22 subroutine redist (ipart,ktop,ipconv)
42 real,
parameter :: const=r_air/ga
43 integer :: ipart, ktop,ipconv
44 integer :: k, kz, levnew, levold
45 real,
save :: uvzlev(nuvzmax)
47 real :: totlevmass, wsubpart
48 real :: temp_levold,temp_levold1
49 real :: sub_levold,sub_levold1
50 real :: pint, pold, rn, tv, tvold, dlevfrac
51 real ::
ew,
ran3, ztold,ffraction
52 real :: tv1, tv2, dlogp, dz, dz1, dz2
53 integer :: iseed = -88
66 tvold=tt2conv*(1.+0.378*
ew(td2conv)/psconv)
72 tv1 = tconv(1)*(1.+0.608*qconv(1))
73 tv2 = tconv(2)*(1.+0.608*qconv(2))
75 tv = tv1 + (tv2-tv1)*(pconv(1)-phconv(2))/(pconv(1)-pconv(2))
76 if (abs(tv-tvold).gt.0.2)
then
77 uvzlev(2) = uvzlev(1) + &
78 const*log(pold/pint)* &
79 (tv-tvold)/log(tv/tvold)
81 uvzlev(2) = uvzlev(1)+ &
82 const*log(pold/pint)*tv
97 tv2 = tconv(kz)*(1.+0.608*qconv(kz))
99 tv = tv1 + (tv2-tv1)*(pconv(kz-1)-phconv(kz))/ &
100 (pconv(kz-1)-pconv(kz))
101 if (abs(tv-tvold).gt.0.2)
then
102 uvzlev(kz) = uvzlev(kz-1) + &
103 const*log(pold/pint)* &
104 (tv-tvold)/log(tv/tvold)
106 uvzlev(kz) = uvzlev(kz-1)+ &
107 const*log(pold/pint)*tv
122 ztold = ztra1(abs(ipart))
125 if (uvzlev(kz) .ge. ztold )
then
149 totlevmass=dpr(levold)/ga
152 if (ldirect.eq.1)
then
153 ffraction=ffraction+fmassfrac(levold,k) &
156 ffraction=ffraction+fmassfrac(k,levold) &
159 if (rn.le.ffraction)
then
164 if (ffraction.gt.1.e-20)
then
165 if (ldirect.eq.1)
then
166 dlevfrac = (ffraction-rn) / fmassfrac(levold,k) * totlevmass
168 dlevfrac = (ffraction-rn) / fmassfrac(k,levold) * totlevmass
181 if (levnew.le.nconvtop)
then
182 if (levnew.eq.levold)
then
183 ztra1(abs(ipart)) = ztold
185 dlogp = (1.-dlevfrac)* &
186 (log(phconv(levnew+1))-log(phconv(levnew)))
187 pint = log(phconv(levnew))+dlogp
188 dz1 = pint - log(phconv(levnew))
189 dz2 = log(phconv(levnew+1)) - pint
191 ztra1(abs(ipart)) = (uvzlev(levnew)*dz2+uvzlev(levnew+1)*dz1)/dz
192 if (ztra1(abs(ipart)).lt.0.) &
193 ztra1(abs(ipart))=-1.*ztra1(abs(ipart))
194 if (ipconv.gt.0) ipconv=-1
203 if (levnew.le.nconvtop.and.levnew.eq.levold)
then
205 ztold = ztra1(abs(ipart))
212 if (levold.gt.1)
then
213 temp_levold = tconv(levold-1) + &
214 (tconv(levold)-tconv(levold-1)) &
215 *(pconv(levold-1)-phconv(levold))/ &
216 (pconv(levold-1)-pconv(levold))
217 sub_levold = sub(levold)/(1.-sub(levold)/dpr(levold)*ga)
218 wsub(levold)=-1.*sub_levold*r_air*temp_levold/(phconv(levold))
223 temp_levold1 = tconv(levold) + &
224 (tconv(levold+1)-tconv(levold)) &
225 *(pconv(levold)-phconv(levold+1))/ &
226 (pconv(levold)-pconv(levold+1))
227 sub_levold1 = sub(levold+1)/(1.-sub(levold+1)/dpr(levold+1)*ga)
228 wsub(levold+1)=-1.*sub_levold1*r_air*temp_levold1/ &
233 dz1 = ztold - uvzlev(levold)
234 dz2 = uvzlev(levold+1) - ztold
237 wsubpart = (dz2*wsub(levold)+dz1*wsub(levold+1))/dz
238 ztra1(abs(ipart)) = ztold+wsubpart*
real(lsynctime)
239 if (ztra1(abs(ipart)).lt.0.)
then
240 ztra1(abs(ipart))=-1.*ztra1(abs(ipart))
250 if (ztra1(abs(ipart)) .gt. height(nz)-0.5) &
251 ztra1(abs(ipart)) = height(nz)-0.5
subroutine redist(ipart, ktop, ipconv)