122 & LBi, UBi, LBj, UBj, &
123 & IminS, ImaxS, JminS, JmaxS, &
124 & nrhs, nstp, nnew, &
126 & rmask, umask, vmask, &
129 & rmask_wet, umask_wet, vmask_wet, &
131 & omn, om_u, om_v, on_u, on_v, &
139# if defined FLOATS_NOT_YET && defined FLOAT_VWALK
142# ifdef DIAGNOSTICS_TS
163 integer,
intent(in) :: ng, tile
164 integer,
intent(in) :: LBi, UBi, LBj, UBj
165 integer,
intent(in) :: IminS, ImaxS, JminS, JmaxS
166 integer,
intent(in) :: nrhs, nstp, nnew
170 real(r8),
intent(in) :: rmask(LBi:,LBj:)
171 real(r8),
intent(in) :: umask(LBi:,LBj:)
172 real(r8),
intent(in) :: vmask(LBi:,LBj:)
175 real(r8),
intent(in) :: rmask_wet(LBi:,LBj:)
176 real(r8),
intent(in) :: umask_wet(LBi:,LBj:)
177 real(r8),
intent(in) :: vmask_wet(LBi:,LBj:)
179 real(r8),
intent(in) :: omn(LBi:,LBj:)
180 real(r8),
intent(in) :: om_u(LBi:,LBj:)
181 real(r8),
intent(in) :: om_v(LBi:,LBj:)
182 real(r8),
intent(in) :: on_u(LBi:,LBj:)
183 real(r8),
intent(in) :: on_v(LBi:,LBj:)
184 real(r8),
intent(in) :: pm(LBi:,LBj:)
185 real(r8),
intent(in) :: pn(LBi:,LBj:)
186 real(r8),
intent(in) :: Hz(LBi:,LBj:,:)
187 real(r8),
intent(in) :: Huon(LBi:,LBj:,:)
188 real(r8),
intent(in) :: Hvom(LBi:,LBj:,:)
189 real(r8),
intent(in) :: z_r(LBi:,LBj:,:)
191 real(r8),
intent(in) :: Akt(LBi:UBi,LBj:UBj,0:N(ng),NAT)
192 real(r8),
intent(in) :: t(LBi:UBi,LBj:UBj,N(ng),3,NT(ng))
194 real(r8),
intent(in) :: Akt(LBi:,LBj:,0:,:)
195 real(r8),
intent(in) :: t(LBi:,LBj:,:,:,:)
197 real(r8),
intent(in) :: W(LBi:,LBj:,0:)
199 real(r8),
intent(in) :: tl_Hz(LBi:,LBj:,:)
200 real(r8),
intent(in) :: tl_Huon(LBi:,LBj:,:)
201 real(r8),
intent(in) :: tl_Hvom(LBi:,LBj:,:)
202 real(r8),
intent(in) :: tl_z_r(LBi:,LBj:,:)
204 real(r8),
intent(in) :: tl_Akt(LBi:UBi,LBj:UBj,0:N(ng),NAT)
206 real(r8),
intent(in) :: tl_Akt(LBi:,LBj:,0:,:)
208 real(r8),
intent(in) :: tl_W(LBi:,LBj:,0:)
209# ifdef DIAGNOSTICS_TS
213 real(r8),
intent(inout) :: tl_t(LBi:UBi,LBj:UBj,N(ng),3,NT(ng))
215 real(r8),
intent(inout) :: tl_t(LBi:,LBj:,:,:,:)
217# if defined FLOATS_NOT_YET && defined FLOAT_VWALK
218 real(r8),
intent(out) :: dAktdz(LBi:,LBj:,:)
224 real(r8),
intent(in) :: rmask(LBi:UBi,LBj:UBj)
225 real(r8),
intent(in) :: umask(LBi:UBi,LBj:UBj)
226 real(r8),
intent(in) :: vmask(LBi:UBi,LBj:UBj)
229 real(r8),
intent(in) :: rmask_wet(LBi:UBi,LBj:UBj)
230 real(r8),
intent(in) :: umask_wet(LBi:UBi,LBj:UBj)
231 real(r8),
intent(in) :: vmask_wet(LBi:UBi,LBj:UBj)
233 real(r8),
intent(in) :: omn(LBi:UBi,LBj:UBj)
234 real(r8),
intent(in) :: om_u(LBi:UBi,LBj:UBj)
235 real(r8),
intent(in) :: om_v(LBi:UBi,LBj:UBj)
236 real(r8),
intent(in) :: on_u(LBi:UBi,LBj:UBj)
237 real(r8),
intent(in) :: on_v(LBi:UBi,LBj:UBj)
238 real(r8),
intent(in) :: pm(LBi:UBi,LBj:UBj)
239 real(r8),
intent(in) :: pn(LBi:UBi,LBj:UBj)
240 real(r8),
intent(in) :: Hz(LBi:UBi,LBj:UBj,N(ng))
241 real(r8),
intent(in) :: Huon(LBi:UBi,LBj:UBj,N(ng))
242 real(r8),
intent(in) :: Hvom(LBi:UBi,LBj:UBj,N(ng))
243 real(r8),
intent(in) :: z_r(LBi:UBi,LBj:UBj,N(ng))
244 real(r8),
intent(in) :: Akt(LBi:UBi,LBj:UBj,0:N(ng),NAT)
245 real(r8),
intent(in) :: t(LBi:UBi,LBj:UBj,N(ng),3,NT(ng))
246 real(r8),
intent(in) :: W(LBi:UBi,LBj:UBj,0:N(ng))
248 real(r8),
intent(in) :: tl_Hz(LBi:UBi,LBj:UBj,N(ng))
249 real(r8),
intent(in) :: tl_Huon(LBi:UBi,LBj:UBj,N(ng))
250 real(r8),
intent(in) :: tl_Hvom(LBi:UBi,LBj:UBj,N(ng))
251 real(r8),
intent(in) :: tl_z_r(LBi:UBi,LBj:UBj,N(ng))
252 real(r8),
intent(in) :: tl_Akt(LBi:UBi,LBj:UBj,0:N(ng),NAT)
253 real(r8),
intent(in) :: tl_W(LBi:UBi,LBj:UBj,0:N(ng))
254# ifdef DIAGNOSTICS_TS
258 real(r8),
intent(inout) :: tl_t(LBi:UBi,LBj:UBj,N(ng),3,NT(ng))
259# if defined FLOATS_NOT_YET && defined FLOAT_VWALK
260 real(r8),
intent(out) :: dAktdz(LBi:UBi,LBj:UBj,N(ng))
266 logical :: LapplySrc, Lhsimt
268 integer :: JminT, JmaxT
269 integer :: Isrc, Jsrc
270 integer :: i, ic, is, itrc, j, k, ltrc
271# if defined AGE_MEAN && defined T_PASSIVE
274# ifdef DIAGNOSTICS_TS
277 real(r8),
parameter :: eps = 1.0e-16_r8
279 real(r8) :: cff, cff1, cff2, cff3
280 real(r8) :: tl_cff, tl_cff1, tl_cff2, tl_cff3
282 real(r8),
dimension(IminS:ImaxS,0:N(ng)) :: CF
283 real(r8),
dimension(IminS:ImaxS,0:N(ng)) :: BC
284 real(r8),
dimension(IminS:ImaxS,0:N(ng)) :: DC
285 real(r8),
dimension(IminS:ImaxS,0:N(ng)) :: FC
287 real(r8),
dimension(IminS:ImaxS,0:N(ng)) :: tl_CF
288 real(r8),
dimension(IminS:ImaxS,0:N(ng)) :: tl_BC
289 real(r8),
dimension(IminS:ImaxS,0:N(ng)) :: tl_DC
290 real(r8),
dimension(IminS:ImaxS,0:N(ng)) :: tl_FC
292 real(r8),
dimension(IminS:ImaxS,JminS:JmaxS) :: FE
293 real(r8),
dimension(IminS:ImaxS,JminS:JmaxS) :: FX
294 real(r8),
dimension(IminS:ImaxS,JminS:JmaxS) :: curv
295 real(r8),
dimension(IminS:ImaxS,JminS:JmaxS) :: grad
297 real(r8),
dimension(IminS:ImaxS,JminS:JmaxS) :: tl_FE
298 real(r8),
dimension(IminS:ImaxS,JminS:JmaxS) :: tl_FX
299 real(r8),
dimension(IminS:ImaxS,JminS:JmaxS) :: tl_curv
300 real(r8),
dimension(IminS:ImaxS,JminS:JmaxS) :: tl_grad
302 real(r8),
dimension(IminS:ImaxS,JminS:JmaxS,N(ng)) :: oHz
303 real(r8),
dimension(IminS:ImaxS,JminS:JmaxS,N(ng)) :: tl_oHz
305# include "set_bounds.h"
320 ohz(i,j,k)=1.0_r8/hz(i,j,k)
321 tl_ohz(i,j,k)=-ohz(i,j,k)*ohz(i,j,k)*tl_hz(i,j,k)+ &
332 ohz(i,j,k)=1.0_r8/hz(i,j,k)
333 tl_ohz(i,j,k)=-ohz(i,j,k)*ohz(i,j,k)*tl_hz(i,j,k)+ &
345 t_loop1 :
DO itrc=1,nt(ng)
361 & lbi, ubi, lbj, ubj, 1, n(ng), &
362 & tl_t(:,:,:,nnew,itrc))
373 & lbi, ubi, lbj, ubj, 1, n(ng), &
376 & tl_t(:,:,:,nnew,itrc))
383 k_loop :
DO k=1,n(ng)
391 fx(i,j)=huon(i,j,k)* &
392 & 0.5_r8*(t(i-1,j,k,3,itrc)+ &
395 & (tl_huon(i,j,k)*(t(i-1,j,k,3,itrc)+ &
396 & t(i ,j,k,3,itrc))+ &
397 & huon(i,j,k)*(tl_t(i-1,j,k,3,itrc)+ &
398 & tl_t(i ,j,k,3,itrc)))- &
406 fe(i,j)=hvom(i,j,k)* &
407 & 0.5_r8*(t(i,j-1,k,3,itrc)+ &
410 & (tl_hvom(i,j,k)*(t(i,j-1,k,3,itrc)+ &
411 & t(i,j ,k,3,itrc))+ &
412 & hvom(i,j,k)*(tl_t(i,j-1,k,3,itrc)+ &
413 & tl_t(i,j ,k,3,itrc)))- &
449 fx(i,j)=t(i ,j,k,3,itrc)- &
451 tl_fx(i,j)=tl_t(i ,j,k,3,itrc)- &
452 & tl_t(i-1,j,k,3,itrc)
454 fx(i,j)=fx(i,j)*umask(i,j)
455 tl_fx(i,j)=tl_fx(i,j)*umask(i,j)
460 IF (
domain(ng)%Western_Edge(tile))
THEN
462 fx(istr-1,j)=fx(istr,j)
463 tl_fx(istr-1,j)=tl_fx(istr,j)
468 IF (
domain(ng)%Eastern_Edge(tile))
THEN
470 fx(iend+2,j)=fx(iend+1,j)
471 tl_fx(iend+2,j)=tl_fx(iend+1,j)
479 curv(i,j)=fx(i+1,j)-fx(i,j)
480 tl_curv(i,j)=tl_fx(i+1,j)-tl_fx(i,j)
482 cff=2.0_r8*fx(i+1,j)*fx(i,j)
483 tl_cff=2.0_r8*(tl_fx(i+1,j)*fx(i,j)+ &
484 & fx(i+1,j)*tl_fx(i,j))- &
489 grad(i,j)=cff/(fx(i+1,j)+fx(i,j))
490 tl_grad(i,j)=((fx(i+1,j)+fx(i,j))*tl_cff- &
491 & cff*(tl_fx(i+1,j)+tl_fx(i,j)))/ &
492 & ((fx(i+1,j)+fx(i,j))* &
493 & (fx(i+1,j)+fx(i,j)))+ &
503 grad(i,j)=0.5_r8*(fx(i+1,j)+fx(i,j))
504 tl_grad(i,j)=0.5_r8*(tl_fx(i+1,j)+tl_fx(i,j))
514 fx(i,j)=huon(i,j,k)*0.5_r8* &
515 & (t(i-1,j,k,3,itrc)+ &
516 & t(i ,j,k,3,itrc))- &
517 & cff1*(curv(i-1,j)*max(huon(i,j,k),0.0_r8)+ &
518 & curv(i ,j)*min(huon(i,j,k),0.0_r8))
521 & (t(i-1,j,k,3,itrc)+ &
522 & t(i ,j,k,3,itrc))+ &
524 & (tl_t(i-1,j,k,3,itrc)+ &
525 & tl_t(i ,j,k,3,itrc)))- &
527 & (tl_curv(i-1,j)*max(huon(i,j,k),0.0_r8)+ &
529 & (0.5_r8+sign(0.5_r8, huon(i,j,k)))* &
531 & tl_curv(i ,j)*min(huon(i,j,k),0.0_r8)+ &
533 & (0.5_r8+sign(0.5_r8,-huon(i,j,k)))* &
541 fx(i,j)=huon(i,j,k)*0.5_r8* &
542 & (t(i-1,j,k,3,itrc)+ &
543 & t(i ,j,k,3,itrc)- &
544 & cff2*(grad(i ,j)- &
548 & (t(i-1,j,k,3,itrc)+ &
549 & t(i ,j,k,3,itrc)- &
550 & cff2*(grad(i ,j)- &
553 & (tl_t(i-1,j,k,3,itrc)+ &
554 & tl_t(i ,j,k,3,itrc)- &
555 & cff2*(tl_grad(i ,j)- &
556 & tl_grad(i-1,j))))- &
566 fe(i,j)=t(i,j ,k,3,itrc)- &
568 tl_fe(i,j)=tl_t(i,j ,k,3,itrc)- &
569 & tl_t(i,j-1,k,3,itrc)
571 fe(i,j)=fe(i,j)*vmask(i,j)
572 tl_fe(i,j)=tl_fe(i,j)*vmask(i,j)
577 IF (
domain(ng)%Southern_Edge(tile))
THEN
579 fe(i,jstr-1)=fe(i,jstr)
580 tl_fe(i,jstr-1)=tl_fe(i,jstr)
585 IF (
domain(ng)%Northern_Edge(tile))
THEN
587 fe(i,jend+2)=fe(i,jend+1)
588 tl_fe(i,jend+2)=tl_fe(i,jend+1)
596 curv(i,j)=fe(i,j+1)-fe(i,j)
597 tl_curv(i,j)=tl_fe(i,j+1)-tl_fe(i,j)
599 cff=2.0_r8*fe(i,j+1)*fe(i,j)
600 tl_cff=2.0_r8*(tl_fe(i,j+1)*fe(i,j)+ &
601 & fe(i,j+1)*tl_fe(i,j))- &
606 grad(i,j)=cff/(fe(i,j+1)+fe(i,j))
607 tl_grad(i,j)=((fe(i,j+1)+fe(i,j))*tl_cff- &
608 & cff*(tl_fe(i,j+1)+tl_fe(i,j)))/ &
609 & ((fe(i,j+1)+fe(i,j))* &
610 & (fe(i,j+1)+fe(i,j)))+ &
620 grad(i,j)=0.5_r8*(fe(i,j+1)+fe(i,j))
621 tl_grad(i,j)=0.5_r8*(tl_fe(i,j+1)+tl_fe(i,j))
631 fe(i,j)=hvom(i,j,k)*0.5_r8* &
632 & (t(i,j-1,k,3,itrc)+ &
633 & t(i,j ,k,3,itrc))- &
634 & cff1*(curv(i,j-1)*max(hvom(i,j,k),0.0_r8)+ &
635 & curv(i,j )*min(hvom(i,j,k),0.0_r8))
638 & (t(i,j-1,k,3,itrc)+ &
639 & t(i,j ,k,3,itrc))+ &
641 & (tl_t(i,j-1,k,3,itrc)+ &
642 & tl_t(i,j ,k,3,itrc)))- &
644 & (tl_curv(i,j-1)*max(hvom(i,j,k),0.0_r8)+ &
646 & (0.5_r8+sign(0.5_r8, hvom(i,j,k)))* &
648 & tl_curv(i,j )*min(hvom(i,j,k),0.0_r8)+ &
650 & (0.5_r8+sign(0.5_r8,-hvom(i,j,k)))* &
658 fe(i,j)=hvom(i,j,k)*0.5_r8* &
659 & (t(i,j-1,k,3,itrc)+ &
660 & t(i,j ,k,3,itrc)- &
661 & cff2*(grad(i,j )- &
665 & (t(i,j-1,k,3,itrc)+ &
666 & t(i,j ,k,3,itrc)- &
667 & cff2*(grad(i,j )- &
670 & (tl_t(i,j-1,k,3,itrc)+ &
671 & tl_t(i,j ,k,3,itrc)- &
672 & cff2*(tl_grad(i,j )- &
673 & tl_grad(i,j-1))))- &
692 IF (int(
sources(ng)%Dsrc(is)).eq.0)
THEN
695 lapplysrc=(istrum2.le.isrc).and. &
696 & (isrc.le.iendp3).and. &
697 & (jstrvm2.le.jsrc).and. &
700 lapplysrc=(istr.le.isrc).and. &
701 & (isrc.le.iend+1).and. &
702 & (jstr.le.jsrc).and. &
707 fx(isrc,jsrc)=huon(isrc,jsrc,k)* &
709 tl_fx(isrc,jsrc)=tl_huon(isrc,jsrc,k)* &
710 &
sources(ng)%Tsrc(is,k,itrc)+ &
711 & huon(isrc,jsrc,k)* &
712 &
sources(ng)%tl_Tsrc(is,k,itrc)- &
718 IF ((rmask(isrc ,jsrc).eq.0.0_r8).and. &
719 & (rmask(isrc-1,jsrc).eq.1.0_r8))
THEN
720 fx(isrc,jsrc)=huon(isrc,jsrc,k)* &
721 & t(isrc-1,jsrc,k,3,itrc)
722 tl_fx(isrc,jsrc)=tl_huon(isrc,jsrc,k)* &
723 & t(isrc-1,jsrc,k,3,itrc)+ &
724 & huon(isrc,jsrc,k)* &
725 & tl_t(isrc-1,jsrc,k,3,itrc)- &
729 ELSE IF ((rmask(isrc ,jsrc).eq.1.0_r8).and. &
730 & (rmask(isrc-1,jsrc).eq.0.0_r8))
THEN
731 fx(isrc,jsrc)=huon(isrc,jsrc,k)* &
732 & t(isrc ,jsrc,k,3,itrc)
733 tl_fx(isrc,jsrc)=tl_huon(isrc,jsrc,k)* &
734 & t(isrc ,jsrc,k,3,itrc)+ &
735 & huon(isrc,jsrc,k)* &
736 & tl_t(isrc ,jsrc,k,3,itrc)- &
744 ELSE IF (int(
sources(ng)%Dsrc(is)).eq.1)
THEN
747 lapplysrc=(istrum2.le.isrc).and. &
748 & (isrc.le.iendp2i).and. &
749 & (jstrvm2.le.jsrc).and. &
752 lapplysrc=(istr.le.isrc).and. &
753 & (isrc.le.iend).and. &
754 & (jstr.le.jsrc).and. &
759 fe(isrc,jsrc)=hvom(isrc,jsrc,k)* &
761 tl_fe(isrc,jsrc)=tl_hvom(isrc,jsrc,k)* &
762 &
sources(ng)%Tsrc(is,k,itrc)+ &
763 & hvom(isrc,jsrc,k)* &
764 &
sources(ng)%tl_Tsrc(is,k,itrc)- &
770 IF ((rmask(isrc,jsrc ).eq.0.0_r8).and. &
771 & (rmask(isrc,jsrc-1).eq.1.0_r8))
THEN
772 fe(isrc,jsrc)=hvom(isrc,jsrc,k)* &
773 & t(isrc,jsrc-1,k,3,itrc)
774 tl_fe(isrc,jsrc)=tl_hvom(isrc,jsrc,k)* &
775 & t(isrc,jsrc-1,k,3,itrc)+ &
776 & hvom(isrc,jsrc,k)* &
777 & tl_t(isrc,jsrc-1,k,3,itrc)- &
781 ELSE IF ((rmask(isrc,jsrc ).eq.1.0_r8).and. &
782 & (rmask(isrc,jsrc-1).eq.0.0_r8))
THEN
783 fe(isrc,jsrc)=hvom(isrc,jsrc,k)* &
784 & t(isrc,jsrc ,k,3,itrc)
785 tl_fe(isrc,jsrc)=tl_hvom(isrc,jsrc,k)* &
786 & t(isrc,jsrc ,k,3,itrc)+ &
787 & hvom(isrc,jsrc,k)* &
788 & tl_t(isrc,jsrc ,k,3,itrc)- &
808 cff=
dt(ng)*pm(i,j)*pn(i,j)
811 tl_cff1=cff*(tl_fx(i+1,j)-tl_fx(i,j))
814 tl_cff2=cff*(tl_fe(i,j+1)-tl_fe(i,j))
817 tl_cff3=tl_cff1+tl_cff2
820 tl_t(i,j,k,nnew,itrc)=tl_t(i,j,k,nnew,itrc)-tl_cff3
821# ifdef DIAGNOSTICS_TS
836 t_loop2 :
DO itrc=1,nt(ng)
845 j_loop1 :
DO j=jmint,jmaxt
855 fc(i,0)=1.5_r8*t(i,j,1,3,itrc)
858 fc(i,0)=2.0_r8*t(i,j,1,3,itrc)
864 cff=1.0_r8/(2.0_r8*hz(i,j,k)+ &
865 & hz(i,j,k+1)*(2.0_r8-cf(i,k)))
866 cf(i,k+1)=cff*hz(i,j,k)
867 fc(i,k)=cff*(3.0_r8*(hz(i,j,k )*t(i,j,k+1,3,itrc)+ &
868 & hz(i,j,k+1)*t(i,j,k ,3,itrc))- &
869 & hz(i,j,k+1)*fc(i,k-1))
874 fc(i,n(ng))=(3.0_r8*t(i,j,n(ng),3,itrc)-fc(i,n(ng)-1))/ &
875 & (2.0_r8-cf(i,n(ng)))
877 fc(i,n(ng))=(2.0_r8*t(i,j,n(ng),3,itrc)-fc(i,n(ng)-1))/ &
878 & (1.0_r8-cf(i,n(ng)))
883 fc(i,k)=fc(i,k)-cf(i,k+1)*fc(i,k+1)
893 tl_fc(i,0)=1.5_r8*tl_t(i,j,1,3,itrc)
898 tl_fc(i,0)=2.0_r8*tl_t(i,j,1,3,itrc)
904 cff=1.0_r8/(2.0_r8*hz(i,j,k)+ &
905 & hz(i,j,k+1)*(2.0_r8-cf(i,k)))
906 cf(i,k+1)=cff*hz(i,j,k)
909 & (3.0_r8*(hz(i,j,k )*tl_t(i,j,k+1,3,itrc)+ &
910 & hz(i,j,k+1)*tl_t(i,j,k ,3,itrc)+ &
911 & tl_hz(i,j,k )*t(i,j,k+1,3,itrc)+ &
912 & tl_hz(i,j,k+1)*t(i,j,k ,3,itrc)- &
913 & hz(i,j,k )*t(i,j,k+1,3,itrc)- &
914 & hz(i,j,k+1)*t(i,j,k ,3,itrc))- &
915 & ((tl_hz(i,j,k+1)-hz(i,j,k+1))*fc(i,k-1)+ &
916 & 2.0_r8*(tl_hz(i,j,k )+ &
919 & hz(i,j,k+1))*fc(i,k)+ &
920 & (tl_hz(i,j,k )-hz(i,j,k ))*fc(i,k+1))- &
921 & hz(i,j,k+1)*tl_fc(i,k-1))
924 & (3.0_r8*(hz(i,j,k )*tl_t(i,j,k+1,3,itrc)+ &
925 & hz(i,j,k+1)*tl_t(i,j,k ,3,itrc)+ &
926 & tl_hz(i,j,k )*t(i,j,k+1,3,itrc)+ &
927 & tl_hz(i,j,k+1)*t(i,j,k ,3,itrc))- &
928 & (tl_hz(i,j,k+1)*fc(i,k-1)+ &
929 & 2.0_r8*(tl_hz(i,j,k )+ &
930 & tl_hz(i,j,k+1))*fc(i,k)+ &
931 & tl_hz(i,j,k )*fc(i,k+1))- &
932 & hz(i,j,k+1)*tl_fc(i,k-1))
941 tl_fc(i,n(ng))=(3.0_r8*tl_t(i,j,n(ng),3,itrc)- &
942 & tl_fc(i,n(ng)-1))/ &
943 & (2.0_r8-cf(i,n(ng)))
948 tl_fc(i,n(ng))=(2.0_r8*tl_t(i,j,n(ng),3,itrc)- &
949 & tl_fc(i,n(ng)-1))/ &
950 & (1.0_r8-cf(i,n(ng)))
957 tl_fc(i,k)=tl_fc(i,k)-cf(i,k+1)*tl_fc(i,k+1)
960 tl_fc(i,k+1)=tl_w(i,j,k+1)*fc(i,k+1)+ &
961 & w(i,j,k+1)*tl_fc(i,k+1)- &
963 & w(i,j,k+1)*fc(i,k+1)
970 tl_fc(i,n(ng))=0.0_r8
980 fc(i,k+1)=w(i,j,k+1)*fc(i,k+1)
994 fc(i,k)=t(i,j,k+1,3,itrc)- &
996 tl_fc(i,k)=tl_t(i,j,k+1,3,itrc)- &
997 & tl_t(i,j,k ,3,itrc)
1002 tl_fc(i,0)=tl_fc(i,1)
1003 fc(i,n(ng))=fc(i,n(ng)-1)
1004 tl_fc(i,n(ng))=tl_fc(i,n(ng)-1)
1008 cff=2.0_r8*fc(i,k)*fc(i,k-1)
1009 tl_cff=2.0_r8*(tl_fc(i,k)*fc(i,k-1)+ &
1010 & fc(i,k)*tl_fc(i,k-1))- &
1014 IF (cff.gt.eps)
THEN
1015 cf(i,k)=cff/(fc(i,k)+fc(i,k-1))
1016 tl_cf(i,k)=((fc(i,k)+fc(i,k-1))*tl_cff- &
1017 & cff*(tl_fc(i,k)+tl_fc(i,k-1)))/ &
1018 & ((fc(i,k)+fc(i,k-1))*(fc(i,k)+fc(i,k-1)))+ &
1032 & 0.5_r8*(t(i,j,k ,3,itrc)+ &
1033 & t(i,j,k+1,3,itrc)- &
1034 & cff1*(cf(i,k+1)-cf(i,k)))
1035 tl_fc(i,k)=0.5_r8* &
1037 & (t(i,j,k ,3,itrc)+ &
1038 & t(i,j,k+1,3,itrc)- &
1039 & cff1*(cf(i,k+1)-cf(i,k)))+ &
1041 & (tl_t(i,j,k ,3,itrc)+ &
1042 & tl_t(i,j,k+1,3,itrc)- &
1043 & cff1*(tl_cf(i,k+1)-tl_cf(i,k))))- &
1051 fc(i,0)=w(i,j,0)*t(i,j,1,3,itrc)
1052 tl_fc(i,0)=tl_w(i,j,0)*t(i,j,1,3,itrc)+ &
1053 & w(i,j,0)*tl_t(i,j,1,3,itrc)- &
1062 tl_fc(i,n(ng))=0.0_r8
1073 & 0.5_r8*(t(i,j,k ,3,itrc)+ &
1074 & t(i,j,k+1,3,itrc))
1075 tl_fc(i,k)=0.5_r8* &
1077 & (t(i,j,k ,3,itrc)+ &
1078 & t(i,j,k+1,3,itrc))+ &
1080 & (tl_t(i,j,k ,3,itrc)+ &
1081 & tl_t(i,j,k+1,3,itrc)))- &
1089 fc(i,0)=w(i,j,0)*t(i,j,1,3,itrc)
1090 tl_fc(i,0)=tl_w(i,j,0)*t(i,j,1,3,itrc)+ &
1091 & w(i,j,0)*tl_t(i,j,1,3,itrc)- &
1100 tl_fc(i,n(ng))=0.0_r8
1130 & (cff2*(t(i,j,k ,3,itrc)+ &
1131 & t(i,j,k+1,3,itrc))- &
1132 & cff3*(t(i,j,k-1,3,itrc)+ &
1133 & t(i,j,k+2,3,itrc)))
1134 tl_fc(i,k)=tl_w(i,j,k)* &
1135 & (cff2*(t(i,j,k ,3,itrc)+ &
1136 & t(i,j,k+1,3,itrc))- &
1137 & cff3*(t(i,j,k-1,3,itrc)+ &
1138 & t(i,j,k+2,3,itrc)))+ &
1140 & (cff2*(tl_t(i,j,k ,3,itrc)+ &
1141 & tl_t(i,j,k+1,3,itrc))- &
1142 & cff3*(tl_t(i,j,k-1,3,itrc)+ &
1143 & tl_t(i,j,k+2,3,itrc)))- &
1151 fc(i,0)=w(i,j,0)*2.0_r8* &
1152 & (cff2*t(i,j,1,3,itrc)- &
1153 & cff3*t(i,j,2,3,itrc))
1154 tl_fc(i,0)=2.0_r8* &
1156 & (cff2*t(i,j,1,3,itrc)- &
1157 & cff3*t(i,j,2,3,itrc))+ &
1159 & (cff2*tl_t(i,j,1,3,itrc)- &
1160 & cff3*tl_t(i,j,2,3,itrc)))- &
1169 & (cff1*t(i,j,1,3,itrc)+ &
1170 & cff2*t(i,j,2,3,itrc)- &
1171 & cff3*t(i,j,3,3,itrc))
1172 tl_fc(i,1)=tl_w(i,j,1)* &
1173 & (cff1*t(i,j,1,3,itrc)+ &
1174 & cff2*t(i,j,2,3,itrc)- &
1175 & cff3*t(i,j,3,3,itrc))+ &
1177 & (cff1*tl_t(i,j,1,3,itrc)+ &
1178 & cff2*tl_t(i,j,2,3,itrc)- &
1179 & cff3*tl_t(i,j,3,3,itrc))- &
1183 fc(i,n(ng)-1)=w(i,j,n(ng)-1)* &
1184 & (cff1*t(i,j,n(ng) ,3,itrc)+ &
1185 & cff2*t(i,j,n(ng)-1,3,itrc)- &
1186 & cff3*t(i,j,n(ng)-2,3,itrc))
1187 tl_fc(i,n(ng)-1)=tl_w(i,j,n(ng)-1)* &
1188 & (cff1*t(i,j,n(ng) ,3,itrc)+ &
1189 & cff2*t(i,j,n(ng)-1,3,itrc)- &
1190 & cff3*t(i,j,n(ng)-2,3,itrc))+ &
1192 & (cff1*tl_t(i,j,n(ng) ,3,itrc)+ &
1193 & cff2*tl_t(i,j,n(ng)-1,3,itrc)- &
1194 & cff3*tl_t(i,j,n(ng)-2,3,itrc))- &
1199 tl_fc(i,n(ng))=0.0_r8
1205# ifdef DIAGNOSTICS_TS
1213 cf(i,0)=
dt(ng)*pm(i,j)*pn(i,j)
1217 cff1=cf(i,0)*(fc(i,k)-fc(i,k-1))
1218 tl_cff1=cf(i,0)*(tl_fc(i,k)-tl_fc(i,k-1))
1221 tl_t(i,j,k,nnew,itrc)=tl_t(i,j,k,nnew,itrc)-tl_cff1
1222# ifdef SPLINES_VDIFF
1225 tl_t(i,j,k,nnew,itrc)=tl_t(i,j,k,nnew,itrc)* &
1227 & (t(i,j,k,nnew,itrc)*hz(i,j,k))* &
1230 & t(i,j,k,nnew,itrc)
1233# ifdef DIAGNOSTICS_TS
1242 END IF vadv_stepping
1262 IF (int(
sources(ng)%Dsrc(is)).eq.2)
THEN
1265 IF (((istr.le.isrc).and.(isrc.le.iend+1)).and. &
1266 & ((jstr.le.jsrc).and.(jsrc.le.jend+1)))
THEN
1268 cff=
dt(ng)*pm(isrc,jsrc)*pn(isrc,jsrc)
1269# ifdef SPLINES_VDIFF
1270 cff=cff*ohz(isrc,jsrc,k)
1271 tl_cff=cff*tl_ohz(isrc,jsrc,k)
1274 cff3=
sources(ng)%Tsrc(is,k,itrc)
1275 tl_cff3=
sources(ng)%tl_Tsrc(is,k,itrc)
1277 cff3=t(isrc,jsrc,k,3,itrc)
1278 tl_cff3=tl_t(isrc,jsrc,k,3,itrc)
1284# ifdef SPLINES_VDIFF
1285 tl_t(isrc,jsrc,k,nnew,itrc)= &
1286 & tl_t(isrc,jsrc,k,nnew,itrc)+ &
1287 & cff*(
sources(ng)%tl_Qsrc(is,k)* &
1291 & tl_cff*
sources(ng)%Qsrc(is,k)* &
1298 tl_t(isrc,jsrc,k,nnew,itrc)= &
1299 & tl_t(isrc,jsrc,k,nnew,itrc)+ &
1300 & cff*(
sources(ng)%tl_Qsrc(is,k)* &
1305 & cff*
sources(ng)%Qsrc(is,k)* &
1321 j_loop2 :
DO j=jstr,jend
1325# ifdef SPLINES_VDIFF
1336 fc(i,k)=cff1*hz(i,j,k )- &
1337 &
dt(ng)*akt(i,j,k-1,ltrc)*ohz(i,j,k )
1338 cf(i,k)=cff1*hz(i,j,k+1)- &
1339 &
dt(ng)*akt(i,j,k+1,ltrc)*ohz(i,j,k+1)
1352 bc(i,k)=cff1*(hz(i,j,k)+hz(i,j,k+1))+ &
1353 &
dt(ng)*akt(i,j,k,ltrc)*(ohz(i,j,k)+ohz(i,j,k+1))
1354 cff=1.0_r8/(bc(i,k)-fc(i,k)*cf(i,k-1))
1356 dc(i,k)=cff*(t(i,j,k+1,nnew,itrc)-t(i,j,k,nnew,itrc)- &
1357 & fc(i,k)*dc(i,k-1))
1369 dc(i,k)=dc(i,k)-cf(i,k)*dc(i,k+1)
1383 fc(i,k)=cff1*hz(i,j,k )- &
1384 &
dt(ng)*akt(i,j,k-1,ltrc)*ohz(i,j,k )
1385 tl_fc(i,k)=cff1*tl_hz(i,j,k )- &
1386 &
dt(ng)*(tl_akt(i,j,k-1,ltrc)*ohz(i,j,k )+ &
1387 & akt(i,j,k-1,ltrc)*tl_ohz(i,j,k ))
1388 cf(i,k)=cff1*hz(i,j,k+1)- &
1389 &
dt(ng)*akt(i,j,k+1,ltrc)*ohz(i,j,k+1)
1390 tl_cf(i,k)=cff1*tl_hz(i,j,k+1)- &
1391 &
dt(ng)*(tl_akt(i,j,k+1,ltrc)*ohz(i,j,k+1)+ &
1392 & akt(i,j,k+1,ltrc)*tl_ohz(i,j,k+1))
1409 bc(i,k)=cff1*(hz(i,j,k)+hz(i,j,k+1))+ &
1410 &
dt(ng)*akt(i,j,k,ltrc)*(ohz(i,j,k)+ohz(i,j,k+1))
1411 tl_bc(i,k)=cff1*(tl_hz(i,j,k)+tl_hz(i,j,k+1))+ &
1412 &
dt(ng)*(tl_akt(i,j,k,ltrc)* &
1413 & (ohz(i,j,k)+ohz(i,j,k+1))+ &
1414 & akt(i,j,k,ltrc)* &
1415 & (tl_ohz(i,j,k)+tl_ohz(i,j,k+1)))
1416 cff=1.0_r8/(bc(i,k)-fc(i,k)*cf(i,k-1))
1418 tl_dc(i,k)=cff*(tl_t(i,j,k+1,nnew,itrc)- &
1419 & tl_t(i,j,k ,nnew,itrc)- &
1420 & ((tl_fc(i,k)-fc(i,k))*dc(i,k-1)+ &
1421 & (tl_bc(i,k)-bc(i,k))*dc(i,k )+ &
1422 & (tl_cf(i,k)-cf(i,k))*dc(i,k+1))- &
1423 & fc(i,k)*tl_dc(i,k-1))
1427 tl_dc(i,k)=cff*(tl_t(i,j,k+1,nnew,itrc)- &
1428 & tl_t(i,j,k ,nnew,itrc)- &
1429 & (tl_fc(i,k)*dc(i,k-1)+ &
1430 & tl_bc(i,k)*dc(i,k )+ &
1431 & tl_cf(i,k)*dc(i,k+1))- &
1432 & fc(i,k)*tl_dc(i,k-1))
1440 tl_dc(i,n(ng))=0.0_r8
1444 tl_dc(i,k)=tl_dc(i,k)-cf(i,k)*tl_dc(i,k+1)
1453 tl_dc(i,k)=tl_dc(i,k)*akt(i,j,k,ltrc)+ &
1454 & dc(i,k)*tl_akt(i,j,k,ltrc)
1459 dc(i,k)=dc(i,k)*akt(i,j,k,ltrc)
1462 tl_cff1=
dt(ng)*(tl_ohz(i,j,k)*(dc(i,k)-dc(i,k-1))+ &
1463 & ohz(i,j,k)*(tl_dc(i,k)-tl_dc(i,k-1)))- &
1465 &
dt(ng)*ohz(i,j,k)*(dc(i,k)-dc(i,k-1))
1469 tl_t(i,j,k,nnew,itrc)=tl_t(i,j,k,nnew,itrc)+tl_cff1
1470# ifdef DIAGNOSTICS_TS
1493 cff1=1.0_r8/(z_r(i,j,k+1)-z_r(i,j,k))
1494 tl_cff1=-cff1*cff1*(tl_z_r(i,j,k+1)-tl_z_r(i,j,k))+ &
1498 fc(i,k)=cff*cff1*akt(i,j,k,ltrc)
1499 tl_fc(i,k)=cff*(tl_cff1*akt(i,j,k,ltrc)+ &
1500 & cff1*tl_akt(i,j,k,ltrc))
1513 tl_fc(i,n(ng))=0.0_r8
1520 bc(i,k)=hz(i,j,k)-fc(i,k)-fc(i,k-1)
1521 tl_bc(i,k)=tl_hz(i,j,k)-tl_fc(i,k)-tl_fc(i,k-1)
1531 dc(i,k)=tl_t(i,j,k,nnew,itrc)- &
1532 & ((tl_fc(i,k-1)-fc(i,k-1))*t(i,j,k-1,nnew,itrc)+ &
1533 & (tl_bc(i,k )-bc(i,k ))*t(i,j,k ,nnew,itrc)+ &
1534 & (tl_fc(i,k )-fc(i,k ))*t(i,j,k+1,nnew,itrc))
1536 dc(i,k)=tl_t(i,j,k,nnew,itrc)- &
1537 & (tl_fc(i,k-1)*t(i,j,k-1,nnew,itrc)+ &
1538 & tl_bc(i,k )*t(i,j,k ,nnew,itrc)+ &
1539 & tl_fc(i,k )*t(i,j,k+1,nnew,itrc))
1545 dc(i,1)=tl_t(i,j,1,nnew,itrc)- &
1546 & ((tl_bc(i,1)-bc(i,1))*t(i,j,1,nnew,itrc)+ &
1547 & (tl_fc(i,1)-fc(i,1))*t(i,j,2,nnew,itrc))
1548 dc(i,n(ng))=tl_t(i,j,n(ng),nnew,itrc)- &
1549 & ((tl_fc(i,n(ng)-1)-fc(i,n(ng)-1))* &
1550 & t(i,j,n(ng)-1,nnew,itrc)+ &
1551 & (tl_bc(i,n(ng) )-bc(i,n(ng) ))* &
1552 & t(i,j,n(ng) ,nnew,itrc))
1554 dc(i,1)=tl_t(i,j,1,nnew,itrc)- &
1555 & (tl_bc(i,1)*t(i,j,1,nnew,itrc)+ &
1556 & tl_fc(i,1)*t(i,j,2,nnew,itrc))
1557 dc(i,n(ng))=tl_t(i,j,n(ng),nnew,itrc)- &
1558 & (tl_fc(i,n(ng)-1)*t(i,j,n(ng)-1,nnew,itrc)+ &
1559 & tl_bc(i,n(ng) )*t(i,j,n(ng) ,nnew,itrc))
1570 cff=1.0_r8/(bc(i,k)-fc(i,k-1)*cf(i,k-1))
1572 dc(i,k)=cff*(dc(i,k)-fc(i,k-1)*dc(i,k-1))
1580# ifdef DIAGNOSTICS_TS
1583 dc(i,n(ng))=(dc(i,n(ng))-fc(i,n(ng)-1)*dc(i,n(ng)-1))/ &
1584 & (bc(i,n(ng))-fc(i,n(ng)-1)*cf(i,n(ng)-1))
1585 tl_t(i,j,n(ng),nnew,itrc)=dc(i,n(ng))
1586# ifdef DIAGNOSTICS_TS
1594# ifdef DIAGNOSTICS_TS
1597 dc(i,k)=dc(i,k)-cf(i,k)*dc(i,k+1)
1598 tl_t(i,j,k,nnew,itrc)=dc(i,k)
1599# ifdef DIAGNOSTICS_TS
1605# ifdef SPLINES_VDIFF
1611# if defined AGE_MEAN && defined T_PASSIVE
1639 tl_t(i,j,k,nnew,iage)=tl_t(i,j,k,nnew,iage)+ &
1641 & tl_t(i,j,k,3,
inert(itrc))
1678 & lbi, ubi, lbj, ubj, n(ng), nt(ng), &
1679 & imins, imaxs, jmins, jmaxs, &
1695 tl_t(i,j,k,nnew,itrc)=tl_t(i,j,k,nnew,itrc)- &
1697 &
clima(ng)%Tnudgcof(i,j,k,ic)* &
1698 & tl_t(i,j,k,nnew,itrc)+ &
1701 &
clima(ng)%Tnudgcof(i,j,k,ic)* &
1702 &
clima(ng)%tclm(i,j,k,ic)
1718 tl_t(i,j,k,nnew,itrc)=tl_t(i,j,k,nnew,itrc)*rmask(i,j)
1723# ifdef DIAGNOSTICS_TS
1747 & lbi, ubi, lbj, ubj, 1, n(ng), &
1748 & tl_t(:,:,:,nnew,itrc))
1762 & lbi, ubi, lbj, ubj, 1, n(ng), 1, nt(ng), &
1765 & tl_t(:,:,:,nnew,:))
1767# if defined FLOATS_NOT_YET && defined FLOAT_VWALK
1777 daktdz(i,j,k)=(akt(i,j,k,1)-akt(i,j,k-1,1))/hz(i,j,k)
1786 & lbi, ubi, lbj, ubj, 1, n(ng), &
1792 & lbi, ubi, lbj, ubj, 1, n(ng), &