Context Navigation

newmicro.F @ 1989

Last change on this file since 1989 was 1989, checked in by Laurent Fairhead, 11 years ago

Inclusion du code RRTM

Adding RRTM code

MPL

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: 21.6 KB

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

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

Download in other formats:

Original Format