5 SUBROUTINE newmicro (ok_cdnc, bl95_b0, bl95_b1,
7 . t, pqlwp, pclc, pcltau, pclemi,
8 . pch, pcl, pcm, pct, pctlwp,
9 . xflwp, xfiwp, xflwc, xfiwc,
10 . mass_solu_aero, mass_solu_aero_pi,
11 . pcldtaupi, re, fl, reliq, reice)
15 . reffclws,reffclwc,cldnvi,lcc3d,
57 LOGICAL random, maximum_random, maximum
60 LOGICAL,
SAVE :: first=.true.
65 REAL thres_tau,thres_neb
68 REAL phase3d(klon,
klev)
69 REAL tcc(klon), ftmp(klon), lcc_integrat(klon),
height(klon)
71 REAL paprs(klon,
klev+1)
76 REAL pcltau(klon,
klev)
77 REAL pclemi(klon,
klev)
78 REAL pcldtaupi(klon,
klev)
96 parameter(prmhc = 440.*100., prlmc = 680.*100.)
99 REAL xflwp(klon), xfiwp(klon)
100 REAL xflwc(klon,
klev), xfiwc(klon,
klev)
104 REAL coef_froi, coef_chau
105 parameter(coef_chau=0.13, coef_froi=0.09)
115 REAL k_ice0, k_ice, df
122 REAL mass_solu_aero(klon,
klev)
123 REAL mass_solu_aero_pi(klon,
klev)
124 REAL cdnc(klon,
klev)
126 REAL cdnc_pi(klon,
klev)
127 REAL re_pi(klon,
klev)
132 REAL bl95_b0, bl95_b1
141 REAL rhodz(klon,
klev)
142 REAL zrho(klon,
klev)
144 REAL zfice(klon,
klev)
145 REAL rad_chaud(klon,
klev)
146 REAL zflwp_var, zfiwp_var
150 Real reliq(klon,
klev), reice(klon,
klev)
164 d_rei_dt=(rei_max-
rei_min)/81.4
165 if (abs(d_rei_dt-0.71)<1.e-4) d_rei_dt=0.71
182 rhodz(
i,
k) = (paprs(
i,
k)-paprs(
i,
k+1))/rg
184 dh(
i,
k)=rhodz(
i,
k)/zrho(
i,
k)
188 zfice(
i,
k) = min(max(zfice(
i,
k),0.0),1.0)
190 xflwc(
i,
k) = (1.-zfice(
i,
k))*pqlwp(
i,
k)
191 xfiwc(
i,
k) = zfice(
i,
k)*pqlwp(
i,
k)
207 cdnc(
i,
k) = 10.**(bl95_b0+bl95_b1*
208 & log(max(mass_solu_aero(
i,
k),1.e-4))/log(10.))*1.e6
209 cdnc(
i,
k)=min(1000.e6,max(20.e6,cdnc(
i,
k)))
212 cdnc_pi(
i,
k) = 10.**(bl95_b0+bl95_b1*
213 & log(max(mass_solu_aero_pi(
i,
k),1.e-4))/log(10.))
215 cdnc_pi(
i,
k)=min(1000.e6,max(20.e6,cdnc_pi(
i,
k)))
220 & /(4./3*rpi*1000.*cdnc(
i,
k)) )**(1./3.)
221 rad_chaud(
i,
k) = max(rad_chaud(
i,
k) * 1.e6, 5.)
226 & /(4./3.*rpi*1000.*cdnc_pi(
i,
k)))**(1./3.)
227 radius = max(radius*1.e6, 5.)
231 IF (pclc(
i,
k) .LE. seuil_neb)
THEN
237 zflwp_var= 1000.*(1.-zfice(
i,
k))*pqlwp(
i,
k)/pclc(
i,
k)
239 zfiwp_var= 1000.*zfice(
i,
k)*pqlwp(
i,
k)/pclc(
i,
k)
242 rei = d_rei_dt*tc + rei_max
249 if (zflwp_var.eq.0.) radius = 1.
250 if (zfiwp_var.eq.0. .or. rei.le.0.) rei = 1.
251 pcldtaupi(
i,
k) = 3.0/2.0 * zflwp_var / radius
252 & + zfiwp_var * (3.448e-03 + 2.431/rei)
263 DO k = 1, min(3,
klev)
282 IF (pclc(
i,
k) .LE. seuil_neb)
THEN
291 fl(
i,
k) = seuil_neb*(1.-zfice(
i,
k))
292 re(
i,
k) = rad_chaud(
i,
k)*fl(
i,
k)
303 zflwp_var= 1000.*(1.-zfice(
i,
k))*pqlwp(
i,
k)/pclc(
i,
k)
305 zfiwp_var= 1000.*zfice(
i,
k)*pqlwp(
i,
k)/pclc(
i,
k)
315 fl(
i,
k) = pclc(
i,
k)*(1.-zfice(
i,
k))
316 re(
i,
k) = rad_chaud(
i,
k)*fl(
i,
k)
327 rei = d_rei_dt*tc + rei_max
334 if (zflwp_var.eq.0.) rel = 1.
335 if (zfiwp_var.eq.0. .or. rei.le.0.) rei = 1.
336 pcltau(
i,
k) = 3.0/2.0 * ( zflwp_var/rel )
337 & + zfiwp_var * (3.448e-03 + 2.431/rei)
344 k_ice = k_ice0 + 1.0/rei
347 & - exp( -coef_chau*zflwp_var - df*k_ice*zfiwp_var)
354 xflwp(
i) = xflwp(
i)+ xflwc(
i,
k) * rhodz(
i,
k)
355 xfiwp(
i) = xfiwp(
i)+ xfiwc(
i,
k) * rhodz(
i,
k)
362 IF (.NOT.ok_cdnc)
THEN
365 pcldtaupi(
i,
k)=pcltau(
i,
k)
390 pctlwp(
i) = pctlwp(
i)+ pqlwp(
i,
k)*rhodz(
i,
k)
399 zclear(
i)=zclear(
i)*(1.-max(pclc(
i,
k),zcloud(
i)))
400 & /(1.-min(
REAL(zcloud(i), kind=8),1.-zepsec))
402 IF (paprs(
i,
k).LT.prmhc)
THEN
403 pch(
i) = pch(
i)*(1.-max(pclc(
i,
k),zcloudh(
i)))
404 & /(1.-min(
REAL(zcloudh(i), kind=8),1.-zepsec))
406 ELSE IF (paprs(
i,
k).GE.prmhc .AND.
407 & paprs(
i,
k).LT.prlmc)
THEN
408 pcm(
i) = pcm(
i)*(1.-max(pclc(
i,
k),zcloudm(
i)))
409 & /(1.-min(
REAL(zcloudm(i), kind=8),1.-zepsec))
411 ELSE IF (paprs(
i,
k).GE.prlmc)
THEN
412 pcl(
i) = pcl(
i)*(1.-max(pclc(
i,
k),zcloudl(
i)))
413 & /(1.-min(
REAL(zcloudl(i), kind=8),1.-zepsec))
419 ELSE IF (novlp.EQ.2)
THEN
422 zcloud(
i)=max(pclc(
i,
k),zcloud(
i))
424 IF (paprs(
i,
k).LT.prmhc)
THEN
425 pch(
i) = min(pclc(
i,
k),pch(
i))
426 ELSE IF (paprs(
i,
k).GE.prmhc .AND.
427 & paprs(
i,
k).LT.prlmc)
THEN
428 pcm(
i) = min(pclc(
i,
k),pcm(
i))
429 ELSE IF (paprs(
i,
k).GE.prlmc)
THEN
430 pcl(
i) = min(pclc(
i,
k),pcl(
i))
434 ELSE IF (novlp.EQ.3)
THEN
437 zclear(
i)=zclear(
i)*(1.-pclc(
i,
k))
439 IF (paprs(
i,
k).LT.prmhc)
THEN
440 pch(
i) = pch(
i)*(1.0-pclc(
i,
k))
441 ELSE IF (paprs(
i,
k).GE.prmhc .AND.
442 & paprs(
i,
k).LT.prlmc)
THEN
443 pcm(
i) = pcm(
i)*(1.0-pclc(
i,
k))
444 ELSE IF (paprs(
i,
k).GE.prlmc)
THEN
445 pcl(
i) = pcl(
i)*(1.0-pclc(
i,
k))
471 phase3d(
i,
k)=1-zfice(
i,
k)
472 IF (pclc(
i,
k) .LE. seuil_neb)
THEN
473 lcc3d(
i,
k)=seuil_neb*phase3d(
i,
k)
475 lcc3d(
i,
k)=pclc(
i,
k)*phase3d(
i,
k)
477 scdnc(
i,
k)=lcc3d(
i,
k)*cdnc(
i,
k)
485 IF(random .OR. maximum_random) tcc(
i) = 1.
486 IF(maximum) tcc(
i) = 0.
495 IF (pcltau(
i,
k).GT.thres_tau
496 . .AND. pclc(
i,
k).GT.thres_neb)
THEN
500 write(*,*)
'Hypothese de recouvrement: MAXIMUM'
504 ftmp(
i) = max(tcc(
i),pclc(
i,
k))
509 write(*,*)
'Hypothese de recouvrement: RANDOM'
513 ftmp(
i) = tcc(
i) * (1-pclc(
i,
k))
516 IF (maximum_random)
THEN
519 'Hypothese de recouvrement: MAXIMUM_ . RANDOM'
524 . (1. - max(pclc(
i,
k),pclc(
i,
k+1))) /
525 . (1. - min(pclc(
i,
k+1),1.-thres_neb))
528 reffclwtop(
i) = reffclwtop(
i) + rad_chaud(
i,
k) *
529 . 1.0e-06 * phase3d(
i,
k) * ( tcc(
i) - ftmp(
i))*flag_max
531 cldncl(
i) = cldncl(
i) + cdnc(
i,
k) * phase3d(
i,
k) *
532 . (tcc(
i) - ftmp(
i))*flag_max
534 lcc(
i) = lcc(
i) + phase3d(
i,
k) * (tcc(
i)-ftmp(
i))*
542 IF (random .OR. maximum_random) tcc(
i)=1.-tcc(
i)
550 lcc3dcon(
i,
k) =rnebcon(
i,
k)*phase3d(
i,
k)*clwcon(
i,
k)
551 lcc3dstra(
i,
k)=pclc(
i,
k)*pqlwp(
i,
k)*phase3d(
i,
k)
552 lcc3dstra(
i,
k)=lcc3dstra(
i,
k)-lcc3dcon(
i,
k)
553 lcc3dstra(
i,
k)=max(lcc3dstra(
i,
k),0.0)
556 & /(4./3*rpi*1000.*cdnc(
i,
k)) )**(1./3.)
557 radius=max(radius, 5.e-6)
560 reffclwc(
i,
k)=reffclwc(
i,
k)*lcc3dcon(
i,
k)
563 reffclws(
i,
k)=reffclws(
i,
k)*lcc3dstra(
i,
k)
574 cldnvi(
i)=cldnvi(
i)+cdnc(
i,
k)*lcc3d(
i,
k)*dh(
i,
k)
575 lcc_integrat(
i)=lcc_integrat(
i)+lcc3d(
i,
k)*dh(
i,
k)
578 lcc_integrat(
i)=lcc_integrat(
i)/
height(
i)
579 IF (lcc_integrat(
i) .LE. 1.0e-03)
THEN
580 cldnvi(
i)=cldnvi(
i)*lcc(
i)/seuil_neb
582 cldnvi(
i)=cldnvi(
i)*lcc(
i)/lcc_integrat(
i)
588 IF (scdnc(
i,
k) .LE. 0.0) scdnc(
i,
k)=0.0
589 IF (reffclws(
i,
k) .LE. 0.0) reffclws(
i,
k)=0.0
590 IF (reffclwc(
i,
k) .LE. 0.0) reffclwc(
i,
k)=0.0
591 IF (lcc3d(
i,
k) .LE. 0.0) lcc3d(
i,
k)=0.0
592 IF (lcc3dcon(
i,
k) .LE. 0.0) lcc3dcon(
i,
k)=0.0
593 IF (lcc3dstra(
i,
k) .LE. 0.0) lcc3dstra(
i,
k)=0.0
595 IF (reffclwtop(
i) .LE. 0.0) reffclwtop(
i)=0.0
596 IF (cldncl(
i) .LE. 0.0) cldncl(
i)=0.0
597 IF (cldnvi(
i) .LE. 0.0) cldnvi(
i)=0.0
598 IF (lcc(
i) .LE. 0.0) lcc(
i)=0.0