190 real(RP),
intent(out) :: DENS_RK (KA,IA,JA)
191 real(RP),
intent(out) :: MOMZ_RK (KA,IA,JA)
192 real(RP),
intent(out) :: MOMX_RK (KA,IA,JA)
193 real(RP),
intent(out) :: MOMY_RK (KA,IA,JA)
194 real(RP),
intent(out) :: RHOT_RK (KA,IA,JA)
195 real(RP),
intent(out) :: PROG_RK (KA,IA,JA,VA)
197 real(RP),
intent(inout) :: mflx_hi (KA,IA,JA,3)
198 real(RP),
intent(out) :: tflx_hi (KA,IA,JA,3)
200 real(RP),
intent(in),
target :: DENS0 (KA,IA,JA)
201 real(RP),
intent(in),
target :: MOMZ0 (KA,IA,JA)
202 real(RP),
intent(in),
target :: MOMX0 (KA,IA,JA)
203 real(RP),
intent(in),
target :: MOMY0 (KA,IA,JA)
204 real(RP),
intent(in),
target :: RHOT0 (KA,IA,JA)
205 real(RP),
intent(in) :: PROG0 (KA,IA,JA,VA)
207 real(RP),
intent(in) :: DENS (KA,IA,JA)
208 real(RP),
intent(in) :: MOMZ (KA,IA,JA)
209 real(RP),
intent(in) :: MOMX (KA,IA,JA)
210 real(RP),
intent(in) :: MOMY (KA,IA,JA)
211 real(RP),
intent(in) :: RHOT (KA,IA,JA)
212 real(RP),
intent(in) :: PROG (KA,IA,JA,VA)
214 real(RP),
intent(in) :: DENS_t (KA,IA,JA)
215 real(RP),
intent(in) :: MOMZ_t (KA,IA,JA)
216 real(RP),
intent(in) :: MOMX_t (KA,IA,JA)
217 real(RP),
intent(in) :: MOMY_t (KA,IA,JA)
218 real(RP),
intent(in) :: RHOT_t (KA,IA,JA)
220 real(RP),
intent(in) :: DPRES0 (KA,IA,JA)
221 real(RP),
intent(in) :: RT2P (KA,IA,JA)
222 real(RP),
intent(in) :: CORIOLI (1, IA,JA)
223 real(RP),
intent(in) :: num_diff(KA,IA,JA,5,3)
224 real(RP),
intent(in) :: wdamp_coef(KA)
225 real(RP),
intent(in) :: divdmp_coef
226 real(RP),
intent(in) :: DDIV (KA,IA,JA)
228 logical,
intent(in) :: FLAG_FCT_MOMENTUM
229 logical,
intent(in) :: FLAG_FCT_T
230 logical,
intent(in) :: FLAG_FCT_ALONG_STREAM
232 real(RP),
intent(in) :: CDZ (KA)
233 real(RP),
intent(in) :: FDZ (KA-1)
234 real(RP),
intent(in) :: FDX (IA-1)
235 real(RP),
intent(in) :: FDY (JA-1)
236 real(RP),
intent(in) :: RCDZ(KA)
237 real(RP),
intent(in) :: RCDX(IA)
238 real(RP),
intent(in) :: RCDY(JA)
239 real(RP),
intent(in) :: RFDZ(KA-1)
240 real(RP),
intent(in) :: RFDX(IA-1)
241 real(RP),
intent(in) :: RFDY(JA-1)
243 real(RP),
intent(in) :: PHI (KA,IA,JA)
244 real(RP),
intent(in) :: GSQRT (KA,IA,JA,7)
245 real(RP),
intent(in) :: J13G (KA,IA,JA,7)
246 real(RP),
intent(in) :: J23G (KA,IA,JA,7)
247 real(RP),
intent(in) :: J33G
248 real(RP),
intent(in) :: MAPF (IA,JA,2,4)
249 real(RP),
intent(in) :: REF_dens(KA,IA,JA)
250 real(RP),
intent(in) :: REF_rhot(KA,IA,JA)
252 logical,
intent(in) :: BND_W
253 logical,
intent(in) :: BND_E
254 logical,
intent(in) :: BND_S
255 logical,
intent(in) :: BND_N
257 real(RP),
intent(in) :: dtrk
258 logical,
intent(in) :: last
261 real(RP) :: VELZ (KA,IA,JA)
262 real(RP) :: VELX (KA,IA,JA)
263 real(RP) :: VELY (KA,IA,JA)
264 real(RP) :: POTT (KA,IA,JA)
265 real(RP) :: DPRES(KA,IA,JA)
267 real(RP) :: qflx_J13(KA,IA,JA)
268 real(RP) :: qflx_J23(KA,IA,JA)
269 real(RP) :: pgf (KA,IA,JA)
270 real(RP) :: buoy (KA,IA,JA)
271 real(RP) :: cor (KA,IA,JA)
274 real(RP) :: qflx_hi (KA,IA,JA,3)
276 real(RP) :: qflx_lo (KA,IA,JA,3)
277 real(RP) :: qflx_anti(KA,IA,JA,3)
278 real(RP) :: tflx_lo (KA,IA,JA,3)
279 real(RP) :: tflx_anti(KA,IA,JA,3)
280 real(RP) :: DENS0_uvw(KA,IA,JA)
281 real(RP) :: DENS_uvw (KA,IA,JA)
288 real(RP) :: advch_t(KA,IA,JA,5)
289 real(RP) :: advcv_t(KA,IA,JA,5)
290 real(RP) :: wdmp_t(KA,IA,JA)
291 real(RP) :: ddiv_t(KA,IA,JA,3)
292 real(RP) :: pg_t(KA,IA,JA,3)
293 real(RP) :: cf_t(KA,IA,JA,2)
299 integer :: IFS_OFF, JFS_OFF
311 mflx_hi(:,:,:,:) = undef
312 tflx_hi(:,:,:,:) = undef
313 qflx_hi(:,:,:,:) = undef
316 qflx_lo(:,:,:,:) = undef
317 qflx_anti(:,:,:,:) = undef
318 tflx_lo(:,:,:,:) = undef
319 tflx_anti(:,:,:,:) = undef
323 #if defined DEBUG || defined QUICKDEBUG 324 dens_rk( 1:
ks-1,:,:) = undef
325 dens_rk(
ke+1:
ka ,:,:) = undef
326 momz_rk( 1:
ks-1,:,:) = undef
327 momz_rk(
ke+1:
ka ,:,:) = undef
328 momx_rk( 1:
ks-1,:,:) = undef
329 momx_rk(
ke+1:
ka ,:,:) = undef
330 momy_rk( 1:
ks-1,:,:) = undef
331 momy_rk(
ke+1:
ka ,:,:) = undef
332 rhot_rk( 1:
ks-1,:,:) = undef
333 rhot_rk(
ke+1:
ka ,:,:) = undef
334 prog_rk( 1:
ks-1,:,:,:) = undef
335 prog_rk(
ke+1:
ka ,:,:,:) = undef
351 if ( bnd_w ) ifs_off = 0
352 if ( bnd_s ) jfs_off = 0
367 call check( __line__, dpres0(k,i,j) )
368 call check( __line__, rt2p(k,i,j) )
369 call check( __line__, rhot(k,i,j) )
370 call check( __line__, ref_rhot(k,i,j) )
372 dpres(k,i,j) = dpres0(k,i,j) + rt2p(k,i,j) * ( rhot(k,i,j) - ref_rhot(k,i,j) )
374 dpres(
ks-1,i,j) = dpres0(
ks-1,i,j) - dens(
ks,i,j) * ( phi(
ks-1,i,j) - phi(
ks+1,i,j) )
375 dpres(
ke+1,i,j) = dpres0(
ke+1,i,j) - dens(
ke,i,j) * ( phi(
ke+1,i,j) - phi(
ke-1,i,j) )
379 k = iundef; i = iundef; j = iundef
386 call check( __line__, rhot(k,i,j) )
387 call check( __line__, dens(k,i,j) )
389 pott(k,i,j) = rhot(k,i,j) / dens(k,i,j)
394 k = iundef; i = iundef; j = iundef
401 if ( flag_fct_momentum )
then 408 call check( __line__, momz0(k,i,j) )
409 call check( __line__, dens0(k ,i,j) )
410 call check( __line__, dens0(k+1,i,j) )
412 velz(k,i,j) = 2.0_rp * momz0(k,i,j) / ( dens0(k+1,i,j)+dens0(k,i,j) )
417 k = iundef; i = iundef; j = iundef
422 velz(
ke,i,j) = 0.0_rp
426 k = iundef; i = iundef; j = iundef
434 call check( __line__, momx0(k,i,j) )
435 call check( __line__, dens0(k,i ,j) )
436 call check( __line__, dens0(k,i+1,j) )
438 velx(k,i,j) = 2.0_rp * momx0(k,i,j) / ( dens0(k,i+1,j)+dens0(k,i,j) )
443 k = iundef; i = iundef; j = iundef
451 call check( __line__, momy0(k,i,j) )
452 call check( __line__, dens0(k,i,j ) )
453 call check( __line__, dens0(k,i,j+1) )
455 vely(k,i,j) = 2.0_rp * momy0(k,i,j) / ( dens0(k,i,j+1)+dens0(k,i,j) )
460 k = iundef; i = iundef; j = iundef
462 call comm_vars8( velz(:,:,:), 4 )
463 call comm_vars8( velx(:,:,:), 5 )
464 call comm_vars8( vely(:,:,:), 6 )
486 call check( __line__, momz(k+1,i,j) )
487 call check( __line__, momz(k ,i,j) )
488 call check( __line__, momz(k-1,i,j) )
489 call check( __line__, num_diff(k,i,j,
i_dens,
zdir) )
491 mflx_hi(k,i,j,
zdir) = j33g * momz(k,i,j) / ( mapf(i,j,1,
i_xy)*mapf(i,j,2,
i_xy) ) &
492 + j13g(k,i,j,
i_xyw) * 0.25_rp * ( momx(k+1,i,j)+momx(k+1,i-1,j) &
493 + momx(k ,i,j)+momx(k ,i-1,j) ) &
495 + j23g(k,i,j,
i_xyw) * 0.25_rp * ( momy(k+1,i,j)+momy(k+1,i,j-1) &
496 + momy(k ,i,j)+momy(k ,i,j-1) ) &
498 + gsqrt(k,i,j,
i_xyw) * num_diff(k,i,j,
i_dens,
zdir) / ( mapf(i,j,1,
i_xy)*mapf(i,j,2,
i_xy) )
503 k = iundef; i = iundef; j = iundef
509 mflx_hi(
ks-1,i,j,
zdir) = 0.0_rp
510 mflx_hi(
ke ,i,j,
zdir) = 0.0_rp
514 k = iundef; i = iundef; j = iundef
521 do i = iis-ifs_off, min(iie,
ieh)
524 call check( __line__, momx(k,i+1,j) )
525 call check( __line__, momx(k,i ,j) )
526 call check( __line__, momx(k,i-1,j) )
527 call check( __line__, num_diff(k,i,j,
i_dens,
xdir) )
529 mflx_hi(k,i,j,
xdir) = gsqrt(k,i,j,
i_uyz) / mapf(i,j,2,
i_uy) &
530 * ( momx(k,i,j) + num_diff(k,i,j,
i_dens,
xdir) )
535 k = iundef; i = iundef; j = iundef
541 do j = jjs-jfs_off, min(jje,
jeh)
545 call check( __line__, momy(k,i,j+1) )
546 call check( __line__, momy(k,i,j ) )
547 call check( __line__, momy(k,i,j-1) )
548 call check( __line__, num_diff(k,i,j,
i_dens,
ydir) )
550 mflx_hi(k,i,j,
ydir) = gsqrt(k,i,j,
i_xvz) / mapf(i,j,1,
i_xv) &
551 * ( momy(k,i,j) + num_diff(k,i,j,
i_dens,
ydir) )
556 k = iundef; i = iundef; j = iundef
566 call check( __line__, dens0(k,i,j) )
567 call check( __line__, mflx_hi(k ,i ,j ,
zdir) )
568 call check( __line__, mflx_hi(k-1,i ,j ,
zdir) )
569 call check( __line__, mflx_hi(k ,i ,j ,
xdir) )
570 call check( __line__, mflx_hi(k ,i-1,j ,
xdir) )
571 call check( __line__, mflx_hi(k ,i ,j ,
ydir) )
572 call check( __line__, mflx_hi(k ,i ,j-1,
ydir) )
573 call check( __line__, dens_t(k,i,j) )
575 advcv = - ( mflx_hi(k,i,j,
zdir)-mflx_hi(k-1,i, j,
zdir) ) * rcdz(k)
576 advch = - ( mflx_hi(k,i,j,
xdir)-mflx_hi(k ,i-1,j,
xdir) ) * rcdx(i) &
577 - ( mflx_hi(k,i,j,
ydir)-mflx_hi(k ,i, j-1,
ydir) ) * rcdy(j)
578 dens_rk(k,i,j) = dens0(k,i,j) &
579 + dtrk * ( ( advcv + advch ) * mapf(i,j,1,
i_xy) * mapf(i,j,2,
i_xy) / gsqrt(k,i,j,
i_xyz) &
583 advcv_t(k,i,j,
i_dens) = advcv * mapf(i,j,1,
i_xy) * mapf(i,j,2,
i_xy) / gsqrt(k,i,j,
i_xyz)
584 advch_t(k,i,j,
i_dens) = advch * mapf(i,j,1,
i_xy) * mapf(i,j,2,
i_xy) / gsqrt(k,i,j,
i_xyz)
591 k = iundef; i = iundef; j = iundef
605 gsqrt(:,:,:,
i_xyz), j33g, &
611 gsqrt(:,:,:,
i_xyz), j13g(:,:,:,
i_xyz), mapf(:,:,:,
i_xy), &
616 gsqrt(:,:,:,
i_xyz), j23g(:,:,:,
i_xyz), mapf(:,:,:,
i_xy), &
642 pgf(k,i,j) = j33g * ( dpres(k+1,i,j)-dpres(k,i,j) ) * rfdz(k)
653 buoy(k,i,j) = grav * gsqrt(k,i,j,
i_xyw) &
654 * ( f2h(k,1,
i_xyz) * ( dens(k+1,i,j)-ref_dens(k+1,i,j) ) &
655 + f2h(k,2,
i_xyz) * ( dens(k ,i,j)-ref_dens(k ,i,j) ) )
667 call check( __line__, qflx_hi(k ,i ,j ,
zdir) )
668 call check( __line__, qflx_hi(k-1,i ,j ,
zdir) )
669 call check( __line__, qflx_hi(k ,i ,j ,
xdir) )
670 call check( __line__, qflx_hi(k ,i-1,j ,
xdir) )
671 call check( __line__, qflx_hi(k ,i ,j ,
ydir) )
672 call check( __line__, qflx_hi(k ,i ,j-1,
ydir) )
673 call check( __line__, ddiv(k ,i,j) )
674 call check( __line__, ddiv(k+1,i,j) )
675 call check( __line__, momz0(k,i,j) )
676 call check( __line__, momz_t(k,i,j) )
678 advcv = - ( qflx_hi(k,i,j,
zdir) - qflx_hi(k-1,i ,j ,
zdir) &
679 + qflx_j13(k,i,j) - qflx_j13(k-1,i,j) &
680 + qflx_j23(k,i,j) - qflx_j23(k-1,i,j) ) * rfdz(k)
681 advch = - ( ( qflx_hi(k,i,j,
xdir) - qflx_hi(k,i-1,j,
xdir) ) * rcdx(i) &
682 + ( qflx_hi(k,i,j,
ydir) - qflx_hi(k,i,j-1,
ydir) ) * rcdy(j) ) &
683 * mapf(i,j,1,
i_xy) * mapf(i,j,2,
i_xy)
684 wdamp = - wdamp_coef(k) * momz0(k,i,j)
685 div = divdmp_coef / dtrk * fdz(k) * ( ddiv(k+1,i,j)-ddiv(k,i,j) )
686 momz_rk(k,i,j) = momz0(k,i,j) &
687 + dtrk * ( ( advcv + advch &
690 ) / gsqrt(k,i,j,
i_xyw) &
698 pg_t(k,i,j,1) = ( - pgf(k,i,j) - buoy(k,i,j) ) / gsqrt(k,i,j,
i_xyw)
699 wdmp_t(k,i,j) = wdamp
700 ddiv_t(k,i,j,1) = div
707 k = iundef; i = iundef; j = iundef
713 momz_rk(
ks-1,i,j) = 0.0_rp
714 momz_rk(
ke ,i,j) = 0.0_rp
719 pg_t(
ke,i,j,1) = 0.0_rp
720 wdmp_t(
ke,i,j) = 0.0_rp
721 ddiv_t(
ke,i,j,1) = 0.0_rp
727 k = iundef; i = iundef; j = iundef
731 if ( flag_fct_momentum )
then 738 gsqrt(:,:,:,
i_xyz), j33g, &
741 iis-1, iie+1, jjs-1, jje+1 )
748 iis-1, iie+1, jjs-1, jje+1 )
755 iis-1, iie+1, jjs-1, jje+1 )
761 if ( flag_fct_momentum )
then 763 call comm_vars8( dens_rk, 1 )
764 call comm_wait ( dens_rk, 1, .false. )
769 qflx_hi(k,i,j,
zdir) = qflx_hi(k,i,j,
zdir) / ( mapf(i,j,1,
i_xy) * mapf(i,j,2,
i_xy) ) &
770 + qflx_j13(k,i,j) + qflx_j23(k,i,j)
778 dens0_uvw(k,i,j) = 0.5_rp * ( dens0(k,i,j) + dens0(k+1,i,j) )
779 dens_uvw(k,i,j) = 0.5_rp * ( dens_rk(k,i,j) + dens_rk(k+1,i,j) )
786 dens_uvw(
ke,i,j) = dens_uvw(
ke-1,i,j)
787 dens0_uvw(
ke,i,j) = dens0_uvw(
ke-1,i,j)
791 call comm_wait ( velz(:,:,:), 4 )
794 velz, dens0_uvw, dens_uvw, &
798 gsqrt(:,:,:,
i_xyw), &
799 mapf(:,:,:,
i_xy), dtrk, &
800 flag_fct_along_stream )
812 momz_rk(k,i,j) = momz_rk(k,i,j) &
813 + dtrk * ( ( qflx_anti(k,i,j,
zdir) - qflx_anti(k-1,i ,j ,
zdir) ) * rfdz(k) &
814 + ( ( qflx_anti(k,i,j,
xdir) - qflx_anti(k ,i-1,j ,
xdir) ) * rcdx(i) &
815 + ( qflx_anti(k,i,j,
ydir) - qflx_anti(k ,i ,j-1,
ydir) ) * rcdy(j) ) &
816 * mapf(i,j,1,
i_xy) * mapf(i,j,2,
i_xy) ) &
828 qflx_hi(:,:,:,:) = undef
846 gsqrt(:,:,:,
i_uyw), j33g, &
852 gsqrt(:,:,:,
i_uyz), j13g(:,:,:,
i_uyw), mapf(:,:,:,
i_uy), &
857 gsqrt(:,:,:,
i_uyz), j23g(:,:,:,
i_uyw), mapf(:,:,:,
i_uy), &
883 pgf(k,i,j) = ( ( gsqrt(k,i+1,j,
i_xyz) * dpres(k,i+1,j) &
884 - gsqrt(k,i ,j,
i_xyz) * dpres(k,i ,j) &
886 + ( j13g(k ,i,j,
i_uyw) &
887 * 0.5_rp * ( f2h(k,1,
i_uyz) * ( dpres(k+1,i+1,j)+dpres(k+1,i,j) ) &
888 + f2h(k,2,
i_uyz) * ( dpres(k ,i+1,j)+dpres(k ,i,j) ) ) &
889 - j13g(k-1,i,j,
i_uyw) &
890 * 0.5_rp * ( f2h(k,1,
i_uyz) * ( dpres(k ,i+1,j)+dpres(k ,i,j) ) &
891 + f2h(k,2,
i_uyz) * ( dpres(k-1,i+1,j)+dpres(k-1,i,j) ) ) &
905 call check( __line__, momy(k,i ,j ) )
906 call check( __line__, momy(k,i+1,j ) )
907 call check( __line__, momy(k,i ,j-1) )
908 call check( __line__, momy(k,i+1,j-1) )
910 cor(k,i,j) = 0.125_rp * ( corioli(1,i+1,j )+corioli(1,i,j ) ) &
911 * ( momy(k,i+1,j )+momy(k,i,j ) &
912 + momy(k,i+1,j-1)+momy(k,i,j-1) ) &
913 + 0.25_rp * mapf(i,j,1,
i_uy) * mapf(i,j,2,
i_uy) &
914 * ( momy(k,i,j) + momy(k,i,j-1) + momy(k,i+1,j) + momy(k,i+1,j-1) ) &
915 * ( ( momy(k,i,j) + momy(k,i,j-1) + momy(k,i+1,j) + momy(k,i+1,j-1) ) * 0.25_rp &
916 * ( 1.0_rp/mapf(i+1,j,2,
i_xy) - 1.0_rp/mapf(i,j,2,
i_xy) ) * rfdx(i) &
918 * ( 1.0_rp/mapf(i,j,1,
i_uv) - 1.0_rp/mapf(i,j-1,1,
i_uv) ) * rcdy(j) ) &
919 * 2.0_rp / ( dens(k,i+1,j) + dens(k,i,j) )
928 do i = iis, min(iie,
ieh)
931 call check( __line__, qflx_hi(k ,i ,j ,
zdir) )
932 call check( __line__, qflx_hi(k-1,i ,j ,
zdir) )
933 call check( __line__, qflx_hi(k ,i ,j ,
xdir) )
934 call check( __line__, qflx_hi(k ,i-1,j ,
xdir) )
935 call check( __line__, qflx_hi(k ,i ,j ,
ydir) )
936 call check( __line__, qflx_hi(k ,i ,j-1,
ydir) )
937 call check( __line__, ddiv(k,i+1,j) )
938 call check( __line__, ddiv(k,i ,j) )
939 call check( __line__, momx0(k,i,j) )
942 advcv = - ( qflx_hi(k,i,j,
zdir) - qflx_hi(k-1,i ,j ,
zdir) &
943 + qflx_j13(k,i,j) - qflx_j13(k-1,i,j) &
944 + qflx_j23(k,i,j) - qflx_j23(k-1,i,j) ) * rcdz(k)
945 advch = - ( ( qflx_hi(k,i,j,
xdir) - qflx_hi(k ,i-1,j ,
xdir) ) * rfdx(i) &
946 + ( qflx_hi(k,i,j,
ydir) - qflx_hi(k ,i ,j-1,
ydir) ) * rcdy(j) ) &
947 * mapf(i,j,1,
i_uy) * mapf(i,j,2,
i_uy)
948 div = divdmp_coef / dtrk * fdx(i) * ( ddiv(k,i+1,j)-ddiv(k,i,j) )
949 momx_rk(k,i,j) = momx0(k,i,j) &
950 + dtrk * ( ( advcv + advch &
952 ) / gsqrt(k,i,j,
i_uyz) &
960 pg_t(k,i,j,2) = - pgf(k,i,j) / gsqrt(k,i,j,
i_uyz)
961 cf_t(k,i,j,1) = cor(k,i,j)
962 ddiv_t(k,i,j,2) = div
969 k = iundef; i = iundef; j = iundef
973 if ( flag_fct_momentum )
then 977 gsqrt(:,:,:,
i_uyw), j33g, &
980 iis-1, iie+1, jjs-1, jje+1 )
988 iis-1, iie+1, jjs-1, jje+1 )
995 iis-1, iie+1, jjs-1, jje+1 )
1001 if ( flag_fct_momentum )
then 1006 qflx_hi(k,i,j,
zdir) = qflx_hi(k,i,j,
zdir) / ( mapf(i,j,1,
i_uy) * mapf(i,j,2,
i_uy) )&
1007 + qflx_j13(k,i,j) + qflx_j23(k,i,j)
1015 dens0_uvw(k,i,j) = 0.5_rp * ( dens0(k,i,j) + dens0(k,i+1,j) )
1016 dens_uvw(k,i,j) = 0.5_rp * ( dens_rk(k,i,j) + dens_rk(k,i+1,j) )
1021 call comm_wait ( velx(:,:,:), 5 )
1024 velx, dens0_uvw, dens_uvw, &
1028 gsqrt(:,:,:,
i_uyz), &
1029 mapf(:,:,:,
i_uy), dtrk, &
1030 flag_fct_along_stream )
1040 do i = iis, min(iie,
ieh)
1043 call check( __line__, momx_rk(k,i,j) )
1044 call check( __line__, qflx_anti(k ,i ,j ,
zdir) )
1045 call check( __line__, qflx_anti(k-1,i ,j ,
zdir) )
1046 call check( __line__, qflx_anti(k ,i ,j ,
xdir) )
1047 call check( __line__, qflx_anti(k ,i-1,j ,
xdir) )
1048 call check( __line__, qflx_anti(k ,i ,j ,
ydir) )
1049 call check( __line__, qflx_anti(k ,i ,j-1,
ydir) )
1051 momx_rk(k,i,j) = momx_rk(k,i,j) &
1052 + dtrk * ( ( ( qflx_anti(k,i,j,
zdir) - qflx_anti(k-1,i ,j ,
zdir) ) * rcdz(k) &
1053 + ( qflx_anti(k,i,j,
xdir) - qflx_anti(k ,i-1,j ,
xdir) ) * rfdx(i) &
1054 + ( qflx_anti(k,i,j,
ydir) - qflx_anti(k ,i ,j-1,
ydir) ) * rcdy(j) ) ) &
1055 * mapf(i,j,1,
i_uy) * mapf(i,j,2,
i_uy) &
1056 / gsqrt(k,i,j,
i_uyz)
1061 k = iundef; i = iundef; j = iundef
1068 qflx_lo(:,:,:,:) = undef
1069 qflx_anti(:,:,:,:) = undef
1075 qflx_hi(:,:,:,:) = undef
1093 gsqrt(:,:,:,
i_xvw), j33g, &
1096 iis, iie, jjs, jje )
1099 gsqrt(:,:,:,
i_xvz), j13g(:,:,:,
i_xvw), mapf(:,:,:,
i_xv), &
1101 iis, iie, jjs, jje )
1104 gsqrt(:,:,:,
i_xvz), j23g(:,:,:,
i_xvw), mapf(:,:,:,
i_xv), &
1106 iis, iie, jjs, jje )
1114 iis, iie, jjs, jje )
1123 iis, iie, jjs, jje )
1131 pgf(k,i,j) = ( ( gsqrt(k,i,j+1,
i_xyz) * dpres(k,i,j+1) &
1132 - gsqrt(k,i,j ,
i_xyz) * dpres(k,i,j ) &
1134 + ( j23g(k ,i,j,
i_xvw) &
1135 * 0.5_rp * ( f2h(k ,1,
i_xvz) * ( dpres(k+1,i,j+1)+dpres(k+1,i,j) ) &
1136 + f2h(k ,2,
i_xvz) * ( dpres(k ,i,j+1)+dpres(k ,i,j) ) ) &
1137 - j23g(k-1,i,j,
i_xvw) &
1138 * 0.5_rp * ( f2h(k-1,1,
i_xvz) * ( dpres(k ,i,j+1)+dpres(k ,i,j) ) &
1139 + f2h(k-1,2,
i_xvz) * ( dpres(k-1,i,j+1)+dpres(k-1,i,j) ) ) &
1153 call check( __line__, momx(k,i ,j ) )
1154 call check( __line__, momx(k,i ,j+1) )
1155 call check( __line__, momx(k,i-1,j ) )
1156 call check( __line__, momx(k,i-1,j+1) )
1158 cor(k,i,j) = - 0.125_rp * ( corioli(1,i ,j+1)+corioli(1,i ,j) ) &
1159 * ( momx(k,i ,j+1)+momx(k,i ,j) &
1160 + momx(k,i-1,j+1)+momx(k,i-1,j) ) &
1161 - 0.25_rp * mapf(i,j,1,
i_xv) * mapf(i,j,2,
i_xv) &
1162 * ( momx(k,i,j) + momx(k,i-1,j) + momx(k,i,j+1) + momx(k,i-1,j+1) )&
1164 * ( 1.0_rp/mapf(i,j,2,
i_uv) - 1.0_rp/mapf(i-1,j,2,
i_uv) ) * rcdx(i) &
1165 - 0.25_rp * ( momx(k,i,j)+momx(k,i-1,j)+momx(k,i,j+1)+momx(k,i-1,j+1) ) &
1166 * ( 1.0_rp/mapf(i,j+1,1,
i_xy) - 1.0_rp/mapf(i,j,1,
i_xy) ) * rfdy(j) ) &
1167 * 2.0_rp / ( dens(k,i,j) + dens(k,i,j+1) )
1175 do j = jjs, min(jje,
jeh)
1179 call check( __line__, qflx_hi(k ,i ,j ,
zdir) )
1180 call check( __line__, qflx_hi(k-1,i ,j ,
zdir) )
1181 call check( __line__, qflx_hi(k ,i ,j ,
xdir) )
1182 call check( __line__, qflx_hi(k ,i-1,j ,
xdir) )
1183 call check( __line__, qflx_hi(k ,i ,j ,
ydir) )
1184 call check( __line__, qflx_hi(k ,i ,j-1,
ydir) )
1185 call check( __line__, ddiv(k,i,j+1) )
1186 call check( __line__, ddiv(k,i,j ) )
1187 call check( __line__, momy_t(k,i,j) )
1188 call check( __line__, momy0(k,i,j) )
1191 advcv = - ( qflx_hi(k,i,j,
zdir) - qflx_hi(k-1,i ,j ,
zdir) &
1192 + qflx_j13(k,i,j) - qflx_j13(k-1,i,j) &
1193 + qflx_j23(k,i,j) - qflx_j23(k-1,i,j) ) * rcdz(k)
1194 advch = - ( ( qflx_hi(k,i,j,
xdir) - qflx_hi(k ,i-1,j ,
xdir) ) * rcdx(i) &
1195 + ( qflx_hi(k,i,j,
ydir) - qflx_hi(k ,i ,j-1,
ydir) ) * rfdy(j) ) &
1196 * mapf(i,j,1,
i_xv) * mapf(i,j,2,
i_xv)
1197 div = divdmp_coef / dtrk * fdy(j) * ( ddiv(k,i,j+1)-ddiv(k,i,j) )
1198 momy_rk(k,i,j) = momy0(k,i,j) &
1199 + dtrk * ( ( advcv + advch &
1201 ) / gsqrt(k,i,j,
i_xvz) &
1207 advcv_t(k,i,j,
i_momy) = advcv / gsqrt(k,i,j,
i_uyz)
1208 advch_t(k,i,j,
i_momy) = advch / gsqrt(k,i,j,
i_uyz)
1209 pg_t(k,i,j,3) = - pgf(k,i,j) / gsqrt(k,i,j,
i_uyz)
1210 cf_t(k,i,j,2) = cor(k,i,j)
1211 ddiv_t(k,i,j,3) = div
1218 k = iundef; i = iundef; j = iundef
1222 if ( flag_fct_momentum )
then 1227 momz, momy0, dens, &
1228 gsqrt(:,:,:,
i_xvz), j33g, &
1231 iis-1, iie+1, jjs-1, jje+1 )
1235 momx, momy0, dens, &
1239 iis-1, iie+1, jjs-1, jje+1 )
1244 momy, momy0, dens, &
1248 iis-1, iie+1, jjs-1, jje+1 )
1254 if ( flag_fct_momentum )
then 1259 qflx_hi(k,i,j,
zdir) = qflx_hi(k,i,j,
zdir) / ( mapf(i,j,1,
i_xv) * mapf(i,j,2,
i_xv) ) &
1260 + qflx_j13(k,i,j) + qflx_j23(k,i,j)
1268 dens0_uvw(k,i,j) = 0.5_rp * ( dens0(k,i,j) + dens0(k,i,j+1) )
1269 dens_uvw(k,i,j) = 0.5_rp * ( dens_rk(k,i,j) + dens_rk(k,i,j+1) )
1274 call comm_wait ( vely(:,:,:), 6 )
1277 vely, dens0_uvw, dens_uvw, &
1281 gsqrt(:,:,:,
i_xvz), &
1282 mapf(:,:,:,
i_xv), dtrk, &
1283 flag_fct_along_stream )
1292 do j = jjs, min(jje,
jeh)
1296 call check( __line__, momy_rk(k,i,j) )
1297 call check( __line__, qflx_anti(k ,i ,j ,
zdir) )
1298 call check( __line__, qflx_anti(k-1,i ,j ,
zdir) )
1299 call check( __line__, qflx_anti(k ,i ,j ,
xdir) )
1300 call check( __line__, qflx_anti(k ,i-1,j ,
xdir) )
1301 call check( __line__, qflx_anti(k ,i ,j ,
ydir) )
1302 call check( __line__, qflx_anti(k ,i ,j-1,
ydir) )
1304 momy_rk(k,i,j) = momy_rk(k,i,j) &
1305 + dtrk * ( ( ( qflx_anti(k,i,j,
zdir) - qflx_anti(k-1,i ,j ,
zdir) ) * rcdz(k) &
1306 + ( qflx_anti(k,i,j,
xdir) - qflx_anti(k ,i-1,j ,
xdir) ) * rcdx(i) &
1307 + ( qflx_anti(k,i,j,
ydir) - qflx_anti(k ,i ,j-1,
ydir) ) * rfdy(j) ) ) &
1308 * mapf(i,j,1,
i_xv) * mapf(i,j,2,
i_xv) &
1309 / gsqrt(k,i,j,
i_xvz)
1314 k = iundef; i = iundef; j = iundef
1321 qflx_lo(:,:,:,:) = undef
1322 qflx_anti(:,:,:,:) = undef
1327 qflx_hi(
ks:,:,:,:) = undef
1344 mflx_hi(:,:,:,
zdir), pott, gsqrt(:,:,:,
i_xyw), &
1347 iis, iie, jjs, jje )
1351 mflx_hi(:,:,:,
xdir), pott, gsqrt(:,:,:,
i_uyz), &
1354 iis, iie, jjs, jje )
1358 mflx_hi(:,:,:,
ydir), pott, gsqrt(:,:,:,
i_xvz), &
1361 iis, iie, jjs, jje )
1370 call check( __line__, tflx_hi(k ,i ,j ,
zdir) )
1371 call check( __line__, tflx_hi(k-1,i ,j ,
zdir) )
1372 call check( __line__, tflx_hi(k ,i ,j ,
xdir) )
1373 call check( __line__, tflx_hi(k ,i-1,j ,
xdir) )
1374 call check( __line__, tflx_hi(k ,i ,j ,
ydir) )
1375 call check( __line__, tflx_hi(k ,i ,j-1,
ydir) )
1376 call check( __line__, rhot_t(k,i,j) )
1377 call check( __line__, rhot0(k,i,j) )
1379 advcv = - ( tflx_hi(k,i,j,
zdir) - tflx_hi(k-1,i ,j ,
zdir) ) * rcdz(k)
1380 advch = - ( tflx_hi(k,i,j,
xdir) - tflx_hi(k ,i-1,j ,
xdir) ) * rcdx(i) &
1381 - ( tflx_hi(k,i,j,
ydir) - tflx_hi(k ,i ,j-1,
ydir) ) * rcdy(j)
1382 rhot_rk(k,i,j) = rhot0(k,i,j) &
1383 + dtrk * ( ( advcv + advch ) * mapf(i,j,1,
i_xy) * mapf(i,j,2,
i_xy) / gsqrt(k,i,j,
i_xyz) &
1387 advcv_t(k,i,j,
i_rhot) = advcv * mapf(i,j,1,
i_xy) * mapf(i,j,2,
i_xy)/ gsqrt(k,i,j,
i_xyz)
1388 advch_t(k,i,j,
i_rhot) = advch * mapf(i,j,1,
i_xy) * mapf(i,j,2,
i_xy)/ gsqrt(k,i,j,
i_xyz)
1395 k = iundef; i = iundef; j = iundef
1403 if ( flag_fct_t )
then 1405 call comm_vars8( mflx_hi(:,:,:,
zdir), 1 )
1406 call comm_vars8( mflx_hi(:,:,:,
xdir), 2 )
1407 call comm_vars8( mflx_hi(:,:,:,
ydir), 3 )
1408 call comm_wait ( mflx_hi(:,:,:,
zdir), 1, .false. )
1409 call comm_wait ( mflx_hi(:,:,:,
xdir), 2, .false. )
1410 call comm_wait ( mflx_hi(:,:,:,
ydir), 3, .false. )
1412 if ( .NOT. flag_fct_momentum )
then 1413 call comm_vars8( dens_rk, 1 )
1414 call comm_wait ( dens_rk, 1, .false. )
1421 pott(k,i,j) = rhot0(k,i,j) / dens0(k,i,j)
1434 mflx_hi(:,:,:,
zdir), pott, gsqrt(:,:,:,
i_xyz), &
1437 iis-1, iie+1, jjs-1, jje+1 )
1441 mflx_hi(:,:,:,
xdir), pott, gsqrt(:,:,:,
i_uyz), &
1444 iis-1, iie+1, jjs-1, jje+1 )
1448 mflx_hi(:,:,:,
ydir), pott, gsqrt(:,:,:,
i_xvz), &
1451 iis-1, iie+1, jjs-1, jje+1 )
1457 pott, dens0, dens_rk, &
1461 gsqrt(:,:,:,
i_xyz), &
1462 mapf(:,:,:,
i_xy), dtrk, &
1463 flag_fct_along_stream )
1476 call check( __line__, rhot_rk(k,i,j) )
1477 call check( __line__, tflx_anti(k ,i ,j ,
zdir) )
1478 call check( __line__, tflx_anti(k-1,i ,j ,
zdir) )
1479 call check( __line__, tflx_anti(k ,i ,j ,
xdir) )
1480 call check( __line__, tflx_anti(k ,i-1,j ,
xdir) )
1481 call check( __line__, tflx_anti(k ,i ,j ,
ydir) )
1482 call check( __line__, tflx_anti(k ,i ,j-1,
ydir) )
1484 rhot_rk(k,i,j) = rhot_rk(k,i,j) &
1485 + dtrk * ( ( tflx_anti(k,i,j,
zdir) - tflx_anti(k-1,i ,j ,
zdir) ) * rcdz(k) &
1486 + ( tflx_anti(k,i,j,
xdir) - tflx_anti(k ,i-1,j ,
xdir) ) * rcdx(i) &
1487 + ( tflx_anti(k,i,j,
ydir) - tflx_anti(k ,i ,j-1,
ydir) ) * rcdy(j) ) &
1488 * mapf(i,j,1,
i_xy) * mapf(i,j,2,
i_xy) &
1489 / gsqrt(k,i,j,
i_xyz)
1494 k = iundef; i = iundef; j = iundef
1503 call hist_in(advcv_t(:,:,:,
i_dens),
'DENS_t_advcv',
'tendency of density (vert. advection)',
'kg/m3/s' )
1504 call hist_in(advcv_t(:,:,:,
i_momz),
'MOMZ_t_advcv',
'tendency of momentum z (vert. advection)',
'kg/m2/s2', zdim=
'half')
1505 call hist_in(advcv_t(:,:,:,
i_momx),
'MOMX_t_advcv',
'tendency of momentum x (vert. advection)',
'kg/m2/s2', xdim=
'half')
1506 call hist_in(advcv_t(:,:,:,
i_momy),
'MOMY_t_advcv',
'tendency of momentum y (vert. advection)',
'kg/m2/s2', ydim=
'half')
1507 call hist_in(advcv_t(:,:,:,
i_rhot),
'RHOT_t_advcv',
'tendency of rho*theta (vert. advection)',
'K kg/m3/s' )
1509 call hist_in(advch_t(:,:,:,
i_dens),
'DENS_t_advch',
'tendency of density (horiz. advection)',
'kg/m3/s' )
1510 call hist_in(advch_t(:,:,:,
i_momz),
'MOMZ_t_advch',
'tendency of momentum z (horiz. advection)',
'kg/m2/s2', zdim=
'half')
1511 call hist_in(advch_t(:,:,:,
i_momx),
'MOMX_t_advch',
'tendency of momentum x (horiz. advection)',
'kg/m2/s2', xdim=
'half')
1512 call hist_in(advch_t(:,:,:,
i_momy),
'MOMY_t_advch',
'tendency of momentum y (horiz. advection)',
'kg/m2/s2', ydim=
'half')
1513 call hist_in(advch_t(:,:,:,
i_rhot),
'RHOT_t_advch',
'tendency of rho*theta (horiz. advection)',
'K kg/m3/s' )
1515 call hist_in(pg_t(:,:,:,1),
'MOMZ_t_pg',
'tendency of momentum z (pressure gradient)',
'kg/m2/s2', zdim=
'half')
1516 call hist_in(pg_t(:,:,:,2),
'MOMX_t_pg',
'tendency of momentum x (pressure gradient)',
'kg/m2/s2', xdim=
'half')
1517 call hist_in(pg_t(:,:,:,3),
'MOMY_t_pg',
'tendency of momentum y (pressure gradient)',
'kg/m2/s2', ydim=
'half')
1519 call hist_in(wdmp_t(:,:,:),
'MOMZ_t_wdamp',
'tendency of momentum z (Raileight damping)',
'kg/m2/s2', zdim=
'half')
1521 call hist_in(ddiv_t(:,:,:,1),
'MOMZ_t_ddiv',
'tendency of momentum z (divergence damping)',
'kg/m2/s2', zdim=
'half')
1522 call hist_in(ddiv_t(:,:,:,2),
'MOMX_t_ddiv',
'tendency of momentum x (divergence damping)',
'kg/m2/s2', xdim=
'half')
1523 call hist_in(ddiv_t(:,:,:,3),
'MOMY_t_ddiv',
'tendency of momentum y (divergence damping)',
'kg/m2/s2', ydim=
'half')
1525 call hist_in(cf_t(:,:,:,1),
'MOMX_t_cf',
'tendency of momentum x (coliolis force)',
'kg/m2/s2', xdim=
'half')
1526 call hist_in(cf_t(:,:,:,2),
'MOMY_t_cf',
'tendency of momentum y (coliolis force)',
'kg/m2/s2', ydim=
'half')
integer, parameter, public i_rhot
subroutine, public atmos_dyn_fvm_fluxx_xyw_ud1(flux, mom, val, DENS, GSQRT, MAPF, num_diff, CDZ, IIS, IIE, JJS, JJE)
calculation X-flux at XYW
integer, public is
start point of inner domain: x, local
integer, public je
end point of inner domain: y, local
subroutine, public atmos_dyn_fvm_fluxy_xyz_ud1(flux, mflx, val, GSQRT, num_diff, CDZ, IIS, IIE, JJS, JJE)
calculation Y-flux at XYZ
subroutine, public atmos_dyn_fvm_fluxy_xyw_ud1(flux, mom, val, DENS, GSQRT, MAPF, num_diff, CDZ, IIS, IIE, JJS, JJE)
calculation Y-flux at XYW
subroutine, public atmos_dyn_fvm_fluxz_xyz_ud1(flux, mflx, val, GSQRT, num_diff, CDZ, IIS, IIE, JJS, JJE)
calculation z-flux at XYZ
procedure(flux_mom), pointer, public atmos_dyn_fvm_fluxx_xvz
procedure(flux_j), pointer, public atmos_dyn_fvm_fluxj23_uyz
integer, public iblock
block size for cache blocking: x
integer, parameter, public i_momx
integer, parameter, public zdir
subroutine, public atmos_dyn_fvm_fluxy_xvz_ud1(flux, mom, val, DENS, GSQRT, MAPF, num_diff, CDZ, IIS, IIE, JJS, JJE)
calculation Y-flux at XV
integer, parameter, public i_momz
procedure(flux_j), pointer, public atmos_dyn_fvm_fluxj23_xyw
procedure(flux_phi), pointer, public atmos_dyn_fvm_fluxx_xyz
integer, parameter, public ydir
integer, public ke
end point of inner domain: z, local
procedure(flux_j), pointer, public atmos_dyn_fvm_fluxj13_xyw
integer, parameter, public xdir
integer, parameter, public i_dens
integer, parameter, public i_momy
procedure(flux_mom), pointer, public atmos_dyn_fvm_fluxx_xyw
procedure(flux_mom), pointer, public atmos_dyn_fvm_fluxy_xyw
subroutine, public atmos_dyn_fvm_fluxx_uyz_ud1(flux, mom, val, DENS, GSQRT, MAPF, num_diff, CDZ, IIS, IIE, JJS, JJE)
calculation X-flux at UY
procedure(flux_z), pointer, public atmos_dyn_fvm_fluxz_xvz
subroutine, public atmos_dyn_fvm_fluxz_xvz_ud1(flux, mom, val, DENS, GSQRT, J33G, num_diff, CDZ, IIS, IIE, JJS, JJE)
calculation z-flux at XV
integer, public ka
of whole cells: z, local, with HALO
real(rp), public const_pre00
pressure reference [Pa]
integer, public jblock
block size for cache blocking: y
integer, public jhalo
of halo cells: y
subroutine, public atmos_dyn_fvm_fluxz_uyz_ud1(flux, mom, val, DENS, GSQRT, J33G, num_diff, CDZ, IIS, IIE, JJS, JJE)
calculation z-flux at UY
real(rp), public const_grav
standard acceleration of gravity [m/s2]
integer, public js
start point of inner domain: y, local
module Atmosphere / Dynamics common
subroutine, public atmos_dyn_fvm_fluxy_uyz_ud1(flux, mom, val, DENS, GSQRT, MAPF, num_diff, CDZ, IIS, IIE, JJS, JJE)
calculation Y-flux at UY
subroutine, public atmos_dyn_fvm_fluxx_xvz_ud1(flux, mom, val, DENS, GSQRT, MAPF, num_diff, CDZ, IIS, IIE, JJS, JJE)
calculation X-flux at XV
integer, public ks
start point of inner domain: z, local
procedure(flux_j), pointer, public atmos_dyn_fvm_fluxj13_xvz
integer, public jeh
end point of inner domain: y, local (half level)
integer, public ieh
end point of inner domain: x, local (half level)
integer, public ie
end point of inner domain: x, local
real(rp), public const_eps
small number
procedure(flux_z), pointer, public atmos_dyn_fvm_fluxz_uyz
module scale_atmos_dyn_fvm_flux
subroutine, public atmos_dyn_fct(qflx_anti, phi_in, DENS0, DENS, qflx_hi, qflx_lo, mflx_hi, rdz, rdx, rdy, GSQRT, MAPF, dt, flag_vect)
Flux Correction Transport Limiter.
procedure(flux_j), pointer, public atmos_dyn_fvm_fluxj13_uyz
procedure(flux_j), pointer, public atmos_dyn_fvm_fluxj23_xvz
procedure(flux_phi), pointer, public atmos_dyn_fvm_fluxz_xyz
procedure(flux_mom), pointer, public atmos_dyn_fvm_fluxx_uyz
subroutine, public atmos_dyn_fvm_fluxz_xyw_ud1(flux, mom, val, DENS, GSQRT, J33G, num_diff, CDZ, FDZ, dtrk, IIS, IIE, JJS, JJE)
calculation z-flux at XYW
procedure(flux_phi), pointer, public atmos_dyn_fvm_fluxy_xyz
procedure(flux_mom), pointer, public atmos_dyn_fvm_fluxy_uyz
subroutine, public atmos_dyn_fvm_fluxx_xyz_ud1(flux, mflx, val, GSQRT, num_diff, CDZ, IIS, IIE, JJS, JJE)
calculation X-flux at XYZ
procedure(flux_wz), pointer, public atmos_dyn_fvm_fluxz_xyw
integer, public ihalo
of halo cells: x
module scale_atmos_dyn_fvm_flux_ud1
procedure(flux_mom), pointer, public atmos_dyn_fvm_fluxy_xvz