80 & LBi, UBi, LBj, UBj, &
81 & IminS, ImaxS, JminS, JmaxS, &
86 & Huon, Hvom, Hz, pm, pn, W, &
104 integer,
intent(in) :: ng, tile
105 integer,
intent(in) :: LBi, UBi, LBj, UBj
106 integer,
intent(in) :: IminS, ImaxS, JminS, JmaxS
107 integer,
intent(in) :: nstp, nnew
111 real(r8),
intent(in) :: umask(LBi:,LBj:)
112 real(r8),
intent(in) :: vmask(LBi:,LBj:)
114 real(r8),
intent(in) :: Huon(LBi:,LBj:,:)
115 real(r8),
intent(in) :: Hvom(LBi:,LBj:,:)
116 real(r8),
intent(in) :: Hz(LBi:,LBj:,:)
117 real(r8),
intent(in) :: pm(LBi:,LBj:)
118 real(r8),
intent(in) :: pn(LBi:,LBj:)
119 real(r8),
intent(in) :: W(LBi:,LBj:,0:)
121 real(r8),
intent(in) :: W_stokes(LBi:,LBj:,0:)
123 real(r8),
intent(inout) :: gls(LBi:,LBj:,0:,:)
124 real(r8),
intent(inout) :: tke(LBi:,LBj:,0:,:)
127 real(r8),
intent(in) :: umask(LBi:UBi,LBj:UBj)
128 real(r8),
intent(in) :: vmask(LBi:UBi,LBj:UBj)
130 real(r8),
intent(in) :: Huon(LBi:UBi,LBj:UBj,N(ng))
131 real(r8),
intent(in) :: Hvom(LBi:UBi,LBj:UBj,N(ng))
132 real(r8),
intent(in) :: Hz(LBi:UBi,LBj:UBj,N(ng))
133 real(r8),
intent(in) :: pm(LBi:UBi,LBj:UBj)
134 real(r8),
intent(in) :: pn(LBi:UBi,LBj:UBj)
135 real(r8),
intent(in) :: W(LBi:UBi,LBj:UBj,0:N(ng))
137 real(r8),
intent(in) :: W_stokes(LBi:UBi,LBj:UBj,0:N(ng))
139 real(r8),
intent(inout) :: gls(LBi:UBi,LBj:UBj,0:N(ng),3)
140 real(r8),
intent(inout) :: tke(LBi:UBi,LBj:UBj,0:N(ng),3)
145 integer :: i, indx, j, k
147 real(r8),
parameter :: Gamma = 1.0_r8/6.0_r8
149 real(r8) :: cff, cff1, cff2, cff3, cff4
151 real(r8),
dimension(IminS:ImaxS,N(ng)) :: CF
152 real(r8),
dimension(IminS:ImaxS,N(ng)) :: FC
153 real(r8),
dimension(IminS:ImaxS,N(ng)) :: FCL
155 real(r8),
dimension(IminS:ImaxS,JminS:JmaxS,N(ng)) :: Hz_half
157 real(r8),
dimension(IminS:ImaxS,JminS:JmaxS) :: EF
158 real(r8),
dimension(IminS:ImaxS,JminS:JmaxS) :: FE
159 real(r8),
dimension(IminS:ImaxS,JminS:JmaxS) :: FEL
160 real(r8),
dimension(IminS:ImaxS,JminS:JmaxS) :: FX
161 real(r8),
dimension(IminS:ImaxS,JminS:JmaxS) :: FXL
162 real(r8),
dimension(IminS:ImaxS,JminS:JmaxS) :: XF
163 real(r8),
dimension(IminS:ImaxS,JminS:JmaxS) :: grad
164 real(r8),
dimension(IminS:ImaxS,JminS:JmaxS) :: gradL
166# include "set_bounds.h"
198 xf(i,j)=0.5_r8*(huon(i,j,k)+huon(i,j,k+1))
200 & 0.5_r8*(tke(i,j,k,nstp)+tke(i-1,j,k,nstp))
202 & 0.5_r8*(gls(i,j,k,nstp)+gls(i-1,j,k,nstp))
207 ef(i,j)=0.5*(hvom(i,j,k)+hvom(i,j,k+1))
209 & 0.5*(tke(i,j,k,nstp)+tke(i,j-1,k,nstp))
211 & 0.5*(gls(i,j,k,nstp)+gls(i,j-1,k,nstp))
220 grad(i,j)=(tke(i,j,k,nstp)-tke(i-1,j,k,nstp))
222 grad(i,j)=grad(i,j)*umask(i,j)
224 gradl(i,j)=(gls(i,j,k,nstp)-gls(i-1,j,k,nstp))
226 gradl(i,j)=gradl(i,j)*umask(i,j)
231 IF (
domain(ng)%Western_Edge(tile))
THEN
233 grad(istr-1,j)=grad(istr,j)
234 gradl(istr-1,j)=gradl(istr,j)
239 IF (
domain(ng)%Eastern_Edge(tile))
THEN
241 grad(iend+2,j)=grad(iend+1,j)
242 gradl(iend+2,j)=gradl(iend+1,j)
249 xf(i,j)=0.5_r8*(huon(i,j,k)+huon(i,j,k+1))
251 & 0.5_r8*(tke(i-1,j,k,nstp)+tke(i,j,k,nstp)- &
252 & cff*(grad(i+1,j)-grad(i-1,j)))
254 & 0.5_r8*(gls(i-1,j,k,nstp)+gls(i,j,k,nstp)- &
255 & cff*(gradl(i+1,j)-gradl(i-1,j)))
261 grad(i,j)=(tke(i,j,k,nstp)-tke(i,j-1,k,nstp))
263 grad(i,j)=grad(i,j)*vmask(i,j)
265 gradl(i,j)=(gls(i,j,k,nstp)-gls(i,j-1,k,nstp))
267 gradl(i,j)=gradl(i,j)*vmask(i,j)
272 IF (
domain(ng)%Southern_Edge(tile))
THEN
274 grad(i,jstr-1)=grad(i,jstr)
275 gradl(i,jstr-1)=gradl(i,jstr)
280 IF (
domain(ng)%Northern_Edge(tile))
THEN
282 grad(i,jend+2)=grad(i,jend+1)
283 gradl(i,jend+2)=gradl(i,jend+1)
290 ef(i,j)=0.5_r8*(hvom(i,j,k)+hvom(i,j,k+1))
292 & 0.5_r8*(tke(i,j-1,k,nstp)+tke(i,j,k,nstp)- &
293 & cff*(grad(i,j+1)-grad(i,j-1)))
295 & 0.5_r8*(gls(i,j-1,k,nstp)+gls(i,j,k,nstp)- &
296 & cff*(gradl(i,j+1)-gradl(i,j-1)))
311 cff3=(1.0_r8-gamma)*
dt(ng)
316 cff=0.5_r8*(hz(i,j,k)+hz(i,j,k+1))
317 cff4=cff3*pm(i,j)*pn(i,j)
318 hz_half(i,j,k)=cff-cff4*(xf(i+1,j)-xf(i,j)+ &
320 tke(i,j,k,3)=cff*(cff1*tke(i,j,k,nstp)+ &
321 & cff2*tke(i,j,k,indx))- &
322 & cff4*(fx(i+1,j)-fx(i,j)+ &
324 gls(i,j,k,3)=cff*(cff1*gls(i,j,k,nstp)+ &
325 & cff2*gls(i,j,k,indx))- &
326 & cff4*(fxl(i+1,j)-fxl(i,j)+ &
327 & fel(i,j+1)-fel(i,j))
328 tke(i,j,k,nnew)=cff*tke(i,j,k,nstp)
329 gls(i,j,k,nnew)=cff*gls(i,j,k,nstp)
340 cf(i,k)=0.5_r8*(w(i,j,k)+w(i,j,k-1))
342 cf(i,k)=cf(i,k)+0.5_r8*(w_stokes(i,j,k)+w_stokes(i,j,k-1))
345 & 0.5_r8*(tke(i,j,k-1,nstp)+tke(i,j,k,nstp))
347 & 0.5_r8*(gls(i,j,k-1,nstp)+gls(i,j,k,nstp))
355 cf(i,k)=0.5_r8*(w(i,j,k)+w(i,j,k-1))
357 cf(i,k)=cf(i,k)+0.5_r8*(w_stokes(i,j,k)+w_stokes(i,j,k-1))
359 fc(i,k)=cf(i,k)*(cff1*(tke(i,j,k-1,nstp)+ &
360 & tke(i,j,k ,nstp))- &
361 & cff2*(tke(i,j,k-2,nstp)+ &
362 & tke(i,j,k+1,nstp)))
363 fcl(i,k)=cf(i,k)*(cff1*(gls(i,j,k-1,nstp)+ &
364 & gls(i,j,k ,nstp))- &
365 & cff2*(gls(i,j,k-2,nstp)+ &
366 & gls(i,j,k+1,nstp)))
373 cf(i,1)=0.5*(w(i,j,0)+w(i,j,1))
375 cf(i,1)=cf(i,1)+0.5_r8*(w_stokes(i,j,0)+w_stokes(i,j,1))
377 fc(i,1)=cf(i,1)*(cff1*tke(i,j,0,nstp)+ &
378 & cff2*tke(i,j,1,nstp)- &
379 & cff3*tke(i,j,2,nstp))
380 fcl(i,1)=cf(i,1)*(cff1*gls(i,j,0,nstp)+ &
381 & cff2*gls(i,j,1,nstp)- &
382 & cff3*gls(i,j,2,nstp))
383 cf(i,n(ng))=0.5*(w(i,j,n(ng))+w(i,j,n(ng)-1))
385 cf(i,n(ng))=cf(i,n(ng))+0.5_r8* &
386 & (w_stokes(i,j,n(ng))+w_stokes(i,j,n(ng)-1))
388 fc(i,n(ng))=cf(i,n(ng))*(cff1*tke(i,j,n(ng) ,nstp)+ &
389 & cff2*tke(i,j,n(ng)-1,nstp)- &
390 & cff3*tke(i,j,n(ng)-2,nstp))
391 fcl(i,n(ng))=cf(i,n(ng))*(cff1*gls(i,j,n(ng) ,nstp)+ &
392 & cff2*gls(i,j,n(ng)-1,nstp)- &
393 & cff3*gls(i,j,n(ng)-2,nstp))
402 cff3=(1.0_r8-gamma)*
dt(ng)
406 cff4=cff3*pm(i,j)*pn(i,j)
407 hz_half(i,j,k)=hz_half(i,j,k)-cff4*(cf(i,k+1)-cf(i,k))
408 cff1=1.0_r8/hz_half(i,j,k)
409 tke(i,j,k,3)=cff1*(tke(i,j,k,3)- &
410 & cff4*(fc(i,k+1)-fc(i,k)))
411 gls(i,j,k,3)=cff1*(gls(i,j,k,3)- &
412 & cff4*(fcl(i,k+1)-fcl(i,k)))
420 & lbi, ubi, lbj, ubj, n(ng), &
421 & imins, imaxs, jmins, jmaxs, &
427 & lbi, ubi, lbj, ubj, 0, n(ng), &
430 & lbi, ubi, lbj, ubj, 0, n(ng), &
436 & lbi, ubi, lbj, ubj, 0, n(ng), &