99 & LBi, UBi, LBj, UBj, &
100 & IminS, ImaxS, JminS, JmaxS, &
108 & bustr, bvstr, sustr, svstr, &
117 & Akt, Akv, hsbl, ksbl)
133 integer,
intent(in) :: ng, tile
134 integer,
intent(in) :: LBi, UBi, LBj, UBj
135 integer,
intent(in) :: IminS, ImaxS, JminS, JmaxS
136 integer,
intent(in) :: nstp
140 real(r8),
intent(in) :: rmask(LBi:,LBj:)
142 real(r8),
intent(in) :: f(LBi:,LBj:)
143 real(r8),
intent(in) :: Hz(LBi:,LBj:,:)
144 real(r8),
intent(in) :: z_r(LBi:,LBj:,:)
145 real(r8),
intent(in) :: z_w(LBi:,LBj:,0:)
146 real(r8),
intent(in) :: u(LBi:,LBj:,:,:)
147 real(r8),
intent(in) :: v(LBi:,LBj:,:,:)
148 real(r8),
intent(in) :: pden(LBi:,LBj:,:)
149 real(r8),
intent(in) :: srflx(LBi:,LBj:)
150 real(r8),
intent(in) :: stflx(LBi:,LBj:,:)
151 real(r8),
intent(in) :: alpha(LBi:,LBj:)
153 real(r8),
intent(in) :: beta(LBi:,LBj:)
155 real(r8),
intent(in) :: bustr(LBi:,LBj:)
156 real(r8),
intent(in) :: bvstr(LBi:,LBj:)
157 real(r8),
intent(in) :: sustr(LBi:,LBj:)
158 real(r8),
intent(in) :: svstr(LBi:,LBj:)
159 real(r8),
intent(in) :: bvf(LBi:,LBj:,0:)
160 real(r8),
intent(inout) :: Akt(LBi:,LBj:,0:,:)
161 real(r8),
intent(inout) :: Akv(LBi:,LBj:,0:)
162 real(r8),
intent(inout) :: hsbl(LBi:,LBj:)
163 integer,
intent(out) :: ksbl(LBi:,LBj:)
165 real(r8),
intent(out) :: ghats(LBi:,LBj:,0:,:)
169 real(r8),
intent(in) :: rmask(LBi:UBi,LBj:UBj)
171 real(r8),
intent(in) :: f(LBi:UBi,LBj:UBj)
172 real(r8),
intent(in) :: Hz(LBi:UBi,LBj:UBj,N(ng))
173 real(r8),
intent(in) :: z_r(LBi:UBi,LBj:UBj,N(ng))
174 real(r8),
intent(in) :: z_w(LBi:UBi,LBj:UBj,0:N(ng))
175 real(r8),
intent(in) :: u(LBi:UBi,LBj:UBj,N(ng),3)
176 real(r8),
intent(in) :: v(LBi:UBi,LBj:UBj,N(ng),3)
177 real(r8),
intent(in) :: pden(LBi:UBi,LBj:UBj,N(ng))
178 real(r8),
intent(in) :: srflx(LBi:UBi,LBj:UBj)
179 real(r8),
intent(in) :: stflx(LBi:UBi,LBj:UBj,NT(ng))
180 real(r8),
intent(in) :: alpha(LBi:UBi,LBj:UBj)
182 real(r8),
intent(in) :: beta(LBi:UBi,LBj:UBj)
184 real(r8),
intent(in) :: bustr(LBi:UBi,LBj:UBj)
185 real(r8),
intent(in) :: bvstr(LBi:UBi,LBj:UBj)
186 real(r8),
intent(in) :: sustr(LBi:UBi,LBj:UBj)
187 real(r8),
intent(in) :: svstr(LBi:UBi,LBj:UBj)
188 real(r8),
intent(in) :: bvf(LBi:UBi,LBj:UBj,0:N(ng))
189 real(r8),
intent(inout) :: Akt(LBi:UBi,LBj:UBj,0:N(ng),NAT)
190 real(r8),
intent(inout) :: Akv(LBi:UBi,LBj:UBj,0:N(ng))
191 real(r8),
intent(inout) :: hsbl(LBi:UBi,LBj:UBj)
192 integer,
intent(out) :: ksbl(LBi:UBi,LBj:UBj)
194 real(r8),
intent(out) :: ghats(LBi:UBi,LBj:UBj,0:N(ng),NAT)
200 integer :: i, itrc, j, k
202 real(r8),
parameter :: eps = 1.0e-10_r8
203 real(r8),
parameter :: r3 = 1.0_r8/3.0_r8
204 real(r8),
parameter :: small = 1.0e-20_r8
206 real(r8) :: Gm, Gt, Gs, K_bl, Ribot, Ritop, Rk
207 real(r8) :: Uk, Ustarb, Ustar3, Vk, Vtc
208 real(r8) :: a1, a2, a3, cff, cff1, cff2,cff_up, cff_dn
209 real(r8) :: depth, dK_bl, hekman, hmonob, sigma, zbl
210 real(r8) :: zetahat, zetapar
212 real(r8) :: slope_up, a_co, b_co, c_co, z_up, sqrt_arg
215 real(r8),
dimension (IminS:ImaxS) :: Rref
216 real(r8),
dimension (IminS:ImaxS) :: Uref
217 real(r8),
dimension (IminS:ImaxS) :: Vref
219 real(r8),
dimension (IminS:ImaxS,JminS:JmaxS,0:N(ng)) :: Bflux
221 real(r8),
dimension (IminS:ImaxS,0:N(ng)) :: FC
222 real(r8),
dimension (IminS:ImaxS,0:N(ng)) :: dR
223 real(r8),
dimension (IminS:ImaxS,0:N(ng)) :: dU
224 real(r8),
dimension (IminS:ImaxS,0:N(ng)) :: dV
226 real(r8),
dimension (IminS:ImaxS,JminS:JmaxS) :: Bo
227 real(r8),
dimension (IminS:ImaxS,JminS:JmaxS) :: Bosol
228 real(r8),
dimension (IminS:ImaxS,JminS:JmaxS) :: Bfsfc
229 real(r8),
dimension (IminS:ImaxS,JminS:JmaxS) :: Gm1
230 real(r8),
dimension (IminS:ImaxS,JminS:JmaxS) :: Gt1
231 real(r8),
dimension (IminS:ImaxS,JminS:JmaxS) :: Gs1
232 real(r8),
dimension (IminS:ImaxS,JminS:JmaxS) :: Ustar
233 real(r8),
dimension (IminS:ImaxS,JminS:JmaxS) :: dGm1dS
234 real(r8),
dimension (IminS:ImaxS,JminS:JmaxS) :: dGt1dS
235 real(r8),
dimension (IminS:ImaxS,JminS:JmaxS) :: dGs1dS
236 real(r8),
dimension (IminS:ImaxS,JminS:JmaxS) :: f1
237 real(r8),
dimension (IminS:ImaxS,JminS:JmaxS) :: sl_dpth
238 real(r8),
dimension (IminS:ImaxS,JminS:JmaxS) :: swdk
239 real(r8),
dimension (IminS:ImaxS,JminS:JmaxS) :: wm
240 real(r8),
dimension (IminS:ImaxS,JminS:JmaxS) :: ws
241 real(r8),
dimension (IminS:ImaxS,JminS:JmaxS) :: zgrid
243# include "set_bounds.h"
259 sl_dpth(i,j)=
lmd_epsilon*(z_w(i,j,n(ng))-hsbl(i,j))
270 ustar(i,j)=sqrt(sqrt((0.5_r8*(sustr(i,j)+sustr(i+1,j)))**2+ &
271 & (0.5_r8*(svstr(i,j)+svstr(i,j+1)))**2))
273 ustar(i,j)=ustar(i,j)*rmask(i,j)
288 bo(i,j)=
g*(alpha(i,j)*(stflx(i,j,
itemp)-srflx(i,j))- &
289 & beta(i,j)*stflx(i,j,
isalt))
291 bo(i,j)=
g*alpha(i,j)*(stflx(i,j,
itemp)-srflx(i,j))
293 bosol(i,j)=
g*alpha(i,j)*srflx(i,j)
306 zgrid(i,j)=z_w(i,j,n(ng))-z_w(i,j,k)
310 & lbi, ubi, lbj, ubj, &
311 & imins, imaxs, jmins, jmaxs, &
312 & -1.0_r8, zgrid, swdk)
315 bflux(i,j,k)=(bo(i,j)+bosol(i,j)*(1.0_r8-swdk(i,j)))
317 bflux(i,j,k)=bflux(i,j,k)*rmask(i,j)
320 cff=1.0_r8-(0.5_r8+sign(0.5_r8,bflux(i,j,k)))
321 ghats(i,j,k,
itemp)=-cff*(stflx(i,j,
itemp)-srflx(i,j)+ &
322 & srflx(i,j)*(1.0_r8-swdk(i,j)))
350 cff=1.0_r8/(2.0_r8*hz(i,j,k+1)+ &
351 & hz(i,j,k)*(2.0_r8-fc(i,k-1)))
352 fc(i,k)=cff*hz(i,j,k+1)
353 dr(i,k)=cff*(6.0_r8*(pden(i,j,k+1)-pden(i,j,k))- &
354 & hz(i,j,k)*dr(i,k-1))
355 du(i,k)=cff*(3.0_r8*(u(i ,j,k+1,nstp)-u(i, j,k,nstp)+ &
356 & u(i+1,j,k+1,nstp)-u(i+1,j,k,nstp))- &
357 & hz(i,j,k)*du(i,k-1))
358 dv(i,k)=cff*(3.0_r8*(v(i,j ,k+1,nstp)-v(i,j ,k,nstp)+ &
359 & v(i,j+1,k+1,nstp)-v(i,j+1,k,nstp))- &
360 & hz(i,j,k)*dv(i,k-1))
370 dr(i,k)=dr(i,k)-fc(i,k)*dr(i,k+1)
371 du(i,k)=du(i,k)-fc(i,k)*du(i,k+1)
372 dv(i,k)=dv(i,k)-fc(i,k)*dv(i,k+1)
382 cff=1.0_r8/(z_r(i,j,k+1)-z_r(i,j,k))
383 dr(i,k)=cff*(pden(i,j,k+1)-pden(i,j,k))
385 du(i,k)=cff*(u(i ,j,k+1,nstp)-u(i, j,k,nstp)+ &
386 & u(i+1,j,k+1,nstp)-u(i+1,j,k,nstp))
387 dv(i,k)=cff*(v(i,j ,k+1,nstp)-v(i,j ,k,nstp)+ &
388 & v(i,j+1,k+1,nstp)-v(i,j+1,k,nstp))
434 rref(i)=pden(i,j,n(ng))+ &
435 & hz(i,j,n(ng))*(cff1*dr(i,n(ng))+cff2*dr(i,n(ng)-1))
436 uref(i)=0.5_r8*(u(i,j,n(ng),nstp)+u(i+1,j,n(ng),nstp))+ &
437 & hz(i,j,n(ng))*(cff1*du(i,n(ng))+cff2*du(i,n(ng)-1))
438 vref(i)=0.5_r8*(v(i,j,n(ng),nstp)+v(i,j+1,n(ng),nstp))+ &
439 & hz(i,j,n(ng))*(cff1*dv(i,n(ng))+cff2*dv(i,n(ng)-1))
448 depth=z_w(i,j,n(ng))-z_w(i,j,k-1)
449 IF (bflux(i,j,k-1).lt.0.0_r8)
THEN
450 sigma=min(sl_dpth(i,j),depth)
454 ustar3=ustar(i,j)*ustar(i,j)*ustar(i,j)
455 zetahat=
vonkar*sigma*bflux(i,j,k-1)
456 zetapar=zetahat/(ustar3+small)
457 IF (zetahat.ge.0.0_r8)
THEN
458 wm(i,j)=
vonkar*ustar(i,j)/(1.0_r8+5.0_r8*zetapar)
462 wm(i,j)=
vonkar*ustar(i,j)* &
463 & (1.0_r8-16.0_r8*zetapar)**0.25_r8
468 ws(i,j)=
vonkar*ustar(i,j)* &
469 & (1.0_r8-16.0_r8*zetapar)**0.5_r8
476 & hz(i,j,k)*(cff1*dr(i,k-1)+cff2*dr(i,k))
477 uk=0.5_r8*(u(i,j,k,nstp)+u(i+1,j,k,nstp))- &
478 & hz(i,j,k)*(cff1*du(i,k-1)+cff2*du(i,k))
479 vk=0.5_r8*(v(i,j,k,nstp)+v(i,j+1,k,nstp))- &
480 & hz(i,j,k)*(cff1*dv(i,k-1)+cff2*dv(i,k))
482 ritop=-
gorho0*(rref(i)-rk)*depth
483 ribot=(uref(i)-uk)**2+(vref(i)-vk)**2+ &
484 & vtc*depth*ws(i,j)*sqrt(abs(bvf(i,j,k-1)))
488 fc(i,k-1)=ritop/(ribot+eps)
502 IF ((ksbl(i,j).eq.1).and.(fc(i,k-1).gt.0.0_r8))
THEN
503 hsbl(i,j)=(z_w(i,j,k)*fc(i,k-1)-z_w(i,j,k-1)*fc(i,k))/ &
504 & (fc(i,k-1)-fc(i,k))
517 IF ((ksbl(i,j).eq.1).and.(fc(i,k-1).ge.
lmd_ric))
THEN
522 slope_up=(fc(i,k+1)-fc(i,k))/(z_up-z_w(i,j,k+1))
524 a_co=(fc(i,k-1)-fc(i,k)+slope_up*(z_w(i,j,k-1)-z_up))/ &
525 & (z_up-z_w(i,j,k-1))**2
526 b_co=slope_up+2.0_r8*a_co*z_up
527 c_co=fc(i,k)+z_up*(a_co*z_up+slope_up)-
lmd_ric
528 sqrt_arg=b_co*b_co-4.0_r8*a_co*c_co
529 IF (((abs(b_co).gt.eps).and.(abs(a_co/b_co).le.eps)).or. &
530 & (sqrt_arg.le.0.0_r8))
THEN
531 hsbl(i,j)=-z_up+(z_up-z_w(i,j,k-1))* &
532 & (
lmd_ric-fc(i,k))/(fc(i,k-1)-fc(i,k))
534 hsbl(i,j)=(-b_co+sqrt(sqrt_arg))/(2.0_r8*a_co)
543 IF ((ksbl(i,j).eq.1).and.((fc(i,k ).lt.
lmd_ric).and. &
544 & (fc(i,k-1).ge.
lmd_ric)))
THEN
545 hsbl(i,j)=((fc(i,k-1)-
lmd_ric)*z_w(i,j,k )+ &
546 & (
lmd_ric-fc(i,k ))*z_w(i,j,k-1))/ &
547 & (fc(i,k-1)-fc(i,k))
561 zgrid(i,j)=z_w(i,j,n(ng))-hsbl(i,j)
563 zgrid(i,j)=zgrid(i,j)*rmask(i,j)
568 & lbi, ubi, lbj, ubj, &
569 & imins, imaxs, jmins, jmaxs, &
570 & -1.0_r8, zgrid, swdk)
573 bfsfc(i,j)=(bo(i,j)+bosol(i,j)*(1.0_r8-swdk(i,j)))
575 bfsfc(i,j)=bfsfc(i,j)*rmask(i,j)
586 IF ((ustar(i,j).gt.0.0_r8).and.(bfsfc(i,j).gt.0.0_r8))
THEN
587 hekman=
lmd_cekman*ustar(i,j)/max(abs(f(i,j)),eps)
588 hmonob=
lmd_cmonob*ustar(i,j)*ustar(i,j)*ustar(i,j)/ &
589 & max(
vonkar*bfsfc(i,j),eps)
590 hsbl(i,j)=(z_w(i,j,n(ng))- &
591 & min(hekman,hmonob,z_w(i,j,n(ng))-hsbl(i,j)))
593 hsbl(i,j)=min(hsbl(i,j),z_w(i,j,n(ng)))
594 hsbl(i,j)=max(hsbl(i,j),z_w(i,j,0))
596 hsbl(i,j)=hsbl(i,j)*rmask(i,j)
605 & lbi, ubi, lbj, ubj, &
609 & lbi, ubi, lbj, ubj, &
618 & lbi, ubi, lbj, ubj, &
619 & imins, imaxs, jmins, jmaxs, &
627 hsbl(i,j)=min(hsbl(i,j),z_w(i,j,n(ng)))
628 hsbl(i,j)=max(hsbl(i,j),z_w(i,j,0))
630 hsbl(i,j)=hsbl(i,j)*rmask(i,j)
639 & lbi, ubi, lbj, ubj, &
643 & lbi, ubi, lbj, ubj, &
655 IF ((ksbl(i,j).eq.1).and.(z_w(i,j,k-1).lt.hsbl(i,j)))
THEN
668 zgrid(i,j)=z_w(i,j,n(ng))-hsbl(i,j)
670 zgrid(i,j)=zgrid(i,j)*rmask(i,j)
675 & lbi, ubi, lbj, ubj, &
676 & imins, imaxs, jmins, jmaxs, &
677 & -1.0_r8, zgrid, swdk)
680 bfsfc(i,j)=(bo(i,j)+bosol(i,j)*(1.0_r8-swdk(i,j)))
682 bfsfc(i,j)=bfsfc(i,j)*rmask(i,j)
696 sl_dpth(i,j)=
lmd_epsilon*(z_w(i,j,n(ng))-hsbl(i,j))
697 IF (bfsfc(i,j).gt.0.0_r8)
THEN
702 sigma=cff*(z_w(i,j,n(ng))-hsbl(i,j))
703 ustar3=ustar(i,j)*ustar(i,j)*ustar(i,j)
704 zetahat=
vonkar*sigma*bfsfc(i,j)
705 zetapar=zetahat/(ustar3+small)
706 IF (zetahat.ge.0.0_r8)
THEN
707 wm(i,j)=
vonkar*ustar(i,j)/(1.0_r8+5.0_r8*zetapar)
711 wm(i,j)=
vonkar*ustar(i,j)* &
712 & (1.0_r8-16.0_r8*zetapar)**0.25_r8
717 ws(i,j)=
vonkar*ustar(i,j)* &
718 & (1.0_r8-16.0_r8*zetapar)**0.5_r8
734 f1(i,j)=5.0_r8*max(0.0_r8,bfsfc(i,j))*
vonkar/ &
735 & (ustar(i,j)*ustar(i,j)*ustar(i,j)*ustar(i,j)+eps)
741 zbl=z_w(i,j,n(ng))-hsbl(i,j)
742 IF (hsbl(i,j).gt.z_w(i,j,1))
THEN
744 cff=1.0_r8/(z_w(i,j,k)-z_w(i,j,k-1))
745 cff_dn=cff*(hsbl(i,j)-z_w(i,j,k-1))
746 cff_up=cff*(z_w(i,j,k)-hsbl(i,j))
751 k_bl=cff_dn*akv(i,j,k)+cff_up*akv(i,j,k-1)
752 dk_bl=cff*(akv(i,j,k)-akv(i,j,k-1))
753 gm1(i,j)=k_bl/(zbl*wm(i,j)+eps)
755 gm1(i,j)=gm1(i,j)*rmask(i,j)
757 dgm1ds(i,j)=min(0.0_r8,-dk_bl/(wm(i,j)+eps)-k_bl*f1(i,j))
762 k_bl=cff_dn*akt(i,j,k,
itemp)+cff_up*akt(i,j,k-1,
itemp)
763 dk_bl=cff*(akt(i,j,k,
itemp)-akt(i,j,k-1,
itemp))
764 gt1(i,j)=k_bl/(zbl*ws(i,j)+eps)
766 gt1(i,j)=gt1(i,j)*rmask(i,j)
768 dgt1ds(i,j)=min(0.0_r8,-dk_bl/(ws(i,j)+eps)-k_bl*f1(i,j))
774 k_bl=cff_dn*akt(i,j,k,
isalt)+cff_up*akt(i,j,k-1,
isalt)
775 dk_bl=cff*(akt(i,j,k,
isalt)-akt(i,j,k-1,
isalt))
776 gs1(i,j)=k_bl/(zbl*ws(i,j)+eps)
778 gs1(i,j)=gs1(i,j)*rmask(i,j)
780 dgs1ds(i,j)=min(0.0_r8,-dk_bl/(ws(i,j)+eps)-k_bl*f1(i,j))
791 ustarb=sqrt(sqrt((0.5_r8*(bustr(i,j)+bustr(i+1,j)))**2+ &
792 & (0.5_r8*(bvstr(i,j)+bvstr(i,j+1)))**2))
794 ustarb=ustarb*rmask(i,j)
797 k_bl=dk_bl*(hsbl(i,j)-z_w(i,j,0))
798 gm1(i,j)=k_bl/(zbl*wm(i,j)+eps)
800 gm1(i,j)=gm1(i,j)*rmask(i,j)
802 dgm1ds(i,j)=min(0.0_r8,-dk_bl/(wm(i,j)+eps)-k_bl*f1(i,j))
807 gt1(i,j)=k_bl/(zbl*ws(i,j)+eps)
809 gt1(i,j)=gt1(i,j)*rmask(i,j)
811 dgt1ds(i,j)=min(0.0_r8,-dk_bl/(ws(i,j)+eps)-k_bl*f1(i,j))
818 dgs1ds(i,j)=dgt1ds(i,j)
831 zbl=z_w(i,j,n(ng))-hsbl(i,j)
832 IF (k.gt.ksbl(i,j))
THEN
836 depth=z_w(i,j,n(ng))-z_w(i,j,k)
837 IF (bflux(i,j,k).lt.0.0_r8)
THEN
838 sigma=min(sl_dpth(i,j),depth)
842 ustar3=ustar(i,j)*ustar(i,j)*ustar(i,j)
843 zetahat=
vonkar*sigma*bflux(i,j,k)
844 zetapar=zetahat/(ustar3+small)
845 IF (zetahat.ge.0.0_r8)
THEN
846 wm(i,j)=
vonkar*ustar(i,j)/(1.0_r8+5.0_r8*zetapar)
850 wm(i,j)=
vonkar*ustar(i,j)* &
851 & (1.0_r8-16.0_r8*zetapar)**0.25_r8
856 ws(i,j)=
vonkar*ustar(i,j)* &
857 & (1.0_r8-16.0_r8*zetapar)**0.5_r8
865 sigma=depth/(zbl+eps)
867 sigma=sigma*rmask(i,j)
870 a2=3.0_r8-2.0_r8*sigma
875 gm=a1+a2*gm1(i,j)+a3*dgm1ds(i,j)
876 gt=a1+a2*gt1(i,j)+a3*dgt1ds(i,j)
878 gs=a1+a2*gs1(i,j)+a3*dgs1ds(i,j)
886 & depth*wm(i,j)*(1.0_r8+sigma*gm))
888 & depth*ws(i,j)*(1.0_r8+sigma*gt))
891 & depth*ws(i,j)*(1.0_r8+sigma*gs))
894 akv(i,j,k)=depth*wm(i,j)*(1.0_r8+sigma*gm)
895 akt(i,j,k,
itemp)=depth*ws(i,j)*(1.0_r8+sigma*gt)
897 akt(i,j,k,
isalt)=depth*ws(i,j)*(1.0_r8+sigma*gs)
904 cff=
lmd_cg*(1.0_r8-(0.5_r8+sign(0.5_r8,bflux(i,j,k))))/ &
917 ghats(i,j,k,
itemp)=0.0_r8
919 ghats(i,j,k,
isalt)=0.0_r8