9515 & (nx,ny,nz,na,jyslab &
9516 & ,nor,norz,dtp,nxi &
9523 & ,ssfilt,t00,t77,flag_qndrop &
9530 integer :: nx,ny,nz,na,nxi
9531 integer :: nor,norz, jyslab
9533 logical :: flag_qndrop
9535 integer,
parameter :: ng1 = 1
9541 real t00(-nor+1:nx+nor,-nor+1:ny+nor,-norz+1:nz+norz)
9542 real t77(-nor+1:nx+nor,-nor+1:ny+nor,-norz+1:nz+norz)
9544 real t0(-nor+1:nx+nor,-nor+1:ny+nor,-norz+1:nz+norz)
9553 real t9(-nor+1:nx+nor,-nor+1:ny+nor,-norz+1:nz+norz)
9556 real p2(-nor+1:nx+nor,-nor+1:ny+nor,-norz+1:nz+norz)
9557 real pn(-nor+1:nx+nor,-nor+1:ny+nor,-norz+1:nz+norz)
9558 real an(-nor+1:nx+nor,-nor+1:ny+nor,-norz+1:nz+norz,na)
9559 real dn(-nor+1:nx+nor,-nor+1:ny+nor,-norz+1:nz+norz)
9561 real w(-nor+1:nx+nor,-nor+1:ny+nor,-norz+1:nz+norz)
9564 real ssfilt(-nor+1:nx+nor,-nor+1:ny+nor,-norz+1:nz+norz)
9567 real pb(-norz+ng1:nz+norz)
9568 real pinit(-norz+ng1:nz+norz)
9570 real dz3d(-nor+1:nx+nor,-nor+1:ny+nor,-norz+1:nz+norz)
9576 real axtra(-nor+ng1:nx+nor,-nor+ng1:ny+nor,-norz+ng1:nz+norz,nxtra)
9580 real :: ccnefactwo, sstmp, cn1, cnuctmp
9585 real,
parameter :: cwmas30 = 1000.*0.523599*(2.*30.e-6)**3
9586 real,
parameter :: cwmas20 = 1000.*0.523599*(2.*20.e-6)**3
9587 integer nxmpb,nzmpb,nxz
9588 integer mgs,ngs,numgs,inumgs
9589 integer ngscnt,igs(ngs),kgs(ngs)
9590 integer kgsp(ngs),kgsm(ngs)
9593 integer ix,kz,i,n, kp1, km1
9595 integer ixb,ixe,jyb,jye,kzb,kze
9597 integer itile,jtile,ktile
9598 integer ixend,jyend,kzend,kzbeg
9599 integer nxend,nyend,nzend,nzbeg
9606 real ccnc(ngs), ccna(ngs), cnuc(ngs), cwnccn(ngs)
9607 real :: ccnc_nu(ngs), ccnc_ac(ngs), ccnc_co(ngs)
9610 parameter( sscb = 2.0 )
9612 parameter( idecss = 1 )
9618 parameter( ifilt = 0 )
9628 real,
parameter :: aa1 = 9.44e15, aa2 = 5.78e3
9630 real ec0, ex1, ft, rhoinv(ngs)
9634 real ac1,bc, taus, c1,d1,e1,f1,p380,tmp,tmp2
9635 real tmpmx, fw, qctmp
9637 double precision :: vent1,vent2
9641 real d1r, d1i, d1s, e1i
9643 real dtcon,dtcon1,dtcon2
9645 integer ltemq1,ltemq1m
9646 real dqv,qv1,ss1,ss2,qvs1,dqvs,dtemp,dt1
9648 real ssi1, ssi2, dqvi, dqvis, dqvii,qis1
9649 real dqvr, dqc, dqr, dqi, dqs
9650 real qv1m,qvs1m,ss1m,ssi1m,qis1m
9654 real cn(ngs), cnuf(ngs)
9663 real ssf(ngs),ssfkp1(ngs),ssfkm1(ngs),ssat0(ngs)
9664 real,
parameter :: ssfcut = 4.0
9665 real ssfjp1(ngs),ssfjm1(ngs)
9666 real ssfip1(ngs),ssfim1(ngs)
9669 parameter(supcb=0.5,supmx=238.0)
9670 real r2dxm, r2dym, r2dzm
9671 real dssdz, dssdy, dssdx
9674 parameter(epsi = 0.622, d = 0.266)
9677 real vr,nrx,qr,z1,z2,rdi,alp,xnutmp,xnuc
9684 real dqvcnd(ngs),dqwv(ngs),dqcw(ngs),dqci(ngs)
9685 real temp(ngs),tempc(ngs)
9686 real temg(ngs),temcg(ngs),theta(ngs),qvap(ngs)
9687 real temgx(ngs),temcgx(ngs)
9688 real qvs(ngs),qis(ngs),qss(ngs),pqs(ngs)
9689 real felv(ngs),felf(ngs),fels(ngs)
9690 real felvcp(ngs),felvpi(ngs)
9691 real gamw(ngs),gams(ngs)
9692 real tsqr(ngs),ssi(ngs),ssw(ngs)
9693 real cc3(ngs),cqv1(ngs),cqv2(ngs)
9694 real qcwtmp(ngs),qtmp
9697 real fwvdf(ngs),ftka(ngs),fthdf(ngs)
9698 real fadvisc(ngs),fakvisc(ngs)
9699 real fci(ngs),fcw(ngs)
9700 real fschm(ngs),fpndl(ngs)
9702 real pres(ngs),pipert(ngs)
9704 real rho0(ngs),pi0(ngs)
9706 real thetap(ngs),theta0(ngs),qwvp(ngs),qv0(ngs)
9710 real wvel(ngs),wvelkm1(ngs)
9712 real wvdf(ngs),tka(ngs)
9718 real :: qx(ngs,lv:lhab)
9719 real :: cx(ngs,lc:lhab)
9720 real :: xv(ngs,lc:lhab)
9721 real :: xmas(ngs,lc:lhab)
9722 real :: xdn(ngs,lc:lhab)
9723 real :: xdia(ngs,lc:lhab,3)
9724 real :: alpha(ngs,lc:lhab)
9725 real :: zx(ngs,lr:lhab)
9728 logical zerocx(lc:lqmx)
9732 integer,
parameter :: iunit = 0
9734 real :: frac, hwdn, tmpg
9738 real,
parameter :: cpv = 1885.0
9757 IF ( ac_opt > 0 ) ccnefactwo = (1.63e-3/(cck * beta(3./2., cck/2.)))**(1.0/(cck + 2.0))
9758 f5 = 237.3 * 17.27 * 2.5e6 / cp
9765 IF ( ipconc <= 1 .or. isedonly == 2 )
GOTO 2200
9778 temp1 = an(ix,jy,kz,lt)*t77(ix,jy,kz)
9779 t0(ix,jy,kz) = temp1
9780 ltemq = int( (temp1-163.15)/fqsat+1.5 )
9781 ltemq = min( nqsat, max(1,ltemq) )
9783 c1 = t00(ix,jy,kz)*tabqvs(ltemq)
9786 ssfilt(ix,jy,kz) = 100.*(an(ix,jy,kz,lv)/c1 - 1.0)
9802 if ( ndebug .gt. 0 )
write(0,*)
'ICEZVD_DR: Gather stage'
9810 do 2000 inumgs = 1,numgs
9825 pqs(1) = 380.0/(pn(ix,jy,kz) + pb(kz))
9826 theta(1) = an(ix,jy,kz,lt)
9827 temg(1) = t0(ix,jy,kz)
9829 temcg(1) = temg(1) - tfr
9830 ltemq = (temg(1)-163.15)/fqsat+1.5
9831 ltemq = min( nqsat, max(1,ltemq) )
9832 qvs(1) = pqs(1)*tabqvs(ltemq)
9833 qis(1) = pqs(1)*tabqis(ltemq)
9838 if ( temg(1) .lt. tfr )
then
9841 if ( (temg(1) .gt. tfrh .or. an(ix,jy,kz,lv)/qvs(1) > maxlowtempss ) .and. &
9842 & ( an(ix,jy,kz,lv) .gt. qss(1) .or. &
9843 & an(ix,jy,kz,lc) .gt. qxmin(lc) .or. &
9844 & ( an(ix,jy,kz,lr) .gt. qxmin(lr) .and. rcond == 2 ) &
9849 if ( ngscnt .eq. ngs )
goto 2100
9859 if ( ngscnt .eq. 0 )
go to 29998
9861 if (ndebug .gt. 0 )
write(0,*)
'ICEZVD_DR: dbg = 8'
9873 IF ( imurain == 1 )
THEN
9874 alpha(:,lr) = alphar
9875 ELSEIF ( imurain == 3 )
THEN
9876 alpha(:,lr) = xnu(lr)
9883 qx(mgs,lv) = an(igs(mgs),jy,kgs(mgs),lv)
9885 qx(mgs,il) = max(an(igs(mgs),jy,kgs(mgs),il), 0.0)
9888 qcwtmp(mgs) = qx(mgs,lc)
9891 theta0(mgs) = an(igs(mgs),jy,kgs(mgs),lt)
9893 theta(mgs) = an(igs(mgs),jy,kgs(mgs),lt)
9894 qv0(mgs) = qx(mgs,lv)
9895 qwvp(mgs) = qx(mgs,lv) - qv0(mgs)
9897 pres(mgs) = pn(igs(mgs),jy,kgs(mgs)) + pb(kgs(mgs))
9898 pipert(mgs) = p2(igs(mgs),jy,kgs(mgs))
9899 rho0(mgs) = dn(igs(mgs),jy,kgs(mgs))
9900 rhoinv(mgs) = 1.0/rho0(mgs)
9901 rhovt(mgs) = sqrt(rho00/rho0(mgs))
9902 pi0(mgs) = p2(igs(mgs),jy,kgs(mgs)) + pinit(kgs(mgs))
9903 temg(mgs) = t0(igs(mgs),jy,kgs(mgs))
9905 pk(mgs) = p2(igs(mgs),jy,kgs(mgs)) + pinit(kgs(mgs))
9906 temcg(mgs) = temg(mgs) - tfr
9907 qss0(mgs) = (380.0)/(pres(mgs))
9908 pqs(mgs) = (380.0)/(pres(mgs))
9909 ltemq = (temg(mgs)-163.15)/fqsat+1.5
9910 ltemq = min( nqsat, max(1,ltemq) )
9911 qvs(mgs) = pqs(mgs)*tabqvs(ltemq)
9912 qis(mgs) = pqs(mgs)*tabqis(ltemq)
9914 qvap(mgs) = max( (qwvp(mgs) + qv0(mgs)), 0.0 )
9915 es(mgs) = 6.1078e2*tabqvs(ltemq)
9919 temgx(mgs) = min(temg(mgs),313.15)
9920 temgx(mgs) = max(temgx(mgs),233.15)
9921 felv(mgs) = 2500837.367 * (273.15/temgx(mgs))**((0.167)+(3.67e-4)*temgx(mgs))
9923 IF ( eqtset <= 1 )
THEN
9924 felvcp(mgs) = felv(mgs)*cpi
9926 tmp = qx(mgs,li)+qx(mgs,ls)+qx(mgs,lh)
9927 IF ( lhl > 1 ) tmp = tmp + qx(mgs,lhl)
9928 IF ( lf > 1 ) tmp = tmp + qx(mgs,lf)
9929 cvm = cv+cvv*qx(mgs,lv)+cpl*(qx(mgs,lc)+qx(mgs,lr)) &
9931 cpm = cp+cpv*qx(mgs,lv)+cpl*(qx(mgs,lc)+qx(mgs,lr)) &
9933 rmm=rd+rw*qx(mgs,lv)
9935 IF ( eqtset == 2 )
THEN
9937 felvcp(mgs) = (felv(mgs)-rw*temg(mgs))/cvm
9940 felvcp(mgs) = (felv(mgs)*cv/(cp) - rw*temg(mgs)*(1.0-rovcp*cpm/rmm))/cvm
9941 felvpi(mgs) = pi0(mgs)*rovcp*(felv(mgs)/(temg(mgs)) - rw*cpm/rmm)/cvm
9946 temcgx(mgs) = min(temg(mgs),273.15)
9947 temcgx(mgs) = max(temcgx(mgs),223.15)
9948 temcgx(mgs) = temcgx(mgs)-273.15
9949 felf(mgs) = 333690.6098 + (2030.61425)*temcgx(mgs) - (10.46708312)*temcgx(mgs)**2
9951 fels(mgs) = felv(mgs) + felf(mgs)
9952 fcqv1(mgs) = 4098.0258*felv(mgs)*cpi
9954 wvdf(mgs) = (2.11e-05)*((temg(mgs)/tfr)**1.94)* &
9955 & (101325.0/(pb(kgs(mgs)) + pn(igs(mgs),jgs,kgs(mgs))))
9956 advisc(mgs) = advisc0*(416.16/(temg(mgs)+120.0))* &
9957 & (temg(mgs)/296.0)**(1.5)
9958 tka(mgs) = tka0*advisc(mgs)/advisc1
9968 if ( ipconc .ge. 1 )
then
9970 cx(mgs,li) = max(an(igs(mgs),jy,kgs(mgs),lni), 0.0)
9973 if ( ipconc .ge. 2 )
then
9975 cx(mgs,lc) = max(an(igs(mgs),jy,kgs(mgs),lnc), 0.0)
9976 cwnccn(mgs) = cwccn*rho0(mgs)/rho00
9979 ssmax(mgs) = an(igs(mgs),jy,kgs(mgs),lss)
9983 IF ( lccn .gt. 1 .and. ac_opt == 0 )
THEN
9984 IF ( lccnuf .gt. 1 .and. i_uf_or_ccn > 0 )
THEN
9985 ccnc(mgs) = an(igs(mgs),jy,kgs(mgs),lccn) + an(igs(mgs),jy,kgs(mgs),lccnuf)
9987 ccnc(mgs) = an(igs(mgs),jy,kgs(mgs),lccn)
9990 ccnc(mgs) = cwnccn(mgs)
9992 IF ( lccnuf .gt. 1 .and. i_uf_or_ccn == 0 )
THEN
9993 ccncuf(mgs) = an(igs(mgs),jy,kgs(mgs),lccnuf)
9998 IF ( lccna > 1 )
THEN
9999 ccna(mgs) = an(igs(mgs),jy,kgs(mgs),lccna)
10001 IF ( lccn > 1 )
THEN
10002 ccna(mgs) = cwnccn(mgs) - ccnc(mgs)
10004 ccna(mgs) = cx(mgs,lc)
10009 if ( ipconc .ge. 3 )
then
10011 cx(mgs,lr) = max(an(igs(mgs),jy,kgs(mgs),lnr), 0.0)
10018 IF ( irenuc /= 6 )
THEN
10019 cnuc(mgs) = max(ccnc(mgs),cwnccn(mgs))*(1. - renucfrac) + ccnc(mgs)*renucfrac
10021 cnuc(mgs) = max(ccnc(mgs),cwnccn(mgs))*(1. - renucfrac) + max(0.0,ccnc(mgs) - ccna(mgs))*renucfrac
10023 IF ( renucfrac >= 0.999 )
THEN
10024 IF ( temg(mgs) < 265. )
THEN
10025 IF ( qx(mgs,lc) > 10.*qxmin(lc) .and. w(igs(mgs),jgs,kgs(mgs)) > 2.0 )
THEN
10028 cnuc(mgs) = 0.1*cnuc(mgs)
10036 if (ndebug .gt. 0 )
write(0,*)
'ICEZVD_DR: Set density'
10039 xdn(mgs,lc) = xdn0(lc)
10040 xdn(mgs,lr) = xdn0(lr)
10044 ventrxn(:) = ventrn
10049 IF ( lzr > 1 .and. rcond == 2 )
THEN
10051 zx(mgs,lr) = max(an(igs(mgs),jy,kgs(mgs),lzr), 0.0)
10058 IF ( zx(mgs,il) <= zxmin )
THEN
10059 qx(mgs,lv) = qx(mgs,lv) + qx(mgs,il)
10062 an(igs(mgs),jgs,kgs(mgs),lv) = an(igs(mgs),jgs,kgs(mgs),lv) + an(igs(mgs),jgs,kgs(mgs),il)
10063 an(igs(mgs),jgs,kgs(mgs),il) = qx(mgs,il)
10064 an(igs(mgs),jgs,kgs(mgs),ln(il)) = cx(mgs,il)
10065 ELSEIF ( cx(mgs,il) <= 0.0 )
THEN
10066 qx(mgs,lv) = qx(mgs,lv) + qx(mgs,il)
10069 an(igs(mgs),jgs,kgs(mgs),lv) = an(igs(mgs),jgs,kgs(mgs),lv) + an(igs(mgs),jgs,kgs(mgs),il)
10070 an(igs(mgs),jgs,kgs(mgs),il) = qx(mgs,il)
10071 an(igs(mgs),jgs,kgs(mgs),lz(il)) = zx(mgs,il)
10074 IF ( qx(mgs,lr) .gt. qxmin(lr) )
THEN
10076 xv(mgs,lr) = rho0(mgs)*qx(mgs,lr)/(xdn(mgs,lr)*max(1.0e-11,cx(mgs,lr)))
10077 IF ( xv(mgs,lr) .gt. xvmx(lr) )
THEN
10078 xv(mgs,lr) = xvmx(lr)
10079 cx(mgs,lr) = rho0(mgs)*qx(mgs,lr)/(xvmx(lr)*xdn(mgs,lr))
10080 ELSEIF ( xv(mgs,lr) .lt. xvmn(lr) )
THEN
10081 xv(mgs,lr) = xvmn(lr)
10082 cx(mgs,lr) = rho0(mgs)*qx(mgs,lr)/(xvmn(lr)*xdn(mgs,lr))
10085 IF ( zx(mgs,il) > 0.0 .and. cx(mgs,il) <= 0.0 )
THEN
10087 IF ( imurain == 3 )
THEN
10088 g1 = 36.*(alpha(mgs,lr)+2.0)/((alpha(mgs,lr)+1.0)*pi**2)
10091 cx(mgs,il) = g1*dn(igs(mgs),jy,kgs(mgs))**2*(qr)*qr/(z1*1000.*1000)
10093 g1 = 36.*(6.0 + alpha(mgs,il))*(5.0 + alpha(mgs,il))*(4.0 + alpha(mgs,il))/ &
10094 & ((3.0 + alpha(mgs,il))*(2.0 + alpha(mgs,il))*(1.0 + alpha(mgs,il))*pi**2)
10097 cx(mgs,il) = g1*dn(igs(mgs),jy,kgs(mgs))**2*(qr)*qr/(z1*1000.*1000)
10101 ELSEIF ( zx(mgs,il) <= zxmin .and. cx(mgs,il) > 0.0 )
THEN
10103 IF ( imurain == 3 )
THEN
10104 g1 = 36.*(alpha(mgs,lr)+2.0)/((alpha(mgs,lr)+1.0)*pi**2)
10107 zx(mgs,il) = g1*dn(igs(mgs),jy,kgs(mgs))**2*(qr)*qr/(chw*1000.*1000)
10109 g1 = 36.*(6.0 + alpha(mgs,il))*(5.0 + alpha(mgs,il))*(4.0 + alpha(mgs,il))/ &
10110 & ((3.0 + alpha(mgs,il))*(2.0 + alpha(mgs,il))*(1.0 + alpha(mgs,il))*pi**2)
10113 zx(mgs,il) = g1*dn(igs(mgs),jy,kgs(mgs))**2*(qr)*qr/(chw*1000.*1000)
10117 ELSEIF ( zx(mgs,il) <= zxmin .and. cx(mgs,il) <= 0.0 )
THEN
10121 zx(mgs,il) = 1.e-19/0.224*(xdn0(lr)/xdn0(il))**2
10122 an(igs(mgs),jgs,kgs(mgs),lz(il)) = zx(mgs,il)
10124 IF ( imurain == 3 )
THEN
10125 g1 = 36.*(alpha(mgs,lr)+2.0)/((alpha(mgs,lr)+1.0)*pi**2)
10128 cx(mgs,il) = g1*dn(igs(mgs),jy,kgs(mgs))**2*(qr)*qr/(z1*1000.*1000)
10129 an(igs(mgs),jgs,kgs(mgs),ln(il)) = cx(mgs,il)
10130 ELSEIF ( imurain == 1 )
THEN
10131 g1 = (6.0 + alpha(mgs,il))*(5.0 + alpha(mgs,il))*(4.0 + alpha(mgs,il))/ &
10132 & ((3.0 + alpha(mgs,il))*(2.0 + alpha(mgs,il))*(1.0 + alpha(mgs,il)))
10135 cx(mgs,il) = g1*dn(igs(mgs),jy,kgs(mgs))**2*(6*qr)**2/(z1*(pi*xdn(mgs,il))**2)
10136 an(igs(mgs),jgs,kgs(mgs),ln(il)) = cx(mgs,il)
10141 IF ( zx(mgs,lr) > 0.0 )
THEN
10142 vr = rho0(mgs)*qx(mgs,lr)/(1000.*cx(mgs,lr))
10153 IF ( z1 .gt. 0.0 )
THEN
10155 IF ( imurain == 3 )
THEN
10156 alp = 36.*(alpha(mgs,lr)+2.0)*nrx*vr**2/(z1*pi**2) - 1.
10159 IF ( abs(alp - alpha(mgs,lr)) .lt. 0.01 )
EXIT
10160 alpha(mgs,lr) = max( rnumin, min( rnumax, alp ) )
10161 alp = 36.*(alpha(mgs,lr)+2.0)*nrx*vr**2/(z1*pi**2) - 1.
10163 alp = max( rnumin, min( rnumax, alp ) )
10167 g1 = 36.*(6.0 + alpha(mgs,il))*(5.0 + alpha(mgs,il))*(4.0 + alpha(mgs,il))/ &
10168 & ((3.0 + alpha(mgs,il))*(2.0 + alpha(mgs,il))*(1.0 + alpha(mgs,il))*pi**2)
10170 rd1 = z1*(pi/6.*xdn(mgs,il))**2*nrx/(rho0(mgs)*qr)**2
10172 alp = (6.+alpha(mgs,il))*(5.0+alpha(mgs,il))*(4.0+alpha(mgs,il))/ &
10173 & ((3.0+alpha(mgs,il))*(2.0+alpha(mgs,il))*rd1) - 1.0
10176 IF ( abs(alp - alpha(mgs,il)) .lt. 0.01 )
EXIT
10177 alpha(mgs,il) = max( alphamin, min( alphamax, alp ) )
10179 alp = (6.+alpha(mgs,il))*(5.0+alpha(mgs,il))*(4.0+alpha(mgs,il))/ &
10180 & ((3.0+alpha(mgs,il))*(2.0+alpha(mgs,il))*rd1) - 1.0
10182 alp = max( alphamin, min( alphamax, alp ) )
10193 IF ( imurain == 3 )
THEN
10194 IF ( .true. .and. (alpha(mgs,il) <= rnumin .or. alp == rnumin .or. alp == rnumax) )
THEN
10196 IF ( rescale_high_alpha .and. alp >= rnumax - 0.01 )
THEN
10197 g1 = 36.*(alpha(mgs,lr)+2.0)/((alpha(mgs,lr)+1.0)*pi**2)
10198 cx(mgs,il) = g1*dn(igs(mgs),jy,kgs(mgs))**2*(qr)*qr/z1*(1./(xdn(mgs,il)))**2
10199 an(igs(mgs),jy,kgs(mgs),ln(il)) = cx(mgs,il)
10201 ELSEIF ( rescale_low_alphar .and. alp <= rnumin )
THEN
10203 z1 = 36.*(alpha(mgs,lr)+2.0)*nrx*vr**2/((alpha(mgs,lr)+1.0)*pi**2)
10208 ELSEIF ( imurain == 1 )
THEN
10210 g1 = (6.0 + alpha(mgs,il))*(5.0 + alpha(mgs,il))*(4.0 + alpha(mgs,il))/ &
10211 & ((3.0 + alpha(mgs,il))*(2.0 + alpha(mgs,il))*(1.0 + alpha(mgs,il)))
10213 IF ( (rescale_low_alpha .or. rescale_high_alpha ) .and. &
10214 & ( alpha(mgs,il) <= alphamin .or. alp == alphamin .or. alp == alphamax ) )
THEN
10218 IF ( rescale_high_alpha .and. alp >= alphamax - 0.01 )
THEN
10219 cx(mgs,il) = g1*rho0(mgs)**2*(qr)*qr/zx(mgs,lr)*(6./(pi*xdn(mgs,il)))**2
10220 an(igs(mgs),jy,kgs(mgs),ln(il)) = cx(mgs,il)
10222 ELSEIF ( rescale_low_alpha .and. alp <= alphamin )
THEN
10223 z1 = g1*rho0(mgs)**2*(qr)*qr/nrx
10224 z2 = z1*(6./(pi*xdn(mgs,il)))**2
10226 an(igs(mgs),jy,kgs(mgs),lz(il)) = z2
10232 tmp = alpha(mgs,lr) + 4./3.
10233 i = int(dgami*(tmp))
10235 x = gmoi(i) + (gmoi(i+1) - gmoi(i))*del*dgami
10237 tmp = alpha(mgs,lr) + 1.
10238 i = int(dgami*(tmp))
10240 y = gmoi(i) + (gmoi(i+1) - gmoi(i))*del*dgami
10243 ventrx(mgs) = x/(y*(alpha(mgs,lr) + 1.)**(1./3.))
10245 IF ( imurain == 3 .and. izwisventr == 2 )
THEN
10247 tmp = alpha(mgs,lr) + 1.5 + br/6.
10248 i = int(dgami*(tmp))
10250 x = gmoi(i) + (gmoi(i+1) - gmoi(i))*del*dgami
10253 ventrxn(mgs) = x/(y*(alpha(mgs,lr) + 1.)**((1.+br)/6. + 1./3.))
10255 ELSEIF ( imurain == 1 .and. iferwisventr == 2 )
THEN
10257 tmp = alpha(mgs,lr) + 2.5 + br/2.
10258 i = int(dgami*(tmp))
10260 x = gmoi(i) + (gmoi(i+1) - gmoi(i))*del*dgami
10283 kp1 = min(nz, kgs(mgs)+1 )
10284 wvel(mgs) = (0.5)*(w(igs(mgs),jgs,kp1) &
10285 & +w(igs(mgs),jgs,kgs(mgs)))
10286 wvelkm1(mgs) = (0.5)*(w(igs(mgs),jgs,kgs(mgs)) &
10287 & +w(igs(mgs),jgs,max(1,kgs(mgs)-1)))
10289 ssat0(mgs) = ssfilt(igs(mgs),jgs,kgs(mgs))
10290 ssf(mgs) = ssfilt(igs(mgs),jgs,kgs(mgs))
10294 ssfkp1(mgs) = ssfilt(igs(mgs),jgs,min(nz-1,kgs(mgs)+1))
10295 ssfkm1(mgs) = ssfilt(igs(mgs),jgs,max(1,kgs(mgs)-1))
10308 if ( ndebug .gt. 0 )
write(0,*)
'ICEZVD_DR: Set cloud water variables'
10312 IF ( ipconc .ge. 2 .and. cx(mgs,lc) .gt. 1.0e6 )
THEN
10314 & min( max(qx(mgs,lc)*rho0(mgs)/cx(mgs,lc),cwmasn),cwmasx )
10315 xv(mgs,lc) = xmas(mgs,lc)/xdn(mgs,lc)
10317 IF ( qx(mgs,lc) .gt. qxmin(lc) .and. cx(mgs,lc) .gt. cxmin )
THEN
10319 & min( max(qx(mgs,lc)*rho0(mgs)/cx(mgs,lc),xdn(mgs,lc)*xvmn(lc)), &
10320 & xdn(mgs,lc)*xvmx(lc) )
10322 cx(mgs,lc) = qx(mgs,lc)*rho0(mgs)/xmas(mgs,lc)
10324 ELSEIF ( qx(mgs,lc) .gt. qxmin(lc) .and. cx(mgs,lc) .le. cxmin )
THEN
10327 cx(mgs,lc) = max( cxmin, rho0(mgs)*qx(mgs,lc)/cwmasx )
10329 & min( max(qx(mgs,lc)*rho0(mgs)/cx(mgs,lc),cwmasn),cwmasx )
10330 xv(mgs,lc) = xmas(mgs,lc)/xdn(mgs,lc)
10333 xmas(mgs,lc) = cwmasn
10336 xdia(mgs,lc,1) = (xmas(mgs,lc)*cwc1)**c1f3
10344 if ( qx(mgs,lr) .gt. qxmin(lr) )
then
10346 if ( ipconc .ge. 3 )
then
10347 xv(mgs,lr) = rho0(mgs)*qx(mgs,lr)/(xdn(mgs,lr)*max(1.0e-9,cx(mgs,lr)))
10349 IF ( xv(mgs,lr) .gt. xvmx(lr) )
THEN
10350 xv(mgs,lr) = xvmx(lr)
10351 cx(mgs,lr) = rho0(mgs)*qx(mgs,lr)/(xvmx(lr)*xdn(mgs,lr))
10352 ELSEIF ( xv(mgs,lr) .lt. xvmn(lr) )
THEN
10353 xv(mgs,lr) = xvmn(lr)
10354 cx(mgs,lr) = rho0(mgs)*qx(mgs,lr)/(xvmn(lr)*xdn(mgs,lr))
10357 xmas(mgs,lr) = xv(mgs,lr)*xdn(mgs,lr)
10358 xdia(mgs,lr,3) = (xmas(mgs,lr)*cwc1)**(1./3.)
10359 IF ( imurain == 3 )
THEN
10361 xdia(mgs,lr,1) = xdia(mgs,lr,3)
10363 xdia(mgs,lr,1) = (6.*piinv*xv(mgs,lr)/((alpha(mgs,lr)+3.)*(alpha(mgs,lr)+2.)*(alpha(mgs,lr)+1.)))**(1./3.)
10373 & (qx(mgs,lr)*rho0(mgs)/(pi*xdn(mgs,lr)*cno(lr)))**(0.25)
10376 xdia(mgs,lr,1) = 1.e-9
10389 fadvisc(mgs) = advisc0*(416.16/(temg(mgs)+120.0))* &
10390 & (temg(mgs)/296.0)**(1.5)
10392 fakvisc(mgs) = fadvisc(mgs)*rhoinv(mgs)
10394 fwvdf(mgs) = (2.11e-05)*((temg(mgs)/tfr)**1.94)* &
10395 & (101325.0/(pres(mgs)))
10397 fschm(mgs) = (fakvisc(mgs)/fwvdf(mgs))
10399 fvent(mgs) = (fschm(mgs)**(1./3.)) * (fakvisc(mgs)**(-0.5))
10414 IF ( temg(mgs) .le. tfrh .and. qx(mgs,lv)/qvs(mgs) < maxlowtempss )
THEN
10418 IF( ssat0(mgs) .GT. 0. .OR. ssf(mgs) .GT. 0. )
GO TO 620
10424 IF ( qx(mgs,lc) .LE. 0. )
GO TO 631
10427 r1=1./(1. + caw*(273.15 - cbw)*qss(mgs)*felv(mgs)/ &
10428 & (cp*(temg(mgs) - cbw)**2))
10429 qevap= min( qx(mgs,lc), r1*(qss(mgs)-qvap(mgs)) )
10432 IF ( qx(mgs,lc) <= qevap )
THEN
10433 qwvp(mgs) = qwvp(mgs) + qx(mgs,lc)
10434 thetap(mgs) = thetap(mgs) - felvcp(mgs)*qx(mgs,lc)/(pi0(mgs))
10435 IF ( io_flag .and. nxtra > 1 )
THEN
10436 axtra(igs(mgs),jy,kgs(mgs),1) = -qx(mgs,lc)/dtp
10439 IF ( restoreccn )
THEN
10440 IF ( lccna > 1 )
THEN
10441 ccna(mgs) = ccna(mgs) - restoreccnfrac*cx(mgs,lc)
10442 ELSEIF ( irenuc <= 2 )
THEN
10443 IF ( .not. invertccn )
THEN
10444 ccnc(mgs) = max( ccnc(mgs), min( qccn*rho0(mgs), ccnc(mgs) + restoreccnfrac*cx(mgs,lc) ) )
10446 ccnc(mgs) = ccnc(mgs) + restoreccnfrac*cx(mgs,lc)
10453 qwvp(mgs) = qwvp(mgs) + qevap
10454 qx(mgs,lc) = qx(mgs,lc) - qevap
10455 IF ( qx(mgs,lc) .le. 0. )
THEN
10456 IF ( restoreccn )
THEN
10457 IF ( lccna > 1 )
THEN
10458 ccna(mgs) = ccna(mgs) - restoreccnfrac*cx(mgs,lc)
10459 ELSEIF ( irenuc <= 2 )
THEN
10462 IF ( .not. invertccn )
THEN
10463 ccnc(mgs) = max( ccnc(mgs), min( qccn*rho0(mgs), ccnc(mgs) + restoreccnfrac*cx(mgs,lc) ) )
10465 ccnc(mgs) = ccnc(mgs) + restoreccnfrac*cx(mgs,lc)
10471 tmp = 0.9*qevap*cx(mgs,lc)/qctmp
10472 IF ( restoreccn )
THEN
10473 IF ( lccna > 1 )
THEN
10474 ccna(mgs) = ccna(mgs) - restoreccnfrac*tmp
10475 ELSEIF ( irenuc <= 2 )
THEN
10478 IF ( .not. invertccn )
THEN
10479 ccnc(mgs) = max( ccnc(mgs), min( qccn*rho0(mgs), ccnc(mgs) + restoreccnfrac*tmp ) )
10481 ccnc(mgs) = ccnc(mgs) + restoreccnfrac*tmp
10485 cx(mgs,lc) = cx(mgs,lc) - tmp
10487 thetap(mgs) = thetap(mgs) - felvcp(mgs)*qevap/(pi0(mgs))
10488 IF ( io_flag .and. nxtra > 1 )
THEN
10489 axtra(igs(mgs),jy,kgs(mgs),1) = -qevap/dtp
10501 IF ( qx(mgs,lc) .GT. qxmin(lc) .and. cx(mgs,lc) .ge. 1. )
THEN
10508 ac1 = felv(mgs)**2/(tka(mgs)*rw*temg(mgs)**2)
10514 bc = rw*temg(mgs)/(wvdf(mgs)*es(mgs))
10523 IF ( ssf(mgs) .gt. 0.0 .or. ssat0(mgs) .gt. 0.0 )
THEN
10524 IF ( ny .le. 2 )
THEN
10531 IF ( qx(mgs,lc) .gt. qxmin(lc) )
THEN
10533 IF ( xdia(mgs,lc,1) .le. 0.0 )
THEN
10534 xmas(mgs,lc) = cwmasn
10535 xdia(mgs,lc,1) = (xmas(mgs,lc)*cwc1)**c1f3
10537 d1 = (1./(ac1 + bc))*4.0*pi*ventc &
10538 & *0.5*xdia(mgs,lc,1)*cx(mgs,lc)*rhoinv(mgs)
10544 IF ( rcond .eq. 2 .and. qx(mgs,lr) .gt. qxmin(lr) .and. cx(mgs,lr) > 1.e-9 )
THEN
10545 IF ( imurain == 3 )
THEN
10546 IF ( izwisventr == 1 )
THEN
10547 rwvent(mgs) = ventrx(mgs)*(1.6 + 124.9*(1.e-3*rho0(mgs)*qx(mgs,lr))**.2046)
10551 & (0.78*ventrx(mgs) + 0.308*ventrxn(mgs)*fvent(mgs) &
10552 & *sqrt((ar*rhovt(mgs))) &
10553 & *(xdia(mgs,lr,1)**((1.0+br)/2.0)) )
10558 IF ( iferwisventr == 1 )
THEN
10559 alpr = min(alpharmax,alpha(mgs,lr) )
10564 i = int(dgami*(tmp))
10566 g1palp = gmoi(i) + (gmoi(i+1) - gmoi(i))*del*dgami
10568 tmp = 2.5 + alpr + 0.5*bx(lr)
10569 i = int(dgami*(tmp))
10571 y = (gmoi(i) + (gmoi(i+1) - gmoi(i))*del*dgami)/g1palp
10575 vent1 = dble(xdia(mgs,lr,1))**(0.5 + 0.5*bx(lr))
10576 vent2 = dble(1. + 0.5*fx(lr)*xdia(mgs,lr,1))**dble(2.5+alpr+0.5*bx(lr))
10581 & 0.308*fvent(mgs)*y* &
10582 & sqrt(ax(lr)*rhovt(mgs))*(vent1/vent2)
10584 ELSEIF ( iferwisventr == 2 )
THEN
10587 x = 1. + alpha(mgs,lr)
10590 & (0.78*x + 0.308*ventrxn(mgs)*fvent(mgs) &
10591 & *sqrt((ar*rhovt(mgs))) &
10592 & *(xdia(mgs,lr,1)**((1.0+br)/2.0)) )
10599 d1r = (1./(ac1 + bc))*4.0*pi*rwvent(mgs) &
10600 & *0.5*xdia(mgs,lr,1)*cx(mgs,lr)*rhoinv(mgs)
10606 e1 = felvcp(mgs)/(pi0(mgs))
10612 ltemq = (temg(mgs)-163.15)/fqsat+1.5
10613 ltemq = min( nqsat, max(1,ltemq) )
10616 p380 = 380.0/pres(mgs)
10621 ss1 = qx(mgs,lv)/qvs(mgs)
10638 IF ( abs(ss1 - 1.0) .gt. 1.e-5 )
THEN
10639 delta = 0.5*(qv1-qvs1)/(d1*(ss1 - 1.0))
10646 dtcon1 = min(0.05,0.2*delta)
10647 nc = max(5,2*nint( (dtp-4.0*dtcon1)/delta))
10648 dtcon2 = (dtp-4.0*dtcon1)/nc
10660 rk2c:
DO WHILE ( dt1 .lt. dtp )
10662 IF ( n .le. 4 )
THEN
10667 609 dqv = -(ss1 - 1.)*d1*dtcon
10668 dqvr = -(ss1 - 1.)*d1r*dtcon
10669 dtemp = -0.5*e1*f1*(dqv + dqvr)
10675 ltemq1m = (temp1+dtemp-163.15)*fqsati+1.5
10676 ltemq1m = min( nqsat, max(1,ltemq1m) )
10678 IF ( ltemq1m .lt. 1 .or. ltemq1m .gt. nqsat )
THEN
10679 write(0,*)
'STOP in nucond line 1192 '
10680 write(0,*)
' ltemq1m,icond = ',ltemq1m,icond
10681 write(0,*)
' dtemp,e1,f1,dqv,dqvr = ', dtemp,e1,f1,dqv,dqvr
10682 write(0,*)
' d1,d1r,dtcon,ss1 = ',d1,d1r,dtcon,ss1
10683 write(0,*)
' dqc, dqr = ',dqc,dqr
10684 write(0,*)
' qv,qc,qr = ',qx(mgs,lv)*1000.,qx(mgs,lc)*1000.,qx(mgs,lr)*1000.
10685 write(0,*)
' i, j, k = ',igs(mgs),jy,kgs(mgs)
10686 write(0,*)
' dtcon1,dtcon2,delta = ',dtcon1,dtcon2,delta
10687 write(0,*)
' nc,dtp = ',nc,dtp
10688 write(0,*)
' rwvent,xdia,crw,ccw = ', rwvent(mgs),xdia(mgs,lr,1),cx(mgs,lr),cx(mgs,lc)
10689 write(0,*)
' fvent,alphar = ',fvent(mgs),alpha(mgs,lr)
10690 write(0,*)
' xvr,xmasr,xdnr,cwc1 = ',xv(mgs,lr),xmas(mgs,lr),xdn(mgs,lr),cwc1
10692 dqvs = dtemp*p380*dtabqvs(ltemq1m)
10693 qv1m = qv1 + dqv + dqvr
10696 qvs1m = qvs1 + dqvs
10700 IF ( ss1m .lt. 1. .and. (dqvii + dqvis) .eq. 0.0 )
THEN
10701 dtcon = (0.5*dtcon)
10702 IF ( dtcon .ge. dtcon1 )
THEN
10709 dqv = -(ss1m - 1.)*d1*dtcon
10710 dqvr = -(ss1m - 1.)*d1r*dtcon
10714 dtemp = -e1*f1*(dqv + dqvr)
10719 ltemq1 = (temp1+dtemp-163.15)*fqsati+1.5
10720 ltemq1 = min( nqsat, max(1,ltemq1) )
10722 IF ( ltemq1 .lt. 1 .or. ltemq1 .gt. nqsat )
THEN
10723 write(0,*)
'STOP in nucond line 1230 '
10724 write(0,*)
' ltemq1m,icond = ',ltemq1m,icond
10725 write(0,*)
' dtemp,e1,dqv,dqvr = ', dtemp,e1,dqv,dqvr
10727 dqvs = dtemp*p380*dtabqvs(ltemq1)
10729 qv1 = qv1 + dqv + dqvr
10736 temp1 = temp1 + dtemp
10737 IF ( temp2 .eq. temp1 .or. ss2 .eq. ss1 .or. &
10738 & ss1 .eq. 1.00 .or. &
10739 & ( n .gt. 10 .and. ss1 .lt. 1.0005 ) )
THEN
10752 thetap(mgs) = thetap(mgs) + e1*(dcloud + dqr)
10755 IF ( eqtset > 2 )
THEN
10756 pipert(mgs) = pipert(mgs) + felvpi(mgs)*(dcloud + dqr)
10758 IF ( io_flag .and. nxtra > 1 )
THEN
10759 axtra(igs(mgs),jy,kgs(mgs),1) = dcloud/dtp
10760 axtra(igs(mgs),jy,kgs(mgs),2) = axtra(igs(mgs),jy,kgs(mgs),2) + dqr/dtp
10762 qwvp(mgs) = qwvp(mgs) - (dcloud + dqr)
10763 qx(mgs,lc) = qx(mgs,lc) + dcloud
10764 qx(mgs,lr) = qx(mgs,lr) + dqr
10769 IF ( lzr > 1 .and. rcond == 2 .and. qx(mgs,lr) .gt. qxmin(lr) &
10770 & .and. cx(mgs,lr) .gt. 1.e-9 )
THEN
10771 tmp = qx(mgs,lr)/cx(mgs,lr)
10772 IF ( imurain == 3 )
THEN
10773 g1 = 36.*(alpha(mgs,lr)+2.0)/((alpha(mgs,lr)+1.0)*pi**2)
10775 g1 = 36.*(6.0 + alpha(mgs,il))*(5.0 + alpha(mgs,il))*(4.0 + alpha(mgs,il))/ &
10776 & ((3.0 + alpha(mgs,il))*(2.0 + alpha(mgs,il))*(1.0 + alpha(mgs,il))*pi**2)
10779 zx(mgs,lr) = zx(mgs,lr) + g1*(rho0(mgs)/(xdn(mgs,lr)))**2*( 2.*( tmp ) * dqr )
10782 theta(mgs) = thetap(mgs) + theta0(mgs)
10783 temg(mgs) = theta(mgs)*f1
10784 ltemq = (temg(mgs)-163.15)/fqsat+1.5
10785 ltemq = min( nqsat, max(1,ltemq) )
10786 qvs(mgs) = pqs(mgs)*tabqvs(ltemq)
10797 IF ( ssf(mgs) .gt. 0.0 )
THEN
10799 IF ( iqcinit == 1 )
THEN
10801 qvs0 = 380.*exp(17.27*(temg(mgs)-273.)/(temg(mgs)- 36.))/pk(mgs)
10803 dcloud = max(0.0, (qx(mgs,lv)-qvs0) / (1.+qvs0*f5/(temg(mgs)-36.)**2) )
10805 ELSEIF ( iqcinit == 3 )
THEN
10806 r1=1./(1. + caw*(273.15 - cbw)*qss(mgs)*felvcp(mgs)/ &
10807 & ((temg(mgs) - cbw)**2))
10808 dcloud=r1*(qvap(mgs) - qvs(mgs))
10811 ELSEIF ( iqcinit == 2 )
THEN
10823 IF ( ssf(mgs) > ssmx .and. ssf(mgs) < 20.0 .and. &
10824 ( ccnc(mgs) > 0.05*cwnccn(mgs) .or. ( ac_opt > 0 .and. ccnc_ac(mgs) - cx(mgs,lc) > 0.0 ) ) )
THEN
10826 CALL qvexcess(ngs,mgs,qwvp,qv0,qx(1,lc),pres,thetap,theta0,dcloud, &
10827 & pi0,tabqvs,nqsat,fqsat,cbw,fcqv1,felvcp,ssmx,pk,ngscnt)
10836 thetap(mgs) = thetap(mgs) + felvcp(mgs)*dcloud/(pi0(mgs))
10837 qwvp(mgs) = qwvp(mgs) - dcloud
10838 qx(mgs,lc) = qx(mgs,lc) + dcloud
10839 IF ( io_flag .and. nxtra > 1 )
THEN
10840 axtra(igs(mgs),jy,kgs(mgs),1) = dcloud/dtp
10842 theta(mgs) = thetap(mgs) + theta0(mgs)
10843 temg(mgs) = theta(mgs)*pk(mgs)
10845 ltemq = (temg(mgs)-163.15)/fqsat+1.5
10846 ltemq = min( nqsat, max(1,ltemq) )
10847 qvs(mgs) = pqs(mgs)*tabqvs(ltemq)
10854 IF ( ncdebug .ge. 1 )
THEN
10855 write(iunit,*)
'at 613: ',qx(mgs,lc),cx(mgs,lc),wvel(mgs),ssmax(mgs),kgs(mgs)
10858 IF ( .not. flag_qndrop )
THEN
10860 IF ( ac_opt == 0 )
THEN
10861 cnuctmp = cnuc(mgs)
10863 cnuctmp = ccnc_ac(mgs)
10867 IF ( dcloud .gt. qxmin(lc) .and. wvel(mgs) > 0.0)
THEN
10869 cn(mgs) = ccne0*cnuctmp**(2./(2.+cck))*wvel(mgs)**cnexp
10870 IF ( ny .le. 2 .and. cn(mgs) .gt. 0.0 &
10871 & .and. ncdebug .ge. 1 )
THEN
10872 write(iunit,*)
'CN: ',cn(mgs)*1.e-6, cx(mgs,lc)*1.e-6, qx(mgs,lc)*1.e3, &
10873 & wvel(mgs), dcloud*1.e3
10874 IF ( cn(mgs) .gt. 1.0 )
write(iunit,*)
'cwrad = ', &
10875 & 1.e6*(rho0(mgs)*qx(mgs,lc)/cn(mgs)*cwc1)**c1f3, &
10876 & igs(mgs),kgs(mgs),temcg(mgs), &
10877 & 1.e3*an(igs(mgs),jgs,kgs(mgs)-1,lc)
10879 IF ( iccwflg .eq. 1 )
THEN
10880 cn(mgs) = min(cwccn*rho0(mgs)/rho00, max(cn(mgs), &
10881 & rho0(mgs)*qx(mgs,lc)/(xdn(mgs,lc)*(4.*pi/3.)*(4.e-6)**3)))
10890 IF ( cn(mgs) .gt. 0.0 )
THEN
10891 IF ( ac_opt == 0 )
THEN
10892 IF ( cn(mgs) .gt. ccnc(mgs) )
THEN
10893 cn(mgs) = ccnc(mgs)
10897 cn(mgs) = min( cn(mgs), ccnc_ac(mgs) )
10900 IF ( irenuc <= 2 .and. lccna < 1 ) ccnc(mgs) = max(0.0, ccnc(mgs) - cn(mgs))
10901 ccna(mgs) = ccna(mgs) + cn(mgs)
10906 IF( cn(mgs) .GT. cx(mgs,lc) ) cx(mgs,lc) = cn(mgs)
10907 IF( cx(mgs,lc) .GT. 0. .AND. qx(mgs,lc) .le. qxmin(lc) )
THEN
10910 cx(mgs,lc) = min(cx(mgs,lc),rho0(mgs)*max(0.0,qx(mgs,lc))/cwmasn)
10926 IF ( wvel(mgs) .le. 0. )
GO TO 616
10927 IF ( cx(mgs,lc) .le. 0. )
GO TO 613
10928 IF ( kzbeg-1+kgs(mgs) .GT. 1 .and. qx(mgs,lc) .le. qxmin(lc))
GO TO 613
10929 IF ( kzbeg-1+kgs(mgs) .eq. 1 .and. wvel(mgs) .gt. 0. )
GO TO 613
10931 616
IF ( ssf(mgs) .LE. supcb .AND. wvel(mgs) .GT. 0. )
GO TO 631
10932 IF ( kzbeg-1+kgs(mgs) .GT. 1 .AND. kzbeg-1+kgs(mgs) .LT. nzend-1 .AND. &
10933 & (ssfkp1(mgs) .GE. supmx .OR. &
10934 & ssf(mgs) .GE. supmx .OR. &
10935 & ssfkm1(mgs) .GE. supmx))
GO TO 631
10936 IF (ssf(mgs) .LT. 1.e-10 .OR. ssf(mgs) .GE. supmx)
GO TO 631
10942 if (ndebug .gt. 0)
write(0,*)
"ICEZVD_DR: Entered Ziegler Cloud Nucleation"
10945 r2dzm=0.50/dz3d(igs(mgs),jy,kgs(mgs))
10947 IF ( irenuc >= 0 .and. ac_opt == 0 .and. .not. flag_qndrop )
THEN
10949 IF ( irenuc < 2 )
THEN
10951 IF ( kzend == nzend )
THEN
10952 t0p3 = t0(igs(mgs),jgs,min(kze,kgs(mgs)+3))
10953 t0p1 = t0(igs(mgs),jgs,min(kze,kgs(mgs)+1))
10955 t0p3 = t0(igs(mgs),jgs,kgs(mgs)+3)
10956 t0p1 = t0(igs(mgs),jgs,kgs(mgs)+1)
10959 IF ( ( ssf(mgs) .gt. ssmax(mgs) .or. irenuc .eq. 1 ) &
10960 & .and. ( ( lccn .lt. 1 .and. &
10961 & cx(mgs,lc) .lt. cwccn*(min(1.0,rho0(mgs)))) .or. &
10962 & ( lccn .gt. 1 .and. ccnc(mgs) .gt. 0. ) ) &
10964 IF( kzbeg-1+kgs(mgs) .GT. 1 .AND. kzbeg-1+kgs(mgs) .LT. nzend-1 &
10965 & .and. ssf(mgs) .gt. 0.0 &
10966 & .and. ssfkp1(mgs) .LT. supmx .and. ssfkp1(mgs) .ge. 0.0 &
10967 & .AND. ssfkm1(mgs) .LT. supmx .AND. ssfkm1(mgs) .ge. 0.0 &
10968 & .AND. ssfkp1(mgs) .gt. ssfkm1(mgs) &
10969 & .and. t0p3 .gt. 233.2)
THEN
10970 dssdz = (ssfkp1(mgs) - ssfkm1(mgs))*r2dzm
10974 ELSEIF( kzbeg-1+kgs(mgs) .GT. 1 .AND. kzbeg-1+kgs(mgs) .LT. nzend-1 &
10976 & .and. ssf(mgs) .gt. 0.0 .and. wvel(mgs) .gt. 0.0 &
10977 & .and. ssfkp1(mgs) .gt. 0.0 &
10978 & .AND. ssfkm1(mgs) .le. 0.0 .and. wvelkm1(mgs) .gt. 0.0 &
10979 & .AND. ssf(mgs) .gt. ssfkm1(mgs) &
10980 & .and. t0p1 .gt. 233.2)
THEN
10981 dssdz = 2.*(ssf(mgs) - ssfkm1(mgs))*r2dzm
10988 c1 = max(0.0, rho0(mgs)*(qx(mgs,lv) - qss(mgs))/ &
10989 & (xdn(mgs,lc)*(4.*pi/3.)*(4.e-6)**3))
10990 IF ( lccn .lt. 1 )
THEN
10991 cn(mgs) = cwccn*rho0(mgs)/rho00*cck*ssf(mgs)**cckm*dtp* &
10993 & (wvel(mgs)*dssdz) )
10996 & min(ccnc(mgs), cnuc(mgs)*cck*ssf(mgs)**cckm*dtp* &
10998 & ( wvel(mgs)*dssdz) ) )
11002 IF ( cn(mgs) .gt. 0.0 )
THEN
11003 IF ( ccnc(mgs) .lt. 5.e7 .and. cn(mgs) .ge. 5.e7 )
THEN
11006 ELSEIF ( cn(mgs) .gt. ccnc(mgs) )
THEN
11007 cn(mgs) = ccnc(mgs)
11010 cx(mgs,lc) = cx(mgs,lc) + cn(mgs)
11011 ccnc(mgs) = max(0.0, ccnc(mgs) - cn(mgs))
11014 ELSEIF ( irenuc == 2 )
THEN
11017 cn(mgs) = ccne0*cnuc(mgs)**(2./(2.+cck))*max(0.0,wvel(mgs))**cnexp
11022 cn(mgs) = min(cn(mgs), ccnc(mgs))
11023 cn(mgs) = min(cn(mgs), 0.5*dqc/cwmasn)
11024 cn(mgs) = min( cn(mgs), max(0.0, (cnuc(mgs) - ccna(mgs) )) )
11026 IF ( .false. .and. ny <= 2 )
THEN
11027 write(0,*)
'i,k, cwmasn = ',igs(mgs),kgs(mgs),cwmasn
11028 write(0,*)
'wvel, cnuc, cn = ',wvel(mgs),cnuc(mgs),cn(mgs)
11029 write(0,*)
'ccne0,cnexp,cck = ',ccne0,cnexp,cck
11030 write(0,*)
'part1, part2 = ',ccne0*cnuc(mgs)**(2./(2.+cck)), max(0.0,wvel(mgs))**cnexp
11031 write(0,*)
'ccnc, dqc, dqc/cwmasn = ',ccnc(mgs), dqc, 0.5*dqc/cwmasn
11034 IF ( icnuclimit > 0 )
THEN
11035 tmp = ccnc(mgs) + cx(mgs,lc)
11036 IF ( tmp < 330.34e6 )
THEN
11037 ccwmax = 1.1173e6 * (1.e-6*tmp)**0.9504
11039 ccwmax = 21.57e6 * (1.e-6*tmp)**0.44
11046 cn(mgs) = max( 0.0, min( cn(mgs), ccwmax - cx(mgs,lc) ) )
11050 cx(mgs,lc) = cx(mgs,lc) + cn(mgs)
11052 IF ( lccna < 1 ) ccnc(mgs) = max(0.0, ccnc(mgs) - cn(mgs))
11054 ELSEIF ( irenuc == 3 )
THEN
11060 temp1 = (theta0(mgs)+thetap(mgs))*pk(mgs)
11061 ltemq = int( (temp1-163.15)/fqsat+1.5 )
11062 ltemq = min( nqsat, max(1,ltemq) )
11064 c1= pqs(mgs)*tabqvs(ltemq)
11067 IF ( c1 > 0. )
THEN
11068 ssf(mgs) = 100.*(qx(mgs,lv)/c1 - 1.0)
11070 cn(mgs) = cnuc(mgs)*min(1.0, (ssf(mgs))**cck )
11072 cn(mgs) = max( 0.0, cn(mgs) - ccna(mgs) )
11075 cn(mgs) = min(cn(mgs), ccnc(mgs))
11076 cn(mgs) = min(cn(mgs), 0.5*dqc/cwmasn)
11078 cx(mgs,lc) = cx(mgs,lc) + cn(mgs)
11082 ccnc(mgs) = max(0.0, ccnc(mgs) - cn(mgs))
11084 ELSEIF ( irenuc == 4 )
THEN
11090 temp1 = (theta0(mgs)+thetap(mgs))*pk(mgs)
11091 ltemq = int( (temp1-163.15)/fqsat+1.5 )
11092 ltemq = min( nqsat, max(1,ltemq) )
11094 c1= pqs(mgs)*tabqvs(ltemq)
11095 IF ( c1 > 0. )
THEN
11096 ssf(mgs) = max(0.0, 100.*((qv0(mgs) + qwvp(mgs))/c1 - 1.0) )
11100 cn(mgs) = cnuc(mgs)*min(ssf2kmax, ssf(mgs)**cck)
11102 cn(mgs) = max( 0.0, cn(mgs) - ccna(mgs) )
11106 cn(mgs) = min(cn(mgs), 0.5*dqc/cwmasn)
11108 IF ( cn(mgs) > 0.0 )
THEN
11109 cx(mgs,lc) = cx(mgs,lc) + cn(mgs)
11114 dcloud = 1000.*dcrit**3*pi/6.*cn(mgs)
11115 qx(mgs,lc) = qx(mgs,lc) + dcloud
11116 thetap(mgs) = thetap(mgs) + felvcp(mgs)*dcloud/(pi0(mgs))
11117 qwvp(mgs) = qwvp(mgs) - dcloud
11125 ELSEIF ( irenuc == 6 )
THEN
11131 IF ( ccna(mgs) < 0.7*cnuc(mgs) )
THEN
11132 cn(mgs) = min( 0.9*cnuc(mgs), ccne0*cnuc(mgs)**(2./(2.+cck))*max(0.0,wvel(mgs))**cnexp )
11135 cn(mgs) = min( cn(mgs), max(0.0, (0.7*cnuc(mgs) - ccna(mgs) )) )
11141 temp1 = (theta0(mgs)+thetap(mgs))*pk(mgs)
11143 ltemq = int( (temp1-163.15)/fqsat+1.5 )
11144 ltemq = min( nqsat, max(1,ltemq) )
11147 c1= pqs(mgs)*tabqvs(ltemq)
11148 IF ( c1 > 0. )
THEN
11149 ssf(mgs) = max(0.0, 100.*((qv0(mgs) + qwvp(mgs))/c1 - 1.0) )
11155 cn(mgs) = cnuc(mgs)*min(2.0, max(0.0,ssf(mgs))**cck )
11159 cn(mgs) = min(0.01*cnuc(mgs), max( 0.0, cn(mgs) - ccna(mgs) ) )
11169 IF ( cn(mgs) > 0.0 )
THEN
11170 cx(mgs,lc) = cx(mgs,lc) + cn(mgs)
11176 dcloud = 1000.*dcrit**3*pi/6.*cn(mgs)
11177 qx(mgs,lc) = qx(mgs,lc) + dcloud
11178 thetap(mgs) = thetap(mgs) + felvcp(mgs)*dcloud/(pi0(mgs))
11179 qwvp(mgs) = qwvp(mgs) - dcloud
11182 ELSEIF ( irenuc == 5 )
THEN
11187 cn(mgs) = min( cnuc(mgs), ccne0*cnuc(mgs)**(2./(2.+cck))*max(0.0,wvel(mgs))**cnexp )
11190 IF ( ccna(mgs) >= cnuc(mgs) )
THEN
11191 temp1 = (theta0(mgs)+thetap(mgs))*pk(mgs)
11192 ltemq = int( (temp1-163.15)/fqsat+1.5 )
11193 ltemq = min( nqsat, max(1,ltemq) )
11195 c1= pqs(mgs)*tabqvs(ltemq)
11196 IF ( c1 > 0. )
THEN
11197 ssf(mgs) = max(0.0, 100.*((qv0(mgs) + qwvp(mgs))/c1 - 1.0) )
11203 cn(mgs) = max( cn(mgs), cnuc(mgs)*min(ssf2kmax, ssf(mgs)**cck) )
11208 cn(mgs) = max( 0.0, cn(mgs) - ccna(mgs) )
11211 cn(mgs) = min( cn(mgs), cnuc(mgs) - ccna(mgs) )
11218 dcloud = 1000.*dcrit**3*pi/6.
11222 tmp = max(0.0, rho0(mgs)*qx(mgs,lc)/dcloud - cx(mgs,lc))
11223 cn(mgs) = min(tmp, cn(mgs) )
11226 IF ( cn(mgs) > 0.0 )
THEN
11227 cx(mgs,lc) = cx(mgs,lc) + cn(mgs)
11231 dcloud = 1000.*dcrit**3*pi/6.*cn(mgs)
11232 qx(mgs,lc) = qx(mgs,lc) + dcloud
11233 thetap(mgs) = thetap(mgs) + felvcp(mgs)*dcloud/(pi0(mgs))
11234 qwvp(mgs) = qwvp(mgs) - dcloud
11239 ELSEIF ( irenuc == 7 .or. irenuc == 17 )
THEN
11244 IF ( irenuc == 7 )
THEN
11250 IF ( ccna(mgs) < frac*cnuc(mgs) )
THEN
11251 cn(mgs) = min( (frac+0.01)*cnuc(mgs), ccne0*cnuc(mgs)**(2./(2.+cck))*max(0.0,wvel(mgs))**cnexp )
11254 cn(mgs) = min( cn(mgs), max(0.0, (frac*cnuc(mgs) - ccna(mgs) )) )
11267 temp1 = (theta0(mgs)+thetap(mgs))*pk(mgs)
11269 ltemq = int( (temp1-163.15)/fqsat+1.5 )
11270 ltemq = min( nqsat, max(1,ltemq) )
11273 c1= pqs(mgs)*tabqvs(ltemq)
11276 IF ( c1 > 0. )
THEN
11277 ssf(mgs) = 100.*(qx(mgs,lv)/c1 - 1.0)
11281 IF ( ssf(mgs) <= 1.0 )
THEN
11282 cn(mgs) = cnuc(mgs)*min(1.0, max(0.0,ssf(mgs))**cck )
11284 cn(mgs) = cnuc(mgs)*min(2.0, max(0.0,0.03*(ssf(mgs)-1.0)+1.)**cck )
11292 IF ( ccncuf(mgs) > 0.0 .and. ssf(mgs) > ssmxuf .and. ( ssmax(mgs) > ssmxuf .or. lss < 1 ) )
THEN
11293 cnuf(mgs) = min( ccncuf(mgs), ccne0*ccncuf(mgs)**(2./(2.+cck))*max(0.0,wvel(mgs))**cnexp )
11301 cn(mgs) = min(0.01*cnuc(mgs), max( 0.0, cn(mgs) - ccna(mgs) ) )
11312 IF ( icnuclimit > 0 )
THEN
11314 tmp = ccnc(mgs) - ccna(mgs) + cx(mgs,lc)
11315 IF ( tmp < 330.34e6 )
THEN
11316 ccwmax = 1.1173e6 * (1.e-6*tmp)**0.9504
11318 ccwmax = 21.57e6 * (1.e-6*tmp)**0.44
11321 cn(mgs) = max( 0.0, min( cn(mgs), ccwmax - cx(mgs,lc) ) )
11325 IF ( cn(mgs) + cnuf(mgs) > 0.0 )
THEN
11328 dcloud = 1000.*dcrit**3*pi/6.
11332 tmp = max(0.0, rho0(mgs)*qx(mgs,lc)/dcloud - cx(mgs,lc))
11333 cn(mgs) = min(tmp, cn(mgs) )
11335 cx(mgs,lc) = cx(mgs,lc) + cn(mgs) + cnuf(mgs)
11342 dcloud = 1000.*dcrit**3*pi/6.*(cn(mgs) + cnuf(mgs) )
11343 qx(mgs,lc) = qx(mgs,lc) + dcloud
11344 thetap(mgs) = thetap(mgs) + felvcp(mgs)*dcloud/(pi0(mgs))
11345 qwvp(mgs) = qwvp(mgs) - dcloud
11347 ccncuf(mgs) = max(0.0, ccncuf(mgs) - cnuf(mgs))
11350 ELSEIF ( irenuc == 8 )
THEN
11356 IF ( ccnc(mgs) > 0. )
THEN
11357 cn(mgs) = ccne0*ccnc(mgs)**(2./(2.+cck))*max(0.0,wvel(mgs))**cnexp
11362 cn(mgs) = min(cn(mgs), ccnc(mgs))
11364 ELSEIF ( cx(mgs,lc) < 0.01e9 )
THEN
11368 temp1 = (theta0(mgs)+thetap(mgs))*pk(mgs)
11370 ltemq = int( (temp1-163.15)/fqsat+1.5 )
11371 ltemq = min( nqsat, max(1,ltemq) )
11374 c1= pqs(mgs)*tabqvs(ltemq)
11377 IF ( c1 > 0. )
THEN
11378 ssf(mgs) = 100.*(qx(mgs,lv)/c1 - 1.0)
11382 IF ( ssf(mgs) <= 1.0 )
THEN
11386 cn(mgs) = 0.01e9*min(2.0, max(0.0,0.03*(ssf(mgs)-1.0)+1.)**cck ) - cx(mgs,lc)
11391 IF ( cn(mgs) > 0.0 )
THEN
11392 cx(mgs,lc) = cx(mgs,lc) + cn(mgs)
11400 dcloud = 1000.*dcrit**3*pi/6.*cn(mgs)
11401 qx(mgs,lc) = qx(mgs,lc) + dcloud
11402 thetap(mgs) = thetap(mgs) + felvcp(mgs)*dcloud/(pi0(mgs))
11403 qwvp(mgs) = qwvp(mgs) - dcloud
11411 ccna(mgs) = ccna(mgs) + cn(mgs)
11415 IF( cx(mgs,lc) .GT. 0. .AND. qx(mgs,lc) .LE. qxmin(lc)) cx(mgs,lc)=0.
11427 qv1 = qv0(mgs) + qwvp(mgs)
11432 IF ( qv1 .gt. (ssmx*qvs1) )
THEN
11438 ssmx = 100.*(ssmx - 1.0)
11442 CALL qvexcess(ngs,mgs,qwvp,qv0,qx(1,lc),pres,thetap,theta0,qvex, &
11443 & pi0,tabqvs,nqsat,fqsat,cbw,fcqv1,felvcp,ssmx,pk,ngscnt)
11447 IF ( qvex .gt. 0.0 )
THEN
11448 thetap(mgs) = thetap(mgs) + felvcp(mgs)*qvex/(pi0(mgs))
11449 IF ( io_flag .and. nxtra > 1 )
THEN
11450 axtra(igs(mgs),jy,kgs(mgs),1) = axtra(igs(mgs),jy,kgs(mgs),1) + qvex/dtp
11452 qwvp(mgs) = qwvp(mgs) - qvex
11453 qx(mgs,lc) = qx(mgs,lc) + qvex
11454 IF ( .not. flag_qndrop)
THEN
11455 IF ( imaxsupopt == 1 )
THEN
11456 cn(mgs) = min( max(ccnc(mgs),cwnccn(mgs)), rho0(mgs)*qvex/max( cwmasn5, xmas(mgs,lc) ) )
11457 ELSEIF ( imaxsupopt == 2 )
THEN
11458 cn(mgs) = min( max(ccnc(mgs),cwnccn(mgs)), rho0(mgs)*qvex/max( cwmasn5, max(cwmas30,xmas(mgs,lc)) ) )
11459 ELSEIF ( imaxsupopt == 3 )
THEN
11460 cn(mgs) = min( max(ccnc(mgs),cwnccn(mgs)), rho0(mgs)*qvex/max( cwmasn5, max(cwmasx,xmas(mgs,lc)) ) )
11462 ELSEIF ( imaxsupopt == 4 )
THEN
11463 cn(mgs) = min( max(ccnc(mgs),cwnccn(mgs)), rho0(mgs)*qvex/max( cwmasn5, max(cwmas20,xmas(mgs,lc)) ) )
11465 IF ( lccna > 1 )
THEN
11466 ccna(mgs) = ccna(mgs) + cn(mgs)
11468 ccnc(mgs) = max( 0.0, ccnc(mgs) - cn(mgs) )
11470 cx(mgs,lc) = cx(mgs,lc) + cn(mgs)
11490 IF( cx(mgs,lc) > cxmin .AND. qx(mgs,lc) .GT. qxmin(lc))
THEN
11492 xmas(mgs,lc) = rho0(mgs)*qx(mgs,lc)/(cx(mgs,lc))
11494 IF ( xmas(mgs,lc) < cwmasn .or. xmas(mgs,lc) > cwmasx )
THEN
11496 xmas(mgs,lc) = min( xmas(mgs,lc), cwmasx )
11497 xmas(mgs,lc) = max( xmas(mgs,lc), cwmasn )
11498 cx(mgs,lc) = rho0(mgs)*qx(mgs,lc)/xmas(mgs,lc)
11528 IF ( ipconc .ge. 3 .and. rcond == 2 )
THEN
11531 IF (cx(mgs,lr) .GT. 0. .AND. qx(mgs,lr) .GT. qxmin(lr)) &
11532 & xv(mgs,lr)=rho0(mgs)*qx(mgs,lr)/(xdn(mgs,lr)*cx(mgs,lr))
11533 IF (xv(mgs,lr) .GT. xvmx(lr)) xv(mgs,lr) = xvmx(lr)
11534 IF (xv(mgs,lr) .LT. xvmn(lr)) xv(mgs,lr) = xvmn(lr)
11545 IF ( lss > 1 .and. ssf(mgs) .gt. ssmax(mgs) &
11546 & .and. ( idecss .eq. 0 .or. qx(mgs,lc) .gt. qxmin(lc)) )
THEN
11547 ssmax(mgs) = ssf(mgs)
11553 an(igs(mgs),jy,kgs(mgs),lt) = theta0(mgs) + thetap(mgs)
11554 an(igs(mgs),jy,kgs(mgs),lv) = qv0(mgs) + qwvp(mgs)
11557 IF ( eqtset > 2 )
THEN
11558 p2(igs(mgs),jy,kgs(mgs)) = pipert(mgs)
11561 if ( ido(lc) .eq. 1 )
then
11562 an(igs(mgs),jy,kgs(mgs),lc) = qx(mgs,lc) + &
11563 & min( an(igs(mgs),jy,kgs(mgs),lc), 0.0 )
11568 if ( ido(lr) .eq. 1 .and. rcond == 2 )
then
11569 an(igs(mgs),jy,kgs(mgs),lr) = qx(mgs,lr) + &
11570 & min( an(igs(mgs),jy,kgs(mgs),lr), 0.0 )
11574 IF ( lzr > 1 .and. rcond == 2 )
THEN
11575 an(igs(mgs),jy,kgs(mgs),lzr) = zx(mgs,lr) + &
11576 & min( an(igs(mgs),jy,kgs(mgs),lzr), 0.0 )
11580 IF ( ipconc .ge. 2 )
THEN
11581 an(igs(mgs),jy,kgs(mgs),lnc) = max(cx(mgs,lc) , 0.0)
11582 IF ( lss > 1 ) an(igs(mgs),jy,kgs(mgs),lss) = max( 0.0, ssmax(mgs) )
11583 IF ( ac_opt == 0 )
THEN
11584 IF ( lccn .gt. 1 .and. lccna .lt. 1 )
THEN
11585 an(igs(mgs),jy,kgs(mgs),lccn) = max(0.0, ccnc(mgs) )
11588 IF ( lccnuf .gt. 1 .and. .not. ( lccna .gt. 1 .and. i_uf_or_ccn > 0 ) )
THEN
11589 an(igs(mgs),jy,kgs(mgs),lccnuf) = max(0.0, ccncuf(mgs) )
11591 IF ( lccna .gt. 1 )
THEN
11592 an(igs(mgs),jy,kgs(mgs),lccna) = max(0.0, ccna(mgs) )
11595 IF ( ipconc .ge. 3 .and. rcond == 2 )
THEN
11596 an(igs(mgs),jy,kgs(mgs),lnr) = max(cx(mgs,lr) , 0.0)
11604 if ( kz .gt. nz-1 .and. ix .ge. nxi)
then
11605 if ( ix .ge. nxi )
then
11614 if ( ix .ge. nxi )
then
11647 t0(ix,jy,kz) = an(ix,jy,kz,lt)*t77(ix,jy,kz)
11649 zerocx(:) = .false.
11651 IF ( iresetmoments == 1 .or. iresetmoments == il )
THEN
11652 IF ( ln(il) > 1 ) zerocx(il) = ( an(ix,jy,kz,ln(il)) < cxmin )
11653 IF ( lz(il) > 1 ) zerocx(il) = ( zerocx(il) .or. an(ix,jy,kz,lz(il)) < zxmin )
11655 IF ( il == lc )
THEN
11656 IF ( ln(il) > 1 ) zerocx(il) = ( an(ix,jy,kz,ln(il)) <= 0 ) .and. .not. flag_qndrop
11658 IF ( ln(il) > 1 ) zerocx(il) = ( an(ix,jy,kz,ln(il)) <= 0 )
11663 IF ( lhl .gt. 1 )
THEN
11665 IF ( lzhl .gt. 1 )
THEN
11667 an(ix,jy,kz,lzhl) = max(0.0, an(ix,jy,kz,lzhl) )
11669 IF ( an(ix,jy,kz,lhl) .ge. frac*qxmin(lhl) .and. rescale_low_alpha )
THEN
11671 IF ( an(ix,jy,kz,lnhl) .gt. 0.0 )
THEN
11673 IF ( lvhl .gt. 1 )
THEN
11674 IF ( an(ix,jy,kz,lvhl) .gt. 0.0 )
THEN
11675 hwdn = dn(ix,jy,kz)*an(ix,jy,kz,lhl)/an(ix,jy,kz,lvhl)
11679 hwdn = max( xdnmn(lhl), hwdn )
11684 chw = an(ix,jy,kz,lnhl)
11685 g1 = (6.0+alphamin)*(5.0+alphamin)*(4.0+alphamin)/ &
11686 & ((3.0+alphamin)*(2.0+alphamin)*(1.0+alphamin))
11687 z1 = g1*dn(ix,jy,kz)**2*( an(ix,jy,kz,lhl) )*an(ix,jy,kz,lhl)/chw
11688 z1 = z1*(6./(pi*hwdn))**2
11693 an(ix,jy,kz,lzhl) = min( z1, an(ix,jy,kz,lzhl) )
11695 IF ( an(ix,jy,kz,lnhl) .lt. 1.e-5 )
THEN
11702 if ( an(ix,jy,kz,lhl) .lt. frac*qxmin(lhl) .or. zerocx(lhl) )
then
11705 an(ix,jy,kz,lv) = an(ix,jy,kz,lv) + an(ix,jy,kz,lhl)
11706 an(ix,jy,kz,lhl) = 0.0
11709 IF ( ipconc .ge. 5 )
THEN
11710 an(ix,jy,kz,lnhl) = 0.0
11713 IF ( lvhl .gt. 1 )
THEN
11714 an(ix,jy,kz,lvhl) = 0.0
11717 IF ( lhlw .gt. 1 )
THEN
11718 an(ix,jy,kz,lhlw) = 0.0
11721 IF ( lnhlf .gt. 1 )
THEN
11722 an(ix,jy,kz,lnhlf) = 0.0
11725 IF ( lzhl .gt. 1 )
THEN
11726 an(ix,jy,kz,lzhl) = 0.0
11730 IF ( lvol(lhl) .gt. 1 )
THEN
11731 IF ( an(ix,jy,kz,lvhl) .gt. 0.0 )
THEN
11732 tmp = dn(ix,jy,kz)*an(ix,jy,kz,lhl)/an(ix,jy,kz,lvhl)
11735 an(ix,jy,kz,lvhl) = dn(ix,jy,kz)*an(ix,jy,kz,lhl)/tmp
11738 IF ( tmp .lt. xdnmn(lhl) )
THEN
11739 tmp = max( xdnmn(lhl), tmp )
11740 an(ix,jy,kz,lvhl) = dn(ix,jy,kz)*an(ix,jy,kz,lhl)/tmp
11743 IF ( tmp .gt. xdnmx(lhl) .and. lhlw .le. 0 )
THEN
11744 tmp = min( xdnmx(lhl), tmp )
11745 an(ix,jy,kz,lvhl) = dn(ix,jy,kz)*an(ix,jy,kz,lhl)/tmp
11746 ELSEIF ( tmp .gt. xdnmx(lhl) .and. lhlw .gt. 1 )
THEN
11747 fw = an(ix,jy,kz,lhlw)/an(ix,jy,kz,lhl)
11752 tmpmx = xdnmx(lhl)/( 1. - fw*(1. - xdnmx(lhl)/xdnmx(lr) ))
11754 IF ( tmp .gt. tmpmx )
THEN
11755 an(ix,jy,kz,lvhl) = dn(ix,jy,kz)*an(ix,jy,kz,lhl)/tmpmx
11767 IF ( lhlw .gt. 1 )
THEN
11768 IF ( an(ix,jy,kz,lhlw) .gt. 0.98*an(ix,jy,kz,lhl) )
THEN
11770 an(ix,jy,kz,lvhl) = dn(ix,jy,kz)*an(ix,jy,kz,lhl)/tmp
11778 IF ( ipconc == 5 .and. an(ix,jy,kz,lhl) .gt. qxmin(lhl) .and. alphahl .le. 0.1 .and. lnhl .gt. 1 .and. lzhl == 0 )
THEN
11780 IF ( lvhl .gt. 1 )
THEN
11781 hwdn = dn(ix,jy,kz)*an(ix,jy,kz,lhl)/an(ix,jy,kz,lvhl)
11785 tmp = (hwdn*an(ix,jy,kz,lnhl))/(dn(ix,jy,kz)*an(ix,jy,kz,lhl))
11786 tmpg = an(ix,jy,kz,lnhl)*(tmp*(3.14159))**(1./3.)
11787 IF ( tmpg .lt. cnohlmn )
THEN
11788 tmp = ( (hwdn)/(dn(ix,jy,kz)*an(ix,jy,kz,lhl))*(3.14159))**(1./3.)
11789 an(ix,jy,kz,lnhl) = (cnohlmn/tmp)**(3./4.)
11801 IF ( lzh .gt. 1 )
THEN
11803 an(ix,jy,kz,lzh) = max(0.0, an(ix,jy,kz,lzh) )
11805 IF ( .false. .and. an(ix,jy,kz,lh) .ge. frac*qxmin(lh) .and. rescale_low_alpha )
THEN
11807 IF ( an(ix,jy,kz,lnh) .gt. 0.0 )
THEN
11809 IF ( lvh .gt. 1 )
THEN
11810 IF ( an(ix,jy,kz,lvh) .gt. 0.0 )
THEN
11811 hwdn = dn(ix,jy,kz)*an(ix,jy,kz,lh)/an(ix,jy,kz,lvh)
11815 hwdn = max( xdnmn(lh), hwdn )
11820 chw = an(ix,jy,kz,lnh)
11821 g1 = (6.0+alphamin)*(5.0+alphamin)*(4.0+alphamin)/ &
11822 & ((3.0+alphamin)*(2.0+alphamin)*(1.0+alphamin))
11823 z1 = g1*dn(ix,jy,kz)**2*( an(ix,jy,kz,lh) )*an(ix,jy,kz,lh)/chw
11824 z1 = z1*(6./(pi*hwdn))**2
11829 an(ix,jy,kz,lzh) = min( z1, an(ix,jy,kz,lzh) )
11831 IF ( an(ix,jy,kz,lnh) .lt. 1.e-5 )
THEN
11838 if ( an(ix,jy,kz,lh) .lt. frac*qxmin(lh) .or. zerocx(lh) )
then
11841 an(ix,jy,kz,lv) = an(ix,jy,kz,lv) + an(ix,jy,kz,lh)
11842 an(ix,jy,kz,lh) = 0.0
11845 IF ( ipconc .ge. 5 )
THEN
11846 an(ix,jy,kz,lnh) = 0.0
11849 IF ( lvh .gt. 1 )
THEN
11850 an(ix,jy,kz,lvh) = 0.0
11853 IF ( lhw .gt. 1 )
THEN
11854 an(ix,jy,kz,lhw) = 0.0
11857 IF ( lnhf .gt. 1 )
THEN
11858 an(ix,jy,kz,lnhf) = 0.0
11861 IF ( lzh .gt. 1 )
THEN
11862 an(ix,jy,kz,lzh) = 0.0
11866 IF ( lvol(lh) .gt. 1 )
THEN
11867 IF ( an(ix,jy,kz,lvh) .gt. 0.0 )
THEN
11868 tmp = dn(ix,jy,kz)*an(ix,jy,kz,lh)/an(ix,jy,kz,lvh)
11871 an(ix,jy,kz,lvh) = dn(ix,jy,kz)*an(ix,jy,kz,lh)/tmp
11874 IF ( tmp .lt. xdnmn(lh) )
THEN
11875 tmp = max( xdnmn(lh), tmp )
11876 an(ix,jy,kz,lvh) = dn(ix,jy,kz)*an(ix,jy,kz,lh)/tmp
11879 IF ( tmp .gt. xdnmx(lh) .and. lhw .le. 0 )
THEN
11880 tmp = min( xdnmx(lh), tmp )
11881 an(ix,jy,kz,lvh) = dn(ix,jy,kz)*an(ix,jy,kz,lh)/tmp
11882 ELSEIF ( tmp .gt. xdnmx(lh) .and. lhw .gt. 1 )
THEN
11883 fw = an(ix,jy,kz,lhw)/an(ix,jy,kz,lh)
11887 tmpmx = xdnmx(lh)/( 1. - fw*(1. - xdnmx(lh)/xdnmx(lr) ))
11889 IF ( tmp .gt. tmpmx )
THEN
11890 an(ix,jy,kz,lvh) = dn(ix,jy,kz)*an(ix,jy,kz,lh)/tmpmx
11903 IF ( lhw .gt. 1 )
THEN
11904 IF ( an(ix,jy,kz,lhw) .gt. 0.98*an(ix,jy,kz,lh) )
THEN
11906 an(ix,jy,kz,lvh) = dn(ix,jy,kz)*an(ix,jy,kz,lh)/tmp
11913 IF ( ipconc == 5 .and. an(ix,jy,kz,lh) .gt. qxmin(lh) .and. alphah .le. 0.1 .and. lnh .gt. 1 .and. lzh == 0 )
THEN
11915 IF ( lvh .gt. 1 )
THEN
11916 IF ( an(ix,jy,kz,lvh) .gt. 0.0 )
THEN
11917 hwdn = dn(ix,jy,kz)*an(ix,jy,kz,lh)/an(ix,jy,kz,lvh)
11921 hwdn = max( xdnmn(lh), hwdn )
11925 tmp = (hwdn*an(ix,jy,kz,lnh))/(dn(ix,jy,kz)*an(ix,jy,kz,lh))
11926 tmpg = an(ix,jy,kz,lnh)*(tmp*(3.14159))**(1./3.)
11927 IF ( tmpg .lt. cnohmn )
THEN
11930 tmp = ( (hwdn)/(dn(ix,jy,kz)*an(ix,jy,kz,lh))*(3.14159))**(1./3.)
11931 an(ix,jy,kz,lnh) = (cnohmn/tmp)**(3./4.)
11939 if ( an(ix,jy,kz,ls) .lt. frac*qxmin(ls) .or. zerocx(ls) &
11941 IF ( t0(ix,jy,kz) .lt. 273.15 )
THEN
11943 an(ix,jy,kz,lv) = an(ix,jy,kz,lv) + an(ix,jy,kz,ls)
11944 an(ix,jy,kz,ls) = 0.0
11947 IF ( ipconc .ge. 4 )
THEN
11949 an(ix,jy,kz,lns) = 0.0
11952 IF ( lvs .gt. 1 )
THEN
11953 an(ix,jy,kz,lvs) = 0.0
11956 IF ( lsw .gt. 1 )
THEN
11957 an(ix,jy,kz,lsw) = 0.0
11962 an(ix,jy,kz,lv) = an(ix,jy,kz,lv) + an(ix,jy,kz,ls)
11963 an(ix,jy,kz,ls) = 0.0
11966 IF ( lvs .gt. 1 )
THEN
11967 an(ix,jy,kz,lvs) = 0.0
11970 IF ( lsw .gt. 1 )
THEN
11971 an(ix,jy,kz,lsw) = 0.0
11974 IF ( ipconc .ge. 4 )
THEN
11976 an(ix,jy,kz,lns) = 0.0
11982 ELSEIF ( lvol(ls) .gt. 1 )
THEN
11983 IF ( an(ix,jy,kz,lvs) .gt. 0.0 )
THEN
11984 tmp = dn(ix,jy,kz)*an(ix,jy,kz,ls)/an(ix,jy,kz,lvs)
11985 IF ( tmp .gt. xdnmx(ls) .or. tmp .lt. xdnmn(ls) )
THEN
11986 tmp = min( xdnmx(ls), max( xdnmn(ls), tmp ) )
11987 an(ix,jy,kz,lvs) = dn(ix,jy,kz)*an(ix,jy,kz,ls)/tmp
11991 an(ix,jy,kz,lvs) = dn(ix,jy,kz)*an(ix,jy,kz,ls)/tmp
11997 IF ( lzr > 1 )
THEN
11998 an(ix,jy,kz,lzr) = max(0.0, an(ix,jy,kz,lzr) )
12001 if ( an(ix,jy,kz,lr) .lt. frac*qxmin(lr) .or. zerocx(lr) &
12003 an(ix,jy,kz,lv) = an(ix,jy,kz,lv) + an(ix,jy,kz,lr)
12004 an(ix,jy,kz,lr) = 0.0
12005 IF ( ipconc .ge. 3 )
THEN
12007 an(ix,jy,kz,lnr) = 0.0
12010 IF ( lzr > 1 )
THEN
12011 an(ix,jy,kz,lzr) = 0.0
12019 IF ( an(ix,jy,kz,li) .le. frac*qxmin(li) .or. zerocx(li) &
12021 an(ix,jy,kz,lv) = an(ix,jy,kz,lv) + an(ix,jy,kz,li)
12022 an(ix,jy,kz,li)= 0.0
12023 IF ( ipconc .ge. 1 )
THEN
12024 an(ix,jy,kz,lni) = 0.0
12031 IF ( lis > 1 )
THEN
12032 IF ( an(ix,jy,kz,lis) .le. frac*qxmin(lis) .or. zerocx(lis) &
12034 an(ix,jy,kz,lv) = an(ix,jy,kz,lv) + an(ix,jy,kz,lis)
12035 an(ix,jy,kz,lis)= 0.0
12036 IF ( ipconc .ge. 1 )
THEN
12037 an(ix,jy,kz,lnis) = 0.0
12040 ELSEIF ( icespheres >= 2 )
THEN
12042 IF ( 0.5*( w(ix,jy,kz) + w(ix,jy,kz+1)) < -1.0 .or. &
12043 & (icespheres == 3 .and. ( t0(ix,jy,kz) < 232.15 .or. an(ix,jy,kz,lc) < qxmin(lc) ) ) .or. &
12044 & (icespheres == 5 .and. ( t0(ix,jy,kz) < 232.15 .or. &
12045 & ( an(ix,jy,kz,lc) < qxmin(lc) .and. an(ix,jy,km1,lc) < qxmin(lc) )) ) .or. &
12046 & (icespheres == 4 .and. ( t0(ix,jy,kz) < 235.15 )) )
THEN
12047 an(ix,jy,kz,li) = an(ix,jy,kz,li) + an(ix,jy,kz,lis)
12048 an(ix,jy,kz,lni) = an(ix,jy,kz,lni) + an(ix,jy,kz,lnis)
12049 an(ix,jy,kz,lis)= 0.0
12050 an(ix,jy,kz,lnis)= 0.0
12061 IF ( an(ix,jy,kz,lc) .le. frac*qxmin(lc) .or. zerocx(lc) &
12063 an(ix,jy,kz,lv) = an(ix,jy,kz,lv) + an(ix,jy,kz,lc)
12064 an(ix,jy,kz,lc)= 0.0
12065 IF ( ipconc .ge. 2 )
THEN
12066 IF ( lccn .gt. 1 .or. ac_opt == 1 )
THEN
12067 IF ( irenuc < 5 .and. lccna <= 1 )
THEN
12068 IF ( ac_opt == 0 )
THEN
12069 an(ix,jy,kz,lccn) = an(ix,jy,kz,lccn) + max(0.0,an(ix,jy,kz,lnc))
12071 ELSEIF ( lccna > 1 )
THEN
12072 an(ix,jy,kz,lccna) = max( 0.0, an(ix,jy,kz,lccna) - max(0.0,an(ix,jy,kz,lnc)) )
12075 an(ix,jy,kz,lnc) = 0.0
12076 IF ( lccn > 1 ) an(ix,jy,kz,lccn) = max( 0.0, an(ix,jy,kz,lccn) )
12078 IF ( lccna > 0 .and. ac_opt == 0 )
THEN
12079 IF ( restoreccn )
THEN
12080 tmp = an(ix,jy,kz,li) + an(ix,jy,kz,ls)
12082 IF ( an(ix,jy,kz,lccna) > 1. .and. tmp < qxmin(li) ) an(ix,jy,kz,lccna) = an(ix,jy,kz,lccna)*exp(-dtp/ccntimeconst)
12084 ELSEIF ( lccn > 1 .and. restoreccn .and. ac_opt == 0 )
THEN
12086 tmp = an(ix,jy,kz,li) + an(ix,jy,kz,ls)
12091 IF ( an(ix,jy,kz,lccn) > 1. .and. tmp < qxmin(li) .and. ( an(ix,jy,kz,lccn) < dn(ix,jy,kz)*qccn .or. .not. invertccn ) )
THEN
12095 an(ix,jy,kz,lccn) = &
12096 dn(ix,jy,kz)*qccn - max(0.0 , dn(ix,jy,kz)*qccn - an(ix,jy,kz,lccn))*exp(-dtp/ccntimeconst)
12111 IF ( ndebug .ge. 1 )
write(6,*)
'END OF ICEZVD_DR'
12136 & (nx,ny,nz,na,jyslab &
12139 & ,t0,t1,t2,t3,t4,t5,t6,t7,t8,t9 &
12143 & ventr,ventc,c1sw,jgs,ido, &
12147 & xdn0,tmp3d,tkediss &
12148 & ,thproc,numproc,dx1,dy1,ngs &
12149 & ,timevtcalc,axtra,io_flag &
12150 & , has_wetscav,rainprod2d, evapprod2d, alpha2d &
12152 & ,elec,its,ids,ide,jds,jde &
12216 integer,
parameter :: ng1 = 1
12218 integer nx,ny,nz,na,nba,nv
12219 integer nor,norz,istag,jstag,kstag
12223 logical,
intent(in) :: io_flag
12225 integer itile,jtile,ktile
12226 integer ixbeg,jybeg
12227 integer ixend,jyend,kzend,kzbeg
12228 integer nxend,nyend,nzend,nzbeg
12229 integer :: my_rank = 0
12230 integer,
parameter :: myprock = 1, nprock = 1
12231 logical,
intent(in) :: has_wetscav
12232 integer,
intent(in) :: numproc
12233 real,
intent(inout) :: thproc(nz,numproc)
12234 real,
intent(in) :: dx1,dy1
12235 real rainprod2d(-nor+1:nx+nor,-norz+ng1:nz+norz)
12236 real evapprod2d(-nor+1:nx+nor,-norz+ng1:nz+norz)
12239 real :: alpha2d(-nor+1:nx+nor,-norz+ng1:nz+norz,3)
12241 real,
parameter :: tfrdry = 243.15
12243 logical lrescalelow(lc:lhab)
12244 real tkediss(-nor+1:nx+nor,-norz+ng1:nz+norz)
12245 real axtra(-nor+ng1:nx+nor,-nor+ng1:ny+nor,-norz+ng1:nz+norz,nxtra)
12250 integer jyslab,its,ids,ide,jds,jde
12251 integer,
intent(in) :: iunit
12253 integer iraincv, icgxconv
12254 parameter( iraincv = 1, icgxconv = 1)
12256 real :: ffrzh = 1.0
12258 real qcitmp,cirdiatmp
12264 double precision dp1
12266 double precision frac, frach, xvfrz, xvbiggsnow
12268 double precision :: timevtcalc
12269 double precision :: dpt1,dpt2
12271 logical,
parameter :: gammacheck = .false.
12273 double precision :: tmpgam
12274 logical,
parameter :: usegamxinfcnu = .false.
12275 logical,
parameter :: usegamxinf = .false.
12276 logical,
parameter :: usegamxinf2 = .false.
12277 logical,
parameter :: usegamxinf3 = .false.
12281 character(len=*),
intent( out) :: errmsg
12282 integer,
intent( out) :: errflg
12287 double precision chgneg,chgpos,sctot
12291 real pb(-norz+ng1:nz+norz)
12292 real pinit(-norz+ng1:nz+norz)
12294 real gz(-nor+ng1:nx+nor,-nor+ng1:ny+nor,-norz+ng1:nz+norz)
12296 real qimax,xni0,roqi0
12302 integer itest,nidx,id1,jd1,kd1
12305 parameter(id1=1,jd1=1,kd1=1)
12309 integer ix,kz, il, ic, ir, icp1, irp1, ip1,jp1,kp1
12313 real slope1, slope2
12316 parameter(eps=1.e-20,eps2=1.e-5)
12323 logical ldovol, ishail, ltest, wtest
12324 logical ,
parameter :: alp0flag = .false.
12330 parameter(mu=1,mv=2,mw=3)
12334 integer mqcw,mqxw,mtem,mrho,mtim
12335 parameter(mqcw=21,mqxw=21,mtem=21,mrho=5,mtim=6)
12337 real xftim,xftimi,yftim, xftem,yftem, xfqcw,yfqcw, xfqxw,yfqxw
12338 parameter(xftim=0.05,xftimi = 1./xftim,yftim=1.)
12339 parameter(xftem=0.5,yftem=1.)
12340 parameter(xfqcw=2000.,yfqcw=1.)
12341 parameter(xfqxw=2000.,yfqxw=1.)
12343 parameter( dtfac = 1.0 )
12344 integer ido(lc:lqmx)
12357 real delqnxa(lc:lqmx)
12358 real delqxxa(lc:lqmx)
12362 real t00(-nor+ng1:nx+nor,-nor+ng1:ny+nor,-norz+ng1:nz+norz)
12363 real t77(-nor+ng1:nx+nor,-nor+ng1:ny+nor,-norz+ng1:nz+norz)
12365 real t0(-nor+ng1:nx+nor,-nor+ng1:ny+nor,-norz+ng1:nz+norz)
12366 real t1(-nor+ng1:nx+nor,-nor+ng1:ny+nor,-norz+ng1:nz+norz)
12367 real t2(-nor+ng1:nx+nor,-nor+ng1:ny+nor,-norz+ng1:nz+norz)
12368 real t3(-nor+ng1:nx+nor,-nor+ng1:ny+nor,-norz+ng1:nz+norz)
12369 real t4(-nor+ng1:nx+nor,-nor+ng1:ny+nor,-norz+ng1:nz+norz)
12370 real t5(-nor+ng1:nx+nor,-nor+ng1:ny+nor,-norz+ng1:nz+norz)
12371 real t6(-nor+ng1:nx+nor,-nor+ng1:ny+nor,-norz+ng1:nz+norz)
12372 real t7(-nor+ng1:nx+nor,-nor+ng1:ny+nor,-norz+ng1:nz+norz)
12373 real t8(-nor+ng1:nx+nor,-nor+ng1:ny+nor,-norz+ng1:nz+norz)
12374 real t9(-nor+ng1:nx+nor,-nor+ng1:ny+nor,-norz+ng1:nz+norz)
12376 real p2(-nor+1:nx+nor,-nor+1:ny+nor,-norz+ng1:nz+norz)
12377 real pn(-nor+1:nx+nor,-nor+1:ny+nor,-norz+ng1:nz+norz)
12378 real an(-nor+ng1:nx+nor,-nor+ng1:ny+nor,-norz+ng1:nz+norz,na)
12379 real dn(-nor+1:nx+nor,-nor+1:ny+nor,-norz+ng1:nz+norz)
12380 real w(-nor+1:nx+nor,-nor+1:ny+nor,-norz+ng1:nz+norz)
12382 real tmp3d(-nor+ng1:nx+nor,-nor+ng1:ny+nor,-norz+ng1:nz+norz)
12387 integer nxmpb,nzmpb,nxz
12388 integer jgs,mgs,ngs,numgs
12389 integer,
parameter :: ngsz = 500
12395 integer ngscnt,igs(ngs),kgs(ngs)
12396 integer kgsp(ngs),kgsm(ngs),kgsm2(ngs)
12399 integer il0(ngs),il5(ngs),il2(ngs),il3(ngs)
12402 real tdtol,temsav,tfrcbw,tfrcbi
12403 real,
parameter :: thnuc = 235.15
12407 real fimt1(ngs),fimta(ngs),fimt2(ngs)
12415 real ccnc(ngs),ccin(ngs),cina(ngs),ccna(ngs)
12418 parameter( sscb = 2.0 )
12420 parameter( idecss = 1 )
12426 parameter( ifilt = 0 )
12428 real :: mwat, mice, dice, mwshed, fwmax, fw, mwcrit, massfactor, tmpdiam
12429 real,
parameter :: shedalp = 3.
12435 real bfnu, bfnu0, bfnu1
12436 parameter( bfnu0 = (rnu + 2.0)/(rnu + 1.0) )
12439 double precision t2s, xdp
12440 double precision xl2p(ngs),rb(ngs)
12441 real,
parameter :: aa1 = 9.44e15, aa2 = 5.78e3
12443 real,
parameter :: cexs = 0.1, cecs = 0.5
12444 real,
parameter :: rvt = 0.104
12445 real,
parameter :: kfrag = 1.0e-6
12446 real,
parameter :: mfrag = 1.0e-10
12447 double precision cautn(ngs), rh(ngs), nh(ngs)
12448 real ex1, ft, rhoinv(ngs)
12449 double precision ec0(ngs)
12451 real ac1,bc, taus, c1,d1,e1,f1,p380,tmp,tmp1,tmp2,tmp3,tmp4,tmp5,tmp6,temp3
12454 double precision :: tmpz, tmpzmlt
12455 real ratio, delx, dely
12457 real chgtmp,fac,mixedphasefac
12458 real x,y,y2,del,r,rtmp,alpr
12459 double precision :: vent1,vent2
12460 double precision :: g1palp,g4palp
12461 double precision :: g1palpinf,g4palpinf
12465 real d1r, d1i, d1s, e1i
12467 real,
parameter :: vr1mm = 5.23599e-10
12468 real,
parameter :: vr3mm = 5.23599e-10*(3.0/1.)**3
12469 real,
parameter :: vr4p5mm = 5.23599e-10*(4.5/1.)**3
12470 real vmlt,vshd, vshdgs(ngs,lh:lhab), maxmassfac(lc:lhab)
12472 parameter( rhosm = 500. )
12474 real dtcon,dtcon1,dtcon2
12476 integer ltemq1,ltemq1m
12477 real dqv,qv1,ss1,ss2,qvs1,dqvs,dtemp,dt1
12478 real ssi1, ssi2, dqvi, dqvis, dqvii,qis1
12479 real dqvr, dqc, dqr, dqi, dqs
12480 real qv1m,qvs1m,ss1m,ssi1m,qis1m
12482 real dcloud,dcloud2
12484 double precision xvc, xvr
12492 parameter( vgra = 0.523599*(1.0e-3)**3 )
12496 real :: d, dold, denom,denominv,vth
12497 double precision :: h1, h2, h3, h4,denomdp, denominvdp
12500 real vr,nrx,chw,g1,qr,z,z1,rdi,alp,xnutmp,xnuc,g1r,rd1,rdia,rmas
12501 real :: snowmeltmass = 0
12504 real,
parameter :: rimedens = 500.
12511 parameter( raero = 3.e-7, kaero = 5.39e-3 )
12513 parameter(kb = 1.3807e-23)
12515 real knud(ngs),knuda(ngs)
12518 real fn1(ngs),fn2(ngs),fnft(ngs)
12521 real ctfzbd(ngs),ctfzth(ngs),ctfzdi(ngs)
12526 real dqvcnd(ngs),dqwv(ngs),dqcw(ngs),dqci(ngs),dqcitmp(ngs),dqwvtmp(ngs)
12528 real temg(ngs),temcg(ngs),theta(ngs),qvap(ngs)
12529 real temgkm1(ngs), temgkm2(ngs)
12530 real temgx(ngs),temcgx(ngs)
12531 real qvs(ngs),qis(ngs),qss(ngs),pqs(ngs)
12532 real elv(ngs),elf(ngs),els(ngs)
12533 real tsqr(ngs),ssi(ngs),ssw(ngs),ssi0(ngs)
12534 real qcwtmp(ngs),qtmp,qtot(ngs)
12537 real cimasn,cimasx,ccimx
12539 real cs,ds,gf7,gf6,gf5,gf4,gf3,gf2,gf1
12541 real gf73rds, gf83rds
12542 real gamice73fac, gamsnow73fac
12543 real gf43rds, gf53rds
12544 real aradcw,bradcw,cradcw,dradcw,cwrad,rwrad,rwradmn
12545 parameter( rwradmn = 50.e-6 )
12547 real dg0(ngs),df0(ngs)
12548 real dhwet(ngs),dhlwet(ngs),dfwet(ngs)
12550 real clionpmx,clionnmx
12551 parameter(clionpmx=1.e9,clionnmx=1.e9)
12555 real fwet1(ngs),fwet2(ngs)
12556 real fmlt1(ngs),fmlt2(ngs),fmlt1e(ngs)
12557 real fvds(ngs),fvce(ngs),fiinit(ngs)
12558 real fvent(ngs),fraci(ngs),fracl(ngs)
12560 real fai(ngs),fav(ngs),fbi(ngs),fbv(ngs)
12561 real felv(ngs),fels(ngs),felf(ngs)
12562 real felvcp(ngs),felscp(ngs),felfcp(ngs)
12563 real felvpi(ngs),felspi(ngs),felfpi(ngs)
12564 real felvs(ngs),felss(ngs)
12565 real fwvdf(ngs),ftka(ngs),fthdf(ngs)
12566 real fadvisc(ngs),fakvisc(ngs)
12567 real fci(ngs),fcw(ngs)
12568 real fschm(ngs),fpndl(ngs)
12569 real fgamw(ngs),fgams(ngs)
12570 real fcqv1(ngs),fcqv2(ngs),fcc3(ngs)
12574 real,
parameter :: cpv = 1885.0
12576 real fcci(ngs), fcip(ngs)
12578 real :: sfm1(ngs),sfm2(ngs)
12579 real :: gfm1(ngs),gfm2(ngs)
12580 real :: ffm1(ngs),ffm2(ngs)
12581 real :: hfm1(ngs),hfm2(ngs)
12583 logical :: wetsfc(ngs),wetsfchl(ngs),wetsfcf(ngs)
12584 logical :: wetgrowth(ngs), wetgrowthhl(ngs), wetgrowthf(ngs)
12586 real qitmp(ngs),qistmp(ngs)
12588 real rzxh(ngs), rzxhl(ngs), rzxhlh(ngs), rzxhlf(ngs)
12589 real rzxs(ngs), rzxf(ngs)
12591 real cdh(ngs),cdhl(ngs)
12592 real :: axx(ngs,lh:lhab),bxx(ngs,lh:lhab)
12595 real :: qcwresv(ngs), ccwresv(ngs)
12597 real :: lfsave(ngs,6)
12598 real :: qx(ngs,lv:lhab)
12599 real :: qxw(ngs,ls:lhab)
12600 real :: qxwlg(ngs,lh:lhab)
12601 real :: chxf(ngs,lh:lhab)
12602 real :: cx(ngs,lc:lhab)
12603 real :: cxmxd(ngs,lc:lhab)
12604 real :: qxmxd(ngs,lv:lhab)
12605 real :: scx(ngs,lc:lhab)
12606 real :: xv(ngs,lc:lhab)
12607 real :: vtxbar(ngs,lc:lhab,3)
12608 real :: xmas(ngs,lc:lhab)
12609 real :: xdn(ngs,lc:lhab)
12610 real :: xdntmp(ngs,lc:lhab)
12611 real :: cdxgs(ngs,lc:lhab)
12612 real :: xdia(ngs,lc:lhab,3)
12613 real :: vtwtdia(ngs,lr:lhab)
12614 real :: rarx(ngs,ls:lhab)
12615 real :: vx(ngs,li:lhab)
12616 real :: rimdn(ngs,li:lhab)
12617 real :: raindn(ngs,li:lhab)
12618 real :: alpha(ngs,lc:lhab)
12619 real :: dab0lh(ngs,lc:lhab,lc:lhab)
12620 real :: dab1lh(ngs,lc:lhab,lc:lhab)
12621 real :: zx(ngs,lr:lhab)
12622 real :: zxmxd(ngs,lr:lhab)
12623 real :: g1x(ngs,lr:lhab)
12626 real :: qsimxdep(ngs)
12627 real :: qsimxsub(ngs)
12628 logical,
parameter :: DoSublimationFix = .true.
12629 real :: qrtmp(ngs),qvtmp(ngs),qctmp(ngs)
12630 real :: felvcptmp,felscptmp,qsstmp
12631 real :: thetatmp, thetaptmp, temcgtmp,qvaptmp
12632 real :: qvstmp, qisstmp, qvptmp, qitmp1, qctmp1
12638 real g1shr, alphashr
12639 real g1mlr, alphamlr
12640 real g1smlr, alphasmlr
12641 real massfacshr, massfacmlr
12648 real,
parameter :: fwmhtmptem = -15.
12649 real,
parameter :: d1t = (6.0 * 0.268e-3/(917.* pi))**(1./3.)
12650 real,
parameter :: srasheym = 0.1389
12652 real swvent(ngs),hwvent(ngs),rwvent(ngs),hlvent(ngs),hwventy(ngs),hlventy(ngs),rwventz(ngs)
12654 real hlventinc(ngs),hwventinc(ngs)
12655 integer,
parameter :: ndiam = 10
12657 real hwvent0(ndiam+4),hlvent0
12658 real hwvent1,hlvent1
12659 real hwvent2,hlvent2
12664 real :: mltdiam(ndiam+4)
12665 real mltmass0inv,mltmass1inv,mltmass2inv, mltmass1cgs, mltmass2cgs,mltmass3inv, mltmass3cgs
12666 real qhmlr0, qhmlr05, qhmlr1, qhmlr2,qhmlr3, qhmlr12, qhmlr23
12667 real qhlmlr0, qhlmlr05, qhlmlr1, qhlmlr2,qhlmlr3, qhlmlr12, qhlmlr23
12668 real qxd1, cxd1, zxd1
12671 real :: qxd(ndiam+4), cxd(ndiam+4), qhml(ndiam+4), qhml0(ndiam+4)
12672 real :: dqxd(ndiam+4), dcxd(ndiam+4), dqhml(ndiam+4)
12679 real xdnmx(lc:lhab), xdnmn(lc:lhab)
12681 real :: xdiamxmas(ngs,lc:lhab)
12686 real rwcap(ngs),swcap(ngs)
12693 real qimxd(ngs),qismxd(ngs),qcmxd(ngs),qrmxd(ngs),qsmxd(ngs),qhmxd(ngs),qhlmxd(ngs)
12694 real cimxd(ngs),ccmxd(ngs),crmxd(ngs),csmxd(ngs),chmxd(ngs)
12695 real cionpmxd(ngs),cionnmxd(ngs)
12696 real clionpmxd(ngs),clionnmxd(ngs)
12699 real elec(-nor+ng1:nx+nor,-nor+ng1:ny+nor,-norz+ng1:nz+norz)
12704 real chmul1(ngs),chlmul1(ngs),csmul1(ngs),csmul(ngs)
12705 real qhmul1(ngs),qhlmul1(ngs),qsmul1(ngs),qsmul(ngs)
12708 real csplinter(ngs),qsplinter(ngs)
12709 real csplinter2(ngs),qsplinter2(ngs)
12714 real :: chlcnh(ngs), vhlcnh(ngs), vhlcnhl(ngs)
12715 real :: chlcnhhl(ngs)
12716 real cracif(ngs), ciacrf(ngs)
12720 real ciint(ngs), crfrz(ngs), crfrzf(ngs), crfrzs(ngs)
12723 real ciacw(ngs), cwacii(ngs)
12724 real ciacr(ngs), craci(ngs)
12727 real csaci(ngs), csacs(ngs)
12729 real chacw(ngs), chacr(ngs)
12730 real :: chlacw(ngs)
12731 real chaci(ngs), chacs(ngs)
12733 real :: chlacr(ngs)
12734 real :: chlaci(ngs), chlacs(ngs)
12736 real cidpv(ngs),cisbv(ngs)
12737 real cisdpv(ngs),cissbv(ngs)
12738 real cimlr(ngs),cismlr(ngs)
12740 real chlsbv(ngs), chldpv(ngs)
12741 real chlmlr(ngs), chlmlrr(ngs)
12744 real chlshr(ngs), chlshrr(ngs)
12747 real chdpv(ngs),chsbv(ngs)
12748 real chmlr(ngs),chcev(ngs)
12750 real chshr(ngs), chshrr(ngs)
12752 real csdpv(ngs),cssbv(ngs)
12753 real csmlr(ngs),csmlrr(ngs),cscev(ngs)
12754 real csshr(ngs), csshrr(ngs)
12758 real cwshw(ngs), qwshw(ngs)
12765 real qrcnw(ngs), qwcnr(ngs)
12766 real zrcnw(ngs),zracr(ngs),zracw(ngs),zrcev(ngs)
12773 real :: qhlacw(ngs), qxacwtmp, qxacrtmp, qxacitmp, qxacstmp
12774 real vhacw(ngs), vsacw(ngs), vhlacw(ngs), vhlacr(ngs)
12777 real qfmul1(ngs),cfmul1(ngs)
12784 real qsacr(ngs),qracs(ngs)
12785 real qhacr(ngs),qhacrmlr(ngs),qhacwmlr(ngs)
12786 real vhacr(ngs), zhacr(ngs), zhacrf(ngs), zrach(ngs), zrachl(ngs)
12787 real qiacr(ngs),qraci(ngs)
12791 real qracif(ngs),qiacrf(ngs),qiacrs(ngs),ciacrs(ngs)
12793 real :: qhlacr(ngs),qhlacrmlr(ngs), qhlacwmlr(ngs)
12803 real :: qhacis(ngs)
12804 real :: chacis(ngs)
12805 real :: chacis0(ngs)
12807 real :: csaci0(ngs)
12808 real :: chaci0(ngs)
12809 real :: chacs0(ngs)
12810 real :: chlaci0(ngs)
12811 real :: chlacis(ngs)
12812 real :: chlacis0(ngs)
12813 real :: chlacs0(ngs)
12815 real :: qsaci0(ngs)
12816 real :: qsacis0(ngs)
12817 real :: qhaci0(ngs)
12818 real :: qhacis0(ngs)
12819 real :: qhacs0(ngs)
12820 real :: qhlaci0(ngs)
12821 real :: qhlacis0(ngs)
12822 real :: qhlacs0(ngs)
12824 real :: qhlaci(ngs)
12825 real :: qhlacis(ngs)
12826 real :: qhlacs(ngs)
12831 real zrfrz(ngs), zrfrzf(ngs), zrfrzs(ngs)
12832 real ziacrf(ngs), zhcnsh(ngs), zhcnih(ngs)
12833 real zhacw(ngs), zhacs(ngs), zhaci(ngs)
12834 real zhmlr(ngs), zhdsv(ngs), zhsbv(ngs), zhlcnh(ngs), zhshr(ngs)
12835 real zfacw(ngs), zfacs(ngs), zfaci(ngs)
12836 real zfmlr(ngs), zfdsv(ngs), zfsbv(ngs), zhlcnf(ngs), zfshr(ngs), zfshrr(ngs)
12837 real zhmlrtmp,zhmlr0inf,zhlmlr0inf
12838 real zhmlrr(ngs),zhlmlrr(ngs),zhshrr(ngs),zhlshrr(ngs),zfmlrr(ngs)
12840 real zsmlrr(ngs), zsshr(ngs), zsshrr(ngs)
12841 real zhcns(ngs), zhcni(ngs)
12842 real zhwdn(ngs), zfwdn(ngs)
12845 real zhlacw(ngs), zhlacs(ngs), zhlacr(ngs)
12846 real zhlmlr(ngs), zhldsv(ngs), zhlsbv(ngs), zhlshr(ngs)
12849 real vrfrzf(ngs), viacrf(ngs)
12850 real qrfrzs(ngs), qrfrzf(ngs)
12851 real qwfrz(ngs), qwctfz(ngs)
12852 real cwfrz(ngs), cwctfz(ngs)
12853 real qwfrzis(ngs), qwctfzis(ngs)
12854 real cwfrzis(ngs), cwctfzis(ngs)
12855 real qwfrzc(ngs), qwctfzc(ngs)
12856 real cwfrzc(ngs), cwctfzc(ngs)
12857 real qwfrzp(ngs), qwctfzp(ngs)
12858 real cwfrzp(ngs), cwctfzp(ngs)
12859 real xcolmn(ngs), xplate(ngs)
12860 real ciihr(ngs), qiihr(ngs)
12861 real cicichr(ngs), qicichr(ngs)
12862 real cipiphr(ngs), qipiphr(ngs)
12863 real qscni(ngs), cscni(ngs), cscnis(ngs)
12864 real qscnvi(ngs), cscnvi(ngs), cscnvis(ngs)
12865 real qhcns(ngs), chcns(ngs), chcnsh(ngs), vhcns(ngs)
12866 real qscnh(ngs), cscnh(ngs), vscnh(ngs)
12867 real qhcni(ngs), chcni(ngs), chcnih(ngs), vhcni(ngs)
12868 real qiint(ngs),qipipnt(ngs),qicicnt(ngs)
12869 real cninm(ngs),cnina(ngs),cninp(ngs),wvel(ngs),wvelkm1(ngs)
12871 real uvel(ngs),vvel(ngs)
12873 real qidpv(ngs),qisbv(ngs)
12874 real qimlr(ngs),qidsv(ngs),qisdsv(ngs),qidsvp(ngs)
12879 real :: qhldpv(ngs), qhlsbv(ngs)
12880 real :: qhlmlr(ngs), qhldsv(ngs), qhlmlrsave(ngs)
12881 real :: qhlwet(ngs), qhldry(ngs), qhlshr(ngs), qxwettmp
12883 real :: qrfz(ngs),qsfz(ngs),qhfz(ngs),qhlfz(ngs)
12886 real qhdpv(ngs),qhsbv(ngs)
12887 real qhmlr(ngs),qhdsv(ngs),qhcev(ngs),qhcndv(ngs),qhevv(ngs)
12888 real qhlcev(ngs), chlcev(ngs)
12889 real qhwet(ngs),qhdry(ngs),qhshr(ngs)
12897 real qhmlrlg(ngs),qhlmlrlg(ngs)
12899 real qhlfzhllg(ngs)
12900 real qhlcevlg(ngs), chlcevlg(ngs)
12901 real qhcevlg(ngs), chcevlg(ngs)
12903 real vhfzh(ngs), vffzf(ngs)
12914 real qsdpv(ngs),qssbv(ngs)
12915 real qsmlr(ngs),qsdsv(ngs),qscev(ngs),qscndv(ngs),qsevv(ngs)
12916 real qswet(ngs),qsdry(ngs),qsshr(ngs)
12921 real qipdpv(ngs),qipsbv(ngs)
12922 real qipmlr(ngs),qipdsv(ngs)
12924 real qirdpv(ngs),qirsbv(ngs)
12925 real qirmlr(ngs),qirdsv(ngs),qirmlw(ngs)
12927 real qgldpv(ngs),qglsbv(ngs)
12928 real qglmlr(ngs),qgldsv(ngs)
12929 real qglwet(ngs),qgldry(ngs),qglshr(ngs)
12932 real qgmdpv(ngs),qgmsbv(ngs)
12933 real qgmmlr(ngs),qgmdsv(ngs)
12934 real qgmwet(ngs),qgmdry(ngs),qgmshr(ngs)
12936 real qghdpv(ngs),qghsbv(ngs)
12937 real qghmlr(ngs),qghdsv(ngs)
12938 real qghwet(ngs),qghdry(ngs),qghshr(ngs)
12941 real qrztot(ngs),qrzmax(ngs),qrzfac(ngs)
12944 real fsw(ngs),fhw(ngs),fhlw(ngs),ffw(ngs)
12945 real fswmax(ngs),fhwmax(ngs),fhlwmax(ngs)
12948 real :: qhlcnh(ngs)
12949 real qhcngh(ngs),qhcngm(ngs),qhcngl(ngs)
12951 real :: qhcnhl(ngs), chcnhl(ngs), zhcnhl(ngs), vhcnhl(ngs)
12953 real eiw(ngs),eii(ngs),eiri(ngs),eipir(ngs),eisw(ngs)
12954 real erw(ngs),esw(ngs),eglw(ngs),eghw(ngs),efw(ngs)
12955 real ehxw(ngs),ehlw(ngs),egmw(ngs),ehw(ngs)
12956 real err(ngs),esr(ngs),eglr(ngs),eghr(ngs),efr(ngs)
12957 real ehxr(ngs),ehlr(ngs),egmr(ngs)
12958 real eri(ngs),esi(ngs),egli(ngs),eghi(ngs),efi(ngs),efis(ngs)
12959 real ehxi(ngs),ehli(ngs),egmi(ngs),ehi(ngs),ehis(ngs),ehlis(ngs)
12960 real ers(ngs),ess(ngs),egls(ngs),eghs(ngs),efs(ngs),ehs(ngs),ehsfac(ngs)
12962 real ehxs(ngs),ehls(ngs),egms(ngs),egmip(ngs)
12964 real ehsclsn(ngs),ehiclsn(ngs),ehisclsn(ngs)
12965 real efsclsn(ngs),eficlsn(ngs),efisclsn(ngs)
12966 real ehlsclsn(ngs),ehliclsn(ngs),ehlisclsn(ngs)
12969 real :: ehs_collsn = 0.5, ehi_collsn = 1.0
12970 real :: efs_collsn = 0.5, efi_collsn = 1.0
12971 real :: ehls_collsn = 1.0, ehli_collsn = 1.0
12972 real :: esi_collsn = 1.0
12976 data cwr / 2.0, 3.0, 4.0, 6.0, 8.0, 10.0, 15.0, 20.0 , &
12977 & 1.0, 1.0, 0.5, 0.5, 0.5, 0.2, 0.2, 1. /
12978 integer icwr(ngs), igwr(ngs), irwr(ngs), ihlr(ngs), ifwr(ngs)
12980 data grad / 100., 200., 300., 400., 600., 1000., &
12981 & 1.e-2,1.e-2,1.e-2,5.e-3,2.5e-3, 1. /
12983 data ew /0.03, 0.07, 0.17, 0.41, 0.58, 0.69, 0.82, 0.88, &
12985 & 0.10, 0.20, 0.34, 0.58, 0.70, 0.78, 0.88, 0.92, &
12986 & 0.15, 0.31, 0.44, 0.65, 0.75, 0.83, 0.96, 0.91, &
12987 & 0.17, 0.37, 0.50, 0.70, 0.81, 0.87, 0.93, 0.96, &
12988 & 0.17, 0.40, 0.54, 0.71, 0.83, 0.88, 0.94, 0.98, &
12989 & 0.15, 0.37, 0.52, 0.74, 0.82, 0.88, 0.94, 0.98 /
12993 real da0lr(ngs),da1lr(ngs)
12994 real da0lc(ngs),da1lc(ngs)
12998 real :: da0lx(ngs,lr:lhab)
13001 real vab0(lc:lqmx,lc:lqmx)
13002 real vab1(lc:lqmx,lc:lqmx)
13004 real ehip(ngs),ehlip(ngs),ehlir(ngs)
13005 real erir(ngs),esir(ngs),eglir(ngs),egmir(ngs),eghir(ngs)
13006 real efir(ngs),ehir(ngs),eirw(ngs),eirir(ngs),ehr(ngs)
13007 real erip(ngs),esip(ngs),eglip(ngs),eghip(ngs)
13008 real efip(ngs),eipi(ngs),eipw(ngs),eipip(ngs)
13014 real pqcwi(ngs),pqcii(ngs),pqrwi(ngs),pqisi(ngs)
13015 real pqswi(ngs),pqhwi(ngs),pqwvi(ngs)
13016 real pqgli(ngs),pqghi(ngs),pqfwi(ngs)
13017 real pqgmi(ngs),pqhli(ngs)
13018 real pqiri(ngs),pqipi(ngs)
13019 real pqlwsi(ngs),pqlwhi(ngs),pqlwhli(ngs),pqlwfi(ngs)
13021 real pqlwlghi(ngs),pqlwlghli(ngs)
13022 real pqlwlghd(ngs),pqlwlghld(ngs)
13027 real pvhwi(ngs), pvhwd(ngs)
13028 real pvfwi(ngs), pvfwd(ngs)
13029 real pvhli(ngs), pvhld(ngs)
13030 real pvswi(ngs), pvswd(ngs)
13032 real pqcwd(ngs),pqcid(ngs),pqrwd(ngs),pqisd(ngs), pqcwdacc(ngs)
13033 real pqswd(ngs),pqhwd(ngs),pqwvd(ngs)
13034 real pqgld(ngs),pqghd(ngs),pqfwd(ngs)
13035 real pqgmd(ngs),pqhld(ngs)
13036 real pqird(ngs),pqipd(ngs)
13037 real pqlwsd(ngs),pqlwhd(ngs),pqlwhld(ngs),pqlwfd(ngs)
13042 real pcipi(ngs), pcipd(ngs)
13043 real pciri(ngs), pcird(ngs)
13044 real pccwi(ngs), pccwd(ngs), pccwdacc(ngs)
13045 real pccii(ngs), pccid(ngs)
13046 real pcisi(ngs), pcisd(ngs)
13048 real pcrwi(ngs), pcrwd(ngs)
13049 real pcswi(ngs), pcswd(ngs)
13050 real pchwi(ngs), pchwd(ngs)
13051 real pchli(ngs), pchld(ngs)
13052 real pcfwi(ngs), pcfwd(ngs)
13053 real pcgli(ngs), pcgld(ngs)
13054 real pcgmi(ngs), pcgmd(ngs)
13055 real pcghi(ngs), pcghd(ngs)
13057 real pzrwi(ngs), pzrwd(ngs)
13058 real pzhwi(ngs), pzhwd(ngs)
13059 real pzfwi(ngs), pzfwd(ngs)
13060 real pzhli(ngs), pzhld(ngs)
13061 real pzswi(ngs), pzswd(ngs)
13071 real pres(ngs),pipert(ngs)
13073 real rho0(ngs),pi0(ngs)
13074 real rhovt(ngs),sqrtrhovt
13075 real thetap(ngs),theta0(ngs),qwvp(ngs),qv0(ngs)
13077 real ptwfzi(ngs),ptimlw(ngs)
13078 real psub(ngs),pvap(ngs),pfrz(ngs),ptem(ngs),pmlt(ngs),pevap(ngs),pdep(ngs),ptem2(ngs)
13092 parameter(iholef = 1)
13093 parameter(iholen = 1)
13094 real cqtotn,cqtotn1
13104 real cqtotp,cqtotp1
13129 real ssifac, qvapor
13133 real,
parameter :: cwmas30 = 1000.*0.523599*(2.*30.e-6)**3
13134 real,
parameter :: cwmas20 = 1000.*0.523599*(2.*20.e-6)**3
13135 integer ireadqf,lrho,lqsw,lqgl,lqgm ,lqgh
13139 real erbnd1, fdgt1, costhe1
13141 real dyi2,dzi2,bta1,cnit,dragh,dnz00,pii
13142 real qccrit,gf4br,gf4ds,gf4p5, gf3ds, gf1ds
13147 real xdn_new,drhodt
13149 integer l ,ltemq,inumgs, idelq
13156 real cval,aval,eval,fval,gval ,qsign,ftelwc,qconkq,elecfac,altelecfac
13157 real qconm,qconn,cfce15,gf8,gf4i,gf3p5,gf1a,gf1p5,qdiff,argrcnw
13158 real c4,bradp,bl2,bt2,dthr,hrifac, hdia0,hdia1,civenta,civentb
13159 real civentc,civentd,civente,civentf,civentg,cireyn,xcivent
13160 real cipventa,cipventb,cipventc,cipventd,cipreyn,cirventa
13162 integer igmrwa,igmrwb,igmswa, igmswb,igmfwa,igmfwb,igmhwa,igmhwb
13163 real rwventa ,rwventb,swventa,swventb,fwventa,fwventb,fwventc
13164 real hwventa,hwventb
13165 real hwventc, hlventa, hlventb, hlventc
13166 real glventa, glventb, glventc
13167 real gmventa, gmventb, gmventc, ghventa, ghventb, ghventc
13168 real dzfacp, dzfacm, cmassin, cwdiar
13169 real rimmas, rhobar
13170 real argtim, argqcw, argqxw, argtem
13171 real frcswsw, frcswgl, frcswgm, frcswgh, frcswfw, frcswsw1
13172 real frcglgl, frcglgm, frcglgh, frcglfw, frcglgl1
13173 real frcgmgl, frcgmgm, frcgmgh, frcgmfw, frcgmgm1
13174 real frcghgl, frcghgm, frcghgh, frcghfw, frcghgh1
13175 real frcfwgl, frcfwgm, frcfwgh, frcfwfw, frcfwfw1
13176 real frcswrsw, frcswrgl, frcswrgm, frcswrgh, frcswrfw
13178 real frcrswsw, frcrswgl, frcrswgm, frcrswgh, frcrswfw
13180 real frcglrgl, frcglrgm, frcglrgh, frcglrfw, frcglrgl1
13182 real frcrglgm, frcrglgh, frcrglfw, frcrglgl1
13183 real frcgmrgl, frcgmrgm, frcgmrgh, frcgmrfw, frcgmrgm1
13184 real frcrgmgl, frcrgmgm, frcrgmgh, frcrgmfw, frcrgmgm1
13185 real total, qweps, gf2a, gf4a, dqldt, dqidt, dqdt
13186 real frcghrgl, frcghrgm, frcghrgh, frcghrfw, frcghrgh1, frcrghgl
13187 real frcrghgm, frcrghgh, frcrghfw, frcrghgh1
13188 real a1,a2,a3,a4,a5,a6
13190 real cdw, cdi, denom1, denom2, delqci1, delqip1
13191 real cirtotn, ciptotn, cgmtotn, chltotn, cirtotp
13192 real cgmfac, chlfac, cirfac
13193 integer igmhla, igmhlb, igmgla, igmglb, igmgma, igmgmb
13194 integer igmgha, igmghb
13195 integer idqis, item, itim0
13196 integer iqgl, iqgm, iqgh, iqrw, iqsw
13203 integer cntnic_noliq
13204 real q_noliqmn, q_noliqmx
13205 real scsacimn, scsacimx
13211 real :: xden,xmlt,cmlt,cmlttot,fventm,fventh,am,ah,felfinv,dmwdt
13213 real :: qhmlrtmp,qhmlrtmp2, chmlrtmp, chmlrtmpd1inf, chlmlrtmp, zhlmlrtmp, zhlmlrrtmp, qvs0,tmpcmlt
13215 real :: term1,term2,term3,term4
13219 real,
parameter :: c1r=19.0, c2r=0.6, c3r=1.8, c4r=17.0
13220 real,
parameter :: c1h=5.5, c2h=0.7, c3h=4.5, c4h=8.5
13221 real,
parameter :: c1hl=3.7, c2hl=0.3, c3hl=9.0, c4hl=6.5, c5hl=1.0, c6hl=6.5
13225 real :: galpha, dgalpha
13227 logical,
parameter :: newton = .false.
13230 galpha(a_in) = ((4. + a_in)*(5. + a_in)*(6. + a_in))/((1. + a_in)*(2. + a_in)*(3. + a_in))
13231 dgalpha(a_in) = (876. + 1260.*a_in + 621.*a_in**2 + 126.*a_in**3 + 9.*a_in**4)/ &
13232 & (36. + 132.*a_in + 193.*a_in**2 + 144.*a_in**3 + 58.*a_in**4 + 12.*a_in**5 + a_in**6)
13262 lrescalelow(:) = rescale_low_alpha
13263 lrescalelow(lr) = rescale_low_alphar .and. rescale_low_alpha
13264 lrescalelow(lh) = rescale_low_alphah .and. rescale_low_alpha
13265 IF ( lf > 1 ) lrescalelow(lf) = rescale_low_alphah .and. rescale_low_alpha
13266 IF ( lhl > 1 ) lrescalelow(lhl) = rescale_low_alphahl .and. rescale_low_alpha
13273 IF ( ngs .lt. nz )
THEN
13287 ldovol = ldovol .or. ( lvol(il) .gt. 1 )
13325 bradcw = 0.26249e+06
13326 cradcw = -1.8896e+10
13327 dradcw = 4.4626e+14
13341 gf1p5 = 0.8862269255
13349 gf4br = 17.837861981813607
13350 gf4ds = 10.41688578110938
13351 gf4p5 = 11.63172839656745
13352 gf3ds = 3.0458730354120997
13353 gf1ds = 0.8863557896089221
13355 gf43rds = 0.8929795116
13356 gf53rds = 0.9027452930
13357 gf73rds = 1.190639349
13358 gf83rds = 1.504575488
13360 gamice73fac = (
gamma_sp(7./3. + cinu))**3/ (
gamma_sp(1. + cinu)**3 * (1. + cinu)**4)
13361 gamsnow73fac = (
gamma_sp(7./3. + snu))**3/ (
gamma_sp(1. + snu)**3 * (1. + snu)**4)
13374 bfnu1 = (4. + alphar)*(5. + alphar)*(6. + alphar)/ &
13375 & ((1. + alphar)*(2. + alphar)*(3. + alphar))
13377 galpharaut = (6.+alpharaut)*(5.+alpharaut)*(4.+alpharaut)/ &
13378 & ((3.+alpharaut)*(2.+alpharaut)*(1.+alpharaut))
13380 vfrz = 0.523599*(dfrz)**3
13381 vmlt = min(xvmx(lr), 0.523599*(dmlt)**3 )
13382 vshd = min(xvmx(lr), 0.523599*(dshd)**3 )
13384 IF ( snowmeltdia > 0.0 )
THEN
13385 snowmeltmass = pi/6.0 * 1000. * snowmeltdia**3
13392 IF ( mixedphase )
THEN
13411 mltmass0inv = 1.0/( 1000.0* xvmx(lr) )
13412 mltmass1inv = 1.0/( 1000.0*(4.0*pi/3.0)*((0.01*0.5*takshedsize1)**3) )
13413 mltmass2inv = 1.0/( 1000.0*(4.0*pi/3.0)*((0.01*0.5*takshedsize2)**3) )
13414 mltmass3inv = 1.0/( 1000.0*(4.0*pi/3.0)*((0.01*0.5*takshedsize3)**3) )
13415 mltmass1cgs = 1.0*(4.0*pi/3.0)*((0.5*takshedsize1)**3)
13416 mltmass2cgs = 1.0*(4.0*pi/3.0)*((0.5*takshedsize2)**3)
13417 mltmass3cgs = 1.0*(4.0*pi/3.0)*((0.5*takshedsize3)**3)
13421 IF ( ibinnum == 1 )
THEN
13423 mltdiam(1) = 4.5e-3
13424 ELSEIF ( ibinnum == 2 )
THEN
13426 mltdiam(1) = mltdiam1/6.
13427 mltdiam(2) = mltdiam1/2.
13428 ELSEIF ( ibinnum > 2 )
THEN
13429 numdiam = min(ibinnum, ndiam)
13431 mltdiam(k) = (k - 0.5)*mltdiam1/float(numdiam)
13436 mltdiam(1) = 0.5e-3
13437 mltdiam(2) = 1.0e-3
13438 mltdiam(3) = 2.0e-3
13439 mltdiam(4) = 4.0e-3
13440 mltdiam(5) = 6.0e-3
13444 IF ( numshedregimes == 2 )
THEN
13445 mltdiam(ndiam+1) = mltdiam1
13446 mltdiam(ndiam+2) = mltdiam3
13447 mltdiam(ndiam+3) = mltdiam4
13448 ELSEIF ( numshedregimes == 3 )
THEN
13449 mltdiam(ndiam+1) = mltdiam1
13450 mltdiam(ndiam+2) = mltdiam2
13451 mltdiam(ndiam+3) = mltdiam3
13452 mltdiam(ndiam+4) = mltdiam4
13463 mwfac = 6.0**(1./3.)
13464 IF ( ipconc .ge. 2 )
THEN
13469 rwmasn = xvmn(lr)*1000.
13470 rwmasx = xvmx(lr)*1000.
13472 IF ( biggsnowdiam > 0.0 )
THEN
13473 xvbiggsnow = (pi/6.0)*biggsnowdiam**3
13475 xvbiggsnow = xvmn(lh)
13481 cimasn = min(cimas0, cimas1)
13519 IF ( ipconc < 2 )
THEN
13522 t9(ix,jy,kz) = an(ix,jy,kz,lc)
13530 if ( ndebug .gt. 0 )
write(0,*)
'ICEZVD_GS: ENTER GATHER STAGE'
13537 numgs = nxz/ngs + 1
13540 do 1000 inumgs = 1,numgs
13544 do ix = nxmpb,itile
13546 pqs(1) = t00(ix,jy,kz)
13548 theta(1) = an(ix,jy,kz,lt)
13549 temg(1) = t0(ix,jy,kz)
13550 temcg(1) = temg(1) - tfr
13551 tqvcon = temg(1)-cbw
13552 ltemq = (temg(1)-163.15)/fqsat + 1.5
13553 ltemq = min( nqsat, max(1,ltemq) )
13554 qvs(1) = pqs(1)*tabqvs(ltemq)
13555 IF ( iqis0 == 1 .or. temg(1) <= tfr+0.5 )
THEN
13556 qis(1) = pqs(1)*tabqis(ltemq)
13558 ltemq = (tfr - 163.15)/fqsat + 1.5
13559 qis(1) = pqs(1)*tabqis(ltemq)
13564 if ( temg(1) .lt. tfr )
then
13569 IF ( lhl > 1 )
THEN
13570 IF ( an(ix,jy,kz,lhl) .gt. qxmin(lhl) ) ishail = .true.
13575 if ( an(ix,jy,kz,lv) .gt. qss(1) .or. &
13576 & an(ix,jy,kz,lc) .gt. qxmin(lc) .or. &
13577 & an(ix,jy,kz,li) .gt. qxmin(li) .or. &
13578 & an(ix,jy,kz,lr) .gt. qxmin(lr) .or. &
13579 & an(ix,jy,kz,ls) .gt. qxmin(ls) .or. &
13580 & an(ix,jy,kz,lh) .gt. qxmin(lh) .or. ishail )
then
13581 ngscnt = ngscnt + 1
13584 if ( ngscnt .eq. ngs )
goto 1100
13591 if ( ngscnt .eq. 0 )
go to 9998
13593 if ( ndebug .gt. 0 )
write(0,*)
'ICEZVD_GS: dbg = 5, ngscnt = ',ngscnt
13600 vtxbar(:,:,:) = 0.0
13604 IF ( lnhf > 1 .or. lnhlf > 1 ) chxf(:,:) = 0.0
13608 rimdn(mgs,il) = rimedens
13614 if ( ndebug .gt. 0 )
write(0,*)
'ICEZVD_GS: dbg = def temps'
13616 kgsm(mgs) = max(kgs(mgs)-1,1)
13617 kgsp(mgs) = min(kgs(mgs)+1,nz-1)
13618 kgsm2(mgs) = max(kgs(mgs)-2,1)
13619 theta0(mgs) = an(igs(mgs),jy,kgs(mgs),lt)
13620 thetap(mgs) = an(igs(mgs),jy,kgs(mgs),lt) - theta0(mgs)
13621 theta(mgs) = an(igs(mgs),jy,kgs(mgs),lt)
13622 qv0(mgs) = an(igs(mgs),jy,kgs(mgs),lv)
13623 qwvp(mgs) = an(igs(mgs),jy,kgs(mgs),lv) - qv0(mgs)
13625 pres(mgs) = pn(igs(mgs),jy,kgs(mgs)) + pb(kgs(mgs))
13626 pipert(mgs) = p2(igs(mgs),jy,kgs(mgs))
13627 rho0(mgs) = dn(igs(mgs),jy,kgs(mgs))
13628 rhoinv(mgs) = 1.0/rho0(mgs)
13629 rhovt(mgs) = sqrt(rho00/max(0.05,rho0(mgs)))
13630 pi0(mgs) = p2(igs(mgs),jy,kgs(mgs)) + pinit(kgs(mgs))
13631 temg(mgs) = t0(igs(mgs),jy,kgs(mgs))
13632 temgkm1(mgs) = t0(igs(mgs),jy,kgsm(mgs))
13633 temgkm2(mgs) = t0(igs(mgs),jy,kgsm2(mgs))
13634 pk(mgs) = p2(igs(mgs),jy,kgs(mgs)) + pinit(kgs(mgs))
13635 temcg(mgs) = temg(mgs) - tfr
13636 qss0(mgs) = (380.0)/(pres(mgs))
13637 pqs(mgs) = (380.0)/(pres(mgs))
13638 ltemq = (temg(mgs)-163.15)/fqsat+1.5
13639 ltemq = min( nqsat, max(1,ltemq) )
13640 qvs(mgs) = pqs(mgs)*tabqvs(ltemq)
13641 IF ( iqis0 == 1 .or. temg(mgs) <= tfr+0.5 )
THEN
13642 qis(mgs) = pqs(mgs)*tabqis(ltemq)
13644 ltemq = (tfr - 163.15)/fqsat + 1.5
13645 qis(mgs) = pqs(mgs)*tabqis(ltemq)
13647 qss(mgs) = qvs(mgs)
13650 cnostmp(mgs) = cno(ls)
13654 if ( temg(mgs) .lt. tfr )
then
13659 IF ( ipconc < 1 .and. lwsm6 )
THEN
13661 tmp = min( 0.0, temcg(mgs) )
13662 cnostmp(mgs) = min( 2.e8, 2.e6*exp(0.12*tmp) )
13678 qx(mgs,il) = max(an(igs(mgs),jy,kgs(mgs),il), 0.0)
13694 if ( ndebug .gt. 0 .and. my_rank>=0 )
write(0,*)
'ICEZVD_GS: dbg = 5b'
13696 if ( ipconc .ge. 1 )
then
13698 cx(mgs,li) = max(an(igs(mgs),jy,kgs(mgs),lni), 0.0)
13699 IF ( qx(mgs,li) .le. qxmin(li) )
THEN
13703 IF ( lcina .gt. 1 )
THEN
13704 cina(mgs) = an(igs(mgs),jy,kgs(mgs),lcina)
13706 cina(mgs) = cx(mgs,li)
13708 IF ( lcin > 1 )
THEN
13709 ccin(mgs) = an(igs(mgs),jy,kgs(mgs),lcin)
13713 if ( ipconc .ge. 2 )
then
13715 cx(mgs,lc) = max(an(igs(mgs),jy,kgs(mgs),lnc), 0.0)
13717 IF ( qx(mgs,lc) .le. qxmin(lc) )
THEN
13720 IF ( lss > 1 )
THEN
13721 ssmax(mgs) = an(igs(mgs),jy,kgs(mgs),lss)
13723 IF ( lccn .gt. 1 )
THEN
13724 ccnc(mgs) = an(igs(mgs),jy,kgs(mgs),lccn)
13728 IF ( lccna .gt. 1 )
THEN
13729 ccna(mgs) = an(igs(mgs),jy,kgs(mgs),lccna)
13731 ccna(mgs) = cx(mgs,lc)
13737 if ( ipconc .ge. 3 )
then
13739 cx(mgs,lr) = max(an(igs(mgs),jy,kgs(mgs),lnr), 0.0)
13740 IF ( qx(mgs,lr) .le. qxmin(lr) )
THEN
13742 ELSEIF ( cx(mgs,lr) .eq. 0.0 .and. qx(mgs,lr) .lt. 3.0*qxmin(lr) )
THEN
13743 qx(mgs,lv) = qx(mgs,lv) + qx(mgs,lr)
13746 cx(mgs,lr) = max( 1.e-9, cx(mgs,lr) )
13750 if ( ipconc .ge. 4 )
then
13752 cx(mgs,ls) = max(an(igs(mgs),jy,kgs(mgs),lns), 0.0)
13753 IF ( qx(mgs,ls) .le. qxmin(ls) )
THEN
13755 ELSEIF ( cx(mgs,ls) .eq. 0.0 .and. qx(mgs,ls) .lt. 3.0*qxmin(ls) )
THEN
13756 qx(mgs,lv) = qx(mgs,lv) + qx(mgs,ls)
13759 cx(mgs,ls) = max( 1.e-9, cx(mgs,ls) )
13761 IF ( ilimit .ge. ipc(ls) )
THEN
13762 tmp = (xdn0(ls)*cx(mgs,ls))/(rho0(mgs)*qx(mgs,ls))
13763 tmp2 = (tmp*(3.14159))**(1./3.)
13764 cnox = cx(mgs,ls)*(tmp2)
13765 IF ( cnox .gt. 3.0*cno(ls) )
THEN
13766 cx(mgs,ls) = 3.0*cno(ls)/tmp2
13772 if ( ipconc .ge. 5 )
then
13775 cx(mgs,lh) = max(an(igs(mgs),jy,kgs(mgs),lnh), 0.0)
13776 IF ( qx(mgs,lh) .le. qxmin(lh) )
THEN
13778 ELSEIF ( cx(mgs,lh) .eq. 0.0 .and. qx(mgs,lh) .lt. 3.0*qxmin(lh) )
THEN
13779 qx(mgs,lv) = qx(mgs,lv) + qx(mgs,lh)
13782 cx(mgs,lh) = max( 1.e-9, cx(mgs,lh) )
13783 IF ( ilimit .ge. ipc(lh) )
THEN
13784 tmp = (xdn0(lh)*cx(mgs,lh))/(rho0(mgs)*qx(mgs,lh))
13785 tmp2 = (tmp*(3.14159))**(1./3.)
13786 cnox = cx(mgs,lh)*(tmp2)
13787 IF ( cnox .gt. 3.0*cno(lh) )
THEN
13788 cx(mgs,lh) = 3.0*cno(lh)/tmp2
13799 if ( lhl .gt. 1 .and. ipconc .ge. 5 )
then
13802 cx(mgs,lhl) = max(an(igs(mgs),jy,kgs(mgs),lnhl), 0.0)
13803 IF ( qx(mgs,lhl) .le. qxmin(lhl) )
THEN
13805 ELSEIF ( cx(mgs,lhl) .eq. 0.0 .and. qx(mgs,lhl) .lt. 3.0*qxmin(lhl) )
THEN
13806 qx(mgs,lv) = qx(mgs,lv) + qx(mgs,lhl)
13809 cx(mgs,lhl) = max( 1.e-9, cx(mgs,lhl) )
13810 IF ( ilimit .ge. ipc(lhl) )
THEN
13811 tmp = (xdn0(lhl)*cx(mgs,lhl))/(rho0(mgs)*qx(mgs,lhl))
13812 tmp2 = (tmp*(3.14159))**(1./3.)
13813 cnox = cx(mgs,lhl)*(tmp2)
13814 IF ( cnox .gt. 3.0*cno(lhl) )
THEN
13815 cx(mgs,lhl) = 3.0*cno(lhl)/tmp2
13833 IF ( lvol(il) .ge. 1 )
THEN
13836 vx(mgs,il) = max(an(igs(mgs),jy,kgs(mgs),lvol(il)), 0.0)
13859 IF ( ipconc .ge. 6 )
THEN
13862 IF ( lz(il) .gt. 1 )
THEN
13864 zx(mgs,il) = max( an(igs(mgs),jy,kgs(mgs),lz(il)), 0.0 )
13871 IF ( ipconc .ge. 6 )
THEN
13873 IF ( lz(lr) .lt. 1 )
THEN
13874 g1x(:,lr) = (6.0 + alphar)*(5.0 + alphar)*(4.0 + alphar)/ &
13875 & ((3.0 + alphar)*(2.0 + alphar)*(1.0 + alphar))
13879 IF ( cx(mgs,lr) .gt. 0.0 .and. qx(mgs,lr) .gt. qxmin(lr) )
THEN
13881 vr = rho0(mgs)*qx(mgs,lr)/(1000.*cx(mgs,lr))
13882 IF ( lzr < 1 )
THEN
13883 IF ( imurain == 3 )
THEN
13884 zx(mgs,lr) = 3.6476*(rnu+2.0)*cx(mgs,lr)*vr**2/(rnu+1.0)
13886 zx(mgs,lr) = 3.6476*g1x(mgs,lr)*cx(mgs,lr)*vr**2
13901 if ( ndebug .gt. 0 .and. my_rank>=0 )
write(0,*) my_rank,
'ICEZVD_GS: dbg = set alpha'
13902 IF ( imurain == 1 )
THEN
13903 alpha(:,lr) = alphar
13904 ELSEIF ( imurain == 3 )
THEN
13905 alpha(:,lr) = xnu(lr)
13908 alpha(:,li) = xnu(li)
13909 alpha(:,lc) = xnu(lc)
13911 IF ( imusnow == 1 )
THEN
13912 alpha(:,ls) = alphas
13913 ELSEIF ( imusnow == 3 )
THEN
13914 alpha(:,ls) = xnu(ls)
13917 if ( ndebug .gt. 0 .and. my_rank>=0 )
write(0,*) my_rank,
'ICEZVD_GS: dbg = set dab'
13921 IF ( il .ge. lg ) alpha(mgs,il) = dnu(il)
13925 dab0lh(mgs,il,ic) = dab0(il,ic)
13926 dab1lh(mgs,il,ic) = dab1(il,ic)
13934 da0lx(:,il) = da0(il)
13942 if ( ndebug .gt. 0 .and. my_rank>=0 )
write(0,*) my_rank,
'ICEZVD_GS: dbg = set rz'
13944 IF ( lzh < 1 .or. lzhl < 1 )
THEN
13945 rzxhlh(:) = rzhl/rz
13946 ELSEIF ( lzh > 1 .and. lzhl > 1 )
THEN
13949 IF ( lzr > 1 )
THEN
13957 IF ( imurain == 1 .and. imusnow == 3 .and. lzr < 1 )
THEN
13959 ELSEIF ( imurain == imusnow .or. lzr > 1 )
THEN
13964 IF ( lhl .gt. 1 )
THEN
13966 da0lhl(mgs) = da0(lhl)
13971 ventrxn(:) = ventrn
13972 gf1palp(:) =
gamma_sp(1.0 + alphar)
13979 ssi(mgs) = qx(mgs,lv)/qis(mgs)
13980 ssw(mgs) = qx(mgs,lv)/qvs(mgs)
13982 tsqr(mgs) = temg(mgs)**2
13984 temgx(mgs) = min(temg(mgs),313.15)
13985 temgx(mgs) = max(temgx(mgs),233.15)
13986 felv(mgs) = 2500837.367 * (273.15/temgx(mgs))**((0.167)+(3.67e-4)*temgx(mgs))
13988 temcgx(mgs) = min(temg(mgs),273.15)
13989 temcgx(mgs) = max(temcgx(mgs),223.15)
13990 temcgx(mgs) = temcgx(mgs)-273.15
13993 felf(mgs) = 333690.6098 + (2030.61425)*temcgx(mgs) - (10.46708312)*temcgx(mgs)**2
13995 fels(mgs) = felv(mgs) + felf(mgs)
13997 felvs(mgs) = felv(mgs)*felv(mgs)
13998 felss(mgs) = fels(mgs)*fels(mgs)
14000 IF ( eqtset <= 1 )
THEN
14001 felvcp(mgs) = felv(mgs)*cpi
14002 felscp(mgs) = fels(mgs)*cpi
14003 felfcp(mgs) = felf(mgs)*cpi
14009 tmp = qx(mgs,li)+qx(mgs,ls)+qx(mgs,lh)
14010 IF ( lhl > 1 ) tmp = tmp + qx(mgs,lhl)
14011 IF ( lf > 1 ) tmp = tmp + qx(mgs,lf)
14012 cvm = cv+cvv*qx(mgs,lv)+cpl*(qx(mgs,lc)+qx(mgs,lr)) &
14015 IF ( eqtset == 2 )
THEN
14016 felvcp(mgs) = (felv(mgs)-rw*temg(mgs))/cvm
14017 felscp(mgs) = (fels(mgs)-rw*temg(mgs))/cvm
14018 felfcp(mgs) = felf(mgs)/cvm
14023 cpm = cp+cpv*qx(mgs,lv)+cpl*(qx(mgs,lc)+qx(mgs,lr)) &
14025 rmm=rd+rw*qx(mgs,lv)
14027 felvcp(mgs) = (felv(mgs)*cv/(cp) - rw*temg(mgs)*(1.0-rovcp*cpm/rmm))/cvm
14028 felscp(mgs) = (fels(mgs)*cv/(cp) - rw*temg(mgs)*(1.0-rovcp*cpm/rmm))/cvm
14029 felfcp(mgs) = felf(mgs)*cv/(cp*cvm)
14031 felvpi(mgs) = pi0(mgs)*rovcp*(felv(mgs)/(temg(mgs)) - rw*cpm/rmm)/cvm
14032 felspi(mgs) = pi0(mgs)*rovcp*(fels(mgs)/(temg(mgs)) - rw*cpm/rmm)/cvm
14033 felfpi(mgs) = pi0(mgs)*rovcp*(felf(mgs)/(cvm*temg(mgs)))
14039 fgamw(mgs) = felvcp(mgs)/pi0(mgs)
14040 fgams(mgs) = felscp(mgs)/pi0(mgs)
14042 fcqv1(mgs) = 4098.0258*pi0(mgs)*fgamw(mgs)
14043 fcqv2(mgs) = 5807.6953*pi0(mgs)*fgams(mgs)
14044 fcc3(mgs) = felfcp(mgs)/pi0(mgs)
14047 fwvdf(mgs) = (2.11e-05)*((temg(mgs)/tfr)**1.94)*(101325.0/(pres(mgs)))
14051 fadvisc(mgs) = advisc0*(416.16/(temg(mgs)+120.0))*(temg(mgs)/296.0)**(1.5)
14053 fakvisc(mgs) = fadvisc(mgs)*rhoinv(mgs)
14055 temcgx(mgs) = min(temg(mgs),273.15)
14056 temcgx(mgs) = max(temcgx(mgs),233.15)
14057 temcgx(mgs) = temcgx(mgs)-273.15
14058 fci(mgs) = (2.118636 + 0.007371*(temcgx(mgs)))*(1.0e+03)
14060 if ( temg(mgs) .lt. 273.15 )
then
14061 temcgx(mgs) = min(temg(mgs),273.15)
14062 temcgx(mgs) = max(temcgx(mgs),233.15)
14063 temcgx(mgs) = temcgx(mgs)-273.15
14064 fcw(mgs) = 4203.1548 + (1.30572e-2)*((temcgx(mgs)-35.)**2) &
14065 & + (1.60056e-5)*((temcgx(mgs)-35.)**4)
14067 if ( temg(mgs) .ge. 273.15 )
then
14068 temcgx(mgs) = min(temg(mgs),308.15)
14069 temcgx(mgs) = max(temcgx(mgs),273.15)
14070 temcgx(mgs) = temcgx(mgs)-273.15
14071 fcw(mgs) = 4243.1688 + (3.47104e-1)*(temcgx(mgs)**2)
14074 ftka(mgs) = tka0*fadvisc(mgs)/advisc1
14075 fthdf(mgs) = ftka(mgs)*cpi*rhoinv(mgs)
14077 fschm(mgs) = (fakvisc(mgs)/fwvdf(mgs))
14078 fpndl(mgs) = (fakvisc(mgs)/fthdf(mgs))
14080 fai(mgs) = (fels(mgs)**2)/(ftka(mgs)*rw*temg(mgs)**2)
14081 fbi(mgs) = (1.0/(rho0(mgs)*fwvdf(mgs)*qis(mgs)))
14082 fav(mgs) = (felv(mgs)**2)/(ftka(mgs)*rw*temg(mgs)**2)
14083 fbv(mgs) = (1.0/(rho0(mgs)*fwvdf(mgs)*qvs(mgs)))
14085 kp1 = min(nz, kgs(mgs)+1 )
14086 wvel(mgs) = (0.5)*(w(igs(mgs),jgs,kp1) &
14087 & +w(igs(mgs),jgs,kgs(mgs)))
14099 if (ndebug .gt. 0 )
write(0,*)
'ICEZVD_GS: Set density'
14103 xdn(mgs,li) = xdn0(li)
14104 xdn(mgs,lc) = xdn0(lc)
14105 xdn(mgs,lr) = xdn0(lr)
14106 xdn(mgs,ls) = xdn0(ls)
14107 xdn(mgs,lh) = xdn0(lh)
14108 IF ( lvol(ls) .gt. 1 )
THEN
14109 IF ( vx(mgs,ls) .gt. 0.0 .and. qx(mgs,ls) .gt. qxmin(ls) )
THEN
14110 xdn(mgs,ls) = min( xdnmx(ls), max( xdnmn(ls), rho0(mgs)*qx(mgs,ls)/vx(mgs,ls) ) )
14114 IF ( lvol(lh) .gt. 1 )
THEN
14115 IF ( vx(mgs,lh) .gt. 0.0 .and. qx(mgs,lh) .gt. qxmin(lh) )
THEN
14116 IF ( mixedphase )
THEN
14120 xdn(mgs,lh) = min( dnmx, max( xdnmn(lh), rho0(mgs)*qx(mgs,lh)/vx(mgs,lh) ) )
14121 vx(mgs,lh) = rho0(mgs)*qx(mgs,lh)/xdn(mgs,lh)
14123 ELSEIF ( vx(mgs,lh) == 0.0 .and. qx(mgs,lh) .gt. qxmin(lh) )
THEN
14125 vx(mgs,lh) = rho0(mgs)*qx(mgs,lh)/xdn(mgs,lh)
14131 IF ( lhl .gt. 1 )
THEN
14133 xdn(mgs,lhl) = xdn0(lhl)
14134 xdntmp(mgs,lhl) = xdn0(lhl)
14136 IF ( lvol(lhl) .gt. 1 )
THEN
14137 IF ( vx(mgs,lhl) .gt. 0.0 .and. qx(mgs,lhl) .gt. qxmin(lhl) )
THEN
14139 IF ( mixedphase .and. lhlw > 1 )
THEN
14144 xdn(mgs,lhl) = min( dnmx, max( xdnmn(lhl), rho0(mgs)*qx(mgs,lhl)/vx(mgs,lhl) ) )
14145 vx(mgs,lhl) = rho0(mgs)*qx(mgs,lhl)/xdn(mgs,lhl)
14146 xdntmp(mgs,lhl) = xdn(mgs,lhl)
14148 ELSEIF ( vx(mgs,lhl) == 0.0 .and. qx(mgs,lhl) .gt. qxmin(lhl) )
THEN
14150 vx(mgs,lhl) = rho0(mgs)*qx(mgs,lhl)/xdn(mgs,lhl)
14160 IF ( ipconc == 5 .and. imydiagalpha == 2 )
THEN
14162 cwchtmp = ((3. + dnu(lh))*(2. + dnu(lh))*(1.0 + dnu(lh)))**(-1./3.)
14166 IF ( qx(mgs,lr) .gt. qxmin(lr) .and. cx(mgs,lr) > cxmin )
THEN
14167 xv(mgs,lr) = rho0(mgs)*qx(mgs,lr)/(xdn(mgs,lr)*cx(mgs,lr))
14168 xdia(mgs,lr,3) = (xv(mgs,lr)*6.0*cwc1)**(1./3.)
14174 i = int(dgami*(tmp))
14176 x = gmoi(i) + (gmoi(i+1) - gmoi(i))*del*dgami
14179 i = int(dgami*(tmp))
14181 y = gmoi(i) + (gmoi(i+1) - gmoi(i))*del*dgami
14183 tmp = (x/y)**(1./3.)*xdia(mgs,lr,3)*cwchtmp
14185 alpha(mgs,lr) = min(15., 11.8*(1000.*tmp - 0.7)**2 + 2.)
14187 IF ( qx(mgs,lh) .gt. qxmin(lh) .and. cx(mgs,lh) > cxmin )
THEN
14189 xv(mgs,lh) = rho0(mgs)*qx(mgs,lh)/(xdn(mgs,lh)*cx(mgs,lh))
14190 xdia(mgs,lh,3) = (xv(mgs,lh)*6.*piinv)**(1./3.)
14195 i = int(dgami*(tmp))
14197 x = gmoi(i) + (gmoi(i+1) - gmoi(i))*del*dgami
14200 i = int(dgami*(tmp))
14202 y = gmoi(i) + (gmoi(i+1) - gmoi(i))*del*dgami
14204 tmp = (x/y)**(1./3.)*xdia(mgs,lh,3)*cwchtmp
14206 alpha(mgs,lh) = min(15., 11.8*(1000.*tmp - 0.7)**2 + 2.)
14212 i = nint( alpha(mgs,il)*dqiacralphainv )
14213 IF ( ic == lc .or. ic == li .or. ic == ls .or. (ic == lr .and. imurain == 3) )
THEN
14214 alp = (3.*alpha(mgs,ic) + 2.)
14215 j = nint( (3.*alpha(mgs,ic) + 2.)*dqiacralphainv )
14217 alp = alpha(mgs,ic)
14218 j = nint( alpha(mgs,ic)*dqiacralphainv )
14221 dab0lh(mgs,ic,il) = dab0lu(j,i,ic,il)
14222 dab1lh(mgs,ic,il) = dab1lu(j,i,ic,il)
14223 dab0lh(mgs,il,ic) = dab0lu(i,j,il,ic)
14224 dab1lh(mgs,il,ic) = dab1lu(i,j,il,ic)
14229 IF ( lhl > 0 )
THEN
14230 IF ( qx(mgs,lhl) .gt. qxmin(lhl) .and. cx(mgs,lhl) > cxmin )
THEN
14231 xv(mgs,lhl) = rho0(mgs)*qx(mgs,lhl)/(xdn(mgs,lhl)*cx(mgs,lhl))
14232 xdia(mgs,lhl,3) = (xv(mgs,lhl)*6.*piinv)**(1./3.)
14233 IF ( xdia(mgs,lhl,3) < 0.008 )
THEN
14234 alpha(mgs,lhl) = min(alphamax, c1hl*tanh(c2hl*(xdia(mgs,lhl,3)*1000. - c3hl)) + c4hl)
14236 alpha(mgs,lhl) = min(alphamax, c5hl*xdia(mgs,lhl,3)*1000. + c6hl)
14241 i = nint( alpha(mgs,il)*dqiacralphainv )
14242 IF ( ic == lc .or. ic == li .or. ic == ls .or. (ic == lr .and. imurain == 3) )
THEN
14243 alp = (3.*alpha(mgs,ic) + 2.)
14244 j = nint( (3.*alpha(mgs,ic) + 2.)*dqiacralphainv )
14246 alp = alpha(mgs,ic)
14247 j = nint( alpha(mgs,ic)*dqiacralphainv )
14250 dab0lh(mgs,ic,il) = dab0lu(j,i,ic,il)
14251 dab1lh(mgs,ic,il) = dab1lu(j,i,ic,il)
14252 dab0lh(mgs,il,ic) = dab0lu(i,j,il,ic)
14253 dab1lh(mgs,il,ic) = dab1lu(i,j,il,ic)
14265 IF ( imurain == 3 )
THEN
14266 IF ( lzr > 1 )
THEN
14268 alphamlr = -2.0/3.0
14269 alphasmlr = -2.0/3.0
14273 alphasmlr = xnu(lr)
14277 massfacshr = ( (2. + 3.*(1. +alphashr) )**3/( 3.*(1. + alphashr) ) )
14278 massfacmlr = ( (2. + 3.*(1. +alphamlr) )**3/( 3.*(1. + alphamlr) ) )
14279 ELSEIF ( imurain == 1 )
THEN
14280 IF ( lzr > 1 )
THEN
14283 alphasmlr = alphasmlr0
14291 massfacshr = (3.0 + alphashr)**3/((3.+alphashr)*(2.+alphashr)*(1. + alphashr) )
14292 massfacmlr = (3.0 + alphamlr)**3/((3.+alphamlr)*(2.+alphamlr)*(1. + alphamlr) )
14303 IF ( ipconc >= 6 )
THEN
14306 IF ( ipconc >= 6 .and. imurain == 3 )
THEN
14310 g1x(mgs,il) = (alpha(mgs,lr)+2.0)/((alpha(mgs,lr)+1.0))
14315 IF ( imurain == 3 )
THEN
14316 g1shr = (alphashr+2.0)/((alphashr+1.0))
14317 g1mlr = (alphamlr+2.0)/((alphamlr+1.0))
14318 g1smlr = (alphasmlr+2.0)/((alphasmlr+1.0))
14319 ELSEIF ( imurain == 1 )
THEN
14322 g1shr = (6.0 + alphashr)*(5.0 + alphashr)*(4.0 + alphashr)/ &
14323 & ((3.0 + alphashr)*(2.0 + alphashr)*(1.0 + alphashr))
14326 g1mlr = (6.0 + alphamlr)*(5.0 + alphamlr)*(4.0 + alphamlr)/ &
14327 & ((3.0 + alphamlr)*(2.0 + alphamlr)*(1.0 + alphamlr))
14328 g1smlr = (6.0 + alphasmlr)*(5.0 + alphasmlr)*(4.0 + alphasmlr)/ &
14329 & ((3.0 + alphasmlr)*(2.0 + alphasmlr)*(1.0 + alphasmlr))
14333 IF ( lzr > 1 .and. imurain == 3 )
THEN
14341 IF ( iresetmoments == 1 .or. iresetmoments == il .or. iresetmoments == -1 )
THEN
14342 IF ( zx(mgs,il) <= zxmin )
THEN
14346 an(igs(mgs),jgs,kgs(mgs),lv) = an(igs(mgs),jgs,kgs(mgs),lv) + an(igs(mgs),jgs,kgs(mgs),il)
14347 an(igs(mgs),jgs,kgs(mgs),il) = qx(mgs,il)
14348 an(igs(mgs),jgs,kgs(mgs),ln(il)) = cx(mgs,il)
14349 ELSEIF ( iresetmoments == -1 .and. qx(mgs,il) < qxmin(il) )
THEN
14352 an(igs(mgs),jgs,kgs(mgs),lv) = an(igs(mgs),jgs,kgs(mgs),lv) + an(igs(mgs),jgs,kgs(mgs),il)
14355 an(igs(mgs),jgs,kgs(mgs),il) = qx(mgs,il)
14356 an(igs(mgs),jgs,kgs(mgs),ln(il)) = cx(mgs,il)
14357 an(igs(mgs),jgs,kgs(mgs),lz(il)) = zx(mgs,il)
14359 ELSEIF ( cx(mgs,il) <= cxmin .and. iresetmoments /= -1 )
THEN
14361 qx(mgs,lv) = qx(mgs,lv) + qx(mgs,il)
14364 an(igs(mgs),jgs,kgs(mgs),lv) = an(igs(mgs),jgs,kgs(mgs),lv) + an(igs(mgs),jgs,kgs(mgs),lr)
14365 an(igs(mgs),jgs,kgs(mgs),lr) = qx(mgs,lr)
14366 an(igs(mgs),jgs,kgs(mgs),lz(lr)) = zx(mgs,lr)
14370 IF ( .false. .and. zx(mgs,il) <= zxmin .and. cx(mgs,il) <= cxmin )
THEN
14373 an(igs(mgs),jgs,kgs(mgs),lv) = an(igs(mgs),jgs,kgs(mgs),lv) + an(igs(mgs),jgs,kgs(mgs),il)
14376 an(igs(mgs),jgs,kgs(mgs),il) = qx(mgs,il)
14377 an(igs(mgs),jgs,kgs(mgs),ln(il)) = cx(mgs,il)
14378 an(igs(mgs),jgs,kgs(mgs),lz(il)) = zx(mgs,il)
14381 IF ( qx(mgs,lr) .gt. qxmin(lr) )
THEN
14383 xv(mgs,lr) = rho0(mgs)*qx(mgs,lr)/(xdn(mgs,lr)*max(1.0e-11,cx(mgs,lr)))
14384 IF ( xv(mgs,lr) .gt. xvmx(lr) )
THEN
14387 ELSEIF ( xv(mgs,lr) .lt. xvmn(lr) )
THEN
14388 xv(mgs,lr) = xvmn(lr)
14389 cx(mgs,lr) = rho0(mgs)*qx(mgs,lr)/(xvmn(lr)*xdn(mgs,lr))
14392 IF ( zx(mgs,il) > 0.0 .and. cx(mgs,il) <= 0.0 )
THEN
14394 g1 = 36.*(alpha(mgs,lr)+2.0)/((alpha(mgs,lr)+1.0)*pi**2)
14397 cx(mgs,il) = g1*dn(igs(mgs),jy,kgs(mgs))**2*(qr)*qr/(z*xdn(mgs,lr)**2)
14399 ELSEIF ( zx(mgs,il) <= zxmin .and. cx(mgs,il) > 0.0 )
THEN
14401 g1 = 36.*(alpha(mgs,lr)+2.0)/((alpha(mgs,lr)+1.0)*pi**2)
14404 zx(mgs,il) = g1*dn(igs(mgs),jy,kgs(mgs))**2*(qr)*qr/(xdn(mgs,lr)**2*chw)
14405 an(igs(mgs),jgs,kgs(mgs),lz(lr)) = zx(mgs,lr)
14407 ELSEIF ( zx(mgs,il) <= zxmin .and. cx(mgs,il) <= 0.0 )
THEN
14411 zx(mgs,il) = 1.e-19/0.224*(xdn0(lr)/xdn0(il))**2
14412 an(igs(mgs),jgs,kgs(mgs),lz(il)) = zx(mgs,il)
14414 g1 = 36.*(alpha(mgs,lr)+2.0)/((alpha(mgs,lr)+1.0)*pi**2)
14417 cx(mgs,il) = g1*dn(igs(mgs),jy,kgs(mgs))**2*(qr)*qr/(z*1000.*1000)
14418 an(igs(mgs),jgs,kgs(mgs),ln(il)) = cx(mgs,il)
14421 IF ( zx(mgs,lr) > 0.0 )
THEN
14422 xv(mgs,lr) = rho0(mgs)*qx(mgs,lr)/(1000.*cx(mgs,lr))
14432 IF ( z .gt. 0.0 )
THEN
14434 alp = 36.*(alpha(mgs,lr)+2.0)*nrx*vr**2/(z*pi**2) - 1.
14436 IF ( abs(alp - alpha(mgs,lr)) .lt. 0.01 )
EXIT
14437 alpha(mgs,lr) = max( rnumin, min( rnumax, alp ) )
14438 alp = 36.*(alpha(mgs,lr)+2.0)*nrx*vr**2/(z*pi**2) - 1.
14439 alp = max( rnumin, min( rnumax, alp ) )
14443 IF ( (xv(mgs,il) .gt. xvmx(il) .or. (ioldlimiter >= 2 .and. xv(mgs,il) .gt. xvmx(il)/8.) ))
THEN
14445 IF ( ioldlimiter >= 2 )
THEN
14446 x = (6.*rho0(mgs)*qx(mgs,il)/(pi*xdn(mgs,il)*cx(mgs,il)))**(1./3.)
14447 x1 = max(0.0e-3, x - 3.0e-3)
14448 x2 = max(0.5, x/6.0e-3)
14450 cx(mgs,il) = cx(mgs,il)*max((1.+2.222e3*x1**2), x3)
14451 xv(mgs,il) = xv(mgs,il)/max((1.+2.222e3*x1**2), x3)
14453 xv(mgs,il) = min( xvmx(il), max( xvmn(il),xv(mgs,il) ) )
14454 xmas(mgs,il) = xv(mgs,il)*xdn(mgs,il)
14455 cx(mgs,il) = rho0(mgs)*qx(mgs,il)/(xmas(mgs,il))
14460 IF ( tmp < cx(mgs,il) )
THEN
14462 g1 = 36.*(alpha(mgs,lr)+2.0)/((alpha(mgs,lr)+1.0)*pi**2)
14463 zx(mgs,il) = zx(mgs,il) + g1*(rho0(mgs)/xdn(mgs,il))**2*( (qx(mgs,il)/tmp)**2 * (tmp-cx(mgs,il)) )
14464 an(igs(mgs),jgs,kgs(mgs),lz(il)) = zx(mgs,il)
14473 alp = 36.*(alpha(mgs,lr)+2.0)*nrx*vr**2/(z*pi**2) - 1.
14475 IF ( abs(alp - alpha(mgs,lr)) .lt. 0.01 )
EXIT
14476 alpha(mgs,lr) = max( rnumin, min( rnumax, alp ) )
14477 alp = 36.*(alpha(mgs,lr)+2.0)*nrx*vr**2/(z*pi**2) - 1.
14478 alp = max( rnumin, min( rnumax, alp ) )
14489 g1 = 36.*(alpha(mgs,lr)+2.0)/((alpha(mgs,lr)+1.0)*pi**2)
14490 IF ( .true. .and. (alpha(mgs,il) <= rnumin .or. alp == rnumin .or. alp == rnumax) )
THEN
14492 IF ( rescale_high_alpha .and. alp >= rnumax - 0.01 )
THEN
14493 cx(mgs,il) = g1*dn(igs(mgs),jy,kgs(mgs))**2*(qr)*qr/z*(1./(xdn(mgs,il)))**2
14494 an(igs(mgs),jy,kgs(mgs),ln(il)) = cx(mgs,il)
14496 ELSEIF ( rescale_low_alphar .and. alp <= rnumin )
THEN
14497 z = 36.*(alpha(mgs,lr)+2.0)*nrx*vr**2/((alpha(mgs,lr)+1.0)*pi**2)
14499 an(igs(mgs),jy,kgs(mgs),lz(il)) = zx(mgs,il)
14507 IF ( alp >= rnumax - 0.01 )
THEN
14510 g1x(mgs,il) = (pi*xdn(mgs,il))**2*zx(mgs,il)*cx(mgs,il)/((6.*rho0(mgs)*qx(mgs,il))**2)
14515 tmp = alpha(mgs,lr) + 4./3.
14516 i = int(dgami*(tmp))
14518 x = gmoi(i) + (gmoi(i+1) - gmoi(i))*del*dgami
14520 tmp = alpha(mgs,lr) + 1.
14521 i = int(dgami*(tmp))
14523 y = gmoi(i) + (gmoi(i+1) - gmoi(i))*del*dgami
14528 ventrx(mgs) = x/(y*(alpha(mgs,lr) + 1.)**(1./3.))
14530 IF ( imurain == 3 .and. izwisventr == 2 )
THEN
14532 tmp = alpha(mgs,lr) + 1.5 + br/6.
14533 i = int(dgami*(tmp))
14535 x = gmoi(i) + (gmoi(i+1) - gmoi(i))*del*dgami
14538 ventrxn(mgs) = x/(y*(alpha(mgs,lr) + 1.)**((1.+br)/6. + 1./3.))
14566 IF ( ipconc .ge. 6 )
THEN
14571 IF ( (.not. ( il == lr .and. imurain == 3 )) .and. ( il == lr .or. il == lh .or. il == lhl .or. il == lf ) )
THEN
14573 g1x(mgs,il) = (6.0 + alpha(mgs,il))*(5.0 + alpha(mgs,il))*(4.0 + alpha(mgs,il))/ &
14574 & ((3.0 + alpha(mgs,il))*(2.0 + alpha(mgs,il))*(1.0 + alpha(mgs,il)))
14578 IF ( lz(il) .gt. 1 .and. ( .not. ( il == lr .and. imurain == 3 )) )
THEN
14583 IF ( iresetmoments == 1 .or. iresetmoments == il .or. iresetmoments == -1 )
THEN
14584 IF ( zx(mgs,il) <= zxmin )
THEN
14589 an(igs(mgs),jgs,kgs(mgs),lv) = an(igs(mgs),jgs,kgs(mgs),lv) + an(igs(mgs),jgs,kgs(mgs),il)
14590 an(igs(mgs),jgs,kgs(mgs),il) = qx(mgs,il)
14591 an(igs(mgs),jgs,kgs(mgs),ln(il)) = cx(mgs,il)
14592 an(igs(mgs),jgs,kgs(mgs),lz(il)) = zx(mgs,il)
14593 ELSEIF ( iresetmoments == -1 .and. qx(mgs,il) < qxmin(il) )
THEN
14596 an(igs(mgs),jgs,kgs(mgs),lv) = an(igs(mgs),jgs,kgs(mgs),lv) + an(igs(mgs),jgs,kgs(mgs),il)
14599 an(igs(mgs),jgs,kgs(mgs),il) = qx(mgs,il)
14600 an(igs(mgs),jgs,kgs(mgs),ln(il)) = cx(mgs,il)
14601 an(igs(mgs),jgs,kgs(mgs),lz(il)) = zx(mgs,il)
14603 ELSEIF ( cx(mgs,il) <= cxmin .and. iresetmoments /= -1 )
THEN
14604 qx(mgs,lv) = qx(mgs,lv) + qx(mgs,il)
14608 an(igs(mgs),jgs,kgs(mgs),lv) = an(igs(mgs),jgs,kgs(mgs),lv) + an(igs(mgs),jgs,kgs(mgs),il)
14609 an(igs(mgs),jgs,kgs(mgs),il) = qx(mgs,il)
14610 an(igs(mgs),jgs,kgs(mgs),lz(il)) = zx(mgs,il)
14611 an(igs(mgs),jgs,kgs(mgs),ln(il)) = cx(mgs,il)
14615 IF ( zx(mgs,il) <= zxmin .and. cx(mgs,il) <= cxmin )
THEN
14618 an(igs(mgs),jgs,kgs(mgs),lv) = an(igs(mgs),jgs,kgs(mgs),lv) + an(igs(mgs),jgs,kgs(mgs),il)
14621 an(igs(mgs),jgs,kgs(mgs),il) = qx(mgs,il)
14622 an(igs(mgs),jgs,kgs(mgs),ln(il)) = cx(mgs,il)
14623 an(igs(mgs),jgs,kgs(mgs),lz(il)) = zx(mgs,il)
14626 IF ( qx(mgs,il) .gt. qxmin(il) )
THEN
14628 xv(mgs,il) = rho0(mgs)*qx(mgs,il)/(xdn(mgs,il)*max(1.0e-9,cx(mgs,il)))
14629 xmas(mgs,il) = xv(mgs,il)*xdn(mgs,il)
14631 IF ( xv(mgs,il) .lt. xvmn(il) )
THEN
14632 xv(mgs,il) = min( xvmx(il), max( xvmn(il),xv(mgs,il) ) )
14633 xmas(mgs,il) = xv(mgs,il)*xdn(mgs,il)
14634 cx(mgs,il) = rho0(mgs)*qx(mgs,il)/(xmas(mgs,il))
14637 IF ( zx(mgs,il) > 0.0 .and. cx(mgs,il) <= 0.0 )
THEN
14639 g1 = (6.0 + alpha(mgs,il))*(5.0 + alpha(mgs,il))*(4.0 + alpha(mgs,il))/ &
14640 & ((3.0 + alpha(mgs,il))*(2.0 + alpha(mgs,il))*(1.0 + alpha(mgs,il)))
14644 cx(mgs,il) = g1*dn(igs(mgs),jy,kgs(mgs))**2*(6.*qr)**2/(z*(pi*xdn(mgs,il))**2)
14646 ELSEIF ( zx(mgs,il) <= zxmin .and. cx(mgs,il) > cxmin )
THEN
14654 g1 = (6.0 + alphamax)*(5.0 + alphamax)*(4.0 + alphamax)/ &
14655 & ((3.0 + alphamax)*(2.0 + alphamax)*(1.0 + alphamax))
14656 zx(mgs,il) = max(zxmin*1.1, g1*dn(igs(mgs),jy,kgs(mgs))**2*(6*qr)**2/(chw*(pi*xdn(mgs,il))**2) )
14657 an(igs(mgs),jgs,kgs(mgs),lz(il)) = zx(mgs,il)
14659 ELSEIF ( zx(mgs,il) <= zxmin .and. cx(mgs,il) <= 0.0 )
THEN
14663 zx(mgs,il) = 1.e-19/0.224*(xdn0(lr)/xdn0(il))**2
14664 an(igs(mgs),jgs,kgs(mgs),lz(il)) = zx(mgs,il)
14666 g1 = (6.0 + alpha(mgs,il))*(5.0 + alpha(mgs,il))*(4.0 + alpha(mgs,il))/ &
14667 & ((3.0 + alpha(mgs,il))*(2.0 + alpha(mgs,il))*(1.0 + alpha(mgs,il)))
14671 cx(mgs,il) = g1*dn(igs(mgs),jy,kgs(mgs))**2*(6.*qr)**2/(z*(pi*xdn(mgs,il))**2)
14672 an(igs(mgs),jgs,kgs(mgs),ln(il)) = cx(mgs,il)
14679 IF ( zx(mgs,il) .gt. 0. )
THEN
14682 rdi = z*(pi/6.*xdn(mgs,il))**2*chw/((rho0(mgs)*qr)**2)
14686 alp = (6.0+alpha(mgs,il))*(5.0+alpha(mgs,il))*(4.0+alpha(mgs,il))/ &
14687 & ((3.0+alpha(mgs,il))*(2.0+alpha(mgs,il))*rdi) - 1.0
14689 alp = max( alphamin, min( alphamax, alp ) )
14693 IF ( abs(alp - alpha(mgs,il)) .lt. 0.01 )
EXIT
14694 alpha(mgs,il) = max( alphamin, min( alphamax, alp ) )
14695 alp = alp + ( galpha(alp) - rdi )/dgalpha(alp)
14696 alp = max( alphamin, min( alphamax, alp ) )
14702 IF ( abs(alp - alpha(mgs,il)) .lt. 0.01 )
EXIT
14703 alpha(mgs,il) = max( alphamin, min( alphamax, alp ) )
14706 alp = (6.+alpha(mgs,il))*(5.0+alpha(mgs,il))*(4.0+alpha(mgs,il))/ &
14707 & ((3.0+alpha(mgs,il))*(2.0+alpha(mgs,il))*rdi) - 1.0
14709 alp = max( alphamin, min( alphamax, alp ) )
14715 IF ( imaxdiaopt == 1 )
THEN
14716 xvbarmax = xvmx(il)
14717 ELSEIF ( imaxdiaopt == 2 )
THEN
14718 xvbarmax = xvmx(il) /((3. + alpha(mgs,il))**3/((3. + alpha(mgs,il))*(2. + alpha(mgs,il))*(1. + alpha(mgs,il))))
14719 ELSEIF ( imaxdiaopt == 3 )
THEN
14720 xvbarmax = xvmx(il) /((4. + alpha(mgs,il))**3/((3. + alpha(mgs,il))*(2. + alpha(mgs,il))*(1. + alpha(mgs,il))))
14722 xvbarmax = xvmx(il)
14725 IF ( xv(mgs,il) .gt. xvbarmax .or. (il == lr .and. ioldlimiter >= 2 .and. xv(mgs,il) .gt. xvmx(il)/8.))
THEN
14727 IF( ioldlimiter >= 2 .and. il == lr)
THEN
14728 x = (6.*rho0(mgs)*qx(mgs,il)/(pi*xdn(mgs,il)*cx(mgs,il)))**(1./3.)
14729 x1 = max(0.0e-3, x - 3.0e-3)
14730 x2 = max(0.5, x/6.0e-3)
14732 cx(mgs,il) = cx(mgs,il)*max((1.+2.222e3*x1**2), x3)
14733 xv(mgs,il) = xv(mgs,il)/max((1.+2.222e3*x1**2), x3)
14735 xv(mgs,il) = min( xvbarmax, max( xvmn(il),xv(mgs,il) ) )
14736 xmas(mgs,il) = xv(mgs,il)*xdn(mgs,il)
14737 cx(mgs,il) = rho0(mgs)*qx(mgs,il)/(xmas(mgs,il))
14739 IF ( tmp < cx(mgs,il) )
THEN
14740 g1 = 36.*(6.0 + alpha(mgs,il))*(5.0 + alpha(mgs,il))*(4.0 + alpha(mgs,il))/ &
14741 & ((3.0 + alpha(mgs,il))*(2.0 + alpha(mgs,il))*(1.0 + alpha(mgs,il))*pi**2)
14742 zx(mgs,il) = zx(mgs,il) + g1*(rho0(mgs)/xdn(mgs,il))**2*( (qx(mgs,il)/tmp)**2 * (tmp-cx(mgs,il)) )
14743 an(igs(mgs),jgs,kgs(mgs),lz(il)) = zx(mgs,il)
14749 rdi = z*(pi/6.*xdn(mgs,il))**2*chw/((rho0(mgs)*qr)**2)
14750 alp = (6.0+alpha(mgs,il))*(5.0+alpha(mgs,il))*(4.0+alpha(mgs,il))/ &
14751 & ((3.0+alpha(mgs,il))*(2.0+alpha(mgs,il))*rdi) - 1.0
14753 IF ( abs(alp - alpha(mgs,il)) .lt. 0.01 )
EXIT
14754 alpha(mgs,il) = max( alphamin, min( alphamax, alp ) )
14755 alp = (6.+alpha(mgs,il))*(5.0+alpha(mgs,il))*(4.0+alpha(mgs,il))/ &
14756 & ((3.0+alpha(mgs,il))*(2.0+alpha(mgs,il))*rdi) - 1.0
14757 alp = max( alphamin, min( alphamax, alp ) )
14768 g1 = (6.0 + alpha(mgs,il))*(5.0 + alpha(mgs,il))*(4.0 + alpha(mgs,il))/ &
14769 & ((3.0 + alpha(mgs,il))*(2.0 + alpha(mgs,il))*(1.0 + alpha(mgs,il)))
14771 IF ( ( lrescalelow(il) .or. rescale_high_alpha ) .and. &
14772 & ( alpha(mgs,il) <= alphamin .or. alp == alphamin .or. alp == alphamax ) )
THEN
14776 IF ( rescale_high_alpha .and. alp >= alphamax - 0.01 )
THEN
14777 cx(mgs,il) = g1*dn(igs(mgs),jy,kgs(mgs))**2*(qr)*qr/z*(6./(pi*xdn(mgs,il)))**2
14778 an(igs(mgs),jy,kgs(mgs),ln(il)) = cx(mgs,il)
14780 ELSEIF ( lrescalelow(il) .and. alp <= alphamin .and. .not. (il == lh .and. icvhl2h > 0 ) .and. &
14781 .not. ( il == lr .and. .not. rescale_low_alphar ) )
THEN
14783 IF ( irescalerainopt == 0 )
THEN
14785 ELSEIF ( irescalerainopt == 1 )
THEN
14786 wtest = qx(mgs,lc) > qxmin(lc)
14787 ELSEIF ( irescalerainopt == 2 )
THEN
14788 wtest = qx(mgs,lc) > qxmin(lc) .and. wvel(mgs) < rescale_wthresh
14789 ELSEIF ( irescalerainopt == 3 )
THEN
14790 wtest = temcg(mgs) > rescale_tempthresh .and. qx(mgs,lc) > qxmin(lc) .and. wvel(mgs) < rescale_wthresh
14793 IF ( il == lr .and. ( wtest ) )
THEN
14797 chw = g1*dn(igs(mgs),jy,kgs(mgs))**2*(qr)*qr/z*(6./(pi*xdn(mgs,il)))**2
14799 an(igs(mgs),jy,kgs(mgs),ln(il)) = chw
14803 z1 = g1*dn(igs(mgs),jy,kgs(mgs))**2*(qr)*qr/chw
14804 z = z1*(6./(pi*xdn(mgs,il)))**2
14806 an(igs(mgs),jy,kgs(mgs),lz(il)) = z
14818 IF ( alp >= alphamax - 0.5 )
THEN
14821 g1x(mgs,il) = (pi*xdn(mgs,il))**2*zx(mgs,il)*cx(mgs,il)/((6.*rho0(mgs)*qx(mgs,il))**2)
14837 IF ( il == lr )
THEN
14853 tmp = alpha(mgs,lr) + 1.
14854 i = int(dgami*(tmp))
14856 y = gmoi(i) + (gmoi(i+1) - gmoi(i))*del*dgami
14860 IF ( iferwisventr == 2 )
THEN
14861 tmp = alpha(mgs,lr) + 2.5 + br/2.
14862 i = int(dgami*(tmp))
14864 x = gmoi(i) + (gmoi(i+1) - gmoi(i))*del*dgami
14897 IF ( .not. ( il == lr .and. imurain == 3 ) )
THEN
14900 IF ( qx(mgs,il) > qxmin(il) )
THEN
14901 xnutmp = (alpha(mgs,il) - 2.)/3.
14905 IF ( il .ne. ic .and. qx(mgs,ic) .gt. qxmin(ic))
THEN
14907 IF ( ic == lc .and. idiagnosecnu > 0 ) xnuc = alpha(mgs,lc)
14908 IF ( il /= lr .and. ic == lr .and. lzr > 1 )
THEN
14909 IF ( imurain == 3 )
THEN
14910 xnuc = alpha(mgs,lr)
14912 xnuc = ( alpha(mgs,lr) - 2. )/3.
14916 IF ( .false. )
THEN
14917 dab0lh(mgs,ic,il) =
delabk(bb(ic), bb(il), xnuc, xnutmp, xmu(ic), xmu(il), 0)
14918 dab1lh(mgs,ic,il) =
delabk(bb(ic), bb(il), xnuc, xnutmp, xmu(ic), xmu(il), 1)
14919 dab0lh(mgs,il,ic) =
delabk(bb(il), bb(ic), xnutmp, xnuc, xmu(il), xmu(ic), 0)
14920 dab1lh(mgs,il,ic) =
delabk(bb(il), bb(ic), xnutmp, xnuc, xmu(il), xmu(ic), 1)
14922 i = nint( alpha(mgs,il)*dqiacralphainv )
14923 IF ( ic == lc .or. ic == li .or. ic == ls .or. (ic == lr .and. imurain == 3) )
THEN
14924 alp = (3.*alpha(mgs,ic) + 2.)
14925 j = nint( (3.*alpha(mgs,ic) + 2.)*dqiacralphainv )
14927 alp = alpha(mgs,ic)
14928 j = nint( alpha(mgs,ic)*dqiacralphainv )
14931 dab0lh(mgs,ic,il) = dab0lu(j,i,ic,il)
14932 dab1lh(mgs,ic,il) = dab1lu(j,i,ic,il)
14933 dab0lh(mgs,il,ic) = dab0lu(i,j,il,ic)
14934 dab1lh(mgs,il,ic) = dab1lu(i,j,il,ic)
14945 IF ( .false. .and. ny <= 2 )
THEN
14947 write(0,*)
'bb: ', bb(il), bb(ic), xnutmp, xnuc, xmu(il), xmu(ic)
14948 write(0,*)
'il,ic = ',il,ic,alpha(mgs,il),i,xnuc,alp,j
14949 write(0,*)
'dab0lh,tmp1 = ',dab0lh(mgs,ic,il),tmp1
14950 write(0,*)
'dab1lh,tmp2 = ',dab1lh(mgs,ic,il),tmp2
14951 write(0,*)
'dab0lh,tmp3 = ',dab0lh(mgs,il,ic),tmp3,tmp5
14952 write(0,*)
'dab1lh,tmp4 = ',dab1lh(mgs,il,ic),tmp4,tmp6
14963 da0lx(mgs,il) =
delbk(bb(il), xnutmp, xmu(il), 0)
14964 IF ( il .eq. lh )
THEN
14965 da0lh(mgs) =
delbk(bb(il), xnutmp, xmu(il), 0)
14966 IF ( lzr > 1 )
THEN
14969 rzxh(mgs) = ((4. + alpha(mgs,il))*(5. + alpha(mgs,il))*(6. + alpha(mgs,il))*(1. + xnu(lr)))/ &
14970 & ((1. + alpha(mgs,il))*(2. + alpha(mgs,il))*(3. + alpha(mgs,il))*(2. + xnu(lr)))
14973 IF ( lzhl < 1 )
THEN
14974 rzxhlh(mgs) = rzxhl(mgs)/(((4. + alpha(mgs,il))*(5. + alpha(mgs,il))*(6. + alpha(mgs,il))*(1. + xnu(lr)))/ &
14975 & ((1. + alpha(mgs,il))*(2. + alpha(mgs,il))*(3. + alpha(mgs,il))*(2. + xnu(lr))))
14977 ELSEIF ( il .eq. lhl )
THEN
14978 da0lhl(mgs) =
delbk(bb(il), xnutmp, xmu(il), 0)
14979 IF ( lzr > 1 )
THEN
14982 rzxhl(mgs) = ((4.0 + alpha(mgs,il))*(5. + alpha(mgs,il))*(6. + alpha(mgs,il))*(1. + xnu(lr)))/ &
14983 & ((1. + alpha(mgs,il))*(2. + alpha(mgs,il))*(3. + alpha(mgs,il))*(2. + xnu(lr)))
14985 ELSEIF ( il == lr )
THEN
14986 xnutmp = (alpha(mgs,il) - 2.)/3.
14987 da0lr(mgs) =
delbk(bb(il), xnutmp, xmu(il), 0)
14988 da1lr(mgs) =
delbk(bb(il), xnutmp, xmu(il), 1)
15010 kp1 = min(nz, kgs(mgs)+1 )
15015 wvelkm1(mgs) = (0.5)*(w(igs(mgs),jgs,kgs(mgs)) &
15016 & +w(igs(mgs),jgs,kgsm(mgs)))
15017 cninm(mgs) = t7(igs(mgs),jgs,kgsm(mgs))
15018 cnina(mgs) = t7(igs(mgs),jgs,kgs(mgs))
15019 cninp(mgs) = t7(igs(mgs),jgs,kgsp(mgs))
15037 IF ( rimdenvwgt > 0 ) infdo = 1
15039 call setvtz(ngscnt,qx,qxmin,qxw,cx,rho0,rhovt,xdia,cno,cnostmp, &
15040 & xmas,vtxbar,xdn,xvmn,xvmx,xv,cdx,cdxgs, &
15041 & ipconc,ndebug,ngs,nz,kgs,fadvisc, &
15042 & cwmasn,cwmasx,cwradn,cnina,cimn,cimx, &
15043 & itype1,itype2,temcg,infdo,alpha,0,axx,bxx)
15047 IF ( lwsm6 .and. ipconc == 0 )
THEN
15048 tmp = max(qxmin(lh), qxmin(ls))
15050 total = qx(mgs,lh) + qx(mgs,ls)
15051 IF ( total > tmp )
THEN
15052 vt2ave(mgs) = (qx(mgs,lh)*vtxbar(mgs,lh,1) + qx(mgs,ls)*vtxbar(mgs,ls,1))/total
15063 if ( ndebug .gt. 0 )
write(0,*)
'ICEZVD_GS: Set concentration'
15064 IF ( ipconc .lt. 1 )
THEN
15065 cina(1:ngscnt) = cx(1:ngscnt,li)
15067 if ( ipconc .lt. 5 )
then
15071 IF ( ipconc .lt. 3 )
THEN
15073 if ( qx(mgs,lr) .gt. qxmin(lh) )
then
15079 IF ( ipconc .lt. 4 )
THEN
15082 if ( qx(mgs,ls) .gt. qxmin(ls) )
then
15088 IF ( ipconc .lt. 5 )
THEN
15092 if ( qx(mgs,lh) .gt. qxmin(lh) )
then
15103 IF ( ipconc .ge. 2 )
THEN
15106 rb(mgs) = 0.5*xdia(mgs,lc,1)*(1./(1.+alpha(mgs,lc)))**(1./6.)
15107 xl2p(mgs) = max(0.0d0, 2.7e-2*xdn(mgs,lc)*cx(mgs,lc)*xv(mgs,lc)* &
15108 & ((0.5e20*rb(mgs)**3*xdia(mgs,lc,1))-0.4) )
15109 IF ( rb(mgs) .gt. 3.51e-6 )
THEN
15111 rh(mgs) = max( 41.d-6, 6.3d-4/(1.d6*(rb(mgs) - 3.5d-6)) )
15115 IF ( xl2p(mgs) .gt. 0.0 )
THEN
15116 nh(mgs) = 4.2d9*xl2p(mgs)
15130 if( ndebug .ge. 0 )
THEN
15134 qvimxd(mgs) = 0.70*(qx(mgs,lv)-qis(mgs))*dtpinv
15136 IF ( qx(mgs,lc) < qxmin(lc) ) qvimxd(mgs) = 0.99*(qx(mgs,lv)-qis(mgs))*dtpinv
15138 qvimxd(mgs) = max(qvimxd(mgs), 0.0)
15141 qimxd(mgs) = frac*qx(mgs,li)*dtpinv
15142 qcmxd(mgs) = frac*qx(mgs,lc)*dtpinv
15143 qrmxd(mgs) = frac*qx(mgs,lr)*dtpinv
15144 qsmxd(mgs) = frac*qx(mgs,ls)*dtpinv
15145 qhmxd(mgs) = frac*qx(mgs,lh)*dtpinv
15146 IF ( lhl > 1 ) qhlmxd(mgs) = frac*qx(mgs,lhl)*dtpinv
15149 if( ndebug .ge. 0 )
THEN
15155 if ( qx(mgs,lc) .le. qxmin(lc) )
then
15156 ccmxd(mgs) = 0.20*cx(mgs,lc)*dtpinv
15158 IF ( ipconc .ge. 2 )
THEN
15159 ccmxd(mgs) = frac*cx(mgs,lc)*dtpinv
15161 ccmxd(mgs) = frac*qx(mgs,lc)/(xmas(mgs,lc)*rho0(mgs)*dtp)
15165 if ( qx(mgs,li) .le. qxmin(li) )
then
15166 cimxd(mgs) = frac*cx(mgs,li)*dtpinv
15168 IF ( ipconc .ge. 1 )
THEN
15169 cimxd(mgs) = frac*cx(mgs,li)*dtpinv
15171 cimxd(mgs) = frac*qx(mgs,li)/(xmas(mgs,li)*rho0(mgs)*dtp)
15176 crmxd(mgs) = 0.10*cx(mgs,lr)*dtpinv
15177 csmxd(mgs) = frac*cx(mgs,ls)*dtpinv
15178 chmxd(mgs) = frac*cx(mgs,lh)*dtpinv
15180 ccmxd(mgs) = frac*cx(mgs,lc)*dtpinv
15181 cimxd(mgs) = frac*cx(mgs,li)*dtpinv
15182 crmxd(mgs) = frac*cx(mgs,lr)*dtpinv
15183 csmxd(mgs) = frac*cx(mgs,ls)*dtpinv
15184 chmxd(mgs) = frac*cx(mgs,lh)*dtpinv
15186 qxmxd(mgs,lv) = max(0.0, 0.1*(qx(mgs,lv) - qvs(mgs))*dtpinv)
15189 qxmxd(mgs,il) = frac*qx(mgs,il)*dtpinv
15190 cxmxd(mgs,il) = frac*cx(mgs,il)*dtpinv
15198 IF ( ipconc >= 6 )
THEN
15202 IF ( lz(il) > 0 .or. ( il == lr ) )
THEN
15204 zxmxd(mgs,il) = frac*zx(mgs,il)*dtpinv
15214 maxmassfac(lc) = ( (2. + 3.*(1. + xnu(lc)) )**3/( 3.*(1. + xnu(lc)) ) )
15215 maxmassfac(li) = ( (2. + 3.*(1. + xnu(li)) )**3/( 3.*(1. + xnu(li)) ) )
15217 IF ( imurain == 3 )
THEN
15218 maxmassfac(lr) = ( (2. + 3.*(1. + xnu(lr)) )**3/( 3.*(1. + xnu(lr)) ) )
15220 maxmassfac(lr) = (3.0 + alphar)**3/ &
15221 & ((3.+alphar)*(2.+alphar)*(1. + alphar) )
15224 IF ( imusnow == 3 )
THEN
15225 maxmassfac(ls) = ( (2. + 3.*(1. + alphas) )**3/( 3.*(1. + alphas) ) )
15227 maxmassfac(ls) = (3.0 + alphas)**3/ &
15228 & ((3.+alphas)*(2.+alphas)*(1. + alphas) )
15231 maxmassfac(lh) = (3.0 + alphah)**3/ &
15232 & ((3.+alphah)*(2.+alphah)*(1. + alphah) )
15234 IF ( lhl > 1 )
THEN
15235 maxmassfac(lhl) = (3.0 + alphahl)**3/ &
15236 & ((3.+alphahl)*(2.+alphahl)*(1. + alphahl) )
15244 vshdgs(mgs,il) = vshd
15246 IF ( qx(mgs,il) > qxmin(il) .and. ivshdgs > 0 )
THEN
15249 tmpdiam = (shedalp+alpha(mgs,il))*xdia(mgs,il,1)
15251 IF ( tmpdiam > sheddiam0 )
THEN
15252 vshdgs(mgs,il) = 0.523599*(1.5e-3)**3/massfacshr
15253 ELSEIF ( tmpdiam > sheddiam )
THEN
15254 vshdgs(mgs,il) = 0.523599*(3.0e-3)**3/massfacshr
15257 vshdgs(mgs,il) = min( xvmx(lr), 6./pi*xdn(mgs,il)*0.001*tmpdiam**3 )/massfacshr
15271 if (ndebug .gt. 0 )
write(0,*)
'ICEZVD_GS: Set collection efficiencies'
15315 ehlsclsn(mgs) = 0.0
15316 ehliclsn(mgs) = 0.0
15321 IF ( exwmindiam > 0 .and. qx(mgs,lc) > qxmin(lc) )
THEN
15322 tmp = cx(mgs,lc)*exp(- (exwmindiam/xdia(mgs,lc,1))**3 )
15323 ccwresv(mgs) = min( cx(mgs,lc), max( 2.e6, cx(mgs,lc) - tmp ) )
15325 tmp = cx(mgs,lc) - ccwresv(mgs)
15327 volt = pi/6.*(exwmindiam)**3
15328 qcwresv(mgs) = qx(mgs,lc) - tmp*xdn0(lc)*rhoinv(mgs)*(volt + xv(mgs,lc))
15331 IF ( .false. .and. qx(mgs,lc) > 0.1e-3 )
THEN
15333 write(0,*)
'cx,qx,crsv,qrsv = ',cx(mgs,lc),qx(mgs,lc),ccwresv(mgs),qcwresv(mgs)
15341 IF ( qx(mgs,lc) .gt. qxmin(lc) )
THEN
15342 cwrad = 0.5*xdia(mgs,lc,1)
15344 IF ( cwrad .ge. 1.e-6*cwr(il,1) ) icwr(mgs) = il
15350 IF ( qx(mgs,lr) .gt. qxmin(lr) )
THEN
15351 rwrad = 0.5*xdia(mgs,lr,3)
15353 IF ( rwrad .ge. 1.e-6*grad(il,1) ) irwr(mgs) = il
15362 IF ( qx(mgs,lh) .gt. qxmin(lh) )
THEN
15363 rwrad = 0.5*xdia(mgs,lh,3)
15365 IF ( rwrad .ge. 1.e-6*grad(il,1) ) igwr(mgs) = il
15370 IF ( lhl .gt. 1 )
THEN
15372 IF ( qx(mgs,lhl) .gt. qxmin(lhl) )
THEN
15373 rwrad = 0.5*xdia(mgs,lhl,3)
15375 IF ( rwrad .ge. 1.e-6*grad(il,1) ) ihlr(mgs) = il
15385 if ( qx(mgs,li) .gt. qxmin(li) )
then
15393 eii(mgs) = exp(0.025*min(temcg(mgs),0.0))
15395 if ( temg(mgs) .gt. 273.15 ) eii(mgs) = 1.0
15404 if ( qx(mgs,li).gt.qxmin(li) .and. qx(mgs,lc).gt.qxmin(lc) )
then
15407 if (xdia(mgs,lc,1).gt.ewi_dcmin .and. xdia(mgs,li,1).gt.ewi_dimin)
then
15412 if ( temg(mgs) .ge. 273.15 ) eiw(mgs) = 0.0
15421 if ( qx(mgs,lr).gt.qxmin(lr) .and. qx(mgs,lc).gt.qxmin(lc) )
then
15423 IF ( lnr .gt. 1 )
THEN
15438 icp1 = min( 8, ic+1 )
15440 irp1 = min( 6, ir+1 )
15441 cwrad = 0.5*xdia(mgs,lc,3)
15442 rwrad = 0.5*xdia(mgs,lr,3)
15444 slope1 = (ew(icp1, ir ) - ew(ic,ir ))*cwr(ic,2)
15445 slope2 = (ew(icp1, irp1) - ew(ic,irp1))*cwr(ic,2)
15449 x1 = ew(ic, ir) + slope1*max(0.0, (cwrad - cwr(ic,1)) )
15450 x2 = ew(icp1,ir) + slope2*max(0.0, (cwrad - cwr(ic,1)) )
15452 slope1 = (x2 - x1)*grad(ir,2)
15454 erw(mgs) = max(0.0, x1 + slope1*max(0.0, (rwrad - grad(ir,1)) ))
15459 erw(mgs) = max(0.0, erw(mgs) )
15460 IF ( rwrad .lt. 50.e-6 )
THEN
15462 ELSEIF ( rwrad .lt. 100.e-6 )
THEN
15463 erw(mgs) = erw(mgs)*(rwrad - 50.e-6)/50.e-6
15468 IF ( cx(mgs,lc) .le. 0.0 ) erw(mgs) = 0.0
15470 if ( qx(mgs,lr).gt.qxmin(lr) .and. qx(mgs,lr).gt.qxmin(lr) )
then
15474 if ( qx(mgs,lr).gt.qxmin(lr) .and. qx(mgs,ls).gt.qxmin(ls) )
then
15478 if ( qx(mgs,lr).gt.qxmin(lr) .and. qx(mgs,li).gt.qxmin(li) )
then
15488 if ( xdia(mgs,li,3) .lt. eri_cimin ) eri(mgs)=0.0
15500 if ( qx(mgs,ls).gt.qxmin(ls) .and. qx(mgs,lc).gt.qxmin(lc) )
then
15502 if ( xdia(mgs,lc,1) .gt. 15.e-6 .and. xdia(mgs,ls,1) .gt. 100.e-6)
then
15504 ELSEIF ( xdia(mgs,ls,1) .ge. 500.e-6 )
THEN
15505 esw(mgs) = min(0.5, 0.05 + (0.8-0.05)/(40.e-6)*xdia(mgs,lc,1) )
15509 if ( qx(mgs,ls).gt.qxmin(ls) .and. qx(mgs,lr).gt.qxmin(lr) &
15510 & .and. temg(mgs) .lt. tfr - 1. &
15512 esr(mgs)=exp(-(40.e-6)**3/xv(mgs,lr))*exp(-40.e-6/xdia(mgs,ls,1))
15513 IF ( qx(mgs,ls) < 1.e-4 .and. qx(mgs,lr) < 1.e-4 ) il2(mgs) = 1
15516 IF ( ipconc < 3 .and. temg(mgs) < tfr .and. qx(mgs,lr).gt.qxmin(lr) .and. qx(mgs,lr) < 1.e-4 )
THEN
15521 if ( temcg(mgs) < 0.0 )
then
15523 IF ( ipconc .lt. 4 .or. temcg(mgs) < esstem1 )
THEN
15531 IF ( iessopt == 2 )
THEN
15533 IF ( wvel(mgs) > 2.0 )
THEN
15536 ELSEIF ( wvel(mgs) > 1.0 )
THEN
15537 fac = max(0.0, 2.0 - wvel(mgs))*fac
15539 ELSEIF ( iessopt == 3 )
THEN
15540 IF ( ssi(mgs) <= 1.0 )
THEN
15543 ELSEIF ( ssi(mgs) <= 1.02 )
THEN
15544 fac = fac*(ssi(mgs) - 1.0)/0.02
15545 ehsfac(mgs) = (ssi(mgs) - 1.0)/0.02
15547 ELSEIF ( iessopt == 4 )
THEN
15548 IF ( ssi(mgs) <= 1.0 )
THEN
15551 ELSEIF ( ssi(mgs) <= 1.005 )
THEN
15552 fac = max(0.1, fac*(ssi(mgs) - 1.0)/0.005)
15553 ehsfac(mgs) = max(0.1, (ssi(mgs) - 1.0)/0.005)
15557 IF ( temcg(mgs) > esstem1 .and. temcg(mgs) < esstem2 )
THEN
15558 ess(mgs) = fac*exp(ess1*(esstem2) )*(temcg(mgs) - esstem1)/(esstem2 - esstem1)
15559 ELSEIF ( temcg(mgs) >= esstem2 )
THEN
15560 ess(mgs) = fac*exp(ess1*min( temcg(mgs), 0.0 ) )
15566 if ( qx(mgs,ls).gt.qxmin(ls) .and. qx(mgs,li).gt.qxmin(li) )
then
15567 esiclsn(mgs) = esi_collsn
15569 IF ( ipconc < 1 .and. lwsm6 )
THEN
15570 esi(mgs) = exp(0.7*min(temcg(mgs),0.0))
15572 esi(mgs) = esi0*exp(0.1*min(temcg(mgs),0.0))
15573 esi(mgs) = min(0.1,esi(mgs))
15575 IF ( ipconc .le. 3 )
THEN
15576 esi(mgs) = exp(0.025*min(temcg(mgs),0.0))
15583 if ( temg(mgs) .gt. 273.15 ) esi(mgs) = 0.0
15592 xmascw(mgs) = xmas(mgs,lc)
15593 if ( qx(mgs,lh).gt.qxmin(lh) .and. qx(mgs,lc).gt.qxmin(lc) )
then
15595 IF ( iehw .eq. 0 )
THEN
15597 ELSEIF ( iehw .eq. 1 .or. iehw .eq. 10 )
THEN
15598 cwrad = 0.5*xdia(mgs,lc,1)
15599 ehw(mgs) = min( ehw0, &
15600 & ewfac*min((aradcw + cwrad*(bradcw + cwrad* &
15601 & (cradcw + cwrad*(dradcw)))), 1.0) )
15603 ELSEIF ( iehw .eq. 2 .or. iehw .eq. 10 )
THEN
15605 icp1 = min( 8, ic+1 )
15607 irp1 = min( 6, ir+1 )
15608 cwrad = 0.5*xdia(mgs,lc,1)
15609 rwrad = 0.5*xdia(mgs,lh,3)
15611 slope1 = (ew(icp1, ir ) - ew(ic,ir ))*cwr(ic,2)
15612 slope2 = (ew(icp1, irp1) - ew(ic,irp1))*cwr(ic,2)
15616 x1 = ew(ic, ir) + slope1*max(0.0, (cwrad - cwr(ic,1)) )
15617 x2 = ew(icp1,ir) + slope2*max(0.0, (cwrad - cwr(ic,1)) )
15619 slope1 = (x2 - x1)*grad(ir,2)
15621 tmp = max( 0.0, min( 1.0, x1 + slope1*max(0.0, (rwrad - grad(ir,1)) ) ) )
15622 ehw(mgs) = min( ehw(mgs), tmp )
15632 ELSEIF ( iehw .eq. 3 .or. iehw .eq. 10 )
THEN
15633 tmp = exp(- (dmincw/xdia(mgs,lc,1))**3)
15634 xmascw(mgs) = xmas(mgs,lc) + xdn0(lc)*(pi*dmincw**3/6.0)
15635 ehw(mgs) = min( ehw(mgs), tmp )
15636 ELSEIF ( iehw .eq. 4 .or. iehw .eq. 10 )
THEN
15638 & 2.0*xdn(mgs,lc)*vtxbar(mgs,lh,1)*(0.5*xdia(mgs,lc,1))**2 &
15639 & /(9.0*fadvisc(mgs)*0.5*xdia(mgs,lh,3))
15640 tmp = max( 1.5, min(10.0, tmp) )
15641 ehw(mgs) = min( ehw(mgs), 0.55*log10(2.51*tmp) )
15643 if ( xdia(mgs,lc,1) .lt. 2.4e-06 ) ehw(mgs)=0.0
15645 ehw(mgs) = min( ehw0, ehw(mgs) )
15647 IF ( ibfc == -1 .and. temcg(mgs) < -41.0 )
THEN
15653 if ( qx(mgs,lh).gt.qxmin(lh) .and. qx(mgs,lr).gt.qxmin(lr) &
15658 ehr(mgs) = exp(-(40.e-6)/xdia(mgs,lr,3))*exp(-40.e-6/xdia(mgs,lh,3))
15659 ehr(mgs) = min( ehr0, ehr(mgs) )
15662 IF ( qx(mgs,ls).gt.qxmin(ls) )
THEN
15663 IF ( ipconc .ge. 4 )
THEN
15664 ehscnv(mgs) = ehs0*exp(ehs1*min(temcg(mgs),0.0))
15666 ehscnv(mgs) = exp(0.09*min(temcg(mgs),0.0))
15669 IF ( qx(mgs,lh).gt.qxmin(lh) .and. qx(mgs,lc) >= qxmin(lc) )
THEN
15673 ehsclsn(mgs) = ehs_collsn
15674 IF ( xdia(mgs,ls,3) < 40.e-6 )
THEN
15676 ELSEIF ( xdia(mgs,ls,3) < 150.e-6 )
THEN
15677 ehsclsn(mgs) = ehs_collsn*(xdia(mgs,ls,3) - 40.e-6)/(150.e-6 - 40.e-6)
15679 ehsclsn(mgs) = ehs_collsn
15682 ehs(mgs) = ehscnv(mgs)*min(1.0, max(0.0,xdn(mgs,lh) - 300.)/300. )
15684 ehs(mgs) = min(ehs(mgs),ehsmax)
15688 if ( qx(mgs,lh).gt.qxmin(lh) .and. qx(mgs,li).gt.qxmin(li) )
then
15689 ehiclsn(mgs) = ehi_collsn
15690 ehi(mgs)=eii0*exp(eii1*min(temcg(mgs),0.0))
15691 ehi(mgs) = min( ehimax, max( ehi(mgs), ehimin ) )
15695 IF ( lis > 1 )
THEN
15696 if ( qx(mgs,lh).gt.qxmin(lh) .and. qx(mgs,lis).gt.qxmin(lis) )
then
15697 ehisclsn(mgs) = ehi_collsn
15698 ehis(mgs)=eii0*exp(eii1*min(temcg(mgs),0.0))
15699 ehis(mgs) = min( ehimax, max( ehis(mgs), ehimin ) )
15710 IF ( lhl .gt. 1 )
THEN
15712 if ( qx(mgs,lhl).gt.qxmin(lhl) .and. qx(mgs,lc).gt.qxmin(lc) )
then
15713 IF ( iehw == 3 ) iehlw = 3
15714 IF ( iehw == 4 ) iehlw = 4
15716 IF ( iehlw .eq. 0 )
THEN
15718 ELSEIF ( iehlw .eq. 1 .or. iehlw .eq. 10 )
THEN
15719 cwrad = 0.5*xdia(mgs,lc,1)
15720 ehlw(mgs) = min( ehlw0, &
15721 & ewfac*min((aradcw + cwrad*(bradcw + cwrad* &
15722 & (cradcw + cwrad*(dradcw)))), 1.0) )
15724 ELSEIF ( iehlw .eq. 2 .or. iehlw .eq. 10 )
THEN
15726 icp1 = min( 8, ic+1 )
15728 irp1 = min( 6, ir+1 )
15729 cwrad = 0.5*xdia(mgs,lc,1)
15730 rwrad = 0.5*xdia(mgs,lhl,3)
15732 slope1 = (ew(icp1, ir ) - ew(ic,ir ))*cwr(ic,2)
15733 slope2 = (ew(icp1, irp1) - ew(ic,irp1))*cwr(ic,2)
15735 x1 = ew(ic, ir) + slope1*(cwrad - cwr(ic,1))
15736 x2 = ew(icp1,ir) + slope2*(cwrad - cwr(ic,1))
15738 slope1 = (x2 - x1)*grad(ir,2)
15740 tmp = max( 0.0, min( 1.0, x1 + slope1*(rwrad - grad(ir,1)) ) )
15741 ehlw(mgs) = min( ehlw(mgs), tmp )
15742 ehlw(mgs) = min( ehlw0, ehlw(mgs) )
15748 ELSEIF ( iehlw .eq. 3 .or. iehlw .eq. 10 )
THEN
15749 tmp = exp(- (dmincw/xdia(mgs,lc,1))**3)
15750 ehlw(mgs) = min( ehlw(mgs), tmp )
15751 ELSEIF ( iehlw .eq. 4 .or. iehlw .eq. 10 )
THEN
15753 & 2.0*xdn(mgs,lc)*vtxbar(mgs,lhl,1)*(0.5*xdia(mgs,lc,1))**2 &
15754 & /(9.0*fadvisc(mgs)*0.5*xdia(mgs,lhl,3))
15755 tmp = max( 1.5, min(10.0, tmp) )
15756 ehlw(mgs) = min( ehlw(mgs), 0.55*log10(2.51*tmp) )
15758 if ( xdia(mgs,lc,1) .lt. 2.4e-06 ) ehlw(mgs)=0.0
15759 ehlw(mgs) = min( ehlw0, ehlw(mgs) )
15761 IF ( ibfc == -1 .and. temcg(mgs) < -41.0 )
THEN
15767 if ( qx(mgs,lhl).gt.qxmin(lhl) .and. qx(mgs,lr).gt.qxmin(lr) &
15771 ehlr(mgs) = min( ehlr0, ehlr(mgs) )
15774 IF ( qx(mgs,ls).gt.qxmin(ls) )
THEN
15775 if ( qx(mgs,lhl).gt.qxmin(lhl) )
then
15776 ehlsclsn(mgs) = ehls_collsn
15777 ehls(mgs) = ehscnv(mgs)
15778 ehls(mgs) = min(ehls(mgs),ehsmax)
15782 if ( qx(mgs,lhl).gt.qxmin(lhl) .and. qx(mgs,li).gt.qxmin(li) )
then
15783 ehliclsn(mgs) = ehli_collsn
15784 ehli(mgs)=eii0hl*exp(eii1hl*min(temcg(mgs),0.0))
15785 ehli(mgs) = min( ehimax, max( ehli(mgs), ehimin ) )
15786 if ( temg(mgs) .gt. 273.15 .or. ( qx(mgs,lc) < qxmin(lc)) ) ehli(mgs) = 0.0
15789 IF ( lis > 1 )
THEN
15790 if ( qx(mgs,lhl).gt.qxmin(lhl) .and. qx(mgs,lis).gt.qxmin(lis) )
then
15791 ehlisclsn(mgs) = ehli_collsn
15792 ehlis(mgs)=eii0*exp(eii1*min(temcg(mgs),0.0))
15793 ehlis(mgs) = min( ehimax, max( ehlis(mgs), ehimin ) )
15794 if ( temg(mgs) .gt. 273.15 .or. ( qx(mgs,lc) < qxmin(lc)) ) ehlis(mgs) = 0.0
15844 if (ndebug .gt. 0 )
write(0,*)
'Collection: rain collects xxxxx'
15848 IF ( qx(mgs,lr) .gt. qxmin(lr) .and. erw(mgs) .gt. 0.0 )
THEN
15849 IF ( ipconc .lt. 3 )
THEN
15850 IF ( erw(mgs) .gt. 0.0 .and. qx(mgs,lr) .gt. 1.e-7 )
THEN
15851 vt = (ar*(xdia(mgs,lc,1)**br))*rhovt(mgs)
15853 & (0.25)*pi*erw(mgs)*(qx(mgs,lc)-qcwresv(mgs))*cx(mgs,lr) &
15855 & *max(0.0, vtxbar(mgs,lr,1)-vt) &
15856 & *( gf3*xdia(mgs,lr,2) &
15857 & + 2.0*gf2*xdia(mgs,lr,1)*xdia(mgs,lc,1) &
15858 & + gf1*xdia(mgs,lc,2) )
15867 IF ( dmrauto <= 0 .or. rho0(mgs)*qx(mgs,lr) > 1.2*xl2p(mgs) )
THEN
15868 rwrad = 0.5*xdia(mgs,lr,3)
15869 IF ( rwrad .gt. rh(mgs) )
THEN
15870 IF ( rwrad .gt. rwradmn )
THEN
15873 qracw(mgs) = erw(mgs)*aa2*cx(mgs,lr)*cx(mgs,lc)*xmas(mgs,lc)* &
15874 & ((alpha(mgs,lc) + 2.)*xv(mgs,lc)/(alpha(mgs,lc) + 1.) + xv(mgs,lr))/rho0(mgs)
15877 IF ( imurain == 3 )
THEN
15886 qracw(mgs) = aa1*cx(mgs,lr)*(qx(mgs,lc)-qcwresv(mgs))* &
15887 & ((alpha(mgs,lc) + 3.)*(alpha(mgs,lc) + 2.)*xv(mgs,lc)**2/(alpha(mgs,lc) + 1.)**2 + &
15888 & (alpha(mgs,lr) + 2.)*xv(mgs,lr)**2/(alpha(mgs,lr) + 1.))
15892 qracw(mgs) = aa1*cx(mgs,lr)*(qx(mgs,lc)-qcwresv(mgs))* &
15893 & ((alpha(mgs,lc) + 3.)*(alpha(mgs,lc) + 2.)*xv(mgs,lc)**2/(alpha(mgs,lc) + 1.)**2 + &
15894 & (alpha(mgs,lr) + 6.)*(alpha(mgs,lr) + 5.)*(alpha(mgs,lr) + 4.)*xv(mgs,lr)**2/ &
15895 & ((alpha(mgs,lr) + 3.)*(alpha(mgs,lr) + 2.)*(alpha(mgs,lr) + 1.)))
15904 qracw(mgs) = min(qracw(mgs), qcmxd(mgs))
15912 IF ( eri(mgs) .gt. 0.0 .and. iacr .ge. 1 .and. xdia(mgs,lr,3) .gt. 2.*rwradmn )
THEN
15913 IF ( ipconc .ge. 3 )
THEN
15915 tmp = eri(mgs)*aa2*cx(mgs,lr)*cx(mgs,li)* &
15916 & ((cinu + 2.)*xv(mgs,li)/(cinu + 1.) + xv(mgs,lr))
15918 qraci(mgs) = min( qxmxd(mgs,li), tmp*xmas(mgs,li)*rhoinv(mgs) )
15919 craci(mgs) = min( cxmxd(mgs,li), tmp )
15944 & (0.25)*pi*eri(mgs)*qx(mgs,li)*cx(mgs,lr) &
15945 & *abs(vtxbar(mgs,lr,1)-vtxbar(mgs,li,1)) &
15946 & *( gf3*xdia(mgs,lr,2) &
15947 & + 2.0*gf2*xdia(mgs,lr,1)*xdia(mgs,li,1) &
15948 & + gf1*xdia(mgs,li,2) ) &
15951 if ( temg(mgs) .gt. 268.15 )
then
15957 IF ( ipconc < 3 )
THEN
15960 IF ( ers(mgs) .gt. 0.0 .and. ipconc < 3 )
THEN
15961 IF ( lwsm6 .and. ipconc == 0 )
THEN
15964 vt = vtxbar(mgs,ls,1)
15968 & ((0.25)*pi/gf4)*ers(mgs)*qx(mgs,ls)*cx(mgs,lr) &
15969 & *abs(vtxbar(mgs,lr,1)-vt) &
15970 & *( gf6*gf1*xdia(mgs,ls,2) &
15971 & + 2.0*gf5*gf2*xdia(mgs,ls,1)*xdia(mgs,lr,1) &
15972 & + gf4*gf3*xdia(mgs,lr,2) ) &
15980 if (ndebug .gt. 0 )
write(0,*)
'Collection: snow collects xxxxx'
15986 IF ( esw(mgs) .gt. 0.0 )
THEN
15988 IF ( ipconc .ge. 4 )
THEN
15994 tmp = 1.0*rvt*aa2*cx(mgs,ls)*cx(mgs,lc)* &
15995 & ((alpha(mgs,lc) + 2.)*xv(mgs,lc)/(alpha(mgs,lc) + 1.) + xv(mgs,ls))
15997 qsacw(mgs) = min( qxmxd(mgs,lc), tmp*xmas(mgs,lc)*rhoinv(mgs) )
15998 csacw(mgs) = min( cxmxd(mgs,lc), tmp )
16000 IF ( lvol(ls) .gt. 1 )
THEN
16001 IF ( temg(mgs) .lt. 273.15)
THEN
16002 rimdn(mgs,ls) = rimc1*(-((0.5)*(1.e+06)*xdia(mgs,lc,1)) &
16003 & *((0.60)*vtxbar(mgs,ls,1)) &
16004 & /(temg(mgs)-273.15))**(rimc2)
16005 rimdn(mgs,ls) = min( max( rimc3, rimdn(mgs,ls) ), rimc4 )
16007 rimdn(mgs,ls) = 1000.
16010 vsacw(mgs) = rho0(mgs)*qsacw(mgs)/rimdn(mgs,ls)
16027 vt = abs(vtxbar(mgs,ls,1)-vtxbar(mgs,lc,1))
16029 qsacw(mgs) = 0.25*pi*esw(mgs)*cx(mgs,ls)*qx(mgs,lc)*vt* &
16030 & ( da0(ls)*xdia(mgs,ls,3)**2 + &
16031 & dab1(ls,lc)*xdia(mgs,ls,3)*xdia(mgs,lc,3) + &
16032 & da1lc(mgs)*xdia(mgs,lc,3)**2 )
16033 qsacw(mgs) = min( qsacw(mgs), qxmxd(mgs,ls) )
16034 csacw(mgs) = rho0(mgs)*qsacw(mgs)/xmas(mgs,lc)
16044 IF ( ipconc .ge. 4 )
THEN
16045 IF ( esi(mgs) .gt. 0.0 .or. ( ipelec > 0 .and. esiclsn(mgs) > 0.0 ))
THEN
16049 tmp = esiclsn(mgs)*rvt*aa2*cx(mgs,ls)*cx(mgs,li)* &
16050 & ((cinu + 2.)*xv(mgs,li)/(cinu + 1.) + xv(mgs,ls))
16052 qsaci(mgs) = min( qxmxd(mgs,li), esi(mgs)*tmp*xmas(mgs,li)*rhoinv(mgs) )
16054 csaci(mgs) = min(cxmxd(mgs,li), esi(mgs)*tmp )
16066 IF ( esi(mgs) .gt. 0.0 )
THEN
16069 & ((0.25)*pi)*esi(mgs)*qx(mgs,li)*cx(mgs,ls) &
16070 & *abs(vtxbar(mgs,ls,1)-vtxbar(mgs,li,1)) &
16071 & *( gf3*xdia(mgs,ls,2) &
16072 & + 2.0*gf2*xdia(mgs,ls,1)*xdia(mgs,li,1) &
16073 & + gf1*xdia(mgs,li,2) ) &
16085 IF ( esr(mgs) .gt. 0.0 )
THEN
16086 IF ( ipconc .ge. 3 )
THEN
16098 IF ( lwsm6 .and. ipconc == 0 )
THEN
16101 vt = vtxbar(mgs,ls,1)
16106 & ((0.25)*pi/gf4)*esr(mgs)*qx(mgs,lr)*cx(mgs,ls) &
16107 & *abs(vtxbar(mgs,lr,1)-vt) &
16108 & *( gf6*gf1*xdia(mgs,lr,2) &
16109 & + 2.0*gf5*gf2*xdia(mgs,lr,1)*xdia(mgs,ls,1) &
16110 & + gf4*gf3*xdia(mgs,ls,2) ) &
16119 if (ndebug .gt. 0 )
write(0,*)
'Collection: graupel collects xxxxx'
16123 qhacwmlr(mgs) = 0.0
16129 IF ( .false. )
THEN
16130 vtmax = (gz(igs(mgs),jgs,kgs(mgs))*dtpinv)
16131 vtxbar(mgs,lh,1) = min( vtmax, vtxbar(mgs,lh,1))
16132 vtxbar(mgs,lh,2) = min( vtmax, vtxbar(mgs,lh,2))
16133 vtxbar(mgs,lh,3) = min( vtmax, vtxbar(mgs,lh,3))
16135 IF ( ehw(mgs) .gt. 0.0 )
THEN
16137 IF ( ipconc .ge. 2 )
THEN
16139 IF ( .false. )
THEN
16140 qhacw(mgs) = (ehw(mgs)*(qx(mgs,lc)-qcwresv(mgs))*cx(mgs,lh)*pi* &
16141 & abs(vtxbar(mgs,lh,1)-vtxbar(mgs,lc,1))* &
16142 & (2.0*xdia(mgs,lh,1)*(xdia(mgs,lh,1) + &
16143 & xdia(mgs,lc,1)*gf73rds) + &
16144 & xdia(mgs,lc,2)*gf83rds))/4.
16147 vt = abs(vtxbar(mgs,lh,1)-vtxbar(mgs,lc,1))
16149 qhacw(mgs) = 0.25*pi*ehw(mgs)*cx(mgs,lh)*(qx(mgs,lc)-qcwresv(mgs))*vt* &
16150 & ( da0lh(mgs)*xdia(mgs,lh,3)**2 + &
16151 & dab1lh(mgs,lh,lc)*xdia(mgs,lh,3)*xdia(mgs,lc,3) + &
16152 & da1lc(mgs)*xdia(mgs,lc,3)**2 )
16155 qhacw(mgs) = min( qhacw(mgs), 0.5*qx(mgs,lc)*dtpinv )
16157 IF ( lzh .gt. 1 )
THEN
16158 tmp = qx(mgs,lh)/cx(mgs,lh)
16171 & ((0.25)*pi)*ehw(mgs)*(qx(mgs,lc)-qcwresv(mgs))*cx(mgs,lh) &
16172 & *abs(vtxbar(mgs,lh,1)-vtxbar(mgs,lc,1)) &
16173 & *( gf3*xdia(mgs,lh,2) &
16174 & + 2.0*gf2*xdia(mgs,lh,1)*xdia(mgs,lc,1) &
16175 & + gf1*xdia(mgs,lc,2) ) &
16176 & , 0.5*(qx(mgs,lc)-qcwresv(mgs))*dtpinv)
16181 IF ( lwsm6 .and. qsacw(mgs) > 0.0 .and. qhacw(mgs) > 0.0)
THEN
16182 qaacw = ( qx(mgs,ls)*qsacw(mgs) + qx(mgs,lh)*qhacw(mgs) )/(qx(mgs,ls) + qx(mgs,lh))
16190 qhacwmlr(mgs) = qhacw(mgs)
16191 IF ( temg(mgs) > tfr .and. iqhacwshr == 0 )
THEN
16195 IF ( lvol(lh) .gt. 1 .or. lhl .gt. 1 )
THEN
16197 IF ( temg(mgs) .lt. 273.15)
THEN
16198 IF ( irimdenopt == 1 )
THEN
16199 vt = ( (1.0-rimdenvwgt)*vtxbar(mgs,lh,1) + rimdenvwgt*vtxbar(mgs,lh,2) )
16201 rimdn(mgs,lh) = rimc1*(-((0.5)*(1.e+06)*xdia(mgs,lc,1)) &
16203 & /(temg(mgs)-273.15))**(rimc2)
16205 rimdn(mgs,lh) = min( max( rimc3, rimdn(mgs,lh) ), rimc4 )
16215 ELSEIF ( irimdenopt == 2 )
THEN
16217 tmp = (-((0.5)*(1.e+06)*xdia(mgs,lc,1)) &
16218 & *( (1.0-rimdenvwgt)*vtxbar(mgs,lh,1) + rimdenvwgt*vtxbar(mgs,lh,2) ) &
16219 & /(temg(mgs)-273.15))
16220 tmp = min( 5.5/0.6, max( 0.3/0.6, tmp ) )
16222 rimdn(mgs,lh) = 1000.*(0.051 + 0.114*tmp - 0.0055*tmp**2)
16224 ELSEIF ( irimdenopt == 3 .or. irimdenopt == 4)
THEN
16226 tmp = (-((0.5)*(1.e+06)*xdia(mgs,lc,1)) &
16227 & *( (1.0-rimdenvwgt)*vtxbar(mgs,lh,1) + rimdenvwgt*vtxbar(mgs,lh,2) ) &
16228 & /(temg(mgs)-273.15))
16231 IF ( irimdenopt == 3 )
THEN
16232 rimdn(mgs,lh) = min(900., max( 170., 110.*tmp**0.76 ) )
16233 ELSEIF ( irimdenopt == 4 )
THEN
16234 rimdn(mgs,lh) = min(917., max( 10., 900.0*(1.0 - 0.905**tmp ) ) )
16239 rimdn(mgs,lh) = 1000.
16242 IF ( lvol(lh) > 1 ) vhacw(mgs) = rho0(mgs)*qhacw(mgs)/rimdn(mgs,lh)
16246 IF ( qx(mgs,lh) .gt. qxmin(lh) .and. ipelec .ge. 1 )
THEN
16248 & qhacw(mgs)*1.0e3*rho0(mgs)/((pi/2.0)*xdia(mgs,lh,2)*cx(mgs,lh))
16258 IF ( ehi(mgs) .gt. 0.0 )
THEN
16259 IF ( ipconc .ge. 5 )
THEN
16261 vt = sqrt((vtxbar(mgs,lh,1)-vtxbar(mgs,li,1))**2 + &
16262 & 0.04*vtxbar(mgs,lh,1)*vtxbar(mgs,li,1) )
16264 qhaci0(mgs) = 0.25*pi*ehiclsn(mgs)*cx(mgs,lh)*qx(mgs,li)*vt* &
16265 & ( da0lh(mgs)*xdia(mgs,lh,3)**2 + &
16266 & dab1lh(mgs,lh,li)*xdia(mgs,lh,3)*xdia(mgs,li,3) + &
16267 & da1(li)*xdia(mgs,li,3)**2 )
16268 qhaci(mgs) = min( ehi(mgs)*qhaci0(mgs), qimxd(mgs) )
16272 & ((0.25)*pi)*ehi(mgs)*ehiclsn(mgs)*qx(mgs,li)*cx(mgs,lh) &
16273 & *abs(vtxbar(mgs,lh,1)-vtxbar(mgs,li,1)) &
16274 & *( gf3*xdia(mgs,lh,2) &
16275 & + 2.0*gf2*xdia(mgs,lh,1)*xdia(mgs,li,1) &
16276 & + gf1*xdia(mgs,li,2) ) &
16283 IF ( lis > 1 .and. ipconc >= 5 )
THEN
16287 IF ( ehis(mgs) .gt. 0.0 )
THEN
16289 vt = sqrt((vtxbar(mgs,lh,1)-vtxbar(mgs,lis,1))**2 + &
16290 & 0.04*vtxbar(mgs,lh,1)*vtxbar(mgs,lis,1) )
16292 qhacis0(mgs) = 0.25*pi*ehisclsn(mgs)*cx(mgs,lh)*qx(mgs,lis)*vt* &
16293 & ( da0lh(mgs)*xdia(mgs,lh,3)**2 + &
16294 & dab1lh(mgs,lh,lis)*xdia(mgs,lh,3)*xdia(mgs,lis,3) + &
16295 & da1(li)*xdia(mgs,lis,3)**2 )
16296 qhacis(mgs) = min( ehis(mgs)*qhacis0(mgs), qxmxd(mgs,lis) )
16306 IF ( ehs(mgs) .gt. 0.0 )
THEN
16307 IF ( ipconc .ge. 5 )
THEN
16309 vt = sqrt((vtxbar(mgs,lh,1)-vtxbar(mgs,ls,1))**2 + &
16310 & 0.04*vtxbar(mgs,lh,1)*vtxbar(mgs,ls,1) )
16312 qhacs0(mgs) = 0.25*pi*ehsclsn(mgs)*cx(mgs,lh)*qx(mgs,ls)*vt* &
16313 & ( da0lh(mgs)*xdia(mgs,lh,3)**2 + &
16314 & dab1lh(mgs,lh,ls)*xdia(mgs,lh,3)*xdia(mgs,ls,3) + &
16315 & da1(ls)*xdia(mgs,ls,3)**2 )
16317 qhacs(mgs) = min( ehs(mgs)*qhacs0(mgs), qsmxd(mgs) )
16322 & ((0.25)*pi/gf4)*ehs(mgs)*ehsclsn(mgs)*qx(mgs,ls)*cx(mgs,lh) &
16323 & *abs(vtxbar(mgs,lh,1)-vtxbar(mgs,ls,1)) &
16324 & *( gf6*gf1*xdia(mgs,ls,2) &
16325 & + 2.0*gf5*gf2*xdia(mgs,ls,1)*xdia(mgs,lh,1) &
16326 & + gf4*gf3*xdia(mgs,lh,2) ) &
16334 qhacrmlr(mgs) = 0.0
16338 IF ( temg(mgs) .gt. tfr ) raindn(mgs,lh) = 1000.0
16340 IF ( ehr(mgs) .gt. 0.0 )
THEN
16341 IF ( ipconc .ge. 3 )
THEN
16342 vt = sqrt((vtxbar(mgs,lh,1)-vtxbar(mgs,lr,1))**2 + &
16343 & 0.04*vtxbar(mgs,lh,1)*vtxbar(mgs,lr,1) )
16350 qhacr(mgs) = 0.25*pi*ehr(mgs)*cx(mgs,lh)*qx(mgs,lr)*vt* &
16351 & ( da0lh(mgs)*xdia(mgs,lh,3)**2 + &
16352 & dab1lh(mgs,lh,lr)*xdia(mgs,lh,3)*xdia(mgs,lr,3) + &
16353 & da1lr(mgs)*xdia(mgs,lr,3)**2 )
16360 qhacr(mgs) = min( qhacr(mgs), qxmxd(mgs,lr) )
16362 qhacrmlr(mgs) = qhacr(mgs)
16364 IF ( temg(mgs) > tfr .and. iehr0c == 0 )
THEN
16367 IF ( iqhacrmlr == 0 )
THEN
16368 qhacrmlr(mgs) = -qhacw(mgs)
16380 chacr(mgs) = 0.25*pi*ehr(mgs)*cx(mgs,lh)*cx(mgs,lr)*vt* &
16381 & ( da0lh(mgs)*xdia(mgs,lh,3)**2 + &
16382 & dab0lh(mgs,lh,lr)*xdia(mgs,lh,3)*xdia(mgs,lr,3) + &
16383 & da0lr(mgs)*xdia(mgs,lr,3)**2 )
16388 chacr(mgs) = min(chacr(mgs),crmxd(mgs))
16390 IF ( lzh .gt. 1 )
THEN
16391 tmp = qx(mgs,lh)/cx(mgs,lh)
16404 IF ( lwsm6 .and. ipconc == 0 )
THEN
16407 vt = vtxbar(mgs,lh,1)
16412 & ((0.25)*pi/gf4)*ehr(mgs)*qx(mgs,lr)*cx(mgs,lh) &
16413 & *abs(vt-vtxbar(mgs,lr,1)) &
16414 & *( gf6*gf1*xdia(mgs,lr,2) &
16415 & + 2.0*gf5*gf2*xdia(mgs,lr,1)*xdia(mgs,lh,1) &
16416 & + gf4*gf3*xdia(mgs,lh,2) ) &
16419 IF ( temg(mgs) > tfr )
THEN
16420 IF ( iqhacrmlr >= 1 ) qhacrmlr(mgs) = qhacr(mgs)
16425 IF ( lvol(lh) .gt. 1 .or. lhl .gt. 1 )
THEN
16427 IF ( temg(mgs) .lt. 273.15)
THEN
16428 raindn(mgs,lh) = rimc1*(-((0.5)*(1.e+06)*xdia(mgs,lr,3)) &
16430 & /(temg(mgs)-273.15))**(rimc2)
16432 raindn(mgs,lh) = min( max( rimc3, rimdn(mgs,lh) ), rimc4 )
16434 raindn(mgs,lh) = 1000.
16437 IF ( lvol(lh) > 1 ) vhacr(mgs) = rho0(mgs)*qhacr(mgs)/raindn(mgs,lh)
16444 if (ndebug .gt. 0 )
write(0,*)
'Collection: hail collects xxxxx'
16449 qhlacwmlr(mgs) = 0.0
16452 IF ( lhl > 1 .and. .true.)
THEN
16453 vtmax = (gz(igs(mgs),jgs,kgs(mgs))*dtpinv)
16454 vtxbar(mgs,lhl,1) = min( vtmax, vtxbar(mgs,lhl,1))
16455 vtxbar(mgs,lhl,2) = min( vtmax, vtxbar(mgs,lhl,2))
16456 vtxbar(mgs,lhl,3) = min( vtmax, vtxbar(mgs,lhl,3))
16459 IF ( lhl > 0 )
THEN
16460 rarx(mgs,lhl) = 0.0
16463 IF ( lhl .gt. 1 .and. ehlw(mgs) .gt. 0.0 )
THEN
16468 vt = abs(vtxbar(mgs,lhl,1)-vtxbar(mgs,lc,1))
16470 qhlacw(mgs) = 0.25*pi*ehlw(mgs)*cx(mgs,lhl)*(qx(mgs,lc)-qcwresv(mgs))*vt* &
16471 & ( da0lhl(mgs)*xdia(mgs,lhl,3)**2 + &
16472 & dab1lh(mgs,lhl,lc)*xdia(mgs,lhl,3)*xdia(mgs,lc,3) + &
16473 & da1lc(mgs)*xdia(mgs,lc,3)**2 )
16476 qhlacw(mgs) = min( qhlacw(mgs), 0.5*qx(mgs,lc)*dtpinv )
16478 qhlacwmlr(mgs) = qhlacw(mgs)
16479 IF ( temg(mgs) > tfr .and. iqhlacwshr == 0 )
THEN
16483 IF ( lvol(lhl) .gt. 1 )
THEN
16485 IF ( temg(mgs) .lt. 273.15)
THEN
16486 IF ( irimdenopt == 1 )
THEN
16487 rimdn(mgs,lhl) = rimc1*(-((0.5)*(1.e+06)*xdia(mgs,lc,1)) &
16488 & *((0.60)*( (1.0-rimdenvwgt)*vtxbar(mgs,lhl,1) + rimdenvwgt*vtxbar(mgs,lhl,2) )) &
16489 & /(temg(mgs)-273.15))**(rimc2)
16490 rimdn(mgs,lhl) = min( max( hldnmn, rimc3, rimdn(mgs,lhl) ), rimc4 )
16492 ELSEIF ( irimdenopt == 2 )
THEN
16493 tmp = -0.5*(1.e+06)*xdia(mgs,lc,1) &
16494 & *( (1.0-rimdenvwgt)*vtxbar(mgs,lhl,1) + rimdenvwgt*vtxbar(mgs,lhl,2) ) &
16495 & /(temg(mgs)-273.15)
16496 tmp = min( 5.5/0.6, max( 0.3/0.6, tmp ) )
16498 rimdn(mgs,lhl) = 1000.*(0.051 + 0.114*tmp - 0.005*tmp**2)
16500 ELSEIF ( irimdenopt == 3 .or. irimdenopt == 4)
THEN
16501 tmp = -0.5*(1.e+06)*xdia(mgs,lc,1) &
16502 & *( (1.0-rimdenvwgt)*vtxbar(mgs,lhl,1) + rimdenvwgt*vtxbar(mgs,lhl,2) ) &
16503 & /(temg(mgs)-273.15)
16506 IF ( irimdenopt == 3 )
THEN
16507 rimdn(mgs,lhl) = min(900., max( 170., 110.*tmp**0.76 ) )
16508 ELSEIF ( irimdenopt == 4 )
THEN
16509 rimdn(mgs,lhl) = min(917., max( 10., 900.0*(1.0 - 0.905**tmp ) ) )
16514 rimdn(mgs,lhl) = 1000.
16517 vhlacw(mgs) = rho0(mgs)*qhlacw(mgs)/rimdn(mgs,lhl)
16522 IF ( qx(mgs,lhl) .gt. qxmin(lhl) .and. ipelec .ge. 1 )
THEN
16524 & qhlacw(mgs)*1.0e3*rho0(mgs)/((pi/2.0)*xdia(mgs,lhl,2)*cx(mgs,lhl))
16532 IF ( lhl .gt. 1 )
THEN
16534 IF ( ehli(mgs) .gt. 0.0 )
THEN
16535 IF ( ipconc .ge. 5 )
THEN
16537 vt = sqrt((vtxbar(mgs,lhl,1)-vtxbar(mgs,li,1))**2 + &
16538 & 0.04*vtxbar(mgs,lhl,1)*vtxbar(mgs,li,1) )
16540 qhlaci0(mgs) = 0.25*pi*ehliclsn(mgs)*cx(mgs,lhl)*qx(mgs,li)*vt* &
16541 & ( da0lhl(mgs)*xdia(mgs,lhl,3)**2 + &
16542 & dab1lh(mgs,lhl,li)*xdia(mgs,lhl,3)*xdia(mgs,li,3) + &
16543 & da1(li)*xdia(mgs,li,3)**2 )
16545 qhlaci(mgs) = min( ehli(mgs)*qhlaci0(mgs), qimxd(mgs) )
16553 IF ( lhl .gt. 1 )
THEN
16555 IF ( ehls(mgs) .gt. 0.0)
THEN
16556 IF ( ipconc .ge. 5 )
THEN
16558 vt = sqrt((vtxbar(mgs,lhl,1)-vtxbar(mgs,ls,1))**2 + &
16559 & 0.04*vtxbar(mgs,lhl,1)*vtxbar(mgs,ls,1) )
16561 qhlacs0(mgs) = 0.25*pi*ehlsclsn(mgs)*cx(mgs,lhl)*qx(mgs,ls)*vt* &
16562 & ( da0lhl(mgs)*xdia(mgs,lhl,3)**2 + &
16563 & dab1lh(mgs,lhl,ls)*xdia(mgs,lhl,3)*xdia(mgs,ls,3) + &
16564 & da1(ls)*xdia(mgs,ls,3)**2 )
16566 qhlacs(mgs) = min( ehls(mgs)*qhlacs0(mgs), qsmxd(mgs) )
16575 qhlacrmlr(mgs) = 0.0
16578 IF ( lhl .gt. 1 .and. temg(mgs) .gt. tfr ) raindn(mgs,lhl) = 1000.0
16580 IF ( lhl .gt. 1 .and. ehlr(mgs) .gt. 0.0 )
THEN
16581 IF ( ipconc .ge. 3 )
THEN
16582 vt = sqrt((vtxbar(mgs,lhl,1)-vtxbar(mgs,lr,1))**2 + &
16583 & 0.04*vtxbar(mgs,lhl,1)*vtxbar(mgs,lr,1) )
16585 qhlacr(mgs) = 0.25*pi*ehlr(mgs)*cx(mgs,lhl)*qx(mgs,lr)*vt* &
16586 & ( da0lhl(mgs)*xdia(mgs,lhl,3)**2 + &
16587 & dab1lh(mgs,lhl,lr)*xdia(mgs,lhl,3)*xdia(mgs,lr,3) + &
16588 & da1lr(mgs)*xdia(mgs,lr,3)**2 )
16595 qhlacr(mgs) = min( qhlacr(mgs), qxmxd(mgs,lr) )
16598 IF ( iqhlacrmlr >= 1 ) qhlacrmlr(mgs) = qhlacr(mgs)
16600 IF ( temg(mgs) > tfr .and. iehlr0c == 0)
THEN
16602 IF ( iqhlacrmlr == 0 )
THEN
16603 qhlacrmlr(mgs) = -qhlacw(mgs)
16606 chlacr(mgs) = 0.25*pi*ehlr(mgs)*cx(mgs,lhl)*cx(mgs,lr)*vt* &
16607 & ( da0lhl(mgs)*xdia(mgs,lhl,3)**2 + &
16608 & dab0lh(mgs,lhl,lr)*xdia(mgs,lhl,3)*xdia(mgs,lr,3) + &
16609 & da0lr(mgs)*xdia(mgs,lr,3)**2 )
16611 chlacr(mgs) = min(chlacr(mgs),crmxd(mgs))
16613 IF ( lvol(lhl) .gt. 1 )
THEN
16614 vhlacr(mgs) = rho0(mgs)*qhlacr(mgs)/raindn(mgs,lhl)
16629 if (ndebug .gt. 0 )
write(0,*)
'Collection: cloud ice collects xxxx2'
16633 IF ( eiw(mgs) .gt. 0.0 )
THEN
16635 vt = sqrt((vtxbar(mgs,li,1)-vtxbar(mgs,lc,1))**2 + &
16636 & 0.04*vtxbar(mgs,li,1)*vtxbar(mgs,lc,1) )
16638 qiacw(mgs) = 0.25*pi*eiw(mgs)*cx(mgs,li)*qx(mgs,lc)*vt* &
16639 & ( da0(li)*xdia(mgs,li,3)**2 + &
16640 & dab1(li,lc)*xdia(mgs,li,3)*xdia(mgs,lc,3) + &
16641 & da1lc(mgs)*xdia(mgs,lc,3)**2 )
16643 qiacw(mgs) = min( qiacw(mgs), qxmxd(mgs,lc) )
16650 if (ndebug .gt. 0 )
write(0,*)
'Collection: cloud ice collects xxxx8'
16660 csplinter(mgs) = 0.0
16661 qsplinter(mgs) = 0.0
16662 csplinter2(mgs) = 0.0
16663 qsplinter2(mgs) = 0.0
16664 IF ( iacr .ge. 1 .and. eri(mgs) .gt. 0.0 &
16665 & .and. temg(mgs) .le. 270.15 )
THEN
16666 IF ( ipconc .ge. 3 )
THEN
16668 IF ( xdia(mgs,li,1) .ge. 10.e-6 )
THEN
16669 ni = ni + cx(mgs,li)*exp(- (40.e-6/xdia(mgs,li,1))**3 )
16671 IF ( imurain == 1 )
THEN
16672 IF ( iacrsize /= 4 )
THEN
16673 IF ( iacrsize .eq. 1 )
THEN
16674 ratio = 500.e-6/xdia(mgs,lr,1)
16675 ELSEIF ( iacrsize .eq. 2 )
THEN
16676 ratio = 300.e-6/xdia(mgs,lr,1)
16677 ELSEIF ( iacrsize .eq. 3 )
THEN
16678 ratio = 40.e-6/xdia(mgs,lr,1)
16679 ELSEIF ( iacrsize .eq. 5 )
THEN
16680 ratio = 150.e-6/xdia(mgs,lr,1)
16682 i = min(nqiacrratio,int(ratio*dqiacrratioinv))
16683 j = int(max(0.0,min(15.,alpha(mgs,lr)))*dqiacralphainv)
16685 delx = ratio - float(i)*dqiacrratio
16686 dely = alpha(mgs,lr) - float(j)*dqiacralpha
16687 ip1 = min( i+1, nqiacrratio )
16688 jp1 = min( j+1, nqiacralpha )
16691 tmp1 = ciacrratio(i,j) + delx*dqiacrratioinv*(ciacrratio(ip1,j) - ciacrratio(i,j))
16692 tmp2 = ciacrratio(i,jp1) + delx*dqiacrratioinv*(ciacrratio(ip1,jp1) - ciacrratio(i,jp1))
16696 nr = (tmp1 + dely*dqiacralphainv*(tmp2 - tmp1))*cx(mgs,lr)
16699 tmp1 = qiacrratio(i,j) + delx*dqiacrratioinv*(qiacrratio(ip1,j) - qiacrratio(i,j))
16700 tmp2 = qiacrratio(i,jp1) + delx*dqiacrratioinv*(qiacrratio(ip1,jp1) - qiacrratio(i,jp1))
16704 qr = (tmp1 + dely*dqiacralphainv*(tmp2 - tmp1))*qx(mgs,lr)
16711 vt = sqrt((vtxbar(mgs,lr,1)-vtxbar(mgs,li,1))**2 + &
16712 & 0.04*vtxbar(mgs,lr,1)*vtxbar(mgs,li,1) )
16714 qiacr(mgs) = 0.25*pi*eri(mgs)*ni*qr*vt* &
16715 & ( da0(li)*xdia(mgs,li,3)**2 + &
16716 & dab1lh(mgs,li,lr)*xdia(mgs,lh,3)*xdia(mgs,li,3) + &
16717 & da1(lr)*xdia(mgs,lr,3)**2 )
16719 qiacr(mgs) = min( qrmxd(mgs), qiacr(mgs) )
16722 ciacr(mgs) = 0.25*pi*eri(mgs)*ni*nr*vt* &
16723 & ( da0(li)*xdia(mgs,li,3)**2 + &
16724 & dab0lh(mgs,li,lr)*xdia(mgs,lr,3)*xdia(mgs,li,3) + &
16725 & da0(lr)*xdia(mgs,lr,3)**2 )
16727 ciacr(mgs) = min( crmxd(mgs), ciacr(mgs) )
16734 ELSEIF ( imurain == 3 )
THEN
16736 arg = 1000.*xdia(mgs,lr,3)
16739 IF ( ipconc .ge. 3 )
THEN
16740 IF ( iacrsize .eq. 1 )
THEN
16742 ELSEIF ( iacrsize .eq. 2 .or. iacrsize .eq. 5 )
THEN
16744 ELSEIF ( iacrsize .eq. 3 )
THEN
16745 nr = cx(mgs,lr)*
gaml02( arg )
16746 ELSEIF ( iacrsize .eq. 4 )
THEN
16750 nr = cx(mgs,lr)*
gaml02( arg )
16755 IF ( ni .gt. 0.0 .and. nr .gt. 0.0 )
THEN
16756 d0 = xdia(mgs,lr,3)
16757 qiacr(mgs) = xdn(mgs,lr)*rhoinv(mgs)* &
16758 & (0.217239*(0.522295*(d0**5) + &
16759 & 49711.81*(d0**6) - &
16760 & 1.673016e7*(d0**7)+ &
16761 & 2.404471e9*(d0**8) - &
16762 & 1.22872e11*(d0**9))*ni*nr)
16763 qiacr(mgs) = min( qrmxd(mgs), qiacr(mgs) )
16765 & (0.217239*(0.2301947*(d0**2) + &
16766 & 15823.76*(d0**3) - &
16767 & 4.167685e6*(d0**4) + &
16768 & 4.920215e8*(d0**5) - &
16769 & 2.133344e10*(d0**6))*ni*nr)
16770 ciacr(mgs) = min( crmxd(mgs), ciacr(mgs) )
16774 IF ( iacr .eq. 1 .or. iacr .eq. 3 )
THEN
16775 ciacrf(mgs) = min(ciacr(mgs), qiacr(mgs)/(1.0*vr1mm*1000.0)*rho0(mgs) )
16776 ELSEIF ( iacr .eq. 2 )
THEN
16777 ciacrf(mgs) = ciacr(mgs)
16778 ELSEIF ( iacr .eq. 4 )
THEN
16779 ciacrf(mgs) = min(ciacr(mgs), qiacr(mgs)/(1.0*vfrz*1000.0)*rho0(mgs) )
16780 ELSEIF ( iacr .eq. 5 )
THEN
16781 ciacrf(mgs) = ciacr(mgs)*rzxh(mgs)
16790 & ((0.25/gf4)*pi)*eri(mgs)*cx(mgs,li)*qx(mgs,lr) &
16791 & *abs(vtxbar(mgs,lr,1)-vtxbar(mgs,li,1)) &
16792 & *( gf6*gf1*xdia(mgs,lr,2) &
16793 & + 2.0*gf5*gf2*xdia(mgs,lr,1)*xdia(mgs,li,1) &
16794 & + gf4*gf3*xdia(mgs,li,2) ) &
16802 IF ( ipconc .ge. 1 )
THEN
16803 IF ( nsplinter .ge. 1000 )
THEN
16806 IF ( qiacr(mgs)*dtp > qxmin(lh) .and. ciacr(mgs) > 1.e-3 )
THEN
16807 tmpdiam = 1.e6*( 6.*qiacr(mgs)/(1000.*pi*ciacr(mgs) ) )**(1./3.)
16808 csplinter(mgs) = lawson_splinter_fac*tmpdiam**4*ciacr(mgs)
16810 ELSEIF ( nsplinter .ge. 0 )
THEN
16811 csplinter(mgs) = nsplinter*ciacr(mgs)
16813 csplinter(mgs) = -nsplinter*ciacrf(mgs)
16815 qsplinter(mgs) = min(0.1*qiacr(mgs), csplinter(mgs)*splintermass/rho0(mgs) )
16819 IF ( ibiggsnow == 2 .or. ibiggsnow == 3 )
THEN
16820 IF ( ciacr(mgs) > qxmin(lh) )
THEN
16821 xvfrz = rho0(mgs)*qiacr(mgs)/(ciacr(mgs)*900.)
16822 frach = 0.5 *(1. + tanh(0.2e12 *( xvfrz - 1.15*xvbiggsnow)))
16824 qiacrs(mgs) = (1.-frach)*qiacr(mgs)
16825 ciacrs(mgs) = (1.-frach)*ciacrf(mgs)
16830 qiacrf(mgs) = frach*qiacr(mgs)
16831 ciacrf(mgs) = frach*ciacrf(mgs)
16833 IF ( lvol(lh) > 1 )
THEN
16834 viacrf(mgs) = rho0(mgs)*qiacrf(mgs)/rhofrz
16844 if ( ipconc .ge. 4 )
then
16847 IF ( qx(mgs,ls) > qxmin(ls) .and. ess(mgs) .gt. 0.0 )
THEN
16849 IF ( iessec0flag == 0 )
THEN
16852 tmp = xv(mgs,ls)/(xvmx(ls)*max(1.,100./min(100.,xdn(mgs,ls))))
16853 IF ( tmp .lt. essfrac1 )
THEN
16855 ELSEIF ( tmp .ge. essfrac2 )
THEN
16858 ec0(mgs) = (essfrac2 - tmp)/(essfrac2 - essfrac1)
16862 csacs(mgs) = ec0(mgs)*rvt*aa2*ess(mgs)*cx(mgs,ls)**2*min( xv(mgs,ls), 4.*pii/3.*essrmax**3 )
16864 csacs(mgs) = min(csacs(mgs),csmxd(mgs))
16870 if (ndebug .gt. 0 )
write(0,*)
'ICEZVD_GS: conc 11'
16871 if ( ipconc .ge. 2 .or. ipelec .ge. 9 )
then
16874 IF ( eiw(mgs) .gt. 0.0 )
THEN
16875 ciacw(mgs) = qiacw(mgs)*rho0(mgs)/xmas(mgs,lc)
16876 ciacw(mgs) = min(ciacw(mgs),ccmxd(mgs))
16882 if (ndebug .gt. 0 )
write(0,*)
'ICEZVD_GS: conc 18'
16883 if ( ipconc .ge. 2 .or. ipelec .ge. 1 )
then
16888 IF ( qx(mgs,lc) .gt. qxmin(lc) .and. qx(mgs,lr) .gt. qxmin(lr) &
16889 & .and. qracw(mgs) .gt. 0.0 )
THEN
16891 IF ( ipconc .lt. 3 )
THEN
16892 IF ( erw(mgs) .gt. 0.0 )
THEN
16894 & ((0.25)*pi)*erw(mgs)*(cx(mgs,lc) - ccwresv(mgs))*cx(mgs,lr) &
16895 & *abs(vtxbar(mgs,lr,1)-vtxbar(mgs,lc,1)) &
16896 & *( gf1*xdia(mgs,lc,2) &
16897 & + 2.0*gf2*xdia(mgs,lc,1)*xdia(mgs,lr,1) &
16898 & + gf3*xdia(mgs,lr,2) )
16901 IF ( dmrauto <= 0 .or. rho0(mgs)*qx(mgs,lr) > 1.2*xl2p(mgs) )
THEN
16902 IF ( 0.5*xdia(mgs,lr,3) .gt. rh(mgs) )
THEN
16904 IF ( 0.5*xdia(mgs,lr,3) .gt. rwradmn )
THEN
16907 cracw(mgs) = aa2*cx(mgs,lr)*(cx(mgs,lc) - ccwresv(mgs))*(xv(mgs,lc) + xv(mgs,lr))
16909 IF ( imurain == 3 )
THEN
16911 cracw(mgs) = aa1*cx(mgs,lr)*(cx(mgs,lc) - ccwresv(mgs))* &
16912 & ((alpha(mgs,lc) + 2.)*xv(mgs,lc)**2/(alpha(mgs,lc) + 1.) + &
16913 & (alpha(mgs,lr) + 2.)*xv(mgs,lr)**2/(alpha(mgs,lr) + 1.))
16915 cracw(mgs) = aa1*cx(mgs,lr)*(cx(mgs,lc) - ccwresv(mgs))* &
16916 & ((alpha(mgs,lc) + 2.)*xv(mgs,lc)**2/(alpha(mgs,lc) + 1.) + &
16917 & (alpha(mgs,lr) + 6.)*(alpha(mgs,lr) + 5.)*(alpha(mgs,lr) + 4.)*xv(mgs,lr)**2/ &
16918 & ((alpha(mgs,lr) + 3.)*(alpha(mgs,lr) + 2.)*(alpha(mgs,lr) + 1.)) )
16930 IF ( qx(mgs,lr) .gt. qxmin(lr) )
THEN
16931 rwrad = 0.5*xdia(mgs,lr,3)
16935 IF ( icracrthresh > 1 )
THEN
16936 IF ( imurain == 1 )
THEN
16937 tmp = (3.67+alpha(mgs,lr))*xdia(mgs,lr,1)
16939 tmp = (1.678+alpha(mgs,lr))**(1./3.)*xdia(mgs,lr,1)
16942 tmp = xdia(mgs,lr,3) - 0.1e-3
16946 IF ( tmp .gt. 1.9e-3 .or. icracr <= 0 )
THEN
16950 IF ( dmrauto <= 0 .or. rho0(mgs)*qx(mgs,lr) > 1.2*xl2p(mgs) )
THEN
16951 IF ( xdia(mgs,lr,3) .lt. 6.1e-4 )
THEN
16954 ec0(mgs) = exp(-50.0*(50.0*(xdia(mgs,lr,3) - 6.0e-4)))
16958 IF ( rwrad .ge. 50.e-6 )
THEN
16959 cracr(mgs) = ec0(mgs)*aa2*cx(mgs,lr)**2*xv(mgs,lr)
16961 IF ( imurain == 3 )
THEN
16962 cracr(mgs) = ec0(mgs)*aa1*(cx(mgs,lr)*xv(mgs,lr))**2* &
16963 & (alpha(mgs,lr) + 2.)/(alpha(mgs,lr) + 1.)
16965 cracr(mgs) = ec0(mgs)*aa1*(cx(mgs,lr)*xv(mgs,lr))**2* &
16966 & (alpha(mgs,lr) + 6.)*(alpha(mgs,lr) + 5.)*(alpha(mgs,lr) + 4.)/ &
16967 & ((alpha(mgs,lr) + 3.)*(alpha(mgs,lr) + 2.)*(alpha(mgs,lr) + 1.))
16985 if (ndebug .gt. 0 )
write(0,*)
'ICEZVD_GS: conc 22ii'
16987 if ( ipconc .ge. 1 .or. ipelec .ge. 1 )
then
16990 IF ( ipconc .ge. 5 )
THEN
16991 IF ( qhacw(mgs) .gt. 0.0 .and. xmas(mgs,lc) .gt. 0.0 )
THEN
17005 chacw(mgs) = qhacw(mgs)*rho0(mgs)/xmascw(mgs)
17007 chacw(mgs) = min( chacw(mgs), 0.5*(cx(mgs,lc) - ccwresv(mgs))*dtpinv )
17014 & ((0.25)*pi)*ehw(mgs)*cx(mgs,lc)*cx(mgs,lh) &
17015 & *abs(vtxbar(mgs,lh,1)-vtxbar(mgs,lc,1)) &
17016 & *( gf1*xdia(mgs,lc,2) &
17017 & + 2.0*gf2*xdia(mgs,lc,1)*xdia(mgs,lh,1) &
17018 & + gf3*xdia(mgs,lh,2) )
17019 chacw(mgs) = min(chacw(mgs),0.5*cx(mgs,lc)*dtpinv)
17026 if (ndebug .gt. 0 )
write(0,*)
'ICEZVD_GS: conc 22kk'
17029 if ( ipconc .ge. 1 .or. ipelec .ge. 1 )
then
17031 IF ( ehi(mgs) .gt. 0.0 .or. ( ehiclsn(mgs) > 0.0 .and. ipelec > 0 ))
THEN
17032 IF ( ipconc .ge. 5 )
THEN
17034 vt = sqrt((vtxbar(mgs,lh,1)-vtxbar(mgs,li,1))**2 + &
17035 & 0.04*vtxbar(mgs,lh,1)*vtxbar(mgs,li,1) )
17037 chaci0(mgs) = 0.25*pi*ehiclsn(mgs)*cx(mgs,lh)*cx(mgs,li)*vt* &
17038 & ( da0lh(mgs)*xdia(mgs,lh,3)**2 + &
17039 & dab0lh(mgs,lh,li)*xdia(mgs,lh,3)*xdia(mgs,li,3) + &
17040 & da0(li)*xdia(mgs,li,3)**2 )
17044 & ((0.25)*pi)*ehiclsn(mgs)*cx(mgs,li)*cx(mgs,lh) &
17045 & *abs(vtxbar(mgs,lh,1)-vtxbar(mgs,li,1)) &
17046 & *( gf1*xdia(mgs,li,2) &
17047 & + 2.0*gf2*xdia(mgs,li,1)*xdia(mgs,lh,1) &
17048 & + gf3*xdia(mgs,lh,2) )
17051 chaci(mgs) = min(ehi(mgs)*chaci0(mgs),cimxd(mgs))
17058 if ( lis > 1 .and. ipconc .ge. 5 .or. ipelec .ge. 1 )
then
17060 IF ( ehis(mgs) .gt. 0.0 .or. ( ehisclsn(mgs) > 0.0 .and. ipelec > 0 ))
THEN
17062 vt = sqrt((vtxbar(mgs,lh,1)-vtxbar(mgs,lis,1))**2 + &
17063 & 0.04*vtxbar(mgs,lh,1)*vtxbar(mgs,lis,1) )
17065 chacis0(mgs) = 0.25*pi*ehisclsn(mgs)*cx(mgs,lh)*cx(mgs,lis)*vt* &
17066 & ( da0lh(mgs)*xdia(mgs,lh,3)**2 + &
17067 & dab0lh(mgs,lh,lis)*xdia(mgs,lh,3)*xdia(mgs,lis,3) + &
17068 & da0(lis)*xdia(mgs,lis,3)**2 )
17071 chacis(mgs) = min(ehis(mgs)*chacis0(mgs),cxmxd(mgs,lis))
17077 if (ndebug .gt. 0 )
write(0,*)
'ICEZVD_GS: conc 22nn'
17080 if ( ipconc .ge. 1 .or. ipelec .ge. 1 )
then
17082 IF ( ehs(mgs) .gt. 0 )
THEN
17083 IF ( ipconc .ge. 5 .or. ( ehsclsn(mgs) > 0.0 .and. ipelec > 0 ) )
THEN
17085 vt = sqrt((vtxbar(mgs,lh,1)-vtxbar(mgs,ls,1))**2 + &
17086 & 0.04*vtxbar(mgs,lh,1)*vtxbar(mgs,ls,1) )
17088 chacs0(mgs) = 0.25*pi*ehsclsn(mgs)*cx(mgs,lh)*cx(mgs,ls)*vt* &
17089 & ( da0lh(mgs)*xdia(mgs,lh,3)**2 + &
17090 & dab0lh(mgs,lh,ls)*xdia(mgs,lh,3)*xdia(mgs,ls,3) + &
17091 & da0(ls)*xdia(mgs,ls,3)**2 )
17095 & ((0.25)*pi)*ehsclsn(mgs)*cx(mgs,ls)*cx(mgs,lh) &
17096 & *abs(vtxbar(mgs,lh,1)-vtxbar(mgs,ls,1)) &
17097 & *( gf3*gf1*xdia(mgs,ls,2) &
17098 & + 2.0*gf2*gf2*xdia(mgs,ls,1)*xdia(mgs,lh,1) &
17099 & + gf1*gf3*xdia(mgs,lh,2) )
17101 chacs(mgs) = min(ehs(mgs)*chacs0(mgs),csmxd(mgs))
17111 if (ndebug .gt. 0 )
write(0,*)
'ICEZVD_GS: conc 22ii'
17113 if ( ipconc .ge. 1 .or. ipelec .ge. 1 )
then
17116 IF ( lhl .gt. 1 .and. ipconc .ge. 5 )
THEN
17117 IF ( qhlacw(mgs) .gt. 0.0 .and. xmas(mgs,lc) .gt. 0.0 )
THEN
17131 chlacw(mgs) = qhlacw(mgs)*rho0(mgs)/xmascw(mgs)
17133 chlacw(mgs) = min( chlacw(mgs), 0.5*cx(mgs,lc)*dtpinv )
17151 if (ndebug .gt. 0 )
write(0,*)
'ICEZVD_GS: conc 22kk'
17154 if ( ipconc .ge. 1 .or. ipelec .ge. 1 )
then
17156 IF ( lhl .gt. 1 .and. ( ehli(mgs) .gt. 0.0 .or. (ipelec > 0 .and. ehliclsn(mgs) > 0.0) ) )
THEN
17157 IF ( ipconc .ge. 5 )
THEN
17159 vt = sqrt((vtxbar(mgs,lhl,1)-vtxbar(mgs,li,1))**2 + &
17160 & 0.04*vtxbar(mgs,lhl,1)*vtxbar(mgs,li,1) )
17162 chlaci0(mgs) = 0.25*pi*ehliclsn(mgs)*cx(mgs,lhl)*cx(mgs,li)*vt* &
17163 & ( da0lhl(mgs)*xdia(mgs,lhl,3)**2 + &
17164 & dab0(lhl,li)*xdia(mgs,lhl,3)*xdia(mgs,li,3) + &
17165 & da0(li)*xdia(mgs,li,3)**2 )
17176 chlaci(mgs) = min(ehli(mgs)*chlaci0(mgs),cimxd(mgs))
17182 IF ( lis > 1 .and. ipconc .ge. 5)
THEN
17184 if (ndebug .gt. 0 )
write(0,*)
'ICEZVD_GS: conc 22kk'
17188 IF ( lhl .gt. 1 .and. ( ehlis(mgs) .gt. 0.0 .or. (ipelec > 0 .and. ehlisclsn(mgs) > 0.0) ) )
THEN
17190 vt = sqrt((vtxbar(mgs,lhl,1)-vtxbar(mgs,lis,1))**2 + &
17191 & 0.04*vtxbar(mgs,lhl,1)*vtxbar(mgs,lis,1) )
17193 chlacis0(mgs) = 0.25*pi*ehlisclsn(mgs)*cx(mgs,lhl)*cx(mgs,lis)*vt* &
17194 & ( da0lhl(mgs)*xdia(mgs,lhl,3)**2 + &
17195 & dab0(lhl,lis)*xdia(mgs,lhl,3)*xdia(mgs,lis,3) + &
17196 & da0(lis)*xdia(mgs,lis,3)**2 )
17199 chlacis(mgs) = min(ehlis(mgs)*chlacis0(mgs),cxmxd(mgs,lis))
17206 if (ndebug .gt. 0 )
write(0,*)
'ICEZVD_GS: conc 22jj'
17209 if ( ipconc .ge. 1 .or. ipelec .ge. 1 )
then
17211 IF ( lhl .gt. 1 .and. ( ehls(mgs) .gt. 0.0 .or. (ipelec > 0 .and. ehlsclsn(mgs) > 0.0) ) )
THEN
17212 IF ( ipconc .ge. 5 )
THEN
17214 vt = sqrt((vtxbar(mgs,lhl,1)-vtxbar(mgs,ls,1))**2 + &
17215 & 0.04*vtxbar(mgs,lhl,1)*vtxbar(mgs,ls,1) )
17217 chlacs0(mgs) = 0.25*pi*ehlsclsn(mgs)*cx(mgs,lhl)*cx(mgs,ls)*vt* &
17218 & ( da0lhl(mgs)*xdia(mgs,lhl,3)**2 + &
17219 & dab0(lhl,ls)*xdia(mgs,lhl,3)*xdia(mgs,ls,3) + &
17220 & da0(ls)*xdia(mgs,ls,3)**2 )
17230 chlacs(mgs) = min(ehls(mgs)*chlacs0(mgs),csmxd(mgs))
17239 IF ( ipconc .ge. 2 )
THEN
17240 if (ndebug .gt. 0 )
write(0,*)
'conc 26a'
17249 IF ( dmrauto >= -1 )
THEN
17253 IF ( qx(mgs,lc) .gt. qxmin(lc) .and. cx(mgs,lc) .gt. 1000. .and. temg(mgs) .gt. tfrh+4.)
THEN
17255 volb = xv(mgs,lc)*(1./(1.+alpha(mgs,lc)))**(1./2.)
17256 cautn(mgs) = min(ccmxd(mgs), &
17257 & ((alpha(mgs,lc)+2.)/(alpha(mgs,lc)+1.))*aa1*cx(mgs,lc)**2*xv(mgs,lc)**2)
17258 cautn(mgs) = max( 0.0d0, cautn(mgs) )
17259 IF ( rb(mgs) .le. 7.51d-6 .or. dmrauto == -1)
THEN
17268 t2s = 3.72/(1.e6*(rb(mgs)-7.500d-6)*rho0(mgs)*qx(mgs,lc))
17270 qrcnw(mgs) = max( 0.0d0, xl2p(mgs)/(t2s*rho0(mgs)) )
17271 crcnw(mgs) = max( 0.0d0, min(3.5e9*xl2p(mgs)/t2s,0.5*cautn(mgs)) )
17273 IF ( dmrauto == 0 )
THEN
17274 IF ( qx(mgs,lr)*rho0(mgs) > 1.2*xl2p(mgs) .and. cx(mgs,lr) > cxmin )
THEN
17275 crcnw(mgs) = cx(mgs,lr)/qx(mgs,lr)*qrcnw(mgs)
17276 ELSEIF ( ( dmropt == 1 .or. dmropt == 3 ) .and. qx(mgs,lr) > qxmin(lr) )
THEN
17277 tmp = qrcnw(mgs)*cx(mgs,lr)/qx(mgs,lr)
17278 crcnw(mgs) = min(tmp,crcnw(mgs) )
17279 ELSEIF ( ( dmropt == 4 ) .and. qx(mgs,lr) > qxmin(lr) )
THEN
17281 tmp2 = qrcnw(mgs)*cx(mgs,lr)/qx(mgs,lr)
17283 crcnw(mgs) = (tmp*qrcnw(mgs)+tmp2*qx(mgs,lr))/(qrcnw(mgs)+qx(mgs,lr))
17284 ELSEIF ( ( dmropt == 5 ) .and. qx(mgs,lr) > qxmin(lr) )
THEN
17286 tmp2 = qrcnw(mgs)*cx(mgs,lr)/qx(mgs,lr)
17288 crcnw(mgs) = (tmp*qx(mgs,lc)+tmp2*qx(mgs,lr))/(qx(mgs,lc)+qx(mgs,lr))
17289 ELSEIF ( ( dmropt == 6 ) .and. qx(mgs,lr) > qxmin(lr) )
THEN
17291 tmp2 = qrcnw(mgs)*cx(mgs,lr)/qx(mgs,lr)
17293 crcnw(mgs) = (tmp*xdia(mgs,lc,3)*qx(mgs,lc)+tmp2*xdia(mgs,lr,3)*qx(mgs,lr))/(xdia(mgs,lc,3)*qx(mgs,lc)+xdia(mgs,lr,3)*qx(mgs,lr))
17294 ELSEIF ( ( dmropt == 7 ) .and. qx(mgs,lr) > qxmin(lr) )
THEN
17296 tmp2 = qrcnw(mgs)*cx(mgs,lr)/qx(mgs,lr)
17298 crcnw(mgs) = (tmp*xdia(mgs,lc,3)+tmp2*xdia(mgs,lr,3))/(xdia(mgs,lc,3)+xdia(mgs,lr,3))
17299 ELSEIF ( ( dmropt == 8 ) .and. qx(mgs,lr) > qxmin(lr) )
THEN
17301 tmp2 = qrcnw(mgs)*cx(mgs,lr)/qx(mgs,lr)
17303 crcnw(mgs) = (tmp*sqrt(xdia(mgs,lc,3))+tmp2*sqrt(xdia(mgs,lr,3)))/(sqrt(xdia(mgs,lc,3))+sqrt(xdia(mgs,lr,3)))
17305 ELSEIF ( dmrauto == 1 .and. cx(mgs,lr) > cxmin)
THEN
17306 IF ( qx(mgs,lr) > qxmin(lr) )
THEN
17307 tmp = qrcnw(mgs)*cx(mgs,lr)/qx(mgs,lr)
17308 crcnw(mgs) = min(tmp,crcnw(mgs) )
17310 ELSEIF ( dmrauto == 2 .and. cx(mgs,lr) > cxmin)
THEN
17312 tmp2 = qrcnw(mgs)*cx(mgs,lr)/qx(mgs,lr)
17314 crcnw(mgs) = (tmp*qrcnw(mgs)+tmp2*qx(mgs,lr))/(qrcnw(mgs)+qx(mgs,lr))
17315 ELSEIF ( dmrauto == 3 .and. cx(mgs,lr) > cxmin)
THEN
17316 tmp = max( 2.d0*rh(mgs), dble( xdia(mgs,lr,3) ) )
17317 crcnw(mgs) = rho0(mgs)*qrcnw(mgs)/(pi/6.*1000.*tmp**3)
17320 IF ( crcnw(mgs) < 1.e-30 ) qrcnw(mgs) = 0.0
17322 IF ( ipconc >= 6 )
THEN
17323 IF ( lzr > 1 .and. qrcnw(mgs) > 0.0 )
THEN
17329 IF (qx(mgs,lr) .gt. qxmin(lr) .and. ( dmrauto == 1 .or. dmrauto ==2 ) )
THEN
17330 tmp3 = qx(mgs,lr)/cx(mgs,lr)
17331 tmp4 = g1x(mgs,lr)*(6.*rho0(mgs)/(pi*xdn(mgs,lr)))**2* &
17332 & ( 2.*tmp3 * qrcnw(mgs) - tmp3**2 * crcnw(mgs) )
17333 if (imurain == 3)
then
17334 vr = rho0(mgs)*qrcnw(mgs)/(1000.)
17335 tmp3 = 36.*(xnu(lc)+2.0)*vr**2/(crcnw(mgs)*(xnu(lc)+1.0)*pi**2)
17337 tmp3 = galpharaut*(6.*rho0(mgs)*qrcnw(mgs)/(pi*xdn0(lr)))**2/crcnw(mgs)
17339 IF ( dmrauto == 1 )
THEN
17341 ELSEIF ( dmrauto == 2 )
THEN
17342 zrcnw(mgs) = (tmp3*qrcnw(mgs)+tmp4*qx(mgs,lr))/(qrcnw(mgs)+qx(mgs,lr))
17345 IF ( imurain == 3 )
THEN
17346 vr = rho0(mgs)*qrcnw(mgs)/(1000.)
17347 zrcnw(mgs) = 36.*(xnu(lc)+2.0)*vr**2/(crcnw(mgs)*(xnu(lc)+1.0)*pi**2)
17349 IF ( dmropt <= 1 .or. dmropt >= 4 .or. ( qx(mgs,lr) < qxmin(lr) .and. cx(mgs,lr) < cxmin ) )
THEN
17350 zrcnw(mgs) = galpharaut*(6.*rho0(mgs)*qrcnw(mgs)/(pi*xdn0(lr)))**2/crcnw(mgs)
17352 tmp3 = qx(mgs,lr)/cx(mgs,lr)
17353 zrcnw(mgs) = g1x(mgs,lr)*(6.*rho0(mgs)/(pi*xdn(mgs,lr)))**2* &
17354 & ( 2.*tmp3 * qrcnw(mgs) - tmp3**2 * crcnw(mgs) )
17403 if ( ircnw .eq. 4 )
then
17407 qdiff = max((qx(mgs,lc)-qminrncw),0.0)
17408 if ( qdiff .gt. 0.0 .and. xdia(mgs,lc,1) .gt. 20.0e-6 )
then
17410 & ((1.2e-4)+(1.596e-12)*(cx(mgs,lc)*1.0e-6) &
17411 & /(cwdisp*qdiff*1.0e-3*rho0(mgs)))
17412 qrcnw(mgs) = (rho0(mgs)*1e-3)*(qdiff**2)/argrcnw
17414 qrcnw(mgs) = (max(qrcnw(mgs),0.0))
17425 if ( ircnw .eq. 5 )
then
17429 qccrit = (pi/6.)*(cx(mgs,lc)*cwdiap**3)*xdn(mgs,lc)/rho0(mgs)
17430 qdiff = max((qx(mgs,lc)-qccrit),0.)
17431 if ( qdiff .gt. 0.0 .and. cx(mgs,lc) .gt. 1.0 )
then
17434 & ((1.2e-4)+(1.596e-12)*cx(mgs,lc)*1.0e-3/(cwdisp*rho0(mgs)*qdiff))
17437 & 1.0e-3*rho0(mgs)*(qdiff**2)/argrcnw
17438 qrcnw(mgs) = min(qxmxd(mgs,lc), (max(qrcnw(mgs),0.0)) )
17449 if ( ircnw .eq. 2 )
then
17452 qrcnw(mgs) = (0.001)*max((qx(mgs,lc)-qminrncw),0.0)
17460 if ( ircnw .eq. 1 )
then
17466 & (1.e+06) * ((c1/(0.38))**(1./3.)) * (xdia(mgs,lc,1)*(0.5))
17468 & (0.027) * ((100.0)*(bradp**3)*(xdia(mgs,lc,1)*(0.5)) - (0.4))
17469 bt2 = (bradp -7.5) / (3.72)
17471 if ( bl2 .gt. 0.0 .and. bt2 .gt. 0.0 )
then
17472 qrcnw(mgs) = bl2 * bt2 * rho0(mgs) &
17473 & * qx(mgs,lc) * qx(mgs,lc)
17487 if (ndebug .gt. 0 )
write(0,*)
'conc 27a'
17500 IF ( .not. ( ipconc == 0 .and. lwsm6 ) )
THEN
17503 if ( qx(mgs,lr) .gt. qxmin(lr) .and. temcg(mgs) .lt. -5. .and. ibiggopt > 0 )
then
17506 IF ( ipconc .lt. 3 )
THEN
17509 & (20.0)*(pi**2)*brz*(xdn(mgs,lr)/rho0(mgs)) &
17510 & *cx(mgs,lr)*(xdia(mgs,lr,1)**6) &
17511 & *(exp(max(-arz*temcg(mgs), 0.0))-1.0) &
17513 qrfrzf(mgs) = qrfrz(mgs)
17516 ELSEIF ( ipconc .ge. 3 )
THEN
17523 IF ( ibiggopt == 2 .and. imurain == 1 )
THEN
17526 volt = exp( 16.2 + 1.0*temcg(mgs) )* 1.0e-6
17529 dbigg = (6./pi* volt )**(1./3.)
17532 IF ( dbigg < 8.e-3 )
THEN
17534 ratio = min(maxratiolu, dbigg/xdia(mgs,lr,1) )
17536 i = min(nqiacrratio,int(ratio*dqiacrratioinv))
17537 IF ( alp0flag )
THEN
17538 j = int(max(0.0,min(15.,alpha(mgs,lr)))*dqiacralphainv)
17540 j = int(max(minalphalu,min(maxalphalu,alpha(mgs,lr)))*dqiacralphainv)
17542 delx = ratio - float(i)*dqiacrratio
17543 dely = alpha(mgs,lr) - float(j)*dqiacralpha
17544 ip1 = min( i+1, nqiacrratio )
17545 jp1 = min( j+1, nqiacralpha )
17548 tmp1 = ciacrratio(i,j) + delx*dqiacrratioinv*(ciacrratio(ip1,j) - ciacrratio(i,j))
17549 tmp2 = ciacrratio(i,jp1) + delx*dqiacrratioinv*(ciacrratio(ip1,jp1) - ciacrratio(i,jp1))
17553 crfrz(mgs) = (tmp1 + dely*dqiacralphainv*(tmp2 - tmp1))*cx(mgs,lr)*dtpinv
17554 crfrzf(mgs) = crfrz(mgs)
17556 tmp1 = qiacrratio(i,j) + delx*dqiacrratioinv*(qiacrratio(ip1,j) - qiacrratio(i,j))
17557 tmp2 = qiacrratio(i,jp1) + delx*dqiacrratioinv*(qiacrratio(ip1,jp1) - qiacrratio(i,jp1))
17561 qrfrz(mgs) = (tmp1 + dely*dqiacralphainv*(tmp2 - tmp1))*qx(mgs,lr)*dtpinv
17562 qrfrzf(mgs) = qrfrz(mgs)
17564 IF ( qrfrz(mgs)*dtp < qxmin(lh) .or. crfrz(mgs)*dtp < cxmin )
THEN
17573 IF ( ipconc >= 6 .and. lzr > 1 )
THEN
17575 tmp1 = ziacrratio(i,j) + delx*dqiacrratioinv*(ziacrratio(ip1,j) - ziacrratio(i,j))
17576 tmp2 = ziacrratio(i,jp1) + delx*dqiacrratioinv*(ziacrratio(ip1,jp1) - ziacrratio(i,jp1))
17580 zrfrz(mgs) = (tmp1 + dely*dqiacralphainv*(tmp2 - tmp1))*zx(mgs,lr)*dtpinv
17583 IF ( ibiggsmallrain > 0 .and. xv(mgs,lr) < 2.*xvmn(lr) .and. ( ibiggsnow == 1 .or. ibiggsnow == 3 ) )
THEN
17588 crfrzs(mgs) = crfrz(mgs)
17589 qrfrzs(mgs) = qrfrz(mgs)
17591 IF ( ipconc >= 6 .and. lzr > 1 )
THEN
17592 zrfrzs(mgs) = zrfrz(mgs)
17595 ELSEIF ( dbigg < max( biggsnowdiam, max(dfrz,dhmn)) .and. ( ibiggsnow == 1 .or. ibiggsnow == 3 ) )
THEN
17598 crfrzs(mgs) = crfrz(mgs)
17599 qrfrzs(mgs) = qrfrz(mgs)
17601 IF ( ibiggsmallrain > 0 .and. xv(mgs,lr) < 1.2*xvmn(lr) )
THEN
17606 IF (ipconc >= 6 .and. lzr > 1 )
THEN
17607 zrfrzs(mgs) = zrfrz(mgs)
17613 ratio = min( maxratiolu, max(dfrz,dhmn)/xdia(mgs,lr,1) )
17615 i = min(nqiacrratio,int(ratio*dqiacrratioinv))
17618 IF ( alp0flag )
THEN
17619 j = int(max(0.0,min(15.,alpha(mgs,lr)))*dqiacralphainv)
17621 j = int(max(minalphalu,min(maxalphalu,alpha(mgs,lr)))*dqiacralphainv)
17623 delx = ratio - float(i)*dqiacrratio
17624 dely = alpha(mgs,lr) - float(j)*dqiacralpha
17625 ip1 = min( i+1, nqiacrratio )
17626 jp1 = min( j+1, nqiacralpha )
17629 tmp1 = ciacrratio(i,j) + delx*dqiacrratioinv*(ciacrratio(ip1,j) - ciacrratio(i,j))
17630 tmp2 = ciacrratio(i,jp1) + delx*dqiacrratioinv*(ciacrratio(ip1,jp1) - ciacrratio(i,jp1))
17635 crfrzf(mgs) = (tmp1 + dely*dqiacralphainv*(tmp2 - tmp1))*cx(mgs,lr)*dtpinv
17638 tmp1 = qiacrratio(i,j) + delx*dqiacrratioinv*(qiacrratio(ip1,j) - qiacrratio(i,j))
17639 tmp2 = qiacrratio(i,jp1) + delx*dqiacrratioinv*(qiacrratio(ip1,jp1) - qiacrratio(i,jp1))
17643 qrfrzf(mgs) = (tmp1 + dely*dqiacralphainv*(tmp2 - tmp1))*qx(mgs,lr)*dtpinv
17646 crfrzs(mgs) = crfrzs(mgs) - crfrzf(mgs)
17647 qrfrzs(mgs) = qrfrzs(mgs) - qrfrzf(mgs)
17649 IF ( ipconc >= 6 .and. lzr > 1 )
THEN
17650 zrfrzs(mgs) = zrfrz(mgs)
17652 tmp1 = ziacrratio(i,j) + delx*dqiacrratioinv*(ziacrratio(ip1,j) - ziacrratio(i,j))
17653 tmp2 = ziacrratio(i,jp1) + delx*dqiacrratioinv*(ziacrratio(ip1,jp1) - ziacrratio(i,jp1))
17657 zrfrzf(mgs) = (tmp1 + dely*dqiacralphainv*(tmp2 - tmp1))*zx(mgs,lr)*dtpinv
17658 zrfrzs(mgs) = zrfrzs(mgs) - zrfrzf(mgs)
17659 zrfrzf(mgs) = (1000./900.)**2*zrfrzf(mgs)
17670 IF ( (qrfrz(mgs))*dtp > qx(mgs,lr) )
THEN
17671 fac = ( qrfrz(mgs) )*dtp/qx(mgs,lr)
17672 qrfrz(mgs) = fac*qrfrz(mgs)
17673 qrfrzs(mgs) = fac*qrfrzs(mgs)
17674 qrfrzf(mgs) = fac*qrfrzf(mgs)
17675 crfrz(mgs) = fac*crfrz(mgs)
17676 crfrzs(mgs) = fac*crfrzs(mgs)
17677 crfrzf(mgs) = fac*crfrzf(mgs)
17678 IF ( ipconc >= 6 .and. lzr > 1 )
THEN
17679 zrfrz(mgs) = fac*zrfrz(mgs)
17680 zrfrzf(mgs) = fac*zrfrzf(mgs)
17699 ELSEIF ( ibiggopt == 1 )
THEN
17701 tmp = xv(mgs,lr)*brz*cx(mgs,lr)*(exp(max( -arz*temcg(mgs), 0.0 )) - 1.0)
17702 IF ( .false. .and. tmp .gt. cxmxd(mgs,lr) )
THEN
17706 crfrz(mgs) = cxmxd(mgs,lr)
17707 qrfrz(mgs) = qxmxd(mgs,lr)
17717 IF ( lzr < 1 )
THEN
17718 IF ( imurain == 3 )
THEN
17725 IF ( imurain == 3 )
THEN
17726 bfnu = (alpha(mgs,lr)+2.0)/(alpha(mgs,lr)+1.)
17729 bfnu = (4. + alpha(mgs,lr))*(5. + alpha(mgs,lr))*(6. + alpha(mgs,lr))/ &
17730 & ((1. + alpha(mgs,lr))*(2. + alpha(mgs,lr))*(3. + alpha(mgs,lr)))
17734 qrfrz(mgs) = bfnu*xmas(mgs,lr)*rhoinv(mgs)*crfrz(mgs)
17736 qrfrz(mgs) = min( qrfrz(mgs), 1.*qx(mgs,lr)*dtpinv )
17737 crfrz(mgs) = min( crfrz(mgs), 1.*cx(mgs,lr)*dtpinv )
17738 qrfrz(mgs) = min( qrfrz(mgs), qx(mgs,lr) )
17739 qrfrzf(mgs) = qrfrz(mgs)
17745 IF ( crfrz(mgs) .gt. qxmin(lh) )
THEN
17750 IF ( (ibiggsnow == 1 .or. ibiggsnow == 3 ) .and. ibiggopt /= 2 )
THEN
17751 xvfrz = rho0(mgs)*qrfrz(mgs)/(crfrz(mgs)*900.)
17752 frach = 0.5 *(1. + tanh(0.2e12 *( xvfrz - 1.15*xvmn(lh))))
17754 qrfrzs(mgs) = (1.-frach)*qrfrz(mgs)
17755 crfrzs(mgs) = (1.-frach)*crfrz(mgs)
17760 IF ( ipconc .ge. 14 .and. 1.e-3*rho0(mgs)*qrfrz(mgs)/crfrz(mgs) .lt. xvmn(lh) )
THEN
17761 qrfrzs(mgs) = qrfrz(mgs)
17762 crfrzs(mgs) = crfrz(mgs)
17766 qrfrzf(mgs) = frach*qrfrz(mgs)
17768 IF ( ibfr .le. 1 )
THEN
17769 crfrzf(mgs) = frach*min(crfrz(mgs), qrfrz(mgs)/(bfnu*1.0*vr1mm*1000.0)*rho0(mgs) )
17770 ELSEIF ( ibfr .eq. 5 )
THEN
17771 crfrzf(mgs) = frach*min(crfrz(mgs), qrfrz(mgs)/(bfnu*vfrz*1000.0)*rho0(mgs) )*rzxh(mgs)
17772 ELSEIF ( ibfr .eq. 2 )
THEN
17773 crfrzf(mgs) = frach*min(crfrz(mgs), qrfrz(mgs)/(bfnu*vfrz*1000.0)*rho0(mgs) )
17774 ELSEIF ( ibfr .eq. 6 )
THEN
17775 crfrzf(mgs) = frach*max(crfrz(mgs), qrfrz(mgs)/(bfnu*9.*xv(mgs,lr)*1000.0)*rho0(mgs) )
17777 crfrzf(mgs) = frach*crfrz(mgs)
17793 IF ( lvol(lh) .gt. 1 )
THEN
17794 vrfrzf(mgs) = rho0(mgs)*qrfrzf(mgs)/rhofrz
17798 IF ( nsplinter .ne. 0 )
THEN
17799 IF ( nsplinter .ge. 1000 )
THEN
17803 IF ( qrfrz(mgs)*dtp > qxmin(lh) .and. crfrz(mgs) > 1.e-3 )
THEN
17804 tmpdiam = 1.e6*( 6.*qrfrz(mgs)/(1000.*pi*crfrz(mgs) ))**(1./3.)
17805 tmp = lawson_splinter_fac*tmpdiam**4*crfrz(mgs)
17807 ELSEIF ( nsplinter .gt. 0 )
THEN
17808 tmp = nsplinter*crfrz(mgs)
17810 tmp = -nsplinter*crfrzf(mgs)
17812 csplinter2(mgs) = tmp
17813 qsplinter2(mgs) = min(0.1*qrfrz(mgs), tmp*splintermass/rho0(mgs) )
17840 if (ndebug .gt. 0 )
write(0,*)
'conc 25b'
17848 IF ( ibfc .ge. 1 .and. ibfc /= 3 .and. temg(mgs) < 268.15 )
THEN
17851 if ( qx(mgs,lc) .gt. qxmin(lc) .and. cx(mgs,lc) .gt. cxmin )
THEN
17852 IF ( ipconc < 2 )
THEN
17853 qwfrz(mgs) = ((2.0)*(brz)/(xdn(mgs,lc)*cx(mgs,lc))) &
17854 & *(exp(max(-arz*temcg(mgs), 0.0))-1.0) &
17855 & *rho0(mgs)*(qx(mgs,lc)**2)
17856 qwfrz(mgs) = max(qwfrz(mgs), 0.0)
17857 qwfrz(mgs) = min(qwfrz(mgs),qcmxd(mgs))
17858 cwfrz(mgs) = qwfrz(mgs)*rho0(mgs)/xmas(mgs,li)
17859 ELSEIF ( ipconc .ge. 2 )
THEN
17860 IF ( xdia(mgs,lc,3) > 0.e-6 )
THEN
17861 volt = exp( 16.2 + 1.0*temcg(mgs) )* 1.0e-6
17866 IF ( alpha(mgs,lc) == 0.0 )
THEN
17867 cwfrz(mgs) = cx(mgs,lc)*exp(-volt/xv(mgs,lc))*dtpinv
17871 qwfrz(mgs) = cwfrz(mgs)*xdn0(lc)*rhoinv(mgs)*(volt + xv(mgs,lc))
17873 ratio = (1. + alpha(mgs,lc))*volt/xv(mgs,lc)
17875 IF ( .false. .and. usegamxinfcnu )
THEN
17876 i = nint(dgami*(1. + alpha(mgs,lc)))
17878 i = nint(dgami*(2. + alpha(mgs,lc)))
17881 cwfrz(mgs) = cx(mgs,lc)*
gamxinf(1.+alpha(mgs,lc), ratio)/(dtp*gcnup1)
17883 qwfrz(mgs) = cx(mgs,lc)*xdn0(lc)*xv(mgs,lc)*rhoinv(mgs)*
gamxinf(2.+alpha(mgs,lc), ratio)/(dtp*gcnup2)
17887 ratio = min( maxratiolu, ratio )
17891 tmp =
gaminterp(ratio,alpha(mgs,lc),1,1)
17893 cwfrz(mgs) = cx(mgs,lc)*tmp*dtpinv
17895 tmp =
gaminterp(ratio,alpha(mgs,lc),12,1)
17897 qwfrz(mgs) = cx(mgs,lc)*xdn0(lc)*xv(mgs,lc)*rhoinv(mgs)*dtpinv*tmp
17905 if ( temg(mgs) .gt. 268.15 )
then
17912 if ( xplate(mgs) .eq. 1 )
then
17913 qwfrzp(mgs) = qwfrz(mgs)
17914 cwfrzp(mgs) = cwfrz(mgs)
17917 if ( xcolmn(mgs) .eq. 1 )
then
17918 qwfrzc(mgs) = qwfrz(mgs)
17919 cwfrzc(mgs) = cwfrz(mgs)
17932 if (ndebug .gt. 0 )
write(0,*)
'conc 25a'
17947 IF ( icfn .ge. 1 )
THEN
17949 IF ( temg(mgs) .lt. 271.15 .and. qx(mgs,lc) .gt. qxmin(lc))
THEN
17953 IF ( icfn .ge. 2 )
THEN
17954 ccia(mgs) = exp( 4.11 - (0.262)*temcg(mgs) )
17960 knud(mgs) = 2.28e-5 * temg(mgs) / ( pres(mgs)*raero )
17961 knuda(mgs) = 1.257 + 0.4*exp(-1.1/knud(mgs))
17962 gtp(mgs) = 1. / ( fai(mgs) + fbi(mgs) )
17963 dfar(mgs) = kb*temg(mgs)*(1.+knuda(mgs)*knud(mgs))/(6.*pi*fadvisc(mgs)*raero)
17964 fn1(mgs) = 2.*pi*xdia(mgs,lc,1)*cx(mgs,lc)*ccia(mgs)
17965 fn2(mgs) = -gtp(mgs)*(ssw(mgs)-1.)*felv(mgs)/pres(mgs)
17966 fnft(mgs) = 0.4*(1.+1.45*knud(mgs)+0.4*knud(mgs)*exp(-1./knud(mgs)))*(ftka(mgs)+2.5*knud(mgs)*kaero) &
17967 & / ( (1.+3.*knud(mgs))*(2*ftka(mgs)+5.*knud(mgs)*kaero+kaero) )
17971 ctfzbd(mgs) = fn1(mgs)*dfar(mgs)
17974 ctfzth(mgs) = fn1(mgs)*fn2(mgs)*fnft(mgs)/rho0(mgs)
17977 ctfzdi(mgs) = fn1(mgs)*fn2(mgs)*rw*temg(mgs)/(felv(mgs)*rho0(mgs))
17979 cwctfz(mgs) = max( ctfzbd(mgs) + ctfzth(mgs) + ctfzdi(mgs) , 0.)
17989 ELSEIF ( icfn .eq. 1 )
THEN
17990 IF ( wvel(mgs) .lt. -0.05 )
THEN
17991 cwctfz(mgs) = cfnfac*exp( (-2.80) - (0.262)*temcg(mgs) )
17992 cwctfz(mgs) = min((1.0e3)*cwctfz(mgs), ccmxd(mgs) )
17996 IF ( ipconc .ge. 2 )
THEN
17997 cwctfz(mgs) = min( cwctfz(mgs)*dtpinv, ccmxd(mgs) )
17998 qwctfz(mgs) = xmas(mgs,lc)*cwctfz(mgs)/rho0(mgs)
18000 qwctfz(mgs) = (cimasn)*cwctfz(mgs)/(dtp*rho0(mgs))
18001 qwctfz(mgs) = max(qwctfz(mgs), 0.0)
18002 qwctfz(mgs) = min(qwctfz(mgs),qcmxd(mgs))
18006 if ( xplate(mgs) .eq. 1 )
then
18007 qwctfzp(mgs) = qwctfz(mgs)
18008 cwctfzp(mgs) = cwctfz(mgs)
18011 if ( xcolmn(mgs) .eq. 1 )
then
18012 qwctfzc(mgs) = qwctfz(mgs)
18013 cwctfzc(mgs) = cwctfz(mgs)
18034 if (ndebug .gt. 0 )
write(0,*)
'conc 23a'
18036 hrifac = (1.e-3)*((0.044)*(0.01**3))
18044 IF ( ihrn .ge. 1 )
THEN
18045 if ( qx(mgs,lc) .gt. qxmin(lc) )
then
18046 if ( temg(mgs) .lt. 273.15 )
then
18057 IF ( log(cx(mgs,lc)*(1.e-6)/(3.0)) .gt. 0.0 )
THEN
18058 ciihr(mgs) = ((1.69e17)/dthr) &
18059 & *(log(cx(mgs,lc)*(1.e-6)/(3.0)) * &
18060 & ((1.e-3)*rho0(mgs)*qx(mgs,lc))/(cx(mgs,lc)*(1.e-6)))**(7./3.)
18061 ciihr(mgs) = ciihr(mgs)*(1.0e6)
18062 qiihr(mgs) = hrifac*ciihr(mgs)/rho0(mgs)
18063 qiihr(mgs) = max(qiihr(mgs), 0.0)
18064 qiihr(mgs) = min(qiihr(mgs),qcmxd(mgs))
18067 if ( xplate(mgs) .eq. 1 )
then
18068 qipiphr(mgs) = qiihr(mgs)
18069 cipiphr(mgs) = ciihr(mgs)
18072 if ( xcolmn(mgs) .eq. 1 )
then
18073 qicichr(mgs) = qiihr(mgs)
18074 cicichr(mgs) = ciihr(mgs)
18115 IF ( temg(mgs) .lt. tfr .and. qx(mgs,li) .gt. qxmin(li) )
THEN
18116 IF ( ipconc .ge. 4 .and. .false. )
THEN
18117 if ( cx(mgs,li) .gt. 10. .and. xdia(mgs,li,1) .gt. 50.e-6 )
then
18119 & (qx(mgs,li)*rho0(mgs) &
18120 & /(pi*xdn(mgs,li)*cx(mgs,li)))**(1./3.)
18121 IF ( cirdiatmp .gt. 100.e-6 )
THEN
18123 & ((pi*xdn(mgs,li)*cx(mgs,li)) / (6.0*rho0(mgs)*dtp)) &
18124 & *exp(-hdia0/cirdiatmp) &
18125 & *( (hdia0**3) + 3.0*(hdia0**2)*cirdiatmp &
18126 & + 6.0*(hdia0)*(cirdiatmp**2) + 6.0*(cirdiatmp**3) )
18128 & min(qscnvi(mgs),qimxd(mgs))
18129 IF ( ipconc .ge. 4 )
THEN
18130 cscnvi(mgs) = min( cimxd(mgs), cx(mgs,li)*exp(-hdia0/cirdiatmp))
18135 ELSEIF ( ipconc .lt. 4 )
THEN
18137 qscnvi(mgs) = 0.001*eii(mgs)*max((qx(mgs,li)-1.e-3),0.0)
18138 qscnvi(mgs) = min(qscnvi(mgs),qxmxd(mgs,li))
18139 cscnvi(mgs) = qscnvi(mgs)*rho0(mgs)/xmas(mgs,li)
18140 cscnvis(mgs) = 0.5*cscnvi(mgs)
18153 fvent(mgs) = (fschm(mgs)**(1./3.)) * (fakvisc(mgs)**(-0.5))
18157 if ( ndebug .gt. 0 )
write(0,*)
'civent'
18168 IF ( icond .eq. 1 .or. temg(mgs) .le. tfrh &
18169 & .or. (qx(mgs,lr) .le. qxmin(lr) .and. qx(mgs,lc) .le. qxmin(lc)) )
THEN
18170 IF ( qx(mgs,li) .gt. qxmin(li) )
THEN
18172 & (civenta*xdia(mgs,li,1)**civentb &
18173 & +civentc*xdia(mgs,li,1)**civentd) &
18175 & (civente*xdia(mgs,li,1)**civentf+civentg)
18176 xcivent = (fschm(mgs)**(1./3.))*((cireyn/fakvisc(mgs))**0.5)
18177 if ( xcivent .lt. 1.0 )
then
18178 civent(mgs) = 1.0 + 0.14*xcivent**2
18180 if ( xcivent .ge. 1.0 )
then
18181 civent(mgs) = 0.86 + 0.28*xcivent
18194 igmrwb = 100.*((5.0+br)/2.0)
18195 rwventa = (0.78)*gmoi(igmrwa)
18196 rwventb = (0.308)*gmoi(igmrwb)
18198 IF ( qx(mgs,lr) .gt. qxmin(lr) )
THEN
18199 IF ( ipconc .ge. 3 )
THEN
18200 IF ( imurain == 3 )
THEN
18201 IF ( izwisventr == 1 )
THEN
18202 rwvent(mgs) = ventrx(mgs)*(1.6 + 124.9*(1.e-3*rho0(mgs)*qx(mgs,lr))**.2046)
18206 & (0.78*ventrx(mgs) + 0.308*ventrxn(mgs)*fvent(mgs) &
18207 & *sqrt((ar*rhovt(mgs))) &
18208 & *(xdia(mgs,lr,1)**((1.0+br)/2.0)) )
18218 IF ( iferwisventr == 1 )
THEN
18222 alpr = min(alpharmax,alpha(mgs,lr) )
18224 x = 1. + alpha(mgs,lr)
18226 IF ( ipconc >= 6 .and. lzr > 1 )
THEN
18228 i = int(dgami*(tmp))
18230 g1palp = gmoi(i) + (gmoi(i+1) - gmoi(i))*del*dgami
18232 tmp = 2.5 + alpha(mgs,lr) + 0.5*bx(lr)
18233 i = int(dgami*(tmp))
18235 y = (gmoi(i) + (gmoi(i+1) - gmoi(i))*del*dgami)/g1palp
18242 vent1 = dble(xdia(mgs,lr,1))**(0.5 + 0.5*bx(lr))
18243 vent2 = dble(1. + 0.5*fx(lr)*xdia(mgs,lr,1))**dble(2.5+alpr+0.5*bx(lr))
18248 & 0.308*fvent(mgs)*y* &
18249 & sqrt(ax(lr)*rhovt(mgs))*(vent1/vent2)
18259 ELSEIF ( iferwisventr == 2 )
THEN
18262 x = 1. + alpha(mgs,lr)
18265 & (0.78*x + 0.308*ventrxn(mgs)*fvent(mgs) &
18266 & *sqrt((ar*rhovt(mgs))) &
18267 & *(xdia(mgs,lr,1)**((1.0+br)/2.0)) )
18270 IF ( ipconc >= 7 )
THEN
18271 alpr = min(alpharmax,alpha(mgs,lr) )
18273 tmp = alpr + 5.5 + br/2.
18274 i = int(dgami*(tmp))
18276 y = gmoi(i) + (gmoi(i+1) - gmoi(i))*del*dgami
18281 & 0.78*(4. + alpr)*(3. + alpr)*(2. + alpr)*(1. + alpr) + &
18282 & 0.308*fvent(mgs)* &
18283 & sqrt(ax(lr)*rhovt(mgs))*(y/gf1palp(mgs))*(xdia(mgs,lr,1)**((1.0+br)/2.0))
18293 & (rwventa + rwventb*fvent(mgs) &
18294 & *sqrt((ar*rhovt(mgs))) &
18295 & *(xdia(mgs,lr,1)**((1.0+br)/2.0)) )
18303 igmswb = 100.*((5.0+ds)/2.0)
18304 swventa = (0.78)*gmoi(igmswa)
18305 swventb = (0.308)*gmoi(igmswb)
18307 IF ( qx(mgs,ls) .gt. qxmin(ls) )
THEN
18308 IF ( ipconc .ge. 4 )
THEN
18309 swvent(mgs) = 0.65 + 0.44*fvent(mgs)*sqrt(vtxbar(mgs,ls,1)*xdia(mgs,ls,1))
18313 & (swventa + swventb*fvent(mgs) &
18314 & *sqrt((cs*rhovt(mgs))) &
18315 & *(xdia(mgs,ls,1)**((1.0+ds)/2.0)) )
18325 igmhwb = 100.0*2.75
18326 hwventa = (0.78)*gmoi(igmhwa)
18327 hwventb = (0.308)*gmoi(igmhwb)
18333 IF ( qx(mgs,lh) .gt. qxmin(lh) )
THEN
18334 hwventc = (4.0*gr/(3.0*cdxgs(mgs,lh)))**(0.25)
18335 IF ( .false. .or. alpha(mgs,lh) .eq. 0.0 )
THEN
18337 & ( hwventa + hwventb*hwventc*fvent(mgs) &
18338 & *((xdn(mgs,lh)/rho0(mgs))**(0.25)) &
18339 & *(xdia(mgs,lh,1)**(0.75)))
18349 x = 1. + alpha(mgs,lh)
18351 tmp = 1 + alpha(mgs,lh)
18352 i = int(dgami*(tmp))
18354 g1palp = gmoi(i) + (gmoi(i+1) - gmoi(i))*del*dgami
18356 tmp = 2.5 + alpha(mgs,lh) + 0.5*bxx(mgs,lh)
18357 i = int(dgami*(tmp))
18359 y = (gmoi(i) + (gmoi(i+1) - gmoi(i))*del*dgami)/g1palp
18362 hwventy(mgs) = 0.308*fvent(mgs)*(xdia(mgs,lh,1)**(0.5 + 0.5*bxx(mgs,lh)))*sqrt(axx(mgs,lh)*rhovt(mgs))
18364 & ( 0.78*x + y*hwventy(mgs) )
18379 IF ( lhl .gt. 1 )
THEN
18381 igmhwb = 100.0*2.75
18382 hwventa = (0.78)*gmoi(igmhwa)
18383 hwventb = (0.308)*gmoi(igmhwb)
18386 IF ( qx(mgs,lhl) .gt. qxmin(lhl) )
THEN
18387 hwventc = (4.0*gr/(3.0*cdxgs(mgs,lhl)))**(0.25)
18389 IF ( .false. .or. alpha(mgs,lhl) .eq. 0.0 )
THEN
18391 & ( hwventa + hwventb*hwventc*fvent(mgs) &
18392 & *((xdn(mgs,lhl)/rho0(mgs))**(0.25)) &
18393 & *(xdia(mgs,lhl,1)**(0.75)))
18404 x = 1. + alpha(mgs,lhl)
18406 tmp = 1 + alpha(mgs,lhl)
18407 i = int(dgami*(tmp))
18409 g1palp = gmoi(i) + (gmoi(i+1) - gmoi(i))*del*dgami
18411 tmp = 2.5 + alpha(mgs,lhl) + 0.5*bxx(mgs,lhl)
18412 i = int(dgami*(tmp))
18414 y = (gmoi(i) + (gmoi(i+1) - gmoi(i))*del*dgami)/g1palp
18416 hlventy(mgs) = 0.308*fvent(mgs)*(xdia(mgs,lhl,1)**(0.5 + 0.5*bxx(mgs,lhl)))*sqrt(axx(mgs,lhl)*rhovt(mgs))
18418 hlvent(mgs) = 0.78*x + y*hlventy(mgs)
18436 & ( felv(mgs)*fwvdf(mgs)*rho0(mgs)*(qss0(mgs)-qx(mgs,lv)) &
18437 & -ftka(mgs)*temcg(mgs) ) &
18438 & / ( rho0(mgs)*(felf(mgs)+fcw(mgs)*temcg(mgs)) )
18440 & (1.0)-fci(mgs)*temcg(mgs) &
18441 & / ( felf(mgs)+fcw(mgs)*temcg(mgs) )
18447 fmlt1(mgs) = (2.0*pi)* &
18448 & ( felv(mgs)*fwvdf(mgs)*(qss0(mgs)-qx(mgs,lv)) &
18449 & -ftka(mgs)*temcg(mgs)/rho0(mgs) ) &
18451 fmlt2(mgs) = -fcw(mgs)*temcg(mgs)/felf(mgs)
18452 fmlt1e(mgs) = (2.0*pi)* &
18453 & ( felv(mgs)*fwvdf(mgs)*(qss0(mgs)-qx(mgs,lv)) ) / (felf(mgs))
18460 & (4.0*pi/rho0(mgs))*(ssi(mgs)-1.0)* &
18461 & (1.0/(fai(mgs)+fbi(mgs)))
18465 & (4.0*pi/rho0(mgs))*(ssw(mgs)-1.0)* &
18466 & (1.0/(fav(mgs)+fbv(mgs)))
18476 IF ( lhwlg > 1 )
THEN
18514 if ( .not. mixedphase )
then
18517 IF ( temg(mgs) .gt. tfr )
THEN
18519 IF ( qx(mgs,ls) .gt. qxmin(ls) )
THEN
18522 & (c1sw*fmlt1(mgs)*cx(mgs,ls)*swvent(mgs)*xdia(mgs,ls,1) ) &
18538 IF ( qx(mgs,lh) .gt. qxmin(lh) )
THEN
18540 IF ( ibinhmlr == 0 .or. lzh < 1 )
THEN
18543 & fmlt1(mgs)*cx(mgs,lh)*hwvent(mgs)*xdia(mgs,lh,1) &
18544 & + fmlt2(mgs)*(qhacrmlr(mgs)+qhacwmlr(mgs)) &
18546 ELSEIF ( ibinhmlr == 1 )
THEN
18548 errmsg =
'ibinhmlr = 1 not available for 2-moment'
18552 ELSEIF ( ibinhmlr == 2 .or. ibinhmlr == 3 )
THEN
18557 IF ( ivhmltsoak > 0 .and. qhmlr(mgs) < 0.0 .and. lvol(lh) > 1 .and. xdn(mgs,lh) .lt. xdnmx(lh) )
THEN
18559 v1 = (1. - xdn(mgs,lh)/xdnmx(lh))*(vx(mgs,lh) + rho0(mgs)*qhmlr(mgs)/xdn(mgs,lh) )/(dtp)
18560 v2 = -1.0*rho0(mgs)*qhmlr(mgs)/xdnmx(lh)
18562 vhsoak(mgs) = min(v1,v2)
18569 IF ( lhl .gt. 1 .and. lhlw < 1 )
THEN
18571 IF ( qx(mgs,lhl) .gt. qxmin(lhl) )
THEN
18572 IF ( ibinhlmlr == 0 .or. lzhl < 1)
THEN
18575 & fmlt1(mgs)*cx(mgs,lhl)*hlvent(mgs)*xdia(mgs,lhl,1) &
18576 & + fmlt2(mgs)*(qhlacrmlr(mgs)+qhlacwmlr(mgs)) &
18579 ELSEIF ( ibinhlmlr == 1 )
THEN
18584 ELSEIF ( ibinhlmlr == -1 )
THEN
18589 IF ( ivhmltsoak > 0 .and. qhlmlr(mgs) < 0.0 .and. lvol(lhl) > 1 .and. xdn(mgs,lhl) .lt. xdnmx(lhl) )
THEN
18591 v1 = (1. - xdn(mgs,lhl)/xdnmx(lhl))*(vx(mgs,lhl) + rho0(mgs)*qhlmlr(mgs)/xdn(mgs,lhl) )/(dtp)
18592 v2 = -1.0*rho0(mgs)*qhlmlr(mgs)/xdnmx(lhl)
18594 vhlsoak(mgs) = min(v1,v2)
18607 if ( .not. mixedphase ) qsmlr(mgs) = max( qsmlr(mgs), min( -qsmxd(mgs), -0.7*qx(mgs,ls)*dtpinv ) )
18608 IF ( .not. mixedphase )
THEN
18609 qhmlr(mgs) = max( qhmlr(mgs), min( -qhmxd(mgs), -0.95*qx(mgs,lh)*dtpinv ) )
18610 chmlr(mgs) = max( chmlr(mgs), min( -chmxd(mgs), -0.95*cx(mgs,lh)*dtpinv ) )
18619 IF ( lhl .gt. 1 .and. lhlw < 1 )
THEN
18620 qhlmlr(mgs) = max( qhlmlr(mgs), min( -qxmxd(mgs,lhl), -0.95*qx(mgs,lhl)*dtpinv ) )
18621 chlmlr(mgs) = max( chlmlr(mgs), min( -cxmxd(mgs,lhl), -0.95*cx(mgs,lhl)*dtpinv ) )
18629 if ( ipconc .ge. 1 )
then
18631 cimlr(mgs) = (cx(mgs,li)/(qx(mgs,li)+1.e-20))*qimlr(mgs)
18632 IF ( .not. mixedphase )
THEN
18633 IF ( xdia(mgs,ls,1) .gt. 1.e-6 .and. -qsmlr(mgs) .ge. 0.5*qxmin(ls) .and. ipconc .ge. 4 )
THEN
18635 csmlr(mgs) = (cx(mgs,ls)/(qx(mgs,ls)))*qsmlr(mgs)
18636 ELSEIF ( qx(mgs,ls) > qxmin(ls) )
THEN
18637 csmlr(mgs) = (cx(mgs,ls)/(qx(mgs,ls)))*qsmlr(mgs)
18640 csmlrr(mgs) = csmlr(mgs)/rzxs(mgs)
18641 IF ( -csmlrr(mgs)*dtp > cxmin .and. -qsmlr(mgs)*dtp > qxmin(lr) .and. snowmeltdia > 0.0 )
THEN
18642 rmas = rho0(mgs)*qsmlr(mgs)/csmlrr(mgs)
18643 IF ( rmas > snowmeltmass )
THEN
18644 csmlrr(mgs) = rho0(mgs)*qsmlr(mgs)/snowmeltmass
18654 IF ( ibinhmlr == 0 .or. lzh < 1 )
THEN
18655 chmlr(mgs) = (cx(mgs,lh)/(qx(mgs,lh)+1.e-20))*qhmlr(mgs)
18656 IF ( imltshddmr == 3 .and. qhmlr(mgs) < -qxmin(lh) )
THEN
18665 tmp = 1. + alpha(mgs,lh)
18666 i = int(dgami*(tmp))
18668 g1palp = gmoi(i) + (gmoi(i+1) - gmoi(i))*del*dgami
18670 ratio = min( maxratiolu, mltdiam1/xdia(mgs,lh,1) )
18672 x =
gamxinfdp(2. + alpha(mgs,lh), ratio)/g1palp
18673 y =
gamxinfdp(2.5 + alpha(mgs,lh) + 0.5*bxx(mgs,lh), ratio)/g1palp
18675 hwvent1 = 0.78*x + y*hwventy(mgs)
18677 qhlmlr1 = min( fmlt1(mgs)*cx(mgs,lh)*hwvent1*xdia(mgs,lh,1), 0.0 )
18679 chmlr(mgs) = (cx(mgs,lh)/(qx(mgs,lh)+1.e-20))*(qhmlr(mgs) - qhlmlr1)
18690 IF ( chmlr(mgs) < 0.0 .and. (ibinhmlr < 1 .or. lzh < 1) )
THEN
18691 IF ( ipconc >= 6 .and. lzr .gt. 1 .and. lzh < 1 .and. qx(mgs,lh) > qxmin(lh) )
THEN
18692 tmp = qx(mgs,lh)/cx(mgs,lh)
18693 alp = alpha(mgs,lh)
18696 zhmlr(mgs) = g1*(6.*rho0(mgs)/(pi*xdn(mgs,lh)))**2*( 2.*tmp * qhmlr(mgs) - tmp**2 * chmlr(mgs) )
18700 IF ( ibinhmlr == 0 .or. lzh < 1 )
THEN
18701 IF ( ihmlt .eq. 1 )
THEN
18702 chmlrr(mgs) = min( chmlr(mgs), rho0(mgs)*qhmlr(mgs)/(xdn(mgs,lr)*vmlt) )
18703 ELSEIF ( ihmlt .eq. 2 )
THEN
18704 IF ( xv(mgs,lh) .gt. 0.0 .and. chmlr(mgs) .lt. 0.0 )
THEN
18707 IF(imltshddmr == 1)
THEN
18710 tmp = -rho0(mgs)*qhmlr(mgs)/(min(xdn(mgs,lr)*xvmx(lr), xdn(mgs,lh)*xv(mgs,lh)))
18711 tmp2 = -rho0(mgs)*qhmlr(mgs)/(xdn(mgs,lr)*vr3mm)
18713 chmlrr(mgs) = tmp*(sheddiam0-xdia(mgs,lh,3))/(sheddiam0-sheddiam)+tmp2*(xdia(mgs,lh,3)-sheddiam)/(sheddiam0-sheddiam)
18714 chmlrr(mgs) = -max(tmp,min(tmp2,chmlrr(mgs)))
18715 ELSEIF ( imltshddmr == 2 .or. imltshddmr == 3 )
THEN
18718 chmlrr(mgs) = rho0(mgs)*qhmlr(mgs)/(xdn(mgs,lr)*vshdgs(mgs,lh))
18720 chmlrr(mgs) = rho0(mgs)*qhmlr(mgs)/(min(xdn(mgs,lr)*xvmx(lr), xdn(mgs,lh)*xv(mgs,lh)))
18723 chmlrr(mgs) = chmlr(mgs)
18725 ELSEIF ( ihmlt .eq. 0 )
THEN
18726 chmlrr(mgs) = chmlr(mgs)
18730 chmlrr(mgs) = min( chmlrr(mgs), rho0(mgs)*qhmlr(mgs)/(xdn(mgs,lr)*xvmx(lr)) )
18735 IF ( lhl .gt. 1 .and. lhlw < 1 .and. .not. mixedphase .and. qhlmlr(mgs) < 0.0 )
THEN
18737 IF ( ibinhlmlr == 0 .or. lzhl < 1 )
THEN
18742 chlmlr(mgs) = (cx(mgs,lhl)/(qx(mgs,lhl)+1.e-20))*qhlmlr(mgs)
18743 IF ( imltshddmr == 3 .and. qhlmlr(mgs) < -qxmin(lhl) )
THEN
18753 tmp = 1. + alpha(mgs,lhl)
18754 i = int(dgami*(tmp))
18756 g1palp = gmoi(i) + (gmoi(i+1) - gmoi(i))*del*dgami
18758 ratio = min( maxratiolu, mltdiam1/xdia(mgs,lhl,1) )
18760 x =
gamxinfdp(2. + alpha(mgs,lhl), ratio)/g1palp
18761 y =
gamxinfdp(2.5 + alpha(mgs,lhl) + 0.5*bxx(mgs,lhl), ratio)/g1palp
18763 hwvent1 = 0.78*x + y*hlventy(mgs)
18765 qhlmlr1 = min( fmlt1(mgs)*cx(mgs,lhl)*hwvent1*xdia(mgs,lhl,1), 0.0 )
18767 chlmlr(mgs) = (cx(mgs,lhl)/(qx(mgs,lhl)+1.e-20))*min(0.0, qhlmlr(mgs) - qhlmlr1)
18773 IF ( ibinhlmlr == 0 .or. lzhl < 1 )
THEN
18774 IF ( ihmlt .eq. 1 )
THEN
18775 chlmlrr(mgs) = min( chlmlr(mgs), rho0(mgs)*qhlmlr(mgs)/(xdn(mgs,lr)*vmlt) )
18776 ELSEIF ( ihmlt .eq. 2 )
THEN
18777 IF ( xv(mgs,lhl) .gt. 0.0 .and. chlmlr(mgs) .lt. 0.0 )
THEN
18780 IF(imltshddmr == 1 )
THEN
18781 tmp = -rho0(mgs)*qhlmlr(mgs)/(min(xdn(mgs,lr)*xvmx(lr), xdn(mgs,lhl)*xv(mgs,lhl)))
18782 tmp2 = -rho0(mgs)*qhlmlr(mgs)/(xdn(mgs,lr)*vr3mm)
18783 chlmlrr(mgs) = tmp*(20.e-3-xdia(mgs,lhl,3))/(20.e-3-sheddiam)+tmp2*(xdia(mgs,lhl,3)-sheddiam)/(20.e-3-sheddiam)
18784 chlmlrr(mgs) = -max(tmp,min(tmp2,chlmlrr(mgs)))
18785 ELSEIF ( imltshddmr == 2 .or. imltshddmr == 3 )
THEN
18788 chlmlrr(mgs) = rho0(mgs)*qhlmlr(mgs)/(xdn(mgs,lr)*vshdgs(mgs,lhl))
18790 chlmlrr(mgs) = rho0(mgs)*qhlmlr(mgs)/(min(xdn(mgs,lr)*xvmx(lr), xdn(mgs,lhl)*xv(mgs,lhl)))
18793 chlmlrr(mgs) = chlmlr(mgs)
18795 ELSEIF ( ihmlt .eq. 0 )
THEN
18796 chlmlrr(mgs) = chlmlr(mgs)
18800 chlmlrr(mgs) = min( chlmlrr(mgs), rho0(mgs)*qhlmlr(mgs)/(xdn(mgs,lr)*xvmx(lr)) )
18804 IF ( ipconc >= 8 .and. lzhl .gt. 1 .and. ibinhlmlr <= 0 )
THEN
18805 IF ( cx(mgs,lhl) > 0.0 )
THEN
18807 tmp = qx(mgs,lhl)/cx(mgs,lhl)
18808 alp = alpha(mgs,lhl)
18812 zhlmlr(mgs) = g1*(6.*rho0(mgs)/(pi*xdn(mgs,lhl)))**2*( tmp * qhlmlr(mgs) )
18830 rwcap(mgs) = (0.5)*xdia(mgs,lr,1)
18831 swcap(mgs) = (0.5)*xdia(mgs,ls,1)
18832 hwcap(mgs) = (0.5)*xdia(mgs,lh,1)
18833 IF ( lhl .gt. 1 ) hlcap(mgs) = (0.5)*xdia(mgs,lhl,1)
18835 if ( qx(mgs,li).gt.qxmin(li) .and. xdia(mgs,li,1) .gt. 0.0 )
then
18839 cilen(mgs) = 0.4764*(xdia(mgs,li,1))**(0.958)
18840 cval = xdia(mgs,li,1)
18842 eval = sqrt(1.0-(aval**2)/(cval**2))
18843 fval = min(0.99,eval)
18844 gval = alog( abs( (1.+fval)/(1.-fval) ) )
18845 cicap(mgs) = cval*fval / gval
18856 IF ( icond .eq. 1 .or. temg(mgs) .le. tfrh &
18857 & .or. (qx(mgs,lr) .le. qxmin(lr) .and. qx(mgs,lc) .le. qxmin(lc)) )
THEN
18859 & fvds(mgs)*cx(mgs,li)*civent(mgs)*cicap(mgs)*depfac
18861 & fvds(mgs)*cx(mgs,ls)*swvent(mgs)*swcap(mgs)*depfac
18873 & fvds(mgs)*cx(mgs,lh)*hwvent(mgs)*hwcap(mgs)*depfac
18875 IF ( lhl .gt. 1 ) qhldsv(mgs) = fvds(mgs)*cx(mgs,lhl)*hlvent(mgs)*hlcap(mgs)*depfac
18889 IF ( dosublimationfix )
THEN
18893 qitmp(mgs) = qx(mgs,li) + qx(mgs,ls) + qx(mgs,lh)
18894 IF ( lis > 1 ) qitmp(mgs) = qitmp(mgs) + qx(mgs,lis)
18895 IF ( lhl > 1 ) qitmp(mgs) = qitmp(mgs) + qx(mgs,lhl)
18896 qrtmp(mgs) = qx(mgs,lr)
18897 qctmp(mgs) = qx(mgs,lc)
18898 qsimxdep(mgs) = 0.0
18899 qsimxsub(mgs) = 0.0
18904 IF ( qitmp(mgs) > qxmin(li) )
THEN
18906 qitmp1 = qitmp(mgs)
18907 qctmp1 = qctmp(mgs)
18908 felvcptmp = felvcp(mgs)
18909 felscptmp = felscp(mgs)
18910 qvtmp(mgs) = qx(mgs,lv)
18911 qss(mgs) = qvs(mgs)
18915 thetatmp = theta(mgs)
18916 thetaptmp = thetap(mgs)
18917 temgtmp = temg(mgs)
18918 temcgtmp = temcg(mgs)
18919 qvaptmp = qx(mgs,lv)
18925 dqwvtmp(mgs) = ( qvtmp(mgs) - qsstmp )
18932 IF ( itertd == 1 )
THEN
18935 dqcitmp(mgs) = dqci(mgs)
18941 dqwv(mgs) = ( qvtmp(mgs) - qsstmp )
18945 if( dqwv(mgs) .lt. 0. )
then
18946 if( qitmp(mgs) .gt. -dqwv(mgs) )
then
18947 dqci(mgs) = dqwv(mgs)
18950 dqci(mgs) = -qitmp(mgs)
18951 dqwv(mgs) = dqwv(mgs) + qitmp(mgs)
18954 qvptmp = qvptmp - ( dqcw(mgs) + dqci(mgs) )
18956 IF ( itertd == 2 .and. eqtset > 1 )
THEN
18960 cvm = cv+cvv*qvtmp(mgs)+cpl*(qx(mgs,lc)+qrtmp(mgs)) &
18963 felvcptmp = (felv(mgs)-rw*temg(mgs))/cvm
18964 felscptmp = (fels(mgs)-rw*temg(mgs))/cvm
18969 qctmp(mgs) = qctmp(mgs) + dqcw(mgs)
18970 qitmp(mgs) = qitmp(mgs) + dqci(mgs)
18971 thetaptmp = thetaptmp + &
18973 & (felvcp(mgs)*dqcw(mgs) +felscp(mgs)*dqci(mgs))
18980 IF ( dqwv(mgs) .ge. 0. )
THEN
18987 if ( temg(mgs) .lt. tfr .and. temg(mgs) .gt. thnuc )
then
18991 if ( temg(mgs) .le. thnuc )
then
18997 gamss = (felvcp(mgs)*fracl(mgs) + felscp(mgs)*fraci(mgs)) &
19000 dqvcnd(mgs) = dqwv(mgs)/(1. + fcqv2(mgs)*qsstmp/ &
19001 & ((temg(mgs)-cbi)**2))
19003 if ( temg(mgs) .ge. tfr )
then
19004 dqvcnd(mgs) = dqwv(mgs)/(1. + fcqv1(mgs)*qsstmp/ &
19005 & ((temg(mgs)-cbw)**2))
19011 dqcw(mgs) = dqvcnd(mgs)*fracl(mgs)
19012 dqci(mgs) = dqvcnd(mgs)*fraci(mgs)
19014 thetaptmp = thetaptmp + &
19015 & (felvcp(mgs)*dqcw(mgs) + felscp(mgs)*dqci(mgs)) &
19018 qvptmp = qvptmp - ( dqvcnd(mgs) )
19019 qctmp(mgs) = qctmp(mgs) + dqcw(mgs)
19020 qitmp(mgs) = qitmp(mgs) + dqci(mgs)
19022 IF ( itertd == 2 .and. eqtset > 1 )
THEN
19026 cvm = cv+cvv*qvtmp(mgs)+cpl*(qctmp(mgs) +qrtmp(mgs)) &
19029 felvcptmp = (felv(mgs)-rw*temg(mgs))/cvm
19030 felscptmp = (fels(mgs)-rw*temg(mgs))/cvm
19033 IF ( eqtset > 2 )
THEN
19034 pipert(mgs) = pipert(mgs) + (0 &
19035 & +felspi(mgs)*dqci(mgs) &
19036 & +felvpi(mgs)*dqcw(mgs))*dtp
19045 IF ( itertd == 1 )
THEN
19048 thetatmp = thetaptmp + theta0(mgs)
19049 temgtmp = thetatmp*pk(mgs)
19050 qvaptmp = max((qvptmp + qv0(mgs)), 0.0)
19051 temcgtmp = temgtmp - tfr
19052 tqvcon = temgtmp-cbw
19053 ltemq = (temgtmp-163.15)/fqsat+1.5
19054 ltemq = min( nqsat, max(1,ltemq) )
19055 qvstmp = pqs(mgs)*tabqvs(ltemq)
19056 qisstmp = pqs(mgs)*tabqis(ltemq)
19057 qctmp(mgs) = max( 0.0, qctmp(mgs) )
19058 qitmp(mgs) = max( 0.0, qitmp(mgs) )
19059 qvtmp(mgs) = max( 0.0, qvaptmp )
19066 qctmp(mgs) = max( 0.0, qctmp(mgs) )
19067 qitmp(mgs) = max( 0.0, qitmp(mgs) )
19069 IF ( qitmp(mgs) < qitmp1 )
THEN
19070 qsimxsub(mgs) = (qitmp1 - qitmp(mgs))*dtpinv
19071 ELSEIF ( qitmp(mgs) > qitmp1 )
THEN
19072 qsimxdep(mgs) = (qitmp(mgs) - qitmp1)*dtpinv
19091 qsimxdep(mgs) = qvimxd(mgs)
19092 qsimxsub(mgs) = 1.e20
19113 IF ( icond .eq. 1 .or. temg(mgs) .le. tfrh &
19114 & .or. (qx(mgs,lr) .le. qxmin(lr) .and. qx(mgs,lc) .le. qxmin(lc)) )
THEN
19118 qisbv(mgs) = max( min(qidsv(mgs), 0.0), min( -qimxd(mgs), -0.5*qx(mgs,li)*dtpinv ) )
19119 IF ( temg(mgs) < tfr .or. .not. qsmlr(mgs) < 0.0 )
THEN
19120 qssbv(mgs) = max( min(qsdsv(mgs), 0.0), min( -qsmxd(mgs), -0.5*qx(mgs,ls)*dtpinv ) )
19122 qidpv(mgs) = max(qidsv(mgs), 0.0)
19123 qsdpv(mgs) = max(qsdsv(mgs), 0.0)
19125 IF ( qsmlr(mgs) < 0.0 .and. .not. mixedphase )
THEN
19127 qscev(mgs) = evapfac* &
19128 & 4.0*pi*(qx(mgs,lv)-qss0(mgs))*cx(mgs,ls)*swcap(mgs)*swvent(mgs)/(qss0(mgs)*(fav(mgs)+fbv(mgs)))
19129 qscev(mgs) = max( min(0.0,qscev(mgs)), min( -qsmxd(mgs), -0.5*qx(mgs,ls)*dtpinv ) )
19145 IF ( qx(mgs,lh) > qxmin(lh) )
THEN
19146 IF ( temg(mgs) < tfr .or. .not. qhmlr(mgs) < 0.0 )
THEN
19148 qhsbv(mgs) = max( min(qhdsv(mgs), 0.0), -qhmxd(mgs) )
19149 qhdpv(mgs) = max(qhdsv(mgs), 0.0)
19152 IF ( .true. .and. qhmlr(mgs) < 0.0 .and. .not. mixedphase )
THEN
19158 qhcev(mgs) = evapfac*2.0*pi*(qx(mgs,lv)-qss0(mgs))* &
19159 & cx(mgs,lh)*xdia(mgs,lh,1)*hwvent(mgs)/(qss0(mgs)*(fav(mgs)+fbv(mgs)))
19161 qhcev(mgs) = max(qhcev(mgs), -qhmxd(mgs))
19162 IF ( temg(mgs) > tfr ) qhcev(mgs) = min(0.0, qhcev(mgs) )
19170 IF ( lhl .gt. 1 )
THEN
19171 IF ( qx(mgs,lhl) > qxmin(lhl) )
THEN
19172 IF ( temg(mgs) < tfr .or. .not. qhlmlr(mgs) < 0.0 )
THEN
19173 qhlsbv(mgs) = max( min(qhldsv(mgs), 0.0), -qxmxd(mgs,lhl) )
19174 qhldpv(mgs) = max(qhldsv(mgs), 0.0)
19176 IF ( qhlmlr(mgs) < 0.0 .and. .not. mixedphase )
THEN
19178 qhlcev(mgs) = evapfac*2.0*pi*(qx(mgs,lv)-qss0(mgs))* &
19179 & cx(mgs,lhl)*xdia(mgs,lhl,1)*hlvent(mgs)/(qss0(mgs)*(fav(mgs)+fbv(mgs)))
19181 qhlcev(mgs) = max(qhlcev(mgs), -qhlmxd(mgs))
19182 IF ( temg(mgs) > tfr ) qhlcev(mgs) = min(0.0, qhlcev(mgs) )
19188 temp1 = qidpv(mgs) + qsdpv(mgs) + qhdpv(mgs) + qhldpv(mgs)
19194 IF ( temp1 .gt. qsimxdep(mgs) )
THEN
19195 frac = qsimxdep(mgs)/temp1
19197 qidpv(mgs) = frac*qidpv(mgs)
19198 qsdpv(mgs) = frac*qsdpv(mgs)
19199 qhdpv(mgs) = frac*qhdpv(mgs)
19200 qhldpv(mgs) = frac*qhldpv(mgs)
19209 temp1 = qisbv(mgs) + qssbv(mgs) + qhsbv(mgs) + qhlsbv(mgs)
19212 IF ( temp1 < -qsimxsub(mgs) )
THEN
19213 frac = -qsimxsub(mgs)/temp1
19215 qisbv(mgs) = frac*qisbv(mgs)
19216 qssbv(mgs) = frac*qssbv(mgs)
19217 qhsbv(mgs) = frac*qhsbv(mgs)
19218 qhlsbv(mgs) = frac*qhlsbv(mgs)
19231 if ( ipconc .ge. 1 )
then
19233 cssbv(mgs) = (cx(mgs,ls)/(qx(mgs,ls)+1.e-20))*qssbv(mgs)
19234 cisbv(mgs) = (cx(mgs,li)/(qx(mgs,li)+1.e-20))*qisbv(mgs)
19235 chsbv(mgs) = (cx(mgs,lh)/(qx(mgs,lh)+1.e-20))*qhsbv(mgs)
19236 IF ( lhl .gt. 1 ) chlsbv(mgs) = (cx(mgs,lhl)/(qx(mgs,lhl)+1.e-20))*qhlsbv(mgs)
19248 if (ndebug .gt. 0 )
write(0,*)
'conc 29a'
19253 if ( ipconc .ge. 4 .and. iscni .ge. 1 .and. qx(mgs,li) .gt. qxmin(li) )
then
19254 IF ( iscni .eq. 1 )
THEN
19256 & pi*rho0(mgs)*((0.25)/(6.0)) &
19257 & *eii(mgs)*(qx(mgs,li)**2)*(xdia(mgs,li,2)) &
19258 & *vtxbar(mgs,li,1)/xmas(mgs,li)
19259 cscni(mgs) = min(cimxd(mgs),qscni(mgs)*rho0(mgs)/xmas(mgs,li))
19260 cscnis(mgs) = 0.5*cscni(mgs)
19261 ELSEIF ( iscni .eq. 2 .or. iscni .eq. 4 .or. iscni .eq. 5 )
THEN
19262 IF ( iscni .ne. 5 .and. qidpv(mgs) .gt. 0.0 .and. xdia(mgs,li,3) .ge. 100.e-6 )
THEN
19267 qscni(mgs) = min(0.5, xdia(mgs,li,3)/200.e-6)*qidpv(mgs)
19271 cscni(mgs) = fscni*qscni(mgs)*rho0(mgs)/max(rho_qs*xvmn(ls),xmas(mgs,li))
19275 cscnis(mgs) = cscni(mgs)
19281 IF ( iscni .ne. 4 )
THEN
19284 tmp = ess(mgs)*rvt*aa2*cx(mgs,li)*cx(mgs,li)*xv(mgs,li)
19289 qscni(mgs) = qscni(mgs) + min( qxmxd(mgs,li), 2.0*tmp*xmas(mgs,li)*rhoinv(mgs) )
19290 cscni(mgs) = cscni(mgs) + min( cxmxd(mgs,li), 2.0*tmp )
19291 cscnis(mgs) = cscnis(mgs) + min( cxmxd(mgs,li), tmp )
19293 ELSEIF ( iscni .eq. 3 )
THEN
19294 qscni(mgs) = 0.001*eii(mgs)*max((qx(mgs,li)-1.e-3),0.0)
19295 qscni(mgs) = min(qscni(mgs),qxmxd(mgs,li))
19296 cscni(mgs) = qscni(mgs)*rho0(mgs)/xmas(mgs,li)
19297 cscnis(mgs) = 0.5*cscni(mgs)
19301 ELSEIF ( ipconc < 4 )
THEN
19303 qimax = rhoinv(mgs)*roqimax
19304 qscni(mgs) = min(0.90*qx(mgs,li), max( 0.0, (qx(mgs,li) - qimax)*dtpinv ) )
19306 qscni(mgs) = 0.001*eii(mgs)*max((qx(mgs,li)-1.e-3),0.0)
19307 qscni(mgs) = min(qscni(mgs),qxmxd(mgs,li))
19310 if ( iscni > 0 .and. qx(mgs,li) .gt. qxmin(li) )
then
19312 & pi*rho0(mgs)*((0.25)/(6.0)) &
19313 & *eii(mgs)*(qx(mgs,li)**2)*(xdia(mgs,li,2)) &
19314 & *vtxbar(mgs,li,1)/xmas(mgs,li)
19315 cscni(mgs) = min(cimxd(mgs),qscni(mgs)*rho0(mgs)/xmas(mgs,li))
19331 qsdry(mgs) = qsacr(mgs) + qsacw(mgs) &
19334 qhdry(mgs) = qhaci(mgs) + qhacs(mgs) &
19340 IF ( lhl .gt. 1 )
THEN
19341 qhldry(mgs) = qhlaci(mgs) + qhlacs(mgs) &
19351 IF ( tfrdry < temg(mgs) .and. temg(mgs) < tfr )
THEN
19362 IF ( incwet == 0 )
THEN
19364 & ( xdia(mgs,lh,1)*hwvent(mgs)*cx(mgs,lh)*fwet1(mgs) &
19365 & + fwet2(mgs)*(qhaci(mgs) + qhacs(mgs)) )
19366 qhwet(mgs) = max( 0.0, qhwet(mgs))
19374 IF ( lhl .gt. 1 )
THEN
19375 IF ( incwet == 0 )
THEN
19377 & ( xdia(mgs,lhl,1)*hlvent(mgs)*cx(mgs,lhl)*fwet1(mgs) &
19378 & + fwet2(mgs)*(qhlaci(mgs) + qhlacs(mgs)) )
19379 qhlwet(mgs) = max( 0.0, qhlwet(mgs))
19387 qhwet(mgs) = qhdry(mgs)
19388 qhlwet(mgs) = qhldry(mgs)
19410 wetsfc(:) = .false.
19411 wetgrowth(:) = .false.
19412 wetsfchl(:) = .false.
19413 wetgrowthhl(:) = .false.
19419 qhshr(mgs) = min( 0.0, qhwet(mgs) - qhdry(mgs) )
19423 qhlshr(mgs) = min( 0.0, qhlwet(mgs) - qhldry(mgs) )
19433 if ( temg(mgs) .lt. 243.15 )
then
19439 wetsfc(mgs) = .false.
19440 wetgrowth(mgs) = .false.
19441 wetsfchl(mgs) = .false.
19442 wetgrowthhl(mgs) = .false.
19447 if ( temg(mgs) .gt. tfr )
then
19449 IF ( .false. )
THEN
19450 qsshr(mgs) = -qsdry(mgs)
19451 qhshr(mgs) = -qhdry(mgs)
19452 qhlshr(mgs) = -qhldry(mgs)
19455 qsshr(mgs) = - qsacr(mgs) - qsacw(mgs)
19456 qhlshr(mgs) = - qhlacw(mgs) - qhlacr(mgs)
19457 qhshr(mgs) = - qhacw(mgs) - qhacr(mgs)
19461 vhshdr(mgs) = -vhacw(mgs) - vhacr(mgs)
19462 vhlshdr(mgs) = -vhlacw(mgs) - vhlacr(mgs)
19468 wetsfc(mgs) = (qhshr(mgs) .lt. 0.0 .and. temg(mgs) < tfr ) .or. ( qhmlr(mgs) < -qxmin(lh) .and. temg(mgs) > tfr )
19469 wetgrowth(mgs) = (qhshr(mgs) .lt. 0.0 .and. temg(mgs) < tfr )
19471 if (qhlshr(mgs) .lt. 0.0 .and. temg(mgs) < tfr )
THEN
19472 wetsfchl(mgs) = (qhlshr(mgs) .lt. 0.0 .and. temg(mgs) < tfr ) .or. ( qhlmlr(mgs) < -qxmin(lhl) .and. temg(mgs) > tfr )
19473 wetgrowthhl(mgs) = (qhlshr(mgs) .lt. 0.0 .and. temg(mgs) < tfr )
19478 if ( ipconc .ge. 1 )
then
19488 chshrr(mgs) = rho0(mgs)*qhshr(mgs)/(xdn(mgs,lr)*vshdgs(mgs,lh))
19494 IF ( lhl .gt. 1 )
THEN
19504 chlshrr(mgs) = rho0(mgs)*qhlshr(mgs)/(xdn(mgs,lr)*vshdgs(mgs,lhl))
19521 if ( qsshr(mgs) .lt. 0.0 )
then
19538 if ( wetgrowth(mgs) .or. (mixedphase .and. fhw(mgs) .gt. 0.05 .and. temg(mgs) .gt. 243.15) )
then
19543 IF ( lvol(lh) .gt. 1 .and. .not. mixedphase)
THEN
19545 IF ( iwetsoak )
THEN
19547 rimdn(mgs,lh) = xdnmx(lh)
19548 raindn(mgs,lh) = xdnmx(lh)
19549 vhacw(mgs) = qhacw(mgs)*rho0(mgs)/rimdn(mgs,lh)
19550 vhacr(mgs) = qhacr(mgs)*rho0(mgs)/raindn(mgs,lh)
19552 IF ( xdn(mgs,lh) .lt. xdnmx(lh) )
THEN
19555 v1 = (1. - xdn(mgs,lh)/xdnmx(lh))*vx(mgs,lh)/(dtp)
19557 v2 = rho0(mgs)*qhwet(mgs)/xdnmx(lh)
19559 vhsoak(mgs) = min(v1,v2)
19566 vhshdr(mgs) = min(0.0, rho0(mgs)*qhwet(mgs)/xdnmx(lh) - vhacw(mgs) - vhacr(mgs) )
19568 ELSEIF ( lvol(lh) .gt. 1 .and. mixedphase )
THEN
19581 IF ( ehi(mgs) .gt. 0.0 )
THEN
19582 qhaci(mgs) = min(qimxd(mgs),qhaci0(mgs))
19583 chaci(mgs) = min(cimxd(mgs),chaci0(mgs))
19585 IF ( ehs(mgs) .gt. 0.0 )
THEN
19587 qhacs(mgs) = min(qsmxd(mgs),qhacs0(mgs))
19588 chacs(mgs) = min(csmxd(mgs),chacs0(mgs))
19590 qhacs(mgs) = min(qsmxd(mgs),qhacs(mgs))
19594 wetsfc(mgs) = .true.
19604 if ( lhl > 1 .and. ( wetgrowthhl(mgs) .or. (mixedphase .and. fhlw(mgs) .gt. 0.05 .and. temg(mgs) .gt. 243.15) ) )
then
19616 IF ( lvol(lhl) .gt. 1 .and. .not. mixedphase )
THEN
19619 IF ( iwetsoak )
THEN
19621 rimdn(mgs,lhl) = xdnmx(lhl)
19622 raindn(mgs,lhl) = xdnmx(lhl)
19623 vhlacw(mgs) = qhlacw(mgs)*rho0(mgs)/rimdn(mgs,lhl)
19624 vhlacr(mgs) = qhlacr(mgs)*rho0(mgs)/raindn(mgs,lhl)
19626 IF ( xdn(mgs,lhl) .lt. xdnmx(lhl) )
THEN
19629 v1 = (1. - xdn(mgs,lhl)/xdnmx(lhl))*vx(mgs,lhl)/(dtp)
19631 v2 = rho0(mgs)*qhlwet(mgs)/xdnmx(lhl)
19632 IF ( v1 > v2 )
THEN
19648 vhlshdr(mgs) = min(0.0, rho0(mgs)*qhlwet(mgs)/xdnmx(lhl) - vhlacw(mgs) - vhlacr(mgs) )
19651 ELSEIF ( lvol(lhl) .gt. 1 .and. mixedphase )
THEN
19656 IF ( ehli(mgs) .gt. 0.0 )
THEN
19657 qhlaci(mgs) = min(qimxd(mgs),qhlaci0(mgs))
19658 chlaci(mgs) = min(cimxd(mgs),chlaci0(mgs))
19664 IF ( ehls(mgs) .gt. 0.0 )
THEN
19665 qhlacs(mgs) = min(qsmxd(mgs),qhlacs0(mgs))
19666 chlacs(mgs) = min(csmxd(mgs),chlacs0(mgs))
19675 wetsfchl(mgs) = .true.
19694 IF ( iglcnvi .ge. 1 )
THEN
19695 IF ( temg(mgs) .lt. 273.0 .and. qiacw(mgs) - qidpv(mgs) .gt. 0.0 )
THEN
19698 tmp = rimc1*(-((0.5)*(1.e+06)*xdia(mgs,lc,1)) &
19699 & *((0.60)*vtxbar(mgs,li,1)) &
19700 & /(temg(mgs)-273.15))**(rimc2)
19701 tmp = min( max( rimc3, tmp ), 900.0 )
19709 IF ( tmp .ge. 200.0 .or. iglcnvi >= 2 )
THEN
19710 r = max( 0.5*(xdn(mgs,li) + tmp), xdnmn(lh) )
19712 qhcni(mgs) = (qiacw(mgs) - qidpv(mgs))
19713 chcni(mgs) = cx(mgs,li)*qhcni(mgs)/qx(mgs,li)
19715 chcnih(mgs) = min(chcni(mgs), rho0(mgs)*qhcni(mgs)/(r*xvmn(lh)) )
19717 vhcni(mgs) = rho0(mgs)*qhcni(mgs)/r
19720 ELSEIF ( iglcnvi == 3 )
THEN
19722 IF ( temg(mgs) .lt. 273.0 .and. qiacw(mgs)*dtp > 2.*qxmin(lh) .and. gamice73fac*xmas(mgs,li) > xdnmn(lh)*xvmn(lh) )
THEN
19725 tmp = rimc1*(-((0.5)*(1.e+06)*xdia(mgs,lc,1)) &
19726 & *((0.60)*vtxbar(mgs,li,1)) &
19727 & /(temg(mgs)-273.15))**(rimc2)
19728 tmp = min( max( rimc3, tmp ), 900.0 )
19738 IF ( tmp .ge. xdnmn(lh) )
THEN
19739 r = max( 0.5*(xdn(mgs,li) + tmp), xdnmn(lh) )
19741 qhcni(mgs) = 0.5*qiacw(mgs)
19742 chcni(mgs) = qhcni(mgs)/(gamice73fac*xmas(mgs,li))
19743 chcnih(mgs) = min(chcni(mgs), rho0(mgs)*qhcni(mgs)/(r*xvmn(lh)) )
19745 vhcni(mgs) = rho0(mgs)*qhcni(mgs)/r
19771 IF ( lhl .gt. 1 )
THEN
19773 IF ( ihlcnh == 1 .or. ihlcnh == 3 )
THEN
19783 IF ( hlcnhdia > 0 )
THEN
19784 ltest = xdia(mgs,lh,3) .gt. hlcnhdia
19787 ltest = xdia(mgs,lh,1)*(4. + alpha(mgs,lh)) > abs( hlcnhdia )
19790 IF ( iusedw == 0 .and. ihlcnh == 1 )
THEN
19793 IF (((qhacw(mgs) + qhacr(mgs))*dtp > qxmin(lh) .and. qx(mgs,lh) > hlcnhqmin .and. temg(mgs) .le. tfr-2.0 &
19794 .and. temg(mgs) .gt. dwtempmin ) .or. ( wetgrowth(mgs) .and. qx(mgs,lh) > hlcnhqmin ) )
THEN
19798 x = 1.1e4 * rho0(mgs)*(ehw(mgs)*qx(mgs,lc)+ehr(mgs)*qx(mgs,lr)) - &
19799 1.3e3*rho0(mgs)*qx(mgs,li) + 1.0
19800 IF ( x > 1.e-20 )
THEN
19801 arg = min(70.0, (-temcg(mgs)/x ))
19802 dwr = 0.01*(exp(arg) - 1.0)
19807 IF ( dwr < 0.2 .and. dwr > 0.0 .and. rho0(mgs)*(qx(mgs,lc)+qx(mgs,lr)) > 1.e-4 )
THEN
19808 sqrtrhovt = sqrt( rhovt(mgs) )
19809 fventh = sqrtrhovt*(fpndl(mgs)**(1./3.)) * (fakvisc(mgs))**(-0.5)
19810 fventm = sqrtrhovt*(fschm(mgs)**(1./3.)) * (fakvisc(mgs))**(-0.5)
19811 ltemq = (tfr-163.15)/fqsat+1.5
19812 qvs0 = pqs(mgs)*tabqvs(ltemq)
19813 denomdp = felf(mgs) + fcw(mgs)*temcg(mgs)
19814 denominvdp = 1.d0/(felf(mgs) + fcw(mgs)*temcg(mgs))
19817 h1 = ( -ftka(mgs)*temcg(mgs) - felv(mgs)*fwvdf(mgs)*rho0(mgs)*(qx(mgs,lv) - qvs0) )
19818 h2 = ehi(mgs)*qx(mgs,li)*rho0(mgs)*fci(mgs)*temcg(mgs)
19819 h3 = max(dwehwmin, ehw(mgs))*qx(mgs,lc)
19820 h4 = ehr(mgs)* qx(mgs,lr)
19825 vth = axx(mgs,lh)*d**bxx(mgs,lh)
19826 x2 = fventh*sqrtrhovt*sqrt(d*vth)
19827 IF ( x2 > 1.4 )
THEN
19828 ah = 0.78 + 0.308*x2
19830 ah = 1.0 + 0.108*x2**2
19833 IF ( .false. )
THEN
19834 x1 = fventm*sqrtrhovt*sqrt(d*vth)
19835 IF ( x1 > 1.4 )
THEN
19836 am = 0.78 + 0.308*x1
19838 am = 1.0 + 0.108*x1**2
19841 d = 8.*denominvdp*( am*felv(mgs)*fwvdf(mgs)*rho0(mgs)*(qvs0 - qx(mgs,lv)) - ah*ftka(mgs)*temcg(mgs) )/ &
19842 (dtp* ( ( max(0.001,vth - vtxbar(mgs,lc,1))*h3 + &
19843 max(0.001,vth - vtxbar(mgs,lr,1))*h4) *rho0(mgs) + &
19844 max(0.001,vth - vtxbar(mgs,li,1))*h2*denominvdp))
19851 ( ( max(0.001,vth - vtxbar(mgs,lc,1))*h3 + &
19852 max(0.001,vth - vtxbar(mgs,lr,1))*h4) *rho0(mgs)*denomdp + &
19853 max(0.001,vth - vtxbar(mgs,li,1))*h2)
19856 IF ( abs(dold - d)/dold < 0.05 .or. ( n > 3 .and. d > dg0thresh ) )
EXIT
19861 dg0(mgs) = min( dwmax, max( d, dwmin ) )
19863 IF ( qx(mgs,lh) > qxmin(lh) .and. qx(mgs,lh) > hlcnhqmin .and. temg(mgs) .le. tfr-2.0 )
THEN
19866 dg0(mgs) = dg0thresh + 0.0001
19870 IF ( ihlcnh == 3 .and. (qhacw(mgs) + qhacr(mgs))*dtp > qxmin(lh) .and. qx(mgs,lh) > hlcnhqmin &
19871 .and. temg(mgs) .le. tfr-2.0 )
THEN
19873 dg0(mgs) = min( dg0(mgs), dg0thresh - 0.0001 )
19878 wtest = (dg0(mgs) > 0.0 .and. dg0(mgs) < dg0thresh )
19880 IF ( ihlcnh == 1 )
THEN
19882 IF ( ( wetgrowth(mgs) .and. (xdn(mgs,lh) .gt. hldnmn .or. lvh < 1 ) .and. &
19883 & rimdn(mgs,lh) .gt. 800. .and. &
19884 & ltest .and. qx(mgs,lh) .gt. hlcnhqmin ) .or. wtest )
THEN
19887 IF ( qhacw(mgs) .gt. 0.0 .and. qhacw(mgs) .gt. qhaci(mgs) .and. temg(mgs) .le. tfr-2.0 )
THEN
19894 x = (1.1e4*(rho0(mgs)*qx(mgs,lc)) - 1.3e3*rho0(mgs)*qx(mgs,li) + 1.0e-3 )
19895 IF ( x > 1.e-20 )
THEN
19896 arg = min(70.0, (-temcg(mgs)/x ))
19897 dh0 = 0.01*(exp(arg) - 1.0)
19906 IF ( xdia(mgs,lh,3)/dh0 .gt. 0.1 )
THEN
19908 tmp = qhacw(mgs) + qhacr(mgs) + qhaci(mgs) + qhacs(mgs)
19910 qtmp = min( 100.0, xdia(mgs,lh,3)/(2.0*dh0) )*(tmp)
19911 qhlcnh(mgs) = min( qxmxd(mgs,lh), qtmp )
19913 IF ( ipconc .ge. 5 )
THEN
19915 IF ( .not. wtest ) dh0 = min( dh0, 10.e-3 )
19916 IF ( qx(mgs,lhl) > 0.1e-3 ) dh0 = max( dh0, xdia(mgs,lhl,3) )
19917 chlcnhhl(mgs) = min( cxmxd(mgs,lh), rho0(mgs)*qhlcnh(mgs)/(pi*xdn(mgs,lh)*dh0**3/6.0) )
19919 r = rho0(mgs)*qhlcnh(mgs)/(xdn(mgs,lh)*xv(mgs,lh))
19920 chlcnh(mgs) = max( chlcnhhl(mgs), r )
19923 vhlcnh(mgs) = rho0(mgs)*qhlcnh(mgs)/xdn(mgs,lh)
19924 vhlcnhl(mgs) = rho0(mgs)*qhlcnh(mgs)/max(xdnmn(lhl), xdn(mgs,lh))
19931 ELSEIF ( ihlcnh == 3 )
THEN
19935 ( qhacw(mgs)*dtp > qxmin(lh) .and. temg(mgs) .lt. tfr-2. .and. qx(mgs,lh) > hlcnhqmin ) )
THEN
19937 IF ( ipconc == 5 )
THEN
19942 ratio = min( maxratiolu, dg0(mgs)/xdia(mgs,lh,1) )
19946 tmp2 =
gaminterp(ratio,alpha(mgs,lh),4,1)
19947 IF ( ipconc == 5 )
THEN
19950 qxd1 = qx(mgs,lh)*(tmp2)
19951 qhlcnh(mgs) = dtpinv*qxd1
19953 tmp3 = qxmxd(mgs,lh)
19954 IF (qxd1 > tmp3 )
THEN
19961 IF ( ( qxd1 > qxmin(lhl) .and. ipconc > 5 ) .or. ( qxd1 > 10.*qxmin(lhl) .and. ipconc == 5) )
THEN
19964 tmp =
gaminterp(ratio,alpha(mgs,lh),1,1)
19965 IF ( ipconc == 5 )
THEN
19968 cxd1 = flim*cx(mgs,lh)*( tmp)
19969 chlcnh(mgs) = dtpinv*cxd1
19970 chlcnhhl(mgs) = chlcnh(mgs)
19972 IF ( qx(mgs,lhl) > qxmin(lhl) .and. dmhlopt > 0 )
THEN
19973 tmp = rho0(mgs)*qhlcnh(mgs)/chlcnhhl(mgs)
19974 IF ( tmp < xmas(mgs,lhl) )
THEN
19976 dh0 = (( qxd1*tmp**(1./3.) + qx(mgs,lhl)*xmas(mgs,lhl)**(1./3.))/( qxd1 + qx(mgs,lhl)))**3
19977 chlcnhhl(mgs) = min( chlcnhhl(mgs), rho0(mgs)*qhlcnh(mgs)/dh0 )
19985 IF ( ipconc >= 6 .and. lzh > 1 .and. lzhl > 1 )
THEN
19986 tmp3 =
gaminterp(ratio,alpha(mgs,lh),11,1)
19987 zxd1 = flim*zx(mgs,lh)*(tmp3)
19988 zhlcnh(mgs) = dtpinv*zxd1
19997 vhlcnh(mgs) = rho0(mgs)*qhlcnh(mgs)/xdn(mgs,lh)
19998 vhlcnhl(mgs) = rho0(mgs)*qhlcnh(mgs)/max(xdnmn(lhl), xdn(mgs,lh))
20007 ELSEIF ( ihlcnh == 2 )
THEN
20018 IF ( qhacw(mgs)*dtp > qxmin(lh) .and. temg(mgs) .lt. tfr-2. .and. qx(mgs,lh) > qxmin(lh) )
THEN
20019 ratio = min( maxratiolu, hldia1/xdia(mgs,lh,1) )
20022 tmp =
gaminterp(ratio,alpha(mgs,lh),1,1)
20023 cxd1 = cx(mgs,lh)*( tmp)
20024 chlcnh(mgs) = dtpinv*cxd1
20025 chlcnhhl(mgs) = chlcnh(mgs)
20028 tmp2 =
gaminterp(ratio,alpha(mgs,lh),4,1)
20029 qxd1 = qx(mgs,lh)*(tmp2)
20030 qhlcnh(mgs) = dtpinv*qxd1
20033 IF ( lzh > 1 .and. lzhl > 1 )
THEN
20034 tmp3 =
gaminterp(ratio,alpha(mgs,lh),11,1)
20035 zxd1 = zx(mgs,lh)*(tmp3)
20036 zhlcnh(mgs) = dtpinv*zxd1
20040 vhlcnh(mgs) = rho0(mgs)*qhlcnh(mgs)/xdn(mgs,lh)
20041 vhlcnhl(mgs) = rho0(mgs)*qhlcnh(mgs)/max(xdnmn(lhl), xdn(mgs,lh))
20047 ELSEIF ( ihlcnh == 0 )
THEN
20052 if ( wetgrowth(mgs) .and. temg(mgs) .lt. tfr-5. .and. qx(mgs,lh) > qxmin(lh) )
then
20053 if ( qhacw(mgs).gt.1.e-6 .and. xdn(mgs,lh) > 700. )
then
20055 ((pi*xdn(mgs,lh)*cx(mgs,lh)) / (6.0*rho0(mgs)*dtp)) &
20056 *exp(-hldia1/xdia(mgs,lh,1)) &
20057 *( (hldia1**3) + 3.0*(hldia1**2)*xdia(mgs,lh,1) &
20058 + 6.0*(hldia1)*(xdia(mgs,lh,1)**2) + 6.0*(xdia(mgs,lh,1)**3) )
20059 qhlcnh(mgs) = min(qhlcnh(mgs),qhmxd(mgs))
20060 IF ( ipconc .ge. 5 )
THEN
20061 chlcnh(mgs) = min( cxmxd(mgs,lh), cx(mgs,lh)*exp(-hldia1/xdia(mgs,lh,1)))
20062 chlcnhhl(mgs) = chlcnh(mgs)
20065 vhlcnh(mgs) = rho0(mgs)*qhlcnh(mgs)/xdn(mgs,lh)
20066 vhlcnhl(mgs) = rho0(mgs)*qhlcnh(mgs)/max(xdnmn(lhl), xdn(mgs,lh))
20076 IF ( icvhl2h >= 1 )
THEN
20078 IF ( qx(mgs,lhl) > qxmin(lhl) .and. xdn(mgs,lhl) < 0.5*(xdnmn(lhl) + xdnmx(lhl)) )
THEN
20079 tmp = min(0.95, 1. - 0.5*(1. + tanh(0.125*(xdn(mgs,lhl) - 1.01*xdnmn(lhl) )) ))
20080 qhcnhl(mgs) = tmp*qx(mgs,lhl)*dtpinv
20081 chcnhl(mgs) = cx(mgs,lhl)*qhcnhl(mgs)/qx(mgs,lhl)
20082 vhcnhl(mgs) = vx(mgs,lhl)*qhcnhl(mgs)/qx(mgs,lhl)
20108 IF ( ipconc .ge. 5 )
THEN
20111 IF ( temg(mgs) < tfr .and. qx(mgs,lh) .gt. qxmin(lh) .and. qhdpv(mgs) > qxmin(lh)*dtpinv &
20112 & .and. qhacw(mgs) < qxmin(lh)*dtpinv )
THEN
20113 IF ( xdn(mgs,lh) < 290. )
THEN
20121 IF ( qx(mgs,ls) .gt. qxmin(ls) .and. qsacw(mgs) .gt. 0.0 )
THEN
20140 IF ( iglcnvs .eq. 1 )
THEN
20142 dnnet = cscnvis(mgs) + cscnis(mgs) - csacs(mgs)
20143 dqnet = qscnvi(mgs) + qscni(mgs) + qsacw(mgs) + qsdpv(mgs) + qssbv(mgs)
20145 a3 = 1./(rho0(mgs)*qx(mgs,ls))
20146 a1 = exp( - xdn(mgs,ls)*cx(mgs,ls)*vgra*a3 )
20148 a2 = (1.-(cx(mgs,ls)*vgra*xdn(mgs,ls)*a3))*dnnet
20150 a4 = cx(mgs,ls)**2*vgra*xdn(mgs,ls)*a3/qx(mgs,ls)*dqnet
20152 chcns(mgs) = max( 0.0, a1*(a2 + a4) )
20153 chcns(mgs) = min( chcns(mgs), cxmxd(mgs,ls) )
20154 chcnsh(mgs) = chcns(mgs)
20156 qhcns(mgs) = min( xdn(mgs,ls)*vgra*rhoinv(mgs)*chcns(mgs), qxmxd(mgs,ls) )
20157 vhcns(mgs) = rho0(mgs)*qhcns(mgs)/max(xdn(mgs,ls),xdnmn(lh))
20160 ELSEIF ( iglcnvs .ge. 2 )
THEN
20162 IF ( temg(mgs) .lt. 273.0 .and. ( qsacw(mgs) - qsdpv(mgs) .gt. 0.0 .or. &
20163 ( iglcnvs >= 3 .and. qsacw(mgs)*dtp > 2.*qxmin(lh) .and. gamsnow73fac*xmas(mgs,ls) > xdnmn(lh)*xvmn(lh) ) ) )
THEN
20166 tmp = rimc1*(-((0.5)*(1.e+06)*xdia(mgs,lc,1)) &
20167 & *((0.60)*vtxbar(mgs,ls,1)) &
20168 & /(temg(mgs)-273.15))**(rimc2)
20170 tmp = min( tmp , 900.0 )
20178 IF ( iglcnvs == 2 )
THEN
20179 IF ( tmp .ge. 200.0 )
THEN
20180 r = max( 0.5*(xdn(mgs,ls) + tmp), xdnmn(lh) )
20182 qhcns(mgs) = (qsacw(mgs) - qsdpv(mgs))
20183 chcns(mgs) = cx(mgs,ls)*qhcns(mgs)/qx(mgs,ls)
20185 chcnsh(mgs) = min(chcns(mgs), rho0(mgs)*qhcns(mgs)/(r*xvmn(lh)) )
20187 vhcns(mgs) = rho0(mgs)*qhcns(mgs)/r
20190 ELSEIF ( iglcnvs == 3 )
THEN
20195 IF ( tmp > xdnmn(lh) )
THEN
20196 r = max( 0.5*(xdn(mgs,ls) + tmp), xdnmn(lh) )
20198 qhcns(mgs) = 0.5*qsacw(mgs)
20199 chcns(mgs) = qhcns(mgs)/(gamsnow73fac*xmas(mgs,ls))
20200 chcns(mgs) = min( chcns(mgs), cx(mgs,ls)*qhcns(mgs)/qx(mgs,ls))
20201 chcnsh(mgs) = min(chcns(mgs), rho0(mgs)*qhcns(mgs)/(r*xvmn(lh)) )
20202 vhcns(mgs) = rho0(mgs)*qhcns(mgs)/r
20216 qhcns(mgs) = 0.001*ehscnv(mgs)*max((qx(mgs,ls)-6.e-4),0.0)
20217 qhcns(mgs) = min(qhcns(mgs),qxmxd(mgs,ls))
20218 IF ( lvol(lh) .ge. 1 ) vhcns(mgs) = rho0(mgs)*qhcns(mgs)/max(xdn(mgs,ls),400.)
20228 if ( irwfrz .gt. 0 .and. .not. mixedphase)
then
20234 qrztot(mgs) = qrfrz(mgs) + qiacr(mgs) + qsacr(mgs)
20240 & ( xdia(mgs,lr,1)*rwvent(mgs)*cx(mgs,lr)*fwet1(mgs) )
20241 qrzmax(mgs) = max(qrzmax(mgs), 0.0)
20242 qrzmax(mgs) = min(qrztot(mgs), qrzmax(mgs))
20243 qrzmax(mgs) = min(qx(mgs,lr)*dtpinv, qrzmax(mgs))
20245 IF ( temcg(mgs) < -30. )
THEN
20246 qrzmax(mgs) = qx(mgs,lr)*dtpinv
20253 IF ( qrztot(mgs) .gt. qrzmax(mgs) .and. qrztot(mgs) .gt. qxmin(lr) )
THEN
20254 qrzfac(mgs) = qrzmax(mgs)/(qrztot(mgs))
20258 qrzfac(mgs) = min(1.0, qrzfac(mgs))
20267 if ( temg(mgs) .le. 273.15 .and. qrzfac(mgs) .lt. 1.0 )
then
20268 qrfrz(mgs) = qrzfac(mgs)*qrfrz(mgs)
20269 qrfrzs(mgs) = qrzfac(mgs)*qrfrzs(mgs)
20270 qrfrzf(mgs) = qrzfac(mgs)*qrfrzf(mgs)
20271 qiacr(mgs) = qrzfac(mgs)*qiacr(mgs)
20272 qsacr(mgs) = qrzfac(mgs)*qsacr(mgs)
20273 qiacrf(mgs) = qrzfac(mgs)*qiacrf(mgs)
20274 qiacrs(mgs) = qrzfac(mgs)*qiacrs(mgs)
20275 crfrz(mgs) = qrzfac(mgs)*crfrz(mgs)
20276 crfrzf(mgs) = qrzfac(mgs)*crfrzf(mgs)
20277 crfrzs(mgs) = qrzfac(mgs)*crfrzs(mgs)
20278 ciacr(mgs) = qrzfac(mgs)*ciacr(mgs)
20279 ciacrf(mgs) = qrzfac(mgs)*ciacrf(mgs)
20280 ciacrs(mgs) = qrzfac(mgs)*ciacrs(mgs)
20287 vrfrzf(mgs) = qrzfac(mgs)*vrfrzf(mgs)
20288 viacrf(mgs) = qrzfac(mgs)*viacrf(mgs)
20308 IF ( qx(mgs,lr) .gt. qxmin(lr) )
THEN
20311 & fvce(mgs)*cx(mgs,lr)*rwvent(mgs)*rwcap(mgs)*evapfac
20313 IF ( rcond .eq. 1 )
THEN
20314 qrcev(mgs) = min(qrcev(mgs), qxmxd(mgs,lv))
20317 qrcev(mgs) = min(qrcev(mgs), 0.0)
20320 qrcev(mgs) = max(qrcev(mgs), -qrmxd(mgs))
20322 IF ( qrcev(mgs) .lt. 0. .and. lnr > 1 )
THEN
20325 IF ( icrcev == 1 )
THEN
20326 crcev(mgs) = (cx(mgs,lr)/(qx(mgs,lr)))*qrcev(mgs)
20327 ELSEIF ( icrcev == 2 )
THEN
20328 crcev(mgs) = (cx(mgs,lr)/(qx(mgs,lr)))*qrcev(mgs)*vtxbar(mgs,lr,2)/vtxbar(mgs,lr,1)
20343 IF ( lhwlg > 1 )
THEN
20347 IF ( lhlwlg > 1 )
THEN
20369 ltest = qx(mgs,lh) .gt. qxmin(lh)
20370 IF ( lhl > 1 ) ltest = ltest .or. qx(mgs,lhl) .gt. qxmin(lhl)
20372 IF ( (itype1 .ge. 1 .or. itype2 .ge. 1 ) &
20373 & .and. qx(mgs,lc) .gt. qxmin(lc))
THEN
20374 if ( temg(mgs) .ge. 265.15 .and. temg(mgs) .le. 271.15 )
then
20375 IF ( ipconc .ge. 2 )
THEN
20376 IF ( xv(mgs,lc) .gt. 0.0 &
20383 IF ( alpha(mgs,lc) == 0.0 )
THEN
20384 ex1 = (1./250.)*exp(-7.23e-15/xv(mgs,lc))
20387 ratio = (1. + alpha(mgs,lc))*(7.23e-15)/xv(mgs,lc)
20389 IF ( usegamxinfcnu )
THEN
20390 i = nint(dgami*(1. + alpha(mgs,lc)))
20392 ex1 = (1./250.)*
gamxinf(1.+alpha(mgs,lc), ratio)/(gcnup1)
20394 ratio = min( maxratiolu, ratio )
20395 tmp =
gaminterp(ratio,alpha(mgs,lc),1,1)
20396 ex1 = (1./250.)*tmp
20399 IF ( itype2 .le. 2 )
THEN
20400 ft = max(0.0,min(1.0,-0.11*temcg(mgs)**2 - 1.1*temcg(mgs)-1.7))
20402 IF ( temg(mgs) .ge. 265.15 .and. temg(mgs) .le. 267.15 )
THEN
20404 ELSEIF (temg(mgs) .ge. 267.15 .and. temg(mgs) .le. 269.15 )
THEN
20406 ELSEIF (temg(mgs) .ge. 269.15 .and. temg(mgs) .le. 271.15 )
THEN
20415 IF ( ft > 0.0 )
THEN
20417 IF ( itype2 > 0 )
THEN
20418 IF ( qx(mgs,lh) .gt. qxmin(lh) .and. (.not. wetsfc(mgs)) )
THEN
20419 chmul1(mgs) = ft*ex1*chacw(mgs)
20421 qhmul1(mgs) = cimas0*chmul1(mgs)*rhoinv(mgs)
20423 IF ( lhl .gt. 1 )
THEN
20424 IF ( qx(mgs,lhl) .gt. qxmin(lhl) .and. (.not. wetsfchl(mgs)) )
THEN
20425 chlmul1(mgs) = (ft*ex1*chlacw(mgs))
20426 qhlmul1(mgs) = cimas0*chlmul1(mgs)*rhoinv(mgs)
20431 IF ( itype1 > 0 )
THEN
20432 IF ( qx(mgs,lh) .gt. qxmin(lh) .and. (.not. wetsfc(mgs)) )
THEN
20433 tmp = ft*(3.5e+08)*rho0(mgs)*qhacw(mgs)
20434 chmul1(mgs) = chmul1(mgs) + tmp
20435 qhmul1(mgs) = qhmul1(mgs) + cimas0*tmp*rhoinv(mgs)
20437 IF ( lhl .gt. 1 )
THEN
20438 IF ( qx(mgs,lhl) .gt. qxmin(lhl) .and. (.not. wetsfchl(mgs)) )
THEN
20439 tmp = ft*(3.5e+08)*rho0(mgs)*qhlacw(mgs)
20440 chlmul1(mgs) = chlmul1(mgs) + tmp
20441 qhlmul1(mgs) = qhlmul1(mgs) + cimas0*tmp*rhoinv(mgs)
20459 if ( temg(mgs) .ge. 268.15 .and. temg(mgs) .le. 270.15 )
then
20460 fimt1(mgs) = 1.0 -(temg(mgs)-268.15)/2.0
20461 elseif (temg(mgs) .le. 268.15 .and. temg(mgs) .ge. 265.15 )
then
20462 fimt1(mgs) = 1.0 +(temg(mgs)-268.15)/3.0
20469 if ( temg(mgs) .ge. 265.15 .and. temg(mgs) .le. 267.15 )
then
20471 elseif (temg(mgs) .ge. 267.15 .and. temg(mgs) .le. 269.15 )
then
20473 elseif (temg(mgs) .ge. 269.15 .and. temg(mgs) .le. 271.15 )
then
20484 IF ( itype1 .ge. 1 )
THEN
20485 fimta(mgs) = (3.5e+08)*rho0(mgs)
20498 xcwmas = xmas(mgs,lc) * 1000.
20500 IF ( itype2 .ge. 1 )
THEN
20501 if ( xcwmas.lt.1.26e-9 )
then
20504 if ( xcwmas .le. 3.55e-9 .and. xcwmas .ge. 1.26e-9 )
then
20505 fimt2(mgs) = (2.27)*alog(xcwmas) + 13.39
20507 if ( xcwmas .gt. 3.55e-9 )
then
20511 fimt2(mgs) = min(fimt2(mgs),1.0)
20512 fimt2(mgs) = max(fimt2(mgs),0.0)
20526 IF ( .not. wetsfc(mgs) )
THEN
20527 chmul1(mgs) = fimt1(mgs)*(fimta(mgs) + &
20528 & (4.0e-03)*fimt2(mgs))*qhacw(mgs)
20531 qhmul1(mgs) = chmul1(mgs)*(cimas0/rho0(mgs))
20533 IF ( lhl .gt. 1 )
THEN
20534 IF ( qx(mgs,lhl) .gt. qxmin(lhl) .and. (.not. wetsfchl(mgs)) )
THEN
20535 tmp = fimt1(mgs)*(fimta(mgs) + &
20536 & (4.0e-03)*fimt2(mgs))*qhlacw(mgs)
20538 qhlmul1(mgs) = cimas0*tmp*rhoinv(mgs)
20566 IF ( isnwfrac /= 0 )
THEN
20568 IF (temg(mgs) .gt. 265.0)
THEN
20569 if (xdia(mgs,ls,1) .gt. 100.e-6 .and. xdia(mgs,ls,1) .lt. 2.0e-3)
then
20571 tmp = rhoinv(mgs)*pi*xdn(mgs,ls)*cx(mgs,ls)*(500.e-6)**3
20572 qsmul(mgs) = max( kfrag*( qx(mgs,ls) - tmp ) , 0.0 )
20574 qsmul(mgs) = min( qxmxd(mgs,li), qsmul(mgs) )
20575 csmul(mgs) = min( cxmxd(mgs,li), rho0(mgs)*qsmul(mgs)/mfrag )
20592 qracif(mgs) = qraci(mgs)
20593 cracif(mgs) = craci(mgs)
20628 IF ( icenucopt == 1 .or. icenucopt == -10 .or. icenucopt == -11 )
THEN
20629 if ( ( temg(mgs) .lt. 268.15 .or. &
20631 & ( imeyers5 .and. temg(mgs) .lt. 272.0 .and. temgkm2(mgs) .lt. tfr) ) .and. &
20632 & ciintmx .gt. (cx(mgs,li)+ccitmp) &
20635 fiinit(mgs) = (felv(mgs)**2)/(cp*rw)
20636 dqisdt(mgs) = (qx(mgs,lv)-qis(mgs))/ &
20637 & (1.0 + fiinit(mgs)*qis(mgs)/tsqr(mgs))
20640 if ( ssi(mgs) .gt. 1.0 )
THEN
20642 dzfacp = max( float(kgsp(mgs)-kgs(mgs)), 0.0 )
20643 dzfacm = max( float(kgs(mgs)-kgsm(mgs)), 0.0 )
20646 & *(cmassin/rho0(mgs)) &
20647 & *max(0.0,wvel(mgs)) &
20648 & *max((cninp(mgs)-cninm(mgs)),0.0)/gz(igs(mgs),jgs,kgs(mgs)) &
20649 & /((dzfacp+dzfacm))
20651 qiint(mgs) = min(qiint(mgs), max(0.25*dqisdt(mgs),0.0))
20652 ciint(mgs) = qiint(mgs)*rho0(mgs)/cmassin
20660 IF ( icenucopt /= -10 )
THEN
20662 IF ( lcin > 1 )
THEN
20663 ciint(mgs) = min(ciint(mgs), ccin(mgs)*dtpinv)
20664 ccin(mgs) = ccin(mgs) - ciint(mgs)*dtp
20665 qiint(mgs) = ciint(mgs)*cmassin/rho0(mgs)
20666 ELSEIF ( lcina > 1 )
THEN
20667 ciint(mgs) = max(0.0, min( ciint(mgs), min( cnina(mgs), ciintmx ) - cina(mgs) ))
20668 qiint(mgs) = ciint(mgs)*cmassin/rho0(mgs)
20670 ELSEIF ( icenucopt == 1 .and. ciint(mgs) .gt. max(0.0, ciintmx - cx(mgs,li) - ccitmp )*dtpinv )
THEN
20671 ciint(mgs) = max(0.0, ciintmx - (cx(mgs,li)) )*dtpinv
20672 qiint(mgs) = ciint(mgs)*cmassin/rho0(mgs)
20674 ELSEIF ( icenucopt == -11 .and. dtp*ciint(mgs) .gt. ( cnina(mgs) - (cx(mgs,li) - ccitmp)))
THEN
20675 ciint(mgs) = max(0.0, cnina(mgs) - (cx(mgs,li)+ccitmp)*dtpinv )
20676 qiint(mgs) = ciint(mgs)*cmassin/rho0(mgs)
20684 ELSEIF ( icenucopt == 2 .or. icenucopt == -1 .or. icenucopt == -2 )
THEN
20686 IF ( ( temg(mgs) .lt. 268.15 .and. ssw(mgs) > 1.0 ) .or. ssi(mgs) > 1.25 )
THEN
20687 IF ( lcin > 1 )
THEN
20688 ciint(mgs) = min(cnina(mgs), ccin(mgs))
20689 ciint(mgs) = min( ciint(mgs), max(0.0, ciintmx - (cx(mgs,li) - ccitmp) ) )
20690 ccin(mgs) = ccin(mgs) - ciint(mgs)
20691 ciint(mgs) = ciint(mgs)*dtpinv
20693 ciint(mgs) = max( 0.0, cnina(mgs) - cina(mgs) )*dtpinv
20695 qiint(mgs) = ciint(mgs)*cmassin/rho0(mgs)
20697 fiinit(mgs) = (felv(mgs)**2)/(cp*rw)
20698 dqisdt(mgs) = (qx(mgs,lv)-qis(mgs))/(1.0 + fiinit(mgs)*qis(mgs)/tsqr(mgs))
20699 qiint(mgs) = min(qiint(mgs), max(0.25*dqisdt(mgs),0.0))
20700 ciint(mgs) = qiint(mgs)*rho0(mgs)/cmassin
20705 ELSEIF ( icenucopt == 3 .or. icenucopt == 4 .or. icenucopt == 10 )
THEN
20706 IF ( temg(mgs) .lt. 268.15 )
THEN
20707 IF ( lcin > 1 )
THEN
20708 ciint(mgs) = min(cnina(mgs), ccin(mgs))
20709 ciint(mgs) = min( ciint(mgs), max(0.0, ciintmx - (cx(mgs,li) + ccitmp) ) )
20710 ccin(mgs) = ccin(mgs) - ciint(mgs)
20711 ciint(mgs) = ciint(mgs)*dtpinv
20713 ciint(mgs) = max( 0.0, cnina(mgs) - cina(mgs) )*dtpinv
20715 qiint(mgs) = ciint(mgs)*cmassin/rho0(mgs)
20720 if ( xplate(mgs) .eq. 1 )
then
20721 qipipnt(mgs) = qiint(mgs)
20722 cipint(mgs) = ciint(mgs)
20725 if ( xcolmn(mgs) .eq. 1 )
then
20726 qicicnt(mgs) = qiint(mgs)
20727 cicint(mgs) = ciint(mgs)
20740 if (ndebug .gt. 0 )
write(0,*)
'dbg = 8'
20743 if (ndebug .gt. 0 )
write(0,*)
'Collection: set 3-component'
20775 qrshr(mgs) = qsshr(mgs) + qhshr(mgs) + qhlshr(mgs)
20776 crshr(mgs) = chshrr(mgs)/rzxh(mgs) + chlshrr(mgs)/rzxhl(mgs)
20779 IF ( ipconc .ge. 3 )
THEN
20791 IF ( ipconc .ge. 1 )
THEN
20822 IF ( warmonly < 0.5 )
THEN
20823 IF ( ffrzs < 1.0 )
THEN
20826 & il5(mgs)*cicint(mgs) &
20827 & +il5(mgs)*((1.0-cwfrz2snowfrac)*cwfrzc(mgs)+cwctfzc(mgs) &
20831 & + csplinter(mgs) + csplinter2(mgs) &
20834 pccii(mgs) = pccii(mgs)*(1.0 - ffrzs)
20838 & il5(mgs)*(-cscni(mgs) - cscnvi(mgs) &
20841 & -chaci(mgs) - chlaci(mgs) &
20843 & +il5(mgs)*cisbv(mgs) &
20844 & -(1.-il5(mgs))*cimlr(mgs)
20846 pccin(mgs) = ciint(mgs)
20851 ELSEIF ( warmonly < 0.8 )
THEN
20859 & il5(mgs)*cicint(mgs) &
20860 & +il5(mgs)*((1.0-cwfrz2snowfrac)*cwfrzc(mgs)+cwctfzc(mgs) &
20864 & + csplinter(mgs) + csplinter2(mgs) &
20867 pccii(mgs) = pccii(mgs)*(1. - ffrzs)
20874 & +il5(mgs)*cisbv(mgs) &
20875 & -(1.-il5(mgs))*cimlr(mgs)
20877 pccin(mgs) = ciint(mgs)
20887 IF ( ipconc .ge. 2 )
THEN
20890 pccwi(mgs) = (0.0) - cwshw(mgs)
20892 IF ( warmonly < 0.5 )
THEN
20895 & il5(mgs)*(-ciacw(mgs)-cwfrz(mgs)-cwctfzp(mgs) &
20898 & -cracw(mgs) -csacw(mgs) -chacw(mgs) - chlacw(mgs)
20901 ELSEIF ( warmonly < 0.8 )
THEN
20905 & -ciacw(mgs)-cwfrz(mgs)-cwctfzp(mgs) &
20908 & -cracw(mgs) -chacw(mgs) -chlacw(mgs)
20925 & - cautn(mgs) -cracw(mgs)
20929 IF ( .false. .and. exwmindiam > 0.0 .and. ccwresv(mgs) > 0.0 )
THEN
20931 & il5(mgs)*(-ciacw(mgs) &
20933 & -cracw(mgs) -csacw(mgs) -chacw(mgs) - chlacw(mgs)
20935 IF ( -pccwdacc(mgs)*dtp .gt. cx(mgs,lc) - ccwresv(mgs) )
THEN
20937 frac = -(cx(mgs,lc) - ccwresv(mgs) )/(pccwdacc(mgs)*dtp)
20938 pccwdacc(mgs) = -(cx(mgs,lc) - ccwresv(mgs) )*dtpinv
20940 ciacw(mgs) = frac*ciacw(mgs)
20941 cracw(mgs) = frac*cracw(mgs)
20942 csacw(mgs) = frac*csacw(mgs)
20943 chacw(mgs) = frac*chacw(mgs)
20944 cautn(mgs) = frac*cautn(mgs)
20946 IF ( lhl .gt. 1 ) chlacw(mgs) = frac*chlacw(mgs)
20951 & il5(mgs)*(-ciacw(mgs)-cwfrzp(mgs)-cwctfzp(mgs) &
20952 & -cwfrzc(mgs)-cwctfzc(mgs) &
20953 & -il5(mgs)*(ciihr(mgs)) &
20955 & -cracw(mgs) -csacw(mgs) -chacw(mgs) - chlacw(mgs)
20962 IF ( -pccwd(mgs)*dtp .gt. cx(mgs,lc) )
THEN
20969 frac = -cx(mgs,lc)/(pccwd(mgs)*dtp)
20970 pccwd(mgs) = -cx(mgs,lc)*dtpinv
20972 ciacw(mgs) = frac*ciacw(mgs)
20973 cwfrz(mgs) = frac*cwfrz(mgs)
20974 cwfrzp(mgs) = frac*cwfrzp(mgs)
20975 cwctfzp(mgs) = frac*cwctfzp(mgs)
20976 cwfrzc(mgs) = frac*cwfrzc(mgs)
20977 cwctfzc(mgs) = frac*cwctfzc(mgs)
20978 cwctfz(mgs) = frac*cwctfz(mgs)
20979 cracw(mgs) = frac*cracw(mgs)
20980 csacw(mgs) = frac*csacw(mgs)
20981 chacw(mgs) = frac*chacw(mgs)
20982 cautn(mgs) = frac*cautn(mgs)
20984 pccii(mgs) = pccii(mgs) - (1.-frac)*il5(mgs)*(cwfrzc(mgs)+cwctfzc(mgs))*(1. - ffrzs)
20985 IF ( lhl .gt. 1 ) chlacw(mgs) = frac*chlacw(mgs)
20997 IF ( ipconc .ge. 3 )
THEN
21001 IF ( warmonly < 0.5 )
THEN
21005 & +(1-il5(mgs))*( &
21006 & -chmlrr(mgs)/rzxh(mgs) &
21007 & -chlmlrr(mgs)/rzxhl(mgs) &
21013 & il5(mgs)*(-ciacr(mgs) - crfrz(mgs) ) &
21015 & - chacr(mgs) - chlacr(mgs) &
21021 ELSEIF ( warmonly < 0.8 )
THEN
21024 & +(1-il5(mgs))*( &
21025 & -chmlrr(mgs)/rzxh(mgs) &
21026 & -chlmlrr(mgs)/rzxhl(mgs) &
21032 & il5(mgs)*( - crfrz(mgs) ) &
21053 IF ( -pcrwd(mgs)*dtp .gt. cx(mgs,lr) )
THEN
21061 frac = -cx(mgs,lr)/(pcrwd(mgs)*dtp)
21062 pcrwd(mgs) = -cx(mgs,lr)*dtpinv
21064 ciacr(mgs) = frac*ciacr(mgs)
21065 ciacrf(mgs) = frac*ciacrf(mgs)
21066 ciacrs(mgs) = frac*ciacrs(mgs)
21067 crfrz(mgs) = frac*crfrz(mgs)
21068 crfrzf(mgs) = frac*crfrzf(mgs)
21069 crfrzs(mgs) = frac*crfrzs(mgs)
21070 chacr(mgs) = frac*chacr(mgs)
21071 chlacr(mgs) = frac*chlacr(mgs)
21072 crcev(mgs) = frac*crcev(mgs)
21073 cracr(mgs) = frac*cracr(mgs)
21083 IF ( warmonly < 0.5 )
THEN
21088 IF ( ipconc .ge. 4 )
THEN
21092 & il5(mgs)*(cscnis(mgs) + cscnvis(mgs) ) &
21093 & + cwfrz2snowfrac*cwfrz(mgs)/cwfrz2snowratio &
21096 IF ( ffrzs > 0.0 )
THEN
21097 pcswi(mgs) = pcswi(mgs) + ffrzs* ( &
21098 & il5(mgs)*cicint(mgs) &
21099 & +il5(mgs)*(cwfrzc(mgs)+cwctfzc(mgs) &
21103 & + csplinter(mgs) + csplinter2(mgs) &
21108 IF ( ess0 < 0.0 )
THEN
21109 csacs(mgs) = max(0.0, csacs(mgs) - (ifrzs)*(crfrzs(mgs) + ciacrs(mgs)))
21114 & -chacs(mgs) - chlacs(mgs) &
21116 & +(1-il5(mgs))*csmlr(mgs) + csshr(mgs) &
21122 IF ( imixedphase == 0 )
THEN
21123 IF ( cx(mgs,ls) + dtp*(pcswi(mgs) + pcswd(mgs)) < 0.0 )
THEN
21124 frac = (-cx(mgs,ls) + pcswi(mgs)*dtp)/(pcswd(mgs)*dtp)
21126 pcswd(mgs) = frac*pcswd(mgs)
21128 chacs(mgs) = frac*chacs(mgs)
21129 chlacs(mgs) = frac*chlacs(mgs)
21130 chcns(mgs) = frac*chcns(mgs)
21131 csmlr(mgs) = frac*csmlr(mgs)
21132 csshr(mgs) = frac*csshr(mgs)
21133 cssbv(mgs) = frac*cssbv(mgs)
21134 csacs(mgs) = frac*csacs(mgs)
21141 pccii(mgs) = pccii(mgs) &
21142 & + (1. - ifrzs)*crfrzs(mgs) &
21143 & + (1. - ifrzs)*ciacrs(mgs)
21145 pcswi(mgs) = pcswi(mgs) &
21146 & + (ifrzs)*crfrzs(mgs) &
21147 & + (ifrzs)*ciacrs(mgs)
21156 IF ( ipconc .ge. 5 )
THEN
21159 & +(ffrzh*ifrzg*crfrzf(mgs) &
21160 & +il5(mgs)*ffrzh*ifiacrg*(ciacrf(mgs) )) &
21161 & + f2h*chcnsh(mgs) + f2h*chcnih(mgs) + chcnhl(mgs)
21164 & (1-il5(mgs))*chmlr(mgs) &
21167 & - il5(mgs)*chlcnh(mgs) &
21179 IF ( lhl .gt. 1 .and. lnhl > 1 )
THEN
21181 pchli(mgs) = (ffrzh*(1.0-ifrzg)*crfrzf(mgs) +il5(mgs)*ffrzh*(1.0-ifiacrg)*(ciacrf(mgs) )) &
21182 & + chlcnhhl(mgs) *rzxhlh(mgs)
21185 & (1-il5(mgs))*chlmlr(mgs) &
21187 & + chlsbv(mgs) - chcnhl(mgs)
21189 IF ( imixedphase == 0 )
THEN
21191 IF ( cx(mgs,lhl) + dtp*(pchli(mgs) + pchld(mgs)) < 0.0 )
THEN
21194 frac = (-cx(mgs,lhl) + pchli(mgs)*dtp)/(pchld(mgs)*dtp)
21196 chlmlr(mgs) = frac*chlmlr(mgs)
21197 chlsbv(mgs) = frac*chlsbv(mgs)
21198 chcnhl(mgs) = frac*chcnhl(mgs)
21200 pchld(mgs) = frac*pchld(mgs)
21212 ELSEIF ( warmonly < 0.8 )
THEN
21217 IF ( ipconc .ge. 5 )
THEN
21220 & +ifrzg*(crfrzf(mgs) )
21223 & (1-il5(mgs))*chmlr(mgs) &
21224 & - il5(mgs)*chlcnh(mgs)
21229 IF ( lhl .gt. 1 )
THEN
21231 pchli(mgs) = (1.0-ifrzg)*(crfrzf(mgs)) &
21232 & + chlcnhhl(mgs) *rzxhl(mgs)/rzxh(mgs)
21235 & (1-il5(mgs))*chlmlr(mgs)
21256 pctot(mgs) = pccwi(mgs) +pccwd(mgs) + &
21257 & pccii(mgs) +pccid(mgs) + &
21258 & pcrwi(mgs) +pcrwd(mgs) + &
21259 & pcswi(mgs) +pcswd(mgs) + &
21260 & pchwi(mgs) +pchwd(mgs) + &
21261 & pchli(mgs) +pchld(mgs)
21300 IF ( ipconc > 5 )
THEN
21313 IF ( warmonly < 0.5 )
THEN
21318 & -min(0.0, qrcev(mgs)) &
21319 & -min(0.0, qhcev(mgs)) &
21320 & -min(0.0, qhlcev(mgs)) &
21321 & -min(0.0, qscev(mgs)) &
21323 & -qhsbv(mgs) - qhlsbv(mgs) &
21325 & -il5(mgs)*qisbv(mgs)
21328 & -max(0.0, qrcev(mgs)) &
21329 & -max(0.0, qhcev(mgs)) &
21330 & -max(0.0, qhlcev(mgs)) &
21331 & -max(0.0, qscev(mgs)) &
21332 & +il5(mgs)*(-qiint(mgs) &
21333 & -qhdpv(mgs) -qsdpv(mgs) - qhldpv(mgs)) &
21334 & -il5(mgs)*qidpv(mgs)
21338 ELSEIF ( warmonly < 0.8 )
THEN
21341 & -min(0.0, qrcev(mgs)) &
21342 & -il5(mgs)*qisbv(mgs)
21344 & +il5(mgs)*(-qiint(mgs) &
21346 & -qhdpv(mgs) - qhldpv(mgs)) &
21348 & -max(0.0, qrcev(mgs)) &
21349 & -il5(mgs)*qidpv(mgs)
21355 & -min(0.0, qrcev(mgs))
21357 & -max(0.0, qrcev(mgs))
21366 pqcwi(mgs) = (0.0) + qwcnr(mgs) - qwshw(mgs)
21368 IF ( warmonly < 0.5 )
THEN
21370 & il5(mgs)*(-qiacw(mgs)-qwfrz(mgs)-qwctfz(mgs)) &
21371 & -il5(mgs)*(qiihr(mgs)) &
21372 & -qracw(mgs) -qsacw(mgs) -qrcnw(mgs) -qhacw(mgs) - qhlacw(mgs)
21374 ELSEIF ( warmonly < 0.8 )
THEN
21376 & il5(mgs)*(-qiacw(mgs)-qwfrz(mgs)-qwctfz(mgs)) &
21377 & -il5(mgs)*(qiihr(mgs)) &
21378 & -qracw(mgs) -qrcnw(mgs) -qhacw(mgs) -qhlacw(mgs)
21381 & -qracw(mgs) - qrcnw(mgs)
21385 IF ( pqcwd(mgs) .lt. 0.0 .and. -pqcwd(mgs)*dtp .gt. qx(mgs,lc) )
THEN
21387 frac = -max(0.0,qx(mgs,lc))/(pqcwd(mgs)*dtp)
21388 pqcwd(mgs) = -qx(mgs,lc)*dtpinv
21390 qiacw(mgs) = frac*qiacw(mgs)
21393 qwfrzc(mgs) = frac*qwfrzc(mgs)
21394 qwfrz(mgs) = frac*qwfrz(mgs)
21395 qwctfzc(mgs) = frac*qwctfzc(mgs)
21396 qwctfz(mgs) = frac*qwctfz(mgs)
21397 qracw(mgs) = frac*qracw(mgs)
21398 qsacw(mgs) = frac*qsacw(mgs)
21399 qhacw(mgs) = frac*qhacw(mgs)
21400 vhacw(mgs) = frac*vhacw(mgs)
21401 qrcnw(mgs) = frac*qrcnw(mgs)
21402 qwfrzp(mgs) = frac*qwfrzp(mgs)
21403 IF ( lhl .gt. 1 )
THEN
21404 qhlacw(mgs) = frac*qhlacw(mgs)
21405 vhlacw(mgs) = frac*vhlacw(mgs)
21417 IF ( warmonly < 0.5 )
THEN
21420 IF ( ffrzs < 1.0 )
THEN
21422 & il5(mgs)*qicicnt(mgs) &
21423 & +il5(mgs)*((1.0-cwfrz2snowfrac)*qwfrzc(mgs)+qwctfzc(mgs)) &
21424 & +il5(mgs)*(qicichr(mgs)) &
21426 & +qhmul1(mgs) + qhlmul1(mgs) &
21427 & + qsplinter(mgs) + qsplinter2(mgs)
21431 pqcii(mgs) = pqcii(mgs)*(1.0 - ffrzs) &
21432 & +il5(mgs)*qidpv(mgs) &
21433 & +il5(mgs)*qiacw(mgs)
21436 & il5(mgs)*(-qscni(mgs) - qscnvi(mgs) &
21441 & +il5(mgs)*qisbv(mgs) &
21442 & +(1.-il5(mgs))*qimlr(mgs) &
21447 ELSEIF ( warmonly < 0.8 )
THEN
21451 & il5(mgs)*qicicnt(mgs)*(1. - ffrzs) &
21452 & +il5(mgs)*((1.0-cwfrz2snowfrac)*qwfrzc(mgs)+qwctfzc(mgs))*(1. - ffrzs) &
21453 & +il5(mgs)*(qicichr(mgs))*(1. - ffrzs) &
21456 & +qhmul1(mgs) + qhlmul1(mgs) &
21457 & + qsplinter(mgs) + qsplinter2(mgs) &
21458 & +il5(mgs)*qidpv(mgs) &
21459 & +il5(mgs)*qiacw(mgs)
21472 & +il5(mgs)*qisbv(mgs) &
21473 & +(1.-il5(mgs))*qimlr(mgs)
21483 IF ( warmonly < 0.5 )
THEN
21485 & qracw(mgs) + qrcnw(mgs) + max(0.0, qrcev(mgs)) &
21486 & +(1-il5(mgs))*( &
21488 & -qsmlr(mgs) - qhlmlr(mgs) &
21496 & il5(mgs)*(-qiacr(mgs)-qrfrz(mgs)) &
21497 & - qsacr(mgs) - qhacr(mgs) - qhlacr(mgs) - qwcnr(mgs) &
21498 & + min(0.0,qrcev(mgs))
21499 ELSEIF ( warmonly < 0.8 )
THEN
21501 & qracw(mgs) + qrcnw(mgs) + max(0.0, qrcev(mgs)) &
21502 & +(1-il5(mgs))*( &
21508 & il5(mgs)*(-qrfrz(mgs)) &
21511 & + min(0.0,qrcev(mgs))
21514 & qracw(mgs) + qrcnw(mgs) + max(0.0, qrcev(mgs))
21515 pqrwd(mgs) = min(0.0,qrcev(mgs))
21520 IF ( pqrwd(mgs) .lt. 0.0 .and. -(pqrwd(mgs) + pqrwi(mgs))*dtp .gt. qx(mgs,lr) )
THEN
21522 frac = (-qx(mgs,lr) + pqrwi(mgs)*dtp)/(pqrwd(mgs)*dtp)
21525 pqwvi(mgs) = pqwvi(mgs) &
21526 & + min(0.0, qrcev(mgs)) &
21527 & - frac*min(0.0, qrcev(mgs))
21528 pqwvd(mgs) = pqwvd(mgs) &
21529 & + max(0.0, qrcev(mgs)) &
21530 & - frac*max(0.0, qrcev(mgs))
21532 qiacr(mgs) = frac*qiacr(mgs)
21533 qiacrf(mgs) = frac*qiacrf(mgs)
21534 qiacrs(mgs) = frac*qiacrs(mgs)
21535 viacrf(mgs) = frac*viacrf(mgs)
21536 qrfrz(mgs) = frac*qrfrz(mgs)
21537 qrfrzs(mgs) = frac*qrfrzs(mgs)
21538 qrfrzf(mgs) = frac*qrfrzf(mgs)
21539 vrfrzf(mgs) = frac*vrfrzf(mgs)
21540 qsacr(mgs) = frac*qsacr(mgs)
21541 qhacr(mgs) = frac*qhacr(mgs)
21542 vhacr(mgs) = frac*vhacr(mgs)
21543 qrcev(mgs) = frac*qrcev(mgs)
21544 qhlacr(mgs) = frac*qhlacr(mgs)
21545 vhlacr(mgs) = frac*vhlacr(mgs)
21546 qhcev(mgs) = frac*qhcev(mgs)
21547 qhlcev(mgs) = frac*qhlcev(mgs)
21550 IF ( warmonly < 0.5 )
THEN
21552 & il5(mgs)*(-qiacr(mgs)-qrfrz(mgs) - qsacr(mgs)) &
21553 & - qhacr(mgs) - qhlacr(mgs) - qwcnr(mgs) &
21554 & + min(0.0,qrcev(mgs))
21555 ELSEIF ( warmonly < 0.8 )
THEN
21557 & il5(mgs)*(-qrfrz(mgs)) &
21560 & + min(0.0,qrcev(mgs))
21562 pqrwd(mgs) = min(0.0,qrcev(mgs))
21568 IF ( qrcev(mgs) .ne. 0.0 )
THEN
21570 & -min(0.0, qrcev(mgs)) &
21571 & -min(0.0, qhcev(mgs)) &
21572 & -min(0.0, qhlcev(mgs)) &
21573 & -min(0.0, qscev(mgs)) &
21575 & -qhsbv(mgs) - qhlsbv(mgs) &
21577 & -il5(mgs)*qisbv(mgs)
21580 & -max(0.0, qrcev(mgs)) &
21581 & -max(0.0, qhcev(mgs)) &
21582 & -max(0.0, qhlcev(mgs)) &
21583 & -max(0.0, qscev(mgs)) &
21584 & +il5(mgs)*(-qiint(mgs) &
21585 & -qhdpv(mgs) -qsdpv(mgs) - qhldpv(mgs)) &
21586 & -il5(mgs)*qidpv(mgs)
21597 IF ( warmonly < 0.5 )
THEN
21604 & il5(mgs)*(qscni(mgs)+qsaci(mgs)+qsdpv(mgs) &
21606 & + ifrzs*(qiacrs(mgs) + qrfrzs(mgs)) &
21607 & + il5(mgs)*(( qwfrzc(mgs) + qwctfzc(mgs) + qicichr(mgs) )*ffrzs &
21608 & + (1.0 - ffrzs)*cwfrz2snowfrac*qwfrz(mgs) ) &
21609 & + il2(mgs)*qsacr(mgs)) &
21610 & + il5(mgs)*qicicnt(mgs)*ffrzs &
21611 & + il3(mgs)*(qiacrf(mgs)+qracif(mgs)) &
21612 & + max(0.0, qscev(mgs)) &
21613 & + qsacw(mgs) + qscnh(mgs) &
21614 & + ffrzs*(qsmul(mgs) &
21615 & +qhmul1(mgs) + qhlmul1(mgs) &
21616 & + qsplinter(mgs) + qsplinter2(mgs))
21619 & -qracs(mgs)*(1-il2(mgs)) -qhacs(mgs) - qhlacs(mgs) &
21621 & +(1-il5(mgs))*qsmlr(mgs) + qsshr(mgs) &
21624 & + min(0.0, qscev(mgs)) &
21628 IF ( imixedphase == 0 .and. pqswd(mgs) .lt. 0.0 )
THEN
21629 IF ( qx(mgs,ls) + dtp*(pqswi(mgs) + pqswd(mgs)) < 0.0 )
THEN
21630 frac = (-qx(mgs,ls) + pqswi(mgs)*dtp)/(pqswd(mgs)*dtp)
21632 pqswd(mgs) = frac*pqswd(mgs)
21634 qracs(mgs) = frac*qracs(mgs)
21635 qhacs(mgs) = frac*qhacs(mgs)
21636 qhlacs(mgs) = frac*qhlacs(mgs)
21637 qhcns(mgs) = frac*qhcns(mgs)
21638 qsmlr(mgs) = frac*qsmlr(mgs)
21639 qsshr(mgs) = frac*qsshr(mgs)
21640 qssbv(mgs) = frac*qssbv(mgs)
21641 qsmul(mgs) = frac*qsmul(mgs)
21642 IF ( qscev(mgs) < 0.0 ) qscev(mgs) = frac*qscev(mgs)
21647 pqcii(mgs) = pqcii(mgs) &
21648 & + (1. - ifrzs)*qrfrzs(mgs) &
21649 & + (1. - ifrzs)*qiacrs(mgs)
21658 & +il5(mgs)*(ffrzh*ifrzg*qrfrzf(mgs) + (1-il3(mgs))*ffrzh*ifiacrg*(qiacrf(mgs)+qracif(mgs))) &
21659 & + (1-il2(mgs))*(qracs(mgs) + qsacr(mgs)) &
21660 & +il5(mgs)*(qhdpv(mgs)) &
21661 & +max(0.0, qhcev(mgs)) &
21662 & +qhacr(mgs)+qhacw(mgs) &
21663 & +qhacs(mgs)+qhaci(mgs) &
21664 & + f2h*qhcns(mgs) + f2h*qhcni(mgs) + qhcnhl(mgs)
21667 & +(1-il5(mgs))*qhmlr(mgs) &
21670 & + min(0.0, qhcev(mgs)) &
21671 & -qhmul1(mgs) - qhlcnh(mgs) - qscnh(mgs) &
21672 & - ffrzh*(qsplinter(mgs) + qsplinter2(mgs))
21681 IF ( lhl .gt. 1 )
THEN
21685 & +il5(mgs)*(qhldpv(mgs) + ((1.0-ifrzg)*qrfrzf(mgs) + (1.0-ifiacrg)*(qiacrf(mgs)+ qracif(mgs)))) &
21686 & +max(0.0, qhlcev(mgs)) &
21687 & +qhlacr(mgs)+qhlacw(mgs) &
21688 & +qhlacs(mgs)+qhlaci(mgs) &
21692 & +(1-il5(mgs))*qhlmlr(mgs) &
21695 & + min(0.0, qhlcev(mgs)) &
21696 & -qhlmul1(mgs) - qhcnhl(mgs)
21698 IF ( imixedphase == 0 )
THEN
21700 IF ( qx(mgs,lhl) + dtp*(pqhli(mgs) + pqhld(mgs)) < 0.0 )
THEN
21703 frac = (-qx(mgs,lhl) + pqhli(mgs)*dtp)/(pqhld(mgs)*dtp)
21705 qhlmlr(mgs) = frac*qhlmlr(mgs)
21706 qhlsbv(mgs) = frac*qhlsbv(mgs)
21707 qhcnhl(mgs) = frac*qhcnhl(mgs)
21708 qhlmul1(mgs) = frac*qhlmul1(mgs)
21709 IF ( qhlcev(mgs) < 0.0 ) qhlcev(mgs) = frac*qhlcev(mgs)
21711 pqhld(mgs) = frac*pqhld(mgs)
21721 ELSEIF ( warmonly < 0.8 )
THEN
21727 & +il5(mgs)*ifrzg*(qrfrzf(mgs) ) &
21728 & +il5(mgs)*(qhdpv(mgs)) &
21729 & +qhacr(mgs)+qhacw(mgs)
21734 & - qsplinter(mgs) - qsplinter2(mgs) &
21735 & +(1-il5(mgs))*qhmlr(mgs)
21741 IF ( lhl .gt. 1 )
THEN
21745 & +il5(mgs)*(qhldpv(mgs) ) &
21746 & +il5(mgs)*(1.0-ifrzg)*(qrfrzf(mgs) ) &
21747 & +qhlacr(mgs)+qhlacw(mgs) &
21752 & +(1-il5(mgs))*qhlmlr(mgs) &
21755 & -qhlmul1(mgs) - qhcnhl(mgs)
21772 IF ( mixedphase )
THEN
21776 vhmlr(:) = qhmlr(:)
21780 vhlmlr(:) = qhlmlr(:)
21791 if (ndebug .gt. 0 .and. my_rank>=0 )
write(0,*) my_rank,
'graupel reflectivity'
21801 IF ( ffrzh > 0.0 )
THEN
21813 IF ( lzh .gt. 1 )
THEN
21817 IF ( qx(mgs,lh) .gt. qxmin(lh) .and. cx(mgs,lh) .gt. 0.0 )
THEN
21818 tmp = qx(mgs,lh)/cx(mgs,lh)
21819 alp = max( alphamin, alpha(mgs,lh) )
21824 zhaci(mgs) = g1*(6.*rho0(mgs)/(pi*xdn(mgs,lh)))**2*( 2.*( tmp ) * qhaci(mgs) )
21825 zhacs(mgs) = g1*(6.*rho0(mgs)/(pi*xdn(mgs,lh)))**2*( 2.*( tmp ) * qhacs(mgs) )
21827 IF ( .not. mixedphase .and. ibinhmlr < 1 )
THEN
21828 zhmlr(mgs) = g1*(6.*rho0(mgs)/(pi*xdn(mgs,lh)))**2*( 2.*tmp * qhmlr(mgs) - tmp**2 * chmlr(mgs) )
21831 zhshr(mgs) = g1*(6.*rho0(mgs)/(pi*xdn(mgs,lh)))**2*( 2.*tmp * qhshr(mgs) - tmp**2 * chshr(mgs) )
21834 IF ( lzr > 0 .and. qhshr(mgs) /= 0.0 .and. chshrr(mgs) /= 0.0 )
THEN
21846 IF ( temg(mgs) >= tfr )
THEN
21851 IF ( (shedalp + alpha(mgs,lh))*xdia(mgs,lh,1) < sheddiam )
THEN
21852 z1 = g1*(6.0*rho0(mgs)/(pi*xdn(mgs,lr)))**2*( qhshr(mgs)**2/ chshrr(mgs) )
21854 z1 = g1shr*(6.0*rho0(mgs)/(pi*xdn(mgs,lr)))**2*( qhshr(mgs)**2/ chshrr(mgs) )
21860 zhshrr(mgs) = g1shr*(6.*rho0(mgs)/(pi*xdn(mgs,lr)))**2*( qhshr(mgs)**2/ chshrr(mgs) )
21863 zhshrr(mgs) = min( 0.0, zhshrr(mgs) )
21866 IF ( zhshr(mgs) > 0.0 )
THEN
21867 write(0,*)
'Problem with zhshr! zhshr,qhshr,chshr = ',zhshr(mgs),qhshr(mgs),chshr(mgs)
21868 write(0,*)
'g1,tmp, qx,cx,zx = ',g1,tmp,qx(mgs,lh),cx(mgs,lh),zx(mgs,lh)
21869 write(0,*) ( 2.*tmp * qhshr(mgs) - tmp**2 * chshr(mgs) ), 2.*tmp * qhshr(mgs), - tmp**2 * chshr(mgs)
21870 write(0,*)
'temcg = ',temcg(mgs),
'chshr recalc = ',(cx(mgs,lh)/(qx(mgs,lh)+1.e-20))*qhshr(mgs)
21878 qtmp = qhdpv(mgs) + qhcev(mgs) + qhsbv(mgs)
21879 ctmp = chdpv(mgs) + chcev(mgs) + chsbv(mgs)
21881 zhdsv(mgs) = g1*(6.*rho0(mgs)/(pi*xdn(mgs,lh)))**2*( 2.*( tmp ) * qtmp - tmp**2 * ctmp )
21883 alp = max( alphahacx, alpha(mgs,lh) )
21888 IF ( qhacr(mgs) .gt. 0.0 )
THEN
21893 zhacr(mgs) = g1*(6.*rho0(mgs)/(pi*xdn(mgs,lh)))**2*( 2.*( qx(mgs,lh)/cx(mgs,lh)) * qhacr(mgs) )
21899 IF ( z > zx(mgs,lh) )
THEN
21912 IF ( qhacw(mgs) .gt. 0.0 )
THEN
21914 zhacw(mgs) = g1*(6.*rho0(mgs)/(pi*xdn(mgs,lh)))**2*( 2.*( qx(mgs,lh)/cx(mgs,lh)) * qhacw(mgs) )
21917 IF ( z > zx(mgs,lh) )
THEN
21924 IF ( qhacw(mgs) .gt. 0.0 .or. qhacr(mgs) .gt. 0.0 )
THEN
21925 z = g1*(6.*rho0(mgs)/(pi*1000.))**2*( (qx(mgs,lh)+dtp*(qhacr(mgs) + qhacw(mgs)-qhmul1(mgs)))**2)/(cx(mgs,lh))
21927 IF ( z > zx(mgs,lh) )
THEN
21928 zhacw(mgs) = (z - zx(mgs,lh))*dtpinv
21934 IF ( qhlcnh(mgs) .gt. 0.0 .and. ihlcnh < 2 )
THEN
21935 zhlcnh(mgs) = g1*(6.*rho0(mgs)/(pi*xdn(mgs,lh)))**2*( 2.*( tmp ) * qhlcnh(mgs) - tmp**2 * chlcnh(mgs) )
21939 IF ( ffrzh*qiacrf(mgs) .gt. 0.0 .and. cx(mgs,lr) .gt. 0.0 .and. qx(mgs,lr) .gt. qxmin(lr) )
THEN
21940 tmp = qx(mgs,lr)/cx(mgs,lr)
21943 IF ( imurain == 3 )
THEN
21945 ziacr(mgs) = 3.6476*rho0(mgs)**2*(alpha(mgs,lr)+2.)/(xdn0(lr)**2*(alpha(mgs,lr)+1.))* &
21946 & ( 2.*tmp * qiacrf(mgs) - tmp**2 * ciacrf(mgs) )
21948 ziacr(mgs) = 3.6476*rho0(mgs)**2*g1x(mgs,lr)/(xdn0(lr)**2)* &
21949 & ( 2.*tmp * qiacrf(mgs) - tmp**2 * ciacrf(mgs) )
21951 ziacr(mgs) = min( ziacr(mgs), zxmxd(mgs,lr) )
21953 ziacrf(mgs) = (xdn(mgs,lr)/xdnmx(lh))**2 * ziacr(mgs)
21960 IF ( ffrzh*qrfrzf(mgs) .gt. 0.0 .and. cx(mgs,lr) .gt. 0.0 )
THEN
21961 tmp = qx(mgs,lr)/cx(mgs,lr)
21964 IF ( imurain == 3 )
THEN
21965 zrfrz(mgs) = 3.6476*rho0(mgs)**2*(alpha(mgs,lr)+2.)/(xdn0(lr)**2*(alpha(mgs,lr)+1.)) * &
21966 & ( 2.*tmp * qrfrzf(mgs) - tmp**2 * crfrzf(mgs) )
21967 zrfrzf(mgs) = (xdn(mgs,lr)/xdn(mgs,lh))**2 * zrfrz(mgs)
21968 ELSEIF ( imurain == 1 .and. ibiggopt /= 2 )
THEN
21971 zrfrz(mgs) = 3.6476*rho0(mgs)**2*g1x(mgs,lr)/(xdn0(lr)**2) * &
21972 & ( 2.*tmp * qrfrz(mgs) - tmp**2 * crfrz(mgs) )
21973 zrfrzf(mgs) = 3.6476*rho0(mgs)**2*g1x(mgs,lr)/(rhofrz**2) * &
21974 & ( 2.*tmp * qrfrzf(mgs) - tmp**2 * crfrzf(mgs) )
21976 zrfrz(mgs) = min( zrfrz(mgs), max(0.4,qrfrz(mgs)/qx(mgs,lr))*zx(mgs,lr)*dtpinv )
21984 IF ( lhl > 1 .and. qhcnhl(mgs) .gt. 0.0 )
THEN
21985 tmp = qx(mgs,lhl)/cx(mgs,lhl)
21986 zhcnhl(mgs) = g1x(mgs,lhl)*(6.*rho0(mgs)/(pi*xdn(mgs,lhl)))**2*( 2.*( tmp ) * qhcnhl(mgs) - tmp**2 * chcnhl(mgs) )
21990 IF ( qhcns(mgs) > 0.0 .and. chcns(mgs) > 0.0 .and. cx(mgs,ls) > cxmin .and. vhcns(mgs) > 0 )
THEN
21991 tmp = qx(mgs,ls)/cx(mgs,ls)
21992 r = rho0(mgs)*qhcns(mgs)/vhcns(mgs)
21993 IF ( imusnow == 3 )
THEN
21994 zhcns(mgs) = 3.6476*rho0(mgs)**2*(alpha(mgs,ls)+2.)/(r**2*(alpha(mgs,ls)+1.)) * &
21995 & ( 2.*tmp * qhcns(mgs) - tmp**2 * chcns(mgs) )
21997 write(0,*)
'Value of imusnow not valid. Must be 3 (fix me for =1). imusnow = ',imusnow
22002 IF ( qhcni(mgs) > 0.0 .and. chcni(mgs) > 0.0 .and. cx(mgs,li) > cxmin .and. vhcni(mgs) > 0 )
THEN
22003 tmp = qx(mgs,li)/cx(mgs,li)
22004 r = rho0(mgs)*qhcni(mgs)/vhcni(mgs)
22005 zhcni(mgs) = 3.6476*rho0(mgs)**2*(alpha(mgs,li)+2.)/(r**2*(alpha(mgs,li)+1.)) * &
22006 & ( 2.*tmp * qhcni(mgs) - tmp**2 * chcni(mgs) )
22011 & +ifrzg*ffrzh*(zrfrzf(mgs) &
22012 & +il5(mgs)*ifiacrg*(ziacrf(mgs) ) ) &
22019 & + f2h*zhcni(mgs) + f2h*zhcns(mgs) &
22020 & + max( 0.0, zhdsv(mgs) )
22023 & + (1-il5(mgs))*zhmlr(mgs) &
22025 & + min( 0.0, zhdsv(mgs) ) &
22026 & - il5(mgs)*zhlcnh(mgs)
22029 IF ( igs(mgs) == 44 .and. kgs(mgs) == 23 .or. dtp*( pqhwi(mgs) + pqhwd(mgs) ) > qxmin(lh) )
THEN
22046 if (ndebug .gt. 0 .and. my_rank>=0 )
write(0,*) my_rank,
'end graupel reflectivity'
22062 IF ( lzhl .gt. 1 .or. ( lzr > 1 .and. lnhl > 1 ) )
THEN
22064 if (ndebug .gt. 0 .and. my_rank>=0 )
write(0,*) my_rank,
'hail reflectivity'
22068 IF ( qx(mgs,lhl) .gt. qxmin(lhl) .and. cx(mgs,lhl) .gt. 0.0 )
THEN
22069 tmp = qx(mgs,lhl)/cx(mgs,lhl)
22070 alp = max( alphamin, alpha(mgs,lhl) )
22074 IF ( .not. mixedphase .and. qhlmlr(mgs) /= 0.0 .and. chlmlr(mgs) /= 0.0 .and. ibinhlmlr < 1 )
THEN
22075 zhlmlr(mgs) = g1*(6.*rho0(mgs)/(pi*xdn(mgs,lhl)))**2*( 2.*tmp * qhlmlr(mgs) - tmp**2 * chlmlr(mgs) )
22078 zhlshr(mgs) = g1*(6.*rho0(mgs)/(pi*xdn(mgs,lhl)))**2*( 2.*tmp * qhlshr(mgs) - tmp**2 * chlshr(mgs) )
22079 IF ( lzr > 1 .and. qhlshr(mgs) /= 0.0 .and. chlshrr(mgs) /= 0.0 )
THEN
22080 IF ( temg(mgs) >= tfr )
THEN
22085 IF ( (shedalp + alpha(mgs,lhl))*xdia(mgs,lhl,1) < sheddiam )
THEN
22086 z1 = g1*(6.0*rho0(mgs)/(pi*xdn(mgs,lr)))**2*( qhlshr(mgs)**2/ chlshrr(mgs) )
22088 z1 = g1shr*(6.0*rho0(mgs)/(pi*xdn(mgs,lr)))**2*( qhlshr(mgs)**2/ chlshrr(mgs) )
22094 zhlshrr(mgs) = g1shr*(6.*rho0(mgs)/(pi*xdn(mgs,lr)))**2*( qhlshr(mgs)**2/ chlshrr(mgs) )
22097 zhlshrr(mgs) = min( 0.0, zhlshrr(mgs) )
22100 IF ( zhlshr(mgs) > 0.0 )
THEN
22101 write(0,*)
'Problem with zhlshr! zhlshr,qhlshr,chlshr = ',zhlshr(mgs),qhlshr(mgs),chlshr(mgs)
22102 write(0,*)
'g1,tmp, qx,cx,zx = ',g1,tmp,qx(mgs,lhl),cx(mgs,lhl),zx(mgs,lhl)
22103 write(0,*) ( 2.*tmp * qhlshr(mgs) - tmp**2 * chlshr(mgs) ), 2.*tmp * qhlshr(mgs), - tmp**2 * chlshr(mgs)
22104 write(0,*)
'temcg = ',temcg(mgs),
'chlshr recalc = ',(cx(mgs,lhl)/(qx(mgs,lhl)+1.e-20))*qhlshr(mgs)
22112 qtmp = qhldpv(mgs) + qhlcev(mgs)
22113 ctmp = chldpv(mgs) + chlcev(mgs)
22115 zhldsv(mgs) = g1*(6.*rho0(mgs)/(pi*xdn(mgs,lhl)))**2*( 2.*( tmp ) * qtmp - tmp**2 * ctmp )
22117 alp = max( alphahacx, alpha(mgs,lhl) )
22122 IF ( qhlacr(mgs) .gt. 0.0 )
THEN
22124 zhlacr(mgs) = g1*(6.*rho0(mgs)/(pi*xdn(mgs,lhl)))**2*( 2.*( tmp ) * qhlacr(mgs) )
22137 IF ( qhlacw(mgs) .gt. 0.0 )
THEN
22138 alp = max( 3.0, alpha(mgs,lhl)+1. )
22139 g1 = (6.0 + alp)*(5.0 + alp)*(4.0 + alp)/((3.0 + alp)*(2.0 + alp)*(1.0 + alp))
22143 zhlacw(mgs) = g1*(6.*rho0(mgs)/(pi*xdn(mgs,lhl)))**2*( 2.*tmp * qhlacw(mgs) )
22153 IF ( qhlacw(mgs) .gt. 0.0 .or. qhlacr(mgs) .gt. 0.0 )
THEN
22154 z = g1*(6.*rho0(mgs)/(pi*1000.))**2*( (qx(mgs,lhl)+dtp*(qhlacr(mgs) + qhlacw(mgs)-qhlmul1(mgs)))**2)/(cx(mgs,lhl))
22156 IF ( z > zx(mgs,lhl) )
THEN
22157 zhlacw(mgs) = (z - zx(mgs,lhl))*dtpinv
22166 IF ( lzhl > 1 )
THEN
22167 pzhli(mgs) = ffrzh*(((1.0-ifrzg)*zrfrzf(mgs) &
22168 & +il5(mgs)*(1.0-ifiacrg)*ziacrf(mgs) )) &
22169 & + il5(mgs)*zhlcnh(mgs) &
22173 & + max( 0.0, zhldsv(mgs) )
22176 & + (1-il5(mgs))*zhlmlr(mgs) &
22179 & + min( 0.0, zhldsv(mgs) )
22182 IF ( .not. ( -1.0 < pzhli(mgs) .and. pzhli(mgs) < 1.e20 ) )
THEN
22183 write(iunit,*)
'Problem with pzhli!'
22184 write(iunit,*)
'zhlcnh,zhlacw,zhlacr,zhldsv = ',zhlcnh(mgs),zhlacw(mgs),zhlacr(mgs),zhldsv(mgs)
22187 IF ( .not. ( -1.0e20 < pzhld(mgs) .and. pzhld(mgs) < 1. ) )
THEN
22188 write(iunit,*)
'Problem with pzhld!'
22189 write(iunit,*)
'zhlmlr,zhlshr,zhldsv = ',zhlmlr(mgs),zhlshr(mgs),zhldsv(mgs)
22201 if (ndebug .gt. 0 )
write(0,*)
'WARMZIEG: dbg = 11'
22203 IF ( lzr .gt. 1 )
THEN
22217 IF ( qx(mgs,ls) .gt. qxmin(ls) .and. ( csmlr(mgs) /= 0.0 .or. csshr(mgs) /= 0.0 .or. &
22218 csmlrr(mgs) /= 0.0 .or. csshrr(mgs) /= 0.0) )
THEN
22219 tmp = qx(mgs,ls)/cx(mgs,ls)
22220 g1 = 36.*(xnu(ls)+2.0)/((xnu(ls)+1.0)*pi**2)
22221 IF ( .not. mixedphase )
THEN
22225 IF ( csmlrr(mgs) /= 0.0 )
THEN
22226 z1 = g1smlr*(6.*rho0(mgs)/(pi*xdn(mgs,lr)))**2*( qsmlr(mgs)**2/ csmlrr(mgs) )
22234 IF ( csshrr(mgs) /= 0.0 )
THEN
22235 z1 = g1smlr*(6.*rho0(mgs)/(pi*xdn(mgs,lr)))**2*( qsshr(mgs)**2/ csshrr(mgs) )
22241 IF ( .not. mixedphase )
THEN
22242 IF ( zhmlr(mgs) < 0.0 .and. chmlrr(mgs) /= 0.0 .and. ibinhmlr == 0 )
THEN
22243 tmp = qx(mgs,lh)/cx(mgs,lh)
22250 IF ( (shedalp + alpha(mgs,lh))*xdia(mgs,lh,1) < sheddiam )
THEN
22251 z1 = g1x(mgs,lh)*(6.*rho0(mgs)/(pi*xdn(mgs,lr)))**2*( qhmlr(mgs)**2/ chmlrr(mgs) )
22253 z1 = min(g1x(mgs,lh),g1shr)*(6.*rho0(mgs)/(pi*xdn(mgs,lr)))**2*( qhmlr(mgs)**2/ chmlrr(mgs) )
22263 IF ( lhl > 1 .and. qhlmlr(mgs) /= 0 .and. ibinhlmlr == 0)
THEN
22264 tmp = qx(mgs,lhl)/cx(mgs,lhl)
22272 IF ( (shedalp + alpha(mgs,lhl))*xdia(mgs,lhl,1) < sheddiam )
THEN
22273 z1 = g1x(mgs,lhl)*(6.*rho0(mgs)/(pi*xdn(mgs,lr)))**2*( qhlmlr(mgs)**2/ chlmlrr(mgs) )
22275 z1 = min(g1x(mgs,lhl),g1shr)*(6.*rho0(mgs)/(pi*xdn(mgs,lr)))**2*( qhlmlr(mgs)**2/ chlmlrr(mgs) )
22288 IF ( qx(mgs,lr) .gt. qxmin(lr) .and. cx(mgs,lr) .gt. 0.0 )
THEN
22290 tmp = qx(mgs,lr)/cx(mgs,lr)
22294 IF ( qracw(mgs) > 0.0 .and. cx(mgs,lr) > 0.0 )
THEN
22295 zracw(mgs) = g1x(mgs,lr)*(6.*rho0(mgs)/(pi*1000.))**2*( 2.*tmp * qracw(mgs) )
22298 IF ( cracr(mgs) > 0.0 .and. cx(mgs,lr) > 0.0 )
THEN
22299 zracr(mgs) = g1x(mgs,lr)*(6.*rho0(mgs)/(pi*1000.))**2*( tmp**2 * cracr(mgs) )
22308 zrcev(mgs) = g1x(mgs,lr)*(6.*rho0(mgs)/(pi*xdn(mgs,lr)))**2*( 2.*( tmp ) * qtmp - tmp**2 * ctmp )
22311 IF ( iferwisventr == 2 )
THEN
22312 vent1 = min(0.0, (12./(pii*xdn(mgs,lr)))*xdia(mgs,lr,1)**3*fvce(mgs)*rwcap(mgs)*rwventz(mgs))
22313 zrcev(mgs) = max( zrcev(mgs), vent1 )
22321 zrcev(mgs) = max( zrcev(mgs), -zxmxd(mgs,lr) )
22323 IF ( qhacr(mgs) > 0.0 )
THEN
22324 zrach(mgs) = g1x(mgs,lr)*(6.*rho0(mgs)/(pi*xdn(mgs,lr)))**2* &
22325 & ( 2.*( qx(mgs,lr)/cx(mgs,lr)) * qhacr(mgs) - tmp**2 * chacr(mgs) )
22326 zrach(mgs) = min( zrach(mgs), zxmxd(mgs,lr) )
22330 IF ( lhl > 1 .and. qhlacr(mgs) > 0.0 )
THEN
22331 zrachl(mgs) = g1x(mgs,lr)*(6.*rho0(mgs)/(pi*xdn(mgs,lr)))**2* &
22332 & ( 2.*( qx(mgs,lr)/cx(mgs,lr)) * qhlacr(mgs) - tmp**2 * chlacr(mgs) )
22333 zrachl(mgs) = min( zrachl(mgs), zxmxd(mgs,lr) )
22340 pzrwi(mgs) = zrcnw(mgs) + zracw(mgs) + zracr(mgs) &
22341 & + max( 0.,zrcev(mgs) ) &
22342 & - (1-il5(mgs))*zsmlrr(mgs) &
22344 & - (1-il5(mgs))*zhmlrr(mgs) &
22346 & - (1-il5(mgs))*zhlmlrr(mgs) &
22351 & + min(0.,zrcev(mgs) ) &
22355 & - il5(mgs)*(ziacr(mgs) )
22358 IF ( zx(mgs,lr) + dtp*(pzrwi(mgs)+pzrwd(mgs)) <= 0.0 &
22359 .and. qx(mgs,lr) > qxmin(lr) )
THEN
22360 pzrwd(mgs) = -zx(mgs,lr)*dtpinv - pzrwi(mgs)
22372 IF ( lvol(ls) .gt. 1 )
THEN
22376 pvswi(mgs) = rho0(mgs)*( &
22379 & +il5(mgs)*(qscni(mgs)+qsaci(mgs)+qsdpv(mgs) &
22380 & + qscnvi(mgs) + (1. - ifrzs)*qiacrs(mgs) &
22381 & + (1. - ifrzs)*qrfrzs(mgs) &
22383 & + (qsacr(mgs))/rimdn(mgs,ls) ) + vsacw(mgs)
22385 pvswd(mgs) = rho0(mgs)*( pqswd(mgs) )/xdn0(ls) &
22390 & -rho0(mgs)*qsmul(mgs)/xdn0(ls)
22405 IF ( lvol(lh) .gt. 1 )
THEN
22412 pvhwi(mgs) = rho0(mgs)*( &
22413 & +il5(mgs)*( ifiacrg*ffrzh*qracif(mgs))/rhofrz &
22415 & + ( il5(mgs)*qhdpv(mgs)/qhdpvdn &
22416 & + (qhacs(mgs) + qhaci(mgs))/qhacidn ) ) &
22417 & + rho0(mgs)*max(0.0, qhcev(mgs))/1000. &
22419 & + f2h*vhcns(mgs) &
22420 & + vhacr(mgs) + vhacw(mgs) + vhfzh(mgs) &
22422 & + f2h*vhcni(mgs) + (ifiacrg*viacrf(mgs) + ifrzg*vrfrzf(mgs))*ffrzh
22427 pvhwd(mgs) = rho0(mgs)*( &
22430 & +( (1-il5(mgs))*vhmlr(mgs) &
22433 & + min(0.0, qhcev(mgs)) &
22434 & -qhmul1(mgs) )/xdn(mgs,lh) ) &
22435 & - vhlcnh(mgs) + vhshdr(mgs) - vhsoak(mgs) - vscnh(mgs)
22442 IF ( lzh > 1 .and. qx(mgs,lh) > qxmin(lh) )
THEN
22445 xdn_new = rho0(mgs)*(qx(mgs,lh) + dtp*(pqhwi(mgs) + pqhwd(mgs) ))/ &
22446 & (vx(mgs,lh) + dtp*(pvhwi(mgs) + pvhwd(mgs)) )
22448 IF ( mixedphase )
THEN
22449 IF ( qxw(mgs,lh) .gt. 0.0 )
THEN
22458 xdn_new = max( min( xdn_new, dnmx ), xdnmn(lh) )
22460 drhodt = (xdn_new - xdn(mgs,lh))*dtpinv
22462 zhwdn(mgs) = -2.*g1x(mgs,lh)*(rho0(mgs)*qx(mgs,lh)*6.*pii )**2/(cx(mgs,lh)*xdn(mgs,lh)**3)*drhodt
22464 pzhwi(mgs) = pzhwi(mgs) + max(0.0, zhwdn(mgs))
22465 pzhwd(mgs) = pzhwd(mgs) + min(0.0, zhwdn(mgs))
22469 IF ( .false. .and. ny .eq. 2 .and. kgs(mgs) .eq. 9 .and. igs(mgs) .eq. 19 )
THEN
22472 write(iunit,*)
'Graupel at ',igs(mgs),kgs(mgs)
22474 write(iunit,*) il5(mgs)*qrfrzf(mgs), qrfrzf(mgs) - qrfrz(mgs)
22475 write(iunit,*) il5(mgs)*qiacrf(mgs)
22476 write(iunit,*) il5(mgs)*qracif(mgs)
22477 write(iunit,*)
'qhcns',qhcns(mgs)
22478 write(iunit,*)
'qhcni',qhcni(mgs)
22479 write(iunit,*) il5(mgs)*(qhdpv(mgs))
22480 write(iunit,*)
'qhacr ',qhacr(mgs)
22481 write(iunit,*)
'qhacw', qhacw(mgs)
22482 write(iunit,*)
'qhacs', qhacs(mgs)
22483 write(iunit,*)
'qhaci', qhaci(mgs)
22484 write(iunit,*)
'pqhwi = ',pqhwi(mgs)
22486 write(iunit,*)
'qhcev',qhcev(mgs)
22488 write(iunit,*)
'qhshr',qhshr(mgs)
22489 write(iunit,*)
'qhmlr', (1-il5(mgs))*qhmlr(mgs)
22490 write(iunit,*)
'qhsbv', qhsbv(mgs)
22491 write(iunit,*)
'qhlcnh',-qhlcnh(mgs)
22492 write(iunit,*)
'qhmul1',-qhmul1(mgs)
22493 write(iunit,*)
'pqhwd = ', pqhwd(mgs)
22495 write(iunit,*)
'Volume'
22497 write(iunit,*)
'pvhwi',pvhwi(mgs)
22498 write(iunit,*)
'vhcns', vhcns(mgs)
22499 write(iunit,*)
'vhacr,vhacw',vhacr(mgs), vhacw(mgs)
22500 write(iunit,*)
'vhcni',vhcni(mgs)
22502 write(iunit,*)
'pvhwd',pvhwd(mgs)
22503 write(iunit,*)
'vhlcnh,vhshdr,vhsoak ', vhlcnh(mgs), vhshdr(mgs), vhsoak(mgs)
22504 write(iunit,*)
'vhmlr', vhmlr(mgs)
22509 write(iunit,*)
'Concentration'
22510 write(iunit,*) pchwi(mgs),pchwd(mgs)
22511 write(iunit,*) crfrzf(mgs)
22512 write(iunit,*) chcns(mgs)
22513 write(iunit,*) ciacrf(mgs)
22529 IF ( lhl .gt. 1 )
THEN
22530 IF ( lvol(lhl) .gt. 1 )
THEN
22533 pvhli(mgs) = rho0(mgs)*( &
22534 & + ( il5(mgs)*(((1.0-ifiacrg)*ffrzh*qracif(mgs))/rhofrz + qhldpv(mgs) ) &
22538 & + qhlacs(mgs) + qhlaci(mgs) )/500. ) &
22539 & + rho0(mgs)*max(0.0, qhlcev(mgs))/1000. &
22540 & + vhlcnhl(mgs) + ((1.0-ifiacrg)*ffrzh*viacrf(mgs) + (1.0-ifrzg)*ffrzh*vrfrzf(mgs)) &
22541 & + vhlacr(mgs) + vhlacw(mgs) + vhlfzhl(mgs)
22543 pvhld(mgs) = rho0(mgs)*( &
22545 & + min(0.0, qhlcev(mgs)) &
22546 & -qhlmul1(mgs) )/xdn(mgs,lhl) ) &
22548 & + rho0(mgs)*(1-il5(mgs))*vhlmlr(mgs)/xdn(mgs,lhl) &
22549 & + vhlshdr(mgs) - vhlsoak(mgs)
22551 IF ( lzhl > 1 .and. qx(mgs,lhl) > qxmin(lhl) )
THEN
22554 xdn_new = rho0(mgs)*(qx(mgs,lhl) + dtp*(pqhli(mgs) + pqhld(mgs) ))/ &
22555 & (vx(mgs,lhl) + dtp*(pvhli(mgs) + pvhld(mgs)) )
22557 IF ( mixedphase )
THEN
22558 IF ( qxw(mgs,lhl) .gt. 0.0 )
THEN
22566 xdn_new = max( min( xdn_new, dnmx ), xdnmn(lhl) )
22568 drhodt = (xdn_new - xdn(mgs,lhl))*dtpinv
22570 zhldn(mgs) = -2.*g1x(mgs,lhl)*(rho0(mgs)*qx(mgs,lhl)*6.*pii )**2/(cx(mgs,lhl)*xdn(mgs,lhl)**3)*drhodt
22572 pzhli(mgs) = pzhli(mgs) + max(0.0, zhldn(mgs))
22573 pzhld(mgs) = pzhld(mgs) + min(0.0, zhldn(mgs))
22584 if ( ndebug .ge. 1 )
then
22588 ptotal(mgs) = ptotal(mgs) &
22589 & + pqwvi(mgs) + pqwvd(mgs) &
22590 & + pqcwi(mgs) + pqcwd(mgs) &
22591 & + pqcii(mgs) + pqcid(mgs) &
22592 & + pqrwi(mgs) + pqrwd(mgs) &
22593 & + pqswi(mgs) + pqswd(mgs) &
22594 & + pqhwi(mgs) + pqhwd(mgs) &
22595 & + pqhli(mgs) + pqhld(mgs)
22604 if ( ( (ndebug .ge. 0 ) .and. abs(ptotal(mgs)) .gt. eqtot ) &
22611 & .or. .not. (ptotal(mgs) .lt. 1.0 .and. ptotal(mgs) .gt. -1.0) &
22613 write(iunit,*)
'YIKES! ',
'ptotal1',mgs,igs(mgs),jgs, &
22614 & kgs(mgs),ptotal(mgs)
22616 write(iunit,*)
't7: ', t7(igs(mgs),jgs,kgs(mgs))
22617 write(iunit,*)
'cci,ccw,crw,rdia: ',cx(mgs,li),cx(mgs,lc),cx(mgs,lr),0.5*xdia(mgs,lr,1)
22618 write(iunit,*)
'qc,qi,qr : ',qx(mgs,lc),qx(mgs,li),qx(mgs,lr)
22619 write(iunit,*)
'rmas, qrcalc : ',xmas(mgs,lr),xmas(mgs,lr)*cx(mgs,lr)/rho0(mgs)
22620 write(iunit,*)
'vti,vtc,eiw,vtr: ',vtxbar(mgs,li,1),vtxbar(mgs,lc,1),eiw(mgs),vtxbar(mgs,lr,1)
22621 write(iunit,*)
'cidia,cwdia,qcmxd: ', xdia(mgs,li,1),xdia(mgs,lc,1),qcmxd(mgs)
22622 write(iunit,*)
'snow: ',qx(mgs,ls),cx(mgs,ls),swvent(mgs),vtxbar(mgs,ls,1),xdia(mgs,ls,1)
22623 write(iunit,*)
'graupel: ',qx(mgs,lh),cx(mgs,lh),hwvent(mgs),vtxbar(mgs,lh,1),xdia(mgs,lh,1)
22624 IF ( lhl .gt. 1 )
write(iunit,*)
'hail: ',qx(mgs,lhl),cx(mgs,lhl),hlvent(mgs),vtxbar(mgs,lhl,1),xdia(mgs,lhl,1)
22627 write(iunit,*)
'li: ',xdia(mgs,li,1),xdia(mgs,li,2),xmas(mgs,li),qx(mgs,li), &
22631 write(iunit,*)
'rain cx,xv : ',cx(mgs,lr),xv(mgs,lr)
22632 write(iunit,*)
'temcg = ', temcg(mgs)
22634 write(iunit,*)
'v ', pqwvi(mgs) ,pqwvd(mgs)
22635 write(iunit,*)
'c ', pqcwi(mgs) ,pqcwd(mgs)
22636 write(iunit,*)
'ci', pqcii(mgs) ,pqcid(mgs)
22637 write(iunit,*)
'r ', pqrwi(mgs) ,pqrwd(mgs)
22638 write(iunit,*)
's ', pqswi(mgs) ,pqswd(mgs)
22639 write(iunit,*)
'h ', pqhwi(mgs) ,pqhwd(mgs)
22640 write(iunit,*)
'hl', pqhli(mgs) ,pqhld(mgs)
22641 tmp = pqwvi(mgs) + pqwvd(mgs) &
22642 & + pqcwi(mgs) + pqcwd(mgs) &
22643 & + pqcii(mgs) + pqcid(mgs) &
22644 & + pqrwi(mgs) + pqrwd(mgs) &
22645 & + pqswi(mgs) + pqswd(mgs) &
22646 & + pqhwi(mgs) + pqhwd(mgs) &
22647 & + pqhli(mgs) + pqhld(mgs)
22649 write(iunit,*)
'total = ',tmp
22650 write(iunit,*)
'END OF OUTPUT OF SOURCE AND SINK'
22656 write(iunit,*)
'Vapor'
22658 write(iunit,*) -min(0.0,qrcev(mgs))
22659 write(iunit,*) -il5(mgs)*qhsbv(mgs)
22660 write(iunit,*) -il5(mgs)*qhlsbv(mgs)
22661 write(iunit,*) -il5(mgs)*qssbv(mgs)
22662 write(iunit,*) -il5(mgs)*qisbv(mgs)
22663 write(iunit,*)
'pqwvi= ', pqwvi(mgs)
22664 write(iunit,*) -max(0.0,qrcev(mgs))
22665 write(iunit,*) -max(0.0,qhcev(mgs))
22666 write(iunit,*) -max(0.0,qhlcev(mgs))
22667 write(iunit,*) -max(0.0,qscev(mgs))
22668 write(iunit,*) -il5(mgs)*qiint(mgs)
22669 write(iunit,*) -il5(mgs)*qhdpv(mgs)
22670 write(iunit,*) -il5(mgs)*qhldpv(mgs)
22671 write(iunit,*) -il5(mgs)*qsdpv(mgs)
22672 write(iunit,*) -il5(mgs)*qidpv(mgs)
22673 write(iunit,*)
'pqwvd = ', pqwvd(mgs)
22676 write(iunit,*)
'Cloud ice'
22678 write(iunit,*) il5(mgs)*qicicnt(mgs)
22679 write(iunit,*) il5(mgs)*qidpv(mgs)
22680 write(iunit,*) il5(mgs)*qiacw(mgs)
22681 write(iunit,*) il5(mgs)*qwfrzc(mgs)
22682 write(iunit,*) il5(mgs)*qwctfzc(mgs)
22683 write(iunit,*) il5(mgs)*qicichr(mgs)
22684 write(iunit,*) qhmul1(mgs)
22685 write(iunit,*) qhlmul1(mgs)
22686 write(iunit,*)
'pqcii = ', pqcii(mgs)
22687 write(iunit,*) -il5(mgs)*qscni(mgs)
22688 write(iunit,*) -il5(mgs)*qscnvi(mgs)
22689 write(iunit,*) -il5(mgs)*qraci(mgs)
22690 write(iunit,*) -il5(mgs)*qsaci(mgs)
22691 write(iunit,*) -il5(mgs)*qhaci(mgs)
22692 write(iunit,*) -il5(mgs)*qhlaci(mgs)
22693 write(iunit,*) il5(mgs)*qisbv(mgs)
22694 write(iunit,*) (1.-il5(mgs))*qimlr(mgs)
22695 write(iunit,*) -il5(mgs)*qhcni(mgs)
22696 write(iunit,*)
'pqcid = ', pqcid(mgs)
22697 write(iunit,*)
' Conc:'
22698 write(iunit,*) pccii(mgs),pccid(mgs)
22699 write(iunit,*) il5(mgs),cicint(mgs)
22700 write(iunit,*) cwfrzc(mgs),cwctfzc(mgs)
22701 write(iunit,*) cicichr(mgs)
22702 write(iunit,*) chmul1(mgs)
22703 write(iunit,*) chlmul1(mgs)
22704 write(iunit,*) csmul(mgs)
22710 write(iunit,*)
'Cloud water'
22712 write(iunit,*)
'pqcwi =', pqcwi(mgs)
22713 write(iunit,*) -il5(mgs)*qiacw(mgs)
22714 write(iunit,*) -il5(mgs)*qwfrzc(mgs)
22715 write(iunit,*) -il5(mgs)*qwctfzc(mgs)
22718 write(iunit,*) -il5(mgs)*qiihr(mgs)
22719 write(iunit,*) -il5(mgs)*qicichr(mgs)
22720 write(iunit,*) -il5(mgs)*qipiphr(mgs)
22721 write(iunit,*) -qracw(mgs)
22722 write(iunit,*) -qsacw(mgs)
22723 write(iunit,*) -qrcnw(mgs)
22724 write(iunit,*) -qhacw(mgs)
22725 write(iunit,*) -qhlacw(mgs)
22726 write(iunit,*)
'pqcwd = ', pqcwd(mgs)
22730 write(iunit,*)
'Concentration:'
22731 write(iunit,*) -cautn(mgs)
22732 write(iunit,*) -cracw(mgs)
22733 write(iunit,*) -csacw(mgs)
22734 write(iunit,*) -chacw(mgs)
22735 write(iunit,*) -ciacw(mgs)
22736 write(iunit,*) -cwfrzp(mgs)
22737 write(iunit,*) -cwctfzp(mgs)
22738 write(iunit,*) -cwfrzc(mgs)
22739 write(iunit,*) -cwctfzc(mgs)
22740 write(iunit,*) pccwd(mgs)
22743 write(iunit,*)
'Rain '
22745 write(iunit,*) qracw(mgs)
22746 write(iunit,*) qrcnw(mgs)
22747 write(iunit,*) max(0.0, qrcev(mgs))
22748 write(iunit,*) -(1-il5(mgs))*qhmlr(mgs)
22749 write(iunit,*) -(1-il5(mgs))*qhlmlr(mgs)
22750 write(iunit,*) -(1-il5(mgs))*qsmlr(mgs)
22751 write(iunit,*) -(1-il5(mgs))*qimlr(mgs)
22752 write(iunit,*) -qrshr(mgs)
22753 write(iunit,*)
'pqrwi = ', pqrwi(mgs)
22754 write(iunit,*) -qsshr(mgs)
22755 write(iunit,*) -qhshr(mgs)
22756 write(iunit,*) -qhlshr(mgs)
22757 write(iunit,*) -il5(mgs)*qiacr(mgs),qiacr(mgs), qiacrf(mgs)
22758 write(iunit,*) -il5(mgs)*qrfrz(mgs)
22759 write(iunit,*) -qsacr(mgs)
22760 write(iunit,*) -qhacr(mgs)
22761 write(iunit,*) -qhlacr(mgs)
22762 write(iunit,*) qrcev(mgs)
22763 write(iunit,*)
'pqrwd = ', pqrwd(mgs)
22764 write(iunit,*)
'qrzfac = ', qrzfac(mgs)
22768 write(iunit,*)
'Rain concentration'
22769 write(iunit,*) pcrwi(mgs)
22770 write(iunit,*) crcnw(mgs)
22771 write(iunit,*) 1-il5(mgs)
22772 write(iunit,*) -chmlr(mgs),-csmlr(mgs)
22773 write(iunit,*) -crshr(mgs)
22774 write(iunit,*) pcrwd(mgs)
22775 write(iunit,*) il5(mgs)
22776 write(iunit,*) -ciacr(mgs),-crfrz(mgs)
22777 write(iunit,*) -csacr(mgs),-chacr(mgs)
22778 write(iunit,*) +crcev(mgs)
22779 write(iunit,*) cracr(mgs)
22784 write(iunit,*)
'Snow'
22786 write(iunit,*) il5(mgs)*qscni(mgs), qscnvi(mgs)
22787 write(iunit,*) il5(mgs)*qsaci(mgs)
22788 write(iunit,*) il5(mgs)*qrfrzs(mgs)
22789 write(iunit,*) il5(mgs)*qiacrs(mgs),il3(mgs)*(qiacrf(mgs)+qracif(mgs)),il3(mgs),qiacrf(mgs),qracif(mgs)
22790 write(iunit,*) il5(mgs)*qsdpv(mgs), qscev(mgs)
22791 write(iunit,*) qsacw(mgs)
22792 write(iunit,*) qsacr(mgs), qscnh(mgs)
22793 write(iunit,*)
'pqswi = ',pqswi(mgs)
22794 write(iunit,*) -qhcns(mgs)
22795 write(iunit,*) -qracs(mgs)
22796 write(iunit,*) -qhacs(mgs)
22797 write(iunit,*) -qhlacs(mgs)
22798 write(iunit,*) (1-il5(mgs))*qsmlr(mgs)
22799 write(iunit,*) qsshr(mgs)
22801 write(iunit,*) il5(mgs)*(qssbv(mgs))
22802 write(iunit,*)
'pqswd = ', pqswd(mgs)
22803 write(iunit,*) -qracs(mgs)*(1-il2(mgs)) , qhacs(mgs) , qhlacs(mgs)
22804 write(iunit,*) -qhcns(mgs)
22805 write(iunit,*) +(1-il5(mgs))*qsmlr(mgs) , qsshr(mgs)
22806 write(iunit,*) qssbv(mgs)
22807 write(iunit,*) min(0.0, qscev(mgs))
22808 write(iunit,*) -qsmul(mgs)
22812 write(iunit,*)
'Graupel'
22814 write(iunit,*) il5(mgs)*qrfrzf(mgs), qrfrzf(mgs) - qrfrz(mgs)
22815 write(iunit,*) il5(mgs)*qiacrf(mgs)
22816 write(iunit,*) il5(mgs)*qracif(mgs)
22817 write(iunit,*) qhcns(mgs)
22818 write(iunit,*) qhcni(mgs)
22819 write(iunit,*) il5(mgs)*(qhdpv(mgs))
22820 write(iunit,*) qhacr(mgs)
22821 write(iunit,*) qhacw(mgs)
22822 write(iunit,*) qhacs(mgs)
22823 write(iunit,*) qhaci(mgs)
22824 write(iunit,*)
'pqhwi = ',pqhwi(mgs)
22826 write(iunit,*) qhshr(mgs)
22827 write(iunit,*) (1-il5(mgs))*qhmlr(mgs)
22828 write(iunit,*) il5(mgs),qhsbv(mgs)
22829 write(iunit,*) -qhlcnh(mgs)
22830 write(iunit,*) -qhmul1(mgs)
22831 write(iunit,*)
'pqhwd = ', pqhwd(mgs)
22832 write(iunit,*)
'Concentration'
22833 write(iunit,*) pchwi(mgs),pchwd(mgs)
22834 write(iunit,*) crfrzf(mgs)
22835 write(iunit,*) chcns(mgs)
22836 write(iunit,*) ciacrf(mgs)
22840 write(iunit,*)
'Hail'
22842 write(iunit,*) qhlcnh(mgs)
22843 write(iunit,*) il5(mgs)*(qhldpv(mgs))
22844 write(iunit,*) qhlacr(mgs)
22845 write(iunit,*) qhlacw(mgs)
22846 write(iunit,*) qhlacs(mgs)
22847 write(iunit,*) qhlaci(mgs)
22848 write(iunit,*) pqhli(mgs)
22850 write(iunit,*) qhlshr(mgs)
22851 write(iunit,*) (1-il5(mgs))*qhlmlr(mgs)
22852 write(iunit,*) il5(mgs)*qhlsbv(mgs)
22853 write(iunit,*) pqhld(mgs)
22854 write(iunit,*)
'Concentration'
22855 write(iunit,*) pchli(mgs),pchld(mgs)
22856 write(iunit,*) chlcnh(mgs)
22861 write(iunit,*)
'END OF OUTPUT OF SOURCE AND SINK'
22862 write(iunit,*)
'PTOTAL',ptotal(mgs)
22875 IF ( warmonly < 0.5 )
THEN
22879 & qsmlr(mgs)+qhlmlr(mgs)) &
22880 & +il5(mgs)*(1-imixedphase)*( &
22881 & qsacw(mgs)+qhacw(mgs) + qhlacw(mgs) &
22882 & +qsacr(mgs)+qhacr(mgs) + qhlacr(mgs) &
22886 & +qrfrz(mgs)+qiacr(mgs) &
22888 & +il5(mgs)*(qwfrz(mgs) &
22889 & +qwctfz(mgs)+qiihr(mgs) &
22893 & (qhmlr(mgs)+qsmlr(mgs)+ &
22898 & + qsdpv(mgs) + qhdpv(mgs) &
22900 & + qidpv(mgs) + qisbv(mgs) ) &
22901 & + qssbv(mgs) + qhsbv(mgs) &
22903 & +il5(mgs)*(qiint(mgs))
22905 & qrcev(mgs) + qhcev(mgs) + qscev(mgs) + qhlcev(mgs) + qfcev(mgs)
22907 & min(0.0,qrcev(mgs)) + min(0.0,qhcev(mgs)) + min(0.0,qscev(mgs)) + min(0.0,qhlcev(mgs)) &
22908 + min(0.0,qfcev(mgs))
22912 & + qsdpv(mgs) + qhdpv(mgs) &
22915 & +il5(mgs)*(qiint(mgs))
22916 ELSEIF ( warmonly < 0.8 )
THEN
22919 & (qhmlr(mgs)+qhlmlr(mgs)) &
22920 & +il5(mgs)*(qhfzh(mgs)+qhlfzhl(mgs)) &
22924 & +qrfrz(mgs)+qwfrz(mgs) &
22925 & +qwctfz(mgs)+qiihr(mgs) &
22927 & +qhacw(mgs) + qhlacw(mgs) &
22928 & +qhacr(mgs) + qhlacr(mgs) )
22929 psub(mgs) = 0.0 + &
22933 & + qidpv(mgs) + qisbv(mgs) ) &
22934 & +il5(mgs)*(qiint(mgs))
22936 & qrcev(mgs) + qhcev(mgs) + qhlcev(mgs) + qfcev(mgs)
22940 pvap(mgs) = qrcev(mgs)
22944 & (felfcp(mgs)*pfrz(mgs) &
22945 & +felscp(mgs)*psub(mgs) &
22946 & +felvcp(mgs)*pvap(mgs))
22947 thetap(mgs) = thetap(mgs) + dtp*ptem(mgs)
22948 ptem2(mgs) = ptem(mgs)
22949 IF ( eqtset > 2 )
THEN
22950 pipert(mgs) = pipert(mgs) + (felfpi(mgs)*pfrz(mgs) &
22951 & +felspi(mgs)*psub(mgs) &
22952 & +felvpi(mgs)*pvap(mgs))*dtp
22966 qwvp(mgs) = qwvp(mgs) + &
22967 & dtp*(pqwvi(mgs)+pqwvd(mgs))
22968 qx(mgs,lc) = qx(mgs,lc) + &
22969 & dtp*(pqcwi(mgs)+pqcwd(mgs))
22970 qx(mgs,lr) = qx(mgs,lr) + &
22971 & dtp*(pqrwi(mgs)+pqrwd(mgs))
22972 qx(mgs,li) = qx(mgs,li) + &
22973 & dtp*(pqcii(mgs)+pqcid(mgs))
22974 qx(mgs,ls) = qx(mgs,ls) + &
22975 & dtp*(pqswi(mgs)+pqswd(mgs))
22976 qx(mgs,lh) = qx(mgs,lh) + &
22977 & dtp*(pqhwi(mgs)+pqhwd(mgs))
22979 IF ( lhl .gt. 1 )
THEN
22980 qx(mgs,lhl) = qx(mgs,lhl) + &
22981 & dtp*(pqhli(mgs)+pqhld(mgs))
22993 IF ( lvol(ls) .gt. 1 )
THEN
22994 vx(mgs,ls) = vx(mgs,ls) + &
22995 & dtp*(pvswi(mgs)+pvswd(mgs))
22998 IF ( lvol(lh) .gt. 1 )
THEN
22999 vx(mgs,lh) = vx(mgs,lh) + &
23000 & dtp*(pvhwi(mgs)+pvhwd(mgs))
23004 IF ( lhl .gt. 1 )
THEN
23005 IF ( lvol(lhl) .gt. 1 )
THEN
23006 vx(mgs,lhl) = vx(mgs,lhl) + &
23007 & dtp*(pvhli(mgs)+pvhld(mgs))
23021 if ( ipconc .ge. 1 )
then
23023 cx(mgs,li) = cx(mgs,li) + &
23024 & dtp*(pccii(mgs)+pccid(mgs))
23025 cina(mgs) = cina(mgs) + pccin(mgs)*dtp
23026 IF ( ipconc .ge. 2 )
THEN
23027 cx(mgs,lc) = cx(mgs,lc) + &
23028 & dtp*(pccwi(mgs)+pccwd(mgs))
23030 IF ( ipconc .ge. 3 )
THEN
23031 cx(mgs,lr) = cx(mgs,lr) + &
23032 & dtp*(pcrwi(mgs)+pcrwd(mgs))
23034 IF ( ipconc .ge. 4 )
THEN
23035 cx(mgs,ls) = cx(mgs,ls) + &
23036 & dtp*(pcswi(mgs)+pcswd(mgs))
23038 IF ( ipconc .ge. 5 )
THEN
23039 cx(mgs,lh) = cx(mgs,lh) + &
23040 & dtp*(pchwi(mgs)+pchwd(mgs))
23041 IF ( lhl .gt. 1 )
THEN
23042 cx(mgs,lhl) = cx(mgs,lhl) + &
23043 & dtp*(pchli(mgs)+pchld(mgs))
23050 IF ( ipconc .ge. 6 )
THEN
23051 IF ( lzr .gt. 1 )
THEN
23052 zx(mgs,lr) = zx(mgs,lr) + &
23053 & dtp*(pzrwi(mgs)+pzrwd(mgs))
23055 IF ( lzs .gt. 1 )
THEN
23056 zx(mgs,ls) = zx(mgs,ls) + &
23057 & dtp*(pzswi(mgs)+pzswd(mgs))
23059 IF ( lzh .gt. 1 )
THEN
23060 zx(mgs,lh) = zx(mgs,lh) + &
23061 & dtp*(pzhwi(mgs)+pzhwd(mgs))
23063 IF ( lzhl .gt. 1 )
THEN
23064 zx(mgs,lhl) = zx(mgs,lhl) + &
23065 & dtp*(pzhli(mgs)+pzhld(mgs))
23074 IF ( has_wetscav )
THEN
23076 evapprod2d(igs(mgs),kgs(mgs)) = -(qrcev(mgs) + qssbv(mgs) + qhsbv(mgs) + qhlsbv(mgs))
23077 rainprod2d(igs(mgs),kgs(mgs)) = qrcnw(mgs) + qracw(mgs) + qsacw(mgs) + qhacw(mgs) + qhlacw(mgs) + &
23078 qraci(mgs) + qsaci(mgs) + qhaci(mgs) + qhlaci(mgs) + qscni(mgs)
23086 if (ndebug .gt. 0 )
write(0,*)
'conc 30a'
23098 pqs(mgs) = (380.0)/(pres(mgs))
23099 theta(mgs) = thetap(mgs) + theta0(mgs)
23100 qvap(mgs) = max( (qwvp(mgs) + qv0(mgs)), 0.0 )
23101 temg(mgs) = theta(mgs)*pk(mgs)
23107 qcwtmp(mgs) = qx(mgs,lc)
23112 qitmp(mgs) = qx(mgs,li)
23113 if( temg(mgs) .gt. tfr .and. &
23114 & qitmp(mgs) .gt. 0.0 )
then
23115 qx(mgs,lc) = qx(mgs,lc) + qitmp(mgs)
23117 ptem(mgs) = ptem(mgs) + &
23119 & felfcp(mgs)*(- qitmp(mgs)*dtpinv)
23120 IF ( eqtset > 2 )
THEN
23121 pipert(mgs) = pipert(mgs) - (felfpi(mgs)*qitmp(mgs))
23123 pmlt(mgs) = pmlt(mgs) - qitmp(mgs)*dtpinv
23124 scx(mgs,lc) = scx(mgs,lc) + scx(mgs,li)
23125 thetap(mgs) = thetap(mgs) - &
23126 & fcc3(mgs)*qitmp(mgs)
23127 ptimlw(mgs) = -fcc3(mgs)*qitmp(mgs)*dtpinv
23128 cx(mgs,lc) = cx(mgs,lc) + cx(mgs,li)
23147 IF ( warmonly < 0.8 )
THEN
23150 qcwtmp(mgs) = qx(mgs,lc)
23169 if( ( ( temg(mgs) .lt. thnuc + 0.) .or. (temg(mgs) .lt. thnuc + 2. .and. ibfc >= 3) ) .and. &
23170 & qx(mgs,lc) .gt. 0.0 .and. (ipconc < 2 .or. ibfc == 0 .or. ibfc == 2))
then
23172 IF ( ibfc >= 3 )
THEN
23173 frac = max( 0.25, min( 1., ((thnuc + 2.) - temg(mgs) )/4.0 ) )
23174 ELSEIF ( ibfc /= 2 .or. ipconc < 2 )
THEN
23175 frac = max( 0.25, min( 1., ((thnuc + 1.) - temg(mgs) )/4.0 ) )
23177 volt = exp( 16.2 + 1.0*temcg(mgs) )* 1.0e-6
23181 cwfrz(mgs) = cx(mgs,lc)*exp(-volt/xv(mgs,lc))
23183 qtmp = cwfrz(mgs)*xdn0(lc)*rhoinv(mgs)*(volt + xv(mgs,lc))
23184 frac = qtmp/qx(mgs,lc)
23189 qtmp = frac*qx(mgs,lc)
23191 IF ( ibfc == 4 .and. lis >= 1 )
THEN
23192 qx(mgs,lis) = qx(mgs,lis) + qtmp
23194 qx(mgs,li) = qx(mgs,li) + qtmp
23196 pfrz(mgs) = pfrz(mgs) + qtmp*dtpinv
23197 ptem(mgs) = ptem(mgs) + &
23199 & felfcp(mgs)*(qtmp*dtpinv)
23201 IF ( eqtset > 2 )
THEN
23202 pipert(mgs) = pipert(mgs) + felfpi(mgs)*qtmp
23206 IF ( lvol(li) .gt. 1 ) vx(mgs,li) = vx(mgs,li) + rho0(mgs)*qtmp/xdn0(li)
23208 IF ( ipconc .ge. 2 )
THEN
23209 ctmp = frac*cx(mgs,lc)
23211 IF ( ibfc == 4 .and. lis >= 1 )
THEN
23212 cx(mgs,lis) = cx(mgs,lis) + ctmp
23214 cx(mgs,li) = cx(mgs,li) + ctmp
23218 IF ( t9(igs(mgs),jgs,kgs(mgs)-1) .gt. qx(mgs,lc) )
THEN
23219 qtmp = frac*t9(igs(mgs),jgs,kgs(mgs)-1)
23222 ctmp = cx(mgs,lc)*qx(mgs,lc)*rho0(mgs)/qtmp
23224 cx(mgs,lc) = max(0.0,wvel(mgs))*dtp*cwccn &
23225 & /gz(igs(mgs),jgs,kgs(mgs))
23229 IF ( ipconc .ge. 1 ) cx(mgs,li) = min(ccimx, cx(mgs,li) + cx(mgs,lc))
23232 sctmp = frac*scx(mgs,lc)
23234 scx(mgs,li) = scx(mgs,li) + sctmp
23240 thetap(mgs) = thetap(mgs) + fcc3(mgs)*qtmp
23241 ptwfzi(mgs) = fcc3(mgs)*qtmp*dtpinv
23242 qx(mgs,lc) = qx(mgs,lc) - qtmp
23243 cx(mgs,lc) = cx(mgs,lc) - ctmp
23244 scx(mgs,lc) = scx(mgs,lc) - sctmp
23258 IF ( ipconc .le. 1 .and. lwsm6 )
THEN
23261 qcwtmp(mgs) = qx(mgs,lc)
23262 theta(mgs) = thetap(mgs) + theta0(mgs)
23263 temgtmp = temg(mgs)
23267 temg(mgs) = theta(mgs)*pk(mgs)
23268 temcg(mgs) = temg(mgs) - tfr
23269 ltemq = (temg(mgs)-163.15)/fqsat+1.5
23270 ltemq = min( nqsat, max(1,ltemq) )
23272 qvs(mgs) = pqs(mgs)*tabqvs(ltemq)
23274 IF ( ( qvap(mgs) > qvs(mgs) .or. qx(mgs,lc) > qxmin(lc) ) .and. temg(mgs) > tfrh )
THEN
23275 tmp = (qvap(mgs) - qvs(mgs))/(1. + qvs(mgs)*felv(mgs)**2/(cp*rw*temg(mgs)**2) )
23276 qcond(mgs) = min( max( 0.0, tmp ), (qvap(mgs)-qvs(mgs)) )
23277 IF ( qx(mgs,lc) > qxmin(lc) .and. tmp < 0.0 )
THEN
23278 qcond(mgs) = max( tmp, -qx(mgs,lc) )
23280 qwvp(mgs) = qwvp(mgs) - qcond(mgs)
23281 qvap(mgs) = qvap(mgs) - qcond(mgs)
23282 qx(mgs,lc) = max( 0.0, qx(mgs,lc) + qcond(mgs) )
23283 thetap(mgs) = thetap(mgs) + felvcp(mgs)*qcond(mgs)/(pi0(mgs))
23292 IF ( ipconc .le. 1 .and. .not. lwsm6 )
THEN
23296 qx(mgs,lv) = max( 0.0, qvap(mgs) )
23297 qx(mgs,lc) = max( 0.0, qx(mgs,lc) )
23298 qx(mgs,li) = max( 0.0, qx(mgs,li) )
23299 qitmp(mgs) = qx(mgs,li)
23304 qcwtmp(mgs) = qx(mgs,lc)
23305 qitmp(mgs) = qx(mgs,li)
23306 theta(mgs) = thetap(mgs) + theta0(mgs)
23307 temgtmp = temg(mgs)
23308 temg(mgs) = theta(mgs)*(pinit(kgs(mgs)) + p2(igs(mgs),jgs,kgs(mgs)) )
23310 thsave(mgs) = thetap(mgs)
23311 temcg(mgs) = temg(mgs) - tfr
23312 tqvcon = temg(mgs)-cbw
23313 ltemq = (temg(mgs)-163.15)/fqsat+1.5
23314 ltemq = min( nqsat, max(1,ltemq) )
23316 qvs(mgs) = pqs(mgs)*tabqvs(ltemq)
23317 qis(mgs) = pqs(mgs)*tabqis(ltemq)
23318 qss(mgs) = qvs(mgs)
23319 if ( temg(mgs) .lt. tfr )
then
23320 if( qx(mgs,lc) .ge. 0.0 .and. qitmp(mgs) .le. qxmin(li) ) &
23321 & qss(mgs) = qvs(mgs)
23322 if( qx(mgs,lc) .le. qxmin(lc) .and. qitmp(mgs) .gt. qxmin(li)) &
23323 & qss(mgs) = qis(mgs)
23324 if( qx(mgs,lc) .gt. qxmin(lc) .and. qitmp(mgs) .gt. qxmin(li)) &
23325 & qss(mgs) = (qx(mgs,lc)*qvs(mgs) + qitmp(mgs)*qis(mgs)) / &
23326 & (qx(mgs,lc) + qitmp(mgs))
23338 qitmp(mgs) = qx(mgs,li)
23343 dqwv(mgs) = ( qx(mgs,lv) - qss(mgs) )
23347 if( dqwv(mgs) .lt. 0. )
then
23348 if( qx(mgs,lc) .gt. -dqwv(mgs) )
then
23349 dqcw(mgs) = dqwv(mgs)
23352 dqcw(mgs) = -qx(mgs,lc)
23353 dqwv(mgs) = dqwv(mgs) + qx(mgs,lc)
23356 if( qitmp(mgs) .gt. -dqwv(mgs) )
then
23357 dqci(mgs) = dqwv(mgs)
23360 dqci(mgs) = -qitmp(mgs)
23361 dqwv(mgs) = dqwv(mgs) + qitmp(mgs)
23364 qwvp(mgs) = qwvp(mgs) - ( dqcw(mgs) + dqci(mgs) )
23369 qitmp(mgs) = qx(mgs,li)
23370 IF ( qitmp(mgs) .ge. qxmin(li) )
THEN
23371 fcci(mgs) = qx(mgs,li)/(qitmp(mgs))
23375 qx(mgs,lc) = qx(mgs,lc) + dqcw(mgs)
23376 qx(mgs,li) = qx(mgs,li) + dqci(mgs) * fcci(mgs)
23377 thetap(mgs) = thetap(mgs) + &
23379 & (felvcp(mgs)*dqcw(mgs) +felscp(mgs)*dqci(mgs))
23381 IF ( eqtset > 2 )
THEN
23382 pipert(mgs) = pipert(mgs) &
23383 & +(felspi(mgs)*dqci(mgs) &
23384 & +felvpi(mgs)*dqcw(mgs))*dtp
23391 IF ( dqwv(mgs) .ge. 0. )
THEN
23395 qitmp(mgs) = qx(mgs,li)
23398 if ( temg(mgs) .lt. tfr .and. temg(mgs) .gt. thnuc )
then
23399 fracl(mgs) = max(min(1.,(temg(mgs)-233.15)/(20.)),0.0)
23400 fraci(mgs) = 1.0-fracl(mgs)
23402 if ( temg(mgs) .le. thnuc )
then
23406 fraci(mgs) = 1.0-fracl(mgs)
23408 gamss = (felvcp(mgs)*fracl(mgs) + felscp(mgs)*fraci(mgs)) &
23411 IF ( temg(mgs) .lt. tfr )
then
23412 IF (qx(mgs,lc) .ge. 0.0 .and. qitmp(mgs) .le. qxmin(li) )
then
23413 dqvcnd(mgs) = dqwv(mgs)/(1. + fcqv1(mgs)*qss(mgs)/ &
23414 & ((temg(mgs)-cbw)**2))
23416 IF ( qx(mgs,lc) .eq. 0.0 .and. qitmp(mgs) .gt. qxmin(li) )
then
23417 dqvcnd(mgs) = dqwv(mgs)/(1. + fcqv2(mgs)*qss(mgs)/ &
23418 & ((temg(mgs)-cbi)**2))
23420 IF ( qx(mgs,lc) .gt. 0.0 .and. qitmp(mgs) .gt. qxmin(li) )
then
23421 cdw = caw*pi0(mgs)*tfrcbw/((temg(mgs)-cbw)**2)
23422 cdi = cai*pi0(mgs)*tfrcbi/((temg(mgs)-cbi)**2)
23423 denom1 = qx(mgs,lc) + qitmp(mgs)
23424 denom2 = 1.0 + gamss* &
23425 & (qx(mgs,lc)*qvs(mgs)*cdw + qitmp(mgs)*qis(mgs)*cdi) / denom1
23426 dqvcnd(mgs) = dqwv(mgs) / denom2
23431 if ( temg(mgs) .ge. tfr )
then
23432 dqvcnd(mgs) = dqwv(mgs)/(1. + fcqv1(mgs)*qss(mgs)/ &
23433 & ((temg(mgs)-cbw)**2))
23438 IF ( qitmp(mgs) .gt. qxmin(li) )
THEN
23439 fcci(mgs) = qx(mgs,li)/(qitmp(mgs))
23444 dqcw(mgs) = dqvcnd(mgs)*fracl(mgs)
23445 dqci(mgs) = dqvcnd(mgs)*fraci(mgs)
23447 thetap(mgs) = thetap(mgs) + &
23448 & (felvcp(mgs)*dqcw(mgs) + felscp(mgs)*dqci(mgs)) &
23451 IF ( eqtset > 2 )
THEN
23452 pipert(mgs) = pipert(mgs) + (0 &
23453 & +felspi(mgs)*dqci(mgs) &
23454 & +felvpi(mgs)*dqcw(mgs))*dtp
23457 qwvp(mgs) = qwvp(mgs) - ( dqvcnd(mgs) )
23458 qx(mgs,lc) = qx(mgs,lc) + dqcw(mgs)
23460 qx(mgs,li) = qx(mgs,li) + dqci(mgs)*fcci(mgs)
23461 qitmp(mgs) = qx(mgs,li)
23470 qitmp(mgs) = qx(mgs,li)
23471 theta(mgs) = thetap(mgs) + theta0(mgs)
23472 temg(mgs) = theta(mgs)*pk(mgs)
23473 qvap(mgs) = max((qwvp(mgs) + qv0(mgs)), 0.0)
23474 temcg(mgs) = temg(mgs) - tfr
23475 tqvcon = temg(mgs)-cbw
23476 ltemq = (temg(mgs)-163.15)/fqsat+1.5
23477 ltemq = min( nqsat, max(1,ltemq) )
23478 qvs(mgs) = pqs(mgs)*tabqvs(ltemq)
23479 qis(mgs) = pqs(mgs)*tabqis(ltemq)
23480 qx(mgs,lc) = max( 0.0, qx(mgs,lc) )
23481 qitmp(mgs) = max( 0.0, qitmp(mgs) )
23482 qx(mgs,lv) = max( 0.0, qvap(mgs))
23496 qss(mgs) = qvs(mgs)
23497 if ( temg(mgs) .lt. tfr )
then
23498 if( qx(mgs,lc) .ge. 0.0 .and. qitmp(mgs) .le. qxmin(li) ) &
23499 & qss(mgs) = qvs(mgs)
23500 if( qx(mgs,lc) .le. qxmin(lc) .and. qitmp(mgs) .gt. qxmin(li)) &
23501 & qss(mgs) = qis(mgs)
23502 if( qx(mgs,lc) .gt. qxmin(lc) .and. qitmp(mgs) .gt. qxmin(li)) &
23503 & qss(mgs) = (qx(mgs,lc)*qvs(mgs) + qitmp(mgs)*qis(mgs)) / &
23504 & (qx(mgs,lc) + qitmp(mgs))
23523 if (ndebug .gt. 0 )
write(0,*)
'conc 30b'
23532 t0(igs(mgs),jy,kgs(mgs)) = temg(mgs)
23556 if (ndebug .gt. 0 )
write(0,*)
'gs 11'
23560 an(igs(mgs),jy,kgs(mgs),lt) = &
23561 & theta0(mgs) + thetap(mgs)
23562 an(igs(mgs),jy,kgs(mgs),lv) = qwvp(mgs) + qv0(mgs)
23564 IF ( eqtset > 2 )
THEN
23565 p2(igs(mgs),jy,kgs(mgs)) = pipert(mgs)
23570 IF ( ido(il) .eq. 1 )
THEN
23571 IF ( lf > 1 .and. il == lf )
THEN
23572 lfsave(mgs,1) = an(igs(mgs),jy,kgs(mgs),il)
23573 lfsave(mgs,2) = qx(mgs,il)
23575 an(igs(mgs),jy,kgs(mgs),il) = qx(mgs,il) + &
23576 & min( an(igs(mgs),jy,kgs(mgs),il), 0.0 )
23577 qx(mgs,il) = an(igs(mgs),jy,kgs(mgs),il)
23581 IF ( lcina > 1 )
THEN
23582 an(igs(mgs),jy,kgs(mgs),lcina) = cina(mgs)
23593 IF ( ipconc .ge. 6 )
THEN
23595 IF ( lz(il) .gt. 1 )
THEN
23596 IF ( lf > 1 .and. il == lf )
THEN
23597 lfsave(mgs,3) = an(igs(mgs),jy,kgs(mgs),lz(il))
23598 lfsave(mgs,4) = zx(mgs,il)
23601 an(igs(mgs),jy,kgs(mgs),lz(il)) = zx(mgs,il) + &
23602 & min( an(igs(mgs),jy,kgs(mgs),lz(il)), 0.0 )
23603 zx(mgs,il) = an(igs(mgs),jy,kgs(mgs),lz(il))
23613 if ( ipconc .ge. 1 )
then
23618 IF ( ipconc .ge. ipc(il) .and. ido(il) > 0 )
THEN
23620 IF ( ipconc .ge. 4 .and. ipc(il) .ge. 1 )
THEN
23625 IF ( lz(il) <= 1 .or. ioldlimiter == 1 )
THEN
23629 IF ( qx(mgs,il) .le. 0.0 )
THEN
23632 IF ( cx(mgs,il) .gt. cxmin )
THEN
23635 xv(mgs,il) = rho0(mgs)*qx(mgs,il)/(xdn(mgs,il)*cx(mgs,il))
23642 IF ( imaxdiaopt == 1 .or. il == lc .or. il == li .or. (il == lr .and. imurain == 3) .or. &
23643 & (il == ls .and. imusnow == 3 ) )
THEN
23644 xvbarmax = xvmx(il)
23645 ELSEIF ( imaxdiaopt == 2 )
THEN
23646 xvbarmax = xvmx(il) /((3. + alpha(mgs,il))**3/((3. + alpha(mgs,il))*(2. + alpha(mgs,il))*(1. + alpha(mgs,il))))
23647 ELSEIF ( imaxdiaopt == 3 )
THEN
23648 xvbarmax = xvmx(il) /((4. + alpha(mgs,il))**3/((3. + alpha(mgs,il))*(2. + alpha(mgs,il))*(1. + alpha(mgs,il))))
23650 xvbarmax = xvmx(il)
23654 IF ( il == ls )
THEN
23655 xvbarmax = xvbarmax*max(1.,100./min(100.,xdn(mgs,ls)))
23658 IF ( xv(mgs,il) .lt. xvmn(il) .or. xv(mgs,il) .gt. xvbarmax )
THEN
23659 xv(mgs,il) = min( xvbarmax, xv(mgs,il) )
23660 xv(mgs,il) = max( xvmn(il), xv(mgs,il) )
23661 cx(mgs,il) = rho0(mgs)*qx(mgs,il)/(xv(mgs,il)*xdn(mgs,il))
23674 IF ( il == lr .and. imurain == 3 )
THEN
23682 IF ( iresetmoments == 1 .or. iresetmoments == il )
THEN
23683 IF ( zx(mgs,lr) <= zxmin )
THEN
23684 qx(mgs,lv) = qx(mgs,lv) + qx(mgs,il)
23687 an(igs(mgs),jgs,kgs(mgs),lv) = an(igs(mgs),jgs,kgs(mgs),lv) + an(igs(mgs),jgs,kgs(mgs),lr)
23688 an(igs(mgs),jgs,kgs(mgs),lr) = qx(mgs,lr)
23689 an(igs(mgs),jgs,kgs(mgs),ln(lr)) = cx(mgs,lr)
23690 ELSEIF ( cx(mgs,lr) <= cxmin )
THEN
23691 qx(mgs,lv) = qx(mgs,lv) + qx(mgs,il)
23694 an(igs(mgs),jgs,kgs(mgs),lv) = an(igs(mgs),jgs,kgs(mgs),lv) + an(igs(mgs),jgs,kgs(mgs),lr)
23695 an(igs(mgs),jgs,kgs(mgs),lr) = qx(mgs,lr)
23696 an(igs(mgs),jgs,kgs(mgs),lz(lr)) = zx(mgs,lr)
23700 IF ( qx(mgs,lr) .gt. qxmin(lr) )
THEN
23702 xv(mgs,lr) = rho0(mgs)*qx(mgs,lr)/(xdn(mgs,lr)*max(1.0e-11,cx(mgs,lr)))
23703 IF ( xv(mgs,lr) .gt. xvmx(lr) )
THEN
23706 ELSEIF ( xv(mgs,lr) .lt. xvmn(lr) )
THEN
23707 xv(mgs,lr) = xvmn(lr)
23708 cx(mgs,lr) = rho0(mgs)*qx(mgs,lr)/(xvmn(lr)*xdn(mgs,lr))
23711 IF ( zx(mgs,il) > 0.0 .and. cx(mgs,il) <= 0.0 )
THEN
23713 g1 = 36.*(alpha(mgs,lr)+2.0)/((alpha(mgs,lr)+1.0)*pi**2)
23716 cx(mgs,il) = g1*dn(igs(mgs),jy,kgs(mgs))**2*(qr)*qr/(z*xdn(mgs,lr)**2)
23718 ELSEIF ( zx(mgs,il) <= zxmin .and. cx(mgs,il) > 0.0 )
THEN
23720 g1 = 36.*(alpha(mgs,lr)+2.0)/((alpha(mgs,lr)+1.0)*pi**2)
23723 zx(mgs,il) = g1*dn(igs(mgs),jy,kgs(mgs))**2*(qr)*qr/(xdn(mgs,lr)**2*chw)
23724 an(igs(mgs),jgs,kgs(mgs),lz(lr)) = zx(mgs,lr)
23726 ELSEIF ( zx(mgs,il) <= zxmin .and. cx(mgs,il) <= 0.0 )
THEN
23730 zx(mgs,il) = 1.e-19/0.224*(xdn0(lr)/xdn0(il))**2
23731 an(igs(mgs),jgs,kgs(mgs),lz(il)) = zx(mgs,il)
23733 g1 = 36.*(alpha(mgs,lr)+2.0)/((alpha(mgs,lr)+1.0)*pi**2)
23736 cx(mgs,il) = g1*dn(igs(mgs),jy,kgs(mgs))**2*(qr)*qr/(z*1000.*1000)
23737 an(igs(mgs),jgs,kgs(mgs),ln(il)) = cx(mgs,il)
23740 IF ( zx(mgs,lr) > 0.0 )
THEN
23741 xv(mgs,lr) = rho0(mgs)*qx(mgs,lr)/(1000.*cx(mgs,lr))
23751 IF ( z .gt. 0.0 )
THEN
23752 alp = 36.*(alpha(mgs,lr)+2.0)*nrx*vr**2/(z*pi**2) - 1.
23754 IF ( abs(alp - alpha(mgs,lr)) .lt. 0.01 )
EXIT
23755 alpha(mgs,lr) = max( rnumin, min( rnumax, alp ) )
23756 alp = 36.*(alpha(mgs,lr)+2.0)*nrx*vr**2/(z*pi**2) - 1.
23757 alp = max( rnumin, min( rnumax, alp ) )
23761 IF ( xv(mgs,il) .gt. xvmx(il) .or. (ioldlimiter == 2 .and. xv(mgs,il) .gt. xvmx(il)/8.) )
THEN
23765 IF ( ioldlimiter == 2 )
THEN
23766 x = (6.*rho0(mgs)*qx(mgs,il)/(pi*xdn(mgs,il)*cx(mgs,il)))**(1./3.)
23767 x1 = max(0.0e-3, x - 3.0e-3)
23768 x2 = max(0.5, x/6.0e-3)
23770 cx(mgs,il) = cx(mgs,il)*max((1.+2.222e3*x1**2), x3)
23771 xv(mgs,il) = xv(mgs,il)/max((1.+2.222e3*x1**2), x3)
23773 xv(mgs,il) = min( xvmx(il), max( xvmn(il),xv(mgs,il) ) )
23774 xmas(mgs,il) = xv(mgs,il)*xdn(mgs,il)
23775 cx(mgs,il) = rho0(mgs)*qx(mgs,il)/(xmas(mgs,il))
23781 IF ( tmp < cx(mgs,il) )
THEN
23783 g1 = 36.*(alpha(mgs,lr)+2.0)/((alpha(mgs,lr)+1.0)*pi**2)
23784 zx(mgs,il) = zx(mgs,il) + g1*(rho0(mgs)/xdn(mgs,il))**2*( (qx(mgs,il)/tmp)**2 * (tmp-cx(mgs,il)) )
23785 an(igs(mgs),jgs,kgs(mgs),lz(il)) = zx(mgs,il)
23794 alp = 36.*(alpha(mgs,lr)+2.0)*nrx*vr**2/(z*pi**2) - 1.
23796 IF ( abs(alp - alpha(mgs,lr)) .lt. 0.01 )
EXIT
23797 alpha(mgs,lr) = max( rnumin, min( rnumax, alp ) )
23798 alp = 36.*(alpha(mgs,lr)+2.0)*nrx*vr**2/(z*pi**2) - 1.
23799 alp = max( rnumin, min( rnumax, alp ) )
23810 g1 = 36.*(alpha(mgs,lr)+2.0)/((alpha(mgs,lr)+1.0)*pi**2)
23811 IF ( .true. .and. (alpha(mgs,il) <= rnumin .or. alp == rnumin .or. alp == rnumax) )
THEN
23813 IF ( rescale_high_alpha .and. alp >= rnumax - 0.01 )
THEN
23814 cx(mgs,il) = g1*dn(igs(mgs),jy,kgs(mgs))**2*(qr)*qr/z*(1./(xdn(mgs,il)))**2
23815 an(igs(mgs),jy,kgs(mgs),ln(il)) = cx(mgs,il)
23817 ELSEIF ( rescale_low_alphar .and. alp <= rnumin )
THEN
23818 z = 36.*(alpha(mgs,lr)+2.0)*nrx*vr**2/((alpha(mgs,lr)+1.0)*pi**2)
23820 an(igs(mgs),jy,kgs(mgs),lz(il)) = zx(mgs,il)
23835 ELSEIF ( il == lh .or. il == lhl .or. il == lf .or. (il == lr .and. imurain == 1 ))
THEN
23841 IF ( lf > 1 .and. il == lf )
THEN
23842 lfsave(mgs,5) = an(igs(mgs),jy,kgs(mgs),ln(il))
23843 lfsave(mgs,6) = cx(mgs,il)
23846 IF ( il == lhl .and. lnhlf > 1 )
THEN
23847 IF ( cx(mgs,lhl) > cxmin )
THEN
23848 frac = chxf(mgs,lhl)/cx(mgs,lhl)
23854 IF ( il == lh .and. lnhf > 1 )
THEN
23855 IF ( cx(mgs,lh) > cxmin )
THEN
23856 frach = chxf(mgs,lh)/cx(mgs,lh)
23864 IF ( iresetmoments == 1 .or. iresetmoments == il .or. iresetmoments == -1 )
THEN
23865 IF ( zx(mgs,il) <= zxmin )
THEN
23869 an(igs(mgs),jgs,kgs(mgs),lv) = an(igs(mgs),jgs,kgs(mgs),lv) + an(igs(mgs),jgs,kgs(mgs),il)
23870 an(igs(mgs),jgs,kgs(mgs),il) = qx(mgs,il)
23871 an(igs(mgs),jgs,kgs(mgs),ln(il)) = cx(mgs,il)
23872 ELSEIF ( iresetmoments == -1 .and. qx(mgs,il) < qxmin(il) )
THEN
23875 an(igs(mgs),jgs,kgs(mgs),lv) = an(igs(mgs),jgs,kgs(mgs),lv) + an(igs(mgs),jgs,kgs(mgs),il)
23878 an(igs(mgs),jgs,kgs(mgs),il) = qx(mgs,il)
23879 an(igs(mgs),jgs,kgs(mgs),ln(il)) = cx(mgs,il)
23880 an(igs(mgs),jgs,kgs(mgs),lz(il)) = zx(mgs,il)
23882 ELSEIF ( cx(mgs,il) <= cxmin .and. iresetmoments /= -1 )
THEN
23883 qx(mgs,lv) = qx(mgs,lv) + qx(mgs,il)
23886 an(igs(mgs),jgs,kgs(mgs),lv) = an(igs(mgs),jgs,kgs(mgs),lv) + an(igs(mgs),jgs,kgs(mgs),il)
23887 an(igs(mgs),jgs,kgs(mgs),il) = qx(mgs,il)
23888 an(igs(mgs),jgs,kgs(mgs),lz(il)) = zx(mgs,il)
23891 IF ( zx(mgs,il) < 0.0 )
THEN
23897 IF ( zx(mgs,il) <= zxmin .and. cx(mgs,il) <= cxmin )
THEN
23900 an(igs(mgs),jgs,kgs(mgs),lv) = an(igs(mgs),jgs,kgs(mgs),lv) + an(igs(mgs),jgs,kgs(mgs),il)
23902 an(igs(mgs),jgs,kgs(mgs),il) = qx(mgs,il)
23903 an(igs(mgs),jgs,kgs(mgs),ln(il)) = cx(mgs,il)
23904 an(igs(mgs),jgs,kgs(mgs),lz(il)) = zx(mgs,il)
23907 IF ( qx(mgs,il) .gt. qxmin(il) )
THEN
23909 xv(mgs,il) = rho0(mgs)*qx(mgs,il)/(xdn(mgs,il)*max(1.0e-9,cx(mgs,il)))
23910 xmas(mgs,il) = xv(mgs,il)*xdn(mgs,il)
23912 IF ( xv(mgs,il) .lt. xvmn(il) )
THEN
23913 xv(mgs,il) = min( xvmx(il), max( xvmn(il),xv(mgs,il) ) )
23914 xmas(mgs,il) = xv(mgs,il)*xdn(mgs,il)
23915 cx(mgs,il) = rho0(mgs)*qx(mgs,il)/(xmas(mgs,il))
23918 IF ( zx(mgs,il) > 0.0 .and. cx(mgs,il) <= 0.0 )
THEN
23920 g1 = (6.0 + alpha(mgs,il))*(5.0 + alpha(mgs,il))*(4.0 + alpha(mgs,il))/ &
23921 & ((3.0 + alpha(mgs,il))*(2.0 + alpha(mgs,il))*(1.0 + alpha(mgs,il)))
23925 cx(mgs,il) = g1*dn(igs(mgs),jy,kgs(mgs))**2*(6.*qr)**2/(z*(pi*xdn(mgs,il))**2)
23928 ELSEIF ( zx(mgs,il) <= zxmin .and. cx(mgs,il) > 0.0 )
THEN
23936 g1 = (6.0 + alphamax)*(5.0 + alphamax)*(4.0 + alphamax)/ &
23937 & ((3.0 + alphamax)*(2.0 + alphamax)*(1.0 + alphamax))
23938 zx(mgs,il) = max(zxmin*1.1, g1*dn(igs(mgs),jy,kgs(mgs))**2*(6*qr)**2/(chw*(pi*xdn(mgs,il))**2) )
23939 an(igs(mgs),jgs,kgs(mgs),lz(il)) = zx(mgs,il)
23941 ELSEIF ( zx(mgs,il) <= zxmin .and. cx(mgs,il) <= 0.0 )
THEN
23948 zx(mgs,il) = 1.e-19/0.224*(xdn0(lr)/xdn0(il))**2
23949 an(igs(mgs),jgs,kgs(mgs),lz(il)) = zx(mgs,il)
23951 g1 = (6.0 + alpha(mgs,il))*(5.0 + alpha(mgs,il))*(4.0 + alpha(mgs,il))/ &
23952 & ((3.0 + alpha(mgs,il))*(2.0 + alpha(mgs,il))*(1.0 + alpha(mgs,il)))
23956 cx(mgs,il) = g1*dn(igs(mgs),jy,kgs(mgs))**2*(6.*qr)**2/(z*(pi*xdn(mgs,il))**2)
23957 an(igs(mgs),jgs,kgs(mgs),ln(il)) = cx(mgs,il)
23967 IF ( zx(mgs,il) .gt. 0. )
THEN
23970 rdi = z*(pi/6.*xdn(mgs,il))**2*chw/((rho0(mgs)*qr)**2)
23974 alp = (6.0+alpha(mgs,il))*(5.0+alpha(mgs,il))*(4.0+alpha(mgs,il))/ &
23975 & ((3.0+alpha(mgs,il))*(2.0+alpha(mgs,il))*rdi) - 1.0
23979 IF ( abs(alp - alpha(mgs,il)) .lt. 0.01 )
EXIT
23980 alpha(mgs,il) = max( alphamin, min( alphamax, alp ) )
23983 alp = (6.+alpha(mgs,il))*(5.0+alpha(mgs,il))*(4.0+alpha(mgs,il))/ &
23984 & ((3.0+alpha(mgs,il))*(2.0+alpha(mgs,il))*rdi) - 1.0
23986 alp = max( alphamin, min( alphamax, alp ) )
23991 IF ( xv(mgs,il) .gt. xvmx(il) )
THEN
23995 xv(mgs,il) = min( xvmx(il), max( xvmn(il),xv(mgs,il) ) )
23996 xmas(mgs,il) = xv(mgs,il)*xdn(mgs,il)
23997 cx(mgs,il) = rho0(mgs)*qx(mgs,il)/(xmas(mgs,il))
23998 IF ( tmp < cx(mgs,il) )
THEN
23999 g1 = 36.*(6.0 + alpha(mgs,il))*(5.0 + alpha(mgs,il))*(4.0 + alpha(mgs,il))/ &
24000 & ((3.0 + alpha(mgs,il))*(2.0 + alpha(mgs,il))*(1.0 + alpha(mgs,il))*pi**2)
24001 zx(mgs,il) = zx(mgs,il) + g1*(rho0(mgs)/xdn(mgs,il))**2*( (qx(mgs,il)/tmp)**2 * (tmp-cx(mgs,il)) )
24002 an(igs(mgs),jgs,kgs(mgs),lz(il)) = zx(mgs,il)
24008 rdi = z*(pi/6.*xdn(mgs,il))**2*chw/((rho0(mgs)*qr)**2)
24009 alp = (6.0+alpha(mgs,il))*(5.0+alpha(mgs,il))*(4.0+alpha(mgs,il))/ &
24010 & ((3.0+alpha(mgs,il))*(2.0+alpha(mgs,il))*rdi) - 1.0
24012 IF ( abs(alp - alpha(mgs,il)) .lt. 0.01 )
EXIT
24013 alpha(mgs,il) = max( alphamin, min( alphamax, alp ) )
24014 alp = (6.+alpha(mgs,il))*(5.0+alpha(mgs,il))*(4.0+alpha(mgs,il))/ &
24015 & ((3.0+alpha(mgs,il))*(2.0+alpha(mgs,il))*rdi) - 1.0
24016 alp = max( alphamin, min( alphamax, alp ) )
24027 g1 = (6.0 + alpha(mgs,il))*(5.0 + alpha(mgs,il))*(4.0 + alpha(mgs,il))/ &
24028 & ((3.0 + alpha(mgs,il))*(2.0 + alpha(mgs,il))*(1.0 + alpha(mgs,il)))
24030 IF ( ( lrescalelow(il) .or. rescale_high_alpha ) .and. &
24031 & ( alpha(mgs,il) <= alphamin .or. alp == alphamin .or. alp == alphamax ) )
THEN
24033 IF ( rescale_high_alpha .and. alp >= alphamax - 0.01 )
THEN
24034 cx(mgs,il) = g1*dn(igs(mgs),jy,kgs(mgs))**2*(qr)*qr/z*(6./(pi*xdn(mgs,il)))**2
24035 an(igs(mgs),jy,kgs(mgs),ln(il)) = cx(mgs,il)
24037 ELSEIF ( lrescalelow(il) .and. alp <= alphamin .and. .not. (il == lh .and. icvhl2h > 0 ) .and. &
24038 .not. ( il == lr .and. .not. rescale_low_alphar ) )
THEN
24041 IF ( irescalerainopt == 0 )
THEN
24043 ELSEIF ( irescalerainopt == 1 )
THEN
24044 wtest = qx(mgs,lc) > qxmin(lc)
24045 ELSEIF ( irescalerainopt == 2 )
THEN
24046 wtest = qx(mgs,lc) > qxmin(lc) .and. wvel(mgs) < rescale_wthresh
24047 ELSEIF ( irescalerainopt == 3 )
THEN
24048 wtest = temcg(mgs) > rescale_tempthresh .and. qx(mgs,lc) > qxmin(lc) .and. wvel(mgs) < rescale_wthresh
24051 IF ( il == lr .and. ( wtest .or. .not. rescale_low_alphar ) )
THEN
24054 chw = g1*dn(igs(mgs),jy,kgs(mgs))**2*(qr)*qr/z*(6./(pi*xdn(mgs,il)))**2
24056 an(igs(mgs),jy,kgs(mgs),ln(il)) = chw
24059 z1 = g1*dn(igs(mgs),jy,kgs(mgs))**2*(qr)*qr/chw
24060 z = z1*(6./(pi*xdn(mgs,il)))**2
24062 an(igs(mgs),jy,kgs(mgs),lz(il)) = z
24083 IF ( lzr > 1 )
THEN
24084 alpha2d(igs(mgs),kgs(mgs),1) = max(alphamin, min(alphamax, alpha(mgs,lr) ))
24086 IF ( lzh > 1 )
THEN
24087 alpha2d(igs(mgs),kgs(mgs),2) = max(alphamin, min(alphamax, alpha(mgs,lh) ))
24089 IF ( lzhl > 1 )
THEN
24090 alpha2d(igs(mgs),kgs(mgs),3) = max(alphamin, min(alphamax, alpha(mgs,lhl) ))
24093 IF ( il == lhl .and. lnhlf > 1 )
THEN
24095 chxf(mgs,lhl) = frac*cx(mgs,lhl)
24097 IF ( il == lh .and. lnhf > 1 )
THEN
24099 chxf(mgs,lh) = frach*cx(mgs,lh)
24127 IF ( il == lh )
THEN
24128 IF ( lnhf > 1 )
THEN
24129 an(igs(mgs),jy,kgs(mgs),lnhf) = max( chxf(mgs,lh), 0.0)
24133 IF ( il == lhl )
THEN
24135 IF ( lnhlf > 1 )
THEN
24137 an(igs(mgs),jy,kgs(mgs),lnhlf) = max( chxf(mgs,lhl), 0.0)
24140 an(igs(mgs),jy,kgs(mgs),ln(il)) = max(cx(mgs,il), 0.0)
24145 IF ( lcin > 1 )
THEN
24147 an(igs(mgs),jy,kgs(mgs),lcin) = max(0.0, ccin(mgs))
24151 IF ( ipconc .ge. 2 )
THEN
24153 IF ( lss > 1 )
THEN
24154 an(igs(mgs),jy,kgs(mgs),lss) = max(0.0, ssmax(mgs) )
24157 IF ( lccn > 1 )
THEN
24158 an(igs(mgs),jy,kgs(mgs),lccn) = max(0.0, ccnc(mgs) )
24163 ELSEIF ( ipconc .eq. 0 .and. lni .gt. 1 )
THEN
24166 an(igs(mgs),jy,kgs(mgs),lni) = max(cx(mgs,li), 0.0)
24176 IF ( lvol(il) .ge. 1 )
THEN
24180 an(igs(mgs),jy,kgs(mgs),lvol(il)) = max( 0.0, vx(mgs,il) )
24193 if (ndebug .gt. 0 )
write(0,*)
'gs 12'
24197 if (ndebug .gt. 0 )
write(0,*)
'gs 13'
24201 if ( kz .gt. nz-1 .and. ix .ge. itile)
then
24202 if ( ix .ge. itile )
then
24211 if ( ix .ge. itile )
then