source: LMDZ6/trunk/libf/phylmd/aeropt_5wv.F90 @ 3210

Last change on this file since 3210 was 2634, checked in by oboucher, 10 years ago

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