93 use vrbls3d,
only: zint, pint, t, q, zmid
94 use vrbls2d,
only: slp, fis, z1000
96 use params_mod,
only: rd, gi, g, h1, d608, gamma, d50, p1000
97 use ctlblk_mod,
only: jsta, jend, im, jm, spval, ista, iend
101 real,
PARAMETER :: ZSL=0.0
102 real,
PARAMETER :: TAUCR=rd*gi*290.66,const=0.005*g/rd
103 real,
PARAMETER :: GORD=g/rd,dp=60.e2
108 real ZSFC,PSFC,TVRT,TAU,TVRSFC,TAUSFC,TVRSL,TAUSL,TAUAVG, &
109 alpavg,pavg,rhoavg,rrhog
122 llmh = nint(lmh(i,j))
124 if( pint(i,j,llmh+1)<spval)
then
126 zsfc = zint(i,j,llmh+1)
127 psfc = pint(i,j,llmh+1)
131 tvrt = t(i,j,llmh)*(h1+d608*q(i,j,llmh))
137 tvrsfc = tvrt + (zmid(i,j,llmh) - zsfc)*gamma
138 tausfc = tvrsfc*rd*gi
140 tvrsl = tvrt + (zmid(i,j,llmh) - zsl)*gamma
144 IF ((tausl>taucr).AND.(tausfc<=taucr))
THEN
146 ELSEIF ((tausl>taucr).AND.(tausfc>taucr))
THEN
147 tausl = taucr-const*(tausfc-taucr)**2
151 tauavg = d50*(tausl+tausfc)
154 IF (abs(fis(i,j))>1.0)slp(i,j) = psfc*exp(zsfc/tauavg)
157 alpavg = d50*(alog(psfc)+alog(slp(i,j)))
159 rhoavg = pavg*gi/tauavg
160 rrhog = h1/(rhoavg*g)
161 z1000(i,j) = (slp(i,j)-p1000)*rrhog