source: LMDZ4/branches/LMDZ4-dev/libf/phylmd/aeropt_5wv.F90 @ 1254

Last change on this file since 1254 was 1254, checked in by yann meurdesoif, 15 years ago

Correction de la regression de la version 1246 sur les datas aerosols.

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