Context Navigation

newmicro.F @ 520

Last change on this file since 520 was 517, checked in by lmdzadmin, 21 years ago
Inclusion des modifications de O. Boucher et de J. Quaas pour le calcul des premiers effets directs et indirects dus aux aerosols LF
Property svn:eol-style set to `native` Property svn:keywords set to `Author Date Id Revision`
File size: 11.4 KB

Line
1	SUBROUTINE newmicro (paprs, pplay,ok_newmicro,
2	. t, pqlwp, pclc, pcltau, pclemi,
3	. pch, pcl, pcm, pct, pctlwp,
4	s xflwp, xfiwp, xflwc, xfiwc,
5	e ok_aie,
6	e sulfate, sulfate_pi,
7	e bl95_b0, bl95_b1,
8	s cldtaupi, re, fl)
9	IMPLICIT none
10	c======================================================================
11	c Auteur(s): Z.X. Li (LMD/CNRS) date: 19930910
12	c Objet: Calculer epaisseur optique et emmissivite des nuages
13	c======================================================================
14	c Arguments:
15	c t-------input-R-temperature
16	c pqlwp---input-R-eau liquide nuageuse dans l'atmosphere (kg/kg)
17	c pclc----input-R-couverture nuageuse pour le rayonnement (0 a 1)
18	c
19	c ok_aie--input-L-apply aerosol indirect effect or not
20	c sulfate-input-R-sulfate aerosol mass concentration [um/m^3]
21	c sulfate_pi-input-R-dito, pre-industrial value
22	c bl95_b0-input-R-a parameter, may be varied for tests (s-sea, l-land)
23	c bl95_b1-input-R-a parameter, may be varied for tests ( -"- )
24	c
25	c cldtaupi-output-R-pre-industrial value of cloud optical thickness,
26	c needed for the diagnostics of the aerosol indirect
27	c radiative forcing (see radlwsw)
28	c re------output-R-Cloud droplet effective radius multiplied by fl [um]
29	c fl------output-R-Denominator to re, introduced to avoid problems in
30	c the averaging of the output. fl is the fraction of liquid
31	c water clouds within a grid cell
32	c pcltau--output-R-epaisseur optique des nuages
33	c pclemi--output-R-emissivite des nuages (0 a 1)
34	c======================================================================
35	C
36	#include "YOMCST.h"
37	c
38	#include "dimensions.h"
39	#include "dimphy.h"
40	#include "nuage.h"
41	REAL paprs(klon,klev+1), pplay(klon,klev)
42	REAL t(klon,klev)
43	c
44	REAL pclc(klon,klev)
45	REAL pqlwp(klon,klev)
46	REAL pcltau(klon,klev), pclemi(klon,klev)
47	c
48	REAL pct(klon), pctlwp(klon), pch(klon), pcl(klon), pcm(klon)
49	c
50	LOGICAL lo
51	c
52	REAL cetahb, cetamb
53	PARAMETER (cetahb = 0.45, cetamb = 0.80)
54	C
55	INTEGER i, k
56	cIM: 091003 REAL zflwp, zradef, zfice, zmsac
57	REAL zflwp(klon), zradef, zfice, zmsac
58	cIM: 091003 rajout
59	REAL xflwp(klon), xfiwp(klon)
60	REAL xflwc(klon,klev), xfiwc(klon,klev)
61	c
62	REAL radius, rad_chaud
63	cc PARAMETER (rad_chau1=13.0, rad_chau2=9.0, rad_froid=35.0)
64	ccc PARAMETER (rad_chaud=15.0, rad_froid=35.0)
65	c sintex initial PARAMETER (rad_chaud=10.0, rad_froid=30.0)
66	REAL coef, coef_froi, coef_chau
67	PARAMETER (coef_chau=0.13, coef_froi=0.09)
68	REAL seuil_neb, t_glace
69	PARAMETER (seuil_neb=0.001, t_glace=273.0-15.0)
70	INTEGER nexpo ! exponentiel pour glace/eau
71	PARAMETER (nexpo=6)
72	ccc PARAMETER (nexpo=1)
73
74	c -- sb:
75	logical ok_newmicro
76	c parameter (ok_newmicro=.FALSE.)
77	cIM: 091003 real rel, tc, rei, zfiwp
78	real rel, tc, rei, zfiwp(klon)
79	real k_liq, k_ice0, k_ice, DF
80	parameter (k_liq=0.0903, k_ice0=0.005) ! units=m2/g
81	parameter (DF=1.66) ! diffusivity factor
82	c sb --
83	cjq for the aerosol indirect effect
84	cjq introduced by Johannes Quaas (quaas@lmd.jussieu.fr), 27/11/2003
85	cjq
86	LOGICAL ok_aie ! Apply AIE or not?
87	LOGICAL ok_a1lwpdep ! a1 LWP dependent?
88
89	REAL sulfate(klon, klev) ! sulfate aerosol mass concentration [ug m-3]
90	REAL cdnc(klon, klev) ! cloud droplet number concentration [m-3]
91	REAL re(klon, klev) ! cloud droplet effective radius [um]
92	REAL sulfate_pi(klon, klev) ! sulfate aerosol mass concentration [ug m-3] (pre-industrial value)
93	REAL cdnc_pi(klon, klev) ! cloud droplet number concentration [m-3] (pi value)
94	REAL re_pi(klon, klev) ! cloud droplet effective radius [um] (pi value)
95
96	REAL fl(klon, klev) ! xliq * rneb (denominator to re; fraction of liquid water clouds within the grid cell)
97
98	REAL bl95_b0, bl95_b1 ! Parameter in B&L 95-Formula
99
100	REAL cldtaupi(klon, klev) ! pre-industrial cloud opt thickness for diag
101	cjq-end
102	c
103	c Calculer l'epaisseur optique et l'emmissivite des nuages
104	c
105	cIM inversion des DO
106	DO i = 1, klon
107	xflwp(i)=0.
108	xfiwp(i)=0.
109	DO k = 1, klev
110	c
111	xflwc(i,k)=0.
112	xfiwc(i,k)=0.
113	c
114	rad_chaud = rad_chau1
115	IF (k.LE.3) rad_chaud = rad_chau2
116	pclc(i,k) = MAX(pclc(i,k), seuil_neb)
117	zflwp(i) = 1000.*pqlwp(i,k)/RG/pclc(i,k)
118	. *(paprs(i,k)-paprs(i,k+1))
119	zfice = 1.0 - (t(i,k)-t_glace) / (273.13-t_glace)
120	zfice = MIN(MAX(zfice,0.0),1.0)
121	zfice = zfice**nexpo
122	radius = rad_chaud * (1.-zfice) + rad_froid * zfice
123	coef = coef_chau * (1.-zfice) + coef_froi * zfice
124	pcltau(i,k) = 3.0/2.0 * zflwp(i) / radius
125	pclemi(i,k) = 1.0 - EXP( - coef * zflwp(i))
126
127	if (ok_newmicro) then
128
129	c -- liquid/ice cloud water paths:
130
131	zfice = 1.0 - (t(i,k)-t_glace) / (273.13-t_glace)
132	zfice = MIN(MAX(zfice,0.0),1.0)
133
134	zflwp(i) = 1000.(1.-zfice)pqlwp(i,k)/pclc(i,k)
135	: *(paprs(i,k)-paprs(i,k+1))/RG
136	zfiwp(i) = 1000.zficepqlwp(i,k)/pclc(i,k)
137	: *(paprs(i,k)-paprs(i,k+1))/RG
138
139	xflwp(i) = xflwp(i)+ (1.-zfice)*pqlwp(i,k)
140	: *(paprs(i,k)-paprs(i,k+1))/RG
141	xfiwp(i) = xfiwp(i)+ zfice*pqlwp(i,k)
142	: *(paprs(i,k)-paprs(i,k+1))/RG
143
144	cIM Total Liquid/Ice water content
145	xflwc(i,k) = xflwc(i,k)+(1.-zfice)*pqlwp(i,k)
146	xfiwc(i,k) = xfiwc(i,k)+zfice*pqlwp(i,k)
147	cIM In-Cloud Liquid/Ice water content
148	c xflwc(i,k) = xflwc(i,k)+(1.-zfice)*pqlwp(i,k)/pclc(i,k)
149	c xfiwc(i,k) = xfiwc(i,k)+zfice*pqlwp(i,k)/pclc(i,k)
150
151	c -- effective cloud droplet radius (microns):
152
153	c for liquid water clouds:
154	IF (ok_aie) THEN
155	! Formula "D" of Boucher and Lohmann, Tellus, 1995
156	!
157	cdnc(i,k) = 10.*(bl95_b0+bl95_b1
158	. log(MAX(sulfate(i,k),1.e-4))/log(10.))*1.e6 !-m-3
159	! Cloud droplet number concentration (CDNC) is restricted
160	! to be within [20, 1000 cm^3]
161	!
162	cdnc(i,k)=MIN(1000.e6,MAX(20.e6,cdnc(i,k)))
163	!
164	!
165	cdnc_pi(i,k) = 10.*(bl95_b0+bl95_b1
166	. log(MAX(sulfate_pi(i,k),1.e-4))/log(10.))*1.e6 !-m-3
167	cdnc_pi(i,k)=MIN(1000.e6,MAX(20.e6,cdnc_pi(i,k)))
168	!
169	!
170	! air density: pplay(i,k) / (RD * zT(i,k))
171	! factor 1.1: derive effective radius from volume-mean radius
172	! factor 1000 is the water density
173	! _chaud means that this is the CDR for liquid water clouds
174	!
175	rad_chaud =
176	. 1.1 * ( (pqlwp(i,k) * pplay(i,k) / (RD * T(i,k)) )
177	. / (4./3. * RPI * 1000. * cdnc(i,k)) )**(1./3.)
178	!
179	! Convert to um. CDR shall be at least 3 um.
180	!
181	c rad_chaud = MAX(rad_chaud*1.e6, 3.)
182	rad_chaud = MAX(rad_chaud*1.e6, 5.)
183
184	! Pre-industrial cloud opt thickness
185	!
186	! "radius" is calculated as rad_chaud above (plus the
187	! ice cloud contribution) but using cdnc_pi instead of
188	! cdnc.
189	radius =
190	. 1.1 * ( (pqlwp(i,k) * pplay(i,k) / (RD * T(i,k)) )
191	. / (4./3. * RPI * 1000. * cdnc_pi(i,k)) )**(1./3.)
192	radius = MAX(radius*1.e6, 3.)
193
194	tc = t(i,k)-273.15
195	rei = 0.71*tc + 61.29
196	if (tc.le.-81.4) rei = 3.5
197	if (zflwp(i).eq.0.) radius = 1.
198	if (zfiwp(i).eq.0. .or. rei.le.0.) rei = 1.
199	cldtaupi(i,k) = 3.0/2.0 * zflwp(i) / radius
200	. + zfiwp(i) * (3.448e-03 + 2.431/rei)
201	ENDIF ! ok_aie
202	! For output diagnostics
203	!
204	! Cloud droplet effective radius [um]
205	!
206	! we multiply here with f * xl (fraction of liquid water
207	! clouds in the grid cell) to avoid problems in the
208	! averaging of the output.
209	! In the output of IOIPSL, derive the real cloud droplet
210	! effective radius as re/fl
211	!
212	fl(i,k) = pclc(i,k)*(1.-zfice)
213	re(i,k) = rad_chaud*fl(i,k)
214
215	c-jq end
216
217	rel = rad_chaud
218	c for ice clouds: as a function of the ambiant temperature
219	c [formula used by Iacobellis and Somerville (2000), with an
220	c asymptotical value of 3.5 microns at T<-81.4 C added to be
221	c consistent with observations of Heymsfield et al. 1986]:
222	tc = t(i,k)-273.15
223	rei = 0.71*tc + 61.29
224	if (tc.le.-81.4) rei = 3.5
225
226	c -- cloud optical thickness :
227
228	c [for liquid clouds, traditional formula,
229	c for ice clouds, Ebert & Curry (1992)]
230
231	if (zflwp(i).eq.0.) rel = 1.
232	if (zfiwp(i).eq.0. .or. rei.le.0.) rei = 1.
233	pcltau(i,k) = 3.0/2.0 * ( zflwp(i)/rel )
234	. + zfiwp(i) * (3.448e-03 + 2.431/rei)
235
236	c -- cloud infrared emissivity:
237
238	c [the broadband infrared absorption coefficient is parameterized
239	c as a function of the effective cld droplet radius]
240
241	c Ebert and Curry (1992) formula as used by Kiehl & Zender (1995):
242	k_ice = k_ice0 + 1.0/rei
243
244	pclemi(i,k) = 1.0
245	. - EXP( - coef_chauzflwp(i) - DFk_ice*zfiwp(i) )
246
247	endif ! ok_newmicro
248
249	lo = (pclc(i,k) .LE. seuil_neb)
250	IF (lo) pclc(i,k) = 0.0
251	IF (lo) pcltau(i,k) = 0.0
252	IF (lo) pclemi(i,k) = 0.0
253
254	IF (lo) cldtaupi(i,k) = 0.0
255	IF (.NOT.ok_aie) cldtaupi(i,k)=pcltau(i,k)
256	ENDDO
257	ENDDO
258	ccc DO k = 1, klev
259	ccc DO i = 1, klon
260	ccc t(i,k) = t(i,k)
261	ccc pclc(i,k) = MAX( 1.e-5 , pclc(i,k) )
262	ccc lo = pclc(i,k) .GT. (2.*1.e-5)
263	ccc zflwp = pqlwp(i,k)1000.(paprs(i,k)-paprs(i,k+1))
264	ccc . /(rg*pclc(i,k))
265	ccc zradef = 10.0 + (1.-sigs(k))*45.0
266	ccc pcltau(i,k) = 1.5 * zflwp / zradef
267	ccc zfice=1.0-MIN(MAX((t(i,k)-263.)/(273.-263.),0.0),1.0)
268	ccc zmsac = 0.13(1.0-zfice) + 0.08zfice
269	ccc pclemi(i,k) = 1.-EXP(-zmsac*zflwp)
270	ccc if (.NOT.lo) pclc(i,k) = 0.0
271	ccc if (.NOT.lo) pcltau(i,k) = 0.0
272	ccc if (.NOT.lo) pclemi(i,k) = 0.0
273	ccc ENDDO
274	ccc ENDDO
275	cccccc print*, 'pas de nuage dans le rayonnement'
276	cccccc DO k = 1, klev
277	cccccc DO i = 1, klon
278	cccccc pclc(i,k) = 0.0
279	cccccc pcltau(i,k) = 0.0
280	cccccc pclemi(i,k) = 0.0
281	cccccc ENDDO
282	cccccc ENDDO
283	C
284	C COMPUTE CLOUD LIQUID PATH AND TOTAL CLOUDINESS
285	C
286	DO i = 1, klon
287	pct(i)=1.0
288	pch(i)=1.0
289	pcm(i) = 1.0
290	pcl(i) = 1.0
291	pctlwp(i) = 0.0
292	ENDDO
293	C
294	DO k = klev, 1, -1
295	DO i = 1, klon
296	pctlwp(i) = pctlwp(i)
297	. + pqlwp(i,k)*(paprs(i,k)-paprs(i,k+1))/RG
298	pct(i) = pct(i)*(1.0-pclc(i,k))
299	if (pplay(i,k).LE.cetahb*paprs(i,1))
300	. pch(i) = pch(i)*(1.0-pclc(i,k))
301	if (pplay(i,k).GT.cetahb*paprs(i,1) .AND.
302	. pplay(i,k).LE.cetamb*paprs(i,1))
303	. pcm(i) = pcm(i)*(1.0-pclc(i,k))
304	if (pplay(i,k).GT.cetamb*paprs(i,1))
305	. pcl(i) = pcl(i)*(1.0-pclc(i,k))
306	ENDDO
307	ENDDO
308	C
309	DO i = 1, klon
310	pct(i)=1.-pct(i)
311	pch(i)=1.-pch(i)
312	pcm(i)=1.-pcm(i)
313	pcl(i)=1.-pcl(i)
314	ENDDO
315	C
316	RETURN
317	END

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

Download in other formats:

Original Format