79 &, grav, hvap, hfus, ttp, cp, eps, epsm1 &
80 &, sr,rainp,u00k,psautco,prautco,evpco,wminco &
81 &, wk1,lprnt,jpr,errmsg,errflg)
132 integer,
intent(in) :: im, km, jpr
133 real (kind=kind_phys),
intent(in) :: grav, hvap, hfus, ttp, cp, &
135 real (kind=kind_phys),
intent(in) :: dt
136 real (kind=kind_phys),
intent(in) :: del(:,:), prsl(:,:)
137 real (kind=kind_phys),
intent(inout) :: q(:,:), t(:,:), &
139 real (kind=kind_phys),
intent(out) :: rn(:), sr(:), rainp(:,:)
140 real (kind=kind_phys),
intent(in) :: u00k(:,:)
141 real (kind=kind_phys),
intent(in) :: psautco(:), prautco(:), &
142 & evpco, wminco(:), wk1(:)
143 logical,
intent(in) :: lprnt
144 character(len=*),
intent(out) :: errmsg
145 integer,
intent(out) :: errflg
148 real (kind=kind_phys) g, h1, h1000
153 parameter( h1=1.e0, h1000=1000.0 &
154 &, d00=0.e0, row=1.e3 &
158 real(kind=kind_phys),
parameter :: cons_0=0.0, cons_p01=0.01 &
160 &, cons_m30=-30.0, cons_50=50.0
162 real (kind=kind_phys) rnp(im), psautco_l(im), prautco_l(im) &
165 real (kind=kind_phys) err(im), ers(im), precrl(im) &
166 &, precsl(im), precrl1(im), precsl1(im) &
167 &, rq(im), condt(im) &
168 &, conde(im), rconde(im), tmt0(im) &
169 &, wmin(im,km), wmink(im), pres(im) &
170 &, wmini(im,km), ccr(im) &
171 &, tt(im), qq(im), ww(im) &
173 real (kind=kind_phys) cclim(km)
175 integer iw(im,km), ipr(im), iwl(im), iwl1(im)
179 real (kind=kind_phys) ke, rdt, us, climit, cws, csm1
180 &, crs1, crs2, cr, aa2, dtcp, c00, cmr
183 &, precrk, precsk, pres1, qk, qw, qi
184 &, qint, fiw, wws, cwmk, expf
185 &, psaut, psaci, amaxcm, tem1, tem2
186 &, tmt0k, psm1, psm2, ppr
187 &, rprs, erk, pps, sid, rid, amaxps
188 &, praut, fi, qc, amaxrq, rqkll
189 integer i, k, ihpr, n
197 psautco_l(i) = psautco(1)*wk1(i) + psautco(2)*wk2(i)
198 prautco_l(i) = prautco(1)*wk1(i) + prautco(2)*wk2(i)
228 csm1 = 5.0000e-8 * zaodt
229 crs1 = 5.00000e-6 * zaodt
230 crs2 = 6.66600e-10 * zaodt
232 aa2 = 1.25e-3 * zaodt
255 tem = (prsl(i,k)*0.00001)
262 wmin(i,k) = wminco(1) * tem
263 wmini(i,k) = wminco(2) * tem
299 tem = min(wmin(i,k), wmini(i,k))
300 if (cwm(i,k) > tem) comput(i) = .true.
316 precrl(n) = precrl1(n)
317 precsl(n) = precsl1(n)
329 precrk = max(cons_0, precrl1(n))
330 precsk = max(cons_0, precsl1(n))
331 wwn = max(ww(n), climit)
333 if (wwn > climit .or. (precrk+precsk) > d00)
then
344 conde(n) = (dt/g) * del(i,k)
345 condt(n) = conde(n) * rdt
346 rconde(n) = h1 / conde(n)
347 qk = max(epsq, qq(n))
348 tmt0(n) = tt(n) - 273.16
349 wwn = max(ww(n), climit)
359 qw = min(pres1, fpvs(tt(n)))
360 qw = eps * qw / (pres1 + epsm1 * qw)
380 if(tmt0(n) < -15.)
then
381 fi = qk - u00k(i,k)*qi
382 if(fi > d00 .or. wwn > climit)
then
388 elseif (tmt0(n) >= 0.)
then
394 if(iwl1(n) == 1 .and. wwn > climit) iwl(n) = 1
402 qc = (h1-fiw)*qint + fiw*qi
404 if(qc <= 1.0e-10)
then
411 if(rq(n) < u00k(i,k))
then
413 elseif(rq(n) >= us)
then
416 rqkll = min(us,rq(n))
417 ccr(n) = h1-sqrt((us-rqkll)/(us-u00k(i,k)))
467 if (comput(n) .and. ccr(n) > 0.0)
then
469 cwmk = max(cons_0, wws)
472 if (iwl(n) == 1)
then
473 amaxcm = max(cons_0, cwmk - wmini(i,k))
474 expf = dt * exp(0.025*tmt0(n))
475 psaut = min(cwmk, psautco_l(i)*expf*amaxcm)
476 ww(n) = ww(n) - psaut
477 cwmk = max(cons_0, ww(n))
479 psaci = min(cwmk, aa2*expf*precsl1(n)*cwmk)
481 ww(n) = ww(n) - psaci
482 precsl(n) = precsl(n) + (wws - ww(n)) * condt(n)
495 amaxcm = max(cons_0, cwmk - wmink(n))
497 tem1 = precsl1(n) + precrl1(n)
498 tem2 = min(max(cons_0, 268.0-tt(n)), cons_20)
499 tem = (1.0+c1*sqrt(tem1*rdt)) * (1+c2*sqrt(tem2))
501 tem2 = amaxcm * cmr * tem / max(ccr(n),cons_p01)
502 tem2 = min(cons_50, tem2*tem2)
504 praut = (prautco_l(i)*dt) * tem * amaxcm
506 praut = min(praut, cwmk)
507 ww(n) = ww(n) - praut
529 precrl(n) = precrl(n) + (wws - ww(n)) * condt(n)
533 rnp(n) = rnp(n) + (wws - ww(n))
565 qk = max(epsq, qq(n))
566 tmt0k = max(cons_m30, tmt0(n))
567 precrk = max(cons_0, precrl(n))
568 precsk = max(cons_0, precsl(n))
569 amaxrq = max(cons_0, u00k(i,k)-rq(n)) * conde(n)
573 ppr = ke * amaxrq * sqrt(precrk)
575 if (tmt0(n) .ge. 0.)
then
578 pps = (crs1+crs2*tmt0k) * amaxrq * precsk / u00k(i,k)
582 if(rq(n).ge.1.0e-10) erk = amaxrq * qk * rdt / rq(n)
583 if (ppr+pps .gt. abs(erk))
then
584 rprs = erk / (precrk+precsk)
588 ppr = min(ppr, precrk)
589 pps = min(pps, precsk)
590 err(n) = ppr * rconde(n)
591 ers(n) = pps * rconde(n)
592 precrl(n) = precrl(n) - ppr
596 rnp(n) = rnp(n) - err(n)
598 precsl(n) = precsl(n) - pps
635 if (tmt0(n) .gt. 0.)
then
636 amaxps = max(cons_0, precsl(n))
637 psm1 = csm1 * tmt0(n) * tmt0(n) * amaxps
638 psm2 = cws * cr * max(cons_0, ww(n)) * amaxps
639 ppr = (psm1 + psm2) * conde(n)
640 if (ppr .gt. amaxps)
then
642 psm1 = amaxps * rconde(n)
644 precrl(n) = precrl(n) + ppr
648 rnp(n) = rnp(n) + ppr * rconde(n)
650 precsl(n) = precsl(n) - ppr
664 tt(n) = tt(n) - dtcp * (elwv*err(n)+eliv*ers(n)+eliw*psm1)
665 qq(n) = qq(n) + dt * (err(n)+ers(n))
671 precrl1(n) = max(cons_0, precrl(n))
672 precsl1(n) = max(cons_0, precsl(n))
687 if (cwm(i,k) < 0.)
then
688 tem = q(i,k) + cwm(i,k)
691 t(i,k) = t(i,k) - elwv * rcp * cwm(i,k)
693 elseif (q(i,k) > 0.0)
then
695 t(i,k) = t(i,k) + elwv * rcp * q(i,k)
716 rn(i) = (precrl1(n) + precsl1(n)) * rrow
729 rid = precrl1(n) + precsl1(n)
730 if (rid < 1.e-13)
then
733 sr(i) = precsl1(n)/rid