SCALE-RM
scale_atmos_dyn_fvm_flux_ud1.F90
Go to the documentation of this file.
1 
2 !-------------------------------------------------------------------------------
11 !-------------------------------------------------------------------------------
12 ! Warning: This file was generated from atmos-rm/dynamics/scale_atmos_dyn_fvm_flux_udcd.F90.erb.
13 ! Do not edit this file.
14 !-------------------------------------------------------------------------------
15 #include "scalelib.h"
16 module scale_atmos_dyn_fvm_flux_ud1
17  !-----------------------------------------------------------------------------
18  !
19  !++ used modules
20  !
21  use scale_precision
22  use scale_io
23  use scale_prof
24  use scale_atmos_grid_cartesc_index
25  use scale_index
26  use scale_tracer
27  use scale_prc
28 #ifdef DEBUG
29  use scale_debug, only: &
30  check
31  use scale_const, only: &
32  undef => const_undef, &
33  iundef => const_undef2
34 #endif
35  !-----------------------------------------------------------------------------
36  implicit none
37  private
38  !-----------------------------------------------------------------------------
39  !
40  !++ Public procedure
41  !
42  public :: atmos_dyn_fvm_flux_valuew_z_ud1
43 
44  public :: atmos_dyn_fvm_fluxz_xyz_ud1
45  public :: atmos_dyn_fvm_fluxx_xyz_ud1
46  public :: atmos_dyn_fvm_fluxy_xyz_ud1
47 
48  public :: atmos_dyn_fvm_fluxz_xyw_ud1
49  public :: atmos_dyn_fvm_fluxj13_xyw_ud1
50  public :: atmos_dyn_fvm_fluxj23_xyw_ud1
51  public :: atmos_dyn_fvm_fluxx_xyw_ud1
52  public :: atmos_dyn_fvm_fluxy_xyw_ud1
53 
54  public :: atmos_dyn_fvm_fluxz_uyz_ud1
55  public :: atmos_dyn_fvm_fluxj13_uyz_ud1
56  public :: atmos_dyn_fvm_fluxj23_uyz_ud1
57  public :: atmos_dyn_fvm_fluxx_uyz_ud1
58  public :: atmos_dyn_fvm_fluxy_uyz_ud1
59 
60  public :: atmos_dyn_fvm_fluxz_xvz_ud1
61  public :: atmos_dyn_fvm_fluxj13_xvz_ud1
62  public :: atmos_dyn_fvm_fluxj23_xvz_ud1
63  public :: atmos_dyn_fvm_fluxx_xvz_ud1
64  public :: atmos_dyn_fvm_fluxy_xvz_ud1
65 
66  !-----------------------------------------------------------------------------
67  !
68  !++ Public parameters & variables
69  !
70  !-----------------------------------------------------------------------------
71  !
72  !++ Private procedure
73  !
74 #if 1
75 #define F2H(k,p,q) (CDZ(k+p-1)*GSQRT(k+p-1,i,j)/(CDZ(k)*GSQRT(k,i,j)+CDZ(k+1)*GSQRT(k+1,i,j)))
76 #else
77 #define F2H(k,p,q) 0.5_RP
78 #endif
79  !-----------------------------------------------------------------------------
80  !
81  !++ Private parameters & variables
82  !
83 
84  real(RP), parameter :: F1 = 0.5_rp
85 
86  real(RP), parameter :: F2 = 0.5_rp ! F2 is always used to calculate flux near boundary.
87 
88 
89 
90 
91 
92 
93 contains
94  !-----------------------------------------------------------------------------
96 !OCL SERIAL
97  subroutine atmos_dyn_fvm_flux_valuew_z_ud1( &
98  valW, &
99  mflx, val, GSQRT, &
100  CDZ )
101  implicit none
102 
103  real(rp), intent(out) :: valw (ka)
104  real(rp), intent(in) :: mflx (ka)
105  real(rp), intent(in) :: val (ka)
106  real(rp), intent(in) :: gsqrt(ka)
107  real(rp), intent(in) :: cdz (ka)
108 
109  integer :: k
110  !---------------------------------------------------------------------------
111 
112  do k = ks, ke-1
113 #ifdef DEBUG
114  call check( __line__, mflx(k) )
115 
116  call check( __line__, val(k) )
117  call check( __line__, val(k+1) )
118 
119 #endif
120  valw(k) = f1 * ( val(k+1)+val(k) ) - sign(f1,mflx(k)) * ( val(k+1)-val(k) )
121  enddo
122 #ifdef DEBUG
123  k = iundef
124 #endif
125 
126 #ifdef DEBUG
127 
128 #endif
129 
130 
131  return
132  end subroutine atmos_dyn_fvm_flux_valuew_z_ud1
133 
134  !-----------------------------------------------------------------------------
136  subroutine atmos_dyn_fvm_fluxz_xyz_ud1( &
137  flux, &
138  mflx, val, GSQRT, &
139  num_diff, &
140  CDZ, &
141  IIS, IIE, JJS, JJE )
142  use scale_const, only: &
143  eps => const_eps
144  implicit none
145 
146  real(rp), intent(inout) :: flux (ka,ia,ja)
147  real(rp), intent(in) :: mflx (ka,ia,ja)
148  real(rp), intent(in) :: val (ka,ia,ja)
149  real(rp), intent(in) :: gsqrt (ka,ia,ja)
150  real(rp), intent(in) :: num_diff(ka,ia,ja)
151  real(rp), intent(in) :: cdz (ka)
152  integer, intent(in) :: iis, iie, jjs, jje
153 
154  real(rp) :: vel
155  integer :: k, i, j
156  !---------------------------------------------------------------------------
157 
158  !$omp parallel default(none) private(i,j,k, vel) &
159  !$omp shared(JJS,JJE,IIS,IIE,KS,KE,mflx,val,flux,GSQRT,num_diff,EPS)
160 
161  !$omp do OMP_SCHEDULE_ collapse(2)
162  do j = jjs, jje
163  do i = iis, iie
164  do k = ks, ke-1
165 #ifdef DEBUG
166  call check( __line__, mflx(k,i,j) )
167 
168  call check( __line__, val(k,i,j) )
169  call check( __line__, val(k+1,i,j) )
170 
171 #endif
172  vel = mflx(k,i,j)
173  flux(k,i,j) = vel &
174  * ( f1 * ( val(k+1,i,j)+val(k,i,j) ) - sign(f1,vel) * ( val(k+1,i,j)-val(k,i,j) ) )
175  enddo
176  enddo
177  enddo
178  !$omp end do nowait
179 #ifdef DEBUG
180  k = iundef; i = iundef; j = iundef
181 #endif
182 
183  !$omp do OMP_SCHEDULE_ collapse(2)
184  do j = jjs, jje
185  do i = iis, iie
186 #ifdef DEBUG
187 
188 #endif
189  flux(ks-1,i,j) = 0.0_rp
190 
191  flux(ke ,i,j) = 0.0_rp
192  enddo
193  enddo
194  !$omp end do nowait
195 
196  !$omp end parallel
197 #ifdef DEBUG
198  k = iundef; i = iundef; j = iundef
199 #endif
200 
201  return
202  end subroutine atmos_dyn_fvm_fluxz_xyz_ud1
203 
204  !-----------------------------------------------------------------------------
206  subroutine atmos_dyn_fvm_fluxx_xyz_ud1( &
207  flux, &
208  mflx, val, GSQRT, &
209  num_diff, &
210  CDZ, &
211  IIS, IIE, JJS, JJE )
212  implicit none
213 
214  real(rp), intent(inout) :: flux (ka,ia,ja)
215  real(rp), intent(in) :: mflx (ka,ia,ja)
216  real(rp), intent(in) :: val (ka,ia,ja)
217  real(rp), intent(in) :: gsqrt (ka,ia,ja)
218  real(rp), intent(in) :: num_diff(ka,ia,ja)
219  real(rp), intent(in) :: cdz(ka)
220  integer, intent(in) :: iis, iie, jjs, jje
221 
222  real(rp) :: vel
223  integer :: k, i, j
224  !---------------------------------------------------------------------------
225 
226  !$omp parallel do default(none) private(i,j,k) OMP_SCHEDULE_ collapse(2) &
227  !$omp private(vel) &
228  !$omp shared(JJS,JJE,IIS,IIE,KS,KE,mflx,val,flux,GSQRT,num_diff)
229  do j = jjs, jje
230  do i = iis-1, iie
231  do k = ks, ke
232 #ifdef DEBUG
233  call check( __line__, mflx(k,i,j) )
234 
235  call check( __line__, val(k,i,j) )
236  call check( __line__, val(k,i+1,j) )
237 
238 #endif
239  vel = mflx(k,i,j)
240  flux(k,i,j) = vel &
241  * ( f1 * ( val(k,i+1,j)+val(k,i,j) ) - sign(f1,vel) * ( val(k,i+1,j)-val(k,i,j) ) )
242  enddo
243  enddo
244  enddo
245 #ifdef DEBUG
246  k = iundef; i = iundef; j = iundef
247 #endif
248 
249  return
250  end subroutine atmos_dyn_fvm_fluxx_xyz_ud1
251 
252  !-----------------------------------------------------------------------------
254  subroutine atmos_dyn_fvm_fluxy_xyz_ud1( &
255  flux, &
256  mflx, val, GSQRT, &
257  num_diff, &
258  CDZ, &
259  IIS, IIE, JJS, JJE )
260  implicit none
261 
262  real(rp), intent(inout) :: flux (ka,ia,ja)
263  real(rp), intent(in) :: mflx (ka,ia,ja)
264  real(rp), intent(in) :: val (ka,ia,ja)
265  real(rp), intent(in) :: gsqrt (ka,ia,ja)
266  real(rp), intent(in) :: num_diff(ka,ia,ja)
267  real(rp), intent(in) :: cdz(ka)
268  integer, intent(in) :: iis, iie, jjs, jje
269 
270  real(rp) :: vel
271  integer :: k, i, j
272  !---------------------------------------------------------------------------
273 
274  !$omp parallel do default(none) private(i,j,k) OMP_SCHEDULE_ collapse(2) &
275  !$omp private(vel) &
276  !$omp shared(JJS,JJE,IIS,IIE,KS,KE,mflx,val,flux,GSQRT,num_diff)
277  do j = jjs-1, jje
278  do i = iis, iie
279  do k = ks, ke
280 #ifdef DEBUG
281  call check( __line__, mflx(k,i,j) )
282 
283  call check( __line__, val(k,i,j) )
284  call check( __line__, val(k,i,j+1) )
285 
286 #endif
287  vel = mflx(k,i,j)
288  flux(k,i,j) = vel &
289  * ( f1 * ( val(k,i,j+1)+val(k,i,j) ) - sign(f1,vel) * ( val(k,i,j+1)-val(k,i,j) ) )
290  enddo
291  enddo
292  enddo
293 #ifdef DEBUG
294  k = iundef; i = iundef; j = iundef
295 #endif
296 
297  return
298  end subroutine atmos_dyn_fvm_fluxy_xyz_ud1
299 
300 
301  !-----------------------------------------------------------------------------
303  subroutine atmos_dyn_fvm_fluxz_xyw_ud1( &
304  flux, &
305  mom, val, DENS, &
306  GSQRT, J33G, &
307  num_diff, &
308  CDZ, FDZ, &
309  dtrk, &
310  IIS, IIE, JJS, JJE )
311  implicit none
312 
313  real(rp), intent(inout) :: flux (ka,ia,ja)
314  real(rp), intent(in) :: mom (ka,ia,ja)
315  real(rp), intent(in) :: val (ka,ia,ja)
316  real(rp), intent(in) :: dens (ka,ia,ja)
317  real(rp), intent(in) :: gsqrt (ka,ia,ja)
318  real(rp), intent(in) :: j33g
319  real(rp), intent(in) :: num_diff(ka,ia,ja)
320  real(rp), intent(in) :: cdz (ka)
321  real(rp), intent(in) :: fdz (ka-1)
322  real(rp), intent(in) :: dtrk
323  integer, intent(in) :: iis, iie, jjs, jje
324 
325  real(rp) :: vel
326  integer :: k, i, j
327  !---------------------------------------------------------------------------
328 
329  ! note than z-index is added by -1
330 
331  !$omp parallel default(none) private(i,j,k,vel) &
332  !$omp shared(JJS,JJE,IIS,IIE,KS,KE,mom,val,flux,J33G,GSQRT,num_diff,DENS,FDZ,dtrk)
333 
334  !$omp do OMP_SCHEDULE_ collapse(2)
335  do j = jjs, jje
336  do i = iis, iie
337  do k = ks+1, ke-1
338 #ifdef DEBUG
339  call check( __line__, mom(k-1,i,j) )
340  call check( __line__, mom(k ,i,j) )
341 
342  call check( __line__, val(k-1,i,j) )
343  call check( __line__, val(k,i,j) )
344 
345 #endif
346  vel = ( 0.5_rp * ( mom(k-1,i,j) &
347  + mom(k,i,j) ) ) &
348  / dens(k,i,j)
349  flux(k-1,i,j) = j33g * vel &
350  * ( f1 * ( val(k,i,j)+val(k-1,i,j) ) - sign(f1,vel) * ( val(k,i,j)-val(k-1,i,j) ) )
351  enddo
352  enddo
353  enddo
354  !$omp end do nowait
355 #ifdef DEBUG
356  k = iundef; i = iundef; j = iundef
357 #endif
358 
359  !$omp do OMP_SCHEDULE_ collapse(2)
360  do j = jjs, jje
361  do i = iis, iie
362 #ifdef DEBUG
363 
364 
365 #endif
366  ! The boundary condition is qflx_hi + qflxJ13 + qfluxJ23 = 0 at KS.
367  ! The flux at KS can be non-zero.
368  ! To reduce calculations, all the fluxes are set to zero.
369  flux(ks-1,i,j) = 0.0_rp ! k = KS
370 
371 
372 
373  flux(ke-1,i,j) = 0.0_rp ! k = KE
374  flux(ke ,i,j) = 0.0_rp ! k = KE+1
375  enddo
376  enddo
377  !$omp end do nowait
378 
379  !$omp end parallel
380 
381  return
382  end subroutine atmos_dyn_fvm_fluxz_xyw_ud1
383 
384 
385  !-----------------------------------------------------------------------------
387  subroutine atmos_dyn_fvm_fluxj13_xyw_ud1( &
388  flux, &
389  mom, val, DENS, &
390  GSQRT, J13G, MAPF, &
391  CDZ, TwoD, &
392  IIS, IIE, JJS, JJE )
393  implicit none
394 
395  real(rp), intent(inout) :: flux (ka,ia,ja)
396  real(rp), intent(in) :: mom (ka,ia,ja)
397  real(rp), intent(in) :: val (ka,ia,ja)
398  real(rp), intent(in) :: dens (ka,ia,ja)
399  real(rp), intent(in) :: gsqrt (ka,ia,ja)
400  real(rp), intent(in) :: j13g (ka,ia,ja)
401  real(rp), intent(in) :: mapf ( ia,ja,2)
402  real(rp), intent(in) :: cdz (ka)
403  logical, intent(in) :: twod
404  integer, intent(in) :: iis, iie, jjs, jje
405 
406  real(rp) :: vel
407  integer :: k, i, j
408  !---------------------------------------------------------------------------
409 
410  !$omp parallel default(none) private(i,j,k,vel) &
411  !$omp shared(JJS,JJE,IIS,IIE,KS,KE,mom,val,DENS,flux,J13G,MAPF)
412 
413  !$omp do OMP_SCHEDULE_ collapse(2)
414  do j = jjs, jje
415  do i = iis, iie
416  do k = ks+2, ke-1
417  vel = ( 0.5_rp * ( mom(k,i,j)+mom(k,i-1,j) ) ) &
418  / dens(k,i,j)
419  vel = vel * j13g(k,i,j)
420  flux(k-1,i,j) = vel / mapf(i,j,+2) &
421  * ( f1 * ( val(k,i,j)+val(k-1,i,j) ) - sign(f1,vel) * ( val(k,i,j)-val(k-1,i,j) ) )
422  enddo
423  enddo
424  enddo
425  !$omp end do nowait
426 
427  !$omp do OMP_SCHEDULE_ collapse(2)
428  do j = jjs, jje
429  do i = iis, iie
430  ! The boundary condition is qflx_hi + qflxJ13 + qfluxJ23 = 0 at KS.
431  ! The flux at KS can be non-zero.
432  ! To reduce calculations, all the fluxes are set to zero.
433  flux(ks-1,i,j) = 0.0_rp ! k = KS
434 
435  ! physically incorrect but for numerical stability
436  vel = ( ( 0.5_rp * ( mom(ks+1,i,j)+mom(ks+1,i-1,j) ) ) / dens(ks+1,i,j) &
437  + ( 0.5_rp * ( mom(ks,i,j)+mom(ks,i-1,j) ) ) / dens(ks ,i,j) ) * 0.5_rp
438 ! vel = ( 0.5_RP * ( mom(KS+1,i,j)+mom(KS+1,i-1,j) ) ) &
439 ! / DENS(KS+1,i,j)
440  vel = vel * j13g(ks+1,i,j)
441  flux(ks,i,j) = vel / mapf(i,j,+2) &
442  * ( val(ks,i,j) &
443  * ( 0.5_rp + sign(0.5_rp,vel) ) &
444  + ( 2.0_rp * val(ks,i,j) + 5.0_rp * val(ks+1,i,j) - val(ks+2,i,j) ) / 6.0_rp &
445  * ( 0.5_rp - sign(0.5_rp,vel) ) ) ! k = KS+1
446 
447 
448  flux(ke-1,i,j) = 0.0_rp
449  enddo
450  enddo
451  !$omp end do nowait
452 
453  !$omp end parallel
454 
455  return
456  end subroutine atmos_dyn_fvm_fluxj13_xyw_ud1
457 
458  !-----------------------------------------------------------------------------
460  subroutine atmos_dyn_fvm_fluxj23_xyw_ud1( &
461  flux, &
462  mom, val, DENS, &
463  GSQRT, J23G, MAPF, &
464  CDZ, TwoD, &
465  IIS, IIE, JJS, JJE )
466  implicit none
467 
468  real(rp), intent(inout) :: flux (ka,ia,ja)
469  real(rp), intent(in) :: mom (ka,ia,ja)
470  real(rp), intent(in) :: val (ka,ia,ja)
471  real(rp), intent(in) :: dens (ka,ia,ja)
472  real(rp), intent(in) :: gsqrt (ka,ia,ja)
473  real(rp), intent(in) :: j23g (ka,ia,ja)
474  real(rp), intent(in) :: mapf ( ia,ja,2)
475  real(rp), intent(in) :: cdz (ka)
476  logical, intent(in) :: twod
477  integer, intent(in) :: iis, iie, jjs, jje
478 
479  real(rp) :: vel
480  integer :: k, i, j
481  !---------------------------------------------------------------------------
482 
483  !$omp parallel default(none) private(i,j,k,vel) &
484  !$omp shared(JJS,JJE,IIS,IIE,KS,KE,mom,val,DENS,flux,J23G,MAPF)
485 
486  !$omp do OMP_SCHEDULE_ collapse(2)
487  do j = jjs, jje
488  do i = iis, iie
489  do k = ks+2, ke-1
490  vel = ( 0.5_rp * ( mom(k,i,j)+mom(k,i,j-1) ) ) &
491  / dens(k,i,j)
492  vel = vel * j23g(k,i,j)
493  flux(k-1,i,j) = vel / mapf(i,j,+1) &
494  * ( f1 * ( val(k,i,j)+val(k-1,i,j) ) - sign(f1,vel) * ( val(k,i,j)-val(k-1,i,j) ) )
495  enddo
496  enddo
497  enddo
498  !$omp end do nowait
499 
500  !$omp do OMP_SCHEDULE_ collapse(2)
501  do j = jjs, jje
502  do i = iis, iie
503  ! The boundary condition is qflx_hi + qflxJ13 + qfluxJ23 = 0 at KS.
504  ! The flux at KS can be non-zero.
505  ! To reduce calculations, all the fluxes are set to zero.
506  flux(ks-1,i,j) = 0.0_rp ! k = KS
507 
508  ! physically incorrect but for numerical stability
509  vel = ( ( 0.5_rp * ( mom(ks+1,i,j)+mom(ks+1,i,j-1) ) ) / dens(ks+1,i,j) &
510  + ( 0.5_rp * ( mom(ks,i,j)+mom(ks,i,j-1) ) ) / dens(ks ,i,j) ) * 0.5_rp
511 ! vel = ( 0.5_RP * ( mom(KS+1,i,j)+mom(KS+1,i,j-1) ) ) &
512 ! / DENS(KS+1,i,j)
513  vel = vel * j23g(ks+1,i,j)
514  flux(ks,i,j) = vel / mapf(i,j,+1) &
515  * ( val(ks,i,j) &
516  * ( 0.5_rp + sign(0.5_rp,vel) ) &
517  + ( 2.0_rp * val(ks,i,j) + 5.0_rp * val(ks+1,i,j) - val(ks+2,i,j) ) / 6.0_rp &
518  * ( 0.5_rp - sign(0.5_rp,vel) ) ) ! k = KS+1
519 
520 
521  flux(ke-1,i,j) = 0.0_rp
522  enddo
523  enddo
524  !$omp end do nowait
525 
526  !$omp end parallel
527 
528  return
529  end subroutine atmos_dyn_fvm_fluxj23_xyw_ud1
530 
531 
532  !-----------------------------------------------------------------------------
534  subroutine atmos_dyn_fvm_fluxx_xyw_ud1( &
535  flux, &
536  mom, val, DENS, &
537  GSQRT, MAPF, &
538  num_diff, &
539  CDZ, TwoD, &
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) :: mapf ( ia,ja,2)
549  real(rp), intent(in) :: num_diff(ka,ia,ja)
550  real(rp), intent(in) :: cdz (ka)
551  logical, intent(in) :: twod
552  integer, intent(in) :: iis, iie, jjs, jje
553 
554  real(rp) :: vel
555  integer :: k, i, j
556  !---------------------------------------------------------------------------
557 
558  !$omp parallel default(none) private(i,j,k,vel) &
559  !$omp shared(JJS,JJE,IIS,IIE,KS,KE,mom,val,DENS,flux,GSQRT,MAPF,num_diff) &
560  !$omp shared(CDZ)
561 
562  !$omp do OMP_SCHEDULE_ collapse(2)
563  do j = jjs, jje
564  do i = iis-1, iie
565  do k = ks, ke-1
566 #ifdef DEBUG
567  call check( __line__, mom(k ,i,j) )
568  call check( __line__, mom(k+1,i,j) )
569 
570  call check( __line__, val(k,i,j) )
571  call check( __line__, val(k,i+1,j) )
572 
573 #endif
574  vel = ( f2h(k,1,i_uyz) &
575  * mom(k+1,i,j) &
576  + f2h(k,2,i_uyz) &
577  * mom(k,i,j) ) &
578  / ( f2h(k,1,i_uyz) &
579  * 0.5_rp * ( dens(k+1,i,j)+dens(k+1,i+1,j) ) &
580  + f2h(k,2,i_uyz) &
581  * 0.5_rp * ( dens(k,i,j)+dens(k,i+1,j) ) )
582  flux(k,i,j) = gsqrt(k,i,j) / mapf(i,j,+2) * vel &
583  * ( f1 * ( val(k,i+1,j)+val(k,i,j) ) - sign(f1,vel) * ( val(k,i+1,j)-val(k,i,j) ) )
584  enddo
585  enddo
586  enddo
587  !$omp end do nowait
588 #ifdef DEBUG
589  k = iundef; i = iundef; j = iundef
590 #endif
591 
592  !$omp do OMP_SCHEDULE_ collapse(2)
593  do j = jjs, jje
594  do i = iis-1, iie
595  flux(ke,i,j) = 0.0_rp
596  enddo
597  enddo
598  !$omp end do nowait
599 
600  !$omp end parallel
601 #ifdef DEBUG
602  k = iundef; i = iundef; j = iundef
603 #endif
604 
605  return
606  end subroutine atmos_dyn_fvm_fluxx_xyw_ud1
607 
608  !-----------------------------------------------------------------------------
610  subroutine atmos_dyn_fvm_fluxy_xyw_ud1( &
611  flux, &
612  mom, val, DENS, &
613  GSQRT, MAPF, &
614  num_diff, &
615  CDZ, TwoD, &
616  IIS, IIE, JJS, JJE )
617  implicit none
618 
619  real(rp), intent(inout) :: flux (ka,ia,ja)
620  real(rp), intent(in) :: mom (ka,ia,ja)
621  real(rp), intent(in) :: val (ka,ia,ja)
622  real(rp), intent(in) :: dens (ka,ia,ja)
623  real(rp), intent(in) :: gsqrt (ka,ia,ja)
624  real(rp), intent(in) :: mapf ( ia,ja,2)
625  real(rp), intent(in) :: num_diff(ka,ia,ja)
626  real(rp), intent(in) :: cdz (ka)
627  logical, intent(in) :: twod
628  integer, intent(in) :: iis, iie, jjs, jje
629 
630  real(rp) :: vel
631  integer :: k, i, j
632  !---------------------------------------------------------------------------
633 
634  !$omp parallel default(none) private(i,j,k,vel) &
635  !$omp shared(JJS,JJE,IIS,IIE,KS,KE,mom,val,DENS,flux,GSQRT,MAPF,num_diff) &
636  !$omp shared(CDZ)
637 
638  !$omp do OMP_SCHEDULE_ collapse(2)
639  do j = jjs-1, jje
640  do i = iis, iie
641  do k = ks, ke-1
642 #ifdef DEBUG
643  call check( __line__, mom(k ,i,j) )
644  call check( __line__, mom(k+1,i,j) )
645 
646  call check( __line__, val(k,i,j) )
647  call check( __line__, val(k,i,j+1) )
648 
649 #endif
650  vel = ( f2h(k,1,i_xvz) &
651  * mom(k+1,i,j) &
652  + f2h(k,2,i_xvz) &
653  * mom(k,i,j) ) &
654  / ( f2h(k,1,i_xvz) &
655  * 0.5_rp * ( dens(k+1,i,j)+dens(k+1,i,j+1) ) &
656  + f2h(k,2,i_xvz) &
657  * 0.5_rp * ( dens(k,i,j)+dens(k,i,j+1) ) )
658  flux(k,i,j) = gsqrt(k,i,j) / mapf(i,j,+1) * vel &
659  * ( f1 * ( val(k,i,j+1)+val(k,i,j) ) - sign(f1,vel) * ( val(k,i,j+1)-val(k,i,j) ) )
660  enddo
661  enddo
662  enddo
663  !$omp end do nowait
664 #ifdef DEBUG
665  k = iundef; i = iundef; j = iundef
666 #endif
667 
668  !$omp do OMP_SCHEDULE_ collapse(2)
669  do j = jjs-1, jje
670  do i = iis, iie
671  flux(ke,i,j) = 0.0_rp
672  enddo
673  enddo
674  !$omp end do nowait
675 
676  !$omp end parallel
677 #ifdef DEBUG
678  k = iundef; i = iundef; j = iundef
679 #endif
680 
681  return
682  end subroutine atmos_dyn_fvm_fluxy_xyw_ud1
683 
684 
685  !-----------------------------------------------------------------------------
687  subroutine atmos_dyn_fvm_fluxz_uyz_ud1( &
688  flux, &
689  mom, val, DENS, &
690  GSQRT, J33G, &
691  num_diff, &
692  CDZ, TwoD, &
693  IIS, IIE, JJS, JJE )
694  implicit none
695 
696  real(rp), intent(inout) :: flux (ka,ia,ja)
697  real(rp), intent(in) :: mom (ka,ia,ja)
698  real(rp), intent(in) :: val (ka,ia,ja)
699  real(rp), intent(in) :: dens (ka,ia,ja)
700  real(rp), intent(in) :: gsqrt (ka,ia,ja)
701  real(rp), intent(in) :: j33g
702  real(rp), intent(in) :: num_diff(ka,ia,ja)
703  real(rp), intent(in) :: cdz (ka)
704  logical, intent(in) :: twod
705  integer, intent(in) :: iis, iie, jjs, jje
706 
707  real(rp) :: vel
708  integer :: k, i, j
709  !---------------------------------------------------------------------------
710 
711  !$omp parallel default(none) private(i,j,k,vel) &
712  !$omp shared(JJS,JJE,IIS,IIE,KS,KE,mom,val,DENS,flux,J33G,GSQRT,num_diff) &
713  !$omp shared(CDZ,TwoD)
714 
715 
716  if ( twod ) then
717 
718  !$omp do OMP_SCHEDULE_
719  do j = jjs, jje
720  do k = ks, ke-1
721 #ifdef DEBUG
722  call check( __line__, mom(k,i,j) )
723 
724  call check( __line__, val(k,i,j) )
725  call check( __line__, val(k+1,i,j) )
726 
727 #endif
728  i = iis
729  vel = ( mom(k,i,j) ) &
730  / ( f2h(k,1,i_xyz) &
731  * dens(k+1,i,j) &
732  + f2h(k,2,i_xyz) &
733  * dens(k,i,j) )
734  flux(k,i,j) = j33g * vel &
735  * ( f1 * ( val(k+1,i,j)+val(k,i,j) ) - sign(f1,vel) * ( val(k+1,i,j)-val(k,i,j) ) )
736  enddo
737  enddo
738  !$omp end do nowait
739 #ifdef DEBUG
740  k = iundef; i = iundef; j = iundef
741 #endif
742 
743  !$omp do OMP_SCHEDULE_
744  do j = jjs, jje
745 #ifdef DEBUG
746 
747 #endif
748  i = iis
749  ! The boundary condition is qflx_hi + qflxJ13 + qfluxJ23 = 0 at KS-1.
750  ! The flux at KS-1 can be non-zero.
751  ! To reduce calculations, all the fluxes are set to zero.
752  flux(ks-1,i,j) = 0.0_rp
753 
754  flux(ke,i,j) = 0.0_rp
755  enddo
756  !$omp end do nowait
757 
758  else
759 
760 
761  !$omp do OMP_SCHEDULE_ collapse(2)
762  do j = jjs, jje
763  do i = iis, iie
764  do k = ks, ke-1
765 #ifdef DEBUG
766  call check( __line__, mom(k,i,j) )
767  call check( __line__, mom(k,i+1,j) )
768 
769  call check( __line__, val(k,i,j) )
770  call check( __line__, val(k+1,i,j) )
771 
772 #endif
773  vel = ( 0.5_rp * ( mom(k,i,j)+mom(k,i+1,j) ) ) &
774  / ( f2h(k,1,i_uyz) &
775  * 0.5_rp * ( dens(k+1,i,j)+dens(k+1,i+1,j) ) &
776  + f2h(k,2,i_uyz) &
777  * 0.5_rp * ( dens(k,i,j)+dens(k,i+1,j) ) )
778  flux(k,i,j) = j33g * vel &
779  * ( f1 * ( val(k+1,i,j)+val(k,i,j) ) - sign(f1,vel) * ( val(k+1,i,j)-val(k,i,j) ) )
780  enddo
781  enddo
782  enddo
783  !$omp end do nowait
784 #ifdef DEBUG
785  k = iundef; i = iundef; j = iundef
786 #endif
787 
788  !$omp do OMP_SCHEDULE_ collapse(2)
789  do j = jjs, jje
790  do i = iis, iie
791 #ifdef DEBUG
792 
793 #endif
794  ! The boundary condition is qflx_hi + qflxJ13 + qfluxJ23 = 0 at KS-1.
795  ! The flux at KS-1 can be non-zero.
796  ! To reduce calculations, all the fluxes are set to zero.
797  flux(ks-1,i,j) = 0.0_rp
798 
799  flux(ke,i,j) = 0.0_rp
800  enddo
801  enddo
802  !$omp end do nowait
803 
804  end if
805 
806 
807  !$omp end parallel
808 #ifdef DEBUG
809  k = iundef; i = iundef; j = iundef
810 #endif
811 
812  return
813  end subroutine atmos_dyn_fvm_fluxz_uyz_ud1
814 
815  !-----------------------------------------------------------------------------
817  subroutine atmos_dyn_fvm_fluxj13_uyz_ud1( &
818  flux, &
819  mom, val, DENS, &
820  GSQRT, J13G, MAPF, &
821  CDZ, TwoD, &
822  IIS, IIE, JJS, JJE )
823  implicit none
824 
825  real(rp), intent(inout) :: flux (ka,ia,ja)
826  real(rp), intent(in) :: mom (ka,ia,ja)
827  real(rp), intent(in) :: val (ka,ia,ja)
828  real(rp), intent(in) :: dens (ka,ia,ja)
829  real(rp), intent(in) :: gsqrt (ka,ia,ja)
830  real(rp), intent(in) :: j13g (ka,ia,ja)
831  real(rp), intent(in) :: mapf ( ia,ja,2)
832  real(rp), intent(in) :: cdz (ka)
833  logical, intent(in) :: twod
834  integer, intent(in) :: iis, iie, jjs, jje
835 
836  real(rp) :: vel
837  integer :: k, i, j
838  !---------------------------------------------------------------------------
839 
840  !$omp parallel default(none) private(i,j,k,vel) &
841  !$omp shared(JJS,JJE,IIS,IIE,KS,KE,mom,val,DENS,flux,J13G,MAPF) &
842  !$omp shared(GSQRT,CDZ,TwoD)
843 
844 
845 
846  !$omp do OMP_SCHEDULE_ collapse(2)
847  do j = jjs, jje
848  do i = iis, iie
849  do k = ks, ke-1
850  vel = ( f2h(k,1,i_uyz) &
851  * mom(k+1,i,j) &
852  + f2h(k,2,i_uyz) &
853  * mom(k,i,j) ) &
854  / ( f2h(k,1,i_uyz) &
855  * 0.5_rp * ( dens(k+1,i,j)+dens(k+1,i+1,j) ) &
856  + f2h(k,2,i_uyz) &
857  * 0.5_rp * ( dens(k,i,j)+dens(k,i+1,j) ) )
858  vel = vel * j13g(k,i,j)
859  flux(k,i,j) = vel / mapf(i,j,+2) &
860  * ( f1 * ( val(k+1,i,j)+val(k,i,j) ) - sign(f1,vel) * ( val(k+1,i,j)-val(k,i,j) ) )
861  enddo
862  enddo
863  enddo
864  !$omp end do nowait
865 
866  !$omp do OMP_SCHEDULE_ collapse(2)
867  do j = jjs, jje
868  do i = iis, iie
869  ! The boundary condition is qflx_hi + qflxJ13 + qfluxJ23 = 0 at KS-1.
870  ! The flux at KS-1 can be non-zero.
871  ! To reduce calculations, all the fluxes are set to zero.
872  flux(ks-1,i,j) = 0.0_rp
873 
874  flux(ke ,i,j) = 0.0_rp
875  enddo
876  enddo
877  !$omp end do nowait
878 
879 
880 
881  !$omp end parallel
882  return
883  end subroutine atmos_dyn_fvm_fluxj13_uyz_ud1
884 
885  !-----------------------------------------------------------------------------
887  subroutine atmos_dyn_fvm_fluxj23_uyz_ud1( &
888  flux, &
889  mom, val, DENS, &
890  GSQRT, J23G, MAPF, &
891  CDZ, TwoD, &
892  IIS, IIE, JJS, JJE )
893  implicit none
894 
895  real(rp), intent(inout) :: flux (ka,ia,ja)
896  real(rp), intent(in) :: mom (ka,ia,ja)
897  real(rp), intent(in) :: val (ka,ia,ja)
898  real(rp), intent(in) :: dens (ka,ia,ja)
899  real(rp), intent(in) :: gsqrt (ka,ia,ja)
900  real(rp), intent(in) :: j23g (ka,ia,ja)
901  real(rp), intent(in) :: mapf ( ia,ja,2)
902  real(rp), intent(in) :: cdz (ka)
903  logical, intent(in) :: twod
904  integer, intent(in) :: iis, iie, jjs, jje
905 
906  real(rp) :: vel
907  integer :: k, i, j
908  !---------------------------------------------------------------------------
909 
910  !$omp parallel default(none) private(i,j,k,vel) &
911  !$omp shared(JJS,JJE,IIS,IIE,KS,KE,mom,val,DENS,flux,J23G,MAPF) &
912  !$omp shared(GSQRT,CDZ,TwoD)
913 
914 
915  if ( twod ) then
916 
917  !$omp do OMP_SCHEDULE_
918  do j = jjs, jje
919  do k = ks, ke-1
920  i = iis
921  vel = ( f2h(k,1,i_xyz) &
922  * 0.5_rp * ( mom(k+1,i,j)+mom(k+1,i,j-1) ) &
923  + f2h(k,2,i_xyz) &
924  * 0.5_rp * ( mom(k,i,j)+mom(k,i,j-1) ) ) &
925  / ( f2h(k,1,i_xyz) &
926  * dens(k+1,i,j) &
927  + f2h(k,2,i_xyz) &
928  * dens(k,i,j) )
929  vel = vel * j23g(k,i,j)
930  flux(k,i,j) = vel * ( f1 * ( val(k+1,i,j)+val(k,i,j) ) - sign(f1,vel) * ( val(k+1,i,j)-val(k,i,j) ) )
931  enddo
932  enddo
933  !$omp end do nowait
934 
935  !$omp do OMP_SCHEDULE_
936  do j = jjs, jje
937  i = iis
938  ! The boundary condition is qflx_hi + qflxJ13 + qfluxJ23 = 0 at KS-1.
939  ! The flux at KS-1 can be non-zero.
940  ! To reduce calculations, all the fluxes are set to zero.
941  flux(ks-1,i,j) = 0.0_rp
942 
943  flux(ke ,i,j) = 0.0_rp
944  enddo
945  !$omp end do nowait
946 
947  else
948 
949 
950  !$omp do OMP_SCHEDULE_ collapse(2)
951  do j = jjs, jje
952  do i = iis, iie
953  do k = ks, ke-1
954  vel = ( f2h(k,1,i_uyz) &
955  * 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) ) &
956  + f2h(k,2,i_uyz) &
957  * 0.25_rp * ( mom(k,i,j)+mom(k,i+1,j)+mom(k,i,j-1)+mom(k,i+1,j-1) ) ) &
958  / ( f2h(k,1,i_uyz) &
959  * 0.5_rp * ( dens(k+1,i,j)+dens(k+1,i+1,j) ) &
960  + f2h(k,2,i_uyz) &
961  * 0.5_rp * ( dens(k,i,j)+dens(k,i+1,j) ) )
962  vel = vel * j23g(k,i,j)
963  flux(k,i,j) = vel / mapf(i,j,+1) &
964  * ( f1 * ( val(k+1,i,j)+val(k,i,j) ) - sign(f1,vel) * ( val(k+1,i,j)-val(k,i,j) ) )
965  enddo
966  enddo
967  enddo
968  !$omp end do nowait
969 
970  !$omp do OMP_SCHEDULE_ collapse(2)
971  do j = jjs, jje
972  do i = iis, iie
973  ! The boundary condition is qflx_hi + qflxJ13 + qfluxJ23 = 0 at KS-1.
974  ! The flux at KS-1 can be non-zero.
975  ! To reduce calculations, all the fluxes are set to zero.
976  flux(ks-1,i,j) = 0.0_rp
977 
978  flux(ke ,i,j) = 0.0_rp
979  enddo
980  enddo
981  !$omp end do nowait
982 
983 
984  end if
985 
986 
987  !$omp end parallel
988  return
989  end subroutine atmos_dyn_fvm_fluxj23_uyz_ud1
990 
991  !-----------------------------------------------------------------------------
993  subroutine atmos_dyn_fvm_fluxx_uyz_ud1( &
994  flux, &
995  mom, val, DENS, &
996  GSQRT, MAPF, &
997  num_diff, &
998  CDZ, TwoD, &
999  IIS, IIE, JJS, JJE )
1000  implicit none
1001 
1002  real(rp), intent(inout) :: flux (ka,ia,ja)
1003  real(rp), intent(in) :: mom (ka,ia,ja)
1004  real(rp), intent(in) :: val (ka,ia,ja)
1005  real(rp), intent(in) :: dens (ka,ia,ja)
1006  real(rp), intent(in) :: gsqrt (ka,ia,ja)
1007  real(rp), intent(in) :: mapf ( ia,ja,2)
1008  real(rp), intent(in) :: num_diff(ka,ia,ja)
1009  real(rp), intent(in) :: cdz (ka)
1010  logical, intent(in) :: twod
1011  integer, intent(in) :: iis, iie, jjs, jje
1012 
1013  real(rp) :: vel
1014  integer :: k, i, j
1015  !---------------------------------------------------------------------------
1016 
1017  ! note that x-index is added by -1
1018 
1019 
1020 
1021  !$omp parallel do default(none) private(i,j,k) OMP_SCHEDULE_ collapse(2) &
1022  !$omp private(vel) &
1023  !$omp shared(JJS,JJE,IIS,IIE,KS,KE,mom,val,DENS,flux,GSQRT,MAPF,num_diff)
1024  do j = jjs, jje
1025  do i = iis, iie+1
1026  do k = ks, ke
1027 #ifdef DEBUG
1028  call check( __line__, mom(k,i ,j) )
1029  call check( __line__, mom(k,i-1,j) )
1030 
1031  call check( __line__, val(k,i-1,j) )
1032  call check( __line__, val(k,i,j) )
1033 
1034 #endif
1035  vel = ( 0.5_rp * ( mom(k,i,j)+mom(k,i-1,j) ) ) &
1036  / ( dens(k,i,j) )
1037  flux(k,i-1,j) = gsqrt(k,i,j) / mapf(i,j,+2) * vel &
1038  * ( f1 * ( val(k,i,j)+val(k,i-1,j) ) - sign(f1,vel) * ( val(k,i,j)-val(k,i-1,j) ) )
1039  enddo
1040  enddo
1041  enddo
1042 #ifdef DEBUG
1043  k = iundef; i = iundef; j = iundef
1044 #endif
1045 
1046 
1047 
1048  return
1049  end subroutine atmos_dyn_fvm_fluxx_uyz_ud1
1050 
1051  !-----------------------------------------------------------------------------
1053  subroutine atmos_dyn_fvm_fluxy_uyz_ud1( &
1054  flux, &
1055  mom, val, DENS, &
1056  GSQRT, MAPF, &
1057  num_diff, &
1058  CDZ, TwoD, &
1059  IIS, IIE, JJS, JJE )
1060  implicit none
1061 
1062  real(rp), intent(inout) :: flux (ka,ia,ja)
1063  real(rp), intent(in) :: mom (ka,ia,ja)
1064  real(rp), intent(in) :: val (ka,ia,ja)
1065  real(rp), intent(in) :: dens (ka,ia,ja)
1066  real(rp), intent(in) :: gsqrt (ka,ia,ja)
1067  real(rp), intent(in) :: mapf ( ia,ja,2)
1068  real(rp), intent(in) :: num_diff(ka,ia,ja)
1069  real(rp), intent(in) :: cdz (ka)
1070  logical, intent(in) :: twod
1071  integer, intent(in) :: iis, iie, jjs, jje
1072 
1073  real(rp) :: vel
1074  integer :: k, i, j
1075  !---------------------------------------------------------------------------
1076 
1077 
1078 
1079  if ( twod ) then
1080 
1081  !$omp parallel do default(none) private(i,j,k) OMP_SCHEDULE_ &
1082  !$omp private(vel) &
1083  !$omp shared(JJS,JJE,IIS,IIE,KS,KE,mom,val,DENS,flux,GSQRT,MAPF,num_diff,TwoD)
1084  do j = jjs-1, jje
1085  do k = ks, ke
1086  i = iis
1087 #ifdef DEBUG
1088  call check( __line__, mom(k,i ,j) )
1089 
1090  call check( __line__, val(k,i,j) )
1091  call check( __line__, val(k,i,j+1) )
1092 
1093 #endif
1094  vel = ( mom(k,i,j) ) &
1095  / ( 0.5_rp * ( dens(k,i,j)+dens(k,i,j+1) ) )
1096  flux(k,i,j) = gsqrt(k,i,j) / mapf(i,j,+1) * vel &
1097  * ( f1 * ( val(k,i,j+1)+val(k,i,j) ) - sign(f1,vel) * ( val(k,i,j+1)-val(k,i,j) ) )
1098  enddo
1099  enddo
1100 #ifdef DEBUG
1101  k = iundef; i = iundef; j = iundef
1102 #endif
1103 
1104  else
1105 
1106 
1107  !$omp parallel do default(none) private(i,j,k) OMP_SCHEDULE_ collapse(2) &
1108  !$omp private(vel) &
1109  !$omp shared(JJS,JJE,IIS,IIE,KS,KE,mom,val,DENS,flux,GSQRT,MAPF,num_diff)
1110  do j = jjs-1, jje
1111  do i = iis, iie
1112  do k = ks, ke
1113 #ifdef DEBUG
1114  call check( __line__, mom(k,i ,j) )
1115  call check( __line__, mom(k,i-1,j) )
1116 
1117  call check( __line__, val(k,i,j) )
1118  call check( __line__, val(k,i,j+1) )
1119 
1120 #endif
1121  vel = ( 0.5_rp * ( mom(k,i,j)+mom(k,i+1,j) ) ) &
1122  / ( 0.25_rp * ( dens(k,i,j)+dens(k,i+1,j)+dens(k,i,j+1)+dens(k,i+1,j+1) ) )
1123  flux(k,i,j) = gsqrt(k,i,j) / mapf(i,j,+1) * vel &
1124  * ( f1 * ( val(k,i,j+1)+val(k,i,j) ) - sign(f1,vel) * ( val(k,i,j+1)-val(k,i,j) ) )
1125  enddo
1126  enddo
1127  enddo
1128 #ifdef DEBUG
1129  k = iundef; i = iundef; j = iundef
1130 #endif
1131 
1132 
1133  end if
1134 
1135 
1136  return
1137  end subroutine atmos_dyn_fvm_fluxy_uyz_ud1
1138 
1139 
1140 
1141  !-----------------------------------------------------------------------------
1143  subroutine atmos_dyn_fvm_fluxz_xvz_ud1( &
1144  flux, &
1145  mom, val, DENS, &
1146  GSQRT, J33G, &
1147  num_diff, &
1148  CDZ, TwoD, &
1149  IIS, IIE, JJS, JJE )
1150  implicit none
1151 
1152  real(rp), intent(inout) :: flux (ka,ia,ja)
1153  real(rp), intent(in) :: mom (ka,ia,ja)
1154  real(rp), intent(in) :: val (ka,ia,ja)
1155  real(rp), intent(in) :: dens (ka,ia,ja)
1156  real(rp), intent(in) :: gsqrt (ka,ia,ja)
1157  real(rp), intent(in) :: j33g
1158  real(rp), intent(in) :: num_diff(ka,ia,ja)
1159  real(rp), intent(in) :: cdz (ka)
1160  logical, intent(in) :: twod
1161  integer, intent(in) :: iis, iie, jjs, jje
1162 
1163  real(rp) :: vel
1164  integer :: k, i, j
1165  !---------------------------------------------------------------------------
1166 
1167  !$omp parallel default(none) private(i,j,k,vel) &
1168  !$omp shared(JJS,JJE,IIS,IIE,KS,KE,mom,val,DENS,flux,J33G,GSQRT,num_diff) &
1169  !$omp shared(CDZ,TwoD)
1170 
1171 
1172  !$omp do OMP_SCHEDULE_ collapse(2)
1173  do j = jjs, jje
1174  do i = iis, iie
1175  do k = ks, ke-1
1176 #ifdef DEBUG
1177  call check( __line__, mom(k,i,j) )
1178  call check( __line__, mom(k,i,j+1) )
1179 
1180  call check( __line__, val(k,i,j) )
1181  call check( __line__, val(k+1,i,j) )
1182 
1183 #endif
1184  vel = ( 0.5_rp * ( mom(k,i,j)+mom(k,i,j+1) ) ) &
1185  / ( f2h(k,1,i_xvz) &
1186  * 0.5_rp * ( dens(k+1,i,j)+dens(k+1,i,j+1) ) &
1187  + f2h(k,2,i_xvz) &
1188  * 0.5_rp * ( dens(k,i,j)+dens(k,i,j+1) ) )
1189  flux(k,i,j) = j33g * vel &
1190  * ( f1 * ( val(k+1,i,j)+val(k,i,j) ) - sign(f1,vel) * ( val(k+1,i,j)-val(k,i,j) ) )
1191  enddo
1192  enddo
1193  enddo
1194  !$omp end do nowait
1195 #ifdef DEBUG
1196  k = iundef; i = iundef; j = iundef
1197 #endif
1198 
1199  !$omp do OMP_SCHEDULE_ collapse(2)
1200  do j = jjs, jje
1201  do i = iis, iie
1202 #ifdef DEBUG
1203 
1204 #endif
1205  ! The boundary condition is qflx_hi + qflxJ13 + qfluxJ23 = 0 at KS-1.
1206  ! The flux at KS-1 can be non-zero.
1207  ! To reduce calculations, all the fluxes are set to zero.
1208  flux(ks-1,i,j) = 0.0_rp
1209 
1210  flux(ke,i,j) = 0.0_rp
1211  enddo
1212  enddo
1213  !$omp end do nowait
1214 
1215 
1216  !$omp end parallel
1217 #ifdef DEBUG
1218  k = iundef; i = iundef; j = iundef
1219 #endif
1220 
1221  return
1222  end subroutine atmos_dyn_fvm_fluxz_xvz_ud1
1223 
1224  !-----------------------------------------------------------------------------
1226  subroutine atmos_dyn_fvm_fluxj13_xvz_ud1( &
1227  flux, &
1228  mom, val, DENS, &
1229  GSQRT, J13G, MAPF, &
1230  CDZ, TwoD, &
1231  IIS, IIE, JJS, JJE )
1232  implicit none
1233 
1234  real(rp), intent(inout) :: flux (ka,ia,ja)
1235  real(rp), intent(in) :: mom (ka,ia,ja)
1236  real(rp), intent(in) :: val (ka,ia,ja)
1237  real(rp), intent(in) :: dens (ka,ia,ja)
1238  real(rp), intent(in) :: gsqrt (ka,ia,ja)
1239  real(rp), intent(in) :: j13g (ka,ia,ja)
1240  real(rp), intent(in) :: mapf ( ia,ja,2)
1241  real(rp), intent(in) :: cdz (ka)
1242  logical, intent(in) :: twod
1243  integer, intent(in) :: iis, iie, jjs, jje
1244 
1245  real(rp) :: vel
1246  integer :: k, i, j
1247  !---------------------------------------------------------------------------
1248 
1249  !$omp parallel default(none) private(i,j,k,vel) &
1250  !$omp shared(JJS,JJE,IIS,IIE,KS,KE,mom,val,DENS,flux,J13G,MAPF) &
1251  !$omp shared(GSQRT,CDZ,TwoD)
1252 
1253 
1254 
1255  !$omp do OMP_SCHEDULE_ collapse(2)
1256  do j = jjs, jje
1257  do i = iis, iie
1258  do k = ks, ke-1
1259  vel = ( f2h(k,1,i_xvz) &
1260  * 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) ) &
1261  + f2h(k,2,i_xvz) &
1262  * 0.25_rp * ( mom(k,i,j)+mom(k,i-1,j)+mom(k,i,j+1)+mom(k,i-1,j+1) ) ) &
1263  / ( f2h(k,1,i_xvz) &
1264  * 0.5_rp * ( dens(k+1,i,j)+dens(k+1,i,j+1) ) &
1265  + f2h(k,2,i_xvz) &
1266  * 0.5_rp * ( dens(k,i,j)+dens(k,i,j+1) ) )
1267  vel = vel * j13g(k,i,j)
1268  flux(k,i,j) = vel / mapf(i,j,+2) &
1269  * ( f1 * ( val(k+1,i,j)+val(k,i,j) ) - sign(f1,vel) * ( val(k+1,i,j)-val(k,i,j) ) )
1270  enddo
1271  enddo
1272  enddo
1273  !$omp end do nowait
1274 
1275  !$omp do OMP_SCHEDULE_ collapse(2)
1276  do j = jjs, jje
1277  do i = iis, iie
1278  ! The boundary condition is qflx_hi + qflxJ13 + qfluxJ23 = 0 at KS-1.
1279  ! The flux at KS-1 can be non-zero.
1280  ! To reduce calculations, all the fluxes are set to zero.
1281  flux(ks-1,i,j) = 0.0_rp
1282 
1283  flux(ke ,i,j) = 0.0_rp
1284  enddo
1285  enddo
1286  !$omp end do nowait
1287 
1288 
1289 
1290  !$omp end parallel
1291  return
1292  end subroutine atmos_dyn_fvm_fluxj13_xvz_ud1
1293 
1294  !-----------------------------------------------------------------------------
1296  subroutine atmos_dyn_fvm_fluxj23_xvz_ud1( &
1297  flux, &
1298  mom, val, DENS, &
1299  GSQRT, J23G, MAPF, &
1300  CDZ, TwoD, &
1301  IIS, IIE, JJS, JJE )
1302  implicit none
1303 
1304  real(rp), intent(inout) :: flux (ka,ia,ja)
1305  real(rp), intent(in) :: mom (ka,ia,ja)
1306  real(rp), intent(in) :: val (ka,ia,ja)
1307  real(rp), intent(in) :: dens (ka,ia,ja)
1308  real(rp), intent(in) :: gsqrt (ka,ia,ja)
1309  real(rp), intent(in) :: j23g (ka,ia,ja)
1310  real(rp), intent(in) :: mapf ( ia,ja,2)
1311  real(rp), intent(in) :: cdz (ka)
1312  logical, intent(in) :: twod
1313  integer, intent(in) :: iis, iie, jjs, jje
1314 
1315  real(rp) :: vel
1316  integer :: k, i, j
1317  !---------------------------------------------------------------------------
1318 
1319  !$omp parallel default(none) private(i,j,k,vel) &
1320  !$omp shared(JJS,JJE,IIS,IIE,KS,KE,mom,val,DENS,flux,J23G,MAPF) &
1321  !$omp shared(GSQRT,CDZ,TwoD)
1322 
1323 
1324 
1325  !$omp do OMP_SCHEDULE_ collapse(2)
1326  do j = jjs, jje
1327  do i = iis, iie
1328  do k = ks, ke-1
1329  vel = ( f2h(k,1,i_xvz) &
1330  * mom(k+1,i,j) &
1331  + f2h(k,2,i_xvz) &
1332  * mom(k,i,j) ) &
1333  / ( f2h(k,1,i_xvz) &
1334  * 0.5_rp * ( dens(k+1,i,j)+dens(k+1,i,j+1) ) &
1335  + f2h(k,2,i_xvz) &
1336  * 0.5_rp * ( dens(k,i,j)+dens(k,i,j+1) ) )
1337  vel = vel * j23g(k,i,j)
1338  flux(k,i,j) = vel / mapf(i,j,+1) &
1339  * ( f1 * ( val(k+1,i,j)+val(k,i,j) ) - sign(f1,vel) * ( val(k+1,i,j)-val(k,i,j) ) )
1340  enddo
1341  enddo
1342  enddo
1343  !$omp end do nowait
1344 
1345  !$omp do OMP_SCHEDULE_ collapse(2)
1346  do j = jjs, jje
1347  do i = iis, iie
1348  ! The boundary condition is qflx_hi + qflxJ13 + qfluxJ23 = 0 at KS-1.
1349  ! The flux at KS-1 can be non-zero.
1350  ! To reduce calculations, all the fluxes are set to zero.
1351  flux(ks-1,i,j) = 0.0_rp
1352 
1353  flux(ke ,i,j) = 0.0_rp
1354  enddo
1355  enddo
1356  !$omp end do nowait
1357 
1358 
1359 
1360  !$omp end parallel
1361  return
1362  end subroutine atmos_dyn_fvm_fluxj23_xvz_ud1
1363 
1364  !-----------------------------------------------------------------------------
1366  subroutine atmos_dyn_fvm_fluxx_xvz_ud1( &
1367  flux, &
1368  mom, val, DENS, &
1369  GSQRT, MAPF, &
1370  num_diff, &
1371  CDZ, TwoD, &
1372  IIS, IIE, JJS, JJE )
1373  implicit none
1374 
1375  real(rp), intent(inout) :: flux (ka,ia,ja)
1376  real(rp), intent(in) :: mom (ka,ia,ja)
1377  real(rp), intent(in) :: val (ka,ia,ja)
1378  real(rp), intent(in) :: dens (ka,ia,ja)
1379  real(rp), intent(in) :: gsqrt (ka,ia,ja)
1380  real(rp), intent(in) :: mapf ( ia,ja,2)
1381  real(rp), intent(in) :: num_diff(ka,ia,ja)
1382  real(rp), intent(in) :: cdz (ka)
1383  logical, intent(in) :: twod
1384  integer, intent(in) :: iis, iie, jjs, jje
1385 
1386  real(rp) :: vel
1387  integer :: k, i, j
1388  !---------------------------------------------------------------------------
1389 
1390 
1391 
1392  !$omp parallel do default(none) private(i,j,k) OMP_SCHEDULE_ collapse(2) &
1393  !$omp private(vel) &
1394  !$omp shared(JJS,JJE,IIS,IIE,KS,KE,mom,val,DENS,flux,GSQRT,MAPF,num_diff)
1395  do j = jjs, jje
1396  do i = iis-1, iie
1397  do k = ks, ke
1398 #ifdef DEBUG
1399  call check( __line__, mom(k,i ,j) )
1400  call check( __line__, mom(k,i,j-1) )
1401 
1402  call check( __line__, val(k,i,j) )
1403  call check( __line__, val(k,i+1,j) )
1404 
1405 #endif
1406  vel = ( 0.5_rp * ( mom(k,i,j)+mom(k,i,j+1) ) ) &
1407  / ( 0.25_rp * ( dens(k,i,j)+dens(k,i+1,j)+dens(k,i,j+1)+dens(k,i+1,j+1) ) )
1408  flux(k,i,j) = gsqrt(k,i,j) / mapf(i,j,+2) * vel &
1409  * ( f1 * ( val(k,i+1,j)+val(k,i,j) ) - sign(f1,vel) * ( val(k,i+1,j)-val(k,i,j) ) )
1410  enddo
1411  enddo
1412  enddo
1413 #ifdef DEBUG
1414  k = iundef; i = iundef; j = iundef
1415 #endif
1416 
1417 
1418 
1419  return
1420  end subroutine atmos_dyn_fvm_fluxx_xvz_ud1
1421 
1422  !-----------------------------------------------------------------------------
1424  subroutine atmos_dyn_fvm_fluxy_xvz_ud1( &
1425  flux, &
1426  mom, val, DENS, &
1427  GSQRT, MAPF, &
1428  num_diff, &
1429  CDZ, TwoD, &
1430  IIS, IIE, JJS, JJE )
1431  implicit none
1432 
1433  real(rp), intent(inout) :: flux (ka,ia,ja)
1434  real(rp), intent(in) :: mom (ka,ia,ja)
1435  real(rp), intent(in) :: val (ka,ia,ja)
1436  real(rp), intent(in) :: dens (ka,ia,ja)
1437  real(rp), intent(in) :: gsqrt (ka,ia,ja)
1438  real(rp), intent(in) :: mapf ( ia,ja,2)
1439  real(rp), intent(in) :: num_diff(ka,ia,ja)
1440  real(rp), intent(in) :: cdz (ka)
1441  logical, intent(in) :: twod
1442  integer, intent(in) :: iis, iie, jjs, jje
1443 
1444  real(rp) :: vel
1445  integer :: k, i, j
1446  !---------------------------------------------------------------------------
1447 
1448  ! note that y-index is added by -1
1449 
1450 
1451 
1452  !$omp parallel do default(none) private(i,j,k) OMP_SCHEDULE_ collapse(2) &
1453  !$omp private(vel) &
1454  !$omp shared(JJS,JJE,IIS,IIE,KS,KE,mom,val,DENS,flux,GSQRT,MAPF,num_diff)
1455  do j = jjs, jje+1
1456  do i = iis, iie
1457  do k = ks, ke
1458 #ifdef DEBUG
1459  call check( __line__, mom(k,i ,j) )
1460  call check( __line__, mom(k,i,j-1) )
1461 
1462  call check( __line__, val(k,i,j-1) )
1463  call check( __line__, val(k,i,j) )
1464 
1465 #endif
1466  vel = ( 0.5_rp * ( mom(k,i,j)+mom(k,i,j-1) ) ) &
1467  / ( dens(k,i,j) )
1468  flux(k,i,j-1) = gsqrt(k,i,j) / mapf(i,j,+1) * vel &
1469  * ( f1 * ( val(k,i,j)+val(k,i,j-1) ) - sign(f1,vel) * ( val(k,i,j)-val(k,i,j-1) ) )
1470  enddo
1471  enddo
1472  enddo
1473 #ifdef DEBUG
1474  k = iundef; i = iundef; j = iundef
1475 #endif
1476 
1477 
1478 
1479  return
1480  end subroutine atmos_dyn_fvm_fluxy_xvz_ud1
1481 
1482 
1483 
1484 
1485 
1486 
1487 
1488 end module scale_atmos_dyn_fvm_flux_ud1
1489 
1490 !--
1491 ! vi:set readonly sw=4 ts=8
1492 !
1493 !Local Variables:
1494 !mode: f90
1495 !buffer-read-only: t
1496 !End:
1497 !
1498 !++
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, TwoD, IIS, IIE, JJS, JJE)
calculation z-flux at XV
Definition: scale_atmos_dyn_fvm_flux_ud1.F90:1150
scale_atmos_grid_cartesc_index::ke
integer, public ke
end point of inner domain: z, local
Definition: scale_atmos_grid_cartesC_index.F90:52
scale_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, TwoD, IIS, IIE, JJS, JJE)
calculation X-flux at XYW
Definition: scale_atmos_dyn_fvm_flux_ud1.F90:541
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, TwoD, IIS, IIE, JJS, JJE)
calculation J23-flux at XYW
Definition: scale_atmos_dyn_fvm_flux_ud1.F90:466
scale_index
module Index
Definition: scale_index.F90:11
scale_const::const_undef2
integer, parameter, public const_undef2
undefined value (INT2)
Definition: scale_const.F90:38
scale_atmos_dyn_fvm_flux_ud1::atmos_dyn_fvm_fluxj13_uyz_ud1
subroutine, public atmos_dyn_fvm_fluxj13_uyz_ud1(flux, mom, val, DENS, GSQRT, J13G, MAPF, CDZ, TwoD, IIS, IIE, JJS, JJE)
calculation J13-flux at UYZ
Definition: scale_atmos_dyn_fvm_flux_ud1.F90:823
scale_precision
module PRECISION
Definition: scale_precision.F90:14
scale_atmos_grid_cartesc_index::ka
integer, public ka
Definition: scale_atmos_grid_cartesC_index.F90:47
scale_const::const_eps
real(rp), public const_eps
small number
Definition: scale_const.F90:33
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, TwoD, IIS, IIE, JJS, JJE)
calculation J23-flux at XVZ
Definition: scale_atmos_dyn_fvm_flux_ud1.F90:1302
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:212
scale_atmos_grid_cartesc_index::i_xyz
integer, public i_xyz
Definition: scale_atmos_grid_cartesC_index.F90:90
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:260
scale_prc
module PROCESS
Definition: scale_prc.F90:11
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, TwoD, IIS, IIE, JJS, JJE)
calculation X-flux at UY
Definition: scale_atmos_dyn_fvm_flux_ud1.F90:1000
scale_atmos_grid_cartesc_index::i_uyz
integer, public i_uyz
Definition: scale_atmos_grid_cartesC_index.F90:94
scale_io
module STDIO
Definition: scale_io.F90:10
scale_atmos_dyn_fvm_flux_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:142
scale_tracer::k
real(rp), public k
Definition: scale_tracer.F90:44
scale_atmos_grid_cartesc_index
module atmosphere / grid / cartesC index
Definition: scale_atmos_grid_cartesC_index.F90:12
scale_const
module CONSTANT
Definition: scale_const.F90:11
scale_atmos_grid_cartesc_index::ia
integer, public ia
Definition: scale_atmos_grid_cartesC_index.F90:48
scale_debug::check
subroutine, public check(current_line, v)
Undefined value checker.
Definition: scale_debug.F90:56
scale_atmos_dyn_fvm_flux_ud1
module scale_atmos_dyn_fvm_flux_ud1
Definition: scale_atmos_dyn_fvm_flux_ud1.F90:16
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, TwoD, IIS, IIE, JJS, JJE)
calculation J13-flux at XYW
Definition: scale_atmos_dyn_fvm_flux_ud1.F90:393
scale_atmos_grid_cartesc_index::i_xvz
integer, public i_xvz
Definition: scale_atmos_grid_cartesC_index.F90:95
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, TwoD, IIS, IIE, JJS, JJE)
calculation Y-flux at XV
Definition: scale_atmos_dyn_fvm_flux_ud1.F90:1431
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, TwoD, IIS, IIE, JJS, JJE)
calculation z-flux at UY
Definition: scale_atmos_dyn_fvm_flux_ud1.F90:694
scale_prof
module profiler
Definition: scale_prof.F90:11
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:101
scale_atmos_grid_cartesc_index::ja
integer, public ja
Definition: scale_atmos_grid_cartesC_index.F90:49
scale_tracer
module TRACER
Definition: scale_tracer.F90:12
scale_atmos_dyn_fvm_flux_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:311
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, TwoD, IIS, IIE, JJS, JJE)
calculation J13-flux at XVZ
Definition: scale_atmos_dyn_fvm_flux_ud1.F90:1232
scale_atmos_grid_cartesc_index::ks
integer, public ks
start point of inner domain: z, local
Definition: scale_atmos_grid_cartesC_index.F90:51
scale_debug
module DEBUG
Definition: scale_debug.F90:11
scale_atmos_dyn_fvm_flux_ud1::atmos_dyn_fvm_fluxj23_uyz_ud1
subroutine, public atmos_dyn_fvm_fluxj23_uyz_ud1(flux, mom, val, DENS, GSQRT, J23G, MAPF, CDZ, TwoD, IIS, IIE, JJS, JJE)
calculation J23-flux at UYZ
Definition: scale_atmos_dyn_fvm_flux_ud1.F90:893
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, TwoD, IIS, IIE, JJS, JJE)
calculation Y-flux at XYW
Definition: scale_atmos_dyn_fvm_flux_ud1.F90:617
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, TwoD, IIS, IIE, JJS, JJE)
calculation X-flux at XV
Definition: scale_atmos_dyn_fvm_flux_ud1.F90:1373
scale_const::const_undef
real(rp), public const_undef
Definition: scale_const.F90:41
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, TwoD, IIS, IIE, JJS, JJE)
calculation Y-flux at UY
Definition: scale_atmos_dyn_fvm_flux_ud1.F90:1060
Generated by   doxygen 1.8.17