103 & LBi, UBi, LBj, UBj, &
104 & IminS, ImaxS, JminS, JmaxS, &
105 & nrhs, nstp, nnew, &
109#ifdef WET_DRY_NOT_YET
110 & umask_wet, vmask_wet, &
112 & om_v, on_u, pm, pn, &
116# ifdef TS_U3ADV_SPLIT
117 & diff3d_u, diff3d_v, &
140 integer,
intent(in) :: ng, tile
141 integer,
intent(in) :: LBi, UBi, LBj, UBj
142 integer,
intent(in) :: IminS, ImaxS, JminS, JmaxS
143 integer,
intent(in) :: nrhs, nstp, nnew
147 real(r8),
intent(in) :: umask(LBi:,LBj:)
148 real(r8),
intent(in) :: vmask(LBi:,LBj:)
150# ifdef WET_DRY_NOT_YET
151 real(r8),
intent(in) :: umask_wet(LBi:,LBj:)
152 real(r8),
intent(in) :: vmask_wet(LBi:,LBj:)
155# ifdef TS_U3ADV_SPLIT
156 real(r8),
intent(in) :: diff3d_u(LBi:,LBj:,:)
157 real(r8),
intent(in) :: diff3d_v(LBi:,LBj:,:)
159 real(r8),
intent(in) :: diff3d_r(LBi:,LBj:,:)
162 real(r8),
intent(in) :: diff4(LBi:,LBj:,:)
164 real(r8),
intent(in) :: om_v(LBi:,LBj:)
165 real(r8),
intent(in) :: on_u(LBi:,LBj:)
166 real(r8),
intent(in) :: pm(LBi:,LBj:)
167 real(r8),
intent(in) :: pn(LBi:,LBj:)
168 real(r8),
intent(in) :: Hz(LBi:,LBj:,:)
169 real(r8),
intent(in) :: z_r(LBi:,LBj:,:)
170 real(r8),
intent(in) :: pden(LBi:,LBj:,:)
171 real(r8),
intent(in) :: t(LBi:,LBj:,:,:,:)
173 real(r8),
intent(in) :: tclm(LBi:,LBj:,:,:)
175 real(r8),
intent(in) :: tl_Hz(LBi:,LBj:,:)
176 real(r8),
intent(in) :: tl_z_r(LBi:,LBj:,:)
177 real(r8),
intent(in) :: tl_pden(LBi:,LBj:,:)
178# ifdef DIAGNOSTICS_TS
179 real(r8),
intent(inout) :: DiaTwrk(LBi:,LBj:,:,:,:)
182 real(r8),
intent(inout) :: tl_t(LBi:,LBj:,:,:,:)
185 real(r8),
intent(in) :: umask(LBi:UBi,LBj:UBj)
186 real(r8),
intent(in) :: vmask(LBi:UBi,LBj:UBj)
188# ifdef WET_DRY_NOT_YET
189 real(r8),
intent(in) :: umask_wet(LBi:UBi,LBj:UBj)
190 real(r8),
intent(in) :: vmask_wet(LBi:UBi,LBj:UBj)
193# ifdef TS_U3ADV_SPLIT
194 real(r8),
intent(in) :: diff3d_u(LBi:UBi,LBj:UBj,N(ng))
195 real(r8),
intent(in) :: diff3d_v(LBi:UBi,LBj:UBj,N(ng))
197 real(r8),
intent(in) :: diff3d_r(LBi:UBi,LBj:UBj,N(ng))
200 real(r8),
intent(in) :: diff4(LBi:UBi,LBj:UBj,NT(ng))
202 real(r8),
intent(in) :: om_v(LBi:UBi,LBj:UBj)
203 real(r8),
intent(in) :: on_u(LBi:UBi,LBj:UBj)
204 real(r8),
intent(in) :: pm(LBi:UBi,LBj:UBj)
205 real(r8),
intent(in) :: pn(LBi:UBi,LBj:UBj)
206 real(r8),
intent(in) :: Hz(LBi:UBi,LBj:UBj,N(ng))
207 real(r8),
intent(in) :: z_r(LBi:UBi,LBj:UBj,N(ng))
208 real(r8),
intent(in) :: pden(LBi:UBi,LBj:UBj,N(ng))
209 real(r8),
intent(in) :: t(LBi:UBi,LBj:UBj,N(ng),3,NT(ng))
211 real(r8),
intent(in) :: tclm(LBi:UBi,LBj:UBj,N(ng),NT(ng))
213 real(r8),
intent(in) :: tl_Hz(LBi:UBi,LBj:UBj,N(ng))
214 real(r8),
intent(in) :: tl_z_r(LBi:UBi,LBj:UBj,N(ng))
215 real(r8),
intent(in) :: tl_pden(LBi:UBi,LBj:UBj,N(ng))
216# ifdef DIAGNOSTICS_TS
220 real(r8),
intent(inout) :: tl_t(LBi:UBi,LBj:UBj,N(ng),3,NT(ng))
225 integer :: Imin, Imax, Jmin, Jmax
226 integer :: i, itrc, j, k, k1, k2
228 real(r8),
parameter :: eps = 0.5_r8
229 real(r8),
parameter :: small = 1.0e-14_r8
230 real(r8),
parameter :: slope_max = 0.0001_r8
231 real(r8),
parameter :: strat_min = 0.1_r8
233 real(r8) :: cff, cff1, cff2, cff3, cff4, dife, difx
234 real(r8) :: tl_cff, tl_cff1, tl_cff2, tl_cff3, tl_cff4
236 real(r8),
dimension(IminS:ImaxS,JminS:JmaxS,N(ng)) :: LapT
238 real(r8),
dimension(IminS:ImaxS,JminS:JmaxS,N(ng)) :: tl_LapT
240 real(r8),
dimension(IminS:ImaxS,JminS:JmaxS) :: FE
241 real(r8),
dimension(IminS:ImaxS,JminS:JmaxS) :: FX
243 real(r8),
dimension(IminS:ImaxS,JminS:JmaxS) :: tl_FE
244 real(r8),
dimension(IminS:ImaxS,JminS:JmaxS) :: tl_FX
246 real(r8),
dimension(IminS:ImaxS,JminS:JmaxS,2) :: FS
247 real(r8),
dimension(IminS:ImaxS,JminS:JmaxS,2) :: dRde
248 real(r8),
dimension(IminS:ImaxS,JminS:JmaxS,2) :: dRdx
249 real(r8),
dimension(IminS:ImaxS,JminS:JmaxS,2) :: dTde
250 real(r8),
dimension(IminS:ImaxS,JminS:JmaxS,2) :: dTdr
251 real(r8),
dimension(IminS:ImaxS,JminS:JmaxS,2) :: dTdx
253 real(r8),
dimension(IminS:ImaxS,JminS:JmaxS,2) :: tl_FS
254 real(r8),
dimension(IminS:ImaxS,JminS:JmaxS,2) :: tl_dRde
255 real(r8),
dimension(IminS:ImaxS,JminS:JmaxS,2) :: tl_dRdx
256 real(r8),
dimension(IminS:ImaxS,JminS:JmaxS,2) :: tl_dTde
257 real(r8),
dimension(IminS:ImaxS,JminS:JmaxS,2) :: tl_dTdr
258 real(r8),
dimension(IminS:ImaxS,JminS:JmaxS,2) :: tl_dTdx
260#include "set_bounds.h"
275 imax=min(iend+1,
lm(ng))
282 jmax=min(jend+1,
mm(ng))
293#ifdef TS_MIX_STABILITY
299 t_loop :
DO itrc=1,nt(ng)
301 k_loop1 :
DO k=0,n(ng)
307 cff=0.5_r8*(pm(i,j)+pm(i-1,j))
311#ifdef WET_DRY_NOT_YET
312 cff=cff*umask_wet(i,j)
314 drdx(i,j,k2)=cff*(pden(i ,j,k+1)- &
316 tl_drdx(i,j,k2)=cff*(tl_pden(i ,j,k+1)- &
317 & tl_pden(i-1,j,k+1))
318#if defined TS_MIX_STABILITY
319 dtdx(i,j,k2)=cff*(0.75_r8*(t(i ,j,k+1,nrhs,itrc)- &
320 & t(i-1,j,k+1,nrhs,itrc))+ &
321 & 0.25_r8*(t(i ,j,k+1,nstp,itrc)- &
322 & t(i-1,j,k+1,nstp,itrc)))
323 tl_dtdx(i,j,k2)=cff* &
324 & (0.75_r8*(tl_t(i ,j,k+1,nrhs,itrc)- &
325 & tl_t(i-1,j,k+1,nrhs,itrc))+ &
326 & 0.25_r8*(tl_t(i ,j,k+1,nstp,itrc)- &
327 & tl_t(i-1,j,k+1,nstp,itrc)))
328#elif defined TS_MIX_CLIMA
330 dtdx(i,j,k2)=cff*((t(i ,j,k+1,nrhs,itrc)- &
331 & tclm(i ,j,k+1,itrc))- &
332 & (t(i-1,j,k+1,nrhs,itrc)- &
333 & tclm(i-1,j,k+1,itrc)))
335 dtdx(i,j,k2)=cff*(t(i ,j,k+1,nrhs,itrc)- &
336 & t(i-1,j,k+1,nrhs,itrc))
338 tl_dtdx(i,j,k2)=cff*(tl_t(i ,j,k+1,nrhs,itrc)- &
339 & tl_t(i-1,j,k+1,nrhs,itrc))
341 dtdx(i,j,k2)=cff*(t(i ,j,k+1,nrhs,itrc)- &
342 & t(i-1,j,k+1,nrhs,itrc))
343 tl_dtdx(i,j,k2)=cff*(tl_t(i ,j,k+1,nrhs,itrc)- &
344 & tl_t(i-1,j,k+1,nrhs,itrc))
350 cff=0.5_r8*(pn(i,j)+pn(i,j-1))
354#ifdef WET_DRY_NOT_YET
355 cff=cff*vmask_wet(i,j)
357 drde(i,j,k2)=cff*(pden(i,j ,k+1)- &
359 tl_drde(i,j,k2)=cff*(tl_pden(i,j ,k+1)- &
360 & tl_pden(i,j-1,k+1))
361#if defined TS_MIX_STABILITY
362 dtde(i,j,k2)=cff*(0.75_r8*(t(i,j ,k+1,nrhs,itrc)- &
363 & t(i,j-1,k+1,nrhs,itrc))+ &
364 & 0.25_r8*(t(i,j ,k+1,nstp,itrc)- &
365 & t(i,j-1,k+1,nstp,itrc)))
366 tl_dtde(i,j,k2)=cff* &
367 & (0.75_r8*(tl_t(i,j ,k+1,nrhs,itrc)- &
368 & tl_t(i,j-1,k+1,nrhs,itrc))+ &
369 & 0.25_r8*(tl_t(i,j ,k+1,nstp,itrc)- &
370 & tl_t(i,j-1,k+1,nstp,itrc)))
371#elif defined TS_MIX_CLIMA
373 dtde(i,j,k2)=cff*((t(i,j ,k+1,nrhs,itrc)- &
374 & tclm(i,j ,k+1,itrc))- &
375 & (t(i,j-1,k+1,nrhs,itrc)- &
376 & tclm(i,j-1,k+1,itrc)))
378 dtde(i,j,k2)=cff*(t(i,j ,k+1,nrhs,itrc)- &
379 & t(i,j-1,k+1,nrhs,itrc))
381 tl_dtde(i,j,k2)=cff*(tl_t(i,j ,k+1,nrhs,itrc)- &
382 & tl_t(i,j-1,k+1,nrhs,itrc))
384 dtde(i,j,k2)=cff*(t(i,j ,k+1,nrhs,itrc)- &
385 & t(i,j-1,k+1,nrhs,itrc))
386 tl_dtde(i,j,k2)=cff*(tl_t(i,j ,k+1,nrhs,itrc)- &
387 & tl_t(i,j-1,k+1,nrhs,itrc))
392 IF ((k.eq.0).or.(k.eq.n(ng)))
THEN
396 tl_dtdr(i,j,k2)=0.0_r8
404#if defined TS_MIX_MAX_SLOPE
405 cff1=sqrt(drdx(i,j,k2)**2+drdx(i+1,j,k2)**2+ &
406 & drdx(i,j,k1)**2+drdx(i+1,j,k1)**2+ &
407 & drde(i,j,k2)**2+drde(i,j+1,k2)**2+ &
408 & drde(i,j,k1)**2+drde(i,j+1,k1)**2)
409 IF (cff1.ne.0.0_r8)
THEN
410 tl_cff1=(drdx(i ,j,k2)*tl_drdx(i ,j,k2)+ &
411 & drdx(i+1,j,k2)*tl_drdx(i+1,j,k2)+ &
412 & drdx(i ,j,k1)*tl_drdx(i ,j,k1)+ &
413 & drdx(i+1,j,k1)*tl_drdx(i+1,j,k1)+ &
414 & drde(i,j ,k2)*tl_drde(i,j ,k2)+ &
415 & drde(i,j+1,k2)*tl_drde(i,j+1,k2)+ &
416 & drde(i,j ,k1)*tl_drde(i,j ,k1)+ &
417 & drde(i,j+1,k1)*tl_drde(i,j+1,k1))/cff1
421 cff2=0.25_r8*slope_max* &
422 & (z_r(i,j,k+1)-z_r(i,j,k))*cff1
423 tl_cff2=0.25_r8*slope_max* &
424 & ((tl_z_r(i,j,k+1)-tl_z_r(i,j,k))*cff1+ &
425 & (z_r(i,j,k+1)-z_r(i,j,k))*tl_cff1)- &
429 cff3=max(pden(i,j,k)-pden(i,j,k+1),small)
430 tl_cff3=(0.5_r8+sign(0.5_r8,pden(i,j,k)-pden(i,j,k+1)- &
432 & (tl_pden(i,j,k)-tl_pden(i,j,k+1))+ &
434 & (0.5_r8-sign(0.5_r8, &
435 & pden(i,j,k)-pden(i,j,k+1)-small))* &
439 tl_cff4=(0.5_r8+sign(0.5_r8,cff2-cff3))*tl_cff2+ &
440 & (0.5_r8-sign(0.5_r8,cff2-cff3))*tl_cff3
442 tl_cff=cff*cff*tl_cff4+ &
446#elif defined TS_MIX_MIN_STRAT
447 cff1=max(pden(i,j,k)-pden(i,j,k+1), &
448 & strat_min*(z_r(i,j,k+1)-z_r(i,j,k)))
449 tl_cff1=(0.5_r8+sign(0.5_r8, &
450 & pden(i,j,k)-pden(i,j,k+1)- &
451 & strat_min*(z_r(i,j,k+1)- &
453 & (tl_pden(i,j,k)-tl_pden(i,j,k+1))+ &
454 & (0.5_r8-sign(0.5_r8, &
455 & pden(i,j,k)-pden(i,j,k+1)- &
456 & strat_min*(z_r(i,j,k+1)- &
458 & (strat_min*(tl_z_r(i,j,k+1)-tl_z_r(i,j,k )))
460 tl_cff=cff*cff*tl_cff1+ &
465 cff1=max(pden(i,j,k)-pden(i,j,k+1),eps)
466 tl_cff1=(0.5_r8+sign(0.5_r8, &
467 & pden(i,j,k)-pden(i,j,k+1)-eps))* &
468 & (tl_pden(i,j,k)-tl_pden(i,j,k+1))+ &
470 & (0.5_r8-sign(0.5_r8, &
471 & pden(i,j,k)-pden(i,j,k+1)-eps))*eps
474 tl_cff=cff*cff*tl_cff1+ &
479#if defined TS_MIX_STABILITY
480 dtdr(i,j,k2)=cff*(0.75_r8*(t(i,j,k+1,nrhs,itrc)- &
481 & t(i,j,k ,nrhs,itrc))+ &
482 & 0.25_r8*(t(i,j,k+1,nstp,itrc)- &
483 & t(i,j,k ,nstp,itrc)))
484 tl_dtdr(i,j,k2)=tl_cff* &
485 & (0.75_r8*(t(i,j,k+1,nrhs,itrc)- &
486 & t(i,j,k ,nrhs,itrc))+ &
487 & 0.25_r8*(t(i,j,k+1,nstp,itrc)- &
488 & t(i,j,k ,nstp,itrc)))+ &
490 & (0.75_r8*(tl_t(i,j,k+1,nrhs,itrc)- &
491 & tl_t(i,j,k ,nrhs,itrc))+ &
492 & 0.25_r8*(tl_t(i,j,k+1,nstp,itrc)- &
493 & tl_t(i,j,k ,nstp,itrc)))- &
497#elif defined TS_MIX_CLIMA
499 dtdr(i,j,k2)=cff*((t(i,j,k+1,nrhs,itrc)- &
500 & tclm(i,j,k+1,itrc))- &
501 & (t(i,j,k ,nrhs,itrc)- &
502 & tclm(i,j,k ,itrc)))
503 tl_dtdr(i,j,k2)=tl_cff*((t(i,j,k+1,nrhs,itrc)- &
504 & tclm(i,j,k+1,itrc))- &
505 & (t(i,j,k ,nrhs,itrc)- &
506 & tclm(i,j,k ,itrc)))+ &
507 & cff*(tl_t(i,j,k+1,nrhs,itrc)- &
508 & tl_t(i,j,k ,nrhs,itrc))- &
513 dtdr(i,j,k2)=cff*(t(i,j,k+1,nrhs,itrc)- &
514 & t(i,j,k ,nrhs,itrc))
515 tl_dtdr(i,j,k2)=tl_cff*(t(i,j,k+1,nrhs,itrc)- &
516 & t(i,j,k ,nrhs,itrc))+ &
517 & cff*(tl_t(i,j,k+1,nrhs,itrc)- &
518 & tl_t(i,j,k ,nrhs,itrc))- &
524 dtdr(i,j,k2)=cff*(t(i,j,k+1,nrhs,itrc)- &
525 & t(i,j,k ,nrhs,itrc))
526 tl_dtdr(i,j,k2)=tl_cff*(t(i,j,k+1,nrhs,itrc)- &
527 & t(i,j,k ,nrhs,itrc))+ &
528 & cff*(tl_t(i,j,k+1,nrhs,itrc)- &
529 & tl_t(i,j,k ,nrhs,itrc))- &
534 fs(i,j,k2)=cff*(z_r(i,j,k+1)- &
536 tl_fs(i,j,k2)=tl_cff*(z_r(i,j,k+1)- &
538 & cff*(tl_z_r(i,j,k+1)- &
550# ifdef TS_U3ADV_SPLIT
551 cff=0.5_r8*diff3d_u(i,j,k)*on_u(i,j)
553 cff=0.25_r8*(diff3d_r(i,j,k)+diff3d_r(i-1,j,k))* &
557 cff=0.25_r8*(diff4(i,j,itrc)+diff4(i-1,j,itrc))* &
561 & (hz(i,j,k)+hz(i-1,j,k))* &
563 & 0.5_r8*(max(drdx(i,j,k1),0.0_r8)* &
566 & min(drdx(i,j,k1),0.0_r8)* &
570 & ((tl_hz(i,j,k)+tl_hz(i-1,j,k))* &
572 & 0.5_r8*(max(drdx(i,j,k1),0.0_r8)* &
575 & min(drdx(i,j,k1),0.0_r8)* &
577 & dtdr(i ,j,k1))))+ &
578 & (hz(i,j,k)+hz(i-1,j,k))* &
579 & (tl_dtdx(i,j,k1)- &
580 & 0.5_r8*(max(drdx(i,j,k1),0.0_r8)* &
581 & (tl_dtdr(i-1,j,k1)+ &
582 & tl_dtdr(i ,j,k2))+ &
583 & min(drdx(i,j,k1),0.0_r8)* &
584 & (tl_dtdr(i-1,j,k2)+ &
585 & tl_dtdr(i ,j,k1)))- &
587 & sign(0.5_r8, drdx(i,j,k1)))* &
589 & (dtdr(i-1,j,k1)+dtdr(i,j,k2))+ &
591 & sign(0.5_r8,-drdx(i,j,k1)))* &
593 & (dtdr(i-1,j,k2)+dtdr(i,j,k1)))))- &
596 & (hz(i,j,k)+hz(i-1,j,k))* &
598 & (max(drdx(i,j,k1),0.0_r8)* &
601 & min(drdx(i,j,k1),0.0_r8)* &
610# ifdef TS_U3ADV_SPLIT
611 cff=0.5_r8*diff3d_v(i,j,k)*om_v(i,j)
613 cff=0.25_r8*(diff3d_r(i,j,k)+diff3d_r(i,j-1,k))* &
617 cff=0.25_r8*(diff4(i,j,itrc)+diff4(i,j-1,itrc))* &
621 & (hz(i,j,k)+hz(i,j-1,k))* &
623 & 0.5_r8*(max(drde(i,j,k1),0.0_r8)* &
626 & min(drde(i,j,k1),0.0_r8)* &
630 & ((tl_hz(i,j,k)+tl_hz(i,j-1,k))* &
632 & 0.5_r8*(max(drde(i,j,k1),0.0_r8)* &
635 & min(drde(i,j,k1),0.0_r8)* &
637 & dtdr(i,j ,k1))))+ &
638 & (hz(i,j,k)+hz(i,j-1,k))* &
639 & (tl_dtde(i,j,k1)- &
640 & 0.5_r8*(max(drde(i,j,k1),0.0_r8)* &
641 & (tl_dtdr(i,j-1,k1)+ &
642 & tl_dtdr(i,j ,k2))+ &
643 & min(drde(i,j,k1),0.0_r8)* &
644 & (tl_dtdr(i,j-1,k2)+ &
645 & tl_dtdr(i,j ,k1)))- &
647 & sign(0.5_r8, drde(i,j,k1)))* &
649 & (dtdr(i,j-1,k1)+dtdr(i,j,k2))+ &
651 & sign(0.5_r8,-drde(i,j,k1)))* &
653 & (dtdr(i,j-1,k2)+dtdr(i,j,k1)))))- &
656 & (hz(i,j,k)+hz(i,j-1,k))* &
658 & (max(drde(i,j,k1),0.0_r8)* &
661 & min(drde(i,j,k1),0.0_r8)* &
671# ifdef TS_U3ADV_SPLIT
672 difx=0.125_r8*(diff3d_u(i,j,k )+diff3d_u(i+1,j,k )+ &
673 & diff3d_u(i,j,k+1)+diff3d_u(i+1,j,k+1))
674 dife=0.125_r8*(diff3d_v(i,j,k )+diff3d_v(i,j+1,k )+ &
675 & diff3d_v(i,j,k+1)+diff3d_v(i,j+1,k+1))
677 difx=0.5_r8*diff3d_r(i,j,k)
681 difx=0.5_r8*diff4(i,j,itrc)
684 cff1=max(drdx(i ,j,k1),0.0_r8)
685 cff2=max(drdx(i+1,j,k2),0.0_r8)
686 cff3=min(drdx(i ,j,k2),0.0_r8)
687 cff4=min(drdx(i+1,j,k1),0.0_r8)
688 tl_cff1=(0.5_r8+sign(0.5_r8, drdx(i ,j,k1)))* &
690 tl_cff2=(0.5_r8+sign(0.5_r8, drdx(i+1,j,k2)))* &
692 tl_cff3=(0.5_r8+sign(0.5_r8,-drdx(i ,j,k2)))* &
694 tl_cff4=(0.5_r8+sign(0.5_r8,-drdx(i+1,j,k1)))* &
697 & (cff1*(cff1*dtdr(i,j,k2)-dtdx(i ,j,k1))+ &
698 & cff2*(cff2*dtdr(i,j,k2)-dtdx(i+1,j,k2))+ &
699 & cff3*(cff3*dtdr(i,j,k2)-dtdx(i ,j,k2))+ &
700 & cff4*(cff4*dtdr(i,j,k2)-dtdx(i+1,j,k1)))
702 & (tl_cff1*(cff1*dtdr(i ,j,k2)- &
704 & tl_cff2*(cff2*dtdr(i,j,k2)- &
706 & tl_cff3*(cff3*dtdr(i,j,k2)- &
708 & tl_cff4*(cff4*dtdr(i,j,k2)- &
710 & cff1*(tl_cff1*dtdr(i,j,k2)+ &
711 & cff1*tl_dtdr(i,j,k2)- &
712 & tl_dtdx(i ,j,k1))+ &
713 & cff2*(tl_cff2*dtdr(i,j,k2)+ &
714 & cff2*tl_dtdr(i,j,k2)- &
715 & tl_dtdx(i+1,j,k2))+ &
716 & cff3*(tl_cff3*dtdr(i,j,k2)+ &
717 & cff3*tl_dtdr(i,j,k2)- &
718 & tl_dtdx(i ,j,k2))+ &
719 & cff4*(tl_cff4*dtdr(i,j,k2)+ &
720 & cff4*tl_dtdr(i,j,k2)- &
721 & tl_dtdx(i+1,j,k1)))- &
724 & (cff1*(2.0_r8*cff1*dtdr(i,j,k2)- &
726 & cff2*(2.0_r8*cff2*dtdr(i,j,k2)- &
728 & cff3*(2.0_r8*cff3*dtdr(i,j,k2)- &
730 & cff4*(2.0_r8*cff4*dtdr(i,j,k2)- &
734 cff1=max(drde(i,j ,k1),0.0_r8)
735 cff2=max(drde(i,j+1,k2),0.0_r8)
736 cff3=min(drde(i,j ,k2),0.0_r8)
737 cff4=min(drde(i,j+1,k1),0.0_r8)
738 tl_cff1=(0.5_r8+sign(0.5_r8, drde(i,j ,k1)))* &
740 tl_cff2=(0.5_r8+sign(0.5_r8, drde(i,j+1,k2)))* &
742 tl_cff3=(0.5_r8+sign(0.5_r8,-drde(i,j ,k2)))* &
744 tl_cff4=(0.5_r8+sign(0.5_r8,-drde(i,j+1,k1)))* &
748 & (cff1*(cff1*dtdr(i,j,k2)-dtde(i,j ,k1))+ &
749 & cff2*(cff2*dtdr(i,j,k2)-dtde(i,j+1,k2))+ &
750 & cff3*(cff3*dtdr(i,j,k2)-dtde(i,j ,k2))+ &
751 & cff4*(cff4*dtdr(i,j,k2)-dtde(i,j+1,k1)))
754 & (tl_cff1*(cff1*dtdr(i,j,k2)- &
756 & tl_cff2*(cff2*dtdr(i,j,k2)- &
758 & tl_cff3*(cff3*dtdr(i,j,k2)- &
760 & tl_cff4*(cff4*dtdr(i,j,k2)- &
762 & cff1*(tl_cff1*dtdr(i,j,k2)+ &
763 & cff1*tl_dtdr(i,j,k2)- &
764 & tl_dtde(i,j ,k1))+ &
765 & cff2*(tl_cff2*dtdr(i,j,k2)+ &
766 & cff2*tl_dtdr(i,j,k2)- &
767 & tl_dtde(i,j+1,k2))+ &
768 & cff3*(tl_cff3*dtdr(i,j,k2)+ &
769 & cff3*tl_dtdr(i,j,k2)- &
770 & tl_dtde(i,j ,k2))+ &
771 & cff4*(tl_cff4*dtdr(i,j,k2)+ &
772 & cff4*tl_dtdr(i,j,k2)- &
773 & tl_dtde(i,j+1,k1)))- &
776 & (cff1*(2.0_r8*cff1*dtdr(i,j,k2)- &
778 & cff2*(2.0_r8*cff2*dtdr(i,j,k2)- &
780 & cff3*(2.0_r8*cff3*dtdr(i,j,k2)- &
782 & cff4*(2.0_r8*cff4*dtdr(i,j,k2)-
788 tl_fs(i,j,k2)=tl_cff*fs(i,j,k2)+ &
789 & cff*tl_fs(i,j,k2)- &
793 fs(i,j,k2)=cff*fs(i,j,k2)
805 cff1=1.0_r8/hz(i,j,k)
806 tl_cff1=-cff1*cff1*tl_hz(i,j,k)+ &
810 lapt(i,j,k)=cff1*(cff* &
811 & (fx(i+1,j)-fx(i,j)+ &
812 & fe(i,j+1)-fe(i,j))+ &
813 & (fs(i,j,k2)-fs(i,j,k1)))
814 tl_lapt(i,j,k)=tl_cff1*(cff* &
815 & (fx(i+1,j)-fx(i,j)+ &
816 & fe(i,j+1)-fe(i,j))+ &
817 & (fs(i,j,k2)-fs(i,j,k1)))+ &
819 & (tl_fx(i+1,j)-tl_fx(i,j)+ &
820 & tl_fe(i,j+1)-tl_fe(i,j))+ &
821 & (tl_fs(i,j,k2)-tl_fs(i,j,k1)))- &
834 IF (
domain(ng)%Western_Edge(tile))
THEN
838 lapt(istr-1,j,k)=0.0_r8
839 tl_lapt(istr-1,j,k)=0.0_r8
845 lapt(istr-1,j,k)=lapt(istr,j,k)
846 tl_lapt(istr-1,j,k)=tl_lapt(istr,j,k)
854 IF (
domain(ng)%Eastern_Edge(tile))
THEN
858 lapt(iend+1,j,k)=0.0_r8
859 tl_lapt(iend+1,j,k)=0.0_r8
865 lapt(iend+1,j,k)=lapt(iend,j,k)
866 tl_lapt(iend+1,j,k)=tl_lapt(iend,j,k)
874 IF (
domain(ng)%Southern_Edge(tile))
THEN
878 lapt(i,jstr-1,k)=0.0_r8
879 tl_lapt(i,jstr-1,k)=0.0_r8
885 lapt(i,jstr-1,k)=lapt(i,jstr,k)
886 tl_lapt(i,jstr-1,k)=tl_lapt(i,jstr,k)
894 IF (
domain(ng)%Northern_Edge(tile))
THEN
898 lapt(i,jend+1,k)=0.0_r8
899 tl_lapt(i,jend+1,k)=0.0_r8
905 lapt(i,jend+1,k)=lapt(i,jend,k)
906 tl_lapt(i,jend+1,k)=tl_lapt(i,jend,k)
915 IF (
domain(ng)%SouthWest_Corner(tile))
THEN
917 lapt(istr-1,jstr-1,k)=0.5_r8* &
918 & (lapt(istr ,jstr-1,k)+ &
919 & lapt(istr-1,jstr ,k))
920 tl_lapt(istr-1,jstr-1,k)=0.5_r8* &
921 & (tl_lapt(istr ,jstr-1,k)+ &
922 tl_lapt(istr-1,jstr ,k))
929 IF (
domain(ng)%SouthEast_Corner(tile))
THEN
931 lapt(iend+1,jstr-1,k)=0.5_r8* &
932 & (lapt(iend ,jstr-1,k)+ &
933 & lapt(iend+1,jstr ,k))
934 tl_lapt(iend+1,jstr-1,k)=0.5_r8* &
935 & (tl_lapt(iend ,jstr-1,k)+ &
936 & tl_lapt(iend+1,jstr ,k))
943 IF (
domain(ng)%NorthWest_Corner(tile))
THEN
945 lapt(istr-1,jend+1,k)=0.5_r8* &
946 & (lapt(istr ,jend+1,k)+ &
947 & lapt(istr-1,jend ,k))
948 tl_lapt(istr-1,jend+1,k)=0.5_r8* &
949 & (tl_lapt(istr ,jend+1,k)+ &
950 & tl_lapt(istr-1,jend ,k))
957 IF (
domain(ng)%NorthEast_Corner(tile))
THEN
959 lapt(iend+1,jend+1,k)=0.5_r8* &
960 & (lapt(iend ,jend+1,k)+ &
961 & lapt(iend+1,jend ,k))
962 tl_lapt(iend+1,jend+1,k)=0.5_r8* &
963 & (tl_lapt(iend ,jend+1,k)+ &
964 & tl_lapt(iend+1,jend ,k))
973 k_loop2:
DO k=0,n(ng)
979 cff=0.5_r8*(pm(i,j)+pm(i-1,j))
983#ifdef WET_DRY_NOT_YET
984 cff=cff*umask_wet(i,j)
986 drdx(i,j,k2)=cff*(pden(i ,j,k+1)- &
988 tl_drdx(i,j,k2)=cff*(tl_pden(i ,j,k+1)- &
989 & tl_pden(i-1,j,k+1))
990 dtdx(i,j,k2)=cff*(lapt(i ,j,k+1)- &
992 tl_dtdx(i,j,k2)=cff*(tl_lapt(i ,j,k+1)- &
993 & tl_lapt(i-1,j,k+1))
998 cff=0.5_r8*(pn(i,j)+pn(i,j-1))
1002#ifdef WET_DRY_NOT_YET
1003 cff=cff*vmask_wet(i,j)
1005 drde(i,j,k2)=cff*(pden(i,j ,k+1)- &
1007 tl_drde(i,j,k2)=cff*(tl_pden(i,j ,k+1)- &
1008 & tl_pden(i,j-1,k+1))
1009 dtde(i,j,k2)=cff*(lapt(i,j ,k+1)- &
1011 tl_dtde(i,j,k2)=cff*(tl_lapt(i,j ,k+1)- &
1012 & tl_lapt(i,j-1,k+1))
1016 IF ((k.eq.0).or.(k.eq.n(ng)))
THEN
1020 tl_dtdr(i,j,k2)=0.0_r8
1022 tl_fs(i,j,k2)=0.0_r8
1028#if defined TS_MIX_MAX_SLOPE
1029 cff1=sqrt(drdx(i,j,k2)**2+drdx(i+1,j,k2)**2+ &
1030 & drdx(i,j,k1)**2+drdx(i+1,j,k1)**2+ &
1031 & drde(i,j,k2)**2+drde(i,j+1,k2)**2+ &
1032 & drde(i,j,k1)**2+drde(i,j+1,k1)**2)
1033 IF (cff1.ne.0.0_r8)
THEN
1034 tl_cff1=(drdx(i ,j,k2)*tl_drdx(i ,j,k2)+ &
1035 & drdx(i+1,j,k2)*tl_drdx(i+1,j,k2)+ &
1036 & drdx(i ,j,k1)*tl_drdx(i ,j,k1)+ &
1037 & drdx(i+1,j,k1)*tl_drdx(i+1,j,k1)+ &
1038 & drde(i,j ,k2)*tl_drde(i,j ,k2)+ &
1039 & drde(i,j+1,k2)*tl_drde(i,j+1,k2)+ &
1040 & drde(i,j ,k1)*tl_drde(i,j ,k1)+ &
1041 & drde(i,j+1,k1)*tl_drde(i,j+1,k1))/cff1
1045 cff2=0.25_r8*slope_max* &
1046 & (z_r(i,j,k+1)-z_r(i,j,k))*cff1
1047 tl_cff2=0.25_r8*slope_max* &
1048 & ((tl_z_r(i,j,k+1)-tl_z_r(i,j,k))*cff1+ &
1049 & (z_r(i,j,k+1)-z_r(i,j,k))*tl_cff1)- &
1053 cff3=max(pden(i,j,k)-pden(i,j,k+1),small)
1054 tl_cff3=(0.5_r8+sign(0.5_r8,pden(i,j,k)-pden(i,j,k+1)- &
1056 & (tl_pden(i,j,k)-tl_pden(i,j,k+1))+ &
1058 & (0.5_r8-sign(0.5_r8, &
1059 & pden(i,j,k)-pden(i,j,k+1)-small))* &
1063 tl_cff4=(0.5_r8+sign(0.5_r8,cff2-cff3))*tl_cff2+ &
1064 & (0.5_r8-sign(0.5_r8,cff2-cff3))*tl_cff3
1066 tl_cff=cff*cff*tl_cff4+ &
1070#elif defined TS_MIX_MIN_STRAT
1071 cff1=max(pden(i,j,k)-pden(i,j,k+1), &
1072 & strat_min*(z_r(i,j,k+1)-z_r(i,j,k)))
1073 tl_cff1=(0.5_r8+sign(0.5_r8, &
1074 & pden(i,j,k)-pden(i,j,k+1)- &
1075 & strat_min*(z_r(i,j,k+1)- &
1077 & (tl_pden(i,j,k)-tl_pden(i,j,k+1))+ &
1078 & (0.5_r8-sign(0.5_r8, &
1079 & pden(i,j,k)-pden(i,j,k+1)- &
1080 & strat_min*(z_r(i,j,k+1)- &
1082 & (strat_min*(tl_z_r(i,j,k+1)-tl_z_r(i,j,k )))
1084 tl_cff=cff*cff*tl_cff1+ &
1089 cff1=max(pden(i,j,k)-pden(i,j,k+1),eps)
1090 tl_cff1=(0.5_r8+sign(0.5_r8, &
1091 & pden(i,j,k)-pden(i,j,k+1)-eps))* &
1092 & (tl_pden(i,j,k)-tl_pden(i,j,k+1))+ &
1094 & (0.5_r8-sign(0.5_r8, &
1095 & pden(i,j,k)-pden(i,j,k+1)-eps))*eps
1098 tl_cff=cff*cff*tl_cff1+ &
1103 dtdr(i,j,k2)=cff*(lapt(i,j,k+1)- &
1105 tl_dtdr(i,j,k2)=tl_cff*(lapt(i,j,k+1)- &
1107 & cff*(tl_lapt(i,j,k+1)- &
1108 & tl_lapt(i,j,k ))- &
1112 fs(i,j,k2)=cff*(z_r(i,j,k+1)- &
1114 tl_fs(i,j,k2)=tl_cff*(z_r(i,j,k+1)- &
1116 & cff*(tl_z_r(i,j,k+1)- &
1117 & tl_z_r(i,j,k ))- &
1132# ifdef TS_U3ADV_SPLIT
1133 cff=0.5_r8*diff3d_u(i,j,k)*on_u(i,j)
1135 cff=0.25_r8*(diff3d_r(i,j,k)+diff3d_r(i-1,j,k))* &
1139 cff=0.25_r8*(diff4(i,j,itrc)+diff4(i-1,j,itrc))* &
1153 & ((tl_hz(i,j,k)+tl_hz(i-1,j,k))* &
1155 & 0.5_r8*(max(drdx(i,j,k1),0.0_r8)* &
1156 & (dtdr(i-1,j,k1)+ &
1158 & min(drdx(i,j,k1),0.0_r8)* &
1159 & (dtdr(i-1,j,k2)+ &
1160 & dtdr(i ,j,k1))))+ &
1161 & (hz(i,j,k)+hz(i-1,j,k))* &
1162 & (tl_dtdx(i,j,k1)- &
1163 & 0.5_r8*(max(drdx(i,j,k1),0.0_r8)* &
1164 & (tl_dtdr(i-1,j,k1)+ &
1165 & tl_dtdr(i ,j,k2))+ &
1166 & min(drdx(i,j,k1),0.0_r8)* &
1167 & (tl_dtdr(i-1,j,k2)+ &
1168 & tl_dtdr(i ,j,k1)))- &
1169 & 0.5_r8*((0.5_r8+ &
1170 & sign(0.5_r8, drdx(i,j,k1)))* &
1171 & tl_drdx(i,j,k1)* &
1172 & (dtdr(i-1,j,k1)+dtdr(i,j,k2))+ &
1174 & sign(0.5_r8,-drdx(i,j,k1)))* &
1175 & tl_drdx(i,j,k1)* &
1176 & (dtdr(i-1,j,k2)+dtdr(i,j,k1)))))- &
1179 & (hz(i,j,k)+hz(i-1,j,k))* &
1181 & (max(drdx(i,j,k1),0.0_r8)* &
1182 & (dtdr(i-1,j,k1)+ &
1184 & min(drdx(i,j,k1),0.0_r8)* &
1185 & (dtdr(i-1,j,k2)+ &
1193# ifdef TS_U3ADV_SPLIT
1194 cff=0.5_r8*diff3d_v(i,j,k)*om_v(i,j)
1196 cff=0.25_r8*(diff3d_r(i,j,k)+diff3d_r(i,j-1,k))* &
1200 cff=0.25_r8*(diff4(i,j,itrc)+diff4(i,j-1,itrc))* &
1214 & ((tl_hz(i,j,k)+tl_hz(i,j-1,k))* &
1216 & 0.5_r8*(max(drde(i,j,k1),0.0_r8)* &
1217 & (dtdr(i,j-1,k1)+ &
1219 & min(drde(i,j,k1),0.0_r8)* &
1220 & (dtdr(i,j-1,k2)+ &
1221 & dtdr(i,j ,k1))))+ &
1222 & (hz(i,j,k)+hz(i,j-1,k))* &
1223 & (tl_dtde(i,j,k1)- &
1224 & 0.5_r8*(max(drde(i,j,k1),0.0_r8)* &
1225 & (tl_dtdr(i,j-1,k1)+ &
1226 & tl_dtdr(i,j ,k2))+ &
1227 & min(drde(i,j,k1),0.0_r8)* &
1228 & (tl_dtdr(i,j-1,k2)+ &
1229 & tl_dtdr(i,j ,k1)))- &
1230 & 0.5_r8*((0.5_r8+ &
1231 & sign(0.5_r8, drde(i,j,k1)))* &
1232 & tl_drde(i,j,k1)* &
1233 & (dtdr(i,j-1,k1)+dtdr(i,j,k2))+ &
1235 & sign(0.5_r8,-drde(i,j,k1)))* &
1236 & tl_drde(i,j,k1)* &
1237 & (dtdr(i,j-1,k2)+dtdr(i,j,k1)))))- &
1240 & (hz(i,j,k)+hz(i,j-1,k))* &
1242 & (max(drde(i,j,k1),0.0_r8)* &
1243 & (dtdr(i,j-1,k1)+ &
1245 & min(drde(i,j,k1),0.0_r8)* &
1246 & (dtdr(i,j-1,k2)+ &
1251 IF (k.lt.n(ng))
THEN
1255# ifdef TS_U3ADV_SPLIT
1256 difx=0.125_r8*(diff3d_u(i,j,k )+diff3d_u(i+1,j,k )+ &
1257 & diff3d_u(i,j,k+1)+diff3d_u(i+1,j,k+1))
1258 dife=0.125_r8*(diff3d_v(i,j,k )+diff3d_v(i,j+1,k )+ &
1259 & diff3d_v(i,j,k+1)+diff3d_v(i,j+1,k+1))
1261 difx=0.5_r8*diff3d_r(i,j,k)
1265 difx=0.5_r8*diff4(i,j,itrc)
1268 cff1=max(drdx(i ,j,k1),0.0_r8)
1269 cff2=max(drdx(i+1,j,k2),0.0_r8)
1270 cff3=min(drdx(i ,j,k2),0.0_r8)
1271 cff4=min(drdx(i+1,j,k1),0.0_r8)
1272 tl_cff1=(0.5_r8+sign(0.5_r8, drdx(i ,j,k1)))* &
1274 tl_cff2=(0.5_r8+sign(0.5_r8, drdx(i+1,j,k2)))* &
1276 tl_cff3=(0.5_r8+sign(0.5_r8,-drdx(i ,j,k2)))* &
1278 tl_cff4=(0.5_r8+sign(0.5_r8,-drdx(i+1,j,k1)))* &
1281 & (cff1*(cff1*dtdr(i,j,k2)-dtdx(i ,j,k1))+ &
1282 & cff2*(cff2*dtdr(i,j,k2)-dtdx(i+1,j,k2))+ &
1283 & cff3*(cff3*dtdr(i,j,k2)-dtdx(i ,j,k2))+ &
1284 & cff4*(cff4*dtdr(i,j,k2)-dtdx(i+1,j,k1)))
1286 & (tl_cff1*(cff1*dtdr(i ,j,k2)- &
1288 & tl_cff2*(cff2*dtdr(i,j,k2)- &
1289 & dtdx(i+1,j,k2))+ &
1290 & tl_cff3*(cff3*dtdr(i,j,k2)- &
1292 & tl_cff4*(cff4*dtdr(i,j,k2)- &
1293 & dtdx(i+1,j,k1))+ &
1294 & cff1*(tl_cff1*dtdr(i,j,k2)+ &
1295 & cff1*tl_dtdr(i,j,k2)- &
1296 & tl_dtdx(i ,j,k1))+ &
1297 & cff2*(tl_cff2*dtdr(i,j,k2)+ &
1298 & cff2*tl_dtdr(i,j,k2)- &
1299 & tl_dtdx(i+1,j,k2))+ &
1300 & cff3*(tl_cff3*dtdr(i,j,k2)+ &
1301 & cff3*tl_dtdr(i,j,k2)- &
1302 & tl_dtdx(i ,j,k2))+ &
1303 & cff4*(tl_cff4*dtdr(i,j,k2)+ &
1304 & cff4*tl_dtdr(i,j,k2)- &
1305 & tl_dtdx(i+1,j,k1)))- &
1308 & (cff1*(2.0_r8*cff1*dtdr(i,j,k2)- &
1310 & cff2*(2.0_r8*cff2*dtdr(i,j,k2)- &
1311 & dtdx(i+1,j,k2))- &
1312 & cff3*(2.0_r8*cff3*dtdr(i,j,k2)- &
1314 & cff4*(2.0_r8*cff4*dtdr(i,j,k2)- &
1318 cff1=max(drde(i,j ,k1),0.0_r8)
1319 cff2=max(drde(i,j+1,k2),0.0_r8)
1320 cff3=min(drde(i,j ,k2),0.0_r8)
1321 cff4=min(drde(i,j+1,k1),0.0_r8)
1322 tl_cff1=(0.5_r8+sign(0.5_r8, drde(i,j ,k1)))* &
1324 tl_cff2=(0.5_r8+sign(0.5_r8, drde(i,j+1,k2)))* &
1326 tl_cff3=(0.5_r8+sign(0.5_r8,-drde(i,j ,k2)))* &
1328 tl_cff4=(0.5_r8+sign(0.5_r8,-drde(i,j+1,k1)))* &
1332 & (cff1*(cff1*dtdr(i,j,k2)-dtde(i,j ,k1))+ &
1333 & cff2*(cff2*dtdr(i,j,k2)-dtde(i,j+1,k2))+ &
1334 & cff3*(cff3*dtdr(i,j,k2)-dtde(i,j ,k2))+ &
1335 & cff4*(cff4*dtdr(i,j,k2)-dtde(i,j+1,k1)))
1338 & (tl_cff1*(cff1*dtdr(i,j,k2)- &
1340 & tl_cff2*(cff2*dtdr(i,j,k2)- &
1341 & dtde(i,j+1,k2))+ &
1342 & tl_cff3*(cff3*dtdr(i,j,k2)- &
1344 & tl_cff4*(cff4*dtdr(i,j,k2)- &
1345 & dtde(i,j+1,k1))+ &
1346 & cff1*(tl_cff1*dtdr(i,j,k2)+ &
1347 & cff1*tl_dtdr(i,j,k2)- &
1348 & tl_dtde(i,j ,k1))+ &
1349 & cff2*(tl_cff2*dtdr(i,j,k2)+ &
1350 & cff2*tl_dtdr(i,j,k2)- &
1351 & tl_dtde(i,j+1,k2))+ &
1352 & cff3*(tl_cff3*dtdr(i,j,k2)+ &
1353 & cff3*tl_dtdr(i,j,k2)- &
1354 & tl_dtde(i,j ,k2))+ &
1355 & cff4*(tl_cff4*dtdr(i,j,k2)+ &
1356 & cff4*tl_dtdr(i,j,k2)- &
1357 & tl_dtde(i,j+1,k1)))- &
1360 & (cff1*(2.0_r8*cff1*dtdr(i,j,k2)- &
1362 & cff2*(2.0_r8*cff2*dtdr(i,j,k2)- &
1363 & dtde(i,j+1,k2))- &
1364 & cff3*(2.0_r8*cff3*dtdr(i,j,k2)- &
1366 & cff4*(2.0_r8*cff4*dtdr(i,j,k2)- &
1372 tl_fs(i,j,k2)=tl_cff*fs(i,j,k2)+ &
1374 fs(i,j,k2)=cff*fs(i,j,k2)
1376 tl_fs(i,j,k2)=tl_fs(i,j,k2)-fs(i,j,k2)
1391 tl_cff=
dt(ng)*pm(i,j)*pn(i,j)* &
1392 & (tl_fx(i+1,j)-tl_fx(i,j)+ &
1393 & tl_fe(i,j+1)-tl_fe(i,j))+ &
1394 &
dt(ng)*(tl_fs(i,j,k2)-tl_fs(i,j,k1))
1397 tl_t(i,j,k,nnew,itrc)=tl_t(i,j,k,nnew,itrc)-tl_cff
1398#ifdef DIAGNOSTICS_TS