79 real(RP),
intent(out) :: s33_c (
ka,
ia,
ja)
80 real(RP),
intent(out) :: s11_c (
ka,
ia,
ja)
81 real(RP),
intent(out) :: s22_c (
ka,
ia,
ja)
82 real(RP),
intent(out) :: s31_c (
ka,
ia,
ja)
83 real(RP),
intent(out) :: s12_c (
ka,
ia,
ja)
84 real(RP),
intent(out) :: s23_c (
ka,
ia,
ja)
85 real(RP),
intent(out) :: s12_z (
ka,
ia,
ja)
86 real(RP),
intent(out) :: s23_x (
ka,
ia,
ja)
87 real(RP),
intent(out) :: s31_y (
ka,
ia,
ja)
88 real(RP),
intent(out) :: s2 (
ka,
ia,
ja)
90 real(RP),
intent(in) :: dens (
ka,
ia,
ja)
91 real(RP),
intent(in) :: momz (
ka,
ia,
ja)
92 real(RP),
intent(in) :: momx (
ka,
ia,
ja)
93 real(RP),
intent(in) :: momy (
ka,
ia,
ja)
95 real(RP),
intent(in) :: gsqrt (
ka,
ia,
ja,7)
96 real(RP),
intent(in) :: j13g (
ka,
ia,
ja,7)
97 real(RP),
intent(in) :: j23g (
ka,
ia,
ja,7)
98 real(RP),
intent(in) :: j33g
99 real(RP),
intent(in) :: mapf (
ia,
ja,2,4)
102 real(RP) :: velz_c (
ka,
ia,
ja)
103 real(RP) :: velz_xy(
ka,
ia,
ja)
104 real(RP) :: velx_c (
ka,
ia,
ja)
105 real(RP) :: velx_yz(
ka,
ia,
ja)
106 real(RP) :: vely_c (
ka,
ia,
ja)
107 real(RP) :: vely_zx(
ka,
ia,
ja)
110 real(RP) :: work_v(
ka,
ia,
ja)
111 real(RP) :: work_z(
ka,
ia,
ja)
112 real(RP) :: work_x(
ka,
ia,
ja)
113 real(RP) :: work_y(
ka,
ia,
ja)
115 integer :: iis, iie, jjs, jje
130 velz_c(:,:,:) = undef
131 velz_xy(:,:,:) = undef
132 velx_c(:,:,:) = undef
133 velx_yz(:,:,:) = undef
134 vely_c(:,:,:) = undef
135 vely_zx(:,:,:) = undef
137 work_v(:,:,:) = undef
138 work_z(:,:,:) = undef
139 work_x(:,:,:) = undef
140 work_y(:,:,:) = undef
149 call check( __line__, momz(k,i,j) )
150 call check( __line__, dens(k+1,i,j) )
151 call check( __line__, dens(k,i,j) )
153 velz_xy(k,i,j) = 2.0_rp * momz(k,i,j) / ( dens(k+1,i,j)+dens(k,i,j) )
158 i = iundef; j = iundef; k = iundef
163 velz_xy(
ke,i,j) = 0.0_rp
167 i = iundef; j = iundef; k = iundef
174 call check( __line__, momz(k,i,j) )
175 call check( __line__, momz(k-1,i,j) )
176 call check( __line__, dens(k,i,j) )
178 velz_c(k,i,j) = 0.5_rp * ( momz(k,i,j) + momz(k-1,i,j) ) / dens(k,i,j)
183 i = iundef; j = iundef; k = iundef
189 call check( __line__, momz(
ks,i,j) )
190 call check( __line__, dens(
ks,i,j) )
192 velz_c(
ks,i,j) = 0.5_rp * momz(
ks,i,j) / dens(
ks,i,j)
197 i = iundef; j = iundef; k = iundef
205 call check( __line__, momx(k,i,j) )
206 call check( __line__, dens(k,i+1,j) )
207 call check( __line__, dens(k,i,j) )
209 velx_yz(k,i,j) = 2.0_rp * momx(k,i,j) / ( dens(k,i+1,j)+dens(k,i,j) )
214 i = iundef; j = iundef; k = iundef
219 velx_yz(
ke+1,i,j) = 0.0_rp
223 i = iundef; j = iundef; k = iundef
230 call check( __line__, momx(k,i,j) )
231 call check( __line__, momx(k,i-1,j) )
232 call check( __line__, dens(k,i,j) )
234 velx_c(k,i,j) = 0.5_rp * ( momx(k,i,j) + momx(k,i-1,j) ) / dens(k,i,j)
239 i = iundef; j = iundef; k = iundef
248 call check( __line__, momy(k,i,j) )
249 call check( __line__, dens(k,i,j+1) )
250 call check( __line__, dens(k,i,j) )
252 vely_zx(k,i,j) = 2.0_rp * momy(k,i,j) / ( dens(k,i,j+1)+dens(k,i,j) )
257 i = iundef; j = iundef; k = iundef
262 vely_zx(
ke+1,i,j) = 0.0_rp
266 i = iundef; j = iundef; k = iundef
273 call check( __line__, momy(k,i,j) )
274 call check( __line__, momy(k,i,j-1) )
275 call check( __line__, dens(k,i,j) )
277 vely_c(k,i,j) = 0.5_rp * ( momy(k,i,j) + momy(k,i,j-1) ) / dens(k,i,j)
282 i = iundef; j = iundef; k = iundef
291 work_z(:,:,:) = undef; work_x(:,:,:) = undef; work_y(:,:,:) = undef; work_v(:,:,:) = undef
302 call check( __line__, velz_c(k,i+1,j) )
303 call check( __line__, velz_c(k,i,j) )
305 work_x(k,i,j) = 0.5_rp * ( velz_c(k,i+1,j) + velz_c(k,i,j) )
310 i = iundef; j = iundef; k = iundef
315 work_x(
ke+1,i,j) = 0.0_rp
319 i = iundef; j = iundef; k = iundef
327 call check( __line__, velz_c(k,i,j+1) )
328 call check( __line__, velz_c(k,i,j) )
330 work_y(k,i,j) = 0.5_rp * ( velz_c(k,i,j+1) + velz_c(k,i,j) )
335 i = iundef; j = iundef; k = iundef
340 work_y(
ke+1,i,j) = 0.0_rp
344 i = iundef; j = iundef; k = iundef
354 call check( __line__, velz_xy(k,i,j) )
355 call check( __line__, velz_xy(k-1,i,j) )
356 call check( __line__, rcdz(k) )
358 s33_c(k,i,j) = ( velz_xy(k,i,j) - velz_xy(k-1,i,j) ) * rcdz(k) &
359 * j33g / gsqrt(k,i,j,
i_xyz)
364 i = iundef; j = iundef; k = iundef
370 call check( __line__, velz_xy(
ks,i,j) )
371 call check( __line__, gsqrt(
ks,i,j,
i_xyz) )
372 call check( __line__, rcdz(
ks) )
374 s33_c(
ks,i,j) = velz_xy(
ks,i,j) * rcdz(
ks) &
379 i = iundef; j = iundef; k = iundef
389 call check( __line__, velz_c(k,i+1,j) )
390 call check( __line__, velz_c(k,i-1,j) )
391 call check( __line__, gsqrt(k,i+1,j,
i_xyz) )
392 call check( __line__, gsqrt(k,i-1,j,
i_xyz) )
393 call check( __line__, velz_xy(k,i,j) )
394 call check( __line__, velz_xy(k-1,i,j) )
395 call check( __line__, j13g(k,i,j,
i_xyw) )
396 call check( __line__, j13g(k-1,i,j,
i_xyw) )
397 call check( __line__, fdx(i) )
398 call check( __line__, fdx(i-1) )
400 s31_c(k,i,j) = 0.5_rp * ( &
401 ( 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) ) &
402 + ( 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) &
409 i = iundef; j = iundef; k = iundef
415 call check( __line__, velz_c(
ks,i+1,j) )
416 call check( __line__, velz_c(
ks,i-1,j) )
417 call check( __line__, gsqrt(
ks,i+1,j,
i_xyz) )
418 call check( __line__, gsqrt(
ks,i-1,j,
i_xyz) )
419 call check( __line__, velz_xy(
ks,i,j) )
420 call check( __line__, j13g(
ks,i,j,
i_xyw) )
421 call check( __line__, velz_c(
ke,i+1,j) )
422 call check( __line__, velz_c(
ke,i-1,j) )
423 call check( __line__, gsqrt(
ke,i+1,j,
i_xyz) )
424 call check( __line__, gsqrt(
ke,i-1,j,
i_xyz) )
425 call check( __line__, velz_xy(
ke,i,j) )
426 call check( __line__, j13g(
ke,i,j,
i_xyw) )
427 call check( __line__, fdx(i) )
428 call check( __line__, fdx(i-1) )
430 s31_c(
ks,i,j) = 0.5_rp * ( &
431 ( 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) ) &
432 + ( j13g(
ks,i,j,
i_xyw)*velz_xy(
ks,i,j) ) * rcdz(
ks) &
434 s31_c(
ke,i,j) = 0.5_rp * ( &
435 ( 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) ) &
436 - ( j13g(
ke-1,i,j,
i_xyw)*velz_xy(
ke-1,i,j) ) * rcdz(
ke) &
441 i = iundef; j = iundef; k = iundef
450 call check( __line__, velz_xy(k,i+1,j) )
451 call check( __line__, velz_xy(k,i,j) )
452 call check( __line__, rfdx(i) )
454 s31_y(k,i,j) = 0.5_rp * ( &
455 ( 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) &
456 + ( 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) &
462 i = iundef; j = iundef; k = iundef
472 call check( __line__, velz_c(k,i,j+1) )
473 call check( __line__, velz_c(k,i,j-1) )
474 call check( __line__, gsqrt(k,i,j+1,
i_xyz) )
475 call check( __line__, gsqrt(k,i,j-1,
i_xyz) )
476 call check( __line__, velz_xy(k,i,j) )
477 call check( __line__, velz_xy(k-1,i,j) )
478 call check( __line__, j23g(k,i,j,
i_xyw) )
479 call check( __line__, j23g(k-1,i,j,
i_xyw) )
480 call check( __line__, fdy(j) )
481 call check( __line__, fdy(j-1) )
483 s23_c(k,i,j) = 0.5_rp * ( &
484 ( 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) ) &
485 + ( 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) &
491 i = iundef; j = iundef; k = iundef
497 call check( __line__, velz_c(
ks,i,j+1) )
498 call check( __line__, velz_c(
ks,i,j-1) )
499 call check( __line__, gsqrt(
ks,i,j+1,
i_xyz) )
500 call check( __line__, gsqrt(
ks,i,j-1,
i_xyz) )
501 call check( __line__, velz_xy(
ks,i,j) )
502 call check( __line__, j23g(
ks,i,j,
i_xyw) )
503 call check( __line__, velz_c(
ke,i,j+1) )
504 call check( __line__, velz_c(
ke,i,j-1) )
505 call check( __line__, gsqrt(
ke,i,j+1,
i_xyz) )
506 call check( __line__, gsqrt(
ke,i,j-1,
i_xyz) )
507 call check( __line__, velz_xy(
ke,i,j) )
508 call check( __line__, j23g(
ke,i,j,
i_xyw) )
509 call check( __line__, fdy(j) )
510 call check( __line__, fdy(j-1) )
512 s23_c(
ks,i,j) = 0.5_rp * ( &
513 ( 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) ) &
514 + ( j23g(
ks,i,j,
i_xyw)*velz_xy(
ks,i,j) ) * rcdz(
ks) &
516 s23_c(
ke,i,j) = 0.5_rp * ( &
517 ( 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) ) &
518 - ( j23g(
ke-1,i,j,
i_xyw)*velz_xy(
ke-1,i,j) ) * rcdz(
ke) &
523 i = iundef; j = iundef; k = iundef
532 call check( __line__, velz_xy(k,i,j+1) )
533 call check( __line__, velz_xy(k,i,j) )
534 call check( __line__, rfdy(j) )
536 s23_x(k,i,j) = 0.5_rp * ( &
537 ( 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) &
538 + ( 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) &
544 i = iundef; j = iundef; k = iundef
548 work_z(:,:,:) = undef; work_x(:,:,:) = undef; work_y(:,:,:) = undef; work_v(:,:,:) = undef
557 call check( __line__, velx_c(k+1,i,j) )
558 call check( __line__, velx_c(k,i,j) )
560 work_z(k,i,j) = 0.5_rp * ( velx_c(k+1,i,j) + velx_c(k,i,j) )
565 i = iundef; j = iundef; k = iundef
575 call check( __line__, velx_c(k,i,j+1) )
576 call check( __line__, velx_c(k,i,j) )
578 work_y(k,i,j) = 0.5_rp * ( velx_c(k,i,j+1) + velx_c(k,i,j) )
583 i = iundef; j = iundef; k = iundef
591 call check( __line__, velx_yz(k,i,j) )
592 call check( __line__, velx_yz(k,i,j+1) )
593 call check( __line__, velx_yz(k+1,i,j) )
594 call check( __line__, velx_yz(k+1,i,j+1) )
595 call check( __line__, j23g(k ,i,j ,
i_uvz) )
596 call check( __line__, j23g(k+1,i,j ,
i_uvz) )
597 call check( __line__, j23g(k ,i,j+1,
i_uvz) )
598 call check( __line__, j23g(k+1,i,j+1,
i_uvz) )
600 work_v(k,i,j) = 0.25_rp &
601 * ( j23g(k ,i,j ,
i_uyz)*velx_yz(k ,i,j ) &
602 + j23g(k+1,i,j ,
i_uyz)*velx_yz(k+1,i,j ) &
603 + j23g(k ,i,j+1,
i_uyz)*velx_yz(k ,i,j+1) &
604 + j23g(k+1,i,j+1,
i_uyz)*velx_yz(k+1,i,j+1) )
609 i = iundef; j = iundef; k = iundef
619 call check( __line__, velx_yz(k,i,j) )
620 call check( __line__, velx_yz(k,i-1,j) )
621 call check( __line__, gsqrt(k,i,j,
i_uyz) )
622 call check( __line__, gsqrt(k,i-1,j,
i_uyz) )
623 call check( __line__, work_z(k,i,j) )
624 call check( __line__, work_z(k-1,i,j) )
625 call check( __line__, j13g(k,i,j,
i_xyw) )
626 call check( __line__, j13g(k-1,i,j,
i_xyw) )
627 call check( __line__, gsqrt(k,i,j,
i_xyz) )
628 call check( __line__, rcdx(i) )
631 ( 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) &
632 + ( 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) &
633 ) * mapf(i,j,1,
i_xy) / gsqrt(k,i,j,
i_xyz)
638 i = iundef; j = iundef; k = iundef
644 call check( __line__, velx_yz(
ks,i,j) )
645 call check( __line__, velx_yz(
ks,i-1,j) )
646 call check( __line__, gsqrt(
ks,i,j,
i_uyz) )
647 call check( __line__, gsqrt(
ks,i-1,j,
i_uyz) )
648 call check( __line__, velx_c(
ks+1,i,j) )
649 call check( __line__, velx_c(
ks,i,j) )
650 call check( __line__, j13g(
ks+1,i,j,
i_xyz) )
651 call check( __line__, j13g(
ks,i,j,
i_xyz) )
652 call check( __line__, gsqrt(
ks,i,j,
i_xyz) )
653 call check( __line__, velx_yz(
ke,i,j) )
654 call check( __line__, velx_yz(
ke,i-1,j) )
655 call check( __line__, gsqrt(
ke,i,j,
i_uyz) )
656 call check( __line__, gsqrt(
ke,i-1,j,
i_uyz) )
657 call check( __line__, velx_c(
ke,i,j) )
658 call check( __line__, velx_c(
ke-1,i,j) )
659 call check( __line__, j13g(
ke,i,j,
i_xyz) )
660 call check( __line__, j13g(
ke-1,i,j,
i_xyz) )
661 call check( __line__, gsqrt(
ke,i,j,
i_xyz) )
662 call check( __line__, rcdx(i) )
665 ( 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) &
666 + ( 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) &
669 ( 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) &
670 + ( 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) &
675 i = iundef; j = iundef; k = iundef
685 call check( __line__, s31_c(k,i,j) )
686 call check( __line__, velx_c(k+1,i,j) )
687 call check( __line__, velx_c(k-1,i,j) )
688 call check( __line__, fdz(k) )
689 call check( __line__, fdz(k-1) )
691 s31_c(k,i,j) = ( s31_c(k,i,j) &
692 + 0.5_rp * ( velx_c(k+1,i,j) - velx_c(k-1,i,j) ) * j33g / ( fdz(k) + fdz(k-1) ) &
693 ) / gsqrt(k,i,j,
i_xyz)
698 i = iundef; j = iundef; k = iundef
704 call check( __line__, s31_c(
ks,i,j) )
705 call check( __line__, velx_c(
ks+1,i,j) )
706 call check( __line__, velx_c(
ks,i,j) )
707 call check( __line__, rfdz(
ks) )
708 call check( __line__, s31_c(
ke,i,j) )
709 call check( __line__, velx_c(
ke,i,j) )
710 call check( __line__, velx_c(
ke-1,i,j) )
711 call check( __line__, rfdz(
ke-1) )
713 s31_c(
ks,i,j) = ( s31_c(
ks,i,j) &
714 + 0.5_rp * ( velx_c(
ks+1,i,j) - velx_c(
ks,i,j) ) * j33g * rfdz(
ks) &
716 s31_c(
ke,i,j) = ( s31_c(
ke,i,j) &
717 + 0.5_rp * ( velx_c(
ke,i,j) - velx_c(
ke-1,i,j) ) * j33g * rfdz(
ke-1) &
722 i = iundef; j = iundef; k = iundef
730 call check( __line__, s31_y(k,i,j) )
731 call check( __line__, velx_yz(k+1,i,j) )
732 call check( __line__, velx_yz(k,i,j) )
733 call check( __line__, rfdz(k) )
735 s31_y(k,i,j) = ( s31_y(k,i,j) &
736 + 0.5_rp * ( velx_yz(k+1,i,j) - velx_yz(k,i,j) ) * j33g * rfdz(k) &
737 ) / gsqrt(k,i,j,
i_uyw)
742 i = iundef; j = iundef; k = iundef
752 call check( __line__, velx_c(k,i,j+1) )
753 call check( __line__, velx_c(k,i,j-1) )
754 call check( __line__, gsqrt(k,i,j+1,
i_xyz) )
755 call check( __line__, gsqrt(k,i,j-1,
i_xyz) )
756 call check( __line__, work_z(k,i,j) )
757 call check( __line__, work_z(k-1,i,j) )
758 call check( __line__, j23g(k,i,j,
i_xyw) )
759 call check( __line__, j23g(k-1,i,j,
i_xyw) )
761 s12_c(k,i,j) = 0.5_rp * ( &
762 ( 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) ) &
763 + ( 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) &
764 ) * mapf(i,j,2,
i_xy) / gsqrt(k,i,j,
i_xyz)
769 i = iundef; j = iundef; k = iundef
775 call check( __line__, velx_c(
ks,i,j+1) )
776 call check( __line__, velx_c(
ks,i,j-1) )
777 call check( __line__, gsqrt(
ks,i,j+1,
i_xyz) )
778 call check( __line__, gsqrt(
ks,i,j-1,
i_xyz) )
779 call check( __line__, velx_c(
ks+1,i,j) )
780 call check( __line__, velx_c(
ks,i,j) )
781 call check( __line__, j23g(
ks+1,i,j,
i_xyz) )
782 call check( __line__, j23g(
ks,i,j,
i_xyz) )
783 call check( __line__, gsqrt(
ks,i,j,
i_xyz) )
784 call check( __line__, velx_c(
ke,i,j+1) )
785 call check( __line__, velx_c(
ke,i,j-1) )
786 call check( __line__, gsqrt(
ke,i,j+1,
i_xyz) )
787 call check( __line__, gsqrt(
ke,i,j-1,
i_xyz) )
788 call check( __line__, velx_c(
ke,i,j) )
789 call check( __line__, velx_c(
ke-1,i,j) )
790 call check( __line__, j23g(
ke,i,j,
i_xyz) )
791 call check( __line__, j23g(
ke-1,i,j,
i_xyz) )
792 call check( __line__, gsqrt(
ke,i,j,
i_xyz) )
793 call check( __line__, fdy(j) )
794 call check( __line__, fdy(j-1) )
796 s12_c(
ks,i,j) = 0.5_rp * ( &
797 ( 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) ) &
798 + ( 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) &
800 s12_c(
ke,i,j) = 0.5_rp * ( &
801 ( 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) ) &
802 + ( 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) &
807 i = iundef; j = iundef; k = iundef
816 call check( __line__, velx_yz(k,i,j+1) )
817 call check( __line__, velx_yz(k,i,j) )
818 call check( __line__, work_v(k,i,j) )
819 call check( __line__, work_v(k-1,i,j) )
820 call check( __line__, rfdy(j) )
822 s12_z(k,i,j) = 0.5_rp * ( &
823 ( 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) &
824 + ( work_v(k,i,j) - work_v(k-1,i,j) ) * rcdz(k) &
830 i = iundef; j = iundef; k = iundef
836 call check( __line__, velx_yz(
ks,i,j+1) )
837 call check( __line__, velx_yz(
ks,i,j) )
838 call check( __line__, velx_yz(
ks+1,i,j) )
839 call check( __line__, velx_yz(
ks+1,i,j+1) )
840 call check( __line__, j23g(
ks+1,i,j,
i_uvz) )
841 call check( __line__, j23g(
ks ,i,j,
i_uvz) )
842 call check( __line__, velx_yz(
ke,i,j+1) )
843 call check( __line__, velx_yz(
ke,i,j) )
844 call check( __line__, velx_yz(
ke-1,i,j) )
845 call check( __line__, velx_yz(
ke-1,i,j+1) )
846 call check( __line__, j23g(
ke ,i,j,
i_uvz) )
847 call check( __line__, j23g(
ke-1,i,j,
i_uvz) )
849 s12_z(
ks,i,j) = 0.25_rp * ( &
850 ( 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) &
851 + ( j23g(
ks+1,i,j,
i_uvz) * ( velx_yz(
ks+1,i,j) + velx_yz(
ks+1,i,j+1) ) &
852 - j23g(
ks ,i,j,
i_uvz) * ( velx_yz(
ks ,i,j) + velx_yz(
ks ,i,j+1) ) ) * rfdz(
ks) &
854 s12_z(
ke,i,j) = 0.25_rp * ( &
855 ( 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) &
856 + ( j23g(
ke ,i,j,
i_uvz) * ( velx_yz(
ke ,i,j) + velx_yz(
ke ,i,j+1) ) &
857 - j23g(
ke-1,i,j,
i_uvz) * ( velx_yz(
ke-1,i,j) + velx_yz(
ke-1,i,j+1) ) ) * rfdz(
ke-1) &
862 i = iundef; j = iundef; k = iundef
866 work_z(:,:,:) = undef; work_x(:,:,:) = undef; work_y(:,:,:) = undef; work_v(:,:,:) = undef
875 call check( __line__, vely_c(k+1,i,j) )
876 call check( __line__, vely_c(k,i,j) )
878 work_z(k,i,j) = 0.5_rp * ( vely_c(k+1,i,j) + vely_c(k,i,j) )
883 i = iundef; j = iundef; k = iundef
891 call check( __line__, vely_c(k,i+1,j) )
892 call check( __line__, vely_c(k,i,j) )
894 work_x(k,i,j) = 0.5_rp * ( velz_c(k,i+1,j) + velz_c(k,i,j) )
899 i = iundef; j = iundef; k = iundef
909 call check( __line__, vely_zx(k,i,j) )
910 call check( __line__, vely_zx(k+1,i,j) )
911 call check( __line__, vely_zx(k,i+1,j) )
912 call check( __line__, vely_zx(k+1,i+1,j) )
914 work_v(k,i,j) = 0.25_rp &
915 * ( j13g(k ,i ,j,
i_xvz)*vely_zx(k ,i ,j) &
916 + j13g(k+1,i ,j,
i_xvz)*vely_zx(k+1,i ,j) &
917 + j13g(k ,i+1,j,
i_xvz)*vely_zx(k ,i+1,j) &
918 + j13g(k+1,i+1,j,
i_xvz)*vely_zx(k+1,i+1,j) )
923 i = iundef; j = iundef; k = iundef
933 call check( __line__, vely_zx(k,i,j) )
934 call check( __line__, vely_zx(k,i,j-1) )
935 call check( __line__, gsqrt(k,i,j,
i_xvz) )
936 call check( __line__, gsqrt(k,i,j-1,
i_xvz) )
937 call check( __line__, work_z(k,i,j) )
938 call check( __line__, work_z(k-1,i,j) )
939 call check( __line__, j23g(k,i,j,
i_xyw) )
940 call check( __line__, j23g(k-1,i,j,
i_xyw) )
941 call check( __line__, rcdy(j) )
944 ( 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) &
945 + ( 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) &
946 ) * mapf(i,j,2,
i_xy) / gsqrt(k,i,j,
i_xyz)
951 i = iundef; j = iundef; k = iundef
957 call check( __line__, vely_zx(
ks,i,j) )
958 call check( __line__, vely_zx(
ks,i,j-1) )
959 call check( __line__, gsqrt(
ks,i,j,
i_xvz) )
960 call check( __line__, gsqrt(
ks,i,j-1,
i_xvz) )
961 call check( __line__, vely_c(
ks+1,i,j) )
962 call check( __line__, vely_c(
ks,i,j) )
963 call check( __line__, j23g(
ks+1,i,j,
i_xyz) )
964 call check( __line__, j23g(
ks,i,j,
i_xyz) )
965 call check( __line__, rcdy(j) )
966 call check( __line__, vely_zx(
ke,i,j) )
967 call check( __line__, vely_zx(
ke,i,j-1) )
968 call check( __line__, gsqrt(
ke,i,j,
i_xvz) )
969 call check( __line__, gsqrt(
ke,i,j-1,
i_xvz) )
970 call check( __line__, vely_c(
ke,i,j) )
971 call check( __line__, vely_c(
ke-1,i,j) )
972 call check( __line__, j23g(
ke,i,j,
i_xyz) )
973 call check( __line__, j23g(
ke-1,i,j,
i_xyz) )
976 ( 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) &
977 + ( 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) &
980 ( 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) &
981 + ( 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) &
986 i = iundef; j = iundef; k = iundef
996 call check( __line__, s12_c(k,i,j) )
997 call check( __line__, vely_c(k,i+1,j) )
998 call check( __line__, vely_c(k,i-1,j) )
999 call check( __line__, gsqrt(k,i+1,j,
i_xyz) )
1000 call check( __line__, gsqrt(k,i-1,j,
i_xyz) )
1001 call check( __line__, work_z(k,i,j) )
1002 call check( __line__, work_z(k-1,i,j) )
1003 call check( __line__, j13g(k,i,j,
i_xyw) )
1004 call check( __line__, j13g(k-1,i,j,
i_xyw) )
1005 call check( __line__, gsqrt(k,i,j,
i_xyz) )
1006 call check( __line__, fdx(i) )
1007 call check( __line__, fdx(i-1) )
1009 s12_c(k,i,j) = ( s12_c(k,i,j) &
1011 ( 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) ) &
1012 + ( 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) &
1013 ) / gsqrt(k,i,j,
i_xyz)
1018 i = iundef; j = iundef; k = iundef
1024 call check( __line__, s12_c(
ks,i,j) )
1025 call check( __line__, vely_c(
ks,i+1,j) )
1026 call check( __line__, vely_c(
ks,i-1,j) )
1027 call check( __line__, gsqrt(
ks,i+1,j,
i_xyz) )
1028 call check( __line__, gsqrt(
ks,i-1,j,
i_xyz) )
1029 call check( __line__, vely_c(
ks+1,i,j) )
1030 call check( __line__, vely_c(
ks,i,j) )
1031 call check( __line__, j13g(
ks+1,i,j,
i_xyz) )
1032 call check( __line__, j13g(
ks,i,j,
i_xyz) )
1033 call check( __line__, gsqrt(
ks,i,j,
i_xyz) )
1034 call check( __line__, s12_c(
ke,i,j) )
1035 call check( __line__, vely_c(
ke,i+1,j) )
1036 call check( __line__, vely_c(
ke,i-1,j) )
1037 call check( __line__, gsqrt(
ke,i+1,j,
i_xyz) )
1038 call check( __line__, gsqrt(
ke,i-1,j,
i_xyz) )
1039 call check( __line__, vely_c(
ke,i,j) )
1040 call check( __line__, vely_c(
ke-1,i,j) )
1041 call check( __line__, j13g(
ke,i,j,
i_xyz) )
1042 call check( __line__, j13g(
ke-1,i,j,
i_xyz) )
1043 call check( __line__, gsqrt(
ke,i,j,
i_xyz) )
1044 call check( __line__, fdx(i) )
1045 call check( __line__, fdx(i-1) )
1047 s12_c(
ks,i,j) = ( s12_c(
ks,i,j) &
1049 ( 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) ) &
1050 + ( 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) ) &
1051 * mapf(i,j,1,
i_xy) &
1053 s12_c(
ke,i,j) = ( s12_c(
ke,i,j) &
1055 ( 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) ) &
1056 + ( 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) ) &
1057 * mapf(i,j,1,
i_xy) &
1062 i = iundef; j = iundef; k = iundef
1070 call check( __line__, s12_z(k,i,j) )
1071 call check( __line__, vely_zx(k,i+1,j) )
1072 call check( __line__, vely_zx(k,i,j) )
1073 call check( __line__, work_v(k,i,j) )
1074 call check( __line__, work_v(k-1,i,j) )
1075 call check( __line__, rfdx(i) )
1077 s12_z(k,i,j) = ( s12_z(k,i,j) &
1079 ( 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) &
1080 + ( work_v(k,i,j) - work_v(k-1,i,j) ) * rcdz(k) ) * mapf(i,j,1,
i_uv) &
1081 ) / gsqrt(k,i,j,
i_uvz)
1086 i = iundef; j = iundef; k = iundef
1092 call check( __line__, s12_z(
ks,i,j) )
1093 call check( __line__, vely_zx(
ks,i+1,j) )
1094 call check( __line__, vely_zx(
ks,i,j) )
1095 call check( __line__, vely_zx(
ks+1,i,j) )
1096 call check( __line__, vely_zx(
ks+1,i+1,j) )
1097 call check( __line__, s12_z(
ke,i,j) )
1098 call check( __line__, vely_zx(
ke,i+1,j) )
1099 call check( __line__, vely_zx(
ke,i,j) )
1100 call check( __line__, vely_zx(
ke-1,i,j) )
1101 call check( __line__, vely_zx(
ke-1,i+1,j) )
1102 call check( __line__, rfdx(i) )
1104 s12_z(
ks,i,j) = ( s12_z(
ks,i,j) &
1106 ( 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) &
1107 + ( j13g(
ks+1,i,j,
i_uvz) * ( vely_zx(
ks+1,i,j) + vely_zx(
ks+1,i+1,j) ) &
1108 - 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) &
1110 s12_z(
ke,i,j) = ( s12_z(
ke,i,j) &
1112 ( 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) &
1113 + ( j13g(
ke ,i,j,
i_uvz) * ( vely_zx(
ke ,i,j) + vely_zx(
ke ,i+1,j) ) &
1114 - 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) &
1119 i = iundef; j = iundef; k = iundef
1129 call check( __line__, s23_c(k,i,j) )
1130 call check( __line__, vely_c(k+1,i,j) )
1131 call check( __line__, vely_c(k-1,i,j) )
1132 call check( __line__, fdz(k) )
1133 call check( __line__, fdz(k-1) )
1135 s23_c(k,i,j) = ( s23_c(k,i,j) &
1136 + 0.5_rp * ( vely_c(k+1,i,j) - vely_c(k-1,i,j) ) * j33g / ( fdz(k) + fdz(k-1) ) &
1137 ) / gsqrt(k,i,j,
i_xyz)
1142 i = iundef; j = iundef; k = iundef
1148 call check( __line__, s23_c(
ks,i,j) )
1149 call check( __line__, vely_c(
ks+1,i,j) )
1150 call check( __line__, vely_c(
ks,i,j) )
1151 call check( __line__, rfdz(
ks) )
1152 call check( __line__, s23_c(
ke,i,j) )
1153 call check( __line__, vely_c(
ke,i,j) )
1154 call check( __line__, vely_c(
ke-1,i,j) )
1155 call check( __line__, rfdz(
ke-1) )
1157 s23_c(
ks,i,j) = ( s23_c(
ks,i,j) &
1158 + 0.5_rp * ( vely_c(
ks+1,i,j) - vely_c(
ks,i,j) ) * j33g * rfdz(
ks) &
1160 s23_c(
ke,i,j) = ( s23_c(
ke,i,j) &
1161 + 0.5_rp * ( vely_c(
ke,i,j) - vely_c(
ke-1,i,j) ) * j33g * rfdz(
ke-1) &
1166 i = iundef; j = iundef; k = iundef
1175 call check( __line__, s23_x(k,i,j) )
1176 call check( __line__, vely_zx(k+1,i,j) )
1177 call check( __line__, vely_zx(k,i,j) )
1178 call check( __line__, rfdz(k) )
1180 s23_x(k,i,j) = ( s23_x(k,i,j) &
1181 + 0.5_rp * ( vely_zx(k+1,i,j) - vely_zx(k,i,j) ) * j33g * rfdz(k) &
1182 ) / gsqrt(k,i,j,
i_xvw)
1187 i = iundef; j = iundef; k = iundef
1193 work_z(:,:,:) = undef; work_x(:,:,:) = undef; work_y(:,:,:) = undef
1203 call check( __line__, s11_c(k,i,j) )
1204 call check( __line__, s22_c(k,i,j) )
1205 call check( __line__, s33_c(k,i,j) )
1206 call check( __line__, s31_c(k,i,j) )
1207 call check( __line__, s12_c(k,i,j) )
1208 call check( __line__, s23_c(k,i,j) )
1210 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 ) &
1211 + 4.0_rp * ( s31_c(k,i,j)**2 + s12_c(k,i,j)**2 + s23_c(k,i,j)**2 )
1216 i = iundef; j = iundef; k = iundef
integer, public ia
of whole cells: x, local, with HALO
integer, public iblock
block size for cache blocking: x
integer, public ja
of whole cells: y, local, with HALO
real(rp), dimension(:), allocatable, public atmos_grid_cartesc_fdz
z-length of grid(i+1) to grid(i) [m]
real(rp), dimension(:), allocatable, public atmos_grid_cartesc_fdy
y-length of grid(j+1) to grid(j) [m]
real(rp), dimension(:), allocatable, public atmos_grid_cartesc_rcdy
reciprocal of center-dy
real(rp), dimension(:), allocatable, public atmos_grid_cartesc_rfdz
reciprocal of face-dz
integer, public is
start point of inner domain: x, local
integer, public ie
end point of inner domain: x, local
real(rp), dimension(:), allocatable, public atmos_grid_cartesc_rcdz
reciprocal of center-dz
real(rp), dimension(:), allocatable, public atmos_grid_cartesc_fdx
x-length of grid(i+1) to grid(i) [m]
integer, public ke
end point of inner domain: z, local
integer, public je
end point of inner domain: y, local
module atmosphere / grid / cartesC
integer, public ks
start point of inner domain: z, local
integer, public jblock
block size for cache blocking: y
integer, public js
start point of inner domain: y, local
real(rp), dimension(:), allocatable, public atmos_grid_cartesc_rcdx
reciprocal of center-dx
integer, public ka
of whole cells: z, local, with HALO
real(rp), dimension(:), allocatable, public atmos_grid_cartesc_rfdy
reciprocal of face-dy
real(rp), dimension(:), allocatable, public atmos_grid_cartesc_rfdx
reciprocal of face-dx