Context Navigation

readaerosol_optic_rrtm.F90 @ 4799

Last change on this file since 4799 was 3630, checked in by Laurent Fairhead, 5 years ago
Parameter new_aod is not needed anymore as it is assumed to be true all the time. This means that we cannot replay AR4 simulations with new LMDZ sources (we probably couldn't anyway) LF, OB
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: 16.2 KB

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

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

Download in other formats:

Original Format