Home

Context Navigation

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

Last change on this file since 3483 was 3483, checked in by raasch, 6 years ago
bugfix: misplaced positions of cpp-directives for netCDF and MPI fixed; output format limited to a maximum line length of 80
Property svn:keywords set to `Id`
File size: 510.0 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 3483 2018-11-02 14:19:26Z raasch $
27	! bugfix: directives added to allow compilation without netCDF
28	!
29	! 3481 2018-11-02 09:14:13Z raasch
30	! temporary variable cc introduced to circumvent a possible Intel18 compiler bug
31	! related to contiguous/non-contguous pointer/target attributes
32	!
33	! 3473 2018-10-30 20:50:15Z suehring
34	! NetCDF input routine renamed
35	!
36	! 3467 2018-10-30 19:05:21Z suehring
37	! Initial revision
38	!
39	! 3412 2018-10-24 07:25:57Z monakurppa
40	!
41	! Authors:
42	! --------
43	! @author monakurppa
44	!
45	!
46	! Description:
47	! ------------
48	!> Sectional aerosol module for large scale applications SALSA
49	!> (Kokkola et al., 2008, ACP 8, 2469-2483). Solves the aerosol number and mass
50	!> concentration as well as chemical composition. Includes aerosol dynamic
51	!> processes: nucleation, condensation/evaporation of vapours, coagulation and
52	!> deposition on tree leaves, ground and roofs.
53	!> Implementation is based on formulations implemented in UCLALES-SALSA except
54	!> for deposition which is based on parametrisations by Zhang et al. (2001,
55	!> Atmos. Environ. 35, 549-560) or Petroff&Zhang (2010, Geosci. Model Dev. 3,
56	!> 753-769)
57	!>
58	!> @todo Implement turbulent inflow of aerosols in inflow_turbulence.
59	!> @todo Deposition on walls and horizontal surfaces calculated from the aerosol
60	!> dry radius, not wet
61	!> @todo Deposition on subgrid scale vegetation
62	!> @todo Deposition on vegetation calculated by default for deciduous broadleaf
63	!> trees
64	!> @todo Revise masked data output. There is a potential bug in case of
65	!> terrain-following masked output, according to data_output_mask.
66	!> @todo There are now improved interfaces for NetCDF data input which can be
67	!> used instead of get variable etc.
68	!------------------------------------------------------------------------------!
69	MODULE salsa_mod
70
71	USE basic_constants_and_equations_mod, &
72	ONLY: c_p, g, p_0, pi, r_d
73
74	USE chemistry_model_mod, &
75	ONLY: chem_species, nspec, nvar, spc_names
76
77	USE chem_modules, &
78	ONLY: call_chem_at_all_substeps, chem_gasphase_on
79
80	USE control_parameters
81
82	USE indices, &
83	ONLY: nbgp, nx, nxl, nxlg, nxr, nxrg, ny, nyn, nyng, nys, nysg, nzb, &
84	nzb_s_inner, nz, nzt, wall_flags_0
85
86	USE kinds
87
88	USE pegrid
89
90	USE salsa_util_mod
91
92	IMPLICIT NONE
93	!
94	!-- SALSA constants:
95	!
96	!-- Local constants:
97	INTEGER(iwp), PARAMETER :: ngast = 5 !< total number of gaseous tracers:
98	!< 1 = H2SO4, 2 = HNO3, 3 = NH3,
99	!< 4 = OCNV (non-volatile OC),
100	!< 5 = OCSV (semi-volatile)
101	INTEGER(iwp), PARAMETER :: nmod = 7 !< number of modes for initialising
102	!< the aerosol size distribution
103	INTEGER(iwp), PARAMETER :: nreg = 2 !< Number of main size subranges
104	INTEGER(iwp), PARAMETER :: maxspec = 7 !< Max. number of aerosol species
105	!
106	!-- Universal constants
107	REAL(wp), PARAMETER :: abo = 1.380662E-23_wp !< Boltzmann constant (J/K)
108	REAL(wp), PARAMETER :: alv = 2.260E+6_wp !< latent heat for H2O
109	!< vaporisation (J/kg)
110	REAL(wp), PARAMETER :: alv_d_rv = 4896.96865_wp !< alv / rv
111	REAL(wp), PARAMETER :: am_airmol = 4.8096E-26_wp !< Average mass of one air
112	!< molecule (Jacobson,
113	!< 2005, Eq. 2.3)
114	REAL(wp), PARAMETER :: api6 = 0.5235988_wp !< pi / 6
115	REAL(wp), PARAMETER :: argas = 8.314409_wp !< Gas constant (J/(mol K))
116	REAL(wp), PARAMETER :: argas_d_cpd = 8.281283865E-3_wp !< argas per cpd
117	REAL(wp), PARAMETER :: avo = 6.02214E+23_wp !< Avogadro constant (1/mol)
118	REAL(wp), PARAMETER :: d_sa = 5.539376964394570E-10_wp !< diameter of
119	!< condensing sulphuric
120	!< acid molecule (m)
121	REAL(wp), PARAMETER :: for_ppm_to_nconc = 7.243016311E+16_wp !<
122	!< ppm * avo / R (K/(Pa*m3))
123	REAL(wp), PARAMETER :: epsoc = 0.15_wp !< water uptake of organic
124	!< material
125	REAL(wp), PARAMETER :: mclim = 1.0E-23_wp !< mass concentration min
126	!< limit for aerosols (kg/m3)
127	REAL(wp), PARAMETER :: n3 = 158.79_wp !< Number of H2SO4 molecules in
128	!< 3 nm cluster if d_sa=5.54e-10m
129	REAL(wp), PARAMETER :: nclim = 1.0_wp !< number concentration min limit
130	!< for aerosols and gases (#/m3)
131	REAL(wp), PARAMETER :: surfw0 = 0.073_wp !< surface tension of pure water
132	!< at ~ 293 K (J/m2)
133	REAL(wp), PARAMETER :: vclim = 1.0E-24_wp !< volume concentration min
134	!< limit for aerosols (m3/m3)
135	!-- Molar masses in kg/mol
136	REAL(wp), PARAMETER :: ambc = 12.0E-3_wp !< black carbon (BC)
137	REAL(wp), PARAMETER :: amdair = 28.970E-3_wp !< dry air
138	REAL(wp), PARAMETER :: amdu = 100.E-3_wp !< mineral dust
139	REAL(wp), PARAMETER :: amh2o = 18.0154E-3_wp !< H2O
140	REAL(wp), PARAMETER :: amh2so4 = 98.06E-3_wp !< H2SO4
141	REAL(wp), PARAMETER :: amhno3 = 63.01E-3_wp !< HNO3
142	REAL(wp), PARAMETER :: amn2o = 44.013E-3_wp !< N2O
143	REAL(wp), PARAMETER :: amnh3 = 17.031E-3_wp !< NH3
144	REAL(wp), PARAMETER :: amo2 = 31.9988E-3_wp !< O2
145	REAL(wp), PARAMETER :: amo3 = 47.998E-3_wp !< O3
146	REAL(wp), PARAMETER :: amoc = 150.E-3_wp !< organic carbon (OC)
147	REAL(wp), PARAMETER :: amss = 58.44E-3_wp !< sea salt (NaCl)
148	!-- Densities in kg/m3
149	REAL(wp), PARAMETER :: arhobc = 2000.0_wp !< black carbon
150	REAL(wp), PARAMETER :: arhodu = 2650.0_wp !< mineral dust
151	REAL(wp), PARAMETER :: arhoh2o = 1000.0_wp !< H2O
152	REAL(wp), PARAMETER :: arhoh2so4 = 1830.0_wp !< SO4
153	REAL(wp), PARAMETER :: arhohno3 = 1479.0_wp !< HNO3
154	REAL(wp), PARAMETER :: arhonh3 = 1530.0_wp !< NH3
155	REAL(wp), PARAMETER :: arhooc = 2000.0_wp !< organic carbon
156	REAL(wp), PARAMETER :: arhoss = 2165.0_wp !< sea salt (NaCl)
157	!-- Volume of molecule in m3/#
158	REAL(wp), PARAMETER :: amvh2o = amh2o /avo / arhoh2o !< H2O
159	REAL(wp), PARAMETER :: amvh2so4 = amh2so4 / avo / arhoh2so4 !< SO4
160	REAL(wp), PARAMETER :: amvhno3 = amhno3 / avo / arhohno3 !< HNO3
161	REAL(wp), PARAMETER :: amvnh3 = amnh3 / avo / arhonh3 !< NH3
162	REAL(wp), PARAMETER :: amvoc = amoc / avo / arhooc !< OC
163	REAL(wp), PARAMETER :: amvss = amss / avo / arhoss !< sea salt
164
165	!
166	!-- SALSA switches:
167	INTEGER(iwp) :: nj3 = 1 !< J3 parametrization (nucleation)
168	!< 1 = condensational sink (Kerminen&Kulmala, 2002)
169	!< 2 = coagulational sink (Lehtinen et al. 2007)
170	!< 3 = coagS+self-coagulation (Anttila et al. 2010)
171	INTEGER(iwp) :: nsnucl = 0 !< Choice of the nucleation scheme:
172	!< 0 = off
173	!< 1 = binary nucleation
174	!< 2 = activation type nucleation
175	!< 3 = kinetic nucleation
176	!< 4 = ternary nucleation
177	!< 5 = nucleation with ORGANICs
178	!< 6 = activation type of nucleation with
179	!< H2SO4+ORG
180	!< 7 = heteromolecular nucleation with H2SO4*ORG
181	!< 8 = homomolecular nucleation of H2SO4 +
182	!< heteromolecular nucleation with H2SO4*ORG
183	!< 9 = homomolecular nucleation of H2SO4 and ORG
184	!< +heteromolecular nucleation with H2SO4*ORG
185	LOGICAL :: advect_particle_water = .TRUE. !< advect water concentration of
186	!< particles
187	LOGICAL :: decycle_lr = .FALSE. !< Undo cyclic boundary
188	!< conditions: left and right
189	LOGICAL :: decycle_ns = .FALSE. !< north and south boundaries
190	LOGICAL :: feedback_to_palm = .FALSE. !< allow feedback due to
191	!< hydration and/or condensation
192	!< of H20
193	LOGICAL :: no_insoluble = .FALSE. !< Switch to exclude insoluble
194	!< chemical components
195	LOGICAL :: read_restart_data_salsa = .FALSE. !< read restart data for salsa
196	LOGICAL :: salsa = .FALSE. !< SALSA master switch
197	LOGICAL :: salsa_gases_from_chem = .FALSE. !< Transfer the gaseous
198	!< components to SALSA from
199	!< from chemistry model
200	LOGICAL :: van_der_waals_coagc = .FALSE. !< Enhancement of coagulation
201	!< kernel by van der Waals and
202	!< viscous forces
203	LOGICAL :: write_binary_salsa = .FALSE. !< read binary for salsa
204	!-- Process switches: nl* is read from the NAMELIST and is NOT changed.
205	!-- ls* is the switch used and will get the value of nl*
206	!-- except for special circumstances (spinup period etc.)
207	LOGICAL :: nlcoag = .FALSE. !< Coagulation master switch
208	LOGICAL :: lscoag = .FALSE. !<
209	LOGICAL :: nlcnd = .FALSE. !< Condensation master switch
210	LOGICAL :: lscnd = .FALSE. !<
211	LOGICAL :: nlcndgas = .FALSE. !< Condensation of precursor gases
212	LOGICAL :: lscndgas = .FALSE. !<
213	LOGICAL :: nlcndh2oae = .FALSE. !< Condensation of H2O on aerosol
214	LOGICAL :: lscndh2oae = .FALSE. !< particles (FALSE -> equilibrium calc.)
215	LOGICAL :: nldepo = .FALSE. !< Deposition master switch
216	LOGICAL :: lsdepo = .FALSE. !<
217	LOGICAL :: nldepo_topo = .FALSE. !< Deposition on vegetation master switch
218	LOGICAL :: lsdepo_topo = .FALSE. !<
219	LOGICAL :: nldepo_vege = .FALSE. !< Deposition on walls master switch
220	LOGICAL :: lsdepo_vege = .FALSE. !<
221	LOGICAL :: nldistupdate = .TRUE. !< Size distribution update master switch
222	LOGICAL :: lsdistupdate = .FALSE. !<
223	!
224	!-- SALSA variables:
225	CHARACTER (LEN=20) :: bc_salsa_b = 'neumann' !< bottom boundary condition
226	CHARACTER (LEN=20) :: bc_salsa_t = 'neumann' !< top boundary condition
227	CHARACTER (LEN=20) :: depo_vege_type = 'zhang2001' !< or 'petroff2010'
228	CHARACTER (LEN=20) :: depo_topo_type = 'zhang2001' !< or 'petroff2010'
229	CHARACTER (LEN=20), DIMENSION(4) :: decycle_method = &
230	(/'dirichlet','dirichlet','dirichlet','dirichlet'/)
231	!< Decycling method at horizontal boundaries,
232	!< 1=left, 2=right, 3=south, 4=north
233	!< dirichlet = initial size distribution and
234	!< chemical composition set for the ghost and
235	!< first three layers
236	!< neumann = zero gradient
237	CHARACTER (LEN=3), DIMENSION(maxspec) :: listspec = & !< Active aerosols
238	(/'SO4',' ',' ',' ',' ',' ',' '/)
239	CHARACTER (LEN=20) :: salsa_source_mode = 'no_source'
240	!< 'read_from_file',
241	!< 'constant' or 'no_source'
242	INTEGER(iwp) :: dots_salsa = 0 !< starting index for salsa-timeseries
243	INTEGER(iwp) :: fn1a = 1 !< last index for bin subranges: subrange 1a
244	INTEGER(iwp) :: fn2a = 1 !< subrange 2a
245	INTEGER(iwp) :: fn2b = 1 !< subrange 2b
246	INTEGER(iwp), DIMENSION(ngast) :: gas_index_chem = (/ 1, 1, 1, 1, 1/) !<
247	!< Index of gaseous compounds in the chemistry
248	!< model. In SALSA, 1 = H2SO4, 2 = HNO3,
249	!< 3 = NH3, 4 = OCNV, 5 = OCSV
250	INTEGER(iwp) :: ibc_salsa_b !<
251	INTEGER(iwp) :: ibc_salsa_t !<
252	INTEGER(iwp) :: igctyp = 0 !< Initial gas concentration type
253	!< 0 = uniform (use H2SO4_init, HNO3_init,
254	!< NH3_init, OCNV_init and OCSV_init)
255	!< 1 = read vertical profile from an input file
256	INTEGER(iwp) :: in1a = 1 !< start index for bin subranges: subrange 1a
257	INTEGER(iwp) :: in2a = 1 !< subrange 2a
258	INTEGER(iwp) :: in2b = 1 !< subrange 2b
259	INTEGER(iwp) :: isdtyp = 0 !< Initial size distribution type
260	!< 0 = uniform
261	!< 1 = read vertical profile of the mode number
262	!< concentration from an input file
263	INTEGER(iwp) :: ibc = -1 !< Indice for: black carbon (BC)
264	INTEGER(iwp) :: idu = -1 !< dust
265	INTEGER(iwp) :: inh = -1 !< NH3
266	INTEGER(iwp) :: ino = -1 !< HNO3
267	INTEGER(iwp) :: ioc = -1 !< organic carbon (OC)
268	INTEGER(iwp) :: iso4 = -1 !< SO4 or H2SO4
269	INTEGER(iwp) :: iss = -1 !< sea salt
270	INTEGER(iwp) :: lod_aero = 0 !< level of detail for aerosol emissions
271	INTEGER(iwp) :: lod_gases = 0 !< level of detail for gaseous emissions
272	INTEGER(iwp), DIMENSION(nreg) :: nbin = (/ 3, 7/) !< Number of size bins
273	!< for each aerosol size subrange
274	INTEGER(iwp) :: nbins = 1 !< total number of size bins
275	INTEGER(iwp) :: ncc = 1 !< number of chemical components used
276	INTEGER(iwp) :: ncc_tot = 1!< total number of chemical compounds (ncc+1
277	!< if particle water is advected)
278	REAL(wp) :: act_coeff = 1.0E-7_wp !< Activation coefficient
279	REAL(wp) :: aerosol_source = 0.0_wp !< Constant aerosol flux (#/(m3*s))
280	REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: emission_mass_fracs !< array for
281	!< aerosol composition per emission category
282	!< 1:SO4 2:OC 3:BC 4:DU 5:SS 6:NO 7:NH
283	REAL(wp) :: dt_salsa = 0.00001_wp !< Time step of SALSA
284	REAL(wp) :: H2SO4_init = nclim !< Init value for sulphuric acid gas
285	REAL(wp) :: HNO3_init = nclim !< Init value for nitric acid gas
286	REAL(wp) :: last_salsa_time = 0.0_wp !< time of the previous salsa
287	!< timestep
288	REAL(wp) :: nf2a = 1.0_wp !< Number fraction allocated to a-
289	!< bins in subrange 2
290	!< (b-bins will get 1-nf2a)
291	REAL(wp) :: NH3_init = nclim !< Init value for ammonia gas
292	REAL(wp) :: OCNV_init = nclim !< Init value for non-volatile
293	!< organic gases
294	REAL(wp) :: OCSV_init = nclim !< Init value for semi-volatile
295	!< organic gases
296	REAL(wp), DIMENSION(nreg+1) :: reglim = & !< Min&max diameters of size subranges
297	(/ 3.0E-9_wp, 5.0E-8_wp, 1.0E-5_wp/)
298	REAL(wp) :: rhlim = 1.20_wp !< RH limit in %/100. Prevents
299	!< unrealistically high RH in condensation
300	REAL(wp) :: skip_time_do_salsa = 0.0_wp !< Starting time of SALSA (s)
301	!-- Initial log-normal size distribution: mode diameter (dpg, micrometres),
302	!-- standard deviation (sigmag) and concentration (n_lognorm, #/cm3)
303	REAL(wp), DIMENSION(nmod) :: dpg = (/0.013_wp, 0.054_wp, 0.86_wp, &
304	0.2_wp, 0.2_wp, 0.2_wp, 0.2_wp/)
305	REAL(wp), DIMENSION(nmod) :: sigmag = (/1.8_wp, 2.16_wp, 2.21_wp, &
306	2.0_wp, 2.0_wp, 2.0_wp, 2.0_wp/)
307	REAL(wp), DIMENSION(nmod) :: n_lognorm = (/1.04e+5_wp, 3.23E+4_wp, 5.4_wp,&
308	0.0_wp, 0.0_wp, 0.0_wp, 0.0_wp/)
309	!-- Initial mass fractions / chemical composition of the size distribution
310	REAL(wp), DIMENSION(maxspec) :: mass_fracs_a = & !< mass fractions between
311	(/1.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0/) !< aerosol species for A bins
312	REAL(wp), DIMENSION(maxspec) :: mass_fracs_b = & !< mass fractions between
313	(/0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0/) !< aerosol species for B bins
314
315	REAL(wp), ALLOCATABLE, DIMENSION(:) :: bin_low_limits !< to deliver
316	!< information about
317	!< the lower
318	!< diameters per bin
319	REAL(wp), ALLOCATABLE, DIMENSION(:) :: nsect !< Background number
320	!< concentration per bin
321	REAL(wp), ALLOCATABLE, DIMENSION(:) :: massacc !< Mass accomodation
322	!< coefficients per bin
323	!
324	!-- SALSA derived datatypes:
325	!
326	!-- Prognostic variable: Aerosol size bin information (number (#/m3) and
327	!-- mass (kg/m3) concentration) and the concentration of gaseous tracers (#/m3).
328	!-- Gas tracers are contained sequentially in dimension 4 as:
329	!-- 1. H2SO4, 2. HNO3, 3. NH3, 4. OCNV (non-volatile organics),
330	!-- 5. OCSV (semi-volatile)
331	TYPE salsa_variable
332	REAL(wp), POINTER, DIMENSION(:,:,:), CONTIGUOUS :: conc
333	REAL(wp), POINTER, DIMENSION(:,:,:), CONTIGUOUS :: conc_p
334	REAL(wp), POINTER, DIMENSION(:,:,:), CONTIGUOUS :: tconc_m
335	REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: flux_s, diss_s
336	REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: flux_l, diss_l
337	REAL(wp), ALLOCATABLE, DIMENSION(:) :: init
338	REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: source
339	REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: sums_ws_l
340	END TYPE salsa_variable
341
342	!-- Map bin indices between parallel size distributions
343	TYPE t_parallelbin
344	INTEGER(iwp) :: cur ! Index for current distribution
345	INTEGER(iwp) :: par ! Index for corresponding parallel distribution
346	END TYPE t_parallelbin
347
348	!-- Datatype used to store information about the binned size distributions of
349	!-- aerosols
350	TYPE t_section
351	REAL(wp) :: vhilim !< bin volume at the high limit
352	REAL(wp) :: vlolim !< bin volume at the low limit
353	REAL(wp) :: vratiohi !< volume ratio between the center and high limit
354	REAL(wp) :: vratiolo !< volume ratio between the center and low limit
355	REAL(wp) :: dmid !< bin middle diameter (m)
356	!******************************************************
357	! ^ Do NOT change the stuff above after initialization !
358	!******************************************************
359	REAL(wp) :: dwet !< Wet diameter or mean droplet diameter (m)
360	REAL(wp), DIMENSION(maxspec+1) :: volc !< Volume concentrations
361	!< (m^3/m^3) of aerosols + water. Since most of
362	!< the stuff in SALSA is hard coded, these *have to
363	!< be* in the order
364	!< 1:SO4, 2:OC, 3:BC, 4:DU, 5:SS, 6:NO, 7:NH, 8:H2O
365	REAL(wp) :: veqh2o !< Equilibrium H2O concentration for each particle
366	REAL(wp) :: numc !< Number concentration of particles/droplets (#/m3)
367	REAL(wp) :: core !< Volume of dry particle
368	END TYPE t_section
369	!
370	!-- Local aerosol properties in SALSA
371	TYPE(t_section), ALLOCATABLE :: aero(:)
372	!
373	!-- SALSA tracers:
374	!-- Tracers as x = x(k,j,i,bin). The 4th dimension contains all the size bins
375	!-- sequentially for each aerosol species + water.
376	!
377	!-- Prognostic tracers:
378	!
379	!-- Number concentration (#/m3)
380	TYPE(salsa_variable), ALLOCATABLE, DIMENSION(:), TARGET :: aerosol_number
381	REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:), TARGET :: nconc_1
382	REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:), TARGET :: nconc_2
383	REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:), TARGET :: nconc_3
384	!
385	!-- Mass concentration (kg/m3)
386	TYPE(salsa_variable), ALLOCATABLE, DIMENSION(:), TARGET :: aerosol_mass
387	REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:), TARGET :: mconc_1
388	REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:), TARGET :: mconc_2
389	REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:), TARGET :: mconc_3
390	!
391	!-- Gaseous tracers (#/m3)
392	TYPE(salsa_variable), ALLOCATABLE, DIMENSION(:), TARGET :: salsa_gas
393	REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:), TARGET :: gconc_1
394	REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:), TARGET :: gconc_2
395	REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:), TARGET :: gconc_3
396	!
397	!-- Diagnostic tracers
398	REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:) :: sedim_vd !< sedimentation
399	!< velocity per size
400	!< bin (m/s)
401	REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:) :: Ra_dry !< dry radius (m)
402
403	!-- Particle component index tables
404	TYPE(component_index) :: prtcl !< Contains "getIndex" which gives the index
405	!< for a given aerosol component name, i.e.
406	!< 1:SO4, 2:OC, 3:BC, 4:DU,
407	!< 5:SS, 6:NO, 7:NH, 8:H2O
408	!
409	!-- Data output arrays:
410	!-- Gases:
411	REAL(wp), ALLOCATABLE, DIMENSION(:,:,:), TARGET :: g_H2SO4_av !< H2SO4
412	REAL(wp), ALLOCATABLE, DIMENSION(:,:,:), TARGET :: g_HNO3_av !< HNO3
413	REAL(wp), ALLOCATABLE, DIMENSION(:,:,:), TARGET :: g_NH3_av !< NH3
414	REAL(wp), ALLOCATABLE, DIMENSION(:,:,:), TARGET :: g_OCNV_av !< non-vola-
415	!< tile OC
416	REAL(wp), ALLOCATABLE, DIMENSION(:,:,:), TARGET :: g_OCSV_av !< semi-vol.
417	!< OC
418	!-- Integrated:
419	REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: LDSA_av !< lung deposited
420	!< surface area
421	REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: Ntot_av !< total number conc.
422	REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: PM25_av !< PM2.5
423	REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: PM10_av !< PM10
424	!-- In the particle phase:
425	REAL(wp), ALLOCATABLE, DIMENSION(:,:,:), TARGET :: s_BC_av !< black carbon
426	REAL(wp), ALLOCATABLE, DIMENSION(:,:,:), TARGET :: s_DU_av !< dust
427	REAL(wp), ALLOCATABLE, DIMENSION(:,:,:), TARGET :: s_H2O_av !< liquid water
428	REAL(wp), ALLOCATABLE, DIMENSION(:,:,:), TARGET :: s_NH_av !< ammonia
429	REAL(wp), ALLOCATABLE, DIMENSION(:,:,:), TARGET :: s_NO_av !< nitrates
430	REAL(wp), ALLOCATABLE, DIMENSION(:,:,:), TARGET :: s_OC_av !< org. carbon
431	REAL(wp), ALLOCATABLE, DIMENSION(:,:,:), TARGET :: s_SO4_av !< sulphates
432	REAL(wp), ALLOCATABLE, DIMENSION(:,:,:), TARGET :: s_SS_av !< sea salt
433	!-- Bins:
434	REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:) :: mbins_av !< bin mass
435	!< concentration
436	REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:) :: Nbins_av !< bin number
437	!< concentration
438
439	!
440	!-- PALM interfaces:
441	!
442	!-- Boundary conditions:
443	INTERFACE salsa_boundary_conds
444	MODULE PROCEDURE salsa_boundary_conds
445	MODULE PROCEDURE salsa_boundary_conds_decycle
446	END INTERFACE salsa_boundary_conds
447	!
448	!-- Data output checks for 2D/3D data to be done in check_parameters
449	INTERFACE salsa_check_data_output
450	MODULE PROCEDURE salsa_check_data_output
451	END INTERFACE salsa_check_data_output
452
453	!
454	!-- Input parameter checks to be done in check_parameters
455	INTERFACE salsa_check_parameters
456	MODULE PROCEDURE salsa_check_parameters
457	END INTERFACE salsa_check_parameters
458
459	!
460	!-- Averaging of 3D data for output
461	INTERFACE salsa_3d_data_averaging
462	MODULE PROCEDURE salsa_3d_data_averaging
463	END INTERFACE salsa_3d_data_averaging
464
465	!
466	!-- Data output of 2D quantities
467	INTERFACE salsa_data_output_2d
468	MODULE PROCEDURE salsa_data_output_2d
469	END INTERFACE salsa_data_output_2d
470
471	!
472	!-- Data output of 3D data
473	INTERFACE salsa_data_output_3d
474	MODULE PROCEDURE salsa_data_output_3d
475	END INTERFACE salsa_data_output_3d
476
477	!
478	!-- Data output of 3D data
479	INTERFACE salsa_data_output_mask
480	MODULE PROCEDURE salsa_data_output_mask
481	END INTERFACE salsa_data_output_mask
482
483	!
484	!-- Definition of data output quantities
485	INTERFACE salsa_define_netcdf_grid
486	MODULE PROCEDURE salsa_define_netcdf_grid
487	END INTERFACE salsa_define_netcdf_grid
488
489	!
490	!-- Output of information to the header file
491	INTERFACE salsa_header
492	MODULE PROCEDURE salsa_header
493	END INTERFACE salsa_header
494
495	!
496	!-- Initialization actions
497	INTERFACE salsa_init
498	MODULE PROCEDURE salsa_init
499	END INTERFACE salsa_init
500
501	!
502	!-- Initialization of arrays
503	INTERFACE salsa_init_arrays
504	MODULE PROCEDURE salsa_init_arrays
505	END INTERFACE salsa_init_arrays
506
507	!
508	!-- Writing of binary output for restart runs !!! renaming?!
509	INTERFACE salsa_wrd_local
510	MODULE PROCEDURE salsa_wrd_local
511	END INTERFACE salsa_wrd_local
512
513	!
514	!-- Reading of NAMELIST parameters
515	INTERFACE salsa_parin
516	MODULE PROCEDURE salsa_parin
517	END INTERFACE salsa_parin
518
519	!
520	!-- Reading of parameters for restart runs
521	INTERFACE salsa_rrd_local
522	MODULE PROCEDURE salsa_rrd_local
523	END INTERFACE salsa_rrd_local
524
525	!
526	!-- Swapping of time levels (required for prognostic variables)
527	INTERFACE salsa_swap_timelevel
528	MODULE PROCEDURE salsa_swap_timelevel
529	END INTERFACE salsa_swap_timelevel
530
531	INTERFACE salsa_driver
532	MODULE PROCEDURE salsa_driver
533	END INTERFACE salsa_driver
534
535	INTERFACE salsa_tendency
536	MODULE PROCEDURE salsa_tendency
537	MODULE PROCEDURE salsa_tendency_ij
538	END INTERFACE salsa_tendency
539
540
541
542	SAVE
543
544	PRIVATE
545	!
546	!-- Public functions:
547	PUBLIC salsa_boundary_conds, salsa_check_data_output, &
548	salsa_check_parameters, salsa_3d_data_averaging, &
549	salsa_data_output_2d, salsa_data_output_3d, salsa_data_output_mask, &
550	salsa_define_netcdf_grid, salsa_diagnostics, salsa_driver, &
551	salsa_header, salsa_init, salsa_init_arrays, salsa_parin, &
552	salsa_rrd_local, salsa_swap_timelevel, salsa_tendency, &
553	salsa_wrd_local
554	!
555	!-- Public parameters, constants and initial values
556	PUBLIC dots_salsa, dt_salsa, last_salsa_time, lsdepo, salsa, &
557	salsa_gases_from_chem, skip_time_do_salsa
558	!
559	!-- Public prognostic variables
560	PUBLIC aerosol_mass, aerosol_number, fn2a, fn2b, gconc_2, in1a, in2b, &
561	mconc_2, nbins, ncc, ncc_tot, nclim, nconc_2, ngast, prtcl, Ra_dry, &
562	salsa_gas, sedim_vd
563
564	CONTAINS
565
566	!------------------------------------------------------------------------------!
567	! Description:
568	! ------------
569	!> Parin for &salsa_par for new modules
570	!------------------------------------------------------------------------------!
571	SUBROUTINE salsa_parin
572
573	IMPLICIT NONE
574
575	CHARACTER (LEN=80) :: line !< dummy string that contains the current line
576	!< of the parameter file
577
578	NAMELIST /salsa_parameters/ &
579	advect_particle_water, & ! Switch for advecting
580	! particle water. If .FALSE.,
581	! equilibration is called at
582	! each time step.
583	bc_salsa_b, & ! bottom boundary condition
584	bc_salsa_t, & ! top boundary condition
585	decycle_lr, & ! decycle SALSA components
586	decycle_method, & ! decycle method applied:
587	! 1=left 2=right 3=south 4=north
588	decycle_ns, & ! decycle SALSA components
589	depo_vege_type, & ! Parametrisation type
590	depo_topo_type, & ! Parametrisation type
591	dpg, & ! Mean diameter for the initial
592	! log-normal modes
593	dt_salsa, & ! SALSA timestep in seconds
594	feedback_to_palm, & ! allow feedback due to
595	! hydration / condensation
596	H2SO4_init, & ! Init value for sulphuric acid
597	HNO3_init, & ! Init value for nitric acid
598	igctyp, & ! Initial gas concentration type
599	isdtyp, & ! Initial size distribution type
600	listspec, & ! List of actived aerosols
601	! (string list)
602	mass_fracs_a, & ! Initial relative contribution
603	! of each species to particle
604	! volume in a-bins, 0 for unused
605	mass_fracs_b, & ! Initial relative contribution
606	! of each species to particle
607	! volume in b-bins, 0 for unused
608	n_lognorm, & ! Number concentration for the
609	! log-normal modes
610	nbin, & ! Number of size bins for
611	! aerosol size subranges 1 & 2
612	nf2a, & ! Number fraction of particles
613	! allocated to a-bins in
614	! subrange 2 b-bins will get
615	! 1-nf2a
616	NH3_init, & ! Init value for ammonia
617	nj3, & ! J3 parametrization
618	! 1 = condensational sink
619	! (Kerminen&Kulmala, 2002)
620	! 2 = coagulational sink
621	! (Lehtinen et al. 2007)
622	! 3 = coagS+self-coagulation
623	! (Anttila et al. 2010)
624	nlcnd, & ! Condensation master switch
625	nlcndgas, & ! Condensation of gases
626	nlcndh2oae, & ! Condensation of H2O
627	nlcoag, & ! Coagulation master switch
628	nldepo, & ! Deposition master switch
629	nldepo_vege, & ! Deposition on vegetation
630	! master switch
631	nldepo_topo, & ! Deposition on topo master
632	! switch
633	nldistupdate, & ! Size distribution update
634	! master switch
635	nsnucl, & ! Nucleation scheme:
636	! 0 = off,
637	! 1 = binary nucleation
638	! 2 = activation type nucleation
639	! 3 = kinetic nucleation
640	! 4 = ternary nucleation
641	! 5 = nucleation with organics
642	! 6 = activation type of
643	! nucleation with H2SO4+ORG
644	! 7 = heteromolecular nucleation
645	! with H2SO4*ORG
646	! 8 = homomolecular nucleation
647	! of H2SO4 + heteromolecular
648	! nucleation with H2SO4*ORG
649	! 9 = homomolecular nucleation
650	! of H2SO4 and ORG + hetero-
651	! molecular nucleation with
652	! H2SO4*ORG
653	OCNV_init, & ! Init value for non-volatile
654	! organic gases
655	OCSV_init, & ! Init value for semi-volatile
656	! organic gases
657	read_restart_data_salsa, & ! read restart data for
658	! salsa
659	reglim, & ! Min&max diameter limits of
660	! size subranges
661	salsa, & ! Master switch for SALSA
662	salsa_source_mode,& ! 'read_from_file' or 'constant'
663	! or 'no_source'
664	sigmag, & ! stdev for the initial log-
665	! normal modes
666	skip_time_do_salsa, & ! Starting time of SALSA (s)
667	van_der_waals_coagc,& ! include van der Waals forces
668	write_binary_salsa ! Write binary for salsa
669
670
671	line = ' '
672
673	!
674	!-- Try to find salsa package
675	REWIND ( 11 )
676	line = ' '
677	DO WHILE ( INDEX( line, '&salsa_parameters' ) == 0 )
678	READ ( 11, '(A)', END=10 ) line
679	ENDDO
680	BACKSPACE ( 11 )
681
682	!
683	!-- Read user-defined namelist
684	READ ( 11, salsa_parameters )
685
686	!
687	!-- Set flag that indicates that the new module is switched on
688	!-- Note that this parameter needs to be declared in modules.f90
689	salsa = .TRUE.
690
691	10 CONTINUE
692
693	END SUBROUTINE salsa_parin
694
695
696	!------------------------------------------------------------------------------!
697	! Description:
698	! ------------
699	!> Check parameters routine for salsa.
700	!------------------------------------------------------------------------------!
701	SUBROUTINE salsa_check_parameters
702
703	USE control_parameters, &
704	ONLY: message_string
705
706	IMPLICIT NONE
707
708	!
709	!-- Checks go here (cf. check_parameters.f90).
710	IF ( salsa .AND. .NOT. humidity ) THEN
711	WRITE( message_string, * ) 'salsa = ', salsa, ' is ', &
712	'not allowed with humidity = ', humidity
713	CALL message( 'check_parameters', 'SA0009', 1, 2, 0, 6, 0 )
714	ENDIF
715
716	IF ( bc_salsa_b == 'dirichlet' ) THEN
717	ibc_salsa_b = 0
718	ELSEIF ( bc_salsa_b == 'neumann' ) THEN
719	ibc_salsa_b = 1
720	ELSE
721	message_string = 'unknown boundary condition: bc_salsa_b = "' &
722	// TRIM( bc_salsa_t ) // '"'
723	CALL message( 'check_parameters', 'SA0011', 1, 2, 0, 6, 0 )
724	ENDIF
725
726	IF ( bc_salsa_t == 'dirichlet' ) THEN
727	ibc_salsa_t = 0
728	ELSEIF ( bc_salsa_t == 'neumann' ) THEN
729	ibc_salsa_t = 1
730	ELSE
731	message_string = 'unknown boundary condition: bc_salsa_t = "' &
732	// TRIM( bc_salsa_t ) // '"'
733	CALL message( 'check_parameters', 'SA0012', 1, 2, 0, 6, 0 )
734	ENDIF
735
736	IF ( nj3 < 1 .OR. nj3 > 3 ) THEN
737	message_string = 'unknown nj3 (must be 1-3)'
738	CALL message( 'check_parameters', 'SA0044', 1, 2, 0, 6, 0 )
739	ENDIF
740
741	END SUBROUTINE salsa_check_parameters
742
743	!------------------------------------------------------------------------------!
744	!
745	! Description:
746	! ------------
747	!> Subroutine defining appropriate grid for netcdf variables.
748	!> It is called out from subroutine netcdf.
749	!> Same grid as for other scalars (see netcdf_interface_mod.f90)
750	!------------------------------------------------------------------------------!
751	SUBROUTINE salsa_define_netcdf_grid( var, found, grid_x, grid_y, grid_z )
752
753	IMPLICIT NONE
754
755	CHARACTER (LEN=*), INTENT(OUT) :: grid_x !<
756	CHARACTER (LEN=*), INTENT(OUT) :: grid_y !<
757	CHARACTER (LEN=*), INTENT(OUT) :: grid_z !<
758	CHARACTER (LEN=*), INTENT(IN) :: var !<
759
760	LOGICAL, INTENT(OUT) :: found !<
761
762	found = .TRUE.
763	!
764	!-- Check for the grid
765
766	IF ( var(1:2) == 'g_' ) THEN
767	grid_x = 'x'
768	grid_y = 'y'
769	grid_z = 'zu'
770	ELSEIF ( var(1:4) == 'LDSA' ) THEN
771	grid_x = 'x'
772	grid_y = 'y'
773	grid_z = 'zu'
774	ELSEIF ( var(1:5) == 'm_bin' ) THEN
775	grid_x = 'x'
776	grid_y = 'y'
777	grid_z = 'zu'
778	ELSEIF ( var(1:5) == 'N_bin' ) THEN
779	grid_x = 'x'
780	grid_y = 'y'
781	grid_z = 'zu'
782	ELSEIF ( var(1:4) == 'Ntot' ) THEN
783	grid_x = 'x'
784	grid_y = 'y'
785	grid_z = 'zu'
786	ELSEIF ( var(1:2) == 'PM' ) THEN
787	grid_x = 'x'
788	grid_y = 'y'
789	grid_z = 'zu'
790	ELSEIF ( var(1:2) == 's_' ) THEN
791	grid_x = 'x'
792	grid_y = 'y'
793	grid_z = 'zu'
794	ELSE
795	found = .FALSE.
796	grid_x = 'none'
797	grid_y = 'none'
798	grid_z = 'none'
799	ENDIF
800
801	END SUBROUTINE salsa_define_netcdf_grid
802
803
804	!------------------------------------------------------------------------------!
805	! Description:
806	! ------------
807	!> Header output for new module
808	!------------------------------------------------------------------------------!
809	SUBROUTINE salsa_header( io )
810
811	IMPLICIT NONE
812
813	INTEGER(iwp), INTENT(IN) :: io !< Unit of the output file
814	!
815	!-- Write SALSA header
816	WRITE( io, 1 )
817	WRITE( io, 2 ) skip_time_do_salsa
818	WRITE( io, 3 ) dt_salsa
819	WRITE( io, 12 ) SHAPE( aerosol_number(1)%conc ), nbins
820	IF ( advect_particle_water ) THEN
821	WRITE( io, 16 ) SHAPE( aerosol_mass(1)%conc ), ncc_tot*nbins, &
822	advect_particle_water
823	ELSE
824	WRITE( io, 16 ) SHAPE( aerosol_mass(1)%conc ), ncc*nbins, &
825	advect_particle_water
826	ENDIF
827	IF ( .NOT. salsa_gases_from_chem ) THEN
828	WRITE( io, 17 ) SHAPE( aerosol_mass(1)%conc ), ngast, &
829	salsa_gases_from_chem
830	ENDIF
831	WRITE( io, 4 )
832	IF ( nsnucl > 0 ) THEN
833	WRITE( io, 5 ) nsnucl, nj3
834	ENDIF
835	IF ( nlcoag ) THEN
836	WRITE( io, 6 )
837	ENDIF
838	IF ( nlcnd ) THEN
839	WRITE( io, 7 ) nlcndgas, nlcndh2oae
840	ENDIF
841	IF ( nldepo ) THEN
842	WRITE( io, 14 ) nldepo_vege, nldepo_topo
843	ENDIF
844	WRITE( io, 8 ) reglim, nbin, bin_low_limits
845	WRITE( io, 15 ) nsect
846	WRITE( io, 13 ) ncc, listspec, mass_fracs_a, mass_fracs_b
847	IF ( .NOT. salsa_gases_from_chem ) THEN
848	WRITE( io, 18 ) ngast, H2SO4_init, HNO3_init, NH3_init, OCNV_init, &
849	OCSV_init
850	ENDIF
851	WRITE( io, 9 ) isdtyp, igctyp
852	IF ( isdtyp == 0 ) THEN
853	WRITE( io, 10 ) dpg, sigmag, n_lognorm
854	ELSE
855	WRITE( io, 11 )
856	ENDIF
857
858
859	1 FORMAT (//' SALSA information:'/ &
860	' ------------------------------'/)
861	2 FORMAT (' Starts at: skip_time_do_salsa = ', F10.2, ' s')
862	3 FORMAT (/' Timestep: dt_salsa = ', F6.2, ' s')
863	12 FORMAT (/' Array shape (z,y,x,bins):'/ &
864	' aerosol_number: ', 4(I3))
865	16 FORMAT (/' aerosol_mass: ', 4(I3),/ &
866	' (advect_particle_water = ', L1, ')')
867	17 FORMAT (' salsa_gas: ', 4(I3),/ &
868	' (salsa_gases_from_chem = ', L1, ')')
869	4 FORMAT (/' Aerosol dynamic processes included: ')
870	5 FORMAT (/' nucleation (scheme = ', I1, ' and J3 parametrization = ',&
871	I1, ')')
872	6 FORMAT (/' coagulation')
873	7 FORMAT (/' condensation (of precursor gases = ', L1, &
874	' and water vapour = ', L1, ')' )
875	14 FORMAT (/' dry deposition (on vegetation = ', L1, &
876	' and on topography = ', L1, ')')
877	8 FORMAT (/' Aerosol bin subrange limits (in metres): ', 3(ES10.2E3) / &
878	' Number of size bins for each aerosol subrange: ', 2I3,/ &
879	' Aerosol bin limits (in metres): ', *(ES10.2E3))
880	15 FORMAT (' Initial number concentration in bins at the lowest level', &
881	' (#/m*3):', (ES10.2E3))
882	13 FORMAT (/' Number of chemical components used: ', I1,/ &
883	' Species: ',7(A6),/ &
884	' Initial relative contribution of each species to particle', &
885	' volume in:',/ &
886	' a-bins: ', 7(F6.3),/ &
887	' b-bins: ', 7(F6.3))
888	18 FORMAT (/' Number of gaseous tracers used: ', I1,/ &
889	' Initial gas concentrations:',/ &
890	' H2SO4: ',ES12.4E3, ' #/m**3',/ &
891	' HNO3: ',ES12.4E3, ' #/m**3',/ &
892	' NH3: ',ES12.4E3, ' #/m**3',/ &
893	' OCNV: ',ES12.4E3, ' #/m**3',/ &
894	' OCSV: ',ES12.4E3, ' #/m**3')
895	9 FORMAT (/' Initialising concentrations: ', / &
896	' Aerosol size distribution: isdtyp = ', I1,/ &
897	' Gas concentrations: igctyp = ', I1 )
898	10 FORMAT ( ' Mode diametres: dpg(nmod) = ', 7(F7.3),/ &
899	' Standard deviation: sigmag(nmod) = ', 7(F7.2),/ &
900	' Number concentration: n_lognorm(nmod) = ', 7(ES12.4E3) )
901	11 FORMAT (/' Size distribution read from a file.')
902
903	END SUBROUTINE salsa_header
904
905	!------------------------------------------------------------------------------!
906	! Description:
907	! ------------
908	!> Allocate SALSA arrays and define pointers if required
909	!------------------------------------------------------------------------------!
910	SUBROUTINE salsa_init_arrays
911
912	USE surface_mod, &
913	ONLY: surf_def_h, surf_def_v, surf_lsm_h, surf_lsm_v, surf_usm_h, &
914	surf_usm_v
915
916	IMPLICIT NONE
917
918	INTEGER(iwp) :: gases_available !< Number of available gas components in
919	!< the chemistry model
920	INTEGER(iwp) :: i !< loop index for allocating
921	INTEGER(iwp) :: l !< loop index for allocating: surfaces
922	INTEGER(iwp) :: lsp !< loop index for chem species in the chemistry model
923
924	gases_available = 0
925
926	!
927	!-- Allocate prognostic variables (see salsa_swap_timelevel)
928	#if defined( __nopointer )
929	message_string = 'SALSA runs only with POINTER Version'
930	CALL message( 'salsa_mod: salsa_init_arrays', 'SA0023', 1, 2, 0, 6, 0 )
931	#else
932	!
933	!-- Set derived indices:
934	!-- (This does the same as the subroutine salsa_initialize in SALSA/
935	!-- UCLALES-SALSA)
936	in1a = 1 ! 1st index of subrange 1a
937	in2a = in1a + nbin(1) ! 1st index of subrange 2a
938	fn1a = in2a - 1 ! last index of subrange 1a
939	fn2a = fn1a + nbin(2) ! last index of subrange 2a
940
941	!
942	!-- If the fraction of insoluble aerosols in subrange 2 is zero: do not allocate
943	!-- arrays for them
944	IF ( nf2a > 0.999999_wp .AND. SUM( mass_fracs_b ) < 0.00001_wp ) THEN
945	no_insoluble = .TRUE.
946	in2b = fn2a+1 ! 1st index of subrange 2b
947	fn2b = fn2a ! last index of subrange 2b
948	ELSE
949	in2b = in2a + nbin(2) ! 1st index of subrange 2b
950	fn2b = fn2a + nbin(2) ! last index of subrange 2b
951	ENDIF
952
953
954	nbins = fn2b ! total number of aerosol size bins
955	!
956	!-- Create index tables for different aerosol components
957	CALL component_index_constructor( prtcl, ncc, maxspec, listspec )
958
959	ncc_tot = ncc
960	IF ( advect_particle_water ) ncc_tot = ncc + 1 ! Add water
961
962	!
963	!-- Allocate:
964	ALLOCATE( aero(nbins), bin_low_limits(nbins), nsect(nbins), massacc(nbins) )
965	IF ( nldepo ) ALLOCATE( sedim_vd(nzb:nzt+1,nysg:nyng,nxlg:nxrg,nbins) )
966	ALLOCATE( Ra_dry(nzb:nzt+1,nysg:nyng,nxlg:nxrg,nbins) )
967
968	!
969	!-- Aerosol number concentration
970	ALLOCATE( aerosol_number(nbins) )
971	ALLOCATE( nconc_1(nzb:nzt+1,nysg:nyng,nxlg:nxrg,nbins), &
972	nconc_2(nzb:nzt+1,nysg:nyng,nxlg:nxrg,nbins), &
973	nconc_3(nzb:nzt+1,nysg:nyng,nxlg:nxrg,nbins) )
974	nconc_1 = 0.0_wp
975	nconc_2 = 0.0_wp
976	nconc_3 = 0.0_wp
977
978	DO i = 1, nbins
979	aerosol_number(i)%conc(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => nconc_1(:,:,:,i)
980	aerosol_number(i)%conc_p(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => nconc_2(:,:,:,i)
981	aerosol_number(i)%tconc_m(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => nconc_3(:,:,:,i)
982	ALLOCATE( aerosol_number(i)%flux_s(nzb+1:nzt,0:threads_per_task-1), &
983	aerosol_number(i)%diss_s(nzb+1:nzt,0:threads_per_task-1), &
984	aerosol_number(i)%flux_l(nzb+1:nzt,nys:nyn,0:threads_per_task-1),&
985	aerosol_number(i)%diss_l(nzb+1:nzt,nys:nyn,0:threads_per_task-1),&
986	aerosol_number(i)%init(nzb:nzt+1), &
987	aerosol_number(i)%sums_ws_l(nzb:nzt+1,0:threads_per_task-1) )
988	ENDDO
989
990	!
991	!-- Aerosol mass concentration
992	ALLOCATE( aerosol_mass(ncc_tot*nbins) )
993	ALLOCATE( mconc_1(nzb:nzt+1,nysg:nyng,nxlg:nxrg,ncc_tot*nbins), &
994	mconc_2(nzb:nzt+1,nysg:nyng,nxlg:nxrg,ncc_tot*nbins), &
995	mconc_3(nzb:nzt+1,nysg:nyng,nxlg:nxrg,ncc_tot*nbins) )
996	mconc_1 = 0.0_wp
997	mconc_2 = 0.0_wp
998	mconc_3 = 0.0_wp
999
1000	DO i = 1, ncc_tot*nbins
1001	aerosol_mass(i)%conc(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => mconc_1(:,:,:,i)
1002	aerosol_mass(i)%conc_p(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => mconc_2(:,:,:,i)
1003	aerosol_mass(i)%tconc_m(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => mconc_3(:,:,:,i)
1004	ALLOCATE( aerosol_mass(i)%flux_s(nzb+1:nzt,0:threads_per_task-1), &
1005	aerosol_mass(i)%diss_s(nzb+1:nzt,0:threads_per_task-1), &
1006	aerosol_mass(i)%flux_l(nzb+1:nzt,nys:nyn,0:threads_per_task-1),&
1007	aerosol_mass(i)%diss_l(nzb+1:nzt,nys:nyn,0:threads_per_task-1),&
1008	aerosol_mass(i)%init(nzb:nzt+1), &
1009	aerosol_mass(i)%sums_ws_l(nzb:nzt+1,0:threads_per_task-1) )
1010	ENDDO
1011
1012	!
1013	!-- Surface fluxes: answs = aerosol number, amsws = aerosol mass
1014	!
1015	!-- Horizontal surfaces: default type
1016	DO l = 0, 2 ! upward (l=0), downward (l=1) and model top (l=2)
1017	ALLOCATE( surf_def_h(l)%answs( 1:surf_def_h(l)%ns, nbins ) )
1018	ALLOCATE( surf_def_h(l)%amsws( 1:surf_def_h(l)%ns, nbins*ncc_tot ) )
1019	surf_def_h(l)%answs = 0.0_wp
1020	surf_def_h(l)%amsws = 0.0_wp
1021	ENDDO
1022	!-- Horizontal surfaces: natural type
1023	IF ( land_surface ) THEN
1024	ALLOCATE( surf_lsm_h%answs( 1:surf_lsm_h%ns, nbins ) )
1025	ALLOCATE( surf_lsm_h%amsws( 1:surf_lsm_h%ns, nbins*ncc_tot ) )
1026	surf_lsm_h%answs = 0.0_wp
1027	surf_lsm_h%amsws = 0.0_wp
1028	ENDIF
1029	!-- Horizontal surfaces: urban type
1030	IF ( urban_surface ) THEN
1031	ALLOCATE( surf_usm_h%answs( 1:surf_usm_h%ns, nbins ) )
1032	ALLOCATE( surf_usm_h%amsws( 1:surf_usm_h%ns, nbins*ncc_tot ) )
1033	surf_usm_h%answs = 0.0_wp
1034	surf_usm_h%amsws = 0.0_wp
1035	ENDIF
1036	!
1037	!-- Vertical surfaces: northward (l=0), southward (l=1), eastward (l=2) and
1038	!-- westward (l=3) facing
1039	DO l = 0, 3
1040	ALLOCATE( surf_def_v(l)%answs( 1:surf_def_v(l)%ns, nbins ) )
1041	surf_def_v(l)%answs = 0.0_wp
1042	ALLOCATE( surf_def_v(l)%amsws( 1:surf_def_v(l)%ns, nbins*ncc_tot ) )
1043	surf_def_v(l)%amsws = 0.0_wp
1044
1045	IF ( land_surface) THEN
1046	ALLOCATE( surf_lsm_v(l)%answs( 1:surf_lsm_v(l)%ns, nbins ) )
1047	surf_lsm_v(l)%answs = 0.0_wp
1048	ALLOCATE( surf_lsm_v(l)%amsws( 1:surf_lsm_v(l)%ns, nbins*ncc_tot ) )
1049	surf_lsm_v(l)%amsws = 0.0_wp
1050	ENDIF
1051
1052	IF ( urban_surface ) THEN
1053	ALLOCATE( surf_usm_v(l)%answs( 1:surf_usm_v(l)%ns, nbins ) )
1054	surf_usm_v(l)%answs = 0.0_wp
1055	ALLOCATE( surf_usm_v(l)%amsws( 1:surf_usm_v(l)%ns, nbins*ncc_tot ) )
1056	surf_usm_v(l)%amsws = 0.0_wp
1057	ENDIF
1058	ENDDO
1059
1060	!
1061	!-- Concentration of gaseous tracers (1. SO4, 2. HNO3, 3. NH3, 4. OCNV, 5. OCSV)
1062	!-- (number concentration (#/m3) )
1063	!
1064	!-- If chemistry is on, read gas phase concentrations from there. Otherwise,
1065	!-- allocate salsa_gas array.
1066
1067	IF ( air_chemistry ) THEN
1068	DO lsp = 1, nvar
1069	IF ( TRIM( chem_species(lsp)%name ) == 'H2SO4' ) THEN
1070	gases_available = gases_available + 1
1071	gas_index_chem(1) = lsp
1072	ELSEIF ( TRIM( chem_species(lsp)%name ) == 'HNO3' ) THEN
1073	gases_available = gases_available + 1
1074	gas_index_chem(2) = lsp
1075	ELSEIF ( TRIM( chem_species(lsp)%name ) == 'NH3' ) THEN
1076	gases_available = gases_available + 1
1077	gas_index_chem(3) = lsp
1078	ELSEIF ( TRIM( chem_species(lsp)%name ) == 'OCNV' ) THEN
1079	gases_available = gases_available + 1
1080	gas_index_chem(4) = lsp
1081	ELSEIF ( TRIM( chem_species(lsp)%name ) == 'OCSV' ) THEN
1082	gases_available = gases_available + 1
1083	gas_index_chem(5) = lsp
1084	ENDIF
1085	ENDDO
1086
1087	IF ( gases_available == ngast ) THEN
1088	salsa_gases_from_chem = .TRUE.
1089	ELSE
1090	WRITE( message_string, * ) 'SALSA is run together with chemistry '// &
1091	'but not all gaseous components are '// &
1092	'provided by kpp (H2SO4, HNO3, NH3, '// &
1093	'OCNV, OCSC)'
1094	CALL message( 'check_parameters', 'SA0024', 1, 2, 0, 6, 0 )
1095	ENDIF
1096
1097	ELSE
1098
1099	ALLOCATE( salsa_gas(ngast) )
1100	ALLOCATE( gconc_1(nzb:nzt+1,nysg:nyng,nxlg:nxrg,ngast), &
1101	gconc_2(nzb:nzt+1,nysg:nyng,nxlg:nxrg,ngast), &
1102	gconc_3(nzb:nzt+1,nysg:nyng,nxlg:nxrg,ngast) )
1103	gconc_1 = 0.0_wp
1104	gconc_2 = 0.0_wp
1105	gconc_3 = 0.0_wp
1106
1107	DO i = 1, ngast
1108	salsa_gas(i)%conc(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => gconc_1(:,:,:,i)
1109	salsa_gas(i)%conc_p(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => gconc_2(:,:,:,i)
1110	salsa_gas(i)%tconc_m(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => gconc_3(:,:,:,i)
1111	ALLOCATE( salsa_gas(i)%flux_s(nzb+1:nzt,0:threads_per_task-1), &
1112	salsa_gas(i)%diss_s(nzb+1:nzt,0:threads_per_task-1), &
1113	salsa_gas(i)%flux_l(nzb+1:nzt,nys:nyn,0:threads_per_task-1),&
1114	salsa_gas(i)%diss_l(nzb+1:nzt,nys:nyn,0:threads_per_task-1),&
1115	salsa_gas(i)%init(nzb:nzt+1), &
1116	salsa_gas(i)%sums_ws_l(nzb:nzt+1,0:threads_per_task-1) )
1117	ENDDO
1118	!
1119	!-- Surface fluxes: gtsws = gaseous tracer flux
1120	!
1121	!-- Horizontal surfaces: default type
1122	DO l = 0, 2 ! upward (l=0), downward (l=1) and model top (l=2)
1123	ALLOCATE( surf_def_h(l)%gtsws( 1:surf_def_h(l)%ns, ngast ) )
1124	surf_def_h(l)%gtsws = 0.0_wp
1125	ENDDO
1126	!-- Horizontal surfaces: natural type
1127	IF ( land_surface ) THEN
1128	ALLOCATE( surf_lsm_h%gtsws( 1:surf_lsm_h%ns, ngast ) )
1129	surf_lsm_h%gtsws = 0.0_wp
1130	ENDIF
1131	!-- Horizontal surfaces: urban type
1132	IF ( urban_surface ) THEN
1133	ALLOCATE( surf_usm_h%gtsws( 1:surf_usm_h%ns, ngast ) )
1134	surf_usm_h%gtsws = 0.0_wp
1135	ENDIF
1136	!
1137	!-- Vertical surfaces: northward (l=0), southward (l=1), eastward (l=2) and
1138	!-- westward (l=3) facing
1139	DO l = 0, 3
1140	ALLOCATE( surf_def_v(l)%gtsws( 1:surf_def_v(l)%ns, ngast ) )
1141	surf_def_v(l)%gtsws = 0.0_wp
1142	IF ( land_surface ) THEN
1143	ALLOCATE( surf_lsm_v(l)%gtsws( 1:surf_lsm_v(l)%ns, ngast ) )
1144	surf_lsm_v(l)%gtsws = 0.0_wp
1145	ENDIF
1146	IF ( urban_surface ) THEN
1147	ALLOCATE( surf_usm_v(l)%gtsws( 1:surf_usm_v(l)%ns, ngast ) )
1148	surf_usm_v(l)%gtsws = 0.0_wp
1149	ENDIF
1150	ENDDO
1151	ENDIF
1152
1153	#endif
1154
1155	END SUBROUTINE salsa_init_arrays
1156
1157	!------------------------------------------------------------------------------!
1158	! Description:
1159	! ------------
1160	!> Initialization of SALSA. Based on salsa_initialize in UCLALES-SALSA.
1161	!> Subroutines salsa_initialize, SALSAinit and DiagInitAero in UCLALES-SALSA are
1162	!> also merged here.
1163	!------------------------------------------------------------------------------!
1164	SUBROUTINE salsa_init
1165
1166	IMPLICIT NONE
1167
1168	INTEGER(iwp) :: b
1169	INTEGER(iwp) :: c
1170	INTEGER(iwp) :: g
1171	INTEGER(iwp) :: i
1172	INTEGER(iwp) :: j
1173
1174	bin_low_limits = 0.0_wp
1175	nsect = 0.0_wp
1176	massacc = 1.0_wp
1177
1178	!
1179	!-- Indices for chemical components used (-1 = not used)
1180	i = 0
1181	IF ( is_used( prtcl, 'SO4' ) ) THEN
1182	iso4 = get_index( prtcl,'SO4' )
1183	i = i + 1
1184	ENDIF
1185	IF ( is_used( prtcl,'OC' ) ) THEN
1186	ioc = get_index(prtcl, 'OC')
1187	i = i + 1
1188	ENDIF
1189	IF ( is_used( prtcl, 'BC' ) ) THEN
1190	ibc = get_index( prtcl, 'BC' )
1191	i = i + 1
1192	ENDIF
1193	IF ( is_used( prtcl, 'DU' ) ) THEN
1194	idu = get_index( prtcl, 'DU' )
1195	i = i + 1
1196	ENDIF
1197	IF ( is_used( prtcl, 'SS' ) ) THEN
1198	iss = get_index( prtcl, 'SS' )
1199	i = i + 1
1200	ENDIF
1201	IF ( is_used( prtcl, 'NO' ) ) THEN
1202	ino = get_index( prtcl, 'NO' )
1203	i = i + 1
1204	ENDIF
1205	IF ( is_used( prtcl, 'NH' ) ) THEN
1206	inh = get_index( prtcl, 'NH' )
1207	i = i + 1
1208	ENDIF
1209	!
1210	!-- All species must be known
1211	IF ( i /= ncc ) THEN
1212	message_string = 'Unknown aerosol species/component(s) given in the' // &
1213	' initialization'
1214	CALL message( 'salsa_mod: salsa_init', 'SA0020', 1, 2, 0, 6, 0 )
1215	ENDIF
1216
1217	!
1218	!-- Initialise
1219	!
1220	!-- Aerosol size distribution (TYPE t_section)
1221	aero(:)%dwet = 1.0E-10_wp
1222	aero(:)%veqh2o = 1.0E-10_wp
1223	aero(:)%numc = nclim
1224	aero(:)%core = 1.0E-10_wp
1225	DO c = 1, maxspec+1 ! 1:SO4, 2:OC, 3:BC, 4:DU, 5:SS, 6:NO, 7:NH, 8:H2O
1226	aero(:)%volc(c) = 0.0_wp
1227	ENDDO
1228
1229	IF ( nldepo ) sedim_vd = 0.0_wp
1230	!
1231	!-- Initilisation actions that are NOT conducted for restart runs
1232	IF ( .NOT. read_restart_data_salsa ) THEN
1233
1234	DO b = 1, nbins
1235	aerosol_number(b)%conc = nclim
1236	aerosol_number(b)%conc_p = 0.0_wp
1237	aerosol_number(b)%tconc_m = 0.0_wp
1238	aerosol_number(b)%flux_s = 0.0_wp
1239	aerosol_number(b)%diss_s = 0.0_wp
1240	aerosol_number(b)%flux_l = 0.0_wp
1241	aerosol_number(b)%diss_l = 0.0_wp
1242	aerosol_number(b)%init = nclim
1243	aerosol_number(b)%sums_ws_l = 0.0_wp
1244	ENDDO
1245	DO c = 1, ncc_tot*nbins
1246	aerosol_mass(c)%conc = mclim
1247	aerosol_mass(c)%conc_p = 0.0_wp
1248	aerosol_mass(c)%tconc_m = 0.0_wp
1249	aerosol_mass(c)%flux_s = 0.0_wp
1250	aerosol_mass(c)%diss_s = 0.0_wp
1251	aerosol_mass(c)%flux_l = 0.0_wp
1252	aerosol_mass(c)%diss_l = 0.0_wp
1253	aerosol_mass(c)%init = mclim
1254	aerosol_mass(c)%sums_ws_l = 0.0_wp
1255	ENDDO
1256
1257	IF ( .NOT. salsa_gases_from_chem ) THEN
1258	DO g = 1, ngast
1259	salsa_gas(g)%conc_p = 0.0_wp
1260	salsa_gas(g)%tconc_m = 0.0_wp
1261	salsa_gas(g)%flux_s = 0.0_wp
1262	salsa_gas(g)%diss_s = 0.0_wp
1263	salsa_gas(g)%flux_l = 0.0_wp
1264	salsa_gas(g)%diss_l = 0.0_wp
1265	salsa_gas(g)%sums_ws_l = 0.0_wp
1266	ENDDO
1267
1268	!
1269	!-- Set initial value for gas compound tracers and initial values
1270	salsa_gas(1)%conc = H2SO4_init
1271	salsa_gas(1)%init = H2SO4_init
1272	salsa_gas(2)%conc = HNO3_init
1273	salsa_gas(2)%init = HNO3_init
1274	salsa_gas(3)%conc = NH3_init
1275	salsa_gas(3)%init = NH3_init
1276	salsa_gas(4)%conc = OCNV_init
1277	salsa_gas(4)%init = OCNV_init
1278	salsa_gas(5)%conc = OCSV_init
1279	salsa_gas(5)%init = OCSV_init
1280	ENDIF
1281	!
1282	!-- Aerosol radius in each bin: dry and wet (m)
1283	Ra_dry = 1.0E-10_wp
1284	!
1285	!-- Initialise aerosol tracers
1286	aero(:)%vhilim = 0.0_wp
1287	aero(:)%vlolim = 0.0_wp
1288	aero(:)%vratiohi = 0.0_wp
1289	aero(:)%vratiolo = 0.0_wp
1290	aero(:)%dmid = 0.0_wp
1291	!
1292	!-- Initialise the sectional particle size distribution
1293	CALL set_sizebins()
1294	!
1295	!-- Initialise location-dependent aerosol size distributions and
1296	!-- chemical compositions:
1297	CALL aerosol_init
1298	!
1299	!-- Initalisation run of SALSA
1300	DO i = nxl, nxr
1301	DO j = nys, nyn
1302	CALL salsa_driver( i, j, 1 )
1303	CALL salsa_diagnostics( i, j )
1304	ENDDO
1305	ENDDO
1306	ENDIF
1307	!
1308	!-- Set the aerosol and gas sources
1309	IF ( salsa_source_mode == 'read_from_file' ) THEN
1310	CALL salsa_set_source
1311	ENDIF
1312
1313	END SUBROUTINE salsa_init
1314
1315	!------------------------------------------------------------------------------!
1316	! Description:
1317	! ------------
1318	!> Initializes particle size distribution grid by calculating size bin limits
1319	!> and mid-size for dry particles in each bin. Called from salsa_initialize
1320	!> (only at the beginning of simulation).
1321	!> Size distribution described using:
1322	!> 1) moving center method (subranges 1 and 2)
1323	!> (Jacobson, Atmos. Env., 31, 131-144, 1997)
1324	!> 2) fixed sectional method (subrange 3)
1325	!> Size bins in each subrange are spaced logarithmically
1326	!> based on given subrange size limits and bin number.
1327	!
1328	!> Mona changed 06/2017: Use geometric mean diameter to describe the mean
1329	!> particle diameter in a size bin, not the arithmeric mean which clearly
1330	!> overestimates the total particle volume concentration.
1331	!
1332	!> Coded by:
1333	!> Hannele Korhonen (FMI) 2005
1334	!> Harri Kokkola (FMI) 2006
1335	!
1336	!> Bug fixes for box model + updated for the new aerosol datatype:
1337	!> Juha Tonttila (FMI) 2014
1338	!------------------------------------------------------------------------------!
1339	SUBROUTINE set_sizebins
1340
1341	IMPLICIT NONE
1342	!
1343	!-- Local variables
1344	INTEGER(iwp) :: cc
1345	INTEGER(iwp) :: dd
1346	REAL(wp) :: ratio_d !< ratio of the upper and lower diameter of subranges
1347	!
1348	!-- vlolim&vhilim: min & max dry volumes [fxm]
1349	!-- dmid: bin mid dry diameter (m)
1350	!-- vratiolo&vratiohi: volume ratio between the center and low/high limit
1351	!
1352	!-- 1) Size subrange 1:
1353	ratio_d = reglim(2) / reglim(1) ! section spacing (m)
1354	DO cc = in1a,fn1a
1355	aero(cc)%vlolim = api6 * ( reglim(1) * ratio_d ** &
1356	( REAL( cc-1 ) / nbin(1) ) ) ** 3.0_wp
1357	aero(cc)%vhilim = api6 * ( reglim(1) * ratio_d ** &
1358	( REAL( cc ) / nbin(1) ) ) ** 3.0_wp
1359	aero(cc)%dmid = SQRT( ( aero(cc)%vhilim / api6 ) ** ( 1.0_wp / 3.0_wp ) &
1360	* ( aero(cc)%vlolim / api6 ) ** ( 1.0_wp / 3.0_wp ) )
1361	aero(cc)%vratiohi = aero(cc)%vhilim / ( api6 * aero(cc)%dmid ** 3.0_wp )
1362	aero(cc)%vratiolo = aero(cc)%vlolim / ( api6 * aero(cc)%dmid ** 3.0_wp )
1363	ENDDO
1364	!
1365	!-- 2) Size subrange 2:
1366	!-- 2.1) Sub-subrange 2a: high hygroscopicity
1367	ratio_d = reglim(3) / reglim(2) ! section spacing
1368	DO dd = in2a, fn2a
1369	cc = dd - in2a
1370	aero(dd)%vlolim = api6 * ( reglim(2) * ratio_d ** &
1371	( REAL( cc ) / nbin(2) ) ) ** 3.0_wp
1372	aero(dd)%vhilim = api6 * ( reglim(2) * ratio_d ** &
1373	( REAL( cc+1 ) / nbin(2) ) ) ** 3.0_wp
1374	aero(dd)%dmid = SQRT( ( aero(dd)%vhilim / api6 ) ** ( 1.0_wp / 3.0_wp ) &
1375	* ( aero(dd)%vlolim / api6 ) ** ( 1.0_wp / 3.0_wp ) )
1376	aero(dd)%vratiohi = aero(dd)%vhilim / ( api6 * aero(dd)%dmid ** 3.0_wp )
1377	aero(dd)%vratiolo = aero(dd)%vlolim / ( api6 * aero(dd)%dmid ** 3.0_wp )
1378	ENDDO
1379	!
1380	!-- 2.2) Sub-subrange 2b: low hygroscopicity
1381	IF ( .NOT. no_insoluble ) THEN
1382	aero(in2b:fn2b)%vlolim = aero(in2a:fn2a)%vlolim
1383	aero(in2b:fn2b)%vhilim = aero(in2a:fn2a)%vhilim
1384	aero(in2b:fn2b)%dmid = aero(in2a:fn2a)%dmid
1385	aero(in2b:fn2b)%vratiohi = aero(in2a:fn2a)%vratiohi
1386	aero(in2b:fn2b)%vratiolo = aero(in2a:fn2a)%vratiolo
1387	ENDIF
1388	!
1389	!-- Initialize the wet diameter with the bin dry diameter to avoid numerical
1390	!-- problems later
1391	aero(:)%dwet = aero(:)%dmid
1392	!
1393	!-- Save bin limits (lower diameter) to be delivered to the host model if needed
1394	DO cc = 1, nbins
1395	bin_low_limits(cc) = ( aero(cc)%vlolim / api6 )**( 1.0_wp / 3.0_wp )
1396	ENDDO
1397
1398	END SUBROUTINE set_sizebins
1399
1400	!------------------------------------------------------------------------------!
1401	! Description:
1402	! ------------
1403	!> Initilize altitude-dependent aerosol size distributions and compositions.
1404	!>
1405	!> Mona added 06/2017: Correct the number and mass concentrations by normalizing
1406	!< by the given total number and mass concentration.
1407	!>
1408	!> Tomi Raatikainen, FMI, 29.2.2016
1409	!------------------------------------------------------------------------------!
1410	SUBROUTINE aerosol_init
1411
1412	USE arrays_3d, &
1413	ONLY: zu
1414
1415	! USE NETCDF
1416
1417	USE netcdf_data_input_mod, &
1418	ONLY: get_attribute, netcdf_data_input_get_dimension_length, &
1419	get_variable, open_read_file
1420
1421	IMPLICIT NONE
1422
1423	INTEGER(iwp) :: b !< loop index: size bins
1424	INTEGER(iwp) :: c !< loop index: chemical components
1425	INTEGER(iwp) :: ee !< index: end
1426	INTEGER(iwp) :: g !< loop index: gases
1427	INTEGER(iwp) :: i !< loop index: x-direction
1428	INTEGER(iwp) :: id_faero !< NetCDF id of PIDS_SALSA
1429	INTEGER(iwp) :: id_fchem !< NetCDF id of PIDS_CHEM
1430	INTEGER(iwp) :: j !< loop index: y-direction
1431	INTEGER(iwp) :: k !< loop index: z-direction
1432	INTEGER(iwp) :: kk !< loop index: z-direction
1433	INTEGER(iwp) :: nz_file !< Number of grid-points in file (heights)
1434	INTEGER(iwp) :: prunmode
1435	INTEGER(iwp) :: ss !< index: start
1436	LOGICAL :: netcdf_extend = .FALSE. !< Flag indicating wether netcdf
1437	!< topography input file or not
1438	REAL(wp), DIMENSION(nbins) :: core !< size of the bin mid aerosol particle,
1439	REAL(wp) :: flag !< flag to mask topography grid points
1440	REAL(wp), DIMENSION(:,:), ALLOCATABLE :: pr_gas !< gas profiles
1441	REAL(wp), DIMENSION(:,:), ALLOCATABLE :: pr_mass_fracs_a !< mass fraction
1442	!< profiles: a
1443	REAL(wp), DIMENSION(:,:), ALLOCATABLE :: pr_mass_fracs_b !< and b
1444	REAL(wp), DIMENSION(:,:), ALLOCATABLE :: pr_nsect !< sectional size
1445	!< distribution profile
1446	REAL(wp), DIMENSION(nbins) :: nsect !< size distribution (#/m3)
1447	REAL(wp), DIMENSION(0:nz+1,nbins) :: pndist !< size dist as a function
1448	!< of height (#/m3)
1449	REAL(wp), DIMENSION(0:nz+1) :: pnf2a !< number fraction: bins 2a
1450	REAL(wp), DIMENSION(0:nz+1,maxspec) :: pvf2a !< mass distributions of
1451	!< aerosol species for a
1452	REAL(wp), DIMENSION(0:nz+1,maxspec) :: pvf2b !< and b-bins
1453	REAL(wp), DIMENSION(0:nz+1) :: pvfOC1a !< mass fraction between
1454	!< SO4 and OC in 1a
1455	REAL(wp), DIMENSION(:), ALLOCATABLE :: pr_z
1456
1457	prunmode = 1
1458	!
1459	!-- Bin mean aerosol particle volume (m3)
1460	core(:) = 0.0_wp
1461	core(1:nbins) = api6 * aero(1:nbins)%dmid ** 3.0_wp
1462	!
1463	!-- Set concentrations to zero
1464	nsect(:) = 0.0_wp
1465	pndist(:,:) = 0.0_wp
1466	pnf2a(:) = nf2a
1467	pvf2a(:,:) = 0.0_wp
1468	pvf2b(:,:) = 0.0_wp
1469	pvfOC1a(:) = 0.0_wp
1470
1471	IF ( isdtyp == 1 ) THEN
1472	!
1473	!-- Read input profiles from PIDS_SALSA
1474	#if defined( __netcdf )
1475	!
1476	!-- Location-dependent size distributions and compositions.
1477	INQUIRE( FILE='PIDS_SALSA'// TRIM( coupling_char ), EXIST=netcdf_extend )
1478	IF ( netcdf_extend ) THEN
1479	!
1480	!-- Open file in read-only mode
1481	CALL open_read_file( 'PIDS_SALSA' // TRIM( coupling_char ), id_faero )
1482	!
1483	!-- Input heights
1484	CALL netcdf_data_input_get_dimension_length( id_faero, nz_file, "profile_z" )
1485
1486	ALLOCATE( pr_z(nz_file), pr_mass_fracs_a(maxspec,nz_file), &
1487	pr_mass_fracs_b(maxspec,nz_file), pr_nsect(nbins,nz_file) )
1488	CALL get_variable( id_faero, 'profile_z', pr_z )
1489	!
1490	!-- Mass fracs profile: 1: H2SO4 (sulphuric acid), 2: OC (organic carbon),
1491	!-- 3: BC (black carbon), 4: DU (dust),
1492	!-- 5: SS (sea salt), 6: HNO3 (nitric acid),
1493	!-- 7: NH3 (ammonia)
1494	CALL get_variable( id_faero, "profile_mass_fracs_a", pr_mass_fracs_a,&
1495	0, nz_file-1, 0, maxspec-1 )
1496	CALL get_variable( id_faero, "profile_mass_fracs_b", pr_mass_fracs_b,&
1497	0, nz_file-1, 0, maxspec-1 )
1498	CALL get_variable( id_faero, "profile_nsect", pr_nsect, 0, nz_file-1,&
1499	0, nbins-1 )
1500
1501	kk = 1
1502	DO k = nzb, nz+1
1503	IF ( kk < nz_file ) THEN
1504	DO WHILE ( pr_z(kk+1) <= zu(k) )
1505	kk = kk + 1
1506	IF ( kk == nz_file ) EXIT
1507	ENDDO
1508	ENDIF
1509	IF ( kk < nz_file ) THEN
1510	!
1511	!-- Set initial value for gas compound tracers and initial values
1512	pvf2a(k,:) = pr_mass_fracs_a(:,kk) + ( zu(k) - pr_z(kk) ) / ( &
1513	pr_z(kk+1) - pr_z(kk) ) * ( pr_mass_fracs_a(:,kk+1)&
1514	- pr_mass_fracs_a(:,kk) )
1515	pvf2b(k,:) = pr_mass_fracs_b(:,kk) + ( zu(k) - pr_z(kk) ) / ( &
1516	pr_z(kk+1) - pr_z(kk) ) * ( pr_mass_fracs_b(:,kk+1)&
1517	- pr_mass_fracs_b(:,kk) )
1518	pndist(k,:) = pr_nsect(:,kk) + ( zu(k) - pr_z(kk) ) / ( &
1519	pr_z(kk+1) - pr_z(kk) ) * ( pr_nsect(:,kk+1) - &
1520	pr_nsect(:,kk) )
1521	ELSE
1522	pvf2a(k,:) = pr_mass_fracs_a(:,kk)
1523	pvf2b(k,:) = pr_mass_fracs_b(:,kk)
1524	pndist(k,:) = pr_nsect(:,kk)
1525	ENDIF
1526	IF ( iso4 < 0 ) THEN
1527	pvf2a(k,1) = 0.0_wp
1528	pvf2b(k,1) = 0.0_wp
1529	ENDIF
1530	IF ( ioc < 0 ) THEN
1531	pvf2a(k,2) = 0.0_wp
1532	pvf2b(k,2) = 0.0_wp
1533	ENDIF
1534	IF ( ibc < 0 ) THEN
1535	pvf2a(k,3) = 0.0_wp
1536	pvf2b(k,3) = 0.0_wp
1537	ENDIF
1538	IF ( idu < 0 ) THEN
1539	pvf2a(k,4) = 0.0_wp
1540	pvf2b(k,4) = 0.0_wp
1541	ENDIF
1542	IF ( iss < 0 ) THEN
1543	pvf2a(k,5) = 0.0_wp
1544	pvf2b(k,5) = 0.0_wp
1545	ENDIF
1546	IF ( ino < 0 ) THEN
1547	pvf2a(k,6) = 0.0_wp
1548	pvf2b(k,6) = 0.0_wp
1549	ENDIF
1550	IF ( inh < 0 ) THEN
1551	pvf2a(k,7) = 0.0_wp
1552	pvf2b(k,7) = 0.0_wp
1553	ENDIF
1554	!
1555	!-- Then normalise the mass fraction so that SUM = 1
1556	pvf2a(k,:) = pvf2a(k,:) / SUM( pvf2a(k,:) )
1557	IF ( SUM( pvf2b(k,:) ) > 0.0_wp ) pvf2b(k,:) = pvf2b(k,:) / &
1558	SUM( pvf2b(k,:) )
1559	ENDDO
1560	DEALLOCATE( pr_z, pr_mass_fracs_a, pr_mass_fracs_b, pr_nsect )
1561	ELSE
1562	message_string = 'Input file '// TRIM( 'PIDS_SALSA' ) // &
1563	TRIM( coupling_char ) // ' for SALSA missing!'
1564	CALL message( 'salsa_mod: aerosol_init', 'SA0032', 1, 2, 0, 6, 0 )
1565	ENDIF ! netcdf_extend
1566	#endif
1567
1568	ELSEIF ( isdtyp == 0 ) THEN
1569	!
1570	!-- Mass fractions for species in a and b-bins
1571	IF ( iso4 > 0 ) THEN
1572	pvf2a(:,1) = mass_fracs_a(iso4)
1573	pvf2b(:,1) = mass_fracs_b(iso4)
1574	ENDIF
1575	IF ( ioc > 0 ) THEN
1576	pvf2a(:,2) = mass_fracs_a(ioc)
1577	pvf2b(:,2) = mass_fracs_b(ioc)
1578	ENDIF
1579	IF ( ibc > 0 ) THEN
1580	pvf2a(:,3) = mass_fracs_a(ibc)
1581	pvf2b(:,3) = mass_fracs_b(ibc)
1582	ENDIF
1583	IF ( idu > 0 ) THEN
1584	pvf2a(:,4) = mass_fracs_a(idu)
1585	pvf2b(:,4) = mass_fracs_b(idu)
1586	ENDIF
1587	IF ( iss > 0 ) THEN
1588	pvf2a(:,5) = mass_fracs_a(iss)
1589	pvf2b(:,5) = mass_fracs_b(iss)
1590	ENDIF
1591	IF ( ino > 0 ) THEN
1592	pvf2a(:,6) = mass_fracs_a(ino)
1593	pvf2b(:,6) = mass_fracs_b(ino)
1594	ENDIF
1595	IF ( inh > 0 ) THEN
1596	pvf2a(:,7) = mass_fracs_a(inh)
1597	pvf2b(:,7) = mass_fracs_b(inh)
1598	ENDIF
1599	DO k = nzb, nz+1
1600	pvf2a(k,:) = pvf2a(k,:) / SUM( pvf2a(k,:) )
1601	IF ( SUM( pvf2b(k,:) ) > 0.0_wp ) pvf2b(k,:) = pvf2b(k,:) / &
1602	SUM( pvf2b(k,:) )
1603	ENDDO
1604
1605	CALL size_distribution( n_lognorm, dpg, sigmag, nsect )
1606	!
1607	!-- Normalize by the given total number concentration
1608	nsect = nsect * SUM( n_lognorm ) * 1.0E+6_wp / SUM( nsect )
1609	DO b = in1a, fn2b
1610	pndist(:,b) = nsect(b)
1611	ENDDO
1612	ENDIF
1613
1614	IF ( igctyp == 1 ) THEN
1615	!
1616	!-- Read input profiles from PIDS_CHEM
1617	#if defined( __netcdf )
1618	!
1619	!-- Location-dependent size distributions and compositions.
1620	INQUIRE( FILE='PIDS_CHEM' // TRIM( coupling_char ), EXIST=netcdf_extend )
1621	IF ( netcdf_extend .AND. .NOT. salsa_gases_from_chem ) THEN
1622	!
1623	!-- Open file in read-only mode
1624	CALL open_read_file( 'PIDS_CHEM' // TRIM( coupling_char ), id_fchem )
1625	!
1626	!-- Input heights
1627	CALL netcdf_data_input_get_dimension_length( id_fchem, nz_file, "profile_z" )
1628	ALLOCATE( pr_z(nz_file), pr_gas(ngast,nz_file) )
1629	CALL get_variable( id_fchem, 'profile_z', pr_z )
1630	!
1631	!-- Gases:
1632	CALL get_variable( id_fchem, "profile_H2SO4", pr_gas(1,:) )
1633	CALL get_variable( id_fchem, "profile_HNO3", pr_gas(2,:) )
1634	CALL get_variable( id_fchem, "profile_NH3", pr_gas(3,:) )
1635	CALL get_variable( id_fchem, "profile_OCNV", pr_gas(4,:) )
1636	CALL get_variable( id_fchem, "profile_OCSV", pr_gas(5,:) )
1637
1638	kk = 1
1639	DO k = nzb, nz+1
1640	IF ( kk < nz_file ) THEN
1641	DO WHILE ( pr_z(kk+1) <= zu(k) )
1642	kk = kk + 1
1643	IF ( kk == nz_file ) EXIT
1644	ENDDO
1645	ENDIF
1646	IF ( kk < nz_file ) THEN
1647	!
1648	!-- Set initial value for gas compound tracers and initial values
1649	DO g = 1, ngast
1650	salsa_gas(g)%init(k) = pr_gas(g,kk) + ( zu(k) - pr_z(kk) ) &
1651	/ ( pr_z(kk+1) - pr_z(kk) ) * &
1652	( pr_gas(g,kk+1) - pr_gas(g,kk) )
1653	salsa_gas(g)%conc(k,:,:) = salsa_gas(g)%init(k)
1654	ENDDO
1655	ELSE
1656	DO g = 1, ngast
1657	salsa_gas(g)%init(k) = pr_gas(g,kk)
1658	salsa_gas(g)%conc(k,:,:) = salsa_gas(g)%init(k)
1659	ENDDO
1660	ENDIF
1661	ENDDO
1662
1663	DEALLOCATE( pr_z, pr_gas )
1664	ELSEIF ( .NOT. netcdf_extend .AND. .NOT. salsa_gases_from_chem ) THEN
1665	message_string = 'Input file '// TRIM( 'PIDS_CHEM' ) // &
1666	TRIM( coupling_char ) // ' for SALSA missing!'
1667	CALL message( 'salsa_mod: aerosol_init', 'SA0033', 1, 2, 0, 6, 0 )
1668	ENDIF ! netcdf_extend
1669	#endif
1670
1671	ENDIF
1672
1673	IF ( ioc > 0 .AND. iso4 > 0 ) THEN
1674	!-- Both are there, so use the given "massDistrA"
1675	pvfOC1a(:) = pvf2a(:,2) / ( pvf2a(:,2) + pvf2a(:,1) ) ! Normalize
1676	ELSEIF ( ioc > 0 ) THEN
1677	!-- Pure organic carbon
1678	pvfOC1a(:) = 1.0_wp
1679	ELSEIF ( iso4 > 0 ) THEN
1680	!-- Pure SO4
1681	pvfOC1a(:) = 0.0_wp
1682	ELSE
1683	message_string = 'Either OC or SO4 must be active for aerosol region 1a!'
1684	CALL message( 'salsa_mod: aerosol_init', 'SA0021', 1, 2, 0, 6, 0 )
1685	ENDIF
1686
1687	!
1688	!-- Initialize concentrations
1689	DO i = nxlg, nxrg
1690	DO j = nysg, nyng
1691	DO k = nzb, nzt+1
1692	!
1693	!-- Predetermine flag to mask topography
1694	flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_0(k,j,i), 0 ) )
1695	!
1696	!-- a) Number concentrations
1697	!-- Region 1:
1698	DO b = in1a, fn1a
1699	aerosol_number(b)%conc(k,j,i) = pndist(k,b) * flag
1700	IF ( prunmode == 1 ) THEN
1701	aerosol_number(b)%init = pndist(:,b)
1702	ENDIF
1703	ENDDO
1704	!
1705	!-- Region 2:
1706	IF ( nreg > 1 ) THEN
1707	DO b = in2a, fn2a
1708	aerosol_number(b)%conc(k,j,i) = MAX( 0.0_wp, pnf2a(k) ) * &
1709	pndist(k,b) * flag
1710	IF ( prunmode == 1 ) THEN
1711	aerosol_number(b)%init = MAX( 0.0_wp, nf2a ) * pndist(:,b)
1712	ENDIF
1713	ENDDO
1714	IF ( .NOT. no_insoluble ) THEN
1715	DO b = in2b, fn2b
1716	IF ( pnf2a(k) < 1.0_wp ) THEN
1717	aerosol_number(b)%conc(k,j,i) = MAX( 0.0_wp, 1.0_wp &
1718	- pnf2a(k) ) * pndist(k,b) * flag
1719	IF ( prunmode == 1 ) THEN
1720	aerosol_number(b)%init = MAX( 0.0_wp, 1.0_wp - &
1721	nf2a ) * pndist(:,b)
1722	ENDIF
1723	ENDIF
1724	ENDDO
1725	ENDIF
1726	ENDIF
1727	!
1728	!-- b) Aerosol mass concentrations
1729	!-- bin subrange 1: done here separately due to the SO4/OC convention
1730	!-- SO4:
1731	IF ( iso4 > 0 ) THEN
1732	ss = ( iso4 - 1 ) * nbins + in1a !< start
1733	ee = ( iso4 - 1 ) * nbins + fn1a !< end
1734	b = in1a
1735	DO c = ss, ee
1736	aerosol_mass(c)%conc(k,j,i) = MAX( 0.0_wp, 1.0_wp - &
1737	pvfOC1a(k) ) * pndist(k,b) * &
1738	core(b) * arhoh2so4 * flag
1739	IF ( prunmode == 1 ) THEN
1740	aerosol_mass(c)%init = MAX( 0.0_wp, 1.0_wp - MAXVAL( &
1741	pvfOC1a ) ) * pndist(:,b) * &
1742	core(b) * arhoh2so4
1743	ENDIF
1744	b = b+1
1745	ENDDO
1746	ENDIF
1747	!-- OC:
1748	IF ( ioc > 0 ) THEN
1749	ss = ( ioc - 1 ) * nbins + in1a !< start
1750	ee = ( ioc - 1 ) * nbins + fn1a !< end
1751	b = in1a
1752	DO c = ss, ee
1753	aerosol_mass(c)%conc(k,j,i) = MAX( 0.0_wp, pvfOC1a(k) ) * &
1754	pndist(k,b) * core(b) * arhooc * flag
1755	IF ( prunmode == 1 ) THEN
1756	aerosol_mass(c)%init = MAX( 0.0_wp, MAXVAL( pvfOC1a ) ) &
1757	* pndist(:,b) * core(b) * arhooc
1758	ENDIF
1759	b = b+1
1760	ENDDO
1761	ENDIF
1762
1763	prunmode = 3 ! Init only once
1764
1765	ENDDO !< k
1766	ENDDO !< j
1767	ENDDO !< i
1768
1769	!
1770	!-- c) Aerosol mass concentrations
1771	!-- bin subrange 2:
1772	IF ( nreg > 1 ) THEN
1773
1774	IF ( iso4 > 0 ) THEN
1775	CALL set_aero_mass( iso4, pvf2a(:,1), pvf2b(:,1), pnf2a, pndist, &
1776	core, arhoh2so4 )
1777	ENDIF
1778	IF ( ioc > 0 ) THEN
1779	CALL set_aero_mass( ioc, pvf2a(:,2), pvf2b(:,2), pnf2a, pndist, core,&
1780	arhooc )
1781	ENDIF
1782	IF ( ibc > 0 ) THEN
1783	CALL set_aero_mass( ibc, pvf2a(:,3), pvf2b(:,3), pnf2a, pndist, core,&
1784	arhobc )
1785	ENDIF
1786	IF ( idu > 0 ) THEN
1787	CALL set_aero_mass( idu, pvf2a(:,4), pvf2b(:,4), pnf2a, pndist, core,&
1788	arhodu )
1789	ENDIF
1790	IF ( iss > 0 ) THEN
1791	CALL set_aero_mass( iss, pvf2a(:,5), pvf2b(:,5), pnf2a, pndist, core,&
1792	arhoss )
1793	ENDIF
1794	IF ( ino > 0 ) THEN
1795	CALL set_aero_mass( ino, pvf2a(:,6), pvf2b(:,6), pnf2a, pndist, core,&
1796	arhohno3 )
1797	ENDIF
1798	IF ( inh > 0 ) THEN
1799	CALL set_aero_mass( inh, pvf2a(:,7), pvf2b(:,7), pnf2a, pndist, core,&
1800	arhonh3 )
1801	ENDIF
1802
1803	ENDIF
1804
1805	END SUBROUTINE aerosol_init
1806
1807	!------------------------------------------------------------------------------!
1808	! Description:
1809	! ------------
1810	!> Create a lognormal size distribution and discretise to a sectional
1811	!> representation.
1812	!------------------------------------------------------------------------------!
1813	SUBROUTINE size_distribution( in_ntot, in_dpg, in_sigma, psd_sect )
1814
1815	IMPLICIT NONE
1816
1817	!-- Log-normal size distribution: modes
1818	REAL(wp), DIMENSION(:), INTENT(in) :: in_dpg !< geometric mean diameter
1819	!< (micrometres)
1820	REAL(wp), DIMENSION(:), INTENT(in) :: in_ntot !< number conc. (#/cm3)
1821	REAL(wp), DIMENSION(:), INTENT(in) :: in_sigma !< standard deviation
1822	REAL(wp), DIMENSION(:), INTENT(inout) :: psd_sect !< sectional size
1823	!< distribution
1824	INTEGER(iwp) :: b !< running index: bin
1825	INTEGER(iwp) :: ib !< running index: iteration
1826	REAL(wp) :: d1 !< particle diameter (m, dummy)
1827	REAL(wp) :: d2 !< particle diameter (m, dummy)
1828	REAL(wp) :: delta_d !< (d2-d1)/10
1829	REAL(wp) :: deltadp !< bin width
1830	REAL(wp) :: dmidi !< ( d1 + d2 ) / 2
1831
1832	DO b = in1a, fn2b !< aerosol size bins
1833	psd_sect(b) = 0.0_wp
1834	!-- Particle diameter at the low limit (largest in the bin) (m)
1835	d1 = ( aero(b)%vlolim / api6 ) ** ( 1.0_wp / 3.0_wp )
1836	!-- Particle diameter at the high limit (smallest in the bin) (m)
1837	d2 = ( aero(b)%vhilim / api6 ) ** ( 1.0_wp / 3.0_wp )
1838	!-- Span of particle diameter in a bin (m)
1839	delta_d = ( d2 - d1 ) / 10.0_wp
1840	!-- Iterate:
1841	DO ib = 1, 10
1842	d1 = ( aero(b)%vlolim / api6 ) ** ( 1.0_wp / 3.0_wp ) + ( ib - 1) &
1843	* delta_d
1844	d2 = d1 + delta_d
1845	dmidi = ( d1 + d2 ) / 2.0_wp
1846	deltadp = LOG10( d2 / d1 )
1847
1848	!-- Size distribution
1849	!-- in_ntot = total number, total area, or total volume concentration
1850	!-- in_dpg = geometric-mean number, area, or volume diameter
1851	!-- n(k) = number, area, or volume concentration in a bin
1852	!-- n_lognorm and dpg converted to units of #/m3 and m
1853	psd_sect(b) = psd_sect(b) + SUM( in_ntot * 1.0E+6_wp * deltadp / &
1854	( SQRT( 2.0_wp * pi ) * LOG10( in_sigma ) ) * &
1855	EXP( -LOG10( dmidi / ( 1.0E-6_wp * in_dpg ) )**2.0_wp / &
1856	( 2.0_wp * LOG10( in_sigma ) ** 2.0_wp ) ) )
1857
1858	ENDDO
1859	ENDDO
1860
1861	END SUBROUTINE size_distribution
1862
1863	!------------------------------------------------------------------------------!
1864	! Description:
1865	! ------------
1866	!> Sets the mass concentrations to aerosol arrays in 2a and 2b.
1867	!>
1868	!> Tomi Raatikainen, FMI, 29.2.2016
1869	!------------------------------------------------------------------------------!
1870	SUBROUTINE set_aero_mass( ispec, ppvf2a, ppvf2b, ppnf2a, ppndist, pcore, prho )
1871
1872	IMPLICIT NONE
1873
1874	INTEGER(iwp), INTENT(in) :: ispec !< Aerosol species index
1875	REAL(wp), INTENT(in) :: pcore(nbins) !< Aerosol bin mid core volume
1876	REAL(wp), INTENT(in) :: ppndist(0:nz+1,nbins) !< Aerosol size distribution
1877	REAL(wp), INTENT(in) :: ppnf2a(0:nz+1) !< Number fraction for 2a
1878	REAL(wp), INTENT(in) :: ppvf2a(0:nz+1) !< Mass distributions for a
1879	REAL(wp), INTENT(in) :: ppvf2b(0:nz+1) !< and b bins
1880	REAL(wp), INTENT(in) :: prho !< Aerosol density
1881	INTEGER(iwp) :: b !< loop index
1882	INTEGER(iwp) :: c !< loop index
1883	INTEGER(iwp) :: ee !< index: end
1884	INTEGER(iwp) :: i !< loop index
1885	INTEGER(iwp) :: j !< loop index
1886	INTEGER(iwp) :: k !< loop index
1887	INTEGER(iwp) :: prunmode !< 1 = initialise
1888	INTEGER(iwp) :: ss !< index: start
1889	REAL(wp) :: flag !< flag to mask topography grid points
1890
1891	prunmode = 1
1892
1893	DO i = nxlg, nxrg
1894	DO j = nysg, nyng
1895	DO k = nzb, nzt+1
1896	!
1897	!-- Predetermine flag to mask topography
1898	flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_0(k,j,i), 0 ) )
1899	!
1900	!-- Regime 2a:
1901	ss = ( ispec - 1 ) * nbins + in2a
1902	ee = ( ispec - 1 ) * nbins + fn2a
1903	b = in2a
1904	DO c = ss, ee
1905	aerosol_mass(c)%conc(k,j,i) = MAX( 0.0_wp, ppvf2a(k) ) * &
1906	ppnf2a(k) * ppndist(k,b) * pcore(b) * prho * flag
1907	IF ( prunmode == 1 ) THEN
1908	aerosol_mass(c)%init = MAX( 0.0_wp, MAXVAL( ppvf2a(:) ) ) * &
1909	MAXVAL( ppnf2a ) * pcore(b) * prho * &
1910	MAXVAL( ppndist(:,b) )
1911	ENDIF
1912	b = b+1
1913	ENDDO
1914	!-- Regime 2b:
1915	IF ( .NOT. no_insoluble ) THEN
1916	ss = ( ispec - 1 ) * nbins + in2b
1917	ee = ( ispec - 1 ) * nbins + fn2b
1918	b = in2a
1919	DO c = ss, ee
1920	aerosol_mass(c)%conc(k,j,i) = MAX( 0.0_wp, ppvf2b(k) ) * ( &
1921	1.0_wp - ppnf2a(k) ) * ppndist(k,b) * &
1922	pcore(b) * prho * flag
1923	IF ( prunmode == 1 ) THEN
1924	aerosol_mass(c)%init = MAX( 0.0_wp, MAXVAL( ppvf2b(:) ) )&
1925	* ( 1.0_wp - MAXVAL( ppnf2a ) ) * &
1926	MAXVAL( ppndist(:,b) ) * pcore(b) * prho
1927	ENDIF
1928	b = b+1
1929	ENDDO
1930	ENDIF
1931	prunmode = 3 ! Init only once
1932	ENDDO
1933	ENDDO
1934	ENDDO
1935	END SUBROUTINE set_aero_mass
1936
1937	!------------------------------------------------------------------------------!
1938	! Description:
1939	! ------------
1940	!> Swapping of timelevels
1941	!------------------------------------------------------------------------------!
1942	SUBROUTINE salsa_swap_timelevel( mod_count )
1943
1944	IMPLICIT NONE
1945
1946	INTEGER(iwp), INTENT(IN) :: mod_count !<
1947	INTEGER(iwp) :: b !<
1948	INTEGER(iwp) :: c !<
1949	INTEGER(iwp) :: cc !<
1950	INTEGER(iwp) :: g !<
1951
1952	!
1953	!-- Example for prognostic variable "prog_var"
1954	#if defined( __nopointer )
1955	IF ( myid == 0 ) THEN
1956	message_string = ' SALSA runs only with POINTER Version'
1957	CALL message( 'salsa_swap_timelevel', 'SA0022', 1, 2, 0, 6, 0 )
1958	ENDIF
1959	#else
1960
1961	SELECT CASE ( mod_count )
1962
1963	CASE ( 0 )
1964
1965	DO b = 1, nbins
1966	aerosol_number(b)%conc(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => &
1967	nconc_1(:,:,:,b)
1968	aerosol_number(b)%conc_p(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => &
1969	nconc_2(:,:,:,b)
1970	DO c = 1, ncc_tot
1971	cc = ( c-1 ) * nbins + b ! required due to possible Intel18 bug
1972	aerosol_mass(cc)%conc(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => &
1973	mconc_1(:,:,:,cc)
1974	aerosol_mass(cc)%conc_p(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => &
1975	mconc_2(:,:,:,cc)
1976	ENDDO
1977	ENDDO
1978
1979	IF ( .NOT. salsa_gases_from_chem ) THEN
1980	DO g = 1, ngast
1981	salsa_gas(g)%conc(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => &
1982	gconc_1(:,:,:,g)
1983	salsa_gas(g)%conc_p(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => &
1984	gconc_2(:,:,:,g)
1985	ENDDO
1986	ENDIF
1987
1988	CASE ( 1 )
1989
1990	DO b = 1, nbins
1991	aerosol_number(b)%conc(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => &
1992	nconc_2(:,:,:,b)
1993	aerosol_number(b)%conc_p(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => &
1994	nconc_1(:,:,:,b)
1995	DO c = 1, ncc_tot
1996	cc = ( c-1 ) * nbins + b ! required due to possible Intel18 bug
1997	aerosol_mass(cc)%conc(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => &
1998	mconc_2(:,:,:,cc)
1999	aerosol_mass(cc)%conc_p(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => &
2000	mconc_1(:,:,:,cc)
2001	ENDDO
2002	ENDDO
2003
2004	IF ( .NOT. salsa_gases_from_chem ) THEN
2005	DO g = 1, ngast
2006	salsa_gas(g)%conc(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => &
2007	gconc_2(:,:,:,g)
2008	salsa_gas(g)%conc_p(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => &
2009	gconc_1(:,:,:,g)
2010	ENDDO
2011	ENDIF
2012
2013	END SELECT
2014	#endif
2015
2016	END SUBROUTINE salsa_swap_timelevel
2017
2018
2019	!------------------------------------------------------------------------------!
2020	! Description:
2021	! ------------
2022	!> This routine reads the respective restart data.
2023	!------------------------------------------------------------------------------!
2024	SUBROUTINE salsa_rrd_local
2025
2026
2027	IMPLICIT NONE
2028
2029	CHARACTER (LEN=20) :: field_char !<
2030	INTEGER(iwp) :: b !<
2031	INTEGER(iwp) :: c !<
2032	INTEGER(iwp) :: g !<
2033	INTEGER(iwp) :: i !<
2034	INTEGER(iwp) :: j !<
2035	INTEGER(iwp) :: k !<
2036
2037	IF ( read_restart_data_salsa ) THEN
2038	READ ( 13 ) field_char
2039
2040	DO WHILE ( TRIM( field_char ) /= '* end salsa *' )
2041
2042	DO b = 1, nbins
2043	READ ( 13 ) aero(b)%vlolim
2044	READ ( 13 ) aero(b)%vhilim
2045	READ ( 13 ) aero(b)%dmid
2046	READ ( 13 ) aero(b)%vratiohi
2047	READ ( 13 ) aero(b)%vratiolo
2048	ENDDO
2049
2050	DO i = nxl, nxr
2051	DO j = nys, nyn
2052	DO k = nzb+1, nzt
2053	DO b = 1, nbins
2054	READ ( 13 ) aerosol_number(b)%conc(k,j,i)
2055	DO c = 1, ncc_tot
2056	READ ( 13 ) aerosol_mass((c-1)*nbins+b)%conc(k,j,i)
2057	ENDDO
2058	ENDDO
2059	IF ( .NOT. salsa_gases_from_chem ) THEN
2060	DO g = 1, ngast
2061	READ ( 13 ) salsa_gas(g)%conc(k,j,i)
2062	ENDDO
2063	ENDIF
2064	ENDDO
2065	ENDDO
2066	ENDDO
2067
2068	READ ( 13 ) field_char
2069
2070	ENDDO
2071
2072	ENDIF
2073
2074	END SUBROUTINE salsa_rrd_local
2075
2076
2077	!------------------------------------------------------------------------------!
2078	! Description:
2079	! ------------
2080	!> This routine writes the respective restart data.
2081	!> Note that the following input variables in PARIN have to be equal between
2082	!> restart runs:
2083	!> listspec, nbin, nbin2, nf2a, ncc, mass_fracs_a, mass_fracs_b
2084	!------------------------------------------------------------------------------!
2085	SUBROUTINE salsa_wrd_local
2086
2087	IMPLICIT NONE
2088
2089	INTEGER(iwp) :: b !<
2090	INTEGER(iwp) :: c !<
2091	INTEGER(iwp) :: g !<
2092	INTEGER(iwp) :: i !<
2093	INTEGER(iwp) :: j !<
2094	INTEGER(iwp) :: k !<
2095
2096	IF ( write_binary .AND. write_binary_salsa ) THEN
2097
2098	DO b = 1, nbins
2099	WRITE ( 14 ) aero(b)%vlolim
2100	WRITE ( 14 ) aero(b)%vhilim
2101	WRITE ( 14 ) aero(b)%dmid
2102	WRITE ( 14 ) aero(b)%vratiohi
2103	WRITE ( 14 ) aero(b)%vratiolo
2104	ENDDO
2105
2106	DO i = nxl, nxr
2107	DO j = nys, nyn
2108	DO k = nzb+1, nzt
2109	DO b = 1, nbins
2110	WRITE ( 14 ) aerosol_number(b)%conc(k,j,i)
2111	DO c = 1, ncc_tot
2112	WRITE ( 14 ) aerosol_mass((c-1)*nbins+b)%conc(k,j,i)
2113	ENDDO
2114	ENDDO
2115	IF ( .NOT. salsa_gases_from_chem ) THEN
2116	DO g = 1, ngast
2117	WRITE ( 14 ) salsa_gas(g)%conc(k,j,i)
2118	ENDDO
2119	ENDIF
2120	ENDDO
2121	ENDDO
2122	ENDDO
2123
2124	WRITE ( 14 ) '* end salsa * '
2125
2126	ENDIF
2127
2128	END SUBROUTINE salsa_wrd_local
2129
2130
2131	!------------------------------------------------------------------------------!
2132	! Description:
2133	! ------------
2134	!> Performs necessary unit and dimension conversion between the host model and
2135	!> SALSA module, and calls the main SALSA routine.
2136	!> Partially adobted form the original SALSA boxmodel version.
2137	!> Now takes masses in as kg/kg from LES!! Converted to m3/m3 for SALSA
2138	!> 05/2016 Juha: This routine is still pretty much in its original shape.
2139	!> It's dumb as a mule and twice as ugly, so implementation of
2140	!> an improved solution is necessary sooner or later.
2141	!> Juha Tonttila, FMI, 2014
2142	!> Jaakko Ahola, FMI, 2016
2143	!> Only aerosol processes included, Mona Kurppa, UHel, 2017
2144	!------------------------------------------------------------------------------!
2145	SUBROUTINE salsa_driver( i, j, prunmode )
2146
2147	USE arrays_3d, &
2148	ONLY: pt_p, q_p, rho_air_zw, u, v, w
2149
2150	USE plant_canopy_model_mod, &
2151	ONLY: lad_s
2152
2153	USE surface_mod, &
2154	ONLY: surf_def_h, surf_def_v, surf_lsm_h, surf_lsm_v, surf_usm_h, &
2155	surf_usm_v
2156
2157	IMPLICIT NONE
2158
2159	INTEGER(iwp), INTENT(in) :: i !< loop index
2160	INTEGER(iwp), INTENT(in) :: j !< loop index
2161	INTEGER(iwp), INTENT(in) :: prunmode !< 1: Initialization call
2162	!< 2: Spinup period call
2163	!< 3: Regular runtime call
2164	!-- Local variables
2165	TYPE(t_section), DIMENSION(fn2b) :: aero_old !< helper array
2166	INTEGER(iwp) :: bb !< loop index
2167	INTEGER(iwp) :: cc !< loop index
2168	INTEGER(iwp) :: endi !< end index
2169	INTEGER(iwp) :: k_wall !< vertical index of topography top
2170	INTEGER(iwp) :: k !< loop index
2171	INTEGER(iwp) :: l !< loop index
2172	INTEGER(iwp) :: nc_h2o !< index of H2O in the prtcl index table
2173	INTEGER(iwp) :: ss !< loop index
2174	INTEGER(iwp) :: str !< start index
2175	INTEGER(iwp) :: vc !< default index in prtcl
2176	REAL(wp) :: cw_old !< previous H2O mixing ratio
2177	REAL(wp) :: flag !< flag to mask topography grid points
2178	REAL(wp), DIMENSION(nzb:nzt+1) :: in_adn !< air density (kg/m3)
2179	REAL(wp), DIMENSION(nzb:nzt+1) :: in_cs !< H2O sat. vapour conc.
2180	REAL(wp), DIMENSION(nzb:nzt+1) :: in_cw !< H2O vapour concentration
2181	REAL(wp) :: in_lad !< leaf area density (m2/m3)
2182	REAL(wp), DIMENSION(nzb:nzt+1) :: in_p !< pressure (Pa)
2183	REAL(wp) :: in_rh !< relative humidity
2184	REAL(wp), DIMENSION(nzb:nzt+1) :: in_t !< temperature (K)
2185	REAL(wp), DIMENSION(nzb:nzt+1) :: in_u !< wind magnitude (m/s)
2186	REAL(wp), DIMENSION(nzb:nzt+1) :: kvis !< kinematic viscosity of air(m2/s)
2187	REAL(wp), DIMENSION(nzb:nzt+1,fn2b) :: Sc !< particle Schmidt number
2188	REAL(wp), DIMENSION(nzb:nzt+1,fn2b) :: vd !< particle fall seed (m/s,
2189	!< sedimentation velocity)
2190	REAL(wp), DIMENSION(nzb:nzt+1) :: ppm_to_nconc !< Conversion factor
2191	!< from ppm to #/m3
2192	REAL(wp) :: zgso4 !< SO4
2193	REAL(wp) :: zghno3 !< HNO3
2194	REAL(wp) :: zgnh3 !< NH3
2195	REAL(wp) :: zgocnv !< non-volatile OC
2196	REAL(wp) :: zgocsv !< semi-volatile OC
2197
2198	aero_old(:)%numc = 0.0_wp
2199	in_adn = 0.0_wp
2200	in_cs = 0.0_wp
2201	in_cw = 0.0_wp
2202	in_lad = 0.0_wp
2203	in_rh = 0.0_wp
2204	in_p = 0.0_wp
2205	in_t = 0.0_wp
2206	in_u = 0.0_wp
2207	kvis = 0.0_wp
2208	Sc = 0.0_wp
2209	vd = 0.0_wp
2210	ppm_to_nconc = 1.0_wp
2211	zgso4 = nclim
2212	zghno3 = nclim
2213	zgnh3 = nclim
2214	zgocnv = nclim
2215	zgocsv = nclim
2216
2217	!
2218	!-- Aerosol number is always set, but mass can be uninitialized
2219	DO cc = 1, nbins
2220	aero(cc)%volc = 0.0_wp
2221	aero_old(cc)%volc = 0.0_wp
2222	ENDDO
2223	!
2224	!-- Set the salsa runtime config (How to make this more efficient?)
2225	CALL set_salsa_runtime( prunmode )
2226	!
2227	!-- Calculate thermodynamic quantities needed in SALSA
2228	CALL salsa_thrm_ij( i, j, p_ij=in_p, temp_ij=in_t, cw_ij=in_cw, &
2229	cs_ij=in_cs, adn_ij=in_adn )
2230	!
2231	!-- Magnitude of wind: needed for deposition
2232	IF ( lsdepo ) THEN
2233	in_u(nzb+1:nzt) = SQRT( &
2234	( 0.5_wp * ( u(nzb+1:nzt,j,i) + u(nzb+1:nzt,j,i+1) ) )**2 + &
2235	( 0.5_wp * ( v(nzb+1:nzt,j,i) + v(nzb+1:nzt,j+1,i) ) )**2 + &
2236	( 0.5_wp * ( w(nzb:nzt-1,j,i) + w(nzb+1:nzt,j, i) ) )**2 )
2237	ENDIF
2238	!
2239	!-- Calculate conversion factors for gas concentrations
2240	ppm_to_nconc = for_ppm_to_nconc * in_p / in_t
2241	!
2242	!-- Determine topography-top index on scalar grid
2243	k_wall = MAXLOC( MERGE( 1, 0, BTEST( wall_flags_0(:,j,i), 12 ) ), &
2244	DIM = 1 ) - 1
2245
2246	DO k = nzb+1, nzt
2247	!
2248	!-- Predetermine flag to mask topography
2249	flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_0(k,j,i), 0 ) )
2250	!
2251	!-- Do not run inside buildings
2252	IF ( flag == 0.0_wp ) CYCLE
2253	!
2254	!-- Wind velocity for dry depositon on vegetation
2255	IF ( lsdepo_vege .AND. plant_canopy ) THEN
2256	in_lad = lad_s(k-k_wall,j,i)
2257	ENDIF
2258	!
2259	!-- For initialization and spinup, limit the RH with the parameter rhlim
2260	IF ( prunmode < 3 ) THEN
2261	in_cw(k) = MIN( in_cw(k), in_cs(k) * rhlim )
2262	ELSE
2263	in_cw(k) = in_cw(k)
2264	ENDIF
2265	cw_old = in_cw(k) !* in_adn(k)
2266	!
2267	!-- Set volume concentrations:
2268	!-- Sulphate (SO4) or sulphuric acid H2SO4
2269	IF ( iso4 > 0 ) THEN
2270	vc = 1
2271	str = ( iso4-1 ) * nbins + 1 ! start index
2272	endi = iso4 * nbins ! end index
2273	cc = 1
2274	DO ss = str, endi
2275	aero(cc)%volc(vc) = aerosol_mass(ss)%conc(k,j,i) / arhoh2so4
2276	cc = cc+1
2277	ENDDO
2278	aero_old(1:nbins)%volc(vc) = aero(1:nbins)%volc(vc)
2279	ENDIF
2280
2281	!-- Organic carbon (OC) compounds
2282	IF ( ioc > 0 ) THEN
2283	vc = 2
2284	str = ( ioc-1 ) * nbins + 1
2285	endi = ioc * nbins
2286	cc = 1
2287	DO ss = str, endi
2288	aero(cc)%volc(vc) = aerosol_mass(ss)%conc(k,j,i) / arhooc
2289	cc = cc+1
2290	ENDDO
2291	aero_old(1:nbins)%volc(vc) = aero(1:nbins)%volc(vc)
2292	ENDIF
2293
2294	!-- Black carbon (BC)
2295	IF ( ibc > 0 ) THEN
2296	vc = 3
2297	str = ( ibc-1 ) * nbins + 1 + fn1a
2298	endi = ibc * nbins
2299	cc = 1 + fn1a
2300	DO ss = str, endi
2301	aero(cc)%volc(vc) = aerosol_mass(ss)%conc(k,j,i) / arhobc
2302	cc = cc+1
2303	ENDDO
2304	aero_old(1:nbins)%volc(vc) = aero(1:nbins)%volc(vc)
2305	ENDIF
2306
2307	!-- Dust (DU)
2308	IF ( idu > 0 ) THEN
2309	vc = 4
2310	str = ( idu-1 ) * nbins + 1 + fn1a
2311	endi = idu * nbins
2312	cc = 1 + fn1a
2313	DO ss = str, endi
2314	aero(cc)%volc(vc) = aerosol_mass(ss)%conc(k,j,i) / arhodu
2315	cc = cc+1
2316	ENDDO
2317	aero_old(1:nbins)%volc(vc) = aero(1:nbins)%volc(vc)
2318	ENDIF
2319
2320	!-- Sea salt (SS)
2321	IF ( iss > 0 ) THEN
2322	vc = 5
2323	str = ( iss-1 ) * nbins + 1 + fn1a
2324	endi = iss * nbins
2325	cc = 1 + fn1a
2326	DO ss = str, endi
2327	aero(cc)%volc(vc) = aerosol_mass(ss)%conc(k,j,i) / arhoss
2328	cc = cc+1
2329	ENDDO
2330	aero_old(1:nbins)%volc(vc) = aero(1:nbins)%volc(vc)
2331	ENDIF
2332
2333	!-- Nitrate (NO(3-)) or nitric acid HNO3
2334	IF ( ino > 0 ) THEN
2335	vc = 6
2336	str = ( ino-1 ) * nbins + 1
2337	endi = ino * nbins
2338	cc = 1
2339	DO ss = str, endi
2340	aero(cc)%volc(vc) = aerosol_mass(ss)%conc(k,j,i) / arhohno3
2341	cc = cc+1
2342	ENDDO
2343	aero_old(1:nbins)%volc(vc) = aero(1:nbins)%volc(vc)
2344	ENDIF
2345
2346	!-- Ammonium (NH(4+)) or ammonia NH3
2347	IF ( inh > 0 ) THEN
2348	vc = 7
2349	str = ( inh-1 ) * nbins + 1
2350	endi = inh * nbins
2351	cc = 1
2352	DO ss = str, endi
2353	aero(cc)%volc(vc) = aerosol_mass(ss)%conc(k,j,i) / arhonh3
2354	cc = cc+1
2355	ENDDO
2356	aero_old(1:nbins)%volc(vc) = aero(1:nbins)%volc(vc)
2357	ENDIF
2358
2359	!-- Water (always used)
2360	nc_h2o = get_index( prtcl,'H2O' )
2361	vc = 8
2362	str = ( nc_h2o-1 ) * nbins + 1
2363	endi = nc_h2o * nbins
2364	cc = 1
2365	IF ( advect_particle_water ) THEN
2366	DO ss = str, endi
2367	aero(cc)%volc(vc) = aerosol_mass(ss)%conc(k,j,i) / arhoh2o
2368	cc = cc+1
2369	ENDDO
2370	ELSE
2371	aero(1:nbins)%volc(vc) = mclim
2372	ENDIF
2373	aero_old(1:nbins)%volc(vc) = aero(1:nbins)%volc(vc)
2374	!
2375	!-- Number concentrations (numc) and particle sizes
2376	!-- (dwet = wet diameter, core = dry volume)
2377	DO bb = 1, nbins
2378	aero(bb)%numc = aerosol_number(bb)%conc(k,j,i)
2379	aero_old(bb)%numc = aero(bb)%numc
2380	IF ( aero(bb)%numc > nclim ) THEN
2381	aero(bb)%dwet = ( SUM( aero(bb)%volc(:) ) / aero(bb)%numc / api6 )&
2382	**( 1.0_wp / 3.0_wp )
2383	aero(bb)%core = SUM( aero(bb)%volc(1:7) ) / aero(bb)%numc
2384	ELSE
2385	aero(bb)%dwet = aero(bb)%dmid
2386	aero(bb)%core = api6 * ( aero(bb)%dwet ) ** 3.0_wp
2387	ENDIF
2388	ENDDO
2389	!
2390	!-- On EACH call of salsa_driver, calculate the ambient sizes of
2391	!-- particles by equilibrating soluble fraction of particles with water
2392	!-- using the ZSR method.
2393	in_rh = in_cw(k) / in_cs(k)
2394	IF ( prunmode==1 .OR. .NOT. advect_particle_water ) THEN
2395	CALL equilibration( in_rh, in_t(k), aero, .TRUE. )
2396	ENDIF
2397	!
2398	!-- Gaseous tracer concentrations in #/m3
2399	IF ( salsa_gases_from_chem ) THEN
2400	!
2401	!-- Convert concentrations in ppm to #/m3
2402	zgso4 = chem_species(gas_index_chem(1))%conc(k,j,i) * ppm_to_nconc(k)
2403	zghno3 = chem_species(gas_index_chem(2))%conc(k,j,i) * ppm_to_nconc(k)
2404	zgnh3 = chem_species(gas_index_chem(3))%conc(k,j,i) * ppm_to_nconc(k)
2405	zgocnv = chem_species(gas_index_chem(4))%conc(k,j,i) * ppm_to_nconc(k)
2406	zgocsv = chem_species(gas_index_chem(5))%conc(k,j,i) * ppm_to_nconc(k)
2407	ELSE
2408	zgso4 = salsa_gas(1)%conc(k,j,i)
2409	zghno3 = salsa_gas(2)%conc(k,j,i)
2410	zgnh3 = salsa_gas(3)%conc(k,j,i)
2411	zgocnv = salsa_gas(4)%conc(k,j,i)
2412	zgocsv = salsa_gas(5)%conc(k,j,i)
2413	ENDIF
2414	!
2415	!-- ***************************************!
2416	!-- Run SALSA !
2417	!-- ***************************************!
2418	CALL run_salsa( in_p(k), in_cw(k), in_cs(k), in_t(k), in_u(k), &
2419	in_adn(k), in_lad, zgso4, zgocnv, zgocsv, zghno3, zgnh3,&
2420	aero, prtcl, kvis(k), Sc(k,:), vd(k,:), dt_salsa )
2421	!-- ***************************************!
2422	IF ( lsdepo ) sedim_vd(k,j,i,:) = vd(k,:)
2423	!
2424	!-- Calculate changes in concentrations
2425	DO bb = 1, nbins
2426	aerosol_number(bb)%conc(k,j,i) = aerosol_number(bb)%conc(k,j,i) &
2427	+ ( aero(bb)%numc - aero_old(bb)%numc ) * flag
2428	ENDDO
2429
2430	IF ( iso4 > 0 ) THEN
2431	vc = 1
2432	str = ( iso4-1 ) * nbins + 1
2433	endi = iso4 * nbins
2434	cc = 1
2435	DO ss = str, endi
2436	aerosol_mass(ss)%conc(k,j,i) = aerosol_mass(ss)%conc(k,j,i) &
2437	+ ( aero(cc)%volc(vc) - aero_old(cc)%volc(vc) ) &
2438	* arhoh2so4 * flag
2439	cc = cc+1
2440	ENDDO
2441	ENDIF
2442
2443	IF ( ioc > 0 ) THEN
2444	vc = 2
2445	str = ( ioc-1 ) * nbins + 1
2446	endi = ioc * nbins
2447	cc = 1
2448	DO ss = str, endi
2449	aerosol_mass(ss)%conc(k,j,i) = aerosol_mass(ss)%conc(k,j,i) &
2450	+ ( aero(cc)%volc(vc) - aero_old(cc)%volc(vc) ) &
2451	* arhooc * flag
2452	cc = cc+1
2453	ENDDO
2454	ENDIF
2455
2456	IF ( ibc > 0 ) THEN
2457	vc = 3
2458	str = ( ibc-1 ) * nbins + 1 + fn1a
2459	endi = ibc * nbins
2460	cc = 1 + fn1a
2461	DO ss = str, endi
2462	aerosol_mass(ss)%conc(k,j,i) = aerosol_mass(ss)%conc(k,j,i) &
2463	+ ( aero(cc)%volc(vc) - aero_old(cc)%volc(vc) ) &
2464	* arhobc * flag
2465	cc = cc+1
2466	ENDDO
2467	ENDIF
2468
2469	IF ( idu > 0 ) THEN
2470	vc = 4
2471	str = ( idu-1 ) * nbins + 1 + fn1a
2472	endi = idu * nbins
2473	cc = 1 + fn1a
2474	DO ss = str, endi
2475	aerosol_mass(ss)%conc(k,j,i) = aerosol_mass(ss)%conc(k,j,i) &
2476	+ ( aero(cc)%volc(vc) - aero_old(cc)%volc(vc) ) &
2477	* arhodu * flag
2478	cc = cc+1
2479	ENDDO
2480	ENDIF
2481
2482	IF ( iss > 0 ) THEN
2483	vc = 5
2484	str = ( iss-1 ) * nbins + 1 + fn1a
2485	endi = iss * nbins
2486	cc = 1 + fn1a
2487	DO ss = str, endi
2488	aerosol_mass(ss)%conc(k,j,i) = aerosol_mass(ss)%conc(k,j,i) &
2489	+ ( aero(cc)%volc(vc) - aero_old(cc)%volc(vc) ) &
2490	* arhoss * flag
2491	cc = cc+1
2492	ENDDO
2493	ENDIF
2494
2495	IF ( ino > 0 ) THEN
2496	vc = 6
2497	str = ( ino-1 ) * nbins + 1
2498	endi = ino * nbins
2499	cc = 1
2500	DO ss = str, endi
2501	aerosol_mass(ss)%conc(k,j,i) = aerosol_mass(ss)%conc(k,j,i) &
2502	+ ( aero(cc)%volc(vc) - aero_old(cc)%volc(vc) ) &
2503	* arhohno3 * flag
2504	cc = cc+1
2505	ENDDO
2506	ENDIF
2507
2508	IF ( inh > 0 ) THEN
2509	vc = 7
2510	str = ( ino-1 ) * nbins + 1
2511	endi = ino * nbins
2512	cc = 1
2513	DO ss = str, endi
2514	aerosol_mass(ss)%conc(k,j,i) = aerosol_mass(ss)%conc(k,j,i) &
2515	+ ( aero(cc)%volc(vc) - aero_old(cc)%volc(vc) ) &
2516	* arhonh3 * flag
2517	cc = cc+1
2518	ENDDO
2519	ENDIF
2520
2521	IF ( advect_particle_water ) THEN
2522	nc_h2o = get_index( prtcl,'H2O' )
2523	vc = 8
2524	str = ( nc_h2o-1 ) * nbins + 1
2525	endi = nc_h2o * nbins
2526	cc = 1
2527	DO ss = str, endi
2528	aerosol_mass(ss)%conc(k,j,i) = aerosol_mass(ss)%conc(k,j,i) &
2529	+ ( aero(cc)%volc(vc) - aero_old(cc)%volc(vc) ) &
2530	* arhoh2o * flag
2531	IF ( prunmode == 1 ) THEN
2532	aerosol_mass(ss)%init(k) = MAX( aerosol_mass(ss)%init(k), &
2533	aerosol_mass(ss)%conc(k,j,i) )
2534	ENDIF
2535	cc = cc+1
2536	ENDDO
2537	ENDIF
2538
2539	!-- Condensation of precursor gases
2540	IF ( lscndgas ) THEN
2541	IF ( salsa_gases_from_chem ) THEN
2542	!
2543	!-- SO4 (or H2SO4)
2544	chem_species( gas_index_chem(1) )%conc(k,j,i) = &
2545	chem_species( gas_index_chem(1) )%conc(k,j,i) + &
2546	( zgso4 / ppm_to_nconc(k) - &
2547	chem_species( gas_index_chem(1) )%conc(k,j,i) ) * flag
2548	!
2549	!-- HNO3
2550	chem_species( gas_index_chem(2) )%conc(k,j,i) = &
2551	chem_species( gas_index_chem(2) )%conc(k,j,i) + &
2552	( zghno3 / ppm_to_nconc(k) - &
2553	chem_species( gas_index_chem(2) )%conc(k,j,i) ) * flag
2554	!
2555	!-- NH3
2556	chem_species( gas_index_chem(3) )%conc(k,j,i) = &
2557	chem_species( gas_index_chem(3) )%conc(k,j,i) + &
2558	( zgnh3 / ppm_to_nconc(k) - &
2559	chem_species( gas_index_chem(3) )%conc(k,j,i) ) * flag
2560	!
2561	!-- non-volatile OC
2562	chem_species( gas_index_chem(4) )%conc(k,j,i) = &
2563	chem_species( gas_index_chem(4) )%conc(k,j,i) + &
2564	( zgocnv / ppm_to_nconc(k) - &
2565	chem_species( gas_index_chem(4) )%conc(k,j,i) ) * flag
2566	!
2567	!-- semi-volatile OC
2568	chem_species( gas_index_chem(5) )%conc(k,j,i) = &
2569	chem_species( gas_index_chem(5) )%conc(k,j,i) + &
2570	( zgocsv / ppm_to_nconc(k) - &
2571	chem_species( gas_index_chem(5) )%conc(k,j,i) ) * flag
2572
2573	ELSE
2574	!
2575	!-- SO4 (or H2SO4)
2576	salsa_gas(1)%conc(k,j,i) = salsa_gas(1)%conc(k,j,i) + ( zgso4 - &
2577	salsa_gas(1)%conc(k,j,i) ) * flag
2578	!
2579	!-- HNO3
2580	salsa_gas(2)%conc(k,j,i) = salsa_gas(2)%conc(k,j,i) + ( zghno3 - &
2581	salsa_gas(2)%conc(k,j,i) ) * flag
2582	!
2583	!-- NH3
2584	salsa_gas(3)%conc(k,j,i) = salsa_gas(3)%conc(k,j,i) + ( zgnh3 - &
2585	salsa_gas(3)%conc(k,j,i) ) * flag
2586	!
2587	!-- non-volatile OC
2588	salsa_gas(4)%conc(k,j,i) = salsa_gas(4)%conc(k,j,i) + ( zgocnv - &
2589	salsa_gas(4)%conc(k,j,i) ) * flag
2590	!
2591	!-- semi-volatile OC
2592	salsa_gas(5)%conc(k,j,i) = salsa_gas(5)%conc(k,j,i) + ( zgocsv - &
2593	salsa_gas(5)%conc(k,j,i) ) * flag
2594	ENDIF
2595	ENDIF
2596	!
2597	!-- Tendency of water vapour mixing ratio is obtained from the
2598	!-- change in RH during SALSA run. This releases heat and changes pt.
2599	!-- Assumes no temperature change during SALSA run.
2600	!-- q = r / (1+r), Euler method for integration
2601	!
2602	IF ( feedback_to_palm ) THEN
2603	q_p(k,j,i) = q_p(k,j,i) + 1.0_wp / ( in_cw(k) * in_adn(k) + 1.0_wp ) &
2604	** 2.0_wp * ( in_cw(k) - cw_old ) * in_adn(k)
2605	pt_p(k,j,i) = pt_p(k,j,i) + alv / c_p * ( in_cw(k) - cw_old ) * &
2606	in_adn(k) / ( in_cw(k) / in_adn(k) + 1.0_wp ) ** 2.0_wp&
2607	* pt_p(k,j,i) / in_t(k)
2608	ENDIF
2609
2610	ENDDO ! k
2611	!
2612	!-- Set surfaces and wall fluxes due to deposition
2613	IF ( lsdepo_topo .AND. prunmode == 3 ) THEN
2614	IF ( .NOT. land_surface .AND. .NOT. urban_surface ) THEN
2615	CALL depo_topo( i, j, surf_def_h(0), vd, Sc, kvis, in_u, rho_air_zw )
2616	DO l = 0, 3
2617	CALL depo_topo( i, j, surf_def_v(l), vd, Sc, kvis, in_u, &
2618	rho_air_zw**0.0_wp )
2619	ENDDO
2620	ELSE
2621	CALL depo_topo( i, j, surf_usm_h, vd, Sc, kvis, in_u, rho_air_zw )
2622	DO l = 0, 3
2623	CALL depo_topo( i, j, surf_usm_v(l), vd, Sc, kvis, in_u, &
2624	rho_air_zw**0.0_wp )
2625	ENDDO
2626	CALL depo_topo( i, j, surf_lsm_h, vd, Sc, kvis, in_u, rho_air_zw )
2627	DO l = 0, 3
2628	CALL depo_topo( i, j, surf_lsm_v(l), vd, Sc, kvis, in_u, &
2629	rho_air_zw**0.0_wp )
2630	ENDDO
2631	ENDIF
2632	ENDIF
2633
2634	END SUBROUTINE salsa_driver
2635
2636	!------------------------------------------------------------------------------!
2637	! Description:
2638	! ------------
2639	!> The SALSA subroutine
2640	!> Modified for the new aerosol datatype,
2641	!> Juha Tonttila, FMI, 2014.
2642	!> Only aerosol processes included, Mona Kurppa, UHel, 2017
2643	!------------------------------------------------------------------------------!
2644	SUBROUTINE run_salsa( ppres, pcw, pcs, ptemp, mag_u, adn, lad, pc_h2so4, &
2645	pc_ocnv, pc_ocsv, pc_hno3, pc_nh3, paero, prtcl, kvis, &
2646	Sc, vc, ptstep )
2647
2648	IMPLICIT NONE
2649	!
2650	!-- Input parameters and variables
2651	REAL(wp), INTENT(in) :: adn !< air density (kg/m3)
2652	REAL(wp), INTENT(in) :: lad !< leaf area density (m2/m3)
2653	REAL(wp), INTENT(in) :: mag_u !< magnitude of wind (m/s)
2654	REAL(wp), INTENT(in) :: ppres !< atmospheric pressure at each grid
2655	!< point (Pa)
2656	REAL(wp), INTENT(in) :: ptemp !< temperature at each grid point (K)
2657	REAL(wp), INTENT(in) :: ptstep !< time step of salsa processes (s)
2658	TYPE(component_index), INTENT(in) :: prtcl !< part. component index table
2659	!
2660	!-- Input variables that are changed within:
2661	REAL(wp), INTENT(inout) :: kvis !< kinematic viscosity of air (m2/s)
2662	REAL(wp), INTENT(inout) :: Sc(:) !< particle Schmidt number
2663	REAL(wp), INTENT(inout) :: vc(:) !< particle fall speed (m/s,
2664	!< sedimentation velocity)
2665	!-- Gas phase concentrations at each grid point (#/m3)
2666	REAL(wp), INTENT(inout) :: pc_h2so4 !< sulphuric acid
2667	REAL(wp), INTENT(inout) :: pc_hno3 !< nitric acid
2668	REAL(wp), INTENT(inout) :: pc_nh3 !< ammonia
2669	REAL(wp), INTENT(inout) :: pc_ocnv !< nonvolatile OC
2670	REAL(wp), INTENT(inout) :: pc_ocsv !< semivolatile OC
2671	REAL(wp), INTENT(inout) :: pcs !< Saturation concentration of water
2672	!< vapour (kg/m3)
2673	REAL(wp), INTENT(inout) :: pcw !< Water vapour concentration (kg/m3)
2674	TYPE(t_section), INTENT(inout) :: paero(fn2b)
2675	!
2676	!-- Coagulation
2677	IF ( lscoag ) THEN
2678	CALL coagulation( paero, ptstep, ptemp, ppres )
2679	ENDIF
2680	!
2681	!-- Condensation
2682	IF ( lscnd ) THEN
2683	CALL condensation( paero, pc_h2so4, pc_ocnv, pc_ocsv, pc_hno3, pc_nh3, &
2684	pcw, pcs, ptemp, ppres, ptstep, prtcl )
2685	ENDIF
2686	!
2687	!-- Deposition
2688	IF ( lsdepo ) THEN
2689	CALL deposition( paero, ptemp, adn, mag_u, lad, kvis, Sc, vc )
2690	ENDIF
2691	!
2692	!-- Size distribution bin update
2693	!-- Mona: why done 3 times in SALSA-standalone?
2694	IF ( lsdistupdate ) THEN
2695	CALL distr_update( paero )
2696	ENDIF
2697
2698	END SUBROUTINE run_salsa
2699
2700	!------------------------------------------------------------------------------!
2701	! Description:
2702	! ------------
2703	!> Set logical switches according to the host model state and user-specified
2704	!> NAMELIST options.
2705	!> Juha Tonttila, FMI, 2014
2706	!> Only aerosol processes included, Mona Kurppa, UHel, 2017
2707	!------------------------------------------------------------------------------!
2708	SUBROUTINE set_salsa_runtime( prunmode )
2709
2710	IMPLICIT NONE
2711
2712	INTEGER(iwp), INTENT(in) :: prunmode
2713
2714	SELECT CASE(prunmode)
2715
2716	CASE(1) !< Initialization
2717	lscoag = .FALSE.
2718	lscnd = .FALSE.
2719	lscndgas = .FALSE.
2720	lscndh2oae = .FALSE.
2721	lsdepo = .FALSE.
2722	lsdepo_vege = .FALSE.
2723	lsdepo_topo = .FALSE.
2724	lsdistupdate = .TRUE.
2725
2726	CASE(2) !< Spinup period
2727	lscoag = ( .FALSE. .AND. nlcoag )
2728	lscnd = ( .TRUE. .AND. nlcnd )
2729	lscndgas = ( .TRUE. .AND. nlcndgas )
2730	lscndh2oae = ( .TRUE. .AND. nlcndh2oae )
2731
2732	CASE(3) !< Run
2733	lscoag = nlcoag
2734	lscnd = nlcnd
2735	lscndgas = nlcndgas
2736	lscndh2oae = nlcndh2oae
2737	lsdepo = nldepo
2738	lsdepo_vege = nldepo_vege
2739	lsdepo_topo = nldepo_topo
2740	lsdistupdate = nldistupdate
2741
2742	END SELECT
2743
2744
2745	END SUBROUTINE set_salsa_runtime
2746
2747	!------------------------------------------------------------------------------!
2748	! Description:
2749	! ------------
2750	!> Calculates the absolute temperature (using hydrostatic pressure), saturation
2751	!> vapour pressure and mixing ratio over water, relative humidity and air
2752	!> density needed in the SALSA model.
2753	!> NOTE, no saturation adjustment takes place -> the resulting water vapour
2754	!> mixing ratio can be supersaturated, allowing the microphysical calculations
2755	!> in SALSA.
2756	!
2757	!> Juha Tonttila, FMI, 2014 (original SALSAthrm)
2758	!> Mona Kurppa, UHel, 2017 (adjustment for PALM and only aerosol processes)
2759	!------------------------------------------------------------------------------!
2760	SUBROUTINE salsa_thrm_ij( i, j, p_ij, temp_ij, cw_ij, cs_ij, adn_ij )
2761
2762	USE arrays_3d, &
2763	ONLY: p, pt, q, zu
2764
2765	USE basic_constants_and_equations_mod, &
2766	ONLY: barometric_formula, exner_function, ideal_gas_law_rho, magnus
2767
2768	USE control_parameters, &
2769	ONLY: pt_surface, surface_pressure
2770
2771	IMPLICIT NONE
2772
2773	INTEGER(iwp), INTENT(in) :: i
2774	INTEGER(iwp), INTENT(in) :: j
2775	REAL(wp), DIMENSION(:), INTENT(inout) :: adn_ij
2776	REAL(wp), DIMENSION(:), INTENT(inout) :: p_ij
2777	REAL(wp), DIMENSION(:), INTENT(inout) :: temp_ij
2778	REAL(wp), DIMENSION(:), INTENT(inout), OPTIONAL :: cw_ij
2779	REAL(wp), DIMENSION(:), INTENT(inout), OPTIONAL :: cs_ij
2780	REAL(wp), DIMENSION(nzb:nzt+1) :: e_s !< saturation vapour pressure
2781	!< over water (Pa)
2782	REAL(wp) :: t_surface !< absolute surface temperature (K)
2783	!
2784	!-- Pressure p_ijk (Pa) = hydrostatic pressure + perturbation pressure (p)
2785	t_surface = pt_surface * exner_function( surface_pressure )
2786	p_ij(:) = 100.0_wp * barometric_formula( zu, t_surface, surface_pressure ) &
2787	+ p(:,j,i)
2788	!
2789	!-- Absolute ambient temperature (K)
2790	temp_ij(:) = pt(:,j,i) * exner_function( p_ij(:) )
2791	!
2792	!-- Air density
2793	adn_ij(:) = ideal_gas_law_rho( p_ij(:), temp_ij(:) )
2794	!
2795	!-- Water vapour concentration r_v (kg/m3)
2796	IF ( PRESENT( cw_ij ) ) THEN
2797	cw_ij(:) = ( q(:,j,i) / ( 1.0_wp - q(:,j,i) ) ) * adn_ij(:)
2798	ENDIF
2799	!
2800	!-- Saturation mixing ratio r_s (kg/kg) from vapour pressure at temp (Pa)
2801	IF ( PRESENT( cs_ij ) ) THEN
2802	e_s(:) = magnus( temp_ij(:) )
2803	cs_ij(:) = ( 0.622_wp * e_s / ( p_ij(:) - e_s(:) ) ) * adn_ij(:)
2804	ENDIF
2805
2806	END SUBROUTINE salsa_thrm_ij
2807
2808	!------------------------------------------------------------------------------!
2809	! Description:
2810	! ------------
2811	!> Calculates ambient sizes of particles by equilibrating soluble fraction of
2812	!> particles with water using the ZSR method (Stokes and Robinson, 1966).
2813	!> Method:
2814	!> Following chemical components are assumed water-soluble
2815	!> - (ammonium) sulphate (100%)
2816	!> - sea salt (100 %)
2817	!> - organic carbon (epsoc * 100%)
2818	!> Exact thermodynamic considerations neglected.
2819	!> - If particles contain no sea salt, calculation according to sulphate
2820	!> properties
2821	!> - If contain sea salt but no sulphate, calculation according to sea salt
2822	!> properties
2823	!> - If contain both sulphate and sea salt -> the molar fraction of these
2824	!> compounds determines which one of them is used as the basis of calculation.
2825	!> If sulphate and sea salt coexist in a particle, it is assumed that the Cl is
2826	!> replaced by sulphate; thus only either sulphate + organics or sea salt +
2827	!> organics is included in the calculation of soluble fraction.
2828	!> Molality parameterizations taken from Table 1 of Tang: Thermodynamic and
2829	!> optical properties of mixed-salt aerosols of atmospheric importance,
2830	!> J. Geophys. Res., 102 (D2), 1883-1893 (1997)
2831	!
2832	!> Coded by:
2833	!> Hannele Korhonen (FMI) 2005
2834	!> Harri Kokkola (FMI) 2006
2835	!> Matti Niskanen(FMI) 2012
2836	!> Anton Laakso (FMI) 2013
2837	!> Modified for the new aerosol datatype, Juha Tonttila (FMI) 2014
2838	!
2839	!> fxm: should sea salt form a solid particle when prh is very low (even though
2840	!> it could be mixed with e.g. sulphate)?
2841	!> fxm: crashes if no sulphate or sea salt
2842	!> fxm: do we really need to consider Kelvin effect for subrange 2
2843	!------------------------------------------------------------------------------!
2844	SUBROUTINE equilibration( prh, ptemp, paero, init )
2845
2846	IMPLICIT NONE
2847	!
2848	!-- Input variables
2849	LOGICAL, INTENT(in) :: init !< TRUE: Initialization call
2850	!< FALSE: Normal runtime: update water
2851	!< content only for 1a
2852	REAL(wp), INTENT(in) :: prh !< relative humidity [0-1]
2853	REAL(wp), INTENT(in) :: ptemp !< temperature (K)
2854	!
2855	!-- Output variables
2856	TYPE(t_section), INTENT(inout) :: paero(fn2b)
2857	!
2858	!-- Local
2859	INTEGER(iwp) :: b !< loop index
2860	INTEGER(iwp) :: counti !< loop index
2861	REAL(wp) :: zaw !< water activity [0-1]
2862	REAL(wp) :: zbinmol(7) !< binary molality of each components (mol/kg)
2863	REAL(wp) :: zcore !< Volume of dry particle
2864	REAL(wp) :: zdold !< Old diameter
2865	REAL(wp) :: zdwet !< Wet diameter or mean droplet diameter
2866	REAL(wp) :: zke !< Kelvin term in the KÃ¶hler equation
2867	REAL(wp) :: zlwc !< liquid water content [kg/m3-air]
2868	REAL(wp) :: zrh !< Relative humidity
2869	REAL(wp) :: zvpart(7) !< volume of chem. compounds in one particle
2870
2871	zaw = 0.0_wp
2872	zbinmol = 0.0_wp
2873	zcore = 0.0_wp
2874	zdold = 0.0_wp
2875	zdwet = 0.0_wp
2876	zlwc = 0.0_wp
2877	zrh = 0.0_wp
2878
2879	!
2880	!-- Relative humidity:
2881	zrh = prh
2882	zrh = MAX( zrh, 0.05_wp )
2883	zrh = MIN( zrh, 0.98_wp)
2884	!
2885	!-- 1) Regime 1: sulphate and partly water-soluble OC. Done for every CALL
2886	DO b = in1a, fn1a ! size bin
2887
2888	zbinmol = 0.0_wp
2889	zdold = 1.0_wp
2890	zke = 1.02_wp
2891
2892	IF ( paero(b)%numc > nclim ) THEN
2893	!
2894	!-- Volume in one particle
2895	zvpart = 0.0_wp
2896	zvpart(1:2) = paero(b)%volc(1:2) / paero(b)%numc
2897	zvpart(6:7) = paero(b)%volc(6:7) / paero(b)%numc
2898	!
2899	!-- Total volume and wet diameter of one dry particle
2900	zcore = SUM( zvpart(1:2) )
2901	zdwet = paero(b)%dwet
2902
2903	counti = 0
2904	DO WHILE ( ABS( zdwet / zdold - 1.0_wp ) > 1.0E-2_wp )
2905
2906	zdold = MAX( zdwet, 1.0E-20_wp )
2907	zaw = MAX( 1.0E-3_wp, zrh / zke ) ! To avoid underflow
2908	!
2909	!-- Binary molalities (mol/kg):
2910	!-- Sulphate
2911	zbinmol(1) = 1.1065495E+2_wp - 3.6759197E+2_wp * zaw &
2912	+ 5.0462934E+2_wp * zaw**2.0_wp &
2913	- 3.1543839E+2_wp * zaw**3.0_wp &
2914	+ 6.770824E+1_wp * zaw**4.0_wp
2915	!-- Organic carbon
2916	zbinmol(2) = 1.0_wp / ( zaw * amh2o ) - 1.0_wp / amh2o
2917	!-- Nitric acid
2918	zbinmol(6) = 2.306844303E+1_wp - 3.563608869E+1_wp * zaw &
2919	- 6.210577919E+1_wp * zaw**2.0_wp &
2920	+ 5.510176187E+2_wp * zaw**3.0_wp &
2921	- 1.460055286E+3_wp * zaw**4.0_wp &
2922	+ 1.894467542E+3_wp * zaw**5.0_wp &
2923	- 1.220611402E+3_wp * zaw**6.0_wp &
2924	+ 3.098597737E+2_wp * zaw**7.0_wp
2925	!
2926	!-- Calculate the liquid water content (kg/m3-air) using ZSR (see e.g.
2927	!-- Eq. 10.98 in Seinfeld and Pandis (2006))
2928	zlwc = ( paero(b)%volc(1) * ( arhoh2so4 / amh2so4 ) ) / &
2929	zbinmol(1) + epsoc * paero(b)%volc(2) * ( arhooc / amoc ) &
2930	/ zbinmol(2) + ( paero(b)%volc(6) * ( arhohno3/amhno3 ) ) &
2931	/ zbinmol(6)
2932	!
2933	!-- Particle wet diameter (m)
2934	zdwet = ( zlwc / paero(b)%numc / arhoh2o / api6 + &
2935	( SUM( zvpart(6:7) ) / api6 ) + &
2936	zcore / api6 )**( 1.0_wp / 3.0_wp )
2937	!
2938	!-- Kelvin effect (Eq. 10.85 in in Seinfeld and Pandis (2006)). Avoid
2939	!-- overflow.
2940	zke = EXP( MIN( 50.0_wp, &
2941	4.0_wp * surfw0 * amvh2so4 / ( abo * ptemp * zdwet ) ) )
2942
2943	counti = counti + 1
2944	IF ( counti > 1000 ) THEN
2945	message_string = 'Subrange 1: no convergence!'
2946	CALL message( 'salsa_mod: equilibration', 'SA0042', &
2947	1, 2, 0, 6, 0 )
2948	ENDIF
2949	ENDDO
2950	!
2951	!-- Instead of lwc, use the volume concentration of water from now on
2952	!-- (easy to convert...)
2953	paero(b)%volc(8) = zlwc / arhoh2o
2954	!
2955	!-- If this is initialization, update the core and wet diameter
2956	IF ( init ) THEN
2957	paero(b)%dwet = zdwet
2958	paero(b)%core = zcore
2959	ENDIF
2960
2961	ELSE
2962	!-- If initialization
2963	!-- 1.2) empty bins given bin average values
2964	IF ( init ) THEN
2965	paero(b)%dwet = paero(b)%dmid
2966	paero(b)%core = api6 * paero(b)%dmid ** 3.0_wp
2967	ENDIF
2968
2969	ENDIF
2970
2971	ENDDO !< b
2972	!
2973	!-- 2) Regime 2a: sulphate, OC, BC and sea salt
2974	!-- This is done only for initialization call, otherwise the water contents
2975	!-- are computed via condensation
2976	IF ( init ) THEN
2977	DO b = in2a, fn2b
2978
2979	!-- Initialize
2980	zke = 1.02_wp
2981	zbinmol = 0.0_wp
2982	zdold = 1.0_wp
2983	!
2984	!-- 1) Particle properties calculated for non-empty bins
2985	IF ( paero(b)%numc > nclim ) THEN
2986	!
2987	!-- Volume in one particle [fxm]
2988	zvpart = 0.0_wp
2989	zvpart(1:7) = paero(b)%volc(1:7) / paero(b)%numc
2990	!
2991	!-- Total volume and wet diameter of one dry particle [fxm]
2992	zcore = SUM( zvpart(1:5) )
2993	zdwet = paero(b)%dwet
2994
2995	counti = 0
2996	DO WHILE ( ABS( zdwet / zdold - 1.0_wp ) > 1.0E-12_wp )
2997
2998	zdold = MAX( zdwet, 1.0E-20_wp )
2999	zaw = zrh / zke
3000	!
3001	!-- Binary molalities (mol/kg):
3002	!-- Sulphate
3003	zbinmol(1) = 1.1065495E+2_wp - 3.6759197E+2_wp * zaw &
3004	+ 5.0462934E+2_wp * zaw*2 - 3.1543839E+2_wp zaw**3 &
3005	+ 6.770824E+1_wp * zaw**4
3006	!-- Organic carbon
3007	zbinmol(2) = 1.0_wp / ( zaw * amh2o ) - 1.0_wp / amh2o
3008	!-- Nitric acid
3009	zbinmol(6) = 2.306844303E+1_wp - 3.563608869E+1_wp * zaw &
3010	- 6.210577919E+1_wp * zaw*2 + 5.510176187E+2_wp zaw**3 &
3011	- 1.460055286E+3_wp * zaw*4 + 1.894467542E+3_wp zaw**5 &
3012	- 1.220611402E+3_wp * zaw*6 + 3.098597737E+2_wp zaw**7
3013	!-- Sea salt (natrium chloride)
3014	zbinmol(5) = 5.875248E+1_wp - 1.8781997E+2_wp * zaw &
3015	+ 2.7211377E+2_wp * zaw*2 - 1.8458287E+2_wp zaw**3 &
3016	+ 4.153689E+1_wp * zaw**4
3017	!
3018	!-- Calculate the liquid water content (kg/m3-air)
3019	zlwc = ( paero(b)%volc(1) * ( arhoh2so4 / amh2so4 ) ) / &
3020	zbinmol(1) + epsoc * ( paero(b)%volc(2) * ( arhooc / &
3021	amoc ) ) / zbinmol(2) + ( paero(b)%volc(6) * ( arhohno3 &
3022	/ amhno3 ) ) / zbinmol(6) + ( paero(b)%volc(5) * &
3023	( arhoss / amss ) ) / zbinmol(5)
3024
3025	!-- Particle wet radius (m)
3026	zdwet = ( zlwc / paero(b)%numc / arhoh2o / api6 + &
3027	( SUM( zvpart(6:7) ) / api6 ) + &
3028	zcore / api6 ) ** ( 1.0_wp / 3.0_wp )
3029	!
3030	!-- Kelvin effect (Eq. 10.85 in Seinfeld and Pandis (2006))
3031	zke = EXP( MIN( 50.0_wp, &
3032	4.0_wp * surfw0 * amvh2so4 / ( abo * zdwet * ptemp ) ) )
3033
3034	counti = counti + 1
3035	IF ( counti > 1000 ) THEN
3036	message_string = 'Subrange 2: no convergence!'
3037	CALL message( 'salsa_mod: equilibration', 'SA0043', &
3038	1, 2, 0, 6, 0 )
3039	ENDIF
3040	ENDDO
3041	!
3042	!-- Liquid water content; instead of LWC use the volume concentration
3043	paero(b)%volc(8) = zlwc / arhoh2o
3044	paero(b)%dwet = zdwet
3045	paero(b)%core = zcore
3046
3047	ELSE
3048	!-- 2.2) empty bins given bin average values
3049	paero(b)%dwet = paero(b)%dmid
3050	paero(b)%core = api6 * paero(b)%dmid ** 3.0_wp
3051	ENDIF
3052
3053	ENDDO ! b
3054	ENDIF
3055
3056	END SUBROUTINE equilibration
3057
3058	!------------------------------------------------------------------------------!
3059	!> Description:
3060	!> ------------
3061	!> Calculation of the settling velocity vc (m/s) per aerosol size bin and
3062	!> deposition on plant canopy (lsdepo_vege).
3063	!
3064	!> Deposition is based on either the scheme presented in:
3065	!> Zhang et al. (2001), Atmos. Environ. 35, 549-560 (includes collection due to
3066	!> Brownian diffusion, impaction, interception and sedimentation)
3067	!> OR
3068	!> Petroff & Zhang (2010), Geosci. Model Dev. 3, 753-769 (includes also
3069	!> collection due to turbulent impaction)
3070	!
3071	!> Equation numbers refer to equation in Jacobson (2005): Fundamentals of
3072	!> Atmospheric Modeling, 2nd Edition.
3073	!
3074	!> Subroutine follows closely sedim_SALSA in UCLALES-SALSA written by Juha
3075	!> Tonttila (KIT/FMI) and Zubair Maalick (UEF).
3076	!> Rewritten to PALM by Mona Kurppa (UH), 2017.
3077	!
3078	!> Call for grid point i,j,k
3079	!------------------------------------------------------------------------------!
3080
3081	SUBROUTINE deposition( paero, tk, adn, mag_u, lad, kvis, Sc, vc )
3082
3083	USE plant_canopy_model_mod, &
3084	ONLY: cdc
3085
3086	IMPLICIT NONE
3087
3088	REAL(wp), INTENT(in) :: adn !< air density (kg/m3)
3089	REAL(wp), INTENT(out) :: kvis !< kinematic viscosity of air (m2/s)
3090	REAL(wp), INTENT(in) :: lad !< leaf area density (m2/m3)
3091	REAL(wp), INTENT(in) :: mag_u !< wind velocity (m/s)
3092	REAL(wp), INTENT(out) :: Sc(:) !< particle Schmidt number
3093	REAL(wp), INTENT(in) :: tk !< abs.temperature (K)
3094	REAL(wp), INTENT(out) :: vc(:) !< critical fall speed i.e. settling
3095	!< velocity of an aerosol particle (m/s)
3096	TYPE(t_section), INTENT(inout) :: paero(fn2b)
3097
3098	INTEGER(iwp) :: b !< loop index
3099	INTEGER(iwp) :: c !< loop index
3100	REAL(wp) :: avis !< molecular viscocity of air (kg/(m*s))
3101	REAL(wp), PARAMETER :: c_A = 1.249_wp !< Constants A, B and C for
3102	REAL(wp), PARAMETER :: c_B = 0.42_wp !< calculating the Cunningham
3103	REAL(wp), PARAMETER :: c_C = 0.87_wp !< slip-flow correction (Cc)
3104	!< according to Jacobson (2005),
3105	!< Eq. 15.30
3106	REAL(wp) :: Cc !< Cunningham slip-flow correction factor
3107	REAL(wp) :: Kn !< Knudsen number
3108	REAL(wp) :: lambda !< molecular mean free path (m)
3109	REAL(wp) :: mdiff !< particle diffusivity coefficient
3110	REAL(wp) :: pdn !< particle density (kg/m3)
3111	REAL(wp) :: ustar !< friction velocity (m/s)
3112	REAL(wp) :: va !< thermal speed of an air molecule (m/s)
3113	REAL(wp) :: zdwet !< wet diameter (m)
3114	!
3115	!-- Initialise
3116	Cc = 0.0_wp
3117	Kn = 0.0_wp
3118	mdiff = 0.0_wp
3119	pdn = 1500.0_wp ! default value
3120	ustar = 0.0_wp
3121	!
3122	!-- Molecular viscosity of air (Eq. 4.54)
3123	avis = 1.8325E-5_wp * ( 416.16_wp / ( tk + 120.0_wp ) ) * ( tk / &
3124	296.16_wp )**1.5_wp
3125	!
3126	!-- Kinematic viscosity (Eq. 4.55)
3127	kvis = avis / adn
3128	!
3129	!-- Thermal velocity of an air molecule (Eq. 15.32)
3130	va = SQRT( 8.0_wp * abo * tk / ( pi * am_airmol ) )
3131	!
3132	!-- Mean free path (m) (Eq. 15.24)
3133	lambda = 2.0_wp * avis / ( adn * va )
3134
3135	DO b = 1, nbins
3136
3137	IF ( paero(b)%numc < nclim ) CYCLE
3138	zdwet = paero(b)%dwet
3139	!
3140	!-- Knudsen number (Eq. 15.23)
3141	Kn = MAX( 1.0E-2_wp, lambda / ( zdwet * 0.5_wp ) ) ! To avoid underflow
3142	!
3143	!-- Cunningham slip-flow correction (Eq. 15.30)
3144	Cc = 1.0_wp + Kn * ( c_A + c_B * EXP( -c_C / Kn ) )
3145
3146	!-- Particle diffusivity coefficient (Eq. 15.29)
3147	mdiff = ( abo * tk * Cc ) / ( 3.0_wp * pi * avis * zdwet )
3148	!
3149	!-- Particle Schmidt number (Eq. 15.36)
3150	Sc(b) = kvis / mdiff
3151	!
3152	!-- Critical fall speed i.e. settling velocity (Eq. 20.4)
3153	vc(b) = MIN( 1.0_wp, terminal_vel( 0.5_wp * zdwet, pdn, adn, avis, Cc) )
3154
3155	IF ( lsdepo_vege .AND. plant_canopy .AND. lad > 0.0_wp ) THEN
3156	!
3157	!-- Friction velocity calculated following Prandtl (1925):
3158	ustar = SQRT( cdc ) * mag_u
3159	CALL depo_vege( paero, b, vc(b), mag_u, ustar, kvis, Sc(b), lad )
3160	ENDIF
3161	ENDDO
3162
3163	END SUBROUTINE deposition
3164
3165	!------------------------------------------------------------------------------!
3166	! Description:
3167	! ------------
3168	!> Calculate change in number and volume concentrations due to deposition on
3169	!> plant canopy.
3170	!------------------------------------------------------------------------------!
3171	SUBROUTINE depo_vege( paero, b, vc, mag_u, ustar, kvis_a, Sc, lad )
3172
3173	IMPLICIT NONE
3174
3175	INTEGER(iwp), INTENT(in) :: b !< loop index
3176	REAL(wp), INTENT(in) :: kvis_a !< kinematic viscosity of air (m2/s)
3177	REAL(wp), INTENT(in) :: lad !< leaf area density (m2/m3)
3178	REAL(wp), INTENT(in) :: mag_u !< wind velocity (m/s)
3179	REAL(wp), INTENT(in) :: Sc !< particle Schmidt number
3180	REAL(wp), INTENT(in) :: ustar !< friction velocity (m/s)
3181	REAL(wp), INTENT(in) :: vc !< terminal velocity (m/s)
3182	TYPE(t_section), INTENT(inout) :: paero(fn2b)
3183
3184	INTEGER(iwp) :: c !< loop index
3185	REAL(wp), PARAMETER :: c_A = 1.249_wp !< Constants A, B and C for
3186	REAL(wp), PARAMETER :: c_B = 0.42_wp !< calculating the Cunningham
3187	REAL(wp), PARAMETER :: c_C = 0.87_wp !< slip-flow correction (Cc)
3188	!< according to Jacobson (2005),
3189	!< Eq. 15.30
3190	REAL(wp) :: alpha !< parameter, Table 3 in Zhang et al. (2001)
3191	REAL(wp) :: depo !< deposition efficiency
3192	REAL(wp) :: C_Br !< coefficient for Brownian diffusion
3193	REAL(wp) :: C_IM !< coefficient for inertial impaction
3194	REAL(wp) :: C_IN !< coefficient for interception
3195	REAL(wp) :: C_IT !< coefficient for turbulent impaction
3196	REAL(wp) :: gamma !< parameter, Table 3 in Zhang et al. (2001)
3197	REAL(wp) :: par_A !< parameter A for the characteristic radius of
3198	!< collectors, Table 3 in Zhang et al. (2001)
3199	REAL(wp) :: rt !< the overall quasi-laminar resistance for
3200	!< particles
3201	REAL(wp) :: St !< Stokes number for smooth surfaces or bluff
3202	!< surface elements
3203	REAL(wp) :: tau_plus !< dimensionless particle relaxation time
3204	REAL(wp) :: v_bd !< deposition velocity due to Brownian diffusion
3205	REAL(wp) :: v_im !< deposition velocity due to impaction
3206	REAL(wp) :: v_in !< deposition velocity due to interception
3207	REAL(wp) :: v_it !< deposition velocity due to turbulent impaction
3208	!
3209	!-- Initialise
3210	depo = 0.0_wp
3211	rt = 0.0_wp
3212	St = 0.0_wp
3213	tau_plus = 0.0_wp
3214	v_bd = 0.0_wp
3215	v_im = 0.0_wp
3216	v_in = 0.0_wp
3217	v_it = 0.0_wp
3218
3219	IF ( depo_vege_type == 'zhang2001' ) THEN
3220	!
3221	!-- Parameters for the land use category 'deciduous broadleaf trees'(Table 3)
3222	par_A = 5.0E-3_wp
3223	alpha = 0.8_wp
3224	gamma = 0.56_wp
3225	!
3226	!-- Stokes number for vegetated surfaces (Seinfeld & Pandis (2006): Eq.19.24)
3227	St = vc * ustar / ( g * par_A )
3228	!
3229	!-- The overall quasi-laminar resistance for particles (Zhang et al., Eq. 5)
3230	rt = MAX( EPSILON( 1.0_wp ), ( 3.0_wp * ustar * EXP( -St*0.5_wp ) &
3231	( Sc( -gamma ) + ( St / ( alpha + St ) )2.0_wp + &
3232	0.5_wp * ( paero(b)%dwet / par_A )**2.0_wp ) ) )
3233	depo = ( rt + vc ) * lad
3234	paero(b)%numc = paero(b)%numc - depo * paero(b)%numc * dt_salsa
3235	DO c = 1, maxspec+1
3236	paero(b)%volc(c) = paero(b)%volc(c) - depo * paero(b)%volc(c) * &
3237	dt_salsa
3238	ENDDO
3239
3240	ELSEIF ( depo_vege_type == 'petroff2010' ) THEN
3241	!
3242	!-- vd = v_BD + v_IN + v_IM + v_IT + vc
3243	!-- Deposition efficiencies from Table 1. Constants from Table 2.
3244	C_Br = 1.262_wp
3245	C_IM = 0.130_wp
3246	C_IN = 0.216_wp
3247	C_IT = 0.056_wp
3248	par_A = 0.03_wp ! Here: leaf width (m)
3249	!
3250	!-- Stokes number for vegetated surfaces (Seinfeld & Pandis (2006): Eq.19.24)
3251	St = vc * ustar / ( g * par_A )
3252	!
3253	!-- Non-dimensional relexation time of the particle on top of canopy
3254	tau_plus = vc * ustar*2.0_wp / ( kvis_a g )
3255	!
3256	!-- Brownian diffusion
3257	v_bd = mag_u * C_Br * Sc*( -2.0_wp / 3.0_wp ) &
3258	( mag_u * par_A / kvis_a )**( -0.5_wp )
3259	!
3260	!-- Interception
3261	v_in = mag_u * C_IN * paero(b)%dwet / par_A * ( 2.0_wp + LOG( 2.0_wp * &
3262	par_A / paero(b)%dwet ) )
3263	!
3264	!-- Impaction: Petroff (2009) Eq. 18
3265	v_im = mag_u * C_IM * ( St / ( St + 0.47_wp ) )**2.0_wp
3266
3267	IF ( tau_plus < 20.0_wp ) THEN
3268	v_it = 2.5E-3_wp * C_IT * tau_plus**2.0_wp
3269	ELSE
3270	v_it = C_IT
3271	ENDIF
3272	depo = ( v_bd + v_in + v_im + v_it + vc ) * lad
3273	paero(b)%numc = paero(b)%numc - depo * paero(b)%numc * dt_salsa
3274	DO c = 1, maxspec+1
3275	paero(b)%volc(c) = paero(b)%volc(c) - depo * paero(b)%volc(c) * &
3276	dt_salsa
3277	ENDDO
3278	ENDIF
3279
3280	END SUBROUTINE depo_vege
3281
3282	!------------------------------------------------------------------------------!
3283	! Description:
3284	! ------------
3285	!> Calculate deposition on horizontal and vertical surfaces. Implement as
3286	!> surface flux.
3287	!------------------------------------------------------------------------------!
3288
3289	SUBROUTINE depo_topo( i, j, surf, vc, Sc, kvis, mag_u, norm )
3290
3291	USE surface_mod, &
3292	ONLY: surf_type
3293
3294	IMPLICIT NONE
3295
3296	INTEGER(iwp), INTENT(in) :: i !< loop index
3297	INTEGER(iwp), INTENT(in) :: j !< loop index
3298	REAL(wp), INTENT(in) :: kvis(:) !< kinematic viscosity of air (m2/s)
3299	REAL(wp), INTENT(in) :: mag_u(:) !< wind velocity (m/s)
3300	REAL(wp), INTENT(in) :: norm(:) !< normalisation (usually air density)
3301	REAL(wp), INTENT(in) :: Sc(:,:) !< particle Schmidt number
3302	REAL(wp), INTENT(in) :: vc(:,:) !< terminal velocity (m/s)
3303	TYPE(surf_type), INTENT(inout) :: surf !< respective surface type
3304	INTEGER(iwp) :: b !< loop index
3305	INTEGER(iwp) :: c !< loop index
3306	INTEGER(iwp) :: k !< loop index
3307	INTEGER(iwp) :: m !< loop index
3308	INTEGER(iwp) :: surf_e !< End index of surface elements at (j,i)-gridpoint
3309	INTEGER(iwp) :: surf_s !< Start index of surface elements at (j,i)-gridpoint
3310	REAL(wp) :: alpha !< parameter, Table 3 in Zhang et al. (2001)
3311	REAL(wp) :: C_Br !< coefficient for Brownian diffusion
3312	REAL(wp) :: C_IM !< coefficient for inertial impaction
3313	REAL(wp) :: C_IN !< coefficient for interception
3314	REAL(wp) :: C_IT !< coefficient for turbulent impaction
3315	REAL(wp) :: depo !< deposition efficiency
3316	REAL(wp) :: gamma !< parameter, Table 3 in Zhang et al. (2001)
3317	REAL(wp) :: par_A !< parameter A for the characteristic radius of
3318	!< collectors, Table 3 in Zhang et al. (2001)
3319	REAL(wp) :: rt !< the overall quasi-laminar resistance for
3320	!< particles
3321	REAL(wp) :: St !< Stokes number for bluff surface elements
3322	REAL(wp) :: tau_plus !< dimensionless particle relaxation time
3323	REAL(wp) :: v_bd !< deposition velocity due to Brownian diffusion
3324	REAL(wp) :: v_im !< deposition velocity due to impaction
3325	REAL(wp) :: v_in !< deposition velocity due to interception
3326	REAL(wp) :: v_it !< deposition velocity due to turbulent impaction
3327	!
3328	!-- Initialise
3329	rt = 0.0_wp
3330	St = 0.0_wp
3331	tau_plus = 0.0_wp
3332	v_bd = 0.0_wp
3333	v_im = 0.0_wp
3334	v_in = 0.0_wp
3335	v_it = 0.0_wp
3336	surf_s = surf%start_index(j,i)
3337	surf_e = surf%end_index(j,i)
3338
3339	DO m = surf_s, surf_e
3340	k = surf%k(m)
3341	DO b = 1, nbins
3342	IF ( aerosol_number(b)%conc(k,j,i) <= nclim .OR. &
3343	Sc(k+1,b) < 1.0_wp ) CYCLE
3344
3345	IF ( depo_topo_type == 'zhang2001' ) THEN
3346	!
3347	!-- Parameters for the land use category 'urban' in Table 3
3348	alpha = 1.5_wp
3349	gamma = 0.56_wp
3350	par_A = 10.0E-3_wp
3351	!
3352	!-- Stokes number for smooth surfaces or surfaces with bluff roughness
3353	!-- elements (Seinfeld and Pandis, 2nd edition (2006): Eq. 19.23)
3354	St = MAX( 0.01_wp, vc(k+1,b) * surf%us(m) ** 2.0_wp / &
3355	( g * kvis(k+1) ) )
3356	!
3357	!-- The overall quasi-laminar resistance for particles (Eq. 5)
3358	rt = MAX( EPSILON( 1.0_wp ), ( 3.0_wp * surf%us(m) * ( &
3359	Sc(k+1,b)( -gamma ) + ( St / ( alpha + St ) )2.0_wp &
3360	+ 0.5_wp * ( Ra_dry(k,j,i,b) / par_A )*2.0_wp ) &
3361	EXP( -St**0.5_wp ) ) )
3362	depo = vc(k+1,b) + rt
3363
3364	ELSEIF ( depo_topo_type == 'petroff2010' ) THEN
3365	!
3366	!-- vd = v_BD + v_IN + v_IM + v_IT + vc
3367	!-- Deposition efficiencies from Table 1. Constants from Table 2.
3368	C_Br = 1.262_wp
3369	C_IM = 0.130_wp
3370	C_IN = 0.216_wp
3371	C_IT = 0.056_wp
3372	par_A = 0.03_wp ! Here: leaf width (m)
3373	!
3374	!-- Stokes number for smooth surfaces or surfaces with bluff roughness
3375	!-- elements (Seinfeld and Pandis, 2nd edition (2006): Eq. 19.23)
3376	St = MAX( 0.01_wp, vc(k+1,b) * surf%us(m) ** 2.0_wp / &
3377	( g * kvis(k+1) ) )
3378	!
3379	!-- Non-dimensional relexation time of the particle on top of canopy
3380	tau_plus = vc(k+1,b) * surf%us(m)*2.0_wp / ( kvis(k+1) g )
3381	!
3382	!-- Brownian diffusion
3383	v_bd = mag_u(k+1) * C_Br * Sc(k+1,b)*( -2.0_wp / 3.0_wp ) &
3384	( mag_u(k+1) * par_A / kvis(k+1) )**( -0.5_wp )
3385	!
3386	!-- Interception
3387	v_in = mag_u(k+1) * C_IN * Ra_dry(k,j,i,b)/ par_A * ( 2.0_wp + &
3388	LOG( 2.0_wp * par_A / Ra_dry(k,j,i,b) ) )
3389	!
3390	!-- Impaction: Petroff (2009) Eq. 18
3391	v_im = mag_u(k+1) * C_IM * ( St / ( St + 0.47_wp ) )**2.0_wp
3392
3393	IF ( tau_plus < 20.0_wp ) THEN
3394	v_it = 2.5E-3_wp * C_IT * tau_plus**2.0_wp
3395	ELSE
3396	v_it = C_IT
3397	ENDIF
3398	depo = v_bd + v_in + v_im + v_it + vc(k+1,b)
3399
3400	ENDIF
3401	IF ( lod_aero == 3 .OR. salsa_source_mode == 'no_source' ) THEN
3402	surf%answs(m,b) = -depo * norm(k) * aerosol_number(b)%conc(k,j,i)
3403	DO c = 1, ncc_tot
3404	surf%amsws(m,(c-1)nbins+b) = -depo norm(k) * &
3405	aerosol_mass((c-1)*nbins+b)%conc(k,j,i)
3406	ENDDO ! c
3407	ELSE
3408	surf%answs(m,b) = SUM( aerosol_number(b)%source(:,j,i) ) - &
3409	MAX( 0.0_wp, depo * norm(k) * &
3410	aerosol_number(b)%conc(k,j,i) )
3411	DO c = 1, ncc_tot
3412	surf%amsws(m,(c-1)*nbins+b) = SUM( &
3413	aerosol_mass((c-1)*nbins+b)%source(:,j,i) ) - &
3414	MAX( 0.0_wp, depo * norm(k) * &
3415	aerosol_mass((c-1)*nbins+b)%conc(k,j,i) )
3416	ENDDO
3417	ENDIF
3418	ENDDO ! b
3419	ENDDO ! m
3420
3421	END SUBROUTINE depo_topo
3422
3423	!------------------------------------------------------------------------------!
3424	! Description:
3425	! ------------
3426	! Function for calculating terminal velocities for different particles sizes.
3427	!------------------------------------------------------------------------------!
3428	REAL(wp) FUNCTION terminal_vel( radius, rhop, rhoa, visc, beta )
3429
3430	IMPLICIT NONE
3431
3432	REAL(wp), INTENT(in) :: beta !< Cunningham correction factor
3433	REAL(wp), INTENT(in) :: radius !< particle radius (m)
3434	REAL(wp), INTENT(in) :: rhop !< particle density (kg/m3)
3435	REAL(wp), INTENT(in) :: rhoa !< air density (kg/m3)
3436	REAL(wp), INTENT(in) :: visc !< molecular viscosity of air (kg/(m*s))
3437
3438	REAL(wp), PARAMETER :: rhoa_ref = 1.225_wp ! reference air density (kg/m3)
3439	!
3440	!-- Stokes law with Cunningham slip correction factor
3441	terminal_vel = ( 4.0_wp * radius*2.0_wp ) ( rhop - rhoa ) * g * beta / &
3442	( 18.0_wp * visc ) ! (m/s)
3443
3444	END FUNCTION terminal_vel
3445
3446	!------------------------------------------------------------------------------!
3447	! Description:
3448	! ------------
3449	!> Calculates particle loss and change in size distribution due to (Brownian)
3450	!> coagulation. Only for particles with dwet < 30 micrometres.
3451	!
3452	!> Method:
3453	!> Semi-implicit, non-iterative method: (Jacobson, 1994)
3454	!> Volume concentrations of the smaller colliding particles added to the bin of
3455	!> the larger colliding particles. Start from first bin and use the updated
3456	!> number and volume for calculation of following bins. NB! Our bin numbering
3457	!> does not follow particle size in subrange 2.
3458	!
3459	!> Schematic for bin numbers in different subranges:
3460	!> 1 2
3461	!> +-------------------------------------------+
3462	!> a \| 1 \| 2 \| 3 \|\| 4 \| 5 \| 6 \| 7 \| 8 \| 9 \| 10\|\|
3463	!> b \| \|\|11 \|12 \|13 \|14 \| 15 \| 16 \| 17\|\|
3464	!> +-------------------------------------------+
3465	!
3466	!> Exact coagulation coefficients for each pressure level are scaled according
3467	!> to current particle wet size (linear scaling).
3468	!> Bins are organized in terms of the dry size of the condensation nucleus,
3469	!> while coagulation kernell is calculated with the actual hydrometeor
3470	!> size.
3471	!
3472	!> Called from salsa_driver
3473	!> fxm: Process selection should be made smarter - now just lots of IFs inside
3474	!> loops
3475	!
3476	!> Coded by:
3477	!> Hannele Korhonen (FMI) 2005
3478	!> Harri Kokkola (FMI) 2006
3479	!> Tommi Bergman (FMI) 2012
3480	!> Matti Niskanen(FMI) 2012
3481	!> Anton Laakso (FMI) 2013
3482	!> Juha Tonttila (FMI) 2014
3483	!------------------------------------------------------------------------------!
3484	SUBROUTINE coagulation( paero, ptstep, ptemp, ppres )
3485
3486	IMPLICIT NONE
3487
3488	!-- Input and output variables
3489	TYPE(t_section), INTENT(inout) :: paero(fn2b) !< Aerosol properties
3490	REAL(wp), INTENT(in) :: ppres !< ambient pressure (Pa)
3491	REAL(wp), INTENT(in) :: ptemp !< ambient temperature (K)
3492	REAL(wp), INTENT(in) :: ptstep !< time step (s)
3493	!-- Local variables
3494	INTEGER(iwp) :: index_2a !< corresponding bin in subrange 2a
3495	INTEGER(iwp) :: index_2b !< corresponding bin in subrange 2b
3496	INTEGER(iwp) :: b !< loop index
3497	INTEGER(iwp) :: ll !< loop index
3498	INTEGER(iwp) :: mm !< loop index
3499	INTEGER(iwp) :: nn !< loop index
3500	REAL(wp) :: pressi !< pressure
3501	REAL(wp) :: temppi !< temperature
3502	REAL(wp) :: zcc(fn2b,fn2b) !< updated coagulation coefficients (m3/s)
3503	REAL(wp) :: zdpart_mm !< diameter of particle (m)
3504	REAL(wp) :: zdpart_nn !< diameter of particle (m)
3505	REAL(wp) :: zminusterm !< coagulation loss in a bin (1/s)
3506	REAL(wp) :: zplusterm(8) !< coagulation gain in a bin (fxm/s)
3507	!< (for each chemical compound)
3508	REAL(wp) :: zmpart(fn2b) !< approximate mass of particles (kg)
3509
3510	zcc = 0.0_wp
3511	zmpart = 0.0_wp
3512	zdpart_mm = 0.0_wp
3513	zdpart_nn = 0.0_wp
3514	!
3515	!-- 1) Coagulation to coarse mode calculated in a simplified way:
3516	!-- CoagSink ~ Dp in continuum subrange, thus we calculate 'effective'
3517	!-- number concentration of coarse particles
3518
3519	!-- 2) Updating coagulation coefficients
3520	!
3521	!-- Aerosol mass (kg). Density of 1500 kg/m3 assumed
3522	zmpart(1:fn2b) = api6 * ( MIN( paero(1:fn2b)%dwet, 30.0E-6_wp )**3.0_wp ) &
3523	* 1500.0_wp
3524	temppi = ptemp
3525	pressi = ppres
3526	zcc = 0.0_wp
3527	!
3528	!-- Aero-aero coagulation
3529	DO mm = 1, fn2b ! smaller colliding particle
3530	IF ( paero(mm)%numc < nclim ) CYCLE
3531	DO nn = mm, fn2b ! larger colliding particle
3532	IF ( paero(nn)%numc < nclim ) CYCLE
3533
3534	zdpart_mm = MIN( paero(mm)%dwet, 30.0E-6_wp ) ! Limit to 30 um
3535	zdpart_nn = MIN( paero(nn)%dwet, 30.0E-6_wp ) ! Limit to 30 um
3536	!
3537	!-- Coagulation coefficient of particles (m3/s)
3538	zcc(mm,nn) = coagc( zdpart_mm, zdpart_nn, zmpart(mm), zmpart(nn), &
3539	temppi, pressi )
3540	zcc(nn,mm) = zcc(mm,nn)
3541	ENDDO
3542	ENDDO
3543
3544	!
3545	!-- 3) New particle and volume concentrations after coagulation:
3546	!-- Calculated according to Jacobson (2005) eq. 15.9
3547	!
3548	!-- Aerosols in subrange 1a:
3549	DO b = in1a, fn1a
3550	IF ( paero(b)%numc < nclim ) CYCLE
3551	zminusterm = 0.0_wp
3552	zplusterm(:) = 0.0_wp
3553	!
3554	!-- Particles lost by coagulation with larger aerosols
3555	DO ll = b+1, fn2b
3556	zminusterm = zminusterm + zcc(b,ll) * paero(ll)%numc
3557	ENDDO
3558	!
3559	!-- Coagulation gain in a bin: change in volume conc. (cm3/cm3):
3560	DO ll = in1a, b-1
3561	zplusterm(1:2) = zplusterm(1:2) + zcc(ll,b) * paero(ll)%volc(1:2)
3562	zplusterm(6:7) = zplusterm(6:7) + zcc(ll,b) * paero(ll)%volc(6:7)
3563	zplusterm(8) = zplusterm(8) + zcc(ll,b) * paero(ll)%volc(8)
3564	ENDDO
3565	!
3566	!-- Volume and number concentrations after coagulation update [fxm]
3567	paero(b)%volc(1:2) = ( paero(b)%volc(1:2) + ptstep * zplusterm(1:2) * &
3568	paero(b)%numc ) / ( 1.0_wp + ptstep * zminusterm )
3569	paero(b)%volc(6:7) = ( paero(b)%volc(6:7) + ptstep * zplusterm(6:7) * &
3570	paero(b)%numc ) / ( 1.0_wp + ptstep * zminusterm )
3571	paero(b)%volc(8) = ( paero(b)%volc(8) + ptstep * zplusterm(8) * &
3572	paero(b)%numc ) / ( 1.0_wp + ptstep * zminusterm )
3573	paero(b)%numc = paero(b)%numc / ( 1.0_wp + ptstep * zminusterm + &
3574	0.5_wp * ptstep * zcc(b,b) * paero(b)%numc )
3575	ENDDO
3576	!
3577	!-- Aerosols in subrange 2a:
3578	DO b = in2a, fn2a
3579	IF ( paero(b)%numc < nclim ) CYCLE
3580	zminusterm = 0.0_wp
3581	zplusterm(:) = 0.0_wp
3582	!
3583	!-- Find corresponding size bin in subrange 2b
3584	index_2b = b - in2a + in2b
3585	!
3586	!-- Particles lost by larger particles in 2a
3587	DO ll = b+1, fn2a
3588	zminusterm = zminusterm + zcc(b,ll) * paero(ll)%numc
3589	ENDDO
3590	!
3591	!-- Particles lost by larger particles in 2b
3592	IF ( .NOT. no_insoluble ) THEN
3593	DO ll = index_2b+1, fn2b
3594	zminusterm = zminusterm + zcc(b,ll) * paero(ll)%numc
3595	ENDDO
3596	ENDIF
3597	!
3598	!-- Particle volume gained from smaller particles in subranges 1, 2a and 2b
3599	DO ll = in1a, b-1
3600	zplusterm(1:2) = zplusterm(1:2) + zcc(ll,b) * paero(ll)%volc(1:2)
3601	zplusterm(6:7) = zplusterm(6:7) + zcc(ll,b) * paero(ll)%volc(6:7)
3602	zplusterm(8) = zplusterm(8) + zcc(ll,b) * paero(ll)%volc(8)
3603	ENDDO
3604	!
3605	!-- Particle volume gained from smaller particles in 2a
3606	!-- (Note, for components not included in the previous loop!)
3607	DO ll = in2a, b-1
3608	zplusterm(3:5) = zplusterm(3:5) + zcc(ll,b)*paero(ll)%volc(3:5)
3609	ENDDO
3610
3611	!
3612	!-- Particle volume gained from smaller (and equal) particles in 2b
3613	IF ( .NOT. no_insoluble ) THEN
3614	DO ll = in2b, index_2b
3615	zplusterm(1:8) = zplusterm(1:8) + zcc(ll,b) * paero(ll)%volc(1:8)
3616	ENDDO
3617	ENDIF
3618	!
3619	!-- Volume and number concentrations after coagulation update [fxm]
3620	paero(b)%volc(1:8) = ( paero(b)%volc(1:8) + ptstep * zplusterm(1:8) * &
3621	paero(b)%numc ) / ( 1.0_wp + ptstep * zminusterm )
3622	paero(b)%numc = paero(b)%numc / ( 1.0_wp + ptstep * zminusterm + &
3623	0.5_wp * ptstep * zcc(b,b) * paero(b)%numc )
3624	ENDDO
3625	!
3626	!-- Aerosols in subrange 2b:
3627	IF ( .NOT. no_insoluble ) THEN
3628	DO b = in2b, fn2b
3629	IF ( paero(b)%numc < nclim ) CYCLE
3630	zminusterm = 0.0_wp
3631	zplusterm(:) = 0.0_wp
3632	!
3633	!-- Find corresponding size bin in subsubrange 2a
3634	index_2a = b - in2b + in2a
3635	!
3636	!-- Particles lost to larger particles in subranges 2b
3637	DO ll = b+1, fn2b
3638	zminusterm = zminusterm + zcc(b,ll) * paero(ll)%numc
3639	ENDDO
3640	!
3641	!-- Particles lost to larger and equal particles in 2a
3642	DO ll = index_2a, fn2a
3643	zminusterm = zminusterm + zcc(b,ll) * paero(ll)%numc
3644	ENDDO
3645	!
3646	!-- Particle volume gained from smaller particles in subranges 1 & 2a
3647	DO ll = in1a, index_2a-1
3648	zplusterm(1:8) = zplusterm(1:8) + zcc(ll,b) * paero(ll)%volc(1:8)
3649	ENDDO
3650	!
3651	!-- Particle volume gained from smaller particles in 2b
3652	DO ll = in2b, b-1
3653	zplusterm(1:8) = zplusterm(1:8) + zcc(ll,b) * paero(ll)%volc(1:8)
3654	ENDDO
3655	!
3656	!-- Volume and number concentrations after coagulation update [fxm]
3657	paero(b)%volc(1:8) = ( paero(b)%volc(1:8) + ptstep * zplusterm(1:8)&
3658	* paero(b)%numc ) / ( 1.0_wp + ptstep * zminusterm )
3659	paero(b)%numc = paero(b)%numc / ( 1.0_wp + ptstep * zminusterm + &
3660	0.5_wp * ptstep * zcc(b,b) * paero(b)%numc )
3661	ENDDO
3662	ENDIF
3663
3664	END SUBROUTINE coagulation
3665
3666	!------------------------------------------------------------------------------!
3667	! Description:
3668	! ------------
3669	!> Calculation of coagulation coefficients. Extended version of the function
3670	!> originally found in mo_salsa_init.
3671	!
3672	!> J. Tonttila, FMI, 05/2014
3673	!------------------------------------------------------------------------------!
3674	REAL(wp) FUNCTION coagc( diam1, diam2, mass1, mass2, temp, pres )
3675
3676	IMPLICIT NONE
3677	!
3678	!-- Input and output variables
3679	REAL(wp), INTENT(in) :: diam1 !< diameter of colliding particle 1 (m)
3680	REAL(wp), INTENT(in) :: diam2 !< diameter of colliding particle 2 (m)
3681	REAL(wp), INTENT(in) :: mass1 !< mass of colliding particle 1 (kg)
3682	REAL(wp), INTENT(in) :: mass2 !< mass of colliding particle 2 (kg)
3683	REAL(wp), INTENT(in) :: pres !< ambient pressure (Pa?) [fxm]
3684	REAL(wp), INTENT(in) :: temp !< ambient temperature (K)
3685	!
3686	!-- Local variables
3687	REAL(wp) :: fmdist !< distance of flux matching (m)
3688	REAL(wp) :: knud_p !< particle Knudsen number
3689	REAL(wp) :: mdiam !< mean diameter of colliding particles (m)
3690	REAL(wp) :: mfp !< mean free path of air molecules (m)
3691	REAL(wp) :: visc !< viscosity of air (kg/(m s))
3692	REAL(wp), DIMENSION (2) :: beta !< Cunningham correction factor
3693	REAL(wp), DIMENSION (2) :: dfpart !< particle diffusion coefficient
3694	!< (m2/s)
3695	REAL(wp), DIMENSION (2) :: diam !< diameters of particles (m)
3696	REAL(wp), DIMENSION (2) :: flux !< flux in continuum and free molec.
3697	!< regime (m/s)
3698	REAL(wp), DIMENSION (2) :: knud !< particle Knudsen number
3699	REAL(wp), DIMENSION (2) :: mpart !< masses of particles (kg)
3700	REAL(wp), DIMENSION (2) :: mtvel !< particle mean thermal velocity (m/s)
3701	REAL(wp), DIMENSION (2) :: omega !< particle mean free path
3702	REAL(wp), DIMENSION (2) :: tva !< temporary variable (m)
3703	!
3704	!-- Initialisation
3705	coagc = 0.0_wp
3706	!
3707	!-- 1) Initializing particle and ambient air variables
3708	diam = (/ diam1, diam2 /) !< particle diameters (m)
3709	mpart = (/ mass1, mass2 /) !< particle masses (kg)
3710	!-- Viscosity of air (kg/(m s))
3711	visc = ( 7.44523E-3_wp * temp ** 1.5_wp ) / &
3712	( 5093.0_wp * ( temp + 110.4_wp ) )
3713	!-- Mean free path of air (m)
3714	mfp = ( 1.656E-10_wp * temp + 1.828E-8_wp ) * ( p_0 + 1325.0_wp ) / pres
3715	!
3716	!-- 2) Slip correction factor for small particles
3717	knud = 2.0_wp * EXP( LOG(mfp) - LOG(diam) )! Knudsen number for air (15.23)
3718	!-- Cunningham correction factor (Allen and Raabe, Aerosol Sci. Tech. 4, 269)
3719	beta = 1.0_wp + knud * ( 1.142_wp + 0.558_wp * EXP( -0.999_wp / knud ) )
3720	!
3721	!-- 3) Particle properties
3722	!-- Diffusion coefficient (m2/s) (Jacobson (2005) eq. 15.29)
3723	dfpart = beta * abo * temp / ( 3.0_wp * pi * visc * diam )
3724	!-- Mean thermal velocity (m/s) (Jacobson (2005) eq. 15.32)
3725	mtvel = SQRT( ( 8.0_wp * abo * temp ) / ( pi * mpart ) )
3726	!-- Particle mean free path (m) (Jacobson (2005) eq. 15.34 )
3727	omega = 8.0_wp * dfpart / ( pi * mtvel )
3728	!-- Mean diameter (m)
3729	mdiam = 0.5_wp * ( diam(1) + diam(2) )
3730	!
3731	!-- 4) Calculation of fluxes (Brownian collision kernels) and flux matching
3732	!-- following Jacobson (2005):
3733	!-- Flux in continuum regime (m3/s) (eq. 15.28)
3734	flux(1) = 4.0_wp * pi * mdiam * ( dfpart(1) + dfpart(2) )
3735	!-- Flux in free molec. regime (m3/s) (eq. 15.31)
3736	flux(2) = pi * SQRT( ( mtvel(1)2.0_wp ) + ( mtvel(2)2.0_wp ) ) * &
3737	( mdiam**2.0_wp )
3738	!-- temporary variables (m) to calculate flux matching distance (m)
3739	tva(1) = ( ( mdiam + omega(1) )3.0_wp - ( mdiam2.0_wp + &
3740	omega(1)*2.0_wp ) SQRT( ( mdiam2.0_wp + omega(1)2.0_wp ) &
3741	) ) / ( 3.0_wp * mdiam * omega(1) ) - mdiam
3742	tva(2) = ( ( mdiam + omega(2) )3.0_wp - ( mdiam2.0_wp + &
3743	omega(2)*2.0_wp ) SQRT( ( mdiam2 + omega(2)2 ) ) ) / &
3744	( 3.0_wp * mdiam * omega(2) ) - mdiam
3745	!-- Flux matching distance (m) i.e. the mean distance from the centre of a
3746	!-- sphere reached by particles leaving sphere's surface and travelling a
3747	!-- distance of particle mean free path mfp (eq. 15 34)
3748	fmdist = SQRT( tva(1)2 + tva(2)2.0_wp)
3749	!
3750	!-- 5) Coagulation coefficient (m3/s) (eq. 15.33). Here assumed
3751	!-- coalescence efficiency 1!!
3752	coagc = flux(1) / ( mdiam / ( mdiam + fmdist) + flux(1) / flux(2) )
3753	!-- coagulation coefficient = coalescence efficiency * collision kernel
3754	!
3755	!-- Corrected collision kernel following Karl et al., 2016 (ACP):
3756	!-- Inclusion of van der Waals and viscous forces
3757	IF ( van_der_waals_coagc ) THEN
3758	knud_p = SQRT( omega(1)2 + omega(2)2 ) / mdiam
3759	IF ( knud_p >= 0.1_wp .AND. knud_p <= 10.0_wp ) THEN
3760	coagc = coagc * ( 2.0_wp + 0.4_wp * LOG( knud_p ) )
3761	ELSE
3762	coagc = coagc * 3.0_wp
3763	ENDIF
3764	ENDIF
3765
3766	END FUNCTION coagc
3767
3768	!------------------------------------------------------------------------------!
3769	! Description:
3770	! ------------
3771	!> Calculates the change in particle volume and gas phase
3772	!> concentrations due to nucleation, condensation and dissolutional growth.
3773	!
3774	!> Sulphuric acid and organic vapour: only condensation and no evaporation.
3775	!
3776	!> New gas and aerosol phase concentrations calculated according to Jacobson
3777	!> (1997): Numerical techniques to solve condensational and dissolutional growth
3778	!> equations when growth is coupled to reversible reactions, Aerosol Sci. Tech.,
3779	!> 27, pp 491-498.
3780	!
3781	!> Following parameterization has been used:
3782	!> Molecular diffusion coefficient of condensing vapour (m2/s)
3783	!> (Reid et al. (1987): Properties of gases and liquids, McGraw-Hill, New York.)
3784	!> D = {1.d-7sqrt(1/M_air + 1/M_gas)T^1.75} / &
3785	! {p_atm/p_stand * (d_air^(1/3) + d_gas^(1/3))^2 }
3786	! M_air = 28.965 : molar mass of air (g/mol)
3787	! d_air = 19.70 : diffusion volume of air
3788	! M_h2so4 = 98.08 : molar mass of h2so4 (g/mol)
3789	! d_h2so4 = 51.96 : diffusion volume of h2so4
3790	!
3791	!> Called from main aerosol model
3792	!
3793	!> fxm: calculated for empty bins too
3794	!> fxm: same diffusion coefficients and mean free paths used for sulphuric acid
3795	!> and organic vapours (average values? 'real' values for each?)
3796	!> fxm: one should really couple with vapour production and loss terms as well
3797	!> should nucleation be coupled here as well????
3798	!
3799	! Coded by:
3800	! Hannele Korhonen (FMI) 2005
3801	! Harri Kokkola (FMI) 2006
3802	! Juha Tonttila (FMI) 2014
3803	! Rewritten to PALM by Mona Kurppa (UHel) 2017
3804	!------------------------------------------------------------------------------!
3805	SUBROUTINE condensation( paero, pcsa, pcocnv, pcocsv, pchno3, pcnh3, pcw, pcs,&
3806	ptemp, ppres, ptstep, prtcl )
3807
3808	IMPLICIT NONE
3809
3810	!-- Input and output variables
3811	REAL(wp), INTENT(IN) :: ppres !< ambient pressure (Pa)
3812	REAL(wp), INTENT(IN) :: pcs !< Water vapour saturation concentration
3813	!< (kg/m3)
3814	REAL(wp), INTENT(IN) :: ptemp !< ambient temperature (K)
3815	REAL(wp), INTENT(IN) :: ptstep !< timestep (s)
3816	TYPE(component_index), INTENT(in) :: prtcl !< Keeps track which substances
3817	!< are used
3818	REAL(wp), INTENT(INOUT) :: pchno3 !< Gas concentrations (#/m3):
3819	!< nitric acid HNO3
3820	REAL(wp), INTENT(INOUT) :: pcnh3 !< ammonia NH3
3821	REAL(wp), INTENT(INOUT) :: pcocnv !< non-volatile organics
3822	REAL(wp), INTENT(INOUT) :: pcocsv !< semi-volatile organics
3823	REAL(wp), INTENT(INOUT) :: pcsa !< sulphuric acid H2SO4
3824	REAL(wp), INTENT(INOUT) :: pcw !< Water vapor concentration (kg/m3)
3825	TYPE(t_section), INTENT(inout) :: paero(fn2b) !< Aerosol properties
3826	!-- Local variables
3827	REAL(wp) :: zbeta(fn2b) !< transitional correction factor for aerosols
3828	REAL(wp) :: zcolrate(fn2b) !< collision rate of molecules to particles
3829	!< (1/s)
3830	REAL(wp) :: zcolrate_ocnv(fn2b) !< collision rate of organic molecules
3831	!< to particles (1/s)
3832	REAL(wp) :: zcs_ocnv !< condensation sink of nonvolatile organics (1/s)
3833	REAL(wp) :: zcs_ocsv !< condensation sink of semivolatile organics (1/s)
3834	REAL(wp) :: zcs_su !< condensation sink of sulfate (1/s)
3835	REAL(wp) :: zcs_tot!< total condensation sink (1/s) (gases)
3836	!-- vapour concentration after time step (#/m3)
3837	REAL(wp) :: zcvap_new1 !< sulphuric acid
3838	REAL(wp) :: zcvap_new2 !< nonvolatile organics
3839	REAL(wp) :: zcvap_new3 !< semivolatile organics
3840	REAL(wp) :: zdfpart(in1a+1) !< particle diffusion coefficient (m2/s)
3841	REAL(wp) :: zdfvap !< air diffusion coefficient (m2/s)
3842	!-- change in vapour concentration (#/m3)
3843	REAL(wp) :: zdvap1 !< sulphuric acid
3844	REAL(wp) :: zdvap2 !< nonvolatile organics
3845	REAL(wp) :: zdvap3 !< semivolatile organics
3846	REAL(wp) :: zdvoloc(fn2b) !< change of organics volume in each bin [fxm]
3847	REAL(wp) :: zdvolsa(fn2b) !< change of sulphate volume in each bin [fxm]
3848	REAL(wp) :: zj3n3(2) !< Formation massrate of molecules in
3849	!< nucleation, (molec/m3s). 1: H2SO4
3850	!< and 2: organic vapor
3851	REAL(wp) :: zknud(fn2b) !< particle Knudsen number
3852	REAL(wp) :: zmfp !< mean free path of condensing vapour (m)
3853	REAL(wp) :: zrh !< Relative humidity [0-1]
3854	REAL(wp) :: zvisc !< viscosity of air (kg/(m s))
3855	REAL(wp) :: zn_vs_c !< ratio of nucleation of all mass transfer in the
3856	!< smallest bin
3857	REAL(wp) :: zxocnv !< ratio of organic vapour in 3nm particles
3858	REAL(wp) :: zxsa !< Ratio in 3nm particles: sulphuric acid
3859
3860	zj3n3 = 0.0_wp
3861	zrh = pcw / pcs
3862	zxocnv = 0.0_wp
3863	zxsa = 0.0_wp
3864	!
3865	!-- Nucleation
3866	IF ( nsnucl > 0 ) THEN
3867	CALL nucleation( paero, ptemp, zrh, ppres, pcsa, pcocnv, pcnh3, ptstep, &
3868	zj3n3, zxsa, zxocnv )
3869	ENDIF
3870	!
3871	!-- Condensation on pre-existing particles
3872	IF ( lscndgas ) THEN
3873	!
3874	!-- Initialise:
3875	zdvolsa = 0.0_wp
3876	zdvoloc = 0.0_wp
3877	zcolrate = 0.0_wp
3878	!
3879	!-- 1) Properties of air and condensing gases:
3880	!-- Viscosity of air (kg/(m s)) (Eq. 4.54 in Jabonson (2005))
3881	zvisc = ( 7.44523E-3_wp * ptemp ** 1.5_wp ) / ( 5093.0_wp * &
3882	( ptemp + 110.4_wp ) )
3883	!-- Diffusion coefficient of air (m2/s)
3884	zdfvap = 5.1111E-10_wp * ptemp ** 1.75_wp * ( p_0 + 1325.0_wp ) / ppres
3885	!-- Mean free path (m): same for H2SO4 and organic compounds
3886	zmfp = 3.0_wp * zdfvap * SQRT( pi * amh2so4 / ( 8.0_wp * argas * ptemp ) )
3887	!
3888	!-- 2) Transition regime correction factor zbeta for particles:
3889	!-- Fuchs and Sutugin (1971), In: Hidy et al. (ed.) Topics in current
3890	!-- aerosol research, Pergamon. Size of condensing molecule considered
3891	!-- only for nucleation mode (3 - 20 nm)
3892	!
3893	!-- Particle Knudsen number: condensation of gases on aerosols
3894	zknud(in1a:in1a+1) = 2.0_wp * zmfp / ( paero(in1a:in1a+1)%dwet + d_sa )
3895	zknud(in1a+2:fn2b) = 2.0_wp * zmfp / paero(in1a+2:fn2b)%dwet
3896	!
3897	!-- Transitional correction factor: aerosol + gas (the semi-empirical Fuchs-
3898	!-- Sutugin interpolation function (Fuchs and Sutugin, 1971))
3899	zbeta = ( zknud + 1.0_wp ) / ( 0.377_wp * zknud + 1.0_wp + 4.0_wp / &
3900	( 3.0_wp * massacc ) * ( zknud + zknud ** 2.0_wp ) )
3901	!
3902	!-- 3) Collision rate of molecules to particles
3903	!-- Particle diffusion coefficient considered only for nucleation mode
3904	!-- (3 - 20 nm)
3905	!
3906	!-- Particle diffusion coefficient (m2/s) (e.g. Eq. 15.29 in Jacobson (2005))
3907	zdfpart = abo * ptemp * zbeta(in1a:in1a+1) / ( 3.0_wp * pi * zvisc * &
3908	paero(in1a:in1a+1)%dwet )
3909	!
3910	!-- Collision rate (mass-transfer coefficient): gases on aerosols (1/s)
3911	!-- (Eq. 16.64 in Jacobson (2005))
3912	zcolrate(in1a:in1a+1) = MERGE( 2.0_wp * pi * &
3913	( paero(in1a:in1a+1)%dwet + d_sa ) * &
3914	( zdfvap + zdfpart ) * zbeta(in1a:in1a+1)&
3915	* paero(in1a:in1a+1)%numc, 0.0_wp, &
3916	paero(in1a:in1a+1)%numc > nclim )
3917	zcolrate(in1a+2:fn2b) = MERGE( 2.0_wp * pi * paero(in1a+2:fn2b)%dwet * &
3918	zdfvap * zbeta(in1a+2:fn2b) * &
3919	paero(in1a+2:fn2b)%numc, 0.0_wp, &
3920	paero(in1a+2:fn2b)%numc > nclim )
3921	!
3922	!-- 4) Condensation sink (1/s)
3923	zcs_tot = SUM( zcolrate ) ! total sink
3924	!
3925	!-- 5) Changes in gas-phase concentrations and particle volume
3926	!
3927	!-- 5.1) Organic vapours
3928	!
3929	!-- 5.1.1) Non-volatile organic compound: condenses onto all bins
3930	IF ( pcocnv > 1.0E+10_wp .AND. zcs_tot > 1.0E-30_wp .AND. &
3931	is_used( prtcl,'OC' ) ) &
3932	THEN
3933	!-- Ratio of nucleation vs. condensation rates in the smallest bin
3934	zn_vs_c = 0.0_wp
3935	IF ( zj3n3(2) > 1.0_wp ) THEN
3936	zn_vs_c = ( zj3n3(2) ) / ( zj3n3(2) + pcocnv * zcolrate(in1a) )
3937	ENDIF
3938	!
3939	!-- Collision rate in the smallest bin, including nucleation and
3940	!-- condensation(see Jacobson, Fundamentals of Atmospheric Modeling, 2nd
3941	!-- Edition (2005), equation (16.73) )
3942	zcolrate_ocnv = zcolrate
3943	zcolrate_ocnv(in1a) = zcolrate_ocnv(in1a) + zj3n3(2) / pcocnv
3944	!
3945	!-- Total sink for organic vapor
3946	zcs_ocnv = zcs_tot + zj3n3(2) / pcocnv
3947	!
3948	!-- New gas phase concentration (#/m3)
3949	zcvap_new2 = pcocnv / ( 1.0_wp + ptstep * zcs_ocnv )
3950	!
3951	!-- Change in gas concentration (#/m3)
3952	zdvap2 = pcocnv - zcvap_new2
3953	!
3954	!-- Updated vapour concentration (#/m3)
3955	pcocnv = zcvap_new2
3956	!
3957	!-- Volume change of particles (m3(OC)/m3(air))
3958	zdvoloc = zcolrate_ocnv(in1a:fn2b) / zcs_ocnv * amvoc * zdvap2
3959	!
3960	!-- Change of volume due to condensation in 1a-2b
3961	paero(in1a:fn2b)%volc(2) = paero(in1a:fn2b)%volc(2) + zdvoloc
3962	!
3963	!-- Change of number concentration in the smallest bin caused by
3964	!-- nucleation (Jacobson (2005), equation (16.75)). If zxocnv = 0, then
3965	!-- the chosen nucleation mechanism doesn't take into account the non-
3966	!-- volatile organic vapors and thus the paero doesn't have to be updated.
3967	IF ( zxocnv > 0.0_wp ) THEN
3968	paero(in1a)%numc = paero(in1a)%numc + zn_vs_c * zdvoloc(in1a) / &
3969	amvoc / ( n3 * zxocnv )
3970	ENDIF
3971	ENDIF
3972	!
3973	!-- 5.1.2) Semivolatile organic compound: all bins except subrange 1
3974	zcs_ocsv = SUM( zcolrate(in2a:fn2b) ) !< sink for semi-volatile organics
3975	IF ( pcocsv > 1.0E+10_wp .AND. zcs_ocsv > 1.0E-30 .AND. &
3976	is_used( prtcl,'OC') ) &
3977	THEN
3978	!
3979	!-- New gas phase concentration (#/m3)
3980	zcvap_new3 = pcocsv / ( 1.0_wp + ptstep * zcs_ocsv )
3981	!
3982	!-- Change in gas concentration (#/m3)
3983	zdvap3 = pcocsv - zcvap_new3
3984	!
3985	!-- Updated gas concentration (#/m3)
3986	pcocsv = zcvap_new3
3987	!
3988	!-- Volume change of particles (m3(OC)/m3(air))
3989	zdvoloc(in2a:fn2b) = zdvoloc(in2a:fn2b) + zcolrate(in2a:fn2b) / &
3990	zcs_ocsv * amvoc * zdvap3
3991	!
3992	!-- Change of volume due to condensation in 1a-2b
3993	paero(in1a:fn2b)%volc(2) = paero(in1a:fn2b)%volc(2) + zdvoloc
3994	ENDIF
3995	!
3996	!-- 5.2) Sulphate: condensed on all bins
3997	IF ( pcsa > 1.0E+10_wp .AND. zcs_tot > 1.0E-30_wp .AND. &
3998	is_used( prtcl,'SO4' ) ) &
3999	THEN
4000	!
4001	!-- Ratio of mass transfer between nucleation and condensation
4002	zn_vs_c = 0.0_wp
4003	IF ( zj3n3(1) > 1.0_wp ) THEN
4004	zn_vs_c = ( zj3n3(1) ) / ( zj3n3(1) + pcsa * zcolrate(in1a) )
4005	ENDIF
4006	!
4007	!-- Collision rate in the smallest bin, including nucleation and
4008	!-- condensation (see Jacobson, Fundamentals of Atmospheric Modeling, 2nd
4009	!-- Edition (2005), equation (16.73))
4010	zcolrate(in1a) = zcolrate(in1a) + zj3n3(1) / pcsa
4011	!
4012	!-- Total sink for sulfate (1/s)
4013	zcs_su = zcs_tot + zj3n3(1) / pcsa
4014	!
4015	!-- Sulphuric acid:
4016	!-- New gas phase concentration (#/m3)
4017	zcvap_new1 = pcsa / ( 1.0_wp + ptstep * zcs_su )
4018	!
4019	!-- Change in gas concentration (#/m3)
4020	zdvap1 = pcsa - zcvap_new1
4021	!
4022	!-- Updating vapour concentration (#/m3)
4023	pcsa = zcvap_new1
4024	!
4025	!-- Volume change of particles (m3(SO4)/m3(air)) by condensation
4026	zdvolsa = zcolrate(in1a:fn2b) / zcs_su * amvh2so4 * zdvap1
4027	!-- For validation: zdvolsa = 5.5 mum3/cm3 per 12 h
4028	! zdvolsa = zdvolsa / SUM( zdvolsa ) * 5.5E-12_wp * dt_salsa / 43200.0_wp
4029	!0.3E-12_wp, 0.6E-12_wp, 11.0E-12_wp, 4.6E-12_wp, 9.2E-12_wp
4030	!
4031	!-- Change of volume concentration of sulphate in aerosol [fxm]
4032	paero(in1a:fn2b)%volc(1) = paero(in1a:fn2b)%volc(1) + zdvolsa
4033	!
4034	!-- Change of number concentration in the smallest bin caused by nucleation
4035	!-- (Jacobson (2005), equation (16.75))
4036	IF ( zxsa > 0.0_wp ) THEN
4037	paero(in1a)%numc = paero(in1a)%numc + zn_vs_c * zdvolsa(in1a) / &
4038	amvh2so4 / ( n3 * zxsa )
4039	ENDIF
4040	ENDIF
4041	ENDIF
4042	!
4043	!
4044	!-- Condensation of water vapour
4045	IF ( lscndh2oae ) THEN
4046	CALL gpparth2o( paero, ptemp, ppres, pcs, pcw, ptstep )
4047	ENDIF
4048	!
4049	!
4050	!-- Partitioning of H2O, HNO3, and NH3: Dissolutional growth
4051	IF ( lscndgas .AND. ino > 0 .AND. inh > 0 .AND. &
4052	( pchno3 > 1.0E+10_wp .OR. pcnh3 > 1.0E+10_wp ) ) &
4053	THEN
4054	CALL gpparthno3( ppres, ptemp, paero, pchno3, pcnh3, pcw, pcs, zbeta, &
4055	ptstep )
4056	ENDIF
4057
4058	END SUBROUTINE condensation
4059
4060	!------------------------------------------------------------------------------!
4061	! Description:
4062	! ------------
4063	!> Calculates the particle number and volume increase, and gas-phase
4064	!> concentration decrease due to nucleation subsequent growth to detectable size
4065	!> of 3 nm.
4066	!
4067	!> Method:
4068	!> When the formed clusters grow by condensation (possibly also by self-
4069	!> coagulation), their number is reduced due to scavenging to pre-existing
4070	!> particles. Thus, the apparent nucleation rate at 3 nm is significantly lower
4071	!> than the real nucleation rate (at ~1 nm).
4072	!
4073	!> Calculation of the formation rate of detectable particles at 3 nm (i.e. J3):
4074	!> nj3 = 1: Kerminen, V.-M. and Kulmala, M. (2002), J. Aerosol Sci.,33, 609-622.
4075	!> nj3 = 2: Lehtinen et al. (2007), J. Aerosol Sci., 38(9), 988-994.
4076	!> nj3 = 3: Anttila et al. (2010), J. Aerosol Sci., 41(7), 621-636.
4077	!
4078	!> Called from subroutine condensation (in module salsa_dynamics_mod.f90)
4079	!
4080	!> Calls one of the following subroutines:
4081	!> - binnucl
4082	!> - ternucl
4083	!> - kinnucl
4084	!> - actnucl
4085	!
4086	!> fxm: currently only sulphuric acid grows particles from 1 to 3 nm
4087	!> (if asked from Markku, this is terribly wrong!!!)
4088	!
4089	!> Coded by:
4090	!> Hannele Korhonen (FMI) 2005
4091	!> Harri Kokkola (FMI) 2006
4092	!> Matti Niskanen(FMI) 2012
4093	!> Anton Laakso (FMI) 2013
4094	!------------------------------------------------------------------------------!
4095
4096	SUBROUTINE nucleation( paero, ptemp, prh, ppres, pcsa, pcocnv, pcnh3, ptstep, &
4097	pj3n3, pxsa, pxocnv )
4098	IMPLICIT NONE
4099	!
4100	!-- Input and output variables
4101	REAL(wp), INTENT(in) :: pcnh3 !< ammonia concentration (#/m3)
4102	REAL(wp), INTENT(in) :: pcocnv !< conc. of non-volatile OC (#/m3)
4103	REAL(wp), INTENT(in) :: pcsa !< sulphuric acid conc. (#/m3)
4104	REAL(wp), INTENT(in) :: ppres !< ambient air pressure (Pa)
4105	REAL(wp), INTENT(in) :: prh !< ambient rel. humidity [0-1]
4106	REAL(wp), INTENT(in) :: ptemp !< ambient temperature (K)
4107	REAL(wp), INTENT(in) :: ptstep !< time step (s) of SALSA
4108	TYPE(t_section), INTENT(inout) :: paero(fn2b) !< aerosol properties
4109	REAL(wp), INTENT(inout) :: pj3n3(2) !< formation mass rate of molecules
4110	!< (molec/m3s) for 1: H2SO4 and
4111	!< 2: organic vapour
4112	REAL(wp), INTENT(out) :: pxocnv !< ratio of non-volatile organic vapours in
4113	!< 3nm aerosol particles
4114	REAL(wp), INTENT(out) :: pxsa !< ratio of H2SO4 in 3nm aerosol particles
4115	!-- Local variables
4116	INTEGER(iwp) :: iteration
4117	REAL(wp) :: zbeta(fn2b) !< transitional correction factor
4118	REAL(wp) :: zc_h2so4 !< H2SO4 conc. (#/cm3) !UNITS!
4119	REAL(wp) :: zc_org !< organic vapour conc. (#/cm3)
4120	REAL(wp) :: zCoagStot !< total losses due to coagulation, including
4121	!< condensation and self-coagulation
4122	REAL(wp) :: zcocnv_local !< organic vapour conc. (#/m3)
4123	REAL(wp) :: zcsink !< condensational sink (#/m2)
4124	REAL(wp) :: zcsa_local !< H2SO4 conc. (#/m3)
4125	REAL(wp) :: zdcrit !< diameter of critical cluster (m)
4126	REAL(wp) :: zdelta_vap !< change of H2SO4 and organic vapour
4127	!< concentration (#/m3)
4128	REAL(wp) :: zdfvap !< air diffusion coefficient (m2/s)
4129	REAL(wp) :: zdmean !< mean diameter of existing particles (m)
4130	REAL(wp) :: zeta !< constant: proportional to ratio of CS/GR (m)
4131	!< (condensation sink / growth rate)
4132	REAL(wp) :: zgamma !< proportionality factor ((nm2*m2)/h)
4133	REAL(wp) :: zGRclust !< growth rate of formed clusters (nm/h)
4134	REAL(wp) :: zGRtot !< total growth rate
4135	REAL(wp) :: zj3 !< number conc. of formed 3nm particles (#/m3)
4136	REAL(wp) :: zjnuc !< nucleation rate at ~1nm (#/m3s)
4137	REAL(wp) :: zKeff !< effective cogulation coefficient between
4138	!< freshly nucleated particles
4139	REAL(wp) :: zknud(fn2b) !< particle Knudsen number
4140	REAL(wp) :: zkocnv !< lever: zkocnv=1 --> organic compounds involved
4141	!< in nucleation
4142	REAL(wp) :: zksa !< lever: zksa=1 --> H2SO4 involved in nucleation
4143	REAL(wp) :: zlambda !< parameter for adjusting the growth rate due to
4144	!< self-coagulation
4145	REAL(wp) :: zmfp !< mean free path of condesing vapour(m)
4146	REAL(wp) :: zmixnh3 !< ammonia mixing ratio (ppt)
4147	REAL(wp) :: zNnuc !< number of clusters/particles at the size range
4148	!< d1-dx (#/m3)
4149	REAL(wp) :: znoc !< number of organic molecules in critical cluster
4150	REAL(wp) :: znsa !< number of H2SO4 molecules in critical cluster
4151	!
4152	!-- Variable determined for the m-parameter
4153	REAL(wp) :: zCc_2(fn2b) !<
4154	REAL(wp) :: zCc_c !<
4155	REAL(wp) :: zCc_x !<
4156	REAL(wp) :: zCoagS_c !<
4157	REAL(wp) :: zCoagS_x !<
4158	REAL(wp) :: zcv_2(fn2b) !<
4159	REAL(wp) :: zcv_c !<
4160	REAL(wp) :: zcv_c2(fn2b) !<
4161	REAL(wp) :: zcv_x !<
4162	REAL(wp) :: zcv_x2(fn2b) !<
4163	REAL(wp) :: zDc_2(fn2b) !<
4164	REAL(wp) :: zDc_c(fn2b) !<
4165	REAL(wp) :: zDc_c2(fn2b) !<
4166	REAL(wp) :: zDc_x(fn2b) !<
4167	REAL(wp) :: zDc_x2(fn2b) !<
4168	REAL(wp) :: zgammaF_2(fn2b) !<
4169	REAL(wp) :: zgammaF_c(fn2b) !<
4170	REAL(wp) :: zgammaF_x(fn2b) !<
4171	REAL(wp) :: zK_c2(fn2b) !<
4172	REAL(wp) :: zK_x2(fn2b) !<
4173	REAL(wp) :: zknud_2(fn2b) !<
4174	REAL(wp) :: zknud_c !<
4175	REAL(wp) :: zknud_x !<
4176	REAL(wp) :: zm_2(fn2b) !<
4177	REAL(wp) :: zm_c !<
4178	REAL(wp) :: zm_para !<
4179	REAL(wp) :: zm_x !<
4180	REAL(wp) :: zmyy !<
4181	REAL(wp) :: zomega_2c(fn2b) !<
4182	REAL(wp) :: zomega_2x(fn2b) !<
4183	REAL(wp) :: zomega_c(fn2b) !<
4184	REAL(wp) :: zomega_x(fn2b) !<
4185	REAL(wp) :: zRc2(fn2b) !<
4186	REAL(wp) :: zRx2(fn2b) !<
4187	REAL(wp) :: zsigma_c2(fn2b) !<
4188	REAL(wp) :: zsigma_x2(fn2b) !<
4189	!
4190	!-- 1) Nucleation rate (zjnuc) and diameter of critical cluster (zdcrit)
4191	zjnuc = 0.0_wp
4192	znsa = 0.0_wp
4193	znoc = 0.0_wp
4194	zdcrit = 0.0_wp
4195	zksa = 0.0_wp
4196	zkocnv = 0.0_wp
4197
4198	SELECT CASE ( nsnucl )
4199
4200	CASE(1) ! Binary H2SO4-H2O nucleation
4201
4202	zc_h2so4 = pcsa * 1.0E-6_wp ! sulphuric acid conc. to #/cm3
4203	CALL binnucl( zc_h2so4, ptemp, prh, zjnuc, znsa, znoc, zdcrit, zksa, &
4204	zkocnv )
4205
4206	CASE(2) ! Activation type nucleation
4207
4208	zc_h2so4 = pcsa * 1.0E-6_wp ! sulphuric acid conc. to #/cm3
4209	CALL binnucl( zc_h2so4, ptemp, prh, zjnuc, znsa, znoc, zdcrit, zksa, &
4210	zkocnv )
4211	CALL actnucl( pcsa, zjnuc, zdcrit, znsa, znoc, zksa, zkocnv, act_coeff )
4212
4213	CASE(3) ! Kinetically limited nucleation of (NH4)HSO4 clusters
4214
4215	zc_h2so4 = pcsa * 1.0E-6_wp ! sulphuric acid conc. to #/cm3
4216	CALL binnucl( zc_h2so4, ptemp, prh, zjnuc, znsa, znoc, zdcrit, zksa, &
4217	zkocnv )
4218
4219	CALL kinnucl( zc_h2so4, zjnuc, zdcrit, znsa, znoc, zksa, zkocnv )
4220
4221	CASE(4) ! Ternary H2SO4-H2O-NH3 nucleation
4222
4223	zmixnh3 = pcnh3 * ptemp * argas / ( ppres * avo )
4224	zc_h2so4 = pcsa * 1.0E-6_wp ! sulphuric acid conc. to #/cm3
4225	CALL ternucl( zc_h2so4, zmixnh3, ptemp, prh, zjnuc, znsa, znoc, zdcrit, &
4226	zksa, zkocnv )
4227
4228	CASE(5) ! Organic nucleation, J~[ORG] or J~[ORG]**2
4229
4230	zc_org = pcocnv * 1.0E-6_wp ! conc. of non-volatile OC to #/cm3
4231	zc_h2so4 = pcsa * 1.0E-6_wp ! sulphuric acid conc. to #/cm3
4232	CALL binnucl( zc_h2so4, ptemp, prh, zjnuc, znsa, znoc, zdcrit, zksa, &
4233	zkocnv )
4234	CALL orgnucl( pcocnv, zjnuc, zdcrit, znsa, znoc, zksa, zkocnv )
4235
4236	CASE(6) ! Sum of H2SO4 and organic activation type nucleation,
4237	! J~[H2SO4]+[ORG]
4238
4239	zc_h2so4 = pcsa * 1.0E-6_wp ! sulphuric acid conc. to #/cm3
4240	CALL binnucl( zc_h2so4, ptemp, prh, zjnuc, znsa, znoc, zdcrit, zksa, &
4241	zkocnv )
4242	CALL sumnucl( pcsa, pcocnv, zjnuc, zdcrit, znsa, znoc, zksa, zkocnv )
4243
4244
4245	CASE(7) ! Heteromolecular nucleation, J~[H2SO4]*[ORG]
4246
4247	zc_h2so4 = pcsa * 1.0E-6_wp ! sulphuric acid conc. to #/cm3
4248	zc_org = pcocnv * 1.0E-6_wp ! conc. of non-volatile OC to #/cm3
4249	CALL binnucl( zc_h2so4, ptemp, prh, zjnuc, znsa, znoc, zdcrit, zksa, &
4250	zkocnv )
4251	CALL hetnucl( zc_h2so4, zc_org, zjnuc, zdcrit, znsa, znoc, zksa, zkocnv )
4252
4253	CASE(8) ! Homomolecular nucleation of H2SO4 and heteromolecular
4254	! nucleation of H2SO4 and organic vapour,
4255	! J~[H2SO4]*2 + [H2SO4][ORG] (EUCAARI project)
4256	zc_h2so4 = pcsa * 1.0E-6_wp ! sulphuric acid conc. to #/cm3
4257	zc_org = pcocnv * 1.0E-6_wp ! conc. of non-volatile OC to #/cm3
4258	CALL binnucl( zc_h2so4, ptemp, prh, zjnuc, znsa, znoc, zdcrit, zksa, &
4259	zkocnv )
4260	CALL SAnucl( zc_h2so4, zc_org, zjnuc, zdcrit, znsa, znoc, zksa, zkocnv )
4261
4262	CASE(9) ! Homomolecular nucleation of H2SO4 and organic vapour and
4263	! heteromolecular nucleation of H2SO4 and organic vapour,
4264	! J~[H2SO4]*2 + [H2SO4][ORG]+[ORG]**2 (EUCAARI project)
4265
4266	zc_h2so4 = pcsa * 1.0E-6_wp ! sulphuric acid conc. to #/cm3
4267	zc_org = pcocnv * 1.0E-6_wp ! conc. of non-volatile OC to #/cm3
4268	CALL binnucl( zc_h2so4, ptemp, prh, zjnuc, znsa, znoc, zdcrit, zksa, &
4269	zkocnv )
4270
4271	CALL SAORGnucl( zc_h2so4, zc_org, zjnuc, zdcrit, znsa, znoc, zksa, &
4272	zkocnv )
4273	END SELECT
4274
4275	zcsa_local = pcsa
4276	zcocnv_local = pcocnv
4277	!
4278	!-- 2) Change of particle and gas concentrations due to nucleation
4279	!
4280	!-- 2.1) Check that there is enough H2SO4 and organic vapour to produce the
4281	!-- nucleation
4282	IF ( nsnucl <= 4 ) THEN
4283	!-- If the chosen nucleation scheme is 1-4, nucleation occurs only due to
4284	!-- H2SO4. All of the total vapour concentration that is taking part to the
4285	!-- nucleation is there for sulphuric acid (sa = H2SO4) and non-volatile
4286	!-- organic vapour is zero.
4287	pxsa = 1.0_wp ! ratio of sulphuric acid in 3nm particles
4288	pxocnv = 0.0_wp ! ratio of non-volatile origanic vapour
4289	! in 3nm particles
4290	ELSEIF ( nsnucl > 4 ) THEN
4291	!-- If the chosen nucleation scheme is 5-9, nucleation occurs due to organic
4292	!-- vapour or the combination of organic vapour and H2SO4. The number of
4293	!-- needed molecules depends on the chosen nucleation type and it has an
4294	!-- effect also on the minimum ratio of the molecules present.
4295	IF ( pcsa * znsa + pcocnv * znoc < 1.E-14_wp ) THEN
4296	pxsa = 0.0_wp
4297	pxocnv = 0.0_wp
4298	ELSE
4299	pxsa = pcsa * znsa / ( pcsa * znsa + pcocnv * znoc )
4300	pxocnv = pcocnv * znoc / ( pcsa * znsa + pcocnv * znoc )
4301	ENDIF
4302	ENDIF
4303	!
4304	!-- The change in total vapour concentration is the sum of the concentrations
4305	!-- of the vapours taking part to the nucleation (depends on the chosen
4306	!-- nucleation scheme)
4307	zdelta_vap = MIN( zjnuc * ( znoc + znsa ), ( pcocnv * zkocnv + pcsa * &
4308	zksa ) / ptstep )
4309	!
4310	!-- Nucleation rate J at ~1nm (#/m3s)
4311	zjnuc = zdelta_vap / ( znoc + znsa )
4312	!
4313	!-- H2SO4 concentration after nucleation in #/m3
4314	zcsa_local = MAX( 1.0_wp, pcsa - zdelta_vap * pxsa )
4315	!
4316	!-- Non-volative organic vapour concentration after nucleation (#/m3)
4317	zcocnv_local = MAX( 1.0_wp, pcocnv - zdelta_vap * pxocnv )
4318	!
4319	!-- 2.2) Formation rate of 3 nm particles (Kerminen & Kulmala, 2002)
4320	!
4321	!-- 2.2.1) Growth rate of clusters formed by H2SO4
4322	!
4323	!-- GR = 3.0e-15 / dens_clus * sum( molecspeed * molarmass * conc )
4324	!
4325	!-- dens_clus = density of the clusters (here 1830 kg/m3)
4326	!-- molarmass = molar mass of condensing species (here 98.08 g/mol)
4327	!-- conc = concentration of condensing species [#/m3]
4328	!-- molecspeed = molecular speed of condensing species [m/s]
4329	!-- = sqrt( 8.0 * R * ptemp / ( pi * molarmass ) )
4330	!-- (Seinfeld & Pandis, 1998)
4331	!
4332	!-- Growth rate by H2SO4 and organic vapour in nm/h (Eq. 21)
4333	zGRclust = 2.3623E-15_wp * SQRT( ptemp ) * ( zcsa_local + zcocnv_local )
4334	!
4335	!-- 2.2.2) Condensational sink of pre-existing particle population
4336	!
4337	!-- Diffusion coefficient (m2/s)
4338	zdfvap = 5.1111E-10_wp * ptemp ** 1.75_wp * ( p_0 + 1325.0_wp ) / ppres
4339	!-- Mean free path of condensing vapour (m) (Jacobson (2005), Eq. 15.25 and
4340	!-- 16.29)
4341	zmfp = 3.0_wp * zdfvap * SQRT( pi * amh2so4 / ( 8.0_wp * argas * ptemp ) )
4342	!-- Knudsen number
4343	zknud = 2.0_wp * zmfp / ( paero(:)%dwet + d_sa )
4344	!-- Transitional regime correction factor (zbeta) according to Fuchs and
4345	!-- Sutugin (1971), In: Hidy et al. (ed.), Topics in current aerosol research,
4346	!-- Pergamon. (Eq. 4 in Kerminen and Kulmala, 2002)
4347	zbeta = ( zknud + 1.0_wp) / ( 0.377_wp * zknud + 1.0_wp + 4.0_wp / &
4348	( 3.0_wp * massacc ) * ( zknud + zknud ** 2 ) )
4349	!-- Condensational sink (#/m2) (Eq. 3)
4350	zcsink = SUM( paero(:)%dwet * zbeta * paero(:)%numc )
4351	!
4352	!-- Parameterised formation rate of detectable 3 nm particles (i.e. J3)
4353	IF ( nj3 == 1 ) THEN ! Kerminen and Kulmala (2002)
4354	!-- 2.2.3) Parameterised formation rate of detectable 3 nm particles
4355	!-- Constants needed for the parameterisation:
4356	!-- dapp = 3 nm and dens_nuc = 1830 kg/m3
4357	IF ( zcsink < 1.0E-30_wp ) THEN
4358	zeta = 0._dp
4359	ELSE
4360	!-- Mean diameter of backgroud population (nm)
4361	zdmean = 1.0_wp / SUM( paero(:)%numc ) * SUM( paero(:)%numc * &
4362	paero(:)%dwet ) * 1.0E+9_wp
4363	!-- Proportionality factor (nm2*m2/h) (Eq. 22)
4364	zgamma = 0.23_wp * ( zdcrit * 1.0E+9_wp ) ** 0.2_wp * ( zdmean / &
4365	150.0_wp ) ** 0.048_wp * ( ptemp / 293.0_wp ) ** ( -0.75_wp ) &
4366	* ( arhoh2so4 / 1000.0_wp ) ** ( -0.33_wp )
4367	!-- Factor eta (nm) (Eq. 11)
4368	zeta = MIN( zgamma * zcsink / zGRclust, zdcrit * 1.0E11_wp )
4369	ENDIF
4370	!
4371	!-- Number conc. of clusters surviving to 3 nm in a time step (#/m3) (Eq.14)
4372	zj3 = zjnuc * EXP( MIN( 0.0_wp, zeta / 3.0_wp - zeta / &
4373	( zdcrit * 1.0E9_wp ) ) )
4374
4375	ELSEIF ( nj3 > 1 ) THEN
4376	!-- Defining the value for zm_para. The growth is investigated between
4377	!-- [d1,reglim(1)] = [zdcrit,3nm]
4378	!-- m = LOG( CoagS_dx / CoagX_zdcrit ) / LOG( reglim / zdcrit )
4379	!-- (Lehtinen et al. 2007, Eq. 5)
4380	!-- The steps for the coagulation sink for reglim = 3nm and zdcrit ~= 1nm are
4381	!-- explained in article of Kulmala et al. (2001). The particles of diameter
4382	!-- zdcrit ~1.14 nm and reglim = 3nm are both in turn the "number 1"
4383	!-- variables (Kulmala et al. 2001).
4384	!-- c = critical (1nm), x = 3nm, 2 = wet or mean droplet
4385	!-- Sum of the radii, R12 = R1 + zR2 (m) of two particles 1 and 2
4386	zRc2 = zdcrit / 2.0_wp + paero(:)%dwet / 2.0_wp
4387	zRx2 = reglim(1) / 2.0_wp + paero(:)%dwet / 2.0_wp
4388	!
4389	!-- The mass of particle (kg) (comes only from H2SO4)
4390	zm_c = 4.0_wp / 3.0_wp * pi * ( zdcrit / 2.0_wp ) ** 3.0_wp * arhoh2so4
4391	zm_x = 4.0_wp / 3.0_wp * pi * ( reglim(1) / 2.0_wp ) ** 3.0_wp * &
4392	arhoh2so4
4393	zm_2 = 4.0_wp / 3.0_wp * pi * ( paero(:)%dwet / 2.0_wp )** 3.0_wp * &
4394	arhoh2so4
4395	!
4396	!-- Mean relative thermal velocity between the particles (m/s)
4397	zcv_c = SQRT( 8.0_wp * abo * ptemp / ( pi * zm_c ) )
4398	zcv_x = SQRT( 8.0_wp * abo * ptemp / ( pi * zm_x ) )
4399	zcv_2 = SQRT( 8.0_wp * abo * ptemp / ( pi * zm_2 ) )
4400	!
4401	!-- Average velocity after coagulation
4402	zcv_c2 = SQRT( zcv_c 2.0_wp + zcv_2 2.0_wp )
4403	zcv_x2 = SQRT( zcv_x 2.0_wp + zcv_2 2.0_wp )
4404	!
4405	!-- Knudsen number (zmfp = mean free path of condensing vapour)
4406	zknud_c = 2.0_wp * zmfp / zdcrit
4407	zknud_x = 2.0_wp * zmfp / reglim(1)
4408	zknud_2 = MAX( 0.0_wp, 2.0_wp * zmfp / paero(:)%dwet )
4409	!
4410	!-- Cunningham correction factor
4411	zCc_c = 1.0_wp + zknud_c * ( 1.142_wp + 0.558_wp * &
4412	EXP( -0.999_wp / zknud_c ) )
4413	zCc_x = 1.0_wp + zknud_x * ( 1.142_wp + 0.558_wp * &
4414	EXP( -0.999_wp / zknud_x ) )
4415	zCc_2 = 1.0_wp + zknud_2 * ( 1.142_wp + 0.558_wp * &
4416	EXP( -0.999_wp / zknud_2 ) )
4417	!
4418	!-- Gas dynamic viscosity (N*s/m2).
4419	!-- Viscocity(air @20C) = 1.81e-5_dp N/m2 *s (Hinds, p. 25)
4420	zmyy = 1.81E-5_wp * ( ptemp / 293.0_wp) ** ( 0.74_wp )
4421	!
4422	!-- Particle diffusion coefficient (m2/s)
4423	zDc_c = abo * ptemp * zCc_c / ( 3.0_wp * pi * zmyy * zdcrit )
4424	zDc_x = abo * ptemp * zCc_x / ( 3.0_wp * pi * zmyy * reglim(1) )
4425	zDc_2 = abo * ptemp * zCc_2 / ( 3.0_wp * pi * zmyy * paero(:)%dwet )
4426	!
4427	!-- D12 = D1+D2 (Seinfield and Pandis, 2nd ed. Eq. 13.38)
4428	zDc_c2 = zDc_c + zDc_2
4429	zDc_x2 = zDc_x + zDc_2
4430	!
4431	!-- zgammaF = 8*D/pi/zcv (m) for calculating zomega
4432	zgammaF_c = 8.0_wp * zDc_c / pi / zcv_c
4433	zgammaF_x = 8.0_wp * zDc_x / pi / zcv_x
4434	zgammaF_2 = 8.0_wp * zDc_2 / pi / zcv_2
4435	!
4436	!-- zomega (m) for calculating zsigma
4437	zomega_c = ( ( zRc2 + zgammaF_c ) 3 - ( zRc2 2 + &
4438	zgammaF_c ) ** ( 3.0_wp / 2.0_wp ) ) / ( 3.0_wp * &
4439	zRc2 * zgammaF_c ) - zRc2
4440	zomega_x = ( ( zRx2 + zgammaF_x ) 3.0_wp - ( zRx2 2.0_wp + &
4441	zgammaF_x ) ** ( 3.0_wp / 2.0_wp ) ) / ( 3.0_wp * &
4442	zRx2 * zgammaF_x ) - zRx2
4443	zomega_2c = ( ( zRc2 + zgammaF_2 ) 3.0_wp - ( zRc2 2.0_wp + &
4444	zgammaF_2 ) ** ( 3.0_wp / 2.0_wp ) ) / ( 3.0_wp * &
4445	zRc2 * zgammaF_2 ) - zRc2
4446	zomega_2x = ( ( zRx2 + zgammaF_2 ) 3.0_wp - ( zRx2 2.0_wp + &
4447	zgammaF_2 ) ** ( 3.0_wp / 2.0_wp ) ) / ( 3.0_wp * &
4448	zRx2 * zgammaF_2 ) - zRx2
4449	!
4450	!-- The distance (m) at which the two fluxes are matched (condensation and
4451	!-- coagulation sinks?)
4452	zsigma_c2 = SQRT( zomega_c 2.0_wp + zomega_2c 2.0_wp )
4453	zsigma_x2 = SQRT( zomega_x 2.0_wp + zomega_2x 2.0_wp )
4454	!
4455	!-- Coagulation coefficient in the continuum regime (m*m2/s)
4456	zK_c2 = 4.0_wp * pi * zRc2 * zDc_c2 / ( zRc2 / ( zRc2 + zsigma_c2 ) + &
4457	4.0_wp * zDc_c2 / ( zcv_c2 * zRc2 ) )
4458	zK_x2 = 4.0_wp * pi * zRx2 * zDc_x2 / ( zRx2 / ( zRx2 + zsigma_x2 ) + &
4459	4.0_wp * zDc_x2 / ( zcv_x2 * zRx2 ) )
4460	!
4461	!-- Coagulation sink (1/s)
4462	zCoagS_c = MAX( 1.0E-20_wp, SUM( zK_c2 * paero(:)%numc ) )
4463	zCoagS_x = MAX( 1.0E-20_wp, SUM( zK_x2 * paero(:)%numc ) )
4464	!
4465	!-- Parameter m for calculating the coagulation sink onto background
4466	!-- particles (Eq. 5&6 in Lehtinen et al. 2007)
4467	zm_para = LOG( zCoagS_x / zCoagS_c ) / LOG( reglim(1) / zdcrit )
4468	!
4469	!-- Parameter gamma for calculating the formation rate J of particles having
4470	!-- a diameter zdcrit < d < reglim(1) (Anttila et al. 2010, eq. 5)
4471	zgamma = ( ( ( reglim(1) / zdcrit ) ** ( zm_para + 1.0_wp ) ) - 1.0_wp )&
4472	/ ( zm_para + 1.0_wp )
4473
4474	IF ( nj3 == 2 ) THEN ! Coagulation sink
4475	!
4476	!-- Formation rate J before iteration (#/m3s)
4477	zj3 = zjnuc * EXP( MIN( 0.0_wp, -zgamma * zdcrit * zCoagS_c / &
4478	( zGRclust * 1.0E-9_wp / ( 60.0_wp ** 2.0_wp ) ) ) )
4479
4480	ELSEIF ( nj3 == 3 ) THEN ! Coagulation sink and self-coag.
4481	!-- IF polluted air... then the self-coagulation becomes important.
4482	!-- Self-coagulation of small particles < 3 nm.
4483	!
4484	!-- "Effective" coagulation coefficient between freshly-nucleated
4485	!-- particles:
4486	zKeff = 5.0E-16_wp ! cm3/s
4487	!
4488	!-- zlambda parameter for "adjusting" the growth rate due to the
4489	!-- self-coagulation
4490	zlambda = 6.0_wp
4491	IF ( reglim(1) >= 10.0E-9_wp ) THEN ! for particles >10 nm:
4492	zKeff = 5.0E-17_wp
4493	zlambda = 3.0_wp
4494	ENDIF
4495	!
4496	!-- Initial values for coagulation sink and growth rate (m/s)
4497	zCoagStot = zCoagS_c
4498	zGRtot = zGRclust * 1.0E-9_wp / 60.0_wp ** 2.0_wp
4499	!
4500	!-- Number of clusters/particles at the size range [d1,dx] (#/m3):
4501	zNnuc = zjnuc / zCoagStot !< Initial guess
4502	!
4503	!-- Coagulation sink and growth rate due to self-coagulation:
4504	DO iteration = 1, 5
4505	zCoagStot = zCoagS_c + zKeff * zNnuc * 1.0E-6_wp ! (1/s)
4506	zGRtot = zGRclust * 1.0E-9_wp / ( 3600.0_wp ) + 1.5708E-6_wp * &
4507	zlambda * zdcrit ** 3.0_wp * ( zNnuc * 1.0E-6_wp ) * &
4508	zcv_c * avo * 1.0E-9_wp / 3600.0_wp
4509	zeta = - zCoagStot / ( ( zm_para + 1.0_wp ) * zGRtot * ( zdcrit **&
4510	zm_para ) ) ! Eq. 7b (Anttila)
4511	zNnuc = zNnuc_tayl( zdcrit, reglim(1), zm_para, zjnuc, zeta, &
4512	zGRtot )
4513	ENDDO
4514	!
4515	!-- Calculate the final values with new zNnuc:
4516	zCoagStot = zCoagS_c + zKeff * zNnuc * 1.0E-6_wp ! (1/s)
4517	zGRtot = zGRclust * 1.0E-9_wp / 3600.0_wp + 1.5708E-6_wp * zlambda &
4518	* zdcrit ** 3.0_wp * ( zNnuc * 1.0E-6_wp ) * zcv_c * avo * &
4519	1.0E-9_wp / 3600.0_wp !< (m/s)
4520	zj3 = zjnuc * EXP( MIN( 0.0_wp, -zgamma * zdcrit * zCoagStot / &
4521	zGRtot ) ) ! (Eq. 5a) (#/m3s)
4522
4523	ENDIF
4524
4525	ENDIF
4526	!-- If J3 very small (< 1 #/cm3), neglect particle formation. In real atmosphere
4527	!-- this would mean that clusters form but coagulate to pre-existing particles
4528	!-- who gain sulphate. Since CoagS ~ CS (4piDCS'), we do not* update H2SO4
4529	!-- concentration here but let condensation take care of it.
4530	!-- Formation mass rate of molecules (molec/m3s) for 1: H2SO4 and 2: organic
4531	!-- vapour
4532	pj3n3(1) = zj3 * n3 * pxsa
4533	pj3n3(2) = zj3 * n3 * pxocnv
4534
4535
4536	END SUBROUTINE nucleation
4537
4538	!------------------------------------------------------------------------------!
4539	! Description:
4540	! ------------
4541	!> Calculate the nucleation rate and the size of critical clusters assuming
4542	!> binary nucleation.
4543	!> Parametrisation according to Vehkamaki et al. (2002), J. Geophys. Res.,
4544	!> 107(D22), 4622. Called from subroutine nucleation.
4545	!------------------------------------------------------------------------------!
4546	SUBROUTINE binnucl( pc_sa, ptemp, prh, pnuc_rate, pn_crit_sa, pn_crit_ocnv, &
4547	pd_crit, pk_sa, pk_ocnv )
4548
4549	IMPLICIT NONE
4550	!
4551	!-- Input and output variables
4552	REAL(wp), INTENT(in) :: pc_sa !< H2SO4 conc. (#/cm3)
4553	REAL(wp), INTENT(in) :: prh !< relative humidity [0-1]
4554	REAL(wp), INTENT(in) :: ptemp !< ambient temperature (K)
4555	REAL(wp), INTENT(out) :: pnuc_rate !< nucleation rate (#/(m3 s))
4556	REAL(wp), INTENT(out) :: pn_crit_sa !< number of H2SO4 molecules in
4557	!< cluster (#)
4558	REAL(wp), INTENT(out) :: pn_crit_ocnv !< number of organic molecules in
4559	!< cluster (#)
4560	REAL(wp), INTENT(out) :: pd_crit !< diameter of critical cluster (m)
4561	REAL(wp), INTENT(out) :: pk_sa !< Lever: if pk_sa = 1, H2SO4 is
4562	!< involved in nucleation.
4563	REAL(wp), INTENT(out) :: pk_ocnv !< Lever: if pk_ocnv = 1, organic
4564	!< compounds are involved in
4565	!< nucleation.
4566	!-- Local variables
4567	REAL(wp) :: zx !< mole fraction of sulphate in critical cluster
4568	REAL(wp) :: zntot !< number of molecules in critical cluster
4569	REAL(wp) :: zt !< temperature
4570	REAL(wp) :: zpcsa !< sulfuric acid concentration
4571	REAL(wp) :: zrh !< relative humidity
4572	REAL(wp) :: zma !<
4573	REAL(wp) :: zmw !<
4574	REAL(wp) :: zxmass!<
4575	REAL(wp) :: za !<
4576	REAL(wp) :: zb !<
4577	REAL(wp) :: zc !<
4578	REAL(wp) :: zroo !<
4579	REAL(wp) :: zm1 !<
4580	REAL(wp) :: zm2 !<
4581	REAL(wp) :: zv1 !<
4582	REAL(wp) :: zv2 !<
4583	REAL(wp) :: zcoll !<
4584
4585	pnuc_rate = 0.0_wp
4586	pd_crit = 1.0E-9_wp
4587
4588	!
4589	!-- 1) Checking that we are in the validity range of the parameterization
4590	zt = MAX( ptemp, 190.15_wp )
4591	zt = MIN( zt, 300.15_wp )
4592	zpcsa = MAX( pc_sa, 1.0E4_wp )
4593	zpcsa = MIN( zpcsa, 1.0E11_wp )
4594	zrh = MAX( prh, 0.0001_wp )
4595	zrh = MIN( zrh, 1.0_wp )
4596	!
4597	!-- 2) Mole fraction of sulphate in a critical cluster (Eq. 11)
4598	zx = 0.7409967177282139_wp &
4599	- 0.002663785665140117_wp * zt &
4600	+ 0.002010478847383187_wp * LOG( zrh ) &
4601	- 0.0001832894131464668_wp* zt * LOG( zrh ) &
4602	+ 0.001574072538464286_wp * LOG( zrh ) ** 2 &
4603	- 0.00001790589121766952_wp * zt * LOG( zrh ) ** 2 &
4604	+ 0.0001844027436573778_wp * LOG( zrh ) ** 3 &
4605	- 1.503452308794887E-6_wp * zt * LOG( zrh ) ** 3 &
4606	- 0.003499978417957668_wp * LOG( zpcsa ) &
4607	+ 0.0000504021689382576_wp * zt * LOG( zpcsa )
4608	!
4609	!-- 3) Nucleation rate (Eq. 12)
4610	pnuc_rate = 0.1430901615568665_wp &
4611	+ 2.219563673425199_wp * zt &
4612	- 0.02739106114964264_wp * zt ** 2 &
4613	+ 0.00007228107239317088_wp * zt ** 3 &
4614	+ 5.91822263375044_wp / zx &
4615	+ 0.1174886643003278_wp * LOG( zrh ) &
4616	+ 0.4625315047693772_wp * zt * LOG( zrh ) &
4617	- 0.01180591129059253_wp * zt ** 2 * LOG( zrh ) &
4618	+ 0.0000404196487152575_wp * zt ** 3 * LOG( zrh ) &
4619	+ ( 15.79628615047088_wp * LOG( zrh ) ) / zx &
4620	- 0.215553951893509_wp * LOG( zrh ) ** 2 &
4621	- 0.0810269192332194_wp * zt * LOG( zrh ) ** 2 &
4622	+ 0.001435808434184642_wp * zt ** 2 * LOG( zrh ) ** 2 &
4623	- 4.775796947178588E-6_wp * zt ** 3 * LOG( zrh ) ** 2 &
4624	- (2.912974063702185_wp * LOG( zrh ) ** 2 ) / zx &
4625	- 3.588557942822751_wp * LOG( zrh ) ** 3 &
4626	+ 0.04950795302831703_wp * zt * LOG( zrh ) ** 3 &
4627	- 0.0002138195118737068_wp * zt ** 2 * LOG( zrh ) ** 3 &
4628	+ 3.108005107949533E-7_wp * zt ** 3 * LOG( zrh ) ** 3 &
4629	- ( 0.02933332747098296_wp * LOG( zrh ) ** 3 ) / zx &
4630	+ 1.145983818561277_wp * LOG( zpcsa ) &
4631	- 0.6007956227856778_wp * zt * LOG( zpcsa ) &
4632	+ 0.00864244733283759_wp * zt ** 2 * LOG( zpcsa ) &
4633	- 0.00002289467254710888_wp * zt ** 3 * LOG( zpcsa ) &
4634	- ( 8.44984513869014_wp * LOG( zpcsa ) ) / zx &
4635	+ 2.158548369286559_wp * LOG( zrh ) * LOG( zpcsa ) &
4636	+ 0.0808121412840917_wp * zt * LOG( zrh ) * LOG( zpcsa ) &
4637	- 0.0004073815255395214_wp * zt ** 2 * LOG( zrh ) * LOG( zpcsa ) &
4638	- 4.019572560156515E-7_wp * zt ** 3 * LOG( zrh ) * LOG( zpcsa ) &
4639	+ ( 0.7213255852557236_wp * LOG( zrh ) * LOG( zpcsa ) ) / zx &
4640	+ 1.62409850488771_wp * LOG( zrh ) ** 2 * LOG( zpcsa ) &
4641	- 0.01601062035325362_wp * zt * LOG( zrh ) ** 2 * LOG( zpcsa ) &
4642	+ 0.00003771238979714162_wpzt2 LOG( zrh )*2 LOG( zpcsa ) &
4643	+ 3.217942606371182E-8_wp * zt*3 LOG( zrh )*2 LOG( zpcsa ) &
4644	- (0.01132550810022116_wp * LOG( zrh )*2 LOG( zpcsa ) ) / zx &
4645	+ 9.71681713056504_wp * LOG( zpcsa ) ** 2 &
4646	- 0.1150478558347306_wp * zt * LOG( zpcsa ) ** 2 &
4647	+ 0.0001570982486038294_wp * zt ** 2 * LOG( zpcsa ) ** 2 &
4648	+ 4.009144680125015E-7_wp * zt ** 3 * LOG( zpcsa ) ** 2 &
4649	+ ( 0.7118597859976135_wp * LOG( zpcsa ) ** 2 ) / zx &
4650	- 1.056105824379897_wp * LOG( zrh ) * LOG( zpcsa ) ** 2 &
4651	+ 0.00903377584628419_wp * zt * LOG( zrh ) * LOG( zpcsa )**2 &
4652	- 0.00001984167387090606_wpzt2LOG( zrh )LOG( zpcsa )*2 &
4653	+ 2.460478196482179E-8_wp * zt*3 LOG( zrh ) * LOG( zpcsa )**2 &
4654	- ( 0.05790872906645181_wp * LOG( zrh ) * LOG( zpcsa )**2 ) / zx &
4655	- 0.1487119673397459_wp * LOG( zpcsa ) ** 3 &
4656	+ 0.002835082097822667_wp * zt * LOG( zpcsa ) ** 3 &
4657	- 9.24618825471694E-6_wp * zt ** 2 * LOG( zpcsa ) ** 3 &
4658	+ 5.004267665960894E-9_wp * zt ** 3 * LOG( zpcsa ) ** 3 &
4659	- ( 0.01270805101481648_wp * LOG( zpcsa ) ** 3 ) / zx
4660	!
4661	!-- Nucleation rate in #/(cm3 s)
4662	pnuc_rate = EXP( pnuc_rate )
4663	!
4664	!-- Check the validity of parameterization
4665	IF ( pnuc_rate < 1.0E-7_wp ) THEN
4666	pnuc_rate = 0.0_wp
4667	pd_crit = 1.0E-9_wp
4668	ENDIF
4669	!
4670	!-- 4) Total number of molecules in the critical cluster (Eq. 13)
4671	zntot = - 0.002954125078716302_wp &
4672	- 0.0976834264241286_wp * zt &
4673	+ 0.001024847927067835_wp * zt ** 2 &
4674	- 2.186459697726116E-6_wp * zt ** 3 &
4675	- 0.1017165718716887_wp / zx &
4676	- 0.002050640345231486_wp * LOG( zrh ) &
4677	- 0.007585041382707174_wp * zt * LOG( zrh ) &
4678	+ 0.0001926539658089536_wp * zt ** 2 * LOG( zrh ) &
4679	- 6.70429719683894E-7_wp * zt ** 3 * LOG( zrh ) &
4680	- ( 0.2557744774673163_wp * LOG( zrh ) ) / zx &
4681	+ 0.003223076552477191_wp * LOG( zrh ) ** 2 &
4682	+ 0.000852636632240633_wp * zt * LOG( zrh ) ** 2 &
4683	- 0.00001547571354871789_wp * zt ** 2 * LOG( zrh ) ** 2 &
4684	+ 5.666608424980593E-8_wp * zt ** 3 * LOG( zrh ) ** 2 &
4685	+ ( 0.03384437400744206_wp * LOG( zrh ) ** 2 ) / zx &
4686	+ 0.04743226764572505_wp * LOG( zrh ) ** 3 &
4687	- 0.0006251042204583412_wp * zt * LOG( zrh ) ** 3 &
4688	+ 2.650663328519478E-6_wp * zt ** 2 * LOG( zrh ) ** 3 &
4689	- 3.674710848763778E-9_wp * zt ** 3 * LOG( zrh ) ** 3 &
4690	- ( 0.0002672510825259393_wp * LOG( zrh ) ** 3 ) / zx &
4691	- 0.01252108546759328_wp * LOG( zpcsa ) &
4692	+ 0.005806550506277202_wp * zt * LOG( zpcsa ) &
4693	- 0.0001016735312443444_wp * zt ** 2 * LOG( zpcsa ) &
4694	+ 2.881946187214505E-7_wp * zt ** 3 * LOG( zpcsa ) &
4695	+ ( 0.0942243379396279_wp * LOG( zpcsa ) ) / zx &
4696	- 0.0385459592773097_wp * LOG( zrh ) * LOG( zpcsa ) &
4697	- 0.0006723156277391984_wp * zt * LOG( zrh ) * LOG( zpcsa ) &
4698	+ 2.602884877659698E-6_wp * zt ** 2 * LOG( zrh ) * LOG( zpcsa ) &
4699	+ 1.194163699688297E-8_wp * zt ** 3 * LOG( zrh ) * LOG( zpcsa ) &
4700	- ( 0.00851515345806281_wp * LOG( zrh ) * LOG( zpcsa ) ) / zx &
4701	- 0.01837488495738111_wp * LOG( zrh ) ** 2 * LOG( zpcsa ) &
4702	+ 0.0001720723574407498_wp * zt * LOG( zrh ) ** 2 * LOG( zpcsa ) &
4703	- 3.717657974086814E-7_wp * zt*2 LOG( zrh )*2 LOG( zpcsa ) &
4704	- 5.148746022615196E-10_wp * zt*3 LOG( zrh )*2 LOG( zpcsa ) &
4705	+ ( 0.0002686602132926594_wp * LOG(zrh)*2 LOG(zpcsa) ) / zx &
4706	- 0.06199739728812199_wp * LOG( zpcsa ) ** 2 &
4707	+ 0.000906958053583576_wp * zt * LOG( zpcsa ) ** 2 &
4708	- 9.11727926129757E-7_wp * zt ** 2 * LOG( zpcsa ) ** 2 &
4709	- 5.367963396508457E-9_wp * zt ** 3 * LOG( zpcsa ) ** 2 &
4710	- ( 0.007742343393937707_wp * LOG( zpcsa ) ** 2 ) / zx &
4711	+ 0.0121827103101659_wp * LOG( zrh ) * LOG( zpcsa ) ** 2 &
4712	- 0.0001066499571188091_wp * zt * LOG( zrh ) * LOG( zpcsa ) ** 2 &
4713	+ 2.534598655067518E-7_wp * zt*2 LOG( zrh ) * LOG( zpcsa )**2 &
4714	- 3.635186504599571E-10_wp * zt*3 LOG( zrh ) * LOG( zpcsa )**2 &
4715	+ ( 0.0006100650851863252_wp * LOG( zrh ) * LOG( zpcsa ) **2 )/ zx &
4716	+ 0.0003201836700403512_wp * LOG( zpcsa ) ** 3 &
4717	- 0.0000174761713262546_wp * zt * LOG( zpcsa ) ** 3 &
4718	+ 6.065037668052182E-8_wp * zt ** 2 * LOG( zpcsa ) ** 3 &
4719	- 1.421771723004557E-11_wp * zt ** 3 * LOG( zpcsa ) ** 3 &
4720	+ ( 0.0001357509859501723_wp * LOG( zpcsa ) ** 3 ) / zx
4721	zntot = EXP( zntot ) ! in #
4722	!
4723	!-- 5) Size of the critical cluster pd_crit (m) (diameter) (Eq. 14)
4724	pn_crit_sa = zx * zntot
4725	pd_crit = 2.0E-9_wp * EXP( -1.6524245_wp + 0.42316402_wp * zx + &
4726	0.33466487_wp * LOG( zntot ) )
4727	!
4728	!-- 6) Organic compounds not involved when binary nucleation is assumed
4729	pn_crit_ocnv = 0.0_wp ! number of organic molecules
4730	pk_sa = 1.0_wp ! if = 1, H2SO4 involved in nucleation
4731	pk_ocnv = 0.0_wp ! if = 1, organic compounds involved
4732	!
4733	!-- Set nucleation rate to collision rate
4734	IF ( pn_crit_sa < 4.0_wp ) THEN
4735	!
4736	!-- Volumes of the colliding objects
4737	zma = 96.0_wp ! molar mass of SO4 in g/mol
4738	zmw = 18.0_wp ! molar mass of water in g/mol
4739	zxmass = 1.0_wp ! mass fraction of H2SO4
4740	za = 0.7681724_wp + zxmass * ( 2.1847140_wp + zxmass * ( &
4741	7.1630022_wp + zxmass * ( -44.31447_wp + zxmass * ( &
4742	88.75606 + zxmass * ( -75.73729_wp + zxmass * &
4743	23.43228_wp ) ) ) ) )
4744	zb = 1.808225E-3_wp + zxmass * ( -9.294656E-3_wp + zxmass * &
4745	( -0.03742148_wp + zxmass * ( 0.2565321_wp + zxmass * &
4746	( -0.5362872_wp + zxmass * ( 0.4857736 - zxmass * &
4747	0.1629592_wp ) ) ) ) )
4748	zc = - 3.478524E-6_wp + zxmass * ( 1.335867E-5_wp + zxmass * &
4749	( 5.195706E-5_wp + zxmass * ( -3.717636E-4_wp + zxmass * &
4750	( 7.990811E-4_wp + zxmass * ( -7.458060E-4_wp + zxmass * &
4751	2.58139E-4_wp ) ) ) ) )
4752	!
4753	!-- Density for the sulphuric acid solution (Eq. 10 in Vehkamaki)
4754	zroo = za + zt * ( zb + zc * zt ) ! g/cm^3
4755	zroo = zroo * 1.0E+3_wp ! kg/m^3
4756	zm1 = 0.098_wp ! molar mass of H2SO4 in kg/mol
4757	zm2 = zm1
4758	zv1 = zm1 / avo / zroo ! volume
4759	zv2 = zv1
4760	!
4761	!-- Collision rate
4762	zcoll = zpcsa * zpcsa * ( 3.0_wp * pi / 4.0_wp ) ** ( 1.0_wp / 6.0_wp )&
4763	* SQRT( 6.0_wp * argas * zt / zm1 + 6.0_wp * argas * zt / zm2 )&
4764	* ( zv1 ( 1.0_wp / 3.0_wp ) + zv2 ( 1.0_wp /3.0_wp ) ) **&
4765	2.0_wp * 1.0E+6_wp ! m3 -> cm3
4766
4767	zcoll = MIN( zcoll, 1.0E+10_wp )
4768	pnuc_rate = zcoll ! (#/(cm3 s))
4769
4770	ELSE
4771	pnuc_rate = MIN( pnuc_rate, 1.0E+10_wp )
4772	ENDIF
4773	pnuc_rate = pnuc_rate * 1.0E+6_wp ! (#/(m3 s))
4774
4775	END SUBROUTINE binnucl
4776
4777	!------------------------------------------------------------------------------!
4778	! Description:
4779	! ------------
4780	!> Calculate the nucleation rate and the size of critical clusters assuming
4781	!> ternary nucleation. Parametrisation according to:
4782	!> Napari et al. (2002), J. Chem. Phys., 116, 4221-4227 and
4783	!> Napari et al. (2002), J. Geophys. Res., 107(D19), AAC 6-1-ACC 6-6.
4784	!> Called from subroutine nucleation.
4785	!------------------------------------------------------------------------------!
4786	SUBROUTINE ternucl( pc_sa, pc_nh3, ptemp, prh, pnuc_rate, pn_crit_sa, &
4787	pn_crit_ocnv, pd_crit, pk_sa, pk_ocnv )
4788
4789	IMPLICIT NONE
4790
4791	!-- Input and output variables
4792	REAL(wp), INTENT(in) :: pc_nh3 !< ammonia mixing ratio (ppt)
4793	REAL(wp), INTENT(in) :: pc_sa !< H2SO4 conc. (#/cm3)
4794	REAL(wp), INTENT(in) :: prh !< relative humidity [0-1]
4795	REAL(wp), INTENT(in) :: ptemp !< ambient temperature (K)
4796	REAL(wp), INTENT(out) :: pd_crit !< diameter of critical
4797	!< cluster (m)
4798	REAL(wp), INTENT(out) :: pk_ocnv !< Lever: if pk_ocnv = 1,organic compounds
4799	!< are involved in nucleation
4800	REAL(wp), INTENT(out) :: pk_sa !< Lever: if pk_sa = 1, H2SO4 is involved
4801	!< in nucleation
4802	REAL(wp), INTENT(out) :: pn_crit_ocnv !< number of organic molecules in
4803	!< cluster (#)
4804	REAL(wp), INTENT(out) :: pn_crit_sa !< number of H2SO4 molecules in
4805	!< cluster (#)
4806	REAL(wp), INTENT(out) :: pnuc_rate !< nucleation rate (#/(m3 s))
4807	!-- Local variables
4808	REAL(wp) :: zlnj !< logarithm of nucleation rate
4809
4810	!-- 1) Checking that we are in the validity range of the parameterization.
4811	!-- Validity of parameterization : DO NOT REMOVE!
4812	IF ( ptemp < 240.0_wp .OR. ptemp > 300.0_wp ) THEN
4813	message_string = 'Invalid input value: ptemp'
4814	CALL message( 'salsa_mod: ternucl', 'SA0045', 1, 2, 0, 6, 0 )
4815	ENDIF
4816	IF ( prh < 0.05_wp .OR. prh > 0.95_wp ) THEN
4817	message_string = 'Invalid input value: prh'
4818	CALL message( 'salsa_mod: ternucl', 'SA0046', 1, 2, 0, 6, 0 )
4819	ENDIF
4820	IF ( pc_sa < 1.0E+4_wp .OR. pc_sa > 1.0E+9_wp ) THEN
4821	message_string = 'Invalid input value: pc_sa'
4822	CALL message( 'salsa_mod: ternucl', 'SA0047', 1, 2, 0, 6, 0 )
4823	ENDIF
4824	IF ( pc_nh3 < 0.1_wp .OR. pc_nh3 > 100.0_wp ) THEN
4825	message_string = 'Invalid input value: pc_nh3'
4826	CALL message( 'salsa_mod: ternucl', 'SA0048', 1, 2, 0, 6, 0 )
4827	ENDIF
4828	!
4829	!-- 2) Nucleation rate (Eq. 7 in Napari et al., 2002: Parameterization of
4830	!-- ternary nucleation of sulfuric acid - ammonia - water.
4831	zlnj = - 84.7551114741543_wp &
4832	+ 0.3117595133628944_wp * prh &
4833	+ 1.640089605712946_wp * prh * ptemp &
4834	- 0.003438516933381083_wp * prh * ptemp ** 2.0_wp &
4835	- 0.00001097530402419113_wp * prh * ptemp ** 3.0_wp &
4836	- 0.3552967070274677_wp / LOG( pc_sa ) &
4837	- ( 0.06651397829765026_wp * prh ) / LOG( pc_sa ) &
4838	- ( 33.84493989762471_wp * ptemp ) / LOG( pc_sa ) &
4839	- ( 7.823815852128623_wp * prh * ptemp ) / LOG( pc_sa) &
4840	+ ( 0.3453602302090915_wp * ptemp ** 2.0_wp ) / LOG( pc_sa ) &
4841	+ ( 0.01229375748100015_wp * prh * ptemp ** 2.0_wp ) / LOG( pc_sa ) &
4842	- ( 0.000824007160514956_wp ptemp * 3.0_wp ) / LOG( pc_sa ) &
4843	+ ( 0.00006185539100670249_wp * prh * ptemp ** 3.0_wp ) &
4844	/ LOG( pc_sa ) &
4845	+ 3.137345238574998_wp * LOG( pc_sa ) &
4846	+ 3.680240980277051_wp * prh * LOG( pc_sa ) &
4847	- 0.7728606202085936_wp * ptemp * LOG( pc_sa ) &
4848	- 0.204098217156962_wp * prh * ptemp * LOG( pc_sa ) &
4849	+ 0.005612037586790018_wp * ptemp ** 2.0_wp * LOG( pc_sa ) &
4850	+ 0.001062588391907444_wp * prh * ptemp ** 2.0_wp * LOG( pc_sa ) &
4851	- 9.74575691760229E-6_wp * ptemp ** 3.0_wp * LOG( pc_sa ) &
4852	- 1.265595265137352E-6_wp * prh * ptemp ** 3.0_wp * LOG( pc_sa ) &
4853	+ 19.03593713032114_wp * LOG( pc_sa ) ** 2.0_wp &
4854	- 0.1709570721236754_wp * ptemp * LOG( pc_sa ) ** 2.0_wp &
4855	+ 0.000479808018162089_wp * ptemp ** 2.0_wp * LOG( pc_sa ) ** 2.0_wp&
4856	- 4.146989369117246E-7_wp * ptemp ** 3.0_wp * LOG( pc_sa ) ** 2.0_wp&
4857	+ 1.076046750412183_wp * LOG( pc_nh3 ) &
4858	+ 0.6587399318567337_wp * prh * LOG( pc_nh3 ) &
4859	+ 1.48932164750748_wp * ptemp * LOG( pc_nh3 ) &
4860	+ 0.1905424394695381_wp * prh * ptemp * LOG( pc_nh3 ) &
4861	- 0.007960522921316015_wp * ptemp ** 2.0_wp * LOG( pc_nh3 ) &
4862	- 0.001657184248661241_wp * prh * ptemp ** 2.0_wp * LOG( pc_nh3 ) &
4863	+ 7.612287245047392E-6_wp * ptemp ** 3.0_wp * LOG( pc_nh3 ) &
4864	+ 3.417436525881869E-6_wp * prh * ptemp ** 3.0_wp * LOG( pc_nh3 ) &
4865	+ ( 0.1655358260404061_wp * LOG( pc_nh3 ) ) / LOG( pc_sa) &
4866	+ ( 0.05301667612522116_wp * prh * LOG( pc_nh3 ) ) / LOG( pc_sa ) &
4867	+ ( 3.26622914116752_wp * ptemp * LOG( pc_nh3 ) ) / LOG( pc_sa ) &
4868	- ( 1.988145079742164_wp * prh * ptemp * LOG( pc_nh3 ) ) &
4869	/ LOG( pc_sa ) &
4870	- ( 0.04897027401984064_wp * ptemp ** 2.0_wp * LOG( pc_nh3) ) &
4871	/ LOG( pc_sa ) &
4872	+ ( 0.01578269253599732_wp * prh * ptemp ** 2.0_wp * LOG( pc_nh3 ) &
4873	) / LOG( pc_sa ) &
4874	+ ( 0.0001469672236351303_wp * ptemp ** 3.0_wp * LOG( pc_nh3 ) ) &
4875	/ LOG( pc_sa ) &
4876	- ( 0.00002935642836387197_wp * prh * ptemp ** 3.0_wp *LOG( pc_nh3 )&
4877	) / LOG( pc_sa ) &
4878	+ 6.526451177887659_wp * LOG( pc_sa ) * LOG( pc_nh3 ) &
4879	- 0.2580021816722099_wp * ptemp * LOG( pc_sa ) * LOG( pc_nh3 ) &
4880	+ 0.001434563104474292_wp * ptemp ** 2.0_wp * LOG( pc_sa ) &
4881	* LOG( pc_nh3 ) &
4882	- 2.020361939304473E-6_wp * ptemp ** 3.0_wp * LOG( pc_sa ) &
4883	* LOG( pc_nh3 ) &
4884	- 0.160335824596627_wp * LOG( pc_sa ) ** 2.0_wp * LOG( pc_nh3 ) &
4885	+ 0.00889880721460806_wp * ptemp * LOG( pc_sa ) ** 2.0_wp &
4886	* LOG( pc_nh3 ) &
4887	- 0.00005395139051155007_wp * ptemp ** 2.0_wp &
4888	* LOG( pc_sa) ** 2.0_wp * LOG( pc_nh3 ) &
4889	+ 8.39521718689596E-8_wp * ptemp ** 3.0_wp * LOG( pc_sa ) ** 2.0_wp&
4890	* LOG( pc_nh3 ) &
4891	+ 6.091597586754857_wp * LOG( pc_nh3 ) ** 2.0_wp &
4892	+ 8.5786763679309_wp * prh * LOG( pc_nh3 ) ** 2.0_wp &
4893	- 1.253783854872055_wp * ptemp * LOG( pc_nh3 ) ** 2.0_wp &
4894	- 0.1123577232346848_wp * prh * ptemp * LOG( pc_nh3 ) ** 2.0_wp &
4895	+ 0.00939835595219825_wp * ptemp ** 2.0_wp * LOG( pc_nh3 ) ** 2.0_wp&
4896	+ 0.0004726256283031513_wp * prh * ptemp ** 2.0_wp &
4897	* LOG( pc_nh3) ** 2.0_wp &
4898	- 0.00001749269360523252_wp * ptemp ** 3.0_wp &
4899	* LOG( pc_nh3 ) ** 2.0_wp &
4900	- 6.483647863710339E-7_wp * prh * ptemp ** 3.0_wp &
4901	* LOG( pc_nh3 ) ** 2.0_wp &
4902	+ ( 0.7284285726576598_wp * LOG( pc_nh3 ) ** 2.0_wp ) / LOG( pc_sa )&
4903	+ ( 3.647355600846383_wp * ptemp * LOG( pc_nh3 ) ** 2.0_wp ) &
4904	/ LOG( pc_sa ) &
4905	- ( 0.02742195276078021_wp * ptemp ** 2.0_wp &
4906	* LOG( pc_nh3) ** 2.0_wp ) / LOG( pc_sa ) &
4907	+ ( 0.00004934777934047135_wp * ptemp ** 3.0_wp &
4908	* LOG( pc_nh3 ) ** 2.0_wp ) / LOG( pc_sa ) &
4909	+ 41.30162491567873_wp * LOG( pc_sa ) * LOG( pc_nh3 ) ** 2.0_wp &
4910	- 0.357520416800604_wp * ptemp * LOG( pc_sa ) &
4911	* LOG( pc_nh3 ) ** 2.0_wp &
4912	+ 0.000904383005178356_wp * ptemp ** 2.0_wp * LOG( pc_sa ) &
4913	* LOG( pc_nh3 ) ** 2.0_wp &
4914	- 5.737876676408978E-7_wp * ptemp ** 3.0_wp * LOG( pc_sa ) &
4915	* LOG( pc_nh3 ) ** 2.0_wp &
4916	- 2.327363918851818_wp * LOG( pc_sa ) ** 2.0_wp &
4917	* LOG( pc_nh3 ) ** 2.0_wp &
4918	+ 0.02346464261919324_wp * ptemp * LOG( pc_sa ) ** 2.0_wp &
4919	* LOG( pc_nh3 ) ** 2.0_wp &
4920	- 0.000076518969516405_wp * ptemp ** 2.0_wp &
4921	* LOG( pc_sa ) ** 2.0_wp * LOG( pc_nh3 ) ** 2.0_wp &
4922	+ 8.04589834836395E-8_wp * ptemp ** 3.0_wp * LOG( pc_sa ) ** 2.0_wp &
4923	* LOG( pc_nh3 ) ** 2.0_wp &
4924	- 0.02007379204248076_wp * LOG( prh ) &
4925	- 0.7521152446208771_wp * ptemp * LOG( prh ) &
4926	+ 0.005258130151226247_wp * ptemp ** 2.0_wp * LOG( prh ) &
4927	- 8.98037634284419E-6_wp * ptemp ** 3.0_wp * LOG( prh ) &
4928	+ ( 0.05993213079516759_wp * LOG( prh ) ) / LOG( pc_sa ) &
4929	+ ( 5.964746463184173_wp * ptemp * LOG( prh ) ) / LOG( pc_sa ) &
4930	- ( 0.03624322255690942_wp * ptemp ** 2.0_wp * LOG( prh ) ) &
4931	/ LOG( pc_sa ) &
4932	+ ( 0.00004933369382462509_wp * ptemp ** 3.0_wp * LOG( prh ) ) &
4933	/ LOG( pc_sa ) &
4934	- 0.7327310805365114_wp * LOG( pc_nh3 ) * LOG( prh ) &
4935	- 0.01841792282958795_wp * ptemp * LOG( pc_nh3 ) * LOG( prh ) &
4936	+ 0.0001471855981005184_wp * ptemp ** 2.0_wp * LOG( pc_nh3 ) &
4937	* LOG( prh ) &
4938	- 2.377113195631848E-7_wp * ptemp ** 3.0_wp * LOG( pc_nh3 ) &
4939	* LOG( prh )
4940	pnuc_rate = EXP( zlnj ) ! (#/(cm3 s))
4941	!
4942	!-- Check validity of parametrization
4943	IF ( pnuc_rate < 1.0E-5_wp ) THEN
4944	pnuc_rate = 0.0_wp
4945	pd_crit = 1.0E-9_wp
4946	ELSEIF ( pnuc_rate > 1.0E6_wp ) THEN
4947	message_string = 'Invalid output value: nucleation rate > 10^6 1/cm3s'
4948	CALL message( 'salsa_mod: ternucl', 'SA0049', 1, 2, 0, 6, 0 )
4949	ENDIF
4950	pnuc_rate = pnuc_rate * 1.0E6_wp ! (#/(m3 s))
4951	!
4952	!-- 3) Number of H2SO4 molecules in a critical cluster (Eq. 9)
4953	pn_crit_sa = 38.16448247950508_wp + 0.7741058259731187_wp * zlnj + &
4954	0.002988789927230632_wp * zlnj ** 2.0_wp - &
4955	0.3576046920535017_wp * ptemp - &
4956	0.003663583011953248_wp * zlnj * ptemp + &
4957	0.000855300153372776_wp * ptemp ** 2.0_wp
4958	!-- Kinetic limit: at least 2 H2SO4 molecules in a cluster
4959	pn_crit_sa = MAX( pn_crit_sa, 2.0E0_wp )
4960	!
4961	!-- 4) Size of the critical cluster in nm (Eq. 12)
4962	pd_crit = 0.1410271086638381_wp - 0.001226253898894878_wp * zlnj - &
4963	7.822111731550752E-6_wp * zlnj ** 2.0_wp - &
4964	0.001567273351921166_wp * ptemp - &
4965	0.00003075996088273962_wp * zlnj * ptemp + &
4966	0.00001083754117202233_wp * ptemp ** 2.0_wp
4967	pd_crit = pd_crit * 2.0E-9_wp ! Diameter in m
4968	!
4969	!-- 5) Organic compounds not involved when ternary nucleation assumed
4970	pn_crit_ocnv = 0.0_wp
4971	pk_sa = 1.0_wp
4972	pk_ocnv = 0.0_wp
4973
4974	END SUBROUTINE ternucl
4975
4976	!------------------------------------------------------------------------------!
4977	! Description:
4978	! ------------
4979	!> Calculate the nucleation rate and the size of critical clusters assuming
4980	!> kinetic nucleation. Each sulphuric acid molecule forms an (NH4)HSO4 molecule
4981	!> in the atmosphere and two colliding (NH4)HSO4 molecules form a stable
4982	!> cluster. See Sihto et al. (2006), Atmos. Chem. Phys., 6(12), 4079-4091.
4983	!>
4984	!> Below the following assumption have been made:
4985	!> nucrate = coagcoeffzpcsa*2
4986	!> coagcoeff = 8sqrt(3boltzptempr_abs/dens_abs)
4987	!> r_abs = 0.315d-9 radius of bisulphate molecule [m]
4988	!> dens_abs = 1465 density of - " - [kg/m3]
4989	!------------------------------------------------------------------------------!
4990	SUBROUTINE kinnucl( pc_sa, pnuc_rate, pd_crit, pn_crit_sa, pn_crit_ocnv, &
4991	pk_sa, pk_ocnv )
4992
4993	IMPLICIT NONE
4994
4995	!-- Input and output variables
4996	REAL(wp), INTENT(in) :: pc_sa !< H2SO4 conc. (#/m3)
4997	REAL(wp), INTENT(out) :: pd_crit !< critical diameter of clusters (m)
4998	REAL(wp), INTENT(out) :: pk_ocnv !< Lever: if pk_ocnv = 1, organic
4999	!< compounds are involved in nucleation
5000	REAL(wp), INTENT(out) :: pk_sa !< Lever: if pk_sa = 1, H2SO4 is involved
5001	!< in nucleation
5002	REAL(wp), INTENT(out) :: pn_crit_ocnv !< number of organic molecules in
5003	!< cluster (#)
5004	REAL(wp), INTENT(out) :: pn_crit_sa !< number of H2SO4 molecules in
5005	!< cluster (#)
5006	REAL(wp), INTENT(out) :: pnuc_rate !< nucl. rate (#/(m3 s))
5007
5008	!-- Nucleation rate (#/(m3 s))
5009	pnuc_rate = 5.0E-13_wp * pc_sa ** 2.0_wp * 1.0E+6_wp
5010	!-- Organic compounds not involved when kinetic nucleation is assumed.
5011	pn_crit_sa = 2.0_wp
5012	pn_crit_ocnv = 0.0_wp
5013	pk_sa = 1.0_wp
5014	pk_ocnv = 0.0_wp
5015	pd_crit = 7.9375E-10_wp ! (m)
5016
5017	END SUBROUTINE kinnucl
5018	!------------------------------------------------------------------------------!
5019	! Description:
5020	! ------------
5021	!> Calculate the nucleation rate and the size of critical clusters assuming
5022	!> activation type nucleation.
5023	!> See Riipinen et al. (2007), Atmos. Chem. Phys., 7(8), 1899-1914.
5024	!------------------------------------------------------------------------------!
5025	SUBROUTINE actnucl( psa_conc, pnuc_rate, pd_crit, pn_crit_sa, pn_crit_ocnv, &
5026	pk_sa, pk_ocnv, activ )
5027
5028	IMPLICIT NONE
5029
5030	!-- Input and output variables
5031	REAL(wp), INTENT(in) :: psa_conc !< H2SO4 conc. (#/m3)
5032	REAL(wp), INTENT(in) :: activ !<
5033	REAL(wp), INTENT(out) :: pd_crit !< critical diameter of clusters (m)
5034	REAL(wp), INTENT(out) :: pk_ocnv !< Lever: if pk_ocnv = 1, organic
5035	!< compounds are involved in nucleation
5036	REAL(wp), INTENT(out) :: pk_sa !< Lever: if pk_sa = 1, H2SO4 is involved
5037	!< in nucleation
5038	REAL(wp), INTENT(out) :: pn_crit_ocnv !< number of organic molecules in
5039	!< cluster (#)
5040	REAL(wp), INTENT(out) :: pn_crit_sa !< number of H2SO4 molecules in
5041	!< cluster (#)
5042	REAL(wp), INTENT(out) :: pnuc_rate !< nucl. rate (#/(m3 s))
5043
5044	!-- act_coeff 1e-7 by default
5045	pnuc_rate = activ * psa_conc ! (#/(m3 s))
5046	!-- Organic compounds not involved when kinetic nucleation is assumed.
5047	pn_crit_sa = 2.0_wp
5048	pn_crit_ocnv = 0.0_wp
5049	pk_sa = 1.0_wp
5050	pk_ocnv = 0.0_wp
5051	pd_crit = 7.9375E-10_wp ! (m)
5052	END SUBROUTINE actnucl
5053	!------------------------------------------------------------------------------!
5054	! Description:
5055	! ------------
5056	!> Conciders only the organic matter in nucleation. Paasonen et al. (2010)
5057	!> determined particle formation rates for 2 nm particles, J2, from different
5058	!> kind of combinations of sulphuric acid and organic matter concentration.
5059	!> See Paasonen et al. (2010), Atmos. Chem. Phys., 10, 11223-11242.
5060	!------------------------------------------------------------------------------!
5061	SUBROUTINE orgnucl( pc_org, pnuc_rate, pd_crit, pn_crit_sa, pn_crit_ocnv, &
5062	pk_sa, pk_ocnv )
5063
5064	IMPLICIT NONE
5065
5066	!-- Input and output variables
5067	REAL(wp), INTENT(in) :: pc_org !< organic vapour concentration (#/m3)
5068	REAL(wp), INTENT(out) :: pd_crit !< critical diameter of clusters (m)
5069	REAL(wp), INTENT(out) :: pk_ocnv !< Lever: if pk_ocnv = 1, organic
5070	!< compounds are involved in nucleation
5071	REAL(wp), INTENT(out) :: pk_sa !< Lever: if pk_sa = 1, H2SO4 is involved
5072	!< in nucleation
5073	REAL(wp), INTENT(out) :: pn_crit_ocnv !< number of organic molecules in
5074	!< cluster (#)
5075	REAL(wp), INTENT(out) :: pn_crit_sa !< number of H2SO4 molecules in
5076	!< cluster (#)
5077	REAL(wp), INTENT(out) :: pnuc_rate !< nucl. rate (#/(m3 s))
5078	!-- Local variables
5079	REAL(wp) :: Aorg = 1.3E-7_wp !< (1/s) (Paasonen et al. Table 4: median)
5080
5081	!-- Homomolecular nuleation - which one?
5082	pnuc_rate = Aorg * pc_org
5083	!-- H2SO4 not involved when pure organic nucleation is assumed.
5084	pn_crit_sa = 0.0_wp
5085	pn_crit_ocnv = 1.0_wp
5086	pk_sa = 0.0_wp
5087	pk_ocnv = 1.0_wp
5088	pd_crit = 1.5E-9_wp ! (m)
5089
5090	END SUBROUTINE orgnucl
5091	!------------------------------------------------------------------------------!
5092	! Description:
5093	! ------------
5094	!> Conciders both the organic vapor and H2SO4 in nucleation - activation type
5095	!> of nucleation.
5096	!> See Paasonen et al. (2010), Atmos. Chem. Phys., 10, 11223-11242.
5097	!------------------------------------------------------------------------------!
5098	SUBROUTINE sumnucl( pc_sa, pc_org, pnuc_rate, pd_crit, pn_crit_sa, &
5099	pn_crit_ocnv, pk_sa, pk_ocnv )
5100
5101	IMPLICIT NONE
5102
5103	!-- Input and output variables
5104	REAL(wp), INTENT(in) :: pc_org !< organic vapour concentration (#/m3)
5105	REAL(wp), INTENT(in) :: pc_sa !< H2SO4 conc. (#/m3)
5106	REAL(wp), INTENT(out) :: pd_crit !< critical diameter of clusters (m)
5107	REAL(wp), INTENT(out) :: pk_ocnv !< Lever: if pk_ocnv = 1, organic
5108	!< compounds are involved in nucleation
5109	REAL(wp), INTENT(out) :: pk_sa !< Lever: if pk_sa = 1, H2SO4 is involved
5110	!< in nucleation
5111	REAL(wp), INTENT(out) :: pn_crit_ocnv !< number of organic molecules in
5112	!< cluster (#)
5113	REAL(wp), INTENT(out) :: pn_crit_sa !< number of H2SO4 molecules in
5114	!< cluster (#)
5115	REAL(wp), INTENT(out) :: pnuc_rate !< nucl. rate (#/(m3 s))
5116	!-- Local variables
5117	REAL(wp) :: As1 = 6.1E-7_wp !< (1/s)
5118	REAL(wp) :: As2 = 0.39E-7_wp !< (1/s) (Paasonen et al. Table 3.)
5119
5120	!-- Nucleation rate (#/m3/s)
5121	pnuc_rate = As1 * pc_sa + As2 * pc_org
5122	!-- Both Organic compounds and H2SO4 are involved when SUMnucleation is assumed.
5123	pn_crit_sa = 1.0_wp
5124	pn_crit_ocnv = 1.0_wp
5125	pk_sa = 1.0_wp
5126	pk_ocnv = 1.0_wp
5127	pd_crit = 1.5E-9_wp ! (m)
5128
5129	END SUBROUTINE sumnucl
5130	!------------------------------------------------------------------------------!
5131	! Description:
5132	! ------------
5133	!> Conciders both the organic vapor and H2SO4 in nucleation - heteromolecular
5134	!> nucleation.
5135	!> See Paasonen et al. (2010), Atmos. Chem. Phys., 10, 11223-11242.
5136	!------------------------------------------------------------------------------!
5137	SUBROUTINE hetnucl( pc_sa, pc_org, pnuc_rate, pd_crit, pn_crit_sa, &
5138	pn_crit_ocnv, pk_sa, pk_ocnv )
5139
5140	IMPLICIT NONE
5141
5142	!-- Input and output variables
5143	REAL(wp), INTENT(in) :: pc_org !< organic vapour concentration (#/m3)
5144	REAL(wp), INTENT(in) :: pc_sa !< H2SO4 conc. (#/m3)
5145	REAL(wp), INTENT(out) :: pd_crit !< critical diameter of clusters (m)
5146	REAL(wp), INTENT(out) :: pk_ocnv !< Lever: if pk_ocnv = 1, organic
5147	!< compounds are involved in nucleation
5148	REAL(wp), INTENT(out) :: pk_sa !< Lever: if pk_sa = 1, H2SO4 is involved
5149	!< in nucleation
5150	REAL(wp), INTENT(out) :: pn_crit_ocnv !< number of organic molecules in
5151	!< cluster (#)
5152	REAL(wp), INTENT(out) :: pn_crit_sa !< number of H2SO4 molecules in
5153	!< cluster (#)
5154	REAL(wp), INTENT(out) :: pnuc_rate !< nucl. rate (#/(m3 s))
5155	!-- Local variables
5156	REAL(wp) :: zKhet = 4.1E-14_wp !< (cm3/s) (Paasonen et al. Table 4: median)
5157
5158	!-- Nucleation rate (#/m3/s)
5159	pnuc_rate = zKhet * pc_sa * pc_org * 1.0E6_wp
5160	!-- Both Organic compounds and H2SO4 are involved when heteromolecular
5161	!-- nucleation is assumed.
5162	pn_crit_sa = 1.0_wp
5163	pn_crit_ocnv = 1.0_wp
5164	pk_sa = 1.0_wp
5165	pk_ocnv = 1.0_wp
5166	pd_crit = 1.5E-9_wp ! (m)
5167
5168	END SUBROUTINE hetnucl
5169	!------------------------------------------------------------------------------!
5170	! Description:
5171	! ------------
5172	!> Takes into account the homomolecular nucleation of sulphuric acid H2SO4 with
5173	!> both of the available vapours.
5174	!> See Paasonen et al. (2010), Atmos. Chem. Phys., 10, 11223-11242.
5175	!------------------------------------------------------------------------------!
5176	SUBROUTINE SAnucl( pc_sa, pc_org, pnuc_rate, pd_crit, pn_crit_sa, &
5177	pn_crit_ocnv, pk_sa, pk_ocnv )
5178
5179	IMPLICIT NONE
5180
5181	!-- Input and output variables
5182	REAL(wp), INTENT(in) :: pc_org !< organic vapour concentration (#/m3)
5183	REAL(wp), INTENT(in) :: pc_sa !< H2SO4 conc. (#/m3)
5184	REAL(wp), INTENT(out) :: pd_crit !< critical diameter of clusters (m)
5185	REAL(wp), INTENT(out) :: pk_ocnv !< Lever: if pk_ocnv = 1, organic
5186	!< compounds are involved in nucleation
5187	REAL(wp), INTENT(out) :: pk_sa !< Lever: if pk_sa = 1, H2SO4 is involved
5188	!< in nucleation
5189	REAL(wp), INTENT(out) :: pn_crit_ocnv !< number of organic molecules in
5190	!< cluster (#)
5191	REAL(wp), INTENT(out) :: pn_crit_sa !< number of H2SO4 molecules in
5192	!< cluster (#)
5193	REAL(wp), INTENT(out) :: pnuc_rate !< nucleation rate (#/(m3 s))
5194	!-- Local variables
5195	REAL(wp) :: zKsa1 = 1.1E-14_wp !< (cm3/s)
5196	REAL(wp) :: zKsa2 = 3.2E-14_wp !< (cm3/s) (Paasonen et al. Table 3.)
5197
5198	!-- Nucleation rate (#/m3/s)
5199	pnuc_rate = ( zKsa1 * pc_sa ** 2.0_wp + zKsa2 * pc_sa * pc_org ) * 1.0E+6_wp
5200	!-- Both Organic compounds and H2SO4 are involved when SAnucleation is assumed.
5201	pn_crit_sa = 3.0_wp
5202	pn_crit_ocnv = 1.0_wp
5203	pk_sa = 1.0_wp
5204	pk_ocnv = 1.0_wp
5205	pd_crit = 1.5E-9_wp ! (m)
5206
5207	END SUBROUTINE SAnucl
5208	!------------------------------------------------------------------------------!
5209	! Description:
5210	! ------------
5211	!> Takes into account the homomolecular nucleation of both sulphuric acid and
5212	!> Lorganic with heteromolecular nucleation.
5213	!> See Paasonen et al. (2010), Atmos. Chem. Phys., 10, 11223-11242.
5214	!------------------------------------------------------------------------------!
5215	SUBROUTINE SAORGnucl( pc_sa, pc_org, pnuc_rate, pd_crit, pn_crit_sa, &
5216	pn_crit_ocnv, pk_sa, pk_ocnv )
5217
5218	IMPLICIT NONE
5219
5220	!-- Input and output variables
5221	REAL(wp), INTENT(in) :: pc_org !< organic vapour concentration (#/m3)
5222	REAL(wp), INTENT(in) :: pc_sa !< H2SO4 conc. (#/m3)
5223	REAL(wp), INTENT(out) :: pd_crit !< critical diameter of clusters (m)
5224	REAL(wp), INTENT(out) :: pk_ocnv !< Lever: if pk_ocnv = 1, organic
5225	!< compounds are involved in nucleation
5226	REAL(wp), INTENT(out) :: pk_sa !< Lever: if pk_sa = 1, H2SO4 is involved
5227	!< in nucleation
5228	REAL(wp), INTENT(out) :: pn_crit_ocnv !< number of organic molecules in
5229	!< cluster (#)
5230	REAL(wp), INTENT(out) :: pn_crit_sa !< number of H2SO4 molecules in
5231	!< cluster (#)
5232	REAL(wp), INTENT(out) :: pnuc_rate !< nucl. rate (#/(m3 s))
5233	!-- Local variables
5234	REAL(wp) :: zKs1 = 1.4E-14_wp !< (cm3/s])
5235	REAL(wp) :: zKs2 = 2.6E-14_wp !< (cm3/s])
5236	REAL(wp) :: zKs3 = 0.037E-14_wp !< (cm3/s]) (Paasonen et al. Table 3.)
5237
5238	!-- Nucleation rate (#/m3/s)
5239	pnuc_rate = ( zKs1 * pc_sa *2 + zKs2 pc_sa * pc_org + zKs3 * &
5240	pc_org ** 2.0_wp ) * 1.0E+6_wp
5241	!-- Organic compounds not involved when kinetic nucleation is assumed.
5242	pn_crit_sa = 3.0_wp
5243	pn_crit_ocnv = 3.0_wp
5244	pk_sa = 1.0_wp
5245	pk_ocnv = 1.0_wp
5246	pd_crit = 1.5E-9_wp ! (m)
5247
5248	END SUBROUTINE SAORGnucl
5249
5250	!------------------------------------------------------------------------------!
5251	! Description:
5252	! ------------
5253	!> Function zNnuc_tayl is connected to the calculation of self-coagualtion of
5254	!> small particles. It calculates number of the particles in the size range
5255	!> [zdcrit,dx] using Taylor-expansion (please note that the expansion is not
5256	!> valid for certain rational numbers, e.g. -4/3 and -3/2)
5257	!------------------------------------------------------------------------------!
5258	FUNCTION zNnuc_tayl( d1, dx, zm_para, zjnuc_t, zeta, zGRtot )
5259	IMPLICIT NONE
5260
5261	INTEGER(iwp) :: i
5262	REAL(wp) :: d1
5263	REAL(wp) :: dx
5264	REAL(wp) :: zjnuc_t
5265	REAL(wp) :: zeta
5266	REAL(wp) :: term1
5267	REAL(wp) :: term2
5268	REAL(wp) :: term3
5269	REAL(wp) :: term4
5270	REAL(wp) :: term5
5271	REAL(wp) :: zNnuc_tayl
5272	REAL(wp) :: zGRtot
5273	REAL(wp) :: zm_para
5274
5275	zNnuc_tayl = 0.0_wp
5276
5277	DO i = 0, 29
5278	IF ( i == 0 .OR. i == 1 ) THEN
5279	term1 = 1.0_wp
5280	ELSE
5281	term1 = term1 * REAL( i, SELECTED_REAL_KIND(12,307) )
5282	END IF
5283	term2 = ( REAL( i, SELECTED_REAL_KIND(12,307) ) * ( zm_para + 1.0_wp &
5284	) + 1.0_wp ) * term1
5285	term3 = zeta ** i
5286	term4 = term3 / term2
5287	term5 = REAL( i, SELECTED_REAL_KIND(12,307) ) * ( zm_para + 1.0_wp ) &
5288	+ 1.0_wp
5289	zNnuc_tayl = zNnuc_tayl + term4 * ( dx term5 - d1 term5 )
5290	ENDDO
5291	zNnuc_tayl = zNnuc_tayl * zjnuc_t * EXP( -zeta * &
5292	( d1 ** ( zm_para + 1 ) ) ) / zGRtot
5293
5294	END FUNCTION zNnuc_tayl
5295
5296	!------------------------------------------------------------------------------!
5297	! Description:
5298	! ------------
5299	!> Calculates the condensation of water vapour on aerosol particles. Follows the
5300	!> analytical predictor method by Jacobson (2005).
5301	!> For equations, see Jacobson (2005), Fundamentals of atmospheric modelling
5302	!> (2nd edition).
5303	!------------------------------------------------------------------------------!
5304	SUBROUTINE gpparth2o( paero, ptemp, ppres, pcs, pcw, ptstep )
5305
5306	IMPLICIT NONE
5307	!
5308	!-- Input and output variables
5309	REAL(wp), INTENT(in) :: ppres !< Air pressure (Pa)
5310	REAL(wp), INTENT(in) :: pcs !< Water vapour saturation
5311	!< concentration (kg/m3)
5312	REAL(wp), INTENT(in) :: ptemp !< Ambient temperature (K)
5313	REAL(wp), INTENT(in) :: ptstep !< timestep (s)
5314	REAL(wp), INTENT(inout) :: pcw !< Water vapour concentration
5315	!< (kg/m3)
5316	TYPE(t_section), INTENT(inout) :: paero(nbins) !< Aerosol properties
5317	!-- Local variables
5318	INTEGER(iwp) :: b !< loop index
5319	INTEGER(iwp) :: nstr
5320	REAL(wp) :: adt !< internal timestep in this subroutine
5321	REAL(wp) :: adtc(nbins)
5322	REAL(wp) :: rhoair
5323	REAL(wp) :: ttot
5324	REAL(wp) :: zact !< Water activity
5325	REAL(wp) :: zaelwc1 !< Current aerosol water content
5326	REAL(wp) :: zaelwc2 !< New aerosol water content after
5327	!< equilibrium calculation
5328	REAL(wp) :: zbeta !< Transitional correction factor
5329	REAL(wp) :: zcwc !< Current water vapour mole concentration
5330	REAL(wp) :: zcwcae(nbins) !< Current water mole concentrations
5331	!< in aerosols
5332	REAL(wp) :: zcwint !< Current and new water vapour mole concentrations
5333	REAL(wp) :: zcwintae(nbins) !< Current and new water mole concentrations
5334	!< in aerosols
5335	REAL(wp) :: zcwn !< New water vapour mole concentration
5336	REAL(wp) :: zcwnae(nbins) !< New water mole concentration in aerosols
5337	REAL(wp) :: zcwsurfae(nbins) !< Surface mole concentration
5338	REAL(wp) :: zcwtot !< Total water mole concentration
5339	REAL(wp) :: zdfh2o
5340	REAL(wp) :: zhlp1
5341	REAL(wp) :: zhlp2
5342	REAL(wp) :: zhlp3
5343	REAL(wp) :: zka(nbins) !< Activity coefficient
5344	REAL(wp) :: zkelvin(nbins) !< Kelvin effect
5345	REAL(wp) :: zknud
5346	REAL(wp) :: zmfph2o !< mean free path of H2O gas molecule
5347	REAL(wp) :: zmtae(nbins) !< Mass transfer coefficients
5348	REAL(wp) :: zrh !< Relative humidity [0-1]
5349	REAL(wp) :: zthcond
5350	REAL(wp) :: zwsatae(nbins) !< Water saturation ratio above aerosols
5351	!
5352	!-- Relative humidity [0-1]
5353	zrh = pcw / pcs
5354	!-- Calculate the condensation only for 2a/2b aerosol bins
5355	nstr = in2a
5356	!-- Save the current aerosol water content, 8 in paero is H2O
5357	zaelwc1 = SUM( paero(in1a:fn2b)%volc(8) ) * arhoh2o
5358	!
5359	!-- Equilibration:
5360	IF ( advect_particle_water ) THEN
5361	IF ( zrh < 0.98_wp .OR. .NOT. lscndh2oae ) THEN
5362	CALL equilibration( zrh, ptemp, paero, .TRUE. )
5363	ELSE
5364	CALL equilibration( zrh, ptemp, paero, .FALSE. )
5365	ENDIF
5366	ENDIF
5367	!
5368	!-- The new aerosol water content after equilibrium calculation
5369	zaelwc2 = SUM( paero(in1a:fn2b)%volc(8) ) * arhoh2o
5370	!-- New water vapour mixing ratio (kg/m3)
5371	pcw = pcw - ( zaelwc2 - zaelwc1 ) * ppres * amdair / ( argas * ptemp )
5372	!
5373	!-- Initialise variables
5374	adtc(:) = 0.0_wp
5375	zcwc = 0.0_wp
5376	zcwcae = 0.0_wp
5377	zcwint = 0.0_wp
5378	zcwintae = 0.0_wp
5379	zcwn = 0.0_wp
5380	zcwnae = 0.0_wp
5381	zhlp1 = 0.0_wp
5382	zwsatae = 0.0_wp
5383	!
5384	!-- Air:
5385	!-- Density (kg/m3)
5386	rhoair = amdair * ppres / ( argas * ptemp )
5387	!-- Thermal conductivity of air
5388	zthcond = 0.023807_wp + 7.1128E-5_wp * ( ptemp - 273.16_wp )
5389	!
5390	!-- Water vapour:
5391	!
5392	!-- Molecular diffusion coefficient (cm2/s) (eq.16.17)
5393	zdfh2o = ( 5.0_wp / ( 16.0_wp * avo * rhoair * 1.0E-3_wp * &
5394	( 3.11E-8_wp ) ** 2.0_wp ) ) * SQRT( argas * 1.0E+7_wp * ptemp * &
5395	amdair * 1.0E+3_wp * ( amh2o + amdair ) * 1.0E+3_wp / ( 2.0_wp * &
5396	pi * amh2o * 1.0E+3_wp ) )
5397	zdfh2o = zdfh2o * 1.0E-4 ! Unit change to m^2/s
5398	!
5399	!-- Mean free path (eq. 15.25 & 16.29)
5400	zmfph2o = 3.0_wp * zdfh2o * SQRT( pi * amh2o / ( 8.0_wp * argas * ptemp ) )
5401	zka = 1.0_wp ! Assume activity coefficients as 1 for now.
5402	!
5403	!-- Kelvin effect (eq. 16.33)
5404	zkelvin = 1.0_wp
5405	zkelvin(1:nbins) = EXP( 4.0_wp * surfw0 * amh2o / ( argas * ptemp * &
5406	arhoh2o * paero(1:nbins)%dwet) )
5407	!
5408	! --Aerosols:
5409	zmtae(:) = 0.0_wp ! mass transfer coefficient
5410	zcwsurfae(:) = 0.0_wp ! surface mole concentrations
5411	DO b = 1, nbins
5412	IF ( paero(b)%numc > nclim .AND. zrh > 0.98_wp ) THEN
5413	!
5414	!-- Water activity
5415	zact = acth2o( paero(b) )
5416	!
5417	!-- Saturation mole concentration over flat surface. Limit the super-
5418	!-- saturation to max 1.01 for the mass transfer. Experimental!
5419	zcwsurfae(b) = MAX( pcs, pcw / 1.01_wp ) * rhoair / amh2o
5420	!
5421	!-- Equilibrium saturation ratio
5422	zwsatae(b) = zact * zkelvin(b)
5423	!
5424	!-- Knudsen number (eq. 16.20)
5425	zknud = 2.0_wp * zmfph2o / paero(b)%dwet
5426	!
5427	!-- Transitional correction factor (Fuks & Sutugin, 1971)
5428	zbeta = ( zknud + 1.0_wp ) / ( 0.377_wp * zknud + 1.0_wp + 4.0_wp / &
5429	( 3.0_wp * massacc(b) ) * ( zknud + zknud ** 2.0_wp ) )
5430	!
5431	!-- Mass transfer of H2O: Eq. 16.64 but here D^eff = zdfh2o * zbeta
5432	zhlp1 = paero(b)%numc * 2.0_wp * pi * paero(b)%dwet * zdfh2o * &
5433	zbeta
5434	!-- 1st term on the left side of the denominator in eq. 16.55
5435	zhlp2 = amh2o * zdfh2o * alv * zwsatae(b) * zcwsurfae(b) / &
5436	( zthcond * ptemp )
5437	!-- 2nd term on the left side of the denominator in eq. 16.55
5438	zhlp3 = ( (alv * amh2o ) / ( argas * ptemp ) ) - 1.0_wp
5439	!-- Full eq. 16.64: Mass transfer coefficient (1/s)
5440	zmtae(b) = zhlp1 / ( zhlp2 * zhlp3 + 1.0_wp )
5441	ENDIF
5442	ENDDO
5443	!
5444	!-- Current mole concentrations of water
5445	zcwc = pcw * rhoair / amh2o ! as vapour
5446	zcwcae(1:nbins) = paero(1:nbins)%volc(8) * arhoh2o / amh2o ! in aerosols
5447	zcwtot = zcwc + SUM( zcwcae ) ! total water concentration
5448	ttot = 0.0_wp
5449	adtc = 0.0_wp
5450	zcwintae = zcwcae
5451	!
5452	!-- Substepping loop
5453	zcwint = 0.0_wp
5454	DO WHILE ( ttot < ptstep )
5455	adt = 2.0E-2_wp ! internal timestep
5456	!
5457	!-- New vapour concentration: (eq. 16.71)
5458	zhlp1 = zcwc + adt * ( SUM( zmtae(nstr:nbins) * zwsatae(nstr:nbins) * &
5459	zcwsurfae(nstr:nbins) ) ) ! numerator
5460	zhlp2 = 1.0_wp + adt * ( SUM( zmtae(nstr:nbins) ) ) ! denomin.
5461	zcwint = zhlp1 / zhlp2 ! new vapour concentration
5462	zcwint = MIN( zcwint, zcwtot )
5463	IF ( ANY( paero(:)%numc > nclim ) .AND. zrh > 0.98_wp ) THEN
5464	DO b = nstr, nbins
5465	zcwintae(b) = zcwcae(b) + MIN( MAX( adt * zmtae(b) * &
5466	( zcwint - zwsatae(b) * zcwsurfae(b) ), &
5467	-0.02_wp * zcwcae(b) ), 0.05_wp * zcwcae(b) )
5468	zwsatae(b) = acth2o( paero(b), zcwintae(b) ) * zkelvin(b)
5469	ENDDO
5470	ENDIF
5471	zcwintae(nstr:nbins) = MAX( zcwintae(nstr:nbins), 0.0_wp )
5472	!
5473	!-- Update vapour concentration for consistency
5474	zcwint = zcwtot - SUM( zcwintae(1:nbins) )
5475	!-- Update "old" values for next cycle
5476	zcwcae = zcwintae
5477
5478	ttot = ttot + adt
5479	ENDDO ! ADT
5480	zcwn = zcwint
5481	zcwnae = zcwintae
5482	pcw = zcwn * amh2o / rhoair
5483	paero(1:nbins)%volc(8) = MAX( 0.0_wp, zcwnae(1:nbins) * amh2o / arhoh2o )
5484
5485	END SUBROUTINE gpparth2o
5486
5487	!------------------------------------------------------------------------------!
5488	! Description:
5489	! ------------
5490	!> Calculates the activity coefficient of liquid water
5491	!------------------------------------------------------------------------------!
5492	REAL(wp) FUNCTION acth2o( ppart, pcw )
5493
5494	IMPLICIT NONE
5495
5496	TYPE(t_section), INTENT(in) :: ppart !< Aerosol properties of a bin
5497	REAL(wp), INTENT(in), OPTIONAL :: pcw !< molar concentration of water
5498	!< (mol/m3)
5499
5500	REAL(wp) :: zns !< molar concentration of solutes (mol/m3)
5501	REAL(wp) :: znw !< molar concentration of water (mol/m3)
5502
5503	zns = ( 3.0_wp * ( ppart%volc(1) * arhoh2so4 / amh2so4 ) + &
5504	( ppart%volc(2) * arhooc / amoc ) + &
5505	2.0_wp * ( ppart%volc(5) * arhoss / amss ) + &
5506	( ppart%volc(6) * arhohno3 / amhno3 ) + &
5507	( ppart%volc(7) * arhonh3 / amnh3 ) )
5508	IF ( PRESENT(pcw) ) THEN
5509	znw = pcw
5510	ELSE
5511	znw = ppart%volc(8) * arhoh2o / amh2o
5512	ENDIF
5513	!-- Activity = partial pressure of water vapour /
5514	!-- sat. vapour pressure of water over a bulk liquid surface
5515	!-- = molality * activity coefficient (Jacobson, 2005: eq. 17.20-21)
5516	!-- Assume activity coefficient of 1 for water
5517	acth2o = MAX( 0.1_wp, znw / MAX( EPSILON( 1.0_wp ),( znw + zns ) ) )
5518	END FUNCTION acth2o
5519
5520	!------------------------------------------------------------------------------!
5521	! Description:
5522	! ------------
5523	!> Calculates the dissolutional growth of particles (i.e. gas transfers to a
5524	!> particle surface and dissolves in liquid water on the surface). Treated here
5525	!> as a non-equilibrium (time-dependent) process. Gases: HNO3 and NH3
5526	!> (Chapter 17.14 in Jacobson, 2005).
5527	!
5528	!> Called from subroutine condensation.
5529	!> Coded by:
5530	!> Harri Kokkola (FMI)
5531	!------------------------------------------------------------------------------!
5532	SUBROUTINE gpparthno3( ppres, ptemp, paero, pghno3, pgnh3, pcw, pcs, pbeta, &
5533	ptstep )
5534
5535	IMPLICIT NONE
5536	!
5537	!-- Input and output variables
5538	REAL(wp), INTENT(in) :: pbeta(nbins) !< transitional correction factor for
5539	!< aerosols
5540	REAL(wp), INTENT(in) :: ppres !< ambient pressure (Pa)
5541	REAL(wp), INTENT(in) :: pcs !< water vapour saturation
5542	!< concentration (kg/m3)
5543	REAL(wp), INTENT(in) :: ptemp !< ambient temperature (K)
5544	REAL(wp), INTENT(in) :: ptstep !< time step (s)
5545	REAL(wp), INTENT(inout) :: pghno3 !< nitric acid concentration (#/m3)
5546	REAL(wp), INTENT(inout) :: pgnh3 !< ammonia conc. (#/m3)
5547	REAL(wp), INTENT(inout) :: pcw !< water vapour concentration (kg/m3)
5548	TYPE(t_section), INTENT(inout) :: paero(nbins) !< Aerosol properties
5549	!
5550	!-- Local variables
5551	INTEGER(iwp) :: b !< loop index
5552	REAL(wp) :: adt !< timestep
5553	REAL(wp) :: zachhso4ae(nbins) !< Activity coefficients for HHSO4
5554	REAL(wp) :: zacnh3ae(nbins) !< Activity coefficients for NH3
5555	REAL(wp) :: zacnh4hso2ae(nbins)!< Activity coefficients for NH4HSO2
5556	REAL(wp) :: zacno3ae(nbins) !< Activity coefficients for HNO3
5557	REAL(wp) :: zcgnh3eqae(nbins) !< Equilibrium gas concentration: NH3
5558	REAL(wp) :: zcgno3eqae(nbins) !< Equilibrium gas concentration: HNO3
5559	REAL(wp) :: zcgwaeqae(nbins) !< Equilibrium gas concentration: H2O
5560	REAL(wp) :: zcnh3c !< Current NH3 gas concentration
5561	REAL(wp) :: zcnh3int !< Intermediate NH3 gas concentration
5562	REAL(wp) :: zcnh3intae(nbins) !< Intermediate NH3 aerosol concentration
5563	REAL(wp) :: zcnh3n !< New NH3 gas concentration
5564	REAL(wp) :: zcnh3cae(nbins) !< Current NH3 in aerosols
5565	REAL(wp) :: zcnh3nae(nbins) !< New NH3 in aerosols
5566	REAL(wp) :: zcnh3tot !< Total NH3 concentration
5567	REAL(wp) :: zcno3c !< Current HNO3 gas concentration
5568	REAL(wp) :: zcno3int !< Intermediate HNO3 gas concentration
5569	REAL(wp) :: zcno3intae(nbins) !< Intermediate HNO3 aerosol concentration
5570	REAL(wp) :: zcno3n !< New HNO3 gas concentration
5571	REAL(wp) :: zcno3cae(nbins) !< Current HNO3 in aerosols
5572	REAL(wp) :: zcno3nae(nbins) !< New HNO3 in aerosols
5573	REAL(wp) :: zcno3tot !< Total HNO3 concentration
5574	REAL(wp) :: zdfvap !< Diffusion coefficient for vapors
5575	REAL(wp) :: zhlp1 !< helping variable
5576	REAL(wp) :: zhlp2 !< helping variable
5577	REAL(wp) :: zkelnh3ae(nbins) !< Kelvin effects for NH3
5578	REAL(wp) :: zkelno3ae(nbins) !< Kelvin effect for HNO3
5579	REAL(wp) :: zmolsae(nbins,7) !< Ion molalities from pdfite
5580	REAL(wp) :: zmtnh3ae(nbins) !< Mass transfer coefficients for NH3
5581	REAL(wp) :: zmtno3ae(nbins) !< Mass transfer coefficients for HNO3
5582	REAL(wp) :: zrh !< relative humidity
5583	REAL(wp) :: zsathno3ae(nbins) !< HNO3 saturation ratio
5584	REAL(wp) :: zsatnh3ae(nbins) !< NH3 saturation ratio = the partial
5585	!< pressure of a gas divided by its
5586	!< saturation vapor pressure over a surface
5587	!
5588	!-- Initialise:
5589	adt = ptstep
5590	zachhso4ae = 0.0_wp
5591	zacnh3ae = 0.0_wp
5592	zacnh4hso2ae = 0.0_wp
5593	zacno3ae = 0.0_wp
5594	zcgnh3eqae = 0.0_wp
5595	zcgno3eqae = 0.0_wp
5596	zcnh3c = 0.0_wp
5597	zcnh3cae = 0.0_wp
5598	zcnh3int = 0.0_wp
5599	zcnh3intae = 0.0_wp
5600	zcnh3n = 0.0_wp
5601	zcnh3nae = 0.0_wp
5602	zcnh3tot = 0.0_wp
5603	zcno3c = 0.0_wp
5604	zcno3cae = 0.0_wp
5605	zcno3int = 0.0_wp
5606	zcno3intae = 0.0_wp
5607	zcno3n = 0.0_wp
5608	zcno3nae = 0.0_wp
5609	zcno3tot = 0.0_wp
5610	zhlp1 = 0.0_wp
5611	zhlp2 = 0.0_wp
5612	zkelno3ae = 1.0_wp
5613	zkelnh3ae = 1.0_wp
5614	zmolsae = 0.0_wp
5615	zmtno3ae = 0.0_wp
5616	zmtnh3ae = 0.0_wp
5617	zrh = 0.0_wp
5618	zsatnh3ae = 1.0_wp
5619	zsathno3ae = 1.0_wp
5620	!
5621	!-- Diffusion coefficient (m2/s)
5622	zdfvap = 5.1111E-10_wp * ptemp ** 1.75_wp * ( p_0 + 1325.0_wp ) / ppres
5623	!
5624	!-- Kelvin effects (Jacobson (2005), eq. 16.33)
5625	zkelno3ae(1:nbins) = EXP( 4.0_wp * surfw0 * amvhno3 / ( abo * ptemp * &
5626	paero(1:nbins)%dwet ) )
5627	zkelnh3ae(1:nbins) = EXP( 4.0_wp * surfw0 * amvnh3 / ( abo * ptemp * &
5628	paero(1:nbins)%dwet ) )
5629	!
5630	!-- Current vapour mole concentrations (mol/m3)
5631	zcno3c = pghno3 / avo ! HNO3
5632	zcnh3c = pgnh3 / avo ! NH3
5633	!
5634	!-- Current particle mole concentrations (mol/m3)
5635	zcno3cae(1:nbins) = paero(1:nbins)%volc(6) * arhohno3 / amhno3
5636	zcnh3cae(1:nbins) = paero(1:nbins)%volc(7) * arhonh3 / amnh3
5637	!
5638	!-- Total mole concentrations: gas and particle phase
5639	zcno3tot = zcno3c + SUM( zcno3cae(1:nbins) )
5640	zcnh3tot = zcnh3c + SUM( zcnh3cae(1:nbins) )
5641	!
5642	!-- Relative humidity [0-1]
5643	zrh = pcw / pcs
5644	!
5645	!-- Mass transfer coefficients (Jacobson, Eq. 16.64)
5646	zmtno3ae(1:nbins) = 2.0_wp * pi * paero(1:nbins)%dwet * zdfvap * &
5647	paero(1:nbins)%numc * pbeta(1:nbins)
5648	zmtnh3ae(1:nbins) = 2.0_wp * pi * paero(1:nbins)%dwet * zdfvap * &
5649	paero(1:nbins)%numc * pbeta(1:nbins)
5650
5651	!
5652	!-- Get the equilibrium concentrations above aerosols
5653	CALL NONHEquil( zrh, ptemp, paero, zcgno3eqae, zcgnh3eqae, zacno3ae, &
5654	zacnh3ae, zacnh4hso2ae, zachhso4ae, zmolsae )
5655
5656	!
5657	!-- NH4/HNO3 saturation ratios for aerosols
5658	CALL SVsat( ptemp, paero, zacno3ae, zacnh3ae, zacnh4hso2ae, zachhso4ae, &
5659	zcgno3eqae, zcno3cae, zcnh3cae, zkelno3ae, zkelnh3ae, &
5660	zsathno3ae, zsatnh3ae, zmolsae )
5661	!
5662	!-- Intermediate concentrations
5663	zhlp1 = SUM( zcno3cae(1:nbins) / ( 1.0_wp + adt * zmtno3ae(1:nbins) * &
5664	zsathno3ae(1:nbins) ) )
5665	zhlp2 = SUM( zmtno3ae(1:nbins) / ( 1.0_wp + adt * zmtno3ae(1:nbins) * &
5666	zsathno3ae(1:nbins) ) )
5667	zcno3int = ( zcno3tot - zhlp1 ) / ( 1.0_wp + adt * zhlp2 )
5668
5669	zhlp1 = SUM( zcnh3cae(1:nbins) / ( 1.0_wp + adt * zmtnh3ae(1:nbins) * &
5670	zsatnh3ae(1:nbins) ) )
5671	zhlp2 = SUM( zmtnh3ae(1:nbins) / ( 1.0_wp + adt * zmtnh3ae(1:nbins) * &
5672	zsatnh3ae(1:nbins) ) )
5673	zcnh3int = ( zcnh3tot - zhlp1 )/( 1.0_wp + adt * zhlp2 )
5674
5675	zcno3int = MIN(zcno3int, zcno3tot)
5676	zcnh3int = MIN(zcnh3int, zcnh3tot)
5677	!
5678	!-- Calculate the new particle concentrations
5679	zcno3intae = zcno3cae
5680	zcnh3intae = zcnh3cae
5681	DO b = 1, nbins
5682	zcno3intae(b) = ( zcno3cae(b) + adt * zmtno3ae(b) * zcno3int ) / &
5683	( 1.0_wp + adt * zmtno3ae(b) * zsathno3ae(b) )
5684	zcnh3intae(b) = ( zcnh3cae(b) + adt * zmtnh3ae(b) * zcnh3int ) / &
5685	( 1.0_wp + adt * zmtnh3ae(b) * zsatnh3ae(b) )
5686	ENDDO
5687
5688	zcno3intae(1:nbins) = MAX( zcno3intae(1:nbins), 0.0_wp )
5689	zcnh3intae(1:nbins) = MAX( zcnh3intae(1:nbins), 0.0_wp )
5690
5691	zcno3n = zcno3int ! Final molar gas concentration of HNO3
5692	zcno3nae = zcno3intae ! Final molar particle concentration of HNO3
5693
5694	zcnh3n = zcnh3int ! Final molar gas concentration of NH3
5695	zcnh3nae = zcnh3intae ! Final molar particle concentration of NH3
5696	!
5697	!-- Model timestep reached - update the new arrays
5698	pghno3 = zcno3n * avo
5699	pgnh3 = zcnh3n * avo
5700
5701	DO b = in1a, fn2b
5702	paero(b)%volc(6) = zcno3nae(b) * amhno3 / arhohno3
5703	paero(b)%volc(7) = zcnh3nae(b) * amnh3 / arhonh3
5704	ENDDO
5705
5706
5707	END SUBROUTINE gpparthno3
5708	!------------------------------------------------------------------------------!
5709	! Description:
5710	! ------------
5711	!> Calculate the equilibrium concentrations above aerosols (reference?)
5712	!------------------------------------------------------------------------------!
5713	SUBROUTINE NONHEquil( prh, ptemp, ppart, pcgno3eq, pcgnh3eq, pgammano, &
5714	pgammanh, pgammanh4hso2, pgammahhso4, pmols )
5715
5716	IMPLICIT NONE
5717
5718	REAL(wp), INTENT(in) :: prh !< relative humidity
5719	REAL(wp), INTENT(in) :: ptemp !< ambient temperature (K)
5720
5721	TYPE(t_section), INTENT(inout) :: ppart(nbins) !< Aerosol properties
5722	!-- Equilibrium molar concentration above aerosols:
5723	REAL(wp), INTENT(inout) :: pcgnh3eq(nbins) !< of NH3
5724	REAL(wp), INTENT(inout) :: pcgno3eq(nbins) !< of HNO3
5725	!< Activity coefficients:
5726	REAL(wp), INTENT(inout) :: pgammahhso4(nbins) !< HHSO4
5727	REAL(wp), INTENT(inout) :: pgammanh(nbins) !< NH3
5728	REAL(wp), INTENT(inout) :: pgammanh4hso2(nbins) !< NH4HSO2
5729	REAL(wp), INTENT(inout) :: pgammano(nbins) !< HNO3
5730	REAL(wp), INTENT(inout) :: pmols(nbins,7) !< Ion molalities
5731
5732	INTEGER(iwp) :: b
5733
5734	REAL(wp) :: zgammas(7) !< Activity coefficients
5735	REAL(wp) :: zhlp !< Dummy variable
5736	REAL(wp) :: zions(7) !< molar concentration of ion (mol/m3)
5737	REAL(wp) :: zphcl !< Equilibrium vapor pressures (Pa??)
5738	REAL(wp) :: zphno3 !< Equilibrium vapor pressures (Pa??)
5739	REAL(wp) :: zpnh3 !< Equilibrium vapor pressures (Pa??)
5740	REAL(wp) :: zwatertotal !< Total water in particles (mol/m3) ???
5741
5742	zgammas = 0.0_wp
5743	zhlp = 0.0_wp
5744	zions = 0.0_wp
5745	zphcl = 0.0_wp
5746	zphno3 = 0.0_wp
5747	zpnh3 = 0.0_wp
5748	zwatertotal = 0.0_wp
5749
5750	DO b = 1, nbins
5751
5752	IF ( ppart(b)%numc < nclim ) CYCLE
5753	!
5754	!-- 2*H2SO4 + CL + NO3 - Na - NH4
5755	zhlp = 2.0_wp * ppart(b)%volc(1) * arhoh2so4 / amh2so4 + &
5756	ppart(b)%volc(5) * arhoss / amss + &
5757	ppart(b)%volc(6) * arhohno3 / amhno3 - &
5758	ppart(b)%volc(5) * arhoss / amss - &
5759	ppart(b)%volc(7) * arhonh3 / amnh3
5760
5761	zhlp = MAX( zhlp, 1.0E-30_wp )
5762
5763	zions(1) = zhlp ! H+
5764	zions(2) = ppart(b)%volc(7) * arhonh3 / amnh3 ! NH4+
5765	zions(3) = ppart(b)%volc(5) * arhoss / amss ! Na+
5766	zions(4) = ppart(b)%volc(1) * arhoh2so4 / amh2so4 ! SO4(2-)
5767	zions(5) = 0.0_wp ! HSO4-
5768	zions(6) = ppart(b)%volc(6) * arhohno3 / amhno3 ! NO3-
5769	zions(7) = ppart(b)%volc(5) * arhoss / amss ! Cl-
5770
5771	zwatertotal = ppart(b)%volc(8) * arhoh2o / amh2o
5772	IF ( zwatertotal > 1.0E-30_wp ) THEN
5773	CALL inorganic_pdfite( prh, ptemp, zions, zwatertotal, zphno3, zphcl,&
5774	zpnh3, zgammas, pmols(b,:) )
5775	ENDIF
5776	!
5777	!-- Activity coefficients
5778	pgammano(b) = zgammas(1) ! HNO3
5779	pgammanh(b) = zgammas(3) ! NH3
5780	pgammanh4hso2(b) = zgammas(6) ! NH4HSO2
5781	pgammahhso4(b) = zgammas(7) ! HHSO4
5782	!
5783	!-- Equilibrium molar concentrations (mol/m3) from equlibrium pressures (Pa)
5784	pcgno3eq(b) = zphno3 / ( argas * ptemp )
5785	pcgnh3eq(b) = zpnh3 / ( argas * ptemp )
5786
5787	ENDDO
5788
5789	END SUBROUTINE NONHEquil
5790
5791	!------------------------------------------------------------------------------!
5792	! Description:
5793	! ------------
5794	!> Calculate saturation ratios of NH4 and HNO3 for aerosols
5795	!------------------------------------------------------------------------------!
5796	SUBROUTINE SVsat( ptemp, ppart, pachno3, pacnh3, pacnh4hso2, pachhso4, &
5797	pchno3eq, pchno3, pcnh3, pkelhno3, pkelnh3, psathno3, &
5798	psatnh3, pmols )
5799
5800	IMPLICIT NONE
5801
5802	REAL(wp), INTENT(in) :: ptemp !< ambient temperature (K)
5803
5804	TYPE(t_section), INTENT(inout) :: ppart(nbins) !< Aerosol properties
5805	!-- Activity coefficients
5806	REAL(wp), INTENT(in) :: pachhso4(nbins) !<
5807	REAL(wp), INTENT(in) :: pacnh3(nbins) !<
5808	REAL(wp), INTENT(in) :: pacnh4hso2(nbins) !<
5809	REAL(wp), INTENT(in) :: pachno3(nbins) !<
5810	REAL(wp), INTENT(in) :: pchno3eq(nbins) !< Equilibrium surface concentration
5811	!< of HNO3
5812	REAL(wp), INTENT(in) :: pchno3(nbins) !< Current particle mole
5813	!< concentration of HNO3 (mol/m3)
5814	REAL(wp), INTENT(in) :: pcnh3(nbins) !< Current particle mole
5815	!< concentration of NH3 (mol/m3)
5816	REAL(wp), INTENT(in) :: pkelhno3(nbins) !< Kelvin effect for HNO3
5817	REAL(wp), INTENT(in) :: pkelnh3(nbins) !< Kelvin effect for NH3
5818	REAL(wp), INTENT(in) :: pmols(nbins,7)
5819	!-- Saturation ratios
5820	REAL(wp), INTENT(out) :: psathno3(nbins) !<
5821	REAL(wp), INTENT(out) :: psatnh3(nbins) !<
5822
5823	INTEGER :: b !< running index for aerosol bins
5824	!-- Constants for calculating equilibrium constants:
5825	REAL(wp), PARAMETER :: a1 = -22.52_wp !<
5826	REAL(wp), PARAMETER :: a2 = -1.50_wp !<
5827	REAL(wp), PARAMETER :: a3 = 13.79_wp !<
5828	REAL(wp), PARAMETER :: a4 = 29.17_wp !<
5829	REAL(wp), PARAMETER :: b1 = 26.92_wp !<
5830	REAL(wp), PARAMETER :: b2 = 26.92_wp !<
5831	REAL(wp), PARAMETER :: b3 = -5.39_wp !<
5832	REAL(wp), PARAMETER :: b4 = 16.84_wp !<
5833	REAL(wp), PARAMETER :: K01 = 1.01E-14_wp !<
5834	REAL(wp), PARAMETER :: K02 = 1.81E-5_wp !<
5835	REAL(wp), PARAMETER :: K03 = 57.64_wp !<
5836	REAL(wp), PARAMETER :: K04 = 2.51E+6_wp !<
5837	!-- Equilibrium constants of equilibrium reactions
5838	REAL(wp) :: KllH2O !< H2O(aq) <--> H+ + OH- (mol/kg)
5839	REAL(wp) :: KllNH3 !< NH3(aq) + H2O(aq) <--> NH4+ + OH- (mol/kg)
5840	REAL(wp) :: KglNH3 !< NH3(g) <--> NH3(aq) (mol/kg/atm)
5841	REAL(wp) :: KglHNO3 !< HNO3(g) <--> H+ + NO3- (mol2/kg2/atm)
5842	REAL(wp) :: zmolno3 !< molality of NO3- (mol/kg)
5843	REAL(wp) :: zmolhp !< molality of H+ (mol/kg)
5844	REAL(wp) :: zmolso4 !< molality of SO4(2-) (mol/kg)
5845	REAL(wp) :: zmolcl !< molality of Cl (mol/kg)
5846	REAL(wp) :: zmolnh4 !< Molality of NH4 (mol/kg)
5847	REAL(wp) :: zmolna !< Molality of Na (mol/kg)
5848	REAL(wp) :: zhlp1 !<
5849	REAL(wp) :: zhlp2 !<
5850	REAL(wp) :: zhlp3 !<
5851	REAL(wp) :: zxi !<
5852	REAL(wp) :: zt0 !< Reference temp
5853
5854	zhlp1 = 0.0_wp
5855	zhlp2 = 0.0_wp
5856	zhlp3 = 0.0_wp
5857	zmolcl = 0.0_wp
5858	zmolhp = 0.0_wp
5859	zmolna = 0.0_wp
5860	zmolnh4 = 0.0_wp
5861	zmolno3 = 0.0_wp
5862	zmolso4 = 0.0_wp
5863	zt0 = 298.15_wp
5864	zxi = 0.0_wp
5865	!
5866	!-- Calculates equlibrium rate constants based on Table B.7 in Jacobson (2005)
5867	!-- K^ll_H20, K^ll_NH3, K^gl_NH3, K^gl_HNO3
5868	zhlp1 = zt0 / ptemp
5869	zhlp2 = zhlp1 - 1.0_wp
5870	zhlp3 = 1.0_wp + LOG( zhlp1 ) - zhlp1
5871
5872	KllH2O = K01 * EXP( a1 * zhlp2 + b1 * zhlp3 )
5873	KllNH3 = K02 * EXP( a2 * zhlp2 + b2 * zhlp3 )
5874	KglNH3 = K03 * EXP( a3 * zhlp2 + b3 * zhlp3 )
5875	KglHNO3 = K04 * EXP( a4 * zhlp2 + b4 * zhlp3 )
5876
5877	DO b = 1, nbins
5878
5879	IF ( ppart(b)%numc > nclim .AND. ppart(b)%volc(8) > 1.0E-30_wp ) THEN
5880	!
5881	!-- Molality of H+ and NO3-
5882	zhlp1 = pcnh3(b) * amnh3 + ppart(b)%volc(1) * arhoh2so4 + &
5883	ppart(b)%volc(2) * arhooc + ppart(b)%volc(5) * arhoss + &
5884	ppart(b)%volc(8) * arhoh2o
5885	zmolno3 = pchno3(b) / zhlp1 !< mol/kg
5886	!
5887	!-- Particle mole concentration ratio: (NH3+SS)/H2SO4
5888	zxi = ( pcnh3(b) + ppart(b)%volc(5) * arhoss / amss ) / &
5889	( ppart(b)%volc(1) * arhoh2so4 / amh2so4 )
5890
5891	IF ( zxi <= 2.0_wp ) THEN
5892	!
5893	!-- Molality of SO4(2-)
5894	zhlp1 = pcnh3(b) * amnh3 + pchno3(b) * amhno3 + &
5895	ppart(b)%volc(2) * arhooc + ppart(b)%volc(5) * arhoss + &
5896	ppart(b)%volc(8) * arhoh2o
5897	zmolso4 = ( ppart(b)%volc(1) * arhoh2so4 / amh2so4 ) / zhlp1
5898	!
5899	!-- Molality of Cl-
5900	zhlp1 = pcnh3(b) * amnh3 + pchno3(b) * amhno3 + &
5901	ppart(b)%volc(2) * arhooc + ppart(b)%volc(1) * arhoh2so4 &
5902	+ ppart(b)%volc(8) * arhoh2o
5903	zmolcl = ( ppart(b)%volc(5) * arhoss / amss ) / zhlp1
5904	!
5905	!-- Molality of NH4+
5906	zhlp1 = pchno3(b) * amhno3 + ppart(b)%volc(1) * arhoh2so4 + &
5907	ppart(b)%volc(2) * arhooc + ppart(b)%volc(5) * arhoss + &
5908	ppart(b)%volc(8) * arhoh2o
5909	zmolnh4 = pcnh3(b) / zhlp1
5910	!
5911	!-- Molality of Na+
5912	zmolna = zmolcl
5913	!
5914	!-- Molality of H+
5915	zmolhp = 2.0_wp * zmolso4 + zmolno3 + zmolcl - ( zmolnh4 + zmolna )
5916
5917	ELSE
5918
5919	zhlp2 = pkelhno3(b) * zmolno3 * pachno3(b) ** 2.0_wp
5920	!
5921	!-- Mona debugging
5922	IF ( zhlp2 > 1.0E-30_wp ) THEN
5923	zmolhp = KglHNO3 * pchno3eq(b) / zhlp2 ! Eq. 17.38
5924	ELSE
5925	zmolhp = 0.0_wp
5926	ENDIF
5927
5928	ENDIF
5929
5930	zhlp1 = ppart(b)%volc(8) * arhoh2o * argas * ptemp * KglHNO3
5931	!
5932	!-- Saturation ratio for NH3 and for HNO3
5933	IF ( zmolhp > 0.0_wp ) THEN
5934	zhlp2 = pkelnh3(b) / ( zhlp1 * zmolhp )
5935	zhlp3 = KllH2O / ( KllNH3 + KglNH3 )
5936	psatnh3(b) = zhlp2 * ( ( pacnh4hso2(b) / pachhso4(b) ) **2.0_wp ) &
5937	* zhlp3
5938	psathno3(b) = ( pkelhno3(b) * zmolhp * pachno3(b)**2.0_wp ) / zhlp1
5939	ELSE
5940	psatnh3(b) = 1.0_wp
5941	psathno3(b) = 1.0_wp
5942	ENDIF
5943	ELSE
5944	psatnh3(b) = 1.0_wp
5945	psathno3(b) = 1.0_wp
5946	ENDIF
5947
5948	ENDDO
5949
5950	END SUBROUTINE SVsat
5951
5952	!------------------------------------------------------------------------------!
5953	! Description:
5954	! ------------
5955	!> Prototype module for calculating the water content of a mixed inorganic/
5956	!> organic particle + equilibrium water vapour pressure above the solution
5957	!> (HNO3, HCL, NH3 and representative organic compounds. Efficient calculation
5958	!> of the partitioning of species between gas and aerosol. Based in a chamber
5959	!> study.
5960	!
5961	!> Written by Dave Topping. Pure organic component properties predicted by Mark
5962	!> Barley based on VOCs predicted in MCM simulations performed by Mike Jenkin.
5963	!> Delivered by Gordon McFiggans as Deliverable D22 from WP1.4 in the EU FP6
5964	!> EUCAARI Integrated Project.
5965	!
5966	!> Queries concerning the use of this code through Gordon McFiggans,
5967	!> g.mcfiggans@manchester.ac.uk,
5968	!> Ownership: D. Topping, Centre for Atmospheric Sciences, University of
5969	!> Manchester, 2007
5970	!
5971	!> Rewritten to PALM by Mona Kurppa, UHel, 2017
5972	!------------------------------------------------------------------------------!
5973	SUBROUTINE inorganic_pdfite( RH, temp, ions, water_total, Press_HNO3, &
5974	Press_HCL, Press_NH3, gamma_out, mols_out )
5975
5976	IMPLICIT NONE
5977
5978	REAL(wp), DIMENSION(:) :: gamma_out !< Activity coefficient for calculating
5979	!< the non-ideal dissociation constants
5980	!< 1: HNO3, 2: HCL, 3: NH4+/H+ (NH3)
5981	!< 4: HHSO4**2/H2SO4,
5982	!< 5: H2SO43/HHSO42
5983	!< 6: NH4HSO2, 7: HHSO4
5984	REAL(wp), DIMENSION(:) :: ions !< ion molarities (mol/m3)
5985	!< 1: H+, 2: NH4+, 3: Na+, 4: SO4(2-),
5986	!< 5: HSO4-, 6: NO3-, 7: Cl-
5987	REAL(wp), DIMENSION(7) :: ions_mol !< ion molalities (mol/kg)
5988	!< 1: H+, 2: NH4+, 3: Na+, 4: SO4(2-),
5989	!< 5: HSO4-, 6: NO3-, 7: Cl-
5990	REAL(wp), DIMENSION(:) :: mols_out !< ion molality output (mol/kg)
5991	!< 1: H+, 2: NH4+, 3: Na+, 4: SO4(2-),
5992	!< 5: HSO4-, 6: NO3-, 7: Cl-
5993	REAL(wp) :: act_product !< ionic activity coef. product:
5994	!< = (gamma_h2so4**3d0) /
5995	!< (gamma_hhso4**2d0)
5996	REAL(wp) :: ammonium_chloride !<
5997	REAL(wp) :: ammonium_chloride_eq_frac !<
5998	REAL(wp) :: ammonium_nitrate !<
5999	REAL(wp) :: ammonium_nitrate_eq_frac !<
6000	REAL(wp) :: ammonium_sulphate !<
6001	REAL(wp) :: ammonium_sulphate_eq_frac !<
6002	REAL(wp) :: binary_h2so4 !< binary H2SO4 activity coeff.
6003	REAL(wp) :: binary_hcl !< binary HCL activity coeff.
6004	REAL(wp) :: binary_hhso4 !< binary HHSO4 activity coeff.
6005	REAL(wp) :: binary_hno3 !< binary HNO3 activity coeff.
6006	REAL(wp) :: binary_nh4hso4 !< binary NH4HSO4 activity coeff.
6007	REAL(wp) :: charge_sum !< sum of ionic charges
6008	REAL(wp) :: gamma_h2so4 !< activity coefficient
6009	REAL(wp) :: gamma_hcl !< activity coefficient
6010	REAL(wp) :: gamma_hhso4 !< activity coeffient
6011	REAL(wp) :: gamma_hno3 !< activity coefficient
6012	REAL(wp) :: gamma_nh3 !< activity coefficient
6013	REAL(wp) :: gamma_nh4hso4 !< activity coefficient
6014	REAL(wp) :: h_out !<
6015	REAL(wp) :: h_real !< new hydrogen ion conc.
6016	REAL(wp) :: H2SO4_hcl !< contribution of H2SO4
6017	REAL(wp) :: H2SO4_hno3 !< contribution of H2SO4
6018	REAL(wp) :: H2SO4_nh3 !< contribution of H2SO4
6019	REAL(wp) :: H2SO4_nh4hso4 !< contribution of H2SO4
6020	REAL(wp) :: HCL_h2so4 !< contribution of HCL
6021	REAL(wp) :: HCL_hhso4 !< contribution of HCL
6022	REAL(wp) :: HCL_hno3 !< contribution of HCL
6023	REAL(wp) :: HCL_nh3 !< contribution of HCL
6024	REAL(wp) :: HCL_nh4hso4 !< contribution of HCL
6025	REAL(wp) :: henrys_temp_dep !< temperature dependence of
6026	!< Henry's Law
6027	REAL(wp) :: HNO3_h2so4 !< contribution of HNO3
6028	REAL(wp) :: HNO3_hcl !< contribution of HNO3
6029	REAL(wp) :: HNO3_hhso4 !< contribution of HNO3
6030	REAL(wp) :: HNO3_nh3 !< contribution of HNO3
6031	REAL(wp) :: HNO3_nh4hso4 !< contribution of HNO3
6032	REAL(wp) :: hso4_out !<
6033	REAL(wp) :: hso4_real !< new bisulphate ion conc.
6034	REAL(wp) :: hydrochloric_acid !<
6035	REAL(wp) :: hydrochloric_acid_eq_frac !<
6036	REAL(wp) :: Kh !< equilibrium constant for H+
6037	REAL(wp) :: K_hcl !< equilibrium constant of HCL
6038	REAL(wp) :: K_hno3 !< equilibrium constant of HNO3
6039	REAL(wp) :: Knh4 !< equilibrium constant for NH4+
6040	REAL(wp) :: Kw !< equil. const. for water_surface
6041	REAL(wp) :: Ln_h2so4_act !< gamma_h2so4 = EXP(Ln_h2so4_act)
6042	REAL(wp) :: Ln_HCL_act !< gamma_hcl = EXP( Ln_HCL_act )
6043	REAL(wp) :: Ln_hhso4_act !< gamma_hhso4 = EXP(Ln_hhso4_act)
6044	REAL(wp) :: Ln_HNO3_act !< gamma_hno3 = EXP( Ln_HNO3_act )
6045	REAL(wp) :: Ln_NH4HSO4_act !< gamma_nh4hso4 =
6046	!< EXP( Ln_NH4HSO4_act )
6047	REAL(wp) :: molality_ratio_nh3 !< molality ratio of NH3
6048	!< (NH4+ and H+)
6049	REAL(wp) :: Na2SO4_h2so4 !< contribution of Na2SO4
6050	REAL(wp) :: Na2SO4_hcl !< contribution of Na2SO4
6051	REAL(wp) :: Na2SO4_hhso4 !< contribution of Na2SO4
6052	REAL(wp) :: Na2SO4_hno3 !< contribution of Na2SO4
6053	REAL(wp) :: Na2SO4_nh3 !< contribution of Na2SO4
6054	REAL(wp) :: Na2SO4_nh4hso4 !< contribution of Na2SO4
6055	REAL(wp) :: NaCl_h2so4 !< contribution of NaCl
6056	REAL(wp) :: NaCl_hcl !< contribution of NaCl
6057	REAL(wp) :: NaCl_hhso4 !< contribution of NaCl
6058	REAL(wp) :: NaCl_hno3 !< contribution of NaCl
6059	REAL(wp) :: NaCl_nh3 !< contribution of NaCl
6060	REAL(wp) :: NaCl_nh4hso4 !< contribution of NaCl
6061	REAL(wp) :: NaNO3_h2so4 !< contribution of NaNO3
6062	REAL(wp) :: NaNO3_hcl !< contribution of NaNO3
6063	REAL(wp) :: NaNO3_hhso4 !< contribution of NaNO3
6064	REAL(wp) :: NaNO3_hno3 !< contribution of NaNO3
6065	REAL(wp) :: NaNO3_nh3 !< contribution of NaNO3
6066	REAL(wp) :: NaNO3_nh4hso4 !< contribution of NaNO3
6067	REAL(wp) :: NH42SO4_h2so4 !< contribution of NH42SO4
6068	REAL(wp) :: NH42SO4_hcl !< contribution of NH42SO4
6069	REAL(wp) :: NH42SO4_hhso4 !< contribution of NH42SO4
6070	REAL(wp) :: NH42SO4_hno3 !< contribution of NH42SO4
6071	REAL(wp) :: NH42SO4_nh3 !< contribution of NH42SO4
6072	REAL(wp) :: NH42SO4_nh4hso4 !< contribution of NH42SO4
6073	REAL(wp) :: NH4Cl_h2so4 !< contribution of NH4Cl
6074	REAL(wp) :: NH4Cl_hcl !< contribution of NH4Cl
6075	REAL(wp) :: NH4Cl_hhso4 !< contribution of NH4Cl
6076	REAL(wp) :: NH4Cl_hno3 !< contribution of NH4Cl
6077	REAL(wp) :: NH4Cl_nh3 !< contribution of NH4Cl
6078	REAL(wp) :: NH4Cl_nh4hso4 !< contribution of NH4Cl
6079	REAL(wp) :: NH4NO3_h2so4 !< contribution of NH4NO3
6080	REAL(wp) :: NH4NO3_hcl !< contribution of NH4NO3
6081	REAL(wp) :: NH4NO3_hhso4 !< contribution of NH4NO3
6082	REAL(wp) :: NH4NO3_hno3 !< contribution of NH4NO3
6083	REAL(wp) :: NH4NO3_nh3 !< contribution of NH4NO3
6084	REAL(wp) :: NH4NO3_nh4hso4 !< contribution of NH4NO3
6085	REAL(wp) :: nitric_acid !<
6086	REAL(wp) :: nitric_acid_eq_frac !< Equivalent fractions
6087	REAL(wp) :: Press_HCL !< partial pressure of HCL
6088	REAL(wp) :: Press_HNO3 !< partial pressure of HNO3
6089	REAL(wp) :: Press_NH3 !< partial pressure of NH3
6090	REAL(wp) :: RH !< relative humidity [0-1]
6091	REAL(wp) :: temp !< temperature
6092	REAL(wp) :: so4_out !<
6093	REAL(wp) :: so4_real !< new sulpate ion concentration
6094	REAL(wp) :: sodium_chloride !<
6095	REAL(wp) :: sodium_chloride_eq_frac !<
6096	REAL(wp) :: sodium_nitrate !<
6097	REAL(wp) :: sodium_nitrate_eq_frac !<
6098	REAL(wp) :: sodium_sulphate !<
6099	REAL(wp) :: sodium_sulphate_eq_frac !<
6100	REAL(wp) :: solutes !<
6101	REAL(wp) :: sulphuric_acid !<
6102	REAL(wp) :: sulphuric_acid_eq_frac !<
6103	REAL(wp) :: water_total !<
6104
6105	REAL(wp) :: a !< auxiliary variable
6106	REAL(wp) :: b !< auxiliary variable
6107	REAL(wp) :: c !< auxiliary variable
6108	REAL(wp) :: root1 !< auxiliary variable
6109	REAL(wp) :: root2 !< auxiliary variable
6110
6111	INTEGER(iwp) :: binary_case
6112	INTEGER(iwp) :: full_complexity
6113	!
6114	!-- Value initialisation
6115	binary_h2so4 = 0.0_wp
6116	binary_hcl = 0.0_wp
6117	binary_hhso4 = 0.0_wp
6118	binary_hno3 = 0.0_wp
6119	binary_nh4hso4 = 0.0_wp
6120	henrys_temp_dep = ( 1.0_wp / temp - 1.0_wp / 298.0_wp )
6121	HCL_hno3 = 1.0_wp
6122	H2SO4_hno3 = 1.0_wp
6123	NH42SO4_hno3 = 1.0_wp
6124	NH4NO3_hno3 = 1.0_wp
6125	NH4Cl_hno3 = 1.0_wp
6126	Na2SO4_hno3 = 1.0_wp
6127	NaNO3_hno3 = 1.0_wp
6128	NaCl_hno3 = 1.0_wp
6129	HNO3_hcl = 1.0_wp
6130	H2SO4_hcl = 1.0_wp
6131	NH42SO4_hcl = 1.0_wp
6132	NH4NO3_hcl = 1.0_wp
6133	NH4Cl_hcl = 1.0_wp
6134	Na2SO4_hcl = 1.0_wp
6135	NaNO3_hcl = 1.0_wp
6136	NaCl_hcl = 1.0_wp
6137	HNO3_nh3 = 1.0_wp
6138	HCL_nh3 = 1.0_wp
6139	H2SO4_nh3 = 1.0_wp
6140	NH42SO4_nh3 = 1.0_wp
6141	NH4NO3_nh3 = 1.0_wp
6142	NH4Cl_nh3 = 1.0_wp
6143	Na2SO4_nh3 = 1.0_wp
6144	NaNO3_nh3 = 1.0_wp
6145	NaCl_nh3 = 1.0_wp
6146	HNO3_hhso4 = 1.0_wp
6147	HCL_hhso4 = 1.0_wp
6148	NH42SO4_hhso4 = 1.0_wp
6149	NH4NO3_hhso4 = 1.0_wp
6150	NH4Cl_hhso4 = 1.0_wp
6151	Na2SO4_hhso4 = 1.0_wp
6152	NaNO3_hhso4 = 1.0_wp
6153	NaCl_hhso4 = 1.0_wp
6154	HNO3_h2so4 = 1.0_wp
6155	HCL_h2so4 = 1.0_wp
6156	NH42SO4_h2so4 = 1.0_wp
6157	NH4NO3_h2so4 = 1.0_wp
6158	NH4Cl_h2so4 = 1.0_wp
6159	Na2SO4_h2so4 = 1.0_wp
6160	NaNO3_h2so4 = 1.0_wp
6161	NaCl_h2so4 = 1.0_wp
6162	!-- New NH3 variables
6163	HNO3_nh4hso4 = 1.0_wp
6164	HCL_nh4hso4 = 1.0_wp
6165	H2SO4_nh4hso4 = 1.0_wp
6166	NH42SO4_nh4hso4 = 1.0_wp
6167	NH4NO3_nh4hso4 = 1.0_wp
6168	NH4Cl_nh4hso4 = 1.0_wp
6169	Na2SO4_nh4hso4 = 1.0_wp
6170	NaNO3_nh4hso4 = 1.0_wp
6171	NaCl_nh4hso4 = 1.0_wp
6172	!
6173	!-- Juha Tonttila added
6174	mols_out = 0.0_wp
6175	Press_HNO3 = 0.0_wp
6176	Press_HCL = 0.0_wp
6177	Press_NH3 = 0.0_wp !< Initialising vapour pressure over the
6178	!< multicomponent particle
6179	gamma_out = 1.0_wp !< i.e. don't alter the ideal mixing ratios if
6180	!< there's nothing there.
6181	!
6182	!-- 1) - COMPOSITION DEFINITIONS
6183	!
6184	!-- a) Inorganic ion pairing:
6185	!-- In order to calculate the water content, which is also used in
6186	!-- calculating vapour pressures, one needs to pair the anions and cations
6187	!-- for use in the ZSR mixing rule. The equation provided by Clegg et al.
6188	!-- (2001) is used for ion pairing. The solutes chosen comprise of 9
6189	!-- inorganic salts and acids which provide a pairing between each anion and
6190	!-- cation: (NH4)2SO4, NH4NO3, NH4Cl, Na2SO4, NaNO3, NaCl, H2SO4, HNO3, HCL.
6191	!-- The organic compound is treated as a seperate solute.
6192	!-- Ions: 1: H+, 2: NH4+, 3: Na+, 4: SO4(2-), 5: HSO4-, 6: NO3-, 7: Cl-
6193	!
6194	charge_sum = ions(1) + ions(2) + ions(3) + 2.0_wp * ions(4) + ions(5) + &
6195	ions(6) + ions(7)
6196	nitric_acid = 0.0_wp ! HNO3
6197	nitric_acid = ( 2.0_wp * ions(1) * ions(6) * &
6198	( ( 1.0_wp / 1.0_wp ) ** 0.5_wp ) ) / ( charge_sum )
6199	hydrochloric_acid = 0.0_wp ! HCL
6200	hydrochloric_acid = ( 2.0_wp * ions(1) * ions(7) * &
6201	( ( 1.0_wp / 1.0_wp ) ** 0.5_wp ) ) / ( charge_sum )
6202	sulphuric_acid = 0.0_wp ! H2SO4
6203	sulphuric_acid = ( 2.0_wp * ions(1) * ions(4) * &
6204	( ( 2.0_wp / 2.0_wp ) ** 0.5_wp ) ) / ( charge_sum )
6205	ammonium_sulphate = 0.0_wp ! (NH4)2SO4
6206	ammonium_sulphate = ( 2.0_wp * ions(2) * ions(4) * &
6207	( ( 2.0_wp / 2.0_wp ) ** 0.5_wp ) ) / ( charge_sum )
6208	ammonium_nitrate = 0.0_wp ! NH4NO3
6209	ammonium_nitrate = ( 2.0_wp * ions(2) * ions(6) * &
6210	( ( 1.0_wp / 1.0_wp ) ** 0.5_wp ) ) / ( charge_sum )
6211	ammonium_chloride = 0.0_wp ! NH4Cl
6212	ammonium_chloride = ( 2.0_wp * ions(2) * ions(7) * &
6213	( ( 1.0_wp / 1.0_wp ) ** 0.5_wp ) ) / ( charge_sum )
6214	sodium_sulphate = 0.0_wp ! Na2SO4
6215	sodium_sulphate = ( 2.0_wp * ions(3) * ions(4) * &
6216	( ( 2.0_wp / 2.0_wp ) ** 0.5_wp ) ) / ( charge_sum )
6217	sodium_nitrate = 0.0_wp ! NaNO3
6218	sodium_nitrate = ( 2.0_wp * ions(3) ions(6) &
6219	( ( 1.0_wp / 1.0_wp ) ** 0.5_wp ) ) / ( charge_sum )
6220	sodium_chloride = 0.0_wp ! NaCl
6221	sodium_chloride = ( 2.0_wp * ions(3) * ions(7) * &
6222	( ( 1.0_wp / 1.0_wp ) ** 0.5_wp ) ) / ( charge_sum )
6223	solutes = 0.0_wp
6224	solutes = 3.0_wp * sulphuric_acid + 2.0_wp * hydrochloric_acid + &
6225	2.0_wp * nitric_acid + 3.0_wp * ammonium_sulphate + &
6226	2.0_wp * ammonium_nitrate + 2.0_wp * ammonium_chloride + &
6227	3.0_wp * sodium_sulphate + 2.0_wp * sodium_nitrate + &
6228	2.0_wp * sodium_chloride
6229
6230	!
6231	!-- b) Inorganic equivalent fractions:
6232	!-- These values are calculated so that activity coefficients can be
6233	!-- expressed by a linear additive rule, thus allowing more efficient
6234	!-- calculations and future expansion (see more detailed description below)
6235	nitric_acid_eq_frac = 2.0_wp * nitric_acid / ( solutes )
6236	hydrochloric_acid_eq_frac = 2.0_wp * hydrochloric_acid / ( solutes )
6237	sulphuric_acid_eq_frac = 3.0_wp * sulphuric_acid / ( solutes )
6238	ammonium_sulphate_eq_frac = 3.0_wp * ammonium_sulphate / ( solutes )
6239	ammonium_nitrate_eq_frac = 2.0_wp * ammonium_nitrate / ( solutes )
6240	ammonium_chloride_eq_frac = 2.0_wp * ammonium_chloride / ( solutes )
6241	sodium_sulphate_eq_frac = 3.0_wp * sodium_sulphate / ( solutes )
6242	sodium_nitrate_eq_frac = 2.0_wp * sodium_nitrate / ( solutes )
6243	sodium_chloride_eq_frac = 2.0_wp * sodium_chloride / ( solutes )
6244	!
6245	!-- Inorganic ion molalities
6246	ions_mol(:) = 0.0_wp
6247	ions_mol(1) = ions(1) / ( water_total * 18.01528E-3_wp ) ! H+
6248	ions_mol(2) = ions(2) / ( water_total * 18.01528E-3_wp ) ! NH4+
6249	ions_mol(3) = ions(3) / ( water_total * 18.01528E-3_wp ) ! Na+
6250	ions_mol(4) = ions(4) / ( water_total * 18.01528E-3_wp ) ! SO4(2-)
6251	ions_mol(5) = ions(5) / ( water_total * 18.01528E-3_wp ) ! HSO4(2-)
6252	ions_mol(6) = ions(6) / ( water_total * 18.01528E-3_wp ) ! NO3-
6253	ions_mol(7) = ions(7) / ( water_total * 18.01528E-3_wp ) ! Cl-
6254
6255	!-- ***
6256	!-- At this point we may need to introduce a method for prescribing H+ when
6257	!-- there is no 'real' value for H+..i.e. in the sulphate poor domain
6258	!-- This will give a value for solve quadratic proposed by Zaveri et al. 2005
6259	!
6260	!-- 2) - WATER CALCULATION
6261	!
6262	!-- a) The water content is calculated using the ZSR rule with solute
6263	!-- concentrations calculated using 1a above. Whilst the usual approximation of
6264	!-- ZSR relies on binary data consisting of 5th or higher order polynomials, in
6265	!-- this code 4 different RH regimes are used, each housing cubic equations for
6266	!-- the water associated with each solute listed above. Binary water contents
6267	!-- for inorganic components were calculated using AIM online (Clegg et al
6268	!-- 1998). The water associated with the organic compound is calculated assuming
6269	!-- ideality and that aw = RH.
6270	!
6271	!-- b) Molality of each inorganic ion and organic solute (initial input) is
6272	!-- calculated for use in vapour pressure calculation.
6273	!
6274	!-- 3) - BISULPHATE ION DISSOCIATION CALCULATION
6275	!
6276	!-- The dissociation of the bisulphate ion is calculated explicitly. A solution
6277	!-- to the equilibrium equation between the bisulphate ion, hydrogen ion and
6278	!-- sulphate ion is found using tabulated equilibrium constants (referenced). It
6279	!-- is necessary to calculate the activity coefficients of HHSO4 and H2SO4 in a
6280	!-- non-iterative manner. These are calculated using the same format as
6281	!-- described in 4) below, where both activity coefficients were fit to the
6282	!-- output from ADDEM (Topping et al 2005a,b) covering an extensive composition
6283	!-- space, providing the activity coefficients and bisulphate ion dissociation
6284	!-- as a function of equivalent mole fractions and relative humidity.
6285	!
6286	!-- NOTE: the flags "binary_case" and "full_complexity" are not used in this
6287	!-- prototype. They are used for simplification of the fit expressions when
6288	!-- using limited composition regions. This section of code calculates the
6289	!-- bisulphate ion concentration
6290	!
6291	IF ( ions(1) > 0.0_wp .AND. ions(4) > 0.0_wp ) THEN
6292	!
6293	!-- HHSO4:
6294	binary_case = 1
6295	IF ( RH > 0.1_wp .AND. RH < 0.9_wp ) THEN
6296	binary_hhso4 = - 4.9521_wp * ( RH*3 ) + 9.2881_wp ( RH**2 ) - &
6297	10.777_wp * RH + 6.0534_wp
6298	ELSEIF ( RH >= 0.9_wp .AND. RH < 0.955_wp ) THEN
6299	binary_hhso4 = - 6.3777_wp * RH + 5.962_wp
6300	ELSEIF ( RH >= 0.955_wp .AND. RH < 0.99_wp ) THEN
6301	binary_hhso4 = 2367.2_wp * ( RH*3 ) - 6849.7_wp ( RH**2 ) + &
6302	6600.9_wp * RH - 2118.7_wp
6303	ELSEIF ( RH >= 0.99_wp .AND. RH < 0.9999_wp ) THEN
6304	binary_hhso4 = 3E-7_wp * ( RH*5 ) - 2E-5_wp ( RH**4 ) + &
6305	0.0004_wp * ( RH*3 ) - 0.0035_wp ( RH**2 ) + &
6306	0.0123_wp * RH - 0.3025_wp
6307	ENDIF
6308
6309	IF ( nitric_acid > 0.0_wp ) THEN
6310	HNO3_hhso4 = - 4.2204_wp * ( RH*4 ) + 12.193_wp ( RH**3 ) - &
6311	12.481_wp * ( RH*2 ) + 6.459_wp RH - 1.9004_wp
6312	ENDIF
6313
6314	IF ( hydrochloric_acid > 0.0_wp ) THEN
6315	HCL_hhso4 = - 54.845_wp * ( RH*7 ) + 209.54_wp ( RH**6 ) - &
6316	336.59_wp * ( RH*5 ) + 294.21_wp ( RH**4 ) - &
6317	150.07_wp * ( RH*3 ) + 43.767_wp ( RH**2 ) - &
6318	6.5495_wp * RH + 0.60048_wp
6319	ENDIF
6320
6321	IF ( ammonium_sulphate > 0.0_wp ) THEN
6322	NH42SO4_hhso4 = 16.768_wp * ( RH*3 ) - 28.75_wp ( RH**2 ) + &
6323	20.011_wp * RH - 8.3206_wp
6324	ENDIF
6325
6326	IF ( ammonium_nitrate > 0.0_wp ) THEN
6327	NH4NO3_hhso4 = - 17.184_wp * ( RH*4 ) + 56.834_wp ( RH**3 ) - &
6328	65.765_wp * ( RH*2 ) + 35.321_wp RH - 9.252_wp
6329	ENDIF
6330
6331	IF (ammonium_chloride > 0.0_wp ) THEN
6332	IF ( RH < 0.2_wp .AND. RH >= 0.1_wp ) THEN
6333	NH4Cl_hhso4 = 3.2809_wp * RH - 2.0637_wp
6334	ELSEIF ( RH >= 0.2_wp .AND. RH < 0.99_wp ) THEN
6335	NH4Cl_hhso4 = - 1.2981_wp * ( RH*3 ) + 4.7461_wp ( RH**2 ) - &
6336	2.3269_wp * RH - 1.1259_wp
6337	ENDIF
6338	ENDIF
6339
6340	IF ( sodium_sulphate > 0.0_wp ) THEN
6341	Na2SO4_hhso4 = 118.87_wp * ( RH*6 ) - 358.63_wp ( RH**5 ) + &
6342	435.85_wp * ( RH*4 ) - 272.88_wp ( RH**3 ) + &
6343	94.411_wp * ( RH*2 ) - 18.21_wp RH + 0.45935_wp
6344	ENDIF
6345
6346	IF ( sodium_nitrate > 0.0_wp ) THEN
6347	IF ( RH < 0.2_wp .AND. RH >= 0.1_wp ) THEN
6348	NaNO3_hhso4 = 4.8456_wp * RH - 2.5773_wp
6349	ELSEIF ( RH >= 0.2_wp .AND. RH < 0.99_wp ) THEN
6350	NaNO3_hhso4 = 0.5964_wp * ( RH*3 ) - 0.38967_wp ( RH**2 ) + &
6351	1.7918_wp * RH - 1.9691_wp
6352	ENDIF
6353	ENDIF
6354
6355	IF ( sodium_chloride > 0.0_wp ) THEN
6356	IF ( RH < 0.2_wp ) THEN
6357	NaCl_hhso4 = 0.51995_wp * RH - 1.3981_wp
6358	ELSEIF ( RH >= 0.2_wp .AND. RH < 0.99_wp ) THEN
6359	NaCl_hhso4 = 1.6539_wp * RH - 1.6101_wp
6360	ENDIF
6361	ENDIF
6362
6363	Ln_hhso4_act = binary_hhso4 + &
6364	nitric_acid_eq_frac * HNO3_hhso4 + &
6365	hydrochloric_acid_eq_frac * HCL_hhso4 + &
6366	ammonium_sulphate_eq_frac * NH42SO4_hhso4 + &
6367	ammonium_nitrate_eq_frac * NH4NO3_hhso4 + &
6368	ammonium_chloride_eq_frac * NH4Cl_hhso4 + &
6369	sodium_sulphate_eq_frac * Na2SO4_hhso4 + &
6370	sodium_nitrate_eq_frac * NaNO3_hhso4 + &
6371	sodium_chloride_eq_frac * NaCl_hhso4
6372	gamma_hhso4 = EXP( Ln_hhso4_act ) ! molal activity coefficient of HHSO4
6373
6374	!-- H2SO4 (sulphuric acid):
6375	IF ( RH >= 0.1_wp .AND. RH < 0.9_wp ) THEN
6376	binary_h2so4 = 2.4493_wp * ( RH*2 ) - 6.2326_wp RH + 2.1763_wp
6377	ELSEIF ( RH >= 0.9_wp .AND. RH < 0.98 ) THEN
6378	binary_h2so4 = 914.68_wp * ( RH*3 ) - 2502.3_wp ( RH**2 ) + &
6379	2281.9_wp * RH - 695.11_wp
6380	ELSEIF ( RH >= 0.98 .AND. RH < 0.9999 ) THEN
6381	binary_h2so4 = 3E-8_wp * ( RH*4 ) - 5E-6_wp ( RH**3 ) + &
6382	0.0003_wp * ( RH*2 ) - 0.0022_wp RH - 1.1305_wp
6383	ENDIF
6384
6385	IF ( nitric_acid > 0.0_wp ) THEN
6386	HNO3_h2so4 = - 16.382_wp * ( RH*5 ) + 46.677_wp ( RH**4 ) - &
6387	54.149_wp * ( RH*3 ) + 34.36_wp ( RH**2 ) - &
6388	12.54_wp * RH + 2.1368_wp
6389	ENDIF
6390
6391	IF ( hydrochloric_acid > 0.0_wp ) THEN
6392	HCL_h2so4 = - 14.409_wp * ( RH*5 ) + 42.804_wp ( RH**4 ) - &
6393	47.24_wp * ( RH*3 ) + 24.668_wp ( RH**2 ) - &
6394	5.8015_wp * RH + 0.084627_wp
6395	ENDIF
6396
6397	IF ( ammonium_sulphate > 0.0_wp ) THEN
6398	NH42SO4_h2so4 = 66.71_wp * ( RH*5 ) - 187.5_wp ( RH**4 ) + &
6399	210.57_wp * ( RH*3 ) - 121.04_wp ( RH**2 ) + &
6400	39.182_wp * RH - 8.0606_wp
6401	ENDIF
6402
6403	IF ( ammonium_nitrate > 0.0_wp ) THEN
6404	NH4NO3_h2so4 = - 22.532_wp * ( RH*4 ) + 66.615_wp ( RH**3 ) - &
6405	74.647_wp * ( RH*2 ) + 37.638_wp RH - 6.9711_wp
6406	ENDIF
6407
6408	IF ( ammonium_chloride > 0.0_wp ) THEN
6409	IF ( RH >= 0.1_wp .AND. RH < 0.2_wp ) THEN
6410	NH4Cl_h2so4 = - 0.32089_wp * RH + 0.57738_wp
6411	ELSEIF ( RH >= 0.2_wp .AND. RH < 0.9_wp ) THEN
6412	NH4Cl_h2so4 = 18.089_wp * ( RH*5 ) - 51.083_wp ( RH**4 ) + &
6413	50.32_wp * ( RH*3 ) - 17.012_wp ( RH**2 ) - &
6414	0.93435_wp * RH + 1.0548_wp
6415	ELSEIF ( RH >= 0.9_wp .AND. RH < 0.99_wp ) THEN
6416	NH4Cl_h2so4 = - 1.5749_wp * RH + 1.7002_wp
6417	ENDIF
6418	ENDIF
6419
6420	IF ( sodium_sulphate > 0.0_wp ) THEN
6421	Na2SO4_h2so4 = 29.843_wp * ( RH*4 ) - 69.417_wp ( RH**3 ) + &
6422	61.507_wp * ( RH*2 ) - 29.874_wp RH + 7.7556_wp
6423	ENDIF
6424
6425	IF ( sodium_nitrate > 0.0_wp ) THEN
6426	NaNO3_h2so4 = - 122.37_wp * ( RH*6 ) + 427.43_wp ( RH**5 ) - &
6427	604.68_wp * ( RH*4 ) + 443.08_wp ( RH**3 ) - &
6428	178.61_wp * ( RH*2 ) + 37.242_wp RH - 1.9564_wp
6429	ENDIF
6430
6431	IF ( sodium_chloride > 0.0_wp ) THEN
6432	NaCl_h2so4 = - 40.288_wp * ( RH*5 ) + 115.61_wp ( RH**4 ) - &
6433	129.99_wp * ( RH*3 ) + 72.652_wp ( RH**2 ) - &
6434	22.124_wp * RH + 4.2676_wp
6435	ENDIF
6436
6437	Ln_h2so4_act = binary_h2so4 + &
6438	nitric_acid_eq_frac * HNO3_h2so4 + &
6439	hydrochloric_acid_eq_frac * HCL_h2so4 + &
6440	ammonium_sulphate_eq_frac * NH42SO4_h2so4 + &
6441	ammonium_nitrate_eq_frac * NH4NO3_h2so4 + &
6442	ammonium_chloride_eq_frac * NH4Cl_h2so4 + &
6443	sodium_sulphate_eq_frac * Na2SO4_h2so4 + &
6444	sodium_nitrate_eq_frac * NaNO3_h2so4 + &
6445	sodium_chloride_eq_frac * NaCl_h2so4
6446
6447	gamma_h2so4 = EXP( Ln_h2so4_act ) ! molal activity coefficient
6448	!
6449	!-- Export activity coefficients
6450	IF ( gamma_h2so4 > 1.0E-10_wp ) THEN
6451	gamma_out(4) = ( gamma_hhso4**2.0_wp ) / gamma_h2so4
6452	ENDIF
6453	IF ( gamma_hhso4 > 1.0E-10_wp ) THEN
6454	gamma_out(5) = ( gamma_h2so43.0_wp ) / ( gamma_hhso42.0_wp )
6455	ENDIF
6456	!
6457	!-- Ionic activity coefficient product
6458	act_product = ( gamma_h2so43.0_wp ) / ( gamma_hhso42.0_wp )
6459	!
6460	!-- Solve the quadratic equation (i.e. x in ax**2 + bx + c = 0)
6461	a = 1.0_wp
6462	b = - 1.0_wp * ( ions(4) + ions(1) + ( ( water_total * 18.0E-3_wp ) / &
6463	( 99.0_wp * act_product ) ) )
6464	c = ions(4) * ions(1)
6465	root1 = ( ( -1.0_wp * b ) + ( ( ( b*2 ) - 4.0_wp a * c )**0.5_wp &
6466	) ) / ( 2 * a )
6467	root2 = ( ( -1.0_wp * b ) - ( ( ( b*2 ) - 4.0_wp a * c) **0.5_wp &
6468	) ) / ( 2 * a )
6469
6470	IF ( root1 > ions(1) .OR. root1 < 0.0_wp ) THEN
6471	root1 = 0.0_wp
6472	ENDIF
6473
6474	IF ( root2 > ions(1) .OR. root2 < 0.0_wp ) THEN
6475	root2 = 0.0_wp
6476	ENDIF
6477	!
6478	!-- Calculate the new hydrogen ion, bisulphate ion and sulphate ion
6479	!-- concentration
6480	hso4_real = 0.0_wp
6481	h_real = ions(1)
6482	so4_real = ions(4)
6483	IF ( root1 == 0.0_wp ) THEN
6484	hso4_real = root2
6485	ELSEIF ( root2 == 0.0_wp ) THEN
6486	hso4_real = root1
6487	ENDIF
6488	h_real = ions(1) - hso4_real
6489	so4_real = ions(4) - hso4_real
6490	!
6491	!-- Recalculate ion molalities
6492	ions_mol(1) = h_real / ( water_total * 18.01528E-3_wp ) ! H+
6493	ions_mol(4) = so4_real / ( water_total * 18.01528E-3_wp ) ! SO4(2-)
6494	ions_mol(5) = hso4_real / ( water_total * 18.01528E-3_wp ) ! HSO4(2-)
6495
6496	h_out = h_real
6497	hso4_out = hso4_real
6498	so4_out = so4_real
6499
6500	ELSEIF ( ions(1) == 0.0_wp .OR. ions(4) == 0.0_wp ) THEN
6501	h_out = ions(1)
6502	hso4_out = 0.0_wp
6503	so4_out = ions(4)
6504	ENDIF
6505
6506	!
6507	!-- 4) ACTIVITY COEFFICIENTS -for vapour pressures of HNO3,HCL and NH3
6508	!
6509	!-- This section evaluates activity coefficients and vapour pressures using the
6510	!-- water content calculated above) for each inorganic condensing species:
6511	!-- a - HNO3, b - NH3, c - HCL.
6512	!-- The following procedure is used:
6513	!-- Zaveri et al (2005) found that one could express the variation of activity
6514	!-- coefficients linearly in log-space if equivalent mole fractions were used.
6515	!-- So, by a taylor series expansion LOG( activity coefficient ) =
6516	!-- LOG( binary activity coefficient at a given RH ) +
6517	!-- (equivalent mole fraction compound A) *
6518	!-- ('interaction' parameter between A and condensing species) +
6519	!-- equivalent mole fraction compound B) *
6520	!-- ('interaction' parameter between B and condensing species).
6521	!-- Here, the interaction parameters have been fit to ADDEM by searching the
6522	!-- whole compositon space and fit usign the Levenberg-Marquardt non-linear
6523	!-- least squares algorithm.
6524	!
6525	!-- They are given as a function of RH and vary with complexity ranging from
6526	!-- linear to 5th order polynomial expressions, the binary activity coefficients
6527	!-- were calculated using AIM online.
6528	!-- NOTE: for NH3, no binary activity coefficient was used and the data were fit
6529	!-- to the ratio of the activity coefficients for the ammonium and hydrogen
6530	!-- ions. Once the activity coefficients are obtained the vapour pressure can be
6531	!-- easily calculated using tabulated equilibrium constants (referenced). This
6532	!-- procedure differs from that of Zaveri et al (2005) in that it is not assumed
6533	!-- one can carry behaviour from binary mixtures in multicomponent systems. To
6534	!-- this end we have fit the 'interaction' parameters explicitly to a general
6535	!-- inorganic equilibrium model (ADDEM - Topping et al. 2005a,b). Such
6536	!-- parameters take into account bisulphate ion dissociation and water content.
6537	!-- This also allows us to consider one regime for all composition space, rather
6538	!-- than defining sulphate rich and sulphate poor regimes
6539	!-- NOTE: The flags "binary_case" and "full_complexity" are not used in this
6540	!-- prototype. They are used for simplification of the fit expressions when
6541	!-- using limited composition regions.
6542	!
6543	!-- a) - ACTIVITY COEFF/VAPOUR PRESSURE - HNO3
6544	IF ( ions(1) > 0.0_wp .AND. ions(6) > 0.0_wp ) THEN
6545	binary_case = 1
6546	IF ( RH > 0.1_wp .AND. RH < 0.98_wp ) THEN
6547	IF ( binary_case == 1 ) THEN
6548	binary_hno3 = 1.8514_wp * ( RH*3 ) - 4.6991_wp ( RH**2 ) + &
6549	1.5514_wp * RH + 0.90236_wp
6550	ELSEIF ( binary_case == 2 ) THEN
6551	binary_hno3 = - 1.1751_wp * ( RH*2 ) - 0.53794_wp RH + &
6552	1.2808_wp
6553	ENDIF
6554	ELSEIF ( RH >= 0.98_wp .AND. RH < 0.9999_wp ) THEN
6555	binary_hno3 = 1244.69635941351_wp * ( RH**3 ) - &
6556	2613.93941099991_wp * ( RH**2 ) + &
6557	1525.0684974546_wp * RH -155.946764059316_wp
6558	ENDIF
6559	!
6560	!-- Contributions from other solutes
6561	full_complexity = 1
6562	IF ( hydrochloric_acid > 0.0_wp ) THEN ! HCL
6563	IF ( full_complexity == 1 .OR. RH < 0.4_wp ) THEN
6564	HCL_hno3 = 16.051_wp * ( RH*4 ) - 44.357_wp ( RH**3 ) + &
6565	45.141_wp * ( RH*2 ) - 21.638_wp RH + 4.8182_wp
6566	ELSEIF ( full_complexity == 0 .AND. RH > 0.4_wp ) THEN
6567	HCL_hno3 = - 1.5833_wp * RH + 1.5569_wp
6568	ENDIF
6569	ENDIF
6570
6571	IF ( sulphuric_acid > 0.0_wp ) THEN ! H2SO4
6572	IF ( full_complexity == 1 .OR. RH < 0.4_wp ) THEN
6573	H2SO4_hno3 = - 3.0849_wp * ( RH*3 ) + 5.9609_wp ( RH**2 ) - &
6574	4.468_wp * RH + 1.5658_wp
6575	ELSEIF ( full_complexity == 0 .AND. RH > 0.4_wp ) THEN
6576	H2SO4_hno3 = - 0.93473_wp * RH + 0.9363_wp
6577	ENDIF
6578	ENDIF
6579
6580	IF ( ammonium_sulphate > 0.0_wp ) THEN ! NH42SO4
6581	NH42SO4_hno3 = 16.821_wp * ( RH*3 ) - 28.391_wp ( RH**2 ) + &
6582	18.133_wp * RH - 6.7356_wp
6583	ENDIF
6584
6585	IF ( ammonium_nitrate > 0.0_wp ) THEN ! NH4NO3
6586	NH4NO3_hno3 = 11.01_wp * ( RH*3 ) - 21.578_wp ( RH**2 ) + &
6587	14.808_wp * RH - 4.2593_wp
6588	ENDIF
6589
6590	IF ( ammonium_chloride > 0.0_wp ) THEN ! NH4Cl
6591	IF ( full_complexity == 1 .OR. RH <= 0.4_wp ) THEN
6592	NH4Cl_hno3 = - 1.176_wp * ( RH*3 ) + 5.0828_wp ( RH**2 ) - &
6593	3.8792_wp * RH - 0.05518_wp
6594	ELSEIF ( full_complexity == 0 .AND. RH > 0.4_wp ) THEN
6595	NH4Cl_hno3 = 2.6219_wp * ( RH*2 ) - 2.2609_wp RH - 0.38436_wp
6596	ENDIF
6597	ENDIF
6598
6599	IF ( sodium_sulphate > 0.0_wp ) THEN ! Na2SO4
6600	Na2SO4_hno3 = 35.504_wp * ( RH*4 ) - 80.101_wp ( RH**3 ) + &
6601	67.326_wp * ( RH*2 ) - 28.461_wp RH + 5.6016_wp
6602	ENDIF
6603
6604	IF ( sodium_nitrate > 0.0_wp ) THEN ! NaNO3
6605	IF ( full_complexity == 1 .OR. RH <= 0.4_wp ) THEN
6606	NaNO3_hno3 = 23.659_wp * ( RH*5 ) - 66.917_wp ( RH**4 ) + &
6607	74.686_wp * ( RH*3 ) - 40.795_wp ( RH**2 ) + &
6608	10.831_wp * RH - 1.4701_wp
6609	ELSEIF ( full_complexity == 0 .AND. RH > 0.4_wp ) THEN
6610	NaNO3_hno3 = 14.749_wp * ( RH*4 ) - 35.237_wp ( RH**3 ) + &
6611	31.196_wp * ( RH*2 ) - 12.076_wp RH + 1.3605_wp
6612	ENDIF
6613	ENDIF
6614
6615	IF ( sodium_chloride > 0.0_wp ) THEN ! NaCl
6616	IF ( full_complexity == 1 .OR. RH <= 0.4_wp ) THEN
6617	NaCl_hno3 = 13.682_wp * ( RH*4 ) - 35.122_wp ( RH**3 ) + &
6618	33.397_wp * ( RH*2 ) - 14.586_wp RH + 2.6276_wp
6619	ELSEIF ( full_complexity == 0 .AND. RH > 0.4_wp ) THEN
6620	NaCl_hno3 = 1.1882_wp * ( RH*3 ) - 1.1037_wp ( RH**2 ) - &
6621	0.7642_wp * RH + 0.6671_wp
6622	ENDIF
6623	ENDIF
6624
6625	Ln_HNO3_act = binary_hno3 + &
6626	hydrochloric_acid_eq_frac * HCL_hno3 + &
6627	sulphuric_acid_eq_frac * H2SO4_hno3 + &
6628	ammonium_sulphate_eq_frac * NH42SO4_hno3 + &
6629	ammonium_nitrate_eq_frac * NH4NO3_hno3 + &
6630	ammonium_chloride_eq_frac * NH4Cl_hno3 + &
6631	sodium_sulphate_eq_frac * Na2SO4_hno3 + &
6632	sodium_nitrate_eq_frac * NaNO3_hno3 + &
6633	sodium_chloride_eq_frac * NaCl_hno3
6634
6635	gamma_hno3 = EXP( Ln_HNO3_act ) ! Molal activity coefficient of HNO3
6636	gamma_out(1) = gamma_hno3
6637	!
6638	!-- Partial pressure calculation
6639	!-- K_hno3 = 2.51 * ( 10**6 )
6640	!-- K_hno3 = 2.628145923d6 !< calculated by AIM online (Clegg et al 1998)
6641	!-- after Chameides (1984) (and NIST database)
6642	K_hno3 = 2.6E6_wp * EXP( 8700.0_wp * henrys_temp_dep)
6643	Press_HNO3 = ( ions_mol(1) * ions_mol(6) * ( gamma_hno3**2 ) ) / &
6644	K_hno3
6645	ENDIF
6646	!
6647	!-- b) - ACTIVITY COEFF/VAPOUR PRESSURE - NH3
6648	!-- Follow the two solute approach of Zaveri et al. (2005)
6649	IF ( ions(2) > 0.0_wp .AND. ions_mol(1) > 0.0_wp ) THEN
6650	!-- NH4HSO4:
6651	binary_nh4hso4 = 56.907_wp * ( RH*6 ) - 155.32_wp ( RH**5 ) + &
6652	142.94_wp * ( RH*4 ) - 32.298_wp ( RH**3 ) - &
6653	27.936_wp * ( RH*2 ) + 19.502_wp RH - 4.2618_wp
6654	IF ( nitric_acid > 0.0_wp) THEN ! HNO3
6655	HNO3_nh4hso4 = 104.8369_wp * ( RH*8 ) - 288.8923_wp ( RH**7 ) + &
6656	129.3445_wp * ( RH*6 ) + 373.0471_wp ( RH**5 ) - &
6657	571.0385_wp * ( RH*4 ) + 326.3528_wp ( RH**3 ) - &
6658	74.169_wp * ( RH*2 ) - 2.4999_wp RH + 3.17_wp
6659	ENDIF
6660
6661	IF ( hydrochloric_acid > 0.0_wp) THEN ! HCL
6662	HCL_nh4hso4 = - 7.9133_wp * ( RH*8 ) + 126.6648_wp ( RH**7 ) - &
6663	460.7425_wp * ( RH*6 ) + 731.606_wp ( RH**5 ) - &
6664	582.7467_wp * ( RH*4 ) + 216.7197_wp ( RH**3 ) - &
6665	11.3934_wp * ( RH*2 ) - 17.7728_wp RH + 5.75_wp
6666	ENDIF
6667
6668	IF ( sulphuric_acid > 0.0_wp) THEN ! H2SO4
6669	H2SO4_nh4hso4 = 195.981_wp * ( RH*8 ) - 779.2067_wp ( RH**7 ) + &
6670	1226.3647_wp * ( RH*6 ) - 964.0261_wp ( RH**5 ) + &
6671	391.7911_wp * ( RH*4 ) - 84.1409_wp ( RH**3 ) + &
6672	20.0602_wp * ( RH*2 ) - 10.2663_wp RH + 3.5817_wp
6673	ENDIF
6674
6675	IF ( ammonium_sulphate > 0.0_wp) THEN ! NH42SO4
6676	NH42SO4_nh4hso4 = 617.777_wp * ( RH*8 ) - 2547.427_wp ( RH**7 ) &
6677	+ 4361.6009_wp * ( RH*6 ) - 4003.162_wp ( RH**5 ) &
6678	+ 2117.8281_wp * ( RH*4 ) - 640.0678_wp ( RH**3 ) &
6679	+ 98.0902_wp * ( RH*2 ) - 2.2615_wp RH - 2.3811_wp
6680	ENDIF
6681
6682	IF ( ammonium_nitrate > 0.0_wp) THEN ! NH4NO3
6683	NH4NO3_nh4hso4 = - 104.4504_wp * ( RH*8 ) + 539.5921_wp &
6684	( RH*7 ) - 1157.0498_wp ( RH*6 ) + 1322.4507_wp &
6685	( RH*5 ) - 852.2475_wp ( RH*4 ) + 298.3734_wp &
6686	( RH*3 ) - 47.0309_wp ( RH*2 ) + 1.297_wp RH - &
6687	0.8029_wp
6688	ENDIF
6689
6690	IF ( ammonium_chloride > 0.0_wp) THEN ! NH4Cl
6691	NH4Cl_nh4hso4 = 258.1792_wp * ( RH*8 ) - 1019.3777_wp &
6692	( RH*7 ) + 1592.8918_wp ( RH*6 ) - 1221.0726_wp &
6693	( RH*5 ) + 442.2548_wp ( RH*4 ) - 43.6278_wp &
6694	( RH*3 ) - 7.5282_wp ( RH*2 ) - 3.8459_wp RH + 2.2728_wp
6695	ENDIF
6696
6697	IF ( sodium_sulphate > 0.0_wp) THEN ! Na2SO4
6698	Na2SO4_nh4hso4 = 225.4238_wp * ( RH*8 ) - 732.4113_wp &
6699	( RH*7 ) + 843.7291_wp ( RH*6 ) - 322.7328_wp &
6700	( RH*5 ) - 88.6252_wp ( RH*4 ) + 72.4434_wp &
6701	( RH*3 ) + 22.9252_wp ( RH*2 ) - 25.3954_wp RH + &
6702	4.6971_wp
6703	ENDIF
6704
6705	IF ( sodium_nitrate > 0.0_wp) THEN ! NaNO3
6706	NaNO3_nh4hso4 = 96.1348_wp * ( RH*8 ) - 341.6738_wp ( RH**7 ) + &
6707	406.5314_wp * ( RH*6 ) - 98.5777_wp ( RH**5 ) - &
6708	172.8286_wp * ( RH*4 ) + 149.3151_wp ( RH**3 ) - &
6709	38.9998_wp * ( RH*2 ) - 0.2251 RH + 0.4953_wp
6710	ENDIF
6711
6712	IF ( sodium_chloride > 0.0_wp) THEN ! NaCl
6713	NaCl_nh4hso4 = 91.7856_wp * ( RH*8 ) - 316.6773_wp ( RH**7 ) + &
6714	358.2703_wp * ( RH*6 ) - 68.9142 ( RH**5 ) - &
6715	156.5031_wp * ( RH*4 ) + 116.9592_wp ( RH**3 ) - &
6716	22.5271_wp * ( RH*2 ) - 3.7716_wp RH + 1.56_wp
6717	ENDIF
6718
6719	Ln_NH4HSO4_act = binary_nh4hso4 + &
6720	nitric_acid_eq_frac * HNO3_nh4hso4 + &
6721	hydrochloric_acid_eq_frac * HCL_nh4hso4 + &
6722	sulphuric_acid_eq_frac * H2SO4_nh4hso4 + &
6723	ammonium_sulphate_eq_frac * NH42SO4_nh4hso4 + &
6724	ammonium_nitrate_eq_frac * NH4NO3_nh4hso4 + &
6725	ammonium_chloride_eq_frac * NH4Cl_nh4hso4 + &
6726	sodium_sulphate_eq_frac * Na2SO4_nh4hso4 + &
6727	sodium_nitrate_eq_frac * NaNO3_nh4hso4 + &
6728	sodium_chloride_eq_frac * NaCl_nh4hso4
6729
6730	gamma_nh4hso4 = EXP( Ln_NH4HSO4_act ) ! molal act. coefficient of NH4HSO4
6731	!-- Molal activity coefficient of NO3-
6732	gamma_out(6) = gamma_nh4hso4
6733	!-- Molal activity coefficient of NH4+
6734	gamma_nh3 = ( gamma_nh4hso42 ) / ( gamma_hhso42 )
6735	gamma_out(3) = gamma_nh3
6736	!
6737	!-- This actually represents the ratio of the ammonium to hydrogen ion
6738	!-- activity coefficients (see Zaveri paper) - multiply this by the ratio
6739	!-- of the ammonium to hydrogen ion molality and the ratio of appropriate
6740	!-- equilibrium constants
6741	!
6742	!-- Equilibrium constants
6743	!-- Kh = 57.64d0 ! Zaveri et al. (2005)
6744	Kh = 5.8E1_wp * EXP( 4085.0_wp * henrys_temp_dep ) ! after Chameides
6745	! ! (1984) (and NIST database)
6746	!-- Knh4 = 1.81E-5_wp ! Zaveri et al. (2005)
6747	Knh4 = 1.7E-5_wp * EXP( -4325.0_wp * henrys_temp_dep ) ! Chameides
6748	! (1984)
6749	!-- Kw = 1.01E-14_wp ! Zaveri et al (2005)
6750	Kw = 1.E-14_wp * EXP( -6716.0_wp * henrys_temp_dep ) ! Chameides
6751	! (1984)
6752	!
6753	molality_ratio_nh3 = ions_mol(2) / ions_mol(1)
6754	!-- Partial pressure calculation
6755	Press_NH3 = molality_ratio_nh3 * gamma_nh3 * ( Kw / ( Kh * Knh4 ) )
6756
6757	ENDIF
6758	!
6759	!-- c) - ACTIVITY COEFF/VAPOUR PRESSURE - HCL
6760	IF ( ions(1) > 0.0_wp .AND. ions(7) > 0.0_wp ) THEN
6761	binary_case = 1
6762	IF ( RH > 0.1_wp .AND. RH < 0.98 ) THEN
6763	IF ( binary_case == 1 ) THEN
6764	binary_hcl = - 5.0179_wp * ( RH*3 ) + 9.8816_wp ( RH**2 ) - &
6765	10.789_wp * RH + 5.4737_wp
6766	ELSEIF ( binary_case == 2 ) THEN
6767	binary_hcl = - 4.6221_wp * RH + 4.2633_wp
6768	ENDIF
6769	ELSEIF ( RH >= 0.98_wp .AND. RH < 0.9999_wp ) THEN
6770	binary_hcl = 775.6111008626_wp * ( RH*3 ) - 2146.01320888771_wp &
6771	( RH*2 ) + 1969.01979670259_wp RH - 598.878230033926_wp
6772	ENDIF
6773	ENDIF
6774
6775	IF ( nitric_acid > 0.0_wp ) THEN ! HNO3
6776	IF ( full_complexity == 1 .OR. RH <= 0.4_wp ) THEN
6777	HNO3_hcl = 9.6256_wp * ( RH*4 ) - 26.507_wp ( RH**3 ) + &
6778	27.622_wp * ( RH*2 ) - 12.958_wp RH + 2.2193_wp
6779	ELSEIF ( full_complexity == 0 .AND. RH > 0.4_wp ) THEN
6780	HNO3_hcl = 1.3242_wp * ( RH*2 ) - 1.8827_wp RH + 0.55706_wp
6781	ENDIF
6782	ENDIF
6783
6784	IF ( sulphuric_acid > 0.0_wp ) THEN ! H2SO4
6785	IF ( full_complexity == 1 .OR. RH <= 0.4 ) THEN
6786	H2SO4_hcl = 1.4406_wp * ( RH*3 ) - 2.7132_wp ( RH**2 ) + &
6787	1.014_wp * RH + 0.25226_wp
6788	ELSEIF ( full_complexity == 0 .AND. RH > 0.4_wp ) THEN
6789	H2SO4_hcl = 0.30993_wp * ( RH*2 ) - 0.99171_wp RH + 0.66913_wp
6790	ENDIF
6791	ENDIF
6792
6793	IF ( ammonium_sulphate > 0.0_wp ) THEN ! NH42SO4
6794	NH42SO4_hcl = 22.071_wp * ( RH*3 ) - 40.678_wp ( RH**2 ) + &
6795	27.893_wp * RH - 9.4338_wp
6796	ENDIF
6797
6798	IF ( ammonium_nitrate > 0.0_wp ) THEN ! NH4NO3
6799	NH4NO3_hcl = 19.935_wp * ( RH*3 ) - 42.335_wp ( RH**2 ) + &
6800	31.275_wp * RH - 8.8675_wp
6801	ENDIF
6802
6803	IF ( ammonium_chloride > 0.0_wp ) THEN ! NH4Cl
6804	IF ( full_complexity == 1 .OR. RH <= 0.4_wp ) THEN
6805	NH4Cl_hcl = 2.8048_wp * ( RH*3 ) - 4.3182_wp ( RH**2 ) + &
6806	3.1971_wp * RH - 1.6824_wp
6807	ELSEIF ( full_complexity == 0 .AND. RH > 0.4_wp ) THEN
6808	NH4Cl_hcl = 1.2304_wp * ( RH*2 ) - 0.18262_wp RH - 1.0643_wp
6809	ENDIF
6810	ENDIF
6811
6812	IF ( sodium_sulphate > 0.0_wp ) THEN ! Na2SO4
6813	Na2SO4_hcl = 36.104_wp * ( RH*4 ) - 78.658_wp ( RH**3 ) + &
6814	63.441_wp * ( RH*2 ) - 26.727_wp RH + 5.7007_wp
6815	ENDIF
6816
6817	IF ( sodium_nitrate > 0.0_wp ) THEN ! NaNO3
6818	IF ( full_complexity == 1 .OR. RH <= 0.4_wp ) THEN
6819	NaNO3_hcl = 54.471_wp * ( RH*5 ) - 159.42_wp ( RH**4 ) + &
6820	180.25_wp * ( RH*3 ) - 98.176_wp ( RH**2 ) + &
6821	25.309_wp * RH - 2.4275_wp
6822	ELSEIF ( full_complexity == 0 .AND. RH > 0.4_wp ) THEN
6823	NaNO3_hcl = 21.632_wp * ( RH*4 ) - 53.088_wp ( RH**3 ) + &
6824	47.285_wp * ( RH*2 ) - 18.519_wp RH + 2.6846_wp
6825	ENDIF
6826	ENDIF
6827
6828	IF ( sodium_chloride > 0.0_wp ) THEN ! NaCl
6829	IF ( full_complexity == 1 .OR. RH <= 0.4_wp ) THEN
6830	NaCl_hcl = 5.4138_wp * ( RH*4 ) - 12.079_wp ( RH**3 ) + &
6831	9.627_wp * ( RH*2 ) - 3.3164_wp RH + 0.35224_wp
6832	ELSEIF ( full_complexity == 0 .AND. RH > 0.4_wp ) THEN
6833	NaCl_hcl = 2.432_wp * ( RH*3 ) - 4.3453_wp ( RH**2 ) + &
6834	2.3834_wp * RH - 0.4762_wp
6835	ENDIF
6836	ENDIF
6837
6838	Ln_HCL_act = binary_hcl + &
6839	nitric_acid_eq_frac * HNO3_hcl + &
6840	sulphuric_acid_eq_frac * H2SO4_hcl + &
6841	ammonium_sulphate_eq_frac * NH42SO4_hcl + &
6842	ammonium_nitrate_eq_frac * NH4NO3_hcl + &
6843	ammonium_chloride_eq_frac * NH4Cl_hcl + &
6844	sodium_sulphate_eq_frac * Na2SO4_hcl + &
6845	sodium_nitrate_eq_frac * NaNO3_hcl + &
6846	sodium_chloride_eq_frac * NaCl_hcl
6847
6848	gamma_hcl = EXP( Ln_HCL_act ) ! Molal activity coefficient
6849	gamma_out(2) = gamma_hcl
6850	!
6851	!-- Equilibrium constant after Wagman et al. (1982) (and NIST database)
6852	K_hcl = 2E6_wp * EXP( 9000.0_wp * henrys_temp_dep )
6853
6854	Press_HCL = ( ions_mol(1) * ions_mol(7) * ( gamma_hcl**2 ) ) / K_hcl
6855	!
6856	!-- 5) Ion molility output
6857	mols_out = ions_mol
6858	!
6859	!-- REFERENCES
6860	!-- Clegg et al. (1998) A Thermodynamic Model of the System
6861	!-- H+-NH4+-Na+-SO42- -NO3--Cl--H2O at 298.15 K, J. Phys. Chem., 102A,
6862	!-- 2155-2171.
6863	!-- Clegg et al. (2001) Thermodynamic modelling of aqueous aerosols containing
6864	!-- electrolytes and dissolved organic compounds. Journal of Aerosol Science
6865	!-- 2001;32(6):713-738.
6866	!-- Topping et al. (2005a) A curved multi-component aerosol hygroscopicity model
6867	!-- framework: Part 1 - Inorganic compounds. Atmospheric Chemistry and
6868	!-- Physics 2005;5:1205-1222.
6869	!-- Topping et al. (2005b) A curved multi-component aerosol hygroscopicity model
6870	!-- framework: Part 2 - Including organic compounds. Atmospheric Chemistry
6871	!-- and Physics 2005;5:1223-1242.
6872	!-- Wagman et al. (1982). The NBS tables of chemical thermodynamic properties:
6873	!-- selected values for inorganic and Câ and Câ organic substances in SI
6874	!-- units (book)
6875	!-- Zaveri et al. (2005). A new method for multicomponent activity coefficients
6876	!-- of electrolytes in aqueous atmospheric aerosols, JGR, 110, D02201, 2005.
6877	END SUBROUTINE inorganic_pdfite
6878
6879	!------------------------------------------------------------------------------!
6880	! Description:
6881	! ------------
6882	!> Update the particle size distribution. Put particles into corrects bins.
6883	!>
6884	!> Moving-centre method assumed, i.e. particles are allowed to grow to their
6885	!> exact size as long as they are not crossing the fixed diameter bin limits.
6886	!> If the particles in a size bin cross the lower or upper diameter limit, they
6887	!> are all moved to the adjacent diameter bin and their volume is averaged with
6888	!> the particles in the new bin, which then get a new diameter.
6889	!
6890	!> Moving-centre method minimises numerical diffusion.
6891	!------------------------------------------------------------------------------!
6892	SUBROUTINE distr_update( paero )
6893
6894	IMPLICIT NONE
6895
6896	!-- Input and output variables
6897	TYPE(t_section), INTENT(inout) :: paero(fn2b) !< Aerosols particle
6898	!< size distribution and properties
6899	!-- Local variables
6900	INTEGER(iwp) :: b !< loop index
6901	INTEGER(iwp) :: mm !< loop index
6902	INTEGER(iwp) :: counti
6903	LOGICAL :: within_bins !< logical (particle belongs to the bin?)
6904	REAL(wp) :: znfrac !< number fraction to be moved to the larger bin
6905	REAL(wp) :: zvfrac !< volume fraction to be moved to the larger bin
6906	REAL(wp) :: zVexc !< Volume in the grown bin which exceeds the bin
6907	!< upper limit
6908	REAL(wp) :: zVihi !< particle volume at the high end of the bin
6909	REAL(wp) :: zVilo !< particle volume at the low end of the bin
6910	REAL(wp) :: zvpart !< particle volume (m3)
6911	REAL(wp) :: zVrat !< volume ratio of a size bin
6912
6913	zvpart = 0.0_wp
6914	zvfrac = 0.0_wp
6915
6916	within_bins = .FALSE.
6917
6918	!
6919	!-- Check if the volume of the bin is within bin limits after update
6920	counti = 0
6921	DO WHILE ( .NOT. within_bins )
6922	within_bins = .TRUE.
6923
6924	DO b = fn2b-1, in1a, -1
6925	mm = 0
6926	IF ( paero(b)%numc > nclim ) THEN
6927
6928	zvpart = 0.0_wp
6929	zvfrac = 0.0_wp
6930
6931	IF ( b == fn2a ) CYCLE
6932	!
6933	!-- Dry volume
6934	zvpart = SUM( paero(b)%volc(1:7) ) / paero(b)%numc
6935	!
6936	!-- Smallest bin cannot decrease
6937	IF ( paero(b)%vlolim > zvpart .AND. b == in1a ) CYCLE
6938	!
6939	!-- Decreasing bins
6940	IF ( paero(b)%vlolim > zvpart ) THEN
6941	mm = b - 1
6942	IF ( b == in2b ) mm = fn1a ! 2b goes to 1a
6943
6944	paero(mm)%numc = paero(mm)%numc + paero(b)%numc
6945	paero(b)%numc = 0.0_wp
6946	paero(mm)%volc(:) = paero(mm)%volc(:) + paero(b)%volc(:)
6947	paero(b)%volc(:) = 0.0_wp
6948	CYCLE
6949	ENDIF
6950	!
6951	!-- If size bin has not grown, cycle
6952	!-- Changed by Mona: compare to the arithmetic mean volume, as done
6953	!-- originally. Now particle volume is derived from the geometric mean
6954	!-- diameter, not arithmetic (see SUBROUTINE set_sizebins).
6955	IF ( zvpart <= api6 * ( ( aero(b)%vhilim + aero(b)%vlolim ) / &
6956	( 2.0_wp * api6 ) ) ) CYCLE
6957	IF ( ABS( zvpart - api6 * paero(b)%dmid ** 3.0_wp ) < &
6958	1.0E-35_wp ) CYCLE ! Mona: to avoid precision problems
6959	!
6960	!-- Volume ratio of the size bin
6961	zVrat = paero(b)%vhilim / paero(b)%vlolim
6962	!-- Particle volume at the low end of the bin
6963	zVilo = 2.0_wp * zvpart / ( 1.0_wp + zVrat )
6964	!-- Particle volume at the high end of the bin
6965	zVihi = zVrat * zVilo
6966	!-- Volume in the grown bin which exceeds the bin upper limit
6967	zVexc = 0.5_wp * ( zVihi + paero(b)%vhilim )
6968	!-- Number fraction to be moved to the larger bin
6969	znfrac = MIN( 1.0_wp, ( zVihi - paero(b)%vhilim) / &
6970	( zVihi - zVilo ) )
6971	!-- Volume fraction to be moved to the larger bin
6972	zvfrac = MIN( 0.99_wp, znfrac * zVexc / zvpart )
6973	IF ( zvfrac < 0.0_wp ) THEN
6974	message_string = 'Error: zvfrac < 0'
6975	CALL message( 'salsa_mod: distr_update', 'SA0050', &
6976	1, 2, 0, 6, 0 )
6977	ENDIF
6978	!
6979	!-- Update bin
6980	mm = b + 1
6981	!-- Volume (cm3/cm3)
6982	paero(mm)%volc(:) = paero(mm)%volc(:) + znfrac * paero(b)%numc * &
6983	zVexc * paero(b)%volc(:) / &
6984	SUM( paero(b)%volc(1:7) )
6985	paero(b)%volc(:) = paero(b)%volc(:) - znfrac * paero(b)%numc * &
6986	zVexc * paero(b)%volc(:) / &
6987	SUM( paero(b)%volc(1:7) )
6988
6989	!-- Number concentration (#/m3)
6990	paero(mm)%numc = paero(mm)%numc + znfrac * paero(b)%numc
6991	paero(b)%numc = paero(b)%numc * ( 1.0_wp - znfrac )
6992
6993	ENDIF ! nclim
6994
6995	IF ( paero(b)%numc > nclim ) THEN
6996	zvpart = SUM( paero(b)%volc(1:7) ) / paero(b)%numc
6997	within_bins = ( paero(b)%vlolim < zvpart .AND. &
6998	zvpart < paero(b)%vhilim )
6999	ENDIF
7000
7001	ENDDO ! - b
7002
7003	counti = counti + 1
7004	IF ( counti > 100 ) THEN
7005	message_string = 'Error: Aerosol bin update not converged'
7006	CALL message( 'salsa_mod: distr_update', 'SA0051', 1, 2, 0, 6, 0 )
7007	ENDIF
7008
7009	ENDDO ! - within bins
7010
7011	END SUBROUTINE distr_update
7012
7013	!------------------------------------------------------------------------------!
7014	! Description:
7015	! ------------
7016	!> salsa_diagnostics: Update properties for the current timestep:
7017	!>
7018	!> Juha Tonttila, FMI, 2014
7019	!> Tomi Raatikainen, FMI, 2016
7020	!------------------------------------------------------------------------------!
7021	SUBROUTINE salsa_diagnostics( i, j )
7022
7023	USE arrays_3d, &
7024	ONLY: p, pt, zu
7025
7026	USE basic_constants_and_equations_mod, &
7027	ONLY: g
7028
7029	USE control_parameters, &
7030	ONLY: pt_surface, surface_pressure
7031
7032	USE cpulog, &
7033	ONLY: cpu_log, log_point_s
7034
7035	IMPLICIT NONE
7036
7037	INTEGER(iwp), INTENT(in) :: i !<
7038	INTEGER(iwp), INTENT(in) :: j !<
7039
7040	INTEGER(iwp) :: b !<
7041	INTEGER(iwp) :: c !<
7042	INTEGER(iwp) :: gt !<
7043	INTEGER(iwp) :: k !<
7044	INTEGER(iwp) :: nc !<
7045	REAL(wp), DIMENSION(nzb:nzt+1) :: flag !< flag to mask topography
7046	REAL(wp), DIMENSION(nzb:nzt+1) :: flag_zddry !< flag to mask zddry
7047	REAL(wp), DIMENSION(nzb:nzt+1) :: in_adn !< air density (kg/m3)
7048	REAL(wp), DIMENSION(nzb:nzt+1) :: in_p !< pressure
7049	REAL(wp), DIMENSION(nzb:nzt+1) :: in_t !< temperature (K)
7050	REAL(wp), DIMENSION(nzb:nzt+1) :: mcsum !< sum of mass concentration
7051	REAL(wp), DIMENSION(nzb:nzt+1) :: ppm_to_nconc !< Conversion factor
7052	!< from ppm to #/m3
7053	REAL(wp), DIMENSION(nzb:nzt+1) :: zddry !<
7054	REAL(wp), DIMENSION(nzb:nzt+1) :: zvol !<
7055
7056	flag_zddry = 0.0_wp
7057	in_adn = 0.0_wp
7058	in_p = 0.0_wp
7059	in_t = 0.0_wp
7060	ppm_to_nconc = 1.0_wp
7061	zddry = 0.0_wp
7062	zvol = 0.0_wp
7063
7064	CALL cpu_log( log_point_s(94), 'salsa diagnostics ', 'start' )
7065
7066	!
7067	!-- Calculate thermodynamic quantities needed in SALSA
7068	CALL salsa_thrm_ij( i, j, p_ij=in_p, temp_ij=in_t, adn_ij=in_adn )
7069	!
7070	!-- Calculate conversion factors for gas concentrations
7071	ppm_to_nconc = for_ppm_to_nconc * in_p / in_t
7072	!
7073	!-- Predetermine flag to mask topography
7074	flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_0(:,j,i), 0 ) )
7075
7076	DO b = 1, nbins ! aerosol size bins
7077	!
7078	!-- Remove negative values
7079	aerosol_number(b)%conc(:,j,i) = MAX( nclim, &
7080	aerosol_number(b)%conc(:,j,i) ) * flag
7081	mcsum = 0.0_wp ! total mass concentration
7082	DO c = 1, ncc_tot
7083	!
7084	!-- Remove negative concentrations
7085	aerosol_mass((c-1)*nbins+b)%conc(:,j,i) = MAX( mclim, &
7086	aerosol_mass((c-1)*nbins+b)%conc(:,j,i) ) &
7087	* flag
7088	mcsum = mcsum + aerosol_mass((c-1)nbins+b)%conc(:,j,i) flag
7089	ENDDO
7090	!
7091	!-- Check that number and mass concentration match qualitatively
7092	IF ( ANY ( aerosol_number(b)%conc(:,j,i) > nclim .AND. &
7093	mcsum <= 0.0_wp ) ) &
7094	THEN
7095	DO k = nzb+1, nzt
7096	IF ( aerosol_number(b)%conc(k,j,i) > nclim .AND. &
7097	mcsum(k) <= 0.0_wp ) &
7098	THEN
7099	aerosol_number(b)%conc(k,j,i) = nclim * flag(k)
7100	DO c = 1, ncc_tot
7101	aerosol_mass((c-1)nbins+b)%conc(k,j,i) = mclim flag(k)
7102	ENDDO
7103	ENDIF
7104	ENDDO
7105	ENDIF
7106	!
7107	!-- Update aerosol particle radius
7108	CALL bin_mixrat( 'dry', b, i, j, zvol )
7109	zvol = zvol / arhoh2so4 ! Why on sulphate?
7110	!
7111	!-- Particles smaller then 0.1 nm diameter are set to zero
7112	zddry = ( zvol / MAX( nclim, aerosol_number(b)%conc(:,j,i) ) / api6 )** &
7113	( 1.0_wp / 3.0_wp )
7114	flag_zddry = MERGE( 1.0_wp, 0.0_wp, ( zddry < 1.0E-10_wp .AND. &
7115	aerosol_number(b)%conc(:,j,i) > nclim ) )
7116	!
7117	!-- Volatile species to the gas phase
7118	IF ( is_used( prtcl, 'SO4' ) .AND. lscndgas ) THEN
7119	nc = get_index( prtcl, 'SO4' )
7120	c = ( nc - 1 ) * nbins + b
7121	IF ( salsa_gases_from_chem ) THEN
7122	chem_species( gas_index_chem(1) )%conc(:,j,i) = &
7123	chem_species( gas_index_chem(1) )%conc(:,j,i) + &
7124	aerosol_mass(c)%conc(:,j,i) * avo * flag * &
7125	flag_zddry / ( amh2so4 * ppm_to_nconc )
7126	ELSE
7127	salsa_gas(1)%conc(:,j,i) = salsa_gas(1)%conc(:,j,i) + &
7128	aerosol_mass(c)%conc(:,j,i) / amh2so4 *&
7129	avo * flag * flag_zddry
7130	ENDIF
7131	ENDIF
7132	IF ( is_used( prtcl, 'OC' ) .AND. lscndgas ) THEN
7133	nc = get_index( prtcl, 'OC' )
7134	c = ( nc - 1 ) * nbins + b
7135	IF ( salsa_gases_from_chem ) THEN
7136	chem_species( gas_index_chem(5) )%conc(:,j,i) = &
7137	chem_species( gas_index_chem(5) )%conc(:,j,i) + &
7138	aerosol_mass(c)%conc(:,j,i) * avo * flag * &
7139	flag_zddry / ( amoc * ppm_to_nconc )
7140	ELSE
7141	salsa_gas(5)%conc(:,j,i) = salsa_gas(5)%conc(:,j,i) + &
7142	aerosol_mass(c)%conc(:,j,i) / amoc * &
7143	avo * flag * flag_zddry
7144	ENDIF
7145	ENDIF
7146	IF ( is_used( prtcl, 'NO' ) .AND. lscndgas ) THEN
7147	nc = get_index( prtcl, 'NO' )
7148	c = ( nc - 1 ) * nbins + b
7149	IF ( salsa_gases_from_chem ) THEN
7150	chem_species( gas_index_chem(2) )%conc(:,j,i) = &
7151	chem_species( gas_index_chem(2) )%conc(:,j,i) + &
7152	aerosol_mass(c)%conc(:,j,i) * avo * flag * &
7153	flag_zddry / ( amhno3 * ppm_to_nconc )
7154	ELSE
7155	salsa_gas(2)%conc(:,j,i) = salsa_gas(2)%conc(:,j,i) + &
7156	aerosol_mass(c)%conc(:,j,i) / amhno3 * &
7157	avo * flag * flag_zddry
7158	ENDIF
7159	ENDIF
7160	IF ( is_used( prtcl, 'NH' ) .AND. lscndgas ) THEN
7161	nc = get_index( prtcl, 'NH' )
7162	c = ( nc - 1 ) * nbins + b
7163	IF ( salsa_gases_from_chem ) THEN
7164	chem_species( gas_index_chem(3) )%conc(:,j,i) = &
7165	chem_species( gas_index_chem(3) )%conc(:,j,i) + &
7166	aerosol_mass(c)%conc(:,j,i) * avo * flag * &
7167	flag_zddry / ( amnh3 * ppm_to_nconc )
7168	ELSE
7169	salsa_gas(3)%conc(:,j,i) = salsa_gas(3)%conc(:,j,i) + &
7170	aerosol_mass(c)%conc(:,j,i) / amnh3 * &
7171	avo * flag * flag_zddry
7172	ENDIF
7173	ENDIF
7174	!
7175	!-- Mass and number to zero (insoluble species and water are lost)
7176	DO c = 1, ncc_tot
7177	aerosol_mass((c-1)nbins+b)%conc(:,j,i) = MERGE( mclim flag, &
7178	aerosol_mass((c-1)*nbins+b)%conc(:,j,i), &
7179	flag_zddry > 0.0_wp )
7180	ENDDO
7181	aerosol_number(b)%conc(:,j,i) = MERGE( nclim * flag, &
7182	aerosol_number(b)%conc(:,j,i), &
7183	flag_zddry > 0.0_wp )
7184	Ra_dry(:,j,i,b) = MAX( 1.0E-10_wp, 0.5_wp * zddry )
7185
7186	ENDDO
7187	IF ( .NOT. salsa_gases_from_chem ) THEN
7188	DO gt = 1, ngast
7189	salsa_gas(gt)%conc(:,j,i) = MAX( nclim, salsa_gas(gt)%conc(:,j,i) ) &
7190	* flag
7191	ENDDO
7192	ENDIF
7193
7194	CALL cpu_log( log_point_s(94), 'salsa diagnostics ', 'stop' )
7195
7196	END SUBROUTINE salsa_diagnostics
7197
7198
7199	!
7200	!------------------------------------------------------------------------------!
7201	! Description:
7202	! ------------
7203	!> Calculate the tendencies for aerosol number and mass concentrations.
7204	!> Cache-optimized.
7205	!------------------------------------------------------------------------------!
7206	SUBROUTINE salsa_tendency_ij( id, rs_p, rs, trs_m, i, j, i_omp_start, tn, b, &
7207	c, flux_s, diss_s, flux_l, diss_l, rs_init )
7208
7209	USE advec_ws, &
7210	ONLY: advec_s_ws
7211	USE advec_s_pw_mod, &
7212	ONLY: advec_s_pw
7213	USE advec_s_up_mod, &
7214	ONLY: advec_s_up
7215	USE arrays_3d, &
7216	ONLY: ddzu, hyp, pt, rdf_sc, tend
7217	USE diffusion_s_mod, &
7218	ONLY: diffusion_s
7219	USE indices, &
7220	ONLY: wall_flags_0
7221	USE pegrid, &
7222	ONLY: threads_per_task, myid
7223	USE surface_mod, &
7224	ONLY : surf_def_h, surf_def_v, surf_lsm_h, surf_lsm_v, surf_usm_h, &
7225	surf_usm_v
7226
7227	IMPLICIT NONE
7228
7229	CHARACTER (LEN = *) :: id
7230	INTEGER(iwp) :: b !< bin index in derived type aerosol_size_bin
7231	INTEGER(iwp) :: c !< bin index in derived type aerosol_size_bin
7232	INTEGER(iwp) :: i !<
7233	INTEGER(iwp) :: i_omp_start !<
7234	INTEGER(iwp) :: j !<
7235	INTEGER(iwp) :: k !<
7236	INTEGER(iwp) :: nc !< (c-1)*nbins+b
7237	INTEGER(iwp) :: tn !<
7238	REAL(wp), DIMENSION(nzb+1:nzt,nys:nyn,0:threads_per_task-1) :: diss_l !<
7239	REAL(wp), DIMENSION(nzb+1:nzt,0:threads_per_task-1) :: diss_s !<
7240	REAL(wp), DIMENSION(nzb+1:nzt,nys:nyn,0:threads_per_task-1) :: flux_l !<
7241	REAL(wp), DIMENSION(nzb+1:nzt,0:threads_per_task-1) :: flux_s !<
7242	REAL(wp), DIMENSION(nzb:nzt+1) :: rs_init !<
7243	REAL(wp), DIMENSION(:,:,:), POINTER :: rs_p !<
7244	REAL(wp), DIMENSION(:,:,:), POINTER :: rs !<
7245	REAL(wp), DIMENSION(:,:,:), POINTER :: trs_m !<
7246
7247	nc = (c-1)*nbins+b
7248	!
7249	!-- Tendency-terms for reactive scalar
7250	tend(:,j,i) = 0.0_wp
7251
7252	IF ( id == 'aerosol_number' .AND. lod_aero == 3 ) THEN
7253	tend(:,j,i) = tend(:,j,i) + aerosol_number(b)%source(:,j,i)
7254	ELSEIF ( id == 'aerosol_mass' .AND. lod_aero == 3 ) THEN
7255	tend(:,j,i) = tend(:,j,i) + aerosol_mass(nc)%source(:,j,i)
7256	ENDIF
7257	!
7258	!-- Advection terms
7259	IF ( timestep_scheme(1:5) == 'runge' ) THEN
7260	IF ( ws_scheme_sca ) THEN
7261	CALL advec_s_ws( i, j, rs, id, flux_s, diss_s, flux_l, diss_l, &
7262	i_omp_start, tn )
7263	ELSE
7264	CALL advec_s_pw( i, j, rs )
7265	ENDIF
7266	ELSE
7267	CALL advec_s_up( i, j, rs )
7268	ENDIF
7269	!
7270	!-- Diffusion terms
7271	IF ( id == 'aerosol_number' ) THEN
7272	CALL diffusion_s( i, j, rs, surf_def_h(0)%answs(:,b), &
7273	surf_def_h(1)%answs(:,b), surf_def_h(2)%answs(:,b), &
7274	surf_lsm_h%answs(:,b), surf_usm_h%answs(:,b), &
7275	surf_def_v(0)%answs(:,b), surf_def_v(1)%answs(:,b), &
7276	surf_def_v(2)%answs(:,b), surf_def_v(3)%answs(:,b), &
7277	surf_lsm_v(0)%answs(:,b), surf_lsm_v(1)%answs(:,b), &
7278	surf_lsm_v(2)%answs(:,b), surf_lsm_v(3)%answs(:,b), &
7279	surf_usm_v(0)%answs(:,b), surf_usm_v(1)%answs(:,b), &
7280	surf_usm_v(2)%answs(:,b), surf_usm_v(3)%answs(:,b) )
7281	!
7282	!-- Sedimentation for aerosol number and mass
7283	IF ( lsdepo ) THEN
7284	tend(nzb+1:nzt,j,i) = tend(nzb+1:nzt,j,i) - MAX( 0.0_wp, &
7285	( rs(nzb+2:nzt+1,j,i) * sedim_vd(nzb+2:nzt+1,j,i,b) - &
7286	rs(nzb+1:nzt,j,i) * sedim_vd(nzb+1:nzt,j,i,b) ) * &
7287	ddzu(nzb+1:nzt) ) * MERGE( 1.0_wp, 0.0_wp, &
7288	BTEST( wall_flags_0(nzb:nzt-1,j,i), 0 ) )
7289	ENDIF
7290
7291	ELSEIF ( id == 'aerosol_mass' ) THEN
7292	CALL diffusion_s( i, j, rs, surf_def_h(0)%amsws(:,nc), &
7293	surf_def_h(1)%amsws(:,nc), surf_def_h(2)%amsws(:,nc), &
7294	surf_lsm_h%amsws(:,nc), surf_usm_h%amsws(:,nc), &
7295	surf_def_v(0)%amsws(:,nc), surf_def_v(1)%amsws(:,nc), &
7296	surf_def_v(2)%amsws(:,nc), surf_def_v(3)%amsws(:,nc), &
7297	surf_lsm_v(0)%amsws(:,nc), surf_lsm_v(1)%amsws(:,nc), &
7298	surf_lsm_v(2)%amsws(:,nc), surf_lsm_v(3)%amsws(:,nc), &
7299	surf_usm_v(0)%amsws(:,nc), surf_usm_v(1)%amsws(:,nc), &
7300	surf_usm_v(2)%amsws(:,nc), surf_usm_v(3)%amsws(:,nc) )
7301	!
7302	!-- Sedimentation for aerosol number and mass
7303	IF ( lsdepo ) THEN
7304	tend(nzb+1:nzt,j,i) = tend(nzb+1:nzt,j,i) - MAX( 0.0_wp, &
7305	( rs(nzb+2:nzt+1,j,i) * sedim_vd(nzb+2:nzt+1,j,i,b) - &
7306	rs(nzb+1:nzt,j,i) * sedim_vd(nzb+1:nzt,j,i,b) ) * &
7307	ddzu(nzb+1:nzt) ) * MERGE( 1.0_wp, 0.0_wp, &
7308	BTEST( wall_flags_0(nzb:nzt-1,j,i), 0 ) )
7309	ENDIF
7310	ELSEIF ( id == 'salsa_gas' ) THEN
7311	CALL diffusion_s( i, j, rs, surf_def_h(0)%gtsws(:,b), &
7312	surf_def_h(1)%gtsws(:,b), surf_def_h(2)%gtsws(:,b), &
7313	surf_lsm_h%gtsws(:,b), surf_usm_h%gtsws(:,b), &
7314	surf_def_v(0)%gtsws(:,b), surf_def_v(1)%gtsws(:,b), &
7315	surf_def_v(2)%gtsws(:,b), surf_def_v(3)%gtsws(:,b), &
7316	surf_lsm_v(0)%gtsws(:,b), surf_lsm_v(1)%gtsws(:,b), &
7317	surf_lsm_v(2)%gtsws(:,b), surf_lsm_v(3)%gtsws(:,b), &
7318	surf_usm_v(0)%gtsws(:,b), surf_usm_v(1)%gtsws(:,b), &
7319	surf_usm_v(2)%gtsws(:,b), surf_usm_v(3)%gtsws(:,b) )
7320	ENDIF
7321	!
7322	!-- Prognostic equation for a scalar
7323	DO k = nzb+1, nzt
7324	rs_p(k,j,i) = rs(k,j,i) + ( dt_3d * ( tsc(2) * tend(k,j,i) + &
7325	tsc(3) * trs_m(k,j,i) ) &
7326	- tsc(5) * rdf_sc(k) &
7327	* ( rs(k,j,i) - rs_init(k) ) ) &
7328	* MERGE( 1.0_wp, 0.0_wp, &
7329	BTEST( wall_flags_0(k,j,i), 0 ) )
7330	IF ( rs_p(k,j,i) < 0.0_wp ) rs_p(k,j,i) = 0.1_wp * rs(k,j,i)
7331	ENDDO
7332
7333	!
7334	!-- Calculate tendencies for the next Runge-Kutta step
7335	IF ( timestep_scheme(1:5) == 'runge' ) THEN
7336	IF ( intermediate_timestep_count == 1 ) THEN
7337	DO k = nzb+1, nzt
7338	trs_m(k,j,i) = tend(k,j,i)
7339	ENDDO
7340	ELSEIF ( intermediate_timestep_count < &
7341	intermediate_timestep_count_max ) THEN
7342	DO k = nzb+1, nzt
7343	trs_m(k,j,i) = -9.5625_wp * tend(k,j,i) + 5.3125_wp * trs_m(k,j,i)
7344	ENDDO
7345	ENDIF
7346	ENDIF
7347
7348	END SUBROUTINE salsa_tendency_ij
7349
7350	!
7351	!------------------------------------------------------------------------------!
7352	! Description:
7353	! ------------
7354	!> Calculate the tendencies for aerosol number and mass concentrations.
7355	!> Vector-optimized.
7356	!------------------------------------------------------------------------------!
7357	SUBROUTINE salsa_tendency( id, rs_p, rs, trs_m, b, c, rs_init )
7358
7359	USE advec_ws, &
7360	ONLY: advec_s_ws
7361	USE advec_s_pw_mod, &
7362	ONLY: advec_s_pw
7363	USE advec_s_up_mod, &
7364	ONLY: advec_s_up
7365	USE arrays_3d, &
7366	ONLY: ddzu, hyp, pt, rdf_sc, tend
7367	USE diffusion_s_mod, &
7368	ONLY: diffusion_s
7369	USE indices, &
7370	ONLY: wall_flags_0
7371	USE surface_mod, &
7372	ONLY : surf_def_h, surf_def_v, surf_lsm_h, surf_lsm_v, surf_usm_h, &
7373	surf_usm_v
7374
7375	IMPLICIT NONE
7376
7377	CHARACTER (LEN = *) :: id
7378	INTEGER(iwp) :: b !< bin index in derived type aerosol_size_bin
7379	INTEGER(iwp) :: c !< bin index in derived type aerosol_size_bin
7380	INTEGER(iwp) :: i !<
7381	INTEGER(iwp) :: j !<
7382	INTEGER(iwp) :: k !<
7383	INTEGER(iwp) :: nc !< (c-1)*nbins+b
7384	REAL(wp), DIMENSION(nzb:nzt+1) :: rs_init !<
7385	REAL(wp), DIMENSION(:,:,:), POINTER :: rs_p !<
7386	REAL(wp), DIMENSION(:,:,:), POINTER :: rs !<
7387	REAL(wp), DIMENSION(:,:,:), POINTER :: trs_m !<
7388
7389	nc = (c-1)*nbins+b
7390	!
7391	!-- Tendency-terms for reactive scalar
7392	tend = 0.0_wp
7393
7394	IF ( id == 'aerosol_number' .AND. lod_aero == 3 ) THEN
7395	tend = tend + aerosol_number(b)%source
7396	ELSEIF ( id == 'aerosol_mass' .AND. lod_aero == 3 ) THEN
7397	tend = tend + aerosol_mass(nc)%source
7398	ENDIF
7399	!
7400	!-- Advection terms
7401	IF ( timestep_scheme(1:5) == 'runge' ) THEN
7402	IF ( ws_scheme_sca ) THEN
7403	CALL advec_s_ws( rs, id )
7404	ELSE
7405	CALL advec_s_pw( rs )
7406	ENDIF
7407	ELSE
7408	CALL advec_s_up( rs )
7409	ENDIF
7410	!
7411	!-- Diffusion terms
7412	IF ( id == 'aerosol_number' ) THEN
7413	CALL diffusion_s( rs, surf_def_h(0)%answs(:,b), &
7414	surf_def_h(1)%answs(:,b), surf_def_h(2)%answs(:,b), &
7415	surf_lsm_h%answs(:,b), surf_usm_h%answs(:,b), &
7416	surf_def_v(0)%answs(:,b), surf_def_v(1)%answs(:,b), &
7417	surf_def_v(2)%answs(:,b), surf_def_v(3)%answs(:,b), &
7418	surf_lsm_v(0)%answs(:,b), surf_lsm_v(1)%answs(:,b), &
7419	surf_lsm_v(2)%answs(:,b), surf_lsm_v(3)%answs(:,b), &
7420	surf_usm_v(0)%answs(:,b), surf_usm_v(1)%answs(:,b), &
7421	surf_usm_v(2)%answs(:,b), surf_usm_v(3)%answs(:,b) )
7422	ELSEIF ( id == 'aerosol_mass' ) THEN
7423	CALL diffusion_s( rs, surf_def_h(0)%amsws(:,nc), &
7424	surf_def_h(1)%amsws(:,nc), surf_def_h(2)%amsws(:,nc), &
7425	surf_lsm_h%amsws(:,nc), surf_usm_h%amsws(:,nc), &
7426	surf_def_v(0)%amsws(:,nc), surf_def_v(1)%amsws(:,nc), &
7427	surf_def_v(2)%amsws(:,nc), surf_def_v(3)%amsws(:,nc), &
7428	surf_lsm_v(0)%amsws(:,nc), surf_lsm_v(1)%amsws(:,nc), &
7429	surf_lsm_v(2)%amsws(:,nc), surf_lsm_v(3)%amsws(:,nc), &
7430	surf_usm_v(0)%amsws(:,nc), surf_usm_v(1)%amsws(:,nc), &
7431	surf_usm_v(2)%amsws(:,nc), surf_usm_v(3)%amsws(:,nc) )
7432	ELSEIF ( id == 'salsa_gas' ) THEN
7433	CALL diffusion_s( rs, surf_def_h(0)%gtsws(:,b), &
7434	surf_def_h(1)%gtsws(:,b), surf_def_h(2)%gtsws(:,b), &
7435	surf_lsm_h%gtsws(:,b), surf_usm_h%gtsws(:,b), &
7436	surf_def_v(0)%gtsws(:,b), surf_def_v(1)%gtsws(:,b), &
7437	surf_def_v(2)%gtsws(:,b), surf_def_v(3)%gtsws(:,b), &
7438	surf_lsm_v(0)%gtsws(:,b), surf_lsm_v(1)%gtsws(:,b), &
7439	surf_lsm_v(2)%gtsws(:,b), surf_lsm_v(3)%gtsws(:,b), &
7440	surf_usm_v(0)%gtsws(:,b), surf_usm_v(1)%gtsws(:,b), &
7441	surf_usm_v(2)%gtsws(:,b), surf_usm_v(3)%gtsws(:,b) )
7442	ENDIF
7443	!
7444	!-- Prognostic equation for a scalar
7445	DO i = nxl, nxr
7446	DO j = nys, nyn
7447	IF ( id == 'salsa_gas' .AND. lod_gases == 3 ) THEN
7448	tend(:,j,i) = tend(:,j,i) + salsa_gas(b)%source(:,j,i) * &
7449	for_ppm_to_nconc * hyp(:) / pt(:,j,i) * ( hyp(:) / &
7450	100000.0_wp )**0.286_wp ! ppm to #/m3
7451	ELSEIF ( id == 'aerosol_mass' .OR. id == 'aerosol_number') THEN
7452	!
7453	!-- Sedimentation for aerosol number and mass
7454	IF ( lsdepo ) THEN
7455	tend(nzb+1:nzt,j,i) = tend(nzb+1:nzt,j,i) - MAX( 0.0_wp, &
7456	( rs(nzb+2:nzt+1,j,i) * sedim_vd(nzb+2:nzt+1,j,i,b) - &
7457	rs(nzb+1:nzt,j,i) * sedim_vd(nzb+1:nzt,j,i,b) ) * &
7458	ddzu(nzb+1:nzt) ) * MERGE( 1.0_wp, 0.0_wp, &
7459	BTEST( wall_flags_0(nzb:nzt-1,j,i), 0 ) )
7460	ENDIF
7461	ENDIF
7462	DO k = nzb+1, nzt
7463	rs_p(k,j,i) = rs(k,j,i) + ( dt_3d * ( tsc(2) * tend(k,j,i) + &
7464	tsc(3) * trs_m(k,j,i) ) &
7465	- tsc(5) * rdf_sc(k) &
7466	* ( rs(k,j,i) - rs_init(k) ) )&
7467	* MERGE( 1.0_wp, 0.0_wp, &
7468	BTEST( wall_flags_0(k,j,i), 0 ) )
7469	IF ( rs_p(k,j,i) < 0.0_wp ) rs_p(k,j,i) = 0.1_wp * rs(k,j,i)
7470	ENDDO
7471	ENDDO
7472	ENDDO
7473
7474	!
7475	!-- Calculate tendencies for the next Runge-Kutta step
7476	IF ( timestep_scheme(1:5) == 'runge' ) THEN
7477	IF ( intermediate_timestep_count == 1 ) THEN
7478	DO i = nxl, nxr
7479	DO j = nys, nyn
7480	DO k = nzb+1, nzt
7481	trs_m(k,j,i) = tend(k,j,i)
7482	ENDDO
7483	ENDDO
7484	ENDDO
7485	ELSEIF ( intermediate_timestep_count < &
7486	intermediate_timestep_count_max ) THEN
7487	DO i = nxl, nxr
7488	DO j = nys, nyn
7489	DO k = nzb+1, nzt
7490	trs_m(k,j,i) = -9.5625_wp * tend(k,j,i) &
7491	+ 5.3125_wp * trs_m(k,j,i)
7492	ENDDO
7493	ENDDO
7494	ENDDO
7495	ENDIF
7496	ENDIF
7497
7498	END SUBROUTINE salsa_tendency
7499
7500	!------------------------------------------------------------------------------!
7501	! Description:
7502	! ------------
7503	!> Boundary conditions for prognostic variables in SALSA
7504	!------------------------------------------------------------------------------!
7505	SUBROUTINE salsa_boundary_conds
7506
7507	USE surface_mod, &
7508	ONLY : bc_h
7509
7510	IMPLICIT NONE
7511
7512	INTEGER(iwp) :: b !< index for aerosol size bins
7513	INTEGER(iwp) :: c !< index for chemical compounds in aerosols
7514	INTEGER(iwp) :: g !< idex for gaseous compounds
7515	INTEGER(iwp) :: i !< grid index x direction
7516	INTEGER(iwp) :: j !< grid index y direction
7517	INTEGER(iwp) :: k !< grid index y direction
7518	INTEGER(iwp) :: kb !< variable to set respective boundary value, depends on
7519	!< facing.
7520	INTEGER(iwp) :: l !< running index boundary type, for up- and downward-
7521	!< facing walls
7522	INTEGER(iwp) :: m !< running index surface elements
7523
7524	!
7525	!-- Surface conditions:
7526	IF ( ibc_salsa_b == 0 ) THEN ! Dirichlet
7527	!
7528	!-- Run loop over all non-natural and natural walls. Note, in wall-datatype
7529	!-- the k coordinate belongs to the atmospheric grid point, therefore, set
7530	!-- s_p at k-1
7531
7532	DO l = 0, 1
7533	!
7534	!-- Set kb, for upward-facing surfaces value at topography top (k-1) is
7535	!-- set, for downward-facing surfaces at topography bottom (k+1)
7536	kb = MERGE ( -1, 1, l == 0 )
7537	!$OMP PARALLEL PRIVATE( b, c, g, i, j, k )
7538	!$OMP DO
7539	DO m = 1, bc_h(l)%ns
7540
7541	i = bc_h(l)%i(m)
7542	j = bc_h(l)%j(m)
7543	k = bc_h(l)%k(m)
7544
7545	DO b = 1, nbins
7546	aerosol_number(b)%conc_p(k+kb,j,i) = &
7547	aerosol_number(b)%conc(k+kb,j,i)
7548	DO c = 1, ncc_tot
7549	aerosol_mass((c-1)*nbins+b)%conc_p(k+kb,j,i) = &
7550	aerosol_mass((c-1)*nbins+b)%conc(k+kb,j,i)
7551	ENDDO
7552	ENDDO
7553	IF ( .NOT. salsa_gases_from_chem ) THEN
7554	DO g = 1, ngast
7555	salsa_gas(g)%conc_p(k+kb,j,i) = salsa_gas(g)%conc(k+kb,j,i)
7556	ENDDO
7557	ENDIF
7558
7559	ENDDO
7560	!$OMP END PARALLEL
7561
7562	ENDDO
7563
7564	ELSE ! Neumann
7565
7566	DO l = 0, 1
7567	!
7568	!-- Set kb, for upward-facing surfaces value at topography top (k-1) is
7569	!-- set, for downward-facing surfaces at topography bottom (k+1)
7570	kb = MERGE( -1, 1, l == 0 )
7571	!$OMP PARALLEL PRIVATE( b, c, g, i, j, k )
7572	!$OMP DO
7573	DO m = 1, bc_h(l)%ns
7574
7575	i = bc_h(l)%i(m)
7576	j = bc_h(l)%j(m)
7577	k = bc_h(l)%k(m)
7578
7579	DO b = 1, nbins
7580	aerosol_number(b)%conc_p(k+kb,j,i) = &
7581	aerosol_number(b)%conc_p(k,j,i)
7582	DO c = 1, ncc_tot
7583	aerosol_mass((c-1)*nbins+b)%conc_p(k+kb,j,i) = &
7584	aerosol_mass((c-1)*nbins+b)%conc_p(k,j,i)
7585	ENDDO
7586	ENDDO
7587	IF ( .NOT. salsa_gases_from_chem ) THEN
7588	DO g = 1, ngast
7589	salsa_gas(g)%conc_p(k+kb,j,i) = salsa_gas(g)%conc_p(k,j,i)
7590	ENDDO
7591	ENDIF
7592
7593	ENDDO
7594	!$OMP END PARALLEL
7595	ENDDO
7596
7597	ENDIF
7598
7599	!
7600	!--Top boundary conditions:
7601	IF ( ibc_salsa_t == 0 ) THEN ! Dirichlet
7602
7603	DO b = 1, nbins
7604	aerosol_number(b)%conc_p(nzt+1,:,:) = &
7605	aerosol_number(b)%conc(nzt+1,:,:)
7606	DO c = 1, ncc_tot
7607	aerosol_mass((c-1)*nbins+b)%conc_p(nzt+1,:,:) = &
7608	aerosol_mass((c-1)*nbins+b)%conc(nzt+1,:,:)
7609	ENDDO
7610	ENDDO
7611	IF ( .NOT. salsa_gases_from_chem ) THEN
7612	DO g = 1, ngast
7613	salsa_gas(g)%conc_p(nzt+1,:,:) = salsa_gas(g)%conc(nzt+1,:,:)
7614	ENDDO
7615	ENDIF
7616
7617	ELSEIF ( ibc_salsa_t == 1 ) THEN ! Neumann
7618
7619	DO b = 1, nbins
7620	aerosol_number(b)%conc_p(nzt+1,:,:) = &
7621	aerosol_number(b)%conc_p(nzt,:,:)
7622	DO c = 1, ncc_tot
7623	aerosol_mass((c-1)*nbins+b)%conc_p(nzt+1,:,:) = &
7624	aerosol_mass((c-1)*nbins+b)%conc_p(nzt,:,:)
7625	ENDDO
7626	ENDDO
7627	IF ( .NOT. salsa_gases_from_chem ) THEN
7628	DO g = 1, ngast
7629	salsa_gas(g)%conc_p(nzt+1,:,:) = salsa_gas(g)%conc_p(nzt,:,:)
7630	ENDDO
7631	ENDIF
7632
7633	ENDIF
7634	!
7635	!-- Lateral boundary conditions at the outflow
7636	IF ( bc_radiation_s ) THEN
7637	DO b = 1, nbins
7638	aerosol_number(b)%conc_p(:,nys-1,:) = aerosol_number(b)%conc_p(:,nys,:)
7639	DO c = 1, ncc_tot
7640	aerosol_mass((c-1)*nbins+b)%conc_p(:,nys-1,:) = &
7641	aerosol_mass((c-1)*nbins+b)%conc_p(:,nys,:)
7642	ENDDO
7643	ENDDO
7644	ELSEIF ( bc_radiation_n ) THEN
7645	DO b = 1, nbins
7646	aerosol_number(b)%conc_p(:,nyn+1,:) = aerosol_number(b)%conc_p(:,nyn,:)
7647	DO c = 1, ncc_tot
7648	aerosol_mass((c-1)*nbins+b)%conc_p(:,nyn+1,:) = &
7649	aerosol_mass((c-1)*nbins+b)%conc_p(:,nyn,:)
7650	ENDDO
7651	ENDDO
7652	ELSEIF ( bc_radiation_l ) THEN
7653	DO b = 1, nbins
7654	aerosol_number(b)%conc_p(:,nxl-1,:) = aerosol_number(b)%conc_p(:,nxl,:)
7655	DO c = 1, ncc_tot
7656	aerosol_mass((c-1)*nbins+b)%conc_p(:,nxl-1,:) = &
7657	aerosol_mass((c-1)*nbins+b)%conc_p(:,nxl,:)
7658	ENDDO
7659	ENDDO
7660	ELSEIF ( bc_radiation_r ) THEN
7661	DO b = 1, nbins
7662	aerosol_number(b)%conc_p(:,nxr+1,:) = aerosol_number(b)%conc_p(:,nxr,:)
7663	DO c = 1, ncc_tot
7664	aerosol_mass((c-1)*nbins+b)%conc_p(:,nxr+1,:) = &
7665	aerosol_mass((c-1)*nbins+b)%conc_p(:,nxr,:)
7666	ENDDO
7667	ENDDO
7668	ENDIF
7669
7670	END SUBROUTINE salsa_boundary_conds
7671
7672	!------------------------------------------------------------------------------!
7673	! Description:
7674	! ------------
7675	! Undoing of the previously done cyclic boundary conditions.
7676	!------------------------------------------------------------------------------!
7677	SUBROUTINE salsa_boundary_conds_decycle ( sq, sq_init )
7678
7679	IMPLICIT NONE
7680
7681	INTEGER(iwp) :: boundary !<
7682	INTEGER(iwp) :: ee !<
7683	INTEGER(iwp) :: copied !<
7684	INTEGER(iwp) :: i !<
7685	INTEGER(iwp) :: j !<
7686	INTEGER(iwp) :: k !<
7687	INTEGER(iwp) :: ss !<
7688	REAL(wp), DIMENSION(nzb:nzt+1) :: sq_init
7689	REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) :: sq
7690	REAL(wp) :: flag !< flag to mask topography grid points
7691
7692	flag = 0.0_wp
7693	!
7694	!-- Left and right boundaries
7695	IF ( decycle_lr .AND. ( bc_lr_cyc .OR. bc_lr == 'nested' ) ) THEN
7696
7697	DO boundary = 1, 2
7698
7699	IF ( decycle_method(boundary) == 'dirichlet' ) THEN
7700	!
7701	!-- Initial profile is copied to ghost and first three layers
7702	ss = 1
7703	ee = 0
7704	IF ( boundary == 1 .AND. nxl == 0 ) THEN
7705	ss = nxlg
7706	ee = nxl+2
7707	ELSEIF ( boundary == 2 .AND. nxr == nx ) THEN
7708	ss = nxr-2
7709	ee = nxrg
7710	ENDIF
7711
7712	DO i = ss, ee
7713	DO j = nysg, nyng
7714	DO k = nzb+1, nzt
7715	flag = MERGE( 1.0_wp, 0.0_wp, &
7716	BTEST( wall_flags_0(k,j,i), 0 ) )
7717	sq(k,j,i) = sq_init(k) * flag
7718	ENDDO
7719	ENDDO
7720	ENDDO
7721
7722	ELSEIF ( decycle_method(boundary) == 'neumann' ) THEN
7723	!
7724	!-- The value at the boundary is copied to the ghost layers to simulate
7725	!-- an outlet with zero gradient
7726	ss = 1
7727	ee = 0
7728	IF ( boundary == 1 .AND. nxl == 0 ) THEN
7729	ss = nxlg
7730	ee = nxl-1
7731	copied = nxl
7732	ELSEIF ( boundary == 2 .AND. nxr == nx ) THEN
7733	ss = nxr+1
7734	ee = nxrg
7735	copied = nxr
7736	ENDIF
7737
7738	DO i = ss, ee
7739	DO j = nysg, nyng
7740	DO k = nzb+1, nzt
7741	flag = MERGE( 1.0_wp, 0.0_wp, &
7742	BTEST( wall_flags_0(k,j,i), 0 ) )
7743	sq(k,j,i) = sq(k,j,copied) * flag
7744	ENDDO
7745	ENDDO
7746	ENDDO
7747
7748	ELSE
7749	WRITE(message_string,*) &
7750	'unknown decycling method: decycle_method (', &
7751	boundary, ') ="' // TRIM( decycle_method(boundary) ) // '"'
7752	CALL message( 'salsa_boundary_conds_decycle', 'SA0029', &
7753	1, 2, 0, 6, 0 )
7754	ENDIF
7755	ENDDO
7756	ENDIF
7757
7758	!
7759	!-- South and north boundaries
7760	IF ( decycle_ns .AND. ( bc_ns_cyc .OR. bc_ns == 'nested' ) ) THEN
7761
7762	DO boundary = 3, 4
7763
7764	IF ( decycle_method(boundary) == 'dirichlet' ) THEN
7765	!
7766	!-- Initial profile is copied to ghost and first three layers
7767	ss = 1
7768	ee = 0
7769	IF ( boundary == 3 .AND. nys == 0 ) THEN
7770	ss = nysg
7771	ee = nys+2
7772	ELSEIF ( boundary == 4 .AND. nyn == ny ) THEN
7773	ss = nyn-2
7774	ee = nyng
7775	ENDIF
7776
7777	DO i = nxlg, nxrg
7778	DO j = ss, ee
7779	DO k = nzb+1, nzt
7780	flag = MERGE( 1.0_wp, 0.0_wp, &
7781	BTEST( wall_flags_0(k,j,i), 0 ) )
7782	sq(k,j,i) = sq_init(k) * flag
7783	ENDDO
7784	ENDDO
7785	ENDDO
7786
7787	ELSEIF ( decycle_method(boundary) == 'neumann' ) THEN
7788	!
7789	!-- The value at the boundary is copied to the ghost layers to simulate
7790	!-- an outlet with zero gradient
7791	ss = 1
7792	ee = 0
7793	IF ( boundary == 3 .AND. nys == 0 ) THEN
7794	ss = nysg
7795	ee = nys-1
7796	copied = nys
7797	ELSEIF ( boundary == 4 .AND. nyn == ny ) THEN
7798	ss = nyn+1
7799	ee = nyng
7800	copied = nyn
7801	ENDIF
7802
7803	DO i = nxlg, nxrg
7804	DO j = ss, ee
7805	DO k = nzb+1, nzt
7806	flag = MERGE( 1.0_wp, 0.0_wp, &
7807	BTEST( wall_flags_0(k,j,i), 0 ) )
7808	sq(k,j,i) = sq(k,copied,i) * flag
7809	ENDDO
7810	ENDDO
7811	ENDDO
7812
7813	ELSE
7814	WRITE(message_string,*) &
7815	'unknown decycling method: decycle_method (', &
7816	boundary, ') ="' // TRIM( decycle_method(boundary) ) // '"'
7817	CALL message( 'salsa_boundary_conds_decycle', 'SA0030', &
7818	1, 2, 0, 6, 0 )
7819	ENDIF
7820	ENDDO
7821	ENDIF
7822
7823	END SUBROUTINE salsa_boundary_conds_decycle
7824
7825	!------------------------------------------------------------------------------!
7826	! Description:
7827	! ------------
7828	!> Calculates the total dry or wet mass concentration for individual bins
7829	!> Juha Tonttila (FMI) 2015
7830	!> Tomi Raatikainen (FMI) 2016
7831	!------------------------------------------------------------------------------!
7832	SUBROUTINE bin_mixrat( itype, ibin, i, j, mconc )
7833
7834	IMPLICIT NONE
7835
7836	CHARACTER(len=*), INTENT(in) :: itype !< 'dry' or 'wet'
7837	INTEGER(iwp), INTENT(in) :: ibin !< index of the chemical component
7838	INTEGER(iwp), INTENT(in) :: i !< loop index for x-direction
7839	INTEGER(iwp), INTENT(in) :: j !< loop index for y-direction
7840	REAL(wp), DIMENSION(:), INTENT(out) :: mconc !< total dry or wet mass
7841	!< concentration
7842
7843	INTEGER(iwp) :: c !< loop index for mass bin number
7844	INTEGER(iwp) :: iend !< end index: include water or not
7845
7846	!-- Number of components
7847	IF ( itype == 'dry' ) THEN
7848	iend = get_n_comp( prtcl ) - 1
7849	ELSE IF ( itype == 'wet' ) THEN
7850	iend = get_n_comp( prtcl )
7851	ELSE
7852	STOP 'bin_mixrat: Error in itype'
7853	ENDIF
7854
7855	mconc = 0.0_wp
7856
7857	DO c = ibin, iend*nbins+ibin, nbins !< every nbins'th element
7858	mconc = mconc + aerosol_mass(c)%conc(:,j,i)
7859	ENDDO
7860
7861	END SUBROUTINE bin_mixrat
7862
7863	!------------------------------------------------------------------------------!
7864	!> Description:
7865	!> ------------
7866	!> Define aerosol fluxes: constant or read from a from file
7867	!------------------------------------------------------------------------------!
7868	SUBROUTINE salsa_set_source
7869
7870	! USE date_and_time_mod, &
7871	! ONLY: index_dd, index_hh, index_mm
7872	#if defined( __netcdf )
7873	USE NETCDF
7874
7875	USE netcdf_data_input_mod, &
7876	ONLY: get_attribute, netcdf_data_input_get_dimension_length, &
7877	get_variable, open_read_file
7878
7879	USE surface_mod, &
7880	ONLY: surf_def_h, surf_lsm_h, surf_usm_h
7881
7882	IMPLICIT NONE
7883
7884	INTEGER(iwp), PARAMETER :: ndm = 3 !< number of default modes
7885	INTEGER(iwp), PARAMETER :: ndc = 4 !< number of default categories
7886
7887	CHARACTER (LEN=10) :: unita !< Unit of aerosol fluxes
7888	CHARACTER (LEN=10) :: unitg !< Unit of gaseous fluxes
7889	INTEGER(iwp) :: b !< loop index: aerosol number bins
7890	INTEGER(iwp) :: c !< loop index: aerosol chemical components
7891	INTEGER(iwp) :: ee !< loop index: end
7892	INTEGER(iwp), ALLOCATABLE, DIMENSION(:) :: eci !< emission category index
7893	INTEGER(iwp) :: g !< loop index: gaseous tracers
7894	INTEGER(iwp) :: i !< loop index: x-direction
7895	INTEGER(iwp) :: id_faero !< NetCDF id of aerosol source input file
7896	INTEGER(iwp) :: id_fchem !< NetCDF id of aerosol source input file
7897	INTEGER(iwp) :: id_sa !< NetCDF id of variable: source
7898	INTEGER(iwp) :: j !< loop index: y-direction
7899	INTEGER(iwp) :: k !< loop index: z-direction
7900	INTEGER(iwp) :: kg !< loop index: z-direction (gases)
7901	INTEGER(iwp) :: n_dt !< number of time steps in the emission file
7902	INTEGER(iwp) :: nc_stat !< local variable for storing the result of
7903	!< netCDF calls for error message handling
7904	INTEGER(iwp) :: nb_file !< Number of grid-points in file (bins)
7905	INTEGER(iwp) :: ncat !< Number of emission categories
7906	INTEGER(iwp) :: ng_file !< Number of grid-points in file (gases)
7907	INTEGER(iwp) :: num_vars !< number of variables in input file
7908	INTEGER(iwp) :: nz_file !< number of grid-points in file
7909	INTEGER(iwp) :: n !< loop index
7910	INTEGER(iwp) :: ni !< loop index
7911	INTEGER(iwp) :: ss !< loop index
7912	LOGICAL :: netcdf_extend = .FALSE. !< Flag indicating wether netcdf
7913	!< topography input file or not
7914	REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:) :: dum_var_4d !< variable for
7915	!< temporary data
7916	REAL(wp) :: fillval !< fill value
7917	REAL(wp) :: flag !< flag to mask topography grid points
7918	REAL(wp), DIMENSION(nbins) :: nsect_emission !< sectional emission (lod1)
7919	REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: pm_emission !< aerosol mass
7920	!< emission (lod1)
7921	REAL(wp), DIMENSION(nbins) :: source_ijka !< aerosol source at (k,j,i)
7922	!
7923	!-- The default size distribution and mass composition per emission category:
7924	!-- 1 = traffic, 2 = road dust, 3 = wood combustion, 4 = other
7925	!-- Mass fractions: H2SO4, OC, BC, DU, SS, HNO3, NH3
7926	CHARACTER(LEN=15), DIMENSION(ndc) :: cat_name_table = &!< emission category
7927	(/'road traffic ','road dust ',&
7928	'wood combustion','other '/)
7929	REAL(wp), DIMENSION(ndc) :: avg_density !< average density
7930	REAL(wp), DIMENSION(ndc) :: conversion_factor !< unit conversion factor
7931	!< for aerosol emissions
7932	REAL(wp), DIMENSION(ndm), PARAMETER :: dpg_table = & !< mean diameter (mum)
7933	(/ 13.5E-3_wp, 1.4_wp, 5.4E-2_wp/)
7934	REAL(wp), DIMENSION(ndm) :: ntot_table
7935	REAL(wp), DIMENSION(maxspec,ndc), PARAMETER :: mass_fraction_table = &
7936	RESHAPE( (/ 0.04_wp, 0.48_wp, 0.48_wp, 0.0_wp, 0.0_wp, 0.0_wp, 0.0_wp, &
7937	0.0_wp, 0.05_wp, 0.0_wp, 0.95_wp, 0.0_wp, 0.0_wp, 0.0_wp, &
7938	0.0_wp, 0.5_wp, 0.5_wp, 0.0_wp, 0.0_wp, 0.0_wp, 0.0_wp, &
7939	0.0_wp, 0.5_wp, 0.5_wp, 0.0_wp, 0.0_wp, 0.0_wp, 0.0_wp &
7940	/), (/maxspec,ndc/) )
7941	REAL(wp), DIMENSION(ndm,ndc), PARAMETER :: PMfrac_table = & !< rel. mass
7942	RESHAPE( (/ 0.016_wp, 0.000_wp, 0.984_wp, &
7943	0.000_wp, 1.000_wp, 0.000_wp, &
7944	0.000_wp, 0.000_wp, 1.000_wp, &
7945	1.000_wp, 0.000_wp, 1.000_wp &
7946	/), (/ndm,ndc/) )
7947	REAL(wp), DIMENSION(ndm), PARAMETER :: sigmag_table = & !< mode std
7948	(/1.6_wp, 1.4_wp, 1.7_wp/)
7949	avg_density = 1.0_wp
7950	nb_file = 0
7951	ng_file = 0
7952	nsect_emission = 0.0_wp
7953	nz_file = 0
7954	source_ijka = 0.0_wp
7955	!
7956	!-- First gases, if needed:
7957	IF ( .NOT. salsa_gases_from_chem ) THEN
7958	!
7959	!-- Read sources from PIDS_CHEM
7960	INQUIRE( FILE='PIDS_CHEM' // TRIM( coupling_char ), EXIST=netcdf_extend )
7961	IF ( .NOT. netcdf_extend ) THEN
7962	message_string = 'Input file '// TRIM( 'PIDS_CHEM' ) // &
7963	TRIM( coupling_char ) // ' for SALSA missing!'
7964	CALL message( 'salsa_mod: salsa_set_source', 'SA0027', 1, 2, 0, 6, 0 )
7965	ENDIF ! netcdf_extend
7966
7967	CALL location_message( ' salsa_set_source: NOTE! Gaseous emissions'//&
7968	' should be provided with following emission indices:'// &
7969	' 1=H2SO4, 2=HNO3, 3=NH3, 4=OCNV, 5=OCSV', .TRUE. )
7970	CALL location_message( ' salsa_set_source: No time dependency for '//&
7971	'gaseous emissions. Use emission_values '// &
7972	'directly.', .TRUE. )
7973	!
7974	!-- Open PIDS_CHEM in read-only mode
7975	CALL open_read_file( 'PIDS_CHEM' // TRIM( coupling_char ), id_fchem )
7976	!
7977	!-- Inquire the level of detail (lod)
7978	CALL get_attribute( id_fchem, 'lod', lod_gases, .FALSE., &
7979	"emission_values" )
7980
7981	IF ( lod_gases == 2 ) THEN
7982	!
7983	!-- Index of gaseous compounds
7984	CALL netcdf_data_input_get_dimension_length( id_fchem, ng_file, "nspecies" )
7985	IF ( ng_file < 5 ) THEN
7986	message_string = 'Some gaseous emissions missing.'
7987	CALL message( 'salsa_mod: salsa_set_source', 'SA0041', &
7988	1, 2, 0, 6, 0 )
7989	ENDIF
7990	!
7991	!-- Get number of emission categories
7992	CALL netcdf_data_input_get_dimension_length( id_fchem, ncat, "ncat" )
7993	!
7994	!-- Inquire the unit of gaseous fluxes
7995	CALL get_attribute( id_fchem, 'units', unitg, .FALSE., &
7996	"emission_values")
7997	!
7998	!-- Inquire the fill value
7999	CALL get_attribute( id_fchem, '_FillValue', fillval, .FALSE., &
8000	"emission_values" )
8001	!
8002	!-- Read surface emission data (x,y) PE-wise
8003	ALLOCATE( dum_var_4d(ng_file,ncat,nys:nyn,nxl:nxr) )
8004	CALL get_variable( id_fchem, 'emission_values', dum_var_4d, nxl, nxr,&
8005	nys, nyn, 0, ncat-1, 0, ng_file-1 )
8006	DO g = 1, ngast
8007	ALLOCATE( salsa_gas(g)%source(ncat,nys:nyn,nxl:nxr) )
8008	salsa_gas(g)%source = 0.0_wp
8009	salsa_gas(g)%source = salsa_gas(g)%source + dum_var_4d(g,:,:,:)
8010	ENDDO
8011	!
8012	!-- Set surface fluxes of gaseous compounds on horizontal surfaces.
8013	!-- Set fluxes only for either default, land or urban surface.
8014	IF ( .NOT. land_surface .AND. .NOT. urban_surface ) THEN
8015	CALL set_gas_flux( surf_def_h(0), ncat, unitg )
8016	ELSE
8017	CALL set_gas_flux( surf_lsm_h, ncat, unitg )
8018	CALL set_gas_flux( surf_usm_h, ncat, unitg )
8019	ENDIF
8020
8021	DEALLOCATE( dum_var_4d )
8022	DO g = 1, ngast
8023	DEALLOCATE( salsa_gas(g)%source )
8024	ENDDO
8025	ELSE
8026	message_string = 'Input file PIDS_CHEM needs to have lod = 2 when '//&
8027	'SALSA is applied but not the chemistry module!'
8028	CALL message( 'salsa_mod: salsa_set_source', 'SA0039', 1, 2, 0, 6, 0 )
8029	ENDIF
8030	ENDIF
8031	!
8032	!-- Read sources from PIDS_SALSA
8033	INQUIRE( FILE='PIDS_SALSA' // TRIM( coupling_char ), EXIST=netcdf_extend )
8034	IF ( .NOT. netcdf_extend ) THEN
8035	message_string = 'Input file '// TRIM( 'PIDS_SALSA' ) // &
8036	TRIM( coupling_char ) // ' for SALSA missing!'
8037	CALL message( 'salsa_mod: salsa_set_source', 'SA0034', 1, 2, 0, 6, 0 )
8038	ENDIF ! netcdf_extend
8039	!
8040	!-- Open file in read-only mode
8041	CALL open_read_file( 'PIDS_SALSA' // TRIM( coupling_char ), id_faero )
8042	!
8043	!-- Get number of emission categories and their indices
8044	CALL netcdf_data_input_get_dimension_length( id_faero, ncat, "ncat" )
8045	!
8046	!-- Get emission category indices
8047	ALLOCATE( eci(1:ncat) )
8048	CALL get_variable( id_faero, 'emission_category_index', eci )
8049	!
8050	!-- Inquire the level of detail (lod)
8051	CALL get_attribute( id_faero, 'lod', lod_aero, .FALSE., &
8052	"aerosol_emission_values" )
8053
8054	IF ( lod_aero < 3 .AND. ibc_salsa_b == 0 ) THEN
8055	message_string = 'lod1/2 for aerosol emissions requires '// &
8056	'bc_salsa_b = "Neumann"'
8057	CALL message( 'salsa_mod: salsa_set_source','SA0025', 1, 2, 0, 6, 0 )
8058	ENDIF
8059	!
8060	!-- Inquire the fill value
8061	CALL get_attribute( id_faero, '_FillValue', fillval, .FALSE., &
8062	"aerosol_emission_values" )
8063	!
8064	!-- Aerosol chemical composition:
8065	ALLOCATE( emission_mass_fracs(1:ncat,1:maxspec) )
8066	emission_mass_fracs = 0.0_wp
8067	!-- Chemical composition: 1: H2SO4 (sulphuric acid), 2: OC (organic carbon),
8068	!-- 3: BC (black carbon), 4: DU (dust),
8069	!-- 5: SS (sea salt), 6: HNO3 (nitric acid),
8070	!-- 7: NH3 (ammonia)
8071	DO n = 1, ncat
8072	IF ( lod_aero < 2 ) THEN
8073	emission_mass_fracs(n,:) = mass_fraction_table(:,n)
8074	ELSE
8075	CALL get_variable( id_faero, "emission_mass_fracs", &
8076	emission_mass_fracs(n,:) )
8077	ENDIF
8078	!
8079	!-- If the chemical component is not activated, set its mass fraction to 0
8080	!-- to avoid inbalance between number and mass flux
8081	IF ( iso4 < 0 ) emission_mass_fracs(n,1) = 0.0_wp
8082	IF ( ioc < 0 ) emission_mass_fracs(n,2) = 0.0_wp
8083	IF ( ibc < 0 ) emission_mass_fracs(n,3) = 0.0_wp
8084	IF ( idu < 0 ) emission_mass_fracs(n,4) = 0.0_wp
8085	IF ( iss < 0 ) emission_mass_fracs(n,5) = 0.0_wp
8086	IF ( ino < 0 ) emission_mass_fracs(n,6) = 0.0_wp
8087	IF ( inh < 0 ) emission_mass_fracs(n,7) = 0.0_wp
8088	!-- Then normalise the mass fraction so that SUM = 1
8089	emission_mass_fracs(n,:) = emission_mass_fracs(n,:) / &
8090	SUM( emission_mass_fracs(n,:) )
8091	ENDDO
8092
8093	IF ( lod_aero > 1 ) THEN
8094	!
8095	!-- Aerosol geometric mean diameter
8096	CALL netcdf_data_input_get_dimension_length( id_faero, nb_file, 'Dmid' )
8097	IF ( nb_file /= nbins ) THEN
8098	message_string = 'The number of size bins in aerosol input data '// &
8099	'does not correspond to the model set-up'
8100	CALL message( 'salsa_mod: salsa_set_source','SA0040', 1, 2, 0, 6, 0 )
8101	ENDIF
8102	ENDIF
8103
8104	IF ( lod_aero < 3 ) THEN
8105	CALL location_message( ' salsa_set_source: No time dependency for '//&
8106	'aerosol emissions. Use aerosol_emission_values'//&
8107	' directly.', .TRUE. )
8108	!
8109	!-- Allocate source arrays
8110	DO b = 1, nbins
8111	ALLOCATE( aerosol_number(b)%source(1:ncat,nys:nyn,nxl:nxr) )
8112	aerosol_number(b)%source = 0.0_wp
8113	ENDDO
8114	DO c = 1, ncc_tot*nbins
8115	ALLOCATE( aerosol_mass(c)%source(1:ncat,nys:nyn,nxl:nxr) )
8116	aerosol_mass(c)%source = 0.0_wp
8117	ENDDO
8118
8119	IF ( lod_aero == 1 ) THEN
8120	DO n = 1, ncat
8121	avg_density(n) = emission_mass_fracs(n,1) * arhoh2so4 + &
8122	emission_mass_fracs(n,2) * arhooc + &
8123	emission_mass_fracs(n,3) * arhobc + &
8124	emission_mass_fracs(n,4) * arhodu + &
8125	emission_mass_fracs(n,5) * arhoss + &
8126	emission_mass_fracs(n,6) * arhohno3 + &
8127	emission_mass_fracs(n,7) * arhonh3
8128	ENDDO
8129	!
8130	!-- Emission unit
8131	CALL get_attribute( id_faero, 'units', unita, .FALSE., &
8132	"aerosol_emission_values")
8133	conversion_factor = 1.0_wp
8134	IF ( unita == 'kg/m2/yr' ) THEN
8135	conversion_factor = 3.170979e-8_wp / avg_density
8136	ELSEIF ( unita == 'g/m2/yr' ) THEN
8137	conversion_factor = 3.170979e-8_wp * 1.0E-3_wp / avg_density
8138	ELSEIF ( unita == 'kg/m2/s' ) THEN
8139	conversion_factor = 1.0_wp / avg_density
8140	ELSEIF ( unita == 'g/m2/s' ) THEN
8141	conversion_factor = 1.0E-3_wp / avg_density
8142	ELSE
8143	message_string = 'unknown unit for aerosol emissions: ' &
8144	// TRIM( unita ) // ' (lod1)'
8145	CALL message( 'salsa_mod: salsa_set_source','SA0035', &
8146	1, 2, 0, 6, 0 )
8147	ENDIF
8148	!
8149	!-- Read surface emission data (x,y) PE-wise
8150	ALLOCATE( pm_emission(ncat,nys:nyn,nxl:nxr) )
8151	CALL get_variable( id_faero, 'aerosol_emission_values', pm_emission, &
8152	nxl, nxr, nys, nyn, 0, ncat-1 )
8153	DO ni = 1, SIZE( eci )
8154	n = eci(ni)
8155	!
8156	!-- Calculate the number concentration of a log-normal size
8157	!-- distribution following Jacobson (2005): Eq 13.25.
8158	ntot_table = 6.0_wp * PMfrac_table(:,n) / ( pi * dpg_table*3 &
8159	EXP( 4.5_wp * LOG( sigmag_table )*2 ) ) 1.0E+12_wp
8160	!
8161	!-- Sectional size distibution from a log-normal one
8162	CALL size_distribution( ntot_table, dpg_table, sigmag_table, &
8163	nsect_emission )
8164	DO b = 1, nbins
8165	aerosol_number(b)%source(ni,:,:) = &
8166	aerosol_number(b)%source(ni,:,:) + &
8167	pm_emission(ni,:,:) * conversion_factor(n) &
8168	* nsect_emission(b)
8169	ENDDO
8170	ENDDO
8171	ELSEIF ( lod_aero == 2 ) THEN
8172	!
8173	!-- Read surface emission data (x,y) PE-wise
8174	ALLOCATE( dum_var_4d(nb_file,ncat,nys:nyn,nxl:nxr) )
8175	CALL get_variable( id_faero, 'aerosol_emission_values', dum_var_4d, &
8176	nxl, nxr, nys, nyn, 0, ncat-1, 0, nb_file-1 )
8177	DO b = 1, nbins
8178	aerosol_number(b)%source = dum_var_4d(b,:,:,:)
8179	ENDDO
8180	DEALLOCATE( dum_var_4d )
8181	ENDIF
8182	!
8183	!-- Set surface fluxes of aerosol number and mass on horizontal surfaces.
8184	!-- Set fluxes only for either default, land or urban surface.
8185	IF ( .NOT. land_surface .AND. .NOT. urban_surface ) THEN
8186	CALL set_flux( surf_def_h(0), ncat )
8187	ELSE
8188	CALL set_flux( surf_usm_h, ncat )
8189	CALL set_flux( surf_lsm_h, ncat )
8190	ENDIF
8191
8192	ELSEIF ( lod_aero == 3 ) THEN
8193	!
8194	!-- Inquire aerosol emission rate per bin (#/(m3s))
8195	nc_stat = NF90_INQ_VARID( id_faero, "aerosol_emission_values", id_sa )
8196
8197	!
8198	!-- Emission time step
8199	CALL netcdf_data_input_get_dimension_length( id_faero, n_dt, 'dt_emission' )
8200	IF ( n_dt > 1 ) THEN
8201	CALL location_message( ' salsa_set_source: hourly emission data'//&
8202	' provided but currently the value of the '// &
8203	' first hour is applied.', .TRUE. )
8204	ENDIF
8205	!
8206	!-- Allocate source arrays
8207	DO b = 1, nbins
8208	ALLOCATE( aerosol_number(b)%source(nzb:nzt+1,nys:nyn,nxl:nxr) )
8209	aerosol_number(b)%source = 0.0_wp
8210	ENDDO
8211	DO c = 1, ncc_tot*nbins
8212	ALLOCATE( aerosol_mass(c)%source(nzb:nzt+1,nys:nyn,nxl:nxr) )
8213	aerosol_mass(c)%source = 0.0_wp
8214	ENDDO
8215	!
8216	!-- Get dimension of z-axis:
8217	CALL netcdf_data_input_get_dimension_length( id_faero, nz_file, 'z' )
8218	!
8219	!-- Read surface emission data (x,y) PE-wise
8220	DO i = nxl, nxr
8221	DO j = nys, nyn
8222	DO k = 0, nz_file-1
8223	!
8224	!-- Predetermine flag to mask topography
8225	flag = MERGE( 1.0_wp, 0.0_wp, BTEST(wall_flags_0(k,j,i), 0 ))
8226	!
8227	!-- No sources inside buildings !
8228	IF ( flag == 0.0_wp ) CYCLE
8229	!
8230	!-- Read volume source:
8231	nc_stat = NF90_GET_VAR( id_faero, id_sa, source_ijka, &
8232	start = (/ i+1, j+1, k+1, 1, 1 /), &
8233	count = (/ 1, 1, 1, 1, nb_file /) )
8234	IF ( nc_stat /= NF90_NOERR ) THEN
8235	message_string = 'error in aerosol emissions: lod3'
8236	CALL message( 'salsa_mod: salsa_set_source','SA0038', 1, 2, &
8237	0, 6, 0 )
8238	ENDIF
8239	!
8240	!-- Set mass fluxes. First bins include only SO4 and/or OC. Call
8241	!-- subroutine set_mass_source for larger bins.
8242	!
8243	!-- Sulphate and organic carbon
8244	IF ( iso4 > 0 .AND. ioc > 0 ) THEN
8245	!-- First sulphate:
8246	ss = ( iso4 - 1 ) * nbins + in1a ! start
8247	ee = ( iso4 - 1 ) * nbins + fn1a ! end
8248	b = in1a
8249	DO c = ss, ee
8250	IF ( source_ijka(b) /= fillval ) &
8251	aerosol_mass(c)%source(k,j,i) = &
8252	aerosol_mass(c)%source(k,j,i) + &
8253	emission_mass_fracs(1,1) / ( emission_mass_fracs(1,1) &
8254	+ emission_mass_fracs(1,2) ) * source_ijka(b) * &
8255	aero(b)%core * arhoh2so4
8256	b = b+1
8257	ENDDO
8258	!-- Then organic carbon:
8259	ss = ( ioc - 1 ) * nbins + in1a ! start
8260	ee = ( ioc - 1 ) * nbins + fn1a ! end
8261	b = in1a
8262	DO c = ss, ee
8263	IF ( source_ijka(b) /= fillval ) &
8264	aerosol_mass(c)%source(k,j,i) = &
8265	aerosol_mass(c)%source(k,j,i) + &
8266	emission_mass_fracs(1,2) / ( emission_mass_fracs(1,1) &
8267	+ emission_mass_fracs(1,2) ) * source_ijka(b) * &
8268	aero(b)%core * arhooc
8269	b = b+1
8270	ENDDO
8271
8272	CALL set_mass_source( k, j, i, iso4, &
8273	emission_mass_fracs(1,1), arhoh2so4, &
8274	source_ijka, fillval )
8275	CALL set_mass_source( k, j, i, ioc, emission_mass_fracs(1,2),&
8276	arhooc, source_ijka, fillval )
8277	!-- Only sulphate:
8278	ELSEIF ( iso4 > 0 .AND. ioc < 0 ) THEN
8279	ss = ( iso4 - 1 ) * nbins + in1a ! start
8280	ee = ( iso4 - 1 ) * nbins + fn1a ! end
8281	b = in1a
8282	DO c = ss, ee
8283	IF ( source_ijka(b) /= fillval ) &
8284	aerosol_mass(c)%source(k,j,i) = &
8285	aerosol_mass(c)%source(k,j,i) + source_ijka(b) * &
8286	aero(b)%core * arhoh2so4
8287	b = b+1
8288	ENDDO
8289	CALL set_mass_source( k, j, i, iso4, &
8290	emission_mass_fracs(1,1), arhoh2so4, &
8291	source_ijka, fillval )
8292	!-- Only organic carbon:
8293	ELSEIF ( iso4 < 0 .AND. ioc > 0 ) THEN
8294	ss = ( ioc - 1 ) * nbins + in1a ! start
8295	ee = ( ioc - 1 ) * nbins + fn1a ! end
8296	b = in1a
8297	DO c = ss, ee
8298	IF ( source_ijka(b) /= fillval ) &
8299	aerosol_mass(c)%source(k,j,i) = &
8300	aerosol_mass(c)%source(k,j,i) + source_ijka(b) * &
8301	aero(b)%core * arhooc
8302	b = b+1
8303	ENDDO
8304	CALL set_mass_source( k, j, i, ioc, emission_mass_fracs(1,2),&
8305	arhooc, source_ijka, fillval )
8306	ENDIF
8307	!-- Black carbon
8308	IF ( ibc > 0 ) THEN
8309	CALL set_mass_source( k, j, i, ibc, emission_mass_fracs(1,3),&
8310	arhobc, source_ijka, fillval )
8311	ENDIF
8312	!-- Dust
8313	IF ( idu > 0 ) THEN
8314	CALL set_mass_source( k, j, i, idu, emission_mass_fracs(1,4),&
8315	arhodu, source_ijka, fillval )
8316	ENDIF
8317	!-- Sea salt
8318	IF ( iss > 0 ) THEN
8319	CALL set_mass_source( k, j, i, iss, emission_mass_fracs(1,5),&
8320	arhoss, source_ijka, fillval )
8321	ENDIF
8322	!-- Nitric acid
8323	IF ( ino > 0 ) THEN
8324	CALL set_mass_source( k, j, i, ino, emission_mass_fracs(1,6),&
8325	arhohno3, source_ijka, fillval )
8326	ENDIF
8327	!-- Ammonia
8328	IF ( inh > 0 ) THEN
8329	CALL set_mass_source( k, j, i, inh, emission_mass_fracs(1,7),&
8330	arhonh3, source_ijka, fillval )
8331	ENDIF
8332	!
8333	!-- Save aerosol number sources in the end
8334	DO b = 1, nbins
8335	IF ( source_ijka(b) /= fillval ) &
8336	aerosol_number(b)%source(k,j,i) = &
8337	aerosol_number(b)%source(k,j,i) + source_ijka(b)
8338	ENDDO
8339	ENDDO ! k
8340	ENDDO ! j
8341	ENDDO ! i
8342
8343	ELSE
8344	message_string = 'NetCDF attribute lod is not set properly.'
8345	CALL message( 'salsa_mod: salsa_set_source','SA0026', 1, 2, 0, 6, 0 )
8346	ENDIF
8347
8348	#endif
8349	END SUBROUTINE salsa_set_source
8350
8351	!------------------------------------------------------------------------------!
8352	! Description:
8353	! ------------
8354	!> Sets the gaseous fluxes
8355	!------------------------------------------------------------------------------!
8356	SUBROUTINE set_gas_flux( surface, ncat_emission, unit )
8357
8358	USE arrays_3d, &
8359	ONLY: dzw, hyp, pt, rho_air_zw
8360
8361	USE grid_variables, &
8362	ONLY: dx, dy
8363
8364	USE surface_mod, &
8365	ONLY: surf_type
8366
8367	IMPLICIT NONE
8368
8369	CHARACTER(LEN=*) :: unit !< flux unit in the input file
8370	INTEGER(iwp) :: ncat_emission !< number of emission categories
8371	TYPE(surf_type), INTENT(inout) :: surface !< respective surface type
8372	INTEGER(iwp) :: g !< loop index
8373	INTEGER(iwp) :: i !< loop index
8374	INTEGER(iwp) :: j !< loop index
8375	INTEGER(iwp) :: k !< loop index
8376	INTEGER(iwp) :: m !< running index for surface elements
8377	INTEGER(iwp) :: n !< running index for emission categories
8378	REAL(wp), DIMENSION(ngast) :: conversion_factor
8379
8380	conversion_factor = 1.0_wp
8381
8382	DO m = 1, surface%ns
8383	!
8384	!-- Get indices of respective grid point
8385	i = surface%i(m)
8386	j = surface%j(m)
8387	k = surface%k(m)
8388
8389	IF ( unit == '#/m2/s' ) THEN
8390	conversion_factor = 1.0_wp
8391	ELSEIF ( unit == 'g/m2/s' ) THEN
8392	conversion_factor(1) = avo / ( amh2so4 * 1000.0_wp )
8393	conversion_factor(2) = avo / ( amhno3 * 1000.0_wp )
8394	conversion_factor(3) = avo / ( amnh3 * 1000.0_wp )
8395	conversion_factor(4) = avo / ( amoc * 1000.0_wp )
8396	conversion_factor(5) = avo / ( amoc * 1000.0_wp )
8397	ELSEIF ( unit == 'ppm/m2/s' ) THEN
8398	conversion_factor = for_ppm_to_nconc * hyp(k) / pt(k,j,i) * ( hyp(k) &
8399	/ 100000.0_wp )*0.286_wp dx * dy * dzw(k)
8400	ELSEIF ( unit == 'mumol/m2/s' ) THEN
8401	conversion_factor = 1.0E-6_wp * avo
8402	ELSE
8403	message_string = 'Unknown unit for gaseous emissions!'
8404	CALL message( 'salsa_mod: set_gas_flux', 'SA0031', 1, 2, 0, 6, 0 )
8405	ENDIF
8406
8407	DO n = 1, ncat_emission
8408	DO g = 1, ngast
8409	IF ( .NOT. salsa_gas(g)%source(n,j,i) > 0.0_wp ) THEN
8410	salsa_gas(g)%source(n,j,i) = 0.0_wp
8411	CYCLE
8412	ENDIF
8413	surface%gtsws(m,g) = surface%gtsws(m,g) + &
8414	salsa_gas(g)%source(n,j,i) * rho_air_zw(k-1) &
8415	* conversion_factor(g)
8416	ENDDO
8417	ENDDO
8418	ENDDO
8419
8420	END SUBROUTINE set_gas_flux
8421
8422
8423	!------------------------------------------------------------------------------!
8424	! Description:
8425	! ------------
8426	!> Sets the aerosol flux to aerosol arrays in 2a and 2b.
8427	!------------------------------------------------------------------------------!
8428	SUBROUTINE set_flux( surface, ncat_emission )
8429
8430	USE arrays_3d, &
8431	ONLY: hyp, pt, rho_air_zw
8432
8433	USE surface_mod, &
8434	ONLY: surf_type
8435
8436	IMPLICIT NONE
8437
8438	INTEGER(iwp) :: ncat_emission !< number of emission categories
8439	TYPE(surf_type), INTENT(inout) :: surface !< respective surface type
8440	INTEGER(iwp) :: b !< loop index
8441	INTEGER(iwp) :: ee !< loop index
8442	INTEGER(iwp) :: g !< loop index
8443	INTEGER(iwp) :: i !< loop index
8444	INTEGER(iwp) :: j !< loop index
8445	INTEGER(iwp) :: k !< loop index
8446	INTEGER(iwp) :: m !< running index for surface elements
8447	INTEGER(iwp) :: n !< loop index for emission categories
8448	INTEGER(iwp) :: c !< loop index
8449	INTEGER(iwp) :: ss !< loop index
8450
8451	DO m = 1, surface%ns
8452	!
8453	!-- Get indices of respective grid point
8454	i = surface%i(m)
8455	j = surface%j(m)
8456	k = surface%k(m)
8457
8458	DO n = 1, ncat_emission
8459	DO b = 1, nbins
8460	IF ( aerosol_number(b)%source(n,j,i) < 0.0_wp ) THEN
8461	aerosol_number(b)%source(n,j,i) = 0.0_wp
8462	CYCLE
8463	ENDIF
8464	!
8465	!-- Set mass fluxes. First bins include only SO4 and/or OC.
8466
8467	IF ( b <= fn1a ) THEN
8468	!
8469	!-- Both sulphate and organic carbon
8470	IF ( iso4 > 0 .AND. ioc > 0 ) THEN
8471
8472	c = ( iso4 - 1 ) * nbins + b
8473	surface%amsws(m,c) = surface%amsws(m,c) + &
8474	emission_mass_fracs(n,1) / &
8475	( emission_mass_fracs(n,1) + &
8476	emission_mass_fracs(n,2) ) * &
8477	aerosol_number(b)%source(n,j,i) * &
8478	api6 * aero(b)%dmid*3.0_wp &
8479	arhoh2so4 * rho_air_zw(k-1)
8480	aerosol_mass(c)%source(n,j,i) = &
8481	aerosol_mass(c)%source(n,j,i) + surface%amsws(m,c)
8482	c = ( ioc - 1 ) * nbins + b
8483	surface%amsws(m,c) = surface%amsws(m,c) + &
8484	emission_mass_fracs(n,2) / &
8485	( emission_mass_fracs(n,1) + &
8486	emission_mass_fracs(n,2) ) * &
8487	aerosol_number(b)%source(n,j,i) * &
8488	api6 * aero(b)%dmid*3.0_wp arhooc &
8489	* rho_air_zw(k-1)
8490	aerosol_mass(c)%source(n,j,i) = &
8491	aerosol_mass(c)%source(n,j,i) + surface%amsws(m,c)
8492	!
8493	!-- Only sulphates
8494	ELSEIF ( iso4 > 0 .AND. ioc < 0 ) THEN
8495	c = ( iso4 - 1 ) * nbins + b
8496	surface%amsws(m,c) = surface%amsws(m,c) + &
8497	aerosol_number(b)%source(n,j,i) * api6 &
8498	* aero(b)%dmid*3.0_wp arhoh2so4 &
8499	* rho_air_zw(k-1)
8500	aerosol_mass(c)%source(n,j,i) = &
8501	aerosol_mass(c)%source(n,j,i) + surface%amsws(m,c)
8502	!
8503	!-- Only organic carbon
8504	ELSEIF ( iso4 < 0 .AND. ioc > 0 ) THEN
8505	c = ( ioc - 1 ) * nbins + b
8506	surface%amsws(m,c) = surface%amsws(m,c) + &
8507	aerosol_number(b)%source(n,j,i) * api6 &
8508	* aero(b)%dmid*3.0_wp arhooc &
8509	* rho_air_zw(k-1)
8510	aerosol_mass(c)%source(n,j,i) = &
8511	aerosol_mass(c)%source(n,j,i) + surface%amsws(m,c)
8512	ENDIF
8513
8514	ELSEIF ( b > fn1a ) THEN
8515	!
8516	!-- Sulphate
8517	IF ( iso4 > 0 ) THEN
8518	CALL set_mass_flux( surface, m, b, iso4, n, &
8519	emission_mass_fracs(n,1), arhoh2so4, &
8520	aerosol_number(b)%source(n,j,i) )
8521	ENDIF
8522	!
8523	!-- Organic carbon
8524	IF ( ioc > 0 ) THEN
8525	CALL set_mass_flux( surface, m, b, ioc, n, &
8526	emission_mass_fracs(n,2), arhooc, &
8527	aerosol_number(b)%source(n,j,i) )
8528	ENDIF
8529	!
8530	!-- Black carbon
8531	IF ( ibc > 0 ) THEN
8532	CALL set_mass_flux( surface, m, b, ibc, n, &
8533	emission_mass_fracs(n,3), arhobc, &
8534	aerosol_number(b)%source(n,j,i) )
8535	ENDIF
8536	!
8537	!-- Dust
8538	IF ( idu > 0 ) THEN
8539	CALL set_mass_flux( surface, m, b, idu, n, &
8540	emission_mass_fracs(n,4), arhodu, &
8541	aerosol_number(b)%source(n,j,i) )
8542	ENDIF
8543	!
8544	!-- Sea salt
8545	IF ( iss > 0 ) THEN
8546	CALL set_mass_flux( surface, m, b, iss, n, &
8547	emission_mass_fracs(n,5), arhoss, &
8548	aerosol_number(b)%source(n,j,i) )
8549	ENDIF
8550	!
8551	!-- Nitric acid
8552	IF ( ino > 0 ) THEN
8553	CALL set_mass_flux( surface, m, b, ino, n, &
8554	emission_mass_fracs(n,6), arhohno3, &
8555	aerosol_number(b)%source(n,j,i) )
8556	ENDIF
8557	!
8558	!-- Ammonia
8559	IF ( inh > 0 ) THEN
8560	CALL set_mass_flux( surface, m, b, inh, n, &
8561	emission_mass_fracs(n,7), arhonh3, &
8562	aerosol_number(b)%source(n,j,i) )
8563	ENDIF
8564
8565	ENDIF
8566	!
8567	!-- Save number fluxes in the end
8568	surface%answs(m,b) = surface%answs(m,b) + &
8569	aerosol_number(b)%source(n,j,i) * rho_air_zw(k-1)
8570	aerosol_number(b)%source(n,j,i) = surface%answs(m,b)
8571	ENDDO
8572
8573	ENDDO
8574
8575	ENDDO
8576
8577	END SUBROUTINE set_flux
8578
8579	!------------------------------------------------------------------------------!
8580	! Description:
8581	! ------------
8582	!> Sets the mass emissions to aerosol arrays in 2a and 2b.
8583	!------------------------------------------------------------------------------!
8584	SUBROUTINE set_mass_flux( surface, surf_num, b, ispec, n, mass_frac, prho, &
8585	nsource )
8586
8587	USE arrays_3d, &
8588	ONLY: rho_air_zw
8589
8590	USE surface_mod, &
8591	ONLY: surf_type
8592
8593	IMPLICIT NONE
8594
8595	INTEGER(iwp), INTENT(in) :: b !< Aerosol size bin index
8596	INTEGER(iwp), INTENT(in) :: ispec !< Aerosol species index
8597	INTEGER(iwp), INTENT(in) :: n !< emission category number
8598	INTEGER(iwp), INTENT(in) :: surf_num !< index surface elements
8599	REAL(wp), INTENT(in) :: mass_frac !< mass fraction of a chemical
8600	!< compound in all bins
8601	REAL(wp), INTENT(in) :: nsource !< number source (#/m2/s)
8602	REAL(wp), INTENT(in) :: prho !< Aerosol density
8603	TYPE(surf_type), INTENT(inout) :: surface !< respective surface type
8604
8605	INTEGER(iwp) :: ee !< index: end
8606	INTEGER(iwp) :: i !< loop index
8607	INTEGER(iwp) :: j !< loop index
8608	INTEGER(iwp) :: k !< loop index
8609	INTEGER(iwp) :: c !< loop index
8610	INTEGER(iwp) :: ss !<index: start
8611
8612	!
8613	!-- Get indices of respective grid point
8614	i = surface%i(surf_num)
8615	j = surface%j(surf_num)
8616	k = surface%k(surf_num)
8617	!
8618	!-- Subrange 2a:
8619	c = ( ispec - 1 ) * nbins + b
8620	surface%amsws(surf_num,c) = surface%amsws(surf_num,c) + mass_frac * nsource&
8621	* aero(b)%core * prho * rho_air_zw(k-1)
8622	aerosol_mass(c)%source(n,j,i) = aerosol_mass(c)%source(n,j,i) + &
8623	surface%amsws(surf_num,c)
8624	!
8625	!-- Subrange 2b:
8626	IF ( .NOT. no_insoluble ) THEN
8627	WRITE(,) 'All emissions are soluble!'
8628	ENDIF
8629
8630	END SUBROUTINE set_mass_flux
8631
8632	!------------------------------------------------------------------------------!
8633	! Description:
8634	! ------------
8635	!> Sets the mass sources to aerosol arrays in 2a and 2b.
8636	!------------------------------------------------------------------------------!
8637	SUBROUTINE set_mass_source( k, j, i, ispec, mass_frac, prho, nsource, fillval )
8638
8639	USE surface_mod, &
8640	ONLY: surf_type
8641
8642	IMPLICIT NONE
8643
8644	INTEGER(iwp), INTENT(in) :: ispec !< Aerosol species index
8645	REAL(wp), INTENT(in) :: fillval !< _FillValue in the NetCDF file
8646	REAL(wp), INTENT(in) :: mass_frac !< mass fraction of a chemical
8647	!< compound in all bins
8648	REAL(wp), INTENT(in), DIMENSION(:) :: nsource !< number source
8649	REAL(wp), INTENT(in) :: prho !< Aerosol density
8650
8651	INTEGER(iwp) :: b !< loop index
8652	INTEGER(iwp) :: ee !< index: end
8653	INTEGER(iwp) :: i !< loop index
8654	INTEGER(iwp) :: j !< loop index
8655	INTEGER(iwp) :: k !< loop index
8656	INTEGER(iwp) :: c !< loop index
8657	INTEGER(iwp) :: ss !<index: start
8658	!
8659	!-- Subrange 2a:
8660	ss = ( ispec - 1 ) * nbins + in2a
8661	ee = ( ispec - 1 ) * nbins + fn2a
8662	b = in2a
8663	DO c = ss, ee
8664	IF ( nsource(b) /= fillval ) THEN
8665	aerosol_mass(c)%source(k,j,i) = aerosol_mass(c)%source(k,j,i) + &
8666	mass_frac * nsource(b) * aero(b)%core * &
8667	prho
8668	ENDIF
8669	b = b+1
8670	ENDDO
8671	!
8672	!-- Subrange 2b:
8673	IF ( .NOT. no_insoluble ) THEN
8674	WRITE(,) 'All sources are soluble!'
8675	ENDIF
8676
8677	END SUBROUTINE set_mass_source
8678
8679	!------------------------------------------------------------------------------!
8680	! Description:
8681	! ------------
8682	!> Check data output for salsa.
8683	!------------------------------------------------------------------------------!
8684	SUBROUTINE salsa_check_data_output( var, unit )
8685
8686	USE control_parameters, &
8687	ONLY: message_string
8688
8689	IMPLICIT NONE
8690
8691	CHARACTER (LEN=*) :: unit !<
8692	CHARACTER (LEN=*) :: var !<
8693
8694	SELECT CASE ( TRIM( var ) )
8695
8696	CASE ( 'g_H2SO4', 'g_HNO3', 'g_NH3', 'g_OCNV', 'g_OCSV', &
8697	'N_bin1', 'N_bin2', 'N_bin3', 'N_bin4', 'N_bin5', 'N_bin6', &
8698	'N_bin7', 'N_bin8', 'N_bin9', 'N_bin10', 'N_bin11', 'N_bin12', &
8699	'Ntot' )
8700	IF ( .NOT. salsa ) THEN
8701	message_string = 'output of "' // TRIM( var ) // '" requi' // &
8702	'res salsa = .TRUE.'
8703	CALL message( 'check_parameters', 'SA0006', 1, 2, 0, 6, 0 )
8704	ENDIF
8705	unit = '#/m3'
8706
8707	CASE ( 'LDSA' )
8708	IF ( .NOT. salsa ) THEN
8709	message_string = 'output of "' // TRIM( var ) // '" requi' // &
8710	'res salsa = .TRUE.'
8711	CALL message( 'check_parameters', 'SA0003', 1, 2, 0, 6, 0 )
8712	ENDIF
8713	unit = 'mum2/cm3'
8714
8715	CASE ( 'm_bin1', 'm_bin2', 'm_bin3', 'm_bin4', 'm_bin5', 'm_bin6', &
8716	'm_bin7', 'm_bin8', 'm_bin9', 'm_bin10', 'm_bin11', 'm_bin12', &
8717	'PM2.5', 'PM10', 's_BC', 's_DU', 's_H2O', 's_NH', &
8718	's_NO', 's_OC', 's_SO4', 's_SS' )
8719	IF ( .NOT. salsa ) THEN
8720	message_string = 'output of "' // TRIM( var ) // '" requi' // &
8721	'res salsa = .TRUE.'
8722	CALL message( 'check_parameters', 'SA0001', 1, 2, 0, 6, 0 )
8723	ENDIF
8724	unit = 'kg/m3'
8725
8726	CASE DEFAULT
8727	unit = 'illegal'
8728
8729	END SELECT
8730
8731	END SUBROUTINE salsa_check_data_output
8732
8733	!------------------------------------------------------------------------------!
8734	!
8735	! Description:
8736	! ------------
8737	!> Subroutine for averaging 3D data
8738	!------------------------------------------------------------------------------!
8739	SUBROUTINE salsa_3d_data_averaging( mode, variable )
8740
8741
8742	USE control_parameters
8743
8744	USE indices
8745
8746	USE kinds
8747
8748	IMPLICIT NONE
8749
8750	CHARACTER (LEN=*) :: mode !<
8751	CHARACTER (LEN=*) :: variable !<
8752
8753	INTEGER(iwp) :: b !<
8754	INTEGER(iwp) :: c !<
8755	INTEGER(iwp) :: i !<
8756	INTEGER(iwp) :: icc !<
8757	INTEGER(iwp) :: j !<
8758	INTEGER(iwp) :: k !<
8759
8760	REAL(wp) :: df !< For calculating LDSA: fraction of particles
8761	!< depositing in the alveolar (or tracheobronchial)
8762	!< region of the lung. Depends on the particle size
8763	REAL(wp) :: mean_d !< Particle diameter in micrometres
8764	REAL(wp) :: nc !< Particle number concentration in units 1/cm**3
8765	REAL(wp) :: temp_bin !<
8766	REAL(wp), DIMENSION(:,:,:), POINTER :: to_be_resorted !< points to
8767	!< selected output variable
8768
8769	temp_bin = 0.0_wp
8770
8771	IF ( mode == 'allocate' ) THEN
8772
8773	SELECT CASE ( TRIM( variable ) )
8774
8775	CASE ( 'g_H2SO4' )
8776	IF ( .NOT. ALLOCATED( g_H2SO4_av ) ) THEN
8777	ALLOCATE( g_H2SO4_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
8778	ENDIF
8779	g_H2SO4_av = 0.0_wp
8780
8781	CASE ( 'g_HNO3' )
8782	IF ( .NOT. ALLOCATED( g_HNO3_av ) ) THEN
8783	ALLOCATE( g_HNO3_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
8784	ENDIF
8785	g_HNO3_av = 0.0_wp
8786
8787	CASE ( 'g_NH3' )
8788	IF ( .NOT. ALLOCATED( g_NH3_av ) ) THEN
8789	ALLOCATE( g_NH3_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
8790	ENDIF
8791	g_NH3_av = 0.0_wp
8792
8793	CASE ( 'g_OCNV' )
8794	IF ( .NOT. ALLOCATED( g_OCNV_av ) ) THEN
8795	ALLOCATE( g_OCNV_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
8796	ENDIF
8797	g_OCNV_av = 0.0_wp
8798
8799	CASE ( 'g_OCSV' )
8800	IF ( .NOT. ALLOCATED( g_OCSV_av ) ) THEN
8801	ALLOCATE( g_OCSV_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
8802	ENDIF
8803	g_OCSV_av = 0.0_wp
8804
8805	CASE ( 'LDSA' )
8806	IF ( .NOT. ALLOCATED( LDSA_av ) ) THEN
8807	ALLOCATE( LDSA_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
8808	ENDIF
8809	LDSA_av = 0.0_wp
8810
8811	CASE ( 'N_bin1', 'N_bin2', 'N_bin3', 'N_bin4', 'N_bin5', 'N_bin6', &
8812	'N_bin7', 'N_bin8', 'N_bin9', 'N_bin10', 'N_bin11', 'N_bin12' )
8813	IF ( .NOT. ALLOCATED( Nbins_av ) ) THEN
8814	ALLOCATE( Nbins_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg,nbins) )
8815	ENDIF
8816	Nbins_av = 0.0_wp
8817
8818	CASE ( 'Ntot' )
8819	IF ( .NOT. ALLOCATED( Ntot_av ) ) THEN
8820	ALLOCATE( Ntot_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
8821	ENDIF
8822	Ntot_av = 0.0_wp
8823
8824	CASE ( 'm_bin1', 'm_bin2', 'm_bin3', 'm_bin4', 'm_bin5', 'm_bin6', &
8825	'm_bin7', 'm_bin8', 'm_bin9', 'm_bin10', 'm_bin11', 'm_bin12' )
8826	IF ( .NOT. ALLOCATED( mbins_av ) ) THEN
8827	ALLOCATE( mbins_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg,nbins) )
8828	ENDIF
8829	mbins_av = 0.0_wp
8830
8831	CASE ( 'PM2.5' )
8832	IF ( .NOT. ALLOCATED( PM25_av ) ) THEN
8833	ALLOCATE( PM25_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
8834	ENDIF
8835	PM25_av = 0.0_wp
8836
8837	CASE ( 'PM10' )
8838	IF ( .NOT. ALLOCATED( PM10_av ) ) THEN
8839	ALLOCATE( PM10_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
8840	ENDIF
8841	PM10_av = 0.0_wp
8842
8843	CASE ( 's_BC' )
8844	IF ( .NOT. ALLOCATED( s_BC_av ) ) THEN
8845	ALLOCATE( s_BC_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
8846	ENDIF
8847	s_BC_av = 0.0_wp
8848
8849	CASE ( 's_DU' )
8850	IF ( .NOT. ALLOCATED( s_DU_av ) ) THEN
8851	ALLOCATE( s_DU_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
8852	ENDIF
8853	s_DU_av = 0.0_wp
8854
8855	CASE ( 's_H2O' )
8856	IF ( .NOT. ALLOCATED( s_H2O_av ) ) THEN
8857	ALLOCATE( s_H2O_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
8858	ENDIF
8859	s_H2O_av = 0.0_wp
8860
8861	CASE ( 's_NH' )
8862	IF ( .NOT. ALLOCATED( s_NH_av ) ) THEN
8863	ALLOCATE( s_NH_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
8864	ENDIF
8865	s_NH_av = 0.0_wp
8866
8867	CASE ( 's_NO' )
8868	IF ( .NOT. ALLOCATED( s_NO_av ) ) THEN
8869	ALLOCATE( s_NO_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
8870	ENDIF
8871	s_NO_av = 0.0_wp
8872
8873	CASE ( 's_OC' )
8874	IF ( .NOT. ALLOCATED( s_OC_av ) ) THEN
8875	ALLOCATE( s_OC_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
8876	ENDIF
8877	s_OC_av = 0.0_wp
8878
8879	CASE ( 's_SO4' )
8880	IF ( .NOT. ALLOCATED( s_SO4_av ) ) THEN
8881	ALLOCATE( s_SO4_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
8882	ENDIF
8883	s_SO4_av = 0.0_wp
8884
8885	CASE ( 's_SS' )
8886	IF ( .NOT. ALLOCATED( s_SS_av ) ) THEN
8887	ALLOCATE( s_SS_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
8888	ENDIF
8889	s_SS_av = 0.0_wp
8890
8891	CASE DEFAULT
8892	CONTINUE
8893
8894	END SELECT
8895
8896	ELSEIF ( mode == 'sum' ) THEN
8897
8898	SELECT CASE ( TRIM( variable ) )
8899
8900	CASE ( 'g_H2SO4', 'g_HNO3', 'g_NH3', 'g_OCNV', 'g_OCSV' )
8901	IF ( TRIM( variable(3:) ) == 'H2SO4' ) THEN
8902	icc = 1
8903	to_be_resorted => g_H2SO4_av
8904	ELSEIF ( TRIM( variable(3:) ) == 'HNO3' ) THEN
8905	icc = 2
8906	to_be_resorted => g_HNO3_av
8907	ELSEIF ( TRIM( variable(3:) ) == 'NH3' ) THEN
8908	icc = 3
8909	to_be_resorted => g_NH3_av
8910	ELSEIF ( TRIM( variable(3:) ) == 'OCNV' ) THEN
8911	icc = 4
8912	to_be_resorted => g_OCNV_av
8913	ELSEIF ( TRIM( variable(3:) ) == 'OCSV' ) THEN
8914	icc = 5
8915	to_be_resorted => g_OCSV_av
8916	ENDIF
8917	DO i = nxlg, nxrg
8918	DO j = nysg, nyng
8919	DO k = nzb, nzt+1
8920	to_be_resorted(k,j,i) = to_be_resorted(k,j,i) + &
8921	salsa_gas(icc)%conc(k,j,i)
8922	ENDDO
8923	ENDDO
8924	ENDDO
8925
8926	CASE ( 'LDSA' )
8927	DO i = nxlg, nxrg
8928	DO j = nysg, nyng
8929	DO k = nzb, nzt+1
8930	temp_bin = 0.0_wp
8931	DO b = 1, nbins
8932	!
8933	!-- Diameter in micrometres
8934	mean_d = 1.0E+6_wp * Ra_dry(k,j,i,b) * 2.0_wp
8935	!
8936	!-- Deposition factor: alveolar (use Ra_dry)
8937	df = ( 0.01555_wp / mean_d ) * ( EXP( -0.416_wp * &
8938	( LOG( mean_d ) + 2.84_wp )**2.0_wp ) &
8939	+ 19.11_wp * EXP( -0.482_wp * &
8940	( LOG( mean_d ) - 1.362_wp )**2.0_wp ) )
8941	!
8942	!-- Number concentration in 1/cm3
8943	nc = 1.0E-6_wp * aerosol_number(b)%conc(k,j,i)
8944	!
8945	!-- Lung-deposited surface area LDSA (units mum2/cm3)
8946	temp_bin = temp_bin + pi * mean_d*2.0_wp df * nc
8947	ENDDO
8948	LDSA_av(k,j,i) = LDSA_av(k,j,i) + temp_bin
8949	ENDDO
8950	ENDDO
8951	ENDDO
8952
8953	CASE ( 'N_bin1', 'N_bin2', 'N_bin3', 'N_bin4', 'N_bin5', 'N_bin6', &
8954	'N_bin7', 'N_bin8', 'N_bin9', 'N_bin10', 'N_bin11', 'N_bin12' )
8955	DO i = nxlg, nxrg
8956	DO j = nysg, nyng
8957	DO k = nzb, nzt+1
8958	DO b = 1, nbins
8959	Nbins_av(k,j,i,b) = Nbins_av(k,j,i,b) + &
8960	aerosol_number(b)%conc(k,j,i)
8961	ENDDO
8962	ENDDO
8963	ENDDO
8964	ENDDO
8965
8966	CASE ( 'Ntot' )
8967	DO i = nxlg, nxrg
8968	DO j = nysg, nyng
8969	DO k = nzb, nzt+1
8970	DO b = 1, nbins
8971	Ntot_av(k,j,i) = Ntot_av(k,j,i) + &
8972	aerosol_number(b)%conc(k,j,i)
8973	ENDDO
8974	ENDDO
8975	ENDDO
8976	ENDDO
8977
8978	CASE ( 'm_bin1', 'm_bin2', 'm_bin3', 'm_bin4', 'm_bin5', 'm_bin6', &
8979	'm_bin7', 'm_bin8', 'm_bin9', 'm_bin10', 'm_bin11', 'm_bin12' )
8980	DO i = nxlg, nxrg
8981	DO j = nysg, nyng
8982	DO k = nzb, nzt+1
8983	DO b = 1, nbins
8984	DO c = b, nbins*ncc_tot, nbins
8985	mbins_av(k,j,i,b) = mbins_av(k,j,i,b) + &
8986	aerosol_mass(c)%conc(k,j,i)
8987	ENDDO
8988	ENDDO
8989	ENDDO
8990	ENDDO
8991	ENDDO
8992
8993	CASE ( 'PM2.5' )
8994	DO i = nxlg, nxrg
8995	DO j = nysg, nyng
8996	DO k = nzb, nzt+1
8997	temp_bin = 0.0_wp
8998	DO b = 1, nbins
8999	IF ( 2.0_wp * Ra_dry(k,j,i,b) <= 2.5E-6_wp ) THEN
9000	DO c = b, nbins*ncc, nbins
9001	temp_bin = temp_bin + aerosol_mass(c)%conc(k,j,i)
9002	ENDDO
9003	ENDIF
9004	ENDDO
9005	PM25_av(k,j,i) = PM25_av(k,j,i) + temp_bin
9006	ENDDO
9007	ENDDO
9008	ENDDO
9009
9010	CASE ( 'PM10' )
9011	DO i = nxlg, nxrg
9012	DO j = nysg, nyng
9013	DO k = nzb, nzt+1
9014	temp_bin = 0.0_wp
9015	DO b = 1, nbins
9016	IF ( 2.0_wp * Ra_dry(k,j,i,b) <= 10.0E-6_wp ) THEN
9017	DO c = b, nbins*ncc, nbins
9018	temp_bin = temp_bin + aerosol_mass(c)%conc(k,j,i)
9019	ENDDO
9020	ENDIF
9021	ENDDO
9022	PM10_av(k,j,i) = PM10_av(k,j,i) + temp_bin
9023	ENDDO
9024	ENDDO
9025	ENDDO
9026
9027	CASE ( 's_BC', 's_DU', 's_H2O', 's_NH', 's_NO', 's_OC', 's_SO4', &
9028	's_SS' )
9029	IF ( is_used( prtcl, TRIM( variable(3:) ) ) ) THEN
9030	icc = get_index( prtcl, TRIM( variable(3:) ) )
9031	IF ( TRIM( variable(3:) ) == 'BC' ) to_be_resorted => s_BC_av
9032	IF ( TRIM( variable(3:) ) == 'DU' ) to_be_resorted => s_DU_av
9033	IF ( TRIM( variable(3:) ) == 'NH' ) to_be_resorted => s_NH_av
9034	IF ( TRIM( variable(3:) ) == 'NO' ) to_be_resorted => s_NO_av
9035	IF ( TRIM( variable(3:) ) == 'OC' ) to_be_resorted => s_OC_av
9036	IF ( TRIM( variable(3:) ) == 'SO4' ) to_be_resorted => s_SO4_av
9037	IF ( TRIM( variable(3:) ) == 'SS' ) to_be_resorted => s_SS_av
9038	DO i = nxlg, nxrg
9039	DO j = nysg, nyng
9040	DO k = nzb, nzt+1
9041	DO c = ( icc-1 )nbins+1, iccnbins
9042	to_be_resorted(k,j,i) = to_be_resorted(k,j,i) + &
9043	aerosol_mass(c)%conc(k,j,i)
9044	ENDDO
9045	ENDDO
9046	ENDDO
9047	ENDDO
9048	ENDIF
9049
9050	CASE DEFAULT
9051	CONTINUE
9052
9053	END SELECT
9054
9055	ELSEIF ( mode == 'average' ) THEN
9056
9057	SELECT CASE ( TRIM( variable ) )
9058
9059	CASE ( 'g_H2SO4', 'g_HNO3', 'g_NH3', 'g_OCNV', 'g_OCSV' )
9060	IF ( TRIM( variable(3:) ) == 'H2SO4' ) THEN
9061	icc = 1
9062	to_be_resorted => g_H2SO4_av
9063	ELSEIF ( TRIM( variable(3:) ) == 'HNO3' ) THEN
9064	icc = 2
9065	to_be_resorted => g_HNO3_av
9066	ELSEIF ( TRIM( variable(3:) ) == 'NH3' ) THEN
9067	icc = 3
9068	to_be_resorted => g_NH3_av
9069	ELSEIF ( TRIM( variable(3:) ) == 'OCNV' ) THEN
9070	icc = 4
9071	to_be_resorted => g_OCNV_av
9072	ELSEIF ( TRIM( variable(3:) ) == 'OCSV' ) THEN
9073	icc = 5
9074	to_be_resorted => g_OCSV_av
9075	ENDIF
9076	DO i = nxlg, nxrg
9077	DO j = nysg, nyng
9078	DO k = nzb, nzt+1
9079	to_be_resorted(k,j,i) = to_be_resorted(k,j,i) &
9080	/ REAL( average_count_3d, KIND=wp )
9081	ENDDO
9082	ENDDO
9083	ENDDO
9084
9085	CASE ( 'LDSA' )
9086	DO i = nxlg, nxrg
9087	DO j = nysg, nyng
9088	DO k = nzb, nzt+1
9089	LDSA_av(k,j,i) = LDSA_av(k,j,i) &
9090	/ REAL( average_count_3d, KIND=wp )
9091	ENDDO
9092	ENDDO
9093	ENDDO
9094
9095	CASE ( 'N_bin1', 'N_bin2', 'N_bin3', 'N_bin4', 'N_bin5', 'N_bin6', &
9096	'N_bin7', 'N_bin8', 'N_bin9', 'N_bin10', 'N_bin11', 'N_bin12' )
9097	DO i = nxlg, nxrg
9098	DO j = nysg, nyng
9099	DO k = nzb, nzt+1
9100	DO b = 1, nbins
9101	Nbins_av(k,j,i,b) = Nbins_av(k,j,i,b) &
9102	/ REAL( average_count_3d, KIND=wp )
9103	ENDDO
9104	ENDDO
9105	ENDDO
9106	ENDDO
9107
9108	CASE ( 'Ntot' )
9109	DO i = nxlg, nxrg
9110	DO j = nysg, nyng
9111	DO k = nzb, nzt+1
9112	Ntot_av(k,j,i) = Ntot_av(k,j,i) &
9113	/ REAL( average_count_3d, KIND=wp )
9114	ENDDO
9115	ENDDO
9116	ENDDO
9117
9118	CASE ( 'm_bin1', 'm_bin2', 'm_bin3', 'm_bin4', 'm_bin5', 'm_bin6', &
9119	'm_bin7', 'm_bin8', 'm_bin9', 'm_bin10', 'm_bin11', 'm_bin12' )
9120	DO i = nxlg, nxrg
9121	DO j = nysg, nyng
9122	DO k = nzb, nzt+1
9123	DO b = 1, nbins
9124	DO c = b, nbins*ncc, nbins
9125	mbins_av(k,j,i,b) = mbins_av(k,j,i,b) &
9126	/ REAL( average_count_3d, KIND=wp )
9127	ENDDO
9128	ENDDO
9129	ENDDO
9130	ENDDO
9131	ENDDO
9132
9133	CASE ( 'PM2.5' )
9134	DO i = nxlg, nxrg
9135	DO j = nysg, nyng
9136	DO k = nzb, nzt+1
9137	PM25_av(k,j,i) = PM25_av(k,j,i) &
9138	/ REAL( average_count_3d, KIND=wp )
9139	ENDDO
9140	ENDDO
9141	ENDDO
9142
9143	CASE ( 'PM10' )
9144	DO i = nxlg, nxrg
9145	DO j = nysg, nyng
9146	DO k = nzb, nzt+1
9147	PM10_av(k,j,i) = PM10_av(k,j,i) &
9148	/ REAL( average_count_3d, KIND=wp )
9149	ENDDO
9150	ENDDO
9151	ENDDO
9152
9153	CASE ( 's_BC', 's_DU', 's_H2O', 's_NH', 's_NO', 's_OC', 's_SO4', &
9154	's_SS' )
9155	IF ( is_used( prtcl, TRIM( variable(3:) ) ) ) THEN
9156	icc = get_index( prtcl, TRIM( variable(3:) ) )
9157	IF ( TRIM( variable(3:) ) == 'BC' ) to_be_resorted => s_BC_av
9158	IF ( TRIM( variable(3:) ) == 'DU' ) to_be_resorted => s_DU_av
9159	IF ( TRIM( variable(3:) ) == 'NH' ) to_be_resorted => s_NH_av
9160	IF ( TRIM( variable(3:) ) == 'NO' ) to_be_resorted => s_NO_av
9161	IF ( TRIM( variable(3:) ) == 'OC' ) to_be_resorted => s_OC_av
9162	IF ( TRIM( variable(3:) ) == 'SO4' ) to_be_resorted => s_SO4_av
9163	IF ( TRIM( variable(3:) ) == 'SS' ) to_be_resorted => s_SS_av
9164	DO i = nxlg, nxrg
9165	DO j = nysg, nyng
9166	DO k = nzb, nzt+1
9167	to_be_resorted(k,j,i) = to_be_resorted(k,j,i) &
9168	/ REAL( average_count_3d, KIND=wp )
9169	ENDDO
9170	ENDDO
9171	ENDDO
9172	ENDIF
9173
9174	END SELECT
9175
9176	ENDIF
9177
9178	END SUBROUTINE salsa_3d_data_averaging
9179
9180
9181	!------------------------------------------------------------------------------!
9182	!
9183	! Description:
9184	! ------------
9185	!> Subroutine defining 2D output variables
9186	!------------------------------------------------------------------------------!
9187	SUBROUTINE salsa_data_output_2d( av, variable, found, grid, mode, &
9188	local_pf, two_d )
9189
9190	USE indices
9191
9192	USE kinds
9193
9194	IMPLICIT NONE
9195
9196	CHARACTER (LEN=*) :: grid !<
9197	CHARACTER (LEN=*) :: mode !<
9198	CHARACTER (LEN=*) :: variable !<
9199	CHARACTER (LEN=5) :: vari !< trimmed format of variable
9200
9201	INTEGER(iwp) :: av !<
9202	INTEGER(iwp) :: b !<
9203	INTEGER(iwp) :: c !<
9204	INTEGER(iwp) :: i !<
9205	INTEGER(iwp) :: icc !< index of a chemical compound
9206	INTEGER(iwp) :: j !<
9207	INTEGER(iwp) :: k !<
9208
9209	LOGICAL :: found !<
9210	LOGICAL :: two_d !< flag parameter that indicates 2D variables
9211	!< (horizontal cross sections)
9212
9213	REAL(wp) :: df !< For calculating LDSA: fraction of particles
9214	!< depositing in the alveolar (or tracheobronchial)
9215	!< region of the lung. Depends on the particle size
9216	REAL(wp) :: mean_d !< Particle diameter in micrometres
9217	REAL(wp) :: nc !< Particle number concentration in units 1/cm**3
9218	REAL(wp), DIMENSION(nxl:nxr,nys:nyn,nzb:nzt+1) :: local_pf !< local
9219	!< array to which output data is resorted to
9220	REAL(wp) :: temp_bin !<
9221	REAL(wp), DIMENSION(:,:,:), POINTER :: to_be_resorted !< points to
9222	!< selected output variable
9223
9224	found = .TRUE.
9225	temp_bin = 0.0_wp
9226
9227	IF ( TRIM( variable(1:2) ) == 'g_' ) THEN
9228	vari = TRIM( variable( 3:LEN( TRIM( variable ) ) - 3 ) )
9229	IF ( av == 0 ) THEN
9230	IF ( vari == 'H2SO4') icc = 1
9231	IF ( vari == 'HNO3') icc = 2
9232	IF ( vari == 'NH3') icc = 3
9233	IF ( vari == 'OCNV') icc = 4
9234	IF ( vari == 'OCSV') icc = 5
9235	DO i = nxl, nxr
9236	DO j = nys, nyn
9237	DO k = nzb, nzt+1
9238	local_pf(i,j,k) = MERGE( salsa_gas(icc)%conc(k,j,i), &
9239	REAL( -999.0_wp, KIND = wp ), &
9240	BTEST( wall_flags_0(k,j,i), 0 ) )
9241	ENDDO
9242	ENDDO
9243	ENDDO
9244	ELSE
9245	IF ( vari == 'H2SO4' ) to_be_resorted => g_H2SO4_av
9246	IF ( vari == 'HNO3' ) to_be_resorted => g_HNO3_av
9247	IF ( vari == 'NH3' ) to_be_resorted => g_NH3_av
9248	IF ( vari == 'OCNV' ) to_be_resorted => g_OCNV_av
9249	IF ( vari == 'OCSV' ) to_be_resorted => g_OCSV_av
9250	DO i = nxl, nxr
9251	DO j = nys, nyn
9252	DO k = nzb, nzt+1
9253	local_pf(i,j,k) = MERGE( to_be_resorted(k,j,i), &
9254	REAL( -999.0_wp, KIND = wp ), &
9255	BTEST( wall_flags_0(k,j,i), 0 ) )
9256	ENDDO
9257	ENDDO
9258	ENDDO
9259	ENDIF
9260
9261	IF ( mode == 'xy' ) grid = 'zu'
9262
9263	ELSEIF ( TRIM( variable(1:4) ) == 'LDSA' ) THEN
9264	IF ( av == 0 ) THEN
9265	DO i = nxl, nxr
9266	DO j = nys, nyn
9267	DO k = nzb, nzt+1
9268	temp_bin = 0.0_wp
9269	DO b = 1, nbins
9270	!
9271	!-- Diameter in micrometres
9272	mean_d = 1.0E+6_wp * Ra_dry(k,j,i,b) * 2.0_wp
9273	!
9274	!-- Deposition factor: alveolar
9275	df = ( 0.01555_wp / mean_d ) * ( EXP( -0.416_wp * ( LOG( &
9276	mean_d ) + 2.84_wp )*2.0_wp ) + 19.11_wp EXP( &
9277	-0.482_wp * ( LOG( mean_d ) - 1.362_wp )**2.0_wp ) )
9278	!
9279	!-- Number concentration in 1/cm3
9280	nc = 1.0E-6_wp * aerosol_number(b)%conc(k,j,i)
9281	!
9282	!-- Lung-deposited surface area LDSA (units mum2/cm3)
9283	temp_bin = temp_bin + pi * mean_d*2.0_wp df * nc
9284	ENDDO
9285	local_pf(i,j,k) = MERGE( temp_bin, REAL( -999.0_wp, &
9286	KIND = wp ), BTEST( wall_flags_0(k,j,i), 0 ) )
9287	ENDDO
9288	ENDDO
9289	ENDDO
9290	ELSE
9291	DO i = nxl, nxr
9292	DO j = nys, nyn
9293	DO k = nzb, nzt+1
9294	local_pf(i,j,k) = MERGE( LDSA_av(k,j,i), REAL( -999.0_wp, &
9295	KIND = wp ), BTEST( wall_flags_0(k,j,i), 0 ) )
9296	ENDDO
9297	ENDDO
9298	ENDDO
9299	ENDIF
9300
9301	IF ( mode == 'xy' ) grid = 'zu'
9302
9303	ELSEIF ( TRIM( variable(1:6) ) == 'N_bin1' ) THEN
9304	IF ( av == 0 ) THEN
9305	DO i = nxl, nxr
9306	DO j = nys, nyn
9307	DO k = nzb, nzt+1
9308	local_pf(i,j,k) = MERGE( aerosol_number(1)%conc(k,j,i), &
9309	REAL( -999.0_wp, KIND = wp ), &
9310	BTEST( wall_flags_0(k,j,i), 0 ) )
9311	ENDDO
9312	ENDDO
9313	ENDDO
9314	ELSE
9315	DO i = nxl, nxr
9316	DO j = nys, nyn
9317	DO k = nzb, nzt+1
9318	local_pf(i,j,k) = MERGE( Nbins_av(k,j,i,1), &
9319	REAL( -999.0_wp, KIND = wp ), &
9320	BTEST( wall_flags_0(k,j,i), 0 ) )
9321	ENDDO
9322	ENDDO
9323	ENDDO
9324	ENDIF
9325
9326	ELSEIF ( TRIM( variable(1:6) ) == 'N_bin2' ) THEN
9327	IF ( av == 0 ) THEN
9328	DO i = nxl, nxr
9329	DO j = nys, nyn
9330	DO k = nzb, nzt+1
9331	local_pf(i,j,k) = MERGE( aerosol_number(2)%conc(k,j,i), &
9332	REAL( -999.0_wp, KIND = wp ), &
9333	BTEST( wall_flags_0(k,j,i), 0 ) )
9334	ENDDO
9335	ENDDO
9336	ENDDO
9337	ELSE
9338	DO i = nxl, nxr
9339	DO j = nys, nyn
9340	DO k = nzb, nzt+1
9341	local_pf(i,j,k) = MERGE( Nbins_av(k,j,i,2), &
9342	REAL( -999.0_wp, KIND = wp ), &
9343	BTEST( wall_flags_0(k,j,i), 0 ) )
9344	ENDDO
9345	ENDDO
9346	ENDDO
9347	ENDIF
9348
9349	ELSEIF ( TRIM( variable(1:6) ) == 'N_bin3' ) THEN
9350	IF ( av == 0 ) THEN
9351	DO i = nxl, nxr
9352	DO j = nys, nyn
9353	DO k = nzb, nzt+1
9354	local_pf(i,j,k) = MERGE( aerosol_number(3)%conc(k,j,i), &
9355	REAL( -999.0_wp, KIND = wp ), &
9356	BTEST( wall_flags_0(k,j,i), 0 ) )
9357	ENDDO
9358	ENDDO
9359	ENDDO
9360	ELSE
9361	DO i = nxl, nxr
9362	DO j = nys, nyn
9363	DO k = nzb, nzt+1
9364	local_pf(i,j,k) = MERGE( Nbins_av(k,j,i,3), &
9365	REAL( -999.0_wp, KIND = wp ), &
9366	BTEST( wall_flags_0(k,j,i), 0 ) )
9367	ENDDO
9368	ENDDO
9369	ENDDO
9370	ENDIF
9371
9372	ELSEIF ( TRIM( variable(1:6) ) == 'N_bin4' ) THEN
9373	IF ( av == 0 ) THEN
9374	DO i = nxl, nxr
9375	DO j = nys, nyn
9376	DO k = nzb, nzt+1
9377	local_pf(i,j,k) = MERGE( aerosol_number(4)%conc(k,j,i), &
9378	REAL( -999.0_wp, KIND = wp ), &
9379	BTEST( wall_flags_0(k,j,i), 0 ) )
9380	ENDDO
9381	ENDDO
9382	ENDDO
9383	ELSE
9384	DO i = nxl, nxr
9385	DO j = nys, nyn
9386	DO k = nzb, nzt+1
9387	local_pf(i,j,k) = MERGE( Nbins_av(k,j,i,4), &
9388	REAL( -999.0_wp, KIND = wp ), &
9389	BTEST( wall_flags_0(k,j,i), 0 ) )
9390	ENDDO
9391	ENDDO
9392	ENDDO
9393	ENDIF
9394
9395	ELSEIF ( TRIM( variable(1:6) ) == 'N_bin5' ) THEN
9396	IF ( av == 0 ) THEN
9397	DO i = nxl, nxr
9398	DO j = nys, nyn
9399	DO k = nzb, nzt+1
9400	local_pf(i,j,k) = MERGE( aerosol_number(5)%conc(k,j,i), &
9401	REAL( -999.0_wp, KIND = wp ), &
9402	BTEST( wall_flags_0(k,j,i), 0 ) )
9403	ENDDO
9404	ENDDO
9405	ENDDO
9406	ELSE
9407	DO i = nxl, nxr
9408	DO j = nys, nyn
9409	DO k = nzb, nzt+1
9410	local_pf(i,j,k) = MERGE( Nbins_av(k,j,i,5), &
9411	REAL( -999.0_wp, KIND = wp ), &
9412	BTEST( wall_flags_0(k,j,i), 0 ) )
9413	ENDDO
9414	ENDDO
9415	ENDDO
9416	ENDIF
9417
9418	ELSEIF ( TRIM( variable(1:6) ) == 'N_bin6' ) THEN
9419	IF ( av == 0 ) THEN
9420	DO i = nxl, nxr
9421	DO j = nys, nyn
9422	DO k = nzb, nzt+1
9423	local_pf(i,j,k) = MERGE( aerosol_number(6)%conc(k,j,i), &
9424	REAL( -999.0_wp, KIND = wp ), &
9425	BTEST( wall_flags_0(k,j,i), 0 ) )
9426	ENDDO
9427	ENDDO
9428	ENDDO
9429	ELSE
9430	DO i = nxl, nxr
9431	DO j = nys, nyn
9432	DO k = nzb, nzt+1
9433	local_pf(i,j,k) = MERGE( Nbins_av(k,j,i,6), &
9434	REAL( -999.0_wp, KIND = wp ), &
9435	BTEST( wall_flags_0(k,j,i), 0 ) )
9436	ENDDO
9437	ENDDO
9438	ENDDO
9439	ENDIF
9440
9441	ELSEIF ( TRIM( variable(1:6) ) == 'N_bin7' ) THEN
9442	IF ( av == 0 ) THEN
9443	DO i = nxl, nxr
9444	DO j = nys, nyn
9445	DO k = nzb, nzt+1
9446	local_pf(i,j,k) = MERGE( aerosol_number(7)%conc(k,j,i), &
9447	REAL( -999.0_wp, KIND = wp ), &
9448	BTEST( wall_flags_0(k,j,i), 0 ) )
9449	ENDDO
9450	ENDDO
9451	ENDDO
9452	ELSE
9453	DO i = nxl, nxr
9454	DO j = nys, nyn
9455	DO k = nzb, nzt+1
9456	local_pf(i,j,k) = MERGE( Nbins_av(k,j,i,7), &
9457	REAL( -999.0_wp, KIND = wp ), &
9458	BTEST( wall_flags_0(k,j,i), 0 ) )
9459	ENDDO
9460	ENDDO
9461	ENDDO
9462	ENDIF
9463
9464	ELSEIF ( TRIM( variable(1:6) ) == 'N_bin8' ) THEN
9465	IF ( av == 0 ) THEN
9466	DO i = nxl, nxr
9467	DO j = nys, nyn
9468	DO k = nzb, nzt+1
9469	local_pf(i,j,k) = MERGE( aerosol_number(8)%conc(k,j,i), &
9470	REAL( -999.0_wp, KIND = wp ), &
9471	BTEST( wall_flags_0(k,j,i), 0 ) )
9472	ENDDO
9473	ENDDO
9474	ENDDO
9475	ELSE
9476	DO i = nxl, nxr
9477	DO j = nys, nyn
9478	DO k = nzb, nzt+1
9479	local_pf(i,j,k) = MERGE( Nbins_av(k,j,i,8), &
9480	REAL( -999.0_wp, KIND = wp ), &
9481	BTEST( wall_flags_0(k,j,i), 0 ) )
9482	ENDDO
9483	ENDDO
9484	ENDDO
9485	ENDIF
9486
9487	ELSEIF ( TRIM( variable(1:6) ) == 'N_bin9' ) THEN
9488	IF ( av == 0 ) THEN
9489	DO i = nxl, nxr
9490	DO j = nys, nyn
9491	DO k = nzb, nzt+1
9492	local_pf(i,j,k) = MERGE( aerosol_number(9)%conc(k,j,i), &
9493	REAL( -999.0_wp, KIND = wp ), &
9494	BTEST( wall_flags_0(k,j,i), 0 ) )
9495	ENDDO
9496	ENDDO
9497	ENDDO
9498	ELSE
9499	DO i = nxl, nxr
9500	DO j = nys, nyn
9501	DO k = nzb, nzt+1
9502	local_pf(i,j,k) = MERGE( Nbins_av(k,j,i,9), &
9503	REAL( -999.0_wp, KIND = wp ), &
9504	BTEST( wall_flags_0(k,j,i), 0 ) )
9505	ENDDO
9506	ENDDO
9507	ENDDO
9508	ENDIF
9509
9510	ELSEIF ( TRIM( variable(1:7) ) == 'N_bin10' ) THEN
9511	IF ( av == 0 ) THEN
9512	DO i = nxl, nxr
9513	DO j = nys, nyn
9514	DO k = nzb, nzt+1
9515	local_pf(i,j,k) = MERGE( aerosol_number(10)%conc(k,j,i), &
9516	REAL( -999.0_wp, KIND = wp ), &
9517	BTEST( wall_flags_0(k,j,i), 0 ) )
9518	ENDDO
9519	ENDDO
9520	ENDDO
9521	ELSE
9522	DO i = nxl, nxr
9523	DO j = nys, nyn
9524	DO k = nzb, nzt+1
9525	local_pf(i,j,k) = MERGE( Nbins_av(k,j,i,10), &
9526	REAL( -999.0_wp, KIND = wp ), &
9527	BTEST( wall_flags_0(k,j,i), 0 ) )
9528	ENDDO
9529	ENDDO
9530	ENDDO
9531	ENDIF
9532
9533	ELSEIF ( TRIM( variable(1:7) ) == 'N_bin11' ) THEN
9534	IF ( av == 0 ) THEN
9535	DO i = nxl, nxr
9536	DO j = nys, nyn
9537	DO k = nzb, nzt+1
9538	local_pf(i,j,k) = MERGE( aerosol_number(11)%conc(k,j,i), &
9539	REAL( -999.0_wp, KIND = wp ), &
9540	BTEST( wall_flags_0(k,j,i), 0 ) )
9541	ENDDO
9542	ENDDO
9543	ENDDO
9544	ELSE
9545	DO i = nxl, nxr
9546	DO j = nys, nyn
9547	DO k = nzb, nzt+1
9548	local_pf(i,j,k) = MERGE( Nbins_av(k,j,i,11), &
9549	REAL( -999.0_wp, KIND = wp ), &
9550	BTEST( wall_flags_0(k,j,i), 0 ) )
9551	ENDDO
9552	ENDDO
9553	ENDDO
9554	ENDIF
9555
9556	ELSEIF ( TRIM( variable(1:7) ) == 'N_bin12' ) THEN
9557	IF ( av == 0 ) THEN
9558	DO i = nxl, nxr
9559	DO j = nys, nyn
9560	DO k = nzb, nzt+1
9561	local_pf(i,j,k) = MERGE( aerosol_number(12)%conc(k,j,i), &
9562	REAL( -999.0_wp, KIND = wp ), &
9563	BTEST( wall_flags_0(k,j,i), 0 ) )
9564	ENDDO
9565	ENDDO
9566	ENDDO
9567	ELSE
9568	DO i = nxl, nxr
9569	DO j = nys, nyn
9570	DO k = nzb, nzt+1
9571	local_pf(i,j,k) = MERGE( Nbins_av(k,j,i,12), &
9572	REAL( -999.0_wp, KIND = wp ), &
9573	BTEST( wall_flags_0(k,j,i), 0 ) )
9574	ENDDO
9575	ENDDO
9576	ENDDO
9577	ENDIF
9578
9579	ELSEIF ( TRIM( variable(1:4) ) == 'Ntot' ) THEN
9580	IF ( av == 0 ) THEN
9581	DO i = nxl, nxr
9582	DO j = nys, nyn
9583	DO k = nzb, nzt+1
9584	temp_bin = 0.0_wp
9585	DO b = 1, nbins
9586	temp_bin = temp_bin + aerosol_number(b)%conc(k,j,i)
9587	ENDDO
9588	local_pf(i,j,k) = MERGE( temp_bin, REAL( -999.0_wp, &
9589	KIND = wp ), BTEST( wall_flags_0(k,j,i), 0 ) )
9590	ENDDO
9591	ENDDO
9592	ENDDO
9593	ELSE
9594	DO i = nxl, nxr
9595	DO j = nys, nyn
9596	DO k = nzb, nzt+1
9597	local_pf(i,j,k) = MERGE( Ntot_av(k,j,i), REAL( -999.0_wp, &
9598	KIND = wp ), BTEST( wall_flags_0(k,j,i), 0 ) )
9599	ENDDO
9600	ENDDO
9601	ENDDO
9602	ENDIF
9603
9604	IF ( mode == 'xy' ) grid = 'zu'
9605
9606
9607	ELSEIF ( TRIM( variable(1:6) ) == 'm_bin1' ) THEN
9608	IF ( av == 0 ) THEN
9609	DO i = nxl, nxr
9610	DO j = nys, nyn
9611	DO k = nzb, nzt+1
9612	temp_bin = 0.0_wp
9613	DO c = 1, ncc_tot*nbins, nbins
9614	temp_bin = temp_bin + aerosol_mass(c)%conc(k,j,i)
9615	ENDDO
9616	local_pf(i,j,k) = MERGE( temp_bin, REAL( -999.0_wp, &
9617	KIND = wp ), BTEST( wall_flags_0(k,j,i), 0 ) )
9618	ENDDO
9619	ENDDO
9620	ENDDO
9621	ELSE
9622	DO i = nxl, nxr
9623	DO j = nys, nyn
9624	DO k = nzb, nzt+1
9625	local_pf(i,j,k) = MERGE( mbins_av(k,j,i,1), REAL( -999.0_wp,&
9626	KIND = wp ), BTEST( wall_flags_0(k,j,i), 0 ) )
9627	ENDDO
9628	ENDDO
9629	ENDDO
9630	ENDIF
9631
9632	ELSEIF ( TRIM( variable(1:6) ) == 'm_bin2' ) THEN
9633	IF ( av == 0 ) THEN
9634	DO i = nxl, nxr
9635	DO j = nys, nyn
9636	DO k = nzb, nzt+1
9637	temp_bin = 0.0_wp
9638	DO c = 2, ncc_tot*nbins, nbins
9639	temp_bin = temp_bin + aerosol_mass(c)%conc(k,j,i)
9640	ENDDO
9641	local_pf(i,j,k) = MERGE( temp_bin, REAL( -999.0_wp, &
9642	KIND = wp ), BTEST( wall_flags_0(k,j,i), 0 ) )
9643	ENDDO
9644	ENDDO
9645	ENDDO
9646	ELSE
9647	DO i = nxl, nxr
9648	DO j = nys, nyn
9649	DO k = nzb, nzt+1
9650	local_pf(i,j,k) = MERGE( mbins_av(k,j,i,2), REAL( -999.0_wp,&
9651	KIND = wp ), BTEST( wall_flags_0(k,j,i), 0 ) )
9652	ENDDO
9653	ENDDO
9654	ENDDO
9655	ENDIF
9656
9657	ELSEIF ( TRIM( variable(1:6) ) == 'm_bin3' ) THEN
9658	IF ( av == 0 ) THEN
9659	DO i = nxl, nxr
9660	DO j = nys, nyn
9661	DO k = nzb, nzt+1
9662	temp_bin = 0.0_wp
9663	DO c = 3, ncc_tot*nbins, nbins
9664	temp_bin = temp_bin + aerosol_mass(c)%conc(k,j,i)
9665	ENDDO
9666	local_pf(i,j,k) = MERGE( temp_bin, REAL( -999.0_wp, &
9667	KIND = wp ), BTEST( wall_flags_0(k,j,i), 0 ) )
9668	ENDDO
9669	ENDDO
9670	ENDDO
9671	ELSE
9672	DO i = nxl, nxr
9673	DO j = nys, nyn
9674	DO k = nzb, nzt+1
9675	local_pf(i,j,k) = MERGE( mbins_av(k,j,i,3), REAL( -999.0_wp,&
9676	KIND = wp ), BTEST( wall_flags_0(k,j,i), 0 ) )
9677	ENDDO
9678	ENDDO
9679	ENDDO
9680	ENDIF
9681
9682	ELSEIF ( TRIM( variable(1:6) ) == 'm_bin4' ) THEN
9683	IF ( av == 0 ) THEN
9684	DO i = nxl, nxr
9685	DO j = nys, nyn
9686	DO k = nzb, nzt+1
9687	temp_bin = 0.0_wp
9688	DO c = 4, ncc_tot*nbins, nbins
9689	temp_bin = temp_bin + aerosol_mass(c)%conc(k,j,i)
9690	ENDDO
9691	local_pf(i,j,k) = MERGE( temp_bin, REAL( -999.0_wp, &
9692	KIND = wp ), BTEST( wall_flags_0(k,j,i), 0 ) )
9693	ENDDO
9694	ENDDO
9695	ENDDO
9696	ELSE
9697	DO i = nxl, nxr
9698	DO j = nys, nyn
9699	DO k = nzb, nzt+1
9700	local_pf(i,j,k) = MERGE( mbins_av(k,j,i,4), REAL( -999.0_wp,&
9701	KIND = wp ), BTEST( wall_flags_0(k,j,i), 0 ) )
9702	ENDDO
9703	ENDDO
9704	ENDDO
9705	ENDIF
9706
9707	ELSEIF ( TRIM( variable(1:6) ) == 'm_bin5' ) THEN
9708	IF ( av == 0 ) THEN
9709	DO i = nxl, nxr
9710	DO j = nys, nyn
9711	DO k = nzb, nzt+1
9712	temp_bin = 0.0_wp
9713	DO c = 5, ncc_tot*nbins, nbins
9714	temp_bin = temp_bin + aerosol_mass(c)%conc(k,j,i)
9715	ENDDO
9716	local_pf(i,j,k) = MERGE( temp_bin, REAL( -999.0_wp, &
9717	KIND = wp ), BTEST( wall_flags_0(k,j,i), 0 ) )
9718	ENDDO
9719	ENDDO
9720	ENDDO
9721	ELSE
9722	DO i = nxl, nxr
9723	DO j = nys, nyn
9724	DO k = nzb, nzt+1
9725	local_pf(i,j,k) = MERGE( mbins_av(k,j,i,5), REAL( -999.0_wp,&
9726	KIND = wp ), BTEST( wall_flags_0(k,j,i), 0 ) )
9727	ENDDO
9728	ENDDO
9729	ENDDO
9730	ENDIF
9731
9732	ELSEIF ( TRIM( variable(1:6) ) == 'm_bin6' ) THEN
9733	IF ( av == 0 ) THEN
9734	DO i = nxl, nxr
9735	DO j = nys, nyn
9736	DO k = nzb, nzt+1
9737	temp_bin = 0.0_wp
9738	DO c = 6, ncc_tot*nbins, nbins
9739	temp_bin = temp_bin + aerosol_mass(c)%conc(k,j,i)
9740	ENDDO
9741	local_pf(i,j,k) = MERGE( temp_bin, REAL( -999.0_wp, &
9742	KIND = wp ), BTEST( wall_flags_0(k,j,i), 0 ) )
9743	ENDDO
9744	ENDDO
9745	ENDDO
9746	ELSE
9747	DO i = nxl, nxr
9748	DO j = nys, nyn
9749	DO k = nzb, nzt+1
9750	local_pf(i,j,k) = MERGE( mbins_av(k,j,i,6), REAL( -999.0_wp,&
9751	KIND = wp ), BTEST( wall_flags_0(k,j,i), 0 ) )
9752	ENDDO
9753	ENDDO
9754	ENDDO
9755	ENDIF
9756
9757	ELSEIF ( TRIM( variable(1:6) ) == 'm_bin7' ) THEN
9758	IF ( av == 0 ) THEN
9759	DO i = nxl, nxr
9760	DO j = nys, nyn
9761	DO k = nzb, nzt+1
9762	temp_bin = 0.0_wp
9763	DO c = 7, ncc_tot*nbins, nbins
9764	temp_bin = temp_bin + aerosol_mass(c)%conc(k,j,i)
9765	ENDDO
9766	local_pf(i,j,k) = MERGE( temp_bin, REAL( -999.0_wp, &
9767	KIND = wp ), BTEST( wall_flags_0(k,j,i), 0 ) )
9768	ENDDO
9769	ENDDO
9770	ENDDO
9771	ELSE
9772	DO i = nxl, nxr
9773	DO j = nys, nyn
9774	DO k = nzb, nzt+1
9775	local_pf(i,j,k) = MERGE( mbins_av(k,j,i,7), REAL( -999.0_wp,&
9776	KIND = wp ), BTEST( wall_flags_0(k,j,i), 0 ) )
9777	ENDDO
9778	ENDDO
9779	ENDDO
9780	ENDIF
9781
9782	ELSEIF ( TRIM( variable(1:6) ) == 'm_bin8' ) THEN
9783	IF ( av == 0 ) THEN
9784	DO i = nxl, nxr
9785	DO j = nys, nyn
9786	DO k = nzb, nzt+1
9787	temp_bin = 0.0_wp
9788	DO c = 8, ncc_tot*nbins, nbins
9789	temp_bin = temp_bin + aerosol_mass(c)%conc(k,j,i)
9790	ENDDO
9791	local_pf(i,j,k) = MERGE( temp_bin, REAL( -999.0_wp, &
9792	KIND = wp ), BTEST( wall_flags_0(k,j,i), 0 ) )
9793	ENDDO
9794	ENDDO
9795	ENDDO
9796	ELSE
9797	DO i = nxl, nxr
9798	DO j = nys, nyn
9799	DO k = nzb, nzt+1
9800	local_pf(i,j,k) = MERGE( mbins_av(k,j,i,8), REAL( -999.0_wp,&
9801	KIND = wp ), BTEST( wall_flags_0(k,j,i), 0 ) )
9802	ENDDO
9803	ENDDO
9804	ENDDO
9805	ENDIF
9806
9807	ELSEIF ( TRIM( variable(1:6) ) == 'm_bin9' ) THEN
9808	IF ( av == 0 ) THEN
9809	DO i = nxl, nxr
9810	DO j = nys, nyn
9811	DO k = nzb, nzt+1
9812	temp_bin = 0.0_wp
9813	DO c = 9, ncc_tot*nbins, nbins
9814	temp_bin = temp_bin + aerosol_mass(c)%conc(k,j,i)
9815	ENDDO
9816	local_pf(i,j,k) = MERGE( temp_bin, REAL( -999.0_wp, &
9817	KIND = wp ), BTEST( wall_flags_0(k,j,i), 0 ) )
9818	ENDDO
9819	ENDDO
9820	ENDDO
9821	ELSE
9822	DO i = nxl, nxr
9823	DO j = nys, nyn
9824	DO k = nzb, nzt+1
9825	local_pf(i,j,k) = MERGE( mbins_av(k,j,i,9), REAL( -999.0_wp,&
9826	KIND = wp ), BTEST( wall_flags_0(k,j,i), 0 ) )
9827	ENDDO
9828	ENDDO
9829	ENDDO
9830	ENDIF
9831
9832	ELSEIF ( TRIM( variable(1:7) ) == 'm_bin10' ) THEN
9833	IF ( av == 0 ) THEN
9834	DO i = nxl, nxr
9835	DO j = nys, nyn
9836	DO k = nzb, nzt+1
9837	temp_bin = 0.0_wp
9838	DO c = 10, ncc_tot*nbins, nbins
9839	temp_bin = temp_bin + aerosol_mass(c)%conc(k,j,i)
9840	ENDDO
9841	local_pf(i,j,k) = MERGE( temp_bin, REAL( -999.0_wp, &
9842	KIND = wp ), BTEST( wall_flags_0(k,j,i), 0 ) )
9843	ENDDO
9844	ENDDO
9845	ENDDO
9846	ELSE
9847	DO i = nxl, nxr
9848	DO j = nys, nyn
9849	DO k = nzb, nzt+1
9850	local_pf(i,j,k) = MERGE( mbins_av(k,j,i,10), REAL( &
9851	-999.0_wp, KIND = wp ), BTEST( wall_flags_0(k,j,i), 0 ) )
9852	ENDDO
9853	ENDDO
9854	ENDDO
9855	ENDIF
9856
9857	ELSEIF ( TRIM( variable(1:7) ) == 'm_bin11' ) THEN
9858	IF ( av == 0 ) THEN
9859	DO i = nxl, nxr
9860	DO j = nys, nyn
9861	DO k = nzb, nzt+1
9862	temp_bin = 0.0_wp
9863	DO c = 11, ncc_tot*nbins, nbins
9864	temp_bin = temp_bin + aerosol_mass(c)%conc(k,j,i)
9865	ENDDO
9866	local_pf(i,j,k) = MERGE( temp_bin, REAL( -999.0_wp, &
9867	KIND = wp ), BTEST( wall_flags_0(k,j,i), 0 ) )
9868	ENDDO
9869	ENDDO
9870	ENDDO
9871	ELSE
9872	DO i = nxl, nxr
9873	DO j = nys, nyn
9874	DO k = nzb, nzt+1
9875	local_pf(i,j,k) = MERGE( mbins_av(k,j,i,11), REAL( &
9876	-999.0_wp, KIND = wp ), BTEST( wall_flags_0(k,j,i), 0 ) )
9877	ENDDO
9878	ENDDO
9879	ENDDO
9880	ENDIF
9881
9882	ELSEIF ( TRIM( variable(1:7) ) == 'm_bin12' ) THEN
9883	IF ( av == 0 ) THEN
9884	DO i = nxl, nxr
9885	DO j = nys, nyn
9886	DO k = nzb, nzt+1
9887	temp_bin = 0.0_wp
9888	DO c = 12, ncc_tot*nbins, nbins
9889	temp_bin = temp_bin + aerosol_mass(c)%conc(k,j,i)
9890	ENDDO
9891	local_pf(i,j,k) = MERGE( temp_bin, REAL( -999.0_wp, &
9892	KIND = wp ), BTEST( wall_flags_0(k,j,i), 0 ) )
9893	ENDDO
9894	ENDDO
9895	ENDDO
9896	ELSE
9897	DO i = nxl, nxr
9898	DO j = nys, nyn
9899	DO k = nzb, nzt+1
9900	local_pf(i,j,k) = MERGE( mbins_av(k,j,i,12), REAL( &
9901	-999.0_wp, KIND = wp ), BTEST( wall_flags_0(k,j,i), 0 ) )
9902	ENDDO
9903	ENDDO
9904	ENDDO
9905	ENDIF
9906
9907	ELSEIF ( TRIM( variable(1:5) ) == 'PM2.5' ) THEN
9908	IF ( av == 0 ) THEN
9909	DO i = nxl, nxr
9910	DO j = nys, nyn
9911	DO k = nzb, nzt+1
9912	temp_bin = 0.0_wp
9913	DO b = 1, nbins
9914	IF ( 2.0_wp * Ra_dry(k,j,i,b) <= 2.5E-6_wp ) THEN
9915	DO c = b, nbins*ncc, nbins
9916	temp_bin = temp_bin + aerosol_mass(c)%conc(k,j,i)
9917	ENDDO
9918	ENDIF
9919	ENDDO
9920	local_pf(i,j,k) = MERGE( temp_bin, REAL( -999.0_wp, &
9921	KIND = wp ), BTEST( wall_flags_0(k,j,i), 0 ) )
9922	ENDDO
9923	ENDDO
9924	ENDDO
9925	ELSE
9926	DO i = nxl, nxr
9927	DO j = nys, nyn
9928	DO k = nzb, nzt+1
9929	local_pf(i,j,k) = MERGE( PM25_av(k,j,i), REAL( -999.0_wp, &
9930	KIND = wp ), BTEST( wall_flags_0(k,j,i), 0 ) )
9931	ENDDO
9932	ENDDO
9933	ENDDO
9934	ENDIF
9935
9936	IF ( mode == 'xy' ) grid = 'zu'
9937
9938
9939	ELSEIF ( TRIM( variable(1:4) ) == 'PM10' ) THEN
9940	IF ( av == 0 ) THEN
9941	DO i = nxl, nxr
9942	DO j = nys, nyn
9943	DO k = nzb, nzt+1
9944	temp_bin = 0.0_wp
9945	DO b = 1, nbins
9946	IF ( 2.0_wp * Ra_dry(k,j,i,b) <= 10.0E-6_wp ) THEN
9947	DO c = b, nbins*ncc, nbins
9948	temp_bin = temp_bin + aerosol_mass(c)%conc(k,j,i)
9949	ENDDO
9950	ENDIF
9951	ENDDO
9952	local_pf(i,j,k) = MERGE( temp_bin, REAL( -999.0_wp, &
9953	KIND = wp ), BTEST( wall_flags_0(k,j,i), 0 ) )
9954	ENDDO
9955	ENDDO
9956	ENDDO
9957	ELSE
9958	DO i = nxl, nxr
9959	DO j = nys, nyn
9960	DO k = nzb, nzt+1
9961	local_pf(i,j,k) = MERGE( PM10_av(k,j,i), REAL( -999.0_wp, &
9962	KIND = wp ), BTEST( wall_flags_0(k,j,i), 0 ) )
9963	ENDDO
9964	ENDDO
9965	ENDDO
9966	ENDIF
9967
9968	IF ( mode == 'xy' ) grid = 'zu'
9969
9970	ELSEIF ( TRIM( variable(1:2) ) == 's_' ) THEN
9971	vari = TRIM( variable( 3:LEN( TRIM( variable ) ) - 3 ) )
9972	IF ( is_used( prtcl, vari ) ) THEN
9973	icc = get_index( prtcl, vari )
9974	IF ( av == 0 ) THEN
9975	DO i = nxl, nxr
9976	DO j = nys, nyn
9977	DO k = nzb, nzt+1
9978	temp_bin = 0.0_wp
9979	DO c = ( icc-1 )nbins+1, iccnbins, 1
9980	temp_bin = temp_bin + aerosol_mass(c)%conc(k,j,i)
9981	ENDDO
9982	local_pf(i,j,k) = MERGE( temp_bin, REAL( -999.0_wp, &
9983	KIND = wp ), BTEST( wall_flags_0(k,j,i), 0 ) )
9984	ENDDO
9985	ENDDO
9986	ENDDO
9987	ELSE
9988	IF ( vari == 'BC' ) to_be_resorted => s_BC_av
9989	IF ( vari == 'DU' ) to_be_resorted => s_DU_av
9990	IF ( vari == 'NH' ) to_be_resorted => s_NH_av
9991	IF ( vari == 'NO' ) to_be_resorted => s_NO_av
9992	IF ( vari == 'OC' ) to_be_resorted => s_OC_av
9993	IF ( vari == 'SO4' ) to_be_resorted => s_SO4_av
9994	IF ( vari == 'SS' ) to_be_resorted => s_SS_av
9995	DO i = nxl, nxr
9996	DO j = nys, nyn
9997	DO k = nzb, nzt+1
9998	local_pf(i,j,k) = MERGE( to_be_resorted(k,j,i), &
9999	REAL( -999.0_wp, KIND = wp ), &
10000	BTEST( wall_flags_0(k,j,i), 0 ) )
10001	ENDDO
10002	ENDDO
10003	ENDDO
10004	ENDIF
10005	ELSE
10006	local_pf = 0.0_wp
10007	ENDIF
10008
10009	IF ( mode == 'xy' ) grid = 'zu'
10010
10011	ELSE
10012	found = .FALSE.
10013	grid = 'none'
10014
10015	ENDIF
10016
10017	END SUBROUTINE salsa_data_output_2d
10018
10019
10020	!------------------------------------------------------------------------------!
10021	!
10022	! Description:
10023	! ------------
10024	!> Subroutine defining 3D output variables
10025	!------------------------------------------------------------------------------!
10026	SUBROUTINE salsa_data_output_3d( av, variable, found, local_pf )
10027
10028	USE indices
10029
10030	USE kinds
10031
10032	IMPLICIT NONE
10033
10034	CHARACTER (LEN=*), INTENT(in) :: variable !<
10035
10036	INTEGER(iwp) :: av !<
10037	INTEGER(iwp) :: c !<
10038	INTEGER(iwp) :: i !<
10039	INTEGER(iwp) :: icc !< index of a chemical compound
10040	INTEGER(iwp) :: j !<
10041	INTEGER(iwp) :: k !<
10042	INTEGER(iwp) :: n !<
10043
10044	LOGICAL :: found !<
10045	REAL(wp) :: df !< For calculating LDSA: fraction of particles
10046	!< depositing in the alveolar (or tracheobronchial)
10047	!< region of the lung. Depends on the particle size
10048	REAL(wp) :: mean_d !< Particle diameter in micrometres
10049	REAL(wp) :: nc !< Particle number concentration in units 1/cm**3
10050
10051	REAL(sp), DIMENSION(nxl:nxr,nys:nyn,nzb:nzt+1) :: local_pf !< local
10052	!< array to which output data is resorted to
10053	REAL(wp) :: temp_bin !<
10054	REAL(wp), DIMENSION(:,:,:), POINTER :: to_be_resorted !< points to
10055	!< selected output variable
10056
10057	found = .TRUE.
10058	temp_bin = 0.0_wp
10059
10060	SELECT CASE ( TRIM( variable ) )
10061
10062	CASE ( 'g_H2SO4', 'g_HNO3', 'g_NH3', 'g_OCNV', 'g_OCSV' )
10063	IF ( av == 0 ) THEN
10064	IF ( TRIM( variable ) == 'g_H2SO4') icc = 1
10065	IF ( TRIM( variable ) == 'g_HNO3') icc = 2
10066	IF ( TRIM( variable ) == 'g_NH3') icc = 3
10067	IF ( TRIM( variable ) == 'g_OCNV') icc = 4
10068	IF ( TRIM( variable ) == 'g_OCSV') icc = 5
10069
10070	DO i = nxl, nxr
10071	DO j = nys, nyn
10072	DO k = nzb, nzt+1
10073	local_pf(i,j,k) = MERGE( salsa_gas(icc)%conc(k,j,i), &
10074	REAL( -999.0_wp, KIND = wp ), &
10075	BTEST( wall_flags_0(k,j,i), 0 ) )
10076	ENDDO
10077	ENDDO
10078	ENDDO
10079	ELSE
10080	IF ( TRIM( variable(3:) ) == 'H2SO4' ) to_be_resorted => g_H2SO4_av
10081	IF ( TRIM( variable(3:) ) == 'HNO3' ) to_be_resorted => g_HNO3_av
10082	IF ( TRIM( variable(3:) ) == 'NH3' ) to_be_resorted => g_NH3_av
10083	IF ( TRIM( variable(3:) ) == 'OCNV' ) to_be_resorted => g_OCNV_av
10084	IF ( TRIM( variable(3:) ) == 'OCSV' ) to_be_resorted => g_OCSV_av
10085	DO i = nxl, nxr
10086	DO j = nys, nyn
10087	DO k = nzb, nzt+1
10088	local_pf(i,j,k) = MERGE( to_be_resorted(k,j,i), &
10089	REAL( -999.0_wp, KIND = wp ), &
10090	BTEST( wall_flags_0(k,j,i), 0 ) )
10091	ENDDO
10092	ENDDO
10093	ENDDO
10094	ENDIF
10095
10096	CASE ( 'LDSA' )
10097	IF ( av == 0 ) THEN
10098	DO i = nxl, nxr
10099	DO j = nys, nyn
10100	DO k = nzb, nzt+1
10101	temp_bin = 0.0_wp
10102	DO n = 1, nbins
10103	!
10104	!-- Diameter in micrometres
10105	mean_d = 1.0E+6_wp * Ra_dry(k,j,i,n) * 2.0_wp
10106	!
10107	!-- Deposition factor: alveolar
10108	df = ( 0.01555_wp / mean_d ) * ( EXP( -0.416_wp * &
10109	( LOG( mean_d ) + 2.84_wp )**2.0_wp ) &
10110	+ 19.11_wp * EXP( -0.482_wp * &
10111	( LOG( mean_d ) - 1.362_wp )**2.0_wp ) )
10112	!
10113	!-- Number concentration in 1/cm3
10114	nc = 1.0E-6_wp * aerosol_number(n)%conc(k,j,i)
10115	!
10116	!-- Lung-deposited surface area LDSA (units mum2/cm3)
10117	temp_bin = temp_bin + pi * mean_d*2.0_wp df * nc
10118	ENDDO
10119	local_pf(i,j,k) = MERGE( temp_bin, &
10120	REAL( -999.0_wp, KIND = wp ), &
10121	BTEST( wall_flags_0(k,j,i), 0 ) )
10122	ENDDO
10123	ENDDO
10124	ENDDO
10125	ELSE
10126	DO i = nxl, nxr
10127	DO j = nys, nyn
10128	DO k = nzb, nzt+1
10129	local_pf(i,j,k) = MERGE( LDSA_av(k,j,i), &
10130	REAL( -999.0_wp, KIND = wp ), &
10131	BTEST( wall_flags_0(k,j,i), 0 ) )
10132	ENDDO
10133	ENDDO
10134	ENDDO
10135	ENDIF
10136
10137	CASE ( 'Ntot' )
10138	IF ( av == 0 ) THEN
10139	DO i = nxl, nxr
10140	DO j = nys, nyn
10141	DO k = nzb, nzt+1
10142	temp_bin = 0.0_wp
10143	DO n = 1, nbins
10144	temp_bin = temp_bin + aerosol_number(n)%conc(k,j,i)
10145	ENDDO
10146	local_pf(i,j,k) = MERGE( temp_bin, &
10147	REAL( -999.0_wp, KIND = wp ), &
10148	BTEST( wall_flags_0(k,j,i), 0 ) )
10149	ENDDO
10150	ENDDO
10151	ENDDO
10152	ELSE
10153	DO i = nxl, nxr
10154	DO j = nys, nyn
10155	DO k = nzb, nzt+1
10156	local_pf(i,j,k) = MERGE( Ntot_av(k,j,i), &
10157	REAL( -999.0_wp, KIND = wp ), &
10158	BTEST( wall_flags_0(k,j,i), 0 ) )
10159	ENDDO
10160	ENDDO
10161	ENDDO
10162	ENDIF
10163
10164	CASE ( 'PM2.5' )
10165	IF ( av == 0 ) THEN
10166	DO i = nxl, nxr
10167	DO j = nys, nyn
10168	DO k = nzb, nzt+1
10169	temp_bin = 0.0_wp
10170	DO n = 1, nbins
10171	IF ( 2.0_wp * Ra_dry(k,j,i,n) <= 2.5E-6_wp ) THEN
10172	DO c = n, nbins*ncc, nbins
10173	temp_bin = temp_bin + aerosol_mass(c)%conc(k,j,i)
10174	ENDDO
10175	ENDIF
10176	ENDDO
10177	local_pf(i,j,k) = MERGE( temp_bin, &
10178	REAL( -999.0_wp, KIND = wp ), &
10179	BTEST( wall_flags_0(k,j,i), 0 ) )
10180	ENDDO
10181	ENDDO
10182	ENDDO
10183	ELSE
10184	DO i = nxl, nxr
10185	DO j = nys, nyn
10186	DO k = nzb, nzt+1
10187	local_pf(i,j,k) = MERGE( PM25_av(k,j,i), &
10188	REAL( -999.0_wp, KIND = wp ), &
10189	BTEST( wall_flags_0(k,j,i), 0 ) )
10190	ENDDO
10191	ENDDO
10192	ENDDO
10193	ENDIF
10194
10195	CASE ( 'PM10' )
10196	IF ( av == 0 ) THEN
10197	DO i = nxl, nxr
10198	DO j = nys, nyn
10199	DO k = nzb, nzt+1
10200	temp_bin = 0.0_wp
10201	DO n = 1, nbins
10202	IF ( 2.0_wp * Ra_dry(k,j,i,n) <= 10.0E-6_wp ) THEN
10203	DO c = n, nbins*ncc, nbins
10204	temp_bin = temp_bin + aerosol_mass(c)%conc(k,j,i)
10205	ENDDO
10206	ENDIF
10207	ENDDO
10208	local_pf(i,j,k) = MERGE( temp_bin, &
10209	REAL( -999.0_wp, KIND = wp ), &
10210	BTEST( wall_flags_0(k,j,i), 0 ) )
10211	ENDDO
10212	ENDDO
10213	ENDDO
10214	ELSE
10215	DO i = nxl, nxr
10216	DO j = nys, nyn
10217	DO k = nzb, nzt+1
10218	local_pf(i,j,k) = MERGE( PM10_av(k,j,i), &
10219	REAL( -999.0_wp, KIND = wp ), &
10220	BTEST( wall_flags_0(k,j,i), 0 ) )
10221	ENDDO
10222	ENDDO
10223	ENDDO
10224	ENDIF
10225
10226	CASE ( 'N_bin1' )
10227	IF ( av == 0 ) THEN
10228	DO i = nxl, nxr
10229	DO j = nys, nyn
10230	DO k = nzb, nzt+1
10231	local_pf(i,j,k) = MERGE( aerosol_number(1)%conc(k,j,i), &
10232	REAL( -999.0_wp, KIND = wp ), &
10233	BTEST( wall_flags_0(k,j,i), 0 ) )
10234	ENDDO
10235	ENDDO
10236	ENDDO
10237	ELSE
10238	DO i = nxl, nxr
10239	DO j = nys, nyn
10240	DO k = nzb, nzt+1
10241	local_pf(i,j,k) = MERGE( Nbins_av(k,j,i,1), &
10242	REAL( -999.0_wp, KIND = wp ), &
10243	BTEST( wall_flags_0(k,j,i), 0 ) )
10244	ENDDO
10245	ENDDO
10246	ENDDO
10247	ENDIF
10248
10249	CASE ( 'N_bin2' )
10250	IF ( av == 0 ) THEN
10251	DO i = nxl, nxr
10252	DO j = nys, nyn
10253	DO k = nzb, nzt+1
10254	local_pf(i,j,k) = MERGE( aerosol_number(2)%conc(k,j,i), &
10255	REAL( -999.0_wp, KIND = wp ), &
10256	BTEST( wall_flags_0(k,j,i), 0 ) )
10257	ENDDO
10258	ENDDO
10259	ENDDO
10260	ELSE
10261	DO i = nxl, nxr
10262	DO j = nys, nyn
10263	DO k = nzb, nzt+1
10264	local_pf(i,j,k) = MERGE( Nbins_av(k,j,i,2), &
10265	REAL( -999.0_wp, KIND = wp ), &
10266	BTEST( wall_flags_0(k,j,i), 0 ) )
10267	ENDDO
10268	ENDDO
10269	ENDDO
10270	ENDIF
10271
10272	CASE ( 'N_bin3' )
10273	IF ( av == 0 ) THEN
10274	DO i = nxl, nxr
10275	DO j = nys, nyn
10276	DO k = nzb, nzt+1
10277	local_pf(i,j,k) = MERGE( aerosol_number(3)%conc(k,j,i), &
10278	REAL( -999.0_wp, KIND = wp ), &
10279	BTEST( wall_flags_0(k,j,i), 0 ) )
10280	ENDDO
10281	ENDDO
10282	ENDDO
10283	ELSE
10284	DO i = nxl, nxr
10285	DO j = nys, nyn
10286	DO k = nzb, nzt+1
10287	local_pf(i,j,k) = MERGE( Nbins_av(k,j,i,3), &
10288	REAL( -999.0_wp, KIND = wp ), &
10289	BTEST( wall_flags_0(k,j,i), 0 ) )
10290	ENDDO
10291	ENDDO
10292	ENDDO
10293	ENDIF
10294
10295	CASE ( 'N_bin4' )
10296	IF ( av == 0 ) THEN
10297	DO i = nxl, nxr
10298	DO j = nys, nyn
10299	DO k = nzb, nzt+1
10300	local_pf(i,j,k) = MERGE( aerosol_number(4)%conc(k,j,i), &
10301	REAL( -999.0_wp, KIND = wp ), &
10302	BTEST( wall_flags_0(k,j,i), 0 ) )
10303	ENDDO
10304	ENDDO
10305	ENDDO
10306	ELSE
10307	DO i = nxl, nxr
10308	DO j = nys, nyn
10309	DO k = nzb, nzt+1
10310	local_pf(i,j,k) = MERGE( Nbins_av(k,j,i,4), &
10311	REAL( -999.0_wp, KIND = wp ), &
10312	BTEST( wall_flags_0(k,j,i), 0 ) )
10313	ENDDO
10314	ENDDO
10315	ENDDO
10316	ENDIF
10317
10318	CASE ( 'N_bin5' )
10319	IF ( av == 0 ) THEN
10320	DO i = nxl, nxr
10321	DO j = nys, nyn
10322	DO k = nzb, nzt+1
10323	local_pf(i,j,k) = MERGE( aerosol_number(5)%conc(k,j,i), &
10324	REAL( -999.0_wp, KIND = wp ), &
10325	BTEST( wall_flags_0(k,j,i), 0 ) )
10326	ENDDO
10327	ENDDO
10328	ENDDO
10329	ELSE
10330	DO i = nxl, nxr
10331	DO j = nys, nyn
10332	DO k = nzb, nzt+1
10333	local_pf(i,j,k) = MERGE( Nbins_av(k,j,i,5), &
10334	REAL( -999.0_wp, KIND = wp ), &
10335	BTEST( wall_flags_0(k,j,i), 0 ) )
10336	ENDDO
10337	ENDDO
10338	ENDDO
10339	ENDIF
10340
10341	CASE ( 'N_bin6' )
10342	IF ( av == 0 ) THEN
10343	DO i = nxl, nxr
10344	DO j = nys, nyn
10345	DO k = nzb, nzt+1
10346	local_pf(i,j,k) = MERGE( aerosol_number(6)%conc(k,j,i), &
10347	REAL( -999.0_wp, KIND = wp ), &
10348	BTEST( wall_flags_0(k,j,i), 0 ) )
10349	ENDDO
10350	ENDDO
10351	ENDDO
10352	ELSE
10353	DO i = nxl, nxr
10354	DO j = nys, nyn
10355	DO k = nzb, nzt+1
10356	local_pf(i,j,k) = MERGE( Nbins_av(k,j,i,6), &
10357	REAL( -999.0_wp, KIND = wp ), &
10358	BTEST( wall_flags_0(k,j,i), 0 ) )
10359	ENDDO
10360	ENDDO
10361	ENDDO
10362	ENDIF
10363
10364	CASE ( 'N_bin7' )
10365	IF ( av == 0 ) THEN
10366	DO i = nxl, nxr
10367	DO j = nys, nyn
10368	DO k = nzb, nzt+1
10369	local_pf(i,j,k) = MERGE( aerosol_number(7)%conc(k,j,i), &
10370	REAL( -999.0_wp, KIND = wp ), &
10371	BTEST( wall_flags_0(k,j,i), 0 ) )
10372	ENDDO
10373	ENDDO
10374	ENDDO
10375	ELSE
10376	DO i = nxl, nxr
10377	DO j = nys, nyn
10378	DO k = nzb, nzt+1
10379	local_pf(i,j,k) = MERGE( Nbins_av(k,j,i,7), &
10380	REAL( -999.0_wp, KIND = wp ), &
10381	BTEST( wall_flags_0(k,j,i), 0 ) )
10382	ENDDO
10383	ENDDO
10384	ENDDO
10385	ENDIF
10386
10387	CASE ( 'N_bin8' )
10388	IF ( av == 0 ) THEN
10389	DO i = nxl, nxr
10390	DO j = nys, nyn
10391	DO k = nzb, nzt+1
10392	local_pf(i,j,k) = MERGE( aerosol_number(8)%conc(k,j,i), &
10393	REAL( -999.0_wp, KIND = wp ), &
10394	BTEST( wall_flags_0(k,j,i), 0 ) )
10395	ENDDO
10396	ENDDO
10397	ENDDO
10398	ELSE
10399	DO i = nxl, nxr
10400	DO j = nys, nyn
10401	DO k = nzb, nzt+1
10402	local_pf(i,j,k) = MERGE( Nbins_av(k,j,i,8), &
10403	REAL( -999.0_wp, KIND = wp ), &
10404	BTEST( wall_flags_0(k,j,i), 0 ) )
10405	ENDDO
10406	ENDDO
10407	ENDDO
10408	ENDIF
10409
10410	CASE ( 'N_bin9' )
10411	IF ( av == 0 ) THEN
10412	DO i = nxl, nxr
10413	DO j = nys, nyn
10414	DO k = nzb, nzt+1
10415	local_pf(i,j,k) = MERGE( aerosol_number(9)%conc(k,j,i), &
10416	REAL( -999.0_wp, KIND = wp ), &
10417	BTEST( wall_flags_0(k,j,i), 0 ) )
10418	ENDDO
10419	ENDDO
10420	ENDDO
10421	ELSE
10422	DO i = nxl, nxr
10423	DO j = nys, nyn
10424	DO k = nzb, nzt+1
10425	local_pf(i,j,k) = MERGE( Nbins_av(k,j,i,9), &
10426	REAL( -999.0_wp, KIND = wp ), &
10427	BTEST( wall_flags_0(k,j,i), 0 ) )
10428	ENDDO
10429	ENDDO
10430	ENDDO
10431	ENDIF
10432
10433	CASE ( 'N_bin10' )
10434	IF ( av == 0 ) THEN
10435	DO i = nxl, nxr
10436	DO j = nys, nyn
10437	DO k = nzb, nzt+1
10438	local_pf(i,j,k) = MERGE( aerosol_number(10)%conc(k,j,i), &
10439	REAL( -999.0_wp, KIND = wp ), &
10440	BTEST( wall_flags_0(k,j,i), 0 ) )
10441	ENDDO
10442	ENDDO
10443	ENDDO
10444	ELSE
10445	DO i = nxl, nxr
10446	DO j = nys, nyn
10447	DO k = nzb, nzt+1
10448	local_pf(i,j,k) = MERGE( Nbins_av(k,j,i,10), &
10449	REAL( -999.0_wp, KIND = wp ), &
10450	BTEST( wall_flags_0(k,j,i), 0 ) )
10451	ENDDO
10452	ENDDO
10453	ENDDO
10454	ENDIF
10455
10456	CASE ( 'N_bin11' )
10457	IF ( av == 0 ) THEN
10458	DO i = nxl, nxr
10459	DO j = nys, nyn
10460	DO k = nzb, nzt+1
10461	local_pf(i,j,k) = MERGE( aerosol_number(11)%conc(k,j,i), &
10462	REAL( -999.0_wp, KIND = wp ), &
10463	BTEST( wall_flags_0(k,j,i), 0 ) )
10464	ENDDO
10465	ENDDO
10466	ENDDO
10467	ELSE
10468	DO i = nxl, nxr
10469	DO j = nys, nyn
10470	DO k = nzb, nzt+1
10471	local_pf(i,j,k) = MERGE( Nbins_av(k,j,i,11), &
10472	REAL( -999.0_wp, KIND = wp ), &
10473	BTEST( wall_flags_0(k,j,i), 0 ) )
10474	ENDDO
10475	ENDDO
10476	ENDDO
10477	ENDIF
10478
10479	CASE ( 'N_bin12' )
10480	IF ( av == 0 ) THEN
10481	DO i = nxl, nxr
10482	DO j = nys, nyn
10483	DO k = nzb, nzt+1
10484	local_pf(i,j,k) = MERGE( aerosol_number(12)%conc(k,j,i), &
10485	REAL( -999.0_wp, KIND = wp ), &
10486	BTEST( wall_flags_0(k,j,i), 0 ) )
10487	ENDDO
10488	ENDDO
10489	ENDDO
10490	ELSE
10491	DO i = nxl, nxr
10492	DO j = nys, nyn
10493	DO k = nzb, nzt+1
10494	local_pf(i,j,k) = MERGE( Nbins_av(k,j,i,12), &
10495	REAL( -999.0_wp, KIND = wp ), &
10496	BTEST( wall_flags_0(k,j,i), 0 ) )
10497	ENDDO
10498	ENDDO
10499	ENDDO
10500	ENDIF
10501
10502	CASE ( 'm_bin1' )
10503	IF ( av == 0 ) THEN
10504	DO i = nxl, nxr
10505	DO j = nys, nyn
10506	DO k = nzb, nzt+1
10507	temp_bin = 0.0_wp
10508	DO c = 1, ncc_tot*nbins, nbins
10509	temp_bin = temp_bin + aerosol_mass(c)%conc(k,j,i)
10510	ENDDO
10511	local_pf(i,j,k) = MERGE( temp_bin, &
10512	REAL( -999.0_wp, KIND = wp ), &
10513	BTEST( wall_flags_0(k,j,i), 0 ) )
10514	ENDDO
10515	ENDDO
10516	ENDDO
10517	ELSE
10518	DO i = nxl, nxr
10519	DO j = nys, nyn
10520	DO k = nzb, nzt+1
10521	local_pf(i,j,k) = MERGE( mbins_av(k,j,i,1), &
10522	REAL( -999.0_wp, KIND = wp ), &
10523	BTEST( wall_flags_0(k,j,i), 0 ) )
10524	ENDDO
10525	ENDDO
10526	ENDDO
10527	ENDIF
10528
10529	CASE ( 'm_bin2' )
10530	IF ( av == 0 ) THEN
10531	DO i = nxl, nxr
10532	DO j = nys, nyn
10533	DO k = nzb, nzt+1
10534	temp_bin = 0.0_wp
10535	DO c = 2, ncc_tot*nbins, nbins
10536	temp_bin = temp_bin + aerosol_mass(c)%conc(k,j,i)
10537	ENDDO
10538	local_pf(i,j,k) = MERGE( temp_bin, &
10539	REAL( -999.0_wp, KIND = wp ), &
10540	BTEST( wall_flags_0(k,j,i), 0 ) )
10541	ENDDO
10542	ENDDO
10543	ENDDO
10544	ELSE
10545	DO i = nxl, nxr
10546	DO j = nys, nyn
10547	DO k = nzb, nzt+1
10548	local_pf(i,j,k) = MERGE( mbins_av(k,j,i,2), &
10549	REAL( -999.0_wp, KIND = wp ), &
10550	BTEST( wall_flags_0(k,j,i), 0 ) )
10551	ENDDO
10552	ENDDO
10553	ENDDO
10554	ENDIF
10555
10556	CASE ( 'm_bin3' )
10557	IF ( av == 0 ) THEN
10558	DO i = nxl, nxr
10559	DO j = nys, nyn
10560	DO k = nzb, nzt+1
10561	temp_bin = 0.0_wp
10562	DO c = 3, ncc_tot*nbins, nbins
10563	temp_bin = temp_bin + aerosol_mass(c)%conc(k,j,i)
10564	ENDDO
10565	local_pf(i,j,k) = MERGE( temp_bin, &
10566	REAL( -999.0_wp, KIND = wp ), &
10567	BTEST( wall_flags_0(k,j,i), 0 ) )
10568	ENDDO
10569	ENDDO
10570	ENDDO
10571	ELSE
10572	DO i = nxl, nxr
10573	DO j = nys, nyn
10574	DO k = nzb, nzt+1
10575	local_pf(i,j,k) = MERGE( mbins_av(k,j,i,3), &
10576	REAL( -999.0_wp, KIND = wp ), &
10577	BTEST( wall_flags_0(k,j,i), 0 ) )
10578	ENDDO
10579	ENDDO
10580	ENDDO
10581	ENDIF
10582
10583	CASE ( 'm_bin4' )
10584	IF ( av == 0 ) THEN
10585	DO i = nxl, nxr
10586	DO j = nys, nyn
10587	DO k = nzb, nzt+1
10588	temp_bin = 0.0_wp
10589	DO c = 4, ncc_tot*nbins, nbins
10590	temp_bin = temp_bin + aerosol_mass(c)%conc(k,j,i)
10591	ENDDO
10592	local_pf(i,j,k) = MERGE( temp_bin, &
10593	REAL( -999.0_wp, KIND = wp ), &
10594	BTEST( wall_flags_0(k,j,i), 0 ) )
10595	ENDDO
10596	ENDDO
10597	ENDDO
10598	ELSE
10599	DO i = nxl, nxr
10600	DO j = nys, nyn
10601	DO k = nzb, nzt+1
10602	local_pf(i,j,k) = MERGE( mbins_av(k,j,i,4), &
10603	REAL( -999.0_wp, KIND = wp ), &
10604	BTEST( wall_flags_0(k,j,i), 0 ) )
10605	ENDDO
10606	ENDDO
10607	ENDDO
10608	ENDIF
10609
10610	CASE ( 'm_bin5' )
10611	IF ( av == 0 ) THEN
10612	DO i = nxl, nxr
10613	DO j = nys, nyn
10614	DO k = nzb, nzt+1
10615	temp_bin = 0.0_wp
10616	DO c = 5, ncc_tot*nbins, nbins
10617	temp_bin = temp_bin + aerosol_mass(c)%conc(k,j,i)
10618	ENDDO
10619	local_pf(i,j,k) = MERGE( temp_bin, &
10620	REAL( -999.0_wp, KIND = wp ), &
10621	BTEST( wall_flags_0(k,j,i), 0 ) )
10622	ENDDO
10623	ENDDO
10624	ENDDO
10625	ELSE
10626	DO i = nxl, nxr
10627	DO j = nys, nyn
10628	DO k = nzb, nzt+1
10629	local_pf(i,j,k) = MERGE( mbins_av(k,j,i,5), &
10630	REAL( -999.0_wp, KIND = wp ), &
10631	BTEST( wall_flags_0(k,j,i), 0 ) )
10632	ENDDO
10633	ENDDO
10634	ENDDO
10635	ENDIF
10636
10637	CASE ( 'm_bin6' )
10638	IF ( av == 0 ) THEN
10639	DO i = nxl, nxr
10640	DO j = nys, nyn
10641	DO k = nzb, nzt+1
10642	temp_bin = 0.0_wp
10643	DO c = 6, ncc_tot*nbins, nbins
10644	temp_bin = temp_bin + aerosol_mass(c)%conc(k,j,i)
10645	ENDDO
10646	local_pf(i,j,k) = MERGE( temp_bin, &
10647	REAL( -999.0_wp, KIND = wp ), &
10648	BTEST( wall_flags_0(k,j,i), 0 ) )
10649	ENDDO
10650	ENDDO
10651	ENDDO
10652	ELSE
10653	DO i = nxl, nxr
10654	DO j = nys, nyn
10655	DO k = nzb, nzt+1
10656	local_pf(i,j,k) = MERGE( mbins_av(k,j,i,6), &
10657	REAL( -999.0_wp, KIND = wp ), &
10658	BTEST( wall_flags_0(k,j,i), 0 ) )
10659	ENDDO
10660	ENDDO
10661	ENDDO
10662	ENDIF
10663
10664	CASE ( 'm_bin7' )
10665	IF ( av == 0 ) THEN
10666	DO i = nxl, nxr
10667	DO j = nys, nyn
10668	DO k = nzb, nzt+1
10669	temp_bin = 0.0_wp
10670	DO c = 7, ncc_tot*nbins, nbins
10671	temp_bin = temp_bin + aerosol_mass(c)%conc(k,j,i)
10672	ENDDO
10673	local_pf(i,j,k) = MERGE( temp_bin, &
10674	REAL( -999.0_wp, KIND = wp ), &
10675	BTEST( wall_flags_0(k,j,i), 0 ) )
10676	ENDDO
10677	ENDDO
10678	ENDDO
10679	ELSE
10680	DO i = nxl, nxr
10681	DO j = nys, nyn
10682	DO k = nzb, nzt+1
10683	local_pf(i,j,k) = MERGE( mbins_av(k,j,i,7), &
10684	REAL( -999.0_wp, KIND = wp ), &
10685	BTEST( wall_flags_0(k,j,i), 0 ) )
10686	ENDDO
10687	ENDDO
10688	ENDDO
10689	ENDIF
10690
10691	CASE ( 'm_bin8' )
10692	IF ( av == 0 ) THEN
10693	DO i = nxl, nxr
10694	DO j = nys, nyn
10695	DO k = nzb, nzt+1
10696	temp_bin = 0.0_wp
10697	DO c = 8, ncc_tot*nbins, nbins
10698	temp_bin = temp_bin + aerosol_mass(c)%conc(k,j,i)
10699	ENDDO
10700	local_pf(i,j,k) = MERGE( temp_bin, &
10701	REAL( -999.0_wp, KIND = wp ), &
10702	BTEST( wall_flags_0(k,j,i), 0 ) )
10703	ENDDO
10704	ENDDO
10705	ENDDO
10706	ELSE
10707	DO i = nxl, nxr
10708	DO j = nys, nyn
10709	DO k = nzb, nzt+1
10710	local_pf(i,j,k) = MERGE( mbins_av(k,j,i,8), &
10711	REAL( -999.0_wp, KIND = wp ), &
10712	BTEST( wall_flags_0(k,j,i), 0 ) )
10713	ENDDO
10714	ENDDO
10715	ENDDO
10716	ENDIF
10717
10718	CASE ( 'm_bin9' )
10719	IF ( av == 0 ) THEN
10720	DO i = nxl, nxr
10721	DO j = nys, nyn
10722	DO k = nzb, nzt+1
10723	temp_bin = 0.0_wp
10724	DO c = 9, ncc_tot*nbins, nbins
10725	temp_bin = temp_bin + aerosol_mass(c)%conc(k,j,i)
10726	ENDDO
10727	local_pf(i,j,k) = MERGE( temp_bin, &
10728	REAL( -999.0_wp, KIND = wp ), &
10729	BTEST( wall_flags_0(k,j,i), 0 ) )
10730	ENDDO
10731	ENDDO
10732	ENDDO
10733	ELSE
10734	DO i = nxl, nxr
10735	DO j = nys, nyn
10736	DO k = nzb, nzt+1
10737	local_pf(i,j,k) = MERGE( mbins_av(k,j,i,9), &
10738	REAL( -999.0_wp, KIND = wp ), &
10739	BTEST( wall_flags_0(k,j,i), 0 ) )
10740	ENDDO
10741	ENDDO
10742	ENDDO
10743	ENDIF
10744
10745	CASE ( 'm_bin10' )
10746	IF ( av == 0 ) THEN
10747	DO i = nxl, nxr
10748	DO j = nys, nyn
10749	DO k = nzb, nzt+1
10750	temp_bin = 0.0_wp
10751	DO c = 10, ncc_tot*nbins, nbins
10752	temp_bin = temp_bin + aerosol_mass(c)%conc(k,j,i)
10753	ENDDO
10754	local_pf(i,j,k) = MERGE( temp_bin, &
10755	REAL( -999.0_wp, KIND = wp ), &
10756	BTEST( wall_flags_0(k,j,i), 0 ) )
10757	ENDDO
10758	ENDDO
10759	ENDDO
10760	ELSE
10761	DO i = nxl, nxr
10762	DO j = nys, nyn
10763	DO k = nzb, nzt+1
10764	local_pf(i,j,k) = MERGE( mbins_av(k,j,i,10), &
10765	REAL( -999.0_wp, KIND = wp ), &
10766	BTEST( wall_flags_0(k,j,i), 0 ) )
10767	ENDDO
10768	ENDDO
10769	ENDDO
10770	ENDIF
10771
10772	CASE ( 'm_bin11' )
10773	IF ( av == 0 ) THEN
10774	DO i = nxl, nxr
10775	DO j = nys, nyn
10776	DO k = nzb, nzt+1
10777	temp_bin = 0.0_wp
10778	DO c = 11, ncc_tot*nbins, nbins
10779	temp_bin = temp_bin + aerosol_mass(c)%conc(k,j,i)
10780	ENDDO
10781	local_pf(i,j,k) = MERGE( temp_bin, &
10782	REAL( -999.0_wp, KIND = wp ), &
10783	BTEST( wall_flags_0(k,j,i), 0 ) )
10784	ENDDO
10785	ENDDO
10786	ENDDO
10787	ELSE
10788	DO i = nxl, nxr
10789	DO j = nys, nyn
10790	DO k = nzb, nzt+1
10791	local_pf(i,j,k) = MERGE( mbins_av(k,j,i,11), &
10792	REAL( -999.0_wp, KIND = wp ), &
10793	BTEST( wall_flags_0(k,j,i), 0 ) )
10794	ENDDO
10795	ENDDO
10796	ENDDO
10797	ENDIF
10798
10799	CASE ( 'm_bin12' )
10800	IF ( av == 0 ) THEN
10801	DO i = nxl, nxr
10802	DO j = nys, nyn
10803	DO k = nzb, nzt+1
10804	temp_bin = 0.0_wp
10805	DO c = 12, ncc_tot*nbins, nbins
10806	temp_bin = temp_bin + aerosol_mass(c)%conc(k,j,i)
10807	ENDDO
10808	local_pf(i,j,k) = MERGE( temp_bin, &
10809	REAL( -999.0_wp, KIND = wp ), &
10810	BTEST( wall_flags_0(k,j,i), 0 ) )
10811	ENDDO
10812	ENDDO
10813	ENDDO
10814	ELSE
10815	DO i = nxl, nxr
10816	DO j = nys, nyn
10817	DO k = nzb, nzt+1
10818	local_pf(i,j,k) = MERGE( mbins_av(k,j,i,12), &
10819	REAL( -999.0_wp, KIND = wp ), &
10820	BTEST( wall_flags_0(k,j,i), 0 ) )
10821	ENDDO
10822	ENDDO
10823	ENDDO
10824	ENDIF
10825
10826	CASE ( 's_BC', 's_DU', 's_H2O', 's_NH', 's_NO', 's_OC', 's_SO4', 's_SS' )
10827	IF ( is_used( prtcl, TRIM( variable(3:) ) ) ) THEN
10828	icc = get_index( prtcl, TRIM( variable(3:) ) )
10829	IF ( av == 0 ) THEN
10830	DO i = nxl, nxr
10831	DO j = nys, nyn
10832	DO k = nzb, nzt+1
10833	temp_bin = 0.0_wp
10834	DO c = ( icc-1 )nbins+1, iccnbins
10835	temp_bin = temp_bin + aerosol_mass(c)%conc(k,j,i)
10836	ENDDO
10837	local_pf(i,j,k) = MERGE( temp_bin, &
10838	REAL( -999.0_wp, KIND = wp ), &
10839	BTEST( wall_flags_0(k,j,i), 0 ) )
10840	ENDDO
10841	ENDDO
10842	ENDDO
10843	ELSE
10844	IF ( TRIM( variable(3:) ) == 'BC' ) to_be_resorted => s_BC_av
10845	IF ( TRIM( variable(3:) ) == 'DU' ) to_be_resorted => s_DU_av
10846	IF ( TRIM( variable(3:) ) == 'NH' ) to_be_resorted => s_NH_av
10847	IF ( TRIM( variable(3:) ) == 'NO' ) to_be_resorted => s_NO_av
10848	IF ( TRIM( variable(3:) ) == 'OC' ) to_be_resorted => s_OC_av
10849	IF ( TRIM( variable(3:) ) == 'SO4' ) to_be_resorted => s_SO4_av
10850	IF ( TRIM( variable(3:) ) == 'SS' ) to_be_resorted => s_SS_av
10851	DO i = nxl, nxr
10852	DO j = nys, nyn
10853	DO k = nzb, nzt+1
10854	local_pf(i,j,k) = MERGE( to_be_resorted(k,j,i), &
10855	REAL( -999.0_wp, KIND = wp ), &
10856	BTEST( wall_flags_0(k,j,i), 0 ) )
10857	ENDDO
10858	ENDDO
10859	ENDDO
10860	ENDIF
10861	ENDIF
10862	CASE DEFAULT
10863	found = .FALSE.
10864
10865	END SELECT
10866
10867	END SUBROUTINE salsa_data_output_3d
10868
10869	!------------------------------------------------------------------------------!
10870	!
10871	! Description:
10872	! ------------
10873	!> Subroutine defining mask output variables
10874	!------------------------------------------------------------------------------!
10875	SUBROUTINE salsa_data_output_mask( av, variable, found, local_pf )
10876
10877	USE control_parameters, &
10878	ONLY: mask_size_l, mid
10879
10880	IMPLICIT NONE
10881
10882	CHARACTER (LEN=*) :: variable !<
10883
10884	INTEGER(iwp) :: av !<
10885	INTEGER(iwp) :: c !<
10886	INTEGER(iwp) :: i !<
10887	INTEGER(iwp) :: icc !< index of a chemical compound
10888	INTEGER(iwp) :: j !<
10889	INTEGER(iwp) :: k !<
10890	INTEGER(iwp) :: n !<
10891
10892	LOGICAL :: found !<
10893	REAL(wp) :: df !< For calculating LDSA: fraction of particles
10894	!< depositing in the alveolar (or tracheobronchial)
10895	!< region of the lung. Depends on the particle size
10896	REAL(wp) :: mean_d !< Particle diameter in micrometres
10897	REAL(wp) :: nc !< Particle number concentration in units 1/cm**3
10898
10899	REAL(wp), &
10900	DIMENSION(mask_size_l(mid,1),mask_size_l(mid,2),mask_size_l(mid,3)) :: &
10901	local_pf !<
10902	REAL(wp) :: temp_bin !<
10903	REAL(wp), DIMENSION(:,:,:), POINTER :: to_be_resorted !< points to
10904	!< selected output variable
10905
10906	found = .TRUE.
10907	temp_bin = 0.0_wp
10908
10909	SELECT CASE ( TRIM( variable ) )
10910
10911	CASE ( 'g_H2SO4', 'g_HNO3', 'g_NH3', 'g_OCNV', 'g_OCSV' )
10912	IF ( av == 0 ) THEN
10913	IF ( TRIM( variable ) == 'g_H2SO4') icc = 1
10914	IF ( TRIM( variable ) == 'g_HNO3') icc = 2
10915	IF ( TRIM( variable ) == 'g_NH3') icc = 3
10916	IF ( TRIM( variable ) == 'g_OCNV') icc = 4
10917	IF ( TRIM( variable ) == 'g_OCSV') icc = 5
10918
10919	DO i = 1, mask_size_l(mid,1)
10920	DO j = 1, mask_size_l(mid,2)
10921	DO k = 1, mask_size_l(mid,3)
10922	local_pf(i,j,k) = salsa_gas(icc)%conc(mask_k(mid,k), &
10923	mask_j(mid,j),mask_i(mid,i))
10924	ENDDO
10925	ENDDO
10926	ENDDO
10927	ELSE
10928	IF ( TRIM( variable(3:) ) == 'H2SO4' ) to_be_resorted => g_H2SO4_av
10929	IF ( TRIM( variable(3:) ) == 'HNO3' ) to_be_resorted => g_HNO3_av
10930	IF ( TRIM( variable(3:) ) == 'NH3' ) to_be_resorted => g_NH3_av
10931	IF ( TRIM( variable(3:) ) == 'OCNV' ) to_be_resorted => g_OCNV_av
10932	IF ( TRIM( variable(3:) ) == 'OCSV' ) to_be_resorted => g_OCSV_av
10933	DO i = 1, mask_size_l(mid,1)
10934	DO j = 1, mask_size_l(mid,2)
10935	DO k = 1, mask_size_l(mid,3)
10936	local_pf(i,j,k) = to_be_resorted(mask_k(mid,k), &
10937	mask_j(mid,j),mask_i(mid,i))
10938	ENDDO
10939	ENDDO
10940	ENDDO
10941	ENDIF
10942
10943	CASE ( 'LDSA' )
10944	IF ( av == 0 ) THEN
10945	DO i = 1, mask_size_l(mid,1)
10946	DO j = 1, mask_size_l(mid,2)
10947	DO k = 1, mask_size_l(mid,3)
10948	temp_bin = 0.0_wp
10949	DO n = 1, nbins
10950	!
10951	!-- Diameter in micrometres
10952	mean_d = 1.0E+6_wp * Ra_dry(mask_k(mid,k), &
10953	mask_j(mid,j),mask_i(mid,i),n) * 2.0_wp
10954	!
10955	!-- Deposition factor: alveolar (use Ra_dry for the size??)
10956	df = ( 0.01555_wp / mean_d ) * ( EXP( -0.416_wp * &
10957	( LOG( mean_d ) + 2.84_wp )**2.0_wp ) &
10958	+ 19.11_wp * EXP( -0.482_wp * &
10959	( LOG( mean_d ) - 1.362_wp )**2.0_wp ) )
10960	!
10961	!-- Number concentration in 1/cm3
10962	nc = 1.0E-6_wp * aerosol_number(n)%conc(mask_k(mid,k),&
10963	mask_j(mid,j),mask_i(mid,i))
10964	!
10965	!-- Lung-deposited surface area LDSA (units mum2/cm3)
10966	temp_bin = temp_bin + pi * mean_d*2.0_wp df * nc
10967	ENDDO
10968	local_pf(i,j,k) = temp_bin
10969	ENDDO
10970	ENDDO
10971	ENDDO
10972	ELSE
10973	DO i = 1, mask_size_l(mid,1)
10974	DO j = 1, mask_size_l(mid,2)
10975	DO k = 1, mask_size_l(mid,3)
10976	local_pf(i,j,k) = LDSA_av(mask_k(mid,k), &
10977	mask_j(mid,j),mask_i(mid,i))
10978	ENDDO
10979	ENDDO
10980	ENDDO
10981	ENDIF
10982
10983	CASE ( 'Ntot' )
10984	IF ( av == 0 ) THEN
10985	DO i = 1, mask_size_l(mid,1)
10986	DO j = 1, mask_size_l(mid,2)
10987	DO k = 1, mask_size_l(mid,3)
10988	temp_bin = 0.0_wp
10989	DO n = 1, nbins
10990	temp_bin = temp_bin + aerosol_number(n)%conc( &
10991	mask_k(mid,k),mask_j(mid,j),mask_i(mid,i))
10992	ENDDO
10993	local_pf(i,j,k) = temp_bin
10994	ENDDO
10995	ENDDO
10996	ENDDO
10997	ELSE
10998	DO i = 1, mask_size_l(mid,1)
10999	DO j = 1, mask_size_l(mid,2)
11000	DO k = 1, mask_size_l(mid,3)
11001	local_pf(i,j,k) = Ntot_av(mask_k(mid,k), &
11002	mask_j(mid,j),mask_i(mid,i))
11003	ENDDO
11004	ENDDO
11005	ENDDO
11006	ENDIF
11007
11008	CASE ( 'PM2.5' )
11009	IF ( av == 0 ) THEN
11010	DO i = 1, mask_size_l(mid,1)
11011	DO j = 1, mask_size_l(mid,2)
11012	DO k = 1, mask_size_l(mid,3)
11013	temp_bin = 0.0_wp
11014	DO n = 1, nbins
11015	IF ( 2.0_wp * Ra_dry(mask_k(mid,k),mask_j(mid,j), &
11016	mask_i(mid,i),n) <= 2.5E-6_wp ) THEN
11017	DO c = n, nbins*ncc, nbins
11018	temp_bin = temp_bin + aerosol_mass(c)%conc( &
11019	mask_k(mid,k), mask_j(mid,j),mask_i(mid,i))
11020	ENDDO
11021	ENDIF
11022	ENDDO
11023	local_pf(i,j,k) = temp_bin
11024	ENDDO
11025	ENDDO
11026	ENDDO
11027	ELSE
11028	DO i = 1, mask_size_l(mid,1)
11029	DO j = 1, mask_size_l(mid,2)
11030	DO k = 1, mask_size_l(mid,3)
11031	local_pf(i,j,k) = PM25_av(mask_k(mid,k), &
11032	mask_j(mid,j),mask_i(mid,i))
11033	ENDDO
11034	ENDDO
11035	ENDDO
11036	ENDIF
11037
11038	CASE ( 'PM10' )
11039	IF ( av == 0 ) THEN
11040	DO i = 1, mask_size_l(mid,1)
11041	DO j = 1, mask_size_l(mid,2)
11042	DO k = 1, mask_size_l(mid,3)
11043	temp_bin = 0.0_wp
11044	DO n = 1, nbins
11045	IF ( 2.0_wp * Ra_dry(mask_k(mid,k),mask_j(mid,j), &
11046	mask_i(mid,i),n) <= 10.0E-6_wp ) THEN
11047	DO c = n, nbins*ncc, nbins
11048	temp_bin = temp_bin + aerosol_mass(c)%conc( &
11049	mask_k(mid,k),mask_j(mid,j),mask_i(mid,i))
11050	ENDDO
11051	ENDIF
11052	ENDDO
11053	local_pf(i,j,k) = temp_bin
11054	ENDDO
11055	ENDDO
11056	ENDDO
11057	ELSE
11058	DO i = 1, mask_size_l(mid,1)
11059	DO j = 1, mask_size_l(mid,2)
11060	DO k = 1, mask_size_l(mid,3)
11061	local_pf(i,j,k) = PM10_av(mask_k(mid,k), &
11062	mask_j(mid,j),mask_i(mid,i))
11063	ENDDO
11064	ENDDO
11065	ENDDO
11066	ENDIF
11067
11068	CASE ( 'N_bin1' )
11069	IF ( av == 0 ) THEN
11070	DO i = 1, mask_size_l(mid,1)
11071	DO j = 1, mask_size_l(mid,2)
11072	DO k = 1, mask_size_l(mid,3)
11073	local_pf(i,j,k) = aerosol_number(1)%conc(mask_k(mid,k), &
11074	mask_j(mid,j),mask_i(mid,i))
11075	ENDDO
11076	ENDDO
11077	ENDDO
11078	ELSE
11079	DO i = 1, mask_size_l(mid,1)
11080	DO j = 1, mask_size_l(mid,2)
11081	DO k = 1, mask_size_l(mid,3)
11082	local_pf(i,j,k) = Nbins_av(mask_k(mid,k), &
11083	mask_j(mid,j),mask_i(mid,i),1)
11084	ENDDO
11085	ENDDO
11086	ENDDO
11087	ENDIF
11088
11089	CASE ( 'N_bin2' )
11090	IF ( av == 0 ) THEN
11091	DO i = 1, mask_size_l(mid,1)
11092	DO j = 1, mask_size_l(mid,2)
11093	DO k = 1, mask_size_l(mid,3)
11094	local_pf(i,j,k) = aerosol_number(2)%conc(mask_k(mid,k), &
11095	mask_j(mid,j),mask_i(mid,i))
11096	ENDDO
11097	ENDDO
11098	ENDDO
11099	ELSE
11100	DO i = 1, mask_size_l(mid,1)
11101	DO j = 1, mask_size_l(mid,2)
11102	DO k = 1, mask_size_l(mid,3)
11103	local_pf(i,j,k) = Nbins_av(mask_k(mid,k), &
11104	mask_j(mid,j),mask_i(mid,i),2)
11105	ENDDO
11106	ENDDO
11107	ENDDO
11108	ENDIF
11109
11110	CASE ( 'N_bin3' )
11111	IF ( av == 0 ) THEN
11112	DO i = 1, mask_size_l(mid,1)
11113	DO j = 1, mask_size_l(mid,2)
11114	DO k = 1, mask_size_l(mid,3)
11115	local_pf(i,j,k) = aerosol_number(3)%conc(mask_k(mid,k), &
11116	mask_j(mid,j),mask_i(mid,i))
11117	ENDDO
11118	ENDDO
11119	ENDDO
11120	ELSE
11121	DO i = 1, mask_size_l(mid,1)
11122	DO j = 1, mask_size_l(mid,2)
11123	DO k = 1, mask_size_l(mid,3)
11124	local_pf(i,j,k) = Nbins_av(mask_k(mid,k), &
11125	mask_j(mid,j),mask_i(mid,i),3)
11126	ENDDO
11127	ENDDO
11128	ENDDO
11129	ENDIF
11130
11131	CASE ( 'N_bin4' )
11132	IF ( av == 0 ) THEN
11133	DO i = 1, mask_size_l(mid,1)
11134	DO j = 1, mask_size_l(mid,2)
11135	DO k = 1, mask_size_l(mid,3)
11136	local_pf(i,j,k) = aerosol_number(4)%conc(mask_k(mid,k), &
11137	mask_j(mid,j),mask_i(mid,i))
11138	ENDDO
11139	ENDDO
11140	ENDDO
11141	ELSE
11142	DO i = 1, mask_size_l(mid,1)
11143	DO j = 1, mask_size_l(mid,2)
11144	DO k = 1, mask_size_l(mid,3)
11145	local_pf(i,j,k) = Nbins_av(mask_k(mid,k), &
11146	mask_j(mid,j),mask_i(mid,i),4)
11147	ENDDO
11148	ENDDO
11149	ENDDO
11150	ENDIF
11151
11152	CASE ( 'N_bin5' )
11153	IF ( av == 0 ) THEN
11154	DO i = 1, mask_size_l(mid,1)
11155	DO j = 1, mask_size_l(mid,2)
11156	DO k = 1, mask_size_l(mid,3)
11157	local_pf(i,j,k) = aerosol_number(5)%conc(mask_k(mid,k), &
11158	mask_j(mid,j),mask_i(mid,i))
11159	ENDDO
11160	ENDDO
11161	ENDDO
11162	ELSE
11163	DO i = 1, mask_size_l(mid,1)
11164	DO j = 1, mask_size_l(mid,2)
11165	DO k = 1, mask_size_l(mid,3)
11166	local_pf(i,j,k) = Nbins_av(mask_k(mid,k), &
11167	mask_j(mid,j),mask_i(mid,i),5)
11168	ENDDO
11169	ENDDO
11170	ENDDO
11171	ENDIF
11172
11173	CASE ( 'N_bin6' )
11174	IF ( av == 0 ) THEN
11175	DO i = 1, mask_size_l(mid,1)
11176	DO j = 1, mask_size_l(mid,2)
11177	DO k = 1, mask_size_l(mid,3)
11178	local_pf(i,j,k) = aerosol_number(6)%conc(mask_k(mid,k), &
11179	mask_j(mid,j),mask_i(mid,i))
11180	ENDDO
11181	ENDDO
11182	ENDDO
11183	ELSE
11184	DO i = 1, mask_size_l(mid,1)
11185	DO j = 1, mask_size_l(mid,2)
11186	DO k = 1, mask_size_l(mid,3)
11187	local_pf(i,j,k) = Nbins_av(mask_k(mid,k), &
11188	mask_j(mid,j),mask_i(mid,i),6)
11189	ENDDO
11190	ENDDO
11191	ENDDO
11192	ENDIF
11193
11194	CASE ( 'N_bin7' )
11195	IF ( av == 0 ) THEN
11196	DO i = 1, mask_size_l(mid,1)
11197	DO j = 1, mask_size_l(mid,2)
11198	DO k = 1, mask_size_l(mid,3)
11199	local_pf(i,j,k) = aerosol_number(7)%conc(mask_k(mid,k), &
11200	mask_j(mid,j),mask_i(mid,i))
11201	ENDDO
11202	ENDDO
11203	ENDDO
11204	ELSE
11205	DO i = 1, mask_size_l(mid,1)
11206	DO j = 1, mask_size_l(mid,2)
11207	DO k = 1, mask_size_l(mid,3)
11208	local_pf(i,j,k) = Nbins_av(mask_k(mid,k), &
11209	mask_j(mid,j),mask_i(mid,i),7)
11210	ENDDO
11211	ENDDO
11212	ENDDO
11213	ENDIF
11214
11215	CASE ( 'N_bin8' )
11216	IF ( av == 0 ) THEN
11217	DO i = 1, mask_size_l(mid,1)
11218	DO j = 1, mask_size_l(mid,2)
11219	DO k = 1, mask_size_l(mid,3)
11220	local_pf(i,j,k) = aerosol_number(8)%conc(mask_k(mid,k), &
11221	mask_j(mid,j),mask_i(mid,i))
11222	ENDDO
11223	ENDDO
11224	ENDDO
11225	ELSE
11226	DO i = 1, mask_size_l(mid,1)
11227	DO j = 1, mask_size_l(mid,2)
11228	DO k = 1, mask_size_l(mid,3)
11229	local_pf(i,j,k) = Nbins_av(mask_k(mid,k), &
11230	mask_j(mid,j),mask_i(mid,i),8)
11231	ENDDO
11232	ENDDO
11233	ENDDO
11234	ENDIF
11235
11236	CASE ( 'N_bin9' )
11237	IF ( av == 0 ) THEN
11238	DO i = 1, mask_size_l(mid,1)
11239	DO j = 1, mask_size_l(mid,2)
11240	DO k = 1, mask_size_l(mid,3)
11241	local_pf(i,j,k) = aerosol_number(9)%conc(mask_k(mid,k), &
11242	mask_j(mid,j),mask_i(mid,i))
11243	ENDDO
11244	ENDDO
11245	ENDDO
11246	ELSE
11247	DO i = 1, mask_size_l(mid,1)
11248	DO j = 1, mask_size_l(mid,2)
11249	DO k = 1, mask_size_l(mid,3)
11250	local_pf(i,j,k) = Nbins_av(mask_k(mid,k), &
11251	mask_j(mid,j),mask_i(mid,i),9)
11252	ENDDO
11253	ENDDO
11254	ENDDO
11255	ENDIF
11256
11257	CASE ( 'N_bin10' )
11258	IF ( av == 0 ) THEN
11259	DO i = 1, mask_size_l(mid,1)
11260	DO j = 1, mask_size_l(mid,2)
11261	DO k = 1, mask_size_l(mid,3)
11262	local_pf(i,j,k) = aerosol_number(10)%conc(mask_k(mid,k), &
11263	mask_j(mid,j),mask_i(mid,i))
11264	ENDDO
11265	ENDDO
11266	ENDDO
11267	ELSE
11268	DO i = 1, mask_size_l(mid,1)
11269	DO j = 1, mask_size_l(mid,2)
11270	DO k = 1, mask_size_l(mid,3)
11271	local_pf(i,j,k) = Nbins_av(mask_k(mid,k), &
11272	mask_j(mid,j),mask_i(mid,i),10)
11273	ENDDO
11274	ENDDO
11275	ENDDO
11276	ENDIF
11277
11278	CASE ( 'N_bin11' )
11279	IF ( av == 0 ) THEN
11280	DO i = 1, mask_size_l(mid,1)
11281	DO j = 1, mask_size_l(mid,2)
11282	DO k = 1, mask_size_l(mid,3)
11283	local_pf(i,j,k) = aerosol_number(11)%conc(mask_k(mid,k), &
11284	mask_j(mid,j),mask_i(mid,i))
11285	ENDDO
11286	ENDDO
11287	ENDDO
11288	ELSE
11289	DO i = 1, mask_size_l(mid,1)
11290	DO j = 1, mask_size_l(mid,2)
11291	DO k = 1, mask_size_l(mid,3)
11292	local_pf(i,j,k) = Nbins_av(mask_k(mid,k), &
11293	mask_j(mid,j),mask_i(mid,i),11)
11294	ENDDO
11295	ENDDO
11296	ENDDO
11297	ENDIF
11298
11299	CASE ( 'N_bin12' )
11300	IF ( av == 0 ) THEN
11301	DO i = 1, mask_size_l(mid,1)
11302	DO j = 1, mask_size_l(mid,2)
11303	DO k = 1, mask_size_l(mid,3)
11304	local_pf(i,j,k) = aerosol_number(12)%conc(mask_k(mid,k), &
11305	mask_j(mid,j),mask_i(mid,i))
11306	ENDDO
11307	ENDDO
11308	ENDDO
11309	ELSE
11310	DO i = 1, mask_size_l(mid,1)
11311	DO j = 1, mask_size_l(mid,2)
11312	DO k = 1, mask_size_l(mid,3)
11313	local_pf(i,j,k) = Nbins_av(mask_k(mid,k), &
11314	mask_j(mid,j),mask_i(mid,i),12)
11315	ENDDO
11316	ENDDO
11317	ENDDO
11318	ENDIF
11319
11320	CASE ( 'm_bin1' )
11321	IF ( av == 0 ) THEN
11322	DO i = 1, mask_size_l(mid,1)
11323	DO j = 1, mask_size_l(mid,2)
11324	DO k = 1, mask_size_l(mid,3)
11325	temp_bin = 0.0_wp
11326	DO c = 1, ncc_tot*nbins, nbins
11327	temp_bin = temp_bin + aerosol_mass(c)%conc( &
11328	mask_k(mid,k),mask_j(mid,j),mask_i(mid,i))
11329	ENDDO
11330	local_pf(i,j,k) = temp_bin
11331	ENDDO
11332	ENDDO
11333	ENDDO
11334	ELSE
11335	DO i = 1, mask_size_l(mid,1)
11336	DO j = 1, mask_size_l(mid,2)
11337	DO k = 1, mask_size_l(mid,3)
11338	local_pf(i,j,k) = mbins_av(mask_k(mid,k), &
11339	mask_j(mid,j),mask_i(mid,i),1)
11340	ENDDO
11341	ENDDO
11342	ENDDO
11343	ENDIF
11344
11345	CASE ( 'm_bin2' )
11346	IF ( av == 0 ) THEN
11347	DO i = 1, mask_size_l(mid,1)
11348	DO j = 1, mask_size_l(mid,2)
11349	DO k = 1, mask_size_l(mid,3)
11350	temp_bin = 0.0_wp
11351	DO c = 2, ncc_tot*nbins, nbins
11352	temp_bin = temp_bin + aerosol_mass(c)%conc( &
11353	mask_k(mid,k),mask_j(mid,j),mask_i(mid,i))
11354	ENDDO
11355	local_pf(i,j,k) = temp_bin
11356	ENDDO
11357	ENDDO
11358	ENDDO
11359	ELSE
11360	DO i = 1, mask_size_l(mid,1)
11361	DO j = 1, mask_size_l(mid,2)
11362	DO k = 1, mask_size_l(mid,3)
11363	local_pf(i,j,k) = mbins_av(mask_k(mid,k), &
11364	mask_j(mid,j),mask_i(mid,i),2)
11365	ENDDO
11366	ENDDO
11367	ENDDO
11368	ENDIF
11369
11370	CASE ( 'm_bin3' )
11371	IF ( av == 0 ) THEN
11372	DO i = 1, mask_size_l(mid,1)
11373	DO j = 1, mask_size_l(mid,2)
11374	DO k = 1, mask_size_l(mid,3)
11375	temp_bin = 0.0_wp
11376	DO c = 3, ncc_tot*nbins, nbins
11377	temp_bin = temp_bin + aerosol_mass(c)%conc( &
11378	mask_k(mid,k),mask_j(mid,j),mask_i(mid,i))
11379	ENDDO
11380	local_pf(i,j,k) = temp_bin
11381	ENDDO
11382	ENDDO
11383	ENDDO
11384	ELSE
11385	DO i = 1, mask_size_l(mid,1)
11386	DO j = 1, mask_size_l(mid,2)
11387	DO k = 1, mask_size_l(mid,3)
11388	local_pf(i,j,k) = mbins_av(mask_k(mid,k), &
11389	mask_j(mid,j),mask_i(mid,i),3)
11390	ENDDO
11391	ENDDO
11392	ENDDO
11393	ENDIF
11394
11395	CASE ( 'm_bin4' )
11396	IF ( av == 0 ) THEN
11397	DO i = 1, mask_size_l(mid,1)
11398	DO j = 1, mask_size_l(mid,2)
11399	DO k = 1, mask_size_l(mid,3)
11400	temp_bin = 0.0_wp
11401	DO c = 4, ncc_tot*nbins, nbins
11402	temp_bin = temp_bin + aerosol_mass(c)%conc( &
11403	mask_k(mid,k),mask_j(mid,j),mask_i(mid,i))
11404	ENDDO
11405	local_pf(i,j,k) = temp_bin
11406	ENDDO
11407	ENDDO
11408	ENDDO
11409	ELSE
11410	DO i = 1, mask_size_l(mid,1)
11411	DO j = 1, mask_size_l(mid,2)
11412	DO k = 1, mask_size_l(mid,3)
11413	local_pf(i,j,k) = mbins_av(mask_k(mid,k), &
11414	mask_j(mid,j),mask_i(mid,i),4)
11415	ENDDO
11416	ENDDO
11417	ENDDO
11418	ENDIF
11419
11420	CASE ( 'm_bin5' )
11421	IF ( av == 0 ) THEN
11422	DO i = 1, mask_size_l(mid,1)
11423	DO j = 1, mask_size_l(mid,2)
11424	DO k = 1, mask_size_l(mid,3)
11425	temp_bin = 0.0_wp
11426	DO c = 5, ncc_tot*nbins, nbins
11427	temp_bin = temp_bin + aerosol_mass(c)%conc( &
11428	mask_k(mid,k),mask_j(mid,j),mask_i(mid,i))
11429	ENDDO
11430	local_pf(i,j,k) = temp_bin
11431	ENDDO
11432	ENDDO
11433	ENDDO
11434	ELSE
11435	DO i = 1, mask_size_l(mid,1)
11436	DO j = 1, mask_size_l(mid,2)
11437	DO k = 1, mask_size_l(mid,3)
11438	local_pf(i,j,k) = mbins_av(mask_k(mid,k), &
11439	mask_j(mid,j),mask_i(mid,i),5)
11440	ENDDO
11441	ENDDO
11442	ENDDO
11443	ENDIF
11444
11445	CASE ( 'm_bin6' )
11446	IF ( av == 0 ) THEN
11447	DO i = 1, mask_size_l(mid,1)
11448	DO j = 1, mask_size_l(mid,2)
11449	DO k = 1, mask_size_l(mid,3)
11450	temp_bin = 0.0_wp
11451	DO c = 6, ncc_tot*nbins, nbins
11452	temp_bin = temp_bin + aerosol_mass(c)%conc( &
11453	mask_k(mid,k),mask_j(mid,j),mask_i(mid,i))
11454	ENDDO
11455	local_pf(i,j,k) = temp_bin
11456	ENDDO
11457	ENDDO
11458	ENDDO
11459	ELSE
11460	DO i = 1, mask_size_l(mid,1)
11461	DO j = 1, mask_size_l(mid,2)
11462	DO k = 1, mask_size_l(mid,3)
11463	local_pf(i,j,k) = mbins_av(mask_k(mid,k), &
11464	mask_j(mid,j),mask_i(mid,i),6)
11465	ENDDO
11466	ENDDO
11467	ENDDO
11468	ENDIF
11469
11470	CASE ( 'm_bin7' )
11471	IF ( av == 0 ) THEN
11472	DO i = 1, mask_size_l(mid,1)
11473	DO j = 1, mask_size_l(mid,2)
11474	DO k = 1, mask_size_l(mid,3)
11475	temp_bin = 0.0_wp
11476	DO c = 7, ncc_tot*nbins, nbins
11477	temp_bin = temp_bin + aerosol_mass(c)%conc( &
11478	mask_k(mid,k),mask_j(mid,j),mask_i(mid,i))
11479	ENDDO
11480	local_pf(i,j,k) = temp_bin
11481	ENDDO
11482	ENDDO
11483	ENDDO
11484	ELSE
11485	DO i = 1, mask_size_l(mid,1)
11486	DO j = 1, mask_size_l(mid,2)
11487	DO k = 1, mask_size_l(mid,3)
11488	local_pf(i,j,k) = mbins_av(mask_k(mid,k), &
11489	mask_j(mid,j),mask_i(mid,i),7)
11490	ENDDO
11491	ENDDO
11492	ENDDO
11493	ENDIF
11494
11495	CASE ( 'm_bin8' )
11496	IF ( av == 0 ) THEN
11497	DO i = 1, mask_size_l(mid,1)
11498	DO j = 1, mask_size_l(mid,2)
11499	DO k = 1, mask_size_l(mid,3)
11500	temp_bin = 0.0_wp
11501	DO c = 8, ncc_tot*nbins, nbins
11502	temp_bin = temp_bin + aerosol_mass(c)%conc( &
11503	mask_k(mid,k),mask_j(mid,j),mask_i(mid,i))
11504	ENDDO
11505	local_pf(i,j,k) = temp_bin
11506	ENDDO
11507	ENDDO
11508	ENDDO
11509	ELSE
11510	DO i = 1, mask_size_l(mid,1)
11511	DO j = 1, mask_size_l(mid,2)
11512	DO k = 1, mask_size_l(mid,3)
11513	local_pf(i,j,k) = mbins_av(mask_k(mid,k), &
11514	mask_j(mid,j),mask_i(mid,i),8)
11515	ENDDO
11516	ENDDO
11517	ENDDO
11518	ENDIF
11519
11520	CASE ( 'm_bin9' )
11521	IF ( av == 0 ) THEN
11522	DO i = 1, mask_size_l(mid,1)
11523	DO j = 1, mask_size_l(mid,2)
11524	DO k = 1, mask_size_l(mid,3)
11525	temp_bin = 0.0_wp
11526	DO c = 9, ncc_tot*nbins, nbins
11527	temp_bin = temp_bin + aerosol_mass(c)%conc( &
11528	mask_k(mid,k),mask_j(mid,j),mask_i(mid,i))
11529	ENDDO
11530	local_pf(i,j,k) = temp_bin
11531	ENDDO
11532	ENDDO
11533	ENDDO
11534	ELSE
11535	DO i = 1, mask_size_l(mid,1)
11536	DO j = 1, mask_size_l(mid,2)
11537	DO k = 1, mask_size_l(mid,3)
11538	local_pf(i,j,k) = mbins_av(mask_k(mid,k), &
11539	mask_j(mid,j),mask_i(mid,i),9)
11540	ENDDO
11541	ENDDO
11542	ENDDO
11543	ENDIF
11544
11545	CASE ( 'm_bin10' )
11546	IF ( av == 0 ) THEN
11547	DO i = 1, mask_size_l(mid,1)
11548	DO j = 1, mask_size_l(mid,2)
11549	DO k = 1, mask_size_l(mid,3)
11550	temp_bin = 0.0_wp
11551	DO c = 10, ncc_tot*nbins, nbins
11552	temp_bin = temp_bin + aerosol_mass(c)%conc( &
11553	mask_k(mid,k),mask_j(mid,j),mask_i(mid,i))
11554	ENDDO
11555	local_pf(i,j,k) = temp_bin
11556	ENDDO
11557	ENDDO
11558	ENDDO
11559	ELSE
11560	DO i = 1, mask_size_l(mid,1)
11561	DO j = 1, mask_size_l(mid,2)
11562	DO k = 1, mask_size_l(mid,3)
11563	local_pf(i,j,k) = mbins_av(mask_k(mid,k), &
11564	mask_j(mid,j),mask_i(mid,i),10)
11565	ENDDO
11566	ENDDO
11567	ENDDO
11568	ENDIF
11569
11570	CASE ( 'm_bin11' )
11571	IF ( av == 0 ) THEN
11572	DO i = 1, mask_size_l(mid,1)
11573	DO j = 1, mask_size_l(mid,2)
11574	DO k = 1, mask_size_l(mid,3)
11575	temp_bin = 0.0_wp
11576	DO c = 11, ncc_tot*nbins, nbins
11577	temp_bin = temp_bin + aerosol_mass(c)%conc( &
11578	mask_k(mid,k),mask_j(mid,j),mask_i(mid,i))
11579	ENDDO
11580	local_pf(i,j,k) = temp_bin
11581	ENDDO
11582	ENDDO
11583	ENDDO
11584	ELSE
11585	DO i = 1, mask_size_l(mid,1)
11586	DO j = 1, mask_size_l(mid,2)
11587	DO k = 1, mask_size_l(mid,3)
11588	local_pf(i,j,k) = mbins_av(mask_k(mid,k), &
11589	mask_j(mid,j),mask_i(mid,i),11)
11590	ENDDO
11591	ENDDO
11592	ENDDO
11593	ENDIF
11594
11595	CASE ( 'm_bin12' )
11596	IF ( av == 0 ) THEN
11597	DO i = 1, mask_size_l(mid,1)
11598	DO j = 1, mask_size_l(mid,2)
11599	DO k = 1, mask_size_l(mid,3)
11600	temp_bin = 0.0_wp
11601	DO c = 12, ncc_tot*nbins, nbins
11602	temp_bin = temp_bin + aerosol_mass(c)%conc( &
11603	mask_k(mid,k),mask_j(mid,j),mask_i(mid,i))
11604	ENDDO
11605	local_pf(i,j,k) = temp_bin
11606	ENDDO
11607	ENDDO
11608	ENDDO
11609	ELSE
11610	DO i = 1, mask_size_l(mid,1)
11611	DO j = 1, mask_size_l(mid,2)
11612	DO k = 1, mask_size_l(mid,3)
11613	local_pf(i,j,k) = mbins_av(mask_k(mid,k), &
11614	mask_j(mid,j),mask_i(mid,i),12)
11615	ENDDO
11616	ENDDO
11617	ENDDO
11618	ENDIF
11619
11620	CASE ( 's_BC', 's_DU', 's_NH', 's_NO', 's_OC', 's_SO4', 's_SS' )
11621	IF ( is_used( prtcl, TRIM( variable(3:) ) ) ) THEN
11622	icc = get_index( prtcl, TRIM( variable(3:) ) )
11623	IF ( av == 0 ) THEN
11624	DO i = 1, mask_size_l(mid,1)
11625	DO j = 1, mask_size_l(mid,2)
11626	DO k = 1, mask_size_l(mid,3)
11627	temp_bin = 0.0_wp
11628	DO c = ( icc-1 )nbins+1, iccnbins
11629	temp_bin = temp_bin + aerosol_mass(c)%conc( &
11630	mask_k(mid,k),mask_j(mid,j),mask_i(mid,i))
11631	ENDDO
11632	local_pf(i,j,k) = temp_bin
11633	ENDDO
11634	ENDDO
11635	ENDDO
11636	ELSE
11637	IF ( TRIM( variable(3:) ) == 'BC' ) to_be_resorted => s_BC_av
11638	IF ( TRIM( variable(3:) ) == 'DU' ) to_be_resorted => s_DU_av
11639	IF ( TRIM( variable(3:) ) == 'NH' ) to_be_resorted => s_NH_av
11640	IF ( TRIM( variable(3:) ) == 'NO' ) to_be_resorted => s_NO_av
11641	IF ( TRIM( variable(3:) ) == 'OC' ) to_be_resorted => s_OC_av
11642	IF ( TRIM( variable(3:) ) == 'SO4' ) to_be_resorted => s_SO4_av
11643	IF ( TRIM( variable(3:) ) == 'SS' ) to_be_resorted => s_SS_av
11644	DO i = 1, mask_size_l(mid,1)
11645	DO j = 1, mask_size_l(mid,2)
11646	DO k = 1, mask_size_l(mid,3)
11647	local_pf(i,j,k) = to_be_resorted(mask_k(mid,k), &
11648	mask_j(mid,j),mask_i(mid,i))
11649	ENDDO
11650	ENDDO
11651	ENDDO
11652	ENDIF
11653	ENDIF
11654
11655	CASE DEFAULT
11656	found = .FALSE.
11657
11658	END SELECT
11659
11660	END SUBROUTINE salsa_data_output_mask
11661
11662
11663	END MODULE salsa_mod

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

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |