Context Navigation

aeropt_6bands_rrtm.F90 @ 2064

Last change on this file since 2064 was 2058, checked in by Laurent Fairhead, 10 years ago

Modifications sur l'utilisation du module/fichier YOMCST

Modification on the use of the file/module YOMCST
MPL

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 2058 2014-06-16 15:00:45Z fairhead $
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	USE YOMCST , only: RD , RG
14
15	! Yves Balkanski le 12 avril 2006
16	! Celine Deandreis
17	! Anne Cozic Avril 2009
18	! a partir d'une sous-routine de Johannes Quaas pour les sulfates
19	! Olivier Boucher février 2014 pour passage à RRTM
20	! a partir des propriétés optiques fournies par Yves Balkanski
21	!
22	IMPLICIT NONE
23
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