50 SUBROUTINE frzlvl2(ISOTHERM,ZFRZ,RHFRZ,PFRZL)
53 use vrbls3d,
only: pint, t, zmid, pmid, q, zint, alpint
54 use vrbls2d,
only: fis, tshltr, pshltr, qz0, qs, qshltr
55 use masks,
only: lmh, sm
56 use params_mod,
only: gi, d00, capa, d0065, tfrz, pq0, a2, a3, a4, d50
57 use ctlblk_mod,
only: jsta, jend, spval, lm, modelname, im, ista, iend
58 use physcons_post,
only: con_rd, con_rv, con_eps, con_epsm1
59 use upp_physics,
only: fpvsnew
68 REAL,
PARAMETER::PUCAP=300.0e2
69 real,
intent(in) :: ISOTHERM
70 REAL,
dimension(ista:iend,jsta:jend),
intent(out) :: RHFRZ, ZFRZ, PFRZL
72 integer I,J,L,LICE,LLMH
73 real HTSFC,PSFC,QSFC,RHSFC,QW,QSAT,DELZ,DELT,DELQ,DELALP,DELZP, &
74 zl,zu,dzabv,qfrz,alpl,alph,alpfrz,pfrz,qsfrz,rhz,dzfr, &
85 IF(fis(i,j)<spval)
THEN
98 IF(tshltr(i,j)/=spval .AND. pshltr(i,j)/=spval)
THEN
99 tsfc=tshltr(i,j)*(pshltr(i,j)*1.e-5)**capa
102 tsfc=t(i,j,lm)+d0065*(zmid(i,j,lm)-htsfc-2.0)
108 IF (pmid(i,j,l)>=pucap .AND. &
109 (t(i,j,l)<=isotherm.AND.t(i,j,l+1)>isotherm))lice=l
114 IF (lice==llmh.AND.tsfc<=isotherm)
THEN
115 zfrz(i,j) = htsfc+2.0+(tsfc-isotherm)/d0065
116 qsfc = sm(i,j)*qz0(i,j)+(1.-sm(i,j))*qs(i,j)
117 IF(qshltr(i,j)/=spval)
THEN
126 IF(modelname ==
'GFS' .OR. modelname ==
'RAPR')
THEN
129 qsat=con_eps*es/(psfc+con_epsm1*es)
132 *exp(a2*(tsfc-a3)/(tsfc-a4))
136 rhsfc = amax1(0.01,rhsfc)
137 rhsfc = amin1(rhsfc,1.0)
142 ELSE IF (lice<llmh)
THEN
144 delz = d50*(zint(i,j,l)-zint(i,j,l+2))
145 zl = d50*(zint(i,j,l+1)+zint(i,j,l+2))
146 delt = t(i,j,l)-t(i,j,l+1)
147 zfrz(i,j) = zl+(isotherm-t(i,j,l+1))/delt*delz
150 delq = q(i,j,l)-q(i,j,l+1)
151 qfrz = q(i,j,l+1) + delq/delz*dzabv
152 qfrz = amax1(0.0,qfrz)
154 alpl = alpint(i,j,l+2)
157 delzp = zint(i,j,l)-zint(i,j,l+2)
158 dzfr = zfrz(i,j) - zint(i,j,l+2)
159 alpfrz = alpl + delalp/delzp*dzfr
162 IF(modelname ==
'GFS'.OR.modelname ==
'RAPR')
THEN
165 qsfrz=con_eps*es/(pfrz+con_epsm1*es)
168 *exp(a2*(isotherm-a3)/(isotherm-a4))
173 rhz = amax1(0.01,rhz)
182 IF(tshltr(i,j)/=spval .AND. pshltr(i,j)/=spval)
THEN
183 tsfc=tshltr(i,j)*(pshltr(i,j)*1.e-5)**capa
186 tsfc=t(i,j,lm)+d0065*(zmid(i,j,lm)-htsfc-2.0)
189 zfrz(i,j) = zl + (isotherm-tsfc)/delt*delz
193 IF(qshltr(i,j)/=spval)
THEN
199 qfrz = qsfc + delq/delz*dzabv
200 qfrz = amax1(0.0,qfrz)
205 alpfrz = alpl + delalp/delz*dzabv
208 IF(modelname ==
'GFS'.OR.modelname ==
'RAPR')
THEN
211 qsfrz=con_eps*es/(pfrz+con_epsm1*es)
214 *exp(a2*(isotherm-a3)/(isotherm-a4))
218 rhz = amax1(0.01,rhz)
226 rhfrz(i,j) = amax1(0.01,rhfrz(i,j))
227 rhfrz(i,j) = amin1(rhfrz(i,j),1.00)
228 zfrz(i,j) = amax1(0.0,zfrz(i,j))