36 SUBROUTINE calmict_new(P1D,T1D,Q1D,C1D,FI1D,FR1D,FS1D,CUREFL, &
37 qw1,qi1,qr1,qs1,dbz1,dbzr1,dbzi1,dbzc1,nlice1,nrain1)
40 use params_mod, only: dbzmin, epsq, tfrz, eps, rd, d608
41 use ctlblk_mod, only: jsta, jend, jsta_2l, jend_2u,im, &
42 ista, iend, ista_2l, iend_2u
43 use cmassi_mod, only: t_ice, rqr_drmin, n0rmin, cn0r_dmrmin, &
44 mdrmin, rqr_drmax, cn0r_dmrmax, mdrmax, n0r0, xmrmin, &
45 xmrmax, massi, cn0r0, mdimin, xmimax, mdimax
49 INTEGER indexs, indexr
51 REAL,
PARAMETER :: cice=1.634e13, cwet=1./.189, cboth=cice/.224, &
52 & NLI_min=1.E3, RFmax=45.259, RQmix=0.1E-3,NSI_max=250.E3
54 real,
dimension(ista_2l:iend_2u,jsta_2l:jend_2u),
intent(in) :: p1d,t1d,q1d,c1d,fi1d,fr1d, &
56 real,
dimension(ista_2l:iend_2u,jsta_2l:jend_2u),
intent(inout) :: qw1,qi1,qr1,qs1,dbz1,dbzr1,&
57 dbzi1,dbzc1,nlice1,nrain1
60 real :: tc,frain,fice,rimef,xsimass,qice,qsat,esat,wv,rho,rrho, &
61 & RQR,DRmm,Qsigrd,WVQW,Dum,XLi,Qlice,WC,DLI,NLImax,NSImax, &
62 & RQLICE, N0r,Ztot,Zrain,Zice,Zconv,Zmin,Zmix,NLICE,NSmICE, &
63 & QSmICE,NRAIN,NMIX,Zsmice
64 logical :: large_rf, hail
70 zmin=10.**(0.1*dbzmin)
92 IF (c1d(i,j) <= epsq)
THEN
109 IF (tc<=t_ice .OR. fice>=1.)
THEN
112 ELSE IF (fice <= 0.)
THEN
118 IF (qw1(i,j)>0. .AND. frain>0.)
THEN
119 IF (frain >= 1.)
THEN
123 qr1(i,j)=frain*qw1(i,j)
124 qw1(i,j)=qw1(i,j)-qr1(i,j)
127 wv=q1d(i,j)/(1.-q1d(i,j))
131 esat=1000.*
fpvs(t1d(i,j))
132 qsat=eps*esat/(p1d(i,j)-esat)
133 rho=p1d(i,j)/(rd*t1d(i,j)*(1.+d608*q1d(i,j)))
139 IF (qr1(i,j) > epsq)
THEN
141 IF (rqr <= rqr_drmin)
THEN
142 n0r=max(n0rmin, cn0r_dmrmin*rqr)
144 ELSE IF (rqr >= rqr_drmax)
THEN
149 indexr=max( xmrmin, min(cn0r0*rqr**.25, xmrmax) )
154 drmm=1.e-3*
REAL(indexr)
158 nrain=n0r*1.e-6*
REAL(indexr)
160 zrain=0.72*n0r*drmm*drmm*drmm*drmm*drmm*drmm*drmm
167 IF (qi1(i,j) > epsq)
THEN
191 nsimax=max(nsi_max,0.1*rho*qice/massi(mdimin) )
196 nsmice=min(0.01*exp(-0.6*tc), nsimax)
197 dum=rrho*massi(mdimin)
198 nsmice=min(nsmice, qice/dum)
201 qlice=max(0., qice-qsmice)
204 rimef=amax1(1., fs1d(i,j) )
205 rimef=min(rimef, rfmax)
207 dum=xmimax*exp(.0536*tc)
208 indexs=min(mdimax, max(mdimin, int(dum) ) )
218 nlimax=10.e3*exp(-0.017*dum)
220 nlice=rqlice/(rimef*massi(indexs))
221 dum=nli_min*massi(mdimin)
222 new_nlice:
IF (rqlice<dum)
THEN
223 nlice=rqlice/massi(mdimin)
224 ELSE IF (nlice<nli_min .OR. nlice>nlimax)
THEN new_nlice
229 nlice=max(nli_min, min(nlimax, nlice) )
230 xli=rqlice/(nlice*rimef)
231 new_size:
IF (xli <= massi(mdimin) )
THEN
233 ELSE IF (xli <= massi(450) )
THEN new_size
234 dli=9.5885e5*xli**.42066
235 indexs=min(mdimax, max(mdimin, int(dli) ) )
236 ELSE IF (xli <= massi(mdimax) )
THEN new_size
237 dli=3.9751e6*xli**.49870
238 indexs=min(mdimax, max(mdimin, int(dli) ) )
241 IF (large_rf) hail=.true.
243 no_hail:
IF (.NOT. hail)
THEN
244 nlice=rqlice/(rimef*massi(indexs))
258 IF (nsmice > 0.)
THEN
259 zsmice=cice*rho*rho*qsmice*qsmice/nsmice
261 if (nlice1(i,j) /= 0.0) zice=cice*rqlice*rqlice/nlice1(i,j)
262 IF (tc>=0.) zice=cwet*zice
268 dbz_mix:
IF (rqr>rqmix .AND. rqlice>rqmix)
THEN
275 zmix=cboth*dum*dum/nmix
276 IF (zmix > zrain+zice)
THEN
288 ztot=zrain+zice+zconv
289 IF (ztot > zmin) dbz1(i,j)= 10.*alog10(ztot)
290 IF (zrain > zmin) dbzr1(i,j)=10.*alog10(zrain)
291 IF (zice > zmin) dbzi1(i,j)=10.*alog10(zice)
293 IF (zconv > zmin) dbzc1(i,j)=10.*alog10(zconv)
303 qw1,qi1,qr1,qs1,dbz1,dbzr1,dbzi1,dbzc1,nlice1,nrain1)
337 use params_mod, only: dbzmin, epsq, tfrz, eps, rd, d608, oneps, nlimin
338 use ctlblk_mod, only: jsta, jend, jsta_2l, jend_2u, im, &
339 ista, iend, ista_2l, iend_2u
341 use cmassi_mod, only: t_ice, rqr_drmin, n0rmin, cn0r_dmrmin, mdrmin, &
342 rqr_drmax,cn0r_dmrmax, mdrmax, n0r0, xmrmin, xmrmax,flarge2, &
343 massi, cn0r0, mdimin, xmimax, mdimax,nlimax
347 INTEGER indexs, indexr
348 REAL,
PARAMETER :: cice=1.634e13
350 real,
dimension(ista_2l:iend_2u,jsta_2l:jend_2u),
intent(in) :: p1d,t1d,q1d,c1d,fi1d,fr1d, &
352 real,
dimension(ista_2l:iend_2u,jsta_2l:jend_2u),
intent(inout) :: qw1,qi1,qr1,qs1,dbz1,dbzr1,&
353 dbzi1,dbzc1,nlice1,nrain1
355 REAL n0r,ztot,zrain,zice,zconv,zmin
357 real tc, frain,fice,flimass,flarge, &
358 fsmall,rimef,xsimass,qice,qsat,esat,wv,rho,rrho,rqr, &
359 drmm,qsigrd,wvqw,dum,xli,qlice,wc,dli,xlimass
360 real,
external ::
fpvs
365 zmin=10.**(0.1*dbzmin)
385 IF (c1d(i,j) <= epsq)
THEN
402 IF (tc<=t_ice .OR. fice>=1.)
THEN
405 ELSE IF (fice <= 0.)
THEN
411 IF (qw1(i,j)>0. .AND. frain>0.)
THEN
412 IF (frain >= 1.)
THEN
416 qr1(i,j)=frain*qw1(i,j)
417 qw1(i,j)=qw1(i,j)-qr1(i,j)
420 wv=q1d(i,j)/(1.-q1d(i,j))
424 esat=1000.*
fpvs(t1d(i,j))
425 qsat=eps*esat/(p1d(i,j)-esat)
426 rho=p1d(i,j)/(rd*t1d(i,j)*(1.+d608*q1d(i,j)))
431 IF (qr1(i,j) > epsq)
THEN
433 IF (rqr <= rqr_drmin)
THEN
434 n0r=max(n0rmin, cn0r_dmrmin*rqr)
436 ELSE IF (rqr >= rqr_drmax)
THEN
441 indexr=max( xmrmin, min(cn0r0*rqr**.25, xmrmax) )
446 drmm=1.e-3*
REAL(indexr)
447 zrain=0.72*n0r*drmm*drmm*drmm*drmm*drmm*drmm*drmm
451 nrain1(i,j)=n0r*1.e-6*
REAL(indexr)
457 IF (qi1(i,j) > epsq)
THEN
459 rho=p1d(i,j)/(rd*t1d(i,j)*(1.+oneps*q1d(i,j)))
477 IF (tc>=0. .OR. wvqw<qsigrd)
THEN
483 fsmall=(1.-flarge)/flarge
484 xsimass=rrho*massi(mdimin)*fsmall
485 dum=xmimax*exp(.0536*tc)
486 indexs=min(mdimax, max(mdimin, int(dum) ) )
487 rimef=amax1(1., fs1d(i,j) )
488 xlimass=rrho*rimef*massi(indexs)
489 flimass=xlimass/(xlimass+xsimass)
491 nlice1(i,j)=qlice/xlimass
492 IF (nlice1(i,j)<nlimin .OR. nlice1(i,j)>nlimax)
THEN
496 dum=max(nlimin, min(nlimax, nlice1(i,j)) )
497 xli=rho*(qice/dum-xsimass)/rimef
498 IF (xli <= massi(mdimin) )
THEN
500 ELSE IF (xli <= massi(450) )
THEN
501 dli=9.5885e5*xli**.42066
502 indexs=min(mdimax, max(mdimin, int(dli) ) )
503 ELSE IF (xli <= massi(mdimax) )
THEN
504 dli=3.9751e6*xli**.49870
505 indexs=min(mdimax, max(mdimin, int(dli) ) )
514 rimef=rho*(qice/nlimax-xsimass)/massi(indexs)
516 xlimass=rrho*rimef*massi(indexs)
517 flimass=xlimass/(xlimass+xsimass)
519 nlice1(i,j)=qlice/xlimass
521 qs1(i,j)=amin1(qi1(i,j), qlice)
522 qi1(i,j)=amax1(0., qi1(i,j)-qs1(i,j))
533 zice=cice*rho*rho*qlice*qlice/nlice1(i,j)
537 10 ztot=zrain+zice+zconv
538 IF (ztot > zmin) dbz1(i,j)= 10.*alog10(ztot)
539 IF (zrain > zmin) dbzr1(i,j)=10.*alog10(zrain)
540 IF (zice > zmin) dbzi1(i,j)=10.*alog10(zice)
541 IF (zconv > zmin) dbzc1(i,j)=10.*alog10(zconv)
subroutine calmict_old(P1D, T1D, Q1D, C1D, FI1D, FR1D, FS1D, CUREFL, QW1, QI1, QR1, QS1, DBZ1, DBZR1, DBZI1, DBZC1, NLICE1, NRAIN1)