74 &, clw2, cwm, t, tp, qp, psp &
75 &, psat,hvap,grav,hfus,ttp,rd,cp,eps,epsm1,rv &
76 &, tp1, qp1, psp1, u, lprnt, ipr, errmsg, errflg)
100 integer,
intent(in) :: im, km, ipr
101 real(kind=kind_phys),
intent(in) :: dt, dtf
102 real(kind=kind_phys),
intent(in) :: prsl(:,:), ps(:)
103 real(kind=kind_phys),
intent(inout) :: q(:,:), t(:,:)
104 real(kind=kind_phys),
intent(in) :: clw1(:,:), clw2(:,:)
105 real(kind=kind_phys),
intent(out) :: cwm(:,:)
106 real(kind=kind_phys),
intent(inout),
optional :: &
107 &, tp(:,:), qp(:,:), psp(:) &
108 &, tp1(:,:), qp1(:,:), psp1(:)
109 real(kind=kind_phys),
intent(in) :: u(:,:)
110 logical,
intent(in) :: lprnt
111 real(kind=kind_phys),
intent(in) :: psat, hvap, grav, hfus &
112 &, ttp, rd, cp, eps, epsm1, rv
114 character(len=*),
intent(out) :: errmsg
115 integer,
intent(out) :: errflg
118 real (kind=kind_phys) h1, d00, elwv, eliv
121 parameter(h1=1.e0, d00=0.e0, epsq=2.e-12)
123 real(kind=kind_phys),
parameter :: cons_0=0.0, cons_m15=-15.0
125 real (kind=kind_phys) qi(im), qint(im), ccrik, e0
126 &, cond, rdt, us, cclimit, climit
127 &, tmt0, tmt15, qik, cwmik
128 &, ai, qw, u00ik, tik, pres, pp0, fi
129 &, at, aq, ap, fiw, elv, qc, rqik
130 &, rqikk, tx1, tx2, tx3, es, qs
131 &, tsq, delq, condi, cone0, us00, ccrik1
132 &, aa, ab, ac, ad, ae, af, ag
135 integer iw(im,km), i, k, iwik
144 cwm(i,k) = clw1(i,k)+clw2(i,k)
154 el2orc = hvap*hvap / (rv*cp)
195 tmt15 = min(tmt0,cons_m15)
196 qik = max(q(i,k),epsq)
197 cwmik = max(cwm(i,k),climit)
210 qw = min(pres, fpvs(t(i,k)))
212 qw = eps * qw / (pres + epsm1 * qw)
238 if(tmt0.lt.-15.0)
then
240 fi = qik - u00ik*qi(i)
241 if(fi > d00.or.cwmik > climit)
then
252 if (tmt0 < 0.0 .and. tmt0 >= -15.0)
then
255 if (iw(i,k+1) == 1 .and. cwmik > climit) iw(i,k) = 1
275 qik = max(q(i,k),epsq)
276 cwmik = max(cwm(i,k),climit)
281 pp0 = (pres / ps(i)) * psp(i)
282 at = (tik-tp(i,k)) * rdt
283 aq = (qik-qp(i,k)) * rdt
284 ap = (pres-pp0) * rdt
289 elv = (h1-fiw)*elwv + fiw*eliv
290 qc = (h1-fiw)*qint(i) + fiw*qi(i)
293 if(qc.le.1.0e-10)
then
384 if (rqik .lt. u00ik)
then
386 elseif(rqik.ge.us)
then
390 ccrik = h1-sqrt((us-rqikk)/(us-u00ik))
401 if (ccrik <= cclimit.and. cwmik > climit)
then
408 es = min(pres, fpvs(tx1))
409 qs = u00ik * eps * es / (pres + epsm1*es)
411 delq = 0.5 * (qs - tx3) * tsq / (tsq + el2orc * qs)
414 tx1 = tx1 - delq * albycp
419 es = min(pres, fpvs(tx1))
420 qs = u00ik * eps * es / (pres + epsm1*es)
422 delq = (qs - tx3) * tsq / (tsq + el2orc * qs)
425 tx1 = tx1 - delq * albycp
430 es = min(pres, fpvs(tx1))
431 qs = u00ik * eps * es / (pres + epsm1*es)
433 delq = (qs - tx3) * tsq / (tsq + el2orc * qs)
436 e0 = max(tx2*rdt, cons_0)
442 e0 = min(cwmik*rdt, e0)
449 if (ccrik .gt. cclimit .and. qc .gt. epsq)
then
452 aa = eps*elv*pres*qik
453 ab = ccrik*ccrik1*qc*us00
460 cond = (ac-ad)*(af*aq-ai*at+ae*qik*ap)/(ac*(af+ag))
462 condi = (qik -u00ik *qc*1.0)*rdt
463 cond = min(cond, condi)
475 cond = max(cond, d00)
478 cone0 = (cond-e0) * dt
479 cwm(i,k) = cwm(i,k) + cone0
483 t(i,k) = t(i,k) + elv*rcp*cone0
484 q(i,k) = q(i,k) - cone0
494 if (dt > dtf+0.001)
then
501 qp1(i,k) = max(q(i,k),epsq)
514 qp(i,k) = max(q(i,k),epsq)
subroutine, public zhaocarr_gscond_run(im, km, dt, dtf, prsl, ps, q, clw1, clw2, cwm, t, tp, qp, psp, psat, hvap, grav, hfus, ttp, rd, cp, eps, epsm1, rv, tp1, qp1, psp1, u, lprnt, ipr, errmsg, errflg)