54 use vrbls3d,
only: q, qqw, qqi, qqr, qqs, cwm, qqg, t, rswtt, &
55 train, tcucn, mcvg, pmid, o3, ext, pint, rlwtt, &
57 use vrbls4d,
only: smoke, fv3dust, coarsepm
59 use params_mod,
only: tfrz, gi
60 use ctlblk_mod,
only: lm, jsta, jend, im, spval, ista, iend
61 use upp_physics,
only: fpvsnew
68 real,
PARAMETER :: RHOWAT=1.e3
69 real,
parameter:: con_rd =2.8705e+2
70 real,
parameter:: con_rv =4.6150e+2
71 real,
parameter:: con_eps =con_rd/con_rv
72 real,
parameter:: con_epsm1 =con_rd/con_rv-1
76 integer,
intent(in) :: IDECID
77 real,
dimension(ista:iend,jsta:jend),
intent(inout) :: PW
79 REAL ALPM,DZ,PM,PWSUM,RHOAIR,DP,ES
80 REAL QDUM(ista:iend,jsta:jend), PWS(ista:iend,jsta:jend),QS(ista:iend,jsta:jend)
100 IF (idecid <= 1)
THEN
107 ELSE IF (idecid == 2)
THEN
111 qdum(i,j) = qqw(i,j,l)
114 ELSE IF (idecid == 3)
THEN
118 qdum(i,j) = qqi(i,j,l)
121 ELSE IF (idecid == 4)
THEN
125 qdum(i,j) = qqr(i,j,l)
128 ELSE IF (idecid == 5)
THEN
132 qdum(i,j) = qqs(i,j,l)
135 ELSE IF (idecid == 6)
THEN
139 qdum(i,j) = cwm(i,j,l)
143 ELSE IF (idecid == 16)
THEN
147 qdum(i,j) = qqg(i,j,l)
151 ELSE IF (idecid == 7)
THEN
156 IF (t(i,j,l) >= tfrz)
THEN
159 qdum(i,j) = qqw(i,j,l) + qqr(i,j,l)
163 ELSE IF (idecid == 8)
THEN
168 IF (t(i,j,l) <= tfrz)
THEN
171 qdum(i,j) = qqi(i,j,l) + qqs(i,j,l)
175 ELSE IF (idecid == 9)
THEN
180 qdum(i,j) = rswtt(i,j,l)
183 ELSE IF (idecid == 10)
THEN
188 qdum(i,j) = rlwtt(i,j,l)
191 ELSE IF (idecid == 11)
THEN
196 qdum(i,j) = train(i,j,l)
199 ELSE IF (idecid == 12)
THEN
204 qdum(i,j) = tcucn(i,j,l)
207 ELSE IF (idecid == 13)
THEN
212 qdum(i,j) = mcvg(i,j,l)
216 ELSE IF (idecid == 14)
THEN
221 es = min(fpvsnew(t(i,j,l)),pmid(i,j,l))
222 qs(i,j) = con_eps*es/(pmid(i,j,l)+con_epsm1*es)
226 ELSE IF (idecid == 15)
THEN
230 qdum(i,j) = o3(i,j,l)
235 ELSE IF (idecid == 17)
THEN
239 qdum(i,j) = ext(i,j,l)
245 ELSE IF (idecid == 18)
THEN
249 qdum(i,j) = smoke(i,j,l,1)/(1e9)
255 ELSE IF (idecid == 19)
THEN
259 qdum(i,j) = taod5503d(i,j,l)
264 ELSE IF (idecid == 20)
THEN
268 qdum(i,j) = sca(i,j,l)
273 ELSE IF (idecid == 21)
THEN
277 qdum(i,j) = asy(i,j,l)
283 ELSE IF (idecid == 22)
THEN
287 qdum(i,j) = fv3dust(i,j,l,1)/(1e9)
293 ELSE IF (idecid == 23)
THEN
297 qdum(i,j) = coarsepm(i,j,l,1)/(1e9)
305 if(pint(i,j,l+1) <spval .and. qdum(i,j) < spval)
then
306 dp = pint(i,j,l+1) - pint(i,j,l)
307 IF (idecid == 19)
THEN
308 pw(i,j) = pw(i,j) + qdum(i,j)
310 pw(i,j) = pw(i,j) + qdum(i,j)*max(dp,0.)*gi*htm(i,j,l)
312 IF (idecid == 14) pws(i,j) = pws(i,j) + qs(i,j)*dp*gi*htm(i,j,l)
322 IF (idecid == 14)
THEN
326 if( pw(i,j)<spval)
then
327 pw(i,j) = max(0.,pw(i,j)/pws(i,j)*100.)
335 IF (idecid == 15)
then
339 if( pw(i,j)<spval)
then
340 pw(i,j) = pw(i,j) / 2.14e-5