Context Navigation

aeropt_5wv.F90 @ 3837

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

Additions to aerosol outputs for CMIP5 exercise
(Needed because of chageset r1346 LF)

Additions aux sorties aérosols pour l'exercice CMIP5
(Nécessaires suite au changeset r1346 LF)

Michael, Anne

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

File size: 35.8 KB

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

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

Download in other formats:

Original Format