source: LMDZ5/branches/LMDZ5_SPLA/libf/phylmd/newmicro.F90 @ 2699

Last change on this file since 2699 was 2006, checked in by fhourdin, 11 years ago

Modification de la spécification de la plage de température pour
la phase mixte liquide/glace des nuages.
Contrôle par les paramètres t_glace_min/max, exposant_glace, iflag_t_glace

Modifying the specification of the mixte liquid/ice phase for cloud water.

Jean-Baptiste Madeleine
  • Property copyright set to
    Name of program: LMDZ
    Creation date: 1984
    Version: LMDZ5
    License: CeCILL version 2
    Holder: Laboratoire de m\'et\'eorologie dynamique, CNRS, UMR 8539
    See the license file in the root directory
  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 20.1 KB
Line 
1! $Id: newmicro.F90 2006 2014-04-06 11:31:28Z oboucher $
2
3
4
5SUBROUTINE newmicro(ok_cdnc, bl95_b0, bl95_b1, paprs, pplay, t, pqlwp, pclc, &
6    pcltau, pclemi, pch, pcl, pcm, pct, pctlwp, xflwp, xfiwp, xflwc, xfiwc, &
7    mass_solu_aero, mass_solu_aero_pi, pcldtaupi, re, fl, reliq, reice, &
8    reliq_pi, reice_pi)
9
10  USE dimphy
11  USE phys_local_var_mod, ONLY: scdnc, cldncl, reffclwtop, lcc, reffclws, &
12    reffclwc, cldnvi, lcc3d, lcc3dcon, lcc3dstra
13  USE phys_state_var_mod, ONLY: rnebcon, clwcon
14  USE microphys_mod ! cloud microphysics (JBM 3/14)
15  IMPLICIT NONE
16  ! ======================================================================
17  ! Auteur(s): Z.X. Li (LMD/CNRS) date: 19930910
18  ! O.   Boucher (LMD/CNRS) mise a jour en 201212
19  ! Objet: Calculer epaisseur optique et emmissivite des nuages
20  ! ======================================================================
21  ! Arguments:
22  ! ok_cdnc-input-L-flag pour calculer les rayons a partir des aerosols
23
24  ! t-------input-R-temperature
25  ! pqlwp---input-R-eau liquide nuageuse dans l'atmosphere dans la partie
26  ! nuageuse (kg/kg)
27  ! pclc----input-R-couverture nuageuse pour le rayonnement (0 a 1)
28  ! mass_solu_aero-----input-R-total mass concentration for all soluble
29  ! aerosols[ug/m^3]
30  ! mass_solu_aero_pi--input-R-ditto, pre-industrial value
31
32  ! bl95_b0-input-R-a PARAMETER, may be varied for tests (s-sea, l-land)
33  ! bl95_b1-input-R-a PARAMETER, may be varied for tests (    -"-      )
34
35  ! re------output-R-Cloud droplet effective radius multiplied by fl [um]
36  ! fl------output-R-Denominator to re, introduced to avoid problems in
37  ! the averaging of the output. fl is the fraction of liquid
38  ! water clouds within a grid cell
39
40  ! pcltau--output-R-epaisseur optique des nuages
41  ! pclemi--output-R-emissivite des nuages (0 a 1)
42  ! pcldtaupi-output-R-pre-industrial value of cloud optical thickness,
43
44  ! pcl-output-R-2D low-level cloud cover
45  ! pcm-output-R-2D mid-level cloud cover
46  ! pch-output-R-2D high-level cloud cover
47  ! pct-output-R-2D total cloud cover
48  ! ======================================================================
49
50  include "YOMCST.h"
51  include "nuage.h"
52  include "radepsi.h"
53  include "radopt.h"
54
55  ! choix de l'hypothese de recouvrememnt nuageuse
56  LOGICAL random, maximum_random, maximum
57  PARAMETER (random=.FALSE., maximum_random=.TRUE., maximum=.FALSE.)
58
59  LOGICAL, SAVE :: first = .TRUE.
60  !$OMP THREADPRIVATE(FIRST)
61  INTEGER flag_max
62
63  ! threshold PARAMETERs
64  REAL thres_tau, thres_neb
65  PARAMETER (thres_tau=0.3, thres_neb=0.001)
66
67  REAL phase3d(klon, klev)
68  REAL tcc(klon), ftmp(klon), lcc_integrat(klon), height(klon)
69
70  REAL paprs(klon, klev+1)
71  REAL pplay(klon, klev)
72  REAL t(klon, klev)
73  REAL pclc(klon, klev)
74  REAL pqlwp(klon, klev)
75  REAL pcltau(klon, klev)
76  REAL pclemi(klon, klev)
77  REAL pcldtaupi(klon, klev)
78
79  REAL pct(klon)
80  REAL pcl(klon)
81  REAL pcm(klon)
82  REAL pch(klon)
83  REAL pctlwp(klon)
84
85  LOGICAL lo
86
87  ! !Abderr modif JL mail du 19.01.2011 18:31
88  ! REAL cetahb, cetamb
89  ! PARAMETER (cetahb = 0.45, cetamb = 0.80)
90  ! Remplacer
91  ! cetahb*paprs(i,1) par  prmhc
92  ! cetamb*paprs(i,1) par  prlmc
93  REAL prmhc ! Pressure between medium and high level cloud in Pa
94  REAL prlmc ! Pressure between low and medium level cloud in Pa
95  PARAMETER (prmhc=440.*100., prlmc=680.*100.)
96
97  INTEGER i, k
98  REAL xflwp(klon), xfiwp(klon)
99  REAL xflwc(klon, klev), xfiwc(klon, klev)
100
101  REAL radius
102
103  REAL coef_froi, coef_chau
104  PARAMETER (coef_chau=0.13, coef_froi=0.09)
105
106  REAL seuil_neb
107  PARAMETER (seuil_neb=0.001)
108
109! JBM (3/14) nexpo is replaced by exposant_glace
110! INTEGER nexpo ! exponentiel pour glace/eau
111! PARAMETER (nexpo=6)
112! PARAMETER (nexpo=1)
113! if iflag_t_glace=0, the old values are used:
114  REAL, PARAMETER :: t_glace_min_old = 258.
115  REAL, PARAMETER :: t_glace_max_old = 273.13
116
117  REAL rel, tc, rei
118  REAL k_ice0, k_ice, df
119  PARAMETER (k_ice0=0.005) ! units=m2/g
120  PARAMETER (df=1.66) ! diffusivity factor
121
122  ! jq for the aerosol indirect effect
123  ! jq introduced by Johannes Quaas (quaas@lmd.jussieu.fr), 27/11/2003
124  ! jq
125  REAL mass_solu_aero(klon, klev) ! total mass concentration for all soluble aerosols [ug m-3]
126  REAL mass_solu_aero_pi(klon, klev) ! - " - (pre-industrial value)
127  REAL cdnc(klon, klev) ! cloud droplet number concentration [m-3]
128  REAL re(klon, klev) ! cloud droplet effective radius [um]
129  REAL cdnc_pi(klon, klev) ! cloud droplet number concentration [m-3] (pi value)
130  REAL re_pi(klon, klev) ! cloud droplet effective radius [um] (pi value)
131
132  REAL fl(klon, klev) ! xliq * rneb (denominator to re; fraction of liquid water clouds
133  ! within the grid cell)
134
135  LOGICAL ok_cdnc
136  REAL bl95_b0, bl95_b1 ! Parameter in B&L 95-Formula
137
138  ! jq-end
139  ! IM cf. CR:parametres supplementaires
140  REAL zclear(klon)
141  REAL zcloud(klon)
142  REAL zcloudh(klon)
143  REAL zcloudm(klon)
144  REAL zcloudl(klon)
145  REAL rhodz(klon, klev) !--rho*dz pour la couche
146  REAL zrho(klon, klev) !--rho pour la couche
147  REAL dh(klon, klev) !--dz pour la couche
148  REAL zfice(klon, klev)
149  REAL rad_chaud(klon, klev) !--rayon pour les nuages chauds
150  REAL rad_chaud_pi(klon, klev) !--rayon pour les nuages chauds pre-industriels
151  REAL zflwp_var, zfiwp_var
152  REAL d_rei_dt
153
154  ! Abderrahmane oct 2009
155  REAL reliq(klon, klev), reice(klon, klev)
156  REAL reliq_pi(klon, klev), reice_pi(klon, klev)
157
158  ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
159  ! FH : 2011/05/24
160
161  ! rei = ( rei_max - rei_min ) * T(°C) / 81.4 + rei_max
162  ! to be used for a temperature in celcius T(°C) < 0
163  ! rei=rei_min for T(°C) < -81.4
164
165  ! Calcul de la pente de la relation entre rayon effective des cristaux
166  ! et la température.
167  ! Pour retrouver les résultats numériques de la version d'origine,
168  ! on impose 0.71 quand on est proche de 0.71
169
170  d_rei_dt = (rei_max-rei_min)/81.4
171  IF (abs(d_rei_dt-0.71)<1.E-4) d_rei_dt = 0.71
172  ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
173
174  ! Calculer l'epaisseur optique et l'emmissivite des nuages
175  ! IM inversion des DO
176
177  xflwp = 0.D0
178  xfiwp = 0.D0
179  xflwc = 0.D0
180  xfiwc = 0.D0
181
182  reliq = 0.
183  reice = 0.
184  reliq_pi = 0.
185  reice_pi = 0.
186
187  IF (iflag_t_glace.EQ.0) THEN
188    DO k = 1, klev
189      DO i = 1, klon
190        ! -layer calculation
191        rhodz(i, k) = (paprs(i,k)-paprs(i,k+1))/rg ! kg/m2
192        zrho(i, k) = pplay(i, k)/t(i, k)/rd ! kg/m3
193        dh(i, k) = rhodz(i, k)/zrho(i, k) ! m
194        ! -Fraction of ice in cloud using a linear transition
195        zfice(i, k) = 1.0 - (t(i,k)-t_glace_min_old)/(t_glace_max_old-t_glace_min_old)
196        zfice(i, k) = min(max(zfice(i,k),0.0), 1.0)
197        ! -IM Total Liquid/Ice water content
198        xflwc(i, k) = (1.-zfice(i,k))*pqlwp(i, k)
199        xfiwc(i, k) = zfice(i, k)*pqlwp(i, k)
200      END DO
201    END DO
202  ELSE ! of IF (iflag_t_glace.EQ.0)
203    DO k = 1, klev
204      DO i = 1, klon
205        ! -layer calculation
206        rhodz(i, k) = (paprs(i,k)-paprs(i,k+1))/rg ! kg/m2
207        zrho(i, k) = pplay(i, k)/t(i, k)/rd ! kg/m3
208        dh(i, k) = rhodz(i, k)/zrho(i, k) ! m
209        ! JBM: icefrac_lsc is now a function contained in microphys_mod
210        zfice(i, k) = icefrac_lsc(t(i,k), t_glace_min, &
211                                  t_glace_max, exposant_glace)
212        ! -IM Total Liquid/Ice water content
213        xflwc(i, k) = (1.-zfice(i,k))*pqlwp(i, k)
214        xfiwc(i, k) = zfice(i, k)*pqlwp(i, k)
215      END DO
216    END DO
217  ENDIF
218
219  IF (ok_cdnc) THEN
220
221    ! --we compute cloud properties as a function of the aerosol load
222
223    DO k = 1, klev
224      DO i = 1, klon
225
226        ! Formula "D" of Boucher and Lohmann, Tellus, 1995
227        ! Cloud droplet number concentration (CDNC) is restricted
228        ! to be within [20, 1000 cm^3]
229
230        ! --present-day case
231        cdnc(i, k) = 10.**(bl95_b0+bl95_b1*log(max(mass_solu_aero(i,k), &
232          1.E-4))/log(10.))*1.E6 !-m-3
233        cdnc(i, k) = min(1000.E6, max(20.E6,cdnc(i,k)))
234
235        ! --pre-industrial case
236        cdnc_pi(i, k) = 10.**(bl95_b0+bl95_b1*log(max(mass_solu_aero_pi(i,k), &
237          1.E-4))/log(10.))*1.E6 !-m-3
238        cdnc_pi(i, k) = min(1000.E6, max(20.E6,cdnc_pi(i,k)))
239
240        ! --present-day case
241        rad_chaud(i, k) = 1.1*((pqlwp(i,k)*pplay(i, &
242          k)/(rd*t(i,k)))/(4./3*rpi*1000.*cdnc(i,k)))**(1./3.)
243        rad_chaud(i, k) = max(rad_chaud(i,k)*1.E6, 5.)
244
245        ! --pre-industrial case
246        rad_chaud_pi(i, k) = 1.1*((pqlwp(i,k)*pplay(i, &
247          k)/(rd*t(i,k)))/(4./3.*rpi*1000.*cdnc_pi(i,k)))**(1./3.)
248        rad_chaud_pi(i, k) = max(rad_chaud_pi(i,k)*1.E6, 5.)
249
250        ! --pre-industrial case
251        ! --liquid/ice cloud water paths:
252        IF (pclc(i,k)<=seuil_neb) THEN
253
254          pcldtaupi(i, k) = 0.0
255
256        ELSE
257
258          zflwp_var = 1000.*(1.-zfice(i,k))*pqlwp(i, k)/pclc(i, k)* &
259            rhodz(i, k)
260          zfiwp_var = 1000.*zfice(i, k)*pqlwp(i, k)/pclc(i, k)*rhodz(i, k)
261          tc = t(i, k) - 273.15
262          rei = d_rei_dt*tc + rei_max
263          IF (tc<=-81.4) rei = rei_min
264
265          ! -- cloud optical thickness :
266          ! [for liquid clouds, traditional formula,
267          ! for ice clouds, Ebert & Curry (1992)]
268
269          IF (zfiwp_var==0. .OR. rei<=0.) rei = 1.
270          pcldtaupi(i, k) = 3.0/2.0*zflwp_var/rad_chaud_pi(i, k) + &
271            zfiwp_var*(3.448E-03+2.431/rei)
272
273        END IF
274
275      END DO
276    END DO
277
278  ELSE !--not ok_cdnc
279
280    ! -prescribed cloud droplet radius
281
282    DO k = 1, min(3, klev)
283      DO i = 1, klon
284        rad_chaud(i, k) = rad_chau2
285        rad_chaud_pi(i, k) = rad_chau2
286      END DO
287    END DO
288    DO k = min(3, klev) + 1, klev
289      DO i = 1, klon
290        rad_chaud(i, k) = rad_chau1
291        rad_chaud_pi(i, k) = rad_chau1
292      END DO
293    END DO
294
295  END IF !--ok_cdnc
296
297  ! --computation of cloud optical depth and emissivity
298  ! --in the general case
299
300  DO k = 1, klev
301    DO i = 1, klon
302
303      IF (pclc(i,k)<=seuil_neb) THEN
304
305        ! effective cloud droplet radius (microns) for liquid water clouds:
306        ! For output diagnostics cloud droplet effective radius [um]
307        ! we multiply here with f * xl (fraction of liquid water
308        ! clouds in the grid cell) to avoid problems in the averaging of the
309        ! output.
310        ! In the output of IOIPSL, derive the REAL cloud droplet
311        ! effective radius as re/fl
312
313        fl(i, k) = seuil_neb*(1.-zfice(i,k))
314        re(i, k) = rad_chaud(i, k)*fl(i, k)
315        rel = 0.
316        rei = 0.
317        pclc(i, k) = 0.0
318        pcltau(i, k) = 0.0
319        pclemi(i, k) = 0.0
320
321      ELSE
322
323        ! -- liquid/ice cloud water paths:
324
325        zflwp_var = 1000.*(1.-zfice(i,k))*pqlwp(i, k)/pclc(i, k)*rhodz(i, k)
326        zfiwp_var = 1000.*zfice(i, k)*pqlwp(i, k)/pclc(i, k)*rhodz(i, k)
327
328        ! effective cloud droplet radius (microns) for liquid water clouds:
329        ! For output diagnostics cloud droplet effective radius [um]
330        ! we multiply here with f * xl (fraction of liquid water
331        ! clouds in the grid cell) to avoid problems in the averaging of the
332        ! output.
333        ! In the output of IOIPSL, derive the REAL cloud droplet
334        ! effective radius as re/fl
335
336        fl(i, k) = pclc(i, k)*(1.-zfice(i,k))
337        re(i, k) = rad_chaud(i, k)*fl(i, k)
338
339        rel = rad_chaud(i, k)
340
341        ! for ice clouds: as a function of the ambiant temperature
342        ! [formula used by Iacobellis and Somerville (2000), with an
343        ! asymptotical value of 3.5 microns at T<-81.4 C added to be
344        ! consistent with observations of Heymsfield et al. 1986]:
345        ! 2011/05/24 : rei_min = 3.5 becomes a free PARAMETER as well as
346        ! rei_max=61.29
347
348        tc = t(i, k) - 273.15
349        rei = d_rei_dt*tc + rei_max
350        IF (tc<=-81.4) rei = rei_min
351
352        ! -- cloud optical thickness :
353        ! [for liquid clouds, traditional formula,
354        ! for ice clouds, Ebert & Curry (1992)]
355
356        IF (zflwp_var==0.) rel = 1.
357        IF (zfiwp_var==0. .OR. rei<=0.) rei = 1.
358        pcltau(i, k) = 3.0/2.0*(zflwp_var/rel) + zfiwp_var*(3.448E-03+2.431/ &
359          rei)
360
361        ! -- cloud infrared emissivity:
362        ! [the broadband infrared absorption coefficient is PARAMETERized
363        ! as a function of the effective cld droplet radius]
364        ! Ebert and Curry (1992) formula as used by Kiehl & Zender (1995):
365
366        k_ice = k_ice0 + 1.0/rei
367
368        pclemi(i, k) = 1.0 - exp(-coef_chau*zflwp_var-df*k_ice*zfiwp_var)
369
370      END IF
371
372      reice(i, k) = rei
373
374      xflwp(i) = xflwp(i) + xflwc(i, k)*rhodz(i, k)
375      xfiwp(i) = xfiwp(i) + xfiwc(i, k)*rhodz(i, k)
376
377    END DO
378  END DO
379
380  ! --if cloud droplet radius is fixed, then pcldtaupi=pcltau
381
382  IF (.NOT. ok_cdnc) THEN
383    DO k = 1, klev
384      DO i = 1, klon
385        pcldtaupi(i, k) = pcltau(i, k)
386        reice_pi(i, k) = reice(i, k)
387      END DO
388    END DO
389  END IF
390
391  DO k = 1, klev
392    DO i = 1, klon
393      reliq(i, k) = rad_chaud(i, k)
394      reliq_pi(i, k) = rad_chaud_pi(i, k)
395      reice_pi(i, k) = reice(i, k)
396    END DO
397  END DO
398
399  ! COMPUTE CLOUD LIQUID PATH AND TOTAL CLOUDINESS
400  ! IM cf. CR:test: calcul prenant ou non en compte le recouvrement
401  ! initialisations
402
403  DO i = 1, klon
404    zclear(i) = 1.
405    zcloud(i) = 0.
406    zcloudh(i) = 0.
407    zcloudm(i) = 0.
408    zcloudl(i) = 0.
409    pch(i) = 1.0
410    pcm(i) = 1.0
411    pcl(i) = 1.0
412    pctlwp(i) = 0.0
413  END DO
414
415  ! --calculation of liquid water path
416
417  DO k = klev, 1, -1
418    DO i = 1, klon
419      pctlwp(i) = pctlwp(i) + pqlwp(i, k)*rhodz(i, k)
420    END DO
421  END DO
422
423  ! --calculation of cloud properties with cloud overlap
424
425  IF (novlp==1) THEN
426    DO k = klev, 1, -1
427      DO i = 1, klon
428        zclear(i) = zclear(i)*(1.-max(pclc(i,k),zcloud(i)))/(1.-min(real( &
429          zcloud(i),kind=8),1.-zepsec))
430        pct(i) = 1. - zclear(i)
431        IF (paprs(i,k)<prmhc) THEN
432          pch(i) = pch(i)*(1.-max(pclc(i,k),zcloudh(i)))/(1.-min(real(zcloudh &
433            (i),kind=8),1.-zepsec))
434          zcloudh(i) = pclc(i, k)
435        ELSE IF (paprs(i,k)>=prmhc .AND. paprs(i,k)<prlmc) THEN
436          pcm(i) = pcm(i)*(1.-max(pclc(i,k),zcloudm(i)))/(1.-min(real(zcloudm &
437            (i),kind=8),1.-zepsec))
438          zcloudm(i) = pclc(i, k)
439        ELSE IF (paprs(i,k)>=prlmc) THEN
440          pcl(i) = pcl(i)*(1.-max(pclc(i,k),zcloudl(i)))/(1.-min(real(zcloudl &
441            (i),kind=8),1.-zepsec))
442          zcloudl(i) = pclc(i, k)
443        END IF
444        zcloud(i) = pclc(i, k)
445      END DO
446    END DO
447  ELSE IF (novlp==2) THEN
448    DO k = klev, 1, -1
449      DO i = 1, klon
450        zcloud(i) = max(pclc(i,k), zcloud(i))
451        pct(i) = zcloud(i)
452        IF (paprs(i,k)<prmhc) THEN
453          pch(i) = min(pclc(i,k), pch(i))
454        ELSE IF (paprs(i,k)>=prmhc .AND. paprs(i,k)<prlmc) THEN
455          pcm(i) = min(pclc(i,k), pcm(i))
456        ELSE IF (paprs(i,k)>=prlmc) THEN
457          pcl(i) = min(pclc(i,k), pcl(i))
458        END IF
459      END DO
460    END DO
461  ELSE IF (novlp==3) THEN
462    DO k = klev, 1, -1
463      DO i = 1, klon
464        zclear(i) = zclear(i)*(1.-pclc(i,k))
465        pct(i) = 1 - zclear(i)
466        IF (paprs(i,k)<prmhc) THEN
467          pch(i) = pch(i)*(1.0-pclc(i,k))
468        ELSE IF (paprs(i,k)>=prmhc .AND. paprs(i,k)<prlmc) THEN
469          pcm(i) = pcm(i)*(1.0-pclc(i,k))
470        ELSE IF (paprs(i,k)>=prlmc) THEN
471          pcl(i) = pcl(i)*(1.0-pclc(i,k))
472        END IF
473      END DO
474    END DO
475  END IF
476
477  DO i = 1, klon
478    pch(i) = 1. - pch(i)
479    pcm(i) = 1. - pcm(i)
480    pcl(i) = 1. - pcl(i)
481  END DO
482
483  ! ========================================================
484  ! DIAGNOSTICS CALCULATION FOR CMIP5 PROTOCOL
485  ! ========================================================
486  ! change by Nicolas Yan (LSCE)
487  ! Cloud Droplet Number Concentration (CDNC) : 3D variable
488  ! Fractionnal cover by liquid water cloud (LCC3D) : 3D variable
489  ! Cloud Droplet Number Concentration at top of cloud (CLDNCL) : 2D variable
490  ! Droplet effective radius at top of cloud (REFFCLWTOP) : 2D variable
491  ! Fractionnal cover by liquid water at top of clouds (LCC) : 2D variable
492
493  IF (ok_cdnc) THEN
494
495    DO k = 1, klev
496      DO i = 1, klon
497        phase3d(i, k) = 1 - zfice(i, k)
498        IF (pclc(i,k)<=seuil_neb) THEN
499          lcc3d(i, k) = seuil_neb*phase3d(i, k)
500        ELSE
501          lcc3d(i, k) = pclc(i, k)*phase3d(i, k)
502        END IF
503        scdnc(i, k) = lcc3d(i, k)*cdnc(i, k) ! m-3
504      END DO
505    END DO
506
507    DO i = 1, klon
508      lcc(i) = 0.
509      reffclwtop(i) = 0.
510      cldncl(i) = 0.
511      IF (random .OR. maximum_random) tcc(i) = 1.
512      IF (maximum) tcc(i) = 0.
513    END DO
514
515    DO i = 1, klon
516      DO k = klev - 1, 1, -1 !From TOA down
517
518          ! Test, if the cloud optical depth exceeds the necessary
519          ! threshold:
520
521        IF (pcltau(i,k)>thres_tau .AND. pclc(i,k)>thres_neb) THEN
522
523          IF (maximum) THEN
524            IF (first) THEN
525              WRITE (*, *) 'Hypothese de recouvrement: MAXIMUM'
526              first = .FALSE.
527            END IF
528            flag_max = -1.
529            ftmp(i) = max(tcc(i), pclc(i,k))
530          END IF
531
532          IF (random) THEN
533            IF (first) THEN
534              WRITE (*, *) 'Hypothese de recouvrement: RANDOM'
535              first = .FALSE.
536            END IF
537            flag_max = 1.
538            ftmp(i) = tcc(i)*(1-pclc(i,k))
539          END IF
540
541          IF (maximum_random) THEN
542            IF (first) THEN
543              WRITE (*, *) 'Hypothese de recouvrement: MAXIMUM_ &
544                &                                             &
545                &                                          RANDOM'
546              first = .FALSE.
547            END IF
548            flag_max = 1.
549            ftmp(i) = tcc(i)*(1.-max(pclc(i,k),pclc(i,k+1)))/(1.-min(pclc(i, &
550              k+1),1.-thres_neb))
551          END IF
552          ! Effective radius of cloud droplet at top of cloud (m)
553          reffclwtop(i) = reffclwtop(i) + rad_chaud(i, k)*1.0E-06*phase3d(i, &
554            k)*(tcc(i)-ftmp(i))*flag_max
555          ! CDNC at top of cloud (m-3)
556          cldncl(i) = cldncl(i) + cdnc(i, k)*phase3d(i, k)*(tcc(i)-ftmp(i))* &
557            flag_max
558          ! Liquid Cloud Content at top of cloud
559          lcc(i) = lcc(i) + phase3d(i, k)*(tcc(i)-ftmp(i))*flag_max
560          ! Total Cloud Content at top of cloud
561          tcc(i) = ftmp(i)
562
563        END IF ! is there a visible, not-too-small cloud?
564      END DO ! loop over k
565
566      IF (random .OR. maximum_random) tcc(i) = 1. - tcc(i)
567
568    END DO ! loop over i
569
570    ! ! Convective and Stratiform Cloud Droplet Effective Radius (REFFCLWC
571    ! REFFCLWS)
572    DO i = 1, klon
573      DO k = 1, klev
574        ! Weight to be used for outputs: eau_liquide*couverture nuageuse
575        lcc3dcon(i, k) = rnebcon(i, k)*phase3d(i, k)*clwcon(i, k) ! eau liquide convective
576        lcc3dstra(i, k) = pclc(i, k)*pqlwp(i, k)*phase3d(i, k)
577        lcc3dstra(i, k) = lcc3dstra(i, k) - lcc3dcon(i, k) ! eau liquide stratiforme
578        lcc3dstra(i, k) = max(lcc3dstra(i,k), 0.0)
579        ! Compute cloud droplet radius as above in meter
580        radius = 1.1*((pqlwp(i,k)*pplay(i,k)/(rd*t(i,k)))/(4./3*rpi*1000.* &
581          cdnc(i,k)))**(1./3.)
582        radius = max(radius, 5.E-6)
583        ! Convective Cloud Droplet Effective Radius (REFFCLWC) : variable 3D
584        reffclwc(i, k) = radius
585        reffclwc(i, k) = reffclwc(i, k)*lcc3dcon(i, k)
586        ! Stratiform Cloud Droplet Effective Radius (REFFCLWS) : variable 3D
587        reffclws(i, k) = radius
588        reffclws(i, k) = reffclws(i, k)*lcc3dstra(i, k)
589      END DO !klev
590    END DO !klon
591
592    ! Column Integrated Cloud Droplet Number (CLDNVI) : variable 2D
593
594    DO i = 1, klon
595      cldnvi(i) = 0.
596      lcc_integrat(i) = 0.
597      height(i) = 0.
598      DO k = 1, klev
599        cldnvi(i) = cldnvi(i) + cdnc(i, k)*lcc3d(i, k)*dh(i, k)
600        lcc_integrat(i) = lcc_integrat(i) + lcc3d(i, k)*dh(i, k)
601        height(i) = height(i) + dh(i, k)
602      END DO ! klev
603      lcc_integrat(i) = lcc_integrat(i)/height(i)
604      IF (lcc_integrat(i)<=1.0E-03) THEN
605        cldnvi(i) = cldnvi(i)*lcc(i)/seuil_neb
606      ELSE
607        cldnvi(i) = cldnvi(i)*lcc(i)/lcc_integrat(i)
608      END IF
609    END DO ! klon
610
611    DO i = 1, klon
612      DO k = 1, klev
613        IF (scdnc(i,k)<=0.0) scdnc(i, k) = 0.0
614        IF (reffclws(i,k)<=0.0) reffclws(i, k) = 0.0
615        IF (reffclwc(i,k)<=0.0) reffclwc(i, k) = 0.0
616        IF (lcc3d(i,k)<=0.0) lcc3d(i, k) = 0.0
617        IF (lcc3dcon(i,k)<=0.0) lcc3dcon(i, k) = 0.0
618        IF (lcc3dstra(i,k)<=0.0) lcc3dstra(i, k) = 0.0
619      END DO
620      IF (reffclwtop(i)<=0.0) reffclwtop(i) = 0.0
621      IF (cldncl(i)<=0.0) cldncl(i) = 0.0
622      IF (cldnvi(i)<=0.0) cldnvi(i) = 0.0
623      IF (lcc(i)<=0.0) lcc(i) = 0.0
624    END DO
625
626  END IF !ok_cdnc
627
628  RETURN
629
630END SUBROUTINE newmicro
Note: See TracBrowser for help on using the repository browser.