Home

Context Navigation

source: palm/trunk/SOURCE/salsa_mod.f90 @ 3524

Last change on this file since 3524 was 3524, checked in by raasch, 6 years ago
unused variables removed, missing working precision added, missing preprocessor directives added, bugfix concerning allocation of t_surf_wall_v in nopointer case, declaration statements rearranged to avoid compile time errors, mpi_abort arguments replaced to avoid compile errors
Property svn:keywords set to `Id`
File size: 510.1 KB

Line
1	!> @file salsa_mod.f90
2	!--------------------------------------------------------------------------------!
3	! This file is part of PALM-4U.
4	!
5	! PALM-4U is free software: you can redistribute it and/or modify it under the
6	! terms of the GNU General Public License as published by the Free Software
7	! Foundation, either version 3 of the License, or (at your option) any later
8	! version.
9	!
10	! PALM-4U is distributed in the hope that it will be useful, but WITHOUT ANY
11	! WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
12	! A PARTICULAR PURPOSE. See the GNU General Public License for more details.
13	!
14	! You should have received a copy of the GNU General Public License along with
15	! PALM. If not, see <http://www.gnu.org/licenses/>.
16	!
17	! Copyright 1997-2018 Leibniz Universitaet Hannover
18	!--------------------------------------------------------------------------------!
19	!
20	! Current revisions:
21	! -----------------
22	!
23	!
24	! Former revisions:
25	! -----------------
26	! $Id: salsa_mod.f90 3524 2018-11-14 13:36:44Z raasch $
27	! missing comma separator inserted
28	!
29	! 3483 2018-11-02 14:19:26Z raasch
30	! bugfix: directives added to allow compilation without netCDF
31	!
32	! 3481 2018-11-02 09:14:13Z raasch
33	! temporary variable cc introduced to circumvent a possible Intel18 compiler bug
34	! related to contiguous/non-contguous pointer/target attributes
35	!
36	! 3473 2018-10-30 20:50:15Z suehring
37	! NetCDF input routine renamed
38	!
39	! 3467 2018-10-30 19:05:21Z suehring
40	! Initial revision
41	!
42	! 3412 2018-10-24 07:25:57Z monakurppa
43	!
44	! Authors:
45	! --------
46	! @author monakurppa
47	!
48	!
49	! Description:
50	! ------------
51	!> Sectional aerosol module for large scale applications SALSA
52	!> (Kokkola et al., 2008, ACP 8, 2469-2483). Solves the aerosol number and mass
53	!> concentration as well as chemical composition. Includes aerosol dynamic
54	!> processes: nucleation, condensation/evaporation of vapours, coagulation and
55	!> deposition on tree leaves, ground and roofs.
56	!> Implementation is based on formulations implemented in UCLALES-SALSA except
57	!> for deposition which is based on parametrisations by Zhang et al. (2001,
58	!> Atmos. Environ. 35, 549-560) or Petroff&Zhang (2010, Geosci. Model Dev. 3,
59	!> 753-769)
60	!>
61	!> @todo Implement turbulent inflow of aerosols in inflow_turbulence.
62	!> @todo Deposition on walls and horizontal surfaces calculated from the aerosol
63	!> dry radius, not wet
64	!> @todo Deposition on subgrid scale vegetation
65	!> @todo Deposition on vegetation calculated by default for deciduous broadleaf
66	!> trees
67	!> @todo Revise masked data output. There is a potential bug in case of
68	!> terrain-following masked output, according to data_output_mask.
69	!> @todo There are now improved interfaces for NetCDF data input which can be
70	!> used instead of get variable etc.
71	!------------------------------------------------------------------------------!
72	MODULE salsa_mod
73
74	USE basic_constants_and_equations_mod, &
75	ONLY: c_p, g, p_0, pi, r_d
76
77	USE chemistry_model_mod, &
78	ONLY: chem_species, nspec, nvar, spc_names
79
80	USE chem_modules, &
81	ONLY: call_chem_at_all_substeps, chem_gasphase_on
82
83	USE control_parameters
84
85	USE indices, &
86	ONLY: nbgp, nx, nxl, nxlg, nxr, nxrg, ny, nyn, nyng, nys, nysg, nzb, &
87	nzb_s_inner, nz, nzt, wall_flags_0
88
89	USE kinds
90
91	USE pegrid
92
93	USE salsa_util_mod
94
95	IMPLICIT NONE
96	!
97	!-- SALSA constants:
98	!
99	!-- Local constants:
100	INTEGER(iwp), PARAMETER :: ngast = 5 !< total number of gaseous tracers:
101	!< 1 = H2SO4, 2 = HNO3, 3 = NH3,
102	!< 4 = OCNV (non-volatile OC),
103	!< 5 = OCSV (semi-volatile)
104	INTEGER(iwp), PARAMETER :: nmod = 7 !< number of modes for initialising
105	!< the aerosol size distribution
106	INTEGER(iwp), PARAMETER :: nreg = 2 !< Number of main size subranges
107	INTEGER(iwp), PARAMETER :: maxspec = 7 !< Max. number of aerosol species
108	!
109	!-- Universal constants
110	REAL(wp), PARAMETER :: abo = 1.380662E-23_wp !< Boltzmann constant (J/K)
111	REAL(wp), PARAMETER :: alv = 2.260E+6_wp !< latent heat for H2O
112	!< vaporisation (J/kg)
113	REAL(wp), PARAMETER :: alv_d_rv = 4896.96865_wp !< alv / rv
114	REAL(wp), PARAMETER :: am_airmol = 4.8096E-26_wp !< Average mass of one air
115	!< molecule (Jacobson,
116	!< 2005, Eq. 2.3)
117	REAL(wp), PARAMETER :: api6 = 0.5235988_wp !< pi / 6
118	REAL(wp), PARAMETER :: argas = 8.314409_wp !< Gas constant (J/(mol K))
119	REAL(wp), PARAMETER :: argas_d_cpd = 8.281283865E-3_wp !< argas per cpd
120	REAL(wp), PARAMETER :: avo = 6.02214E+23_wp !< Avogadro constant (1/mol)
121	REAL(wp), PARAMETER :: d_sa = 5.539376964394570E-10_wp !< diameter of
122	!< condensing sulphuric
123	!< acid molecule (m)
124	REAL(wp), PARAMETER :: for_ppm_to_nconc = 7.243016311E+16_wp !<
125	!< ppm * avo / R (K/(Pa*m3))
126	REAL(wp), PARAMETER :: epsoc = 0.15_wp !< water uptake of organic
127	!< material
128	REAL(wp), PARAMETER :: mclim = 1.0E-23_wp !< mass concentration min
129	!< limit for aerosols (kg/m3)
130	REAL(wp), PARAMETER :: n3 = 158.79_wp !< Number of H2SO4 molecules in
131	!< 3 nm cluster if d_sa=5.54e-10m
132	REAL(wp), PARAMETER :: nclim = 1.0_wp !< number concentration min limit
133	!< for aerosols and gases (#/m3)
134	REAL(wp), PARAMETER :: surfw0 = 0.073_wp !< surface tension of pure water
135	!< at ~ 293 K (J/m2)
136	REAL(wp), PARAMETER :: vclim = 1.0E-24_wp !< volume concentration min
137	!< limit for aerosols (m3/m3)
138	!-- Molar masses in kg/mol
139	REAL(wp), PARAMETER :: ambc = 12.0E-3_wp !< black carbon (BC)
140	REAL(wp), PARAMETER :: amdair = 28.970E-3_wp !< dry air
141	REAL(wp), PARAMETER :: amdu = 100.E-3_wp !< mineral dust
142	REAL(wp), PARAMETER :: amh2o = 18.0154E-3_wp !< H2O
143	REAL(wp), PARAMETER :: amh2so4 = 98.06E-3_wp !< H2SO4
144	REAL(wp), PARAMETER :: amhno3 = 63.01E-3_wp !< HNO3
145	REAL(wp), PARAMETER :: amn2o = 44.013E-3_wp !< N2O
146	REAL(wp), PARAMETER :: amnh3 = 17.031E-3_wp !< NH3
147	REAL(wp), PARAMETER :: amo2 = 31.9988E-3_wp !< O2
148	REAL(wp), PARAMETER :: amo3 = 47.998E-3_wp !< O3
149	REAL(wp), PARAMETER :: amoc = 150.E-3_wp !< organic carbon (OC)
150	REAL(wp), PARAMETER :: amss = 58.44E-3_wp !< sea salt (NaCl)
151	!-- Densities in kg/m3
152	REAL(wp), PARAMETER :: arhobc = 2000.0_wp !< black carbon
153	REAL(wp), PARAMETER :: arhodu = 2650.0_wp !< mineral dust
154	REAL(wp), PARAMETER :: arhoh2o = 1000.0_wp !< H2O
155	REAL(wp), PARAMETER :: arhoh2so4 = 1830.0_wp !< SO4
156	REAL(wp), PARAMETER :: arhohno3 = 1479.0_wp !< HNO3
157	REAL(wp), PARAMETER :: arhonh3 = 1530.0_wp !< NH3
158	REAL(wp), PARAMETER :: arhooc = 2000.0_wp !< organic carbon
159	REAL(wp), PARAMETER :: arhoss = 2165.0_wp !< sea salt (NaCl)
160	!-- Volume of molecule in m3/#
161	REAL(wp), PARAMETER :: amvh2o = amh2o /avo / arhoh2o !< H2O
162	REAL(wp), PARAMETER :: amvh2so4 = amh2so4 / avo / arhoh2so4 !< SO4
163	REAL(wp), PARAMETER :: amvhno3 = amhno3 / avo / arhohno3 !< HNO3
164	REAL(wp), PARAMETER :: amvnh3 = amnh3 / avo / arhonh3 !< NH3
165	REAL(wp), PARAMETER :: amvoc = amoc / avo / arhooc !< OC
166	REAL(wp), PARAMETER :: amvss = amss / avo / arhoss !< sea salt
167
168	!
169	!-- SALSA switches:
170	INTEGER(iwp) :: nj3 = 1 !< J3 parametrization (nucleation)
171	!< 1 = condensational sink (Kerminen&Kulmala, 2002)
172	!< 2 = coagulational sink (Lehtinen et al. 2007)
173	!< 3 = coagS+self-coagulation (Anttila et al. 2010)
174	INTEGER(iwp) :: nsnucl = 0 !< Choice of the nucleation scheme:
175	!< 0 = off
176	!< 1 = binary nucleation
177	!< 2 = activation type nucleation
178	!< 3 = kinetic nucleation
179	!< 4 = ternary nucleation
180	!< 5 = nucleation with ORGANICs
181	!< 6 = activation type of nucleation with
182	!< H2SO4+ORG
183	!< 7 = heteromolecular nucleation with H2SO4*ORG
184	!< 8 = homomolecular nucleation of H2SO4 +
185	!< heteromolecular nucleation with H2SO4*ORG
186	!< 9 = homomolecular nucleation of H2SO4 and ORG
187	!< +heteromolecular nucleation with H2SO4*ORG
188	LOGICAL :: advect_particle_water = .TRUE. !< advect water concentration of
189	!< particles
190	LOGICAL :: decycle_lr = .FALSE. !< Undo cyclic boundary
191	!< conditions: left and right
192	LOGICAL :: decycle_ns = .FALSE. !< north and south boundaries
193	LOGICAL :: feedback_to_palm = .FALSE. !< allow feedback due to
194	!< hydration and/or condensation
195	!< of H20
196	LOGICAL :: no_insoluble = .FALSE. !< Switch to exclude insoluble
197	!< chemical components
198	LOGICAL :: read_restart_data_salsa = .FALSE. !< read restart data for salsa
199	LOGICAL :: salsa = .FALSE. !< SALSA master switch
200	LOGICAL :: salsa_gases_from_chem = .FALSE. !< Transfer the gaseous
201	!< components to SALSA from
202	!< from chemistry model
203	LOGICAL :: van_der_waals_coagc = .FALSE. !< Enhancement of coagulation
204	!< kernel by van der Waals and
205	!< viscous forces
206	LOGICAL :: write_binary_salsa = .FALSE. !< read binary for salsa
207	!-- Process switches: nl* is read from the NAMELIST and is NOT changed.
208	!-- ls* is the switch used and will get the value of nl*
209	!-- except for special circumstances (spinup period etc.)
210	LOGICAL :: nlcoag = .FALSE. !< Coagulation master switch
211	LOGICAL :: lscoag = .FALSE. !<
212	LOGICAL :: nlcnd = .FALSE. !< Condensation master switch
213	LOGICAL :: lscnd = .FALSE. !<
214	LOGICAL :: nlcndgas = .FALSE. !< Condensation of precursor gases
215	LOGICAL :: lscndgas = .FALSE. !<
216	LOGICAL :: nlcndh2oae = .FALSE. !< Condensation of H2O on aerosol
217	LOGICAL :: lscndh2oae = .FALSE. !< particles (FALSE -> equilibrium calc.)
218	LOGICAL :: nldepo = .FALSE. !< Deposition master switch
219	LOGICAL :: lsdepo = .FALSE. !<
220	LOGICAL :: nldepo_topo = .FALSE. !< Deposition on vegetation master switch
221	LOGICAL :: lsdepo_topo = .FALSE. !<
222	LOGICAL :: nldepo_vege = .FALSE. !< Deposition on walls master switch
223	LOGICAL :: lsdepo_vege = .FALSE. !<
224	LOGICAL :: nldistupdate = .TRUE. !< Size distribution update master switch
225	LOGICAL :: lsdistupdate = .FALSE. !<
226	!
227	!-- SALSA variables:
228	CHARACTER (LEN=20) :: bc_salsa_b = 'neumann' !< bottom boundary condition
229	CHARACTER (LEN=20) :: bc_salsa_t = 'neumann' !< top boundary condition
230	CHARACTER (LEN=20) :: depo_vege_type = 'zhang2001' !< or 'petroff2010'
231	CHARACTER (LEN=20) :: depo_topo_type = 'zhang2001' !< or 'petroff2010'
232	CHARACTER (LEN=20), DIMENSION(4) :: decycle_method = &
233	(/'dirichlet','dirichlet','dirichlet','dirichlet'/)
234	!< Decycling method at horizontal boundaries,
235	!< 1=left, 2=right, 3=south, 4=north
236	!< dirichlet = initial size distribution and
237	!< chemical composition set for the ghost and
238	!< first three layers
239	!< neumann = zero gradient
240	CHARACTER (LEN=3), DIMENSION(maxspec) :: listspec = & !< Active aerosols
241	(/'SO4',' ',' ',' ',' ',' ',' '/)
242	CHARACTER (LEN=20) :: salsa_source_mode = 'no_source'
243	!< 'read_from_file',
244	!< 'constant' or 'no_source'
245	INTEGER(iwp) :: dots_salsa = 0 !< starting index for salsa-timeseries
246	INTEGER(iwp) :: fn1a = 1 !< last index for bin subranges: subrange 1a
247	INTEGER(iwp) :: fn2a = 1 !< subrange 2a
248	INTEGER(iwp) :: fn2b = 1 !< subrange 2b
249	INTEGER(iwp), DIMENSION(ngast) :: gas_index_chem = (/ 1, 1, 1, 1, 1/) !<
250	!< Index of gaseous compounds in the chemistry
251	!< model. In SALSA, 1 = H2SO4, 2 = HNO3,
252	!< 3 = NH3, 4 = OCNV, 5 = OCSV
253	INTEGER(iwp) :: ibc_salsa_b !<
254	INTEGER(iwp) :: ibc_salsa_t !<
255	INTEGER(iwp) :: igctyp = 0 !< Initial gas concentration type
256	!< 0 = uniform (use H2SO4_init, HNO3_init,
257	!< NH3_init, OCNV_init and OCSV_init)
258	!< 1 = read vertical profile from an input file
259	INTEGER(iwp) :: in1a = 1 !< start index for bin subranges: subrange 1a
260	INTEGER(iwp) :: in2a = 1 !< subrange 2a
261	INTEGER(iwp) :: in2b = 1 !< subrange 2b
262	INTEGER(iwp) :: isdtyp = 0 !< Initial size distribution type
263	!< 0 = uniform
264	!< 1 = read vertical profile of the mode number
265	!< concentration from an input file
266	INTEGER(iwp) :: ibc = -1 !< Indice for: black carbon (BC)
267	INTEGER(iwp) :: idu = -1 !< dust
268	INTEGER(iwp) :: inh = -1 !< NH3
269	INTEGER(iwp) :: ino = -1 !< HNO3
270	INTEGER(iwp) :: ioc = -1 !< organic carbon (OC)
271	INTEGER(iwp) :: iso4 = -1 !< SO4 or H2SO4
272	INTEGER(iwp) :: iss = -1 !< sea salt
273	INTEGER(iwp) :: lod_aero = 0 !< level of detail for aerosol emissions
274	INTEGER(iwp) :: lod_gases = 0 !< level of detail for gaseous emissions
275	INTEGER(iwp), DIMENSION(nreg) :: nbin = (/ 3, 7/) !< Number of size bins
276	!< for each aerosol size subrange
277	INTEGER(iwp) :: nbins = 1 !< total number of size bins
278	INTEGER(iwp) :: ncc = 1 !< number of chemical components used
279	INTEGER(iwp) :: ncc_tot = 1!< total number of chemical compounds (ncc+1
280	!< if particle water is advected)
281	REAL(wp) :: act_coeff = 1.0E-7_wp !< Activation coefficient
282	REAL(wp) :: aerosol_source = 0.0_wp !< Constant aerosol flux (#/(m3*s))
283	REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: emission_mass_fracs !< array for
284	!< aerosol composition per emission category
285	!< 1:SO4 2:OC 3:BC 4:DU 5:SS 6:NO 7:NH
286	REAL(wp) :: dt_salsa = 0.00001_wp !< Time step of SALSA
287	REAL(wp) :: H2SO4_init = nclim !< Init value for sulphuric acid gas
288	REAL(wp) :: HNO3_init = nclim !< Init value for nitric acid gas
289	REAL(wp) :: last_salsa_time = 0.0_wp !< time of the previous salsa
290	!< timestep
291	REAL(wp) :: nf2a = 1.0_wp !< Number fraction allocated to a-
292	!< bins in subrange 2
293	!< (b-bins will get 1-nf2a)
294	REAL(wp) :: NH3_init = nclim !< Init value for ammonia gas
295	REAL(wp) :: OCNV_init = nclim !< Init value for non-volatile
296	!< organic gases
297	REAL(wp) :: OCSV_init = nclim !< Init value for semi-volatile
298	!< organic gases
299	REAL(wp), DIMENSION(nreg+1) :: reglim = & !< Min&max diameters of size subranges
300	(/ 3.0E-9_wp, 5.0E-8_wp, 1.0E-5_wp/)
301	REAL(wp) :: rhlim = 1.20_wp !< RH limit in %/100. Prevents
302	!< unrealistically high RH in condensation
303	REAL(wp) :: skip_time_do_salsa = 0.0_wp !< Starting time of SALSA (s)
304	!-- Initial log-normal size distribution: mode diameter (dpg, micrometres),
305	!-- standard deviation (sigmag) and concentration (n_lognorm, #/cm3)
306	REAL(wp), DIMENSION(nmod) :: dpg = (/0.013_wp, 0.054_wp, 0.86_wp, &
307	0.2_wp, 0.2_wp, 0.2_wp, 0.2_wp/)
308	REAL(wp), DIMENSION(nmod) :: sigmag = (/1.8_wp, 2.16_wp, 2.21_wp, &
309	2.0_wp, 2.0_wp, 2.0_wp, 2.0_wp/)
310	REAL(wp), DIMENSION(nmod) :: n_lognorm = (/1.04e+5_wp, 3.23E+4_wp, 5.4_wp,&
311	0.0_wp, 0.0_wp, 0.0_wp, 0.0_wp/)
312	!-- Initial mass fractions / chemical composition of the size distribution
313	REAL(wp), DIMENSION(maxspec) :: mass_fracs_a = & !< mass fractions between
314	(/1.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0/) !< aerosol species for A bins
315	REAL(wp), DIMENSION(maxspec) :: mass_fracs_b = & !< mass fractions between
316	(/0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0/) !< aerosol species for B bins
317
318	REAL(wp), ALLOCATABLE, DIMENSION(:) :: bin_low_limits !< to deliver
319	!< information about
320	!< the lower
321	!< diameters per bin
322	REAL(wp), ALLOCATABLE, DIMENSION(:) :: nsect !< Background number
323	!< concentration per bin
324	REAL(wp), ALLOCATABLE, DIMENSION(:) :: massacc !< Mass accomodation
325	!< coefficients per bin
326	!
327	!-- SALSA derived datatypes:
328	!
329	!-- Prognostic variable: Aerosol size bin information (number (#/m3) and
330	!-- mass (kg/m3) concentration) and the concentration of gaseous tracers (#/m3).
331	!-- Gas tracers are contained sequentially in dimension 4 as:
332	!-- 1. H2SO4, 2. HNO3, 3. NH3, 4. OCNV (non-volatile organics),
333	!-- 5. OCSV (semi-volatile)
334	TYPE salsa_variable
335	REAL(wp), POINTER, DIMENSION(:,:,:), CONTIGUOUS :: conc
336	REAL(wp), POINTER, DIMENSION(:,:,:), CONTIGUOUS :: conc_p
337	REAL(wp), POINTER, DIMENSION(:,:,:), CONTIGUOUS :: tconc_m
338	REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: flux_s, diss_s
339	REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: flux_l, diss_l
340	REAL(wp), ALLOCATABLE, DIMENSION(:) :: init
341	REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: source
342	REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: sums_ws_l
343	END TYPE salsa_variable
344
345	!-- Map bin indices between parallel size distributions
346	TYPE t_parallelbin
347	INTEGER(iwp) :: cur ! Index for current distribution
348	INTEGER(iwp) :: par ! Index for corresponding parallel distribution
349	END TYPE t_parallelbin
350
351	!-- Datatype used to store information about the binned size distributions of
352	!-- aerosols
353	TYPE t_section
354	REAL(wp) :: vhilim !< bin volume at the high limit
355	REAL(wp) :: vlolim !< bin volume at the low limit
356	REAL(wp) :: vratiohi !< volume ratio between the center and high limit
357	REAL(wp) :: vratiolo !< volume ratio between the center and low limit
358	REAL(wp) :: dmid !< bin middle diameter (m)
359	!******************************************************
360	! ^ Do NOT change the stuff above after initialization !
361	!******************************************************
362	REAL(wp) :: dwet !< Wet diameter or mean droplet diameter (m)
363	REAL(wp), DIMENSION(maxspec+1) :: volc !< Volume concentrations
364	!< (m^3/m^3) of aerosols + water. Since most of
365	!< the stuff in SALSA is hard coded, these *have to
366	!< be* in the order
367	!< 1:SO4, 2:OC, 3:BC, 4:DU, 5:SS, 6:NO, 7:NH, 8:H2O
368	REAL(wp) :: veqh2o !< Equilibrium H2O concentration for each particle
369	REAL(wp) :: numc !< Number concentration of particles/droplets (#/m3)
370	REAL(wp) :: core !< Volume of dry particle
371	END TYPE t_section
372	!
373	!-- Local aerosol properties in SALSA
374	TYPE(t_section), ALLOCATABLE :: aero(:)
375	!
376	!-- SALSA tracers:
377	!-- Tracers as x = x(k,j,i,bin). The 4th dimension contains all the size bins
378	!-- sequentially for each aerosol species + water.
379	!
380	!-- Prognostic tracers:
381	!
382	!-- Number concentration (#/m3)
383	TYPE(salsa_variable), ALLOCATABLE, DIMENSION(:), TARGET :: aerosol_number
384	REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:), TARGET :: nconc_1
385	REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:), TARGET :: nconc_2
386	REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:), TARGET :: nconc_3
387	!
388	!-- Mass concentration (kg/m3)
389	TYPE(salsa_variable), ALLOCATABLE, DIMENSION(:), TARGET :: aerosol_mass
390	REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:), TARGET :: mconc_1
391	REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:), TARGET :: mconc_2
392	REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:), TARGET :: mconc_3
393	!
394	!-- Gaseous tracers (#/m3)
395	TYPE(salsa_variable), ALLOCATABLE, DIMENSION(:), TARGET :: salsa_gas
396	REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:), TARGET :: gconc_1
397	REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:), TARGET :: gconc_2
398	REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:), TARGET :: gconc_3
399	!
400	!-- Diagnostic tracers
401	REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:) :: sedim_vd !< sedimentation
402	!< velocity per size
403	!< bin (m/s)
404	REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:) :: Ra_dry !< dry radius (m)
405
406	!-- Particle component index tables
407	TYPE(component_index) :: prtcl !< Contains "getIndex" which gives the index
408	!< for a given aerosol component name, i.e.
409	!< 1:SO4, 2:OC, 3:BC, 4:DU,
410	!< 5:SS, 6:NO, 7:NH, 8:H2O
411	!
412	!-- Data output arrays:
413	!-- Gases:
414	REAL(wp), ALLOCATABLE, DIMENSION(:,:,:), TARGET :: g_H2SO4_av !< H2SO4
415	REAL(wp), ALLOCATABLE, DIMENSION(:,:,:), TARGET :: g_HNO3_av !< HNO3
416	REAL(wp), ALLOCATABLE, DIMENSION(:,:,:), TARGET :: g_NH3_av !< NH3
417	REAL(wp), ALLOCATABLE, DIMENSION(:,:,:), TARGET :: g_OCNV_av !< non-vola-
418	!< tile OC
419	REAL(wp), ALLOCATABLE, DIMENSION(:,:,:), TARGET :: g_OCSV_av !< semi-vol.
420	!< OC
421	!-- Integrated:
422	REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: LDSA_av !< lung deposited
423	!< surface area
424	REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: Ntot_av !< total number conc.
425	REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: PM25_av !< PM2.5
426	REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: PM10_av !< PM10
427	!-- In the particle phase:
428	REAL(wp), ALLOCATABLE, DIMENSION(:,:,:), TARGET :: s_BC_av !< black carbon
429	REAL(wp), ALLOCATABLE, DIMENSION(:,:,:), TARGET :: s_DU_av !< dust
430	REAL(wp), ALLOCATABLE, DIMENSION(:,:,:), TARGET :: s_H2O_av !< liquid water
431	REAL(wp), ALLOCATABLE, DIMENSION(:,:,:), TARGET :: s_NH_av !< ammonia
432	REAL(wp), ALLOCATABLE, DIMENSION(:,:,:), TARGET :: s_NO_av !< nitrates
433	REAL(wp), ALLOCATABLE, DIMENSION(:,:,:), TARGET :: s_OC_av !< org. carbon
434	REAL(wp), ALLOCATABLE, DIMENSION(:,:,:), TARGET :: s_SO4_av !< sulphates
435	REAL(wp), ALLOCATABLE, DIMENSION(:,:,:), TARGET :: s_SS_av !< sea salt
436	!-- Bins:
437	REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:) :: mbins_av !< bin mass
438	!< concentration
439	REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:) :: Nbins_av !< bin number
440	!< concentration
441
442	!
443	!-- PALM interfaces:
444	!
445	!-- Boundary conditions:
446	INTERFACE salsa_boundary_conds
447	MODULE PROCEDURE salsa_boundary_conds
448	MODULE PROCEDURE salsa_boundary_conds_decycle
449	END INTERFACE salsa_boundary_conds
450	!
451	!-- Data output checks for 2D/3D data to be done in check_parameters
452	INTERFACE salsa_check_data_output
453	MODULE PROCEDURE salsa_check_data_output
454	END INTERFACE salsa_check_data_output
455
456	!
457	!-- Input parameter checks to be done in check_parameters
458	INTERFACE salsa_check_parameters
459	MODULE PROCEDURE salsa_check_parameters
460	END INTERFACE salsa_check_parameters
461
462	!
463	!-- Averaging of 3D data for output
464	INTERFACE salsa_3d_data_averaging
465	MODULE PROCEDURE salsa_3d_data_averaging
466	END INTERFACE salsa_3d_data_averaging
467
468	!
469	!-- Data output of 2D quantities
470	INTERFACE salsa_data_output_2d
471	MODULE PROCEDURE salsa_data_output_2d
472	END INTERFACE salsa_data_output_2d
473
474	!
475	!-- Data output of 3D data
476	INTERFACE salsa_data_output_3d
477	MODULE PROCEDURE salsa_data_output_3d
478	END INTERFACE salsa_data_output_3d
479
480	!
481	!-- Data output of 3D data
482	INTERFACE salsa_data_output_mask
483	MODULE PROCEDURE salsa_data_output_mask
484	END INTERFACE salsa_data_output_mask
485
486	!
487	!-- Definition of data output quantities
488	INTERFACE salsa_define_netcdf_grid
489	MODULE PROCEDURE salsa_define_netcdf_grid
490	END INTERFACE salsa_define_netcdf_grid
491
492	!
493	!-- Output of information to the header file
494	INTERFACE salsa_header
495	MODULE PROCEDURE salsa_header
496	END INTERFACE salsa_header
497
498	!
499	!-- Initialization actions
500	INTERFACE salsa_init
501	MODULE PROCEDURE salsa_init
502	END INTERFACE salsa_init
503
504	!
505	!-- Initialization of arrays
506	INTERFACE salsa_init_arrays
507	MODULE PROCEDURE salsa_init_arrays
508	END INTERFACE salsa_init_arrays
509
510	!
511	!-- Writing of binary output for restart runs !!! renaming?!
512	INTERFACE salsa_wrd_local
513	MODULE PROCEDURE salsa_wrd_local
514	END INTERFACE salsa_wrd_local
515
516	!
517	!-- Reading of NAMELIST parameters
518	INTERFACE salsa_parin
519	MODULE PROCEDURE salsa_parin
520	END INTERFACE salsa_parin
521
522	!
523	!-- Reading of parameters for restart runs
524	INTERFACE salsa_rrd_local
525	MODULE PROCEDURE salsa_rrd_local
526	END INTERFACE salsa_rrd_local
527
528	!
529	!-- Swapping of time levels (required for prognostic variables)
530	INTERFACE salsa_swap_timelevel
531	MODULE PROCEDURE salsa_swap_timelevel
532	END INTERFACE salsa_swap_timelevel
533
534	INTERFACE salsa_driver
535	MODULE PROCEDURE salsa_driver
536	END INTERFACE salsa_driver
537
538	INTERFACE salsa_tendency
539	MODULE PROCEDURE salsa_tendency
540	MODULE PROCEDURE salsa_tendency_ij
541	END INTERFACE salsa_tendency
542
543
544
545	SAVE
546
547	PRIVATE
548	!
549	!-- Public functions:
550	PUBLIC salsa_boundary_conds, salsa_check_data_output, &
551	salsa_check_parameters, salsa_3d_data_averaging, &
552	salsa_data_output_2d, salsa_data_output_3d, salsa_data_output_mask, &
553	salsa_define_netcdf_grid, salsa_diagnostics, salsa_driver, &
554	salsa_header, salsa_init, salsa_init_arrays, salsa_parin, &
555	salsa_rrd_local, salsa_swap_timelevel, salsa_tendency, &
556	salsa_wrd_local
557	!
558	!-- Public parameters, constants and initial values
559	PUBLIC dots_salsa, dt_salsa, last_salsa_time, lsdepo, salsa, &
560	salsa_gases_from_chem, skip_time_do_salsa
561	!
562	!-- Public prognostic variables
563	PUBLIC aerosol_mass, aerosol_number, fn2a, fn2b, gconc_2, in1a, in2b, &
564	mconc_2, nbins, ncc, ncc_tot, nclim, nconc_2, ngast, prtcl, Ra_dry, &
565	salsa_gas, sedim_vd
566
567	CONTAINS
568
569	!------------------------------------------------------------------------------!
570	! Description:
571	! ------------
572	!> Parin for &salsa_par for new modules
573	!------------------------------------------------------------------------------!
574	SUBROUTINE salsa_parin
575
576	IMPLICIT NONE
577
578	CHARACTER (LEN=80) :: line !< dummy string that contains the current line
579	!< of the parameter file
580
581	NAMELIST /salsa_parameters/ &
582	advect_particle_water, & ! Switch for advecting
583	! particle water. If .FALSE.,
584	! equilibration is called at
585	! each time step.
586	bc_salsa_b, & ! bottom boundary condition
587	bc_salsa_t, & ! top boundary condition
588	decycle_lr, & ! decycle SALSA components
589	decycle_method, & ! decycle method applied:
590	! 1=left 2=right 3=south 4=north
591	decycle_ns, & ! decycle SALSA components
592	depo_vege_type, & ! Parametrisation type
593	depo_topo_type, & ! Parametrisation type
594	dpg, & ! Mean diameter for the initial
595	! log-normal modes
596	dt_salsa, & ! SALSA timestep in seconds
597	feedback_to_palm, & ! allow feedback due to
598	! hydration / condensation
599	H2SO4_init, & ! Init value for sulphuric acid
600	HNO3_init, & ! Init value for nitric acid
601	igctyp, & ! Initial gas concentration type
602	isdtyp, & ! Initial size distribution type
603	listspec, & ! List of actived aerosols
604	! (string list)
605	mass_fracs_a, & ! Initial relative contribution
606	! of each species to particle
607	! volume in a-bins, 0 for unused
608	mass_fracs_b, & ! Initial relative contribution
609	! of each species to particle
610	! volume in b-bins, 0 for unused
611	n_lognorm, & ! Number concentration for the
612	! log-normal modes
613	nbin, & ! Number of size bins for
614	! aerosol size subranges 1 & 2
615	nf2a, & ! Number fraction of particles
616	! allocated to a-bins in
617	! subrange 2 b-bins will get
618	! 1-nf2a
619	NH3_init, & ! Init value for ammonia
620	nj3, & ! J3 parametrization
621	! 1 = condensational sink
622	! (Kerminen&Kulmala, 2002)
623	! 2 = coagulational sink
624	! (Lehtinen et al. 2007)
625	! 3 = coagS+self-coagulation
626	! (Anttila et al. 2010)
627	nlcnd, & ! Condensation master switch
628	nlcndgas, & ! Condensation of gases
629	nlcndh2oae, & ! Condensation of H2O
630	nlcoag, & ! Coagulation master switch
631	nldepo, & ! Deposition master switch
632	nldepo_vege, & ! Deposition on vegetation
633	! master switch
634	nldepo_topo, & ! Deposition on topo master
635	! switch
636	nldistupdate, & ! Size distribution update
637	! master switch
638	nsnucl, & ! Nucleation scheme:
639	! 0 = off,
640	! 1 = binary nucleation
641	! 2 = activation type nucleation
642	! 3 = kinetic nucleation
643	! 4 = ternary nucleation
644	! 5 = nucleation with organics
645	! 6 = activation type of
646	! nucleation with H2SO4+ORG
647	! 7 = heteromolecular nucleation
648	! with H2SO4*ORG
649	! 8 = homomolecular nucleation
650	! of H2SO4 + heteromolecular
651	! nucleation with H2SO4*ORG
652	! 9 = homomolecular nucleation
653	! of H2SO4 and ORG + hetero-
654	! molecular nucleation with
655	! H2SO4*ORG
656	OCNV_init, & ! Init value for non-volatile
657	! organic gases
658	OCSV_init, & ! Init value for semi-volatile
659	! organic gases
660	read_restart_data_salsa, & ! read restart data for
661	! salsa
662	reglim, & ! Min&max diameter limits of
663	! size subranges
664	salsa, & ! Master switch for SALSA
665	salsa_source_mode,& ! 'read_from_file' or 'constant'
666	! or 'no_source'
667	sigmag, & ! stdev for the initial log-
668	! normal modes
669	skip_time_do_salsa, & ! Starting time of SALSA (s)
670	van_der_waals_coagc,& ! include van der Waals forces
671	write_binary_salsa ! Write binary for salsa
672
673
674	line = ' '
675
676	!
677	!-- Try to find salsa package
678	REWIND ( 11 )
679	line = ' '
680	DO WHILE ( INDEX( line, '&salsa_parameters' ) == 0 )
681	READ ( 11, '(A)', END=10 ) line
682	ENDDO
683	BACKSPACE ( 11 )
684
685	!
686	!-- Read user-defined namelist
687	READ ( 11, salsa_parameters )
688
689	!
690	!-- Set flag that indicates that the new module is switched on
691	!-- Note that this parameter needs to be declared in modules.f90
692	salsa = .TRUE.
693
694	10 CONTINUE
695
696	END SUBROUTINE salsa_parin
697
698
699	!------------------------------------------------------------------------------!
700	! Description:
701	! ------------
702	!> Check parameters routine for salsa.
703	!------------------------------------------------------------------------------!
704	SUBROUTINE salsa_check_parameters
705
706	USE control_parameters, &
707	ONLY: message_string
708
709	IMPLICIT NONE
710
711	!
712	!-- Checks go here (cf. check_parameters.f90).
713	IF ( salsa .AND. .NOT. humidity ) THEN
714	WRITE( message_string, * ) 'salsa = ', salsa, ' is ', &
715	'not allowed with humidity = ', humidity
716	CALL message( 'check_parameters', 'SA0009', 1, 2, 0, 6, 0 )
717	ENDIF
718
719	IF ( bc_salsa_b == 'dirichlet' ) THEN
720	ibc_salsa_b = 0
721	ELSEIF ( bc_salsa_b == 'neumann' ) THEN
722	ibc_salsa_b = 1
723	ELSE
724	message_string = 'unknown boundary condition: bc_salsa_b = "' &
725	// TRIM( bc_salsa_t ) // '"'
726	CALL message( 'check_parameters', 'SA0011', 1, 2, 0, 6, 0 )
727	ENDIF
728
729	IF ( bc_salsa_t == 'dirichlet' ) THEN
730	ibc_salsa_t = 0
731	ELSEIF ( bc_salsa_t == 'neumann' ) THEN
732	ibc_salsa_t = 1
733	ELSE
734	message_string = 'unknown boundary condition: bc_salsa_t = "' &
735	// TRIM( bc_salsa_t ) // '"'
736	CALL message( 'check_parameters', 'SA0012', 1, 2, 0, 6, 0 )
737	ENDIF
738
739	IF ( nj3 < 1 .OR. nj3 > 3 ) THEN
740	message_string = 'unknown nj3 (must be 1-3)'
741	CALL message( 'check_parameters', 'SA0044', 1, 2, 0, 6, 0 )
742	ENDIF
743
744	END SUBROUTINE salsa_check_parameters
745
746	!------------------------------------------------------------------------------!
747	!
748	! Description:
749	! ------------
750	!> Subroutine defining appropriate grid for netcdf variables.
751	!> It is called out from subroutine netcdf.
752	!> Same grid as for other scalars (see netcdf_interface_mod.f90)
753	!------------------------------------------------------------------------------!
754	SUBROUTINE salsa_define_netcdf_grid( var, found, grid_x, grid_y, grid_z )
755
756	IMPLICIT NONE
757
758	CHARACTER (LEN=*), INTENT(OUT) :: grid_x !<
759	CHARACTER (LEN=*), INTENT(OUT) :: grid_y !<
760	CHARACTER (LEN=*), INTENT(OUT) :: grid_z !<
761	CHARACTER (LEN=*), INTENT(IN) :: var !<
762
763	LOGICAL, INTENT(OUT) :: found !<
764
765	found = .TRUE.
766	!
767	!-- Check for the grid
768
769	IF ( var(1:2) == 'g_' ) THEN
770	grid_x = 'x'
771	grid_y = 'y'
772	grid_z = 'zu'
773	ELSEIF ( var(1:4) == 'LDSA' ) THEN
774	grid_x = 'x'
775	grid_y = 'y'
776	grid_z = 'zu'
777	ELSEIF ( var(1:5) == 'm_bin' ) THEN
778	grid_x = 'x'
779	grid_y = 'y'
780	grid_z = 'zu'
781	ELSEIF ( var(1:5) == 'N_bin' ) THEN
782	grid_x = 'x'
783	grid_y = 'y'
784	grid_z = 'zu'
785	ELSEIF ( var(1:4) == 'Ntot' ) THEN
786	grid_x = 'x'
787	grid_y = 'y'
788	grid_z = 'zu'
789	ELSEIF ( var(1:2) == 'PM' ) THEN
790	grid_x = 'x'
791	grid_y = 'y'
792	grid_z = 'zu'
793	ELSEIF ( var(1:2) == 's_' ) THEN
794	grid_x = 'x'
795	grid_y = 'y'
796	grid_z = 'zu'
797	ELSE
798	found = .FALSE.
799	grid_x = 'none'
800	grid_y = 'none'
801	grid_z = 'none'
802	ENDIF
803
804	END SUBROUTINE salsa_define_netcdf_grid
805
806
807	!------------------------------------------------------------------------------!
808	! Description:
809	! ------------
810	!> Header output for new module
811	!------------------------------------------------------------------------------!
812	SUBROUTINE salsa_header( io )
813
814	IMPLICIT NONE
815
816	INTEGER(iwp), INTENT(IN) :: io !< Unit of the output file
817	!
818	!-- Write SALSA header
819	WRITE( io, 1 )
820	WRITE( io, 2 ) skip_time_do_salsa
821	WRITE( io, 3 ) dt_salsa
822	WRITE( io, 12 ) SHAPE( aerosol_number(1)%conc ), nbins
823	IF ( advect_particle_water ) THEN
824	WRITE( io, 16 ) SHAPE( aerosol_mass(1)%conc ), ncc_tot*nbins, &
825	advect_particle_water
826	ELSE
827	WRITE( io, 16 ) SHAPE( aerosol_mass(1)%conc ), ncc*nbins, &
828	advect_particle_water
829	ENDIF
830	IF ( .NOT. salsa_gases_from_chem ) THEN
831	WRITE( io, 17 ) SHAPE( aerosol_mass(1)%conc ), ngast, &
832	salsa_gases_from_chem
833	ENDIF
834	WRITE( io, 4 )
835	IF ( nsnucl > 0 ) THEN
836	WRITE( io, 5 ) nsnucl, nj3
837	ENDIF
838	IF ( nlcoag ) THEN
839	WRITE( io, 6 )
840	ENDIF
841	IF ( nlcnd ) THEN
842	WRITE( io, 7 ) nlcndgas, nlcndh2oae
843	ENDIF
844	IF ( nldepo ) THEN
845	WRITE( io, 14 ) nldepo_vege, nldepo_topo
846	ENDIF
847	WRITE( io, 8 ) reglim, nbin, bin_low_limits
848	WRITE( io, 15 ) nsect
849	WRITE( io, 13 ) ncc, listspec, mass_fracs_a, mass_fracs_b
850	IF ( .NOT. salsa_gases_from_chem ) THEN
851	WRITE( io, 18 ) ngast, H2SO4_init, HNO3_init, NH3_init, OCNV_init, &
852	OCSV_init
853	ENDIF
854	WRITE( io, 9 ) isdtyp, igctyp
855	IF ( isdtyp == 0 ) THEN
856	WRITE( io, 10 ) dpg, sigmag, n_lognorm
857	ELSE
858	WRITE( io, 11 )
859	ENDIF
860
861
862	1 FORMAT (//' SALSA information:'/ &
863	' ------------------------------'/)
864	2 FORMAT (' Starts at: skip_time_do_salsa = ', F10.2, ' s')
865	3 FORMAT (/' Timestep: dt_salsa = ', F6.2, ' s')
866	12 FORMAT (/' Array shape (z,y,x,bins):'/ &
867	' aerosol_number: ', 4(I3))
868	16 FORMAT (/' aerosol_mass: ', 4(I3),/ &
869	' (advect_particle_water = ', L1, ')')
870	17 FORMAT (' salsa_gas: ', 4(I3),/ &
871	' (salsa_gases_from_chem = ', L1, ')')
872	4 FORMAT (/' Aerosol dynamic processes included: ')
873	5 FORMAT (/' nucleation (scheme = ', I1, ' and J3 parametrization = ',&
874	I1, ')')
875	6 FORMAT (/' coagulation')
876	7 FORMAT (/' condensation (of precursor gases = ', L1, &
877	' and water vapour = ', L1, ')' )
878	14 FORMAT (/' dry deposition (on vegetation = ', L1, &
879	' and on topography = ', L1, ')')
880	8 FORMAT (/' Aerosol bin subrange limits (in metres): ', 3(ES10.2E3), / &
881	' Number of size bins for each aerosol subrange: ', 2I3,/ &
882	' Aerosol bin limits (in metres): ', *(ES10.2E3))
883	15 FORMAT (' Initial number concentration in bins at the lowest level', &
884	' (#/m*3):', (ES10.2E3))
885	13 FORMAT (/' Number of chemical components used: ', I1,/ &
886	' Species: ',7(A6),/ &
887	' Initial relative contribution of each species to particle', &
888	' volume in:',/ &
889	' a-bins: ', 7(F6.3),/ &
890	' b-bins: ', 7(F6.3))
891	18 FORMAT (/' Number of gaseous tracers used: ', I1,/ &
892	' Initial gas concentrations:',/ &
893	' H2SO4: ',ES12.4E3, ' #/m**3',/ &
894	' HNO3: ',ES12.4E3, ' #/m**3',/ &
895	' NH3: ',ES12.4E3, ' #/m**3',/ &
896	' OCNV: ',ES12.4E3, ' #/m**3',/ &
897	' OCSV: ',ES12.4E3, ' #/m**3')
898	9 FORMAT (/' Initialising concentrations: ', / &
899	' Aerosol size distribution: isdtyp = ', I1,/ &
900	' Gas concentrations: igctyp = ', I1 )
901	10 FORMAT ( ' Mode diametres: dpg(nmod) = ', 7(F7.3),/ &
902	' Standard deviation: sigmag(nmod) = ', 7(F7.2),/ &
903	' Number concentration: n_lognorm(nmod) = ', 7(ES12.4E3) )
904	11 FORMAT (/' Size distribution read from a file.')
905
906	END SUBROUTINE salsa_header
907
908	!------------------------------------------------------------------------------!
909	! Description:
910	! ------------
911	!> Allocate SALSA arrays and define pointers if required
912	!------------------------------------------------------------------------------!
913	SUBROUTINE salsa_init_arrays
914
915	USE surface_mod, &
916	ONLY: surf_def_h, surf_def_v, surf_lsm_h, surf_lsm_v, surf_usm_h, &
917	surf_usm_v
918
919	IMPLICIT NONE
920
921	INTEGER(iwp) :: gases_available !< Number of available gas components in
922	!< the chemistry model
923	INTEGER(iwp) :: i !< loop index for allocating
924	INTEGER(iwp) :: l !< loop index for allocating: surfaces
925	INTEGER(iwp) :: lsp !< loop index for chem species in the chemistry model
926
927	gases_available = 0
928
929	!
930	!-- Allocate prognostic variables (see salsa_swap_timelevel)
931	#if defined( __nopointer )
932	message_string = 'SALSA runs only with POINTER Version'
933	CALL message( 'salsa_mod: salsa_init_arrays', 'SA0023', 1, 2, 0, 6, 0 )
934	#else
935	!
936	!-- Set derived indices:
937	!-- (This does the same as the subroutine salsa_initialize in SALSA/
938	!-- UCLALES-SALSA)
939	in1a = 1 ! 1st index of subrange 1a
940	in2a = in1a + nbin(1) ! 1st index of subrange 2a
941	fn1a = in2a - 1 ! last index of subrange 1a
942	fn2a = fn1a + nbin(2) ! last index of subrange 2a
943
944	!
945	!-- If the fraction of insoluble aerosols in subrange 2 is zero: do not allocate
946	!-- arrays for them
947	IF ( nf2a > 0.999999_wp .AND. SUM( mass_fracs_b ) < 0.00001_wp ) THEN
948	no_insoluble = .TRUE.
949	in2b = fn2a+1 ! 1st index of subrange 2b
950	fn2b = fn2a ! last index of subrange 2b
951	ELSE
952	in2b = in2a + nbin(2) ! 1st index of subrange 2b
953	fn2b = fn2a + nbin(2) ! last index of subrange 2b
954	ENDIF
955
956
957	nbins = fn2b ! total number of aerosol size bins
958	!
959	!-- Create index tables for different aerosol components
960	CALL component_index_constructor( prtcl, ncc, maxspec, listspec )
961
962	ncc_tot = ncc
963	IF ( advect_particle_water ) ncc_tot = ncc + 1 ! Add water
964
965	!
966	!-- Allocate:
967	ALLOCATE( aero(nbins), bin_low_limits(nbins), nsect(nbins), massacc(nbins) )
968	IF ( nldepo ) ALLOCATE( sedim_vd(nzb:nzt+1,nysg:nyng,nxlg:nxrg,nbins) )
969	ALLOCATE( Ra_dry(nzb:nzt+1,nysg:nyng,nxlg:nxrg,nbins) )
970
971	!
972	!-- Aerosol number concentration
973	ALLOCATE( aerosol_number(nbins) )
974	ALLOCATE( nconc_1(nzb:nzt+1,nysg:nyng,nxlg:nxrg,nbins), &
975	nconc_2(nzb:nzt+1,nysg:nyng,nxlg:nxrg,nbins), &
976	nconc_3(nzb:nzt+1,nysg:nyng,nxlg:nxrg,nbins) )
977	nconc_1 = 0.0_wp
978	nconc_2 = 0.0_wp
979	nconc_3 = 0.0_wp
980
981	DO i = 1, nbins
982	aerosol_number(i)%conc(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => nconc_1(:,:,:,i)
983	aerosol_number(i)%conc_p(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => nconc_2(:,:,:,i)
984	aerosol_number(i)%tconc_m(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => nconc_3(:,:,:,i)
985	ALLOCATE( aerosol_number(i)%flux_s(nzb+1:nzt,0:threads_per_task-1), &
986	aerosol_number(i)%diss_s(nzb+1:nzt,0:threads_per_task-1), &
987	aerosol_number(i)%flux_l(nzb+1:nzt,nys:nyn,0:threads_per_task-1),&
988	aerosol_number(i)%diss_l(nzb+1:nzt,nys:nyn,0:threads_per_task-1),&
989	aerosol_number(i)%init(nzb:nzt+1), &
990	aerosol_number(i)%sums_ws_l(nzb:nzt+1,0:threads_per_task-1) )
991	ENDDO
992
993	!
994	!-- Aerosol mass concentration
995	ALLOCATE( aerosol_mass(ncc_tot*nbins) )
996	ALLOCATE( mconc_1(nzb:nzt+1,nysg:nyng,nxlg:nxrg,ncc_tot*nbins), &
997	mconc_2(nzb:nzt+1,nysg:nyng,nxlg:nxrg,ncc_tot*nbins), &
998	mconc_3(nzb:nzt+1,nysg:nyng,nxlg:nxrg,ncc_tot*nbins) )
999	mconc_1 = 0.0_wp
1000	mconc_2 = 0.0_wp
1001	mconc_3 = 0.0_wp
1002
1003	DO i = 1, ncc_tot*nbins
1004	aerosol_mass(i)%conc(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => mconc_1(:,:,:,i)
1005	aerosol_mass(i)%conc_p(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => mconc_2(:,:,:,i)
1006	aerosol_mass(i)%tconc_m(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => mconc_3(:,:,:,i)
1007	ALLOCATE( aerosol_mass(i)%flux_s(nzb+1:nzt,0:threads_per_task-1), &
1008	aerosol_mass(i)%diss_s(nzb+1:nzt,0:threads_per_task-1), &
1009	aerosol_mass(i)%flux_l(nzb+1:nzt,nys:nyn,0:threads_per_task-1),&
1010	aerosol_mass(i)%diss_l(nzb+1:nzt,nys:nyn,0:threads_per_task-1),&
1011	aerosol_mass(i)%init(nzb:nzt+1), &
1012	aerosol_mass(i)%sums_ws_l(nzb:nzt+1,0:threads_per_task-1) )
1013	ENDDO
1014
1015	!
1016	!-- Surface fluxes: answs = aerosol number, amsws = aerosol mass
1017	!
1018	!-- Horizontal surfaces: default type
1019	DO l = 0, 2 ! upward (l=0), downward (l=1) and model top (l=2)
1020	ALLOCATE( surf_def_h(l)%answs( 1:surf_def_h(l)%ns, nbins ) )
1021	ALLOCATE( surf_def_h(l)%amsws( 1:surf_def_h(l)%ns, nbins*ncc_tot ) )
1022	surf_def_h(l)%answs = 0.0_wp
1023	surf_def_h(l)%amsws = 0.0_wp
1024	ENDDO
1025	!-- Horizontal surfaces: natural type
1026	IF ( land_surface ) THEN
1027	ALLOCATE( surf_lsm_h%answs( 1:surf_lsm_h%ns, nbins ) )
1028	ALLOCATE( surf_lsm_h%amsws( 1:surf_lsm_h%ns, nbins*ncc_tot ) )
1029	surf_lsm_h%answs = 0.0_wp
1030	surf_lsm_h%amsws = 0.0_wp
1031	ENDIF
1032	!-- Horizontal surfaces: urban type
1033	IF ( urban_surface ) THEN
1034	ALLOCATE( surf_usm_h%answs( 1:surf_usm_h%ns, nbins ) )
1035	ALLOCATE( surf_usm_h%amsws( 1:surf_usm_h%ns, nbins*ncc_tot ) )
1036	surf_usm_h%answs = 0.0_wp
1037	surf_usm_h%amsws = 0.0_wp
1038	ENDIF
1039	!
1040	!-- Vertical surfaces: northward (l=0), southward (l=1), eastward (l=2) and
1041	!-- westward (l=3) facing
1042	DO l = 0, 3
1043	ALLOCATE( surf_def_v(l)%answs( 1:surf_def_v(l)%ns, nbins ) )
1044	surf_def_v(l)%answs = 0.0_wp
1045	ALLOCATE( surf_def_v(l)%amsws( 1:surf_def_v(l)%ns, nbins*ncc_tot ) )
1046	surf_def_v(l)%amsws = 0.0_wp
1047
1048	IF ( land_surface) THEN
1049	ALLOCATE( surf_lsm_v(l)%answs( 1:surf_lsm_v(l)%ns, nbins ) )
1050	surf_lsm_v(l)%answs = 0.0_wp
1051	ALLOCATE( surf_lsm_v(l)%amsws( 1:surf_lsm_v(l)%ns, nbins*ncc_tot ) )
1052	surf_lsm_v(l)%amsws = 0.0_wp
1053	ENDIF
1054
1055	IF ( urban_surface ) THEN
1056	ALLOCATE( surf_usm_v(l)%answs( 1:surf_usm_v(l)%ns, nbins ) )
1057	surf_usm_v(l)%answs = 0.0_wp
1058	ALLOCATE( surf_usm_v(l)%amsws( 1:surf_usm_v(l)%ns, nbins*ncc_tot ) )
1059	surf_usm_v(l)%amsws = 0.0_wp
1060	ENDIF
1061	ENDDO
1062
1063	!
1064	!-- Concentration of gaseous tracers (1. SO4, 2. HNO3, 3. NH3, 4. OCNV, 5. OCSV)
1065	!-- (number concentration (#/m3) )
1066	!
1067	!-- If chemistry is on, read gas phase concentrations from there. Otherwise,
1068	!-- allocate salsa_gas array.
1069
1070	IF ( air_chemistry ) THEN
1071	DO lsp = 1, nvar
1072	IF ( TRIM( chem_species(lsp)%name ) == 'H2SO4' ) THEN
1073	gases_available = gases_available + 1
1074	gas_index_chem(1) = lsp
1075	ELSEIF ( TRIM( chem_species(lsp)%name ) == 'HNO3' ) THEN
1076	gases_available = gases_available + 1
1077	gas_index_chem(2) = lsp
1078	ELSEIF ( TRIM( chem_species(lsp)%name ) == 'NH3' ) THEN
1079	gases_available = gases_available + 1
1080	gas_index_chem(3) = lsp
1081	ELSEIF ( TRIM( chem_species(lsp)%name ) == 'OCNV' ) THEN
1082	gases_available = gases_available + 1
1083	gas_index_chem(4) = lsp
1084	ELSEIF ( TRIM( chem_species(lsp)%name ) == 'OCSV' ) THEN
1085	gases_available = gases_available + 1
1086	gas_index_chem(5) = lsp
1087	ENDIF
1088	ENDDO
1089
1090	IF ( gases_available == ngast ) THEN
1091	salsa_gases_from_chem = .TRUE.
1092	ELSE
1093	WRITE( message_string, * ) 'SALSA is run together with chemistry '// &
1094	'but not all gaseous components are '// &
1095	'provided by kpp (H2SO4, HNO3, NH3, '// &
1096	'OCNV, OCSC)'
1097	CALL message( 'check_parameters', 'SA0024', 1, 2, 0, 6, 0 )
1098	ENDIF
1099
1100	ELSE
1101
1102	ALLOCATE( salsa_gas(ngast) )
1103	ALLOCATE( gconc_1(nzb:nzt+1,nysg:nyng,nxlg:nxrg,ngast), &
1104	gconc_2(nzb:nzt+1,nysg:nyng,nxlg:nxrg,ngast), &
1105	gconc_3(nzb:nzt+1,nysg:nyng,nxlg:nxrg,ngast) )
1106	gconc_1 = 0.0_wp
1107	gconc_2 = 0.0_wp
1108	gconc_3 = 0.0_wp
1109
1110	DO i = 1, ngast
1111	salsa_gas(i)%conc(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => gconc_1(:,:,:,i)
1112	salsa_gas(i)%conc_p(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => gconc_2(:,:,:,i)
1113	salsa_gas(i)%tconc_m(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => gconc_3(:,:,:,i)
1114	ALLOCATE( salsa_gas(i)%flux_s(nzb+1:nzt,0:threads_per_task-1), &
1115	salsa_gas(i)%diss_s(nzb+1:nzt,0:threads_per_task-1), &
1116	salsa_gas(i)%flux_l(nzb+1:nzt,nys:nyn,0:threads_per_task-1),&
1117	salsa_gas(i)%diss_l(nzb+1:nzt,nys:nyn,0:threads_per_task-1),&
1118	salsa_gas(i)%init(nzb:nzt+1), &
1119	salsa_gas(i)%sums_ws_l(nzb:nzt+1,0:threads_per_task-1) )
1120	ENDDO
1121	!
1122	!-- Surface fluxes: gtsws = gaseous tracer flux
1123	!
1124	!-- Horizontal surfaces: default type
1125	DO l = 0, 2 ! upward (l=0), downward (l=1) and model top (l=2)
1126	ALLOCATE( surf_def_h(l)%gtsws( 1:surf_def_h(l)%ns, ngast ) )
1127	surf_def_h(l)%gtsws = 0.0_wp
1128	ENDDO
1129	!-- Horizontal surfaces: natural type
1130	IF ( land_surface ) THEN
1131	ALLOCATE( surf_lsm_h%gtsws( 1:surf_lsm_h%ns, ngast ) )
1132	surf_lsm_h%gtsws = 0.0_wp
1133	ENDIF
1134	!-- Horizontal surfaces: urban type
1135	IF ( urban_surface ) THEN
1136	ALLOCATE( surf_usm_h%gtsws( 1:surf_usm_h%ns, ngast ) )
1137	surf_usm_h%gtsws = 0.0_wp
1138	ENDIF
1139	!
1140	!-- Vertical surfaces: northward (l=0), southward (l=1), eastward (l=2) and
1141	!-- westward (l=3) facing
1142	DO l = 0, 3
1143	ALLOCATE( surf_def_v(l)%gtsws( 1:surf_def_v(l)%ns, ngast ) )
1144	surf_def_v(l)%gtsws = 0.0_wp
1145	IF ( land_surface ) THEN
1146	ALLOCATE( surf_lsm_v(l)%gtsws( 1:surf_lsm_v(l)%ns, ngast ) )
1147	surf_lsm_v(l)%gtsws = 0.0_wp
1148	ENDIF
1149	IF ( urban_surface ) THEN
1150	ALLOCATE( surf_usm_v(l)%gtsws( 1:surf_usm_v(l)%ns, ngast ) )
1151	surf_usm_v(l)%gtsws = 0.0_wp
1152	ENDIF
1153	ENDDO
1154	ENDIF
1155
1156	#endif
1157
1158	END SUBROUTINE salsa_init_arrays
1159
1160	!------------------------------------------------------------------------------!
1161	! Description:
1162	! ------------
1163	!> Initialization of SALSA. Based on salsa_initialize in UCLALES-SALSA.
1164	!> Subroutines salsa_initialize, SALSAinit and DiagInitAero in UCLALES-SALSA are
1165	!> also merged here.
1166	!------------------------------------------------------------------------------!
1167	SUBROUTINE salsa_init
1168
1169	IMPLICIT NONE
1170
1171	INTEGER(iwp) :: b
1172	INTEGER(iwp) :: c
1173	INTEGER(iwp) :: g
1174	INTEGER(iwp) :: i
1175	INTEGER(iwp) :: j
1176
1177	bin_low_limits = 0.0_wp
1178	nsect = 0.0_wp
1179	massacc = 1.0_wp
1180
1181	!
1182	!-- Indices for chemical components used (-1 = not used)
1183	i = 0
1184	IF ( is_used( prtcl, 'SO4' ) ) THEN
1185	iso4 = get_index( prtcl,'SO4' )
1186	i = i + 1
1187	ENDIF
1188	IF ( is_used( prtcl,'OC' ) ) THEN
1189	ioc = get_index(prtcl, 'OC')
1190	i = i + 1
1191	ENDIF
1192	IF ( is_used( prtcl, 'BC' ) ) THEN
1193	ibc = get_index( prtcl, 'BC' )
1194	i = i + 1
1195	ENDIF
1196	IF ( is_used( prtcl, 'DU' ) ) THEN
1197	idu = get_index( prtcl, 'DU' )
1198	i = i + 1
1199	ENDIF
1200	IF ( is_used( prtcl, 'SS' ) ) THEN
1201	iss = get_index( prtcl, 'SS' )
1202	i = i + 1
1203	ENDIF
1204	IF ( is_used( prtcl, 'NO' ) ) THEN
1205	ino = get_index( prtcl, 'NO' )
1206	i = i + 1
1207	ENDIF
1208	IF ( is_used( prtcl, 'NH' ) ) THEN
1209	inh = get_index( prtcl, 'NH' )
1210	i = i + 1
1211	ENDIF
1212	!
1213	!-- All species must be known
1214	IF ( i /= ncc ) THEN
1215	message_string = 'Unknown aerosol species/component(s) given in the' // &
1216	' initialization'
1217	CALL message( 'salsa_mod: salsa_init', 'SA0020', 1, 2, 0, 6, 0 )
1218	ENDIF
1219
1220	!
1221	!-- Initialise
1222	!
1223	!-- Aerosol size distribution (TYPE t_section)
1224	aero(:)%dwet = 1.0E-10_wp
1225	aero(:)%veqh2o = 1.0E-10_wp
1226	aero(:)%numc = nclim
1227	aero(:)%core = 1.0E-10_wp
1228	DO c = 1, maxspec+1 ! 1:SO4, 2:OC, 3:BC, 4:DU, 5:SS, 6:NO, 7:NH, 8:H2O
1229	aero(:)%volc(c) = 0.0_wp
1230	ENDDO
1231
1232	IF ( nldepo ) sedim_vd = 0.0_wp
1233	!
1234	!-- Initilisation actions that are NOT conducted for restart runs
1235	IF ( .NOT. read_restart_data_salsa ) THEN
1236
1237	DO b = 1, nbins
1238	aerosol_number(b)%conc = nclim
1239	aerosol_number(b)%conc_p = 0.0_wp
1240	aerosol_number(b)%tconc_m = 0.0_wp
1241	aerosol_number(b)%flux_s = 0.0_wp
1242	aerosol_number(b)%diss_s = 0.0_wp
1243	aerosol_number(b)%flux_l = 0.0_wp
1244	aerosol_number(b)%diss_l = 0.0_wp
1245	aerosol_number(b)%init = nclim
1246	aerosol_number(b)%sums_ws_l = 0.0_wp
1247	ENDDO
1248	DO c = 1, ncc_tot*nbins
1249	aerosol_mass(c)%conc = mclim
1250	aerosol_mass(c)%conc_p = 0.0_wp
1251	aerosol_mass(c)%tconc_m = 0.0_wp
1252	aerosol_mass(c)%flux_s = 0.0_wp
1253	aerosol_mass(c)%diss_s = 0.0_wp
1254	aerosol_mass(c)%flux_l = 0.0_wp
1255	aerosol_mass(c)%diss_l = 0.0_wp
1256	aerosol_mass(c)%init = mclim
1257	aerosol_mass(c)%sums_ws_l = 0.0_wp
1258	ENDDO
1259
1260	IF ( .NOT. salsa_gases_from_chem ) THEN
1261	DO g = 1, ngast
1262	salsa_gas(g)%conc_p = 0.0_wp
1263	salsa_gas(g)%tconc_m = 0.0_wp
1264	salsa_gas(g)%flux_s = 0.0_wp
1265	salsa_gas(g)%diss_s = 0.0_wp
1266	salsa_gas(g)%flux_l = 0.0_wp
1267	salsa_gas(g)%diss_l = 0.0_wp
1268	salsa_gas(g)%sums_ws_l = 0.0_wp
1269	ENDDO
1270
1271	!
1272	!-- Set initial value for gas compound tracers and initial values
1273	salsa_gas(1)%conc = H2SO4_init
1274	salsa_gas(1)%init = H2SO4_init
1275	salsa_gas(2)%conc = HNO3_init
1276	salsa_gas(2)%init = HNO3_init
1277	salsa_gas(3)%conc = NH3_init
1278	salsa_gas(3)%init = NH3_init
1279	salsa_gas(4)%conc = OCNV_init
1280	salsa_gas(4)%init = OCNV_init
1281	salsa_gas(5)%conc = OCSV_init
1282	salsa_gas(5)%init = OCSV_init
1283	ENDIF
1284	!
1285	!-- Aerosol radius in each bin: dry and wet (m)
1286	Ra_dry = 1.0E-10_wp
1287	!
1288	!-- Initialise aerosol tracers
1289	aero(:)%vhilim = 0.0_wp
1290	aero(:)%vlolim = 0.0_wp
1291	aero(:)%vratiohi = 0.0_wp
1292	aero(:)%vratiolo = 0.0_wp
1293	aero(:)%dmid = 0.0_wp
1294	!
1295	!-- Initialise the sectional particle size distribution
1296	CALL set_sizebins()
1297	!
1298	!-- Initialise location-dependent aerosol size distributions and
1299	!-- chemical compositions:
1300	CALL aerosol_init
1301	!
1302	!-- Initalisation run of SALSA
1303	DO i = nxl, nxr
1304	DO j = nys, nyn
1305	CALL salsa_driver( i, j, 1 )
1306	CALL salsa_diagnostics( i, j )
1307	ENDDO
1308	ENDDO
1309	ENDIF
1310	!
1311	!-- Set the aerosol and gas sources
1312	IF ( salsa_source_mode == 'read_from_file' ) THEN
1313	CALL salsa_set_source
1314	ENDIF
1315
1316	END SUBROUTINE salsa_init
1317
1318	!------------------------------------------------------------------------------!
1319	! Description:
1320	! ------------
1321	!> Initializes particle size distribution grid by calculating size bin limits
1322	!> and mid-size for dry particles in each bin. Called from salsa_initialize
1323	!> (only at the beginning of simulation).
1324	!> Size distribution described using:
1325	!> 1) moving center method (subranges 1 and 2)
1326	!> (Jacobson, Atmos. Env., 31, 131-144, 1997)
1327	!> 2) fixed sectional method (subrange 3)
1328	!> Size bins in each subrange are spaced logarithmically
1329	!> based on given subrange size limits and bin number.
1330	!
1331	!> Mona changed 06/2017: Use geometric mean diameter to describe the mean
1332	!> particle diameter in a size bin, not the arithmeric mean which clearly
1333	!> overestimates the total particle volume concentration.
1334	!
1335	!> Coded by:
1336	!> Hannele Korhonen (FMI) 2005
1337	!> Harri Kokkola (FMI) 2006
1338	!
1339	!> Bug fixes for box model + updated for the new aerosol datatype:
1340	!> Juha Tonttila (FMI) 2014
1341	!------------------------------------------------------------------------------!
1342	SUBROUTINE set_sizebins
1343
1344	IMPLICIT NONE
1345	!
1346	!-- Local variables
1347	INTEGER(iwp) :: cc
1348	INTEGER(iwp) :: dd
1349	REAL(wp) :: ratio_d !< ratio of the upper and lower diameter of subranges
1350	!
1351	!-- vlolim&vhilim: min & max dry volumes [fxm]
1352	!-- dmid: bin mid dry diameter (m)
1353	!-- vratiolo&vratiohi: volume ratio between the center and low/high limit
1354	!
1355	!-- 1) Size subrange 1:
1356	ratio_d = reglim(2) / reglim(1) ! section spacing (m)
1357	DO cc = in1a,fn1a
1358	aero(cc)%vlolim = api6 * ( reglim(1) * ratio_d ** &
1359	( REAL( cc-1 ) / nbin(1) ) ) ** 3.0_wp
1360	aero(cc)%vhilim = api6 * ( reglim(1) * ratio_d ** &
1361	( REAL( cc ) / nbin(1) ) ) ** 3.0_wp
1362	aero(cc)%dmid = SQRT( ( aero(cc)%vhilim / api6 ) ** ( 1.0_wp / 3.0_wp ) &
1363	* ( aero(cc)%vlolim / api6 ) ** ( 1.0_wp / 3.0_wp ) )
1364	aero(cc)%vratiohi = aero(cc)%vhilim / ( api6 * aero(cc)%dmid ** 3.0_wp )
1365	aero(cc)%vratiolo = aero(cc)%vlolim / ( api6 * aero(cc)%dmid ** 3.0_wp )
1366	ENDDO
1367	!
1368	!-- 2) Size subrange 2:
1369	!-- 2.1) Sub-subrange 2a: high hygroscopicity
1370	ratio_d = reglim(3) / reglim(2) ! section spacing
1371	DO dd = in2a, fn2a
1372	cc = dd - in2a
1373	aero(dd)%vlolim = api6 * ( reglim(2) * ratio_d ** &
1374	( REAL( cc ) / nbin(2) ) ) ** 3.0_wp
1375	aero(dd)%vhilim = api6 * ( reglim(2) * ratio_d ** &
1376	( REAL( cc+1 ) / nbin(2) ) ) ** 3.0_wp
1377	aero(dd)%dmid = SQRT( ( aero(dd)%vhilim / api6 ) ** ( 1.0_wp / 3.0_wp ) &
1378	* ( aero(dd)%vlolim / api6 ) ** ( 1.0_wp / 3.0_wp ) )
1379	aero(dd)%vratiohi = aero(dd)%vhilim / ( api6 * aero(dd)%dmid ** 3.0_wp )
1380	aero(dd)%vratiolo = aero(dd)%vlolim / ( api6 * aero(dd)%dmid ** 3.0_wp )
1381	ENDDO
1382	!
1383	!-- 2.2) Sub-subrange 2b: low hygroscopicity
1384	IF ( .NOT. no_insoluble ) THEN
1385	aero(in2b:fn2b)%vlolim = aero(in2a:fn2a)%vlolim
1386	aero(in2b:fn2b)%vhilim = aero(in2a:fn2a)%vhilim
1387	aero(in2b:fn2b)%dmid = aero(in2a:fn2a)%dmid
1388	aero(in2b:fn2b)%vratiohi = aero(in2a:fn2a)%vratiohi
1389	aero(in2b:fn2b)%vratiolo = aero(in2a:fn2a)%vratiolo
1390	ENDIF
1391	!
1392	!-- Initialize the wet diameter with the bin dry diameter to avoid numerical
1393	!-- problems later
1394	aero(:)%dwet = aero(:)%dmid
1395	!
1396	!-- Save bin limits (lower diameter) to be delivered to the host model if needed
1397	DO cc = 1, nbins
1398	bin_low_limits(cc) = ( aero(cc)%vlolim / api6 )**( 1.0_wp / 3.0_wp )
1399	ENDDO
1400
1401	END SUBROUTINE set_sizebins
1402
1403	!------------------------------------------------------------------------------!
1404	! Description:
1405	! ------------
1406	!> Initilize altitude-dependent aerosol size distributions and compositions.
1407	!>
1408	!> Mona added 06/2017: Correct the number and mass concentrations by normalizing
1409	!< by the given total number and mass concentration.
1410	!>
1411	!> Tomi Raatikainen, FMI, 29.2.2016
1412	!------------------------------------------------------------------------------!
1413	SUBROUTINE aerosol_init
1414
1415	USE arrays_3d, &
1416	ONLY: zu
1417
1418	! USE NETCDF
1419
1420	USE netcdf_data_input_mod, &
1421	ONLY: get_attribute, netcdf_data_input_get_dimension_length, &
1422	get_variable, open_read_file
1423
1424	IMPLICIT NONE
1425
1426	INTEGER(iwp) :: b !< loop index: size bins
1427	INTEGER(iwp) :: c !< loop index: chemical components
1428	INTEGER(iwp) :: ee !< index: end
1429	INTEGER(iwp) :: g !< loop index: gases
1430	INTEGER(iwp) :: i !< loop index: x-direction
1431	INTEGER(iwp) :: id_faero !< NetCDF id of PIDS_SALSA
1432	INTEGER(iwp) :: id_fchem !< NetCDF id of PIDS_CHEM
1433	INTEGER(iwp) :: j !< loop index: y-direction
1434	INTEGER(iwp) :: k !< loop index: z-direction
1435	INTEGER(iwp) :: kk !< loop index: z-direction
1436	INTEGER(iwp) :: nz_file !< Number of grid-points in file (heights)
1437	INTEGER(iwp) :: prunmode
1438	INTEGER(iwp) :: ss !< index: start
1439	LOGICAL :: netcdf_extend = .FALSE. !< Flag indicating wether netcdf
1440	!< topography input file or not
1441	REAL(wp), DIMENSION(nbins) :: core !< size of the bin mid aerosol particle,
1442	REAL(wp) :: flag !< flag to mask topography grid points
1443	REAL(wp), DIMENSION(:,:), ALLOCATABLE :: pr_gas !< gas profiles
1444	REAL(wp), DIMENSION(:,:), ALLOCATABLE :: pr_mass_fracs_a !< mass fraction
1445	!< profiles: a
1446	REAL(wp), DIMENSION(:,:), ALLOCATABLE :: pr_mass_fracs_b !< and b
1447	REAL(wp), DIMENSION(:,:), ALLOCATABLE :: pr_nsect !< sectional size
1448	!< distribution profile
1449	REAL(wp), DIMENSION(nbins) :: nsect !< size distribution (#/m3)
1450	REAL(wp), DIMENSION(0:nz+1,nbins) :: pndist !< size dist as a function
1451	!< of height (#/m3)
1452	REAL(wp), DIMENSION(0:nz+1) :: pnf2a !< number fraction: bins 2a
1453	REAL(wp), DIMENSION(0:nz+1,maxspec) :: pvf2a !< mass distributions of
1454	!< aerosol species for a
1455	REAL(wp), DIMENSION(0:nz+1,maxspec) :: pvf2b !< and b-bins
1456	REAL(wp), DIMENSION(0:nz+1) :: pvfOC1a !< mass fraction between
1457	!< SO4 and OC in 1a
1458	REAL(wp), DIMENSION(:), ALLOCATABLE :: pr_z
1459
1460	prunmode = 1
1461	!
1462	!-- Bin mean aerosol particle volume (m3)
1463	core(:) = 0.0_wp
1464	core(1:nbins) = api6 * aero(1:nbins)%dmid ** 3.0_wp
1465	!
1466	!-- Set concentrations to zero
1467	nsect(:) = 0.0_wp
1468	pndist(:,:) = 0.0_wp
1469	pnf2a(:) = nf2a
1470	pvf2a(:,:) = 0.0_wp
1471	pvf2b(:,:) = 0.0_wp
1472	pvfOC1a(:) = 0.0_wp
1473
1474	IF ( isdtyp == 1 ) THEN
1475	!
1476	!-- Read input profiles from PIDS_SALSA
1477	#if defined( __netcdf )
1478	!
1479	!-- Location-dependent size distributions and compositions.
1480	INQUIRE( FILE='PIDS_SALSA'// TRIM( coupling_char ), EXIST=netcdf_extend )
1481	IF ( netcdf_extend ) THEN
1482	!
1483	!-- Open file in read-only mode
1484	CALL open_read_file( 'PIDS_SALSA' // TRIM( coupling_char ), id_faero )
1485	!
1486	!-- Input heights
1487	CALL netcdf_data_input_get_dimension_length( id_faero, nz_file, "profile_z" )
1488
1489	ALLOCATE( pr_z(nz_file), pr_mass_fracs_a(maxspec,nz_file), &
1490	pr_mass_fracs_b(maxspec,nz_file), pr_nsect(nbins,nz_file) )
1491	CALL get_variable( id_faero, 'profile_z', pr_z )
1492	!
1493	!-- Mass fracs profile: 1: H2SO4 (sulphuric acid), 2: OC (organic carbon),
1494	!-- 3: BC (black carbon), 4: DU (dust),
1495	!-- 5: SS (sea salt), 6: HNO3 (nitric acid),
1496	!-- 7: NH3 (ammonia)
1497	CALL get_variable( id_faero, "profile_mass_fracs_a", pr_mass_fracs_a,&
1498	0, nz_file-1, 0, maxspec-1 )
1499	CALL get_variable( id_faero, "profile_mass_fracs_b", pr_mass_fracs_b,&
1500	0, nz_file-1, 0, maxspec-1 )
1501	CALL get_variable( id_faero, "profile_nsect", pr_nsect, 0, nz_file-1,&
1502	0, nbins-1 )
1503
1504	kk = 1
1505	DO k = nzb, nz+1
1506	IF ( kk < nz_file ) THEN
1507	DO WHILE ( pr_z(kk+1) <= zu(k) )
1508	kk = kk + 1
1509	IF ( kk == nz_file ) EXIT
1510	ENDDO
1511	ENDIF
1512	IF ( kk < nz_file ) THEN
1513	!
1514	!-- Set initial value for gas compound tracers and initial values
1515	pvf2a(k,:) = pr_mass_fracs_a(:,kk) + ( zu(k) - pr_z(kk) ) / ( &
1516	pr_z(kk+1) - pr_z(kk) ) * ( pr_mass_fracs_a(:,kk+1)&
1517	- pr_mass_fracs_a(:,kk) )
1518	pvf2b(k,:) = pr_mass_fracs_b(:,kk) + ( zu(k) - pr_z(kk) ) / ( &
1519	pr_z(kk+1) - pr_z(kk) ) * ( pr_mass_fracs_b(:,kk+1)&
1520	- pr_mass_fracs_b(:,kk) )
1521	pndist(k,:) = pr_nsect(:,kk) + ( zu(k) - pr_z(kk) ) / ( &
1522	pr_z(kk+1) - pr_z(kk) ) * ( pr_nsect(:,kk+1) - &
1523	pr_nsect(:,kk) )
1524	ELSE
1525	pvf2a(k,:) = pr_mass_fracs_a(:,kk)
1526	pvf2b(k,:) = pr_mass_fracs_b(:,kk)
1527	pndist(k,:) = pr_nsect(:,kk)
1528	ENDIF
1529	IF ( iso4 < 0 ) THEN
1530	pvf2a(k,1) = 0.0_wp
1531	pvf2b(k,1) = 0.0_wp
1532	ENDIF
1533	IF ( ioc < 0 ) THEN
1534	pvf2a(k,2) = 0.0_wp
1535	pvf2b(k,2) = 0.0_wp
1536	ENDIF
1537	IF ( ibc < 0 ) THEN
1538	pvf2a(k,3) = 0.0_wp
1539	pvf2b(k,3) = 0.0_wp
1540	ENDIF
1541	IF ( idu < 0 ) THEN
1542	pvf2a(k,4) = 0.0_wp
1543	pvf2b(k,4) = 0.0_wp
1544	ENDIF
1545	IF ( iss < 0 ) THEN
1546	pvf2a(k,5) = 0.0_wp
1547	pvf2b(k,5) = 0.0_wp
1548	ENDIF
1549	IF ( ino < 0 ) THEN
1550	pvf2a(k,6) = 0.0_wp
1551	pvf2b(k,6) = 0.0_wp
1552	ENDIF
1553	IF ( inh < 0 ) THEN
1554	pvf2a(k,7) = 0.0_wp
1555	pvf2b(k,7) = 0.0_wp
1556	ENDIF
1557	!
1558	!-- Then normalise the mass fraction so that SUM = 1
1559	pvf2a(k,:) = pvf2a(k,:) / SUM( pvf2a(k,:) )
1560	IF ( SUM( pvf2b(k,:) ) > 0.0_wp ) pvf2b(k,:) = pvf2b(k,:) / &
1561	SUM( pvf2b(k,:) )
1562	ENDDO
1563	DEALLOCATE( pr_z, pr_mass_fracs_a, pr_mass_fracs_b, pr_nsect )
1564	ELSE
1565	message_string = 'Input file '// TRIM( 'PIDS_SALSA' ) // &
1566	TRIM( coupling_char ) // ' for SALSA missing!'
1567	CALL message( 'salsa_mod: aerosol_init', 'SA0032', 1, 2, 0, 6, 0 )
1568	ENDIF ! netcdf_extend
1569	#endif
1570
1571	ELSEIF ( isdtyp == 0 ) THEN
1572	!
1573	!-- Mass fractions for species in a and b-bins
1574	IF ( iso4 > 0 ) THEN
1575	pvf2a(:,1) = mass_fracs_a(iso4)
1576	pvf2b(:,1) = mass_fracs_b(iso4)
1577	ENDIF
1578	IF ( ioc > 0 ) THEN
1579	pvf2a(:,2) = mass_fracs_a(ioc)
1580	pvf2b(:,2) = mass_fracs_b(ioc)
1581	ENDIF
1582	IF ( ibc > 0 ) THEN
1583	pvf2a(:,3) = mass_fracs_a(ibc)
1584	pvf2b(:,3) = mass_fracs_b(ibc)
1585	ENDIF
1586	IF ( idu > 0 ) THEN
1587	pvf2a(:,4) = mass_fracs_a(idu)
1588	pvf2b(:,4) = mass_fracs_b(idu)
1589	ENDIF
1590	IF ( iss > 0 ) THEN
1591	pvf2a(:,5) = mass_fracs_a(iss)
1592	pvf2b(:,5) = mass_fracs_b(iss)
1593	ENDIF
1594	IF ( ino > 0 ) THEN
1595	pvf2a(:,6) = mass_fracs_a(ino)
1596	pvf2b(:,6) = mass_fracs_b(ino)
1597	ENDIF
1598	IF ( inh > 0 ) THEN
1599	pvf2a(:,7) = mass_fracs_a(inh)
1600	pvf2b(:,7) = mass_fracs_b(inh)
1601	ENDIF
1602	DO k = nzb, nz+1
1603	pvf2a(k,:) = pvf2a(k,:) / SUM( pvf2a(k,:) )
1604	IF ( SUM( pvf2b(k,:) ) > 0.0_wp ) pvf2b(k,:) = pvf2b(k,:) / &
1605	SUM( pvf2b(k,:) )
1606	ENDDO
1607
1608	CALL size_distribution( n_lognorm, dpg, sigmag, nsect )
1609	!
1610	!-- Normalize by the given total number concentration
1611	nsect = nsect * SUM( n_lognorm ) * 1.0E+6_wp / SUM( nsect )
1612	DO b = in1a, fn2b
1613	pndist(:,b) = nsect(b)
1614	ENDDO
1615	ENDIF
1616
1617	IF ( igctyp == 1 ) THEN
1618	!
1619	!-- Read input profiles from PIDS_CHEM
1620	#if defined( __netcdf )
1621	!
1622	!-- Location-dependent size distributions and compositions.
1623	INQUIRE( FILE='PIDS_CHEM' // TRIM( coupling_char ), EXIST=netcdf_extend )
1624	IF ( netcdf_extend .AND. .NOT. salsa_gases_from_chem ) THEN
1625	!
1626	!-- Open file in read-only mode
1627	CALL open_read_file( 'PIDS_CHEM' // TRIM( coupling_char ), id_fchem )
1628	!
1629	!-- Input heights
1630	CALL netcdf_data_input_get_dimension_length( id_fchem, nz_file, "profile_z" )
1631	ALLOCATE( pr_z(nz_file), pr_gas(ngast,nz_file) )
1632	CALL get_variable( id_fchem, 'profile_z', pr_z )
1633	!
1634	!-- Gases:
1635	CALL get_variable( id_fchem, "profile_H2SO4", pr_gas(1,:) )
1636	CALL get_variable( id_fchem, "profile_HNO3", pr_gas(2,:) )
1637	CALL get_variable( id_fchem, "profile_NH3", pr_gas(3,:) )
1638	CALL get_variable( id_fchem, "profile_OCNV", pr_gas(4,:) )
1639	CALL get_variable( id_fchem, "profile_OCSV", pr_gas(5,:) )
1640
1641	kk = 1
1642	DO k = nzb, nz+1
1643	IF ( kk < nz_file ) THEN
1644	DO WHILE ( pr_z(kk+1) <= zu(k) )
1645	kk = kk + 1
1646	IF ( kk == nz_file ) EXIT
1647	ENDDO
1648	ENDIF
1649	IF ( kk < nz_file ) THEN
1650	!
1651	!-- Set initial value for gas compound tracers and initial values
1652	DO g = 1, ngast
1653	salsa_gas(g)%init(k) = pr_gas(g,kk) + ( zu(k) - pr_z(kk) ) &
1654	/ ( pr_z(kk+1) - pr_z(kk) ) * &
1655	( pr_gas(g,kk+1) - pr_gas(g,kk) )
1656	salsa_gas(g)%conc(k,:,:) = salsa_gas(g)%init(k)
1657	ENDDO
1658	ELSE
1659	DO g = 1, ngast
1660	salsa_gas(g)%init(k) = pr_gas(g,kk)
1661	salsa_gas(g)%conc(k,:,:) = salsa_gas(g)%init(k)
1662	ENDDO
1663	ENDIF
1664	ENDDO
1665
1666	DEALLOCATE( pr_z, pr_gas )
1667	ELSEIF ( .NOT. netcdf_extend .AND. .NOT. salsa_gases_from_chem ) THEN
1668	message_string = 'Input file '// TRIM( 'PIDS_CHEM' ) // &
1669	TRIM( coupling_char ) // ' for SALSA missing!'
1670	CALL message( 'salsa_mod: aerosol_init', 'SA0033', 1, 2, 0, 6, 0 )
1671	ENDIF ! netcdf_extend
1672	#endif
1673
1674	ENDIF
1675
1676	IF ( ioc > 0 .AND. iso4 > 0 ) THEN
1677	!-- Both are there, so use the given "massDistrA"
1678	pvfOC1a(:) = pvf2a(:,2) / ( pvf2a(:,2) + pvf2a(:,1) ) ! Normalize
1679	ELSEIF ( ioc > 0 ) THEN
1680	!-- Pure organic carbon
1681	pvfOC1a(:) = 1.0_wp
1682	ELSEIF ( iso4 > 0 ) THEN
1683	!-- Pure SO4
1684	pvfOC1a(:) = 0.0_wp
1685	ELSE
1686	message_string = 'Either OC or SO4 must be active for aerosol region 1a!'
1687	CALL message( 'salsa_mod: aerosol_init', 'SA0021', 1, 2, 0, 6, 0 )
1688	ENDIF
1689
1690	!
1691	!-- Initialize concentrations
1692	DO i = nxlg, nxrg
1693	DO j = nysg, nyng
1694	DO k = nzb, nzt+1
1695	!
1696	!-- Predetermine flag to mask topography
1697	flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_0(k,j,i), 0 ) )
1698	!
1699	!-- a) Number concentrations
1700	!-- Region 1:
1701	DO b = in1a, fn1a
1702	aerosol_number(b)%conc(k,j,i) = pndist(k,b) * flag
1703	IF ( prunmode == 1 ) THEN
1704	aerosol_number(b)%init = pndist(:,b)
1705	ENDIF
1706	ENDDO
1707	!
1708	!-- Region 2:
1709	IF ( nreg > 1 ) THEN
1710	DO b = in2a, fn2a
1711	aerosol_number(b)%conc(k,j,i) = MAX( 0.0_wp, pnf2a(k) ) * &
1712	pndist(k,b) * flag
1713	IF ( prunmode == 1 ) THEN
1714	aerosol_number(b)%init = MAX( 0.0_wp, nf2a ) * pndist(:,b)
1715	ENDIF
1716	ENDDO
1717	IF ( .NOT. no_insoluble ) THEN
1718	DO b = in2b, fn2b
1719	IF ( pnf2a(k) < 1.0_wp ) THEN
1720	aerosol_number(b)%conc(k,j,i) = MAX( 0.0_wp, 1.0_wp &
1721	- pnf2a(k) ) * pndist(k,b) * flag
1722	IF ( prunmode == 1 ) THEN
1723	aerosol_number(b)%init = MAX( 0.0_wp, 1.0_wp - &
1724	nf2a ) * pndist(:,b)
1725	ENDIF
1726	ENDIF
1727	ENDDO
1728	ENDIF
1729	ENDIF
1730	!
1731	!-- b) Aerosol mass concentrations
1732	!-- bin subrange 1: done here separately due to the SO4/OC convention
1733	!-- SO4:
1734	IF ( iso4 > 0 ) THEN
1735	ss = ( iso4 - 1 ) * nbins + in1a !< start
1736	ee = ( iso4 - 1 ) * nbins + fn1a !< end
1737	b = in1a
1738	DO c = ss, ee
1739	aerosol_mass(c)%conc(k,j,i) = MAX( 0.0_wp, 1.0_wp - &
1740	pvfOC1a(k) ) * pndist(k,b) * &
1741	core(b) * arhoh2so4 * flag
1742	IF ( prunmode == 1 ) THEN
1743	aerosol_mass(c)%init = MAX( 0.0_wp, 1.0_wp - MAXVAL( &
1744	pvfOC1a ) ) * pndist(:,b) * &
1745	core(b) * arhoh2so4
1746	ENDIF
1747	b = b+1
1748	ENDDO
1749	ENDIF
1750	!-- OC:
1751	IF ( ioc > 0 ) THEN
1752	ss = ( ioc - 1 ) * nbins + in1a !< start
1753	ee = ( ioc - 1 ) * nbins + fn1a !< end
1754	b = in1a
1755	DO c = ss, ee
1756	aerosol_mass(c)%conc(k,j,i) = MAX( 0.0_wp, pvfOC1a(k) ) * &
1757	pndist(k,b) * core(b) * arhooc * flag
1758	IF ( prunmode == 1 ) THEN
1759	aerosol_mass(c)%init = MAX( 0.0_wp, MAXVAL( pvfOC1a ) ) &
1760	* pndist(:,b) * core(b) * arhooc
1761	ENDIF
1762	b = b+1
1763	ENDDO
1764	ENDIF
1765
1766	prunmode = 3 ! Init only once
1767
1768	ENDDO !< k
1769	ENDDO !< j
1770	ENDDO !< i
1771
1772	!
1773	!-- c) Aerosol mass concentrations
1774	!-- bin subrange 2:
1775	IF ( nreg > 1 ) THEN
1776
1777	IF ( iso4 > 0 ) THEN
1778	CALL set_aero_mass( iso4, pvf2a(:,1), pvf2b(:,1), pnf2a, pndist, &
1779	core, arhoh2so4 )
1780	ENDIF
1781	IF ( ioc > 0 ) THEN
1782	CALL set_aero_mass( ioc, pvf2a(:,2), pvf2b(:,2), pnf2a, pndist, core,&
1783	arhooc )
1784	ENDIF
1785	IF ( ibc > 0 ) THEN
1786	CALL set_aero_mass( ibc, pvf2a(:,3), pvf2b(:,3), pnf2a, pndist, core,&
1787	arhobc )
1788	ENDIF
1789	IF ( idu > 0 ) THEN
1790	CALL set_aero_mass( idu, pvf2a(:,4), pvf2b(:,4), pnf2a, pndist, core,&
1791	arhodu )
1792	ENDIF
1793	IF ( iss > 0 ) THEN
1794	CALL set_aero_mass( iss, pvf2a(:,5), pvf2b(:,5), pnf2a, pndist, core,&
1795	arhoss )
1796	ENDIF
1797	IF ( ino > 0 ) THEN
1798	CALL set_aero_mass( ino, pvf2a(:,6), pvf2b(:,6), pnf2a, pndist, core,&
1799	arhohno3 )
1800	ENDIF
1801	IF ( inh > 0 ) THEN
1802	CALL set_aero_mass( inh, pvf2a(:,7), pvf2b(:,7), pnf2a, pndist, core,&
1803	arhonh3 )
1804	ENDIF
1805
1806	ENDIF
1807
1808	END SUBROUTINE aerosol_init
1809
1810	!------------------------------------------------------------------------------!
1811	! Description:
1812	! ------------
1813	!> Create a lognormal size distribution and discretise to a sectional
1814	!> representation.
1815	!------------------------------------------------------------------------------!
1816	SUBROUTINE size_distribution( in_ntot, in_dpg, in_sigma, psd_sect )
1817
1818	IMPLICIT NONE
1819
1820	!-- Log-normal size distribution: modes
1821	REAL(wp), DIMENSION(:), INTENT(in) :: in_dpg !< geometric mean diameter
1822	!< (micrometres)
1823	REAL(wp), DIMENSION(:), INTENT(in) :: in_ntot !< number conc. (#/cm3)
1824	REAL(wp), DIMENSION(:), INTENT(in) :: in_sigma !< standard deviation
1825	REAL(wp), DIMENSION(:), INTENT(inout) :: psd_sect !< sectional size
1826	!< distribution
1827	INTEGER(iwp) :: b !< running index: bin
1828	INTEGER(iwp) :: ib !< running index: iteration
1829	REAL(wp) :: d1 !< particle diameter (m, dummy)
1830	REAL(wp) :: d2 !< particle diameter (m, dummy)
1831	REAL(wp) :: delta_d !< (d2-d1)/10
1832	REAL(wp) :: deltadp !< bin width
1833	REAL(wp) :: dmidi !< ( d1 + d2 ) / 2
1834
1835	DO b = in1a, fn2b !< aerosol size bins
1836	psd_sect(b) = 0.0_wp
1837	!-- Particle diameter at the low limit (largest in the bin) (m)
1838	d1 = ( aero(b)%vlolim / api6 ) ** ( 1.0_wp / 3.0_wp )
1839	!-- Particle diameter at the high limit (smallest in the bin) (m)
1840	d2 = ( aero(b)%vhilim / api6 ) ** ( 1.0_wp / 3.0_wp )
1841	!-- Span of particle diameter in a bin (m)
1842	delta_d = ( d2 - d1 ) / 10.0_wp
1843	!-- Iterate:
1844	DO ib = 1, 10
1845	d1 = ( aero(b)%vlolim / api6 ) ** ( 1.0_wp / 3.0_wp ) + ( ib - 1) &
1846	* delta_d
1847	d2 = d1 + delta_d
1848	dmidi = ( d1 + d2 ) / 2.0_wp
1849	deltadp = LOG10( d2 / d1 )
1850
1851	!-- Size distribution
1852	!-- in_ntot = total number, total area, or total volume concentration
1853	!-- in_dpg = geometric-mean number, area, or volume diameter
1854	!-- n(k) = number, area, or volume concentration in a bin
1855	!-- n_lognorm and dpg converted to units of #/m3 and m
1856	psd_sect(b) = psd_sect(b) + SUM( in_ntot * 1.0E+6_wp * deltadp / &
1857	( SQRT( 2.0_wp * pi ) * LOG10( in_sigma ) ) * &
1858	EXP( -LOG10( dmidi / ( 1.0E-6_wp * in_dpg ) )**2.0_wp / &
1859	( 2.0_wp * LOG10( in_sigma ) ** 2.0_wp ) ) )
1860
1861	ENDDO
1862	ENDDO
1863
1864	END SUBROUTINE size_distribution
1865
1866	!------------------------------------------------------------------------------!
1867	! Description:
1868	! ------------
1869	!> Sets the mass concentrations to aerosol arrays in 2a and 2b.
1870	!>
1871	!> Tomi Raatikainen, FMI, 29.2.2016
1872	!------------------------------------------------------------------------------!
1873	SUBROUTINE set_aero_mass( ispec, ppvf2a, ppvf2b, ppnf2a, ppndist, pcore, prho )
1874
1875	IMPLICIT NONE
1876
1877	INTEGER(iwp), INTENT(in) :: ispec !< Aerosol species index
1878	REAL(wp), INTENT(in) :: pcore(nbins) !< Aerosol bin mid core volume
1879	REAL(wp), INTENT(in) :: ppndist(0:nz+1,nbins) !< Aerosol size distribution
1880	REAL(wp), INTENT(in) :: ppnf2a(0:nz+1) !< Number fraction for 2a
1881	REAL(wp), INTENT(in) :: ppvf2a(0:nz+1) !< Mass distributions for a
1882	REAL(wp), INTENT(in) :: ppvf2b(0:nz+1) !< and b bins
1883	REAL(wp), INTENT(in) :: prho !< Aerosol density
1884	INTEGER(iwp) :: b !< loop index
1885	INTEGER(iwp) :: c !< loop index
1886	INTEGER(iwp) :: ee !< index: end
1887	INTEGER(iwp) :: i !< loop index
1888	INTEGER(iwp) :: j !< loop index
1889	INTEGER(iwp) :: k !< loop index
1890	INTEGER(iwp) :: prunmode !< 1 = initialise
1891	INTEGER(iwp) :: ss !< index: start
1892	REAL(wp) :: flag !< flag to mask topography grid points
1893
1894	prunmode = 1
1895
1896	DO i = nxlg, nxrg
1897	DO j = nysg, nyng
1898	DO k = nzb, nzt+1
1899	!
1900	!-- Predetermine flag to mask topography
1901	flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_0(k,j,i), 0 ) )
1902	!
1903	!-- Regime 2a:
1904	ss = ( ispec - 1 ) * nbins + in2a
1905	ee = ( ispec - 1 ) * nbins + fn2a
1906	b = in2a
1907	DO c = ss, ee
1908	aerosol_mass(c)%conc(k,j,i) = MAX( 0.0_wp, ppvf2a(k) ) * &
1909	ppnf2a(k) * ppndist(k,b) * pcore(b) * prho * flag
1910	IF ( prunmode == 1 ) THEN
1911	aerosol_mass(c)%init = MAX( 0.0_wp, MAXVAL( ppvf2a(:) ) ) * &
1912	MAXVAL( ppnf2a ) * pcore(b) * prho * &
1913	MAXVAL( ppndist(:,b) )
1914	ENDIF
1915	b = b+1
1916	ENDDO
1917	!-- Regime 2b:
1918	IF ( .NOT. no_insoluble ) THEN
1919	ss = ( ispec - 1 ) * nbins + in2b
1920	ee = ( ispec - 1 ) * nbins + fn2b
1921	b = in2a
1922	DO c = ss, ee
1923	aerosol_mass(c)%conc(k,j,i) = MAX( 0.0_wp, ppvf2b(k) ) * ( &
1924	1.0_wp - ppnf2a(k) ) * ppndist(k,b) * &
1925	pcore(b) * prho * flag
1926	IF ( prunmode == 1 ) THEN
1927	aerosol_mass(c)%init = MAX( 0.0_wp, MAXVAL( ppvf2b(:) ) )&
1928	* ( 1.0_wp - MAXVAL( ppnf2a ) ) * &
1929	MAXVAL( ppndist(:,b) ) * pcore(b) * prho
1930	ENDIF
1931	b = b+1
1932	ENDDO
1933	ENDIF
1934	prunmode = 3 ! Init only once
1935	ENDDO
1936	ENDDO
1937	ENDDO
1938	END SUBROUTINE set_aero_mass
1939
1940	!------------------------------------------------------------------------------!
1941	! Description:
1942	! ------------
1943	!> Swapping of timelevels
1944	!------------------------------------------------------------------------------!
1945	SUBROUTINE salsa_swap_timelevel( mod_count )
1946
1947	IMPLICIT NONE
1948
1949	INTEGER(iwp), INTENT(IN) :: mod_count !<
1950	INTEGER(iwp) :: b !<
1951	INTEGER(iwp) :: c !<
1952	INTEGER(iwp) :: cc !<
1953	INTEGER(iwp) :: g !<
1954
1955	!
1956	!-- Example for prognostic variable "prog_var"
1957	#if defined( __nopointer )
1958	IF ( myid == 0 ) THEN
1959	message_string = ' SALSA runs only with POINTER Version'
1960	CALL message( 'salsa_swap_timelevel', 'SA0022', 1, 2, 0, 6, 0 )
1961	ENDIF
1962	#else
1963
1964	SELECT CASE ( mod_count )
1965
1966	CASE ( 0 )
1967
1968	DO b = 1, nbins
1969	aerosol_number(b)%conc(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => &
1970	nconc_1(:,:,:,b)
1971	aerosol_number(b)%conc_p(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => &
1972	nconc_2(:,:,:,b)
1973	DO c = 1, ncc_tot
1974	cc = ( c-1 ) * nbins + b ! required due to possible Intel18 bug
1975	aerosol_mass(cc)%conc(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => &
1976	mconc_1(:,:,:,cc)
1977	aerosol_mass(cc)%conc_p(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => &
1978	mconc_2(:,:,:,cc)
1979	ENDDO
1980	ENDDO
1981
1982	IF ( .NOT. salsa_gases_from_chem ) THEN
1983	DO g = 1, ngast
1984	salsa_gas(g)%conc(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => &
1985	gconc_1(:,:,:,g)
1986	salsa_gas(g)%conc_p(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => &
1987	gconc_2(:,:,:,g)
1988	ENDDO
1989	ENDIF
1990
1991	CASE ( 1 )
1992
1993	DO b = 1, nbins
1994	aerosol_number(b)%conc(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => &
1995	nconc_2(:,:,:,b)
1996	aerosol_number(b)%conc_p(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => &
1997	nconc_1(:,:,:,b)
1998	DO c = 1, ncc_tot
1999	cc = ( c-1 ) * nbins + b ! required due to possible Intel18 bug
2000	aerosol_mass(cc)%conc(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => &
2001	mconc_2(:,:,:,cc)
2002	aerosol_mass(cc)%conc_p(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => &
2003	mconc_1(:,:,:,cc)
2004	ENDDO
2005	ENDDO
2006
2007	IF ( .NOT. salsa_gases_from_chem ) THEN
2008	DO g = 1, ngast
2009	salsa_gas(g)%conc(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => &
2010	gconc_2(:,:,:,g)
2011	salsa_gas(g)%conc_p(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => &
2012	gconc_1(:,:,:,g)
2013	ENDDO
2014	ENDIF
2015
2016	END SELECT
2017	#endif
2018
2019	END SUBROUTINE salsa_swap_timelevel
2020
2021
2022	!------------------------------------------------------------------------------!
2023	! Description:
2024	! ------------
2025	!> This routine reads the respective restart data.
2026	!------------------------------------------------------------------------------!
2027	SUBROUTINE salsa_rrd_local
2028
2029
2030	IMPLICIT NONE
2031
2032	CHARACTER (LEN=20) :: field_char !<
2033	INTEGER(iwp) :: b !<
2034	INTEGER(iwp) :: c !<
2035	INTEGER(iwp) :: g !<
2036	INTEGER(iwp) :: i !<
2037	INTEGER(iwp) :: j !<
2038	INTEGER(iwp) :: k !<
2039
2040	IF ( read_restart_data_salsa ) THEN
2041	READ ( 13 ) field_char
2042
2043	DO WHILE ( TRIM( field_char ) /= '* end salsa *' )
2044
2045	DO b = 1, nbins
2046	READ ( 13 ) aero(b)%vlolim
2047	READ ( 13 ) aero(b)%vhilim
2048	READ ( 13 ) aero(b)%dmid
2049	READ ( 13 ) aero(b)%vratiohi
2050	READ ( 13 ) aero(b)%vratiolo
2051	ENDDO
2052
2053	DO i = nxl, nxr
2054	DO j = nys, nyn
2055	DO k = nzb+1, nzt
2056	DO b = 1, nbins
2057	READ ( 13 ) aerosol_number(b)%conc(k,j,i)
2058	DO c = 1, ncc_tot
2059	READ ( 13 ) aerosol_mass((c-1)*nbins+b)%conc(k,j,i)
2060	ENDDO
2061	ENDDO
2062	IF ( .NOT. salsa_gases_from_chem ) THEN
2063	DO g = 1, ngast
2064	READ ( 13 ) salsa_gas(g)%conc(k,j,i)
2065	ENDDO
2066	ENDIF
2067	ENDDO
2068	ENDDO
2069	ENDDO
2070
2071	READ ( 13 ) field_char
2072
2073	ENDDO
2074
2075	ENDIF
2076
2077	END SUBROUTINE salsa_rrd_local
2078
2079
2080	!------------------------------------------------------------------------------!
2081	! Description:
2082	! ------------
2083	!> This routine writes the respective restart data.
2084	!> Note that the following input variables in PARIN have to be equal between
2085	!> restart runs:
2086	!> listspec, nbin, nbin2, nf2a, ncc, mass_fracs_a, mass_fracs_b
2087	!------------------------------------------------------------------------------!
2088	SUBROUTINE salsa_wrd_local
2089
2090	IMPLICIT NONE
2091
2092	INTEGER(iwp) :: b !<
2093	INTEGER(iwp) :: c !<
2094	INTEGER(iwp) :: g !<
2095	INTEGER(iwp) :: i !<
2096	INTEGER(iwp) :: j !<
2097	INTEGER(iwp) :: k !<
2098
2099	IF ( write_binary .AND. write_binary_salsa ) THEN
2100
2101	DO b = 1, nbins
2102	WRITE ( 14 ) aero(b)%vlolim
2103	WRITE ( 14 ) aero(b)%vhilim
2104	WRITE ( 14 ) aero(b)%dmid
2105	WRITE ( 14 ) aero(b)%vratiohi
2106	WRITE ( 14 ) aero(b)%vratiolo
2107	ENDDO
2108
2109	DO i = nxl, nxr
2110	DO j = nys, nyn
2111	DO k = nzb+1, nzt
2112	DO b = 1, nbins
2113	WRITE ( 14 ) aerosol_number(b)%conc(k,j,i)
2114	DO c = 1, ncc_tot
2115	WRITE ( 14 ) aerosol_mass((c-1)*nbins+b)%conc(k,j,i)
2116	ENDDO
2117	ENDDO
2118	IF ( .NOT. salsa_gases_from_chem ) THEN
2119	DO g = 1, ngast
2120	WRITE ( 14 ) salsa_gas(g)%conc(k,j,i)
2121	ENDDO
2122	ENDIF
2123	ENDDO
2124	ENDDO
2125	ENDDO
2126
2127	WRITE ( 14 ) '* end salsa * '
2128
2129	ENDIF
2130
2131	END SUBROUTINE salsa_wrd_local
2132
2133
2134	!------------------------------------------------------------------------------!
2135	! Description:
2136	! ------------
2137	!> Performs necessary unit and dimension conversion between the host model and
2138	!> SALSA module, and calls the main SALSA routine.
2139	!> Partially adobted form the original SALSA boxmodel version.
2140	!> Now takes masses in as kg/kg from LES!! Converted to m3/m3 for SALSA
2141	!> 05/2016 Juha: This routine is still pretty much in its original shape.
2142	!> It's dumb as a mule and twice as ugly, so implementation of
2143	!> an improved solution is necessary sooner or later.
2144	!> Juha Tonttila, FMI, 2014
2145	!> Jaakko Ahola, FMI, 2016
2146	!> Only aerosol processes included, Mona Kurppa, UHel, 2017
2147	!------------------------------------------------------------------------------!
2148	SUBROUTINE salsa_driver( i, j, prunmode )
2149
2150	USE arrays_3d, &
2151	ONLY: pt_p, q_p, rho_air_zw, u, v, w
2152
2153	USE plant_canopy_model_mod, &
2154	ONLY: lad_s
2155
2156	USE surface_mod, &
2157	ONLY: surf_def_h, surf_def_v, surf_lsm_h, surf_lsm_v, surf_usm_h, &
2158	surf_usm_v
2159
2160	IMPLICIT NONE
2161
2162	INTEGER(iwp), INTENT(in) :: i !< loop index
2163	INTEGER(iwp), INTENT(in) :: j !< loop index
2164	INTEGER(iwp), INTENT(in) :: prunmode !< 1: Initialization call
2165	!< 2: Spinup period call
2166	!< 3: Regular runtime call
2167	!-- Local variables
2168	TYPE(t_section), DIMENSION(fn2b) :: aero_old !< helper array
2169	INTEGER(iwp) :: bb !< loop index
2170	INTEGER(iwp) :: cc !< loop index
2171	INTEGER(iwp) :: endi !< end index
2172	INTEGER(iwp) :: k_wall !< vertical index of topography top
2173	INTEGER(iwp) :: k !< loop index
2174	INTEGER(iwp) :: l !< loop index
2175	INTEGER(iwp) :: nc_h2o !< index of H2O in the prtcl index table
2176	INTEGER(iwp) :: ss !< loop index
2177	INTEGER(iwp) :: str !< start index
2178	INTEGER(iwp) :: vc !< default index in prtcl
2179	REAL(wp) :: cw_old !< previous H2O mixing ratio
2180	REAL(wp) :: flag !< flag to mask topography grid points
2181	REAL(wp), DIMENSION(nzb:nzt+1) :: in_adn !< air density (kg/m3)
2182	REAL(wp), DIMENSION(nzb:nzt+1) :: in_cs !< H2O sat. vapour conc.
2183	REAL(wp), DIMENSION(nzb:nzt+1) :: in_cw !< H2O vapour concentration
2184	REAL(wp) :: in_lad !< leaf area density (m2/m3)
2185	REAL(wp), DIMENSION(nzb:nzt+1) :: in_p !< pressure (Pa)
2186	REAL(wp) :: in_rh !< relative humidity
2187	REAL(wp), DIMENSION(nzb:nzt+1) :: in_t !< temperature (K)
2188	REAL(wp), DIMENSION(nzb:nzt+1) :: in_u !< wind magnitude (m/s)
2189	REAL(wp), DIMENSION(nzb:nzt+1) :: kvis !< kinematic viscosity of air(m2/s)
2190	REAL(wp), DIMENSION(nzb:nzt+1,fn2b) :: Sc !< particle Schmidt number
2191	REAL(wp), DIMENSION(nzb:nzt+1,fn2b) :: vd !< particle fall seed (m/s,
2192	!< sedimentation velocity)
2193	REAL(wp), DIMENSION(nzb:nzt+1) :: ppm_to_nconc !< Conversion factor
2194	!< from ppm to #/m3
2195	REAL(wp) :: zgso4 !< SO4
2196	REAL(wp) :: zghno3 !< HNO3
2197	REAL(wp) :: zgnh3 !< NH3
2198	REAL(wp) :: zgocnv !< non-volatile OC
2199	REAL(wp) :: zgocsv !< semi-volatile OC
2200
2201	aero_old(:)%numc = 0.0_wp
2202	in_adn = 0.0_wp
2203	in_cs = 0.0_wp
2204	in_cw = 0.0_wp
2205	in_lad = 0.0_wp
2206	in_rh = 0.0_wp
2207	in_p = 0.0_wp
2208	in_t = 0.0_wp
2209	in_u = 0.0_wp
2210	kvis = 0.0_wp
2211	Sc = 0.0_wp
2212	vd = 0.0_wp
2213	ppm_to_nconc = 1.0_wp
2214	zgso4 = nclim
2215	zghno3 = nclim
2216	zgnh3 = nclim
2217	zgocnv = nclim
2218	zgocsv = nclim
2219
2220	!
2221	!-- Aerosol number is always set, but mass can be uninitialized
2222	DO cc = 1, nbins
2223	aero(cc)%volc = 0.0_wp
2224	aero_old(cc)%volc = 0.0_wp
2225	ENDDO
2226	!
2227	!-- Set the salsa runtime config (How to make this more efficient?)
2228	CALL set_salsa_runtime( prunmode )
2229	!
2230	!-- Calculate thermodynamic quantities needed in SALSA
2231	CALL salsa_thrm_ij( i, j, p_ij=in_p, temp_ij=in_t, cw_ij=in_cw, &
2232	cs_ij=in_cs, adn_ij=in_adn )
2233	!
2234	!-- Magnitude of wind: needed for deposition
2235	IF ( lsdepo ) THEN
2236	in_u(nzb+1:nzt) = SQRT( &
2237	( 0.5_wp * ( u(nzb+1:nzt,j,i) + u(nzb+1:nzt,j,i+1) ) )**2 + &
2238	( 0.5_wp * ( v(nzb+1:nzt,j,i) + v(nzb+1:nzt,j+1,i) ) )**2 + &
2239	( 0.5_wp * ( w(nzb:nzt-1,j,i) + w(nzb+1:nzt,j, i) ) )**2 )
2240	ENDIF
2241	!
2242	!-- Calculate conversion factors for gas concentrations
2243	ppm_to_nconc = for_ppm_to_nconc * in_p / in_t
2244	!
2245	!-- Determine topography-top index on scalar grid
2246	k_wall = MAXLOC( MERGE( 1, 0, BTEST( wall_flags_0(:,j,i), 12 ) ), &
2247	DIM = 1 ) - 1
2248
2249	DO k = nzb+1, nzt
2250	!
2251	!-- Predetermine flag to mask topography
2252	flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_0(k,j,i), 0 ) )
2253	!
2254	!-- Do not run inside buildings
2255	IF ( flag == 0.0_wp ) CYCLE
2256	!
2257	!-- Wind velocity for dry depositon on vegetation
2258	IF ( lsdepo_vege .AND. plant_canopy ) THEN
2259	in_lad = lad_s(k-k_wall,j,i)
2260	ENDIF
2261	!
2262	!-- For initialization and spinup, limit the RH with the parameter rhlim
2263	IF ( prunmode < 3 ) THEN
2264	in_cw(k) = MIN( in_cw(k), in_cs(k) * rhlim )
2265	ELSE
2266	in_cw(k) = in_cw(k)
2267	ENDIF
2268	cw_old = in_cw(k) !* in_adn(k)
2269	!
2270	!-- Set volume concentrations:
2271	!-- Sulphate (SO4) or sulphuric acid H2SO4
2272	IF ( iso4 > 0 ) THEN
2273	vc = 1
2274	str = ( iso4-1 ) * nbins + 1 ! start index
2275	endi = iso4 * nbins ! end index
2276	cc = 1
2277	DO ss = str, endi
2278	aero(cc)%volc(vc) = aerosol_mass(ss)%conc(k,j,i) / arhoh2so4
2279	cc = cc+1
2280	ENDDO
2281	aero_old(1:nbins)%volc(vc) = aero(1:nbins)%volc(vc)
2282	ENDIF
2283
2284	!-- Organic carbon (OC) compounds
2285	IF ( ioc > 0 ) THEN
2286	vc = 2
2287	str = ( ioc-1 ) * nbins + 1
2288	endi = ioc * nbins
2289	cc = 1
2290	DO ss = str, endi
2291	aero(cc)%volc(vc) = aerosol_mass(ss)%conc(k,j,i) / arhooc
2292	cc = cc+1
2293	ENDDO
2294	aero_old(1:nbins)%volc(vc) = aero(1:nbins)%volc(vc)
2295	ENDIF
2296
2297	!-- Black carbon (BC)
2298	IF ( ibc > 0 ) THEN
2299	vc = 3
2300	str = ( ibc-1 ) * nbins + 1 + fn1a
2301	endi = ibc * nbins
2302	cc = 1 + fn1a
2303	DO ss = str, endi
2304	aero(cc)%volc(vc) = aerosol_mass(ss)%conc(k,j,i) / arhobc
2305	cc = cc+1
2306	ENDDO
2307	aero_old(1:nbins)%volc(vc) = aero(1:nbins)%volc(vc)
2308	ENDIF
2309
2310	!-- Dust (DU)
2311	IF ( idu > 0 ) THEN
2312	vc = 4
2313	str = ( idu-1 ) * nbins + 1 + fn1a
2314	endi = idu * nbins
2315	cc = 1 + fn1a
2316	DO ss = str, endi
2317	aero(cc)%volc(vc) = aerosol_mass(ss)%conc(k,j,i) / arhodu
2318	cc = cc+1
2319	ENDDO
2320	aero_old(1:nbins)%volc(vc) = aero(1:nbins)%volc(vc)
2321	ENDIF
2322
2323	!-- Sea salt (SS)
2324	IF ( iss > 0 ) THEN
2325	vc = 5
2326	str = ( iss-1 ) * nbins + 1 + fn1a
2327	endi = iss * nbins
2328	cc = 1 + fn1a
2329	DO ss = str, endi
2330	aero(cc)%volc(vc) = aerosol_mass(ss)%conc(k,j,i) / arhoss
2331	cc = cc+1
2332	ENDDO
2333	aero_old(1:nbins)%volc(vc) = aero(1:nbins)%volc(vc)
2334	ENDIF
2335
2336	!-- Nitrate (NO(3-)) or nitric acid HNO3
2337	IF ( ino > 0 ) THEN
2338	vc = 6
2339	str = ( ino-1 ) * nbins + 1
2340	endi = ino * nbins
2341	cc = 1
2342	DO ss = str, endi
2343	aero(cc)%volc(vc) = aerosol_mass(ss)%conc(k,j,i) / arhohno3
2344	cc = cc+1
2345	ENDDO
2346	aero_old(1:nbins)%volc(vc) = aero(1:nbins)%volc(vc)
2347	ENDIF
2348
2349	!-- Ammonium (NH(4+)) or ammonia NH3
2350	IF ( inh > 0 ) THEN
2351	vc = 7
2352	str = ( inh-1 ) * nbins + 1
2353	endi = inh * nbins
2354	cc = 1
2355	DO ss = str, endi
2356	aero(cc)%volc(vc) = aerosol_mass(ss)%conc(k,j,i) / arhonh3
2357	cc = cc+1
2358	ENDDO
2359	aero_old(1:nbins)%volc(vc) = aero(1:nbins)%volc(vc)
2360	ENDIF
2361
2362	!-- Water (always used)
2363	nc_h2o = get_index( prtcl,'H2O' )
2364	vc = 8
2365	str = ( nc_h2o-1 ) * nbins + 1
2366	endi = nc_h2o * nbins
2367	cc = 1
2368	IF ( advect_particle_water ) THEN
2369	DO ss = str, endi
2370	aero(cc)%volc(vc) = aerosol_mass(ss)%conc(k,j,i) / arhoh2o
2371	cc = cc+1
2372	ENDDO
2373	ELSE
2374	aero(1:nbins)%volc(vc) = mclim
2375	ENDIF
2376	aero_old(1:nbins)%volc(vc) = aero(1:nbins)%volc(vc)
2377	!
2378	!-- Number concentrations (numc) and particle sizes
2379	!-- (dwet = wet diameter, core = dry volume)
2380	DO bb = 1, nbins
2381	aero(bb)%numc = aerosol_number(bb)%conc(k,j,i)
2382	aero_old(bb)%numc = aero(bb)%numc
2383	IF ( aero(bb)%numc > nclim ) THEN
2384	aero(bb)%dwet = ( SUM( aero(bb)%volc(:) ) / aero(bb)%numc / api6 )&
2385	**( 1.0_wp / 3.0_wp )
2386	aero(bb)%core = SUM( aero(bb)%volc(1:7) ) / aero(bb)%numc
2387	ELSE
2388	aero(bb)%dwet = aero(bb)%dmid
2389	aero(bb)%core = api6 * ( aero(bb)%dwet ) ** 3.0_wp
2390	ENDIF
2391	ENDDO
2392	!
2393	!-- On EACH call of salsa_driver, calculate the ambient sizes of
2394	!-- particles by equilibrating soluble fraction of particles with water
2395	!-- using the ZSR method.
2396	in_rh = in_cw(k) / in_cs(k)
2397	IF ( prunmode==1 .OR. .NOT. advect_particle_water ) THEN
2398	CALL equilibration( in_rh, in_t(k), aero, .TRUE. )
2399	ENDIF
2400	!
2401	!-- Gaseous tracer concentrations in #/m3
2402	IF ( salsa_gases_from_chem ) THEN
2403	!
2404	!-- Convert concentrations in ppm to #/m3
2405	zgso4 = chem_species(gas_index_chem(1))%conc(k,j,i) * ppm_to_nconc(k)
2406	zghno3 = chem_species(gas_index_chem(2))%conc(k,j,i) * ppm_to_nconc(k)
2407	zgnh3 = chem_species(gas_index_chem(3))%conc(k,j,i) * ppm_to_nconc(k)
2408	zgocnv = chem_species(gas_index_chem(4))%conc(k,j,i) * ppm_to_nconc(k)
2409	zgocsv = chem_species(gas_index_chem(5))%conc(k,j,i) * ppm_to_nconc(k)
2410	ELSE
2411	zgso4 = salsa_gas(1)%conc(k,j,i)
2412	zghno3 = salsa_gas(2)%conc(k,j,i)
2413	zgnh3 = salsa_gas(3)%conc(k,j,i)
2414	zgocnv = salsa_gas(4)%conc(k,j,i)
2415	zgocsv = salsa_gas(5)%conc(k,j,i)
2416	ENDIF
2417	!
2418	!-- ***************************************!
2419	!-- Run SALSA !
2420	!-- ***************************************!
2421	CALL run_salsa( in_p(k), in_cw(k), in_cs(k), in_t(k), in_u(k), &
2422	in_adn(k), in_lad, zgso4, zgocnv, zgocsv, zghno3, zgnh3,&
2423	aero, prtcl, kvis(k), Sc(k,:), vd(k,:), dt_salsa )
2424	!-- ***************************************!
2425	IF ( lsdepo ) sedim_vd(k,j,i,:) = vd(k,:)
2426	!
2427	!-- Calculate changes in concentrations
2428	DO bb = 1, nbins
2429	aerosol_number(bb)%conc(k,j,i) = aerosol_number(bb)%conc(k,j,i) &
2430	+ ( aero(bb)%numc - aero_old(bb)%numc ) * flag
2431	ENDDO
2432
2433	IF ( iso4 > 0 ) THEN
2434	vc = 1
2435	str = ( iso4-1 ) * nbins + 1
2436	endi = iso4 * nbins
2437	cc = 1
2438	DO ss = str, endi
2439	aerosol_mass(ss)%conc(k,j,i) = aerosol_mass(ss)%conc(k,j,i) &
2440	+ ( aero(cc)%volc(vc) - aero_old(cc)%volc(vc) ) &
2441	* arhoh2so4 * flag
2442	cc = cc+1
2443	ENDDO
2444	ENDIF
2445
2446	IF ( ioc > 0 ) THEN
2447	vc = 2
2448	str = ( ioc-1 ) * nbins + 1
2449	endi = ioc * nbins
2450	cc = 1
2451	DO ss = str, endi
2452	aerosol_mass(ss)%conc(k,j,i) = aerosol_mass(ss)%conc(k,j,i) &
2453	+ ( aero(cc)%volc(vc) - aero_old(cc)%volc(vc) ) &
2454	* arhooc * flag
2455	cc = cc+1
2456	ENDDO
2457	ENDIF
2458
2459	IF ( ibc > 0 ) THEN
2460	vc = 3
2461	str = ( ibc-1 ) * nbins + 1 + fn1a
2462	endi = ibc * nbins
2463	cc = 1 + fn1a
2464	DO ss = str, endi
2465	aerosol_mass(ss)%conc(k,j,i) = aerosol_mass(ss)%conc(k,j,i) &
2466	+ ( aero(cc)%volc(vc) - aero_old(cc)%volc(vc) ) &
2467	* arhobc * flag
2468	cc = cc+1
2469	ENDDO
2470	ENDIF
2471
2472	IF ( idu > 0 ) THEN
2473	vc = 4
2474	str = ( idu-1 ) * nbins + 1 + fn1a
2475	endi = idu * nbins
2476	cc = 1 + fn1a
2477	DO ss = str, endi
2478	aerosol_mass(ss)%conc(k,j,i) = aerosol_mass(ss)%conc(k,j,i) &
2479	+ ( aero(cc)%volc(vc) - aero_old(cc)%volc(vc) ) &
2480	* arhodu * flag
2481	cc = cc+1
2482	ENDDO
2483	ENDIF
2484
2485	IF ( iss > 0 ) THEN
2486	vc = 5
2487	str = ( iss-1 ) * nbins + 1 + fn1a
2488	endi = iss * nbins
2489	cc = 1 + fn1a
2490	DO ss = str, endi
2491	aerosol_mass(ss)%conc(k,j,i) = aerosol_mass(ss)%conc(k,j,i) &
2492	+ ( aero(cc)%volc(vc) - aero_old(cc)%volc(vc) ) &
2493	* arhoss * flag
2494	cc = cc+1
2495	ENDDO
2496	ENDIF
2497
2498	IF ( ino > 0 ) THEN
2499	vc = 6
2500	str = ( ino-1 ) * nbins + 1
2501	endi = ino * nbins
2502	cc = 1
2503	DO ss = str, endi
2504	aerosol_mass(ss)%conc(k,j,i) = aerosol_mass(ss)%conc(k,j,i) &
2505	+ ( aero(cc)%volc(vc) - aero_old(cc)%volc(vc) ) &
2506	* arhohno3 * flag
2507	cc = cc+1
2508	ENDDO
2509	ENDIF
2510
2511	IF ( inh > 0 ) THEN
2512	vc = 7
2513	str = ( ino-1 ) * nbins + 1
2514	endi = ino * nbins
2515	cc = 1
2516	DO ss = str, endi
2517	aerosol_mass(ss)%conc(k,j,i) = aerosol_mass(ss)%conc(k,j,i) &
2518	+ ( aero(cc)%volc(vc) - aero_old(cc)%volc(vc) ) &
2519	* arhonh3 * flag
2520	cc = cc+1
2521	ENDDO
2522	ENDIF
2523
2524	IF ( advect_particle_water ) THEN
2525	nc_h2o = get_index( prtcl,'H2O' )
2526	vc = 8
2527	str = ( nc_h2o-1 ) * nbins + 1
2528	endi = nc_h2o * nbins
2529	cc = 1
2530	DO ss = str, endi
2531	aerosol_mass(ss)%conc(k,j,i) = aerosol_mass(ss)%conc(k,j,i) &
2532	+ ( aero(cc)%volc(vc) - aero_old(cc)%volc(vc) ) &
2533	* arhoh2o * flag
2534	IF ( prunmode == 1 ) THEN
2535	aerosol_mass(ss)%init(k) = MAX( aerosol_mass(ss)%init(k), &
2536	aerosol_mass(ss)%conc(k,j,i) )
2537	ENDIF
2538	cc = cc+1
2539	ENDDO
2540	ENDIF
2541
2542	!-- Condensation of precursor gases
2543	IF ( lscndgas ) THEN
2544	IF ( salsa_gases_from_chem ) THEN
2545	!
2546	!-- SO4 (or H2SO4)
2547	chem_species( gas_index_chem(1) )%conc(k,j,i) = &
2548	chem_species( gas_index_chem(1) )%conc(k,j,i) + &
2549	( zgso4 / ppm_to_nconc(k) - &
2550	chem_species( gas_index_chem(1) )%conc(k,j,i) ) * flag
2551	!
2552	!-- HNO3
2553	chem_species( gas_index_chem(2) )%conc(k,j,i) = &
2554	chem_species( gas_index_chem(2) )%conc(k,j,i) + &
2555	( zghno3 / ppm_to_nconc(k) - &
2556	chem_species( gas_index_chem(2) )%conc(k,j,i) ) * flag
2557	!
2558	!-- NH3
2559	chem_species( gas_index_chem(3) )%conc(k,j,i) = &
2560	chem_species( gas_index_chem(3) )%conc(k,j,i) + &
2561	( zgnh3 / ppm_to_nconc(k) - &
2562	chem_species( gas_index_chem(3) )%conc(k,j,i) ) * flag
2563	!
2564	!-- non-volatile OC
2565	chem_species( gas_index_chem(4) )%conc(k,j,i) = &
2566	chem_species( gas_index_chem(4) )%conc(k,j,i) + &
2567	( zgocnv / ppm_to_nconc(k) - &
2568	chem_species( gas_index_chem(4) )%conc(k,j,i) ) * flag
2569	!
2570	!-- semi-volatile OC
2571	chem_species( gas_index_chem(5) )%conc(k,j,i) = &
2572	chem_species( gas_index_chem(5) )%conc(k,j,i) + &
2573	( zgocsv / ppm_to_nconc(k) - &
2574	chem_species( gas_index_chem(5) )%conc(k,j,i) ) * flag
2575
2576	ELSE
2577	!
2578	!-- SO4 (or H2SO4)
2579	salsa_gas(1)%conc(k,j,i) = salsa_gas(1)%conc(k,j,i) + ( zgso4 - &
2580	salsa_gas(1)%conc(k,j,i) ) * flag
2581	!
2582	!-- HNO3
2583	salsa_gas(2)%conc(k,j,i) = salsa_gas(2)%conc(k,j,i) + ( zghno3 - &
2584	salsa_gas(2)%conc(k,j,i) ) * flag
2585	!
2586	!-- NH3
2587	salsa_gas(3)%conc(k,j,i) = salsa_gas(3)%conc(k,j,i) + ( zgnh3 - &
2588	salsa_gas(3)%conc(k,j,i) ) * flag
2589	!
2590	!-- non-volatile OC
2591	salsa_gas(4)%conc(k,j,i) = salsa_gas(4)%conc(k,j,i) + ( zgocnv - &
2592	salsa_gas(4)%conc(k,j,i) ) * flag
2593	!
2594	!-- semi-volatile OC
2595	salsa_gas(5)%conc(k,j,i) = salsa_gas(5)%conc(k,j,i) + ( zgocsv - &
2596	salsa_gas(5)%conc(k,j,i) ) * flag
2597	ENDIF
2598	ENDIF
2599	!
2600	!-- Tendency of water vapour mixing ratio is obtained from the
2601	!-- change in RH during SALSA run. This releases heat and changes pt.
2602	!-- Assumes no temperature change during SALSA run.
2603	!-- q = r / (1+r), Euler method for integration
2604	!
2605	IF ( feedback_to_palm ) THEN
2606	q_p(k,j,i) = q_p(k,j,i) + 1.0_wp / ( in_cw(k) * in_adn(k) + 1.0_wp ) &
2607	** 2.0_wp * ( in_cw(k) - cw_old ) * in_adn(k)
2608	pt_p(k,j,i) = pt_p(k,j,i) + alv / c_p * ( in_cw(k) - cw_old ) * &
2609	in_adn(k) / ( in_cw(k) / in_adn(k) + 1.0_wp ) ** 2.0_wp&
2610	* pt_p(k,j,i) / in_t(k)
2611	ENDIF
2612
2613	ENDDO ! k
2614	!
2615	!-- Set surfaces and wall fluxes due to deposition
2616	IF ( lsdepo_topo .AND. prunmode == 3 ) THEN
2617	IF ( .NOT. land_surface .AND. .NOT. urban_surface ) THEN
2618	CALL depo_topo( i, j, surf_def_h(0), vd, Sc, kvis, in_u, rho_air_zw )
2619	DO l = 0, 3
2620	CALL depo_topo( i, j, surf_def_v(l), vd, Sc, kvis, in_u, &
2621	rho_air_zw**0.0_wp )
2622	ENDDO
2623	ELSE
2624	CALL depo_topo( i, j, surf_usm_h, vd, Sc, kvis, in_u, rho_air_zw )
2625	DO l = 0, 3
2626	CALL depo_topo( i, j, surf_usm_v(l), vd, Sc, kvis, in_u, &
2627	rho_air_zw**0.0_wp )
2628	ENDDO
2629	CALL depo_topo( i, j, surf_lsm_h, vd, Sc, kvis, in_u, rho_air_zw )
2630	DO l = 0, 3
2631	CALL depo_topo( i, j, surf_lsm_v(l), vd, Sc, kvis, in_u, &
2632	rho_air_zw**0.0_wp )
2633	ENDDO
2634	ENDIF
2635	ENDIF
2636
2637	END SUBROUTINE salsa_driver
2638
2639	!------------------------------------------------------------------------------!
2640	! Description:
2641	! ------------
2642	!> The SALSA subroutine
2643	!> Modified for the new aerosol datatype,
2644	!> Juha Tonttila, FMI, 2014.
2645	!> Only aerosol processes included, Mona Kurppa, UHel, 2017
2646	!------------------------------------------------------------------------------!
2647	SUBROUTINE run_salsa( ppres, pcw, pcs, ptemp, mag_u, adn, lad, pc_h2so4, &
2648	pc_ocnv, pc_ocsv, pc_hno3, pc_nh3, paero, prtcl, kvis, &
2649	Sc, vc, ptstep )
2650
2651	IMPLICIT NONE
2652	!
2653	!-- Input parameters and variables
2654	REAL(wp), INTENT(in) :: adn !< air density (kg/m3)
2655	REAL(wp), INTENT(in) :: lad !< leaf area density (m2/m3)
2656	REAL(wp), INTENT(in) :: mag_u !< magnitude of wind (m/s)
2657	REAL(wp), INTENT(in) :: ppres !< atmospheric pressure at each grid
2658	!< point (Pa)
2659	REAL(wp), INTENT(in) :: ptemp !< temperature at each grid point (K)
2660	REAL(wp), INTENT(in) :: ptstep !< time step of salsa processes (s)
2661	TYPE(component_index), INTENT(in) :: prtcl !< part. component index table
2662	!
2663	!-- Input variables that are changed within:
2664	REAL(wp), INTENT(inout) :: kvis !< kinematic viscosity of air (m2/s)
2665	REAL(wp), INTENT(inout) :: Sc(:) !< particle Schmidt number
2666	REAL(wp), INTENT(inout) :: vc(:) !< particle fall speed (m/s,
2667	!< sedimentation velocity)
2668	!-- Gas phase concentrations at each grid point (#/m3)
2669	REAL(wp), INTENT(inout) :: pc_h2so4 !< sulphuric acid
2670	REAL(wp), INTENT(inout) :: pc_hno3 !< nitric acid
2671	REAL(wp), INTENT(inout) :: pc_nh3 !< ammonia
2672	REAL(wp), INTENT(inout) :: pc_ocnv !< nonvolatile OC
2673	REAL(wp), INTENT(inout) :: pc_ocsv !< semivolatile OC
2674	REAL(wp), INTENT(inout) :: pcs !< Saturation concentration of water
2675	!< vapour (kg/m3)
2676	REAL(wp), INTENT(inout) :: pcw !< Water vapour concentration (kg/m3)
2677	TYPE(t_section), INTENT(inout) :: paero(fn2b)
2678	!
2679	!-- Coagulation
2680	IF ( lscoag ) THEN
2681	CALL coagulation( paero, ptstep, ptemp, ppres )
2682	ENDIF
2683	!
2684	!-- Condensation
2685	IF ( lscnd ) THEN
2686	CALL condensation( paero, pc_h2so4, pc_ocnv, pc_ocsv, pc_hno3, pc_nh3, &
2687	pcw, pcs, ptemp, ppres, ptstep, prtcl )
2688	ENDIF
2689	!
2690	!-- Deposition
2691	IF ( lsdepo ) THEN
2692	CALL deposition( paero, ptemp, adn, mag_u, lad, kvis, Sc, vc )
2693	ENDIF
2694	!
2695	!-- Size distribution bin update
2696	!-- Mona: why done 3 times in SALSA-standalone?
2697	IF ( lsdistupdate ) THEN
2698	CALL distr_update( paero )
2699	ENDIF
2700
2701	END SUBROUTINE run_salsa
2702
2703	!------------------------------------------------------------------------------!
2704	! Description:
2705	! ------------
2706	!> Set logical switches according to the host model state and user-specified
2707	!> NAMELIST options.
2708	!> Juha Tonttila, FMI, 2014
2709	!> Only aerosol processes included, Mona Kurppa, UHel, 2017
2710	!------------------------------------------------------------------------------!
2711	SUBROUTINE set_salsa_runtime( prunmode )
2712
2713	IMPLICIT NONE
2714
2715	INTEGER(iwp), INTENT(in) :: prunmode
2716
2717	SELECT CASE(prunmode)
2718
2719	CASE(1) !< Initialization
2720	lscoag = .FALSE.
2721	lscnd = .FALSE.
2722	lscndgas = .FALSE.
2723	lscndh2oae = .FALSE.
2724	lsdepo = .FALSE.
2725	lsdepo_vege = .FALSE.
2726	lsdepo_topo = .FALSE.
2727	lsdistupdate = .TRUE.
2728
2729	CASE(2) !< Spinup period
2730	lscoag = ( .FALSE. .AND. nlcoag )
2731	lscnd = ( .TRUE. .AND. nlcnd )
2732	lscndgas = ( .TRUE. .AND. nlcndgas )
2733	lscndh2oae = ( .TRUE. .AND. nlcndh2oae )
2734
2735	CASE(3) !< Run
2736	lscoag = nlcoag
2737	lscnd = nlcnd
2738	lscndgas = nlcndgas
2739	lscndh2oae = nlcndh2oae
2740	lsdepo = nldepo
2741	lsdepo_vege = nldepo_vege
2742	lsdepo_topo = nldepo_topo
2743	lsdistupdate = nldistupdate
2744
2745	END SELECT
2746
2747
2748	END SUBROUTINE set_salsa_runtime
2749
2750	!------------------------------------------------------------------------------!
2751	! Description:
2752	! ------------
2753	!> Calculates the absolute temperature (using hydrostatic pressure), saturation
2754	!> vapour pressure and mixing ratio over water, relative humidity and air
2755	!> density needed in the SALSA model.
2756	!> NOTE, no saturation adjustment takes place -> the resulting water vapour
2757	!> mixing ratio can be supersaturated, allowing the microphysical calculations
2758	!> in SALSA.
2759	!
2760	!> Juha Tonttila, FMI, 2014 (original SALSAthrm)
2761	!> Mona Kurppa, UHel, 2017 (adjustment for PALM and only aerosol processes)
2762	!------------------------------------------------------------------------------!
2763	SUBROUTINE salsa_thrm_ij( i, j, p_ij, temp_ij, cw_ij, cs_ij, adn_ij )
2764
2765	USE arrays_3d, &
2766	ONLY: p, pt, q, zu
2767
2768	USE basic_constants_and_equations_mod, &
2769	ONLY: barometric_formula, exner_function, ideal_gas_law_rho, magnus
2770
2771	USE control_parameters, &
2772	ONLY: pt_surface, surface_pressure
2773
2774	IMPLICIT NONE
2775
2776	INTEGER(iwp), INTENT(in) :: i
2777	INTEGER(iwp), INTENT(in) :: j
2778	REAL(wp), DIMENSION(:), INTENT(inout) :: adn_ij
2779	REAL(wp), DIMENSION(:), INTENT(inout) :: p_ij
2780	REAL(wp), DIMENSION(:), INTENT(inout) :: temp_ij
2781	REAL(wp), DIMENSION(:), INTENT(inout), OPTIONAL :: cw_ij
2782	REAL(wp), DIMENSION(:), INTENT(inout), OPTIONAL :: cs_ij
2783	REAL(wp), DIMENSION(nzb:nzt+1) :: e_s !< saturation vapour pressure
2784	!< over water (Pa)
2785	REAL(wp) :: t_surface !< absolute surface temperature (K)
2786	!
2787	!-- Pressure p_ijk (Pa) = hydrostatic pressure + perturbation pressure (p)
2788	t_surface = pt_surface * exner_function( surface_pressure )
2789	p_ij(:) = 100.0_wp * barometric_formula( zu, t_surface, surface_pressure ) &
2790	+ p(:,j,i)
2791	!
2792	!-- Absolute ambient temperature (K)
2793	temp_ij(:) = pt(:,j,i) * exner_function( p_ij(:) )
2794	!
2795	!-- Air density
2796	adn_ij(:) = ideal_gas_law_rho( p_ij(:), temp_ij(:) )
2797	!
2798	!-- Water vapour concentration r_v (kg/m3)
2799	IF ( PRESENT( cw_ij ) ) THEN
2800	cw_ij(:) = ( q(:,j,i) / ( 1.0_wp - q(:,j,i) ) ) * adn_ij(:)
2801	ENDIF
2802	!
2803	!-- Saturation mixing ratio r_s (kg/kg) from vapour pressure at temp (Pa)
2804	IF ( PRESENT( cs_ij ) ) THEN
2805	e_s(:) = magnus( temp_ij(:) )
2806	cs_ij(:) = ( 0.622_wp * e_s / ( p_ij(:) - e_s(:) ) ) * adn_ij(:)
2807	ENDIF
2808
2809	END SUBROUTINE salsa_thrm_ij
2810
2811	!------------------------------------------------------------------------------!
2812	! Description:
2813	! ------------
2814	!> Calculates ambient sizes of particles by equilibrating soluble fraction of
2815	!> particles with water using the ZSR method (Stokes and Robinson, 1966).
2816	!> Method:
2817	!> Following chemical components are assumed water-soluble
2818	!> - (ammonium) sulphate (100%)
2819	!> - sea salt (100 %)
2820	!> - organic carbon (epsoc * 100%)
2821	!> Exact thermodynamic considerations neglected.
2822	!> - If particles contain no sea salt, calculation according to sulphate
2823	!> properties
2824	!> - If contain sea salt but no sulphate, calculation according to sea salt
2825	!> properties
2826	!> - If contain both sulphate and sea salt -> the molar fraction of these
2827	!> compounds determines which one of them is used as the basis of calculation.
2828	!> If sulphate and sea salt coexist in a particle, it is assumed that the Cl is
2829	!> replaced by sulphate; thus only either sulphate + organics or sea salt +
2830	!> organics is included in the calculation of soluble fraction.
2831	!> Molality parameterizations taken from Table 1 of Tang: Thermodynamic and
2832	!> optical properties of mixed-salt aerosols of atmospheric importance,
2833	!> J. Geophys. Res., 102 (D2), 1883-1893 (1997)
2834	!
2835	!> Coded by:
2836	!> Hannele Korhonen (FMI) 2005
2837	!> Harri Kokkola (FMI) 2006
2838	!> Matti Niskanen(FMI) 2012
2839	!> Anton Laakso (FMI) 2013
2840	!> Modified for the new aerosol datatype, Juha Tonttila (FMI) 2014
2841	!
2842	!> fxm: should sea salt form a solid particle when prh is very low (even though
2843	!> it could be mixed with e.g. sulphate)?
2844	!> fxm: crashes if no sulphate or sea salt
2845	!> fxm: do we really need to consider Kelvin effect for subrange 2
2846	!------------------------------------------------------------------------------!
2847	SUBROUTINE equilibration( prh, ptemp, paero, init )
2848
2849	IMPLICIT NONE
2850	!
2851	!-- Input variables
2852	LOGICAL, INTENT(in) :: init !< TRUE: Initialization call
2853	!< FALSE: Normal runtime: update water
2854	!< content only for 1a
2855	REAL(wp), INTENT(in) :: prh !< relative humidity [0-1]
2856	REAL(wp), INTENT(in) :: ptemp !< temperature (K)
2857	!
2858	!-- Output variables
2859	TYPE(t_section), INTENT(inout) :: paero(fn2b)
2860	!
2861	!-- Local
2862	INTEGER(iwp) :: b !< loop index
2863	INTEGER(iwp) :: counti !< loop index
2864	REAL(wp) :: zaw !< water activity [0-1]
2865	REAL(wp) :: zbinmol(7) !< binary molality of each components (mol/kg)
2866	REAL(wp) :: zcore !< Volume of dry particle
2867	REAL(wp) :: zdold !< Old diameter
2868	REAL(wp) :: zdwet !< Wet diameter or mean droplet diameter
2869	REAL(wp) :: zke !< Kelvin term in the KÃ¶hler equation
2870	REAL(wp) :: zlwc !< liquid water content [kg/m3-air]
2871	REAL(wp) :: zrh !< Relative humidity
2872	REAL(wp) :: zvpart(7) !< volume of chem. compounds in one particle
2873
2874	zaw = 0.0_wp
2875	zbinmol = 0.0_wp
2876	zcore = 0.0_wp
2877	zdold = 0.0_wp
2878	zdwet = 0.0_wp
2879	zlwc = 0.0_wp
2880	zrh = 0.0_wp
2881
2882	!
2883	!-- Relative humidity:
2884	zrh = prh
2885	zrh = MAX( zrh, 0.05_wp )
2886	zrh = MIN( zrh, 0.98_wp)
2887	!
2888	!-- 1) Regime 1: sulphate and partly water-soluble OC. Done for every CALL
2889	DO b = in1a, fn1a ! size bin
2890
2891	zbinmol = 0.0_wp
2892	zdold = 1.0_wp
2893	zke = 1.02_wp
2894
2895	IF ( paero(b)%numc > nclim ) THEN
2896	!
2897	!-- Volume in one particle
2898	zvpart = 0.0_wp
2899	zvpart(1:2) = paero(b)%volc(1:2) / paero(b)%numc
2900	zvpart(6:7) = paero(b)%volc(6:7) / paero(b)%numc
2901	!
2902	!-- Total volume and wet diameter of one dry particle
2903	zcore = SUM( zvpart(1:2) )
2904	zdwet = paero(b)%dwet
2905
2906	counti = 0
2907	DO WHILE ( ABS( zdwet / zdold - 1.0_wp ) > 1.0E-2_wp )
2908
2909	zdold = MAX( zdwet, 1.0E-20_wp )
2910	zaw = MAX( 1.0E-3_wp, zrh / zke ) ! To avoid underflow
2911	!
2912	!-- Binary molalities (mol/kg):
2913	!-- Sulphate
2914	zbinmol(1) = 1.1065495E+2_wp - 3.6759197E+2_wp * zaw &
2915	+ 5.0462934E+2_wp * zaw**2.0_wp &
2916	- 3.1543839E+2_wp * zaw**3.0_wp &
2917	+ 6.770824E+1_wp * zaw**4.0_wp
2918	!-- Organic carbon
2919	zbinmol(2) = 1.0_wp / ( zaw * amh2o ) - 1.0_wp / amh2o
2920	!-- Nitric acid
2921	zbinmol(6) = 2.306844303E+1_wp - 3.563608869E+1_wp * zaw &
2922	- 6.210577919E+1_wp * zaw**2.0_wp &
2923	+ 5.510176187E+2_wp * zaw**3.0_wp &
2924	- 1.460055286E+3_wp * zaw**4.0_wp &
2925	+ 1.894467542E+3_wp * zaw**5.0_wp &
2926	- 1.220611402E+3_wp * zaw**6.0_wp &
2927	+ 3.098597737E+2_wp * zaw**7.0_wp
2928	!
2929	!-- Calculate the liquid water content (kg/m3-air) using ZSR (see e.g.
2930	!-- Eq. 10.98 in Seinfeld and Pandis (2006))
2931	zlwc = ( paero(b)%volc(1) * ( arhoh2so4 / amh2so4 ) ) / &
2932	zbinmol(1) + epsoc * paero(b)%volc(2) * ( arhooc / amoc ) &
2933	/ zbinmol(2) + ( paero(b)%volc(6) * ( arhohno3/amhno3 ) ) &
2934	/ zbinmol(6)
2935	!
2936	!-- Particle wet diameter (m)
2937	zdwet = ( zlwc / paero(b)%numc / arhoh2o / api6 + &
2938	( SUM( zvpart(6:7) ) / api6 ) + &
2939	zcore / api6 )**( 1.0_wp / 3.0_wp )
2940	!
2941	!-- Kelvin effect (Eq. 10.85 in in Seinfeld and Pandis (2006)). Avoid
2942	!-- overflow.
2943	zke = EXP( MIN( 50.0_wp, &
2944	4.0_wp * surfw0 * amvh2so4 / ( abo * ptemp * zdwet ) ) )
2945
2946	counti = counti + 1
2947	IF ( counti > 1000 ) THEN
2948	message_string = 'Subrange 1: no convergence!'
2949	CALL message( 'salsa_mod: equilibration', 'SA0042', &
2950	1, 2, 0, 6, 0 )
2951	ENDIF
2952	ENDDO
2953	!
2954	!-- Instead of lwc, use the volume concentration of water from now on
2955	!-- (easy to convert...)
2956	paero(b)%volc(8) = zlwc / arhoh2o
2957	!
2958	!-- If this is initialization, update the core and wet diameter
2959	IF ( init ) THEN
2960	paero(b)%dwet = zdwet
2961	paero(b)%core = zcore
2962	ENDIF
2963
2964	ELSE
2965	!-- If initialization
2966	!-- 1.2) empty bins given bin average values
2967	IF ( init ) THEN
2968	paero(b)%dwet = paero(b)%dmid
2969	paero(b)%core = api6 * paero(b)%dmid ** 3.0_wp
2970	ENDIF
2971
2972	ENDIF
2973
2974	ENDDO !< b
2975	!
2976	!-- 2) Regime 2a: sulphate, OC, BC and sea salt
2977	!-- This is done only for initialization call, otherwise the water contents
2978	!-- are computed via condensation
2979	IF ( init ) THEN
2980	DO b = in2a, fn2b
2981
2982	!-- Initialize
2983	zke = 1.02_wp
2984	zbinmol = 0.0_wp
2985	zdold = 1.0_wp
2986	!
2987	!-- 1) Particle properties calculated for non-empty bins
2988	IF ( paero(b)%numc > nclim ) THEN
2989	!
2990	!-- Volume in one particle [fxm]
2991	zvpart = 0.0_wp
2992	zvpart(1:7) = paero(b)%volc(1:7) / paero(b)%numc
2993	!
2994	!-- Total volume and wet diameter of one dry particle [fxm]
2995	zcore = SUM( zvpart(1:5) )
2996	zdwet = paero(b)%dwet
2997
2998	counti = 0
2999	DO WHILE ( ABS( zdwet / zdold - 1.0_wp ) > 1.0E-12_wp )
3000
3001	zdold = MAX( zdwet, 1.0E-20_wp )
3002	zaw = zrh / zke
3003	!
3004	!-- Binary molalities (mol/kg):
3005	!-- Sulphate
3006	zbinmol(1) = 1.1065495E+2_wp - 3.6759197E+2_wp * zaw &
3007	+ 5.0462934E+2_wp * zaw*2 - 3.1543839E+2_wp zaw**3 &
3008	+ 6.770824E+1_wp * zaw**4
3009	!-- Organic carbon
3010	zbinmol(2) = 1.0_wp / ( zaw * amh2o ) - 1.0_wp / amh2o
3011	!-- Nitric acid
3012	zbinmol(6) = 2.306844303E+1_wp - 3.563608869E+1_wp * zaw &
3013	- 6.210577919E+1_wp * zaw*2 + 5.510176187E+2_wp zaw**3 &
3014	- 1.460055286E+3_wp * zaw*4 + 1.894467542E+3_wp zaw**5 &
3015	- 1.220611402E+3_wp * zaw*6 + 3.098597737E+2_wp zaw**7
3016	!-- Sea salt (natrium chloride)
3017	zbinmol(5) = 5.875248E+1_wp - 1.8781997E+2_wp * zaw &
3018	+ 2.7211377E+2_wp * zaw*2 - 1.8458287E+2_wp zaw**3 &
3019	+ 4.153689E+1_wp * zaw**4
3020	!
3021	!-- Calculate the liquid water content (kg/m3-air)
3022	zlwc = ( paero(b)%volc(1) * ( arhoh2so4 / amh2so4 ) ) / &
3023	zbinmol(1) + epsoc * ( paero(b)%volc(2) * ( arhooc / &
3024	amoc ) ) / zbinmol(2) + ( paero(b)%volc(6) * ( arhohno3 &
3025	/ amhno3 ) ) / zbinmol(6) + ( paero(b)%volc(5) * &
3026	( arhoss / amss ) ) / zbinmol(5)
3027
3028	!-- Particle wet radius (m)
3029	zdwet = ( zlwc / paero(b)%numc / arhoh2o / api6 + &
3030	( SUM( zvpart(6:7) ) / api6 ) + &
3031	zcore / api6 ) ** ( 1.0_wp / 3.0_wp )
3032	!
3033	!-- Kelvin effect (Eq. 10.85 in Seinfeld and Pandis (2006))
3034	zke = EXP( MIN( 50.0_wp, &
3035	4.0_wp * surfw0 * amvh2so4 / ( abo * zdwet * ptemp ) ) )
3036
3037	counti = counti + 1
3038	IF ( counti > 1000 ) THEN
3039	message_string = 'Subrange 2: no convergence!'
3040	CALL message( 'salsa_mod: equilibration', 'SA0043', &
3041	1, 2, 0, 6, 0 )
3042	ENDIF
3043	ENDDO
3044	!
3045	!-- Liquid water content; instead of LWC use the volume concentration
3046	paero(b)%volc(8) = zlwc / arhoh2o
3047	paero(b)%dwet = zdwet
3048	paero(b)%core = zcore
3049
3050	ELSE
3051	!-- 2.2) empty bins given bin average values
3052	paero(b)%dwet = paero(b)%dmid
3053	paero(b)%core = api6 * paero(b)%dmid ** 3.0_wp
3054	ENDIF
3055
3056	ENDDO ! b
3057	ENDIF
3058
3059	END SUBROUTINE equilibration
3060
3061	!------------------------------------------------------------------------------!
3062	!> Description:
3063	!> ------------
3064	!> Calculation of the settling velocity vc (m/s) per aerosol size bin and
3065	!> deposition on plant canopy (lsdepo_vege).
3066	!
3067	!> Deposition is based on either the scheme presented in:
3068	!> Zhang et al. (2001), Atmos. Environ. 35, 549-560 (includes collection due to
3069	!> Brownian diffusion, impaction, interception and sedimentation)
3070	!> OR
3071	!> Petroff & Zhang (2010), Geosci. Model Dev. 3, 753-769 (includes also
3072	!> collection due to turbulent impaction)
3073	!
3074	!> Equation numbers refer to equation in Jacobson (2005): Fundamentals of
3075	!> Atmospheric Modeling, 2nd Edition.
3076	!
3077	!> Subroutine follows closely sedim_SALSA in UCLALES-SALSA written by Juha
3078	!> Tonttila (KIT/FMI) and Zubair Maalick (UEF).
3079	!> Rewritten to PALM by Mona Kurppa (UH), 2017.
3080	!
3081	!> Call for grid point i,j,k
3082	!------------------------------------------------------------------------------!
3083
3084	SUBROUTINE deposition( paero, tk, adn, mag_u, lad, kvis, Sc, vc )
3085
3086	USE plant_canopy_model_mod, &
3087	ONLY: cdc
3088
3089	IMPLICIT NONE
3090
3091	REAL(wp), INTENT(in) :: adn !< air density (kg/m3)
3092	REAL(wp), INTENT(out) :: kvis !< kinematic viscosity of air (m2/s)
3093	REAL(wp), INTENT(in) :: lad !< leaf area density (m2/m3)
3094	REAL(wp), INTENT(in) :: mag_u !< wind velocity (m/s)
3095	REAL(wp), INTENT(out) :: Sc(:) !< particle Schmidt number
3096	REAL(wp), INTENT(in) :: tk !< abs.temperature (K)
3097	REAL(wp), INTENT(out) :: vc(:) !< critical fall speed i.e. settling
3098	!< velocity of an aerosol particle (m/s)
3099	TYPE(t_section), INTENT(inout) :: paero(fn2b)
3100
3101	INTEGER(iwp) :: b !< loop index
3102	INTEGER(iwp) :: c !< loop index
3103	REAL(wp) :: avis !< molecular viscocity of air (kg/(m*s))
3104	REAL(wp), PARAMETER :: c_A = 1.249_wp !< Constants A, B and C for
3105	REAL(wp), PARAMETER :: c_B = 0.42_wp !< calculating the Cunningham
3106	REAL(wp), PARAMETER :: c_C = 0.87_wp !< slip-flow correction (Cc)
3107	!< according to Jacobson (2005),
3108	!< Eq. 15.30
3109	REAL(wp) :: Cc !< Cunningham slip-flow correction factor
3110	REAL(wp) :: Kn !< Knudsen number
3111	REAL(wp) :: lambda !< molecular mean free path (m)
3112	REAL(wp) :: mdiff !< particle diffusivity coefficient
3113	REAL(wp) :: pdn !< particle density (kg/m3)
3114	REAL(wp) :: ustar !< friction velocity (m/s)
3115	REAL(wp) :: va !< thermal speed of an air molecule (m/s)
3116	REAL(wp) :: zdwet !< wet diameter (m)
3117	!
3118	!-- Initialise
3119	Cc = 0.0_wp
3120	Kn = 0.0_wp
3121	mdiff = 0.0_wp
3122	pdn = 1500.0_wp ! default value
3123	ustar = 0.0_wp
3124	!
3125	!-- Molecular viscosity of air (Eq. 4.54)
3126	avis = 1.8325E-5_wp * ( 416.16_wp / ( tk + 120.0_wp ) ) * ( tk / &
3127	296.16_wp )**1.5_wp
3128	!
3129	!-- Kinematic viscosity (Eq. 4.55)
3130	kvis = avis / adn
3131	!
3132	!-- Thermal velocity of an air molecule (Eq. 15.32)
3133	va = SQRT( 8.0_wp * abo * tk / ( pi * am_airmol ) )
3134	!
3135	!-- Mean free path (m) (Eq. 15.24)
3136	lambda = 2.0_wp * avis / ( adn * va )
3137
3138	DO b = 1, nbins
3139
3140	IF ( paero(b)%numc < nclim ) CYCLE
3141	zdwet = paero(b)%dwet
3142	!
3143	!-- Knudsen number (Eq. 15.23)
3144	Kn = MAX( 1.0E-2_wp, lambda / ( zdwet * 0.5_wp ) ) ! To avoid underflow
3145	!
3146	!-- Cunningham slip-flow correction (Eq. 15.30)
3147	Cc = 1.0_wp + Kn * ( c_A + c_B * EXP( -c_C / Kn ) )
3148
3149	!-- Particle diffusivity coefficient (Eq. 15.29)
3150	mdiff = ( abo * tk * Cc ) / ( 3.0_wp * pi * avis * zdwet )
3151	!
3152	!-- Particle Schmidt number (Eq. 15.36)
3153	Sc(b) = kvis / mdiff
3154	!
3155	!-- Critical fall speed i.e. settling velocity (Eq. 20.4)
3156	vc(b) = MIN( 1.0_wp, terminal_vel( 0.5_wp * zdwet, pdn, adn, avis, Cc) )
3157
3158	IF ( lsdepo_vege .AND. plant_canopy .AND. lad > 0.0_wp ) THEN
3159	!
3160	!-- Friction velocity calculated following Prandtl (1925):
3161	ustar = SQRT( cdc ) * mag_u
3162	CALL depo_vege( paero, b, vc(b), mag_u, ustar, kvis, Sc(b), lad )
3163	ENDIF
3164	ENDDO
3165
3166	END SUBROUTINE deposition
3167
3168	!------------------------------------------------------------------------------!
3169	! Description:
3170	! ------------
3171	!> Calculate change in number and volume concentrations due to deposition on
3172	!> plant canopy.
3173	!------------------------------------------------------------------------------!
3174	SUBROUTINE depo_vege( paero, b, vc, mag_u, ustar, kvis_a, Sc, lad )
3175
3176	IMPLICIT NONE
3177
3178	INTEGER(iwp), INTENT(in) :: b !< loop index
3179	REAL(wp), INTENT(in) :: kvis_a !< kinematic viscosity of air (m2/s)
3180	REAL(wp), INTENT(in) :: lad !< leaf area density (m2/m3)
3181	REAL(wp), INTENT(in) :: mag_u !< wind velocity (m/s)
3182	REAL(wp), INTENT(in) :: Sc !< particle Schmidt number
3183	REAL(wp), INTENT(in) :: ustar !< friction velocity (m/s)
3184	REAL(wp), INTENT(in) :: vc !< terminal velocity (m/s)
3185	TYPE(t_section), INTENT(inout) :: paero(fn2b)
3186
3187	INTEGER(iwp) :: c !< loop index
3188	REAL(wp), PARAMETER :: c_A = 1.249_wp !< Constants A, B and C for
3189	REAL(wp), PARAMETER :: c_B = 0.42_wp !< calculating the Cunningham
3190	REAL(wp), PARAMETER :: c_C = 0.87_wp !< slip-flow correction (Cc)
3191	!< according to Jacobson (2005),
3192	!< Eq. 15.30
3193	REAL(wp) :: alpha !< parameter, Table 3 in Zhang et al. (2001)
3194	REAL(wp) :: depo !< deposition efficiency
3195	REAL(wp) :: C_Br !< coefficient for Brownian diffusion
3196	REAL(wp) :: C_IM !< coefficient for inertial impaction
3197	REAL(wp) :: C_IN !< coefficient for interception
3198	REAL(wp) :: C_IT !< coefficient for turbulent impaction
3199	REAL(wp) :: gamma !< parameter, Table 3 in Zhang et al. (2001)
3200	REAL(wp) :: par_A !< parameter A for the characteristic radius of
3201	!< collectors, Table 3 in Zhang et al. (2001)
3202	REAL(wp) :: rt !< the overall quasi-laminar resistance for
3203	!< particles
3204	REAL(wp) :: St !< Stokes number for smooth surfaces or bluff
3205	!< surface elements
3206	REAL(wp) :: tau_plus !< dimensionless particle relaxation time
3207	REAL(wp) :: v_bd !< deposition velocity due to Brownian diffusion
3208	REAL(wp) :: v_im !< deposition velocity due to impaction
3209	REAL(wp) :: v_in !< deposition velocity due to interception
3210	REAL(wp) :: v_it !< deposition velocity due to turbulent impaction
3211	!
3212	!-- Initialise
3213	depo = 0.0_wp
3214	rt = 0.0_wp
3215	St = 0.0_wp
3216	tau_plus = 0.0_wp
3217	v_bd = 0.0_wp
3218	v_im = 0.0_wp
3219	v_in = 0.0_wp
3220	v_it = 0.0_wp
3221
3222	IF ( depo_vege_type == 'zhang2001' ) THEN
3223	!
3224	!-- Parameters for the land use category 'deciduous broadleaf trees'(Table 3)
3225	par_A = 5.0E-3_wp
3226	alpha = 0.8_wp
3227	gamma = 0.56_wp
3228	!
3229	!-- Stokes number for vegetated surfaces (Seinfeld & Pandis (2006): Eq.19.24)
3230	St = vc * ustar / ( g * par_A )
3231	!
3232	!-- The overall quasi-laminar resistance for particles (Zhang et al., Eq. 5)
3233	rt = MAX( EPSILON( 1.0_wp ), ( 3.0_wp * ustar * EXP( -St*0.5_wp ) &
3234	( Sc( -gamma ) + ( St / ( alpha + St ) )2.0_wp + &
3235	0.5_wp * ( paero(b)%dwet / par_A )**2.0_wp ) ) )
3236	depo = ( rt + vc ) * lad
3237	paero(b)%numc = paero(b)%numc - depo * paero(b)%numc * dt_salsa
3238	DO c = 1, maxspec+1
3239	paero(b)%volc(c) = paero(b)%volc(c) - depo * paero(b)%volc(c) * &
3240	dt_salsa
3241	ENDDO
3242
3243	ELSEIF ( depo_vege_type == 'petroff2010' ) THEN
3244	!
3245	!-- vd = v_BD + v_IN + v_IM + v_IT + vc
3246	!-- Deposition efficiencies from Table 1. Constants from Table 2.
3247	C_Br = 1.262_wp
3248	C_IM = 0.130_wp
3249	C_IN = 0.216_wp
3250	C_IT = 0.056_wp
3251	par_A = 0.03_wp ! Here: leaf width (m)
3252	!
3253	!-- Stokes number for vegetated surfaces (Seinfeld & Pandis (2006): Eq.19.24)
3254	St = vc * ustar / ( g * par_A )
3255	!
3256	!-- Non-dimensional relexation time of the particle on top of canopy
3257	tau_plus = vc * ustar*2.0_wp / ( kvis_a g )
3258	!
3259	!-- Brownian diffusion
3260	v_bd = mag_u * C_Br * Sc*( -2.0_wp / 3.0_wp ) &
3261	( mag_u * par_A / kvis_a )**( -0.5_wp )
3262	!
3263	!-- Interception
3264	v_in = mag_u * C_IN * paero(b)%dwet / par_A * ( 2.0_wp + LOG( 2.0_wp * &
3265	par_A / paero(b)%dwet ) )
3266	!
3267	!-- Impaction: Petroff (2009) Eq. 18
3268	v_im = mag_u * C_IM * ( St / ( St + 0.47_wp ) )**2.0_wp
3269
3270	IF ( tau_plus < 20.0_wp ) THEN
3271	v_it = 2.5E-3_wp * C_IT * tau_plus**2.0_wp
3272	ELSE
3273	v_it = C_IT
3274	ENDIF
3275	depo = ( v_bd + v_in + v_im + v_it + vc ) * lad
3276	paero(b)%numc = paero(b)%numc - depo * paero(b)%numc * dt_salsa
3277	DO c = 1, maxspec+1
3278	paero(b)%volc(c) = paero(b)%volc(c) - depo * paero(b)%volc(c) * &
3279	dt_salsa
3280	ENDDO
3281	ENDIF
3282
3283	END SUBROUTINE depo_vege
3284
3285	!------------------------------------------------------------------------------!
3286	! Description:
3287	! ------------
3288	!> Calculate deposition on horizontal and vertical surfaces. Implement as
3289	!> surface flux.
3290	!------------------------------------------------------------------------------!
3291
3292	SUBROUTINE depo_topo( i, j, surf, vc, Sc, kvis, mag_u, norm )
3293
3294	USE surface_mod, &
3295	ONLY: surf_type
3296
3297	IMPLICIT NONE
3298
3299	INTEGER(iwp), INTENT(in) :: i !< loop index
3300	INTEGER(iwp), INTENT(in) :: j !< loop index
3301	REAL(wp), INTENT(in) :: kvis(:) !< kinematic viscosity of air (m2/s)
3302	REAL(wp), INTENT(in) :: mag_u(:) !< wind velocity (m/s)
3303	REAL(wp), INTENT(in) :: norm(:) !< normalisation (usually air density)
3304	REAL(wp), INTENT(in) :: Sc(:,:) !< particle Schmidt number
3305	REAL(wp), INTENT(in) :: vc(:,:) !< terminal velocity (m/s)
3306	TYPE(surf_type), INTENT(inout) :: surf !< respective surface type
3307	INTEGER(iwp) :: b !< loop index
3308	INTEGER(iwp) :: c !< loop index
3309	INTEGER(iwp) :: k !< loop index
3310	INTEGER(iwp) :: m !< loop index
3311	INTEGER(iwp) :: surf_e !< End index of surface elements at (j,i)-gridpoint
3312	INTEGER(iwp) :: surf_s !< Start index of surface elements at (j,i)-gridpoint
3313	REAL(wp) :: alpha !< parameter, Table 3 in Zhang et al. (2001)
3314	REAL(wp) :: C_Br !< coefficient for Brownian diffusion
3315	REAL(wp) :: C_IM !< coefficient for inertial impaction
3316	REAL(wp) :: C_IN !< coefficient for interception
3317	REAL(wp) :: C_IT !< coefficient for turbulent impaction
3318	REAL(wp) :: depo !< deposition efficiency
3319	REAL(wp) :: gamma !< parameter, Table 3 in Zhang et al. (2001)
3320	REAL(wp) :: par_A !< parameter A for the characteristic radius of
3321	!< collectors, Table 3 in Zhang et al. (2001)
3322	REAL(wp) :: rt !< the overall quasi-laminar resistance for
3323	!< particles
3324	REAL(wp) :: St !< Stokes number for bluff surface elements
3325	REAL(wp) :: tau_plus !< dimensionless particle relaxation time
3326	REAL(wp) :: v_bd !< deposition velocity due to Brownian diffusion
3327	REAL(wp) :: v_im !< deposition velocity due to impaction
3328	REAL(wp) :: v_in !< deposition velocity due to interception
3329	REAL(wp) :: v_it !< deposition velocity due to turbulent impaction
3330	!
3331	!-- Initialise
3332	rt = 0.0_wp
3333	St = 0.0_wp
3334	tau_plus = 0.0_wp
3335	v_bd = 0.0_wp
3336	v_im = 0.0_wp
3337	v_in = 0.0_wp
3338	v_it = 0.0_wp
3339	surf_s = surf%start_index(j,i)
3340	surf_e = surf%end_index(j,i)
3341
3342	DO m = surf_s, surf_e
3343	k = surf%k(m)
3344	DO b = 1, nbins
3345	IF ( aerosol_number(b)%conc(k,j,i) <= nclim .OR. &
3346	Sc(k+1,b) < 1.0_wp ) CYCLE
3347
3348	IF ( depo_topo_type == 'zhang2001' ) THEN
3349	!
3350	!-- Parameters for the land use category 'urban' in Table 3
3351	alpha = 1.5_wp
3352	gamma = 0.56_wp
3353	par_A = 10.0E-3_wp
3354	!
3355	!-- Stokes number for smooth surfaces or surfaces with bluff roughness
3356	!-- elements (Seinfeld and Pandis, 2nd edition (2006): Eq. 19.23)
3357	St = MAX( 0.01_wp, vc(k+1,b) * surf%us(m) ** 2.0_wp / &
3358	( g * kvis(k+1) ) )
3359	!
3360	!-- The overall quasi-laminar resistance for particles (Eq. 5)
3361	rt = MAX( EPSILON( 1.0_wp ), ( 3.0_wp * surf%us(m) * ( &
3362	Sc(k+1,b)( -gamma ) + ( St / ( alpha + St ) )2.0_wp &
3363	+ 0.5_wp * ( Ra_dry(k,j,i,b) / par_A )*2.0_wp ) &
3364	EXP( -St**0.5_wp ) ) )
3365	depo = vc(k+1,b) + rt
3366
3367	ELSEIF ( depo_topo_type == 'petroff2010' ) THEN
3368	!
3369	!-- vd = v_BD + v_IN + v_IM + v_IT + vc
3370	!-- Deposition efficiencies from Table 1. Constants from Table 2.
3371	C_Br = 1.262_wp
3372	C_IM = 0.130_wp
3373	C_IN = 0.216_wp
3374	C_IT = 0.056_wp
3375	par_A = 0.03_wp ! Here: leaf width (m)
3376	!
3377	!-- Stokes number for smooth surfaces or surfaces with bluff roughness
3378	!-- elements (Seinfeld and Pandis, 2nd edition (2006): Eq. 19.23)
3379	St = MAX( 0.01_wp, vc(k+1,b) * surf%us(m) ** 2.0_wp / &
3380	( g * kvis(k+1) ) )
3381	!
3382	!-- Non-dimensional relexation time of the particle on top of canopy
3383	tau_plus = vc(k+1,b) * surf%us(m)*2.0_wp / ( kvis(k+1) g )
3384	!
3385	!-- Brownian diffusion
3386	v_bd = mag_u(k+1) * C_Br * Sc(k+1,b)*( -2.0_wp / 3.0_wp ) &
3387	( mag_u(k+1) * par_A / kvis(k+1) )**( -0.5_wp )
3388	!
3389	!-- Interception
3390	v_in = mag_u(k+1) * C_IN * Ra_dry(k,j,i,b)/ par_A * ( 2.0_wp + &
3391	LOG( 2.0_wp * par_A / Ra_dry(k,j,i,b) ) )
3392	!
3393	!-- Impaction: Petroff (2009) Eq. 18
3394	v_im = mag_u(k+1) * C_IM * ( St / ( St + 0.47_wp ) )**2.0_wp
3395
3396	IF ( tau_plus < 20.0_wp ) THEN
3397	v_it = 2.5E-3_wp * C_IT * tau_plus**2.0_wp
3398	ELSE
3399	v_it = C_IT
3400	ENDIF
3401	depo = v_bd + v_in + v_im + v_it + vc(k+1,b)
3402
3403	ENDIF
3404	IF ( lod_aero == 3 .OR. salsa_source_mode == 'no_source' ) THEN
3405	surf%answs(m,b) = -depo * norm(k) * aerosol_number(b)%conc(k,j,i)
3406	DO c = 1, ncc_tot
3407	surf%amsws(m,(c-1)nbins+b) = -depo norm(k) * &
3408	aerosol_mass((c-1)*nbins+b)%conc(k,j,i)
3409	ENDDO ! c
3410	ELSE
3411	surf%answs(m,b) = SUM( aerosol_number(b)%source(:,j,i) ) - &
3412	MAX( 0.0_wp, depo * norm(k) * &
3413	aerosol_number(b)%conc(k,j,i) )
3414	DO c = 1, ncc_tot
3415	surf%amsws(m,(c-1)*nbins+b) = SUM( &
3416	aerosol_mass((c-1)*nbins+b)%source(:,j,i) ) - &
3417	MAX( 0.0_wp, depo * norm(k) * &
3418	aerosol_mass((c-1)*nbins+b)%conc(k,j,i) )
3419	ENDDO
3420	ENDIF
3421	ENDDO ! b
3422	ENDDO ! m
3423
3424	END SUBROUTINE depo_topo
3425
3426	!------------------------------------------------------------------------------!
3427	! Description:
3428	! ------------
3429	! Function for calculating terminal velocities for different particles sizes.
3430	!------------------------------------------------------------------------------!
3431	REAL(wp) FUNCTION terminal_vel( radius, rhop, rhoa, visc, beta )
3432
3433	IMPLICIT NONE
3434
3435	REAL(wp), INTENT(in) :: beta !< Cunningham correction factor
3436	REAL(wp), INTENT(in) :: radius !< particle radius (m)
3437	REAL(wp), INTENT(in) :: rhop !< particle density (kg/m3)
3438	REAL(wp), INTENT(in) :: rhoa !< air density (kg/m3)
3439	REAL(wp), INTENT(in) :: visc !< molecular viscosity of air (kg/(m*s))
3440
3441	REAL(wp), PARAMETER :: rhoa_ref = 1.225_wp ! reference air density (kg/m3)
3442	!
3443	!-- Stokes law with Cunningham slip correction factor
3444	terminal_vel = ( 4.0_wp * radius*2.0_wp ) ( rhop - rhoa ) * g * beta / &
3445	( 18.0_wp * visc ) ! (m/s)
3446
3447	END FUNCTION terminal_vel
3448
3449	!------------------------------------------------------------------------------!
3450	! Description:
3451	! ------------
3452	!> Calculates particle loss and change in size distribution due to (Brownian)
3453	!> coagulation. Only for particles with dwet < 30 micrometres.
3454	!
3455	!> Method:
3456	!> Semi-implicit, non-iterative method: (Jacobson, 1994)
3457	!> Volume concentrations of the smaller colliding particles added to the bin of
3458	!> the larger colliding particles. Start from first bin and use the updated
3459	!> number and volume for calculation of following bins. NB! Our bin numbering
3460	!> does not follow particle size in subrange 2.
3461	!
3462	!> Schematic for bin numbers in different subranges:
3463	!> 1 2
3464	!> +-------------------------------------------+
3465	!> a \| 1 \| 2 \| 3 \|\| 4 \| 5 \| 6 \| 7 \| 8 \| 9 \| 10\|\|
3466	!> b \| \|\|11 \|12 \|13 \|14 \| 15 \| 16 \| 17\|\|
3467	!> +-------------------------------------------+
3468	!
3469	!> Exact coagulation coefficients for each pressure level are scaled according
3470	!> to current particle wet size (linear scaling).
3471	!> Bins are organized in terms of the dry size of the condensation nucleus,
3472	!> while coagulation kernell is calculated with the actual hydrometeor
3473	!> size.
3474	!
3475	!> Called from salsa_driver
3476	!> fxm: Process selection should be made smarter - now just lots of IFs inside
3477	!> loops
3478	!
3479	!> Coded by:
3480	!> Hannele Korhonen (FMI) 2005
3481	!> Harri Kokkola (FMI) 2006
3482	!> Tommi Bergman (FMI) 2012
3483	!> Matti Niskanen(FMI) 2012
3484	!> Anton Laakso (FMI) 2013
3485	!> Juha Tonttila (FMI) 2014
3486	!------------------------------------------------------------------------------!
3487	SUBROUTINE coagulation( paero, ptstep, ptemp, ppres )
3488
3489	IMPLICIT NONE
3490
3491	!-- Input and output variables
3492	TYPE(t_section), INTENT(inout) :: paero(fn2b) !< Aerosol properties
3493	REAL(wp), INTENT(in) :: ppres !< ambient pressure (Pa)
3494	REAL(wp), INTENT(in) :: ptemp !< ambient temperature (K)
3495	REAL(wp), INTENT(in) :: ptstep !< time step (s)
3496	!-- Local variables
3497	INTEGER(iwp) :: index_2a !< corresponding bin in subrange 2a
3498	INTEGER(iwp) :: index_2b !< corresponding bin in subrange 2b
3499	INTEGER(iwp) :: b !< loop index
3500	INTEGER(iwp) :: ll !< loop index
3501	INTEGER(iwp) :: mm !< loop index
3502	INTEGER(iwp) :: nn !< loop index
3503	REAL(wp) :: pressi !< pressure
3504	REAL(wp) :: temppi !< temperature
3505	REAL(wp) :: zcc(fn2b,fn2b) !< updated coagulation coefficients (m3/s)
3506	REAL(wp) :: zdpart_mm !< diameter of particle (m)
3507	REAL(wp) :: zdpart_nn !< diameter of particle (m)
3508	REAL(wp) :: zminusterm !< coagulation loss in a bin (1/s)
3509	REAL(wp) :: zplusterm(8) !< coagulation gain in a bin (fxm/s)
3510	!< (for each chemical compound)
3511	REAL(wp) :: zmpart(fn2b) !< approximate mass of particles (kg)
3512
3513	zcc = 0.0_wp
3514	zmpart = 0.0_wp
3515	zdpart_mm = 0.0_wp
3516	zdpart_nn = 0.0_wp
3517	!
3518	!-- 1) Coagulation to coarse mode calculated in a simplified way:
3519	!-- CoagSink ~ Dp in continuum subrange, thus we calculate 'effective'
3520	!-- number concentration of coarse particles
3521
3522	!-- 2) Updating coagulation coefficients
3523	!
3524	!-- Aerosol mass (kg). Density of 1500 kg/m3 assumed
3525	zmpart(1:fn2b) = api6 * ( MIN( paero(1:fn2b)%dwet, 30.0E-6_wp )**3.0_wp ) &
3526	* 1500.0_wp
3527	temppi = ptemp
3528	pressi = ppres
3529	zcc = 0.0_wp
3530	!
3531	!-- Aero-aero coagulation
3532	DO mm = 1, fn2b ! smaller colliding particle
3533	IF ( paero(mm)%numc < nclim ) CYCLE
3534	DO nn = mm, fn2b ! larger colliding particle
3535	IF ( paero(nn)%numc < nclim ) CYCLE
3536
3537	zdpart_mm = MIN( paero(mm)%dwet, 30.0E-6_wp ) ! Limit to 30 um
3538	zdpart_nn = MIN( paero(nn)%dwet, 30.0E-6_wp ) ! Limit to 30 um
3539	!
3540	!-- Coagulation coefficient of particles (m3/s)
3541	zcc(mm,nn) = coagc( zdpart_mm, zdpart_nn, zmpart(mm), zmpart(nn), &
3542	temppi, pressi )
3543	zcc(nn,mm) = zcc(mm,nn)
3544	ENDDO
3545	ENDDO
3546
3547	!
3548	!-- 3) New particle and volume concentrations after coagulation:
3549	!-- Calculated according to Jacobson (2005) eq. 15.9
3550	!
3551	!-- Aerosols in subrange 1a:
3552	DO b = in1a, fn1a
3553	IF ( paero(b)%numc < nclim ) CYCLE
3554	zminusterm = 0.0_wp
3555	zplusterm(:) = 0.0_wp
3556	!
3557	!-- Particles lost by coagulation with larger aerosols
3558	DO ll = b+1, fn2b
3559	zminusterm = zminusterm + zcc(b,ll) * paero(ll)%numc
3560	ENDDO
3561	!
3562	!-- Coagulation gain in a bin: change in volume conc. (cm3/cm3):
3563	DO ll = in1a, b-1
3564	zplusterm(1:2) = zplusterm(1:2) + zcc(ll,b) * paero(ll)%volc(1:2)
3565	zplusterm(6:7) = zplusterm(6:7) + zcc(ll,b) * paero(ll)%volc(6:7)
3566	zplusterm(8) = zplusterm(8) + zcc(ll,b) * paero(ll)%volc(8)
3567	ENDDO
3568	!
3569	!-- Volume and number concentrations after coagulation update [fxm]
3570	paero(b)%volc(1:2) = ( paero(b)%volc(1:2) + ptstep * zplusterm(1:2) * &
3571	paero(b)%numc ) / ( 1.0_wp + ptstep * zminusterm )
3572	paero(b)%volc(6:7) = ( paero(b)%volc(6:7) + ptstep * zplusterm(6:7) * &
3573	paero(b)%numc ) / ( 1.0_wp + ptstep * zminusterm )
3574	paero(b)%volc(8) = ( paero(b)%volc(8) + ptstep * zplusterm(8) * &
3575	paero(b)%numc ) / ( 1.0_wp + ptstep * zminusterm )
3576	paero(b)%numc = paero(b)%numc / ( 1.0_wp + ptstep * zminusterm + &
3577	0.5_wp * ptstep * zcc(b,b) * paero(b)%numc )
3578	ENDDO
3579	!
3580	!-- Aerosols in subrange 2a:
3581	DO b = in2a, fn2a
3582	IF ( paero(b)%numc < nclim ) CYCLE
3583	zminusterm = 0.0_wp
3584	zplusterm(:) = 0.0_wp
3585	!
3586	!-- Find corresponding size bin in subrange 2b
3587	index_2b = b - in2a + in2b
3588	!
3589	!-- Particles lost by larger particles in 2a
3590	DO ll = b+1, fn2a
3591	zminusterm = zminusterm + zcc(b,ll) * paero(ll)%numc
3592	ENDDO
3593	!
3594	!-- Particles lost by larger particles in 2b
3595	IF ( .NOT. no_insoluble ) THEN
3596	DO ll = index_2b+1, fn2b
3597	zminusterm = zminusterm + zcc(b,ll) * paero(ll)%numc
3598	ENDDO
3599	ENDIF
3600	!
3601	!-- Particle volume gained from smaller particles in subranges 1, 2a and 2b
3602	DO ll = in1a, b-1
3603	zplusterm(1:2) = zplusterm(1:2) + zcc(ll,b) * paero(ll)%volc(1:2)
3604	zplusterm(6:7) = zplusterm(6:7) + zcc(ll,b) * paero(ll)%volc(6:7)
3605	zplusterm(8) = zplusterm(8) + zcc(ll,b) * paero(ll)%volc(8)
3606	ENDDO
3607	!
3608	!-- Particle volume gained from smaller particles in 2a
3609	!-- (Note, for components not included in the previous loop!)
3610	DO ll = in2a, b-1
3611	zplusterm(3:5) = zplusterm(3:5) + zcc(ll,b)*paero(ll)%volc(3:5)
3612	ENDDO
3613
3614	!
3615	!-- Particle volume gained from smaller (and equal) particles in 2b
3616	IF ( .NOT. no_insoluble ) THEN
3617	DO ll = in2b, index_2b
3618	zplusterm(1:8) = zplusterm(1:8) + zcc(ll,b) * paero(ll)%volc(1:8)
3619	ENDDO
3620	ENDIF
3621	!
3622	!-- Volume and number concentrations after coagulation update [fxm]
3623	paero(b)%volc(1:8) = ( paero(b)%volc(1:8) + ptstep * zplusterm(1:8) * &
3624	paero(b)%numc ) / ( 1.0_wp + ptstep * zminusterm )
3625	paero(b)%numc = paero(b)%numc / ( 1.0_wp + ptstep * zminusterm + &
3626	0.5_wp * ptstep * zcc(b,b) * paero(b)%numc )
3627	ENDDO
3628	!
3629	!-- Aerosols in subrange 2b:
3630	IF ( .NOT. no_insoluble ) THEN
3631	DO b = in2b, fn2b
3632	IF ( paero(b)%numc < nclim ) CYCLE
3633	zminusterm = 0.0_wp
3634	zplusterm(:) = 0.0_wp
3635	!
3636	!-- Find corresponding size bin in subsubrange 2a
3637	index_2a = b - in2b + in2a
3638	!
3639	!-- Particles lost to larger particles in subranges 2b
3640	DO ll = b+1, fn2b
3641	zminusterm = zminusterm + zcc(b,ll) * paero(ll)%numc
3642	ENDDO
3643	!
3644	!-- Particles lost to larger and equal particles in 2a
3645	DO ll = index_2a, fn2a
3646	zminusterm = zminusterm + zcc(b,ll) * paero(ll)%numc
3647	ENDDO
3648	!
3649	!-- Particle volume gained from smaller particles in subranges 1 & 2a
3650	DO ll = in1a, index_2a-1
3651	zplusterm(1:8) = zplusterm(1:8) + zcc(ll,b) * paero(ll)%volc(1:8)
3652	ENDDO
3653	!
3654	!-- Particle volume gained from smaller particles in 2b
3655	DO ll = in2b, b-1
3656	zplusterm(1:8) = zplusterm(1:8) + zcc(ll,b) * paero(ll)%volc(1:8)
3657	ENDDO
3658	!
3659	!-- Volume and number concentrations after coagulation update [fxm]
3660	paero(b)%volc(1:8) = ( paero(b)%volc(1:8) + ptstep * zplusterm(1:8)&
3661	* paero(b)%numc ) / ( 1.0_wp + ptstep * zminusterm )
3662	paero(b)%numc = paero(b)%numc / ( 1.0_wp + ptstep * zminusterm + &
3663	0.5_wp * ptstep * zcc(b,b) * paero(b)%numc )
3664	ENDDO
3665	ENDIF
3666
3667	END SUBROUTINE coagulation
3668
3669	!------------------------------------------------------------------------------!
3670	! Description:
3671	! ------------
3672	!> Calculation of coagulation coefficients. Extended version of the function
3673	!> originally found in mo_salsa_init.
3674	!
3675	!> J. Tonttila, FMI, 05/2014
3676	!------------------------------------------------------------------------------!
3677	REAL(wp) FUNCTION coagc( diam1, diam2, mass1, mass2, temp, pres )
3678
3679	IMPLICIT NONE
3680	!
3681	!-- Input and output variables
3682	REAL(wp), INTENT(in) :: diam1 !< diameter of colliding particle 1 (m)
3683	REAL(wp), INTENT(in) :: diam2 !< diameter of colliding particle 2 (m)
3684	REAL(wp), INTENT(in) :: mass1 !< mass of colliding particle 1 (kg)
3685	REAL(wp), INTENT(in) :: mass2 !< mass of colliding particle 2 (kg)
3686	REAL(wp), INTENT(in) :: pres !< ambient pressure (Pa?) [fxm]
3687	REAL(wp), INTENT(in) :: temp !< ambient temperature (K)
3688	!
3689	!-- Local variables
3690	REAL(wp) :: fmdist !< distance of flux matching (m)
3691	REAL(wp) :: knud_p !< particle Knudsen number
3692	REAL(wp) :: mdiam !< mean diameter of colliding particles (m)
3693	REAL(wp) :: mfp !< mean free path of air molecules (m)
3694	REAL(wp) :: visc !< viscosity of air (kg/(m s))
3695	REAL(wp), DIMENSION (2) :: beta !< Cunningham correction factor
3696	REAL(wp), DIMENSION (2) :: dfpart !< particle diffusion coefficient
3697	!< (m2/s)
3698	REAL(wp), DIMENSION (2) :: diam !< diameters of particles (m)
3699	REAL(wp), DIMENSION (2) :: flux !< flux in continuum and free molec.
3700	!< regime (m/s)
3701	REAL(wp), DIMENSION (2) :: knud !< particle Knudsen number
3702	REAL(wp), DIMENSION (2) :: mpart !< masses of particles (kg)
3703	REAL(wp), DIMENSION (2) :: mtvel !< particle mean thermal velocity (m/s)
3704	REAL(wp), DIMENSION (2) :: omega !< particle mean free path
3705	REAL(wp), DIMENSION (2) :: tva !< temporary variable (m)
3706	!
3707	!-- Initialisation
3708	coagc = 0.0_wp
3709	!
3710	!-- 1) Initializing particle and ambient air variables
3711	diam = (/ diam1, diam2 /) !< particle diameters (m)
3712	mpart = (/ mass1, mass2 /) !< particle masses (kg)
3713	!-- Viscosity of air (kg/(m s))
3714	visc = ( 7.44523E-3_wp * temp ** 1.5_wp ) / &
3715	( 5093.0_wp * ( temp + 110.4_wp ) )
3716	!-- Mean free path of air (m)
3717	mfp = ( 1.656E-10_wp * temp + 1.828E-8_wp ) * ( p_0 + 1325.0_wp ) / pres
3718	!
3719	!-- 2) Slip correction factor for small particles
3720	knud = 2.0_wp * EXP( LOG(mfp) - LOG(diam) )! Knudsen number for air (15.23)
3721	!-- Cunningham correction factor (Allen and Raabe, Aerosol Sci. Tech. 4, 269)
3722	beta = 1.0_wp + knud * ( 1.142_wp + 0.558_wp * EXP( -0.999_wp / knud ) )
3723	!
3724	!-- 3) Particle properties
3725	!-- Diffusion coefficient (m2/s) (Jacobson (2005) eq. 15.29)
3726	dfpart = beta * abo * temp / ( 3.0_wp * pi * visc * diam )
3727	!-- Mean thermal velocity (m/s) (Jacobson (2005) eq. 15.32)
3728	mtvel = SQRT( ( 8.0_wp * abo * temp ) / ( pi * mpart ) )
3729	!-- Particle mean free path (m) (Jacobson (2005) eq. 15.34 )
3730	omega = 8.0_wp * dfpart / ( pi * mtvel )
3731	!-- Mean diameter (m)
3732	mdiam = 0.5_wp * ( diam(1) + diam(2) )
3733	!
3734	!-- 4) Calculation of fluxes (Brownian collision kernels) and flux matching
3735	!-- following Jacobson (2005):
3736	!-- Flux in continuum regime (m3/s) (eq. 15.28)
3737	flux(1) = 4.0_wp * pi * mdiam * ( dfpart(1) + dfpart(2) )
3738	!-- Flux in free molec. regime (m3/s) (eq. 15.31)
3739	flux(2) = pi * SQRT( ( mtvel(1)2.0_wp ) + ( mtvel(2)2.0_wp ) ) * &
3740	( mdiam**2.0_wp )
3741	!-- temporary variables (m) to calculate flux matching distance (m)
3742	tva(1) = ( ( mdiam + omega(1) )3.0_wp - ( mdiam2.0_wp + &
3743	omega(1)*2.0_wp ) SQRT( ( mdiam2.0_wp + omega(1)2.0_wp ) &
3744	) ) / ( 3.0_wp * mdiam * omega(1) ) - mdiam
3745	tva(2) = ( ( mdiam + omega(2) )3.0_wp - ( mdiam2.0_wp + &
3746	omega(2)*2.0_wp ) SQRT( ( mdiam2 + omega(2)2 ) ) ) / &
3747	( 3.0_wp * mdiam * omega(2) ) - mdiam
3748	!-- Flux matching distance (m) i.e. the mean distance from the centre of a
3749	!-- sphere reached by particles leaving sphere's surface and travelling a
3750	!-- distance of particle mean free path mfp (eq. 15 34)
3751	fmdist = SQRT( tva(1)2 + tva(2)2.0_wp)
3752	!
3753	!-- 5) Coagulation coefficient (m3/s) (eq. 15.33). Here assumed
3754	!-- coalescence efficiency 1!!
3755	coagc = flux(1) / ( mdiam / ( mdiam + fmdist) + flux(1) / flux(2) )
3756	!-- coagulation coefficient = coalescence efficiency * collision kernel
3757	!
3758	!-- Corrected collision kernel following Karl et al., 2016 (ACP):
3759	!-- Inclusion of van der Waals and viscous forces
3760	IF ( van_der_waals_coagc ) THEN
3761	knud_p = SQRT( omega(1)2 + omega(2)2 ) / mdiam
3762	IF ( knud_p >= 0.1_wp .AND. knud_p <= 10.0_wp ) THEN
3763	coagc = coagc * ( 2.0_wp + 0.4_wp * LOG( knud_p ) )
3764	ELSE
3765	coagc = coagc * 3.0_wp
3766	ENDIF
3767	ENDIF
3768
3769	END FUNCTION coagc
3770
3771	!------------------------------------------------------------------------------!
3772	! Description:
3773	! ------------
3774	!> Calculates the change in particle volume and gas phase
3775	!> concentrations due to nucleation, condensation and dissolutional growth.
3776	!
3777	!> Sulphuric acid and organic vapour: only condensation and no evaporation.
3778	!
3779	!> New gas and aerosol phase concentrations calculated according to Jacobson
3780	!> (1997): Numerical techniques to solve condensational and dissolutional growth
3781	!> equations when growth is coupled to reversible reactions, Aerosol Sci. Tech.,
3782	!> 27, pp 491-498.
3783	!
3784	!> Following parameterization has been used:
3785	!> Molecular diffusion coefficient of condensing vapour (m2/s)
3786	!> (Reid et al. (1987): Properties of gases and liquids, McGraw-Hill, New York.)
3787	!> D = {1.d-7sqrt(1/M_air + 1/M_gas)T^1.75} / &
3788	! {p_atm/p_stand * (d_air^(1/3) + d_gas^(1/3))^2 }
3789	! M_air = 28.965 : molar mass of air (g/mol)
3790	! d_air = 19.70 : diffusion volume of air
3791	! M_h2so4 = 98.08 : molar mass of h2so4 (g/mol)
3792	! d_h2so4 = 51.96 : diffusion volume of h2so4
3793	!
3794	!> Called from main aerosol model
3795	!
3796	!> fxm: calculated for empty bins too
3797	!> fxm: same diffusion coefficients and mean free paths used for sulphuric acid
3798	!> and organic vapours (average values? 'real' values for each?)
3799	!> fxm: one should really couple with vapour production and loss terms as well
3800	!> should nucleation be coupled here as well????
3801	!
3802	! Coded by:
3803	! Hannele Korhonen (FMI) 2005
3804	! Harri Kokkola (FMI) 2006
3805	! Juha Tonttila (FMI) 2014
3806	! Rewritten to PALM by Mona Kurppa (UHel) 2017
3807	!------------------------------------------------------------------------------!
3808	SUBROUTINE condensation( paero, pcsa, pcocnv, pcocsv, pchno3, pcnh3, pcw, pcs,&
3809	ptemp, ppres, ptstep, prtcl )
3810
3811	IMPLICIT NONE
3812
3813	!-- Input and output variables
3814	REAL(wp), INTENT(IN) :: ppres !< ambient pressure (Pa)
3815	REAL(wp), INTENT(IN) :: pcs !< Water vapour saturation concentration
3816	!< (kg/m3)
3817	REAL(wp), INTENT(IN) :: ptemp !< ambient temperature (K)
3818	REAL(wp), INTENT(IN) :: ptstep !< timestep (s)
3819	TYPE(component_index), INTENT(in) :: prtcl !< Keeps track which substances
3820	!< are used
3821	REAL(wp), INTENT(INOUT) :: pchno3 !< Gas concentrations (#/m3):
3822	!< nitric acid HNO3
3823	REAL(wp), INTENT(INOUT) :: pcnh3 !< ammonia NH3
3824	REAL(wp), INTENT(INOUT) :: pcocnv !< non-volatile organics
3825	REAL(wp), INTENT(INOUT) :: pcocsv !< semi-volatile organics
3826	REAL(wp), INTENT(INOUT) :: pcsa !< sulphuric acid H2SO4
3827	REAL(wp), INTENT(INOUT) :: pcw !< Water vapor concentration (kg/m3)
3828	TYPE(t_section), INTENT(inout) :: paero(fn2b) !< Aerosol properties
3829	!-- Local variables
3830	REAL(wp) :: zbeta(fn2b) !< transitional correction factor for aerosols
3831	REAL(wp) :: zcolrate(fn2b) !< collision rate of molecules to particles
3832	!< (1/s)
3833	REAL(wp) :: zcolrate_ocnv(fn2b) !< collision rate of organic molecules
3834	!< to particles (1/s)
3835	REAL(wp) :: zcs_ocnv !< condensation sink of nonvolatile organics (1/s)
3836	REAL(wp) :: zcs_ocsv !< condensation sink of semivolatile organics (1/s)
3837	REAL(wp) :: zcs_su !< condensation sink of sulfate (1/s)
3838	REAL(wp) :: zcs_tot!< total condensation sink (1/s) (gases)
3839	!-- vapour concentration after time step (#/m3)
3840	REAL(wp) :: zcvap_new1 !< sulphuric acid
3841	REAL(wp) :: zcvap_new2 !< nonvolatile organics
3842	REAL(wp) :: zcvap_new3 !< semivolatile organics
3843	REAL(wp) :: zdfpart(in1a+1) !< particle diffusion coefficient (m2/s)
3844	REAL(wp) :: zdfvap !< air diffusion coefficient (m2/s)
3845	!-- change in vapour concentration (#/m3)
3846	REAL(wp) :: zdvap1 !< sulphuric acid
3847	REAL(wp) :: zdvap2 !< nonvolatile organics
3848	REAL(wp) :: zdvap3 !< semivolatile organics
3849	REAL(wp) :: zdvoloc(fn2b) !< change of organics volume in each bin [fxm]
3850	REAL(wp) :: zdvolsa(fn2b) !< change of sulphate volume in each bin [fxm]
3851	REAL(wp) :: zj3n3(2) !< Formation massrate of molecules in
3852	!< nucleation, (molec/m3s). 1: H2SO4
3853	!< and 2: organic vapor
3854	REAL(wp) :: zknud(fn2b) !< particle Knudsen number
3855	REAL(wp) :: zmfp !< mean free path of condensing vapour (m)
3856	REAL(wp) :: zrh !< Relative humidity [0-1]
3857	REAL(wp) :: zvisc !< viscosity of air (kg/(m s))
3858	REAL(wp) :: zn_vs_c !< ratio of nucleation of all mass transfer in the
3859	!< smallest bin
3860	REAL(wp) :: zxocnv !< ratio of organic vapour in 3nm particles
3861	REAL(wp) :: zxsa !< Ratio in 3nm particles: sulphuric acid
3862
3863	zj3n3 = 0.0_wp
3864	zrh = pcw / pcs
3865	zxocnv = 0.0_wp
3866	zxsa = 0.0_wp
3867	!
3868	!-- Nucleation
3869	IF ( nsnucl > 0 ) THEN
3870	CALL nucleation( paero, ptemp, zrh, ppres, pcsa, pcocnv, pcnh3, ptstep, &
3871	zj3n3, zxsa, zxocnv )
3872	ENDIF
3873	!
3874	!-- Condensation on pre-existing particles
3875	IF ( lscndgas ) THEN
3876	!
3877	!-- Initialise:
3878	zdvolsa = 0.0_wp
3879	zdvoloc = 0.0_wp
3880	zcolrate = 0.0_wp
3881	!
3882	!-- 1) Properties of air and condensing gases:
3883	!-- Viscosity of air (kg/(m s)) (Eq. 4.54 in Jabonson (2005))
3884	zvisc = ( 7.44523E-3_wp * ptemp ** 1.5_wp ) / ( 5093.0_wp * &
3885	( ptemp + 110.4_wp ) )
3886	!-- Diffusion coefficient of air (m2/s)
3887	zdfvap = 5.1111E-10_wp * ptemp ** 1.75_wp * ( p_0 + 1325.0_wp ) / ppres
3888	!-- Mean free path (m): same for H2SO4 and organic compounds
3889	zmfp = 3.0_wp * zdfvap * SQRT( pi * amh2so4 / ( 8.0_wp * argas * ptemp ) )
3890	!
3891	!-- 2) Transition regime correction factor zbeta for particles:
3892	!-- Fuchs and Sutugin (1971), In: Hidy et al. (ed.) Topics in current
3893	!-- aerosol research, Pergamon. Size of condensing molecule considered
3894	!-- only for nucleation mode (3 - 20 nm)
3895	!
3896	!-- Particle Knudsen number: condensation of gases on aerosols
3897	zknud(in1a:in1a+1) = 2.0_wp * zmfp / ( paero(in1a:in1a+1)%dwet + d_sa )
3898	zknud(in1a+2:fn2b) = 2.0_wp * zmfp / paero(in1a+2:fn2b)%dwet
3899	!
3900	!-- Transitional correction factor: aerosol + gas (the semi-empirical Fuchs-
3901	!-- Sutugin interpolation function (Fuchs and Sutugin, 1971))
3902	zbeta = ( zknud + 1.0_wp ) / ( 0.377_wp * zknud + 1.0_wp + 4.0_wp / &
3903	( 3.0_wp * massacc ) * ( zknud + zknud ** 2.0_wp ) )
3904	!
3905	!-- 3) Collision rate of molecules to particles
3906	!-- Particle diffusion coefficient considered only for nucleation mode
3907	!-- (3 - 20 nm)
3908	!
3909	!-- Particle diffusion coefficient (m2/s) (e.g. Eq. 15.29 in Jacobson (2005))
3910	zdfpart = abo * ptemp * zbeta(in1a:in1a+1) / ( 3.0_wp * pi * zvisc * &
3911	paero(in1a:in1a+1)%dwet )
3912	!
3913	!-- Collision rate (mass-transfer coefficient): gases on aerosols (1/s)
3914	!-- (Eq. 16.64 in Jacobson (2005))
3915	zcolrate(in1a:in1a+1) = MERGE( 2.0_wp * pi * &
3916	( paero(in1a:in1a+1)%dwet + d_sa ) * &
3917	( zdfvap + zdfpart ) * zbeta(in1a:in1a+1)&
3918	* paero(in1a:in1a+1)%numc, 0.0_wp, &
3919	paero(in1a:in1a+1)%numc > nclim )
3920	zcolrate(in1a+2:fn2b) = MERGE( 2.0_wp * pi * paero(in1a+2:fn2b)%dwet * &
3921	zdfvap * zbeta(in1a+2:fn2b) * &
3922	paero(in1a+2:fn2b)%numc, 0.0_wp, &
3923	paero(in1a+2:fn2b)%numc > nclim )
3924	!
3925	!-- 4) Condensation sink (1/s)
3926	zcs_tot = SUM( zcolrate ) ! total sink
3927	!
3928	!-- 5) Changes in gas-phase concentrations and particle volume
3929	!
3930	!-- 5.1) Organic vapours
3931	!
3932	!-- 5.1.1) Non-volatile organic compound: condenses onto all bins
3933	IF ( pcocnv > 1.0E+10_wp .AND. zcs_tot > 1.0E-30_wp .AND. &
3934	is_used( prtcl,'OC' ) ) &
3935	THEN
3936	!-- Ratio of nucleation vs. condensation rates in the smallest bin
3937	zn_vs_c = 0.0_wp
3938	IF ( zj3n3(2) > 1.0_wp ) THEN
3939	zn_vs_c = ( zj3n3(2) ) / ( zj3n3(2) + pcocnv * zcolrate(in1a) )
3940	ENDIF
3941	!
3942	!-- Collision rate in the smallest bin, including nucleation and
3943	!-- condensation(see Jacobson, Fundamentals of Atmospheric Modeling, 2nd
3944	!-- Edition (2005), equation (16.73) )
3945	zcolrate_ocnv = zcolrate
3946	zcolrate_ocnv(in1a) = zcolrate_ocnv(in1a) + zj3n3(2) / pcocnv
3947	!
3948	!-- Total sink for organic vapor
3949	zcs_ocnv = zcs_tot + zj3n3(2) / pcocnv
3950	!
3951	!-- New gas phase concentration (#/m3)
3952	zcvap_new2 = pcocnv / ( 1.0_wp + ptstep * zcs_ocnv )
3953	!
3954	!-- Change in gas concentration (#/m3)
3955	zdvap2 = pcocnv - zcvap_new2
3956	!
3957	!-- Updated vapour concentration (#/m3)
3958	pcocnv = zcvap_new2
3959	!
3960	!-- Volume change of particles (m3(OC)/m3(air))
3961	zdvoloc = zcolrate_ocnv(in1a:fn2b) / zcs_ocnv * amvoc * zdvap2
3962	!
3963	!-- Change of volume due to condensation in 1a-2b
3964	paero(in1a:fn2b)%volc(2) = paero(in1a:fn2b)%volc(2) + zdvoloc
3965	!
3966	!-- Change of number concentration in the smallest bin caused by
3967	!-- nucleation (Jacobson (2005), equation (16.75)). If zxocnv = 0, then
3968	!-- the chosen nucleation mechanism doesn't take into account the non-
3969	!-- volatile organic vapors and thus the paero doesn't have to be updated.
3970	IF ( zxocnv > 0.0_wp ) THEN
3971	paero(in1a)%numc = paero(in1a)%numc + zn_vs_c * zdvoloc(in1a) / &
3972	amvoc / ( n3 * zxocnv )
3973	ENDIF
3974	ENDIF
3975	!
3976	!-- 5.1.2) Semivolatile organic compound: all bins except subrange 1
3977	zcs_ocsv = SUM( zcolrate(in2a:fn2b) ) !< sink for semi-volatile organics
3978	IF ( pcocsv > 1.0E+10_wp .AND. zcs_ocsv > 1.0E-30 .AND. &
3979	is_used( prtcl,'OC') ) &
3980	THEN
3981	!
3982	!-- New gas phase concentration (#/m3)
3983	zcvap_new3 = pcocsv / ( 1.0_wp + ptstep * zcs_ocsv )
3984	!
3985	!-- Change in gas concentration (#/m3)
3986	zdvap3 = pcocsv - zcvap_new3
3987	!
3988	!-- Updated gas concentration (#/m3)
3989	pcocsv = zcvap_new3
3990	!
3991	!-- Volume change of particles (m3(OC)/m3(air))
3992	zdvoloc(in2a:fn2b) = zdvoloc(in2a:fn2b) + zcolrate(in2a:fn2b) / &
3993	zcs_ocsv * amvoc * zdvap3
3994	!
3995	!-- Change of volume due to condensation in 1a-2b
3996	paero(in1a:fn2b)%volc(2) = paero(in1a:fn2b)%volc(2) + zdvoloc
3997	ENDIF
3998	!
3999	!-- 5.2) Sulphate: condensed on all bins
4000	IF ( pcsa > 1.0E+10_wp .AND. zcs_tot > 1.0E-30_wp .AND. &
4001	is_used( prtcl,'SO4' ) ) &
4002	THEN
4003	!
4004	!-- Ratio of mass transfer between nucleation and condensation
4005	zn_vs_c = 0.0_wp
4006	IF ( zj3n3(1) > 1.0_wp ) THEN
4007	zn_vs_c = ( zj3n3(1) ) / ( zj3n3(1) + pcsa * zcolrate(in1a) )
4008	ENDIF
4009	!
4010	!-- Collision rate in the smallest bin, including nucleation and
4011	!-- condensation (see Jacobson, Fundamentals of Atmospheric Modeling, 2nd
4012	!-- Edition (2005), equation (16.73))
4013	zcolrate(in1a) = zcolrate(in1a) + zj3n3(1) / pcsa
4014	!
4015	!-- Total sink for sulfate (1/s)
4016	zcs_su = zcs_tot + zj3n3(1) / pcsa
4017	!
4018	!-- Sulphuric acid:
4019	!-- New gas phase concentration (#/m3)
4020	zcvap_new1 = pcsa / ( 1.0_wp + ptstep * zcs_su )
4021	!
4022	!-- Change in gas concentration (#/m3)
4023	zdvap1 = pcsa - zcvap_new1
4024	!
4025	!-- Updating vapour concentration (#/m3)
4026	pcsa = zcvap_new1
4027	!
4028	!-- Volume change of particles (m3(SO4)/m3(air)) by condensation
4029	zdvolsa = zcolrate(in1a:fn2b) / zcs_su * amvh2so4 * zdvap1
4030	!-- For validation: zdvolsa = 5.5 mum3/cm3 per 12 h
4031	! zdvolsa = zdvolsa / SUM( zdvolsa ) * 5.5E-12_wp * dt_salsa / 43200.0_wp
4032	!0.3E-12_wp, 0.6E-12_wp, 11.0E-12_wp, 4.6E-12_wp, 9.2E-12_wp
4033	!
4034	!-- Change of volume concentration of sulphate in aerosol [fxm]
4035	paero(in1a:fn2b)%volc(1) = paero(in1a:fn2b)%volc(1) + zdvolsa
4036	!
4037	!-- Change of number concentration in the smallest bin caused by nucleation
4038	!-- (Jacobson (2005), equation (16.75))
4039	IF ( zxsa > 0.0_wp ) THEN
4040	paero(in1a)%numc = paero(in1a)%numc + zn_vs_c * zdvolsa(in1a) / &
4041	amvh2so4 / ( n3 * zxsa )
4042	ENDIF
4043	ENDIF
4044	ENDIF
4045	!
4046	!
4047	!-- Condensation of water vapour
4048	IF ( lscndh2oae ) THEN
4049	CALL gpparth2o( paero, ptemp, ppres, pcs, pcw, ptstep )
4050	ENDIF
4051	!
4052	!
4053	!-- Partitioning of H2O, HNO3, and NH3: Dissolutional growth
4054	IF ( lscndgas .AND. ino > 0 .AND. inh > 0 .AND. &
4055	( pchno3 > 1.0E+10_wp .OR. pcnh3 > 1.0E+10_wp ) ) &
4056	THEN
4057	CALL gpparthno3( ppres, ptemp, paero, pchno3, pcnh3, pcw, pcs, zbeta, &
4058	ptstep )
4059	ENDIF
4060
4061	END SUBROUTINE condensation
4062
4063	!------------------------------------------------------------------------------!
4064	! Description:
4065	! ------------
4066	!> Calculates the particle number and volume increase, and gas-phase
4067	!> concentration decrease due to nucleation subsequent growth to detectable size
4068	!> of 3 nm.
4069	!
4070	!> Method:
4071	!> When the formed clusters grow by condensation (possibly also by self-
4072	!> coagulation), their number is reduced due to scavenging to pre-existing
4073	!> particles. Thus, the apparent nucleation rate at 3 nm is significantly lower
4074	!> than the real nucleation rate (at ~1 nm).
4075	!
4076	!> Calculation of the formation rate of detectable particles at 3 nm (i.e. J3):
4077	!> nj3 = 1: Kerminen, V.-M. and Kulmala, M. (2002), J. Aerosol Sci.,33, 609-622.
4078	!> nj3 = 2: Lehtinen et al. (2007), J. Aerosol Sci., 38(9), 988-994.
4079	!> nj3 = 3: Anttila et al. (2010), J. Aerosol Sci., 41(7), 621-636.
4080	!
4081	!> Called from subroutine condensation (in module salsa_dynamics_mod.f90)
4082	!
4083	!> Calls one of the following subroutines:
4084	!> - binnucl
4085	!> - ternucl
4086	!> - kinnucl
4087	!> - actnucl
4088	!
4089	!> fxm: currently only sulphuric acid grows particles from 1 to 3 nm
4090	!> (if asked from Markku, this is terribly wrong!!!)
4091	!
4092	!> Coded by:
4093	!> Hannele Korhonen (FMI) 2005
4094	!> Harri Kokkola (FMI) 2006
4095	!> Matti Niskanen(FMI) 2012
4096	!> Anton Laakso (FMI) 2013
4097	!------------------------------------------------------------------------------!
4098
4099	SUBROUTINE nucleation( paero, ptemp, prh, ppres, pcsa, pcocnv, pcnh3, ptstep, &
4100	pj3n3, pxsa, pxocnv )
4101	IMPLICIT NONE
4102	!
4103	!-- Input and output variables
4104	REAL(wp), INTENT(in) :: pcnh3 !< ammonia concentration (#/m3)
4105	REAL(wp), INTENT(in) :: pcocnv !< conc. of non-volatile OC (#/m3)
4106	REAL(wp), INTENT(in) :: pcsa !< sulphuric acid conc. (#/m3)
4107	REAL(wp), INTENT(in) :: ppres !< ambient air pressure (Pa)
4108	REAL(wp), INTENT(in) :: prh !< ambient rel. humidity [0-1]
4109	REAL(wp), INTENT(in) :: ptemp !< ambient temperature (K)
4110	REAL(wp), INTENT(in) :: ptstep !< time step (s) of SALSA
4111	TYPE(t_section), INTENT(inout) :: paero(fn2b) !< aerosol properties
4112	REAL(wp), INTENT(inout) :: pj3n3(2) !< formation mass rate of molecules
4113	!< (molec/m3s) for 1: H2SO4 and
4114	!< 2: organic vapour
4115	REAL(wp), INTENT(out) :: pxocnv !< ratio of non-volatile organic vapours in
4116	!< 3nm aerosol particles
4117	REAL(wp), INTENT(out) :: pxsa !< ratio of H2SO4 in 3nm aerosol particles
4118	!-- Local variables
4119	INTEGER(iwp) :: iteration
4120	REAL(wp) :: zbeta(fn2b) !< transitional correction factor
4121	REAL(wp) :: zc_h2so4 !< H2SO4 conc. (#/cm3) !UNITS!
4122	REAL(wp) :: zc_org !< organic vapour conc. (#/cm3)
4123	REAL(wp) :: zCoagStot !< total losses due to coagulation, including
4124	!< condensation and self-coagulation
4125	REAL(wp) :: zcocnv_local !< organic vapour conc. (#/m3)
4126	REAL(wp) :: zcsink !< condensational sink (#/m2)
4127	REAL(wp) :: zcsa_local !< H2SO4 conc. (#/m3)
4128	REAL(wp) :: zdcrit !< diameter of critical cluster (m)
4129	REAL(wp) :: zdelta_vap !< change of H2SO4 and organic vapour
4130	!< concentration (#/m3)
4131	REAL(wp) :: zdfvap !< air diffusion coefficient (m2/s)
4132	REAL(wp) :: zdmean !< mean diameter of existing particles (m)
4133	REAL(wp) :: zeta !< constant: proportional to ratio of CS/GR (m)
4134	!< (condensation sink / growth rate)
4135	REAL(wp) :: zgamma !< proportionality factor ((nm2*m2)/h)
4136	REAL(wp) :: zGRclust !< growth rate of formed clusters (nm/h)
4137	REAL(wp) :: zGRtot !< total growth rate
4138	REAL(wp) :: zj3 !< number conc. of formed 3nm particles (#/m3)
4139	REAL(wp) :: zjnuc !< nucleation rate at ~1nm (#/m3s)
4140	REAL(wp) :: zKeff !< effective cogulation coefficient between
4141	!< freshly nucleated particles
4142	REAL(wp) :: zknud(fn2b) !< particle Knudsen number
4143	REAL(wp) :: zkocnv !< lever: zkocnv=1 --> organic compounds involved
4144	!< in nucleation
4145	REAL(wp) :: zksa !< lever: zksa=1 --> H2SO4 involved in nucleation
4146	REAL(wp) :: zlambda !< parameter for adjusting the growth rate due to
4147	!< self-coagulation
4148	REAL(wp) :: zmfp !< mean free path of condesing vapour(m)
4149	REAL(wp) :: zmixnh3 !< ammonia mixing ratio (ppt)
4150	REAL(wp) :: zNnuc !< number of clusters/particles at the size range
4151	!< d1-dx (#/m3)
4152	REAL(wp) :: znoc !< number of organic molecules in critical cluster
4153	REAL(wp) :: znsa !< number of H2SO4 molecules in critical cluster
4154	!
4155	!-- Variable determined for the m-parameter
4156	REAL(wp) :: zCc_2(fn2b) !<
4157	REAL(wp) :: zCc_c !<
4158	REAL(wp) :: zCc_x !<
4159	REAL(wp) :: zCoagS_c !<
4160	REAL(wp) :: zCoagS_x !<
4161	REAL(wp) :: zcv_2(fn2b) !<
4162	REAL(wp) :: zcv_c !<
4163	REAL(wp) :: zcv_c2(fn2b) !<
4164	REAL(wp) :: zcv_x !<
4165	REAL(wp) :: zcv_x2(fn2b) !<
4166	REAL(wp) :: zDc_2(fn2b) !<
4167	REAL(wp) :: zDc_c(fn2b) !<
4168	REAL(wp) :: zDc_c2(fn2b) !<
4169	REAL(wp) :: zDc_x(fn2b) !<
4170	REAL(wp) :: zDc_x2(fn2b) !<
4171	REAL(wp) :: zgammaF_2(fn2b) !<
4172	REAL(wp) :: zgammaF_c(fn2b) !<
4173	REAL(wp) :: zgammaF_x(fn2b) !<
4174	REAL(wp) :: zK_c2(fn2b) !<
4175	REAL(wp) :: zK_x2(fn2b) !<
4176	REAL(wp) :: zknud_2(fn2b) !<
4177	REAL(wp) :: zknud_c !<
4178	REAL(wp) :: zknud_x !<
4179	REAL(wp) :: zm_2(fn2b) !<
4180	REAL(wp) :: zm_c !<
4181	REAL(wp) :: zm_para !<
4182	REAL(wp) :: zm_x !<
4183	REAL(wp) :: zmyy !<
4184	REAL(wp) :: zomega_2c(fn2b) !<
4185	REAL(wp) :: zomega_2x(fn2b) !<
4186	REAL(wp) :: zomega_c(fn2b) !<
4187	REAL(wp) :: zomega_x(fn2b) !<
4188	REAL(wp) :: zRc2(fn2b) !<
4189	REAL(wp) :: zRx2(fn2b) !<
4190	REAL(wp) :: zsigma_c2(fn2b) !<
4191	REAL(wp) :: zsigma_x2(fn2b) !<
4192	!
4193	!-- 1) Nucleation rate (zjnuc) and diameter of critical cluster (zdcrit)
4194	zjnuc = 0.0_wp
4195	znsa = 0.0_wp
4196	znoc = 0.0_wp
4197	zdcrit = 0.0_wp
4198	zksa = 0.0_wp
4199	zkocnv = 0.0_wp
4200
4201	SELECT CASE ( nsnucl )
4202
4203	CASE(1) ! Binary H2SO4-H2O nucleation
4204
4205	zc_h2so4 = pcsa * 1.0E-6_wp ! sulphuric acid conc. to #/cm3
4206	CALL binnucl( zc_h2so4, ptemp, prh, zjnuc, znsa, znoc, zdcrit, zksa, &
4207	zkocnv )
4208
4209	CASE(2) ! Activation type nucleation
4210
4211	zc_h2so4 = pcsa * 1.0E-6_wp ! sulphuric acid conc. to #/cm3
4212	CALL binnucl( zc_h2so4, ptemp, prh, zjnuc, znsa, znoc, zdcrit, zksa, &
4213	zkocnv )
4214	CALL actnucl( pcsa, zjnuc, zdcrit, znsa, znoc, zksa, zkocnv, act_coeff )
4215
4216	CASE(3) ! Kinetically limited nucleation of (NH4)HSO4 clusters
4217
4218	zc_h2so4 = pcsa * 1.0E-6_wp ! sulphuric acid conc. to #/cm3
4219	CALL binnucl( zc_h2so4, ptemp, prh, zjnuc, znsa, znoc, zdcrit, zksa, &
4220	zkocnv )
4221
4222	CALL kinnucl( zc_h2so4, zjnuc, zdcrit, znsa, znoc, zksa, zkocnv )
4223
4224	CASE(4) ! Ternary H2SO4-H2O-NH3 nucleation
4225
4226	zmixnh3 = pcnh3 * ptemp * argas / ( ppres * avo )
4227	zc_h2so4 = pcsa * 1.0E-6_wp ! sulphuric acid conc. to #/cm3
4228	CALL ternucl( zc_h2so4, zmixnh3, ptemp, prh, zjnuc, znsa, znoc, zdcrit, &
4229	zksa, zkocnv )
4230
4231	CASE(5) ! Organic nucleation, J~[ORG] or J~[ORG]**2
4232
4233	zc_org = pcocnv * 1.0E-6_wp ! conc. of non-volatile OC to #/cm3
4234	zc_h2so4 = pcsa * 1.0E-6_wp ! sulphuric acid conc. to #/cm3
4235	CALL binnucl( zc_h2so4, ptemp, prh, zjnuc, znsa, znoc, zdcrit, zksa, &
4236	zkocnv )
4237	CALL orgnucl( pcocnv, zjnuc, zdcrit, znsa, znoc, zksa, zkocnv )
4238
4239	CASE(6) ! Sum of H2SO4 and organic activation type nucleation,
4240	! J~[H2SO4]+[ORG]
4241
4242	zc_h2so4 = pcsa * 1.0E-6_wp ! sulphuric acid conc. to #/cm3
4243	CALL binnucl( zc_h2so4, ptemp, prh, zjnuc, znsa, znoc, zdcrit, zksa, &
4244	zkocnv )
4245	CALL sumnucl( pcsa, pcocnv, zjnuc, zdcrit, znsa, znoc, zksa, zkocnv )
4246
4247
4248	CASE(7) ! Heteromolecular nucleation, J~[H2SO4]*[ORG]
4249
4250	zc_h2so4 = pcsa * 1.0E-6_wp ! sulphuric acid conc. to #/cm3
4251	zc_org = pcocnv * 1.0E-6_wp ! conc. of non-volatile OC to #/cm3
4252	CALL binnucl( zc_h2so4, ptemp, prh, zjnuc, znsa, znoc, zdcrit, zksa, &
4253	zkocnv )
4254	CALL hetnucl( zc_h2so4, zc_org, zjnuc, zdcrit, znsa, znoc, zksa, zkocnv )
4255
4256	CASE(8) ! Homomolecular nucleation of H2SO4 and heteromolecular
4257	! nucleation of H2SO4 and organic vapour,
4258	! J~[H2SO4]*2 + [H2SO4][ORG] (EUCAARI project)
4259	zc_h2so4 = pcsa * 1.0E-6_wp ! sulphuric acid conc. to #/cm3
4260	zc_org = pcocnv * 1.0E-6_wp ! conc. of non-volatile OC to #/cm3
4261	CALL binnucl( zc_h2so4, ptemp, prh, zjnuc, znsa, znoc, zdcrit, zksa, &
4262	zkocnv )
4263	CALL SAnucl( zc_h2so4, zc_org, zjnuc, zdcrit, znsa, znoc, zksa, zkocnv )
4264
4265	CASE(9) ! Homomolecular nucleation of H2SO4 and organic vapour and
4266	! heteromolecular nucleation of H2SO4 and organic vapour,
4267	! J~[H2SO4]*2 + [H2SO4][ORG]+[ORG]**2 (EUCAARI project)
4268
4269	zc_h2so4 = pcsa * 1.0E-6_wp ! sulphuric acid conc. to #/cm3
4270	zc_org = pcocnv * 1.0E-6_wp ! conc. of non-volatile OC to #/cm3
4271	CALL binnucl( zc_h2so4, ptemp, prh, zjnuc, znsa, znoc, zdcrit, zksa, &
4272	zkocnv )
4273
4274	CALL SAORGnucl( zc_h2so4, zc_org, zjnuc, zdcrit, znsa, znoc, zksa, &
4275	zkocnv )
4276	END SELECT
4277
4278	zcsa_local = pcsa
4279	zcocnv_local = pcocnv
4280	!
4281	!-- 2) Change of particle and gas concentrations due to nucleation
4282	!
4283	!-- 2.1) Check that there is enough H2SO4 and organic vapour to produce the
4284	!-- nucleation
4285	IF ( nsnucl <= 4 ) THEN
4286	!-- If the chosen nucleation scheme is 1-4, nucleation occurs only due to
4287	!-- H2SO4. All of the total vapour concentration that is taking part to the
4288	!-- nucleation is there for sulphuric acid (sa = H2SO4) and non-volatile
4289	!-- organic vapour is zero.
4290	pxsa = 1.0_wp ! ratio of sulphuric acid in 3nm particles
4291	pxocnv = 0.0_wp ! ratio of non-volatile origanic vapour
4292	! in 3nm particles
4293	ELSEIF ( nsnucl > 4 ) THEN
4294	!-- If the chosen nucleation scheme is 5-9, nucleation occurs due to organic
4295	!-- vapour or the combination of organic vapour and H2SO4. The number of
4296	!-- needed molecules depends on the chosen nucleation type and it has an
4297	!-- effect also on the minimum ratio of the molecules present.
4298	IF ( pcsa * znsa + pcocnv * znoc < 1.E-14_wp ) THEN
4299	pxsa = 0.0_wp
4300	pxocnv = 0.0_wp
4301	ELSE
4302	pxsa = pcsa * znsa / ( pcsa * znsa + pcocnv * znoc )
4303	pxocnv = pcocnv * znoc / ( pcsa * znsa + pcocnv * znoc )
4304	ENDIF
4305	ENDIF
4306	!
4307	!-- The change in total vapour concentration is the sum of the concentrations
4308	!-- of the vapours taking part to the nucleation (depends on the chosen
4309	!-- nucleation scheme)
4310	zdelta_vap = MIN( zjnuc * ( znoc + znsa ), ( pcocnv * zkocnv + pcsa * &
4311	zksa ) / ptstep )
4312	!
4313	!-- Nucleation rate J at ~1nm (#/m3s)
4314	zjnuc = zdelta_vap / ( znoc + znsa )
4315	!
4316	!-- H2SO4 concentration after nucleation in #/m3
4317	zcsa_local = MAX( 1.0_wp, pcsa - zdelta_vap * pxsa )
4318	!
4319	!-- Non-volative organic vapour concentration after nucleation (#/m3)
4320	zcocnv_local = MAX( 1.0_wp, pcocnv - zdelta_vap * pxocnv )
4321	!
4322	!-- 2.2) Formation rate of 3 nm particles (Kerminen & Kulmala, 2002)
4323	!
4324	!-- 2.2.1) Growth rate of clusters formed by H2SO4
4325	!
4326	!-- GR = 3.0e-15 / dens_clus * sum( molecspeed * molarmass * conc )
4327	!
4328	!-- dens_clus = density of the clusters (here 1830 kg/m3)
4329	!-- molarmass = molar mass of condensing species (here 98.08 g/mol)
4330	!-- conc = concentration of condensing species [#/m3]
4331	!-- molecspeed = molecular speed of condensing species [m/s]
4332	!-- = sqrt( 8.0 * R * ptemp / ( pi * molarmass ) )
4333	!-- (Seinfeld & Pandis, 1998)
4334	!
4335	!-- Growth rate by H2SO4 and organic vapour in nm/h (Eq. 21)
4336	zGRclust = 2.3623E-15_wp * SQRT( ptemp ) * ( zcsa_local + zcocnv_local )
4337	!
4338	!-- 2.2.2) Condensational sink of pre-existing particle population
4339	!
4340	!-- Diffusion coefficient (m2/s)
4341	zdfvap = 5.1111E-10_wp * ptemp ** 1.75_wp * ( p_0 + 1325.0_wp ) / ppres
4342	!-- Mean free path of condensing vapour (m) (Jacobson (2005), Eq. 15.25 and
4343	!-- 16.29)
4344	zmfp = 3.0_wp * zdfvap * SQRT( pi * amh2so4 / ( 8.0_wp * argas * ptemp ) )
4345	!-- Knudsen number
4346	zknud = 2.0_wp * zmfp / ( paero(:)%dwet + d_sa )
4347	!-- Transitional regime correction factor (zbeta) according to Fuchs and
4348	!-- Sutugin (1971), In: Hidy et al. (ed.), Topics in current aerosol research,
4349	!-- Pergamon. (Eq. 4 in Kerminen and Kulmala, 2002)
4350	zbeta = ( zknud + 1.0_wp) / ( 0.377_wp * zknud + 1.0_wp + 4.0_wp / &
4351	( 3.0_wp * massacc ) * ( zknud + zknud ** 2 ) )
4352	!-- Condensational sink (#/m2) (Eq. 3)
4353	zcsink = SUM( paero(:)%dwet * zbeta * paero(:)%numc )
4354	!
4355	!-- Parameterised formation rate of detectable 3 nm particles (i.e. J3)
4356	IF ( nj3 == 1 ) THEN ! Kerminen and Kulmala (2002)
4357	!-- 2.2.3) Parameterised formation rate of detectable 3 nm particles
4358	!-- Constants needed for the parameterisation:
4359	!-- dapp = 3 nm and dens_nuc = 1830 kg/m3
4360	IF ( zcsink < 1.0E-30_wp ) THEN
4361	zeta = 0._dp
4362	ELSE
4363	!-- Mean diameter of backgroud population (nm)
4364	zdmean = 1.0_wp / SUM( paero(:)%numc ) * SUM( paero(:)%numc * &
4365	paero(:)%dwet ) * 1.0E+9_wp
4366	!-- Proportionality factor (nm2*m2/h) (Eq. 22)
4367	zgamma = 0.23_wp * ( zdcrit * 1.0E+9_wp ) ** 0.2_wp * ( zdmean / &
4368	150.0_wp ) ** 0.048_wp * ( ptemp / 293.0_wp ) ** ( -0.75_wp ) &
4369	* ( arhoh2so4 / 1000.0_wp ) ** ( -0.33_wp )
4370	!-- Factor eta (nm) (Eq. 11)
4371	zeta = MIN( zgamma * zcsink / zGRclust, zdcrit * 1.0E11_wp )
4372	ENDIF
4373	!
4374	!-- Number conc. of clusters surviving to 3 nm in a time step (#/m3) (Eq.14)
4375	zj3 = zjnuc * EXP( MIN( 0.0_wp, zeta / 3.0_wp - zeta / &
4376	( zdcrit * 1.0E9_wp ) ) )
4377
4378	ELSEIF ( nj3 > 1 ) THEN
4379	!-- Defining the value for zm_para. The growth is investigated between
4380	!-- [d1,reglim(1)] = [zdcrit,3nm]
4381	!-- m = LOG( CoagS_dx / CoagX_zdcrit ) / LOG( reglim / zdcrit )
4382	!-- (Lehtinen et al. 2007, Eq. 5)
4383	!-- The steps for the coagulation sink for reglim = 3nm and zdcrit ~= 1nm are
4384	!-- explained in article of Kulmala et al. (2001). The particles of diameter
4385	!-- zdcrit ~1.14 nm and reglim = 3nm are both in turn the "number 1"
4386	!-- variables (Kulmala et al. 2001).
4387	!-- c = critical (1nm), x = 3nm, 2 = wet or mean droplet
4388	!-- Sum of the radii, R12 = R1 + zR2 (m) of two particles 1 and 2
4389	zRc2 = zdcrit / 2.0_wp + paero(:)%dwet / 2.0_wp
4390	zRx2 = reglim(1) / 2.0_wp + paero(:)%dwet / 2.0_wp
4391	!
4392	!-- The mass of particle (kg) (comes only from H2SO4)
4393	zm_c = 4.0_wp / 3.0_wp * pi * ( zdcrit / 2.0_wp ) ** 3.0_wp * arhoh2so4
4394	zm_x = 4.0_wp / 3.0_wp * pi * ( reglim(1) / 2.0_wp ) ** 3.0_wp * &
4395	arhoh2so4
4396	zm_2 = 4.0_wp / 3.0_wp * pi * ( paero(:)%dwet / 2.0_wp )** 3.0_wp * &
4397	arhoh2so4
4398	!
4399	!-- Mean relative thermal velocity between the particles (m/s)
4400	zcv_c = SQRT( 8.0_wp * abo * ptemp / ( pi * zm_c ) )
4401	zcv_x = SQRT( 8.0_wp * abo * ptemp / ( pi * zm_x ) )
4402	zcv_2 = SQRT( 8.0_wp * abo * ptemp / ( pi * zm_2 ) )
4403	!
4404	!-- Average velocity after coagulation
4405	zcv_c2 = SQRT( zcv_c 2.0_wp + zcv_2 2.0_wp )
4406	zcv_x2 = SQRT( zcv_x 2.0_wp + zcv_2 2.0_wp )
4407	!
4408	!-- Knudsen number (zmfp = mean free path of condensing vapour)
4409	zknud_c = 2.0_wp * zmfp / zdcrit
4410	zknud_x = 2.0_wp * zmfp / reglim(1)
4411	zknud_2 = MAX( 0.0_wp, 2.0_wp * zmfp / paero(:)%dwet )
4412	!
4413	!-- Cunningham correction factor
4414	zCc_c = 1.0_wp + zknud_c * ( 1.142_wp + 0.558_wp * &
4415	EXP( -0.999_wp / zknud_c ) )
4416	zCc_x = 1.0_wp + zknud_x * ( 1.142_wp + 0.558_wp * &
4417	EXP( -0.999_wp / zknud_x ) )
4418	zCc_2 = 1.0_wp + zknud_2 * ( 1.142_wp + 0.558_wp * &
4419	EXP( -0.999_wp / zknud_2 ) )
4420	!
4421	!-- Gas dynamic viscosity (N*s/m2).
4422	!-- Viscocity(air @20C) = 1.81e-5_dp N/m2 *s (Hinds, p. 25)
4423	zmyy = 1.81E-5_wp * ( ptemp / 293.0_wp) ** ( 0.74_wp )
4424	!
4425	!-- Particle diffusion coefficient (m2/s)
4426	zDc_c = abo * ptemp * zCc_c / ( 3.0_wp * pi * zmyy * zdcrit )
4427	zDc_x = abo * ptemp * zCc_x / ( 3.0_wp * pi * zmyy * reglim(1) )
4428	zDc_2 = abo * ptemp * zCc_2 / ( 3.0_wp * pi * zmyy * paero(:)%dwet )
4429	!
4430	!-- D12 = D1+D2 (Seinfield and Pandis, 2nd ed. Eq. 13.38)
4431	zDc_c2 = zDc_c + zDc_2
4432	zDc_x2 = zDc_x + zDc_2
4433	!
4434	!-- zgammaF = 8*D/pi/zcv (m) for calculating zomega
4435	zgammaF_c = 8.0_wp * zDc_c / pi / zcv_c
4436	zgammaF_x = 8.0_wp * zDc_x / pi / zcv_x
4437	zgammaF_2 = 8.0_wp * zDc_2 / pi / zcv_2
4438	!
4439	!-- zomega (m) for calculating zsigma
4440	zomega_c = ( ( zRc2 + zgammaF_c ) 3 - ( zRc2 2 + &
4441	zgammaF_c ) ** ( 3.0_wp / 2.0_wp ) ) / ( 3.0_wp * &
4442	zRc2 * zgammaF_c ) - zRc2
4443	zomega_x = ( ( zRx2 + zgammaF_x ) 3.0_wp - ( zRx2 2.0_wp + &
4444	zgammaF_x ) ** ( 3.0_wp / 2.0_wp ) ) / ( 3.0_wp * &
4445	zRx2 * zgammaF_x ) - zRx2
4446	zomega_2c = ( ( zRc2 + zgammaF_2 ) 3.0_wp - ( zRc2 2.0_wp + &
4447	zgammaF_2 ) ** ( 3.0_wp / 2.0_wp ) ) / ( 3.0_wp * &
4448	zRc2 * zgammaF_2 ) - zRc2
4449	zomega_2x = ( ( zRx2 + zgammaF_2 ) 3.0_wp - ( zRx2 2.0_wp + &
4450	zgammaF_2 ) ** ( 3.0_wp / 2.0_wp ) ) / ( 3.0_wp * &
4451	zRx2 * zgammaF_2 ) - zRx2
4452	!
4453	!-- The distance (m) at which the two fluxes are matched (condensation and
4454	!-- coagulation sinks?)
4455	zsigma_c2 = SQRT( zomega_c 2.0_wp + zomega_2c 2.0_wp )
4456	zsigma_x2 = SQRT( zomega_x 2.0_wp + zomega_2x 2.0_wp )
4457	!
4458	!-- Coagulation coefficient in the continuum regime (m*m2/s)
4459	zK_c2 = 4.0_wp * pi * zRc2 * zDc_c2 / ( zRc2 / ( zRc2 + zsigma_c2 ) + &
4460	4.0_wp * zDc_c2 / ( zcv_c2 * zRc2 ) )
4461	zK_x2 = 4.0_wp * pi * zRx2 * zDc_x2 / ( zRx2 / ( zRx2 + zsigma_x2 ) + &
4462	4.0_wp * zDc_x2 / ( zcv_x2 * zRx2 ) )
4463	!
4464	!-- Coagulation sink (1/s)
4465	zCoagS_c = MAX( 1.0E-20_wp, SUM( zK_c2 * paero(:)%numc ) )
4466	zCoagS_x = MAX( 1.0E-20_wp, SUM( zK_x2 * paero(:)%numc ) )
4467	!
4468	!-- Parameter m for calculating the coagulation sink onto background
4469	!-- particles (Eq. 5&6 in Lehtinen et al. 2007)
4470	zm_para = LOG( zCoagS_x / zCoagS_c ) / LOG( reglim(1) / zdcrit )
4471	!
4472	!-- Parameter gamma for calculating the formation rate J of particles having
4473	!-- a diameter zdcrit < d < reglim(1) (Anttila et al. 2010, eq. 5)
4474	zgamma = ( ( ( reglim(1) / zdcrit ) ** ( zm_para + 1.0_wp ) ) - 1.0_wp )&
4475	/ ( zm_para + 1.0_wp )
4476
4477	IF ( nj3 == 2 ) THEN ! Coagulation sink
4478	!
4479	!-- Formation rate J before iteration (#/m3s)
4480	zj3 = zjnuc * EXP( MIN( 0.0_wp, -zgamma * zdcrit * zCoagS_c / &
4481	( zGRclust * 1.0E-9_wp / ( 60.0_wp ** 2.0_wp ) ) ) )
4482
4483	ELSEIF ( nj3 == 3 ) THEN ! Coagulation sink and self-coag.
4484	!-- IF polluted air... then the self-coagulation becomes important.
4485	!-- Self-coagulation of small particles < 3 nm.
4486	!
4487	!-- "Effective" coagulation coefficient between freshly-nucleated
4488	!-- particles:
4489	zKeff = 5.0E-16_wp ! cm3/s
4490	!
4491	!-- zlambda parameter for "adjusting" the growth rate due to the
4492	!-- self-coagulation
4493	zlambda = 6.0_wp
4494	IF ( reglim(1) >= 10.0E-9_wp ) THEN ! for particles >10 nm:
4495	zKeff = 5.0E-17_wp
4496	zlambda = 3.0_wp
4497	ENDIF
4498	!
4499	!-- Initial values for coagulation sink and growth rate (m/s)
4500	zCoagStot = zCoagS_c
4501	zGRtot = zGRclust * 1.0E-9_wp / 60.0_wp ** 2.0_wp
4502	!
4503	!-- Number of clusters/particles at the size range [d1,dx] (#/m3):
4504	zNnuc = zjnuc / zCoagStot !< Initial guess
4505	!
4506	!-- Coagulation sink and growth rate due to self-coagulation:
4507	DO iteration = 1, 5
4508	zCoagStot = zCoagS_c + zKeff * zNnuc * 1.0E-6_wp ! (1/s)
4509	zGRtot = zGRclust * 1.0E-9_wp / ( 3600.0_wp ) + 1.5708E-6_wp * &
4510	zlambda * zdcrit ** 3.0_wp * ( zNnuc * 1.0E-6_wp ) * &
4511	zcv_c * avo * 1.0E-9_wp / 3600.0_wp
4512	zeta = - zCoagStot / ( ( zm_para + 1.0_wp ) * zGRtot * ( zdcrit **&
4513	zm_para ) ) ! Eq. 7b (Anttila)
4514	zNnuc = zNnuc_tayl( zdcrit, reglim(1), zm_para, zjnuc, zeta, &
4515	zGRtot )
4516	ENDDO
4517	!
4518	!-- Calculate the final values with new zNnuc:
4519	zCoagStot = zCoagS_c + zKeff * zNnuc * 1.0E-6_wp ! (1/s)
4520	zGRtot = zGRclust * 1.0E-9_wp / 3600.0_wp + 1.5708E-6_wp * zlambda &
4521	* zdcrit ** 3.0_wp * ( zNnuc * 1.0E-6_wp ) * zcv_c * avo * &
4522	1.0E-9_wp / 3600.0_wp !< (m/s)
4523	zj3 = zjnuc * EXP( MIN( 0.0_wp, -zgamma * zdcrit * zCoagStot / &
4524	zGRtot ) ) ! (Eq. 5a) (#/m3s)
4525
4526	ENDIF
4527
4528	ENDIF
4529	!-- If J3 very small (< 1 #/cm3), neglect particle formation. In real atmosphere
4530	!-- this would mean that clusters form but coagulate to pre-existing particles
4531	!-- who gain sulphate. Since CoagS ~ CS (4piDCS'), we do not* update H2SO4
4532	!-- concentration here but let condensation take care of it.
4533	!-- Formation mass rate of molecules (molec/m3s) for 1: H2SO4 and 2: organic
4534	!-- vapour
4535	pj3n3(1) = zj3 * n3 * pxsa
4536	pj3n3(2) = zj3 * n3 * pxocnv
4537
4538
4539	END SUBROUTINE nucleation
4540
4541	!------------------------------------------------------------------------------!
4542	! Description:
4543	! ------------
4544	!> Calculate the nucleation rate and the size of critical clusters assuming
4545	!> binary nucleation.
4546	!> Parametrisation according to Vehkamaki et al. (2002), J. Geophys. Res.,
4547	!> 107(D22), 4622. Called from subroutine nucleation.
4548	!------------------------------------------------------------------------------!
4549	SUBROUTINE binnucl( pc_sa, ptemp, prh, pnuc_rate, pn_crit_sa, pn_crit_ocnv, &
4550	pd_crit, pk_sa, pk_ocnv )
4551
4552	IMPLICIT NONE
4553	!
4554	!-- Input and output variables
4555	REAL(wp), INTENT(in) :: pc_sa !< H2SO4 conc. (#/cm3)
4556	REAL(wp), INTENT(in) :: prh !< relative humidity [0-1]
4557	REAL(wp), INTENT(in) :: ptemp !< ambient temperature (K)
4558	REAL(wp), INTENT(out) :: pnuc_rate !< nucleation rate (#/(m3 s))
4559	REAL(wp), INTENT(out) :: pn_crit_sa !< number of H2SO4 molecules in
4560	!< cluster (#)
4561	REAL(wp), INTENT(out) :: pn_crit_ocnv !< number of organic molecules in
4562	!< cluster (#)
4563	REAL(wp), INTENT(out) :: pd_crit !< diameter of critical cluster (m)
4564	REAL(wp), INTENT(out) :: pk_sa !< Lever: if pk_sa = 1, H2SO4 is
4565	!< involved in nucleation.
4566	REAL(wp), INTENT(out) :: pk_ocnv !< Lever: if pk_ocnv = 1, organic
4567	!< compounds are involved in
4568	!< nucleation.
4569	!-- Local variables
4570	REAL(wp) :: zx !< mole fraction of sulphate in critical cluster
4571	REAL(wp) :: zntot !< number of molecules in critical cluster
4572	REAL(wp) :: zt !< temperature
4573	REAL(wp) :: zpcsa !< sulfuric acid concentration
4574	REAL(wp) :: zrh !< relative humidity
4575	REAL(wp) :: zma !<
4576	REAL(wp) :: zmw !<
4577	REAL(wp) :: zxmass!<
4578	REAL(wp) :: za !<
4579	REAL(wp) :: zb !<
4580	REAL(wp) :: zc !<
4581	REAL(wp) :: zroo !<
4582	REAL(wp) :: zm1 !<
4583	REAL(wp) :: zm2 !<
4584	REAL(wp) :: zv1 !<
4585	REAL(wp) :: zv2 !<
4586	REAL(wp) :: zcoll !<
4587
4588	pnuc_rate = 0.0_wp
4589	pd_crit = 1.0E-9_wp
4590
4591	!
4592	!-- 1) Checking that we are in the validity range of the parameterization
4593	zt = MAX( ptemp, 190.15_wp )
4594	zt = MIN( zt, 300.15_wp )
4595	zpcsa = MAX( pc_sa, 1.0E4_wp )
4596	zpcsa = MIN( zpcsa, 1.0E11_wp )
4597	zrh = MAX( prh, 0.0001_wp )
4598	zrh = MIN( zrh, 1.0_wp )
4599	!
4600	!-- 2) Mole fraction of sulphate in a critical cluster (Eq. 11)
4601	zx = 0.7409967177282139_wp &
4602	- 0.002663785665140117_wp * zt &
4603	+ 0.002010478847383187_wp * LOG( zrh ) &
4604	- 0.0001832894131464668_wp* zt * LOG( zrh ) &
4605	+ 0.001574072538464286_wp * LOG( zrh ) ** 2 &
4606	- 0.00001790589121766952_wp * zt * LOG( zrh ) ** 2 &
4607	+ 0.0001844027436573778_wp * LOG( zrh ) ** 3 &
4608	- 1.503452308794887E-6_wp * zt * LOG( zrh ) ** 3 &
4609	- 0.003499978417957668_wp * LOG( zpcsa ) &
4610	+ 0.0000504021689382576_wp * zt * LOG( zpcsa )
4611	!
4612	!-- 3) Nucleation rate (Eq. 12)
4613	pnuc_rate = 0.1430901615568665_wp &
4614	+ 2.219563673425199_wp * zt &
4615	- 0.02739106114964264_wp * zt ** 2 &
4616	+ 0.00007228107239317088_wp * zt ** 3 &
4617	+ 5.91822263375044_wp / zx &
4618	+ 0.1174886643003278_wp * LOG( zrh ) &
4619	+ 0.4625315047693772_wp * zt * LOG( zrh ) &
4620	- 0.01180591129059253_wp * zt ** 2 * LOG( zrh ) &
4621	+ 0.0000404196487152575_wp * zt ** 3 * LOG( zrh ) &
4622	+ ( 15.79628615047088_wp * LOG( zrh ) ) / zx &
4623	- 0.215553951893509_wp * LOG( zrh ) ** 2 &
4624	- 0.0810269192332194_wp * zt * LOG( zrh ) ** 2 &
4625	+ 0.001435808434184642_wp * zt ** 2 * LOG( zrh ) ** 2 &
4626	- 4.775796947178588E-6_wp * zt ** 3 * LOG( zrh ) ** 2 &
4627	- (2.912974063702185_wp * LOG( zrh ) ** 2 ) / zx &
4628	- 3.588557942822751_wp * LOG( zrh ) ** 3 &
4629	+ 0.04950795302831703_wp * zt * LOG( zrh ) ** 3 &
4630	- 0.0002138195118737068_wp * zt ** 2 * LOG( zrh ) ** 3 &
4631	+ 3.108005107949533E-7_wp * zt ** 3 * LOG( zrh ) ** 3 &
4632	- ( 0.02933332747098296_wp * LOG( zrh ) ** 3 ) / zx &
4633	+ 1.145983818561277_wp * LOG( zpcsa ) &
4634	- 0.6007956227856778_wp * zt * LOG( zpcsa ) &
4635	+ 0.00864244733283759_wp * zt ** 2 * LOG( zpcsa ) &
4636	- 0.00002289467254710888_wp * zt ** 3 * LOG( zpcsa ) &
4637	- ( 8.44984513869014_wp * LOG( zpcsa ) ) / zx &
4638	+ 2.158548369286559_wp * LOG( zrh ) * LOG( zpcsa ) &
4639	+ 0.0808121412840917_wp * zt * LOG( zrh ) * LOG( zpcsa ) &
4640	- 0.0004073815255395214_wp * zt ** 2 * LOG( zrh ) * LOG( zpcsa ) &
4641	- 4.019572560156515E-7_wp * zt ** 3 * LOG( zrh ) * LOG( zpcsa ) &
4642	+ ( 0.7213255852557236_wp * LOG( zrh ) * LOG( zpcsa ) ) / zx &
4643	+ 1.62409850488771_wp * LOG( zrh ) ** 2 * LOG( zpcsa ) &
4644	- 0.01601062035325362_wp * zt * LOG( zrh ) ** 2 * LOG( zpcsa ) &
4645	+ 0.00003771238979714162_wpzt2 LOG( zrh )*2 LOG( zpcsa ) &
4646	+ 3.217942606371182E-8_wp * zt*3 LOG( zrh )*2 LOG( zpcsa ) &
4647	- (0.01132550810022116_wp * LOG( zrh )*2 LOG( zpcsa ) ) / zx &
4648	+ 9.71681713056504_wp * LOG( zpcsa ) ** 2 &
4649	- 0.1150478558347306_wp * zt * LOG( zpcsa ) ** 2 &
4650	+ 0.0001570982486038294_wp * zt ** 2 * LOG( zpcsa ) ** 2 &
4651	+ 4.009144680125015E-7_wp * zt ** 3 * LOG( zpcsa ) ** 2 &
4652	+ ( 0.7118597859976135_wp * LOG( zpcsa ) ** 2 ) / zx &
4653	- 1.056105824379897_wp * LOG( zrh ) * LOG( zpcsa ) ** 2 &
4654	+ 0.00903377584628419_wp * zt * LOG( zrh ) * LOG( zpcsa )**2 &
4655	- 0.00001984167387090606_wpzt2LOG( zrh )LOG( zpcsa )*2 &
4656	+ 2.460478196482179E-8_wp * zt*3 LOG( zrh ) * LOG( zpcsa )**2 &
4657	- ( 0.05790872906645181_wp * LOG( zrh ) * LOG( zpcsa )**2 ) / zx &
4658	- 0.1487119673397459_wp * LOG( zpcsa ) ** 3 &
4659	+ 0.002835082097822667_wp * zt * LOG( zpcsa ) ** 3 &
4660	- 9.24618825471694E-6_wp * zt ** 2 * LOG( zpcsa ) ** 3 &
4661	+ 5.004267665960894E-9_wp * zt ** 3 * LOG( zpcsa ) ** 3 &
4662	- ( 0.01270805101481648_wp * LOG( zpcsa ) ** 3 ) / zx
4663	!
4664	!-- Nucleation rate in #/(cm3 s)
4665	pnuc_rate = EXP( pnuc_rate )
4666	!
4667	!-- Check the validity of parameterization
4668	IF ( pnuc_rate < 1.0E-7_wp ) THEN
4669	pnuc_rate = 0.0_wp
4670	pd_crit = 1.0E-9_wp
4671	ENDIF
4672	!
4673	!-- 4) Total number of molecules in the critical cluster (Eq. 13)
4674	zntot = - 0.002954125078716302_wp &
4675	- 0.0976834264241286_wp * zt &
4676	+ 0.001024847927067835_wp * zt ** 2 &
4677	- 2.186459697726116E-6_wp * zt ** 3 &
4678	- 0.1017165718716887_wp / zx &
4679	- 0.002050640345231486_wp * LOG( zrh ) &
4680	- 0.007585041382707174_wp * zt * LOG( zrh ) &
4681	+ 0.0001926539658089536_wp * zt ** 2 * LOG( zrh ) &
4682	- 6.70429719683894E-7_wp * zt ** 3 * LOG( zrh ) &
4683	- ( 0.2557744774673163_wp * LOG( zrh ) ) / zx &
4684	+ 0.003223076552477191_wp * LOG( zrh ) ** 2 &
4685	+ 0.000852636632240633_wp * zt * LOG( zrh ) ** 2 &
4686	- 0.00001547571354871789_wp * zt ** 2 * LOG( zrh ) ** 2 &
4687	+ 5.666608424980593E-8_wp * zt ** 3 * LOG( zrh ) ** 2 &
4688	+ ( 0.03384437400744206_wp * LOG( zrh ) ** 2 ) / zx &
4689	+ 0.04743226764572505_wp * LOG( zrh ) ** 3 &
4690	- 0.0006251042204583412_wp * zt * LOG( zrh ) ** 3 &
4691	+ 2.650663328519478E-6_wp * zt ** 2 * LOG( zrh ) ** 3 &
4692	- 3.674710848763778E-9_wp * zt ** 3 * LOG( zrh ) ** 3 &
4693	- ( 0.0002672510825259393_wp * LOG( zrh ) ** 3 ) / zx &
4694	- 0.01252108546759328_wp * LOG( zpcsa ) &
4695	+ 0.005806550506277202_wp * zt * LOG( zpcsa ) &
4696	- 0.0001016735312443444_wp * zt ** 2 * LOG( zpcsa ) &
4697	+ 2.881946187214505E-7_wp * zt ** 3 * LOG( zpcsa ) &
4698	+ ( 0.0942243379396279_wp * LOG( zpcsa ) ) / zx &
4699	- 0.0385459592773097_wp * LOG( zrh ) * LOG( zpcsa ) &
4700	- 0.0006723156277391984_wp * zt * LOG( zrh ) * LOG( zpcsa ) &
4701	+ 2.602884877659698E-6_wp * zt ** 2 * LOG( zrh ) * LOG( zpcsa ) &
4702	+ 1.194163699688297E-8_wp * zt ** 3 * LOG( zrh ) * LOG( zpcsa ) &
4703	- ( 0.00851515345806281_wp * LOG( zrh ) * LOG( zpcsa ) ) / zx &
4704	- 0.01837488495738111_wp * LOG( zrh ) ** 2 * LOG( zpcsa ) &
4705	+ 0.0001720723574407498_wp * zt * LOG( zrh ) ** 2 * LOG( zpcsa ) &
4706	- 3.717657974086814E-7_wp * zt*2 LOG( zrh )*2 LOG( zpcsa ) &
4707	- 5.148746022615196E-10_wp * zt*3 LOG( zrh )*2 LOG( zpcsa ) &
4708	+ ( 0.0002686602132926594_wp * LOG(zrh)*2 LOG(zpcsa) ) / zx &
4709	- 0.06199739728812199_wp * LOG( zpcsa ) ** 2 &
4710	+ 0.000906958053583576_wp * zt * LOG( zpcsa ) ** 2 &
4711	- 9.11727926129757E-7_wp * zt ** 2 * LOG( zpcsa ) ** 2 &
4712	- 5.367963396508457E-9_wp * zt ** 3 * LOG( zpcsa ) ** 2 &
4713	- ( 0.007742343393937707_wp * LOG( zpcsa ) ** 2 ) / zx &
4714	+ 0.0121827103101659_wp * LOG( zrh ) * LOG( zpcsa ) ** 2 &
4715	- 0.0001066499571188091_wp * zt * LOG( zrh ) * LOG( zpcsa ) ** 2 &
4716	+ 2.534598655067518E-7_wp * zt*2 LOG( zrh ) * LOG( zpcsa )**2 &
4717	- 3.635186504599571E-10_wp * zt*3 LOG( zrh ) * LOG( zpcsa )**2 &
4718	+ ( 0.0006100650851863252_wp * LOG( zrh ) * LOG( zpcsa ) **2 )/ zx &
4719	+ 0.0003201836700403512_wp * LOG( zpcsa ) ** 3 &
4720	- 0.0000174761713262546_wp * zt * LOG( zpcsa ) ** 3 &
4721	+ 6.065037668052182E-8_wp * zt ** 2 * LOG( zpcsa ) ** 3 &
4722	- 1.421771723004557E-11_wp * zt ** 3 * LOG( zpcsa ) ** 3 &
4723	+ ( 0.0001357509859501723_wp * LOG( zpcsa ) ** 3 ) / zx
4724	zntot = EXP( zntot ) ! in #
4725	!
4726	!-- 5) Size of the critical cluster pd_crit (m) (diameter) (Eq. 14)
4727	pn_crit_sa = zx * zntot
4728	pd_crit = 2.0E-9_wp * EXP( -1.6524245_wp + 0.42316402_wp * zx + &
4729	0.33466487_wp * LOG( zntot ) )
4730	!
4731	!-- 6) Organic compounds not involved when binary nucleation is assumed
4732	pn_crit_ocnv = 0.0_wp ! number of organic molecules
4733	pk_sa = 1.0_wp ! if = 1, H2SO4 involved in nucleation
4734	pk_ocnv = 0.0_wp ! if = 1, organic compounds involved
4735	!
4736	!-- Set nucleation rate to collision rate
4737	IF ( pn_crit_sa < 4.0_wp ) THEN
4738	!
4739	!-- Volumes of the colliding objects
4740	zma = 96.0_wp ! molar mass of SO4 in g/mol
4741	zmw = 18.0_wp ! molar mass of water in g/mol
4742	zxmass = 1.0_wp ! mass fraction of H2SO4
4743	za = 0.7681724_wp + zxmass * ( 2.1847140_wp + zxmass * ( &
4744	7.1630022_wp + zxmass * ( -44.31447_wp + zxmass * ( &
4745	88.75606 + zxmass * ( -75.73729_wp + zxmass * &
4746	23.43228_wp ) ) ) ) )
4747	zb = 1.808225E-3_wp + zxmass * ( -9.294656E-3_wp + zxmass * &
4748	( -0.03742148_wp + zxmass * ( 0.2565321_wp + zxmass * &
4749	( -0.5362872_wp + zxmass * ( 0.4857736 - zxmass * &
4750	0.1629592_wp ) ) ) ) )
4751	zc = - 3.478524E-6_wp + zxmass * ( 1.335867E-5_wp + zxmass * &
4752	( 5.195706E-5_wp + zxmass * ( -3.717636E-4_wp + zxmass * &
4753	( 7.990811E-4_wp + zxmass * ( -7.458060E-4_wp + zxmass * &
4754	2.58139E-4_wp ) ) ) ) )
4755	!
4756	!-- Density for the sulphuric acid solution (Eq. 10 in Vehkamaki)
4757	zroo = za + zt * ( zb + zc * zt ) ! g/cm^3
4758	zroo = zroo * 1.0E+3_wp ! kg/m^3
4759	zm1 = 0.098_wp ! molar mass of H2SO4 in kg/mol
4760	zm2 = zm1
4761	zv1 = zm1 / avo / zroo ! volume
4762	zv2 = zv1
4763	!
4764	!-- Collision rate
4765	zcoll = zpcsa * zpcsa * ( 3.0_wp * pi / 4.0_wp ) ** ( 1.0_wp / 6.0_wp )&
4766	* SQRT( 6.0_wp * argas * zt / zm1 + 6.0_wp * argas * zt / zm2 )&
4767	* ( zv1 ( 1.0_wp / 3.0_wp ) + zv2 ( 1.0_wp /3.0_wp ) ) **&
4768	2.0_wp * 1.0E+6_wp ! m3 -> cm3
4769
4770	zcoll = MIN( zcoll, 1.0E+10_wp )
4771	pnuc_rate = zcoll ! (#/(cm3 s))
4772
4773	ELSE
4774	pnuc_rate = MIN( pnuc_rate, 1.0E+10_wp )
4775	ENDIF
4776	pnuc_rate = pnuc_rate * 1.0E+6_wp ! (#/(m3 s))
4777
4778	END SUBROUTINE binnucl
4779
4780	!------------------------------------------------------------------------------!
4781	! Description:
4782	! ------------
4783	!> Calculate the nucleation rate and the size of critical clusters assuming
4784	!> ternary nucleation. Parametrisation according to:
4785	!> Napari et al. (2002), J. Chem. Phys., 116, 4221-4227 and
4786	!> Napari et al. (2002), J. Geophys. Res., 107(D19), AAC 6-1-ACC 6-6.
4787	!> Called from subroutine nucleation.
4788	!------------------------------------------------------------------------------!
4789	SUBROUTINE ternucl( pc_sa, pc_nh3, ptemp, prh, pnuc_rate, pn_crit_sa, &
4790	pn_crit_ocnv, pd_crit, pk_sa, pk_ocnv )
4791
4792	IMPLICIT NONE
4793
4794	!-- Input and output variables
4795	REAL(wp), INTENT(in) :: pc_nh3 !< ammonia mixing ratio (ppt)
4796	REAL(wp), INTENT(in) :: pc_sa !< H2SO4 conc. (#/cm3)
4797	REAL(wp), INTENT(in) :: prh !< relative humidity [0-1]
4798	REAL(wp), INTENT(in) :: ptemp !< ambient temperature (K)
4799	REAL(wp), INTENT(out) :: pd_crit !< diameter of critical
4800	!< cluster (m)
4801	REAL(wp), INTENT(out) :: pk_ocnv !< Lever: if pk_ocnv = 1,organic compounds
4802	!< are involved in nucleation
4803	REAL(wp), INTENT(out) :: pk_sa !< Lever: if pk_sa = 1, H2SO4 is involved
4804	!< in nucleation
4805	REAL(wp), INTENT(out) :: pn_crit_ocnv !< number of organic molecules in
4806	!< cluster (#)
4807	REAL(wp), INTENT(out) :: pn_crit_sa !< number of H2SO4 molecules in
4808	!< cluster (#)
4809	REAL(wp), INTENT(out) :: pnuc_rate !< nucleation rate (#/(m3 s))
4810	!-- Local variables
4811	REAL(wp) :: zlnj !< logarithm of nucleation rate
4812
4813	!-- 1) Checking that we are in the validity range of the parameterization.
4814	!-- Validity of parameterization : DO NOT REMOVE!
4815	IF ( ptemp < 240.0_wp .OR. ptemp > 300.0_wp ) THEN
4816	message_string = 'Invalid input value: ptemp'
4817	CALL message( 'salsa_mod: ternucl', 'SA0045', 1, 2, 0, 6, 0 )
4818	ENDIF
4819	IF ( prh < 0.05_wp .OR. prh > 0.95_wp ) THEN
4820	message_string = 'Invalid input value: prh'
4821	CALL message( 'salsa_mod: ternucl', 'SA0046', 1, 2, 0, 6, 0 )
4822	ENDIF
4823	IF ( pc_sa < 1.0E+4_wp .OR. pc_sa > 1.0E+9_wp ) THEN
4824	message_string = 'Invalid input value: pc_sa'
4825	CALL message( 'salsa_mod: ternucl', 'SA0047', 1, 2, 0, 6, 0 )
4826	ENDIF
4827	IF ( pc_nh3 < 0.1_wp .OR. pc_nh3 > 100.0_wp ) THEN
4828	message_string = 'Invalid input value: pc_nh3'
4829	CALL message( 'salsa_mod: ternucl', 'SA0048', 1, 2, 0, 6, 0 )
4830	ENDIF
4831	!
4832	!-- 2) Nucleation rate (Eq. 7 in Napari et al., 2002: Parameterization of
4833	!-- ternary nucleation of sulfuric acid - ammonia - water.
4834	zlnj = - 84.7551114741543_wp &
4835	+ 0.3117595133628944_wp * prh &
4836	+ 1.640089605712946_wp * prh * ptemp &
4837	- 0.003438516933381083_wp * prh * ptemp ** 2.0_wp &
4838	- 0.00001097530402419113_wp * prh * ptemp ** 3.0_wp &
4839	- 0.3552967070274677_wp / LOG( pc_sa ) &
4840	- ( 0.06651397829765026_wp * prh ) / LOG( pc_sa ) &
4841	- ( 33.84493989762471_wp * ptemp ) / LOG( pc_sa ) &
4842	- ( 7.823815852128623_wp * prh * ptemp ) / LOG( pc_sa) &
4843	+ ( 0.3453602302090915_wp * ptemp ** 2.0_wp ) / LOG( pc_sa ) &
4844	+ ( 0.01229375748100015_wp * prh * ptemp ** 2.0_wp ) / LOG( pc_sa ) &
4845	- ( 0.000824007160514956_wp ptemp * 3.0_wp ) / LOG( pc_sa ) &
4846	+ ( 0.00006185539100670249_wp * prh * ptemp ** 3.0_wp ) &
4847	/ LOG( pc_sa ) &
4848	+ 3.137345238574998_wp * LOG( pc_sa ) &
4849	+ 3.680240980277051_wp * prh * LOG( pc_sa ) &
4850	- 0.7728606202085936_wp * ptemp * LOG( pc_sa ) &
4851	- 0.204098217156962_wp * prh * ptemp * LOG( pc_sa ) &
4852	+ 0.005612037586790018_wp * ptemp ** 2.0_wp * LOG( pc_sa ) &
4853	+ 0.001062588391907444_wp * prh * ptemp ** 2.0_wp * LOG( pc_sa ) &
4854	- 9.74575691760229E-6_wp * ptemp ** 3.0_wp * LOG( pc_sa ) &
4855	- 1.265595265137352E-6_wp * prh * ptemp ** 3.0_wp * LOG( pc_sa ) &
4856	+ 19.03593713032114_wp * LOG( pc_sa ) ** 2.0_wp &
4857	- 0.1709570721236754_wp * ptemp * LOG( pc_sa ) ** 2.0_wp &
4858	+ 0.000479808018162089_wp * ptemp ** 2.0_wp * LOG( pc_sa ) ** 2.0_wp&
4859	- 4.146989369117246E-7_wp * ptemp ** 3.0_wp * LOG( pc_sa ) ** 2.0_wp&
4860	+ 1.076046750412183_wp * LOG( pc_nh3 ) &
4861	+ 0.6587399318567337_wp * prh * LOG( pc_nh3 ) &
4862	+ 1.48932164750748_wp * ptemp * LOG( pc_nh3 ) &
4863	+ 0.1905424394695381_wp * prh * ptemp * LOG( pc_nh3 ) &
4864	- 0.007960522921316015_wp * ptemp ** 2.0_wp * LOG( pc_nh3 ) &
4865	- 0.001657184248661241_wp * prh * ptemp ** 2.0_wp * LOG( pc_nh3 ) &
4866	+ 7.612287245047392E-6_wp * ptemp ** 3.0_wp * LOG( pc_nh3 ) &
4867	+ 3.417436525881869E-6_wp * prh * ptemp ** 3.0_wp * LOG( pc_nh3 ) &
4868	+ ( 0.1655358260404061_wp * LOG( pc_nh3 ) ) / LOG( pc_sa) &
4869	+ ( 0.05301667612522116_wp * prh * LOG( pc_nh3 ) ) / LOG( pc_sa ) &
4870	+ ( 3.26622914116752_wp * ptemp * LOG( pc_nh3 ) ) / LOG( pc_sa ) &
4871	- ( 1.988145079742164_wp * prh * ptemp * LOG( pc_nh3 ) ) &
4872	/ LOG( pc_sa ) &
4873	- ( 0.04897027401984064_wp * ptemp ** 2.0_wp * LOG( pc_nh3) ) &
4874	/ LOG( pc_sa ) &
4875	+ ( 0.01578269253599732_wp * prh * ptemp ** 2.0_wp * LOG( pc_nh3 ) &
4876	) / LOG( pc_sa ) &
4877	+ ( 0.0001469672236351303_wp * ptemp ** 3.0_wp * LOG( pc_nh3 ) ) &
4878	/ LOG( pc_sa ) &
4879	- ( 0.00002935642836387197_wp * prh * ptemp ** 3.0_wp *LOG( pc_nh3 )&
4880	) / LOG( pc_sa ) &
4881	+ 6.526451177887659_wp * LOG( pc_sa ) * LOG( pc_nh3 ) &
4882	- 0.2580021816722099_wp * ptemp * LOG( pc_sa ) * LOG( pc_nh3 ) &
4883	+ 0.001434563104474292_wp * ptemp ** 2.0_wp * LOG( pc_sa ) &
4884	* LOG( pc_nh3 ) &
4885	- 2.020361939304473E-6_wp * ptemp ** 3.0_wp * LOG( pc_sa ) &
4886	* LOG( pc_nh3 ) &
4887	- 0.160335824596627_wp * LOG( pc_sa ) ** 2.0_wp * LOG( pc_nh3 ) &
4888	+ 0.00889880721460806_wp * ptemp * LOG( pc_sa ) ** 2.0_wp &
4889	* LOG( pc_nh3 ) &
4890	- 0.00005395139051155007_wp * ptemp ** 2.0_wp &
4891	* LOG( pc_sa) ** 2.0_wp * LOG( pc_nh3 ) &
4892	+ 8.39521718689596E-8_wp * ptemp ** 3.0_wp * LOG( pc_sa ) ** 2.0_wp&
4893	* LOG( pc_nh3 ) &
4894	+ 6.091597586754857_wp * LOG( pc_nh3 ) ** 2.0_wp &
4895	+ 8.5786763679309_wp * prh * LOG( pc_nh3 ) ** 2.0_wp &
4896	- 1.253783854872055_wp * ptemp * LOG( pc_nh3 ) ** 2.0_wp &
4897	- 0.1123577232346848_wp * prh * ptemp * LOG( pc_nh3 ) ** 2.0_wp &
4898	+ 0.00939835595219825_wp * ptemp ** 2.0_wp * LOG( pc_nh3 ) ** 2.0_wp&
4899	+ 0.0004726256283031513_wp * prh * ptemp ** 2.0_wp &
4900	* LOG( pc_nh3) ** 2.0_wp &
4901	- 0.00001749269360523252_wp * ptemp ** 3.0_wp &
4902	* LOG( pc_nh3 ) ** 2.0_wp &
4903	- 6.483647863710339E-7_wp * prh * ptemp ** 3.0_wp &
4904	* LOG( pc_nh3 ) ** 2.0_wp &
4905	+ ( 0.7284285726576598_wp * LOG( pc_nh3 ) ** 2.0_wp ) / LOG( pc_sa )&
4906	+ ( 3.647355600846383_wp * ptemp * LOG( pc_nh3 ) ** 2.0_wp ) &
4907	/ LOG( pc_sa ) &
4908	- ( 0.02742195276078021_wp * ptemp ** 2.0_wp &
4909	* LOG( pc_nh3) ** 2.0_wp ) / LOG( pc_sa ) &
4910	+ ( 0.00004934777934047135_wp * ptemp ** 3.0_wp &
4911	* LOG( pc_nh3 ) ** 2.0_wp ) / LOG( pc_sa ) &
4912	+ 41.30162491567873_wp * LOG( pc_sa ) * LOG( pc_nh3 ) ** 2.0_wp &
4913	- 0.357520416800604_wp * ptemp * LOG( pc_sa ) &
4914	* LOG( pc_nh3 ) ** 2.0_wp &
4915	+ 0.000904383005178356_wp * ptemp ** 2.0_wp * LOG( pc_sa ) &
4916	* LOG( pc_nh3 ) ** 2.0_wp &
4917	- 5.737876676408978E-7_wp * ptemp ** 3.0_wp * LOG( pc_sa ) &
4918	* LOG( pc_nh3 ) ** 2.0_wp &
4919	- 2.327363918851818_wp * LOG( pc_sa ) ** 2.0_wp &
4920	* LOG( pc_nh3 ) ** 2.0_wp &
4921	+ 0.02346464261919324_wp * ptemp * LOG( pc_sa ) ** 2.0_wp &
4922	* LOG( pc_nh3 ) ** 2.0_wp &
4923	- 0.000076518969516405_wp * ptemp ** 2.0_wp &
4924	* LOG( pc_sa ) ** 2.0_wp * LOG( pc_nh3 ) ** 2.0_wp &
4925	+ 8.04589834836395E-8_wp * ptemp ** 3.0_wp * LOG( pc_sa ) ** 2.0_wp &
4926	* LOG( pc_nh3 ) ** 2.0_wp &
4927	- 0.02007379204248076_wp * LOG( prh ) &
4928	- 0.7521152446208771_wp * ptemp * LOG( prh ) &
4929	+ 0.005258130151226247_wp * ptemp ** 2.0_wp * LOG( prh ) &
4930	- 8.98037634284419E-6_wp * ptemp ** 3.0_wp * LOG( prh ) &
4931	+ ( 0.05993213079516759_wp * LOG( prh ) ) / LOG( pc_sa ) &
4932	+ ( 5.964746463184173_wp * ptemp * LOG( prh ) ) / LOG( pc_sa ) &
4933	- ( 0.03624322255690942_wp * ptemp ** 2.0_wp * LOG( prh ) ) &
4934	/ LOG( pc_sa ) &
4935	+ ( 0.00004933369382462509_wp * ptemp ** 3.0_wp * LOG( prh ) ) &
4936	/ LOG( pc_sa ) &
4937	- 0.7327310805365114_wp * LOG( pc_nh3 ) * LOG( prh ) &
4938	- 0.01841792282958795_wp * ptemp * LOG( pc_nh3 ) * LOG( prh ) &
4939	+ 0.0001471855981005184_wp * ptemp ** 2.0_wp * LOG( pc_nh3 ) &
4940	* LOG( prh ) &
4941	- 2.377113195631848E-7_wp * ptemp ** 3.0_wp * LOG( pc_nh3 ) &
4942	* LOG( prh )
4943	pnuc_rate = EXP( zlnj ) ! (#/(cm3 s))
4944	!
4945	!-- Check validity of parametrization
4946	IF ( pnuc_rate < 1.0E-5_wp ) THEN
4947	pnuc_rate = 0.0_wp
4948	pd_crit = 1.0E-9_wp
4949	ELSEIF ( pnuc_rate > 1.0E6_wp ) THEN
4950	message_string = 'Invalid output value: nucleation rate > 10^6 1/cm3s'
4951	CALL message( 'salsa_mod: ternucl', 'SA0049', 1, 2, 0, 6, 0 )
4952	ENDIF
4953	pnuc_rate = pnuc_rate * 1.0E6_wp ! (#/(m3 s))
4954	!
4955	!-- 3) Number of H2SO4 molecules in a critical cluster (Eq. 9)
4956	pn_crit_sa = 38.16448247950508_wp + 0.7741058259731187_wp * zlnj + &
4957	0.002988789927230632_wp * zlnj ** 2.0_wp - &
4958	0.3576046920535017_wp * ptemp - &
4959	0.003663583011953248_wp * zlnj * ptemp + &
4960	0.000855300153372776_wp * ptemp ** 2.0_wp
4961	!-- Kinetic limit: at least 2 H2SO4 molecules in a cluster
4962	pn_crit_sa = MAX( pn_crit_sa, 2.0E0_wp )
4963	!
4964	!-- 4) Size of the critical cluster in nm (Eq. 12)
4965	pd_crit = 0.1410271086638381_wp - 0.001226253898894878_wp * zlnj - &
4966	7.822111731550752E-6_wp * zlnj ** 2.0_wp - &
4967	0.001567273351921166_wp * ptemp - &
4968	0.00003075996088273962_wp * zlnj * ptemp + &
4969	0.00001083754117202233_wp * ptemp ** 2.0_wp
4970	pd_crit = pd_crit * 2.0E-9_wp ! Diameter in m
4971	!
4972	!-- 5) Organic compounds not involved when ternary nucleation assumed
4973	pn_crit_ocnv = 0.0_wp
4974	pk_sa = 1.0_wp
4975	pk_ocnv = 0.0_wp
4976
4977	END SUBROUTINE ternucl
4978
4979	!------------------------------------------------------------------------------!
4980	! Description:
4981	! ------------
4982	!> Calculate the nucleation rate and the size of critical clusters assuming
4983	!> kinetic nucleation. Each sulphuric acid molecule forms an (NH4)HSO4 molecule
4984	!> in the atmosphere and two colliding (NH4)HSO4 molecules form a stable
4985	!> cluster. See Sihto et al. (2006), Atmos. Chem. Phys., 6(12), 4079-4091.
4986	!>
4987	!> Below the following assumption have been made:
4988	!> nucrate = coagcoeffzpcsa*2
4989	!> coagcoeff = 8sqrt(3boltzptempr_abs/dens_abs)
4990	!> r_abs = 0.315d-9 radius of bisulphate molecule [m]
4991	!> dens_abs = 1465 density of - " - [kg/m3]
4992	!------------------------------------------------------------------------------!
4993	SUBROUTINE kinnucl( pc_sa, pnuc_rate, pd_crit, pn_crit_sa, pn_crit_ocnv, &
4994	pk_sa, pk_ocnv )
4995
4996	IMPLICIT NONE
4997
4998	!-- Input and output variables
4999	REAL(wp), INTENT(in) :: pc_sa !< H2SO4 conc. (#/m3)
5000	REAL(wp), INTENT(out) :: pd_crit !< critical diameter of clusters (m)
5001	REAL(wp), INTENT(out) :: pk_ocnv !< Lever: if pk_ocnv = 1, organic
5002	!< compounds are involved in nucleation
5003	REAL(wp), INTENT(out) :: pk_sa !< Lever: if pk_sa = 1, H2SO4 is involved
5004	!< in nucleation
5005	REAL(wp), INTENT(out) :: pn_crit_ocnv !< number of organic molecules in
5006	!< cluster (#)
5007	REAL(wp), INTENT(out) :: pn_crit_sa !< number of H2SO4 molecules in
5008	!< cluster (#)
5009	REAL(wp), INTENT(out) :: pnuc_rate !< nucl. rate (#/(m3 s))
5010
5011	!-- Nucleation rate (#/(m3 s))
5012	pnuc_rate = 5.0E-13_wp * pc_sa ** 2.0_wp * 1.0E+6_wp
5013	!-- Organic compounds not involved when kinetic nucleation is assumed.
5014	pn_crit_sa = 2.0_wp
5015	pn_crit_ocnv = 0.0_wp
5016	pk_sa = 1.0_wp
5017	pk_ocnv = 0.0_wp
5018	pd_crit = 7.9375E-10_wp ! (m)
5019
5020	END SUBROUTINE kinnucl
5021	!------------------------------------------------------------------------------!
5022	! Description:
5023	! ------------
5024	!> Calculate the nucleation rate and the size of critical clusters assuming
5025	!> activation type nucleation.
5026	!> See Riipinen et al. (2007), Atmos. Chem. Phys., 7(8), 1899-1914.
5027	!------------------------------------------------------------------------------!
5028	SUBROUTINE actnucl( psa_conc, pnuc_rate, pd_crit, pn_crit_sa, pn_crit_ocnv, &
5029	pk_sa, pk_ocnv, activ )
5030
5031	IMPLICIT NONE
5032
5033	!-- Input and output variables
5034	REAL(wp), INTENT(in) :: psa_conc !< H2SO4 conc. (#/m3)
5035	REAL(wp), INTENT(in) :: activ !<
5036	REAL(wp), INTENT(out) :: pd_crit !< critical diameter of clusters (m)
5037	REAL(wp), INTENT(out) :: pk_ocnv !< Lever: if pk_ocnv = 1, organic
5038	!< compounds are involved in nucleation
5039	REAL(wp), INTENT(out) :: pk_sa !< Lever: if pk_sa = 1, H2SO4 is involved
5040	!< in nucleation
5041	REAL(wp), INTENT(out) :: pn_crit_ocnv !< number of organic molecules in
5042	!< cluster (#)
5043	REAL(wp), INTENT(out) :: pn_crit_sa !< number of H2SO4 molecules in
5044	!< cluster (#)
5045	REAL(wp), INTENT(out) :: pnuc_rate !< nucl. rate (#/(m3 s))
5046
5047	!-- act_coeff 1e-7 by default
5048	pnuc_rate = activ * psa_conc ! (#/(m3 s))
5049	!-- Organic compounds not involved when kinetic nucleation is assumed.
5050	pn_crit_sa = 2.0_wp
5051	pn_crit_ocnv = 0.0_wp
5052	pk_sa = 1.0_wp
5053	pk_ocnv = 0.0_wp
5054	pd_crit = 7.9375E-10_wp ! (m)
5055	END SUBROUTINE actnucl
5056	!------------------------------------------------------------------------------!
5057	! Description:
5058	! ------------
5059	!> Conciders only the organic matter in nucleation. Paasonen et al. (2010)
5060	!> determined particle formation rates for 2 nm particles, J2, from different
5061	!> kind of combinations of sulphuric acid and organic matter concentration.
5062	!> See Paasonen et al. (2010), Atmos. Chem. Phys., 10, 11223-11242.
5063	!------------------------------------------------------------------------------!
5064	SUBROUTINE orgnucl( pc_org, pnuc_rate, pd_crit, pn_crit_sa, pn_crit_ocnv, &
5065	pk_sa, pk_ocnv )
5066
5067	IMPLICIT NONE
5068
5069	!-- Input and output variables
5070	REAL(wp), INTENT(in) :: pc_org !< organic vapour concentration (#/m3)
5071	REAL(wp), INTENT(out) :: pd_crit !< critical diameter of clusters (m)
5072	REAL(wp), INTENT(out) :: pk_ocnv !< Lever: if pk_ocnv = 1, organic
5073	!< compounds are involved in nucleation
5074	REAL(wp), INTENT(out) :: pk_sa !< Lever: if pk_sa = 1, H2SO4 is involved
5075	!< in nucleation
5076	REAL(wp), INTENT(out) :: pn_crit_ocnv !< number of organic molecules in
5077	!< cluster (#)
5078	REAL(wp), INTENT(out) :: pn_crit_sa !< number of H2SO4 molecules in
5079	!< cluster (#)
5080	REAL(wp), INTENT(out) :: pnuc_rate !< nucl. rate (#/(m3 s))
5081	!-- Local variables
5082	REAL(wp) :: Aorg = 1.3E-7_wp !< (1/s) (Paasonen et al. Table 4: median)
5083
5084	!-- Homomolecular nuleation - which one?
5085	pnuc_rate = Aorg * pc_org
5086	!-- H2SO4 not involved when pure organic nucleation is assumed.
5087	pn_crit_sa = 0.0_wp
5088	pn_crit_ocnv = 1.0_wp
5089	pk_sa = 0.0_wp
5090	pk_ocnv = 1.0_wp
5091	pd_crit = 1.5E-9_wp ! (m)
5092
5093	END SUBROUTINE orgnucl
5094	!------------------------------------------------------------------------------!
5095	! Description:
5096	! ------------
5097	!> Conciders both the organic vapor and H2SO4 in nucleation - activation type
5098	!> of nucleation.
5099	!> See Paasonen et al. (2010), Atmos. Chem. Phys., 10, 11223-11242.
5100	!------------------------------------------------------------------------------!
5101	SUBROUTINE sumnucl( pc_sa, pc_org, pnuc_rate, pd_crit, pn_crit_sa, &
5102	pn_crit_ocnv, pk_sa, pk_ocnv )
5103
5104	IMPLICIT NONE
5105
5106	!-- Input and output variables
5107	REAL(wp), INTENT(in) :: pc_org !< organic vapour concentration (#/m3)
5108	REAL(wp), INTENT(in) :: pc_sa !< H2SO4 conc. (#/m3)
5109	REAL(wp), INTENT(out) :: pd_crit !< critical diameter of clusters (m)
5110	REAL(wp), INTENT(out) :: pk_ocnv !< Lever: if pk_ocnv = 1, organic
5111	!< compounds are involved in nucleation
5112	REAL(wp), INTENT(out) :: pk_sa !< Lever: if pk_sa = 1, H2SO4 is involved
5113	!< in nucleation
5114	REAL(wp), INTENT(out) :: pn_crit_ocnv !< number of organic molecules in
5115	!< cluster (#)
5116	REAL(wp), INTENT(out) :: pn_crit_sa !< number of H2SO4 molecules in
5117	!< cluster (#)
5118	REAL(wp), INTENT(out) :: pnuc_rate !< nucl. rate (#/(m3 s))
5119	!-- Local variables
5120	REAL(wp) :: As1 = 6.1E-7_wp !< (1/s)
5121	REAL(wp) :: As2 = 0.39E-7_wp !< (1/s) (Paasonen et al. Table 3.)
5122
5123	!-- Nucleation rate (#/m3/s)
5124	pnuc_rate = As1 * pc_sa + As2 * pc_org
5125	!-- Both Organic compounds and H2SO4 are involved when SUMnucleation is assumed.
5126	pn_crit_sa = 1.0_wp
5127	pn_crit_ocnv = 1.0_wp
5128	pk_sa = 1.0_wp
5129	pk_ocnv = 1.0_wp
5130	pd_crit = 1.5E-9_wp ! (m)
5131
5132	END SUBROUTINE sumnucl
5133	!------------------------------------------------------------------------------!
5134	! Description:
5135	! ------------
5136	!> Conciders both the organic vapor and H2SO4 in nucleation - heteromolecular
5137	!> nucleation.
5138	!> See Paasonen et al. (2010), Atmos. Chem. Phys., 10, 11223-11242.
5139	!------------------------------------------------------------------------------!
5140	SUBROUTINE hetnucl( pc_sa, pc_org, pnuc_rate, pd_crit, pn_crit_sa, &
5141	pn_crit_ocnv, pk_sa, pk_ocnv )
5142
5143	IMPLICIT NONE
5144
5145	!-- Input and output variables
5146	REAL(wp), INTENT(in) :: pc_org !< organic vapour concentration (#/m3)
5147	REAL(wp), INTENT(in) :: pc_sa !< H2SO4 conc. (#/m3)
5148	REAL(wp), INTENT(out) :: pd_crit !< critical diameter of clusters (m)
5149	REAL(wp), INTENT(out) :: pk_ocnv !< Lever: if pk_ocnv = 1, organic
5150	!< compounds are involved in nucleation
5151	REAL(wp), INTENT(out) :: pk_sa !< Lever: if pk_sa = 1, H2SO4 is involved
5152	!< in nucleation
5153	REAL(wp), INTENT(out) :: pn_crit_ocnv !< number of organic molecules in
5154	!< cluster (#)
5155	REAL(wp), INTENT(out) :: pn_crit_sa !< number of H2SO4 molecules in
5156	!< cluster (#)
5157	REAL(wp), INTENT(out) :: pnuc_rate !< nucl. rate (#/(m3 s))
5158	!-- Local variables
5159	REAL(wp) :: zKhet = 4.1E-14_wp !< (cm3/s) (Paasonen et al. Table 4: median)
5160
5161	!-- Nucleation rate (#/m3/s)
5162	pnuc_rate = zKhet * pc_sa * pc_org * 1.0E6_wp
5163	!-- Both Organic compounds and H2SO4 are involved when heteromolecular
5164	!-- nucleation is assumed.
5165	pn_crit_sa = 1.0_wp
5166	pn_crit_ocnv = 1.0_wp
5167	pk_sa = 1.0_wp
5168	pk_ocnv = 1.0_wp
5169	pd_crit = 1.5E-9_wp ! (m)
5170
5171	END SUBROUTINE hetnucl
5172	!------------------------------------------------------------------------------!
5173	! Description:
5174	! ------------
5175	!> Takes into account the homomolecular nucleation of sulphuric acid H2SO4 with
5176	!> both of the available vapours.
5177	!> See Paasonen et al. (2010), Atmos. Chem. Phys., 10, 11223-11242.
5178	!------------------------------------------------------------------------------!
5179	SUBROUTINE SAnucl( pc_sa, pc_org, pnuc_rate, pd_crit, pn_crit_sa, &
5180	pn_crit_ocnv, pk_sa, pk_ocnv )
5181
5182	IMPLICIT NONE
5183
5184	!-- Input and output variables
5185	REAL(wp), INTENT(in) :: pc_org !< organic vapour concentration (#/m3)
5186	REAL(wp), INTENT(in) :: pc_sa !< H2SO4 conc. (#/m3)
5187	REAL(wp), INTENT(out) :: pd_crit !< critical diameter of clusters (m)
5188	REAL(wp), INTENT(out) :: pk_ocnv !< Lever: if pk_ocnv = 1, organic
5189	!< compounds are involved in nucleation
5190	REAL(wp), INTENT(out) :: pk_sa !< Lever: if pk_sa = 1, H2SO4 is involved
5191	!< in nucleation
5192	REAL(wp), INTENT(out) :: pn_crit_ocnv !< number of organic molecules in
5193	!< cluster (#)
5194	REAL(wp), INTENT(out) :: pn_crit_sa !< number of H2SO4 molecules in
5195	!< cluster (#)
5196	REAL(wp), INTENT(out) :: pnuc_rate !< nucleation rate (#/(m3 s))
5197	!-- Local variables
5198	REAL(wp) :: zKsa1 = 1.1E-14_wp !< (cm3/s)
5199	REAL(wp) :: zKsa2 = 3.2E-14_wp !< (cm3/s) (Paasonen et al. Table 3.)
5200
5201	!-- Nucleation rate (#/m3/s)
5202	pnuc_rate = ( zKsa1 * pc_sa ** 2.0_wp + zKsa2 * pc_sa * pc_org ) * 1.0E+6_wp
5203	!-- Both Organic compounds and H2SO4 are involved when SAnucleation is assumed.
5204	pn_crit_sa = 3.0_wp
5205	pn_crit_ocnv = 1.0_wp
5206	pk_sa = 1.0_wp
5207	pk_ocnv = 1.0_wp
5208	pd_crit = 1.5E-9_wp ! (m)
5209
5210	END SUBROUTINE SAnucl
5211	!------------------------------------------------------------------------------!
5212	! Description:
5213	! ------------
5214	!> Takes into account the homomolecular nucleation of both sulphuric acid and
5215	!> Lorganic with heteromolecular nucleation.
5216	!> See Paasonen et al. (2010), Atmos. Chem. Phys., 10, 11223-11242.
5217	!------------------------------------------------------------------------------!
5218	SUBROUTINE SAORGnucl( pc_sa, pc_org, pnuc_rate, pd_crit, pn_crit_sa, &
5219	pn_crit_ocnv, pk_sa, pk_ocnv )
5220
5221	IMPLICIT NONE
5222
5223	!-- Input and output variables
5224	REAL(wp), INTENT(in) :: pc_org !< organic vapour concentration (#/m3)
5225	REAL(wp), INTENT(in) :: pc_sa !< H2SO4 conc. (#/m3)
5226	REAL(wp), INTENT(out) :: pd_crit !< critical diameter of clusters (m)
5227	REAL(wp), INTENT(out) :: pk_ocnv !< Lever: if pk_ocnv = 1, organic
5228	!< compounds are involved in nucleation
5229	REAL(wp), INTENT(out) :: pk_sa !< Lever: if pk_sa = 1, H2SO4 is involved
5230	!< in nucleation
5231	REAL(wp), INTENT(out) :: pn_crit_ocnv !< number of organic molecules in
5232	!< cluster (#)
5233	REAL(wp), INTENT(out) :: pn_crit_sa !< number of H2SO4 molecules in
5234	!< cluster (#)
5235	REAL(wp), INTENT(out) :: pnuc_rate !< nucl. rate (#/(m3 s))
5236	!-- Local variables
5237	REAL(wp) :: zKs1 = 1.4E-14_wp !< (cm3/s])
5238	REAL(wp) :: zKs2 = 2.6E-14_wp !< (cm3/s])
5239	REAL(wp) :: zKs3 = 0.037E-14_wp !< (cm3/s]) (Paasonen et al. Table 3.)
5240
5241	!-- Nucleation rate (#/m3/s)
5242	pnuc_rate = ( zKs1 * pc_sa *2 + zKs2 pc_sa * pc_org + zKs3 * &
5243	pc_org ** 2.0_wp ) * 1.0E+6_wp
5244	!-- Organic compounds not involved when kinetic nucleation is assumed.
5245	pn_crit_sa = 3.0_wp
5246	pn_crit_ocnv = 3.0_wp
5247	pk_sa = 1.0_wp
5248	pk_ocnv = 1.0_wp
5249	pd_crit = 1.5E-9_wp ! (m)
5250
5251	END SUBROUTINE SAORGnucl
5252
5253	!------------------------------------------------------------------------------!
5254	! Description:
5255	! ------------
5256	!> Function zNnuc_tayl is connected to the calculation of self-coagualtion of
5257	!> small particles. It calculates number of the particles in the size range
5258	!> [zdcrit,dx] using Taylor-expansion (please note that the expansion is not
5259	!> valid for certain rational numbers, e.g. -4/3 and -3/2)
5260	!------------------------------------------------------------------------------!
5261	FUNCTION zNnuc_tayl( d1, dx, zm_para, zjnuc_t, zeta, zGRtot )
5262	IMPLICIT NONE
5263
5264	INTEGER(iwp) :: i
5265	REAL(wp) :: d1
5266	REAL(wp) :: dx
5267	REAL(wp) :: zjnuc_t
5268	REAL(wp) :: zeta
5269	REAL(wp) :: term1
5270	REAL(wp) :: term2
5271	REAL(wp) :: term3
5272	REAL(wp) :: term4
5273	REAL(wp) :: term5
5274	REAL(wp) :: zNnuc_tayl
5275	REAL(wp) :: zGRtot
5276	REAL(wp) :: zm_para
5277
5278	zNnuc_tayl = 0.0_wp
5279
5280	DO i = 0, 29
5281	IF ( i == 0 .OR. i == 1 ) THEN
5282	term1 = 1.0_wp
5283	ELSE
5284	term1 = term1 * REAL( i, SELECTED_REAL_KIND(12,307) )
5285	END IF
5286	term2 = ( REAL( i, SELECTED_REAL_KIND(12,307) ) * ( zm_para + 1.0_wp &
5287	) + 1.0_wp ) * term1
5288	term3 = zeta ** i
5289	term4 = term3 / term2
5290	term5 = REAL( i, SELECTED_REAL_KIND(12,307) ) * ( zm_para + 1.0_wp ) &
5291	+ 1.0_wp
5292	zNnuc_tayl = zNnuc_tayl + term4 * ( dx term5 - d1 term5 )
5293	ENDDO
5294	zNnuc_tayl = zNnuc_tayl * zjnuc_t * EXP( -zeta * &
5295	( d1 ** ( zm_para + 1 ) ) ) / zGRtot
5296
5297	END FUNCTION zNnuc_tayl
5298
5299	!------------------------------------------------------------------------------!
5300	! Description:
5301	! ------------
5302	!> Calculates the condensation of water vapour on aerosol particles. Follows the
5303	!> analytical predictor method by Jacobson (2005).
5304	!> For equations, see Jacobson (2005), Fundamentals of atmospheric modelling
5305	!> (2nd edition).
5306	!------------------------------------------------------------------------------!
5307	SUBROUTINE gpparth2o( paero, ptemp, ppres, pcs, pcw, ptstep )
5308
5309	IMPLICIT NONE
5310	!
5311	!-- Input and output variables
5312	REAL(wp), INTENT(in) :: ppres !< Air pressure (Pa)
5313	REAL(wp), INTENT(in) :: pcs !< Water vapour saturation
5314	!< concentration (kg/m3)
5315	REAL(wp), INTENT(in) :: ptemp !< Ambient temperature (K)
5316	REAL(wp), INTENT(in) :: ptstep !< timestep (s)
5317	REAL(wp), INTENT(inout) :: pcw !< Water vapour concentration
5318	!< (kg/m3)
5319	TYPE(t_section), INTENT(inout) :: paero(nbins) !< Aerosol properties
5320	!-- Local variables
5321	INTEGER(iwp) :: b !< loop index
5322	INTEGER(iwp) :: nstr
5323	REAL(wp) :: adt !< internal timestep in this subroutine
5324	REAL(wp) :: adtc(nbins)
5325	REAL(wp) :: rhoair
5326	REAL(wp) :: ttot
5327	REAL(wp) :: zact !< Water activity
5328	REAL(wp) :: zaelwc1 !< Current aerosol water content
5329	REAL(wp) :: zaelwc2 !< New aerosol water content after
5330	!< equilibrium calculation
5331	REAL(wp) :: zbeta !< Transitional correction factor
5332	REAL(wp) :: zcwc !< Current water vapour mole concentration
5333	REAL(wp) :: zcwcae(nbins) !< Current water mole concentrations
5334	!< in aerosols
5335	REAL(wp) :: zcwint !< Current and new water vapour mole concentrations
5336	REAL(wp) :: zcwintae(nbins) !< Current and new water mole concentrations
5337	!< in aerosols
5338	REAL(wp) :: zcwn !< New water vapour mole concentration
5339	REAL(wp) :: zcwnae(nbins) !< New water mole concentration in aerosols
5340	REAL(wp) :: zcwsurfae(nbins) !< Surface mole concentration
5341	REAL(wp) :: zcwtot !< Total water mole concentration
5342	REAL(wp) :: zdfh2o
5343	REAL(wp) :: zhlp1
5344	REAL(wp) :: zhlp2
5345	REAL(wp) :: zhlp3
5346	REAL(wp) :: zka(nbins) !< Activity coefficient
5347	REAL(wp) :: zkelvin(nbins) !< Kelvin effect
5348	REAL(wp) :: zknud
5349	REAL(wp) :: zmfph2o !< mean free path of H2O gas molecule
5350	REAL(wp) :: zmtae(nbins) !< Mass transfer coefficients
5351	REAL(wp) :: zrh !< Relative humidity [0-1]
5352	REAL(wp) :: zthcond
5353	REAL(wp) :: zwsatae(nbins) !< Water saturation ratio above aerosols
5354	!
5355	!-- Relative humidity [0-1]
5356	zrh = pcw / pcs
5357	!-- Calculate the condensation only for 2a/2b aerosol bins
5358	nstr = in2a
5359	!-- Save the current aerosol water content, 8 in paero is H2O
5360	zaelwc1 = SUM( paero(in1a:fn2b)%volc(8) ) * arhoh2o
5361	!
5362	!-- Equilibration:
5363	IF ( advect_particle_water ) THEN
5364	IF ( zrh < 0.98_wp .OR. .NOT. lscndh2oae ) THEN
5365	CALL equilibration( zrh, ptemp, paero, .TRUE. )
5366	ELSE
5367	CALL equilibration( zrh, ptemp, paero, .FALSE. )
5368	ENDIF
5369	ENDIF
5370	!
5371	!-- The new aerosol water content after equilibrium calculation
5372	zaelwc2 = SUM( paero(in1a:fn2b)%volc(8) ) * arhoh2o
5373	!-- New water vapour mixing ratio (kg/m3)
5374	pcw = pcw - ( zaelwc2 - zaelwc1 ) * ppres * amdair / ( argas * ptemp )
5375	!
5376	!-- Initialise variables
5377	adtc(:) = 0.0_wp
5378	zcwc = 0.0_wp
5379	zcwcae = 0.0_wp
5380	zcwint = 0.0_wp
5381	zcwintae = 0.0_wp
5382	zcwn = 0.0_wp
5383	zcwnae = 0.0_wp
5384	zhlp1 = 0.0_wp
5385	zwsatae = 0.0_wp
5386	!
5387	!-- Air:
5388	!-- Density (kg/m3)
5389	rhoair = amdair * ppres / ( argas * ptemp )
5390	!-- Thermal conductivity of air
5391	zthcond = 0.023807_wp + 7.1128E-5_wp * ( ptemp - 273.16_wp )
5392	!
5393	!-- Water vapour:
5394	!
5395	!-- Molecular diffusion coefficient (cm2/s) (eq.16.17)
5396	zdfh2o = ( 5.0_wp / ( 16.0_wp * avo * rhoair * 1.0E-3_wp * &
5397	( 3.11E-8_wp ) ** 2.0_wp ) ) * SQRT( argas * 1.0E+7_wp * ptemp * &
5398	amdair * 1.0E+3_wp * ( amh2o + amdair ) * 1.0E+3_wp / ( 2.0_wp * &
5399	pi * amh2o * 1.0E+3_wp ) )
5400	zdfh2o = zdfh2o * 1.0E-4 ! Unit change to m^2/s
5401	!
5402	!-- Mean free path (eq. 15.25 & 16.29)
5403	zmfph2o = 3.0_wp * zdfh2o * SQRT( pi * amh2o / ( 8.0_wp * argas * ptemp ) )
5404	zka = 1.0_wp ! Assume activity coefficients as 1 for now.
5405	!
5406	!-- Kelvin effect (eq. 16.33)
5407	zkelvin = 1.0_wp
5408	zkelvin(1:nbins) = EXP( 4.0_wp * surfw0 * amh2o / ( argas * ptemp * &
5409	arhoh2o * paero(1:nbins)%dwet) )
5410	!
5411	! --Aerosols:
5412	zmtae(:) = 0.0_wp ! mass transfer coefficient
5413	zcwsurfae(:) = 0.0_wp ! surface mole concentrations
5414	DO b = 1, nbins
5415	IF ( paero(b)%numc > nclim .AND. zrh > 0.98_wp ) THEN
5416	!
5417	!-- Water activity
5418	zact = acth2o( paero(b) )
5419	!
5420	!-- Saturation mole concentration over flat surface. Limit the super-
5421	!-- saturation to max 1.01 for the mass transfer. Experimental!
5422	zcwsurfae(b) = MAX( pcs, pcw / 1.01_wp ) * rhoair / amh2o
5423	!
5424	!-- Equilibrium saturation ratio
5425	zwsatae(b) = zact * zkelvin(b)
5426	!
5427	!-- Knudsen number (eq. 16.20)
5428	zknud = 2.0_wp * zmfph2o / paero(b)%dwet
5429	!
5430	!-- Transitional correction factor (Fuks & Sutugin, 1971)
5431	zbeta = ( zknud + 1.0_wp ) / ( 0.377_wp * zknud + 1.0_wp + 4.0_wp / &
5432	( 3.0_wp * massacc(b) ) * ( zknud + zknud ** 2.0_wp ) )
5433	!
5434	!-- Mass transfer of H2O: Eq. 16.64 but here D^eff = zdfh2o * zbeta
5435	zhlp1 = paero(b)%numc * 2.0_wp * pi * paero(b)%dwet * zdfh2o * &
5436	zbeta
5437	!-- 1st term on the left side of the denominator in eq. 16.55
5438	zhlp2 = amh2o * zdfh2o * alv * zwsatae(b) * zcwsurfae(b) / &
5439	( zthcond * ptemp )
5440	!-- 2nd term on the left side of the denominator in eq. 16.55
5441	zhlp3 = ( (alv * amh2o ) / ( argas * ptemp ) ) - 1.0_wp
5442	!-- Full eq. 16.64: Mass transfer coefficient (1/s)
5443	zmtae(b) = zhlp1 / ( zhlp2 * zhlp3 + 1.0_wp )
5444	ENDIF
5445	ENDDO
5446	!
5447	!-- Current mole concentrations of water
5448	zcwc = pcw * rhoair / amh2o ! as vapour
5449	zcwcae(1:nbins) = paero(1:nbins)%volc(8) * arhoh2o / amh2o ! in aerosols
5450	zcwtot = zcwc + SUM( zcwcae ) ! total water concentration
5451	ttot = 0.0_wp
5452	adtc = 0.0_wp
5453	zcwintae = zcwcae
5454	!
5455	!-- Substepping loop
5456	zcwint = 0.0_wp
5457	DO WHILE ( ttot < ptstep )
5458	adt = 2.0E-2_wp ! internal timestep
5459	!
5460	!-- New vapour concentration: (eq. 16.71)
5461	zhlp1 = zcwc + adt * ( SUM( zmtae(nstr:nbins) * zwsatae(nstr:nbins) * &
5462	zcwsurfae(nstr:nbins) ) ) ! numerator
5463	zhlp2 = 1.0_wp + adt * ( SUM( zmtae(nstr:nbins) ) ) ! denomin.
5464	zcwint = zhlp1 / zhlp2 ! new vapour concentration
5465	zcwint = MIN( zcwint, zcwtot )
5466	IF ( ANY( paero(:)%numc > nclim ) .AND. zrh > 0.98_wp ) THEN
5467	DO b = nstr, nbins
5468	zcwintae(b) = zcwcae(b) + MIN( MAX( adt * zmtae(b) * &
5469	( zcwint - zwsatae(b) * zcwsurfae(b) ), &
5470	-0.02_wp * zcwcae(b) ), 0.05_wp * zcwcae(b) )
5471	zwsatae(b) = acth2o( paero(b), zcwintae(b) ) * zkelvin(b)
5472	ENDDO
5473	ENDIF
5474	zcwintae(nstr:nbins) = MAX( zcwintae(nstr:nbins), 0.0_wp )
5475	!
5476	!-- Update vapour concentration for consistency
5477	zcwint = zcwtot - SUM( zcwintae(1:nbins) )
5478	!-- Update "old" values for next cycle
5479	zcwcae = zcwintae
5480
5481	ttot = ttot + adt
5482	ENDDO ! ADT
5483	zcwn = zcwint
5484	zcwnae = zcwintae
5485	pcw = zcwn * amh2o / rhoair
5486	paero(1:nbins)%volc(8) = MAX( 0.0_wp, zcwnae(1:nbins) * amh2o / arhoh2o )
5487
5488	END SUBROUTINE gpparth2o
5489
5490	!------------------------------------------------------------------------------!
5491	! Description:
5492	! ------------
5493	!> Calculates the activity coefficient of liquid water
5494	!------------------------------------------------------------------------------!
5495	REAL(wp) FUNCTION acth2o( ppart, pcw )
5496
5497	IMPLICIT NONE
5498
5499	TYPE(t_section), INTENT(in) :: ppart !< Aerosol properties of a bin
5500	REAL(wp), INTENT(in), OPTIONAL :: pcw !< molar concentration of water
5501	!< (mol/m3)
5502
5503	REAL(wp) :: zns !< molar concentration of solutes (mol/m3)
5504	REAL(wp) :: znw !< molar concentration of water (mol/m3)
5505
5506	zns = ( 3.0_wp * ( ppart%volc(1) * arhoh2so4 / amh2so4 ) + &
5507	( ppart%volc(2) * arhooc / amoc ) + &
5508	2.0_wp * ( ppart%volc(5) * arhoss / amss ) + &
5509	( ppart%volc(6) * arhohno3 / amhno3 ) + &
5510	( ppart%volc(7) * arhonh3 / amnh3 ) )
5511	IF ( PRESENT(pcw) ) THEN
5512	znw = pcw
5513	ELSE
5514	znw = ppart%volc(8) * arhoh2o / amh2o
5515	ENDIF
5516	!-- Activity = partial pressure of water vapour /
5517	!-- sat. vapour pressure of water over a bulk liquid surface
5518	!-- = molality * activity coefficient (Jacobson, 2005: eq. 17.20-21)
5519	!-- Assume activity coefficient of 1 for water
5520	acth2o = MAX( 0.1_wp, znw / MAX( EPSILON( 1.0_wp ),( znw + zns ) ) )
5521	END FUNCTION acth2o
5522
5523	!------------------------------------------------------------------------------!
5524	! Description:
5525	! ------------
5526	!> Calculates the dissolutional growth of particles (i.e. gas transfers to a
5527	!> particle surface and dissolves in liquid water on the surface). Treated here
5528	!> as a non-equilibrium (time-dependent) process. Gases: HNO3 and NH3
5529	!> (Chapter 17.14 in Jacobson, 2005).
5530	!
5531	!> Called from subroutine condensation.
5532	!> Coded by:
5533	!> Harri Kokkola (FMI)
5534	!------------------------------------------------------------------------------!
5535	SUBROUTINE gpparthno3( ppres, ptemp, paero, pghno3, pgnh3, pcw, pcs, pbeta, &
5536	ptstep )
5537
5538	IMPLICIT NONE
5539	!
5540	!-- Input and output variables
5541	REAL(wp), INTENT(in) :: pbeta(nbins) !< transitional correction factor for
5542	!< aerosols
5543	REAL(wp), INTENT(in) :: ppres !< ambient pressure (Pa)
5544	REAL(wp), INTENT(in) :: pcs !< water vapour saturation
5545	!< concentration (kg/m3)
5546	REAL(wp), INTENT(in) :: ptemp !< ambient temperature (K)
5547	REAL(wp), INTENT(in) :: ptstep !< time step (s)
5548	REAL(wp), INTENT(inout) :: pghno3 !< nitric acid concentration (#/m3)
5549	REAL(wp), INTENT(inout) :: pgnh3 !< ammonia conc. (#/m3)
5550	REAL(wp), INTENT(inout) :: pcw !< water vapour concentration (kg/m3)
5551	TYPE(t_section), INTENT(inout) :: paero(nbins) !< Aerosol properties
5552	!
5553	!-- Local variables
5554	INTEGER(iwp) :: b !< loop index
5555	REAL(wp) :: adt !< timestep
5556	REAL(wp) :: zachhso4ae(nbins) !< Activity coefficients for HHSO4
5557	REAL(wp) :: zacnh3ae(nbins) !< Activity coefficients for NH3
5558	REAL(wp) :: zacnh4hso2ae(nbins)!< Activity coefficients for NH4HSO2
5559	REAL(wp) :: zacno3ae(nbins) !< Activity coefficients for HNO3
5560	REAL(wp) :: zcgnh3eqae(nbins) !< Equilibrium gas concentration: NH3
5561	REAL(wp) :: zcgno3eqae(nbins) !< Equilibrium gas concentration: HNO3
5562	REAL(wp) :: zcgwaeqae(nbins) !< Equilibrium gas concentration: H2O
5563	REAL(wp) :: zcnh3c !< Current NH3 gas concentration
5564	REAL(wp) :: zcnh3int !< Intermediate NH3 gas concentration
5565	REAL(wp) :: zcnh3intae(nbins) !< Intermediate NH3 aerosol concentration
5566	REAL(wp) :: zcnh3n !< New NH3 gas concentration
5567	REAL(wp) :: zcnh3cae(nbins) !< Current NH3 in aerosols
5568	REAL(wp) :: zcnh3nae(nbins) !< New NH3 in aerosols
5569	REAL(wp) :: zcnh3tot !< Total NH3 concentration
5570	REAL(wp) :: zcno3c !< Current HNO3 gas concentration
5571	REAL(wp) :: zcno3int !< Intermediate HNO3 gas concentration
5572	REAL(wp) :: zcno3intae(nbins) !< Intermediate HNO3 aerosol concentration
5573	REAL(wp) :: zcno3n !< New HNO3 gas concentration
5574	REAL(wp) :: zcno3cae(nbins) !< Current HNO3 in aerosols
5575	REAL(wp) :: zcno3nae(nbins) !< New HNO3 in aerosols
5576	REAL(wp) :: zcno3tot !< Total HNO3 concentration
5577	REAL(wp) :: zdfvap !< Diffusion coefficient for vapors
5578	REAL(wp) :: zhlp1 !< helping variable
5579	REAL(wp) :: zhlp2 !< helping variable
5580	REAL(wp) :: zkelnh3ae(nbins) !< Kelvin effects for NH3
5581	REAL(wp) :: zkelno3ae(nbins) !< Kelvin effect for HNO3
5582	REAL(wp) :: zmolsae(nbins,7) !< Ion molalities from pdfite
5583	REAL(wp) :: zmtnh3ae(nbins) !< Mass transfer coefficients for NH3
5584	REAL(wp) :: zmtno3ae(nbins) !< Mass transfer coefficients for HNO3
5585	REAL(wp) :: zrh !< relative humidity
5586	REAL(wp) :: zsathno3ae(nbins) !< HNO3 saturation ratio
5587	REAL(wp) :: zsatnh3ae(nbins) !< NH3 saturation ratio = the partial
5588	!< pressure of a gas divided by its
5589	!< saturation vapor pressure over a surface
5590	!
5591	!-- Initialise:
5592	adt = ptstep
5593	zachhso4ae = 0.0_wp
5594	zacnh3ae = 0.0_wp
5595	zacnh4hso2ae = 0.0_wp
5596	zacno3ae = 0.0_wp
5597	zcgnh3eqae = 0.0_wp
5598	zcgno3eqae = 0.0_wp
5599	zcnh3c = 0.0_wp
5600	zcnh3cae = 0.0_wp
5601	zcnh3int = 0.0_wp
5602	zcnh3intae = 0.0_wp
5603	zcnh3n = 0.0_wp
5604	zcnh3nae = 0.0_wp
5605	zcnh3tot = 0.0_wp
5606	zcno3c = 0.0_wp
5607	zcno3cae = 0.0_wp
5608	zcno3int = 0.0_wp
5609	zcno3intae = 0.0_wp
5610	zcno3n = 0.0_wp
5611	zcno3nae = 0.0_wp
5612	zcno3tot = 0.0_wp
5613	zhlp1 = 0.0_wp
5614	zhlp2 = 0.0_wp
5615	zkelno3ae = 1.0_wp
5616	zkelnh3ae = 1.0_wp
5617	zmolsae = 0.0_wp
5618	zmtno3ae = 0.0_wp
5619	zmtnh3ae = 0.0_wp
5620	zrh = 0.0_wp
5621	zsatnh3ae = 1.0_wp
5622	zsathno3ae = 1.0_wp
5623	!
5624	!-- Diffusion coefficient (m2/s)
5625	zdfvap = 5.1111E-10_wp * ptemp ** 1.75_wp * ( p_0 + 1325.0_wp ) / ppres
5626	!
5627	!-- Kelvin effects (Jacobson (2005), eq. 16.33)
5628	zkelno3ae(1:nbins) = EXP( 4.0_wp * surfw0 * amvhno3 / ( abo * ptemp * &
5629	paero(1:nbins)%dwet ) )
5630	zkelnh3ae(1:nbins) = EXP( 4.0_wp * surfw0 * amvnh3 / ( abo * ptemp * &
5631	paero(1:nbins)%dwet ) )
5632	!
5633	!-- Current vapour mole concentrations (mol/m3)
5634	zcno3c = pghno3 / avo ! HNO3
5635	zcnh3c = pgnh3 / avo ! NH3
5636	!
5637	!-- Current particle mole concentrations (mol/m3)
5638	zcno3cae(1:nbins) = paero(1:nbins)%volc(6) * arhohno3 / amhno3
5639	zcnh3cae(1:nbins) = paero(1:nbins)%volc(7) * arhonh3 / amnh3
5640	!
5641	!-- Total mole concentrations: gas and particle phase
5642	zcno3tot = zcno3c + SUM( zcno3cae(1:nbins) )
5643	zcnh3tot = zcnh3c + SUM( zcnh3cae(1:nbins) )
5644	!
5645	!-- Relative humidity [0-1]
5646	zrh = pcw / pcs
5647	!
5648	!-- Mass transfer coefficients (Jacobson, Eq. 16.64)
5649	zmtno3ae(1:nbins) = 2.0_wp * pi * paero(1:nbins)%dwet * zdfvap * &
5650	paero(1:nbins)%numc * pbeta(1:nbins)
5651	zmtnh3ae(1:nbins) = 2.0_wp * pi * paero(1:nbins)%dwet * zdfvap * &
5652	paero(1:nbins)%numc * pbeta(1:nbins)
5653
5654	!
5655	!-- Get the equilibrium concentrations above aerosols
5656	CALL NONHEquil( zrh, ptemp, paero, zcgno3eqae, zcgnh3eqae, zacno3ae, &
5657	zacnh3ae, zacnh4hso2ae, zachhso4ae, zmolsae )
5658
5659	!
5660	!-- NH4/HNO3 saturation ratios for aerosols
5661	CALL SVsat( ptemp, paero, zacno3ae, zacnh3ae, zacnh4hso2ae, zachhso4ae, &
5662	zcgno3eqae, zcno3cae, zcnh3cae, zkelno3ae, zkelnh3ae, &
5663	zsathno3ae, zsatnh3ae, zmolsae )
5664	!
5665	!-- Intermediate concentrations
5666	zhlp1 = SUM( zcno3cae(1:nbins) / ( 1.0_wp + adt * zmtno3ae(1:nbins) * &
5667	zsathno3ae(1:nbins) ) )
5668	zhlp2 = SUM( zmtno3ae(1:nbins) / ( 1.0_wp + adt * zmtno3ae(1:nbins) * &
5669	zsathno3ae(1:nbins) ) )
5670	zcno3int = ( zcno3tot - zhlp1 ) / ( 1.0_wp + adt * zhlp2 )
5671
5672	zhlp1 = SUM( zcnh3cae(1:nbins) / ( 1.0_wp + adt * zmtnh3ae(1:nbins) * &
5673	zsatnh3ae(1:nbins) ) )
5674	zhlp2 = SUM( zmtnh3ae(1:nbins) / ( 1.0_wp + adt * zmtnh3ae(1:nbins) * &
5675	zsatnh3ae(1:nbins) ) )
5676	zcnh3int = ( zcnh3tot - zhlp1 )/( 1.0_wp + adt * zhlp2 )
5677
5678	zcno3int = MIN(zcno3int, zcno3tot)
5679	zcnh3int = MIN(zcnh3int, zcnh3tot)
5680	!
5681	!-- Calculate the new particle concentrations
5682	zcno3intae = zcno3cae
5683	zcnh3intae = zcnh3cae
5684	DO b = 1, nbins
5685	zcno3intae(b) = ( zcno3cae(b) + adt * zmtno3ae(b) * zcno3int ) / &
5686	( 1.0_wp + adt * zmtno3ae(b) * zsathno3ae(b) )
5687	zcnh3intae(b) = ( zcnh3cae(b) + adt * zmtnh3ae(b) * zcnh3int ) / &
5688	( 1.0_wp + adt * zmtnh3ae(b) * zsatnh3ae(b) )
5689	ENDDO
5690
5691	zcno3intae(1:nbins) = MAX( zcno3intae(1:nbins), 0.0_wp )
5692	zcnh3intae(1:nbins) = MAX( zcnh3intae(1:nbins), 0.0_wp )
5693
5694	zcno3n = zcno3int ! Final molar gas concentration of HNO3
5695	zcno3nae = zcno3intae ! Final molar particle concentration of HNO3
5696
5697	zcnh3n = zcnh3int ! Final molar gas concentration of NH3
5698	zcnh3nae = zcnh3intae ! Final molar particle concentration of NH3
5699	!
5700	!-- Model timestep reached - update the new arrays
5701	pghno3 = zcno3n * avo
5702	pgnh3 = zcnh3n * avo
5703
5704	DO b = in1a, fn2b
5705	paero(b)%volc(6) = zcno3nae(b) * amhno3 / arhohno3
5706	paero(b)%volc(7) = zcnh3nae(b) * amnh3 / arhonh3
5707	ENDDO
5708
5709
5710	END SUBROUTINE gpparthno3
5711	!------------------------------------------------------------------------------!
5712	! Description:
5713	! ------------
5714	!> Calculate the equilibrium concentrations above aerosols (reference?)
5715	!------------------------------------------------------------------------------!
5716	SUBROUTINE NONHEquil( prh, ptemp, ppart, pcgno3eq, pcgnh3eq, pgammano, &
5717	pgammanh, pgammanh4hso2, pgammahhso4, pmols )
5718
5719	IMPLICIT NONE
5720
5721	REAL(wp), INTENT(in) :: prh !< relative humidity
5722	REAL(wp), INTENT(in) :: ptemp !< ambient temperature (K)
5723
5724	TYPE(t_section), INTENT(inout) :: ppart(nbins) !< Aerosol properties
5725	!-- Equilibrium molar concentration above aerosols:
5726	REAL(wp), INTENT(inout) :: pcgnh3eq(nbins) !< of NH3
5727	REAL(wp), INTENT(inout) :: pcgno3eq(nbins) !< of HNO3
5728	!< Activity coefficients:
5729	REAL(wp), INTENT(inout) :: pgammahhso4(nbins) !< HHSO4
5730	REAL(wp), INTENT(inout) :: pgammanh(nbins) !< NH3
5731	REAL(wp), INTENT(inout) :: pgammanh4hso2(nbins) !< NH4HSO2
5732	REAL(wp), INTENT(inout) :: pgammano(nbins) !< HNO3
5733	REAL(wp), INTENT(inout) :: pmols(nbins,7) !< Ion molalities
5734
5735	INTEGER(iwp) :: b
5736
5737	REAL(wp) :: zgammas(7) !< Activity coefficients
5738	REAL(wp) :: zhlp !< Dummy variable
5739	REAL(wp) :: zions(7) !< molar concentration of ion (mol/m3)
5740	REAL(wp) :: zphcl !< Equilibrium vapor pressures (Pa??)
5741	REAL(wp) :: zphno3 !< Equilibrium vapor pressures (Pa??)
5742	REAL(wp) :: zpnh3 !< Equilibrium vapor pressures (Pa??)
5743	REAL(wp) :: zwatertotal !< Total water in particles (mol/m3) ???
5744
5745	zgammas = 0.0_wp
5746	zhlp = 0.0_wp
5747	zions = 0.0_wp
5748	zphcl = 0.0_wp
5749	zphno3 = 0.0_wp
5750	zpnh3 = 0.0_wp
5751	zwatertotal = 0.0_wp
5752
5753	DO b = 1, nbins
5754
5755	IF ( ppart(b)%numc < nclim ) CYCLE
5756	!
5757	!-- 2*H2SO4 + CL + NO3 - Na - NH4
5758	zhlp = 2.0_wp * ppart(b)%volc(1) * arhoh2so4 / amh2so4 + &
5759	ppart(b)%volc(5) * arhoss / amss + &
5760	ppart(b)%volc(6) * arhohno3 / amhno3 - &
5761	ppart(b)%volc(5) * arhoss / amss - &
5762	ppart(b)%volc(7) * arhonh3 / amnh3
5763
5764	zhlp = MAX( zhlp, 1.0E-30_wp )
5765
5766	zions(1) = zhlp ! H+
5767	zions(2) = ppart(b)%volc(7) * arhonh3 / amnh3 ! NH4+
5768	zions(3) = ppart(b)%volc(5) * arhoss / amss ! Na+
5769	zions(4) = ppart(b)%volc(1) * arhoh2so4 / amh2so4 ! SO4(2-)
5770	zions(5) = 0.0_wp ! HSO4-
5771	zions(6) = ppart(b)%volc(6) * arhohno3 / amhno3 ! NO3-
5772	zions(7) = ppart(b)%volc(5) * arhoss / amss ! Cl-
5773
5774	zwatertotal = ppart(b)%volc(8) * arhoh2o / amh2o
5775	IF ( zwatertotal > 1.0E-30_wp ) THEN
5776	CALL inorganic_pdfite( prh, ptemp, zions, zwatertotal, zphno3, zphcl,&
5777	zpnh3, zgammas, pmols(b,:) )
5778	ENDIF
5779	!
5780	!-- Activity coefficients
5781	pgammano(b) = zgammas(1) ! HNO3
5782	pgammanh(b) = zgammas(3) ! NH3
5783	pgammanh4hso2(b) = zgammas(6) ! NH4HSO2
5784	pgammahhso4(b) = zgammas(7) ! HHSO4
5785	!
5786	!-- Equilibrium molar concentrations (mol/m3) from equlibrium pressures (Pa)
5787	pcgno3eq(b) = zphno3 / ( argas * ptemp )
5788	pcgnh3eq(b) = zpnh3 / ( argas * ptemp )
5789
5790	ENDDO
5791
5792	END SUBROUTINE NONHEquil
5793
5794	!------------------------------------------------------------------------------!
5795	! Description:
5796	! ------------
5797	!> Calculate saturation ratios of NH4 and HNO3 for aerosols
5798	!------------------------------------------------------------------------------!
5799	SUBROUTINE SVsat( ptemp, ppart, pachno3, pacnh3, pacnh4hso2, pachhso4, &
5800	pchno3eq, pchno3, pcnh3, pkelhno3, pkelnh3, psathno3, &
5801	psatnh3, pmols )
5802
5803	IMPLICIT NONE
5804
5805	REAL(wp), INTENT(in) :: ptemp !< ambient temperature (K)
5806
5807	TYPE(t_section), INTENT(inout) :: ppart(nbins) !< Aerosol properties
5808	!-- Activity coefficients
5809	REAL(wp), INTENT(in) :: pachhso4(nbins) !<
5810	REAL(wp), INTENT(in) :: pacnh3(nbins) !<
5811	REAL(wp), INTENT(in) :: pacnh4hso2(nbins) !<
5812	REAL(wp), INTENT(in) :: pachno3(nbins) !<
5813	REAL(wp), INTENT(in) :: pchno3eq(nbins) !< Equilibrium surface concentration
5814	!< of HNO3
5815	REAL(wp), INTENT(in) :: pchno3(nbins) !< Current particle mole
5816	!< concentration of HNO3 (mol/m3)
5817	REAL(wp), INTENT(in) :: pcnh3(nbins) !< Current particle mole
5818	!< concentration of NH3 (mol/m3)
5819	REAL(wp), INTENT(in) :: pkelhno3(nbins) !< Kelvin effect for HNO3
5820	REAL(wp), INTENT(in) :: pkelnh3(nbins) !< Kelvin effect for NH3
5821	REAL(wp), INTENT(in) :: pmols(nbins,7)
5822	!-- Saturation ratios
5823	REAL(wp), INTENT(out) :: psathno3(nbins) !<
5824	REAL(wp), INTENT(out) :: psatnh3(nbins) !<
5825
5826	INTEGER :: b !< running index for aerosol bins
5827	!-- Constants for calculating equilibrium constants:
5828	REAL(wp), PARAMETER :: a1 = -22.52_wp !<
5829	REAL(wp), PARAMETER :: a2 = -1.50_wp !<
5830	REAL(wp), PARAMETER :: a3 = 13.79_wp !<
5831	REAL(wp), PARAMETER :: a4 = 29.17_wp !<
5832	REAL(wp), PARAMETER :: b1 = 26.92_wp !<
5833	REAL(wp), PARAMETER :: b2 = 26.92_wp !<
5834	REAL(wp), PARAMETER :: b3 = -5.39_wp !<
5835	REAL(wp), PARAMETER :: b4 = 16.84_wp !<
5836	REAL(wp), PARAMETER :: K01 = 1.01E-14_wp !<
5837	REAL(wp), PARAMETER :: K02 = 1.81E-5_wp !<
5838	REAL(wp), PARAMETER :: K03 = 57.64_wp !<
5839	REAL(wp), PARAMETER :: K04 = 2.51E+6_wp !<
5840	!-- Equilibrium constants of equilibrium reactions
5841	REAL(wp) :: KllH2O !< H2O(aq) <--> H+ + OH- (mol/kg)
5842	REAL(wp) :: KllNH3 !< NH3(aq) + H2O(aq) <--> NH4+ + OH- (mol/kg)
5843	REAL(wp) :: KglNH3 !< NH3(g) <--> NH3(aq) (mol/kg/atm)
5844	REAL(wp) :: KglHNO3 !< HNO3(g) <--> H+ + NO3- (mol2/kg2/atm)
5845	REAL(wp) :: zmolno3 !< molality of NO3- (mol/kg)
5846	REAL(wp) :: zmolhp !< molality of H+ (mol/kg)
5847	REAL(wp) :: zmolso4 !< molality of SO4(2-) (mol/kg)
5848	REAL(wp) :: zmolcl !< molality of Cl (mol/kg)
5849	REAL(wp) :: zmolnh4 !< Molality of NH4 (mol/kg)
5850	REAL(wp) :: zmolna !< Molality of Na (mol/kg)
5851	REAL(wp) :: zhlp1 !<
5852	REAL(wp) :: zhlp2 !<
5853	REAL(wp) :: zhlp3 !<
5854	REAL(wp) :: zxi !<
5855	REAL(wp) :: zt0 !< Reference temp
5856
5857	zhlp1 = 0.0_wp
5858	zhlp2 = 0.0_wp
5859	zhlp3 = 0.0_wp
5860	zmolcl = 0.0_wp
5861	zmolhp = 0.0_wp
5862	zmolna = 0.0_wp
5863	zmolnh4 = 0.0_wp
5864	zmolno3 = 0.0_wp
5865	zmolso4 = 0.0_wp
5866	zt0 = 298.15_wp
5867	zxi = 0.0_wp
5868	!
5869	!-- Calculates equlibrium rate constants based on Table B.7 in Jacobson (2005)
5870	!-- K^ll_H20, K^ll_NH3, K^gl_NH3, K^gl_HNO3
5871	zhlp1 = zt0 / ptemp
5872	zhlp2 = zhlp1 - 1.0_wp
5873	zhlp3 = 1.0_wp + LOG( zhlp1 ) - zhlp1
5874
5875	KllH2O = K01 * EXP( a1 * zhlp2 + b1 * zhlp3 )
5876	KllNH3 = K02 * EXP( a2 * zhlp2 + b2 * zhlp3 )
5877	KglNH3 = K03 * EXP( a3 * zhlp2 + b3 * zhlp3 )
5878	KglHNO3 = K04 * EXP( a4 * zhlp2 + b4 * zhlp3 )
5879
5880	DO b = 1, nbins
5881
5882	IF ( ppart(b)%numc > nclim .AND. ppart(b)%volc(8) > 1.0E-30_wp ) THEN
5883	!
5884	!-- Molality of H+ and NO3-
5885	zhlp1 = pcnh3(b) * amnh3 + ppart(b)%volc(1) * arhoh2so4 + &
5886	ppart(b)%volc(2) * arhooc + ppart(b)%volc(5) * arhoss + &
5887	ppart(b)%volc(8) * arhoh2o
5888	zmolno3 = pchno3(b) / zhlp1 !< mol/kg
5889	!
5890	!-- Particle mole concentration ratio: (NH3+SS)/H2SO4
5891	zxi = ( pcnh3(b) + ppart(b)%volc(5) * arhoss / amss ) / &
5892	( ppart(b)%volc(1) * arhoh2so4 / amh2so4 )
5893
5894	IF ( zxi <= 2.0_wp ) THEN
5895	!
5896	!-- Molality of SO4(2-)
5897	zhlp1 = pcnh3(b) * amnh3 + pchno3(b) * amhno3 + &
5898	ppart(b)%volc(2) * arhooc + ppart(b)%volc(5) * arhoss + &
5899	ppart(b)%volc(8) * arhoh2o
5900	zmolso4 = ( ppart(b)%volc(1) * arhoh2so4 / amh2so4 ) / zhlp1
5901	!
5902	!-- Molality of Cl-
5903	zhlp1 = pcnh3(b) * amnh3 + pchno3(b) * amhno3 + &
5904	ppart(b)%volc(2) * arhooc + ppart(b)%volc(1) * arhoh2so4 &
5905	+ ppart(b)%volc(8) * arhoh2o
5906	zmolcl = ( ppart(b)%volc(5) * arhoss / amss ) / zhlp1
5907	!
5908	!-- Molality of NH4+
5909	zhlp1 = pchno3(b) * amhno3 + ppart(b)%volc(1) * arhoh2so4 + &
5910	ppart(b)%volc(2) * arhooc + ppart(b)%volc(5) * arhoss + &
5911	ppart(b)%volc(8) * arhoh2o
5912	zmolnh4 = pcnh3(b) / zhlp1
5913	!
5914	!-- Molality of Na+
5915	zmolna = zmolcl
5916	!
5917	!-- Molality of H+
5918	zmolhp = 2.0_wp * zmolso4 + zmolno3 + zmolcl - ( zmolnh4 + zmolna )
5919
5920	ELSE
5921
5922	zhlp2 = pkelhno3(b) * zmolno3 * pachno3(b) ** 2.0_wp
5923	!
5924	!-- Mona debugging
5925	IF ( zhlp2 > 1.0E-30_wp ) THEN
5926	zmolhp = KglHNO3 * pchno3eq(b) / zhlp2 ! Eq. 17.38
5927	ELSE
5928	zmolhp = 0.0_wp
5929	ENDIF
5930
5931	ENDIF
5932
5933	zhlp1 = ppart(b)%volc(8) * arhoh2o * argas * ptemp * KglHNO3
5934	!
5935	!-- Saturation ratio for NH3 and for HNO3
5936	IF ( zmolhp > 0.0_wp ) THEN
5937	zhlp2 = pkelnh3(b) / ( zhlp1 * zmolhp )
5938	zhlp3 = KllH2O / ( KllNH3 + KglNH3 )
5939	psatnh3(b) = zhlp2 * ( ( pacnh4hso2(b) / pachhso4(b) ) **2.0_wp ) &
5940	* zhlp3
5941	psathno3(b) = ( pkelhno3(b) * zmolhp * pachno3(b)**2.0_wp ) / zhlp1
5942	ELSE
5943	psatnh3(b) = 1.0_wp
5944	psathno3(b) = 1.0_wp
5945	ENDIF
5946	ELSE
5947	psatnh3(b) = 1.0_wp
5948	psathno3(b) = 1.0_wp
5949	ENDIF
5950
5951	ENDDO
5952
5953	END SUBROUTINE SVsat
5954
5955	!------------------------------------------------------------------------------!
5956	! Description:
5957	! ------------
5958	!> Prototype module for calculating the water content of a mixed inorganic/
5959	!> organic particle + equilibrium water vapour pressure above the solution
5960	!> (HNO3, HCL, NH3 and representative organic compounds. Efficient calculation
5961	!> of the partitioning of species between gas and aerosol. Based in a chamber
5962	!> study.
5963	!
5964	!> Written by Dave Topping. Pure organic component properties predicted by Mark
5965	!> Barley based on VOCs predicted in MCM simulations performed by Mike Jenkin.
5966	!> Delivered by Gordon McFiggans as Deliverable D22 from WP1.4 in the EU FP6
5967	!> EUCAARI Integrated Project.
5968	!
5969	!> Queries concerning the use of this code through Gordon McFiggans,
5970	!> g.mcfiggans@manchester.ac.uk,
5971	!> Ownership: D. Topping, Centre for Atmospheric Sciences, University of
5972	!> Manchester, 2007
5973	!
5974	!> Rewritten to PALM by Mona Kurppa, UHel, 2017
5975	!------------------------------------------------------------------------------!
5976	SUBROUTINE inorganic_pdfite( RH, temp, ions, water_total, Press_HNO3, &
5977	Press_HCL, Press_NH3, gamma_out, mols_out )
5978
5979	IMPLICIT NONE
5980
5981	REAL(wp), DIMENSION(:) :: gamma_out !< Activity coefficient for calculating
5982	!< the non-ideal dissociation constants
5983	!< 1: HNO3, 2: HCL, 3: NH4+/H+ (NH3)
5984	!< 4: HHSO4**2/H2SO4,
5985	!< 5: H2SO43/HHSO42
5986	!< 6: NH4HSO2, 7: HHSO4
5987	REAL(wp), DIMENSION(:) :: ions !< ion molarities (mol/m3)
5988	!< 1: H+, 2: NH4+, 3: Na+, 4: SO4(2-),
5989	!< 5: HSO4-, 6: NO3-, 7: Cl-
5990	REAL(wp), DIMENSION(7) :: ions_mol !< ion molalities (mol/kg)
5991	!< 1: H+, 2: NH4+, 3: Na+, 4: SO4(2-),
5992	!< 5: HSO4-, 6: NO3-, 7: Cl-
5993	REAL(wp), DIMENSION(:) :: mols_out !< ion molality output (mol/kg)
5994	!< 1: H+, 2: NH4+, 3: Na+, 4: SO4(2-),
5995	!< 5: HSO4-, 6: NO3-, 7: Cl-
5996	REAL(wp) :: act_product !< ionic activity coef. product:
5997	!< = (gamma_h2so4**3d0) /
5998	!< (gamma_hhso4**2d0)
5999	REAL(wp) :: ammonium_chloride !<
6000	REAL(wp) :: ammonium_chloride_eq_frac !<
6001	REAL(wp) :: ammonium_nitrate !<
6002	REAL(wp) :: ammonium_nitrate_eq_frac !<
6003	REAL(wp) :: ammonium_sulphate !<
6004	REAL(wp) :: ammonium_sulphate_eq_frac !<
6005	REAL(wp) :: binary_h2so4 !< binary H2SO4 activity coeff.
6006	REAL(wp) :: binary_hcl !< binary HCL activity coeff.
6007	REAL(wp) :: binary_hhso4 !< binary HHSO4 activity coeff.
6008	REAL(wp) :: binary_hno3 !< binary HNO3 activity coeff.
6009	REAL(wp) :: binary_nh4hso4 !< binary NH4HSO4 activity coeff.
6010	REAL(wp) :: charge_sum !< sum of ionic charges
6011	REAL(wp) :: gamma_h2so4 !< activity coefficient
6012	REAL(wp) :: gamma_hcl !< activity coefficient
6013	REAL(wp) :: gamma_hhso4 !< activity coeffient
6014	REAL(wp) :: gamma_hno3 !< activity coefficient
6015	REAL(wp) :: gamma_nh3 !< activity coefficient
6016	REAL(wp) :: gamma_nh4hso4 !< activity coefficient
6017	REAL(wp) :: h_out !<
6018	REAL(wp) :: h_real !< new hydrogen ion conc.
6019	REAL(wp) :: H2SO4_hcl !< contribution of H2SO4
6020	REAL(wp) :: H2SO4_hno3 !< contribution of H2SO4
6021	REAL(wp) :: H2SO4_nh3 !< contribution of H2SO4
6022	REAL(wp) :: H2SO4_nh4hso4 !< contribution of H2SO4
6023	REAL(wp) :: HCL_h2so4 !< contribution of HCL
6024	REAL(wp) :: HCL_hhso4 !< contribution of HCL
6025	REAL(wp) :: HCL_hno3 !< contribution of HCL
6026	REAL(wp) :: HCL_nh3 !< contribution of HCL
6027	REAL(wp) :: HCL_nh4hso4 !< contribution of HCL
6028	REAL(wp) :: henrys_temp_dep !< temperature dependence of
6029	!< Henry's Law
6030	REAL(wp) :: HNO3_h2so4 !< contribution of HNO3
6031	REAL(wp) :: HNO3_hcl !< contribution of HNO3
6032	REAL(wp) :: HNO3_hhso4 !< contribution of HNO3
6033	REAL(wp) :: HNO3_nh3 !< contribution of HNO3
6034	REAL(wp) :: HNO3_nh4hso4 !< contribution of HNO3
6035	REAL(wp) :: hso4_out !<
6036	REAL(wp) :: hso4_real !< new bisulphate ion conc.
6037	REAL(wp) :: hydrochloric_acid !<
6038	REAL(wp) :: hydrochloric_acid_eq_frac !<
6039	REAL(wp) :: Kh !< equilibrium constant for H+
6040	REAL(wp) :: K_hcl !< equilibrium constant of HCL
6041	REAL(wp) :: K_hno3 !< equilibrium constant of HNO3
6042	REAL(wp) :: Knh4 !< equilibrium constant for NH4+
6043	REAL(wp) :: Kw !< equil. const. for water_surface
6044	REAL(wp) :: Ln_h2so4_act !< gamma_h2so4 = EXP(Ln_h2so4_act)
6045	REAL(wp) :: Ln_HCL_act !< gamma_hcl = EXP( Ln_HCL_act )
6046	REAL(wp) :: Ln_hhso4_act !< gamma_hhso4 = EXP(Ln_hhso4_act)
6047	REAL(wp) :: Ln_HNO3_act !< gamma_hno3 = EXP( Ln_HNO3_act )
6048	REAL(wp) :: Ln_NH4HSO4_act !< gamma_nh4hso4 =
6049	!< EXP( Ln_NH4HSO4_act )
6050	REAL(wp) :: molality_ratio_nh3 !< molality ratio of NH3
6051	!< (NH4+ and H+)
6052	REAL(wp) :: Na2SO4_h2so4 !< contribution of Na2SO4
6053	REAL(wp) :: Na2SO4_hcl !< contribution of Na2SO4
6054	REAL(wp) :: Na2SO4_hhso4 !< contribution of Na2SO4
6055	REAL(wp) :: Na2SO4_hno3 !< contribution of Na2SO4
6056	REAL(wp) :: Na2SO4_nh3 !< contribution of Na2SO4
6057	REAL(wp) :: Na2SO4_nh4hso4 !< contribution of Na2SO4
6058	REAL(wp) :: NaCl_h2so4 !< contribution of NaCl
6059	REAL(wp) :: NaCl_hcl !< contribution of NaCl
6060	REAL(wp) :: NaCl_hhso4 !< contribution of NaCl
6061	REAL(wp) :: NaCl_hno3 !< contribution of NaCl
6062	REAL(wp) :: NaCl_nh3 !< contribution of NaCl
6063	REAL(wp) :: NaCl_nh4hso4 !< contribution of NaCl
6064	REAL(wp) :: NaNO3_h2so4 !< contribution of NaNO3
6065	REAL(wp) :: NaNO3_hcl !< contribution of NaNO3
6066	REAL(wp) :: NaNO3_hhso4 !< contribution of NaNO3
6067	REAL(wp) :: NaNO3_hno3 !< contribution of NaNO3
6068	REAL(wp) :: NaNO3_nh3 !< contribution of NaNO3
6069	REAL(wp) :: NaNO3_nh4hso4 !< contribution of NaNO3
6070	REAL(wp) :: NH42SO4_h2so4 !< contribution of NH42SO4
6071	REAL(wp) :: NH42SO4_hcl !< contribution of NH42SO4
6072	REAL(wp) :: NH42SO4_hhso4 !< contribution of NH42SO4
6073	REAL(wp) :: NH42SO4_hno3 !< contribution of NH42SO4
6074	REAL(wp) :: NH42SO4_nh3 !< contribution of NH42SO4
6075	REAL(wp) :: NH42SO4_nh4hso4 !< contribution of NH42SO4
6076	REAL(wp) :: NH4Cl_h2so4 !< contribution of NH4Cl
6077	REAL(wp) :: NH4Cl_hcl !< contribution of NH4Cl
6078	REAL(wp) :: NH4Cl_hhso4 !< contribution of NH4Cl
6079	REAL(wp) :: NH4Cl_hno3 !< contribution of NH4Cl
6080	REAL(wp) :: NH4Cl_nh3 !< contribution of NH4Cl
6081	REAL(wp) :: NH4Cl_nh4hso4 !< contribution of NH4Cl
6082	REAL(wp) :: NH4NO3_h2so4 !< contribution of NH4NO3
6083	REAL(wp) :: NH4NO3_hcl !< contribution of NH4NO3
6084	REAL(wp) :: NH4NO3_hhso4 !< contribution of NH4NO3
6085	REAL(wp) :: NH4NO3_hno3 !< contribution of NH4NO3
6086	REAL(wp) :: NH4NO3_nh3 !< contribution of NH4NO3
6087	REAL(wp) :: NH4NO3_nh4hso4 !< contribution of NH4NO3
6088	REAL(wp) :: nitric_acid !<
6089	REAL(wp) :: nitric_acid_eq_frac !< Equivalent fractions
6090	REAL(wp) :: Press_HCL !< partial pressure of HCL
6091	REAL(wp) :: Press_HNO3 !< partial pressure of HNO3
6092	REAL(wp) :: Press_NH3 !< partial pressure of NH3
6093	REAL(wp) :: RH !< relative humidity [0-1]
6094	REAL(wp) :: temp !< temperature
6095	REAL(wp) :: so4_out !<
6096	REAL(wp) :: so4_real !< new sulpate ion concentration
6097	REAL(wp) :: sodium_chloride !<
6098	REAL(wp) :: sodium_chloride_eq_frac !<
6099	REAL(wp) :: sodium_nitrate !<
6100	REAL(wp) :: sodium_nitrate_eq_frac !<
6101	REAL(wp) :: sodium_sulphate !<
6102	REAL(wp) :: sodium_sulphate_eq_frac !<
6103	REAL(wp) :: solutes !<
6104	REAL(wp) :: sulphuric_acid !<
6105	REAL(wp) :: sulphuric_acid_eq_frac !<
6106	REAL(wp) :: water_total !<
6107
6108	REAL(wp) :: a !< auxiliary variable
6109	REAL(wp) :: b !< auxiliary variable
6110	REAL(wp) :: c !< auxiliary variable
6111	REAL(wp) :: root1 !< auxiliary variable
6112	REAL(wp) :: root2 !< auxiliary variable
6113
6114	INTEGER(iwp) :: binary_case
6115	INTEGER(iwp) :: full_complexity
6116	!
6117	!-- Value initialisation
6118	binary_h2so4 = 0.0_wp
6119	binary_hcl = 0.0_wp
6120	binary_hhso4 = 0.0_wp
6121	binary_hno3 = 0.0_wp
6122	binary_nh4hso4 = 0.0_wp
6123	henrys_temp_dep = ( 1.0_wp / temp - 1.0_wp / 298.0_wp )
6124	HCL_hno3 = 1.0_wp
6125	H2SO4_hno3 = 1.0_wp
6126	NH42SO4_hno3 = 1.0_wp
6127	NH4NO3_hno3 = 1.0_wp
6128	NH4Cl_hno3 = 1.0_wp
6129	Na2SO4_hno3 = 1.0_wp
6130	NaNO3_hno3 = 1.0_wp
6131	NaCl_hno3 = 1.0_wp
6132	HNO3_hcl = 1.0_wp
6133	H2SO4_hcl = 1.0_wp
6134	NH42SO4_hcl = 1.0_wp
6135	NH4NO3_hcl = 1.0_wp
6136	NH4Cl_hcl = 1.0_wp
6137	Na2SO4_hcl = 1.0_wp
6138	NaNO3_hcl = 1.0_wp
6139	NaCl_hcl = 1.0_wp
6140	HNO3_nh3 = 1.0_wp
6141	HCL_nh3 = 1.0_wp
6142	H2SO4_nh3 = 1.0_wp
6143	NH42SO4_nh3 = 1.0_wp
6144	NH4NO3_nh3 = 1.0_wp
6145	NH4Cl_nh3 = 1.0_wp
6146	Na2SO4_nh3 = 1.0_wp
6147	NaNO3_nh3 = 1.0_wp
6148	NaCl_nh3 = 1.0_wp
6149	HNO3_hhso4 = 1.0_wp
6150	HCL_hhso4 = 1.0_wp
6151	NH42SO4_hhso4 = 1.0_wp
6152	NH4NO3_hhso4 = 1.0_wp
6153	NH4Cl_hhso4 = 1.0_wp
6154	Na2SO4_hhso4 = 1.0_wp
6155	NaNO3_hhso4 = 1.0_wp
6156	NaCl_hhso4 = 1.0_wp
6157	HNO3_h2so4 = 1.0_wp
6158	HCL_h2so4 = 1.0_wp
6159	NH42SO4_h2so4 = 1.0_wp
6160	NH4NO3_h2so4 = 1.0_wp
6161	NH4Cl_h2so4 = 1.0_wp
6162	Na2SO4_h2so4 = 1.0_wp
6163	NaNO3_h2so4 = 1.0_wp
6164	NaCl_h2so4 = 1.0_wp
6165	!-- New NH3 variables
6166	HNO3_nh4hso4 = 1.0_wp
6167	HCL_nh4hso4 = 1.0_wp
6168	H2SO4_nh4hso4 = 1.0_wp
6169	NH42SO4_nh4hso4 = 1.0_wp
6170	NH4NO3_nh4hso4 = 1.0_wp
6171	NH4Cl_nh4hso4 = 1.0_wp
6172	Na2SO4_nh4hso4 = 1.0_wp
6173	NaNO3_nh4hso4 = 1.0_wp
6174	NaCl_nh4hso4 = 1.0_wp
6175	!
6176	!-- Juha Tonttila added
6177	mols_out = 0.0_wp
6178	Press_HNO3 = 0.0_wp
6179	Press_HCL = 0.0_wp
6180	Press_NH3 = 0.0_wp !< Initialising vapour pressure over the
6181	!< multicomponent particle
6182	gamma_out = 1.0_wp !< i.e. don't alter the ideal mixing ratios if
6183	!< there's nothing there.
6184	!
6185	!-- 1) - COMPOSITION DEFINITIONS
6186	!
6187	!-- a) Inorganic ion pairing:
6188	!-- In order to calculate the water content, which is also used in
6189	!-- calculating vapour pressures, one needs to pair the anions and cations
6190	!-- for use in the ZSR mixing rule. The equation provided by Clegg et al.
6191	!-- (2001) is used for ion pairing. The solutes chosen comprise of 9
6192	!-- inorganic salts and acids which provide a pairing between each anion and
6193	!-- cation: (NH4)2SO4, NH4NO3, NH4Cl, Na2SO4, NaNO3, NaCl, H2SO4, HNO3, HCL.
6194	!-- The organic compound is treated as a seperate solute.
6195	!-- Ions: 1: H+, 2: NH4+, 3: Na+, 4: SO4(2-), 5: HSO4-, 6: NO3-, 7: Cl-
6196	!
6197	charge_sum = ions(1) + ions(2) + ions(3) + 2.0_wp * ions(4) + ions(5) + &
6198	ions(6) + ions(7)
6199	nitric_acid = 0.0_wp ! HNO3
6200	nitric_acid = ( 2.0_wp * ions(1) * ions(6) * &
6201	( ( 1.0_wp / 1.0_wp ) ** 0.5_wp ) ) / ( charge_sum )
6202	hydrochloric_acid = 0.0_wp ! HCL
6203	hydrochloric_acid = ( 2.0_wp * ions(1) * ions(7) * &
6204	( ( 1.0_wp / 1.0_wp ) ** 0.5_wp ) ) / ( charge_sum )
6205	sulphuric_acid = 0.0_wp ! H2SO4
6206	sulphuric_acid = ( 2.0_wp * ions(1) * ions(4) * &
6207	( ( 2.0_wp / 2.0_wp ) ** 0.5_wp ) ) / ( charge_sum )
6208	ammonium_sulphate = 0.0_wp ! (NH4)2SO4
6209	ammonium_sulphate = ( 2.0_wp * ions(2) * ions(4) * &
6210	( ( 2.0_wp / 2.0_wp ) ** 0.5_wp ) ) / ( charge_sum )
6211	ammonium_nitrate = 0.0_wp ! NH4NO3
6212	ammonium_nitrate = ( 2.0_wp * ions(2) * ions(6) * &
6213	( ( 1.0_wp / 1.0_wp ) ** 0.5_wp ) ) / ( charge_sum )
6214	ammonium_chloride = 0.0_wp ! NH4Cl
6215	ammonium_chloride = ( 2.0_wp * ions(2) * ions(7) * &
6216	( ( 1.0_wp / 1.0_wp ) ** 0.5_wp ) ) / ( charge_sum )
6217	sodium_sulphate = 0.0_wp ! Na2SO4
6218	sodium_sulphate = ( 2.0_wp * ions(3) * ions(4) * &
6219	( ( 2.0_wp / 2.0_wp ) ** 0.5_wp ) ) / ( charge_sum )
6220	sodium_nitrate = 0.0_wp ! NaNO3
6221	sodium_nitrate = ( 2.0_wp * ions(3) ions(6) &
6222	( ( 1.0_wp / 1.0_wp ) ** 0.5_wp ) ) / ( charge_sum )
6223	sodium_chloride = 0.0_wp ! NaCl
6224	sodium_chloride = ( 2.0_wp * ions(3) * ions(7) * &
6225	( ( 1.0_wp / 1.0_wp ) ** 0.5_wp ) ) / ( charge_sum )
6226	solutes = 0.0_wp
6227	solutes = 3.0_wp * sulphuric_acid + 2.0_wp * hydrochloric_acid + &
6228	2.0_wp * nitric_acid + 3.0_wp * ammonium_sulphate + &
6229	2.0_wp * ammonium_nitrate + 2.0_wp * ammonium_chloride + &
6230	3.0_wp * sodium_sulphate + 2.0_wp * sodium_nitrate + &
6231	2.0_wp * sodium_chloride
6232
6233	!
6234	!-- b) Inorganic equivalent fractions:
6235	!-- These values are calculated so that activity coefficients can be
6236	!-- expressed by a linear additive rule, thus allowing more efficient
6237	!-- calculations and future expansion (see more detailed description below)
6238	nitric_acid_eq_frac = 2.0_wp * nitric_acid / ( solutes )
6239	hydrochloric_acid_eq_frac = 2.0_wp * hydrochloric_acid / ( solutes )
6240	sulphuric_acid_eq_frac = 3.0_wp * sulphuric_acid / ( solutes )
6241	ammonium_sulphate_eq_frac = 3.0_wp * ammonium_sulphate / ( solutes )
6242	ammonium_nitrate_eq_frac = 2.0_wp * ammonium_nitrate / ( solutes )
6243	ammonium_chloride_eq_frac = 2.0_wp * ammonium_chloride / ( solutes )
6244	sodium_sulphate_eq_frac = 3.0_wp * sodium_sulphate / ( solutes )
6245	sodium_nitrate_eq_frac = 2.0_wp * sodium_nitrate / ( solutes )
6246	sodium_chloride_eq_frac = 2.0_wp * sodium_chloride / ( solutes )
6247	!
6248	!-- Inorganic ion molalities
6249	ions_mol(:) = 0.0_wp
6250	ions_mol(1) = ions(1) / ( water_total * 18.01528E-3_wp ) ! H+
6251	ions_mol(2) = ions(2) / ( water_total * 18.01528E-3_wp ) ! NH4+
6252	ions_mol(3) = ions(3) / ( water_total * 18.01528E-3_wp ) ! Na+
6253	ions_mol(4) = ions(4) / ( water_total * 18.01528E-3_wp ) ! SO4(2-)
6254	ions_mol(5) = ions(5) / ( water_total * 18.01528E-3_wp ) ! HSO4(2-)
6255	ions_mol(6) = ions(6) / ( water_total * 18.01528E-3_wp ) ! NO3-
6256	ions_mol(7) = ions(7) / ( water_total * 18.01528E-3_wp ) ! Cl-
6257
6258	!-- ***
6259	!-- At this point we may need to introduce a method for prescribing H+ when
6260	!-- there is no 'real' value for H+..i.e. in the sulphate poor domain
6261	!-- This will give a value for solve quadratic proposed by Zaveri et al. 2005
6262	!
6263	!-- 2) - WATER CALCULATION
6264	!
6265	!-- a) The water content is calculated using the ZSR rule with solute
6266	!-- concentrations calculated using 1a above. Whilst the usual approximation of
6267	!-- ZSR relies on binary data consisting of 5th or higher order polynomials, in
6268	!-- this code 4 different RH regimes are used, each housing cubic equations for
6269	!-- the water associated with each solute listed above. Binary water contents
6270	!-- for inorganic components were calculated using AIM online (Clegg et al
6271	!-- 1998). The water associated with the organic compound is calculated assuming
6272	!-- ideality and that aw = RH.
6273	!
6274	!-- b) Molality of each inorganic ion and organic solute (initial input) is
6275	!-- calculated for use in vapour pressure calculation.
6276	!
6277	!-- 3) - BISULPHATE ION DISSOCIATION CALCULATION
6278	!
6279	!-- The dissociation of the bisulphate ion is calculated explicitly. A solution
6280	!-- to the equilibrium equation between the bisulphate ion, hydrogen ion and
6281	!-- sulphate ion is found using tabulated equilibrium constants (referenced). It
6282	!-- is necessary to calculate the activity coefficients of HHSO4 and H2SO4 in a
6283	!-- non-iterative manner. These are calculated using the same format as
6284	!-- described in 4) below, where both activity coefficients were fit to the
6285	!-- output from ADDEM (Topping et al 2005a,b) covering an extensive composition
6286	!-- space, providing the activity coefficients and bisulphate ion dissociation
6287	!-- as a function of equivalent mole fractions and relative humidity.
6288	!
6289	!-- NOTE: the flags "binary_case" and "full_complexity" are not used in this
6290	!-- prototype. They are used for simplification of the fit expressions when
6291	!-- using limited composition regions. This section of code calculates the
6292	!-- bisulphate ion concentration
6293	!
6294	IF ( ions(1) > 0.0_wp .AND. ions(4) > 0.0_wp ) THEN
6295	!
6296	!-- HHSO4:
6297	binary_case = 1
6298	IF ( RH > 0.1_wp .AND. RH < 0.9_wp ) THEN
6299	binary_hhso4 = - 4.9521_wp * ( RH*3 ) + 9.2881_wp ( RH**2 ) - &
6300	10.777_wp * RH + 6.0534_wp
6301	ELSEIF ( RH >= 0.9_wp .AND. RH < 0.955_wp ) THEN
6302	binary_hhso4 = - 6.3777_wp * RH + 5.962_wp
6303	ELSEIF ( RH >= 0.955_wp .AND. RH < 0.99_wp ) THEN
6304	binary_hhso4 = 2367.2_wp * ( RH*3 ) - 6849.7_wp ( RH**2 ) + &
6305	6600.9_wp * RH - 2118.7_wp
6306	ELSEIF ( RH >= 0.99_wp .AND. RH < 0.9999_wp ) THEN
6307	binary_hhso4 = 3E-7_wp * ( RH*5 ) - 2E-5_wp ( RH**4 ) + &
6308	0.0004_wp * ( RH*3 ) - 0.0035_wp ( RH**2 ) + &
6309	0.0123_wp * RH - 0.3025_wp
6310	ENDIF
6311
6312	IF ( nitric_acid > 0.0_wp ) THEN
6313	HNO3_hhso4 = - 4.2204_wp * ( RH*4 ) + 12.193_wp ( RH**3 ) - &
6314	12.481_wp * ( RH*2 ) + 6.459_wp RH - 1.9004_wp
6315	ENDIF
6316
6317	IF ( hydrochloric_acid > 0.0_wp ) THEN
6318	HCL_hhso4 = - 54.845_wp * ( RH*7 ) + 209.54_wp ( RH**6 ) - &
6319	336.59_wp * ( RH*5 ) + 294.21_wp ( RH**4 ) - &
6320	150.07_wp * ( RH*3 ) + 43.767_wp ( RH**2 ) - &
6321	6.5495_wp * RH + 0.60048_wp
6322	ENDIF
6323
6324	IF ( ammonium_sulphate > 0.0_wp ) THEN
6325	NH42SO4_hhso4 = 16.768_wp * ( RH*3 ) - 28.75_wp ( RH**2 ) + &
6326	20.011_wp * RH - 8.3206_wp
6327	ENDIF
6328
6329	IF ( ammonium_nitrate > 0.0_wp ) THEN
6330	NH4NO3_hhso4 = - 17.184_wp * ( RH*4 ) + 56.834_wp ( RH**3 ) - &
6331	65.765_wp * ( RH*2 ) + 35.321_wp RH - 9.252_wp
6332	ENDIF
6333
6334	IF (ammonium_chloride > 0.0_wp ) THEN
6335	IF ( RH < 0.2_wp .AND. RH >= 0.1_wp ) THEN
6336	NH4Cl_hhso4 = 3.2809_wp * RH - 2.0637_wp
6337	ELSEIF ( RH >= 0.2_wp .AND. RH < 0.99_wp ) THEN
6338	NH4Cl_hhso4 = - 1.2981_wp * ( RH*3 ) + 4.7461_wp ( RH**2 ) - &
6339	2.3269_wp * RH - 1.1259_wp
6340	ENDIF
6341	ENDIF
6342
6343	IF ( sodium_sulphate > 0.0_wp ) THEN
6344	Na2SO4_hhso4 = 118.87_wp * ( RH*6 ) - 358.63_wp ( RH**5 ) + &
6345	435.85_wp * ( RH*4 ) - 272.88_wp ( RH**3 ) + &
6346	94.411_wp * ( RH*2 ) - 18.21_wp RH + 0.45935_wp
6347	ENDIF
6348
6349	IF ( sodium_nitrate > 0.0_wp ) THEN
6350	IF ( RH < 0.2_wp .AND. RH >= 0.1_wp ) THEN
6351	NaNO3_hhso4 = 4.8456_wp * RH - 2.5773_wp
6352	ELSEIF ( RH >= 0.2_wp .AND. RH < 0.99_wp ) THEN
6353	NaNO3_hhso4 = 0.5964_wp * ( RH*3 ) - 0.38967_wp ( RH**2 ) + &
6354	1.7918_wp * RH - 1.9691_wp
6355	ENDIF
6356	ENDIF
6357
6358	IF ( sodium_chloride > 0.0_wp ) THEN
6359	IF ( RH < 0.2_wp ) THEN
6360	NaCl_hhso4 = 0.51995_wp * RH - 1.3981_wp
6361	ELSEIF ( RH >= 0.2_wp .AND. RH < 0.99_wp ) THEN
6362	NaCl_hhso4 = 1.6539_wp * RH - 1.6101_wp
6363	ENDIF
6364	ENDIF
6365
6366	Ln_hhso4_act = binary_hhso4 + &
6367	nitric_acid_eq_frac * HNO3_hhso4 + &
6368	hydrochloric_acid_eq_frac * HCL_hhso4 + &
6369	ammonium_sulphate_eq_frac * NH42SO4_hhso4 + &
6370	ammonium_nitrate_eq_frac * NH4NO3_hhso4 + &
6371	ammonium_chloride_eq_frac * NH4Cl_hhso4 + &
6372	sodium_sulphate_eq_frac * Na2SO4_hhso4 + &
6373	sodium_nitrate_eq_frac * NaNO3_hhso4 + &
6374	sodium_chloride_eq_frac * NaCl_hhso4
6375	gamma_hhso4 = EXP( Ln_hhso4_act ) ! molal activity coefficient of HHSO4
6376
6377	!-- H2SO4 (sulphuric acid):
6378	IF ( RH >= 0.1_wp .AND. RH < 0.9_wp ) THEN
6379	binary_h2so4 = 2.4493_wp * ( RH*2 ) - 6.2326_wp RH + 2.1763_wp
6380	ELSEIF ( RH >= 0.9_wp .AND. RH < 0.98 ) THEN
6381	binary_h2so4 = 914.68_wp * ( RH*3 ) - 2502.3_wp ( RH**2 ) + &
6382	2281.9_wp * RH - 695.11_wp
6383	ELSEIF ( RH >= 0.98 .AND. RH < 0.9999 ) THEN
6384	binary_h2so4 = 3E-8_wp * ( RH*4 ) - 5E-6_wp ( RH**3 ) + &
6385	0.0003_wp * ( RH*2 ) - 0.0022_wp RH - 1.1305_wp
6386	ENDIF
6387
6388	IF ( nitric_acid > 0.0_wp ) THEN
6389	HNO3_h2so4 = - 16.382_wp * ( RH*5 ) + 46.677_wp ( RH**4 ) - &
6390	54.149_wp * ( RH*3 ) + 34.36_wp ( RH**2 ) - &
6391	12.54_wp * RH + 2.1368_wp
6392	ENDIF
6393
6394	IF ( hydrochloric_acid > 0.0_wp ) THEN
6395	HCL_h2so4 = - 14.409_wp * ( RH*5 ) + 42.804_wp ( RH**4 ) - &
6396	47.24_wp * ( RH*3 ) + 24.668_wp ( RH**2 ) - &
6397	5.8015_wp * RH + 0.084627_wp
6398	ENDIF
6399
6400	IF ( ammonium_sulphate > 0.0_wp ) THEN
6401	NH42SO4_h2so4 = 66.71_wp * ( RH*5 ) - 187.5_wp ( RH**4 ) + &
6402	210.57_wp * ( RH*3 ) - 121.04_wp ( RH**2 ) + &
6403	39.182_wp * RH - 8.0606_wp
6404	ENDIF
6405
6406	IF ( ammonium_nitrate > 0.0_wp ) THEN
6407	NH4NO3_h2so4 = - 22.532_wp * ( RH*4 ) + 66.615_wp ( RH**3 ) - &
6408	74.647_wp * ( RH*2 ) + 37.638_wp RH - 6.9711_wp
6409	ENDIF
6410
6411	IF ( ammonium_chloride > 0.0_wp ) THEN
6412	IF ( RH >= 0.1_wp .AND. RH < 0.2_wp ) THEN
6413	NH4Cl_h2so4 = - 0.32089_wp * RH + 0.57738_wp
6414	ELSEIF ( RH >= 0.2_wp .AND. RH < 0.9_wp ) THEN
6415	NH4Cl_h2so4 = 18.089_wp * ( RH*5 ) - 51.083_wp ( RH**4 ) + &
6416	50.32_wp * ( RH*3 ) - 17.012_wp ( RH**2 ) - &
6417	0.93435_wp * RH + 1.0548_wp
6418	ELSEIF ( RH >= 0.9_wp .AND. RH < 0.99_wp ) THEN
6419	NH4Cl_h2so4 = - 1.5749_wp * RH + 1.7002_wp
6420	ENDIF
6421	ENDIF
6422
6423	IF ( sodium_sulphate > 0.0_wp ) THEN
6424	Na2SO4_h2so4 = 29.843_wp * ( RH*4 ) - 69.417_wp ( RH**3 ) + &
6425	61.507_wp * ( RH*2 ) - 29.874_wp RH + 7.7556_wp
6426	ENDIF
6427
6428	IF ( sodium_nitrate > 0.0_wp ) THEN
6429	NaNO3_h2so4 = - 122.37_wp * ( RH*6 ) + 427.43_wp ( RH**5 ) - &
6430	604.68_wp * ( RH*4 ) + 443.08_wp ( RH**3 ) - &
6431	178.61_wp * ( RH*2 ) + 37.242_wp RH - 1.9564_wp
6432	ENDIF
6433
6434	IF ( sodium_chloride > 0.0_wp ) THEN
6435	NaCl_h2so4 = - 40.288_wp * ( RH*5 ) + 115.61_wp ( RH**4 ) - &
6436	129.99_wp * ( RH*3 ) + 72.652_wp ( RH**2 ) - &
6437	22.124_wp * RH + 4.2676_wp
6438	ENDIF
6439
6440	Ln_h2so4_act = binary_h2so4 + &
6441	nitric_acid_eq_frac * HNO3_h2so4 + &
6442	hydrochloric_acid_eq_frac * HCL_h2so4 + &
6443	ammonium_sulphate_eq_frac * NH42SO4_h2so4 + &
6444	ammonium_nitrate_eq_frac * NH4NO3_h2so4 + &
6445	ammonium_chloride_eq_frac * NH4Cl_h2so4 + &
6446	sodium_sulphate_eq_frac * Na2SO4_h2so4 + &
6447	sodium_nitrate_eq_frac * NaNO3_h2so4 + &
6448	sodium_chloride_eq_frac * NaCl_h2so4
6449
6450	gamma_h2so4 = EXP( Ln_h2so4_act ) ! molal activity coefficient
6451	!
6452	!-- Export activity coefficients
6453	IF ( gamma_h2so4 > 1.0E-10_wp ) THEN
6454	gamma_out(4) = ( gamma_hhso4**2.0_wp ) / gamma_h2so4
6455	ENDIF
6456	IF ( gamma_hhso4 > 1.0E-10_wp ) THEN
6457	gamma_out(5) = ( gamma_h2so43.0_wp ) / ( gamma_hhso42.0_wp )
6458	ENDIF
6459	!
6460	!-- Ionic activity coefficient product
6461	act_product = ( gamma_h2so43.0_wp ) / ( gamma_hhso42.0_wp )
6462	!
6463	!-- Solve the quadratic equation (i.e. x in ax**2 + bx + c = 0)
6464	a = 1.0_wp
6465	b = - 1.0_wp * ( ions(4) + ions(1) + ( ( water_total * 18.0E-3_wp ) / &
6466	( 99.0_wp * act_product ) ) )
6467	c = ions(4) * ions(1)
6468	root1 = ( ( -1.0_wp * b ) + ( ( ( b*2 ) - 4.0_wp a * c )**0.5_wp &
6469	) ) / ( 2 * a )
6470	root2 = ( ( -1.0_wp * b ) - ( ( ( b*2 ) - 4.0_wp a * c) **0.5_wp &
6471	) ) / ( 2 * a )
6472
6473	IF ( root1 > ions(1) .OR. root1 < 0.0_wp ) THEN
6474	root1 = 0.0_wp
6475	ENDIF
6476
6477	IF ( root2 > ions(1) .OR. root2 < 0.0_wp ) THEN
6478	root2 = 0.0_wp
6479	ENDIF
6480	!
6481	!-- Calculate the new hydrogen ion, bisulphate ion and sulphate ion
6482	!-- concentration
6483	hso4_real = 0.0_wp
6484	h_real = ions(1)
6485	so4_real = ions(4)
6486	IF ( root1 == 0.0_wp ) THEN
6487	hso4_real = root2
6488	ELSEIF ( root2 == 0.0_wp ) THEN
6489	hso4_real = root1
6490	ENDIF
6491	h_real = ions(1) - hso4_real
6492	so4_real = ions(4) - hso4_real
6493	!
6494	!-- Recalculate ion molalities
6495	ions_mol(1) = h_real / ( water_total * 18.01528E-3_wp ) ! H+
6496	ions_mol(4) = so4_real / ( water_total * 18.01528E-3_wp ) ! SO4(2-)
6497	ions_mol(5) = hso4_real / ( water_total * 18.01528E-3_wp ) ! HSO4(2-)
6498
6499	h_out = h_real
6500	hso4_out = hso4_real
6501	so4_out = so4_real
6502
6503	ELSEIF ( ions(1) == 0.0_wp .OR. ions(4) == 0.0_wp ) THEN
6504	h_out = ions(1)
6505	hso4_out = 0.0_wp
6506	so4_out = ions(4)
6507	ENDIF
6508
6509	!
6510	!-- 4) ACTIVITY COEFFICIENTS -for vapour pressures of HNO3,HCL and NH3
6511	!
6512	!-- This section evaluates activity coefficients and vapour pressures using the
6513	!-- water content calculated above) for each inorganic condensing species:
6514	!-- a - HNO3, b - NH3, c - HCL.
6515	!-- The following procedure is used:
6516	!-- Zaveri et al (2005) found that one could express the variation of activity
6517	!-- coefficients linearly in log-space if equivalent mole fractions were used.
6518	!-- So, by a taylor series expansion LOG( activity coefficient ) =
6519	!-- LOG( binary activity coefficient at a given RH ) +
6520	!-- (equivalent mole fraction compound A) *
6521	!-- ('interaction' parameter between A and condensing species) +
6522	!-- equivalent mole fraction compound B) *
6523	!-- ('interaction' parameter between B and condensing species).
6524	!-- Here, the interaction parameters have been fit to ADDEM by searching the
6525	!-- whole compositon space and fit usign the Levenberg-Marquardt non-linear
6526	!-- least squares algorithm.
6527	!
6528	!-- They are given as a function of RH and vary with complexity ranging from
6529	!-- linear to 5th order polynomial expressions, the binary activity coefficients
6530	!-- were calculated using AIM online.
6531	!-- NOTE: for NH3, no binary activity coefficient was used and the data were fit
6532	!-- to the ratio of the activity coefficients for the ammonium and hydrogen
6533	!-- ions. Once the activity coefficients are obtained the vapour pressure can be
6534	!-- easily calculated using tabulated equilibrium constants (referenced). This
6535	!-- procedure differs from that of Zaveri et al (2005) in that it is not assumed
6536	!-- one can carry behaviour from binary mixtures in multicomponent systems. To
6537	!-- this end we have fit the 'interaction' parameters explicitly to a general
6538	!-- inorganic equilibrium model (ADDEM - Topping et al. 2005a,b). Such
6539	!-- parameters take into account bisulphate ion dissociation and water content.
6540	!-- This also allows us to consider one regime for all composition space, rather
6541	!-- than defining sulphate rich and sulphate poor regimes
6542	!-- NOTE: The flags "binary_case" and "full_complexity" are not used in this
6543	!-- prototype. They are used for simplification of the fit expressions when
6544	!-- using limited composition regions.
6545	!
6546	!-- a) - ACTIVITY COEFF/VAPOUR PRESSURE - HNO3
6547	IF ( ions(1) > 0.0_wp .AND. ions(6) > 0.0_wp ) THEN
6548	binary_case = 1
6549	IF ( RH > 0.1_wp .AND. RH < 0.98_wp ) THEN
6550	IF ( binary_case == 1 ) THEN
6551	binary_hno3 = 1.8514_wp * ( RH*3 ) - 4.6991_wp ( RH**2 ) + &
6552	1.5514_wp * RH + 0.90236_wp
6553	ELSEIF ( binary_case == 2 ) THEN
6554	binary_hno3 = - 1.1751_wp * ( RH*2 ) - 0.53794_wp RH + &
6555	1.2808_wp
6556	ENDIF
6557	ELSEIF ( RH >= 0.98_wp .AND. RH < 0.9999_wp ) THEN
6558	binary_hno3 = 1244.69635941351_wp * ( RH**3 ) - &
6559	2613.93941099991_wp * ( RH**2 ) + &
6560	1525.0684974546_wp * RH -155.946764059316_wp
6561	ENDIF
6562	!
6563	!-- Contributions from other solutes
6564	full_complexity = 1
6565	IF ( hydrochloric_acid > 0.0_wp ) THEN ! HCL
6566	IF ( full_complexity == 1 .OR. RH < 0.4_wp ) THEN
6567	HCL_hno3 = 16.051_wp * ( RH*4 ) - 44.357_wp ( RH**3 ) + &
6568	45.141_wp * ( RH*2 ) - 21.638_wp RH + 4.8182_wp
6569	ELSEIF ( full_complexity == 0 .AND. RH > 0.4_wp ) THEN
6570	HCL_hno3 = - 1.5833_wp * RH + 1.5569_wp
6571	ENDIF
6572	ENDIF
6573
6574	IF ( sulphuric_acid > 0.0_wp ) THEN ! H2SO4
6575	IF ( full_complexity == 1 .OR. RH < 0.4_wp ) THEN
6576	H2SO4_hno3 = - 3.0849_wp * ( RH*3 ) + 5.9609_wp ( RH**2 ) - &
6577	4.468_wp * RH + 1.5658_wp
6578	ELSEIF ( full_complexity == 0 .AND. RH > 0.4_wp ) THEN
6579	H2SO4_hno3 = - 0.93473_wp * RH + 0.9363_wp
6580	ENDIF
6581	ENDIF
6582
6583	IF ( ammonium_sulphate > 0.0_wp ) THEN ! NH42SO4
6584	NH42SO4_hno3 = 16.821_wp * ( RH*3 ) - 28.391_wp ( RH**2 ) + &
6585	18.133_wp * RH - 6.7356_wp
6586	ENDIF
6587
6588	IF ( ammonium_nitrate > 0.0_wp ) THEN ! NH4NO3
6589	NH4NO3_hno3 = 11.01_wp * ( RH*3 ) - 21.578_wp ( RH**2 ) + &
6590	14.808_wp * RH - 4.2593_wp
6591	ENDIF
6592
6593	IF ( ammonium_chloride > 0.0_wp ) THEN ! NH4Cl
6594	IF ( full_complexity == 1 .OR. RH <= 0.4_wp ) THEN
6595	NH4Cl_hno3 = - 1.176_wp * ( RH*3 ) + 5.0828_wp ( RH**2 ) - &
6596	3.8792_wp * RH - 0.05518_wp
6597	ELSEIF ( full_complexity == 0 .AND. RH > 0.4_wp ) THEN
6598	NH4Cl_hno3 = 2.6219_wp * ( RH*2 ) - 2.2609_wp RH - 0.38436_wp
6599	ENDIF
6600	ENDIF
6601
6602	IF ( sodium_sulphate > 0.0_wp ) THEN ! Na2SO4
6603	Na2SO4_hno3 = 35.504_wp * ( RH*4 ) - 80.101_wp ( RH**3 ) + &
6604	67.326_wp * ( RH*2 ) - 28.461_wp RH + 5.6016_wp
6605	ENDIF
6606
6607	IF ( sodium_nitrate > 0.0_wp ) THEN ! NaNO3
6608	IF ( full_complexity == 1 .OR. RH <= 0.4_wp ) THEN
6609	NaNO3_hno3 = 23.659_wp * ( RH*5 ) - 66.917_wp ( RH**4 ) + &
6610	74.686_wp * ( RH*3 ) - 40.795_wp ( RH**2 ) + &
6611	10.831_wp * RH - 1.4701_wp
6612	ELSEIF ( full_complexity == 0 .AND. RH > 0.4_wp ) THEN
6613	NaNO3_hno3 = 14.749_wp * ( RH*4 ) - 35.237_wp ( RH**3 ) + &
6614	31.196_wp * ( RH*2 ) - 12.076_wp RH + 1.3605_wp
6615	ENDIF
6616	ENDIF
6617
6618	IF ( sodium_chloride > 0.0_wp ) THEN ! NaCl
6619	IF ( full_complexity == 1 .OR. RH <= 0.4_wp ) THEN
6620	NaCl_hno3 = 13.682_wp * ( RH*4 ) - 35.122_wp ( RH**3 ) + &
6621	33.397_wp * ( RH*2 ) - 14.586_wp RH + 2.6276_wp
6622	ELSEIF ( full_complexity == 0 .AND. RH > 0.4_wp ) THEN
6623	NaCl_hno3 = 1.1882_wp * ( RH*3 ) - 1.1037_wp ( RH**2 ) - &
6624	0.7642_wp * RH + 0.6671_wp
6625	ENDIF
6626	ENDIF
6627
6628	Ln_HNO3_act = binary_hno3 + &
6629	hydrochloric_acid_eq_frac * HCL_hno3 + &
6630	sulphuric_acid_eq_frac * H2SO4_hno3 + &
6631	ammonium_sulphate_eq_frac * NH42SO4_hno3 + &
6632	ammonium_nitrate_eq_frac * NH4NO3_hno3 + &
6633	ammonium_chloride_eq_frac * NH4Cl_hno3 + &
6634	sodium_sulphate_eq_frac * Na2SO4_hno3 + &
6635	sodium_nitrate_eq_frac * NaNO3_hno3 + &
6636	sodium_chloride_eq_frac * NaCl_hno3
6637
6638	gamma_hno3 = EXP( Ln_HNO3_act ) ! Molal activity coefficient of HNO3
6639	gamma_out(1) = gamma_hno3
6640	!
6641	!-- Partial pressure calculation
6642	!-- K_hno3 = 2.51 * ( 10**6 )
6643	!-- K_hno3 = 2.628145923d6 !< calculated by AIM online (Clegg et al 1998)
6644	!-- after Chameides (1984) (and NIST database)
6645	K_hno3 = 2.6E6_wp * EXP( 8700.0_wp * henrys_temp_dep)
6646	Press_HNO3 = ( ions_mol(1) * ions_mol(6) * ( gamma_hno3**2 ) ) / &
6647	K_hno3
6648	ENDIF
6649	!
6650	!-- b) - ACTIVITY COEFF/VAPOUR PRESSURE - NH3
6651	!-- Follow the two solute approach of Zaveri et al. (2005)
6652	IF ( ions(2) > 0.0_wp .AND. ions_mol(1) > 0.0_wp ) THEN
6653	!-- NH4HSO4:
6654	binary_nh4hso4 = 56.907_wp * ( RH*6 ) - 155.32_wp ( RH**5 ) + &
6655	142.94_wp * ( RH*4 ) - 32.298_wp ( RH**3 ) - &
6656	27.936_wp * ( RH*2 ) + 19.502_wp RH - 4.2618_wp
6657	IF ( nitric_acid > 0.0_wp) THEN ! HNO3
6658	HNO3_nh4hso4 = 104.8369_wp * ( RH*8 ) - 288.8923_wp ( RH**7 ) + &
6659	129.3445_wp * ( RH*6 ) + 373.0471_wp ( RH**5 ) - &
6660	571.0385_wp * ( RH*4 ) + 326.3528_wp ( RH**3 ) - &
6661	74.169_wp * ( RH*2 ) - 2.4999_wp RH + 3.17_wp
6662	ENDIF
6663
6664	IF ( hydrochloric_acid > 0.0_wp) THEN ! HCL
6665	HCL_nh4hso4 = - 7.9133_wp * ( RH*8 ) + 126.6648_wp ( RH**7 ) - &
6666	460.7425_wp * ( RH*6 ) + 731.606_wp ( RH**5 ) - &
6667	582.7467_wp * ( RH*4 ) + 216.7197_wp ( RH**3 ) - &
6668	11.3934_wp * ( RH*2 ) - 17.7728_wp RH + 5.75_wp
6669	ENDIF
6670
6671	IF ( sulphuric_acid > 0.0_wp) THEN ! H2SO4
6672	H2SO4_nh4hso4 = 195.981_wp * ( RH*8 ) - 779.2067_wp ( RH**7 ) + &
6673	1226.3647_wp * ( RH*6 ) - 964.0261_wp ( RH**5 ) + &
6674	391.7911_wp * ( RH*4 ) - 84.1409_wp ( RH**3 ) + &
6675	20.0602_wp * ( RH*2 ) - 10.2663_wp RH + 3.5817_wp
6676	ENDIF
6677
6678	IF ( ammonium_sulphate > 0.0_wp) THEN ! NH42SO4
6679	NH42SO4_nh4hso4 = 617.777_wp * ( RH*8 ) - 2547.427_wp ( RH**7 ) &
6680	+ 4361.6009_wp * ( RH*6 ) - 4003.162_wp ( RH**5 ) &
6681	+ 2117.8281_wp * ( RH*4 ) - 640.0678_wp ( RH**3 ) &
6682	+ 98.0902_wp * ( RH*2 ) - 2.2615_wp RH - 2.3811_wp
6683	ENDIF
6684
6685	IF ( ammonium_nitrate > 0.0_wp) THEN ! NH4NO3
6686	NH4NO3_nh4hso4 = - 104.4504_wp * ( RH*8 ) + 539.5921_wp &
6687	( RH*7 ) - 1157.0498_wp ( RH*6 ) + 1322.4507_wp &
6688	( RH*5 ) - 852.2475_wp ( RH*4 ) + 298.3734_wp &
6689	( RH*3 ) - 47.0309_wp ( RH*2 ) + 1.297_wp RH - &
6690	0.8029_wp
6691	ENDIF
6692
6693	IF ( ammonium_chloride > 0.0_wp) THEN ! NH4Cl
6694	NH4Cl_nh4hso4 = 258.1792_wp * ( RH*8 ) - 1019.3777_wp &
6695	( RH*7 ) + 1592.8918_wp ( RH*6 ) - 1221.0726_wp &
6696	( RH*5 ) + 442.2548_wp ( RH*4 ) - 43.6278_wp &
6697	( RH*3 ) - 7.5282_wp ( RH*2 ) - 3.8459_wp RH + 2.2728_wp
6698	ENDIF
6699
6700	IF ( sodium_sulphate > 0.0_wp) THEN ! Na2SO4
6701	Na2SO4_nh4hso4 = 225.4238_wp * ( RH*8 ) - 732.4113_wp &
6702	( RH*7 ) + 843.7291_wp ( RH*6 ) - 322.7328_wp &
6703	( RH*5 ) - 88.6252_wp ( RH*4 ) + 72.4434_wp &
6704	( RH*3 ) + 22.9252_wp ( RH*2 ) - 25.3954_wp RH + &
6705	4.6971_wp
6706	ENDIF
6707
6708	IF ( sodium_nitrate > 0.0_wp) THEN ! NaNO3
6709	NaNO3_nh4hso4 = 96.1348_wp * ( RH*8 ) - 341.6738_wp ( RH**7 ) + &
6710	406.5314_wp * ( RH*6 ) - 98.5777_wp ( RH**5 ) - &
6711	172.8286_wp * ( RH*4 ) + 149.3151_wp ( RH**3 ) - &
6712	38.9998_wp * ( RH*2 ) - 0.2251 RH + 0.4953_wp
6713	ENDIF
6714
6715	IF ( sodium_chloride > 0.0_wp) THEN ! NaCl
6716	NaCl_nh4hso4 = 91.7856_wp * ( RH*8 ) - 316.6773_wp ( RH**7 ) + &
6717	358.2703_wp * ( RH*6 ) - 68.9142 ( RH**5 ) - &
6718	156.5031_wp * ( RH*4 ) + 116.9592_wp ( RH**3 ) - &
6719	22.5271_wp * ( RH*2 ) - 3.7716_wp RH + 1.56_wp
6720	ENDIF
6721
6722	Ln_NH4HSO4_act = binary_nh4hso4 + &
6723	nitric_acid_eq_frac * HNO3_nh4hso4 + &
6724	hydrochloric_acid_eq_frac * HCL_nh4hso4 + &
6725	sulphuric_acid_eq_frac * H2SO4_nh4hso4 + &
6726	ammonium_sulphate_eq_frac * NH42SO4_nh4hso4 + &
6727	ammonium_nitrate_eq_frac * NH4NO3_nh4hso4 + &
6728	ammonium_chloride_eq_frac * NH4Cl_nh4hso4 + &
6729	sodium_sulphate_eq_frac * Na2SO4_nh4hso4 + &
6730	sodium_nitrate_eq_frac * NaNO3_nh4hso4 + &
6731	sodium_chloride_eq_frac * NaCl_nh4hso4
6732
6733	gamma_nh4hso4 = EXP( Ln_NH4HSO4_act ) ! molal act. coefficient of NH4HSO4
6734	!-- Molal activity coefficient of NO3-
6735	gamma_out(6) = gamma_nh4hso4
6736	!-- Molal activity coefficient of NH4+
6737	gamma_nh3 = ( gamma_nh4hso42 ) / ( gamma_hhso42 )
6738	gamma_out(3) = gamma_nh3
6739	!
6740	!-- This actually represents the ratio of the ammonium to hydrogen ion
6741	!-- activity coefficients (see Zaveri paper) - multiply this by the ratio
6742	!-- of the ammonium to hydrogen ion molality and the ratio of appropriate
6743	!-- equilibrium constants
6744	!
6745	!-- Equilibrium constants
6746	!-- Kh = 57.64d0 ! Zaveri et al. (2005)
6747	Kh = 5.8E1_wp * EXP( 4085.0_wp * henrys_temp_dep ) ! after Chameides
6748	! ! (1984) (and NIST database)
6749	!-- Knh4 = 1.81E-5_wp ! Zaveri et al. (2005)
6750	Knh4 = 1.7E-5_wp * EXP( -4325.0_wp * henrys_temp_dep ) ! Chameides
6751	! (1984)
6752	!-- Kw = 1.01E-14_wp ! Zaveri et al (2005)
6753	Kw = 1.E-14_wp * EXP( -6716.0_wp * henrys_temp_dep ) ! Chameides
6754	! (1984)
6755	!
6756	molality_ratio_nh3 = ions_mol(2) / ions_mol(1)
6757	!-- Partial pressure calculation
6758	Press_NH3 = molality_ratio_nh3 * gamma_nh3 * ( Kw / ( Kh * Knh4 ) )
6759
6760	ENDIF
6761	!
6762	!-- c) - ACTIVITY COEFF/VAPOUR PRESSURE - HCL
6763	IF ( ions(1) > 0.0_wp .AND. ions(7) > 0.0_wp ) THEN
6764	binary_case = 1
6765	IF ( RH > 0.1_wp .AND. RH < 0.98 ) THEN
6766	IF ( binary_case == 1 ) THEN
6767	binary_hcl = - 5.0179_wp * ( RH*3 ) + 9.8816_wp ( RH**2 ) - &
6768	10.789_wp * RH + 5.4737_wp
6769	ELSEIF ( binary_case == 2 ) THEN
6770	binary_hcl = - 4.6221_wp * RH + 4.2633_wp
6771	ENDIF
6772	ELSEIF ( RH >= 0.98_wp .AND. RH < 0.9999_wp ) THEN
6773	binary_hcl = 775.6111008626_wp * ( RH*3 ) - 2146.01320888771_wp &
6774	( RH*2 ) + 1969.01979670259_wp RH - 598.878230033926_wp
6775	ENDIF
6776	ENDIF
6777
6778	IF ( nitric_acid > 0.0_wp ) THEN ! HNO3
6779	IF ( full_complexity == 1 .OR. RH <= 0.4_wp ) THEN
6780	HNO3_hcl = 9.6256_wp * ( RH*4 ) - 26.507_wp ( RH**3 ) + &
6781	27.622_wp * ( RH*2 ) - 12.958_wp RH + 2.2193_wp
6782	ELSEIF ( full_complexity == 0 .AND. RH > 0.4_wp ) THEN
6783	HNO3_hcl = 1.3242_wp * ( RH*2 ) - 1.8827_wp RH + 0.55706_wp
6784	ENDIF
6785	ENDIF
6786
6787	IF ( sulphuric_acid > 0.0_wp ) THEN ! H2SO4
6788	IF ( full_complexity == 1 .OR. RH <= 0.4 ) THEN
6789	H2SO4_hcl = 1.4406_wp * ( RH*3 ) - 2.7132_wp ( RH**2 ) + &
6790	1.014_wp * RH + 0.25226_wp
6791	ELSEIF ( full_complexity == 0 .AND. RH > 0.4_wp ) THEN
6792	H2SO4_hcl = 0.30993_wp * ( RH*2 ) - 0.99171_wp RH + 0.66913_wp
6793	ENDIF
6794	ENDIF
6795
6796	IF ( ammonium_sulphate > 0.0_wp ) THEN ! NH42SO4
6797	NH42SO4_hcl = 22.071_wp * ( RH*3 ) - 40.678_wp ( RH**2 ) + &
6798	27.893_wp * RH - 9.4338_wp
6799	ENDIF
6800
6801	IF ( ammonium_nitrate > 0.0_wp ) THEN ! NH4NO3
6802	NH4NO3_hcl = 19.935_wp * ( RH*3 ) - 42.335_wp ( RH**2 ) + &
6803	31.275_wp * RH - 8.8675_wp
6804	ENDIF
6805
6806	IF ( ammonium_chloride > 0.0_wp ) THEN ! NH4Cl
6807	IF ( full_complexity == 1 .OR. RH <= 0.4_wp ) THEN
6808	NH4Cl_hcl = 2.8048_wp * ( RH*3 ) - 4.3182_wp ( RH**2 ) + &
6809	3.1971_wp * RH - 1.6824_wp
6810	ELSEIF ( full_complexity == 0 .AND. RH > 0.4_wp ) THEN
6811	NH4Cl_hcl = 1.2304_wp * ( RH*2 ) - 0.18262_wp RH - 1.0643_wp
6812	ENDIF
6813	ENDIF
6814
6815	IF ( sodium_sulphate > 0.0_wp ) THEN ! Na2SO4
6816	Na2SO4_hcl = 36.104_wp * ( RH*4 ) - 78.658_wp ( RH**3 ) + &
6817	63.441_wp * ( RH*2 ) - 26.727_wp RH + 5.7007_wp
6818	ENDIF
6819
6820	IF ( sodium_nitrate > 0.0_wp ) THEN ! NaNO3
6821	IF ( full_complexity == 1 .OR. RH <= 0.4_wp ) THEN
6822	NaNO3_hcl = 54.471_wp * ( RH*5 ) - 159.42_wp ( RH**4 ) + &
6823	180.25_wp * ( RH*3 ) - 98.176_wp ( RH**2 ) + &
6824	25.309_wp * RH - 2.4275_wp
6825	ELSEIF ( full_complexity == 0 .AND. RH > 0.4_wp ) THEN
6826	NaNO3_hcl = 21.632_wp * ( RH*4 ) - 53.088_wp ( RH**3 ) + &
6827	47.285_wp * ( RH*2 ) - 18.519_wp RH + 2.6846_wp
6828	ENDIF
6829	ENDIF
6830
6831	IF ( sodium_chloride > 0.0_wp ) THEN ! NaCl
6832	IF ( full_complexity == 1 .OR. RH <= 0.4_wp ) THEN
6833	NaCl_hcl = 5.4138_wp * ( RH*4 ) - 12.079_wp ( RH**3 ) + &
6834	9.627_wp * ( RH*2 ) - 3.3164_wp RH + 0.35224_wp
6835	ELSEIF ( full_complexity == 0 .AND. RH > 0.4_wp ) THEN
6836	NaCl_hcl = 2.432_wp * ( RH*3 ) - 4.3453_wp ( RH**2 ) + &
6837	2.3834_wp * RH - 0.4762_wp
6838	ENDIF
6839	ENDIF
6840
6841	Ln_HCL_act = binary_hcl + &
6842	nitric_acid_eq_frac * HNO3_hcl + &
6843	sulphuric_acid_eq_frac * H2SO4_hcl + &
6844	ammonium_sulphate_eq_frac * NH42SO4_hcl + &
6845	ammonium_nitrate_eq_frac * NH4NO3_hcl + &
6846	ammonium_chloride_eq_frac * NH4Cl_hcl + &
6847	sodium_sulphate_eq_frac * Na2SO4_hcl + &
6848	sodium_nitrate_eq_frac * NaNO3_hcl + &
6849	sodium_chloride_eq_frac * NaCl_hcl
6850
6851	gamma_hcl = EXP( Ln_HCL_act ) ! Molal activity coefficient
6852	gamma_out(2) = gamma_hcl
6853	!
6854	!-- Equilibrium constant after Wagman et al. (1982) (and NIST database)
6855	K_hcl = 2E6_wp * EXP( 9000.0_wp * henrys_temp_dep )
6856
6857	Press_HCL = ( ions_mol(1) * ions_mol(7) * ( gamma_hcl**2 ) ) / K_hcl
6858	!
6859	!-- 5) Ion molility output
6860	mols_out = ions_mol
6861	!
6862	!-- REFERENCES
6863	!-- Clegg et al. (1998) A Thermodynamic Model of the System
6864	!-- H+-NH4+-Na+-SO42- -NO3--Cl--H2O at 298.15 K, J. Phys. Chem., 102A,
6865	!-- 2155-2171.
6866	!-- Clegg et al. (2001) Thermodynamic modelling of aqueous aerosols containing
6867	!-- electrolytes and dissolved organic compounds. Journal of Aerosol Science
6868	!-- 2001;32(6):713-738.
6869	!-- Topping et al. (2005a) A curved multi-component aerosol hygroscopicity model
6870	!-- framework: Part 1 - Inorganic compounds. Atmospheric Chemistry and
6871	!-- Physics 2005;5:1205-1222.
6872	!-- Topping et al. (2005b) A curved multi-component aerosol hygroscopicity model
6873	!-- framework: Part 2 - Including organic compounds. Atmospheric Chemistry
6874	!-- and Physics 2005;5:1223-1242.
6875	!-- Wagman et al. (1982). The NBS tables of chemical thermodynamic properties:
6876	!-- selected values for inorganic and Câ and Câ organic substances in SI
6877	!-- units (book)
6878	!-- Zaveri et al. (2005). A new method for multicomponent activity coefficients
6879	!-- of electrolytes in aqueous atmospheric aerosols, JGR, 110, D02201, 2005.
6880	END SUBROUTINE inorganic_pdfite
6881
6882	!------------------------------------------------------------------------------!
6883	! Description:
6884	! ------------
6885	!> Update the particle size distribution. Put particles into corrects bins.
6886	!>
6887	!> Moving-centre method assumed, i.e. particles are allowed to grow to their
6888	!> exact size as long as they are not crossing the fixed diameter bin limits.
6889	!> If the particles in a size bin cross the lower or upper diameter limit, they
6890	!> are all moved to the adjacent diameter bin and their volume is averaged with
6891	!> the particles in the new bin, which then get a new diameter.
6892	!
6893	!> Moving-centre method minimises numerical diffusion.
6894	!------------------------------------------------------------------------------!
6895	SUBROUTINE distr_update( paero )
6896
6897	IMPLICIT NONE
6898
6899	!-- Input and output variables
6900	TYPE(t_section), INTENT(inout) :: paero(fn2b) !< Aerosols particle
6901	!< size distribution and properties
6902	!-- Local variables
6903	INTEGER(iwp) :: b !< loop index
6904	INTEGER(iwp) :: mm !< loop index
6905	INTEGER(iwp) :: counti
6906	LOGICAL :: within_bins !< logical (particle belongs to the bin?)
6907	REAL(wp) :: znfrac !< number fraction to be moved to the larger bin
6908	REAL(wp) :: zvfrac !< volume fraction to be moved to the larger bin
6909	REAL(wp) :: zVexc !< Volume in the grown bin which exceeds the bin
6910	!< upper limit
6911	REAL(wp) :: zVihi !< particle volume at the high end of the bin
6912	REAL(wp) :: zVilo !< particle volume at the low end of the bin
6913	REAL(wp) :: zvpart !< particle volume (m3)
6914	REAL(wp) :: zVrat !< volume ratio of a size bin
6915
6916	zvpart = 0.0_wp
6917	zvfrac = 0.0_wp
6918
6919	within_bins = .FALSE.
6920
6921	!
6922	!-- Check if the volume of the bin is within bin limits after update
6923	counti = 0
6924	DO WHILE ( .NOT. within_bins )
6925	within_bins = .TRUE.
6926
6927	DO b = fn2b-1, in1a, -1
6928	mm = 0
6929	IF ( paero(b)%numc > nclim ) THEN
6930
6931	zvpart = 0.0_wp
6932	zvfrac = 0.0_wp
6933
6934	IF ( b == fn2a ) CYCLE
6935	!
6936	!-- Dry volume
6937	zvpart = SUM( paero(b)%volc(1:7) ) / paero(b)%numc
6938	!
6939	!-- Smallest bin cannot decrease
6940	IF ( paero(b)%vlolim > zvpart .AND. b == in1a ) CYCLE
6941	!
6942	!-- Decreasing bins
6943	IF ( paero(b)%vlolim > zvpart ) THEN
6944	mm = b - 1
6945	IF ( b == in2b ) mm = fn1a ! 2b goes to 1a
6946
6947	paero(mm)%numc = paero(mm)%numc + paero(b)%numc
6948	paero(b)%numc = 0.0_wp
6949	paero(mm)%volc(:) = paero(mm)%volc(:) + paero(b)%volc(:)
6950	paero(b)%volc(:) = 0.0_wp
6951	CYCLE
6952	ENDIF
6953	!
6954	!-- If size bin has not grown, cycle
6955	!-- Changed by Mona: compare to the arithmetic mean volume, as done
6956	!-- originally. Now particle volume is derived from the geometric mean
6957	!-- diameter, not arithmetic (see SUBROUTINE set_sizebins).
6958	IF ( zvpart <= api6 * ( ( aero(b)%vhilim + aero(b)%vlolim ) / &
6959	( 2.0_wp * api6 ) ) ) CYCLE
6960	IF ( ABS( zvpart - api6 * paero(b)%dmid ** 3.0_wp ) < &
6961	1.0E-35_wp ) CYCLE ! Mona: to avoid precision problems
6962	!
6963	!-- Volume ratio of the size bin
6964	zVrat = paero(b)%vhilim / paero(b)%vlolim
6965	!-- Particle volume at the low end of the bin
6966	zVilo = 2.0_wp * zvpart / ( 1.0_wp + zVrat )
6967	!-- Particle volume at the high end of the bin
6968	zVihi = zVrat * zVilo
6969	!-- Volume in the grown bin which exceeds the bin upper limit
6970	zVexc = 0.5_wp * ( zVihi + paero(b)%vhilim )
6971	!-- Number fraction to be moved to the larger bin
6972	znfrac = MIN( 1.0_wp, ( zVihi - paero(b)%vhilim) / &
6973	( zVihi - zVilo ) )
6974	!-- Volume fraction to be moved to the larger bin
6975	zvfrac = MIN( 0.99_wp, znfrac * zVexc / zvpart )
6976	IF ( zvfrac < 0.0_wp ) THEN
6977	message_string = 'Error: zvfrac < 0'
6978	CALL message( 'salsa_mod: distr_update', 'SA0050', &
6979	1, 2, 0, 6, 0 )
6980	ENDIF
6981	!
6982	!-- Update bin
6983	mm = b + 1
6984	!-- Volume (cm3/cm3)
6985	paero(mm)%volc(:) = paero(mm)%volc(:) + znfrac * paero(b)%numc * &
6986	zVexc * paero(b)%volc(:) / &
6987	SUM( paero(b)%volc(1:7) )
6988	paero(b)%volc(:) = paero(b)%volc(:) - znfrac * paero(b)%numc * &
6989	zVexc * paero(b)%volc(:) / &
6990	SUM( paero(b)%volc(1:7) )
6991
6992	!-- Number concentration (#/m3)
6993	paero(mm)%numc = paero(mm)%numc + znfrac * paero(b)%numc
6994	paero(b)%numc = paero(b)%numc * ( 1.0_wp - znfrac )
6995
6996	ENDIF ! nclim
6997
6998	IF ( paero(b)%numc > nclim ) THEN
6999	zvpart = SUM( paero(b)%volc(1:7) ) / paero(b)%numc
7000	within_bins = ( paero(b)%vlolim < zvpart .AND. &
7001	zvpart < paero(b)%vhilim )
7002	ENDIF
7003
7004	ENDDO ! - b
7005
7006	counti = counti + 1
7007	IF ( counti > 100 ) THEN
7008	message_string = 'Error: Aerosol bin update not converged'
7009	CALL message( 'salsa_mod: distr_update', 'SA0051', 1, 2, 0, 6, 0 )
7010	ENDIF
7011
7012	ENDDO ! - within bins
7013
7014	END SUBROUTINE distr_update
7015
7016	!------------------------------------------------------------------------------!
7017	! Description:
7018	! ------------
7019	!> salsa_diagnostics: Update properties for the current timestep:
7020	!>
7021	!> Juha Tonttila, FMI, 2014
7022	!> Tomi Raatikainen, FMI, 2016
7023	!------------------------------------------------------------------------------!
7024	SUBROUTINE salsa_diagnostics( i, j )
7025
7026	USE arrays_3d, &
7027	ONLY: p, pt, zu
7028
7029	USE basic_constants_and_equations_mod, &
7030	ONLY: g
7031
7032	USE control_parameters, &
7033	ONLY: pt_surface, surface_pressure
7034
7035	USE cpulog, &
7036	ONLY: cpu_log, log_point_s
7037
7038	IMPLICIT NONE
7039
7040	INTEGER(iwp), INTENT(in) :: i !<
7041	INTEGER(iwp), INTENT(in) :: j !<
7042
7043	INTEGER(iwp) :: b !<
7044	INTEGER(iwp) :: c !<
7045	INTEGER(iwp) :: gt !<
7046	INTEGER(iwp) :: k !<
7047	INTEGER(iwp) :: nc !<
7048	REAL(wp), DIMENSION(nzb:nzt+1) :: flag !< flag to mask topography
7049	REAL(wp), DIMENSION(nzb:nzt+1) :: flag_zddry !< flag to mask zddry
7050	REAL(wp), DIMENSION(nzb:nzt+1) :: in_adn !< air density (kg/m3)
7051	REAL(wp), DIMENSION(nzb:nzt+1) :: in_p !< pressure
7052	REAL(wp), DIMENSION(nzb:nzt+1) :: in_t !< temperature (K)
7053	REAL(wp), DIMENSION(nzb:nzt+1) :: mcsum !< sum of mass concentration
7054	REAL(wp), DIMENSION(nzb:nzt+1) :: ppm_to_nconc !< Conversion factor
7055	!< from ppm to #/m3
7056	REAL(wp), DIMENSION(nzb:nzt+1) :: zddry !<
7057	REAL(wp), DIMENSION(nzb:nzt+1) :: zvol !<
7058
7059	flag_zddry = 0.0_wp
7060	in_adn = 0.0_wp
7061	in_p = 0.0_wp
7062	in_t = 0.0_wp
7063	ppm_to_nconc = 1.0_wp
7064	zddry = 0.0_wp
7065	zvol = 0.0_wp
7066
7067	CALL cpu_log( log_point_s(94), 'salsa diagnostics ', 'start' )
7068
7069	!
7070	!-- Calculate thermodynamic quantities needed in SALSA
7071	CALL salsa_thrm_ij( i, j, p_ij=in_p, temp_ij=in_t, adn_ij=in_adn )
7072	!
7073	!-- Calculate conversion factors for gas concentrations
7074	ppm_to_nconc = for_ppm_to_nconc * in_p / in_t
7075	!
7076	!-- Predetermine flag to mask topography
7077	flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_0(:,j,i), 0 ) )
7078
7079	DO b = 1, nbins ! aerosol size bins
7080	!
7081	!-- Remove negative values
7082	aerosol_number(b)%conc(:,j,i) = MAX( nclim, &
7083	aerosol_number(b)%conc(:,j,i) ) * flag
7084	mcsum = 0.0_wp ! total mass concentration
7085	DO c = 1, ncc_tot
7086	!
7087	!-- Remove negative concentrations
7088	aerosol_mass((c-1)*nbins+b)%conc(:,j,i) = MAX( mclim, &
7089	aerosol_mass((c-1)*nbins+b)%conc(:,j,i) ) &
7090	* flag
7091	mcsum = mcsum + aerosol_mass((c-1)nbins+b)%conc(:,j,i) flag
7092	ENDDO
7093	!
7094	!-- Check that number and mass concentration match qualitatively
7095	IF ( ANY ( aerosol_number(b)%conc(:,j,i) > nclim .AND. &
7096	mcsum <= 0.0_wp ) ) &
7097	THEN
7098	DO k = nzb+1, nzt
7099	IF ( aerosol_number(b)%conc(k,j,i) > nclim .AND. &
7100	mcsum(k) <= 0.0_wp ) &
7101	THEN
7102	aerosol_number(b)%conc(k,j,i) = nclim * flag(k)
7103	DO c = 1, ncc_tot
7104	aerosol_mass((c-1)nbins+b)%conc(k,j,i) = mclim flag(k)
7105	ENDDO
7106	ENDIF
7107	ENDDO
7108	ENDIF
7109	!
7110	!-- Update aerosol particle radius
7111	CALL bin_mixrat( 'dry', b, i, j, zvol )
7112	zvol = zvol / arhoh2so4 ! Why on sulphate?
7113	!
7114	!-- Particles smaller then 0.1 nm diameter are set to zero
7115	zddry = ( zvol / MAX( nclim, aerosol_number(b)%conc(:,j,i) ) / api6 )** &
7116	( 1.0_wp / 3.0_wp )
7117	flag_zddry = MERGE( 1.0_wp, 0.0_wp, ( zddry < 1.0E-10_wp .AND. &
7118	aerosol_number(b)%conc(:,j,i) > nclim ) )
7119	!
7120	!-- Volatile species to the gas phase
7121	IF ( is_used( prtcl, 'SO4' ) .AND. lscndgas ) THEN
7122	nc = get_index( prtcl, 'SO4' )
7123	c = ( nc - 1 ) * nbins + b
7124	IF ( salsa_gases_from_chem ) THEN
7125	chem_species( gas_index_chem(1) )%conc(:,j,i) = &
7126	chem_species( gas_index_chem(1) )%conc(:,j,i) + &
7127	aerosol_mass(c)%conc(:,j,i) * avo * flag * &
7128	flag_zddry / ( amh2so4 * ppm_to_nconc )
7129	ELSE
7130	salsa_gas(1)%conc(:,j,i) = salsa_gas(1)%conc(:,j,i) + &
7131	aerosol_mass(c)%conc(:,j,i) / amh2so4 *&
7132	avo * flag * flag_zddry
7133	ENDIF
7134	ENDIF
7135	IF ( is_used( prtcl, 'OC' ) .AND. lscndgas ) THEN
7136	nc = get_index( prtcl, 'OC' )
7137	c = ( nc - 1 ) * nbins + b
7138	IF ( salsa_gases_from_chem ) THEN
7139	chem_species( gas_index_chem(5) )%conc(:,j,i) = &
7140	chem_species( gas_index_chem(5) )%conc(:,j,i) + &
7141	aerosol_mass(c)%conc(:,j,i) * avo * flag * &
7142	flag_zddry / ( amoc * ppm_to_nconc )
7143	ELSE
7144	salsa_gas(5)%conc(:,j,i) = salsa_gas(5)%conc(:,j,i) + &
7145	aerosol_mass(c)%conc(:,j,i) / amoc * &
7146	avo * flag * flag_zddry
7147	ENDIF
7148	ENDIF
7149	IF ( is_used( prtcl, 'NO' ) .AND. lscndgas ) THEN
7150	nc = get_index( prtcl, 'NO' )
7151	c = ( nc - 1 ) * nbins + b
7152	IF ( salsa_gases_from_chem ) THEN
7153	chem_species( gas_index_chem(2) )%conc(:,j,i) = &
7154	chem_species( gas_index_chem(2) )%conc(:,j,i) + &
7155	aerosol_mass(c)%conc(:,j,i) * avo * flag * &
7156	flag_zddry / ( amhno3 * ppm_to_nconc )
7157	ELSE
7158	salsa_gas(2)%conc(:,j,i) = salsa_gas(2)%conc(:,j,i) + &
7159	aerosol_mass(c)%conc(:,j,i) / amhno3 * &
7160	avo * flag * flag_zddry
7161	ENDIF
7162	ENDIF
7163	IF ( is_used( prtcl, 'NH' ) .AND. lscndgas ) THEN
7164	nc = get_index( prtcl, 'NH' )
7165	c = ( nc - 1 ) * nbins + b
7166	IF ( salsa_gases_from_chem ) THEN
7167	chem_species( gas_index_chem(3) )%conc(:,j,i) = &
7168	chem_species( gas_index_chem(3) )%conc(:,j,i) + &
7169	aerosol_mass(c)%conc(:,j,i) * avo * flag * &
7170	flag_zddry / ( amnh3 * ppm_to_nconc )
7171	ELSE
7172	salsa_gas(3)%conc(:,j,i) = salsa_gas(3)%conc(:,j,i) + &
7173	aerosol_mass(c)%conc(:,j,i) / amnh3 * &
7174	avo * flag * flag_zddry
7175	ENDIF
7176	ENDIF
7177	!
7178	!-- Mass and number to zero (insoluble species and water are lost)
7179	DO c = 1, ncc_tot
7180	aerosol_mass((c-1)nbins+b)%conc(:,j,i) = MERGE( mclim flag, &
7181	aerosol_mass((c-1)*nbins+b)%conc(:,j,i), &
7182	flag_zddry > 0.0_wp )
7183	ENDDO
7184	aerosol_number(b)%conc(:,j,i) = MERGE( nclim * flag, &
7185	aerosol_number(b)%conc(:,j,i), &
7186	flag_zddry > 0.0_wp )
7187	Ra_dry(:,j,i,b) = MAX( 1.0E-10_wp, 0.5_wp * zddry )
7188
7189	ENDDO
7190	IF ( .NOT. salsa_gases_from_chem ) THEN
7191	DO gt = 1, ngast
7192	salsa_gas(gt)%conc(:,j,i) = MAX( nclim, salsa_gas(gt)%conc(:,j,i) ) &
7193	* flag
7194	ENDDO
7195	ENDIF
7196
7197	CALL cpu_log( log_point_s(94), 'salsa diagnostics ', 'stop' )
7198
7199	END SUBROUTINE salsa_diagnostics
7200
7201
7202	!
7203	!------------------------------------------------------------------------------!
7204	! Description:
7205	! ------------
7206	!> Calculate the tendencies for aerosol number and mass concentrations.
7207	!> Cache-optimized.
7208	!------------------------------------------------------------------------------!
7209	SUBROUTINE salsa_tendency_ij( id, rs_p, rs, trs_m, i, j, i_omp_start, tn, b, &
7210	c, flux_s, diss_s, flux_l, diss_l, rs_init )
7211
7212	USE advec_ws, &
7213	ONLY: advec_s_ws
7214	USE advec_s_pw_mod, &
7215	ONLY: advec_s_pw
7216	USE advec_s_up_mod, &
7217	ONLY: advec_s_up
7218	USE arrays_3d, &
7219	ONLY: ddzu, hyp, pt, rdf_sc, tend
7220	USE diffusion_s_mod, &
7221	ONLY: diffusion_s
7222	USE indices, &
7223	ONLY: wall_flags_0
7224	USE pegrid, &
7225	ONLY: threads_per_task, myid
7226	USE surface_mod, &
7227	ONLY : surf_def_h, surf_def_v, surf_lsm_h, surf_lsm_v, surf_usm_h, &
7228	surf_usm_v
7229
7230	IMPLICIT NONE
7231
7232	CHARACTER (LEN = *) :: id
7233	INTEGER(iwp) :: b !< bin index in derived type aerosol_size_bin
7234	INTEGER(iwp) :: c !< bin index in derived type aerosol_size_bin
7235	INTEGER(iwp) :: i !<
7236	INTEGER(iwp) :: i_omp_start !<
7237	INTEGER(iwp) :: j !<
7238	INTEGER(iwp) :: k !<
7239	INTEGER(iwp) :: nc !< (c-1)*nbins+b
7240	INTEGER(iwp) :: tn !<
7241	REAL(wp), DIMENSION(nzb+1:nzt,nys:nyn,0:threads_per_task-1) :: diss_l !<
7242	REAL(wp), DIMENSION(nzb+1:nzt,0:threads_per_task-1) :: diss_s !<
7243	REAL(wp), DIMENSION(nzb+1:nzt,nys:nyn,0:threads_per_task-1) :: flux_l !<
7244	REAL(wp), DIMENSION(nzb+1:nzt,0:threads_per_task-1) :: flux_s !<
7245	REAL(wp), DIMENSION(nzb:nzt+1) :: rs_init !<
7246	REAL(wp), DIMENSION(:,:,:), POINTER :: rs_p !<
7247	REAL(wp), DIMENSION(:,:,:), POINTER :: rs !<
7248	REAL(wp), DIMENSION(:,:,:), POINTER :: trs_m !<
7249
7250	nc = (c-1)*nbins+b
7251	!
7252	!-- Tendency-terms for reactive scalar
7253	tend(:,j,i) = 0.0_wp
7254
7255	IF ( id == 'aerosol_number' .AND. lod_aero == 3 ) THEN
7256	tend(:,j,i) = tend(:,j,i) + aerosol_number(b)%source(:,j,i)
7257	ELSEIF ( id == 'aerosol_mass' .AND. lod_aero == 3 ) THEN
7258	tend(:,j,i) = tend(:,j,i) + aerosol_mass(nc)%source(:,j,i)
7259	ENDIF
7260	!
7261	!-- Advection terms
7262	IF ( timestep_scheme(1:5) == 'runge' ) THEN
7263	IF ( ws_scheme_sca ) THEN
7264	CALL advec_s_ws( i, j, rs, id, flux_s, diss_s, flux_l, diss_l, &
7265	i_omp_start, tn )
7266	ELSE
7267	CALL advec_s_pw( i, j, rs )
7268	ENDIF
7269	ELSE
7270	CALL advec_s_up( i, j, rs )
7271	ENDIF
7272	!
7273	!-- Diffusion terms
7274	IF ( id == 'aerosol_number' ) THEN
7275	CALL diffusion_s( i, j, rs, surf_def_h(0)%answs(:,b), &
7276	surf_def_h(1)%answs(:,b), surf_def_h(2)%answs(:,b), &
7277	surf_lsm_h%answs(:,b), surf_usm_h%answs(:,b), &
7278	surf_def_v(0)%answs(:,b), surf_def_v(1)%answs(:,b), &
7279	surf_def_v(2)%answs(:,b), surf_def_v(3)%answs(:,b), &
7280	surf_lsm_v(0)%answs(:,b), surf_lsm_v(1)%answs(:,b), &
7281	surf_lsm_v(2)%answs(:,b), surf_lsm_v(3)%answs(:,b), &
7282	surf_usm_v(0)%answs(:,b), surf_usm_v(1)%answs(:,b), &
7283	surf_usm_v(2)%answs(:,b), surf_usm_v(3)%answs(:,b) )
7284	!
7285	!-- Sedimentation for aerosol number and mass
7286	IF ( lsdepo ) THEN
7287	tend(nzb+1:nzt,j,i) = tend(nzb+1:nzt,j,i) - MAX( 0.0_wp, &
7288	( rs(nzb+2:nzt+1,j,i) * sedim_vd(nzb+2:nzt+1,j,i,b) - &
7289	rs(nzb+1:nzt,j,i) * sedim_vd(nzb+1:nzt,j,i,b) ) * &
7290	ddzu(nzb+1:nzt) ) * MERGE( 1.0_wp, 0.0_wp, &
7291	BTEST( wall_flags_0(nzb:nzt-1,j,i), 0 ) )
7292	ENDIF
7293
7294	ELSEIF ( id == 'aerosol_mass' ) THEN
7295	CALL diffusion_s( i, j, rs, surf_def_h(0)%amsws(:,nc), &
7296	surf_def_h(1)%amsws(:,nc), surf_def_h(2)%amsws(:,nc), &
7297	surf_lsm_h%amsws(:,nc), surf_usm_h%amsws(:,nc), &
7298	surf_def_v(0)%amsws(:,nc), surf_def_v(1)%amsws(:,nc), &
7299	surf_def_v(2)%amsws(:,nc), surf_def_v(3)%amsws(:,nc), &
7300	surf_lsm_v(0)%amsws(:,nc), surf_lsm_v(1)%amsws(:,nc), &
7301	surf_lsm_v(2)%amsws(:,nc), surf_lsm_v(3)%amsws(:,nc), &
7302	surf_usm_v(0)%amsws(:,nc), surf_usm_v(1)%amsws(:,nc), &
7303	surf_usm_v(2)%amsws(:,nc), surf_usm_v(3)%amsws(:,nc) )
7304	!
7305	!-- Sedimentation for aerosol number and mass
7306	IF ( lsdepo ) THEN
7307	tend(nzb+1:nzt,j,i) = tend(nzb+1:nzt,j,i) - MAX( 0.0_wp, &
7308	( rs(nzb+2:nzt+1,j,i) * sedim_vd(nzb+2:nzt+1,j,i,b) - &
7309	rs(nzb+1:nzt,j,i) * sedim_vd(nzb+1:nzt,j,i,b) ) * &
7310	ddzu(nzb+1:nzt) ) * MERGE( 1.0_wp, 0.0_wp, &
7311	BTEST( wall_flags_0(nzb:nzt-1,j,i), 0 ) )
7312	ENDIF
7313	ELSEIF ( id == 'salsa_gas' ) THEN
7314	CALL diffusion_s( i, j, rs, surf_def_h(0)%gtsws(:,b), &
7315	surf_def_h(1)%gtsws(:,b), surf_def_h(2)%gtsws(:,b), &
7316	surf_lsm_h%gtsws(:,b), surf_usm_h%gtsws(:,b), &
7317	surf_def_v(0)%gtsws(:,b), surf_def_v(1)%gtsws(:,b), &
7318	surf_def_v(2)%gtsws(:,b), surf_def_v(3)%gtsws(:,b), &
7319	surf_lsm_v(0)%gtsws(:,b), surf_lsm_v(1)%gtsws(:,b), &
7320	surf_lsm_v(2)%gtsws(:,b), surf_lsm_v(3)%gtsws(:,b), &
7321	surf_usm_v(0)%gtsws(:,b), surf_usm_v(1)%gtsws(:,b), &
7322	surf_usm_v(2)%gtsws(:,b), surf_usm_v(3)%gtsws(:,b) )
7323	ENDIF
7324	!
7325	!-- Prognostic equation for a scalar
7326	DO k = nzb+1, nzt
7327	rs_p(k,j,i) = rs(k,j,i) + ( dt_3d * ( tsc(2) * tend(k,j,i) + &
7328	tsc(3) * trs_m(k,j,i) ) &
7329	- tsc(5) * rdf_sc(k) &
7330	* ( rs(k,j,i) - rs_init(k) ) ) &
7331	* MERGE( 1.0_wp, 0.0_wp, &
7332	BTEST( wall_flags_0(k,j,i), 0 ) )
7333	IF ( rs_p(k,j,i) < 0.0_wp ) rs_p(k,j,i) = 0.1_wp * rs(k,j,i)
7334	ENDDO
7335
7336	!
7337	!-- Calculate tendencies for the next Runge-Kutta step
7338	IF ( timestep_scheme(1:5) == 'runge' ) THEN
7339	IF ( intermediate_timestep_count == 1 ) THEN
7340	DO k = nzb+1, nzt
7341	trs_m(k,j,i) = tend(k,j,i)
7342	ENDDO
7343	ELSEIF ( intermediate_timestep_count < &
7344	intermediate_timestep_count_max ) THEN
7345	DO k = nzb+1, nzt
7346	trs_m(k,j,i) = -9.5625_wp * tend(k,j,i) + 5.3125_wp * trs_m(k,j,i)
7347	ENDDO
7348	ENDIF
7349	ENDIF
7350
7351	END SUBROUTINE salsa_tendency_ij
7352
7353	!
7354	!------------------------------------------------------------------------------!
7355	! Description:
7356	! ------------
7357	!> Calculate the tendencies for aerosol number and mass concentrations.
7358	!> Vector-optimized.
7359	!------------------------------------------------------------------------------!
7360	SUBROUTINE salsa_tendency( id, rs_p, rs, trs_m, b, c, rs_init )
7361
7362	USE advec_ws, &
7363	ONLY: advec_s_ws
7364	USE advec_s_pw_mod, &
7365	ONLY: advec_s_pw
7366	USE advec_s_up_mod, &
7367	ONLY: advec_s_up
7368	USE arrays_3d, &
7369	ONLY: ddzu, hyp, pt, rdf_sc, tend
7370	USE diffusion_s_mod, &
7371	ONLY: diffusion_s
7372	USE indices, &
7373	ONLY: wall_flags_0
7374	USE surface_mod, &
7375	ONLY : surf_def_h, surf_def_v, surf_lsm_h, surf_lsm_v, surf_usm_h, &
7376	surf_usm_v
7377
7378	IMPLICIT NONE
7379
7380	CHARACTER (LEN = *) :: id
7381	INTEGER(iwp) :: b !< bin index in derived type aerosol_size_bin
7382	INTEGER(iwp) :: c !< bin index in derived type aerosol_size_bin
7383	INTEGER(iwp) :: i !<
7384	INTEGER(iwp) :: j !<
7385	INTEGER(iwp) :: k !<
7386	INTEGER(iwp) :: nc !< (c-1)*nbins+b
7387	REAL(wp), DIMENSION(nzb:nzt+1) :: rs_init !<
7388	REAL(wp), DIMENSION(:,:,:), POINTER :: rs_p !<
7389	REAL(wp), DIMENSION(:,:,:), POINTER :: rs !<
7390	REAL(wp), DIMENSION(:,:,:), POINTER :: trs_m !<
7391
7392	nc = (c-1)*nbins+b
7393	!
7394	!-- Tendency-terms for reactive scalar
7395	tend = 0.0_wp
7396
7397	IF ( id == 'aerosol_number' .AND. lod_aero == 3 ) THEN
7398	tend = tend + aerosol_number(b)%source
7399	ELSEIF ( id == 'aerosol_mass' .AND. lod_aero == 3 ) THEN
7400	tend = tend + aerosol_mass(nc)%source
7401	ENDIF
7402	!
7403	!-- Advection terms
7404	IF ( timestep_scheme(1:5) == 'runge' ) THEN
7405	IF ( ws_scheme_sca ) THEN
7406	CALL advec_s_ws( rs, id )
7407	ELSE
7408	CALL advec_s_pw( rs )
7409	ENDIF
7410	ELSE
7411	CALL advec_s_up( rs )
7412	ENDIF
7413	!
7414	!-- Diffusion terms
7415	IF ( id == 'aerosol_number' ) THEN
7416	CALL diffusion_s( rs, surf_def_h(0)%answs(:,b), &
7417	surf_def_h(1)%answs(:,b), surf_def_h(2)%answs(:,b), &
7418	surf_lsm_h%answs(:,b), surf_usm_h%answs(:,b), &
7419	surf_def_v(0)%answs(:,b), surf_def_v(1)%answs(:,b), &
7420	surf_def_v(2)%answs(:,b), surf_def_v(3)%answs(:,b), &
7421	surf_lsm_v(0)%answs(:,b), surf_lsm_v(1)%answs(:,b), &
7422	surf_lsm_v(2)%answs(:,b), surf_lsm_v(3)%answs(:,b), &
7423	surf_usm_v(0)%answs(:,b), surf_usm_v(1)%answs(:,b), &
7424	surf_usm_v(2)%answs(:,b), surf_usm_v(3)%answs(:,b) )
7425	ELSEIF ( id == 'aerosol_mass' ) THEN
7426	CALL diffusion_s( rs, surf_def_h(0)%amsws(:,nc), &
7427	surf_def_h(1)%amsws(:,nc), surf_def_h(2)%amsws(:,nc), &
7428	surf_lsm_h%amsws(:,nc), surf_usm_h%amsws(:,nc), &
7429	surf_def_v(0)%amsws(:,nc), surf_def_v(1)%amsws(:,nc), &
7430	surf_def_v(2)%amsws(:,nc), surf_def_v(3)%amsws(:,nc), &
7431	surf_lsm_v(0)%amsws(:,nc), surf_lsm_v(1)%amsws(:,nc), &
7432	surf_lsm_v(2)%amsws(:,nc), surf_lsm_v(3)%amsws(:,nc), &
7433	surf_usm_v(0)%amsws(:,nc), surf_usm_v(1)%amsws(:,nc), &
7434	surf_usm_v(2)%amsws(:,nc), surf_usm_v(3)%amsws(:,nc) )
7435	ELSEIF ( id == 'salsa_gas' ) THEN
7436	CALL diffusion_s( rs, surf_def_h(0)%gtsws(:,b), &
7437	surf_def_h(1)%gtsws(:,b), surf_def_h(2)%gtsws(:,b), &
7438	surf_lsm_h%gtsws(:,b), surf_usm_h%gtsws(:,b), &
7439	surf_def_v(0)%gtsws(:,b), surf_def_v(1)%gtsws(:,b), &
7440	surf_def_v(2)%gtsws(:,b), surf_def_v(3)%gtsws(:,b), &
7441	surf_lsm_v(0)%gtsws(:,b), surf_lsm_v(1)%gtsws(:,b), &
7442	surf_lsm_v(2)%gtsws(:,b), surf_lsm_v(3)%gtsws(:,b), &
7443	surf_usm_v(0)%gtsws(:,b), surf_usm_v(1)%gtsws(:,b), &
7444	surf_usm_v(2)%gtsws(:,b), surf_usm_v(3)%gtsws(:,b) )
7445	ENDIF
7446	!
7447	!-- Prognostic equation for a scalar
7448	DO i = nxl, nxr
7449	DO j = nys, nyn
7450	IF ( id == 'salsa_gas' .AND. lod_gases == 3 ) THEN
7451	tend(:,j,i) = tend(:,j,i) + salsa_gas(b)%source(:,j,i) * &
7452	for_ppm_to_nconc * hyp(:) / pt(:,j,i) * ( hyp(:) / &
7453	100000.0_wp )**0.286_wp ! ppm to #/m3
7454	ELSEIF ( id == 'aerosol_mass' .OR. id == 'aerosol_number') THEN
7455	!
7456	!-- Sedimentation for aerosol number and mass
7457	IF ( lsdepo ) THEN
7458	tend(nzb+1:nzt,j,i) = tend(nzb+1:nzt,j,i) - MAX( 0.0_wp, &
7459	( rs(nzb+2:nzt+1,j,i) * sedim_vd(nzb+2:nzt+1,j,i,b) - &
7460	rs(nzb+1:nzt,j,i) * sedim_vd(nzb+1:nzt,j,i,b) ) * &
7461	ddzu(nzb+1:nzt) ) * MERGE( 1.0_wp, 0.0_wp, &
7462	BTEST( wall_flags_0(nzb:nzt-1,j,i), 0 ) )
7463	ENDIF
7464	ENDIF
7465	DO k = nzb+1, nzt
7466	rs_p(k,j,i) = rs(k,j,i) + ( dt_3d * ( tsc(2) * tend(k,j,i) + &
7467	tsc(3) * trs_m(k,j,i) ) &
7468	- tsc(5) * rdf_sc(k) &
7469	* ( rs(k,j,i) - rs_init(k) ) )&
7470	* MERGE( 1.0_wp, 0.0_wp, &
7471	BTEST( wall_flags_0(k,j,i), 0 ) )
7472	IF ( rs_p(k,j,i) < 0.0_wp ) rs_p(k,j,i) = 0.1_wp * rs(k,j,i)
7473	ENDDO
7474	ENDDO
7475	ENDDO
7476
7477	!
7478	!-- Calculate tendencies for the next Runge-Kutta step
7479	IF ( timestep_scheme(1:5) == 'runge' ) THEN
7480	IF ( intermediate_timestep_count == 1 ) THEN
7481	DO i = nxl, nxr
7482	DO j = nys, nyn
7483	DO k = nzb+1, nzt
7484	trs_m(k,j,i) = tend(k,j,i)
7485	ENDDO
7486	ENDDO
7487	ENDDO
7488	ELSEIF ( intermediate_timestep_count < &
7489	intermediate_timestep_count_max ) THEN
7490	DO i = nxl, nxr
7491	DO j = nys, nyn
7492	DO k = nzb+1, nzt
7493	trs_m(k,j,i) = -9.5625_wp * tend(k,j,i) &
7494	+ 5.3125_wp * trs_m(k,j,i)
7495	ENDDO
7496	ENDDO
7497	ENDDO
7498	ENDIF
7499	ENDIF
7500
7501	END SUBROUTINE salsa_tendency
7502
7503	!------------------------------------------------------------------------------!
7504	! Description:
7505	! ------------
7506	!> Boundary conditions for prognostic variables in SALSA
7507	!------------------------------------------------------------------------------!
7508	SUBROUTINE salsa_boundary_conds
7509
7510	USE surface_mod, &
7511	ONLY : bc_h
7512
7513	IMPLICIT NONE
7514
7515	INTEGER(iwp) :: b !< index for aerosol size bins
7516	INTEGER(iwp) :: c !< index for chemical compounds in aerosols
7517	INTEGER(iwp) :: g !< idex for gaseous compounds
7518	INTEGER(iwp) :: i !< grid index x direction
7519	INTEGER(iwp) :: j !< grid index y direction
7520	INTEGER(iwp) :: k !< grid index y direction
7521	INTEGER(iwp) :: kb !< variable to set respective boundary value, depends on
7522	!< facing.
7523	INTEGER(iwp) :: l !< running index boundary type, for up- and downward-
7524	!< facing walls
7525	INTEGER(iwp) :: m !< running index surface elements
7526
7527	!
7528	!-- Surface conditions:
7529	IF ( ibc_salsa_b == 0 ) THEN ! Dirichlet
7530	!
7531	!-- Run loop over all non-natural and natural walls. Note, in wall-datatype
7532	!-- the k coordinate belongs to the atmospheric grid point, therefore, set
7533	!-- s_p at k-1
7534
7535	DO l = 0, 1
7536	!
7537	!-- Set kb, for upward-facing surfaces value at topography top (k-1) is
7538	!-- set, for downward-facing surfaces at topography bottom (k+1)
7539	kb = MERGE ( -1, 1, l == 0 )
7540	!$OMP PARALLEL PRIVATE( b, c, g, i, j, k )
7541	!$OMP DO
7542	DO m = 1, bc_h(l)%ns
7543
7544	i = bc_h(l)%i(m)
7545	j = bc_h(l)%j(m)
7546	k = bc_h(l)%k(m)
7547
7548	DO b = 1, nbins
7549	aerosol_number(b)%conc_p(k+kb,j,i) = &
7550	aerosol_number(b)%conc(k+kb,j,i)
7551	DO c = 1, ncc_tot
7552	aerosol_mass((c-1)*nbins+b)%conc_p(k+kb,j,i) = &
7553	aerosol_mass((c-1)*nbins+b)%conc(k+kb,j,i)
7554	ENDDO
7555	ENDDO
7556	IF ( .NOT. salsa_gases_from_chem ) THEN
7557	DO g = 1, ngast
7558	salsa_gas(g)%conc_p(k+kb,j,i) = salsa_gas(g)%conc(k+kb,j,i)
7559	ENDDO
7560	ENDIF
7561
7562	ENDDO
7563	!$OMP END PARALLEL
7564
7565	ENDDO
7566
7567	ELSE ! Neumann
7568
7569	DO l = 0, 1
7570	!
7571	!-- Set kb, for upward-facing surfaces value at topography top (k-1) is
7572	!-- set, for downward-facing surfaces at topography bottom (k+1)
7573	kb = MERGE( -1, 1, l == 0 )
7574	!$OMP PARALLEL PRIVATE( b, c, g, i, j, k )
7575	!$OMP DO
7576	DO m = 1, bc_h(l)%ns
7577
7578	i = bc_h(l)%i(m)
7579	j = bc_h(l)%j(m)
7580	k = bc_h(l)%k(m)
7581
7582	DO b = 1, nbins
7583	aerosol_number(b)%conc_p(k+kb,j,i) = &
7584	aerosol_number(b)%conc_p(k,j,i)
7585	DO c = 1, ncc_tot
7586	aerosol_mass((c-1)*nbins+b)%conc_p(k+kb,j,i) = &
7587	aerosol_mass((c-1)*nbins+b)%conc_p(k,j,i)
7588	ENDDO
7589	ENDDO
7590	IF ( .NOT. salsa_gases_from_chem ) THEN
7591	DO g = 1, ngast
7592	salsa_gas(g)%conc_p(k+kb,j,i) = salsa_gas(g)%conc_p(k,j,i)
7593	ENDDO
7594	ENDIF
7595
7596	ENDDO
7597	!$OMP END PARALLEL
7598	ENDDO
7599
7600	ENDIF
7601
7602	!
7603	!--Top boundary conditions:
7604	IF ( ibc_salsa_t == 0 ) THEN ! Dirichlet
7605
7606	DO b = 1, nbins
7607	aerosol_number(b)%conc_p(nzt+1,:,:) = &
7608	aerosol_number(b)%conc(nzt+1,:,:)
7609	DO c = 1, ncc_tot
7610	aerosol_mass((c-1)*nbins+b)%conc_p(nzt+1,:,:) = &
7611	aerosol_mass((c-1)*nbins+b)%conc(nzt+1,:,:)
7612	ENDDO
7613	ENDDO
7614	IF ( .NOT. salsa_gases_from_chem ) THEN
7615	DO g = 1, ngast
7616	salsa_gas(g)%conc_p(nzt+1,:,:) = salsa_gas(g)%conc(nzt+1,:,:)
7617	ENDDO
7618	ENDIF
7619
7620	ELSEIF ( ibc_salsa_t == 1 ) THEN ! Neumann
7621
7622	DO b = 1, nbins
7623	aerosol_number(b)%conc_p(nzt+1,:,:) = &
7624	aerosol_number(b)%conc_p(nzt,:,:)
7625	DO c = 1, ncc_tot
7626	aerosol_mass((c-1)*nbins+b)%conc_p(nzt+1,:,:) = &
7627	aerosol_mass((c-1)*nbins+b)%conc_p(nzt,:,:)
7628	ENDDO
7629	ENDDO
7630	IF ( .NOT. salsa_gases_from_chem ) THEN
7631	DO g = 1, ngast
7632	salsa_gas(g)%conc_p(nzt+1,:,:) = salsa_gas(g)%conc_p(nzt,:,:)
7633	ENDDO
7634	ENDIF
7635
7636	ENDIF
7637	!
7638	!-- Lateral boundary conditions at the outflow
7639	IF ( bc_radiation_s ) THEN
7640	DO b = 1, nbins
7641	aerosol_number(b)%conc_p(:,nys-1,:) = aerosol_number(b)%conc_p(:,nys,:)
7642	DO c = 1, ncc_tot
7643	aerosol_mass((c-1)*nbins+b)%conc_p(:,nys-1,:) = &
7644	aerosol_mass((c-1)*nbins+b)%conc_p(:,nys,:)
7645	ENDDO
7646	ENDDO
7647	ELSEIF ( bc_radiation_n ) THEN
7648	DO b = 1, nbins
7649	aerosol_number(b)%conc_p(:,nyn+1,:) = aerosol_number(b)%conc_p(:,nyn,:)
7650	DO c = 1, ncc_tot
7651	aerosol_mass((c-1)*nbins+b)%conc_p(:,nyn+1,:) = &
7652	aerosol_mass((c-1)*nbins+b)%conc_p(:,nyn,:)
7653	ENDDO
7654	ENDDO
7655	ELSEIF ( bc_radiation_l ) THEN
7656	DO b = 1, nbins
7657	aerosol_number(b)%conc_p(:,nxl-1,:) = aerosol_number(b)%conc_p(:,nxl,:)
7658	DO c = 1, ncc_tot
7659	aerosol_mass((c-1)*nbins+b)%conc_p(:,nxl-1,:) = &
7660	aerosol_mass((c-1)*nbins+b)%conc_p(:,nxl,:)
7661	ENDDO
7662	ENDDO
7663	ELSEIF ( bc_radiation_r ) THEN
7664	DO b = 1, nbins
7665	aerosol_number(b)%conc_p(:,nxr+1,:) = aerosol_number(b)%conc_p(:,nxr,:)
7666	DO c = 1, ncc_tot
7667	aerosol_mass((c-1)*nbins+b)%conc_p(:,nxr+1,:) = &
7668	aerosol_mass((c-1)*nbins+b)%conc_p(:,nxr,:)
7669	ENDDO
7670	ENDDO
7671	ENDIF
7672
7673	END SUBROUTINE salsa_boundary_conds
7674
7675	!------------------------------------------------------------------------------!
7676	! Description:
7677	! ------------
7678	! Undoing of the previously done cyclic boundary conditions.
7679	!------------------------------------------------------------------------------!
7680	SUBROUTINE salsa_boundary_conds_decycle ( sq, sq_init )
7681
7682	IMPLICIT NONE
7683
7684	INTEGER(iwp) :: boundary !<
7685	INTEGER(iwp) :: ee !<
7686	INTEGER(iwp) :: copied !<
7687	INTEGER(iwp) :: i !<
7688	INTEGER(iwp) :: j !<
7689	INTEGER(iwp) :: k !<
7690	INTEGER(iwp) :: ss !<
7691	REAL(wp), DIMENSION(nzb:nzt+1) :: sq_init
7692	REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) :: sq
7693	REAL(wp) :: flag !< flag to mask topography grid points
7694
7695	flag = 0.0_wp
7696	!
7697	!-- Left and right boundaries
7698	IF ( decycle_lr .AND. ( bc_lr_cyc .OR. bc_lr == 'nested' ) ) THEN
7699
7700	DO boundary = 1, 2
7701
7702	IF ( decycle_method(boundary) == 'dirichlet' ) THEN
7703	!
7704	!-- Initial profile is copied to ghost and first three layers
7705	ss = 1
7706	ee = 0
7707	IF ( boundary == 1 .AND. nxl == 0 ) THEN
7708	ss = nxlg
7709	ee = nxl+2
7710	ELSEIF ( boundary == 2 .AND. nxr == nx ) THEN
7711	ss = nxr-2
7712	ee = nxrg
7713	ENDIF
7714
7715	DO i = ss, ee
7716	DO j = nysg, nyng
7717	DO k = nzb+1, nzt
7718	flag = MERGE( 1.0_wp, 0.0_wp, &
7719	BTEST( wall_flags_0(k,j,i), 0 ) )
7720	sq(k,j,i) = sq_init(k) * flag
7721	ENDDO
7722	ENDDO
7723	ENDDO
7724
7725	ELSEIF ( decycle_method(boundary) == 'neumann' ) THEN
7726	!
7727	!-- The value at the boundary is copied to the ghost layers to simulate
7728	!-- an outlet with zero gradient
7729	ss = 1
7730	ee = 0
7731	IF ( boundary == 1 .AND. nxl == 0 ) THEN
7732	ss = nxlg
7733	ee = nxl-1
7734	copied = nxl
7735	ELSEIF ( boundary == 2 .AND. nxr == nx ) THEN
7736	ss = nxr+1
7737	ee = nxrg
7738	copied = nxr
7739	ENDIF
7740
7741	DO i = ss, ee
7742	DO j = nysg, nyng
7743	DO k = nzb+1, nzt
7744	flag = MERGE( 1.0_wp, 0.0_wp, &
7745	BTEST( wall_flags_0(k,j,i), 0 ) )
7746	sq(k,j,i) = sq(k,j,copied) * flag
7747	ENDDO
7748	ENDDO
7749	ENDDO
7750
7751	ELSE
7752	WRITE(message_string,*) &
7753	'unknown decycling method: decycle_method (', &
7754	boundary, ') ="' // TRIM( decycle_method(boundary) ) // '"'
7755	CALL message( 'salsa_boundary_conds_decycle', 'SA0029', &
7756	1, 2, 0, 6, 0 )
7757	ENDIF
7758	ENDDO
7759	ENDIF
7760
7761	!
7762	!-- South and north boundaries
7763	IF ( decycle_ns .AND. ( bc_ns_cyc .OR. bc_ns == 'nested' ) ) THEN
7764
7765	DO boundary = 3, 4
7766
7767	IF ( decycle_method(boundary) == 'dirichlet' ) THEN
7768	!
7769	!-- Initial profile is copied to ghost and first three layers
7770	ss = 1
7771	ee = 0
7772	IF ( boundary == 3 .AND. nys == 0 ) THEN
7773	ss = nysg
7774	ee = nys+2
7775	ELSEIF ( boundary == 4 .AND. nyn == ny ) THEN
7776	ss = nyn-2
7777	ee = nyng
7778	ENDIF
7779
7780	DO i = nxlg, nxrg
7781	DO j = ss, ee
7782	DO k = nzb+1, nzt
7783	flag = MERGE( 1.0_wp, 0.0_wp, &
7784	BTEST( wall_flags_0(k,j,i), 0 ) )
7785	sq(k,j,i) = sq_init(k) * flag
7786	ENDDO
7787	ENDDO
7788	ENDDO
7789
7790	ELSEIF ( decycle_method(boundary) == 'neumann' ) THEN
7791	!
7792	!-- The value at the boundary is copied to the ghost layers to simulate
7793	!-- an outlet with zero gradient
7794	ss = 1
7795	ee = 0
7796	IF ( boundary == 3 .AND. nys == 0 ) THEN
7797	ss = nysg
7798	ee = nys-1
7799	copied = nys
7800	ELSEIF ( boundary == 4 .AND. nyn == ny ) THEN
7801	ss = nyn+1
7802	ee = nyng
7803	copied = nyn
7804	ENDIF
7805
7806	DO i = nxlg, nxrg
7807	DO j = ss, ee
7808	DO k = nzb+1, nzt
7809	flag = MERGE( 1.0_wp, 0.0_wp, &
7810	BTEST( wall_flags_0(k,j,i), 0 ) )
7811	sq(k,j,i) = sq(k,copied,i) * flag
7812	ENDDO
7813	ENDDO
7814	ENDDO
7815
7816	ELSE
7817	WRITE(message_string,*) &
7818	'unknown decycling method: decycle_method (', &
7819	boundary, ') ="' // TRIM( decycle_method(boundary) ) // '"'
7820	CALL message( 'salsa_boundary_conds_decycle', 'SA0030', &
7821	1, 2, 0, 6, 0 )
7822	ENDIF
7823	ENDDO
7824	ENDIF
7825
7826	END SUBROUTINE salsa_boundary_conds_decycle
7827
7828	!------------------------------------------------------------------------------!
7829	! Description:
7830	! ------------
7831	!> Calculates the total dry or wet mass concentration for individual bins
7832	!> Juha Tonttila (FMI) 2015
7833	!> Tomi Raatikainen (FMI) 2016
7834	!------------------------------------------------------------------------------!
7835	SUBROUTINE bin_mixrat( itype, ibin, i, j, mconc )
7836
7837	IMPLICIT NONE
7838
7839	CHARACTER(len=*), INTENT(in) :: itype !< 'dry' or 'wet'
7840	INTEGER(iwp), INTENT(in) :: ibin !< index of the chemical component
7841	INTEGER(iwp), INTENT(in) :: i !< loop index for x-direction
7842	INTEGER(iwp), INTENT(in) :: j !< loop index for y-direction
7843	REAL(wp), DIMENSION(:), INTENT(out) :: mconc !< total dry or wet mass
7844	!< concentration
7845
7846	INTEGER(iwp) :: c !< loop index for mass bin number
7847	INTEGER(iwp) :: iend !< end index: include water or not
7848
7849	!-- Number of components
7850	IF ( itype == 'dry' ) THEN
7851	iend = get_n_comp( prtcl ) - 1
7852	ELSE IF ( itype == 'wet' ) THEN
7853	iend = get_n_comp( prtcl )
7854	ELSE
7855	STOP 'bin_mixrat: Error in itype'
7856	ENDIF
7857
7858	mconc = 0.0_wp
7859
7860	DO c = ibin, iend*nbins+ibin, nbins !< every nbins'th element
7861	mconc = mconc + aerosol_mass(c)%conc(:,j,i)
7862	ENDDO
7863
7864	END SUBROUTINE bin_mixrat
7865
7866	!------------------------------------------------------------------------------!
7867	!> Description:
7868	!> ------------
7869	!> Define aerosol fluxes: constant or read from a from file
7870	!------------------------------------------------------------------------------!
7871	SUBROUTINE salsa_set_source
7872
7873	! USE date_and_time_mod, &
7874	! ONLY: index_dd, index_hh, index_mm
7875	#if defined( __netcdf )
7876	USE NETCDF
7877
7878	USE netcdf_data_input_mod, &
7879	ONLY: get_attribute, netcdf_data_input_get_dimension_length, &
7880	get_variable, open_read_file
7881
7882	USE surface_mod, &
7883	ONLY: surf_def_h, surf_lsm_h, surf_usm_h
7884
7885	IMPLICIT NONE
7886
7887	INTEGER(iwp), PARAMETER :: ndm = 3 !< number of default modes
7888	INTEGER(iwp), PARAMETER :: ndc = 4 !< number of default categories
7889
7890	CHARACTER (LEN=10) :: unita !< Unit of aerosol fluxes
7891	CHARACTER (LEN=10) :: unitg !< Unit of gaseous fluxes
7892	INTEGER(iwp) :: b !< loop index: aerosol number bins
7893	INTEGER(iwp) :: c !< loop index: aerosol chemical components
7894	INTEGER(iwp) :: ee !< loop index: end
7895	INTEGER(iwp), ALLOCATABLE, DIMENSION(:) :: eci !< emission category index
7896	INTEGER(iwp) :: g !< loop index: gaseous tracers
7897	INTEGER(iwp) :: i !< loop index: x-direction
7898	INTEGER(iwp) :: id_faero !< NetCDF id of aerosol source input file
7899	INTEGER(iwp) :: id_fchem !< NetCDF id of aerosol source input file
7900	INTEGER(iwp) :: id_sa !< NetCDF id of variable: source
7901	INTEGER(iwp) :: j !< loop index: y-direction
7902	INTEGER(iwp) :: k !< loop index: z-direction
7903	INTEGER(iwp) :: kg !< loop index: z-direction (gases)
7904	INTEGER(iwp) :: n_dt !< number of time steps in the emission file
7905	INTEGER(iwp) :: nc_stat !< local variable for storing the result of
7906	!< netCDF calls for error message handling
7907	INTEGER(iwp) :: nb_file !< Number of grid-points in file (bins)
7908	INTEGER(iwp) :: ncat !< Number of emission categories
7909	INTEGER(iwp) :: ng_file !< Number of grid-points in file (gases)
7910	INTEGER(iwp) :: num_vars !< number of variables in input file
7911	INTEGER(iwp) :: nz_file !< number of grid-points in file
7912	INTEGER(iwp) :: n !< loop index
7913	INTEGER(iwp) :: ni !< loop index
7914	INTEGER(iwp) :: ss !< loop index
7915	LOGICAL :: netcdf_extend = .FALSE. !< Flag indicating wether netcdf
7916	!< topography input file or not
7917	REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:) :: dum_var_4d !< variable for
7918	!< temporary data
7919	REAL(wp) :: fillval !< fill value
7920	REAL(wp) :: flag !< flag to mask topography grid points
7921	REAL(wp), DIMENSION(nbins) :: nsect_emission !< sectional emission (lod1)
7922	REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: pm_emission !< aerosol mass
7923	!< emission (lod1)
7924	REAL(wp), DIMENSION(nbins) :: source_ijka !< aerosol source at (k,j,i)
7925	!
7926	!-- The default size distribution and mass composition per emission category:
7927	!-- 1 = traffic, 2 = road dust, 3 = wood combustion, 4 = other
7928	!-- Mass fractions: H2SO4, OC, BC, DU, SS, HNO3, NH3
7929	CHARACTER(LEN=15), DIMENSION(ndc) :: cat_name_table = &!< emission category
7930	(/'road traffic ','road dust ',&
7931	'wood combustion','other '/)
7932	REAL(wp), DIMENSION(ndc) :: avg_density !< average density
7933	REAL(wp), DIMENSION(ndc) :: conversion_factor !< unit conversion factor
7934	!< for aerosol emissions
7935	REAL(wp), DIMENSION(ndm), PARAMETER :: dpg_table = & !< mean diameter (mum)
7936	(/ 13.5E-3_wp, 1.4_wp, 5.4E-2_wp/)
7937	REAL(wp), DIMENSION(ndm) :: ntot_table
7938	REAL(wp), DIMENSION(maxspec,ndc), PARAMETER :: mass_fraction_table = &
7939	RESHAPE( (/ 0.04_wp, 0.48_wp, 0.48_wp, 0.0_wp, 0.0_wp, 0.0_wp, 0.0_wp, &
7940	0.0_wp, 0.05_wp, 0.0_wp, 0.95_wp, 0.0_wp, 0.0_wp, 0.0_wp, &
7941	0.0_wp, 0.5_wp, 0.5_wp, 0.0_wp, 0.0_wp, 0.0_wp, 0.0_wp, &
7942	0.0_wp, 0.5_wp, 0.5_wp, 0.0_wp, 0.0_wp, 0.0_wp, 0.0_wp &
7943	/), (/maxspec,ndc/) )
7944	REAL(wp), DIMENSION(ndm,ndc), PARAMETER :: PMfrac_table = & !< rel. mass
7945	RESHAPE( (/ 0.016_wp, 0.000_wp, 0.984_wp, &
7946	0.000_wp, 1.000_wp, 0.000_wp, &
7947	0.000_wp, 0.000_wp, 1.000_wp, &
7948	1.000_wp, 0.000_wp, 1.000_wp &
7949	/), (/ndm,ndc/) )
7950	REAL(wp), DIMENSION(ndm), PARAMETER :: sigmag_table = & !< mode std
7951	(/1.6_wp, 1.4_wp, 1.7_wp/)
7952	avg_density = 1.0_wp
7953	nb_file = 0
7954	ng_file = 0
7955	nsect_emission = 0.0_wp
7956	nz_file = 0
7957	source_ijka = 0.0_wp
7958	!
7959	!-- First gases, if needed:
7960	IF ( .NOT. salsa_gases_from_chem ) THEN
7961	!
7962	!-- Read sources from PIDS_CHEM
7963	INQUIRE( FILE='PIDS_CHEM' // TRIM( coupling_char ), EXIST=netcdf_extend )
7964	IF ( .NOT. netcdf_extend ) THEN
7965	message_string = 'Input file '// TRIM( 'PIDS_CHEM' ) // &
7966	TRIM( coupling_char ) // ' for SALSA missing!'
7967	CALL message( 'salsa_mod: salsa_set_source', 'SA0027', 1, 2, 0, 6, 0 )
7968	ENDIF ! netcdf_extend
7969
7970	CALL location_message( ' salsa_set_source: NOTE! Gaseous emissions'//&
7971	' should be provided with following emission indices:'// &
7972	' 1=H2SO4, 2=HNO3, 3=NH3, 4=OCNV, 5=OCSV', .TRUE. )
7973	CALL location_message( ' salsa_set_source: No time dependency for '//&
7974	'gaseous emissions. Use emission_values '// &
7975	'directly.', .TRUE. )
7976	!
7977	!-- Open PIDS_CHEM in read-only mode
7978	CALL open_read_file( 'PIDS_CHEM' // TRIM( coupling_char ), id_fchem )
7979	!
7980	!-- Inquire the level of detail (lod)
7981	CALL get_attribute( id_fchem, 'lod', lod_gases, .FALSE., &
7982	"emission_values" )
7983
7984	IF ( lod_gases == 2 ) THEN
7985	!
7986	!-- Index of gaseous compounds
7987	CALL netcdf_data_input_get_dimension_length( id_fchem, ng_file, "nspecies" )
7988	IF ( ng_file < 5 ) THEN
7989	message_string = 'Some gaseous emissions missing.'
7990	CALL message( 'salsa_mod: salsa_set_source', 'SA0041', &
7991	1, 2, 0, 6, 0 )
7992	ENDIF
7993	!
7994	!-- Get number of emission categories
7995	CALL netcdf_data_input_get_dimension_length( id_fchem, ncat, "ncat" )
7996	!
7997	!-- Inquire the unit of gaseous fluxes
7998	CALL get_attribute( id_fchem, 'units', unitg, .FALSE., &
7999	"emission_values")
8000	!
8001	!-- Inquire the fill value
8002	CALL get_attribute( id_fchem, '_FillValue', fillval, .FALSE., &
8003	"emission_values" )
8004	!
8005	!-- Read surface emission data (x,y) PE-wise
8006	ALLOCATE( dum_var_4d(ng_file,ncat,nys:nyn,nxl:nxr) )
8007	CALL get_variable( id_fchem, 'emission_values', dum_var_4d, nxl, nxr,&
8008	nys, nyn, 0, ncat-1, 0, ng_file-1 )
8009	DO g = 1, ngast
8010	ALLOCATE( salsa_gas(g)%source(ncat,nys:nyn,nxl:nxr) )
8011	salsa_gas(g)%source = 0.0_wp
8012	salsa_gas(g)%source = salsa_gas(g)%source + dum_var_4d(g,:,:,:)
8013	ENDDO
8014	!
8015	!-- Set surface fluxes of gaseous compounds on horizontal surfaces.
8016	!-- Set fluxes only for either default, land or urban surface.
8017	IF ( .NOT. land_surface .AND. .NOT. urban_surface ) THEN
8018	CALL set_gas_flux( surf_def_h(0), ncat, unitg )
8019	ELSE
8020	CALL set_gas_flux( surf_lsm_h, ncat, unitg )
8021	CALL set_gas_flux( surf_usm_h, ncat, unitg )
8022	ENDIF
8023
8024	DEALLOCATE( dum_var_4d )
8025	DO g = 1, ngast
8026	DEALLOCATE( salsa_gas(g)%source )
8027	ENDDO
8028	ELSE
8029	message_string = 'Input file PIDS_CHEM needs to have lod = 2 when '//&
8030	'SALSA is applied but not the chemistry module!'
8031	CALL message( 'salsa_mod: salsa_set_source', 'SA0039', 1, 2, 0, 6, 0 )
8032	ENDIF
8033	ENDIF
8034	!
8035	!-- Read sources from PIDS_SALSA
8036	INQUIRE( FILE='PIDS_SALSA' // TRIM( coupling_char ), EXIST=netcdf_extend )
8037	IF ( .NOT. netcdf_extend ) THEN
8038	message_string = 'Input file '// TRIM( 'PIDS_SALSA' ) // &
8039	TRIM( coupling_char ) // ' for SALSA missing!'
8040	CALL message( 'salsa_mod: salsa_set_source', 'SA0034', 1, 2, 0, 6, 0 )
8041	ENDIF ! netcdf_extend
8042	!
8043	!-- Open file in read-only mode
8044	CALL open_read_file( 'PIDS_SALSA' // TRIM( coupling_char ), id_faero )
8045	!
8046	!-- Get number of emission categories and their indices
8047	CALL netcdf_data_input_get_dimension_length( id_faero, ncat, "ncat" )
8048	!
8049	!-- Get emission category indices
8050	ALLOCATE( eci(1:ncat) )
8051	CALL get_variable( id_faero, 'emission_category_index', eci )
8052	!
8053	!-- Inquire the level of detail (lod)
8054	CALL get_attribute( id_faero, 'lod', lod_aero, .FALSE., &
8055	"aerosol_emission_values" )
8056
8057	IF ( lod_aero < 3 .AND. ibc_salsa_b == 0 ) THEN
8058	message_string = 'lod1/2 for aerosol emissions requires '// &
8059	'bc_salsa_b = "Neumann"'
8060	CALL message( 'salsa_mod: salsa_set_source','SA0025', 1, 2, 0, 6, 0 )
8061	ENDIF
8062	!
8063	!-- Inquire the fill value
8064	CALL get_attribute( id_faero, '_FillValue', fillval, .FALSE., &
8065	"aerosol_emission_values" )
8066	!
8067	!-- Aerosol chemical composition:
8068	ALLOCATE( emission_mass_fracs(1:ncat,1:maxspec) )
8069	emission_mass_fracs = 0.0_wp
8070	!-- Chemical composition: 1: H2SO4 (sulphuric acid), 2: OC (organic carbon),
8071	!-- 3: BC (black carbon), 4: DU (dust),
8072	!-- 5: SS (sea salt), 6: HNO3 (nitric acid),
8073	!-- 7: NH3 (ammonia)
8074	DO n = 1, ncat
8075	IF ( lod_aero < 2 ) THEN
8076	emission_mass_fracs(n,:) = mass_fraction_table(:,n)
8077	ELSE
8078	CALL get_variable( id_faero, "emission_mass_fracs", &
8079	emission_mass_fracs(n,:) )
8080	ENDIF
8081	!
8082	!-- If the chemical component is not activated, set its mass fraction to 0
8083	!-- to avoid inbalance between number and mass flux
8084	IF ( iso4 < 0 ) emission_mass_fracs(n,1) = 0.0_wp
8085	IF ( ioc < 0 ) emission_mass_fracs(n,2) = 0.0_wp
8086	IF ( ibc < 0 ) emission_mass_fracs(n,3) = 0.0_wp
8087	IF ( idu < 0 ) emission_mass_fracs(n,4) = 0.0_wp
8088	IF ( iss < 0 ) emission_mass_fracs(n,5) = 0.0_wp
8089	IF ( ino < 0 ) emission_mass_fracs(n,6) = 0.0_wp
8090	IF ( inh < 0 ) emission_mass_fracs(n,7) = 0.0_wp
8091	!-- Then normalise the mass fraction so that SUM = 1
8092	emission_mass_fracs(n,:) = emission_mass_fracs(n,:) / &
8093	SUM( emission_mass_fracs(n,:) )
8094	ENDDO
8095
8096	IF ( lod_aero > 1 ) THEN
8097	!
8098	!-- Aerosol geometric mean diameter
8099	CALL netcdf_data_input_get_dimension_length( id_faero, nb_file, 'Dmid' )
8100	IF ( nb_file /= nbins ) THEN
8101	message_string = 'The number of size bins in aerosol input data '// &
8102	'does not correspond to the model set-up'
8103	CALL message( 'salsa_mod: salsa_set_source','SA0040', 1, 2, 0, 6, 0 )
8104	ENDIF
8105	ENDIF
8106
8107	IF ( lod_aero < 3 ) THEN
8108	CALL location_message( ' salsa_set_source: No time dependency for '//&
8109	'aerosol emissions. Use aerosol_emission_values'//&
8110	' directly.', .TRUE. )
8111	!
8112	!-- Allocate source arrays
8113	DO b = 1, nbins
8114	ALLOCATE( aerosol_number(b)%source(1:ncat,nys:nyn,nxl:nxr) )
8115	aerosol_number(b)%source = 0.0_wp
8116	ENDDO
8117	DO c = 1, ncc_tot*nbins
8118	ALLOCATE( aerosol_mass(c)%source(1:ncat,nys:nyn,nxl:nxr) )
8119	aerosol_mass(c)%source = 0.0_wp
8120	ENDDO
8121
8122	IF ( lod_aero == 1 ) THEN
8123	DO n = 1, ncat
8124	avg_density(n) = emission_mass_fracs(n,1) * arhoh2so4 + &
8125	emission_mass_fracs(n,2) * arhooc + &
8126	emission_mass_fracs(n,3) * arhobc + &
8127	emission_mass_fracs(n,4) * arhodu + &
8128	emission_mass_fracs(n,5) * arhoss + &
8129	emission_mass_fracs(n,6) * arhohno3 + &
8130	emission_mass_fracs(n,7) * arhonh3
8131	ENDDO
8132	!
8133	!-- Emission unit
8134	CALL get_attribute( id_faero, 'units', unita, .FALSE., &
8135	"aerosol_emission_values")
8136	conversion_factor = 1.0_wp
8137	IF ( unita == 'kg/m2/yr' ) THEN
8138	conversion_factor = 3.170979e-8_wp / avg_density
8139	ELSEIF ( unita == 'g/m2/yr' ) THEN
8140	conversion_factor = 3.170979e-8_wp * 1.0E-3_wp / avg_density
8141	ELSEIF ( unita == 'kg/m2/s' ) THEN
8142	conversion_factor = 1.0_wp / avg_density
8143	ELSEIF ( unita == 'g/m2/s' ) THEN
8144	conversion_factor = 1.0E-3_wp / avg_density
8145	ELSE
8146	message_string = 'unknown unit for aerosol emissions: ' &
8147	// TRIM( unita ) // ' (lod1)'
8148	CALL message( 'salsa_mod: salsa_set_source','SA0035', &
8149	1, 2, 0, 6, 0 )
8150	ENDIF
8151	!
8152	!-- Read surface emission data (x,y) PE-wise
8153	ALLOCATE( pm_emission(ncat,nys:nyn,nxl:nxr) )
8154	CALL get_variable( id_faero, 'aerosol_emission_values', pm_emission, &
8155	nxl, nxr, nys, nyn, 0, ncat-1 )
8156	DO ni = 1, SIZE( eci )
8157	n = eci(ni)
8158	!
8159	!-- Calculate the number concentration of a log-normal size
8160	!-- distribution following Jacobson (2005): Eq 13.25.
8161	ntot_table = 6.0_wp * PMfrac_table(:,n) / ( pi * dpg_table*3 &
8162	EXP( 4.5_wp * LOG( sigmag_table )*2 ) ) 1.0E+12_wp
8163	!
8164	!-- Sectional size distibution from a log-normal one
8165	CALL size_distribution( ntot_table, dpg_table, sigmag_table, &
8166	nsect_emission )
8167	DO b = 1, nbins
8168	aerosol_number(b)%source(ni,:,:) = &
8169	aerosol_number(b)%source(ni,:,:) + &
8170	pm_emission(ni,:,:) * conversion_factor(n) &
8171	* nsect_emission(b)
8172	ENDDO
8173	ENDDO
8174	ELSEIF ( lod_aero == 2 ) THEN
8175	!
8176	!-- Read surface emission data (x,y) PE-wise
8177	ALLOCATE( dum_var_4d(nb_file,ncat,nys:nyn,nxl:nxr) )
8178	CALL get_variable( id_faero, 'aerosol_emission_values', dum_var_4d, &
8179	nxl, nxr, nys, nyn, 0, ncat-1, 0, nb_file-1 )
8180	DO b = 1, nbins
8181	aerosol_number(b)%source = dum_var_4d(b,:,:,:)
8182	ENDDO
8183	DEALLOCATE( dum_var_4d )
8184	ENDIF
8185	!
8186	!-- Set surface fluxes of aerosol number and mass on horizontal surfaces.
8187	!-- Set fluxes only for either default, land or urban surface.
8188	IF ( .NOT. land_surface .AND. .NOT. urban_surface ) THEN
8189	CALL set_flux( surf_def_h(0), ncat )
8190	ELSE
8191	CALL set_flux( surf_usm_h, ncat )
8192	CALL set_flux( surf_lsm_h, ncat )
8193	ENDIF
8194
8195	ELSEIF ( lod_aero == 3 ) THEN
8196	!
8197	!-- Inquire aerosol emission rate per bin (#/(m3s))
8198	nc_stat = NF90_INQ_VARID( id_faero, "aerosol_emission_values", id_sa )
8199
8200	!
8201	!-- Emission time step
8202	CALL netcdf_data_input_get_dimension_length( id_faero, n_dt, 'dt_emission' )
8203	IF ( n_dt > 1 ) THEN
8204	CALL location_message( ' salsa_set_source: hourly emission data'//&
8205	' provided but currently the value of the '// &
8206	' first hour is applied.', .TRUE. )
8207	ENDIF
8208	!
8209	!-- Allocate source arrays
8210	DO b = 1, nbins
8211	ALLOCATE( aerosol_number(b)%source(nzb:nzt+1,nys:nyn,nxl:nxr) )
8212	aerosol_number(b)%source = 0.0_wp
8213	ENDDO
8214	DO c = 1, ncc_tot*nbins
8215	ALLOCATE( aerosol_mass(c)%source(nzb:nzt+1,nys:nyn,nxl:nxr) )
8216	aerosol_mass(c)%source = 0.0_wp
8217	ENDDO
8218	!
8219	!-- Get dimension of z-axis:
8220	CALL netcdf_data_input_get_dimension_length( id_faero, nz_file, 'z' )
8221	!
8222	!-- Read surface emission data (x,y) PE-wise
8223	DO i = nxl, nxr
8224	DO j = nys, nyn
8225	DO k = 0, nz_file-1
8226	!
8227	!-- Predetermine flag to mask topography
8228	flag = MERGE( 1.0_wp, 0.0_wp, BTEST(wall_flags_0(k,j,i), 0 ))
8229	!
8230	!-- No sources inside buildings !
8231	IF ( flag == 0.0_wp ) CYCLE
8232	!
8233	!-- Read volume source:
8234	nc_stat = NF90_GET_VAR( id_faero, id_sa, source_ijka, &
8235	start = (/ i+1, j+1, k+1, 1, 1 /), &
8236	count = (/ 1, 1, 1, 1, nb_file /) )
8237	IF ( nc_stat /= NF90_NOERR ) THEN
8238	message_string = 'error in aerosol emissions: lod3'
8239	CALL message( 'salsa_mod: salsa_set_source','SA0038', 1, 2, &
8240	0, 6, 0 )
8241	ENDIF
8242	!
8243	!-- Set mass fluxes. First bins include only SO4 and/or OC. Call
8244	!-- subroutine set_mass_source for larger bins.
8245	!
8246	!-- Sulphate and organic carbon
8247	IF ( iso4 > 0 .AND. ioc > 0 ) THEN
8248	!-- First sulphate:
8249	ss = ( iso4 - 1 ) * nbins + in1a ! start
8250	ee = ( iso4 - 1 ) * nbins + fn1a ! end
8251	b = in1a
8252	DO c = ss, ee
8253	IF ( source_ijka(b) /= fillval ) &
8254	aerosol_mass(c)%source(k,j,i) = &
8255	aerosol_mass(c)%source(k,j,i) + &
8256	emission_mass_fracs(1,1) / ( emission_mass_fracs(1,1) &
8257	+ emission_mass_fracs(1,2) ) * source_ijka(b) * &
8258	aero(b)%core * arhoh2so4
8259	b = b+1
8260	ENDDO
8261	!-- Then organic carbon:
8262	ss = ( ioc - 1 ) * nbins + in1a ! start
8263	ee = ( ioc - 1 ) * nbins + fn1a ! end
8264	b = in1a
8265	DO c = ss, ee
8266	IF ( source_ijka(b) /= fillval ) &
8267	aerosol_mass(c)%source(k,j,i) = &
8268	aerosol_mass(c)%source(k,j,i) + &
8269	emission_mass_fracs(1,2) / ( emission_mass_fracs(1,1) &
8270	+ emission_mass_fracs(1,2) ) * source_ijka(b) * &
8271	aero(b)%core * arhooc
8272	b = b+1
8273	ENDDO
8274
8275	CALL set_mass_source( k, j, i, iso4, &
8276	emission_mass_fracs(1,1), arhoh2so4, &
8277	source_ijka, fillval )
8278	CALL set_mass_source( k, j, i, ioc, emission_mass_fracs(1,2),&
8279	arhooc, source_ijka, fillval )
8280	!-- Only sulphate:
8281	ELSEIF ( iso4 > 0 .AND. ioc < 0 ) THEN
8282	ss = ( iso4 - 1 ) * nbins + in1a ! start
8283	ee = ( iso4 - 1 ) * nbins + fn1a ! end
8284	b = in1a
8285	DO c = ss, ee
8286	IF ( source_ijka(b) /= fillval ) &
8287	aerosol_mass(c)%source(k,j,i) = &
8288	aerosol_mass(c)%source(k,j,i) + source_ijka(b) * &
8289	aero(b)%core * arhoh2so4
8290	b = b+1
8291	ENDDO
8292	CALL set_mass_source( k, j, i, iso4, &
8293	emission_mass_fracs(1,1), arhoh2so4, &
8294	source_ijka, fillval )
8295	!-- Only organic carbon:
8296	ELSEIF ( iso4 < 0 .AND. ioc > 0 ) THEN
8297	ss = ( ioc - 1 ) * nbins + in1a ! start
8298	ee = ( ioc - 1 ) * nbins + fn1a ! end
8299	b = in1a
8300	DO c = ss, ee
8301	IF ( source_ijka(b) /= fillval ) &
8302	aerosol_mass(c)%source(k,j,i) = &
8303	aerosol_mass(c)%source(k,j,i) + source_ijka(b) * &
8304	aero(b)%core * arhooc
8305	b = b+1
8306	ENDDO
8307	CALL set_mass_source( k, j, i, ioc, emission_mass_fracs(1,2),&
8308	arhooc, source_ijka, fillval )
8309	ENDIF
8310	!-- Black carbon
8311	IF ( ibc > 0 ) THEN
8312	CALL set_mass_source( k, j, i, ibc, emission_mass_fracs(1,3),&
8313	arhobc, source_ijka, fillval )
8314	ENDIF
8315	!-- Dust
8316	IF ( idu > 0 ) THEN
8317	CALL set_mass_source( k, j, i, idu, emission_mass_fracs(1,4),&
8318	arhodu, source_ijka, fillval )
8319	ENDIF
8320	!-- Sea salt
8321	IF ( iss > 0 ) THEN
8322	CALL set_mass_source( k, j, i, iss, emission_mass_fracs(1,5),&
8323	arhoss, source_ijka, fillval )
8324	ENDIF
8325	!-- Nitric acid
8326	IF ( ino > 0 ) THEN
8327	CALL set_mass_source( k, j, i, ino, emission_mass_fracs(1,6),&
8328	arhohno3, source_ijka, fillval )
8329	ENDIF
8330	!-- Ammonia
8331	IF ( inh > 0 ) THEN
8332	CALL set_mass_source( k, j, i, inh, emission_mass_fracs(1,7),&
8333	arhonh3, source_ijka, fillval )
8334	ENDIF
8335	!
8336	!-- Save aerosol number sources in the end
8337	DO b = 1, nbins
8338	IF ( source_ijka(b) /= fillval ) &
8339	aerosol_number(b)%source(k,j,i) = &
8340	aerosol_number(b)%source(k,j,i) + source_ijka(b)
8341	ENDDO
8342	ENDDO ! k
8343	ENDDO ! j
8344	ENDDO ! i
8345
8346	ELSE
8347	message_string = 'NetCDF attribute lod is not set properly.'
8348	CALL message( 'salsa_mod: salsa_set_source','SA0026', 1, 2, 0, 6, 0 )
8349	ENDIF
8350
8351	#endif
8352	END SUBROUTINE salsa_set_source
8353
8354	!------------------------------------------------------------------------------!
8355	! Description:
8356	! ------------
8357	!> Sets the gaseous fluxes
8358	!------------------------------------------------------------------------------!
8359	SUBROUTINE set_gas_flux( surface, ncat_emission, unit )
8360
8361	USE arrays_3d, &
8362	ONLY: dzw, hyp, pt, rho_air_zw
8363
8364	USE grid_variables, &
8365	ONLY: dx, dy
8366
8367	USE surface_mod, &
8368	ONLY: surf_type
8369
8370	IMPLICIT NONE
8371
8372	CHARACTER(LEN=*) :: unit !< flux unit in the input file
8373	INTEGER(iwp) :: ncat_emission !< number of emission categories
8374	TYPE(surf_type), INTENT(inout) :: surface !< respective surface type
8375	INTEGER(iwp) :: g !< loop index
8376	INTEGER(iwp) :: i !< loop index
8377	INTEGER(iwp) :: j !< loop index
8378	INTEGER(iwp) :: k !< loop index
8379	INTEGER(iwp) :: m !< running index for surface elements
8380	INTEGER(iwp) :: n !< running index for emission categories
8381	REAL(wp), DIMENSION(ngast) :: conversion_factor
8382
8383	conversion_factor = 1.0_wp
8384
8385	DO m = 1, surface%ns
8386	!
8387	!-- Get indices of respective grid point
8388	i = surface%i(m)
8389	j = surface%j(m)
8390	k = surface%k(m)
8391
8392	IF ( unit == '#/m2/s' ) THEN
8393	conversion_factor = 1.0_wp
8394	ELSEIF ( unit == 'g/m2/s' ) THEN
8395	conversion_factor(1) = avo / ( amh2so4 * 1000.0_wp )
8396	conversion_factor(2) = avo / ( amhno3 * 1000.0_wp )
8397	conversion_factor(3) = avo / ( amnh3 * 1000.0_wp )
8398	conversion_factor(4) = avo / ( amoc * 1000.0_wp )
8399	conversion_factor(5) = avo / ( amoc * 1000.0_wp )
8400	ELSEIF ( unit == 'ppm/m2/s' ) THEN
8401	conversion_factor = for_ppm_to_nconc * hyp(k) / pt(k,j,i) * ( hyp(k) &
8402	/ 100000.0_wp )*0.286_wp dx * dy * dzw(k)
8403	ELSEIF ( unit == 'mumol/m2/s' ) THEN
8404	conversion_factor = 1.0E-6_wp * avo
8405	ELSE
8406	message_string = 'Unknown unit for gaseous emissions!'
8407	CALL message( 'salsa_mod: set_gas_flux', 'SA0031', 1, 2, 0, 6, 0 )
8408	ENDIF
8409
8410	DO n = 1, ncat_emission
8411	DO g = 1, ngast
8412	IF ( .NOT. salsa_gas(g)%source(n,j,i) > 0.0_wp ) THEN
8413	salsa_gas(g)%source(n,j,i) = 0.0_wp
8414	CYCLE
8415	ENDIF
8416	surface%gtsws(m,g) = surface%gtsws(m,g) + &
8417	salsa_gas(g)%source(n,j,i) * rho_air_zw(k-1) &
8418	* conversion_factor(g)
8419	ENDDO
8420	ENDDO
8421	ENDDO
8422
8423	END SUBROUTINE set_gas_flux
8424
8425
8426	!------------------------------------------------------------------------------!
8427	! Description:
8428	! ------------
8429	!> Sets the aerosol flux to aerosol arrays in 2a and 2b.
8430	!------------------------------------------------------------------------------!
8431	SUBROUTINE set_flux( surface, ncat_emission )
8432
8433	USE arrays_3d, &
8434	ONLY: hyp, pt, rho_air_zw
8435
8436	USE surface_mod, &
8437	ONLY: surf_type
8438
8439	IMPLICIT NONE
8440
8441	INTEGER(iwp) :: ncat_emission !< number of emission categories
8442	TYPE(surf_type), INTENT(inout) :: surface !< respective surface type
8443	INTEGER(iwp) :: b !< loop index
8444	INTEGER(iwp) :: ee !< loop index
8445	INTEGER(iwp) :: g !< loop index
8446	INTEGER(iwp) :: i !< loop index
8447	INTEGER(iwp) :: j !< loop index
8448	INTEGER(iwp) :: k !< loop index
8449	INTEGER(iwp) :: m !< running index for surface elements
8450	INTEGER(iwp) :: n !< loop index for emission categories
8451	INTEGER(iwp) :: c !< loop index
8452	INTEGER(iwp) :: ss !< loop index
8453
8454	DO m = 1, surface%ns
8455	!
8456	!-- Get indices of respective grid point
8457	i = surface%i(m)
8458	j = surface%j(m)
8459	k = surface%k(m)
8460
8461	DO n = 1, ncat_emission
8462	DO b = 1, nbins
8463	IF ( aerosol_number(b)%source(n,j,i) < 0.0_wp ) THEN
8464	aerosol_number(b)%source(n,j,i) = 0.0_wp
8465	CYCLE
8466	ENDIF
8467	!
8468	!-- Set mass fluxes. First bins include only SO4 and/or OC.
8469
8470	IF ( b <= fn1a ) THEN
8471	!
8472	!-- Both sulphate and organic carbon
8473	IF ( iso4 > 0 .AND. ioc > 0 ) THEN
8474
8475	c = ( iso4 - 1 ) * nbins + b
8476	surface%amsws(m,c) = surface%amsws(m,c) + &
8477	emission_mass_fracs(n,1) / &
8478	( emission_mass_fracs(n,1) + &
8479	emission_mass_fracs(n,2) ) * &
8480	aerosol_number(b)%source(n,j,i) * &
8481	api6 * aero(b)%dmid*3.0_wp &
8482	arhoh2so4 * rho_air_zw(k-1)
8483	aerosol_mass(c)%source(n,j,i) = &
8484	aerosol_mass(c)%source(n,j,i) + surface%amsws(m,c)
8485	c = ( ioc - 1 ) * nbins + b
8486	surface%amsws(m,c) = surface%amsws(m,c) + &
8487	emission_mass_fracs(n,2) / &
8488	( emission_mass_fracs(n,1) + &
8489	emission_mass_fracs(n,2) ) * &
8490	aerosol_number(b)%source(n,j,i) * &
8491	api6 * aero(b)%dmid*3.0_wp arhooc &
8492	* rho_air_zw(k-1)
8493	aerosol_mass(c)%source(n,j,i) = &
8494	aerosol_mass(c)%source(n,j,i) + surface%amsws(m,c)
8495	!
8496	!-- Only sulphates
8497	ELSEIF ( iso4 > 0 .AND. ioc < 0 ) THEN
8498	c = ( iso4 - 1 ) * nbins + b
8499	surface%amsws(m,c) = surface%amsws(m,c) + &
8500	aerosol_number(b)%source(n,j,i) * api6 &
8501	* aero(b)%dmid*3.0_wp arhoh2so4 &
8502	* rho_air_zw(k-1)
8503	aerosol_mass(c)%source(n,j,i) = &
8504	aerosol_mass(c)%source(n,j,i) + surface%amsws(m,c)
8505	!
8506	!-- Only organic carbon
8507	ELSEIF ( iso4 < 0 .AND. ioc > 0 ) THEN
8508	c = ( ioc - 1 ) * nbins + b
8509	surface%amsws(m,c) = surface%amsws(m,c) + &
8510	aerosol_number(b)%source(n,j,i) * api6 &
8511	* aero(b)%dmid*3.0_wp arhooc &
8512	* rho_air_zw(k-1)
8513	aerosol_mass(c)%source(n,j,i) = &
8514	aerosol_mass(c)%source(n,j,i) + surface%amsws(m,c)
8515	ENDIF
8516
8517	ELSEIF ( b > fn1a ) THEN
8518	!
8519	!-- Sulphate
8520	IF ( iso4 > 0 ) THEN
8521	CALL set_mass_flux( surface, m, b, iso4, n, &
8522	emission_mass_fracs(n,1), arhoh2so4, &
8523	aerosol_number(b)%source(n,j,i) )
8524	ENDIF
8525	!
8526	!-- Organic carbon
8527	IF ( ioc > 0 ) THEN
8528	CALL set_mass_flux( surface, m, b, ioc, n, &
8529	emission_mass_fracs(n,2), arhooc, &
8530	aerosol_number(b)%source(n,j,i) )
8531	ENDIF
8532	!
8533	!-- Black carbon
8534	IF ( ibc > 0 ) THEN
8535	CALL set_mass_flux( surface, m, b, ibc, n, &
8536	emission_mass_fracs(n,3), arhobc, &
8537	aerosol_number(b)%source(n,j,i) )
8538	ENDIF
8539	!
8540	!-- Dust
8541	IF ( idu > 0 ) THEN
8542	CALL set_mass_flux( surface, m, b, idu, n, &
8543	emission_mass_fracs(n,4), arhodu, &
8544	aerosol_number(b)%source(n,j,i) )
8545	ENDIF
8546	!
8547	!-- Sea salt
8548	IF ( iss > 0 ) THEN
8549	CALL set_mass_flux( surface, m, b, iss, n, &
8550	emission_mass_fracs(n,5), arhoss, &
8551	aerosol_number(b)%source(n,j,i) )
8552	ENDIF
8553	!
8554	!-- Nitric acid
8555	IF ( ino > 0 ) THEN
8556	CALL set_mass_flux( surface, m, b, ino, n, &
8557	emission_mass_fracs(n,6), arhohno3, &
8558	aerosol_number(b)%source(n,j,i) )
8559	ENDIF
8560	!
8561	!-- Ammonia
8562	IF ( inh > 0 ) THEN
8563	CALL set_mass_flux( surface, m, b, inh, n, &
8564	emission_mass_fracs(n,7), arhonh3, &
8565	aerosol_number(b)%source(n,j,i) )
8566	ENDIF
8567
8568	ENDIF
8569	!
8570	!-- Save number fluxes in the end
8571	surface%answs(m,b) = surface%answs(m,b) + &
8572	aerosol_number(b)%source(n,j,i) * rho_air_zw(k-1)
8573	aerosol_number(b)%source(n,j,i) = surface%answs(m,b)
8574	ENDDO
8575
8576	ENDDO
8577
8578	ENDDO
8579
8580	END SUBROUTINE set_flux
8581
8582	!------------------------------------------------------------------------------!
8583	! Description:
8584	! ------------
8585	!> Sets the mass emissions to aerosol arrays in 2a and 2b.
8586	!------------------------------------------------------------------------------!
8587	SUBROUTINE set_mass_flux( surface, surf_num, b, ispec, n, mass_frac, prho, &
8588	nsource )
8589
8590	USE arrays_3d, &
8591	ONLY: rho_air_zw
8592
8593	USE surface_mod, &
8594	ONLY: surf_type
8595
8596	IMPLICIT NONE
8597
8598	INTEGER(iwp), INTENT(in) :: b !< Aerosol size bin index
8599	INTEGER(iwp), INTENT(in) :: ispec !< Aerosol species index
8600	INTEGER(iwp), INTENT(in) :: n !< emission category number
8601	INTEGER(iwp), INTENT(in) :: surf_num !< index surface elements
8602	REAL(wp), INTENT(in) :: mass_frac !< mass fraction of a chemical
8603	!< compound in all bins
8604	REAL(wp), INTENT(in) :: nsource !< number source (#/m2/s)
8605	REAL(wp), INTENT(in) :: prho !< Aerosol density
8606	TYPE(surf_type), INTENT(inout) :: surface !< respective surface type
8607
8608	INTEGER(iwp) :: ee !< index: end
8609	INTEGER(iwp) :: i !< loop index
8610	INTEGER(iwp) :: j !< loop index
8611	INTEGER(iwp) :: k !< loop index
8612	INTEGER(iwp) :: c !< loop index
8613	INTEGER(iwp) :: ss !<index: start
8614
8615	!
8616	!-- Get indices of respective grid point
8617	i = surface%i(surf_num)
8618	j = surface%j(surf_num)
8619	k = surface%k(surf_num)
8620	!
8621	!-- Subrange 2a:
8622	c = ( ispec - 1 ) * nbins + b
8623	surface%amsws(surf_num,c) = surface%amsws(surf_num,c) + mass_frac * nsource&
8624	* aero(b)%core * prho * rho_air_zw(k-1)
8625	aerosol_mass(c)%source(n,j,i) = aerosol_mass(c)%source(n,j,i) + &
8626	surface%amsws(surf_num,c)
8627	!
8628	!-- Subrange 2b:
8629	IF ( .NOT. no_insoluble ) THEN
8630	WRITE(,) 'All emissions are soluble!'
8631	ENDIF
8632
8633	END SUBROUTINE set_mass_flux
8634
8635	!------------------------------------------------------------------------------!
8636	! Description:
8637	! ------------
8638	!> Sets the mass sources to aerosol arrays in 2a and 2b.
8639	!------------------------------------------------------------------------------!
8640	SUBROUTINE set_mass_source( k, j, i, ispec, mass_frac, prho, nsource, fillval )
8641
8642	USE surface_mod, &
8643	ONLY: surf_type
8644
8645	IMPLICIT NONE
8646
8647	INTEGER(iwp), INTENT(in) :: ispec !< Aerosol species index
8648	REAL(wp), INTENT(in) :: fillval !< _FillValue in the NetCDF file
8649	REAL(wp), INTENT(in) :: mass_frac !< mass fraction of a chemical
8650	!< compound in all bins
8651	REAL(wp), INTENT(in), DIMENSION(:) :: nsource !< number source
8652	REAL(wp), INTENT(in) :: prho !< Aerosol density
8653
8654	INTEGER(iwp) :: b !< loop index
8655	INTEGER(iwp) :: ee !< index: end
8656	INTEGER(iwp) :: i !< loop index
8657	INTEGER(iwp) :: j !< loop index
8658	INTEGER(iwp) :: k !< loop index
8659	INTEGER(iwp) :: c !< loop index
8660	INTEGER(iwp) :: ss !<index: start
8661	!
8662	!-- Subrange 2a:
8663	ss = ( ispec - 1 ) * nbins + in2a
8664	ee = ( ispec - 1 ) * nbins + fn2a
8665	b = in2a
8666	DO c = ss, ee
8667	IF ( nsource(b) /= fillval ) THEN
8668	aerosol_mass(c)%source(k,j,i) = aerosol_mass(c)%source(k,j,i) + &
8669	mass_frac * nsource(b) * aero(b)%core * &
8670	prho
8671	ENDIF
8672	b = b+1
8673	ENDDO
8674	!
8675	!-- Subrange 2b:
8676	IF ( .NOT. no_insoluble ) THEN
8677	WRITE(,) 'All sources are soluble!'
8678	ENDIF
8679
8680	END SUBROUTINE set_mass_source
8681
8682	!------------------------------------------------------------------------------!
8683	! Description:
8684	! ------------
8685	!> Check data output for salsa.
8686	!------------------------------------------------------------------------------!
8687	SUBROUTINE salsa_check_data_output( var, unit )
8688
8689	USE control_parameters, &
8690	ONLY: message_string
8691
8692	IMPLICIT NONE
8693
8694	CHARACTER (LEN=*) :: unit !<
8695	CHARACTER (LEN=*) :: var !<
8696
8697	SELECT CASE ( TRIM( var ) )
8698
8699	CASE ( 'g_H2SO4', 'g_HNO3', 'g_NH3', 'g_OCNV', 'g_OCSV', &
8700	'N_bin1', 'N_bin2', 'N_bin3', 'N_bin4', 'N_bin5', 'N_bin6', &
8701	'N_bin7', 'N_bin8', 'N_bin9', 'N_bin10', 'N_bin11', 'N_bin12', &
8702	'Ntot' )
8703	IF ( .NOT. salsa ) THEN
8704	message_string = 'output of "' // TRIM( var ) // '" requi' // &
8705	'res salsa = .TRUE.'
8706	CALL message( 'check_parameters', 'SA0006', 1, 2, 0, 6, 0 )
8707	ENDIF
8708	unit = '#/m3'
8709
8710	CASE ( 'LDSA' )
8711	IF ( .NOT. salsa ) THEN
8712	message_string = 'output of "' // TRIM( var ) // '" requi' // &
8713	'res salsa = .TRUE.'
8714	CALL message( 'check_parameters', 'SA0003', 1, 2, 0, 6, 0 )
8715	ENDIF
8716	unit = 'mum2/cm3'
8717
8718	CASE ( 'm_bin1', 'm_bin2', 'm_bin3', 'm_bin4', 'm_bin5', 'm_bin6', &
8719	'm_bin7', 'm_bin8', 'm_bin9', 'm_bin10', 'm_bin11', 'm_bin12', &
8720	'PM2.5', 'PM10', 's_BC', 's_DU', 's_H2O', 's_NH', &
8721	's_NO', 's_OC', 's_SO4', 's_SS' )
8722	IF ( .NOT. salsa ) THEN
8723	message_string = 'output of "' // TRIM( var ) // '" requi' // &
8724	'res salsa = .TRUE.'
8725	CALL message( 'check_parameters', 'SA0001', 1, 2, 0, 6, 0 )
8726	ENDIF
8727	unit = 'kg/m3'
8728
8729	CASE DEFAULT
8730	unit = 'illegal'
8731
8732	END SELECT
8733
8734	END SUBROUTINE salsa_check_data_output
8735
8736	!------------------------------------------------------------------------------!
8737	!
8738	! Description:
8739	! ------------
8740	!> Subroutine for averaging 3D data
8741	!------------------------------------------------------------------------------!
8742	SUBROUTINE salsa_3d_data_averaging( mode, variable )
8743
8744
8745	USE control_parameters
8746
8747	USE indices
8748
8749	USE kinds
8750
8751	IMPLICIT NONE
8752
8753	CHARACTER (LEN=*) :: mode !<
8754	CHARACTER (LEN=*) :: variable !<
8755
8756	INTEGER(iwp) :: b !<
8757	INTEGER(iwp) :: c !<
8758	INTEGER(iwp) :: i !<
8759	INTEGER(iwp) :: icc !<
8760	INTEGER(iwp) :: j !<
8761	INTEGER(iwp) :: k !<
8762
8763	REAL(wp) :: df !< For calculating LDSA: fraction of particles
8764	!< depositing in the alveolar (or tracheobronchial)
8765	!< region of the lung. Depends on the particle size
8766	REAL(wp) :: mean_d !< Particle diameter in micrometres
8767	REAL(wp) :: nc !< Particle number concentration in units 1/cm**3
8768	REAL(wp) :: temp_bin !<
8769	REAL(wp), DIMENSION(:,:,:), POINTER :: to_be_resorted !< points to
8770	!< selected output variable
8771
8772	temp_bin = 0.0_wp
8773
8774	IF ( mode == 'allocate' ) THEN
8775
8776	SELECT CASE ( TRIM( variable ) )
8777
8778	CASE ( 'g_H2SO4' )
8779	IF ( .NOT. ALLOCATED( g_H2SO4_av ) ) THEN
8780	ALLOCATE( g_H2SO4_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
8781	ENDIF
8782	g_H2SO4_av = 0.0_wp
8783
8784	CASE ( 'g_HNO3' )
8785	IF ( .NOT. ALLOCATED( g_HNO3_av ) ) THEN
8786	ALLOCATE( g_HNO3_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
8787	ENDIF
8788	g_HNO3_av = 0.0_wp
8789
8790	CASE ( 'g_NH3' )
8791	IF ( .NOT. ALLOCATED( g_NH3_av ) ) THEN
8792	ALLOCATE( g_NH3_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
8793	ENDIF
8794	g_NH3_av = 0.0_wp
8795
8796	CASE ( 'g_OCNV' )
8797	IF ( .NOT. ALLOCATED( g_OCNV_av ) ) THEN
8798	ALLOCATE( g_OCNV_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
8799	ENDIF
8800	g_OCNV_av = 0.0_wp
8801
8802	CASE ( 'g_OCSV' )
8803	IF ( .NOT. ALLOCATED( g_OCSV_av ) ) THEN
8804	ALLOCATE( g_OCSV_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
8805	ENDIF
8806	g_OCSV_av = 0.0_wp
8807
8808	CASE ( 'LDSA' )
8809	IF ( .NOT. ALLOCATED( LDSA_av ) ) THEN
8810	ALLOCATE( LDSA_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
8811	ENDIF
8812	LDSA_av = 0.0_wp
8813
8814	CASE ( 'N_bin1', 'N_bin2', 'N_bin3', 'N_bin4', 'N_bin5', 'N_bin6', &
8815	'N_bin7', 'N_bin8', 'N_bin9', 'N_bin10', 'N_bin11', 'N_bin12' )
8816	IF ( .NOT. ALLOCATED( Nbins_av ) ) THEN
8817	ALLOCATE( Nbins_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg,nbins) )
8818	ENDIF
8819	Nbins_av = 0.0_wp
8820
8821	CASE ( 'Ntot' )
8822	IF ( .NOT. ALLOCATED( Ntot_av ) ) THEN
8823	ALLOCATE( Ntot_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
8824	ENDIF
8825	Ntot_av = 0.0_wp
8826
8827	CASE ( 'm_bin1', 'm_bin2', 'm_bin3', 'm_bin4', 'm_bin5', 'm_bin6', &
8828	'm_bin7', 'm_bin8', 'm_bin9', 'm_bin10', 'm_bin11', 'm_bin12' )
8829	IF ( .NOT. ALLOCATED( mbins_av ) ) THEN
8830	ALLOCATE( mbins_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg,nbins) )
8831	ENDIF
8832	mbins_av = 0.0_wp
8833
8834	CASE ( 'PM2.5' )
8835	IF ( .NOT. ALLOCATED( PM25_av ) ) THEN
8836	ALLOCATE( PM25_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
8837	ENDIF
8838	PM25_av = 0.0_wp
8839
8840	CASE ( 'PM10' )
8841	IF ( .NOT. ALLOCATED( PM10_av ) ) THEN
8842	ALLOCATE( PM10_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
8843	ENDIF
8844	PM10_av = 0.0_wp
8845
8846	CASE ( 's_BC' )
8847	IF ( .NOT. ALLOCATED( s_BC_av ) ) THEN
8848	ALLOCATE( s_BC_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
8849	ENDIF
8850	s_BC_av = 0.0_wp
8851
8852	CASE ( 's_DU' )
8853	IF ( .NOT. ALLOCATED( s_DU_av ) ) THEN
8854	ALLOCATE( s_DU_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
8855	ENDIF
8856	s_DU_av = 0.0_wp
8857
8858	CASE ( 's_H2O' )
8859	IF ( .NOT. ALLOCATED( s_H2O_av ) ) THEN
8860	ALLOCATE( s_H2O_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
8861	ENDIF
8862	s_H2O_av = 0.0_wp
8863
8864	CASE ( 's_NH' )
8865	IF ( .NOT. ALLOCATED( s_NH_av ) ) THEN
8866	ALLOCATE( s_NH_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
8867	ENDIF
8868	s_NH_av = 0.0_wp
8869
8870	CASE ( 's_NO' )
8871	IF ( .NOT. ALLOCATED( s_NO_av ) ) THEN
8872	ALLOCATE( s_NO_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
8873	ENDIF
8874	s_NO_av = 0.0_wp
8875
8876	CASE ( 's_OC' )
8877	IF ( .NOT. ALLOCATED( s_OC_av ) ) THEN
8878	ALLOCATE( s_OC_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
8879	ENDIF
8880	s_OC_av = 0.0_wp
8881
8882	CASE ( 's_SO4' )
8883	IF ( .NOT. ALLOCATED( s_SO4_av ) ) THEN
8884	ALLOCATE( s_SO4_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
8885	ENDIF
8886	s_SO4_av = 0.0_wp
8887
8888	CASE ( 's_SS' )
8889	IF ( .NOT. ALLOCATED( s_SS_av ) ) THEN
8890	ALLOCATE( s_SS_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
8891	ENDIF
8892	s_SS_av = 0.0_wp
8893
8894	CASE DEFAULT
8895	CONTINUE
8896
8897	END SELECT
8898
8899	ELSEIF ( mode == 'sum' ) THEN
8900
8901	SELECT CASE ( TRIM( variable ) )
8902
8903	CASE ( 'g_H2SO4', 'g_HNO3', 'g_NH3', 'g_OCNV', 'g_OCSV' )
8904	IF ( TRIM( variable(3:) ) == 'H2SO4' ) THEN
8905	icc = 1
8906	to_be_resorted => g_H2SO4_av
8907	ELSEIF ( TRIM( variable(3:) ) == 'HNO3' ) THEN
8908	icc = 2
8909	to_be_resorted => g_HNO3_av
8910	ELSEIF ( TRIM( variable(3:) ) == 'NH3' ) THEN
8911	icc = 3
8912	to_be_resorted => g_NH3_av
8913	ELSEIF ( TRIM( variable(3:) ) == 'OCNV' ) THEN
8914	icc = 4
8915	to_be_resorted => g_OCNV_av
8916	ELSEIF ( TRIM( variable(3:) ) == 'OCSV' ) THEN
8917	icc = 5
8918	to_be_resorted => g_OCSV_av
8919	ENDIF
8920	DO i = nxlg, nxrg
8921	DO j = nysg, nyng
8922	DO k = nzb, nzt+1
8923	to_be_resorted(k,j,i) = to_be_resorted(k,j,i) + &
8924	salsa_gas(icc)%conc(k,j,i)
8925	ENDDO
8926	ENDDO
8927	ENDDO
8928
8929	CASE ( 'LDSA' )
8930	DO i = nxlg, nxrg
8931	DO j = nysg, nyng
8932	DO k = nzb, nzt+1
8933	temp_bin = 0.0_wp
8934	DO b = 1, nbins
8935	!
8936	!-- Diameter in micrometres
8937	mean_d = 1.0E+6_wp * Ra_dry(k,j,i,b) * 2.0_wp
8938	!
8939	!-- Deposition factor: alveolar (use Ra_dry)
8940	df = ( 0.01555_wp / mean_d ) * ( EXP( -0.416_wp * &
8941	( LOG( mean_d ) + 2.84_wp )**2.0_wp ) &
8942	+ 19.11_wp * EXP( -0.482_wp * &
8943	( LOG( mean_d ) - 1.362_wp )**2.0_wp ) )
8944	!
8945	!-- Number concentration in 1/cm3
8946	nc = 1.0E-6_wp * aerosol_number(b)%conc(k,j,i)
8947	!
8948	!-- Lung-deposited surface area LDSA (units mum2/cm3)
8949	temp_bin = temp_bin + pi * mean_d*2.0_wp df * nc
8950	ENDDO
8951	LDSA_av(k,j,i) = LDSA_av(k,j,i) + temp_bin
8952	ENDDO
8953	ENDDO
8954	ENDDO
8955
8956	CASE ( 'N_bin1', 'N_bin2', 'N_bin3', 'N_bin4', 'N_bin5', 'N_bin6', &
8957	'N_bin7', 'N_bin8', 'N_bin9', 'N_bin10', 'N_bin11', 'N_bin12' )
8958	DO i = nxlg, nxrg
8959	DO j = nysg, nyng
8960	DO k = nzb, nzt+1
8961	DO b = 1, nbins
8962	Nbins_av(k,j,i,b) = Nbins_av(k,j,i,b) + &
8963	aerosol_number(b)%conc(k,j,i)
8964	ENDDO
8965	ENDDO
8966	ENDDO
8967	ENDDO
8968
8969	CASE ( 'Ntot' )
8970	DO i = nxlg, nxrg
8971	DO j = nysg, nyng
8972	DO k = nzb, nzt+1
8973	DO b = 1, nbins
8974	Ntot_av(k,j,i) = Ntot_av(k,j,i) + &
8975	aerosol_number(b)%conc(k,j,i)
8976	ENDDO
8977	ENDDO
8978	ENDDO
8979	ENDDO
8980
8981	CASE ( 'm_bin1', 'm_bin2', 'm_bin3', 'm_bin4', 'm_bin5', 'm_bin6', &
8982	'm_bin7', 'm_bin8', 'm_bin9', 'm_bin10', 'm_bin11', 'm_bin12' )
8983	DO i = nxlg, nxrg
8984	DO j = nysg, nyng
8985	DO k = nzb, nzt+1
8986	DO b = 1, nbins
8987	DO c = b, nbins*ncc_tot, nbins
8988	mbins_av(k,j,i,b) = mbins_av(k,j,i,b) + &
8989	aerosol_mass(c)%conc(k,j,i)
8990	ENDDO
8991	ENDDO
8992	ENDDO
8993	ENDDO
8994	ENDDO
8995
8996	CASE ( 'PM2.5' )
8997	DO i = nxlg, nxrg
8998	DO j = nysg, nyng
8999	DO k = nzb, nzt+1
9000	temp_bin = 0.0_wp
9001	DO b = 1, nbins
9002	IF ( 2.0_wp * Ra_dry(k,j,i,b) <= 2.5E-6_wp ) THEN
9003	DO c = b, nbins*ncc, nbins
9004	temp_bin = temp_bin + aerosol_mass(c)%conc(k,j,i)
9005	ENDDO
9006	ENDIF
9007	ENDDO
9008	PM25_av(k,j,i) = PM25_av(k,j,i) + temp_bin
9009	ENDDO
9010	ENDDO
9011	ENDDO
9012
9013	CASE ( 'PM10' )
9014	DO i = nxlg, nxrg
9015	DO j = nysg, nyng
9016	DO k = nzb, nzt+1
9017	temp_bin = 0.0_wp
9018	DO b = 1, nbins
9019	IF ( 2.0_wp * Ra_dry(k,j,i,b) <= 10.0E-6_wp ) THEN
9020	DO c = b, nbins*ncc, nbins
9021	temp_bin = temp_bin + aerosol_mass(c)%conc(k,j,i)
9022	ENDDO
9023	ENDIF
9024	ENDDO
9025	PM10_av(k,j,i) = PM10_av(k,j,i) + temp_bin
9026	ENDDO
9027	ENDDO
9028	ENDDO
9029
9030	CASE ( 's_BC', 's_DU', 's_H2O', 's_NH', 's_NO', 's_OC', 's_SO4', &
9031	's_SS' )
9032	IF ( is_used( prtcl, TRIM( variable(3:) ) ) ) THEN
9033	icc = get_index( prtcl, TRIM( variable(3:) ) )
9034	IF ( TRIM( variable(3:) ) == 'BC' ) to_be_resorted => s_BC_av
9035	IF ( TRIM( variable(3:) ) == 'DU' ) to_be_resorted => s_DU_av
9036	IF ( TRIM( variable(3:) ) == 'NH' ) to_be_resorted => s_NH_av
9037	IF ( TRIM( variable(3:) ) == 'NO' ) to_be_resorted => s_NO_av
9038	IF ( TRIM( variable(3:) ) == 'OC' ) to_be_resorted => s_OC_av
9039	IF ( TRIM( variable(3:) ) == 'SO4' ) to_be_resorted => s_SO4_av
9040	IF ( TRIM( variable(3:) ) == 'SS' ) to_be_resorted => s_SS_av
9041	DO i = nxlg, nxrg
9042	DO j = nysg, nyng
9043	DO k = nzb, nzt+1
9044	DO c = ( icc-1 )nbins+1, iccnbins
9045	to_be_resorted(k,j,i) = to_be_resorted(k,j,i) + &
9046	aerosol_mass(c)%conc(k,j,i)
9047	ENDDO
9048	ENDDO
9049	ENDDO
9050	ENDDO
9051	ENDIF
9052
9053	CASE DEFAULT
9054	CONTINUE
9055
9056	END SELECT
9057
9058	ELSEIF ( mode == 'average' ) THEN
9059
9060	SELECT CASE ( TRIM( variable ) )
9061
9062	CASE ( 'g_H2SO4', 'g_HNO3', 'g_NH3', 'g_OCNV', 'g_OCSV' )
9063	IF ( TRIM( variable(3:) ) == 'H2SO4' ) THEN
9064	icc = 1
9065	to_be_resorted => g_H2SO4_av
9066	ELSEIF ( TRIM( variable(3:) ) == 'HNO3' ) THEN
9067	icc = 2
9068	to_be_resorted => g_HNO3_av
9069	ELSEIF ( TRIM( variable(3:) ) == 'NH3' ) THEN
9070	icc = 3
9071	to_be_resorted => g_NH3_av
9072	ELSEIF ( TRIM( variable(3:) ) == 'OCNV' ) THEN
9073	icc = 4
9074	to_be_resorted => g_OCNV_av
9075	ELSEIF ( TRIM( variable(3:) ) == 'OCSV' ) THEN
9076	icc = 5
9077	to_be_resorted => g_OCSV_av
9078	ENDIF
9079	DO i = nxlg, nxrg
9080	DO j = nysg, nyng
9081	DO k = nzb, nzt+1
9082	to_be_resorted(k,j,i) = to_be_resorted(k,j,i) &
9083	/ REAL( average_count_3d, KIND=wp )
9084	ENDDO
9085	ENDDO
9086	ENDDO
9087
9088	CASE ( 'LDSA' )
9089	DO i = nxlg, nxrg
9090	DO j = nysg, nyng
9091	DO k = nzb, nzt+1
9092	LDSA_av(k,j,i) = LDSA_av(k,j,i) &
9093	/ REAL( average_count_3d, KIND=wp )
9094	ENDDO
9095	ENDDO
9096	ENDDO
9097
9098	CASE ( 'N_bin1', 'N_bin2', 'N_bin3', 'N_bin4', 'N_bin5', 'N_bin6', &
9099	'N_bin7', 'N_bin8', 'N_bin9', 'N_bin10', 'N_bin11', 'N_bin12' )
9100	DO i = nxlg, nxrg
9101	DO j = nysg, nyng
9102	DO k = nzb, nzt+1
9103	DO b = 1, nbins
9104	Nbins_av(k,j,i,b) = Nbins_av(k,j,i,b) &
9105	/ REAL( average_count_3d, KIND=wp )
9106	ENDDO
9107	ENDDO
9108	ENDDO
9109	ENDDO
9110
9111	CASE ( 'Ntot' )
9112	DO i = nxlg, nxrg
9113	DO j = nysg, nyng
9114	DO k = nzb, nzt+1
9115	Ntot_av(k,j,i) = Ntot_av(k,j,i) &
9116	/ REAL( average_count_3d, KIND=wp )
9117	ENDDO
9118	ENDDO
9119	ENDDO
9120
9121	CASE ( 'm_bin1', 'm_bin2', 'm_bin3', 'm_bin4', 'm_bin5', 'm_bin6', &
9122	'm_bin7', 'm_bin8', 'm_bin9', 'm_bin10', 'm_bin11', 'm_bin12' )
9123	DO i = nxlg, nxrg
9124	DO j = nysg, nyng
9125	DO k = nzb, nzt+1
9126	DO b = 1, nbins
9127	DO c = b, nbins*ncc, nbins
9128	mbins_av(k,j,i,b) = mbins_av(k,j,i,b) &
9129	/ REAL( average_count_3d, KIND=wp )
9130	ENDDO
9131	ENDDO
9132	ENDDO
9133	ENDDO
9134	ENDDO
9135
9136	CASE ( 'PM2.5' )
9137	DO i = nxlg, nxrg
9138	DO j = nysg, nyng
9139	DO k = nzb, nzt+1
9140	PM25_av(k,j,i) = PM25_av(k,j,i) &
9141	/ REAL( average_count_3d, KIND=wp )
9142	ENDDO
9143	ENDDO
9144	ENDDO
9145
9146	CASE ( 'PM10' )
9147	DO i = nxlg, nxrg
9148	DO j = nysg, nyng
9149	DO k = nzb, nzt+1
9150	PM10_av(k,j,i) = PM10_av(k,j,i) &
9151	/ REAL( average_count_3d, KIND=wp )
9152	ENDDO
9153	ENDDO
9154	ENDDO
9155
9156	CASE ( 's_BC', 's_DU', 's_H2O', 's_NH', 's_NO', 's_OC', 's_SO4', &
9157	's_SS' )
9158	IF ( is_used( prtcl, TRIM( variable(3:) ) ) ) THEN
9159	icc = get_index( prtcl, TRIM( variable(3:) ) )
9160	IF ( TRIM( variable(3:) ) == 'BC' ) to_be_resorted => s_BC_av
9161	IF ( TRIM( variable(3:) ) == 'DU' ) to_be_resorted => s_DU_av
9162	IF ( TRIM( variable(3:) ) == 'NH' ) to_be_resorted => s_NH_av
9163	IF ( TRIM( variable(3:) ) == 'NO' ) to_be_resorted => s_NO_av
9164	IF ( TRIM( variable(3:) ) == 'OC' ) to_be_resorted => s_OC_av
9165	IF ( TRIM( variable(3:) ) == 'SO4' ) to_be_resorted => s_SO4_av
9166	IF ( TRIM( variable(3:) ) == 'SS' ) to_be_resorted => s_SS_av
9167	DO i = nxlg, nxrg
9168	DO j = nysg, nyng
9169	DO k = nzb, nzt+1
9170	to_be_resorted(k,j,i) = to_be_resorted(k,j,i) &
9171	/ REAL( average_count_3d, KIND=wp )
9172	ENDDO
9173	ENDDO
9174	ENDDO
9175	ENDIF
9176
9177	END SELECT
9178
9179	ENDIF
9180
9181	END SUBROUTINE salsa_3d_data_averaging
9182
9183
9184	!------------------------------------------------------------------------------!
9185	!
9186	! Description:
9187	! ------------
9188	!> Subroutine defining 2D output variables
9189	!------------------------------------------------------------------------------!
9190	SUBROUTINE salsa_data_output_2d( av, variable, found, grid, mode, &
9191	local_pf, two_d )
9192
9193	USE indices
9194
9195	USE kinds
9196
9197	IMPLICIT NONE
9198
9199	CHARACTER (LEN=*) :: grid !<
9200	CHARACTER (LEN=*) :: mode !<
9201	CHARACTER (LEN=*) :: variable !<
9202	CHARACTER (LEN=5) :: vari !< trimmed format of variable
9203
9204	INTEGER(iwp) :: av !<
9205	INTEGER(iwp) :: b !<
9206	INTEGER(iwp) :: c !<
9207	INTEGER(iwp) :: i !<
9208	INTEGER(iwp) :: icc !< index of a chemical compound
9209	INTEGER(iwp) :: j !<
9210	INTEGER(iwp) :: k !<
9211
9212	LOGICAL :: found !<
9213	LOGICAL :: two_d !< flag parameter that indicates 2D variables
9214	!< (horizontal cross sections)
9215
9216	REAL(wp) :: df !< For calculating LDSA: fraction of particles
9217	!< depositing in the alveolar (or tracheobronchial)
9218	!< region of the lung. Depends on the particle size
9219	REAL(wp) :: mean_d !< Particle diameter in micrometres
9220	REAL(wp) :: nc !< Particle number concentration in units 1/cm**3
9221	REAL(wp), DIMENSION(nxl:nxr,nys:nyn,nzb:nzt+1) :: local_pf !< local
9222	!< array to which output data is resorted to
9223	REAL(wp) :: temp_bin !<
9224	REAL(wp), DIMENSION(:,:,:), POINTER :: to_be_resorted !< points to
9225	!< selected output variable
9226
9227	found = .TRUE.
9228	temp_bin = 0.0_wp
9229
9230	IF ( TRIM( variable(1:2) ) == 'g_' ) THEN
9231	vari = TRIM( variable( 3:LEN( TRIM( variable ) ) - 3 ) )
9232	IF ( av == 0 ) THEN
9233	IF ( vari == 'H2SO4') icc = 1
9234	IF ( vari == 'HNO3') icc = 2
9235	IF ( vari == 'NH3') icc = 3
9236	IF ( vari == 'OCNV') icc = 4
9237	IF ( vari == 'OCSV') icc = 5
9238	DO i = nxl, nxr
9239	DO j = nys, nyn
9240	DO k = nzb, nzt+1
9241	local_pf(i,j,k) = MERGE( salsa_gas(icc)%conc(k,j,i), &
9242	REAL( -999.0_wp, KIND = wp ), &
9243	BTEST( wall_flags_0(k,j,i), 0 ) )
9244	ENDDO
9245	ENDDO
9246	ENDDO
9247	ELSE
9248	IF ( vari == 'H2SO4' ) to_be_resorted => g_H2SO4_av
9249	IF ( vari == 'HNO3' ) to_be_resorted => g_HNO3_av
9250	IF ( vari == 'NH3' ) to_be_resorted => g_NH3_av
9251	IF ( vari == 'OCNV' ) to_be_resorted => g_OCNV_av
9252	IF ( vari == 'OCSV' ) to_be_resorted => g_OCSV_av
9253	DO i = nxl, nxr
9254	DO j = nys, nyn
9255	DO k = nzb, nzt+1
9256	local_pf(i,j,k) = MERGE( to_be_resorted(k,j,i), &
9257	REAL( -999.0_wp, KIND = wp ), &
9258	BTEST( wall_flags_0(k,j,i), 0 ) )
9259	ENDDO
9260	ENDDO
9261	ENDDO
9262	ENDIF
9263
9264	IF ( mode == 'xy' ) grid = 'zu'
9265
9266	ELSEIF ( TRIM( variable(1:4) ) == 'LDSA' ) THEN
9267	IF ( av == 0 ) THEN
9268	DO i = nxl, nxr
9269	DO j = nys, nyn
9270	DO k = nzb, nzt+1
9271	temp_bin = 0.0_wp
9272	DO b = 1, nbins
9273	!
9274	!-- Diameter in micrometres
9275	mean_d = 1.0E+6_wp * Ra_dry(k,j,i,b) * 2.0_wp
9276	!
9277	!-- Deposition factor: alveolar
9278	df = ( 0.01555_wp / mean_d ) * ( EXP( -0.416_wp * ( LOG( &
9279	mean_d ) + 2.84_wp )*2.0_wp ) + 19.11_wp EXP( &
9280	-0.482_wp * ( LOG( mean_d ) - 1.362_wp )**2.0_wp ) )
9281	!
9282	!-- Number concentration in 1/cm3
9283	nc = 1.0E-6_wp * aerosol_number(b)%conc(k,j,i)
9284	!
9285	!-- Lung-deposited surface area LDSA (units mum2/cm3)
9286	temp_bin = temp_bin + pi * mean_d*2.0_wp df * nc
9287	ENDDO
9288	local_pf(i,j,k) = MERGE( temp_bin, REAL( -999.0_wp, &
9289	KIND = wp ), BTEST( wall_flags_0(k,j,i), 0 ) )
9290	ENDDO
9291	ENDDO
9292	ENDDO
9293	ELSE
9294	DO i = nxl, nxr
9295	DO j = nys, nyn
9296	DO k = nzb, nzt+1
9297	local_pf(i,j,k) = MERGE( LDSA_av(k,j,i), REAL( -999.0_wp, &
9298	KIND = wp ), BTEST( wall_flags_0(k,j,i), 0 ) )
9299	ENDDO
9300	ENDDO
9301	ENDDO
9302	ENDIF
9303
9304	IF ( mode == 'xy' ) grid = 'zu'
9305
9306	ELSEIF ( TRIM( variable(1:6) ) == 'N_bin1' ) THEN
9307	IF ( av == 0 ) THEN
9308	DO i = nxl, nxr
9309	DO j = nys, nyn
9310	DO k = nzb, nzt+1
9311	local_pf(i,j,k) = MERGE( aerosol_number(1)%conc(k,j,i), &
9312	REAL( -999.0_wp, KIND = wp ), &
9313	BTEST( wall_flags_0(k,j,i), 0 ) )
9314	ENDDO
9315	ENDDO
9316	ENDDO
9317	ELSE
9318	DO i = nxl, nxr
9319	DO j = nys, nyn
9320	DO k = nzb, nzt+1
9321	local_pf(i,j,k) = MERGE( Nbins_av(k,j,i,1), &
9322	REAL( -999.0_wp, KIND = wp ), &
9323	BTEST( wall_flags_0(k,j,i), 0 ) )
9324	ENDDO
9325	ENDDO
9326	ENDDO
9327	ENDIF
9328
9329	ELSEIF ( TRIM( variable(1:6) ) == 'N_bin2' ) THEN
9330	IF ( av == 0 ) THEN
9331	DO i = nxl, nxr
9332	DO j = nys, nyn
9333	DO k = nzb, nzt+1
9334	local_pf(i,j,k) = MERGE( aerosol_number(2)%conc(k,j,i), &
9335	REAL( -999.0_wp, KIND = wp ), &
9336	BTEST( wall_flags_0(k,j,i), 0 ) )
9337	ENDDO
9338	ENDDO
9339	ENDDO
9340	ELSE
9341	DO i = nxl, nxr
9342	DO j = nys, nyn
9343	DO k = nzb, nzt+1
9344	local_pf(i,j,k) = MERGE( Nbins_av(k,j,i,2), &
9345	REAL( -999.0_wp, KIND = wp ), &
9346	BTEST( wall_flags_0(k,j,i), 0 ) )
9347	ENDDO
9348	ENDDO
9349	ENDDO
9350	ENDIF
9351
9352	ELSEIF ( TRIM( variable(1:6) ) == 'N_bin3' ) THEN
9353	IF ( av == 0 ) THEN
9354	DO i = nxl, nxr
9355	DO j = nys, nyn
9356	DO k = nzb, nzt+1
9357	local_pf(i,j,k) = MERGE( aerosol_number(3)%conc(k,j,i), &
9358	REAL( -999.0_wp, KIND = wp ), &
9359	BTEST( wall_flags_0(k,j,i), 0 ) )
9360	ENDDO
9361	ENDDO
9362	ENDDO
9363	ELSE
9364	DO i = nxl, nxr
9365	DO j = nys, nyn
9366	DO k = nzb, nzt+1
9367	local_pf(i,j,k) = MERGE( Nbins_av(k,j,i,3), &
9368	REAL( -999.0_wp, KIND = wp ), &
9369	BTEST( wall_flags_0(k,j,i), 0 ) )
9370	ENDDO
9371	ENDDO
9372	ENDDO
9373	ENDIF
9374
9375	ELSEIF ( TRIM( variable(1:6) ) == 'N_bin4' ) THEN
9376	IF ( av == 0 ) THEN
9377	DO i = nxl, nxr
9378	DO j = nys, nyn
9379	DO k = nzb, nzt+1
9380	local_pf(i,j,k) = MERGE( aerosol_number(4)%conc(k,j,i), &
9381	REAL( -999.0_wp, KIND = wp ), &
9382	BTEST( wall_flags_0(k,j,i), 0 ) )
9383	ENDDO
9384	ENDDO
9385	ENDDO
9386	ELSE
9387	DO i = nxl, nxr
9388	DO j = nys, nyn
9389	DO k = nzb, nzt+1
9390	local_pf(i,j,k) = MERGE( Nbins_av(k,j,i,4), &
9391	REAL( -999.0_wp, KIND = wp ), &
9392	BTEST( wall_flags_0(k,j,i), 0 ) )
9393	ENDDO
9394	ENDDO
9395	ENDDO
9396	ENDIF
9397
9398	ELSEIF ( TRIM( variable(1:6) ) == 'N_bin5' ) THEN
9399	IF ( av == 0 ) THEN
9400	DO i = nxl, nxr
9401	DO j = nys, nyn
9402	DO k = nzb, nzt+1
9403	local_pf(i,j,k) = MERGE( aerosol_number(5)%conc(k,j,i), &
9404	REAL( -999.0_wp, KIND = wp ), &
9405	BTEST( wall_flags_0(k,j,i), 0 ) )
9406	ENDDO
9407	ENDDO
9408	ENDDO
9409	ELSE
9410	DO i = nxl, nxr
9411	DO j = nys, nyn
9412	DO k = nzb, nzt+1
9413	local_pf(i,j,k) = MERGE( Nbins_av(k,j,i,5), &
9414	REAL( -999.0_wp, KIND = wp ), &
9415	BTEST( wall_flags_0(k,j,i), 0 ) )
9416	ENDDO
9417	ENDDO
9418	ENDDO
9419	ENDIF
9420
9421	ELSEIF ( TRIM( variable(1:6) ) == 'N_bin6' ) THEN
9422	IF ( av == 0 ) THEN
9423	DO i = nxl, nxr
9424	DO j = nys, nyn
9425	DO k = nzb, nzt+1
9426	local_pf(i,j,k) = MERGE( aerosol_number(6)%conc(k,j,i), &
9427	REAL( -999.0_wp, KIND = wp ), &
9428	BTEST( wall_flags_0(k,j,i), 0 ) )
9429	ENDDO
9430	ENDDO
9431	ENDDO
9432	ELSE
9433	DO i = nxl, nxr
9434	DO j = nys, nyn
9435	DO k = nzb, nzt+1
9436	local_pf(i,j,k) = MERGE( Nbins_av(k,j,i,6), &
9437	REAL( -999.0_wp, KIND = wp ), &
9438	BTEST( wall_flags_0(k,j,i), 0 ) )
9439	ENDDO
9440	ENDDO
9441	ENDDO
9442	ENDIF
9443
9444	ELSEIF ( TRIM( variable(1:6) ) == 'N_bin7' ) THEN
9445	IF ( av == 0 ) THEN
9446	DO i = nxl, nxr
9447	DO j = nys, nyn
9448	DO k = nzb, nzt+1
9449	local_pf(i,j,k) = MERGE( aerosol_number(7)%conc(k,j,i), &
9450	REAL( -999.0_wp, KIND = wp ), &
9451	BTEST( wall_flags_0(k,j,i), 0 ) )
9452	ENDDO
9453	ENDDO
9454	ENDDO
9455	ELSE
9456	DO i = nxl, nxr
9457	DO j = nys, nyn
9458	DO k = nzb, nzt+1
9459	local_pf(i,j,k) = MERGE( Nbins_av(k,j,i,7), &
9460	REAL( -999.0_wp, KIND = wp ), &
9461	BTEST( wall_flags_0(k,j,i), 0 ) )
9462	ENDDO
9463	ENDDO
9464	ENDDO
9465	ENDIF
9466
9467	ELSEIF ( TRIM( variable(1:6) ) == 'N_bin8' ) THEN
9468	IF ( av == 0 ) THEN
9469	DO i = nxl, nxr
9470	DO j = nys, nyn
9471	DO k = nzb, nzt+1
9472	local_pf(i,j,k) = MERGE( aerosol_number(8)%conc(k,j,i), &
9473	REAL( -999.0_wp, KIND = wp ), &
9474	BTEST( wall_flags_0(k,j,i), 0 ) )
9475	ENDDO
9476	ENDDO
9477	ENDDO
9478	ELSE
9479	DO i = nxl, nxr
9480	DO j = nys, nyn
9481	DO k = nzb, nzt+1
9482	local_pf(i,j,k) = MERGE( Nbins_av(k,j,i,8), &
9483	REAL( -999.0_wp, KIND = wp ), &
9484	BTEST( wall_flags_0(k,j,i), 0 ) )
9485	ENDDO
9486	ENDDO
9487	ENDDO
9488	ENDIF
9489
9490	ELSEIF ( TRIM( variable(1:6) ) == 'N_bin9' ) THEN
9491	IF ( av == 0 ) THEN
9492	DO i = nxl, nxr
9493	DO j = nys, nyn
9494	DO k = nzb, nzt+1
9495	local_pf(i,j,k) = MERGE( aerosol_number(9)%conc(k,j,i), &
9496	REAL( -999.0_wp, KIND = wp ), &
9497	BTEST( wall_flags_0(k,j,i), 0 ) )
9498	ENDDO
9499	ENDDO
9500	ENDDO
9501	ELSE
9502	DO i = nxl, nxr
9503	DO j = nys, nyn
9504	DO k = nzb, nzt+1
9505	local_pf(i,j,k) = MERGE( Nbins_av(k,j,i,9), &
9506	REAL( -999.0_wp, KIND = wp ), &
9507	BTEST( wall_flags_0(k,j,i), 0 ) )
9508	ENDDO
9509	ENDDO
9510	ENDDO
9511	ENDIF
9512
9513	ELSEIF ( TRIM( variable(1:7) ) == 'N_bin10' ) THEN
9514	IF ( av == 0 ) THEN
9515	DO i = nxl, nxr
9516	DO j = nys, nyn
9517	DO k = nzb, nzt+1
9518	local_pf(i,j,k) = MERGE( aerosol_number(10)%conc(k,j,i), &
9519	REAL( -999.0_wp, KIND = wp ), &
9520	BTEST( wall_flags_0(k,j,i), 0 ) )
9521	ENDDO
9522	ENDDO
9523	ENDDO
9524	ELSE
9525	DO i = nxl, nxr
9526	DO j = nys, nyn
9527	DO k = nzb, nzt+1
9528	local_pf(i,j,k) = MERGE( Nbins_av(k,j,i,10), &
9529	REAL( -999.0_wp, KIND = wp ), &
9530	BTEST( wall_flags_0(k,j,i), 0 ) )
9531	ENDDO
9532	ENDDO
9533	ENDDO
9534	ENDIF
9535
9536	ELSEIF ( TRIM( variable(1:7) ) == 'N_bin11' ) THEN
9537	IF ( av == 0 ) THEN
9538	DO i = nxl, nxr
9539	DO j = nys, nyn
9540	DO k = nzb, nzt+1
9541	local_pf(i,j,k) = MERGE( aerosol_number(11)%conc(k,j,i), &
9542	REAL( -999.0_wp, KIND = wp ), &
9543	BTEST( wall_flags_0(k,j,i), 0 ) )
9544	ENDDO
9545	ENDDO
9546	ENDDO
9547	ELSE
9548	DO i = nxl, nxr
9549	DO j = nys, nyn
9550	DO k = nzb, nzt+1
9551	local_pf(i,j,k) = MERGE( Nbins_av(k,j,i,11), &
9552	REAL( -999.0_wp, KIND = wp ), &
9553	BTEST( wall_flags_0(k,j,i), 0 ) )
9554	ENDDO
9555	ENDDO
9556	ENDDO
9557	ENDIF
9558
9559	ELSEIF ( TRIM( variable(1:7) ) == 'N_bin12' ) THEN
9560	IF ( av == 0 ) THEN
9561	DO i = nxl, nxr
9562	DO j = nys, nyn
9563	DO k = nzb, nzt+1
9564	local_pf(i,j,k) = MERGE( aerosol_number(12)%conc(k,j,i), &
9565	REAL( -999.0_wp, KIND = wp ), &
9566	BTEST( wall_flags_0(k,j,i), 0 ) )
9567	ENDDO
9568	ENDDO
9569	ENDDO
9570	ELSE
9571	DO i = nxl, nxr
9572	DO j = nys, nyn
9573	DO k = nzb, nzt+1
9574	local_pf(i,j,k) = MERGE( Nbins_av(k,j,i,12), &
9575	REAL( -999.0_wp, KIND = wp ), &
9576	BTEST( wall_flags_0(k,j,i), 0 ) )
9577	ENDDO
9578	ENDDO
9579	ENDDO
9580	ENDIF
9581
9582	ELSEIF ( TRIM( variable(1:4) ) == 'Ntot' ) THEN
9583	IF ( av == 0 ) THEN
9584	DO i = nxl, nxr
9585	DO j = nys, nyn
9586	DO k = nzb, nzt+1
9587	temp_bin = 0.0_wp
9588	DO b = 1, nbins
9589	temp_bin = temp_bin + aerosol_number(b)%conc(k,j,i)
9590	ENDDO
9591	local_pf(i,j,k) = MERGE( temp_bin, REAL( -999.0_wp, &
9592	KIND = wp ), BTEST( wall_flags_0(k,j,i), 0 ) )
9593	ENDDO
9594	ENDDO
9595	ENDDO
9596	ELSE
9597	DO i = nxl, nxr
9598	DO j = nys, nyn
9599	DO k = nzb, nzt+1
9600	local_pf(i,j,k) = MERGE( Ntot_av(k,j,i), REAL( -999.0_wp, &
9601	KIND = wp ), BTEST( wall_flags_0(k,j,i), 0 ) )
9602	ENDDO
9603	ENDDO
9604	ENDDO
9605	ENDIF
9606
9607	IF ( mode == 'xy' ) grid = 'zu'
9608
9609
9610	ELSEIF ( TRIM( variable(1:6) ) == 'm_bin1' ) THEN
9611	IF ( av == 0 ) THEN
9612	DO i = nxl, nxr
9613	DO j = nys, nyn
9614	DO k = nzb, nzt+1
9615	temp_bin = 0.0_wp
9616	DO c = 1, ncc_tot*nbins, nbins
9617	temp_bin = temp_bin + aerosol_mass(c)%conc(k,j,i)
9618	ENDDO
9619	local_pf(i,j,k) = MERGE( temp_bin, REAL( -999.0_wp, &
9620	KIND = wp ), BTEST( wall_flags_0(k,j,i), 0 ) )
9621	ENDDO
9622	ENDDO
9623	ENDDO
9624	ELSE
9625	DO i = nxl, nxr
9626	DO j = nys, nyn
9627	DO k = nzb, nzt+1
9628	local_pf(i,j,k) = MERGE( mbins_av(k,j,i,1), REAL( -999.0_wp,&
9629	KIND = wp ), BTEST( wall_flags_0(k,j,i), 0 ) )
9630	ENDDO
9631	ENDDO
9632	ENDDO
9633	ENDIF
9634
9635	ELSEIF ( TRIM( variable(1:6) ) == 'm_bin2' ) THEN
9636	IF ( av == 0 ) THEN
9637	DO i = nxl, nxr
9638	DO j = nys, nyn
9639	DO k = nzb, nzt+1
9640	temp_bin = 0.0_wp
9641	DO c = 2, ncc_tot*nbins, nbins
9642	temp_bin = temp_bin + aerosol_mass(c)%conc(k,j,i)
9643	ENDDO
9644	local_pf(i,j,k) = MERGE( temp_bin, REAL( -999.0_wp, &
9645	KIND = wp ), BTEST( wall_flags_0(k,j,i), 0 ) )
9646	ENDDO
9647	ENDDO
9648	ENDDO
9649	ELSE
9650	DO i = nxl, nxr
9651	DO j = nys, nyn
9652	DO k = nzb, nzt+1
9653	local_pf(i,j,k) = MERGE( mbins_av(k,j,i,2), REAL( -999.0_wp,&
9654	KIND = wp ), BTEST( wall_flags_0(k,j,i), 0 ) )
9655	ENDDO
9656	ENDDO
9657	ENDDO
9658	ENDIF
9659
9660	ELSEIF ( TRIM( variable(1:6) ) == 'm_bin3' ) THEN
9661	IF ( av == 0 ) THEN
9662	DO i = nxl, nxr
9663	DO j = nys, nyn
9664	DO k = nzb, nzt+1
9665	temp_bin = 0.0_wp
9666	DO c = 3, ncc_tot*nbins, nbins
9667	temp_bin = temp_bin + aerosol_mass(c)%conc(k,j,i)
9668	ENDDO
9669	local_pf(i,j,k) = MERGE( temp_bin, REAL( -999.0_wp, &
9670	KIND = wp ), BTEST( wall_flags_0(k,j,i), 0 ) )
9671	ENDDO
9672	ENDDO
9673	ENDDO
9674	ELSE
9675	DO i = nxl, nxr
9676	DO j = nys, nyn
9677	DO k = nzb, nzt+1
9678	local_pf(i,j,k) = MERGE( mbins_av(k,j,i,3), REAL( -999.0_wp,&
9679	KIND = wp ), BTEST( wall_flags_0(k,j,i), 0 ) )
9680	ENDDO
9681	ENDDO
9682	ENDDO
9683	ENDIF
9684
9685	ELSEIF ( TRIM( variable(1:6) ) == 'm_bin4' ) THEN
9686	IF ( av == 0 ) THEN
9687	DO i = nxl, nxr
9688	DO j = nys, nyn
9689	DO k = nzb, nzt+1
9690	temp_bin = 0.0_wp
9691	DO c = 4, ncc_tot*nbins, nbins
9692	temp_bin = temp_bin + aerosol_mass(c)%conc(k,j,i)
9693	ENDDO
9694	local_pf(i,j,k) = MERGE( temp_bin, REAL( -999.0_wp, &
9695	KIND = wp ), BTEST( wall_flags_0(k,j,i), 0 ) )
9696	ENDDO
9697	ENDDO
9698	ENDDO
9699	ELSE
9700	DO i = nxl, nxr
9701	DO j = nys, nyn
9702	DO k = nzb, nzt+1
9703	local_pf(i,j,k) = MERGE( mbins_av(k,j,i,4), REAL( -999.0_wp,&
9704	KIND = wp ), BTEST( wall_flags_0(k,j,i), 0 ) )
9705	ENDDO
9706	ENDDO
9707	ENDDO
9708	ENDIF
9709
9710	ELSEIF ( TRIM( variable(1:6) ) == 'm_bin5' ) THEN
9711	IF ( av == 0 ) THEN
9712	DO i = nxl, nxr
9713	DO j = nys, nyn
9714	DO k = nzb, nzt+1
9715	temp_bin = 0.0_wp
9716	DO c = 5, ncc_tot*nbins, nbins
9717	temp_bin = temp_bin + aerosol_mass(c)%conc(k,j,i)
9718	ENDDO
9719	local_pf(i,j,k) = MERGE( temp_bin, REAL( -999.0_wp, &
9720	KIND = wp ), BTEST( wall_flags_0(k,j,i), 0 ) )
9721	ENDDO
9722	ENDDO
9723	ENDDO
9724	ELSE
9725	DO i = nxl, nxr
9726	DO j = nys, nyn
9727	DO k = nzb, nzt+1
9728	local_pf(i,j,k) = MERGE( mbins_av(k,j,i,5), REAL( -999.0_wp,&
9729	KIND = wp ), BTEST( wall_flags_0(k,j,i), 0 ) )
9730	ENDDO
9731	ENDDO
9732	ENDDO
9733	ENDIF
9734
9735	ELSEIF ( TRIM( variable(1:6) ) == 'm_bin6' ) THEN
9736	IF ( av == 0 ) THEN
9737	DO i = nxl, nxr
9738	DO j = nys, nyn
9739	DO k = nzb, nzt+1
9740	temp_bin = 0.0_wp
9741	DO c = 6, ncc_tot*nbins, nbins
9742	temp_bin = temp_bin + aerosol_mass(c)%conc(k,j,i)
9743	ENDDO
9744	local_pf(i,j,k) = MERGE( temp_bin, REAL( -999.0_wp, &
9745	KIND = wp ), BTEST( wall_flags_0(k,j,i), 0 ) )
9746	ENDDO
9747	ENDDO
9748	ENDDO
9749	ELSE
9750	DO i = nxl, nxr
9751	DO j = nys, nyn
9752	DO k = nzb, nzt+1
9753	local_pf(i,j,k) = MERGE( mbins_av(k,j,i,6), REAL( -999.0_wp,&
9754	KIND = wp ), BTEST( wall_flags_0(k,j,i), 0 ) )
9755	ENDDO
9756	ENDDO
9757	ENDDO
9758	ENDIF
9759
9760	ELSEIF ( TRIM( variable(1:6) ) == 'm_bin7' ) THEN
9761	IF ( av == 0 ) THEN
9762	DO i = nxl, nxr
9763	DO j = nys, nyn
9764	DO k = nzb, nzt+1
9765	temp_bin = 0.0_wp
9766	DO c = 7, ncc_tot*nbins, nbins
9767	temp_bin = temp_bin + aerosol_mass(c)%conc(k,j,i)
9768	ENDDO
9769	local_pf(i,j,k) = MERGE( temp_bin, REAL( -999.0_wp, &
9770	KIND = wp ), BTEST( wall_flags_0(k,j,i), 0 ) )
9771	ENDDO
9772	ENDDO
9773	ENDDO
9774	ELSE
9775	DO i = nxl, nxr
9776	DO j = nys, nyn
9777	DO k = nzb, nzt+1
9778	local_pf(i,j,k) = MERGE( mbins_av(k,j,i,7), REAL( -999.0_wp,&
9779	KIND = wp ), BTEST( wall_flags_0(k,j,i), 0 ) )
9780	ENDDO
9781	ENDDO
9782	ENDDO
9783	ENDIF
9784
9785	ELSEIF ( TRIM( variable(1:6) ) == 'm_bin8' ) THEN
9786	IF ( av == 0 ) THEN
9787	DO i = nxl, nxr
9788	DO j = nys, nyn
9789	DO k = nzb, nzt+1
9790	temp_bin = 0.0_wp
9791	DO c = 8, ncc_tot*nbins, nbins
9792	temp_bin = temp_bin + aerosol_mass(c)%conc(k,j,i)
9793	ENDDO
9794	local_pf(i,j,k) = MERGE( temp_bin, REAL( -999.0_wp, &
9795	KIND = wp ), BTEST( wall_flags_0(k,j,i), 0 ) )
9796	ENDDO
9797	ENDDO
9798	ENDDO
9799	ELSE
9800	DO i = nxl, nxr
9801	DO j = nys, nyn
9802	DO k = nzb, nzt+1
9803	local_pf(i,j,k) = MERGE( mbins_av(k,j,i,8), REAL( -999.0_wp,&
9804	KIND = wp ), BTEST( wall_flags_0(k,j,i), 0 ) )
9805	ENDDO
9806	ENDDO
9807	ENDDO
9808	ENDIF
9809
9810	ELSEIF ( TRIM( variable(1:6) ) == 'm_bin9' ) THEN
9811	IF ( av == 0 ) THEN
9812	DO i = nxl, nxr
9813	DO j = nys, nyn
9814	DO k = nzb, nzt+1
9815	temp_bin = 0.0_wp
9816	DO c = 9, ncc_tot*nbins, nbins
9817	temp_bin = temp_bin + aerosol_mass(c)%conc(k,j,i)
9818	ENDDO
9819	local_pf(i,j,k) = MERGE( temp_bin, REAL( -999.0_wp, &
9820	KIND = wp ), BTEST( wall_flags_0(k,j,i), 0 ) )
9821	ENDDO
9822	ENDDO
9823	ENDDO
9824	ELSE
9825	DO i = nxl, nxr
9826	DO j = nys, nyn
9827	DO k = nzb, nzt+1
9828	local_pf(i,j,k) = MERGE( mbins_av(k,j,i,9), REAL( -999.0_wp,&
9829	KIND = wp ), BTEST( wall_flags_0(k,j,i), 0 ) )
9830	ENDDO
9831	ENDDO
9832	ENDDO
9833	ENDIF
9834
9835	ELSEIF ( TRIM( variable(1:7) ) == 'm_bin10' ) THEN
9836	IF ( av == 0 ) THEN
9837	DO i = nxl, nxr
9838	DO j = nys, nyn
9839	DO k = nzb, nzt+1
9840	temp_bin = 0.0_wp
9841	DO c = 10, ncc_tot*nbins, nbins
9842	temp_bin = temp_bin + aerosol_mass(c)%conc(k,j,i)
9843	ENDDO
9844	local_pf(i,j,k) = MERGE( temp_bin, REAL( -999.0_wp, &
9845	KIND = wp ), BTEST( wall_flags_0(k,j,i), 0 ) )
9846	ENDDO
9847	ENDDO
9848	ENDDO
9849	ELSE
9850	DO i = nxl, nxr
9851	DO j = nys, nyn
9852	DO k = nzb, nzt+1
9853	local_pf(i,j,k) = MERGE( mbins_av(k,j,i,10), REAL( &
9854	-999.0_wp, KIND = wp ), BTEST( wall_flags_0(k,j,i), 0 ) )
9855	ENDDO
9856	ENDDO
9857	ENDDO
9858	ENDIF
9859
9860	ELSEIF ( TRIM( variable(1:7) ) == 'm_bin11' ) THEN
9861	IF ( av == 0 ) THEN
9862	DO i = nxl, nxr
9863	DO j = nys, nyn
9864	DO k = nzb, nzt+1
9865	temp_bin = 0.0_wp
9866	DO c = 11, ncc_tot*nbins, nbins
9867	temp_bin = temp_bin + aerosol_mass(c)%conc(k,j,i)
9868	ENDDO
9869	local_pf(i,j,k) = MERGE( temp_bin, REAL( -999.0_wp, &
9870	KIND = wp ), BTEST( wall_flags_0(k,j,i), 0 ) )
9871	ENDDO
9872	ENDDO
9873	ENDDO
9874	ELSE
9875	DO i = nxl, nxr
9876	DO j = nys, nyn
9877	DO k = nzb, nzt+1
9878	local_pf(i,j,k) = MERGE( mbins_av(k,j,i,11), REAL( &
9879	-999.0_wp, KIND = wp ), BTEST( wall_flags_0(k,j,i), 0 ) )
9880	ENDDO
9881	ENDDO
9882	ENDDO
9883	ENDIF
9884
9885	ELSEIF ( TRIM( variable(1:7) ) == 'm_bin12' ) THEN
9886	IF ( av == 0 ) THEN
9887	DO i = nxl, nxr
9888	DO j = nys, nyn
9889	DO k = nzb, nzt+1
9890	temp_bin = 0.0_wp
9891	DO c = 12, ncc_tot*nbins, nbins
9892	temp_bin = temp_bin + aerosol_mass(c)%conc(k,j,i)
9893	ENDDO
9894	local_pf(i,j,k) = MERGE( temp_bin, REAL( -999.0_wp, &
9895	KIND = wp ), BTEST( wall_flags_0(k,j,i), 0 ) )
9896	ENDDO
9897	ENDDO
9898	ENDDO
9899	ELSE
9900	DO i = nxl, nxr
9901	DO j = nys, nyn
9902	DO k = nzb, nzt+1
9903	local_pf(i,j,k) = MERGE( mbins_av(k,j,i,12), REAL( &
9904	-999.0_wp, KIND = wp ), BTEST( wall_flags_0(k,j,i), 0 ) )
9905	ENDDO
9906	ENDDO
9907	ENDDO
9908	ENDIF
9909
9910	ELSEIF ( TRIM( variable(1:5) ) == 'PM2.5' ) THEN
9911	IF ( av == 0 ) THEN
9912	DO i = nxl, nxr
9913	DO j = nys, nyn
9914	DO k = nzb, nzt+1
9915	temp_bin = 0.0_wp
9916	DO b = 1, nbins
9917	IF ( 2.0_wp * Ra_dry(k,j,i,b) <= 2.5E-6_wp ) THEN
9918	DO c = b, nbins*ncc, nbins
9919	temp_bin = temp_bin + aerosol_mass(c)%conc(k,j,i)
9920	ENDDO
9921	ENDIF
9922	ENDDO
9923	local_pf(i,j,k) = MERGE( temp_bin, REAL( -999.0_wp, &
9924	KIND = wp ), BTEST( wall_flags_0(k,j,i), 0 ) )
9925	ENDDO
9926	ENDDO
9927	ENDDO
9928	ELSE
9929	DO i = nxl, nxr
9930	DO j = nys, nyn
9931	DO k = nzb, nzt+1
9932	local_pf(i,j,k) = MERGE( PM25_av(k,j,i), REAL( -999.0_wp, &
9933	KIND = wp ), BTEST( wall_flags_0(k,j,i), 0 ) )
9934	ENDDO
9935	ENDDO
9936	ENDDO
9937	ENDIF
9938
9939	IF ( mode == 'xy' ) grid = 'zu'
9940
9941
9942	ELSEIF ( TRIM( variable(1:4) ) == 'PM10' ) THEN
9943	IF ( av == 0 ) THEN
9944	DO i = nxl, nxr
9945	DO j = nys, nyn
9946	DO k = nzb, nzt+1
9947	temp_bin = 0.0_wp
9948	DO b = 1, nbins
9949	IF ( 2.0_wp * Ra_dry(k,j,i,b) <= 10.0E-6_wp ) THEN
9950	DO c = b, nbins*ncc, nbins
9951	temp_bin = temp_bin + aerosol_mass(c)%conc(k,j,i)
9952	ENDDO
9953	ENDIF
9954	ENDDO
9955	local_pf(i,j,k) = MERGE( temp_bin, REAL( -999.0_wp, &
9956	KIND = wp ), BTEST( wall_flags_0(k,j,i), 0 ) )
9957	ENDDO
9958	ENDDO
9959	ENDDO
9960	ELSE
9961	DO i = nxl, nxr
9962	DO j = nys, nyn
9963	DO k = nzb, nzt+1
9964	local_pf(i,j,k) = MERGE( PM10_av(k,j,i), REAL( -999.0_wp, &
9965	KIND = wp ), BTEST( wall_flags_0(k,j,i), 0 ) )
9966	ENDDO
9967	ENDDO
9968	ENDDO
9969	ENDIF
9970
9971	IF ( mode == 'xy' ) grid = 'zu'
9972
9973	ELSEIF ( TRIM( variable(1:2) ) == 's_' ) THEN
9974	vari = TRIM( variable( 3:LEN( TRIM( variable ) ) - 3 ) )
9975	IF ( is_used( prtcl, vari ) ) THEN
9976	icc = get_index( prtcl, vari )
9977	IF ( av == 0 ) THEN
9978	DO i = nxl, nxr
9979	DO j = nys, nyn
9980	DO k = nzb, nzt+1
9981	temp_bin = 0.0_wp
9982	DO c = ( icc-1 )nbins+1, iccnbins, 1
9983	temp_bin = temp_bin + aerosol_mass(c)%conc(k,j,i)
9984	ENDDO
9985	local_pf(i,j,k) = MERGE( temp_bin, REAL( -999.0_wp, &
9986	KIND = wp ), BTEST( wall_flags_0(k,j,i), 0 ) )
9987	ENDDO
9988	ENDDO
9989	ENDDO
9990	ELSE
9991	IF ( vari == 'BC' ) to_be_resorted => s_BC_av
9992	IF ( vari == 'DU' ) to_be_resorted => s_DU_av
9993	IF ( vari == 'NH' ) to_be_resorted => s_NH_av
9994	IF ( vari == 'NO' ) to_be_resorted => s_NO_av
9995	IF ( vari == 'OC' ) to_be_resorted => s_OC_av
9996	IF ( vari == 'SO4' ) to_be_resorted => s_SO4_av
9997	IF ( vari == 'SS' ) to_be_resorted => s_SS_av
9998	DO i = nxl, nxr
9999	DO j = nys, nyn
10000	DO k = nzb, nzt+1
10001	local_pf(i,j,k) = MERGE( to_be_resorted(k,j,i), &
10002	REAL( -999.0_wp, KIND = wp ), &
10003	BTEST( wall_flags_0(k,j,i), 0 ) )
10004	ENDDO
10005	ENDDO
10006	ENDDO
10007	ENDIF
10008	ELSE
10009	local_pf = 0.0_wp
10010	ENDIF
10011
10012	IF ( mode == 'xy' ) grid = 'zu'
10013
10014	ELSE
10015	found = .FALSE.
10016	grid = 'none'
10017
10018	ENDIF
10019
10020	END SUBROUTINE salsa_data_output_2d
10021
10022
10023	!------------------------------------------------------------------------------!
10024	!
10025	! Description:
10026	! ------------
10027	!> Subroutine defining 3D output variables
10028	!------------------------------------------------------------------------------!
10029	SUBROUTINE salsa_data_output_3d( av, variable, found, local_pf )
10030
10031	USE indices
10032
10033	USE kinds
10034
10035	IMPLICIT NONE
10036
10037	CHARACTER (LEN=*), INTENT(in) :: variable !<
10038
10039	INTEGER(iwp) :: av !<
10040	INTEGER(iwp) :: c !<
10041	INTEGER(iwp) :: i !<
10042	INTEGER(iwp) :: icc !< index of a chemical compound
10043	INTEGER(iwp) :: j !<
10044	INTEGER(iwp) :: k !<
10045	INTEGER(iwp) :: n !<
10046
10047	LOGICAL :: found !<
10048	REAL(wp) :: df !< For calculating LDSA: fraction of particles
10049	!< depositing in the alveolar (or tracheobronchial)
10050	!< region of the lung. Depends on the particle size
10051	REAL(wp) :: mean_d !< Particle diameter in micrometres
10052	REAL(wp) :: nc !< Particle number concentration in units 1/cm**3
10053
10054	REAL(sp), DIMENSION(nxl:nxr,nys:nyn,nzb:nzt+1) :: local_pf !< local
10055	!< array to which output data is resorted to
10056	REAL(wp) :: temp_bin !<
10057	REAL(wp), DIMENSION(:,:,:), POINTER :: to_be_resorted !< points to
10058	!< selected output variable
10059
10060	found = .TRUE.
10061	temp_bin = 0.0_wp
10062
10063	SELECT CASE ( TRIM( variable ) )
10064
10065	CASE ( 'g_H2SO4', 'g_HNO3', 'g_NH3', 'g_OCNV', 'g_OCSV' )
10066	IF ( av == 0 ) THEN
10067	IF ( TRIM( variable ) == 'g_H2SO4') icc = 1
10068	IF ( TRIM( variable ) == 'g_HNO3') icc = 2
10069	IF ( TRIM( variable ) == 'g_NH3') icc = 3
10070	IF ( TRIM( variable ) == 'g_OCNV') icc = 4
10071	IF ( TRIM( variable ) == 'g_OCSV') icc = 5
10072
10073	DO i = nxl, nxr
10074	DO j = nys, nyn
10075	DO k = nzb, nzt+1
10076	local_pf(i,j,k) = MERGE( salsa_gas(icc)%conc(k,j,i), &
10077	REAL( -999.0_wp, KIND = wp ), &
10078	BTEST( wall_flags_0(k,j,i), 0 ) )
10079	ENDDO
10080	ENDDO
10081	ENDDO
10082	ELSE
10083	IF ( TRIM( variable(3:) ) == 'H2SO4' ) to_be_resorted => g_H2SO4_av
10084	IF ( TRIM( variable(3:) ) == 'HNO3' ) to_be_resorted => g_HNO3_av
10085	IF ( TRIM( variable(3:) ) == 'NH3' ) to_be_resorted => g_NH3_av
10086	IF ( TRIM( variable(3:) ) == 'OCNV' ) to_be_resorted => g_OCNV_av
10087	IF ( TRIM( variable(3:) ) == 'OCSV' ) to_be_resorted => g_OCSV_av
10088	DO i = nxl, nxr
10089	DO j = nys, nyn
10090	DO k = nzb, nzt+1
10091	local_pf(i,j,k) = MERGE( to_be_resorted(k,j,i), &
10092	REAL( -999.0_wp, KIND = wp ), &
10093	BTEST( wall_flags_0(k,j,i), 0 ) )
10094	ENDDO
10095	ENDDO
10096	ENDDO
10097	ENDIF
10098
10099	CASE ( 'LDSA' )
10100	IF ( av == 0 ) THEN
10101	DO i = nxl, nxr
10102	DO j = nys, nyn
10103	DO k = nzb, nzt+1
10104	temp_bin = 0.0_wp
10105	DO n = 1, nbins
10106	!
10107	!-- Diameter in micrometres
10108	mean_d = 1.0E+6_wp * Ra_dry(k,j,i,n) * 2.0_wp
10109	!
10110	!-- Deposition factor: alveolar
10111	df = ( 0.01555_wp / mean_d ) * ( EXP( -0.416_wp * &
10112	( LOG( mean_d ) + 2.84_wp )**2.0_wp ) &
10113	+ 19.11_wp * EXP( -0.482_wp * &
10114	( LOG( mean_d ) - 1.362_wp )**2.0_wp ) )
10115	!
10116	!-- Number concentration in 1/cm3
10117	nc = 1.0E-6_wp * aerosol_number(n)%conc(k,j,i)
10118	!
10119	!-- Lung-deposited surface area LDSA (units mum2/cm3)
10120	temp_bin = temp_bin + pi * mean_d*2.0_wp df * nc
10121	ENDDO
10122	local_pf(i,j,k) = MERGE( temp_bin, &
10123	REAL( -999.0_wp, KIND = wp ), &
10124	BTEST( wall_flags_0(k,j,i), 0 ) )
10125	ENDDO
10126	ENDDO
10127	ENDDO
10128	ELSE
10129	DO i = nxl, nxr
10130	DO j = nys, nyn
10131	DO k = nzb, nzt+1
10132	local_pf(i,j,k) = MERGE( LDSA_av(k,j,i), &
10133	REAL( -999.0_wp, KIND = wp ), &
10134	BTEST( wall_flags_0(k,j,i), 0 ) )
10135	ENDDO
10136	ENDDO
10137	ENDDO
10138	ENDIF
10139
10140	CASE ( 'Ntot' )
10141	IF ( av == 0 ) THEN
10142	DO i = nxl, nxr
10143	DO j = nys, nyn
10144	DO k = nzb, nzt+1
10145	temp_bin = 0.0_wp
10146	DO n = 1, nbins
10147	temp_bin = temp_bin + aerosol_number(n)%conc(k,j,i)
10148	ENDDO
10149	local_pf(i,j,k) = MERGE( temp_bin, &
10150	REAL( -999.0_wp, KIND = wp ), &
10151	BTEST( wall_flags_0(k,j,i), 0 ) )
10152	ENDDO
10153	ENDDO
10154	ENDDO
10155	ELSE
10156	DO i = nxl, nxr
10157	DO j = nys, nyn
10158	DO k = nzb, nzt+1
10159	local_pf(i,j,k) = MERGE( Ntot_av(k,j,i), &
10160	REAL( -999.0_wp, KIND = wp ), &
10161	BTEST( wall_flags_0(k,j,i), 0 ) )
10162	ENDDO
10163	ENDDO
10164	ENDDO
10165	ENDIF
10166
10167	CASE ( 'PM2.5' )
10168	IF ( av == 0 ) THEN
10169	DO i = nxl, nxr
10170	DO j = nys, nyn
10171	DO k = nzb, nzt+1
10172	temp_bin = 0.0_wp
10173	DO n = 1, nbins
10174	IF ( 2.0_wp * Ra_dry(k,j,i,n) <= 2.5E-6_wp ) THEN
10175	DO c = n, nbins*ncc, nbins
10176	temp_bin = temp_bin + aerosol_mass(c)%conc(k,j,i)
10177	ENDDO
10178	ENDIF
10179	ENDDO
10180	local_pf(i,j,k) = MERGE( temp_bin, &
10181	REAL( -999.0_wp, KIND = wp ), &
10182	BTEST( wall_flags_0(k,j,i), 0 ) )
10183	ENDDO
10184	ENDDO
10185	ENDDO
10186	ELSE
10187	DO i = nxl, nxr
10188	DO j = nys, nyn
10189	DO k = nzb, nzt+1
10190	local_pf(i,j,k) = MERGE( PM25_av(k,j,i), &
10191	REAL( -999.0_wp, KIND = wp ), &
10192	BTEST( wall_flags_0(k,j,i), 0 ) )
10193	ENDDO
10194	ENDDO
10195	ENDDO
10196	ENDIF
10197
10198	CASE ( 'PM10' )
10199	IF ( av == 0 ) THEN
10200	DO i = nxl, nxr
10201	DO j = nys, nyn
10202	DO k = nzb, nzt+1
10203	temp_bin = 0.0_wp
10204	DO n = 1, nbins
10205	IF ( 2.0_wp * Ra_dry(k,j,i,n) <= 10.0E-6_wp ) THEN
10206	DO c = n, nbins*ncc, nbins
10207	temp_bin = temp_bin + aerosol_mass(c)%conc(k,j,i)
10208	ENDDO
10209	ENDIF
10210	ENDDO
10211	local_pf(i,j,k) = MERGE( temp_bin, &
10212	REAL( -999.0_wp, KIND = wp ), &
10213	BTEST( wall_flags_0(k,j,i), 0 ) )
10214	ENDDO
10215	ENDDO
10216	ENDDO
10217	ELSE
10218	DO i = nxl, nxr
10219	DO j = nys, nyn
10220	DO k = nzb, nzt+1
10221	local_pf(i,j,k) = MERGE( PM10_av(k,j,i), &
10222	REAL( -999.0_wp, KIND = wp ), &
10223	BTEST( wall_flags_0(k,j,i), 0 ) )
10224	ENDDO
10225	ENDDO
10226	ENDDO
10227	ENDIF
10228
10229	CASE ( 'N_bin1' )
10230	IF ( av == 0 ) THEN
10231	DO i = nxl, nxr
10232	DO j = nys, nyn
10233	DO k = nzb, nzt+1
10234	local_pf(i,j,k) = MERGE( aerosol_number(1)%conc(k,j,i), &
10235	REAL( -999.0_wp, KIND = wp ), &
10236	BTEST( wall_flags_0(k,j,i), 0 ) )
10237	ENDDO
10238	ENDDO
10239	ENDDO
10240	ELSE
10241	DO i = nxl, nxr
10242	DO j = nys, nyn
10243	DO k = nzb, nzt+1
10244	local_pf(i,j,k) = MERGE( Nbins_av(k,j,i,1), &
10245	REAL( -999.0_wp, KIND = wp ), &
10246	BTEST( wall_flags_0(k,j,i), 0 ) )
10247	ENDDO
10248	ENDDO
10249	ENDDO
10250	ENDIF
10251
10252	CASE ( 'N_bin2' )
10253	IF ( av == 0 ) THEN
10254	DO i = nxl, nxr
10255	DO j = nys, nyn
10256	DO k = nzb, nzt+1
10257	local_pf(i,j,k) = MERGE( aerosol_number(2)%conc(k,j,i), &
10258	REAL( -999.0_wp, KIND = wp ), &
10259	BTEST( wall_flags_0(k,j,i), 0 ) )
10260	ENDDO
10261	ENDDO
10262	ENDDO
10263	ELSE
10264	DO i = nxl, nxr
10265	DO j = nys, nyn
10266	DO k = nzb, nzt+1
10267	local_pf(i,j,k) = MERGE( Nbins_av(k,j,i,2), &
10268	REAL( -999.0_wp, KIND = wp ), &
10269	BTEST( wall_flags_0(k,j,i), 0 ) )
10270	ENDDO
10271	ENDDO
10272	ENDDO
10273	ENDIF
10274
10275	CASE ( 'N_bin3' )
10276	IF ( av == 0 ) THEN
10277	DO i = nxl, nxr
10278	DO j = nys, nyn
10279	DO k = nzb, nzt+1
10280	local_pf(i,j,k) = MERGE( aerosol_number(3)%conc(k,j,i), &
10281	REAL( -999.0_wp, KIND = wp ), &
10282	BTEST( wall_flags_0(k,j,i), 0 ) )
10283	ENDDO
10284	ENDDO
10285	ENDDO
10286	ELSE
10287	DO i = nxl, nxr
10288	DO j = nys, nyn
10289	DO k = nzb, nzt+1
10290	local_pf(i,j,k) = MERGE( Nbins_av(k,j,i,3), &
10291	REAL( -999.0_wp, KIND = wp ), &
10292	BTEST( wall_flags_0(k,j,i), 0 ) )
10293	ENDDO
10294	ENDDO
10295	ENDDO
10296	ENDIF
10297
10298	CASE ( 'N_bin4' )
10299	IF ( av == 0 ) THEN
10300	DO i = nxl, nxr
10301	DO j = nys, nyn
10302	DO k = nzb, nzt+1
10303	local_pf(i,j,k) = MERGE( aerosol_number(4)%conc(k,j,i), &
10304	REAL( -999.0_wp, KIND = wp ), &
10305	BTEST( wall_flags_0(k,j,i), 0 ) )
10306	ENDDO
10307	ENDDO
10308	ENDDO
10309	ELSE
10310	DO i = nxl, nxr
10311	DO j = nys, nyn
10312	DO k = nzb, nzt+1
10313	local_pf(i,j,k) = MERGE( Nbins_av(k,j,i,4), &
10314	REAL( -999.0_wp, KIND = wp ), &
10315	BTEST( wall_flags_0(k,j,i), 0 ) )
10316	ENDDO
10317	ENDDO
10318	ENDDO
10319	ENDIF
10320
10321	CASE ( 'N_bin5' )
10322	IF ( av == 0 ) THEN
10323	DO i = nxl, nxr
10324	DO j = nys, nyn
10325	DO k = nzb, nzt+1
10326	local_pf(i,j,k) = MERGE( aerosol_number(5)%conc(k,j,i), &
10327	REAL( -999.0_wp, KIND = wp ), &
10328	BTEST( wall_flags_0(k,j,i), 0 ) )
10329	ENDDO
10330	ENDDO
10331	ENDDO
10332	ELSE
10333	DO i = nxl, nxr
10334	DO j = nys, nyn
10335	DO k = nzb, nzt+1
10336	local_pf(i,j,k) = MERGE( Nbins_av(k,j,i,5), &
10337	REAL( -999.0_wp, KIND = wp ), &
10338	BTEST( wall_flags_0(k,j,i), 0 ) )
10339	ENDDO
10340	ENDDO
10341	ENDDO
10342	ENDIF
10343
10344	CASE ( 'N_bin6' )
10345	IF ( av == 0 ) THEN
10346	DO i = nxl, nxr
10347	DO j = nys, nyn
10348	DO k = nzb, nzt+1
10349	local_pf(i,j,k) = MERGE( aerosol_number(6)%conc(k,j,i), &
10350	REAL( -999.0_wp, KIND = wp ), &
10351	BTEST( wall_flags_0(k,j,i), 0 ) )
10352	ENDDO
10353	ENDDO
10354	ENDDO
10355	ELSE
10356	DO i = nxl, nxr
10357	DO j = nys, nyn
10358	DO k = nzb, nzt+1
10359	local_pf(i,j,k) = MERGE( Nbins_av(k,j,i,6), &
10360	REAL( -999.0_wp, KIND = wp ), &
10361	BTEST( wall_flags_0(k,j,i), 0 ) )
10362	ENDDO
10363	ENDDO
10364	ENDDO
10365	ENDIF
10366
10367	CASE ( 'N_bin7' )
10368	IF ( av == 0 ) THEN
10369	DO i = nxl, nxr
10370	DO j = nys, nyn
10371	DO k = nzb, nzt+1
10372	local_pf(i,j,k) = MERGE( aerosol_number(7)%conc(k,j,i), &
10373	REAL( -999.0_wp, KIND = wp ), &
10374	BTEST( wall_flags_0(k,j,i), 0 ) )
10375	ENDDO
10376	ENDDO
10377	ENDDO
10378	ELSE
10379	DO i = nxl, nxr
10380	DO j = nys, nyn
10381	DO k = nzb, nzt+1
10382	local_pf(i,j,k) = MERGE( Nbins_av(k,j,i,7), &
10383	REAL( -999.0_wp, KIND = wp ), &
10384	BTEST( wall_flags_0(k,j,i), 0 ) )
10385	ENDDO
10386	ENDDO
10387	ENDDO
10388	ENDIF
10389
10390	CASE ( 'N_bin8' )
10391	IF ( av == 0 ) THEN
10392	DO i = nxl, nxr
10393	DO j = nys, nyn
10394	DO k = nzb, nzt+1
10395	local_pf(i,j,k) = MERGE( aerosol_number(8)%conc(k,j,i), &
10396	REAL( -999.0_wp, KIND = wp ), &
10397	BTEST( wall_flags_0(k,j,i), 0 ) )
10398	ENDDO
10399	ENDDO
10400	ENDDO
10401	ELSE
10402	DO i = nxl, nxr
10403	DO j = nys, nyn
10404	DO k = nzb, nzt+1
10405	local_pf(i,j,k) = MERGE( Nbins_av(k,j,i,8), &
10406	REAL( -999.0_wp, KIND = wp ), &
10407	BTEST( wall_flags_0(k,j,i), 0 ) )
10408	ENDDO
10409	ENDDO
10410	ENDDO
10411	ENDIF
10412
10413	CASE ( 'N_bin9' )
10414	IF ( av == 0 ) THEN
10415	DO i = nxl, nxr
10416	DO j = nys, nyn
10417	DO k = nzb, nzt+1
10418	local_pf(i,j,k) = MERGE( aerosol_number(9)%conc(k,j,i), &
10419	REAL( -999.0_wp, KIND = wp ), &
10420	BTEST( wall_flags_0(k,j,i), 0 ) )
10421	ENDDO
10422	ENDDO
10423	ENDDO
10424	ELSE
10425	DO i = nxl, nxr
10426	DO j = nys, nyn
10427	DO k = nzb, nzt+1
10428	local_pf(i,j,k) = MERGE( Nbins_av(k,j,i,9), &
10429	REAL( -999.0_wp, KIND = wp ), &
10430	BTEST( wall_flags_0(k,j,i), 0 ) )
10431	ENDDO
10432	ENDDO
10433	ENDDO
10434	ENDIF
10435
10436	CASE ( 'N_bin10' )
10437	IF ( av == 0 ) THEN
10438	DO i = nxl, nxr
10439	DO j = nys, nyn
10440	DO k = nzb, nzt+1
10441	local_pf(i,j,k) = MERGE( aerosol_number(10)%conc(k,j,i), &
10442	REAL( -999.0_wp, KIND = wp ), &
10443	BTEST( wall_flags_0(k,j,i), 0 ) )
10444	ENDDO
10445	ENDDO
10446	ENDDO
10447	ELSE
10448	DO i = nxl, nxr
10449	DO j = nys, nyn
10450	DO k = nzb, nzt+1
10451	local_pf(i,j,k) = MERGE( Nbins_av(k,j,i,10), &
10452	REAL( -999.0_wp, KIND = wp ), &
10453	BTEST( wall_flags_0(k,j,i), 0 ) )
10454	ENDDO
10455	ENDDO
10456	ENDDO
10457	ENDIF
10458
10459	CASE ( 'N_bin11' )
10460	IF ( av == 0 ) THEN
10461	DO i = nxl, nxr
10462	DO j = nys, nyn
10463	DO k = nzb, nzt+1
10464	local_pf(i,j,k) = MERGE( aerosol_number(11)%conc(k,j,i), &
10465	REAL( -999.0_wp, KIND = wp ), &
10466	BTEST( wall_flags_0(k,j,i), 0 ) )
10467	ENDDO
10468	ENDDO
10469	ENDDO
10470	ELSE
10471	DO i = nxl, nxr
10472	DO j = nys, nyn
10473	DO k = nzb, nzt+1
10474	local_pf(i,j,k) = MERGE( Nbins_av(k,j,i,11), &
10475	REAL( -999.0_wp, KIND = wp ), &
10476	BTEST( wall_flags_0(k,j,i), 0 ) )
10477	ENDDO
10478	ENDDO
10479	ENDDO
10480	ENDIF
10481
10482	CASE ( 'N_bin12' )
10483	IF ( av == 0 ) THEN
10484	DO i = nxl, nxr
10485	DO j = nys, nyn
10486	DO k = nzb, nzt+1
10487	local_pf(i,j,k) = MERGE( aerosol_number(12)%conc(k,j,i), &
10488	REAL( -999.0_wp, KIND = wp ), &
10489	BTEST( wall_flags_0(k,j,i), 0 ) )
10490	ENDDO
10491	ENDDO
10492	ENDDO
10493	ELSE
10494	DO i = nxl, nxr
10495	DO j = nys, nyn
10496	DO k = nzb, nzt+1
10497	local_pf(i,j,k) = MERGE( Nbins_av(k,j,i,12), &
10498	REAL( -999.0_wp, KIND = wp ), &
10499	BTEST( wall_flags_0(k,j,i), 0 ) )
10500	ENDDO
10501	ENDDO
10502	ENDDO
10503	ENDIF
10504
10505	CASE ( 'm_bin1' )
10506	IF ( av == 0 ) THEN
10507	DO i = nxl, nxr
10508	DO j = nys, nyn
10509	DO k = nzb, nzt+1
10510	temp_bin = 0.0_wp
10511	DO c = 1, ncc_tot*nbins, nbins
10512	temp_bin = temp_bin + aerosol_mass(c)%conc(k,j,i)
10513	ENDDO
10514	local_pf(i,j,k) = MERGE( temp_bin, &
10515	REAL( -999.0_wp, KIND = wp ), &
10516	BTEST( wall_flags_0(k,j,i), 0 ) )
10517	ENDDO
10518	ENDDO
10519	ENDDO
10520	ELSE
10521	DO i = nxl, nxr
10522	DO j = nys, nyn
10523	DO k = nzb, nzt+1
10524	local_pf(i,j,k) = MERGE( mbins_av(k,j,i,1), &
10525	REAL( -999.0_wp, KIND = wp ), &
10526	BTEST( wall_flags_0(k,j,i), 0 ) )
10527	ENDDO
10528	ENDDO
10529	ENDDO
10530	ENDIF
10531
10532	CASE ( 'm_bin2' )
10533	IF ( av == 0 ) THEN
10534	DO i = nxl, nxr
10535	DO j = nys, nyn
10536	DO k = nzb, nzt+1
10537	temp_bin = 0.0_wp
10538	DO c = 2, ncc_tot*nbins, nbins
10539	temp_bin = temp_bin + aerosol_mass(c)%conc(k,j,i)
10540	ENDDO
10541	local_pf(i,j,k) = MERGE( temp_bin, &
10542	REAL( -999.0_wp, KIND = wp ), &
10543	BTEST( wall_flags_0(k,j,i), 0 ) )
10544	ENDDO
10545	ENDDO
10546	ENDDO
10547	ELSE
10548	DO i = nxl, nxr
10549	DO j = nys, nyn
10550	DO k = nzb, nzt+1
10551	local_pf(i,j,k) = MERGE( mbins_av(k,j,i,2), &
10552	REAL( -999.0_wp, KIND = wp ), &
10553	BTEST( wall_flags_0(k,j,i), 0 ) )
10554	ENDDO
10555	ENDDO
10556	ENDDO
10557	ENDIF
10558
10559	CASE ( 'm_bin3' )
10560	IF ( av == 0 ) THEN
10561	DO i = nxl, nxr
10562	DO j = nys, nyn
10563	DO k = nzb, nzt+1
10564	temp_bin = 0.0_wp
10565	DO c = 3, ncc_tot*nbins, nbins
10566	temp_bin = temp_bin + aerosol_mass(c)%conc(k,j,i)
10567	ENDDO
10568	local_pf(i,j,k) = MERGE( temp_bin, &
10569	REAL( -999.0_wp, KIND = wp ), &
10570	BTEST( wall_flags_0(k,j,i), 0 ) )
10571	ENDDO
10572	ENDDO
10573	ENDDO
10574	ELSE
10575	DO i = nxl, nxr
10576	DO j = nys, nyn
10577	DO k = nzb, nzt+1
10578	local_pf(i,j,k) = MERGE( mbins_av(k,j,i,3), &
10579	REAL( -999.0_wp, KIND = wp ), &
10580	BTEST( wall_flags_0(k,j,i), 0 ) )
10581	ENDDO
10582	ENDDO
10583	ENDDO
10584	ENDIF
10585
10586	CASE ( 'm_bin4' )
10587	IF ( av == 0 ) THEN
10588	DO i = nxl, nxr
10589	DO j = nys, nyn
10590	DO k = nzb, nzt+1
10591	temp_bin = 0.0_wp
10592	DO c = 4, ncc_tot*nbins, nbins
10593	temp_bin = temp_bin + aerosol_mass(c)%conc(k,j,i)
10594	ENDDO
10595	local_pf(i,j,k) = MERGE( temp_bin, &
10596	REAL( -999.0_wp, KIND = wp ), &
10597	BTEST( wall_flags_0(k,j,i), 0 ) )
10598	ENDDO
10599	ENDDO
10600	ENDDO
10601	ELSE
10602	DO i = nxl, nxr
10603	DO j = nys, nyn
10604	DO k = nzb, nzt+1
10605	local_pf(i,j,k) = MERGE( mbins_av(k,j,i,4), &
10606	REAL( -999.0_wp, KIND = wp ), &
10607	BTEST( wall_flags_0(k,j,i), 0 ) )
10608	ENDDO
10609	ENDDO
10610	ENDDO
10611	ENDIF
10612
10613	CASE ( 'm_bin5' )
10614	IF ( av == 0 ) THEN
10615	DO i = nxl, nxr
10616	DO j = nys, nyn
10617	DO k = nzb, nzt+1
10618	temp_bin = 0.0_wp
10619	DO c = 5, ncc_tot*nbins, nbins
10620	temp_bin = temp_bin + aerosol_mass(c)%conc(k,j,i)
10621	ENDDO
10622	local_pf(i,j,k) = MERGE( temp_bin, &
10623	REAL( -999.0_wp, KIND = wp ), &
10624	BTEST( wall_flags_0(k,j,i), 0 ) )
10625	ENDDO
10626	ENDDO
10627	ENDDO
10628	ELSE
10629	DO i = nxl, nxr
10630	DO j = nys, nyn
10631	DO k = nzb, nzt+1
10632	local_pf(i,j,k) = MERGE( mbins_av(k,j,i,5), &
10633	REAL( -999.0_wp, KIND = wp ), &
10634	BTEST( wall_flags_0(k,j,i), 0 ) )
10635	ENDDO
10636	ENDDO
10637	ENDDO
10638	ENDIF
10639
10640	CASE ( 'm_bin6' )
10641	IF ( av == 0 ) THEN
10642	DO i = nxl, nxr
10643	DO j = nys, nyn
10644	DO k = nzb, nzt+1
10645	temp_bin = 0.0_wp
10646	DO c = 6, ncc_tot*nbins, nbins
10647	temp_bin = temp_bin + aerosol_mass(c)%conc(k,j,i)
10648	ENDDO
10649	local_pf(i,j,k) = MERGE( temp_bin, &
10650	REAL( -999.0_wp, KIND = wp ), &
10651	BTEST( wall_flags_0(k,j,i), 0 ) )
10652	ENDDO
10653	ENDDO
10654	ENDDO
10655	ELSE
10656	DO i = nxl, nxr
10657	DO j = nys, nyn
10658	DO k = nzb, nzt+1
10659	local_pf(i,j,k) = MERGE( mbins_av(k,j,i,6), &
10660	REAL( -999.0_wp, KIND = wp ), &
10661	BTEST( wall_flags_0(k,j,i), 0 ) )
10662	ENDDO
10663	ENDDO
10664	ENDDO
10665	ENDIF
10666
10667	CASE ( 'm_bin7' )
10668	IF ( av == 0 ) THEN
10669	DO i = nxl, nxr
10670	DO j = nys, nyn
10671	DO k = nzb, nzt+1
10672	temp_bin = 0.0_wp
10673	DO c = 7, ncc_tot*nbins, nbins
10674	temp_bin = temp_bin + aerosol_mass(c)%conc(k,j,i)
10675	ENDDO
10676	local_pf(i,j,k) = MERGE( temp_bin, &
10677	REAL( -999.0_wp, KIND = wp ), &
10678	BTEST( wall_flags_0(k,j,i), 0 ) )
10679	ENDDO
10680	ENDDO
10681	ENDDO
10682	ELSE
10683	DO i = nxl, nxr
10684	DO j = nys, nyn
10685	DO k = nzb, nzt+1
10686	local_pf(i,j,k) = MERGE( mbins_av(k,j,i,7), &
10687	REAL( -999.0_wp, KIND = wp ), &
10688	BTEST( wall_flags_0(k,j,i), 0 ) )
10689	ENDDO
10690	ENDDO
10691	ENDDO
10692	ENDIF
10693
10694	CASE ( 'm_bin8' )
10695	IF ( av == 0 ) THEN
10696	DO i = nxl, nxr
10697	DO j = nys, nyn
10698	DO k = nzb, nzt+1
10699	temp_bin = 0.0_wp
10700	DO c = 8, ncc_tot*nbins, nbins
10701	temp_bin = temp_bin + aerosol_mass(c)%conc(k,j,i)
10702	ENDDO
10703	local_pf(i,j,k) = MERGE( temp_bin, &
10704	REAL( -999.0_wp, KIND = wp ), &
10705	BTEST( wall_flags_0(k,j,i), 0 ) )
10706	ENDDO
10707	ENDDO
10708	ENDDO
10709	ELSE
10710	DO i = nxl, nxr
10711	DO j = nys, nyn
10712	DO k = nzb, nzt+1
10713	local_pf(i,j,k) = MERGE( mbins_av(k,j,i,8), &
10714	REAL( -999.0_wp, KIND = wp ), &
10715	BTEST( wall_flags_0(k,j,i), 0 ) )
10716	ENDDO
10717	ENDDO
10718	ENDDO
10719	ENDIF
10720
10721	CASE ( 'm_bin9' )
10722	IF ( av == 0 ) THEN
10723	DO i = nxl, nxr
10724	DO j = nys, nyn
10725	DO k = nzb, nzt+1
10726	temp_bin = 0.0_wp
10727	DO c = 9, ncc_tot*nbins, nbins
10728	temp_bin = temp_bin + aerosol_mass(c)%conc(k,j,i)
10729	ENDDO
10730	local_pf(i,j,k) = MERGE( temp_bin, &
10731	REAL( -999.0_wp, KIND = wp ), &
10732	BTEST( wall_flags_0(k,j,i), 0 ) )
10733	ENDDO
10734	ENDDO
10735	ENDDO
10736	ELSE
10737	DO i = nxl, nxr
10738	DO j = nys, nyn
10739	DO k = nzb, nzt+1
10740	local_pf(i,j,k) = MERGE( mbins_av(k,j,i,9), &
10741	REAL( -999.0_wp, KIND = wp ), &
10742	BTEST( wall_flags_0(k,j,i), 0 ) )
10743	ENDDO
10744	ENDDO
10745	ENDDO
10746	ENDIF
10747
10748	CASE ( 'm_bin10' )
10749	IF ( av == 0 ) THEN
10750	DO i = nxl, nxr
10751	DO j = nys, nyn
10752	DO k = nzb, nzt+1
10753	temp_bin = 0.0_wp
10754	DO c = 10, ncc_tot*nbins, nbins
10755	temp_bin = temp_bin + aerosol_mass(c)%conc(k,j,i)
10756	ENDDO
10757	local_pf(i,j,k) = MERGE( temp_bin, &
10758	REAL( -999.0_wp, KIND = wp ), &
10759	BTEST( wall_flags_0(k,j,i), 0 ) )
10760	ENDDO
10761	ENDDO
10762	ENDDO
10763	ELSE
10764	DO i = nxl, nxr
10765	DO j = nys, nyn
10766	DO k = nzb, nzt+1
10767	local_pf(i,j,k) = MERGE( mbins_av(k,j,i,10), &
10768	REAL( -999.0_wp, KIND = wp ), &
10769	BTEST( wall_flags_0(k,j,i), 0 ) )
10770	ENDDO
10771	ENDDO
10772	ENDDO
10773	ENDIF
10774
10775	CASE ( 'm_bin11' )
10776	IF ( av == 0 ) THEN
10777	DO i = nxl, nxr
10778	DO j = nys, nyn
10779	DO k = nzb, nzt+1
10780	temp_bin = 0.0_wp
10781	DO c = 11, ncc_tot*nbins, nbins
10782	temp_bin = temp_bin + aerosol_mass(c)%conc(k,j,i)
10783	ENDDO
10784	local_pf(i,j,k) = MERGE( temp_bin, &
10785	REAL( -999.0_wp, KIND = wp ), &
10786	BTEST( wall_flags_0(k,j,i), 0 ) )
10787	ENDDO
10788	ENDDO
10789	ENDDO
10790	ELSE
10791	DO i = nxl, nxr
10792	DO j = nys, nyn
10793	DO k = nzb, nzt+1
10794	local_pf(i,j,k) = MERGE( mbins_av(k,j,i,11), &
10795	REAL( -999.0_wp, KIND = wp ), &
10796	BTEST( wall_flags_0(k,j,i), 0 ) )
10797	ENDDO
10798	ENDDO
10799	ENDDO
10800	ENDIF
10801
10802	CASE ( 'm_bin12' )
10803	IF ( av == 0 ) THEN
10804	DO i = nxl, nxr
10805	DO j = nys, nyn
10806	DO k = nzb, nzt+1
10807	temp_bin = 0.0_wp
10808	DO c = 12, ncc_tot*nbins, nbins
10809	temp_bin = temp_bin + aerosol_mass(c)%conc(k,j,i)
10810	ENDDO
10811	local_pf(i,j,k) = MERGE( temp_bin, &
10812	REAL( -999.0_wp, KIND = wp ), &
10813	BTEST( wall_flags_0(k,j,i), 0 ) )
10814	ENDDO
10815	ENDDO
10816	ENDDO
10817	ELSE
10818	DO i = nxl, nxr
10819	DO j = nys, nyn
10820	DO k = nzb, nzt+1
10821	local_pf(i,j,k) = MERGE( mbins_av(k,j,i,12), &
10822	REAL( -999.0_wp, KIND = wp ), &
10823	BTEST( wall_flags_0(k,j,i), 0 ) )
10824	ENDDO
10825	ENDDO
10826	ENDDO
10827	ENDIF
10828
10829	CASE ( 's_BC', 's_DU', 's_H2O', 's_NH', 's_NO', 's_OC', 's_SO4', 's_SS' )
10830	IF ( is_used( prtcl, TRIM( variable(3:) ) ) ) THEN
10831	icc = get_index( prtcl, TRIM( variable(3:) ) )
10832	IF ( av == 0 ) THEN
10833	DO i = nxl, nxr
10834	DO j = nys, nyn
10835	DO k = nzb, nzt+1
10836	temp_bin = 0.0_wp
10837	DO c = ( icc-1 )nbins+1, iccnbins
10838	temp_bin = temp_bin + aerosol_mass(c)%conc(k,j,i)
10839	ENDDO
10840	local_pf(i,j,k) = MERGE( temp_bin, &
10841	REAL( -999.0_wp, KIND = wp ), &
10842	BTEST( wall_flags_0(k,j,i), 0 ) )
10843	ENDDO
10844	ENDDO
10845	ENDDO
10846	ELSE
10847	IF ( TRIM( variable(3:) ) == 'BC' ) to_be_resorted => s_BC_av
10848	IF ( TRIM( variable(3:) ) == 'DU' ) to_be_resorted => s_DU_av
10849	IF ( TRIM( variable(3:) ) == 'NH' ) to_be_resorted => s_NH_av
10850	IF ( TRIM( variable(3:) ) == 'NO' ) to_be_resorted => s_NO_av
10851	IF ( TRIM( variable(3:) ) == 'OC' ) to_be_resorted => s_OC_av
10852	IF ( TRIM( variable(3:) ) == 'SO4' ) to_be_resorted => s_SO4_av
10853	IF ( TRIM( variable(3:) ) == 'SS' ) to_be_resorted => s_SS_av
10854	DO i = nxl, nxr
10855	DO j = nys, nyn
10856	DO k = nzb, nzt+1
10857	local_pf(i,j,k) = MERGE( to_be_resorted(k,j,i), &
10858	REAL( -999.0_wp, KIND = wp ), &
10859	BTEST( wall_flags_0(k,j,i), 0 ) )
10860	ENDDO
10861	ENDDO
10862	ENDDO
10863	ENDIF
10864	ENDIF
10865	CASE DEFAULT
10866	found = .FALSE.
10867
10868	END SELECT
10869
10870	END SUBROUTINE salsa_data_output_3d
10871
10872	!------------------------------------------------------------------------------!
10873	!
10874	! Description:
10875	! ------------
10876	!> Subroutine defining mask output variables
10877	!------------------------------------------------------------------------------!
10878	SUBROUTINE salsa_data_output_mask( av, variable, found, local_pf )
10879
10880	USE control_parameters, &
10881	ONLY: mask_size_l, mid
10882
10883	IMPLICIT NONE
10884
10885	CHARACTER (LEN=*) :: variable !<
10886
10887	INTEGER(iwp) :: av !<
10888	INTEGER(iwp) :: c !<
10889	INTEGER(iwp) :: i !<
10890	INTEGER(iwp) :: icc !< index of a chemical compound
10891	INTEGER(iwp) :: j !<
10892	INTEGER(iwp) :: k !<
10893	INTEGER(iwp) :: n !<
10894
10895	LOGICAL :: found !<
10896	REAL(wp) :: df !< For calculating LDSA: fraction of particles
10897	!< depositing in the alveolar (or tracheobronchial)
10898	!< region of the lung. Depends on the particle size
10899	REAL(wp) :: mean_d !< Particle diameter in micrometres
10900	REAL(wp) :: nc !< Particle number concentration in units 1/cm**3
10901
10902	REAL(wp), &
10903	DIMENSION(mask_size_l(mid,1),mask_size_l(mid,2),mask_size_l(mid,3)) :: &
10904	local_pf !<
10905	REAL(wp) :: temp_bin !<
10906	REAL(wp), DIMENSION(:,:,:), POINTER :: to_be_resorted !< points to
10907	!< selected output variable
10908
10909	found = .TRUE.
10910	temp_bin = 0.0_wp
10911
10912	SELECT CASE ( TRIM( variable ) )
10913
10914	CASE ( 'g_H2SO4', 'g_HNO3', 'g_NH3', 'g_OCNV', 'g_OCSV' )
10915	IF ( av == 0 ) THEN
10916	IF ( TRIM( variable ) == 'g_H2SO4') icc = 1
10917	IF ( TRIM( variable ) == 'g_HNO3') icc = 2
10918	IF ( TRIM( variable ) == 'g_NH3') icc = 3
10919	IF ( TRIM( variable ) == 'g_OCNV') icc = 4
10920	IF ( TRIM( variable ) == 'g_OCSV') icc = 5
10921
10922	DO i = 1, mask_size_l(mid,1)
10923	DO j = 1, mask_size_l(mid,2)
10924	DO k = 1, mask_size_l(mid,3)
10925	local_pf(i,j,k) = salsa_gas(icc)%conc(mask_k(mid,k), &
10926	mask_j(mid,j),mask_i(mid,i))
10927	ENDDO
10928	ENDDO
10929	ENDDO
10930	ELSE
10931	IF ( TRIM( variable(3:) ) == 'H2SO4' ) to_be_resorted => g_H2SO4_av
10932	IF ( TRIM( variable(3:) ) == 'HNO3' ) to_be_resorted => g_HNO3_av
10933	IF ( TRIM( variable(3:) ) == 'NH3' ) to_be_resorted => g_NH3_av
10934	IF ( TRIM( variable(3:) ) == 'OCNV' ) to_be_resorted => g_OCNV_av
10935	IF ( TRIM( variable(3:) ) == 'OCSV' ) to_be_resorted => g_OCSV_av
10936	DO i = 1, mask_size_l(mid,1)
10937	DO j = 1, mask_size_l(mid,2)
10938	DO k = 1, mask_size_l(mid,3)
10939	local_pf(i,j,k) = to_be_resorted(mask_k(mid,k), &
10940	mask_j(mid,j),mask_i(mid,i))
10941	ENDDO
10942	ENDDO
10943	ENDDO
10944	ENDIF
10945
10946	CASE ( 'LDSA' )
10947	IF ( av == 0 ) THEN
10948	DO i = 1, mask_size_l(mid,1)
10949	DO j = 1, mask_size_l(mid,2)
10950	DO k = 1, mask_size_l(mid,3)
10951	temp_bin = 0.0_wp
10952	DO n = 1, nbins
10953	!
10954	!-- Diameter in micrometres
10955	mean_d = 1.0E+6_wp * Ra_dry(mask_k(mid,k), &
10956	mask_j(mid,j),mask_i(mid,i),n) * 2.0_wp
10957	!
10958	!-- Deposition factor: alveolar (use Ra_dry for the size??)
10959	df = ( 0.01555_wp / mean_d ) * ( EXP( -0.416_wp * &
10960	( LOG( mean_d ) + 2.84_wp )**2.0_wp ) &
10961	+ 19.11_wp * EXP( -0.482_wp * &
10962	( LOG( mean_d ) - 1.362_wp )**2.0_wp ) )
10963	!
10964	!-- Number concentration in 1/cm3
10965	nc = 1.0E-6_wp * aerosol_number(n)%conc(mask_k(mid,k),&
10966	mask_j(mid,j),mask_i(mid,i))
10967	!
10968	!-- Lung-deposited surface area LDSA (units mum2/cm3)
10969	temp_bin = temp_bin + pi * mean_d*2.0_wp df * nc
10970	ENDDO
10971	local_pf(i,j,k) = temp_bin
10972	ENDDO
10973	ENDDO
10974	ENDDO
10975	ELSE
10976	DO i = 1, mask_size_l(mid,1)
10977	DO j = 1, mask_size_l(mid,2)
10978	DO k = 1, mask_size_l(mid,3)
10979	local_pf(i,j,k) = LDSA_av(mask_k(mid,k), &
10980	mask_j(mid,j),mask_i(mid,i))
10981	ENDDO
10982	ENDDO
10983	ENDDO
10984	ENDIF
10985
10986	CASE ( 'Ntot' )
10987	IF ( av == 0 ) THEN
10988	DO i = 1, mask_size_l(mid,1)
10989	DO j = 1, mask_size_l(mid,2)
10990	DO k = 1, mask_size_l(mid,3)
10991	temp_bin = 0.0_wp
10992	DO n = 1, nbins
10993	temp_bin = temp_bin + aerosol_number(n)%conc( &
10994	mask_k(mid,k),mask_j(mid,j),mask_i(mid,i))
10995	ENDDO
10996	local_pf(i,j,k) = temp_bin
10997	ENDDO
10998	ENDDO
10999	ENDDO
11000	ELSE
11001	DO i = 1, mask_size_l(mid,1)
11002	DO j = 1, mask_size_l(mid,2)
11003	DO k = 1, mask_size_l(mid,3)
11004	local_pf(i,j,k) = Ntot_av(mask_k(mid,k), &
11005	mask_j(mid,j),mask_i(mid,i))
11006	ENDDO
11007	ENDDO
11008	ENDDO
11009	ENDIF
11010
11011	CASE ( 'PM2.5' )
11012	IF ( av == 0 ) THEN
11013	DO i = 1, mask_size_l(mid,1)
11014	DO j = 1, mask_size_l(mid,2)
11015	DO k = 1, mask_size_l(mid,3)
11016	temp_bin = 0.0_wp
11017	DO n = 1, nbins
11018	IF ( 2.0_wp * Ra_dry(mask_k(mid,k),mask_j(mid,j), &
11019	mask_i(mid,i),n) <= 2.5E-6_wp ) THEN
11020	DO c = n, nbins*ncc, nbins
11021	temp_bin = temp_bin + aerosol_mass(c)%conc( &
11022	mask_k(mid,k), mask_j(mid,j),mask_i(mid,i))
11023	ENDDO
11024	ENDIF
11025	ENDDO
11026	local_pf(i,j,k) = temp_bin
11027	ENDDO
11028	ENDDO
11029	ENDDO
11030	ELSE
11031	DO i = 1, mask_size_l(mid,1)
11032	DO j = 1, mask_size_l(mid,2)
11033	DO k = 1, mask_size_l(mid,3)
11034	local_pf(i,j,k) = PM25_av(mask_k(mid,k), &
11035	mask_j(mid,j),mask_i(mid,i))
11036	ENDDO
11037	ENDDO
11038	ENDDO
11039	ENDIF
11040
11041	CASE ( 'PM10' )
11042	IF ( av == 0 ) THEN
11043	DO i = 1, mask_size_l(mid,1)
11044	DO j = 1, mask_size_l(mid,2)
11045	DO k = 1, mask_size_l(mid,3)
11046	temp_bin = 0.0_wp
11047	DO n = 1, nbins
11048	IF ( 2.0_wp * Ra_dry(mask_k(mid,k),mask_j(mid,j), &
11049	mask_i(mid,i),n) <= 10.0E-6_wp ) THEN
11050	DO c = n, nbins*ncc, nbins
11051	temp_bin = temp_bin + aerosol_mass(c)%conc( &
11052	mask_k(mid,k),mask_j(mid,j),mask_i(mid,i))
11053	ENDDO
11054	ENDIF
11055	ENDDO
11056	local_pf(i,j,k) = temp_bin
11057	ENDDO
11058	ENDDO
11059	ENDDO
11060	ELSE
11061	DO i = 1, mask_size_l(mid,1)
11062	DO j = 1, mask_size_l(mid,2)
11063	DO k = 1, mask_size_l(mid,3)
11064	local_pf(i,j,k) = PM10_av(mask_k(mid,k), &
11065	mask_j(mid,j),mask_i(mid,i))
11066	ENDDO
11067	ENDDO
11068	ENDDO
11069	ENDIF
11070
11071	CASE ( 'N_bin1' )
11072	IF ( av == 0 ) THEN
11073	DO i = 1, mask_size_l(mid,1)
11074	DO j = 1, mask_size_l(mid,2)
11075	DO k = 1, mask_size_l(mid,3)
11076	local_pf(i,j,k) = aerosol_number(1)%conc(mask_k(mid,k), &
11077	mask_j(mid,j),mask_i(mid,i))
11078	ENDDO
11079	ENDDO
11080	ENDDO
11081	ELSE
11082	DO i = 1, mask_size_l(mid,1)
11083	DO j = 1, mask_size_l(mid,2)
11084	DO k = 1, mask_size_l(mid,3)
11085	local_pf(i,j,k) = Nbins_av(mask_k(mid,k), &
11086	mask_j(mid,j),mask_i(mid,i),1)
11087	ENDDO
11088	ENDDO
11089	ENDDO
11090	ENDIF
11091
11092	CASE ( 'N_bin2' )
11093	IF ( av == 0 ) THEN
11094	DO i = 1, mask_size_l(mid,1)
11095	DO j = 1, mask_size_l(mid,2)
11096	DO k = 1, mask_size_l(mid,3)
11097	local_pf(i,j,k) = aerosol_number(2)%conc(mask_k(mid,k), &
11098	mask_j(mid,j),mask_i(mid,i))
11099	ENDDO
11100	ENDDO
11101	ENDDO
11102	ELSE
11103	DO i = 1, mask_size_l(mid,1)
11104	DO j = 1, mask_size_l(mid,2)
11105	DO k = 1, mask_size_l(mid,3)
11106	local_pf(i,j,k) = Nbins_av(mask_k(mid,k), &
11107	mask_j(mid,j),mask_i(mid,i),2)
11108	ENDDO
11109	ENDDO
11110	ENDDO
11111	ENDIF
11112
11113	CASE ( 'N_bin3' )
11114	IF ( av == 0 ) THEN
11115	DO i = 1, mask_size_l(mid,1)
11116	DO j = 1, mask_size_l(mid,2)
11117	DO k = 1, mask_size_l(mid,3)
11118	local_pf(i,j,k) = aerosol_number(3)%conc(mask_k(mid,k), &
11119	mask_j(mid,j),mask_i(mid,i))
11120	ENDDO
11121	ENDDO
11122	ENDDO
11123	ELSE
11124	DO i = 1, mask_size_l(mid,1)
11125	DO j = 1, mask_size_l(mid,2)
11126	DO k = 1, mask_size_l(mid,3)
11127	local_pf(i,j,k) = Nbins_av(mask_k(mid,k), &
11128	mask_j(mid,j),mask_i(mid,i),3)
11129	ENDDO
11130	ENDDO
11131	ENDDO
11132	ENDIF
11133
11134	CASE ( 'N_bin4' )
11135	IF ( av == 0 ) THEN
11136	DO i = 1, mask_size_l(mid,1)
11137	DO j = 1, mask_size_l(mid,2)
11138	DO k = 1, mask_size_l(mid,3)
11139	local_pf(i,j,k) = aerosol_number(4)%conc(mask_k(mid,k), &
11140	mask_j(mid,j),mask_i(mid,i))
11141	ENDDO
11142	ENDDO
11143	ENDDO
11144	ELSE
11145	DO i = 1, mask_size_l(mid,1)
11146	DO j = 1, mask_size_l(mid,2)
11147	DO k = 1, mask_size_l(mid,3)
11148	local_pf(i,j,k) = Nbins_av(mask_k(mid,k), &
11149	mask_j(mid,j),mask_i(mid,i),4)
11150	ENDDO
11151	ENDDO
11152	ENDDO
11153	ENDIF
11154
11155	CASE ( 'N_bin5' )
11156	IF ( av == 0 ) THEN
11157	DO i = 1, mask_size_l(mid,1)
11158	DO j = 1, mask_size_l(mid,2)
11159	DO k = 1, mask_size_l(mid,3)
11160	local_pf(i,j,k) = aerosol_number(5)%conc(mask_k(mid,k), &
11161	mask_j(mid,j),mask_i(mid,i))
11162	ENDDO
11163	ENDDO
11164	ENDDO
11165	ELSE
11166	DO i = 1, mask_size_l(mid,1)
11167	DO j = 1, mask_size_l(mid,2)
11168	DO k = 1, mask_size_l(mid,3)
11169	local_pf(i,j,k) = Nbins_av(mask_k(mid,k), &
11170	mask_j(mid,j),mask_i(mid,i),5)
11171	ENDDO
11172	ENDDO
11173	ENDDO
11174	ENDIF
11175
11176	CASE ( 'N_bin6' )
11177	IF ( av == 0 ) THEN
11178	DO i = 1, mask_size_l(mid,1)
11179	DO j = 1, mask_size_l(mid,2)
11180	DO k = 1, mask_size_l(mid,3)
11181	local_pf(i,j,k) = aerosol_number(6)%conc(mask_k(mid,k), &
11182	mask_j(mid,j),mask_i(mid,i))
11183	ENDDO
11184	ENDDO
11185	ENDDO
11186	ELSE
11187	DO i = 1, mask_size_l(mid,1)
11188	DO j = 1, mask_size_l(mid,2)
11189	DO k = 1, mask_size_l(mid,3)
11190	local_pf(i,j,k) = Nbins_av(mask_k(mid,k), &
11191	mask_j(mid,j),mask_i(mid,i),6)
11192	ENDDO
11193	ENDDO
11194	ENDDO
11195	ENDIF
11196
11197	CASE ( 'N_bin7' )
11198	IF ( av == 0 ) THEN
11199	DO i = 1, mask_size_l(mid,1)
11200	DO j = 1, mask_size_l(mid,2)
11201	DO k = 1, mask_size_l(mid,3)
11202	local_pf(i,j,k) = aerosol_number(7)%conc(mask_k(mid,k), &
11203	mask_j(mid,j),mask_i(mid,i))
11204	ENDDO
11205	ENDDO
11206	ENDDO
11207	ELSE
11208	DO i = 1, mask_size_l(mid,1)
11209	DO j = 1, mask_size_l(mid,2)
11210	DO k = 1, mask_size_l(mid,3)
11211	local_pf(i,j,k) = Nbins_av(mask_k(mid,k), &
11212	mask_j(mid,j),mask_i(mid,i),7)
11213	ENDDO
11214	ENDDO
11215	ENDDO
11216	ENDIF
11217
11218	CASE ( 'N_bin8' )
11219	IF ( av == 0 ) THEN
11220	DO i = 1, mask_size_l(mid,1)
11221	DO j = 1, mask_size_l(mid,2)
11222	DO k = 1, mask_size_l(mid,3)
11223	local_pf(i,j,k) = aerosol_number(8)%conc(mask_k(mid,k), &
11224	mask_j(mid,j),mask_i(mid,i))
11225	ENDDO
11226	ENDDO
11227	ENDDO
11228	ELSE
11229	DO i = 1, mask_size_l(mid,1)
11230	DO j = 1, mask_size_l(mid,2)
11231	DO k = 1, mask_size_l(mid,3)
11232	local_pf(i,j,k) = Nbins_av(mask_k(mid,k), &
11233	mask_j(mid,j),mask_i(mid,i),8)
11234	ENDDO
11235	ENDDO
11236	ENDDO
11237	ENDIF
11238
11239	CASE ( 'N_bin9' )
11240	IF ( av == 0 ) THEN
11241	DO i = 1, mask_size_l(mid,1)
11242	DO j = 1, mask_size_l(mid,2)
11243	DO k = 1, mask_size_l(mid,3)
11244	local_pf(i,j,k) = aerosol_number(9)%conc(mask_k(mid,k), &
11245	mask_j(mid,j),mask_i(mid,i))
11246	ENDDO
11247	ENDDO
11248	ENDDO
11249	ELSE
11250	DO i = 1, mask_size_l(mid,1)
11251	DO j = 1, mask_size_l(mid,2)
11252	DO k = 1, mask_size_l(mid,3)
11253	local_pf(i,j,k) = Nbins_av(mask_k(mid,k), &
11254	mask_j(mid,j),mask_i(mid,i),9)
11255	ENDDO
11256	ENDDO
11257	ENDDO
11258	ENDIF
11259
11260	CASE ( 'N_bin10' )
11261	IF ( av == 0 ) THEN
11262	DO i = 1, mask_size_l(mid,1)
11263	DO j = 1, mask_size_l(mid,2)
11264	DO k = 1, mask_size_l(mid,3)
11265	local_pf(i,j,k) = aerosol_number(10)%conc(mask_k(mid,k), &
11266	mask_j(mid,j),mask_i(mid,i))
11267	ENDDO
11268	ENDDO
11269	ENDDO
11270	ELSE
11271	DO i = 1, mask_size_l(mid,1)
11272	DO j = 1, mask_size_l(mid,2)
11273	DO k = 1, mask_size_l(mid,3)
11274	local_pf(i,j,k) = Nbins_av(mask_k(mid,k), &
11275	mask_j(mid,j),mask_i(mid,i),10)
11276	ENDDO
11277	ENDDO
11278	ENDDO
11279	ENDIF
11280
11281	CASE ( 'N_bin11' )
11282	IF ( av == 0 ) THEN
11283	DO i = 1, mask_size_l(mid,1)
11284	DO j = 1, mask_size_l(mid,2)
11285	DO k = 1, mask_size_l(mid,3)
11286	local_pf(i,j,k) = aerosol_number(11)%conc(mask_k(mid,k), &
11287	mask_j(mid,j),mask_i(mid,i))
11288	ENDDO
11289	ENDDO
11290	ENDDO
11291	ELSE
11292	DO i = 1, mask_size_l(mid,1)
11293	DO j = 1, mask_size_l(mid,2)
11294	DO k = 1, mask_size_l(mid,3)
11295	local_pf(i,j,k) = Nbins_av(mask_k(mid,k), &
11296	mask_j(mid,j),mask_i(mid,i),11)
11297	ENDDO
11298	ENDDO
11299	ENDDO
11300	ENDIF
11301
11302	CASE ( 'N_bin12' )
11303	IF ( av == 0 ) THEN
11304	DO i = 1, mask_size_l(mid,1)
11305	DO j = 1, mask_size_l(mid,2)
11306	DO k = 1, mask_size_l(mid,3)
11307	local_pf(i,j,k) = aerosol_number(12)%conc(mask_k(mid,k), &
11308	mask_j(mid,j),mask_i(mid,i))
11309	ENDDO
11310	ENDDO
11311	ENDDO
11312	ELSE
11313	DO i = 1, mask_size_l(mid,1)
11314	DO j = 1, mask_size_l(mid,2)
11315	DO k = 1, mask_size_l(mid,3)
11316	local_pf(i,j,k) = Nbins_av(mask_k(mid,k), &
11317	mask_j(mid,j),mask_i(mid,i),12)
11318	ENDDO
11319	ENDDO
11320	ENDDO
11321	ENDIF
11322
11323	CASE ( 'm_bin1' )
11324	IF ( av == 0 ) THEN
11325	DO i = 1, mask_size_l(mid,1)
11326	DO j = 1, mask_size_l(mid,2)
11327	DO k = 1, mask_size_l(mid,3)
11328	temp_bin = 0.0_wp
11329	DO c = 1, ncc_tot*nbins, nbins
11330	temp_bin = temp_bin + aerosol_mass(c)%conc( &
11331	mask_k(mid,k),mask_j(mid,j),mask_i(mid,i))
11332	ENDDO
11333	local_pf(i,j,k) = temp_bin
11334	ENDDO
11335	ENDDO
11336	ENDDO
11337	ELSE
11338	DO i = 1, mask_size_l(mid,1)
11339	DO j = 1, mask_size_l(mid,2)
11340	DO k = 1, mask_size_l(mid,3)
11341	local_pf(i,j,k) = mbins_av(mask_k(mid,k), &
11342	mask_j(mid,j),mask_i(mid,i),1)
11343	ENDDO
11344	ENDDO
11345	ENDDO
11346	ENDIF
11347
11348	CASE ( 'm_bin2' )
11349	IF ( av == 0 ) THEN
11350	DO i = 1, mask_size_l(mid,1)
11351	DO j = 1, mask_size_l(mid,2)
11352	DO k = 1, mask_size_l(mid,3)
11353	temp_bin = 0.0_wp
11354	DO c = 2, ncc_tot*nbins, nbins
11355	temp_bin = temp_bin + aerosol_mass(c)%conc( &
11356	mask_k(mid,k),mask_j(mid,j),mask_i(mid,i))
11357	ENDDO
11358	local_pf(i,j,k) = temp_bin
11359	ENDDO
11360	ENDDO
11361	ENDDO
11362	ELSE
11363	DO i = 1, mask_size_l(mid,1)
11364	DO j = 1, mask_size_l(mid,2)
11365	DO k = 1, mask_size_l(mid,3)
11366	local_pf(i,j,k) = mbins_av(mask_k(mid,k), &
11367	mask_j(mid,j),mask_i(mid,i),2)
11368	ENDDO
11369	ENDDO
11370	ENDDO
11371	ENDIF
11372
11373	CASE ( 'm_bin3' )
11374	IF ( av == 0 ) THEN
11375	DO i = 1, mask_size_l(mid,1)
11376	DO j = 1, mask_size_l(mid,2)
11377	DO k = 1, mask_size_l(mid,3)
11378	temp_bin = 0.0_wp
11379	DO c = 3, ncc_tot*nbins, nbins
11380	temp_bin = temp_bin + aerosol_mass(c)%conc( &
11381	mask_k(mid,k),mask_j(mid,j),mask_i(mid,i))
11382	ENDDO
11383	local_pf(i,j,k) = temp_bin
11384	ENDDO
11385	ENDDO
11386	ENDDO
11387	ELSE
11388	DO i = 1, mask_size_l(mid,1)
11389	DO j = 1, mask_size_l(mid,2)
11390	DO k = 1, mask_size_l(mid,3)
11391	local_pf(i,j,k) = mbins_av(mask_k(mid,k), &
11392	mask_j(mid,j),mask_i(mid,i),3)
11393	ENDDO
11394	ENDDO
11395	ENDDO
11396	ENDIF
11397
11398	CASE ( 'm_bin4' )
11399	IF ( av == 0 ) THEN
11400	DO i = 1, mask_size_l(mid,1)
11401	DO j = 1, mask_size_l(mid,2)
11402	DO k = 1, mask_size_l(mid,3)
11403	temp_bin = 0.0_wp
11404	DO c = 4, ncc_tot*nbins, nbins
11405	temp_bin = temp_bin + aerosol_mass(c)%conc( &
11406	mask_k(mid,k),mask_j(mid,j),mask_i(mid,i))
11407	ENDDO
11408	local_pf(i,j,k) = temp_bin
11409	ENDDO
11410	ENDDO
11411	ENDDO
11412	ELSE
11413	DO i = 1, mask_size_l(mid,1)
11414	DO j = 1, mask_size_l(mid,2)
11415	DO k = 1, mask_size_l(mid,3)
11416	local_pf(i,j,k) = mbins_av(mask_k(mid,k), &
11417	mask_j(mid,j),mask_i(mid,i),4)
11418	ENDDO
11419	ENDDO
11420	ENDDO
11421	ENDIF
11422
11423	CASE ( 'm_bin5' )
11424	IF ( av == 0 ) THEN
11425	DO i = 1, mask_size_l(mid,1)
11426	DO j = 1, mask_size_l(mid,2)
11427	DO k = 1, mask_size_l(mid,3)
11428	temp_bin = 0.0_wp
11429	DO c = 5, ncc_tot*nbins, nbins
11430	temp_bin = temp_bin + aerosol_mass(c)%conc( &
11431	mask_k(mid,k),mask_j(mid,j),mask_i(mid,i))
11432	ENDDO
11433	local_pf(i,j,k) = temp_bin
11434	ENDDO
11435	ENDDO
11436	ENDDO
11437	ELSE
11438	DO i = 1, mask_size_l(mid,1)
11439	DO j = 1, mask_size_l(mid,2)
11440	DO k = 1, mask_size_l(mid,3)
11441	local_pf(i,j,k) = mbins_av(mask_k(mid,k), &
11442	mask_j(mid,j),mask_i(mid,i),5)
11443	ENDDO
11444	ENDDO
11445	ENDDO
11446	ENDIF
11447
11448	CASE ( 'm_bin6' )
11449	IF ( av == 0 ) THEN
11450	DO i = 1, mask_size_l(mid,1)
11451	DO j = 1, mask_size_l(mid,2)
11452	DO k = 1, mask_size_l(mid,3)
11453	temp_bin = 0.0_wp
11454	DO c = 6, ncc_tot*nbins, nbins
11455	temp_bin = temp_bin + aerosol_mass(c)%conc( &
11456	mask_k(mid,k),mask_j(mid,j),mask_i(mid,i))
11457	ENDDO
11458	local_pf(i,j,k) = temp_bin
11459	ENDDO
11460	ENDDO
11461	ENDDO
11462	ELSE
11463	DO i = 1, mask_size_l(mid,1)
11464	DO j = 1, mask_size_l(mid,2)
11465	DO k = 1, mask_size_l(mid,3)
11466	local_pf(i,j,k) = mbins_av(mask_k(mid,k), &
11467	mask_j(mid,j),mask_i(mid,i),6)
11468	ENDDO
11469	ENDDO
11470	ENDDO
11471	ENDIF
11472
11473	CASE ( 'm_bin7' )
11474	IF ( av == 0 ) THEN
11475	DO i = 1, mask_size_l(mid,1)
11476	DO j = 1, mask_size_l(mid,2)
11477	DO k = 1, mask_size_l(mid,3)
11478	temp_bin = 0.0_wp
11479	DO c = 7, ncc_tot*nbins, nbins
11480	temp_bin = temp_bin + aerosol_mass(c)%conc( &
11481	mask_k(mid,k),mask_j(mid,j),mask_i(mid,i))
11482	ENDDO
11483	local_pf(i,j,k) = temp_bin
11484	ENDDO
11485	ENDDO
11486	ENDDO
11487	ELSE
11488	DO i = 1, mask_size_l(mid,1)
11489	DO j = 1, mask_size_l(mid,2)
11490	DO k = 1, mask_size_l(mid,3)
11491	local_pf(i,j,k) = mbins_av(mask_k(mid,k), &
11492	mask_j(mid,j),mask_i(mid,i),7)
11493	ENDDO
11494	ENDDO
11495	ENDDO
11496	ENDIF
11497
11498	CASE ( 'm_bin8' )
11499	IF ( av == 0 ) THEN
11500	DO i = 1, mask_size_l(mid,1)
11501	DO j = 1, mask_size_l(mid,2)
11502	DO k = 1, mask_size_l(mid,3)
11503	temp_bin = 0.0_wp
11504	DO c = 8, ncc_tot*nbins, nbins
11505	temp_bin = temp_bin + aerosol_mass(c)%conc( &
11506	mask_k(mid,k),mask_j(mid,j),mask_i(mid,i))
11507	ENDDO
11508	local_pf(i,j,k) = temp_bin
11509	ENDDO
11510	ENDDO
11511	ENDDO
11512	ELSE
11513	DO i = 1, mask_size_l(mid,1)
11514	DO j = 1, mask_size_l(mid,2)
11515	DO k = 1, mask_size_l(mid,3)
11516	local_pf(i,j,k) = mbins_av(mask_k(mid,k), &
11517	mask_j(mid,j),mask_i(mid,i),8)
11518	ENDDO
11519	ENDDO
11520	ENDDO
11521	ENDIF
11522
11523	CASE ( 'm_bin9' )
11524	IF ( av == 0 ) THEN
11525	DO i = 1, mask_size_l(mid,1)
11526	DO j = 1, mask_size_l(mid,2)
11527	DO k = 1, mask_size_l(mid,3)
11528	temp_bin = 0.0_wp
11529	DO c = 9, ncc_tot*nbins, nbins
11530	temp_bin = temp_bin + aerosol_mass(c)%conc( &
11531	mask_k(mid,k),mask_j(mid,j),mask_i(mid,i))
11532	ENDDO
11533	local_pf(i,j,k) = temp_bin
11534	ENDDO
11535	ENDDO
11536	ENDDO
11537	ELSE
11538	DO i = 1, mask_size_l(mid,1)
11539	DO j = 1, mask_size_l(mid,2)
11540	DO k = 1, mask_size_l(mid,3)
11541	local_pf(i,j,k) = mbins_av(mask_k(mid,k), &
11542	mask_j(mid,j),mask_i(mid,i),9)
11543	ENDDO
11544	ENDDO
11545	ENDDO
11546	ENDIF
11547
11548	CASE ( 'm_bin10' )
11549	IF ( av == 0 ) THEN
11550	DO i = 1, mask_size_l(mid,1)
11551	DO j = 1, mask_size_l(mid,2)
11552	DO k = 1, mask_size_l(mid,3)
11553	temp_bin = 0.0_wp
11554	DO c = 10, ncc_tot*nbins, nbins
11555	temp_bin = temp_bin + aerosol_mass(c)%conc( &
11556	mask_k(mid,k),mask_j(mid,j),mask_i(mid,i))
11557	ENDDO
11558	local_pf(i,j,k) = temp_bin
11559	ENDDO
11560	ENDDO
11561	ENDDO
11562	ELSE
11563	DO i = 1, mask_size_l(mid,1)
11564	DO j = 1, mask_size_l(mid,2)
11565	DO k = 1, mask_size_l(mid,3)
11566	local_pf(i,j,k) = mbins_av(mask_k(mid,k), &
11567	mask_j(mid,j),mask_i(mid,i),10)
11568	ENDDO
11569	ENDDO
11570	ENDDO
11571	ENDIF
11572
11573	CASE ( 'm_bin11' )
11574	IF ( av == 0 ) THEN
11575	DO i = 1, mask_size_l(mid,1)
11576	DO j = 1, mask_size_l(mid,2)
11577	DO k = 1, mask_size_l(mid,3)
11578	temp_bin = 0.0_wp
11579	DO c = 11, ncc_tot*nbins, nbins
11580	temp_bin = temp_bin + aerosol_mass(c)%conc( &
11581	mask_k(mid,k),mask_j(mid,j),mask_i(mid,i))
11582	ENDDO
11583	local_pf(i,j,k) = temp_bin
11584	ENDDO
11585	ENDDO
11586	ENDDO
11587	ELSE
11588	DO i = 1, mask_size_l(mid,1)
11589	DO j = 1, mask_size_l(mid,2)
11590	DO k = 1, mask_size_l(mid,3)
11591	local_pf(i,j,k) = mbins_av(mask_k(mid,k), &
11592	mask_j(mid,j),mask_i(mid,i),11)
11593	ENDDO
11594	ENDDO
11595	ENDDO
11596	ENDIF
11597
11598	CASE ( 'm_bin12' )
11599	IF ( av == 0 ) THEN
11600	DO i = 1, mask_size_l(mid,1)
11601	DO j = 1, mask_size_l(mid,2)
11602	DO k = 1, mask_size_l(mid,3)
11603	temp_bin = 0.0_wp
11604	DO c = 12, ncc_tot*nbins, nbins
11605	temp_bin = temp_bin + aerosol_mass(c)%conc( &
11606	mask_k(mid,k),mask_j(mid,j),mask_i(mid,i))
11607	ENDDO
11608	local_pf(i,j,k) = temp_bin
11609	ENDDO
11610	ENDDO
11611	ENDDO
11612	ELSE
11613	DO i = 1, mask_size_l(mid,1)
11614	DO j = 1, mask_size_l(mid,2)
11615	DO k = 1, mask_size_l(mid,3)
11616	local_pf(i,j,k) = mbins_av(mask_k(mid,k), &
11617	mask_j(mid,j),mask_i(mid,i),12)
11618	ENDDO
11619	ENDDO
11620	ENDDO
11621	ENDIF
11622
11623	CASE ( 's_BC', 's_DU', 's_NH', 's_NO', 's_OC', 's_SO4', 's_SS' )
11624	IF ( is_used( prtcl, TRIM( variable(3:) ) ) ) THEN
11625	icc = get_index( prtcl, TRIM( variable(3:) ) )
11626	IF ( av == 0 ) THEN
11627	DO i = 1, mask_size_l(mid,1)
11628	DO j = 1, mask_size_l(mid,2)
11629	DO k = 1, mask_size_l(mid,3)
11630	temp_bin = 0.0_wp
11631	DO c = ( icc-1 )nbins+1, iccnbins
11632	temp_bin = temp_bin + aerosol_mass(c)%conc( &
11633	mask_k(mid,k),mask_j(mid,j),mask_i(mid,i))
11634	ENDDO
11635	local_pf(i,j,k) = temp_bin
11636	ENDDO
11637	ENDDO
11638	ENDDO
11639	ELSE
11640	IF ( TRIM( variable(3:) ) == 'BC' ) to_be_resorted => s_BC_av
11641	IF ( TRIM( variable(3:) ) == 'DU' ) to_be_resorted => s_DU_av
11642	IF ( TRIM( variable(3:) ) == 'NH' ) to_be_resorted => s_NH_av
11643	IF ( TRIM( variable(3:) ) == 'NO' ) to_be_resorted => s_NO_av
11644	IF ( TRIM( variable(3:) ) == 'OC' ) to_be_resorted => s_OC_av
11645	IF ( TRIM( variable(3:) ) == 'SO4' ) to_be_resorted => s_SO4_av
11646	IF ( TRIM( variable(3:) ) == 'SS' ) to_be_resorted => s_SS_av
11647	DO i = 1, mask_size_l(mid,1)
11648	DO j = 1, mask_size_l(mid,2)
11649	DO k = 1, mask_size_l(mid,3)
11650	local_pf(i,j,k) = to_be_resorted(mask_k(mid,k), &
11651	mask_j(mid,j),mask_i(mid,i))
11652	ENDDO
11653	ENDDO
11654	ENDDO
11655	ENDIF
11656	ENDIF
11657
11658	CASE DEFAULT
11659	found = .FALSE.
11660
11661	END SELECT
11662
11663	END SUBROUTINE salsa_data_output_mask
11664
11665
11666	END MODULE salsa_mod

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

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |