77 subroutine precpd (im,ix,km,dt,del,prsl,q,cwm,t,rn,sr &
78 &, rainp,u00k,psautco,prautco,evpco,wminco &
124 use machine
, only : kind_phys
125 use funcphys
, only : fpvs
128 &, eps => con_eps, epsm1 => con_epsm1
132 real (kind=kind_phys) g, h1, h1000
137 parameter(g=grav, h1=1.e0, h1000=1000.0
139 &, elwv=hvap, eliv=hvap+hfus, row=1.e3
141 &, eliw=eliv-elwv, rcp=h1/cp, rrow=h1/row)
143 real(kind=kind_phys),
parameter :: cons_0=0.0, cons_p01=0.01
145 &, cons_m30=-30.0, cons_50=50.0
147 integer im, ix, km, jpr
148 real (kind=kind_phys) q(ix,km), t(ix,km), cwm(ix,km) &
149 &, del(ix,km), prsl(ix,km) &
152 &, rainp(im,km), rnp(im), &
153 & psautco(im), prautco(im), evpco, wminco(2)
156 real (kind=kind_phys) err(im), ers(im), precrl(im) &
157 &, precsl(im), precrl1(im), precsl1(im) &
158 &, rq(im), condt(im) &
159 &, conde(im), rconde(im), tmt0(im) &
160 &, wmin(im,km), wmink(im), pres(im) &
161 &, wmini(im,km), ccr(im) &
162 &, tt(im), qq(im), ww(im) &
165 real (kind=kind_phys) cclim(km)
167 integer iw(im,km), ipr(im), iwl(im), iwl1(im)
172 real (kind=kind_phys) ke, rdt, us, climit, cws, csm1
173 &, crs1, crs2, cr, aa2, dtcp, c00, cmr
176 &, precrk, precsk, pres1, qk, qw, qi
177 &, qint, fiw, wws, cwmk, expf
178 &, psaut, psaci, amaxcm, tem1, tem2
179 &, tmt0k, psm1, psm2, ppr
180 &, rprs, erk, pps, sid, rid, amaxps
181 &, praut, fi, qc, amaxrq, rqkll
182 integer i, k, ihpr, n
206 csm1 = 5.0000e-8 * zaodt
207 crs1 = 5.00000e-6 * zaodt
208 crs2 = 6.66600e-10 * zaodt
210 aa2 = 1.25e-3 * zaodt
233 tem = (prsl(i,k)*0.00001)
240 wmin(i,k) = wminco(1) * tem
241 wmini(i,k) = wminco(2) * tem
277 tem = min(wmin(i,k), wmini(i,k))
278 if (cwm(i,k) > tem) comput(i) = .true.
294 precrl(n) = precrl1(n)
295 precsl(n) = precsl1(n)
307 precrk = max(cons_0, precrl1(n))
308 precsk = max(cons_0, precsl1(n))
309 wwn = max(ww(n), climit)
311 if (wwn > climit .or. (precrk+precsk) > d00)
then
322 conde(n) = (dt/g) * del(i,k)
323 condt(n) = conde(n) * rdt
324 rconde(n) = h1 / conde(n)
325 qk = max(epsq, qq(n))
326 tmt0(n) = tt(n) - 273.16
327 wwn = max(ww(n), climit)
337 qw = min(pres1, fpvs(tt(n)))
338 qw = eps * qw / (pres1 + epsm1 * qw)
358 if(tmt0(n) < -15.)
then
359 fi = qk - u00k(i,k)*qi
360 if(fi > d00 .or. wwn > climit)
then
366 elseif (tmt0(n) >= 0.)
then
372 if(iwl1(n) == 1 .and. wwn > climit) iwl(n) = 1
380 qc = (h1-fiw)*qint + fiw*qi
382 if(qc <= 1.0e-10)
then
389 if(rq(n) < u00k(i,k))
then
391 elseif(rq(n) >= us)
then
394 rqkll = min(us,rq(n))
395 ccr(n) = h1-sqrt((us-rqkll)/(us-u00k(i,k)))
445 if (comput(n) .and. ccr(n) > 0.0)
then
447 cwmk = max(cons_0, wws)
450 if (iwl(n) == 1)
then
451 amaxcm = max(cons_0, cwmk - wmini(i,k))
452 expf = dt * exp(0.025*tmt0(n))
453 psaut = min(cwmk, psautco(i)*expf*amaxcm)
454 ww(n) = ww(n) - psaut
455 cwmk = max(cons_0, ww(n))
457 psaci = min(cwmk, aa2*expf*precsl1(n)*cwmk)
459 ww(n) = ww(n) - psaci
460 precsl(n) = precsl(n) + (wws - ww(n)) * condt(n)
473 amaxcm = max(cons_0, cwmk - wmink(n))
475 tem1 = precsl1(n) + precrl1(n)
476 tem2 = min(max(cons_0, 268.0-tt(n)), cons_20)
477 tem = (1.0+c1*sqrt(tem1*rdt)) * (1+c2*sqrt(tem2))
479 tem2 = amaxcm * cmr * tem / max(ccr(n),cons_p01)
480 tem2 = min(cons_50, tem2*tem2)
482 praut = (prautco(i)*dt) * tem * amaxcm
484 praut = min(praut, cwmk)
485 ww(n) = ww(n) - praut
507 precrl(n) = precrl(n) + (wws - ww(n)) * condt(n)
511 rnp(n) = rnp(n) + (wws - ww(n))
544 qk = max(epsq, qq(n))
545 tmt0k = max(cons_m30, tmt0(n))
546 precrk = max(cons_0, precrl(n))
547 precsk = max(cons_0, precsl(n))
548 amaxrq = max(cons_0, u00k(i,k)-rq(n)) * conde(n)
552 ppr = ke * amaxrq * sqrt(precrk)
554 if (tmt0(n) .ge. 0.)
then
557 pps = (crs1+crs2*tmt0k) * amaxrq * precsk / u00k(i,k)
561 if(rq(n).ge.1.0e-10) erk = amaxrq * qk * rdt / rq(n)
562 if (ppr+pps .gt. abs(erk))
then
563 rprs = erk / (precrk+precsk)
567 ppr = min(ppr, precrk)
568 pps = min(pps, precsk)
569 err(n) = ppr * rconde(n)
570 ers(n) = pps * rconde(n)
571 precrl(n) = precrl(n) - ppr
575 rnp(n) = rnp(n) - err(n)
577 precsl(n) = precsl(n) - pps
614 if (tmt0(n) .gt. 0.)
then
615 amaxps = max(cons_0, precsl(n))
616 psm1 = csm1 * tmt0(n) * tmt0(n) * amaxps
617 psm2 = cws * cr * max(cons_0, ww(n)) * amaxps
618 ppr = (psm1 + psm2) * conde(n)
619 if (ppr .gt. amaxps)
then
621 psm1 = amaxps * rconde(n)
623 precrl(n) = precrl(n) + ppr
627 rnp(n) = rnp(n) + ppr * rconde(n)
629 precsl(n) = precsl(n) - ppr
643 tt(n) = tt(n) - dtcp * (elwv*err(n)+eliv*ers(n)+eliw*psm1)
644 qq(n) = qq(n) + dt * (err(n)+ers(n))
650 precrl1(n) = max(cons_0, precrl(n))
651 precsl1(n) = max(cons_0, precsl(n))
666 if (cwm(i,k) < 0.)
then
667 tem = q(i,k) + cwm(i,k)
670 t(i,k) = t(i,k) - elwv * rcp * cwm(i,k)
672 elseif (q(i,k) > 0.0)
then
674 t(i,k) = t(i,k) + elwv * rcp * q(i,k)
695 rn(i) = (precrl1(n) + precsl1(n)) * rrow
708 rid = precrl1(n) + precsl1(n)
709 if (rid < 1.e-13)
then
712 sr(i) = precsl1(n)/rid
real(kind=kind_phys), parameter con_g
gravity ( )
subroutine precpd(im, ix, km, dt, del, prsl, q, cwm, t, rn, sr , rainp, u00k, psautco, prautco, evpco, wminco , lprnt, jpr)
real(kind=kind_phys), parameter con_hfus
lat heat H2O fusion ( )
real(kind=kind_phys), parameter con_cp
spec heat air at p ( )
real(kind=kind_phys), parameter con_hvap
lat heat H2O cond ( )
real(kind=kind_phys), parameter con_ttp
temp at H2O 3pt (K)