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

Last change on this file since 2310 was 2231, checked in by oboucher, 10 years ago

Putting minimum values for SW and LW aerosol optical depth values
Putting default value for aerosol single scattering albedo if no aerosol
Doing this consistently in all cases covered by flag_aerosol and flag_aerosol_strat
  • 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
RevLine 
[2004]1!
[2005]2! $Id: aeropt_6bands_rrtm.F90 2231 2015-03-12 16:46:56Z fairhead $
[2004]3!
4SUBROUTINE AEROPT_6BANDS_RRTM ( &
5     pdel, m_allaer, delt, RHcl, &
6     tau_allaer, piz_allaer, &
7     cg_allaer, m_allaer_pi, &
[2146]8     flag_aerosol, zrho )
[2004]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
[2146]23  INCLUDE "YOMCST.h"
[2004]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
[2146]32  REAL, DIMENSION(klon,klev,naero_tot),   INTENT(in)  :: m_allaer
33  REAL, DIMENSION(klon,klev,naero_tot),   INTENT(in)  :: m_allaer_pi
[2004]34  REAL, DIMENSION(klon,klev),     INTENT(in)  :: RHcl       ! humidite relative ciel clair
35  INTEGER,                        INTENT(in)  :: flag_aerosol
[2146]36  REAL, DIMENSION(klon,klev),     INTENT(in)  :: zrho
[2004]37  !
38  ! Output arguments:
39  ! 1= total aerosols
40  ! 2= natural aerosols
41  !
[2146]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
[2004]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
[2146]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
[2004]79
80
81  !
82  ! Proprietes optiques
83  !
[2146]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
[2004]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, &
[2216]128        ! seasalt seasalt Super Coarse Soluble (SS)
129  0.214, 0.267, 0.287, 0.310, 0.337, 0.373, 0.421, 0.494, 0.625, 0.742, 0.956, 1.480, &
130  0.217, 0.270, 0.291, 0.314, 0.341, 0.377, 0.426, 0.499, 0.632, 0.751, 0.963, 1.490, &
131  0.221, 0.275, 0.297, 0.320, 0.348, 0.384, 0.434, 0.507, 0.642, 0.762, 0.976, 1.506, &
132  0.230, 0.285, 0.308, 0.331, 0.359, 0.396, 0.447, 0.522, 0.658, 0.780, 0.997, 1.536, &
133  0.250, 0.307, 0.330, 0.354, 0.384, 0.424, 0.477, 0.556, 0.696, 0.822, 1.044, 1.592, &
134  0.279, 0.347, 0.373, 0.401, 0.434, 0.478, 0.537, 0.625, 0.781, 0.918, 1.158, 1.744, &
135        ! seasalt seasalt Coarse Soluble (CS)     
136  0.550, 0.676, 0.724, 0.779, 0.841, 0.925, 1.040, 1.213, 1.523, 1.803, 2.306, 3.535, &
137  0.568, 0.695, 0.744, 0.798, 0.863, 0.950, 1.066, 1.240, 1.556, 1.839, 2.342, 3.588, &
138  0.599, 0.727, 0.779, 0.834, 0.901, 0.993, 1.111, 1.290, 1.612, 1.899, 2.411, 3.669, &
139  0.647, 0.786, 0.841, 0.899, 0.969, 1.069, 1.193, 1.384, 1.717, 2.015, 2.543, 3.842, &
140  0.663, 0.825, 0.889, 0.957, 1.038, 1.126, 1.268, 1.483, 1.862, 2.196, 2.780, 4.183, &
141  0.479, 0.644, 0.711, 0.785, 0.873, 0.904, 1.048, 1.275, 1.692, 2.072, 2.753, 4.430, &
142        ! seasalt seasalt Accumulation Soluble (AS)
143  6.128, 7.564, 8.127, 8.723, 9.421,10.014,11.250,13.113,16.320,19.061,23.675,34.158, &
144  5.080, 6.586, 7.197, 7.856, 8.645, 8.820,10.115,12.140,15.775,18.983,24.499,36.993, &
145  3.290, 4.541, 5.073, 5.663, 6.387, 6.227, 7.339, 9.161,12.645,15.918,21.908,36.673, &
146  1.389, 2.066, 2.371, 2.719, 3.161, 2.970, 3.623, 4.747, 7.064, 9.419,14.120,27.565, &
147  0.309, 0.497, 0.587, 0.693, 0.832, 0.777, 0.986, 1.364, 2.207, 3.136, 5.174,12.065, &
148  0.021, 0.037, 0.045, 0.054, 0.067, 0.065, 0.087, 0.129, 0.230, 0.353, 0.654, 1.885  /
[2004]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, &
[2216]187        ! seasalt seasalt Super Coarse Soluble (SS)
188  0.797, 0.800, 0.801, 0.802, 0.804, 0.822, 0.825, 0.828, 0.832, 0.835, 0.838, 0.843, &
189  0.788, 0.792, 0.794, 0.795, 0.796, 0.815, 0.818, 0.822, 0.827, 0.829, 0.833, 0.838, &
190  0.773, 0.778, 0.780, 0.782, 0.783, 0.802, 0.806, 0.811, 0.817, 0.820, 0.825, 0.832, &
191  0.746, 0.753, 0.755, 0.759, 0.760, 0.781, 0.787, 0.792, 0.800, 0.805, 0.811, 0.820, &
192  0.706, 0.714, 0.716, 0.720, 0.722, 0.749, 0.753, 0.761, 0.769, 0.774, 0.783, 0.797, &
193  0.681, 0.682, 0.682, 0.683, 0.684, 0.723, 0.727, 0.732, 0.738, 0.741, 0.748, 0.757, &
194        ! seasalt seasalt Coarse Soluble (CS)     
195  0.756, 0.761, 0.764, 0.766, 0.769, 0.790, 0.793, 0.799, 0.805, 0.810, 0.815, 0.823, &
196  0.736, 0.743, 0.747, 0.749, 0.751, 0.773, 0.778, 0.784, 0.793, 0.797, 0.804, 0.815, &
197  0.712, 0.719, 0.721, 0.725, 0.726, 0.752, 0.758, 0.764, 0.773, 0.779, 0.786, 0.800, &
198  0.690, 0.694, 0.695, 0.698, 0.699, 0.731, 0.738, 0.742, 0.751, 0.756, 0.764, 0.776, &
199  0.682, 0.683, 0.683, 0.683, 0.684, 0.725, 0.729, 0.733, 0.737, 0.740, 0.744, 0.752, &
200  0.669, 0.673, 0.674, 0.675, 0.676, 0.718, 0.724, 0.730, 0.736, 0.739, 0.742, 0.746, &
201        ! seasalt seasalt Accumulation Soluble (AS)
202  0.694, 0.692, 0.692, 0.691, 0.689, 0.737, 0.740, 0.742, 0.742, 0.740, 0.737, 0.731, &
203  0.685, 0.690, 0.691, 0.692, 0.692, 0.735, 0.741, 0.746, 0.750, 0.751, 0.750, 0.744, &
204  0.650, 0.662, 0.666, 0.670, 0.673, 0.710, 0.719, 0.729, 0.741, 0.747, 0.754, 0.757, &
205  0.561, 0.585, 0.593, 0.601, 0.609, 0.637, 0.651, 0.669, 0.691, 0.705, 0.723, 0.745, &
206  0.392, 0.427, 0.439, 0.451, 0.464, 0.480, 0.500, 0.526, 0.563, 0.588, 0.621, 0.671, &
207  0.144, 0.170, 0.179, 0.189, 0.201, 0.207, 0.224, 0.248, 0.285, 0.315, 0.359, 0.439 /
[2004]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, &
[2216]246        ! seasalt seasalt Super Coarse Soluble (SS)
247  0.983, 0.982, 0.982, 0.982, 0.982, 0.992, 0.993, 0.994, 0.995, 0.996, 0.997, 0.998, &
248  0.984, 0.983, 0.983, 0.983, 0.983, 0.993, 0.994, 0.995, 0.996, 0.996, 0.997, 0.998, &
[2004]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, &
[2216]250  0.989, 0.988, 0.988, 0.988, 0.987, 0.995, 0.996, 0.996, 0.997, 0.997, 0.998, 0.999, &
251  0.994, 0.993, 0.992, 0.992, 0.992, 0.997, 0.997, 0.998, 0.998, 0.998, 0.999, 0.999, &
252  0.997, 0.997, 0.997, 0.996, 0.996, 0.999, 0.999, 0.999, 0.999, 0.999, 0.999, 1.000, &
253        ! seasalt seasalt Coarse Soluble (CS)     
254  0.988, 0.987, 0.987, 0.987, 0.986, 0.995, 0.995, 0.996, 0.997, 0.997, 0.998, 0.999, &
255  0.990, 0.989, 0.989, 0.989, 0.989, 0.995, 0.996, 0.997, 0.997, 0.998, 0.998, 0.999, &
256  0.993, 0.992, 0.992, 0.992, 0.991, 0.997, 0.997, 0.997, 0.998, 0.998, 0.998, 0.999, &
257  0.996, 0.995, 0.995, 0.995, 0.994, 0.998, 0.998, 0.998, 0.999, 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, 1.000, &
259  0.999, 0.998, 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.998, 0.998, 0.998, 0.998, 0.999, 0.999, 1.000, 1.000, 1.000, 1.000, 1.000, &
[2004]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, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, &
[2216]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.997, 0.998, 0.998, 0.998, 0.998, 0.999, 0.999, 0.999, 1.000, 1.000, 1.000, 1.000, &
266  0.985, 0.989, 0.990, 0.990, 0.991, 0.996, 0.997, 0.998, 0.999, 0.999, 0.999, 1.000 /
[2004]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
[2146]280  IF (NSW.NE.nbands_sw_rrtm) THEN
[2004]281     print *,'Erreur NSW doit etre egal a 6 pour cette routine'
282     stop
[2146]283  ENDIF
[2004]284
285  DO k=1, klev
286    DO i=1, klon
[2146]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
[2004]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))
[2146]298     aerosol_name(1) = id_ASSO4M_phy
299     aerosol_name(2) = id_CSSO4M_phy
[2004]300  ELSEIF (flag_aerosol .EQ. 2) THEN
301     nb_aer = 2
302     ALLOCATE (aerosol_name(nb_aer))
[2146]303     aerosol_name(1) = id_ASBCM_phy
304     aerosol_name(2) = id_AIBCM_phy
[2004]305  ELSEIF (flag_aerosol .EQ. 3) THEN
306     nb_aer = 2
307     ALLOCATE (aerosol_name(nb_aer))
[2146]308     aerosol_name(1) = id_ASPOMM_phy
309     aerosol_name(2) = id_AIPOMM_phy
[2004]310  ELSEIF (flag_aerosol .EQ. 4) THEN
311     nb_aer = 3
312     ALLOCATE (aerosol_name(nb_aer))
[2146]313     aerosol_name(1) = id_CSSSM_phy
314     aerosol_name(2) = id_SSSSM_phy
315     aerosol_name(3) = id_ASSSM_phy
[2004]316  ELSEIF (flag_aerosol .EQ. 5) THEN
317     nb_aer = 1
318     ALLOCATE (aerosol_name(nb_aer))
[2146]319     aerosol_name(1) = id_CIDUSTM_phy
[2004]320  ELSEIF (flag_aerosol .EQ. 6) THEN
321     nb_aer = 10
322     ALLOCATE (aerosol_name(nb_aer))
[2146]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
[2004]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)
[2146]353      RH_num(i,k) = INT(rh(i,k)/10. + 1.)
[2004]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
[2146]364     IF (aerosol_name(m).EQ.id_ASBCM_phy) THEN
[2004]365        soluble=.TRUE.
366        spsol=1
[2146]367     ELSEIF (aerosol_name(m).EQ.id_ASPOMM_phy) THEN
[2004]368        soluble=.TRUE.
369        spsol=2
[2146]370     ELSEIF (aerosol_name(m).EQ.id_ASSO4M_phy) THEN
[2004]371        soluble=.TRUE.
372        spsol=3
373        fac=1.375    ! (NH4)2-SO4/SO4 132/96 mass conversion factor for OD
[2146]374     ELSEIF  (aerosol_name(m).EQ.id_CSSO4M_phy) THEN
[2004]375        soluble=.TRUE.
376        spsol=4
377        fac=1.375    ! (NH4)2-SO4/SO4 132/96 mass conversion factor for OD
[2146]378     ELSEIF (aerosol_name(m).EQ.id_SSSSM_phy) THEN
[2004]379         soluble=.TRUE.
380         spsol=5
[2146]381     ELSEIF (aerosol_name(m).EQ.id_CSSSM_phy) THEN
[2004]382         soluble=.TRUE.
383         spsol=6
[2146]384     ELSEIF (aerosol_name(m).EQ.id_ASSSM_phy) THEN
[2004]385         soluble=.TRUE.
386         spsol=7
[2146]387     ELSEIF (aerosol_name(m).EQ.id_CIDUSTM_phy) THEN
[2004]388         soluble=.FALSE.
389         spinsol=1
[2146]390     ELSEIF  (aerosol_name(m).EQ.id_AIBCM_phy) THEN
[2004]391         soluble=.FALSE.
392         spinsol=2
[2146]393     ELSEIF (aerosol_name(m).EQ.id_AIPOMM_phy) THEN
[2004]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
[2146]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)
[2231]475         tau_allaer(i,k,2,inu)=MAX(tau_allaer(i,k,2,inu),1e-15)
[2004]476
[2146]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)) &
[2004]487                                /tau_allaer(i,k,2,inu)
[2231]488         piz_allaer(i,k,2,inu)=MAX(piz_allaer(i,k,2,inu),0.01)
[2004]489
[2146]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))/ &
[2004]500                               (tau_allaer(i,k,2,inu)*piz_allaer(i,k,2,inu))
501
502!--natural aerosol
[2146]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)
[2231]508         tau_allaer(i,k,1,inu)=MAX(tau_allaer(i,k,1,inu),1e-15)
[2004]509
[2146]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)) &
[2004]520                                /tau_allaer(i,k,1,inu)
[2231]521         piz_allaer(i,k,1,inu)=MAX(piz_allaer(i,k,1,inu),0.01)
[2004]522
[2146]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))/ &
[2004]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.