Context Navigation

aeropt_2bands.F90 @ 1248

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

En deconnectant les aérosols (ok_ade=ok_aie=n) on a les mêmes

résultats avant et après les modifs.

preindustrial readin fields are used to compute natural aerosol fields

to allow for clean double calls to radiation

full forcing diagnostics (NAT, ANT, ZERO, Cloud forcing, CS,AS) are

activated with lev_histmth 4, If lev_histmth is not 4, the call to the
radiation is minimized, for efficiency, but ade and aie are computed and
applied (however for species wise forcing one would need to do
difference runs) (still quite a bit new forcing info, requires probably

some more explanation)

there is a hardcoded key in sw_aeroAR4.F90 which lets you choose to use the zero aerosol, or natural aerosol perturbation acting on the meteorology, but still would put out the full forcing diagnostics.
aod fields from offline aerosol fields are also output in histmth for

all aerosol tracers read in and available for evaluation

aeropt contains the ss humidity correction from nicolas&yves

Property svn:eol-style set to native
Property svn:keywords set to Author Date Id Revision

File size: 47.7 KB

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

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

Download in other formats:

Original Format