Context Navigation

readaerosol_optic_rrtm.F90 @ 2297

Last change on this file since 2297 was 2297, checked in by musat, 9 years ago

RRTM :
Correction bug interface avec rrtm (radlwsw_m.F90)
Ajouter la possibilite d'utilsation d'anciennes proprites optique dans le cas RRTM 2bandes (readaerosol_optic_rrtm.F90)
Correction rrtm (rrtm_rtrn1a_140gp.F90)

COSP :
Modifications pour traiter les valeurs indefines :
mise a 0 en cas d'utilisation de IOIPSL
mise a la valeur recuperee dans .xml en cas d'utilisation de XIOS

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:keywords set to Author Date Id Revi

File size: 15.8 KB

Line
1	! $Id: readaerosol_optic_rrtm.F90 2297 2015-06-12 21:38:57Z musat $
2	!
3	SUBROUTINE readaerosol_optic_rrtm(debut, aerosol_couple, &
4	new_aod, flag_aerosol, itap, rjourvrai, &
5	pdtphys, pplay, paprs, t_seri, rhcl, presnivs, &
6	tr_seri, mass_solu_aero, mass_solu_aero_pi, &
7	tau_aero, piz_aero, cg_aero, &
8	tausum_aero, tau3d_aero )
9
10	! This routine will :
11	! 1) recevie the aerosols(already read and interpolated) corresponding to flag_aerosol
12	! 2) calculate the optical properties for the aerosols
13	!
14
15	USE dimphy
16	USE aero_mod
17	USE phys_local_var_mod, only: sconcso4,sconcno3,sconcoa,sconcbc,sconcss,sconcdust, &
18	concso4,concno3,concoa,concbc,concss,concdust,loadso4,loadoa,loadbc,loadss,loaddust, &
19	load_tmp1,load_tmp2,load_tmp3,load_tmp4,load_tmp5,load_tmp6,load_tmp7
20
21	USE infotrac
22
23	IMPLICIT NONE
24	include "clesphys.h"
25	include "YOMCST.h"
26
27
28	! Input arguments
29	!****************************************************************************************
30	LOGICAL, INTENT(IN) :: debut
31	LOGICAL, INTENT(IN) :: aerosol_couple
32	LOGICAL, INTENT(IN) :: new_aod
33	INTEGER, INTENT(IN) :: flag_aerosol
34	INTEGER, INTENT(IN) :: itap
35	REAL, INTENT(IN) :: rjourvrai
36	REAL, INTENT(IN) :: pdtphys
37	REAL, DIMENSION(klon,klev), INTENT(IN) :: pplay
38	REAL, DIMENSION(klon,klev+1), INTENT(IN) :: paprs
39	REAL, DIMENSION(klon,klev), INTENT(IN) :: t_seri
40	REAL, DIMENSION(klon,klev), INTENT(IN) :: rhcl ! humidite relative ciel clair
41	REAL, DIMENSION(klev), INTENT(IN) :: presnivs
42	REAL, DIMENSION(klon,klev,nbtr), INTENT(IN) :: tr_seri ! concentration tracer
43
44	! Output arguments
45	!****************************************************************************************
46	REAL, DIMENSION(klon,klev), INTENT(OUT) :: mass_solu_aero ! Total mass for all soluble aerosols
47	REAL, DIMENSION(klon,klev), INTENT(OUT) :: mass_solu_aero_pi ! -"- preindustrial values
48	REAL, DIMENSION(klon,klev,2,NSW), INTENT(OUT) :: tau_aero ! Aerosol optical thickness
49	REAL, DIMENSION(klon,klev,2,NSW), INTENT(OUT) :: piz_aero ! Single scattering albedo aerosol
50	REAL, DIMENSION(klon,klev,2,NSW), INTENT(OUT) :: cg_aero ! asymmetry parameter aerosol
51	REAL, DIMENSION(klon,nwave,naero_tot), INTENT(OUT) :: tausum_aero
52	REAL, DIMENSION(klon,klev,nwave,naero_tot), INTENT(OUT) :: tau3d_aero
53
54	! Local variables
55	!****************************************************************************************
56	REAL, DIMENSION(klon) :: aerindex ! POLDER aerosol index
57	REAL, DIMENSION(klon,klev) :: sulfacc ! SO4 accumulation concentration [ug/m3]
58	REAL, DIMENSION(klon,klev) :: sulfcoarse ! SO4 coarse concentration [ug/m3]
59	REAL, DIMENSION(klon,klev) :: bcsol ! BC soluble concentration [ug/m3]
60	REAL, DIMENSION(klon,klev) :: bcins ! BC insoluble concentration [ug/m3]
61	REAL, DIMENSION(klon,klev) :: pomsol ! POM soluble concentration [ug/m3]
62	REAL, DIMENSION(klon,klev) :: pomins ! POM insoluble concentration [ug/m3]
63	REAL, DIMENSION(klon,klev) :: cidust ! DUST aerosol concentration [ug/m3]
64	REAL, DIMENSION(klon,klev) :: sscoarse ! SS Coarse concentration [ug/m3]
65	REAL, DIMENSION(klon,klev) :: sssupco ! SS Super Coarse concentration [ug/m3]
66	REAL, DIMENSION(klon,klev) :: ssacu ! SS Acumulation concentration [ug/m3]
67	REAL, DIMENSION(klon,klev) :: nitracc ! nitrate accumulation concentration [ug/m3]
68	REAL, DIMENSION(klon,klev) :: nitrcoarse ! nitrate coarse concentration [ug/m3]
69	REAL, DIMENSION(klon,klev) :: nitrinscoarse ! nitrate insoluble coarse concentration [ug/m3]
70	REAL, DIMENSION(klon,klev) :: sulfacc_pi
71	REAL, DIMENSION(klon,klev) :: sulfcoarse_pi
72	REAL, DIMENSION(klon,klev) :: bcsol_pi
73	REAL, DIMENSION(klon,klev) :: bcins_pi
74	REAL, DIMENSION(klon,klev) :: pomsol_pi
75	REAL, DIMENSION(klon,klev) :: pomins_pi
76	REAL, DIMENSION(klon,klev) :: cidust_pi
77	REAL, DIMENSION(klon,klev) :: sscoarse_pi
78	REAL, DIMENSION(klon,klev) :: sssupco_pi
79	REAL, DIMENSION(klon,klev) :: ssacu_pi
80	REAL, DIMENSION(klon,klev) :: nitracc_pi
81	REAL, DIMENSION(klon,klev) :: nitrcoarse_pi
82	REAL, DIMENSION(klon,klev) :: nitrinscoarse_pi
83	REAL, DIMENSION(klon,klev) :: pdel, zrho
84	REAL, DIMENSION(klon,klev,naero_tot) :: m_allaer
85	REAL, DIMENSION(klon,klev,naero_tot) :: m_allaer_pi !RAF
86
87	integer :: id_ASBCM, id_ASPOMM, id_ASSO4M, id_ASMSAM, id_CSSO4M, id_CSMSAM, id_SSSSM
88	integer :: id_CSSSM, id_ASSSM, id_CIDUSTM, id_AIBCM, id_AIPOMM, id_ASNO3M, id_CSNO3M, id_CINO3M
89	INTEGER :: k, i
90
91	!--air density
92	zrho(:,:)=pplay(:,:)/t_seri(:,:)/RD !--kg/m3
93
94	!****************************************************************************************
95	! 1) Get aerosol mass
96	!
97	!****************************************************************************************
98	!
99	!
100	IF (aerosol_couple) THEN !--we get aerosols from tr_seri array from INCA
101	!
102	!--copy fields from INCA tr_seri
103	!--convert to ug m-3 unit for consistency with offline fields
104	!
105	do i=1,nbtr
106	select case(trim(solsym(i)))
107	case ("ASBCM")
108	id_ASBCM = i
109	case ("ASPOMM")
110	id_ASPOMM = i
111	case ("ASSO4M")
112	id_ASSO4M = i
113	case ("ASMSAM")
114	id_ASMSAM = i
115	case ("CSSO4M")
116	id_CSSO4M = i
117	case ("CSMSAM")
118	id_CSMSAM = i
119	case ("SSSSM")
120	id_SSSSM = i
121	case ("CSSSM")
122	id_CSSSM = i
123	case ("ASSSM")
124	id_ASSSM = i
125	case ("CIDUSTM")
126	id_CIDUSTM = i
127	case ("AIBCM")
128	id_AIBCM = i
129	case ("AIPOMM")
130	id_AIPOMM = i
131	case ("ASNO3M")
132	id_ASNO3M = i
133	case ("CSNO3M")
134	id_CSNO3M = i
135	case ("CINO3M")
136	id_CINO3M = i
137	end select
138	enddo
139
140
141	bcsol(:,:) = tr_seri(:,:,id_ASBCM) zrho(:,:)1.e9 ! ASBCM
142	pomsol(:,:) = tr_seri(:,:,id_ASPOMM) zrho(:,:)1.e9 ! ASPOMM
143	sulfacc(:,:) = (tr_seri(:,:,id_ASSO4M)+tr_seri(:,:,id_ASMSAM))zrho(:,:)1.e9 ! ASSO4M (=SO4) + ASMSAM (=MSA)
144	sulfcoarse(:,:) = (tr_seri(:,:,id_CSSO4M)+tr_seri(:,:,id_CSMSAM))zrho(:,:)1.e9 ! CSSO4M (=SO4) + CSMSAM (=MSA)
145	sssupco(:,:) = tr_seri(:,:,id_SSSSM) zrho(:,:)1.e9 ! SSSSM
146	sscoarse(:,:) = tr_seri(:,:,id_CSSSM) zrho(:,:)1.e9 ! CSSSM
147	ssacu(:,:) = tr_seri(:,:,id_ASSSM) zrho(:,:)1.e9 ! ASSSM
148	cidust(:,:) = tr_seri(:,:,id_CIDUSTM) zrho(:,:)1.e9 ! CIDUSTM
149	bcins(:,:) = tr_seri(:,:,id_AIBCM) zrho(:,:)1.e9 ! AIBCM
150	pomins(:,:) = tr_seri(:,:,id_AIPOMM) zrho(:,:)1.e9 ! AIPOMM
151	nitracc(:,:) = tr_seri(:,:,id_ASNO3M) zrho(:,:)1.e9 ! ASNO3M
152	nitrcoarse(:,:) = tr_seri(:,:,id_CSNO3M) zrho(:,:)1.e9 ! CSNO3M
153	nitrinscoarse(:,:)= tr_seri(:,:,id_CINO3M) zrho(:,:)1.e9 ! CINO3M
154	!
155	bcsol_pi(:,:) = 0.0 ! ASBCM pre-ind
156	pomsol_pi(:,:) = 0.0 ! ASPOMM pre-ind
157	sulfacc_pi(:,:) = 0.0 ! ASSO4M (=SO4) + ASMSAM (=MSA) pre-ind
158	sulfcoarse_pi(:,:) = 0.0 ! CSSO4M (=SO4) + CSMSAM (=MSA) pre-ind
159	sssupco_pi(:,:) = 0.0 ! SSSSM pre-ind
160	sscoarse_pi(:,:) = 0.0 ! CSSSM pre-ind
161	ssacu_pi(:,:) = 0.0 ! ASSSM pre-ind
162	cidust_pi(:,:) = 0.0 ! CIDUSTM pre-ind
163	bcins_pi(:,:) = 0.0 ! AIBCM pre-ind
164	pomins_pi(:,:) = 0.0 ! AIPOMM pre-ind
165	nitracc_pi(:,:) = 0.0 ! ASNO3M pre-ind
166	nitrcoarse_pi(:,:) = 0.0 ! CSNO3M pre-ind
167	nitrinscoarse_pi(:,:)= 0.0 ! CINO3M
168	!
169	ELSE !--not aerosol_couple
170	!
171	! Read and interpolate sulfate
172	IF ( flag_aerosol .EQ. 1 .OR. &
173	flag_aerosol .EQ. 6 ) THEN
174
175	CALL readaerosol_interp(id_ASSO4M_phy, itap, pdtphys, rjourvrai, debut, pplay, paprs, t_seri, sulfacc, sulfacc_pi,loadso4)
176	ELSE
177	sulfacc(:,:) = 0. ; sulfacc_pi(:,:) = 0.
178	loadso4=0.
179	END IF
180
181	! Read and interpolate bcsol and bcins
182	IF ( flag_aerosol .EQ. 2 .OR. &
183	flag_aerosol .EQ. 6 ) THEN
184
185	! Get bc aerosol distribution
186	CALL readaerosol_interp(id_ASBCM_phy, itap, pdtphys, rjourvrai, debut, pplay, paprs, t_seri, bcsol, bcsol_pi, load_tmp1 )
187	CALL readaerosol_interp(id_AIBCM_phy, itap, pdtphys, rjourvrai, debut, pplay, paprs, t_seri, bcins, bcins_pi, load_tmp2 )
188	loadbc(:)=load_tmp1(:)+load_tmp2(:)
189	ELSE
190	bcsol(:,:) = 0. ; bcsol_pi(:,:) = 0.
191	bcins(:,:) = 0. ; bcins_pi(:,:) = 0.
192	loadbc=0.
193	END IF
194
195
196	! Read and interpolate pomsol and pomins
197	IF ( flag_aerosol .EQ. 3 .OR. &
198	flag_aerosol .EQ. 6 ) THEN
199
200	CALL readaerosol_interp(id_ASPOMM_phy, itap, pdtphys, rjourvrai, debut, pplay, paprs, t_seri, pomsol, pomsol_pi, load_tmp3)
201	CALL readaerosol_interp(id_AIPOMM_phy, itap, pdtphys, rjourvrai, debut, pplay, paprs, t_seri, pomins, pomins_pi, load_tmp4)
202	loadoa(:)=load_tmp3(:)+load_tmp4(:)
203	ELSE
204	pomsol(:,:) = 0. ; pomsol_pi(:,:) = 0.
205	pomins(:,:) = 0. ; pomins_pi(:,:) = 0.
206	loadoa=0.
207	END IF
208
209
210	! Read and interpolate csssm, ssssm, assssm
211	IF (flag_aerosol .EQ. 4 .OR. &
212	flag_aerosol .EQ. 6 ) THEN
213
214	CALL readaerosol_interp(id_SSSSM_phy ,itap, pdtphys,rjourvrai, &
215	debut, pplay, paprs, t_seri, sssupco, sssupco_pi, load_tmp5)
216	CALL readaerosol_interp(id_CSSSM_phy ,itap, pdtphys,rjourvrai, &
217	debut, pplay, paprs, t_seri, sscoarse,sscoarse_pi, load_tmp6)
218	CALL readaerosol_interp(id_ASSSM_phy ,itap, pdtphys, rjourvrai, &
219	debut, pplay, paprs, t_seri, ssacu, ssacu_pi, load_tmp7)
220	loadss(:)=load_tmp5(:)+load_tmp6(:)+load_tmp7(:)
221	ELSE
222	sscoarse(:,:) = 0. ; sscoarse_pi(:,:) = 0.
223	ssacu(:,:) = 0. ; ssacu_pi(:,:) = 0.
224	sssupco(:,:) = 0. ; sssupco_pi = 0.
225	loadss=0.
226	ENDIF
227
228	! Read and interpolate cidustm
229	IF (flag_aerosol .EQ. 5 .OR. &
230	flag_aerosol .EQ. 6 ) THEN
231
232	CALL readaerosol_interp(id_CIDUSTM_phy, itap, pdtphys, rjourvrai, debut, pplay, paprs, t_seri, cidust, cidust_pi, loaddust)
233
234	ELSE
235	cidust(:,:) = 0. ; cidust_pi(:,:) = 0.
236	loaddust=0.
237	ENDIF
238	!
239	sulfcoarse(:,:) = 0.0 ! CSSO4M (=SO4) + CSMSAM (=MSA)
240	sulfcoarse_pi(:,:) = 0.0 ! CSSO4M (=SO4) + CSMSAM (=MSA) pre-ind
241	!
242	!--placeholder for offline nitrate
243	!
244	nitracc(:,:) = 0.0
245	nitracc_pi(:,:) = 0.0
246	nitrcoarse(:,:) = 0.0
247	nitrcoarse_pi(:,:) = 0.0
248	nitrinscoarse(:,:) = 0.0
249	nitrinscoarse_pi(:,:)= 0.0
250
251	ENDIF !--not aerosol_couple
252
253	!
254	! Store all aerosols in one variable
255	!
256	m_allaer(:,:,id_ASBCM_phy) = bcsol(:,:) ! ASBCM
257	m_allaer(:,:,id_ASPOMM_phy) = pomsol(:,:) ! ASPOMM
258	m_allaer(:,:,id_ASSO4M_phy) = sulfacc(:,:) ! ASSO4M (= SO4)
259	m_allaer(:,:,id_CSSO4M_phy) = sulfcoarse(:,:) ! CSSO4M
260	m_allaer(:,:,id_SSSSM_phy) = sssupco(:,:) ! SSSSM
261	m_allaer(:,:,id_CSSSM_phy) = sscoarse(:,:) ! CSSSM
262	m_allaer(:,:,id_ASSSM_phy) = ssacu(:,:) ! ASSSM
263	m_allaer(:,:,id_CIDUSTM_phy)= cidust(:,:) ! CIDUSTM
264	m_allaer(:,:,id_AIBCM_phy) = bcins(:,:) ! AIBCM
265	m_allaer(:,:,id_ASNO3M_phy) = nitracc(:,:) ! ASNO3M
266	m_allaer(:,:,id_CSNO3M_phy) = nitrcoarse(:,:) ! CSNO3M
267	m_allaer(:,:,id_CINO3M_phy) = nitrinscoarse(:,:)! CINO3M
268	m_allaer(:,:,id_AIPOMM_phy) = pomins(:,:) ! AIPOMM
269	m_allaer(:,:,id_STRAT_phy) = 0.0
270
271	!RAF
272	m_allaer_pi(:,:,id_ASBCM_phy) = bcsol_pi(:,:) ! ASBCM pre-ind
273	m_allaer_pi(:,:,id_ASPOMM_phy) = pomsol_pi(:,:) ! ASPOMM pre-ind
274	m_allaer_pi(:,:,id_ASSO4M_phy) = sulfacc_pi(:,:) ! ASSO4M (= SO4) pre-ind
275	m_allaer_pi(:,:,id_CSSO4M_phy) = sulfcoarse_pi(:,:) ! CSSO4M pre-ind
276	m_allaer_pi(:,:,id_SSSSM_phy) = sssupco_pi(:,:) ! SSSSM pre-ind
277	m_allaer_pi(:,:,id_CSSSM_phy) = sscoarse_pi(:,:) ! CSSSM pre-ind
278	m_allaer_pi(:,:,id_ASSSM_phy) = ssacu_pi(:,:) ! ASSSM pre-ind
279	m_allaer_pi(:,:,id_CIDUSTM_phy)= cidust_pi(:,:) ! CIDUSTM pre-ind
280	m_allaer_pi(:,:,id_AIBCM_phy) = bcins_pi(:,:) ! AIBCM pre-ind
281	m_allaer_pi(:,:,id_ASNO3M_phy) = nitracc_pi(:,:) ! ASNO3M pre-ind
282	m_allaer_pi(:,:,id_CSNO3M_phy) = nitrcoarse_pi(:,:) ! CSNO3M pre-ind
283	m_allaer_pi(:,:,id_CINO3M_phy) = nitrinscoarse_pi(:,:)! CINO3M pre-ind
284	m_allaer_pi(:,:,id_AIPOMM_phy) = pomins_pi(:,:) ! AIPOMM pre-ind
285	m_allaer_pi(:,:,id_STRAT_phy) = 0.0
286
287	!
288	! Calculate the total mass of all soluble aersosols
289	! to be revisited for AR6
290	mass_solu_aero(:,:) = sulfacc(:,:) + bcsol(:,:) + pomsol(:,:) + nitracc(:,:) ! + &
291	! sscoarse(:,:) + ssacu(:,:) + sssupco(:,:)
292	mass_solu_aero_pi(:,:) = sulfacc_pi(:,:) + bcsol_pi(:,:) + pomsol_pi(:,:) + nitracc_pi(:,:) ! + &
293	! sscoarse_pi(:,:) + ssacu_pi(:,:) + sssupco_pi(:,:)
294
295	!****************************************************************************************
296	! 2) Calculate optical properties for the aerosols
297	!
298	!****************************************************************************************
299	DO k = 1, klev
300	DO i = 1, klon
301	pdel(i,k) = paprs(i,k) - paprs (i,k+1)
302	END DO
303	END DO
304
305	! AI 12 juin 2015
306	! Modif Olivier pour prendre en compte des prop optiq aero ancienne pour RRTM 2bds
307
308	IF (NSW.EQ.2) THEN
309	!--old aerosol properties
310
311	! old aeropt_2bands for rrtm
312	CALL aeropt_2bands( &
313	pdel, m_allaer, pdtphys, rhcl, &
314	tau_aero, piz_aero, cg_aero, &
315	m_allaer_pi, flag_aerosol, &
316	pplay, t_seri, presnivs)
317
318	! aeropt_5wv only for validation and diagnostics.
319	CALL aeropt_5wv( &
320	pdel, m_allaer, &
321	pdtphys, rhcl, aerindex, &
322	flag_aerosol, pplay, t_seri, &
323	tausum_aero, tau3d_aero, presnivs)
324
325	ELSEIF (NSW.EQ.6) THEN
326	!--new aerosol propertie
327	! aeropt_6bands for rrtm
328	CALL aeropt_6bands_rrtm( &
329	pdel, m_allaer, pdtphys, rhcl, &
330	tau_aero, piz_aero, cg_aero, &
331	m_allaer_pi, flag_aerosol, &
332	zrho )
333
334	! aeropt_5wv only for validation and diagnostics
335	CALL aeropt_5wv_rrtm( &
336	pdel, m_allaer, &
337	pdtphys, rhcl, aerindex, &
338	flag_aerosol, pplay, t_seri, &
339	tausum_aero, tau3d_aero )
340
341	ELSE
342
343	PRINT *,'Cas NSW non prevu pour RRTM - NSW=',NSW
344	STOP
345
346	ENDIF
347
348	! Diagnostics calculation for CMIP5 protocol
349	sconcso4(:) =m_allaer(:,1,id_ASSO4M_phy)*1.e-9
350	sconcno3(:) =(m_allaer(:,1,id_ASNO3M_phy)+m_allaer(:,1,id_CSNO3M_phy)+m_allaer(:,1,id_CINO3M_phy))*1.e-9
351	sconcoa(:) =(m_allaer(:,1,id_ASPOMM_phy)+m_allaer(:,1,id_AIPOMM_phy))*1.e-9
352	sconcbc(:) =(m_allaer(:,1,id_ASBCM_phy)+m_allaer(:,1,id_AIBCM_phy))*1.e-9
353	sconcss(:) =(m_allaer(:,1,id_ASSSM_phy)+m_allaer(:,1,id_CSSSM_phy)+m_allaer(:,1,id_SSSSM_phy))*1.e-9
354	sconcdust(:) =m_allaer(:,1,id_CIDUSTM_phy)*1.e-9
355	concso4(:,:) =m_allaer(:,:,id_ASSO4M_phy)*1.e-9
356	concno3(:,:) =(m_allaer(:,:,id_ASNO3M_phy)+m_allaer(:,:,id_CSNO3M_phy)+m_allaer(:,:,id_CINO3M_phy))*1.e-9
357	concoa(:,:) =(m_allaer(:,:,id_ASPOMM_phy)+m_allaer(:,:,id_AIPOMM_phy))*1.e-9
358	concbc(:,:) =(m_allaer(:,:,id_ASBCM_phy)+m_allaer(:,:,id_AIBCM_phy))*1.e-9
359	concss(:,:) =(m_allaer(:,:,id_ASSSM_phy)+m_allaer(:,:,id_CSSSM_phy)+m_allaer(:,:,id_SSSSM_phy))*1.e-9
360	concdust(:,:)=m_allaer(:,:,id_CIDUSTM_phy)*1.e-9
361
362	END SUBROUTINE readaerosol_optic_rrtm

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

Download in other formats:

Original Format