185 real(RP),
intent(out) :: dens_rk (
ka,
ia,
ja)
186 real(RP),
intent(out) :: momz_rk (
ka,
ia,
ja)
187 real(RP),
intent(out) :: momx_rk (
ka,
ia,
ja)
188 real(RP),
intent(out) :: momy_rk (
ka,
ia,
ja)
189 real(RP),
intent(out) :: rhot_rk (
ka,
ia,
ja)
190 real(RP),
intent(out) :: prog_rk (
ka,
ia,
ja,
va)
192 real(RP),
intent(inout) :: mflx_hi (
ka,
ia,
ja,3)
193 real(RP),
intent(out) :: tflx_hi (
ka,
ia,
ja,3)
195 real(RP),
intent(in),
target :: dens0 (
ka,
ia,
ja)
196 real(RP),
intent(in),
target :: momz0 (
ka,
ia,
ja)
197 real(RP),
intent(in),
target :: momx0 (
ka,
ia,
ja)
198 real(RP),
intent(in),
target :: momy0 (
ka,
ia,
ja)
199 real(RP),
intent(in),
target :: rhot0 (
ka,
ia,
ja)
200 real(RP),
intent(in) :: prog0 (
ka,
ia,
ja,
va)
202 real(RP),
intent(in) :: dens (
ka,
ia,
ja)
203 real(RP),
intent(in) :: momz (
ka,
ia,
ja)
204 real(RP),
intent(in) :: momx (
ka,
ia,
ja)
205 real(RP),
intent(in) :: momy (
ka,
ia,
ja)
206 real(RP),
intent(in) :: rhot (
ka,
ia,
ja)
207 real(RP),
intent(in) :: prog (
ka,
ia,
ja,
va)
209 real(RP),
intent(in) :: dens_t (
ka,
ia,
ja)
210 real(RP),
intent(in) :: momz_t (
ka,
ia,
ja)
211 real(RP),
intent(in) :: momx_t (
ka,
ia,
ja)
212 real(RP),
intent(in) :: momy_t (
ka,
ia,
ja)
213 real(RP),
intent(in) :: rhot_t (
ka,
ia,
ja)
215 real(RP),
intent(in) :: dpres0 (
ka,
ia,
ja)
216 real(RP),
intent(in) :: rt2p (
ka,
ia,
ja)
217 real(RP),
intent(in) :: corioli (1,
ia,
ja)
218 real(RP),
intent(in) :: num_diff(
ka,
ia,
ja,5,3)
219 real(RP),
intent(in) :: divdmp_coef
220 real(RP),
intent(in) :: ddiv (
ka,
ia,
ja)
222 logical,
intent(in) :: flag_fct_momentum
223 logical,
intent(in) :: flag_fct_t
224 logical,
intent(in) :: flag_fct_along_stream
226 real(RP),
intent(in) :: cdz (
ka)
227 real(RP),
intent(in) :: fdz (
ka-1)
228 real(RP),
intent(in) :: fdx (
ia-1)
229 real(RP),
intent(in) :: fdy (
ja-1)
230 real(RP),
intent(in) :: rcdz(
ka)
231 real(RP),
intent(in) :: rcdx(
ia)
232 real(RP),
intent(in) :: rcdy(
ja)
233 real(RP),
intent(in) :: rfdz(
ka-1)
234 real(RP),
intent(in) :: rfdx(
ia-1)
235 real(RP),
intent(in) :: rfdy(
ja-1)
237 real(RP),
intent(in) :: phi (
ka,
ia,
ja)
238 real(RP),
intent(in) :: gsqrt (
ka,
ia,
ja,7)
239 real(RP),
intent(in) :: j13g (
ka,
ia,
ja,7)
240 real(RP),
intent(in) :: j23g (
ka,
ia,
ja,7)
241 real(RP),
intent(in) :: j33g
242 real(RP),
intent(in) :: mapf (
ia,
ja,2,4)
243 real(RP),
intent(in) :: ref_dens(
ka,
ia,
ja)
244 real(RP),
intent(in) :: ref_rhot(
ka,
ia,
ja)
246 logical,
intent(in) :: bnd_w
247 logical,
intent(in) :: bnd_e
248 logical,
intent(in) :: bnd_s
249 logical,
intent(in) :: bnd_n
251 real(RP),
intent(in) :: dtrk
252 real(RP),
intent(in) :: dt
255 real(RP) :: velz (
ka,
ia,
ja)
256 real(RP) :: velx (
ka,
ia,
ja)
257 real(RP) :: vely (
ka,
ia,
ja)
258 real(RP) :: pott (
ka,
ia,
ja)
259 real(RP) :: dpres(
ka,
ia,
ja)
261 real(RP) :: qflx_j13(
ka,
ia,
ja)
262 real(RP) :: qflx_j23(
ka,
ia,
ja)
263 real(RP) :: pgf (
ka,
ia,
ja)
264 real(RP) :: buoy (
ka,
ia,
ja)
265 real(RP) :: cor (
ka,
ia,
ja)
268 real(RP) :: qflx_hi (
ka,
ia,
ja,3)
270 real(RP) :: qflx_lo (
ka,
ia,
ja,3)
271 real(RP) :: qflx_anti(
ka,
ia,
ja,3)
272 real(RP) :: tflx_lo (
ka,
ia,
ja,3)
273 real(RP) :: tflx_anti(
ka,
ia,
ja,3)
274 real(RP) :: dens0_uvw(
ka,
ia,
ja)
275 real(RP) :: dens_uvw (
ka,
ia,
ja)
281 real(RP) :: advch_t(
ka,
ia,
ja,5)
282 real(RP) :: advcv_t(
ka,
ia,
ja,5)
283 real(RP) :: ddiv_t(
ka,
ia,
ja,3)
284 real(RP) :: pg_t(
ka,
ia,
ja,3)
285 real(RP) :: cf_t(
ka,
ia,
ja,2)
291 integer :: ifs_off, jfs_off
303 mflx_hi(:,:,:,:) = undef
304 tflx_hi(:,:,:,:) = undef
305 qflx_hi(:,:,:,:) = undef
308 qflx_lo(:,:,:,:) = undef
309 qflx_anti(:,:,:,:) = undef
310 tflx_lo(:,:,:,:) = undef
311 tflx_anti(:,:,:,:) = undef
327 if ( bnd_w ) ifs_off = 0
328 if ( bnd_s ) jfs_off = 0
343 call check( __line__, dpres0(k,i,j) )
344 call check( __line__, rt2p(k,i,j) )
345 call check( __line__, rhot(k,i,j) )
346 call check( __line__, ref_rhot(k,i,j) )
348 dpres(k,i,j) = dpres0(k,i,j) + rt2p(k,i,j) * ( rhot(k,i,j) - ref_rhot(k,i,j) )
350 dpres(
ks-1,i,j) = dpres0(
ks-1,i,j) - dens(
ks,i,j) * ( phi(
ks-1,i,j) - phi(
ks+1,i,j) )
351 dpres(
ke+1,i,j) = dpres0(
ke+1,i,j) - dens(
ke,i,j) * ( phi(
ke+1,i,j) - phi(
ke-1,i,j) )
355 k = iundef; i = iundef; j = iundef
362 call check( __line__, rhot(k,i,j) )
363 call check( __line__, dens(k,i,j) )
365 pott(k,i,j) = rhot(k,i,j) / dens(k,i,j)
370 k = iundef; i = iundef; j = iundef
377 if ( flag_fct_momentum )
then 384 call check( __line__, momz0(k,i,j) )
385 call check( __line__, dens0(k ,i,j) )
386 call check( __line__, dens0(k+1,i,j) )
388 velz(k,i,j) = 2.0_rp * momz0(k,i,j) / ( dens0(k+1,i,j)+dens0(k,i,j) )
393 k = iundef; i = iundef; j = iundef
398 velz(
ke,i,j) = 0.0_rp
402 k = iundef; i = iundef; j = iundef
410 call check( __line__, momx0(k,i,j) )
411 call check( __line__, dens0(k,i ,j) )
412 call check( __line__, dens0(k,i+1,j) )
414 velx(k,i,j) = 2.0_rp * momx0(k,i,j) / ( dens0(k,i+1,j)+dens0(k,i,j) )
419 k = iundef; i = iundef; j = iundef
427 call check( __line__, momy0(k,i,j) )
428 call check( __line__, dens0(k,i,j ) )
429 call check( __line__, dens0(k,i,j+1) )
431 vely(k,i,j) = 2.0_rp * momy0(k,i,j) / ( dens0(k,i,j+1)+dens0(k,i,j) )
436 k = iundef; i = iundef; j = iundef
438 call comm_vars8( velz(:,:,:), 4 )
439 call comm_vars8( velx(:,:,:), 5 )
440 call comm_vars8( vely(:,:,:), 6 )
462 call check( __line__, momz(k+1,i,j) )
463 call check( __line__, momz(k ,i,j) )
464 call check( __line__, momz(k-1,i,j) )
465 call check( __line__, num_diff(k,i,j,
i_dens,
zdir) )
467 mflx_hi(k,i,j,
zdir) = j33g * momz(k,i,j) / ( mapf(i,j,1,
i_xy)*mapf(i,j,2,
i_xy) ) &
468 + j13g(k,i,j,
i_xyw) * 0.25_rp * ( momx(k+1,i,j)+momx(k+1,i-1,j) &
469 + momx(k ,i,j)+momx(k ,i-1,j) ) &
471 + j23g(k,i,j,
i_xyw) * 0.25_rp * ( momy(k+1,i,j)+momy(k+1,i,j-1) &
472 + momy(k ,i,j)+momy(k ,i,j-1) ) &
474 + 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) )
479 k = iundef; i = iundef; j = iundef
485 mflx_hi(
ks-1,i,j,
zdir) = 0.0_rp
486 mflx_hi(
ke ,i,j,
zdir) = 0.0_rp
490 k = iundef; i = iundef; j = iundef
497 do i = iis-ifs_off, min(iie,
ieh)
500 call check( __line__, momx(k,i+1,j) )
501 call check( __line__, momx(k,i ,j) )
502 call check( __line__, momx(k,i-1,j) )
503 call check( __line__, num_diff(k,i,j,
i_dens,
xdir) )
505 mflx_hi(k,i,j,
xdir) = gsqrt(k,i,j,
i_uyz) / mapf(i,j,2,
i_uy) &
506 * ( momx(k,i,j) + num_diff(k,i,j,
i_dens,
xdir) )
511 k = iundef; i = iundef; j = iundef
517 do j = jjs-jfs_off, min(jje,
jeh)
521 call check( __line__, momy(k,i,j+1) )
522 call check( __line__, momy(k,i,j ) )
523 call check( __line__, momy(k,i,j-1) )
524 call check( __line__, num_diff(k,i,j,
i_dens,
ydir) )
526 mflx_hi(k,i,j,
ydir) = gsqrt(k,i,j,
i_xvz) / mapf(i,j,1,
i_xv) &
527 * ( momy(k,i,j) + num_diff(k,i,j,
i_dens,
ydir) )
532 k = iundef; i = iundef; j = iundef
542 call check( __line__, dens0(k,i,j) )
543 call check( __line__, mflx_hi(k ,i ,j ,
zdir) )
544 call check( __line__, mflx_hi(k-1,i ,j ,
zdir) )
545 call check( __line__, mflx_hi(k ,i ,j ,
xdir) )
546 call check( __line__, mflx_hi(k ,i-1,j ,
xdir) )
547 call check( __line__, mflx_hi(k ,i ,j ,
ydir) )
548 call check( __line__, mflx_hi(k ,i ,j-1,
ydir) )
549 call check( __line__, dens_t(k,i,j) )
551 advcv = - ( mflx_hi(k,i,j,
zdir)-mflx_hi(k-1,i, j,
zdir) ) * rcdz(k)
552 advch = - ( mflx_hi(k,i,j,
xdir)-mflx_hi(k ,i-1,j,
xdir) ) * rcdx(i) &
553 - ( mflx_hi(k,i,j,
ydir)-mflx_hi(k ,i, j-1,
ydir) ) * rcdy(j)
554 dens_rk(k,i,j) = dens0(k,i,j) &
555 + dtrk * ( ( advcv + advch ) * mapf(i,j,1,
i_xy) * mapf(i,j,2,
i_xy) / gsqrt(k,i,j,
i_xyz) &
559 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)
560 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)
567 k = iundef; i = iundef; j = iundef
581 gsqrt(:,:,:,
i_xyz), j33g, &
587 gsqrt(:,:,:,
i_xyz), j13g(:,:,:,
i_xyz), mapf(:,:,:,
i_xy), &
592 gsqrt(:,:,:,
i_xyz), j23g(:,:,:,
i_xyz), mapf(:,:,:,
i_xy), &
618 pgf(k,i,j) = j33g * ( dpres(k+1,i,j)-dpres(k,i,j) ) * rfdz(k)
629 buoy(k,i,j) = grav * gsqrt(k,i,j,
i_xyw) &
630 * ( f2h(k,1,
i_xyz) * ( dens(k+1,i,j)-ref_dens(k+1,i,j) ) &
631 + f2h(k,2,
i_xyz) * ( dens(k ,i,j)-ref_dens(k ,i,j) ) )
643 call check( __line__, qflx_hi(k ,i ,j ,
zdir) )
644 call check( __line__, qflx_hi(k-1,i ,j ,
zdir) )
645 call check( __line__, qflx_hi(k ,i ,j ,
xdir) )
646 call check( __line__, qflx_hi(k ,i-1,j ,
xdir) )
647 call check( __line__, qflx_hi(k ,i ,j ,
ydir) )
648 call check( __line__, qflx_hi(k ,i ,j-1,
ydir) )
649 call check( __line__, ddiv(k ,i,j) )
650 call check( __line__, ddiv(k+1,i,j) )
651 call check( __line__, momz0(k,i,j) )
652 call check( __line__, momz_t(k,i,j) )
654 advcv = - ( qflx_hi(k,i,j,
zdir) - qflx_hi(k-1,i ,j ,
zdir) ) * rfdz(k)
655 advch = - ( ( qflx_j13(k,i,j) - qflx_j13(k-1,i,j) &
656 + qflx_j23(k,i,j) - qflx_j23(k-1,i,j) ) * rfdz(k) &
657 + ( qflx_hi(k,i,j,
xdir) - qflx_hi(k,i-1,j,
xdir) ) * rcdx(i) &
658 + ( qflx_hi(k,i,j,
ydir) - qflx_hi(k,i,j-1,
ydir) ) * rcdy(j) ) &
659 * mapf(i,j,1,
i_xy) * mapf(i,j,2,
i_xy)
660 div = divdmp_coef / dtrk * fdz(k) * ( ddiv(k+1,i,j)-ddiv(k,i,j) )
661 momz_rk(k,i,j) = momz0(k,i,j) &
662 + dtrk * ( ( advcv + advch &
665 ) / gsqrt(k,i,j,
i_xyw) &
672 pg_t(k,i,j,1) = ( - pgf(k,i,j) - buoy(k,i,j) ) / gsqrt(k,i,j,
i_xyw)
673 ddiv_t(k,i,j,1) = div
680 k = iundef; i = iundef; j = iundef
686 momz_rk(
ks-1,i,j) = 0.0_rp
687 momz_rk(
ke ,i,j) = 0.0_rp
692 pg_t(
ke,i,j,1) = 0.0_rp
693 ddiv_t(
ke,i,j,1) = 0.0_rp
699 k = iundef; i = iundef; j = iundef
703 if ( flag_fct_momentum )
then 710 gsqrt(:,:,:,
i_xyz), j33g, &
712 iis-1, iie+1, jjs-1, jje+1 )
718 iis-1, iie+1, jjs-1, jje+1 )
724 iis-1, iie+1, jjs-1, jje+1 )
730 if ( flag_fct_momentum )
then 732 call comm_vars8( dens_rk, 1 )
733 call comm_wait ( dens_rk, 1, .false. )
738 qflx_hi(k,i,j,
zdir) = qflx_hi(k,i,j,
zdir) / ( mapf(i,j,1,
i_xy) * mapf(i,j,2,
i_xy) ) &
739 + qflx_j13(k,i,j) + qflx_j23(k,i,j)
747 dens0_uvw(k,i,j) = 0.5_rp * ( dens0(k,i,j) + dens0(k+1,i,j) )
748 dens_uvw(k,i,j) = 0.5_rp * ( dens_rk(k,i,j) + dens_rk(k+1,i,j) )
755 dens_uvw(
ke,i,j) = dens_uvw(
ke-1,i,j)
756 dens0_uvw(
ke,i,j) = dens0_uvw(
ke-1,i,j)
760 call comm_wait ( velz(:,:,:), 4 )
763 velz, dens0_uvw, dens_uvw, &
767 gsqrt(:,:,:,
i_xyw), &
768 mapf(:,:,:,
i_xy), dtrk, &
769 flag_fct_along_stream )
781 momz_rk(k,i,j) = momz_rk(k,i,j) &
782 + dtrk * ( ( qflx_anti(k,i,j,
zdir) - qflx_anti(k-1,i ,j ,
zdir) ) * rfdz(k) &
783 + ( ( qflx_anti(k,i,j,
xdir) - qflx_anti(k ,i-1,j ,
xdir) ) * rcdx(i) &
784 + ( qflx_anti(k,i,j,
ydir) - qflx_anti(k ,i ,j-1,
ydir) ) * rcdy(j) ) &
785 * mapf(i,j,1,
i_xy) * mapf(i,j,2,
i_xy) ) &
797 qflx_hi(:,:,:,:) = undef
815 gsqrt(:,:,:,
i_uyw), j33g, &
821 gsqrt(:,:,:,
i_uyz), j13g(:,:,:,
i_uyw), mapf(:,:,:,
i_uy), &
826 gsqrt(:,:,:,
i_uyz), j23g(:,:,:,
i_uyw), mapf(:,:,:,
i_uy), &
852 pgf(k,i,j) = ( ( gsqrt(k,i+1,j,
i_xyz) * dpres(k,i+1,j) &
853 - gsqrt(k,i ,j,
i_xyz) * dpres(k,i ,j) &
855 + ( j13g(k ,i,j,
i_uyw) &
856 * 0.5_rp * ( f2h(k,1,
i_uyz) * ( dpres(k+1,i+1,j)+dpres(k+1,i,j) ) &
857 + f2h(k,2,
i_uyz) * ( dpres(k ,i+1,j)+dpres(k ,i,j) ) ) &
858 - j13g(k-1,i,j,
i_uyw) &
859 * 0.5_rp * ( f2h(k,1,
i_uyz) * ( dpres(k ,i+1,j)+dpres(k ,i,j) ) &
860 + f2h(k,2,
i_uyz) * ( dpres(k-1,i+1,j)+dpres(k-1,i,j) ) ) &
874 call check( __line__, momy(k,i ,j ) )
875 call check( __line__, momy(k,i+1,j ) )
876 call check( __line__, momy(k,i ,j-1) )
877 call check( __line__, momy(k,i+1,j-1) )
879 cor(k,i,j) = 0.125_rp * ( corioli(1,i+1,j )+corioli(1,i,j ) ) &
880 * ( momy(k,i+1,j )+momy(k,i,j ) &
881 + momy(k,i+1,j-1)+momy(k,i,j-1) ) &
882 + 0.25_rp * mapf(i,j,1,
i_uy) * mapf(i,j,2,
i_uy) &
883 * ( momy(k,i,j) + momy(k,i,j-1) + momy(k,i+1,j) + momy(k,i+1,j-1) ) &
884 * ( ( momy(k,i,j) + momy(k,i,j-1) + momy(k,i+1,j) + momy(k,i+1,j-1) ) * 0.25_rp &
885 * ( 1.0_rp/mapf(i+1,j,2,
i_xy) - 1.0_rp/mapf(i,j,2,
i_xy) ) * rcdx(i) &
887 * ( 1.0_rp/mapf(i,j,1,
i_uv) - 1.0_rp/mapf(i,j-1,1,
i_uv) ) * rfdy(j) ) &
888 * 2.0_rp / ( dens(k,i+1,j) + dens(k,i,j) )
897 do i = iis, min(iie,
ieh)
900 call check( __line__, qflx_hi(k ,i ,j ,
zdir) )
901 call check( __line__, qflx_hi(k-1,i ,j ,
zdir) )
902 call check( __line__, qflx_hi(k ,i ,j ,
xdir) )
903 call check( __line__, qflx_hi(k ,i-1,j ,
xdir) )
904 call check( __line__, qflx_hi(k ,i ,j ,
ydir) )
905 call check( __line__, qflx_hi(k ,i ,j-1,
ydir) )
906 call check( __line__, ddiv(k,i+1,j) )
907 call check( __line__, ddiv(k,i ,j) )
908 call check( __line__, momx0(k,i,j) )
911 advcv = - ( qflx_hi(k,i,j,
zdir) - qflx_hi(k-1,i ,j ,
zdir) ) * rcdz(k)
912 advch = - ( ( qflx_j13(k,i,j) - qflx_j13(k-1,i,j) ) * rcdz(k) &
913 + ( qflx_j23(k,i,j) - qflx_j23(k-1,i,j) ) * rcdz(k) &
914 + ( qflx_hi(k,i,j,
xdir) - qflx_hi(k ,i-1,j ,
xdir) ) * rfdx(i) &
915 + ( qflx_hi(k,i,j,
ydir) - qflx_hi(k ,i ,j-1,
ydir) ) * rcdy(j) ) &
916 * mapf(i,j,1,
i_uy) * mapf(i,j,2,
i_uy)
917 div = divdmp_coef / dtrk * fdx(i) * ( ddiv(k,i+1,j)-ddiv(k,i,j) )
918 momx_rk(k,i,j) = momx0(k,i,j) &
919 + dtrk * ( ( advcv + advch &
921 ) / gsqrt(k,i,j,
i_uyz) &
929 pg_t(k,i,j,2) = - pgf(k,i,j) / gsqrt(k,i,j,
i_uyz)
930 cf_t(k,i,j,1) = cor(k,i,j)
931 ddiv_t(k,i,j,2) = div
938 k = iundef; i = iundef; j = iundef
942 if ( flag_fct_momentum )
then 946 gsqrt(:,:,:,
i_uyw), j33g, &
948 iis-1, iie+1, jjs-1, jje+1 )
955 iis-1, iie+1, jjs-1, jje+1 )
961 iis-1, iie+1, jjs-1, jje+1 )
967 if ( flag_fct_momentum )
then 972 qflx_hi(k,i,j,
zdir) = qflx_hi(k,i,j,
zdir) / ( mapf(i,j,1,
i_uy) * mapf(i,j,2,
i_uy) )&
973 + qflx_j13(k,i,j) + qflx_j23(k,i,j)
981 dens0_uvw(k,i,j) = 0.5_rp * ( dens0(k,i,j) + dens0(k,i+1,j) )
982 dens_uvw(k,i,j) = 0.5_rp * ( dens_rk(k,i,j) + dens_rk(k,i+1,j) )
987 call comm_wait ( velx(:,:,:), 5 )
990 velx, dens0_uvw, dens_uvw, &
994 gsqrt(:,:,:,
i_uyz), &
995 mapf(:,:,:,
i_uy), dtrk, &
996 flag_fct_along_stream )
1006 do i = iis, min(iie,
ieh)
1009 call check( __line__, momx_rk(k,i,j) )
1010 call check( __line__, qflx_anti(k ,i ,j ,
zdir) )
1011 call check( __line__, qflx_anti(k-1,i ,j ,
zdir) )
1012 call check( __line__, qflx_anti(k ,i ,j ,
xdir) )
1013 call check( __line__, qflx_anti(k ,i-1,j ,
xdir) )
1014 call check( __line__, qflx_anti(k ,i ,j ,
ydir) )
1015 call check( __line__, qflx_anti(k ,i ,j-1,
ydir) )
1017 momx_rk(k,i,j) = momx_rk(k,i,j) &
1018 + dtrk * ( ( ( qflx_anti(k,i,j,
zdir) - qflx_anti(k-1,i ,j ,
zdir) ) * rcdz(k) &
1019 + ( qflx_anti(k,i,j,
xdir) - qflx_anti(k ,i-1,j ,
xdir) ) * rfdx(i) &
1020 + ( qflx_anti(k,i,j,
ydir) - qflx_anti(k ,i ,j-1,
ydir) ) * rcdy(j) ) ) &
1021 * mapf(i,j,1,
i_uy) * mapf(i,j,2,
i_uy) &
1022 / gsqrt(k,i,j,
i_uyz)
1027 k = iundef; i = iundef; j = iundef
1034 qflx_lo(:,:,:,:) = undef
1035 qflx_anti(:,:,:,:) = undef
1041 qflx_hi(:,:,:,:) = undef
1059 gsqrt(:,:,:,
i_xvw), j33g, &
1062 iis, iie, jjs, jje )
1065 gsqrt(:,:,:,
i_xvz), j13g(:,:,:,
i_xvw), mapf(:,:,:,
i_xv), &
1067 iis, iie, jjs, jje )
1070 gsqrt(:,:,:,
i_xvz), j23g(:,:,:,
i_xvw), mapf(:,:,:,
i_xv), &
1072 iis, iie, jjs, jje )
1080 iis, iie, jjs, jje )
1089 iis, iie, jjs, jje )
1097 pgf(k,i,j) = ( ( gsqrt(k,i,j+1,
i_xyz) * dpres(k,i,j+1) &
1098 - gsqrt(k,i,j ,
i_xyz) * dpres(k,i,j ) &
1100 + ( j23g(k ,i,j,
i_xvw) &
1101 * 0.5_rp * ( f2h(k ,1,
i_xvz) * ( dpres(k+1,i,j+1)+dpres(k+1,i,j) ) &
1102 + f2h(k ,2,
i_xvz) * ( dpres(k ,i,j+1)+dpres(k ,i,j) ) ) &
1103 - j23g(k-1,i,j,
i_xvw) &
1104 * 0.5_rp * ( f2h(k-1,1,
i_xvz) * ( dpres(k ,i,j+1)+dpres(k ,i,j) ) &
1105 + f2h(k-1,2,
i_xvz) * ( dpres(k-1,i,j+1)+dpres(k-1,i,j) ) ) &
1119 call check( __line__, momx(k,i ,j ) )
1120 call check( __line__, momx(k,i ,j+1) )
1121 call check( __line__, momx(k,i-1,j ) )
1122 call check( __line__, momx(k,i-1,j+1) )
1124 cor(k,i,j) = - 0.125_rp * ( corioli(1,i ,j+1)+corioli(1,i ,j) ) &
1125 * ( momx(k,i ,j+1)+momx(k,i ,j) &
1126 + momx(k,i-1,j+1)+momx(k,i-1,j) ) &
1127 - 0.25_rp * mapf(i,j,1,
i_xv) * mapf(i,j,2,
i_xv) &
1128 * ( momx(k,i,j) + momx(k,i-1,j) + momx(k,i,j+1) + momx(k,i-1,j+1) )&
1130 * ( 1.0_rp/mapf(i,j,2,
i_uv) - 1.0_rp/mapf(i-1,j,2,
i_uv) ) * rcdx(i) &
1131 - 0.25_rp * ( momx(k,i,j)+momx(k,i-1,j)+momx(k,i,j+1)+momx(k,i-1,j+1) ) &
1132 * ( 1.0_rp/mapf(i,j+1,1,
i_xy) - 1.0_rp/mapf(i,j,1,
i_xy) ) * rfdy(j) ) &
1133 * 2.0_rp / ( dens(k,i,j) + dens(k,i,j+1) )
1141 do j = jjs, min(jje,
jeh)
1145 call check( __line__, qflx_hi(k ,i ,j ,
zdir) )
1146 call check( __line__, qflx_hi(k-1,i ,j ,
zdir) )
1147 call check( __line__, qflx_hi(k ,i ,j ,
xdir) )
1148 call check( __line__, qflx_hi(k ,i-1,j ,
xdir) )
1149 call check( __line__, qflx_hi(k ,i ,j ,
ydir) )
1150 call check( __line__, qflx_hi(k ,i ,j-1,
ydir) )
1151 call check( __line__, ddiv(k,i,j+1) )
1152 call check( __line__, ddiv(k,i,j ) )
1153 call check( __line__, momy_t(k,i,j) )
1154 call check( __line__, momy0(k,i,j) )
1157 advcv = - ( qflx_hi(k,i,j,
zdir) - qflx_hi(k-1,i ,j ,
zdir) ) * rcdz(k)
1158 advch = - ( qflx_j13(k,i,j) - qflx_j13(k-1,i,j) ) * rcdz(k) &
1159 - ( qflx_j23(k,i,j) - qflx_j23(k-1,i,j) ) * rcdz(k) &
1160 - ( qflx_hi(k,i,j,
xdir) - qflx_hi(k ,i-1,j ,
xdir) ) * rcdx(i) &
1161 - ( qflx_hi(k,i,j,
ydir) - qflx_hi(k ,i ,j-1,
ydir) ) * rfdy(j) &
1162 * mapf(i,j,1,
i_xv) * mapf(i,j,2,
i_xv)
1163 div = divdmp_coef / dtrk * fdy(j) * ( ddiv(k,i,j+1)-ddiv(k,i,j) )
1164 momy_rk(k,i,j) = momy0(k,i,j) &
1165 + dtrk * ( ( advcv + advch &
1167 ) / gsqrt(k,i,j,
i_xvz) &
1173 advcv_t(k,i,j,
i_momy) = advcv / gsqrt(k,i,j,
i_uyz)
1174 advch_t(k,i,j,
i_momy) = advch / gsqrt(k,i,j,
i_uyz)
1175 pg_t(k,i,j,3) = - pgf(k,i,j) / gsqrt(k,i,j,
i_uyz)
1176 cf_t(k,i,j,2) = cor(k,i,j)
1177 ddiv_t(k,i,j,3) = div
1184 k = iundef; i = iundef; j = iundef
1188 if ( flag_fct_momentum )
then 1194 gsqrt(:,:,:,
i_xvz), j33g, &
1196 iis-1, iie+1, jjs-1, jje+1 )
1203 iis-1, iie+1, jjs-1, jje+1 )
1211 iis-1, iie+1, jjs-1, jje+1 )
1217 if ( flag_fct_momentum )
then 1222 qflx_hi(k,i,j,
zdir) = qflx_hi(k,i,j,
zdir) / ( mapf(i,j,1,
i_xv) * mapf(i,j,2,
i_xv) ) &
1223 + qflx_j13(k,i,j) + qflx_j23(k,i,j)
1231 dens0_uvw(k,i,j) = 0.5_rp * ( dens0(k,i,j) + dens0(k,i,j+1) )
1232 dens_uvw(k,i,j) = 0.5_rp * ( dens_rk(k,i,j) + dens_rk(k,i,j+1) )
1237 call comm_wait ( vely(:,:,:), 6 )
1240 vely, dens0_uvw, dens_uvw, &
1244 gsqrt(:,:,:,
i_xvz), &
1245 mapf(:,:,:,
i_xv), dtrk, &
1246 flag_fct_along_stream )
1255 do j = jjs, min(jje,
jeh)
1259 call check( __line__, momy_rk(k,i,j) )
1260 call check( __line__, qflx_anti(k ,i ,j ,
zdir) )
1261 call check( __line__, qflx_anti(k-1,i ,j ,
zdir) )
1262 call check( __line__, qflx_anti(k ,i ,j ,
xdir) )
1263 call check( __line__, qflx_anti(k ,i-1,j ,
xdir) )
1264 call check( __line__, qflx_anti(k ,i ,j ,
ydir) )
1265 call check( __line__, qflx_anti(k ,i ,j-1,
ydir) )
1267 momy_rk(k,i,j) = momy_rk(k,i,j) &
1268 + dtrk * ( ( ( qflx_anti(k,i,j,
zdir) - qflx_anti(k-1,i ,j ,
zdir) ) * rcdz(k) &
1269 + ( qflx_anti(k,i,j,
xdir) - qflx_anti(k ,i-1,j ,
xdir) ) * rcdx(i) &
1270 + ( qflx_anti(k,i,j,
ydir) - qflx_anti(k ,i ,j-1,
ydir) ) * rfdy(j) ) ) &
1271 * mapf(i,j,1,
i_xv) * mapf(i,j,2,
i_xv) &
1272 / gsqrt(k,i,j,
i_xvz)
1277 k = iundef; i = iundef; j = iundef
1284 qflx_lo(:,:,:,:) = undef
1285 qflx_anti(:,:,:,:) = undef
1290 qflx_hi(
ks:,:,:,:) = undef
1307 mflx_hi(:,:,:,
zdir), pott, gsqrt(:,:,:,
i_xyw), &
1310 iis, iie, jjs, jje )
1314 mflx_hi(:,:,:,
xdir), pott, gsqrt(:,:,:,
i_uyz), &
1317 iis, iie, jjs, jje )
1321 mflx_hi(:,:,:,
ydir), pott, gsqrt(:,:,:,
i_xvz), &
1324 iis, iie, jjs, jje )
1333 call check( __line__, tflx_hi(k ,i ,j ,
zdir) )
1334 call check( __line__, tflx_hi(k-1,i ,j ,
zdir) )
1335 call check( __line__, tflx_hi(k ,i ,j ,
xdir) )
1336 call check( __line__, tflx_hi(k ,i-1,j ,
xdir) )
1337 call check( __line__, tflx_hi(k ,i ,j ,
ydir) )
1338 call check( __line__, tflx_hi(k ,i ,j-1,
ydir) )
1339 call check( __line__, rhot_t(k,i,j) )
1340 call check( __line__, rhot0(k,i,j) )
1342 advcv = - ( tflx_hi(k,i,j,
zdir) - tflx_hi(k-1,i ,j ,
zdir) ) * rcdz(k)
1343 advch = - ( tflx_hi(k,i,j,
xdir) - tflx_hi(k ,i-1,j ,
xdir) ) * rcdx(i) &
1344 - ( tflx_hi(k,i,j,
ydir) - tflx_hi(k ,i ,j-1,
ydir) ) * rcdy(j)
1345 rhot_rk(k,i,j) = rhot0(k,i,j) &
1346 + dtrk * ( ( advcv + advch ) * mapf(i,j,1,
i_xy) * mapf(i,j,2,
i_xy) / gsqrt(k,i,j,
i_xyz) &
1350 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)
1351 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)
1358 k = iundef; i = iundef; j = iundef
1366 if ( flag_fct_t )
then 1368 call comm_vars8( mflx_hi(:,:,:,
zdir), 1 )
1369 call comm_vars8( mflx_hi(:,:,:,
xdir), 2 )
1370 call comm_vars8( mflx_hi(:,:,:,
ydir), 3 )
1371 call comm_wait ( mflx_hi(:,:,:,
zdir), 1, .false. )
1372 call comm_wait ( mflx_hi(:,:,:,
xdir), 2, .false. )
1373 call comm_wait ( mflx_hi(:,:,:,
ydir), 3, .false. )
1375 if ( .NOT. flag_fct_momentum )
then 1376 call comm_vars8( dens_rk, 1 )
1377 call comm_wait ( dens_rk, 1, .false. )
1388 mflx_hi(:,:,:,
zdir), pott, gsqrt(:,:,:,
i_xyz), &
1390 iis-1, iie+1, jjs-1, jje+1 )
1394 mflx_hi(:,:,:,
xdir), pott, gsqrt(:,:,:,
i_uyz), &
1396 iis-1, iie+1, jjs-1, jje+1 )
1400 mflx_hi(:,:,:,
ydir), pott, gsqrt(:,:,:,
i_xvz), &
1402 iis-1, iie+1, jjs-1, jje+1 )
1411 pott(k,i,j) = rhot0(k,i,j) / dens0(k,i,j)
1417 pott, dens0, dens_rk, &
1421 gsqrt(:,:,:,
i_xyz), &
1422 mapf(:,:,:,
i_xy), dtrk, &
1423 flag_fct_along_stream )
1436 call check( __line__, rhot_rk(k,i,j) )
1437 call check( __line__, tflx_anti(k ,i ,j ,
zdir) )
1438 call check( __line__, tflx_anti(k-1,i ,j ,
zdir) )
1439 call check( __line__, tflx_anti(k ,i ,j ,
xdir) )
1440 call check( __line__, tflx_anti(k ,i-1,j ,
xdir) )
1441 call check( __line__, tflx_anti(k ,i ,j ,
ydir) )
1442 call check( __line__, tflx_anti(k ,i ,j-1,
ydir) )
1444 rhot_rk(k,i,j) = rhot_rk(k,i,j) &
1445 + dtrk * ( ( tflx_anti(k,i,j,
zdir) - tflx_anti(k-1,i ,j ,
zdir) ) * rcdz(k) &
1446 + ( tflx_anti(k,i,j,
xdir) - tflx_anti(k ,i-1,j ,
xdir) ) * rcdx(i) &
1447 + ( tflx_anti(k,i,j,
ydir) - tflx_anti(k ,i ,j-1,
ydir) ) * rcdy(j) ) &
1448 * mapf(i,j,1,
i_xy) * mapf(i,j,2,
i_xy) &
1449 / gsqrt(k,i,j,
i_xyz)
1454 k = iundef; i = iundef; j = iundef
1463 call hist_in(advcv_t(:,:,:,
i_dens),
'DENS_t_advcv',
'tendency of density (vert. advection)',
'kg/m3/s' )
1464 call hist_in(advcv_t(:,:,:,
i_momz),
'MOMZ_t_advcv',
'tendency of momentum z (vert. advection)',
'kg/m2/s2', zdim=
'half')
1465 call hist_in(advcv_t(:,:,:,
i_momx),
'MOMX_t_advcv',
'tendency of momentum x (vert. advection)',
'kg/m2/s2', xdim=
'half')
1466 call hist_in(advcv_t(:,:,:,
i_momy),
'MOMY_t_advcv',
'tendency of momentum y (vert. advection)',
'kg/m2/s2', ydim=
'half')
1467 call hist_in(advcv_t(:,:,:,
i_rhot),
'RHOT_t_advcv',
'tendency of rho*theta (vert. advection)',
'K kg/m3/s' )
1469 call hist_in(advch_t(:,:,:,
i_dens),
'DENS_t_advch',
'tendency of density (horiz. advection)',
'kg/m3/s' )
1470 call hist_in(advch_t(:,:,:,
i_momz),
'MOMZ_t_advch',
'tendency of momentum z (horiz. advection)',
'kg/m2/s2', zdim=
'half')
1471 call hist_in(advch_t(:,:,:,
i_momx),
'MOMX_t_advch',
'tendency of momentum x (horiz. advection)',
'kg/m2/s2', xdim=
'half')
1472 call hist_in(advch_t(:,:,:,
i_momy),
'MOMY_t_advch',
'tendency of momentum y (horiz. advection)',
'kg/m2/s2', ydim=
'half')
1473 call hist_in(advch_t(:,:,:,
i_rhot),
'RHOT_t_advch',
'tendency of rho*theta (horiz. advection)',
'K kg/m3/s' )
1475 call hist_in(pg_t(:,:,:,1),
'MOMZ_t_pg',
'tendency of momentum z (pressure gradient)',
'kg/m2/s2', zdim=
'half')
1476 call hist_in(pg_t(:,:,:,2),
'MOMX_t_pg',
'tendency of momentum x (pressure gradient)',
'kg/m2/s2', xdim=
'half')
1477 call hist_in(pg_t(:,:,:,3),
'MOMY_t_pg',
'tendency of momentum y (pressure gradient)',
'kg/m2/s2', ydim=
'half')
1479 call hist_in(ddiv_t(:,:,:,1),
'MOMZ_t_ddiv',
'tendency of momentum z (divergence damping)',
'kg/m2/s2', zdim=
'half')
1480 call hist_in(ddiv_t(:,:,:,2),
'MOMX_t_ddiv',
'tendency of momentum x (divergence damping)',
'kg/m2/s2', xdim=
'half')
1481 call hist_in(ddiv_t(:,:,:,3),
'MOMY_t_ddiv',
'tendency of momentum y (divergence damping)',
'kg/m2/s2', ydim=
'half')
1483 call hist_in(cf_t(:,:,:,1),
'MOMX_t_cf',
'tendency of momentum x (coliolis force)',
'kg/m2/s2', xdim=
'half')
1484 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
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_fluxz_xyw_ud1(flux, mom, val, DENS, GSQRT, J33G, CDZ, FDZ, dtrk, IIS, IIE, JJS, JJE)
calculation z-flux at XYW
procedure(flux_mom), pointer, public atmos_dyn_fvm_fluxx_xvz
subroutine, public atmos_dyn_fvm_fluxy_xvz_ud1(flux, mom, val, DENS, GSQRT, MAPF, CDZ, IIS, IIE, JJS, JJE)
calculation Y-flux at XV
procedure(flux_j), pointer, public atmos_dyn_fvm_fluxj23_uyz
subroutine, public atmos_dyn_fvm_fluxy_xyz_ud1(flux, mflx, val, GSQRT, CDZ, IIS, IIE, JJS, JJE)
calculation Y-flux at XYZ
integer, public iblock
block size for cache blocking: x
integer, parameter, public i_momx
subroutine, public atmos_dyn_fvm_fluxz_uyz_ud1(flux, mom, val, DENS, GSQRT, J33G, CDZ, IIS, IIE, JJS, JJE)
calculation z-flux at UY
integer, parameter, public zdir
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
integer, public ia
of x whole cells (local, with HALO)
subroutine, public atmos_dyn_fvm_fluxx_xyw_ud1(flux, mom, val, DENS, GSQRT, MAPF, CDZ, IIS, IIE, JJS, JJE)
calculation X-flux at XYW
procedure(flux_z), pointer, public atmos_dyn_fvm_fluxz_xvz
subroutine, public atmos_dyn_fvm_fluxy_uyz_ud1(flux, mom, val, DENS, GSQRT, MAPF, CDZ, IIS, IIE, JJS, JJE)
calculation Y-flux at UY
integer, public ka
of z whole cells (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_fluxx_uyz_ud1(flux, mom, val, DENS, GSQRT, MAPF, CDZ, IIS, IIE, JJS, JJE)
calculation X-flux at UY
subroutine, public atmos_dyn_fvm_fluxx_xvz_ud1(flux, mom, val, DENS, GSQRT, MAPF, CDZ, IIS, IIE, JJS, JJE)
calculation X-flux at XV
real(rp), public const_grav
standard acceleration of gravity [m/s2]
subroutine, public atmos_dyn_fvm_fluxz_xyz_ud1(flux, mflx, val, GSQRT, CDZ, IIS, IIE, JJS, JJE)
calculation z-flux at XYZ
integer, public js
start point of inner domain: y, local
module Atmosphere / Dynamics common
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
procedure(flux_z), pointer, public atmos_dyn_fvm_fluxz_uyz
subroutine, public atmos_dyn_fvm_fluxy_xyw_ud1(flux, mom, val, DENS, GSQRT, MAPF, CDZ, IIS, IIE, JJS, JJE)
calculation Y-flux at XYW
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.
subroutine, public atmos_dyn_fvm_fluxx_xyz_ud1(flux, mflx, val, GSQRT, CDZ, IIS, IIE, JJS, JJE)
calculation X-flux at XYZ
procedure(flux_j), pointer, public atmos_dyn_fvm_fluxj13_uyz
procedure(flux_j), pointer, public atmos_dyn_fvm_fluxj23_xvz
subroutine, public atmos_dyn_fvm_fluxz_xvz_ud1(flux, mom, val, DENS, GSQRT, J33G, CDZ, IIS, IIE, JJS, JJE)
calculation z-flux at XV
procedure(flux_phi), pointer, public atmos_dyn_fvm_fluxz_xyz
procedure(flux_mom), pointer, public atmos_dyn_fvm_fluxx_uyz
procedure(flux_phi), pointer, public atmos_dyn_fvm_fluxy_xyz
procedure(flux_mom), pointer, public atmos_dyn_fvm_fluxy_uyz
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
integer, public ja
of y whole cells (local, with HALO)