source: LMDZ5/trunk/libf/phylmd/rrtm/aeropt_6bands_rrtm.F90 @ 2004

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

Nouvelle version qui inclut les effets des aérosols et propose les mêmes diagnostics des effets directs
et indirects que l'ancienne version du rayonnement.
OB

New RRTM version that includes the effects of aerosols and outputs the same direct and indirect effects
diagnostics as the old version
OB
File size: 27.4 KB
Line 
1!
2! $Id: aeropt_6bands.F90 1716 2013-01-22 13:36:30Z acozic $
3!
4SUBROUTINE 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)/(RG*delt)      ! 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)*delt*fac
411           tmp_var_pi=mass_temp_pi(i,k,spsol)*1000.*zdp1(i,k)*delt*fac
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)*delt*fac
441           tmp_var_pi=mass_temp_pi(i,k,naero_soluble+spinsol)*1000.*zdp1(i,k)*delt*fac
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
550END SUBROUTINE AEROPT_6BANDS_RRTM
Note: See TracBrowser for help on using the repository browser.