SCALE-RM
Functions/Subroutines
scale_atmos_phy_tb_common Module Reference

module ATMOSPHERE / Physics Turbulence More...

Functions/Subroutines

subroutine, public atmos_phy_tb_calc_strain_tensor (S33_C, S11_C, S22_C, S31_C, S12_C, S23_C, S12_Z, S23_X, S31_Y, S2, DENS, MOMZ, MOMX, MOMY, GSQRT, J13G, J23G, J33G, MAPF)
 
subroutine, public atmos_phy_tb_calc_flux_phi (qflx_phi, DENS, PHI, Kh, FACT, GSQRT, J13G, J23G, J33G, MAPF, horizontal, implicit, a, b, c, dt, IIS, IIE, JJS, JJE)
 
subroutine, public atmos_phy_tb_calc_tend_momz (MOMZ_t_TB, QFLX_MOMZ, GSQRT, J13G, J23G, J33G, MAPF, IIS, IIE, JJS, JJE)
 
subroutine, public atmos_phy_tb_calc_tend_momx (MOMX_t_TB, QFLX_MOMX, GSQRT, J13G, J23G, J33G, MAPF, IIS, IIE, JJS, JJE)
 
subroutine, public atmos_phy_tb_calc_tend_momy (MOMY_t_TB, QFLX_MOMY, GSQRT, J13G, J23G, J33G, MAPF, IIS, IIE, JJS, JJE)
 
subroutine, public atmos_phy_tb_calc_tend_phi (phi_t_TB, QFLX_phi, GSQRT, J13G, J23G, J33G, MAPF, IIS, IIE, JJS, JJE)
 

Detailed Description

module ATMOSPHERE / Physics Turbulence

Description
Common routines for turbulence
Author
Team SCALE

Function/Subroutine Documentation

◆ atmos_phy_tb_calc_strain_tensor()

subroutine, public scale_atmos_phy_tb_common::atmos_phy_tb_calc_strain_tensor ( real(rp), dimension (ka,ia,ja), intent(out)  S33_C,
real(rp), dimension (ka,ia,ja), intent(out)  S11_C,
real(rp), dimension (ka,ia,ja), intent(out)  S22_C,
real(rp), dimension (ka,ia,ja), intent(out)  S31_C,
real(rp), dimension (ka,ia,ja), intent(out)  S12_C,
real(rp), dimension (ka,ia,ja), intent(out)  S23_C,
real(rp), dimension (ka,ia,ja), intent(out)  S12_Z,
real(rp), dimension (ka,ia,ja), intent(out)  S23_X,
real(rp), dimension (ka,ia,ja), intent(out)  S31_Y,
real(rp), dimension (ka,ia,ja), intent(out)  S2,
real(rp), dimension (ka,ia,ja), intent(in)  DENS,
real(rp), dimension (ka,ia,ja), intent(in)  MOMZ,
real(rp), dimension (ka,ia,ja), intent(in)  MOMX,
real(rp), dimension (ka,ia,ja), intent(in)  MOMY,
real(rp), dimension (ka,ia,ja,7), intent(in)  GSQRT,
real(rp), dimension (ka,ia,ja,7), intent(in)  J13G,
real(rp), dimension (ka,ia,ja,7), intent(in)  J23G,
real(rp), intent(in)  J33G,
real(rp), dimension (ia,ja,2,4), intent(in)  MAPF 
)
Parameters
[in]gsqrtvertical metrics {G}^1/2
[in]j13g(1,3) element of Jacobian matrix
[in]j23g(1,3) element of Jacobian matrix
[in]j33g(3,3) element of Jacobian matrix
[in]mapfmap factor

Definition at line 66 of file scale_atmos_phy_tb_common.F90.

66  use scale_atmos_grid_cartesc, only: &
67  fdz => atmos_grid_cartesc_fdz, &
68  fdx => atmos_grid_cartesc_fdx, &
69  fdy => atmos_grid_cartesc_fdy, &
70  rcdz => atmos_grid_cartesc_rcdz, &
71  rcdx => atmos_grid_cartesc_rcdx, &
72  rcdy => atmos_grid_cartesc_rcdy, &
73  rfdz => atmos_grid_cartesc_rfdz, &
74  rfdx => atmos_grid_cartesc_rfdx, &
75  rfdy => atmos_grid_cartesc_rfdy
76  implicit none
77 
78  real(RP), intent(out) :: S33_C (KA,IA,JA) ! (cell center)
79  real(RP), intent(out) :: S11_C (KA,IA,JA)
80  real(RP), intent(out) :: S22_C (KA,IA,JA)
81  real(RP), intent(out) :: S31_C (KA,IA,JA)
82  real(RP), intent(out) :: S12_C (KA,IA,JA)
83  real(RP), intent(out) :: S23_C (KA,IA,JA)
84  real(RP), intent(out) :: S12_Z (KA,IA,JA) ! (z edge or x-y plane)
85  real(RP), intent(out) :: S23_X (KA,IA,JA) ! (x edge or y-z plane)
86  real(RP), intent(out) :: S31_Y (KA,IA,JA) ! (y edge or z-x plane)
87  real(RP), intent(out) :: S2 (KA,IA,JA) ! |S|^2
88 
89  real(RP), intent(in) :: DENS (KA,IA,JA)
90  real(RP), intent(in) :: MOMZ (KA,IA,JA)
91  real(RP), intent(in) :: MOMX (KA,IA,JA)
92  real(RP), intent(in) :: MOMY (KA,IA,JA)
93 
94  real(RP), intent(in) :: GSQRT (KA,IA,JA,7)
95  real(RP), intent(in) :: J13G (KA,IA,JA,7)
96  real(RP), intent(in) :: J23G (KA,IA,JA,7)
97  real(RP), intent(in) :: J33G
98  real(RP), intent(in) :: MAPF (IA,JA,2,4)
99 
100  ! velocity
101  real(RP) :: VELZ_C (KA,IA,JA)
102  real(RP) :: VELZ_XY(KA,IA,JA)
103  real(RP) :: VELX_C (KA,IA,JA)
104  real(RP) :: VELX_YZ(KA,IA,JA)
105  real(RP) :: VELY_C (KA,IA,JA)
106  real(RP) :: VELY_ZX(KA,IA,JA)
107 
108  ! work space
109  real(RP) :: WORK_V(KA,IA,JA) ! work space (vertex)
110  real(RP) :: WORK_Z(KA,IA,JA) ! (z edge or x-y plane)
111  real(RP) :: WORK_X(KA,IA,JA) ! (x edge or y-z plane)
112  real(RP) :: WORK_Y(KA,IA,JA) ! (y edge or z-x plane)
113 
114  integer :: IIS, IIE, JJS, JJE
115  integer :: k, i, j
116 
117  !$acc data copyout(S33_C, S11_C, S22_C, S31_C, S12_C, S23_C, S12_Z, S23_X, S31_y, S2) &
118  !$acc copyin(DENS, MOMZ, MOMX, MOMY, GSQRT, J13G, J23G, MAPF, &
119  !$acc FDZ, FDX, FDY, RCDZ, RCDX, RCDY, RFDZ, RFDX, RFDY) &
120  !$acc create(VELZ_C, VELZ_XY, VELX_C, VELX_YZ, VELY_C, VELY_ZX, &
121  !$acc WORK_V, WORK_Z, WORK_X, WORK_Y)
122 
123 #ifdef DEBUG
124  !$acc kernels
125  s33_c(:,:,:) = undef
126  s11_c(:,:,:) = undef
127  s22_c(:,:,:) = undef
128  s31_c(:,:,:) = undef
129  s12_c(:,:,:) = undef
130  s23_c(:,:,:) = undef
131  s12_z(:,:,:) = undef
132  s23_x(:,:,:) = undef
133  s31_y(:,:,:) = undef
134  s2(:,:,:) = undef
135 
136  velz_c(:,:,:) = undef
137  velz_xy(:,:,:) = undef
138  velx_c(:,:,:) = undef
139  velx_yz(:,:,:) = undef
140  vely_c(:,:,:) = undef
141  vely_zx(:,:,:) = undef
142 
143  work_v(:,:,:) = undef
144  work_z(:,:,:) = undef
145  work_x(:,:,:) = undef
146  work_y(:,:,:) = undef
147  !$end kernels
148 #endif
149 
150  ! momentum -> velocity
151  !$omp parallel do
152  !$acc kernels
153  do j = js-1, je+1
154  do i = is-1, ie+1
155  do k = ks, ke-1
156 #ifdef DEBUG
157  call check( __line__, momz(k,i,j) )
158  call check( __line__, dens(k+1,i,j) )
159  call check( __line__, dens(k,i,j) )
160 #endif
161  velz_xy(k,i,j) = 2.0_rp * momz(k,i,j) / ( dens(k+1,i,j)+dens(k,i,j) )
162  enddo
163  enddo
164  enddo
165  !$acc end kernels
166 #ifdef DEBUG
167  i = iundef; j = iundef; k = iundef
168 #endif
169  !$omp parallel do
170  !$acc kernels
171  do j = js-1, je+1
172  do i = is-1, ie+1
173  velz_xy(ke,i,j) = 0.0_rp
174  enddo
175  enddo
176  !$acc end kernels
177 #ifdef DEBUG
178  i = iundef; j = iundef; k = iundef
179 #endif
180  !$omp parallel do
181  !$acc kernels
182  do j = js-2, je+2
183  do i = is-2, ie+2
184  do k = ks+1, ke
185 #ifdef DEBUG
186  call check( __line__, momz(k,i,j) )
187  call check( __line__, momz(k-1,i,j) )
188  call check( __line__, dens(k,i,j) )
189 #endif
190  velz_c(k,i,j) = 0.5_rp * ( momz(k,i,j) + momz(k-1,i,j) ) / dens(k,i,j)
191  enddo
192  enddo
193  enddo
194  !$acc end kernels
195 #ifdef DEBUG
196  i = iundef; j = iundef; k = iundef
197 #endif
198  !$omp parallel do
199  !$acc kernels
200  do j = js-2, je+2
201  do i = is-2, ie+2
202 #ifdef DEBUG
203  call check( __line__, momz(ks,i,j) )
204  call check( __line__, dens(ks,i,j) )
205 #endif
206  velz_c(ks,i,j) = 0.5_rp * momz(ks,i,j) / dens(ks,i,j) ! MOMZ(KS-1,i,j) = 0
207  enddo
208  enddo
209  !$acc end kernels
210 #ifdef DEBUG
211  i = iundef; j = iundef; k = iundef
212 #endif
213 
214  !$omp parallel do
215  !$acc kernels
216  do j = js-1, je+1
217  do i = is-2, ie+1
218  do k = ks, ke
219 #ifdef DEBUG
220  call check( __line__, momx(k,i,j) )
221  call check( __line__, dens(k,i+1,j) )
222  call check( __line__, dens(k,i,j) )
223 #endif
224  velx_yz(k,i,j) = 2.0_rp * momx(k,i,j) / ( dens(k,i+1,j)+dens(k,i,j) )
225  enddo
226  enddo
227  enddo
228  !$acc end kernels
229 #ifdef DEBUG
230  i = iundef; j = iundef; k = iundef
231 #endif
232  !$omp parallel do
233  !$acc kernels
234  do j = js-1, je+1
235  do i = is-2, ie+1
236  velx_yz(ke+1,i,j) = 0.0_rp
237  enddo
238  enddo
239  !$acc end kernels
240 #ifdef DEBUG
241  i = iundef; j = iundef; k = iundef
242 #endif
243  !$omp parallel do
244  !$acc kernels
245  do j = js-2, je+2
246  do i = is-1, ie+2
247  do k = ks, ke
248 #ifdef DEBUG
249  call check( __line__, momx(k,i,j) )
250  call check( __line__, momx(k,i-1,j) )
251  call check( __line__, dens(k,i,j) )
252 #endif
253  velx_c(k,i,j) = 0.5_rp * ( momx(k,i,j) + momx(k,i-1,j) ) / dens(k,i,j)
254  enddo
255  enddo
256  enddo
257  !$acc end kernels
258 #ifdef DEBUG
259  i = iundef; j = iundef; k = iundef
260 #endif
261  !$omp parallel do default(none) &
262  !$omp shared(JS,JE,IS,IE,KS,KE,MOMY,DENS,VELY_ZX) &
263  !$omp private(i,j,k) OMP_SCHEDULE_ collapse(2)
264  !$acc kernels
265  do j = js-2, je+1
266  do i = is-1, ie+1
267  do k = ks, ke
268 #ifdef DEBUG
269  call check( __line__, momy(k,i,j) )
270  call check( __line__, dens(k,i,j+1) )
271  call check( __line__, dens(k,i,j) )
272 #endif
273  vely_zx(k,i,j) = 2.0_rp * momy(k,i,j) / ( dens(k,i,j+1)+dens(k,i,j) )
274  enddo
275  enddo
276  enddo
277  !$acc end kernels
278 #ifdef DEBUG
279  i = iundef; j = iundef; k = iundef
280 #endif
281  !$omp parallel do
282  !$acc kernels
283  do j = js-2, je+1
284  do i = is-1, ie+1
285  vely_zx(ke+1,i,j) = 0.0_rp
286  enddo
287  enddo
288  !$acc end kernels
289 #ifdef DEBUG
290  i = iundef; j = iundef; k = iundef
291 #endif
292  !$omp parallel do
293  !$acc kernels
294  do j = js-1, je+2
295  do i = is-2, ie+2
296  do k = ks, ke
297 #ifdef DEBUG
298  call check( __line__, momy(k,i,j) )
299  call check( __line__, momy(k,i,j-1) )
300  call check( __line__, dens(k,i,j) )
301 #endif
302  vely_c(k,i,j) = 0.5_rp * ( momy(k,i,j) + momy(k,i,j-1) ) / dens(k,i,j)
303  enddo
304  enddo
305  enddo
306  !$acc end kernels
307 #ifdef DEBUG
308  i = iundef; j = iundef; k = iundef
309 #endif
310 
311  do jjs = js, je, jblock
312  jje = jjs+jblock-1
313  do iis = is, ie, iblock
314  iie = iis+iblock-1
315 
316 #ifdef DEBUG
317  work_z(:,:,:) = undef; work_x(:,:,:) = undef; work_y(:,:,:) = undef; work_v(:,:,:) = undef
318 #endif
319  ! w
320  ! (x-y plane; x,y,w)
321  ! WORK_Z = VELZ_XY
322  ! (y-z plane; u,y,z)
323  !$omp parallel do
324  !$acc kernels
325  do j = jjs-1, jje+1
326  do i = iis-1, iie+1
327  do k = ks, ke
328 #ifdef DEBUG
329  call check( __line__, velz_c(k,i+1,j) )
330  call check( __line__, velz_c(k,i,j) )
331 #endif
332  work_x(k,i,j) = 0.5_rp * ( velz_c(k,i+1,j) + velz_c(k,i,j) )
333  enddo
334  enddo
335  enddo
336  !$acc end kernels
337 #ifdef DEBUG
338  i = iundef; j = iundef; k = iundef
339 #endif
340  !$omp parallel do
341  !$acc kernels
342  do j = jjs-1, jje+1
343  do i = iis-1, iie+1
344  work_x(ke+1,i,j) = 0.0_rp
345  enddo
346  enddo
347  !$acc end kernels
348 #ifdef DEBUG
349  i = iundef; j = iundef; k = iundef
350 #endif
351  ! (z-x plane; x,v,z)
352  !$omp parallel do
353  !$acc kernels
354  do j = jjs-1, jje+1
355  do i = iis-1, iie+1
356  do k = ks, ke
357 #ifdef DEBUG
358  call check( __line__, velz_c(k,i,j+1) )
359  call check( __line__, velz_c(k,i,j) )
360 #endif
361  work_y(k,i,j) = 0.5_rp * ( velz_c(k,i,j+1) + velz_c(k,i,j) )
362  enddo
363  enddo
364  enddo
365  !$acc end kernels
366 #ifdef DEBUG
367  i = iundef; j = iundef; k = iundef
368 #endif
369  !$omp parallel do
370  !$acc kernels
371  do j = jjs-1, jje+1
372  do i = iis-1, iie+1
373  work_y(ke+1,i,j) = 0.0_rp
374  enddo
375  enddo
376  !$acc end kernels
377 #ifdef DEBUG
378  i = iundef; j = iundef; k = iundef
379 #endif
380 
381  ! dw/dz
382  ! (cell center; x,y,z)
383  !$omp parallel do
384  !$acc kernels
385  do j = jjs-1, jje+1
386  do i = iis-1, iie+1
387  do k = ks+1, ke
388 #ifdef DEBUG
389  call check( __line__, velz_xy(k,i,j) )
390  call check( __line__, velz_xy(k-1,i,j) )
391  call check( __line__, rcdz(k) )
392 #endif
393  s33_c(k,i,j) = ( velz_xy(k,i,j) - velz_xy(k-1,i,j) ) * rcdz(k) &
394  * j33g / gsqrt(k,i,j,i_xyz)
395  enddo
396  enddo
397  enddo
398  !$acc end kernels
399 #ifdef DEBUG
400  i = iundef; j = iundef; k = iundef
401 #endif
402  !$omp parallel do
403  !$acc kernels
404  do j = jjs-1, jje+1
405  do i = iis-1, iie+1
406 #ifdef DEBUG
407  call check( __line__, velz_xy(ks,i,j) )
408  call check( __line__, gsqrt(ks,i,j,i_xyz) )
409  call check( __line__, rcdz(ks) )
410 #endif
411  s33_c(ks,i,j) = velz_xy(ks,i,j) * rcdz(ks) & ! VELZ_XY(KS-1,i,j) == 0
412  * j33g / gsqrt(ks,i,j,i_xyz)
413  enddo
414  enddo
415  !$acc end kernels
416 #ifdef DEBUG
417  i = iundef; j = iundef; k = iundef
418 #endif
419 
420  ! 1/2 * dw/dx
421  ! (cell center; x,y,z)
422  !$omp parallel do
423  !$acc kernels
424 !OCL LOOP_NOINTERCHANGE
425  do j = jjs-1, jje+1
426  do i = iis-1, iie+1
427  do k = ks+1, ke-1
428 #ifdef DEBUG
429  call check( __line__, velz_c(k,i+1,j) )
430  call check( __line__, velz_c(k,i-1,j) )
431  call check( __line__, gsqrt(k,i+1,j,i_xyz) )
432  call check( __line__, gsqrt(k,i-1,j,i_xyz) )
433  call check( __line__, velz_xy(k,i,j) )
434  call check( __line__, velz_xy(k-1,i,j) )
435  call check( __line__, j13g(k,i,j,i_xyw) )
436  call check( __line__, j13g(k-1,i,j,i_xyw) )
437  call check( __line__, fdx(i) )
438  call check( __line__, fdx(i-1) )
439 #endif
440  s31_c(k,i,j) = 0.5_rp * ( &
441  ( gsqrt(k,i+1,j,i_xyz)*velz_c(k,i+1,j) - gsqrt(k,i-1,j,i_xyz)*velz_c(k,i-1,j) ) / ( fdx(i) + fdx(i-1) ) &
442  + ( j13g(k,i,j,i_xyw)*velz_xy(k,i,j) - j13g(k-1,i,j,i_xyw)*velz_xy(k-1,i,j) ) * rcdz(k) &
443  ) * mapf(i,j,1,i_xy)
444 
445  enddo
446  enddo
447  enddo
448  !$acc end kernels
449 #ifdef DEBUG
450  i = iundef; j = iundef; k = iundef
451 #endif
452  !$omp parallel do
453  !$acc kernels
454  do j = jjs-1, jje+1
455  do i = iis-1, iie+1
456 #ifdef DEBUG
457  call check( __line__, velz_c(ks,i+1,j) )
458  call check( __line__, velz_c(ks,i-1,j) )
459  call check( __line__, gsqrt(ks,i+1,j,i_xyz) )
460  call check( __line__, gsqrt(ks,i-1,j,i_xyz) )
461  call check( __line__, velz_xy(ks,i,j) )
462  call check( __line__, j13g(ks,i,j,i_xyw) )
463  call check( __line__, velz_c(ke,i+1,j) )
464  call check( __line__, velz_c(ke,i-1,j) )
465  call check( __line__, gsqrt(ke,i+1,j,i_xyz) )
466  call check( __line__, gsqrt(ke,i-1,j,i_xyz) )
467  call check( __line__, velz_xy(ke,i,j) )
468  call check( __line__, j13g(ke,i,j,i_xyw) )
469  call check( __line__, fdx(i) )
470  call check( __line__, fdx(i-1) )
471 #endif
472  s31_c(ks,i,j) = 0.5_rp * ( &
473  ( gsqrt(ks,i+1,j,i_xyz)*velz_c(ks,i+1,j) - gsqrt(ks,i-1,j,i_xyz)*velz_c(ks,i-1,j) ) / ( fdx(i) + fdx(i-1) ) &
474  + ( j13g(ks,i,j,i_xyw)*velz_xy(ks,i,j) ) * rcdz(ks) &
475  ) * mapf(i,j,1,i_xy)
476  s31_c(ke,i,j) = 0.5_rp * ( &
477  ( gsqrt(ke,i+1,j,i_xyz)*velz_c(ke,i+1,j) - gsqrt(ke,i-1,j,i_xyz)*velz_c(ke,i-1,j) ) / ( fdx(i) + fdx(i-1) ) &
478  - ( j13g(ke-1,i,j,i_xyw)*velz_xy(ke-1,i,j) ) * rcdz(ke) &
479  ) * mapf(i,j,1,i_xy)
480  enddo
481  enddo
482  !$acc end kernels
483 #ifdef DEBUG
484  i = iundef; j = iundef; k = iundef
485 #endif
486 
487  ! (y edge, u,y,w)
488  !$omp parallel do
489  !$acc kernels
490  do j = jjs , jje
491  do i = iis-1, iie
492  do k = ks, ke-1
493 #ifdef DEBUG
494  call check( __line__, velz_xy(k,i+1,j) )
495  call check( __line__, velz_xy(k,i,j) )
496  call check( __line__, rfdx(i) )
497 #endif
498  s31_y(k,i,j) = 0.5_rp * ( &
499  ( gsqrt(k,i+1,j,i_xyw)*velz_xy(k,i+1,j) - gsqrt(k,i,j,i_xyw)*velz_xy(k,i,j) ) * rfdx(i) &
500  + ( j13g(k+1,i,j,i_uyz)*work_x(k+1,i,j) - j13g(k,i,j,i_uyz)*work_x(k,i,j)) * rfdz(k) &
501  ) * mapf(i,j,1,i_uy)
502  enddo
503  enddo
504  enddo
505  !$acc end kernels
506 #ifdef DEBUG
507  i = iundef; j = iundef; k = iundef
508 #endif
509 
510  ! 1/2 * dw/dy
511  ! (cell center; x,y,z)
512  !$omp parallel do
513  !$acc kernels
514  do j = jjs-1, jje+1
515  do i = iis-1, iie+1
516  do k = ks+1, ke-1
517 #ifdef DEBUG
518  call check( __line__, velz_c(k,i,j+1) )
519  call check( __line__, velz_c(k,i,j-1) )
520  call check( __line__, gsqrt(k,i,j+1,i_xyz) )
521  call check( __line__, gsqrt(k,i,j-1,i_xyz) )
522  call check( __line__, velz_xy(k,i,j) )
523  call check( __line__, velz_xy(k-1,i,j) )
524  call check( __line__, j23g(k,i,j,i_xyw) )
525  call check( __line__, j23g(k-1,i,j,i_xyw) )
526  call check( __line__, fdy(j) )
527  call check( __line__, fdy(j-1) )
528 #endif
529  s23_c(k,i,j) = 0.5_rp * ( &
530  ( gsqrt(k,i,j+1,i_xyz)*velz_c(k,i,j+1) - gsqrt(k,i,j-1,i_xyz)*velz_c(k,i,j-1) ) / ( fdy(j) + fdy(j-1) ) &
531  + ( j23g(k,i,j,i_xyw)*velz_xy(k,i,j) - j23g(k-1,i,j,i_xyw)*velz_xy(k-1,i,j) ) * rcdz(k) &
532  ) * mapf(i,j,2,i_xy)
533  enddo
534  enddo
535  enddo
536  !$acc end kernels
537 #ifdef DEBUG
538  i = iundef; j = iundef; k = iundef
539 #endif
540  !$omp parallel do
541  !$acc kernels
542  do j = jjs-1, jje+1
543  do i = iis-1, iie+1
544 #ifdef DEBUG
545  call check( __line__, velz_c(ks,i,j+1) )
546  call check( __line__, velz_c(ks,i,j-1) )
547  call check( __line__, gsqrt(ks,i,j+1,i_xyz) )
548  call check( __line__, gsqrt(ks,i,j-1,i_xyz) )
549  call check( __line__, velz_xy(ks,i,j) )
550  call check( __line__, j23g(ks,i,j,i_xyw) )
551  call check( __line__, velz_c(ke,i,j+1) )
552  call check( __line__, velz_c(ke,i,j-1) )
553  call check( __line__, gsqrt(ke,i,j+1,i_xyz) )
554  call check( __line__, gsqrt(ke,i,j-1,i_xyz) )
555  call check( __line__, velz_xy(ke,i,j) )
556  call check( __line__, j23g(ke,i,j,i_xyw) )
557  call check( __line__, fdy(j) )
558  call check( __line__, fdy(j-1) )
559 #endif
560  s23_c(ks,i,j) = 0.5_rp * ( &
561  ( gsqrt(ks,i,j+1,i_xyz)*velz_c(ks,i,j+1) - gsqrt(ks,i,j-1,i_xyz)*velz_c(ks,i,j-1) ) / ( fdy(j) + fdy(j-1) ) &
562  + ( j23g(ks,i,j,i_xyw)*velz_xy(ks,i,j) ) * rcdz(ks) &
563  ) * mapf(i,j,2,i_xy)
564  s23_c(ke,i,j) = 0.5_rp * ( &
565  ( gsqrt(ke,i,j+1,i_xyz)*velz_c(ke,i,j+1) - gsqrt(ke,i,j-1,i_xyz)*velz_c(ke,i,j-1) ) / ( fdy(j) + fdy(j-1) ) &
566  - ( j23g(ke-1,i,j,i_xyw)*velz_xy(ke-1,i,j) ) * rcdz(ke) &
567  ) * mapf(i,j,2,i_xy)
568  enddo
569  enddo
570  !$acc end kernels
571 #ifdef DEBUG
572  i = iundef; j = iundef; k = iundef
573 #endif
574 
575  ! (x edge; x,v,w)
576  !$omp parallel do
577  !$acc kernels
578  do j = jjs-1, jje
579  do i = iis , iie
580  do k = ks, ke-1
581 #ifdef DEBUG
582  call check( __line__, velz_xy(k,i,j+1) )
583  call check( __line__, velz_xy(k,i,j) )
584  call check( __line__, rfdy(j) )
585 #endif
586  s23_x(k,i,j) = 0.5_rp * ( &
587  ( gsqrt(k,i,j+1,i_xyw)*velz_xy(k,i,j+1) - gsqrt(k,i,j,i_xyw)*velz_xy(k,i,j) ) * rfdy(j) &
588  + ( j23g(k+1,i,j,i_xvz)*work_y(k+1,i,j) - j23g(k,i,j,i_xvz)*work_y(k,i,j) ) * rfdz(k) &
589  ) * mapf(i,j,2,i_xv)
590  enddo
591  enddo
592  enddo
593  !$acc end kernels
594 #ifdef DEBUG
595  i = iundef; j = iundef; k = iundef
596 #endif
597 
598 #ifdef DEBUG
599  work_z(:,:,:) = undef; work_x(:,:,:) = undef; work_y(:,:,:) = undef; work_v(:,:,:) = undef
600 #endif
601  ! u
602  ! (x-y plane; x,y,w)
603  !$omp parallel do
604  !$acc kernels
605  do j = jjs-1, jje+1
606  do i = iis-1, iie+1
607  do k = ks, ke-1
608 #ifdef DEBUG
609  call check( __line__, velx_c(k+1,i,j) )
610  call check( __line__, velx_c(k,i,j) )
611 #endif
612  work_z(k,i,j) = 0.5_rp * ( velx_c(k+1,i,j) + velx_c(k,i,j) )
613  enddo
614  enddo
615  enddo
616  !$acc end kernels
617 #ifdef DEBUG
618  i = iundef; j = iundef; k = iundef
619 #endif
620  ! (y-z plane; u,y,z)
621  ! WORK_X = VELX_YZ
622  ! (z-x plane; x,v,z)
623  !$omp parallel do
624  !$acc kernels
625  do j = jjs-1, jje
626  do i = iis-1, iie+1
627  do k = ks, ke
628 #ifdef DEBUG
629  call check( __line__, velx_c(k,i,j+1) )
630  call check( __line__, velx_c(k,i,j) )
631 #endif
632  work_y(k,i,j) = 0.5_rp * ( velx_c(k,i,j+1) + velx_c(k,i,j) )
633  enddo
634  enddo
635  enddo
636  !$acc end kernels
637 #ifdef DEBUG
638  i = iundef; j = iundef; k = iundef
639 #endif
640  ! (vertex; u,v,w)
641  !$omp parallel do
642  !$acc kernels
643  do j = jjs-1, jje
644  do i = iis-1, iie
645  do k = ks, ke-1
646 #ifdef DEBUG
647  call check( __line__, velx_yz(k,i,j) )
648  call check( __line__, velx_yz(k,i,j+1) )
649  call check( __line__, velx_yz(k+1,i,j) )
650  call check( __line__, velx_yz(k+1,i,j+1) )
651  call check( __line__, j23g(k ,i,j ,i_uvz) )
652  call check( __line__, j23g(k+1,i,j ,i_uvz) )
653  call check( __line__, j23g(k ,i,j+1,i_uvz) )
654  call check( __line__, j23g(k+1,i,j+1,i_uvz) )
655 #endif
656  work_v(k,i,j) = 0.25_rp &
657  * ( j23g(k ,i,j ,i_uyz)*velx_yz(k ,i,j ) &
658  + j23g(k+1,i,j ,i_uyz)*velx_yz(k+1,i,j ) &
659  + j23g(k ,i,j+1,i_uyz)*velx_yz(k ,i,j+1) &
660  + j23g(k+1,i,j+1,i_uyz)*velx_yz(k+1,i,j+1) )
661  enddo
662  enddo
663  enddo
664  !$acc end kernels
665 #ifdef DEBUG
666  i = iundef; j = iundef; k = iundef
667 #endif
668 
669  ! du/dx
670  ! (cell center; x,y,z)
671  !$omp parallel do
672  !$acc kernels
673  do j = jjs-1, jje+1
674  do i = iis-1, iie+1
675  do k = ks+1, ke-1
676 #ifdef DEBUG
677  call check( __line__, velx_yz(k,i,j) )
678  call check( __line__, velx_yz(k,i-1,j) )
679  call check( __line__, gsqrt(k,i,j,i_uyz) )
680  call check( __line__, gsqrt(k,i-1,j,i_uyz) )
681  call check( __line__, work_z(k,i,j) )
682  call check( __line__, work_z(k-1,i,j) )
683  call check( __line__, j13g(k,i,j,i_xyw) )
684  call check( __line__, j13g(k-1,i,j,i_xyw) )
685  call check( __line__, gsqrt(k,i,j,i_xyz) )
686  call check( __line__, rcdx(i) )
687 #endif
688  s11_c(k,i,j) = ( &
689  ( gsqrt(k,i,j,i_uyz)*velx_yz(k,i,j) - gsqrt(k,i-1,j,i_uyz)*velx_yz(k,i-1,j) ) * rcdx(i) &
690  + ( j13g(k,i,j,i_xyw)*work_z(k,i,j) - j13g(k-1,i,j,i_xyw)*work_z(k-1,i,j) ) * rcdz(k) &
691  ) * mapf(i,j,1,i_xy) / gsqrt(k,i,j,i_xyz)
692  enddo
693  enddo
694  enddo
695  !$acc end kernels
696 #ifdef DEBUG
697  i = iundef; j = iundef; k = iundef
698 #endif
699  !$omp parallel do
700  !$acc kernels
701  do j = jjs-1, jje+1
702  do i = iis-1, iie+1
703 #ifdef DEBUG
704  call check( __line__, velx_yz(ks,i,j) )
705  call check( __line__, velx_yz(ks,i-1,j) )
706  call check( __line__, gsqrt(ks,i,j,i_uyz) )
707  call check( __line__, gsqrt(ks,i-1,j,i_uyz) )
708  call check( __line__, velx_c(ks+1,i,j) )
709  call check( __line__, velx_c(ks,i,j) )
710  call check( __line__, j13g(ks+1,i,j,i_xyz) )
711  call check( __line__, j13g(ks,i,j,i_xyz) )
712  call check( __line__, gsqrt(ks,i,j,i_xyz) )
713  call check( __line__, velx_yz(ke,i,j) )
714  call check( __line__, velx_yz(ke,i-1,j) )
715  call check( __line__, gsqrt(ke,i,j,i_uyz) )
716  call check( __line__, gsqrt(ke,i-1,j,i_uyz) )
717  call check( __line__, velx_c(ke,i,j) )
718  call check( __line__, velx_c(ke-1,i,j) )
719  call check( __line__, j13g(ke,i,j,i_xyz) )
720  call check( __line__, j13g(ke-1,i,j,i_xyz) )
721  call check( __line__, gsqrt(ke,i,j,i_xyz) )
722  call check( __line__, rcdx(i) )
723 #endif
724  s11_c(ks,i,j) = ( &
725  ( gsqrt(ks,i,j,i_uyz)*velx_yz(ks,i,j) - gsqrt(ks,i-1,j,i_uyz)*velx_yz(ks,i-1,j) ) * rcdx(i) &
726  + ( j13g(ks+1,i,j,i_xyz)*velx_c(ks+1,i,j) - j13g(ks,i,j,i_xyz)*velx_c(ks,i,j) ) * rfdz(ks) &
727  ) * mapf(i,j,1,i_xy) / gsqrt(ks,i,j,i_xyz)
728  s11_c(ke,i,j) = ( &
729  ( gsqrt(ke,i,j,i_uyz)*velx_yz(ke,i,j) - gsqrt(ke,i-1,j,i_uyz)*velx_yz(ke,i-1,j) ) * rcdx(i) &
730  + ( j13g(ke,i,j,i_xyz)*velx_c(ke,i,j) - j13g(ke-1,i,j,i_xyz)*velx_c(ke-1,i,j) ) * rfdz(ke-1) &
731  ) * mapf(i,j,1,i_xy) / gsqrt(ke,i,j,i_xyz)
732  enddo
733  enddo
734  !$acc end kernels
735 #ifdef DEBUG
736  i = iundef; j = iundef; k = iundef
737 #endif
738 
739  ! 1/2 * du/dz
740  ! (cell center; x,y,z)
741  !$omp parallel do
742  !$acc kernels
743  do j = jjs-1, jje+1
744  do i = iis-1, iie+1
745  do k = ks+1, ke-1
746 #ifdef DEBUG
747  call check( __line__, s31_c(k,i,j) )
748  call check( __line__, velx_c(k+1,i,j) )
749  call check( __line__, velx_c(k-1,i,j) )
750  call check( __line__, fdz(k) )
751  call check( __line__, fdz(k-1) )
752 #endif
753  s31_c(k,i,j) = ( s31_c(k,i,j) & ! dw/dx
754  + 0.5_rp * ( velx_c(k+1,i,j) - velx_c(k-1,i,j) ) * j33g / ( fdz(k) + fdz(k-1) ) &
755  ) / gsqrt(k,i,j,i_xyz)
756  enddo
757  enddo
758  enddo
759  !$acc end kernels
760 #ifdef DEBUG
761  i = iundef; j = iundef; k = iundef
762 #endif
763  !$omp parallel do
764  !$acc kernels
765  do j = jjs-1, jje+1
766  do i = iis-1, iie+1
767 #ifdef DEBUG
768  call check( __line__, s31_c(ks,i,j) )
769  call check( __line__, velx_c(ks+1,i,j) )
770  call check( __line__, velx_c(ks,i,j) )
771  call check( __line__, rfdz(ks) )
772  call check( __line__, s31_c(ke,i,j) )
773  call check( __line__, velx_c(ke,i,j) )
774  call check( __line__, velx_c(ke-1,i,j) )
775  call check( __line__, rfdz(ke-1) )
776 #endif
777  s31_c(ks,i,j) = ( s31_c(ks,i,j) &
778  + 0.5_rp * ( velx_c(ks+1,i,j) - velx_c(ks,i,j) ) * j33g * rfdz(ks) &
779  ) / gsqrt(ks,i,j,i_xyz)
780  s31_c(ke,i,j) = ( s31_c(ke,i,j) &
781  + 0.5_rp * ( velx_c(ke,i,j) - velx_c(ke-1,i,j) ) * j33g * rfdz(ke-1) &
782  ) / gsqrt(ke,i,j,i_xyz)
783  enddo
784  enddo
785  !$acc end kernels
786 #ifdef DEBUG
787  i = iundef; j = iundef; k = iundef
788 #endif
789  ! (y edge; u,y,w)
790  !$omp parallel do
791  !$acc kernels
792  do j = jjs , jje
793  do i = iis-1, iie
794  do k = ks, ke-1
795 #ifdef DEBUG
796  call check( __line__, s31_y(k,i,j) )
797  call check( __line__, velx_yz(k+1,i,j) )
798  call check( __line__, velx_yz(k,i,j) )
799  call check( __line__, rfdz(k) )
800 #endif
801  s31_y(k,i,j) = ( s31_y(k,i,j) & ! dw/dx
802  + 0.5_rp * ( velx_yz(k+1,i,j) - velx_yz(k,i,j) ) * j33g * rfdz(k) &
803  ) / gsqrt(k,i,j,i_uyw)
804  enddo
805  enddo
806  enddo
807  !$acc end kernels
808 #ifdef DEBUG
809  i = iundef; j = iundef; k = iundef
810 #endif
811 
812  ! 1/2 * du/dy
813  ! (cell center; x,y,z)
814  !$omp parallel do
815  !$acc kernels
816  do j = jjs-1, jje+1
817  do i = iis-1, iie+1
818  do k = ks+1, ke-1
819 #ifdef DEBUG
820  call check( __line__, velx_c(k,i,j+1) )
821  call check( __line__, velx_c(k,i,j-1) )
822  call check( __line__, gsqrt(k,i,j+1,i_xyz) )
823  call check( __line__, gsqrt(k,i,j-1,i_xyz) )
824  call check( __line__, work_z(k,i,j) )
825  call check( __line__, work_z(k-1,i,j) )
826  call check( __line__, j23g(k,i,j,i_xyw) )
827  call check( __line__, j23g(k-1,i,j,i_xyw) )
828 #endif
829  s12_c(k,i,j) = 0.5_rp * ( &
830  ( gsqrt(k,i,j+1,i_xyz)*velx_c(k,i,j+1) - gsqrt(k,i,j-1,i_xyz)*velx_c(k,i,j-1) ) / ( fdy(j) + fdy(j-1) ) &
831  + ( j23g(k,i,j,i_xyw)*work_z(k,i,j) - j23g(k-1,i,j,i_xyw)*work_z(k-1,i,j) ) * rcdz(k) &
832  ) * mapf(i,j,2,i_xy) / gsqrt(k,i,j,i_xyz)
833  enddo
834  enddo
835  enddo
836  !$acc end kernels
837 #ifdef DEBUG
838  i = iundef; j = iundef; k = iundef
839 #endif
840  !$omp parallel do
841  !$acc kernels
842  do j = jjs-1, jje+1
843  do i = iis-1, iie+1
844 #ifdef DEBUG
845  call check( __line__, velx_c(ks,i,j+1) )
846  call check( __line__, velx_c(ks,i,j-1) )
847  call check( __line__, gsqrt(ks,i,j+1,i_xyz) )
848  call check( __line__, gsqrt(ks,i,j-1,i_xyz) )
849  call check( __line__, velx_c(ks+1,i,j) )
850  call check( __line__, velx_c(ks,i,j) )
851  call check( __line__, j23g(ks+1,i,j,i_xyz) )
852  call check( __line__, j23g(ks,i,j,i_xyz) )
853  call check( __line__, gsqrt(ks,i,j,i_xyz) )
854  call check( __line__, velx_c(ke,i,j+1) )
855  call check( __line__, velx_c(ke,i,j-1) )
856  call check( __line__, gsqrt(ke,i,j+1,i_xyz) )
857  call check( __line__, gsqrt(ke,i,j-1,i_xyz) )
858  call check( __line__, velx_c(ke,i,j) )
859  call check( __line__, velx_c(ke-1,i,j) )
860  call check( __line__, j23g(ke,i,j,i_xyz) )
861  call check( __line__, j23g(ke-1,i,j,i_xyz) )
862  call check( __line__, gsqrt(ke,i,j,i_xyz) )
863  call check( __line__, fdy(j) )
864  call check( __line__, fdy(j-1) )
865 #endif
866  s12_c(ks,i,j) = 0.5_rp * ( &
867  ( gsqrt(ks,i,j+1,i_xyz)*velx_c(ks,i,j+1) - gsqrt(ks,i,j-1,i_xyz)*velx_c(ks,i,j-1) ) / ( fdy(j) + fdy(j-1) ) &
868  + ( j23g(ks+1,i,j,i_xyz)*velx_c(ks+1,i,j) - j23g(ks,i,j,i_xyz)*velx_c(ks,i,j) ) * rfdz(ks) &
869  ) * mapf(i,j,2,i_xy) / gsqrt(ks,i,j,i_xyz)
870  s12_c(ke,i,j) = 0.5_rp * ( &
871  ( gsqrt(ke,i,j+1,i_xyz)*velx_c(ke,i,j+1) - gsqrt(ke,i,j-1,i_xyz)*velx_c(ke,i,j-1) ) / ( fdy(j) + fdy(j-1) ) &
872  + ( j23g(ke,i,j,i_xyz)*velx_c(ke,i,j) - j23g(ke-1,i,j,i_xyz)*velx_c(ke-1,i,j) ) * rfdz(ke-1) &
873  ) * mapf(i,j,2,i_xy) / gsqrt(ke,i,j,i_xyz)
874  enddo
875  enddo
876  !$acc end kernels
877 #ifdef DEBUG
878  i = iundef; j = iundef; k = iundef
879 #endif
880 
881  ! (z edge; u,v,z)
882  !$omp parallel do
883  !$acc kernels
884  do j = jjs-1, jje
885  do i = iis-1, iie
886  do k = ks+1, ke-1
887 #ifdef DEBUG
888  call check( __line__, velx_yz(k,i,j+1) )
889  call check( __line__, velx_yz(k,i,j) )
890  call check( __line__, work_v(k,i,j) )
891  call check( __line__, work_v(k-1,i,j) )
892  call check( __line__, rfdy(j) )
893 #endif
894  s12_z(k,i,j) = 0.5_rp * ( &
895  ( gsqrt(k,i,j+1,i_uyz)*velx_yz(k,i,j+1) - gsqrt(k,i,j,i_uyz)*velx_yz(k,i,j) ) * rfdy(j) &
896  + ( work_v(k,i,j) - work_v(k-1,i,j) ) * rcdz(k) &
897  ) * mapf(i,j,2,i_uv)
898  enddo
899  enddo
900  enddo
901  !$acc end kernels
902 #ifdef DEBUG
903  i = iundef; j = iundef; k = iundef
904 #endif
905  !$omp parallel do
906  !$acc kernels
907  do j = jjs-1, jje
908  do i = iis-1, iie
909 #ifdef DEBUG
910  call check( __line__, velx_yz(ks,i,j+1) )
911  call check( __line__, velx_yz(ks,i,j) )
912  call check( __line__, velx_yz(ks+1,i,j) )
913  call check( __line__, velx_yz(ks+1,i,j+1) )
914  call check( __line__, j23g(ks+1,i,j,i_uvz) )
915  call check( __line__, j23g(ks ,i,j,i_uvz) )
916  call check( __line__, velx_yz(ke,i,j+1) )
917  call check( __line__, velx_yz(ke,i,j) )
918  call check( __line__, velx_yz(ke-1,i,j) )
919  call check( __line__, velx_yz(ke-1,i,j+1) )
920  call check( __line__, j23g(ke ,i,j,i_uvz) )
921  call check( __line__, j23g(ke-1,i,j,i_uvz) )
922 #endif
923  s12_z(ks,i,j) = 0.25_rp * ( &
924  ( gsqrt(ks,i,j+1,i_uyz)*velx_yz(ks,i,j+1) - gsqrt(ks,i,j,i_uyz)*velx_yz(ks,i,j) ) * rfdy(j) &
925  + ( j23g(ks+1,i,j,i_uvz) * ( velx_yz(ks+1,i,j) + velx_yz(ks+1,i,j+1) ) &
926  - j23g(ks ,i,j,i_uvz) * ( velx_yz(ks ,i,j) + velx_yz(ks ,i,j+1) ) ) * rfdz(ks) &
927  ) * mapf(i,j,2,i_uv)
928  s12_z(ke,i,j) = 0.25_rp * ( &
929  ( gsqrt(ke,i,j+1,i_uyz)*velx_yz(ke,i,j+1) - gsqrt(ke,i,j,i_uyz)*velx_yz(ke,i,j) ) * rfdy(j) &
930  + ( j23g(ke ,i,j,i_uvz) * ( velx_yz(ke ,i,j) + velx_yz(ke ,i,j+1) ) &
931  - j23g(ke-1,i,j,i_uvz) * ( velx_yz(ke-1,i,j) + velx_yz(ke-1,i,j+1) ) ) * rfdz(ke-1) &
932  ) * mapf(i,j,2,i_uv)
933  enddo
934  enddo
935  !$acc end kernels
936 #ifdef DEBUG
937  i = iundef; j = iundef; k = iundef
938 #endif
939 
940 #ifdef DEBUG
941  work_z(:,:,:) = undef; work_x(:,:,:) = undef; work_y(:,:,:) = undef; work_v(:,:,:) = undef
942 #endif
943  ! v
944  ! (x-y plane; x,y,w)
945  !$omp parallel do
946  !$acc kernels
947  do j = jjs-1, jje+1
948  do i = iis-1, iie+1
949  do k = ks, ke-1
950 #ifdef DEBUG
951  call check( __line__, vely_c(k+1,i,j) )
952  call check( __line__, vely_c(k,i,j) )
953 #endif
954  work_z(k,i,j) = 0.5_rp * ( vely_c(k+1,i,j) + vely_c(k,i,j) )
955  enddo
956  enddo
957  enddo
958  !$acc end kernels
959 #ifdef DEBUG
960  i = iundef; j = iundef; k = iundef
961 #endif
962  ! (y-z plane; u,y,z)
963  !$omp parallel do
964  !$acc kernels
965  do j = jjs-1, jje+1
966  do i = iis-1, iie
967  do k = ks, ke
968 #ifdef DEBUG
969  call check( __line__, vely_c(k,i+1,j) )
970  call check( __line__, vely_c(k,i,j) )
971 #endif
972  work_x(k,i,j) = 0.5_rp * ( velz_c(k,i+1,j) + velz_c(k,i,j) )
973  enddo
974  enddo
975  enddo
976  !$acc end kernels
977 #ifdef DEBUG
978  i = iundef; j = iundef; k = iundef
979 #endif
980  ! (z-x plane; x,v,z)
981  ! WORK_Y = VELY_ZX
982  ! (vertex; u,v,w)
983  !$omp parallel do
984  !$acc kernels
985  do j = jjs-1, jje
986  do i = iis-1, iie
987  do k = ks, ke-1
988 #ifdef DEBUG
989  call check( __line__, vely_zx(k,i,j) )
990  call check( __line__, vely_zx(k+1,i,j) )
991  call check( __line__, vely_zx(k,i+1,j) )
992  call check( __line__, vely_zx(k+1,i+1,j) )
993 #endif
994  work_v(k,i,j) = 0.25_rp &
995  * ( j13g(k ,i ,j,i_xvz)*vely_zx(k ,i ,j) &
996  + j13g(k+1,i ,j,i_xvz)*vely_zx(k+1,i ,j) &
997  + j13g(k ,i+1,j,i_xvz)*vely_zx(k ,i+1,j) &
998  + j13g(k+1,i+1,j,i_xvz)*vely_zx(k+1,i+1,j) )
999  enddo
1000  enddo
1001  enddo
1002  !$acc end kernels
1003 #ifdef DEBUG
1004  i = iundef; j = iundef; k = iundef
1005 #endif
1006 
1007  ! dv/dy
1008  ! (cell center; x,y,z)
1009  !$omp parallel do
1010  !$acc kernels
1011  do j = jjs-1, jje+1
1012  do i = iis-1, iie+1
1013  do k = ks+1, ke-1
1014 #ifdef DEBUG
1015  call check( __line__, vely_zx(k,i,j) )
1016  call check( __line__, vely_zx(k,i,j-1) )
1017  call check( __line__, gsqrt(k,i,j,i_xvz) )
1018  call check( __line__, gsqrt(k,i,j-1,i_xvz) )
1019  call check( __line__, work_z(k,i,j) )
1020  call check( __line__, work_z(k-1,i,j) )
1021  call check( __line__, j23g(k,i,j,i_xyw) )
1022  call check( __line__, j23g(k-1,i,j,i_xyw) )
1023  call check( __line__, rcdy(j) )
1024 #endif
1025  s22_c(k,i,j) = ( &
1026  ( gsqrt(k,i,j,i_xvz)*vely_zx(k,i,j) - gsqrt(k,i,j-1,i_xvz)*vely_zx(k,i,j-1) ) * rcdy(j) &
1027  + ( j23g(k,i,j,i_xyw)*work_z(k,i,j) - j23g(k-1,i,j,i_xyw)*work_z(k-1,i,j) ) * rcdz(k) &
1028  ) * mapf(i,j,2,i_xy) / gsqrt(k,i,j,i_xyz)
1029  enddo
1030  enddo
1031  enddo
1032  !$acc end kernels
1033 #ifdef DEBUG
1034  i = iundef; j = iundef; k = iundef
1035 #endif
1036  !$omp parallel do
1037  !$acc kernels
1038  do j = jjs-1, jje+1
1039  do i = iis-1, iie+1
1040 #ifdef DEBUG
1041  call check( __line__, vely_zx(ks,i,j) )
1042  call check( __line__, vely_zx(ks,i,j-1) )
1043  call check( __line__, gsqrt(ks,i,j,i_xvz) )
1044  call check( __line__, gsqrt(ks,i,j-1,i_xvz) )
1045  call check( __line__, vely_c(ks+1,i,j) )
1046  call check( __line__, vely_c(ks,i,j) )
1047  call check( __line__, j23g(ks+1,i,j,i_xyz) )
1048  call check( __line__, j23g(ks,i,j,i_xyz) )
1049  call check( __line__, rcdy(j) )
1050  call check( __line__, vely_zx(ke,i,j) )
1051  call check( __line__, vely_zx(ke,i,j-1) )
1052  call check( __line__, gsqrt(ke,i,j,i_xvz) )
1053  call check( __line__, gsqrt(ke,i,j-1,i_xvz) )
1054  call check( __line__, vely_c(ke,i,j) )
1055  call check( __line__, vely_c(ke-1,i,j) )
1056  call check( __line__, j23g(ke,i,j,i_xyz) )
1057  call check( __line__, j23g(ke-1,i,j,i_xyz) )
1058 #endif
1059  s22_c(ks,i,j) = ( &
1060  ( gsqrt(ks,i,j,i_xvz)*vely_zx(ks,i,j) - gsqrt(ks,i,j-1,i_xvz)*vely_zx(ks,i,j-1) ) * rcdy(j) &
1061  + ( j23g(ks+1,i,j,i_xyz)*vely_c(ks+1,i,j) - j23g(ks,i,j,i_xyz)*vely_c(ks,i,j) ) * rfdz(ks) &
1062  ) * mapf(i,j,2,i_xy) / gsqrt(ks,i,j,i_xyz)
1063  s22_c(ke,i,j) = ( &
1064  ( gsqrt(ke,i,j,i_xvz)*vely_zx(ke,i,j) - gsqrt(ke,i,j-1,i_xvz)*vely_zx(ke,i,j-1) ) * rcdy(j) &
1065  + ( j23g(ke,i,j,i_xyz)*vely_c(ke,i,j) - j23g(ke-1,i,j,i_xyz)*vely_c(ke-1,i,j) ) * rfdz(ke-1) &
1066  ) * mapf(i,j,2,i_xy) / gsqrt(ke,i,j,i_xyz)
1067  enddo
1068  enddo
1069  !$acc end kernels
1070 #ifdef DEBUG
1071  i = iundef; j = iundef; k = iundef
1072 #endif
1073 
1074  ! 1/2 * dv/dx
1075  ! (cell center; x,y,z)
1076  !$omp parallel do
1077  !$acc kernels
1078  do j = jjs-1, jje+1
1079  do i = iis-1, iie+1
1080  do k = ks+1, ke-1
1081 #ifdef DEBUG
1082  call check( __line__, s12_c(k,i,j) )
1083  call check( __line__, vely_c(k,i+1,j) )
1084  call check( __line__, vely_c(k,i-1,j) )
1085  call check( __line__, gsqrt(k,i+1,j,i_xyz) )
1086  call check( __line__, gsqrt(k,i-1,j,i_xyz) )
1087  call check( __line__, work_z(k,i,j) )
1088  call check( __line__, work_z(k-1,i,j) )
1089  call check( __line__, j13g(k,i,j,i_xyw) )
1090  call check( __line__, j13g(k-1,i,j,i_xyw) )
1091  call check( __line__, gsqrt(k,i,j,i_xyz) )
1092  call check( __line__, fdx(i) )
1093  call check( __line__, fdx(i-1) )
1094 #endif
1095  s12_c(k,i,j) = ( s12_c(k,i,j) & ! du/dy
1096  + 0.5_rp * ( &
1097  ( gsqrt(k,i+1,j,i_xyz)*vely_c(k,i+1,j) - gsqrt(k,i-1,j,i_xyz)*vely_c(k,i-1,j) ) / ( fdx(i) + fdx(i-1) ) &
1098  + ( j13g(k,i,j,i_xyw)*work_z(k,i,j) - j13g(k-1,i,j,i_xyw)*work_z(k-1,i,j) ) * rcdz(k) ) * mapf(i,j,1,i_xy) &
1099  ) / gsqrt(k,i,j,i_xyz)
1100  enddo
1101  enddo
1102  enddo
1103  !$acc end kernels
1104 #ifdef DEBUG
1105  i = iundef; j = iundef; k = iundef
1106 #endif
1107  !$omp parallel do
1108  !$acc kernels
1109  do j = jjs-1, jje+1
1110  do i = iis-1, iie+1
1111 #ifdef DEBUG
1112  call check( __line__, s12_c(ks,i,j) )
1113  call check( __line__, vely_c(ks,i+1,j) )
1114  call check( __line__, vely_c(ks,i-1,j) )
1115  call check( __line__, gsqrt(ks,i+1,j,i_xyz) )
1116  call check( __line__, gsqrt(ks,i-1,j,i_xyz) )
1117  call check( __line__, vely_c(ks+1,i,j) )
1118  call check( __line__, vely_c(ks,i,j) )
1119  call check( __line__, j13g(ks+1,i,j,i_xyz) )
1120  call check( __line__, j13g(ks,i,j,i_xyz) )
1121  call check( __line__, gsqrt(ks,i,j,i_xyz) )
1122  call check( __line__, s12_c(ke,i,j) )
1123  call check( __line__, vely_c(ke,i+1,j) )
1124  call check( __line__, vely_c(ke,i-1,j) )
1125  call check( __line__, gsqrt(ke,i+1,j,i_xyz) )
1126  call check( __line__, gsqrt(ke,i-1,j,i_xyz) )
1127  call check( __line__, vely_c(ke,i,j) )
1128  call check( __line__, vely_c(ke-1,i,j) )
1129  call check( __line__, j13g(ke,i,j,i_xyz) )
1130  call check( __line__, j13g(ke-1,i,j,i_xyz) )
1131  call check( __line__, gsqrt(ke,i,j,i_xyz) )
1132  call check( __line__, fdx(i) )
1133  call check( __line__, fdx(i-1) )
1134 #endif
1135  s12_c(ks,i,j) = ( s12_c(ks,i,j) & ! du/dy
1136  + 0.5_rp * ( &
1137  ( gsqrt(ks,i+1,j,i_xyz)*vely_c(ks,i+1,j) - gsqrt(ks,i-1,j,i_xyz)*vely_c(ks,i-1,j) ) / ( fdx(i) + fdx(i-1) ) &
1138  + ( j13g(ks+1,i,j,i_xyz)*vely_c(ks+1,i,j) - j13g(ks,i,j,i_xyz)*vely_c(ks,i,j) ) * rfdz(ks) ) &
1139  * mapf(i,j,1,i_xy) &
1140  ) / gsqrt(ks,i,j,i_xyz)
1141  s12_c(ke,i,j) = ( s12_c(ke,i,j) & ! du/dy
1142  + 0.5_rp * ( &
1143  ( gsqrt(ke,i+1,j,i_xyz)*vely_c(ke,i+1,j) - gsqrt(ke,i-1,j,i_xyz)*vely_c(ke,i-1,j) ) / ( fdx(i) + fdx(i-1) ) &
1144  + ( j13g(ke,i,j,i_xyz)*vely_c(ke,i,j) - j13g(ke-1,i,j,i_xyz)*vely_c(ke-1,i,j) ) * rfdz(ke-1) ) &
1145  * mapf(i,j,1,i_xy) &
1146  ) / gsqrt(ke,i,j,i_xyz)
1147  enddo
1148  enddo
1149  !$acc end kernels
1150 #ifdef DEBUG
1151  i = iundef; j = iundef; k = iundef
1152 #endif
1153  ! (z edge; u,v,z)
1154  !$omp parallel do
1155  !$acc kernels
1156  do j = jjs-1, jje
1157  do i = iis-1, iie
1158  do k = ks+1, ke-1
1159 #ifdef DEBUG
1160  call check( __line__, s12_z(k,i,j) )
1161  call check( __line__, vely_zx(k,i+1,j) )
1162  call check( __line__, vely_zx(k,i,j) )
1163  call check( __line__, work_v(k,i,j) )
1164  call check( __line__, work_v(k-1,i,j) )
1165  call check( __line__, rfdx(i) )
1166 #endif
1167  s12_z(k,i,j) = ( s12_z(k,i,j) &
1168  + 0.5_rp * ( &
1169  ( gsqrt(k,i+1,j,i_xvz)*vely_zx(k,i+1,j) - gsqrt(k,i,j,i_xvz)*vely_zx(k,i,j) ) * rfdx(i) &
1170  + ( work_v(k,i,j) - work_v(k-1,i,j) ) * rcdz(k) ) * mapf(i,j,1,i_uv) &
1171  ) / gsqrt(k,i,j,i_uvz)
1172  enddo
1173  enddo
1174  enddo
1175  !$acc end kernels
1176 #ifdef DEBUG
1177  i = iundef; j = iundef; k = iundef
1178 #endif
1179  !$omp parallel do
1180  !$acc kernels
1181  do j = jjs-1, jje
1182  do i = iis-1, iie
1183 #ifdef DEBUG
1184  call check( __line__, s12_z(ks,i,j) )
1185  call check( __line__, vely_zx(ks,i+1,j) )
1186  call check( __line__, vely_zx(ks,i,j) )
1187  call check( __line__, vely_zx(ks+1,i,j) )
1188  call check( __line__, vely_zx(ks+1,i+1,j) )
1189  call check( __line__, s12_z(ke,i,j) )
1190  call check( __line__, vely_zx(ke,i+1,j) )
1191  call check( __line__, vely_zx(ke,i,j) )
1192  call check( __line__, vely_zx(ke-1,i,j) )
1193  call check( __line__, vely_zx(ke-1,i+1,j) )
1194  call check( __line__, rfdx(i) )
1195 #endif
1196  s12_z(ks,i,j) = ( s12_z(ks,i,j) &
1197  + 0.5_rp * ( &
1198  ( gsqrt(ks,i+1,j,i_xvz)*vely_zx(ks,i+1,j) - gsqrt(ks,i,j,i_xvz)*vely_zx(ks,i,j) ) * rfdx(i) &
1199  + ( j13g(ks+1,i,j,i_uvz) * ( vely_zx(ks+1,i,j) + vely_zx(ks+1,i+1,j) ) &
1200  - j13g(ks ,i,j,i_uvz) * ( vely_zx(ks ,i,j) + vely_zx(ks ,i+1,j) ) ) * rfdz(ks) ) * mapf(i,j,1,i_uv) &
1201  ) / gsqrt(ks,i,j,i_uvz)
1202  s12_z(ke,i,j) = ( s12_z(ke,i,j) &
1203  + 0.5_rp * ( &
1204  ( gsqrt(ke,i+1,j,i_xvz)*vely_zx(ke,i+1,j) - gsqrt(ke,i,j,i_xvz)*vely_zx(ke,i,j) ) * rfdx(i) &
1205  + ( j13g(ke ,i,j,i_uvz) * ( vely_zx(ke ,i,j) + vely_zx(ke ,i+1,j) ) &
1206  - j13g(ke-1,i,j,i_uvz) * ( vely_zx(ke-1,i,j) + vely_zx(ke-1,i+1,j) ) ) * rfdz(ke-1) ) * mapf(i,j,1,i_uv) &
1207  ) / gsqrt(ke,i,j,i_uvz)
1208  enddo
1209  enddo
1210  !$acc end kernels
1211 #ifdef DEBUG
1212  i = iundef; j = iundef; k = iundef
1213 #endif
1214 
1215  ! 1/2 * dv/dz
1216  ! (cell center; x,y,z)
1217  !$omp parallel do
1218  !$acc kernels
1219  do j = jjs-1, jje+1
1220  do i = iis-1, iie+1
1221  do k = ks+1, ke-1
1222 #ifdef DEBUG
1223  call check( __line__, s23_c(k,i,j) )
1224  call check( __line__, vely_c(k+1,i,j) )
1225  call check( __line__, vely_c(k-1,i,j) )
1226  call check( __line__, fdz(k) )
1227  call check( __line__, fdz(k-1) )
1228 #endif
1229  s23_c(k,i,j) = ( s23_c(k,i,j) & ! dw/dy
1230  + 0.5_rp * ( vely_c(k+1,i,j) - vely_c(k-1,i,j) ) * j33g / ( fdz(k) + fdz(k-1) ) &
1231  ) / gsqrt(k,i,j,i_xyz)
1232  enddo
1233  enddo
1234  enddo
1235  !$acc end kernels
1236 #ifdef DEBUG
1237  i = iundef; j = iundef; k = iundef
1238 #endif
1239  !$omp parallel do
1240  !$acc kernels
1241  do j = jjs-1, jje+1
1242  do i = iis-1, iie+1
1243 #ifdef DEBUG
1244  call check( __line__, s23_c(ks,i,j) )
1245  call check( __line__, vely_c(ks+1,i,j) )
1246  call check( __line__, vely_c(ks,i,j) )
1247  call check( __line__, rfdz(ks) )
1248  call check( __line__, s23_c(ke,i,j) )
1249  call check( __line__, vely_c(ke,i,j) )
1250  call check( __line__, vely_c(ke-1,i,j) )
1251  call check( __line__, rfdz(ke-1) )
1252 #endif
1253  s23_c(ks,i,j) = ( s23_c(ks,i,j) &
1254  + 0.5_rp * ( vely_c(ks+1,i,j) - vely_c(ks,i,j) ) * j33g * rfdz(ks) &
1255  ) / gsqrt(ks,i,j,i_xyz)
1256  s23_c(ke,i,j) = ( s23_c(ke,i,j) &
1257  + 0.5_rp * ( vely_c(ke,i,j) - vely_c(ke-1,i,j) ) * j33g * rfdz(ke-1) &
1258  ) / gsqrt(ke,i,j,i_xyz)
1259  enddo
1260  enddo
1261  !$acc end kernels
1262 #ifdef DEBUG
1263  i = iundef; j = iundef; k = iundef
1264 #endif
1265 
1266  ! (x edge; x,v,w)
1267  !$omp parallel do
1268  !$acc kernels
1269  do j = jjs-1, jje
1270  do i = iis , iie
1271  do k = ks, ke-1
1272 #ifdef DEBUG
1273  call check( __line__, s23_x(k,i,j) )
1274  call check( __line__, vely_zx(k+1,i,j) )
1275  call check( __line__, vely_zx(k,i,j) )
1276  call check( __line__, rfdz(k) )
1277 #endif
1278  s23_x(k,i,j) = ( s23_x(k,i,j) &
1279  + 0.5_rp * ( vely_zx(k+1,i,j) - vely_zx(k,i,j) ) * j33g * rfdz(k) &
1280  ) / gsqrt(k,i,j,i_xvw)
1281  enddo
1282  enddo
1283  enddo
1284  !$acc end kernels
1285 #ifdef DEBUG
1286  i = iundef; j = iundef; k = iundef
1287 #endif
1288 
1289 
1290  ! |S|^2 = 2*Sij*Sij
1291 #ifdef DEBUG
1292  work_z(:,:,:) = undef; work_x(:,:,:) = undef; work_y(:,:,:) = undef
1293 #endif
1294  ! (cell center)
1295  !$omp parallel do default(none) &
1296  !$omp shared(JJS,JJE,IIS,IIE,KS,KE,S11_C,S22_C,S33_C,S31_C,S12_C,S23_C,S2) &
1297  !$omp private(i,j,k) OMP_SCHEDULE_ collapse(2)
1298  !$acc kernels
1299  do j = jjs-1, jje+1
1300  do i = iis-1, iie+1
1301  do k = ks, ke
1302 #ifdef DEBUG
1303  call check( __line__, s11_c(k,i,j) )
1304  call check( __line__, s22_c(k,i,j) )
1305  call check( __line__, s33_c(k,i,j) )
1306  call check( __line__, s31_c(k,i,j) )
1307  call check( __line__, s12_c(k,i,j) )
1308  call check( __line__, s23_c(k,i,j) )
1309 #endif
1310  s2(k,i,j) = 2.0_rp * ( s11_c(k,i,j)**2 + s22_c(k,i,j)**2 + s33_c(k,i,j)**2 ) &
1311  + 4.0_rp * ( s31_c(k,i,j)**2 + s12_c(k,i,j)**2 + s23_c(k,i,j)**2 )
1312  enddo
1313  enddo
1314  enddo
1315  !$acc end kernels
1316 #ifdef DEBUG
1317  i = iundef; j = iundef; k = iundef
1318 #endif
1319 
1320  enddo
1321  enddo
1322 
1323  !$acc end data
1324 
1325  return

References scale_atmos_grid_cartesc::atmos_grid_cartesc_fdx, scale_atmos_grid_cartesc::atmos_grid_cartesc_fdy, scale_atmos_grid_cartesc::atmos_grid_cartesc_fdz, scale_atmos_grid_cartesc::atmos_grid_cartesc_rcdx, scale_atmos_grid_cartesc::atmos_grid_cartesc_rcdy, scale_atmos_grid_cartesc::atmos_grid_cartesc_rcdz, scale_atmos_grid_cartesc::atmos_grid_cartesc_rfdx, scale_atmos_grid_cartesc::atmos_grid_cartesc_rfdy, scale_atmos_grid_cartesc::atmos_grid_cartesc_rfdz, scale_debug::check(), scale_atmos_grid_cartesc_index::i_uv, scale_atmos_grid_cartesc_index::i_uvz, scale_atmos_grid_cartesc_index::i_uy, scale_atmos_grid_cartesc_index::i_uyw, scale_atmos_grid_cartesc_index::i_uyz, scale_atmos_grid_cartesc_index::i_xv, scale_atmos_grid_cartesc_index::i_xvw, scale_atmos_grid_cartesc_index::i_xvz, scale_atmos_grid_cartesc_index::i_xy, scale_atmos_grid_cartesc_index::i_xyw, scale_atmos_grid_cartesc_index::i_xyz, scale_atmos_grid_cartesc_index::iblock, scale_atmos_grid_cartesc_index::ie, scale_atmos_grid_cartesc_index::is, scale_atmos_grid_cartesc_index::jblock, scale_atmos_grid_cartesc_index::je, scale_atmos_grid_cartesc_index::js, scale_tracer::k, scale_atmos_grid_cartesc_index::ke, and scale_atmos_grid_cartesc_index::ks.

Referenced by scale_atmos_phy_tb_d1980::atmos_phy_tb_d1980(), scale_atmos_phy_tb_dns::atmos_phy_tb_dns(), and scale_atmos_phy_tb_smg::atmos_phy_tb_smg().

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

◆ atmos_phy_tb_calc_flux_phi()

subroutine, public scale_atmos_phy_tb_common::atmos_phy_tb_calc_flux_phi ( real(rp), dimension(ka,ia,ja,3), intent(inout)  qflx_phi,
real(rp), dimension (ka,ia,ja), intent(in)  DENS,
real(rp), dimension (ka,ia,ja), intent(in)  PHI,
real(rp), dimension (ka,ia,ja), intent(in)  Kh,
real(rp), intent(in)  FACT,
real(rp), dimension (ka,ia,ja,7), intent(in)  GSQRT,
real(rp), dimension (ka,ia,ja,7), intent(in)  J13G,
real(rp), dimension (ka,ia,ja,7), intent(in)  J23G,
real(rp), intent(in)  J33G,
real(rp), dimension (ia,ja,2,4), intent(in)  MAPF,
logical, intent(in)  horizontal,
logical, intent(in)  implicit,
real(rp), dimension (ka,ia,ja), intent(in)  a,
real(rp), dimension (ka,ia,ja), intent(in)  b,
real(rp), dimension (ka,ia,ja), intent(in)  c,
real(dp), intent(in)  dt,
integer, intent(in)  IIS,
integer, intent(in)  IIE,
integer, intent(in)  JJS,
integer, intent(in)  JJE 
)

Definition at line 1337 of file scale_atmos_phy_tb_common.F90.

1337  use scale_atmos_grid_cartesc, only: &
1338  rcdz => atmos_grid_cartesc_rcdz, &
1339  rfdz => atmos_grid_cartesc_rfdz, &
1340  rfdx => atmos_grid_cartesc_rfdx, &
1341  rfdy => atmos_grid_cartesc_rfdy
1342  use scale_matrix, only: &
1343  matrix_solver_tridiagonal
1344  implicit none
1345 
1346  real(RP), intent(inout) :: qflx_phi(KA,IA,JA,3)
1347  real(RP), intent(in) :: DENS (KA,IA,JA)
1348  real(RP), intent(in) :: PHI (KA,IA,JA)
1349  real(RP), intent(in) :: Kh (KA,IA,JA)
1350  real(RP), intent(in) :: FACT
1351  real(RP), intent(in) :: GSQRT (KA,IA,JA,7)
1352  real(RP), intent(in) :: J13G (KA,IA,JA,7)
1353  real(RP), intent(in) :: J23G (KA,IA,JA,7)
1354  real(RP), intent(in) :: J33G
1355  real(RP), intent(in) :: MAPF (IA,JA,2,4)
1356  logical, intent(in) :: horizontal
1357  logical, intent(in) :: implicit
1358  real(RP), intent(in) :: a (KA,IA,JA)
1359  real(RP), intent(in) :: b (KA,IA,JA)
1360  real(RP), intent(in) :: c (KA,IA,JA)
1361  real(DP), intent(in) :: dt
1362  integer, intent(in) :: IIS
1363  integer, intent(in) :: IIE
1364  integer, intent(in) :: JJS
1365  integer, intent(in) :: JJE
1366 
1367  real(RP) :: TEND(KA,IA,JA)
1368  real(RP) :: TEND2(KA,IA,JA)
1369  real(RP) :: d(KA)
1370 
1371  integer :: k, i, j
1372 
1373  !$acc data copy(qflx_phi) &
1374  !$acc copyin(DENS, PHI, Kh, GSQRT, J13G, J23G, MAPF, a, b, c, &
1375  !$acc RCDZ, RFDZ, RFDX, RFDY) &
1376  !$acc create(TEND,TEND2)
1377 
1378 
1379  ! (x-y plane; x,y,w)
1380  if ( horizontal ) then
1381  !$omp parallel workshare
1382  !$acc kernels
1383 !XFILL
1384  qflx_phi(:,:,:,zdir) = 0.0_rp
1385  !$acc end kernels
1386  !$omp end parallel workshare
1387  else
1388  !$omp parallel do default(none) private(i,j,k) OMP_SCHEDULE_ collapse(2) &
1389  !$omp shared(JJS,JJE,IIS,IIE,KS,KE,DENS,Kh,FACT,PHI,qflx_phi,GSQRT,I_XYW,RFDZ,J33G)
1390  !$acc kernels
1391  do j = jjs, jje
1392  do i = iis, iie
1393  do k = ks, ke-1
1394 #ifdef DEBUG
1395  call check( __line__, dens(k,i,j) )
1396  call check( __line__, dens(k+1,i,j) )
1397  call check( __line__, kh(k,i,j) )
1398  call check( __line__, kh(k+1,i,j) )
1399  call check( __line__, phi(k+1,i,j) )
1400  call check( __line__, phi(k,i,j) )
1401  call check( __line__, rfdz(k) )
1402 #endif
1403  qflx_phi(k,i,j,zdir) = - 0.25_rp & ! 1/2/2
1404  * ( dens(k,i,j)+dens(k+1,i,j) ) &
1405  * ( kh(k,i,j) + kh(k+1,i,j) ) * fact &
1406  * ( phi(k+1,i,j)-phi(k,i,j) ) * rfdz(k) * j33g &
1407  / gsqrt(k,i,j,i_xyw)
1408  enddo
1409  enddo
1410  enddo
1411  !$acc end kernels
1412 #ifdef DEBUG
1413  i = iundef; j = iundef; k = iundef
1414 #endif
1415  !$omp parallel do
1416  !$acc kernels
1417  do j = jjs, jje
1418  do i = iis, iie
1419  qflx_phi(ks-1,i,j,zdir) = 0.0_rp
1420  qflx_phi(ke ,i,j,zdir) = 0.0_rp
1421  enddo
1422  enddo
1423  !$acc end kernels
1424 #ifdef DEBUG
1425  i = iundef; j = iundef; k = iundef
1426 #endif
1427  end if
1428 
1429  ! (y-z plane; u,y,z)
1430  !$omp parallel do default(none) private(i,j,k) OMP_SCHEDULE_ collapse(2) &
1431  !$omp shared(JJS,JJE,IIS,IIE,KS,KE,DENS,Kh,FACT,PHI,qflx_phi,GSQRT,I_XYZ,RFDX,J13G,I_UYZ) &
1432  !$omp shared(RCDZ)
1433  !$acc kernels
1434  do j = jjs, jje
1435  do i = iis-1, iie
1436  do k = ks+1, ke-1
1437 #ifdef DEBUG
1438  call check( __line__, dens(k,i,j) )
1439  call check( __line__, dens(k,i+1,j) )
1440  call check( __line__, kh(k,i,j) )
1441  call check( __line__, kh(k,i+1,j) )
1442  call check( __line__, phi(k,i+1,j) )
1443  call check( __line__, phi(k,i,j) )
1444  call check( __line__, rfdx(i) )
1445 #endif
1446  qflx_phi(k,i,j,xdir) = - 0.25_rp & ! 1/2/2
1447  * ( dens(k,i,j) + dens(k,i+1,j) ) &
1448  * ( kh(k,i,j) + kh(k,i+1,j) ) * fact &
1449  * ( &
1450  ( gsqrt(k,i+1,j,i_xyz) * phi(k,i+1,j) &
1451  - gsqrt(k,i ,j,i_xyz) * phi(k,i ,j) ) * rfdx(i) &
1452  + ( j13g(k ,i,j,i_uyz) * ( phi(k+1,i+1,j)+phi(k+1,i,j)+phi(k ,i+1,j)+phi(k ,i,j) ) &
1453  - j13g(k-1,i,j,i_uyz) * ( phi(k ,i+1,j)+phi(k ,i,j)+phi(k-1,i+1,j)+phi(k-1,i,j) ) &
1454  ) * 0.25_rp * rcdz(k) &
1455  ) / gsqrt(k,i,j,i_uyz)
1456  enddo
1457  enddo
1458  enddo
1459  !$acc end kernels
1460 #ifdef DEBUG
1461  i = iundef; j = iundef; k = iundef
1462 #endif
1463  !$omp parallel do
1464  !$acc kernels
1465  do j = jjs, jje
1466  do i = iis-1, iie
1467 #ifdef DEBUG
1468  call check( __line__, dens(ks,i,j) )
1469  call check( __line__, dens(ks,i+1,j) )
1470  call check( __line__, kh(ks,i,j) )
1471  call check( __line__, kh(ks,i+1,j) )
1472  call check( __line__, phi(ks,i+1,j) )
1473  call check( __line__, phi(ks,i,j) )
1474  call check( __line__, rfdx(i) )
1475 #endif
1476  qflx_phi(ks,i,j,xdir) = - 0.25_rp & ! 1/2/2
1477  * ( dens(ks,i,j) + dens(ks,i+1,j) ) &
1478  * ( kh(ks,i,j) + kh(ks,i+1,j) ) * fact &
1479  * ( &
1480  ( gsqrt(ks,i+1,j,i_xyz) * phi(ks,i+1,j) &
1481  - gsqrt(ks,i ,j,i_xyz) * phi(ks,i ,j) ) * rfdx(i) &
1482  + ( j13g(ks+1,i,j,i_uyz) * ( phi(ks+1,i+1,j)+phi(ks+1,i,j) ) &
1483  - j13g(ks ,i,j,i_uyz) * ( phi(ks ,i+1,j)+phi(ks ,i,j) ) &
1484  ) * 0.5_rp * rfdz(ks) &
1485  ) * mapf(i,j,1,i_uy) / gsqrt(ks,i,j,i_uyz)
1486  qflx_phi(ke,i,j,xdir) = - 0.25_rp & ! 1/2/2
1487  * ( dens(ke,i,j) + dens(ke,i+1,j) ) &
1488  * ( kh(ke,i,j) + kh(ke,i+1,j) ) * fact &
1489  * ( &
1490  ( gsqrt(ke,i+1,j,i_xyz) * phi(ke,i+1,j) &
1491  - gsqrt(ke,i ,j,i_xyz) * phi(ke,i ,j) ) * rfdx(i) &
1492  + ( j13g(ke ,i,j,i_uyz) * ( phi(ke ,i+1,j)+phi(ke ,i,j) ) &
1493  - j13g(ke-1,i,j,i_uyz) * ( phi(ke-1,i+1,j)+phi(ke-1,i,j) ) &
1494  ) * 0.5_rp * rfdz(ke-1) &
1495  ) * mapf(i,j,1,i_uy) / gsqrt(ke,i,j,i_uyz)
1496  enddo
1497  enddo
1498  !$acc end kernels
1499 #ifdef DEBUG
1500  i = iundef; j = iundef; k = iundef
1501 #endif
1502  ! (z-x plane; x,v,z)
1503  !$omp parallel do default(none) OMP_SCHEDULE_ collapse(2) &
1504  !$omp private(i,j,k) &
1505  !$omp shared(JJS,JJE,IIS,IIE,KS,KE,Kh,FACT,PHI,RFDY,DENS,qflx_phi,GSQRT,I_XYZ,J23G,I_XVZ,RCDZ) &
1506  !$omp shared(MAPF,I_XV)
1507  !$acc kernels
1508  do j = jjs-1, jje
1509  do i = iis, iie
1510  do k = ks+1, ke-1
1511 #ifdef DEBUG
1512  call check( __line__, dens(k,i,j) )
1513  call check( __line__, dens(k,i,j+1) )
1514  call check( __line__, kh(k,i,j) )
1515  call check( __line__, kh(k,i,j+1) )
1516  call check( __line__, phi(k,i,j+1) )
1517  call check( __line__, phi(k,i,j) )
1518  call check( __line__, rfdy(j) )
1519 #endif
1520  qflx_phi(k,i,j,ydir) = - 0.25_rp &
1521  * ( dens(k,i,j) + dens(k,i,j+1) ) &
1522  * ( kh(k,i,j) + kh(k,i,j+1) ) * fact &
1523  * ( &
1524  ( gsqrt(k,i,j+1,i_xyz) * phi(k,i,j+1) &
1525  - gsqrt(k,i,j ,i_xyz) * phi(k,i,j ) ) * rfdy(j) &
1526  + ( j23g(k ,i,j,i_xvz) * ( phi(k+1,i,j+1)+phi(k+1,i,j)+phi(k ,i,j+1)+phi(k ,i,j) ) &
1527  - j23g(k-1,i,j,i_xvz) * ( phi(k ,i,j+1)+phi(k ,i,j)+phi(k-1,i,j+1)+phi(k-1,i,j) ) &
1528  ) * 0.25_rp * rcdz(k) &
1529  ) * mapf(i,j,2,i_xv) / gsqrt(k,i,j,i_xvz)
1530  enddo
1531  enddo
1532  enddo
1533  !$acc end kernels
1534 #ifdef DEBUG
1535  i = iundef; j = iundef; k = iundef
1536 #endif
1537  !$omp parallel do
1538  !$acc kernels
1539  do j = jjs-1, jje
1540  do i = iis, iie
1541 #ifdef DEBUG
1542  call check( __line__, dens(ks,i,j) )
1543  call check( __line__, dens(ks,i,j+1) )
1544  call check( __line__, kh(ks,i,j) )
1545  call check( __line__, kh(ks,i,j+1) )
1546  call check( __line__, phi(ks,i,j+1) )
1547  call check( __line__, phi(ks,i,j) )
1548  call check( __line__, rfdy(j) )
1549 #endif
1550  qflx_phi(ks,i,j,ydir) = - 0.25_rp &
1551  * ( dens(ks,i,j) + dens(ks,i,j+1) ) &
1552  * ( kh(ks,i,j) + kh(ks,i,j+1) ) * fact &
1553  * ( &
1554  ( gsqrt(ks,i,j+1,i_xyz) * phi(ks,i,j+1) &
1555  - gsqrt(ks,i,j ,i_xyz) * phi(ks,i,j ) ) * rfdy(j) &
1556  + ( j23g(ks+1,i,j,i_xvz) * ( phi(ks+1,i,j+1)+phi(ks+1,i,j) ) &
1557  - j23g(ks ,i,j,i_xvz) * ( phi(ks ,i,j+1)+phi(ks ,i,j) ) &
1558  ) * 0.5_rp * rfdz(ks) &
1559  ) * mapf(i,j,2,i_xv) / gsqrt(ks,i,j,i_xvz)
1560  qflx_phi(ke,i,j,ydir) = - 0.25_rp &
1561  * ( dens(ke,i,j) + dens(ke,i,j+1) ) &
1562  * ( kh(ke,i,j) + kh(ke,i,j+1) ) * fact &
1563  * ( &
1564  ( gsqrt(ke,i,j+1,i_xyz) * phi(ke,i,j+1) &
1565  - gsqrt(ke,i,j ,i_xyz) * phi(ke,i,j ) ) * rfdy(j) &
1566  + ( j23g(ke ,i,j,i_xvz) * ( phi(ke ,i,j+1)+phi(ke ,i,j) ) &
1567  - j23g(ke-1,i,j,i_xvz) * ( phi(ke-1,i,j+1)+phi(ke-1,i,j) ) &
1568  ) * 0.5_rp * rfdz(ke-1) &
1569  ) * mapf(i,j,2,i_xv) / gsqrt(ke,i,j,i_xvz)
1570  enddo
1571  enddo
1572  !$acc end kernels
1573 #ifdef DEBUG
1574  i = iundef; j = iundef; k = iundef
1575 #endif
1576 
1577  if ( (.not. horizontal) .and. implicit ) then
1578  call atmos_phy_tb_calc_tend_phi( tend, & ! (out)
1579  qflx_phi, & ! (in)
1580  gsqrt, j13g, j23g, j33g, mapf, & ! (in)
1581  iis, iie, jjs, jje ) ! (in)
1582 
1583  call matrix_solver_tridiagonal( ka, ks, ke, ia, iis, iie, ja, jjs, jje, &
1584  a(:,:,:), b(:,:,:), c(:,:,:), tend(:,:,:), &
1585  tend2(:,:,:) )
1586 
1587  !$omp parallel do collapse(2)
1588  !$acc kernels
1589  do j = jjs, jje
1590  do i = iis, iie
1591  do k = ks, ke-1
1592  qflx_phi(k,i,j,zdir) = qflx_phi(k,i,j,zdir) &
1593  - 0.25_rp & ! 1/2/2
1594  * ( dens(k,i,j)+dens(k+1,i,j) ) &
1595  * ( kh(k,i,j) + kh(k+1,i,j) ) * fact &
1596  * dt * ( tend2(k+1,i,j)-tend2(k,i,j) ) * rfdz(k) * j33g &
1597  / gsqrt(k,i,j,i_xyw)
1598  end do
1599  end do
1600  end do
1601  !$acc end kernels
1602 
1603  end if
1604 
1605  !$acc end data
1606 
1607  return

References scale_atmos_grid_cartesc::atmos_grid_cartesc_rcdz, scale_atmos_grid_cartesc::atmos_grid_cartesc_rfdx, scale_atmos_grid_cartesc::atmos_grid_cartesc_rfdy, scale_atmos_grid_cartesc::atmos_grid_cartesc_rfdz, atmos_phy_tb_calc_tend_phi(), scale_debug::check(), scale_atmos_grid_cartesc_index::i_uy, scale_atmos_grid_cartesc_index::i_uyz, scale_atmos_grid_cartesc_index::i_xv, scale_atmos_grid_cartesc_index::i_xvz, scale_atmos_grid_cartesc_index::i_xyw, scale_atmos_grid_cartesc_index::i_xyz, scale_atmos_grid_cartesc_index::ia, scale_atmos_grid_cartesc_index::ja, scale_tracer::k, scale_atmos_grid_cartesc_index::ka, scale_atmos_grid_cartesc_index::ke, scale_atmos_grid_cartesc_index::ks, scale_atmos_grid_cartesc_index::xdir, scale_atmos_grid_cartesc_index::ydir, and scale_atmos_grid_cartesc_index::zdir.

Referenced by scale_atmos_phy_tb_d1980::atmos_phy_tb_d1980(), scale_atmos_phy_tb_dns::atmos_phy_tb_dns(), and scale_atmos_phy_tb_smg::atmos_phy_tb_smg().

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

◆ atmos_phy_tb_calc_tend_momz()

subroutine, public scale_atmos_phy_tb_common::atmos_phy_tb_calc_tend_momz ( real(rp), dimension(ka,ia,ja), intent(out)  MOMZ_t_TB,
real(rp), dimension(ka,ia,ja,3), intent(in)  QFLX_MOMZ,
real(rp), dimension(ka,ia,ja,7), intent(in)  GSQRT,
real(rp), dimension(ka,ia,ja,7), intent(in)  J13G,
real(rp), dimension(ka,ia,ja,7), intent(in)  J23G,
real(rp), intent(in)  J33G,
real(rp), dimension(ia,ja,2,4), intent(in)  MAPF,
integer, intent(in)  IIS,
integer, intent(in)  IIE,
integer, intent(in)  JJS,
integer, intent(in)  JJE 
)

Definition at line 1616 of file scale_atmos_phy_tb_common.F90.

1616  use scale_atmos_grid_cartesc, only: &
1617  rcdx => atmos_grid_cartesc_rcdx, &
1618  rcdy => atmos_grid_cartesc_rcdy, &
1619  rfdz => atmos_grid_cartesc_rfdz
1620  implicit none
1621 
1622  real(RP), intent(out) :: MOMZ_t_TB(KA,IA,JA)
1623 
1624  real(RP), intent(in) :: QFLX_MOMZ(KA,IA,JA,3)
1625  real(RP), intent(in) :: GSQRT(KA,IA,JA,7)
1626  real(RP), intent(in) :: J13G(KA,IA,JA,7)
1627  real(RP), intent(in) :: J23G(KA,IA,JA,7)
1628  real(RP), intent(in) :: J33G
1629  real(RP), intent(in) :: MAPF(IA,JA,2,4)
1630  integer , intent(in) :: IIS
1631  integer , intent(in) :: IIE
1632  integer , intent(in) :: JJS
1633  integer , intent(in) :: JJE
1634 
1635  real(RP) :: fluxZ(KA)
1636  integer :: k, i, j
1637 
1638  !$omp parallel do default(none) OMP_SCHEDULE_ collapse(2) &
1639  !$omp private(i,j,k, &
1640  !$omp fluxZ) &
1641  !$omp shared(JJS,JJE,IIS,IIE,KS,KE,I_XYZ,I_XYW,I_UYW,I_XVW,I_XY,I_XV,I_UY, &
1642  !$omp MOMZ_t_TB,QFLX_MOMZ,GSQRT,J13G,J23G,J33G,MAPF,RFDZ,RCDX,RCDY)
1643  !$acc kernels
1644  do j = jjs, jje
1645  !$acc loop private(fluxZ)
1646  do i = iis, iie
1647  do k = ks+1, ke-1
1648  fluxz(k) = ( ( qflx_momz(k ,i,j,xdir) + qflx_momz(k ,i-1,j,xdir) &
1649  + qflx_momz(k-1,i,j,xdir) + qflx_momz(k-1,i-1,j,xdir) ) * j13g(k,i,j,i_xyz) * mapf(i,j,1,i_xy) &
1650  + ( qflx_momz(k ,i,j,ydir) + qflx_momz(k ,i,j-1,ydir) &
1651  + qflx_momz(k-1,i,j,ydir) + qflx_momz(k-1,i,j-1,ydir) ) * j23g(k,i,j,i_xyz) * mapf(i,j,2,i_xy) &
1652  ) * 0.25_rp &
1653  + j33g * qflx_momz(k,i,j,zdir)
1654  end do
1655  fluxz(ks) = 0.0_rp
1656  fluxz(ke) = 0.0_rp
1657  do k = ks, ke-1
1658  momz_t_tb(k,i,j) = &
1659  - ( ( ( gsqrt(k,i ,j,i_uyw) * qflx_momz(k,i ,j,xdir) / mapf(i ,j,2,i_uy) &
1660  - gsqrt(k,i-1,j,i_uyw) * qflx_momz(k,i-1,j,xdir) / mapf(i-1,j,2,i_uy) ) * rcdx(i) &
1661  + ( gsqrt(k,i,j ,i_xvw) * qflx_momz(k,i,j ,ydir) / mapf(i,j ,1,i_xv) &
1662  - gsqrt(k,i,j-1,i_xvw) * qflx_momz(k,i,j-1,ydir) / mapf(i,j-1,1,i_xv) ) * rcdy(j) &
1663  ) * mapf(i,j,1,i_xy) * mapf(i,j,2,i_xy) &
1664  + ( fluxz(k+1) - fluxz(k) ) * rfdz(k) &
1665  ) / gsqrt(k,i,j,i_xyw)
1666  enddo
1667  enddo
1668  enddo
1669  !$acc end kernels
1670 
1671  return

References scale_atmos_grid_cartesc::atmos_grid_cartesc_rcdx, scale_atmos_grid_cartesc::atmos_grid_cartesc_rcdy, scale_atmos_grid_cartesc::atmos_grid_cartesc_rfdz, scale_atmos_grid_cartesc_index::i_uy, scale_atmos_grid_cartesc_index::i_uyw, scale_atmos_grid_cartesc_index::i_xv, scale_atmos_grid_cartesc_index::i_xvw, scale_atmos_grid_cartesc_index::i_xy, scale_atmos_grid_cartesc_index::i_xyw, scale_atmos_grid_cartesc_index::i_xyz, scale_tracer::k, scale_atmos_grid_cartesc_index::ke, scale_atmos_grid_cartesc_index::ks, scale_atmos_grid_cartesc_index::xdir, scale_atmos_grid_cartesc_index::ydir, and scale_atmos_grid_cartesc_index::zdir.

Referenced by scale_atmos_phy_tb_d1980::atmos_phy_tb_d1980(), mod_atmos_phy_tb_driver::atmos_phy_tb_driver_calc_tendency(), and scale_atmos_phy_tb_smg::atmos_phy_tb_smg().

Here is the caller graph for this function:

◆ atmos_phy_tb_calc_tend_momx()

subroutine, public scale_atmos_phy_tb_common::atmos_phy_tb_calc_tend_momx ( real(rp), dimension(ka,ia,ja), intent(out)  MOMX_t_TB,
real(rp), dimension(ka,ia,ja,3), intent(in)  QFLX_MOMX,
real(rp), dimension(ka,ia,ja,7), intent(in)  GSQRT,
real(rp), dimension(ka,ia,ja,7), intent(in)  J13G,
real(rp), dimension(ka,ia,ja,7), intent(in)  J23G,
real(rp), intent(in)  J33G,
real(rp), dimension(ia,ja,2,4), intent(in)  MAPF,
integer, intent(in)  IIS,
integer, intent(in)  IIE,
integer, intent(in)  JJS,
integer, intent(in)  JJE 
)

Definition at line 1679 of file scale_atmos_phy_tb_common.F90.

1679  use scale_atmos_grid_cartesc, only: &
1680  rcdz => atmos_grid_cartesc_rcdz, &
1681  rcdy => atmos_grid_cartesc_rcdy, &
1682  rfdx => atmos_grid_cartesc_rfdx
1683  implicit none
1684  real(RP), intent(out) :: MOMX_t_TB(KA,IA,JA)
1685 
1686  real(RP), intent(in) :: QFLX_MOMX(KA,IA,JA,3)
1687  real(RP), intent(in) :: GSQRT(KA,IA,JA,7)
1688  real(RP), intent(in) :: MAPF(IA,JA,2,4)
1689  real(RP), intent(in) :: J13G(KA,IA,JA,7)
1690  real(RP), intent(in) :: J23G(KA,IA,JA,7)
1691  real(RP), intent(in) :: J33G
1692  integer , intent(in) :: IIS
1693  integer , intent(in) :: IIE
1694  integer , intent(in) :: JJS
1695  integer , intent(in) :: JJE
1696 
1697  real(RP) :: fluxZ(KA)
1698  integer :: k, i, j
1699 
1700  !$omp parallel do default(none) OMP_SCHEDULE_ collapse(2) &
1701  !$omp private(i,j,k, &
1702  !$omp fluxZ) &
1703  !$omp shared(JJS,JJE,IIS,IIE,KS,KE,I_XYZ,I_UYZ,I_UVZ,I_UYW,I_UY,I_XY,I_UV, &
1704  !$omp MOMX_t_TB,QFLX_MOMX,GSQRT,J13G,J23G,J33G,MAPF,RCDZ,RFDX,RCDY)
1705  !$acc kernels
1706  do j = jjs, jje
1707  !$acc loop private(fluxZ)
1708  do i = iis, iie
1709  do k = ks, ke-1
1710  fluxz(k) = ( ( qflx_momx(k+1,i+1,j,xdir) + qflx_momx(k+1,i,j ,xdir) &
1711  + qflx_momx(k ,i+1,j,xdir) + qflx_momx(k ,i,j ,xdir) ) * j13g(k,i,j,i_uyw) * mapf(i,j,1,i_uy) &
1712  + ( qflx_momx(k+1,i ,j,ydir) + qflx_momx(k+1,i,j-1,ydir) &
1713  + qflx_momx(k ,i ,j,ydir) + qflx_momx(k ,i,j-1,ydir) ) * j23g(k,i,j,i_uyw) * mapf(i,j,2,i_uy) &
1714  ) * 0.25_rp &
1715  + j33g * qflx_momx(k,i,j,zdir)
1716  end do
1717  fluxz(ks-1) = 0.0_rp
1718  fluxz(ke ) = 0.0_rp
1719  do k = ks, ke
1720  momx_t_tb(k,i,j) = &
1721  - ( ( ( gsqrt(k,i+1,j,i_xyz) * qflx_momx(k,i+1,j,xdir) / mapf(i+1,j ,2,i_xy) &
1722  - gsqrt(k,i ,j,i_xyz) * qflx_momx(k,i ,j,xdir) / mapf(i ,j ,2,i_xy) ) * rfdx(i) &
1723  + ( gsqrt(k,i,j ,i_uvz) * qflx_momx(k,i,j ,ydir) / mapf(i ,j ,1,i_uv) &
1724  - gsqrt(k,i,j-1,i_uvz) * qflx_momx(k,i,j-1,ydir) / mapf(i ,j-1,1,i_uv) ) * rcdy(j) &
1725  ) * mapf(i,j,1,i_uy) * mapf(i,j,2,i_uy) &
1726  + ( fluxz(k) - fluxz(k-1) ) * rcdz(k) &
1727  ) / gsqrt(k,i,j,i_uyz)
1728  enddo
1729  enddo
1730  enddo
1731  !$acc end kernels
1732 
1733  return

References scale_atmos_grid_cartesc::atmos_grid_cartesc_rcdy, scale_atmos_grid_cartesc::atmos_grid_cartesc_rcdz, scale_atmos_grid_cartesc::atmos_grid_cartesc_rfdx, scale_atmos_grid_cartesc_index::i_uv, scale_atmos_grid_cartesc_index::i_uvz, scale_atmos_grid_cartesc_index::i_uy, scale_atmos_grid_cartesc_index::i_uyw, scale_atmos_grid_cartesc_index::i_uyz, scale_atmos_grid_cartesc_index::i_xy, scale_atmos_grid_cartesc_index::i_xyz, scale_tracer::k, scale_atmos_grid_cartesc_index::ke, scale_atmos_grid_cartesc_index::ks, scale_atmos_grid_cartesc_index::xdir, scale_atmos_grid_cartesc_index::ydir, and scale_atmos_grid_cartesc_index::zdir.

Referenced by scale_atmos_phy_tb_d1980::atmos_phy_tb_d1980(), mod_atmos_phy_tb_driver::atmos_phy_tb_driver_calc_tendency(), and scale_atmos_phy_tb_smg::atmos_phy_tb_smg().

Here is the caller graph for this function:

◆ atmos_phy_tb_calc_tend_momy()

subroutine, public scale_atmos_phy_tb_common::atmos_phy_tb_calc_tend_momy ( real(rp), dimension(ka,ia,ja), intent(out)  MOMY_t_TB,
real(rp), dimension(ka,ia,ja,3), intent(in)  QFLX_MOMY,
real(rp), dimension(ka,ia,ja,7), intent(in)  GSQRT,
real(rp), dimension(ka,ia,ja,7), intent(in)  J13G,
real(rp), dimension(ka,ia,ja,7), intent(in)  J23G,
real(rp), intent(in)  J33G,
real(rp), dimension(ia,ja,2,4), intent(in)  MAPF,
integer, intent(in)  IIS,
integer, intent(in)  IIE,
integer, intent(in)  JJS,
integer, intent(in)  JJE 
)

Definition at line 1741 of file scale_atmos_phy_tb_common.F90.

1741  use scale_atmos_grid_cartesc, only: &
1742  rcdz => atmos_grid_cartesc_rcdz, &
1743  rcdx => atmos_grid_cartesc_rcdx, &
1744  rfdy => atmos_grid_cartesc_rfdy
1745  implicit none
1746 
1747  real(RP), intent(out) :: MOMY_t_TB(KA,IA,JA)
1748 
1749  real(RP), intent(in) :: QFLX_MOMY(KA,IA,JA,3)
1750  real(RP), intent(in) :: GSQRT(KA,IA,JA,7)
1751  real(RP), intent(in) :: MAPF(IA,JA,2,4)
1752  real(RP), intent(in) :: J13G(KA,IA,JA,7)
1753  real(RP), intent(in) :: J23G(KA,IA,JA,7)
1754  real(RP), intent(in) :: J33G
1755  integer , intent(in) :: IIS
1756  integer , intent(in) :: IIE
1757  integer , intent(in) :: JJS
1758  integer , intent(in) :: JJE
1759 
1760  real(RP) :: fluxZ(KA)
1761  integer :: k, i, j
1762 
1763  !$omp parallel do default(none) OMP_SCHEDULE_ collapse(2) &
1764  !$omp private(i,j,k, &
1765  !$omp fluxZ) &
1766  !$omp shared(JJS,JJE,IIS,IIE,KS,KE,I_XVZ,I_UVZ,I_XYZ,I_XVW,I_XV,I_UV,I_XY, &
1767  !$omp MOMY_t_TB,QFLX_MOMY,GSQRT,J13G,J23G,J33G,MAPF,RCDZ,RCDX,RFDY)
1768  !$acc kernels
1769  do j = jjs, jje
1770  !$acc loop private(fluxZ)
1771  do i = iis, iie
1772  do k = ks, ke-1
1773  fluxz(k) = ( ( qflx_momy(k+1,i,j ,xdir) + qflx_momy(k+1,i-1,j,xdir) &
1774  + qflx_momy(k ,i,j ,xdir) + qflx_momy(k ,i-1,j,xdir) ) * j13g(k,i,j,i_xvw) * mapf(i,j,1,i_xv) &
1775  + ( qflx_momy(k+1,i,j+1,ydir) + qflx_momy(k+1,i ,j,ydir) &
1776  + qflx_momy(k ,i,j+1,ydir) + qflx_momy(k ,i ,j,ydir) ) * j23g(k,i,j,i_xvw) * mapf(i,j,2,i_xv) &
1777  ) * 0.25_rp &
1778  + j33g * qflx_momy(k,i,j,zdir)
1779  end do
1780  fluxz(ks-1) = 0.0_rp
1781  fluxz(ke ) = 0.0_rp
1782  do k = ks, ke
1783  momy_t_tb(k,i,j) = &
1784  - ( ( ( gsqrt(k,i ,j ,i_uvz) * qflx_momy(k,i ,j,xdir) / mapf(i ,j,2,i_uv) &
1785  - gsqrt(k,i-1,j ,i_uvz) * qflx_momy(k,i-1,j,xdir) / mapf(i-1,j,2,i_uv) ) * rcdx(i) &
1786  + ( gsqrt(k,i ,j+1,i_xyz) * qflx_momy(k,i,j+1,ydir) / mapf(i,j+1,2,i_xy) &
1787  - gsqrt(k,i ,j ,i_xyz) * qflx_momy(k,i,j ,ydir) / mapf(i,j ,2,i_xy) ) * rfdy(j) &
1788  ) * mapf(i,j,1,i_xv) * mapf(i,j,2,i_xv) &
1789  + ( fluxz(k) - fluxz(k-1) ) * rcdz(k) &
1790  ) / gsqrt(k,i,j,i_xvz)
1791  enddo
1792  enddo
1793  enddo
1794  !$acc end kernels
1795 
1796  return

References scale_atmos_grid_cartesc::atmos_grid_cartesc_rcdx, scale_atmos_grid_cartesc::atmos_grid_cartesc_rcdz, scale_atmos_grid_cartesc::atmos_grid_cartesc_rfdy, scale_atmos_grid_cartesc_index::i_uv, scale_atmos_grid_cartesc_index::i_uvz, scale_atmos_grid_cartesc_index::i_xv, scale_atmos_grid_cartesc_index::i_xvw, scale_atmos_grid_cartesc_index::i_xvz, scale_atmos_grid_cartesc_index::i_xy, scale_atmos_grid_cartesc_index::i_xyz, scale_tracer::k, scale_atmos_grid_cartesc_index::ke, scale_atmos_grid_cartesc_index::ks, scale_atmos_grid_cartesc_index::xdir, scale_atmos_grid_cartesc_index::ydir, and scale_atmos_grid_cartesc_index::zdir.

Referenced by scale_atmos_phy_tb_d1980::atmos_phy_tb_d1980(), mod_atmos_phy_tb_driver::atmos_phy_tb_driver_calc_tendency(), and scale_atmos_phy_tb_smg::atmos_phy_tb_smg().

Here is the caller graph for this function:

◆ atmos_phy_tb_calc_tend_phi()

subroutine, public scale_atmos_phy_tb_common::atmos_phy_tb_calc_tend_phi ( real(rp), dimension(ka,ia,ja), intent(out)  phi_t_TB,
real(rp), dimension(ka,ia,ja,3), intent(in)  QFLX_phi,
real(rp), dimension(ka,ia,ja,7), intent(in)  GSQRT,
real(rp), dimension(ka,ia,ja,7), intent(in)  J13G,
real(rp), dimension(ka,ia,ja,7), intent(in)  J23G,
real(rp), intent(in)  J33G,
real(rp), dimension(ia,ja,2,4), intent(in)  MAPF,
integer, intent(in)  IIS,
integer, intent(in)  IIE,
integer, intent(in)  JJS,
integer, intent(in)  JJE 
)

Definition at line 1804 of file scale_atmos_phy_tb_common.F90.

1804  use scale_atmos_grid_cartesc, only: &
1805  rcdz => atmos_grid_cartesc_rcdz, &
1806  rcdx => atmos_grid_cartesc_rcdx, &
1807  rcdy => atmos_grid_cartesc_rcdy, &
1808  fdz => atmos_grid_cartesc_fdz
1809  implicit none
1810 
1811  real(RP), intent(out) :: phi_t_TB(KA,IA,JA)
1812 
1813  real(RP), intent(in) :: QFLX_phi(KA,IA,JA,3)
1814  real(RP), intent(in) :: GSQRT(KA,IA,JA,7)
1815  real(RP), intent(in) :: J13G(KA,IA,JA,7)
1816  real(RP), intent(in) :: J23G(KA,IA,JA,7)
1817  real(RP), intent(in) :: J33G
1818  real(RP), intent(in) :: MAPF(IA,JA,2,4)
1819  integer , intent(in) :: IIS
1820  integer , intent(in) :: IIE
1821  integer , intent(in) :: JJS
1822  integer , intent(in) :: JJE
1823 
1824  real(RP) :: fluxZ(0:KA)
1825  integer :: k, i, j
1826 
1827  !$omp parallel do default(none) OMP_SCHEDULE_ collapse(2) &
1828  !$omp private(i,j,k, &
1829  !$omp fluxZ) &
1830  !$omp shared(JJS,JJE,IIS,IIE,KS,KE,I_XYZ,I_UYZ,I_XVZ,I_XYW,I_XY,I_UY,I_XV, &
1831  !$omp phi_t_TB,QFLX_phi,GSQRT,MAPF, &
1832  !$omp J13G,J23G,J33G,RCDZ,RCDX,RCDY)
1833  !$acc kernels
1834  do j = jjs, jje
1835  !$acc loop private(fluxZ)
1836  do i = iis, iie
1837  do k = ks, ke-1
1838  fluxz(k) = ( ( qflx_phi(k+1,i,j,xdir) + qflx_phi(k+1,i-1,j,xdir) &
1839  + qflx_phi(k ,i,j,xdir) + qflx_phi(k ,i-1,j,xdir) ) * j13g(k,i,j,i_xyw) * mapf(i,j,1,i_xy) &
1840  + ( qflx_phi(k+1,i,j,ydir) + qflx_phi(k+1,i,j-1,ydir) &
1841  + qflx_phi(k ,i,j,ydir) + qflx_phi(k ,i,j-1,ydir) ) * j23g(k,i,j,i_xyw) * mapf(i,j,2,i_xy) &
1842  ) * 0.25_rp &
1843  + j33g * qflx_phi(k,i,j,zdir)
1844  end do
1845  fluxz(ks-1) = 0.0_rp
1846  fluxz(ke ) = 0.0_rp
1847  do k = ks, ke
1848  phi_t_tb(k,i,j) = &
1849  - ( ( ( gsqrt(k,i ,j,i_uyz) * qflx_phi(k,i ,j,xdir) / mapf(i ,j,2,i_uy) &
1850  - gsqrt(k,i-1,j,i_uyz) * qflx_phi(k,i-1,j,xdir) / mapf(i-1,j,2,i_uy) ) * rcdx(i) &
1851  + ( gsqrt(k,i,j ,i_xvz) * qflx_phi(k,i,j ,ydir) / mapf(i,j ,1,i_xv) &
1852  - gsqrt(k,i,j-1,i_xvz) * qflx_phi(k,i,j-1,ydir) / mapf(i,j-1,1,i_xv) ) * rcdy(j) &
1853  ) * mapf(i,j,1,i_xy) * mapf(i,j,2,i_xy) &
1854  + ( fluxz(k) - fluxz(k-1) ) * rcdz(k) &
1855  ) / gsqrt(k,i,j,i_xyz)
1856  enddo
1857  enddo
1858  enddo
1859  !$acc end kernels
1860 
1861  return

References scale_atmos_grid_cartesc::atmos_grid_cartesc_fdz, scale_atmos_grid_cartesc::atmos_grid_cartesc_rcdx, scale_atmos_grid_cartesc::atmos_grid_cartesc_rcdy, scale_atmos_grid_cartesc::atmos_grid_cartesc_rcdz, scale_atmos_grid_cartesc_index::i_uy, scale_atmos_grid_cartesc_index::i_uyz, scale_atmos_grid_cartesc_index::i_xv, scale_atmos_grid_cartesc_index::i_xvz, scale_atmos_grid_cartesc_index::i_xy, scale_atmos_grid_cartesc_index::i_xyw, scale_atmos_grid_cartesc_index::i_xyz, scale_tracer::k, scale_atmos_grid_cartesc_index::ke, scale_atmos_grid_cartesc_index::ks, scale_atmos_grid_cartesc_index::xdir, scale_atmos_grid_cartesc_index::ydir, and scale_atmos_grid_cartesc_index::zdir.

Referenced by atmos_phy_tb_calc_flux_phi(), scale_atmos_phy_tb_d1980::atmos_phy_tb_d1980(), and mod_atmos_phy_tb_driver::atmos_phy_tb_driver_calc_tendency().

Here is the caller graph for this function:
scale_atmos_grid_cartesc_index::i_uy
integer, public i_uy
Definition: scale_atmos_grid_cartesC_index.F90:100
scale_atmos_grid_cartesc_index::i_xv
integer, public i_xv
Definition: scale_atmos_grid_cartesC_index.F90:101
scale_atmos_grid_cartesc::atmos_grid_cartesc_rfdx
real(rp), dimension(:), allocatable, public atmos_grid_cartesc_rfdx
reciprocal of face-dx
Definition: scale_atmos_grid_cartesC.F90:68
scale_atmos_grid_cartesc_index::i_uv
integer, public i_uv
Definition: scale_atmos_grid_cartesC_index.F90:102
scale_atmos_grid_cartesc::atmos_grid_cartesc_rcdx
real(rp), dimension(:), allocatable, public atmos_grid_cartesc_rcdx
reciprocal of center-dx
Definition: scale_atmos_grid_cartesC.F90:66
scale_atmos_grid_cartesc::atmos_grid_cartesc_fdy
real(rp), dimension(:), allocatable, public atmos_grid_cartesc_fdy
y-length of grid(j+1) to grid(j) [m]
Definition: scale_atmos_grid_cartesC.F90:64
scale_atmos_grid_cartesc::atmos_grid_cartesc_rcdz
real(rp), dimension(:), allocatable, public atmos_grid_cartesc_rcdz
reciprocal of center-dz
Definition: scale_atmos_grid_cartesC.F90:45
scale_atmos_grid_cartesc_index::i_xyz
integer, public i_xyz
Definition: scale_atmos_grid_cartesC_index.F90:91
scale_atmos_grid_cartesc_index::i_xy
integer, public i_xy
Definition: scale_atmos_grid_cartesC_index.F90:99
scale_atmos_grid_cartesc_index::i_uyz
integer, public i_uyz
Definition: scale_atmos_grid_cartesC_index.F90:95
scale_atmos_grid_cartesc::atmos_grid_cartesc_rcdy
real(rp), dimension(:), allocatable, public atmos_grid_cartesc_rcdy
reciprocal of center-dy
Definition: scale_atmos_grid_cartesC.F90:67
scale_atmos_grid_cartesc_index::i_xvw
integer, public i_xvw
Definition: scale_atmos_grid_cartesC_index.F90:94
scale_atmos_grid_cartesc_index::i_xvz
integer, public i_xvz
Definition: scale_atmos_grid_cartesC_index.F90:96
scale_atmos_grid_cartesc_index::i_uyw
integer, public i_uyw
Definition: scale_atmos_grid_cartesC_index.F90:93
scale_atmos_grid_cartesc::atmos_grid_cartesc_fdx
real(rp), dimension(:), allocatable, public atmos_grid_cartesc_fdx
x-length of grid(i+1) to grid(i) [m]
Definition: scale_atmos_grid_cartesC.F90:63
scale_atmos_phy_tb_common::atmos_phy_tb_calc_tend_phi
subroutine, public atmos_phy_tb_calc_tend_phi(phi_t_TB, QFLX_phi, GSQRT, J13G, J23G, J33G, MAPF, IIS, IIE, JJS, JJE)
Definition: scale_atmos_phy_tb_common.F90:1804
scale_matrix
module MATRIX
Definition: scale_matrix.F90:17
scale_atmos_grid_cartesc::atmos_grid_cartesc_rfdz
real(rp), dimension(:), allocatable, public atmos_grid_cartesc_rfdz
reciprocal of face-dz
Definition: scale_atmos_grid_cartesC.F90:46
scale_atmos_grid_cartesc
module atmosphere / grid / cartesC
Definition: scale_atmos_grid_cartesC.F90:12
scale_atmos_grid_cartesc::atmos_grid_cartesc_fdz
real(rp), dimension(:), allocatable, public atmos_grid_cartesc_fdz
z-length of grid(i+1) to grid(i) [m]
Definition: scale_atmos_grid_cartesC.F90:44
scale_atmos_grid_cartesc_index::i_uvz
integer, public i_uvz
Definition: scale_atmos_grid_cartesC_index.F90:97
scale_atmos_grid_cartesc::atmos_grid_cartesc_rfdy
real(rp), dimension(:), allocatable, public atmos_grid_cartesc_rfdy
reciprocal of face-dy
Definition: scale_atmos_grid_cartesC.F90:69
scale_atmos_grid_cartesc_index::i_xyw
integer, public i_xyw
Definition: scale_atmos_grid_cartesC_index.F90:92
Generated by   doxygen 1.8.17