SCALE-RM
scale_atmos_dyn_fvm_flux_ud3Koren1993.F90
Go to the documentation of this file.
1 
2 !-------------------------------------------------------------------------------
11 !-------------------------------------------------------------------------------
12 ! Warning: This file was generated from atmos-rm/dynamics/scale_atmos_dyn_fvm_flux_udcd.F90.erb.
13 ! Do not edit this file.
14 !-------------------------------------------------------------------------------
15 #include "scalelib.h"
16 module scale_atmos_dyn_fvm_flux_ud3koren1993
17  !-----------------------------------------------------------------------------
18  !
19  !++ used modules
20  !
21  use scale_precision
22  use scale_io
23  use scale_prof
24  use scale_atmos_grid_cartesc_index
25  use scale_index
26  use scale_tracer
27  use scale_prc
28 #ifdef DEBUG
29  use scale_debug, only: &
30  check
31  use scale_const, only: &
32  undef => const_undef, &
33  iundef => const_undef2
34 #endif
35  !-----------------------------------------------------------------------------
36  implicit none
37  private
38  !-----------------------------------------------------------------------------
39  !
40  !++ Public procedure
41  !
42  public :: atmos_dyn_fvm_flux_valuew_z_ud3koren1993
43 
44  public :: atmos_dyn_fvm_fluxz_xyz_ud3koren1993
45  public :: atmos_dyn_fvm_fluxx_xyz_ud3koren1993
46  public :: atmos_dyn_fvm_fluxy_xyz_ud3koren1993
47 
48  public :: atmos_dyn_fvm_fluxz_xyw_ud3koren1993
49  public :: atmos_dyn_fvm_fluxj13_xyw_ud3koren1993
50  public :: atmos_dyn_fvm_fluxj23_xyw_ud3koren1993
51  public :: atmos_dyn_fvm_fluxx_xyw_ud3koren1993
52  public :: atmos_dyn_fvm_fluxy_xyw_ud3koren1993
53 
54  public :: atmos_dyn_fvm_fluxz_uyz_ud3koren1993
55  public :: atmos_dyn_fvm_fluxj13_uyz_ud3koren1993
56  public :: atmos_dyn_fvm_fluxj23_uyz_ud3koren1993
57  public :: atmos_dyn_fvm_fluxx_uyz_ud3koren1993
58  public :: atmos_dyn_fvm_fluxy_uyz_ud3koren1993
59 
60  public :: atmos_dyn_fvm_fluxz_xvz_ud3koren1993
61  public :: atmos_dyn_fvm_fluxj13_xvz_ud3koren1993
62  public :: atmos_dyn_fvm_fluxj23_xvz_ud3koren1993
63  public :: atmos_dyn_fvm_fluxx_xvz_ud3koren1993
64  public :: atmos_dyn_fvm_fluxy_xvz_ud3koren1993
65 
66  !-----------------------------------------------------------------------------
67  !
68  !++ Public parameters & variables
69  !
70  !-----------------------------------------------------------------------------
71  !
72  !++ Private procedure
73  !
74 #if 1
75 #define F2H(k,p,q) (CDZ(k+p-1)*GSQRT(k+p-1,i,j)/(CDZ(k)*GSQRT(k,i,j)+CDZ(k+1)*GSQRT(k+1,i,j)))
76 #else
77 #define F2H(k,p,q) 0.5_RP
78 #endif
79  !-----------------------------------------------------------------------------
80  !
81  !++ Private parameters & variables
82  !
83 
84  real(RP), parameter :: F2 = 0.5_rp ! F2 is always used to calculate flux near boundary.
85 
86 
87  real(RP), parameter :: F31 = -1.0_rp/12.0_rp
88  real(RP), parameter :: F32 = 7.0_rp/12.0_rp
89  real(RP), parameter :: F33 = 3.0_rp/12.0_rp
90 
91 
92 
93 
94 
95 contains
96  !-----------------------------------------------------------------------------
98 !OCL SERIAL
99  subroutine atmos_dyn_fvm_flux_valuew_z_ud3koren1993( &
100  valW, &
101  mflx, val, GSQRT, &
102  CDZ )
103  implicit none
104 
105  real(rp), intent(out) :: valw (ka)
106  real(rp), intent(in) :: mflx (ka)
107  real(rp), intent(in) :: val (ka)
108  real(rp), intent(in) :: gsqrt(ka)
109  real(rp), intent(in) :: cdz (ka)
110 
111  integer :: k
112  !---------------------------------------------------------------------------
113 
114  do k = ks+1, ke-2
115 #ifdef DEBUG
116  call check( __line__, mflx(k) )
117 
118  call check( __line__, val(k) )
119  call check( __line__, val(k+1) )
120 
121  call check( __line__, val(k-1) )
122  call check( __line__, val(k+2) )
123 
124 #endif
125  valw(k) = ( val(k) &
126  + 0.5_rp * phi(val(k+1),val(k),val(k-1)) * ( val(k)-val(k-1) ) ) &
127  * ( 0.5_rp + sign(0.5_rp,mflx(k)) ) &
128  + ( val(k+1) &
129  + 0.5_rp * phi(val(k),val(k+1),val(k+2)) * ( val(k+1)-val(k+2) ) ) &
130  * ( 0.5_rp - sign(0.5_rp,mflx(k)) )
131  enddo
132 #ifdef DEBUG
133  k = iundef
134 #endif
135 
136 #ifdef DEBUG
137 
138  call check( __line__, mflx(ks) )
139  call check( __line__, val(ks ) )
140  call check( __line__, val(ks+1) )
141  call check( __line__, mflx(ke-1) )
142  call check( __line__, val(ke ) )
143  call check( __line__, val(ke-1) )
144 
145 #endif
146 
147  valw(ks) = val(ks) &
148  * ( 0.5_rp + sign(0.5_rp,mflx(ks)) ) &
149  + ( val(ks+1) &
150  + 0.5_rp * phi(val(ks),val(ks+1),val(ks+2)) * ( val(ks+1)-val(ks+2) ) ) &
151  * ( 0.5_rp - sign(0.5_rp,mflx(ks)) )
152  valw(ke-1) = ( val(ke-1) &
153  + 0.5_rp * phi(val(ke-2),val(ke-1),val(ke)) * ( val(ke-1)-val(ke) ) ) &
154  * ( 0.5_rp + sign(0.5_rp,mflx(ke-1)) ) &
155  + val(ke) &
156  * ( 0.5_rp - sign(0.5_rp,mflx(ke-1)) )
157 
158 
159  return
160  end subroutine atmos_dyn_fvm_flux_valuew_z_ud3koren1993
161 
162  !-----------------------------------------------------------------------------
164  subroutine atmos_dyn_fvm_fluxz_xyz_ud3koren1993( &
165  flux, &
166  mflx, val, GSQRT, &
167  num_diff, &
168  CDZ, &
169  IIS, IIE, JJS, JJE )
170  use scale_const, only: &
171  eps => const_eps
172  implicit none
173 
174  real(rp), intent(inout) :: flux (ka,ia,ja)
175  real(rp), intent(in) :: mflx (ka,ia,ja)
176  real(rp), intent(in) :: val (ka,ia,ja)
177  real(rp), intent(in) :: gsqrt (ka,ia,ja)
178  real(rp), intent(in) :: num_diff(ka,ia,ja)
179  real(rp), intent(in) :: cdz (ka)
180  integer, intent(in) :: iis, iie, jjs, jje
181 
182  real(rp) :: vel
183  integer :: k, i, j
184  !---------------------------------------------------------------------------
185 
186  !$omp parallel default(none) private(i,j,k, vel) &
187  !$omp shared(JJS,JJE,IIS,IIE,KS,KE,mflx,val,flux,GSQRT,num_diff,EPS)
188 
189  !$omp do OMP_SCHEDULE_ collapse(2)
190  do j = jjs, jje
191  do i = iis, iie
192  do k = ks+1, ke-2
193 #ifdef DEBUG
194  call check( __line__, mflx(k,i,j) )
195 
196  call check( __line__, val(k,i,j) )
197  call check( __line__, val(k+1,i,j) )
198 
199  call check( __line__, val(k-1,i,j) )
200  call check( __line__, val(k+2,i,j) )
201 
202 #endif
203  vel = mflx(k,i,j)
204  flux(k,i,j) = vel &
205  * ( ( val(k,i,j) &
206  + 0.5_rp * phi(val(k+1,i,j),val(k,i,j),val(k-1,i,j)) * ( val(k,i,j)-val(k-1,i,j) ) ) &
207  * ( 0.5_rp + sign(0.5_rp,vel) ) &
208  + ( val(k+1,i,j) &
209  + 0.5_rp * phi(val(k,i,j),val(k+1,i,j),val(k+2,i,j)) * ( val(k+1,i,j)-val(k+2,i,j) ) ) &
210  * ( 0.5_rp - sign(0.5_rp,vel) ) ) &
211  + gsqrt(k,i,j) * num_diff(k,i,j)
212  enddo
213  enddo
214  enddo
215  !$omp end do nowait
216 #ifdef DEBUG
217  k = iundef; i = iundef; j = iundef
218 #endif
219 
220  !$omp do OMP_SCHEDULE_ collapse(2)
221  do j = jjs, jje
222  do i = iis, iie
223 #ifdef DEBUG
224 
225  call check( __line__, mflx(ks,i,j) )
226  call check( __line__, val(ks ,i,j) )
227  call check( __line__, val(ks+1,i,j) )
228  call check( __line__, mflx(ke-1,i,j) )
229  call check( __line__, val(ke ,i,j) )
230  call check( __line__, val(ke-1,i,j) )
231 
232 #endif
233  flux(ks-1,i,j) = 0.0_rp
234 
235  vel = mflx(ks,i,j)
236  flux(ks,i,j) = vel &
237  * ( val(ks,i,j) &
238  * ( 0.5_rp + sign(0.5_rp,vel) ) &
239  + ( val(ks+1,i,j) &
240  + 0.5_rp * phi(val(ks,i,j),val(ks+1,i,j),val(ks+2,i,j)) * ( val(ks+1,i,j)-val(ks+2,i,j) ) ) &
241  * ( 0.5_rp - sign(0.5_rp,vel) ) ) &
242  + gsqrt(ks,i,j) * num_diff(ks,i,j)
243  vel = mflx(ke-1,i,j)
244  flux(ke-1,i,j) = vel &
245  * ( ( val(ke-1,i,j) &
246  + 0.5_rp * phi(val(ke-2,i,j),val(ke-1,i,j),val(ke,i,j)) * ( val(ke-1,i,j)-val(ke,i,j) ) ) &
247  * ( 0.5_rp + sign(0.5_rp,vel) ) &
248  + val(ke,i,j) &
249  * ( 0.5_rp - sign(0.5_rp,vel) ) ) &
250  + gsqrt(ke-1,i,j) * num_diff(ke-1,i,j)
251 
252  flux(ke ,i,j) = 0.0_rp
253  enddo
254  enddo
255  !$omp end do nowait
256 
257  !$omp end parallel
258 #ifdef DEBUG
259  k = iundef; i = iundef; j = iundef
260 #endif
261 
262  return
263  end subroutine atmos_dyn_fvm_fluxz_xyz_ud3koren1993
264 
265  !-----------------------------------------------------------------------------
267  subroutine atmos_dyn_fvm_fluxx_xyz_ud3koren1993( &
268  flux, &
269  mflx, val, GSQRT, &
270  num_diff, &
271  CDZ, &
272  IIS, IIE, JJS, JJE )
273  implicit none
274 
275  real(rp), intent(inout) :: flux (ka,ia,ja)
276  real(rp), intent(in) :: mflx (ka,ia,ja)
277  real(rp), intent(in) :: val (ka,ia,ja)
278  real(rp), intent(in) :: gsqrt (ka,ia,ja)
279  real(rp), intent(in) :: num_diff(ka,ia,ja)
280  real(rp), intent(in) :: cdz(ka)
281  integer, intent(in) :: iis, iie, jjs, jje
282 
283  real(rp) :: vel
284  integer :: k, i, j
285  !---------------------------------------------------------------------------
286 
287  !$omp parallel do default(none) private(i,j,k) OMP_SCHEDULE_ collapse(2) &
288  !$omp private(vel) &
289  !$omp shared(JJS,JJE,IIS,IIE,KS,KE,mflx,val,flux,GSQRT,num_diff)
290  do j = jjs, jje
291  do i = iis-1, iie
292  do k = ks, ke
293 #ifdef DEBUG
294  call check( __line__, mflx(k,i,j) )
295 
296  call check( __line__, val(k,i,j) )
297  call check( __line__, val(k,i+1,j) )
298 
299  call check( __line__, val(k,i-1,j) )
300  call check( __line__, val(k,i+2,j) )
301 
302 #endif
303  vel = mflx(k,i,j)
304  flux(k,i,j) = vel &
305  * ( ( val(k,i,j) &
306  + 0.5_rp * phi(val(k,i+1,j),val(k,i,j),val(k,i-1,j)) * ( val(k,i,j)-val(k,i-1,j) ) ) &
307  * ( 0.5_rp + sign(0.5_rp,vel) ) &
308  + ( val(k,i+1,j) &
309  + 0.5_rp * phi(val(k,i,j),val(k,i+1,j),val(k,i+2,j)) * ( val(k,i+1,j)-val(k,i+2,j) ) ) &
310  * ( 0.5_rp - sign(0.5_rp,vel) ) ) &
311  + gsqrt(k,i,j) * num_diff(k,i,j)
312  enddo
313  enddo
314  enddo
315 #ifdef DEBUG
316  k = iundef; i = iundef; j = iundef
317 #endif
318 
319  return
320  end subroutine atmos_dyn_fvm_fluxx_xyz_ud3koren1993
321 
322  !-----------------------------------------------------------------------------
324  subroutine atmos_dyn_fvm_fluxy_xyz_ud3koren1993( &
325  flux, &
326  mflx, val, GSQRT, &
327  num_diff, &
328  CDZ, &
329  IIS, IIE, JJS, JJE )
330  implicit none
331 
332  real(rp), intent(inout) :: flux (ka,ia,ja)
333  real(rp), intent(in) :: mflx (ka,ia,ja)
334  real(rp), intent(in) :: val (ka,ia,ja)
335  real(rp), intent(in) :: gsqrt (ka,ia,ja)
336  real(rp), intent(in) :: num_diff(ka,ia,ja)
337  real(rp), intent(in) :: cdz(ka)
338  integer, intent(in) :: iis, iie, jjs, jje
339 
340  real(rp) :: vel
341  integer :: k, i, j
342  !---------------------------------------------------------------------------
343 
344  !$omp parallel do default(none) private(i,j,k) OMP_SCHEDULE_ collapse(2) &
345  !$omp private(vel) &
346  !$omp shared(JJS,JJE,IIS,IIE,KS,KE,mflx,val,flux,GSQRT,num_diff)
347  do j = jjs-1, jje
348  do i = iis, iie
349  do k = ks, ke
350 #ifdef DEBUG
351  call check( __line__, mflx(k,i,j) )
352 
353  call check( __line__, val(k,i,j) )
354  call check( __line__, val(k,i,j+1) )
355 
356  call check( __line__, val(k,i,j-1) )
357  call check( __line__, val(k,i,j+2) )
358 
359 #endif
360  vel = mflx(k,i,j)
361  flux(k,i,j) = vel &
362  * ( ( val(k,i,j) &
363  + 0.5_rp * phi(val(k,i,j+1),val(k,i,j),val(k,i,j-1)) * ( val(k,i,j)-val(k,i,j-1) ) ) &
364  * ( 0.5_rp + sign(0.5_rp,vel) ) &
365  + ( val(k,i,j+1) &
366  + 0.5_rp * phi(val(k,i,j),val(k,i,j+1),val(k,i,j+2)) * ( val(k,i,j+1)-val(k,i,j+2) ) ) &
367  * ( 0.5_rp - sign(0.5_rp,vel) ) ) &
368  + gsqrt(k,i,j) * num_diff(k,i,j)
369  enddo
370  enddo
371  enddo
372 #ifdef DEBUG
373  k = iundef; i = iundef; j = iundef
374 #endif
375 
376  return
377  end subroutine atmos_dyn_fvm_fluxy_xyz_ud3koren1993
378 
379 
380  !-----------------------------------------------------------------------------
382  subroutine atmos_dyn_fvm_fluxz_xyw_ud3koren1993( &
383  flux, &
384  mom, val, DENS, &
385  GSQRT, J33G, &
386  num_diff, &
387  CDZ, FDZ, &
388  dtrk, &
389  IIS, IIE, JJS, JJE )
390  implicit none
391 
392  real(rp), intent(inout) :: flux (ka,ia,ja)
393  real(rp), intent(in) :: mom (ka,ia,ja)
394  real(rp), intent(in) :: val (ka,ia,ja)
395  real(rp), intent(in) :: dens (ka,ia,ja)
396  real(rp), intent(in) :: gsqrt (ka,ia,ja)
397  real(rp), intent(in) :: j33g
398  real(rp), intent(in) :: num_diff(ka,ia,ja)
399  real(rp), intent(in) :: cdz (ka)
400  real(rp), intent(in) :: fdz (ka-1)
401  real(rp), intent(in) :: dtrk
402  integer, intent(in) :: iis, iie, jjs, jje
403 
404  real(rp) :: vel
405  integer :: k, i, j
406  !---------------------------------------------------------------------------
407 
408  ! note than z-index is added by -1
409 
410  !$omp parallel default(none) private(i,j,k,vel) &
411  !$omp shared(JJS,JJE,IIS,IIE,KS,KE,mom,val,flux,J33G,GSQRT,num_diff,DENS,FDZ,dtrk)
412 
413  !$omp do OMP_SCHEDULE_ collapse(2)
414  do j = jjs, jje
415  do i = iis, iie
416  do k = ks+2, ke-1
417 #ifdef DEBUG
418  call check( __line__, mom(k-1,i,j) )
419  call check( __line__, mom(k ,i,j) )
420 
421  call check( __line__, val(k-1,i,j) )
422  call check( __line__, val(k,i,j) )
423 
424  call check( __line__, val(k-2,i,j) )
425  call check( __line__, val(k+1,i,j) )
426 
427 #endif
428  vel = ( 0.5_rp * ( mom(k-1,i,j) &
429  + mom(k,i,j) ) ) &
430  / dens(k,i,j)
431  flux(k-1,i,j) = j33g * vel &
432  * ( ( val(k-1,i,j) &
433  + 0.5_rp * phi(val(k,i,j),val(k-1,i,j),val(k-2,i,j)) * ( val(k-1,i,j)-val(k-2,i,j) ) ) &
434  * ( 0.5_rp + sign(0.5_rp,vel) ) &
435  + ( val(k,i,j) &
436  + 0.5_rp * phi(val(k-1,i,j),val(k,i,j),val(k+1,i,j)) * ( val(k,i,j)-val(k+1,i,j) ) ) &
437  * ( 0.5_rp - sign(0.5_rp,vel) ) ) &
438  + gsqrt(k,i,j) * num_diff(k,i,j)
439  enddo
440  enddo
441  enddo
442  !$omp end do nowait
443 #ifdef DEBUG
444  k = iundef; i = iundef; j = iundef
445 #endif
446 
447  !$omp do OMP_SCHEDULE_ collapse(2)
448  do j = jjs, jje
449  do i = iis, iie
450 #ifdef DEBUG
451 
452  call check( __line__, val(ks,i,j) )
453  call check( __line__, val(ks+1,i,j) )
454  call check( __line__, val(ks+2,i,j) )
455 
456 
457 #endif
458  ! The boundary condition is qflx_hi + qflxJ13 + qfluxJ23 = 0 at KS.
459  ! The flux at KS can be non-zero.
460  ! To reduce calculations, all the fluxes are set to zero.
461  flux(ks-1,i,j) = 0.0_rp ! k = KS
462 
463  vel = ( 0.5_rp * ( mom(ks,i,j) &
464  + mom(ks+1,i,j) ) ) &
465  / dens(ks+1,i,j)
466  flux(ks,i,j) = j33g * vel &
467  * ( val(ks,i,j) &
468  * ( 0.5_rp + sign(0.5_rp,vel) ) &
469  + ( val(ks+1,i,j) &
470  + 0.5_rp * phi(val(ks,i,j),val(ks+1,i,j),val(ks+2,i,j)) * ( val(ks+1,i,j)-val(ks+2,i,j) ) ) &
471  * ( 0.5_rp - sign(0.5_rp,vel) ) ) &
472  + gsqrt(ks+1,i,j) * num_diff(ks+1,i,j) ! k = KS+1
473 
474 
475 
476  flux(ke-1,i,j) = 0.0_rp ! k = KE
477  flux(ke ,i,j) = 0.0_rp ! k = KE+1
478  enddo
479  enddo
480  !$omp end do nowait
481 
482  !$omp end parallel
483 
484  return
485  end subroutine atmos_dyn_fvm_fluxz_xyw_ud3koren1993
486 
487 
488  !-----------------------------------------------------------------------------
490  subroutine atmos_dyn_fvm_fluxj13_xyw_ud3koren1993( &
491  flux, &
492  mom, val, DENS, &
493  GSQRT, J13G, MAPF, &
494  CDZ, TwoD, &
495  IIS, IIE, JJS, JJE )
496  implicit none
497 
498  real(rp), intent(inout) :: flux (ka,ia,ja)
499  real(rp), intent(in) :: mom (ka,ia,ja)
500  real(rp), intent(in) :: val (ka,ia,ja)
501  real(rp), intent(in) :: dens (ka,ia,ja)
502  real(rp), intent(in) :: gsqrt (ka,ia,ja)
503  real(rp), intent(in) :: j13g (ka,ia,ja)
504  real(rp), intent(in) :: mapf ( ia,ja,2)
505  real(rp), intent(in) :: cdz (ka)
506  logical, intent(in) :: twod
507  integer, intent(in) :: iis, iie, jjs, jje
508 
509  real(rp) :: vel
510  integer :: k, i, j
511  !---------------------------------------------------------------------------
512 
513  !$omp parallel default(none) private(i,j,k,vel) &
514  !$omp shared(JJS,JJE,IIS,IIE,KS,KE,mom,val,DENS,flux,J13G,MAPF)
515 
516  !$omp do OMP_SCHEDULE_ collapse(2)
517  do j = jjs, jje
518  do i = iis, iie
519  do k = ks+2, ke-1
520  vel = ( 0.5_rp * ( mom(k,i,j)+mom(k,i-1,j) ) ) &
521  / dens(k,i,j)
522  vel = vel * j13g(k,i,j)
523  flux(k-1,i,j) = vel / mapf(i,j,+2) &
524  * ( ( val(k-1,i,j) &
525  + 0.5_rp * phi(val(k,i,j),val(k-1,i,j),val(k-2,i,j)) * ( val(k-1,i,j)-val(k-2,i,j) ) ) &
526  * ( 0.5_rp + sign(0.5_rp,vel) ) &
527  + ( val(k,i,j) &
528  + 0.5_rp * phi(val(k-1,i,j),val(k,i,j),val(k+1,i,j)) * ( val(k,i,j)-val(k+1,i,j) ) ) &
529  * ( 0.5_rp - sign(0.5_rp,vel) ) )
530  enddo
531  enddo
532  enddo
533  !$omp end do nowait
534 
535  !$omp do OMP_SCHEDULE_ collapse(2)
536  do j = jjs, jje
537  do i = iis, iie
538  ! The boundary condition is qflx_hi + qflxJ13 + qfluxJ23 = 0 at KS.
539  ! The flux at KS can be non-zero.
540  ! To reduce calculations, all the fluxes are set to zero.
541  flux(ks-1,i,j) = 0.0_rp ! k = KS
542 
543  ! physically incorrect but for numerical stability
544  vel = ( ( 0.5_rp * ( mom(ks+1,i,j)+mom(ks+1,i-1,j) ) ) / dens(ks+1,i,j) &
545  + ( 0.5_rp * ( mom(ks,i,j)+mom(ks,i-1,j) ) ) / dens(ks ,i,j) ) * 0.5_rp
546 ! vel = ( 0.5_RP * ( mom(KS+1,i,j)+mom(KS+1,i-1,j) ) ) &
547 ! / DENS(KS+1,i,j)
548  vel = vel * j13g(ks+1,i,j)
549  flux(ks,i,j) = vel / mapf(i,j,+2) &
550  * ( val(ks,i,j) &
551  * ( 0.5_rp + sign(0.5_rp,vel) ) &
552  + ( val(ks+1,i,j) &
553  + 0.5_rp * phi(val(ks,i,j),val(ks+1,i,j),val(ks+2,i,j)) * ( val(ks+1,i,j)-val(ks+2,i,j) ) ) &
554  * ( 0.5_rp - sign(0.5_rp,vel) ) ) ! k = KS+1
555 
556 
557  flux(ke-1,i,j) = 0.0_rp
558  enddo
559  enddo
560  !$omp end do nowait
561 
562  !$omp end parallel
563 
564  return
565  end subroutine atmos_dyn_fvm_fluxj13_xyw_ud3koren1993
566 
567  !-----------------------------------------------------------------------------
569  subroutine atmos_dyn_fvm_fluxj23_xyw_ud3koren1993( &
570  flux, &
571  mom, val, DENS, &
572  GSQRT, J23G, MAPF, &
573  CDZ, TwoD, &
574  IIS, IIE, JJS, JJE )
575  implicit none
576 
577  real(rp), intent(inout) :: flux (ka,ia,ja)
578  real(rp), intent(in) :: mom (ka,ia,ja)
579  real(rp), intent(in) :: val (ka,ia,ja)
580  real(rp), intent(in) :: dens (ka,ia,ja)
581  real(rp), intent(in) :: gsqrt (ka,ia,ja)
582  real(rp), intent(in) :: j23g (ka,ia,ja)
583  real(rp), intent(in) :: mapf ( ia,ja,2)
584  real(rp), intent(in) :: cdz (ka)
585  logical, intent(in) :: twod
586  integer, intent(in) :: iis, iie, jjs, jje
587 
588  real(rp) :: vel
589  integer :: k, i, j
590  !---------------------------------------------------------------------------
591 
592  !$omp parallel default(none) private(i,j,k,vel) &
593  !$omp shared(JJS,JJE,IIS,IIE,KS,KE,mom,val,DENS,flux,J23G,MAPF)
594 
595  !$omp do OMP_SCHEDULE_ collapse(2)
596  do j = jjs, jje
597  do i = iis, iie
598  do k = ks+2, ke-1
599  vel = ( 0.5_rp * ( mom(k,i,j)+mom(k,i,j-1) ) ) &
600  / dens(k,i,j)
601  vel = vel * j23g(k,i,j)
602  flux(k-1,i,j) = vel / mapf(i,j,+1) &
603  * ( ( val(k-1,i,j) &
604  + 0.5_rp * phi(val(k,i,j),val(k-1,i,j),val(k-2,i,j)) * ( val(k-1,i,j)-val(k-2,i,j) ) ) &
605  * ( 0.5_rp + sign(0.5_rp,vel) ) &
606  + ( val(k,i,j) &
607  + 0.5_rp * phi(val(k-1,i,j),val(k,i,j),val(k+1,i,j)) * ( val(k,i,j)-val(k+1,i,j) ) ) &
608  * ( 0.5_rp - sign(0.5_rp,vel) ) )
609  enddo
610  enddo
611  enddo
612  !$omp end do nowait
613 
614  !$omp do OMP_SCHEDULE_ collapse(2)
615  do j = jjs, jje
616  do i = iis, iie
617  ! The boundary condition is qflx_hi + qflxJ13 + qfluxJ23 = 0 at KS.
618  ! The flux at KS can be non-zero.
619  ! To reduce calculations, all the fluxes are set to zero.
620  flux(ks-1,i,j) = 0.0_rp ! k = KS
621 
622  ! physically incorrect but for numerical stability
623  vel = ( ( 0.5_rp * ( mom(ks+1,i,j)+mom(ks+1,i,j-1) ) ) / dens(ks+1,i,j) &
624  + ( 0.5_rp * ( mom(ks,i,j)+mom(ks,i,j-1) ) ) / dens(ks ,i,j) ) * 0.5_rp
625 ! vel = ( 0.5_RP * ( mom(KS+1,i,j)+mom(KS+1,i,j-1) ) ) &
626 ! / DENS(KS+1,i,j)
627  vel = vel * j23g(ks+1,i,j)
628  flux(ks,i,j) = vel / mapf(i,j,+1) &
629  * ( val(ks,i,j) &
630  * ( 0.5_rp + sign(0.5_rp,vel) ) &
631  + ( val(ks+1,i,j) &
632  + 0.5_rp * phi(val(ks,i,j),val(ks+1,i,j),val(ks+2,i,j)) * ( val(ks+1,i,j)-val(ks+2,i,j) ) ) &
633  * ( 0.5_rp - sign(0.5_rp,vel) ) ) ! k = KS+1
634 
635 
636  flux(ke-1,i,j) = 0.0_rp
637  enddo
638  enddo
639  !$omp end do nowait
640 
641  !$omp end parallel
642 
643  return
644  end subroutine atmos_dyn_fvm_fluxj23_xyw_ud3koren1993
645 
646 
647  !-----------------------------------------------------------------------------
649  subroutine atmos_dyn_fvm_fluxx_xyw_ud3koren1993( &
650  flux, &
651  mom, val, DENS, &
652  GSQRT, MAPF, &
653  num_diff, &
654  CDZ, TwoD, &
655  IIS, IIE, JJS, JJE )
656  implicit none
657 
658  real(rp), intent(inout) :: flux (ka,ia,ja)
659  real(rp), intent(in) :: mom (ka,ia,ja)
660  real(rp), intent(in) :: val (ka,ia,ja)
661  real(rp), intent(in) :: dens (ka,ia,ja)
662  real(rp), intent(in) :: gsqrt (ka,ia,ja)
663  real(rp), intent(in) :: mapf ( ia,ja,2)
664  real(rp), intent(in) :: num_diff(ka,ia,ja)
665  real(rp), intent(in) :: cdz (ka)
666  logical, intent(in) :: twod
667  integer, intent(in) :: iis, iie, jjs, jje
668 
669  real(rp) :: vel
670  integer :: k, i, j
671  !---------------------------------------------------------------------------
672 
673  !$omp parallel default(none) private(i,j,k,vel) &
674  !$omp shared(JJS,JJE,IIS,IIE,KS,KE,mom,val,DENS,flux,GSQRT,MAPF,num_diff) &
675  !$omp shared(CDZ)
676 
677  !$omp do OMP_SCHEDULE_ collapse(2)
678  do j = jjs, jje
679  do i = iis-1, iie
680  do k = ks, ke-1
681 #ifdef DEBUG
682  call check( __line__, mom(k ,i,j) )
683  call check( __line__, mom(k+1,i,j) )
684 
685  call check( __line__, val(k,i,j) )
686  call check( __line__, val(k,i+1,j) )
687 
688  call check( __line__, val(k,i-1,j) )
689  call check( __line__, val(k,i+2,j) )
690 
691 #endif
692  vel = ( f2h(k,1,i_uyz) &
693  * mom(k+1,i,j) &
694  + f2h(k,2,i_uyz) &
695  * mom(k,i,j) ) &
696  / ( f2h(k,1,i_uyz) &
697  * 0.5_rp * ( dens(k+1,i,j)+dens(k+1,i+1,j) ) &
698  + f2h(k,2,i_uyz) &
699  * 0.5_rp * ( dens(k,i,j)+dens(k,i+1,j) ) )
700  flux(k,i,j) = gsqrt(k,i,j) / mapf(i,j,+2) * vel &
701  * ( ( val(k,i,j) &
702  + 0.5_rp * phi(val(k,i+1,j),val(k,i,j),val(k,i-1,j)) * ( val(k,i,j)-val(k,i-1,j) ) ) &
703  * ( 0.5_rp + sign(0.5_rp,vel) ) &
704  + ( val(k,i+1,j) &
705  + 0.5_rp * phi(val(k,i,j),val(k,i+1,j),val(k,i+2,j)) * ( val(k,i+1,j)-val(k,i+2,j) ) ) &
706  * ( 0.5_rp - sign(0.5_rp,vel) ) ) &
707  + gsqrt(k,i,j) * num_diff(k,i,j)
708  enddo
709  enddo
710  enddo
711  !$omp end do nowait
712 #ifdef DEBUG
713  k = iundef; i = iundef; j = iundef
714 #endif
715 
716  !$omp do OMP_SCHEDULE_ collapse(2)
717  do j = jjs, jje
718  do i = iis-1, iie
719  flux(ke,i,j) = 0.0_rp
720  enddo
721  enddo
722  !$omp end do nowait
723 
724  !$omp end parallel
725 #ifdef DEBUG
726  k = iundef; i = iundef; j = iundef
727 #endif
728 
729  return
730  end subroutine atmos_dyn_fvm_fluxx_xyw_ud3koren1993
731 
732  !-----------------------------------------------------------------------------
734  subroutine atmos_dyn_fvm_fluxy_xyw_ud3koren1993( &
735  flux, &
736  mom, val, DENS, &
737  GSQRT, MAPF, &
738  num_diff, &
739  CDZ, TwoD, &
740  IIS, IIE, JJS, JJE )
741  implicit none
742 
743  real(rp), intent(inout) :: flux (ka,ia,ja)
744  real(rp), intent(in) :: mom (ka,ia,ja)
745  real(rp), intent(in) :: val (ka,ia,ja)
746  real(rp), intent(in) :: dens (ka,ia,ja)
747  real(rp), intent(in) :: gsqrt (ka,ia,ja)
748  real(rp), intent(in) :: mapf ( ia,ja,2)
749  real(rp), intent(in) :: num_diff(ka,ia,ja)
750  real(rp), intent(in) :: cdz (ka)
751  logical, intent(in) :: twod
752  integer, intent(in) :: iis, iie, jjs, jje
753 
754  real(rp) :: vel
755  integer :: k, i, j
756  !---------------------------------------------------------------------------
757 
758  !$omp parallel default(none) private(i,j,k,vel) &
759  !$omp shared(JJS,JJE,IIS,IIE,KS,KE,mom,val,DENS,flux,GSQRT,MAPF,num_diff) &
760  !$omp shared(CDZ)
761 
762  !$omp do OMP_SCHEDULE_ collapse(2)
763  do j = jjs-1, jje
764  do i = iis, iie
765  do k = ks, ke-1
766 #ifdef DEBUG
767  call check( __line__, mom(k ,i,j) )
768  call check( __line__, mom(k+1,i,j) )
769 
770  call check( __line__, val(k,i,j) )
771  call check( __line__, val(k,i,j+1) )
772 
773  call check( __line__, val(k,i,j-1) )
774  call check( __line__, val(k,i,j+2) )
775 
776 #endif
777  vel = ( f2h(k,1,i_xvz) &
778  * mom(k+1,i,j) &
779  + f2h(k,2,i_xvz) &
780  * mom(k,i,j) ) &
781  / ( f2h(k,1,i_xvz) &
782  * 0.5_rp * ( dens(k+1,i,j)+dens(k+1,i,j+1) ) &
783  + f2h(k,2,i_xvz) &
784  * 0.5_rp * ( dens(k,i,j)+dens(k,i,j+1) ) )
785  flux(k,i,j) = gsqrt(k,i,j) / mapf(i,j,+1) * vel &
786  * ( ( val(k,i,j) &
787  + 0.5_rp * phi(val(k,i,j+1),val(k,i,j),val(k,i,j-1)) * ( val(k,i,j)-val(k,i,j-1) ) ) &
788  * ( 0.5_rp + sign(0.5_rp,vel) ) &
789  + ( val(k,i,j+1) &
790  + 0.5_rp * phi(val(k,i,j),val(k,i,j+1),val(k,i,j+2)) * ( val(k,i,j+1)-val(k,i,j+2) ) ) &
791  * ( 0.5_rp - sign(0.5_rp,vel) ) ) &
792  + gsqrt(k,i,j) * num_diff(k,i,j)
793  enddo
794  enddo
795  enddo
796  !$omp end do nowait
797 #ifdef DEBUG
798  k = iundef; i = iundef; j = iundef
799 #endif
800 
801  !$omp do OMP_SCHEDULE_ collapse(2)
802  do j = jjs-1, jje
803  do i = iis, iie
804  flux(ke,i,j) = 0.0_rp
805  enddo
806  enddo
807  !$omp end do nowait
808 
809  !$omp end parallel
810 #ifdef DEBUG
811  k = iundef; i = iundef; j = iundef
812 #endif
813 
814  return
815  end subroutine atmos_dyn_fvm_fluxy_xyw_ud3koren1993
816 
817 
818  !-----------------------------------------------------------------------------
820  subroutine atmos_dyn_fvm_fluxz_uyz_ud3koren1993( &
821  flux, &
822  mom, val, DENS, &
823  GSQRT, J33G, &
824  num_diff, &
825  CDZ, TwoD, &
826  IIS, IIE, JJS, JJE )
827  implicit none
828 
829  real(rp), intent(inout) :: flux (ka,ia,ja)
830  real(rp), intent(in) :: mom (ka,ia,ja)
831  real(rp), intent(in) :: val (ka,ia,ja)
832  real(rp), intent(in) :: dens (ka,ia,ja)
833  real(rp), intent(in) :: gsqrt (ka,ia,ja)
834  real(rp), intent(in) :: j33g
835  real(rp), intent(in) :: num_diff(ka,ia,ja)
836  real(rp), intent(in) :: cdz (ka)
837  logical, intent(in) :: twod
838  integer, intent(in) :: iis, iie, jjs, jje
839 
840  real(rp) :: vel
841  integer :: k, i, j
842  !---------------------------------------------------------------------------
843 
844  !$omp parallel default(none) private(i,j,k,vel) &
845  !$omp shared(JJS,JJE,IIS,IIE,KS,KE,mom,val,DENS,flux,J33G,GSQRT,num_diff) &
846  !$omp shared(CDZ,TwoD)
847 
848 
849  if ( twod ) then
850 
851  !$omp do OMP_SCHEDULE_
852  do j = jjs, jje
853  do k = ks+1, ke-2
854 #ifdef DEBUG
855  call check( __line__, mom(k,i,j) )
856 
857  call check( __line__, val(k,i,j) )
858  call check( __line__, val(k+1,i,j) )
859 
860  call check( __line__, val(k-1,i,j) )
861  call check( __line__, val(k+2,i,j) )
862 
863 #endif
864  i = iis
865  vel = ( mom(k,i,j) ) &
866  / ( f2h(k,1,i_xyz) &
867  * dens(k+1,i,j) &
868  + f2h(k,2,i_xyz) &
869  * dens(k,i,j) )
870  flux(k,i,j) = j33g * vel &
871  * ( ( val(k,i,j) &
872  + 0.5_rp * phi(val(k+1,i,j),val(k,i,j),val(k-1,i,j)) * ( val(k,i,j)-val(k-1,i,j) ) ) &
873  * ( 0.5_rp + sign(0.5_rp,vel) ) &
874  + ( val(k+1,i,j) &
875  + 0.5_rp * phi(val(k,i,j),val(k+1,i,j),val(k+2,i,j)) * ( val(k+1,i,j)-val(k+2,i,j) ) ) &
876  * ( 0.5_rp - sign(0.5_rp,vel) ) ) &
877  + gsqrt(k,i,j) * num_diff(k,i,j)
878  enddo
879  enddo
880  !$omp end do nowait
881 #ifdef DEBUG
882  k = iundef; i = iundef; j = iundef
883 #endif
884 
885  !$omp do OMP_SCHEDULE_
886  do j = jjs, jje
887 #ifdef DEBUG
888 
889  call check( __line__, mom(ks,i ,j) )
890  call check( __line__, val(ks+1,i,j) )
891  call check( __line__, val(ks,i,j) )
892 
893 #endif
894  i = iis
895  ! The boundary condition is qflx_hi + qflxJ13 + qfluxJ23 = 0 at KS-1.
896  ! The flux at KS-1 can be non-zero.
897  ! To reduce calculations, all the fluxes are set to zero.
898  flux(ks-1,i,j) = 0.0_rp
899 
900  vel = ( mom(ks,i,j) ) &
901  / ( f2h(ks,1,i_xyz) &
902  * dens(ks+1,i,j) &
903  + f2h(ks,2,i_xyz) &
904  * dens(ks,i,j) )
905  flux(ks,i,j) = j33g * vel &
906  * ( val(ks,i,j) &
907  * ( 0.5_rp + sign(0.5_rp,vel) ) &
908  + ( val(ks+1,i,j) &
909  + 0.5_rp * phi(val(ks,i,j),val(ks+1,i,j),val(ks+2,i,j)) * ( val(ks+1,i,j)-val(ks+2,i,j) ) ) &
910  * ( 0.5_rp - sign(0.5_rp,vel) ) ) &
911  + gsqrt(ks,i,j) * num_diff(ks,i,j)
912  vel = ( mom(ke-1,i,j) ) &
913  / ( f2h(ke-1,1,i_xyz) &
914  * dens(ke,i,j) &
915  + f2h(ke-1,2,i_xyz) &
916  * dens(ke-1,i,j) )
917  flux(ke-1,i,j) = j33g * vel &
918  * ( ( val(ke-1,i,j) &
919  + 0.5_rp * phi(val(ke-2,i,j),val(ke-1,i,j),val(ke,i,j)) * ( val(ke-1,i,j)-val(ke,i,j) ) ) &
920  * ( 0.5_rp + sign(0.5_rp,vel) ) &
921  + val(ke,i,j) &
922  * ( 0.5_rp - sign(0.5_rp,vel) ) ) &
923  + gsqrt(ke-1,i,j) * num_diff(ke-1,i,j)
924 
925  flux(ke,i,j) = 0.0_rp
926  enddo
927  !$omp end do nowait
928 
929  else
930 
931 
932  !$omp do OMP_SCHEDULE_ collapse(2)
933  do j = jjs, jje
934  do i = iis, iie
935  do k = ks+1, ke-2
936 #ifdef DEBUG
937  call check( __line__, mom(k,i,j) )
938  call check( __line__, mom(k,i+1,j) )
939 
940  call check( __line__, val(k,i,j) )
941  call check( __line__, val(k+1,i,j) )
942 
943  call check( __line__, val(k-1,i,j) )
944  call check( __line__, val(k+2,i,j) )
945 
946 #endif
947  vel = ( 0.5_rp * ( mom(k,i,j)+mom(k,i+1,j) ) ) &
948  / ( f2h(k,1,i_uyz) &
949  * 0.5_rp * ( dens(k+1,i,j)+dens(k+1,i+1,j) ) &
950  + f2h(k,2,i_uyz) &
951  * 0.5_rp * ( dens(k,i,j)+dens(k,i+1,j) ) )
952  flux(k,i,j) = j33g * vel &
953  * ( ( val(k,i,j) &
954  + 0.5_rp * phi(val(k+1,i,j),val(k,i,j),val(k-1,i,j)) * ( val(k,i,j)-val(k-1,i,j) ) ) &
955  * ( 0.5_rp + sign(0.5_rp,vel) ) &
956  + ( val(k+1,i,j) &
957  + 0.5_rp * phi(val(k,i,j),val(k+1,i,j),val(k+2,i,j)) * ( val(k+1,i,j)-val(k+2,i,j) ) ) &
958  * ( 0.5_rp - sign(0.5_rp,vel) ) ) &
959  + gsqrt(k,i,j) * num_diff(k,i,j)
960  enddo
961  enddo
962  enddo
963  !$omp end do nowait
964 #ifdef DEBUG
965  k = iundef; i = iundef; j = iundef
966 #endif
967 
968  !$omp do OMP_SCHEDULE_ collapse(2)
969  do j = jjs, jje
970  do i = iis, iie
971 #ifdef DEBUG
972 
973  call check( __line__, mom(ks,i ,j) )
974  call check( __line__, mom(ks,i+1,j) )
975  call check( __line__, val(ks+1,i,j) )
976  call check( __line__, val(ks,i,j) )
977 
978 #endif
979  ! The boundary condition is qflx_hi + qflxJ13 + qfluxJ23 = 0 at KS-1.
980  ! The flux at KS-1 can be non-zero.
981  ! To reduce calculations, all the fluxes are set to zero.
982  flux(ks-1,i,j) = 0.0_rp
983 
984  vel = ( 0.5_rp * ( mom(ks,i,j)+mom(ks,i+1,j) ) ) &
985  / ( f2h(ks,1,i_uyz) &
986  * 0.5_rp * ( dens(ks+1,i,j)+dens(ks+1,i+1,j) ) &
987  + f2h(ks,2,i_uyz) &
988  * 0.5_rp * ( dens(ks,i,j)+dens(ks,i+1,j) ) )
989  flux(ks,i,j) = j33g * vel &
990  * ( val(ks,i,j) &
991  * ( 0.5_rp + sign(0.5_rp,vel) ) &
992  + ( val(ks+1,i,j) &
993  + 0.5_rp * phi(val(ks,i,j),val(ks+1,i,j),val(ks+2,i,j)) * ( val(ks+1,i,j)-val(ks+2,i,j) ) ) &
994  * ( 0.5_rp - sign(0.5_rp,vel) ) ) &
995  + gsqrt(ks,i,j) * num_diff(ks,i,j)
996  vel = ( 0.5_rp * ( mom(ke-1,i,j)+mom(ke-1,i+1,j) ) ) &
997  / ( f2h(ke-1,1,i_uyz) &
998  * 0.5_rp * ( dens(ke,i,j)+dens(ke,i+1,j) ) &
999  + f2h(ke-1,2,i_uyz) &
1000  * 0.5_rp * ( dens(ke-1,i,j)+dens(ke-1,i+1,j) ) )
1001  flux(ke-1,i,j) = j33g * vel &
1002  * ( ( val(ke-1,i,j) &
1003  + 0.5_rp * phi(val(ke-2,i,j),val(ke-1,i,j),val(ke,i,j)) * ( val(ke-1,i,j)-val(ke,i,j) ) ) &
1004  * ( 0.5_rp + sign(0.5_rp,vel) ) &
1005  + val(ke,i,j) &
1006  * ( 0.5_rp - sign(0.5_rp,vel) ) ) &
1007  + gsqrt(ke-1,i,j) * num_diff(ke-1,i,j)
1008 
1009  flux(ke,i,j) = 0.0_rp
1010  enddo
1011  enddo
1012  !$omp end do nowait
1013 
1014  end if
1015 
1016 
1017  !$omp end parallel
1018 #ifdef DEBUG
1019  k = iundef; i = iundef; j = iundef
1020 #endif
1021 
1022  return
1023  end subroutine atmos_dyn_fvm_fluxz_uyz_ud3koren1993
1024 
1025  !-----------------------------------------------------------------------------
1027  subroutine atmos_dyn_fvm_fluxj13_uyz_ud3koren1993( &
1028  flux, &
1029  mom, val, DENS, &
1030  GSQRT, J13G, MAPF, &
1031  CDZ, TwoD, &
1032  IIS, IIE, JJS, JJE )
1033  implicit none
1034 
1035  real(rp), intent(inout) :: flux (ka,ia,ja)
1036  real(rp), intent(in) :: mom (ka,ia,ja)
1037  real(rp), intent(in) :: val (ka,ia,ja)
1038  real(rp), intent(in) :: dens (ka,ia,ja)
1039  real(rp), intent(in) :: gsqrt (ka,ia,ja)
1040  real(rp), intent(in) :: j13g (ka,ia,ja)
1041  real(rp), intent(in) :: mapf ( ia,ja,2)
1042  real(rp), intent(in) :: cdz (ka)
1043  logical, intent(in) :: twod
1044  integer, intent(in) :: iis, iie, jjs, jje
1045 
1046  real(rp) :: vel
1047  integer :: k, i, j
1048  !---------------------------------------------------------------------------
1049 
1050  !$omp parallel default(none) private(i,j,k,vel) &
1051  !$omp shared(JJS,JJE,IIS,IIE,KS,KE,mom,val,DENS,flux,J13G,MAPF) &
1052  !$omp shared(GSQRT,CDZ,TwoD)
1053 
1054 
1055 
1056  !$omp do OMP_SCHEDULE_ collapse(2)
1057  do j = jjs, jje
1058  do i = iis, iie
1059  do k = ks+1, ke-2
1060  vel = ( f2h(k,1,i_uyz) &
1061  * mom(k+1,i,j) &
1062  + f2h(k,2,i_uyz) &
1063  * mom(k,i,j) ) &
1064  / ( f2h(k,1,i_uyz) &
1065  * 0.5_rp * ( dens(k+1,i,j)+dens(k+1,i+1,j) ) &
1066  + f2h(k,2,i_uyz) &
1067  * 0.5_rp * ( dens(k,i,j)+dens(k,i+1,j) ) )
1068  vel = vel * j13g(k,i,j)
1069  flux(k,i,j) = vel / mapf(i,j,+2) &
1070  * ( ( val(k,i,j) &
1071  + 0.5_rp * phi(val(k+1,i,j),val(k,i,j),val(k-1,i,j)) * ( val(k,i,j)-val(k-1,i,j) ) ) &
1072  * ( 0.5_rp + sign(0.5_rp,vel) ) &
1073  + ( val(k+1,i,j) &
1074  + 0.5_rp * phi(val(k,i,j),val(k+1,i,j),val(k+2,i,j)) * ( val(k+1,i,j)-val(k+2,i,j) ) ) &
1075  * ( 0.5_rp - sign(0.5_rp,vel) ) )
1076  enddo
1077  enddo
1078  enddo
1079  !$omp end do nowait
1080 
1081  !$omp do OMP_SCHEDULE_ collapse(2)
1082  do j = jjs, jje
1083  do i = iis, iie
1084  ! The boundary condition is qflx_hi + qflxJ13 + qfluxJ23 = 0 at KS-1.
1085  ! The flux at KS-1 can be non-zero.
1086  ! To reduce calculations, all the fluxes are set to zero.
1087  flux(ks-1,i,j) = 0.0_rp
1088 
1089  vel = ( f2h(ks,1,i_uyz) &
1090  * mom(ks+1,i,j) &
1091  + f2h(ks,2,i_uyz) &
1092  * mom(ks,i,j) ) &
1093  / ( f2h(ks,1,i_uyz) &
1094  * 0.5_rp * ( dens(ks+1,i,j)+dens(ks+1,i+1,j) ) &
1095  + f2h(ks,2,i_uyz) &
1096  * 0.5_rp * ( dens(ks,i,j)+dens(ks,i+1,j) ) )
1097  vel = vel * j13g(ks,i,j)
1098  flux(ks,i,j) = vel / mapf(i,j,+2) &
1099  * ( val(ks,i,j) &
1100  * ( 0.5_rp + sign(0.5_rp,vel) ) &
1101  + ( val(ks+1,i,j) &
1102  + 0.5_rp * phi(val(ks,i,j),val(ks+1,i,j),val(ks+2,i,j)) * ( val(ks+1,i,j)-val(ks+2,i,j) ) ) &
1103  * ( 0.5_rp - sign(0.5_rp,vel) ) )
1104 
1105  vel = ( f2h(ke-1,1,i_uyz) &
1106  * mom(ke,i,j) &
1107  + f2h(ke-1,2,i_uyz) &
1108  * mom(ke-1,i,j) ) &
1109  / ( f2h(ke-1,1,i_uyz) &
1110  * 0.5_rp * ( dens(ke,i,j)+dens(ke,i+1,j) ) &
1111  + f2h(ke-1,2,i_uyz) &
1112  * 0.5_rp * ( dens(ke-1,i,j)+dens(ke-1,i+1,j) ) )
1113  vel = vel * j13g(ke-1,i,j)
1114  flux(ke-1,i,j) = vel / mapf(i,j,+2) &
1115  * ( ( val(ke-1,i,j) &
1116  + 0.5_rp * phi(val(ke-2,i,j),val(ke-1,i,j),val(ke,i,j)) * ( val(ke-1,i,j)-val(ke,i,j) ) ) &
1117  * ( 0.5_rp + sign(0.5_rp,vel) ) &
1118  + val(ke,i,j) &
1119  * ( 0.5_rp - sign(0.5_rp,vel) ) )
1120 
1121  flux(ke ,i,j) = 0.0_rp
1122  enddo
1123  enddo
1124  !$omp end do nowait
1125 
1126 
1127 
1128  !$omp end parallel
1129  return
1130  end subroutine atmos_dyn_fvm_fluxj13_uyz_ud3koren1993
1131 
1132  !-----------------------------------------------------------------------------
1134  subroutine atmos_dyn_fvm_fluxj23_uyz_ud3koren1993( &
1135  flux, &
1136  mom, val, DENS, &
1137  GSQRT, J23G, MAPF, &
1138  CDZ, TwoD, &
1139  IIS, IIE, JJS, JJE )
1140  implicit none
1141 
1142  real(rp), intent(inout) :: flux (ka,ia,ja)
1143  real(rp), intent(in) :: mom (ka,ia,ja)
1144  real(rp), intent(in) :: val (ka,ia,ja)
1145  real(rp), intent(in) :: dens (ka,ia,ja)
1146  real(rp), intent(in) :: gsqrt (ka,ia,ja)
1147  real(rp), intent(in) :: j23g (ka,ia,ja)
1148  real(rp), intent(in) :: mapf ( ia,ja,2)
1149  real(rp), intent(in) :: cdz (ka)
1150  logical, intent(in) :: twod
1151  integer, intent(in) :: iis, iie, jjs, jje
1152 
1153  real(rp) :: vel
1154  integer :: k, i, j
1155  !---------------------------------------------------------------------------
1156 
1157  !$omp parallel default(none) private(i,j,k,vel) &
1158  !$omp shared(JJS,JJE,IIS,IIE,KS,KE,mom,val,DENS,flux,J23G,MAPF) &
1159  !$omp shared(GSQRT,CDZ,TwoD)
1160 
1161 
1162  if ( twod ) then
1163 
1164  !$omp do OMP_SCHEDULE_
1165  do j = jjs, jje
1166  do k = ks+1, ke-2
1167  i = iis
1168  vel = ( f2h(k,1,i_xyz) &
1169  * 0.5_rp * ( mom(k+1,i,j)+mom(k+1,i,j-1) ) &
1170  + f2h(k,2,i_xyz) &
1171  * 0.5_rp * ( mom(k,i,j)+mom(k,i,j-1) ) ) &
1172  / ( f2h(k,1,i_xyz) &
1173  * dens(k+1,i,j) &
1174  + f2h(k,2,i_xyz) &
1175  * dens(k,i,j) )
1176  vel = vel * j23g(k,i,j)
1177  flux(k,i,j) = vel * ( ( val(k,i,j) &
1178  + 0.5_rp * phi(val(k+1,i,j),val(k,i,j),val(k-1,i,j)) * ( val(k,i,j)-val(k-1,i,j) ) ) &
1179  * ( 0.5_rp + sign(0.5_rp,vel) ) &
1180  + ( val(k+1,i,j) &
1181  + 0.5_rp * phi(val(k,i,j),val(k+1,i,j),val(k+2,i,j)) * ( val(k+1,i,j)-val(k+2,i,j) ) ) &
1182  * ( 0.5_rp - sign(0.5_rp,vel) ) )
1183  enddo
1184  enddo
1185  !$omp end do nowait
1186 
1187  !$omp do OMP_SCHEDULE_
1188  do j = jjs, jje
1189  i = iis
1190  ! The boundary condition is qflx_hi + qflxJ13 + qfluxJ23 = 0 at KS-1.
1191  ! The flux at KS-1 can be non-zero.
1192  ! To reduce calculations, all the fluxes are set to zero.
1193  flux(ks-1,i,j) = 0.0_rp
1194 
1195  vel = ( f2h(ks,1,i_xyz) &
1196  * 0.5_rp * ( mom(ks+1,i,j)+mom(ks+1,i,j-1) ) &
1197  + f2h(ks,2,i_xyz) &
1198  * 0.5_rp * ( mom(ks,i,j)+mom(ks,i,j-1) ) ) &
1199  / ( f2h(ks,1,i_xyz) &
1200  * dens(ks+1,i,j) &
1201  + f2h(ks,2,i_xyz) &
1202  * dens(ks,i,j) )
1203  vel = vel * j23g(ks,i,j)
1204  flux(ks,i,j) = vel / mapf(i,j,+1) &
1205  * ( val(ks,i,j) &
1206  * ( 0.5_rp + sign(0.5_rp,vel) ) &
1207  + ( val(ks+1,i,j) &
1208  + 0.5_rp * phi(val(ks,i,j),val(ks+1,i,j),val(ks+2,i,j)) * ( val(ks+1,i,j)-val(ks+2,i,j) ) ) &
1209  * ( 0.5_rp - sign(0.5_rp,vel) ) )
1210 
1211  vel = ( f2h(ke-1,1,i_xyz) &
1212  * 0.5_rp * ( mom(ke,i,j)+mom(ke,i,j-1) ) &
1213  + f2h(ke-1,2,i_xyz) &
1214  * 0.5_rp * ( mom(ke-1,i,j)+mom(ke-1,i,j-1) ) ) &
1215  / ( f2h(ke-1,1,i_xyz) &
1216  * dens(ke,i,j) &
1217  + f2h(ke-1,2,i_xyz) &
1218  * dens(ke-1,i,j) )
1219  vel = vel * j23g(ke-1,i,j)
1220  flux(ke-1,i,j) = vel / mapf(i,j,+1) &
1221  * ( ( val(ke-1,i,j) &
1222  + 0.5_rp * phi(val(ke-2,i,j),val(ke-1,i,j),val(ke,i,j)) * ( val(ke-1,i,j)-val(ke,i,j) ) ) &
1223  * ( 0.5_rp + sign(0.5_rp,vel) ) &
1224  + val(ke,i,j) &
1225  * ( 0.5_rp - sign(0.5_rp,vel) ) )
1226 
1227  flux(ke ,i,j) = 0.0_rp
1228  enddo
1229  !$omp end do nowait
1230 
1231  else
1232 
1233 
1234  !$omp do OMP_SCHEDULE_ collapse(2)
1235  do j = jjs, jje
1236  do i = iis, iie
1237  do k = ks+1, ke-2
1238  vel = ( f2h(k,1,i_uyz) &
1239  * 0.25_rp * ( mom(k+1,i,j)+mom(k+1,i+1,j)+mom(k+1,i,j-1)+mom(k+1,i+1,j-1) ) &
1240  + f2h(k,2,i_uyz) &
1241  * 0.25_rp * ( mom(k,i,j)+mom(k,i+1,j)+mom(k,i,j-1)+mom(k,i+1,j-1) ) ) &
1242  / ( f2h(k,1,i_uyz) &
1243  * 0.5_rp * ( dens(k+1,i,j)+dens(k+1,i+1,j) ) &
1244  + f2h(k,2,i_uyz) &
1245  * 0.5_rp * ( dens(k,i,j)+dens(k,i+1,j) ) )
1246  vel = vel * j23g(k,i,j)
1247  flux(k,i,j) = vel / mapf(i,j,+1) &
1248  * ( ( val(k,i,j) &
1249  + 0.5_rp * phi(val(k+1,i,j),val(k,i,j),val(k-1,i,j)) * ( val(k,i,j)-val(k-1,i,j) ) ) &
1250  * ( 0.5_rp + sign(0.5_rp,vel) ) &
1251  + ( val(k+1,i,j) &
1252  + 0.5_rp * phi(val(k,i,j),val(k+1,i,j),val(k+2,i,j)) * ( val(k+1,i,j)-val(k+2,i,j) ) ) &
1253  * ( 0.5_rp - sign(0.5_rp,vel) ) )
1254  enddo
1255  enddo
1256  enddo
1257  !$omp end do nowait
1258 
1259  !$omp do OMP_SCHEDULE_ collapse(2)
1260  do j = jjs, jje
1261  do i = iis, iie
1262  ! The boundary condition is qflx_hi + qflxJ13 + qfluxJ23 = 0 at KS-1.
1263  ! The flux at KS-1 can be non-zero.
1264  ! To reduce calculations, all the fluxes are set to zero.
1265  flux(ks-1,i,j) = 0.0_rp
1266 
1267  vel = ( f2h(ks,1,i_uyz) &
1268  * 0.25_rp * ( mom(ks+1,i,j)+mom(ks+1,i+1,j)+mom(ks+1,i,j-1)+mom(ks+1,i+1,j-1) ) &
1269  + f2h(ks,2,i_uyz) &
1270  * 0.25_rp * ( mom(ks,i,j)+mom(ks,i+1,j)+mom(ks,i,j-1)+mom(ks,i+1,j-1) ) ) &
1271  / ( f2h(ks,1,i_uyz) &
1272  * 0.5_rp * ( dens(ks+1,i,j)+dens(ks+1,i+1,j) ) &
1273  + f2h(ks,2,i_uyz) &
1274  * 0.5_rp * ( dens(ks,i,j)+dens(ks,i+1,j) ) )
1275  vel = vel * j23g(ks,i,j)
1276  flux(ks,i,j) = vel / mapf(i,j,+1) &
1277  * ( val(ks,i,j) &
1278  * ( 0.5_rp + sign(0.5_rp,vel) ) &
1279  + ( val(ks+1,i,j) &
1280  + 0.5_rp * phi(val(ks,i,j),val(ks+1,i,j),val(ks+2,i,j)) * ( val(ks+1,i,j)-val(ks+2,i,j) ) ) &
1281  * ( 0.5_rp - sign(0.5_rp,vel) ) )
1282 
1283  vel = ( f2h(ke-1,1,i_uyz) &
1284  * 0.25_rp * ( mom(ke,i,j)+mom(ke,i+1,j)+mom(ke,i,j-1)+mom(ke,i+1,j-1) ) &
1285  + f2h(ke-1,2,i_uyz) &
1286  * 0.25_rp * ( mom(ke-1,i,j)+mom(ke-1,i+1,j)+mom(ke-1,i,j-1)+mom(ke-1,i+1,j-1) ) ) &
1287  / ( f2h(ke-1,1,i_uyz) &
1288  * 0.5_rp * ( dens(ke,i,j)+dens(ke,i+1,j) ) &
1289  + f2h(ke-1,2,i_uyz) &
1290  * 0.5_rp * ( dens(ke-1,i,j)+dens(ke-1,i+1,j) ) )
1291  vel = vel * j23g(ke-1,i,j)
1292  flux(ke-1,i,j) = vel / mapf(i,j,+1) &
1293  * ( ( val(ke-1,i,j) &
1294  + 0.5_rp * phi(val(ke-2,i,j),val(ke-1,i,j),val(ke,i,j)) * ( val(ke-1,i,j)-val(ke,i,j) ) ) &
1295  * ( 0.5_rp + sign(0.5_rp,vel) ) &
1296  + val(ke,i,j) &
1297  * ( 0.5_rp - sign(0.5_rp,vel) ) )
1298 
1299  flux(ke ,i,j) = 0.0_rp
1300  enddo
1301  enddo
1302  !$omp end do nowait
1303 
1304 
1305  end if
1306 
1307 
1308  !$omp end parallel
1309  return
1310  end subroutine atmos_dyn_fvm_fluxj23_uyz_ud3koren1993
1311 
1312  !-----------------------------------------------------------------------------
1314  subroutine atmos_dyn_fvm_fluxx_uyz_ud3koren1993( &
1315  flux, &
1316  mom, val, DENS, &
1317  GSQRT, MAPF, &
1318  num_diff, &
1319  CDZ, TwoD, &
1320  IIS, IIE, JJS, JJE )
1321  implicit none
1322 
1323  real(rp), intent(inout) :: flux (ka,ia,ja)
1324  real(rp), intent(in) :: mom (ka,ia,ja)
1325  real(rp), intent(in) :: val (ka,ia,ja)
1326  real(rp), intent(in) :: dens (ka,ia,ja)
1327  real(rp), intent(in) :: gsqrt (ka,ia,ja)
1328  real(rp), intent(in) :: mapf ( ia,ja,2)
1329  real(rp), intent(in) :: num_diff(ka,ia,ja)
1330  real(rp), intent(in) :: cdz (ka)
1331  logical, intent(in) :: twod
1332  integer, intent(in) :: iis, iie, jjs, jje
1333 
1334  real(rp) :: vel
1335  integer :: k, i, j
1336  !---------------------------------------------------------------------------
1337 
1338  ! note that x-index is added by -1
1339 
1340 
1341 
1342  !$omp parallel do default(none) private(i,j,k) OMP_SCHEDULE_ collapse(2) &
1343  !$omp private(vel) &
1344  !$omp shared(JJS,JJE,IIS,IIE,KS,KE,mom,val,DENS,flux,GSQRT,MAPF,num_diff)
1345  do j = jjs, jje
1346  do i = iis, iie+1
1347  do k = ks, ke
1348 #ifdef DEBUG
1349  call check( __line__, mom(k,i ,j) )
1350  call check( __line__, mom(k,i-1,j) )
1351 
1352  call check( __line__, val(k,i-1,j) )
1353  call check( __line__, val(k,i,j) )
1354 
1355  call check( __line__, val(k,i-2,j) )
1356  call check( __line__, val(k,i+1,j) )
1357 
1358 #endif
1359  vel = ( 0.5_rp * ( mom(k,i,j)+mom(k,i-1,j) ) ) &
1360  / ( dens(k,i,j) )
1361  flux(k,i-1,j) = gsqrt(k,i,j) / mapf(i,j,+2) * vel &
1362  * ( ( val(k,i-1,j) &
1363  + 0.5_rp * phi(val(k,i,j),val(k,i-1,j),val(k,i-2,j)) * ( val(k,i-1,j)-val(k,i-2,j) ) ) &
1364  * ( 0.5_rp + sign(0.5_rp,vel) ) &
1365  + ( val(k,i,j) &
1366  + 0.5_rp * phi(val(k,i-1,j),val(k,i,j),val(k,i+1,j)) * ( val(k,i,j)-val(k,i+1,j) ) ) &
1367  * ( 0.5_rp - sign(0.5_rp,vel) ) ) &
1368  + gsqrt(k,i,j) * num_diff(k,i,j)
1369  enddo
1370  enddo
1371  enddo
1372 #ifdef DEBUG
1373  k = iundef; i = iundef; j = iundef
1374 #endif
1375 
1376 
1377 
1378  return
1379  end subroutine atmos_dyn_fvm_fluxx_uyz_ud3koren1993
1380 
1381  !-----------------------------------------------------------------------------
1383  subroutine atmos_dyn_fvm_fluxy_uyz_ud3koren1993( &
1384  flux, &
1385  mom, val, DENS, &
1386  GSQRT, MAPF, &
1387  num_diff, &
1388  CDZ, TwoD, &
1389  IIS, IIE, JJS, JJE )
1390  implicit none
1391 
1392  real(rp), intent(inout) :: flux (ka,ia,ja)
1393  real(rp), intent(in) :: mom (ka,ia,ja)
1394  real(rp), intent(in) :: val (ka,ia,ja)
1395  real(rp), intent(in) :: dens (ka,ia,ja)
1396  real(rp), intent(in) :: gsqrt (ka,ia,ja)
1397  real(rp), intent(in) :: mapf ( ia,ja,2)
1398  real(rp), intent(in) :: num_diff(ka,ia,ja)
1399  real(rp), intent(in) :: cdz (ka)
1400  logical, intent(in) :: twod
1401  integer, intent(in) :: iis, iie, jjs, jje
1402 
1403  real(rp) :: vel
1404  integer :: k, i, j
1405  !---------------------------------------------------------------------------
1406 
1407 
1408 
1409  if ( twod ) then
1410 
1411  !$omp parallel do default(none) private(i,j,k) OMP_SCHEDULE_ &
1412  !$omp private(vel) &
1413  !$omp shared(JJS,JJE,IIS,IIE,KS,KE,mom,val,DENS,flux,GSQRT,MAPF,num_diff,TwoD)
1414  do j = jjs-1, jje
1415  do k = ks, ke
1416  i = iis
1417 #ifdef DEBUG
1418  call check( __line__, mom(k,i ,j) )
1419 
1420  call check( __line__, val(k,i,j) )
1421  call check( __line__, val(k,i,j+1) )
1422 
1423  call check( __line__, val(k,i,j-1) )
1424  call check( __line__, val(k,i,j+2) )
1425 
1426 #endif
1427  vel = ( mom(k,i,j) ) &
1428  / ( 0.5_rp * ( dens(k,i,j)+dens(k,i,j+1) ) )
1429  flux(k,i,j) = gsqrt(k,i,j) / mapf(i,j,+1) * vel &
1430  * ( ( val(k,i,j) &
1431  + 0.5_rp * phi(val(k,i,j+1),val(k,i,j),val(k,i,j-1)) * ( val(k,i,j)-val(k,i,j-1) ) ) &
1432  * ( 0.5_rp + sign(0.5_rp,vel) ) &
1433  + ( val(k,i,j+1) &
1434  + 0.5_rp * phi(val(k,i,j),val(k,i,j+1),val(k,i,j+2)) * ( val(k,i,j+1)-val(k,i,j+2) ) ) &
1435  * ( 0.5_rp - sign(0.5_rp,vel) ) ) &
1436  + gsqrt(k,i,j) * num_diff(k,i,j)
1437  enddo
1438  enddo
1439 #ifdef DEBUG
1440  k = iundef; i = iundef; j = iundef
1441 #endif
1442 
1443  else
1444 
1445 
1446  !$omp parallel do default(none) private(i,j,k) OMP_SCHEDULE_ collapse(2) &
1447  !$omp private(vel) &
1448  !$omp shared(JJS,JJE,IIS,IIE,KS,KE,mom,val,DENS,flux,GSQRT,MAPF,num_diff)
1449  do j = jjs-1, jje
1450  do i = iis, iie
1451  do k = ks, ke
1452 #ifdef DEBUG
1453  call check( __line__, mom(k,i ,j) )
1454  call check( __line__, mom(k,i-1,j) )
1455 
1456  call check( __line__, val(k,i,j) )
1457  call check( __line__, val(k,i,j+1) )
1458 
1459  call check( __line__, val(k,i,j-1) )
1460  call check( __line__, val(k,i,j+2) )
1461 
1462 #endif
1463  vel = ( 0.5_rp * ( mom(k,i,j)+mom(k,i+1,j) ) ) &
1464  / ( 0.25_rp * ( dens(k,i,j)+dens(k,i+1,j)+dens(k,i,j+1)+dens(k,i+1,j+1) ) )
1465  flux(k,i,j) = gsqrt(k,i,j) / mapf(i,j,+1) * vel &
1466  * ( ( val(k,i,j) &
1467  + 0.5_rp * phi(val(k,i,j+1),val(k,i,j),val(k,i,j-1)) * ( val(k,i,j)-val(k,i,j-1) ) ) &
1468  * ( 0.5_rp + sign(0.5_rp,vel) ) &
1469  + ( val(k,i,j+1) &
1470  + 0.5_rp * phi(val(k,i,j),val(k,i,j+1),val(k,i,j+2)) * ( val(k,i,j+1)-val(k,i,j+2) ) ) &
1471  * ( 0.5_rp - sign(0.5_rp,vel) ) ) &
1472  + gsqrt(k,i,j) * num_diff(k,i,j)
1473  enddo
1474  enddo
1475  enddo
1476 #ifdef DEBUG
1477  k = iundef; i = iundef; j = iundef
1478 #endif
1479 
1480 
1481  end if
1482 
1483 
1484  return
1485  end subroutine atmos_dyn_fvm_fluxy_uyz_ud3koren1993
1486 
1487 
1488 
1489  !-----------------------------------------------------------------------------
1491  subroutine atmos_dyn_fvm_fluxz_xvz_ud3koren1993( &
1492  flux, &
1493  mom, val, DENS, &
1494  GSQRT, J33G, &
1495  num_diff, &
1496  CDZ, TwoD, &
1497  IIS, IIE, JJS, JJE )
1498  implicit none
1499 
1500  real(rp), intent(inout) :: flux (ka,ia,ja)
1501  real(rp), intent(in) :: mom (ka,ia,ja)
1502  real(rp), intent(in) :: val (ka,ia,ja)
1503  real(rp), intent(in) :: dens (ka,ia,ja)
1504  real(rp), intent(in) :: gsqrt (ka,ia,ja)
1505  real(rp), intent(in) :: j33g
1506  real(rp), intent(in) :: num_diff(ka,ia,ja)
1507  real(rp), intent(in) :: cdz (ka)
1508  logical, intent(in) :: twod
1509  integer, intent(in) :: iis, iie, jjs, jje
1510 
1511  real(rp) :: vel
1512  integer :: k, i, j
1513  !---------------------------------------------------------------------------
1514 
1515  !$omp parallel default(none) private(i,j,k,vel) &
1516  !$omp shared(JJS,JJE,IIS,IIE,KS,KE,mom,val,DENS,flux,J33G,GSQRT,num_diff) &
1517  !$omp shared(CDZ,TwoD)
1518 
1519 
1520  !$omp do OMP_SCHEDULE_ collapse(2)
1521  do j = jjs, jje
1522  do i = iis, iie
1523  do k = ks+1, ke-2
1524 #ifdef DEBUG
1525  call check( __line__, mom(k,i,j) )
1526  call check( __line__, mom(k,i,j+1) )
1527 
1528  call check( __line__, val(k,i,j) )
1529  call check( __line__, val(k+1,i,j) )
1530 
1531  call check( __line__, val(k-1,i,j) )
1532  call check( __line__, val(k+2,i,j) )
1533 
1534 #endif
1535  vel = ( 0.5_rp * ( mom(k,i,j)+mom(k,i,j+1) ) ) &
1536  / ( f2h(k,1,i_xvz) &
1537  * 0.5_rp * ( dens(k+1,i,j)+dens(k+1,i,j+1) ) &
1538  + f2h(k,2,i_xvz) &
1539  * 0.5_rp * ( dens(k,i,j)+dens(k,i,j+1) ) )
1540  flux(k,i,j) = j33g * vel &
1541  * ( ( val(k,i,j) &
1542  + 0.5_rp * phi(val(k+1,i,j),val(k,i,j),val(k-1,i,j)) * ( val(k,i,j)-val(k-1,i,j) ) ) &
1543  * ( 0.5_rp + sign(0.5_rp,vel) ) &
1544  + ( val(k+1,i,j) &
1545  + 0.5_rp * phi(val(k,i,j),val(k+1,i,j),val(k+2,i,j)) * ( val(k+1,i,j)-val(k+2,i,j) ) ) &
1546  * ( 0.5_rp - sign(0.5_rp,vel) ) ) &
1547  + gsqrt(k,i,j) * num_diff(k,i,j)
1548  enddo
1549  enddo
1550  enddo
1551  !$omp end do nowait
1552 #ifdef DEBUG
1553  k = iundef; i = iundef; j = iundef
1554 #endif
1555 
1556  !$omp do OMP_SCHEDULE_ collapse(2)
1557  do j = jjs, jje
1558  do i = iis, iie
1559 #ifdef DEBUG
1560 
1561  call check( __line__, mom(ks,i ,j) )
1562  call check( __line__, mom(ks,i,j+1) )
1563  call check( __line__, val(ks+1,i,j) )
1564  call check( __line__, val(ks,i,j) )
1565 
1566 #endif
1567  ! The boundary condition is qflx_hi + qflxJ13 + qfluxJ23 = 0 at KS-1.
1568  ! The flux at KS-1 can be non-zero.
1569  ! To reduce calculations, all the fluxes are set to zero.
1570  flux(ks-1,i,j) = 0.0_rp
1571 
1572  vel = ( 0.5_rp * ( mom(ks,i,j)+mom(ks,i,j+1) ) ) &
1573  / ( f2h(ks,1,i_xvz) &
1574  * 0.5_rp * ( dens(ks+1,i,j)+dens(ks+1,i,j+1) ) &
1575  + f2h(ks,2,i_xvz) &
1576  * 0.5_rp * ( dens(ks,i,j)+dens(ks,i,j+1) ) )
1577  flux(ks,i,j) = j33g * vel &
1578  * ( val(ks,i,j) &
1579  * ( 0.5_rp + sign(0.5_rp,vel) ) &
1580  + ( val(ks+1,i,j) &
1581  + 0.5_rp * phi(val(ks,i,j),val(ks+1,i,j),val(ks+2,i,j)) * ( val(ks+1,i,j)-val(ks+2,i,j) ) ) &
1582  * ( 0.5_rp - sign(0.5_rp,vel) ) ) &
1583  + gsqrt(ks,i,j) * num_diff(ks,i,j)
1584  vel = ( 0.5_rp * ( mom(ke-1,i,j)+mom(ke-1,i,j+1) ) ) &
1585  / ( f2h(ke-1,1,i_xvz) &
1586  * 0.5_rp * ( dens(ke,i,j)+dens(ke,i,j+1) ) &
1587  + f2h(ke-1,2,i_xvz) &
1588  * 0.5_rp * ( dens(ke-1,i,j)+dens(ke-1,i,j+1) ) )
1589  flux(ke-1,i,j) = j33g * vel &
1590  * ( ( val(ke-1,i,j) &
1591  + 0.5_rp * phi(val(ke-2,i,j),val(ke-1,i,j),val(ke,i,j)) * ( val(ke-1,i,j)-val(ke,i,j) ) ) &
1592  * ( 0.5_rp + sign(0.5_rp,vel) ) &
1593  + val(ke,i,j) &
1594  * ( 0.5_rp - sign(0.5_rp,vel) ) ) &
1595  + gsqrt(ke-1,i,j) * num_diff(ke-1,i,j)
1596 
1597  flux(ke,i,j) = 0.0_rp
1598  enddo
1599  enddo
1600  !$omp end do nowait
1601 
1602 
1603  !$omp end parallel
1604 #ifdef DEBUG
1605  k = iundef; i = iundef; j = iundef
1606 #endif
1607 
1608  return
1609  end subroutine atmos_dyn_fvm_fluxz_xvz_ud3koren1993
1610 
1611  !-----------------------------------------------------------------------------
1613  subroutine atmos_dyn_fvm_fluxj13_xvz_ud3koren1993( &
1614  flux, &
1615  mom, val, DENS, &
1616  GSQRT, J13G, MAPF, &
1617  CDZ, TwoD, &
1618  IIS, IIE, JJS, JJE )
1619  implicit none
1620 
1621  real(rp), intent(inout) :: flux (ka,ia,ja)
1622  real(rp), intent(in) :: mom (ka,ia,ja)
1623  real(rp), intent(in) :: val (ka,ia,ja)
1624  real(rp), intent(in) :: dens (ka,ia,ja)
1625  real(rp), intent(in) :: gsqrt (ka,ia,ja)
1626  real(rp), intent(in) :: j13g (ka,ia,ja)
1627  real(rp), intent(in) :: mapf ( ia,ja,2)
1628  real(rp), intent(in) :: cdz (ka)
1629  logical, intent(in) :: twod
1630  integer, intent(in) :: iis, iie, jjs, jje
1631 
1632  real(rp) :: vel
1633  integer :: k, i, j
1634  !---------------------------------------------------------------------------
1635 
1636  !$omp parallel default(none) private(i,j,k,vel) &
1637  !$omp shared(JJS,JJE,IIS,IIE,KS,KE,mom,val,DENS,flux,J13G,MAPF) &
1638  !$omp shared(GSQRT,CDZ,TwoD)
1639 
1640 
1641 
1642  !$omp do OMP_SCHEDULE_ collapse(2)
1643  do j = jjs, jje
1644  do i = iis, iie
1645  do k = ks+1, ke-2
1646  vel = ( f2h(k,1,i_xvz) &
1647  * 0.25_rp * ( mom(k+1,i,j)+mom(k+1,i-1,j)+mom(k+1,i,j+1)+mom(k+1,i-1,j+1) ) &
1648  + f2h(k,2,i_xvz) &
1649  * 0.25_rp * ( mom(k,i,j)+mom(k,i-1,j)+mom(k,i,j+1)+mom(k,i-1,j+1) ) ) &
1650  / ( f2h(k,1,i_xvz) &
1651  * 0.5_rp * ( dens(k+1,i,j)+dens(k+1,i,j+1) ) &
1652  + f2h(k,2,i_xvz) &
1653  * 0.5_rp * ( dens(k,i,j)+dens(k,i,j+1) ) )
1654  vel = vel * j13g(k,i,j)
1655  flux(k,i,j) = vel / mapf(i,j,+2) &
1656  * ( ( val(k,i,j) &
1657  + 0.5_rp * phi(val(k+1,i,j),val(k,i,j),val(k-1,i,j)) * ( val(k,i,j)-val(k-1,i,j) ) ) &
1658  * ( 0.5_rp + sign(0.5_rp,vel) ) &
1659  + ( val(k+1,i,j) &
1660  + 0.5_rp * phi(val(k,i,j),val(k+1,i,j),val(k+2,i,j)) * ( val(k+1,i,j)-val(k+2,i,j) ) ) &
1661  * ( 0.5_rp - sign(0.5_rp,vel) ) )
1662  enddo
1663  enddo
1664  enddo
1665  !$omp end do nowait
1666 
1667  !$omp do OMP_SCHEDULE_ collapse(2)
1668  do j = jjs, jje
1669  do i = iis, iie
1670  ! The boundary condition is qflx_hi + qflxJ13 + qfluxJ23 = 0 at KS-1.
1671  ! The flux at KS-1 can be non-zero.
1672  ! To reduce calculations, all the fluxes are set to zero.
1673  flux(ks-1,i,j) = 0.0_rp
1674 
1675  vel = ( f2h(ks,1,i_xvz) &
1676  * 0.25_rp * ( mom(ks+1,i,j)+mom(ks+1,i-1,j)+mom(ks+1,i,j+1)+mom(ks+1,i-1,j+1) ) &
1677  + f2h(ks,2,i_xvz) &
1678  * 0.25_rp * ( mom(ks,i,j)+mom(ks,i-1,j)+mom(ks,i,j+1)+mom(ks,i-1,j+1) ) ) &
1679  / ( f2h(ks,1,i_xvz) &
1680  * 0.5_rp * ( dens(ks+1,i,j)+dens(ks+1,i,j+1) ) &
1681  + f2h(ks,2,i_xvz) &
1682  * 0.5_rp * ( dens(ks,i,j)+dens(ks,i,j+1) ) )
1683  vel = vel * j13g(ks,i,j)
1684  flux(ks,i,j) = vel / mapf(i,j,+2) &
1685  * ( val(ks,i,j) &
1686  * ( 0.5_rp + sign(0.5_rp,vel) ) &
1687  + ( val(ks+1,i,j) &
1688  + 0.5_rp * phi(val(ks,i,j),val(ks+1,i,j),val(ks+2,i,j)) * ( val(ks+1,i,j)-val(ks+2,i,j) ) ) &
1689  * ( 0.5_rp - sign(0.5_rp,vel) ) )
1690 
1691  vel = ( f2h(ke-1,1,i_xvz) &
1692  * 0.25_rp * ( mom(ke,i,j)+mom(ke,i-1,j)+mom(ke,i,j+1)+mom(ke,i-1,j+1) ) &
1693  + f2h(ke-1,2,i_xvz) &
1694  * 0.25_rp * ( mom(ke-1,i,j)+mom(ke-1,i-1,j)+mom(ke-1,i,j+1)+mom(ke-1,i-1,j+1) ) ) &
1695  / ( f2h(ke-1,1,i_xvz) &
1696  * 0.5_rp * ( dens(ke,i,j)+dens(ke,i,j+1) ) &
1697  + f2h(ke-1,2,i_xvz) &
1698  * 0.5_rp * ( dens(ke-1,i,j)+dens(ke-1,i,j+1) ) )
1699  vel = vel * j13g(ke-1,i,j)
1700  flux(ke-1,i,j) = vel / mapf(i,j,+2) &
1701  * ( ( val(ke-1,i,j) &
1702  + 0.5_rp * phi(val(ke-2,i,j),val(ke-1,i,j),val(ke,i,j)) * ( val(ke-1,i,j)-val(ke,i,j) ) ) &
1703  * ( 0.5_rp + sign(0.5_rp,vel) ) &
1704  + val(ke,i,j) &
1705  * ( 0.5_rp - sign(0.5_rp,vel) ) )
1706 
1707  flux(ke ,i,j) = 0.0_rp
1708  enddo
1709  enddo
1710  !$omp end do nowait
1711 
1712 
1713 
1714  !$omp end parallel
1715  return
1716  end subroutine atmos_dyn_fvm_fluxj13_xvz_ud3koren1993
1717 
1718  !-----------------------------------------------------------------------------
1720  subroutine atmos_dyn_fvm_fluxj23_xvz_ud3koren1993( &
1721  flux, &
1722  mom, val, DENS, &
1723  GSQRT, J23G, MAPF, &
1724  CDZ, TwoD, &
1725  IIS, IIE, JJS, JJE )
1726  implicit none
1727 
1728  real(rp), intent(inout) :: flux (ka,ia,ja)
1729  real(rp), intent(in) :: mom (ka,ia,ja)
1730  real(rp), intent(in) :: val (ka,ia,ja)
1731  real(rp), intent(in) :: dens (ka,ia,ja)
1732  real(rp), intent(in) :: gsqrt (ka,ia,ja)
1733  real(rp), intent(in) :: j23g (ka,ia,ja)
1734  real(rp), intent(in) :: mapf ( ia,ja,2)
1735  real(rp), intent(in) :: cdz (ka)
1736  logical, intent(in) :: twod
1737  integer, intent(in) :: iis, iie, jjs, jje
1738 
1739  real(rp) :: vel
1740  integer :: k, i, j
1741  !---------------------------------------------------------------------------
1742 
1743  !$omp parallel default(none) private(i,j,k,vel) &
1744  !$omp shared(JJS,JJE,IIS,IIE,KS,KE,mom,val,DENS,flux,J23G,MAPF) &
1745  !$omp shared(GSQRT,CDZ,TwoD)
1746 
1747 
1748 
1749  !$omp do OMP_SCHEDULE_ collapse(2)
1750  do j = jjs, jje
1751  do i = iis, iie
1752  do k = ks+1, ke-2
1753  vel = ( f2h(k,1,i_xvz) &
1754  * mom(k+1,i,j) &
1755  + f2h(k,2,i_xvz) &
1756  * mom(k,i,j) ) &
1757  / ( f2h(k,1,i_xvz) &
1758  * 0.5_rp * ( dens(k+1,i,j)+dens(k+1,i,j+1) ) &
1759  + f2h(k,2,i_xvz) &
1760  * 0.5_rp * ( dens(k,i,j)+dens(k,i,j+1) ) )
1761  vel = vel * j23g(k,i,j)
1762  flux(k,i,j) = vel / mapf(i,j,+1) &
1763  * ( ( val(k,i,j) &
1764  + 0.5_rp * phi(val(k+1,i,j),val(k,i,j),val(k-1,i,j)) * ( val(k,i,j)-val(k-1,i,j) ) ) &
1765  * ( 0.5_rp + sign(0.5_rp,vel) ) &
1766  + ( val(k+1,i,j) &
1767  + 0.5_rp * phi(val(k,i,j),val(k+1,i,j),val(k+2,i,j)) * ( val(k+1,i,j)-val(k+2,i,j) ) ) &
1768  * ( 0.5_rp - sign(0.5_rp,vel) ) )
1769  enddo
1770  enddo
1771  enddo
1772  !$omp end do nowait
1773 
1774  !$omp do OMP_SCHEDULE_ collapse(2)
1775  do j = jjs, jje
1776  do i = iis, iie
1777  ! The boundary condition is qflx_hi + qflxJ13 + qfluxJ23 = 0 at KS-1.
1778  ! The flux at KS-1 can be non-zero.
1779  ! To reduce calculations, all the fluxes are set to zero.
1780  flux(ks-1,i,j) = 0.0_rp
1781 
1782  vel = ( f2h(ks,1,i_xvz) &
1783  * mom(ks+1,i,j) &
1784  + f2h(ks,2,i_xvz) &
1785  * mom(ks,i,j) ) &
1786  / ( f2h(ks,1,i_xvz) &
1787  * 0.5_rp * ( dens(ks+1,i,j)+dens(ks+1,i,j+1) ) &
1788  + f2h(ks,2,i_xvz) &
1789  * 0.5_rp * ( dens(ks,i,j)+dens(ks,i,j+1) ) )
1790  vel = vel * j23g(ks,i,j)
1791  flux(ks,i,j) = vel / mapf(i,j,+1) &
1792  * ( val(ks,i,j) &
1793  * ( 0.5_rp + sign(0.5_rp,vel) ) &
1794  + ( val(ks+1,i,j) &
1795  + 0.5_rp * phi(val(ks,i,j),val(ks+1,i,j),val(ks+2,i,j)) * ( val(ks+1,i,j)-val(ks+2,i,j) ) ) &
1796  * ( 0.5_rp - sign(0.5_rp,vel) ) )
1797 
1798  vel = ( f2h(ke-1,1,i_xvz) &
1799  * mom(ke,i,j) &
1800  + f2h(ke-1,2,i_xvz) &
1801  * mom(ke-1,i,j) ) &
1802  / ( f2h(ke-1,1,i_xvz) &
1803  * 0.5_rp * ( dens(ke,i,j)+dens(ke,i,j+1) ) &
1804  + f2h(ke-1,2,i_xvz) &
1805  * 0.5_rp * ( dens(ke-1,i,j)+dens(ke-1,i,j+1) ) )
1806  vel = vel * j23g(ke-1,i,j)
1807  flux(ke-1,i,j) = vel / mapf(i,j,+1) &
1808  * ( ( val(ke-1,i,j) &
1809  + 0.5_rp * phi(val(ke-2,i,j),val(ke-1,i,j),val(ke,i,j)) * ( val(ke-1,i,j)-val(ke,i,j) ) ) &
1810  * ( 0.5_rp + sign(0.5_rp,vel) ) &
1811  + val(ke,i,j) &
1812  * ( 0.5_rp - sign(0.5_rp,vel) ) )
1813 
1814  flux(ke ,i,j) = 0.0_rp
1815  enddo
1816  enddo
1817  !$omp end do nowait
1818 
1819 
1820 
1821  !$omp end parallel
1822  return
1823  end subroutine atmos_dyn_fvm_fluxj23_xvz_ud3koren1993
1824 
1825  !-----------------------------------------------------------------------------
1827  subroutine atmos_dyn_fvm_fluxx_xvz_ud3koren1993( &
1828  flux, &
1829  mom, val, DENS, &
1830  GSQRT, MAPF, &
1831  num_diff, &
1832  CDZ, TwoD, &
1833  IIS, IIE, JJS, JJE )
1834  implicit none
1835 
1836  real(rp), intent(inout) :: flux (ka,ia,ja)
1837  real(rp), intent(in) :: mom (ka,ia,ja)
1838  real(rp), intent(in) :: val (ka,ia,ja)
1839  real(rp), intent(in) :: dens (ka,ia,ja)
1840  real(rp), intent(in) :: gsqrt (ka,ia,ja)
1841  real(rp), intent(in) :: mapf ( ia,ja,2)
1842  real(rp), intent(in) :: num_diff(ka,ia,ja)
1843  real(rp), intent(in) :: cdz (ka)
1844  logical, intent(in) :: twod
1845  integer, intent(in) :: iis, iie, jjs, jje
1846 
1847  real(rp) :: vel
1848  integer :: k, i, j
1849  !---------------------------------------------------------------------------
1850 
1851 
1852 
1853  !$omp parallel do default(none) private(i,j,k) OMP_SCHEDULE_ collapse(2) &
1854  !$omp private(vel) &
1855  !$omp shared(JJS,JJE,IIS,IIE,KS,KE,mom,val,DENS,flux,GSQRT,MAPF,num_diff)
1856  do j = jjs, jje
1857  do i = iis-1, iie
1858  do k = ks, ke
1859 #ifdef DEBUG
1860  call check( __line__, mom(k,i ,j) )
1861  call check( __line__, mom(k,i,j-1) )
1862 
1863  call check( __line__, val(k,i,j) )
1864  call check( __line__, val(k,i+1,j) )
1865 
1866  call check( __line__, val(k,i-1,j) )
1867  call check( __line__, val(k,i+2,j) )
1868 
1869 #endif
1870  vel = ( 0.5_rp * ( mom(k,i,j)+mom(k,i,j+1) ) ) &
1871  / ( 0.25_rp * ( dens(k,i,j)+dens(k,i+1,j)+dens(k,i,j+1)+dens(k,i+1,j+1) ) )
1872  flux(k,i,j) = gsqrt(k,i,j) / mapf(i,j,+2) * vel &
1873  * ( ( val(k,i,j) &
1874  + 0.5_rp * phi(val(k,i+1,j),val(k,i,j),val(k,i-1,j)) * ( val(k,i,j)-val(k,i-1,j) ) ) &
1875  * ( 0.5_rp + sign(0.5_rp,vel) ) &
1876  + ( val(k,i+1,j) &
1877  + 0.5_rp * phi(val(k,i,j),val(k,i+1,j),val(k,i+2,j)) * ( val(k,i+1,j)-val(k,i+2,j) ) ) &
1878  * ( 0.5_rp - sign(0.5_rp,vel) ) ) &
1879  + gsqrt(k,i,j) * num_diff(k,i,j)
1880  enddo
1881  enddo
1882  enddo
1883 #ifdef DEBUG
1884  k = iundef; i = iundef; j = iundef
1885 #endif
1886 
1887 
1888 
1889  return
1890  end subroutine atmos_dyn_fvm_fluxx_xvz_ud3koren1993
1891 
1892  !-----------------------------------------------------------------------------
1894  subroutine atmos_dyn_fvm_fluxy_xvz_ud3koren1993( &
1895  flux, &
1896  mom, val, DENS, &
1897  GSQRT, MAPF, &
1898  num_diff, &
1899  CDZ, TwoD, &
1900  IIS, IIE, JJS, JJE )
1901  implicit none
1902 
1903  real(rp), intent(inout) :: flux (ka,ia,ja)
1904  real(rp), intent(in) :: mom (ka,ia,ja)
1905  real(rp), intent(in) :: val (ka,ia,ja)
1906  real(rp), intent(in) :: dens (ka,ia,ja)
1907  real(rp), intent(in) :: gsqrt (ka,ia,ja)
1908  real(rp), intent(in) :: mapf ( ia,ja,2)
1909  real(rp), intent(in) :: num_diff(ka,ia,ja)
1910  real(rp), intent(in) :: cdz (ka)
1911  logical, intent(in) :: twod
1912  integer, intent(in) :: iis, iie, jjs, jje
1913 
1914  real(rp) :: vel
1915  integer :: k, i, j
1916  !---------------------------------------------------------------------------
1917 
1918  ! note that y-index is added by -1
1919 
1920 
1921 
1922  !$omp parallel do default(none) private(i,j,k) OMP_SCHEDULE_ collapse(2) &
1923  !$omp private(vel) &
1924  !$omp shared(JJS,JJE,IIS,IIE,KS,KE,mom,val,DENS,flux,GSQRT,MAPF,num_diff)
1925  do j = jjs, jje+1
1926  do i = iis, iie
1927  do k = ks, ke
1928 #ifdef DEBUG
1929  call check( __line__, mom(k,i ,j) )
1930  call check( __line__, mom(k,i,j-1) )
1931 
1932  call check( __line__, val(k,i,j-1) )
1933  call check( __line__, val(k,i,j) )
1934 
1935  call check( __line__, val(k,i,j-2) )
1936  call check( __line__, val(k,i,j+1) )
1937 
1938 #endif
1939  vel = ( 0.5_rp * ( mom(k,i,j)+mom(k,i,j-1) ) ) &
1940  / ( dens(k,i,j) )
1941  flux(k,i,j-1) = gsqrt(k,i,j) / mapf(i,j,+1) * vel &
1942  * ( ( val(k,i,j-1) &
1943  + 0.5_rp * phi(val(k,i,j),val(k,i,j-1),val(k,i,j-2)) * ( val(k,i,j-1)-val(k,i,j-2) ) ) &
1944  * ( 0.5_rp + sign(0.5_rp,vel) ) &
1945  + ( val(k,i,j) &
1946  + 0.5_rp * phi(val(k,i,j-1),val(k,i,j),val(k,i,j+1)) * ( val(k,i,j)-val(k,i,j+1) ) ) &
1947  * ( 0.5_rp - sign(0.5_rp,vel) ) ) &
1948  + gsqrt(k,i,j) * num_diff(k,i,j)
1949  enddo
1950  enddo
1951  enddo
1952 #ifdef DEBUG
1953  k = iundef; i = iundef; j = iundef
1954 #endif
1955 
1956 
1957 
1958  return
1959  end subroutine atmos_dyn_fvm_fluxy_xvz_ud3koren1993
1960 
1961 
1962 
1963 
1964 
1965 
1966  !-----------------------------------------------------------------------------
1967  function phi(v1, v2, v3)
1968  use scale_const, only: &
1969  eps => const_eps
1970  implicit none
1971 
1972  real(rp) :: phi
1973  real(rp), intent(in) :: v1
1974  real(rp), intent(in) :: v2
1975  real(rp), intent(in) :: v3
1976 
1977  real(rp) :: r2
1978  real(rp) :: zerosw1, zerosw2
1979  !---------------------------------------------------------------------------
1980 
1981  zerosw1 = eps - sign(eps, abs(v1-v2)-eps)
1982  zerosw2 = eps - sign(eps, abs(v2-v3)-eps)
1983  r2 = 2.0_rp * (v1-v2+zerosw1*zerosw2) / (v2-v3+zerosw2)
1984 
1985  phi = max(0.0_rp, min(r2, min((1.0_rp+r2)/3.0_rp, 2.0_rp) ) )
1986 
1987  end function phi
1988 
1989 
1990 end module scale_atmos_dyn_fvm_flux_ud3koren1993
1991 
1992 !--
1993 ! vi:set readonly sw=4 ts=8
1994 !
1995 !Local Variables:
1996 !mode: f90
1997 !buffer-read-only: t
1998 !End:
1999 !
2000 !++
scale_atmos_dyn_fvm_flux_ud3koren1993::atmos_dyn_fvm_fluxz_xyz_ud3koren1993
subroutine, public atmos_dyn_fvm_fluxz_xyz_ud3koren1993(flux, mflx, val, GSQRT, num_diff, CDZ, IIS, IIE, JJS, JJE)
calculation z-flux at XYZ
Definition: scale_atmos_dyn_fvm_flux_ud3Koren1993.F90:170
scale_atmos_grid_cartesc_index::ke
integer, public ke
end point of inner domain: z, local
Definition: scale_atmos_grid_cartesC_index.F90:52
scale_index
module Index
Definition: scale_index.F90:11
scale_const::const_undef2
integer, parameter, public const_undef2
undefined value (INT2)
Definition: scale_const.F90:38
scale_atmos_dyn_fvm_flux_ud3koren1993
module scale_atmos_dyn_fvm_flux_ud3Koren1993
Definition: scale_atmos_dyn_fvm_flux_ud3Koren1993.F90:16
scale_atmos_dyn_fvm_flux_ud3koren1993::atmos_dyn_fvm_fluxj23_uyz_ud3koren1993
subroutine, public atmos_dyn_fvm_fluxj23_uyz_ud3koren1993(flux, mom, val, DENS, GSQRT, J23G, MAPF, CDZ, TwoD, IIS, IIE, JJS, JJE)
calculation J23-flux at UYZ
Definition: scale_atmos_dyn_fvm_flux_ud3Koren1993.F90:1140
scale_precision
module PRECISION
Definition: scale_precision.F90:14
scale_atmos_grid_cartesc_index::ka
integer, public ka
Definition: scale_atmos_grid_cartesC_index.F90:47
scale_atmos_dyn_fvm_flux_ud3koren1993::atmos_dyn_fvm_fluxj13_xvz_ud3koren1993
subroutine, public atmos_dyn_fvm_fluxj13_xvz_ud3koren1993(flux, mom, val, DENS, GSQRT, J13G, MAPF, CDZ, TwoD, IIS, IIE, JJS, JJE)
calculation J13-flux at XVZ
Definition: scale_atmos_dyn_fvm_flux_ud3Koren1993.F90:1619
scale_atmos_dyn_fvm_flux_ud3koren1993::atmos_dyn_fvm_fluxz_xvz_ud3koren1993
subroutine, public atmos_dyn_fvm_fluxz_xvz_ud3koren1993(flux, mom, val, DENS, GSQRT, J33G, num_diff, CDZ, TwoD, IIS, IIE, JJS, JJE)
calculation z-flux at XV
Definition: scale_atmos_dyn_fvm_flux_ud3Koren1993.F90:1498
scale_const::const_eps
real(rp), public const_eps
small number
Definition: scale_const.F90:33
scale_atmos_dyn_fvm_flux_ud3koren1993::atmos_dyn_fvm_fluxz_xyw_ud3koren1993
subroutine, public atmos_dyn_fvm_fluxz_xyw_ud3koren1993(flux, mom, val, DENS, GSQRT, J33G, num_diff, CDZ, FDZ, dtrk, IIS, IIE, JJS, JJE)
calculation z-flux at XYW
Definition: scale_atmos_dyn_fvm_flux_ud3Koren1993.F90:390
scale_atmos_dyn_fvm_flux_ud3koren1993::atmos_dyn_fvm_fluxx_xyw_ud3koren1993
subroutine, public atmos_dyn_fvm_fluxx_xyw_ud3koren1993(flux, mom, val, DENS, GSQRT, MAPF, num_diff, CDZ, TwoD, IIS, IIE, JJS, JJE)
calculation X-flux at XYW
Definition: scale_atmos_dyn_fvm_flux_ud3Koren1993.F90:656
scale_atmos_dyn_fvm_flux_ud3koren1993::atmos_dyn_fvm_fluxj13_uyz_ud3koren1993
subroutine, public atmos_dyn_fvm_fluxj13_uyz_ud3koren1993(flux, mom, val, DENS, GSQRT, J13G, MAPF, CDZ, TwoD, IIS, IIE, JJS, JJE)
calculation J13-flux at UYZ
Definition: scale_atmos_dyn_fvm_flux_ud3Koren1993.F90:1033
scale_atmos_grid_cartesc_index::i_xyz
integer, public i_xyz
Definition: scale_atmos_grid_cartesC_index.F90:90
scale_prc
module PROCESS
Definition: scale_prc.F90:11
scale_atmos_dyn_fvm_flux_ud3koren1993::atmos_dyn_fvm_fluxy_uyz_ud3koren1993
subroutine, public atmos_dyn_fvm_fluxy_uyz_ud3koren1993(flux, mom, val, DENS, GSQRT, MAPF, num_diff, CDZ, TwoD, IIS, IIE, JJS, JJE)
calculation Y-flux at UY
Definition: scale_atmos_dyn_fvm_flux_ud3Koren1993.F90:1390
scale_atmos_grid_cartesc_index::i_uyz
integer, public i_uyz
Definition: scale_atmos_grid_cartesC_index.F90:94
scale_io
module STDIO
Definition: scale_io.F90:10
scale_atmos_dyn_fvm_flux_ud3koren1993::atmos_dyn_fvm_fluxz_uyz_ud3koren1993
subroutine, public atmos_dyn_fvm_fluxz_uyz_ud3koren1993(flux, mom, val, DENS, GSQRT, J33G, num_diff, CDZ, TwoD, IIS, IIE, JJS, JJE)
calculation z-flux at UY
Definition: scale_atmos_dyn_fvm_flux_ud3Koren1993.F90:827
scale_atmos_dyn_fvm_flux_ud3koren1993::atmos_dyn_fvm_fluxy_xyz_ud3koren1993
subroutine, public atmos_dyn_fvm_fluxy_xyz_ud3koren1993(flux, mflx, val, GSQRT, num_diff, CDZ, IIS, IIE, JJS, JJE)
calculation Y-flux at XYZ
Definition: scale_atmos_dyn_fvm_flux_ud3Koren1993.F90:330
scale_tracer::k
real(rp), public k
Definition: scale_tracer.F90:44
scale_atmos_grid_cartesc_index
module atmosphere / grid / cartesC index
Definition: scale_atmos_grid_cartesC_index.F90:12
scale_const
module CONSTANT
Definition: scale_const.F90:11
scale_atmos_grid_cartesc_index::ia
integer, public ia
Definition: scale_atmos_grid_cartesC_index.F90:48
scale_debug::check
subroutine, public check(current_line, v)
Undefined value checker.
Definition: scale_debug.F90:56
scale_atmos_dyn_fvm_flux_ud3koren1993::atmos_dyn_fvm_fluxj23_xvz_ud3koren1993
subroutine, public atmos_dyn_fvm_fluxj23_xvz_ud3koren1993(flux, mom, val, DENS, GSQRT, J23G, MAPF, CDZ, TwoD, IIS, IIE, JJS, JJE)
calculation J23-flux at XVZ
Definition: scale_atmos_dyn_fvm_flux_ud3Koren1993.F90:1726
scale_atmos_grid_cartesc_index::i_xvz
integer, public i_xvz
Definition: scale_atmos_grid_cartesC_index.F90:95
scale_prof
module profiler
Definition: scale_prof.F90:11
scale_atmos_dyn_fvm_flux_ud3koren1993::atmos_dyn_fvm_fluxy_xyw_ud3koren1993
subroutine, public atmos_dyn_fvm_fluxy_xyw_ud3koren1993(flux, mom, val, DENS, GSQRT, MAPF, num_diff, CDZ, TwoD, IIS, IIE, JJS, JJE)
calculation Y-flux at XYW
Definition: scale_atmos_dyn_fvm_flux_ud3Koren1993.F90:741
scale_atmos_grid_cartesc_index::ja
integer, public ja
Definition: scale_atmos_grid_cartesC_index.F90:49
scale_tracer
module TRACER
Definition: scale_tracer.F90:12
scale_atmos_dyn_fvm_flux_ud3koren1993::atmos_dyn_fvm_flux_valuew_z_ud3koren1993
subroutine, public atmos_dyn_fvm_flux_valuew_z_ud3koren1993(valW, mflx, val, GSQRT, CDZ)
value at XYW
Definition: scale_atmos_dyn_fvm_flux_ud3Koren1993.F90:103
scale_atmos_dyn_fvm_flux_ud3koren1993::atmos_dyn_fvm_fluxx_xvz_ud3koren1993
subroutine, public atmos_dyn_fvm_fluxx_xvz_ud3koren1993(flux, mom, val, DENS, GSQRT, MAPF, num_diff, CDZ, TwoD, IIS, IIE, JJS, JJE)
calculation X-flux at XV
Definition: scale_atmos_dyn_fvm_flux_ud3Koren1993.F90:1834
scale_atmos_grid_cartesc_index::ks
integer, public ks
start point of inner domain: z, local
Definition: scale_atmos_grid_cartesC_index.F90:51
scale_debug
module DEBUG
Definition: scale_debug.F90:11
scale_atmos_dyn_fvm_flux_ud3koren1993::atmos_dyn_fvm_fluxx_xyz_ud3koren1993
subroutine, public atmos_dyn_fvm_fluxx_xyz_ud3koren1993(flux, mflx, val, GSQRT, num_diff, CDZ, IIS, IIE, JJS, JJE)
calculation X-flux at XYZ
Definition: scale_atmos_dyn_fvm_flux_ud3Koren1993.F90:273
scale_atmos_dyn_fvm_flux_ud3koren1993::atmos_dyn_fvm_fluxj13_xyw_ud3koren1993
subroutine, public atmos_dyn_fvm_fluxj13_xyw_ud3koren1993(flux, mom, val, DENS, GSQRT, J13G, MAPF, CDZ, TwoD, IIS, IIE, JJS, JJE)
calculation J13-flux at XYW
Definition: scale_atmos_dyn_fvm_flux_ud3Koren1993.F90:496
scale_const::const_undef
real(rp), public const_undef
Definition: scale_const.F90:41
scale_atmos_dyn_fvm_flux_ud3koren1993::atmos_dyn_fvm_fluxj23_xyw_ud3koren1993
subroutine, public atmos_dyn_fvm_fluxj23_xyw_ud3koren1993(flux, mom, val, DENS, GSQRT, J23G, MAPF, CDZ, TwoD, IIS, IIE, JJS, JJE)
calculation J23-flux at XYW
Definition: scale_atmos_dyn_fvm_flux_ud3Koren1993.F90:575
scale_atmos_dyn_fvm_flux_ud3koren1993::atmos_dyn_fvm_fluxx_uyz_ud3koren1993
subroutine, public atmos_dyn_fvm_fluxx_uyz_ud3koren1993(flux, mom, val, DENS, GSQRT, MAPF, num_diff, CDZ, TwoD, IIS, IIE, JJS, JJE)
calculation X-flux at UY
Definition: scale_atmos_dyn_fvm_flux_ud3Koren1993.F90:1321
scale_atmos_dyn_fvm_flux_ud3koren1993::atmos_dyn_fvm_fluxy_xvz_ud3koren1993
subroutine, public atmos_dyn_fvm_fluxy_xvz_ud3koren1993(flux, mom, val, DENS, GSQRT, MAPF, num_diff, CDZ, TwoD, IIS, IIE, JJS, JJE)
calculation Y-flux at XV
Definition: scale_atmos_dyn_fvm_flux_ud3Koren1993.F90:1901
Generated by   doxygen 1.8.17