Context Navigation

readaerosol_optic_rrtm.F90 @ 2172

Last change on this file since 2172 was 2171, checked in by acozic, 10 years ago
There are some commits that we must not do just before holiday .... so be back to rev 2168
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.2 KB

Line
1	! $Id: readaerosol_optic_rrtm.F90 2171 2014-12-19 15:21:08Z jescribano $
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	! REAL, DIMENSION(klon,naero_tot) :: fractnat_allaer !RAF delete??
87	character(len=8), dimension(nbtr) :: tracname
88	integer :: id_ASBCM, id_ASPOMM, id_ASSO4M, id_ASMSAM, id_CSSO4M, id_CSMSAM, id_SSSSM
89	integer :: id_CSSSM, id_ASSSM, id_CIDUSTM, id_AIBCM, id_AIPOMM, id_ASNO3M, id_CSNO3M, id_CINO3M
90	INTEGER :: k, i
91
92	!--air density
93	zrho(:,:)=pplay(:,:)/t_seri(:,:)/RD !--kg/m3
94
95	!****************************************************************************************
96	! 1) Get aerosol mass
97	!
98	!****************************************************************************************
99	!
100	!
101	IF (aerosol_couple) THEN !--we get aerosols from tr_seri array from INCA
102	!
103	!--copy fields from INCA tr_seri
104	!--convert to ug m-3 unit for consistency with offline fields
105	!
106	#ifdef INCA
107	call tracinca_name(tracname)
108	#endif
109
110	do i=1,nbtr
111	select case(trim(tracname(i)))
112	case ("ASBCM")
113	id_ASBCM = i
114	case ("ASPOMM")
115	id_ASPOMM = i
116	case ("ASSO4M")
117	id_ASSO4M = i
118	case ("ASMSAM")
119	id_ASMSAM = i
120	case ("CSSO4M")
121	id_CSSO4M = i
122	case ("CSMSAM")
123	id_CSMSAM = i
124	case ("SSSSM")
125	id_SSSSM = i
126	case ("CSSSM")
127	id_CSSSM = i
128	case ("ASSSM")
129	id_ASSSM = i
130	case ("CIDUSTM")
131	id_CIDUSTM = i
132	case ("AIBCM")
133	id_AIBCM = i
134	case ("AIPOMM")
135	id_AIPOMM = i
136	case ("ASNO3M")
137	id_ASNO3M = i
138	case ("CSNO3M")
139	id_CSNO3M = i
140	case ("CINO3M")
141	id_CINO3M = i
142	end select
143	enddo
144
145
146	bcsol(:,:) = tr_seri(:,:,id_ASBCM) zrho(:,:)1.e9 ! ASBCM
147	pomsol(:,:) = tr_seri(:,:,id_ASPOMM) zrho(:,:)1.e9 ! ASPOMM
148	sulfacc(:,:) = (tr_seri(:,:,id_ASSO4M)+tr_seri(:,:,id_ASMSAM))zrho(:,:)1.e9 ! ASSO4M (=SO4) + ASMSAM (=MSA)
149	sulfcoarse(:,:) = (tr_seri(:,:,id_CSSO4M)+tr_seri(:,:,id_CSMSAM))zrho(:,:)1.e9 ! CSSO4M (=SO4) + CSMSAM (=MSA)
150	sssupco(:,:) = tr_seri(:,:,id_SSSSM) zrho(:,:)1.e9 ! SSSSM
151	sscoarse(:,:) = tr_seri(:,:,id_CSSSM) zrho(:,:)1.e9 ! CSSSM
152	ssacu(:,:) = tr_seri(:,:,id_ASSSM) zrho(:,:)1.e9 ! ASSSM
153	cidust(:,:) = tr_seri(:,:,id_CIDUSTM) zrho(:,:)1.e9 ! CIDUSTM
154	bcins(:,:) = tr_seri(:,:,id_AIBCM) zrho(:,:)1.e9 ! AIBCM
155	pomins(:,:) = tr_seri(:,:,id_AIPOMM) zrho(:,:)1.e9 ! AIPOMM
156	nitracc(:,:) = tr_seri(:,:,id_ASNO3M) zrho(:,:)1.e9 ! ASNO3M
157	nitrcoarse(:,:) = tr_seri(:,:,id_CSNO3M) zrho(:,:)1.e9 ! CSNO3M
158	nitrinscoarse(:,:)= tr_seri(:,:,id_CINO3M) zrho(:,:)1.e9 ! CINO3M
159	!
160	bcsol_pi(:,:) = 0.0 ! ASBCM pre-ind
161	pomsol_pi(:,:) = 0.0 ! ASPOMM pre-ind
162	sulfacc_pi(:,:) = 0.0 ! ASSO4M (=SO4) + ASMSAM (=MSA) pre-ind
163	sulfcoarse_pi(:,:) = 0.0 ! CSSO4M (=SO4) + CSMSAM (=MSA) pre-ind
164	sssupco_pi(:,:) = 0.0 ! SSSSM pre-ind
165	sscoarse_pi(:,:) = 0.0 ! CSSSM pre-ind
166	ssacu_pi(:,:) = 0.0 ! ASSSM pre-ind
167	cidust_pi(:,:) = 0.0 ! CIDUSTM pre-ind
168	bcins_pi(:,:) = 0.0 ! AIBCM pre-ind
169	pomins_pi(:,:) = 0.0 ! AIPOMM pre-ind
170	nitracc_pi(:,:) = 0.0 ! ASNO3M pre-ind
171	nitrcoarse_pi(:,:) = 0.0 ! CSNO3M pre-ind
172	nitrinscoarse_pi(:,:)= 0.0 ! CINO3M
173	!
174	ELSE !--not aerosol_couple
175	!
176	! Read and interpolate sulfate
177	IF ( flag_aerosol .EQ. 1 .OR. &
178	flag_aerosol .EQ. 6 ) THEN
179
180	CALL readaerosol_interp(id_ASSO4M_phy, itap, pdtphys, rjourvrai, debut, pplay, paprs, t_seri, sulfacc, sulfacc_pi,loadso4)
181	ELSE
182	sulfacc(:,:) = 0. ; sulfacc_pi(:,:) = 0.
183	loadso4=0.
184	END IF
185
186	! Read and interpolate bcsol and bcins
187	IF ( flag_aerosol .EQ. 2 .OR. &
188	flag_aerosol .EQ. 6 ) THEN
189
190	! Get bc aerosol distribution
191	CALL readaerosol_interp(id_ASBCM_phy, itap, pdtphys, rjourvrai, debut, pplay, paprs, t_seri, bcsol, bcsol_pi, load_tmp1 )
192	CALL readaerosol_interp(id_AIBCM_phy, itap, pdtphys, rjourvrai, debut, pplay, paprs, t_seri, bcins, bcins_pi, load_tmp2 )
193	loadbc(:)=load_tmp1(:)+load_tmp2(:)
194	ELSE
195	bcsol(:,:) = 0. ; bcsol_pi(:,:) = 0.
196	bcins(:,:) = 0. ; bcins_pi(:,:) = 0.
197	loadbc=0.
198	END IF
199
200
201	! Read and interpolate pomsol and pomins
202	IF ( flag_aerosol .EQ. 3 .OR. &
203	flag_aerosol .EQ. 6 ) THEN
204
205	CALL readaerosol_interp(id_ASPOMM_phy, itap, pdtphys, rjourvrai, debut, pplay, paprs, t_seri, pomsol, pomsol_pi, load_tmp3)
206	CALL readaerosol_interp(id_AIPOMM_phy, itap, pdtphys, rjourvrai, debut, pplay, paprs, t_seri, pomins, pomins_pi, load_tmp4)
207	loadoa(:)=load_tmp3(:)+load_tmp4(:)
208	ELSE
209	pomsol(:,:) = 0. ; pomsol_pi(:,:) = 0.
210	pomins(:,:) = 0. ; pomins_pi(:,:) = 0.
211	loadoa=0.
212	END IF
213
214
215	! Read and interpolate csssm, ssssm, assssm
216	IF (flag_aerosol .EQ. 4 .OR. &
217	flag_aerosol .EQ. 6 ) THEN
218
219	CALL readaerosol_interp(id_SSSSM_phy ,itap, pdtphys,rjourvrai, &
220	debut, pplay, paprs, t_seri, sssupco, sssupco_pi, load_tmp5)
221	CALL readaerosol_interp(id_CSSSM_phy ,itap, pdtphys,rjourvrai, &
222	debut, pplay, paprs, t_seri, sscoarse,sscoarse_pi, load_tmp6)
223	CALL readaerosol_interp(id_ASSSM_phy ,itap, pdtphys, rjourvrai, &
224	debut, pplay, paprs, t_seri, ssacu, ssacu_pi, load_tmp7)
225	loadss(:)=load_tmp5(:)+load_tmp6(:)+load_tmp7(:)
226	ELSE
227	sscoarse(:,:) = 0. ; sscoarse_pi(:,:) = 0.
228	ssacu(:,:) = 0. ; ssacu_pi(:,:) = 0.
229	sssupco(:,:) = 0. ; sssupco_pi = 0.
230	loadss=0.
231	ENDIF
232
233	! Read and interpolate cidustm
234	IF (flag_aerosol .EQ. 5 .OR. &
235	flag_aerosol .EQ. 6 ) THEN
236
237	CALL readaerosol_interp(id_CIDUSTM_phy, itap, pdtphys, rjourvrai, debut, pplay, paprs, t_seri, cidust, cidust_pi, loaddust)
238
239	ELSE
240	cidust(:,:) = 0. ; cidust_pi(:,:) = 0.
241	loaddust=0.
242	ENDIF
243	!
244	sulfcoarse(:,:) = 0.0 ! CSSO4M (=SO4) + CSMSAM (=MSA)
245	sulfcoarse_pi(:,:) = 0.0 ! CSSO4M (=SO4) + CSMSAM (=MSA) pre-ind
246	!
247	!--placeholder for offline nitrate
248	!
249	nitracc(:,:) = 0.0
250	nitracc_pi(:,:) = 0.0
251	nitrcoarse(:,:) = 0.0
252	nitrcoarse_pi(:,:) = 0.0
253	nitrinscoarse(:,:) = 0.0
254	nitrinscoarse_pi(:,:)= 0.0
255
256	ENDIF !--not aerosol_couple
257
258	!
259	! Store all aerosols in one variable
260	!
261	m_allaer(:,:,id_ASBCM_phy) = bcsol(:,:) ! ASBCM
262	m_allaer(:,:,id_ASPOMM_phy) = pomsol(:,:) ! ASPOMM
263	m_allaer(:,:,id_ASSO4M_phy) = sulfacc(:,:) ! ASSO4M (= SO4)
264	m_allaer(:,:,id_CSSO4M_phy) = sulfcoarse(:,:) ! CSSO4M
265	m_allaer(:,:,id_SSSSM_phy) = sssupco(:,:) ! SSSSM
266	m_allaer(:,:,id_CSSSM_phy) = sscoarse(:,:) ! CSSSM
267	m_allaer(:,:,id_ASSSM_phy) = ssacu(:,:) ! ASSSM
268	m_allaer(:,:,id_CIDUSTM_phy)= cidust(:,:) ! CIDUSTM
269	m_allaer(:,:,id_AIBCM_phy) = bcins(:,:) ! AIBCM
270	m_allaer(:,:,id_ASNO3M_phy) = nitracc(:,:) ! ASNO3M
271	m_allaer(:,:,id_CSNO3M_phy) = nitrcoarse(:,:) ! CSNO3M
272	m_allaer(:,:,id_CINO3M_phy) = nitrinscoarse(:,:)! CINO3M
273	m_allaer(:,:,id_AIPOMM_phy) = pomins(:,:) ! AIPOMM
274	m_allaer(:,:,id_STRAT_phy) = 0.0
275
276	!RAF
277	m_allaer_pi(:,:,id_ASBCM_phy) = bcsol_pi(:,:) ! ASBCM pre-ind
278	m_allaer_pi(:,:,id_ASPOMM_phy) = pomsol_pi(:,:) ! ASPOMM pre-ind
279	m_allaer_pi(:,:,id_ASSO4M_phy) = sulfacc_pi(:,:) ! ASSO4M (= SO4) pre-ind
280	m_allaer_pi(:,:,id_CSSO4M_phy) = sulfcoarse_pi(:,:) ! CSSO4M pre-ind
281	m_allaer_pi(:,:,id_SSSSM_phy) = sssupco_pi(:,:) ! SSSSM pre-ind
282	m_allaer_pi(:,:,id_CSSSM_phy) = sscoarse_pi(:,:) ! CSSSM pre-ind
283	m_allaer_pi(:,:,id_ASSSM_phy) = ssacu_pi(:,:) ! ASSSM pre-ind
284	m_allaer_pi(:,:,id_CIDUSTM_phy)= cidust_pi(:,:) ! CIDUSTM pre-ind
285	m_allaer_pi(:,:,id_AIBCM_phy) = bcins_pi(:,:) ! AIBCM pre-ind
286	m_allaer_pi(:,:,id_ASNO3M_phy) = nitracc_pi(:,:) ! ASNO3M pre-ind
287	m_allaer_pi(:,:,id_CSNO3M_phy) = nitrcoarse_pi(:,:) ! CSNO3M pre-ind
288	m_allaer_pi(:,:,id_CINO3M_phy) = nitrinscoarse_pi(:,:)! CINO3M pre-ind
289	m_allaer_pi(:,:,id_AIPOMM_phy) = pomins_pi(:,:) ! AIPOMM pre-ind
290	m_allaer_pi(:,:,id_STRAT_phy) = 0.0
291
292	!
293	! Calculate the total mass of all soluble aersosols
294	! to be revisited for AR6
295	mass_solu_aero(:,:) = sulfacc(:,:) + bcsol(:,:) + pomsol(:,:) + nitracc(:,:) ! + &
296	! sscoarse(:,:) + ssacu(:,:) + sssupco(:,:)
297	mass_solu_aero_pi(:,:) = sulfacc_pi(:,:) + bcsol_pi(:,:) + pomsol_pi(:,:) + nitracc_pi(:,:) ! + &
298	! sscoarse_pi(:,:) + ssacu_pi(:,:) + sssupco_pi(:,:)
299
300	!****************************************************************************************
301	! 2) Calculate optical properties for the aerosols
302	!
303	!****************************************************************************************
304	DO k = 1, klev
305	DO i = 1, klon
306	pdel(i,k) = paprs(i,k) - paprs (i,k+1)
307	END DO
308	END DO
309
310	! aeropt_6bands for rrtm
311	CALL aeropt_6bands_rrtm( &
312	pdel, m_allaer, pdtphys, rhcl, &
313	tau_aero, piz_aero, cg_aero, &
314	m_allaer_pi, flag_aerosol, &
315	zrho )
316
317	! aeropt_5wv only for validation and diagnostics
318	CALL aeropt_5wv_rrtm( &
319	pdel, m_allaer, &
320	pdtphys, rhcl, aerindex, &
321	flag_aerosol, pplay, t_seri, &
322	tausum_aero, tau3d_aero )
323
324	! Diagnostics calculation for CMIP5 protocol
325	sconcso4(:) =m_allaer(:,1,id_ASSO4M_phy)*1.e-9
326	sconcno3(:) =(m_allaer(:,1,id_ASNO3M_phy)+m_allaer(:,1,id_CSNO3M_phy)+m_allaer(:,1,id_CINO3M_phy))*1.e-9
327	sconcoa(:) =(m_allaer(:,1,id_ASPOMM_phy)+m_allaer(:,1,id_AIPOMM_phy))*1.e-9
328	sconcbc(:) =(m_allaer(:,1,id_ASBCM_phy)+m_allaer(:,1,id_AIBCM_phy))*1.e-9
329	sconcss(:) =(m_allaer(:,1,id_ASSSM_phy)+m_allaer(:,1,id_CSSSM_phy)+m_allaer(:,1,id_SSSSM_phy))*1.e-9
330	sconcdust(:) =m_allaer(:,1,id_CIDUSTM_phy)*1.e-9
331	concso4(:,:) =m_allaer(:,:,id_ASSO4M_phy)*1.e-9
332	concno3(:,:) =(m_allaer(:,:,id_ASNO3M_phy)+m_allaer(:,:,id_CSNO3M_phy)+m_allaer(:,:,id_CINO3M_phy))*1.e-9
333	concoa(:,:) =(m_allaer(:,:,id_ASPOMM_phy)+m_allaer(:,:,id_AIPOMM_phy))*1.e-9
334	concbc(:,:) =(m_allaer(:,:,id_ASBCM_phy)+m_allaer(:,:,id_AIBCM_phy))*1.e-9
335	concss(:,:) =(m_allaer(:,:,id_ASSSM_phy)+m_allaer(:,:,id_CSSSM_phy)+m_allaer(:,:,id_SSSSM_phy))*1.e-9
336	concdust(:,:)=m_allaer(:,:,id_CIDUSTM_phy)*1.e-9
337
338	END SUBROUTINE readaerosol_optic_rrtm

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

Download in other formats:

Original Format