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