Context Navigation

aeropt_5wv_rrtm.F90 @ 2634

Last change on this file since 2634 was 2634, checked in by oboucher, 8 years ago
Quicker way to compute aerosol optical properties. Does not converge with previous version but results are close.
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: 13.6 KB

Line
1	!
2	! $Id: aeropt_5wv_rrtm.F90 2634 2016-09-24 17:14:59Z oboucher $
3	!
4
5	SUBROUTINE AEROPT_5WV_RRTM(&
6	pdel, m_allaer, delt, &
7	RHcl, ai, flag_aerosol, &
8	pplay, t_seri, &
9	tausum, tau )
10
11	USE DIMPHY
12	USE aero_mod
13	USE phys_local_var_mod, only: od550aer,od865aer,ec550aer,od550lt1aer
14
15	!
16	! Yves Balkanski le 12 avril 2006
17	! Celine Deandreis
18	! Anne Cozic Avril 2009
19	! a partir d'une sous-routine de Johannes Quaas pour les sulfates
20	! Olivier Boucher mars 2014 pour adaptation RRTM
21	!
22	! Refractive indices for seasalt come from Shettle and Fenn (1979)
23	!
24	! Refractive indices from water come from Hale and Querry (1973)
25	!
26	! Refractive indices from Ammonium Sulfate Toon and Pollack (1976)
27	!
28	! Refractive indices for Dust, internal mixture of minerals coated with 1.5% hematite
29	! by Volume (Balkanski et al., 2006)
30	!
31	! Refractive indices for POM: Kinne (pers. Communication
32	!
33	! Refractive index for BC from Shettle and Fenn (1979)
34	!
35	! Shettle, E. P., & Fenn, R. W. (1979), Models for the aerosols of the lower atmosphere and
36	! the effects of humidity variations on their optical properties, U.S. Air Force Geophysics
37	! Laboratory Rept. AFGL-TR-79-0214, Hanscomb Air Force Base, MA.
38	!
39	! Hale, G. M. and M. R. Querry, Optical constants of water in the 200-nm to 200-m
40	! wavelength region, Appl. Opt., 12, 555-563, 1973.
41	!
42	! Toon, O. B. and J. B. Pollack, The optical constants of several atmospheric aerosol species:
43	! Ammonium sulfate, aluminum oxide, and sodium chloride, J. Geohys. Res., 81, 5733-5748,
44	! 1976.
45	!
46	! Balkanski, Y., M. Schulz, T. Claquin And O. Boucher, Reevaluation of mineral aerosol
47	! radiative forcings suggests a better agreement with satellite and AERONET data, Atmospheric
48	! Chemistry and Physics Discussions., 6, pp 8383-8419, 2006.
49	!
50	IMPLICIT NONE
51	INCLUDE "YOMCST.h"
52	!
53	! Input arguments:
54	!
55	REAL, DIMENSION(klon,klev), INTENT(in) :: pdel
56	REAL, INTENT(in) :: delt
57	REAL, DIMENSION(klon,klev,naero_tot), INTENT(in) :: m_allaer
58	REAL, DIMENSION(klon,klev), INTENT(in) :: RHcl ! humidite relative ciel clair
59	INTEGER,INTENT(in) :: flag_aerosol
60	REAL, DIMENSION(klon,klev), INTENT(in) :: pplay
61	REAL, DIMENSION(klon,klev), INTENT(in) :: t_seri
62	!
63	! Output arguments:
64	!
65	REAL, DIMENSION(klon), INTENT(out) :: ai ! POLDER aerosol index
66	REAL, DIMENSION(klon,nwave,naero_tot), INTENT(out) :: tausum
67	REAL, DIMENSION(klon,klev,nwave,naero_tot), INTENT(out) :: tau
68
69	!
70	! Local
71	!
72	INTEGER, PARAMETER :: las = nwave_sw
73	LOGICAL :: soluble
74
75	INTEGER :: i, k, m, aerindex
76	INTEGER :: spsol, spinsol, la
77	INTEGER :: RH_num(klon,klev)
78	INTEGER, PARAMETER :: la443 = 1
79	INTEGER, PARAMETER :: la550 = 2
80	INTEGER, PARAMETER :: la670 = 3
81	INTEGER, PARAMETER :: la765 = 4
82	INTEGER, PARAMETER :: la865 = 5
83	INTEGER, PARAMETER :: nbre_RH=12
84	INTEGER, PARAMETER :: naero_soluble=7 ! 1- BC soluble; 2- POM soluble; 3- SO4 acc.
85	! 4- SO4 coarse; 5 seasalt super-C; 6 seasalt coarse; 7 seasalt acc.
86	INTEGER, PARAMETER :: naero_insoluble=3 ! 1- Dust; 2- BC insoluble; 3- POM insoluble
87
88	REAL :: zrho
89
90	REAL, PARAMETER :: RH_tab(nbre_RH)=(/0.,10.,20.,30.,40.,50.,60.,70.,80.,85.,90.,95./)
91	REAL, PARAMETER :: RH_MAX=95.
92	REAL :: delta(klon,klev), rh(klon,klev)
93	REAL :: tau_ae5wv_int ! Intermediate computation of epaisseur optique aerosol
94	REAL :: od670aer(klon) ! epaisseur optique aerosol extinction 670 nm
95	REAL :: fac
96	INTEGER, ALLOCATABLE, DIMENSION(:) :: aerosol_name
97	INTEGER :: nb_aer, itau
98	LOGICAL :: ok_itau
99
100	REAL :: zdh(klon,klev)
101
102	! Soluble components 1- BC soluble; 2- POM soluble; 3- SO4 acc.; 4- SO4 coarse; 5 seasalt super-coarse; 6 seasalt coarse; 7 seasalt acc.
103	REAL :: alpha_aers_5wv(nbre_RH,las,naero_soluble) ! Ext. coeff. ** m2/g
104	! Insoluble components 1- Dust: 2- BC; 3- POM
105	REAL :: alpha_aeri_5wv(las,naero_insoluble) ! Ext. coeff. ** m2/g
106
107	!
108	! Proprietes optiques
109	!
110	REAL :: fact_RH(nbre_RH)
111	INTEGER :: n
112
113	! From here on we look at the optical parameters at 5 wavelengths:
114	! 443nm, 550, 670, 765 and 865 nm
115	! le 12 AVRIL 2006
116	!
117	DATA alpha_aers_5wv/ &
118	! bc soluble
119	7.930,7.930,7.930,7.930,7.930,7.930, &
120	7.930,7.930,10.893,12.618,14.550,16.613, &
121	7.658,7.658,7.658,7.658,7.658,7.658, &
122	7.658,7.658,10.351,11.879,13.642,15.510, &
123	7.195,7.195,7.195,7.195,7.195,7.195, &
124	7.195,7.195,9.551,10.847,12.381,13.994, &
125	6.736,6.736,6.736,6.736,6.736,6.736, &
126	6.736,6.736,8.818,9.938,11.283,12.687, &
127	6.277,6.277,6.277,6.277,6.277,6.277, &
128	6.277,6.277,8.123,9.094,10.275,11.501, &
129	! pom soluble
130	6.676,6.676,6.676,6.676,6.710,6.934, &
131	7.141,7.569,8.034,8.529,9.456,10.511, &
132	5.109,5.109,5.109,5.109,5.189,5.535, &
133	5.960,6.852,8.008,9.712,12.897,19.676, &
134	3.718,3.718,3.718,3.718,3.779,4.042, &
135	4.364,5.052,5.956,7.314,9.896,15.688, &
136	2.849,2.849,2.849,2.849,2.897,3.107, &
137	3.365,3.916,4.649,5.760,7.900,12.863, &
138	2.229,2.229,2.229,2.229,2.268,2.437, &
139	2.645,3.095,3.692,4.608,6.391,10.633, &
140	! Sulfate (Accumulation)
141	5.751,6.215,6.690,7.024,7.599,8.195, &
142	9.156,10.355,12.660,14.823,18.908,24.508, &
143	4.320,4.675,5.052,5.375,5.787,6.274, &
144	7.066,8.083,10.088,12.003,15.697,21.133, &
145	3.079,3.351,3.639,3.886,4.205,4.584, &
146	5.206,6.019,7.648,9.234,12.391,17.220, &
147	2.336,2.552,2.781,2.979,3.236,3.540, &
148	4.046,4.711,6.056,7.388,10.093,14.313, &
149	1.777,1.949,2.134,2.292,2.503,2.751, &
150	3.166,3.712,4.828,5.949,8.264,11.922, &
151	! Sulfate (Coarse)
152	5.751,6.215,6.690,7.024,7.599,8.195, &
153	9.156,10.355,12.660,14.823,18.908,24.508, &
154	4.320,4.675,5.052,5.375,5.787,6.274, &
155	7.066,8.083,10.088,12.003,15.697,21.133, &
156	3.079,3.351,3.639,3.886,4.205,4.584, &
157	5.206,6.019,7.648,9.234,12.391,17.220, &
158	2.336,2.552,2.781,2.979,3.236,3.540, &
159	4.046,4.711,6.056,7.388,10.093,14.313, &
160	1.777,1.949,2.134,2.292,2.503,2.751, &
161	3.166,3.712,4.828,5.949,8.264,11.922, &
162	! seasalt seasalt Super Coarse Soluble (SS)
163	0.218, 0.272, 0.293, 0.316, 0.343, 0.380, &
164	0.429, 0.501, 0.636, 0.755, 0.967, 1.495, &
165	0.221, 0.275, 0.297, 0.320, 0.348, 0.383, &
166	0.432, 0.509, 0.640, 0.759, 0.972, 1.510, &
167	0.224, 0.279, 0.301, 0.324, 0.352, 0.388, &
168	0.438, 0.514, 0.647, 0.768, 0.985, 1.514, &
169	0.227, 0.282, 0.303, 0.327, 0.356, 0.392, &
170	0.441, 0.518, 0.652, 0.770, 0.987, 1.529, &
171	0.230, 0.285, 0.306, 0.330, 0.359, 0.396, &
172	0.446, 0.522, 0.656, 0.777, 0.993, 1.539, &
173	! seasalt seasalt Coarse Soluble (CS)
174	0.578, 0.706, 0.756, 0.809, 0.876, 0.964, &
175	1.081, 1.256, 1.577, 1.858, 2.366, 3.613, &
176	0.598, 0.725, 0.779, 0.833, 0.898, 0.990, &
177	1.109, 1.290, 1.609, 1.889, 2.398, 3.682, &
178	0.619, 0.750, 0.802, 0.857, 0.927, 1.022, &
179	1.141, 1.328, 1.648, 1.939, 2.455, 3.729, &
180	0.633, 0.767, 0.820, 0.879, 0.948, 1.044, &
181	1.167, 1.353, 1.683, 1.969, 2.491, 3.785, &
182	0.648, 0.785, 0.838, 0.896, 0.967, 1.066, &
183	1.192, 1.381, 1.714, 2.006, 2.531, 3.836, &
184	! seasalt seasalt Accumulation Soluble (AS)
185	4.432, 5.899, 6.505, 7.166, 7.964, 7.962, &
186	9.232,11.257,14.979,18.337,24.223,37.811, &
187	3.298, 4.569, 5.110, 5.709, 6.446, 6.268, &
188	7.396, 9.246,12.787,16.113,22.197,37.136, &
189	2.340, 3.358, 3.803, 4.303, 4.928, 4.696, &
190	5.629, 7.198,10.308,13.342,19.120,34.296, &
191	1.789, 2.626, 2.999, 3.422, 3.955, 3.730, &
192	4.519, 5.864, 8.593,11.319,16.653,31.331, &
193	1.359, 2.037, 2.343, 2.693, 3.139, 2.940, &
194	3.596, 4.729, 7.076, 9.469,14.266,28.043 /
195
196	DATA alpha_aeri_5wv/ &
197	! dust insoluble
198	0.759, 0.770, 0.775, 0.775, 0.772, &
199	!!jb bc insoluble
200	11.536,10.033, 8.422, 7.234, 6.270, &
201	! pom insoluble
202	5.042, 3.101, 1.890, 1.294, 0.934/
203	!
204	! Initialisations
205	ai(:) = 0.
206	tausum(:,:,:) = 0.
207	tau(:,:,:,:)=0.
208
209	DO k=1, klev
210	DO i=1, klon
211	zrho=pplay(i,k)/t_seri(i,k)/RD ! kg/m3
212	zdh(i,k)=pdel(i,k)/(RG*zrho) ! m
213	ENDDO
214	ENDDO
215
216	IF (flag_aerosol .EQ. 1) THEN
217	nb_aer = 2
218	ALLOCATE (aerosol_name(nb_aer))
219	aerosol_name(1) = id_ASSO4M_phy
220	aerosol_name(2) = id_CSSO4M_phy
221	ELSEIF (flag_aerosol .EQ. 2) THEN
222	nb_aer = 2
223	ALLOCATE (aerosol_name(nb_aer))
224	aerosol_name(1) = id_ASBCM_phy
225	aerosol_name(2) = id_AIBCM_phy
226	ELSEIF (flag_aerosol .EQ. 3) THEN
227	nb_aer = 2
228	ALLOCATE (aerosol_name(nb_aer))
229	aerosol_name(1) = id_ASPOMM_phy
230	aerosol_name(2) = id_AIPOMM_phy
231	ELSEIF (flag_aerosol .EQ. 4) THEN
232	nb_aer = 3
233	ALLOCATE (aerosol_name(nb_aer))
234	aerosol_name(1) = id_CSSSM_phy
235	aerosol_name(2) = id_SSSSM_phy
236	aerosol_name(3) = id_ASSSM_phy
237	ELSEIF (flag_aerosol .EQ. 5) THEN
238	nb_aer = 1
239	ALLOCATE (aerosol_name(nb_aer))
240	aerosol_name(1) = id_CIDUSTM_phy
241	ELSEIF (flag_aerosol .EQ. 6) THEN
242	nb_aer = 10
243	ALLOCATE (aerosol_name(nb_aer))
244	aerosol_name(1) = id_ASSO4M_phy
245	aerosol_name(2) = id_ASBCM_phy
246	aerosol_name(3) = id_AIBCM_phy
247	aerosol_name(4) = id_ASPOMM_phy
248	aerosol_name(5) = id_AIPOMM_phy
249	aerosol_name(6) = id_CSSSM_phy
250	aerosol_name(7) = id_SSSSM_phy
251	aerosol_name(8) = id_ASSSM_phy
252	aerosol_name(9) = id_CIDUSTM_phy
253	aerosol_name(10) = id_CSSO4M_phy
254	ENDIF
255
256	!
257	! Loop over modes, use of precalculated nmd and corresponding sigma
258	! loop over wavelengths
259	! for each mass species in mode
260	! interpolate from Sext to retrieve Sext_at_gridpoint_per_species
261	! compute optical_thickness_at_gridpoint_per_species
262	!
263	! Calculations that need to be done since we are not in the subroutines INCA
264	!
265
266	DO n=1,nbre_RH-1
267	fact_RH(n)=1./(RH_tab(n+1)-RH_tab(n))
268	ENDDO
269
270	DO k=1, klev
271	DO i=1, klon
272	rh(i,k)=MIN(RHcl(i,k)*100.,RH_MAX)
273	RH_num(i,k) = INT( rh(i,k)/10. + 1.)
274	IF (rh(i,k).GT.85.) RH_num(i,k)=10
275	IF (rh(i,k).GT.90.) RH_num(i,k)=11
276	delta(i,k)=(rh(i,k)-RH_tab(RH_num(i,k)))*fact_RH(RH_num(i,k))
277	ENDDO
278	ENDDO
279
280	DO m=1,nb_aer ! tau is only computed for each mass
281	fac=1.0
282	IF (aerosol_name(m).EQ.id_ASBCM_phy) THEN
283	soluble=.TRUE.
284	spsol=1
285	ELSEIF (aerosol_name(m).EQ.id_ASPOMM_phy) THEN
286	soluble=.TRUE.
287	spsol=2
288	ELSEIF (aerosol_name(m).EQ.id_ASSO4M_phy) THEN
289	soluble=.TRUE.
290	spsol=3
291	fac=1.375 ! (NH4)2-SO4/SO4 132/96 mass conversion factor for OD
292	ELSEIF (aerosol_name(m).EQ.id_CSSO4M_phy) THEN
293	soluble=.TRUE.
294	spsol=4
295	fac=1.375 ! (NH4)2-SO4/SO4 132/96 mass conversion factor for OD
296	ELSEIF (aerosol_name(m).EQ.id_SSSSM_phy) THEN
297	soluble=.TRUE.
298	spsol=5
299	ELSEIF (aerosol_name(m).EQ.id_CSSSM_phy) THEN
300	soluble=.TRUE.
301	spsol=6
302	ELSEIF (aerosol_name(m).EQ.id_ASSSM_phy) THEN
303	soluble=.TRUE.
304	spsol=7
305	ELSEIF (aerosol_name(m).EQ.id_CIDUSTM_phy) THEN
306	soluble=.FALSE.
307	spinsol=1
308	ELSEIF (aerosol_name(m).EQ.id_AIBCM_phy) THEN
309	soluble=.FALSE.
310	spinsol=2
311	ELSEIF (aerosol_name(m).EQ.id_AIPOMM_phy) THEN
312	soluble=.FALSE.
313	spinsol=3
314	ELSE
315	CYCLE
316	ENDIF
317
318	aerindex=aerosol_name(m)
319
320	DO la=1,las
321
322	!--only 550, 670 and 865 nm are used
323	IF (la.NE.la550.AND.la.NE.la670.AND.la.NE.la865) CYCLE
324
325	IF (soluble) THEN ! For soluble aerosol
326
327	DO k=1, klev
328	DO i=1, klon
329	tau_ae5wv_int = alpha_aers_5wv(RH_num(i,k),la,spsol)+DELTA(i,k)* &
330	(alpha_aers_5wv(RH_num(i,k)+1,la,spsol) - &
331	alpha_aers_5wv(RH_num(i,k),la,spsol))
332	tau(i,k,la,aerindex) = m_allaer(i,k,aerindex)/1.e6zdh(i,k)tau_ae5wv_int*fac
333	tausum(i,la,aerindex)=tausum(i,la,aerindex)+tau(i,k,la,aerindex)
334	ENDDO
335	ENDDO
336
337	ELSE ! For insoluble aerosol
338
339	DO k=1, klev
340	DO i=1, klon
341	tau_ae5wv_int = alpha_aeri_5wv(la,spinsol)
342	tau(i,k,la,aerindex) = m_allaer(i,k,aerindex)/1.e6zdh(i,k)tau_ae5wv_int*fac
343	tausum(i,la,aerindex)= tausum(i,la,aerindex)+tau(i,k,la,aerindex)
344	ENDDO
345	ENDDO
346
347	ENDIF
348
349	ENDDO ! Boucle sur les longueurs d'onde
350	ENDDO ! Boucle sur les masses de traceurs
351
352	!--AOD calculations for diagnostics
353	od550aer(:)=SUM(tausum(:,la550,:),dim=2)
354	od670aer(:)=SUM(tausum(:,la670,:),dim=2)
355	od865aer(:)=SUM(tausum(:,la865,:),dim=2)
356
357	!--extinction coefficient for diagnostic
358	ec550aer(:,:)=SUM(tau(:,:,la550,:),dim=3)/zdh(:,:)
359
360	!--aerosol index
361	ai(:)=-LOG(MAX(od670aer(:),1.e-8)/MAX(od865aer(:),1.e-8))/LOG(670./865.)
362
363	od550lt1aer(:)=tausum(:,la550,id_ASSO4M_phy)+tausum(:,la550,id_ASBCM_phy) +tausum(:,la550,id_AIBCM_phy)+ &
364	tausum(:,la550,id_ASPOMM_phy)+tausum(:,la550,id_AIPOMM_phy)+tausum(:,la550,id_ASSSM_phy)+ &
365	0.03tausum(:,la550,id_CSSSM_phy)+0.4tausum(:,la550,id_CIDUSTM_phy)
366
367	DEALLOCATE(aerosol_name)
368
369	END SUBROUTINE AEROPT_5WV_RRTM

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

Download in other formats:

Original Format