Context Navigation

aeropt_2bands.F90 @ 1244

Last change on this file since 1244 was 1237, checked in by Laurent Fairhead, 15 years ago
Des modifications sur la lecture des aerosols par Michael Correction du test sur le jour de lecture des aerosols qui ne marchait pas avec le nouveau calendrier (a revoir?) Menage sur quelques prints SD/MAF
Property svn:eol-style set to `native` Property svn:keywords set to `Author Date Id Revision`
File size: 47.6 KB

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

Note: See TracBrowser for help on using the repository browser.

Download in other formats:

Original Format