Context Navigation

radlwsw_aero.F90 @ 1157

Last change on this file since 1157 was 1153, checked in by jghattas, 17 years ago
Changement de nom de fichier et nom de subroutine en ajoutant AR4 pour faire comprendre que cette subroutine fait partie du paquet de la radiation AR4.
Property svn:eol-style set to `native` Property svn:keywords set to `Author Date Id Revision`
File size: 15.6 KB

Line
1	SUBROUTINE radlwsw_aero( &
2	dist, rmu0, fract, solaire, &
3	paprs, pplay,tsol,albedo, alblw, &
4	t,q,wo,&
5	cldfra, cldemi, cldtaupd,&
6	ok_ade, ok_aie,&
7	tau_aero, piz_aero, cg_aero,&
8	cldtaupi, new_aod, &
9	heat,heat0,cool,cool0,radsol,albpla,&
10	topsw,toplw,solsw,sollw,&
11	sollwdown,&
12	topsw0,toplw0,solsw0,sollw0,&
13	lwdn0, lwdn, lwup0, lwup,&
14	swdn0, swdn, swup0, swup,&
15	topswad_aero, solswad_aero,&
16	topswai_aero, solswai_aero, &
17	topswad0_aero, solswad0_aero,&
18	topsw_aero, topsw0_aero,&
19	solsw_aero, solsw0_aero)
20
21
22
23	USE DIMPHY
24
25	IMPLICIT NONE
26	!======================================================================
27	! Auteur(s): Z.X. Li (LMD/CNRS) date: 19960719
28	! Objet: interface entre le modele et les rayonnements
29	! Arguments:
30	! dist-----input-R- distance astronomique terre-soleil
31	! rmu0-----input-R- cosinus de l'angle zenithal
32	! fract----input-R- duree d'ensoleillement normalisee
33	! co2_ppm--input-R- concentration du gaz carbonique (en ppm)
34	! solaire--input-R- constante solaire (W/m**2)
35	! paprs----input-R- pression a inter-couche (Pa)
36	! pplay----input-R- pression au milieu de couche (Pa)
37	! tsol-----input-R- temperature du sol (en K)
38	! albedo---input-R- albedo du sol (entre 0 et 1)
39	! t--------input-R- temperature (K)
40	! q--------input-R- vapeur d'eau (en kg/kg)
41	! wo-------input-R- contenu en ozone (en kg/kg) correction MPL 100505
42	! cldfra---input-R- fraction nuageuse (entre 0 et 1)
43	! cldtaupd---input-R- epaisseur optique des nuages dans le visible (present-day value)
44	! cldemi---input-R- emissivite des nuages dans l'IR (entre 0 et 1)
45	! ok_ade---input-L- apply the Aerosol Direct Effect or not?
46	! ok_aie---input-L- apply the Aerosol Indirect Effect or not?
47	! tau_ae, piz_ae, cg_ae-input-R- aerosol optical properties (calculated in aeropt.F)
48	! cldtaupi-input-R- epaisseur optique des nuages dans le visible
49	! calculated for pre-industrial (pi) aerosol concentrations, i.e. with smaller
50	! droplet concentration, thus larger droplets, thus generally cdltaupi cldtaupd
51	! it is needed for the diagnostics of the aerosol indirect radiative forcing
52	!
53	! heat-----output-R- echauffement atmospherique (visible) (K/jour)
54	! cool-----output-R- refroidissement dans l'IR (K/jour)
55	! radsol---output-R- bilan radiatif net au sol (W/m**2) (+ vers le bas)
56	! albpla---output-R- albedo planetaire (entre 0 et 1)
57	! topsw----output-R- flux solaire net au sommet de l'atm.
58	! toplw----output-R- ray. IR montant au sommet de l'atmosphere
59	! solsw----output-R- flux solaire net a la surface
60	! sollw----output-R- ray. IR montant a la surface
61	! solswad---output-R- ray. solaire net absorbe a la surface (aerosol dir)
62	! topswad---output-R- ray. solaire absorbe au sommet de l'atm. (aerosol dir)
63	! solswai---output-R- ray. solaire net absorbe a la surface (aerosol ind)
64	! topswai---output-R- ray. solaire absorbe au sommet de l'atm. (aerosol ind)
65	!
66	! ATTENTION: swai and swad have to be interpreted in the following manner:
67	! ---------
68	! ok_ade=F & ok_aie=F -both are zero
69	! ok_ade=T & ok_aie=F -aerosol direct forcing is F_{AD} = topsw-topswad
70	! indirect is zero
71	! ok_ade=F & ok_aie=T -aerosol indirect forcing is F_{AI} = topsw-topswai
72	! direct is zero
73	! ok_ade=T & ok_aie=T -aerosol indirect forcing is F_{AI} = topsw-topswai
74	! aerosol direct forcing is F_{AD} = topswai-topswad
75	!
76
77	!======================================================================
78
79	! ====================================================================
80	! Adapte au modele de chimie INCA par Celine Deandreis & Anne Cozic -- 2009
81	! 1 = ZERO
82	! 2 = AER total
83	! 3 = NAT
84	! 4 = BC
85	! 5 = SO4
86	! 6 = POM
87	! 7 = DUST
88	! 8 = SS
89	! 9 = NO3
90	!
91	! ====================================================================
92	include "YOETHF.h"
93	include "YOMCST.h"
94
95	! Input arguments
96	REAL, INTENT(in) :: solaire
97	REAL, INTENT(in) :: dist
98	REAL, INTENT(in) :: rmu0(KLON), fract(KLON)
99	REAL, INTENT(in) :: paprs(KLON,KLEV+1), pplay(KLON,KLEV)
100	REAL, INTENT(in) :: albedo(KLON), alblw(KLON), tsol(KLON)
101	REAL, INTENT(in) :: t(KLON,KLEV), q(KLON,KLEV), wo(KLON,KLEV)
102	LOGICAL, INTENT(in) :: ok_ade, ok_aie ! switches whether to use aerosol direct (indirect) effects or not
103	REAL, INTENT(in) :: cldfra(KLON,KLEV), cldemi(KLON,KLEV), cldtaupd(KLON,KLEV)
104	REAL, INTENT(in) :: tau_aero(KLON,KLEV,9,2) ! aerosol optical properties (see aeropt.F)
105	REAL, INTENT(in) :: piz_aero(KLON,KLEV,9,2) ! aerosol optical properties (see aeropt.F)
106	REAL, INTENT(in) :: cg_aero(KLON,KLEV,9,2) ! aerosol optical properties (see aeropt.F)
107	REAL, INTENT(in) :: cldtaupi(KLON,KLEV) ! cloud optical thickness for pre-industrial aerosol concentrations
108	LOGICAL, INTENT(in) :: new_aod ! flag pour retrouver les resultats exacts de l'AR4 dans le cas ou l'on ne travaille qu'avec les sulfates
109
110	! Output arguments
111	REAL, INTENT(out) :: heat(KLON,KLEV), cool(KLON,KLEV)
112	REAL, INTENT(out) :: heat0(KLON,KLEV), cool0(KLON,KLEV)
113	REAL, INTENT(out) :: radsol(KLON), topsw(KLON), toplw(KLON)
114	REAL, INTENT(out) :: solsw(KLON), sollw(KLON), albpla(KLON)
115	REAL, INTENT(out) :: topsw0(KLON), toplw0(KLON), solsw0(KLON), sollw0(KLON)
116	REAL, INTENT(out) :: sollwdown(KLON)
117	REAL, INTENT(out) :: swdn(KLON,kflev+1),swdn0(KLON,kflev+1)
118	REAL, INTENT(out) :: swup(KLON,kflev+1),swup0(KLON,kflev+1)
119	REAL, INTENT(out) :: lwdn(KLON,kflev+1),lwdn0(KLON,kflev+1)
120	REAL, INTENT(out) :: lwup(KLON,kflev+1),lwup0(KLON,kflev+1)
121	REAL, INTENT(out) :: topswad_aero(KLON), solswad_aero(KLON) ! output: aerosol direct forcing at TOA and surface
122	REAL, INTENT(out) :: topswai_aero(KLON), solswai_aero(KLON) ! output: aerosol indirect forcing atTOA and surface
123	REAL, DIMENSION(klon), INTENT(out) :: topswad0_aero
124	REAL, DIMENSION(klon), INTENT(out) :: solswad0_aero
125	REAL, DIMENSION(kdlon,9), INTENT(out) :: topsw_aero
126	REAL, DIMENSION(kdlon,9), INTENT(out) :: topsw0_aero
127	REAL, DIMENSION(kdlon,9), INTENT(out) :: solsw_aero
128	REAL, DIMENSION(kdlon,9), INTENT(out) :: solsw0_aero
129
130	! Local variables
131	REAL*8 ZFSUP(KDLON,KFLEV+1)
132	REAL*8 ZFSDN(KDLON,KFLEV+1)
133	REAL*8 ZFSUP0(KDLON,KFLEV+1)
134	REAL*8 ZFSDN0(KDLON,KFLEV+1)
135	REAL*8 ZFLUP(KDLON,KFLEV+1)
136	REAL*8 ZFLDN(KDLON,KFLEV+1)
137	REAL*8 ZFLUP0(KDLON,KFLEV+1)
138	REAL*8 ZFLDN0(KDLON,KFLEV+1)
139	REAL*8 zx_alpha1, zx_alpha2
140	INTEGER k, kk, i, j, iof, nb_gr
141	REAL*8 PSCT
142	REAL*8 PALBD(kdlon,2), PALBP(kdlon,2)
143	REAL*8 PEMIS(kdlon), PDT0(kdlon), PVIEW(kdlon)
144	REAL*8 PPSOL(kdlon), PDP(kdlon,KLEV)
145	REAL*8 PTL(kdlon,kflev+1), PPMB(kdlon,kflev+1)
146	REAL*8 PTAVE(kdlon,kflev)
147	REAL*8 PWV(kdlon,kflev), PQS(kdlon,kflev), POZON(kdlon,kflev)
148	REAL*8 PAER(kdlon,kflev,5)
149	REAL*8 PCLDLD(kdlon,kflev)
150	REAL*8 PCLDLU(kdlon,kflev)
151	REAL*8 PCLDSW(kdlon,kflev)
152	REAL*8 PTAU(kdlon,2,kflev)
153	REAL*8 POMEGA(kdlon,2,kflev)
154	REAL*8 PCG(kdlon,2,kflev)
155	REAL*8 zfract(kdlon), zrmu0(kdlon), zdist
156	REAL*8 zheat(kdlon,kflev), zcool(kdlon,kflev)
157	REAL*8 zheat0(kdlon,kflev), zcool0(kdlon,kflev)
158	REAL*8 ztopsw(kdlon), ztoplw(kdlon)
159	REAL*8 zsolsw(kdlon), zsollw(kdlon), zalbpla(kdlon)
160	REAL*8 zsollwdown(kdlon)
161	REAL*8 ztopsw0(kdlon), ztoplw0(kdlon)
162	REAL*8 zsolsw0(kdlon), zsollw0(kdlon)
163	REAL*8 zznormcp
164	REAL*8 tauaero(kdlon,kflev,9,2) ! aer opt properties
165	REAL*8 pizaero(kdlon,kflev,9,2)
166	REAL*8 cgaero(kdlon,kflev,9,2)
167	REAL*8 PTAUA(kdlon,2,kflev) ! present-day value of cloud opt thickness (PTAU is pre-industrial value), local use
168	REAL*8 POMEGAA(kdlon,2,kflev) ! dito for single scatt albedo
169	REAL*8 ztopswadaero(kdlon), zsolswadaero(kdlon) ! Aerosol direct forcing at TOAand surface
170	REAL*8 ztopswad0aero(kdlon), zsolswad0aero(kdlon) ! Aerosol direct forcing at TOAand surface
171	REAL*8 ztopswaiaero(kdlon), zsolswaiaero(kdlon) ! dito, indirect
172	REAL*8 ztopsw_aero(kdlon,9), ztopsw0_aero(kdlon,9)
173	REAL*8 zsolsw_aero(kdlon,9), zsolsw0_aero(kdlon,9)
174
175	! initialisation
176	tauaero(:,:,:,:)=0.
177	pizaero(:,:,:,:)=0.
178	cgaero(:,:,:,:)=0.
179
180	!
181	!-------------------------------------------
182	nb_gr = KLON / kdlon
183	IF (nb_gr*kdlon .NE. KLON) THEN
184	PRINT*, "kdlon mauvais:", KLON, kdlon, nb_gr
185	CALL abort
186	ENDIF
187	IF (kflev .NE. KLEV) THEN
188	PRINT*, "kflev differe de KLEV, kflev, KLEV"
189	CALL abort
190	ENDIF
191	!-------------------------------------------
192	DO k = 1, KLEV
193	DO i = 1, KLON
194	heat(i,k)=0.
195	cool(i,k)=0.
196	heat0(i,k)=0.
197	cool0(i,k)=0.
198	ENDDO
199	ENDDO
200	!
201	zdist = dist
202	!
203	PSCT = solaire/zdist/zdist
204	DO j = 1, nb_gr
205	iof = kdlon*(j-1)
206	DO i = 1, kdlon
207	zfract(i) = fract(iof+i)
208	zrmu0(i) = rmu0(iof+i)
209	PALBD(i,1) = albedo(iof+i)
210	PALBD(i,2) = alblw(iof+i)
211	PALBP(i,1) = albedo(iof+i)
212	PALBP(i,2) = alblw(iof+i)
213	PEMIS(i) = 1.0
214	PVIEW(i) = 1.66
215	PPSOL(i) = paprs(iof+i,1)
216	zx_alpha1 = (paprs(iof+i,1)-pplay(iof+i,2))/(pplay(iof+i,1)-pplay(iof+i,2))
217	zx_alpha2 = 1.0 - zx_alpha1
218	PTL(i,1) = t(iof+i,1) * zx_alpha1 + t(iof+i,2) * zx_alpha2
219	PTL(i,KLEV+1) = t(iof+i,KLEV)
220	PDT0(i) = tsol(iof+i) - PTL(i,1)
221	ENDDO
222	DO k = 2, kflev
223	DO i = 1, kdlon
224	PTL(i,k) = (t(iof+i,k)+t(iof+i,k-1))*0.5
225	ENDDO
226	ENDDO
227	DO k = 1, kflev
228	DO i = 1, kdlon
229	PDP(i,k) = paprs(iof+i,k)-paprs(iof+i,k+1)
230	PTAVE(i,k) = t(iof+i,k)
231	PWV(i,k) = MAX (q(iof+i,k), 1.0e-12)
232	PQS(i,k) = PWV(i,k)
233	! wo: cm.atm (epaisseur en cm dans la situation standard)
234	! POZON: kg/kg
235	POZON(i,k) = MAX(wo(iof+i,k),1.0e-12)*RG/46.6968 &
236	/(paprs(iof+i,k)-paprs(iof+i,k+1))&
237	*(paprs(iof+i,1)/101325.0)
238	PCLDLD(i,k) = cldfra(iof+i,k)*cldemi(iof+i,k)
239	PCLDLU(i,k) = cldfra(iof+i,k)*cldemi(iof+i,k)
240	PCLDSW(i,k) = cldfra(iof+i,k)
241	PTAU(i,1,k) = MAX(cldtaupi(iof+i,k), 1.0e-05)! 1e-12 serait instable
242	PTAU(i,2,k) = MAX(cldtaupi(iof+i,k), 1.0e-05)! pour 32-bit machines
243	POMEGA(i,1,k) = 0.9999 - 5.0e-04 * EXP(-0.5 * PTAU(i,1,k))
244	POMEGA(i,2,k) = 0.9988 - 2.5e-03 * EXP(-0.05 * PTAU(i,2,k))
245	PCG(i,1,k) = 0.865
246	PCG(i,2,k) = 0.910
247	!-
248	! Introduced for aerosol indirect forcings.
249	! The following values use the cloud optical thickness calculated from
250	! present-day aerosol concentrations whereas the quantities without the
251	! "A" at the end are for pre-industial (natural-only) aerosol concentrations
252	!
253	PTAUA(i,1,k) = MAX(cldtaupd(iof+i,k), 1.0e-05)! 1e-12 serait instable
254	PTAUA(i,2,k) = MAX(cldtaupd(iof+i,k), 1.0e-05)! pour 32-bit machines
255	POMEGAA(i,1,k) = 0.9999 - 5.0e-04 * EXP(-0.5 * PTAUA(i,1,k))
256	POMEGAA(i,2,k) = 0.9988 - 2.5e-03 * EXP(-0.05 * PTAUA(i,2,k))
257	ENDDO
258	ENDDO
259	!
260	DO k = 1, kflev+1
261	DO i = 1, kdlon
262	PPMB(i,k) = paprs(iof+i,k)/100.0
263	ENDDO
264	ENDDO
265	!
266	DO kk = 1, 5
267	DO k = 1, kflev
268	DO i = 1, kdlon
269	PAER(i,k,kk) = 1.0E-15
270	ENDDO
271	ENDDO
272	ENDDO
273	DO k = 1, kflev
274	DO i = 1, kdlon
275	tauaero(i,k,:,1)=tau_aero(iof+i,k,:,1)
276	pizaero(i,k,:,1)=piz_aero(iof+i,k,:,1)
277	cgaero(i,k,:,1) =cg_aero(iof+i,k,:,1)
278	tauaero(i,k,:,2)=tau_aero(iof+i,k,:,2)
279	pizaero(i,k,:,2)=piz_aero(iof+i,k,:,2)
280	cgaero(i,k,:,2) =cg_aero(iof+i,k,:,2)
281	ENDDO
282	ENDDO
283	!
284	!======================================================================
285	CALL LW_LMDAR4(&
286	PPMB, PDP,&
287	PPSOL,PDT0,PEMIS,&
288	PTL, PTAVE, PWV, POZON, PAER,&
289	PCLDLD,PCLDLU,&
290	PVIEW,&
291	zcool, zcool0,&
292	ztoplw,zsollw,ztoplw0,zsollw0,&
293	zsollwdown,&
294	ZFLUP, ZFLDN, ZFLUP0,ZFLDN0)
295
296
297	IF (.NOT. new_aod) THEN
298	! use old version
299	CALL SW_LMDAR4(PSCT, zrmu0, zfract,&
300	PPMB, PDP, &
301	PPSOL, PALBD, PALBP,&
302	PTAVE, PWV, PQS, POZON, PAER,&
303	PCLDSW, PTAU, POMEGA, PCG,&
304	zheat, zheat0,&
305	zalbpla,ztopsw,zsolsw,ztopsw0,zsolsw0,&
306	ZFSUP,ZFSDN,ZFSUP0,ZFSDN0,&
307	tau_aero(:,:,5,:), piz_aero(:,:,5,:), cg_aero(:,:,5,:),&
308	PTAUA, POMEGAA,&
309	ztopswadaero,zsolswadaero,&
310	ztopswaiaero,zsolswaiaero,&
311	ok_ade, ok_aie)
312	ELSE
313
314	CALL SW_AEROAR4(PSCT, zrmu0, zfract,&
315	PPMB, PDP,&
316	PPSOL, PALBD, PALBP,&
317	PTAVE, PWV, PQS, POZON, PAER,&
318	PCLDSW, PTAU, POMEGA, PCG,&
319	zheat, zheat0,&
320	zalbpla,ztopsw,zsolsw,ztopsw0,zsolsw0,&
321	ZFSUP,ZFSDN,ZFSUP0,ZFSDN0,&
322	tauaero, pizaero, cgaero, &
323	PTAUA, POMEGAA,&
324	ztopswadaero,zsolswadaero,&
325	ztopswad0aero,zsolswad0aero,&
326	ztopswaiaero,zsolswaiaero, &
327	ztopsw_aero,ztopsw0_aero,&
328	zsolsw_aero,zsolsw0_aero,&
329	ok_ade, ok_aie)
330
331	ENDIF
332	!======================================================================
333	DO i = 1, kdlon
334	radsol(iof+i) = zsolsw(i) + zsollw(i)
335	topsw(iof+i) = ztopsw(i)
336	toplw(iof+i) = ztoplw(i)
337	solsw(iof+i) = zsolsw(i)
338	sollw(iof+i) = zsollw(i)
339	sollwdown(iof+i) = zsollwdown(i)
340	DO k = 1, kflev+1
341	lwdn0 ( iof+i,k) = ZFLDN0 ( i,k)
342	lwdn ( iof+i,k) = ZFLDN ( i,k)
343	lwup0 ( iof+i,k) = ZFLUP0 ( i,k)
344	lwup ( iof+i,k) = ZFLUP ( i,k)
345	ENDDO
346	topsw0(iof+i) = ztopsw0(i)
347	toplw0(iof+i) = ztoplw0(i)
348	solsw0(iof+i) = zsolsw0(i)
349	sollw0(iof+i) = zsollw0(i)
350	albpla(iof+i) = zalbpla(i)
351
352	DO k = 1, kflev+1
353	swdn0 ( iof+i,k) = ZFSDN0 ( i,k)
354	swdn ( iof+i,k) = ZFSDN ( i,k)
355	swup0 ( iof+i,k) = ZFSUP0 ( i,k)
356	swup ( iof+i,k) = ZFSUP ( i,k)
357	ENDDO
358	ENDDO
359	!-transform the aerosol forcings, if they have
360	! to be calculated
361	IF (ok_ade) THEN
362	DO i = 1, kdlon
363	topswad_aero(iof+i) = ztopswadaero(i)
364	topswad0_aero(iof+i) = ztopswad0aero(i)
365	solswad_aero(iof+i) = zsolswadaero(i)
366	solswad0_aero(iof+i) = zsolswad0aero(i)
367	topsw_aero(iof+i,:) = ztopsw_aero(iof+i,:)
368	topsw0_aero(iof+i,:) = ztopsw0_aero(iof+i,:)
369	solsw_aero(iof+i,:) = zsolsw_aero(iof+i,:)
370	solsw0_aero(iof+i,:) = zsolsw0_aero(iof+i,:)
371
372	ENDDO
373	ELSE
374	DO i = 1, kdlon
375	topswad_aero(iof+i) = 0.0
376	solswad_aero(iof+i) = 0.0
377	topswad0_aero(iof+i) = 0.0
378	solswad0_aero(iof+i) = 0.0
379	topsw_aero(iof+i,:) = 0.
380	topsw0_aero(iof+i,:) =0.
381	solsw_aero(iof+i,:) = 0.
382	solsw0_aero(iof+i,:) = 0.
383	ENDDO
384	ENDIF
385	IF (ok_aie) THEN
386	DO i = 1, kdlon
387	topswai_aero(iof+i) = ztopswaiaero(i)
388	solswai_aero(iof+i) = zsolswaiaero(i)
389	ENDDO
390	ELSE
391	DO i = 1, kdlon
392	topswai_aero(iof+i) = 0.0
393	solswai_aero(iof+i) = 0.0
394	ENDDO
395	ENDIF
396	DO k = 1, kflev
397	DO i = 1, kdlon
398	! scale factor to take into account the difference between
399	! dry air and watter vapour scpecifi! heat capacity
400	zznormcp=1.0+RVTMP2*PWV(i,k)
401	heat(iof+i,k) = zheat(i,k)/zznormcp
402	cool(iof+i,k) = zcool(i,k)/zznormcp
403	heat0(iof+i,k) = zheat0(i,k)/zznormcp
404	cool0(iof+i,k) = zcool0(i,k)/zznormcp
405	ENDDO
406	ENDDO
407	!
408	ENDDO
409
410
411	ENDSUBROUTINE radlwsw_aero
412
413

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

Download in other formats:

Original Format