85 subroutine gscond (im,ix,km,dt,dtf,prsl,ps,q,cwm,t
86 &, tp, qp, psp, tp1, qp1, psp1, u, lprnt, ipr)
103 use machine
, only : kind_phys
104 use funcphys
, only : fpvs
107 &, cp =>
con_cp, eps => con_eps, epsm1 => con_epsm1
112 real (kind=kind_phys) h1
116 parameter(h1=1.e0, d00=0.e0
117 &, elwv=hvap, eliv=hvap+hfus
119 &, cpr=cp*r, rcp=h1/cp)
121 real(kind=kind_phys),
parameter :: cons_0=0.0, cons_m15=-15.0
123 integer im, ix, km, ipr
124 real (kind=kind_phys) q(ix,km), t(ix,km), cwm(ix,km)
125 &, prsl(ix,km), ps(im), dt, dtf
126 &, tp(ix,km), qp(ix,km), psp(im)
127 &, tp1(ix,km), qp1(ix,km), psp1(im)
129 real (kind=kind_phys) qi(im), qint(im), u(im,km), ccrik, e0
130 &, cond, rdt, us, cclimit, climit
131 &, tmt0, tmt15, qik, cwmik
132 &, ai, qw, u00ik, tik, pres, pp0, fi
133 &, at, aq, ap, fiw, elv, qc, rqik
134 &, rqikk, tx1, tx2, tx3, es, qs
135 &, tsq, delq, condi, cone0, us00, ccrik1
136 &, aa, ab, ac, ad, ae, af, ag
139 integer iw(im,km), i, k, iwik
144 el2orc = hvap*hvap / (rv*cp)
186 tmt15 = min(tmt0,cons_m15)
187 qik = max(q(i,k),epsq)
188 cwmik = max(cwm(i,k),climit)
201 qw = min(pres, fpvs(t(i,k)))
203 qw = eps * qw / (pres + epsm1 * qw)
227 if(tmt0.lt.-15.0)
then
229 fi = qik - u00ik*qi(i)
230 if(fi > d00.or.cwmik > climit)
then
241 if (tmt0 < 0.0 .and. tmt0 >= -15.0)
then
244 if (iw(i,k+1) == 1 .and. cwmik > climit) iw(i,k) = 1
264 qik = max(q(i,k),epsq)
265 cwmik = max(cwm(i,k),climit)
270 pp0 = (pres / ps(i)) * psp(i)
271 at = (tik-tp(i,k)) * rdt
272 aq = (qik-qp(i,k)) * rdt
273 ap = (pres-pp0) * rdt
278 elv = (h1-fiw)*elwv + fiw*eliv
279 qc = (h1-fiw)*qint(i) + fiw*qi(i)
282 if(qc.le.1.0e-10)
then
371 if (rqik .lt. u00ik)
then
373 elseif(rqik.ge.us)
then
377 ccrik = h1-sqrt((us-rqikk)/(us-u00ik))
388 if (ccrik <= cclimit.and. cwmik > climit)
then
395 es = min(pres, fpvs(tx1))
396 qs = u00ik * eps * es / (pres + epsm1*es)
398 delq = 0.5 * (qs - tx3) * tsq / (tsq + el2orc * qs)
401 tx1 = tx1 - delq * albycp
406 es = min(pres, fpvs(tx1))
407 qs = u00ik * eps * es / (pres + epsm1*es)
409 delq = (qs - tx3) * tsq / (tsq + el2orc * qs)
412 tx1 = tx1 - delq * albycp
417 es = min(pres, fpvs(tx1))
418 qs = u00ik * eps * es / (pres + epsm1*es)
420 delq = (qs - tx3) * tsq / (tsq + el2orc * qs)
423 e0 = max(tx2*rdt, cons_0)
429 e0 = min(cwmik*rdt, e0)
436 if (ccrik .gt. cclimit .and. qc .gt. epsq)
then
439 aa = eps*elv*pres*qik
440 ab = ccrik*ccrik1*qc*us00
447 cond = (ac-ad)*(af*aq-ai*at+ae*qik*ap)/(ac*(af+ag))
449 condi = (qik -u00ik *qc*1.0)*rdt
450 cond = min(cond, condi)
462 cond = max(cond, d00)
465 cone0 = (cond-e0) * dt
466 cwm(i,k) = cwm(i,k) + cone0
470 t(i,k) = t(i,k) + elv*rcp*cone0
471 q(i,k) = q(i,k) - cone0
482 if (dt > dtf+0.001)
then
489 qp1(i,k) = max(q(i,k),epsq)
502 qp(i,k) = max(q(i,k),epsq)
real(kind=kind_phys), parameter con_g
gravity ( )
real(kind=kind_phys), parameter con_rv
gas constant H2O ( )
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)
real(kind=kind_phys), parameter con_rd
gas constant air ( )
real(kind=kind_phys), parameter con_psat
pres at H2O 3pt (Pa)
subroutine gscond(im, ix, km, dt, dtf, prsl, ps, q, cwm, t , tp, qp, psp, tp1, qp1, psp1, u, lprnt, ipr)