Context Navigation

aeropt_6bands_rrtm.F90 @ 5440

Last change on this file since 5440 was 2005, checked in by Laurent Fairhead, 11 years ago

Oublié de mettre les propriétés

Forgot to set properties

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: 27.3 KB

Line
1	!
2	! $Id: aeropt_6bands_rrtm.F90 2005 2014-04-04 12:59:37Z evignon $
3	!
4	SUBROUTINE AEROPT_6BANDS_RRTM ( &
5	pdel, m_allaer, delt, RHcl, &
6	tau_allaer, piz_allaer, &
7	cg_allaer, m_allaer_pi, &
8	flag_aerosol, pplay, t_seri )
9
10	USE dimphy
11	USE aero_mod
12	USE phys_local_var_mod, only: absvisaer
13
14	! Yves Balkanski le 12 avril 2006
15	! Celine Deandreis
16	! Anne Cozic Avril 2009
17	! a partir d'une sous-routine de Johannes Quaas pour les sulfates
18	! Olivier Boucher février 2014 pour passage à RRTM
19	! a partir des propriétés optiques fournies par Yves Balkanski
20	!
21	IMPLICIT NONE
22
23	INCLUDE "YOMCST.h"
24	INCLUDE "iniprint.h"
25	INCLUDE "clesphys.h"
26
27	!
28	! Input arguments:
29	!
30	REAL, DIMENSION(klon,klev), INTENT(in) :: pdel
31	REAL, INTENT(in) :: delt
32	REAL, DIMENSION(klon,klev,naero_spc), INTENT(in) :: m_allaer
33	REAL, DIMENSION(klon,klev,naero_spc), INTENT(in) :: m_allaer_pi
34	REAL, DIMENSION(klon,klev), INTENT(in) :: RHcl ! humidite relative ciel clair
35	INTEGER, INTENT(in) :: flag_aerosol
36	REAL, DIMENSION(klon,klev), INTENT(in) :: pplay
37	REAL, DIMENSION(klon,klev), INTENT(in) :: t_seri
38	!
39	! Output arguments:
40	! 1= total aerosols
41	! 2= natural aerosols
42	!
43	REAL, DIMENSION(klon,klev,2,nbands_rrtm), INTENT(out) :: tau_allaer ! epaisseur optique aerosol
44	REAL, DIMENSION(klon,klev,2,nbands_rrtm), INTENT(out) :: piz_allaer ! single scattering albedo aerosol
45	REAL, DIMENSION(klon,klev,2,nbands_rrtm), INTENT(out) :: cg_allaer ! asymmetry parameter aerosol
46
47	!
48	! Local
49	!
50	LOGICAL :: soluble
51	INTEGER :: i, k,n, inu, m
52	INTEGER :: spsol, spinsol
53	INTEGER :: RH_num(klon,klev)
54
55	INTEGER, PARAMETER :: nb_level=19 ! number of vertical levels in DATA
56
57	INTEGER, PARAMETER :: naero_soluble=7 ! 1- BC soluble; 2- POM soluble; 3- SO4. acc. 4- SO4 coarse
58	! 5- seasalt super coarse 6- seasalt coarse 7- seasalt acc.
59	INTEGER, PARAMETER :: naero_insoluble=3 ! 1- Dust; 2- BC insoluble; 3- POM insoluble
60
61	INTEGER, PARAMETER :: nbre_RH=12
62	REAL,PARAMETER :: RH_tab(nbre_RH)=(/0.,10.,20.,30.,40.,50.,60.,70.,80.,85.,90.,95./)
63	REAL, PARAMETER :: RH_MAX=95.
64	REAL :: delta(klon,klev), rh(klon,klev)
65	REAL :: tau_ae2b_int ! Intermediate computation of epaisseur optique aerosol
66	REAL :: piz_ae2b_int ! Intermediate computation of Single scattering albedo
67	REAL :: cg_ae2b_int ! Intermediate computation of Assymetry parameter
68	REAL :: Fact_RH(nbre_RH)
69	REAL :: zrho
70	REAL :: fac
71	REAL :: zdp1(klon,klev)
72	INTEGER, ALLOCATABLE, DIMENSION(:) :: aerosol_name
73	INTEGER :: nb_aer
74
75	REAL, DIMENSION(klon,klev,naero_spc) :: mass_temp
76	REAL, DIMENSION(klon,klev,naero_spc) :: mass_temp_pi
77	REAL, DIMENSION(klon,klev,naero_tot,nbands_rrtm) :: tau_ae
78	REAL, DIMENSION(klon,klev,naero_tot,nbands_rrtm) :: tau_ae_pi
79	REAL, DIMENSION(klon,klev,naero_tot,nbands_rrtm) :: piz_ae
80	REAL, DIMENSION(klon,klev,naero_tot,nbands_rrtm) :: cg_ae
81
82
83	!
84	! Proprietes optiques
85	!
86	REAL:: alpha_aers_6bands(nbre_RH,nbands_rrtm,naero_soluble) !--unit m2/g SO4
87	REAL:: alpha_aeri_6bands(nbands_rrtm,naero_insoluble)
88	REAL:: cg_aers_6bands(nbre_RH,nbands_rrtm,naero_soluble) !--unit
89	REAL:: cg_aeri_6bands(nbands_rrtm,naero_insoluble)
90	REAL:: piz_aers_6bands(nbre_RH,nbands_rrtm,naero_soluble) !-- unit
91	REAL:: piz_aeri_6bands(nbands_rrtm,naero_insoluble) !-- unit
92
93	INTEGER :: id
94	LOGICAL :: used_aer(naero_tot)
95	REAL :: tmp_var, tmp_var_pi
96
97	!***************************************************************************
98	!--the order of the soluble species has to follow the spsol index below
99	!--the order of the insoluble species has to follow the spinsol index below
100
101	DATA alpha_aers_6bands/ &
102	! bc soluble AS
103	6.497, 6.497, 6.497, 6.497, 6.497, 7.160, 7.875, 9.356,10.811,10.974,11.149,12.734, &
104	6.497, 6.497, 6.497, 6.497, 6.497, 7.160, 7.875, 9.356,10.811,10.974,11.149,12.734, &
105	5.900, 5.900, 5.900, 5.900, 5.900, 6.502, 7.151, 8.496, 9.818, 9.965,10.124,11.564, &
106	4.284, 4.284, 4.284, 4.284, 4.284, 4.721, 5.193, 6.169, 7.129, 7.236, 7.352, 8.397, &
107	2.163, 2.163, 2.163, 2.163, 2.163, 2.384, 2.622, 3.115, 3.600, 3.654, 3.712, 4.240, &
108	0.966, 0.966, 0.966, 0.966, 0.966, 1.065, 1.171, 1.392, 1.608, 1.632, 1.658, 1.894, &
109	! pom soluble AS
110	6.443, 6.443, 6.443, 6.443, 6.443, 7.100, 7.809, 9.277,10.721,10.882,11.056,12.628, &
111	6.443, 6.443, 6.443, 6.443, 6.443, 7.100, 7.809, 9.277,10.721,10.882,11.056,12.628, &
112	4.381, 4.381, 4.381, 4.381, 4.381, 4.828, 5.310, 6.309, 7.290, 7.400, 7.518, 8.587, &
113	1.846, 1.846, 1.846, 1.846, 1.846, 2.034, 2.237, 2.658, 3.072, 3.118, 3.168, 3.618, &
114	0.377, 0.377, 0.377, 0.377, 0.377, 0.415, 0.456, 0.542, 0.627, 0.636, 0.646, 0.738, &
115	0.052, 0.052, 0.052, 0.052, 0.052, 0.057, 0.063, 0.075, 0.087, 0.088, 0.089, 0.102, &
116	! sulfate AS
117	6.554, 6.554, 6.554, 7.223, 7.931, 8.665, 9.438,10.736,14.275,17.755,17.755,31.722, &
118	6.554, 6.554, 6.554, 7.223, 7.931, 8.665, 9.438,10.736,14.275,17.755,17.755,31.722, &
119	4.381, 4.381, 4.381, 4.828, 5.301, 5.792, 6.309, 7.176, 9.542,11.868,11.868,21.204, &
120	1.727, 1.727, 1.727, 1.903, 2.090, 2.283, 2.487, 2.829, 3.762, 4.679, 4.679, 8.359, &
121	0.312, 0.312, 0.312, 0.344, 0.378, 0.413, 0.450, 0.511, 0.680, 0.846, 0.846, 1.511, &
122	0.121, 0.121, 0.121, 0.134, 0.147, 0.161, 0.175, 0.199, 0.264, 0.329, 0.329, 0.588, &
123	! sulfate coarse CS
124	0.693, 0.693, 0.693, 0.764, 0.839, 0.917, 0.999, 1.136, 1.510, 1.879, 1.879, 3.356, &
125	0.693, 0.693, 0.693, 0.764, 0.839, 0.917, 0.999, 1.136, 1.510, 1.879, 1.879, 3.356, &
126	0.715, 0.715, 0.715, 0.788, 0.865, 0.945, 1.029, 1.171, 1.557, 1.936, 1.936, 3.459, &
127	0.736, 0.736, 0.736, 0.811, 0.891, 0.973, 1.060, 1.206, 1.603, 1.994, 1.994, 3.563, &
128	0.711, 0.711, 0.711, 0.783, 0.860, 0.939, 1.023, 1.164, 1.548, 1.925, 1.925, 3.439, &
129	0.602, 0.602, 0.602, 0.664, 0.729, 0.796, 0.867, 0.986, 1.312, 1.631, 1.631, 2.915, &
130	! seasalt seasalt Super Coarse Soluble (SS)
131	0.214, 0.235, 0.257, 0.305, 0.385, 0.444, 0.537, 0.606, 0.876, 1.006, 1.243, 2.313, &
132	0.217, 0.238, 0.261, 0.309, 0.389, 0.448, 0.543, 0.612, 0.882, 1.015, 1.255, 2.327, &
133	0.221, 0.243, 0.266, 0.315, 0.396, 0.456, 0.552, 0.621, 0.895, 1.028, 1.269, 2.351, &
134	0.230, 0.253, 0.276, 0.326, 0.408, 0.469, 0.568, 0.638, 0.918, 1.053, 1.298, 2.389, &
135	0.250, 0.273, 0.298, 0.349, 0.435, 0.501, 0.601, 0.674, 0.960, 1.098, 1.349, 2.466, &
136	0.279, 0.307, 0.336, 0.396, 0.493, 0.566, 0.679, 0.760, 1.072, 1.221, 1.486, 2.652, &
137	! seasalt seasalt Coarse Soluble (CS)
138	0.550, 0.605, 0.661, 0.782, 0.980, 1.131, 1.362, 1.536, 2.204, 2.528, 3.115, 5.773, &
139	0.568, 0.622, 0.681, 0.802, 1.004, 1.155, 1.393, 1.568, 2.246, 2.574, 3.174, 5.846, &
140	0.599, 0.655, 0.714, 0.838, 1.044, 1.202, 1.446, 1.621, 2.312, 2.645, 3.249, 5.950, &
141	0.647, 0.708, 0.771, 0.904, 1.121, 1.290, 1.546, 1.731, 2.447, 2.791, 3.416, 6.166, &
142	0.663, 0.735, 0.809, 0.964, 1.215, 1.386, 1.677, 1.883, 2.681, 3.059, 3.733, 6.647, &
143	0.479, 0.549, 0.623, 0.787, 1.065, 1.174, 1.491, 1.717, 2.648, 3.094, 3.901, 7.382, &
144	! seasalt seasalt Accumulation Soluble (AS)
145	6.128, 6.867, 7.624, 9.184,11.602,13.194,15.955,17.858,24.856,28.034,33.562,56.971, &
146	5.080, 5.837, 6.636, 8.347,11.144,12.321,15.463,17.649,26.080,29.896,36.491,62.414, &
147	3.290, 3.899, 4.567, 6.075, 8.744, 9.355,12.369,14.532,23.747,28.159,36.101,68.531, &
148	1.389, 1.706, 2.070, 2.942, 4.643, 4.846, 6.836, 8.334,15.546,19.346,26.738,62.978, &
149	0.309, 0.394, 0.495, 0.754, 1.312, 1.377, 2.087, 2.654, 5.732, 7.538,11.368,35.212, &
150	0.021, 0.028, 0.036, 0.059, 0.114, 0.126, 0.208, 0.279, 0.718, 1.009, 1.691, 7.271 /
151
152	DATA alpha_aeri_6bands/ &
153	! dust insoluble CI
154	0.751, 0.751, 0.769, 0.772, 0.672, 0.437, &
155	! bc insoluble AI
156	6.497, 6.497, 5.900, 4.284, 2.163, 0.966, &
157	! pom insoluble AI
158	6.443, 6.443, 4.381, 1.846, 0.377, 0.052 /
159
160	DATA cg_aers_6bands/ &
161	! bc soluble AS
162	0.721, 0.721, 0.721, 0.729, 0.735, 0.741, 0.746, 0.754, 0.762, 0.766, 0.769, 0.775, &
163	0.721, 0.721, 0.721, 0.729, 0.735, 0.741, 0.746, 0.754, 0.762, 0.766, 0.769, 0.775, &
164	0.643, 0.643, 0.643, 0.654, 0.662, 0.670, 0.677, 0.688, 0.698, 0.704, 0.707, 0.715, &
165	0.513, 0.513, 0.513, 0.522, 0.530, 0.536, 0.542, 0.552, 0.560, 0.565, 0.568, 0.575, &
166	0.321, 0.321, 0.321, 0.323, 0.325, 0.327, 0.328, 0.331, 0.333, 0.334, 0.335, 0.337, &
167	0.153, 0.153, 0.153, 0.149, 0.145, 0.142, 0.139, 0.135, 0.130, 0.128, 0.127, 0.123, &
168	! pom soluble AS
169	0.687, 0.687, 0.687, 0.687, 0.687, 0.700, 0.710, 0.726, 0.736, 0.737, 0.738, 0.745, &
170	0.687, 0.687, 0.687, 0.687, 0.687, 0.700, 0.710, 0.726, 0.736, 0.737, 0.738, 0.745, &
171	0.658, 0.658, 0.658, 0.658, 0.658, 0.667, 0.674, 0.685, 0.692, 0.692, 0.693, 0.698, &
172	0.564, 0.564, 0.564, 0.564, 0.564, 0.566, 0.568, 0.571, 0.573, 0.573, 0.573, 0.574, &
173	0.363, 0.363, 0.363, 0.363, 0.363, 0.360, 0.357, 0.352, 0.350, 0.349, 0.349, 0.347, &
174	0.142, 0.142, 0.142, 0.142, 0.142, 0.139, 0.137, 0.133, 0.131, 0.131, 0.130, 0.129, &
175	! sulfate AS
176	0.675, 0.675, 0.675, 0.689, 0.701, 0.711, 0.720, 0.735, 0.748, 0.756, 0.760, 0.771, &
177	0.675, 0.675, 0.675, 0.689, 0.701, 0.711, 0.720, 0.735, 0.748, 0.756, 0.760, 0.771, &
178	0.653, 0.653, 0.653, 0.662, 0.670, 0.676, 0.683, 0.692, 0.701, 0.706, 0.709, 0.716, &
179	0.563, 0.563, 0.563, 0.565, 0.567, 0.569, 0.570, 0.573, 0.575, 0.576, 0.577, 0.579, &
180	0.362, 0.362, 0.362, 0.359, 0.356, 0.354, 0.352, 0.348, 0.345, 0.343, 0.342, 0.340, &
181	0.137, 0.137, 0.137, 0.135, 0.133, 0.132, 0.130, 0.128, 0.126, 0.125, 0.124, 0.122, &
182	! sulfate coarse CS
183	0.803, 0.803, 0.803, 0.792, 0.783, 0.776, 0.769, 0.758, 0.747, 0.742, 0.738, 0.730, &
184	0.803, 0.803, 0.803, 0.792, 0.783, 0.776, 0.769, 0.758, 0.747, 0.742, 0.738, 0.730, &
185	0.799, 0.799, 0.799, 0.787, 0.777, 0.768, 0.760, 0.747, 0.736, 0.729, 0.725, 0.716, &
186	0.797, 0.797, 0.797, 0.782, 0.770, 0.760, 0.750, 0.735, 0.722, 0.714, 0.709, 0.698, &
187	0.810, 0.810, 0.810, 0.794, 0.781, 0.770, 0.759, 0.743, 0.728, 0.719, 0.714, 0.702, &
188	0.803, 0.803, 0.803, 0.790, 0.779, 0.770, 0.762, 0.748, 0.736, 0.729, 0.725, 0.715, &
189	! seasalt seasalt Super Coarse Soluble (SS)
190	0.797, 0.799, 0.800, 0.803, 0.805, 0.823, 0.827, 0.830, 0.836, 0.838, 0.840, 0.845, &
191	0.788, 0.790, 0.792, 0.795, 0.798, 0.817, 0.821, 0.824, 0.830, 0.832, 0.835, 0.841, &
192	0.773, 0.776, 0.777, 0.782, 0.786, 0.805, 0.811, 0.814, 0.821, 0.824, 0.829, 0.835, &
193	0.746, 0.748, 0.752, 0.757, 0.764, 0.786, 0.792, 0.797, 0.806, 0.810, 0.815, 0.826, &
194	0.706, 0.710, 0.713, 0.718, 0.726, 0.752, 0.760, 0.766, 0.778, 0.783, 0.790, 0.806, &
195	0.681, 0.681, 0.681, 0.683, 0.685, 0.723, 0.728, 0.733, 0.740, 0.744, 0.751, 0.767, &
196	! seasalt seasalt Coarse Soluble (CS)
197	0.756, 0.759, 0.761, 0.766, 0.772, 0.792, 0.799, 0.802, 0.813, 0.816, 0.820, 0.828, &
198	0.736, 0.740, 0.742, 0.749, 0.756, 0.778, 0.785, 0.789, 0.800, 0.804, 0.810, 0.821, &
199	0.712, 0.714, 0.717, 0.724, 0.732, 0.757, 0.765, 0.770, 0.783, 0.788, 0.794, 0.809, &
200	0.690, 0.691, 0.693, 0.697, 0.703, 0.734, 0.742, 0.746, 0.758, 0.763, 0.769, 0.788, &
201	0.682, 0.682, 0.682, 0.683, 0.684, 0.725, 0.729, 0.733, 0.739, 0.742, 0.746, 0.759, &
202	0.669, 0.671, 0.672, 0.675, 0.678, 0.721, 0.727, 0.732, 0.737, 0.740, 0.743, 0.745, &
203	! seasalt seasalt Accumulation Soluble (AS)
204	0.694, 0.694, 0.693, 0.690, 0.685, 0.733, 0.733, 0.735, 0.729, 0.728, 0.727, 0.732, &
205	0.685, 0.688, 0.690, 0.692, 0.693, 0.738, 0.742, 0.746, 0.745, 0.744, 0.742, 0.731, &
206	0.650, 0.656, 0.662, 0.672, 0.681, 0.722, 0.733, 0.740, 0.750, 0.753, 0.755, 0.748, &
207	0.561, 0.573, 0.584, 0.603, 0.626, 0.661, 0.681, 0.693, 0.721, 0.730, 0.741, 0.758, &
208	0.392, 0.408, 0.424, 0.453, 0.490, 0.517, 0.548, 0.567, 0.619, 0.637, 0.662, 0.716, &
209	0.144, 0.155, 0.167, 0.190, 0.223, 0.237, 0.268, 0.287, 0.353, 0.379, 0.418, 0.530 /
210
211	DATA cg_aeri_6bands/ &
212	! dust insoluble CI
213	0.718, 0.718, 0.699, 0.661, 0.676, 0.670, &
214	! bc insoluble AI
215	0.721, 0.721, 0.643, 0.513, 0.321, 0.153, &
216	! pom insoluble AI
217	0.687, 0.687, 0.658, 0.564, 0.363, 0.142 /
218
219	DATA piz_aers_6bands/&
220	! bc soluble AS
221	0.460, 0.460, 0.460, 0.460, 0.460, 0.534, 0.594, 0.688, 0.748, 0.754, 0.760, 0.803, &
222	0.460, 0.460, 0.460, 0.460, 0.460, 0.534, 0.594, 0.688, 0.748, 0.754, 0.760, 0.803, &
223	0.445, 0.445, 0.445, 0.445, 0.445, 0.521, 0.583, 0.679, 0.741, 0.747, 0.753, 0.798, &
224	0.394, 0.394, 0.394, 0.394, 0.394, 0.477, 0.545, 0.649, 0.718, 0.724, 0.730, 0.779, &
225	0.267, 0.267, 0.267, 0.267, 0.267, 0.365, 0.446, 0.571, 0.652, 0.660, 0.667, 0.725, &
226	0.121, 0.121, 0.121, 0.121, 0.121, 0.139, 0.155, 0.178, 0.193, 0.195, 0.196, 0.207, &
227	! pom soluble AS
228	0.973, 0.973, 0.973, 0.973, 0.973, 0.977, 0.980, 0.984, 0.987, 0.988, 0.988, 0.990, &
229	0.973, 0.973, 0.973, 0.973, 0.973, 0.977, 0.980, 0.984, 0.987, 0.988, 0.988, 0.990, &
230	0.972, 0.972, 0.972, 0.972, 0.972, 0.976, 0.979, 0.984, 0.987, 0.987, 0.988, 0.990, &
231	0.940, 0.940, 0.940, 0.940, 0.940, 0.948, 0.955, 0.965, 0.972, 0.973, 0.973, 0.978, &
232	0.816, 0.816, 0.816, 0.816, 0.816, 0.839, 0.859, 0.888, 0.908, 0.910, 0.911, 0.925, &
233	0.663, 0.663, 0.663, 0.663, 0.663, 0.607, 0.562, 0.492, 0.446, 0.441, 0.437, 0.404, &
234	! sulfate AS
235	1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, &
236	1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, &
237	1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, &
238	1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, &
239	0.988, 0.988, 0.988, 0.989, 0.990, 0.990, 0.991, 0.992, 0.993, 0.993, 0.994, 0.994, &
240	0.256, 0.256, 0.256, 0.263, 0.268, 0.273, 0.277, 0.284, 0.290, 0.294, 0.296, 0.301, &
241	! sulfate coarse CS
242	1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, &
243	1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, &
244	1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, &
245	1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, &
246	0.996, 0.996, 0.996, 0.996, 0.996, 0.996, 0.996, 0.996, 0.996, 0.996, 0.996, 0.996, &
247	0.877, 0.877, 0.877, 0.873, 0.870, 0.867, 0.864, 0.860, 0.856, 0.854, 0.852, 0.849, &
248	! seasalt seasalt Super Coarse Soluble (SS)
249	0.983, 0.982, 0.982, 0.982, 0.981, 0.992, 0.993, 0.994, 0.995, 0.996, 0.997, 0.998, &
250	0.984, 0.983, 0.983, 0.983, 0.982, 0.992, 0.993, 0.995, 0.996, 0.996, 0.997, 0.998, &
251	0.986, 0.985, 0.985, 0.985, 0.984, 0.993, 0.994, 0.995, 0.996, 0.997, 0.997, 0.998, &
252	0.989, 0.989, 0.988, 0.988, 0.987, 0.995, 0.995, 0.996, 0.997, 0.997, 0.998, 0.999, &
253	0.994, 0.993, 0.993, 0.992, 0.992, 0.997, 0.997, 0.997, 0.998, 0.998, 0.998, 0.999, &
254	0.997, 0.997, 0.997, 0.997, 0.996, 0.999, 0.999, 0.999, 0.999, 0.999, 0.999, 0.999, &
255	! seasalt seasalt Coarse Soluble (CS)
256	0.988, 0.988, 0.988, 0.987, 0.986, 0.994, 0.995, 0.996, 0.996, 0.997, 0.998, 0.998, &
257	0.990, 0.990, 0.990, 0.989, 0.988, 0.995, 0.996, 0.996, 0.997, 0.997, 0.998, 0.999, &
258	0.993, 0.993, 0.992, 0.992, 0.991, 0.996, 0.997, 0.997, 0.998, 0.998, 0.998, 0.999, &
259	0.996, 0.995, 0.995, 0.994, 0.994, 0.998, 0.998, 0.998, 0.998, 0.999, 0.999, 0.999, &
260	0.998, 0.997, 0.997, 0.997, 0.997, 0.999, 0.999, 0.999, 0.999, 0.999, 0.999, 0.999, &
261	0.999, 0.999, 0.998, 0.998, 0.998, 0.999, 0.999, 1.000, 1.000, 1.000, 1.000, 1.000, &
262	! seasalt seasalt Accumulation Soluble (AS)
263	0.999, 0.999, 0.998, 0.998, 0.998, 0.999, 0.999, 0.999, 0.999, 1.000, 1.000, 1.000, &
264	0.999, 0.999, 0.999, 0.999, 0.999, 0.999, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, &
265	0.999, 0.999, 0.999, 0.999, 0.999, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, &
266	0.999, 0.999, 0.999, 0.999, 0.999, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, &
267	0.997, 0.997, 0.998, 0.998, 0.998, 0.999, 0.999, 1.000, 1.000, 1.000, 1.000, 1.000, &
268	0.985, 0.987, 0.988, 0.991, 0.993, 0.997, 0.998, 0.998, 0.999, 0.999, 1.000, 1.000 /
269
270	DATA piz_aeri_6bands/ &
271	! dust insoluble CI
272	0.954, 0.954, 0.965, 0.981, 0.996, 0.990, &
273	! bc insoluble AI
274	0.460, 0.460, 0.445, 0.394, 0.267, 0.121, &
275	! pom insoluble AI
276	0.973, 0.973, 0.972, 0.940, 0.816, 0.663 /
277
278	!----BEGINNING OF CALCULATIONS
279
280	spsol = 0
281	spinsol = 0
282	if(NSW.NE.nbands_rrtm) then
283	print *,'Erreur NSW doit etre egal a 6 pour cette routine'
284	stop
285	endif
286
287	DO k=1, klev
288	DO i=1, klon
289	zrho=pplay(i,k)/t_seri(i,k)/RD ! kg/m3
290	!CDIR UNROLL=naero_spc
291	mass_temp(i,k,:) = m_allaer(i,k,:) / zrho / 1.e+9
292	!CDIR UNROLL=naero_spc
293	mass_temp_pi(i,k,:) = m_allaer_pi(i,k,:) / zrho / 1.e+9
294	zdp1(i,k)=pdel(i,k)/(RGdelt) ! air mass auxiliary variable --> zdp1 [kg/(m^2 s)]
295	ENDDO
296	ENDDO
297
298	IF (flag_aerosol .EQ. 1) THEN
299	nb_aer = 2
300	ALLOCATE (aerosol_name(nb_aer))
301	aerosol_name(1) = id_ASSO4M
302	aerosol_name(2) = id_CSSO4M
303	ELSEIF (flag_aerosol .EQ. 2) THEN
304	nb_aer = 2
305	ALLOCATE (aerosol_name(nb_aer))
306	aerosol_name(1) = id_ASBCM
307	aerosol_name(2) = id_AIBCM
308	ELSEIF (flag_aerosol .EQ. 3) THEN
309	nb_aer = 2
310	ALLOCATE (aerosol_name(nb_aer))
311	aerosol_name(1) = id_ASPOMM
312	aerosol_name(2) = id_AIPOMM
313	ELSEIF (flag_aerosol .EQ. 4) THEN
314	nb_aer = 3
315	ALLOCATE (aerosol_name(nb_aer))
316	aerosol_name(1) = id_CSSSM
317	aerosol_name(2) = id_SSSSM
318	aerosol_name(3) = id_ASSSM
319	ELSEIF (flag_aerosol .EQ. 5) THEN
320	nb_aer = 1
321	ALLOCATE (aerosol_name(nb_aer))
322	aerosol_name(1) = id_CIDUSTM
323	ELSEIF (flag_aerosol .EQ. 6) THEN
324	nb_aer = 10
325	ALLOCATE (aerosol_name(nb_aer))
326	aerosol_name(1) = id_ASSO4M
327	aerosol_name(2) = id_ASBCM
328	aerosol_name(3) = id_AIBCM
329	aerosol_name(4) = id_ASPOMM
330	aerosol_name(5) = id_AIPOMM
331	aerosol_name(6) = id_CSSSM
332	aerosol_name(7) = id_SSSSM
333	aerosol_name(8) = id_ASSSM
334	aerosol_name(9) = id_CIDUSTM
335	aerosol_name(10)= id_CSSO4M
336	ENDIF
337
338	!
339	! loop over modes, use of precalculated nmd and corresponding sigma
340	! loop over wavelengths
341	! for each mass species in mode
342	! interpolate from Sext to retrieve Sext_at_gridpoint_per_species
343	! compute optical_thickness_at_gridpoint_per_species
344
345	!!CDIR ON_ADB(RH_tab)
346	!CDIR ON_ADB(fact_RH)
347	!CDIR SHORTLOOP
348	DO n=1,nbre_RH-1
349	fact_RH(n)=1./(RH_tab(n+1)-RH_tab(n))
350	ENDDO
351
352	DO k=1, KLEV
353	!CDIR ON_ADB(fact_RH)
354	DO i=1, KLON
355	rh(i,k)=MIN(RHcl(i,k)*100.,RH_MAX)
356	RH_num(i,k) = INT( rh(i,k)/10. + 1.)
357	IF (rh(i,k).GT.85.) RH_num(i,k)=10
358	IF (rh(i,k).GT.90.) RH_num(i,k)=11
359	delta(i,k)=(rh(i,k)-RH_tab(RH_num(i,k)))*fact_RH(RH_num(i,k))
360	ENDDO
361	ENDDO
362
363	used_aer(:)=.FALSE.
364
365	DO m=1,nb_aer ! tau is only computed for each mass
366	fac=1.0
367	IF (aerosol_name(m).EQ.id_ASBCM) THEN
368	soluble=.TRUE.
369	spsol=1
370	ELSEIF (aerosol_name(m).EQ.id_ASPOMM) THEN
371	soluble=.TRUE.
372	spsol=2
373	ELSEIF (aerosol_name(m).EQ.id_ASSO4M) THEN
374	soluble=.TRUE.
375	spsol=3
376	fac=1.375 ! (NH4)2-SO4/SO4 132/96 mass conversion factor for OD
377	ELSEIF (aerosol_name(m).EQ.id_CSSO4M) THEN
378	soluble=.TRUE.
379	spsol=4
380	fac=1.375 ! (NH4)2-SO4/SO4 132/96 mass conversion factor for OD
381	ELSEIF (aerosol_name(m).EQ.id_SSSSM) THEN
382	soluble=.TRUE.
383	spsol=5
384	ELSEIF (aerosol_name(m).EQ.id_CSSSM) THEN
385	soluble=.TRUE.
386	spsol=6
387	ELSEIF (aerosol_name(m).EQ.id_ASSSM) THEN
388	soluble=.TRUE.
389	spsol=7
390	ELSEIF (aerosol_name(m).EQ.id_CIDUSTM) THEN
391	soluble=.FALSE.
392	spinsol=1
393	ELSEIF (aerosol_name(m).EQ.id_AIBCM) THEN
394	soluble=.FALSE.
395	spinsol=2
396	ELSEIF (aerosol_name(m).EQ.id_AIPOMM) THEN
397	soluble=.FALSE.
398	spinsol=3
399	ELSE
400	CYCLE
401	ENDIF
402
403	id=aerosol_name(m)
404	used_aer(id)=.TRUE.
405
406	IF (soluble) THEN
407
408	DO k=1, KLEV
409	DO i=1, KLON
410	tmp_var=mass_temp(i,k,spsol)1000.zdp1(i,k)deltfac
411	tmp_var_pi=mass_temp_pi(i,k,spsol)1000.zdp1(i,k)deltfac
412
413	DO inu=1,NSW
414
415	tau_ae2b_int= alpha_aers_6bands(RH_num(i,k),inu,spsol)+ &
416	delta(i,k)* (alpha_aers_6bands(RH_num(i,k)+1,inu,spsol) - &
417	alpha_aers_6bands(RH_num(i,k),inu,spsol))
418
419	piz_ae2b_int = piz_aers_6bands(RH_num(i,k),inu,spsol) + &
420	delta(i,k)* (piz_aers_6bands(RH_num(i,k)+1,inu,spsol) - &
421	piz_aers_6bands(RH_num(i,k),inu,spsol))
422
423	cg_ae2b_int = cg_aers_6bands(RH_num(i,k),inu,spsol) + &
424	delta(i,k)* (cg_aers_6bands(RH_num(i,k)+1,inu,spsol) - &
425	cg_aers_6bands(RH_num(i,k),inu,spsol))
426
427	tau_ae(i,k,id,inu) = tmp_var*tau_ae2b_int
428	tau_ae_pi(i,k,id,inu) = tmp_var_pi* tau_ae2b_int
429	piz_ae(i,k,id,inu) = piz_ae2b_int
430	cg_ae(i,k,id,inu) = cg_ae2b_int
431
432	ENDDO
433	ENDDO
434	ENDDO
435
436	ELSE ! For all aerosol insoluble components
437
438	DO k=1, KLEV
439	DO i=1, KLON
440	tmp_var=mass_temp(i,k,naero_soluble+ spinsol)1000.zdp1(i,k)deltfac
441	tmp_var_pi=mass_temp_pi(i,k,naero_soluble+spinsol)1000.zdp1(i,k)deltfac
442
443	DO inu=1,NSW
444	tau_ae2b_int = alpha_aeri_6bands(inu,spinsol)
445	piz_ae2b_int = piz_aeri_6bands(inu,spinsol)
446	cg_ae2b_int = cg_aeri_6bands(inu,spinsol)
447
448	tau_ae(i,k,id,inu) = tmp_var*tau_ae2b_int
449	tau_ae_pi(i,k,id,inu) = tmp_var_pi*tau_ae2b_int
450	piz_ae(i,k,id,inu) = piz_ae2b_int
451	cg_ae(i,k,id,inu)= cg_ae2b_int
452	ENDDO
453	ENDDO
454	ENDDO
455
456	ENDIF ! soluble / insoluble
457
458	ENDDO ! nb_aer
459
460	DO m=1,naero_tot
461	IF (.NOT. used_aer(m)) THEN
462	tau_ae(:,:,m,:)=0.
463	tau_ae_pi(:,:,m,:)=0.
464	piz_ae(:,:,m,:)=0.
465	cg_ae(:,:,m,:)=0.
466	ENDIF
467	ENDDO
468
469	DO inu=1, NSW
470	DO k=1, KLEV
471	DO i=1, KLON
472	!--anthropogenic aerosol
473	tau_allaer(i,k,2,inu)=tau_ae(i,k,id_ASSO4M,inu)+tau_ae(i,k,id_CSSO4M,inu)+ &
474	tau_ae(i,k,id_ASBCM,inu)+tau_ae(i,k,id_AIBCM,inu)+ &
475	tau_ae(i,k,id_ASPOMM,inu)+tau_ae(i,k,id_AIPOMM,inu)+ &
476	tau_ae(i,k,id_ASSSM,inu)+tau_ae(i,k,id_CSSSM,inu)+ &
477	tau_ae(i,k,id_SSSSM,inu)+ tau_ae(i,k,id_CIDUSTM,inu)
478	tau_allaer(i,k,2,inu)=MAX(tau_allaer(i,k,2,inu),1e-5)
479
480	piz_allaer(i,k,2,inu)=(tau_ae(i,k,id_ASSO4M,inu)*piz_ae(i,k,id_ASSO4M,inu)+ &
481	tau_ae(i,k,id_CSSO4M,inu)*piz_ae(i,k,id_CSSO4M,inu)+ &
482	tau_ae(i,k,id_ASBCM,inu)*piz_ae(i,k,id_ASBCM,inu)+ &
483	tau_ae(i,k,id_AIBCM,inu)*piz_ae(i,k,id_AIBCM,inu)+ &
484	tau_ae(i,k,id_ASPOMM,inu)*piz_ae(i,k,id_ASPOMM,inu)+ &
485	tau_ae(i,k,id_AIPOMM,inu)*piz_ae(i,k,id_AIPOMM,inu)+ &
486	tau_ae(i,k,id_ASSSM,inu)*piz_ae(i,k,id_ASSSM,inu)+ &
487	tau_ae(i,k,id_CSSSM,inu)*piz_ae(i,k,id_CSSSM,inu)+ &
488	tau_ae(i,k,id_SSSSM,inu)*piz_ae(i,k,id_SSSSM,inu)+ &
489	tau_ae(i,k,id_CIDUSTM,inu)*piz_ae(i,k,id_CIDUSTM,inu)) &
490	/tau_allaer(i,k,2,inu)
491	piz_allaer(i,k,2,inu)=MAX(piz_allaer(i,k,2,inu),0.1)
492
493	cg_allaer(i,k,2,inu)=(tau_ae(i,k,id_ASSO4M,inu)piz_ae(i,k,id_ASSO4M,inu)cg_ae(i,k,id_ASSO4M,inu)+ &
494	tau_ae(i,k,id_CSSO4M,inu)piz_ae(i,k,id_CSSO4M,inu)cg_ae(i,k,id_CSSO4M,inu)+ &
495	tau_ae(i,k,id_ASBCM,inu)piz_ae(i,k,id_ASBCM,inu)cg_ae(i,k,id_ASBCM,inu)+ &
496	tau_ae(i,k,id_AIBCM,inu)piz_ae(i,k,id_AIBCM,inu)cg_ae(i,k,id_AIBCM,inu)+ &
497	tau_ae(i,k,id_ASPOMM,inu)piz_ae(i,k,id_ASPOMM,inu)cg_ae(i,k,id_ASPOMM,inu)+ &
498	tau_ae(i,k,id_AIPOMM,inu)piz_ae(i,k,id_AIPOMM,inu)cg_ae(i,k,id_AIPOMM,inu)+ &
499	tau_ae(i,k,id_ASSSM,inu)piz_ae(i,k,id_ASSSM,inu)cg_ae(i,k,id_ASSSM,inu)+ &
500	tau_ae(i,k,id_CSSSM,inu)piz_ae(i,k,id_CSSSM,inu)cg_ae(i,k,id_CSSSM,inu)+ &
501	tau_ae(i,k,id_SSSSM,inu)piz_ae(i,k,id_SSSSM,inu)cg_ae(i,k,id_SSSSM,inu)+ &
502	tau_ae(i,k,id_CIDUSTM,inu)piz_ae(i,k,id_CIDUSTM,inu)cg_ae(i,k,id_CIDUSTM,inu))/ &
503	(tau_allaer(i,k,2,inu)*piz_allaer(i,k,2,inu))
504
505	!--natural aerosol
506	tau_allaer(i,k,1,inu)=tau_ae_pi(i,k,id_ASSO4M,inu)+tau_ae_pi(i,k,id_CSSO4M,inu)+ &
507	tau_ae_pi(i,k,id_ASBCM,inu)+tau_ae_pi(i,k,id_AIBCM,inu)+ &
508	tau_ae_pi(i,k,id_ASPOMM,inu)+tau_ae_pi(i,k,id_AIPOMM,inu)+ &
509	tau_ae_pi(i,k,id_ASSSM,inu)+tau_ae_pi(i,k,id_CSSSM,inu)+ &
510	tau_ae_pi(i,k,id_SSSSM,inu)+ tau_ae_pi(i,k,id_CIDUSTM,inu)
511	tau_allaer(i,k,1,inu)=MAX(tau_allaer(i,k,1,inu),1e-5)
512
513	piz_allaer(i,k,1,inu)=(tau_ae_pi(i,k,id_ASSO4M,inu)*piz_ae(i,k,id_ASSO4M,inu)+ &
514	tau_ae_pi(i,k,id_CSSO4M,inu)*piz_ae(i,k,id_CSSO4M,inu)+ &
515	tau_ae_pi(i,k,id_ASBCM,inu)*piz_ae(i,k,id_ASBCM,inu)+ &
516	tau_ae_pi(i,k,id_AIBCM,inu)*piz_ae(i,k,id_AIBCM,inu)+ &
517	tau_ae_pi(i,k,id_ASPOMM,inu)*piz_ae(i,k,id_ASPOMM,inu)+ &
518	tau_ae_pi(i,k,id_AIPOMM,inu)*piz_ae(i,k,id_AIPOMM,inu)+ &
519	tau_ae_pi(i,k,id_ASSSM,inu)*piz_ae(i,k,id_ASSSM,inu)+ &
520	tau_ae_pi(i,k,id_CSSSM,inu)*piz_ae(i,k,id_CSSSM,inu)+ &
521	tau_ae_pi(i,k,id_SSSSM,inu)*piz_ae(i,k,id_SSSSM,inu)+ &
522	tau_ae_pi(i,k,id_CIDUSTM,inu)*piz_ae(i,k,id_CIDUSTM,inu)) &
523	/tau_allaer(i,k,1,inu)
524	piz_allaer(i,k,1,inu)=MAX(piz_allaer(i,k,1,inu),0.1)
525
526	cg_allaer(i,k,1,inu)=(tau_ae_pi(i,k,id_ASSO4M,inu)piz_ae(i,k,id_ASSO4M,inu)cg_ae(i,k,id_ASSO4M,inu)+ &
527	tau_ae_pi(i,k,id_CSSO4M,inu)piz_ae(i,k,id_CSSO4M,inu)cg_ae(i,k,id_CSSO4M,inu)+ &
528	tau_ae_pi(i,k,id_ASBCM,inu)piz_ae(i,k,id_ASBCM,inu)cg_ae(i,k,id_ASBCM,inu)+ &
529	tau_ae_pi(i,k,id_AIBCM,inu)piz_ae(i,k,id_AIBCM,inu)cg_ae(i,k,id_AIBCM,inu)+ &
530	tau_ae_pi(i,k,id_ASPOMM,inu)piz_ae(i,k,id_ASPOMM,inu)cg_ae(i,k,id_ASPOMM,inu)+ &
531	tau_ae_pi(i,k,id_AIPOMM,inu)piz_ae(i,k,id_AIPOMM,inu)cg_ae(i,k,id_AIPOMM,inu)+ &
532	tau_ae_pi(i,k,id_ASSSM,inu)piz_ae(i,k,id_ASSSM,inu)cg_ae(i,k,id_ASSSM,inu)+ &
533	tau_ae_pi(i,k,id_CSSSM,inu)piz_ae(i,k,id_CSSSM,inu)cg_ae(i,k,id_CSSSM,inu)+ &
534	tau_ae_pi(i,k,id_SSSSM,inu)piz_ae(i,k,id_SSSSM,inu)cg_ae(i,k,id_SSSSM,inu)+ &
535	tau_ae_pi(i,k,id_CIDUSTM,inu)piz_ae(i,k,id_CIDUSTM,inu)cg_ae(i,k,id_CIDUSTM,inu))/ &
536	(tau_allaer(i,k,1,inu)*piz_allaer(i,k,1,inu))
537
538	ENDDO
539	ENDDO
540	ENDDO
541
542	!--???????
543	inu=1
544	DO i=1, KLON
545	absvisaer(i)=SUM((1-piz_allaer(i,:,:,inu))*tau_allaer(i,:,:,inu))
546	END DO
547
548	DEALLOCATE(aerosol_name)
549
550	END SUBROUTINE AEROPT_6BANDS_RRTM

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

Download in other formats:

Original Format