source: LMDZ5/branches/testing/libf/phylmd/rrtm/aeropt_6bands_rrtm.F90 @ 2435

Last change on this file since 2435 was 2408, checked in by Laurent Fairhead, 9 years ago

Merged trunk changes r2298:2396 into testing branch
  • 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 2408 2015-12-14 10:43:09Z 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 "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
546END SUBROUTINE AEROPT_6BANDS_RRTM
Note: See TracBrowser for help on using the repository browser.