LMDZ
aeropt_5wv.F90
Go to the documentation of this file.
1 !
2 ! $Id: aeropt_5wv.F90 2324 2015-07-08 15:20:22Z oboucher $
3 !
4 
5 SUBROUTINE aeropt_5wv(&
6  pdel, m_allaer, delt, &
7  rhcl, ai, flag_aerosol, &
8  pplay, t_seri, &
9  tausum, tau, presnivs)
10 
11  USE dimphy
12  USE aero_mod
13  USE phys_local_var_mod, only: od550aer,od865aer,ec550aer,od550lt1aer
14  USE pres2lev_mod
15 
16 
17  !
18  ! Yves Balkanski le 12 avril 2006
19  ! Celine Deandreis
20  ! Anne Cozic Avril 2009
21  ! a partir d'une sous-routine de Johannes Quaas pour les sulfates
22  !
23  !
24  ! Refractive indices for seasalt come from Shettle and Fenn (1979)
25  !
26  ! Refractive indices from water come from Hale and Querry (1973)
27  !
28  ! Refractive indices from Ammonium Sulfate Toon and Pollack (1976)
29  !
30  ! Refractive indices for Dust, internal mixture of minerals coated with 1.5% hematite
31  ! by Volume (Balkanski et al., 2006)
32  !
33  ! Refractive indices for POM: Kinne (pers. Communication
34  !
35  ! Refractive index for BC from Shettle and Fenn (1979)
36  !
37  ! Shettle, E. P., & Fenn, R. W. (1979), Models for the aerosols of the lower atmosphere and
38  ! the effects of humidity variations on their optical properties, U.S. Air Force Geophysics
39  ! Laboratory Rept. AFGL-TR-79-0214, Hanscomb Air Force Base, MA.
40  !
41  ! Hale, G. M. and M. R. Querry, Optical constants of water in the 200-nm to 200-m
42  ! wavelength region, Appl. Opt., 12, 555-563, 1973.
43  !
44  ! Toon, O. B. and J. B. Pollack, The optical constants of several atmospheric aerosol species:
45  ! Ammonium sulfate, aluminum oxide, and sodium chloride, J. Geohys. Res., 81, 5733-5748,
46  ! 1976.
47  !
48  ! Balkanski, Y., M. Schulz, T. Claquin And O. Boucher, Reevaluation of mineral aerosol
49  ! radiative forcings suggests a better agreement with satellite and AERONET data, Atmospheric
50  ! Chemistry and Physics Discussions., 6, pp 8383-8419, 2006.
51  !
52  IMPLICIT NONE
53  include "YOMCST.h"
54  !
55  ! Input arguments:
56  !
57  REAL, DIMENSION(klon,klev), INTENT(in) :: pdel
58  REAL, INTENT(in) :: delt
59  REAL, DIMENSION(klon,klev,naero_tot), INTENT(in) :: m_allaer
60  REAL, DIMENSION(klon,klev), INTENT(in) :: RHcl ! humidite relative ciel clair
61  INTEGER,INTENT(in) :: flag_aerosol
62  REAL, DIMENSION(klon,klev), INTENT(in) :: pplay
63  REAL, DIMENSION(klon,klev), INTENT(in) :: t_seri
64  REAL, DIMENSION(klev), INTENT(in) :: presnivs
65  !
66  ! Output arguments:
67  !
68  REAL, DIMENSION(klon), INTENT(out) :: ai ! POLDER aerosol index
69  REAL, DIMENSION(klon,nwave,naero_tot), INTENT(out) :: tausum
70  REAL, DIMENSION(klon,klev,nwave,naero_tot), INTENT(out) :: tau
71 
72 
73  !
74  ! Local
75  !
76  INTEGER, PARAMETER :: las = nwave
77  LOGICAL :: soluble
78 
79  INTEGER :: i, k, ierr, m, aerindex
80  INTEGER :: spsol, spinsol, spss, la
81  INTEGER :: RH_num(klon,klev)
82  INTEGER, PARAMETER :: la443 = 1
83  INTEGER, PARAMETER :: la550 = 2
84  INTEGER, PARAMETER :: la670 = 3
85  INTEGER, PARAMETER :: la765 = 4
86  INTEGER, PARAMETER :: la865 = 5
87  INTEGER, PARAMETER :: nbre_RH=12
88  INTEGER, PARAMETER :: naero_soluble=7 ! 1- BC soluble; 2- POM soluble; 3- SO4 acc.
89  ! 4- SO4 coarse; 5 seasalt super-C; 6 seasalt coarse; 7 seasalt acc.
90  INTEGER, PARAMETER :: naero_insoluble=3 ! 1- Dust; 2- BC insoluble; 3- POM insoluble
91  INTEGER, PARAMETER :: nb_level = 19 ! number of vertical levels
92  LOGICAL, SAVE :: firstcall=.true.
93 !$OMP THREADPRIVATE(firstcall)
94 
95  REAL :: zrho
96 
97  ! Coefficient optiques sur 19 niveaux
98  REAL, SAVE, DIMENSION(nb_level) :: presnivs_19 ! Pression milieux couche pour 19 niveaux (nb_level)
99 !$OMP THREADPRIVATE(presnivs_19)
100 
101  REAL, SAVE, DIMENSION(nb_level) :: A1_ASSSM_19, A2_ASSSM_19, A3_ASSSM_19,&
102  B1_ASSSM_19, B2_ASSSM_19, C1_ASSSM_19, C2_ASSSM_19,&
103  A1_CSSSM_19, A2_CSSSM_19, A3_CSSSM_19,&
104  B1_CSSSM_19, B2_CSSSM_19, C1_CSSSM_19, C2_CSSSM_19, &
105  A1_SSSSM_19, A2_SSSSM_19, A3_SSSSM_19,&
106  B1_SSSSM_19, B2_SSSSM_19, C1_SSSSM_19, C2_SSSSM_19
107 !$OMP THREADPRIVATE(A1_ASSSM_19, A2_ASSSM_19, A3_ASSSM_19)
108 !$OMP THREADPRIVATE(B1_ASSSM_19, B2_ASSSM_19, C1_ASSSM_19, C2_ASSSM_19)
109 !$OMP THREADPRIVATE(A1_CSSSM_19, A2_CSSSM_19, A3_CSSSM_19)
110 !$OMP THREADPRIVATE(B1_CSSSM_19, B2_CSSSM_19, C1_CSSSM_19, C2_CSSSM_19)
111 !$OMP THREADPRIVATE(A1_SSSSM_19, A2_SSSSM_19, A3_SSSSM_19)
112 !$OMP THREADPRIVATE(B1_SSSSM_19, B2_SSSSM_19, C1_SSSSM_19, C2_SSSSM_19)
113 
114  ! Coefficient optiques interpole sur le nombre de niveau du modele
115  REAL, ALLOCATABLE, DIMENSION(:), SAVE :: &
116  A1_ASSSM, A2_ASSSM, A3_ASSSM,&
117  B1_ASSSM, B2_ASSSM, C1_ASSSM, C2_ASSSM,&
118  A1_CSSSM, A2_CSSSM, A3_CSSSM,&
119  B1_CSSSM, B2_CSSSM, C1_CSSSM, C2_CSSSM, &
120  A1_SSSSM, A2_SSSSM, A3_SSSSM,&
121  B1_SSSSM, B2_SSSSM, C1_SSSSM, C2_SSSSM
122 !$OMP THREADPRIVATE(A1_ASSSM, A2_ASSSM, A3_ASSSM)
123 !$OMP THREADPRIVATE(B1_ASSSM, B2_ASSSM, C1_ASSSM, C2_ASSSM)
124 !$OMP THREADPRIVATE(A1_CSSSM, A2_CSSSM, A3_CSSSM)
125 !$OMP THREADPRIVATE(B1_CSSSM, B2_CSSSM, C1_CSSSM, C2_CSSSM)
126 !$OMP THREADPRIVATE(A1_SSSSM, A2_SSSSM, A3_SSSSM)
127 !$OMP THREADPRIVATE(B1_SSSSM, B2_SSSSM, C1_SSSSM, C2_SSSSM)
128 
129 
130  REAL,PARAMETER :: RH_tab(nbre_rh)=(/0.,10.,20.,30.,40.,50.,60.,70.,80.,85.,90.,95./)
131  REAL :: DELTA(klon,klev), rh(klon,klev), H
132  REAL :: tau_ae5wv_int ! Intermediate computation of epaisseur optique aerosol
133  REAL :: piz_ae5wv_int ! Intermediate single scattering albedo aerosol
134  REAL :: cg_ae5wv_int ! Intermediate asymmetry parameter aerosol
135  REAL, PARAMETER :: RH_MAX=95.
136  REAL :: taue670(klon) ! epaisseur optique aerosol absorption 550 nm
137  REAL :: taue865(klon) ! epaisseur optique aerosol extinction 865 nm
138  REAL :: fac
139  REAL :: zdp1(klon,klev)
140  REAL, PARAMETER :: gravit = 9.80616 ! m2/s
141  INTEGER, ALLOCATABLE, DIMENSION(:) :: aerosol_name
142  INTEGER :: nb_aer
143 
144  REAL :: tau3d(klon,klev), piz3d(klon,klev), cg3d(klon,klev)
145  REAL :: abs3d(klon,klev) ! epaisseur optique d'absorption
146  REAL :: dh(klon,klev)
147 
148  REAL :: alpha_aers_5wv(nbre_rh,las,naero_soluble) ! ext. coeff. Soluble comp. units *** m2/g
149  ! 1- BC soluble; 2- POM soluble; 3- SO4 acc.; 4- SO4 coarse; 5 seasalt super-C; 6 seasalt coarse; 7 seasalt acc.
150  REAL :: alpha_aeri_5wv(las,naero_insoluble) ! ext. coeff. Insoluble comp. 1- Dust: 2- BC; 3- POM
151  REAL :: cg_aers_5wv(nbre_rh,las,naero_soluble) ! Asym. param. soluble comp.
152  ! 1- BC soluble; 2- POM soluble; 3- SO4 acc.; 4- SO4 coarse; 5 seasalt super-C; 6 seasalt coarse; 7 seasalt acc.
153  REAL :: cg_aeri_5wv(las,naero_insoluble) ! Asym. param. insoluble comp. 1- Dust: 2- BC; 3- POM
154  REAL :: piz_aers_5wv(nbre_rh,las,naero_soluble)
155  ! 1- BC soluble; 2- POM soluble; 3- SO4 acc.; 4- SO4 coarse; 5 seasalt super-C; 6 seasalt coarse; 7 seasalt acc.
156  REAL :: piz_aeri_5wv(las,naero_insoluble) ! Insoluble comp. 1- Dust: 2- BC; 3- POM
157 
158  REAL, DIMENSION(klon,klev,naero_tot) :: mass_temp
159 
160  !
161  ! Proprietes optiques
162  !
163  REAL :: radry = 287.054
164  REAL :: tau_tmp ! dry air mass constant
165  REAL :: fact_RH(nbre_rh)
166  LOGICAL :: used_tau(naero_spc)
167  INTEGER :: n
168 
169  DATA presnivs_19/&
170  100426.5, 98327.6, 95346.5, 90966.8, 84776.9, &
171  76536.5, 66292.2, 54559.3, 42501.8, 31806, &
172  23787.5, 18252.7, 13996, 10320.8, 7191.1, &
173  4661.7, 2732.9, 1345.6, 388.2/
174 
175 !!ACCUMULATION MODE
176  DATA a1_asssm_19/ 4.373e+00, 4.361e+00, 4.331e+00, &
177  4.278e+00, 4.223e+00, 4.162e+00, &
178  4.103e+00, 4.035e+00, 3.962e+00, &
179  3.904e+00, 3.871e+00, 3.847e+00, &
180  3.824e+00, 3.780e+00, 3.646e+00, &
181  3.448e+00, 3.179e+00, 2.855e+00, 2.630e+00/
182  DATA a2_asssm_19/ 2.496e+00, 2.489e+00, 2.472e+00, &
183  2.442e+00, 2.411e+00, 2.376e+00, &
184  2.342e+00, 2.303e+00, 2.261e+00, &
185  2.228e+00, 2.210e+00, 2.196e+00, &
186  2.183e+00, 2.158e+00, 2.081e+00, &
187  1.968e+00, 1.814e+00, 1.630e+00, 1.501e+00/
188  DATA a3_asssm_19/-4.688e-02, -4.676e-02, -4.644e-02, &
189  -4.587e-02, -4.528e-02, -4.463e-02, &
190  -4.399e-02, -4.326e-02, -4.248e-02, &
191  -4.186e-02, -4.151e-02, -4.125e-02, &
192  -4.100e-02, -4.053e-02, -3.910e-02, &
193  -3.697e-02, -3.408e-02, -3.061e-02, -2.819e-02/
194  DATA b1_asssm_19/ 1.165e-08, 1.145e-08, 1.097e-08, &
195  1.012e-08, 9.233e-09, 8.261e-09, &
196  7.297e-09, 6.201e-09, 5.026e-09, &
197  4.098e-09, 3.567e-09, 3.187e-09, &
198  2.807e-09, 2.291e-09, 2.075e-09, &
199  1.756e-09, 1.322e-09, 8.011e-10, 4.379e-10/
200  DATA b2_asssm_19/ 2.193e-08, 2.192e-08, 2.187e-08, &
201  2.179e-08, 2.171e-08, 2.162e-08, &
202  2.153e-08, 2.143e-08, 2.132e-08, &
203  2.124e-08, 2.119e-08, 2.115e-08, &
204  2.112e-08, 2.106e-08, 2.100e-08, &
205  2.090e-08, 2.077e-08, 2.061e-08, 2.049e-08/
206  DATA c1_asssm_19/ 7.365e-01, 7.365e-01, 7.365e-01, &
207  7.364e-01, 7.363e-01, 7.362e-01, &
208  7.361e-01, 7.359e-01, 7.358e-01, &
209  7.357e-01, 7.356e-01, 7.356e-01, &
210  7.356e-01, 7.355e-01, 7.354e-01, &
211  7.352e-01, 7.350e-01, 7.347e-01, 7.345e-01/
212  DATA c2_asssm_19/ 5.833e-02, 5.835e-02, 5.841e-02, &
213  5.850e-02, 5.859e-02, 5.870e-02, &
214  5.880e-02, 5.891e-02, 5.904e-02, &
215  5.914e-02, 5.920e-02, 5.924e-02, &
216  5.928e-02, 5.934e-02, 5.944e-02, &
217  5.959e-02, 5.979e-02, 6.003e-02, 6.020e-02/
218 !COARSE MODE
219  DATA a1_csssm_19/ 7.403e-01, 7.422e-01, 7.626e-01, &
220  8.019e-01, 8.270e-01, 8.527e-01, &
221  8.702e-01, 8.806e-01, 8.937e-01, &
222  9.489e-01, 1.030e+00, 1.105e+00, &
223  1.199e+00, 1.357e+00, 1.660e+00, &
224  2.540e+00, 4.421e+00, 2.151e+00, 9.518e-01/
225  DATA a2_csssm_19/ 4.522e-01, 4.532e-01, 4.644e-01, &
226  4.859e-01, 4.996e-01, 5.137e-01, &
227  5.233e-01, 5.290e-01, 5.361e-01, &
228  5.655e-01, 6.085e-01, 6.483e-01, &
229  6.979e-01, 7.819e-01, 9.488e-01, &
230  1.450e+00, 2.523e+00, 1.228e+00, 5.433e-01/
231  DATA a3_csssm_19/-8.516e-03, -8.535e-03, -8.744e-03, &
232  -9.148e-03, -9.406e-03, -9.668e-03, &
233  -9.848e-03, -9.955e-03, -1.009e-02, &
234  -1.064e-02, -1.145e-02, -1.219e-02, &
235  -1.312e-02, -1.470e-02, -1.783e-02, &
236  -2.724e-02, -4.740e-02, -2.306e-02, -1.021e-02/
237  DATA b1_csssm_19/ 2.535e-07, 2.530e-07, 2.479e-07, &
238  2.380e-07, 2.317e-07, 2.252e-07, &
239  2.208e-07, 2.182e-07, 2.149e-07, &
240  2.051e-07, 1.912e-07, 1.784e-07, &
241  1.624e-07, 1.353e-07, 1.012e-07, &
242  6.016e-08, 2.102e-08, 0.000e+00, 0.000e+00/
243  DATA b2_csssm_19/ 1.221e-07, 1.217e-07, 1.179e-07, &
244  1.104e-07, 1.056e-07, 1.008e-07, &
245  9.744e-08, 9.546e-08, 9.299e-08, &
246  8.807e-08, 8.150e-08, 7.544e-08, &
247  6.786e-08, 5.504e-08, 4.080e-08, &
248  2.960e-08, 2.300e-08, 2.030e-08, 1.997e-08/
249  DATA c1_csssm_19/ 7.659e-01, 7.658e-01, 7.652e-01, &
250  7.639e-01, 7.631e-01, 7.623e-01, &
251  7.618e-01, 7.614e-01, 7.610e-01, &
252  7.598e-01, 7.581e-01, 7.566e-01, &
253  7.546e-01, 7.513e-01, 7.472e-01, &
254  7.423e-01, 7.376e-01, 7.342e-01, 7.334e-01/
255  DATA c2_csssm_19/ 3.691e-02, 3.694e-02, 3.729e-02, &
256  3.796e-02, 3.839e-02, 3.883e-02, &
257  3.913e-02, 3.931e-02, 3.953e-02, &
258  4.035e-02, 4.153e-02, 4.263e-02, &
259  4.400e-02, 4.631e-02, 4.933e-02, &
260  5.331e-02, 5.734e-02, 6.053e-02, 6.128e-02/
261 !SUPER COARSE MODE
262  DATA a1_ssssm_19/ 2.836e-01, 2.876e-01, 2.563e-01, &
263  2.414e-01, 2.541e-01, 2.546e-01, &
264  2.572e-01, 2.638e-01, 2.781e-01, &
265  3.167e-01, 4.209e-01, 5.286e-01, &
266  6.959e-01, 9.233e-01, 1.282e+00, &
267  1.836e+00, 2.981e+00, 4.355e+00, 4.059e+00/
268  DATA a2_ssssm_19/ 1.608e-01, 1.651e-01, 1.577e-01, &
269  1.587e-01, 1.686e-01, 1.690e-01, &
270  1.711e-01, 1.762e-01, 1.874e-01, &
271  2.138e-01, 2.751e-01, 3.363e-01, &
272  4.279e-01, 5.519e-01, 7.421e-01, &
273  1.048e+00, 1.702e+00, 2.485e+00, 2.317e+00/
274  DATA a3_ssssm_19/-3.025e-03, -3.111e-03, -2.981e-03, &
275  -3.005e-03, -3.193e-03, -3.200e-03, &
276  -3.239e-03, -3.336e-03, -3.548e-03, &
277  -4.047e-03, -5.196e-03, -6.345e-03, &
278  -8.061e-03, -1.038e-02, -1.395e-02, &
279  -1.970e-02, -3.197e-02, -4.669e-02, -4.352e-02/
280  DATA b1_ssssm_19/ 6.759e-07, 6.246e-07, 5.542e-07, &
281  4.953e-07, 4.746e-07, 4.738e-07, &
282  4.695e-07, 4.588e-07, 4.354e-07, &
283  3.947e-07, 3.461e-07, 3.067e-07, &
284  2.646e-07, 2.095e-07, 1.481e-07, &
285  9.024e-08, 5.747e-08, 2.384e-08, 6.599e-09/
286  DATA b2_ssssm_19/ 5.977e-07, 5.390e-07, 4.468e-07, &
287  3.696e-07, 3.443e-07, 3.433e-07, &
288  3.380e-07, 3.249e-07, 2.962e-07, &
289  2.483e-07, 1.989e-07, 1.623e-07, &
290  1.305e-07, 9.015e-08, 6.111e-08, &
291  3.761e-08, 2.903e-08, 2.337e-08, 2.147e-08/
292  DATA c1_ssssm_19/ 8.120e-01, 8.084e-01, 8.016e-01, &
293  7.953e-01, 7.929e-01, 7.928e-01, &
294  7.923e-01, 7.910e-01, 7.882e-01, &
295  7.834e-01, 7.774e-01, 7.725e-01, &
296  7.673e-01, 7.604e-01, 7.529e-01, &
297  7.458e-01, 7.419e-01, 7.379e-01, 7.360e-01/
298  DATA c2_ssssm_19/ 2.388e-02, 2.392e-02, 2.457e-02, 2.552e-02, &
299  2.615e-02, 2.618e-02, 2.631e-02, 2.663e-02, &
300  2.735e-02, 2.875e-02, 3.113e-02, 3.330e-02, &
301  3.615e-02, 3.997e-02, 4.521e-02, 5.038e-02, &
302  5.358e-02, 5.705e-02, 5.887e-02/
303 !*********************************************************************
304 !
305 !
306 !
307 !
308 !
309 !
310 ! From here on we look at the optical parameters at 5 wavelengths:
311 ! 443nm, 550, 670, 765 and 865 nm
312 ! le 12 AVRIL 2006
313 !
314  DATA alpha_aers_5wv/ &
315  ! bc soluble
316  7.930,7.930,7.930,7.930,7.930,7.930, &
317  7.930,7.930,10.893,12.618,14.550,16.613, &
318  7.658,7.658,7.658,7.658,7.658,7.658, &
319  7.658,7.658,10.351,11.879,13.642,15.510, &
320  7.195,7.195,7.195,7.195,7.195,7.195, &
321  7.195,7.195,9.551,10.847,12.381,13.994, &
322  6.736,6.736,6.736,6.736,6.736,6.736, &
323  6.736,6.736,8.818,9.938,11.283,12.687, &
324  6.277,6.277,6.277,6.277,6.277,6.277, &
325  6.277,6.277,8.123,9.094,10.275,11.501, &
326  ! pom soluble
327  6.676,6.676,6.676,6.676,6.710,6.934, &
328  7.141,7.569,8.034,8.529,9.456,10.511, &
329  5.109,5.109,5.109,5.109,5.189,5.535, &
330  5.960,6.852,8.008,9.712,12.897,19.676, &
331  3.718,3.718,3.718,3.718,3.779,4.042, &
332  4.364,5.052,5.956,7.314,9.896,15.688, &
333  2.849,2.849,2.849,2.849,2.897,3.107, &
334  3.365,3.916,4.649,5.760,7.900,12.863, &
335  2.229,2.229,2.229,2.229,2.268,2.437, &
336  2.645,3.095,3.692,4.608,6.391,10.633, &
337  ! Sulfate (Accumulation)
338  5.751,6.215,6.690,7.024,7.599,8.195, &
339  9.156,10.355,12.660,14.823,18.908,24.508, &
340  4.320,4.675,5.052,5.375,5.787,6.274, &
341  7.066,8.083,10.088,12.003,15.697,21.133, &
342  3.079,3.351,3.639,3.886,4.205,4.584, &
343  5.206,6.019,7.648,9.234,12.391,17.220, &
344  2.336,2.552,2.781,2.979,3.236,3.540, &
345  4.046,4.711,6.056,7.388,10.093,14.313, &
346  1.777,1.949,2.134,2.292,2.503,2.751, &
347  3.166,3.712,4.828,5.949,8.264,11.922, &
348  ! Sulfate (Coarse)
349  5.751,6.215,6.690,7.024,7.599,8.195, &
350  9.156,10.355,12.660,14.823,18.908,24.508, &
351  4.320,4.675,5.052,5.375,5.787,6.274, &
352  7.066,8.083,10.088,12.003,15.697,21.133, &
353  3.079,3.351,3.639,3.886,4.205,4.584, &
354  5.206,6.019,7.648,9.234,12.391,17.220, &
355  2.336,2.552,2.781,2.979,3.236,3.540, &
356  4.046,4.711,6.056,7.388,10.093,14.313, &
357  1.777,1.949,2.134,2.292,2.503,2.751, &
358  3.166,3.712,4.828,5.949,8.264,11.922, &
359  ! Seasalt soluble super_coarse (computed below for 550nm)
360  0.50,0.90,1.05,1.21,1.40,2.41, &
361  2.66,3.11,3.88,4.52,5.69,8.84, &
362  0.000,0.000,0.000,0.000,0.000,0.000, &
363  0.000,0.000,0.000,0.000,0.000,0.000, &
364  0.52,0.93,1.08,1.24,1.43,2.47, &
365  2.73,3.20,3.99,4.64,5.84,9.04, &
366  0.52,0.93,1.09,1.25,1.44,2.50, &
367  2.76,3.23,4.03,4.68,5.89,9.14, &
368  0.52,0.94,1.09,1.26,1.45,2.51, &
369  2.78,3.25,4.06,4.72,5.94,9.22, &
370  ! seasalt soluble coarse (computed below for 550nm)
371  0.50,0.90,1.05,1.21,1.40,2.41, &
372  2.66,3.11,3.88,4.52,5.69,8.84, &
373  0.000,0.000,0.000,0.000,0.000,0.000, &
374  0.000,0.000,0.000,0.000,0.000,0.000, &
375  0.52,0.93,1.08,1.24,1.43,2.47, &
376  2.73,3.20,3.99,4.64,5.84,9.04, &
377  0.52,0.93,1.09,1.25,1.44,2.50, &
378  2.76,3.23,4.03,4.68,5.89,9.14, &
379  0.52,0.94,1.09,1.26,1.45,2.51, &
380  2.78,3.25,4.06,4.72,5.94,9.22, &
381  ! seasalt soluble accumulation (computed below for 550nm)
382  4.28, 7.17, 8.44, 9.85,11.60,22.44, &
383  25.34,30.54,39.38,46.52,59.33,91.77, &
384  0.000,0.000,0.000,0.000,0.000,0.000, &
385  0.000,0.000,0.000,0.000,0.000,0.000, &
386  2.48, 4.22, 5.02, 5.94, 7.11,15.29, &
387  17.70,22.31,30.73,38.06,52.15,90.59, &
388  1.90, 3.29, 3.94, 4.69, 5.65, 12.58, &
389  14.68,18.77,26.41,33.25,46.77,85.50, &
390  1.47, 2.59, 3.12, 3.74, 4.54, 10.42, &
391  12.24,15.82,22.66,28.91,41.54,79.33/
392 
393  DATA alpha_aeri_5wv/ &
394  ! dust insoluble
395  0.759, 0.770, 0.775, 0.775, 0.772, &
396  !!jb bc insoluble
397  11.536,10.033, 8.422, 7.234, 6.270, &
398  ! pom insoluble
399  5.042, 3.101, 1.890, 1.294, 0.934/
400  !
401  DATA cg_aers_5wv/ &
402  ! bc soluble
403  .651, .651, .651, .651, .651, .651, &
404  .651, .651, .738, .764, .785, .800, &
405  .597, .597, .597, .597, .597, .597, &
406  .597, .597, .695, .725, .751, .770, &
407  .543, .543, .543, .543, .543, .543, &
408  .543, .543, .650, .684, .714, .736, &
409  .504, .504, .504, .504, .504, .504, &
410  .504, .504, .614, .651, .683, .708, &
411  .469, .469, .469, .469, .469, .469, &
412  .469, .469, .582, .620, .655, .681, &
413  ! pom soluble
414  .679, .679, .679, .679, .683, .691, &
415  .703, .720, .736, .751, .766, .784, &
416  .656, .656, .656, .656, .659, .669, &
417  .681, .699, .717, .735, .750, .779, &
418  .623, .623, .623, .623, .627, .637, &
419  .649, .668, .688, .709, .734, .762, &
420  .592, .592, .592, .592, .595, .605, &
421  .618, .639, .660, .682, .711, .743, &
422  .561, .561, .561, .561, .565, .575, &
423  .588, .609, .632, .656, .688, .724, &
424  ! Accumulation sulfate
425  .671, .684, .697, .704, .714, .723, &
426  .734, .746, .762, .771, .781, .789, &
427  .653, .666, .678, .687, .697, .707, &
428  .719, .732, .751, .762, .775, .789, &
429  .622, .635, .648, .657, .667, .678, &
430  .691, .705, .728, .741, .758, .777, &
431  .591, .604, .617, .627, .638, .650, &
432  .664, .679, .704, .719, .739, .761, &
433  .560, .574, .587, .597, .609, .621, &
434  .637, .653, .680, .697, .719, .745, &
435  ! Coarse sulfate
436  .671, .684, .697, .704, .714, .723, &
437  .734, .746, .762, .771, .781, .789, &
438  .653, .666, .678, .687, .697, .707, &
439  .719, .732, .751, .762, .775, .789, &
440  .622, .635, .648, .657, .667, .678, &
441  .691, .705, .728, .741, .758, .777, &
442  .591, .604, .617, .627, .638, .650, &
443  .664, .679, .704, .719, .739, .761, &
444  .560, .574, .587, .597, .609, .621, &
445  .637, .653, .680, .697, .719, .745, &
446  ! For super coarse seasalt (computed below for 550nm!)
447  0.730,0.753,0.760,0.766,0.772,0.793, &
448  0.797,0.802,0.809,0.813,0.820,0.830, &
449  0.000,0.000,0.000,0.000,0.000,0.000, &
450  0.000,0.000,0.000,0.000,0.000,0.000, &
451  0.721,0.744,0.750,0.756,0.762,0.784, &
452  0.787,0.793,0.800,0.804,0.811,0.822, &
453  0.717,0.741,0.747,0.753,0.759,0.780, &
454  0.784,0.789,0.795,0.800,0.806,0.817, &
455  0.715,0.739,0.745,0.751,0.757,0.777, &
456  0.781,0.786,0.793,0.797,0.803,0.814, &
457  ! For coarse-soluble seasalt (computed below for 550nm!)
458  0.730,0.753,0.760,0.766,0.772,0.793, &
459  0.797,0.802,0.809,0.813,0.820,0.830, &
460  0.000,0.000,0.000,0.000,0.000,0.000, &
461  0.000,0.000,0.000,0.000,0.000,0.000, &
462  0.721,0.744,0.750,0.756,0.762,0.784, &
463  0.787,0.793,0.800,0.804,0.811,0.822, &
464  0.717,0.741,0.747,0.753,0.759,0.780, &
465  0.784,0.789,0.795,0.800,0.806,0.817, &
466  0.715,0.739,0.745,0.751,0.757,0.777, &
467  0.781,0.786,0.793,0.797,0.803,0.814, &
468  ! accumulation-seasalt soluble (computed below for 550nm!)
469  0.698,0.722,0.729,0.736,0.743,0.765, &
470  0.768,0.773,0.777,0.779,0.781,0.779, &
471  0.000,0.000,0.000,0.000,0.000,0.000, &
472  0.000,0.000,0.000,0.000,0.000,0.000, &
473  0.658,0.691,0.701,0.710,0.720,0.756, &
474  0.763,0.771,0.782,0.788,0.795,0.801, &
475  0.632,0.668,0.679,0.690,0.701,0.743, &
476  0.750,0.762,0.775,0.783,0.792,0.804, &
477  0.605,0.644,0.656,0.669,0.681,0.729, &
478  0.737,0.750,0.765,0.775,0.787,0.803/
479  !
480 
481  DATA cg_aeri_5wv/&
482  ! dust insoluble
483  0.714, 0.697, 0.688, 0.683, 0.679, &
484  ! bc insoluble
485  0.511, 0.445, 0.384, 0.342, 0.307, &
486  !c pom insoluble
487  0.596, 0.536, 0.466, 0.409, 0.359/
488  !
489  DATA piz_aers_5wv/&
490  ! bc soluble
491  .445, .445, .445, .445, .445, .445, &
492  .445, .445, .470, .487, .508, .531, &
493  .442, .442, .442, .442, .442, .442, &
494  .442, .442, .462, .481, .506, .533, &
495  .427, .427, .427, .427, .427, .427, &
496  .427, .427, .449, .470, .497, .526, &
497  .413, .413, .413, .413, .413, .413, &
498  .413, .413, .437, .458, .486, .516, &
499  .399, .399, .399, .399, .399, .399, &
500  .399, .399, .423, .445, .473, .506, &
501  ! pom soluble
502  .975, .975, .975, .975, .975, .977, &
503  .979, .982, .984, .987, .990, .994, &
504  .972, .972, .972, .972, .973, .974, &
505  .977, .980, .983, .986, .989, .993, &
506  .963, .963, .963, .963, .964, .966, &
507  .969, .974, .977, .982, .986, .991, &
508  .955, .955, .955, .955, .955, .958, &
509  .962, .967, .972, .977, .983, .989, &
510  .944, .944, .944, .944, .944, .948, &
511  .952, .959, .962, .972, .979, .987, &
512  ! sulfate soluble accumulation
513  1.000,1.000,1.000,1.000,1.000,1.000, &
514  1.000,1.000,1.000,1.000,1.000,1.000, &
515  1.000,1.000,1.000,1.000,1.000,1.000, &
516  1.000,1.000,1.000,1.000,1.000,1.000, &
517  1.000,1.000,1.000,1.000,1.000,1.000, &
518  1.000,1.000,1.000,1.000,1.000,1.000, &
519  1.000,1.000,1.000,1.000,1.000,1.000, &
520  1.000,1.000,1.000,1.000,1.000,1.000, &
521  1.000,1.000,1.000,1.000,1.000,1.000, &
522  1.000,1.000,1.000,1.000,1.000,1.000, &
523  ! sulfate soluble coarse
524  1.000,1.000,1.000,1.000,1.000,1.000, &
525  1.000,1.000,1.000,1.000,1.000,1.000, &
526  1.000,1.000,1.000,1.000,1.000,1.000, &
527  1.000,1.000,1.000,1.000,1.000,1.000, &
528  1.000,1.000,1.000,1.000,1.000,1.000, &
529  1.000,1.000,1.000,1.000,1.000,1.000, &
530  1.000,1.000,1.000,1.000,1.000,1.000, &
531  1.000,1.000,1.000,1.000,1.000,1.000, &
532  1.000,1.000,1.000,1.000,1.000,1.000, &
533  1.000,1.000,1.000,1.000,1.000,1.000, &
534  ! seasalt super coarse (computed below for 550nm)
535  1.000,1.000,1.000,1.000,1.000,1.000, &
536  1.000,1.000,1.000,1.000,1.000,1.000, &
537  1.000,1.000,1.000,1.000,1.000,1.000, &
538  1.000,1.000,1.000,1.000,1.000,1.000, &
539  1.000,1.000,1.000,1.000,1.000,1.000, &
540  1.000,1.000,1.000,1.000,1.000,1.000, &
541  1.000,1.000,1.000,1.000,1.000,1.000, &
542  1.000,1.000,1.000,1.000,1.000,1.000, &
543  1.000,1.000,1.000,1.000,1.000,1.000, &
544  1.000,1.000,1.000,1.000,1.000,1.000, &
545  ! seasalt coarse (computed below for 550nm)
546  1.000,1.000,1.000,1.000,1.000,1.000, &
547  1.000,1.000,1.000,1.000,1.000,1.000, &
548  1.000,1.000,1.000,1.000,1.000,1.000, &
549  1.000,1.000,1.000,1.000,1.000,1.000, &
550  1.000,1.000,1.000,1.000,1.000,1.000, &
551  1.000,1.000,1.000,1.000,1.000,1.000, &
552  1.000,1.000,1.000,1.000,1.000,1.000, &
553  1.000,1.000,1.000,1.000,1.000,1.000, &
554  1.000,1.000,1.000,1.000,1.000,1.000, &
555  1.000,1.000,1.000,1.000,1.000,1.000, &
556  ! seasalt soluble accumulation (computed below for 550nm)
557  1.000,1.000,1.000,1.000,1.000,1.000, &
558  1.000,1.000,1.000,1.000,1.000,1.000, &
559  1.000,1.000,1.000,1.000,1.000,1.000, &
560  1.000,1.000,1.000,1.000,1.000,1.000, &
561  1.000,1.000,1.000,1.000,1.000,1.000, &
562  1.000,1.000,1.000,1.000,1.000,1.000, &
563  1.000,1.000,1.000,1.000,1.000,1.000, &
564  1.000,1.000,1.000,1.000,1.000,1.000, &
565  1.000,1.000,1.000,1.000,1.000,1.000, &
566  1.000,1.000,1.000,1.000,1.000,1.000/
567 
568  !
569  DATA piz_aeri_5wv/&
570  ! dust insoluble
571  0.944, 0.970, 0.977, 0.982, 0.987, &
572  ! bc insoluble
573  0.415, 0.387, 0.355, 0.328, 0.301, &
574  ! pom insoluble
575  0.972, 0.963, 0.943, 0.923, 0.897/
576 
577 ! Interpolation des coefficients optiques de 19 niveaux vers le nombre des niveaux du model
578  IF (firstcall) THEN
579  firstcall=.false.
580 ! Allocation
581  IF (.NOT. ALLOCATED(a1_asssm)) THEN
582  ALLOCATE(a1_asssm(klev),a2_asssm(klev), a3_asssm(klev),&
583  b1_asssm(klev), b2_asssm(klev), c1_asssm(klev), c2_asssm(klev),&
584  a1_csssm(klev), a2_csssm(klev), a3_csssm(klev),&
585  b1_csssm(klev), b2_csssm(klev), c1_csssm(klev), c2_csssm(klev),&
586  a1_ssssm(klev), a2_ssssm(klev), a3_ssssm(klev),&
587  b1_ssssm(klev), b2_ssssm(klev), c1_ssssm(klev), c2_ssssm(klev), stat=ierr)
588  IF (ierr /= 0) CALL abort_physic('aeropt_5mw', 'pb in allocation 1',1)
589  END IF
590 
591 !Accumulation mode
592  CALL pres2lev(a1_asssm_19, a1_asssm, nb_level, klev, presnivs_19, presnivs, 1, 1, .false.)
593  CALL pres2lev(a2_asssm_19, a2_asssm, nb_level, klev, presnivs_19, presnivs, 1, 1, .false.)
594  CALL pres2lev(a3_asssm_19, a3_asssm, nb_level, klev, presnivs_19, presnivs, 1, 1, .false.)
595  CALL pres2lev(b1_asssm_19, b1_asssm, nb_level, klev, presnivs_19, presnivs, 1, 1, .false.)
596  CALL pres2lev(b2_asssm_19, b2_asssm, nb_level, klev, presnivs_19, presnivs, 1, 1, .false.)
597  CALL pres2lev(c1_asssm_19, c1_asssm, nb_level, klev, presnivs_19, presnivs, 1, 1, .false.)
598  CALL pres2lev(c2_asssm_19, c2_asssm, nb_level, klev, presnivs_19, presnivs, 1, 1, .false.)
599 !Coarse mode
600  CALL pres2lev(a1_csssm_19, a1_csssm, nb_level, klev, presnivs_19, presnivs, 1, 1, .false.)
601  CALL pres2lev(a2_csssm_19, a2_csssm, nb_level, klev, presnivs_19, presnivs, 1, 1, .false.)
602  CALL pres2lev(a3_csssm_19, a3_csssm, nb_level, klev, presnivs_19, presnivs, 1, 1, .false.)
603  CALL pres2lev(b1_csssm_19, b1_csssm, nb_level, klev, presnivs_19, presnivs, 1, 1, .false.)
604  CALL pres2lev(b2_csssm_19, b2_csssm, nb_level, klev, presnivs_19, presnivs, 1, 1, .false.)
605  CALL pres2lev(c1_csssm_19, c1_csssm, nb_level, klev, presnivs_19, presnivs, 1, 1, .false.)
606  CALL pres2lev(c2_csssm_19, c2_csssm, nb_level, klev, presnivs_19, presnivs, 1, 1, .false.)
607 !Super coarse mode
608  CALL pres2lev(a1_ssssm_19, a1_ssssm, nb_level, klev, presnivs_19, presnivs, 1, 1, .false.)
609  CALL pres2lev(a2_ssssm_19, a2_ssssm, nb_level, klev, presnivs_19, presnivs, 1, 1, .false.)
610  CALL pres2lev(a3_ssssm_19, a3_ssssm, nb_level, klev, presnivs_19, presnivs, 1, 1, .false.)
611  CALL pres2lev(b1_ssssm_19, b1_ssssm, nb_level, klev, presnivs_19, presnivs, 1, 1, .false.)
612  CALL pres2lev(b2_ssssm_19, b2_ssssm, nb_level, klev, presnivs_19, presnivs, 1, 1, .false.)
613  CALL pres2lev(c1_ssssm_19, c1_ssssm, nb_level, klev, presnivs_19, presnivs, 1, 1, .false.)
614  CALL pres2lev(c2_ssssm_19, c2_ssssm, nb_level, klev, presnivs_19, presnivs, 1, 1, .false.)
615 
616  END IF ! firstcall
617 
618 
619  ! Initialisations
620  ai(:) = 0.
621  tausum(:,:,:) = 0.
622 
623 
624  DO k=1, klev
625  DO i=1, klon
626  zrho=pplay(i,k)/t_seri(i,k)/rd ! kg/m3
627  dh(i,k)=pdel(i,k)/(gravit*zrho)
628  mass_temp(i,k,:) = m_allaer(i,k,:) / zrho / 1.e+9
629  zdp1(i,k)=pdel(i,k)/(gravit*delt) ! air mass auxiliary variable --> zdp1 [kg/(m^2 *s)]
630 
631  ENDDO
632  ENDDO
633 
634 
635  IF (flag_aerosol .EQ. 1) THEN
636  nb_aer = 2
637  ALLOCATE (aerosol_name(nb_aer))
638  aerosol_name(1) = id_asso4m_phy
639  aerosol_name(2) = id_csso4m_phy
640  ELSEIF (flag_aerosol .EQ. 2) THEN
641  nb_aer = 2
642  ALLOCATE (aerosol_name(nb_aer))
643  aerosol_name(1) = id_asbcm_phy
644  aerosol_name(2) = id_aibcm_phy
645  ELSEIF (flag_aerosol .EQ. 3) THEN
646  nb_aer = 2
647  ALLOCATE (aerosol_name(nb_aer))
648  aerosol_name(1) = id_aspomm_phy
649  aerosol_name(2) = id_aipomm_phy
650  ELSEIF (flag_aerosol .EQ. 4) THEN
651  nb_aer = 3
652  ALLOCATE (aerosol_name(nb_aer))
653  aerosol_name(1) = id_csssm_phy
654  aerosol_name(2) = id_ssssm_phy
655  aerosol_name(3) = id_asssm_phy
656  ELSEIF (flag_aerosol .EQ. 5) THEN
657  nb_aer = 1
658  ALLOCATE (aerosol_name(nb_aer))
659  aerosol_name(1) = id_cidustm_phy
660  ELSEIF (flag_aerosol .EQ. 6) THEN
661  nb_aer = 10
662  ALLOCATE (aerosol_name(nb_aer))
663  aerosol_name(1) = id_asso4m_phy
664  aerosol_name(2) = id_asbcm_phy
665  aerosol_name(3) = id_aibcm_phy
666  aerosol_name(4) = id_aspomm_phy
667  aerosol_name(5) = id_aipomm_phy
668  aerosol_name(6) = id_csssm_phy
669  aerosol_name(7) = id_ssssm_phy
670  aerosol_name(8) = id_asssm_phy
671  aerosol_name(9) = id_cidustm_phy
672  aerosol_name(10) = id_csso4m_phy
673  ENDIF
674 
675  !
676  ! loop over modes, use of precalculated nmd and corresponding sigma
677  ! loop over wavelengths
678  ! for each mass species in mode
679  ! interpolate from Sext to retrieve Sext_at_gridpoint_per_species
680  ! compute optical_thickness_at_gridpoint_per_species
681 
682 
683  !
684  ! Calculations that need to be done since we are not in the subroutines INCA
685  !
686 
687 !CDIR ON_ADB(RH_tab)
688 !CDIR ON_ADB(fact_RH)
689 !CDIR NOVECTOR
690  DO n=1,nbre_rh-1
691  fact_rh(n)=1./(rh_tab(n+1)-rh_tab(n))
692  ENDDO
693 
694  DO k=1, klev
695 !CDIR ON_ADB(RH_tab)
696 !CDIR ON_ADB(fact_RH)
697  DO i=1, klon
698  rh(i,k)=min(rhcl(i,k)*100.,rh_max)
699  rh_num(i,k) = int( rh(i,k)/10. + 1.)
700  IF (rh(i,k).GT.85.) rh_num(i,k)=10
701  IF (rh(i,k).GT.90.) rh_num(i,k)=11
702  delta(i,k)=(rh(i,k)-rh_tab(rh_num(i,k)))*fact_rh(rh_num(i,k))
703  ENDDO
704  ENDDO
705 
706 !CDIR SHORTLOOP
707  used_tau(:)=.false.
708 
709  DO m=1,nb_aer ! tau is only computed for each mass
710  fac=1.0
711  IF (aerosol_name(m).EQ.id_asbcm_phy) THEN
712  soluble=.true.
713  spsol=1
714  spss=0
715  ELSEIF (aerosol_name(m).EQ.id_aspomm_phy) THEN
716  soluble=.true.
717  spsol=2
718  spss=0
719  ELSEIF (aerosol_name(m).EQ.id_asso4m_phy) THEN
720  soluble=.true.
721  spsol=3
722  spss=0
723  fac=1.375 ! (NH4)2-SO4/SO4 132/96 mass conversion factor for OD
724  ELSEIF (aerosol_name(m).EQ.id_csso4m_phy) THEN
725  soluble=.true.
726  spsol=4
727  spss=0
728  fac=1.375 ! (NH4)2-SO4/SO4 132/96 mass conversion factor for OD
729  ELSEIF (aerosol_name(m).EQ.id_ssssm_phy) THEN
730  soluble=.true.
731  spsol=5
732  spss=3
733  ELSEIF (aerosol_name(m).EQ.id_csssm_phy) THEN
734  soluble=.true.
735  spsol=6
736  spss=2
737  ELSEIF (aerosol_name(m).EQ.id_asssm_phy) THEN
738  soluble=.true.
739  spsol=7
740  spss=1
741  ELSEIF (aerosol_name(m).EQ.id_cidustm_phy) THEN
742  soluble=.false.
743  spinsol=1
744  spss=0
745  ELSEIF (aerosol_name(m).EQ.id_aibcm_phy) THEN
746  soluble=.false.
747  spinsol=2
748  spss=0
749  ELSEIF (aerosol_name(m).EQ.id_aipomm_phy) THEN
750  soluble=.false.
751  spinsol=3
752  spss=0
753  ELSE
754  cycle
755  ENDIF
756 
757  IF (soluble) then
758  used_tau(spsol)=.true.
759  ELSE
760  used_tau(naero_soluble+spinsol)=.true.
761  ENDIF
762 
763  aerindex=aerosol_name(m)
764 
765  DO la=1,las
766 
767  IF (soluble) THEN
768 
769  IF((la.EQ.2).AND.(spss.NE.0)) THEN !la=2 corresponds to 550 nm
770  IF (spss.EQ.1) THEN !accumulation mode
771  DO k=1, klev
772 !CDIR ON_ADB(A1_ASSSM)
773 !CDIR ON_ADB(A2_ASSSM)
774 !CDIR ON_ADB(A3_ASSSM)
775  DO i=1, klon
776  h=rh(i,k)/100
777  tau_ae5wv_int=a1_asssm(k)+a2_asssm(k)*h+a3_asssm(k)/(h-1.05)
778  tau(i,k,la,aerindex) = mass_temp(i,k,aerindex)*1000.*zdp1(i,k) &
779  *tau_ae5wv_int*delt*fac
780  tausum(i,la,aerindex)=tausum(i,la,aerindex)+tau(i,k,la,aerindex)
781  ENDDO
782  ENDDO
783  ENDIF
784 
785  IF (spss.EQ.2) THEN !coarse mode
786  DO k=1, klev
787 !CDIR ON_ADB(A1_CSSSM)
788 !CDIR ON_ADB(A2_CSSSM)
789 !CDIR ON_ADB(A3_CSSSM)
790  DO i=1, klon
791  h=rh(i,k)/100
792  tau_ae5wv_int=a1_csssm(k)+a2_csssm(k)*h+a3_csssm(k)/(h-1.05)
793  tau(i,k,la,aerindex) = mass_temp(i,k,aerindex)*1000.*zdp1(i,k) &
794  *tau_ae5wv_int*delt*fac
795  tausum(i,la,aerindex) = tausum(i,la,aerindex)+tau(i,k,la,aerindex)
796  ENDDO
797  ENDDO
798  ENDIF
799 
800  IF (spss.EQ.3) THEN !super coarse mode
801  DO k=1, klev
802 !CDIR ON_ADB(A1_SSSSM)
803 !CDIR ON_ADB(A2_SSSSM)
804 !CDIR ON_ADB(A3_SSSSM)
805  DO i=1, klon
806  h=rh(i,k)/100
807  tau_ae5wv_int=a1_ssssm(k)+a2_ssssm(k)*h+a3_ssssm(k)/(h-1.05)
808  tau(i,k,la,aerindex) = mass_temp(i,k,aerindex)*1000.*zdp1(i,k) &
809  *tau_ae5wv_int*delt*fac
810  tausum(i,la,aerindex)=tausum(i,la,aerindex)+tau(i,k,la,aerindex)
811  ENDDO
812  ENDDO
813  ENDIF
814 
815  ELSE
816  DO k=1, klev
817 !CDIR ON_ADB(alpha_aers_5wv)
818  DO i=1, klon
819  tau_ae5wv_int = alpha_aers_5wv(rh_num(i,k),la,spsol)+delta(i,k)* &
820  (alpha_aers_5wv(rh_num(i,k)+1,la,spsol) - &
821  alpha_aers_5wv(rh_num(i,k),la,spsol))
822 
823  tau(i,k,la,aerindex) = mass_temp(i,k,aerindex)*1000.*zdp1(i,k) &
824  *tau_ae5wv_int*delt*fac
825  tausum(i,la,aerindex)=tausum(i,la,aerindex)+tau(i,k,la,aerindex)
826  ENDDO
827  ENDDO
828  ENDIF
829 
830  ELSE ! For insoluble aerosol
831  DO k=1, klev
832 !CDIR ON_ADB(alpha_aeri_5wv)
833  DO i=1, klon
834  tau_ae5wv_int = alpha_aeri_5wv(la,spinsol)
835  tau(i,k,la,aerindex) = mass_temp(i,k,aerindex)*1000.*zdp1(i,k)* &
836  tau_ae5wv_int*delt*fac
837  tausum(i,la,aerindex)= tausum(i,la,aerindex)+tau(i,k,la,aerindex)
838  ENDDO
839  ENDDO
840  ENDIF
841  ENDDO ! boucle sur les longueurs d'onde
842  ENDDO ! Boucle sur les masses de traceurs
843 
844  DO m=1,naero_spc
845  IF (.NOT.used_tau(m)) tau(:,:,:,m)=0.
846  ENDDO
847 !
848 !
849 ! taue670(:) = SUM(tausum(:,la670,:),dim=2)
850 ! taue865(:) = SUM(tausum(:,la865,:),dim=2)
851 !
852 ! DO i=1, klon
853 ! ai(i)=-LOG(MAX(taue670(i),0.0001)/ &
854 ! MAX(taue865(i),0.0001))/LOG(670./865.)
855 ! ENDDO
856 
857  DO i=1, klon
858  od550aer(i)=0.
859  DO m=1,naero_spc
860  od550aer(i)=od550aer(i)+tausum(i,2,m)
861  ENDDO
862  ENDDO
863 
864  DO i=1, klon
865  od865aer(i)=0.
866  DO m=1,naero_spc
867  od865aer(i)=od865aer(i)+tausum(i,5,m)
868  ENDDO
869  ENDDO
870 
871  DO i=1, klon
872  DO k=1, klev
873  ec550aer(i,k)=0.
874  DO m=1,naero_spc
875  ec550aer(i,k)=ec550aer(i,k)+tau(i,k,2,m)/dh(i,k)
876  ENDDO
877  ENDDO
878  ENDDO
879 
880  od550lt1aer(:)=tausum(:,2,id_asso4m_phy)+tausum(:,2,id_asbcm_phy)+tausum(:,2,id_aibcm_phy)+ &
881  tausum(:,2,id_aspomm_phy)+tausum(:,2,id_aipomm_phy)+tausum(:,2,id_asssm_phy)+ &
882  0.03*tausum(:,2,id_csssm_phy)+0.4*tausum(:,2,id_cidustm_phy)
883 
884  DEALLOCATE(aerosol_name)
885 
886 END SUBROUTINE aeropt_5wv
aero_mod::id_asssm_phy
integer, parameter id_asssm_phy
Definition: aero_mod.F90:20
aero_mod::id_aipomm_phy
integer, parameter id_aipomm_phy
Definition: aero_mod.F90:23
phys_local_var_mod
Definition: phys_local_var_mod.F90:4
aero_mod::id_aspomm_phy
integer, parameter id_aspomm_phy
Definition: aero_mod.F90:15
phys_local_var_mod::od550lt1aer
real, dimension(:), allocatable, save od550lt1aer
Definition: phys_local_var_mod.F90:167
pres2lev_mod::pres2lev
subroutine pres2lev(varo, varn, lmo, lmn, po, pn, ni, nj, ok_invertp)
Definition: pres2lev_mod.F90:9
dimphy::klon
integer, save klon
Definition: dimphy.F90:3
phys_local_var_mod::ec550aer
real, dimension(:,:), allocatable, save ec550aer
Definition: phys_local_var_mod.F90:165
aero_mod::id_csssm_phy
integer, parameter id_csssm_phy
Definition: aero_mod.F90:19
tau
!$Id!Parameters for nlm real spfac!IM cf epmax real ptcrit real omtrain real dttrig real tau
Definition: cv30param.h:5
dimphy::klev
integer, save klev
Definition: dimphy.F90:7
phys_local_var_mod::od865aer
real, dimension(:), allocatable, save od865aer
Definition: phys_local_var_mod.F90:163
presnivs
!$Id presnivs(llm)
false
!$Id itapm1 ENDIF!IM on interpole les champs sur les niveaux STD de pression!IM a chaque pas de temps de la physique c!positionnement de l argument logique a false c!pour ne pas recalculer deux fois la meme chose!c!a cet effet un appel a plevel_new a ete deplace c!a la fin de la serie d appels c!la boucle DO nlevSTD a ete internalisee c!dans d ou la creation de cette routine c c!CALL false
Definition: calcul_STDlev.h:26
aero_mod::id_asbcm_phy
integer, parameter id_asbcm_phy
Definition: aero_mod.F90:14
aeropt_5wv
subroutine aeropt_5wv(pdel, m_allaer, delt, RHcl, ai, flag_aerosol, pplay, t_seri, tausum, tau, presnivs)
Definition: aeropt_5wv.F90:10
aero_mod::id_aibcm_phy
integer, parameter id_aibcm_phy
Definition: aero_mod.F90:22
pplay
!$Id itapm1 ENDIF!IM on interpole les champs sur les niveaux STD de pression!IM a chaque pas de temps de la physique c!positionnement de l argument logique a false c!pour ne pas recalculer deux fois la meme chose!c!a cet effet un appel a plevel_new a ete deplace c!a la fin de la serie d appels c!la boucle DO nlevSTD a ete internalisee c!dans d ou la creation de cette routine c c!CALL pplay
Definition: calcul_STDlev.h:26
aero_mod::id_asso4m_phy
integer, parameter id_asso4m_phy
Definition: aero_mod.F90:16
true
!$Id itapm1 ENDIF!IM on interpole les champs sur les niveaux STD de pression!IM a chaque pas de temps de la physique c!positionnement de l argument logique a false c!pour ne pas recalculer deux fois la meme chose!c!a cet effet un appel a plevel_new a ete deplace c!a la fin de la serie d appels c!la boucle DO nlevSTD a ete internalisee c!dans d ou la creation de cette routine c c!CALL ulevSTD CALL &zphi philevSTD CALL &zx_rh rhlevSTD!DO klev DO klon klev DO klon klev DO klon klev DO klon klev DO klon klev DO klon klev DO klon klev DO klon klev DO klon klev DO klon du jour ou toutes les read_climoz CALL true
Definition: calcul_STDlev.h:139
phys_local_var_mod::od550aer
real, dimension(:), allocatable, save od550aer
Definition: phys_local_var_mod.F90:159
aero_mod
Definition: aero_mod.F90:3
pres2lev_mod
Definition: pres2lev_mod.F90:3
aero_mod::naero_spc
integer, parameter naero_spc
Definition: aero_mod.F90:48
aero_mod::id_ssssm_phy
integer, parameter id_ssssm_phy
Definition: aero_mod.F90:18
abort_physic
subroutine abort_physic(modname, message, ierr)
Definition: abort_physic.F90:3
aero_mod::id_csso4m_phy
integer, parameter id_csso4m_phy
Definition: aero_mod.F90:17
dimphy
Definition: dimphy.F90:1
aero_mod::nwave
integer, parameter nwave
Definition: aero_mod.F90:90
aero_mod::id_cidustm_phy
integer, parameter id_cidustm_phy
Definition: aero_mod.F90:21