source: LMDZ5/trunk/libf/phylmd/aeropt_2bands.F90 @ 2120

Last change on this file since 2120 was 2003, checked in by Laurent Fairhead, 11 years ago

Nouvelle version qui inclut les effets des aérosols et propose les mêmes diagnostics des effets
directs et indirects que l'ancienne version du rayonnement.
OB


New RRTM version that includes the effects of aerosols and outputs the same direct and indirect effects
diagnostics as the old version
OB

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