LMDZ
aeropt_2bands.F90
Go to the documentation of this file.
1 !
2 ! $Id: aeropt_2bands.F90 2324 2015-07-08 15:20:22Z oboucher $
3 !
4 SUBROUTINE aeropt_2bands( &
5  pdel, m_allaer, delt, rhcl, &
6  tau_allaer, piz_allaer, &
7  cg_allaer, m_allaer_pi, &
8  flag_aerosol, pplay, t_seri, presnivs)
9 
10  USE dimphy
11  USE aero_mod
12  USE phys_local_var_mod, only: absvisaer
13  USE pres2lev_mod
14 
15 
16  ! Yves Balkanski le 12 avril 2006
17  ! Celine Deandreis
18  ! Anne Cozic Avril 2009
19  ! a partir d'une sous-routine de Johannes Quaas pour les sulfates
20  !
21  IMPLICIT NONE
22 
23  include "YOMCST.h"
24 
25  !
26  ! Input arguments:
27  !
28  REAL, DIMENSION(klon,klev), INTENT(in) :: pdel
29  REAL, INTENT(in) :: delt
30  REAL, DIMENSION(klon,klev,naero_tot), INTENT(in) :: m_allaer
31  REAL, DIMENSION(klon,klev,naero_tot), INTENT(in) :: m_allaer_pi
32  REAL, DIMENSION(klon,klev), INTENT(in) :: RHcl ! humidite relative ciel clair
33  INTEGER, INTENT(in) :: flag_aerosol
34  REAL, DIMENSION(klon,klev), INTENT(in) :: pplay
35  REAL, DIMENSION(klon,klev), INTENT(in) :: t_seri
36  REAL, DIMENSION(klev), INTENT(in) :: presnivs
37  !
38  ! Output arguments:
39  !
40  REAL, DIMENSION(klon,klev,naero_grp,nbands), INTENT(out) :: tau_allaer ! epaisseur optique aerosol
41  REAL, DIMENSION(klon,klev,naero_grp,nbands), INTENT(out) :: piz_allaer ! single scattering albedo aerosol
42  REAL, DIMENSION(klon,klev,naero_grp,nbands), INTENT(out) :: cg_allaer ! asymmetry parameter aerosol
43 
44  !
45  ! Local
46  !
47  REAL, DIMENSION(klon,klev,naero_tot,nbands) :: tau_ae
48  REAL, DIMENSION(klon,klev,naero_tot,nbands) :: tau_ae_pi
49  REAL, DIMENSION(klon,klev,naero_tot,nbands) :: piz_ae
50  REAL, DIMENSION(klon,klev,naero_tot,nbands) :: cg_ae
51  LOGICAL :: soluble
52  INTEGER :: i, k,n, ierr, inu, m, mrfspecies
53  INTEGER :: spsol, spinsol, spss
54  INTEGER :: RH_num(klon,klev)
55  INTEGER, PARAMETER :: nb_level=19 ! number of vertical levels in DATA
56 
57  INTEGER, PARAMETER :: nbre_RH=12
58  INTEGER, PARAMETER :: naero_soluble=7 ! 1- BC soluble; 2- POM soluble; 3- SO4. acc. 4- SO4 coarse
59  ! 5- seasalt super coarse 6- seasalt coarse 7- seasalt acc.
60  INTEGER, PARAMETER :: naero_insoluble=3 ! 1- Dust; 2- BC insoluble; 3- POM insoluble
61  LOGICAL, SAVE :: firstcall=.true.
62 !$OMP THREADPRIVATE(firstcall)
63 
64 ! Coefficient optiques sur 19 niveaux
65  REAL, SAVE, DIMENSION(nb_level) :: presnivs_19 ! Pression milieux couche pour 19 niveaux (nb_level)
66 !$OMP THREADPRIVATE(presnivs_19)
67 
68  REAL, SAVE, DIMENSION(nb_level) :: A1_ASSSM_b1_19, A2_ASSSM_b1_19, A3_ASSSM_b1_19,&
69  B1_ASSSM_b1_19, B2_ASSSM_b1_19, C1_ASSSM_b1_19, C2_ASSSM_b1_19,&
70  A1_CSSSM_b1_19, A2_CSSSM_b1_19, A3_CSSSM_b1_19,&
71  B1_CSSSM_b1_19, B2_CSSSM_b1_19, C1_CSSSM_b1_19, C2_CSSSM_b1_19,&
72  A1_SSSSM_b1_19, A2_SSSSM_b1_19, A3_SSSSM_b1_19,&
73  B1_SSSSM_b1_19, B2_SSSSM_b1_19, C1_SSSSM_b1_19, C2_SSSSM_b1_19,&
74  A1_ASSSM_b2_19, A2_ASSSM_b2_19, A3_ASSSM_b2_19,&
75  B1_ASSSM_b2_19, B2_ASSSM_b2_19, C1_ASSSM_b2_19, C2_ASSSM_b2_19,&
76  A1_CSSSM_b2_19, A2_CSSSM_b2_19, A3_CSSSM_b2_19,&
77  B1_CSSSM_b2_19, B2_CSSSM_b2_19, C1_CSSSM_b2_19, C2_CSSSM_b2_19,&
78  A1_SSSSM_b2_19, A2_SSSSM_b2_19, A3_SSSSM_b2_19,&
79  B1_SSSSM_b2_19, B2_SSSSM_b2_19, C1_SSSSM_b2_19, C2_SSSSM_b2_19
80 !$OMP THREADPRIVATE(A1_ASSSM_b1_19, A2_ASSSM_b1_19, A3_ASSSM_b1_19)
81 !$OMP THREADPRIVATE(B1_ASSSM_b1_19, B2_ASSSM_b1_19, C1_ASSSM_b1_19, C2_ASSSM_b1_19)
82 !$OMP THREADPRIVATE(A1_CSSSM_b1_19, A2_CSSSM_b1_19, A3_CSSSM_b1_19)
83 !$OMP THREADPRIVATE(B1_CSSSM_b1_19, B2_CSSSM_b1_19, C1_CSSSM_b1_19, C2_CSSSM_b1_19)
84 !$OMP THREADPRIVATE(A1_SSSSM_b1_19, A2_SSSSM_b1_19, A3_SSSSM_b1_19)
85 !$OMP THREADPRIVATE(B1_SSSSM_b1_19, B2_SSSSM_b1_19, C1_SSSSM_b1_19, C2_SSSSM_b1_19)
86 !$OMP THREADPRIVATE(A1_ASSSM_b2_19, A2_ASSSM_b2_19, A3_ASSSM_b2_19)
87 !$OMP THREADPRIVATE(B1_ASSSM_b2_19, B2_ASSSM_b2_19, C1_ASSSM_b2_19, C2_ASSSM_b2_19)
88 !$OMP THREADPRIVATE(A1_CSSSM_b2_19, A2_CSSSM_b2_19, A3_CSSSM_b2_19)
89 !$OMP THREADPRIVATE(B1_CSSSM_b2_19, B2_CSSSM_b2_19, C1_CSSSM_b2_19, C2_CSSSM_b2_19)
90 !$OMP THREADPRIVATE(A1_SSSSM_b2_19, A2_SSSSM_b2_19, A3_SSSSM_b2_19)
91 !$OMP THREADPRIVATE(B1_SSSSM_b2_19, B2_SSSSM_b2_19, C1_SSSSM_b2_19, C2_SSSSM_b2_19)
92 
93 
94 ! Coefficient optiques interpole sur le nombre de niveau du modele
95  REAL, ALLOCATABLE, DIMENSION(:), SAVE :: &
96  A1_ASSSM_b1, A2_ASSSM_b1, A3_ASSSM_b1,&
97  B1_ASSSM_b1, B2_ASSSM_b1, C1_ASSSM_b1, C2_ASSSM_b1,&
98  A1_CSSSM_b1, A2_CSSSM_b1, A3_CSSSM_b1,&
99  B1_CSSSM_b1, B2_CSSSM_b1, C1_CSSSM_b1, C2_CSSSM_b1,&
100  A1_SSSSM_b1, A2_SSSSM_b1, A3_SSSSM_b1,&
101  B1_SSSSM_b1, B2_SSSSM_b1, C1_SSSSM_b1, C2_SSSSM_b1,&
102  A1_ASSSM_b2, A2_ASSSM_b2, A3_ASSSM_b2,&
103  B1_ASSSM_b2, B2_ASSSM_b2, C1_ASSSM_b2, C2_ASSSM_b2,&
104  A1_CSSSM_b2, A2_CSSSM_b2, A3_CSSSM_b2,&
105  B1_CSSSM_b2, B2_CSSSM_b2, C1_CSSSM_b2, C2_CSSSM_b2,&
106  A1_SSSSM_b2, A2_SSSSM_b2, A3_SSSSM_b2,&
107  B1_SSSSM_b2, B2_SSSSM_b2, C1_SSSSM_b2, C2_SSSSM_b2
108 !$OMP THREADPRIVATE(A1_ASSSM_b1, A2_ASSSM_b1, A3_ASSSM_b1)
109 !$OMP THREADPRIVATE(B1_ASSSM_b1, B2_ASSSM_b1, C1_ASSSM_b1, C2_ASSSM_b1)
110 !$OMP THREADPRIVATE(A1_CSSSM_b1, A2_CSSSM_b1, A3_CSSSM_b1)
111 !$OMP THREADPRIVATE(B1_CSSSM_b1, B2_CSSSM_b1, C1_CSSSM_b1, C2_CSSSM_b1)
112 !$OMP THREADPRIVATE(A1_SSSSM_b1, A2_SSSSM_b1, A3_SSSSM_b1)
113 !$OMP THREADPRIVATE(B1_SSSSM_b1, B2_SSSSM_b1, C1_SSSSM_b1, C2_SSSSM_b1)
114 !$OMP THREADPRIVATE(A1_ASSSM_b2, A2_ASSSM_b2, A3_ASSSM_b2)
115 !$OMP THREADPRIVATE(B1_ASSSM_b2, B2_ASSSM_b2, C1_ASSSM_b2, C2_ASSSM_b2)
116 !$OMP THREADPRIVATE(A1_CSSSM_b2, A2_CSSSM_b2, A3_CSSSM_b2)
117 !$OMP THREADPRIVATE(B1_CSSSM_b2, B2_CSSSM_b2, C1_CSSSM_b2, C2_CSSSM_b2)
118 !$OMP THREADPRIVATE(A1_SSSSM_b2, A2_SSSSM_b2, A3_SSSSM_b2)
119 !$OMP THREADPRIVATE(B1_SSSSM_b2, B2_SSSSM_b2, C1_SSSSM_b2, C2_SSSSM_b2)
120 
121  REAL,PARAMETER :: RH_tab(nbre_rh)=(/0.,10.,20.,30.,40.,50.,60.,70.,80.,85.,90.,95./)
122  REAL, PARAMETER :: RH_MAX=95.
123  REAL:: DELTA(klon,klev), rh(klon,klev), H
124  REAL:: tau_ae2b_int ! Intermediate computation of epaisseur optique aerosol
125  REAL:: piz_ae2b_int ! Intermediate computation of Single scattering albedo
126  REAL:: cg_ae2b_int ! Intermediate computation of Assymetry parameter
127  REAL :: Fact_RH(nbre_rh)
128  REAL :: zrho
129  REAL :: fac
130  REAL :: zdp1(klon,klev)
131  REAL, PARAMETER :: gravit = 9.80616 ! m2/s
132  INTEGER, ALLOCATABLE, DIMENSION(:) :: aerosol_name
133  INTEGER :: nb_aer
134  REAL, DIMENSION(klon,klev,naero_tot) :: mass_temp
135 !RAF
136  REAL, DIMENSION(klon,klev,naero_tot) :: mass_temp_pi
137 
138  !
139  ! Proprietes optiques
140  !
141  REAL:: alpha_aers_2bands(nbre_rh,nbands,naero_soluble) !--unit m2/g SO4
142  REAL:: alpha_aeri_2bands(nbands,naero_insoluble)
143  REAL:: cg_aers_2bands(nbre_rh,nbands,naero_soluble) !--unit
144  REAL:: cg_aeri_2bands(nbands,naero_insoluble)
145  REAL:: piz_aers_2bands(nbre_rh,nbands,naero_soluble) !-- unit
146  REAL:: piz_aeri_2bands(nbands,naero_insoluble) !-- unit
147 
148  INTEGER :: id
149  LOGICAL :: used_aer(naero_tot)
150  REAL :: tmp_var, tmp_var_pi
151 
152  DATA presnivs_19/&
153  100426.5, 98327.6, 95346.5, 90966.8, 84776.9, &
154  76536.5, 66292.2, 54559.3, 42501.8, 31806, &
155  23787.5, 18252.7, 13996, 10320.8, 7191.1, &
156  4661.7, 2732.9, 1345.6, 388.2/
157 
158 
159 !***********************BAND 1***********************************
160 !ACCUMULATION MODE
161  DATA a1_asssm_b1_19/ 4.373e+00, 4.361e+00, 4.331e+00, &
162  4.278e+00, 4.223e+00, 4.162e+00, &
163  4.103e+00, 4.035e+00, 3.962e+00, &
164  3.904e+00, 3.871e+00, 3.847e+00, &
165  3.824e+00, 3.780e+00, 3.646e+00, &
166  3.448e+00, 3.179e+00, 2.855e+00, 2.630e+00/
167  DATA a2_asssm_b1_19/ 2.496e+00, 2.489e+00, 2.472e+00, &
168  2.442e+00, 2.411e+00, 2.376e+00, &
169  2.342e+00, 2.303e+00, 2.261e+00, &
170  2.228e+00, 2.210e+00, 2.196e+00, &
171  2.183e+00, 2.158e+00, 2.081e+00, &
172  1.968e+00, 1.814e+00, 1.630e+00, 1.501e+00/
173  DATA a3_asssm_b1_19/-4.688e-02, -4.676e-02, -4.644e-02, &
174  -4.587e-02, -4.528e-02, -4.463e-02, &
175  -4.399e-02, -4.326e-02, -4.248e-02, &
176  -4.186e-02, -4.151e-02, -4.125e-02, &
177  -4.100e-02, -4.053e-02, -3.910e-02, &
178  -3.697e-02, -3.408e-02, -3.061e-02, -2.819e-02/
179  DATA b1_asssm_b1_19/ 1.165e-08, 1.145e-08, 1.097e-08, &
180  1.012e-08, 9.233e-09, 8.261e-09, &
181  7.297e-09, 6.201e-09, 5.026e-09, &
182  4.098e-09, 3.567e-09, 3.187e-09, &
183  2.807e-09, 2.291e-09, 2.075e-09, &
184  1.756e-09, 1.322e-09, 8.011e-10, 4.379e-10/
185  DATA b2_asssm_b1_19/ 2.193e-08, 2.192e-08, 2.187e-08, &
186  2.179e-08, 2.171e-08, 2.162e-08, &
187  2.153e-08, 2.143e-08, 2.132e-08, &
188  2.124e-08, 2.119e-08, 2.115e-08, &
189  2.112e-08, 2.106e-08, 2.100e-08, &
190  2.090e-08, 2.077e-08, 2.061e-08, 2.049e-08/
191  DATA c1_asssm_b1_19/ 7.365e-01, 7.365e-01, 7.365e-01, &
192  7.364e-01, 7.363e-01, 7.362e-01, &
193  7.361e-01, 7.359e-01, 7.358e-01, &
194  7.357e-01, 7.356e-01, 7.356e-01, &
195  7.356e-01, 7.355e-01, 7.354e-01, &
196  7.352e-01, 7.350e-01, 7.347e-01, 7.345e-01/
197  DATA c2_asssm_b1_19/ 5.833e-02, 5.835e-02, 5.841e-02, &
198  5.850e-02, 5.859e-02, 5.870e-02, &
199  5.880e-02, 5.891e-02, 5.904e-02, &
200  5.914e-02, 5.920e-02, 5.924e-02, &
201  5.928e-02, 5.934e-02, 5.944e-02, &
202  5.959e-02, 5.979e-02, 6.003e-02, 6.020e-02/
203 !COARSE MODE
204  DATA a1_csssm_b1_19/ 7.403e-01, 7.422e-01, 7.626e-01, &
205  8.019e-01, 8.270e-01, 8.527e-01, &
206  8.702e-01, 8.806e-01, 8.937e-01, &
207  9.489e-01, 1.030e+00, 1.105e+00, &
208  1.199e+00, 1.357e+00, 1.660e+00, &
209  2.540e+00, 4.421e+00, 2.151e+00, 9.518e-01/
210  DATA a2_csssm_b1_19/ 4.522e-01, 4.532e-01, 4.644e-01, &
211  4.859e-01, 4.996e-01, 5.137e-01, &
212  5.233e-01, 5.290e-01, 5.361e-01, &
213  5.655e-01, 6.085e-01, 6.483e-01, &
214  6.979e-01, 7.819e-01, 9.488e-01, &
215  1.450e+00, 2.523e+00, 1.228e+00, 5.433e-01/
216  DATA a3_csssm_b1_19/-8.516e-03, -8.535e-03, -8.744e-03, &
217  -9.148e-03, -9.406e-03, -9.668e-03, &
218  -9.848e-03, -9.955e-03, -1.009e-02, &
219  -1.064e-02, -1.145e-02, -1.219e-02, &
220  -1.312e-02, -1.470e-02, -1.783e-02, &
221  -2.724e-02, -4.740e-02, -2.306e-02, -1.021e-02/
222  DATA b1_csssm_b1_19/ 2.535e-07, 2.530e-07, 2.479e-07, &
223  2.380e-07, 2.317e-07, 2.252e-07, &
224  2.208e-07, 2.182e-07, 2.149e-07, &
225  2.051e-07, 1.912e-07, 1.784e-07, &
226  1.624e-07, 1.353e-07, 1.012e-07, &
227  6.016e-08, 2.102e-08, 0.000e+00, 0.000e+00/
228  DATA b2_csssm_b1_19/ 1.221e-07, 1.217e-07, 1.179e-07, &
229  1.104e-07, 1.056e-07, 1.008e-07, &
230  9.744e-08, 9.546e-08, 9.299e-08, &
231  8.807e-08, 8.150e-08, 7.544e-08, &
232  6.786e-08, 5.504e-08, 4.080e-08, &
233  2.960e-08, 2.300e-08, 2.030e-08, 1.997e-08/
234  DATA c1_csssm_b1_19/ 7.659e-01, 7.658e-01, 7.652e-01, &
235  7.639e-01, 7.631e-01, 7.623e-01, &
236  7.618e-01, 7.614e-01, 7.610e-01, &
237  7.598e-01, 7.581e-01, 7.566e-01, &
238  7.546e-01, 7.513e-01, 7.472e-01, &
239  7.423e-01, 7.376e-01, 7.342e-01, 7.334e-01/
240  DATA c2_csssm_b1_19/ 3.691e-02, 3.694e-02, 3.729e-02, &
241  3.796e-02, 3.839e-02, 3.883e-02, &
242  3.913e-02, 3.931e-02, 3.953e-02, &
243  4.035e-02, 4.153e-02, 4.263e-02, &
244  4.400e-02, 4.631e-02, 4.933e-02, &
245  5.331e-02, 5.734e-02, 6.053e-02, 6.128e-02/
246 !SUPER COARSE MODE
247  DATA a1_ssssm_b1_19/ 2.836e-01, 2.876e-01, 2.563e-01, &
248  2.414e-01, 2.541e-01, 2.546e-01, &
249  2.572e-01, 2.638e-01, 2.781e-01, &
250  3.167e-01, 4.209e-01, 5.286e-01, &
251  6.959e-01, 9.233e-01, 1.282e+00, &
252  1.836e+00, 2.981e+00, 4.355e+00, 4.059e+00/
253  DATA a2_ssssm_b1_19/ 1.608e-01, 1.651e-01, 1.577e-01, &
254  1.587e-01, 1.686e-01, 1.690e-01, &
255  1.711e-01, 1.762e-01, 1.874e-01, &
256  2.138e-01, 2.751e-01, 3.363e-01, &
257  4.279e-01, 5.519e-01, 7.421e-01, &
258  1.048e+00, 1.702e+00, 2.485e+00, 2.317e+00/
259  DATA a3_ssssm_b1_19/-3.025e-03, -3.111e-03, -2.981e-03, &
260  -3.005e-03, -3.193e-03, -3.200e-03, &
261  -3.239e-03, -3.336e-03, -3.548e-03, &
262  -4.047e-03, -5.196e-03, -6.345e-03, &
263  -8.061e-03, -1.038e-02, -1.395e-02, &
264  -1.970e-02, -3.197e-02, -4.669e-02, -4.352e-02/
265  DATA b1_ssssm_b1_19/ 6.759e-07, 6.246e-07, 5.542e-07, &
266  4.953e-07, 4.746e-07, 4.738e-07, &
267  4.695e-07, 4.588e-07, 4.354e-07, &
268  3.947e-07, 3.461e-07, 3.067e-07, &
269  2.646e-07, 2.095e-07, 1.481e-07, &
270  9.024e-08, 5.747e-08, 2.384e-08, 6.599e-09/
271  DATA b2_ssssm_b1_19/ 5.977e-07, 5.390e-07, 4.468e-07, &
272  3.696e-07, 3.443e-07, 3.433e-07, &
273  3.380e-07, 3.249e-07, 2.962e-07, &
274  2.483e-07, 1.989e-07, 1.623e-07, &
275  1.305e-07, 9.015e-08, 6.111e-08, &
276  3.761e-08, 2.903e-08, 2.337e-08, 2.147e-08/
277  DATA c1_ssssm_b1_19/ 8.120e-01, 8.084e-01, 8.016e-01, &
278  7.953e-01, 7.929e-01, 7.928e-01, &
279  7.923e-01, 7.910e-01, 7.882e-01, &
280  7.834e-01, 7.774e-01, 7.725e-01, &
281  7.673e-01, 7.604e-01, 7.529e-01, &
282  7.458e-01, 7.419e-01, 7.379e-01, 7.360e-01/
283  DATA c2_ssssm_b1_19/ 2.388e-02, 2.392e-02, 2.457e-02, 2.552e-02, &
284  2.615e-02, 2.618e-02, 2.631e-02, 2.663e-02, &
285  2.735e-02, 2.875e-02, 3.113e-02, 3.330e-02, &
286  3.615e-02, 3.997e-02, 4.521e-02, 5.038e-02, &
287  5.358e-02, 5.705e-02, 5.887e-02/
288 !*********************BAND 2************************************************
289 !ACCUMULATION MODE
290  DATA a1_asssm_b2_19/1.256e+00, 1.246e+00, 1.226e+00, 1.187e+00, 1.148e+00, &
291  1.105e+00, 1.062e+00, 1.014e+00, 9.616e-01, 9.205e-01, &
292  8.970e-01, 8.800e-01, 8.632e-01, 8.371e-01, 7.943e-01, &
293  7.308e-01, 6.448e-01, 5.414e-01, 4.693e-01/
294  DATA a2_asssm_b2_19/5.321e-01, 5.284e-01, 5.196e-01, 5.036e-01, 4.872e-01, &
295  4.691e-01, 4.512e-01, 4.308e-01, 4.089e-01, 3.917e-01, &
296  3.818e-01, 3.747e-01, 3.676e-01, 3.567e-01, 3.385e-01, &
297  3.116e-01, 2.751e-01, 2.312e-01, 2.006e-01/
298  DATA a3_asssm_b2_19/-1.053e-02, -1.046e-02, -1.028e-02, -9.964e-03, -9.637e-03, &
299  -9.279e-03, -8.923e-03, -8.518e-03, -8.084e-03, -7.741e-03, &
300  -7.545e-03, -7.405e-03, -7.265e-03, -7.048e-03, -6.687e-03, &
301  -6.156e-03, -5.433e-03, -4.565e-03, -3.961e-03/
302  DATA b1_asssm_b2_19/1.560e-02, 1.560e-02, 1.561e-02, 1.565e-02, 1.568e-02, &
303  1.572e-02, 1.576e-02, 1.580e-02, 1.584e-02, 1.588e-02, &
304  1.590e-02, 1.592e-02, 1.593e-02, 1.595e-02, 1.599e-02, &
305  1.605e-02, 1.612e-02, 1.621e-02, 1.627e-02/
306  DATA b2_asssm_b2_19/1.073e-02, 1.074e-02, 1.076e-02, 1.079e-02, 1.082e-02, &
307  1.085e-02, 1.089e-02, 1.093e-02, 1.097e-02, 1.100e-02, &
308  1.102e-02, 1.103e-02, 1.105e-02, 1.107e-02, 1.110e-02, &
309  1.115e-02, 1.122e-02, 1.130e-02, 1.136e-02/
310  DATA c1_asssm_b2_19/7.429e-01, 7.429e-01, 7.429e-01, 7.427e-01, 7.427e-01, &
311  7.424e-01, 7.423e-01, 7.422e-01, 7.421e-01, 7.420e-01, &
312  7.419e-01, 7.419e-01, 7.418e-01, 7.417e-01, 7.416e-01, &
313  7.415e-01, 7.413e-01, 7.409e-01, 7.408e-01/
314  DATA c2_asssm_b2_19/3.031e-02, 3.028e-02, 3.022e-02, 3.011e-02, 2.999e-02, &
315  2.986e-02, 2.973e-02, 2.959e-02, 2.943e-02, 2.931e-02, &
316  2.924e-02, 2.919e-02, 2.913e-02, 2.905e-02, 2.893e-02, &
317  2.874e-02, 2.847e-02, 2.817e-02, 2.795e-02/
318 !COARSE MODE
319  DATA a1_csssm_b2_19/7.061e-01, 7.074e-01, 7.211e-01, 7.476e-01, 7.647e-01, &
320  7.817e-01, 7.937e-01, 8.007e-01, 8.095e-01, 8.436e-01, &
321  8.932e-01, 9.390e-01, 9.963e-01, 1.093e+00, 1.256e+00, &
322  1.668e+00, 1.581e+00, 3.457e-01, 1.331e-01/
323  DATA a2_csssm_b2_19/3.617e-01, 3.621e-01, 3.662e-01, 3.739e-01, 3.789e-01, &
324  3.840e-01, 3.874e-01, 3.895e-01, 3.921e-01, 4.001e-01, &
325  4.117e-01, 4.223e-01, 4.356e-01, 4.581e-01, 5.099e-01, &
326  6.831e-01, 6.663e-01, 1.481e-01, 5.703e-02/
327  DATA a3_csssm_b2_19/-6.953e-03, -6.961e-03, -7.048e-03, -7.216e-03, -7.322e-03, &
328  -7.431e-03, -7.506e-03, -7.551e-03, -7.606e-03, -7.791e-03, &
329  -8.059e-03, -8.305e-03, -8.613e-03, -9.134e-03, -1.023e-02, &
330  -1.365e-02, -1.320e-02, -2.922e-03, -1.125e-03/
331  DATA b1_csssm_b2_19/1.007e-02, 1.008e-02, 1.012e-02, 1.019e-02, 1.024e-02, &
332  1.029e-02, 1.033e-02, 1.035e-02, 1.038e-02, 1.056e-02, &
333  1.083e-02, 1.109e-02, 1.140e-02, 1.194e-02, 1.270e-02, &
334  1.390e-02, 1.524e-02, 1.639e-02, 1.667e-02/
335  DATA b2_csssm_b2_19/4.675e-03, 4.682e-03, 4.760e-03, 4.908e-03, 5.004e-03, &
336  5.102e-03, 5.168e-03, 5.207e-03, 5.256e-03, 5.474e-03, &
337  5.793e-03, 6.089e-03, 6.457e-03, 7.081e-03, 7.923e-03, &
338  9.127e-03, 1.041e-02, 1.147e-02, 1.173e-02/
339  DATA c1_csssm_b2_19/7.571e-01, 7.571e-01, 7.570e-01, 7.568e-01, 7.565e-01, &
340  7.564e-01, 7.563e-01, 7.562e-01, 7.562e-01, 7.557e-01, &
341  7.552e-01, 7.545e-01, 7.539e-01, 7.527e-01, 7.509e-01, &
342  7.478e-01, 7.440e-01, 7.404e-01, 7.394e-01/
343  DATA c2_csssm_b2_19/4.464e-02, 4.465e-02, 4.468e-02, 4.474e-02, 4.477e-02, &
344  4.480e-02, 4.482e-02, 4.484e-02, 4.486e-02, 4.448e-02, &
345  4.389e-02, 4.334e-02, 4.264e-02, 4.148e-02, 3.957e-02, &
346  3.588e-02, 3.149e-02, 2.751e-02, 2.650e-02/
347 !SUPER COARSE MODE
348  DATA a1_ssssm_b2_19/2.357e-01, 2.490e-01, 2.666e-01, 2.920e-01, 3.120e-01, &
349  3.128e-01, 3.169e-01, 3.272e-01, 3.498e-01, 3.960e-01, &
350  4.822e-01, 5.634e-01, 6.763e-01, 8.278e-01, 1.047e+00, &
351  1.340e+00, 1.927e+00, 1.648e+00, 1.031e+00/
352  DATA a2_ssssm_b2_19/1.219e-01, 1.337e-01, 1.633e-01, 1.929e-01, 2.057e-01, &
353  2.062e-01, 2.089e-01, 2.155e-01, 2.300e-01, 2.560e-01, &
354  2.908e-01, 3.199e-01, 3.530e-01, 3.965e-01, 4.475e-01, &
355  5.443e-01, 7.943e-01, 6.928e-01, 4.381e-01/
356  DATA a3_ssssm_b2_19/-2.387e-03, -2.599e-03, -3.092e-03, -3.599e-03, -3.832e-03, &
357  -3.842e-03, -3.890e-03, -4.012e-03, -4.276e-03, -4.763e-03, &
358  -5.455e-03, -6.051e-03, -6.763e-03, -7.708e-03, -8.887e-03, &
359  -1.091e-02, -1.585e-02, -1.373e-02, -8.665e-03/
360  DATA b1_ssssm_b2_19/1.260e-02, 1.211e-02, 1.126e-02, 1.056e-02, 1.038e-02, &
361  1.037e-02, 1.033e-02, 1.023e-02, 1.002e-02, 9.717e-03, &
362  9.613e-03, 9.652e-03, 9.983e-03, 1.047e-02, 1.168e-02, &
363  1.301e-02, 1.399e-02, 1.514e-02, 1.578e-02/
364  DATA b2_ssssm_b2_19/2.336e-03, 2.419e-03, 2.506e-03, 2.610e-03, 2.690e-03, &
365  2.694e-03, 2.711e-03, 2.752e-03, 2.844e-03, 3.043e-03, &
366  3.455e-03, 3.871e-03, 4.507e-03, 5.373e-03, 6.786e-03, &
367  8.238e-03, 9.208e-03, 1.032e-02, 1.091e-02/
368  DATA c1_ssssm_b2_19/7.832e-01, 7.787e-01, 7.721e-01, 7.670e-01, 7.657e-01, &
369  7.657e-01, 7.654e-01, 7.648e-01, 7.634e-01, 7.613e-01, &
370  7.596e-01, 7.585e-01, 7.574e-01, 7.560e-01, 7.533e-01, &
371  7.502e-01, 7.476e-01, 7.443e-01, 7.423e-01/
372  DATA c2_ssssm_b2_19/3.144e-02, 3.268e-02, 3.515e-02, 3.748e-02, 3.837e-02, &
373  3.840e-02, 3.860e-02, 3.906e-02, 4.006e-02, 4.173e-02, &
374  4.338e-02, 4.435e-02, 4.459e-02, 4.467e-02, 4.202e-02, &
375  3.864e-02, 3.559e-02, 3.183e-02, 2.964e-02/
376 !***************************************************************************
377 
378  spsol = 0
379  spinsol = 0
380  spss = 0
381 
382  DATA alpha_aers_2bands/ &
383  ! bc soluble
384  7.675,7.675,7.675,7.675,7.675,7.675, &
385  7.675,7.675,10.433,11.984,13.767,15.567,&
386  4.720,4.720,4.720,4.720,4.720,4.720, &
387  4.720,4.720,6.081,6.793,7.567,9.344, &
388  ! pom soluble
389  5.503,5.503,5.503,5.503,5.588,5.957, &
390  6.404,7.340,8.545,10.319,13.595,20.398, &
391  1.402,1.402,1.402,1.402,1.431,1.562, &
392  1.715,2.032,2.425,2.991,4.193,7.133, &
393  ! sulfate
394  4.681,5.062,5.460,5.798,6.224,6.733, &
395  7.556,8.613,10.687,12.265,16.32,21.692, &
396  1.107,1.239,1.381,1.490,1.635,1.8030, &
397  2.071,2.407,3.126,3.940,5.539,7.921, &
398  ! sulfate coarse
399  4.681,5.062,5.460,5.798,6.224,6.733, &
400  7.556,8.613,10.687,12.265,16.32,21.692, &
401  1.107,1.239,1.381,1.490,1.635,1.8030, &
402  2.071,2.407,3.126,3.940,5.539,7.921, &
403  ! seasalt Super Coarse Soluble (SS)
404  0.5090,0.6554,0.7129,0.7767,0.8529,1.2728, &
405  1.3820,1.5792,1.9173,2.2002,2.7173,4.1487, &
406  0.5167,0.6613,0.7221,0.7868,0.8622,1.3027, &
407  1.4227,1.6317,1.9887,2.2883,2.8356,4.3453, &
408  ! seasalt Coarse Soluble (CS)
409  0.5090,0.6554,0.7129,0.7767,0.8529,1.2728, &
410  1.3820,1.5792,1.9173,2.2002,2.7173,4.1487, &
411  0.5167,0.6613,0.7221,0.7868,0.8622,1.3027, &
412  1.4227,1.6317,1.9887,2.2883,2.8356,4.3453, &
413  ! seasalt Accumulation Soluble (AS)
414  4.125, 4.674, 5.005, 5.434, 5.985, 10.006, &
415  11.175,13.376,17.264,20.540,26.604, 42.349,&
416  4.187, 3.939, 3.919, 3.937, 3.995, 5.078, &
417  5.511, 6.434, 8.317,10.152,14.024, 26.537/
418 
419  DATA alpha_aeri_2bands/ &
420  ! dust insoluble
421  0.7661,0.7123,&
422  ! bc insoluble
423  10.360,4.437, &
424  ! pom insoluble
425  3.741,0.606/
426 
427  DATA cg_aers_2bands/ &
428  ! bc soluble
429  .612, .612, .612, .612, .612, .612, &
430  .612, .612, .702, .734, .760, .796, &
431  .433, .433, .433, .433, .433, .433, &
432  .433, .433, .534, .575, .613, .669, &
433  ! pom soluble
434  .663, .663, .663, .663, .666, .674, &
435  .685, .702, .718, .737, .757, .777, &
436  .544, .544, .544, .544, .547, .554, &
437  .565, .583, .604, .631, .661, .698, &
438  ! sulfate
439  .658, .669, .680, .688, .698, .707, &
440  .719, .733, .752, .760, .773, .786, &
441  .544, .555, .565, .573, .583, .593, &
442  .610, .628, .655, .666, .692, .719, &
443  ! sulfate coarse
444  .658, .669, .680, .688, .698, .707, &
445  .719, .733, .752, .760, .773, .786, &
446  .544, .555, .565, .573, .583, .593, &
447  .610, .628, .655, .666, .692, .719, &
448  ! seasalt Super Coarse soluble (SS)
449  .727, .747, .755, .761, .770, .788, &
450  .792, .799, .805, .809, .815, .826, &
451  .717, .738, .745, .752, .761, .779, &
452  .781, .786, .793, .797, .803, .813, &
453  ! seasalt Coarse soluble (CS)
454  .727, .747, .755, .761, .770, .788, &
455  .792, .799, .805, .809, .815, .826, &
456  .717, .738, .745, .752, .761, .779, &
457  .781, .786, .793, .797, .803, .813, &
458  ! Sesalt Accumulation Soluble (AS)
459  .727, .741, .748, .754, .761, .782, &
460  .787, .792, .797, .799, .801, .799, &
461  .606, .645, .658, .669, .681, .726, &
462  .734, .746, .761, .770, .782, .798/
463 
464  DATA cg_aeri_2bands/ &
465  ! dust insoluble
466  .701, .670, &
467  ! bc insoluble
468  .471, .297, &
469  ! pom insoluble
470  .568, .365/
471 
472  DATA piz_aers_2bands/&
473  ! bc soluble
474  .445, .445, .445, .445, .445, .445, &
475  .445, .445, .461, .480, .505, .528, &
476  .362, .362, .362, .362, .362, .362, &
477  .362, .362, .381, .405, .437, .483, &
478  ! pom soluble
479  .972, .972, .972, .972, .972, .974, &
480  .976, .979, .982, .986, .989, .992, &
481  .924, .924, .924, .924, .925, .927, &
482  .932, .938, .945, .952, .961, .970, &
483  ! sulfate
484  1.000,1.000,1.000,1.000,1.000,1.000, &
485  1.000,1.000,1.000,1.000,1.000,1.000, &
486  .992, .988, .988, .987, .986, .985, &
487  .985, .985, .984, .984, .984, .984, &
488  ! sulfate coarse
489  1.000,1.000,1.000,1.000,1.000,1.000, &
490  1.000,1.000,1.000,1.000,1.000,1.000, &
491  .992, .988, .988, .987, .986, .985, &
492  .985, .985, .984, .984, .984, .984, &
493  ! seasalt Super Coarse Soluble (SS)
494  1.000,1.000,1.000,1.000,1.000,1.000, &
495  1.000,1.000,1.000,1.000,1.000,1.000, &
496  0.992,0.989,0.987,0.986,0.986,0.980, &
497  0.980,0.978,0.976,0.976,0.974,0.971, &
498  ! seasalt Coarse soluble (CS)
499  1.000,1.000,1.000,1.000,1.000,1.000, &
500  1.000,1.000,1.000,1.000,1.000,1.000, &
501  0.992,0.989,0.987,0.986,0.986,0.980, &
502  0.980,0.978,0.976,0.976,0.974,0.971, &
503  ! seasalt Accumulation Soluble (AS)
504  1.000, 1.000, 1.000, 1.000, 1.000, 1.000, &
505  1.000, 1.000, 1.000, 1.000, 1.000, 1.000, &
506  0.970, 0.975, 0.976, 0.977, 0.978, 0.982, &
507  0.982, 0.983, 0.984, 0.984, 0.985, 0.985/
508 
509  DATA piz_aeri_2bands/ &
510  ! dust insoluble
511  .963, .987, &
512  ! bc insoluble
513  .395, .264, &
514  ! pom insoluble
515  .966, .859/
516 
517 ! Interpolation des coefficients optiques de 19 niveaux vers le nombre des niveaux du model
518  IF (firstcall) THEN
519  firstcall=.false.
520 
521  IF (.NOT. ALLOCATED(a1_asssm_b1)) THEN
522  ALLOCATE(a1_asssm_b1(klev),a2_asssm_b1(klev), a3_asssm_b1(klev),&
523  b1_asssm_b1(klev), b2_asssm_b1(klev), c1_asssm_b1(klev), c2_asssm_b1(klev),&
524  a1_csssm_b1(klev), a2_csssm_b1(klev), a3_csssm_b1(klev),&
525  b1_csssm_b1(klev), b2_csssm_b1(klev), c1_csssm_b1(klev), c2_csssm_b1(klev),&
526  a1_ssssm_b1(klev), a2_ssssm_b1(klev), a3_ssssm_b1(klev),&
527  b1_ssssm_b1(klev), b2_ssssm_b1(klev), c1_ssssm_b1(klev), c2_ssssm_b1(klev),&
528  a1_asssm_b2(klev), a2_asssm_b2(klev), a3_asssm_b2(klev),&
529  b1_asssm_b2(klev), b2_asssm_b2(klev), c1_asssm_b2(klev), c2_asssm_b2(klev),&
530  a1_csssm_b2(klev), a2_csssm_b2(klev), a3_csssm_b2(klev),&
531  b1_csssm_b2(klev), b2_csssm_b2(klev), c1_csssm_b2(klev), c2_csssm_b2(klev),&
532  a1_ssssm_b2(klev), a2_ssssm_b2(klev), a3_ssssm_b2(klev),&
533  b1_ssssm_b2(klev), b2_ssssm_b2(klev), c1_ssssm_b2(klev), c2_ssssm_b2(klev), stat=ierr)
534  IF (ierr /= 0) CALL abort_physic('aeropt_2bands', 'pb in allocation 1',1)
535  END IF
536 
537 ! bande 1
538  CALL pres2lev(a1_asssm_b1_19, a1_asssm_b1, nb_level, klev, presnivs_19, presnivs, 1, 1, .false.)
539  CALL pres2lev(a2_asssm_b1_19, a2_asssm_b1, nb_level, klev, presnivs_19, presnivs, 1, 1, .false.)
540  CALL pres2lev(a3_asssm_b1_19, a3_asssm_b1, nb_level, klev, presnivs_19, presnivs, 1, 1, .false.)
541  CALL pres2lev(b1_asssm_b1_19, b1_asssm_b1, nb_level, klev, presnivs_19, presnivs, 1, 1, .false.)
542  CALL pres2lev(b2_asssm_b1_19, b2_asssm_b1, nb_level, klev, presnivs_19, presnivs, 1, 1, .false.)
543  CALL pres2lev(c1_asssm_b1_19, c1_asssm_b1, nb_level, klev, presnivs_19, presnivs, 1, 1, .false.)
544  CALL pres2lev(c2_asssm_b1_19, c2_asssm_b1, nb_level, klev, presnivs_19, presnivs, 1, 1, .false.)
545 
546  CALL pres2lev(a1_csssm_b1_19, a1_csssm_b1, nb_level, klev, presnivs_19, presnivs, 1, 1, .false.)
547  CALL pres2lev(a2_csssm_b1_19, a2_csssm_b1, nb_level, klev, presnivs_19, presnivs, 1, 1, .false.)
548  CALL pres2lev(a3_csssm_b1_19, a3_csssm_b1, nb_level, klev, presnivs_19, presnivs, 1, 1, .false.)
549  CALL pres2lev(b1_csssm_b1_19, b1_csssm_b1, nb_level, klev, presnivs_19, presnivs, 1, 1, .false.)
550  CALL pres2lev(b2_csssm_b1_19, b2_csssm_b1, nb_level, klev, presnivs_19, presnivs, 1, 1, .false.)
551  CALL pres2lev(c1_csssm_b1_19, c1_csssm_b1, nb_level, klev, presnivs_19, presnivs, 1, 1, .false.)
552  CALL pres2lev(c2_csssm_b1_19, c2_csssm_b1, nb_level, klev, presnivs_19, presnivs, 1, 1, .false.)
553 
554  CALL pres2lev(a1_ssssm_b1_19, a1_ssssm_b1, nb_level, klev, presnivs_19, presnivs, 1, 1, .false.)
555  CALL pres2lev(a2_ssssm_b1_19, a2_ssssm_b1, nb_level, klev, presnivs_19, presnivs, 1, 1, .false.)
556  CALL pres2lev(a3_ssssm_b1_19, a3_ssssm_b1, nb_level, klev, presnivs_19, presnivs, 1, 1, .false.)
557  CALL pres2lev(b1_ssssm_b1_19, b1_ssssm_b1, nb_level, klev, presnivs_19, presnivs, 1, 1, .false.)
558  CALL pres2lev(b2_ssssm_b1_19, b2_ssssm_b1, nb_level, klev, presnivs_19, presnivs, 1, 1, .false.)
559  CALL pres2lev(c1_ssssm_b1_19, c1_ssssm_b1, nb_level, klev, presnivs_19, presnivs, 1, 1, .false.)
560  CALL pres2lev(c2_ssssm_b1_19, c2_ssssm_b1, nb_level, klev, presnivs_19, presnivs, 1, 1, .false.)
561 
562 ! bande 2
563  CALL pres2lev(a1_asssm_b2_19, a1_asssm_b2, nb_level, klev, presnivs_19, presnivs, 1, 1, .false.)
564  CALL pres2lev(a2_asssm_b2_19, a2_asssm_b2, nb_level, klev, presnivs_19, presnivs, 1, 1, .false.)
565  CALL pres2lev(a3_asssm_b2_19, a3_asssm_b2, nb_level, klev, presnivs_19, presnivs, 1, 1, .false.)
566  CALL pres2lev(b1_asssm_b2_19, b1_asssm_b2, nb_level, klev, presnivs_19, presnivs, 1, 1, .false.)
567  CALL pres2lev(b2_asssm_b2_19, b2_asssm_b2, nb_level, klev, presnivs_19, presnivs, 1, 1, .false.)
568  CALL pres2lev(c1_asssm_b2_19, c1_asssm_b2, nb_level, klev, presnivs_19, presnivs, 1, 1, .false.)
569  CALL pres2lev(c2_asssm_b2_19, c2_asssm_b2, nb_level, klev, presnivs_19, presnivs, 1, 1, .false.)
570 
571  CALL pres2lev(a1_csssm_b2_19, a1_csssm_b2, nb_level, klev, presnivs_19, presnivs, 1, 1, .false.)
572  CALL pres2lev(a2_csssm_b2_19, a2_csssm_b2, nb_level, klev, presnivs_19, presnivs, 1, 1, .false.)
573  CALL pres2lev(a3_csssm_b2_19, a3_csssm_b2, nb_level, klev, presnivs_19, presnivs, 1, 1, .false.)
574  CALL pres2lev(b1_csssm_b2_19, b1_csssm_b2, nb_level, klev, presnivs_19, presnivs, 1, 1, .false.)
575  CALL pres2lev(b2_csssm_b2_19, b2_csssm_b2, nb_level, klev, presnivs_19, presnivs, 1, 1, .false.)
576  CALL pres2lev(c1_csssm_b2_19, c1_csssm_b2, nb_level, klev, presnivs_19, presnivs, 1, 1, .false.)
577  CALL pres2lev(c2_csssm_b2_19, c2_csssm_b2, nb_level, klev, presnivs_19, presnivs, 1, 1, .false.)
578 
579  CALL pres2lev(a1_ssssm_b2_19, a1_ssssm_b2, nb_level, klev, presnivs_19, presnivs, 1, 1, .false.)
580  CALL pres2lev(a2_ssssm_b2_19, a2_ssssm_b2, nb_level, klev, presnivs_19, presnivs, 1, 1, .false.)
581  CALL pres2lev(a3_ssssm_b2_19, a3_ssssm_b2, nb_level, klev, presnivs_19, presnivs, 1, 1, .false.)
582  CALL pres2lev(b1_ssssm_b2_19, b1_ssssm_b2, nb_level, klev, presnivs_19, presnivs, 1, 1, .false.)
583  CALL pres2lev(b2_ssssm_b2_19, b2_ssssm_b2, nb_level, klev, presnivs_19, presnivs, 1, 1, .false.)
584  CALL pres2lev(c1_ssssm_b2_19, c1_ssssm_b2, nb_level, klev, presnivs_19, presnivs, 1, 1, .false.)
585  CALL pres2lev(c2_ssssm_b2_19, c2_ssssm_b2, nb_level, klev, presnivs_19, presnivs, 1, 1, .false.)
586 
587  END IF ! firstcall
588 
589 
590  DO k=1, klev
591  DO i=1, klon
592  zrho=pplay(i,k)/t_seri(i,k)/rd ! kg/m3
593  mass_temp(i,k,:) = m_allaer(i,k,:) / zrho / 1.e+9
594  mass_temp_pi(i,k,:) = m_allaer_pi(i,k,:) / zrho / 1.e+9
595  zdp1(i,k)=pdel(i,k)/(gravit*delt) ! air mass auxiliary variable --> zdp1 [kg/(m^2 *s)]
596  ENDDO
597  ENDDO
598 
599  IF (flag_aerosol .EQ. 1) THEN
600  nb_aer = 2
601  ALLOCATE (aerosol_name(nb_aer))
602  aerosol_name(1) = id_asso4m_phy
603  aerosol_name(2) = id_csso4m_phy
604  ELSEIF (flag_aerosol .EQ. 2) THEN
605  nb_aer = 2
606  ALLOCATE (aerosol_name(nb_aer))
607  aerosol_name(1) = id_asbcm_phy
608  aerosol_name(2) = id_aibcm_phy
609  ELSEIF (flag_aerosol .EQ. 3) THEN
610  nb_aer = 2
611  ALLOCATE (aerosol_name(nb_aer))
612  aerosol_name(1) = id_aspomm_phy
613  aerosol_name(2) = id_aipomm_phy
614  ELSEIF (flag_aerosol .EQ. 4) THEN
615  nb_aer = 3
616  ALLOCATE (aerosol_name(nb_aer))
617  aerosol_name(1) = id_csssm_phy
618  aerosol_name(2) = id_ssssm_phy
619  aerosol_name(3) = id_asssm_phy
620  ELSEIF (flag_aerosol .EQ. 5) THEN
621  nb_aer = 1
622  ALLOCATE (aerosol_name(nb_aer))
623  aerosol_name(1) = id_cidustm_phy
624  ELSEIF (flag_aerosol .EQ. 6) THEN
625  nb_aer = 10
626  ALLOCATE (aerosol_name(nb_aer))
627  aerosol_name(1) = id_asso4m_phy
628  aerosol_name(2) = id_asbcm_phy
629  aerosol_name(3) = id_aibcm_phy
630  aerosol_name(4) = id_aspomm_phy
631  aerosol_name(5) = id_aipomm_phy
632  aerosol_name(6) = id_csssm_phy
633  aerosol_name(7) = id_ssssm_phy
634  aerosol_name(8) = id_asssm_phy
635  aerosol_name(9) = id_cidustm_phy
636  aerosol_name(10)= id_csso4m_phy
637  ENDIF
638 
639 
640  !
641  ! loop over modes, use of precalculated nmd and corresponding sigma
642  ! loop over wavelengths
643  ! for each mass species in mode
644  ! interpolate from Sext to retrieve Sext_at_gridpoint_per_species
645  ! compute optical_thickness_at_gridpoint_per_species
646 
647 
648 
649 !CDIR ON_ADB(fact_RH)
650 !CDIR SHORTLOOP
651  DO n=1,nbre_rh-1
652  fact_rh(n)=1./(rh_tab(n+1)-rh_tab(n))
653  ENDDO
654 
655  DO k=1, klev
656 !CDIR ON_ADB(fact_RH)
657  DO i=1, klon
658  rh(i,k)=min(rhcl(i,k)*100.,rh_max)
659  rh_num(i,k) = int( rh(i,k)/10. + 1.)
660  IF (rh(i,k).GT.85.) rh_num(i,k)=10
661  IF (rh(i,k).GT.90.) rh_num(i,k)=11
662 
663  delta(i,k)=(rh(i,k)-rh_tab(rh_num(i,k)))*fact_rh(rh_num(i,k))
664  ENDDO
665  ENDDO
666 
667  used_aer(:)=.false.
668 
669  DO m=1,nb_aer ! tau is only computed for each mass
670  fac=1.0
671  IF (aerosol_name(m).EQ.id_asbcm_phy) THEN
672  soluble=.true.
673  spsol=1
674  spss=0
675  ELSEIF (aerosol_name(m).EQ.id_aspomm_phy) THEN
676  soluble=.true.
677  spsol=2
678  spss=0
679  ELSEIF (aerosol_name(m).EQ.id_asso4m_phy) THEN
680  soluble=.true.
681  spsol=3
682  spss=0
683  fac=1.375 ! (NH4)2-SO4/SO4 132/96 mass conversion factor for OD
684  ELSEIF (aerosol_name(m).EQ.id_csso4m_phy) THEN
685  soluble=.true.
686  spsol=4
687  spss=0
688  fac=1.375 ! (NH4)2-SO4/SO4 132/96 mass conversion factor for OD
689  ELSEIF (aerosol_name(m).EQ.id_ssssm_phy) THEN
690  soluble=.true.
691  spsol=5
692  spss=3
693  ELSEIF (aerosol_name(m).EQ.id_csssm_phy) THEN
694  soluble=.true.
695  spsol=6
696  spss=2
697  ELSEIF (aerosol_name(m).EQ.id_asssm_phy) THEN
698  soluble=.true.
699  spsol=7
700  spss=1
701  ELSEIF (aerosol_name(m).EQ.id_cidustm_phy) THEN
702  soluble=.false.
703  spinsol=1
704  spss=0
705  ELSEIF (aerosol_name(m).EQ.id_aibcm_phy) THEN
706  soluble=.false.
707  spinsol=2
708  spss=0
709  ELSEIF (aerosol_name(m).EQ.id_aipomm_phy) THEN
710  soluble=.false.
711  spinsol=3
712  spss=0
713  ELSE
714  cycle
715  ENDIF
716 
717  id=aerosol_name(m)
718  used_aer(id)=.true.
719 
720 
721  IF (soluble) THEN
722 
723  IF (spss.NE.0) THEN
724 
725  IF (spss.EQ.1) THEN !accumulation mode
726  DO k=1, klev
727 !CDIR ON_ADB(A1_ASSSM_b1)
728 !CDIR ON_ADB(A2_ASSSM_b1)
729 !CDIR ON_ADB(A3_ASSSM_b1)
730 !CDIR ON_ADB(B1_ASSSM_b1)
731 !CDIR ON_ADB(B2_ASSSM_b1)
732 !CDIR ON_ADB(C1_ASSSM_b1)
733 !CDIR ON_ADB(C2_ASSSM_b2)
734 !CDIR ON_ADB(A1_ASSSM_b2)
735 !CDIR ON_ADB(A2_ASSSM_b2)
736 !CDIR ON_ADB(A3_ASSSM_b2)
737 !CDIR ON_ADB(B1_ASSSM_b2)
738 !CDIR ON_ADB(B2_ASSSM_b2)
739 !CDIR ON_ADB(C1_ASSSM_b2)
740 !CDIR ON_ADB(C2_ASSSM_b2)
741  DO i=1, klon
742  h=rh(i,k)/100
743  tmp_var=mass_temp(i,k,spsol)*1000.*zdp1(i,k)*delt*fac
744  tmp_var_pi=mass_temp_pi(i,k,spsol)*1000.*zdp1(i,k)*delt*fac
745 
746  ! band 1
747  tau_ae2b_int=a1_asssm_b1(k)+a2_asssm_b1(k)*h+a3_asssm_b1(k)/(h-1.05)
748  piz_ae2b_int=1-b1_asssm_b1(k)-b2_asssm_b1(k)*h
749  cg_ae2b_int=c1_asssm_b1(k)+c2_asssm_b1(k)*h
750 
751  tau_ae(i,k,id,1) = tmp_var*tau_ae2b_int
752  tau_ae_pi(i,k,id,1) = tmp_var_pi* tau_ae2b_int
753  piz_ae(i,k,id,1) = piz_ae2b_int
754  cg_ae(i,k,id,1)= cg_ae2b_int
755 
756  !band 2
757  tau_ae2b_int=a1_asssm_b2(k)+a2_asssm_b2(k)*h+a3_asssm_b2(k)/(h-1.05)
758  piz_ae2b_int=1-b1_asssm_b2(k)-b2_asssm_b2(k)*h
759  cg_ae2b_int=c1_asssm_b2(k)+c2_asssm_b2(k)*h
760 
761  tau_ae(i,k,id,2) = tmp_var*tau_ae2b_int
762  tau_ae_pi(i,k,id,2) = tmp_var_pi* tau_ae2b_int
763  piz_ae(i,k,id,2) = piz_ae2b_int
764  cg_ae(i,k,id,2)= cg_ae2b_int
765 
766  ENDDO
767  ENDDO
768  ENDIF
769 
770  IF (spss.EQ.2) THEN !coarse mode
771  DO k=1, klev
772 !CDIR ON_ADB(A1_CSSSM_b1)
773 !CDIR ON_ADB(A2_CSSSM_b1)
774 !CDIR ON_ADB(A3_CSSSM_b1)
775 !CDIR ON_ADB(B1_CSSSM_b1)
776 !CDIR ON_ADB(B2_CSSSM_b1)
777 !CDIR ON_ADB(C1_CSSSM_b1)
778 !CDIR ON_ADB(C2_CSSSM_b2)
779 !CDIR ON_ADB(A1_CSSSM_b2)
780 !CDIR ON_ADB(A2_CSSSM_b2)
781 !CDIR ON_ADB(A3_CSSSM_b2)
782 !CDIR ON_ADB(B1_CSSSM_b2)
783 !CDIR ON_ADB(B2_CSSSM_b2)
784 !CDIR ON_ADB(C1_CSSSM_b2)
785 !CDIR ON_ADB(C2_CSSSM_b2)
786  DO i=1, klon
787  h=rh(i,k)/100
788  tmp_var=mass_temp(i,k,spsol)*1000.*zdp1(i,k)*delt*fac
789  tmp_var_pi=mass_temp_pi(i,k,spsol)*1000.*zdp1(i,k)*delt*fac
790  ! band 1
791  tau_ae2b_int=a1_csssm_b1(k)+a2_csssm_b1(k)*h+a3_csssm_b1(k)/(h-1.05)
792  piz_ae2b_int=1-b1_csssm_b1(k)-b2_csssm_b1(k)*h
793  cg_ae2b_int=c1_csssm_b1(k)+c2_csssm_b1(k)*h
794 
795  tau_ae(i,k,id,1) = tmp_var*tau_ae2b_int
796  tau_ae_pi(i,k,id,1) = tmp_var_pi* tau_ae2b_int
797  piz_ae(i,k,id,1) = piz_ae2b_int
798  cg_ae(i,k,id,1)= cg_ae2b_int
799 
800  ! band 2
801  tau_ae2b_int=a1_csssm_b2(k)+a2_csssm_b2(k)*h+a3_csssm_b2(k)/(h-1.05)
802  piz_ae2b_int=1-b1_csssm_b2(k)-b2_csssm_b2(k)*h
803  cg_ae2b_int=c1_csssm_b2(k)+c2_csssm_b2(k)*h
804 
805  tau_ae(i,k,id,2) = tmp_var*tau_ae2b_int
806  tau_ae_pi(i,k,id,2) = tmp_var_pi* tau_ae2b_int
807  piz_ae(i,k,id,2) = piz_ae2b_int
808  cg_ae(i,k,id,2)= cg_ae2b_int
809 
810  ENDDO
811  ENDDO
812  ENDIF
813 
814  IF (spss.EQ.3) THEN !super coarse mode
815  DO k=1, klev
816 !CDIR ON_ADB(A1_SSSSM_b1)
817 !CDIR ON_ADB(A2_SSSSM_b1)
818 !CDIR ON_ADB(A3_SSSSM_b1)
819 !CDIR ON_ADB(B1_SSSSM_b1)
820 !CDIR ON_ADB(B2_SSSSM_b1)
821 !CDIR ON_ADB(C1_SSSSM_b1)
822 !CDIR ON_ADB(C2_SSSSM_b2)
823 !CDIR ON_ADB(A1_SSSSM_b2)
824 !CDIR ON_ADB(A2_SSSSM_b2)
825 !CDIR ON_ADB(A3_SSSSM_b2)
826 !CDIR ON_ADB(B1_SSSSM_b2)
827 !CDIR ON_ADB(B2_SSSSM_b2)
828 !CDIR ON_ADB(C1_SSSSM_b2)
829 !CDIR ON_ADB(C2_SSSSM_b2)
830  DO i=1, klon
831  h=rh(i,k)/100
832  tmp_var=mass_temp(i,k,spsol)*1000.*zdp1(i,k)*delt*fac
833  tmp_var_pi=mass_temp_pi(i,k,spsol)*1000.*zdp1(i,k)*delt*fac
834 
835  ! band 1
836  tau_ae2b_int=a1_ssssm_b1(k)+a2_ssssm_b1(k)*h+a3_ssssm_b1(k)/(h-1.05)
837  piz_ae2b_int=1-b1_ssssm_b1(k)-b2_ssssm_b1(k)*h
838  cg_ae2b_int=c1_ssssm_b1(k)+c2_ssssm_b1(k)*h
839 
840  tau_ae(i,k,id,1) = tmp_var*tau_ae2b_int
841  tau_ae_pi(i,k,id,1) = tmp_var_pi* tau_ae2b_int
842  piz_ae(i,k,id,1) = piz_ae2b_int
843  cg_ae(i,k,id,1)= cg_ae2b_int
844 
845  ! band 2
846  tau_ae2b_int=a1_ssssm_b2(k)+a2_ssssm_b2(k)*h+a3_ssssm_b2(k)/(h-1.05)
847  piz_ae2b_int=1-b1_ssssm_b2(k)-b2_ssssm_b2(k)*h
848  cg_ae2b_int=c1_ssssm_b2(k)+c2_ssssm_b2(k)*h
849 
850  tau_ae(i,k,id,2) = tmp_var*tau_ae2b_int
851  tau_ae_pi(i,k,id,2) = tmp_var_pi* tau_ae2b_int
852  piz_ae(i,k,id,2) = piz_ae2b_int
853  cg_ae(i,k,id,2)= cg_ae2b_int
854 
855  ENDDO
856  ENDDO
857  ENDIF
858 
859  ELSE
860 
861 !CDIR ON_ADB(alpha_aers_2bands)
862 !CDIR ON_ADB(piz_aers_2bands)
863 !CDIR ON_ADB(cg_aers_2bands)
864  DO k=1, klev
865  DO i=1, klon
866  tmp_var=mass_temp(i,k,spsol)*1000.*zdp1(i,k)*delt*fac
867  tmp_var_pi=mass_temp_pi(i,k,spsol)*1000.*zdp1(i,k)*delt*fac
868 !CDIR UNROLL=nbands
869  DO inu=1,nbands
870 
871  tau_ae2b_int= alpha_aers_2bands(rh_num(i,k),inu,spsol)+ &
872  delta(i,k)* (alpha_aers_2bands(rh_num(i,k)+1,inu,spsol) - &
873  alpha_aers_2bands(rh_num(i,k),inu,spsol))
874 
875  piz_ae2b_int = piz_aers_2bands(rh_num(i,k),inu,spsol) + &
876  delta(i,k)* (piz_aers_2bands(rh_num(i,k)+1,inu,spsol) - &
877  piz_aers_2bands(rh_num(i,k),inu,spsol))
878 
879  cg_ae2b_int = cg_aers_2bands(rh_num(i,k),inu,spsol) + &
880  delta(i,k)* (cg_aers_2bands(rh_num(i,k)+1,inu,spsol) - &
881  cg_aers_2bands(rh_num(i,k),inu,spsol))
882 
883  tau_ae(i,k,id,inu) = tmp_var*tau_ae2b_int
884  tau_ae_pi(i,k,id,inu) = tmp_var_pi* tau_ae2b_int
885  piz_ae(i,k,id,inu) = piz_ae2b_int
886  cg_ae(i,k,id,inu)= cg_ae2b_int
887 
888  ENDDO
889  ENDDO
890  ENDDO
891 
892  ENDIF
893 
894  ELSE ! For all aerosol insoluble components
895 
896 !CDIR ON_ADB(alpha_aers_2bands)
897 !CDIR ON_ADB(piz_aers_2bands)
898 !CDIR ON_ADB(cg_aers_2bands)
899  DO k=1, klev
900  DO i=1, klon
901  tmp_var=mass_temp(i,k,naero_soluble+ spinsol)*1000.*zdp1(i,k)*delt*fac
902  tmp_var_pi=mass_temp_pi(i,k,naero_soluble+spinsol)*1000.*zdp1(i,k)*delt*fac
903 !CDIR UNROLL=nbands
904  DO inu=1,nbands
905  tau_ae2b_int = alpha_aeri_2bands(inu,spinsol)
906  piz_ae2b_int = piz_aeri_2bands(inu,spinsol)
907  cg_ae2b_int = cg_aeri_2bands(inu,spinsol)
908 
909  tau_ae(i,k,id,inu) = tmp_var*tau_ae2b_int
910  tau_ae_pi(i,k,id,inu) = tmp_var_pi*tau_ae2b_int
911  piz_ae(i,k,id,inu) = piz_ae2b_int
912  cg_ae(i,k,id,inu)= cg_ae2b_int
913  ENDDO
914  ENDDO
915  ENDDO
916 
917  ENDIF ! soluble
918 
919  ENDDO ! nb_aer
920 
921 !correction bug OB
922 ! DO m=1,nb_aer
923  DO m=1,naero_tot
924  IF (.NOT. used_aer(m)) THEN
925  tau_ae(:,:,m,:)=0.
926  tau_ae_pi(:,:,m,:)=0.
927  piz_ae(:,:,m,:)=0.
928  cg_ae(:,:,m,:)=0.
929  ENDIF
930  ENDDO
931 
932  DO inu=1, nbands
933  DO mrfspecies=1,naero_grp
934  IF (mrfspecies .EQ. 2) THEN ! = total aerosol AER
935  DO k=1, klev
936  DO i=1, klon
937  tau_allaer(i,k,mrfspecies,inu)=tau_ae(i,k,id_asso4m_phy,inu)+tau_ae(i,k,id_csso4m_phy,inu)+ &
938  tau_ae(i,k,id_asbcm_phy,inu)+tau_ae(i,k,id_aibcm_phy,inu)+ &
939  tau_ae(i,k,id_aspomm_phy,inu)+tau_ae(i,k,id_aipomm_phy,inu)+ &
940  tau_ae(i,k,id_asssm_phy,inu)+tau_ae(i,k,id_csssm_phy,inu)+ &
941  tau_ae(i,k,id_ssssm_phy,inu)+ tau_ae(i,k,id_cidustm_phy,inu)
942  tau_allaer(i,k,mrfspecies,inu)=max(tau_allaer(i,k,mrfspecies,inu),1e-5)
943 
944  piz_allaer(i,k,mrfspecies,inu)=(tau_ae(i,k,id_asso4m_phy,inu)*piz_ae(i,k,id_asso4m_phy,inu)+ &
945  tau_ae(i,k,id_csso4m_phy,inu)*piz_ae(i,k,id_csso4m_phy,inu)+ &
946  tau_ae(i,k,id_asbcm_phy,inu)*piz_ae(i,k,id_asbcm_phy,inu)+ &
947  tau_ae(i,k,id_aibcm_phy,inu)*piz_ae(i,k,id_aibcm_phy,inu)+ &
948  tau_ae(i,k,id_aspomm_phy,inu)*piz_ae(i,k,id_aspomm_phy,inu)+ &
949  tau_ae(i,k,id_aipomm_phy,inu)*piz_ae(i,k,id_aipomm_phy,inu)+ &
950  tau_ae(i,k,id_asssm_phy,inu)*piz_ae(i,k,id_asssm_phy,inu)+ &
951  tau_ae(i,k,id_csssm_phy,inu)*piz_ae(i,k,id_csssm_phy,inu)+ &
952  tau_ae(i,k,id_ssssm_phy,inu)*piz_ae(i,k,id_ssssm_phy,inu)+ &
953  tau_ae(i,k,id_cidustm_phy,inu)*piz_ae(i,k,id_cidustm_phy,inu)) &
954  /tau_allaer(i,k,mrfspecies,inu)
955  piz_allaer(i,k,mrfspecies,inu)=max(piz_allaer(i,k,mrfspecies,inu),0.1)
956 
957  cg_allaer(i,k,mrfspecies,inu)=(tau_ae(i,k,id_asso4m_phy,inu)* &
958  piz_ae(i,k,id_asso4m_phy,inu)*cg_ae(i,k,id_asso4m_phy,inu)+ &
959  tau_ae(i,k,id_csso4m_phy,inu)*piz_ae(i,k,id_csso4m_phy,inu)* &
960  cg_ae(i,k,id_csso4m_phy,inu)+ &
961  tau_ae(i,k,id_asbcm_phy,inu)*piz_ae(i,k,id_asbcm_phy,inu)* &
962  cg_ae(i,k,id_asbcm_phy,inu)+ &
963  tau_ae(i,k,id_aibcm_phy,inu)*piz_ae(i,k,id_aibcm_phy,inu)* &
964  cg_ae(i,k,id_aibcm_phy,inu)+ &
965  tau_ae(i,k,id_aspomm_phy,inu)*piz_ae(i,k,id_aspomm_phy,inu)* &
966  cg_ae(i,k,id_aspomm_phy,inu)+ &
967  tau_ae(i,k,id_aipomm_phy,inu)*piz_ae(i,k,id_aipomm_phy,inu)* &
968  cg_ae(i,k,id_aipomm_phy,inu)+ &
969  tau_ae(i,k,id_asssm_phy,inu)*piz_ae(i,k,id_asssm_phy,inu)* &
970  cg_ae(i,k,id_asssm_phy,inu)+ &
971  tau_ae(i,k,id_csssm_phy,inu)*piz_ae(i,k,id_csssm_phy,inu)* &
972  cg_ae(i,k,id_csssm_phy,inu)+ &
973  tau_ae(i,k,id_ssssm_phy,inu)*piz_ae(i,k,id_ssssm_phy,inu)* &
974  cg_ae(i,k,id_ssssm_phy,inu)+ &
975  tau_ae(i,k,id_cidustm_phy,inu)*piz_ae(i,k,id_cidustm_phy,inu)* &
976  cg_ae(i,k,id_cidustm_phy,inu))/ &
977  (tau_allaer(i,k,mrfspecies,inu)*piz_allaer(i,k,mrfspecies,inu))
978  ENDDO
979  ENDDO
980 
981  ELSEIF (mrfspecies .EQ. 3) THEN ! = natural aerosol NAT
982 
983  DO k=1, klev
984  DO i=1, klon
985 
986  tau_allaer(i,k,mrfspecies,inu)=tau_ae_pi(i,k,id_asso4m_phy,inu)+ &
987  tau_ae_pi(i,k,id_csso4m_phy,inu)+ &
988  tau_ae_pi(i,k,id_asbcm_phy,inu)+ &
989  tau_ae_pi(i,k,id_aibcm_phy,inu)+ &
990  tau_ae_pi(i,k,id_aspomm_phy,inu)+ &
991  tau_ae_pi(i,k,id_aipomm_phy,inu)+ &
992  tau_ae_pi(i,k,id_asssm_phy,inu)+ &
993  tau_ae_pi(i,k,id_csssm_phy,inu)+ &
994  tau_ae_pi(i,k,id_ssssm_phy,inu)+ &
995  tau_ae_pi(i,k,id_cidustm_phy,inu)
996  tau_allaer(i,k,mrfspecies,inu)=max(tau_allaer(i,k,mrfspecies,inu),1e-5)
997 
998  piz_allaer(i,k,mrfspecies,inu)=(tau_ae_pi(i,k,id_asso4m_phy,inu)*piz_ae(i,k,id_asso4m_phy,inu)+ &
999  tau_ae_pi(i,k,id_csso4m_phy,inu)*piz_ae(i,k,id_csso4m_phy,inu)+ &
1000  tau_ae_pi(i,k,id_asbcm_phy,inu)*piz_ae(i,k,id_asbcm_phy,inu)+ &
1001  tau_ae_pi(i,k,id_aibcm_phy,inu)*piz_ae(i,k,id_aibcm_phy,inu)+ &
1002  tau_ae_pi(i,k,id_aspomm_phy,inu)*piz_ae(i,k,id_aspomm_phy,inu)+ &
1003  tau_ae_pi(i,k,id_aipomm_phy,inu)*piz_ae(i,k,id_aipomm_phy,inu)+ &
1004  tau_ae_pi(i,k,id_asssm_phy,inu)*piz_ae(i,k,id_asssm_phy,inu)+ &
1005  tau_ae_pi(i,k,id_csssm_phy,inu)*piz_ae(i,k,id_csssm_phy,inu)+ &
1006  tau_ae_pi(i,k,id_ssssm_phy,inu)*piz_ae(i,k,id_ssssm_phy,inu)+ &
1007  tau_ae_pi(i,k,id_cidustm_phy,inu)*piz_ae(i,k,id_cidustm_phy,inu)) &
1008  /tau_allaer(i,k,mrfspecies,inu)
1009  piz_allaer(i,k,mrfspecies,inu)=max(piz_allaer(i,k,mrfspecies,inu),0.1)
1010 
1011  cg_allaer(i,k,mrfspecies,inu)=(&
1012  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)+ &
1013  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)+ &
1014  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)+ &
1015  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)+ &
1016  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)+ &
1017  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)+ &
1018  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)+ &
1019  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)+ &
1020  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)+ &
1021  tau_ae_pi(i,k,id_cidustm_phy,inu)*piz_ae(i,k,id_cidustm_phy,inu)*&
1022  cg_ae(i,k,id_cidustm_phy,inu))/ &
1023  (tau_allaer(i,k,mrfspecies,inu)*piz_allaer(i,k,mrfspecies,inu))
1024  ENDDO
1025  ENDDO
1026 
1027  ELSEIF (mrfspecies .EQ. 4) THEN ! = BC
1028  DO k=1, klev
1029  DO i=1, klon
1030  tau_allaer(i,k,mrfspecies,inu)=tau_ae(i,k,id_asbcm_phy,inu)+tau_ae(i,k,id_aibcm_phy,inu)
1031  tau_allaer(i,k,mrfspecies,inu)=max(tau_allaer(i,k,mrfspecies,inu),1e-5)
1032  piz_allaer(i,k,mrfspecies,inu)=(tau_ae(i,k,id_asbcm_phy,inu)*piz_ae(i,k,id_asbcm_phy,inu) &
1033  +tau_ae(i,k,id_aibcm_phy,inu)*piz_ae(i,k,id_aibcm_phy,inu))/ &
1034  tau_allaer(i,k,mrfspecies,inu)
1035  piz_allaer(i,k,mrfspecies,inu)=max(piz_allaer(i,k,mrfspecies,inu),0.1)
1036  cg_allaer(i,k,mrfspecies,inu)=(tau_ae(i,k,id_asbcm_phy,inu)*piz_ae(i,k,id_asbcm_phy,inu) *cg_ae(i,k,id_asbcm_phy,inu)&
1037  +tau_ae(i,k,id_aibcm_phy,inu)*piz_ae(i,k,id_aibcm_phy,inu)*cg_ae(i,k,id_aibcm_phy,inu))/ &
1038  (tau_allaer(i,k,mrfspecies,inu)*piz_allaer(i,k,mrfspecies,inu))
1039  ENDDO
1040  ENDDO
1041 
1042  ELSEIF (mrfspecies .EQ. 5) THEN ! = SO4
1043 
1044  DO k=1, klev
1045  DO i=1, klon
1046  tau_allaer(i,k,mrfspecies,inu)=tau_ae(i,k,id_asso4m_phy,inu)+tau_ae(i,k,id_csso4m_phy,inu)
1047  tau_allaer(i,k,mrfspecies,inu)=max(tau_allaer(i,k,mrfspecies,inu),1e-5)
1048  piz_allaer(i,k,mrfspecies,inu)=(tau_ae(i,k,id_csso4m_phy,inu)*piz_ae(i,k,id_csso4m_phy,inu) &
1049  +tau_ae(i,k,id_asso4m_phy,inu)*piz_ae(i,k,id_asso4m_phy,inu))/ &
1050  tau_allaer(i,k,mrfspecies,inu)
1051  piz_allaer(i,k,mrfspecies,inu)=max(piz_allaer(i,k,mrfspecies,inu),0.1)
1052  cg_allaer(i,k,mrfspecies,inu)=(tau_ae(i,k,id_csso4m_phy,inu)* &
1053  piz_ae(i,k,id_csso4m_phy,inu) *cg_ae(i,k,id_csso4m_phy,inu)&
1054  +tau_ae(i,k,id_asso4m_phy,inu)*piz_ae(i,k,id_asso4m_phy,inu)* &
1055  cg_ae(i,k,id_asso4m_phy,inu))/ &
1056  (tau_allaer(i,k,mrfspecies,inu)*piz_allaer(i,k,mrfspecies,inu))
1057  ENDDO
1058  ENDDO
1059 
1060  ELSEIF (mrfspecies .EQ. 6) THEN ! = POM
1061 
1062  DO k=1, klev
1063  DO i=1, klon
1064  tau_allaer(i,k,mrfspecies,inu)=tau_ae(i,k,id_aspomm_phy,inu)+tau_ae(i,k,id_aipomm_phy,inu)
1065  tau_allaer(i,k,mrfspecies,inu)=max(tau_allaer(i,k,mrfspecies,inu),1e-5)
1066  piz_allaer(i,k,mrfspecies,inu)=(tau_ae(i,k,id_aspomm_phy,inu)*piz_ae(i,k,id_aspomm_phy,inu) &
1067  +tau_ae(i,k,id_aipomm_phy,inu)*piz_ae(i,k,id_aipomm_phy,inu))/ &
1068  tau_allaer(i,k,mrfspecies,inu)
1069  piz_allaer(i,k,mrfspecies,inu)=max(piz_allaer(i,k,mrfspecies,inu),0.1)
1070  cg_allaer(i,k,mrfspecies,inu)=(tau_ae(i,k,id_aspomm_phy,inu)*piz_ae(i,k,id_aspomm_phy,inu)*cg_ae(i,k,id_aspomm_phy,inu)&
1071  +tau_ae(i,k,id_aipomm_phy,inu)*piz_ae(i,k,id_aipomm_phy,inu)*cg_ae(i,k,id_aipomm_phy,inu))/ &
1072  (tau_allaer(i,k,mrfspecies,inu)*piz_allaer(i,k,mrfspecies,inu))
1073  ENDDO
1074  ENDDO
1075 
1076  ELSEIF (mrfspecies .EQ. 7) THEN ! = DUST
1077 
1078  DO k=1, klev
1079  DO i=1, klon
1080  tau_allaer(i,k,mrfspecies,inu)=tau_ae(i,k,id_cidustm_phy,inu)
1081  tau_allaer(i,k,mrfspecies,inu)=max(tau_allaer(i,k,mrfspecies,inu),1e-5)
1082  piz_allaer(i,k,mrfspecies,inu)=piz_ae(i,k,id_cidustm_phy,inu)
1083  cg_allaer(i,k,mrfspecies,inu)=cg_ae(i,k,id_cidustm_phy,inu)
1084  ENDDO
1085  ENDDO
1086 
1087  ELSEIF (mrfspecies .EQ. 8) THEN ! = SS
1088 
1089  DO k=1, klev
1090  DO i=1, klon
1091  tau_allaer(i,k,mrfspecies,inu)=tau_ae(i,k,id_asssm_phy,inu)+tau_ae(i,k,id_csssm_phy,inu)+tau_ae(i,k,id_ssssm_phy,inu)
1092  tau_allaer(i,k,mrfspecies,inu)=max(tau_allaer(i,k,mrfspecies,inu),1e-5)
1093  piz_allaer(i,k,mrfspecies,inu)=(tau_ae(i,k,id_asssm_phy,inu)*piz_ae(i,k,id_asssm_phy,inu) &
1094  +tau_ae(i,k,id_csssm_phy,inu)*piz_ae(i,k,id_csssm_phy,inu) &
1095  +tau_ae(i,k,id_ssssm_phy,inu)*piz_ae(i,k,id_ssssm_phy,inu))/ &
1096  tau_allaer(i,k,mrfspecies,inu)
1097  piz_allaer(i,k,mrfspecies,inu)=max(piz_allaer(i,k,mrfspecies,inu),0.1)
1098  cg_allaer(i,k,mrfspecies,inu)=(tau_ae(i,k,id_asssm_phy,inu)*piz_ae(i,k,id_asssm_phy,inu) *cg_ae(i,k,id_asssm_phy,inu)&
1099  +tau_ae(i,k,id_csssm_phy,inu)*piz_ae(i,k,id_csssm_phy,inu)*cg_ae(i,k,id_csssm_phy,inu) &
1100  +tau_ae(i,k,id_ssssm_phy,inu)*piz_ae(i,k,id_ssssm_phy,inu)*cg_ae(i,k,id_ssssm_phy,inu))/ &
1101  (tau_allaer(i,k,mrfspecies,inu)*piz_allaer(i,k,mrfspecies,inu))
1102  ENDDO
1103  ENDDO
1104 
1105  ELSEIF (mrfspecies .EQ. 9) THEN ! = NO3
1106 
1107  DO k=1, klev
1108  DO i=1, klon
1109  tau_allaer(i,k,mrfspecies,inu)=0. ! preliminary
1110  piz_allaer(i,k,mrfspecies,inu)=0.
1111  cg_allaer(i,k,mrfspecies,inu)=0.
1112  ENDDO
1113  ENDDO
1114 
1115  ELSE
1116 
1117  DO k=1, klev
1118  DO i=1, klon
1119  tau_allaer(i,k,mrfspecies,inu)=0.
1120  piz_allaer(i,k,mrfspecies,inu)=0.
1121  cg_allaer(i,k,mrfspecies,inu)=0.
1122  ENDDO
1123  ENDDO
1124 
1125  ENDIF
1126 
1127  ENDDO
1128  ENDDO
1129 
1130  inu=1
1131  DO i=1, klon
1132  absvisaer(i)=sum((1-piz_allaer(i,:,:,inu))*tau_allaer(i,:,:,inu))
1133  ENDDO
1134 
1135  DEALLOCATE(aerosol_name)
1136 
1137 END SUBROUTINE aeropt_2bands
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
aero_mod::nbands
integer, parameter nbands
Definition: aero_mod.F90:94
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
aero_mod::id_csssm_phy
integer, parameter id_csssm_phy
Definition: aero_mod.F90:19
dimphy::klev
integer, save klev
Definition: dimphy.F90:7
aeropt_2bands
subroutine aeropt_2bands(pdel, m_allaer, delt, RHcl, tau_allaer, piz_allaer, cg_allaer, m_allaer_pi, flag_aerosol, pplay, t_seri, presnivs)
Definition: aeropt_2bands.F90:9
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
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::absvisaer
real, dimension(:), allocatable, save absvisaer
Definition: phys_local_var_mod.F90:161
aero_mod
Definition: aero_mod.F90:3
pres2lev_mod
Definition: pres2lev_mod.F90:3
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::naero_tot
integer, parameter naero_tot
Definition: aero_mod.F90:10
aero_mod::id_csso4m_phy
integer, parameter id_csso4m_phy
Definition: aero_mod.F90:17
dimphy
Definition: dimphy.F90:1
aero_mod::naero_grp
integer, parameter naero_grp
Definition: aero_mod.F90:64
aero_mod::id_cidustm_phy
integer, parameter id_cidustm_phy
Definition: aero_mod.F90:21