SCALE-RM
Functions/Subroutines
scale_atmos_dyn_fvm_flux_ud3koren1993 Module Reference

module scale_atmos_dyn_fvm_flux_ud3Koren1993 More...

Functions/Subroutines

subroutine, public atmos_dyn_fvm_flux_valuew_z_ud3koren1993 (valW, mflx, val, GSQRT, CDZ)
 value at XYW More...
 
subroutine, public atmos_dyn_fvm_fluxz_xyz_ud3koren1993 (flux, mflx, val, GSQRT, num_diff, CDZ, IIS, IIE, JJS, JJE)
 calculation z-flux at XYZ More...
 
subroutine, public atmos_dyn_fvm_fluxx_xyz_ud3koren1993 (flux, mflx, val, GSQRT, num_diff, CDZ, IIS, IIE, JJS, JJE)
 calculation X-flux at XYZ More...
 
subroutine, public atmos_dyn_fvm_fluxy_xyz_ud3koren1993 (flux, mflx, val, GSQRT, num_diff, CDZ, IIS, IIE, JJS, JJE)
 calculation Y-flux at XYZ More...
 
subroutine, public atmos_dyn_fvm_fluxz_xyw_ud3koren1993 (flux, mom, val, DENS, GSQRT, J33G, num_diff, CDZ, FDZ, dtrk, IIS, IIE, JJS, JJE)
 calculation z-flux at XYW More...
 
subroutine, public atmos_dyn_fvm_fluxj13_xyw_ud3koren1993 (flux, mom, val, DENS, GSQRT, J13G, MAPF, CDZ, TwoD, IIS, IIE, JJS, JJE)
 calculation J13-flux at XYW More...
 
subroutine, public atmos_dyn_fvm_fluxj23_xyw_ud3koren1993 (flux, mom, val, DENS, GSQRT, J23G, MAPF, CDZ, TwoD, IIS, IIE, JJS, JJE)
 calculation J23-flux at XYW More...
 
subroutine, public atmos_dyn_fvm_fluxx_xyw_ud3koren1993 (flux, mom, val, DENS, GSQRT, MAPF, num_diff, CDZ, TwoD, IIS, IIE, JJS, JJE)
 calculation X-flux at XYW More...
 
subroutine, public atmos_dyn_fvm_fluxy_xyw_ud3koren1993 (flux, mom, val, DENS, GSQRT, MAPF, num_diff, CDZ, TwoD, IIS, IIE, JJS, JJE)
 calculation Y-flux at XYW More...
 
subroutine, public atmos_dyn_fvm_fluxz_uyz_ud3koren1993 (flux, mom, val, DENS, GSQRT, J33G, num_diff, CDZ, TwoD, IIS, IIE, JJS, JJE)
 calculation z-flux at UY More...
 
subroutine, public atmos_dyn_fvm_fluxj13_uyz_ud3koren1993 (flux, mom, val, DENS, GSQRT, J13G, MAPF, CDZ, TwoD, IIS, IIE, JJS, JJE)
 calculation J13-flux at UYZ More...
 
subroutine, public atmos_dyn_fvm_fluxj23_uyz_ud3koren1993 (flux, mom, val, DENS, GSQRT, J23G, MAPF, CDZ, TwoD, IIS, IIE, JJS, JJE)
 calculation J23-flux at UYZ More...
 
subroutine, public atmos_dyn_fvm_fluxx_uyz_ud3koren1993 (flux, mom, val, DENS, GSQRT, MAPF, num_diff, CDZ, TwoD, IIS, IIE, JJS, JJE)
 calculation X-flux at UY More...
 
subroutine, public atmos_dyn_fvm_fluxy_uyz_ud3koren1993 (flux, mom, val, DENS, GSQRT, MAPF, num_diff, CDZ, TwoD, IIS, IIE, JJS, JJE)
 calculation Y-flux at UY More...
 
subroutine, public atmos_dyn_fvm_fluxz_xvz_ud3koren1993 (flux, mom, val, DENS, GSQRT, J33G, num_diff, CDZ, TwoD, IIS, IIE, JJS, JJE)
 calculation z-flux at XV More...
 
subroutine, public atmos_dyn_fvm_fluxj13_xvz_ud3koren1993 (flux, mom, val, DENS, GSQRT, J13G, MAPF, CDZ, TwoD, IIS, IIE, JJS, JJE)
 calculation J13-flux at XVZ More...
 
subroutine, public atmos_dyn_fvm_fluxj23_xvz_ud3koren1993 (flux, mom, val, DENS, GSQRT, J23G, MAPF, CDZ, TwoD, IIS, IIE, JJS, JJE)
 calculation J23-flux at XVZ More...
 
subroutine, public atmos_dyn_fvm_fluxx_xvz_ud3koren1993 (flux, mom, val, DENS, GSQRT, MAPF, num_diff, CDZ, TwoD, IIS, IIE, JJS, JJE)
 calculation X-flux at XV More...
 
subroutine, public atmos_dyn_fvm_fluxy_xvz_ud3koren1993 (flux, mom, val, DENS, GSQRT, MAPF, num_diff, CDZ, TwoD, IIS, IIE, JJS, JJE)
 calculation Y-flux at XV More...
 

Detailed Description

module scale_atmos_dyn_fvm_flux_ud3Koren1993

Description
FVM flux scheme with the ud3Koren1993 order
Author
Team SCALE

Function/Subroutine Documentation

◆ atmos_dyn_fvm_flux_valuew_z_ud3koren1993()

subroutine, public scale_atmos_dyn_fvm_flux_ud3koren1993::atmos_dyn_fvm_flux_valuew_z_ud3koren1993 ( real(rp), dimension (ka), intent(out)  valW,
real(rp), dimension (ka), intent(in)  mflx,
real(rp), dimension (ka), intent(in)  val,
real(rp), dimension(ka), intent(in)  GSQRT,
real(rp), dimension (ka), intent(in)  CDZ 
)

value at XYW

Definition at line 103 of file scale_atmos_dyn_fvm_flux_ud3Koren1993.F90.

103  implicit none
104 
105  real(RP), intent(out) :: valW (KA)
106  real(RP), intent(in) :: mflx (KA)
107  real(RP), intent(in) :: val (KA)
108  real(RP), intent(in) :: GSQRT(KA)
109  real(RP), intent(in) :: CDZ (KA)
110 
111  integer :: k
112  !---------------------------------------------------------------------------
113 
114  do k = ks+1, ke-2
115 #ifdef DEBUG
116  call check( __line__, mflx(k) )
117 
118  call check( __line__, val(k) )
119  call check( __line__, val(k+1) )
120 
121  call check( __line__, val(k-1) )
122  call check( __line__, val(k+2) )
123 
124 #endif
125  valw(k) = ( val(k) &
126  + 0.5_rp * phi(val(k+1),val(k),val(k-1)) * ( val(k)-val(k-1) ) ) &
127  * ( 0.5_rp + sign(0.5_rp,mflx(k)) ) &
128  + ( val(k+1) &
129  + 0.5_rp * phi(val(k),val(k+1),val(k+2)) * ( val(k+1)-val(k+2) ) ) &
130  * ( 0.5_rp - sign(0.5_rp,mflx(k)) )
131  enddo
132 #ifdef DEBUG
133  k = iundef
134 #endif
135 
136 #ifdef DEBUG
137 
138  call check( __line__, mflx(ks) )
139  call check( __line__, val(ks ) )
140  call check( __line__, val(ks+1) )
141  call check( __line__, mflx(ke-1) )
142  call check( __line__, val(ke ) )
143  call check( __line__, val(ke-1) )
144 
145 #endif
146 
147  valw(ks) = val(ks) &
148  * ( 0.5_rp + sign(0.5_rp,mflx(ks)) ) &
149  + ( val(ks+1) &
150  + 0.5_rp * phi(val(ks),val(ks+1),val(ks+2)) * ( val(ks+1)-val(ks+2) ) ) &
151  * ( 0.5_rp - sign(0.5_rp,mflx(ks)) )
152  valw(ke-1) = ( val(ke-1) &
153  + 0.5_rp * phi(val(ke-2),val(ke-1),val(ke)) * ( val(ke-1)-val(ke) ) ) &
154  * ( 0.5_rp + sign(0.5_rp,mflx(ke-1)) ) &
155  + val(ke) &
156  * ( 0.5_rp - sign(0.5_rp,mflx(ke-1)) )
157 
158 
159  return

References scale_debug::check(), scale_tracer::k, scale_atmos_grid_cartesc_index::ke, and scale_atmos_grid_cartesc_index::ks.

Referenced by scale_atmos_dyn_fvm_flux::atmos_dyn_fvm_flux_setup().

Here is the call graph for this function:
Here is the caller graph for this function:

◆ atmos_dyn_fvm_fluxz_xyz_ud3koren1993()

subroutine, public scale_atmos_dyn_fvm_flux_ud3koren1993::atmos_dyn_fvm_fluxz_xyz_ud3koren1993 ( real(rp), dimension (ka,ia,ja), intent(inout)  flux,
real(rp), dimension (ka,ia,ja), intent(in)  mflx,
real(rp), dimension (ka,ia,ja), intent(in)  val,
real(rp), dimension (ka,ia,ja), intent(in)  GSQRT,
real(rp), dimension(ka,ia,ja), intent(in)  num_diff,
real(rp), dimension (ka), intent(in)  CDZ,
integer, intent(in)  IIS,
integer, intent(in)  IIE,
integer, intent(in)  JJS,
integer, intent(in)  JJE 
)

calculation z-flux at XYZ

Definition at line 170 of file scale_atmos_dyn_fvm_flux_ud3Koren1993.F90.

170  use scale_const, only: &
171  eps => const_eps
172  implicit none
173 
174  real(RP), intent(inout) :: flux (KA,IA,JA)
175  real(RP), intent(in) :: mflx (KA,IA,JA)
176  real(RP), intent(in) :: val (KA,IA,JA)
177  real(RP), intent(in) :: GSQRT (KA,IA,JA)
178  real(RP), intent(in) :: num_diff(KA,IA,JA)
179  real(RP), intent(in) :: CDZ (KA)
180  integer, intent(in) :: IIS, IIE, JJS, JJE
181 
182  real(RP) :: vel
183  integer :: k, i, j
184  !---------------------------------------------------------------------------
185 
186  !$omp parallel default(none) private(i,j,k, vel) &
187  !$omp shared(JJS,JJE,IIS,IIE,KS,KE,mflx,val,flux,GSQRT,num_diff,EPS)
188 
189  !$omp do OMP_SCHEDULE_ collapse(2)
190  do j = jjs, jje
191  do i = iis, iie
192  do k = ks+1, ke-2
193 #ifdef DEBUG
194  call check( __line__, mflx(k,i,j) )
195 
196  call check( __line__, val(k,i,j) )
197  call check( __line__, val(k+1,i,j) )
198 
199  call check( __line__, val(k-1,i,j) )
200  call check( __line__, val(k+2,i,j) )
201 
202 #endif
203  vel = mflx(k,i,j)
204  flux(k,i,j) = vel &
205  * ( ( val(k,i,j) &
206  + 0.5_rp * phi(val(k+1,i,j),val(k,i,j),val(k-1,i,j)) * ( val(k,i,j)-val(k-1,i,j) ) ) &
207  * ( 0.5_rp + sign(0.5_rp,vel) ) &
208  + ( val(k+1,i,j) &
209  + 0.5_rp * phi(val(k,i,j),val(k+1,i,j),val(k+2,i,j)) * ( val(k+1,i,j)-val(k+2,i,j) ) ) &
210  * ( 0.5_rp - sign(0.5_rp,vel) ) ) &
211  + gsqrt(k,i,j) * num_diff(k,i,j)
212  enddo
213  enddo
214  enddo
215  !$omp end do nowait
216 #ifdef DEBUG
217  k = iundef; i = iundef; j = iundef
218 #endif
219 
220  !$omp do OMP_SCHEDULE_ collapse(2)
221  do j = jjs, jje
222  do i = iis, iie
223 #ifdef DEBUG
224 
225  call check( __line__, mflx(ks,i,j) )
226  call check( __line__, val(ks ,i,j) )
227  call check( __line__, val(ks+1,i,j) )
228  call check( __line__, mflx(ke-1,i,j) )
229  call check( __line__, val(ke ,i,j) )
230  call check( __line__, val(ke-1,i,j) )
231 
232 #endif
233  flux(ks-1,i,j) = 0.0_rp
234 
235  vel = mflx(ks,i,j)
236  flux(ks,i,j) = vel &
237  * ( val(ks,i,j) &
238  * ( 0.5_rp + sign(0.5_rp,vel) ) &
239  + ( val(ks+1,i,j) &
240  + 0.5_rp * phi(val(ks,i,j),val(ks+1,i,j),val(ks+2,i,j)) * ( val(ks+1,i,j)-val(ks+2,i,j) ) ) &
241  * ( 0.5_rp - sign(0.5_rp,vel) ) ) &
242  + gsqrt(ks,i,j) * num_diff(ks,i,j)
243  vel = mflx(ke-1,i,j)
244  flux(ke-1,i,j) = vel &
245  * ( ( val(ke-1,i,j) &
246  + 0.5_rp * phi(val(ke-2,i,j),val(ke-1,i,j),val(ke,i,j)) * ( val(ke-1,i,j)-val(ke,i,j) ) ) &
247  * ( 0.5_rp + sign(0.5_rp,vel) ) &
248  + val(ke,i,j) &
249  * ( 0.5_rp - sign(0.5_rp,vel) ) ) &
250  + gsqrt(ke-1,i,j) * num_diff(ke-1,i,j)
251 
252  flux(ke ,i,j) = 0.0_rp
253  enddo
254  enddo
255  !$omp end do nowait
256 
257  !$omp end parallel
258 #ifdef DEBUG
259  k = iundef; i = iundef; j = iundef
260 #endif
261 
262  return

References scale_debug::check(), scale_const::const_eps, scale_tracer::k, scale_atmos_grid_cartesc_index::ke, and scale_atmos_grid_cartesc_index::ks.

Referenced by scale_atmos_dyn_fvm_flux::atmos_dyn_fvm_flux_setup().

Here is the call graph for this function:
Here is the caller graph for this function:

◆ atmos_dyn_fvm_fluxx_xyz_ud3koren1993()

subroutine, public scale_atmos_dyn_fvm_flux_ud3koren1993::atmos_dyn_fvm_fluxx_xyz_ud3koren1993 ( real(rp), dimension (ka,ia,ja), intent(inout)  flux,
real(rp), dimension (ka,ia,ja), intent(in)  mflx,
real(rp), dimension (ka,ia,ja), intent(in)  val,
real(rp), dimension (ka,ia,ja), intent(in)  GSQRT,
real(rp), dimension(ka,ia,ja), intent(in)  num_diff,
real(rp), dimension(ka), intent(in)  CDZ,
integer, intent(in)  IIS,
integer, intent(in)  IIE,
integer, intent(in)  JJS,
integer, intent(in)  JJE 
)

calculation X-flux at XYZ

Definition at line 273 of file scale_atmos_dyn_fvm_flux_ud3Koren1993.F90.

273  implicit none
274 
275  real(RP), intent(inout) :: flux (KA,IA,JA)
276  real(RP), intent(in) :: mflx (KA,IA,JA)
277  real(RP), intent(in) :: val (KA,IA,JA)
278  real(RP), intent(in) :: GSQRT (KA,IA,JA)
279  real(RP), intent(in) :: num_diff(KA,IA,JA)
280  real(RP), intent(in) :: CDZ(KA)
281  integer, intent(in) :: IIS, IIE, JJS, JJE
282 
283  real(RP) :: vel
284  integer :: k, i, j
285  !---------------------------------------------------------------------------
286 
287  !$omp parallel do default(none) private(i,j,k) OMP_SCHEDULE_ collapse(2) &
288  !$omp private(vel) &
289  !$omp shared(JJS,JJE,IIS,IIE,KS,KE,mflx,val,flux,GSQRT,num_diff)
290  do j = jjs, jje
291  do i = iis-1, iie
292  do k = ks, ke
293 #ifdef DEBUG
294  call check( __line__, mflx(k,i,j) )
295 
296  call check( __line__, val(k,i,j) )
297  call check( __line__, val(k,i+1,j) )
298 
299  call check( __line__, val(k,i-1,j) )
300  call check( __line__, val(k,i+2,j) )
301 
302 #endif
303  vel = mflx(k,i,j)
304  flux(k,i,j) = vel &
305  * ( ( val(k,i,j) &
306  + 0.5_rp * phi(val(k,i+1,j),val(k,i,j),val(k,i-1,j)) * ( val(k,i,j)-val(k,i-1,j) ) ) &
307  * ( 0.5_rp + sign(0.5_rp,vel) ) &
308  + ( val(k,i+1,j) &
309  + 0.5_rp * phi(val(k,i,j),val(k,i+1,j),val(k,i+2,j)) * ( val(k,i+1,j)-val(k,i+2,j) ) ) &
310  * ( 0.5_rp - sign(0.5_rp,vel) ) ) &
311  + gsqrt(k,i,j) * num_diff(k,i,j)
312  enddo
313  enddo
314  enddo
315 #ifdef DEBUG
316  k = iundef; i = iundef; j = iundef
317 #endif
318 
319  return

References scale_debug::check(), scale_tracer::k, scale_atmos_grid_cartesc_index::ke, and scale_atmos_grid_cartesc_index::ks.

Referenced by scale_atmos_dyn_fvm_flux::atmos_dyn_fvm_flux_setup().

Here is the call graph for this function:
Here is the caller graph for this function:

◆ atmos_dyn_fvm_fluxy_xyz_ud3koren1993()

subroutine, public scale_atmos_dyn_fvm_flux_ud3koren1993::atmos_dyn_fvm_fluxy_xyz_ud3koren1993 ( real(rp), dimension (ka,ia,ja), intent(inout)  flux,
real(rp), dimension (ka,ia,ja), intent(in)  mflx,
real(rp), dimension (ka,ia,ja), intent(in)  val,
real(rp), dimension (ka,ia,ja), intent(in)  GSQRT,
real(rp), dimension(ka,ia,ja), intent(in)  num_diff,
real(rp), dimension(ka), intent(in)  CDZ,
integer, intent(in)  IIS,
integer, intent(in)  IIE,
integer, intent(in)  JJS,
integer, intent(in)  JJE 
)

calculation Y-flux at XYZ

Definition at line 330 of file scale_atmos_dyn_fvm_flux_ud3Koren1993.F90.

330  implicit none
331 
332  real(RP), intent(inout) :: flux (KA,IA,JA)
333  real(RP), intent(in) :: mflx (KA,IA,JA)
334  real(RP), intent(in) :: val (KA,IA,JA)
335  real(RP), intent(in) :: GSQRT (KA,IA,JA)
336  real(RP), intent(in) :: num_diff(KA,IA,JA)
337  real(RP), intent(in) :: CDZ(KA)
338  integer, intent(in) :: IIS, IIE, JJS, JJE
339 
340  real(RP) :: vel
341  integer :: k, i, j
342  !---------------------------------------------------------------------------
343 
344  !$omp parallel do default(none) private(i,j,k) OMP_SCHEDULE_ collapse(2) &
345  !$omp private(vel) &
346  !$omp shared(JJS,JJE,IIS,IIE,KS,KE,mflx,val,flux,GSQRT,num_diff)
347  do j = jjs-1, jje
348  do i = iis, iie
349  do k = ks, ke
350 #ifdef DEBUG
351  call check( __line__, mflx(k,i,j) )
352 
353  call check( __line__, val(k,i,j) )
354  call check( __line__, val(k,i,j+1) )
355 
356  call check( __line__, val(k,i,j-1) )
357  call check( __line__, val(k,i,j+2) )
358 
359 #endif
360  vel = mflx(k,i,j)
361  flux(k,i,j) = vel &
362  * ( ( val(k,i,j) &
363  + 0.5_rp * phi(val(k,i,j+1),val(k,i,j),val(k,i,j-1)) * ( val(k,i,j)-val(k,i,j-1) ) ) &
364  * ( 0.5_rp + sign(0.5_rp,vel) ) &
365  + ( val(k,i,j+1) &
366  + 0.5_rp * phi(val(k,i,j),val(k,i,j+1),val(k,i,j+2)) * ( val(k,i,j+1)-val(k,i,j+2) ) ) &
367  * ( 0.5_rp - sign(0.5_rp,vel) ) ) &
368  + gsqrt(k,i,j) * num_diff(k,i,j)
369  enddo
370  enddo
371  enddo
372 #ifdef DEBUG
373  k = iundef; i = iundef; j = iundef
374 #endif
375 
376  return

References scale_debug::check(), scale_tracer::k, scale_atmos_grid_cartesc_index::ke, and scale_atmos_grid_cartesc_index::ks.

Referenced by scale_atmos_dyn_fvm_flux::atmos_dyn_fvm_flux_setup().

Here is the call graph for this function:
Here is the caller graph for this function:

◆ atmos_dyn_fvm_fluxz_xyw_ud3koren1993()

subroutine, public scale_atmos_dyn_fvm_flux_ud3koren1993::atmos_dyn_fvm_fluxz_xyw_ud3koren1993 ( real(rp), dimension (ka,ia,ja), intent(inout)  flux,
real(rp), dimension (ka,ia,ja), intent(in)  mom,
real(rp), dimension (ka,ia,ja), intent(in)  val,
real(rp), dimension (ka,ia,ja), intent(in)  DENS,
real(rp), dimension (ka,ia,ja), intent(in)  GSQRT,
real(rp), intent(in)  J33G,
real(rp), dimension(ka,ia,ja), intent(in)  num_diff,
real(rp), dimension (ka), intent(in)  CDZ,
real(rp), dimension (ka-1), intent(in)  FDZ,
real(rp), intent(in)  dtrk,
integer, intent(in)  IIS,
integer, intent(in)  IIE,
integer, intent(in)  JJS,
integer, intent(in)  JJE 
)

calculation z-flux at XYW

Definition at line 390 of file scale_atmos_dyn_fvm_flux_ud3Koren1993.F90.

390  implicit none
391 
392  real(RP), intent(inout) :: flux (KA,IA,JA)
393  real(RP), intent(in) :: mom (KA,IA,JA)
394  real(RP), intent(in) :: val (KA,IA,JA)
395  real(RP), intent(in) :: DENS (KA,IA,JA)
396  real(RP), intent(in) :: GSQRT (KA,IA,JA)
397  real(RP), intent(in) :: J33G
398  real(RP), intent(in) :: num_diff(KA,IA,JA)
399  real(RP), intent(in) :: CDZ (KA)
400  real(RP), intent(in) :: FDZ (KA-1)
401  real(RP), intent(in) :: dtrk
402  integer, intent(in) :: IIS, IIE, JJS, JJE
403 
404  real(RP) :: vel
405  integer :: k, i, j
406  !---------------------------------------------------------------------------
407 
408  ! note than z-index is added by -1
409 
410  !$omp parallel default(none) private(i,j,k,vel) &
411  !$omp shared(JJS,JJE,IIS,IIE,KS,KE,mom,val,flux,J33G,GSQRT,num_diff,DENS,FDZ,dtrk)
412 
413  !$omp do OMP_SCHEDULE_ collapse(2)
414  do j = jjs, jje
415  do i = iis, iie
416  do k = ks+2, ke-1
417 #ifdef DEBUG
418  call check( __line__, mom(k-1,i,j) )
419  call check( __line__, mom(k ,i,j) )
420 
421  call check( __line__, val(k-1,i,j) )
422  call check( __line__, val(k,i,j) )
423 
424  call check( __line__, val(k-2,i,j) )
425  call check( __line__, val(k+1,i,j) )
426 
427 #endif
428  vel = ( 0.5_rp * ( mom(k-1,i,j) &
429  + mom(k,i,j) ) ) &
430  / dens(k,i,j)
431  flux(k-1,i,j) = j33g * vel &
432  * ( ( val(k-1,i,j) &
433  + 0.5_rp * phi(val(k,i,j),val(k-1,i,j),val(k-2,i,j)) * ( val(k-1,i,j)-val(k-2,i,j) ) ) &
434  * ( 0.5_rp + sign(0.5_rp,vel) ) &
435  + ( val(k,i,j) &
436  + 0.5_rp * phi(val(k-1,i,j),val(k,i,j),val(k+1,i,j)) * ( val(k,i,j)-val(k+1,i,j) ) ) &
437  * ( 0.5_rp - sign(0.5_rp,vel) ) ) &
438  + gsqrt(k,i,j) * num_diff(k,i,j)
439  enddo
440  enddo
441  enddo
442  !$omp end do nowait
443 #ifdef DEBUG
444  k = iundef; i = iundef; j = iundef
445 #endif
446 
447  !$omp do OMP_SCHEDULE_ collapse(2)
448  do j = jjs, jje
449  do i = iis, iie
450 #ifdef DEBUG
451 
452  call check( __line__, val(ks,i,j) )
453  call check( __line__, val(ks+1,i,j) )
454  call check( __line__, val(ks+2,i,j) )
455 
456 
457 #endif
458  ! The boundary condition is qflx_hi + qflxJ13 + qfluxJ23 = 0 at KS.
459  ! The flux at KS can be non-zero.
460  ! To reduce calculations, all the fluxes are set to zero.
461  flux(ks-1,i,j) = 0.0_rp ! k = KS
462 
463  vel = ( 0.5_rp * ( mom(ks,i,j) &
464  + mom(ks+1,i,j) ) ) &
465  / dens(ks+1,i,j)
466  flux(ks,i,j) = j33g * vel &
467  * ( val(ks,i,j) &
468  * ( 0.5_rp + sign(0.5_rp,vel) ) &
469  + ( val(ks+1,i,j) &
470  + 0.5_rp * phi(val(ks,i,j),val(ks+1,i,j),val(ks+2,i,j)) * ( val(ks+1,i,j)-val(ks+2,i,j) ) ) &
471  * ( 0.5_rp - sign(0.5_rp,vel) ) ) &
472  + gsqrt(ks+1,i,j) * num_diff(ks+1,i,j) ! k = KS+1
473 
474 
475 
476  flux(ke-1,i,j) = 0.0_rp ! k = KE
477  flux(ke ,i,j) = 0.0_rp ! k = KE+1
478  enddo
479  enddo
480  !$omp end do nowait
481 
482  !$omp end parallel
483 
484  return

References scale_debug::check(), scale_tracer::k, scale_atmos_grid_cartesc_index::ke, and scale_atmos_grid_cartesc_index::ks.

Referenced by scale_atmos_dyn_fvm_flux::atmos_dyn_fvm_flux_setup().

Here is the call graph for this function:
Here is the caller graph for this function:

◆ atmos_dyn_fvm_fluxj13_xyw_ud3koren1993()

subroutine, public scale_atmos_dyn_fvm_flux_ud3koren1993::atmos_dyn_fvm_fluxj13_xyw_ud3koren1993 ( real(rp), dimension (ka,ia,ja), intent(inout)  flux,
real(rp), dimension (ka,ia,ja), intent(in)  mom,
real(rp), dimension (ka,ia,ja), intent(in)  val,
real(rp), dimension (ka,ia,ja), intent(in)  DENS,
real(rp), dimension (ka,ia,ja), intent(in)  GSQRT,
real(rp), dimension (ka,ia,ja), intent(in)  J13G,
real(rp), dimension ( ia,ja,2), intent(in)  MAPF,
real(rp), dimension (ka), intent(in)  CDZ,
logical, intent(in)  TwoD,
integer, intent(in)  IIS,
integer, intent(in)  IIE,
integer, intent(in)  JJS,
integer, intent(in)  JJE 
)

calculation J13-flux at XYW

Definition at line 496 of file scale_atmos_dyn_fvm_flux_ud3Koren1993.F90.

496  implicit none
497 
498  real(RP), intent(inout) :: flux (KA,IA,JA)
499  real(RP), intent(in) :: mom (KA,IA,JA)
500  real(RP), intent(in) :: val (KA,IA,JA)
501  real(RP), intent(in) :: DENS (KA,IA,JA)
502  real(RP), intent(in) :: GSQRT (KA,IA,JA)
503  real(RP), intent(in) :: J13G (KA,IA,JA)
504  real(RP), intent(in) :: MAPF ( IA,JA,2)
505  real(RP), intent(in) :: CDZ (KA)
506  logical, intent(in) :: TwoD
507  integer, intent(in) :: IIS, IIE, JJS, JJE
508 
509  real(RP) :: vel
510  integer :: k, i, j
511  !---------------------------------------------------------------------------
512 
513  !$omp parallel default(none) private(i,j,k,vel) &
514  !$omp shared(JJS,JJE,IIS,IIE,KS,KE,mom,val,DENS,flux,J13G,MAPF)
515 
516  !$omp do OMP_SCHEDULE_ collapse(2)
517  do j = jjs, jje
518  do i = iis, iie
519  do k = ks+2, ke-1
520  vel = ( 0.5_rp * ( mom(k,i,j)+mom(k,i-1,j) ) ) &
521  / dens(k,i,j)
522  vel = vel * j13g(k,i,j)
523  flux(k-1,i,j) = vel / mapf(i,j,+2) &
524  * ( ( val(k-1,i,j) &
525  + 0.5_rp * phi(val(k,i,j),val(k-1,i,j),val(k-2,i,j)) * ( val(k-1,i,j)-val(k-2,i,j) ) ) &
526  * ( 0.5_rp + sign(0.5_rp,vel) ) &
527  + ( val(k,i,j) &
528  + 0.5_rp * phi(val(k-1,i,j),val(k,i,j),val(k+1,i,j)) * ( val(k,i,j)-val(k+1,i,j) ) ) &
529  * ( 0.5_rp - sign(0.5_rp,vel) ) )
530  enddo
531  enddo
532  enddo
533  !$omp end do nowait
534 
535  !$omp do OMP_SCHEDULE_ collapse(2)
536  do j = jjs, jje
537  do i = iis, iie
538  ! The boundary condition is qflx_hi + qflxJ13 + qfluxJ23 = 0 at KS.
539  ! The flux at KS can be non-zero.
540  ! To reduce calculations, all the fluxes are set to zero.
541  flux(ks-1,i,j) = 0.0_rp ! k = KS
542 
543  ! physically incorrect but for numerical stability
544  vel = ( ( 0.5_rp * ( mom(ks+1,i,j)+mom(ks+1,i-1,j) ) ) / dens(ks+1,i,j) &
545  + ( 0.5_rp * ( mom(ks,i,j)+mom(ks,i-1,j) ) ) / dens(ks ,i,j) ) * 0.5_rp
546 ! vel = ( 0.5_RP * ( mom(KS+1,i,j)+mom(KS+1,i-1,j) ) ) &
547 ! / DENS(KS+1,i,j)
548  vel = vel * j13g(ks+1,i,j)
549  flux(ks,i,j) = vel / mapf(i,j,+2) &
550  * ( val(ks,i,j) &
551  * ( 0.5_rp + sign(0.5_rp,vel) ) &
552  + ( val(ks+1,i,j) &
553  + 0.5_rp * phi(val(ks,i,j),val(ks+1,i,j),val(ks+2,i,j)) * ( val(ks+1,i,j)-val(ks+2,i,j) ) ) &
554  * ( 0.5_rp - sign(0.5_rp,vel) ) ) ! k = KS+1
555 
556 
557  flux(ke-1,i,j) = 0.0_rp
558  enddo
559  enddo
560  !$omp end do nowait
561 
562  !$omp end parallel
563 
564  return

References scale_tracer::k, scale_atmos_grid_cartesc_index::ke, and scale_atmos_grid_cartesc_index::ks.

Referenced by scale_atmos_dyn_fvm_flux::atmos_dyn_fvm_flux_setup().

Here is the caller graph for this function:

◆ atmos_dyn_fvm_fluxj23_xyw_ud3koren1993()

subroutine, public scale_atmos_dyn_fvm_flux_ud3koren1993::atmos_dyn_fvm_fluxj23_xyw_ud3koren1993 ( real(rp), dimension (ka,ia,ja), intent(inout)  flux,
real(rp), dimension (ka,ia,ja), intent(in)  mom,
real(rp), dimension (ka,ia,ja), intent(in)  val,
real(rp), dimension (ka,ia,ja), intent(in)  DENS,
real(rp), dimension (ka,ia,ja), intent(in)  GSQRT,
real(rp), dimension (ka,ia,ja), intent(in)  J23G,
real(rp), dimension ( ia,ja,2), intent(in)  MAPF,
real(rp), dimension (ka), intent(in)  CDZ,
logical, intent(in)  TwoD,
integer, intent(in)  IIS,
integer, intent(in)  IIE,
integer, intent(in)  JJS,
integer, intent(in)  JJE 
)

calculation J23-flux at XYW

Definition at line 575 of file scale_atmos_dyn_fvm_flux_ud3Koren1993.F90.

575  implicit none
576 
577  real(RP), intent(inout) :: flux (KA,IA,JA)
578  real(RP), intent(in) :: mom (KA,IA,JA)
579  real(RP), intent(in) :: val (KA,IA,JA)
580  real(RP), intent(in) :: DENS (KA,IA,JA)
581  real(RP), intent(in) :: GSQRT (KA,IA,JA)
582  real(RP), intent(in) :: J23G (KA,IA,JA)
583  real(RP), intent(in) :: MAPF ( IA,JA,2)
584  real(RP), intent(in) :: CDZ (KA)
585  logical, intent(in) :: TwoD
586  integer, intent(in) :: IIS, IIE, JJS, JJE
587 
588  real(RP) :: vel
589  integer :: k, i, j
590  !---------------------------------------------------------------------------
591 
592  !$omp parallel default(none) private(i,j,k,vel) &
593  !$omp shared(JJS,JJE,IIS,IIE,KS,KE,mom,val,DENS,flux,J23G,MAPF)
594 
595  !$omp do OMP_SCHEDULE_ collapse(2)
596  do j = jjs, jje
597  do i = iis, iie
598  do k = ks+2, ke-1
599  vel = ( 0.5_rp * ( mom(k,i,j)+mom(k,i,j-1) ) ) &
600  / dens(k,i,j)
601  vel = vel * j23g(k,i,j)
602  flux(k-1,i,j) = vel / mapf(i,j,+1) &
603  * ( ( val(k-1,i,j) &
604  + 0.5_rp * phi(val(k,i,j),val(k-1,i,j),val(k-2,i,j)) * ( val(k-1,i,j)-val(k-2,i,j) ) ) &
605  * ( 0.5_rp + sign(0.5_rp,vel) ) &
606  + ( val(k,i,j) &
607  + 0.5_rp * phi(val(k-1,i,j),val(k,i,j),val(k+1,i,j)) * ( val(k,i,j)-val(k+1,i,j) ) ) &
608  * ( 0.5_rp - sign(0.5_rp,vel) ) )
609  enddo
610  enddo
611  enddo
612  !$omp end do nowait
613 
614  !$omp do OMP_SCHEDULE_ collapse(2)
615  do j = jjs, jje
616  do i = iis, iie
617  ! The boundary condition is qflx_hi + qflxJ13 + qfluxJ23 = 0 at KS.
618  ! The flux at KS can be non-zero.
619  ! To reduce calculations, all the fluxes are set to zero.
620  flux(ks-1,i,j) = 0.0_rp ! k = KS
621 
622  ! physically incorrect but for numerical stability
623  vel = ( ( 0.5_rp * ( mom(ks+1,i,j)+mom(ks+1,i,j-1) ) ) / dens(ks+1,i,j) &
624  + ( 0.5_rp * ( mom(ks,i,j)+mom(ks,i,j-1) ) ) / dens(ks ,i,j) ) * 0.5_rp
625 ! vel = ( 0.5_RP * ( mom(KS+1,i,j)+mom(KS+1,i,j-1) ) ) &
626 ! / DENS(KS+1,i,j)
627  vel = vel * j23g(ks+1,i,j)
628  flux(ks,i,j) = vel / mapf(i,j,+1) &
629  * ( val(ks,i,j) &
630  * ( 0.5_rp + sign(0.5_rp,vel) ) &
631  + ( val(ks+1,i,j) &
632  + 0.5_rp * phi(val(ks,i,j),val(ks+1,i,j),val(ks+2,i,j)) * ( val(ks+1,i,j)-val(ks+2,i,j) ) ) &
633  * ( 0.5_rp - sign(0.5_rp,vel) ) ) ! k = KS+1
634 
635 
636  flux(ke-1,i,j) = 0.0_rp
637  enddo
638  enddo
639  !$omp end do nowait
640 
641  !$omp end parallel
642 
643  return

References scale_tracer::k, scale_atmos_grid_cartesc_index::ke, and scale_atmos_grid_cartesc_index::ks.

Referenced by scale_atmos_dyn_fvm_flux::atmos_dyn_fvm_flux_setup().

Here is the caller graph for this function:

◆ atmos_dyn_fvm_fluxx_xyw_ud3koren1993()

subroutine, public scale_atmos_dyn_fvm_flux_ud3koren1993::atmos_dyn_fvm_fluxx_xyw_ud3koren1993 ( real(rp), dimension (ka,ia,ja), intent(inout)  flux,
real(rp), dimension (ka,ia,ja), intent(in)  mom,
real(rp), dimension (ka,ia,ja), intent(in)  val,
real(rp), dimension (ka,ia,ja), intent(in)  DENS,
real(rp), dimension (ka,ia,ja), intent(in)  GSQRT,
real(rp), dimension ( ia,ja,2), intent(in)  MAPF,
real(rp), dimension(ka,ia,ja), intent(in)  num_diff,
real(rp), dimension (ka), intent(in)  CDZ,
logical, intent(in)  TwoD,
integer, intent(in)  IIS,
integer, intent(in)  IIE,
integer, intent(in)  JJS,
integer, intent(in)  JJE 
)

calculation X-flux at XYW

Definition at line 656 of file scale_atmos_dyn_fvm_flux_ud3Koren1993.F90.

656  implicit none
657 
658  real(RP), intent(inout) :: flux (KA,IA,JA)
659  real(RP), intent(in) :: mom (KA,IA,JA)
660  real(RP), intent(in) :: val (KA,IA,JA)
661  real(RP), intent(in) :: DENS (KA,IA,JA)
662  real(RP), intent(in) :: GSQRT (KA,IA,JA)
663  real(RP), intent(in) :: MAPF ( IA,JA,2)
664  real(RP), intent(in) :: num_diff(KA,IA,JA)
665  real(RP), intent(in) :: CDZ (KA)
666  logical, intent(in) :: TwoD
667  integer, intent(in) :: IIS, IIE, JJS, JJE
668 
669  real(RP) :: vel
670  integer :: k, i, j
671  !---------------------------------------------------------------------------
672 
673  !$omp parallel default(none) private(i,j,k,vel) &
674  !$omp shared(JJS,JJE,IIS,IIE,KS,KE,mom,val,DENS,flux,GSQRT,MAPF,num_diff) &
675  !$omp shared(CDZ)
676 
677  !$omp do OMP_SCHEDULE_ collapse(2)
678  do j = jjs, jje
679  do i = iis-1, iie
680  do k = ks, ke-1
681 #ifdef DEBUG
682  call check( __line__, mom(k ,i,j) )
683  call check( __line__, mom(k+1,i,j) )
684 
685  call check( __line__, val(k,i,j) )
686  call check( __line__, val(k,i+1,j) )
687 
688  call check( __line__, val(k,i-1,j) )
689  call check( __line__, val(k,i+2,j) )
690 
691 #endif
692  vel = ( f2h(k,1,i_uyz) &
693  * mom(k+1,i,j) &
694  + f2h(k,2,i_uyz) &
695  * mom(k,i,j) ) &
696  / ( f2h(k,1,i_uyz) &
697  * 0.5_rp * ( dens(k+1,i,j)+dens(k+1,i+1,j) ) &
698  + f2h(k,2,i_uyz) &
699  * 0.5_rp * ( dens(k,i,j)+dens(k,i+1,j) ) )
700  flux(k,i,j) = gsqrt(k,i,j) / mapf(i,j,+2) * vel &
701  * ( ( val(k,i,j) &
702  + 0.5_rp * phi(val(k,i+1,j),val(k,i,j),val(k,i-1,j)) * ( val(k,i,j)-val(k,i-1,j) ) ) &
703  * ( 0.5_rp + sign(0.5_rp,vel) ) &
704  + ( val(k,i+1,j) &
705  + 0.5_rp * phi(val(k,i,j),val(k,i+1,j),val(k,i+2,j)) * ( val(k,i+1,j)-val(k,i+2,j) ) ) &
706  * ( 0.5_rp - sign(0.5_rp,vel) ) ) &
707  + gsqrt(k,i,j) * num_diff(k,i,j)
708  enddo
709  enddo
710  enddo
711  !$omp end do nowait
712 #ifdef DEBUG
713  k = iundef; i = iundef; j = iundef
714 #endif
715 
716  !$omp do OMP_SCHEDULE_ collapse(2)
717  do j = jjs, jje
718  do i = iis-1, iie
719  flux(ke,i,j) = 0.0_rp
720  enddo
721  enddo
722  !$omp end do nowait
723 
724  !$omp end parallel
725 #ifdef DEBUG
726  k = iundef; i = iundef; j = iundef
727 #endif
728 
729  return

References scale_debug::check(), scale_atmos_grid_cartesc_index::i_uyz, scale_tracer::k, scale_atmos_grid_cartesc_index::ke, and scale_atmos_grid_cartesc_index::ks.

Referenced by scale_atmos_dyn_fvm_flux::atmos_dyn_fvm_flux_setup().

Here is the call graph for this function:
Here is the caller graph for this function:

◆ atmos_dyn_fvm_fluxy_xyw_ud3koren1993()

subroutine, public scale_atmos_dyn_fvm_flux_ud3koren1993::atmos_dyn_fvm_fluxy_xyw_ud3koren1993 ( real(rp), dimension (ka,ia,ja), intent(inout)  flux,
real(rp), dimension (ka,ia,ja), intent(in)  mom,
real(rp), dimension (ka,ia,ja), intent(in)  val,
real(rp), dimension (ka,ia,ja), intent(in)  DENS,
real(rp), dimension (ka,ia,ja), intent(in)  GSQRT,
real(rp), dimension ( ia,ja,2), intent(in)  MAPF,
real(rp), dimension(ka,ia,ja), intent(in)  num_diff,
real(rp), dimension (ka), intent(in)  CDZ,
logical, intent(in)  TwoD,
integer, intent(in)  IIS,
integer, intent(in)  IIE,
integer, intent(in)  JJS,
integer, intent(in)  JJE 
)

calculation Y-flux at XYW

Definition at line 741 of file scale_atmos_dyn_fvm_flux_ud3Koren1993.F90.

741  implicit none
742 
743  real(RP), intent(inout) :: flux (KA,IA,JA)
744  real(RP), intent(in) :: mom (KA,IA,JA)
745  real(RP), intent(in) :: val (KA,IA,JA)
746  real(RP), intent(in) :: DENS (KA,IA,JA)
747  real(RP), intent(in) :: GSQRT (KA,IA,JA)
748  real(RP), intent(in) :: MAPF ( IA,JA,2)
749  real(RP), intent(in) :: num_diff(KA,IA,JA)
750  real(RP), intent(in) :: CDZ (KA)
751  logical, intent(in) :: TwoD
752  integer, intent(in) :: IIS, IIE, JJS, JJE
753 
754  real(RP) :: vel
755  integer :: k, i, j
756  !---------------------------------------------------------------------------
757 
758  !$omp parallel default(none) private(i,j,k,vel) &
759  !$omp shared(JJS,JJE,IIS,IIE,KS,KE,mom,val,DENS,flux,GSQRT,MAPF,num_diff) &
760  !$omp shared(CDZ)
761 
762  !$omp do OMP_SCHEDULE_ collapse(2)
763  do j = jjs-1, jje
764  do i = iis, iie
765  do k = ks, ke-1
766 #ifdef DEBUG
767  call check( __line__, mom(k ,i,j) )
768  call check( __line__, mom(k+1,i,j) )
769 
770  call check( __line__, val(k,i,j) )
771  call check( __line__, val(k,i,j+1) )
772 
773  call check( __line__, val(k,i,j-1) )
774  call check( __line__, val(k,i,j+2) )
775 
776 #endif
777  vel = ( f2h(k,1,i_xvz) &
778  * mom(k+1,i,j) &
779  + f2h(k,2,i_xvz) &
780  * mom(k,i,j) ) &
781  / ( f2h(k,1,i_xvz) &
782  * 0.5_rp * ( dens(k+1,i,j)+dens(k+1,i,j+1) ) &
783  + f2h(k,2,i_xvz) &
784  * 0.5_rp * ( dens(k,i,j)+dens(k,i,j+1) ) )
785  flux(k,i,j) = gsqrt(k,i,j) / mapf(i,j,+1) * vel &
786  * ( ( val(k,i,j) &
787  + 0.5_rp * phi(val(k,i,j+1),val(k,i,j),val(k,i,j-1)) * ( val(k,i,j)-val(k,i,j-1) ) ) &
788  * ( 0.5_rp + sign(0.5_rp,vel) ) &
789  + ( val(k,i,j+1) &
790  + 0.5_rp * phi(val(k,i,j),val(k,i,j+1),val(k,i,j+2)) * ( val(k,i,j+1)-val(k,i,j+2) ) ) &
791  * ( 0.5_rp - sign(0.5_rp,vel) ) ) &
792  + gsqrt(k,i,j) * num_diff(k,i,j)
793  enddo
794  enddo
795  enddo
796  !$omp end do nowait
797 #ifdef DEBUG
798  k = iundef; i = iundef; j = iundef
799 #endif
800 
801  !$omp do OMP_SCHEDULE_ collapse(2)
802  do j = jjs-1, jje
803  do i = iis, iie
804  flux(ke,i,j) = 0.0_rp
805  enddo
806  enddo
807  !$omp end do nowait
808 
809  !$omp end parallel
810 #ifdef DEBUG
811  k = iundef; i = iundef; j = iundef
812 #endif
813 
814  return

References scale_debug::check(), scale_atmos_grid_cartesc_index::i_xvz, scale_tracer::k, scale_atmos_grid_cartesc_index::ke, and scale_atmos_grid_cartesc_index::ks.

Referenced by scale_atmos_dyn_fvm_flux::atmos_dyn_fvm_flux_setup().

Here is the call graph for this function:
Here is the caller graph for this function:

◆ atmos_dyn_fvm_fluxz_uyz_ud3koren1993()

subroutine, public scale_atmos_dyn_fvm_flux_ud3koren1993::atmos_dyn_fvm_fluxz_uyz_ud3koren1993 ( real(rp), dimension (ka,ia,ja), intent(inout)  flux,
real(rp), dimension (ka,ia,ja), intent(in)  mom,
real(rp), dimension (ka,ia,ja), intent(in)  val,
real(rp), dimension (ka,ia,ja), intent(in)  DENS,
real(rp), dimension (ka,ia,ja), intent(in)  GSQRT,
real(rp), intent(in)  J33G,
real(rp), dimension(ka,ia,ja), intent(in)  num_diff,
real(rp), dimension (ka), intent(in)  CDZ,
logical, intent(in)  TwoD,
integer, intent(in)  IIS,
integer, intent(in)  IIE,
integer, intent(in)  JJS,
integer, intent(in)  JJE 
)

calculation z-flux at UY

Definition at line 827 of file scale_atmos_dyn_fvm_flux_ud3Koren1993.F90.

827  implicit none
828 
829  real(RP), intent(inout) :: flux (KA,IA,JA)
830  real(RP), intent(in) :: mom (KA,IA,JA)
831  real(RP), intent(in) :: val (KA,IA,JA)
832  real(RP), intent(in) :: DENS (KA,IA,JA)
833  real(RP), intent(in) :: GSQRT (KA,IA,JA)
834  real(RP), intent(in) :: J33G
835  real(RP), intent(in) :: num_diff(KA,IA,JA)
836  real(RP), intent(in) :: CDZ (KA)
837  logical, intent(in) :: TwoD
838  integer, intent(in) :: IIS, IIE, JJS, JJE
839 
840  real(RP) :: vel
841  integer :: k, i, j
842  !---------------------------------------------------------------------------
843 
844  !$omp parallel default(none) private(i,j,k,vel) &
845  !$omp shared(JJS,JJE,IIS,IIE,KS,KE,mom,val,DENS,flux,J33G,GSQRT,num_diff) &
846  !$omp shared(CDZ,TwoD)
847 
848 
849  if ( twod ) then
850 
851  !$omp do OMP_SCHEDULE_
852  do j = jjs, jje
853  do k = ks+1, ke-2
854 #ifdef DEBUG
855  call check( __line__, mom(k,i,j) )
856 
857  call check( __line__, val(k,i,j) )
858  call check( __line__, val(k+1,i,j) )
859 
860  call check( __line__, val(k-1,i,j) )
861  call check( __line__, val(k+2,i,j) )
862 
863 #endif
864  i = iis
865  vel = ( mom(k,i,j) ) &
866  / ( f2h(k,1,i_xyz) &
867  * dens(k+1,i,j) &
868  + f2h(k,2,i_xyz) &
869  * dens(k,i,j) )
870  flux(k,i,j) = j33g * vel &
871  * ( ( val(k,i,j) &
872  + 0.5_rp * phi(val(k+1,i,j),val(k,i,j),val(k-1,i,j)) * ( val(k,i,j)-val(k-1,i,j) ) ) &
873  * ( 0.5_rp + sign(0.5_rp,vel) ) &
874  + ( val(k+1,i,j) &
875  + 0.5_rp * phi(val(k,i,j),val(k+1,i,j),val(k+2,i,j)) * ( val(k+1,i,j)-val(k+2,i,j) ) ) &
876  * ( 0.5_rp - sign(0.5_rp,vel) ) ) &
877  + gsqrt(k,i,j) * num_diff(k,i,j)
878  enddo
879  enddo
880  !$omp end do nowait
881 #ifdef DEBUG
882  k = iundef; i = iundef; j = iundef
883 #endif
884 
885  !$omp do OMP_SCHEDULE_
886  do j = jjs, jje
887 #ifdef DEBUG
888 
889  call check( __line__, mom(ks,i ,j) )
890  call check( __line__, val(ks+1,i,j) )
891  call check( __line__, val(ks,i,j) )
892 
893 #endif
894  i = iis
895  ! The boundary condition is qflx_hi + qflxJ13 + qfluxJ23 = 0 at KS-1.
896  ! The flux at KS-1 can be non-zero.
897  ! To reduce calculations, all the fluxes are set to zero.
898  flux(ks-1,i,j) = 0.0_rp
899 
900  vel = ( mom(ks,i,j) ) &
901  / ( f2h(ks,1,i_xyz) &
902  * dens(ks+1,i,j) &
903  + f2h(ks,2,i_xyz) &
904  * dens(ks,i,j) )
905  flux(ks,i,j) = j33g * vel &
906  * ( val(ks,i,j) &
907  * ( 0.5_rp + sign(0.5_rp,vel) ) &
908  + ( val(ks+1,i,j) &
909  + 0.5_rp * phi(val(ks,i,j),val(ks+1,i,j),val(ks+2,i,j)) * ( val(ks+1,i,j)-val(ks+2,i,j) ) ) &
910  * ( 0.5_rp - sign(0.5_rp,vel) ) ) &
911  + gsqrt(ks,i,j) * num_diff(ks,i,j)
912  vel = ( mom(ke-1,i,j) ) &
913  / ( f2h(ke-1,1,i_xyz) &
914  * dens(ke,i,j) &
915  + f2h(ke-1,2,i_xyz) &
916  * dens(ke-1,i,j) )
917  flux(ke-1,i,j) = j33g * vel &
918  * ( ( val(ke-1,i,j) &
919  + 0.5_rp * phi(val(ke-2,i,j),val(ke-1,i,j),val(ke,i,j)) * ( val(ke-1,i,j)-val(ke,i,j) ) ) &
920  * ( 0.5_rp + sign(0.5_rp,vel) ) &
921  + val(ke,i,j) &
922  * ( 0.5_rp - sign(0.5_rp,vel) ) ) &
923  + gsqrt(ke-1,i,j) * num_diff(ke-1,i,j)
924 
925  flux(ke,i,j) = 0.0_rp
926  enddo
927  !$omp end do nowait
928 
929  else
930 
931 
932  !$omp do OMP_SCHEDULE_ collapse(2)
933  do j = jjs, jje
934  do i = iis, iie
935  do k = ks+1, ke-2
936 #ifdef DEBUG
937  call check( __line__, mom(k,i,j) )
938  call check( __line__, mom(k,i+1,j) )
939 
940  call check( __line__, val(k,i,j) )
941  call check( __line__, val(k+1,i,j) )
942 
943  call check( __line__, val(k-1,i,j) )
944  call check( __line__, val(k+2,i,j) )
945 
946 #endif
947  vel = ( 0.5_rp * ( mom(k,i,j)+mom(k,i+1,j) ) ) &
948  / ( f2h(k,1,i_uyz) &
949  * 0.5_rp * ( dens(k+1,i,j)+dens(k+1,i+1,j) ) &
950  + f2h(k,2,i_uyz) &
951  * 0.5_rp * ( dens(k,i,j)+dens(k,i+1,j) ) )
952  flux(k,i,j) = j33g * vel &
953  * ( ( val(k,i,j) &
954  + 0.5_rp * phi(val(k+1,i,j),val(k,i,j),val(k-1,i,j)) * ( val(k,i,j)-val(k-1,i,j) ) ) &
955  * ( 0.5_rp + sign(0.5_rp,vel) ) &
956  + ( val(k+1,i,j) &
957  + 0.5_rp * phi(val(k,i,j),val(k+1,i,j),val(k+2,i,j)) * ( val(k+1,i,j)-val(k+2,i,j) ) ) &
958  * ( 0.5_rp - sign(0.5_rp,vel) ) ) &
959  + gsqrt(k,i,j) * num_diff(k,i,j)
960  enddo
961  enddo
962  enddo
963  !$omp end do nowait
964 #ifdef DEBUG
965  k = iundef; i = iundef; j = iundef
966 #endif
967 
968  !$omp do OMP_SCHEDULE_ collapse(2)
969  do j = jjs, jje
970  do i = iis, iie
971 #ifdef DEBUG
972 
973  call check( __line__, mom(ks,i ,j) )
974  call check( __line__, mom(ks,i+1,j) )
975  call check( __line__, val(ks+1,i,j) )
976  call check( __line__, val(ks,i,j) )
977 
978 #endif
979  ! The boundary condition is qflx_hi + qflxJ13 + qfluxJ23 = 0 at KS-1.
980  ! The flux at KS-1 can be non-zero.
981  ! To reduce calculations, all the fluxes are set to zero.
982  flux(ks-1,i,j) = 0.0_rp
983 
984  vel = ( 0.5_rp * ( mom(ks,i,j)+mom(ks,i+1,j) ) ) &
985  / ( f2h(ks,1,i_uyz) &
986  * 0.5_rp * ( dens(ks+1,i,j)+dens(ks+1,i+1,j) ) &
987  + f2h(ks,2,i_uyz) &
988  * 0.5_rp * ( dens(ks,i,j)+dens(ks,i+1,j) ) )
989  flux(ks,i,j) = j33g * vel &
990  * ( val(ks,i,j) &
991  * ( 0.5_rp + sign(0.5_rp,vel) ) &
992  + ( val(ks+1,i,j) &
993  + 0.5_rp * phi(val(ks,i,j),val(ks+1,i,j),val(ks+2,i,j)) * ( val(ks+1,i,j)-val(ks+2,i,j) ) ) &
994  * ( 0.5_rp - sign(0.5_rp,vel) ) ) &
995  + gsqrt(ks,i,j) * num_diff(ks,i,j)
996  vel = ( 0.5_rp * ( mom(ke-1,i,j)+mom(ke-1,i+1,j) ) ) &
997  / ( f2h(ke-1,1,i_uyz) &
998  * 0.5_rp * ( dens(ke,i,j)+dens(ke,i+1,j) ) &
999  + f2h(ke-1,2,i_uyz) &
1000  * 0.5_rp * ( dens(ke-1,i,j)+dens(ke-1,i+1,j) ) )
1001  flux(ke-1,i,j) = j33g * vel &
1002  * ( ( val(ke-1,i,j) &
1003  + 0.5_rp * phi(val(ke-2,i,j),val(ke-1,i,j),val(ke,i,j)) * ( val(ke-1,i,j)-val(ke,i,j) ) ) &
1004  * ( 0.5_rp + sign(0.5_rp,vel) ) &
1005  + val(ke,i,j) &
1006  * ( 0.5_rp - sign(0.5_rp,vel) ) ) &
1007  + gsqrt(ke-1,i,j) * num_diff(ke-1,i,j)
1008 
1009  flux(ke,i,j) = 0.0_rp
1010  enddo
1011  enddo
1012  !$omp end do nowait
1013 
1014  end if
1015 
1016 
1017  !$omp end parallel
1018 #ifdef DEBUG
1019  k = iundef; i = iundef; j = iundef
1020 #endif
1021 
1022  return

References scale_debug::check(), scale_atmos_grid_cartesc_index::i_uyz, scale_atmos_grid_cartesc_index::i_xyz, scale_tracer::k, scale_atmos_grid_cartesc_index::ke, and scale_atmos_grid_cartesc_index::ks.

Referenced by scale_atmos_dyn_fvm_flux::atmos_dyn_fvm_flux_setup().

Here is the call graph for this function:
Here is the caller graph for this function:

◆ atmos_dyn_fvm_fluxj13_uyz_ud3koren1993()

subroutine, public scale_atmos_dyn_fvm_flux_ud3koren1993::atmos_dyn_fvm_fluxj13_uyz_ud3koren1993 ( real(rp), dimension (ka,ia,ja), intent(inout)  flux,
real(rp), dimension (ka,ia,ja), intent(in)  mom,
real(rp), dimension (ka,ia,ja), intent(in)  val,
real(rp), dimension (ka,ia,ja), intent(in)  DENS,
real(rp), dimension (ka,ia,ja), intent(in)  GSQRT,
real(rp), dimension (ka,ia,ja), intent(in)  J13G,
real(rp), dimension ( ia,ja,2), intent(in)  MAPF,
real(rp), dimension (ka), intent(in)  CDZ,
logical, intent(in)  TwoD,
integer, intent(in)  IIS,
integer, intent(in)  IIE,
integer, intent(in)  JJS,
integer, intent(in)  JJE 
)

calculation J13-flux at UYZ

Definition at line 1033 of file scale_atmos_dyn_fvm_flux_ud3Koren1993.F90.

1033  implicit none
1034 
1035  real(RP), intent(inout) :: flux (KA,IA,JA)
1036  real(RP), intent(in) :: mom (KA,IA,JA)
1037  real(RP), intent(in) :: val (KA,IA,JA)
1038  real(RP), intent(in) :: DENS (KA,IA,JA)
1039  real(RP), intent(in) :: GSQRT (KA,IA,JA)
1040  real(RP), intent(in) :: J13G (KA,IA,JA)
1041  real(RP), intent(in) :: MAPF ( IA,JA,2)
1042  real(RP), intent(in) :: CDZ (KA)
1043  logical, intent(in) :: TwoD
1044  integer, intent(in) :: IIS, IIE, JJS, JJE
1045 
1046  real(RP) :: vel
1047  integer :: k, i, j
1048  !---------------------------------------------------------------------------
1049 
1050  !$omp parallel default(none) private(i,j,k,vel) &
1051  !$omp shared(JJS,JJE,IIS,IIE,KS,KE,mom,val,DENS,flux,J13G,MAPF) &
1052  !$omp shared(GSQRT,CDZ,TwoD)
1053 
1054 
1055 
1056  !$omp do OMP_SCHEDULE_ collapse(2)
1057  do j = jjs, jje
1058  do i = iis, iie
1059  do k = ks+1, ke-2
1060  vel = ( f2h(k,1,i_uyz) &
1061  * mom(k+1,i,j) &
1062  + f2h(k,2,i_uyz) &
1063  * mom(k,i,j) ) &
1064  / ( f2h(k,1,i_uyz) &
1065  * 0.5_rp * ( dens(k+1,i,j)+dens(k+1,i+1,j) ) &
1066  + f2h(k,2,i_uyz) &
1067  * 0.5_rp * ( dens(k,i,j)+dens(k,i+1,j) ) )
1068  vel = vel * j13g(k,i,j)
1069  flux(k,i,j) = vel / mapf(i,j,+2) &
1070  * ( ( val(k,i,j) &
1071  + 0.5_rp * phi(val(k+1,i,j),val(k,i,j),val(k-1,i,j)) * ( val(k,i,j)-val(k-1,i,j) ) ) &
1072  * ( 0.5_rp + sign(0.5_rp,vel) ) &
1073  + ( val(k+1,i,j) &
1074  + 0.5_rp * phi(val(k,i,j),val(k+1,i,j),val(k+2,i,j)) * ( val(k+1,i,j)-val(k+2,i,j) ) ) &
1075  * ( 0.5_rp - sign(0.5_rp,vel) ) )
1076  enddo
1077  enddo
1078  enddo
1079  !$omp end do nowait
1080 
1081  !$omp do OMP_SCHEDULE_ collapse(2)
1082  do j = jjs, jje
1083  do i = iis, iie
1084  ! The boundary condition is qflx_hi + qflxJ13 + qfluxJ23 = 0 at KS-1.
1085  ! The flux at KS-1 can be non-zero.
1086  ! To reduce calculations, all the fluxes are set to zero.
1087  flux(ks-1,i,j) = 0.0_rp
1088 
1089  vel = ( f2h(ks,1,i_uyz) &
1090  * mom(ks+1,i,j) &
1091  + f2h(ks,2,i_uyz) &
1092  * mom(ks,i,j) ) &
1093  / ( f2h(ks,1,i_uyz) &
1094  * 0.5_rp * ( dens(ks+1,i,j)+dens(ks+1,i+1,j) ) &
1095  + f2h(ks,2,i_uyz) &
1096  * 0.5_rp * ( dens(ks,i,j)+dens(ks,i+1,j) ) )
1097  vel = vel * j13g(ks,i,j)
1098  flux(ks,i,j) = vel / mapf(i,j,+2) &
1099  * ( val(ks,i,j) &
1100  * ( 0.5_rp + sign(0.5_rp,vel) ) &
1101  + ( val(ks+1,i,j) &
1102  + 0.5_rp * phi(val(ks,i,j),val(ks+1,i,j),val(ks+2,i,j)) * ( val(ks+1,i,j)-val(ks+2,i,j) ) ) &
1103  * ( 0.5_rp - sign(0.5_rp,vel) ) )
1104 
1105  vel = ( f2h(ke-1,1,i_uyz) &
1106  * mom(ke,i,j) &
1107  + f2h(ke-1,2,i_uyz) &
1108  * mom(ke-1,i,j) ) &
1109  / ( f2h(ke-1,1,i_uyz) &
1110  * 0.5_rp * ( dens(ke,i,j)+dens(ke,i+1,j) ) &
1111  + f2h(ke-1,2,i_uyz) &
1112  * 0.5_rp * ( dens(ke-1,i,j)+dens(ke-1,i+1,j) ) )
1113  vel = vel * j13g(ke-1,i,j)
1114  flux(ke-1,i,j) = vel / mapf(i,j,+2) &
1115  * ( ( val(ke-1,i,j) &
1116  + 0.5_rp * phi(val(ke-2,i,j),val(ke-1,i,j),val(ke,i,j)) * ( val(ke-1,i,j)-val(ke,i,j) ) ) &
1117  * ( 0.5_rp + sign(0.5_rp,vel) ) &
1118  + val(ke,i,j) &
1119  * ( 0.5_rp - sign(0.5_rp,vel) ) )
1120 
1121  flux(ke ,i,j) = 0.0_rp
1122  enddo
1123  enddo
1124  !$omp end do nowait
1125 
1126 
1127 
1128  !$omp end parallel
1129  return

References scale_atmos_grid_cartesc_index::i_uyz, scale_tracer::k, scale_atmos_grid_cartesc_index::ke, and scale_atmos_grid_cartesc_index::ks.

Referenced by scale_atmos_dyn_fvm_flux::atmos_dyn_fvm_flux_setup().

Here is the caller graph for this function:

◆ atmos_dyn_fvm_fluxj23_uyz_ud3koren1993()

subroutine, public scale_atmos_dyn_fvm_flux_ud3koren1993::atmos_dyn_fvm_fluxj23_uyz_ud3koren1993 ( real(rp), dimension (ka,ia,ja), intent(inout)  flux,
real(rp), dimension (ka,ia,ja), intent(in)  mom,
real(rp), dimension (ka,ia,ja), intent(in)  val,
real(rp), dimension (ka,ia,ja), intent(in)  DENS,
real(rp), dimension (ka,ia,ja), intent(in)  GSQRT,
real(rp), dimension (ka,ia,ja), intent(in)  J23G,
real(rp), dimension ( ia,ja,2), intent(in)  MAPF,
real(rp), dimension (ka), intent(in)  CDZ,
logical, intent(in)  TwoD,
integer, intent(in)  IIS,
integer, intent(in)  IIE,
integer, intent(in)  JJS,
integer, intent(in)  JJE 
)

calculation J23-flux at UYZ

Definition at line 1140 of file scale_atmos_dyn_fvm_flux_ud3Koren1993.F90.

1140  implicit none
1141 
1142  real(RP), intent(inout) :: flux (KA,IA,JA)
1143  real(RP), intent(in) :: mom (KA,IA,JA)
1144  real(RP), intent(in) :: val (KA,IA,JA)
1145  real(RP), intent(in) :: DENS (KA,IA,JA)
1146  real(RP), intent(in) :: GSQRT (KA,IA,JA)
1147  real(RP), intent(in) :: J23G (KA,IA,JA)
1148  real(RP), intent(in) :: MAPF ( IA,JA,2)
1149  real(RP), intent(in) :: CDZ (KA)
1150  logical, intent(in) :: TwoD
1151  integer, intent(in) :: IIS, IIE, JJS, JJE
1152 
1153  real(RP) :: vel
1154  integer :: k, i, j
1155  !---------------------------------------------------------------------------
1156 
1157  !$omp parallel default(none) private(i,j,k,vel) &
1158  !$omp shared(JJS,JJE,IIS,IIE,KS,KE,mom,val,DENS,flux,J23G,MAPF) &
1159  !$omp shared(GSQRT,CDZ,TwoD)
1160 
1161 
1162  if ( twod ) then
1163 
1164  !$omp do OMP_SCHEDULE_
1165  do j = jjs, jje
1166  do k = ks+1, ke-2
1167  i = iis
1168  vel = ( f2h(k,1,i_xyz) &
1169  * 0.5_rp * ( mom(k+1,i,j)+mom(k+1,i,j-1) ) &
1170  + f2h(k,2,i_xyz) &
1171  * 0.5_rp * ( mom(k,i,j)+mom(k,i,j-1) ) ) &
1172  / ( f2h(k,1,i_xyz) &
1173  * dens(k+1,i,j) &
1174  + f2h(k,2,i_xyz) &
1175  * dens(k,i,j) )
1176  vel = vel * j23g(k,i,j)
1177  flux(k,i,j) = vel * ( ( val(k,i,j) &
1178  + 0.5_rp * phi(val(k+1,i,j),val(k,i,j),val(k-1,i,j)) * ( val(k,i,j)-val(k-1,i,j) ) ) &
1179  * ( 0.5_rp + sign(0.5_rp,vel) ) &
1180  + ( val(k+1,i,j) &
1181  + 0.5_rp * phi(val(k,i,j),val(k+1,i,j),val(k+2,i,j)) * ( val(k+1,i,j)-val(k+2,i,j) ) ) &
1182  * ( 0.5_rp - sign(0.5_rp,vel) ) )
1183  enddo
1184  enddo
1185  !$omp end do nowait
1186 
1187  !$omp do OMP_SCHEDULE_
1188  do j = jjs, jje
1189  i = iis
1190  ! The boundary condition is qflx_hi + qflxJ13 + qfluxJ23 = 0 at KS-1.
1191  ! The flux at KS-1 can be non-zero.
1192  ! To reduce calculations, all the fluxes are set to zero.
1193  flux(ks-1,i,j) = 0.0_rp
1194 
1195  vel = ( f2h(ks,1,i_xyz) &
1196  * 0.5_rp * ( mom(ks+1,i,j)+mom(ks+1,i,j-1) ) &
1197  + f2h(ks,2,i_xyz) &
1198  * 0.5_rp * ( mom(ks,i,j)+mom(ks,i,j-1) ) ) &
1199  / ( f2h(ks,1,i_xyz) &
1200  * dens(ks+1,i,j) &
1201  + f2h(ks,2,i_xyz) &
1202  * dens(ks,i,j) )
1203  vel = vel * j23g(ks,i,j)
1204  flux(ks,i,j) = vel / mapf(i,j,+1) &
1205  * ( val(ks,i,j) &
1206  * ( 0.5_rp + sign(0.5_rp,vel) ) &
1207  + ( val(ks+1,i,j) &
1208  + 0.5_rp * phi(val(ks,i,j),val(ks+1,i,j),val(ks+2,i,j)) * ( val(ks+1,i,j)-val(ks+2,i,j) ) ) &
1209  * ( 0.5_rp - sign(0.5_rp,vel) ) )
1210 
1211  vel = ( f2h(ke-1,1,i_xyz) &
1212  * 0.5_rp * ( mom(ke,i,j)+mom(ke,i,j-1) ) &
1213  + f2h(ke-1,2,i_xyz) &
1214  * 0.5_rp * ( mom(ke-1,i,j)+mom(ke-1,i,j-1) ) ) &
1215  / ( f2h(ke-1,1,i_xyz) &
1216  * dens(ke,i,j) &
1217  + f2h(ke-1,2,i_xyz) &
1218  * dens(ke-1,i,j) )
1219  vel = vel * j23g(ke-1,i,j)
1220  flux(ke-1,i,j) = vel / mapf(i,j,+1) &
1221  * ( ( val(ke-1,i,j) &
1222  + 0.5_rp * phi(val(ke-2,i,j),val(ke-1,i,j),val(ke,i,j)) * ( val(ke-1,i,j)-val(ke,i,j) ) ) &
1223  * ( 0.5_rp + sign(0.5_rp,vel) ) &
1224  + val(ke,i,j) &
1225  * ( 0.5_rp - sign(0.5_rp,vel) ) )
1226 
1227  flux(ke ,i,j) = 0.0_rp
1228  enddo
1229  !$omp end do nowait
1230 
1231  else
1232 
1233 
1234  !$omp do OMP_SCHEDULE_ collapse(2)
1235  do j = jjs, jje
1236  do i = iis, iie
1237  do k = ks+1, ke-2
1238  vel = ( f2h(k,1,i_uyz) &
1239  * 0.25_rp * ( mom(k+1,i,j)+mom(k+1,i+1,j)+mom(k+1,i,j-1)+mom(k+1,i+1,j-1) ) &
1240  + f2h(k,2,i_uyz) &
1241  * 0.25_rp * ( mom(k,i,j)+mom(k,i+1,j)+mom(k,i,j-1)+mom(k,i+1,j-1) ) ) &
1242  / ( f2h(k,1,i_uyz) &
1243  * 0.5_rp * ( dens(k+1,i,j)+dens(k+1,i+1,j) ) &
1244  + f2h(k,2,i_uyz) &
1245  * 0.5_rp * ( dens(k,i,j)+dens(k,i+1,j) ) )
1246  vel = vel * j23g(k,i,j)
1247  flux(k,i,j) = vel / mapf(i,j,+1) &
1248  * ( ( val(k,i,j) &
1249  + 0.5_rp * phi(val(k+1,i,j),val(k,i,j),val(k-1,i,j)) * ( val(k,i,j)-val(k-1,i,j) ) ) &
1250  * ( 0.5_rp + sign(0.5_rp,vel) ) &
1251  + ( val(k+1,i,j) &
1252  + 0.5_rp * phi(val(k,i,j),val(k+1,i,j),val(k+2,i,j)) * ( val(k+1,i,j)-val(k+2,i,j) ) ) &
1253  * ( 0.5_rp - sign(0.5_rp,vel) ) )
1254  enddo
1255  enddo
1256  enddo
1257  !$omp end do nowait
1258 
1259  !$omp do OMP_SCHEDULE_ collapse(2)
1260  do j = jjs, jje
1261  do i = iis, iie
1262  ! The boundary condition is qflx_hi + qflxJ13 + qfluxJ23 = 0 at KS-1.
1263  ! The flux at KS-1 can be non-zero.
1264  ! To reduce calculations, all the fluxes are set to zero.
1265  flux(ks-1,i,j) = 0.0_rp
1266 
1267  vel = ( f2h(ks,1,i_uyz) &
1268  * 0.25_rp * ( mom(ks+1,i,j)+mom(ks+1,i+1,j)+mom(ks+1,i,j-1)+mom(ks+1,i+1,j-1) ) &
1269  + f2h(ks,2,i_uyz) &
1270  * 0.25_rp * ( mom(ks,i,j)+mom(ks,i+1,j)+mom(ks,i,j-1)+mom(ks,i+1,j-1) ) ) &
1271  / ( f2h(ks,1,i_uyz) &
1272  * 0.5_rp * ( dens(ks+1,i,j)+dens(ks+1,i+1,j) ) &
1273  + f2h(ks,2,i_uyz) &
1274  * 0.5_rp * ( dens(ks,i,j)+dens(ks,i+1,j) ) )
1275  vel = vel * j23g(ks,i,j)
1276  flux(ks,i,j) = vel / mapf(i,j,+1) &
1277  * ( val(ks,i,j) &
1278  * ( 0.5_rp + sign(0.5_rp,vel) ) &
1279  + ( val(ks+1,i,j) &
1280  + 0.5_rp * phi(val(ks,i,j),val(ks+1,i,j),val(ks+2,i,j)) * ( val(ks+1,i,j)-val(ks+2,i,j) ) ) &
1281  * ( 0.5_rp - sign(0.5_rp,vel) ) )
1282 
1283  vel = ( f2h(ke-1,1,i_uyz) &
1284  * 0.25_rp * ( mom(ke,i,j)+mom(ke,i+1,j)+mom(ke,i,j-1)+mom(ke,i+1,j-1) ) &
1285  + f2h(ke-1,2,i_uyz) &
1286  * 0.25_rp * ( mom(ke-1,i,j)+mom(ke-1,i+1,j)+mom(ke-1,i,j-1)+mom(ke-1,i+1,j-1) ) ) &
1287  / ( f2h(ke-1,1,i_uyz) &
1288  * 0.5_rp * ( dens(ke,i,j)+dens(ke,i+1,j) ) &
1289  + f2h(ke-1,2,i_uyz) &
1290  * 0.5_rp * ( dens(ke-1,i,j)+dens(ke-1,i+1,j) ) )
1291  vel = vel * j23g(ke-1,i,j)
1292  flux(ke-1,i,j) = vel / mapf(i,j,+1) &
1293  * ( ( val(ke-1,i,j) &
1294  + 0.5_rp * phi(val(ke-2,i,j),val(ke-1,i,j),val(ke,i,j)) * ( val(ke-1,i,j)-val(ke,i,j) ) ) &
1295  * ( 0.5_rp + sign(0.5_rp,vel) ) &
1296  + val(ke,i,j) &
1297  * ( 0.5_rp - sign(0.5_rp,vel) ) )
1298 
1299  flux(ke ,i,j) = 0.0_rp
1300  enddo
1301  enddo
1302  !$omp end do nowait
1303 
1304 
1305  end if
1306 
1307 
1308  !$omp end parallel
1309  return

References scale_atmos_grid_cartesc_index::i_uyz, scale_atmos_grid_cartesc_index::i_xyz, scale_tracer::k, scale_atmos_grid_cartesc_index::ke, and scale_atmos_grid_cartesc_index::ks.

Referenced by scale_atmos_dyn_fvm_flux::atmos_dyn_fvm_flux_setup().

Here is the caller graph for this function:

◆ atmos_dyn_fvm_fluxx_uyz_ud3koren1993()

subroutine, public scale_atmos_dyn_fvm_flux_ud3koren1993::atmos_dyn_fvm_fluxx_uyz_ud3koren1993 ( real(rp), dimension (ka,ia,ja), intent(inout)  flux,
real(rp), dimension (ka,ia,ja), intent(in)  mom,
real(rp), dimension (ka,ia,ja), intent(in)  val,
real(rp), dimension (ka,ia,ja), intent(in)  DENS,
real(rp), dimension (ka,ia,ja), intent(in)  GSQRT,
real(rp), dimension ( ia,ja,2), intent(in)  MAPF,
real(rp), dimension(ka,ia,ja), intent(in)  num_diff,
real(rp), dimension (ka), intent(in)  CDZ,
logical, intent(in)  TwoD,
integer, intent(in)  IIS,
integer, intent(in)  IIE,
integer, intent(in)  JJS,
integer, intent(in)  JJE 
)

calculation X-flux at UY

Definition at line 1321 of file scale_atmos_dyn_fvm_flux_ud3Koren1993.F90.

1321  implicit none
1322 
1323  real(RP), intent(inout) :: flux (KA,IA,JA)
1324  real(RP), intent(in) :: mom (KA,IA,JA)
1325  real(RP), intent(in) :: val (KA,IA,JA)
1326  real(RP), intent(in) :: DENS (KA,IA,JA)
1327  real(RP), intent(in) :: GSQRT (KA,IA,JA)
1328  real(RP), intent(in) :: MAPF ( IA,JA,2)
1329  real(RP), intent(in) :: num_diff(KA,IA,JA)
1330  real(RP), intent(in) :: CDZ (KA)
1331  logical, intent(in) :: TwoD
1332  integer, intent(in) :: IIS, IIE, JJS, JJE
1333 
1334  real(RP) :: vel
1335  integer :: k, i, j
1336  !---------------------------------------------------------------------------
1337 
1338  ! note that x-index is added by -1
1339 
1340 
1341 
1342  !$omp parallel do default(none) private(i,j,k) OMP_SCHEDULE_ collapse(2) &
1343  !$omp private(vel) &
1344  !$omp shared(JJS,JJE,IIS,IIE,KS,KE,mom,val,DENS,flux,GSQRT,MAPF,num_diff)
1345  do j = jjs, jje
1346  do i = iis, iie+1
1347  do k = ks, ke
1348 #ifdef DEBUG
1349  call check( __line__, mom(k,i ,j) )
1350  call check( __line__, mom(k,i-1,j) )
1351 
1352  call check( __line__, val(k,i-1,j) )
1353  call check( __line__, val(k,i,j) )
1354 
1355  call check( __line__, val(k,i-2,j) )
1356  call check( __line__, val(k,i+1,j) )
1357 
1358 #endif
1359  vel = ( 0.5_rp * ( mom(k,i,j)+mom(k,i-1,j) ) ) &
1360  / ( dens(k,i,j) )
1361  flux(k,i-1,j) = gsqrt(k,i,j) / mapf(i,j,+2) * vel &
1362  * ( ( val(k,i-1,j) &
1363  + 0.5_rp * phi(val(k,i,j),val(k,i-1,j),val(k,i-2,j)) * ( val(k,i-1,j)-val(k,i-2,j) ) ) &
1364  * ( 0.5_rp + sign(0.5_rp,vel) ) &
1365  + ( val(k,i,j) &
1366  + 0.5_rp * phi(val(k,i-1,j),val(k,i,j),val(k,i+1,j)) * ( val(k,i,j)-val(k,i+1,j) ) ) &
1367  * ( 0.5_rp - sign(0.5_rp,vel) ) ) &
1368  + gsqrt(k,i,j) * num_diff(k,i,j)
1369  enddo
1370  enddo
1371  enddo
1372 #ifdef DEBUG
1373  k = iundef; i = iundef; j = iundef
1374 #endif
1375 
1376 
1377 
1378  return

References scale_debug::check(), scale_tracer::k, scale_atmos_grid_cartesc_index::ke, and scale_atmos_grid_cartesc_index::ks.

Referenced by scale_atmos_dyn_fvm_flux::atmos_dyn_fvm_flux_setup().

Here is the call graph for this function:
Here is the caller graph for this function:

◆ atmos_dyn_fvm_fluxy_uyz_ud3koren1993()

subroutine, public scale_atmos_dyn_fvm_flux_ud3koren1993::atmos_dyn_fvm_fluxy_uyz_ud3koren1993 ( real(rp), dimension (ka,ia,ja), intent(inout)  flux,
real(rp), dimension (ka,ia,ja), intent(in)  mom,
real(rp), dimension (ka,ia,ja), intent(in)  val,
real(rp), dimension (ka,ia,ja), intent(in)  DENS,
real(rp), dimension (ka,ia,ja), intent(in)  GSQRT,
real(rp), dimension ( ia,ja,2), intent(in)  MAPF,
real(rp), dimension(ka,ia,ja), intent(in)  num_diff,
real(rp), dimension (ka), intent(in)  CDZ,
logical, intent(in)  TwoD,
integer, intent(in)  IIS,
integer, intent(in)  IIE,
integer, intent(in)  JJS,
integer, intent(in)  JJE 
)

calculation Y-flux at UY

Definition at line 1390 of file scale_atmos_dyn_fvm_flux_ud3Koren1993.F90.

1390  implicit none
1391 
1392  real(RP), intent(inout) :: flux (KA,IA,JA)
1393  real(RP), intent(in) :: mom (KA,IA,JA)
1394  real(RP), intent(in) :: val (KA,IA,JA)
1395  real(RP), intent(in) :: DENS (KA,IA,JA)
1396  real(RP), intent(in) :: GSQRT (KA,IA,JA)
1397  real(RP), intent(in) :: MAPF ( IA,JA,2)
1398  real(RP), intent(in) :: num_diff(KA,IA,JA)
1399  real(RP), intent(in) :: CDZ (KA)
1400  logical, intent(in) :: TwoD
1401  integer, intent(in) :: IIS, IIE, JJS, JJE
1402 
1403  real(RP) :: vel
1404  integer :: k, i, j
1405  !---------------------------------------------------------------------------
1406 
1407 
1408 
1409  if ( twod ) then
1410 
1411  !$omp parallel do default(none) private(i,j,k) OMP_SCHEDULE_ &
1412  !$omp private(vel) &
1413  !$omp shared(JJS,JJE,IIS,IIE,KS,KE,mom,val,DENS,flux,GSQRT,MAPF,num_diff,TwoD)
1414  do j = jjs-1, jje
1415  do k = ks, ke
1416  i = iis
1417 #ifdef DEBUG
1418  call check( __line__, mom(k,i ,j) )
1419 
1420  call check( __line__, val(k,i,j) )
1421  call check( __line__, val(k,i,j+1) )
1422 
1423  call check( __line__, val(k,i,j-1) )
1424  call check( __line__, val(k,i,j+2) )
1425 
1426 #endif
1427  vel = ( mom(k,i,j) ) &
1428  / ( 0.5_rp * ( dens(k,i,j)+dens(k,i,j+1) ) )
1429  flux(k,i,j) = gsqrt(k,i,j) / mapf(i,j,+1) * vel &
1430  * ( ( val(k,i,j) &
1431  + 0.5_rp * phi(val(k,i,j+1),val(k,i,j),val(k,i,j-1)) * ( val(k,i,j)-val(k,i,j-1) ) ) &
1432  * ( 0.5_rp + sign(0.5_rp,vel) ) &
1433  + ( val(k,i,j+1) &
1434  + 0.5_rp * phi(val(k,i,j),val(k,i,j+1),val(k,i,j+2)) * ( val(k,i,j+1)-val(k,i,j+2) ) ) &
1435  * ( 0.5_rp - sign(0.5_rp,vel) ) ) &
1436  + gsqrt(k,i,j) * num_diff(k,i,j)
1437  enddo
1438  enddo
1439 #ifdef DEBUG
1440  k = iundef; i = iundef; j = iundef
1441 #endif
1442 
1443  else
1444 
1445 
1446  !$omp parallel do default(none) private(i,j,k) OMP_SCHEDULE_ collapse(2) &
1447  !$omp private(vel) &
1448  !$omp shared(JJS,JJE,IIS,IIE,KS,KE,mom,val,DENS,flux,GSQRT,MAPF,num_diff)
1449  do j = jjs-1, jje
1450  do i = iis, iie
1451  do k = ks, ke
1452 #ifdef DEBUG
1453  call check( __line__, mom(k,i ,j) )
1454  call check( __line__, mom(k,i-1,j) )
1455 
1456  call check( __line__, val(k,i,j) )
1457  call check( __line__, val(k,i,j+1) )
1458 
1459  call check( __line__, val(k,i,j-1) )
1460  call check( __line__, val(k,i,j+2) )
1461 
1462 #endif
1463  vel = ( 0.5_rp * ( mom(k,i,j)+mom(k,i+1,j) ) ) &
1464  / ( 0.25_rp * ( dens(k,i,j)+dens(k,i+1,j)+dens(k,i,j+1)+dens(k,i+1,j+1) ) )
1465  flux(k,i,j) = gsqrt(k,i,j) / mapf(i,j,+1) * vel &
1466  * ( ( val(k,i,j) &
1467  + 0.5_rp * phi(val(k,i,j+1),val(k,i,j),val(k,i,j-1)) * ( val(k,i,j)-val(k,i,j-1) ) ) &
1468  * ( 0.5_rp + sign(0.5_rp,vel) ) &
1469  + ( val(k,i,j+1) &
1470  + 0.5_rp * phi(val(k,i,j),val(k,i,j+1),val(k,i,j+2)) * ( val(k,i,j+1)-val(k,i,j+2) ) ) &
1471  * ( 0.5_rp - sign(0.5_rp,vel) ) ) &
1472  + gsqrt(k,i,j) * num_diff(k,i,j)
1473  enddo
1474  enddo
1475  enddo
1476 #ifdef DEBUG
1477  k = iundef; i = iundef; j = iundef
1478 #endif
1479 
1480 
1481  end if
1482 
1483 
1484  return

References scale_debug::check(), scale_tracer::k, scale_atmos_grid_cartesc_index::ke, and scale_atmos_grid_cartesc_index::ks.

Referenced by scale_atmos_dyn_fvm_flux::atmos_dyn_fvm_flux_setup().

Here is the call graph for this function:
Here is the caller graph for this function:

◆ atmos_dyn_fvm_fluxz_xvz_ud3koren1993()

subroutine, public scale_atmos_dyn_fvm_flux_ud3koren1993::atmos_dyn_fvm_fluxz_xvz_ud3koren1993 ( real(rp), dimension (ka,ia,ja), intent(inout)  flux,
real(rp), dimension (ka,ia,ja), intent(in)  mom,
real(rp), dimension (ka,ia,ja), intent(in)  val,
real(rp), dimension (ka,ia,ja), intent(in)  DENS,
real(rp), dimension (ka,ia,ja), intent(in)  GSQRT,
real(rp), intent(in)  J33G,
real(rp), dimension(ka,ia,ja), intent(in)  num_diff,
real(rp), dimension (ka), intent(in)  CDZ,
logical, intent(in)  TwoD,
integer, intent(in)  IIS,
integer, intent(in)  IIE,
integer, intent(in)  JJS,
integer, intent(in)  JJE 
)

calculation z-flux at XV

Definition at line 1498 of file scale_atmos_dyn_fvm_flux_ud3Koren1993.F90.

1498  implicit none
1499 
1500  real(RP), intent(inout) :: flux (KA,IA,JA)
1501  real(RP), intent(in) :: mom (KA,IA,JA)
1502  real(RP), intent(in) :: val (KA,IA,JA)
1503  real(RP), intent(in) :: DENS (KA,IA,JA)
1504  real(RP), intent(in) :: GSQRT (KA,IA,JA)
1505  real(RP), intent(in) :: J33G
1506  real(RP), intent(in) :: num_diff(KA,IA,JA)
1507  real(RP), intent(in) :: CDZ (KA)
1508  logical, intent(in) :: TwoD
1509  integer, intent(in) :: IIS, IIE, JJS, JJE
1510 
1511  real(RP) :: vel
1512  integer :: k, i, j
1513  !---------------------------------------------------------------------------
1514 
1515  !$omp parallel default(none) private(i,j,k,vel) &
1516  !$omp shared(JJS,JJE,IIS,IIE,KS,KE,mom,val,DENS,flux,J33G,GSQRT,num_diff) &
1517  !$omp shared(CDZ,TwoD)
1518 
1519 
1520  !$omp do OMP_SCHEDULE_ collapse(2)
1521  do j = jjs, jje
1522  do i = iis, iie
1523  do k = ks+1, ke-2
1524 #ifdef DEBUG
1525  call check( __line__, mom(k,i,j) )
1526  call check( __line__, mom(k,i,j+1) )
1527 
1528  call check( __line__, val(k,i,j) )
1529  call check( __line__, val(k+1,i,j) )
1530 
1531  call check( __line__, val(k-1,i,j) )
1532  call check( __line__, val(k+2,i,j) )
1533 
1534 #endif
1535  vel = ( 0.5_rp * ( mom(k,i,j)+mom(k,i,j+1) ) ) &
1536  / ( f2h(k,1,i_xvz) &
1537  * 0.5_rp * ( dens(k+1,i,j)+dens(k+1,i,j+1) ) &
1538  + f2h(k,2,i_xvz) &
1539  * 0.5_rp * ( dens(k,i,j)+dens(k,i,j+1) ) )
1540  flux(k,i,j) = j33g * vel &
1541  * ( ( val(k,i,j) &
1542  + 0.5_rp * phi(val(k+1,i,j),val(k,i,j),val(k-1,i,j)) * ( val(k,i,j)-val(k-1,i,j) ) ) &
1543  * ( 0.5_rp + sign(0.5_rp,vel) ) &
1544  + ( val(k+1,i,j) &
1545  + 0.5_rp * phi(val(k,i,j),val(k+1,i,j),val(k+2,i,j)) * ( val(k+1,i,j)-val(k+2,i,j) ) ) &
1546  * ( 0.5_rp - sign(0.5_rp,vel) ) ) &
1547  + gsqrt(k,i,j) * num_diff(k,i,j)
1548  enddo
1549  enddo
1550  enddo
1551  !$omp end do nowait
1552 #ifdef DEBUG
1553  k = iundef; i = iundef; j = iundef
1554 #endif
1555 
1556  !$omp do OMP_SCHEDULE_ collapse(2)
1557  do j = jjs, jje
1558  do i = iis, iie
1559 #ifdef DEBUG
1560 
1561  call check( __line__, mom(ks,i ,j) )
1562  call check( __line__, mom(ks,i,j+1) )
1563  call check( __line__, val(ks+1,i,j) )
1564  call check( __line__, val(ks,i,j) )
1565 
1566 #endif
1567  ! The boundary condition is qflx_hi + qflxJ13 + qfluxJ23 = 0 at KS-1.
1568  ! The flux at KS-1 can be non-zero.
1569  ! To reduce calculations, all the fluxes are set to zero.
1570  flux(ks-1,i,j) = 0.0_rp
1571 
1572  vel = ( 0.5_rp * ( mom(ks,i,j)+mom(ks,i,j+1) ) ) &
1573  / ( f2h(ks,1,i_xvz) &
1574  * 0.5_rp * ( dens(ks+1,i,j)+dens(ks+1,i,j+1) ) &
1575  + f2h(ks,2,i_xvz) &
1576  * 0.5_rp * ( dens(ks,i,j)+dens(ks,i,j+1) ) )
1577  flux(ks,i,j) = j33g * vel &
1578  * ( val(ks,i,j) &
1579  * ( 0.5_rp + sign(0.5_rp,vel) ) &
1580  + ( val(ks+1,i,j) &
1581  + 0.5_rp * phi(val(ks,i,j),val(ks+1,i,j),val(ks+2,i,j)) * ( val(ks+1,i,j)-val(ks+2,i,j) ) ) &
1582  * ( 0.5_rp - sign(0.5_rp,vel) ) ) &
1583  + gsqrt(ks,i,j) * num_diff(ks,i,j)
1584  vel = ( 0.5_rp * ( mom(ke-1,i,j)+mom(ke-1,i,j+1) ) ) &
1585  / ( f2h(ke-1,1,i_xvz) &
1586  * 0.5_rp * ( dens(ke,i,j)+dens(ke,i,j+1) ) &
1587  + f2h(ke-1,2,i_xvz) &
1588  * 0.5_rp * ( dens(ke-1,i,j)+dens(ke-1,i,j+1) ) )
1589  flux(ke-1,i,j) = j33g * vel &
1590  * ( ( val(ke-1,i,j) &
1591  + 0.5_rp * phi(val(ke-2,i,j),val(ke-1,i,j),val(ke,i,j)) * ( val(ke-1,i,j)-val(ke,i,j) ) ) &
1592  * ( 0.5_rp + sign(0.5_rp,vel) ) &
1593  + val(ke,i,j) &
1594  * ( 0.5_rp - sign(0.5_rp,vel) ) ) &
1595  + gsqrt(ke-1,i,j) * num_diff(ke-1,i,j)
1596 
1597  flux(ke,i,j) = 0.0_rp
1598  enddo
1599  enddo
1600  !$omp end do nowait
1601 
1602 
1603  !$omp end parallel
1604 #ifdef DEBUG
1605  k = iundef; i = iundef; j = iundef
1606 #endif
1607 
1608  return

References scale_debug::check(), scale_atmos_grid_cartesc_index::i_xvz, scale_tracer::k, scale_atmos_grid_cartesc_index::ke, and scale_atmos_grid_cartesc_index::ks.

Referenced by scale_atmos_dyn_fvm_flux::atmos_dyn_fvm_flux_setup().

Here is the call graph for this function:
Here is the caller graph for this function:

◆ atmos_dyn_fvm_fluxj13_xvz_ud3koren1993()

subroutine, public scale_atmos_dyn_fvm_flux_ud3koren1993::atmos_dyn_fvm_fluxj13_xvz_ud3koren1993 ( real(rp), dimension (ka,ia,ja), intent(inout)  flux,
real(rp), dimension (ka,ia,ja), intent(in)  mom,
real(rp), dimension (ka,ia,ja), intent(in)  val,
real(rp), dimension (ka,ia,ja), intent(in)  DENS,
real(rp), dimension (ka,ia,ja), intent(in)  GSQRT,
real(rp), dimension (ka,ia,ja), intent(in)  J13G,
real(rp), dimension ( ia,ja,2), intent(in)  MAPF,
real(rp), dimension (ka), intent(in)  CDZ,
logical, intent(in)  TwoD,
integer, intent(in)  IIS,
integer, intent(in)  IIE,
integer, intent(in)  JJS,
integer, intent(in)  JJE 
)

calculation J13-flux at XVZ

Definition at line 1619 of file scale_atmos_dyn_fvm_flux_ud3Koren1993.F90.

1619  implicit none
1620 
1621  real(RP), intent(inout) :: flux (KA,IA,JA)
1622  real(RP), intent(in) :: mom (KA,IA,JA)
1623  real(RP), intent(in) :: val (KA,IA,JA)
1624  real(RP), intent(in) :: DENS (KA,IA,JA)
1625  real(RP), intent(in) :: GSQRT (KA,IA,JA)
1626  real(RP), intent(in) :: J13G (KA,IA,JA)
1627  real(RP), intent(in) :: MAPF ( IA,JA,2)
1628  real(RP), intent(in) :: CDZ (KA)
1629  logical, intent(in) :: TwoD
1630  integer, intent(in) :: IIS, IIE, JJS, JJE
1631 
1632  real(RP) :: vel
1633  integer :: k, i, j
1634  !---------------------------------------------------------------------------
1635 
1636  !$omp parallel default(none) private(i,j,k,vel) &
1637  !$omp shared(JJS,JJE,IIS,IIE,KS,KE,mom,val,DENS,flux,J13G,MAPF) &
1638  !$omp shared(GSQRT,CDZ,TwoD)
1639 
1640 
1641 
1642  !$omp do OMP_SCHEDULE_ collapse(2)
1643  do j = jjs, jje
1644  do i = iis, iie
1645  do k = ks+1, ke-2
1646  vel = ( f2h(k,1,i_xvz) &
1647  * 0.25_rp * ( mom(k+1,i,j)+mom(k+1,i-1,j)+mom(k+1,i,j+1)+mom(k+1,i-1,j+1) ) &
1648  + f2h(k,2,i_xvz) &
1649  * 0.25_rp * ( mom(k,i,j)+mom(k,i-1,j)+mom(k,i,j+1)+mom(k,i-1,j+1) ) ) &
1650  / ( f2h(k,1,i_xvz) &
1651  * 0.5_rp * ( dens(k+1,i,j)+dens(k+1,i,j+1) ) &
1652  + f2h(k,2,i_xvz) &
1653  * 0.5_rp * ( dens(k,i,j)+dens(k,i,j+1) ) )
1654  vel = vel * j13g(k,i,j)
1655  flux(k,i,j) = vel / mapf(i,j,+2) &
1656  * ( ( val(k,i,j) &
1657  + 0.5_rp * phi(val(k+1,i,j),val(k,i,j),val(k-1,i,j)) * ( val(k,i,j)-val(k-1,i,j) ) ) &
1658  * ( 0.5_rp + sign(0.5_rp,vel) ) &
1659  + ( val(k+1,i,j) &
1660  + 0.5_rp * phi(val(k,i,j),val(k+1,i,j),val(k+2,i,j)) * ( val(k+1,i,j)-val(k+2,i,j) ) ) &
1661  * ( 0.5_rp - sign(0.5_rp,vel) ) )
1662  enddo
1663  enddo
1664  enddo
1665  !$omp end do nowait
1666 
1667  !$omp do OMP_SCHEDULE_ collapse(2)
1668  do j = jjs, jje
1669  do i = iis, iie
1670  ! The boundary condition is qflx_hi + qflxJ13 + qfluxJ23 = 0 at KS-1.
1671  ! The flux at KS-1 can be non-zero.
1672  ! To reduce calculations, all the fluxes are set to zero.
1673  flux(ks-1,i,j) = 0.0_rp
1674 
1675  vel = ( f2h(ks,1,i_xvz) &
1676  * 0.25_rp * ( mom(ks+1,i,j)+mom(ks+1,i-1,j)+mom(ks+1,i,j+1)+mom(ks+1,i-1,j+1) ) &
1677  + f2h(ks,2,i_xvz) &
1678  * 0.25_rp * ( mom(ks,i,j)+mom(ks,i-1,j)+mom(ks,i,j+1)+mom(ks,i-1,j+1) ) ) &
1679  / ( f2h(ks,1,i_xvz) &
1680  * 0.5_rp * ( dens(ks+1,i,j)+dens(ks+1,i,j+1) ) &
1681  + f2h(ks,2,i_xvz) &
1682  * 0.5_rp * ( dens(ks,i,j)+dens(ks,i,j+1) ) )
1683  vel = vel * j13g(ks,i,j)
1684  flux(ks,i,j) = vel / mapf(i,j,+2) &
1685  * ( val(ks,i,j) &
1686  * ( 0.5_rp + sign(0.5_rp,vel) ) &
1687  + ( val(ks+1,i,j) &
1688  + 0.5_rp * phi(val(ks,i,j),val(ks+1,i,j),val(ks+2,i,j)) * ( val(ks+1,i,j)-val(ks+2,i,j) ) ) &
1689  * ( 0.5_rp - sign(0.5_rp,vel) ) )
1690 
1691  vel = ( f2h(ke-1,1,i_xvz) &
1692  * 0.25_rp * ( mom(ke,i,j)+mom(ke,i-1,j)+mom(ke,i,j+1)+mom(ke,i-1,j+1) ) &
1693  + f2h(ke-1,2,i_xvz) &
1694  * 0.25_rp * ( mom(ke-1,i,j)+mom(ke-1,i-1,j)+mom(ke-1,i,j+1)+mom(ke-1,i-1,j+1) ) ) &
1695  / ( f2h(ke-1,1,i_xvz) &
1696  * 0.5_rp * ( dens(ke,i,j)+dens(ke,i,j+1) ) &
1697  + f2h(ke-1,2,i_xvz) &
1698  * 0.5_rp * ( dens(ke-1,i,j)+dens(ke-1,i,j+1) ) )
1699  vel = vel * j13g(ke-1,i,j)
1700  flux(ke-1,i,j) = vel / mapf(i,j,+2) &
1701  * ( ( val(ke-1,i,j) &
1702  + 0.5_rp * phi(val(ke-2,i,j),val(ke-1,i,j),val(ke,i,j)) * ( val(ke-1,i,j)-val(ke,i,j) ) ) &
1703  * ( 0.5_rp + sign(0.5_rp,vel) ) &
1704  + val(ke,i,j) &
1705  * ( 0.5_rp - sign(0.5_rp,vel) ) )
1706 
1707  flux(ke ,i,j) = 0.0_rp
1708  enddo
1709  enddo
1710  !$omp end do nowait
1711 
1712 
1713 
1714  !$omp end parallel
1715  return

References scale_atmos_grid_cartesc_index::i_xvz, scale_tracer::k, scale_atmos_grid_cartesc_index::ke, and scale_atmos_grid_cartesc_index::ks.

Referenced by scale_atmos_dyn_fvm_flux::atmos_dyn_fvm_flux_setup().

Here is the caller graph for this function:

◆ atmos_dyn_fvm_fluxj23_xvz_ud3koren1993()

subroutine, public scale_atmos_dyn_fvm_flux_ud3koren1993::atmos_dyn_fvm_fluxj23_xvz_ud3koren1993 ( real(rp), dimension (ka,ia,ja), intent(inout)  flux,
real(rp), dimension (ka,ia,ja), intent(in)  mom,
real(rp), dimension (ka,ia,ja), intent(in)  val,
real(rp), dimension (ka,ia,ja), intent(in)  DENS,
real(rp), dimension (ka,ia,ja), intent(in)  GSQRT,
real(rp), dimension (ka,ia,ja), intent(in)  J23G,
real(rp), dimension ( ia,ja,2), intent(in)  MAPF,
real(rp), dimension (ka), intent(in)  CDZ,
logical, intent(in)  TwoD,
integer, intent(in)  IIS,
integer, intent(in)  IIE,
integer, intent(in)  JJS,
integer, intent(in)  JJE 
)

calculation J23-flux at XVZ

Definition at line 1726 of file scale_atmos_dyn_fvm_flux_ud3Koren1993.F90.

1726  implicit none
1727 
1728  real(RP), intent(inout) :: flux (KA,IA,JA)
1729  real(RP), intent(in) :: mom (KA,IA,JA)
1730  real(RP), intent(in) :: val (KA,IA,JA)
1731  real(RP), intent(in) :: DENS (KA,IA,JA)
1732  real(RP), intent(in) :: GSQRT (KA,IA,JA)
1733  real(RP), intent(in) :: J23G (KA,IA,JA)
1734  real(RP), intent(in) :: MAPF ( IA,JA,2)
1735  real(RP), intent(in) :: CDZ (KA)
1736  logical, intent(in) :: TwoD
1737  integer, intent(in) :: IIS, IIE, JJS, JJE
1738 
1739  real(RP) :: vel
1740  integer :: k, i, j
1741  !---------------------------------------------------------------------------
1742 
1743  !$omp parallel default(none) private(i,j,k,vel) &
1744  !$omp shared(JJS,JJE,IIS,IIE,KS,KE,mom,val,DENS,flux,J23G,MAPF) &
1745  !$omp shared(GSQRT,CDZ,TwoD)
1746 
1747 
1748 
1749  !$omp do OMP_SCHEDULE_ collapse(2)
1750  do j = jjs, jje
1751  do i = iis, iie
1752  do k = ks+1, ke-2
1753  vel = ( f2h(k,1,i_xvz) &
1754  * mom(k+1,i,j) &
1755  + f2h(k,2,i_xvz) &
1756  * mom(k,i,j) ) &
1757  / ( f2h(k,1,i_xvz) &
1758  * 0.5_rp * ( dens(k+1,i,j)+dens(k+1,i,j+1) ) &
1759  + f2h(k,2,i_xvz) &
1760  * 0.5_rp * ( dens(k,i,j)+dens(k,i,j+1) ) )
1761  vel = vel * j23g(k,i,j)
1762  flux(k,i,j) = vel / mapf(i,j,+1) &
1763  * ( ( val(k,i,j) &
1764  + 0.5_rp * phi(val(k+1,i,j),val(k,i,j),val(k-1,i,j)) * ( val(k,i,j)-val(k-1,i,j) ) ) &
1765  * ( 0.5_rp + sign(0.5_rp,vel) ) &
1766  + ( val(k+1,i,j) &
1767  + 0.5_rp * phi(val(k,i,j),val(k+1,i,j),val(k+2,i,j)) * ( val(k+1,i,j)-val(k+2,i,j) ) ) &
1768  * ( 0.5_rp - sign(0.5_rp,vel) ) )
1769  enddo
1770  enddo
1771  enddo
1772  !$omp end do nowait
1773 
1774  !$omp do OMP_SCHEDULE_ collapse(2)
1775  do j = jjs, jje
1776  do i = iis, iie
1777  ! The boundary condition is qflx_hi + qflxJ13 + qfluxJ23 = 0 at KS-1.
1778  ! The flux at KS-1 can be non-zero.
1779  ! To reduce calculations, all the fluxes are set to zero.
1780  flux(ks-1,i,j) = 0.0_rp
1781 
1782  vel = ( f2h(ks,1,i_xvz) &
1783  * mom(ks+1,i,j) &
1784  + f2h(ks,2,i_xvz) &
1785  * mom(ks,i,j) ) &
1786  / ( f2h(ks,1,i_xvz) &
1787  * 0.5_rp * ( dens(ks+1,i,j)+dens(ks+1,i,j+1) ) &
1788  + f2h(ks,2,i_xvz) &
1789  * 0.5_rp * ( dens(ks,i,j)+dens(ks,i,j+1) ) )
1790  vel = vel * j23g(ks,i,j)
1791  flux(ks,i,j) = vel / mapf(i,j,+1) &
1792  * ( val(ks,i,j) &
1793  * ( 0.5_rp + sign(0.5_rp,vel) ) &
1794  + ( val(ks+1,i,j) &
1795  + 0.5_rp * phi(val(ks,i,j),val(ks+1,i,j),val(ks+2,i,j)) * ( val(ks+1,i,j)-val(ks+2,i,j) ) ) &
1796  * ( 0.5_rp - sign(0.5_rp,vel) ) )
1797 
1798  vel = ( f2h(ke-1,1,i_xvz) &
1799  * mom(ke,i,j) &
1800  + f2h(ke-1,2,i_xvz) &
1801  * mom(ke-1,i,j) ) &
1802  / ( f2h(ke-1,1,i_xvz) &
1803  * 0.5_rp * ( dens(ke,i,j)+dens(ke,i,j+1) ) &
1804  + f2h(ke-1,2,i_xvz) &
1805  * 0.5_rp * ( dens(ke-1,i,j)+dens(ke-1,i,j+1) ) )
1806  vel = vel * j23g(ke-1,i,j)
1807  flux(ke-1,i,j) = vel / mapf(i,j,+1) &
1808  * ( ( val(ke-1,i,j) &
1809  + 0.5_rp * phi(val(ke-2,i,j),val(ke-1,i,j),val(ke,i,j)) * ( val(ke-1,i,j)-val(ke,i,j) ) ) &
1810  * ( 0.5_rp + sign(0.5_rp,vel) ) &
1811  + val(ke,i,j) &
1812  * ( 0.5_rp - sign(0.5_rp,vel) ) )
1813 
1814  flux(ke ,i,j) = 0.0_rp
1815  enddo
1816  enddo
1817  !$omp end do nowait
1818 
1819 
1820 
1821  !$omp end parallel
1822  return

References scale_atmos_grid_cartesc_index::i_xvz, scale_tracer::k, scale_atmos_grid_cartesc_index::ke, and scale_atmos_grid_cartesc_index::ks.

Referenced by scale_atmos_dyn_fvm_flux::atmos_dyn_fvm_flux_setup().

Here is the caller graph for this function:

◆ atmos_dyn_fvm_fluxx_xvz_ud3koren1993()

subroutine, public scale_atmos_dyn_fvm_flux_ud3koren1993::atmos_dyn_fvm_fluxx_xvz_ud3koren1993 ( real(rp), dimension (ka,ia,ja), intent(inout)  flux,
real(rp), dimension (ka,ia,ja), intent(in)  mom,
real(rp), dimension (ka,ia,ja), intent(in)  val,
real(rp), dimension (ka,ia,ja), intent(in)  DENS,
real(rp), dimension (ka,ia,ja), intent(in)  GSQRT,
real(rp), dimension ( ia,ja,2), intent(in)  MAPF,
real(rp), dimension(ka,ia,ja), intent(in)  num_diff,
real(rp), dimension (ka), intent(in)  CDZ,
logical, intent(in)  TwoD,
integer, intent(in)  IIS,
integer, intent(in)  IIE,
integer, intent(in)  JJS,
integer, intent(in)  JJE 
)

calculation X-flux at XV

Definition at line 1834 of file scale_atmos_dyn_fvm_flux_ud3Koren1993.F90.

1834  implicit none
1835 
1836  real(RP), intent(inout) :: flux (KA,IA,JA)
1837  real(RP), intent(in) :: mom (KA,IA,JA)
1838  real(RP), intent(in) :: val (KA,IA,JA)
1839  real(RP), intent(in) :: DENS (KA,IA,JA)
1840  real(RP), intent(in) :: GSQRT (KA,IA,JA)
1841  real(RP), intent(in) :: MAPF ( IA,JA,2)
1842  real(RP), intent(in) :: num_diff(KA,IA,JA)
1843  real(RP), intent(in) :: CDZ (KA)
1844  logical, intent(in) :: TwoD
1845  integer, intent(in) :: IIS, IIE, JJS, JJE
1846 
1847  real(RP) :: vel
1848  integer :: k, i, j
1849  !---------------------------------------------------------------------------
1850 
1851 
1852 
1853  !$omp parallel do default(none) private(i,j,k) OMP_SCHEDULE_ collapse(2) &
1854  !$omp private(vel) &
1855  !$omp shared(JJS,JJE,IIS,IIE,KS,KE,mom,val,DENS,flux,GSQRT,MAPF,num_diff)
1856  do j = jjs, jje
1857  do i = iis-1, iie
1858  do k = ks, ke
1859 #ifdef DEBUG
1860  call check( __line__, mom(k,i ,j) )
1861  call check( __line__, mom(k,i,j-1) )
1862 
1863  call check( __line__, val(k,i,j) )
1864  call check( __line__, val(k,i+1,j) )
1865 
1866  call check( __line__, val(k,i-1,j) )
1867  call check( __line__, val(k,i+2,j) )
1868 
1869 #endif
1870  vel = ( 0.5_rp * ( mom(k,i,j)+mom(k,i,j+1) ) ) &
1871  / ( 0.25_rp * ( dens(k,i,j)+dens(k,i+1,j)+dens(k,i,j+1)+dens(k,i+1,j+1) ) )
1872  flux(k,i,j) = gsqrt(k,i,j) / mapf(i,j,+2) * vel &
1873  * ( ( val(k,i,j) &
1874  + 0.5_rp * phi(val(k,i+1,j),val(k,i,j),val(k,i-1,j)) * ( val(k,i,j)-val(k,i-1,j) ) ) &
1875  * ( 0.5_rp + sign(0.5_rp,vel) ) &
1876  + ( val(k,i+1,j) &
1877  + 0.5_rp * phi(val(k,i,j),val(k,i+1,j),val(k,i+2,j)) * ( val(k,i+1,j)-val(k,i+2,j) ) ) &
1878  * ( 0.5_rp - sign(0.5_rp,vel) ) ) &
1879  + gsqrt(k,i,j) * num_diff(k,i,j)
1880  enddo
1881  enddo
1882  enddo
1883 #ifdef DEBUG
1884  k = iundef; i = iundef; j = iundef
1885 #endif
1886 
1887 
1888 
1889  return

References scale_debug::check(), scale_tracer::k, scale_atmos_grid_cartesc_index::ke, and scale_atmos_grid_cartesc_index::ks.

Referenced by scale_atmos_dyn_fvm_flux::atmos_dyn_fvm_flux_setup().

Here is the call graph for this function:
Here is the caller graph for this function:

◆ atmos_dyn_fvm_fluxy_xvz_ud3koren1993()

subroutine, public scale_atmos_dyn_fvm_flux_ud3koren1993::atmos_dyn_fvm_fluxy_xvz_ud3koren1993 ( real(rp), dimension (ka,ia,ja), intent(inout)  flux,
real(rp), dimension (ka,ia,ja), intent(in)  mom,
real(rp), dimension (ka,ia,ja), intent(in)  val,
real(rp), dimension (ka,ia,ja), intent(in)  DENS,
real(rp), dimension (ka,ia,ja), intent(in)  GSQRT,
real(rp), dimension ( ia,ja,2), intent(in)  MAPF,
real(rp), dimension(ka,ia,ja), intent(in)  num_diff,
real(rp), dimension (ka), intent(in)  CDZ,
logical, intent(in)  TwoD,
integer, intent(in)  IIS,
integer, intent(in)  IIE,
integer, intent(in)  JJS,
integer, intent(in)  JJE 
)

calculation Y-flux at XV

Definition at line 1901 of file scale_atmos_dyn_fvm_flux_ud3Koren1993.F90.

1901  implicit none
1902 
1903  real(RP), intent(inout) :: flux (KA,IA,JA)
1904  real(RP), intent(in) :: mom (KA,IA,JA)
1905  real(RP), intent(in) :: val (KA,IA,JA)
1906  real(RP), intent(in) :: DENS (KA,IA,JA)
1907  real(RP), intent(in) :: GSQRT (KA,IA,JA)
1908  real(RP), intent(in) :: MAPF ( IA,JA,2)
1909  real(RP), intent(in) :: num_diff(KA,IA,JA)
1910  real(RP), intent(in) :: CDZ (KA)
1911  logical, intent(in) :: TwoD
1912  integer, intent(in) :: IIS, IIE, JJS, JJE
1913 
1914  real(RP) :: vel
1915  integer :: k, i, j
1916  !---------------------------------------------------------------------------
1917 
1918  ! note that y-index is added by -1
1919 
1920 
1921 
1922  !$omp parallel do default(none) private(i,j,k) OMP_SCHEDULE_ collapse(2) &
1923  !$omp private(vel) &
1924  !$omp shared(JJS,JJE,IIS,IIE,KS,KE,mom,val,DENS,flux,GSQRT,MAPF,num_diff)
1925  do j = jjs, jje+1
1926  do i = iis, iie
1927  do k = ks, ke
1928 #ifdef DEBUG
1929  call check( __line__, mom(k,i ,j) )
1930  call check( __line__, mom(k,i,j-1) )
1931 
1932  call check( __line__, val(k,i,j-1) )
1933  call check( __line__, val(k,i,j) )
1934 
1935  call check( __line__, val(k,i,j-2) )
1936  call check( __line__, val(k,i,j+1) )
1937 
1938 #endif
1939  vel = ( 0.5_rp * ( mom(k,i,j)+mom(k,i,j-1) ) ) &
1940  / ( dens(k,i,j) )
1941  flux(k,i,j-1) = gsqrt(k,i,j) / mapf(i,j,+1) * vel &
1942  * ( ( val(k,i,j-1) &
1943  + 0.5_rp * phi(val(k,i,j),val(k,i,j-1),val(k,i,j-2)) * ( val(k,i,j-1)-val(k,i,j-2) ) ) &
1944  * ( 0.5_rp + sign(0.5_rp,vel) ) &
1945  + ( val(k,i,j) &
1946  + 0.5_rp * phi(val(k,i,j-1),val(k,i,j),val(k,i,j+1)) * ( val(k,i,j)-val(k,i,j+1) ) ) &
1947  * ( 0.5_rp - sign(0.5_rp,vel) ) ) &
1948  + gsqrt(k,i,j) * num_diff(k,i,j)
1949  enddo
1950  enddo
1951  enddo
1952 #ifdef DEBUG
1953  k = iundef; i = iundef; j = iundef
1954 #endif
1955 
1956 
1957 
1958  return

References scale_debug::check(), scale_const::const_eps, scale_tracer::k, scale_atmos_grid_cartesc_index::ke, and scale_atmos_grid_cartesc_index::ks.

Referenced by scale_atmos_dyn_fvm_flux::atmos_dyn_fvm_flux_setup().

Here is the call graph for this function:
Here is the caller graph for this function:
scale_const::const_eps
real(rp), public const_eps
small number
Definition: scale_const.F90:33
scale_atmos_grid_cartesc_index::i_xyz
integer, public i_xyz
Definition: scale_atmos_grid_cartesC_index.F90:90
scale_const
module CONSTANT
Definition: scale_const.F90:11