Context Navigation

readaerosol_optic_rrtm.F90 @ 3069

Last change on this file since 3069 was 2381, checked in by acozic, 9 years ago

Make some commit to fit with INCA coupling

merge with rev 2180 on trunk
merge with rev 2185 on trunk
merge with rev 2200 on trunk
change gregorian calendar in wxios

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.0 KB

Line
1	! $Id: readaerosol_optic_rrtm.F90 2381 2015-10-30 13:50:54Z dcugnet $
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	! aeropt_6bands for rrtm
306	CALL aeropt_6bands_rrtm( &
307	pdel, m_allaer, pdtphys, rhcl, &
308	tau_aero, piz_aero, cg_aero, &
309	m_allaer_pi, flag_aerosol, &
310	zrho )
311
312	! aeropt_5wv only for validation and diagnostics
313	CALL aeropt_5wv_rrtm( &
314	pdel, m_allaer, &
315	pdtphys, rhcl, aerindex, &
316	flag_aerosol, pplay, t_seri, &
317	tausum_aero, tau3d_aero )
318
319	! Diagnostics calculation for CMIP5 protocol
320	sconcso4(:) =m_allaer(:,1,id_ASSO4M_phy)*1.e-9
321	sconcno3(:) =(m_allaer(:,1,id_ASNO3M_phy)+m_allaer(:,1,id_CSNO3M_phy)+m_allaer(:,1,id_CINO3M_phy))*1.e-9
322	sconcoa(:) =(m_allaer(:,1,id_ASPOMM_phy)+m_allaer(:,1,id_AIPOMM_phy))*1.e-9
323	sconcbc(:) =(m_allaer(:,1,id_ASBCM_phy)+m_allaer(:,1,id_AIBCM_phy))*1.e-9
324	sconcss(:) =(m_allaer(:,1,id_ASSSM_phy)+m_allaer(:,1,id_CSSSM_phy)+m_allaer(:,1,id_SSSSM_phy))*1.e-9
325	sconcdust(:) =m_allaer(:,1,id_CIDUSTM_phy)*1.e-9
326	concso4(:,:) =m_allaer(:,:,id_ASSO4M_phy)*1.e-9
327	concno3(:,:) =(m_allaer(:,:,id_ASNO3M_phy)+m_allaer(:,:,id_CSNO3M_phy)+m_allaer(:,:,id_CINO3M_phy))*1.e-9
328	concoa(:,:) =(m_allaer(:,:,id_ASPOMM_phy)+m_allaer(:,:,id_AIPOMM_phy))*1.e-9
329	concbc(:,:) =(m_allaer(:,:,id_ASBCM_phy)+m_allaer(:,:,id_AIBCM_phy))*1.e-9
330	concss(:,:) =(m_allaer(:,:,id_ASSSM_phy)+m_allaer(:,:,id_CSSSM_phy)+m_allaer(:,:,id_SSSSM_phy))*1.e-9
331	concdust(:,:)=m_allaer(:,:,id_CIDUSTM_phy)*1.e-9
332
333	END SUBROUTINE readaerosol_optic_rrtm

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

Download in other formats:

Original Format