source: LMDZ5/branches/LMDZ6_rc0/libf/phylmd/rrtm/aeropt_6bands_rrtm.F90

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

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