31 SUBROUTINE wetfrzlvl(TWET,ZWET)
35 use vrbls3d, only: pint, zint, t
36 use vrbls2d, only: fis, thz0, ths
37 use masks, only: lmh, sm
38 use params_mod, only: gi, p1000, capa, tfrz, d0065, d50
39 use ctlblk_mod
, only: jsta, jend, im, jsta_2l, jend_2u, lm, spval, &
40 ista, iend, ista_2l, iend_2u
46 REAL,
intent(in) :: twet(ista_2l:iend_2u,jsta_2l:jend_2u,lm)
47 REAL,
intent(out) :: zwet(ista:iend,jsta:jend)
50 real htsfc,thsfc,psfc,tsfc,delz,delt,zl,zu
61 IF(fis(i,j)==spval)
THEN
73 thsfc = (sm(i,j)*thz0(i,j)+(1.-sm(i,j))*ths(i,j))
74 psfc = pint(i,j,llmh+1)
75 tsfc = thsfc*(psfc/p1000)**capa
79 zwet(i,j) = htsfc+(tsfc-tfrz)/d0065
85 loopl:
DO l = llmh,1,-1
86 IF (twet(i,j,l)<=tfrz)
THEN
88 delz = d50*(zint(i,j,l)-zint(i,j,l+2))
89 zl = d50*(zint(i,j,l+1)+zint(i,j,l+2))
90 delt = twet(i,j,l)-twet(i,j,l+1)
91 zwet(i,j) = zl + (tfrz-twet(i,j,l+1))/delt*delz
93 zu = d50*(zint(i,j,l)+zint(i,j,l+1))
96 tsfc = sm(i,j)*thz0(i,j)+(1.-sm(i,j))*ths(i,j) &
97 *(pint(i,j,nint(lmh(i,j))+1)/p1000)**capa
100 zwet(i,j) = zl + (tfrz-tsfc)/delt*delz
102 zwet(i,j) = htsfc+(tsfc-twet(i,j,l))/d0065
104 IF (zwet(i,j) > zu)
THEN
107 IF ((-1*zwet(i,j)) > zu)
THEN