source: LMDZ4/trunk/libf/phylmd/aeropt_5wv.F90 @ 1337

Last change on this file since 1337 was 1337, checked in by Laurent Fairhead, 14 years ago

Additions to aerosol outputs for CMIP5 exercise

Additions aux sorties aérosols pour l'exercice CMIP5

Michael, Anne
  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 35.8 KB
RevLine 
[1237]1!
2! $Id: aeropt_5wv.F90 1337 2010-04-02 11:31:05Z fairhead $
3!
[1150]4
5SUBROUTINE AEROPT_5WV(&
6   pdel, m_allaer, delt, &
7   RHcl, ai, flag_aerosol, &
[1181]8   pplay, t_seri, &
[1221]9   tausum, tau, presnivs)
[1150]10
11  USE DIMPHY
[1183]12  USE aero_mod
[1337]13  USE phys_local_var_mod, only: od550aer,od865aer,ec550aer,od550lt1aer
[1246]14
[1150]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
[1181]57  REAL, DIMENSION(klon,klev,naero_spc), INTENT(in) :: m_allaer
[1150]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
[1221]62  REAL, DIMENSION(klev),      INTENT(in)   :: presnivs
[1150]63  !
64  ! Output arguments:
65  !
[1181]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
[1150]69
[1181]70
[1150]71  !
72  ! Local
73  !
[1181]74  INTEGER, PARAMETER :: las = nwave
[1150]75  LOGICAL :: soluble
76 
[1237]77  INTEGER :: i, k, ierr, m
[1221]78  INTEGER :: spsol, spinsol, spss, la
[1267]79  INTEGER :: RH_num(klon,klev)
[1150]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
[1237]86  INTEGER, PARAMETER :: naero_soluble=7   !  1- BC soluble; 2- POM soluble; 3- SO4 acc.
[1246]87                                          !  4- SO4 coarse; 5 seasalt super-C; 6 seasalt coarse; 7 seasalt acc.
[1237]88  INTEGER, PARAMETER :: naero_insoluble=3 !  1- Dust; 2- BC insoluble; 3- POM insoluble
[1246]89  INTEGER, PARAMETER :: nb_level = 19     ! number of vertical levels
[1221]90  LOGICAL, SAVE :: firstcall=.TRUE.
[1249]91!$OMP THREADPRIVATE(firstcall)
[1221]92
[1150]93  REAL :: zrho
[1221]94
95  ! Coefficient optiques sur 19 niveaux
[1249]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,&
[1221]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
[1249]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)
[1221]111
112  ! Coefficient optiques interpole sur le nombre de niveau du modele
[1237]113  REAL, ALLOCATABLE,  DIMENSION(:), SAVE :: &
114          A1_ASSSM, A2_ASSSM, A3_ASSSM,&
[1221]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
[1249]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)
[1221]126
[1249]127
128  REAL,PARAMETER :: RH_tab(nbre_RH)=(/0.,10.,20.,30.,40.,50.,60.,70.,80.,85.,90.,95./)
[1250]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
[1150]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
[1337]144  REAL :: dh(KLON,KLEV)
[1150]145 
[1237]146  REAL :: alpha_aers_5wv(nbre_RH,las,naero_soluble)   ! ext. coeff. Soluble comp. units *** m2/g
[1267]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
[1237]149  REAL :: cg_aers_5wv(nbre_RH,las,naero_soluble)      ! Asym. param. soluble comp.
[1267]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
[1237]152  REAL :: piz_aers_5wv(nbre_RH,las,naero_soluble)   
[1267]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
[1150]155
[1181]156  REAL, DIMENSION(klon,klev,naero_spc) :: mass_temp
[1150]157 
158  !
159  ! Proprietes optiques
160  !
[1250]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)
[1267]165  INTEGER :: n
[1250]166 
[1221]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!
[1246]303!
304!
305!
[1254]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! 
[1267]312 DATA alpha_aers_5wv/ &
[1254]313                                ! bc soluble
[1267]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, & 
[1254]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, & 
[1267]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, & 
[1254]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, & 
[1267]379                                ! seasalt soluble accumulation (computed below for 550nm)
[1254]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, & 
[1267]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, & 
[1254]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/
[1267]390
[1150]391  DATA alpha_aeri_5wv/ &
[1267]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   !
[1254]399  DATA cg_aers_5wv/ & 
400                                 ! bc soluble
[1267]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
[1150]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/&
[1254]488                           ! bc soluble
[1267]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 !
[1150]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
[1221]575! Interpolation des coefficients optiques de 19 niveaux vers le nombre des niveaux du model
576  IF (firstcall) THEN
577     firstcall=.FALSE.
[1237]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
[1221]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
[1181]617  ! Initialisations
618  ai(:) = 0.
619  tausum(:,:,:) = 0.
[1150]620
621
622  DO k=1, klev
623    DO i=1, klon
[1237]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 '
[1150]626      zrho=pplay(i,k)/t_seri(i,k)/RD                  ! kg/m3
[1337]627      dh(i,k)=pdel(i,k)/(gravit*zrho)
[1250]628!CDIR UNROLL=naero_spc
[1150]629      mass_temp(i,k,:) = m_allaer(i,k,:) / zrho / 1.e+9
[1250]630      zdp1(i,k)=pdel(i,k)/(gravit*delt)     ! air mass auxiliary  variable --> zdp1 [kg/(m^2 *s)]
631
[1150]632    ENDDO
633  ENDDO
634
635
636  IF (flag_aerosol .EQ. 1) THEN
[1246]637     nb_aer = 2
[1181]638     ALLOCATE (aerosol_name(nb_aer))
639     aerosol_name(1) = id_ASSO4M
[1246]640     aerosol_name(2) = id_CSSO4M
[1150]641  ELSEIF (flag_aerosol .EQ. 2) THEN
[1181]642     nb_aer = 2
643     ALLOCATE (aerosol_name(nb_aer))
644     aerosol_name(1) = id_ASBCM
645     aerosol_name(2) = id_AIBCM
[1150]646  ELSEIF (flag_aerosol .EQ. 3) THEN
[1181]647     nb_aer = 2
648     ALLOCATE (aerosol_name(nb_aer))
649     aerosol_name(1) = id_ASPOMM
650     aerosol_name(2) = id_AIPOMM
[1150]651  ELSEIF (flag_aerosol .EQ. 4) THEN
[1181]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
[1150]657  ELSEIF (flag_aerosol .EQ. 5) THEN
[1181]658     nb_aer = 1
659     ALLOCATE (aerosol_name(nb_aer))
660     aerosol_name(1) = id_CIDUSTM
[1150]661  ELSEIF (flag_aerosol .EQ. 6) THEN
[1221]662     nb_aer = 10
[1181]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
[1221]673     aerosol_name(10) = id_CSSO4M
[1150]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 
[1181]683
[1150]684  !
685  ! Calculations that need to be done since we are not in the subroutines INCA
686  !     
[1250]687
[1267]688!CDIR ON_ADB(RH_tab)
[1250]689!CDIR ON_ADB(fact_RH)
690!CDIR NOVECTOR
[1267]691  DO n=1,nbre_RH-1
692    fact_RH(n)=1./(RH_tab(n+1)-RH_tab(n))
[1250]693  ENDDO
694   
695  DO k=1, KLEV
[1267]696!CDIR ON_ADB(RH_tab)
[1250]697!CDIR ON_ADB(fact_RH)
698    DO i=1, KLON
699      rh(i,k)=MIN(RHcl(i,k)*100.,RH_MAX)
[1267]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))
[1250]704    ENDDO
705  ENDDO
706
707!CDIR SHORTLOOP 
708  used_tau(:)=.FALSE.
709   
[1237]710  DO m=1,nb_aer   ! tau is only computed for each mass   
[1150]711    fac=1.0
[1221]712    IF (aerosol_name(m).EQ.id_ASBCM) THEN
[1150]713        soluble=.TRUE.
714        spsol=1
[1221]715        spss=0
716    ELSEIF (aerosol_name(m).EQ.id_ASPOMM) THEN
[1150]717        soluble=.TRUE.
[1221]718        spsol=2
719        spss=0
[1237]720    ELSEIF (aerosol_name(m).EQ.id_ASSO4M) THEN
[1150]721        soluble=.TRUE.
722        spsol=3
[1221]723        spss=0
724        fac=1.375    ! (NH4)2-SO4/SO4 132/96 mass conversion factor for OD
[1237]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
[1221]730    ELSEIF (aerosol_name(m).EQ.id_SSSSM) THEN
[1150]731        soluble=.TRUE.
[1221]732        spsol=5
733        spss=3
734    ELSEIF (aerosol_name(m).EQ.id_CSSSM) THEN
[1150]735        soluble=.TRUE.
[1221]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
[1150]743        soluble=.FALSE.
744        spinsol=1
[1221]745        spss=0
[1150]746    ELSEIF  (aerosol_name(m).EQ.id_AIBCM) THEN
747        soluble=.FALSE.
748        spinsol=2
[1221]749        spss=0
[1150]750    ELSEIF (aerosol_name(m).EQ.id_AIPOMM) THEN
751        soluble=.FALSE.
752        spinsol=3
[1221]753        spss=0
[1150]754    ELSE
755        CYCLE
756    ENDIF
[1250]757
758    used_tau(spsol)=.TRUE.
[1150]759    DO la=1,las
[1221]760
[1250]761      IF (soluble) THEN
[1221]762
[1250]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
[1150]793
[1250]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
[1246]807          ENDIF
[1237]808
[1250]809        ELSE
810          DO k=1, KLEV
811!CDIR ON_ADB(alpha_aers_5wv)
812            DO i=1, KLON
[1267]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))
[1266]816
[1250]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)
[1246]820            ENDDO
821          ENDDO
[1250]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
[1246]835      ENDIF
[1181]836    ENDDO   ! boucle sur les longueurs d'onde
837  ENDDO     ! Boucle  sur les masses de traceurs
[1250]838
839  DO m=1,naero_spc
840    IF (.NOT.used_tau(m)) tau(:,:,:,m)=0.
841  ENDDO 
[1181]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
[1150]851
[1337]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
[1181]865  DEALLOCATE(aerosol_name)
[1150]866 
867END SUBROUTINE AEROPT_5WV
Note: See TracBrowser for help on using the repository browser.