Context Navigation

aeropt_5wv.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: 34.4 KB

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

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

Download in other formats:

Original Format