96 & LBi, UBi, LBj, UBj, &
97 & IminS, ImaxS, JminS, JmaxS, &
102 & f, h, Hz, z_r, z_w, &
104 & srflx, btflx, bustr, bvstr, &
110 & ksbl, Akt, Akv, kbbl, hbbl)
126 integer,
intent(in) :: ng, tile
127 integer,
intent(in) :: LBi, UBi, LBj, UBj
128 integer,
intent(in) :: IminS, ImaxS, JminS, JmaxS
129 integer,
Intent(in) :: nstp
133 real(r8),
intent(in) :: rmask(LBi:,LBj:)
135 real(r8),
intent(in) :: f(LBi:,LBj:)
136 real(r8),
intent(in) :: h(LBi:,LBj:)
137 real(r8),
intent(in) :: Hz(LBi:,LBj:,:)
138 real(r8),
intent(in) :: z_r(LBi:,LBj:,:)
139 real(r8),
intent(in) :: z_w(LBi:,LBj:,0:)
140 real(r8),
intent(in) :: u(LBi:,LBj:,:,:)
141 real(r8),
intent(in) :: v(LBi:,LBj:,:,:)
142 real(r8),
intent(in) :: pden(LBi:,LBj:,:)
143 real(r8),
intent(in) :: srflx(LBi:,LBj:)
144 real(r8),
intent(in) :: btflx(LBi:,LBj:,:)
145 real(r8),
intent(in) :: bustr(LBi:,LBj:)
146 real(r8),
intent(in) :: bvstr(LBi:,LBj:)
147 real(r8),
intent(in) :: alpha(LBi:,LBj:)
149 real(r8),
intent(in) :: beta(LBi:,LBj:)
151 real(r8),
intent(in) :: bvf(LBi:,LBj:,0:)
152 integer,
intent(in) :: ksbl(LBi:,LBj:)
153 real(r8),
intent(inout) :: Akt(LBi:,LBj:,0:,:)
154 real(r8),
intent(inout) :: Akv(LBi:,LBj:,0:)
155 real(r8),
intent(inout) :: hbbl(LBi:,LBj:)
156 integer,
intent(out) :: kbbl(LBi:,LBj:)
159 real(r8),
intent(in) :: rmask(LBi:UBi,LBj:UBj)
161 real(r8),
intent(in) :: f(LBi:UBi,LBj:UBj)
162 real(r8),
intent(in) :: h(LBi:UBi,LBj:UBj)
163 real(r8),
intent(in) :: Hz(LBi:UBi,LBj:UBj,N(ng))
164 real(r8),
intent(in) :: z_r(LBi:UBi,LBj:UBj,N(ng))
165 real(r8),
intent(in) :: z_w(LBi:UBi,LBj:UBj,0:N(ng))
166 real(r8),
intent(in) :: u(LBi:UBi,LBj:UBj,N(ng),3)
167 real(r8),
intent(in) :: v(LBi:UBi,LBj:UBj,N(ng),3)
168 real(r8),
intent(in) :: pden(LBi:UBi,LBj:UBj,N(ng))
169 real(r8),
intent(in) :: srflx(LBi:UBi,LBj:UBj)
170 real(r8),
intent(in) :: btflx(LBi:UBi,LBj:UBj,NT(ng))
171 real(r8),
intent(in) :: bustr(LBi:UBi,LBj:UBj)
172 real(r8),
intent(in) :: bvstr(LBi:UBi,LBj:UBj)
173 real(r8),
intent(in) :: alpha(LBi:UBi,LBj:UBj)
175 real(r8),
intent(in) :: beta(LBi:UBi,LBj:UBj)
177 real(r8),
intent(in) :: bvf(LBi:UBi,LBj:UBj,0:N(ng))
178 integer,
intent(in) :: ksbl(LBi:UBi,LBj:UBj)
179 real(r8),
intent(inout) :: Akt(LBi:UBi,LBj:UBj,0:N(ng),NAT)
180 real(r8),
intent(inout) :: Akv(LBi:UBi,LBj:UBj,0:N(ng))
181 real(r8),
intent(inout) :: hbbl(LBi:UBi,LBj:UBj)
182 integer,
intent(out) :: kbbl(LBi:UBi,LBj:UBj)
187 integer :: i, itrc, j, k
189 real(r8),
parameter :: eps = 1.0e-10_r8
190 real(r8),
parameter :: r3 = 1.0_r8/3.0_r8
191 real(r8),
parameter :: small = 1.0e-20_r8
193 real(r8) :: Gm, Gt, Gs, K_bl, Ribot, Ritop, Rk
194 real(r8) :: Uk, Ustar3, Vk, Vtc
195 real(r8) :: a1, a2, a3, cff, cff1, cff2, cff_up, cff_dn
196 real(r8) :: depth, dK_bl, hekman, sigma, zbl
197 real(r8) :: zetahat, zetapar
199 real(r8),
dimension (IminS:ImaxS) :: Rref
200 real(r8),
dimension (IminS:ImaxS) :: Uref
201 real(r8),
dimension (IminS:ImaxS) :: Vref
203 real(r8),
dimension (IminS:ImaxS,JminS:JmaxS,0:N(ng)) :: Bflux
205 real(r8),
dimension (IminS:ImaxS,0:N(ng)) :: FC
206 real(r8),
dimension (IminS:ImaxS,0:N(ng)) :: dR
207 real(r8),
dimension (IminS:ImaxS,0:N(ng)) :: dU
208 real(r8),
dimension (IminS:ImaxS,0:N(ng)) :: dV
210 real(r8),
dimension (IminS:ImaxS,JminS:JmaxS) :: Bo
211 real(r8),
dimension (IminS:ImaxS,JminS:JmaxS) :: Bosol
212 real(r8),
dimension (IminS:ImaxS,JminS:JmaxS) :: Bfbot
213 real(r8),
dimension (IminS:ImaxS,JminS:JmaxS) :: Gm1
214 real(r8),
dimension (IminS:ImaxS,JminS:JmaxS) :: Gt1
215 real(r8),
dimension (IminS:ImaxS,JminS:JmaxS) :: Gs1
216 real(r8),
dimension (IminS:ImaxS,JminS:JmaxS) :: Ustar
217 real(r8),
dimension (IminS:ImaxS,JminS:JmaxS) :: bl_dpth
218 real(r8),
dimension (IminS:ImaxS,JminS:JmaxS) :: dGm1dS
219 real(r8),
dimension (IminS:ImaxS,JminS:JmaxS) :: dGt1dS
220 real(r8),
dimension (IminS:ImaxS,JminS:JmaxS) :: dGs1dS
221 real(r8),
dimension (IminS:ImaxS,JminS:JmaxS) :: f1
222 real(r8),
dimension (IminS:ImaxS,JminS:JmaxS) :: swdk
223 real(r8),
dimension (IminS:ImaxS,JminS:JmaxS) :: wm
224 real(r8),
dimension (IminS:ImaxS,JminS:JmaxS) :: ws
225 real(r8),
dimension (IminS:ImaxS,JminS:JmaxS) :: zgrid
227# include "set_bounds.h"
254 ustar(i,j)=sqrt(sqrt((0.5_r8*(bustr(i,j)+bustr(i+1,j)))**2+ &
255 & (0.5_r8*(bvstr(i,j)+bvstr(i,j+1)))**2))
257 ustar(i,j)=ustar(i,j)*rmask(i,j)
272 bo(i,j)=
g*(alpha(i,j)*btflx(i,j,
itemp)- &
273 & beta(i,j)*btflx(i,j,
isalt))
275 bo(i,j)=
g*alpha(i,j)*btflx(i,j,
itemp)
277 bosol(i,j)=
g*alpha(i,j)*srflx(i,j)
288 zgrid(i,j)=z_w(i,j,n(ng))-z_w(i,j,k)
292 & lbi, ubi, lbj, ubj, &
293 & imins, imaxs, jmins, jmaxs, &
294 & -1.0_r8, zgrid, swdk)
297 bflux(i,j,k)=(bo(i,j)+bosol(i,j)*(1.0_r8-swdk(i,j)))
299 bflux(i,j,k)=bflux(i,j,k)*rmask(i,j)
324 cff=1.0_r8/(2.0_r8*hz(i,j,k+1)+ &
325 & hz(i,j,k)*(2.0_r8-fc(i,k-1)))
326 fc(i,k)=cff*hz(i,j,k+1)
327 dr(i,k)=cff*(6.0_r8*(pden(i,j,k+1)-pden(i,j,k))- &
328 & hz(i,j,k)*dr(i,k-1))
329 du(i,k)=cff*(3.0_r8*(u(i ,j,k+1,nstp)-u(i, j,k,nstp)+ &
330 & u(i+1,j,k+1,nstp)-u(i+1,j,k,nstp))- &
331 & hz(i,j,k)*du(i,k-1))
332 dv(i,k)=cff*(3.0_r8*(v(i,j ,k+1,nstp)-v(i,j ,k,nstp)+ &
333 & v(i,j+1,k+1,nstp)-v(i,j+1,k,nstp))- &
334 & hz(i,j,k)*dv(i,k-1))
344 dr(i,k)=dr(i,k)-fc(i,k)*dr(i,k+1)
345 du(i,k)=du(i,k)-fc(i,k)*du(i,k+1)
346 dv(i,k)=dv(i,k)-fc(i,k)*dv(i,k+1)
356 cff=1.0_r8/(z_r(i,j,k+1)-z_r(i,j,k))
357 dr(i,k)=cff*(pden(i,j,k+1)-pden(i,j,k))
359 du(i,k)=cff*(u(i ,j,k+1,nstp)-u(i, j,k,nstp)+ &
360 & u(i+1,j,k+1,nstp)-u(i+1,j,k,nstp))
361 dv(i,k)=cff*(v(i,j ,k+1,nstp)-v(i,j ,k,nstp)+ &
362 & v(i,j+1,k+1,nstp)-v(i,j+1,k,nstp))
408 rref(i)=pden(i,j,1)- &
409 & hz(i,j,1)*(cff1*dr(i,0)+cff2*dr(i,1))
410 uref(i)=0.5_r8*(u(i,j,1,nstp)+u(i+1,j,1,nstp))- &
411 & hz(i,j,1)*(cff1*du(i,0)+cff2*du(i,1))
412 vref(i)=0.5_r8*(v(i,j,1,nstp)+v(i,j+1,1,nstp))- &
413 & hz(i,j,1)*(cff1*dv(i,0)+cff2*dv(i,1))
422 depth=z_w(i,j,k)-z_w(i,j,0)
423 IF (bflux(i,j,k).lt.0.0_r8)
THEN
424 sigma=min(bl_dpth(i,j),depth)
428 ustar3=ustar(i,j)*ustar(i,j)*ustar(i,j)
429 zetahat=
vonkar*sigma*bflux(i,j,k)
430 zetapar=zetahat/(ustar3+small)
431 IF (zetahat.ge.0.0_r8)
THEN
432 wm(i,j)=
vonkar*ustar(i,j)/(1.0_r8+5.0_r8*zetapar)
436 wm(i,j)=
vonkar*ustar(i,j)* &
437 & (1.0_r8-16.0_r8*zetapar)**0.25_r8
442 ws(i,j)=
vonkar*ustar(i,j)* &
443 & (1.0_r8-16.0_r8*zetapar)**0.5_r8
450 & hz(i,j,k)*(cff1*dr(i,k)+cff2*dr(i,k-1))
451 uk=0.5_r8*(u(i,j,k,nstp)+u(i+1,j,k,nstp))+ &
452 & hz(i,j,k)*(cff1*du(i,k)+cff2*du(i,k-1))
453 vk=0.5_r8*(v(i,j,k,nstp)+v(i,j+1,k,nstp))+ &
454 & hz(i,j,k)*(cff1*dv(i,k)+cff2*dv(i,k-1))
456 ritop=-
gorho0*(rk-rref(i))*depth
457 ribot=(uk-uref(i))**2+(vk-vref(i))**2+ &
458 & vtc*depth*ws(i,j)*sqrt(abs(bvf(i,j,k)))
462 fc(i,k)=ritop/(ribot+eps)
471 hbbl(i,j)=z_w(i,j,n(ng))
476 IF ((kbbl(i,j).eq.n(ng)).and.(fc(i,k).gt.0.0_r8))
THEN
477 hbbl(i,j)=(z_w(i,j,k)*fc(i,k-1)-z_w(i,j,k-1)*fc(i,k))/ &
478 & (fc(i,k-1)-fc(i,k))
486 IF ((kbbl(i,j).eq.n(ng)).and.((fc(i,k-1).lt.
lmd_ric).and. &
488 hbbl(i,j)=((
lmd_ric-fc(i,k-1))*z_w(i,j,k )+ &
489 & (fc(i,k )-
lmd_ric)*z_w(i,j,k-1))/ &
490 & (fc(i,k)-fc(i,k-1))
503 zgrid(i,j)=z_w(i,j,n(ng))-hbbl(i,j)
505 zgrid(i,j)=zgrid(i,j)*rmask(i,j)
510 & lbi, ubi, lbj, ubj, &
511 & imins, imaxs, jmins, jmaxs, &
512 & -1.0_r8, zgrid, swdk)
515 bfbot(i,j)=(bo(i,j)+bosol(i,j)*(1.0_r8-swdk(i,j)))
517 bfbot(i,j)=bfbot(i,j)*rmask(i,j)
528 IF (ustar(i,j).ge.0.0_r8)
THEN
529 hekman=
lmd_cekman*ustar(i,j)/max(abs(f(i,j)),eps)-h(i,j)
530 hbbl(i,j)= min(hekman,hbbl(i,j))
532 hbbl(i,j)=min(hbbl(i,j),z_w(i,j,n(ng)))
533 hbbl(i,j)=max(hbbl(i,j),z_w(i,j,0))
535 hbbl(i,j)=hbbl(i,j)*rmask(i,j)
544 & lbi, ubi, lbj, ubj, &
548 & lbi, ubi, lbj, ubj, &
557 & lbi, ubi, lbj, ubj, &
558 & imins, imaxs, jmins, jmaxs, &
566 hbbl(i,j)=min(hbbl(i,j),z_w(i,j,n(ng)))
567 hbbl(i,j)=max(hbbl(i,j),z_w(i,j,0))
569 hbbl(i,j)=hbbl(i,j)*rmask(i,j)
578 & lbi, ubi, lbj, ubj, &
582 & lbi, ubi, lbj, ubj, &
594 IF ((kbbl(i,j).eq.n(ng)).and.(z_w(i,j,k).gt.hbbl(i,j)))
THEN
607 zgrid(i,j)=z_w(i,j,n(ng))-hbbl(i,j)
609 zgrid(i,j)=zgrid(i,j)*rmask(i,j)
614 & lbi, ubi, lbj, ubj, &
615 & imins, imaxs, jmins, jmaxs, &
616 & -1.0_r8, zgrid, swdk)
619 bfbot(i,j)=(bo(i,j)+bosol(i,j)*(1.0_r8-swdk(i,j)))
621 bfbot(i,j)=bfbot(i,j)*rmask(i,j)
636 IF (bfbot(i,j).gt.0.0_r8)
THEN
641 sigma=cff*(hbbl(i,j)-z_w(i,j,0))
642 ustar3=ustar(i,j)*ustar(i,j)*ustar(i,j)
643 zetahat=
vonkar*sigma*bfbot(i,j)
644 zetapar=zetahat/(ustar3+small)
645 IF (zetahat.ge.0.0_r8)
THEN
646 wm(i,j)=
vonkar*ustar(i,j)/(1.0_r8+5.0_r8*zetapar)
650 wm(i,j)=
vonkar*ustar(i,j)* &
651 & (1.0_r8-16.0_r8*zetapar)**0.25_r8
656 ws(i,j)=
vonkar*ustar(i,j)* &
657 & (1.0_r8-16.0_r8*zetapar)**0.5_r8
673 f1(i,j)=5.0_r8*max(0.0_r8,bfbot(i,j))*
vonkar/ &
674 & (ustar(i,j)*ustar(i,j)*ustar(i,j)*ustar(i,j)+eps)
680 zbl=hbbl(i,j)-z_w(i,j,0)
682 cff=1.0_r8/(z_w(i,j,k)-z_w(i,j,k-1))
683 cff_dn=cff*(hbbl(i,j)-z_w(i,j,k-1))
684 cff_up=cff*(z_w(i,j,k)-hbbl(i,j))
689 k_bl=cff_dn*akv(i,j,k)+cff_up*akv(i,j,k-1)
690 dk_bl=-cff*(akv(i,j,k)-akv(i,j,k-1))
691 gm1(i,j)=k_bl/(zbl*wm(i,j)+eps)
693 gm1(i,j)=gm1(i,j)*rmask(i,j)
695 dgm1ds(i,j)=min(0.0_r8, k_bl*f1(i,j)-dk_bl/(wm(i,j)+eps))
700 k_bl=cff_dn*akt(i,j,k,
itemp)+cff_up*akt(i,j,k-1,
itemp)
701 dk_bl=-cff*(akt(i,j,k,
itemp)-akt(i,j,k-1,
itemp))
702 gt1(i,j)=k_bl/(zbl*ws(i,j)+eps)
704 gt1(i,j)=gt1(i,j)*rmask(i,j)
706 dgt1ds(i,j)=min(0.0_r8, k_bl*f1(i,j)-dk_bl/(ws(i,j)+eps))
712 k_bl=cff_dn*akt(i,j,k,
isalt)+cff_up*akt(i,j,k-1,
isalt)
713 dk_bl=-cff*(akt(i,j,k,
isalt)-akt(i,j,k-1,
isalt))
714 gs1(i,j)=k_bl/(zbl*ws(i,j)+eps)
716 gs1(i,j)=gs1(i,j)*rmask(i,j)
718 dgs1ds(i,j)=min(0.0_r8, k_bl*f1(i,j)-dk_bl/(ws(i,j)+eps))
730 IF (z_w(i,j,k).lt.hbbl(i,j))
THEN
734 depth=z_w(i,j,k)-z_w(i,j,0)
735 IF (bflux(i,j,k).lt.0.0_r8)
THEN
736 sigma=min(bl_dpth(i,j),depth)
740 ustar3=ustar(i,j)*ustar(i,j)*ustar(i,j)
741 zetahat=
vonkar*sigma*bflux(i,j,k)
742 zetapar=zetahat/(ustar3+small)
743 IF (zetahat.ge.0.0_r8)
THEN
744 wm(i,j)=
vonkar*ustar(i,j)/(1.0_r8+5.0_r8*zetapar)
748 wm(i,j)=
vonkar*ustar(i,j)* &
749 & (1.0_r8-16.0_r8*zetapar)**0.25_r8
754 ws(i,j)=
vonkar*ustar(i,j)* &
755 & (1.0_r8-16.0_r8*zetapar)**0.5_r8
763 sigma=depth/(hbbl(i,j)-z_w(i,j,0)+eps)
765 sigma=sigma*rmask(i,j)
768 a2=3.0_r8-2.0_r8*sigma
773 gm=a1+a2*gm1(i,j)+a3*dgm1ds(i,j)
774 gt=a1+a2*gt1(i,j)+a3*dgt1ds(i,j)
776 gs=a1+a2*gs1(i,j)+a3*dgs1ds(i,j)
785 IF (k.gt.ksbl(i,j))
THEN
786 akv(i,j,k)=max(akv(i,j,k), &
787 & depth*wm(i,j)*(1.0_r8+sigma*gm))
789 & depth*ws(i,j)*(1.0_r8+sigma*gt))
792 & depth*ws(i,j)*(1.0_r8+sigma*gs))
795 akv(i,j,k)=depth*wm(i,j)*(1.0_r8+sigma*gm)
796 akt(i,j,k,
itemp)=depth*ws(i,j)*(1.0_r8+sigma*gt)
798 akt(i,j,k,
isalt)=depth*ws(i,j)*(1.0_r8+sigma*gs)