52 use vrbls3d,
only: pint, t, zmid, q, pmid
53 use vrbls2d,
only: fis, tshltr, pshltr, qshltr
55 use params_mod,
only: gi, d00, capa, d0065, tfrz, pq0, a2, a3, a4
56 use ctlblk_mod,
only: jsta, jend, spval, lm, modelname, im, ista, iend
57 use physcons_post,
only: con_rd, con_rv, con_eps, con_epsm1
58 use upp_physics,
only: fpvsnew
64 REAL,
dimension(ista:iend,jsta:jend) :: RHFRZ, ZFRZ, PFRZL
66 real HTSFC,PSFC,TSFC,QSFC,QSAT,RHSFC,DELZ,DELT,DELQ,DELALP, &
67 delzp,zl,dzabv,qfrz,alpl,alph,alpfrz,pfrz,qsfrz,rhz,zu, &
89 psfc = pint(i,j,llmh+1)
100 IF(tshltr(i,j)/=spval .AND. pshltr(i,j)/=spval)
THEN
101 tsfc=tshltr(i,j)*(pshltr(i,j)*1.e-5)**capa
104 tsfc=t(i,j,lm)+d0065*(zmid(i,j,lm)-htsfc-2.0)
108 zfrz(i,j) = htsfc+2.0+(tsfc-tfrz)/d0065
114 IF(qshltr(i,j)/=spval)
THEN
122 IF(modelname ==
'GFS' .OR. modelname ==
'RAPR')
THEN
125 qsat=con_eps*es/(psfc+con_epsm1*es)
127 qsat=pq0/psfc*exp(a2*(tsfc-a3)/(tsfc-a4))
131 rhsfc = amax1(0.01,rhsfc)
132 rhsfc = amin1(rhsfc,1.0)
141 IF (t(i,j,l)<=tfrz)
THEN
143 delz = zmid(i,j,l)-zmid(i,j,l+1)
145 delt = t(i,j,l)-t(i,j,l+1)
146 zfrz(i,j) = zl + (tfrz-t(i,j,l+1))/delt*delz
149 delq = q(i,j,l)-q(i,j,l+1)
150 qfrz = q(i,j,l+1) + delq/delz*dzabv
151 qfrz = amax1(0.0,qfrz)
154 alpl = alog(pmid(i,j,l+1))
155 alph = alog(pmid(i,j,l))
156 alpfrz = alpl + (alph-alpl)/delz*dzabv
159 IF(modelname ==
'GFS' .OR.modelname ==
'RAPR')
THEN
162 qsfrz=con_eps*es/(pfrz+con_epsm1*es)
165 *exp(a2*(tfrz-a3)/(tfrz-a4))
169 rhz = amax1(0.01,rhz)
177 IF(tshltr(i,j)/=spval .AND. pshltr(i,j)/=spval)
THEN
178 tsfc=tshltr(i,j)*(pshltr(i,j)*1.e-5)**capa
181 tsfc=t(i,j,lm)+d0065*(zmid(i,j,lm)-htsfc-2.0)
184 zfrz(i,j) = zl + (tfrz-tsfc)/delt*delz
188 IF(qshltr(i,j)/=spval)
THEN
194 qfrz = qsfc + delq/delz*dzabv
195 qfrz = amax1(0.0,qfrz)
197 alph = alog(pmid(i,j,l))
200 alpfrz = alpl + delalp/delz*dzabv
204 IF(modelname ==
'GFS'.OR.modelname ==
'RAPR')
THEN
207 qsfrz=con_eps*es/(pfrz+con_epsm1*es)
210 *exp(a2*(tfrz-a3)/(tfrz-a4))
214 rhz = amax1(0.01,rhz)
224 zfrz(i,j) = amax1(0.0,zfrz(i,j))