SCALE-RM
scale_atmos_dyn_fvm_flux_ud1.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_ud1
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_ud1
46 
47  public :: atmos_dyn_fvm_fluxz_xyz_ud1
48  public :: atmos_dyn_fvm_fluxx_xyz_ud1
49  public :: atmos_dyn_fvm_fluxy_xyz_ud1
50 
51  public :: atmos_dyn_fvm_fluxz_xyw_ud1
52  public :: atmos_dyn_fvm_fluxj13_xyw_ud1
53  public :: atmos_dyn_fvm_fluxj23_xyw_ud1
54  public :: atmos_dyn_fvm_fluxx_xyw_ud1
55  public :: atmos_dyn_fvm_fluxy_xyw_ud1
56 
57  public :: atmos_dyn_fvm_fluxz_uyz_ud1
58  public :: atmos_dyn_fvm_fluxj13_uyz_ud1
59  public :: atmos_dyn_fvm_fluxj23_uyz_ud1
60  public :: atmos_dyn_fvm_fluxx_uyz_ud1
61  public :: atmos_dyn_fvm_fluxy_uyz_ud1
62 
63  public :: atmos_dyn_fvm_fluxz_xvz_ud1
64  public :: atmos_dyn_fvm_fluxj13_xvz_ud1
65  public :: atmos_dyn_fvm_fluxj23_xvz_ud1
66  public :: atmos_dyn_fvm_fluxx_xvz_ud1
67  public :: atmos_dyn_fvm_fluxy_xvz_ud1
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 :: F1 = 0.5_rp
88 
89  real(RP), parameter :: F2 = 0.5_rp ! F2 is always used to calculate flux near boundary.
90 
91 
92 
93 
94 
95 contains
96  !-----------------------------------------------------------------------------
98 !OCL SERIAL
99  subroutine atmos_dyn_fvm_flux_valuew_z_ud1( &
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, ke-1
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 #endif
122  valw(k) = f1 * ( val(k+1)+val(k) ) - sign(f1,mflx(k)) * ( val(k+1)-val(k) )
123  enddo
124 #ifdef DEBUG
125  k = iundef
126 #endif
127 
128 #ifdef DEBUG
129 
130 #endif
131 
132 
133 
134  valw(ks) = f2 * ( val(ks+1)+val(ks) )
135  valw(ke-1) = f2 * ( val(ke)+val(ke-1) )
136 
137 
138  return
139  end subroutine atmos_dyn_fvm_flux_valuew_z_ud1
140 
141  !-----------------------------------------------------------------------------
143  subroutine atmos_dyn_fvm_fluxz_xyz_ud1( &
144  flux, &
145  mflx, val, GSQRT, &
146  num_diff, &
147  CDZ, &
148  IIS, IIE, JJS, JJE )
149  implicit none
150 
151  real(RP), intent(inout) :: flux (ka,ia,ja)
152  real(RP), intent(in) :: mflx (ka,ia,ja)
153  real(RP), intent(in) :: val (ka,ia,ja)
154  real(RP), intent(in) :: gsqrt (ka,ia,ja)
155  real(RP), intent(in) :: num_diff(ka,ia,ja)
156  real(RP), intent(in) :: cdz (ka)
157  integer, intent(in) :: iis, iie, jjs, jje
158 
159  real(RP) :: vel
160  integer :: k, i, j
161  !---------------------------------------------------------------------------
162 
163  !$omp parallel do default(none) private(i,j,k) OMP_SCHEDULE_ collapse(2) &
164  !$omp private(vel) &
165  !$omp shared(JJS,JJE,IIS,IIE,KS,KE,mflx,val,flux,GSQRT,num_diff)
166  do j = jjs, jje
167  do i = iis, iie
168  do k = ks, ke-1
169 #ifdef DEBUG
170  call check( __line__, mflx(k,i,j) )
171 
172  call check( __line__, val(k,i,j) )
173  call check( __line__, val(k+1,i,j) )
174 
175 #endif
176  vel = mflx(k,i,j)
177  flux(k,i,j) = vel &
178  * ( f1 * ( val(k+1,i,j)+val(k,i,j) ) - sign(f1,vel) * ( val(k+1,i,j)-val(k,i,j) ) )
179  enddo
180  enddo
181  enddo
182 #ifdef DEBUG
183  k = iundef; i = iundef; j = iundef
184 #endif
185 
186  !$omp parallel do default(none) private(i,j) OMP_SCHEDULE_ collapse(2) &
187  !$omp private(vel) &
188  !$omp shared(JJS,JJE,IIS,IIE,KS,KE,mflx,val,flux,GSQRT,num_diff)
189  do j = jjs, jje
190  do i = iis, iie
191 #ifdef DEBUG
192 
193 #endif
194  flux(ks-1,i,j) = 0.0_rp
195 
196  flux(ke ,i,j) = 0.0_rp
197  enddo
198  enddo
199 #ifdef DEBUG
200  k = iundef; i = iundef; j = iundef
201 #endif
202 
203  return
204  end subroutine atmos_dyn_fvm_fluxz_xyz_ud1
205 
206  !-----------------------------------------------------------------------------
208  subroutine atmos_dyn_fvm_fluxx_xyz_ud1( &
209  flux, &
210  mflx, val, GSQRT, &
211  num_diff, &
212  CDZ, &
213  IIS, IIE, JJS, JJE )
214  implicit none
215 
216  real(RP), intent(inout) :: flux (ka,ia,ja)
217  real(RP), intent(in) :: mflx (ka,ia,ja)
218  real(RP), intent(in) :: val (ka,ia,ja)
219  real(RP), intent(in) :: gsqrt (ka,ia,ja)
220  real(RP), intent(in) :: num_diff(ka,ia,ja)
221  real(RP), intent(in) :: cdz(ka)
222  integer, intent(in) :: iis, iie, jjs, jje
223 
224  real(RP) :: vel
225  integer :: k, i, j
226  !---------------------------------------------------------------------------
227 
228  !$omp parallel do default(none) private(i,j,k) OMP_SCHEDULE_ collapse(2) &
229  !$omp private(vel) &
230  !$omp shared(JJS,JJE,IIS,IIE,KS,KE,mflx,val,flux,GSQRT,num_diff)
231  do j = jjs, jje
232  do i = iis-1, iie
233  do k = ks, ke
234 #ifdef DEBUG
235  call check( __line__, mflx(k,i,j) )
236 
237  call check( __line__, val(k,i,j) )
238  call check( __line__, val(k,i+1,j) )
239 
240 #endif
241  vel = mflx(k,i,j)
242  flux(k,i,j) = vel &
243  * ( f1 * ( val(k,i+1,j)+val(k,i,j) ) - sign(f1,vel) * ( val(k,i+1,j)-val(k,i,j) ) )
244  enddo
245  enddo
246  enddo
247 #ifdef DEBUG
248  k = iundef; i = iundef; j = iundef
249 #endif
250 
251  return
252  end subroutine atmos_dyn_fvm_fluxx_xyz_ud1
253 
254  !-----------------------------------------------------------------------------
256  subroutine atmos_dyn_fvm_fluxy_xyz_ud1( &
257  flux, &
258  mflx, val, GSQRT, &
259  num_diff, &
260  CDZ, &
261  IIS, IIE, JJS, JJE )
262  implicit none
263 
264  real(RP), intent(inout) :: flux (ka,ia,ja)
265  real(RP), intent(in) :: mflx (ka,ia,ja)
266  real(RP), intent(in) :: val (ka,ia,ja)
267  real(RP), intent(in) :: gsqrt (ka,ia,ja)
268  real(RP), intent(in) :: num_diff(ka,ia,ja)
269  real(RP), intent(in) :: cdz(ka)
270  integer, intent(in) :: iis, iie, jjs, jje
271 
272  real(RP) :: vel
273  integer :: k, i, j
274  !---------------------------------------------------------------------------
275 
276  !$omp parallel do default(none) private(i,j,k) OMP_SCHEDULE_ collapse(2) &
277  !$omp private(vel) &
278  !$omp shared(JJS,JJE,IIS,IIE,KS,KE,mflx,val,flux,GSQRT,num_diff)
279  do j = jjs-1, jje
280  do i = iis, iie
281  do k = ks, ke
282 #ifdef DEBUG
283  call check( __line__, mflx(k,i,j) )
284 
285  call check( __line__, val(k,i,j) )
286  call check( __line__, val(k,i,j+1) )
287 
288 #endif
289  vel = mflx(k,i,j)
290  flux(k,i,j) = vel &
291  * ( f1 * ( val(k,i,j+1)+val(k,i,j) ) - sign(f1,vel) * ( val(k,i,j+1)-val(k,i,j) ) )
292  enddo
293  enddo
294  enddo
295 #ifdef DEBUG
296  k = iundef; i = iundef; j = iundef
297 #endif
298 
299  return
300  end subroutine atmos_dyn_fvm_fluxy_xyz_ud1
301 
302 
303  !-----------------------------------------------------------------------------
305  subroutine atmos_dyn_fvm_fluxz_xyw_ud1( &
306  flux, &
307  mom, val, DENS, &
308  GSQRT, J33G, &
309  num_diff, &
310  CDZ, FDZ, &
311  dtrk, &
312  IIS, IIE, JJS, JJE )
313  implicit none
314 
315  real(RP), intent(inout) :: flux (ka,ia,ja)
316  real(RP), intent(in) :: mom (ka,ia,ja)
317  real(RP), intent(in) :: val (ka,ia,ja)
318  real(RP), intent(in) :: dens (ka,ia,ja)
319  real(RP), intent(in) :: gsqrt (ka,ia,ja)
320  real(RP), intent(in) :: j33g
321  real(RP), intent(in) :: num_diff(ka,ia,ja)
322  real(RP), intent(in) :: cdz (ka)
323  real(RP), intent(in) :: fdz (ka-1)
324  real(RP), intent(in) :: dtrk
325  integer, intent(in) :: iis, iie, jjs, jje
326 
327  real(RP) :: vel
328  integer :: k, i, j
329  !---------------------------------------------------------------------------
330 
331  ! note than z-index is added by -1
332 
333  !$omp parallel do default(none) private(i,j,k) OMP_SCHEDULE_ collapse(2) &
334  !$omp private(vel) &
335  !$omp shared(JJS,JJE,IIS,IIE,KS,KE,mom,val,flux,J33G,GSQRT,num_diff,DENS)
336  do j = jjs, jje
337  do i = iis, iie
338  do k = ks+1, ke-1
339 #ifdef DEBUG
340  call check( __line__, mom(k-1,i,j) )
341  call check( __line__, mom(k ,i,j) )
342 
343  call check( __line__, val(k-1,i,j) )
344  call check( __line__, val(k,i,j) )
345 
346 #endif
347  vel = ( 0.5_rp * ( mom(k-1,i,j) &
348  + mom(k,i,j) ) ) &
349  / dens(k,i,j)
350  flux(k-1,i,j) = j33g * vel &
351  * ( f1 * ( val(k,i,j)+val(k-1,i,j) ) - sign(f1,vel) * ( val(k,i,j)-val(k-1,i,j) ) )
352  enddo
353  enddo
354  enddo
355 #ifdef DEBUG
356  k = iundef; i = iundef; j = iundef
357 #endif
358 
359  !$omp parallel do default(none) private(i,j) OMP_SCHEDULE_ collapse(2) &
360  !$omp private(vel) &
361  !$omp shared(JJS,JJE,IIS,IIE,KS,KE,mom,val,DENS,flux,J33G,GSQRT,num_diff,FDZ,dtrk)
362  do j = jjs, jje
363  do i = iis, iie
364 #ifdef DEBUG
365 
366 
367 #endif
368  ! The boundary condition is qflx_hi + qflxJ13 + qfluxJ23 = 0 at KS.
369  ! The flux at KS can be non-zero.
370  ! To reduce calculations, all the fluxes are set to zero.
371  flux(ks-1,i,j) = 0.0_rp ! k = KS
372 
373 
374 
375  flux(ke-1,i,j) = 0.0_rp ! k = KE
376  flux(ke ,i,j) = 0.0_rp ! k = KE+1
377  enddo
378  enddo
379 
380  return
381  end subroutine atmos_dyn_fvm_fluxz_xyw_ud1
382 
383 
384  !-----------------------------------------------------------------------------
386  subroutine atmos_dyn_fvm_fluxj13_xyw_ud1( &
387  flux, &
388  mom, val, DENS, &
389  GSQRT, J13G, MAPF, &
390  CDZ, &
391  IIS, IIE, JJS, JJE )
392  implicit none
393 
394  real(RP), intent(inout) :: flux (ka,ia,ja)
395  real(RP), intent(in) :: mom (ka,ia,ja)
396  real(RP), intent(in) :: val (ka,ia,ja)
397  real(RP), intent(in) :: dens (ka,ia,ja)
398  real(RP), intent(in) :: gsqrt (ka,ia,ja)
399  real(RP), intent(in) :: j13g (ka,ia,ja)
400  real(RP), intent(in) :: mapf ( ia,ja,2)
401  real(RP), intent(in) :: cdz (ka)
402  integer, intent(in) :: iis, iie, jjs, jje
403 
404  real(RP) :: vel
405  integer :: k, i, j
406  !---------------------------------------------------------------------------
407 
408  !$omp parallel do default(none) private(i,j,k) OMP_SCHEDULE_ collapse(2) &
409  !$omp private(vel) &
410  !$omp shared(JJS,JJE,IIS,IIE,KS,KE,mom,val,DENS,flux,J13G,MAPF)
411  do j = jjs, jje
412  do i = iis, iie
413  do k = ks+2, ke-1
414  vel = ( 0.5_rp * ( mom(k,i,j)+mom(k,i-1,j) ) ) &
415  / dens(k,i,j)
416  flux(k-1,i,j) = j13g(k,i,j) / mapf(i,j,+2) * vel &
417  * ( f1 * ( val(k,i,j)+val(k-1,i,j) ) - sign(f1,vel) * ( val(k,i,j)-val(k-1,i,j) ) )
418  enddo
419  enddo
420  enddo
421 
422  !$omp parallel do default(none) private(i,j) OMP_SCHEDULE_ collapse(2) &
423  !$omp private(vel) &
424  !$omp shared(JJS,JJE,IIS,IIE,KS,KE,mom,val,DENS,flux,J13G,MAPF)
425  do j = jjs, jje
426  do i = iis, iie
427  ! The boundary condition is qflx_hi + qflxJ13 + qfluxJ23 = 0 at KS.
428  ! The flux at KS can be non-zero.
429  ! To reduce calculations, all the fluxes are set to zero.
430  flux(ks-1,i,j) = 0.0_rp ! k = KS
431 
432  ! physically incorrect but for numerical stability
433  vel = ( ( 0.5_rp * ( mom(ks+1,i,j)+mom(ks+1,i-1,j) ) ) / dens(ks+1,i,j) &
434  + ( 0.5_rp * ( mom(ks,i,j)+mom(ks,i-1,j) ) ) / dens(ks ,i,j) ) * 0.5_rp
435 ! vel = ( 0.5_RP * ( mom(KS+1,i,j)+mom(KS+1,i-1,j) ) ) &
436 ! / DENS(KS+1,i,j)
437  flux(ks,i,j) = j13g(ks+1,i,j) / mapf(i,j,+2) * vel &
438  * ( f2 * ( val(ks+1,i,j)+val(ks,i,j) ) ) ! k = KS+1
439 
440 
441  flux(ke-1,i,j) = 0.0_rp
442  enddo
443  enddo
444 
445  return
446  end subroutine atmos_dyn_fvm_fluxj13_xyw_ud1
447 
448  !-----------------------------------------------------------------------------
450  subroutine atmos_dyn_fvm_fluxj23_xyw_ud1( &
451  flux, &
452  mom, val, DENS, &
453  GSQRT, J23G, MAPF, &
454  CDZ, &
455  IIS, IIE, JJS, JJE )
456  implicit none
457 
458  real(RP), intent(inout) :: flux (ka,ia,ja)
459  real(RP), intent(in) :: mom (ka,ia,ja)
460  real(RP), intent(in) :: val (ka,ia,ja)
461  real(RP), intent(in) :: dens (ka,ia,ja)
462  real(RP), intent(in) :: gsqrt (ka,ia,ja)
463  real(RP), intent(in) :: j23g (ka,ia,ja)
464  real(RP), intent(in) :: mapf ( ia,ja,2)
465  real(RP), intent(in) :: cdz (ka)
466  integer, intent(in) :: iis, iie, jjs, jje
467 
468  real(RP) :: vel
469  integer :: k, i, j
470  !---------------------------------------------------------------------------
471 
472  !$omp parallel do default(none) private(i,j,k) OMP_SCHEDULE_ collapse(2) &
473  !$omp private(vel) &
474  !$omp shared(JJS,JJE,IIS,IIE,KS,KE,mom,val,DENS,flux,J23G,MAPF)
475  do j = jjs, jje
476  do i = iis, iie
477  do k = ks+2, ke-1
478  vel = ( 0.5_rp * ( mom(k,i,j)+mom(k,i,j-1) ) ) &
479  / dens(k,i,j)
480  flux(k-1,i,j) = j23g(k,i,j) / mapf(i,j,+1) * vel &
481  * ( f1 * ( val(k,i,j)+val(k-1,i,j) ) - sign(f1,vel) * ( val(k,i,j)-val(k-1,i,j) ) )
482  enddo
483  enddo
484  enddo
485 
486  !$omp parallel do default(none) private(i,j) OMP_SCHEDULE_ collapse(2) &
487  !$omp private(vel) &
488  !$omp shared(JJS,JJE,IIS,IIE,KS,KE,mom,val,DENS,flux,J23G,MAPF)
489  do j = jjs, jje
490  do i = iis, iie
491  ! The boundary condition is qflx_hi + qflxJ13 + qfluxJ23 = 0 at KS.
492  ! The flux at KS can be non-zero.
493  ! To reduce calculations, all the fluxes are set to zero.
494  flux(ks-1,i,j) = 0.0_rp ! k = KS
495 
496  ! physically incorrect but for numerical stability
497  vel = ( ( 0.5_rp * ( mom(ks+1,i,j)+mom(ks+1,i,j-1) ) ) / dens(ks+1,i,j) &
498  + ( 0.5_rp * ( mom(ks,i,j)+mom(ks,i,j-1) ) ) / dens(ks ,i,j) ) * 0.5_rp
499 ! vel = ( 0.5_RP * ( mom(KS+1,i,j)+mom(KS+1,i,j-1) ) ) &
500 ! / DENS(KS+1,i,j)
501  flux(ks,i,j) = j23g(ks+1,i,j) / mapf(i,j,+1) * vel &
502  * ( f2 * ( val(ks+1,i,j)+val(ks,i,j) ) ) ! k = KS+1
503 
504 
505  flux(ke-1,i,j) = 0.0_rp
506  enddo
507  enddo
508 
509  return
510  end subroutine atmos_dyn_fvm_fluxj23_xyw_ud1
511 
512 
513  !-----------------------------------------------------------------------------
515  subroutine atmos_dyn_fvm_fluxx_xyw_ud1( &
516  flux, &
517  mom, val, DENS, &
518  GSQRT, MAPF, &
519  num_diff, &
520  CDZ, &
521  IIS, IIE, JJS, JJE )
522  implicit none
523 
524  real(RP), intent(inout) :: flux (ka,ia,ja)
525  real(RP), intent(in) :: mom (ka,ia,ja)
526  real(RP), intent(in) :: val (ka,ia,ja)
527  real(RP), intent(in) :: dens (ka,ia,ja)
528  real(RP), intent(in) :: gsqrt (ka,ia,ja)
529  real(RP), intent(in) :: mapf ( ia,ja,2)
530  real(RP), intent(in) :: num_diff(ka,ia,ja)
531  real(RP), intent(in) :: cdz (ka)
532  integer, intent(in) :: iis, iie, jjs, jje
533 
534  real(RP) :: vel
535  integer :: k, i, j
536  !---------------------------------------------------------------------------
537 
538  !$omp parallel do default(none) private(i,j,k) OMP_SCHEDULE_ collapse(2) &
539  !$omp private(vel) &
540  !$omp shared(JJS,JJE,IIS,IIE,KS,KE,mom,val,DENS,flux,GSQRT,MAPF,num_diff) &
541  !$omp shared(CDZ)
542  do j = jjs, jje
543  do i = iis-1, iie
544  do k = ks, ke-1
545 #ifdef DEBUG
546  call check( __line__, mom(k ,i,j) )
547  call check( __line__, mom(k+1,i,j) )
548 
549  call check( __line__, val(k,i,j) )
550  call check( __line__, val(k,i+1,j) )
551 
552 #endif
553  vel = ( f2h(k,1,i_uyz) &
554  * mom(k+1,i,j) &
555  + f2h(k,2,i_uyz) &
556  * mom(k,i,j) ) &
557  / ( f2h(k,1,i_uyz) &
558  * 0.5_rp * ( dens(k+1,i,j)+dens(k+1,i+1,j) ) &
559  + f2h(k,2,i_uyz) &
560  * 0.5_rp * ( dens(k,i,j)+dens(k,i+1,j) ) )
561  flux(k,i,j) = gsqrt(k,i,j) / mapf(i,j,+2) * vel &
562  * ( f1 * ( val(k,i+1,j)+val(k,i,j) ) - sign(f1,vel) * ( val(k,i+1,j)-val(k,i,j) ) )
563  enddo
564  enddo
565  enddo
566 #ifdef DEBUG
567  k = iundef; i = iundef; j = iundef
568 #endif
569 
570  !$omp parallel do default(none) private(i,j) OMP_SCHEDULE_ collapse(2) &
571  !$omp private(vel) &
572  !$omp shared(JJS,JJE,IIS,IIE,KE,flux)
573  do j = jjs, jje
574  do i = iis-1, iie
575  flux(ke,i,j) = 0.0_rp
576  enddo
577  enddo
578 #ifdef DEBUG
579  k = iundef; i = iundef; j = iundef
580 #endif
581 
582  return
583  end subroutine atmos_dyn_fvm_fluxx_xyw_ud1
584 
585  !-----------------------------------------------------------------------------
587  subroutine atmos_dyn_fvm_fluxy_xyw_ud1( &
588  flux, &
589  mom, val, DENS, &
590  GSQRT, MAPF, &
591  num_diff, &
592  CDZ, &
593  IIS, IIE, JJS, JJE )
594  implicit none
595 
596  real(RP), intent(inout) :: flux (ka,ia,ja)
597  real(RP), intent(in) :: mom (ka,ia,ja)
598  real(RP), intent(in) :: val (ka,ia,ja)
599  real(RP), intent(in) :: dens (ka,ia,ja)
600  real(RP), intent(in) :: gsqrt (ka,ia,ja)
601  real(RP), intent(in) :: mapf ( ia,ja,2)
602  real(RP), intent(in) :: num_diff(ka,ia,ja)
603  real(RP), intent(in) :: cdz (ka)
604  integer, intent(in) :: iis, iie, jjs, jje
605 
606  real(RP) :: vel
607  integer :: k, i, j
608  !---------------------------------------------------------------------------
609 
610  !$omp parallel do default(none) private(i,j,k) OMP_SCHEDULE_ collapse(2) &
611  !$omp private(vel) &
612  !$omp shared(JJS,JJE,IIS,IIE,KS,KE,mom,val,DENS,flux,GSQRT,MAPF,num_diff) &
613  !$omp shared(CDZ)
614  do j = jjs-1, jje
615  do i = iis, iie
616  do k = ks, ke-1
617 #ifdef DEBUG
618  call check( __line__, mom(k ,i,j) )
619  call check( __line__, mom(k+1,i,j) )
620 
621  call check( __line__, val(k,i,j) )
622  call check( __line__, val(k,i,j+1) )
623 
624 #endif
625  vel = ( f2h(k,1,i_xvz) &
626  * mom(k+1,i,j) &
627  + f2h(k,2,i_xvz) &
628  * mom(k,i,j) ) &
629  / ( f2h(k,1,i_xvz) &
630  * 0.5_rp * ( dens(k+1,i,j)+dens(k+1,i,j+1) ) &
631  + f2h(k,2,i_xvz) &
632  * 0.5_rp * ( dens(k,i,j)+dens(k,i,j+1) ) )
633  flux(k,i,j) = gsqrt(k,i,j) / mapf(i,j,+1) * vel &
634  * ( f1 * ( val(k,i,j+1)+val(k,i,j) ) - sign(f1,vel) * ( val(k,i,j+1)-val(k,i,j) ) )
635  enddo
636  enddo
637  enddo
638 #ifdef DEBUG
639  k = iundef; i = iundef; j = iundef
640 #endif
641 
642  !$omp parallel do default(none) private(i,j) OMP_SCHEDULE_ collapse(2) &
643  !$omp private(vel) &
644  !$omp shared(JJS,JJE,IIS,IIE,KE,flux)
645  do j = jjs-1, jje
646  do i = iis, iie
647  flux(ke,i,j) = 0.0_rp
648  enddo
649  enddo
650 #ifdef DEBUG
651  k = iundef; i = iundef; j = iundef
652 #endif
653 
654  return
655  end subroutine atmos_dyn_fvm_fluxy_xyw_ud1
656 
657 
658  !-----------------------------------------------------------------------------
660  subroutine atmos_dyn_fvm_fluxz_uyz_ud1( &
661  flux, &
662  mom, val, DENS, &
663  GSQRT, J33G, &
664  num_diff, &
665  CDZ, &
666  IIS, IIE, JJS, JJE )
667  implicit none
668 
669  real(RP), intent(inout) :: flux (ka,ia,ja)
670  real(RP), intent(in) :: mom (ka,ia,ja)
671  real(RP), intent(in) :: val (ka,ia,ja)
672  real(RP), intent(in) :: dens (ka,ia,ja)
673  real(RP), intent(in) :: gsqrt (ka,ia,ja)
674  real(RP), intent(in) :: j33g
675  real(RP), intent(in) :: num_diff(ka,ia,ja)
676  real(RP), intent(in) :: cdz (ka)
677  integer, intent(in) :: iis, iie, jjs, jje
678 
679  real(RP) :: vel
680  integer :: k, i, j
681  !---------------------------------------------------------------------------
682 
683  !$omp parallel do default(none) private(i,j,k) OMP_SCHEDULE_ collapse(2) &
684  !$omp private(vel) &
685  !$omp shared(JJS,JJE,IIS,IIE,KS,KE,mom,val,DENS,flux,J33G,GSQRT,num_diff) &
686  !$omp shared(CDZ)
687  do j = jjs, jje
688  do i = iis, iie
689  do k = ks, ke-1
690 #ifdef DEBUG
691  call check( __line__, mom(k,i,j) )
692  call check( __line__, mom(k,i+1,j) )
693 
694  call check( __line__, val(k,i,j) )
695  call check( __line__, val(k+1,i,j) )
696 
697 #endif
698  vel = ( 0.5_rp * ( mom(k,i,j)+mom(k,i+1,j) ) ) &
699  / ( f2h(k,1,i_uyz) &
700  * 0.5_rp * ( dens(k+1,i,j)+dens(k+1,i+1,j) ) &
701  + f2h(k,2,i_uyz) &
702  * 0.5_rp * ( dens(k,i,j)+dens(k,i+1,j) ) )
703  flux(k,i,j) = j33g * vel &
704  * ( f1 * ( val(k+1,i,j)+val(k,i,j) ) - sign(f1,vel) * ( val(k+1,i,j)-val(k,i,j) ) )
705  enddo
706  enddo
707  enddo
708 #ifdef DEBUG
709  k = iundef; i = iundef; j = iundef
710 #endif
711 
712  !$omp parallel do default(none) private(i,j) OMP_SCHEDULE_ collapse(2) &
713  !$omp private(vel) &
714  !$omp shared(JJS,JJE,IIS,IIE,KS,KE,mom,val,flux,J33G,GSQRT,num_diff,DENS,CDZ)
715  do j = jjs, jje
716  do i = iis, iie
717 #ifdef DEBUG
718 
719 #endif
720  ! The boundary condition is qflx_hi + qflxJ13 + qfluxJ23 = 0 at KS-1.
721  ! The flux at KS-1 can be non-zero.
722  ! To reduce calculations, all the fluxes are set to zero.
723  flux(ks-1,i,j) = 0.0_rp
724 
725  flux(ke,i,j) = 0.0_rp
726  enddo
727  enddo
728 #ifdef DEBUG
729  k = iundef; i = iundef; j = iundef
730 #endif
731 
732  return
733  end subroutine atmos_dyn_fvm_fluxz_uyz_ud1
734 
735  !-----------------------------------------------------------------------------
737  subroutine atmos_dyn_fvm_fluxj13_uyz_ud1( &
738  flux, &
739  mom, val, DENS, &
740  GSQRT, J13G, MAPF, &
741  CDZ, &
742  IIS, IIE, JJS, JJE )
743  implicit none
744 
745  real(RP), intent(inout) :: flux (ka,ia,ja)
746  real(RP), intent(in) :: mom (ka,ia,ja)
747  real(RP), intent(in) :: val (ka,ia,ja)
748  real(RP), intent(in) :: dens (ka,ia,ja)
749  real(RP), intent(in) :: gsqrt (ka,ia,ja)
750  real(RP), intent(in) :: j13g (ka,ia,ja)
751  real(RP), intent(in) :: mapf ( ia,ja,2)
752  real(RP), intent(in) :: cdz (ka)
753  integer, intent(in) :: iis, iie, jjs, jje
754 
755  real(RP) :: vel
756  integer :: k, i, j
757  !---------------------------------------------------------------------------
758 
759  !$omp parallel do default(none) private(i,j,k) OMP_SCHEDULE_ collapse(2) &
760  !$omp private(vel) &
761  !$omp shared(JJS,JJE,IIS,IIE,KS,KE,mom,val,DENS,flux,J13G,MAPF) &
762  !$omp shared(GSQRT,CDZ)
763  do j = jjs, jje
764  do i = iis, iie
765  do k = ks, ke-1
766  vel = ( f2h(k,1,i_uyz) &
767  * mom(k+1,i,j) &
768  + f2h(k,2,i_uyz) &
769  * mom(k,i,j) ) &
770  / ( f2h(k,1,i_uyz) &
771  * 0.5_rp * ( dens(k+1,i,j)+dens(k+1,i+1,j) ) &
772  + f2h(k,2,i_uyz) &
773  * 0.5_rp * ( dens(k,i,j)+dens(k,i+1,j) ) )
774  flux(k,i,j) = j13g(k,i,j) / mapf(i,j,+2) * vel &
775  * ( f1 * ( val(k+1,i,j)+val(k,i,j) ) - sign(f1,vel) * ( val(k+1,i,j)-val(k,i,j) ) )
776  enddo
777  enddo
778  enddo
779 
780  !$omp parallel do default(none) private(i,j) OMP_SCHEDULE_ collapse(2) &
781  !$omp private(vel) &
782  !$omp shared(JJS,JJE,IIS,IIE,KS,KE,mom,val,DENS,flux,J13G,MAPF) &
783  !$omp shared(GSQRT,CDZ)
784  do j = jjs, jje
785  do i = iis, iie
786  ! The boundary condition is qflx_hi + qflxJ13 + qfluxJ23 = 0 at KS-1.
787  ! The flux at KS-1 can be non-zero.
788  ! To reduce calculations, all the fluxes are set to zero.
789  flux(ks-1,i,j) = 0.0_rp
790 
791  flux(ke ,i,j) = 0.0_rp
792  enddo
793  enddo
794 
795  return
796  end subroutine atmos_dyn_fvm_fluxj13_uyz_ud1
797 
798  !-----------------------------------------------------------------------------
800  subroutine atmos_dyn_fvm_fluxj23_uyz_ud1( &
801  flux, &
802  mom, val, DENS, &
803  GSQRT, J23G, MAPF, &
804  CDZ, &
805  IIS, IIE, JJS, JJE )
806  implicit none
807 
808  real(RP), intent(inout) :: flux (ka,ia,ja)
809  real(RP), intent(in) :: mom (ka,ia,ja)
810  real(RP), intent(in) :: val (ka,ia,ja)
811  real(RP), intent(in) :: dens (ka,ia,ja)
812  real(RP), intent(in) :: gsqrt (ka,ia,ja)
813  real(RP), intent(in) :: j23g (ka,ia,ja)
814  real(RP), intent(in) :: mapf ( ia,ja,2)
815  real(RP), intent(in) :: cdz (ka)
816  integer, intent(in) :: iis, iie, jjs, jje
817 
818  real(RP) :: vel
819  integer :: k, i, j
820  !---------------------------------------------------------------------------
821 
822  !$omp parallel do default(none) private(i,j,k) OMP_SCHEDULE_ collapse(2) &
823  !$omp private(vel) &
824  !$omp shared(JJS,JJE,IIS,IIE,KS,KE,mom,val,DENS,flux,J23G,MAPF) &
825  !$omp shared(GSQRT,CDZ)
826  do j = jjs, jje
827  do i = iis, iie
828  do k = ks, ke-1
829  vel = ( f2h(k,1,i_uyz) &
830  * 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) ) &
831  + f2h(k,2,i_uyz) &
832  * 0.25_rp * ( mom(k,i,j)+mom(k,i+1,j)+mom(k,i,j-1)+mom(k,i+1,j-1) ) ) &
833  / ( f2h(k,1,i_uyz) &
834  * 0.5_rp * ( dens(k+1,i,j)+dens(k+1,i+1,j) ) &
835  + f2h(k,2,i_uyz) &
836  * 0.5_rp * ( dens(k,i,j)+dens(k,i+1,j) ) )
837  flux(k,i,j) = j23g(k,i,j) / mapf(i,j,+1) * vel &
838  * ( f1 * ( val(k+1,i,j)+val(k,i,j) ) - sign(f1,vel) * ( val(k+1,i,j)-val(k,i,j) ) )
839  enddo
840  enddo
841  enddo
842 
843  !$omp parallel do default(none) private(i,j) OMP_SCHEDULE_ collapse(2) &
844  !$omp private(vel) &
845  !$omp shared(JJS,JJE,IIS,IIE,KS,KE,mom,val,DENS,flux,J23G,MAPF) &
846  !$omp shared(GSQRT,CDZ)
847  do j = jjs, jje
848  do i = iis, iie
849  ! The boundary condition is qflx_hi + qflxJ13 + qfluxJ23 = 0 at KS-1.
850  ! The flux at KS-1 can be non-zero.
851  ! To reduce calculations, all the fluxes are set to zero.
852  flux(ks-1,i,j) = 0.0_rp
853 
854  flux(ke ,i,j) = 0.0_rp
855  enddo
856  enddo
857 
858  return
859  end subroutine atmos_dyn_fvm_fluxj23_uyz_ud1
860 
861  !-----------------------------------------------------------------------------
863  subroutine atmos_dyn_fvm_fluxx_uyz_ud1( &
864  flux, &
865  mom, val, DENS, &
866  GSQRT, MAPF, &
867  num_diff, &
868  CDZ, &
869  IIS, IIE, JJS, JJE )
870  implicit none
871 
872  real(RP), intent(inout) :: flux (ka,ia,ja)
873  real(RP), intent(in) :: mom (ka,ia,ja)
874  real(RP), intent(in) :: val (ka,ia,ja)
875  real(RP), intent(in) :: dens (ka,ia,ja)
876  real(RP), intent(in) :: gsqrt (ka,ia,ja)
877  real(RP), intent(in) :: mapf ( ia,ja,2)
878  real(RP), intent(in) :: num_diff(ka,ia,ja)
879  real(RP), intent(in) :: cdz (ka)
880  integer, intent(in) :: iis, iie, jjs, jje
881 
882  real(RP) :: vel
883  integer :: k, i, j
884  !---------------------------------------------------------------------------
885 
886  ! note that x-index is added by -1
887 
888  !$omp parallel do default(none) private(i,j,k) OMP_SCHEDULE_ collapse(2) &
889  !$omp private(vel) &
890  !$omp shared(JJS,JJE,IIS,IIE,KS,KE,mom,val,DENS,flux,GSQRT,MAPF,num_diff)
891  do j = jjs, jje
892  do i = iis, iie+1
893  do k = ks, ke
894 #ifdef DEBUG
895  call check( __line__, mom(k,i ,j) )
896  call check( __line__, mom(k,i-1,j) )
897 
898  call check( __line__, val(k,i-1,j) )
899  call check( __line__, val(k,i,j) )
900 
901 #endif
902  vel = ( 0.5_rp * ( mom(k,i,j)+mom(k,i-1,j) ) ) &
903  / ( dens(k,i,j) )
904  flux(k,i-1,j) = gsqrt(k,i,j) / mapf(i,j,+2) * vel &
905  * ( f1 * ( val(k,i,j)+val(k,i-1,j) ) - sign(f1,vel) * ( val(k,i,j)-val(k,i-1,j) ) )
906  enddo
907  enddo
908  enddo
909 #ifdef DEBUG
910  k = iundef; i = iundef; j = iundef
911 #endif
912 
913  return
914  end subroutine atmos_dyn_fvm_fluxx_uyz_ud1
915 
916  !-----------------------------------------------------------------------------
918  subroutine atmos_dyn_fvm_fluxy_uyz_ud1( &
919  flux, &
920  mom, val, DENS, &
921  GSQRT, MAPF, &
922  num_diff, &
923  CDZ, &
924  IIS, IIE, JJS, JJE )
925  implicit none
926 
927  real(RP), intent(inout) :: flux (ka,ia,ja)
928  real(RP), intent(in) :: mom (ka,ia,ja)
929  real(RP), intent(in) :: val (ka,ia,ja)
930  real(RP), intent(in) :: dens (ka,ia,ja)
931  real(RP), intent(in) :: gsqrt (ka,ia,ja)
932  real(RP), intent(in) :: mapf ( ia,ja,2)
933  real(RP), intent(in) :: num_diff(ka,ia,ja)
934  real(RP), intent(in) :: cdz (ka)
935  integer, intent(in) :: iis, iie, jjs, jje
936 
937  real(RP) :: vel
938  integer :: k, i, j
939  !---------------------------------------------------------------------------
940 
941  !$omp parallel do default(none) private(i,j,k) OMP_SCHEDULE_ collapse(2) &
942  !$omp private(vel) &
943  !$omp shared(JJS,JJE,IIS,IIE,KS,KE,mom,val,DENS,flux,GSQRT,MAPF,num_diff)
944  do j = jjs-1, jje
945  do i = iis, iie
946  do k = ks, ke
947 #ifdef DEBUG
948  call check( __line__, mom(k,i ,j) )
949  call check( __line__, mom(k,i-1,j) )
950 
951  call check( __line__, val(k,i,j) )
952  call check( __line__, val(k,i,j+1) )
953 
954 #endif
955  vel = ( 0.5_rp * ( mom(k,i,j)+mom(k,i+1,j) ) ) &
956  / ( 0.25_rp * ( dens(k,i,j)+dens(k,i+1,j)+dens(k,i,j+1)+dens(k,i+1,j+1) ) )
957  flux(k,i,j) = gsqrt(k,i,j) / mapf(i,j,+1) * vel &
958  * ( f1 * ( val(k,i,j+1)+val(k,i,j) ) - sign(f1,vel) * ( val(k,i,j+1)-val(k,i,j) ) )
959  enddo
960  enddo
961  enddo
962 #ifdef DEBUG
963  k = iundef; i = iundef; j = iundef
964 #endif
965 
966  return
967  end subroutine atmos_dyn_fvm_fluxy_uyz_ud1
968 
969 
970 
971  !-----------------------------------------------------------------------------
973  subroutine atmos_dyn_fvm_fluxz_xvz_ud1( &
974  flux, &
975  mom, val, DENS, &
976  GSQRT, J33G, &
977  num_diff, &
978  CDZ, &
979  IIS, IIE, JJS, JJE )
980  implicit none
981 
982  real(RP), intent(inout) :: flux (ka,ia,ja)
983  real(RP), intent(in) :: mom (ka,ia,ja)
984  real(RP), intent(in) :: val (ka,ia,ja)
985  real(RP), intent(in) :: dens (ka,ia,ja)
986  real(RP), intent(in) :: gsqrt (ka,ia,ja)
987  real(RP), intent(in) :: j33g
988  real(RP), intent(in) :: num_diff(ka,ia,ja)
989  real(RP), intent(in) :: cdz (ka)
990  integer, intent(in) :: iis, iie, jjs, jje
991 
992  real(RP) :: vel
993  integer :: k, i, j
994  !---------------------------------------------------------------------------
995 
996  !$omp parallel do default(none) private(i,j,k) OMP_SCHEDULE_ collapse(2) &
997  !$omp private(vel) &
998  !$omp shared(JJS,JJE,IIS,IIE,KS,KE,mom,val,DENS,flux,J33G,GSQRT,num_diff) &
999  !$omp shared(CDZ)
1000  do j = jjs, jje
1001  do i = iis, iie
1002  do k = ks, ke-1
1003 #ifdef DEBUG
1004  call check( __line__, mom(k,i,j) )
1005  call check( __line__, mom(k,i,j+1) )
1006 
1007  call check( __line__, val(k,i,j) )
1008  call check( __line__, val(k+1,i,j) )
1009 
1010 #endif
1011  vel = ( 0.5_rp * ( mom(k,i,j)+mom(k,i,j+1) ) ) &
1012  / ( f2h(k,1,i_xvz) &
1013  * 0.5_rp * ( dens(k+1,i,j)+dens(k+1,i,j+1) ) &
1014  + f2h(k,2,i_xvz) &
1015  * 0.5_rp * ( dens(k,i,j)+dens(k,i,j+1) ) )
1016  flux(k,i,j) = j33g * vel &
1017  * ( f1 * ( val(k+1,i,j)+val(k,i,j) ) - sign(f1,vel) * ( val(k+1,i,j)-val(k,i,j) ) )
1018  enddo
1019  enddo
1020  enddo
1021 #ifdef DEBUG
1022  k = iundef; i = iundef; j = iundef
1023 #endif
1024 
1025  !$omp parallel do default(none) private(i,j) OMP_SCHEDULE_ collapse(2) &
1026  !$omp private(vel) &
1027  !$omp shared(JJS,JJE,IIS,IIE,KS,KE,mom,val,flux,J33G,GSQRT,num_diff,DENS,CDZ)
1028  do j = jjs, jje
1029  do i = iis, iie
1030 #ifdef DEBUG
1031 
1032 #endif
1033  ! The boundary condition is qflx_hi + qflxJ13 + qfluxJ23 = 0 at KS-1.
1034  ! The flux at KS-1 can be non-zero.
1035  ! To reduce calculations, all the fluxes are set to zero.
1036  flux(ks-1,i,j) = 0.0_rp
1037 
1038  flux(ke,i,j) = 0.0_rp
1039  enddo
1040  enddo
1041 #ifdef DEBUG
1042  k = iundef; i = iundef; j = iundef
1043 #endif
1044 
1045  return
1046  end subroutine atmos_dyn_fvm_fluxz_xvz_ud1
1047 
1048  !-----------------------------------------------------------------------------
1050  subroutine atmos_dyn_fvm_fluxj13_xvz_ud1( &
1051  flux, &
1052  mom, val, DENS, &
1053  GSQRT, J13G, MAPF, &
1054  CDZ, &
1055  IIS, IIE, JJS, JJE )
1056  implicit none
1057 
1058  real(RP), intent(inout) :: flux (ka,ia,ja)
1059  real(RP), intent(in) :: mom (ka,ia,ja)
1060  real(RP), intent(in) :: val (ka,ia,ja)
1061  real(RP), intent(in) :: dens (ka,ia,ja)
1062  real(RP), intent(in) :: gsqrt (ka,ia,ja)
1063  real(RP), intent(in) :: j13g (ka,ia,ja)
1064  real(RP), intent(in) :: mapf ( ia,ja,2)
1065  real(RP), intent(in) :: cdz (ka)
1066  integer, intent(in) :: iis, iie, jjs, jje
1067 
1068  real(RP) :: vel
1069  integer :: k, i, j
1070  !---------------------------------------------------------------------------
1071 
1072  !$omp parallel do default(none) private(i,j,k) OMP_SCHEDULE_ collapse(2) &
1073  !$omp private(vel) &
1074  !$omp shared(JJS,JJE,IIS,IIE,KS,KE,mom,val,DENS,flux,J13G,MAPF) &
1075  !$omp shared(GSQRT,CDZ)
1076  do j = jjs, jje
1077  do i = iis, iie
1078  do k = ks, ke-1
1079  vel = ( f2h(k,1,i_xvz) &
1080  * 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) ) &
1081  + f2h(k,2,i_xvz) &
1082  * 0.25_rp * ( mom(k,i,j)+mom(k,i-1,j)+mom(k,i,j+1)+mom(k,i-1,j+1) ) ) &
1083  / ( f2h(k,1,i_xvz) &
1084  * 0.5_rp * ( dens(k+1,i,j)+dens(k+1,i,j+1) ) &
1085  + f2h(k,2,i_xvz) &
1086  * 0.5_rp * ( dens(k,i,j)+dens(k,i,j+1) ) )
1087  flux(k,i,j) = j13g(k,i,j) / mapf(i,j,+2) * vel &
1088  * ( f1 * ( val(k+1,i,j)+val(k,i,j) ) - sign(f1,vel) * ( val(k+1,i,j)-val(k,i,j) ) )
1089  enddo
1090  enddo
1091  enddo
1092 
1093  !$omp parallel do default(none) private(i,j) OMP_SCHEDULE_ collapse(2) &
1094  !$omp private(vel) &
1095  !$omp shared(JJS,JJE,IIS,IIE,KS,KE,mom,val,DENS,flux,J13G,MAPF) &
1096  !$omp shared(GSQRT,CDZ)
1097  do j = jjs, jje
1098  do i = iis, iie
1099  ! The boundary condition is qflx_hi + qflxJ13 + qfluxJ23 = 0 at KS-1.
1100  ! The flux at KS-1 can be non-zero.
1101  ! To reduce calculations, all the fluxes are set to zero.
1102  flux(ks-1,i,j) = 0.0_rp
1103 
1104  flux(ke ,i,j) = 0.0_rp
1105  enddo
1106  enddo
1107 
1108  return
1109  end subroutine atmos_dyn_fvm_fluxj13_xvz_ud1
1110 
1111  !-----------------------------------------------------------------------------
1113  subroutine atmos_dyn_fvm_fluxj23_xvz_ud1( &
1114  flux, &
1115  mom, val, DENS, &
1116  GSQRT, J23G, MAPF, &
1117  CDZ, &
1118  IIS, IIE, JJS, JJE )
1119  implicit none
1120 
1121  real(RP), intent(inout) :: flux (ka,ia,ja)
1122  real(RP), intent(in) :: mom (ka,ia,ja)
1123  real(RP), intent(in) :: val (ka,ia,ja)
1124  real(RP), intent(in) :: dens (ka,ia,ja)
1125  real(RP), intent(in) :: gsqrt (ka,ia,ja)
1126  real(RP), intent(in) :: j23g (ka,ia,ja)
1127  real(RP), intent(in) :: mapf ( ia,ja,2)
1128  real(RP), intent(in) :: cdz (ka)
1129  integer, intent(in) :: iis, iie, jjs, jje
1130 
1131  real(RP) :: vel
1132  integer :: k, i, j
1133  !---------------------------------------------------------------------------
1134 
1135  !$omp parallel do default(none) private(i,j,k) OMP_SCHEDULE_ collapse(2) &
1136  !$omp private(vel) &
1137  !$omp shared(JJS,JJE,IIS,IIE,KS,KE,mom,val,DENS,flux,J23G,MAPF) &
1138  !$omp shared(GSQRT,CDZ)
1139  do j = jjs, jje
1140  do i = iis, iie
1141  do k = ks, ke-1
1142  vel = ( f2h(k,1,i_xvz) &
1143  * mom(k+1,i,j) &
1144  + f2h(k,2,i_xvz) &
1145  * mom(k,i,j) ) &
1146  / ( f2h(k,1,i_xvz) &
1147  * 0.5_rp * ( dens(k+1,i,j)+dens(k+1,i,j+1) ) &
1148  + f2h(k,2,i_xvz) &
1149  * 0.5_rp * ( dens(k,i,j)+dens(k,i,j+1) ) )
1150  flux(k,i,j) = j23g(k,i,j) / mapf(i,j,+1) * vel &
1151  * ( f1 * ( val(k+1,i,j)+val(k,i,j) ) - sign(f1,vel) * ( val(k+1,i,j)-val(k,i,j) ) )
1152  enddo
1153  enddo
1154  enddo
1155 
1156  !$omp parallel do default(none) private(i,j) OMP_SCHEDULE_ collapse(2) &
1157  !$omp private(vel) &
1158  !$omp shared(JJS,JJE,IIS,IIE,KS,KE,mom,val,DENS,flux,J23G,MAPF) &
1159  !$omp shared(GSQRT,CDZ)
1160  do j = jjs, jje
1161  do i = iis, iie
1162  ! The boundary condition is qflx_hi + qflxJ13 + qfluxJ23 = 0 at KS-1.
1163  ! The flux at KS-1 can be non-zero.
1164  ! To reduce calculations, all the fluxes are set to zero.
1165  flux(ks-1,i,j) = 0.0_rp
1166 
1167  flux(ke ,i,j) = 0.0_rp
1168  enddo
1169  enddo
1170 
1171  return
1172  end subroutine atmos_dyn_fvm_fluxj23_xvz_ud1
1173 
1174  !-----------------------------------------------------------------------------
1176  subroutine atmos_dyn_fvm_fluxx_xvz_ud1( &
1177  flux, &
1178  mom, val, DENS, &
1179  GSQRT, MAPF, &
1180  num_diff, &
1181  CDZ, &
1182  IIS, IIE, JJS, JJE )
1183  implicit none
1184 
1185  real(RP), intent(inout) :: flux (ka,ia,ja)
1186  real(RP), intent(in) :: mom (ka,ia,ja)
1187  real(RP), intent(in) :: val (ka,ia,ja)
1188  real(RP), intent(in) :: dens (ka,ia,ja)
1189  real(RP), intent(in) :: gsqrt (ka,ia,ja)
1190  real(RP), intent(in) :: mapf ( ia,ja,2)
1191  real(RP), intent(in) :: num_diff(ka,ia,ja)
1192  real(RP), intent(in) :: cdz (ka)
1193  integer, intent(in) :: iis, iie, jjs, jje
1194 
1195  real(RP) :: vel
1196  integer :: k, i, j
1197  !---------------------------------------------------------------------------
1198 
1199  !$omp parallel do default(none) private(i,j,k) OMP_SCHEDULE_ collapse(2) &
1200  !$omp private(vel) &
1201  !$omp shared(JJS,JJE,IIS,IIE,KS,KE,mom,val,DENS,flux,GSQRT,MAPF,num_diff)
1202  do j = jjs, jje
1203  do i = iis-1, iie
1204  do k = ks, ke
1205 #ifdef DEBUG
1206  call check( __line__, mom(k,i ,j) )
1207  call check( __line__, mom(k,i,j-1) )
1208 
1209  call check( __line__, val(k,i,j) )
1210  call check( __line__, val(k,i+1,j) )
1211 
1212 #endif
1213  vel = ( 0.5_rp * ( mom(k,i,j)+mom(k,i,j+1) ) ) &
1214  / ( 0.25_rp * ( dens(k,i,j)+dens(k,i+1,j)+dens(k,i,j+1)+dens(k,i+1,j+1) ) )
1215  flux(k,i,j) = gsqrt(k,i,j) / mapf(i,j,+2) * vel &
1216  * ( f1 * ( val(k,i+1,j)+val(k,i,j) ) - sign(f1,vel) * ( val(k,i+1,j)-val(k,i,j) ) )
1217  enddo
1218  enddo
1219  enddo
1220 #ifdef DEBUG
1221  k = iundef; i = iundef; j = iundef
1222 #endif
1223 
1224  return
1225  end subroutine atmos_dyn_fvm_fluxx_xvz_ud1
1226 
1227  !-----------------------------------------------------------------------------
1229  subroutine atmos_dyn_fvm_fluxy_xvz_ud1( &
1230  flux, &
1231  mom, val, DENS, &
1232  GSQRT, MAPF, &
1233  num_diff, &
1234  CDZ, &
1235  IIS, IIE, JJS, JJE )
1236  implicit none
1237 
1238  real(RP), intent(inout) :: flux (ka,ia,ja)
1239  real(RP), intent(in) :: mom (ka,ia,ja)
1240  real(RP), intent(in) :: val (ka,ia,ja)
1241  real(RP), intent(in) :: dens (ka,ia,ja)
1242  real(RP), intent(in) :: gsqrt (ka,ia,ja)
1243  real(RP), intent(in) :: mapf ( ia,ja,2)
1244  real(RP), intent(in) :: num_diff(ka,ia,ja)
1245  real(RP), intent(in) :: cdz (ka)
1246  integer, intent(in) :: iis, iie, jjs, jje
1247 
1248  real(RP) :: vel
1249  integer :: k, i, j
1250  !---------------------------------------------------------------------------
1251 
1252  ! note that y-index is added by -1
1253 
1254  !$omp parallel do default(none) private(i,j,k) OMP_SCHEDULE_ collapse(2) &
1255  !$omp private(vel) &
1256  !$omp shared(JJS,JJE,IIS,IIE,KS,KE,mom,val,DENS,flux,GSQRT,MAPF,num_diff)
1257  do j = jjs, jje+1
1258  do i = iis, iie
1259  do k = ks, ke
1260 #ifdef DEBUG
1261  call check( __line__, mom(k,i ,j) )
1262  call check( __line__, mom(k,i,j-1) )
1263 
1264  call check( __line__, val(k,i,j-1) )
1265  call check( __line__, val(k,i,j) )
1266 
1267 #endif
1268  vel = ( 0.5_rp * ( mom(k,i,j)+mom(k,i,j-1) ) ) &
1269  / ( dens(k,i,j) )
1270  flux(k,i,j-1) = gsqrt(k,i,j) / mapf(i,j,+1) * vel &
1271  * ( f1 * ( val(k,i,j)+val(k,i,j-1) ) - sign(f1,vel) * ( val(k,i,j)-val(k,i,j-1) ) )
1272  enddo
1273  enddo
1274  enddo
1275 #ifdef DEBUG
1276  k = iundef; i = iundef; j = iundef
1277 #endif
1278 
1279  return
1280  end subroutine atmos_dyn_fvm_fluxy_xvz_ud1
1281 
1282 
1283 
1284 
1285 
1286 
1287 
1288 end module scale_atmos_dyn_fvm_flux_ud1
1289 
1290 !--
1291 ! vi:set readonly sw=4 ts=8
1292 !
1293 !Local Variables:
1294 !mode: f90
1295 !buffer-read-only: t
1296 !End:
1297 !
1298 !++
scale_atmos_dyn_fvm_flux_ud1::atmos_dyn_fvm_fluxx_xyw_ud1
subroutine, public atmos_dyn_fvm_fluxx_xyw_ud1(flux, mom, val, DENS, GSQRT, MAPF, num_diff, CDZ, IIS, IIE, JJS, JJE)
calculation X-flux at XYW
Definition: scale_atmos_dyn_fvm_flux_ud1.F90:522
scale_debug
module DEBUG
Definition: scale_debug.F90:13
scale_atmos_dyn_fvm_flux_ud1::atmos_dyn_fvm_fluxj23_xvz_ud1
subroutine, public atmos_dyn_fvm_fluxj23_xvz_ud1(flux, mom, val, DENS, GSQRT, J23G, MAPF, CDZ, IIS, IIE, JJS, JJE)
calculation J23-flux at XVZ
Definition: scale_atmos_dyn_fvm_flux_ud1.F90:1119
scale_atmos_dyn_fvm_flux_ud1::atmos_dyn_fvm_fluxy_xyz_ud1
subroutine, public atmos_dyn_fvm_fluxy_xyz_ud1(flux, mflx, val, GSQRT, num_diff, CDZ, IIS, IIE, JJS, JJE)
calculation Y-flux at XYZ
Definition: scale_atmos_dyn_fvm_flux_ud1.F90:262
scale_atmos_dyn_fvm_flux_ud1::atmos_dyn_fvm_fluxy_xyw_ud1
subroutine, public atmos_dyn_fvm_fluxy_xyw_ud1(flux, mom, val, DENS, GSQRT, MAPF, num_diff, CDZ, IIS, IIE, JJS, JJE)
calculation Y-flux at XYW
Definition: scale_atmos_dyn_fvm_flux_ud1.F90:594
scale_atmos_dyn_fvm_flux_ud1::atmos_dyn_fvm_fluxz_xyz_ud1
subroutine, public atmos_dyn_fvm_fluxz_xyz_ud1(flux, mflx, val, GSQRT, num_diff, CDZ, IIS, IIE, JJS, JJE)
calculation z-flux at XYZ
Definition: scale_atmos_dyn_fvm_flux_ud1.F90:149
scale_atmos_dyn_fvm_flux_ud1::atmos_dyn_fvm_fluxy_xvz_ud1
subroutine, public atmos_dyn_fvm_fluxy_xvz_ud1(flux, mom, val, DENS, GSQRT, MAPF, num_diff, CDZ, IIS, IIE, JJS, JJE)
calculation Y-flux at XV
Definition: scale_atmos_dyn_fvm_flux_ud1.F90:1236
scale_atmos_dyn_fvm_flux_ud1::atmos_dyn_fvm_fluxj13_uyz_ud1
subroutine, public atmos_dyn_fvm_fluxj13_uyz_ud1(flux, mom, val, DENS, GSQRT, J13G, MAPF, CDZ, IIS, IIE, JJS, JJE)
calculation J13-flux at UYZ
Definition: scale_atmos_dyn_fvm_flux_ud1.F90:743
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_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_ud1::atmos_dyn_fvm_fluxj13_xyw_ud1
subroutine, public atmos_dyn_fvm_fluxj13_xyw_ud1(flux, mom, val, DENS, GSQRT, J13G, MAPF, CDZ, IIS, IIE, JJS, JJE)
calculation J13-flux at XYW
Definition: scale_atmos_dyn_fvm_flux_ud1.F90:392
scale_grid_index
module grid index
Definition: scale_grid_index.F90:14
scale_tracer
module TRACER
Definition: scale_tracer.F90:15
scale_index
module Index
Definition: scale_index.F90:14
scale_atmos_dyn_fvm_flux_ud1::atmos_dyn_fvm_fluxx_uyz_ud1
subroutine, public atmos_dyn_fvm_fluxx_uyz_ud1(flux, mom, val, DENS, GSQRT, MAPF, num_diff, CDZ, IIS, IIE, JJS, JJE)
calculation X-flux at UY
Definition: scale_atmos_dyn_fvm_flux_ud1.F90:870
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_ud1::atmos_dyn_fvm_fluxj13_xvz_ud1
subroutine, public atmos_dyn_fvm_fluxj13_xvz_ud1(flux, mom, val, DENS, GSQRT, J13G, MAPF, CDZ, IIS, IIE, JJS, JJE)
calculation J13-flux at XVZ
Definition: scale_atmos_dyn_fvm_flux_ud1.F90:1056
scale_atmos_dyn_fvm_flux_ud1::atmos_dyn_fvm_fluxz_xvz_ud1
subroutine, public atmos_dyn_fvm_fluxz_xvz_ud1(flux, mom, val, DENS, GSQRT, J33G, num_diff, CDZ, IIS, IIE, JJS, JJE)
calculation z-flux at XV
Definition: scale_atmos_dyn_fvm_flux_ud1.F90:980
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_ud1::atmos_dyn_fvm_fluxz_uyz_ud1
subroutine, public atmos_dyn_fvm_fluxz_uyz_ud1(flux, mom, val, DENS, GSQRT, J33G, num_diff, CDZ, IIS, IIE, JJS, JJE)
calculation z-flux at UY
Definition: scale_atmos_dyn_fvm_flux_ud1.F90:667
scale_const::const_undef2
integer, parameter, public const_undef2
undefined value (INT2)
Definition: scale_const.F90:40
scale_process
module PROCESS
Definition: scale_process.F90:14
scale_atmos_dyn_fvm_flux_ud1::atmos_dyn_fvm_fluxy_uyz_ud1
subroutine, public atmos_dyn_fvm_fluxy_uyz_ud1(flux, mom, val, DENS, GSQRT, MAPF, num_diff, CDZ, IIS, IIE, JJS, JJE)
calculation Y-flux at UY
Definition: scale_atmos_dyn_fvm_flux_ud1.F90:925
scale_const
module CONSTANT
Definition: scale_const.F90:14
scale_atmos_dyn_fvm_flux_ud1::atmos_dyn_fvm_fluxx_xvz_ud1
subroutine, public atmos_dyn_fvm_fluxx_xvz_ud1(flux, mom, val, DENS, GSQRT, MAPF, num_diff, CDZ, IIS, IIE, JJS, JJE)
calculation X-flux at XV
Definition: scale_atmos_dyn_fvm_flux_ud1.F90:1183
scale_grid_index::ks
integer, public ks
start point of inner domain: z, local
Definition: scale_grid_index.F90:58
scale_prof
module profiler
Definition: scale_prof.F90:10
scale_atmos_dyn_fvm_flux_ud1::atmos_dyn_fvm_fluxj23_uyz_ud1
subroutine, public atmos_dyn_fvm_fluxj23_uyz_ud1(flux, mom, val, DENS, GSQRT, J23G, MAPF, CDZ, IIS, IIE, JJS, JJE)
calculation J23-flux at UYZ
Definition: scale_atmos_dyn_fvm_flux_ud1.F90:806
scale_precision
module PRECISION
Definition: scale_precision.F90:13
scale_atmos_dyn_fvm_flux_ud1::atmos_dyn_fvm_fluxj23_xyw_ud1
subroutine, public atmos_dyn_fvm_fluxj23_xyw_ud1(flux, mom, val, DENS, GSQRT, J23G, MAPF, CDZ, IIS, IIE, JJS, JJE)
calculation J23-flux at XYW
Definition: scale_atmos_dyn_fvm_flux_ud1.F90:456
scale_atmos_dyn_fvm_flux_ud1::atmos_dyn_fvm_flux_valuew_z_ud1
subroutine, public atmos_dyn_fvm_flux_valuew_z_ud1(valW, mflx, val, GSQRT, CDZ)
value at XYW
Definition: scale_atmos_dyn_fvm_flux_ud1.F90:103
scale_atmos_dyn_fvm_flux_ud1::atmos_dyn_fvm_fluxz_xyw_ud1
subroutine, public atmos_dyn_fvm_fluxz_xyw_ud1(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_ud1.F90:313
scale_atmos_dyn_fvm_flux_ud1::atmos_dyn_fvm_fluxx_xyz_ud1
subroutine, public atmos_dyn_fvm_fluxx_xyz_ud1(flux, mflx, val, GSQRT, num_diff, CDZ, IIS, IIE, JJS, JJE)
calculation X-flux at XYZ
Definition: scale_atmos_dyn_fvm_flux_ud1.F90:214
scale_atmos_dyn_fvm_flux_ud1
module scale_atmos_dyn_fvm_flux_ud1
Definition: scale_atmos_dyn_fvm_flux_ud1.F90:19
scale_grid_index::ja
integer, public ja
of whole cells: y, local, with HALO
Definition: scale_grid_index.F90:56
Generated by   doxygen 1.8.14