Context Navigation

readaerosol_optic_rrtm.F90 @ 5441

Last change on this file since 5441 was 5159, checked in by abarral, 5 months ago
Put dimensions.h and paramet.h into modules
File size: 16.2 KB

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

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

Download in other formats:

Original Format