source: LMDZ4/branches/LMDZ4V5.0-dev/libf/phylmd/aeropt_5wv.F90 @ 5423

Last change on this file since 5423 was 1347, checked in by Laurent Fairhead, 15 years ago

Additions to aerosol outputs for CMIP5 exercise
(Needed because of chageset r1346 LF)

Additions aux sorties aérosols pour l'exercice CMIP5
(Nécessaires suite au changeset r1346 LF)

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