Context Navigation

readaerosol_optic_rrtm.F90 @ 2749

Last change on this file since 2749 was 2738, checked in by oboucher, 8 years ago
Swapping the order of CSSO4 and ASSO4 aerosols (and fixing an issue on aerindex). Preparing the ground for nitrate aerosols (coarse soluble, accumulation soluble, coarse insoluble). Modifying the LW aeropt routine so that it is compatible with both INCA and climatological aerosols (for dust only). Adding a new flag ok_alw for activating aerosol direct LW effect (for dust only). This change is bit comparable for flag_aerosol=6, flag_rrtm=1, NSW=6.
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.3 KB

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

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

Download in other formats:

Original Format