51 & LBi, UBi, LBj, UBj, UBk, UBt, &
52 & IminS, ImaxS, JminS, JmaxS, &
66 integer,
intent(in) :: ng, tile, itrc, ic
67 integer,
intent(in) :: lbi, ubi, lbj, ubj, ubk, ubt
68 integer,
intent(in) :: imins, imaxs, jmins, jmaxs
69 integer,
intent(in) :: nstp, nout
72 real(r8),
intent(inout) :: t(lbi:,lbj:,:,:,:)
74 real(r8),
intent(inout) :: t(lbi:ubi,lbj:ubj,ubk,3,ubt)
81 real(r8),
parameter :: eps =1.0e-20_r8
83 real(r8) :: ce, cx, cff, dtde, dtdt, dtdx
84 real(r8) :: obc_in, obc_out, tau
86 real(r8),
dimension(IminS:ImaxS,JminS:JmaxS) :: grad
88# include "set_bounds.h"
94 IF (
domain(ng)%Western_Edge(tile))
THEN
101 grad(istr-1,j)=t(istr-1,j ,k,nstp,itrc)- &
102 & t(istr-1,j-1,k,nstp,itrc)
104 grad(istr-1,j)=grad(istr-1,j)* &
105 &
grid(ng)%vmask(istr-1,j)
107 grad(istr ,j)=t(istr ,j ,k,nstp,itrc)- &
108 & t(istr ,j-1,k,nstp,itrc)
110 grad(istr ,j)=grad(istr ,j)* &
111 &
grid(ng)%vmask(istr ,j)
116 dtdt=t(istr,j,k,nstp,itrc)-t(istr ,j,k,nout,itrc)
117 dtdx=t(istr,j,k,nout,itrc)-t(istr+1,j,k,nout,itrc)
121 obc_out=
clima(ng)%Tnudgcof(istr-1,j,k,ic)
122 obc_in =
obcfac(ng)*obc_out
127 IF ((dtdt*dtdx).lt.0.0_r8)
THEN
135 IF ((dtdt*dtdx).lt.0.0_r8) dtdt=0.0_r8
136 IF ((dtdt*(grad(istr,j )+ &
137 & grad(istr,j+1))).gt.0.0_r8)
THEN
142 cff=max(dtdx*dtdx+dtde*dtde,eps)
145 ce=min(cff,max(dtdt*dtde,-cff))
149# if defined CELERITY_WRITE && defined FORWARD_WRITE
152 boundary(ng)%t_west_C2(j,k,itrc)=cff
154 t(istr-1,j,k,nout,itrc)=(cff*t(istr-1,j,k,nstp,itrc)+ &
155 & cx *t(istr ,j,k,nout,itrc)- &
159 & grad(istr-1,j+1))/ &
163 t(istr-1,j,k,nout,itrc)=t(istr-1,j,k,nout,itrc)+ &
167 & t(istr-1,j,k,nstp,itrc))
170 t(istr-1,j,k,nout,itrc)=t(istr-1,j,k,nout,itrc)* &
171 &
grid(ng)%rmask(istr-1,j)
183 t(istr-1,j,k,nout,itrc)=
boundary(ng)%t_west(j,k,itrc)
185 t(istr-1,j,k,nout,itrc)=t(istr-1,j,k,nout,itrc)* &
186 &
grid(ng)%rmask(istr-1,j)
198 t(istr-1,j,k,nout,itrc)=t(istr,j,k,nout,itrc)
200 t(istr-1,j,k,nout,itrc)=t(istr-1,j,k,nout,itrc)* &
201 &
grid(ng)%rmask(istr-1,j)
213 t(istr-1,j,k,nout,itrc)=t(istr,j,k,nout,itrc)
215 t(istr-1,j,k,nout,itrc)=t(istr-1,j,k,nout,itrc)* &
216 &
grid(ng)%rmask(istr-1,j)
228 IF (
domain(ng)%Eastern_Edge(tile))
THEN
235 grad(iend ,j)=t(iend ,j ,k,nstp,itrc)- &
236 & t(iend ,j-1,k,nstp,itrc)
238 grad(iend ,j)=grad(iend ,j)* &
239 &
grid(ng)%vmask(iend ,j)
241 grad(iend+1,j)=t(iend+1,j ,k,nstp,itrc)- &
242 & t(iend+1,j-1,k,nstp,itrc)
244 grad(iend+1,j)=grad(iend+1,j)* &
245 &
grid(ng)%vmask(iend+1,j)
250 dtdt=t(iend,j,k,nstp,itrc)-t(iend ,j,k,nout,itrc)
251 dtdx=t(iend,j,k,nout,itrc)-t(iend-1,j,k,nout,itrc)
255 obc_out=
clima(ng)%Tnudgcof(iend+1,j,k,ic)
256 obc_in =
obcfac(ng)*obc_out
261 IF ((dtdt*dtdx).lt.0.0_r8)
THEN
269 IF ((dtdt*dtdx).lt.0.0_r8) dtdt=0.0_r8
270 IF ((dtdt*(grad(iend,j )+ &
271 & grad(iend,j+1))).gt.0.0_r8)
THEN
276 cff=max(dtdx*dtdx+dtde*dtde,eps)
279 ce=min(cff,max(dtdt*dtde,-cff))
283# if defined CELERITY_WRITE && defined FORWARD_WRITE
286 boundary(ng)%t_east_C2(j,k,itrc)=cff
288 t(iend+1,j,k,nout,itrc)=(cff*t(iend+1,j,k,nstp,itrc)+ &
289 & cx *t(iend ,j,k,nout,itrc)- &
293 & grad(iend+1,j+1))/ &
297 t(iend+1,j,k,nout,itrc)=t(iend+1,j,k,nout,itrc)+ &
301 & t(iend+1,j,k,nstp,itrc))
304 t(iend+1,j,k,nout,itrc)=t(iend+1,j,k,nout,itrc)* &
305 &
grid(ng)%rmask(iend+1,j)
317 t(iend+1,j,k,nout,itrc)=
boundary(ng)%t_east(j,k,itrc)
319 t(iend+1,j,k,nout,itrc)=t(iend+1,j,k,nout,itrc)* &
320 &
grid(ng)%rmask(iend+1,j)
332 t(iend+1,j,k,nout,itrc)=t(iend,j,k,nout,itrc)
334 t(iend+1,j,k,nout,itrc)=t(iend+1,j,k,nout,itrc)* &
335 &
grid(ng)%rmask(iend+1,j)
347 t(iend+1,j,k,nout,itrc)=t(iend,j,k,nout,itrc)
349 t(iend+1,j,k,nout,itrc)=t(iend+1,j,k,nout,itrc)* &
350 &
grid(ng)%rmask(iend+1,j)
362 IF (
domain(ng)%Southern_Edge(tile))
THEN
369 grad(i,jstr )=t(i ,jstr ,k,nstp,itrc)- &
370 & t(i-1,jstr ,k,nstp,itrc)
372 grad(i,jstr )=grad(i,jstr )* &
373 &
grid(ng)%umask(i,jstr )
375 grad(i,jstr-1)=t(i ,jstr-1,k,nstp,itrc)- &
376 & t(i-1,jstr-1,k,nstp,itrc)
378 grad(i,jstr-1)=grad(i,jstr-1)* &
379 &
grid(ng)%umask(i,jstr-1)
384 dtdt=t(i,jstr,k,nstp,itrc)-t(i,jstr ,k,nout,itrc)
385 dtde=t(i,jstr,k,nout,itrc)-t(i,jstr+1,k,nout,itrc)
389 obc_out=
clima(ng)%Tnudgcof(i,jstr-1,k,ic)
390 obc_in =
obcfac(ng)*obc_out
395 IF ((dtdt*dtde).lt.0.0_r8)
THEN
403 IF ((dtdt*dtde).lt.0.0_r8) dtdt=0.0_r8
404 IF ((dtdt*(grad(i ,jstr)+ &
405 & grad(i+1,jstr))).gt.0.0_r8)
THEN
410 cff=max(dtdx*dtdx+dtde*dtde,eps)
412 cx=min(cff,max(dtdt*dtdx,-cff))
417# if defined CELERITY_WRITE && defined FORWARD_WRITE
418 boundary(ng)%t_south_Cx(i,k,itrc)=cx
419 boundary(ng)%t_south_Ce(i,k,itrc)=ce
420 boundary(ng)%t_south_C2(i,k,itrc)=cff
422 t(i,jstr-1,k,nout,itrc)=(cff*t(i,jstr-1,k,nstp,itrc)+ &
423 & ce *t(i,jstr ,k,nout,itrc )- &
427 & grad(i+1,jstr-1))/ &
431 t(i,jstr-1,k,nout,itrc)=t(i,jstr-1,k,nout,itrc)+ &
435 & t(i,jstr-1,k,nstp,itrc))
438 t(i,jstr-1,k,nout,itrc)=t(i,jstr-1,k,nout,itrc)* &
439 &
grid(ng)%rmask(i,jstr-1)
451 t(i,jstr-1,k,nout,itrc)=
boundary(ng)%t_south(i,k,itrc)
453 t(i,jstr-1,k,nout,itrc)=t(i,jstr-1,k,nout,itrc)* &
454 &
grid(ng)%rmask(i,jstr-1)
466 t(i,jstr-1,k,nout,itrc)=t(i,jstr,k,nout,itrc)
468 t(i,jstr-1,k,nout,itrc)=t(i,jstr-1,k,nout,itrc)* &
469 &
grid(ng)%rmask(i,jstr-1)
481 t(i,jstr-1,k,nout,itrc)=t(i,jstr,k,nout,itrc)
483 t(i,jstr-1,k,nout,itrc)=t(i,jstr-1,k,nout,itrc)* &
484 &
grid(ng)%rmask(i,jstr-1)
496 IF (
domain(ng)%Northern_Edge(tile))
THEN
503 grad(i,jend )=t(i ,jend ,k,nstp,itrc)- &
504 & t(i-1,jend ,k,nstp,itrc)
506 grad(i,jend )=grad(i,jend )* &
507 &
grid(ng)%umask(i,jend )
509 grad(i,jend+1)=t(i ,jend+1,k,nstp,itrc)- &
510 & t(i-1,jend+1,k,nstp,itrc)
512 grad(i,jend+1)=grad(i,jend+1)* &
513 &
grid(ng)%umask(i,jend+1)
518 dtdt=t(i,jend,k,nstp,itrc)-t(i,jend ,k,nout,itrc)
519 dtde=t(i,jend,k,nout,itrc)-t(i,jend-1,k,nout,itrc)
523 obc_out=
clima(ng)%Tnudgcof(i,jend+1,k,ic)
524 obc_in =
obcfac(ng)*obc_out
529 IF ((dtdt*dtde).lt.0.0_r8)
THEN
537 IF ((dtdt*dtde).lt.0.0_r8) dtdt=0.0_r8
538 IF ((dtdt*(grad(i ,jend)+ &
539 & grad(i+1,jend))).gt.0.0_r8)
THEN
544 cff=max(dtdx*dtdx+dtde*dtde,eps)
546 cx=min(cff,max(dtdt*dtdx,-cff))
551# if defined CELERITY_WRITE && defined FORWARD_WRITE
552 boundary(ng)%t_north_Cx(i,k,itrc)=cx
553 boundary(ng)%t_north_Ce(i,k,itrc)=ce
554 boundary(ng)%t_north_C2(i,k,itrc)=cff
556 t(i,jend+1,k,nout,itrc)=(cff*t(i,jend+1,k,nstp,itrc)+ &
557 & ce *t(i,jend ,k,nout,itrc)- &
561 & grad(i+1,jend+1))/ &
565 t(i,jend+1,k,nout,itrc)=t(i,jend+1,k,nout,itrc)+ &
569 & t(i,jend+1,k,nstp,itrc))
572 t(i,jend+1,k,nout,itrc)=t(i,jend+1,k,nout,itrc)* &
573 &
grid(ng)%rmask(i,jend+1)
585 t(i,jend+1,k,nout,itrc)=
boundary(ng)%t_north(i,k,itrc)
587 t(i,jend+1,k,nout,itrc)=t(i,jend+1,k,nout,itrc)* &
588 &
grid(ng)%rmask(i,jend+1)
600 t(i,jend+1,k,nout,itrc)=t(i,jend,k,nout,itrc)
602 t(i,jend+1,k,nout,itrc)=t(i,jend+1,k,nout,itrc)* &
603 &
grid(ng)%rmask(i,jend+1)
615 t(i,jend+1,k,nout,itrc)=t(i,jend,k,nout,itrc)
617 t(i,jend+1,k,nout,itrc)=t(i,jend+1,k,nout,itrc)* &
618 &
grid(ng)%rmask(i,jend+1)
631 IF (
domain(ng)%SouthWest_Corner(tile))
THEN
635 t(istr-1,jstr-1,k,nout,itrc)=0.5_r8* &
636 & (t(istr ,jstr-1,k,nout, &
638 & t(istr-1,jstr ,k,nout, &
643 IF (
domain(ng)%SouthEast_Corner(tile))
THEN
647 t(iend+1,jstr-1,k,nout,itrc)=0.5_r8* &
648 & (t(iend ,jstr-1,k,nout, &
650 & t(iend+1,jstr ,k,nout, &
655 IF (
domain(ng)%NorthWest_Corner(tile))
THEN
659 t(istr-1,jend+1,k,nout,itrc)=0.5_r8* &
660 & (t(istr-1,jend ,k,nout, &
662 & t(istr ,jend+1,k,nout, &
667 IF (
domain(ng)%NorthEast_Corner(tile))
THEN
671 t(iend+1,jend+1,k,nout,itrc)=0.5_r8* &
672 & (t(iend+1,jend ,k,nout, &
674 & t(iend ,jend+1,k,nout, &