Context Navigation

newmicro.F90 @ 3708

Last change on this file since 3708 was 2596, checked in by musat, 8 years ago
In newmicro allow use of cloud overlap hypothesis defined in radopt.h as for the radiation code. In rrtm allow max and random cloud overlap hypothesis. IM
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.5 KB

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

Note: See TracBrowser for help on using the repository browser.

Download in other formats:

Original Format