LMDZ
newmicro.F90
Go to the documentation of this file.
1 ! $Id: newmicro.F90 2109 2014-08-22 10:22:58Z jbmadeleine $
2 
3 
4 
5 SUBROUTINE 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
14  USE icefrac_lsc_mod ! computes ice fraction (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  CALL icefrac_lsc(klon,t(:,k),pplay(:,k)/paprs(:,1),zfice(:,k))
205 
206 
207  ! JBM: icefrac_lsc is now contained icefrac_lsc_mod
208 ! zfice(i, k) = icefrac_lsc(t(i,k), t_glace_min, &
209 ! t_glace_max, exposant_glace)
210  DO i = 1, klon
211  ! -layer calculation
212  rhodz(i, k) = (paprs(i,k)-paprs(i,k+1))/rg ! kg/m2
213  zrho(i, k) = pplay(i, k)/t(i, k)/rd ! kg/m3
214  dh(i, k) = rhodz(i, k)/zrho(i, k) ! m
215  ! -IM Total Liquid/Ice water content
216  xflwc(i, k) = (1.-zfice(i,k))*pqlwp(i, k)
217  xfiwc(i, k) = zfice(i, k)*pqlwp(i, k)
218  END DO
219  END DO
220  ENDIF
221 
222  IF (ok_cdnc) THEN
223 
224  ! --we compute cloud properties as a function of the aerosol load
225 
226  DO k = 1, klev
227  DO i = 1, klon
228 
229  ! Formula "D" of Boucher and Lohmann, Tellus, 1995
230  ! Cloud droplet number concentration (CDNC) is restricted
231  ! to be within [20, 1000 cm^3]
232 
233  ! --present-day case
234  cdnc(i, k) = 10.**(bl95_b0+bl95_b1*log(max(mass_solu_aero(i,k), &
235  1.e-4))/log(10.))*1.e6 !-m-3
236  cdnc(i, k) = min(1000.e6, max(20.e6,cdnc(i,k)))
237 
238  ! --pre-industrial case
239  cdnc_pi(i, k) = 10.**(bl95_b0+bl95_b1*log(max(mass_solu_aero_pi(i,k), &
240  1.e-4))/log(10.))*1.e6 !-m-3
241  cdnc_pi(i, k) = min(1000.e6, max(20.e6,cdnc_pi(i,k)))
242 
243  ! --present-day case
244  rad_chaud(i, k) = 1.1*((pqlwp(i,k)*pplay(i, &
245  k)/(rd*t(i,k)))/(4./3*rpi*1000.*cdnc(i,k)))**(1./3.)
246  rad_chaud(i, k) = max(rad_chaud(i,k)*1.e6, 5.)
247 
248  ! --pre-industrial case
249  rad_chaud_pi(i, k) = 1.1*((pqlwp(i,k)*pplay(i, &
250  k)/(rd*t(i,k)))/(4./3.*rpi*1000.*cdnc_pi(i,k)))**(1./3.)
251  rad_chaud_pi(i, k) = max(rad_chaud_pi(i,k)*1.e6, 5.)
252 
253  ! --pre-industrial case
254  ! --liquid/ice cloud water paths:
255  IF (pclc(i,k)<=seuil_neb) THEN
256 
257  pcldtaupi(i, k) = 0.0
258 
259  ELSE
260 
261  zflwp_var = 1000.*(1.-zfice(i,k))*pqlwp(i, k)/pclc(i, k)* &
262  rhodz(i, k)
263  zfiwp_var = 1000.*zfice(i, k)*pqlwp(i, k)/pclc(i, k)*rhodz(i, k)
264  tc = t(i, k) - 273.15
265  rei = d_rei_dt*tc + rei_max
266  IF (tc<=-81.4) rei = rei_min
267 
268  ! -- cloud optical thickness :
269  ! [for liquid clouds, traditional formula,
270  ! for ice clouds, Ebert & Curry (1992)]
271 
272  IF (zfiwp_var==0. .OR. rei<=0.) rei = 1.
273  pcldtaupi(i, k) = 3.0/2.0*zflwp_var/rad_chaud_pi(i, k) + &
274  zfiwp_var*(3.448e-03+2.431/rei)
275 
276  END IF
277 
278  END DO
279  END DO
280 
281  ELSE !--not ok_cdnc
282 
283  ! -prescribed cloud droplet radius
284 
285  DO k = 1, min(3, klev)
286  DO i = 1, klon
287  rad_chaud(i, k) = rad_chau2
288  rad_chaud_pi(i, k) = rad_chau2
289  END DO
290  END DO
291  DO k = min(3, klev) + 1, klev
292  DO i = 1, klon
293  rad_chaud(i, k) = rad_chau1
294  rad_chaud_pi(i, k) = rad_chau1
295  END DO
296  END DO
297 
298  END IF !--ok_cdnc
299 
300  ! --computation of cloud optical depth and emissivity
301  ! --in the general case
302 
303  DO k = 1, klev
304  DO i = 1, klon
305 
306  IF (pclc(i,k)<=seuil_neb) THEN
307 
308  ! effective cloud droplet radius (microns) for liquid water clouds:
309  ! For output diagnostics cloud droplet effective radius [um]
310  ! we multiply here with f * xl (fraction of liquid water
311  ! clouds in the grid cell) to avoid problems in the averaging of the
312  ! output.
313  ! In the output of IOIPSL, derive the REAL cloud droplet
314  ! effective radius as re/fl
315 
316  fl(i, k) = seuil_neb*(1.-zfice(i,k))
317  re(i, k) = rad_chaud(i, k)*fl(i, k)
318  rel = 0.
319  rei = 0.
320  pclc(i, k) = 0.0
321  pcltau(i, k) = 0.0
322  pclemi(i, k) = 0.0
323 
324  ELSE
325 
326  ! -- liquid/ice cloud water paths:
327 
328  zflwp_var = 1000.*(1.-zfice(i,k))*pqlwp(i, k)/pclc(i, k)*rhodz(i, k)
329  zfiwp_var = 1000.*zfice(i, k)*pqlwp(i, k)/pclc(i, k)*rhodz(i, k)
330 
331  ! effective cloud droplet radius (microns) for liquid water clouds:
332  ! For output diagnostics cloud droplet effective radius [um]
333  ! we multiply here with f * xl (fraction of liquid water
334  ! clouds in the grid cell) to avoid problems in the averaging of the
335  ! output.
336  ! In the output of IOIPSL, derive the REAL cloud droplet
337  ! effective radius as re/fl
338 
339  fl(i, k) = pclc(i, k)*(1.-zfice(i,k))
340  re(i, k) = rad_chaud(i, k)*fl(i, k)
341 
342  rel = rad_chaud(i, k)
343 
344  ! for ice clouds: as a function of the ambiant temperature
345  ! [formula used by Iacobellis and Somerville (2000), with an
346  ! asymptotical value of 3.5 microns at T<-81.4 C added to be
347  ! consistent with observations of Heymsfield et al. 1986]:
348  ! 2011/05/24 : rei_min = 3.5 becomes a free PARAMETER as well as
349  ! rei_max=61.29
350 
351  tc = t(i, k) - 273.15
352  rei = d_rei_dt*tc + rei_max
353  IF (tc<=-81.4) rei = rei_min
354 
355  ! -- cloud optical thickness :
356  ! [for liquid clouds, traditional formula,
357  ! for ice clouds, Ebert & Curry (1992)]
358 
359  IF (zflwp_var==0.) rel = 1.
360  IF (zfiwp_var==0. .OR. rei<=0.) rei = 1.
361  pcltau(i, k) = 3.0/2.0*(zflwp_var/rel) + zfiwp_var*(3.448e-03+2.431/ &
362  rei)
363 
364  ! -- cloud infrared emissivity:
365  ! [the broadband infrared absorption coefficient is PARAMETERized
366  ! as a function of the effective cld droplet radius]
367  ! Ebert and Curry (1992) formula as used by Kiehl & Zender (1995):
368 
369  k_ice = k_ice0 + 1.0/rei
370 
371  pclemi(i, k) = 1.0 - exp(-coef_chau*zflwp_var-df*k_ice*zfiwp_var)
372 
373  END IF
374 
375  reice(i, k) = rei
376 
377  xflwp(i) = xflwp(i) + xflwc(i, k)*rhodz(i, k)
378  xfiwp(i) = xfiwp(i) + xfiwc(i, k)*rhodz(i, k)
379 
380  END DO
381  END DO
382 
383  ! --if cloud droplet radius is fixed, then pcldtaupi=pcltau
384 
385  IF (.NOT. ok_cdnc) THEN
386  DO k = 1, klev
387  DO i = 1, klon
388  pcldtaupi(i, k) = pcltau(i, k)
389  reice_pi(i, k) = reice(i, k)
390  END DO
391  END DO
392  END IF
393 
394  DO k = 1, klev
395  DO i = 1, klon
396  reliq(i, k) = rad_chaud(i, k)
397  reliq_pi(i, k) = rad_chaud_pi(i, k)
398  reice_pi(i, k) = reice(i, k)
399  END DO
400  END DO
401 
402  ! COMPUTE CLOUD LIQUID PATH AND TOTAL CLOUDINESS
403  ! IM cf. CR:test: calcul prenant ou non en compte le recouvrement
404  ! initialisations
405 
406  DO i = 1, klon
407  zclear(i) = 1.
408  zcloud(i) = 0.
409  zcloudh(i) = 0.
410  zcloudm(i) = 0.
411  zcloudl(i) = 0.
412  pch(i) = 1.0
413  pcm(i) = 1.0
414  pcl(i) = 1.0
415  pctlwp(i) = 0.0
416  END DO
417 
418  ! --calculation of liquid water path
419 
420  DO k = klev, 1, -1
421  DO i = 1, klon
422  pctlwp(i) = pctlwp(i) + pqlwp(i, k)*rhodz(i, k)
423  END DO
424  END DO
425 
426  ! --calculation of cloud properties with cloud overlap
427 
428  IF (novlp==1) THEN
429  DO k = klev, 1, -1
430  DO i = 1, klon
431  zclear(i) = zclear(i)*(1.-max(pclc(i,k),zcloud(i)))/(1.-min(real( & zcloud(i),kind=8),1.-zepsec))
432  pct(i) = 1. - zclear(i)
433  IF (paprs(i,k)<prmhc) THEN
434  pch(i) = pch(i)*(1.-max(pclc(i,k),zcloudh(i)))/(1.-min(real(zcloudh & (i),kind=8),1.-zepsec))
435  zcloudh(i) = pclc(i, k)
436  ELSE IF (paprs(i,k)>=prmhc .AND. paprs(i,k)<prlmc) THEN
437  pcm(i) = pcm(i)*(1.-max(pclc(i,k),zcloudm(i)))/(1.-min(real(zcloudm & (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 & (i),kind=8),1.-zepsec))
441  zcloudl(i) = pclc(i, k)
442  END IF
443  zcloud(i) = pclc(i, k)
444  END DO
445  END DO
446  ELSE IF (novlp==2) THEN
447  DO k = klev, 1, -1
448  DO i = 1, klon
449  zcloud(i) = max(pclc(i,k), zcloud(i))
450  pct(i) = zcloud(i)
451  IF (paprs(i,k)<prmhc) THEN
452  pch(i) = min(pclc(i,k), pch(i))
453  ELSE IF (paprs(i,k)>=prmhc .AND. paprs(i,k)<prlmc) THEN
454  pcm(i) = min(pclc(i,k), pcm(i))
455  ELSE IF (paprs(i,k)>=prlmc) THEN
456  pcl(i) = min(pclc(i,k), pcl(i))
457  END IF
458  END DO
459  END DO
460  ELSE IF (novlp==3) THEN
461  DO k = klev, 1, -1
462  DO i = 1, klon
463  zclear(i) = zclear(i)*(1.-pclc(i,k))
464  pct(i) = 1 - zclear(i)
465  IF (paprs(i,k)<prmhc) THEN
466  pch(i) = pch(i)*(1.0-pclc(i,k))
467  ELSE IF (paprs(i,k)>=prmhc .AND. paprs(i,k)<prlmc) THEN
468  pcm(i) = pcm(i)*(1.0-pclc(i,k))
469  ELSE IF (paprs(i,k)>=prlmc) THEN
470  pcl(i) = pcl(i)*(1.0-pclc(i,k))
471  END IF
472  END DO
473  END DO
474  END IF
475 
476  DO i = 1, klon
477  pch(i) = 1. - pch(i)
478  pcm(i) = 1. - pcm(i)
479  pcl(i) = 1. - pcl(i)
480  END DO
481 
482  ! ========================================================
483  ! DIAGNOSTICS CALCULATION FOR CMIP5 PROTOCOL
484  ! ========================================================
485  ! change by Nicolas Yan (LSCE)
486  ! Cloud Droplet Number Concentration (CDNC) : 3D variable
487  ! Fractionnal cover by liquid water cloud (LCC3D) : 3D variable
488  ! Cloud Droplet Number Concentration at top of cloud (CLDNCL) : 2D variable
489  ! Droplet effective radius at top of cloud (REFFCLWTOP) : 2D variable
490  ! Fractionnal cover by liquid water at top of clouds (LCC) : 2D variable
491 
492  IF (ok_cdnc) THEN
493 
494  DO k = 1, klev
495  DO i = 1, klon
496  phase3d(i, k) = 1 - zfice(i, k)
497  IF (pclc(i,k)<=seuil_neb) THEN
498  lcc3d(i, k) = seuil_neb*phase3d(i, k)
499  ELSE
500  lcc3d(i, k) = pclc(i, k)*phase3d(i, k)
501  END IF
502  scdnc(i, k) = lcc3d(i, k)*cdnc(i, k) ! m-3
503  END DO
504  END DO
505 
506  DO i = 1, klon
507  lcc(i) = 0.
508  reffclwtop(i) = 0.
509  cldncl(i) = 0.
510  IF (random .OR. maximum_random) tcc(i) = 1.
511  IF (maximum) tcc(i) = 0.
512  END DO
513 
514  DO i = 1, klon
515  DO k = klev - 1, 1, -1 !From TOA down
516 
517  ! Test, if the cloud optical depth exceeds the necessary
518  ! threshold:
519 
520  IF (pcltau(i,k)>thres_tau .AND. pclc(i,k)>thres_neb) THEN
521 
522  IF (maximum) THEN
523  IF (first) THEN
524  WRITE (*, *) 'Hypothese de recouvrement: MAXIMUM'
525  first = .false.
526  END IF
527  flag_max = -1.
528  ftmp(i) = max(tcc(i), pclc(i,k))
529  END IF
530 
531  IF (random) THEN
532  IF (first) THEN
533  WRITE (*, *) 'Hypothese de recouvrement: RANDOM'
534  first = .false.
535  END IF
536  flag_max = 1.
537  ftmp(i) = tcc(i)*(1-pclc(i,k))
538  END IF
539 
540  IF (maximum_random) THEN
541  IF (first) THEN
542  WRITE (*, *) 'Hypothese de recouvrement: MAXIMUM_ &
543  & &
544  & RANDOM'
545  first = .false.
546  END IF
547  flag_max = 1.
548  ftmp(i) = tcc(i)*(1.-max(pclc(i,k),pclc(i,k+1)))/(1.-min(pclc(i, &
549  k+1),1.-thres_neb))
550  END IF
551  ! Effective radius of cloud droplet at top of cloud (m)
552  reffclwtop(i) = reffclwtop(i) + rad_chaud(i, k)*1.0e-06*phase3d(i, &
553  k)*(tcc(i)-ftmp(i))*flag_max
554  ! CDNC at top of cloud (m-3)
555  cldncl(i) = cldncl(i) + cdnc(i, k)*phase3d(i, k)*(tcc(i)-ftmp(i))* &
556  flag_max
557  ! Liquid Cloud Content at top of cloud
558  lcc(i) = lcc(i) + phase3d(i, k)*(tcc(i)-ftmp(i))*flag_max
559  ! Total Cloud Content at top of cloud
560  tcc(i) = ftmp(i)
561 
562  END IF ! is there a visible, not-too-small cloud?
563  END DO ! loop over k
564 
565  IF (random .OR. maximum_random) tcc(i) = 1. - tcc(i)
566 
567  END DO ! loop over i
568 
569  ! ! Convective and Stratiform Cloud Droplet Effective Radius (REFFCLWC
570  ! REFFCLWS)
571  DO i = 1, klon
572  DO k = 1, klev
573  ! Weight to be used for outputs: eau_liquide*couverture nuageuse
574  lcc3dcon(i, k) = rnebcon(i, k)*phase3d(i, k)*clwcon(i, k) ! eau liquide convective
575  lcc3dstra(i, k) = pclc(i, k)*pqlwp(i, k)*phase3d(i, k)
576  lcc3dstra(i, k) = lcc3dstra(i, k) - lcc3dcon(i, k) ! eau liquide stratiforme
577  lcc3dstra(i, k) = max(lcc3dstra(i,k), 0.0)
578  ! Compute cloud droplet radius as above in meter
579  radius = 1.1*((pqlwp(i,k)*pplay(i,k)/(rd*t(i,k)))/(4./3*rpi*1000.* &
580  cdnc(i,k)))**(1./3.)
581  radius = max(radius, 5.e-6)
582  ! Convective Cloud Droplet Effective Radius (REFFCLWC) : variable 3D
583  reffclwc(i, k) = radius
584  reffclwc(i, k) = reffclwc(i, k)*lcc3dcon(i, k)
585  ! Stratiform Cloud Droplet Effective Radius (REFFCLWS) : variable 3D
586  reffclws(i, k) = radius
587  reffclws(i, k) = reffclws(i, k)*lcc3dstra(i, k)
588  END DO !klev
589  END DO !klon
590 
591  ! Column Integrated Cloud Droplet Number (CLDNVI) : variable 2D
592 
593  DO i = 1, klon
594  cldnvi(i) = 0.
595  lcc_integrat(i) = 0.
596  height(i) = 0.
597  DO k = 1, klev
598  cldnvi(i) = cldnvi(i) + cdnc(i, k)*lcc3d(i, k)*dh(i, k)
599  lcc_integrat(i) = lcc_integrat(i) + lcc3d(i, k)*dh(i, k)
600  height(i) = height(i) + dh(i, k)
601  END DO ! klev
602  lcc_integrat(i) = lcc_integrat(i)/height(i)
603  IF (lcc_integrat(i)<=1.0e-03) THEN
604  cldnvi(i) = cldnvi(i)*lcc(i)/seuil_neb
605  ELSE
606  cldnvi(i) = cldnvi(i)*lcc(i)/lcc_integrat(i)
607  END IF
608  END DO ! klon
609 
610  DO i = 1, klon
611  DO k = 1, klev
612  IF (scdnc(i,k)<=0.0) scdnc(i, k) = 0.0
613  IF (reffclws(i,k)<=0.0) reffclws(i, k) = 0.0
614  IF (reffclwc(i,k)<=0.0) reffclwc(i, k) = 0.0
615  IF (lcc3d(i,k)<=0.0) lcc3d(i, k) = 0.0
616  IF (lcc3dcon(i,k)<=0.0) lcc3dcon(i, k) = 0.0
617  IF (lcc3dstra(i,k)<=0.0) lcc3dstra(i, k) = 0.0
618  END DO
619  IF (reffclwtop(i)<=0.0) reffclwtop(i) = 0.0
620  IF (cldncl(i)<=0.0) cldncl(i) = 0.0
621  IF (cldnvi(i)<=0.0) cldnvi(i) = 0.0
622  IF (lcc(i)<=0.0) lcc(i) = 0.0
623  END DO
624 
625  END IF !ok_cdnc
626 
627  RETURN
628 
629 END SUBROUTINE newmicro
630 
real, dimension(:,:), allocatable, save clwcon
subroutine icefrac_lsc(np, temp, sig, icefrac)
integer, save klon
Definition: dimphy.F90:3
real, dimension(:,:), allocatable, save lcc3dstra
!$Id t_glace_min REAL exposant_glace REAL rei_max REAL coefw_cld_cv REAL tmax_fonte_cv INTEGER iflag_cld_cv common nuagecom rei_max
Definition: nuage.h:4
real, dimension(:), allocatable, save cldnvi
integer, save klev
Definition: dimphy.F90:7
!$Id t_glace_min REAL exposant_glace REAL rei_max REAL coefw_cld_cv REAL tmax_fonte_cv INTEGER iflag_t_glace
Definition: nuage.h:4
!$Id rad_chau1
Definition: nuage.h:4
real, dimension(:,:), allocatable, save rnebcon
real, dimension(:,:), allocatable, save scdnc
!$Id itapm1 ENDIF!IM on interpole les champs sur les niveaux STD de pression!IM a chaque pas de temps de la physique c!positionnement de l argument logique a false c!pour ne pas recalculer deux fois la meme chose!c!a cet effet un appel a plevel_new a ete deplace c!a la fin de la serie d appels c!la boucle DO nlevSTD a ete internalisee c!dans d ou la creation de cette routine c c!CALL false
Definition: calcul_STDlev.h:26
real, dimension(:,:), allocatable, save lcc3dcon
real, dimension(:,:), allocatable, save lcc3d
!$Id rad_chau2
Definition: nuage.h:4
real, dimension(:), allocatable, save lcc
real, dimension(:,:), allocatable, save reffclws
!$Id t_glace_min REAL exposant_glace REAL rei_min
Definition: nuage.h:4
!$Header!integer nvarmx parameter(nfmx=10, imx=200, jmx=150, lmx=200, nvarmx=1000) real xd(imx
real, dimension(:), allocatable, save cldncl
!$Id itapm1 ENDIF!IM on interpole les champs sur les niveaux STD de pression!IM a chaque pas de temps de la physique c!positionnement de l argument logique a false c!pour ne pas recalculer deux fois la meme chose!c!a cet effet un appel a plevel_new a ete deplace c!a la fin de la serie d appels c!la boucle DO nlevSTD a ete internalisee c!dans d ou la creation de cette routine c c!CALL ulevSTD CALL &zphi philevSTD CALL &zx_rh rhlevSTD!DO klev DO klon klev DO klon klev DO klon klev DO klon klev DO klon klev DO klon klev DO klon klev DO klon klev DO klon klev DO klon du jour ou toutes les read_climoz CALL true
real, dimension(:), allocatable, save reffclwtop
real, dimension(:,:), allocatable, save reffclwc
Definition: dimphy.F90:1
subroutine newmicro(ok_cdnc, bl95_b0, bl95_b1, paprs, pplay, t, pqlwp, pclc, pcltau, pclemi, pch, pcl, pcm, pct, pctlwp, xflwp, xfiwp, xflwc, xfiwc, mass_solu_aero, mass_solu_aero_pi, pcldtaupi, re, fl, reliq, reice, reliq_pi, reice_pi)
Definition: newmicro.F90:9
real rg
Definition: comcstphy.h:1