LMDZ
aeropt_6bands_rrtm.F90
Go to the documentation of this file.
1 !
2 ! $Id: aeropt_6bands_rrtm.F90 2311 2015-06-25 07:45:24Z emillour $
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, zrho )
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 "clesphys.h"
25 
26  !
27  ! Input arguments:
28  !
29  REAL, DIMENSION(klon,klev), INTENT(in) :: pdel
30  REAL, INTENT(in) :: delt
31  REAL, DIMENSION(klon,klev,naero_tot), INTENT(in) :: m_allaer
32  REAL, DIMENSION(klon,klev,naero_tot), INTENT(in) :: m_allaer_pi
33  REAL, DIMENSION(klon,klev), INTENT(in) :: RHcl ! humidite relative ciel clair
34  INTEGER, INTENT(in) :: flag_aerosol
35  REAL, DIMENSION(klon,klev), INTENT(in) :: zrho
36  !
37  ! Output arguments:
38  ! 1= total aerosols
39  ! 2= natural aerosols
40  !
41  REAL, DIMENSION(klon,klev,2,nbands_sw_rrtm), INTENT(out) :: tau_allaer ! epaisseur optique aerosol
42  REAL, DIMENSION(klon,klev,2,nbands_sw_rrtm), INTENT(out) :: piz_allaer ! single scattering albedo aerosol
43  REAL, DIMENSION(klon,klev,2,nbands_sw_rrtm), INTENT(out) :: cg_allaer ! asymmetry parameter aerosol
44 
45  !
46  ! Local
47  !
48  LOGICAL :: soluble
49  INTEGER :: i, k,n, inu, m
50  INTEGER :: spsol, spinsol
51  INTEGER :: RH_num(klon,klev)
52 
53  INTEGER, PARAMETER :: nb_level=19 ! number of vertical levels in DATA
54 
55  INTEGER, PARAMETER :: naero_soluble=7 ! 1- BC soluble; 2- POM soluble; 3- SO4. acc. 4- SO4 coarse
56  ! 5- seasalt super coarse 6- seasalt coarse 7- seasalt acc.
57  INTEGER, PARAMETER :: naero_insoluble=3 ! 1- Dust; 2- BC insoluble; 3- POM insoluble
58 
59  INTEGER, PARAMETER :: nbre_RH=12
60  REAL,PARAMETER :: RH_tab(nbre_rh)=(/0.,10.,20.,30.,40.,50.,60.,70.,80.,85.,90.,95./)
61  REAL, PARAMETER :: RH_MAX=95.
62  REAL :: delta(klon,klev), rh(klon,klev)
63  REAL :: tau_ae2b_int ! Intermediate computation of epaisseur optique aerosol
64  REAL :: piz_ae2b_int ! Intermediate computation of Single scattering albedo
65  REAL :: cg_ae2b_int ! Intermediate computation of Assymetry parameter
66  REAL :: Fact_RH(nbre_rh)
67  REAL :: fac
68  REAL :: zdp1(klon,klev)
69  INTEGER, ALLOCATABLE, DIMENSION(:) :: aerosol_name
70  INTEGER :: nb_aer
71 
72  REAL, DIMENSION(klon,klev,naero_tot) :: mass_temp
73  REAL, DIMENSION(klon,klev,naero_tot) :: mass_temp_pi
74  REAL, DIMENSION(klon,klev,naero_tot,nbands_sw_rrtm) :: tau_ae
75  REAL, DIMENSION(klon,klev,naero_tot,nbands_sw_rrtm) :: tau_ae_pi
76  REAL, DIMENSION(klon,klev,naero_tot,nbands_sw_rrtm) :: piz_ae
77  REAL, DIMENSION(klon,klev,naero_tot,nbands_sw_rrtm) :: cg_ae
78 
79 
80  !
81  ! Proprietes optiques
82  !
83  REAL:: alpha_aers_6bands(nbre_rh,nbands_sw_rrtm,naero_soluble) !--unit m2/g SO4
84  REAL:: alpha_aeri_6bands(nbands_sw_rrtm,naero_insoluble)
85  REAL:: cg_aers_6bands(nbre_rh,nbands_sw_rrtm,naero_soluble) !--unit
86  REAL:: cg_aeri_6bands(nbands_sw_rrtm,naero_insoluble)
87  REAL:: piz_aers_6bands(nbre_rh,nbands_sw_rrtm,naero_soluble) !-- unit
88  REAL:: piz_aeri_6bands(nbands_sw_rrtm,naero_insoluble) !-- unit
89 
90  INTEGER :: id
91  LOGICAL :: used_aer(naero_tot)
92  REAL :: tmp_var, tmp_var_pi
93 
94 !***************************************************************************
95 !--the order of the soluble species has to follow the spsol index below
96 !--the order of the insoluble species has to follow the spinsol index below
97 
98  DATA alpha_aers_6bands/ &
99  ! bc soluble AS
100  6.497, 6.497, 6.497, 6.497, 6.497, 7.160, 7.875, 9.356,10.811,10.974,11.149,12.734, &
101  6.497, 6.497, 6.497, 6.497, 6.497, 7.160, 7.875, 9.356,10.811,10.974,11.149,12.734, &
102  5.900, 5.900, 5.900, 5.900, 5.900, 6.502, 7.151, 8.496, 9.818, 9.965,10.124,11.564, &
103  4.284, 4.284, 4.284, 4.284, 4.284, 4.721, 5.193, 6.169, 7.129, 7.236, 7.352, 8.397, &
104  2.163, 2.163, 2.163, 2.163, 2.163, 2.384, 2.622, 3.115, 3.600, 3.654, 3.712, 4.240, &
105  0.966, 0.966, 0.966, 0.966, 0.966, 1.065, 1.171, 1.392, 1.608, 1.632, 1.658, 1.894, &
106  ! pom soluble AS
107  6.443, 6.443, 6.443, 6.443, 6.443, 7.100, 7.809, 9.277,10.721,10.882,11.056,12.628, &
108  6.443, 6.443, 6.443, 6.443, 6.443, 7.100, 7.809, 9.277,10.721,10.882,11.056,12.628, &
109  4.381, 4.381, 4.381, 4.381, 4.381, 4.828, 5.310, 6.309, 7.290, 7.400, 7.518, 8.587, &
110  1.846, 1.846, 1.846, 1.846, 1.846, 2.034, 2.237, 2.658, 3.072, 3.118, 3.168, 3.618, &
111  0.377, 0.377, 0.377, 0.377, 0.377, 0.415, 0.456, 0.542, 0.627, 0.636, 0.646, 0.738, &
112  0.052, 0.052, 0.052, 0.052, 0.052, 0.057, 0.063, 0.075, 0.087, 0.088, 0.089, 0.102, &
113  ! sulfate AS
114  6.554, 6.554, 6.554, 7.223, 7.931, 8.665, 9.438,10.736,14.275,17.755,17.755,31.722, &
115  6.554, 6.554, 6.554, 7.223, 7.931, 8.665, 9.438,10.736,14.275,17.755,17.755,31.722, &
116  4.381, 4.381, 4.381, 4.828, 5.301, 5.792, 6.309, 7.176, 9.542,11.868,11.868,21.204, &
117  1.727, 1.727, 1.727, 1.903, 2.090, 2.283, 2.487, 2.829, 3.762, 4.679, 4.679, 8.359, &
118  0.312, 0.312, 0.312, 0.344, 0.378, 0.413, 0.450, 0.511, 0.680, 0.846, 0.846, 1.511, &
119  0.121, 0.121, 0.121, 0.134, 0.147, 0.161, 0.175, 0.199, 0.264, 0.329, 0.329, 0.588, &
120  ! sulfate coarse CS
121  0.693, 0.693, 0.693, 0.764, 0.839, 0.917, 0.999, 1.136, 1.510, 1.879, 1.879, 3.356, &
122  0.693, 0.693, 0.693, 0.764, 0.839, 0.917, 0.999, 1.136, 1.510, 1.879, 1.879, 3.356, &
123  0.715, 0.715, 0.715, 0.788, 0.865, 0.945, 1.029, 1.171, 1.557, 1.936, 1.936, 3.459, &
124  0.736, 0.736, 0.736, 0.811, 0.891, 0.973, 1.060, 1.206, 1.603, 1.994, 1.994, 3.563, &
125  0.711, 0.711, 0.711, 0.783, 0.860, 0.939, 1.023, 1.164, 1.548, 1.925, 1.925, 3.439, &
126  0.602, 0.602, 0.602, 0.664, 0.729, 0.796, 0.867, 0.986, 1.312, 1.631, 1.631, 2.915, &
127  ! seasalt seasalt Super Coarse Soluble (SS)
128  0.214, 0.267, 0.287, 0.310, 0.337, 0.373, 0.421, 0.494, 0.625, 0.742, 0.956, 1.480, &
129  0.217, 0.270, 0.291, 0.314, 0.341, 0.377, 0.426, 0.499, 0.632, 0.751, 0.963, 1.490, &
130  0.221, 0.275, 0.297, 0.320, 0.348, 0.384, 0.434, 0.507, 0.642, 0.762, 0.976, 1.506, &
131  0.230, 0.285, 0.308, 0.331, 0.359, 0.396, 0.447, 0.522, 0.658, 0.780, 0.997, 1.536, &
132  0.250, 0.307, 0.330, 0.354, 0.384, 0.424, 0.477, 0.556, 0.696, 0.822, 1.044, 1.592, &
133  0.279, 0.347, 0.373, 0.401, 0.434, 0.478, 0.537, 0.625, 0.781, 0.918, 1.158, 1.744, &
134  ! seasalt seasalt Coarse Soluble (CS)
135  0.550, 0.676, 0.724, 0.779, 0.841, 0.925, 1.040, 1.213, 1.523, 1.803, 2.306, 3.535, &
136  0.568, 0.695, 0.744, 0.798, 0.863, 0.950, 1.066, 1.240, 1.556, 1.839, 2.342, 3.588, &
137  0.599, 0.727, 0.779, 0.834, 0.901, 0.993, 1.111, 1.290, 1.612, 1.899, 2.411, 3.669, &
138  0.647, 0.786, 0.841, 0.899, 0.969, 1.069, 1.193, 1.384, 1.717, 2.015, 2.543, 3.842, &
139  0.663, 0.825, 0.889, 0.957, 1.038, 1.126, 1.268, 1.483, 1.862, 2.196, 2.780, 4.183, &
140  0.479, 0.644, 0.711, 0.785, 0.873, 0.904, 1.048, 1.275, 1.692, 2.072, 2.753, 4.430, &
141  ! seasalt seasalt Accumulation Soluble (AS)
142  6.128, 7.564, 8.127, 8.723, 9.421,10.014,11.250,13.113,16.320,19.061,23.675,34.158, &
143  5.080, 6.586, 7.197, 7.856, 8.645, 8.820,10.115,12.140,15.775,18.983,24.499,36.993, &
144  3.290, 4.541, 5.073, 5.663, 6.387, 6.227, 7.339, 9.161,12.645,15.918,21.908,36.673, &
145  1.389, 2.066, 2.371, 2.719, 3.161, 2.970, 3.623, 4.747, 7.064, 9.419,14.120,27.565, &
146  0.309, 0.497, 0.587, 0.693, 0.832, 0.777, 0.986, 1.364, 2.207, 3.136, 5.174,12.065, &
147  0.021, 0.037, 0.045, 0.054, 0.067, 0.065, 0.087, 0.129, 0.230, 0.353, 0.654, 1.885 /
148 
149  DATA alpha_aeri_6bands/ &
150  ! dust insoluble CI
151  0.751, 0.751, 0.769, 0.772, 0.672, 0.437, &
152  ! bc insoluble AI
153  6.497, 6.497, 5.900, 4.284, 2.163, 0.966, &
154  ! pom insoluble AI
155  6.443, 6.443, 4.381, 1.846, 0.377, 0.052 /
156 
157  DATA cg_aers_6bands/ &
158  ! bc soluble AS
159  0.721, 0.721, 0.721, 0.729, 0.735, 0.741, 0.746, 0.754, 0.762, 0.766, 0.769, 0.775, &
160  0.721, 0.721, 0.721, 0.729, 0.735, 0.741, 0.746, 0.754, 0.762, 0.766, 0.769, 0.775, &
161  0.643, 0.643, 0.643, 0.654, 0.662, 0.670, 0.677, 0.688, 0.698, 0.704, 0.707, 0.715, &
162  0.513, 0.513, 0.513, 0.522, 0.530, 0.536, 0.542, 0.552, 0.560, 0.565, 0.568, 0.575, &
163  0.321, 0.321, 0.321, 0.323, 0.325, 0.327, 0.328, 0.331, 0.333, 0.334, 0.335, 0.337, &
164  0.153, 0.153, 0.153, 0.149, 0.145, 0.142, 0.139, 0.135, 0.130, 0.128, 0.127, 0.123, &
165  ! pom soluble AS
166  0.687, 0.687, 0.687, 0.687, 0.687, 0.700, 0.710, 0.726, 0.736, 0.737, 0.738, 0.745, &
167  0.687, 0.687, 0.687, 0.687, 0.687, 0.700, 0.710, 0.726, 0.736, 0.737, 0.738, 0.745, &
168  0.658, 0.658, 0.658, 0.658, 0.658, 0.667, 0.674, 0.685, 0.692, 0.692, 0.693, 0.698, &
169  0.564, 0.564, 0.564, 0.564, 0.564, 0.566, 0.568, 0.571, 0.573, 0.573, 0.573, 0.574, &
170  0.363, 0.363, 0.363, 0.363, 0.363, 0.360, 0.357, 0.352, 0.350, 0.349, 0.349, 0.347, &
171  0.142, 0.142, 0.142, 0.142, 0.142, 0.139, 0.137, 0.133, 0.131, 0.131, 0.130, 0.129, &
172  ! sulfate AS
173  0.675, 0.675, 0.675, 0.689, 0.701, 0.711, 0.720, 0.735, 0.748, 0.756, 0.760, 0.771, &
174  0.675, 0.675, 0.675, 0.689, 0.701, 0.711, 0.720, 0.735, 0.748, 0.756, 0.760, 0.771, &
175  0.653, 0.653, 0.653, 0.662, 0.670, 0.676, 0.683, 0.692, 0.701, 0.706, 0.709, 0.716, &
176  0.563, 0.563, 0.563, 0.565, 0.567, 0.569, 0.570, 0.573, 0.575, 0.576, 0.577, 0.579, &
177  0.362, 0.362, 0.362, 0.359, 0.356, 0.354, 0.352, 0.348, 0.345, 0.343, 0.342, 0.340, &
178  0.137, 0.137, 0.137, 0.135, 0.133, 0.132, 0.130, 0.128, 0.126, 0.125, 0.124, 0.122, &
179  ! sulfate coarse CS
180  0.803, 0.803, 0.803, 0.792, 0.783, 0.776, 0.769, 0.758, 0.747, 0.742, 0.738, 0.730, &
181  0.803, 0.803, 0.803, 0.792, 0.783, 0.776, 0.769, 0.758, 0.747, 0.742, 0.738, 0.730, &
182  0.799, 0.799, 0.799, 0.787, 0.777, 0.768, 0.760, 0.747, 0.736, 0.729, 0.725, 0.716, &
183  0.797, 0.797, 0.797, 0.782, 0.770, 0.760, 0.750, 0.735, 0.722, 0.714, 0.709, 0.698, &
184  0.810, 0.810, 0.810, 0.794, 0.781, 0.770, 0.759, 0.743, 0.728, 0.719, 0.714, 0.702, &
185  0.803, 0.803, 0.803, 0.790, 0.779, 0.770, 0.762, 0.748, 0.736, 0.729, 0.725, 0.715, &
186  ! seasalt seasalt Super Coarse Soluble (SS)
187  0.797, 0.800, 0.801, 0.802, 0.804, 0.822, 0.825, 0.828, 0.832, 0.835, 0.838, 0.843, &
188  0.788, 0.792, 0.794, 0.795, 0.796, 0.815, 0.818, 0.822, 0.827, 0.829, 0.833, 0.838, &
189  0.773, 0.778, 0.780, 0.782, 0.783, 0.802, 0.806, 0.811, 0.817, 0.820, 0.825, 0.832, &
190  0.746, 0.753, 0.755, 0.759, 0.760, 0.781, 0.787, 0.792, 0.800, 0.805, 0.811, 0.820, &
191  0.706, 0.714, 0.716, 0.720, 0.722, 0.749, 0.753, 0.761, 0.769, 0.774, 0.783, 0.797, &
192  0.681, 0.682, 0.682, 0.683, 0.684, 0.723, 0.727, 0.732, 0.738, 0.741, 0.748, 0.757, &
193  ! seasalt seasalt Coarse Soluble (CS)
194  0.756, 0.761, 0.764, 0.766, 0.769, 0.790, 0.793, 0.799, 0.805, 0.810, 0.815, 0.823, &
195  0.736, 0.743, 0.747, 0.749, 0.751, 0.773, 0.778, 0.784, 0.793, 0.797, 0.804, 0.815, &
196  0.712, 0.719, 0.721, 0.725, 0.726, 0.752, 0.758, 0.764, 0.773, 0.779, 0.786, 0.800, &
197  0.690, 0.694, 0.695, 0.698, 0.699, 0.731, 0.738, 0.742, 0.751, 0.756, 0.764, 0.776, &
198  0.682, 0.683, 0.683, 0.683, 0.684, 0.725, 0.729, 0.733, 0.737, 0.740, 0.744, 0.752, &
199  0.669, 0.673, 0.674, 0.675, 0.676, 0.718, 0.724, 0.730, 0.736, 0.739, 0.742, 0.746, &
200  ! seasalt seasalt Accumulation Soluble (AS)
201  0.694, 0.692, 0.692, 0.691, 0.689, 0.737, 0.740, 0.742, 0.742, 0.740, 0.737, 0.731, &
202  0.685, 0.690, 0.691, 0.692, 0.692, 0.735, 0.741, 0.746, 0.750, 0.751, 0.750, 0.744, &
203  0.650, 0.662, 0.666, 0.670, 0.673, 0.710, 0.719, 0.729, 0.741, 0.747, 0.754, 0.757, &
204  0.561, 0.585, 0.593, 0.601, 0.609, 0.637, 0.651, 0.669, 0.691, 0.705, 0.723, 0.745, &
205  0.392, 0.427, 0.439, 0.451, 0.464, 0.480, 0.500, 0.526, 0.563, 0.588, 0.621, 0.671, &
206  0.144, 0.170, 0.179, 0.189, 0.201, 0.207, 0.224, 0.248, 0.285, 0.315, 0.359, 0.439 /
207 
208  DATA cg_aeri_6bands/ &
209  ! dust insoluble CI
210  0.718, 0.718, 0.699, 0.661, 0.676, 0.670, &
211  ! bc insoluble AI
212  0.721, 0.721, 0.643, 0.513, 0.321, 0.153, &
213  ! pom insoluble AI
214  0.687, 0.687, 0.658, 0.564, 0.363, 0.142 /
215 
216  DATA piz_aers_6bands/&
217  ! bc soluble AS
218  0.460, 0.460, 0.460, 0.460, 0.460, 0.534, 0.594, 0.688, 0.748, 0.754, 0.760, 0.803, &
219  0.460, 0.460, 0.460, 0.460, 0.460, 0.534, 0.594, 0.688, 0.748, 0.754, 0.760, 0.803, &
220  0.445, 0.445, 0.445, 0.445, 0.445, 0.521, 0.583, 0.679, 0.741, 0.747, 0.753, 0.798, &
221  0.394, 0.394, 0.394, 0.394, 0.394, 0.477, 0.545, 0.649, 0.718, 0.724, 0.730, 0.779, &
222  0.267, 0.267, 0.267, 0.267, 0.267, 0.365, 0.446, 0.571, 0.652, 0.660, 0.667, 0.725, &
223  0.121, 0.121, 0.121, 0.121, 0.121, 0.139, 0.155, 0.178, 0.193, 0.195, 0.196, 0.207, &
224  ! pom soluble AS
225  0.973, 0.973, 0.973, 0.973, 0.973, 0.977, 0.980, 0.984, 0.987, 0.988, 0.988, 0.990, &
226  0.973, 0.973, 0.973, 0.973, 0.973, 0.977, 0.980, 0.984, 0.987, 0.988, 0.988, 0.990, &
227  0.972, 0.972, 0.972, 0.972, 0.972, 0.976, 0.979, 0.984, 0.987, 0.987, 0.988, 0.990, &
228  0.940, 0.940, 0.940, 0.940, 0.940, 0.948, 0.955, 0.965, 0.972, 0.973, 0.973, 0.978, &
229  0.816, 0.816, 0.816, 0.816, 0.816, 0.839, 0.859, 0.888, 0.908, 0.910, 0.911, 0.925, &
230  0.663, 0.663, 0.663, 0.663, 0.663, 0.607, 0.562, 0.492, 0.446, 0.441, 0.437, 0.404, &
231  ! sulfate AS
232  1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, &
233  1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, &
234  1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, &
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  0.988, 0.988, 0.988, 0.989, 0.990, 0.990, 0.991, 0.992, 0.993, 0.993, 0.994, 0.994, &
237  0.256, 0.256, 0.256, 0.263, 0.268, 0.273, 0.277, 0.284, 0.290, 0.294, 0.296, 0.301, &
238  ! sulfate coarse CS
239  1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, &
240  1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, &
241  1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, &
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  0.996, 0.996, 0.996, 0.996, 0.996, 0.996, 0.996, 0.996, 0.996, 0.996, 0.996, 0.996, &
244  0.877, 0.877, 0.877, 0.873, 0.870, 0.867, 0.864, 0.860, 0.856, 0.854, 0.852, 0.849, &
245  ! seasalt seasalt Super Coarse Soluble (SS)
246  0.983, 0.982, 0.982, 0.982, 0.982, 0.992, 0.993, 0.994, 0.995, 0.996, 0.997, 0.998, &
247  0.984, 0.983, 0.983, 0.983, 0.983, 0.993, 0.994, 0.995, 0.996, 0.996, 0.997, 0.998, &
248  0.986, 0.985, 0.985, 0.985, 0.984, 0.993, 0.994, 0.995, 0.996, 0.997, 0.997, 0.998, &
249  0.989, 0.988, 0.988, 0.988, 0.987, 0.995, 0.996, 0.996, 0.997, 0.997, 0.998, 0.999, &
250  0.994, 0.993, 0.992, 0.992, 0.992, 0.997, 0.997, 0.998, 0.998, 0.998, 0.999, 0.999, &
251  0.997, 0.997, 0.997, 0.996, 0.996, 0.999, 0.999, 0.999, 0.999, 0.999, 0.999, 1.000, &
252  ! seasalt seasalt Coarse Soluble (CS)
253  0.988, 0.987, 0.987, 0.987, 0.986, 0.995, 0.995, 0.996, 0.997, 0.997, 0.998, 0.999, &
254  0.990, 0.989, 0.989, 0.989, 0.989, 0.995, 0.996, 0.997, 0.997, 0.998, 0.998, 0.999, &
255  0.993, 0.992, 0.992, 0.992, 0.991, 0.997, 0.997, 0.997, 0.998, 0.998, 0.998, 0.999, &
256  0.996, 0.995, 0.995, 0.995, 0.994, 0.998, 0.998, 0.998, 0.999, 0.999, 0.999, 0.999, &
257  0.998, 0.997, 0.997, 0.997, 0.997, 0.999, 0.999, 0.999, 0.999, 0.999, 0.999, 1.000, &
258  0.999, 0.998, 0.998, 0.998, 0.998, 0.999, 0.999, 1.000, 1.000, 1.000, 1.000, 1.000, &
259  ! seasalt seasalt Accumulation Soluble (AS)
260  0.999, 0.998, 0.998, 0.998, 0.998, 0.999, 0.999, 1.000, 1.000, 1.000, 1.000, 1.000, &
261  0.999, 0.999, 0.999, 0.999, 0.999, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, &
262  0.999, 0.999, 0.999, 0.999, 0.999, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, &
263  0.999, 0.999, 0.999, 0.999, 0.999, 0.999, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, &
264  0.997, 0.998, 0.998, 0.998, 0.998, 0.999, 0.999, 0.999, 1.000, 1.000, 1.000, 1.000, &
265  0.985, 0.989, 0.990, 0.990, 0.991, 0.996, 0.997, 0.998, 0.999, 0.999, 0.999, 1.000 /
266 
267  DATA piz_aeri_6bands/ &
268  ! dust insoluble CI
269  0.954, 0.954, 0.965, 0.981, 0.996, 0.990, &
270  ! bc insoluble AI
271  0.460, 0.460, 0.445, 0.394, 0.267, 0.121, &
272  ! pom insoluble AI
273  0.973, 0.973, 0.972, 0.940, 0.816, 0.663 /
274 
275 !----BEGINNING OF CALCULATIONS
276 
277  spsol = 0
278  spinsol = 0
279  IF (nsw.NE.nbands_sw_rrtm) THEN
280  print *,'Erreur NSW doit etre egal a 6 pour cette routine'
281  stop
282  ENDIF
283 
284  DO k=1, klev
285  DO i=1, klon
286 !CDIR UNROLL=naero_tot
287  mass_temp(i,k,:) = m_allaer(i,k,:) / zrho(i,k) / 1.e+9 !--kg/kg
288 !CDIR UNROLL=naero_tot
289  mass_temp_pi(i,k,:) = m_allaer_pi(i,k,:) / zrho(i,k) / 1.e+9
290  zdp1(i,k)=pdel(i,k)/(rg*delt) ! air mass auxiliary variable --> zdp1 [kg/(m^2 *s)]
291  ENDDO
292  ENDDO
293 
294  IF (flag_aerosol .EQ. 1) THEN
295  nb_aer = 2
296  ALLOCATE (aerosol_name(nb_aer))
297  aerosol_name(1) = id_asso4m_phy
298  aerosol_name(2) = id_csso4m_phy
299  ELSEIF (flag_aerosol .EQ. 2) THEN
300  nb_aer = 2
301  ALLOCATE (aerosol_name(nb_aer))
302  aerosol_name(1) = id_asbcm_phy
303  aerosol_name(2) = id_aibcm_phy
304  ELSEIF (flag_aerosol .EQ. 3) THEN
305  nb_aer = 2
306  ALLOCATE (aerosol_name(nb_aer))
307  aerosol_name(1) = id_aspomm_phy
308  aerosol_name(2) = id_aipomm_phy
309  ELSEIF (flag_aerosol .EQ. 4) THEN
310  nb_aer = 3
311  ALLOCATE (aerosol_name(nb_aer))
312  aerosol_name(1) = id_csssm_phy
313  aerosol_name(2) = id_ssssm_phy
314  aerosol_name(3) = id_asssm_phy
315  ELSEIF (flag_aerosol .EQ. 5) THEN
316  nb_aer = 1
317  ALLOCATE (aerosol_name(nb_aer))
318  aerosol_name(1) = id_cidustm_phy
319  ELSEIF (flag_aerosol .EQ. 6) THEN
320  nb_aer = 10
321  ALLOCATE (aerosol_name(nb_aer))
322  aerosol_name(1) = id_asso4m_phy
323  aerosol_name(2) = id_asbcm_phy
324  aerosol_name(3) = id_aibcm_phy
325  aerosol_name(4) = id_aspomm_phy
326  aerosol_name(5) = id_aipomm_phy
327  aerosol_name(6) = id_csssm_phy
328  aerosol_name(7) = id_ssssm_phy
329  aerosol_name(8) = id_asssm_phy
330  aerosol_name(9) = id_cidustm_phy
331  aerosol_name(10)= id_csso4m_phy
332  ENDIF
333 
334  !
335  ! loop over modes, use of precalculated nmd and corresponding sigma
336  ! loop over wavelengths
337  ! for each mass species in mode
338  ! interpolate from Sext to retrieve Sext_at_gridpoint_per_species
339  ! compute optical_thickness_at_gridpoint_per_species
340 
341 !!CDIR ON_ADB(RH_tab)
342 !CDIR ON_ADB(fact_RH)
343 !CDIR SHORTLOOP
344  DO n=1,nbre_rh-1
345  fact_rh(n)=1./(rh_tab(n+1)-rh_tab(n))
346  ENDDO
347 
348  DO k=1, klev
349 !CDIR ON_ADB(fact_RH)
350  DO i=1, klon
351  rh(i,k)=min(rhcl(i,k)*100.,rh_max)
352  rh_num(i,k) = int(rh(i,k)/10. + 1.)
353  IF (rh(i,k).GT.85.) rh_num(i,k)=10
354  IF (rh(i,k).GT.90.) rh_num(i,k)=11
355  delta(i,k)=(rh(i,k)-rh_tab(rh_num(i,k)))*fact_rh(rh_num(i,k))
356  ENDDO
357  ENDDO
358 
359  used_aer(:)=.false.
360 
361  DO m=1,nb_aer ! tau is only computed for each mass
362  fac=1.0
363  IF (aerosol_name(m).EQ.id_asbcm_phy) THEN
364  soluble=.true.
365  spsol=1
366  ELSEIF (aerosol_name(m).EQ.id_aspomm_phy) THEN
367  soluble=.true.
368  spsol=2
369  ELSEIF (aerosol_name(m).EQ.id_asso4m_phy) THEN
370  soluble=.true.
371  spsol=3
372  fac=1.375 ! (NH4)2-SO4/SO4 132/96 mass conversion factor for OD
373  ELSEIF (aerosol_name(m).EQ.id_csso4m_phy) THEN
374  soluble=.true.
375  spsol=4
376  fac=1.375 ! (NH4)2-SO4/SO4 132/96 mass conversion factor for OD
377  ELSEIF (aerosol_name(m).EQ.id_ssssm_phy) THEN
378  soluble=.true.
379  spsol=5
380  ELSEIF (aerosol_name(m).EQ.id_csssm_phy) THEN
381  soluble=.true.
382  spsol=6
383  ELSEIF (aerosol_name(m).EQ.id_asssm_phy) THEN
384  soluble=.true.
385  spsol=7
386  ELSEIF (aerosol_name(m).EQ.id_cidustm_phy) THEN
387  soluble=.false.
388  spinsol=1
389  ELSEIF (aerosol_name(m).EQ.id_aibcm_phy) THEN
390  soluble=.false.
391  spinsol=2
392  ELSEIF (aerosol_name(m).EQ.id_aipomm_phy) THEN
393  soluble=.false.
394  spinsol=3
395  ELSE
396  cycle
397  ENDIF
398 
399  id=aerosol_name(m)
400  used_aer(id)=.true.
401 
402  IF (soluble) THEN
403 
404  DO k=1, klev
405  DO i=1, klon
406  tmp_var=mass_temp(i,k,spsol)*1000.*zdp1(i,k)*delt*fac
407  tmp_var_pi=mass_temp_pi(i,k,spsol)*1000.*zdp1(i,k)*delt*fac
408 
409  DO inu=1,nsw
410 
411  tau_ae2b_int= alpha_aers_6bands(rh_num(i,k),inu,spsol)+ &
412  delta(i,k)* (alpha_aers_6bands(rh_num(i,k)+1,inu,spsol) - &
413  alpha_aers_6bands(rh_num(i,k),inu,spsol))
414 
415  piz_ae2b_int = piz_aers_6bands(rh_num(i,k),inu,spsol) + &
416  delta(i,k)* (piz_aers_6bands(rh_num(i,k)+1,inu,spsol) - &
417  piz_aers_6bands(rh_num(i,k),inu,spsol))
418 
419  cg_ae2b_int = cg_aers_6bands(rh_num(i,k),inu,spsol) + &
420  delta(i,k)* (cg_aers_6bands(rh_num(i,k)+1,inu,spsol) - &
421  cg_aers_6bands(rh_num(i,k),inu,spsol))
422 
423  tau_ae(i,k,id,inu) = tmp_var*tau_ae2b_int
424  tau_ae_pi(i,k,id,inu) = tmp_var_pi* tau_ae2b_int
425  piz_ae(i,k,id,inu) = piz_ae2b_int
426  cg_ae(i,k,id,inu) = cg_ae2b_int
427 
428  ENDDO
429  ENDDO
430  ENDDO
431 
432  ELSE ! For all aerosol insoluble components
433 
434  DO k=1, klev
435  DO i=1, klon
436  tmp_var=mass_temp(i,k,naero_soluble+ spinsol)*1000.*zdp1(i,k)*delt*fac
437  tmp_var_pi=mass_temp_pi(i,k,naero_soluble+spinsol)*1000.*zdp1(i,k)*delt*fac
438 
439  DO inu=1,nsw
440  tau_ae2b_int = alpha_aeri_6bands(inu,spinsol)
441  piz_ae2b_int = piz_aeri_6bands(inu,spinsol)
442  cg_ae2b_int = cg_aeri_6bands(inu,spinsol)
443 
444  tau_ae(i,k,id,inu) = tmp_var*tau_ae2b_int
445  tau_ae_pi(i,k,id,inu) = tmp_var_pi*tau_ae2b_int
446  piz_ae(i,k,id,inu) = piz_ae2b_int
447  cg_ae(i,k,id,inu)= cg_ae2b_int
448  ENDDO
449  ENDDO
450  ENDDO
451 
452  ENDIF ! soluble / insoluble
453 
454  ENDDO ! nb_aer
455 
456  DO m=1,naero_tot
457  IF (.NOT. used_aer(m)) THEN
458  tau_ae(:,:,m,:)=0.
459  tau_ae_pi(:,:,m,:)=0.
460  piz_ae(:,:,m,:)=0.
461  cg_ae(:,:,m,:)=0.
462  ENDIF
463  ENDDO
464 
465  DO inu=1, nsw
466  DO k=1, klev
467  DO i=1, klon
468 !--anthropogenic aerosol
469  tau_allaer(i,k,2,inu)=tau_ae(i,k,id_asso4m_phy,inu)+tau_ae(i,k,id_csso4m_phy,inu)+ &
470  tau_ae(i,k,id_asbcm_phy,inu)+tau_ae(i,k,id_aibcm_phy,inu)+ &
471  tau_ae(i,k,id_aspomm_phy,inu)+tau_ae(i,k,id_aipomm_phy,inu)+ &
472  tau_ae(i,k,id_asssm_phy,inu)+tau_ae(i,k,id_csssm_phy,inu)+ &
473  tau_ae(i,k,id_ssssm_phy,inu)+ tau_ae(i,k,id_cidustm_phy,inu)
474  tau_allaer(i,k,2,inu)=max(tau_allaer(i,k,2,inu),1e-15)
475 
476  piz_allaer(i,k,2,inu)=(tau_ae(i,k,id_asso4m_phy,inu)*piz_ae(i,k,id_asso4m_phy,inu)+ &
477  tau_ae(i,k,id_csso4m_phy,inu)*piz_ae(i,k,id_csso4m_phy,inu)+ &
478  tau_ae(i,k,id_asbcm_phy,inu)*piz_ae(i,k,id_asbcm_phy,inu)+ &
479  tau_ae(i,k,id_aibcm_phy,inu)*piz_ae(i,k,id_aibcm_phy,inu)+ &
480  tau_ae(i,k,id_aspomm_phy,inu)*piz_ae(i,k,id_aspomm_phy,inu)+ &
481  tau_ae(i,k,id_aipomm_phy,inu)*piz_ae(i,k,id_aipomm_phy,inu)+ &
482  tau_ae(i,k,id_asssm_phy,inu)*piz_ae(i,k,id_asssm_phy,inu)+ &
483  tau_ae(i,k,id_csssm_phy,inu)*piz_ae(i,k,id_csssm_phy,inu)+ &
484  tau_ae(i,k,id_ssssm_phy,inu)*piz_ae(i,k,id_ssssm_phy,inu)+ &
485  tau_ae(i,k,id_cidustm_phy,inu)*piz_ae(i,k,id_cidustm_phy,inu)) &
486  /tau_allaer(i,k,2,inu)
487  piz_allaer(i,k,2,inu)=max(piz_allaer(i,k,2,inu),0.01)
488 
489  cg_allaer(i,k,2,inu)=(tau_ae(i,k,id_asso4m_phy,inu)*piz_ae(i,k,id_asso4m_phy,inu)*cg_ae(i,k,id_asso4m_phy,inu)+ &
490  tau_ae(i,k,id_csso4m_phy,inu)*piz_ae(i,k,id_csso4m_phy,inu)*cg_ae(i,k,id_csso4m_phy,inu)+ &
491  tau_ae(i,k,id_asbcm_phy,inu)*piz_ae(i,k,id_asbcm_phy,inu)*cg_ae(i,k,id_asbcm_phy,inu)+ &
492  tau_ae(i,k,id_aibcm_phy,inu)*piz_ae(i,k,id_aibcm_phy,inu)*cg_ae(i,k,id_aibcm_phy,inu)+ &
493  tau_ae(i,k,id_aspomm_phy,inu)*piz_ae(i,k,id_aspomm_phy,inu)*cg_ae(i,k,id_aspomm_phy,inu)+ &
494  tau_ae(i,k,id_aipomm_phy,inu)*piz_ae(i,k,id_aipomm_phy,inu)*cg_ae(i,k,id_aipomm_phy,inu)+ &
495  tau_ae(i,k,id_asssm_phy,inu)*piz_ae(i,k,id_asssm_phy,inu)*cg_ae(i,k,id_asssm_phy,inu)+ &
496  tau_ae(i,k,id_csssm_phy,inu)*piz_ae(i,k,id_csssm_phy,inu)*cg_ae(i,k,id_csssm_phy,inu)+ &
497  tau_ae(i,k,id_ssssm_phy,inu)*piz_ae(i,k,id_ssssm_phy,inu)*cg_ae(i,k,id_ssssm_phy,inu)+ &
498  tau_ae(i,k,id_cidustm_phy,inu)*piz_ae(i,k,id_cidustm_phy,inu)*cg_ae(i,k,id_cidustm_phy,inu))/ &
499  (tau_allaer(i,k,2,inu)*piz_allaer(i,k,2,inu))
500 
501 !--natural aerosol
502  tau_allaer(i,k,1,inu)=tau_ae_pi(i,k,id_asso4m_phy,inu)+tau_ae_pi(i,k,id_csso4m_phy,inu)+ &
503  tau_ae_pi(i,k,id_asbcm_phy,inu)+tau_ae_pi(i,k,id_aibcm_phy,inu)+ &
504  tau_ae_pi(i,k,id_aspomm_phy,inu)+tau_ae_pi(i,k,id_aipomm_phy,inu)+ &
505  tau_ae_pi(i,k,id_asssm_phy,inu)+tau_ae_pi(i,k,id_csssm_phy,inu)+ &
506  tau_ae_pi(i,k,id_ssssm_phy,inu)+ tau_ae_pi(i,k,id_cidustm_phy,inu)
507  tau_allaer(i,k,1,inu)=max(tau_allaer(i,k,1,inu),1e-15)
508 
509  piz_allaer(i,k,1,inu)=(tau_ae_pi(i,k,id_asso4m_phy,inu)*piz_ae(i,k,id_asso4m_phy,inu)+ &
510  tau_ae_pi(i,k,id_csso4m_phy,inu)*piz_ae(i,k,id_csso4m_phy,inu)+ &
511  tau_ae_pi(i,k,id_asbcm_phy,inu)*piz_ae(i,k,id_asbcm_phy,inu)+ &
512  tau_ae_pi(i,k,id_aibcm_phy,inu)*piz_ae(i,k,id_aibcm_phy,inu)+ &
513  tau_ae_pi(i,k,id_aspomm_phy,inu)*piz_ae(i,k,id_aspomm_phy,inu)+ &
514  tau_ae_pi(i,k,id_aipomm_phy,inu)*piz_ae(i,k,id_aipomm_phy,inu)+ &
515  tau_ae_pi(i,k,id_asssm_phy,inu)*piz_ae(i,k,id_asssm_phy,inu)+ &
516  tau_ae_pi(i,k,id_csssm_phy,inu)*piz_ae(i,k,id_csssm_phy,inu)+ &
517  tau_ae_pi(i,k,id_ssssm_phy,inu)*piz_ae(i,k,id_ssssm_phy,inu)+ &
518  tau_ae_pi(i,k,id_cidustm_phy,inu)*piz_ae(i,k,id_cidustm_phy,inu)) &
519  /tau_allaer(i,k,1,inu)
520  piz_allaer(i,k,1,inu)=max(piz_allaer(i,k,1,inu),0.01)
521 
522  cg_allaer(i,k,1,inu)=(tau_ae_pi(i,k,id_asso4m_phy,inu)*piz_ae(i,k,id_asso4m_phy,inu)*cg_ae(i,k,id_asso4m_phy,inu)+ &
523  tau_ae_pi(i,k,id_csso4m_phy,inu)*piz_ae(i,k,id_csso4m_phy,inu)*cg_ae(i,k,id_csso4m_phy,inu)+ &
524  tau_ae_pi(i,k,id_asbcm_phy,inu)*piz_ae(i,k,id_asbcm_phy,inu)*cg_ae(i,k,id_asbcm_phy,inu)+ &
525  tau_ae_pi(i,k,id_aibcm_phy,inu)*piz_ae(i,k,id_aibcm_phy,inu)*cg_ae(i,k,id_aibcm_phy,inu)+ &
526  tau_ae_pi(i,k,id_aspomm_phy,inu)*piz_ae(i,k,id_aspomm_phy,inu)*cg_ae(i,k,id_aspomm_phy,inu)+ &
527  tau_ae_pi(i,k,id_aipomm_phy,inu)*piz_ae(i,k,id_aipomm_phy,inu)*cg_ae(i,k,id_aipomm_phy,inu)+ &
528  tau_ae_pi(i,k,id_asssm_phy,inu)*piz_ae(i,k,id_asssm_phy,inu)*cg_ae(i,k,id_asssm_phy,inu)+ &
529  tau_ae_pi(i,k,id_csssm_phy,inu)*piz_ae(i,k,id_csssm_phy,inu)*cg_ae(i,k,id_csssm_phy,inu)+ &
530  tau_ae_pi(i,k,id_ssssm_phy,inu)*piz_ae(i,k,id_ssssm_phy,inu)*cg_ae(i,k,id_ssssm_phy,inu)+ &
531  tau_ae_pi(i,k,id_cidustm_phy,inu)*piz_ae(i,k,id_cidustm_phy,inu)*cg_ae(i,k,id_cidustm_phy,inu))/ &
532  (tau_allaer(i,k,1,inu)*piz_allaer(i,k,1,inu))
533 
534  ENDDO
535  ENDDO
536  ENDDO
537 
538 !--???????
539  inu=1
540  DO i=1, klon
541  absvisaer(i)=sum((1-piz_allaer(i,:,:,inu))*tau_allaer(i,:,:,inu))
542  END DO
543 
544  DEALLOCATE(aerosol_name)
545 
546 END SUBROUTINE aeropt_6bands_rrtm
integer, parameter id_asssm_phy
Definition: aero_mod.F90:20
integer, parameter id_aipomm_phy
Definition: aero_mod.F90:23
integer, parameter id_aspomm_phy
Definition: aero_mod.F90:15
subroutine aeropt_6bands_rrtm(pdel, m_allaer, delt, RHcl, tau_allaer, piz_allaer, cg_allaer, m_allaer_pi, flag_aerosol, zrho)
integer, save klon
Definition: dimphy.F90:3
integer, parameter id_csssm_phy
Definition: aero_mod.F90:19
integer, save klev
Definition: dimphy.F90:7
!$Id itapm1 ENDIF!IM on interpole les champs sur les niveaux STD de pression!IM a chaque pas de temps de la physique c!positionnement de l argument logique a false c!pour ne pas recalculer deux fois la meme chose!c!a cet effet un appel a plevel_new a ete deplace c!a la fin de la serie d appels c!la boucle DO nlevSTD a ete internalisee c!dans d ou la creation de cette routine c c!CALL false
Definition: calcul_STDlev.h:26
integer, parameter id_asbcm_phy
Definition: aero_mod.F90:14
integer, parameter id_aibcm_phy
Definition: aero_mod.F90:22
integer, parameter nbands_sw_rrtm
Definition: aero_mod.F90:95
integer, parameter id_asso4m_phy
Definition: aero_mod.F90:16
!$Id itapm1 ENDIF!IM on interpole les champs sur les niveaux STD de pression!IM a chaque pas de temps de la physique c!positionnement de l argument logique a false c!pour ne pas recalculer deux fois la meme chose!c!a cet effet un appel a plevel_new a ete deplace c!a la fin de la serie d appels c!la boucle DO nlevSTD a ete internalisee c!dans d ou la creation de cette routine c c!CALL ulevSTD CALL &zphi philevSTD CALL &zx_rh rhlevSTD!DO klev DO klon klev DO klon klev DO klon klev DO klon klev DO klon klev DO klon klev DO klon klev DO klon klev DO klon klev DO klon du jour ou toutes les read_climoz CALL true
real, dimension(:), allocatable, save absvisaer
integer, parameter id_ssssm_phy
Definition: aero_mod.F90:18
integer, parameter naero_tot
Definition: aero_mod.F90:10
integer, parameter id_csso4m_phy
Definition: aero_mod.F90:17
Definition: dimphy.F90:1
integer, parameter id_cidustm_phy
Definition: aero_mod.F90:21
real rg
Definition: comcstphy.h:1