12 subroutine mfscuq(im,ix,km,kmscu,ntcw,ntrac1,delt,
13 & cnvflg,zl,zm,q1,t1,u1,v1,plyr,pix,
14 & thlx,thvx,thlvx,gdx,thetae,
15 & krad,mrad,radmin,buo,wush,tkemean,vez0fun,xmfd,
16 & tcdo,qcdo,ucdo,vcdo,xlamdeq,a1)
18 use machine ,
only : kind_phys
19 use funcphys ,
only : fpvs
20 use physcons, grav => con_g, cp => con_cp
21 &, rv => con_rv, hvap => con_hvap
23 &, eps => con_eps, epsm1 => con_epsm1
27 integer im, ix, km, kmscu, ntcw, ntrac1
29 integer krad(im), mrad(im)
32 real(kind=kind_phys) delt
33 real(kind=kind_phys) q1(ix,km,ntrac1),t1(ix,km),
34 & u1(ix,km), v1(ix,km),
35 & plyr(im,km), pix(im,km),
37 & thvx(im,km), thlvx(im,km),
39 & zl(im,km), zm(im,km),
40 & thetae(im,km), radmin(im),
41 & buo(im,km), wush(im,km),
42 & tkemean(im),vez0fun(im),xmfd(im,km),
43 & tcdo(im,km),qcdo(im,km,ntrac1),
44 & ucdo(im,km),vcdo(im,km),
50 integer i,j,indx, k, n, kk, ndc
53 real(kind=kind_phys) dt2, dz, ce0,
56 & gocp, factor, g, tau,
61 & xmmx, tem, tem1, tem2,
64 real(kind=kind_phys) elocp, el2orc, qs, es,
65 & tld, gamma, qld, thdn,
68 real(kind=kind_phys) wd2(im,km), thld(im,km),
69 & qtx(im,km), qtd(im,km),
70 & thlvd(im), hrad(im), xlamde(im,km-1),
71 & xlamdem(im,km-1), ra1(im)
72 real(kind=kind_phys) delz(im), xlamax(im), ce0t(im)
74 real(kind=kind_phys) xlamavg(im), sigma(im),
75 & scaldfunc(im), sumx(im)
77 logical totflg, flg(im)
79 real(kind=kind_phys) actei, cldtime
84 parameter(elocp=hvap/cp,el2orc=hvap*hvap/(rv*cp))
85 parameter(ce0=0.4,cm=1.0,cq=1.0,pgcon=0.55)
86 parameter(tkcrt=2.,cmxfac=5.)
87 parameter(qmin=1.e-8,qlmin=1.e-12)
88 parameter(b1=0.45,f1=0.15)
90 parameter(cldtime=500.)
91 parameter(actei = 0.7)
98 totflg = totflg .and. (.not. cnvflg(i))
109 qtx(i,k) = q1(i,k,1) + q1(i,k,ntcw)
116 hrad(i) = zm(i,krad(i))
124 tem = zm(i,k+1)-zm(i,k)
125 tem1 = cldtime*radmin(i)/tem
126 tem1 = max(tem1, -3.0)
127 thld(i,k)= thlx(i,k) + tem1
129 thlvd(i) = thlvx(i,k) + tem1
130 buo(i,k) = - g * tem1 / thvx(i,k)
148 tem = thetae(i,k) - thetae(i,k+1)
149 tem1 = qtx(i,k) - qtx(i,k+1)
150 if (tem > 0. .and. tem1 > 0.)
then
151 cteit= cp*tem/(hvap*tem1)
152 if(cteit > actei)
then
167 if(flg(i) .and. k < krad(i))
then
168 if(thlvd(i) <= thlvx(i,k))
then
179 if(kk < 1) cnvflg(i)=.false.
185 totflg = totflg .and. (.not. cnvflg(i))
196 ce0t(i) = ce0 * vez0fun(i)
197 if(tkemean(i) > tkcrt)
then
198 tem = sqrt(tkemean(i)/tkcrt)
199 tem1 = min(tem, cmxfac)
201 ce0t(i) = max(ce0t(i), tem2)
208 k = mrad(i) + (krad(i)-mrad(i)) / 2
210 delz(i) = zl(i,k+1) - zl(i,k)
211 xlamax(i) = ce0t(i) / delz(i)
218 if(k >= mrad(i) .and. k < krad(i))
then
219 if(mrad(i) == 1)
then
220 ptem = 1./(zm(i,k)+delz(i))
222 ptem = 1./(zm(i,k)-zm(i,mrad(i)-1)+delz(i))
224 tem = max((hrad(i)-zm(i,k)+delz(i)) ,delz(i))
226 xlamde(i,k) = ce0t(i) * (ptem+ptem1)
228 xlamde(i,k) = xlamax(i)
231 xlamdeq(i,k) = cq * xlamde(i,k)
232 xlamdem(i,k) = cm * xlamde(i,k)
241 if(cnvflg(i) .and. k < krad(i))
then
242 dz = zl(i,k+1) - zl(i,k)
243 tem = 0.5 * xlamde(i,k) * dz
246 thld(i,k) = ((1.-tem)*thld(i,k+1)+tem*
247 & (thlx(i,k)+thlx(i,k+1)))/factor
249 tem = 0.5 * xlamdeq(i,k) * dz
251 qtd(i,k) = ((1.-tem)*qtd(i,k+1)+tem*
252 & (qtx(i,k)+qtx(i,k+1)))/factor
254 tld = thld(i,k) / pix(i,k)
255 es = 0.01 * fpvs(tld)
256 qs = max(qmin, eps * es / (plyr(i,k)+epsm1*es))
260 gamma = el2orc * qs / (tld**2)
261 qld = dq / (1. + gamma)
263 tem1 = 1. + fv * qs - qld
264 thdn = thld(i,k) + pix(i,k) * elocp * qld
267 tem1 = 1. + fv * qtd(i,k)
268 thvd = thld(i,k) * tem1
270 buo(i,k) = g * (1. - thvd / thvx(i,k))
296 dz = zm(i,k+1) - zm(i,k)
298 tem = 0.5*bb1*xlamde(i,k)*dz
299 tem1 = bb2 * buo(i,k+1) * dz
301 wd2(i,k) = tem1 / ptem1
306 if(cnvflg(i) .and. k < krad1(i))
then
307 dz = zm(i,k+1) - zm(i,k)
308 tem = 0.25*bb1*(xlamde(i,k)+xlamde(i,k+1))*dz
309 tem1 = max(wd2(i,k+1), 0.)
310 tem1 = bb2*buo(i,k+1) - wush(i,k+1)*sqrt(tem1)
312 ptem = (1. - tem) * wd2(i,k+1)
314 wd2(i,k) = (ptem + tem2) / ptem1
321 if(flg(i)) mrad(i) = krad(i)
325 if(flg(i) .and. k < krad(i))
then
326 if(wd2(i,k) > 0.)
then
338 if(kk < 1) cnvflg(i)=.false.
344 totflg = totflg .and. (.not. cnvflg(i))
353 k = mrad(i) + (krad(i)-mrad(i)) / 2
355 delz(i) = zl(i,k+1) - zl(i,k)
356 xlamax(i) = ce0t(i) / delz(i)
363 if(k >= mrad(i) .and. k < krad(i))
then
364 if(mrad(i) == 1)
then
365 ptem = 1./(zm(i,k)+delz(i))
367 ptem = 1./(zm(i,k)-zm(i,mrad(i)-1)+delz(i))
369 tem = max((hrad(i)-zm(i,k)+delz(i)) ,delz(i))
371 xlamde(i,k) = ce0t(i) * (ptem+ptem1)
373 xlamde(i,k) = xlamax(i)
376 xlamdeq(i,k) = cq * xlamde(i,k)
377 xlamdem(i,k) = cm * xlamde(i,k)
391 & (k >= mrad(i) .and. k < krad(i)))
then
392 dz = zl(i,k+1) - zl(i,k)
393 xlamavg(i) = xlamavg(i) + xlamde(i,k) * dz
394 sumx(i) = sumx(i) + dz
400 xlamavg(i) = xlamavg(i) / sumx(i)
409 & (k >= mrad(i) .and. k < krad(i)))
then
410 xmfd(i,k) = ra1(i) * sqrt(wd2(i,k))
420 tem = 0.2 / xlamavg(i)
421 tem1 = 3.14 * tem * tem
422 sigma(i) = tem1 / (gdx(i) * gdx(i))
423 sigma(i) = max(sigma(i), 0.001)
424 sigma(i) = min(sigma(i), 0.999)
433 if (sigma(i) > ra1(i))
then
434 scaldfunc(i) = (1.-sigma(i)) * (1.-sigma(i))
435 scaldfunc(i) = max(min(scaldfunc(i), 1.0), 0.)
447 & (k >= mrad(i) .and. k < krad(i)))
then
448 xmfd(i,k) = scaldfunc(i) * xmfd(i,k)
449 dz = zl(i,k+1) - zl(i,k)
451 xmfd(i,k) = min(xmfd(i,k),xmmx)
480 & (k >= mrad(i) .and. k < krad(i)))
then
481 dz = zl(i,k+1) - zl(i,k)
482 tem = 0.5 * xlamde(i,k) * dz
485 thld(i,k) = ((1.-tem)*thld(i,k+1)+tem*
486 & (thlx(i,k)+thlx(i,k+1)))/factor
488 tem = 0.5 * xlamdeq(i,k) * dz
490 qtd(i,k) = ((1.-tem)*qtd(i,k+1)+tem*
491 & (qtx(i,k)+qtx(i,k+1)))/factor
493 tld = thld(i,k) / pix(i,k)
494 es = 0.01 * fpvs(tld)
495 qs = max(qmin, eps * es / (plyr(i,k)+epsm1*es))
499 gamma = el2orc * qs / (tld**2)
500 qld = dq / (1. + gamma)
504 tcdo(i,k) = tld + elocp * qld
506 qcdo(i,k,1) = qtd(i,k)
517 if (cnvflg(i) .and. k < krad(i))
then
518 if(k >= mrad(i))
then
519 dz = zl(i,k+1) - zl(i,k)
520 tem = 0.5 * xlamdem(i,k) * dz
525 ucdo(i,k) = ((1.-tem)*ucdo(i,k+1)+ptem*u1(i,k+1)
526 & +ptem1*u1(i,k))/factor
527 vcdo(i,k) = ((1.-tem)*vcdo(i,k+1)+ptem*v1(i,k+1)
528 & +ptem1*v1(i,k))/factor
539 if (cnvflg(i) .and. k < krad(i))
then
540 if(k >= mrad(i))
then
541 dz = zl(i,k+1) - zl(i,k)
542 tem = 0.5 * xlamdeq(i,k) * dz
545 qcdo(i,k,n) = ((1.-tem)*qcdo(i,k+1,n)+tem*
546 & (q1(i,k,n)+q1(i,k+1,n)))/factor
559 do n = ntcw+1, ntrac1
562 if (cnvflg(i) .and. k < krad(i))
then
563 if(k >= mrad(i))
then
564 dz = zl(i,k+1) - zl(i,k)
565 tem = 0.5 * xlamdeq(i,k) * dz
568 qcdo(i,k,n) = ((1.-tem)*qcdo(i,k+1,n)+tem*
569 & (q1(i,k,n)+q1(i,k+1,n)))/factor