77 #define F2H(k,p,q) (CDZ(k+p-1)*GSQRT(k+p-1,i,j)/(CDZ(k)*GSQRT(k,i,j)+CDZ(k+1)*GSQRT(k+1,i,j))) 79 #define F2H(k,p,q) 0.5_RP 86 real(RP),
parameter :: f2 = 0.5_rp
90 real(RP),
parameter :: f31 = -1.0_rp/12.0_rp
91 real(RP),
parameter :: f32 = 7.0_rp/12.0_rp
92 real(RP),
parameter :: f33 = 3.0_rp/12.0_rp
95 real(RP),
parameter :: f51 = 1.0_rp/60.0_rp
96 real(RP),
parameter :: f52 = -8.0_rp/60.0_rp
97 real(RP),
parameter :: f53 = 37.0_rp/60.0_rp
98 real(RP),
parameter :: f54 = -5.0_rp/60.0_rp
99 real(RP),
parameter :: f55 = 10.0_rp/60.0_rp
113 real(RP),
intent(out) :: valW (
ka)
114 real(RP),
intent(in) :: mflx (
ka)
115 real(RP),
intent(in) :: val (
ka)
116 real(RP),
intent(in) :: GSQRT(
ka)
117 real(RP),
intent(in) :: CDZ (
ka)
124 call check( __line__, mflx(k) )
126 call check( __line__, val(k) )
127 call check( __line__, val(k+1) )
129 call check( __line__, val(k-1) )
130 call check( __line__, val(k+2) )
132 call check( __line__, val(k-2) )
133 call check( __line__, val(k+3) )
136 valw(k) = ( f51 * ( val(k+3)+val(k-2) ) &
137 + f52 * ( val(k+2)+val(k-1) ) &
138 + f53 * ( val(k+1)+val(k) ) ) &
139 - ( f51 * ( val(k+3)-val(k-2) ) &
140 + f54 * ( val(k+2)-val(k-1) ) &
141 + f55 * ( val(k+1)-val(k) ) ) * sign(1.0_rp,mflx(k))
149 call check( __line__, mflx(
ks) )
150 call check( __line__, val(
ks ) )
151 call check( __line__, val(
ks+1) )
152 call check( __line__, mflx(
ke-1) )
153 call check( __line__, val(
ke ) )
154 call check( __line__, val(
ke-1) )
156 call check( __line__, mflx(
ks+1) )
157 call check( __line__, val(
ks+2 ) )
158 call check( __line__, val(
ks+3) )
159 call check( __line__, mflx(
ke-2) )
160 call check( __line__, val(
ke-2 ) )
161 call check( __line__, val(
ke-3) )
165 valw(
ks) = f2 * ( val(
ks+1)+val(
ks) )
166 valw(
ke-1) = f2 * ( val(
ke)+val(
ke-1) )
168 valw(
ks+1) = ( f31 * ( val(
ks+3)+val(
ks) ) + f32 * ( val(
ks+2)+val(
ks+1) ) ) &
169 - ( f31 * ( val(
ks+3)-val(
ks) ) + f33 * ( val(
ks+2)-val(
ks+1) ) ) * sign(1.0_rp,mflx(
ks+1))
170 valw(
ke-2) = ( f31 * ( val(
ke)+val(
ke-3) ) + f32 * ( val(
ke-1)+val(
ke-2) ) ) &
171 - ( f31 * ( val(
ke)-val(
ke-3) ) + f33 * ( val(
ke-1)-val(
ke-2) ) ) * sign(1.0_rp,mflx(
ke-2))
188 real(RP),
intent(out) :: flux (
ka,
ia,
ja)
189 real(RP),
intent(in) :: mflx (
ka,
ia,
ja)
190 real(RP),
intent(in) :: val (
ka,
ia,
ja)
191 real(RP),
intent(in) :: GSQRT (
ka,
ia,
ja)
193 real(RP),
intent(in) :: num_diff(
ka,
ia,
ja)
195 real(RP),
intent(in) :: CDZ (
ka)
196 integer,
intent(in) :: IIS, IIE, JJS, JJE
207 call check( __line__, mflx(k,i,j) )
209 call check( __line__, val(k,i,j) )
210 call check( __line__, val(k+1,i,j) )
212 call check( __line__, val(k-1,i,j) )
213 call check( __line__, val(k+2,i,j) )
215 call check( __line__, val(k-2,i,j) )
216 call check( __line__, val(k+3,i,j) )
221 * ( ( f51 * ( val(k+3,i,j)+val(k-2,i,j) ) &
222 + f52 * ( val(k+2,i,j)+val(k-1,i,j) ) &
223 + f53 * ( val(k+1,i,j)+val(k,i,j) ) ) &
224 - ( f51 * ( val(k+3,i,j)-val(k-2,i,j) ) &
225 + f54 * ( val(k+2,i,j)-val(k-1,i,j) ) &
226 + f55 * ( val(k+1,i,j)-val(k,i,j) ) ) * sign(1.0_rp,vel) ) &
227 + gsqrt(k,i,j) * num_diff(k,i,j)
232 k = iundef; i = iundef; j = iundef
240 call check( __line__, mflx(
ks,i,j) )
241 call check( __line__, val(
ks ,i,j) )
242 call check( __line__, val(
ks+1,i,j) )
243 call check( __line__, mflx(
ke-1,i,j) )
244 call check( __line__, val(
ke ,i,j) )
245 call check( __line__, val(
ke-1,i,j) )
247 call check( __line__, mflx(
ks+1,i,j) )
248 call check( __line__, val(
ks+2 ,i,j) )
249 call check( __line__, val(
ks+3,i,j) )
250 call check( __line__, mflx(
ke-2,i,j) )
251 call check( __line__, val(
ke-2 ,i,j) )
252 call check( __line__, val(
ke-3,i,j) )
255 flux(
ks-1,i,j) = 0.0_rp
259 * ( f2 * ( val(
ks+1,i,j)+val(
ks,i,j) ) ) &
260 + gsqrt(
ks,i,j) * num_diff(
ks,i,j)
262 flux(
ke-1,i,j) = vel &
263 * ( f2 * ( val(
ke,i,j)+val(
ke-1,i,j) ) ) &
264 + gsqrt(
ke-1,i,j) * num_diff(
ke-1,i,j)
267 flux(
ks+1,i,j) = vel &
268 * ( ( f31 * ( val(
ks+3,i,j)+val(
ks,i,j) ) + f32 * ( val(
ks+2,i,j)+val(
ks+1,i,j) ) ) &
269 - ( f31 * ( val(
ks+3,i,j)-val(
ks,i,j) ) + f33 * ( val(
ks+2,i,j)-val(
ks+1,i,j) ) ) * sign(1.0_rp,vel) ) &
270 + gsqrt(
ks+1,i,j) * num_diff(
ks+1,i,j)
272 flux(
ke-2,i,j) = vel &
273 * ( ( f31 * ( val(
ke,i,j)+val(
ke-3,i,j) ) + f32 * ( val(
ke-1,i,j)+val(
ke-2,i,j) ) ) &
274 - ( f31 * ( val(
ke,i,j)-val(
ke-3,i,j) ) + f33 * ( val(
ke-1,i,j)-val(
ke-2,i,j) ) ) * sign(1.0_rp,vel) ) &
275 + gsqrt(
ke-2,i,j) * num_diff(
ke-2,i,j)
277 flux(
ke ,i,j) = 0.0_rp
281 k = iundef; i = iundef; j = iundef
299 real(RP),
intent(out) :: flux (
ka,
ia,
ja)
300 real(RP),
intent(in) :: mflx (
ka,
ia,
ja)
301 real(RP),
intent(in) :: val (
ka,
ia,
ja)
302 real(RP),
intent(in) :: GSQRT (
ka,
ia,
ja)
304 real(RP),
intent(in) :: num_diff(
ka,
ia,
ja)
306 real(RP),
intent(in) :: CDZ(
ka)
307 integer,
intent(in) :: IIS, IIE, JJS, JJE
318 call check( __line__, mflx(k,i,j) )
320 call check( __line__, val(k,i,j) )
321 call check( __line__, val(k,i+1,j) )
323 call check( __line__, val(k,i-1,j) )
324 call check( __line__, val(k,i+2,j) )
326 call check( __line__, val(k,i-2,j) )
327 call check( __line__, val(k,i+3,j) )
332 * ( ( f51 * ( val(k,i+3,j)+val(k,i-2,j) ) &
333 + f52 * ( val(k,i+2,j)+val(k,i-1,j) ) &
334 + f53 * ( val(k,i+1,j)+val(k,i,j) ) ) &
335 - ( f51 * ( val(k,i+3,j)-val(k,i-2,j) ) &
336 + f54 * ( val(k,i+2,j)-val(k,i-1,j) ) &
337 + f55 * ( val(k,i+1,j)-val(k,i,j) ) ) * sign(1.0_rp,vel) ) &
338 + gsqrt(k,i,j) * num_diff(k,i,j)
343 k = iundef; i = iundef; j = iundef
361 real(RP),
intent(out) :: flux (
ka,
ia,
ja)
362 real(RP),
intent(in) :: mflx (
ka,
ia,
ja)
363 real(RP),
intent(in) :: val (
ka,
ia,
ja)
364 real(RP),
intent(in) :: GSQRT (
ka,
ia,
ja)
366 real(RP),
intent(in) :: num_diff(
ka,
ia,
ja)
368 real(RP),
intent(in) :: CDZ(
ka)
369 integer,
intent(in) :: IIS, IIE, JJS, JJE
380 call check( __line__, mflx(k,i,j) )
382 call check( __line__, val(k,i,j) )
383 call check( __line__, val(k,i,j+1) )
385 call check( __line__, val(k,i,j-1) )
386 call check( __line__, val(k,i,j+2) )
388 call check( __line__, val(k,i,j-2) )
389 call check( __line__, val(k,i,j+3) )
394 * ( ( f51 * ( val(k,i,j+3)+val(k,i,j-2) ) &
395 + f52 * ( val(k,i,j+2)+val(k,i,j-1) ) &
396 + f53 * ( val(k,i,j+1)+val(k,i,j) ) ) &
397 - ( f51 * ( val(k,i,j+3)-val(k,i,j-2) ) &
398 + f54 * ( val(k,i,j+2)-val(k,i,j-1) ) &
399 + f55 * ( val(k,i,j+1)-val(k,i,j) ) ) * sign(1.0_rp,vel) ) &
400 + gsqrt(k,i,j) * num_diff(k,i,j)
405 k = iundef; i = iundef; j = iundef
426 real(RP),
intent(out) :: flux (
ka,
ia,
ja)
427 real(RP),
intent(in) :: mom (
ka,
ia,
ja)
428 real(RP),
intent(in) :: val (
ka,
ia,
ja)
429 real(RP),
intent(in) :: DENS (
ka,
ia,
ja)
430 real(RP),
intent(in) :: GSQRT (
ka,
ia,
ja)
431 real(RP),
intent(in) :: J33G
433 real(RP),
intent(in) :: num_diff(
ka,
ia,
ja)
435 real(RP),
intent(in) :: CDZ (
ka)
436 real(RP),
intent(in) :: FDZ (
ka-1)
437 real(RP),
intent(in) :: dtrk
438 integer,
intent(in) :: IIS, IIE, JJS, JJE
452 call check( __line__, mom(k-1,i,j) )
453 call check( __line__, mom(k ,i,j) )
455 call check( __line__, val(k-1,i,j) )
456 call check( __line__, val(k,i,j) )
458 call check( __line__, val(k-2,i,j) )
459 call check( __line__, val(k+1,i,j) )
461 call check( __line__, val(k-3,i,j) )
462 call check( __line__, val(k+2,i,j) )
465 vel = ( 0.5_rp * ( mom(k-1,i,j) &
468 flux(k-1,i,j) = j33g * vel &
469 * ( ( f51 * ( val(k+2,i,j)+val(k-3,i,j) ) &
470 + f52 * ( val(k+1,i,j)+val(k-2,i,j) ) &
471 + f53 * ( val(k,i,j)+val(k-1,i,j) ) ) &
472 - ( f51 * ( val(k+2,i,j)-val(k-3,i,j) ) &
473 + f54 * ( val(k+1,i,j)-val(k-2,i,j) ) &
474 + f55 * ( val(k,i,j)-val(k-1,i,j) ) ) * sign(1.0_rp,vel) ) &
475 + gsqrt(k,i,j) * num_diff(k,i,j)
480 k = iundef; i = iundef; j = iundef
488 call check( __line__, val(
ks ,i,j) )
489 call check( __line__, val(
ks+1,i,j) )
490 call check( __line__, val(
ke-2,i,j) )
491 call check( __line__, val(
ke-1,i,j) )
494 flux(
ks-1,i,j) = 0.0_rp
496 vel = ( 0.5_rp * ( mom(
ks,i,j) &
497 + mom(
ks+1,i,j) ) ) &
499 flux(
ks ,i,j) = j33g * vel &
500 * ( ( f31 * ( val(
ks+2,i,j)+val(
ks-1,i,j) ) + f32 * ( val(
ks+1,i,j)+val(
ks,i,j) ) ) &
501 - ( f31 * ( val(
ks+2,i,j)-val(
ks-1,i,j) ) + f33 * ( val(
ks+1,i,j)-val(
ks,i,j) ) ) * sign(1.0_rp,vel) ) &
502 + gsqrt(
ks+1,i,j) * num_diff(
ks+1,i,j)
506 sw = sign( 1.0_rp, mom(
ks,i,j) )
507 flux(
ks ,i,j) = sw * min( sw*flux(
ks,i,j), sw*val(
ks,i,j)*gsqrt(
ks,i,j)*fdz(
ks)/dtrk )
510 vel = ( 0.5_rp * ( mom(
ke-2,i,j) &
511 + mom(
ke-1,i,j) ) ) &
513 flux(
ke-2,i,j) = j33g * vel &
514 * ( ( f31 * ( val(
ke,i,j)+val(
ke-3,i,j) ) + f32 * ( val(
ke-1,i,j)+val(
ke-2,i,j) ) ) &
515 - ( f31 * ( val(
ke,i,j)-val(
ke-3,i,j) ) + f33 * ( val(
ke-1,i,j)-val(
ke-2,i,j) ) ) * sign(1.0_rp,vel) ) &
516 + gsqrt(
ke-1,i,j) * num_diff(
ke-1,i,j)
518 flux(
ke-1,i,j) = 0.0_rp
519 flux(
ke ,i,j) = 0.0_rp
537 real(RP),
intent(out) :: flux (
ka,
ia,
ja)
538 real(RP),
intent(in) :: mom (
ka,
ia,
ja)
539 real(RP),
intent(in) :: val (
ka,
ia,
ja)
540 real(RP),
intent(in) :: DENS (
ka,
ia,
ja)
541 real(RP),
intent(in) :: GSQRT (
ka,
ia,
ja)
542 real(RP),
intent(in) :: J13G (
ka,
ia,
ja)
543 real(RP),
intent(in) :: MAPF (
ia,
ja,2)
544 real(RP),
intent(in) :: CDZ (
ka)
545 integer,
intent(in) :: IIS, IIE, JJS, JJE
555 vel = ( 0.5_rp * ( mom(k,i,j)+mom(k,i-1,j) ) ) &
557 flux(k-1,i,j) = j13g(k,i,j) / mapf(i,j,+2) * vel &
558 * ( ( f51 * ( val(k+2,i,j)+val(k-3,i,j) ) &
559 + f52 * ( val(k+1,i,j)+val(k-2,i,j) ) &
560 + f53 * ( val(k,i,j)+val(k-1,i,j) ) ) &
561 - ( f51 * ( val(k+2,i,j)-val(k-3,i,j) ) &
562 + f54 * ( val(k+1,i,j)-val(k-2,i,j) ) &
563 + f55 * ( val(k,i,j)-val(k-1,i,j) ) ) * sign(1.0_rp,vel) )
571 flux(
ks-1,i,j) = 0.0_rp
573 vel = ( 0.5_rp * ( mom(
ks,i,j)+mom(
ks,i-1,j) ) ) &
575 flux(
ks,i,j) = j13g(
ks,i,j) / mapf(i,j,+2) * vel &
576 * ( f2 * ( val(
ks+1,i,j)+val(
ks,i,j) ) )
577 vel = ( 0.5_rp * ( mom(
ke,i,j)+mom(
ke,i-1,j) ) ) &
579 flux(
ke-2,i,j) = j13g(
ke,i,j) / mapf(i,j,+2) * vel &
580 * ( f2 * ( val(
ke-1,i,j)+val(
ke-2,i,j) ) )
582 flux(
ke-1,i,j) = 0.0_rp
599 real(RP),
intent(out) :: flux (
ka,
ia,
ja)
600 real(RP),
intent(in) :: mom (
ka,
ia,
ja)
601 real(RP),
intent(in) :: val (
ka,
ia,
ja)
602 real(RP),
intent(in) :: DENS (
ka,
ia,
ja)
603 real(RP),
intent(in) :: GSQRT (
ka,
ia,
ja)
604 real(RP),
intent(in) :: J23G (
ka,
ia,
ja)
605 real(RP),
intent(in) :: MAPF (
ia,
ja,2)
606 real(RP),
intent(in) :: CDZ (
ka)
607 integer,
intent(in) :: IIS, IIE, JJS, JJE
617 vel = ( 0.5_rp * ( mom(k,i,j)+mom(k,i,j-1) ) ) &
619 flux(k-1,i,j) = j23g(k,i,j) / mapf(i,j,+1) * vel &
620 * ( ( f51 * ( val(k+2,i,j)+val(k-3,i,j) ) &
621 + f52 * ( val(k+1,i,j)+val(k-2,i,j) ) &
622 + f53 * ( val(k,i,j)+val(k-1,i,j) ) ) &
623 - ( f51 * ( val(k+2,i,j)-val(k-3,i,j) ) &
624 + f54 * ( val(k+1,i,j)-val(k-2,i,j) ) &
625 + f55 * ( val(k,i,j)-val(k-1,i,j) ) ) * sign(1.0_rp,vel) )
633 flux(
ks-1,i,j) = 0.0_rp
635 vel = ( 0.5_rp * ( mom(
ks,i,j)+mom(
ks,i,j-1) ) ) &
637 flux(
ks,i,j) = j23g(
ks,i,j) / mapf(i,j,+1) * vel &
638 * ( f2 * ( val(
ks+1,i,j)+val(
ks,i,j) ) )
639 vel = ( 0.5_rp * ( mom(
ke,i,j)+mom(
ke,i,j-1) ) ) &
641 flux(
ke-2,i,j) = j23g(
ke,i,j) / mapf(i,j,+1) * vel &
642 * ( f2 * ( val(
ke-1,i,j)+val(
ke-2,i,j) ) )
644 flux(
ke-1,i,j) = 0.0_rp
665 real(RP),
intent(out) :: flux (
ka,
ia,
ja)
666 real(RP),
intent(in) :: mom (
ka,
ia,
ja)
667 real(RP),
intent(in) :: val (
ka,
ia,
ja)
668 real(RP),
intent(in) :: DENS (
ka,
ia,
ja)
669 real(RP),
intent(in) :: GSQRT (
ka,
ia,
ja)
670 real(RP),
intent(in) :: MAPF (
ia,
ja,2)
672 real(RP),
intent(in) :: num_diff(
ka,
ia,
ja)
674 real(RP),
intent(in) :: CDZ (
ka)
675 integer,
intent(in) :: IIS, IIE, JJS, JJE
686 call check( __line__, mom(k ,i,j) )
687 call check( __line__, mom(k+1,i,j) )
689 call check( __line__, val(k,i,j) )
690 call check( __line__, val(k,i+1,j) )
692 call check( __line__, val(k,i-1,j) )
693 call check( __line__, val(k,i+2,j) )
695 call check( __line__, val(k,i-2,j) )
696 call check( __line__, val(k,i+3,j) )
699 vel = ( f2h(k,1,i_uyz) &
704 * 0.5_rp * ( dens(k+1,i,j)+dens(k+1,i+1,j) ) &
706 * 0.5_rp * ( dens(k,i,j)+dens(k,i+1,j) ) )
707 flux(k,i,j) = gsqrt(k,i,j) / mapf(i,j,+2) * vel &
708 * ( ( f51 * ( val(k,i+3,j)+val(k,i-2,j) ) &
709 + f52 * ( val(k,i+2,j)+val(k,i-1,j) ) &
710 + f53 * ( val(k,i+1,j)+val(k,i,j) ) ) &
711 - ( f51 * ( val(k,i+3,j)-val(k,i-2,j) ) &
712 + f54 * ( val(k,i+2,j)-val(k,i-1,j) ) &
713 + f55 * ( val(k,i+1,j)-val(k,i,j) ) ) * sign(1.0_rp,vel) ) &
714 + gsqrt(k,i,j) * num_diff(k,i,j)
719 k = iundef; i = iundef; j = iundef
725 flux(
ke,i,j) = 0.0_rp
729 k = iundef; i = iundef; j = iundef
748 real(RP),
intent(out) :: flux (
ka,
ia,
ja)
749 real(RP),
intent(in) :: mom (
ka,
ia,
ja)
750 real(RP),
intent(in) :: val (
ka,
ia,
ja)
751 real(RP),
intent(in) :: DENS (
ka,
ia,
ja)
752 real(RP),
intent(in) :: GSQRT (
ka,
ia,
ja)
753 real(RP),
intent(in) :: MAPF (
ia,
ja,2)
755 real(RP),
intent(in) :: num_diff(
ka,
ia,
ja)
757 real(RP),
intent(in) :: CDZ (
ka)
758 integer,
intent(in) :: IIS, IIE, JJS, JJE
769 call check( __line__, mom(k ,i,j) )
770 call check( __line__, mom(k+1,i,j) )
772 call check( __line__, val(k,i,j) )
773 call check( __line__, val(k,i,j+1) )
775 call check( __line__, val(k,i,j-1) )
776 call check( __line__, val(k,i,j+2) )
778 call check( __line__, val(k,i,j-2) )
779 call check( __line__, val(k,i,j+3) )
782 vel = ( f2h(k,1,i_xvz) &
787 * 0.5_rp * ( dens(k+1,i,j)+dens(k+1,i,j+1) ) &
789 * 0.5_rp * ( dens(k,i,j)+dens(k,i,j+1) ) )
790 flux(k,i,j) = gsqrt(k,i,j) / mapf(i,j,+1) * vel &
791 * ( ( f51 * ( val(k,i,j+3)+val(k,i,j-2) ) &
792 + f52 * ( val(k,i,j+2)+val(k,i,j-1) ) &
793 + f53 * ( val(k,i,j+1)+val(k,i,j) ) ) &
794 - ( f51 * ( val(k,i,j+3)-val(k,i,j-2) ) &
795 + f54 * ( val(k,i,j+2)-val(k,i,j-1) ) &
796 + f55 * ( val(k,i,j+1)-val(k,i,j) ) ) * sign(1.0_rp,vel) ) &
797 + gsqrt(k,i,j) * num_diff(k,i,j)
802 k = iundef; i = iundef; j = iundef
808 flux(
ke,i,j) = 0.0_rp
812 k = iundef; i = iundef; j = iundef
832 real(RP),
intent(out) :: flux (
ka,
ia,
ja)
833 real(RP),
intent(in) :: mom (
ka,
ia,
ja)
834 real(RP),
intent(in) :: val (
ka,
ia,
ja)
835 real(RP),
intent(in) :: DENS (
ka,
ia,
ja)
836 real(RP),
intent(in) :: GSQRT (
ka,
ia,
ja)
837 real(RP),
intent(in) :: J33G
839 real(RP),
intent(in) :: num_diff(
ka,
ia,
ja)
841 real(RP),
intent(in) :: CDZ (
ka)
842 integer,
intent(in) :: IIS, IIE, JJS, JJE
853 call check( __line__, mom(k,i,j) )
854 call check( __line__, mom(k,i+1,j) )
856 call check( __line__, val(k,i,j) )
857 call check( __line__, val(k+1,i,j) )
859 call check( __line__, val(k-1,i,j) )
860 call check( __line__, val(k+2,i,j) )
862 call check( __line__, val(k-2,i,j) )
863 call check( __line__, val(k+3,i,j) )
866 vel = ( 0.5_rp * ( mom(k,i,j)+mom(k,i+1,j) ) ) &
868 * 0.5_rp * ( dens(k+1,i,j)+dens(k+1,i+1,j) ) &
870 * 0.5_rp * ( dens(k,i,j)+dens(k,i+1,j) ) )
871 flux(k,i,j) = j33g * vel &
872 * ( ( f51 * ( val(k+3,i,j)+val(k-2,i,j) ) &
873 + f52 * ( val(k+2,i,j)+val(k-1,i,j) ) &
874 + f53 * ( val(k+1,i,j)+val(k,i,j) ) ) &
875 - ( f51 * ( val(k+3,i,j)-val(k-2,i,j) ) &
876 + f54 * ( val(k+2,i,j)-val(k-1,i,j) ) &
877 + f55 * ( val(k+1,i,j)-val(k,i,j) ) ) * sign(1.0_rp,vel) ) &
878 + gsqrt(k,i,j) * num_diff(k,i,j)
883 k = iundef; i = iundef; j = iundef
891 call check( __line__, mom(
ks,i ,j) )
892 call check( __line__, mom(
ks,i+1,j) )
893 call check( __line__, val(
ks+1,i,j) )
894 call check( __line__, val(
ks,i,j) )
896 call check( __line__, mom(
ks+1,i ,j) )
897 call check( __line__, mom(
ks+1,i+1,j) )
898 call check( __line__, val(
ks+3,i,j) )
899 call check( __line__, val(
ks+2,i,j) )
902 flux(
ks-1,i,j) = 0.0_rp
904 vel = ( 0.5_rp * ( mom(
ks,i,j)+mom(
ks,i+1,j) ) ) &
905 / ( f2h(
ks,1,i_xyz) &
906 * 0.5_rp * ( dens(
ks+1,i,j)+dens(
ks+1,i+1,j) ) &
908 * 0.5_rp * ( dens(
ks,i,j)+dens(
ks,i+1,j) ) )
909 flux(
ks,i,j) = j33g * vel &
910 * ( f2 * ( val(
ks+1,i,j)+val(
ks,i,j) ) ) &
911 + gsqrt(
ks,i,j) * num_diff(
ks,i,j)
912 vel = ( 0.5_rp * ( mom(
ke-1,i,j)+mom(
ke-1,i+1,j) ) ) &
913 / ( f2h(
ke-1,1,i_xyz) &
914 * 0.5_rp * ( dens(
ke,i,j)+dens(
ke,i+1,j) ) &
915 + f2h(
ke-1,2,i_xyz) &
916 * 0.5_rp * ( dens(
ke-1,i,j)+dens(
ke-1,i+1,j) ) )
917 flux(
ke-1,i,j) = j33g * vel &
918 * ( f2 * ( val(
ke,i,j)+val(
ke-1,i,j) ) ) &
919 + gsqrt(
ke-1,i,j) * num_diff(
ke-1,i,j)
921 vel = ( 0.5_rp * ( mom(
ks+1,i,j)+mom(
ks+1,i+1,j) ) ) &
922 / ( f2h(
ks+1,1,i_xyz) &
923 * 0.5_rp * ( dens(
ks+2,i,j)+dens(
ks+2,i+1,j) ) &
924 + f2h(
ks+1,2,i_xyz) &
925 * 0.5_rp * ( dens(
ks+1,i,j)+dens(
ks+1,i+1,j) ) )
926 flux(
ks+1,i,j) = j33g * vel &
927 * ( ( f31 * ( val(
ks+3,i,j)+val(
ks,i,j) ) + f32 * ( val(
ks+2,i,j)+val(
ks+1,i,j) ) ) &
928 - ( f31 * ( val(
ks+3,i,j)-val(
ks,i,j) ) + f33 * ( val(
ks+2,i,j)-val(
ks+1,i,j) ) ) * sign(1.0_rp,vel) ) &
929 + gsqrt(
ks+1,i,j) * num_diff(
ks+1,i,j)
930 vel = ( 0.5_rp * ( mom(
ke-2,i,j)+mom(
ke-2,i+1,j) ) ) &
931 / ( f2h(
ke-2,1,i_xyz) &
932 * 0.5_rp * ( dens(
ke-1,i,j)+dens(
ke-1,i+1,j) ) &
933 + f2h(
ke-2,2,i_xyz) &
934 * 0.5_rp * ( dens(
ke-2,i,j)+dens(
ke-2,i+1,j) ) )
935 flux(
ke-2,i,j) = j33g * vel &
936 * ( ( f31 * ( val(
ke,i,j)+val(
ke-3,i,j) ) + f32 * ( val(
ke-1,i,j)+val(
ke-2,i,j) ) ) &
937 - ( f31 * ( val(
ke,i,j)-val(
ke-3,i,j) ) + f33 * ( val(
ke-1,i,j)-val(
ke-2,i,j) ) ) * sign(1.0_rp,vel) ) &
938 + gsqrt(
ke-2,i,j) * num_diff(
ke-2,i,j)
940 flux(
ke,i,j) = 0.0_rp
944 k = iundef; i = iundef; j = iundef
960 real(RP),
intent(out) :: flux (
ka,
ia,
ja)
961 real(RP),
intent(in) :: mom (
ka,
ia,
ja)
962 real(RP),
intent(in) :: val (
ka,
ia,
ja)
963 real(RP),
intent(in) :: DENS (
ka,
ia,
ja)
964 real(RP),
intent(in) :: GSQRT (
ka,
ia,
ja)
965 real(RP),
intent(in) :: J13G (
ka,
ia,
ja)
966 real(RP),
intent(in) :: MAPF (
ia,
ja,2)
967 real(RP),
intent(in) :: CDZ (
ka)
968 integer,
intent(in) :: IIS, IIE, JJS, JJE
978 vel = ( f2h(k,1,i_uyz) &
983 * 0.5_rp * ( dens(k+1,i,j)+dens(k+1,i+1,j) ) &
985 * 0.5_rp * ( dens(k,i,j)+dens(k,i+1,j) ) )
986 flux(k,i,j) = j13g(k,i,j) / mapf(i,j,+2) * vel &
987 * ( ( f51 * ( val(k+3,i,j)+val(k-2,i,j) ) &
988 + f52 * ( val(k+2,i,j)+val(k-1,i,j) ) &
989 + f53 * ( val(k+1,i,j)+val(k,i,j) ) ) &
990 - ( f51 * ( val(k+3,i,j)-val(k-2,i,j) ) &
991 + f54 * ( val(k+2,i,j)-val(k-1,i,j) ) &
992 + f55 * ( val(k+1,i,j)-val(k,i,j) ) ) * sign(1.0_rp,vel) )
1000 flux(
ks-1,i,j) = 0.0_rp
1002 vel = ( f2h(
ks,1,i_uyz) &
1006 / ( f2h(
ks,1,i_xyz) &
1007 * 0.5_rp * ( dens(
ks+1,i,j)+dens(
ks+1,i+1,j) ) &
1009 * 0.5_rp * ( dens(
ks,i,j)+dens(
ks,i+1,j) ) )
1010 flux(
ks,i,j) = j13g(
ks,i,j) / mapf(i,j,+2) * vel &
1011 * ( f2 * ( val(
ks+1,i,j)+val(
ks,i,j) ) )
1012 vel = ( f2h(
ke-1,1,i_uyz) &
1014 + f2h(
ke-1,2,i_uyz) &
1016 / ( f2h(
ke-1,1,i_xyz) &
1017 * 0.5_rp * ( dens(
ke,i,j)+dens(
ke,i+1,j) ) &
1018 + f2h(
ke-1,2,i_xyz) &
1019 * 0.5_rp * ( dens(
ke-1,i,j)+dens(
ke-1,i+1,j) ) )
1020 flux(
ke-1,i,j) = j13g(
ke-1,i,j) / mapf(i,j,+2) * vel &
1021 * ( f2 * ( val(
ke,i,j)+val(
ke-1,i,j) ) )
1023 vel = ( f2h(
ks+1,1,i_uyz) &
1025 + f2h(
ks+1,2,i_uyz) &
1027 / ( f2h(
ks+1,1,i_xyz) &
1028 * 0.5_rp * ( dens(
ks+2,i,j)+dens(
ks+2,i+1,j) ) &
1029 + f2h(
ks+1,2,i_xyz) &
1030 * 0.5_rp * ( dens(
ks+1,i,j)+dens(
ks+1,i+1,j) ) )
1031 flux(
ks+1,i,j) = j13g(
ks+1,i,j) / mapf(i,j,+2) * vel &
1032 * ( ( f31 * ( val(
ks+3,i,j)+val(
ks,i,j) ) + f32 * ( val(
ks+2,i,j)+val(
ks+1,i,j) ) ) &
1033 - ( f31 * ( val(
ks+3,i,j)-val(
ks,i,j) ) + f33 * ( val(
ks+2,i,j)-val(
ks+1,i,j) ) ) * sign(1.0_rp,vel) )
1034 vel = ( f2h(
ke-2,1,i_uyz) &
1036 + f2h(
ke-2,2,i_uyz) &
1038 / ( f2h(
ke-2,1,i_xyz) &
1039 * 0.5_rp * ( dens(
ke-1,i,j)+dens(
ke-1,i+1,j) ) &
1040 + f2h(
ke-2,2,i_xyz) &
1041 * 0.5_rp * ( dens(
ke-2,i,j)+dens(
ke-2,i+1,j) ) )
1042 flux(
ke-2,i,j) = j13g(
ke-2,i,j) / mapf(i,j,+2) * vel &
1043 * ( ( f31 * ( val(
ke,i,j)+val(
ke-3,i,j) ) + f32 * ( val(
ke-1,i,j)+val(
ke-2,i,j) ) ) &
1044 - ( f31 * ( val(
ke,i,j)-val(
ke-3,i,j) ) + f33 * ( val(
ke-1,i,j)-val(
ke-2,i,j) ) ) * sign(1.0_rp,vel) )
1046 flux(
ke ,i,j) = 0.0_rp
1058 GSQRT, J23G, MAPF, &
1060 IIS, IIE, JJS, JJE )
1063 real(RP),
intent(out) :: flux (
ka,
ia,
ja)
1064 real(RP),
intent(in) :: mom (
ka,
ia,
ja)
1065 real(RP),
intent(in) :: val (
ka,
ia,
ja)
1066 real(RP),
intent(in) :: DENS (
ka,
ia,
ja)
1067 real(RP),
intent(in) :: GSQRT (
ka,
ia,
ja)
1068 real(RP),
intent(in) :: J23G (
ka,
ia,
ja)
1069 real(RP),
intent(in) :: MAPF (
ia,
ja,2)
1070 real(RP),
intent(in) :: CDZ (
ka)
1071 integer,
intent(in) :: IIS, IIE, JJS, JJE
1081 vel = ( f2h(k,1,i_xvz) &
1082 * 0.25_rp * ( mom(k+1,i,j)+mom(k+1,i+1,j)+mom(k+1,i,j-1)+mom(k+1,i+1,j-1) ) &
1084 * 0.25_rp * ( mom(k,i,j)+mom(k,i+1,j)+mom(k,i,j-1)+mom(k,i+1,j-1) ) ) &
1085 / ( f2h(k,1,i_xyz) &
1086 * 0.5_rp * ( dens(k+1,i,j)+dens(k+1,i+1,j) ) &
1088 * 0.5_rp * ( dens(k,i,j)+dens(k,i+1,j) ) )
1089 flux(k,i,j) = j23g(k,i,j) / mapf(i,j,+1) * vel &
1090 * ( ( f51 * ( val(k+3,i,j)+val(k-2,i,j) ) &
1091 + f52 * ( val(k+2,i,j)+val(k-1,i,j) ) &
1092 + f53 * ( val(k+1,i,j)+val(k,i,j) ) ) &
1093 - ( f51 * ( val(k+3,i,j)-val(k-2,i,j) ) &
1094 + f54 * ( val(k+2,i,j)-val(k-1,i,j) ) &
1095 + f55 * ( val(k+1,i,j)-val(k,i,j) ) ) * sign(1.0_rp,vel) )
1103 flux(
ks-1,i,j) = 0.0_rp
1105 vel = ( f2h(
ks,1,i_xvz) &
1106 * 0.25_rp * ( mom(
ks+1,i,j)+mom(
ks+1,i+1,j)+mom(
ks+1,i,j-1)+mom(
ks+1,i+1,j-1) ) &
1108 * 0.25_rp * ( mom(
ks,i,j)+mom(
ks,i+1,j)+mom(
ks,i,j-1)+mom(
ks,i+1,j-1) ) ) &
1109 / ( f2h(
ks,1,i_xyz) &
1110 * 0.5_rp * ( dens(
ks+1,i,j)+dens(
ks+1,i+1,j) ) &
1112 * 0.5_rp * ( dens(
ks,i,j)+dens(
ks,i+1,j) ) )
1113 flux(
ks,i,j) = j23g(
ks,i,j) / mapf(i,j,+1) * vel &
1114 * ( f2 * ( val(
ks+1,i,j)+val(
ks,i,j) ) )
1115 vel = ( f2h(
ke-1,1,i_xvz) &
1116 * 0.25_rp * ( mom(
ke,i,j)+mom(
ke,i+1,j)+mom(
ke,i,j-1)+mom(
ke,i+1,j-1) ) &
1117 + f2h(
ke-1,2,i_xvz) &
1118 * 0.25_rp * ( mom(
ke-1,i,j)+mom(
ke-1,i+1,j)+mom(
ke-1,i,j-1)+mom(
ke-1,i+1,j-1) ) ) &
1119 / ( f2h(
ke-1,1,i_xyz) &
1120 * 0.5_rp * ( dens(
ke,i,j)+dens(
ke,i+1,j) ) &
1121 + f2h(
ke-1,2,i_xyz) &
1122 * 0.5_rp * ( dens(
ke-1,i,j)+dens(
ke-1,i+1,j) ) )
1123 flux(
ke-1,i,j) = j23g(
ke-1,i,j) / mapf(i,j,+1) * vel &
1124 * ( f2 * ( val(
ke,i,j)+val(
ke-1,i,j) ) )
1126 vel = ( f2h(
ks+1,1,i_xvz) &
1127 * 0.25_rp * ( mom(
ks+2,i,j)+mom(
ks+2,i+1,j)+mom(
ks+2,i,j-1)+mom(
ks+2,i+1,j-1) ) &
1128 + f2h(
ks+1,2,i_xvz) &
1129 * 0.25_rp * ( mom(
ks+1,i,j)+mom(
ks+1,i+1,j)+mom(
ks+1,i,j-1)+mom(
ks+1,i+1,j-1) ) ) &
1130 / ( f2h(
ks+1,1,i_xyz) &
1131 * 0.5_rp * ( dens(
ks+2,i,j)+dens(
ks+2,i+1,j) ) &
1132 + f2h(
ks+1,2,i_xyz) &
1133 * 0.5_rp * ( dens(
ks+1,i,j)+dens(
ks+1,i+1,j) ) )
1134 flux(
ks+1,i,j) = j23g(
ks+1,i,j) / mapf(i,j,+1) * vel &
1135 * ( ( f31 * ( val(
ks+3,i,j)+val(
ks,i,j) ) + f32 * ( val(
ks+2,i,j)+val(
ks+1,i,j) ) ) &
1136 - ( f31 * ( val(
ks+3,i,j)-val(
ks,i,j) ) + f33 * ( val(
ks+2,i,j)-val(
ks+1,i,j) ) ) * sign(1.0_rp,vel) )
1137 vel = ( f2h(
ke-2,1,i_xvz) &
1138 * 0.25_rp * ( mom(
ke-1,i,j)+mom(
ke-1,i+1,j)+mom(
ke-1,i,j-1)+mom(
ke-1,i+1,j-1) ) &
1139 + f2h(
ke-2,2,i_xvz) &
1140 * 0.25_rp * ( mom(
ke-2,i,j)+mom(
ke-2,i+1,j)+mom(
ke-2,i,j-1)+mom(
ke-2,i+1,j-1) ) ) &
1141 / ( f2h(
ke-2,1,i_xyz) &
1142 * 0.5_rp * ( dens(
ke-1,i,j)+dens(
ke-1,i+1,j) ) &
1143 + f2h(
ke-2,2,i_xyz) &
1144 * 0.5_rp * ( dens(
ke-2,i,j)+dens(
ke-2,i+1,j) ) )
1145 flux(
ke-2,i,j) = j23g(
ke-2,i,j) / mapf(i,j,+1) * vel &
1146 * ( ( f31 * ( val(
ke,i,j)+val(
ke-3,i,j) ) + f32 * ( val(
ke-1,i,j)+val(
ke-2,i,j) ) ) &
1147 - ( f31 * ( val(
ke,i,j)-val(
ke-3,i,j) ) + f33 * ( val(
ke-1,i,j)-val(
ke-2,i,j) ) ) * sign(1.0_rp,vel) )
1149 flux(
ke ,i,j) = 0.0_rp
1166 IIS, IIE, JJS, JJE )
1169 real(RP),
intent(out) :: flux (
ka,
ia,
ja)
1170 real(RP),
intent(in) :: mom (
ka,
ia,
ja)
1171 real(RP),
intent(in) :: val (
ka,
ia,
ja)
1172 real(RP),
intent(in) :: DENS (
ka,
ia,
ja)
1173 real(RP),
intent(in) :: GSQRT (
ka,
ia,
ja)
1174 real(RP),
intent(in) :: MAPF (
ia,
ja,2)
1176 real(RP),
intent(in) :: num_diff(
ka,
ia,
ja)
1178 real(RP),
intent(in) :: CDZ (
ka)
1179 integer,
intent(in) :: IIS, IIE, JJS, JJE
1192 call check( __line__, mom(k,i ,j) )
1193 call check( __line__, mom(k,i-1,j) )
1195 call check( __line__, val(k,i-1,j) )
1196 call check( __line__, val(k,i,j) )
1198 call check( __line__, val(k,i-2,j) )
1199 call check( __line__, val(k,i+1,j) )
1201 call check( __line__, val(k,i-3,j) )
1202 call check( __line__, val(k,i+2,j) )
1205 vel = ( 0.5_rp * ( mom(k,i,j)+mom(k,i-1,j) ) ) &
1207 flux(k,i-1,j) = gsqrt(k,i,j) / mapf(i,j,+2) * vel &
1208 * ( ( f51 * ( val(k,i+2,j)+val(k,i-3,j) ) &
1209 + f52 * ( val(k,i+1,j)+val(k,i-2,j) ) &
1210 + f53 * ( val(k,i,j)+val(k,i-1,j) ) ) &
1211 - ( f51 * ( val(k,i+2,j)-val(k,i-3,j) ) &
1212 + f54 * ( val(k,i+1,j)-val(k,i-2,j) ) &
1213 + f55 * ( val(k,i,j)-val(k,i-1,j) ) ) * sign(1.0_rp,vel) ) &
1214 + gsqrt(k,i,j) * num_diff(k,i,j)
1219 k = iundef; i = iundef; j = iundef
1235 IIS, IIE, JJS, JJE )
1238 real(RP),
intent(out) :: flux (
ka,
ia,
ja)
1239 real(RP),
intent(in) :: mom (
ka,
ia,
ja)
1240 real(RP),
intent(in) :: val (
ka,
ia,
ja)
1241 real(RP),
intent(in) :: DENS (
ka,
ia,
ja)
1242 real(RP),
intent(in) :: GSQRT (
ka,
ia,
ja)
1243 real(RP),
intent(in) :: MAPF (
ia,
ja,2)
1245 real(RP),
intent(in) :: num_diff(
ka,
ia,
ja)
1247 real(RP),
intent(in) :: CDZ (
ka)
1248 integer,
intent(in) :: IIS, IIE, JJS, JJE
1259 call check( __line__, mom(k,i ,j) )
1260 call check( __line__, mom(k,i-1,j) )
1262 call check( __line__, val(k,i,j) )
1263 call check( __line__, val(k,i,j+1) )
1265 call check( __line__, val(k,i,j-1) )
1266 call check( __line__, val(k,i,j+2) )
1268 call check( __line__, val(k,i,j-2) )
1269 call check( __line__, val(k,i,j+3) )
1272 vel = ( 0.5_rp * ( mom(k,i,j)+mom(k,i+1,j) ) ) &
1273 / ( 0.25_rp * ( dens(k,i,j)+dens(k,i+1,j)+dens(k,i,j+1)+dens(k,i+1,j+1) ) )
1274 flux(k,i,j) = gsqrt(k,i,j) / mapf(i,j,+1) * vel &
1275 * ( ( f51 * ( val(k,i,j+3)+val(k,i,j-2) ) &
1276 + f52 * ( val(k,i,j+2)+val(k,i,j-1) ) &
1277 + f53 * ( val(k,i,j+1)+val(k,i,j) ) ) &
1278 - ( f51 * ( val(k,i,j+3)-val(k,i,j-2) ) &
1279 + f54 * ( val(k,i,j+2)-val(k,i,j-1) ) &
1280 + f55 * ( val(k,i,j+1)-val(k,i,j) ) ) * sign(1.0_rp,vel) ) &
1281 + gsqrt(k,i,j) * num_diff(k,i,j)
1286 k = iundef; i = iundef; j = iundef
1304 IIS, IIE, JJS, JJE )
1307 real(RP),
intent(out) :: flux (
ka,
ia,
ja)
1308 real(RP),
intent(in) :: mom (
ka,
ia,
ja)
1309 real(RP),
intent(in) :: val (
ka,
ia,
ja)
1310 real(RP),
intent(in) :: DENS (
ka,
ia,
ja)
1311 real(RP),
intent(in) :: GSQRT (
ka,
ia,
ja)
1312 real(RP),
intent(in) :: J33G
1314 real(RP),
intent(in) :: num_diff(
ka,
ia,
ja)
1316 real(RP),
intent(in) :: CDZ (
ka)
1317 integer,
intent(in) :: IIS, IIE, JJS, JJE
1328 call check( __line__, mom(k,i,j) )
1329 call check( __line__, mom(k,i,j+1) )
1331 call check( __line__, val(k,i,j) )
1332 call check( __line__, val(k+1,i,j) )
1334 call check( __line__, val(k-1,i,j) )
1335 call check( __line__, val(k+2,i,j) )
1337 call check( __line__, val(k-2,i,j) )
1338 call check( __line__, val(k+3,i,j) )
1341 vel = ( 0.5_rp * ( mom(k,i,j)+mom(k,i,j+1) ) ) &
1342 / ( f2h(k,1,i_xyz) &
1343 * 0.5_rp * ( dens(k+1,i,j)+dens(k+1,i,j+1) ) &
1345 * 0.5_rp * ( dens(k,i,j)+dens(k,i,j+1) ) )
1346 flux(k,i,j) = j33g * vel &
1347 * ( ( f51 * ( val(k+3,i,j)+val(k-2,i,j) ) &
1348 + f52 * ( val(k+2,i,j)+val(k-1,i,j) ) &
1349 + f53 * ( val(k+1,i,j)+val(k,i,j) ) ) &
1350 - ( f51 * ( val(k+3,i,j)-val(k-2,i,j) ) &
1351 + f54 * ( val(k+2,i,j)-val(k-1,i,j) ) &
1352 + f55 * ( val(k+1,i,j)-val(k,i,j) ) ) * sign(1.0_rp,vel) ) &
1353 + gsqrt(k,i,j) * num_diff(k,i,j)
1358 k = iundef; i = iundef; j = iundef
1366 call check( __line__, mom(
ks,i ,j) )
1367 call check( __line__, mom(
ks,i,j+1) )
1368 call check( __line__, val(
ks+1,i,j) )
1369 call check( __line__, val(
ks,i,j) )
1371 call check( __line__, mom(
ks+1,i ,j) )
1372 call check( __line__, mom(
ks+1,i,j+1) )
1373 call check( __line__, val(
ks+3,i,j) )
1374 call check( __line__, val(
ks+2,i,j) )
1377 flux(
ks-1,i,j) = 0.0_rp
1379 vel = ( 0.5_rp * ( mom(
ks,i,j)+mom(
ks,i,j+1) ) ) &
1380 / ( f2h(
ks,1,i_xyz) &
1381 * 0.5_rp * ( dens(
ks+1,i,j)+dens(
ks+1,i,j+1) ) &
1383 * 0.5_rp * ( dens(
ks,i,j)+dens(
ks,i,j+1) ) )
1384 flux(
ks,i,j) = j33g * vel &
1385 * ( f2 * ( val(
ks+1,i,j)+val(
ks,i,j) ) ) &
1386 + gsqrt(
ks,i,j) * num_diff(
ks,i,j)
1387 vel = ( 0.5_rp * ( mom(
ke-1,i,j)+mom(
ke-1,i,j+1) ) ) &
1388 / ( f2h(
ke-1,1,i_xyz) &
1389 * 0.5_rp * ( dens(
ke,i,j)+dens(
ke,i,j+1) ) &
1390 + f2h(
ke-1,2,i_xyz) &
1391 * 0.5_rp * ( dens(
ke-1,i,j)+dens(
ke-1,i,j+1) ) )
1392 flux(
ke-1,i,j) = j33g * vel &
1393 * ( f2 * ( val(
ke,i,j)+val(
ke-1,i,j) ) ) &
1394 + gsqrt(
ke-1,i,j) * num_diff(
ke-1,i,j)
1396 vel = ( 0.5_rp * ( mom(
ks+1,i,j)+mom(
ks+1,i,j+1) ) ) &
1397 / ( f2h(
ks+1,1,i_xyz) &
1398 * 0.5_rp * ( dens(
ks+2,i,j)+dens(
ks+2,i,j+1) ) &
1399 + f2h(
ks+1,2,i_xyz) &
1400 * 0.5_rp * ( dens(
ks+1,i,j)+dens(
ks+1,i,j+1) ) )
1401 flux(
ks+1,i,j) = j33g * vel &
1402 * ( ( f31 * ( val(
ks+3,i,j)+val(
ks,i,j) ) + f32 * ( val(
ks+2,i,j)+val(
ks+1,i,j) ) ) &
1403 - ( f31 * ( val(
ks+3,i,j)-val(
ks,i,j) ) + f33 * ( val(
ks+2,i,j)-val(
ks+1,i,j) ) ) * sign(1.0_rp,vel) ) &
1404 + gsqrt(
ks+1,i,j) * num_diff(
ks+1,i,j)
1405 vel = ( 0.5_rp * ( mom(
ke-2,i,j)+mom(
ke-2,i,j+1) ) ) &
1406 / ( f2h(
ke-2,1,i_xyz) &
1407 * 0.5_rp * ( dens(
ke-1,i,j)+dens(
ke-1,i,j+1) ) &
1408 + f2h(
ke-2,2,i_xyz) &
1409 * 0.5_rp * ( dens(
ke-2,i,j)+dens(
ke-2,i,j+1) ) )
1410 flux(
ke-2,i,j) = j33g * vel &
1411 * ( ( f31 * ( val(
ke,i,j)+val(
ke-3,i,j) ) + f32 * ( val(
ke-1,i,j)+val(
ke-2,i,j) ) ) &
1412 - ( f31 * ( val(
ke,i,j)-val(
ke-3,i,j) ) + f33 * ( val(
ke-1,i,j)-val(
ke-2,i,j) ) ) * sign(1.0_rp,vel) ) &
1413 + gsqrt(
ke-2,i,j) * num_diff(
ke-2,i,j)
1415 flux(
ke,i,j) = 0.0_rp
1419 k = iundef; i = iundef; j = iundef
1430 GSQRT, J13G, MAPF, &
1432 IIS, IIE, JJS, JJE )
1435 real(RP),
intent(out) :: flux (
ka,
ia,
ja)
1436 real(RP),
intent(in) :: mom (
ka,
ia,
ja)
1437 real(RP),
intent(in) :: val (
ka,
ia,
ja)
1438 real(RP),
intent(in) :: DENS (
ka,
ia,
ja)
1439 real(RP),
intent(in) :: GSQRT (
ka,
ia,
ja)
1440 real(RP),
intent(in) :: J13G (
ka,
ia,
ja)
1441 real(RP),
intent(in) :: MAPF (
ia,
ja,2)
1442 real(RP),
intent(in) :: CDZ (
ka)
1443 integer,
intent(in) :: IIS, IIE, JJS, JJE
1453 vel = ( f2h(k,1,i_uyz) &
1454 * 0.25_rp * ( mom(k+1,i,j)+mom(k+1,i-1,j)+mom(k+1,i,j+1)+mom(k+1,i-1,j+1) ) &
1456 * 0.25_rp * ( mom(k,i,j)+mom(k,i-1,j)+mom(k,i,j+1)+mom(k,i-1,j+1) ) ) &
1457 / ( f2h(k,1,i_xyz) &
1458 * 0.5_rp * ( dens(k+1,i,j)+dens(k+1,i,j+1) ) &
1460 * 0.5_rp * ( dens(k,i,j)+dens(k,i,j+1) ) )
1461 flux(k,i,j) = j13g(k,i,j) / mapf(i,j,+2) * vel &
1462 * ( ( f51 * ( val(k+3,i,j)+val(k-2,i,j) ) &
1463 + f52 * ( val(k+2,i,j)+val(k-1,i,j) ) &
1464 + f53 * ( val(k+1,i,j)+val(k,i,j) ) ) &
1465 - ( f51 * ( val(k+3,i,j)-val(k-2,i,j) ) &
1466 + f54 * ( val(k+2,i,j)-val(k-1,i,j) ) &
1467 + f55 * ( val(k+1,i,j)-val(k,i,j) ) ) * sign(1.0_rp,vel) )
1475 flux(
ks-1,i,j) = 0.0_rp
1477 vel = ( f2h(
ks,1,i_uyz) &
1478 * 0.25_rp * ( mom(
ks+1,i,j)+mom(
ks+1,i-1,j)+mom(
ks+1,i,j+1)+mom(
ks+1,i-1,j+1) ) &
1480 * 0.25_rp * ( mom(
ks,i,j)+mom(
ks,i-1,j)+mom(
ks,i,j+1)+mom(
ks,i-1,j+1) ) ) &
1481 / ( f2h(
ks,1,i_xyz) &
1482 * 0.5_rp * ( dens(
ks+1,i,j)+dens(
ks+1,i,j+1) ) &
1484 * 0.5_rp * ( dens(
ks,i,j)+dens(
ks,i,j+1) ) )
1485 flux(
ks,i,j) = j13g(
ks,i,j) / mapf(i,j,+2) * vel &
1486 * ( f2 * ( val(
ks+1,i,j)+val(
ks,i,j) ) )
1487 vel = ( f2h(
ke-1,1,i_uyz) &
1488 * 0.25_rp * ( mom(
ke,i,j)+mom(
ke,i-1,j)+mom(
ke,i,j+1)+mom(
ke,i-1,j+1) ) &
1489 + f2h(
ke-1,2,i_uyz) &
1490 * 0.25_rp * ( mom(
ke-1,i,j)+mom(
ke-1,i-1,j)+mom(
ke-1,i,j+1)+mom(
ke-1,i-1,j+1) ) ) &
1491 / ( f2h(
ke-1,1,i_xyz) &
1492 * 0.5_rp * ( dens(
ke,i,j)+dens(
ke,i,j+1) ) &
1493 + f2h(
ke-1,2,i_xyz) &
1494 * 0.5_rp * ( dens(
ke-1,i,j)+dens(
ke-1,i,j+1) ) )
1495 flux(
ke-1,i,j) = j13g(
ke-1,i,j) / mapf(i,j,+2) * vel &
1496 * ( f2 * ( val(
ke,i,j)+val(
ke-1,i,j) ) )
1498 vel = ( f2h(
ks+1,1,i_uyz) &
1499 * 0.25_rp * ( mom(
ks+2,i,j)+mom(
ks+2,i-1,j)+mom(
ks+2,i,j+1)+mom(
ks+2,i-1,j+1) ) &
1500 + f2h(
ks+1,2,i_uyz) &
1501 * 0.25_rp * ( mom(
ks+1,i,j)+mom(
ks+1,i-1,j)+mom(
ks+1,i,j+1)+mom(
ks+1,i-1,j+1) ) ) &
1502 / ( f2h(
ks+1,1,i_xyz) &
1503 * 0.5_rp * ( dens(
ks+2,i,j)+dens(
ks+2,i,j+1) ) &
1504 + f2h(
ks+1,2,i_xyz) &
1505 * 0.5_rp * ( dens(
ks+1,i,j)+dens(
ks+1,i,j+1) ) )
1506 flux(
ks+1,i,j) = j13g(
ks+1,i,j) / mapf(i,j,+2) * vel &
1507 * ( ( f31 * ( val(
ks+3,i,j)+val(
ks,i,j) ) + f32 * ( val(
ks+2,i,j)+val(
ks+1,i,j) ) ) &
1508 - ( f31 * ( val(
ks+3,i,j)-val(
ks,i,j) ) + f33 * ( val(
ks+2,i,j)-val(
ks+1,i,j) ) ) * sign(1.0_rp,vel) )
1509 vel = ( f2h(
ke-2,1,i_uyz) &
1510 * 0.25_rp * ( mom(
ke-1,i,j)+mom(
ke-1,i-1,j)+mom(
ke-1,i,j+1)+mom(
ke-1,i-1,j+1) ) &
1511 + f2h(
ke-2,2,i_uyz) &
1512 * 0.25_rp * ( mom(
ke-2,i,j)+mom(
ke-2,i-1,j)+mom(
ke-2,i,j+1)+mom(
ke-2,i-1,j+1) ) ) &
1513 / ( f2h(
ke-2,1,i_xyz) &
1514 * 0.5_rp * ( dens(
ke-1,i,j)+dens(
ke-1,i,j+1) ) &
1515 + f2h(
ke-2,2,i_xyz) &
1516 * 0.5_rp * ( dens(
ke-2,i,j)+dens(
ke-2,i,j+1) ) )
1517 flux(
ke-2,i,j) = j13g(
ke-2,i,j) / mapf(i,j,+2) * vel &
1518 * ( ( f31 * ( val(
ke,i,j)+val(
ke-3,i,j) ) + f32 * ( val(
ke-1,i,j)+val(
ke-2,i,j) ) ) &
1519 - ( f31 * ( val(
ke,i,j)-val(
ke-3,i,j) ) + f33 * ( val(
ke-1,i,j)-val(
ke-2,i,j) ) ) * sign(1.0_rp,vel) )
1521 flux(
ke ,i,j) = 0.0_rp
1533 GSQRT, J23G, MAPF, &
1535 IIS, IIE, JJS, JJE )
1538 real(RP),
intent(out) :: flux (
ka,
ia,
ja)
1539 real(RP),
intent(in) :: mom (
ka,
ia,
ja)
1540 real(RP),
intent(in) :: val (
ka,
ia,
ja)
1541 real(RP),
intent(in) :: DENS (
ka,
ia,
ja)
1542 real(RP),
intent(in) :: GSQRT (
ka,
ia,
ja)
1543 real(RP),
intent(in) :: J23G (
ka,
ia,
ja)
1544 real(RP),
intent(in) :: MAPF (
ia,
ja,2)
1545 real(RP),
intent(in) :: CDZ (
ka)
1546 integer,
intent(in) :: IIS, IIE, JJS, JJE
1556 vel = ( f2h(k,1,i_xvz) &
1560 / ( f2h(k,1,i_xyz) &
1561 * 0.5_rp * ( dens(k+1,i,j)+dens(k+1,i,j+1) ) &
1563 * 0.5_rp * ( dens(k,i,j)+dens(k,i,j+1) ) )
1564 flux(k,i,j) = j23g(k,i,j) / mapf(i,j,+1) * vel &
1565 * ( ( f51 * ( val(k+3,i,j)+val(k-2,i,j) ) &
1566 + f52 * ( val(k+2,i,j)+val(k-1,i,j) ) &
1567 + f53 * ( val(k+1,i,j)+val(k,i,j) ) ) &
1568 - ( f51 * ( val(k+3,i,j)-val(k-2,i,j) ) &
1569 + f54 * ( val(k+2,i,j)-val(k-1,i,j) ) &
1570 + f55 * ( val(k+1,i,j)-val(k,i,j) ) ) * sign(1.0_rp,vel) )
1578 flux(
ks-1,i,j) = 0.0_rp
1580 vel = ( f2h(
ks,1,i_xvz) &
1584 / ( f2h(
ks,1,i_xyz) &
1585 * 0.5_rp * ( dens(
ks+1,i,j)+dens(
ks+1,i,j+1) ) &
1587 * 0.5_rp * ( dens(
ks,i,j)+dens(
ks,i,j+1) ) )
1588 flux(
ks,i,j) = j23g(
ks,i,j) / mapf(i,j,+1) * vel &
1589 * ( f2 * ( val(
ks+1,i,j)+val(
ks,i,j) ) )
1590 vel = ( f2h(
ke-1,1,i_xvz) &
1592 + f2h(
ke-1,2,i_xvz) &
1594 / ( f2h(
ke-1,1,i_xyz) &
1595 * 0.5_rp * ( dens(
ke,i,j)+dens(
ke,i,j+1) ) &
1596 + f2h(
ke-1,2,i_xyz) &
1597 * 0.5_rp * ( dens(
ke-1,i,j)+dens(
ke-1,i,j+1) ) )
1598 flux(
ke-1,i,j) = j23g(
ke-1,i,j) / mapf(i,j,+1) * vel &
1599 * ( f2 * ( val(
ke,i,j)+val(
ke-1,i,j) ) )
1601 vel = ( f2h(
ks+1,1,i_xvz) &
1603 + f2h(
ks+1,2,i_xvz) &
1605 / ( f2h(
ks+1,1,i_xyz) &
1606 * 0.5_rp * ( dens(
ks+2,i,j)+dens(
ks+2,i,j+1) ) &
1607 + f2h(
ks+1,2,i_xyz) &
1608 * 0.5_rp * ( dens(
ks+1,i,j)+dens(
ks+1,i,j+1) ) )
1609 flux(
ks+1,i,j) = j23g(
ks+1,i,j) / mapf(i,j,+1) * vel &
1610 * ( ( f31 * ( val(
ks+3,i,j)+val(
ks,i,j) ) + f32 * ( val(
ks+2,i,j)+val(
ks+1,i,j) ) ) &
1611 - ( f31 * ( val(
ks+3,i,j)-val(
ks,i,j) ) + f33 * ( val(
ks+2,i,j)-val(
ks+1,i,j) ) ) * sign(1.0_rp,vel) )
1612 vel = ( f2h(
ke-2,1,i_xvz) &
1614 + f2h(
ke-2,2,i_xvz) &
1616 / ( f2h(
ke-2,1,i_xyz) &
1617 * 0.5_rp * ( dens(
ke-1,i,j)+dens(
ke-1,i,j+1) ) &
1618 + f2h(
ke-2,2,i_xyz) &
1619 * 0.5_rp * ( dens(
ke-2,i,j)+dens(
ke-2,i,j+1) ) )
1620 flux(
ke-2,i,j) = j23g(
ke-2,i,j) / mapf(i,j,+1) * vel &
1621 * ( ( f31 * ( val(
ke,i,j)+val(
ke-3,i,j) ) + f32 * ( val(
ke-1,i,j)+val(
ke-2,i,j) ) ) &
1622 - ( f31 * ( val(
ke,i,j)-val(
ke-3,i,j) ) + f33 * ( val(
ke-1,i,j)-val(
ke-2,i,j) ) ) * sign(1.0_rp,vel) )
1624 flux(
ke ,i,j) = 0.0_rp
1641 IIS, IIE, JJS, JJE )
1644 real(RP),
intent(out) :: flux (
ka,
ia,
ja)
1645 real(RP),
intent(in) :: mom (
ka,
ia,
ja)
1646 real(RP),
intent(in) :: val (
ka,
ia,
ja)
1647 real(RP),
intent(in) :: DENS (
ka,
ia,
ja)
1648 real(RP),
intent(in) :: GSQRT (
ka,
ia,
ja)
1649 real(RP),
intent(in) :: MAPF (
ia,
ja,2)
1651 real(RP),
intent(in) :: num_diff(
ka,
ia,
ja)
1653 real(RP),
intent(in) :: CDZ (
ka)
1654 integer,
intent(in) :: IIS, IIE, JJS, JJE
1665 call check( __line__, mom(k,i ,j) )
1666 call check( __line__, mom(k,i,j-1) )
1668 call check( __line__, val(k,i,j) )
1669 call check( __line__, val(k,i+1,j) )
1671 call check( __line__, val(k,i-1,j) )
1672 call check( __line__, val(k,i+2,j) )
1674 call check( __line__, val(k,i-2,j) )
1675 call check( __line__, val(k,i+3,j) )
1678 vel = ( 0.5_rp * ( mom(k,i,j)+mom(k,i,j+1) ) ) &
1679 / ( 0.25_rp * ( dens(k,i,j)+dens(k,i+1,j)+dens(k,i,j+1)+dens(k,i+1,j+1) ) )
1680 flux(k,i,j) = gsqrt(k,i,j) / mapf(i,j,+2) * vel &
1681 * ( ( f51 * ( val(k,i+3,j)+val(k,i-2,j) ) &
1682 + f52 * ( val(k,i+2,j)+val(k,i-1,j) ) &
1683 + f53 * ( val(k,i+1,j)+val(k,i,j) ) ) &
1684 - ( f51 * ( val(k,i+3,j)-val(k,i-2,j) ) &
1685 + f54 * ( val(k,i+2,j)-val(k,i-1,j) ) &
1686 + f55 * ( val(k,i+1,j)-val(k,i,j) ) ) * sign(1.0_rp,vel) ) &
1687 + gsqrt(k,i,j) * num_diff(k,i,j)
1692 k = iundef; i = iundef; j = iundef
1708 IIS, IIE, JJS, JJE )
1711 real(RP),
intent(out) :: flux (
ka,
ia,
ja)
1712 real(RP),
intent(in) :: mom (
ka,
ia,
ja)
1713 real(RP),
intent(in) :: val (
ka,
ia,
ja)
1714 real(RP),
intent(in) :: DENS (
ka,
ia,
ja)
1715 real(RP),
intent(in) :: GSQRT (
ka,
ia,
ja)
1716 real(RP),
intent(in) :: MAPF (
ia,
ja,2)
1718 real(RP),
intent(in) :: num_diff(
ka,
ia,
ja)
1720 real(RP),
intent(in) :: CDZ (
ka)
1721 integer,
intent(in) :: IIS, IIE, JJS, JJE
1734 call check( __line__, mom(k,i ,j) )
1735 call check( __line__, mom(k,i,j-1) )
1737 call check( __line__, val(k,i,j-1) )
1738 call check( __line__, val(k,i,j) )
1740 call check( __line__, val(k,i,j-2) )
1741 call check( __line__, val(k,i,j+1) )
1743 call check( __line__, val(k,i,j-3) )
1744 call check( __line__, val(k,i,j+2) )
1747 vel = ( 0.5_rp * ( mom(k,i,j)+mom(k,i,j-1) ) ) &
1749 flux(k,i,j-1) = gsqrt(k,i,j) / mapf(i,j,+1) * vel &
1750 * ( ( f51 * ( val(k,i,j+2)+val(k,i,j-3) ) &
1751 + f52 * ( val(k,i,j+1)+val(k,i,j-2) ) &
1752 + f53 * ( val(k,i,j)+val(k,i,j-1) ) ) &
1753 - ( f51 * ( val(k,i,j+2)-val(k,i,j-3) ) &
1754 + f54 * ( val(k,i,j+1)-val(k,i,j-2) ) &
1755 + f55 * ( val(k,i,j)-val(k,i,j-1) ) ) * sign(1.0_rp,vel) ) &
1756 + gsqrt(k,i,j) * num_diff(k,i,j)
1761 k = iundef; i = iundef; j = iundef
subroutine, public atmos_dyn_fvm_fluxy_xyw_ud5(flux, mom, val, DENS, GSQRT, MAPF, num_diff, CDZ, IIS, IIE, JJS, JJE)
calculation Y-flux at XYW
subroutine, public atmos_dyn_fvm_fluxj23_uyz_ud5(flux, mom, val, DENS, GSQRT, J23G, MAPF, CDZ, IIS, IIE, JJS, JJE)
calculation J23-flux at UYZ
subroutine, public atmos_dyn_fvm_fluxz_xvz_ud5(flux, mom, val, DENS, GSQRT, J33G, num_diff, CDZ, IIS, IIE, JJS, JJE)
calculation z-flux at XV
subroutine, public atmos_dyn_fvm_fluxj23_xvz_ud5(flux, mom, val, DENS, GSQRT, J23G, MAPF, CDZ, IIS, IIE, JJS, JJE)
calculation J23-flux at XVZ
integer, public ke
end point of inner domain: z, local
subroutine, public atmos_dyn_fvm_fluxj13_xyw_ud5(flux, mom, val, DENS, GSQRT, J13G, MAPF, CDZ, IIS, IIE, JJS, JJE)
calculation J13-flux at XYW
subroutine, public check(current_line, v)
Undefined value checker.
real(rp), public const_undef
subroutine, public atmos_dyn_fvm_fluxz_xyw_ud5(flux, mom, val, DENS, GSQRT, J33G, num_diff, CDZ, FDZ, dtrk, IIS, IIE, JJS, JJE)
calculation z-flux at XYW
module scale_atmos_dyn_fvm_flux_ud5
integer, public ia
of x whole cells (local, with HALO)
subroutine, public atmos_dyn_fvm_fluxj23_xyw_ud5(flux, mom, val, DENS, GSQRT, J23G, MAPF, CDZ, IIS, IIE, JJS, JJE)
calculation J23-flux at XYW
integer, public ka
of z whole cells (local, with HALO)
subroutine, public atmos_dyn_fvm_fluxx_xyw_ud5(flux, mom, val, DENS, GSQRT, MAPF, num_diff, CDZ, IIS, IIE, JJS, JJE)
calculation X-flux at XYW
subroutine, public atmos_dyn_fvm_fluxy_xvz_ud5(flux, mom, val, DENS, GSQRT, MAPF, num_diff, CDZ, IIS, IIE, JJS, JJE)
calculation Y-flux at XV
integer, parameter, public const_undef2
undefined value (INT2)
subroutine, public atmos_dyn_fvm_fluxj13_uyz_ud5(flux, mom, val, DENS, GSQRT, J13G, MAPF, CDZ, IIS, IIE, JJS, JJE)
calculation J13-flux at UYZ
subroutine, public atmos_dyn_fvm_fluxx_uyz_ud5(flux, mom, val, DENS, GSQRT, MAPF, num_diff, CDZ, IIS, IIE, JJS, JJE)
calculation X-flux at UY
integer, public ks
start point of inner domain: z, local
subroutine, public atmos_dyn_fvm_fluxy_uyz_ud5(flux, mom, val, DENS, GSQRT, MAPF, num_diff, CDZ, IIS, IIE, JJS, JJE)
calculation Y-flux at UY
subroutine, public atmos_dyn_fvm_fluxj13_xvz_ud5(flux, mom, val, DENS, GSQRT, J13G, MAPF, CDZ, IIS, IIE, JJS, JJE)
calculation J13-flux at XVZ
subroutine, public atmos_dyn_fvm_fluxz_uyz_ud5(flux, mom, val, DENS, GSQRT, J33G, num_diff, CDZ, IIS, IIE, JJS, JJE)
calculation z-flux at UY
subroutine, public atmos_dyn_fvm_fluxz_xyz_ud5(flux, mflx, val, GSQRT, num_diff, CDZ, IIS, IIE, JJS, JJE)
calculation z-flux at XYZ
subroutine, public atmos_dyn_fvm_fluxx_xvz_ud5(flux, mom, val, DENS, GSQRT, MAPF, num_diff, CDZ, IIS, IIE, JJS, JJE)
calculation X-flux at XV
subroutine, public atmos_dyn_fvm_fluxx_xyz_ud5(flux, mflx, val, GSQRT, num_diff, CDZ, IIS, IIE, JJS, JJE)
calculation X-flux at XYZ
subroutine, public atmos_dyn_fvm_flux_valuew_z_ud5(valW, mflx, val, GSQRT, CDZ)
value at XYW
integer, public ja
of y whole cells (local, with HALO)
subroutine, public atmos_dyn_fvm_fluxy_xyz_ud5(flux, mflx, val, GSQRT, num_diff, CDZ, IIS, IIE, JJS, JJE)
calculation Y-flux at XYZ