source: LMDZ5/trunk/libf/phylmd/newmicro.F90 @ 1999

Last change on this file since 1999 was 1992, checked in by lguez, 11 years ago

Converted to free source form files in libf/phylmd which were still in
fixed source form. The conversion was done using the polish mode of
the NAG Fortran Compiler.

In addition to converting to free source form, the processing of the
files also:

-- indented the code (including comments);

-- set Fortran keywords to uppercase, and set all other identifiers
to lower case;

-- added qualifiers to end statements (for example "end subroutine
conflx", instead of "end");

-- changed the terminating statements of all DO loops so that each
loop ends with an ENDDO statement (instead of a labeled continue).

-- replaced #include by include.

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