Home

Context Navigation

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

Last change on this file since 3582 was 3582, checked in by suehring, 6 years ago
Merge branch salsa with trunk
Property svn:keywords set to `Id`
File size: 459.4 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 2018-2018 University of Helsinki
18	! Copyright 1997-2018 Leibniz Universitaet Hannover
19	!--------------------------------------------------------------------------------!
20	!
21	! Current revisions:
22	! -----------------
23	! - Moved the control parameter "salsa" from salsa_mod.f90 to control_parameters
24	! - Updated salsa_rrd_local and salsa_wrd_local
25	! - Add target attribute
26	! - Revise initialization in case of restarts
27	! - Revise masked data output
28	!
29	! Former revisions:
30	! -----------------
31	! $Id: salsa_mod.f90 3582 2018-11-29 19:16:36Z suehring $
32	! missing comma separator inserted
33	!
34	! 3483 2018-11-02 14:19:26Z raasch
35	! bugfix: directives added to allow compilation without netCDF
36	!
37	! 3481 2018-11-02 09:14:13Z raasch
38	! temporary variable cc introduced to circumvent a possible Intel18 compiler bug
39	! related to contiguous/non-contguous pointer/target attributes
40	!
41	! 3473 2018-10-30 20:50:15Z suehring
42	! NetCDF input routine renamed
43	!
44	! 3467 2018-10-30 19:05:21Z suehring
45	! Initial revision
46	!
47	! 3412 2018-10-24 07:25:57Z monakurppa
48	!
49	! Authors:
50	! --------
51	! @author Mona Kurppa (University of Helsinki)
52	!
53	!
54	! Description:
55	! ------------
56	!> Sectional aerosol module for large scale applications SALSA
57	!> (Kokkola et al., 2008, ACP 8, 2469-2483). Solves the aerosol number and mass
58	!> concentration as well as chemical composition. Includes aerosol dynamic
59	!> processes: nucleation, condensation/evaporation of vapours, coagulation and
60	!> deposition on tree leaves, ground and roofs.
61	!> Implementation is based on formulations implemented in UCLALES-SALSA except
62	!> for deposition which is based on parametrisations by Zhang et al. (2001,
63	!> Atmos. Environ. 35, 549-560) or Petroff&Zhang (2010, Geosci. Model Dev. 3,
64	!> 753-769)
65	!>
66	!> @todo Implement turbulent inflow of aerosols in inflow_turbulence.
67	!> @todo Deposition on subgrid scale vegetation
68	!> @todo Deposition on vegetation calculated by default for deciduous broadleaf
69	!> trees
70	!> @todo Revise masked data output. There is a potential bug in case of
71	!> terrain-following masked output, according to data_output_mask.
72	!> @todo There are now improved interfaces for NetCDF data input which can be
73	!> used instead of get variable etc.
74	!------------------------------------------------------------------------------!
75	MODULE salsa_mod
76
77	USE basic_constants_and_equations_mod, &
78	ONLY: c_p, g, p_0, pi, r_d
79
80	USE chemistry_model_mod, &
81	ONLY: chem_species, nspec, nvar, spc_names
82
83	USE chem_modules, &
84	ONLY: call_chem_at_all_substeps, chem_gasphase_on
85
86	USE control_parameters
87
88	USE indices, &
89	ONLY: nbgp, nx, nxl, nxlg, nxr, nxrg, ny, nyn, nyng, nys, nysg, nzb, &
90	nzb_s_inner, nz, nzt, wall_flags_0
91
92	USE kinds
93
94	USE pegrid
95
96	USE salsa_util_mod
97
98	IMPLICIT NONE
99	!
100	!-- SALSA constants:
101	!
102	!-- Local constants:
103	INTEGER(iwp), PARAMETER :: ngast = 5 !< total number of gaseous tracers:
104	!< 1 = H2SO4, 2 = HNO3, 3 = NH3,
105	!< 4 = OCNV (non-volatile OC),
106	!< 5 = OCSV (semi-volatile)
107	INTEGER(iwp), PARAMETER :: nmod = 7 !< number of modes for initialising
108	!< the aerosol size distribution
109	INTEGER(iwp), PARAMETER :: nreg = 2 !< Number of main size subranges
110	INTEGER(iwp), PARAMETER :: maxspec = 7 !< Max. number of aerosol species
111	!
112	!-- Universal constants
113	REAL(wp), PARAMETER :: abo = 1.380662E-23_wp !< Boltzmann constant (J/K)
114	REAL(wp), PARAMETER :: alv = 2.260E+6_wp !< latent heat for H2O
115	!< vaporisation (J/kg)
116	REAL(wp), PARAMETER :: alv_d_rv = 4896.96865_wp !< alv / rv
117	REAL(wp), PARAMETER :: am_airmol = 4.8096E-26_wp !< Average mass of one air
118	!< molecule (Jacobson,
119	!< 2005, Eq. 2.3)
120	REAL(wp), PARAMETER :: api6 = 0.5235988_wp !< pi / 6
121	REAL(wp), PARAMETER :: argas = 8.314409_wp !< Gas constant (J/(mol K))
122	REAL(wp), PARAMETER :: argas_d_cpd = 8.281283865E-3_wp !< argas per cpd
123	REAL(wp), PARAMETER :: avo = 6.02214E+23_wp !< Avogadro constant (1/mol)
124	REAL(wp), PARAMETER :: d_sa = 5.539376964394570E-10_wp !< diameter of
125	!< condensing sulphuric
126	!< acid molecule (m)
127	REAL(wp), PARAMETER :: for_ppm_to_nconc = 7.243016311E+16_wp !<
128	!< ppm * avo / R (K/(Pa*m3))
129	REAL(wp), PARAMETER :: epsoc = 0.15_wp !< water uptake of organic
130	!< material
131	REAL(wp), PARAMETER :: mclim = 1.0E-23_wp !< mass concentration min
132	!< limit for aerosols (kg/m3)
133	REAL(wp), PARAMETER :: n3 = 158.79_wp !< Number of H2SO4 molecules in
134	!< 3 nm cluster if d_sa=5.54e-10m
135	REAL(wp), PARAMETER :: nclim = 1.0_wp !< number concentration min limit
136	!< for aerosols and gases (#/m3)
137	REAL(wp), PARAMETER :: surfw0 = 0.073_wp !< surface tension of pure water
138	!< at ~ 293 K (J/m2)
139	REAL(wp), PARAMETER :: vclim = 1.0E-24_wp !< volume concentration min
140	!< limit for aerosols (m3/m3)
141	!-- Molar masses in kg/mol
142	REAL(wp), PARAMETER :: ambc = 12.0E-3_wp !< black carbon (BC)
143	REAL(wp), PARAMETER :: amdair = 28.970E-3_wp !< dry air
144	REAL(wp), PARAMETER :: amdu = 100.E-3_wp !< mineral dust
145	REAL(wp), PARAMETER :: amh2o = 18.0154E-3_wp !< H2O
146	REAL(wp), PARAMETER :: amh2so4 = 98.06E-3_wp !< H2SO4
147	REAL(wp), PARAMETER :: amhno3 = 63.01E-3_wp !< HNO3
148	REAL(wp), PARAMETER :: amn2o = 44.013E-3_wp !< N2O
149	REAL(wp), PARAMETER :: amnh3 = 17.031E-3_wp !< NH3
150	REAL(wp), PARAMETER :: amo2 = 31.9988E-3_wp !< O2
151	REAL(wp), PARAMETER :: amo3 = 47.998E-3_wp !< O3
152	REAL(wp), PARAMETER :: amoc = 150.E-3_wp !< organic carbon (OC)
153	REAL(wp), PARAMETER :: amss = 58.44E-3_wp !< sea salt (NaCl)
154	!-- Densities in kg/m3
155	REAL(wp), PARAMETER :: arhobc = 2000.0_wp !< black carbon
156	REAL(wp), PARAMETER :: arhodu = 2650.0_wp !< mineral dust
157	REAL(wp), PARAMETER :: arhoh2o = 1000.0_wp !< H2O
158	REAL(wp), PARAMETER :: arhoh2so4 = 1830.0_wp !< SO4
159	REAL(wp), PARAMETER :: arhohno3 = 1479.0_wp !< HNO3
160	REAL(wp), PARAMETER :: arhonh3 = 1530.0_wp !< NH3
161	REAL(wp), PARAMETER :: arhooc = 2000.0_wp !< organic carbon
162	REAL(wp), PARAMETER :: arhoss = 2165.0_wp !< sea salt (NaCl)
163	!-- Volume of molecule in m3/#
164	REAL(wp), PARAMETER :: amvh2o = amh2o /avo / arhoh2o !< H2O
165	REAL(wp), PARAMETER :: amvh2so4 = amh2so4 / avo / arhoh2so4 !< SO4
166	REAL(wp), PARAMETER :: amvhno3 = amhno3 / avo / arhohno3 !< HNO3
167	REAL(wp), PARAMETER :: amvnh3 = amnh3 / avo / arhonh3 !< NH3
168	REAL(wp), PARAMETER :: amvoc = amoc / avo / arhooc !< OC
169	REAL(wp), PARAMETER :: amvss = amss / avo / arhoss !< sea salt
170
171	!
172	!-- SALSA switches:
173	INTEGER(iwp) :: nj3 = 1 !< J3 parametrization (nucleation)
174	!< 1 = condensational sink (Kerminen&Kulmala, 2002)
175	!< 2 = coagulational sink (Lehtinen et al. 2007)
176	!< 3 = coagS+self-coagulation (Anttila et al. 2010)
177	INTEGER(iwp) :: nsnucl = 0 !< Choice of the nucleation scheme:
178	!< 0 = off
179	!< 1 = binary nucleation
180	!< 2 = activation type nucleation
181	!< 3 = kinetic nucleation
182	!< 4 = ternary nucleation
183	!< 5 = nucleation with ORGANICs
184	!< 6 = activation type of nucleation with
185	!< H2SO4+ORG
186	!< 7 = heteromolecular nucleation with H2SO4*ORG
187	!< 8 = homomolecular nucleation of H2SO4 +
188	!< heteromolecular nucleation with H2SO4*ORG
189	!< 9 = homomolecular nucleation of H2SO4 and ORG
190	!< +heteromolecular nucleation with H2SO4*ORG
191	LOGICAL :: advect_particle_water = .TRUE. !< advect water concentration of
192	!< particles
193	LOGICAL :: decycle_lr = .FALSE. !< Undo cyclic boundary
194	!< conditions: left and right
195	LOGICAL :: decycle_ns = .FALSE. !< north and south boundaries
196	LOGICAL :: feedback_to_palm = .FALSE. !< allow feedback due to
197	!< hydration and/or condensation
198	!< of H20
199	LOGICAL :: no_insoluble = .FALSE. !< Switch to exclude insoluble
200	!< chemical components
201	LOGICAL :: read_restart_data_salsa = .FALSE. !< read restart data for salsa
202	LOGICAL :: salsa_gases_from_chem = .FALSE. !< Transfer the gaseous
203	!< components to SALSA from
204	!< from chemistry model
205	LOGICAL :: van_der_waals_coagc = .FALSE. !< Enhancement of coagulation
206	!< kernel by van der Waals and
207	!< viscous forces
208	LOGICAL :: write_binary_salsa = .FALSE. !< read binary for salsa
209	!-- Process switches: nl* is read from the NAMELIST and is NOT changed.
210	!-- ls* is the switch used and will get the value of nl*
211	!-- except for special circumstances (spinup period etc.)
212	LOGICAL :: nlcoag = .FALSE. !< Coagulation master switch
213	LOGICAL :: lscoag = .FALSE. !<
214	LOGICAL :: nlcnd = .FALSE. !< Condensation master switch
215	LOGICAL :: lscnd = .FALSE. !<
216	LOGICAL :: nlcndgas = .FALSE. !< Condensation of precursor gases
217	LOGICAL :: lscndgas = .FALSE. !<
218	LOGICAL :: nlcndh2oae = .FALSE. !< Condensation of H2O on aerosol
219	LOGICAL :: lscndh2oae = .FALSE. !< particles (FALSE -> equilibrium calc.)
220	LOGICAL :: nldepo = .FALSE. !< Deposition master switch
221	LOGICAL :: lsdepo = .FALSE. !<
222	LOGICAL :: nldepo_topo = .FALSE. !< Deposition on vegetation master switch
223	LOGICAL :: lsdepo_topo = .FALSE. !<
224	LOGICAL :: nldepo_vege = .FALSE. !< Deposition on walls master switch
225	LOGICAL :: lsdepo_vege = .FALSE. !<
226	LOGICAL :: nldistupdate = .TRUE. !< Size distribution update master switch
227	LOGICAL :: lsdistupdate = .FALSE. !<
228	!
229	!-- SALSA variables:
230	CHARACTER (LEN=20) :: bc_salsa_b = 'neumann' !< bottom boundary condition
231	CHARACTER (LEN=20) :: bc_salsa_t = 'neumann' !< top boundary condition
232	CHARACTER (LEN=20) :: depo_vege_type = 'zhang2001' !< or 'petroff2010'
233	CHARACTER (LEN=20) :: depo_topo_type = 'zhang2001' !< or 'petroff2010'
234	CHARACTER (LEN=20), DIMENSION(4) :: decycle_method = &
235	(/'dirichlet','dirichlet','dirichlet','dirichlet'/)
236	!< Decycling method at horizontal boundaries,
237	!< 1=left, 2=right, 3=south, 4=north
238	!< dirichlet = initial size distribution and
239	!< chemical composition set for the ghost and
240	!< first three layers
241	!< neumann = zero gradient
242	CHARACTER (LEN=3), DIMENSION(maxspec) :: listspec = & !< Active aerosols
243	(/'SO4',' ',' ',' ',' ',' ',' '/)
244	CHARACTER (LEN=20) :: salsa_source_mode = 'no_source'
245	!< 'read_from_file',
246	!< 'constant' or 'no_source'
247	INTEGER(iwp) :: dots_salsa = 0 !< starting index for salsa-timeseries
248	INTEGER(iwp) :: fn1a = 1 !< last index for bin subranges: subrange 1a
249	INTEGER(iwp) :: fn2a = 1 !< subrange 2a
250	INTEGER(iwp) :: fn2b = 1 !< subrange 2b
251	INTEGER(iwp), DIMENSION(ngast) :: gas_index_chem = (/ 1, 1, 1, 1, 1/) !<
252	!< Index of gaseous compounds in the chemistry
253	!< model. In SALSA, 1 = H2SO4, 2 = HNO3,
254	!< 3 = NH3, 4 = OCNV, 5 = OCSV
255	INTEGER(iwp) :: ibc_salsa_b !<
256	INTEGER(iwp) :: ibc_salsa_t !<
257	INTEGER(iwp) :: igctyp = 0 !< Initial gas concentration type
258	!< 0 = uniform (use H2SO4_init, HNO3_init,
259	!< NH3_init, OCNV_init and OCSV_init)
260	!< 1 = read vertical profile from an input file
261	INTEGER(iwp) :: in1a = 1 !< start index for bin subranges: subrange 1a
262	INTEGER(iwp) :: in2a = 1 !< subrange 2a
263	INTEGER(iwp) :: in2b = 1 !< subrange 2b
264	INTEGER(iwp) :: isdtyp = 0 !< Initial size distribution type
265	!< 0 = uniform
266	!< 1 = read vertical profile of the mode number
267	!< concentration from an input file
268	INTEGER(iwp) :: ibc = -1 !< Indice for: black carbon (BC)
269	INTEGER(iwp) :: idu = -1 !< dust
270	INTEGER(iwp) :: inh = -1 !< NH3
271	INTEGER(iwp) :: ino = -1 !< HNO3
272	INTEGER(iwp) :: ioc = -1 !< organic carbon (OC)
273	INTEGER(iwp) :: iso4 = -1 !< SO4 or H2SO4
274	INTEGER(iwp) :: iss = -1 !< sea salt
275	INTEGER(iwp) :: lod_aero = 0 !< level of detail for aerosol emissions
276	INTEGER(iwp) :: lod_gases = 0 !< level of detail for gaseous emissions
277	INTEGER(iwp), DIMENSION(nreg) :: nbin = (/ 3, 7/) !< Number of size bins
278	!< for each aerosol size subrange
279	INTEGER(iwp) :: nbins = 1 !< total number of size bins
280	INTEGER(iwp) :: ncc = 1 !< number of chemical components used
281	INTEGER(iwp) :: ncc_tot = 1!< total number of chemical compounds (ncc+1
282	!< if particle water is advected)
283	REAL(wp) :: act_coeff = 1.0E-7_wp !< Activation coefficient
284	REAL(wp) :: aerosol_source = 0.0_wp !< Constant aerosol flux (#/(m3*s))
285	REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: emission_mass_fracs !< array for
286	!< aerosol composition per emission category
287	!< 1:SO4 2:OC 3:BC 4:DU 5:SS 6:NO 7:NH
288	REAL(wp) :: dt_salsa = 0.00001_wp !< Time step of SALSA
289	REAL(wp) :: H2SO4_init = nclim !< Init value for sulphuric acid gas
290	REAL(wp) :: HNO3_init = nclim !< Init value for nitric acid gas
291	REAL(wp) :: last_salsa_time = 0.0_wp !< time of the previous salsa
292	!< timestep
293	REAL(wp) :: nf2a = 1.0_wp !< Number fraction allocated to a-
294	!< bins in subrange 2
295	!< (b-bins will get 1-nf2a)
296	REAL(wp) :: NH3_init = nclim !< Init value for ammonia gas
297	REAL(wp) :: OCNV_init = nclim !< Init value for non-volatile
298	!< organic gases
299	REAL(wp) :: OCSV_init = nclim !< Init value for semi-volatile
300	!< organic gases
301	REAL(wp), DIMENSION(nreg+1) :: reglim = & !< Min&max diameters of size subranges
302	(/ 3.0E-9_wp, 5.0E-8_wp, 1.0E-5_wp/)
303	REAL(wp) :: rhlim = 1.20_wp !< RH limit in %/100. Prevents
304	!< unrealistically high RH in condensation
305	REAL(wp) :: skip_time_do_salsa = 0.0_wp !< Starting time of SALSA (s)
306	!-- Initial log-normal size distribution: mode diameter (dpg, micrometres),
307	!-- standard deviation (sigmag) and concentration (n_lognorm, #/cm3)
308	REAL(wp), DIMENSION(nmod) :: dpg = (/0.013_wp, 0.054_wp, 0.86_wp, &
309	0.2_wp, 0.2_wp, 0.2_wp, 0.2_wp/)
310	REAL(wp), DIMENSION(nmod) :: sigmag = (/1.8_wp, 2.16_wp, 2.21_wp, &
311	2.0_wp, 2.0_wp, 2.0_wp, 2.0_wp/)
312	REAL(wp), DIMENSION(nmod) :: n_lognorm = (/1.04e+5_wp, 3.23E+4_wp, 5.4_wp,&
313	0.0_wp, 0.0_wp, 0.0_wp, 0.0_wp/)
314	!-- Initial mass fractions / chemical composition of the size distribution
315	REAL(wp), DIMENSION(maxspec) :: mass_fracs_a = & !< mass fractions between
316	(/1.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0/) !< aerosol species for A bins
317	REAL(wp), DIMENSION(maxspec) :: mass_fracs_b = & !< mass fractions between
318	(/0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0/) !< aerosol species for B bins
319
320	REAL(wp), ALLOCATABLE, DIMENSION(:) :: bin_low_limits !< to deliver
321	!< information about
322	!< the lower
323	!< diameters per bin
324	REAL(wp), ALLOCATABLE, DIMENSION(:) :: nsect !< Background number
325	!< concentration per bin
326	REAL(wp), ALLOCATABLE, DIMENSION(:) :: massacc !< Mass accomodation
327	!< coefficients per bin
328	!
329	!-- SALSA derived datatypes:
330	!
331	!-- Prognostic variable: Aerosol size bin information (number (#/m3) and
332	!-- mass (kg/m3) concentration) and the concentration of gaseous tracers (#/m3).
333	!-- Gas tracers are contained sequentially in dimension 4 as:
334	!-- 1. H2SO4, 2. HNO3, 3. NH3, 4. OCNV (non-volatile organics),
335	!-- 5. OCSV (semi-volatile)
336	TYPE salsa_variable
337	REAL(wp), POINTER, DIMENSION(:,:,:), CONTIGUOUS :: conc
338	REAL(wp), POINTER, DIMENSION(:,:,:), CONTIGUOUS :: conc_p
339	REAL(wp), POINTER, DIMENSION(:,:,:), CONTIGUOUS :: tconc_m
340	REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: flux_s, diss_s
341	REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: flux_l, diss_l
342	REAL(wp), ALLOCATABLE, DIMENSION(:) :: init
343	REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: source
344	REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: sums_ws_l
345	END TYPE salsa_variable
346
347	!-- Map bin indices between parallel size distributions
348	TYPE t_parallelbin
349	INTEGER(iwp) :: cur ! Index for current distribution
350	INTEGER(iwp) :: par ! Index for corresponding parallel distribution
351	END TYPE t_parallelbin
352
353	!-- Datatype used to store information about the binned size distributions of
354	!-- aerosols
355	TYPE t_section
356	REAL(wp) :: vhilim !< bin volume at the high limit
357	REAL(wp) :: vlolim !< bin volume at the low limit
358	REAL(wp) :: vratiohi !< volume ratio between the center and high limit
359	REAL(wp) :: vratiolo !< volume ratio between the center and low limit
360	REAL(wp) :: dmid !< bin middle diameter (m)
361	!******************************************************
362	! ^ Do NOT change the stuff above after initialization !
363	!******************************************************
364	REAL(wp) :: dwet !< Wet diameter or mean droplet diameter (m)
365	REAL(wp), DIMENSION(maxspec+1) :: volc !< Volume concentrations
366	!< (m^3/m^3) of aerosols + water. Since most of
367	!< the stuff in SALSA is hard coded, these *have to
368	!< be* in the order
369	!< 1:SO4, 2:OC, 3:BC, 4:DU, 5:SS, 6:NO, 7:NH, 8:H2O
370	REAL(wp) :: veqh2o !< Equilibrium H2O concentration for each particle
371	REAL(wp) :: numc !< Number concentration of particles/droplets (#/m3)
372	REAL(wp) :: core !< Volume of dry particle
373	END TYPE t_section
374	!
375	!-- Local aerosol properties in SALSA
376	TYPE(t_section), ALLOCATABLE :: aero(:)
377	!
378	!-- SALSA tracers:
379	!-- Tracers as x = x(k,j,i,bin). The 4th dimension contains all the size bins
380	!-- sequentially for each aerosol species + water.
381	!
382	!-- Prognostic tracers:
383	!
384	!-- Number concentration (#/m3)
385	TYPE(salsa_variable), ALLOCATABLE, DIMENSION(:), TARGET :: aerosol_number
386	REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:), TARGET :: nconc_1
387	REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:), TARGET :: nconc_2
388	REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:), TARGET :: nconc_3
389	!
390	!-- Mass concentration (kg/m3)
391	TYPE(salsa_variable), ALLOCATABLE, DIMENSION(:), TARGET :: aerosol_mass
392	REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:), TARGET :: mconc_1
393	REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:), TARGET :: mconc_2
394	REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:), TARGET :: mconc_3
395	!
396	!-- Gaseous tracers (#/m3)
397	TYPE(salsa_variable), ALLOCATABLE, DIMENSION(:), TARGET :: salsa_gas
398	REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:), TARGET :: gconc_1
399	REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:), TARGET :: gconc_2
400	REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:), TARGET :: gconc_3
401	!
402	!-- Diagnostic tracers
403	REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:) :: sedim_vd !< sedimentation
404	!< velocity per size
405	!< bin (m/s)
406	REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:) :: Ra_dry !< dry radius (m)
407
408	!-- Particle component index tables
409	TYPE(component_index) :: prtcl !< Contains "getIndex" which gives the index
410	!< for a given aerosol component name, i.e.
411	!< 1:SO4, 2:OC, 3:BC, 4:DU,
412	!< 5:SS, 6:NO, 7:NH, 8:H2O
413	!
414	!-- Data output arrays:
415	!-- Gases:
416	REAL(wp), ALLOCATABLE, DIMENSION(:,:,:), TARGET :: g_H2SO4_av !< H2SO4
417	REAL(wp), ALLOCATABLE, DIMENSION(:,:,:), TARGET :: g_HNO3_av !< HNO3
418	REAL(wp), ALLOCATABLE, DIMENSION(:,:,:), TARGET :: g_NH3_av !< NH3
419	REAL(wp), ALLOCATABLE, DIMENSION(:,:,:), TARGET :: g_OCNV_av !< non-vola-
420	!< tile OC
421	REAL(wp), ALLOCATABLE, DIMENSION(:,:,:), TARGET :: g_OCSV_av !< semi-vol.
422	!< OC
423	!-- Integrated:
424	REAL(wp), ALLOCATABLE, DIMENSION(:,:,:), TARGET :: LDSA_av !< lung-
425	!< deposited
426	!< surface area
427	REAL(wp), ALLOCATABLE, DIMENSION(:,:,:), TARGET :: Ntot_av !< total number
428	!< conc.
429	REAL(wp), ALLOCATABLE, DIMENSION(:,:,:), TARGET :: PM25_av !< PM2.5
430	REAL(wp), ALLOCATABLE, DIMENSION(:,:,:), TARGET :: PM10_av !< PM10
431	!-- In the particle phase:
432	REAL(wp), ALLOCATABLE, DIMENSION(:,:,:), TARGET :: s_BC_av !< black carbon
433	REAL(wp), ALLOCATABLE, DIMENSION(:,:,:), TARGET :: s_DU_av !< dust
434	REAL(wp), ALLOCATABLE, DIMENSION(:,:,:), TARGET :: s_H2O_av !< liquid water
435	REAL(wp), ALLOCATABLE, DIMENSION(:,:,:), TARGET :: s_NH_av !< ammonia
436	REAL(wp), ALLOCATABLE, DIMENSION(:,:,:), TARGET :: s_NO_av !< nitrates
437	REAL(wp), ALLOCATABLE, DIMENSION(:,:,:), TARGET :: s_OC_av !< org. carbon
438	REAL(wp), ALLOCATABLE, DIMENSION(:,:,:), TARGET :: s_SO4_av !< sulphates
439	REAL(wp), ALLOCATABLE, DIMENSION(:,:,:), TARGET :: s_SS_av !< sea salt
440	!-- Bins:
441	REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:), TARGET :: mbins_av !< bin mass
442	REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:), TARGET :: Nbins_av !< bin number
443
444
445	!
446	!-- PALM interfaces:
447	!
448	!-- Boundary conditions:
449	INTERFACE salsa_boundary_conds
450	MODULE PROCEDURE salsa_boundary_conds
451	MODULE PROCEDURE salsa_boundary_conds_decycle
452	END INTERFACE salsa_boundary_conds
453	!
454	!-- Data output checks for 2D/3D data to be done in check_parameters
455	INTERFACE salsa_check_data_output
456	MODULE PROCEDURE salsa_check_data_output
457	END INTERFACE salsa_check_data_output
458
459	!
460	!-- Input parameter checks to be done in check_parameters
461	INTERFACE salsa_check_parameters
462	MODULE PROCEDURE salsa_check_parameters
463	END INTERFACE salsa_check_parameters
464
465	!
466	!-- Averaging of 3D data for output
467	INTERFACE salsa_3d_data_averaging
468	MODULE PROCEDURE salsa_3d_data_averaging
469	END INTERFACE salsa_3d_data_averaging
470
471	!
472	!-- Data output of 2D quantities
473	INTERFACE salsa_data_output_2d
474	MODULE PROCEDURE salsa_data_output_2d
475	END INTERFACE salsa_data_output_2d
476
477	!
478	!-- Data output of 3D data
479	INTERFACE salsa_data_output_3d
480	MODULE PROCEDURE salsa_data_output_3d
481	END INTERFACE salsa_data_output_3d
482
483	!
484	!-- Data output of 3D data
485	INTERFACE salsa_data_output_mask
486	MODULE PROCEDURE salsa_data_output_mask
487	END INTERFACE salsa_data_output_mask
488
489	!
490	!-- Definition of data output quantities
491	INTERFACE salsa_define_netcdf_grid
492	MODULE PROCEDURE salsa_define_netcdf_grid
493	END INTERFACE salsa_define_netcdf_grid
494
495	!
496	!-- Output of information to the header file
497	INTERFACE salsa_header
498	MODULE PROCEDURE salsa_header
499	END INTERFACE salsa_header
500
501	!
502	!-- Initialization actions
503	INTERFACE salsa_init
504	MODULE PROCEDURE salsa_init
505	END INTERFACE salsa_init
506
507	!
508	!-- Initialization of arrays
509	INTERFACE salsa_init_arrays
510	MODULE PROCEDURE salsa_init_arrays
511	END INTERFACE salsa_init_arrays
512
513	!
514	!-- Writing of binary output for restart runs !!! renaming?!
515	INTERFACE salsa_wrd_local
516	MODULE PROCEDURE salsa_wrd_local
517	END INTERFACE salsa_wrd_local
518
519	!
520	!-- Reading of NAMELIST parameters
521	INTERFACE salsa_parin
522	MODULE PROCEDURE salsa_parin
523	END INTERFACE salsa_parin
524
525	!
526	!-- Reading of parameters for restart runs
527	INTERFACE salsa_rrd_local
528	MODULE PROCEDURE salsa_rrd_local
529	END INTERFACE salsa_rrd_local
530
531	!
532	!-- Swapping of time levels (required for prognostic variables)
533	INTERFACE salsa_swap_timelevel
534	MODULE PROCEDURE salsa_swap_timelevel
535	END INTERFACE salsa_swap_timelevel
536
537	INTERFACE salsa_driver
538	MODULE PROCEDURE salsa_driver
539	END INTERFACE salsa_driver
540
541	INTERFACE salsa_tendency
542	MODULE PROCEDURE salsa_tendency
543	MODULE PROCEDURE salsa_tendency_ij
544	END INTERFACE salsa_tendency
545
546
547
548	SAVE
549
550	PRIVATE
551	!
552	!-- Public functions:
553	PUBLIC salsa_boundary_conds, salsa_check_data_output, &
554	salsa_check_parameters, salsa_3d_data_averaging, &
555	salsa_data_output_2d, salsa_data_output_3d, salsa_data_output_mask, &
556	salsa_define_netcdf_grid, salsa_diagnostics, salsa_driver, &
557	salsa_header, salsa_init, salsa_init_arrays, salsa_parin, &
558	salsa_rrd_local, salsa_swap_timelevel, salsa_tendency, &
559	salsa_wrd_local
560	!
561	!-- Public parameters, constants and initial values
562	PUBLIC dots_salsa, dt_salsa, last_salsa_time, lsdepo, salsa, &
563	salsa_gases_from_chem, skip_time_do_salsa
564	!
565	!-- Public prognostic variables
566	PUBLIC aerosol_mass, aerosol_number, fn2a, fn2b, gconc_2, in1a, in2b, &
567	mconc_2, nbins, ncc, ncc_tot, nclim, nconc_2, ngast, prtcl, Ra_dry, &
568	salsa_gas, sedim_vd
569
570
571	CONTAINS
572
573	!------------------------------------------------------------------------------!
574	! Description:
575	! ------------
576	!> Parin for &salsa_par for new modules
577	!------------------------------------------------------------------------------!
578	SUBROUTINE salsa_parin
579
580	IMPLICIT NONE
581
582	CHARACTER (LEN=80) :: line !< dummy string that contains the current line
583	!< of the parameter file
584
585	NAMELIST /salsa_parameters/ &
586	advect_particle_water, & ! Switch for advecting
587	! particle water. If .FALSE.,
588	! equilibration is called at
589	! each time step.
590	bc_salsa_b, & ! bottom boundary condition
591	bc_salsa_t, & ! top boundary condition
592	decycle_lr, & ! decycle SALSA components
593	decycle_method, & ! decycle method applied:
594	! 1=left 2=right 3=south 4=north
595	decycle_ns, & ! decycle SALSA components
596	depo_vege_type, & ! Parametrisation type
597	depo_topo_type, & ! Parametrisation type
598	dpg, & ! Mean diameter for the initial
599	! log-normal modes
600	dt_salsa, & ! SALSA timestep in seconds
601	feedback_to_palm, & ! allow feedback due to
602	! hydration / condensation
603	H2SO4_init, & ! Init value for sulphuric acid
604	HNO3_init, & ! Init value for nitric acid
605	igctyp, & ! Initial gas concentration type
606	isdtyp, & ! Initial size distribution type
607	listspec, & ! List of actived aerosols
608	! (string list)
609	mass_fracs_a, & ! Initial relative contribution
610	! of each species to particle
611	! volume in a-bins, 0 for unused
612	mass_fracs_b, & ! Initial relative contribution
613	! of each species to particle
614	! volume in b-bins, 0 for unused
615	n_lognorm, & ! Number concentration for the
616	! log-normal modes
617	nbin, & ! Number of size bins for
618	! aerosol size subranges 1 & 2
619	nf2a, & ! Number fraction of particles
620	! allocated to a-bins in
621	! subrange 2 b-bins will get
622	! 1-nf2a
623	NH3_init, & ! Init value for ammonia
624	nj3, & ! J3 parametrization
625	! 1 = condensational sink
626	! (Kerminen&Kulmala, 2002)
627	! 2 = coagulational sink
628	! (Lehtinen et al. 2007)
629	! 3 = coagS+self-coagulation
630	! (Anttila et al. 2010)
631	nlcnd, & ! Condensation master switch
632	nlcndgas, & ! Condensation of gases
633	nlcndh2oae, & ! Condensation of H2O
634	nlcoag, & ! Coagulation master switch
635	nldepo, & ! Deposition master switch
636	nldepo_vege, & ! Deposition on vegetation
637	! master switch
638	nldepo_topo, & ! Deposition on topo master
639	! switch
640	nldistupdate, & ! Size distribution update
641	! master switch
642	nsnucl, & ! Nucleation scheme:
643	! 0 = off,
644	! 1 = binary nucleation
645	! 2 = activation type nucleation
646	! 3 = kinetic nucleation
647	! 4 = ternary nucleation
648	! 5 = nucleation with organics
649	! 6 = activation type of
650	! nucleation with H2SO4+ORG
651	! 7 = heteromolecular nucleation
652	! with H2SO4*ORG
653	! 8 = homomolecular nucleation
654	! of H2SO4 + heteromolecular
655	! nucleation with H2SO4*ORG
656	! 9 = homomolecular nucleation
657	! of H2SO4 and ORG + hetero-
658	! molecular nucleation with
659	! H2SO4*ORG
660	OCNV_init, & ! Init value for non-volatile
661	! organic gases
662	OCSV_init, & ! Init value for semi-volatile
663	! organic gases
664	read_restart_data_salsa, & ! read restart data for
665	! salsa
666	reglim, & ! Min&max diameter limits of
667	! size subranges
668	salsa, & ! Master switch for SALSA
669	salsa_source_mode,& ! 'read_from_file' or 'constant'
670	! or 'no_source'
671	sigmag, & ! stdev for the initial log-
672	! normal modes
673	skip_time_do_salsa, & ! Starting time of SALSA (s)
674	van_der_waals_coagc,& ! include van der Waals forces
675	write_binary_salsa ! Write binary for salsa
676
677
678	line = ' '
679
680	!
681	!-- Try to find salsa package
682	REWIND ( 11 )
683	line = ' '
684	DO WHILE ( INDEX( line, '&salsa_parameters' ) == 0 )
685	READ ( 11, '(A)', END=10 ) line
686	ENDDO
687	BACKSPACE ( 11 )
688
689	!
690	!-- Read user-defined namelist
691	READ ( 11, salsa_parameters )
692
693	!
694	!-- Enable salsa (salsa switch in modules.f90)
695	salsa = .TRUE.
696
697	10 CONTINUE
698
699	END SUBROUTINE salsa_parin
700
701
702	!------------------------------------------------------------------------------!
703	! Description:
704	! ------------
705	!> Check parameters routine for salsa.
706	!------------------------------------------------------------------------------!
707	SUBROUTINE salsa_check_parameters
708
709	USE control_parameters, &
710	ONLY: message_string
711
712	IMPLICIT NONE
713
714	!
715	!-- Checks go here (cf. check_parameters.f90).
716	IF ( salsa .AND. .NOT. humidity ) THEN
717	WRITE( message_string, * ) 'salsa = ', salsa, ' is ', &
718	'not allowed with humidity = ', humidity
719	CALL message( 'check_parameters', 'SA0009', 1, 2, 0, 6, 0 )
720	ENDIF
721
722	IF ( bc_salsa_b == 'dirichlet' ) THEN
723	ibc_salsa_b = 0
724	ELSEIF ( bc_salsa_b == 'neumann' ) THEN
725	ibc_salsa_b = 1
726	ELSE
727	message_string = 'unknown boundary condition: bc_salsa_b = "' &
728	// TRIM( bc_salsa_t ) // '"'
729	CALL message( 'check_parameters', 'SA0011', 1, 2, 0, 6, 0 )
730	ENDIF
731
732	IF ( bc_salsa_t == 'dirichlet' ) THEN
733	ibc_salsa_t = 0
734	ELSEIF ( bc_salsa_t == 'neumann' ) THEN
735	ibc_salsa_t = 1
736	ELSE
737	message_string = 'unknown boundary condition: bc_salsa_t = "' &
738	// TRIM( bc_salsa_t ) // '"'
739	CALL message( 'check_parameters', 'SA0012', 1, 2, 0, 6, 0 )
740	ENDIF
741
742	IF ( nj3 < 1 .OR. nj3 > 3 ) THEN
743	message_string = 'unknown nj3 (must be 1-3)'
744	CALL message( 'check_parameters', 'SA0044', 1, 2, 0, 6, 0 )
745	ENDIF
746
747	END SUBROUTINE salsa_check_parameters
748
749	!------------------------------------------------------------------------------!
750	!
751	! Description:
752	! ------------
753	!> Subroutine defining appropriate grid for netcdf variables.
754	!> It is called out from subroutine netcdf.
755	!> Same grid as for other scalars (see netcdf_interface_mod.f90)
756	!------------------------------------------------------------------------------!
757	SUBROUTINE salsa_define_netcdf_grid( var, found, grid_x, grid_y, grid_z )
758
759	IMPLICIT NONE
760
761	CHARACTER (LEN=*), INTENT(OUT) :: grid_x !<
762	CHARACTER (LEN=*), INTENT(OUT) :: grid_y !<
763	CHARACTER (LEN=*), INTENT(OUT) :: grid_z !<
764	CHARACTER (LEN=*), INTENT(IN) :: var !<
765
766	LOGICAL, INTENT(OUT) :: found !<
767
768	found = .TRUE.
769	!
770	!-- Check for the grid
771
772	IF ( var(1:2) == 'g_' ) THEN
773	grid_x = 'x'
774	grid_y = 'y'
775	grid_z = 'zu'
776	ELSEIF ( var(1:4) == 'LDSA' ) THEN
777	grid_x = 'x'
778	grid_y = 'y'
779	grid_z = 'zu'
780	ELSEIF ( var(1:5) == 'm_bin' ) THEN
781	grid_x = 'x'
782	grid_y = 'y'
783	grid_z = 'zu'
784	ELSEIF ( var(1:5) == 'N_bin' ) THEN
785	grid_x = 'x'
786	grid_y = 'y'
787	grid_z = 'zu'
788	ELSEIF ( var(1:4) == 'Ntot' ) THEN
789	grid_x = 'x'
790	grid_y = 'y'
791	grid_z = 'zu'
792	ELSEIF ( var(1:2) == 'PM' ) THEN
793	grid_x = 'x'
794	grid_y = 'y'
795	grid_z = 'zu'
796	ELSEIF ( var(1:2) == 's_' ) THEN
797	grid_x = 'x'
798	grid_y = 'y'
799	grid_z = 'zu'
800	ELSE
801	found = .FALSE.
802	grid_x = 'none'
803	grid_y = 'none'
804	grid_z = 'none'
805	ENDIF
806
807	END SUBROUTINE salsa_define_netcdf_grid
808
809
810	!------------------------------------------------------------------------------!
811	! Description:
812	! ------------
813	!> Header output for new module
814	!------------------------------------------------------------------------------!
815	SUBROUTINE salsa_header( io )
816
817	IMPLICIT NONE
818
819	INTEGER(iwp), INTENT(IN) :: io !< Unit of the output file
820	!
821	!-- Write SALSA header
822	WRITE( io, 1 )
823	WRITE( io, 2 ) skip_time_do_salsa
824	WRITE( io, 3 ) dt_salsa
825	WRITE( io, 12 ) SHAPE( aerosol_number(1)%conc ), nbins
826	IF ( advect_particle_water ) THEN
827	WRITE( io, 16 ) SHAPE( aerosol_mass(1)%conc ), ncc_tot*nbins, &
828	advect_particle_water
829	ELSE
830	WRITE( io, 16 ) SHAPE( aerosol_mass(1)%conc ), ncc*nbins, &
831	advect_particle_water
832	ENDIF
833	IF ( .NOT. salsa_gases_from_chem ) THEN
834	WRITE( io, 17 ) SHAPE( aerosol_mass(1)%conc ), ngast, &
835	salsa_gases_from_chem
836	ENDIF
837	WRITE( io, 4 )
838	IF ( nsnucl > 0 ) THEN
839	WRITE( io, 5 ) nsnucl, nj3
840	ENDIF
841	IF ( nlcoag ) THEN
842	WRITE( io, 6 )
843	ENDIF
844	IF ( nlcnd ) THEN
845	WRITE( io, 7 ) nlcndgas, nlcndh2oae
846	ENDIF
847	IF ( nldepo ) THEN
848	WRITE( io, 14 ) nldepo_vege, nldepo_topo
849	ENDIF
850	WRITE( io, 8 ) reglim, nbin, bin_low_limits
851	WRITE( io, 15 ) nsect
852	WRITE( io, 13 ) ncc, listspec, mass_fracs_a, mass_fracs_b
853	IF ( .NOT. salsa_gases_from_chem ) THEN
854	WRITE( io, 18 ) ngast, H2SO4_init, HNO3_init, NH3_init, OCNV_init, &
855	OCSV_init
856	ENDIF
857	WRITE( io, 9 ) isdtyp, igctyp
858	IF ( isdtyp == 0 ) THEN
859	WRITE( io, 10 ) dpg, sigmag, n_lognorm
860	ELSE
861	WRITE( io, 11 )
862	ENDIF
863
864
865	1 FORMAT (//' SALSA information:'/ &
866	' ------------------------------'/)
867	2 FORMAT (' Starts at: skip_time_do_salsa = ', F10.2, ' s')
868	3 FORMAT (/' Timestep: dt_salsa = ', F6.2, ' s')
869	12 FORMAT (/' Array shape (z,y,x,bins):'/ &
870	' aerosol_number: ', 4(I3))
871	16 FORMAT (/' aerosol_mass: ', 4(I3),/ &
872	' (advect_particle_water = ', L1, ')')
873	17 FORMAT (' salsa_gas: ', 4(I3),/ &
874	' (salsa_gases_from_chem = ', L1, ')')
875	4 FORMAT (/' Aerosol dynamic processes included: ')
876	5 FORMAT (/' nucleation (scheme = ', I1, ' and J3 parametrization = ',&
877	I1, ')')
878	6 FORMAT (/' coagulation')
879	7 FORMAT (/' condensation (of precursor gases = ', L1, &
880	' and water vapour = ', L1, ')' )
881	14 FORMAT (/' dry deposition (on vegetation = ', L1, &
882	' and on topography = ', L1, ')')
883	8 FORMAT (/' Aerosol bin subrange limits (in metres): ', 3(ES10.2E3), / &
884	' Number of size bins for each aerosol subrange: ', 2I3,/ &
885	' Aerosol bin limits (in metres): ', *(ES10.2E3))
886	15 FORMAT (' Initial number concentration in bins at the lowest level', &
887	' (#/m*3):', (ES10.2E3))
888	13 FORMAT (/' Number of chemical components used: ', I1,/ &
889	' Species: ',7(A6),/ &
890	' Initial relative contribution of each species to particle', &
891	' volume in:',/ &
892	' a-bins: ', 7(F6.3),/ &
893	' b-bins: ', 7(F6.3))
894	18 FORMAT (/' Number of gaseous tracers used: ', I1,/ &
895	' Initial gas concentrations:',/ &
896	' H2SO4: ',ES12.4E3, ' #/m**3',/ &
897	' HNO3: ',ES12.4E3, ' #/m**3',/ &
898	' NH3: ',ES12.4E3, ' #/m**3',/ &
899	' OCNV: ',ES12.4E3, ' #/m**3',/ &
900	' OCSV: ',ES12.4E3, ' #/m**3')
901	9 FORMAT (/' Initialising concentrations: ', / &
902	' Aerosol size distribution: isdtyp = ', I1,/ &
903	' Gas concentrations: igctyp = ', I1 )
904	10 FORMAT ( ' Mode diametres: dpg(nmod) = ', 7(F7.3),/ &
905	' Standard deviation: sigmag(nmod) = ', 7(F7.2),/ &
906	' Number concentration: n_lognorm(nmod) = ', 7(ES12.4E3) )
907	11 FORMAT (/' Size distribution read from a file.')
908
909	END SUBROUTINE salsa_header
910
911	!------------------------------------------------------------------------------!
912	! Description:
913	! ------------
914	!> Allocate SALSA arrays and define pointers if required
915	!------------------------------------------------------------------------------!
916	SUBROUTINE salsa_init_arrays
917
918	USE surface_mod, &
919	ONLY: surf_def_h, surf_def_v, surf_lsm_h, surf_lsm_v, surf_usm_h, &
920	surf_usm_v
921
922	IMPLICIT NONE
923
924	INTEGER(iwp) :: gases_available !< Number of available gas components in
925	!< the chemistry model
926	INTEGER(iwp) :: i !< loop index for allocating
927	INTEGER(iwp) :: l !< loop index for allocating: surfaces
928	INTEGER(iwp) :: lsp !< loop index for chem species in the chemistry model
929
930	gases_available = 0
931
932	!
933	!-- Allocate prognostic variables (see salsa_swap_timelevel)
934	#if defined( __nopointer )
935	message_string = 'SALSA runs only with POINTER Version'
936	CALL message( 'salsa_mod: salsa_init_arrays', 'SA0023', 1, 2, 0, 6, 0 )
937	#else
938	!
939	!-- Set derived indices:
940	!-- (This does the same as the subroutine salsa_initialize in SALSA/
941	!-- UCLALES-SALSA)
942	in1a = 1 ! 1st index of subrange 1a
943	in2a = in1a + nbin(1) ! 1st index of subrange 2a
944	fn1a = in2a - 1 ! last index of subrange 1a
945	fn2a = fn1a + nbin(2) ! last index of subrange 2a
946
947	!
948	!-- If the fraction of insoluble aerosols in subrange 2 is zero: do not allocate
949	!-- arrays for them
950	IF ( nf2a > 0.999999_wp .AND. SUM( mass_fracs_b ) < 0.00001_wp ) THEN
951	no_insoluble = .TRUE.
952	in2b = fn2a+1 ! 1st index of subrange 2b
953	fn2b = fn2a ! last index of subrange 2b
954	ELSE
955	in2b = in2a + nbin(2) ! 1st index of subrange 2b
956	fn2b = fn2a + nbin(2) ! last index of subrange 2b
957	ENDIF
958
959
960	nbins = fn2b ! total number of aerosol size bins
961	!
962	!-- Create index tables for different aerosol components
963	CALL component_index_constructor( prtcl, ncc, maxspec, listspec )
964
965	ncc_tot = ncc
966	IF ( advect_particle_water ) ncc_tot = ncc + 1 ! Add water
967
968	!
969	!-- Allocate:
970	ALLOCATE( aero(nbins), bin_low_limits(nbins), nsect(nbins), massacc(nbins) )
971	IF ( nldepo ) ALLOCATE( sedim_vd(nzb:nzt+1,nysg:nyng,nxlg:nxrg,nbins) )
972	ALLOCATE( Ra_dry(nzb:nzt+1,nysg:nyng,nxlg:nxrg,nbins) )
973
974	!
975	!-- Aerosol number concentration
976	ALLOCATE( aerosol_number(nbins) )
977	ALLOCATE( nconc_1(nzb:nzt+1,nysg:nyng,nxlg:nxrg,nbins), &
978	nconc_2(nzb:nzt+1,nysg:nyng,nxlg:nxrg,nbins), &
979	nconc_3(nzb:nzt+1,nysg:nyng,nxlg:nxrg,nbins) )
980	nconc_1 = 0.0_wp
981	nconc_2 = 0.0_wp
982	nconc_3 = 0.0_wp
983
984	DO i = 1, nbins
985	aerosol_number(i)%conc(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => nconc_1(:,:,:,i)
986	aerosol_number(i)%conc_p(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => nconc_2(:,:,:,i)
987	aerosol_number(i)%tconc_m(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => nconc_3(:,:,:,i)
988	ALLOCATE( aerosol_number(i)%flux_s(nzb+1:nzt,0:threads_per_task-1), &
989	aerosol_number(i)%diss_s(nzb+1:nzt,0:threads_per_task-1), &
990	aerosol_number(i)%flux_l(nzb+1:nzt,nys:nyn,0:threads_per_task-1),&
991	aerosol_number(i)%diss_l(nzb+1:nzt,nys:nyn,0:threads_per_task-1),&
992	aerosol_number(i)%init(nzb:nzt+1), &
993	aerosol_number(i)%sums_ws_l(nzb:nzt+1,0:threads_per_task-1) )
994	ENDDO
995
996	!
997	!-- Aerosol mass concentration
998	ALLOCATE( aerosol_mass(ncc_tot*nbins) )
999	ALLOCATE( mconc_1(nzb:nzt+1,nysg:nyng,nxlg:nxrg,ncc_tot*nbins), &
1000	mconc_2(nzb:nzt+1,nysg:nyng,nxlg:nxrg,ncc_tot*nbins), &
1001	mconc_3(nzb:nzt+1,nysg:nyng,nxlg:nxrg,ncc_tot*nbins) )
1002	mconc_1 = 0.0_wp
1003	mconc_2 = 0.0_wp
1004	mconc_3 = 0.0_wp
1005
1006	DO i = 1, ncc_tot*nbins
1007	aerosol_mass(i)%conc(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => mconc_1(:,:,:,i)
1008	aerosol_mass(i)%conc_p(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => mconc_2(:,:,:,i)
1009	aerosol_mass(i)%tconc_m(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => mconc_3(:,:,:,i)
1010	ALLOCATE( aerosol_mass(i)%flux_s(nzb+1:nzt,0:threads_per_task-1), &
1011	aerosol_mass(i)%diss_s(nzb+1:nzt,0:threads_per_task-1), &
1012	aerosol_mass(i)%flux_l(nzb+1:nzt,nys:nyn,0:threads_per_task-1),&
1013	aerosol_mass(i)%diss_l(nzb+1:nzt,nys:nyn,0:threads_per_task-1),&
1014	aerosol_mass(i)%init(nzb:nzt+1), &
1015	aerosol_mass(i)%sums_ws_l(nzb:nzt+1,0:threads_per_task-1) )
1016	ENDDO
1017
1018	!
1019	!-- Surface fluxes: answs = aerosol number, amsws = aerosol mass
1020	!
1021	!-- Horizontal surfaces: default type
1022	DO l = 0, 2 ! upward (l=0), downward (l=1) and model top (l=2)
1023	ALLOCATE( surf_def_h(l)%answs( 1:surf_def_h(l)%ns, nbins ) )
1024	ALLOCATE( surf_def_h(l)%amsws( 1:surf_def_h(l)%ns, nbins*ncc_tot ) )
1025	surf_def_h(l)%answs = 0.0_wp
1026	surf_def_h(l)%amsws = 0.0_wp
1027	ENDDO
1028	!-- Horizontal surfaces: natural type
1029	IF ( land_surface ) THEN
1030	ALLOCATE( surf_lsm_h%answs( 1:surf_lsm_h%ns, nbins ) )
1031	ALLOCATE( surf_lsm_h%amsws( 1:surf_lsm_h%ns, nbins*ncc_tot ) )
1032	surf_lsm_h%answs = 0.0_wp
1033	surf_lsm_h%amsws = 0.0_wp
1034	ENDIF
1035	!-- Horizontal surfaces: urban type
1036	IF ( urban_surface ) THEN
1037	ALLOCATE( surf_usm_h%answs( 1:surf_usm_h%ns, nbins ) )
1038	ALLOCATE( surf_usm_h%amsws( 1:surf_usm_h%ns, nbins*ncc_tot ) )
1039	surf_usm_h%answs = 0.0_wp
1040	surf_usm_h%amsws = 0.0_wp
1041	ENDIF
1042	!
1043	!-- Vertical surfaces: northward (l=0), southward (l=1), eastward (l=2) and
1044	!-- westward (l=3) facing
1045	DO l = 0, 3
1046	ALLOCATE( surf_def_v(l)%answs( 1:surf_def_v(l)%ns, nbins ) )
1047	surf_def_v(l)%answs = 0.0_wp
1048	ALLOCATE( surf_def_v(l)%amsws( 1:surf_def_v(l)%ns, nbins*ncc_tot ) )
1049	surf_def_v(l)%amsws = 0.0_wp
1050
1051	IF ( land_surface) THEN
1052	ALLOCATE( surf_lsm_v(l)%answs( 1:surf_lsm_v(l)%ns, nbins ) )
1053	surf_lsm_v(l)%answs = 0.0_wp
1054	ALLOCATE( surf_lsm_v(l)%amsws( 1:surf_lsm_v(l)%ns, nbins*ncc_tot ) )
1055	surf_lsm_v(l)%amsws = 0.0_wp
1056	ENDIF
1057
1058	IF ( urban_surface ) THEN
1059	ALLOCATE( surf_usm_v(l)%answs( 1:surf_usm_v(l)%ns, nbins ) )
1060	surf_usm_v(l)%answs = 0.0_wp
1061	ALLOCATE( surf_usm_v(l)%amsws( 1:surf_usm_v(l)%ns, nbins*ncc_tot ) )
1062	surf_usm_v(l)%amsws = 0.0_wp
1063	ENDIF
1064	ENDDO
1065
1066	!
1067	!-- Concentration of gaseous tracers (1. SO4, 2. HNO3, 3. NH3, 4. OCNV, 5. OCSV)
1068	!-- (number concentration (#/m3) )
1069	!
1070	!-- If chemistry is on, read gas phase concentrations from there. Otherwise,
1071	!-- allocate salsa_gas array.
1072
1073	IF ( air_chemistry ) THEN
1074	DO lsp = 1, nvar
1075	IF ( TRIM( chem_species(lsp)%name ) == 'H2SO4' ) THEN
1076	gases_available = gases_available + 1
1077	gas_index_chem(1) = lsp
1078	ELSEIF ( TRIM( chem_species(lsp)%name ) == 'HNO3' ) THEN
1079	gases_available = gases_available + 1
1080	gas_index_chem(2) = lsp
1081	ELSEIF ( TRIM( chem_species(lsp)%name ) == 'NH3' ) THEN
1082	gases_available = gases_available + 1
1083	gas_index_chem(3) = lsp
1084	ELSEIF ( TRIM( chem_species(lsp)%name ) == 'OCNV' ) THEN
1085	gases_available = gases_available + 1
1086	gas_index_chem(4) = lsp
1087	ELSEIF ( TRIM( chem_species(lsp)%name ) == 'OCSV' ) THEN
1088	gases_available = gases_available + 1
1089	gas_index_chem(5) = lsp
1090	ENDIF
1091	ENDDO
1092
1093	IF ( gases_available == ngast ) THEN
1094	salsa_gases_from_chem = .TRUE.
1095	ELSE
1096	WRITE( message_string, * ) 'SALSA is run together with chemistry '// &
1097	'but not all gaseous components are '// &
1098	'provided by kpp (H2SO4, HNO3, NH3, '// &
1099	'OCNV, OCSC)'
1100	CALL message( 'check_parameters', 'SA0024', 1, 2, 0, 6, 0 )
1101	ENDIF
1102
1103	ELSE
1104
1105	ALLOCATE( salsa_gas(ngast) )
1106	ALLOCATE( gconc_1(nzb:nzt+1,nysg:nyng,nxlg:nxrg,ngast), &
1107	gconc_2(nzb:nzt+1,nysg:nyng,nxlg:nxrg,ngast), &
1108	gconc_3(nzb:nzt+1,nysg:nyng,nxlg:nxrg,ngast) )
1109	gconc_1 = 0.0_wp
1110	gconc_2 = 0.0_wp
1111	gconc_3 = 0.0_wp
1112
1113	DO i = 1, ngast
1114	salsa_gas(i)%conc(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => gconc_1(:,:,:,i)
1115	salsa_gas(i)%conc_p(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => gconc_2(:,:,:,i)
1116	salsa_gas(i)%tconc_m(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => gconc_3(:,:,:,i)
1117	ALLOCATE( salsa_gas(i)%flux_s(nzb+1:nzt,0:threads_per_task-1), &
1118	salsa_gas(i)%diss_s(nzb+1:nzt,0:threads_per_task-1), &
1119	salsa_gas(i)%flux_l(nzb+1:nzt,nys:nyn,0:threads_per_task-1),&
1120	salsa_gas(i)%diss_l(nzb+1:nzt,nys:nyn,0:threads_per_task-1),&
1121	salsa_gas(i)%init(nzb:nzt+1), &
1122	salsa_gas(i)%sums_ws_l(nzb:nzt+1,0:threads_per_task-1) )
1123	ENDDO
1124	!
1125	!-- Surface fluxes: gtsws = gaseous tracer flux
1126	!
1127	!-- Horizontal surfaces: default type
1128	DO l = 0, 2 ! upward (l=0), downward (l=1) and model top (l=2)
1129	ALLOCATE( surf_def_h(l)%gtsws( 1:surf_def_h(l)%ns, ngast ) )
1130	surf_def_h(l)%gtsws = 0.0_wp
1131	ENDDO
1132	!-- Horizontal surfaces: natural type
1133	IF ( land_surface ) THEN
1134	ALLOCATE( surf_lsm_h%gtsws( 1:surf_lsm_h%ns, ngast ) )
1135	surf_lsm_h%gtsws = 0.0_wp
1136	ENDIF
1137	!-- Horizontal surfaces: urban type
1138	IF ( urban_surface ) THEN
1139	ALLOCATE( surf_usm_h%gtsws( 1:surf_usm_h%ns, ngast ) )
1140	surf_usm_h%gtsws = 0.0_wp
1141	ENDIF
1142	!
1143	!-- Vertical surfaces: northward (l=0), southward (l=1), eastward (l=2) and
1144	!-- westward (l=3) facing
1145	DO l = 0, 3
1146	ALLOCATE( surf_def_v(l)%gtsws( 1:surf_def_v(l)%ns, ngast ) )
1147	surf_def_v(l)%gtsws = 0.0_wp
1148	IF ( land_surface ) THEN
1149	ALLOCATE( surf_lsm_v(l)%gtsws( 1:surf_lsm_v(l)%ns, ngast ) )
1150	surf_lsm_v(l)%gtsws = 0.0_wp
1151	ENDIF
1152	IF ( urban_surface ) THEN
1153	ALLOCATE( surf_usm_v(l)%gtsws( 1:surf_usm_v(l)%ns, ngast ) )
1154	surf_usm_v(l)%gtsws = 0.0_wp
1155	ENDIF
1156	ENDDO
1157	ENDIF
1158
1159	#endif
1160
1161	END SUBROUTINE salsa_init_arrays
1162
1163	!------------------------------------------------------------------------------!
1164	! Description:
1165	! ------------
1166	!> Initialization of SALSA. Based on salsa_initialize in UCLALES-SALSA.
1167	!> Subroutines salsa_initialize, SALSAinit and DiagInitAero in UCLALES-SALSA are
1168	!> also merged here.
1169	!------------------------------------------------------------------------------!
1170	SUBROUTINE salsa_init
1171
1172	IMPLICIT NONE
1173
1174	INTEGER(iwp) :: b
1175	INTEGER(iwp) :: c
1176	INTEGER(iwp) :: g
1177	INTEGER(iwp) :: i
1178	INTEGER(iwp) :: j
1179
1180	bin_low_limits = 0.0_wp
1181	nsect = 0.0_wp
1182	massacc = 1.0_wp
1183
1184	!
1185	!-- Indices for chemical components used (-1 = not used)
1186	i = 0
1187	IF ( is_used( prtcl, 'SO4' ) ) THEN
1188	iso4 = get_index( prtcl,'SO4' )
1189	i = i + 1
1190	ENDIF
1191	IF ( is_used( prtcl,'OC' ) ) THEN
1192	ioc = get_index(prtcl, 'OC')
1193	i = i + 1
1194	ENDIF
1195	IF ( is_used( prtcl, 'BC' ) ) THEN
1196	ibc = get_index( prtcl, 'BC' )
1197	i = i + 1
1198	ENDIF
1199	IF ( is_used( prtcl, 'DU' ) ) THEN
1200	idu = get_index( prtcl, 'DU' )
1201	i = i + 1
1202	ENDIF
1203	IF ( is_used( prtcl, 'SS' ) ) THEN
1204	iss = get_index( prtcl, 'SS' )
1205	i = i + 1
1206	ENDIF
1207	IF ( is_used( prtcl, 'NO' ) ) THEN
1208	ino = get_index( prtcl, 'NO' )
1209	i = i + 1
1210	ENDIF
1211	IF ( is_used( prtcl, 'NH' ) ) THEN
1212	inh = get_index( prtcl, 'NH' )
1213	i = i + 1
1214	ENDIF
1215	!
1216	!-- All species must be known
1217	IF ( i /= ncc ) THEN
1218	message_string = 'Unknown aerosol species/component(s) given in the' // &
1219	' initialization'
1220	CALL message( 'salsa_mod: salsa_init', 'SA0020', 1, 2, 0, 6, 0 )
1221	ENDIF
1222
1223	!
1224	!-- Initialise
1225	!
1226	!-- Aerosol size distribution (TYPE t_section)
1227	aero(:)%dwet = 1.0E-10_wp
1228	aero(:)%veqh2o = 1.0E-10_wp
1229	aero(:)%numc = nclim
1230	aero(:)%core = 1.0E-10_wp
1231	DO c = 1, maxspec+1 ! 1:SO4, 2:OC, 3:BC, 4:DU, 5:SS, 6:NO, 7:NH, 8:H2O
1232	aero(:)%volc(c) = 0.0_wp
1233	ENDDO
1234
1235	IF ( nldepo ) sedim_vd = 0.0_wp
1236
1237	DO b = 1, nbins
1238	IF ( .NOT. read_restart_data_salsa ) aerosol_number(b)%conc = nclim
1239	aerosol_number(b)%conc_p = 0.0_wp
1240	aerosol_number(b)%tconc_m = 0.0_wp
1241	aerosol_number(b)%flux_s = 0.0_wp
1242	aerosol_number(b)%diss_s = 0.0_wp
1243	aerosol_number(b)%flux_l = 0.0_wp
1244	aerosol_number(b)%diss_l = 0.0_wp
1245	aerosol_number(b)%init = nclim
1246	aerosol_number(b)%sums_ws_l = 0.0_wp
1247	ENDDO
1248	DO c = 1, ncc_tot*nbins
1249	IF ( .NOT. read_restart_data_salsa ) aerosol_mass(c)%conc = mclim
1250	aerosol_mass(c)%conc_p = 0.0_wp
1251	aerosol_mass(c)%tconc_m = 0.0_wp
1252	aerosol_mass(c)%flux_s = 0.0_wp
1253	aerosol_mass(c)%diss_s = 0.0_wp
1254	aerosol_mass(c)%flux_l = 0.0_wp
1255	aerosol_mass(c)%diss_l = 0.0_wp
1256	aerosol_mass(c)%init = mclim
1257	aerosol_mass(c)%sums_ws_l = 0.0_wp
1258	ENDDO
1259
1260	IF ( .NOT. salsa_gases_from_chem ) THEN
1261	DO g = 1, ngast
1262	salsa_gas(g)%conc_p = 0.0_wp
1263	salsa_gas(g)%tconc_m = 0.0_wp
1264	salsa_gas(g)%flux_s = 0.0_wp
1265	salsa_gas(g)%diss_s = 0.0_wp
1266	salsa_gas(g)%flux_l = 0.0_wp
1267	salsa_gas(g)%diss_l = 0.0_wp
1268	salsa_gas(g)%sums_ws_l = 0.0_wp
1269	ENDDO
1270	IF ( .NOT. read_restart_data_salsa ) THEN
1271	salsa_gas(1)%conc = H2SO4_init
1272	salsa_gas(2)%conc = HNO3_init
1273	salsa_gas(3)%conc = NH3_init
1274	salsa_gas(4)%conc = OCNV_init
1275	salsa_gas(5)%conc = OCSV_init
1276	ENDIF
1277	!
1278	!-- Set initial value for gas compound tracers and initial values
1279	salsa_gas(1)%init = H2SO4_init
1280	salsa_gas(2)%init = HNO3_init
1281	salsa_gas(3)%init = NH3_init
1282	salsa_gas(4)%init = OCNV_init
1283	salsa_gas(5)%init = OCSV_init
1284	ENDIF
1285	!
1286	!-- Aerosol radius in each bin: dry and wet (m)
1287	Ra_dry = 1.0E-10_wp
1288	!
1289	!-- Initialise aerosol tracers
1290	aero(:)%vhilim = 0.0_wp
1291	aero(:)%vlolim = 0.0_wp
1292	aero(:)%vratiohi = 0.0_wp
1293	aero(:)%vratiolo = 0.0_wp
1294	aero(:)%dmid = 0.0_wp
1295	!
1296	!-- Initialise the sectional particle size distribution
1297	CALL set_sizebins()
1298	!
1299	!-- Initialise location-dependent aerosol size distributions and
1300	!-- chemical compositions:
1301	CALL aerosol_init
1302	!
1303	!-- Initalisation run of SALSA
1304	DO i = nxl, nxr
1305	DO j = nys, nyn
1306	CALL salsa_driver( i, j, 1 )
1307	CALL salsa_diagnostics( i, j )
1308	ENDDO
1309	ENDDO
1310	!
1311	!-- Set the aerosol and gas sources
1312	IF ( salsa_source_mode == 'read_from_file' ) THEN
1313	CALL salsa_set_source
1314	ENDIF
1315
1316	END SUBROUTINE salsa_init
1317
1318	!------------------------------------------------------------------------------!
1319	! Description:
1320	! ------------
1321	!> Initializes particle size distribution grid by calculating size bin limits
1322	!> and mid-size for dry particles in each bin. Called from salsa_initialize
1323	!> (only at the beginning of simulation).
1324	!> Size distribution described using:
1325	!> 1) moving center method (subranges 1 and 2)
1326	!> (Jacobson, Atmos. Env., 31, 131-144, 1997)
1327	!> 2) fixed sectional method (subrange 3)
1328	!> Size bins in each subrange are spaced logarithmically
1329	!> based on given subrange size limits and bin number.
1330	!
1331	!> Mona changed 06/2017: Use geometric mean diameter to describe the mean
1332	!> particle diameter in a size bin, not the arithmeric mean which clearly
1333	!> overestimates the total particle volume concentration.
1334	!
1335	!> Coded by:
1336	!> Hannele Korhonen (FMI) 2005
1337	!> Harri Kokkola (FMI) 2006
1338	!
1339	!> Bug fixes for box model + updated for the new aerosol datatype:
1340	!> Juha Tonttila (FMI) 2014
1341	!------------------------------------------------------------------------------!
1342	SUBROUTINE set_sizebins
1343
1344	IMPLICIT NONE
1345	!
1346	!-- Local variables
1347	INTEGER(iwp) :: cc
1348	INTEGER(iwp) :: dd
1349	REAL(wp) :: ratio_d !< ratio of the upper and lower diameter of subranges
1350	!
1351	!-- vlolim&vhilim: min & max dry volumes [fxm]
1352	!-- dmid: bin mid dry diameter (m)
1353	!-- vratiolo&vratiohi: volume ratio between the center and low/high limit
1354	!
1355	!-- 1) Size subrange 1:
1356	ratio_d = reglim(2) / reglim(1) ! section spacing (m)
1357	DO cc = in1a,fn1a
1358	aero(cc)%vlolim = api6 * ( reglim(1) * ratio_d ** &
1359	( REAL( cc-1 ) / nbin(1) ) ) ** 3.0_wp
1360	aero(cc)%vhilim = api6 * ( reglim(1) * ratio_d ** &
1361	( REAL( cc ) / nbin(1) ) ) ** 3.0_wp
1362	aero(cc)%dmid = SQRT( ( aero(cc)%vhilim / api6 ) ** ( 1.0_wp / 3.0_wp ) &
1363	* ( aero(cc)%vlolim / api6 ) ** ( 1.0_wp / 3.0_wp ) )
1364	aero(cc)%vratiohi = aero(cc)%vhilim / ( api6 * aero(cc)%dmid ** 3.0_wp )
1365	aero(cc)%vratiolo = aero(cc)%vlolim / ( api6 * aero(cc)%dmid ** 3.0_wp )
1366	ENDDO
1367	!
1368	!-- 2) Size subrange 2:
1369	!-- 2.1) Sub-subrange 2a: high hygroscopicity
1370	ratio_d = reglim(3) / reglim(2) ! section spacing
1371	DO dd = in2a, fn2a
1372	cc = dd - in2a
1373	aero(dd)%vlolim = api6 * ( reglim(2) * ratio_d ** &
1374	( REAL( cc ) / nbin(2) ) ) ** 3.0_wp
1375	aero(dd)%vhilim = api6 * ( reglim(2) * ratio_d ** &
1376	( REAL( cc+1 ) / nbin(2) ) ) ** 3.0_wp
1377	aero(dd)%dmid = SQRT( ( aero(dd)%vhilim / api6 ) ** ( 1.0_wp / 3.0_wp ) &
1378	* ( aero(dd)%vlolim / api6 ) ** ( 1.0_wp / 3.0_wp ) )
1379	aero(dd)%vratiohi = aero(dd)%vhilim / ( api6 * aero(dd)%dmid ** 3.0_wp )
1380	aero(dd)%vratiolo = aero(dd)%vlolim / ( api6 * aero(dd)%dmid ** 3.0_wp )
1381	ENDDO
1382	!
1383	!-- 2.2) Sub-subrange 2b: low hygroscopicity
1384	IF ( .NOT. no_insoluble ) THEN
1385	aero(in2b:fn2b)%vlolim = aero(in2a:fn2a)%vlolim
1386	aero(in2b:fn2b)%vhilim = aero(in2a:fn2a)%vhilim
1387	aero(in2b:fn2b)%dmid = aero(in2a:fn2a)%dmid
1388	aero(in2b:fn2b)%vratiohi = aero(in2a:fn2a)%vratiohi
1389	aero(in2b:fn2b)%vratiolo = aero(in2a:fn2a)%vratiolo
1390	ENDIF
1391	!
1392	!-- Initialize the wet diameter with the bin dry diameter to avoid numerical
1393	!-- problems later
1394	aero(:)%dwet = aero(:)%dmid
1395	!
1396	!-- Save bin limits (lower diameter) to be delivered to the host model if needed
1397	DO cc = 1, nbins
1398	bin_low_limits(cc) = ( aero(cc)%vlolim / api6 )**( 1.0_wp / 3.0_wp )
1399	ENDDO
1400
1401	END SUBROUTINE set_sizebins
1402
1403	!------------------------------------------------------------------------------!
1404	! Description:
1405	! ------------
1406	!> Initilize altitude-dependent aerosol size distributions and compositions.
1407	!>
1408	!> Mona added 06/2017: Correct the number and mass concentrations by normalizing
1409	!< by the given total number and mass concentration.
1410	!>
1411	!> Tomi Raatikainen, FMI, 29.2.2016
1412	!------------------------------------------------------------------------------!
1413	SUBROUTINE aerosol_init
1414
1415	USE arrays_3d, &
1416	ONLY: zu
1417
1418	! USE NETCDF
1419
1420	USE netcdf_data_input_mod, &
1421	ONLY: get_attribute, get_variable, &
1422	netcdf_data_input_get_dimension_length, open_read_file
1423
1424	IMPLICIT NONE
1425
1426	INTEGER(iwp) :: b !< loop index: size bins
1427	INTEGER(iwp) :: c !< loop index: chemical components
1428	INTEGER(iwp) :: ee !< index: end
1429	INTEGER(iwp) :: g !< loop index: gases
1430	INTEGER(iwp) :: i !< loop index: x-direction
1431	INTEGER(iwp) :: id_faero !< NetCDF id of PIDS_SALSA
1432	INTEGER(iwp) :: id_fchem !< NetCDF id of PIDS_CHEM
1433	INTEGER(iwp) :: j !< loop index: y-direction
1434	INTEGER(iwp) :: k !< loop index: z-direction
1435	INTEGER(iwp) :: kk !< loop index: z-direction
1436	INTEGER(iwp) :: nz_file !< Number of grid-points in file (heights)
1437	INTEGER(iwp) :: prunmode
1438	INTEGER(iwp) :: ss !< index: start
1439	LOGICAL :: netcdf_extend = .FALSE. !< Flag indicating wether netcdf
1440	!< topography input file or not
1441	REAL(wp), DIMENSION(nbins) :: core !< size of the bin mid aerosol particle,
1442	REAL(wp) :: flag !< flag to mask topography grid points
1443	REAL(wp), DIMENSION(:,:), ALLOCATABLE :: pr_gas !< gas profiles
1444	REAL(wp), DIMENSION(:,:), ALLOCATABLE :: pr_mass_fracs_a !< mass fraction
1445	!< profiles: a
1446	REAL(wp), DIMENSION(:,:), ALLOCATABLE :: pr_mass_fracs_b !< and b
1447	REAL(wp), DIMENSION(:,:), ALLOCATABLE :: pr_nsect !< sectional size
1448	!< distribution profile
1449	REAL(wp), DIMENSION(nbins) :: nsect !< size distribution (#/m3)
1450	REAL(wp), DIMENSION(0:nz+1,nbins) :: pndist !< size dist as a function
1451	!< of height (#/m3)
1452	REAL(wp), DIMENSION(0:nz+1) :: pnf2a !< number fraction: bins 2a
1453	REAL(wp), DIMENSION(0:nz+1,maxspec) :: pvf2a !< mass distributions of
1454	!< aerosol species for a
1455	REAL(wp), DIMENSION(0:nz+1,maxspec) :: pvf2b !< and b-bins
1456	REAL(wp), DIMENSION(0:nz+1) :: pvfOC1a !< mass fraction between
1457	!< SO4 and OC in 1a
1458	REAL(wp), DIMENSION(:), ALLOCATABLE :: pr_z
1459
1460	prunmode = 1
1461	!
1462	!-- Bin mean aerosol particle volume (m3)
1463	core(:) = 0.0_wp
1464	core(1:nbins) = api6 * aero(1:nbins)%dmid ** 3.0_wp
1465	!
1466	!-- Set concentrations to zero
1467	nsect(:) = 0.0_wp
1468	pndist(:,:) = 0.0_wp
1469	pnf2a(:) = nf2a
1470	pvf2a(:,:) = 0.0_wp
1471	pvf2b(:,:) = 0.0_wp
1472	pvfOC1a(:) = 0.0_wp
1473
1474	IF ( isdtyp == 1 ) THEN
1475	!
1476	!-- Read input profiles from PIDS_SALSA
1477	#if defined( __netcdf )
1478	!
1479	!-- Location-dependent size distributions and compositions.
1480	INQUIRE( FILE='PIDS_SALSA'// TRIM( coupling_char ), EXIST=netcdf_extend )
1481	IF ( netcdf_extend ) THEN
1482	!
1483	!-- Open file in read-only mode
1484	CALL open_read_file( 'PIDS_SALSA' // TRIM( coupling_char ), id_faero )
1485	!
1486	!-- Input heights
1487	CALL netcdf_data_input_get_dimension_length( id_faero, nz_file, &
1488	"profile_z" )
1489
1490	ALLOCATE( pr_z(nz_file), pr_mass_fracs_a(maxspec,nz_file), &
1491	pr_mass_fracs_b(maxspec,nz_file), pr_nsect(nbins,nz_file) )
1492	CALL get_variable( id_faero, 'profile_z', pr_z )
1493	!
1494	!-- Mass fracs profile: 1: H2SO4 (sulphuric acid), 2: OC (organic carbon),
1495	!-- 3: BC (black carbon), 4: DU (dust),
1496	!-- 5: SS (sea salt), 6: HNO3 (nitric acid),
1497	!-- 7: NH3 (ammonia)
1498	CALL get_variable( id_faero, "profile_mass_fracs_a", pr_mass_fracs_a,&
1499	0, nz_file-1, 0, maxspec-1 )
1500	CALL get_variable( id_faero, "profile_mass_fracs_b", pr_mass_fracs_b,&
1501	0, nz_file-1, 0, maxspec-1 )
1502	CALL get_variable( id_faero, "profile_nsect", pr_nsect, 0, nz_file-1,&
1503	0, nbins-1 )
1504
1505	kk = 1
1506	DO k = nzb, nz+1
1507	IF ( kk < nz_file ) THEN
1508	DO WHILE ( pr_z(kk+1) <= zu(k) )
1509	kk = kk + 1
1510	IF ( kk == nz_file ) EXIT
1511	ENDDO
1512	ENDIF
1513	IF ( kk < nz_file ) THEN
1514	!
1515	!-- Set initial value for gas compound tracers and initial values
1516	pvf2a(k,:) = pr_mass_fracs_a(:,kk) + ( zu(k) - pr_z(kk) ) / ( &
1517	pr_z(kk+1) - pr_z(kk) ) * ( pr_mass_fracs_a(:,kk+1)&
1518	- pr_mass_fracs_a(:,kk) )
1519	pvf2b(k,:) = pr_mass_fracs_b(:,kk) + ( zu(k) - pr_z(kk) ) / ( &
1520	pr_z(kk+1) - pr_z(kk) ) * ( pr_mass_fracs_b(:,kk+1)&
1521	- pr_mass_fracs_b(:,kk) )
1522	pndist(k,:) = pr_nsect(:,kk) + ( zu(k) - pr_z(kk) ) / ( &
1523	pr_z(kk+1) - pr_z(kk) ) * ( pr_nsect(:,kk+1) - &
1524	pr_nsect(:,kk) )
1525	ELSE
1526	pvf2a(k,:) = pr_mass_fracs_a(:,kk)
1527	pvf2b(k,:) = pr_mass_fracs_b(:,kk)
1528	pndist(k,:) = pr_nsect(:,kk)
1529	ENDIF
1530	IF ( iso4 < 0 ) THEN
1531	pvf2a(k,1) = 0.0_wp
1532	pvf2b(k,1) = 0.0_wp
1533	ENDIF
1534	IF ( ioc < 0 ) THEN
1535	pvf2a(k,2) = 0.0_wp
1536	pvf2b(k,2) = 0.0_wp
1537	ENDIF
1538	IF ( ibc < 0 ) THEN
1539	pvf2a(k,3) = 0.0_wp
1540	pvf2b(k,3) = 0.0_wp
1541	ENDIF
1542	IF ( idu < 0 ) THEN
1543	pvf2a(k,4) = 0.0_wp
1544	pvf2b(k,4) = 0.0_wp
1545	ENDIF
1546	IF ( iss < 0 ) THEN
1547	pvf2a(k,5) = 0.0_wp
1548	pvf2b(k,5) = 0.0_wp
1549	ENDIF
1550	IF ( ino < 0 ) THEN
1551	pvf2a(k,6) = 0.0_wp
1552	pvf2b(k,6) = 0.0_wp
1553	ENDIF
1554	IF ( inh < 0 ) THEN
1555	pvf2a(k,7) = 0.0_wp
1556	pvf2b(k,7) = 0.0_wp
1557	ENDIF
1558	!
1559	!-- Then normalise the mass fraction so that SUM = 1
1560	pvf2a(k,:) = pvf2a(k,:) / SUM( pvf2a(k,:) )
1561	IF ( SUM( pvf2b(k,:) ) > 0.0_wp ) pvf2b(k,:) = pvf2b(k,:) / &
1562	SUM( pvf2b(k,:) )
1563	ENDDO
1564	DEALLOCATE( pr_z, pr_mass_fracs_a, pr_mass_fracs_b, pr_nsect )
1565	ELSE
1566	message_string = 'Input file '// TRIM( 'PIDS_SALSA' ) // &
1567	TRIM( coupling_char ) // ' for SALSA missing!'
1568	CALL message( 'salsa_mod: aerosol_init', 'SA0032', 1, 2, 0, 6, 0 )
1569	ENDIF ! netcdf_extend
1570	#endif
1571
1572	ELSEIF ( isdtyp == 0 ) THEN
1573	!
1574	!-- Mass fractions for species in a and b-bins
1575	IF ( iso4 > 0 ) THEN
1576	pvf2a(:,1) = mass_fracs_a(iso4)
1577	pvf2b(:,1) = mass_fracs_b(iso4)
1578	ENDIF
1579	IF ( ioc > 0 ) THEN
1580	pvf2a(:,2) = mass_fracs_a(ioc)
1581	pvf2b(:,2) = mass_fracs_b(ioc)
1582	ENDIF
1583	IF ( ibc > 0 ) THEN
1584	pvf2a(:,3) = mass_fracs_a(ibc)
1585	pvf2b(:,3) = mass_fracs_b(ibc)
1586	ENDIF
1587	IF ( idu > 0 ) THEN
1588	pvf2a(:,4) = mass_fracs_a(idu)
1589	pvf2b(:,4) = mass_fracs_b(idu)
1590	ENDIF
1591	IF ( iss > 0 ) THEN
1592	pvf2a(:,5) = mass_fracs_a(iss)
1593	pvf2b(:,5) = mass_fracs_b(iss)
1594	ENDIF
1595	IF ( ino > 0 ) THEN
1596	pvf2a(:,6) = mass_fracs_a(ino)
1597	pvf2b(:,6) = mass_fracs_b(ino)
1598	ENDIF
1599	IF ( inh > 0 ) THEN
1600	pvf2a(:,7) = mass_fracs_a(inh)
1601	pvf2b(:,7) = mass_fracs_b(inh)
1602	ENDIF
1603	DO k = nzb, nz+1
1604	pvf2a(k,:) = pvf2a(k,:) / SUM( pvf2a(k,:) )
1605	IF ( SUM( pvf2b(k,:) ) > 0.0_wp ) pvf2b(k,:) = pvf2b(k,:) / &
1606	SUM( pvf2b(k,:) )
1607	ENDDO
1608
1609	CALL size_distribution( n_lognorm, dpg, sigmag, nsect )
1610	!
1611	!-- Normalize by the given total number concentration
1612	nsect = nsect * SUM( n_lognorm ) * 1.0E+6_wp / SUM( nsect )
1613	DO b = in1a, fn2b
1614	pndist(:,b) = nsect(b)
1615	ENDDO
1616	ENDIF
1617
1618	IF ( igctyp == 1 ) THEN
1619	!
1620	!-- Read input profiles from PIDS_CHEM
1621	#if defined( __netcdf )
1622	!
1623	!-- Location-dependent size distributions and compositions.
1624	INQUIRE( FILE='PIDS_CHEM' // TRIM( coupling_char ), EXIST=netcdf_extend )
1625	IF ( netcdf_extend .AND. .NOT. salsa_gases_from_chem ) THEN
1626	!
1627	!-- Open file in read-only mode
1628	CALL open_read_file( 'PIDS_CHEM' // TRIM( coupling_char ), id_fchem )
1629	!
1630	!-- Input heights
1631	CALL netcdf_data_input_get_dimension_length( id_fchem, nz_file, &
1632	"profile_z" )
1633	ALLOCATE( pr_z(nz_file), pr_gas(ngast,nz_file) )
1634	CALL get_variable( id_fchem, 'profile_z', pr_z )
1635	!
1636	!-- Gases:
1637	CALL get_variable( id_fchem, "profile_H2SO4", pr_gas(1,:) )
1638	CALL get_variable( id_fchem, "profile_HNO3", pr_gas(2,:) )
1639	CALL get_variable( id_fchem, "profile_NH3", pr_gas(3,:) )
1640	CALL get_variable( id_fchem, "profile_OCNV", pr_gas(4,:) )
1641	CALL get_variable( id_fchem, "profile_OCSV", pr_gas(5,:) )
1642
1643	kk = 1
1644	DO k = nzb, nz+1
1645	IF ( kk < nz_file ) THEN
1646	DO WHILE ( pr_z(kk+1) <= zu(k) )
1647	kk = kk + 1
1648	IF ( kk == nz_file ) EXIT
1649	ENDDO
1650	ENDIF
1651	IF ( kk < nz_file ) THEN
1652	!
1653	!-- Set initial value for gas compound tracers and initial values
1654	DO g = 1, ngast
1655	salsa_gas(g)%init(k) = pr_gas(g,kk) + ( zu(k) - pr_z(kk) ) &
1656	/ ( pr_z(kk+1) - pr_z(kk) ) * &
1657	( pr_gas(g,kk+1) - pr_gas(g,kk) )
1658	salsa_gas(g)%conc(k,:,:) = salsa_gas(g)%init(k)
1659	ENDDO
1660	ELSE
1661	DO g = 1, ngast
1662	salsa_gas(g)%init(k) = pr_gas(g,kk)
1663	salsa_gas(g)%conc(k,:,:) = salsa_gas(g)%init(k)
1664	ENDDO
1665	ENDIF
1666	ENDDO
1667
1668	DEALLOCATE( pr_z, pr_gas )
1669	ELSEIF ( .NOT. netcdf_extend .AND. .NOT. salsa_gases_from_chem ) THEN
1670	message_string = 'Input file '// TRIM( 'PIDS_CHEM' ) // &
1671	TRIM( coupling_char ) // ' for SALSA missing!'
1672	CALL message( 'salsa_mod: aerosol_init', 'SA0033', 1, 2, 0, 6, 0 )
1673	ENDIF ! netcdf_extend
1674	#endif
1675
1676	ENDIF
1677
1678	IF ( ioc > 0 .AND. iso4 > 0 ) THEN
1679	!-- Both are there, so use the given "massDistrA"
1680	pvfOC1a(:) = pvf2a(:,2) / ( pvf2a(:,2) + pvf2a(:,1) ) ! Normalize
1681	ELSEIF ( ioc > 0 ) THEN
1682	!-- Pure organic carbon
1683	pvfOC1a(:) = 1.0_wp
1684	ELSEIF ( iso4 > 0 ) THEN
1685	!-- Pure SO4
1686	pvfOC1a(:) = 0.0_wp
1687	ELSE
1688	message_string = 'Either OC or SO4 must be active for aerosol region 1a!'
1689	CALL message( 'salsa_mod: aerosol_init', 'SA0021', 1, 2, 0, 6, 0 )
1690	ENDIF
1691
1692	!
1693	!-- Initialize concentrations
1694	DO i = nxlg, nxrg
1695	DO j = nysg, nyng
1696	DO k = nzb, nzt+1
1697	!
1698	!-- Predetermine flag to mask topography
1699	flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_0(k,j,i), 0 ) )
1700	!
1701	!-- a) Number concentrations
1702	!-- Region 1:
1703	DO b = in1a, fn1a
1704	aerosol_number(b)%conc(k,j,i) = pndist(k,b) * flag
1705	IF ( prunmode == 1 ) THEN
1706	aerosol_number(b)%init = pndist(:,b)
1707	ENDIF
1708	ENDDO
1709	!
1710	!-- Region 2:
1711	IF ( nreg > 1 ) THEN
1712	DO b = in2a, fn2a
1713	aerosol_number(b)%conc(k,j,i) = MAX( 0.0_wp, pnf2a(k) ) * &
1714	pndist(k,b) * flag
1715	IF ( prunmode == 1 ) THEN
1716	aerosol_number(b)%init = MAX( 0.0_wp, nf2a ) * pndist(:,b)
1717	ENDIF
1718	ENDDO
1719	IF ( .NOT. no_insoluble ) THEN
1720	DO b = in2b, fn2b
1721	IF ( pnf2a(k) < 1.0_wp ) THEN
1722	aerosol_number(b)%conc(k,j,i) = MAX( 0.0_wp, 1.0_wp &
1723	- pnf2a(k) ) * pndist(k,b) * flag
1724	IF ( prunmode == 1 ) THEN
1725	aerosol_number(b)%init = MAX( 0.0_wp, 1.0_wp - &
1726	nf2a ) * pndist(:,b)
1727	ENDIF
1728	ENDIF
1729	ENDDO
1730	ENDIF
1731	ENDIF
1732	!
1733	!-- b) Aerosol mass concentrations
1734	!-- bin subrange 1: done here separately due to the SO4/OC convention
1735	!-- SO4:
1736	IF ( iso4 > 0 ) THEN
1737	ss = ( iso4 - 1 ) * nbins + in1a !< start
1738	ee = ( iso4 - 1 ) * nbins + fn1a !< end
1739	b = in1a
1740	DO c = ss, ee
1741	aerosol_mass(c)%conc(k,j,i) = MAX( 0.0_wp, 1.0_wp - &
1742	pvfOC1a(k) ) * pndist(k,b) * &
1743	core(b) * arhoh2so4 * flag
1744	IF ( prunmode == 1 ) THEN
1745	aerosol_mass(c)%init = MAX( 0.0_wp, 1.0_wp - MAXVAL( &
1746	pvfOC1a ) ) * pndist(:,b) * &
1747	core(b) * arhoh2so4
1748	ENDIF
1749	b = b+1
1750	ENDDO
1751	ENDIF
1752	!-- OC:
1753	IF ( ioc > 0 ) THEN
1754	ss = ( ioc - 1 ) * nbins + in1a !< start
1755	ee = ( ioc - 1 ) * nbins + fn1a !< end
1756	b = in1a
1757	DO c = ss, ee
1758	aerosol_mass(c)%conc(k,j,i) = MAX( 0.0_wp, pvfOC1a(k) ) * &
1759	pndist(k,b) * core(b) * arhooc * flag
1760	IF ( prunmode == 1 ) THEN
1761	aerosol_mass(c)%init = MAX( 0.0_wp, MAXVAL( pvfOC1a ) ) &
1762	* pndist(:,b) * core(b) * arhooc
1763	ENDIF
1764	b = b+1
1765	ENDDO
1766	ENDIF
1767
1768	prunmode = 3 ! Init only once
1769
1770	ENDDO !< k
1771	ENDDO !< j
1772	ENDDO !< i
1773
1774	!
1775	!-- c) Aerosol mass concentrations
1776	!-- bin subrange 2:
1777	IF ( nreg > 1 ) THEN
1778
1779	IF ( iso4 > 0 ) THEN
1780	CALL set_aero_mass( iso4, pvf2a(:,1), pvf2b(:,1), pnf2a, pndist, &
1781	core, arhoh2so4 )
1782	ENDIF
1783	IF ( ioc > 0 ) THEN
1784	CALL set_aero_mass( ioc, pvf2a(:,2), pvf2b(:,2), pnf2a, pndist, core,&
1785	arhooc )
1786	ENDIF
1787	IF ( ibc > 0 ) THEN
1788	CALL set_aero_mass( ibc, pvf2a(:,3), pvf2b(:,3), pnf2a, pndist, core,&
1789	arhobc )
1790	ENDIF
1791	IF ( idu > 0 ) THEN
1792	CALL set_aero_mass( idu, pvf2a(:,4), pvf2b(:,4), pnf2a, pndist, core,&
1793	arhodu )
1794	ENDIF
1795	IF ( iss > 0 ) THEN
1796	CALL set_aero_mass( iss, pvf2a(:,5), pvf2b(:,5), pnf2a, pndist, core,&
1797	arhoss )
1798	ENDIF
1799	IF ( ino > 0 ) THEN
1800	CALL set_aero_mass( ino, pvf2a(:,6), pvf2b(:,6), pnf2a, pndist, core,&
1801	arhohno3 )
1802	ENDIF
1803	IF ( inh > 0 ) THEN
1804	CALL set_aero_mass( inh, pvf2a(:,7), pvf2b(:,7), pnf2a, pndist, core,&
1805	arhonh3 )
1806	ENDIF
1807
1808	ENDIF
1809
1810	END SUBROUTINE aerosol_init
1811
1812	!------------------------------------------------------------------------------!
1813	! Description:
1814	! ------------
1815	!> Create a lognormal size distribution and discretise to a sectional
1816	!> representation.
1817	!------------------------------------------------------------------------------!
1818	SUBROUTINE size_distribution( in_ntot, in_dpg, in_sigma, psd_sect )
1819
1820	IMPLICIT NONE
1821
1822	!-- Log-normal size distribution: modes
1823	REAL(wp), DIMENSION(:), INTENT(in) :: in_dpg !< geometric mean diameter
1824	!< (micrometres)
1825	REAL(wp), DIMENSION(:), INTENT(in) :: in_ntot !< number conc. (#/cm3)
1826	REAL(wp), DIMENSION(:), INTENT(in) :: in_sigma !< standard deviation
1827	REAL(wp), DIMENSION(:), INTENT(inout) :: psd_sect !< sectional size
1828	!< distribution
1829	INTEGER(iwp) :: b !< running index: bin
1830	INTEGER(iwp) :: ib !< running index: iteration
1831	REAL(wp) :: d1 !< particle diameter (m, dummy)
1832	REAL(wp) :: d2 !< particle diameter (m, dummy)
1833	REAL(wp) :: delta_d !< (d2-d1)/10
1834	REAL(wp) :: deltadp !< bin width
1835	REAL(wp) :: dmidi !< ( d1 + d2 ) / 2
1836
1837	DO b = in1a, fn2b !< aerosol size bins
1838	psd_sect(b) = 0.0_wp
1839	!-- Particle diameter at the low limit (largest in the bin) (m)
1840	d1 = ( aero(b)%vlolim / api6 ) ** ( 1.0_wp / 3.0_wp )
1841	!-- Particle diameter at the high limit (smallest in the bin) (m)
1842	d2 = ( aero(b)%vhilim / api6 ) ** ( 1.0_wp / 3.0_wp )
1843	!-- Span of particle diameter in a bin (m)
1844	delta_d = ( d2 - d1 ) / 10.0_wp
1845	!-- Iterate:
1846	DO ib = 1, 10
1847	d1 = ( aero(b)%vlolim / api6 ) ** ( 1.0_wp / 3.0_wp ) + ( ib - 1) &
1848	* delta_d
1849	d2 = d1 + delta_d
1850	dmidi = ( d1 + d2 ) / 2.0_wp
1851	deltadp = LOG10( d2 / d1 )
1852
1853	!-- Size distribution
1854	!-- in_ntot = total number, total area, or total volume concentration
1855	!-- in_dpg = geometric-mean number, area, or volume diameter
1856	!-- n(k) = number, area, or volume concentration in a bin
1857	!-- n_lognorm and dpg converted to units of #/m3 and m
1858	psd_sect(b) = psd_sect(b) + SUM( in_ntot * 1.0E+6_wp * deltadp / &
1859	( SQRT( 2.0_wp * pi ) * LOG10( in_sigma ) ) * &
1860	EXP( -LOG10( dmidi / ( 1.0E-6_wp * in_dpg ) )**2.0_wp / &
1861	( 2.0_wp * LOG10( in_sigma ) ** 2.0_wp ) ) )
1862
1863	ENDDO
1864	ENDDO
1865
1866	END SUBROUTINE size_distribution
1867
1868	!------------------------------------------------------------------------------!
1869	! Description:
1870	! ------------
1871	!> Sets the mass concentrations to aerosol arrays in 2a and 2b.
1872	!>
1873	!> Tomi Raatikainen, FMI, 29.2.2016
1874	!------------------------------------------------------------------------------!
1875	SUBROUTINE set_aero_mass( ispec, ppvf2a, ppvf2b, ppnf2a, ppndist, pcore, prho )
1876
1877	IMPLICIT NONE
1878
1879	INTEGER(iwp), INTENT(in) :: ispec !< Aerosol species index
1880	REAL(wp), INTENT(in) :: pcore(nbins) !< Aerosol bin mid core volume
1881	REAL(wp), INTENT(in) :: ppndist(0:nz+1,nbins) !< Aerosol size distribution
1882	REAL(wp), INTENT(in) :: ppnf2a(0:nz+1) !< Number fraction for 2a
1883	REAL(wp), INTENT(in) :: ppvf2a(0:nz+1) !< Mass distributions for a
1884	REAL(wp), INTENT(in) :: ppvf2b(0:nz+1) !< and b bins
1885	REAL(wp), INTENT(in) :: prho !< Aerosol density
1886	INTEGER(iwp) :: b !< loop index
1887	INTEGER(iwp) :: c !< loop index
1888	INTEGER(iwp) :: ee !< index: end
1889	INTEGER(iwp) :: i !< loop index
1890	INTEGER(iwp) :: j !< loop index
1891	INTEGER(iwp) :: k !< loop index
1892	INTEGER(iwp) :: prunmode !< 1 = initialise
1893	INTEGER(iwp) :: ss !< index: start
1894	REAL(wp) :: flag !< flag to mask topography grid points
1895
1896	prunmode = 1
1897
1898	DO i = nxlg, nxrg
1899	DO j = nysg, nyng
1900	DO k = nzb, nzt+1
1901	!
1902	!-- Predetermine flag to mask topography
1903	flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_0(k,j,i), 0 ) )
1904	!
1905	!-- Regime 2a:
1906	ss = ( ispec - 1 ) * nbins + in2a
1907	ee = ( ispec - 1 ) * nbins + fn2a
1908	b = in2a
1909	DO c = ss, ee
1910	aerosol_mass(c)%conc(k,j,i) = MAX( 0.0_wp, ppvf2a(k) ) * &
1911	ppnf2a(k) * ppndist(k,b) * pcore(b) * prho * flag
1912	IF ( prunmode == 1 ) THEN
1913	aerosol_mass(c)%init = MAX( 0.0_wp, MAXVAL( ppvf2a(:) ) ) * &
1914	MAXVAL( ppnf2a ) * pcore(b) * prho * &
1915	MAXVAL( ppndist(:,b) )
1916	ENDIF
1917	b = b+1
1918	ENDDO
1919	!-- Regime 2b:
1920	IF ( .NOT. no_insoluble ) THEN
1921	ss = ( ispec - 1 ) * nbins + in2b
1922	ee = ( ispec - 1 ) * nbins + fn2b
1923	b = in2a
1924	DO c = ss, ee
1925	aerosol_mass(c)%conc(k,j,i) = MAX( 0.0_wp, ppvf2b(k) ) * ( &
1926	1.0_wp - ppnf2a(k) ) * ppndist(k,b) * &
1927	pcore(b) * prho * flag
1928	IF ( prunmode == 1 ) THEN
1929	aerosol_mass(c)%init = MAX( 0.0_wp, MAXVAL( ppvf2b(:) ) )&
1930	* ( 1.0_wp - MAXVAL( ppnf2a ) ) * &
1931	MAXVAL( ppndist(:,b) ) * pcore(b) * prho
1932	ENDIF
1933	b = b+1
1934	ENDDO
1935	ENDIF
1936	prunmode = 3 ! Init only once
1937	ENDDO
1938	ENDDO
1939	ENDDO
1940	END SUBROUTINE set_aero_mass
1941
1942	!------------------------------------------------------------------------------!
1943	! Description:
1944	! ------------
1945	!> Swapping of timelevels
1946	!------------------------------------------------------------------------------!
1947	SUBROUTINE salsa_swap_timelevel( mod_count )
1948
1949	IMPLICIT NONE
1950
1951	INTEGER(iwp), INTENT(IN) :: mod_count !<
1952	INTEGER(iwp) :: b !<
1953	INTEGER(iwp) :: c !<
1954	INTEGER(iwp) :: cc !<
1955	INTEGER(iwp) :: g !<
1956
1957	!
1958	!-- Example for prognostic variable "prog_var"
1959	#if defined( __nopointer )
1960	IF ( myid == 0 ) THEN
1961	message_string = ' SALSA runs only with POINTER Version'
1962	CALL message( 'salsa_swap_timelevel', 'SA0022', 1, 2, 0, 6, 0 )
1963	ENDIF
1964	#else
1965
1966	SELECT CASE ( mod_count )
1967
1968	CASE ( 0 )
1969
1970	DO b = 1, nbins
1971	aerosol_number(b)%conc(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => &
1972	nconc_1(:,:,:,b)
1973	aerosol_number(b)%conc_p(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => &
1974	nconc_2(:,:,:,b)
1975	DO c = 1, ncc_tot
1976	cc = ( c-1 ) * nbins + b ! required due to possible Intel18 bug
1977	aerosol_mass(cc)%conc(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => &
1978	mconc_1(:,:,:,cc)
1979	aerosol_mass(cc)%conc_p(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => &
1980	mconc_2(:,:,:,cc)
1981	ENDDO
1982	ENDDO
1983
1984	IF ( .NOT. salsa_gases_from_chem ) THEN
1985	DO g = 1, ngast
1986	salsa_gas(g)%conc(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => &
1987	gconc_1(:,:,:,g)
1988	salsa_gas(g)%conc_p(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => &
1989	gconc_2(:,:,:,g)
1990	ENDDO
1991	ENDIF
1992
1993	CASE ( 1 )
1994
1995	DO b = 1, nbins
1996	aerosol_number(b)%conc(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => &
1997	nconc_2(:,:,:,b)
1998	aerosol_number(b)%conc_p(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => &
1999	nconc_1(:,:,:,b)
2000	DO c = 1, ncc_tot
2001	cc = ( c-1 ) * nbins + b ! required due to possible Intel18 bug
2002	aerosol_mass(cc)%conc(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => &
2003	mconc_2(:,:,:,cc)
2004	aerosol_mass(cc)%conc_p(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => &
2005	mconc_1(:,:,:,cc)
2006	ENDDO
2007	ENDDO
2008
2009	IF ( .NOT. salsa_gases_from_chem ) THEN
2010	DO g = 1, ngast
2011	salsa_gas(g)%conc(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => &
2012	gconc_2(:,:,:,g)
2013	salsa_gas(g)%conc_p(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => &
2014	gconc_1(:,:,:,g)
2015	ENDDO
2016	ENDIF
2017
2018	END SELECT
2019	#endif
2020
2021	END SUBROUTINE salsa_swap_timelevel
2022
2023
2024	!------------------------------------------------------------------------------!
2025	! Description:
2026	! ------------
2027	!> This routine reads the respective restart data.
2028	!------------------------------------------------------------------------------!
2029	SUBROUTINE salsa_rrd_local( i, k, nxlf, nxlc, nxl_on_file, nxrf, nxrc, &
2030	nxr_on_file, nynf, nync, nyn_on_file, nysf, &
2031	nysc, nys_on_file, tmp_3d, found )
2032
2033
2034	IMPLICIT NONE
2035
2036	CHARACTER (LEN=20) :: field_char !<
2037	INTEGER(iwp) :: b !<
2038	INTEGER(iwp) :: c !<
2039	INTEGER(iwp) :: g !<
2040	INTEGER(iwp) :: i !<
2041	INTEGER(iwp) :: k !<
2042	INTEGER(iwp) :: nxlc !<
2043	INTEGER(iwp) :: nxlf !<
2044	INTEGER(iwp) :: nxl_on_file !<
2045	INTEGER(iwp) :: nxrc !<
2046	INTEGER(iwp) :: nxrf !<
2047	INTEGER(iwp) :: nxr_on_file !<
2048	INTEGER(iwp) :: nync !<
2049	INTEGER(iwp) :: nynf !<
2050	INTEGER(iwp) :: nyn_on_file !<
2051	INTEGER(iwp) :: nysc !<
2052	INTEGER(iwp) :: nysf !<
2053	INTEGER(iwp) :: nys_on_file !<
2054
2055	LOGICAL, INTENT(OUT) :: found
2056
2057	REAL(wp), &
2058	DIMENSION(nzb:nzt+1,nys_on_file-nbgp:nyn_on_file+nbgp,nxl_on_file-nbgp:nxr_on_file+nbgp) :: tmp_3d !<
2059
2060	found = .FALSE.
2061
2062	IF ( read_restart_data_salsa ) THEN
2063
2064	SELECT CASE ( restart_string(1:length) )
2065
2066	CASE ( 'aerosol_number' )
2067	DO b = 1, nbins
2068	IF ( k == 1 ) READ ( 13 ) tmp_3d
2069	aerosol_number(b)%conc(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) = &
2070	tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
2071	found = .TRUE.
2072	ENDDO
2073
2074	CASE ( 'aerosol_mass' )
2075	DO c = 1, ncc_tot * nbins
2076	IF ( k == 1 ) READ ( 13 ) tmp_3d
2077	aerosol_mass(c)%conc(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) = &
2078	tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
2079	found = .TRUE.
2080	ENDDO
2081
2082	CASE ( 'salsa_gas' )
2083	DO g = 1, ngast
2084	IF ( k == 1 ) READ ( 13 ) tmp_3d
2085	salsa_gas(g)%conc(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) = &
2086	tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
2087	found = .TRUE.
2088	ENDDO
2089
2090	CASE DEFAULT
2091	found = .FALSE.
2092
2093	END SELECT
2094	ENDIF
2095
2096	END SUBROUTINE salsa_rrd_local
2097
2098
2099	!------------------------------------------------------------------------------!
2100	! Description:
2101	! ------------
2102	!> This routine writes the respective restart data.
2103	!> Note that the following input variables in PARIN have to be equal between
2104	!> restart runs:
2105	!> listspec, nbin, nbin2, nf2a, ncc, mass_fracs_a, mass_fracs_b
2106	!------------------------------------------------------------------------------!
2107	SUBROUTINE salsa_wrd_local
2108
2109	IMPLICIT NONE
2110
2111	INTEGER(iwp) :: b !<
2112	INTEGER(iwp) :: c !<
2113	INTEGER(iwp) :: g !<
2114
2115	IF ( write_binary .AND. write_binary_salsa ) THEN
2116
2117	CALL wrd_write_string( 'aerosol_number' )
2118	DO b = 1, nbins
2119	WRITE ( 14 ) aerosol_number(b)%conc
2120	ENDDO
2121
2122	CALL wrd_write_string( 'aerosol_mass' )
2123	DO c = 1, nbins*ncc_tot
2124	WRITE ( 14 ) aerosol_mass(c)%conc
2125	ENDDO
2126
2127	CALL wrd_write_string( 'salsa_gas' )
2128	DO g = 1, ngast
2129	WRITE ( 14 ) salsa_gas(g)%conc
2130	ENDDO
2131
2132	ENDIF
2133
2134	END SUBROUTINE salsa_wrd_local
2135
2136
2137	!------------------------------------------------------------------------------!
2138	! Description:
2139	! ------------
2140	!> Performs necessary unit and dimension conversion between the host model and
2141	!> SALSA module, and calls the main SALSA routine.
2142	!> Partially adobted form the original SALSA boxmodel version.
2143	!> Now takes masses in as kg/kg from LES!! Converted to m3/m3 for SALSA
2144	!> 05/2016 Juha: This routine is still pretty much in its original shape.
2145	!> It's dumb as a mule and twice as ugly, so implementation of
2146	!> an improved solution is necessary sooner or later.
2147	!> Juha Tonttila, FMI, 2014
2148	!> Jaakko Ahola, FMI, 2016
2149	!> Only aerosol processes included, Mona Kurppa, UHel, 2017
2150	!------------------------------------------------------------------------------!
2151	SUBROUTINE salsa_driver( i, j, prunmode )
2152
2153	USE arrays_3d, &
2154	ONLY: pt_p, q_p, rho_air_zw, u, v, w
2155
2156	USE plant_canopy_model_mod, &
2157	ONLY: lad_s
2158
2159	USE surface_mod, &
2160	ONLY: surf_def_h, surf_def_v, surf_lsm_h, surf_lsm_v, surf_usm_h, &
2161	surf_usm_v
2162
2163	IMPLICIT NONE
2164
2165	INTEGER(iwp), INTENT(in) :: i !< loop index
2166	INTEGER(iwp), INTENT(in) :: j !< loop index
2167	INTEGER(iwp), INTENT(in) :: prunmode !< 1: Initialization call
2168	!< 2: Spinup period call
2169	!< 3: Regular runtime call
2170	!-- Local variables
2171	TYPE(t_section), DIMENSION(fn2b) :: aero_old !< helper array
2172	INTEGER(iwp) :: bb !< loop index
2173	INTEGER(iwp) :: cc !< loop index
2174	INTEGER(iwp) :: endi !< end index
2175	INTEGER(iwp) :: k_wall !< vertical index of topography top
2176	INTEGER(iwp) :: k !< loop index
2177	INTEGER(iwp) :: l !< loop index
2178	INTEGER(iwp) :: nc_h2o !< index of H2O in the prtcl index table
2179	INTEGER(iwp) :: ss !< loop index
2180	INTEGER(iwp) :: str !< start index
2181	INTEGER(iwp) :: vc !< default index in prtcl
2182	REAL(wp) :: cw_old !< previous H2O mixing ratio
2183	REAL(wp) :: flag !< flag to mask topography grid points
2184	REAL(wp), DIMENSION(nzb:nzt+1) :: in_adn !< air density (kg/m3)
2185	REAL(wp), DIMENSION(nzb:nzt+1) :: in_cs !< H2O sat. vapour conc.
2186	REAL(wp), DIMENSION(nzb:nzt+1) :: in_cw !< H2O vapour concentration
2187	REAL(wp) :: in_lad !< leaf area density (m2/m3)
2188	REAL(wp), DIMENSION(nzb:nzt+1) :: in_p !< pressure (Pa)
2189	REAL(wp) :: in_rh !< relative humidity
2190	REAL(wp), DIMENSION(nzb:nzt+1) :: in_t !< temperature (K)
2191	REAL(wp), DIMENSION(nzb:nzt+1) :: in_u !< wind magnitude (m/s)
2192	REAL(wp), DIMENSION(nzb:nzt+1) :: kvis !< kinematic viscosity of air(m2/s)
2193	REAL(wp), DIMENSION(nzb:nzt+1,fn2b) :: Sc !< particle Schmidt number
2194	REAL(wp), DIMENSION(nzb:nzt+1,fn2b) :: vd !< particle fall seed (m/s,
2195	!< sedimentation velocity)
2196	REAL(wp), DIMENSION(nzb:nzt+1) :: ppm_to_nconc !< Conversion factor
2197	!< from ppm to #/m3
2198	REAL(wp) :: zgso4 !< SO4
2199	REAL(wp) :: zghno3 !< HNO3
2200	REAL(wp) :: zgnh3 !< NH3
2201	REAL(wp) :: zgocnv !< non-volatile OC
2202	REAL(wp) :: zgocsv !< semi-volatile OC
2203
2204	aero_old(:)%numc = 0.0_wp
2205	in_adn = 0.0_wp
2206	in_cs = 0.0_wp
2207	in_cw = 0.0_wp
2208	in_lad = 0.0_wp
2209	in_rh = 0.0_wp
2210	in_p = 0.0_wp
2211	in_t = 0.0_wp
2212	in_u = 0.0_wp
2213	kvis = 0.0_wp
2214	Sc = 0.0_wp
2215	vd = 0.0_wp
2216	ppm_to_nconc = 1.0_wp
2217	zgso4 = nclim
2218	zghno3 = nclim
2219	zgnh3 = nclim
2220	zgocnv = nclim
2221	zgocsv = nclim
2222
2223	!
2224	!-- Aerosol number is always set, but mass can be uninitialized
2225	DO cc = 1, nbins
2226	aero(cc)%volc = 0.0_wp
2227	aero_old(cc)%volc = 0.0_wp
2228	ENDDO
2229	!
2230	!-- Set the salsa runtime config (How to make this more efficient?)
2231	CALL set_salsa_runtime( prunmode )
2232	!
2233	!-- Calculate thermodynamic quantities needed in SALSA
2234	CALL salsa_thrm_ij( i, j, p_ij=in_p, temp_ij=in_t, cw_ij=in_cw, &
2235	cs_ij=in_cs, adn_ij=in_adn )
2236	!
2237	!-- Magnitude of wind: needed for deposition
2238	IF ( lsdepo ) THEN
2239	in_u(nzb+1:nzt) = SQRT( &
2240	( 0.5_wp * ( u(nzb+1:nzt,j,i) + u(nzb+1:nzt,j,i+1) ) )**2 + &
2241	( 0.5_wp * ( v(nzb+1:nzt,j,i) + v(nzb+1:nzt,j+1,i) ) )**2 + &
2242	( 0.5_wp * ( w(nzb:nzt-1,j,i) + w(nzb+1:nzt,j, i) ) )**2 )
2243	ENDIF
2244	!
2245	!-- Calculate conversion factors for gas concentrations
2246	ppm_to_nconc = for_ppm_to_nconc * in_p / in_t
2247	!
2248	!-- Determine topography-top index on scalar grid
2249	k_wall = MAXLOC( MERGE( 1, 0, BTEST( wall_flags_0(:,j,i), 12 ) ), &
2250	DIM = 1 ) - 1
2251
2252	DO k = nzb+1, nzt
2253	!
2254	!-- Predetermine flag to mask topography
2255	flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_0(k,j,i), 0 ) )
2256	!
2257	!-- Do not run inside buildings
2258	IF ( flag == 0.0_wp ) CYCLE
2259	!
2260	!-- Wind velocity for dry depositon on vegetation
2261	IF ( lsdepo_vege .AND. plant_canopy ) THEN
2262	in_lad = lad_s(k-k_wall,j,i)
2263	ENDIF
2264	!
2265	!-- For initialization and spinup, limit the RH with the parameter rhlim
2266	IF ( prunmode < 3 ) THEN
2267	in_cw(k) = MIN( in_cw(k), in_cs(k) * rhlim )
2268	ELSE
2269	in_cw(k) = in_cw(k)
2270	ENDIF
2271	cw_old = in_cw(k) !* in_adn(k)
2272	!
2273	!-- Set volume concentrations:
2274	!-- Sulphate (SO4) or sulphuric acid H2SO4
2275	IF ( iso4 > 0 ) THEN
2276	vc = 1
2277	str = ( iso4-1 ) * nbins + 1 ! start index
2278	endi = iso4 * nbins ! end index
2279	cc = 1
2280	DO ss = str, endi
2281	aero(cc)%volc(vc) = aerosol_mass(ss)%conc(k,j,i) / arhoh2so4
2282	cc = cc+1
2283	ENDDO
2284	aero_old(1:nbins)%volc(vc) = aero(1:nbins)%volc(vc)
2285	ENDIF
2286
2287	!-- Organic carbon (OC) compounds
2288	IF ( ioc > 0 ) THEN
2289	vc = 2
2290	str = ( ioc-1 ) * nbins + 1
2291	endi = ioc * nbins
2292	cc = 1
2293	DO ss = str, endi
2294	aero(cc)%volc(vc) = aerosol_mass(ss)%conc(k,j,i) / arhooc
2295	cc = cc+1
2296	ENDDO
2297	aero_old(1:nbins)%volc(vc) = aero(1:nbins)%volc(vc)
2298	ENDIF
2299
2300	!-- Black carbon (BC)
2301	IF ( ibc > 0 ) THEN
2302	vc = 3
2303	str = ( ibc-1 ) * nbins + 1 + fn1a
2304	endi = ibc * nbins
2305	cc = 1 + fn1a
2306	DO ss = str, endi
2307	aero(cc)%volc(vc) = aerosol_mass(ss)%conc(k,j,i) / arhobc
2308	cc = cc+1
2309	ENDDO
2310	aero_old(1:nbins)%volc(vc) = aero(1:nbins)%volc(vc)
2311	ENDIF
2312
2313	!-- Dust (DU)
2314	IF ( idu > 0 ) THEN
2315	vc = 4
2316	str = ( idu-1 ) * nbins + 1 + fn1a
2317	endi = idu * nbins
2318	cc = 1 + fn1a
2319	DO ss = str, endi
2320	aero(cc)%volc(vc) = aerosol_mass(ss)%conc(k,j,i) / arhodu
2321	cc = cc+1
2322	ENDDO
2323	aero_old(1:nbins)%volc(vc) = aero(1:nbins)%volc(vc)
2324	ENDIF
2325
2326	!-- Sea salt (SS)
2327	IF ( iss > 0 ) THEN
2328	vc = 5
2329	str = ( iss-1 ) * nbins + 1 + fn1a
2330	endi = iss * nbins
2331	cc = 1 + fn1a
2332	DO ss = str, endi
2333	aero(cc)%volc(vc) = aerosol_mass(ss)%conc(k,j,i) / arhoss
2334	cc = cc+1
2335	ENDDO
2336	aero_old(1:nbins)%volc(vc) = aero(1:nbins)%volc(vc)
2337	ENDIF
2338
2339	!-- Nitrate (NO(3-)) or nitric acid HNO3
2340	IF ( ino > 0 ) THEN
2341	vc = 6
2342	str = ( ino-1 ) * nbins + 1
2343	endi = ino * nbins
2344	cc = 1
2345	DO ss = str, endi
2346	aero(cc)%volc(vc) = aerosol_mass(ss)%conc(k,j,i) / arhohno3
2347	cc = cc+1
2348	ENDDO
2349	aero_old(1:nbins)%volc(vc) = aero(1:nbins)%volc(vc)
2350	ENDIF
2351
2352	!-- Ammonium (NH(4+)) or ammonia NH3
2353	IF ( inh > 0 ) THEN
2354	vc = 7
2355	str = ( inh-1 ) * nbins + 1
2356	endi = inh * nbins
2357	cc = 1
2358	DO ss = str, endi
2359	aero(cc)%volc(vc) = aerosol_mass(ss)%conc(k,j,i) / arhonh3
2360	cc = cc+1
2361	ENDDO
2362	aero_old(1:nbins)%volc(vc) = aero(1:nbins)%volc(vc)
2363	ENDIF
2364
2365	!-- Water (always used)
2366	nc_h2o = get_index( prtcl,'H2O' )
2367	vc = 8
2368	str = ( nc_h2o-1 ) * nbins + 1
2369	endi = nc_h2o * nbins
2370	cc = 1
2371	IF ( advect_particle_water ) THEN
2372	DO ss = str, endi
2373	aero(cc)%volc(vc) = aerosol_mass(ss)%conc(k,j,i) / arhoh2o
2374	cc = cc+1
2375	ENDDO
2376	ELSE
2377	aero(1:nbins)%volc(vc) = mclim
2378	ENDIF
2379	aero_old(1:nbins)%volc(vc) = aero(1:nbins)%volc(vc)
2380	!
2381	!-- Number concentrations (numc) and particle sizes
2382	!-- (dwet = wet diameter, core = dry volume)
2383	DO bb = 1, nbins
2384	aero(bb)%numc = aerosol_number(bb)%conc(k,j,i)
2385	aero_old(bb)%numc = aero(bb)%numc
2386	IF ( aero(bb)%numc > nclim ) THEN
2387	aero(bb)%dwet = ( SUM( aero(bb)%volc(:) ) / aero(bb)%numc / api6 )&
2388	**( 1.0_wp / 3.0_wp )
2389	aero(bb)%core = SUM( aero(bb)%volc(1:7) ) / aero(bb)%numc
2390	ELSE
2391	aero(bb)%dwet = aero(bb)%dmid
2392	aero(bb)%core = api6 * ( aero(bb)%dwet ) ** 3.0_wp
2393	ENDIF
2394	ENDDO
2395	!
2396	!-- On EACH call of salsa_driver, calculate the ambient sizes of
2397	!-- particles by equilibrating soluble fraction of particles with water
2398	!-- using the ZSR method.
2399	in_rh = in_cw(k) / in_cs(k)
2400	IF ( prunmode==1 .OR. .NOT. advect_particle_water ) THEN
2401	CALL equilibration( in_rh, in_t(k), aero, .TRUE. )
2402	ENDIF
2403	!
2404	!-- Gaseous tracer concentrations in #/m3
2405	IF ( salsa_gases_from_chem ) THEN
2406	!
2407	!-- Convert concentrations in ppm to #/m3
2408	zgso4 = chem_species(gas_index_chem(1))%conc(k,j,i) * ppm_to_nconc(k)
2409	zghno3 = chem_species(gas_index_chem(2))%conc(k,j,i) * ppm_to_nconc(k)
2410	zgnh3 = chem_species(gas_index_chem(3))%conc(k,j,i) * ppm_to_nconc(k)
2411	zgocnv = chem_species(gas_index_chem(4))%conc(k,j,i) * ppm_to_nconc(k)
2412	zgocsv = chem_species(gas_index_chem(5))%conc(k,j,i) * ppm_to_nconc(k)
2413	ELSE
2414	zgso4 = salsa_gas(1)%conc(k,j,i)
2415	zghno3 = salsa_gas(2)%conc(k,j,i)
2416	zgnh3 = salsa_gas(3)%conc(k,j,i)
2417	zgocnv = salsa_gas(4)%conc(k,j,i)
2418	zgocsv = salsa_gas(5)%conc(k,j,i)
2419	ENDIF
2420	!
2421	!-- ***************************************!
2422	!-- Run SALSA !
2423	!-- ***************************************!
2424	CALL run_salsa( in_p(k), in_cw(k), in_cs(k), in_t(k), in_u(k), &
2425	in_adn(k), in_lad, zgso4, zgocnv, zgocsv, zghno3, zgnh3,&
2426	aero, prtcl, kvis(k), Sc(k,:), vd(k,:), dt_salsa )
2427	!-- ***************************************!
2428	IF ( lsdepo ) sedim_vd(k,j,i,:) = vd(k,:)
2429	!
2430	!-- Calculate changes in concentrations
2431	DO bb = 1, nbins
2432	aerosol_number(bb)%conc(k,j,i) = aerosol_number(bb)%conc(k,j,i) &
2433	+ ( aero(bb)%numc - aero_old(bb)%numc ) * flag
2434	ENDDO
2435
2436	IF ( iso4 > 0 ) THEN
2437	vc = 1
2438	str = ( iso4-1 ) * nbins + 1
2439	endi = iso4 * nbins
2440	cc = 1
2441	DO ss = str, endi
2442	aerosol_mass(ss)%conc(k,j,i) = aerosol_mass(ss)%conc(k,j,i) &
2443	+ ( aero(cc)%volc(vc) - aero_old(cc)%volc(vc) ) &
2444	* arhoh2so4 * flag
2445	cc = cc+1
2446	ENDDO
2447	ENDIF
2448
2449	IF ( ioc > 0 ) THEN
2450	vc = 2
2451	str = ( ioc-1 ) * nbins + 1
2452	endi = ioc * nbins
2453	cc = 1
2454	DO ss = str, endi
2455	aerosol_mass(ss)%conc(k,j,i) = aerosol_mass(ss)%conc(k,j,i) &
2456	+ ( aero(cc)%volc(vc) - aero_old(cc)%volc(vc) ) &
2457	* arhooc * flag
2458	cc = cc+1
2459	ENDDO
2460	ENDIF
2461
2462	IF ( ibc > 0 ) THEN
2463	vc = 3
2464	str = ( ibc-1 ) * nbins + 1 + fn1a
2465	endi = ibc * nbins
2466	cc = 1 + fn1a
2467	DO ss = str, endi
2468	aerosol_mass(ss)%conc(k,j,i) = aerosol_mass(ss)%conc(k,j,i) &
2469	+ ( aero(cc)%volc(vc) - aero_old(cc)%volc(vc) ) &
2470	* arhobc * flag
2471	cc = cc+1
2472	ENDDO
2473	ENDIF
2474
2475	IF ( idu > 0 ) THEN
2476	vc = 4
2477	str = ( idu-1 ) * nbins + 1 + fn1a
2478	endi = idu * nbins
2479	cc = 1 + fn1a
2480	DO ss = str, endi
2481	aerosol_mass(ss)%conc(k,j,i) = aerosol_mass(ss)%conc(k,j,i) &
2482	+ ( aero(cc)%volc(vc) - aero_old(cc)%volc(vc) ) &
2483	* arhodu * flag
2484	cc = cc+1
2485	ENDDO
2486	ENDIF
2487
2488	IF ( iss > 0 ) THEN
2489	vc = 5
2490	str = ( iss-1 ) * nbins + 1 + fn1a
2491	endi = iss * nbins
2492	cc = 1 + fn1a
2493	DO ss = str, endi
2494	aerosol_mass(ss)%conc(k,j,i) = aerosol_mass(ss)%conc(k,j,i) &
2495	+ ( aero(cc)%volc(vc) - aero_old(cc)%volc(vc) ) &
2496	* arhoss * flag
2497	cc = cc+1
2498	ENDDO
2499	ENDIF
2500
2501	IF ( ino > 0 ) THEN
2502	vc = 6
2503	str = ( ino-1 ) * nbins + 1
2504	endi = ino * nbins
2505	cc = 1
2506	DO ss = str, endi
2507	aerosol_mass(ss)%conc(k,j,i) = aerosol_mass(ss)%conc(k,j,i) &
2508	+ ( aero(cc)%volc(vc) - aero_old(cc)%volc(vc) ) &
2509	* arhohno3 * flag
2510	cc = cc+1
2511	ENDDO
2512	ENDIF
2513
2514	IF ( inh > 0 ) THEN
2515	vc = 7
2516	str = ( ino-1 ) * nbins + 1
2517	endi = ino * nbins
2518	cc = 1
2519	DO ss = str, endi
2520	aerosol_mass(ss)%conc(k,j,i) = aerosol_mass(ss)%conc(k,j,i) &
2521	+ ( aero(cc)%volc(vc) - aero_old(cc)%volc(vc) ) &
2522	* arhonh3 * flag
2523	cc = cc+1
2524	ENDDO
2525	ENDIF
2526
2527	IF ( advect_particle_water ) THEN
2528	nc_h2o = get_index( prtcl,'H2O' )
2529	vc = 8
2530	str = ( nc_h2o-1 ) * nbins + 1
2531	endi = nc_h2o * nbins
2532	cc = 1
2533	DO ss = str, endi
2534	aerosol_mass(ss)%conc(k,j,i) = aerosol_mass(ss)%conc(k,j,i) &
2535	+ ( aero(cc)%volc(vc) - aero_old(cc)%volc(vc) ) &
2536	* arhoh2o * flag
2537	IF ( prunmode == 1 ) THEN
2538	aerosol_mass(ss)%init(k) = MAX( aerosol_mass(ss)%init(k), &
2539	aerosol_mass(ss)%conc(k,j,i) )
2540	ENDIF
2541	cc = cc+1
2542	ENDDO
2543	ENDIF
2544
2545	!-- Condensation of precursor gases
2546	IF ( lscndgas ) THEN
2547	IF ( salsa_gases_from_chem ) THEN
2548	!
2549	!-- SO4 (or H2SO4)
2550	chem_species( gas_index_chem(1) )%conc(k,j,i) = &
2551	chem_species( gas_index_chem(1) )%conc(k,j,i) + &
2552	( zgso4 / ppm_to_nconc(k) - &
2553	chem_species( gas_index_chem(1) )%conc(k,j,i) ) * flag
2554	!
2555	!-- HNO3
2556	chem_species( gas_index_chem(2) )%conc(k,j,i) = &
2557	chem_species( gas_index_chem(2) )%conc(k,j,i) + &
2558	( zghno3 / ppm_to_nconc(k) - &
2559	chem_species( gas_index_chem(2) )%conc(k,j,i) ) * flag
2560	!
2561	!-- NH3
2562	chem_species( gas_index_chem(3) )%conc(k,j,i) = &
2563	chem_species( gas_index_chem(3) )%conc(k,j,i) + &
2564	( zgnh3 / ppm_to_nconc(k) - &
2565	chem_species( gas_index_chem(3) )%conc(k,j,i) ) * flag
2566	!
2567	!-- non-volatile OC
2568	chem_species( gas_index_chem(4) )%conc(k,j,i) = &
2569	chem_species( gas_index_chem(4) )%conc(k,j,i) + &
2570	( zgocnv / ppm_to_nconc(k) - &
2571	chem_species( gas_index_chem(4) )%conc(k,j,i) ) * flag
2572	!
2573	!-- semi-volatile OC
2574	chem_species( gas_index_chem(5) )%conc(k,j,i) = &
2575	chem_species( gas_index_chem(5) )%conc(k,j,i) + &
2576	( zgocsv / ppm_to_nconc(k) - &
2577	chem_species( gas_index_chem(5) )%conc(k,j,i) ) * flag
2578
2579	ELSE
2580	!
2581	!-- SO4 (or H2SO4)
2582	salsa_gas(1)%conc(k,j,i) = salsa_gas(1)%conc(k,j,i) + ( zgso4 - &
2583	salsa_gas(1)%conc(k,j,i) ) * flag
2584	!
2585	!-- HNO3
2586	salsa_gas(2)%conc(k,j,i) = salsa_gas(2)%conc(k,j,i) + ( zghno3 - &
2587	salsa_gas(2)%conc(k,j,i) ) * flag
2588	!
2589	!-- NH3
2590	salsa_gas(3)%conc(k,j,i) = salsa_gas(3)%conc(k,j,i) + ( zgnh3 - &
2591	salsa_gas(3)%conc(k,j,i) ) * flag
2592	!
2593	!-- non-volatile OC
2594	salsa_gas(4)%conc(k,j,i) = salsa_gas(4)%conc(k,j,i) + ( zgocnv - &
2595	salsa_gas(4)%conc(k,j,i) ) * flag
2596	!
2597	!-- semi-volatile OC
2598	salsa_gas(5)%conc(k,j,i) = salsa_gas(5)%conc(k,j,i) + ( zgocsv - &
2599	salsa_gas(5)%conc(k,j,i) ) * flag
2600	ENDIF
2601	ENDIF
2602	!
2603	!-- Tendency of water vapour mixing ratio is obtained from the
2604	!-- change in RH during SALSA run. This releases heat and changes pt.
2605	!-- Assumes no temperature change during SALSA run.
2606	!-- q = r / (1+r), Euler method for integration
2607	!
2608	IF ( feedback_to_palm ) THEN
2609	q_p(k,j,i) = q_p(k,j,i) + 1.0_wp / ( in_cw(k) * in_adn(k) + 1.0_wp ) &
2610	** 2.0_wp * ( in_cw(k) - cw_old ) * in_adn(k)
2611	pt_p(k,j,i) = pt_p(k,j,i) + alv / c_p * ( in_cw(k) - cw_old ) * &
2612	in_adn(k) / ( in_cw(k) / in_adn(k) + 1.0_wp ) ** 2.0_wp&
2613	* pt_p(k,j,i) / in_t(k)
2614	ENDIF
2615
2616	ENDDO ! k
2617	!
2618	!-- Set surfaces and wall fluxes due to deposition
2619	IF ( lsdepo_topo .AND. prunmode == 3 ) THEN
2620	IF ( .NOT. land_surface .AND. .NOT. urban_surface ) THEN
2621	CALL depo_topo( i, j, surf_def_h(0), vd, Sc, kvis, in_u, rho_air_zw )
2622	DO l = 0, 3
2623	CALL depo_topo( i, j, surf_def_v(l), vd, Sc, kvis, in_u, &
2624	rho_air_zw**0.0_wp )
2625	ENDDO
2626	ELSE
2627	CALL depo_topo( i, j, surf_usm_h, vd, Sc, kvis, in_u, rho_air_zw )
2628	DO l = 0, 3
2629	CALL depo_topo( i, j, surf_usm_v(l), vd, Sc, kvis, in_u, &
2630	rho_air_zw**0.0_wp )
2631	ENDDO
2632	CALL depo_topo( i, j, surf_lsm_h, vd, Sc, kvis, in_u, rho_air_zw )
2633	DO l = 0, 3
2634	CALL depo_topo( i, j, surf_lsm_v(l), vd, Sc, kvis, in_u, &
2635	rho_air_zw**0.0_wp )
2636	ENDDO
2637	ENDIF
2638	ENDIF
2639
2640	END SUBROUTINE salsa_driver
2641
2642	!------------------------------------------------------------------------------!
2643	! Description:
2644	! ------------
2645	!> The SALSA subroutine
2646	!> Modified for the new aerosol datatype,
2647	!> Juha Tonttila, FMI, 2014.
2648	!> Only aerosol processes included, Mona Kurppa, UHel, 2017
2649	!------------------------------------------------------------------------------!
2650	SUBROUTINE run_salsa( ppres, pcw, pcs, ptemp, mag_u, adn, lad, pc_h2so4, &
2651	pc_ocnv, pc_ocsv, pc_hno3, pc_nh3, paero, prtcl, kvis, &
2652	Sc, vc, ptstep )
2653
2654	IMPLICIT NONE
2655	!
2656	!-- Input parameters and variables
2657	REAL(wp), INTENT(in) :: adn !< air density (kg/m3)
2658	REAL(wp), INTENT(in) :: lad !< leaf area density (m2/m3)
2659	REAL(wp), INTENT(in) :: mag_u !< magnitude of wind (m/s)
2660	REAL(wp), INTENT(in) :: ppres !< atmospheric pressure at each grid
2661	!< point (Pa)
2662	REAL(wp), INTENT(in) :: ptemp !< temperature at each grid point (K)
2663	REAL(wp), INTENT(in) :: ptstep !< time step of salsa processes (s)
2664	TYPE(component_index), INTENT(in) :: prtcl !< part. component index table
2665	!
2666	!-- Input variables that are changed within:
2667	REAL(wp), INTENT(inout) :: kvis !< kinematic viscosity of air (m2/s)
2668	REAL(wp), INTENT(inout) :: Sc(:) !< particle Schmidt number
2669	REAL(wp), INTENT(inout) :: vc(:) !< particle fall speed (m/s,
2670	!< sedimentation velocity)
2671	!-- Gas phase concentrations at each grid point (#/m3)
2672	REAL(wp), INTENT(inout) :: pc_h2so4 !< sulphuric acid
2673	REAL(wp), INTENT(inout) :: pc_hno3 !< nitric acid
2674	REAL(wp), INTENT(inout) :: pc_nh3 !< ammonia
2675	REAL(wp), INTENT(inout) :: pc_ocnv !< nonvolatile OC
2676	REAL(wp), INTENT(inout) :: pc_ocsv !< semivolatile OC
2677	REAL(wp), INTENT(inout) :: pcs !< Saturation concentration of water
2678	!< vapour (kg/m3)
2679	REAL(wp), INTENT(inout) :: pcw !< Water vapour concentration (kg/m3)
2680	TYPE(t_section), INTENT(inout) :: paero(fn2b)
2681	!
2682	!-- Coagulation
2683	IF ( lscoag ) THEN
2684	CALL coagulation( paero, ptstep, ptemp, ppres )
2685	ENDIF
2686	!
2687	!-- Condensation
2688	IF ( lscnd ) THEN
2689	CALL condensation( paero, pc_h2so4, pc_ocnv, pc_ocsv, pc_hno3, pc_nh3, &
2690	pcw, pcs, ptemp, ppres, ptstep, prtcl )
2691	ENDIF
2692	!
2693	!-- Deposition
2694	IF ( lsdepo ) THEN
2695	CALL deposition( paero, ptemp, adn, mag_u, lad, kvis, Sc, vc )
2696	ENDIF
2697	!
2698	!-- Size distribution bin update
2699	!-- Mona: why done 3 times in SALSA-standalone?
2700	IF ( lsdistupdate ) THEN
2701	CALL distr_update( paero )
2702	ENDIF
2703
2704	END SUBROUTINE run_salsa
2705
2706	!------------------------------------------------------------------------------!
2707	! Description:
2708	! ------------
2709	!> Set logical switches according to the host model state and user-specified
2710	!> NAMELIST options.
2711	!> Juha Tonttila, FMI, 2014
2712	!> Only aerosol processes included, Mona Kurppa, UHel, 2017
2713	!------------------------------------------------------------------------------!
2714	SUBROUTINE set_salsa_runtime( prunmode )
2715
2716	IMPLICIT NONE
2717
2718	INTEGER(iwp), INTENT(in) :: prunmode
2719
2720	SELECT CASE(prunmode)
2721
2722	CASE(1) !< Initialization
2723	lscoag = .FALSE.
2724	lscnd = .FALSE.
2725	lscndgas = .FALSE.
2726	lscndh2oae = .FALSE.
2727	lsdepo = .FALSE.
2728	lsdepo_vege = .FALSE.
2729	lsdepo_topo = .FALSE.
2730	lsdistupdate = .TRUE.
2731
2732	CASE(2) !< Spinup period
2733	lscoag = ( .FALSE. .AND. nlcoag )
2734	lscnd = ( .TRUE. .AND. nlcnd )
2735	lscndgas = ( .TRUE. .AND. nlcndgas )
2736	lscndh2oae = ( .TRUE. .AND. nlcndh2oae )
2737
2738	CASE(3) !< Run
2739	lscoag = nlcoag
2740	lscnd = nlcnd
2741	lscndgas = nlcndgas
2742	lscndh2oae = nlcndh2oae
2743	lsdepo = nldepo
2744	lsdepo_vege = nldepo_vege
2745	lsdepo_topo = nldepo_topo
2746	lsdistupdate = nldistupdate
2747
2748	END SELECT
2749
2750
2751	END SUBROUTINE set_salsa_runtime
2752
2753	!------------------------------------------------------------------------------!
2754	! Description:
2755	! ------------
2756	!> Calculates the absolute temperature (using hydrostatic pressure), saturation
2757	!> vapour pressure and mixing ratio over water, relative humidity and air
2758	!> density needed in the SALSA model.
2759	!> NOTE, no saturation adjustment takes place -> the resulting water vapour
2760	!> mixing ratio can be supersaturated, allowing the microphysical calculations
2761	!> in SALSA.
2762	!
2763	!> Juha Tonttila, FMI, 2014 (original SALSAthrm)
2764	!> Mona Kurppa, UHel, 2017 (adjustment for PALM and only aerosol processes)
2765	!------------------------------------------------------------------------------!
2766	SUBROUTINE salsa_thrm_ij( i, j, p_ij, temp_ij, cw_ij, cs_ij, adn_ij )
2767
2768	USE arrays_3d, &
2769	ONLY: p, pt, q, zu
2770
2771	USE basic_constants_and_equations_mod, &
2772	ONLY: barometric_formula, exner_function, ideal_gas_law_rho, magnus
2773
2774	USE control_parameters, &
2775	ONLY: pt_surface, surface_pressure
2776
2777	IMPLICIT NONE
2778
2779	INTEGER(iwp), INTENT(in) :: i
2780	INTEGER(iwp), INTENT(in) :: j
2781	REAL(wp), DIMENSION(:), INTENT(inout) :: adn_ij
2782	REAL(wp), DIMENSION(:), INTENT(inout) :: p_ij
2783	REAL(wp), DIMENSION(:), INTENT(inout) :: temp_ij
2784	REAL(wp), DIMENSION(:), INTENT(inout), OPTIONAL :: cw_ij
2785	REAL(wp), DIMENSION(:), INTENT(inout), OPTIONAL :: cs_ij
2786	REAL(wp), DIMENSION(nzb:nzt+1) :: e_s !< saturation vapour pressure
2787	!< over water (Pa)
2788	REAL(wp) :: t_surface !< absolute surface temperature (K)
2789	!
2790	!-- Pressure p_ijk (Pa) = hydrostatic pressure + perturbation pressure (p)
2791	t_surface = pt_surface * exner_function( surface_pressure * 100.0_wp )
2792	p_ij(:) = barometric_formula( zu, t_surface, surface_pressure * 100.0_wp ) &
2793	+ p(:,j,i)
2794	!
2795	!-- Absolute ambient temperature (K)
2796	temp_ij(:) = pt(:,j,i) * exner_function( p_ij(:) )
2797	!
2798	!-- Air density
2799	adn_ij(:) = ideal_gas_law_rho( p_ij(:), temp_ij(:) )
2800	!
2801	!-- Water vapour concentration r_v (kg/m3)
2802	IF ( PRESENT( cw_ij ) ) THEN
2803	cw_ij(:) = ( q(:,j,i) / ( 1.0_wp - q(:,j,i) ) ) * adn_ij(:)
2804	ENDIF
2805	!
2806	!-- Saturation mixing ratio r_s (kg/kg) from vapour pressure at temp (Pa)
2807	IF ( PRESENT( cs_ij ) ) THEN
2808	e_s(:) = 611.0_wp * EXP( alv_d_rv * ( 3.6609E-3_wp - 1.0_wp / &
2809	temp_ij(:) ) )! magnus( temp_ij(:) )
2810	cs_ij(:) = ( 0.622_wp * e_s / ( p_ij(:) - e_s(:) ) ) * adn_ij(:)
2811	ENDIF
2812
2813	END SUBROUTINE salsa_thrm_ij
2814
2815	!------------------------------------------------------------------------------!
2816	! Description:
2817	! ------------
2818	!> Calculates ambient sizes of particles by equilibrating soluble fraction of
2819	!> particles with water using the ZSR method (Stokes and Robinson, 1966).
2820	!> Method:
2821	!> Following chemical components are assumed water-soluble
2822	!> - (ammonium) sulphate (100%)
2823	!> - sea salt (100 %)
2824	!> - organic carbon (epsoc * 100%)
2825	!> Exact thermodynamic considerations neglected.
2826	!> - If particles contain no sea salt, calculation according to sulphate
2827	!> properties
2828	!> - If contain sea salt but no sulphate, calculation according to sea salt
2829	!> properties
2830	!> - If contain both sulphate and sea salt -> the molar fraction of these
2831	!> compounds determines which one of them is used as the basis of calculation.
2832	!> If sulphate and sea salt coexist in a particle, it is assumed that the Cl is
2833	!> replaced by sulphate; thus only either sulphate + organics or sea salt +
2834	!> organics is included in the calculation of soluble fraction.
2835	!> Molality parameterizations taken from Table 1 of Tang: Thermodynamic and
2836	!> optical properties of mixed-salt aerosols of atmospheric importance,
2837	!> J. Geophys. Res., 102 (D2), 1883-1893 (1997)
2838	!
2839	!> Coded by:
2840	!> Hannele Korhonen (FMI) 2005
2841	!> Harri Kokkola (FMI) 2006
2842	!> Matti Niskanen(FMI) 2012
2843	!> Anton Laakso (FMI) 2013
2844	!> Modified for the new aerosol datatype, Juha Tonttila (FMI) 2014
2845	!
2846	!> fxm: should sea salt form a solid particle when prh is very low (even though
2847	!> it could be mixed with e.g. sulphate)?
2848	!> fxm: crashes if no sulphate or sea salt
2849	!> fxm: do we really need to consider Kelvin effect for subrange 2
2850	!------------------------------------------------------------------------------!
2851	SUBROUTINE equilibration( prh, ptemp, paero, init )
2852
2853	IMPLICIT NONE
2854	!
2855	!-- Input variables
2856	LOGICAL, INTENT(in) :: init !< TRUE: Initialization call
2857	!< FALSE: Normal runtime: update water
2858	!< content only for 1a
2859	REAL(wp), INTENT(in) :: prh !< relative humidity [0-1]
2860	REAL(wp), INTENT(in) :: ptemp !< temperature (K)
2861	!
2862	!-- Output variables
2863	TYPE(t_section), INTENT(inout) :: paero(fn2b)
2864	!
2865	!-- Local
2866	INTEGER(iwp) :: b !< loop index
2867	INTEGER(iwp) :: counti !< loop index
2868	REAL(wp) :: zaw !< water activity [0-1]
2869	REAL(wp) :: zbinmol(7) !< binary molality of each components (mol/kg)
2870	REAL(wp) :: zcore !< Volume of dry particle
2871	REAL(wp) :: zdold !< Old diameter
2872	REAL(wp) :: zdwet !< Wet diameter or mean droplet diameter
2873	REAL(wp) :: zke !< Kelvin term in the KÃ¶hler equation
2874	REAL(wp) :: zlwc !< liquid water content [kg/m3-air]
2875	REAL(wp) :: zrh !< Relative humidity
2876	REAL(wp) :: zvpart(7) !< volume of chem. compounds in one particle
2877
2878	zaw = 0.0_wp
2879	zbinmol = 0.0_wp
2880	zcore = 0.0_wp
2881	zdold = 0.0_wp
2882	zdwet = 0.0_wp
2883	zlwc = 0.0_wp
2884	zrh = 0.0_wp
2885
2886	!
2887	!-- Relative humidity:
2888	zrh = prh
2889	zrh = MAX( zrh, 0.05_wp )
2890	zrh = MIN( zrh, 0.98_wp)
2891	!
2892	!-- 1) Regime 1: sulphate and partly water-soluble OC. Done for every CALL
2893	DO b = in1a, fn1a ! size bin
2894
2895	zbinmol = 0.0_wp
2896	zdold = 1.0_wp
2897	zke = 1.02_wp
2898
2899	IF ( paero(b)%numc > nclim ) THEN
2900	!
2901	!-- Volume in one particle
2902	zvpart = 0.0_wp
2903	zvpart(1:2) = paero(b)%volc(1:2) / paero(b)%numc
2904	zvpart(6:7) = paero(b)%volc(6:7) / paero(b)%numc
2905	!
2906	!-- Total volume and wet diameter of one dry particle
2907	zcore = SUM( zvpart(1:2) )
2908	zdwet = paero(b)%dwet
2909
2910	counti = 0
2911	DO WHILE ( ABS( zdwet / zdold - 1.0_wp ) > 1.0E-2_wp )
2912
2913	zdold = MAX( zdwet, 1.0E-20_wp )
2914	zaw = MAX( 1.0E-3_wp, zrh / zke ) ! To avoid underflow
2915	!
2916	!-- Binary molalities (mol/kg):
2917	!-- Sulphate
2918	zbinmol(1) = 1.1065495E+2_wp - 3.6759197E+2_wp * zaw &
2919	+ 5.0462934E+2_wp * zaw**2.0_wp &
2920	- 3.1543839E+2_wp * zaw**3.0_wp &
2921	+ 6.770824E+1_wp * zaw**4.0_wp
2922	!-- Organic carbon
2923	zbinmol(2) = 1.0_wp / ( zaw * amh2o ) - 1.0_wp / amh2o
2924	!-- Nitric acid
2925	zbinmol(6) = 2.306844303E+1_wp - 3.563608869E+1_wp * zaw &
2926	- 6.210577919E+1_wp * zaw**2.0_wp &
2927	+ 5.510176187E+2_wp * zaw**3.0_wp &
2928	- 1.460055286E+3_wp * zaw**4.0_wp &
2929	+ 1.894467542E+3_wp * zaw**5.0_wp &
2930	- 1.220611402E+3_wp * zaw**6.0_wp &
2931	+ 3.098597737E+2_wp * zaw**7.0_wp
2932	!
2933	!-- Calculate the liquid water content (kg/m3-air) using ZSR (see e.g.
2934	!-- Eq. 10.98 in Seinfeld and Pandis (2006))
2935	zlwc = ( paero(b)%volc(1) * ( arhoh2so4 / amh2so4 ) ) / &
2936	zbinmol(1) + epsoc * paero(b)%volc(2) * ( arhooc / amoc ) &
2937	/ zbinmol(2) + ( paero(b)%volc(6) * ( arhohno3/amhno3 ) ) &
2938	/ zbinmol(6)
2939	!
2940	!-- Particle wet diameter (m)
2941	zdwet = ( zlwc / paero(b)%numc / arhoh2o / api6 + &
2942	( SUM( zvpart(6:7) ) / api6 ) + &
2943	zcore / api6 )**( 1.0_wp / 3.0_wp )
2944	!
2945	!-- Kelvin effect (Eq. 10.85 in in Seinfeld and Pandis (2006)). Avoid
2946	!-- overflow.
2947	zke = EXP( MIN( 50.0_wp, &
2948	4.0_wp * surfw0 * amvh2so4 / ( abo * ptemp * zdwet ) ) )
2949
2950	counti = counti + 1
2951	IF ( counti > 1000 ) THEN
2952	message_string = 'Subrange 1: no convergence!'
2953	CALL message( 'salsa_mod: equilibration', 'SA0042', &
2954	1, 2, 0, 6, 0 )
2955	ENDIF
2956	ENDDO
2957	!
2958	!-- Instead of lwc, use the volume concentration of water from now on
2959	!-- (easy to convert...)
2960	paero(b)%volc(8) = zlwc / arhoh2o
2961	!
2962	!-- If this is initialization, update the core and wet diameter
2963	IF ( init ) THEN
2964	paero(b)%dwet = zdwet
2965	paero(b)%core = zcore
2966	ENDIF
2967
2968	ELSE
2969	!-- If initialization
2970	!-- 1.2) empty bins given bin average values
2971	IF ( init ) THEN
2972	paero(b)%dwet = paero(b)%dmid
2973	paero(b)%core = api6 * paero(b)%dmid ** 3.0_wp
2974	ENDIF
2975
2976	ENDIF
2977
2978	ENDDO !< b
2979	!
2980	!-- 2) Regime 2a: sulphate, OC, BC and sea salt
2981	!-- This is done only for initialization call, otherwise the water contents
2982	!-- are computed via condensation
2983	IF ( init ) THEN
2984	DO b = in2a, fn2b
2985
2986	!-- Initialize
2987	zke = 1.02_wp
2988	zbinmol = 0.0_wp
2989	zdold = 1.0_wp
2990	!
2991	!-- 1) Particle properties calculated for non-empty bins
2992	IF ( paero(b)%numc > nclim ) THEN
2993	!
2994	!-- Volume in one particle [fxm]
2995	zvpart = 0.0_wp
2996	zvpart(1:7) = paero(b)%volc(1:7) / paero(b)%numc
2997	!
2998	!-- Total volume and wet diameter of one dry particle [fxm]
2999	zcore = SUM( zvpart(1:5) )
3000	zdwet = paero(b)%dwet
3001
3002	counti = 0
3003	DO WHILE ( ABS( zdwet / zdold - 1.0_wp ) > 1.0E-12_wp )
3004
3005	zdold = MAX( zdwet, 1.0E-20_wp )
3006	zaw = zrh / zke
3007	!
3008	!-- Binary molalities (mol/kg):
3009	!-- Sulphate
3010	zbinmol(1) = 1.1065495E+2_wp - 3.6759197E+2_wp * zaw &
3011	+ 5.0462934E+2_wp * zaw*2 - 3.1543839E+2_wp zaw**3 &
3012	+ 6.770824E+1_wp * zaw**4
3013	!-- Organic carbon
3014	zbinmol(2) = 1.0_wp / ( zaw * amh2o ) - 1.0_wp / amh2o
3015	!-- Nitric acid
3016	zbinmol(6) = 2.306844303E+1_wp - 3.563608869E+1_wp * zaw &
3017	- 6.210577919E+1_wp * zaw*2 + 5.510176187E+2_wp zaw**3 &
3018	- 1.460055286E+3_wp * zaw*4 + 1.894467542E+3_wp zaw**5 &
3019	- 1.220611402E+3_wp * zaw*6 + 3.098597737E+2_wp zaw**7
3020	!-- Sea salt (natrium chloride)
3021	zbinmol(5) = 5.875248E+1_wp - 1.8781997E+2_wp * zaw &
3022	+ 2.7211377E+2_wp * zaw*2 - 1.8458287E+2_wp zaw**3 &
3023	+ 4.153689E+1_wp * zaw**4
3024	!
3025	!-- Calculate the liquid water content (kg/m3-air)
3026	zlwc = ( paero(b)%volc(1) * ( arhoh2so4 / amh2so4 ) ) / &
3027	zbinmol(1) + epsoc * ( paero(b)%volc(2) * ( arhooc / &
3028	amoc ) ) / zbinmol(2) + ( paero(b)%volc(6) * ( arhohno3 &
3029	/ amhno3 ) ) / zbinmol(6) + ( paero(b)%volc(5) * &
3030	( arhoss / amss ) ) / zbinmol(5)
3031
3032	!-- Particle wet radius (m)
3033	zdwet = ( zlwc / paero(b)%numc / arhoh2o / api6 + &
3034	( SUM( zvpart(6:7) ) / api6 ) + &
3035	zcore / api6 ) ** ( 1.0_wp / 3.0_wp )
3036	!
3037	!-- Kelvin effect (Eq. 10.85 in Seinfeld and Pandis (2006))
3038	zke = EXP( MIN( 50.0_wp, &
3039	4.0_wp * surfw0 * amvh2so4 / ( abo * zdwet * ptemp ) ) )
3040
3041	counti = counti + 1
3042	IF ( counti > 1000 ) THEN
3043	message_string = 'Subrange 2: no convergence!'
3044	CALL message( 'salsa_mod: equilibration', 'SA0043', &
3045	1, 2, 0, 6, 0 )
3046	ENDIF
3047	ENDDO
3048	!
3049	!-- Liquid water content; instead of LWC use the volume concentration
3050	paero(b)%volc(8) = zlwc / arhoh2o
3051	paero(b)%dwet = zdwet
3052	paero(b)%core = zcore
3053
3054	ELSE
3055	!-- 2.2) empty bins given bin average values
3056	paero(b)%dwet = paero(b)%dmid
3057	paero(b)%core = api6 * paero(b)%dmid ** 3.0_wp
3058	ENDIF
3059
3060	ENDDO ! b
3061	ENDIF
3062
3063	END SUBROUTINE equilibration
3064
3065	!------------------------------------------------------------------------------!
3066	!> Description:
3067	!> ------------
3068	!> Calculation of the settling velocity vc (m/s) per aerosol size bin and
3069	!> deposition on plant canopy (lsdepo_vege).
3070	!
3071	!> Deposition is based on either the scheme presented in:
3072	!> Zhang et al. (2001), Atmos. Environ. 35, 549-560 (includes collection due to
3073	!> Brownian diffusion, impaction, interception and sedimentation)
3074	!> OR
3075	!> Petroff & Zhang (2010), Geosci. Model Dev. 3, 753-769 (includes also
3076	!> collection due to turbulent impaction)
3077	!
3078	!> Equation numbers refer to equation in Jacobson (2005): Fundamentals of
3079	!> Atmospheric Modeling, 2nd Edition.
3080	!
3081	!> Subroutine follows closely sedim_SALSA in UCLALES-SALSA written by Juha
3082	!> Tonttila (KIT/FMI) and Zubair Maalick (UEF).
3083	!> Rewritten to PALM by Mona Kurppa (UH), 2017.
3084	!
3085	!> Call for grid point i,j,k
3086	!------------------------------------------------------------------------------!
3087
3088	SUBROUTINE deposition( paero, tk, adn, mag_u, lad, kvis, Sc, vc )
3089
3090	USE plant_canopy_model_mod, &
3091	ONLY: cdc
3092
3093	IMPLICIT NONE
3094
3095	REAL(wp), INTENT(in) :: adn !< air density (kg/m3)
3096	REAL(wp), INTENT(out) :: kvis !< kinematic viscosity of air (m2/s)
3097	REAL(wp), INTENT(in) :: lad !< leaf area density (m2/m3)
3098	REAL(wp), INTENT(in) :: mag_u !< wind velocity (m/s)
3099	REAL(wp), INTENT(out) :: Sc(:) !< particle Schmidt number
3100	REAL(wp), INTENT(in) :: tk !< abs.temperature (K)
3101	REAL(wp), INTENT(out) :: vc(:) !< critical fall speed i.e. settling
3102	!< velocity of an aerosol particle (m/s)
3103	TYPE(t_section), INTENT(inout) :: paero(fn2b)
3104
3105	INTEGER(iwp) :: b !< loop index
3106	INTEGER(iwp) :: c !< loop index
3107	REAL(wp) :: avis !< molecular viscocity of air (kg/(m*s))
3108	REAL(wp), PARAMETER :: c_A = 1.249_wp !< Constants A, B and C for
3109	REAL(wp), PARAMETER :: c_B = 0.42_wp !< calculating the Cunningham
3110	REAL(wp), PARAMETER :: c_C = 0.87_wp !< slip-flow correction (Cc)
3111	!< according to Jacobson (2005),
3112	!< Eq. 15.30
3113	REAL(wp) :: Cc !< Cunningham slip-flow correction factor
3114	REAL(wp) :: Kn !< Knudsen number
3115	REAL(wp) :: lambda !< molecular mean free path (m)
3116	REAL(wp) :: mdiff !< particle diffusivity coefficient
3117	REAL(wp) :: pdn !< particle density (kg/m3)
3118	REAL(wp) :: ustar !< friction velocity (m/s)
3119	REAL(wp) :: va !< thermal speed of an air molecule (m/s)
3120	REAL(wp) :: zdwet !< wet diameter (m)
3121	!
3122	!-- Initialise
3123	Cc = 0.0_wp
3124	Kn = 0.0_wp
3125	mdiff = 0.0_wp
3126	pdn = 1500.0_wp ! default value
3127	ustar = 0.0_wp
3128	!
3129	!-- Molecular viscosity of air (Eq. 4.54)
3130	avis = 1.8325E-5_wp * ( 416.16_wp / ( tk + 120.0_wp ) ) * ( tk / &
3131	296.16_wp )**1.5_wp
3132	!
3133	!-- Kinematic viscosity (Eq. 4.55)
3134	kvis = avis / adn
3135	!
3136	!-- Thermal velocity of an air molecule (Eq. 15.32)
3137	va = SQRT( 8.0_wp * abo * tk / ( pi * am_airmol ) )
3138	!
3139	!-- Mean free path (m) (Eq. 15.24)
3140	lambda = 2.0_wp * avis / ( adn * va )
3141
3142	DO b = 1, nbins
3143
3144	IF ( paero(b)%numc < nclim ) CYCLE
3145	zdwet = paero(b)%dwet
3146	!
3147	!-- Knudsen number (Eq. 15.23)
3148	Kn = MAX( 1.0E-2_wp, lambda / ( zdwet * 0.5_wp ) ) ! To avoid underflow
3149	!
3150	!-- Cunningham slip-flow correction (Eq. 15.30)
3151	Cc = 1.0_wp + Kn * ( c_A + c_B * EXP( -c_C / Kn ) )
3152
3153	!-- Particle diffusivity coefficient (Eq. 15.29)
3154	mdiff = ( abo * tk * Cc ) / ( 3.0_wp * pi * avis * zdwet )
3155	!
3156	!-- Particle Schmidt number (Eq. 15.36)
3157	Sc(b) = kvis / mdiff
3158	!
3159	!-- Critical fall speed i.e. settling velocity (Eq. 20.4)
3160	vc(b) = MIN( 1.0_wp, terminal_vel( 0.5_wp * zdwet, pdn, adn, avis, Cc) )
3161
3162	IF ( lsdepo_vege .AND. plant_canopy .AND. lad > 0.0_wp ) THEN
3163	!
3164	!-- Friction velocity calculated following Prandtl (1925):
3165	ustar = SQRT( cdc ) * mag_u
3166	CALL depo_vege( paero, b, vc(b), mag_u, ustar, kvis, Sc(b), lad )
3167	ENDIF
3168	ENDDO
3169
3170	END SUBROUTINE deposition
3171
3172	!------------------------------------------------------------------------------!
3173	! Description:
3174	! ------------
3175	!> Calculate change in number and volume concentrations due to deposition on
3176	!> plant canopy.
3177	!------------------------------------------------------------------------------!
3178	SUBROUTINE depo_vege( paero, b, vc, mag_u, ustar, kvis_a, Sc, lad )
3179
3180	IMPLICIT NONE
3181
3182	INTEGER(iwp), INTENT(in) :: b !< loop index
3183	REAL(wp), INTENT(in) :: kvis_a !< kinematic viscosity of air (m2/s)
3184	REAL(wp), INTENT(in) :: lad !< leaf area density (m2/m3)
3185	REAL(wp), INTENT(in) :: mag_u !< wind velocity (m/s)
3186	REAL(wp), INTENT(in) :: Sc !< particle Schmidt number
3187	REAL(wp), INTENT(in) :: ustar !< friction velocity (m/s)
3188	REAL(wp), INTENT(in) :: vc !< terminal velocity (m/s)
3189	TYPE(t_section), INTENT(inout) :: paero(fn2b)
3190
3191	INTEGER(iwp) :: c !< loop index
3192	REAL(wp), PARAMETER :: c_A = 1.249_wp !< Constants A, B and C for
3193	REAL(wp), PARAMETER :: c_B = 0.42_wp !< calculating the Cunningham
3194	REAL(wp), PARAMETER :: c_C = 0.87_wp !< slip-flow correction (Cc)
3195	!< according to Jacobson (2005),
3196	!< Eq. 15.30
3197	REAL(wp) :: alpha !< parameter, Table 3 in Zhang et al. (2001)
3198	REAL(wp) :: depo !< deposition efficiency
3199	REAL(wp) :: C_Br !< coefficient for Brownian diffusion
3200	REAL(wp) :: C_IM !< coefficient for inertial impaction
3201	REAL(wp) :: C_IN !< coefficient for interception
3202	REAL(wp) :: C_IT !< coefficient for turbulent impaction
3203	REAL(wp) :: gamma !< parameter, Table 3 in Zhang et al. (2001)
3204	REAL(wp) :: par_A !< parameter A for the characteristic radius of
3205	!< collectors, Table 3 in Zhang et al. (2001)
3206	REAL(wp) :: rt !< the overall quasi-laminar resistance for
3207	!< particles
3208	REAL(wp) :: St !< Stokes number for smooth surfaces or bluff
3209	!< surface elements
3210	REAL(wp) :: tau_plus !< dimensionless particle relaxation time
3211	REAL(wp) :: v_bd !< deposition velocity due to Brownian diffusion
3212	REAL(wp) :: v_im !< deposition velocity due to impaction
3213	REAL(wp) :: v_in !< deposition velocity due to interception
3214	REAL(wp) :: v_it !< deposition velocity due to turbulent impaction
3215	!
3216	!-- Initialise
3217	depo = 0.0_wp
3218	rt = 0.0_wp
3219	St = 0.0_wp
3220	tau_plus = 0.0_wp
3221	v_bd = 0.0_wp
3222	v_im = 0.0_wp
3223	v_in = 0.0_wp
3224	v_it = 0.0_wp
3225
3226	IF ( depo_vege_type == 'zhang2001' ) THEN
3227	!
3228	!-- Parameters for the land use category 'deciduous broadleaf trees'(Table 3)
3229	par_A = 5.0E-3_wp
3230	alpha = 0.8_wp
3231	gamma = 0.56_wp
3232	!
3233	!-- Stokes number for vegetated surfaces (Seinfeld & Pandis (2006): Eq.19.24)
3234	St = vc * ustar / ( g * par_A )
3235	!
3236	!-- The overall quasi-laminar resistance for particles (Zhang et al., Eq. 5)
3237	rt = MAX( EPSILON( 1.0_wp ), ( 3.0_wp * ustar * EXP( -St*0.5_wp ) &
3238	( Sc( -gamma ) + ( St / ( alpha + St ) )2.0_wp + &
3239	0.5_wp * ( paero(b)%dwet / par_A )**2.0_wp ) ) )
3240	depo = ( rt + vc ) * lad
3241	paero(b)%numc = paero(b)%numc - depo * paero(b)%numc * dt_salsa
3242	DO c = 1, maxspec+1
3243	paero(b)%volc(c) = paero(b)%volc(c) - depo * paero(b)%volc(c) * &
3244	dt_salsa
3245	ENDDO
3246
3247	ELSEIF ( depo_vege_type == 'petroff2010' ) THEN
3248	!
3249	!-- vd = v_BD + v_IN + v_IM + v_IT + vc
3250	!-- Deposition efficiencies from Table 1. Constants from Table 2.
3251	C_Br = 1.262_wp
3252	C_IM = 0.130_wp
3253	C_IN = 0.216_wp
3254	C_IT = 0.056_wp
3255	par_A = 0.03_wp ! Here: leaf width (m)
3256	!
3257	!-- Stokes number for vegetated surfaces (Seinfeld & Pandis (2006): Eq.19.24)
3258	St = vc * ustar / ( g * par_A )
3259	!
3260	!-- Non-dimensional relexation time of the particle on top of canopy
3261	tau_plus = vc * ustar*2.0_wp / ( kvis_a g )
3262	!
3263	!-- Brownian diffusion
3264	v_bd = mag_u * C_Br * Sc*( -2.0_wp / 3.0_wp ) &
3265	( mag_u * par_A / kvis_a )**( -0.5_wp )
3266	!
3267	!-- Interception
3268	v_in = mag_u * C_IN * paero(b)%dwet / par_A * ( 2.0_wp + LOG( 2.0_wp * &
3269	par_A / paero(b)%dwet ) )
3270	!
3271	!-- Impaction: Petroff (2009) Eq. 18
3272	v_im = mag_u * C_IM * ( St / ( St + 0.47_wp ) )**2.0_wp
3273
3274	IF ( tau_plus < 20.0_wp ) THEN
3275	v_it = 2.5E-3_wp * C_IT * tau_plus**2.0_wp
3276	ELSE
3277	v_it = C_IT
3278	ENDIF
3279	depo = ( v_bd + v_in + v_im + v_it + vc ) * lad
3280	paero(b)%numc = paero(b)%numc - depo * paero(b)%numc * dt_salsa
3281	DO c = 1, maxspec+1
3282	paero(b)%volc(c) = paero(b)%volc(c) - depo * paero(b)%volc(c) * &
3283	dt_salsa
3284	ENDDO
3285	ENDIF
3286
3287	END SUBROUTINE depo_vege
3288
3289	!------------------------------------------------------------------------------!
3290	! Description:
3291	! ------------
3292	!> Calculate deposition on horizontal and vertical surfaces. Implement as
3293	!> surface flux.
3294	!------------------------------------------------------------------------------!
3295
3296	SUBROUTINE depo_topo( i, j, surf, vc, Sc, kvis, mag_u, norm )
3297
3298	USE surface_mod, &
3299	ONLY: surf_type
3300
3301	IMPLICIT NONE
3302
3303	INTEGER(iwp), INTENT(in) :: i !< loop index
3304	INTEGER(iwp), INTENT(in) :: j !< loop index
3305	REAL(wp), INTENT(in) :: kvis(:) !< kinematic viscosity of air (m2/s)
3306	REAL(wp), INTENT(in) :: mag_u(:) !< wind velocity (m/s)
3307	REAL(wp), INTENT(in) :: norm(:) !< normalisation (usually air density)
3308	REAL(wp), INTENT(in) :: Sc(:,:) !< particle Schmidt number
3309	REAL(wp), INTENT(in) :: vc(:,:) !< terminal velocity (m/s)
3310	TYPE(surf_type), INTENT(inout) :: surf !< respective surface type
3311	INTEGER(iwp) :: b !< loop index
3312	INTEGER(iwp) :: c !< loop index
3313	INTEGER(iwp) :: k !< loop index
3314	INTEGER(iwp) :: m !< loop index
3315	INTEGER(iwp) :: surf_e !< End index of surface elements at (j,i)-gridpoint
3316	INTEGER(iwp) :: surf_s !< Start index of surface elements at (j,i)-gridpoint
3317	REAL(wp) :: alpha !< parameter, Table 3 in Zhang et al. (2001)
3318	REAL(wp) :: C_Br !< coefficient for Brownian diffusion
3319	REAL(wp) :: C_IM !< coefficient for inertial impaction
3320	REAL(wp) :: C_IN !< coefficient for interception
3321	REAL(wp) :: C_IT !< coefficient for turbulent impaction
3322	REAL(wp) :: depo !< deposition efficiency
3323	REAL(wp) :: gamma !< parameter, Table 3 in Zhang et al. (2001)
3324	REAL(wp) :: par_A !< parameter A for the characteristic radius of
3325	!< collectors, Table 3 in Zhang et al. (2001)
3326	REAL(wp) :: rt !< the overall quasi-laminar resistance for
3327	!< particles
3328	REAL(wp) :: St !< Stokes number for bluff surface elements
3329	REAL(wp) :: tau_plus !< dimensionless particle relaxation time
3330	REAL(wp) :: v_bd !< deposition velocity due to Brownian diffusion
3331	REAL(wp) :: v_im !< deposition velocity due to impaction
3332	REAL(wp) :: v_in !< deposition velocity due to interception
3333	REAL(wp) :: v_it !< deposition velocity due to turbulent impaction
3334	!
3335	!-- Initialise
3336	rt = 0.0_wp
3337	St = 0.0_wp
3338	tau_plus = 0.0_wp
3339	v_bd = 0.0_wp
3340	v_im = 0.0_wp
3341	v_in = 0.0_wp
3342	v_it = 0.0_wp
3343	surf_s = surf%start_index(j,i)
3344	surf_e = surf%end_index(j,i)
3345
3346	DO m = surf_s, surf_e
3347	k = surf%k(m)
3348	DO b = 1, nbins
3349	IF ( aerosol_number(b)%conc(k,j,i) <= nclim .OR. &
3350	Sc(k+1,b) < 1.0_wp ) CYCLE
3351
3352	IF ( depo_topo_type == 'zhang2001' ) THEN
3353	!
3354	!-- Parameters for the land use category 'urban' in Table 3
3355	alpha = 1.5_wp
3356	gamma = 0.56_wp
3357	par_A = 10.0E-3_wp
3358	!
3359	!-- Stokes number for smooth surfaces or surfaces with bluff roughness
3360	!-- elements (Seinfeld and Pandis, 2nd edition (2006): Eq. 19.23)
3361	St = MAX( 0.01_wp, vc(k+1,b) * surf%us(m) ** 2.0_wp / &
3362	( g * kvis(k+1) ) )
3363	!
3364	!-- The overall quasi-laminar resistance for particles (Eq. 5)
3365	rt = MAX( EPSILON( 1.0_wp ), ( 3.0_wp * surf%us(m) * ( &
3366	Sc(k+1,b)( -gamma ) + ( St / ( alpha + St ) )2.0_wp &
3367	+ 0.5_wp * ( Ra_dry(k,j,i,b) / par_A )*2.0_wp ) &
3368	EXP( -St**0.5_wp ) ) )
3369	depo = vc(k+1,b) + rt
3370
3371	ELSEIF ( depo_topo_type == 'petroff2010' ) THEN
3372	!
3373	!-- vd = v_BD + v_IN + v_IM + v_IT + vc
3374	!-- Deposition efficiencies from Table 1. Constants from Table 2.
3375	C_Br = 1.262_wp
3376	C_IM = 0.130_wp
3377	C_IN = 0.216_wp
3378	C_IT = 0.056_wp
3379	par_A = 0.03_wp ! Here: leaf width (m)
3380	!
3381	!-- Stokes number for smooth surfaces or surfaces with bluff roughness
3382	!-- elements (Seinfeld and Pandis, 2nd edition (2006): Eq. 19.23)
3383	St = MAX( 0.01_wp, vc(k+1,b) * surf%us(m) ** 2.0_wp / &
3384	( g * kvis(k+1) ) )
3385	!
3386	!-- Non-dimensional relexation time of the particle on top of canopy
3387	tau_plus = vc(k+1,b) * surf%us(m)*2.0_wp / ( kvis(k+1) g )
3388	!
3389	!-- Brownian diffusion
3390	v_bd = mag_u(k+1) * C_Br * Sc(k+1,b)*( -2.0_wp / 3.0_wp ) &
3391	( mag_u(k+1) * par_A / kvis(k+1) )**( -0.5_wp )
3392	!
3393	!-- Interception
3394	v_in = mag_u(k+1) * C_IN * Ra_dry(k,j,i,b)/ par_A * ( 2.0_wp + &
3395	LOG( 2.0_wp * par_A / Ra_dry(k,j,i,b) ) )
3396	!
3397	!-- Impaction: Petroff (2009) Eq. 18
3398	v_im = mag_u(k+1) * C_IM * ( St / ( St + 0.47_wp ) )**2.0_wp
3399
3400	IF ( tau_plus < 20.0_wp ) THEN
3401	v_it = 2.5E-3_wp * C_IT * tau_plus**2.0_wp
3402	ELSE
3403	v_it = C_IT
3404	ENDIF
3405	depo = v_bd + v_in + v_im + v_it + vc(k+1,b)
3406
3407	ENDIF
3408	IF ( lod_aero == 3 .OR. salsa_source_mode == 'no_source' ) THEN
3409	surf%answs(m,b) = -depo * norm(k) * aerosol_number(b)%conc(k,j,i)
3410	DO c = 1, ncc_tot
3411	surf%amsws(m,(c-1)nbins+b) = -depo norm(k) * &
3412	aerosol_mass((c-1)*nbins+b)%conc(k,j,i)
3413	ENDDO ! c
3414	ELSE
3415	surf%answs(m,b) = SUM( aerosol_number(b)%source(:,j,i) ) - &
3416	MAX( 0.0_wp, depo * norm(k) * &
3417	aerosol_number(b)%conc(k,j,i) )
3418	DO c = 1, ncc_tot
3419	surf%amsws(m,(c-1)*nbins+b) = SUM( &
3420	aerosol_mass((c-1)*nbins+b)%source(:,j,i) ) - &
3421	MAX( 0.0_wp, depo * norm(k) * &
3422	aerosol_mass((c-1)*nbins+b)%conc(k,j,i) )
3423	ENDDO
3424	ENDIF
3425	ENDDO ! b
3426	ENDDO ! m
3427
3428	END SUBROUTINE depo_topo
3429
3430	!------------------------------------------------------------------------------!
3431	! Description:
3432	! ------------
3433	! Function for calculating terminal velocities for different particles sizes.
3434	!------------------------------------------------------------------------------!
3435	REAL(wp) FUNCTION terminal_vel( radius, rhop, rhoa, visc, beta )
3436
3437	IMPLICIT NONE
3438
3439	REAL(wp), INTENT(in) :: beta !< Cunningham correction factor
3440	REAL(wp), INTENT(in) :: radius !< particle radius (m)
3441	REAL(wp), INTENT(in) :: rhop !< particle density (kg/m3)
3442	REAL(wp), INTENT(in) :: rhoa !< air density (kg/m3)
3443	REAL(wp), INTENT(in) :: visc !< molecular viscosity of air (kg/(m*s))
3444
3445	REAL(wp), PARAMETER :: rhoa_ref = 1.225_wp ! reference air density (kg/m3)
3446	!
3447	!-- Stokes law with Cunningham slip correction factor
3448	terminal_vel = ( 4.0_wp * radius*2.0_wp ) ( rhop - rhoa ) * g * beta / &
3449	( 18.0_wp * visc ) ! (m/s)
3450
3451	END FUNCTION terminal_vel
3452
3453	!------------------------------------------------------------------------------!
3454	! Description:
3455	! ------------
3456	!> Calculates particle loss and change in size distribution due to (Brownian)
3457	!> coagulation. Only for particles with dwet < 30 micrometres.
3458	!
3459	!> Method:
3460	!> Semi-implicit, non-iterative method: (Jacobson, 1994)
3461	!> Volume concentrations of the smaller colliding particles added to the bin of
3462	!> the larger colliding particles. Start from first bin and use the updated
3463	!> number and volume for calculation of following bins. NB! Our bin numbering
3464	!> does not follow particle size in subrange 2.
3465	!
3466	!> Schematic for bin numbers in different subranges:
3467	!> 1 2
3468	!> +-------------------------------------------+
3469	!> a \| 1 \| 2 \| 3 \|\| 4 \| 5 \| 6 \| 7 \| 8 \| 9 \| 10\|\|
3470	!> b \| \|\|11 \|12 \|13 \|14 \| 15 \| 16 \| 17\|\|
3471	!> +-------------------------------------------+
3472	!
3473	!> Exact coagulation coefficients for each pressure level are scaled according
3474	!> to current particle wet size (linear scaling).
3475	!> Bins are organized in terms of the dry size of the condensation nucleus,
3476	!> while coagulation kernell is calculated with the actual hydrometeor
3477	!> size.
3478	!
3479	!> Called from salsa_driver
3480	!> fxm: Process selection should be made smarter - now just lots of IFs inside
3481	!> loops
3482	!
3483	!> Coded by:
3484	!> Hannele Korhonen (FMI) 2005
3485	!> Harri Kokkola (FMI) 2006
3486	!> Tommi Bergman (FMI) 2012
3487	!> Matti Niskanen(FMI) 2012
3488	!> Anton Laakso (FMI) 2013
3489	!> Juha Tonttila (FMI) 2014
3490	!------------------------------------------------------------------------------!
3491	SUBROUTINE coagulation( paero, ptstep, ptemp, ppres )
3492
3493	IMPLICIT NONE
3494
3495	!-- Input and output variables
3496	TYPE(t_section), INTENT(inout) :: paero(fn2b) !< Aerosol properties
3497	REAL(wp), INTENT(in) :: ppres !< ambient pressure (Pa)
3498	REAL(wp), INTENT(in) :: ptemp !< ambient temperature (K)
3499	REAL(wp), INTENT(in) :: ptstep !< time step (s)
3500	!-- Local variables
3501	INTEGER(iwp) :: index_2a !< corresponding bin in subrange 2a
3502	INTEGER(iwp) :: index_2b !< corresponding bin in subrange 2b
3503	INTEGER(iwp) :: b !< loop index
3504	INTEGER(iwp) :: ll !< loop index
3505	INTEGER(iwp) :: mm !< loop index
3506	INTEGER(iwp) :: nn !< loop index
3507	REAL(wp) :: pressi !< pressure
3508	REAL(wp) :: temppi !< temperature
3509	REAL(wp) :: zcc(fn2b,fn2b) !< updated coagulation coefficients (m3/s)
3510	REAL(wp) :: zdpart_mm !< diameter of particle (m)
3511	REAL(wp) :: zdpart_nn !< diameter of particle (m)
3512	REAL(wp) :: zminusterm !< coagulation loss in a bin (1/s)
3513	REAL(wp) :: zplusterm(8) !< coagulation gain in a bin (fxm/s)
3514	!< (for each chemical compound)
3515	REAL(wp) :: zmpart(fn2b) !< approximate mass of particles (kg)
3516
3517	zcc = 0.0_wp
3518	zmpart = 0.0_wp
3519	zdpart_mm = 0.0_wp
3520	zdpart_nn = 0.0_wp
3521	!
3522	!-- 1) Coagulation to coarse mode calculated in a simplified way:
3523	!-- CoagSink ~ Dp in continuum subrange, thus we calculate 'effective'
3524	!-- number concentration of coarse particles
3525
3526	!-- 2) Updating coagulation coefficients
3527	!
3528	!-- Aerosol mass (kg). Density of 1500 kg/m3 assumed
3529	zmpart(1:fn2b) = api6 * ( MIN( paero(1:fn2b)%dwet, 30.0E-6_wp )**3.0_wp ) &
3530	* 1500.0_wp
3531	temppi = ptemp
3532	pressi = ppres
3533	zcc = 0.0_wp
3534	!
3535	!-- Aero-aero coagulation
3536	DO mm = 1, fn2b ! smaller colliding particle
3537	IF ( paero(mm)%numc < nclim ) CYCLE
3538	DO nn = mm, fn2b ! larger colliding particle
3539	IF ( paero(nn)%numc < nclim ) CYCLE
3540
3541	zdpart_mm = MIN( paero(mm)%dwet, 30.0E-6_wp ) ! Limit to 30 um
3542	zdpart_nn = MIN( paero(nn)%dwet, 30.0E-6_wp ) ! Limit to 30 um
3543	!
3544	!-- Coagulation coefficient of particles (m3/s)
3545	zcc(mm,nn) = coagc( zdpart_mm, zdpart_nn, zmpart(mm), zmpart(nn), &
3546	temppi, pressi )
3547	zcc(nn,mm) = zcc(mm,nn)
3548	ENDDO
3549	ENDDO
3550
3551	!
3552	!-- 3) New particle and volume concentrations after coagulation:
3553	!-- Calculated according to Jacobson (2005) eq. 15.9
3554	!
3555	!-- Aerosols in subrange 1a:
3556	DO b = in1a, fn1a
3557	IF ( paero(b)%numc < nclim ) CYCLE
3558	zminusterm = 0.0_wp
3559	zplusterm(:) = 0.0_wp
3560	!
3561	!-- Particles lost by coagulation with larger aerosols
3562	DO ll = b+1, fn2b
3563	zminusterm = zminusterm + zcc(b,ll) * paero(ll)%numc
3564	ENDDO
3565	!
3566	!-- Coagulation gain in a bin: change in volume conc. (cm3/cm3):
3567	DO ll = in1a, b-1
3568	zplusterm(1:2) = zplusterm(1:2) + zcc(ll,b) * paero(ll)%volc(1:2)
3569	zplusterm(6:7) = zplusterm(6:7) + zcc(ll,b) * paero(ll)%volc(6:7)
3570	zplusterm(8) = zplusterm(8) + zcc(ll,b) * paero(ll)%volc(8)
3571	ENDDO
3572	!
3573	!-- Volume and number concentrations after coagulation update [fxm]
3574	paero(b)%volc(1:2) = ( paero(b)%volc(1:2) + ptstep * zplusterm(1:2) * &
3575	paero(b)%numc ) / ( 1.0_wp + ptstep * zminusterm )
3576	paero(b)%volc(6:7) = ( paero(b)%volc(6:7) + ptstep * zplusterm(6:7) * &
3577	paero(b)%numc ) / ( 1.0_wp + ptstep * zminusterm )
3578	paero(b)%volc(8) = ( paero(b)%volc(8) + ptstep * zplusterm(8) * &
3579	paero(b)%numc ) / ( 1.0_wp + ptstep * zminusterm )
3580	paero(b)%numc = paero(b)%numc / ( 1.0_wp + ptstep * zminusterm + &
3581	0.5_wp * ptstep * zcc(b,b) * paero(b)%numc )
3582	ENDDO
3583	!
3584	!-- Aerosols in subrange 2a:
3585	DO b = in2a, fn2a
3586	IF ( paero(b)%numc < nclim ) CYCLE
3587	zminusterm = 0.0_wp
3588	zplusterm(:) = 0.0_wp
3589	!
3590	!-- Find corresponding size bin in subrange 2b
3591	index_2b = b - in2a + in2b
3592	!
3593	!-- Particles lost by larger particles in 2a
3594	DO ll = b+1, fn2a
3595	zminusterm = zminusterm + zcc(b,ll) * paero(ll)%numc
3596	ENDDO
3597	!
3598	!-- Particles lost by larger particles in 2b
3599	IF ( .NOT. no_insoluble ) THEN
3600	DO ll = index_2b+1, fn2b
3601	zminusterm = zminusterm + zcc(b,ll) * paero(ll)%numc
3602	ENDDO
3603	ENDIF
3604	!
3605	!-- Particle volume gained from smaller particles in subranges 1, 2a and 2b
3606	DO ll = in1a, b-1
3607	zplusterm(1:2) = zplusterm(1:2) + zcc(ll,b) * paero(ll)%volc(1:2)
3608	zplusterm(6:7) = zplusterm(6:7) + zcc(ll,b) * paero(ll)%volc(6:7)
3609	zplusterm(8) = zplusterm(8) + zcc(ll,b) * paero(ll)%volc(8)
3610	ENDDO
3611	!
3612	!-- Particle volume gained from smaller particles in 2a
3613	!-- (Note, for components not included in the previous loop!)
3614	DO ll = in2a, b-1
3615	zplusterm(3:5) = zplusterm(3:5) + zcc(ll,b)*paero(ll)%volc(3:5)
3616	ENDDO
3617
3618	!
3619	!-- Particle volume gained from smaller (and equal) particles in 2b
3620	IF ( .NOT. no_insoluble ) THEN
3621	DO ll = in2b, index_2b
3622	zplusterm(1:8) = zplusterm(1:8) + zcc(ll,b) * paero(ll)%volc(1:8)
3623	ENDDO
3624	ENDIF
3625	!
3626	!-- Volume and number concentrations after coagulation update [fxm]
3627	paero(b)%volc(1:8) = ( paero(b)%volc(1:8) + ptstep * zplusterm(1:8) * &
3628	paero(b)%numc ) / ( 1.0_wp + ptstep * zminusterm )
3629	paero(b)%numc = paero(b)%numc / ( 1.0_wp + ptstep * zminusterm + &
3630	0.5_wp * ptstep * zcc(b,b) * paero(b)%numc )
3631	ENDDO
3632	!
3633	!-- Aerosols in subrange 2b:
3634	IF ( .NOT. no_insoluble ) THEN
3635	DO b = in2b, fn2b
3636	IF ( paero(b)%numc < nclim ) CYCLE
3637	zminusterm = 0.0_wp
3638	zplusterm(:) = 0.0_wp
3639	!
3640	!-- Find corresponding size bin in subsubrange 2a
3641	index_2a = b - in2b + in2a
3642	!
3643	!-- Particles lost to larger particles in subranges 2b
3644	DO ll = b+1, fn2b
3645	zminusterm = zminusterm + zcc(b,ll) * paero(ll)%numc
3646	ENDDO
3647	!
3648	!-- Particles lost to larger and equal particles in 2a
3649	DO ll = index_2a, fn2a
3650	zminusterm = zminusterm + zcc(b,ll) * paero(ll)%numc
3651	ENDDO
3652	!
3653	!-- Particle volume gained from smaller particles in subranges 1 & 2a
3654	DO ll = in1a, index_2a-1
3655	zplusterm(1:8) = zplusterm(1:8) + zcc(ll,b) * paero(ll)%volc(1:8)
3656	ENDDO
3657	!
3658	!-- Particle volume gained from smaller particles in 2b
3659	DO ll = in2b, b-1
3660	zplusterm(1:8) = zplusterm(1:8) + zcc(ll,b) * paero(ll)%volc(1:8)
3661	ENDDO
3662	!
3663	!-- Volume and number concentrations after coagulation update [fxm]
3664	paero(b)%volc(1:8) = ( paero(b)%volc(1:8) + ptstep * zplusterm(1:8)&
3665	* paero(b)%numc ) / ( 1.0_wp + ptstep * zminusterm )
3666	paero(b)%numc = paero(b)%numc / ( 1.0_wp + ptstep * zminusterm + &
3667	0.5_wp * ptstep * zcc(b,b) * paero(b)%numc )
3668	ENDDO
3669	ENDIF
3670
3671	END SUBROUTINE coagulation
3672
3673	!------------------------------------------------------------------------------!
3674	! Description:
3675	! ------------
3676	!> Calculation of coagulation coefficients. Extended version of the function
3677	!> originally found in mo_salsa_init.
3678	!
3679	!> J. Tonttila, FMI, 05/2014
3680	!------------------------------------------------------------------------------!
3681	REAL(wp) FUNCTION coagc( diam1, diam2, mass1, mass2, temp, pres )
3682
3683	IMPLICIT NONE
3684	!
3685	!-- Input and output variables
3686	REAL(wp), INTENT(in) :: diam1 !< diameter of colliding particle 1 (m)
3687	REAL(wp), INTENT(in) :: diam2 !< diameter of colliding particle 2 (m)
3688	REAL(wp), INTENT(in) :: mass1 !< mass of colliding particle 1 (kg)
3689	REAL(wp), INTENT(in) :: mass2 !< mass of colliding particle 2 (kg)
3690	REAL(wp), INTENT(in) :: pres !< ambient pressure (Pa?) [fxm]
3691	REAL(wp), INTENT(in) :: temp !< ambient temperature (K)
3692	!
3693	!-- Local variables
3694	REAL(wp) :: fmdist !< distance of flux matching (m)
3695	REAL(wp) :: knud_p !< particle Knudsen number
3696	REAL(wp) :: mdiam !< mean diameter of colliding particles (m)
3697	REAL(wp) :: mfp !< mean free path of air molecules (m)
3698	REAL(wp) :: visc !< viscosity of air (kg/(m s))
3699	REAL(wp), DIMENSION (2) :: beta !< Cunningham correction factor
3700	REAL(wp), DIMENSION (2) :: dfpart !< particle diffusion coefficient
3701	!< (m2/s)
3702	REAL(wp), DIMENSION (2) :: diam !< diameters of particles (m)
3703	REAL(wp), DIMENSION (2) :: flux !< flux in continuum and free molec.
3704	!< regime (m/s)
3705	REAL(wp), DIMENSION (2) :: knud !< particle Knudsen number
3706	REAL(wp), DIMENSION (2) :: mpart !< masses of particles (kg)
3707	REAL(wp), DIMENSION (2) :: mtvel !< particle mean thermal velocity (m/s)
3708	REAL(wp), DIMENSION (2) :: omega !< particle mean free path
3709	REAL(wp), DIMENSION (2) :: tva !< temporary variable (m)
3710	!
3711	!-- Initialisation
3712	coagc = 0.0_wp
3713	!
3714	!-- 1) Initializing particle and ambient air variables
3715	diam = (/ diam1, diam2 /) !< particle diameters (m)
3716	mpart = (/ mass1, mass2 /) !< particle masses (kg)
3717	!-- Viscosity of air (kg/(m s))
3718	visc = ( 7.44523E-3_wp * temp ** 1.5_wp ) / &
3719	( 5093.0_wp * ( temp + 110.4_wp ) )
3720	!-- Mean free path of air (m)
3721	mfp = ( 1.656E-10_wp * temp + 1.828E-8_wp ) * ( p_0 + 1325.0_wp ) / pres
3722	!
3723	!-- 2) Slip correction factor for small particles
3724	knud = 2.0_wp * EXP( LOG(mfp) - LOG(diam) )! Knudsen number for air (15.23)
3725	!-- Cunningham correction factor (Allen and Raabe, Aerosol Sci. Tech. 4, 269)
3726	beta = 1.0_wp + knud * ( 1.142_wp + 0.558_wp * EXP( -0.999_wp / knud ) )
3727	!
3728	!-- 3) Particle properties
3729	!-- Diffusion coefficient (m2/s) (Jacobson (2005) eq. 15.29)
3730	dfpart = beta * abo * temp / ( 3.0_wp * pi * visc * diam )
3731	!-- Mean thermal velocity (m/s) (Jacobson (2005) eq. 15.32)
3732	mtvel = SQRT( ( 8.0_wp * abo * temp ) / ( pi * mpart ) )
3733	!-- Particle mean free path (m) (Jacobson (2005) eq. 15.34 )
3734	omega = 8.0_wp * dfpart / ( pi * mtvel )
3735	!-- Mean diameter (m)
3736	mdiam = 0.5_wp * ( diam(1) + diam(2) )
3737	!
3738	!-- 4) Calculation of fluxes (Brownian collision kernels) and flux matching
3739	!-- following Jacobson (2005):
3740	!-- Flux in continuum regime (m3/s) (eq. 15.28)
3741	flux(1) = 4.0_wp * pi * mdiam * ( dfpart(1) + dfpart(2) )
3742	!-- Flux in free molec. regime (m3/s) (eq. 15.31)
3743	flux(2) = pi * SQRT( ( mtvel(1)2.0_wp ) + ( mtvel(2)2.0_wp ) ) * &
3744	( mdiam**2.0_wp )
3745	!-- temporary variables (m) to calculate flux matching distance (m)
3746	tva(1) = ( ( mdiam + omega(1) )3.0_wp - ( mdiam2.0_wp + &
3747	omega(1)*2.0_wp ) SQRT( ( mdiam2.0_wp + omega(1)2.0_wp ) &
3748	) ) / ( 3.0_wp * mdiam * omega(1) ) - mdiam
3749	tva(2) = ( ( mdiam + omega(2) )3.0_wp - ( mdiam2.0_wp + &
3750	omega(2)*2.0_wp ) SQRT( ( mdiam2 + omega(2)2 ) ) ) / &
3751	( 3.0_wp * mdiam * omega(2) ) - mdiam
3752	!-- Flux matching distance (m) i.e. the mean distance from the centre of a
3753	!-- sphere reached by particles leaving sphere's surface and travelling a
3754	!-- distance of particle mean free path mfp (eq. 15 34)
3755	fmdist = SQRT( tva(1)2 + tva(2)2.0_wp)
3756	!
3757	!-- 5) Coagulation coefficient (m3/s) (eq. 15.33). Here assumed
3758	!-- coalescence efficiency 1!!
3759	coagc = flux(1) / ( mdiam / ( mdiam + fmdist) + flux(1) / flux(2) )
3760	!-- coagulation coefficient = coalescence efficiency * collision kernel
3761	!
3762	!-- Corrected collision kernel following Karl et al., 2016 (ACP):
3763	!-- Inclusion of van der Waals and viscous forces
3764	IF ( van_der_waals_coagc ) THEN
3765	knud_p = SQRT( omega(1)2 + omega(2)2 ) / mdiam
3766	IF ( knud_p >= 0.1_wp .AND. knud_p <= 10.0_wp ) THEN
3767	coagc = coagc * ( 2.0_wp + 0.4_wp * LOG( knud_p ) )
3768	ELSE
3769	coagc = coagc * 3.0_wp
3770	ENDIF
3771	ENDIF
3772
3773	END FUNCTION coagc
3774
3775	!------------------------------------------------------------------------------!
3776	! Description:
3777	! ------------
3778	!> Calculates the change in particle volume and gas phase
3779	!> concentrations due to nucleation, condensation and dissolutional growth.
3780	!
3781	!> Sulphuric acid and organic vapour: only condensation and no evaporation.
3782	!
3783	!> New gas and aerosol phase concentrations calculated according to Jacobson
3784	!> (1997): Numerical techniques to solve condensational and dissolutional growth
3785	!> equations when growth is coupled to reversible reactions, Aerosol Sci. Tech.,
3786	!> 27, pp 491-498.
3787	!
3788	!> Following parameterization has been used:
3789	!> Molecular diffusion coefficient of condensing vapour (m2/s)
3790	!> (Reid et al. (1987): Properties of gases and liquids, McGraw-Hill, New York.)
3791	!> D = {1.d-7sqrt(1/M_air + 1/M_gas)T^1.75} / &
3792	! {p_atm/p_stand * (d_air^(1/3) + d_gas^(1/3))^2 }
3793	! M_air = 28.965 : molar mass of air (g/mol)
3794	! d_air = 19.70 : diffusion volume of air
3795	! M_h2so4 = 98.08 : molar mass of h2so4 (g/mol)
3796	! d_h2so4 = 51.96 : diffusion volume of h2so4
3797	!
3798	!> Called from main aerosol model
3799	!
3800	!> fxm: calculated for empty bins too
3801	!> fxm: same diffusion coefficients and mean free paths used for sulphuric acid
3802	!> and organic vapours (average values? 'real' values for each?)
3803	!> fxm: one should really couple with vapour production and loss terms as well
3804	!> should nucleation be coupled here as well????
3805	!
3806	! Coded by:
3807	! Hannele Korhonen (FMI) 2005
3808	! Harri Kokkola (FMI) 2006
3809	! Juha Tonttila (FMI) 2014
3810	! Rewritten to PALM by Mona Kurppa (UHel) 2017
3811	!------------------------------------------------------------------------------!
3812	SUBROUTINE condensation( paero, pcsa, pcocnv, pcocsv, pchno3, pcnh3, pcw, pcs,&
3813	ptemp, ppres, ptstep, prtcl )
3814
3815	IMPLICIT NONE
3816
3817	!-- Input and output variables
3818	REAL(wp), INTENT(IN) :: ppres !< ambient pressure (Pa)
3819	REAL(wp), INTENT(IN) :: pcs !< Water vapour saturation concentration
3820	!< (kg/m3)
3821	REAL(wp), INTENT(IN) :: ptemp !< ambient temperature (K)
3822	REAL(wp), INTENT(IN) :: ptstep !< timestep (s)
3823	TYPE(component_index), INTENT(in) :: prtcl !< Keeps track which substances
3824	!< are used
3825	REAL(wp), INTENT(INOUT) :: pchno3 !< Gas concentrations (#/m3):
3826	!< nitric acid HNO3
3827	REAL(wp), INTENT(INOUT) :: pcnh3 !< ammonia NH3
3828	REAL(wp), INTENT(INOUT) :: pcocnv !< non-volatile organics
3829	REAL(wp), INTENT(INOUT) :: pcocsv !< semi-volatile organics
3830	REAL(wp), INTENT(INOUT) :: pcsa !< sulphuric acid H2SO4
3831	REAL(wp), INTENT(INOUT) :: pcw !< Water vapor concentration (kg/m3)
3832	TYPE(t_section), INTENT(inout) :: paero(fn2b) !< Aerosol properties
3833	!-- Local variables
3834	REAL(wp) :: zbeta(fn2b) !< transitional correction factor for aerosols
3835	REAL(wp) :: zcolrate(fn2b) !< collision rate of molecules to particles
3836	!< (1/s)
3837	REAL(wp) :: zcolrate_ocnv(fn2b) !< collision rate of organic molecules
3838	!< to particles (1/s)
3839	REAL(wp) :: zcs_ocnv !< condensation sink of nonvolatile organics (1/s)
3840	REAL(wp) :: zcs_ocsv !< condensation sink of semivolatile organics (1/s)
3841	REAL(wp) :: zcs_su !< condensation sink of sulfate (1/s)
3842	REAL(wp) :: zcs_tot!< total condensation sink (1/s) (gases)
3843	!-- vapour concentration after time step (#/m3)
3844	REAL(wp) :: zcvap_new1 !< sulphuric acid
3845	REAL(wp) :: zcvap_new2 !< nonvolatile organics
3846	REAL(wp) :: zcvap_new3 !< semivolatile organics
3847	REAL(wp) :: zdfpart(in1a+1) !< particle diffusion coefficient (m2/s)
3848	REAL(wp) :: zdfvap !< air diffusion coefficient (m2/s)
3849	!-- change in vapour concentration (#/m3)
3850	REAL(wp) :: zdvap1 !< sulphuric acid
3851	REAL(wp) :: zdvap2 !< nonvolatile organics
3852	REAL(wp) :: zdvap3 !< semivolatile organics
3853	REAL(wp) :: zdvoloc(fn2b) !< change of organics volume in each bin [fxm]
3854	REAL(wp) :: zdvolsa(fn2b) !< change of sulphate volume in each bin [fxm]
3855	REAL(wp) :: zj3n3(2) !< Formation massrate of molecules in
3856	!< nucleation, (molec/m3s). 1: H2SO4
3857	!< and 2: organic vapor
3858	REAL(wp) :: zknud(fn2b) !< particle Knudsen number
3859	REAL(wp) :: zmfp !< mean free path of condensing vapour (m)
3860	REAL(wp) :: zrh !< Relative humidity [0-1]
3861	REAL(wp) :: zvisc !< viscosity of air (kg/(m s))
3862	REAL(wp) :: zn_vs_c !< ratio of nucleation of all mass transfer in the
3863	!< smallest bin
3864	REAL(wp) :: zxocnv !< ratio of organic vapour in 3nm particles
3865	REAL(wp) :: zxsa !< Ratio in 3nm particles: sulphuric acid
3866
3867	zj3n3 = 0.0_wp
3868	zrh = pcw / pcs
3869	zxocnv = 0.0_wp
3870	zxsa = 0.0_wp
3871	!
3872	!-- Nucleation
3873	IF ( nsnucl > 0 ) THEN
3874	CALL nucleation( paero, ptemp, zrh, ppres, pcsa, pcocnv, pcnh3, ptstep, &
3875	zj3n3, zxsa, zxocnv )
3876	ENDIF
3877	!
3878	!-- Condensation on pre-existing particles
3879	IF ( lscndgas ) THEN
3880	!
3881	!-- Initialise:
3882	zdvolsa = 0.0_wp
3883	zdvoloc = 0.0_wp
3884	zcolrate = 0.0_wp
3885	!
3886	!-- 1) Properties of air and condensing gases:
3887	!-- Viscosity of air (kg/(m s)) (Eq. 4.54 in Jabonson (2005))
3888	zvisc = ( 7.44523E-3_wp * ptemp ** 1.5_wp ) / ( 5093.0_wp * &
3889	( ptemp + 110.4_wp ) )
3890	!-- Diffusion coefficient of air (m2/s)
3891	zdfvap = 5.1111E-10_wp * ptemp ** 1.75_wp * ( p_0 + 1325.0_wp ) / ppres
3892	!-- Mean free path (m): same for H2SO4 and organic compounds
3893	zmfp = 3.0_wp * zdfvap * SQRT( pi * amh2so4 / ( 8.0_wp * argas * ptemp ) )
3894	!
3895	!-- 2) Transition regime correction factor zbeta for particles:
3896	!-- Fuchs and Sutugin (1971), In: Hidy et al. (ed.) Topics in current
3897	!-- aerosol research, Pergamon. Size of condensing molecule considered
3898	!-- only for nucleation mode (3 - 20 nm)
3899	!
3900	!-- Particle Knudsen number: condensation of gases on aerosols
3901	zknud(in1a:in1a+1) = 2.0_wp * zmfp / ( paero(in1a:in1a+1)%dwet + d_sa )
3902	zknud(in1a+2:fn2b) = 2.0_wp * zmfp / paero(in1a+2:fn2b)%dwet
3903	!
3904	!-- Transitional correction factor: aerosol + gas (the semi-empirical Fuchs-
3905	!-- Sutugin interpolation function (Fuchs and Sutugin, 1971))
3906	zbeta = ( zknud + 1.0_wp ) / ( 0.377_wp * zknud + 1.0_wp + 4.0_wp / &
3907	( 3.0_wp * massacc ) * ( zknud + zknud ** 2.0_wp ) )
3908	!
3909	!-- 3) Collision rate of molecules to particles
3910	!-- Particle diffusion coefficient considered only for nucleation mode
3911	!-- (3 - 20 nm)
3912	!
3913	!-- Particle diffusion coefficient (m2/s) (e.g. Eq. 15.29 in Jacobson (2005))
3914	zdfpart = abo * ptemp * zbeta(in1a:in1a+1) / ( 3.0_wp * pi * zvisc * &
3915	paero(in1a:in1a+1)%dwet )
3916	!
3917	!-- Collision rate (mass-transfer coefficient): gases on aerosols (1/s)
3918	!-- (Eq. 16.64 in Jacobson (2005))
3919	zcolrate(in1a:in1a+1) = MERGE( 2.0_wp * pi * &
3920	( paero(in1a:in1a+1)%dwet + d_sa ) * &
3921	( zdfvap + zdfpart ) * zbeta(in1a:in1a+1)&
3922	* paero(in1a:in1a+1)%numc, 0.0_wp, &
3923	paero(in1a:in1a+1)%numc > nclim )
3924	zcolrate(in1a+2:fn2b) = MERGE( 2.0_wp * pi * paero(in1a+2:fn2b)%dwet * &
3925	zdfvap * zbeta(in1a+2:fn2b) * &
3926	paero(in1a+2:fn2b)%numc, 0.0_wp, &
3927	paero(in1a+2:fn2b)%numc > nclim )
3928	!
3929	!-- 4) Condensation sink (1/s)
3930	zcs_tot = SUM( zcolrate ) ! total sink
3931	!
3932	!-- 5) Changes in gas-phase concentrations and particle volume
3933	!
3934	!-- 5.1) Organic vapours
3935	!
3936	!-- 5.1.1) Non-volatile organic compound: condenses onto all bins
3937	IF ( pcocnv > 1.0E+10_wp .AND. zcs_tot > 1.0E-30_wp .AND. &
3938	is_used( prtcl,'OC' ) ) &
3939	THEN
3940	!-- Ratio of nucleation vs. condensation rates in the smallest bin
3941	zn_vs_c = 0.0_wp
3942	IF ( zj3n3(2) > 1.0_wp ) THEN
3943	zn_vs_c = ( zj3n3(2) ) / ( zj3n3(2) + pcocnv * zcolrate(in1a) )
3944	ENDIF
3945	!
3946	!-- Collision rate in the smallest bin, including nucleation and
3947	!-- condensation(see Jacobson, Fundamentals of Atmospheric Modeling, 2nd
3948	!-- Edition (2005), equation (16.73) )
3949	zcolrate_ocnv = zcolrate
3950	zcolrate_ocnv(in1a) = zcolrate_ocnv(in1a) + zj3n3(2) / pcocnv
3951	!
3952	!-- Total sink for organic vapor
3953	zcs_ocnv = zcs_tot + zj3n3(2) / pcocnv
3954	!
3955	!-- New gas phase concentration (#/m3)
3956	zcvap_new2 = pcocnv / ( 1.0_wp + ptstep * zcs_ocnv )
3957	!
3958	!-- Change in gas concentration (#/m3)
3959	zdvap2 = pcocnv - zcvap_new2
3960	!
3961	!-- Updated vapour concentration (#/m3)
3962	pcocnv = zcvap_new2
3963	!
3964	!-- Volume change of particles (m3(OC)/m3(air))
3965	zdvoloc = zcolrate_ocnv(in1a:fn2b) / zcs_ocnv * amvoc * zdvap2
3966	!
3967	!-- Change of volume due to condensation in 1a-2b
3968	paero(in1a:fn2b)%volc(2) = paero(in1a:fn2b)%volc(2) + zdvoloc
3969	!
3970	!-- Change of number concentration in the smallest bin caused by
3971	!-- nucleation (Jacobson (2005), equation (16.75)). If zxocnv = 0, then
3972	!-- the chosen nucleation mechanism doesn't take into account the non-
3973	!-- volatile organic vapors and thus the paero doesn't have to be updated.
3974	IF ( zxocnv > 0.0_wp ) THEN
3975	paero(in1a)%numc = paero(in1a)%numc + zn_vs_c * zdvoloc(in1a) / &
3976	amvoc / ( n3 * zxocnv )
3977	ENDIF
3978	ENDIF
3979	!
3980	!-- 5.1.2) Semivolatile organic compound: all bins except subrange 1
3981	zcs_ocsv = SUM( zcolrate(in2a:fn2b) ) !< sink for semi-volatile organics
3982	IF ( pcocsv > 1.0E+10_wp .AND. zcs_ocsv > 1.0E-30 .AND. &
3983	is_used( prtcl,'OC') ) &
3984	THEN
3985	!
3986	!-- New gas phase concentration (#/m3)
3987	zcvap_new3 = pcocsv / ( 1.0_wp + ptstep * zcs_ocsv )
3988	!
3989	!-- Change in gas concentration (#/m3)
3990	zdvap3 = pcocsv - zcvap_new3
3991	!
3992	!-- Updated gas concentration (#/m3)
3993	pcocsv = zcvap_new3
3994	!
3995	!-- Volume change of particles (m3(OC)/m3(air))
3996	zdvoloc(in2a:fn2b) = zdvoloc(in2a:fn2b) + zcolrate(in2a:fn2b) / &
3997	zcs_ocsv * amvoc * zdvap3
3998	!
3999	!-- Change of volume due to condensation in 1a-2b
4000	paero(in1a:fn2b)%volc(2) = paero(in1a:fn2b)%volc(2) + zdvoloc
4001	ENDIF
4002	!
4003	!-- 5.2) Sulphate: condensed on all bins
4004	IF ( pcsa > 1.0E+10_wp .AND. zcs_tot > 1.0E-30_wp .AND. &
4005	is_used( prtcl,'SO4' ) ) &
4006	THEN
4007	!
4008	!-- Ratio of mass transfer between nucleation and condensation
4009	zn_vs_c = 0.0_wp
4010	IF ( zj3n3(1) > 1.0_wp ) THEN
4011	zn_vs_c = ( zj3n3(1) ) / ( zj3n3(1) + pcsa * zcolrate(in1a) )
4012	ENDIF
4013	!
4014	!-- Collision rate in the smallest bin, including nucleation and
4015	!-- condensation (see Jacobson, Fundamentals of Atmospheric Modeling, 2nd
4016	!-- Edition (2005), equation (16.73))
4017	zcolrate(in1a) = zcolrate(in1a) + zj3n3(1) / pcsa
4018	!
4019	!-- Total sink for sulfate (1/s)
4020	zcs_su = zcs_tot + zj3n3(1) / pcsa
4021	!
4022	!-- Sulphuric acid:
4023	!-- New gas phase concentration (#/m3)
4024	zcvap_new1 = pcsa / ( 1.0_wp + ptstep * zcs_su )
4025	!
4026	!-- Change in gas concentration (#/m3)
4027	zdvap1 = pcsa - zcvap_new1
4028	!
4029	!-- Updating vapour concentration (#/m3)
4030	pcsa = zcvap_new1
4031	!
4032	!-- Volume change of particles (m3(SO4)/m3(air)) by condensation
4033	zdvolsa = zcolrate(in1a:fn2b) / zcs_su * amvh2so4 * zdvap1
4034	!-- For validation: zdvolsa = 5.5 mum3/cm3 per 12 h
4035	! zdvolsa = zdvolsa / SUM( zdvolsa ) * 5.5E-12_wp * dt_salsa / 43200.0_wp
4036	!0.3E-12_wp, 0.6E-12_wp, 11.0E-12_wp, 4.6E-12_wp, 9.2E-12_wp
4037	!
4038	!-- Change of volume concentration of sulphate in aerosol [fxm]
4039	paero(in1a:fn2b)%volc(1) = paero(in1a:fn2b)%volc(1) + zdvolsa
4040	!
4041	!-- Change of number concentration in the smallest bin caused by nucleation
4042	!-- (Jacobson (2005), equation (16.75))
4043	IF ( zxsa > 0.0_wp ) THEN
4044	paero(in1a)%numc = paero(in1a)%numc + zn_vs_c * zdvolsa(in1a) / &
4045	amvh2so4 / ( n3 * zxsa )
4046	ENDIF
4047	ENDIF
4048	ENDIF
4049	!
4050	!
4051	!-- Condensation of water vapour
4052	IF ( lscndh2oae ) THEN
4053	CALL gpparth2o( paero, ptemp, ppres, pcs, pcw, ptstep )
4054	ENDIF
4055	!
4056	!
4057	!-- Partitioning of H2O, HNO3, and NH3: Dissolutional growth
4058	IF ( lscndgas .AND. ino > 0 .AND. inh > 0 .AND. &
4059	( pchno3 > 1.0E+10_wp .OR. pcnh3 > 1.0E+10_wp ) ) &
4060	THEN
4061	CALL gpparthno3( ppres, ptemp, paero, pchno3, pcnh3, pcw, pcs, zbeta, &
4062	ptstep )
4063	ENDIF
4064
4065	END SUBROUTINE condensation
4066
4067	!------------------------------------------------------------------------------!
4068	! Description:
4069	! ------------
4070	!> Calculates the particle number and volume increase, and gas-phase
4071	!> concentration decrease due to nucleation subsequent growth to detectable size
4072	!> of 3 nm.
4073	!
4074	!> Method:
4075	!> When the formed clusters grow by condensation (possibly also by self-
4076	!> coagulation), their number is reduced due to scavenging to pre-existing
4077	!> particles. Thus, the apparent nucleation rate at 3 nm is significantly lower
4078	!> than the real nucleation rate (at ~1 nm).
4079	!
4080	!> Calculation of the formation rate of detectable particles at 3 nm (i.e. J3):
4081	!> nj3 = 1: Kerminen, V.-M. and Kulmala, M. (2002), J. Aerosol Sci.,33, 609-622.
4082	!> nj3 = 2: Lehtinen et al. (2007), J. Aerosol Sci., 38(9), 988-994.
4083	!> nj3 = 3: Anttila et al. (2010), J. Aerosol Sci., 41(7), 621-636.
4084	!
4085	!> Called from subroutine condensation (in module salsa_dynamics_mod.f90)
4086	!
4087	!> Calls one of the following subroutines:
4088	!> - binnucl
4089	!> - ternucl
4090	!> - kinnucl
4091	!> - actnucl
4092	!
4093	!> fxm: currently only sulphuric acid grows particles from 1 to 3 nm
4094	!> (if asked from Markku, this is terribly wrong!!!)
4095	!
4096	!> Coded by:
4097	!> Hannele Korhonen (FMI) 2005
4098	!> Harri Kokkola (FMI) 2006
4099	!> Matti Niskanen(FMI) 2012
4100	!> Anton Laakso (FMI) 2013
4101	!------------------------------------------------------------------------------!
4102
4103	SUBROUTINE nucleation( paero, ptemp, prh, ppres, pcsa, pcocnv, pcnh3, ptstep, &
4104	pj3n3, pxsa, pxocnv )
4105	IMPLICIT NONE
4106	!
4107	!-- Input and output variables
4108	REAL(wp), INTENT(in) :: pcnh3 !< ammonia concentration (#/m3)
4109	REAL(wp), INTENT(in) :: pcocnv !< conc. of non-volatile OC (#/m3)
4110	REAL(wp), INTENT(in) :: pcsa !< sulphuric acid conc. (#/m3)
4111	REAL(wp), INTENT(in) :: ppres !< ambient air pressure (Pa)
4112	REAL(wp), INTENT(in) :: prh !< ambient rel. humidity [0-1]
4113	REAL(wp), INTENT(in) :: ptemp !< ambient temperature (K)
4114	REAL(wp), INTENT(in) :: ptstep !< time step (s) of SALSA
4115	TYPE(t_section), INTENT(inout) :: paero(fn2b) !< aerosol properties
4116	REAL(wp), INTENT(inout) :: pj3n3(2) !< formation mass rate of molecules
4117	!< (molec/m3s) for 1: H2SO4 and
4118	!< 2: organic vapour
4119	REAL(wp), INTENT(out) :: pxocnv !< ratio of non-volatile organic vapours in
4120	!< 3nm aerosol particles
4121	REAL(wp), INTENT(out) :: pxsa !< ratio of H2SO4 in 3nm aerosol particles
4122	!-- Local variables
4123	INTEGER(iwp) :: iteration
4124	REAL(wp) :: zbeta(fn2b) !< transitional correction factor
4125	REAL(wp) :: zc_h2so4 !< H2SO4 conc. (#/cm3) !UNITS!
4126	REAL(wp) :: zc_org !< organic vapour conc. (#/cm3)
4127	REAL(wp) :: zCoagStot !< total losses due to coagulation, including
4128	!< condensation and self-coagulation
4129	REAL(wp) :: zcocnv_local !< organic vapour conc. (#/m3)
4130	REAL(wp) :: zcsink !< condensational sink (#/m2)
4131	REAL(wp) :: zcsa_local !< H2SO4 conc. (#/m3)
4132	REAL(wp) :: zdcrit !< diameter of critical cluster (m)
4133	REAL(wp) :: zdelta_vap !< change of H2SO4 and organic vapour
4134	!< concentration (#/m3)
4135	REAL(wp) :: zdfvap !< air diffusion coefficient (m2/s)
4136	REAL(wp) :: zdmean !< mean diameter of existing particles (m)
4137	REAL(wp) :: zeta !< constant: proportional to ratio of CS/GR (m)
4138	!< (condensation sink / growth rate)
4139	REAL(wp) :: zgamma !< proportionality factor ((nm2*m2)/h)
4140	REAL(wp) :: zGRclust !< growth rate of formed clusters (nm/h)
4141	REAL(wp) :: zGRtot !< total growth rate
4142	REAL(wp) :: zj3 !< number conc. of formed 3nm particles (#/m3)
4143	REAL(wp) :: zjnuc !< nucleation rate at ~1nm (#/m3s)
4144	REAL(wp) :: zKeff !< effective cogulation coefficient between
4145	!< freshly nucleated particles
4146	REAL(wp) :: zknud(fn2b) !< particle Knudsen number
4147	REAL(wp) :: zkocnv !< lever: zkocnv=1 --> organic compounds involved
4148	!< in nucleation
4149	REAL(wp) :: zksa !< lever: zksa=1 --> H2SO4 involved in nucleation
4150	REAL(wp) :: zlambda !< parameter for adjusting the growth rate due to
4151	!< self-coagulation
4152	REAL(wp) :: zmfp !< mean free path of condesing vapour(m)
4153	REAL(wp) :: zmixnh3 !< ammonia mixing ratio (ppt)
4154	REAL(wp) :: zNnuc !< number of clusters/particles at the size range
4155	!< d1-dx (#/m3)
4156	REAL(wp) :: znoc !< number of organic molecules in critical cluster
4157	REAL(wp) :: znsa !< number of H2SO4 molecules in critical cluster
4158	!
4159	!-- Variable determined for the m-parameter
4160	REAL(wp) :: zCc_2(fn2b) !<
4161	REAL(wp) :: zCc_c !<
4162	REAL(wp) :: zCc_x !<
4163	REAL(wp) :: zCoagS_c !<
4164	REAL(wp) :: zCoagS_x !<
4165	REAL(wp) :: zcv_2(fn2b) !<
4166	REAL(wp) :: zcv_c !<
4167	REAL(wp) :: zcv_c2(fn2b) !<
4168	REAL(wp) :: zcv_x !<
4169	REAL(wp) :: zcv_x2(fn2b) !<
4170	REAL(wp) :: zDc_2(fn2b) !<
4171	REAL(wp) :: zDc_c(fn2b) !<
4172	REAL(wp) :: zDc_c2(fn2b) !<
4173	REAL(wp) :: zDc_x(fn2b) !<
4174	REAL(wp) :: zDc_x2(fn2b) !<
4175	REAL(wp) :: zgammaF_2(fn2b) !<
4176	REAL(wp) :: zgammaF_c(fn2b) !<
4177	REAL(wp) :: zgammaF_x(fn2b) !<
4178	REAL(wp) :: zK_c2(fn2b) !<
4179	REAL(wp) :: zK_x2(fn2b) !<
4180	REAL(wp) :: zknud_2(fn2b) !<
4181	REAL(wp) :: zknud_c !<
4182	REAL(wp) :: zknud_x !<
4183	REAL(wp) :: zm_2(fn2b) !<
4184	REAL(wp) :: zm_c !<
4185	REAL(wp) :: zm_para !<
4186	REAL(wp) :: zm_x !<
4187	REAL(wp) :: zmyy !<
4188	REAL(wp) :: zomega_2c(fn2b) !<
4189	REAL(wp) :: zomega_2x(fn2b) !<
4190	REAL(wp) :: zomega_c(fn2b) !<
4191	REAL(wp) :: zomega_x(fn2b) !<
4192	REAL(wp) :: zRc2(fn2b) !<
4193	REAL(wp) :: zRx2(fn2b) !<
4194	REAL(wp) :: zsigma_c2(fn2b) !<
4195	REAL(wp) :: zsigma_x2(fn2b) !<
4196	!
4197	!-- 1) Nucleation rate (zjnuc) and diameter of critical cluster (zdcrit)
4198	zjnuc = 0.0_wp
4199	znsa = 0.0_wp
4200	znoc = 0.0_wp
4201	zdcrit = 0.0_wp
4202	zksa = 0.0_wp
4203	zkocnv = 0.0_wp
4204
4205	SELECT CASE ( nsnucl )
4206
4207	CASE(1) ! Binary H2SO4-H2O nucleation
4208
4209	zc_h2so4 = pcsa * 1.0E-6_wp ! sulphuric acid conc. to #/cm3
4210	CALL binnucl( zc_h2so4, ptemp, prh, zjnuc, znsa, znoc, zdcrit, zksa, &
4211	zkocnv )
4212
4213	CASE(2) ! Activation type nucleation
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	CALL actnucl( pcsa, zjnuc, zdcrit, znsa, znoc, zksa, zkocnv, act_coeff )
4219
4220	CASE(3) ! Kinetically limited nucleation of (NH4)HSO4 clusters
4221
4222	zc_h2so4 = pcsa * 1.0E-6_wp ! sulphuric acid conc. to #/cm3
4223	CALL binnucl( zc_h2so4, ptemp, prh, zjnuc, znsa, znoc, zdcrit, zksa, &
4224	zkocnv )
4225
4226	CALL kinnucl( zc_h2so4, zjnuc, zdcrit, znsa, znoc, zksa, zkocnv )
4227
4228	CASE(4) ! Ternary H2SO4-H2O-NH3 nucleation
4229
4230	zmixnh3 = pcnh3 * ptemp * argas / ( ppres * avo )
4231	zc_h2so4 = pcsa * 1.0E-6_wp ! sulphuric acid conc. to #/cm3
4232	CALL ternucl( zc_h2so4, zmixnh3, ptemp, prh, zjnuc, znsa, znoc, zdcrit, &
4233	zksa, zkocnv )
4234
4235	CASE(5) ! Organic nucleation, J~[ORG] or J~[ORG]**2
4236
4237	zc_org = pcocnv * 1.0E-6_wp ! conc. of non-volatile OC to #/cm3
4238	zc_h2so4 = pcsa * 1.0E-6_wp ! sulphuric acid conc. to #/cm3
4239	CALL binnucl( zc_h2so4, ptemp, prh, zjnuc, znsa, znoc, zdcrit, zksa, &
4240	zkocnv )
4241	CALL orgnucl( pcocnv, zjnuc, zdcrit, znsa, znoc, zksa, zkocnv )
4242
4243	CASE(6) ! Sum of H2SO4 and organic activation type nucleation,
4244	! J~[H2SO4]+[ORG]
4245
4246	zc_h2so4 = pcsa * 1.0E-6_wp ! sulphuric acid conc. to #/cm3
4247	CALL binnucl( zc_h2so4, ptemp, prh, zjnuc, znsa, znoc, zdcrit, zksa, &
4248	zkocnv )
4249	CALL sumnucl( pcsa, pcocnv, zjnuc, zdcrit, znsa, znoc, zksa, zkocnv )
4250
4251
4252	CASE(7) ! Heteromolecular nucleation, J~[H2SO4]*[ORG]
4253
4254	zc_h2so4 = pcsa * 1.0E-6_wp ! sulphuric acid conc. to #/cm3
4255	zc_org = pcocnv * 1.0E-6_wp ! conc. of non-volatile OC to #/cm3
4256	CALL binnucl( zc_h2so4, ptemp, prh, zjnuc, znsa, znoc, zdcrit, zksa, &
4257	zkocnv )
4258	CALL hetnucl( zc_h2so4, zc_org, zjnuc, zdcrit, znsa, znoc, zksa, zkocnv )
4259
4260	CASE(8) ! Homomolecular nucleation of H2SO4 and heteromolecular
4261	! nucleation of H2SO4 and organic vapour,
4262	! J~[H2SO4]*2 + [H2SO4][ORG] (EUCAARI project)
4263	zc_h2so4 = pcsa * 1.0E-6_wp ! sulphuric acid conc. to #/cm3
4264	zc_org = pcocnv * 1.0E-6_wp ! conc. of non-volatile OC to #/cm3
4265	CALL binnucl( zc_h2so4, ptemp, prh, zjnuc, znsa, znoc, zdcrit, zksa, &
4266	zkocnv )
4267	CALL SAnucl( zc_h2so4, zc_org, zjnuc, zdcrit, znsa, znoc, zksa, zkocnv )
4268
4269	CASE(9) ! Homomolecular nucleation of H2SO4 and organic vapour and
4270	! heteromolecular nucleation of H2SO4 and organic vapour,
4271	! J~[H2SO4]*2 + [H2SO4][ORG]+[ORG]**2 (EUCAARI project)
4272
4273	zc_h2so4 = pcsa * 1.0E-6_wp ! sulphuric acid conc. to #/cm3
4274	zc_org = pcocnv * 1.0E-6_wp ! conc. of non-volatile OC to #/cm3
4275	CALL binnucl( zc_h2so4, ptemp, prh, zjnuc, znsa, znoc, zdcrit, zksa, &
4276	zkocnv )
4277
4278	CALL SAORGnucl( zc_h2so4, zc_org, zjnuc, zdcrit, znsa, znoc, zksa, &
4279	zkocnv )
4280	END SELECT
4281
4282	zcsa_local = pcsa
4283	zcocnv_local = pcocnv
4284	!
4285	!-- 2) Change of particle and gas concentrations due to nucleation
4286	!
4287	!-- 2.1) Check that there is enough H2SO4 and organic vapour to produce the
4288	!-- nucleation
4289	IF ( nsnucl <= 4 ) THEN
4290	!-- If the chosen nucleation scheme is 1-4, nucleation occurs only due to
4291	!-- H2SO4. All of the total vapour concentration that is taking part to the
4292	!-- nucleation is there for sulphuric acid (sa = H2SO4) and non-volatile
4293	!-- organic vapour is zero.
4294	pxsa = 1.0_wp ! ratio of sulphuric acid in 3nm particles
4295	pxocnv = 0.0_wp ! ratio of non-volatile origanic vapour
4296	! in 3nm particles
4297	ELSEIF ( nsnucl > 4 ) THEN
4298	!-- If the chosen nucleation scheme is 5-9, nucleation occurs due to organic
4299	!-- vapour or the combination of organic vapour and H2SO4. The number of
4300	!-- needed molecules depends on the chosen nucleation type and it has an
4301	!-- effect also on the minimum ratio of the molecules present.
4302	IF ( pcsa * znsa + pcocnv * znoc < 1.E-14_wp ) THEN
4303	pxsa = 0.0_wp
4304	pxocnv = 0.0_wp
4305	ELSE
4306	pxsa = pcsa * znsa / ( pcsa * znsa + pcocnv * znoc )
4307	pxocnv = pcocnv * znoc / ( pcsa * znsa + pcocnv * znoc )
4308	ENDIF
4309	ENDIF
4310	!
4311	!-- The change in total vapour concentration is the sum of the concentrations
4312	!-- of the vapours taking part to the nucleation (depends on the chosen
4313	!-- nucleation scheme)
4314	zdelta_vap = MIN( zjnuc * ( znoc + znsa ), ( pcocnv * zkocnv + pcsa * &
4315	zksa ) / ptstep )
4316	!
4317	!-- Nucleation rate J at ~1nm (#/m3s)
4318	zjnuc = zdelta_vap / ( znoc + znsa )
4319	!
4320	!-- H2SO4 concentration after nucleation in #/m3
4321	zcsa_local = MAX( 1.0_wp, pcsa - zdelta_vap * pxsa )
4322	!
4323	!-- Non-volative organic vapour concentration after nucleation (#/m3)
4324	zcocnv_local = MAX( 1.0_wp, pcocnv - zdelta_vap * pxocnv )
4325	!
4326	!-- 2.2) Formation rate of 3 nm particles (Kerminen & Kulmala, 2002)
4327	!
4328	!-- 2.2.1) Growth rate of clusters formed by H2SO4
4329	!
4330	!-- GR = 3.0e-15 / dens_clus * sum( molecspeed * molarmass * conc )
4331	!
4332	!-- dens_clus = density of the clusters (here 1830 kg/m3)
4333	!-- molarmass = molar mass of condensing species (here 98.08 g/mol)
4334	!-- conc = concentration of condensing species [#/m3]
4335	!-- molecspeed = molecular speed of condensing species [m/s]
4336	!-- = sqrt( 8.0 * R * ptemp / ( pi * molarmass ) )
4337	!-- (Seinfeld & Pandis, 1998)
4338	!
4339	!-- Growth rate by H2SO4 and organic vapour in nm/h (Eq. 21)
4340	zGRclust = 2.3623E-15_wp * SQRT( ptemp ) * ( zcsa_local + zcocnv_local )
4341	!
4342	!-- 2.2.2) Condensational sink of pre-existing particle population
4343	!
4344	!-- Diffusion coefficient (m2/s)
4345	zdfvap = 5.1111E-10_wp * ptemp ** 1.75_wp * ( p_0 + 1325.0_wp ) / ppres
4346	!-- Mean free path of condensing vapour (m) (Jacobson (2005), Eq. 15.25 and
4347	!-- 16.29)
4348	zmfp = 3.0_wp * zdfvap * SQRT( pi * amh2so4 / ( 8.0_wp * argas * ptemp ) )
4349	!-- Knudsen number
4350	zknud = 2.0_wp * zmfp / ( paero(:)%dwet + d_sa )
4351	!-- Transitional regime correction factor (zbeta) according to Fuchs and
4352	!-- Sutugin (1971), In: Hidy et al. (ed.), Topics in current aerosol research,
4353	!-- Pergamon. (Eq. 4 in Kerminen and Kulmala, 2002)
4354	zbeta = ( zknud + 1.0_wp) / ( 0.377_wp * zknud + 1.0_wp + 4.0_wp / &
4355	( 3.0_wp * massacc ) * ( zknud + zknud ** 2 ) )
4356	!-- Condensational sink (#/m2) (Eq. 3)
4357	zcsink = SUM( paero(:)%dwet * zbeta * paero(:)%numc )
4358	!
4359	!-- Parameterised formation rate of detectable 3 nm particles (i.e. J3)
4360	IF ( nj3 == 1 ) THEN ! Kerminen and Kulmala (2002)
4361	!-- 2.2.3) Parameterised formation rate of detectable 3 nm particles
4362	!-- Constants needed for the parameterisation:
4363	!-- dapp = 3 nm and dens_nuc = 1830 kg/m3
4364	IF ( zcsink < 1.0E-30_wp ) THEN
4365	zeta = 0._dp
4366	ELSE
4367	!-- Mean diameter of backgroud population (nm)
4368	zdmean = 1.0_wp / SUM( paero(:)%numc ) * SUM( paero(:)%numc * &
4369	paero(:)%dwet ) * 1.0E+9_wp
4370	!-- Proportionality factor (nm2*m2/h) (Eq. 22)
4371	zgamma = 0.23_wp * ( zdcrit * 1.0E+9_wp ) ** 0.2_wp * ( zdmean / &
4372	150.0_wp ) ** 0.048_wp * ( ptemp / 293.0_wp ) ** ( -0.75_wp ) &
4373	* ( arhoh2so4 / 1000.0_wp ) ** ( -0.33_wp )
4374	!-- Factor eta (nm) (Eq. 11)
4375	zeta = MIN( zgamma * zcsink / zGRclust, zdcrit * 1.0E11_wp )
4376	ENDIF
4377	!
4378	!-- Number conc. of clusters surviving to 3 nm in a time step (#/m3) (Eq.14)
4379	zj3 = zjnuc * EXP( MIN( 0.0_wp, zeta / 3.0_wp - zeta / &
4380	( zdcrit * 1.0E9_wp ) ) )
4381
4382	ELSEIF ( nj3 > 1 ) THEN
4383	!-- Defining the value for zm_para. The growth is investigated between
4384	!-- [d1,reglim(1)] = [zdcrit,3nm]
4385	!-- m = LOG( CoagS_dx / CoagX_zdcrit ) / LOG( reglim / zdcrit )
4386	!-- (Lehtinen et al. 2007, Eq. 5)
4387	!-- The steps for the coagulation sink for reglim = 3nm and zdcrit ~= 1nm are
4388	!-- explained in article of Kulmala et al. (2001). The particles of diameter
4389	!-- zdcrit ~1.14 nm and reglim = 3nm are both in turn the "number 1"
4390	!-- variables (Kulmala et al. 2001).
4391	!-- c = critical (1nm), x = 3nm, 2 = wet or mean droplet
4392	!-- Sum of the radii, R12 = R1 + zR2 (m) of two particles 1 and 2
4393	zRc2 = zdcrit / 2.0_wp + paero(:)%dwet / 2.0_wp
4394	zRx2 = reglim(1) / 2.0_wp + paero(:)%dwet / 2.0_wp
4395	!
4396	!-- The mass of particle (kg) (comes only from H2SO4)
4397	zm_c = 4.0_wp / 3.0_wp * pi * ( zdcrit / 2.0_wp ) ** 3.0_wp * arhoh2so4
4398	zm_x = 4.0_wp / 3.0_wp * pi * ( reglim(1) / 2.0_wp ) ** 3.0_wp * &
4399	arhoh2so4
4400	zm_2 = 4.0_wp / 3.0_wp * pi * ( paero(:)%dwet / 2.0_wp )** 3.0_wp * &
4401	arhoh2so4
4402	!
4403	!-- Mean relative thermal velocity between the particles (m/s)
4404	zcv_c = SQRT( 8.0_wp * abo * ptemp / ( pi * zm_c ) )
4405	zcv_x = SQRT( 8.0_wp * abo * ptemp / ( pi * zm_x ) )
4406	zcv_2 = SQRT( 8.0_wp * abo * ptemp / ( pi * zm_2 ) )
4407	!
4408	!-- Average velocity after coagulation
4409	zcv_c2 = SQRT( zcv_c 2.0_wp + zcv_2 2.0_wp )
4410	zcv_x2 = SQRT( zcv_x 2.0_wp + zcv_2 2.0_wp )
4411	!
4412	!-- Knudsen number (zmfp = mean free path of condensing vapour)
4413	zknud_c = 2.0_wp * zmfp / zdcrit
4414	zknud_x = 2.0_wp * zmfp / reglim(1)
4415	zknud_2 = MAX( 0.0_wp, 2.0_wp * zmfp / paero(:)%dwet )
4416	!
4417	!-- Cunningham correction factor
4418	zCc_c = 1.0_wp + zknud_c * ( 1.142_wp + 0.558_wp * &
4419	EXP( -0.999_wp / zknud_c ) )
4420	zCc_x = 1.0_wp + zknud_x * ( 1.142_wp + 0.558_wp * &
4421	EXP( -0.999_wp / zknud_x ) )
4422	zCc_2 = 1.0_wp + zknud_2 * ( 1.142_wp + 0.558_wp * &
4423	EXP( -0.999_wp / zknud_2 ) )
4424	!
4425	!-- Gas dynamic viscosity (N*s/m2).
4426	!-- Viscocity(air @20C) = 1.81e-5_dp N/m2 *s (Hinds, p. 25)
4427	zmyy = 1.81E-5_wp * ( ptemp / 293.0_wp) ** ( 0.74_wp )
4428	!
4429	!-- Particle diffusion coefficient (m2/s)
4430	zDc_c = abo * ptemp * zCc_c / ( 3.0_wp * pi * zmyy * zdcrit )
4431	zDc_x = abo * ptemp * zCc_x / ( 3.0_wp * pi * zmyy * reglim(1) )
4432	zDc_2 = abo * ptemp * zCc_2 / ( 3.0_wp * pi * zmyy * paero(:)%dwet )
4433	!
4434	!-- D12 = D1+D2 (Seinfield and Pandis, 2nd ed. Eq. 13.38)
4435	zDc_c2 = zDc_c + zDc_2
4436	zDc_x2 = zDc_x + zDc_2
4437	!
4438	!-- zgammaF = 8*D/pi/zcv (m) for calculating zomega
4439	zgammaF_c = 8.0_wp * zDc_c / pi / zcv_c
4440	zgammaF_x = 8.0_wp * zDc_x / pi / zcv_x
4441	zgammaF_2 = 8.0_wp * zDc_2 / pi / zcv_2
4442	!
4443	!-- zomega (m) for calculating zsigma
4444	zomega_c = ( ( zRc2 + zgammaF_c ) 3 - ( zRc2 2 + &
4445	zgammaF_c ) ** ( 3.0_wp / 2.0_wp ) ) / ( 3.0_wp * &
4446	zRc2 * zgammaF_c ) - zRc2
4447	zomega_x = ( ( zRx2 + zgammaF_x ) 3.0_wp - ( zRx2 2.0_wp + &
4448	zgammaF_x ) ** ( 3.0_wp / 2.0_wp ) ) / ( 3.0_wp * &
4449	zRx2 * zgammaF_x ) - zRx2
4450	zomega_2c = ( ( zRc2 + zgammaF_2 ) 3.0_wp - ( zRc2 2.0_wp + &
4451	zgammaF_2 ) ** ( 3.0_wp / 2.0_wp ) ) / ( 3.0_wp * &
4452	zRc2 * zgammaF_2 ) - zRc2
4453	zomega_2x = ( ( zRx2 + zgammaF_2 ) 3.0_wp - ( zRx2 2.0_wp + &
4454	zgammaF_2 ) ** ( 3.0_wp / 2.0_wp ) ) / ( 3.0_wp * &
4455	zRx2 * zgammaF_2 ) - zRx2
4456	!
4457	!-- The distance (m) at which the two fluxes are matched (condensation and
4458	!-- coagulation sinks?)
4459	zsigma_c2 = SQRT( zomega_c 2.0_wp + zomega_2c 2.0_wp )
4460	zsigma_x2 = SQRT( zomega_x 2.0_wp + zomega_2x 2.0_wp )
4461	!
4462	!-- Coagulation coefficient in the continuum regime (m*m2/s)
4463	zK_c2 = 4.0_wp * pi * zRc2 * zDc_c2 / ( zRc2 / ( zRc2 + zsigma_c2 ) + &
4464	4.0_wp * zDc_c2 / ( zcv_c2 * zRc2 ) )
4465	zK_x2 = 4.0_wp * pi * zRx2 * zDc_x2 / ( zRx2 / ( zRx2 + zsigma_x2 ) + &
4466	4.0_wp * zDc_x2 / ( zcv_x2 * zRx2 ) )
4467	!
4468	!-- Coagulation sink (1/s)
4469	zCoagS_c = MAX( 1.0E-20_wp, SUM( zK_c2 * paero(:)%numc ) )
4470	zCoagS_x = MAX( 1.0E-20_wp, SUM( zK_x2 * paero(:)%numc ) )
4471	!
4472	!-- Parameter m for calculating the coagulation sink onto background
4473	!-- particles (Eq. 5&6 in Lehtinen et al. 2007)
4474	zm_para = LOG( zCoagS_x / zCoagS_c ) / LOG( reglim(1) / zdcrit )
4475	!
4476	!-- Parameter gamma for calculating the formation rate J of particles having
4477	!-- a diameter zdcrit < d < reglim(1) (Anttila et al. 2010, eq. 5)
4478	zgamma = ( ( ( reglim(1) / zdcrit ) ** ( zm_para + 1.0_wp ) ) - 1.0_wp )&
4479	/ ( zm_para + 1.0_wp )
4480
4481	IF ( nj3 == 2 ) THEN ! Coagulation sink
4482	!
4483	!-- Formation rate J before iteration (#/m3s)
4484	zj3 = zjnuc * EXP( MIN( 0.0_wp, -zgamma * zdcrit * zCoagS_c / &
4485	( zGRclust * 1.0E-9_wp / ( 60.0_wp ** 2.0_wp ) ) ) )
4486
4487	ELSEIF ( nj3 == 3 ) THEN ! Coagulation sink and self-coag.
4488	!-- IF polluted air... then the self-coagulation becomes important.
4489	!-- Self-coagulation of small particles < 3 nm.
4490	!
4491	!-- "Effective" coagulation coefficient between freshly-nucleated
4492	!-- particles:
4493	zKeff = 5.0E-16_wp ! cm3/s
4494	!
4495	!-- zlambda parameter for "adjusting" the growth rate due to the
4496	!-- self-coagulation
4497	zlambda = 6.0_wp
4498	IF ( reglim(1) >= 10.0E-9_wp ) THEN ! for particles >10 nm:
4499	zKeff = 5.0E-17_wp
4500	zlambda = 3.0_wp
4501	ENDIF
4502	!
4503	!-- Initial values for coagulation sink and growth rate (m/s)
4504	zCoagStot = zCoagS_c
4505	zGRtot = zGRclust * 1.0E-9_wp / 60.0_wp ** 2.0_wp
4506	!
4507	!-- Number of clusters/particles at the size range [d1,dx] (#/m3):
4508	zNnuc = zjnuc / zCoagStot !< Initial guess
4509	!
4510	!-- Coagulation sink and growth rate due to self-coagulation:
4511	DO iteration = 1, 5
4512	zCoagStot = zCoagS_c + zKeff * zNnuc * 1.0E-6_wp ! (1/s)
4513	zGRtot = zGRclust * 1.0E-9_wp / ( 3600.0_wp ) + 1.5708E-6_wp * &
4514	zlambda * zdcrit ** 3.0_wp * ( zNnuc * 1.0E-6_wp ) * &
4515	zcv_c * avo * 1.0E-9_wp / 3600.0_wp
4516	zeta = - zCoagStot / ( ( zm_para + 1.0_wp ) * zGRtot * ( zdcrit **&
4517	zm_para ) ) ! Eq. 7b (Anttila)
4518	zNnuc = zNnuc_tayl( zdcrit, reglim(1), zm_para, zjnuc, zeta, &
4519	zGRtot )
4520	ENDDO
4521	!
4522	!-- Calculate the final values with new zNnuc:
4523	zCoagStot = zCoagS_c + zKeff * zNnuc * 1.0E-6_wp ! (1/s)
4524	zGRtot = zGRclust * 1.0E-9_wp / 3600.0_wp + 1.5708E-6_wp * zlambda &
4525	* zdcrit ** 3.0_wp * ( zNnuc * 1.0E-6_wp ) * zcv_c * avo * &
4526	1.0E-9_wp / 3600.0_wp !< (m/s)
4527	zj3 = zjnuc * EXP( MIN( 0.0_wp, -zgamma * zdcrit * zCoagStot / &
4528	zGRtot ) ) ! (Eq. 5a) (#/m3s)
4529
4530	ENDIF
4531
4532	ENDIF
4533	!-- If J3 very small (< 1 #/cm3), neglect particle formation. In real atmosphere
4534	!-- this would mean that clusters form but coagulate to pre-existing particles
4535	!-- who gain sulphate. Since CoagS ~ CS (4piDCS'), we do not* update H2SO4
4536	!-- concentration here but let condensation take care of it.
4537	!-- Formation mass rate of molecules (molec/m3s) for 1: H2SO4 and 2: organic
4538	!-- vapour
4539	pj3n3(1) = zj3 * n3 * pxsa
4540	pj3n3(2) = zj3 * n3 * pxocnv
4541
4542
4543	END SUBROUTINE nucleation
4544
4545	!------------------------------------------------------------------------------!
4546	! Description:
4547	! ------------
4548	!> Calculate the nucleation rate and the size of critical clusters assuming
4549	!> binary nucleation.
4550	!> Parametrisation according to Vehkamaki et al. (2002), J. Geophys. Res.,
4551	!> 107(D22), 4622. Called from subroutine nucleation.
4552	!------------------------------------------------------------------------------!
4553	SUBROUTINE binnucl( pc_sa, ptemp, prh, pnuc_rate, pn_crit_sa, pn_crit_ocnv, &
4554	pd_crit, pk_sa, pk_ocnv )
4555
4556	IMPLICIT NONE
4557	!
4558	!-- Input and output variables
4559	REAL(wp), INTENT(in) :: pc_sa !< H2SO4 conc. (#/cm3)
4560	REAL(wp), INTENT(in) :: prh !< relative humidity [0-1]
4561	REAL(wp), INTENT(in) :: ptemp !< ambient temperature (K)
4562	REAL(wp), INTENT(out) :: pnuc_rate !< nucleation rate (#/(m3 s))
4563	REAL(wp), INTENT(out) :: pn_crit_sa !< number of H2SO4 molecules in
4564	!< cluster (#)
4565	REAL(wp), INTENT(out) :: pn_crit_ocnv !< number of organic molecules in
4566	!< cluster (#)
4567	REAL(wp), INTENT(out) :: pd_crit !< diameter of critical cluster (m)
4568	REAL(wp), INTENT(out) :: pk_sa !< Lever: if pk_sa = 1, H2SO4 is
4569	!< involved in nucleation.
4570	REAL(wp), INTENT(out) :: pk_ocnv !< Lever: if pk_ocnv = 1, organic
4571	!< compounds are involved in
4572	!< nucleation.
4573	!-- Local variables
4574	REAL(wp) :: zx !< mole fraction of sulphate in critical cluster
4575	REAL(wp) :: zntot !< number of molecules in critical cluster
4576	REAL(wp) :: zt !< temperature
4577	REAL(wp) :: zpcsa !< sulfuric acid concentration
4578	REAL(wp) :: zrh !< relative humidity
4579	REAL(wp) :: zma !<
4580	REAL(wp) :: zmw !<
4581	REAL(wp) :: zxmass!<
4582	REAL(wp) :: za !<
4583	REAL(wp) :: zb !<
4584	REAL(wp) :: zc !<
4585	REAL(wp) :: zroo !<
4586	REAL(wp) :: zm1 !<
4587	REAL(wp) :: zm2 !<
4588	REAL(wp) :: zv1 !<
4589	REAL(wp) :: zv2 !<
4590	REAL(wp) :: zcoll !<
4591
4592	pnuc_rate = 0.0_wp
4593	pd_crit = 1.0E-9_wp
4594
4595	!
4596	!-- 1) Checking that we are in the validity range of the parameterization
4597	zt = MAX( ptemp, 190.15_wp )
4598	zt = MIN( zt, 300.15_wp )
4599	zpcsa = MAX( pc_sa, 1.0E4_wp )
4600	zpcsa = MIN( zpcsa, 1.0E11_wp )
4601	zrh = MAX( prh, 0.0001_wp )
4602	zrh = MIN( zrh, 1.0_wp )
4603	!
4604	!-- 2) Mole fraction of sulphate in a critical cluster (Eq. 11)
4605	zx = 0.7409967177282139_wp &
4606	- 0.002663785665140117_wp * zt &
4607	+ 0.002010478847383187_wp * LOG( zrh ) &
4608	- 0.0001832894131464668_wp* zt * LOG( zrh ) &
4609	+ 0.001574072538464286_wp * LOG( zrh ) ** 2 &
4610	- 0.00001790589121766952_wp * zt * LOG( zrh ) ** 2 &
4611	+ 0.0001844027436573778_wp * LOG( zrh ) ** 3 &
4612	- 1.503452308794887E-6_wp * zt * LOG( zrh ) ** 3 &
4613	- 0.003499978417957668_wp * LOG( zpcsa ) &
4614	+ 0.0000504021689382576_wp * zt * LOG( zpcsa )
4615	!
4616	!-- 3) Nucleation rate (Eq. 12)
4617	pnuc_rate = 0.1430901615568665_wp &
4618	+ 2.219563673425199_wp * zt &
4619	- 0.02739106114964264_wp * zt ** 2 &
4620	+ 0.00007228107239317088_wp * zt ** 3 &
4621	+ 5.91822263375044_wp / zx &
4622	+ 0.1174886643003278_wp * LOG( zrh ) &
4623	+ 0.4625315047693772_wp * zt * LOG( zrh ) &
4624	- 0.01180591129059253_wp * zt ** 2 * LOG( zrh ) &
4625	+ 0.0000404196487152575_wp * zt ** 3 * LOG( zrh ) &
4626	+ ( 15.79628615047088_wp * LOG( zrh ) ) / zx &
4627	- 0.215553951893509_wp * LOG( zrh ) ** 2 &
4628	- 0.0810269192332194_wp * zt * LOG( zrh ) ** 2 &
4629	+ 0.001435808434184642_wp * zt ** 2 * LOG( zrh ) ** 2 &
4630	- 4.775796947178588E-6_wp * zt ** 3 * LOG( zrh ) ** 2 &
4631	- (2.912974063702185_wp * LOG( zrh ) ** 2 ) / zx &
4632	- 3.588557942822751_wp * LOG( zrh ) ** 3 &
4633	+ 0.04950795302831703_wp * zt * LOG( zrh ) ** 3 &
4634	- 0.0002138195118737068_wp * zt ** 2 * LOG( zrh ) ** 3 &
4635	+ 3.108005107949533E-7_wp * zt ** 3 * LOG( zrh ) ** 3 &
4636	- ( 0.02933332747098296_wp * LOG( zrh ) ** 3 ) / zx &
4637	+ 1.145983818561277_wp * LOG( zpcsa ) &
4638	- 0.6007956227856778_wp * zt * LOG( zpcsa ) &
4639	+ 0.00864244733283759_wp * zt ** 2 * LOG( zpcsa ) &
4640	- 0.00002289467254710888_wp * zt ** 3 * LOG( zpcsa ) &
4641	- ( 8.44984513869014_wp * LOG( zpcsa ) ) / zx &
4642	+ 2.158548369286559_wp * LOG( zrh ) * LOG( zpcsa ) &
4643	+ 0.0808121412840917_wp * zt * LOG( zrh ) * LOG( zpcsa ) &
4644	- 0.0004073815255395214_wp * zt ** 2 * LOG( zrh ) * LOG( zpcsa ) &
4645	- 4.019572560156515E-7_wp * zt ** 3 * LOG( zrh ) * LOG( zpcsa ) &
4646	+ ( 0.7213255852557236_wp * LOG( zrh ) * LOG( zpcsa ) ) / zx &
4647	+ 1.62409850488771_wp * LOG( zrh ) ** 2 * LOG( zpcsa ) &
4648	- 0.01601062035325362_wp * zt * LOG( zrh ) ** 2 * LOG( zpcsa ) &
4649	+ 0.00003771238979714162_wpzt2 LOG( zrh )*2 LOG( zpcsa ) &
4650	+ 3.217942606371182E-8_wp * zt*3 LOG( zrh )*2 LOG( zpcsa ) &
4651	- (0.01132550810022116_wp * LOG( zrh )*2 LOG( zpcsa ) ) / zx &
4652	+ 9.71681713056504_wp * LOG( zpcsa ) ** 2 &
4653	- 0.1150478558347306_wp * zt * LOG( zpcsa ) ** 2 &
4654	+ 0.0001570982486038294_wp * zt ** 2 * LOG( zpcsa ) ** 2 &
4655	+ 4.009144680125015E-7_wp * zt ** 3 * LOG( zpcsa ) ** 2 &
4656	+ ( 0.7118597859976135_wp * LOG( zpcsa ) ** 2 ) / zx &
4657	- 1.056105824379897_wp * LOG( zrh ) * LOG( zpcsa ) ** 2 &
4658	+ 0.00903377584628419_wp * zt * LOG( zrh ) * LOG( zpcsa )**2 &
4659	- 0.00001984167387090606_wpzt2LOG( zrh )LOG( zpcsa )*2 &
4660	+ 2.460478196482179E-8_wp * zt*3 LOG( zrh ) * LOG( zpcsa )**2 &
4661	- ( 0.05790872906645181_wp * LOG( zrh ) * LOG( zpcsa )**2 ) / zx &
4662	- 0.1487119673397459_wp * LOG( zpcsa ) ** 3 &
4663	+ 0.002835082097822667_wp * zt * LOG( zpcsa ) ** 3 &
4664	- 9.24618825471694E-6_wp * zt ** 2 * LOG( zpcsa ) ** 3 &
4665	+ 5.004267665960894E-9_wp * zt ** 3 * LOG( zpcsa ) ** 3 &
4666	- ( 0.01270805101481648_wp * LOG( zpcsa ) ** 3 ) / zx
4667	!
4668	!-- Nucleation rate in #/(cm3 s)
4669	pnuc_rate = EXP( pnuc_rate )
4670	!
4671	!-- Check the validity of parameterization
4672	IF ( pnuc_rate < 1.0E-7_wp ) THEN
4673	pnuc_rate = 0.0_wp
4674	pd_crit = 1.0E-9_wp
4675	ENDIF
4676	!
4677	!-- 4) Total number of molecules in the critical cluster (Eq. 13)
4678	zntot = - 0.002954125078716302_wp &
4679	- 0.0976834264241286_wp * zt &
4680	+ 0.001024847927067835_wp * zt ** 2 &
4681	- 2.186459697726116E-6_wp * zt ** 3 &
4682	- 0.1017165718716887_wp / zx &
4683	- 0.002050640345231486_wp * LOG( zrh ) &
4684	- 0.007585041382707174_wp * zt * LOG( zrh ) &
4685	+ 0.0001926539658089536_wp * zt ** 2 * LOG( zrh ) &
4686	- 6.70429719683894E-7_wp * zt ** 3 * LOG( zrh ) &
4687	- ( 0.2557744774673163_wp * LOG( zrh ) ) / zx &
4688	+ 0.003223076552477191_wp * LOG( zrh ) ** 2 &
4689	+ 0.000852636632240633_wp * zt * LOG( zrh ) ** 2 &
4690	- 0.00001547571354871789_wp * zt ** 2 * LOG( zrh ) ** 2 &
4691	+ 5.666608424980593E-8_wp * zt ** 3 * LOG( zrh ) ** 2 &
4692	+ ( 0.03384437400744206_wp * LOG( zrh ) ** 2 ) / zx &
4693	+ 0.04743226764572505_wp * LOG( zrh ) ** 3 &
4694	- 0.0006251042204583412_wp * zt * LOG( zrh ) ** 3 &
4695	+ 2.650663328519478E-6_wp * zt ** 2 * LOG( zrh ) ** 3 &
4696	- 3.674710848763778E-9_wp * zt ** 3 * LOG( zrh ) ** 3 &
4697	- ( 0.0002672510825259393_wp * LOG( zrh ) ** 3 ) / zx &
4698	- 0.01252108546759328_wp * LOG( zpcsa ) &
4699	+ 0.005806550506277202_wp * zt * LOG( zpcsa ) &
4700	- 0.0001016735312443444_wp * zt ** 2 * LOG( zpcsa ) &
4701	+ 2.881946187214505E-7_wp * zt ** 3 * LOG( zpcsa ) &
4702	+ ( 0.0942243379396279_wp * LOG( zpcsa ) ) / zx &
4703	- 0.0385459592773097_wp * LOG( zrh ) * LOG( zpcsa ) &
4704	- 0.0006723156277391984_wp * zt * LOG( zrh ) * LOG( zpcsa ) &
4705	+ 2.602884877659698E-6_wp * zt ** 2 * LOG( zrh ) * LOG( zpcsa ) &
4706	+ 1.194163699688297E-8_wp * zt ** 3 * LOG( zrh ) * LOG( zpcsa ) &
4707	- ( 0.00851515345806281_wp * LOG( zrh ) * LOG( zpcsa ) ) / zx &
4708	- 0.01837488495738111_wp * LOG( zrh ) ** 2 * LOG( zpcsa ) &
4709	+ 0.0001720723574407498_wp * zt * LOG( zrh ) ** 2 * LOG( zpcsa ) &
4710	- 3.717657974086814E-7_wp * zt*2 LOG( zrh )*2 LOG( zpcsa ) &
4711	- 5.148746022615196E-10_wp * zt*3 LOG( zrh )*2 LOG( zpcsa ) &
4712	+ ( 0.0002686602132926594_wp * LOG(zrh)*2 LOG(zpcsa) ) / zx &
4713	- 0.06199739728812199_wp * LOG( zpcsa ) ** 2 &
4714	+ 0.000906958053583576_wp * zt * LOG( zpcsa ) ** 2 &
4715	- 9.11727926129757E-7_wp * zt ** 2 * LOG( zpcsa ) ** 2 &
4716	- 5.367963396508457E-9_wp * zt ** 3 * LOG( zpcsa ) ** 2 &
4717	- ( 0.007742343393937707_wp * LOG( zpcsa ) ** 2 ) / zx &
4718	+ 0.0121827103101659_wp * LOG( zrh ) * LOG( zpcsa ) ** 2 &
4719	- 0.0001066499571188091_wp * zt * LOG( zrh ) * LOG( zpcsa ) ** 2 &
4720	+ 2.534598655067518E-7_wp * zt*2 LOG( zrh ) * LOG( zpcsa )**2 &
4721	- 3.635186504599571E-10_wp * zt*3 LOG( zrh ) * LOG( zpcsa )**2 &
4722	+ ( 0.0006100650851863252_wp * LOG( zrh ) * LOG( zpcsa ) **2 )/ zx &
4723	+ 0.0003201836700403512_wp * LOG( zpcsa ) ** 3 &
4724	- 0.0000174761713262546_wp * zt * LOG( zpcsa ) ** 3 &
4725	+ 6.065037668052182E-8_wp * zt ** 2 * LOG( zpcsa ) ** 3 &
4726	- 1.421771723004557E-11_wp * zt ** 3 * LOG( zpcsa ) ** 3 &
4727	+ ( 0.0001357509859501723_wp * LOG( zpcsa ) ** 3 ) / zx
4728	zntot = EXP( zntot ) ! in #
4729	!
4730	!-- 5) Size of the critical cluster pd_crit (m) (diameter) (Eq. 14)
4731	pn_crit_sa = zx * zntot
4732	pd_crit = 2.0E-9_wp * EXP( -1.6524245_wp + 0.42316402_wp * zx + &
4733	0.33466487_wp * LOG( zntot ) )
4734	!
4735	!-- 6) Organic compounds not involved when binary nucleation is assumed
4736	pn_crit_ocnv = 0.0_wp ! number of organic molecules
4737	pk_sa = 1.0_wp ! if = 1, H2SO4 involved in nucleation
4738	pk_ocnv = 0.0_wp ! if = 1, organic compounds involved
4739	!
4740	!-- Set nucleation rate to collision rate
4741	IF ( pn_crit_sa < 4.0_wp ) THEN
4742	!
4743	!-- Volumes of the colliding objects
4744	zma = 96.0_wp ! molar mass of SO4 in g/mol
4745	zmw = 18.0_wp ! molar mass of water in g/mol
4746	zxmass = 1.0_wp ! mass fraction of H2SO4
4747	za = 0.7681724_wp + zxmass * ( 2.1847140_wp + zxmass * ( &
4748	7.1630022_wp + zxmass * ( -44.31447_wp + zxmass * ( &
4749	88.75606 + zxmass * ( -75.73729_wp + zxmass * &
4750	23.43228_wp ) ) ) ) )
4751	zb = 1.808225E-3_wp + zxmass * ( -9.294656E-3_wp + zxmass * &
4752	( -0.03742148_wp + zxmass * ( 0.2565321_wp + zxmass * &
4753	( -0.5362872_wp + zxmass * ( 0.4857736 - zxmass * &
4754	0.1629592_wp ) ) ) ) )
4755	zc = - 3.478524E-6_wp + zxmass * ( 1.335867E-5_wp + zxmass * &
4756	( 5.195706E-5_wp + zxmass * ( -3.717636E-4_wp + zxmass * &
4757	( 7.990811E-4_wp + zxmass * ( -7.458060E-4_wp + zxmass * &
4758	2.58139E-4_wp ) ) ) ) )
4759	!
4760	!-- Density for the sulphuric acid solution (Eq. 10 in Vehkamaki)
4761	zroo = za + zt * ( zb + zc * zt ) ! g/cm^3
4762	zroo = zroo * 1.0E+3_wp ! kg/m^3
4763	zm1 = 0.098_wp ! molar mass of H2SO4 in kg/mol
4764	zm2 = zm1
4765	zv1 = zm1 / avo / zroo ! volume
4766	zv2 = zv1
4767	!
4768	!-- Collision rate
4769	zcoll = zpcsa * zpcsa * ( 3.0_wp * pi / 4.0_wp ) ** ( 1.0_wp / 6.0_wp )&
4770	* SQRT( 6.0_wp * argas * zt / zm1 + 6.0_wp * argas * zt / zm2 )&
4771	* ( zv1 ( 1.0_wp / 3.0_wp ) + zv2 ( 1.0_wp /3.0_wp ) ) **&
4772	2.0_wp * 1.0E+6_wp ! m3 -> cm3
4773
4774	zcoll = MIN( zcoll, 1.0E+10_wp )
4775	pnuc_rate = zcoll ! (#/(cm3 s))
4776
4777	ELSE
4778	pnuc_rate = MIN( pnuc_rate, 1.0E+10_wp )
4779	ENDIF
4780	pnuc_rate = pnuc_rate * 1.0E+6_wp ! (#/(m3 s))
4781
4782	END SUBROUTINE binnucl
4783
4784	!------------------------------------------------------------------------------!
4785	! Description:
4786	! ------------
4787	!> Calculate the nucleation rate and the size of critical clusters assuming
4788	!> ternary nucleation. Parametrisation according to:
4789	!> Napari et al. (2002), J. Chem. Phys., 116, 4221-4227 and
4790	!> Napari et al. (2002), J. Geophys. Res., 107(D19), AAC 6-1-ACC 6-6.
4791	!> Called from subroutine nucleation.
4792	!------------------------------------------------------------------------------!
4793	SUBROUTINE ternucl( pc_sa, pc_nh3, ptemp, prh, pnuc_rate, pn_crit_sa, &
4794	pn_crit_ocnv, pd_crit, pk_sa, pk_ocnv )
4795
4796	IMPLICIT NONE
4797
4798	!-- Input and output variables
4799	REAL(wp), INTENT(in) :: pc_nh3 !< ammonia mixing ratio (ppt)
4800	REAL(wp), INTENT(in) :: pc_sa !< H2SO4 conc. (#/cm3)
4801	REAL(wp), INTENT(in) :: prh !< relative humidity [0-1]
4802	REAL(wp), INTENT(in) :: ptemp !< ambient temperature (K)
4803	REAL(wp), INTENT(out) :: pd_crit !< diameter of critical
4804	!< cluster (m)
4805	REAL(wp), INTENT(out) :: pk_ocnv !< Lever: if pk_ocnv = 1,organic compounds
4806	!< are involved in nucleation
4807	REAL(wp), INTENT(out) :: pk_sa !< Lever: if pk_sa = 1, H2SO4 is involved
4808	!< in nucleation
4809	REAL(wp), INTENT(out) :: pn_crit_ocnv !< number of organic molecules in
4810	!< cluster (#)
4811	REAL(wp), INTENT(out) :: pn_crit_sa !< number of H2SO4 molecules in
4812	!< cluster (#)
4813	REAL(wp), INTENT(out) :: pnuc_rate !< nucleation rate (#/(m3 s))
4814	!-- Local variables
4815	REAL(wp) :: zlnj !< logarithm of nucleation rate
4816
4817	!-- 1) Checking that we are in the validity range of the parameterization.
4818	!-- Validity of parameterization : DO NOT REMOVE!
4819	IF ( ptemp < 240.0_wp .OR. ptemp > 300.0_wp ) THEN
4820	message_string = 'Invalid input value: ptemp'
4821	CALL message( 'salsa_mod: ternucl', 'SA0045', 1, 2, 0, 6, 0 )
4822	ENDIF
4823	IF ( prh < 0.05_wp .OR. prh > 0.95_wp ) THEN
4824	message_string = 'Invalid input value: prh'
4825	CALL message( 'salsa_mod: ternucl', 'SA0046', 1, 2, 0, 6, 0 )
4826	ENDIF
4827	IF ( pc_sa < 1.0E+4_wp .OR. pc_sa > 1.0E+9_wp ) THEN
4828	message_string = 'Invalid input value: pc_sa'
4829	CALL message( 'salsa_mod: ternucl', 'SA0047', 1, 2, 0, 6, 0 )
4830	ENDIF
4831	IF ( pc_nh3 < 0.1_wp .OR. pc_nh3 > 100.0_wp ) THEN
4832	message_string = 'Invalid input value: pc_nh3'
4833	CALL message( 'salsa_mod: ternucl', 'SA0048', 1, 2, 0, 6, 0 )
4834	ENDIF
4835	!
4836	!-- 2) Nucleation rate (Eq. 7 in Napari et al., 2002: Parameterization of
4837	!-- ternary nucleation of sulfuric acid - ammonia - water.
4838	zlnj = - 84.7551114741543_wp &
4839	+ 0.3117595133628944_wp * prh &
4840	+ 1.640089605712946_wp * prh * ptemp &
4841	- 0.003438516933381083_wp * prh * ptemp ** 2.0_wp &
4842	- 0.00001097530402419113_wp * prh * ptemp ** 3.0_wp &
4843	- 0.3552967070274677_wp / LOG( pc_sa ) &
4844	- ( 0.06651397829765026_wp * prh ) / LOG( pc_sa ) &
4845	- ( 33.84493989762471_wp * ptemp ) / LOG( pc_sa ) &
4846	- ( 7.823815852128623_wp * prh * ptemp ) / LOG( pc_sa) &
4847	+ ( 0.3453602302090915_wp * ptemp ** 2.0_wp ) / LOG( pc_sa ) &
4848	+ ( 0.01229375748100015_wp * prh * ptemp ** 2.0_wp ) / LOG( pc_sa ) &
4849	- ( 0.000824007160514956_wp ptemp * 3.0_wp ) / LOG( pc_sa ) &
4850	+ ( 0.00006185539100670249_wp * prh * ptemp ** 3.0_wp ) &
4851	/ LOG( pc_sa ) &
4852	+ 3.137345238574998_wp * LOG( pc_sa ) &
4853	+ 3.680240980277051_wp * prh * LOG( pc_sa ) &
4854	- 0.7728606202085936_wp * ptemp * LOG( pc_sa ) &
4855	- 0.204098217156962_wp * prh * ptemp * LOG( pc_sa ) &
4856	+ 0.005612037586790018_wp * ptemp ** 2.0_wp * LOG( pc_sa ) &
4857	+ 0.001062588391907444_wp * prh * ptemp ** 2.0_wp * LOG( pc_sa ) &
4858	- 9.74575691760229E-6_wp * ptemp ** 3.0_wp * LOG( pc_sa ) &
4859	- 1.265595265137352E-6_wp * prh * ptemp ** 3.0_wp * LOG( pc_sa ) &
4860	+ 19.03593713032114_wp * LOG( pc_sa ) ** 2.0_wp &
4861	- 0.1709570721236754_wp * ptemp * LOG( pc_sa ) ** 2.0_wp &
4862	+ 0.000479808018162089_wp * ptemp ** 2.0_wp * LOG( pc_sa ) ** 2.0_wp&
4863	- 4.146989369117246E-7_wp * ptemp ** 3.0_wp * LOG( pc_sa ) ** 2.0_wp&
4864	+ 1.076046750412183_wp * LOG( pc_nh3 ) &
4865	+ 0.6587399318567337_wp * prh * LOG( pc_nh3 ) &
4866	+ 1.48932164750748_wp * ptemp * LOG( pc_nh3 ) &
4867	+ 0.1905424394695381_wp * prh * ptemp * LOG( pc_nh3 ) &
4868	- 0.007960522921316015_wp * ptemp ** 2.0_wp * LOG( pc_nh3 ) &
4869	- 0.001657184248661241_wp * prh * ptemp ** 2.0_wp * LOG( pc_nh3 ) &
4870	+ 7.612287245047392E-6_wp * ptemp ** 3.0_wp * LOG( pc_nh3 ) &
4871	+ 3.417436525881869E-6_wp * prh * ptemp ** 3.0_wp * LOG( pc_nh3 ) &
4872	+ ( 0.1655358260404061_wp * LOG( pc_nh3 ) ) / LOG( pc_sa) &
4873	+ ( 0.05301667612522116_wp * prh * LOG( pc_nh3 ) ) / LOG( pc_sa ) &
4874	+ ( 3.26622914116752_wp * ptemp * LOG( pc_nh3 ) ) / LOG( pc_sa ) &
4875	- ( 1.988145079742164_wp * prh * ptemp * LOG( pc_nh3 ) ) &
4876	/ LOG( pc_sa ) &
4877	- ( 0.04897027401984064_wp * ptemp ** 2.0_wp * LOG( pc_nh3) ) &
4878	/ LOG( pc_sa ) &
4879	+ ( 0.01578269253599732_wp * prh * ptemp ** 2.0_wp * LOG( pc_nh3 ) &
4880	) / LOG( pc_sa ) &
4881	+ ( 0.0001469672236351303_wp * ptemp ** 3.0_wp * LOG( pc_nh3 ) ) &
4882	/ LOG( pc_sa ) &
4883	- ( 0.00002935642836387197_wp * prh * ptemp ** 3.0_wp *LOG( pc_nh3 )&
4884	) / LOG( pc_sa ) &
4885	+ 6.526451177887659_wp * LOG( pc_sa ) * LOG( pc_nh3 ) &
4886	- 0.2580021816722099_wp * ptemp * LOG( pc_sa ) * LOG( pc_nh3 ) &
4887	+ 0.001434563104474292_wp * ptemp ** 2.0_wp * LOG( pc_sa ) &
4888	* LOG( pc_nh3 ) &
4889	- 2.020361939304473E-6_wp * ptemp ** 3.0_wp * LOG( pc_sa ) &
4890	* LOG( pc_nh3 ) &
4891	- 0.160335824596627_wp * LOG( pc_sa ) ** 2.0_wp * LOG( pc_nh3 ) &
4892	+ 0.00889880721460806_wp * ptemp * LOG( pc_sa ) ** 2.0_wp &
4893	* LOG( pc_nh3 ) &
4894	- 0.00005395139051155007_wp * ptemp ** 2.0_wp &
4895	* LOG( pc_sa) ** 2.0_wp * LOG( pc_nh3 ) &
4896	+ 8.39521718689596E-8_wp * ptemp ** 3.0_wp * LOG( pc_sa ) ** 2.0_wp&
4897	* LOG( pc_nh3 ) &
4898	+ 6.091597586754857_wp * LOG( pc_nh3 ) ** 2.0_wp &
4899	+ 8.5786763679309_wp * prh * LOG( pc_nh3 ) ** 2.0_wp &
4900	- 1.253783854872055_wp * ptemp * LOG( pc_nh3 ) ** 2.0_wp &
4901	- 0.1123577232346848_wp * prh * ptemp * LOG( pc_nh3 ) ** 2.0_wp &
4902	+ 0.00939835595219825_wp * ptemp ** 2.0_wp * LOG( pc_nh3 ) ** 2.0_wp&
4903	+ 0.0004726256283031513_wp * prh * ptemp ** 2.0_wp &
4904	* LOG( pc_nh3) ** 2.0_wp &
4905	- 0.00001749269360523252_wp * ptemp ** 3.0_wp &
4906	* LOG( pc_nh3 ) ** 2.0_wp &
4907	- 6.483647863710339E-7_wp * prh * ptemp ** 3.0_wp &
4908	* LOG( pc_nh3 ) ** 2.0_wp &
4909	+ ( 0.7284285726576598_wp * LOG( pc_nh3 ) ** 2.0_wp ) / LOG( pc_sa )&
4910	+ ( 3.647355600846383_wp * ptemp * LOG( pc_nh3 ) ** 2.0_wp ) &
4911	/ LOG( pc_sa ) &
4912	- ( 0.02742195276078021_wp * ptemp ** 2.0_wp &
4913	* LOG( pc_nh3) ** 2.0_wp ) / LOG( pc_sa ) &
4914	+ ( 0.00004934777934047135_wp * ptemp ** 3.0_wp &
4915	* LOG( pc_nh3 ) ** 2.0_wp ) / LOG( pc_sa ) &
4916	+ 41.30162491567873_wp * LOG( pc_sa ) * LOG( pc_nh3 ) ** 2.0_wp &
4917	- 0.357520416800604_wp * ptemp * LOG( pc_sa ) &
4918	* LOG( pc_nh3 ) ** 2.0_wp &
4919	+ 0.000904383005178356_wp * ptemp ** 2.0_wp * LOG( pc_sa ) &
4920	* LOG( pc_nh3 ) ** 2.0_wp &
4921	- 5.737876676408978E-7_wp * ptemp ** 3.0_wp * LOG( pc_sa ) &
4922	* LOG( pc_nh3 ) ** 2.0_wp &
4923	- 2.327363918851818_wp * LOG( pc_sa ) ** 2.0_wp &
4924	* LOG( pc_nh3 ) ** 2.0_wp &
4925	+ 0.02346464261919324_wp * ptemp * LOG( pc_sa ) ** 2.0_wp &
4926	* LOG( pc_nh3 ) ** 2.0_wp &
4927	- 0.000076518969516405_wp * ptemp ** 2.0_wp &
4928	* LOG( pc_sa ) ** 2.0_wp * LOG( pc_nh3 ) ** 2.0_wp &
4929	+ 8.04589834836395E-8_wp * ptemp ** 3.0_wp * LOG( pc_sa ) ** 2.0_wp &
4930	* LOG( pc_nh3 ) ** 2.0_wp &
4931	- 0.02007379204248076_wp * LOG( prh ) &
4932	- 0.7521152446208771_wp * ptemp * LOG( prh ) &
4933	+ 0.005258130151226247_wp * ptemp ** 2.0_wp * LOG( prh ) &
4934	- 8.98037634284419E-6_wp * ptemp ** 3.0_wp * LOG( prh ) &
4935	+ ( 0.05993213079516759_wp * LOG( prh ) ) / LOG( pc_sa ) &
4936	+ ( 5.964746463184173_wp * ptemp * LOG( prh ) ) / LOG( pc_sa ) &
4937	- ( 0.03624322255690942_wp * ptemp ** 2.0_wp * LOG( prh ) ) &
4938	/ LOG( pc_sa ) &
4939	+ ( 0.00004933369382462509_wp * ptemp ** 3.0_wp * LOG( prh ) ) &
4940	/ LOG( pc_sa ) &
4941	- 0.7327310805365114_wp * LOG( pc_nh3 ) * LOG( prh ) &
4942	- 0.01841792282958795_wp * ptemp * LOG( pc_nh3 ) * LOG( prh ) &
4943	+ 0.0001471855981005184_wp * ptemp ** 2.0_wp * LOG( pc_nh3 ) &
4944	* LOG( prh ) &
4945	- 2.377113195631848E-7_wp * ptemp ** 3.0_wp * LOG( pc_nh3 ) &
4946	* LOG( prh )
4947	pnuc_rate = EXP( zlnj ) ! (#/(cm3 s))
4948	!
4949	!-- Check validity of parametrization
4950	IF ( pnuc_rate < 1.0E-5_wp ) THEN
4951	pnuc_rate = 0.0_wp
4952	pd_crit = 1.0E-9_wp
4953	ELSEIF ( pnuc_rate > 1.0E6_wp ) THEN
4954	message_string = 'Invalid output value: nucleation rate > 10^6 1/cm3s'
4955	CALL message( 'salsa_mod: ternucl', 'SA0049', 1, 2, 0, 6, 0 )
4956	ENDIF
4957	pnuc_rate = pnuc_rate * 1.0E6_wp ! (#/(m3 s))
4958	!
4959	!-- 3) Number of H2SO4 molecules in a critical cluster (Eq. 9)
4960	pn_crit_sa = 38.16448247950508_wp + 0.7741058259731187_wp * zlnj + &
4961	0.002988789927230632_wp * zlnj ** 2.0_wp - &
4962	0.3576046920535017_wp * ptemp - &
4963	0.003663583011953248_wp * zlnj * ptemp + &
4964	0.000855300153372776_wp * ptemp ** 2.0_wp
4965	!-- Kinetic limit: at least 2 H2SO4 molecules in a cluster
4966	pn_crit_sa = MAX( pn_crit_sa, 2.0E0_wp )
4967	!
4968	!-- 4) Size of the critical cluster in nm (Eq. 12)
4969	pd_crit = 0.1410271086638381_wp - 0.001226253898894878_wp * zlnj - &
4970	7.822111731550752E-6_wp * zlnj ** 2.0_wp - &
4971	0.001567273351921166_wp * ptemp - &
4972	0.00003075996088273962_wp * zlnj * ptemp + &
4973	0.00001083754117202233_wp * ptemp ** 2.0_wp
4974	pd_crit = pd_crit * 2.0E-9_wp ! Diameter in m
4975	!
4976	!-- 5) Organic compounds not involved when ternary nucleation assumed
4977	pn_crit_ocnv = 0.0_wp
4978	pk_sa = 1.0_wp
4979	pk_ocnv = 0.0_wp
4980
4981	END SUBROUTINE ternucl
4982
4983	!------------------------------------------------------------------------------!
4984	! Description:
4985	! ------------
4986	!> Calculate the nucleation rate and the size of critical clusters assuming
4987	!> kinetic nucleation. Each sulphuric acid molecule forms an (NH4)HSO4 molecule
4988	!> in the atmosphere and two colliding (NH4)HSO4 molecules form a stable
4989	!> cluster. See Sihto et al. (2006), Atmos. Chem. Phys., 6(12), 4079-4091.
4990	!>
4991	!> Below the following assumption have been made:
4992	!> nucrate = coagcoeffzpcsa*2
4993	!> coagcoeff = 8sqrt(3boltzptempr_abs/dens_abs)
4994	!> r_abs = 0.315d-9 radius of bisulphate molecule [m]
4995	!> dens_abs = 1465 density of - " - [kg/m3]
4996	!------------------------------------------------------------------------------!
4997	SUBROUTINE kinnucl( pc_sa, pnuc_rate, pd_crit, pn_crit_sa, pn_crit_ocnv, &
4998	pk_sa, pk_ocnv )
4999
5000	IMPLICIT NONE
5001
5002	!-- Input and output variables
5003	REAL(wp), INTENT(in) :: pc_sa !< H2SO4 conc. (#/m3)
5004	REAL(wp), INTENT(out) :: pd_crit !< critical diameter of clusters (m)
5005	REAL(wp), INTENT(out) :: pk_ocnv !< Lever: if pk_ocnv = 1, organic
5006	!< compounds are involved in nucleation
5007	REAL(wp), INTENT(out) :: pk_sa !< Lever: if pk_sa = 1, H2SO4 is involved
5008	!< in nucleation
5009	REAL(wp), INTENT(out) :: pn_crit_ocnv !< number of organic molecules in
5010	!< cluster (#)
5011	REAL(wp), INTENT(out) :: pn_crit_sa !< number of H2SO4 molecules in
5012	!< cluster (#)
5013	REAL(wp), INTENT(out) :: pnuc_rate !< nucl. rate (#/(m3 s))
5014
5015	!-- Nucleation rate (#/(m3 s))
5016	pnuc_rate = 5.0E-13_wp * pc_sa ** 2.0_wp * 1.0E+6_wp
5017	!-- Organic compounds not involved when kinetic nucleation is assumed.
5018	pn_crit_sa = 2.0_wp
5019	pn_crit_ocnv = 0.0_wp
5020	pk_sa = 1.0_wp
5021	pk_ocnv = 0.0_wp
5022	pd_crit = 7.9375E-10_wp ! (m)
5023
5024	END SUBROUTINE kinnucl
5025	!------------------------------------------------------------------------------!
5026	! Description:
5027	! ------------
5028	!> Calculate the nucleation rate and the size of critical clusters assuming
5029	!> activation type nucleation.
5030	!> See Riipinen et al. (2007), Atmos. Chem. Phys., 7(8), 1899-1914.
5031	!------------------------------------------------------------------------------!
5032	SUBROUTINE actnucl( psa_conc, pnuc_rate, pd_crit, pn_crit_sa, pn_crit_ocnv, &
5033	pk_sa, pk_ocnv, activ )
5034
5035	IMPLICIT NONE
5036
5037	!-- Input and output variables
5038	REAL(wp), INTENT(in) :: psa_conc !< H2SO4 conc. (#/m3)
5039	REAL(wp), INTENT(in) :: activ !<
5040	REAL(wp), INTENT(out) :: pd_crit !< critical diameter of clusters (m)
5041	REAL(wp), INTENT(out) :: pk_ocnv !< Lever: if pk_ocnv = 1, organic
5042	!< compounds are involved in nucleation
5043	REAL(wp), INTENT(out) :: pk_sa !< Lever: if pk_sa = 1, H2SO4 is involved
5044	!< in nucleation
5045	REAL(wp), INTENT(out) :: pn_crit_ocnv !< number of organic molecules in
5046	!< cluster (#)
5047	REAL(wp), INTENT(out) :: pn_crit_sa !< number of H2SO4 molecules in
5048	!< cluster (#)
5049	REAL(wp), INTENT(out) :: pnuc_rate !< nucl. rate (#/(m3 s))
5050
5051	!-- act_coeff 1e-7 by default
5052	pnuc_rate = activ * psa_conc ! (#/(m3 s))
5053	!-- Organic compounds not involved when kinetic nucleation is assumed.
5054	pn_crit_sa = 2.0_wp
5055	pn_crit_ocnv = 0.0_wp
5056	pk_sa = 1.0_wp
5057	pk_ocnv = 0.0_wp
5058	pd_crit = 7.9375E-10_wp ! (m)
5059	END SUBROUTINE actnucl
5060	!------------------------------------------------------------------------------!
5061	! Description:
5062	! ------------
5063	!> Conciders only the organic matter in nucleation. Paasonen et al. (2010)
5064	!> determined particle formation rates for 2 nm particles, J2, from different
5065	!> kind of combinations of sulphuric acid and organic matter concentration.
5066	!> See Paasonen et al. (2010), Atmos. Chem. Phys., 10, 11223-11242.
5067	!------------------------------------------------------------------------------!
5068	SUBROUTINE orgnucl( pc_org, pnuc_rate, pd_crit, pn_crit_sa, pn_crit_ocnv, &
5069	pk_sa, pk_ocnv )
5070
5071	IMPLICIT NONE
5072
5073	!-- Input and output variables
5074	REAL(wp), INTENT(in) :: pc_org !< organic vapour concentration (#/m3)
5075	REAL(wp), INTENT(out) :: pd_crit !< critical diameter of clusters (m)
5076	REAL(wp), INTENT(out) :: pk_ocnv !< Lever: if pk_ocnv = 1, organic
5077	!< compounds are involved in nucleation
5078	REAL(wp), INTENT(out) :: pk_sa !< Lever: if pk_sa = 1, H2SO4 is involved
5079	!< in nucleation
5080	REAL(wp), INTENT(out) :: pn_crit_ocnv !< number of organic molecules in
5081	!< cluster (#)
5082	REAL(wp), INTENT(out) :: pn_crit_sa !< number of H2SO4 molecules in
5083	!< cluster (#)
5084	REAL(wp), INTENT(out) :: pnuc_rate !< nucl. rate (#/(m3 s))
5085	!-- Local variables
5086	REAL(wp) :: Aorg = 1.3E-7_wp !< (1/s) (Paasonen et al. Table 4: median)
5087
5088	!-- Homomolecular nuleation - which one?
5089	pnuc_rate = Aorg * pc_org
5090	!-- H2SO4 not involved when pure organic nucleation is assumed.
5091	pn_crit_sa = 0.0_wp
5092	pn_crit_ocnv = 1.0_wp
5093	pk_sa = 0.0_wp
5094	pk_ocnv = 1.0_wp
5095	pd_crit = 1.5E-9_wp ! (m)
5096
5097	END SUBROUTINE orgnucl
5098	!------------------------------------------------------------------------------!
5099	! Description:
5100	! ------------
5101	!> Conciders both the organic vapor and H2SO4 in nucleation - activation type
5102	!> of nucleation.
5103	!> See Paasonen et al. (2010), Atmos. Chem. Phys., 10, 11223-11242.
5104	!------------------------------------------------------------------------------!
5105	SUBROUTINE sumnucl( pc_sa, pc_org, pnuc_rate, pd_crit, pn_crit_sa, &
5106	pn_crit_ocnv, pk_sa, pk_ocnv )
5107
5108	IMPLICIT NONE
5109
5110	!-- Input and output variables
5111	REAL(wp), INTENT(in) :: pc_org !< organic vapour concentration (#/m3)
5112	REAL(wp), INTENT(in) :: pc_sa !< H2SO4 conc. (#/m3)
5113	REAL(wp), INTENT(out) :: pd_crit !< critical diameter of clusters (m)
5114	REAL(wp), INTENT(out) :: pk_ocnv !< Lever: if pk_ocnv = 1, organic
5115	!< compounds are involved in nucleation
5116	REAL(wp), INTENT(out) :: pk_sa !< Lever: if pk_sa = 1, H2SO4 is involved
5117	!< in nucleation
5118	REAL(wp), INTENT(out) :: pn_crit_ocnv !< number of organic molecules in
5119	!< cluster (#)
5120	REAL(wp), INTENT(out) :: pn_crit_sa !< number of H2SO4 molecules in
5121	!< cluster (#)
5122	REAL(wp), INTENT(out) :: pnuc_rate !< nucl. rate (#/(m3 s))
5123	!-- Local variables
5124	REAL(wp) :: As1 = 6.1E-7_wp !< (1/s)
5125	REAL(wp) :: As2 = 0.39E-7_wp !< (1/s) (Paasonen et al. Table 3.)
5126
5127	!-- Nucleation rate (#/m3/s)
5128	pnuc_rate = As1 * pc_sa + As2 * pc_org
5129	!-- Both Organic compounds and H2SO4 are involved when SUMnucleation is assumed.
5130	pn_crit_sa = 1.0_wp
5131	pn_crit_ocnv = 1.0_wp
5132	pk_sa = 1.0_wp
5133	pk_ocnv = 1.0_wp
5134	pd_crit = 1.5E-9_wp ! (m)
5135
5136	END SUBROUTINE sumnucl
5137	!------------------------------------------------------------------------------!
5138	! Description:
5139	! ------------
5140	!> Conciders both the organic vapor and H2SO4 in nucleation - heteromolecular
5141	!> nucleation.
5142	!> See Paasonen et al. (2010), Atmos. Chem. Phys., 10, 11223-11242.
5143	!------------------------------------------------------------------------------!
5144	SUBROUTINE hetnucl( pc_sa, pc_org, pnuc_rate, pd_crit, pn_crit_sa, &
5145	pn_crit_ocnv, pk_sa, pk_ocnv )
5146
5147	IMPLICIT NONE
5148
5149	!-- Input and output variables
5150	REAL(wp), INTENT(in) :: pc_org !< organic vapour concentration (#/m3)
5151	REAL(wp), INTENT(in) :: pc_sa !< H2SO4 conc. (#/m3)
5152	REAL(wp), INTENT(out) :: pd_crit !< critical diameter of clusters (m)
5153	REAL(wp), INTENT(out) :: pk_ocnv !< Lever: if pk_ocnv = 1, organic
5154	!< compounds are involved in nucleation
5155	REAL(wp), INTENT(out) :: pk_sa !< Lever: if pk_sa = 1, H2SO4 is involved
5156	!< in nucleation
5157	REAL(wp), INTENT(out) :: pn_crit_ocnv !< number of organic molecules in
5158	!< cluster (#)
5159	REAL(wp), INTENT(out) :: pn_crit_sa !< number of H2SO4 molecules in
5160	!< cluster (#)
5161	REAL(wp), INTENT(out) :: pnuc_rate !< nucl. rate (#/(m3 s))
5162	!-- Local variables
5163	REAL(wp) :: zKhet = 4.1E-14_wp !< (cm3/s) (Paasonen et al. Table 4: median)
5164
5165	!-- Nucleation rate (#/m3/s)
5166	pnuc_rate = zKhet * pc_sa * pc_org * 1.0E6_wp
5167	!-- Both Organic compounds and H2SO4 are involved when heteromolecular
5168	!-- nucleation is assumed.
5169	pn_crit_sa = 1.0_wp
5170	pn_crit_ocnv = 1.0_wp
5171	pk_sa = 1.0_wp
5172	pk_ocnv = 1.0_wp
5173	pd_crit = 1.5E-9_wp ! (m)
5174
5175	END SUBROUTINE hetnucl
5176	!------------------------------------------------------------------------------!
5177	! Description:
5178	! ------------
5179	!> Takes into account the homomolecular nucleation of sulphuric acid H2SO4 with
5180	!> both of the available vapours.
5181	!> See Paasonen et al. (2010), Atmos. Chem. Phys., 10, 11223-11242.
5182	!------------------------------------------------------------------------------!
5183	SUBROUTINE SAnucl( pc_sa, pc_org, pnuc_rate, pd_crit, pn_crit_sa, &
5184	pn_crit_ocnv, pk_sa, pk_ocnv )
5185
5186	IMPLICIT NONE
5187
5188	!-- Input and output variables
5189	REAL(wp), INTENT(in) :: pc_org !< organic vapour concentration (#/m3)
5190	REAL(wp), INTENT(in) :: pc_sa !< H2SO4 conc. (#/m3)
5191	REAL(wp), INTENT(out) :: pd_crit !< critical diameter of clusters (m)
5192	REAL(wp), INTENT(out) :: pk_ocnv !< Lever: if pk_ocnv = 1, organic
5193	!< compounds are involved in nucleation
5194	REAL(wp), INTENT(out) :: pk_sa !< Lever: if pk_sa = 1, H2SO4 is involved
5195	!< in nucleation
5196	REAL(wp), INTENT(out) :: pn_crit_ocnv !< number of organic molecules in
5197	!< cluster (#)
5198	REAL(wp), INTENT(out) :: pn_crit_sa !< number of H2SO4 molecules in
5199	!< cluster (#)
5200	REAL(wp), INTENT(out) :: pnuc_rate !< nucleation rate (#/(m3 s))
5201	!-- Local variables
5202	REAL(wp) :: zKsa1 = 1.1E-14_wp !< (cm3/s)
5203	REAL(wp) :: zKsa2 = 3.2E-14_wp !< (cm3/s) (Paasonen et al. Table 3.)
5204
5205	!-- Nucleation rate (#/m3/s)
5206	pnuc_rate = ( zKsa1 * pc_sa ** 2.0_wp + zKsa2 * pc_sa * pc_org ) * 1.0E+6_wp
5207	!-- Both Organic compounds and H2SO4 are involved when SAnucleation is assumed.
5208	pn_crit_sa = 3.0_wp
5209	pn_crit_ocnv = 1.0_wp
5210	pk_sa = 1.0_wp
5211	pk_ocnv = 1.0_wp
5212	pd_crit = 1.5E-9_wp ! (m)
5213
5214	END SUBROUTINE SAnucl
5215	!------------------------------------------------------------------------------!
5216	! Description:
5217	! ------------
5218	!> Takes into account the homomolecular nucleation of both sulphuric acid and
5219	!> Lorganic with heteromolecular nucleation.
5220	!> See Paasonen et al. (2010), Atmos. Chem. Phys., 10, 11223-11242.
5221	!------------------------------------------------------------------------------!
5222	SUBROUTINE SAORGnucl( pc_sa, pc_org, pnuc_rate, pd_crit, pn_crit_sa, &
5223	pn_crit_ocnv, pk_sa, pk_ocnv )
5224
5225	IMPLICIT NONE
5226
5227	!-- Input and output variables
5228	REAL(wp), INTENT(in) :: pc_org !< organic vapour concentration (#/m3)
5229	REAL(wp), INTENT(in) :: pc_sa !< H2SO4 conc. (#/m3)
5230	REAL(wp), INTENT(out) :: pd_crit !< critical diameter of clusters (m)
5231	REAL(wp), INTENT(out) :: pk_ocnv !< Lever: if pk_ocnv = 1, organic
5232	!< compounds are involved in nucleation
5233	REAL(wp), INTENT(out) :: pk_sa !< Lever: if pk_sa = 1, H2SO4 is involved
5234	!< in nucleation
5235	REAL(wp), INTENT(out) :: pn_crit_ocnv !< number of organic molecules in
5236	!< cluster (#)
5237	REAL(wp), INTENT(out) :: pn_crit_sa !< number of H2SO4 molecules in
5238	!< cluster (#)
5239	REAL(wp), INTENT(out) :: pnuc_rate !< nucl. rate (#/(m3 s))
5240	!-- Local variables
5241	REAL(wp) :: zKs1 = 1.4E-14_wp !< (cm3/s])
5242	REAL(wp) :: zKs2 = 2.6E-14_wp !< (cm3/s])
5243	REAL(wp) :: zKs3 = 0.037E-14_wp !< (cm3/s]) (Paasonen et al. Table 3.)
5244
5245	!-- Nucleation rate (#/m3/s)
5246	pnuc_rate = ( zKs1 * pc_sa *2 + zKs2 pc_sa * pc_org + zKs3 * &
5247	pc_org ** 2.0_wp ) * 1.0E+6_wp
5248	!-- Organic compounds not involved when kinetic nucleation is assumed.
5249	pn_crit_sa = 3.0_wp
5250	pn_crit_ocnv = 3.0_wp
5251	pk_sa = 1.0_wp
5252	pk_ocnv = 1.0_wp
5253	pd_crit = 1.5E-9_wp ! (m)
5254
5255	END SUBROUTINE SAORGnucl
5256
5257	!------------------------------------------------------------------------------!
5258	! Description:
5259	! ------------
5260	!> Function zNnuc_tayl is connected to the calculation of self-coagualtion of
5261	!> small particles. It calculates number of the particles in the size range
5262	!> [zdcrit,dx] using Taylor-expansion (please note that the expansion is not
5263	!> valid for certain rational numbers, e.g. -4/3 and -3/2)
5264	!------------------------------------------------------------------------------!
5265	FUNCTION zNnuc_tayl( d1, dx, zm_para, zjnuc_t, zeta, zGRtot )
5266	IMPLICIT NONE
5267
5268	INTEGER(iwp) :: i
5269	REAL(wp) :: d1
5270	REAL(wp) :: dx
5271	REAL(wp) :: zjnuc_t
5272	REAL(wp) :: zeta
5273	REAL(wp) :: term1
5274	REAL(wp) :: term2
5275	REAL(wp) :: term3
5276	REAL(wp) :: term4
5277	REAL(wp) :: term5
5278	REAL(wp) :: zNnuc_tayl
5279	REAL(wp) :: zGRtot
5280	REAL(wp) :: zm_para
5281
5282	zNnuc_tayl = 0.0_wp
5283
5284	DO i = 0, 29
5285	IF ( i == 0 .OR. i == 1 ) THEN
5286	term1 = 1.0_wp
5287	ELSE
5288	term1 = term1 * REAL( i, SELECTED_REAL_KIND(12,307) )
5289	END IF
5290	term2 = ( REAL( i, SELECTED_REAL_KIND(12,307) ) * ( zm_para + 1.0_wp &
5291	) + 1.0_wp ) * term1
5292	term3 = zeta ** i
5293	term4 = term3 / term2
5294	term5 = REAL( i, SELECTED_REAL_KIND(12,307) ) * ( zm_para + 1.0_wp ) &
5295	+ 1.0_wp
5296	zNnuc_tayl = zNnuc_tayl + term4 * ( dx term5 - d1 term5 )
5297	ENDDO
5298	zNnuc_tayl = zNnuc_tayl * zjnuc_t * EXP( -zeta * &
5299	( d1 ** ( zm_para + 1 ) ) ) / zGRtot
5300
5301	END FUNCTION zNnuc_tayl
5302
5303	!------------------------------------------------------------------------------!
5304	! Description:
5305	! ------------
5306	!> Calculates the condensation of water vapour on aerosol particles. Follows the
5307	!> analytical predictor method by Jacobson (2005).
5308	!> For equations, see Jacobson (2005), Fundamentals of atmospheric modelling
5309	!> (2nd edition).
5310	!------------------------------------------------------------------------------!
5311	SUBROUTINE gpparth2o( paero, ptemp, ppres, pcs, pcw, ptstep )
5312
5313	IMPLICIT NONE
5314	!
5315	!-- Input and output variables
5316	REAL(wp), INTENT(in) :: ppres !< Air pressure (Pa)
5317	REAL(wp), INTENT(in) :: pcs !< Water vapour saturation
5318	!< concentration (kg/m3)
5319	REAL(wp), INTENT(in) :: ptemp !< Ambient temperature (K)
5320	REAL(wp), INTENT(in) :: ptstep !< timestep (s)
5321	REAL(wp), INTENT(inout) :: pcw !< Water vapour concentration
5322	!< (kg/m3)
5323	TYPE(t_section), INTENT(inout) :: paero(nbins) !< Aerosol properties
5324	!-- Local variables
5325	INTEGER(iwp) :: b !< loop index
5326	INTEGER(iwp) :: nstr
5327	REAL(wp) :: adt !< internal timestep in this subroutine
5328	REAL(wp) :: adtc(nbins)
5329	REAL(wp) :: rhoair
5330	REAL(wp) :: ttot
5331	REAL(wp) :: zact !< Water activity
5332	REAL(wp) :: zaelwc1 !< Current aerosol water content
5333	REAL(wp) :: zaelwc2 !< New aerosol water content after
5334	!< equilibrium calculation
5335	REAL(wp) :: zbeta !< Transitional correction factor
5336	REAL(wp) :: zcwc !< Current water vapour mole concentration
5337	REAL(wp) :: zcwcae(nbins) !< Current water mole concentrations
5338	!< in aerosols
5339	REAL(wp) :: zcwint !< Current and new water vapour mole concentrations
5340	REAL(wp) :: zcwintae(nbins) !< Current and new water mole concentrations
5341	!< in aerosols
5342	REAL(wp) :: zcwn !< New water vapour mole concentration
5343	REAL(wp) :: zcwnae(nbins) !< New water mole concentration in aerosols
5344	REAL(wp) :: zcwsurfae(nbins) !< Surface mole concentration
5345	REAL(wp) :: zcwtot !< Total water mole concentration
5346	REAL(wp) :: zdfh2o
5347	REAL(wp) :: zhlp1
5348	REAL(wp) :: zhlp2
5349	REAL(wp) :: zhlp3
5350	REAL(wp) :: zka(nbins) !< Activity coefficient
5351	REAL(wp) :: zkelvin(nbins) !< Kelvin effect
5352	REAL(wp) :: zknud
5353	REAL(wp) :: zmfph2o !< mean free path of H2O gas molecule
5354	REAL(wp) :: zmtae(nbins) !< Mass transfer coefficients
5355	REAL(wp) :: zrh !< Relative humidity [0-1]
5356	REAL(wp) :: zthcond
5357	REAL(wp) :: zwsatae(nbins) !< Water saturation ratio above aerosols
5358	!
5359	!-- Relative humidity [0-1]
5360	zrh = pcw / pcs
5361	!-- Calculate the condensation only for 2a/2b aerosol bins
5362	nstr = in2a
5363	!-- Save the current aerosol water content, 8 in paero is H2O
5364	zaelwc1 = SUM( paero(in1a:fn2b)%volc(8) ) * arhoh2o
5365	!
5366	!-- Equilibration:
5367	IF ( advect_particle_water ) THEN
5368	IF ( zrh < 0.98_wp .OR. .NOT. lscndh2oae ) THEN
5369	CALL equilibration( zrh, ptemp, paero, .TRUE. )
5370	ELSE
5371	CALL equilibration( zrh, ptemp, paero, .FALSE. )
5372	ENDIF
5373	ENDIF
5374	!
5375	!-- The new aerosol water content after equilibrium calculation
5376	zaelwc2 = SUM( paero(in1a:fn2b)%volc(8) ) * arhoh2o
5377	!-- New water vapour mixing ratio (kg/m3)
5378	pcw = pcw - ( zaelwc2 - zaelwc1 ) * ppres * amdair / ( argas * ptemp )
5379	!
5380	!-- Initialise variables
5381	adtc(:) = 0.0_wp
5382	zcwc = 0.0_wp
5383	zcwcae = 0.0_wp
5384	zcwint = 0.0_wp
5385	zcwintae = 0.0_wp
5386	zcwn = 0.0_wp
5387	zcwnae = 0.0_wp
5388	zhlp1 = 0.0_wp
5389	zwsatae = 0.0_wp
5390	!
5391	!-- Air:
5392	!-- Density (kg/m3)
5393	rhoair = amdair * ppres / ( argas * ptemp )
5394	!-- Thermal conductivity of air
5395	zthcond = 0.023807_wp + 7.1128E-5_wp * ( ptemp - 273.16_wp )
5396	!
5397	!-- Water vapour:
5398	!
5399	!-- Molecular diffusion coefficient (cm2/s) (eq.16.17)
5400	zdfh2o = ( 5.0_wp / ( 16.0_wp * avo * rhoair * 1.0E-3_wp * &
5401	( 3.11E-8_wp ) ** 2.0_wp ) ) * SQRT( argas * 1.0E+7_wp * ptemp * &
5402	amdair * 1.0E+3_wp * ( amh2o + amdair ) * 1.0E+3_wp / ( 2.0_wp * &
5403	pi * amh2o * 1.0E+3_wp ) )
5404	zdfh2o = zdfh2o * 1.0E-4 ! Unit change to m^2/s
5405	!
5406	!-- Mean free path (eq. 15.25 & 16.29)
5407	zmfph2o = 3.0_wp * zdfh2o * SQRT( pi * amh2o / ( 8.0_wp * argas * ptemp ) )
5408	zka = 1.0_wp ! Assume activity coefficients as 1 for now.
5409	!
5410	!-- Kelvin effect (eq. 16.33)
5411	zkelvin = 1.0_wp
5412	zkelvin(1:nbins) = EXP( 4.0_wp * surfw0 * amh2o / ( argas * ptemp * &
5413	arhoh2o * paero(1:nbins)%dwet) )
5414	!
5415	! --Aerosols:
5416	zmtae(:) = 0.0_wp ! mass transfer coefficient
5417	zcwsurfae(:) = 0.0_wp ! surface mole concentrations
5418	DO b = 1, nbins
5419	IF ( paero(b)%numc > nclim .AND. zrh > 0.98_wp ) THEN
5420	!
5421	!-- Water activity
5422	zact = acth2o( paero(b) )
5423	!
5424	!-- Saturation mole concentration over flat surface. Limit the super-
5425	!-- saturation to max 1.01 for the mass transfer. Experimental!
5426	zcwsurfae(b) = MAX( pcs, pcw / 1.01_wp ) * rhoair / amh2o
5427	!
5428	!-- Equilibrium saturation ratio
5429	zwsatae(b) = zact * zkelvin(b)
5430	!
5431	!-- Knudsen number (eq. 16.20)
5432	zknud = 2.0_wp * zmfph2o / paero(b)%dwet
5433	!
5434	!-- Transitional correction factor (Fuks & Sutugin, 1971)
5435	zbeta = ( zknud + 1.0_wp ) / ( 0.377_wp * zknud + 1.0_wp + 4.0_wp / &
5436	( 3.0_wp * massacc(b) ) * ( zknud + zknud ** 2.0_wp ) )
5437	!
5438	!-- Mass transfer of H2O: Eq. 16.64 but here D^eff = zdfh2o * zbeta
5439	zhlp1 = paero(b)%numc * 2.0_wp * pi * paero(b)%dwet * zdfh2o * &
5440	zbeta
5441	!-- 1st term on the left side of the denominator in eq. 16.55
5442	zhlp2 = amh2o * zdfh2o * alv * zwsatae(b) * zcwsurfae(b) / &
5443	( zthcond * ptemp )
5444	!-- 2nd term on the left side of the denominator in eq. 16.55
5445	zhlp3 = ( (alv * amh2o ) / ( argas * ptemp ) ) - 1.0_wp
5446	!-- Full eq. 16.64: Mass transfer coefficient (1/s)
5447	zmtae(b) = zhlp1 / ( zhlp2 * zhlp3 + 1.0_wp )
5448	ENDIF
5449	ENDDO
5450	!
5451	!-- Current mole concentrations of water
5452	zcwc = pcw * rhoair / amh2o ! as vapour
5453	zcwcae(1:nbins) = paero(1:nbins)%volc(8) * arhoh2o / amh2o ! in aerosols
5454	zcwtot = zcwc + SUM( zcwcae ) ! total water concentration
5455	ttot = 0.0_wp
5456	adtc = 0.0_wp
5457	zcwintae = zcwcae
5458	!
5459	!-- Substepping loop
5460	zcwint = 0.0_wp
5461	DO WHILE ( ttot < ptstep )
5462	adt = 2.0E-2_wp ! internal timestep
5463	!
5464	!-- New vapour concentration: (eq. 16.71)
5465	zhlp1 = zcwc + adt * ( SUM( zmtae(nstr:nbins) * zwsatae(nstr:nbins) * &
5466	zcwsurfae(nstr:nbins) ) ) ! numerator
5467	zhlp2 = 1.0_wp + adt * ( SUM( zmtae(nstr:nbins) ) ) ! denomin.
5468	zcwint = zhlp1 / zhlp2 ! new vapour concentration
5469	zcwint = MIN( zcwint, zcwtot )
5470	IF ( ANY( paero(:)%numc > nclim ) .AND. zrh > 0.98_wp ) THEN
5471	DO b = nstr, nbins
5472	zcwintae(b) = zcwcae(b) + MIN( MAX( adt * zmtae(b) * &
5473	( zcwint - zwsatae(b) * zcwsurfae(b) ), &
5474	-0.02_wp * zcwcae(b) ), 0.05_wp * zcwcae(b) )
5475	zwsatae(b) = acth2o( paero(b), zcwintae(b) ) * zkelvin(b)
5476	ENDDO
5477	ENDIF
5478	zcwintae(nstr:nbins) = MAX( zcwintae(nstr:nbins), 0.0_wp )
5479	!
5480	!-- Update vapour concentration for consistency
5481	zcwint = zcwtot - SUM( zcwintae(1:nbins) )
5482	!-- Update "old" values for next cycle
5483	zcwcae = zcwintae
5484
5485	ttot = ttot + adt
5486	ENDDO ! ADT
5487	zcwn = zcwint
5488	zcwnae = zcwintae
5489	pcw = zcwn * amh2o / rhoair
5490	paero(1:nbins)%volc(8) = MAX( 0.0_wp, zcwnae(1:nbins) * amh2o / arhoh2o )
5491
5492	END SUBROUTINE gpparth2o
5493
5494	!------------------------------------------------------------------------------!
5495	! Description:
5496	! ------------
5497	!> Calculates the activity coefficient of liquid water
5498	!------------------------------------------------------------------------------!
5499	REAL(wp) FUNCTION acth2o( ppart, pcw )
5500
5501	IMPLICIT NONE
5502
5503	TYPE(t_section), INTENT(in) :: ppart !< Aerosol properties of a bin
5504	REAL(wp), INTENT(in), OPTIONAL :: pcw !< molar concentration of water
5505	!< (mol/m3)
5506
5507	REAL(wp) :: zns !< molar concentration of solutes (mol/m3)
5508	REAL(wp) :: znw !< molar concentration of water (mol/m3)
5509
5510	zns = ( 3.0_wp * ( ppart%volc(1) * arhoh2so4 / amh2so4 ) + &
5511	( ppart%volc(2) * arhooc / amoc ) + &
5512	2.0_wp * ( ppart%volc(5) * arhoss / amss ) + &
5513	( ppart%volc(6) * arhohno3 / amhno3 ) + &
5514	( ppart%volc(7) * arhonh3 / amnh3 ) )
5515	IF ( PRESENT(pcw) ) THEN
5516	znw = pcw
5517	ELSE
5518	znw = ppart%volc(8) * arhoh2o / amh2o
5519	ENDIF
5520	!-- Activity = partial pressure of water vapour /
5521	!-- sat. vapour pressure of water over a bulk liquid surface
5522	!-- = molality * activity coefficient (Jacobson, 2005: eq. 17.20-21)
5523	!-- Assume activity coefficient of 1 for water
5524	acth2o = MAX( 0.1_wp, znw / MAX( EPSILON( 1.0_wp ),( znw + zns ) ) )
5525	END FUNCTION acth2o
5526
5527	!------------------------------------------------------------------------------!
5528	! Description:
5529	! ------------
5530	!> Calculates the dissolutional growth of particles (i.e. gas transfers to a
5531	!> particle surface and dissolves in liquid water on the surface). Treated here
5532	!> as a non-equilibrium (time-dependent) process. Gases: HNO3 and NH3
5533	!> (Chapter 17.14 in Jacobson, 2005).
5534	!
5535	!> Called from subroutine condensation.
5536	!> Coded by:
5537	!> Harri Kokkola (FMI)
5538	!------------------------------------------------------------------------------!
5539	SUBROUTINE gpparthno3( ppres, ptemp, paero, pghno3, pgnh3, pcw, pcs, pbeta, &
5540	ptstep )
5541
5542	IMPLICIT NONE
5543	!
5544	!-- Input and output variables
5545	REAL(wp), INTENT(in) :: pbeta(nbins) !< transitional correction factor for
5546	!< aerosols
5547	REAL(wp), INTENT(in) :: ppres !< ambient pressure (Pa)
5548	REAL(wp), INTENT(in) :: pcs !< water vapour saturation
5549	!< concentration (kg/m3)
5550	REAL(wp), INTENT(in) :: ptemp !< ambient temperature (K)
5551	REAL(wp), INTENT(in) :: ptstep !< time step (s)
5552	REAL(wp), INTENT(inout) :: pghno3 !< nitric acid concentration (#/m3)
5553	REAL(wp), INTENT(inout) :: pgnh3 !< ammonia conc. (#/m3)
5554	REAL(wp), INTENT(inout) :: pcw !< water vapour concentration (kg/m3)
5555	TYPE(t_section), INTENT(inout) :: paero(nbins) !< Aerosol properties
5556	!
5557	!-- Local variables
5558	INTEGER(iwp) :: b !< loop index
5559	REAL(wp) :: adt !< timestep
5560	REAL(wp) :: zachhso4ae(nbins) !< Activity coefficients for HHSO4
5561	REAL(wp) :: zacnh3ae(nbins) !< Activity coefficients for NH3
5562	REAL(wp) :: zacnh4hso2ae(nbins)!< Activity coefficients for NH4HSO2
5563	REAL(wp) :: zacno3ae(nbins) !< Activity coefficients for HNO3
5564	REAL(wp) :: zcgnh3eqae(nbins) !< Equilibrium gas concentration: NH3
5565	REAL(wp) :: zcgno3eqae(nbins) !< Equilibrium gas concentration: HNO3
5566	REAL(wp) :: zcgwaeqae(nbins) !< Equilibrium gas concentration: H2O
5567	REAL(wp) :: zcnh3c !< Current NH3 gas concentration
5568	REAL(wp) :: zcnh3int !< Intermediate NH3 gas concentration
5569	REAL(wp) :: zcnh3intae(nbins) !< Intermediate NH3 aerosol concentration
5570	REAL(wp) :: zcnh3n !< New NH3 gas concentration
5571	REAL(wp) :: zcnh3cae(nbins) !< Current NH3 in aerosols
5572	REAL(wp) :: zcnh3nae(nbins) !< New NH3 in aerosols
5573	REAL(wp) :: zcnh3tot !< Total NH3 concentration
5574	REAL(wp) :: zcno3c !< Current HNO3 gas concentration
5575	REAL(wp) :: zcno3int !< Intermediate HNO3 gas concentration
5576	REAL(wp) :: zcno3intae(nbins) !< Intermediate HNO3 aerosol concentration
5577	REAL(wp) :: zcno3n !< New HNO3 gas concentration
5578	REAL(wp) :: zcno3cae(nbins) !< Current HNO3 in aerosols
5579	REAL(wp) :: zcno3nae(nbins) !< New HNO3 in aerosols
5580	REAL(wp) :: zcno3tot !< Total HNO3 concentration
5581	REAL(wp) :: zdfvap !< Diffusion coefficient for vapors
5582	REAL(wp) :: zhlp1 !< helping variable
5583	REAL(wp) :: zhlp2 !< helping variable
5584	REAL(wp) :: zkelnh3ae(nbins) !< Kelvin effects for NH3
5585	REAL(wp) :: zkelno3ae(nbins) !< Kelvin effect for HNO3
5586	REAL(wp) :: zmolsae(nbins,7) !< Ion molalities from pdfite
5587	REAL(wp) :: zmtnh3ae(nbins) !< Mass transfer coefficients for NH3
5588	REAL(wp) :: zmtno3ae(nbins) !< Mass transfer coefficients for HNO3
5589	REAL(wp) :: zrh !< relative humidity
5590	REAL(wp) :: zsathno3ae(nbins) !< HNO3 saturation ratio
5591	REAL(wp) :: zsatnh3ae(nbins) !< NH3 saturation ratio = the partial
5592	!< pressure of a gas divided by its
5593	!< saturation vapor pressure over a surface
5594	!
5595	!-- Initialise:
5596	adt = ptstep
5597	zachhso4ae = 0.0_wp
5598	zacnh3ae = 0.0_wp
5599	zacnh4hso2ae = 0.0_wp
5600	zacno3ae = 0.0_wp
5601	zcgnh3eqae = 0.0_wp
5602	zcgno3eqae = 0.0_wp
5603	zcnh3c = 0.0_wp
5604	zcnh3cae = 0.0_wp
5605	zcnh3int = 0.0_wp
5606	zcnh3intae = 0.0_wp
5607	zcnh3n = 0.0_wp
5608	zcnh3nae = 0.0_wp
5609	zcnh3tot = 0.0_wp
5610	zcno3c = 0.0_wp
5611	zcno3cae = 0.0_wp
5612	zcno3int = 0.0_wp
5613	zcno3intae = 0.0_wp
5614	zcno3n = 0.0_wp
5615	zcno3nae = 0.0_wp
5616	zcno3tot = 0.0_wp
5617	zhlp1 = 0.0_wp
5618	zhlp2 = 0.0_wp
5619	zkelno3ae = 1.0_wp
5620	zkelnh3ae = 1.0_wp
5621	zmolsae = 0.0_wp
5622	zmtno3ae = 0.0_wp
5623	zmtnh3ae = 0.0_wp
5624	zrh = 0.0_wp
5625	zsatnh3ae = 1.0_wp
5626	zsathno3ae = 1.0_wp
5627	!
5628	!-- Diffusion coefficient (m2/s)
5629	zdfvap = 5.1111E-10_wp * ptemp ** 1.75_wp * ( p_0 + 1325.0_wp ) / ppres
5630	!
5631	!-- Kelvin effects (Jacobson (2005), eq. 16.33)
5632	zkelno3ae(1:nbins) = EXP( 4.0_wp * surfw0 * amvhno3 / ( abo * ptemp * &
5633	paero(1:nbins)%dwet ) )
5634	zkelnh3ae(1:nbins) = EXP( 4.0_wp * surfw0 * amvnh3 / ( abo * ptemp * &
5635	paero(1:nbins)%dwet ) )
5636	!
5637	!-- Current vapour mole concentrations (mol/m3)
5638	zcno3c = pghno3 / avo ! HNO3
5639	zcnh3c = pgnh3 / avo ! NH3
5640	!
5641	!-- Current particle mole concentrations (mol/m3)
5642	zcno3cae(1:nbins) = paero(1:nbins)%volc(6) * arhohno3 / amhno3
5643	zcnh3cae(1:nbins) = paero(1:nbins)%volc(7) * arhonh3 / amnh3
5644	!
5645	!-- Total mole concentrations: gas and particle phase
5646	zcno3tot = zcno3c + SUM( zcno3cae(1:nbins) )
5647	zcnh3tot = zcnh3c + SUM( zcnh3cae(1:nbins) )
5648	!
5649	!-- Relative humidity [0-1]
5650	zrh = pcw / pcs
5651	!
5652	!-- Mass transfer coefficients (Jacobson, Eq. 16.64)
5653	zmtno3ae(1:nbins) = 2.0_wp * pi * paero(1:nbins)%dwet * zdfvap * &
5654	paero(1:nbins)%numc * pbeta(1:nbins)
5655	zmtnh3ae(1:nbins) = 2.0_wp * pi * paero(1:nbins)%dwet * zdfvap * &
5656	paero(1:nbins)%numc * pbeta(1:nbins)
5657
5658	!
5659	!-- Get the equilibrium concentrations above aerosols
5660	CALL NONHEquil( zrh, ptemp, paero, zcgno3eqae, zcgnh3eqae, zacno3ae, &
5661	zacnh3ae, zacnh4hso2ae, zachhso4ae, zmolsae )
5662
5663	!
5664	!-- NH4/HNO3 saturation ratios for aerosols
5665	CALL SVsat( ptemp, paero, zacno3ae, zacnh3ae, zacnh4hso2ae, zachhso4ae, &
5666	zcgno3eqae, zcno3cae, zcnh3cae, zkelno3ae, zkelnh3ae, &
5667	zsathno3ae, zsatnh3ae, zmolsae )
5668	!
5669	!-- Intermediate concentrations
5670	zhlp1 = SUM( zcno3cae(1:nbins) / ( 1.0_wp + adt * zmtno3ae(1:nbins) * &
5671	zsathno3ae(1:nbins) ) )
5672	zhlp2 = SUM( zmtno3ae(1:nbins) / ( 1.0_wp + adt * zmtno3ae(1:nbins) * &
5673	zsathno3ae(1:nbins) ) )
5674	zcno3int = ( zcno3tot - zhlp1 ) / ( 1.0_wp + adt * zhlp2 )
5675
5676	zhlp1 = SUM( zcnh3cae(1:nbins) / ( 1.0_wp + adt * zmtnh3ae(1:nbins) * &
5677	zsatnh3ae(1:nbins) ) )
5678	zhlp2 = SUM( zmtnh3ae(1:nbins) / ( 1.0_wp + adt * zmtnh3ae(1:nbins) * &
5679	zsatnh3ae(1:nbins) ) )
5680	zcnh3int = ( zcnh3tot - zhlp1 )/( 1.0_wp + adt * zhlp2 )
5681
5682	zcno3int = MIN(zcno3int, zcno3tot)
5683	zcnh3int = MIN(zcnh3int, zcnh3tot)
5684	!
5685	!-- Calculate the new particle concentrations
5686	zcno3intae = zcno3cae
5687	zcnh3intae = zcnh3cae
5688	DO b = 1, nbins
5689	zcno3intae(b) = ( zcno3cae(b) + adt * zmtno3ae(b) * zcno3int ) / &
5690	( 1.0_wp + adt * zmtno3ae(b) * zsathno3ae(b) )
5691	zcnh3intae(b) = ( zcnh3cae(b) + adt * zmtnh3ae(b) * zcnh3int ) / &
5692	( 1.0_wp + adt * zmtnh3ae(b) * zsatnh3ae(b) )
5693	ENDDO
5694
5695	zcno3intae(1:nbins) = MAX( zcno3intae(1:nbins), 0.0_wp )
5696	zcnh3intae(1:nbins) = MAX( zcnh3intae(1:nbins), 0.0_wp )
5697
5698	zcno3n = zcno3int ! Final molar gas concentration of HNO3
5699	zcno3nae = zcno3intae ! Final molar particle concentration of HNO3
5700
5701	zcnh3n = zcnh3int ! Final molar gas concentration of NH3
5702	zcnh3nae = zcnh3intae ! Final molar particle concentration of NH3
5703	!
5704	!-- Model timestep reached - update the new arrays
5705	pghno3 = zcno3n * avo
5706	pgnh3 = zcnh3n * avo
5707
5708	DO b = in1a, fn2b
5709	paero(b)%volc(6) = zcno3nae(b) * amhno3 / arhohno3
5710	paero(b)%volc(7) = zcnh3nae(b) * amnh3 / arhonh3
5711	ENDDO
5712
5713
5714	END SUBROUTINE gpparthno3
5715	!------------------------------------------------------------------------------!
5716	! Description:
5717	! ------------
5718	!> Calculate the equilibrium concentrations above aerosols (reference?)
5719	!------------------------------------------------------------------------------!
5720	SUBROUTINE NONHEquil( prh, ptemp, ppart, pcgno3eq, pcgnh3eq, pgammano, &
5721	pgammanh, pgammanh4hso2, pgammahhso4, pmols )
5722
5723	IMPLICIT NONE
5724
5725	REAL(wp), INTENT(in) :: prh !< relative humidity
5726	REAL(wp), INTENT(in) :: ptemp !< ambient temperature (K)
5727
5728	TYPE(t_section), INTENT(inout) :: ppart(nbins) !< Aerosol properties
5729	!-- Equilibrium molar concentration above aerosols:
5730	REAL(wp), INTENT(inout) :: pcgnh3eq(nbins) !< of NH3
5731	REAL(wp), INTENT(inout) :: pcgno3eq(nbins) !< of HNO3
5732	!< Activity coefficients:
5733	REAL(wp), INTENT(inout) :: pgammahhso4(nbins) !< HHSO4
5734	REAL(wp), INTENT(inout) :: pgammanh(nbins) !< NH3
5735	REAL(wp), INTENT(inout) :: pgammanh4hso2(nbins) !< NH4HSO2
5736	REAL(wp), INTENT(inout) :: pgammano(nbins) !< HNO3
5737	REAL(wp), INTENT(inout) :: pmols(nbins,7) !< Ion molalities
5738
5739	INTEGER(iwp) :: b
5740
5741	REAL(wp) :: zgammas(7) !< Activity coefficients
5742	REAL(wp) :: zhlp !< Dummy variable
5743	REAL(wp) :: zions(7) !< molar concentration of ion (mol/m3)
5744	REAL(wp) :: zphcl !< Equilibrium vapor pressures (Pa??)
5745	REAL(wp) :: zphno3 !< Equilibrium vapor pressures (Pa??)
5746	REAL(wp) :: zpnh3 !< Equilibrium vapor pressures (Pa??)
5747	REAL(wp) :: zwatertotal !< Total water in particles (mol/m3) ???
5748
5749	zgammas = 0.0_wp
5750	zhlp = 0.0_wp
5751	zions = 0.0_wp
5752	zphcl = 0.0_wp
5753	zphno3 = 0.0_wp
5754	zpnh3 = 0.0_wp
5755	zwatertotal = 0.0_wp
5756
5757	DO b = 1, nbins
5758
5759	IF ( ppart(b)%numc < nclim ) CYCLE
5760	!
5761	!-- 2*H2SO4 + CL + NO3 - Na - NH4
5762	zhlp = 2.0_wp * ppart(b)%volc(1) * arhoh2so4 / amh2so4 + &
5763	ppart(b)%volc(5) * arhoss / amss + &
5764	ppart(b)%volc(6) * arhohno3 / amhno3 - &
5765	ppart(b)%volc(5) * arhoss / amss - &
5766	ppart(b)%volc(7) * arhonh3 / amnh3
5767
5768	zhlp = MAX( zhlp, 1.0E-30_wp )
5769
5770	zions(1) = zhlp ! H+
5771	zions(2) = ppart(b)%volc(7) * arhonh3 / amnh3 ! NH4+
5772	zions(3) = ppart(b)%volc(5) * arhoss / amss ! Na+
5773	zions(4) = ppart(b)%volc(1) * arhoh2so4 / amh2so4 ! SO4(2-)
5774	zions(5) = 0.0_wp ! HSO4-
5775	zions(6) = ppart(b)%volc(6) * arhohno3 / amhno3 ! NO3-
5776	zions(7) = ppart(b)%volc(5) * arhoss / amss ! Cl-
5777
5778	zwatertotal = ppart(b)%volc(8) * arhoh2o / amh2o
5779	IF ( zwatertotal > 1.0E-30_wp ) THEN
5780	CALL inorganic_pdfite( prh, ptemp, zions, zwatertotal, zphno3, zphcl,&
5781	zpnh3, zgammas, pmols(b,:) )
5782	ENDIF
5783	!
5784	!-- Activity coefficients
5785	pgammano(b) = zgammas(1) ! HNO3
5786	pgammanh(b) = zgammas(3) ! NH3
5787	pgammanh4hso2(b) = zgammas(6) ! NH4HSO2
5788	pgammahhso4(b) = zgammas(7) ! HHSO4
5789	!
5790	!-- Equilibrium molar concentrations (mol/m3) from equlibrium pressures (Pa)
5791	pcgno3eq(b) = zphno3 / ( argas * ptemp )
5792	pcgnh3eq(b) = zpnh3 / ( argas * ptemp )
5793
5794	ENDDO
5795
5796	END SUBROUTINE NONHEquil
5797
5798	!------------------------------------------------------------------------------!
5799	! Description:
5800	! ------------
5801	!> Calculate saturation ratios of NH4 and HNO3 for aerosols
5802	!------------------------------------------------------------------------------!
5803	SUBROUTINE SVsat( ptemp, ppart, pachno3, pacnh3, pacnh4hso2, pachhso4, &
5804	pchno3eq, pchno3, pcnh3, pkelhno3, pkelnh3, psathno3, &
5805	psatnh3, pmols )
5806
5807	IMPLICIT NONE
5808
5809	REAL(wp), INTENT(in) :: ptemp !< ambient temperature (K)
5810
5811	TYPE(t_section), INTENT(inout) :: ppart(nbins) !< Aerosol properties
5812	!-- Activity coefficients
5813	REAL(wp), INTENT(in) :: pachhso4(nbins) !<
5814	REAL(wp), INTENT(in) :: pacnh3(nbins) !<
5815	REAL(wp), INTENT(in) :: pacnh4hso2(nbins) !<
5816	REAL(wp), INTENT(in) :: pachno3(nbins) !<
5817	REAL(wp), INTENT(in) :: pchno3eq(nbins) !< Equilibrium surface concentration
5818	!< of HNO3
5819	REAL(wp), INTENT(in) :: pchno3(nbins) !< Current particle mole
5820	!< concentration of HNO3 (mol/m3)
5821	REAL(wp), INTENT(in) :: pcnh3(nbins) !< Current particle mole
5822	!< concentration of NH3 (mol/m3)
5823	REAL(wp), INTENT(in) :: pkelhno3(nbins) !< Kelvin effect for HNO3
5824	REAL(wp), INTENT(in) :: pkelnh3(nbins) !< Kelvin effect for NH3
5825	REAL(wp), INTENT(in) :: pmols(nbins,7)
5826	!-- Saturation ratios
5827	REAL(wp), INTENT(out) :: psathno3(nbins) !<
5828	REAL(wp), INTENT(out) :: psatnh3(nbins) !<
5829
5830	INTEGER :: b !< running index for aerosol bins
5831	!-- Constants for calculating equilibrium constants:
5832	REAL(wp), PARAMETER :: a1 = -22.52_wp !<
5833	REAL(wp), PARAMETER :: a2 = -1.50_wp !<
5834	REAL(wp), PARAMETER :: a3 = 13.79_wp !<
5835	REAL(wp), PARAMETER :: a4 = 29.17_wp !<
5836	REAL(wp), PARAMETER :: b1 = 26.92_wp !<
5837	REAL(wp), PARAMETER :: b2 = 26.92_wp !<
5838	REAL(wp), PARAMETER :: b3 = -5.39_wp !<
5839	REAL(wp), PARAMETER :: b4 = 16.84_wp !<
5840	REAL(wp), PARAMETER :: K01 = 1.01E-14_wp !<
5841	REAL(wp), PARAMETER :: K02 = 1.81E-5_wp !<
5842	REAL(wp), PARAMETER :: K03 = 57.64_wp !<
5843	REAL(wp), PARAMETER :: K04 = 2.51E+6_wp !<
5844	!-- Equilibrium constants of equilibrium reactions
5845	REAL(wp) :: KllH2O !< H2O(aq) <--> H+ + OH- (mol/kg)
5846	REAL(wp) :: KllNH3 !< NH3(aq) + H2O(aq) <--> NH4+ + OH- (mol/kg)
5847	REAL(wp) :: KglNH3 !< NH3(g) <--> NH3(aq) (mol/kg/atm)
5848	REAL(wp) :: KglHNO3 !< HNO3(g) <--> H+ + NO3- (mol2/kg2/atm)
5849	REAL(wp) :: zmolno3 !< molality of NO3- (mol/kg)
5850	REAL(wp) :: zmolhp !< molality of H+ (mol/kg)
5851	REAL(wp) :: zmolso4 !< molality of SO4(2-) (mol/kg)
5852	REAL(wp) :: zmolcl !< molality of Cl (mol/kg)
5853	REAL(wp) :: zmolnh4 !< Molality of NH4 (mol/kg)
5854	REAL(wp) :: zmolna !< Molality of Na (mol/kg)
5855	REAL(wp) :: zhlp1 !<
5856	REAL(wp) :: zhlp2 !<
5857	REAL(wp) :: zhlp3 !<
5858	REAL(wp) :: zxi !<
5859	REAL(wp) :: zt0 !< Reference temp
5860
5861	zhlp1 = 0.0_wp
5862	zhlp2 = 0.0_wp
5863	zhlp3 = 0.0_wp
5864	zmolcl = 0.0_wp
5865	zmolhp = 0.0_wp
5866	zmolna = 0.0_wp
5867	zmolnh4 = 0.0_wp
5868	zmolno3 = 0.0_wp
5869	zmolso4 = 0.0_wp
5870	zt0 = 298.15_wp
5871	zxi = 0.0_wp
5872	!
5873	!-- Calculates equlibrium rate constants based on Table B.7 in Jacobson (2005)
5874	!-- K^ll_H20, K^ll_NH3, K^gl_NH3, K^gl_HNO3
5875	zhlp1 = zt0 / ptemp
5876	zhlp2 = zhlp1 - 1.0_wp
5877	zhlp3 = 1.0_wp + LOG( zhlp1 ) - zhlp1
5878
5879	KllH2O = K01 * EXP( a1 * zhlp2 + b1 * zhlp3 )
5880	KllNH3 = K02 * EXP( a2 * zhlp2 + b2 * zhlp3 )
5881	KglNH3 = K03 * EXP( a3 * zhlp2 + b3 * zhlp3 )
5882	KglHNO3 = K04 * EXP( a4 * zhlp2 + b4 * zhlp3 )
5883
5884	DO b = 1, nbins
5885
5886	IF ( ppart(b)%numc > nclim .AND. ppart(b)%volc(8) > 1.0E-30_wp ) THEN
5887	!
5888	!-- Molality of H+ and NO3-
5889	zhlp1 = pcnh3(b) * amnh3 + ppart(b)%volc(1) * arhoh2so4 + &
5890	ppart(b)%volc(2) * arhooc + ppart(b)%volc(5) * arhoss + &
5891	ppart(b)%volc(8) * arhoh2o
5892	zmolno3 = pchno3(b) / zhlp1 !< mol/kg
5893	!
5894	!-- Particle mole concentration ratio: (NH3+SS)/H2SO4
5895	zxi = ( pcnh3(b) + ppart(b)%volc(5) * arhoss / amss ) / &
5896	( ppart(b)%volc(1) * arhoh2so4 / amh2so4 )
5897
5898	IF ( zxi <= 2.0_wp ) THEN
5899	!
5900	!-- Molality of SO4(2-)
5901	zhlp1 = pcnh3(b) * amnh3 + pchno3(b) * amhno3 + &
5902	ppart(b)%volc(2) * arhooc + ppart(b)%volc(5) * arhoss + &
5903	ppart(b)%volc(8) * arhoh2o
5904	zmolso4 = ( ppart(b)%volc(1) * arhoh2so4 / amh2so4 ) / zhlp1
5905	!
5906	!-- Molality of Cl-
5907	zhlp1 = pcnh3(b) * amnh3 + pchno3(b) * amhno3 + &
5908	ppart(b)%volc(2) * arhooc + ppart(b)%volc(1) * arhoh2so4 &
5909	+ ppart(b)%volc(8) * arhoh2o
5910	zmolcl = ( ppart(b)%volc(5) * arhoss / amss ) / zhlp1
5911	!
5912	!-- Molality of NH4+
5913	zhlp1 = pchno3(b) * amhno3 + ppart(b)%volc(1) * arhoh2so4 + &
5914	ppart(b)%volc(2) * arhooc + ppart(b)%volc(5) * arhoss + &
5915	ppart(b)%volc(8) * arhoh2o
5916	zmolnh4 = pcnh3(b) / zhlp1
5917	!
5918	!-- Molality of Na+
5919	zmolna = zmolcl
5920	!
5921	!-- Molality of H+
5922	zmolhp = 2.0_wp * zmolso4 + zmolno3 + zmolcl - ( zmolnh4 + zmolna )
5923
5924	ELSE
5925
5926	zhlp2 = pkelhno3(b) * zmolno3 * pachno3(b) ** 2.0_wp
5927	!
5928	!-- Mona debugging
5929	IF ( zhlp2 > 1.0E-30_wp ) THEN
5930	zmolhp = KglHNO3 * pchno3eq(b) / zhlp2 ! Eq. 17.38
5931	ELSE
5932	zmolhp = 0.0_wp
5933	ENDIF
5934
5935	ENDIF
5936
5937	zhlp1 = ppart(b)%volc(8) * arhoh2o * argas * ptemp * KglHNO3
5938	!
5939	!-- Saturation ratio for NH3 and for HNO3
5940	IF ( zmolhp > 0.0_wp ) THEN
5941	zhlp2 = pkelnh3(b) / ( zhlp1 * zmolhp )
5942	zhlp3 = KllH2O / ( KllNH3 + KglNH3 )
5943	psatnh3(b) = zhlp2 * ( ( pacnh4hso2(b) / pachhso4(b) ) **2.0_wp ) &
5944	* zhlp3
5945	psathno3(b) = ( pkelhno3(b) * zmolhp * pachno3(b)**2.0_wp ) / zhlp1
5946	ELSE
5947	psatnh3(b) = 1.0_wp
5948	psathno3(b) = 1.0_wp
5949	ENDIF
5950	ELSE
5951	psatnh3(b) = 1.0_wp
5952	psathno3(b) = 1.0_wp
5953	ENDIF
5954
5955	ENDDO
5956
5957	END SUBROUTINE SVsat
5958
5959	!------------------------------------------------------------------------------!
5960	! Description:
5961	! ------------
5962	!> Prototype module for calculating the water content of a mixed inorganic/
5963	!> organic particle + equilibrium water vapour pressure above the solution
5964	!> (HNO3, HCL, NH3 and representative organic compounds. Efficient calculation
5965	!> of the partitioning of species between gas and aerosol. Based in a chamber
5966	!> study.
5967	!
5968	!> Written by Dave Topping. Pure organic component properties predicted by Mark
5969	!> Barley based on VOCs predicted in MCM simulations performed by Mike Jenkin.
5970	!> Delivered by Gordon McFiggans as Deliverable D22 from WP1.4 in the EU FP6
5971	!> EUCAARI Integrated Project.
5972	!
5973	!> Queries concerning the use of this code through Gordon McFiggans,
5974	!> g.mcfiggans@manchester.ac.uk,
5975	!> Ownership: D. Topping, Centre for Atmospheric Sciences, University of
5976	!> Manchester, 2007
5977	!
5978	!> Rewritten to PALM by Mona Kurppa, UHel, 2017
5979	!------------------------------------------------------------------------------!
5980	SUBROUTINE inorganic_pdfite( RH, temp, ions, water_total, Press_HNO3, &
5981	Press_HCL, Press_NH3, gamma_out, mols_out )
5982
5983	IMPLICIT NONE
5984
5985	REAL(wp), DIMENSION(:) :: gamma_out !< Activity coefficient for calculating
5986	!< the non-ideal dissociation constants
5987	!< 1: HNO3, 2: HCL, 3: NH4+/H+ (NH3)
5988	!< 4: HHSO4**2/H2SO4,
5989	!< 5: H2SO43/HHSO42
5990	!< 6: NH4HSO2, 7: HHSO4
5991	REAL(wp), DIMENSION(:) :: ions !< ion molarities (mol/m3)
5992	!< 1: H+, 2: NH4+, 3: Na+, 4: SO4(2-),
5993	!< 5: HSO4-, 6: NO3-, 7: Cl-
5994	REAL(wp), DIMENSION(7) :: ions_mol !< ion molalities (mol/kg)
5995	!< 1: H+, 2: NH4+, 3: Na+, 4: SO4(2-),
5996	!< 5: HSO4-, 6: NO3-, 7: Cl-
5997	REAL(wp), DIMENSION(:) :: mols_out !< ion molality output (mol/kg)
5998	!< 1: H+, 2: NH4+, 3: Na+, 4: SO4(2-),
5999	!< 5: HSO4-, 6: NO3-, 7: Cl-
6000	REAL(wp) :: act_product !< ionic activity coef. product:
6001	!< = (gamma_h2so4**3d0) /
6002	!< (gamma_hhso4**2d0)
6003	REAL(wp) :: ammonium_chloride !<
6004	REAL(wp) :: ammonium_chloride_eq_frac !<
6005	REAL(wp) :: ammonium_nitrate !<
6006	REAL(wp) :: ammonium_nitrate_eq_frac !<
6007	REAL(wp) :: ammonium_sulphate !<
6008	REAL(wp) :: ammonium_sulphate_eq_frac !<
6009	REAL(wp) :: binary_h2so4 !< binary H2SO4 activity coeff.
6010	REAL(wp) :: binary_hcl !< binary HCL activity coeff.
6011	REAL(wp) :: binary_hhso4 !< binary HHSO4 activity coeff.
6012	REAL(wp) :: binary_hno3 !< binary HNO3 activity coeff.
6013	REAL(wp) :: binary_nh4hso4 !< binary NH4HSO4 activity coeff.
6014	REAL(wp) :: charge_sum !< sum of ionic charges
6015	REAL(wp) :: gamma_h2so4 !< activity coefficient
6016	REAL(wp) :: gamma_hcl !< activity coefficient
6017	REAL(wp) :: gamma_hhso4 !< activity coeffient
6018	REAL(wp) :: gamma_hno3 !< activity coefficient
6019	REAL(wp) :: gamma_nh3 !< activity coefficient
6020	REAL(wp) :: gamma_nh4hso4 !< activity coefficient
6021	REAL(wp) :: h_out !<
6022	REAL(wp) :: h_real !< new hydrogen ion conc.
6023	REAL(wp) :: H2SO4_hcl !< contribution of H2SO4
6024	REAL(wp) :: H2SO4_hno3 !< contribution of H2SO4
6025	REAL(wp) :: H2SO4_nh3 !< contribution of H2SO4
6026	REAL(wp) :: H2SO4_nh4hso4 !< contribution of H2SO4
6027	REAL(wp) :: HCL_h2so4 !< contribution of HCL
6028	REAL(wp) :: HCL_hhso4 !< contribution of HCL
6029	REAL(wp) :: HCL_hno3 !< contribution of HCL
6030	REAL(wp) :: HCL_nh3 !< contribution of HCL
6031	REAL(wp) :: HCL_nh4hso4 !< contribution of HCL
6032	REAL(wp) :: henrys_temp_dep !< temperature dependence of
6033	!< Henry's Law
6034	REAL(wp) :: HNO3_h2so4 !< contribution of HNO3
6035	REAL(wp) :: HNO3_hcl !< contribution of HNO3
6036	REAL(wp) :: HNO3_hhso4 !< contribution of HNO3
6037	REAL(wp) :: HNO3_nh3 !< contribution of HNO3
6038	REAL(wp) :: HNO3_nh4hso4 !< contribution of HNO3
6039	REAL(wp) :: hso4_out !<
6040	REAL(wp) :: hso4_real !< new bisulphate ion conc.
6041	REAL(wp) :: hydrochloric_acid !<
6042	REAL(wp) :: hydrochloric_acid_eq_frac !<
6043	REAL(wp) :: Kh !< equilibrium constant for H+
6044	REAL(wp) :: K_hcl !< equilibrium constant of HCL
6045	REAL(wp) :: K_hno3 !< equilibrium constant of HNO3
6046	REAL(wp) :: Knh4 !< equilibrium constant for NH4+
6047	REAL(wp) :: Kw !< equil. const. for water_surface
6048	REAL(wp) :: Ln_h2so4_act !< gamma_h2so4 = EXP(Ln_h2so4_act)
6049	REAL(wp) :: Ln_HCL_act !< gamma_hcl = EXP( Ln_HCL_act )
6050	REAL(wp) :: Ln_hhso4_act !< gamma_hhso4 = EXP(Ln_hhso4_act)
6051	REAL(wp) :: Ln_HNO3_act !< gamma_hno3 = EXP( Ln_HNO3_act )
6052	REAL(wp) :: Ln_NH4HSO4_act !< gamma_nh4hso4 =
6053	!< EXP( Ln_NH4HSO4_act )
6054	REAL(wp) :: molality_ratio_nh3 !< molality ratio of NH3
6055	!< (NH4+ and H+)
6056	REAL(wp) :: Na2SO4_h2so4 !< contribution of Na2SO4
6057	REAL(wp) :: Na2SO4_hcl !< contribution of Na2SO4
6058	REAL(wp) :: Na2SO4_hhso4 !< contribution of Na2SO4
6059	REAL(wp) :: Na2SO4_hno3 !< contribution of Na2SO4
6060	REAL(wp) :: Na2SO4_nh3 !< contribution of Na2SO4
6061	REAL(wp) :: Na2SO4_nh4hso4 !< contribution of Na2SO4
6062	REAL(wp) :: NaCl_h2so4 !< contribution of NaCl
6063	REAL(wp) :: NaCl_hcl !< contribution of NaCl
6064	REAL(wp) :: NaCl_hhso4 !< contribution of NaCl
6065	REAL(wp) :: NaCl_hno3 !< contribution of NaCl
6066	REAL(wp) :: NaCl_nh3 !< contribution of NaCl
6067	REAL(wp) :: NaCl_nh4hso4 !< contribution of NaCl
6068	REAL(wp) :: NaNO3_h2so4 !< contribution of NaNO3
6069	REAL(wp) :: NaNO3_hcl !< contribution of NaNO3
6070	REAL(wp) :: NaNO3_hhso4 !< contribution of NaNO3
6071	REAL(wp) :: NaNO3_hno3 !< contribution of NaNO3
6072	REAL(wp) :: NaNO3_nh3 !< contribution of NaNO3
6073	REAL(wp) :: NaNO3_nh4hso4 !< contribution of NaNO3
6074	REAL(wp) :: NH42SO4_h2so4 !< contribution of NH42SO4
6075	REAL(wp) :: NH42SO4_hcl !< contribution of NH42SO4
6076	REAL(wp) :: NH42SO4_hhso4 !< contribution of NH42SO4
6077	REAL(wp) :: NH42SO4_hno3 !< contribution of NH42SO4
6078	REAL(wp) :: NH42SO4_nh3 !< contribution of NH42SO4
6079	REAL(wp) :: NH42SO4_nh4hso4 !< contribution of NH42SO4
6080	REAL(wp) :: NH4Cl_h2so4 !< contribution of NH4Cl
6081	REAL(wp) :: NH4Cl_hcl !< contribution of NH4Cl
6082	REAL(wp) :: NH4Cl_hhso4 !< contribution of NH4Cl
6083	REAL(wp) :: NH4Cl_hno3 !< contribution of NH4Cl
6084	REAL(wp) :: NH4Cl_nh3 !< contribution of NH4Cl
6085	REAL(wp) :: NH4Cl_nh4hso4 !< contribution of NH4Cl
6086	REAL(wp) :: NH4NO3_h2so4 !< contribution of NH4NO3
6087	REAL(wp) :: NH4NO3_hcl !< contribution of NH4NO3
6088	REAL(wp) :: NH4NO3_hhso4 !< contribution of NH4NO3
6089	REAL(wp) :: NH4NO3_hno3 !< contribution of NH4NO3
6090	REAL(wp) :: NH4NO3_nh3 !< contribution of NH4NO3
6091	REAL(wp) :: NH4NO3_nh4hso4 !< contribution of NH4NO3
6092	REAL(wp) :: nitric_acid !<
6093	REAL(wp) :: nitric_acid_eq_frac !< Equivalent fractions
6094	REAL(wp) :: Press_HCL !< partial pressure of HCL
6095	REAL(wp) :: Press_HNO3 !< partial pressure of HNO3
6096	REAL(wp) :: Press_NH3 !< partial pressure of NH3
6097	REAL(wp) :: RH !< relative humidity [0-1]
6098	REAL(wp) :: temp !< temperature
6099	REAL(wp) :: so4_out !<
6100	REAL(wp) :: so4_real !< new sulpate ion concentration
6101	REAL(wp) :: sodium_chloride !<
6102	REAL(wp) :: sodium_chloride_eq_frac !<
6103	REAL(wp) :: sodium_nitrate !<
6104	REAL(wp) :: sodium_nitrate_eq_frac !<
6105	REAL(wp) :: sodium_sulphate !<
6106	REAL(wp) :: sodium_sulphate_eq_frac !<
6107	REAL(wp) :: solutes !<
6108	REAL(wp) :: sulphuric_acid !<
6109	REAL(wp) :: sulphuric_acid_eq_frac !<
6110	REAL(wp) :: water_total !<
6111
6112	REAL(wp) :: a !< auxiliary variable
6113	REAL(wp) :: b !< auxiliary variable
6114	REAL(wp) :: c !< auxiliary variable
6115	REAL(wp) :: root1 !< auxiliary variable
6116	REAL(wp) :: root2 !< auxiliary variable
6117
6118	INTEGER(iwp) :: binary_case
6119	INTEGER(iwp) :: full_complexity
6120	!
6121	!-- Value initialisation
6122	binary_h2so4 = 0.0_wp
6123	binary_hcl = 0.0_wp
6124	binary_hhso4 = 0.0_wp
6125	binary_hno3 = 0.0_wp
6126	binary_nh4hso4 = 0.0_wp
6127	henrys_temp_dep = ( 1.0_wp / temp - 1.0_wp / 298.0_wp )
6128	HCL_hno3 = 1.0_wp
6129	H2SO4_hno3 = 1.0_wp
6130	NH42SO4_hno3 = 1.0_wp
6131	NH4NO3_hno3 = 1.0_wp
6132	NH4Cl_hno3 = 1.0_wp
6133	Na2SO4_hno3 = 1.0_wp
6134	NaNO3_hno3 = 1.0_wp
6135	NaCl_hno3 = 1.0_wp
6136	HNO3_hcl = 1.0_wp
6137	H2SO4_hcl = 1.0_wp
6138	NH42SO4_hcl = 1.0_wp
6139	NH4NO3_hcl = 1.0_wp
6140	NH4Cl_hcl = 1.0_wp
6141	Na2SO4_hcl = 1.0_wp
6142	NaNO3_hcl = 1.0_wp
6143	NaCl_hcl = 1.0_wp
6144	HNO3_nh3 = 1.0_wp
6145	HCL_nh3 = 1.0_wp
6146	H2SO4_nh3 = 1.0_wp
6147	NH42SO4_nh3 = 1.0_wp
6148	NH4NO3_nh3 = 1.0_wp
6149	NH4Cl_nh3 = 1.0_wp
6150	Na2SO4_nh3 = 1.0_wp
6151	NaNO3_nh3 = 1.0_wp
6152	NaCl_nh3 = 1.0_wp
6153	HNO3_hhso4 = 1.0_wp
6154	HCL_hhso4 = 1.0_wp
6155	NH42SO4_hhso4 = 1.0_wp
6156	NH4NO3_hhso4 = 1.0_wp
6157	NH4Cl_hhso4 = 1.0_wp
6158	Na2SO4_hhso4 = 1.0_wp
6159	NaNO3_hhso4 = 1.0_wp
6160	NaCl_hhso4 = 1.0_wp
6161	HNO3_h2so4 = 1.0_wp
6162	HCL_h2so4 = 1.0_wp
6163	NH42SO4_h2so4 = 1.0_wp
6164	NH4NO3_h2so4 = 1.0_wp
6165	NH4Cl_h2so4 = 1.0_wp
6166	Na2SO4_h2so4 = 1.0_wp
6167	NaNO3_h2so4 = 1.0_wp
6168	NaCl_h2so4 = 1.0_wp
6169	!-- New NH3 variables
6170	HNO3_nh4hso4 = 1.0_wp
6171	HCL_nh4hso4 = 1.0_wp
6172	H2SO4_nh4hso4 = 1.0_wp
6173	NH42SO4_nh4hso4 = 1.0_wp
6174	NH4NO3_nh4hso4 = 1.0_wp
6175	NH4Cl_nh4hso4 = 1.0_wp
6176	Na2SO4_nh4hso4 = 1.0_wp
6177	NaNO3_nh4hso4 = 1.0_wp
6178	NaCl_nh4hso4 = 1.0_wp
6179	!
6180	!-- Juha Tonttila added
6181	mols_out = 0.0_wp
6182	Press_HNO3 = 0.0_wp
6183	Press_HCL = 0.0_wp
6184	Press_NH3 = 0.0_wp !< Initialising vapour pressure over the
6185	!< multicomponent particle
6186	gamma_out = 1.0_wp !< i.e. don't alter the ideal mixing ratios if
6187	!< there's nothing there.
6188	!
6189	!-- 1) - COMPOSITION DEFINITIONS
6190	!
6191	!-- a) Inorganic ion pairing:
6192	!-- In order to calculate the water content, which is also used in
6193	!-- calculating vapour pressures, one needs to pair the anions and cations
6194	!-- for use in the ZSR mixing rule. The equation provided by Clegg et al.
6195	!-- (2001) is used for ion pairing. The solutes chosen comprise of 9
6196	!-- inorganic salts and acids which provide a pairing between each anion and
6197	!-- cation: (NH4)2SO4, NH4NO3, NH4Cl, Na2SO4, NaNO3, NaCl, H2SO4, HNO3, HCL.
6198	!-- The organic compound is treated as a seperate solute.
6199	!-- Ions: 1: H+, 2: NH4+, 3: Na+, 4: SO4(2-), 5: HSO4-, 6: NO3-, 7: Cl-
6200	!
6201	charge_sum = ions(1) + ions(2) + ions(3) + 2.0_wp * ions(4) + ions(5) + &
6202	ions(6) + ions(7)
6203	nitric_acid = 0.0_wp ! HNO3
6204	nitric_acid = ( 2.0_wp * ions(1) * ions(6) * &
6205	( ( 1.0_wp / 1.0_wp ) ** 0.5_wp ) ) / ( charge_sum )
6206	hydrochloric_acid = 0.0_wp ! HCL
6207	hydrochloric_acid = ( 2.0_wp * ions(1) * ions(7) * &
6208	( ( 1.0_wp / 1.0_wp ) ** 0.5_wp ) ) / ( charge_sum )
6209	sulphuric_acid = 0.0_wp ! H2SO4
6210	sulphuric_acid = ( 2.0_wp * ions(1) * ions(4) * &
6211	( ( 2.0_wp / 2.0_wp ) ** 0.5_wp ) ) / ( charge_sum )
6212	ammonium_sulphate = 0.0_wp ! (NH4)2SO4
6213	ammonium_sulphate = ( 2.0_wp * ions(2) * ions(4) * &
6214	( ( 2.0_wp / 2.0_wp ) ** 0.5_wp ) ) / ( charge_sum )
6215	ammonium_nitrate = 0.0_wp ! NH4NO3
6216	ammonium_nitrate = ( 2.0_wp * ions(2) * ions(6) * &
6217	( ( 1.0_wp / 1.0_wp ) ** 0.5_wp ) ) / ( charge_sum )
6218	ammonium_chloride = 0.0_wp ! NH4Cl
6219	ammonium_chloride = ( 2.0_wp * ions(2) * ions(7) * &
6220	( ( 1.0_wp / 1.0_wp ) ** 0.5_wp ) ) / ( charge_sum )
6221	sodium_sulphate = 0.0_wp ! Na2SO4
6222	sodium_sulphate = ( 2.0_wp * ions(3) * ions(4) * &
6223	( ( 2.0_wp / 2.0_wp ) ** 0.5_wp ) ) / ( charge_sum )
6224	sodium_nitrate = 0.0_wp ! NaNO3
6225	sodium_nitrate = ( 2.0_wp * ions(3) ions(6) &
6226	( ( 1.0_wp / 1.0_wp ) ** 0.5_wp ) ) / ( charge_sum )
6227	sodium_chloride = 0.0_wp ! NaCl
6228	sodium_chloride = ( 2.0_wp * ions(3) * ions(7) * &
6229	( ( 1.0_wp / 1.0_wp ) ** 0.5_wp ) ) / ( charge_sum )
6230	solutes = 0.0_wp
6231	solutes = 3.0_wp * sulphuric_acid + 2.0_wp * hydrochloric_acid + &
6232	2.0_wp * nitric_acid + 3.0_wp * ammonium_sulphate + &
6233	2.0_wp * ammonium_nitrate + 2.0_wp * ammonium_chloride + &
6234	3.0_wp * sodium_sulphate + 2.0_wp * sodium_nitrate + &
6235	2.0_wp * sodium_chloride
6236
6237	!
6238	!-- b) Inorganic equivalent fractions:
6239	!-- These values are calculated so that activity coefficients can be
6240	!-- expressed by a linear additive rule, thus allowing more efficient
6241	!-- calculations and future expansion (see more detailed description below)
6242	nitric_acid_eq_frac = 2.0_wp * nitric_acid / ( solutes )
6243	hydrochloric_acid_eq_frac = 2.0_wp * hydrochloric_acid / ( solutes )
6244	sulphuric_acid_eq_frac = 3.0_wp * sulphuric_acid / ( solutes )
6245	ammonium_sulphate_eq_frac = 3.0_wp * ammonium_sulphate / ( solutes )
6246	ammonium_nitrate_eq_frac = 2.0_wp * ammonium_nitrate / ( solutes )
6247	ammonium_chloride_eq_frac = 2.0_wp * ammonium_chloride / ( solutes )
6248	sodium_sulphate_eq_frac = 3.0_wp * sodium_sulphate / ( solutes )
6249	sodium_nitrate_eq_frac = 2.0_wp * sodium_nitrate / ( solutes )
6250	sodium_chloride_eq_frac = 2.0_wp * sodium_chloride / ( solutes )
6251	!
6252	!-- Inorganic ion molalities
6253	ions_mol(:) = 0.0_wp
6254	ions_mol(1) = ions(1) / ( water_total * 18.01528E-3_wp ) ! H+
6255	ions_mol(2) = ions(2) / ( water_total * 18.01528E-3_wp ) ! NH4+
6256	ions_mol(3) = ions(3) / ( water_total * 18.01528E-3_wp ) ! Na+
6257	ions_mol(4) = ions(4) / ( water_total * 18.01528E-3_wp ) ! SO4(2-)
6258	ions_mol(5) = ions(5) / ( water_total * 18.01528E-3_wp ) ! HSO4(2-)
6259	ions_mol(6) = ions(6) / ( water_total * 18.01528E-3_wp ) ! NO3-
6260	ions_mol(7) = ions(7) / ( water_total * 18.01528E-3_wp ) ! Cl-
6261
6262	!-- ***
6263	!-- At this point we may need to introduce a method for prescribing H+ when
6264	!-- there is no 'real' value for H+..i.e. in the sulphate poor domain
6265	!-- This will give a value for solve quadratic proposed by Zaveri et al. 2005
6266	!
6267	!-- 2) - WATER CALCULATION
6268	!
6269	!-- a) The water content is calculated using the ZSR rule with solute
6270	!-- concentrations calculated using 1a above. Whilst the usual approximation of
6271	!-- ZSR relies on binary data consisting of 5th or higher order polynomials, in
6272	!-- this code 4 different RH regimes are used, each housing cubic equations for
6273	!-- the water associated with each solute listed above. Binary water contents
6274	!-- for inorganic components were calculated using AIM online (Clegg et al
6275	!-- 1998). The water associated with the organic compound is calculated assuming
6276	!-- ideality and that aw = RH.
6277	!
6278	!-- b) Molality of each inorganic ion and organic solute (initial input) is
6279	!-- calculated for use in vapour pressure calculation.
6280	!
6281	!-- 3) - BISULPHATE ION DISSOCIATION CALCULATION
6282	!
6283	!-- The dissociation of the bisulphate ion is calculated explicitly. A solution
6284	!-- to the equilibrium equation between the bisulphate ion, hydrogen ion and
6285	!-- sulphate ion is found using tabulated equilibrium constants (referenced). It
6286	!-- is necessary to calculate the activity coefficients of HHSO4 and H2SO4 in a
6287	!-- non-iterative manner. These are calculated using the same format as
6288	!-- described in 4) below, where both activity coefficients were fit to the
6289	!-- output from ADDEM (Topping et al 2005a,b) covering an extensive composition
6290	!-- space, providing the activity coefficients and bisulphate ion dissociation
6291	!-- as a function of equivalent mole fractions and relative humidity.
6292	!
6293	!-- NOTE: the flags "binary_case" and "full_complexity" are not used in this
6294	!-- prototype. They are used for simplification of the fit expressions when
6295	!-- using limited composition regions. This section of code calculates the
6296	!-- bisulphate ion concentration
6297	!
6298	IF ( ions(1) > 0.0_wp .AND. ions(4) > 0.0_wp ) THEN
6299	!
6300	!-- HHSO4:
6301	binary_case = 1
6302	IF ( RH > 0.1_wp .AND. RH < 0.9_wp ) THEN
6303	binary_hhso4 = - 4.9521_wp * ( RH*3 ) + 9.2881_wp ( RH**2 ) - &
6304	10.777_wp * RH + 6.0534_wp
6305	ELSEIF ( RH >= 0.9_wp .AND. RH < 0.955_wp ) THEN
6306	binary_hhso4 = - 6.3777_wp * RH + 5.962_wp
6307	ELSEIF ( RH >= 0.955_wp .AND. RH < 0.99_wp ) THEN
6308	binary_hhso4 = 2367.2_wp * ( RH*3 ) - 6849.7_wp ( RH**2 ) + &
6309	6600.9_wp * RH - 2118.7_wp
6310	ELSEIF ( RH >= 0.99_wp .AND. RH < 0.9999_wp ) THEN
6311	binary_hhso4 = 3E-7_wp * ( RH*5 ) - 2E-5_wp ( RH**4 ) + &
6312	0.0004_wp * ( RH*3 ) - 0.0035_wp ( RH**2 ) + &
6313	0.0123_wp * RH - 0.3025_wp
6314	ENDIF
6315
6316	IF ( nitric_acid > 0.0_wp ) THEN
6317	HNO3_hhso4 = - 4.2204_wp * ( RH*4 ) + 12.193_wp ( RH**3 ) - &
6318	12.481_wp * ( RH*2 ) + 6.459_wp RH - 1.9004_wp
6319	ENDIF
6320
6321	IF ( hydrochloric_acid > 0.0_wp ) THEN
6322	HCL_hhso4 = - 54.845_wp * ( RH*7 ) + 209.54_wp ( RH**6 ) - &
6323	336.59_wp * ( RH*5 ) + 294.21_wp ( RH**4 ) - &
6324	150.07_wp * ( RH*3 ) + 43.767_wp ( RH**2 ) - &
6325	6.5495_wp * RH + 0.60048_wp
6326	ENDIF
6327
6328	IF ( ammonium_sulphate > 0.0_wp ) THEN
6329	NH42SO4_hhso4 = 16.768_wp * ( RH*3 ) - 28.75_wp ( RH**2 ) + &
6330	20.011_wp * RH - 8.3206_wp
6331	ENDIF
6332
6333	IF ( ammonium_nitrate > 0.0_wp ) THEN
6334	NH4NO3_hhso4 = - 17.184_wp * ( RH*4 ) + 56.834_wp ( RH**3 ) - &
6335	65.765_wp * ( RH*2 ) + 35.321_wp RH - 9.252_wp
6336	ENDIF
6337
6338	IF (ammonium_chloride > 0.0_wp ) THEN
6339	IF ( RH < 0.2_wp .AND. RH >= 0.1_wp ) THEN
6340	NH4Cl_hhso4 = 3.2809_wp * RH - 2.0637_wp
6341	ELSEIF ( RH >= 0.2_wp .AND. RH < 0.99_wp ) THEN
6342	NH4Cl_hhso4 = - 1.2981_wp * ( RH*3 ) + 4.7461_wp ( RH**2 ) - &
6343	2.3269_wp * RH - 1.1259_wp
6344	ENDIF
6345	ENDIF
6346
6347	IF ( sodium_sulphate > 0.0_wp ) THEN
6348	Na2SO4_hhso4 = 118.87_wp * ( RH*6 ) - 358.63_wp ( RH**5 ) + &
6349	435.85_wp * ( RH*4 ) - 272.88_wp ( RH**3 ) + &
6350	94.411_wp * ( RH*2 ) - 18.21_wp RH + 0.45935_wp
6351	ENDIF
6352
6353	IF ( sodium_nitrate > 0.0_wp ) THEN
6354	IF ( RH < 0.2_wp .AND. RH >= 0.1_wp ) THEN
6355	NaNO3_hhso4 = 4.8456_wp * RH - 2.5773_wp
6356	ELSEIF ( RH >= 0.2_wp .AND. RH < 0.99_wp ) THEN
6357	NaNO3_hhso4 = 0.5964_wp * ( RH*3 ) - 0.38967_wp ( RH**2 ) + &
6358	1.7918_wp * RH - 1.9691_wp
6359	ENDIF
6360	ENDIF
6361
6362	IF ( sodium_chloride > 0.0_wp ) THEN
6363	IF ( RH < 0.2_wp ) THEN
6364	NaCl_hhso4 = 0.51995_wp * RH - 1.3981_wp
6365	ELSEIF ( RH >= 0.2_wp .AND. RH < 0.99_wp ) THEN
6366	NaCl_hhso4 = 1.6539_wp * RH - 1.6101_wp
6367	ENDIF
6368	ENDIF
6369
6370	Ln_hhso4_act = binary_hhso4 + &
6371	nitric_acid_eq_frac * HNO3_hhso4 + &
6372	hydrochloric_acid_eq_frac * HCL_hhso4 + &
6373	ammonium_sulphate_eq_frac * NH42SO4_hhso4 + &
6374	ammonium_nitrate_eq_frac * NH4NO3_hhso4 + &
6375	ammonium_chloride_eq_frac * NH4Cl_hhso4 + &
6376	sodium_sulphate_eq_frac * Na2SO4_hhso4 + &
6377	sodium_nitrate_eq_frac * NaNO3_hhso4 + &
6378	sodium_chloride_eq_frac * NaCl_hhso4
6379	gamma_hhso4 = EXP( Ln_hhso4_act ) ! molal activity coefficient of HHSO4
6380
6381	!-- H2SO4 (sulphuric acid):
6382	IF ( RH >= 0.1_wp .AND. RH < 0.9_wp ) THEN
6383	binary_h2so4 = 2.4493_wp * ( RH*2 ) - 6.2326_wp RH + 2.1763_wp
6384	ELSEIF ( RH >= 0.9_wp .AND. RH < 0.98 ) THEN
6385	binary_h2so4 = 914.68_wp * ( RH*3 ) - 2502.3_wp ( RH**2 ) + &
6386	2281.9_wp * RH - 695.11_wp
6387	ELSEIF ( RH >= 0.98 .AND. RH < 0.9999 ) THEN
6388	binary_h2so4 = 3E-8_wp * ( RH*4 ) - 5E-6_wp ( RH**3 ) + &
6389	0.0003_wp * ( RH*2 ) - 0.0022_wp RH - 1.1305_wp
6390	ENDIF
6391
6392	IF ( nitric_acid > 0.0_wp ) THEN
6393	HNO3_h2so4 = - 16.382_wp * ( RH*5 ) + 46.677_wp ( RH**4 ) - &
6394	54.149_wp * ( RH*3 ) + 34.36_wp ( RH**2 ) - &
6395	12.54_wp * RH + 2.1368_wp
6396	ENDIF
6397
6398	IF ( hydrochloric_acid > 0.0_wp ) THEN
6399	HCL_h2so4 = - 14.409_wp * ( RH*5 ) + 42.804_wp ( RH**4 ) - &
6400	47.24_wp * ( RH*3 ) + 24.668_wp ( RH**2 ) - &
6401	5.8015_wp * RH + 0.084627_wp
6402	ENDIF
6403
6404	IF ( ammonium_sulphate > 0.0_wp ) THEN
6405	NH42SO4_h2so4 = 66.71_wp * ( RH*5 ) - 187.5_wp ( RH**4 ) + &
6406	210.57_wp * ( RH*3 ) - 121.04_wp ( RH**2 ) + &
6407	39.182_wp * RH - 8.0606_wp
6408	ENDIF
6409
6410	IF ( ammonium_nitrate > 0.0_wp ) THEN
6411	NH4NO3_h2so4 = - 22.532_wp * ( RH*4 ) + 66.615_wp ( RH**3 ) - &
6412	74.647_wp * ( RH*2 ) + 37.638_wp RH - 6.9711_wp
6413	ENDIF
6414
6415	IF ( ammonium_chloride > 0.0_wp ) THEN
6416	IF ( RH >= 0.1_wp .AND. RH < 0.2_wp ) THEN
6417	NH4Cl_h2so4 = - 0.32089_wp * RH + 0.57738_wp
6418	ELSEIF ( RH >= 0.2_wp .AND. RH < 0.9_wp ) THEN
6419	NH4Cl_h2so4 = 18.089_wp * ( RH*5 ) - 51.083_wp ( RH**4 ) + &
6420	50.32_wp * ( RH*3 ) - 17.012_wp ( RH**2 ) - &
6421	0.93435_wp * RH + 1.0548_wp
6422	ELSEIF ( RH >= 0.9_wp .AND. RH < 0.99_wp ) THEN
6423	NH4Cl_h2so4 = - 1.5749_wp * RH + 1.7002_wp
6424	ENDIF
6425	ENDIF
6426
6427	IF ( sodium_sulphate > 0.0_wp ) THEN
6428	Na2SO4_h2so4 = 29.843_wp * ( RH*4 ) - 69.417_wp ( RH**3 ) + &
6429	61.507_wp * ( RH*2 ) - 29.874_wp RH + 7.7556_wp
6430	ENDIF
6431
6432	IF ( sodium_nitrate > 0.0_wp ) THEN
6433	NaNO3_h2so4 = - 122.37_wp * ( RH*6 ) + 427.43_wp ( RH**5 ) - &
6434	604.68_wp * ( RH*4 ) + 443.08_wp ( RH**3 ) - &
6435	178.61_wp * ( RH*2 ) + 37.242_wp RH - 1.9564_wp
6436	ENDIF
6437
6438	IF ( sodium_chloride > 0.0_wp ) THEN
6439	NaCl_h2so4 = - 40.288_wp * ( RH*5 ) + 115.61_wp ( RH**4 ) - &
6440	129.99_wp * ( RH*3 ) + 72.652_wp ( RH**2 ) - &
6441	22.124_wp * RH + 4.2676_wp
6442	ENDIF
6443
6444	Ln_h2so4_act = binary_h2so4 + &
6445	nitric_acid_eq_frac * HNO3_h2so4 + &
6446	hydrochloric_acid_eq_frac * HCL_h2so4 + &
6447	ammonium_sulphate_eq_frac * NH42SO4_h2so4 + &
6448	ammonium_nitrate_eq_frac * NH4NO3_h2so4 + &
6449	ammonium_chloride_eq_frac * NH4Cl_h2so4 + &
6450	sodium_sulphate_eq_frac * Na2SO4_h2so4 + &
6451	sodium_nitrate_eq_frac * NaNO3_h2so4 + &
6452	sodium_chloride_eq_frac * NaCl_h2so4
6453
6454	gamma_h2so4 = EXP( Ln_h2so4_act ) ! molal activity coefficient
6455	!
6456	!-- Export activity coefficients
6457	IF ( gamma_h2so4 > 1.0E-10_wp ) THEN
6458	gamma_out(4) = ( gamma_hhso4**2.0_wp ) / gamma_h2so4
6459	ENDIF
6460	IF ( gamma_hhso4 > 1.0E-10_wp ) THEN
6461	gamma_out(5) = ( gamma_h2so43.0_wp ) / ( gamma_hhso42.0_wp )
6462	ENDIF
6463	!
6464	!-- Ionic activity coefficient product
6465	act_product = ( gamma_h2so43.0_wp ) / ( gamma_hhso42.0_wp )
6466	!
6467	!-- Solve the quadratic equation (i.e. x in ax**2 + bx + c = 0)
6468	a = 1.0_wp
6469	b = - 1.0_wp * ( ions(4) + ions(1) + ( ( water_total * 18.0E-3_wp ) / &
6470	( 99.0_wp * act_product ) ) )
6471	c = ions(4) * ions(1)
6472	root1 = ( ( -1.0_wp * b ) + ( ( ( b*2 ) - 4.0_wp a * c )**0.5_wp &
6473	) ) / ( 2 * a )
6474	root2 = ( ( -1.0_wp * b ) - ( ( ( b*2 ) - 4.0_wp a * c) **0.5_wp &
6475	) ) / ( 2 * a )
6476
6477	IF ( root1 > ions(1) .OR. root1 < 0.0_wp ) THEN
6478	root1 = 0.0_wp
6479	ENDIF
6480
6481	IF ( root2 > ions(1) .OR. root2 < 0.0_wp ) THEN
6482	root2 = 0.0_wp
6483	ENDIF
6484	!
6485	!-- Calculate the new hydrogen ion, bisulphate ion and sulphate ion
6486	!-- concentration
6487	hso4_real = 0.0_wp
6488	h_real = ions(1)
6489	so4_real = ions(4)
6490	IF ( root1 == 0.0_wp ) THEN
6491	hso4_real = root2
6492	ELSEIF ( root2 == 0.0_wp ) THEN
6493	hso4_real = root1
6494	ENDIF
6495	h_real = ions(1) - hso4_real
6496	so4_real = ions(4) - hso4_real
6497	!
6498	!-- Recalculate ion molalities
6499	ions_mol(1) = h_real / ( water_total * 18.01528E-3_wp ) ! H+
6500	ions_mol(4) = so4_real / ( water_total * 18.01528E-3_wp ) ! SO4(2-)
6501	ions_mol(5) = hso4_real / ( water_total * 18.01528E-3_wp ) ! HSO4(2-)
6502
6503	h_out = h_real
6504	hso4_out = hso4_real
6505	so4_out = so4_real
6506
6507	ELSEIF ( ions(1) == 0.0_wp .OR. ions(4) == 0.0_wp ) THEN
6508	h_out = ions(1)
6509	hso4_out = 0.0_wp
6510	so4_out = ions(4)
6511	ENDIF
6512
6513	!
6514	!-- 4) ACTIVITY COEFFICIENTS -for vapour pressures of HNO3,HCL and NH3
6515	!
6516	!-- This section evaluates activity coefficients and vapour pressures using the
6517	!-- water content calculated above) for each inorganic condensing species:
6518	!-- a - HNO3, b - NH3, c - HCL.
6519	!-- The following procedure is used:
6520	!-- Zaveri et al (2005) found that one could express the variation of activity
6521	!-- coefficients linearly in log-space if equivalent mole fractions were used.
6522	!-- So, by a taylor series expansion LOG( activity coefficient ) =
6523	!-- LOG( binary activity coefficient at a given RH ) +
6524	!-- (equivalent mole fraction compound A) *
6525	!-- ('interaction' parameter between A and condensing species) +
6526	!-- equivalent mole fraction compound B) *
6527	!-- ('interaction' parameter between B and condensing species).
6528	!-- Here, the interaction parameters have been fit to ADDEM by searching the
6529	!-- whole compositon space and fit usign the Levenberg-Marquardt non-linear
6530	!-- least squares algorithm.
6531	!
6532	!-- They are given as a function of RH and vary with complexity ranging from
6533	!-- linear to 5th order polynomial expressions, the binary activity coefficients
6534	!-- were calculated using AIM online.
6535	!-- NOTE: for NH3, no binary activity coefficient was used and the data were fit
6536	!-- to the ratio of the activity coefficients for the ammonium and hydrogen
6537	!-- ions. Once the activity coefficients are obtained the vapour pressure can be
6538	!-- easily calculated using tabulated equilibrium constants (referenced). This
6539	!-- procedure differs from that of Zaveri et al (2005) in that it is not assumed
6540	!-- one can carry behaviour from binary mixtures in multicomponent systems. To
6541	!-- this end we have fit the 'interaction' parameters explicitly to a general
6542	!-- inorganic equilibrium model (ADDEM - Topping et al. 2005a,b). Such
6543	!-- parameters take into account bisulphate ion dissociation and water content.
6544	!-- This also allows us to consider one regime for all composition space, rather
6545	!-- than defining sulphate rich and sulphate poor regimes
6546	!-- NOTE: The flags "binary_case" and "full_complexity" are not used in this
6547	!-- prototype. They are used for simplification of the fit expressions when
6548	!-- using limited composition regions.
6549	!
6550	!-- a) - ACTIVITY COEFF/VAPOUR PRESSURE - HNO3
6551	IF ( ions(1) > 0.0_wp .AND. ions(6) > 0.0_wp ) THEN
6552	binary_case = 1
6553	IF ( RH > 0.1_wp .AND. RH < 0.98_wp ) THEN
6554	IF ( binary_case == 1 ) THEN
6555	binary_hno3 = 1.8514_wp * ( RH*3 ) - 4.6991_wp ( RH**2 ) + &
6556	1.5514_wp * RH + 0.90236_wp
6557	ELSEIF ( binary_case == 2 ) THEN
6558	binary_hno3 = - 1.1751_wp * ( RH*2 ) - 0.53794_wp RH + &
6559	1.2808_wp
6560	ENDIF
6561	ELSEIF ( RH >= 0.98_wp .AND. RH < 0.9999_wp ) THEN
6562	binary_hno3 = 1244.69635941351_wp * ( RH**3 ) - &
6563	2613.93941099991_wp * ( RH**2 ) + &
6564	1525.0684974546_wp * RH -155.946764059316_wp
6565	ENDIF
6566	!
6567	!-- Contributions from other solutes
6568	full_complexity = 1
6569	IF ( hydrochloric_acid > 0.0_wp ) THEN ! HCL
6570	IF ( full_complexity == 1 .OR. RH < 0.4_wp ) THEN
6571	HCL_hno3 = 16.051_wp * ( RH*4 ) - 44.357_wp ( RH**3 ) + &
6572	45.141_wp * ( RH*2 ) - 21.638_wp RH + 4.8182_wp
6573	ELSEIF ( full_complexity == 0 .AND. RH > 0.4_wp ) THEN
6574	HCL_hno3 = - 1.5833_wp * RH + 1.5569_wp
6575	ENDIF
6576	ENDIF
6577
6578	IF ( sulphuric_acid > 0.0_wp ) THEN ! H2SO4
6579	IF ( full_complexity == 1 .OR. RH < 0.4_wp ) THEN
6580	H2SO4_hno3 = - 3.0849_wp * ( RH*3 ) + 5.9609_wp ( RH**2 ) - &
6581	4.468_wp * RH + 1.5658_wp
6582	ELSEIF ( full_complexity == 0 .AND. RH > 0.4_wp ) THEN
6583	H2SO4_hno3 = - 0.93473_wp * RH + 0.9363_wp
6584	ENDIF
6585	ENDIF
6586
6587	IF ( ammonium_sulphate > 0.0_wp ) THEN ! NH42SO4
6588	NH42SO4_hno3 = 16.821_wp * ( RH*3 ) - 28.391_wp ( RH**2 ) + &
6589	18.133_wp * RH - 6.7356_wp
6590	ENDIF
6591
6592	IF ( ammonium_nitrate > 0.0_wp ) THEN ! NH4NO3
6593	NH4NO3_hno3 = 11.01_wp * ( RH*3 ) - 21.578_wp ( RH**2 ) + &
6594	14.808_wp * RH - 4.2593_wp
6595	ENDIF
6596
6597	IF ( ammonium_chloride > 0.0_wp ) THEN ! NH4Cl
6598	IF ( full_complexity == 1 .OR. RH <= 0.4_wp ) THEN
6599	NH4Cl_hno3 = - 1.176_wp * ( RH*3 ) + 5.0828_wp ( RH**2 ) - &
6600	3.8792_wp * RH - 0.05518_wp
6601	ELSEIF ( full_complexity == 0 .AND. RH > 0.4_wp ) THEN
6602	NH4Cl_hno3 = 2.6219_wp * ( RH*2 ) - 2.2609_wp RH - 0.38436_wp
6603	ENDIF
6604	ENDIF
6605
6606	IF ( sodium_sulphate > 0.0_wp ) THEN ! Na2SO4
6607	Na2SO4_hno3 = 35.504_wp * ( RH*4 ) - 80.101_wp ( RH**3 ) + &
6608	67.326_wp * ( RH*2 ) - 28.461_wp RH + 5.6016_wp
6609	ENDIF
6610
6611	IF ( sodium_nitrate > 0.0_wp ) THEN ! NaNO3
6612	IF ( full_complexity == 1 .OR. RH <= 0.4_wp ) THEN
6613	NaNO3_hno3 = 23.659_wp * ( RH*5 ) - 66.917_wp ( RH**4 ) + &
6614	74.686_wp * ( RH*3 ) - 40.795_wp ( RH**2 ) + &
6615	10.831_wp * RH - 1.4701_wp
6616	ELSEIF ( full_complexity == 0 .AND. RH > 0.4_wp ) THEN
6617	NaNO3_hno3 = 14.749_wp * ( RH*4 ) - 35.237_wp ( RH**3 ) + &
6618	31.196_wp * ( RH*2 ) - 12.076_wp RH + 1.3605_wp
6619	ENDIF
6620	ENDIF
6621
6622	IF ( sodium_chloride > 0.0_wp ) THEN ! NaCl
6623	IF ( full_complexity == 1 .OR. RH <= 0.4_wp ) THEN
6624	NaCl_hno3 = 13.682_wp * ( RH*4 ) - 35.122_wp ( RH**3 ) + &
6625	33.397_wp * ( RH*2 ) - 14.586_wp RH + 2.6276_wp
6626	ELSEIF ( full_complexity == 0 .AND. RH > 0.4_wp ) THEN
6627	NaCl_hno3 = 1.1882_wp * ( RH*3 ) - 1.1037_wp ( RH**2 ) - &
6628	0.7642_wp * RH + 0.6671_wp
6629	ENDIF
6630	ENDIF
6631
6632	Ln_HNO3_act = binary_hno3 + &
6633	hydrochloric_acid_eq_frac * HCL_hno3 + &
6634	sulphuric_acid_eq_frac * H2SO4_hno3 + &
6635	ammonium_sulphate_eq_frac * NH42SO4_hno3 + &
6636	ammonium_nitrate_eq_frac * NH4NO3_hno3 + &
6637	ammonium_chloride_eq_frac * NH4Cl_hno3 + &
6638	sodium_sulphate_eq_frac * Na2SO4_hno3 + &
6639	sodium_nitrate_eq_frac * NaNO3_hno3 + &
6640	sodium_chloride_eq_frac * NaCl_hno3
6641
6642	gamma_hno3 = EXP( Ln_HNO3_act ) ! Molal activity coefficient of HNO3
6643	gamma_out(1) = gamma_hno3
6644	!
6645	!-- Partial pressure calculation
6646	!-- K_hno3 = 2.51 * ( 10**6 )
6647	!-- K_hno3 = 2.628145923d6 !< calculated by AIM online (Clegg et al 1998)
6648	!-- after Chameides (1984) (and NIST database)
6649	K_hno3 = 2.6E6_wp * EXP( 8700.0_wp * henrys_temp_dep)
6650	Press_HNO3 = ( ions_mol(1) * ions_mol(6) * ( gamma_hno3**2 ) ) / &
6651	K_hno3
6652	ENDIF
6653	!
6654	!-- b) - ACTIVITY COEFF/VAPOUR PRESSURE - NH3
6655	!-- Follow the two solute approach of Zaveri et al. (2005)
6656	IF ( ions(2) > 0.0_wp .AND. ions_mol(1) > 0.0_wp ) THEN
6657	!-- NH4HSO4:
6658	binary_nh4hso4 = 56.907_wp * ( RH*6 ) - 155.32_wp ( RH**5 ) + &
6659	142.94_wp * ( RH*4 ) - 32.298_wp ( RH**3 ) - &
6660	27.936_wp * ( RH*2 ) + 19.502_wp RH - 4.2618_wp
6661	IF ( nitric_acid > 0.0_wp) THEN ! HNO3
6662	HNO3_nh4hso4 = 104.8369_wp * ( RH*8 ) - 288.8923_wp ( RH**7 ) + &
6663	129.3445_wp * ( RH*6 ) + 373.0471_wp ( RH**5 ) - &
6664	571.0385_wp * ( RH*4 ) + 326.3528_wp ( RH**3 ) - &
6665	74.169_wp * ( RH*2 ) - 2.4999_wp RH + 3.17_wp
6666	ENDIF
6667
6668	IF ( hydrochloric_acid > 0.0_wp) THEN ! HCL
6669	HCL_nh4hso4 = - 7.9133_wp * ( RH*8 ) + 126.6648_wp ( RH**7 ) - &
6670	460.7425_wp * ( RH*6 ) + 731.606_wp ( RH**5 ) - &
6671	582.7467_wp * ( RH*4 ) + 216.7197_wp ( RH**3 ) - &
6672	11.3934_wp * ( RH*2 ) - 17.7728_wp RH + 5.75_wp
6673	ENDIF
6674
6675	IF ( sulphuric_acid > 0.0_wp) THEN ! H2SO4
6676	H2SO4_nh4hso4 = 195.981_wp * ( RH*8 ) - 779.2067_wp ( RH**7 ) + &
6677	1226.3647_wp * ( RH*6 ) - 964.0261_wp ( RH**5 ) + &
6678	391.7911_wp * ( RH*4 ) - 84.1409_wp ( RH**3 ) + &
6679	20.0602_wp * ( RH*2 ) - 10.2663_wp RH + 3.5817_wp
6680	ENDIF
6681
6682	IF ( ammonium_sulphate > 0.0_wp) THEN ! NH42SO4
6683	NH42SO4_nh4hso4 = 617.777_wp * ( RH*8 ) - 2547.427_wp ( RH**7 ) &
6684	+ 4361.6009_wp * ( RH*6 ) - 4003.162_wp ( RH**5 ) &
6685	+ 2117.8281_wp * ( RH*4 ) - 640.0678_wp ( RH**3 ) &
6686	+ 98.0902_wp * ( RH*2 ) - 2.2615_wp RH - 2.3811_wp
6687	ENDIF
6688
6689	IF ( ammonium_nitrate > 0.0_wp) THEN ! NH4NO3
6690	NH4NO3_nh4hso4 = - 104.4504_wp * ( RH*8 ) + 539.5921_wp &
6691	( RH*7 ) - 1157.0498_wp ( RH*6 ) + 1322.4507_wp &
6692	( RH*5 ) - 852.2475_wp ( RH*4 ) + 298.3734_wp &
6693	( RH*3 ) - 47.0309_wp ( RH*2 ) + 1.297_wp RH - &
6694	0.8029_wp
6695	ENDIF
6696
6697	IF ( ammonium_chloride > 0.0_wp) THEN ! NH4Cl
6698	NH4Cl_nh4hso4 = 258.1792_wp * ( RH*8 ) - 1019.3777_wp &
6699	( RH*7 ) + 1592.8918_wp ( RH*6 ) - 1221.0726_wp &
6700	( RH*5 ) + 442.2548_wp ( RH*4 ) - 43.6278_wp &
6701	( RH*3 ) - 7.5282_wp ( RH*2 ) - 3.8459_wp RH + 2.2728_wp
6702	ENDIF
6703
6704	IF ( sodium_sulphate > 0.0_wp) THEN ! Na2SO4
6705	Na2SO4_nh4hso4 = 225.4238_wp * ( RH*8 ) - 732.4113_wp &
6706	( RH*7 ) + 843.7291_wp ( RH*6 ) - 322.7328_wp &
6707	( RH*5 ) - 88.6252_wp ( RH*4 ) + 72.4434_wp &
6708	( RH*3 ) + 22.9252_wp ( RH*2 ) - 25.3954_wp RH + &
6709	4.6971_wp
6710	ENDIF
6711
6712	IF ( sodium_nitrate > 0.0_wp) THEN ! NaNO3
6713	NaNO3_nh4hso4 = 96.1348_wp * ( RH*8 ) - 341.6738_wp ( RH**7 ) + &
6714	406.5314_wp * ( RH*6 ) - 98.5777_wp ( RH**5 ) - &
6715	172.8286_wp * ( RH*4 ) + 149.3151_wp ( RH**3 ) - &
6716	38.9998_wp * ( RH*2 ) - 0.2251 RH + 0.4953_wp
6717	ENDIF
6718
6719	IF ( sodium_chloride > 0.0_wp) THEN ! NaCl
6720	NaCl_nh4hso4 = 91.7856_wp * ( RH*8 ) - 316.6773_wp ( RH**7 ) + &
6721	358.2703_wp * ( RH*6 ) - 68.9142 ( RH**5 ) - &
6722	156.5031_wp * ( RH*4 ) + 116.9592_wp ( RH**3 ) - &
6723	22.5271_wp * ( RH*2 ) - 3.7716_wp RH + 1.56_wp
6724	ENDIF
6725
6726	Ln_NH4HSO4_act = binary_nh4hso4 + &
6727	nitric_acid_eq_frac * HNO3_nh4hso4 + &
6728	hydrochloric_acid_eq_frac * HCL_nh4hso4 + &
6729	sulphuric_acid_eq_frac * H2SO4_nh4hso4 + &
6730	ammonium_sulphate_eq_frac * NH42SO4_nh4hso4 + &
6731	ammonium_nitrate_eq_frac * NH4NO3_nh4hso4 + &
6732	ammonium_chloride_eq_frac * NH4Cl_nh4hso4 + &
6733	sodium_sulphate_eq_frac * Na2SO4_nh4hso4 + &
6734	sodium_nitrate_eq_frac * NaNO3_nh4hso4 + &
6735	sodium_chloride_eq_frac * NaCl_nh4hso4
6736
6737	gamma_nh4hso4 = EXP( Ln_NH4HSO4_act ) ! molal act. coefficient of NH4HSO4
6738	!-- Molal activity coefficient of NO3-
6739	gamma_out(6) = gamma_nh4hso4
6740	!-- Molal activity coefficient of NH4+
6741	gamma_nh3 = ( gamma_nh4hso42 ) / ( gamma_hhso42 )
6742	gamma_out(3) = gamma_nh3
6743	!
6744	!-- This actually represents the ratio of the ammonium to hydrogen ion
6745	!-- activity coefficients (see Zaveri paper) - multiply this by the ratio
6746	!-- of the ammonium to hydrogen ion molality and the ratio of appropriate
6747	!-- equilibrium constants
6748	!
6749	!-- Equilibrium constants
6750	!-- Kh = 57.64d0 ! Zaveri et al. (2005)
6751	Kh = 5.8E1_wp * EXP( 4085.0_wp * henrys_temp_dep ) ! after Chameides
6752	! ! (1984) (and NIST database)
6753	!-- Knh4 = 1.81E-5_wp ! Zaveri et al. (2005)
6754	Knh4 = 1.7E-5_wp * EXP( -4325.0_wp * henrys_temp_dep ) ! Chameides
6755	! (1984)
6756	!-- Kw = 1.01E-14_wp ! Zaveri et al (2005)
6757	Kw = 1.E-14_wp * EXP( -6716.0_wp * henrys_temp_dep ) ! Chameides
6758	! (1984)
6759	!
6760	molality_ratio_nh3 = ions_mol(2) / ions_mol(1)
6761	!-- Partial pressure calculation
6762	Press_NH3 = molality_ratio_nh3 * gamma_nh3 * ( Kw / ( Kh * Knh4 ) )
6763
6764	ENDIF
6765	!
6766	!-- c) - ACTIVITY COEFF/VAPOUR PRESSURE - HCL
6767	IF ( ions(1) > 0.0_wp .AND. ions(7) > 0.0_wp ) THEN
6768	binary_case = 1
6769	IF ( RH > 0.1_wp .AND. RH < 0.98 ) THEN
6770	IF ( binary_case == 1 ) THEN
6771	binary_hcl = - 5.0179_wp * ( RH*3 ) + 9.8816_wp ( RH**2 ) - &
6772	10.789_wp * RH + 5.4737_wp
6773	ELSEIF ( binary_case == 2 ) THEN
6774	binary_hcl = - 4.6221_wp * RH + 4.2633_wp
6775	ENDIF
6776	ELSEIF ( RH >= 0.98_wp .AND. RH < 0.9999_wp ) THEN
6777	binary_hcl = 775.6111008626_wp * ( RH*3 ) - 2146.01320888771_wp &
6778	( RH*2 ) + 1969.01979670259_wp RH - 598.878230033926_wp
6779	ENDIF
6780	ENDIF
6781
6782	IF ( nitric_acid > 0.0_wp ) THEN ! HNO3
6783	IF ( full_complexity == 1 .OR. RH <= 0.4_wp ) THEN
6784	HNO3_hcl = 9.6256_wp * ( RH*4 ) - 26.507_wp ( RH**3 ) + &
6785	27.622_wp * ( RH*2 ) - 12.958_wp RH + 2.2193_wp
6786	ELSEIF ( full_complexity == 0 .AND. RH > 0.4_wp ) THEN
6787	HNO3_hcl = 1.3242_wp * ( RH*2 ) - 1.8827_wp RH + 0.55706_wp
6788	ENDIF
6789	ENDIF
6790
6791	IF ( sulphuric_acid > 0.0_wp ) THEN ! H2SO4
6792	IF ( full_complexity == 1 .OR. RH <= 0.4 ) THEN
6793	H2SO4_hcl = 1.4406_wp * ( RH*3 ) - 2.7132_wp ( RH**2 ) + &
6794	1.014_wp * RH + 0.25226_wp
6795	ELSEIF ( full_complexity == 0 .AND. RH > 0.4_wp ) THEN
6796	H2SO4_hcl = 0.30993_wp * ( RH*2 ) - 0.99171_wp RH + 0.66913_wp
6797	ENDIF
6798	ENDIF
6799
6800	IF ( ammonium_sulphate > 0.0_wp ) THEN ! NH42SO4
6801	NH42SO4_hcl = 22.071_wp * ( RH*3 ) - 40.678_wp ( RH**2 ) + &
6802	27.893_wp * RH - 9.4338_wp
6803	ENDIF
6804
6805	IF ( ammonium_nitrate > 0.0_wp ) THEN ! NH4NO3
6806	NH4NO3_hcl = 19.935_wp * ( RH*3 ) - 42.335_wp ( RH**2 ) + &
6807	31.275_wp * RH - 8.8675_wp
6808	ENDIF
6809
6810	IF ( ammonium_chloride > 0.0_wp ) THEN ! NH4Cl
6811	IF ( full_complexity == 1 .OR. RH <= 0.4_wp ) THEN
6812	NH4Cl_hcl = 2.8048_wp * ( RH*3 ) - 4.3182_wp ( RH**2 ) + &
6813	3.1971_wp * RH - 1.6824_wp
6814	ELSEIF ( full_complexity == 0 .AND. RH > 0.4_wp ) THEN
6815	NH4Cl_hcl = 1.2304_wp * ( RH*2 ) - 0.18262_wp RH - 1.0643_wp
6816	ENDIF
6817	ENDIF
6818
6819	IF ( sodium_sulphate > 0.0_wp ) THEN ! Na2SO4
6820	Na2SO4_hcl = 36.104_wp * ( RH*4 ) - 78.658_wp ( RH**3 ) + &
6821	63.441_wp * ( RH*2 ) - 26.727_wp RH + 5.7007_wp
6822	ENDIF
6823
6824	IF ( sodium_nitrate > 0.0_wp ) THEN ! NaNO3
6825	IF ( full_complexity == 1 .OR. RH <= 0.4_wp ) THEN
6826	NaNO3_hcl = 54.471_wp * ( RH*5 ) - 159.42_wp ( RH**4 ) + &
6827	180.25_wp * ( RH*3 ) - 98.176_wp ( RH**2 ) + &
6828	25.309_wp * RH - 2.4275_wp
6829	ELSEIF ( full_complexity == 0 .AND. RH > 0.4_wp ) THEN
6830	NaNO3_hcl = 21.632_wp * ( RH*4 ) - 53.088_wp ( RH**3 ) + &
6831	47.285_wp * ( RH*2 ) - 18.519_wp RH + 2.6846_wp
6832	ENDIF
6833	ENDIF
6834
6835	IF ( sodium_chloride > 0.0_wp ) THEN ! NaCl
6836	IF ( full_complexity == 1 .OR. RH <= 0.4_wp ) THEN
6837	NaCl_hcl = 5.4138_wp * ( RH*4 ) - 12.079_wp ( RH**3 ) + &
6838	9.627_wp * ( RH*2 ) - 3.3164_wp RH + 0.35224_wp
6839	ELSEIF ( full_complexity == 0 .AND. RH > 0.4_wp ) THEN
6840	NaCl_hcl = 2.432_wp * ( RH*3 ) - 4.3453_wp ( RH**2 ) + &
6841	2.3834_wp * RH - 0.4762_wp
6842	ENDIF
6843	ENDIF
6844
6845	Ln_HCL_act = binary_hcl + &
6846	nitric_acid_eq_frac * HNO3_hcl + &
6847	sulphuric_acid_eq_frac * H2SO4_hcl + &
6848	ammonium_sulphate_eq_frac * NH42SO4_hcl + &
6849	ammonium_nitrate_eq_frac * NH4NO3_hcl + &
6850	ammonium_chloride_eq_frac * NH4Cl_hcl + &
6851	sodium_sulphate_eq_frac * Na2SO4_hcl + &
6852	sodium_nitrate_eq_frac * NaNO3_hcl + &
6853	sodium_chloride_eq_frac * NaCl_hcl
6854
6855	gamma_hcl = EXP( Ln_HCL_act ) ! Molal activity coefficient
6856	gamma_out(2) = gamma_hcl
6857	!
6858	!-- Equilibrium constant after Wagman et al. (1982) (and NIST database)
6859	K_hcl = 2E6_wp * EXP( 9000.0_wp * henrys_temp_dep )
6860
6861	Press_HCL = ( ions_mol(1) * ions_mol(7) * ( gamma_hcl**2 ) ) / K_hcl
6862	!
6863	!-- 5) Ion molility output
6864	mols_out = ions_mol
6865	!
6866	!-- REFERENCES
6867	!-- Clegg et al. (1998) A Thermodynamic Model of the System
6868	!-- H+-NH4+-Na+-SO42- -NO3--Cl--H2O at 298.15 K, J. Phys. Chem., 102A,
6869	!-- 2155-2171.
6870	!-- Clegg et al. (2001) Thermodynamic modelling of aqueous aerosols containing
6871	!-- electrolytes and dissolved organic compounds. Journal of Aerosol Science
6872	!-- 2001;32(6):713-738.
6873	!-- Topping et al. (2005a) A curved multi-component aerosol hygroscopicity model
6874	!-- framework: Part 1 - Inorganic compounds. Atmospheric Chemistry and
6875	!-- Physics 2005;5:1205-1222.
6876	!-- Topping et al. (2005b) A curved multi-component aerosol hygroscopicity model
6877	!-- framework: Part 2 - Including organic compounds. Atmospheric Chemistry
6878	!-- and Physics 2005;5:1223-1242.
6879	!-- Wagman et al. (1982). The NBS tables of chemical thermodynamic properties:
6880	!-- selected values for inorganic and Câ and Câ organic substances in SI
6881	!-- units (book)
6882	!-- Zaveri et al. (2005). A new method for multicomponent activity coefficients
6883	!-- of electrolytes in aqueous atmospheric aerosols, JGR, 110, D02201, 2005.
6884	END SUBROUTINE inorganic_pdfite
6885
6886	!------------------------------------------------------------------------------!
6887	! Description:
6888	! ------------
6889	!> Update the particle size distribution. Put particles into corrects bins.
6890	!>
6891	!> Moving-centre method assumed, i.e. particles are allowed to grow to their
6892	!> exact size as long as they are not crossing the fixed diameter bin limits.
6893	!> If the particles in a size bin cross the lower or upper diameter limit, they
6894	!> are all moved to the adjacent diameter bin and their volume is averaged with
6895	!> the particles in the new bin, which then get a new diameter.
6896	!
6897	!> Moving-centre method minimises numerical diffusion.
6898	!------------------------------------------------------------------------------!
6899	SUBROUTINE distr_update( paero )
6900
6901	IMPLICIT NONE
6902
6903	!-- Input and output variables
6904	TYPE(t_section), INTENT(inout) :: paero(fn2b) !< Aerosols particle
6905	!< size distribution and properties
6906	!-- Local variables
6907	INTEGER(iwp) :: b !< loop index
6908	INTEGER(iwp) :: mm !< loop index
6909	INTEGER(iwp) :: counti
6910	LOGICAL :: within_bins !< logical (particle belongs to the bin?)
6911	REAL(wp) :: znfrac !< number fraction to be moved to the larger bin
6912	REAL(wp) :: zvfrac !< volume fraction to be moved to the larger bin
6913	REAL(wp) :: zVexc !< Volume in the grown bin which exceeds the bin
6914	!< upper limit
6915	REAL(wp) :: zVihi !< particle volume at the high end of the bin
6916	REAL(wp) :: zVilo !< particle volume at the low end of the bin
6917	REAL(wp) :: zvpart !< particle volume (m3)
6918	REAL(wp) :: zVrat !< volume ratio of a size bin
6919
6920	zvpart = 0.0_wp
6921	zvfrac = 0.0_wp
6922
6923	within_bins = .FALSE.
6924
6925	!
6926	!-- Check if the volume of the bin is within bin limits after update
6927	counti = 0
6928	DO WHILE ( .NOT. within_bins )
6929	within_bins = .TRUE.
6930
6931	DO b = fn2b-1, in1a, -1
6932	mm = 0
6933	IF ( paero(b)%numc > nclim ) THEN
6934
6935	zvpart = 0.0_wp
6936	zvfrac = 0.0_wp
6937
6938	IF ( b == fn2a ) CYCLE
6939	!
6940	!-- Dry volume
6941	zvpart = SUM( paero(b)%volc(1:7) ) / paero(b)%numc
6942	!
6943	!-- Smallest bin cannot decrease
6944	IF ( paero(b)%vlolim > zvpart .AND. b == in1a ) CYCLE
6945	!
6946	!-- Decreasing bins
6947	IF ( paero(b)%vlolim > zvpart ) THEN
6948	mm = b - 1
6949	IF ( b == in2b ) mm = fn1a ! 2b goes to 1a
6950
6951	paero(mm)%numc = paero(mm)%numc + paero(b)%numc
6952	paero(b)%numc = 0.0_wp
6953	paero(mm)%volc(:) = paero(mm)%volc(:) + paero(b)%volc(:)
6954	paero(b)%volc(:) = 0.0_wp
6955	CYCLE
6956	ENDIF
6957	!
6958	!-- If size bin has not grown, cycle
6959	!-- Changed by Mona: compare to the arithmetic mean volume, as done
6960	!-- originally. Now particle volume is derived from the geometric mean
6961	!-- diameter, not arithmetic (see SUBROUTINE set_sizebins).
6962	IF ( zvpart <= api6 * ( ( aero(b)%vhilim + aero(b)%vlolim ) / &
6963	( 2.0_wp * api6 ) ) ) CYCLE
6964	IF ( ABS( zvpart - api6 * paero(b)%dmid ** 3.0_wp ) < &
6965	1.0E-35_wp ) CYCLE ! Mona: to avoid precision problems
6966	!
6967	!-- Volume ratio of the size bin
6968	zVrat = paero(b)%vhilim / paero(b)%vlolim
6969	!-- Particle volume at the low end of the bin
6970	zVilo = 2.0_wp * zvpart / ( 1.0_wp + zVrat )
6971	!-- Particle volume at the high end of the bin
6972	zVihi = zVrat * zVilo
6973	!-- Volume in the grown bin which exceeds the bin upper limit
6974	zVexc = 0.5_wp * ( zVihi + paero(b)%vhilim )
6975	!-- Number fraction to be moved to the larger bin
6976	znfrac = MIN( 1.0_wp, ( zVihi - paero(b)%vhilim) / &
6977	( zVihi - zVilo ) )
6978	!-- Volume fraction to be moved to the larger bin
6979	zvfrac = MIN( 0.99_wp, znfrac * zVexc / zvpart )
6980	IF ( zvfrac < 0.0_wp ) THEN
6981	message_string = 'Error: zvfrac < 0'
6982	CALL message( 'salsa_mod: distr_update', 'SA0050', &
6983	1, 2, 0, 6, 0 )
6984	ENDIF
6985	!
6986	!-- Update bin
6987	mm = b + 1
6988	!-- Volume (cm3/cm3)
6989	paero(mm)%volc(:) = paero(mm)%volc(:) + znfrac * paero(b)%numc * &
6990	zVexc * paero(b)%volc(:) / &
6991	SUM( paero(b)%volc(1:7) )
6992	paero(b)%volc(:) = paero(b)%volc(:) - znfrac * paero(b)%numc * &
6993	zVexc * paero(b)%volc(:) / &
6994	SUM( paero(b)%volc(1:7) )
6995
6996	!-- Number concentration (#/m3)
6997	paero(mm)%numc = paero(mm)%numc + znfrac * paero(b)%numc
6998	paero(b)%numc = paero(b)%numc * ( 1.0_wp - znfrac )
6999
7000	ENDIF ! nclim
7001
7002	IF ( paero(b)%numc > nclim ) THEN
7003	zvpart = SUM( paero(b)%volc(1:7) ) / paero(b)%numc
7004	within_bins = ( paero(b)%vlolim < zvpart .AND. &
7005	zvpart < paero(b)%vhilim )
7006	ENDIF
7007
7008	ENDDO ! - b
7009
7010	counti = counti + 1
7011	IF ( counti > 100 ) THEN
7012	message_string = 'Error: Aerosol bin update not converged'
7013	CALL message( 'salsa_mod: distr_update', 'SA0051', 1, 2, 0, 6, 0 )
7014	ENDIF
7015
7016	ENDDO ! - within bins
7017
7018	END SUBROUTINE distr_update
7019
7020	!------------------------------------------------------------------------------!
7021	! Description:
7022	! ------------
7023	!> salsa_diagnostics: Update properties for the current timestep:
7024	!>
7025	!> Juha Tonttila, FMI, 2014
7026	!> Tomi Raatikainen, FMI, 2016
7027	!------------------------------------------------------------------------------!
7028	SUBROUTINE salsa_diagnostics( i, j )
7029
7030	USE arrays_3d, &
7031	ONLY: p, pt, zu
7032
7033	USE basic_constants_and_equations_mod, &
7034	ONLY: g
7035
7036	USE control_parameters, &
7037	ONLY: pt_surface, surface_pressure
7038
7039	USE cpulog, &
7040	ONLY: cpu_log, log_point_s
7041
7042	IMPLICIT NONE
7043
7044	INTEGER(iwp), INTENT(in) :: i !<
7045	INTEGER(iwp), INTENT(in) :: j !<
7046
7047	INTEGER(iwp) :: b !<
7048	INTEGER(iwp) :: c !<
7049	INTEGER(iwp) :: gt !<
7050	INTEGER(iwp) :: k !<
7051	INTEGER(iwp) :: nc !<
7052	REAL(wp), DIMENSION(nzb:nzt+1) :: flag !< flag to mask topography
7053	REAL(wp), DIMENSION(nzb:nzt+1) :: flag_zddry !< flag to mask zddry
7054	REAL(wp), DIMENSION(nzb:nzt+1) :: in_adn !< air density (kg/m3)
7055	REAL(wp), DIMENSION(nzb:nzt+1) :: in_p !< pressure
7056	REAL(wp), DIMENSION(nzb:nzt+1) :: in_t !< temperature (K)
7057	REAL(wp), DIMENSION(nzb:nzt+1) :: mcsum !< sum of mass concentration
7058	REAL(wp), DIMENSION(nzb:nzt+1) :: ppm_to_nconc !< Conversion factor
7059	!< from ppm to #/m3
7060	REAL(wp), DIMENSION(nzb:nzt+1) :: zddry !<
7061	REAL(wp), DIMENSION(nzb:nzt+1) :: zvol !<
7062
7063	flag_zddry = 0.0_wp
7064	in_adn = 0.0_wp
7065	in_p = 0.0_wp
7066	in_t = 0.0_wp
7067	ppm_to_nconc = 1.0_wp
7068	zddry = 0.0_wp
7069	zvol = 0.0_wp
7070
7071	CALL cpu_log( log_point_s(94), 'salsa diagnostics ', 'start' )
7072
7073	!
7074	!-- Calculate thermodynamic quantities needed in SALSA
7075	CALL salsa_thrm_ij( i, j, p_ij=in_p, temp_ij=in_t, adn_ij=in_adn )
7076	!
7077	!-- Calculate conversion factors for gas concentrations
7078	ppm_to_nconc = for_ppm_to_nconc * in_p / in_t
7079	!
7080	!-- Predetermine flag to mask topography
7081	flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_0(:,j,i), 0 ) )
7082
7083	DO b = 1, nbins ! aerosol size bins
7084	!
7085	!-- Remove negative values
7086	aerosol_number(b)%conc(:,j,i) = MAX( nclim, &
7087	aerosol_number(b)%conc(:,j,i) ) * flag
7088	mcsum = 0.0_wp ! total mass concentration
7089	DO c = 1, ncc_tot
7090	!
7091	!-- Remove negative concentrations
7092	aerosol_mass((c-1)*nbins+b)%conc(:,j,i) = MAX( mclim, &
7093	aerosol_mass((c-1)*nbins+b)%conc(:,j,i) ) &
7094	* flag
7095	mcsum = mcsum + aerosol_mass((c-1)nbins+b)%conc(:,j,i) flag
7096	ENDDO
7097	!
7098	!-- Check that number and mass concentration match qualitatively
7099	IF ( ANY ( aerosol_number(b)%conc(:,j,i) > nclim .AND. &
7100	mcsum <= 0.0_wp ) ) &
7101	THEN
7102	DO k = nzb+1, nzt
7103	IF ( aerosol_number(b)%conc(k,j,i) > nclim .AND. &
7104	mcsum(k) <= 0.0_wp ) &
7105	THEN
7106	aerosol_number(b)%conc(k,j,i) = nclim * flag(k)
7107	DO c = 1, ncc_tot
7108	aerosol_mass((c-1)nbins+b)%conc(k,j,i) = mclim flag(k)
7109	ENDDO
7110	ENDIF
7111	ENDDO
7112	ENDIF
7113	!
7114	!-- Update aerosol particle radius
7115	CALL bin_mixrat( 'dry', b, i, j, zvol )
7116	zvol = zvol / arhoh2so4 ! Why on sulphate?
7117	!
7118	!-- Particles smaller then 0.1 nm diameter are set to zero
7119	zddry = ( zvol / MAX( nclim, aerosol_number(b)%conc(:,j,i) ) / api6 )** &
7120	( 1.0_wp / 3.0_wp )
7121	flag_zddry = MERGE( 1.0_wp, 0.0_wp, ( zddry < 1.0E-10_wp .AND. &
7122	aerosol_number(b)%conc(:,j,i) > nclim ) )
7123	!
7124	!-- Volatile species to the gas phase
7125	IF ( is_used( prtcl, 'SO4' ) .AND. lscndgas ) THEN
7126	nc = get_index( prtcl, 'SO4' )
7127	c = ( nc - 1 ) * nbins + b
7128	IF ( salsa_gases_from_chem ) THEN
7129	chem_species( gas_index_chem(1) )%conc(:,j,i) = &
7130	chem_species( gas_index_chem(1) )%conc(:,j,i) + &
7131	aerosol_mass(c)%conc(:,j,i) * avo * flag * &
7132	flag_zddry / ( amh2so4 * ppm_to_nconc )
7133	ELSE
7134	salsa_gas(1)%conc(:,j,i) = salsa_gas(1)%conc(:,j,i) + &
7135	aerosol_mass(c)%conc(:,j,i) / amh2so4 *&
7136	avo * flag * flag_zddry
7137	ENDIF
7138	ENDIF
7139	IF ( is_used( prtcl, 'OC' ) .AND. lscndgas ) THEN
7140	nc = get_index( prtcl, 'OC' )
7141	c = ( nc - 1 ) * nbins + b
7142	IF ( salsa_gases_from_chem ) THEN
7143	chem_species( gas_index_chem(5) )%conc(:,j,i) = &
7144	chem_species( gas_index_chem(5) )%conc(:,j,i) + &
7145	aerosol_mass(c)%conc(:,j,i) * avo * flag * &
7146	flag_zddry / ( amoc * ppm_to_nconc )
7147	ELSE
7148	salsa_gas(5)%conc(:,j,i) = salsa_gas(5)%conc(:,j,i) + &
7149	aerosol_mass(c)%conc(:,j,i) / amoc * &
7150	avo * flag * flag_zddry
7151	ENDIF
7152	ENDIF
7153	IF ( is_used( prtcl, 'NO' ) .AND. lscndgas ) THEN
7154	nc = get_index( prtcl, 'NO' )
7155	c = ( nc - 1 ) * nbins + b
7156	IF ( salsa_gases_from_chem ) THEN
7157	chem_species( gas_index_chem(2) )%conc(:,j,i) = &
7158	chem_species( gas_index_chem(2) )%conc(:,j,i) + &
7159	aerosol_mass(c)%conc(:,j,i) * avo * flag * &
7160	flag_zddry / ( amhno3 * ppm_to_nconc )
7161	ELSE
7162	salsa_gas(2)%conc(:,j,i) = salsa_gas(2)%conc(:,j,i) + &
7163	aerosol_mass(c)%conc(:,j,i) / amhno3 * &
7164	avo * flag * flag_zddry
7165	ENDIF
7166	ENDIF
7167	IF ( is_used( prtcl, 'NH' ) .AND. lscndgas ) THEN
7168	nc = get_index( prtcl, 'NH' )
7169	c = ( nc - 1 ) * nbins + b
7170	IF ( salsa_gases_from_chem ) THEN
7171	chem_species( gas_index_chem(3) )%conc(:,j,i) = &
7172	chem_species( gas_index_chem(3) )%conc(:,j,i) + &
7173	aerosol_mass(c)%conc(:,j,i) * avo * flag * &
7174	flag_zddry / ( amnh3 * ppm_to_nconc )
7175	ELSE
7176	salsa_gas(3)%conc(:,j,i) = salsa_gas(3)%conc(:,j,i) + &
7177	aerosol_mass(c)%conc(:,j,i) / amnh3 * &
7178	avo * flag * flag_zddry
7179	ENDIF
7180	ENDIF
7181	!
7182	!-- Mass and number to zero (insoluble species and water are lost)
7183	DO c = 1, ncc_tot
7184	aerosol_mass((c-1)nbins+b)%conc(:,j,i) = MERGE( mclim flag, &
7185	aerosol_mass((c-1)*nbins+b)%conc(:,j,i), &
7186	flag_zddry > 0.0_wp )
7187	ENDDO
7188	aerosol_number(b)%conc(:,j,i) = MERGE( nclim * flag, &
7189	aerosol_number(b)%conc(:,j,i), &
7190	flag_zddry > 0.0_wp )
7191	Ra_dry(:,j,i,b) = MAX( 1.0E-10_wp, 0.5_wp * zddry )
7192
7193	ENDDO
7194	IF ( .NOT. salsa_gases_from_chem ) THEN
7195	DO gt = 1, ngast
7196	salsa_gas(gt)%conc(:,j,i) = MAX( nclim, salsa_gas(gt)%conc(:,j,i) ) &
7197	* flag
7198	ENDDO
7199	ENDIF
7200
7201	CALL cpu_log( log_point_s(94), 'salsa diagnostics ', 'stop' )
7202
7203	END SUBROUTINE salsa_diagnostics
7204
7205
7206	!
7207	!------------------------------------------------------------------------------!
7208	! Description:
7209	! ------------
7210	!> Calculate the tendencies for aerosol number and mass concentrations.
7211	!> Cache-optimized.
7212	!------------------------------------------------------------------------------!
7213	SUBROUTINE salsa_tendency_ij( id, rs_p, rs, trs_m, i, j, i_omp_start, tn, b, &
7214	c, flux_s, diss_s, flux_l, diss_l, rs_init )
7215
7216	USE advec_ws, &
7217	ONLY: advec_s_ws
7218	USE advec_s_pw_mod, &
7219	ONLY: advec_s_pw
7220	USE advec_s_up_mod, &
7221	ONLY: advec_s_up
7222	USE arrays_3d, &
7223	ONLY: ddzu, hyp, pt, rdf_sc, tend
7224	USE diffusion_s_mod, &
7225	ONLY: diffusion_s
7226	USE indices, &
7227	ONLY: wall_flags_0
7228	USE pegrid, &
7229	ONLY: threads_per_task, myid
7230	USE surface_mod, &
7231	ONLY : surf_def_h, surf_def_v, surf_lsm_h, surf_lsm_v, surf_usm_h, &
7232	surf_usm_v
7233
7234	IMPLICIT NONE
7235
7236	CHARACTER (LEN = *) :: id
7237	INTEGER(iwp) :: b !< bin index in derived type aerosol_size_bin
7238	INTEGER(iwp) :: c !< bin index in derived type aerosol_size_bin
7239	INTEGER(iwp) :: i !<
7240	INTEGER(iwp) :: i_omp_start !<
7241	INTEGER(iwp) :: j !<
7242	INTEGER(iwp) :: k !<
7243	INTEGER(iwp) :: nc !< (c-1)*nbins+b
7244	INTEGER(iwp) :: tn !<
7245	REAL(wp), DIMENSION(nzb+1:nzt,nys:nyn,0:threads_per_task-1) :: diss_l !<
7246	REAL(wp), DIMENSION(nzb+1:nzt,0:threads_per_task-1) :: diss_s !<
7247	REAL(wp), DIMENSION(nzb+1:nzt,nys:nyn,0:threads_per_task-1) :: flux_l !<
7248	REAL(wp), DIMENSION(nzb+1:nzt,0:threads_per_task-1) :: flux_s !<
7249	REAL(wp), DIMENSION(nzb:nzt+1) :: rs_init !<
7250	REAL(wp), DIMENSION(:,:,:), POINTER :: rs_p !<
7251	REAL(wp), DIMENSION(:,:,:), POINTER :: rs !<
7252	REAL(wp), DIMENSION(:,:,:), POINTER :: trs_m !<
7253
7254	nc = (c-1)*nbins+b
7255	!
7256	!-- Tendency-terms for reactive scalar
7257	tend(:,j,i) = 0.0_wp
7258
7259	IF ( id == 'aerosol_number' .AND. lod_aero == 3 ) THEN
7260	tend(:,j,i) = tend(:,j,i) + aerosol_number(b)%source(:,j,i)
7261	ELSEIF ( id == 'aerosol_mass' .AND. lod_aero == 3 ) THEN
7262	tend(:,j,i) = tend(:,j,i) + aerosol_mass(nc)%source(:,j,i)
7263	ENDIF
7264	!
7265	!-- Advection terms
7266	IF ( timestep_scheme(1:5) == 'runge' ) THEN
7267	IF ( ws_scheme_sca ) THEN
7268	CALL advec_s_ws( i, j, rs, id, flux_s, diss_s, flux_l, diss_l, &
7269	i_omp_start, tn )
7270	ELSE
7271	CALL advec_s_pw( i, j, rs )
7272	ENDIF
7273	ELSE
7274	CALL advec_s_up( i, j, rs )
7275	ENDIF
7276	!
7277	!-- Diffusion terms
7278	IF ( id == 'aerosol_number' ) THEN
7279	CALL diffusion_s( i, j, rs, surf_def_h(0)%answs(:,b), &
7280	surf_def_h(1)%answs(:,b), surf_def_h(2)%answs(:,b), &
7281	surf_lsm_h%answs(:,b), surf_usm_h%answs(:,b), &
7282	surf_def_v(0)%answs(:,b), surf_def_v(1)%answs(:,b), &
7283	surf_def_v(2)%answs(:,b), surf_def_v(3)%answs(:,b), &
7284	surf_lsm_v(0)%answs(:,b), surf_lsm_v(1)%answs(:,b), &
7285	surf_lsm_v(2)%answs(:,b), surf_lsm_v(3)%answs(:,b), &
7286	surf_usm_v(0)%answs(:,b), surf_usm_v(1)%answs(:,b), &
7287	surf_usm_v(2)%answs(:,b), surf_usm_v(3)%answs(:,b) )
7288	!
7289	!-- Sedimentation for aerosol number and mass
7290	IF ( lsdepo ) THEN
7291	tend(nzb+1:nzt,j,i) = tend(nzb+1:nzt,j,i) - MAX( 0.0_wp, &
7292	( rs(nzb+2:nzt+1,j,i) * sedim_vd(nzb+2:nzt+1,j,i,b) - &
7293	rs(nzb+1:nzt,j,i) * sedim_vd(nzb+1:nzt,j,i,b) ) * &
7294	ddzu(nzb+1:nzt) ) * MERGE( 1.0_wp, 0.0_wp, &
7295	BTEST( wall_flags_0(nzb:nzt-1,j,i), 0 ) )
7296	ENDIF
7297
7298	ELSEIF ( id == 'aerosol_mass' ) THEN
7299	CALL diffusion_s( i, j, rs, surf_def_h(0)%amsws(:,nc), &
7300	surf_def_h(1)%amsws(:,nc), surf_def_h(2)%amsws(:,nc), &
7301	surf_lsm_h%amsws(:,nc), surf_usm_h%amsws(:,nc), &
7302	surf_def_v(0)%amsws(:,nc), surf_def_v(1)%amsws(:,nc), &
7303	surf_def_v(2)%amsws(:,nc), surf_def_v(3)%amsws(:,nc), &
7304	surf_lsm_v(0)%amsws(:,nc), surf_lsm_v(1)%amsws(:,nc), &
7305	surf_lsm_v(2)%amsws(:,nc), surf_lsm_v(3)%amsws(:,nc), &
7306	surf_usm_v(0)%amsws(:,nc), surf_usm_v(1)%amsws(:,nc), &
7307	surf_usm_v(2)%amsws(:,nc), surf_usm_v(3)%amsws(:,nc) )
7308	!
7309	!-- Sedimentation for aerosol number and mass
7310	IF ( lsdepo ) THEN
7311	tend(nzb+1:nzt,j,i) = tend(nzb+1:nzt,j,i) - MAX( 0.0_wp, &
7312	( rs(nzb+2:nzt+1,j,i) * sedim_vd(nzb+2:nzt+1,j,i,b) - &
7313	rs(nzb+1:nzt,j,i) * sedim_vd(nzb+1:nzt,j,i,b) ) * &
7314	ddzu(nzb+1:nzt) ) * MERGE( 1.0_wp, 0.0_wp, &
7315	BTEST( wall_flags_0(nzb:nzt-1,j,i), 0 ) )
7316	ENDIF
7317	ELSEIF ( id == 'salsa_gas' ) THEN
7318	CALL diffusion_s( i, j, rs, surf_def_h(0)%gtsws(:,b), &
7319	surf_def_h(1)%gtsws(:,b), surf_def_h(2)%gtsws(:,b), &
7320	surf_lsm_h%gtsws(:,b), surf_usm_h%gtsws(:,b), &
7321	surf_def_v(0)%gtsws(:,b), surf_def_v(1)%gtsws(:,b), &
7322	surf_def_v(2)%gtsws(:,b), surf_def_v(3)%gtsws(:,b), &
7323	surf_lsm_v(0)%gtsws(:,b), surf_lsm_v(1)%gtsws(:,b), &
7324	surf_lsm_v(2)%gtsws(:,b), surf_lsm_v(3)%gtsws(:,b), &
7325	surf_usm_v(0)%gtsws(:,b), surf_usm_v(1)%gtsws(:,b), &
7326	surf_usm_v(2)%gtsws(:,b), surf_usm_v(3)%gtsws(:,b) )
7327	ENDIF
7328	!
7329	!-- Prognostic equation for a scalar
7330	DO k = nzb+1, nzt
7331	rs_p(k,j,i) = rs(k,j,i) + ( dt_3d * ( tsc(2) * tend(k,j,i) + &
7332	tsc(3) * trs_m(k,j,i) ) &
7333	- tsc(5) * rdf_sc(k) &
7334	* ( rs(k,j,i) - rs_init(k) ) ) &
7335	* MERGE( 1.0_wp, 0.0_wp, &
7336	BTEST( wall_flags_0(k,j,i), 0 ) )
7337	IF ( rs_p(k,j,i) < 0.0_wp ) rs_p(k,j,i) = 0.1_wp * rs(k,j,i)
7338	ENDDO
7339
7340	!
7341	!-- Calculate tendencies for the next Runge-Kutta step
7342	IF ( timestep_scheme(1:5) == 'runge' ) THEN
7343	IF ( intermediate_timestep_count == 1 ) THEN
7344	DO k = nzb+1, nzt
7345	trs_m(k,j,i) = tend(k,j,i)
7346	ENDDO
7347	ELSEIF ( intermediate_timestep_count < &
7348	intermediate_timestep_count_max ) THEN
7349	DO k = nzb+1, nzt
7350	trs_m(k,j,i) = -9.5625_wp * tend(k,j,i) + 5.3125_wp * trs_m(k,j,i)
7351	ENDDO
7352	ENDIF
7353	ENDIF
7354
7355	END SUBROUTINE salsa_tendency_ij
7356
7357	!
7358	!------------------------------------------------------------------------------!
7359	! Description:
7360	! ------------
7361	!> Calculate the tendencies for aerosol number and mass concentrations.
7362	!> Vector-optimized.
7363	!------------------------------------------------------------------------------!
7364	SUBROUTINE salsa_tendency( id, rs_p, rs, trs_m, b, c, rs_init )
7365
7366	USE advec_ws, &
7367	ONLY: advec_s_ws
7368	USE advec_s_pw_mod, &
7369	ONLY: advec_s_pw
7370	USE advec_s_up_mod, &
7371	ONLY: advec_s_up
7372	USE arrays_3d, &
7373	ONLY: ddzu, hyp, pt, rdf_sc, tend
7374	USE diffusion_s_mod, &
7375	ONLY: diffusion_s
7376	USE indices, &
7377	ONLY: wall_flags_0
7378	USE surface_mod, &
7379	ONLY : surf_def_h, surf_def_v, surf_lsm_h, surf_lsm_v, surf_usm_h, &
7380	surf_usm_v
7381
7382	IMPLICIT NONE
7383
7384	CHARACTER (LEN = *) :: id
7385	INTEGER(iwp) :: b !< bin index in derived type aerosol_size_bin
7386	INTEGER(iwp) :: c !< bin index in derived type aerosol_size_bin
7387	INTEGER(iwp) :: i !<
7388	INTEGER(iwp) :: j !<
7389	INTEGER(iwp) :: k !<
7390	INTEGER(iwp) :: nc !< (c-1)*nbins+b
7391	REAL(wp), DIMENSION(nzb:nzt+1) :: rs_init !<
7392	REAL(wp), DIMENSION(:,:,:), POINTER :: rs_p !<
7393	REAL(wp), DIMENSION(:,:,:), POINTER :: rs !<
7394	REAL(wp), DIMENSION(:,:,:), POINTER :: trs_m !<
7395
7396	nc = (c-1)*nbins+b
7397	!
7398	!-- Tendency-terms for reactive scalar
7399	tend = 0.0_wp
7400
7401	IF ( id == 'aerosol_number' .AND. lod_aero == 3 ) THEN
7402	tend = tend + aerosol_number(b)%source
7403	ELSEIF ( id == 'aerosol_mass' .AND. lod_aero == 3 ) THEN
7404	tend = tend + aerosol_mass(nc)%source
7405	ENDIF
7406	!
7407	!-- Advection terms
7408	IF ( timestep_scheme(1:5) == 'runge' ) THEN
7409	IF ( ws_scheme_sca ) THEN
7410	CALL advec_s_ws( rs, id )
7411	ELSE
7412	CALL advec_s_pw( rs )
7413	ENDIF
7414	ELSE
7415	CALL advec_s_up( rs )
7416	ENDIF
7417	!
7418	!-- Diffusion terms
7419	IF ( id == 'aerosol_number' ) THEN
7420	CALL diffusion_s( rs, surf_def_h(0)%answs(:,b), &
7421	surf_def_h(1)%answs(:,b), surf_def_h(2)%answs(:,b), &
7422	surf_lsm_h%answs(:,b), surf_usm_h%answs(:,b), &
7423	surf_def_v(0)%answs(:,b), surf_def_v(1)%answs(:,b), &
7424	surf_def_v(2)%answs(:,b), surf_def_v(3)%answs(:,b), &
7425	surf_lsm_v(0)%answs(:,b), surf_lsm_v(1)%answs(:,b), &
7426	surf_lsm_v(2)%answs(:,b), surf_lsm_v(3)%answs(:,b), &
7427	surf_usm_v(0)%answs(:,b), surf_usm_v(1)%answs(:,b), &
7428	surf_usm_v(2)%answs(:,b), surf_usm_v(3)%answs(:,b) )
7429	ELSEIF ( id == 'aerosol_mass' ) THEN
7430	CALL diffusion_s( rs, surf_def_h(0)%amsws(:,nc), &
7431	surf_def_h(1)%amsws(:,nc), surf_def_h(2)%amsws(:,nc), &
7432	surf_lsm_h%amsws(:,nc), surf_usm_h%amsws(:,nc), &
7433	surf_def_v(0)%amsws(:,nc), surf_def_v(1)%amsws(:,nc), &
7434	surf_def_v(2)%amsws(:,nc), surf_def_v(3)%amsws(:,nc), &
7435	surf_lsm_v(0)%amsws(:,nc), surf_lsm_v(1)%amsws(:,nc), &
7436	surf_lsm_v(2)%amsws(:,nc), surf_lsm_v(3)%amsws(:,nc), &
7437	surf_usm_v(0)%amsws(:,nc), surf_usm_v(1)%amsws(:,nc), &
7438	surf_usm_v(2)%amsws(:,nc), surf_usm_v(3)%amsws(:,nc) )
7439	ELSEIF ( id == 'salsa_gas' ) THEN
7440	CALL diffusion_s( rs, surf_def_h(0)%gtsws(:,b), &
7441	surf_def_h(1)%gtsws(:,b), surf_def_h(2)%gtsws(:,b), &
7442	surf_lsm_h%gtsws(:,b), surf_usm_h%gtsws(:,b), &
7443	surf_def_v(0)%gtsws(:,b), surf_def_v(1)%gtsws(:,b), &
7444	surf_def_v(2)%gtsws(:,b), surf_def_v(3)%gtsws(:,b), &
7445	surf_lsm_v(0)%gtsws(:,b), surf_lsm_v(1)%gtsws(:,b), &
7446	surf_lsm_v(2)%gtsws(:,b), surf_lsm_v(3)%gtsws(:,b), &
7447	surf_usm_v(0)%gtsws(:,b), surf_usm_v(1)%gtsws(:,b), &
7448	surf_usm_v(2)%gtsws(:,b), surf_usm_v(3)%gtsws(:,b) )
7449	ENDIF
7450	!
7451	!-- Prognostic equation for a scalar
7452	DO i = nxl, nxr
7453	DO j = nys, nyn
7454	IF ( id == 'salsa_gas' .AND. lod_gases == 3 ) THEN
7455	tend(:,j,i) = tend(:,j,i) + salsa_gas(b)%source(:,j,i) * &
7456	for_ppm_to_nconc * hyp(:) / pt(:,j,i) * ( hyp(:) / &
7457	100000.0_wp )**0.286_wp ! ppm to #/m3
7458	ELSEIF ( id == 'aerosol_mass' .OR. id == 'aerosol_number') THEN
7459	!
7460	!-- Sedimentation for aerosol number and mass
7461	IF ( lsdepo ) THEN
7462	tend(nzb+1:nzt,j,i) = tend(nzb+1:nzt,j,i) - MAX( 0.0_wp, &
7463	( rs(nzb+2:nzt+1,j,i) * sedim_vd(nzb+2:nzt+1,j,i,b) - &
7464	rs(nzb+1:nzt,j,i) * sedim_vd(nzb+1:nzt,j,i,b) ) * &
7465	ddzu(nzb+1:nzt) ) * MERGE( 1.0_wp, 0.0_wp, &
7466	BTEST( wall_flags_0(nzb:nzt-1,j,i), 0 ) )
7467	ENDIF
7468	ENDIF
7469	DO k = nzb+1, nzt
7470	rs_p(k,j,i) = rs(k,j,i) + ( dt_3d * ( tsc(2) * tend(k,j,i) + &
7471	tsc(3) * trs_m(k,j,i) ) &
7472	- tsc(5) * rdf_sc(k) &
7473	* ( rs(k,j,i) - rs_init(k) ) )&
7474	* MERGE( 1.0_wp, 0.0_wp, &
7475	BTEST( wall_flags_0(k,j,i), 0 ) )
7476	IF ( rs_p(k,j,i) < 0.0_wp ) rs_p(k,j,i) = 0.1_wp * rs(k,j,i)
7477	ENDDO
7478	ENDDO
7479	ENDDO
7480
7481	!
7482	!-- Calculate tendencies for the next Runge-Kutta step
7483	IF ( timestep_scheme(1:5) == 'runge' ) THEN
7484	IF ( intermediate_timestep_count == 1 ) THEN
7485	DO i = nxl, nxr
7486	DO j = nys, nyn
7487	DO k = nzb+1, nzt
7488	trs_m(k,j,i) = tend(k,j,i)
7489	ENDDO
7490	ENDDO
7491	ENDDO
7492	ELSEIF ( intermediate_timestep_count < &
7493	intermediate_timestep_count_max ) THEN
7494	DO i = nxl, nxr
7495	DO j = nys, nyn
7496	DO k = nzb+1, nzt
7497	trs_m(k,j,i) = -9.5625_wp * tend(k,j,i) &
7498	+ 5.3125_wp * trs_m(k,j,i)
7499	ENDDO
7500	ENDDO
7501	ENDDO
7502	ENDIF
7503	ENDIF
7504
7505	END SUBROUTINE salsa_tendency
7506
7507	!------------------------------------------------------------------------------!
7508	! Description:
7509	! ------------
7510	!> Boundary conditions for prognostic variables in SALSA
7511	!------------------------------------------------------------------------------!
7512	SUBROUTINE salsa_boundary_conds
7513
7514	USE surface_mod, &
7515	ONLY : bc_h
7516
7517	IMPLICIT NONE
7518
7519	INTEGER(iwp) :: b !< index for aerosol size bins
7520	INTEGER(iwp) :: c !< index for chemical compounds in aerosols
7521	INTEGER(iwp) :: g !< idex for gaseous compounds
7522	INTEGER(iwp) :: i !< grid index x direction
7523	INTEGER(iwp) :: j !< grid index y direction
7524	INTEGER(iwp) :: k !< grid index y direction
7525	INTEGER(iwp) :: kb !< variable to set respective boundary value, depends on
7526	!< facing.
7527	INTEGER(iwp) :: l !< running index boundary type, for up- and downward-
7528	!< facing walls
7529	INTEGER(iwp) :: m !< running index surface elements
7530
7531	!
7532	!-- Surface conditions:
7533	IF ( ibc_salsa_b == 0 ) THEN ! Dirichlet
7534	!
7535	!-- Run loop over all non-natural and natural walls. Note, in wall-datatype
7536	!-- the k coordinate belongs to the atmospheric grid point, therefore, set
7537	!-- s_p at k-1
7538
7539	DO l = 0, 1
7540	!
7541	!-- Set kb, for upward-facing surfaces value at topography top (k-1) is
7542	!-- set, for downward-facing surfaces at topography bottom (k+1)
7543	kb = MERGE ( -1, 1, l == 0 )
7544	!$OMP PARALLEL PRIVATE( b, c, g, i, j, k )
7545	!$OMP DO
7546	DO m = 1, bc_h(l)%ns
7547
7548	i = bc_h(l)%i(m)
7549	j = bc_h(l)%j(m)
7550	k = bc_h(l)%k(m)
7551
7552	DO b = 1, nbins
7553	aerosol_number(b)%conc_p(k+kb,j,i) = &
7554	aerosol_number(b)%conc(k+kb,j,i)
7555	DO c = 1, ncc_tot
7556	aerosol_mass((c-1)*nbins+b)%conc_p(k+kb,j,i) = &
7557	aerosol_mass((c-1)*nbins+b)%conc(k+kb,j,i)
7558	ENDDO
7559	ENDDO
7560	IF ( .NOT. salsa_gases_from_chem ) THEN
7561	DO g = 1, ngast
7562	salsa_gas(g)%conc_p(k+kb,j,i) = salsa_gas(g)%conc(k+kb,j,i)
7563	ENDDO
7564	ENDIF
7565
7566	ENDDO
7567	!$OMP END PARALLEL
7568
7569	ENDDO
7570
7571	ELSE ! Neumann
7572
7573	DO l = 0, 1
7574	!
7575	!-- Set kb, for upward-facing surfaces value at topography top (k-1) is
7576	!-- set, for downward-facing surfaces at topography bottom (k+1)
7577	kb = MERGE( -1, 1, l == 0 )
7578	!$OMP PARALLEL PRIVATE( b, c, g, i, j, k )
7579	!$OMP DO
7580	DO m = 1, bc_h(l)%ns
7581
7582	i = bc_h(l)%i(m)
7583	j = bc_h(l)%j(m)
7584	k = bc_h(l)%k(m)
7585
7586	DO b = 1, nbins
7587	aerosol_number(b)%conc_p(k+kb,j,i) = &
7588	aerosol_number(b)%conc_p(k,j,i)
7589	DO c = 1, ncc_tot
7590	aerosol_mass((c-1)*nbins+b)%conc_p(k+kb,j,i) = &
7591	aerosol_mass((c-1)*nbins+b)%conc_p(k,j,i)
7592	ENDDO
7593	ENDDO
7594	IF ( .NOT. salsa_gases_from_chem ) THEN
7595	DO g = 1, ngast
7596	salsa_gas(g)%conc_p(k+kb,j,i) = salsa_gas(g)%conc_p(k,j,i)
7597	ENDDO
7598	ENDIF
7599
7600	ENDDO
7601	!$OMP END PARALLEL
7602	ENDDO
7603
7604	ENDIF
7605
7606	!
7607	!--Top boundary conditions:
7608	IF ( ibc_salsa_t == 0 ) THEN ! Dirichlet
7609
7610	DO b = 1, nbins
7611	aerosol_number(b)%conc_p(nzt+1,:,:) = &
7612	aerosol_number(b)%conc(nzt+1,:,:)
7613	DO c = 1, ncc_tot
7614	aerosol_mass((c-1)*nbins+b)%conc_p(nzt+1,:,:) = &
7615	aerosol_mass((c-1)*nbins+b)%conc(nzt+1,:,:)
7616	ENDDO
7617	ENDDO
7618	IF ( .NOT. salsa_gases_from_chem ) THEN
7619	DO g = 1, ngast
7620	salsa_gas(g)%conc_p(nzt+1,:,:) = salsa_gas(g)%conc(nzt+1,:,:)
7621	ENDDO
7622	ENDIF
7623
7624	ELSEIF ( ibc_salsa_t == 1 ) THEN ! Neumann
7625
7626	DO b = 1, nbins
7627	aerosol_number(b)%conc_p(nzt+1,:,:) = &
7628	aerosol_number(b)%conc_p(nzt,:,:)
7629	DO c = 1, ncc_tot
7630	aerosol_mass((c-1)*nbins+b)%conc_p(nzt+1,:,:) = &
7631	aerosol_mass((c-1)*nbins+b)%conc_p(nzt,:,:)
7632	ENDDO
7633	ENDDO
7634	IF ( .NOT. salsa_gases_from_chem ) THEN
7635	DO g = 1, ngast
7636	salsa_gas(g)%conc_p(nzt+1,:,:) = salsa_gas(g)%conc_p(nzt,:,:)
7637	ENDDO
7638	ENDIF
7639
7640	ENDIF
7641	!
7642	!-- Lateral boundary conditions at the outflow
7643	IF ( bc_radiation_s ) THEN
7644	DO b = 1, nbins
7645	aerosol_number(b)%conc_p(:,nys-1,:) = aerosol_number(b)%conc_p(:,nys,:)
7646	DO c = 1, ncc_tot
7647	aerosol_mass((c-1)*nbins+b)%conc_p(:,nys-1,:) = &
7648	aerosol_mass((c-1)*nbins+b)%conc_p(:,nys,:)
7649	ENDDO
7650	ENDDO
7651	ELSEIF ( bc_radiation_n ) THEN
7652	DO b = 1, nbins
7653	aerosol_number(b)%conc_p(:,nyn+1,:) = aerosol_number(b)%conc_p(:,nyn,:)
7654	DO c = 1, ncc_tot
7655	aerosol_mass((c-1)*nbins+b)%conc_p(:,nyn+1,:) = &
7656	aerosol_mass((c-1)*nbins+b)%conc_p(:,nyn,:)
7657	ENDDO
7658	ENDDO
7659	ELSEIF ( bc_radiation_l ) THEN
7660	DO b = 1, nbins
7661	aerosol_number(b)%conc_p(:,nxl-1,:) = aerosol_number(b)%conc_p(:,nxl,:)
7662	DO c = 1, ncc_tot
7663	aerosol_mass((c-1)*nbins+b)%conc_p(:,nxl-1,:) = &
7664	aerosol_mass((c-1)*nbins+b)%conc_p(:,nxl,:)
7665	ENDDO
7666	ENDDO
7667	ELSEIF ( bc_radiation_r ) THEN
7668	DO b = 1, nbins
7669	aerosol_number(b)%conc_p(:,nxr+1,:) = aerosol_number(b)%conc_p(:,nxr,:)
7670	DO c = 1, ncc_tot
7671	aerosol_mass((c-1)*nbins+b)%conc_p(:,nxr+1,:) = &
7672	aerosol_mass((c-1)*nbins+b)%conc_p(:,nxr,:)
7673	ENDDO
7674	ENDDO
7675	ENDIF
7676
7677	END SUBROUTINE salsa_boundary_conds
7678
7679	!------------------------------------------------------------------------------!
7680	! Description:
7681	! ------------
7682	! Undoing of the previously done cyclic boundary conditions.
7683	!------------------------------------------------------------------------------!
7684	SUBROUTINE salsa_boundary_conds_decycle ( sq, sq_init )
7685
7686	IMPLICIT NONE
7687
7688	INTEGER(iwp) :: boundary !<
7689	INTEGER(iwp) :: ee !<
7690	INTEGER(iwp) :: copied !<
7691	INTEGER(iwp) :: i !<
7692	INTEGER(iwp) :: j !<
7693	INTEGER(iwp) :: k !<
7694	INTEGER(iwp) :: ss !<
7695	REAL(wp), DIMENSION(nzb:nzt+1) :: sq_init
7696	REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) :: sq
7697	REAL(wp) :: flag !< flag to mask topography grid points
7698
7699	flag = 0.0_wp
7700	!
7701	!-- Left and right boundaries
7702	IF ( decycle_lr .AND. ( bc_lr_cyc .OR. bc_lr == 'nested' ) ) THEN
7703
7704	DO boundary = 1, 2
7705
7706	IF ( decycle_method(boundary) == 'dirichlet' ) THEN
7707	!
7708	!-- Initial profile is copied to ghost and first three layers
7709	ss = 1
7710	ee = 0
7711	IF ( boundary == 1 .AND. nxl == 0 ) THEN
7712	ss = nxlg
7713	ee = nxl+2
7714	ELSEIF ( boundary == 2 .AND. nxr == nx ) THEN
7715	ss = nxr-2
7716	ee = nxrg
7717	ENDIF
7718
7719	DO i = ss, ee
7720	DO j = nysg, nyng
7721	DO k = nzb+1, nzt
7722	flag = MERGE( 1.0_wp, 0.0_wp, &
7723	BTEST( wall_flags_0(k,j,i), 0 ) )
7724	sq(k,j,i) = sq_init(k) * flag
7725	ENDDO
7726	ENDDO
7727	ENDDO
7728
7729	ELSEIF ( decycle_method(boundary) == 'neumann' ) THEN
7730	!
7731	!-- The value at the boundary is copied to the ghost layers to simulate
7732	!-- an outlet with zero gradient
7733	ss = 1
7734	ee = 0
7735	IF ( boundary == 1 .AND. nxl == 0 ) THEN
7736	ss = nxlg
7737	ee = nxl-1
7738	copied = nxl
7739	ELSEIF ( boundary == 2 .AND. nxr == nx ) THEN
7740	ss = nxr+1
7741	ee = nxrg
7742	copied = nxr
7743	ENDIF
7744
7745	DO i = ss, ee
7746	DO j = nysg, nyng
7747	DO k = nzb+1, nzt
7748	flag = MERGE( 1.0_wp, 0.0_wp, &
7749	BTEST( wall_flags_0(k,j,i), 0 ) )
7750	sq(k,j,i) = sq(k,j,copied) * flag
7751	ENDDO
7752	ENDDO
7753	ENDDO
7754
7755	ELSE
7756	WRITE(message_string,*) &
7757	'unknown decycling method: decycle_method (', &
7758	boundary, ') ="' // TRIM( decycle_method(boundary) ) // '"'
7759	CALL message( 'salsa_boundary_conds_decycle', 'SA0029', &
7760	1, 2, 0, 6, 0 )
7761	ENDIF
7762	ENDDO
7763	ENDIF
7764
7765	!
7766	!-- South and north boundaries
7767	IF ( decycle_ns .AND. ( bc_ns_cyc .OR. bc_ns == 'nested' ) ) THEN
7768
7769	DO boundary = 3, 4
7770
7771	IF ( decycle_method(boundary) == 'dirichlet' ) THEN
7772	!
7773	!-- Initial profile is copied to ghost and first three layers
7774	ss = 1
7775	ee = 0
7776	IF ( boundary == 3 .AND. nys == 0 ) THEN
7777	ss = nysg
7778	ee = nys+2
7779	ELSEIF ( boundary == 4 .AND. nyn == ny ) THEN
7780	ss = nyn-2
7781	ee = nyng
7782	ENDIF
7783
7784	DO i = nxlg, nxrg
7785	DO j = ss, ee
7786	DO k = nzb+1, nzt
7787	flag = MERGE( 1.0_wp, 0.0_wp, &
7788	BTEST( wall_flags_0(k,j,i), 0 ) )
7789	sq(k,j,i) = sq_init(k) * flag
7790	ENDDO
7791	ENDDO
7792	ENDDO
7793
7794	ELSEIF ( decycle_method(boundary) == 'neumann' ) THEN
7795	!
7796	!-- The value at the boundary is copied to the ghost layers to simulate
7797	!-- an outlet with zero gradient
7798	ss = 1
7799	ee = 0
7800	IF ( boundary == 3 .AND. nys == 0 ) THEN
7801	ss = nysg
7802	ee = nys-1
7803	copied = nys
7804	ELSEIF ( boundary == 4 .AND. nyn == ny ) THEN
7805	ss = nyn+1
7806	ee = nyng
7807	copied = nyn
7808	ENDIF
7809
7810	DO i = nxlg, nxrg
7811	DO j = ss, ee
7812	DO k = nzb+1, nzt
7813	flag = MERGE( 1.0_wp, 0.0_wp, &
7814	BTEST( wall_flags_0(k,j,i), 0 ) )
7815	sq(k,j,i) = sq(k,copied,i) * flag
7816	ENDDO
7817	ENDDO
7818	ENDDO
7819
7820	ELSE
7821	WRITE(message_string,*) &
7822	'unknown decycling method: decycle_method (', &
7823	boundary, ') ="' // TRIM( decycle_method(boundary) ) // '"'
7824	CALL message( 'salsa_boundary_conds_decycle', 'SA0030', &
7825	1, 2, 0, 6, 0 )
7826	ENDIF
7827	ENDDO
7828	ENDIF
7829
7830	END SUBROUTINE salsa_boundary_conds_decycle
7831
7832	!------------------------------------------------------------------------------!
7833	! Description:
7834	! ------------
7835	!> Calculates the total dry or wet mass concentration for individual bins
7836	!> Juha Tonttila (FMI) 2015
7837	!> Tomi Raatikainen (FMI) 2016
7838	!------------------------------------------------------------------------------!
7839	SUBROUTINE bin_mixrat( itype, ibin, i, j, mconc )
7840
7841	IMPLICIT NONE
7842
7843	CHARACTER(len=*), INTENT(in) :: itype !< 'dry' or 'wet'
7844	INTEGER(iwp), INTENT(in) :: ibin !< index of the chemical component
7845	INTEGER(iwp), INTENT(in) :: i !< loop index for x-direction
7846	INTEGER(iwp), INTENT(in) :: j !< loop index for y-direction
7847	REAL(wp), DIMENSION(:), INTENT(out) :: mconc !< total dry or wet mass
7848	!< concentration
7849
7850	INTEGER(iwp) :: c !< loop index for mass bin number
7851	INTEGER(iwp) :: iend !< end index: include water or not
7852
7853	!-- Number of components
7854	IF ( itype == 'dry' ) THEN
7855	iend = get_n_comp( prtcl ) - 1
7856	ELSE IF ( itype == 'wet' ) THEN
7857	iend = get_n_comp( prtcl )
7858	ELSE
7859	STOP 'bin_mixrat: Error in itype'
7860	ENDIF
7861
7862	mconc = 0.0_wp
7863
7864	DO c = ibin, iend*nbins+ibin, nbins !< every nbins'th element
7865	mconc = mconc + aerosol_mass(c)%conc(:,j,i)
7866	ENDDO
7867
7868	END SUBROUTINE bin_mixrat
7869
7870	!------------------------------------------------------------------------------!
7871	!> Description:
7872	!> ------------
7873	!> Define aerosol fluxes: constant or read from a from file
7874	!------------------------------------------------------------------------------!
7875	SUBROUTINE salsa_set_source
7876
7877	! USE date_and_time_mod, &
7878	! ONLY: index_dd, index_hh, index_mm
7879	#if defined( __netcdf )
7880	USE NETCDF
7881
7882	USE netcdf_data_input_mod, &
7883	ONLY: get_attribute, get_variable, &
7884	netcdf_data_input_get_dimension_length, open_read_file
7885
7886	USE surface_mod, &
7887	ONLY: surf_def_h, surf_lsm_h, surf_usm_h
7888
7889	IMPLICIT NONE
7890
7891	INTEGER(iwp), PARAMETER :: ndm = 3 !< number of default modes
7892	INTEGER(iwp), PARAMETER :: ndc = 4 !< number of default categories
7893
7894	CHARACTER (LEN=10) :: unita !< Unit of aerosol fluxes
7895	CHARACTER (LEN=10) :: unitg !< Unit of gaseous fluxes
7896	INTEGER(iwp) :: b !< loop index: aerosol number bins
7897	INTEGER(iwp) :: c !< loop index: aerosol chemical components
7898	INTEGER(iwp) :: ee !< loop index: end
7899	INTEGER(iwp), ALLOCATABLE, DIMENSION(:) :: eci !< emission category index
7900	INTEGER(iwp) :: g !< loop index: gaseous tracers
7901	INTEGER(iwp) :: i !< loop index: x-direction
7902	INTEGER(iwp) :: id_faero !< NetCDF id of aerosol source input file
7903	INTEGER(iwp) :: id_fchem !< NetCDF id of aerosol source input file
7904	INTEGER(iwp) :: id_sa !< NetCDF id of variable: source
7905	INTEGER(iwp) :: j !< loop index: y-direction
7906	INTEGER(iwp) :: k !< loop index: z-direction
7907	INTEGER(iwp) :: kg !< loop index: z-direction (gases)
7908	INTEGER(iwp) :: n_dt !< number of time steps in the emission file
7909	INTEGER(iwp) :: nc_stat !< local variable for storing the result of
7910	!< netCDF calls for error message handling
7911	INTEGER(iwp) :: nb_file !< Number of grid-points in file (bins)
7912	INTEGER(iwp) :: ncat !< Number of emission categories
7913	INTEGER(iwp) :: ng_file !< Number of grid-points in file (gases)
7914	INTEGER(iwp) :: num_vars !< number of variables in input file
7915	INTEGER(iwp) :: nz_file !< number of grid-points in file
7916	INTEGER(iwp) :: n !< loop index
7917	INTEGER(iwp) :: ni !< loop index
7918	INTEGER(iwp) :: ss !< loop index
7919	LOGICAL :: netcdf_extend = .FALSE. !< Flag indicating wether netcdf
7920	!< topography input file or not
7921	REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:) :: dum_var_4d !< variable for
7922	!< temporary data
7923	REAL(wp) :: fillval !< fill value
7924	REAL(wp) :: flag !< flag to mask topography grid points
7925	REAL(wp), DIMENSION(nbins) :: nsect_emission !< sectional emission (lod1)
7926	REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: pm_emission !< aerosol mass
7927	!< emission (lod1)
7928	REAL(wp), DIMENSION(nbins) :: source_ijka !< aerosol source at (k,j,i)
7929	!
7930	!-- The default size distribution and mass composition per emission category:
7931	!-- 1 = traffic, 2 = road dust, 3 = wood combustion, 4 = other
7932	!-- Mass fractions: H2SO4, OC, BC, DU, SS, HNO3, NH3
7933	CHARACTER(LEN=15), DIMENSION(ndc) :: cat_name_table = &!< emission category
7934	(/'road traffic ','road dust ',&
7935	'wood combustion','other '/)
7936	REAL(wp), DIMENSION(ndc) :: avg_density !< average density
7937	REAL(wp), DIMENSION(ndc) :: conversion_factor !< unit conversion factor
7938	!< for aerosol emissions
7939	REAL(wp), DIMENSION(ndm), PARAMETER :: dpg_table = & !< mean diameter (mum)
7940	(/ 13.5E-3_wp, 1.4_wp, 5.4E-2_wp/)
7941	REAL(wp), DIMENSION(ndm) :: ntot_table
7942	REAL(wp), DIMENSION(maxspec,ndc), PARAMETER :: mass_fraction_table = &
7943	RESHAPE( (/ 0.04_wp, 0.48_wp, 0.48_wp, 0.0_wp, 0.0_wp, 0.0_wp, 0.0_wp, &
7944	0.0_wp, 0.05_wp, 0.0_wp, 0.95_wp, 0.0_wp, 0.0_wp, 0.0_wp, &
7945	0.0_wp, 0.5_wp, 0.5_wp, 0.0_wp, 0.0_wp, 0.0_wp, 0.0_wp, &
7946	0.0_wp, 0.5_wp, 0.5_wp, 0.0_wp, 0.0_wp, 0.0_wp, 0.0_wp &
7947	/), (/maxspec,ndc/) )
7948	REAL(wp), DIMENSION(ndm,ndc), PARAMETER :: PMfrac_table = & !< rel. mass
7949	RESHAPE( (/ 0.016_wp, 0.000_wp, 0.984_wp, &
7950	0.000_wp, 1.000_wp, 0.000_wp, &
7951	0.000_wp, 0.000_wp, 1.000_wp, &
7952	1.000_wp, 0.000_wp, 1.000_wp &
7953	/), (/ndm,ndc/) )
7954	REAL(wp), DIMENSION(ndm), PARAMETER :: sigmag_table = & !< mode std
7955	(/1.6_wp, 1.4_wp, 1.7_wp/)
7956	avg_density = 1.0_wp
7957	nb_file = 0
7958	ng_file = 0
7959	nsect_emission = 0.0_wp
7960	nz_file = 0
7961	source_ijka = 0.0_wp
7962	!
7963	!-- First gases, if needed:
7964	IF ( .NOT. salsa_gases_from_chem ) THEN
7965	!
7966	!-- Read sources from PIDS_CHEM
7967	INQUIRE( FILE='PIDS_CHEM' // TRIM( coupling_char ), EXIST=netcdf_extend )
7968	IF ( .NOT. netcdf_extend ) THEN
7969	message_string = 'Input file '// TRIM( 'PIDS_CHEM' ) // &
7970	TRIM( coupling_char ) // ' for SALSA missing!'
7971	CALL message( 'salsa_mod: salsa_set_source', 'SA0027', 1, 2, 0, 6, 0 )
7972	ENDIF ! netcdf_extend
7973
7974	CALL location_message( ' salsa_set_source: NOTE! Gaseous emissions'//&
7975	' should be provided with following emission indices:'// &
7976	' 1=H2SO4, 2=HNO3, 3=NH3, 4=OCNV, 5=OCSV', .TRUE. )
7977	CALL location_message( ' salsa_set_source: No time dependency for '//&
7978	'gaseous emissions. Use emission_values '// &
7979	'directly.', .TRUE. )
7980	!
7981	!-- Open PIDS_CHEM in read-only mode
7982	CALL open_read_file( 'PIDS_CHEM' // TRIM( coupling_char ), id_fchem )
7983	!
7984	!-- Inquire the level of detail (lod)
7985	CALL get_attribute( id_fchem, 'lod', lod_gases, .FALSE., &
7986	"emission_values" )
7987
7988	IF ( lod_gases == 2 ) THEN
7989	!
7990	!-- Index of gaseous compounds
7991	CALL netcdf_data_input_get_dimension_length( id_fchem, ng_file, &
7992	"nspecies" )
7993	IF ( ng_file < 5 ) THEN
7994	message_string = 'Some gaseous emissions missing.'
7995	CALL message( 'salsa_mod: salsa_set_source', 'SA0041', &
7996	1, 2, 0, 6, 0 )
7997	ENDIF
7998	!
7999	!-- Get number of emission categories
8000	CALL netcdf_data_input_get_dimension_length( id_fchem, ncat, "ncat" )
8001	!
8002	!-- Inquire the unit of gaseous fluxes
8003	CALL get_attribute( id_fchem, 'units', unitg, .FALSE., &
8004	"emission_values")
8005	!
8006	!-- Inquire the fill value
8007	CALL get_attribute( id_fchem, '_FillValue', fillval, .FALSE., &
8008	"emission_values" )
8009	!
8010	!-- Read surface emission data (x,y) PE-wise
8011	ALLOCATE( dum_var_4d(ng_file,ncat,nys:nyn,nxl:nxr) )
8012	CALL get_variable( id_fchem, 'emission_values', dum_var_4d, nxl, nxr,&
8013	nys, nyn, 0, ncat-1, 0, ng_file-1 )
8014	DO g = 1, ngast
8015	ALLOCATE( salsa_gas(g)%source(ncat,nys:nyn,nxl:nxr) )
8016	salsa_gas(g)%source = 0.0_wp
8017	salsa_gas(g)%source = salsa_gas(g)%source + dum_var_4d(g,:,:,:)
8018	ENDDO
8019	!
8020	!-- Set surface fluxes of gaseous compounds on horizontal surfaces.
8021	!-- Set fluxes only for either default, land or urban surface.
8022	IF ( .NOT. land_surface .AND. .NOT. urban_surface ) THEN
8023	CALL set_gas_flux( surf_def_h(0), ncat, unitg )
8024	ELSE
8025	CALL set_gas_flux( surf_lsm_h, ncat, unitg )
8026	CALL set_gas_flux( surf_usm_h, ncat, unitg )
8027	ENDIF
8028
8029	DEALLOCATE( dum_var_4d )
8030	DO g = 1, ngast
8031	DEALLOCATE( salsa_gas(g)%source )
8032	ENDDO
8033	ELSE
8034	message_string = 'Input file PIDS_CHEM needs to have lod = 2 when '//&
8035	'SALSA is applied but not the chemistry module!'
8036	CALL message( 'salsa_mod: salsa_set_source', 'SA0039', 1, 2, 0, 6, 0 )
8037	ENDIF
8038	ENDIF
8039	!
8040	!-- Read sources from PIDS_SALSA
8041	INQUIRE( FILE='PIDS_SALSA' // TRIM( coupling_char ), EXIST=netcdf_extend )
8042	IF ( .NOT. netcdf_extend ) THEN
8043	message_string = 'Input file '// TRIM( 'PIDS_SALSA' ) // &
8044	TRIM( coupling_char ) // ' for SALSA missing!'
8045	CALL message( 'salsa_mod: salsa_set_source', 'SA0034', 1, 2, 0, 6, 0 )
8046	ENDIF ! netcdf_extend
8047	!
8048	!-- Open file in read-only mode
8049	CALL open_read_file( 'PIDS_SALSA' // TRIM( coupling_char ), id_faero )
8050	!
8051	!-- Get number of emission categories and their indices
8052	CALL netcdf_data_input_get_dimension_length( id_faero, ncat, "ncat" )
8053	!
8054	!-- Get emission category indices
8055	ALLOCATE( eci(1:ncat) )
8056	CALL get_variable( id_faero, 'emission_category_index', eci )
8057	!
8058	!-- Inquire the level of detail (lod)
8059	CALL get_attribute( id_faero, 'lod', lod_aero, .FALSE., &
8060	"aerosol_emission_values" )
8061
8062	IF ( lod_aero < 3 .AND. ibc_salsa_b == 0 ) THEN
8063	message_string = 'lod1/2 for aerosol emissions requires '// &
8064	'bc_salsa_b = "Neumann"'
8065	CALL message( 'salsa_mod: salsa_set_source','SA0025', 1, 2, 0, 6, 0 )
8066	ENDIF
8067	!
8068	!-- Inquire the fill value
8069	CALL get_attribute( id_faero, '_FillValue', fillval, .FALSE., &
8070	"aerosol_emission_values" )
8071	!
8072	!-- Aerosol chemical composition:
8073	ALLOCATE( emission_mass_fracs(1:ncat,1:maxspec) )
8074	emission_mass_fracs = 0.0_wp
8075	!-- Chemical composition: 1: H2SO4 (sulphuric acid), 2: OC (organic carbon),
8076	!-- 3: BC (black carbon), 4: DU (dust),
8077	!-- 5: SS (sea salt), 6: HNO3 (nitric acid),
8078	!-- 7: NH3 (ammonia)
8079	DO n = 1, ncat
8080	IF ( lod_aero < 2 ) THEN
8081	emission_mass_fracs(n,:) = mass_fraction_table(:,n)
8082	ELSE
8083	CALL get_variable( id_faero, "emission_mass_fracs", &
8084	emission_mass_fracs(n,:) )
8085	ENDIF
8086	!
8087	!-- If the chemical component is not activated, set its mass fraction to 0
8088	!-- to avoid inbalance between number and mass flux
8089	IF ( iso4 < 0 ) emission_mass_fracs(n,1) = 0.0_wp
8090	IF ( ioc < 0 ) emission_mass_fracs(n,2) = 0.0_wp
8091	IF ( ibc < 0 ) emission_mass_fracs(n,3) = 0.0_wp
8092	IF ( idu < 0 ) emission_mass_fracs(n,4) = 0.0_wp
8093	IF ( iss < 0 ) emission_mass_fracs(n,5) = 0.0_wp
8094	IF ( ino < 0 ) emission_mass_fracs(n,6) = 0.0_wp
8095	IF ( inh < 0 ) emission_mass_fracs(n,7) = 0.0_wp
8096	!-- Then normalise the mass fraction so that SUM = 1
8097	emission_mass_fracs(n,:) = emission_mass_fracs(n,:) / &
8098	SUM( emission_mass_fracs(n,:) )
8099	ENDDO
8100
8101	IF ( lod_aero > 1 ) THEN
8102	!
8103	!-- Aerosol geometric mean diameter
8104	CALL netcdf_data_input_get_dimension_length( id_faero, nb_file, 'Dmid' )
8105	IF ( nb_file /= nbins ) THEN
8106	message_string = 'The number of size bins in aerosol input data '// &
8107	'does not correspond to the model set-up'
8108	CALL message( 'salsa_mod: salsa_set_source','SA0040', 1, 2, 0, 6, 0 )
8109	ENDIF
8110	ENDIF
8111
8112	IF ( lod_aero < 3 ) THEN
8113	CALL location_message( ' salsa_set_source: No time dependency for '//&
8114	'aerosol emissions. Use aerosol_emission_values'//&
8115	' directly.', .TRUE. )
8116	!
8117	!-- Allocate source arrays
8118	DO b = 1, nbins
8119	ALLOCATE( aerosol_number(b)%source(1:ncat,nys:nyn,nxl:nxr) )
8120	aerosol_number(b)%source = 0.0_wp
8121	ENDDO
8122	DO c = 1, ncc_tot*nbins
8123	ALLOCATE( aerosol_mass(c)%source(1:ncat,nys:nyn,nxl:nxr) )
8124	aerosol_mass(c)%source = 0.0_wp
8125	ENDDO
8126
8127	IF ( lod_aero == 1 ) THEN
8128	DO n = 1, ncat
8129	avg_density(n) = emission_mass_fracs(n,1) * arhoh2so4 + &
8130	emission_mass_fracs(n,2) * arhooc + &
8131	emission_mass_fracs(n,3) * arhobc + &
8132	emission_mass_fracs(n,4) * arhodu + &
8133	emission_mass_fracs(n,5) * arhoss + &
8134	emission_mass_fracs(n,6) * arhohno3 + &
8135	emission_mass_fracs(n,7) * arhonh3
8136	ENDDO
8137	!
8138	!-- Emission unit
8139	CALL get_attribute( id_faero, 'units', unita, .FALSE., &
8140	"aerosol_emission_values")
8141	conversion_factor = 1.0_wp
8142	IF ( unita == 'kg/m2/yr' ) THEN
8143	conversion_factor = 3.170979e-8_wp / avg_density
8144	ELSEIF ( unita == 'g/m2/yr' ) THEN
8145	conversion_factor = 3.170979e-8_wp * 1.0E-3_wp / avg_density
8146	ELSEIF ( unita == 'kg/m2/s' ) THEN
8147	conversion_factor = 1.0_wp / avg_density
8148	ELSEIF ( unita == 'g/m2/s' ) THEN
8149	conversion_factor = 1.0E-3_wp / avg_density
8150	ELSE
8151	message_string = 'unknown unit for aerosol emissions: ' &
8152	// TRIM( unita ) // ' (lod1)'
8153	CALL message( 'salsa_mod: salsa_set_source','SA0035', &
8154	1, 2, 0, 6, 0 )
8155	ENDIF
8156	!
8157	!-- Read surface emission data (x,y) PE-wise
8158	ALLOCATE( pm_emission(ncat,nys:nyn,nxl:nxr) )
8159	CALL get_variable( id_faero, 'aerosol_emission_values', pm_emission, &
8160	nxl, nxr, nys, nyn, 0, ncat-1 )
8161	DO ni = 1, SIZE( eci )
8162	n = eci(ni)
8163	!
8164	!-- Calculate the number concentration of a log-normal size
8165	!-- distribution following Jacobson (2005): Eq 13.25.
8166	ntot_table = 6.0_wp * PMfrac_table(:,n) / ( pi * dpg_table*3 &
8167	EXP( 4.5_wp * LOG( sigmag_table )*2 ) ) 1.0E+12_wp
8168	!
8169	!-- Sectional size distibution from a log-normal one
8170	CALL size_distribution( ntot_table, dpg_table, sigmag_table, &
8171	nsect_emission )
8172	DO b = 1, nbins
8173	aerosol_number(b)%source(ni,:,:) = &
8174	aerosol_number(b)%source(ni,:,:) + &
8175	pm_emission(ni,:,:) * conversion_factor(n) &
8176	* nsect_emission(b)
8177	ENDDO
8178	ENDDO
8179	ELSEIF ( lod_aero == 2 ) THEN
8180	!
8181	!-- Read surface emission data (x,y) PE-wise
8182	ALLOCATE( dum_var_4d(nb_file,ncat,nys:nyn,nxl:nxr) )
8183	CALL get_variable( id_faero, 'aerosol_emission_values', dum_var_4d, &
8184	nxl, nxr, nys, nyn, 0, ncat-1, 0, nb_file-1 )
8185	DO b = 1, nbins
8186	aerosol_number(b)%source = dum_var_4d(b,:,:,:)
8187	ENDDO
8188	DEALLOCATE( dum_var_4d )
8189	ENDIF
8190	!
8191	!-- Set surface fluxes of aerosol number and mass on horizontal surfaces.
8192	!-- Set fluxes only for either default, land or urban surface.
8193	IF ( .NOT. land_surface .AND. .NOT. urban_surface ) THEN
8194	CALL set_flux( surf_def_h(0), ncat )
8195	ELSE
8196	CALL set_flux( surf_usm_h, ncat )
8197	CALL set_flux( surf_lsm_h, ncat )
8198	ENDIF
8199
8200	ELSEIF ( lod_aero == 3 ) THEN
8201	!
8202	!-- Inquire aerosol emission rate per bin (#/(m3s))
8203	nc_stat = NF90_INQ_VARID( id_faero, "aerosol_emission_values", id_sa )
8204
8205	!
8206	!-- Emission time step
8207	CALL netcdf_data_input_get_dimension_length( id_faero, n_dt, &
8208	'dt_emission' )
8209	IF ( n_dt > 1 ) THEN
8210	CALL location_message( ' salsa_set_source: hourly emission data'//&
8211	' provided but currently the value of the '// &
8212	' first hour is applied.', .TRUE. )
8213	ENDIF
8214	!
8215	!-- Allocate source arrays
8216	DO b = 1, nbins
8217	ALLOCATE( aerosol_number(b)%source(nzb:nzt+1,nys:nyn,nxl:nxr) )
8218	aerosol_number(b)%source = 0.0_wp
8219	ENDDO
8220	DO c = 1, ncc_tot*nbins
8221	ALLOCATE( aerosol_mass(c)%source(nzb:nzt+1,nys:nyn,nxl:nxr) )
8222	aerosol_mass(c)%source = 0.0_wp
8223	ENDDO
8224	!
8225	!-- Get dimension of z-axis:
8226	CALL netcdf_data_input_get_dimension_length( id_faero, nz_file, 'z' )
8227	!
8228	!-- Read surface emission data (x,y) PE-wise
8229	DO i = nxl, nxr
8230	DO j = nys, nyn
8231	DO k = 0, nz_file-1
8232	!
8233	!-- Predetermine flag to mask topography
8234	flag = MERGE( 1.0_wp, 0.0_wp, BTEST(wall_flags_0(k,j,i), 0 ))
8235	!
8236	!-- No sources inside buildings !
8237	IF ( flag == 0.0_wp ) CYCLE
8238	!
8239	!-- Read volume source:
8240	nc_stat = NF90_GET_VAR( id_faero, id_sa, source_ijka, &
8241	start = (/ i+1, j+1, k+1, 1, 1 /), &
8242	count = (/ 1, 1, 1, 1, nb_file /) )
8243	IF ( nc_stat /= NF90_NOERR ) THEN
8244	message_string = 'error in aerosol emissions: lod3'
8245	CALL message( 'salsa_mod: salsa_set_source','SA0038', 1, 2, &
8246	0, 6, 0 )
8247	ENDIF
8248	!
8249	!-- Set mass fluxes. First bins include only SO4 and/or OC. Call
8250	!-- subroutine set_mass_source for larger bins.
8251	!
8252	!-- Sulphate and organic carbon
8253	IF ( iso4 > 0 .AND. ioc > 0 ) THEN
8254	!-- First sulphate:
8255	ss = ( iso4 - 1 ) * nbins + in1a ! start
8256	ee = ( iso4 - 1 ) * nbins + fn1a ! end
8257	b = in1a
8258	DO c = ss, ee
8259	IF ( source_ijka(b) /= fillval ) &
8260	aerosol_mass(c)%source(k,j,i) = &
8261	aerosol_mass(c)%source(k,j,i) + &
8262	emission_mass_fracs(1,1) / ( emission_mass_fracs(1,1) &
8263	+ emission_mass_fracs(1,2) ) * source_ijka(b) * &
8264	aero(b)%core * arhoh2so4
8265	b = b+1
8266	ENDDO
8267	!-- Then organic carbon:
8268	ss = ( ioc - 1 ) * nbins + in1a ! start
8269	ee = ( ioc - 1 ) * nbins + fn1a ! end
8270	b = in1a
8271	DO c = ss, ee
8272	IF ( source_ijka(b) /= fillval ) &
8273	aerosol_mass(c)%source(k,j,i) = &
8274	aerosol_mass(c)%source(k,j,i) + &
8275	emission_mass_fracs(1,2) / ( emission_mass_fracs(1,1) &
8276	+ emission_mass_fracs(1,2) ) * source_ijka(b) * &
8277	aero(b)%core * arhooc
8278	b = b+1
8279	ENDDO
8280
8281	CALL set_mass_source( k, j, i, iso4, &
8282	emission_mass_fracs(1,1), arhoh2so4, &
8283	source_ijka, fillval )
8284	CALL set_mass_source( k, j, i, ioc, emission_mass_fracs(1,2),&
8285	arhooc, source_ijka, fillval )
8286	!-- Only sulphate:
8287	ELSEIF ( iso4 > 0 .AND. ioc < 0 ) THEN
8288	ss = ( iso4 - 1 ) * nbins + in1a ! start
8289	ee = ( iso4 - 1 ) * nbins + fn1a ! end
8290	b = in1a
8291	DO c = ss, ee
8292	IF ( source_ijka(b) /= fillval ) &
8293	aerosol_mass(c)%source(k,j,i) = &
8294	aerosol_mass(c)%source(k,j,i) + source_ijka(b) * &
8295	aero(b)%core * arhoh2so4
8296	b = b+1
8297	ENDDO
8298	CALL set_mass_source( k, j, i, iso4, &
8299	emission_mass_fracs(1,1), arhoh2so4, &
8300	source_ijka, fillval )
8301	!-- Only organic carbon:
8302	ELSEIF ( iso4 < 0 .AND. ioc > 0 ) THEN
8303	ss = ( ioc - 1 ) * nbins + in1a ! start
8304	ee = ( ioc - 1 ) * nbins + fn1a ! end
8305	b = in1a
8306	DO c = ss, ee
8307	IF ( source_ijka(b) /= fillval ) &
8308	aerosol_mass(c)%source(k,j,i) = &
8309	aerosol_mass(c)%source(k,j,i) + source_ijka(b) * &
8310	aero(b)%core * arhooc
8311	b = b+1
8312	ENDDO
8313	CALL set_mass_source( k, j, i, ioc, emission_mass_fracs(1,2),&
8314	arhooc, source_ijka, fillval )
8315	ENDIF
8316	!-- Black carbon
8317	IF ( ibc > 0 ) THEN
8318	CALL set_mass_source( k, j, i, ibc, emission_mass_fracs(1,3),&
8319	arhobc, source_ijka, fillval )
8320	ENDIF
8321	!-- Dust
8322	IF ( idu > 0 ) THEN
8323	CALL set_mass_source( k, j, i, idu, emission_mass_fracs(1,4),&
8324	arhodu, source_ijka, fillval )
8325	ENDIF
8326	!-- Sea salt
8327	IF ( iss > 0 ) THEN
8328	CALL set_mass_source( k, j, i, iss, emission_mass_fracs(1,5),&
8329	arhoss, source_ijka, fillval )
8330	ENDIF
8331	!-- Nitric acid
8332	IF ( ino > 0 ) THEN
8333	CALL set_mass_source( k, j, i, ino, emission_mass_fracs(1,6),&
8334	arhohno3, source_ijka, fillval )
8335	ENDIF
8336	!-- Ammonia
8337	IF ( inh > 0 ) THEN
8338	CALL set_mass_source( k, j, i, inh, emission_mass_fracs(1,7),&
8339	arhonh3, source_ijka, fillval )
8340	ENDIF
8341	!
8342	!-- Save aerosol number sources in the end
8343	DO b = 1, nbins
8344	IF ( source_ijka(b) /= fillval ) &
8345	aerosol_number(b)%source(k,j,i) = &
8346	aerosol_number(b)%source(k,j,i) + source_ijka(b)
8347	ENDDO
8348	ENDDO ! k
8349	ENDDO ! j
8350	ENDDO ! i
8351
8352	ELSE
8353	message_string = 'NetCDF attribute lod is not set properly.'
8354	CALL message( 'salsa_mod: salsa_set_source','SA0026', 1, 2, 0, 6, 0 )
8355	ENDIF
8356
8357	#endif
8358	END SUBROUTINE salsa_set_source
8359
8360	!------------------------------------------------------------------------------!
8361	! Description:
8362	! ------------
8363	!> Sets the gaseous fluxes
8364	!------------------------------------------------------------------------------!
8365	SUBROUTINE set_gas_flux( surface, ncat_emission, unit )
8366
8367	USE arrays_3d, &
8368	ONLY: dzw, hyp, pt, rho_air_zw
8369
8370	USE grid_variables, &
8371	ONLY: dx, dy
8372
8373	USE surface_mod, &
8374	ONLY: surf_type
8375
8376	IMPLICIT NONE
8377
8378	CHARACTER(LEN=*) :: unit !< flux unit in the input file
8379	INTEGER(iwp) :: ncat_emission !< number of emission categories
8380	TYPE(surf_type), INTENT(inout) :: surface !< respective surface type
8381	INTEGER(iwp) :: g !< loop index
8382	INTEGER(iwp) :: i !< loop index
8383	INTEGER(iwp) :: j !< loop index
8384	INTEGER(iwp) :: k !< loop index
8385	INTEGER(iwp) :: m !< running index for surface elements
8386	INTEGER(iwp) :: n !< running index for emission categories
8387	REAL(wp), DIMENSION(ngast) :: conversion_factor
8388
8389	conversion_factor = 1.0_wp
8390
8391	DO m = 1, surface%ns
8392	!
8393	!-- Get indices of respective grid point
8394	i = surface%i(m)
8395	j = surface%j(m)
8396	k = surface%k(m)
8397
8398	IF ( unit == '#/m2/s' ) THEN
8399	conversion_factor = 1.0_wp
8400	ELSEIF ( unit == 'g/m2/s' ) THEN
8401	conversion_factor(1) = avo / ( amh2so4 * 1000.0_wp )
8402	conversion_factor(2) = avo / ( amhno3 * 1000.0_wp )
8403	conversion_factor(3) = avo / ( amnh3 * 1000.0_wp )
8404	conversion_factor(4) = avo / ( amoc * 1000.0_wp )
8405	conversion_factor(5) = avo / ( amoc * 1000.0_wp )
8406	ELSEIF ( unit == 'ppm/m2/s' ) THEN
8407	conversion_factor = for_ppm_to_nconc * hyp(k) / pt(k,j,i) * ( hyp(k) &
8408	/ 100000.0_wp )*0.286_wp dx * dy * dzw(k)
8409	ELSEIF ( unit == 'mumol/m2/s' ) THEN
8410	conversion_factor = 1.0E-6_wp * avo
8411	ELSE
8412	message_string = 'Unknown unit for gaseous emissions!'
8413	CALL message( 'salsa_mod: set_gas_flux', 'SA0031', 1, 2, 0, 6, 0 )
8414	ENDIF
8415
8416	DO n = 1, ncat_emission
8417	DO g = 1, ngast
8418	IF ( salsa_gas(g)%source(n,j,i) < 0.0_wp ) THEN
8419	salsa_gas(g)%source(n,j,i) = 0.0_wp
8420	CYCLE
8421	ENDIF
8422	surface%gtsws(m,g) = surface%gtsws(m,g) + &
8423	salsa_gas(g)%source(n,j,i) * rho_air_zw(k-1) &
8424	* conversion_factor(g)
8425	ENDDO
8426	ENDDO
8427	ENDDO
8428
8429	END SUBROUTINE set_gas_flux
8430
8431
8432	!------------------------------------------------------------------------------!
8433	! Description:
8434	! ------------
8435	!> Sets the aerosol flux to aerosol arrays in 2a and 2b.
8436	!------------------------------------------------------------------------------!
8437	SUBROUTINE set_flux( surface, ncat_emission )
8438
8439	USE arrays_3d, &
8440	ONLY: hyp, pt, rho_air_zw
8441
8442	USE surface_mod, &
8443	ONLY: surf_type
8444
8445	IMPLICIT NONE
8446
8447	INTEGER(iwp) :: ncat_emission !< number of emission categories
8448	TYPE(surf_type), INTENT(inout) :: surface !< respective surface type
8449	INTEGER(iwp) :: b !< loop index
8450	INTEGER(iwp) :: ee !< loop index
8451	INTEGER(iwp) :: g !< loop index
8452	INTEGER(iwp) :: i !< loop index
8453	INTEGER(iwp) :: j !< loop index
8454	INTEGER(iwp) :: k !< loop index
8455	INTEGER(iwp) :: m !< running index for surface elements
8456	INTEGER(iwp) :: n !< loop index for emission categories
8457	INTEGER(iwp) :: c !< loop index
8458	INTEGER(iwp) :: ss !< loop index
8459
8460	DO m = 1, surface%ns
8461	!
8462	!-- Get indices of respective grid point
8463	i = surface%i(m)
8464	j = surface%j(m)
8465	k = surface%k(m)
8466
8467	DO n = 1, ncat_emission
8468	DO b = 1, nbins
8469	IF ( aerosol_number(b)%source(n,j,i) < 0.0_wp ) THEN
8470	aerosol_number(b)%source(n,j,i) = 0.0_wp
8471	CYCLE
8472	ENDIF
8473	!
8474	!-- Set mass fluxes. First bins include only SO4 and/or OC.
8475
8476	IF ( b <= fn1a ) THEN
8477	!
8478	!-- Both sulphate and organic carbon
8479	IF ( iso4 > 0 .AND. ioc > 0 ) THEN
8480
8481	c = ( iso4 - 1 ) * nbins + b
8482	surface%amsws(m,c) = surface%amsws(m,c) + &
8483	emission_mass_fracs(n,1) / &
8484	( emission_mass_fracs(n,1) + &
8485	emission_mass_fracs(n,2) ) * &
8486	aerosol_number(b)%source(n,j,i) * &
8487	api6 * aero(b)%dmid*3.0_wp &
8488	arhoh2so4 * rho_air_zw(k-1)
8489	aerosol_mass(c)%source(n,j,i) = &
8490	aerosol_mass(c)%source(n,j,i) + surface%amsws(m,c)
8491	c = ( ioc - 1 ) * nbins + b
8492	surface%amsws(m,c) = surface%amsws(m,c) + &
8493	emission_mass_fracs(n,2) / &
8494	( emission_mass_fracs(n,1) + &
8495	emission_mass_fracs(n,2) ) * &
8496	aerosol_number(b)%source(n,j,i) * &
8497	api6 * aero(b)%dmid*3.0_wp arhooc &
8498	* rho_air_zw(k-1)
8499	aerosol_mass(c)%source(n,j,i) = &
8500	aerosol_mass(c)%source(n,j,i) + surface%amsws(m,c)
8501	!
8502	!-- Only sulphates
8503	ELSEIF ( iso4 > 0 .AND. ioc < 0 ) THEN
8504	c = ( iso4 - 1 ) * nbins + b
8505	surface%amsws(m,c) = surface%amsws(m,c) + &
8506	aerosol_number(b)%source(n,j,i) * api6 &
8507	* aero(b)%dmid*3.0_wp arhoh2so4 &
8508	* rho_air_zw(k-1)
8509	aerosol_mass(c)%source(n,j,i) = &
8510	aerosol_mass(c)%source(n,j,i) + surface%amsws(m,c)
8511	!
8512	!-- Only organic carbon
8513	ELSEIF ( iso4 < 0 .AND. ioc > 0 ) THEN
8514	c = ( ioc - 1 ) * nbins + b
8515	surface%amsws(m,c) = surface%amsws(m,c) + &
8516	aerosol_number(b)%source(n,j,i) * api6 &
8517	* aero(b)%dmid*3.0_wp arhooc &
8518	* rho_air_zw(k-1)
8519	aerosol_mass(c)%source(n,j,i) = &
8520	aerosol_mass(c)%source(n,j,i) + surface%amsws(m,c)
8521	ENDIF
8522
8523	ELSEIF ( b > fn1a ) THEN
8524	!
8525	!-- Sulphate
8526	IF ( iso4 > 0 ) THEN
8527	CALL set_mass_flux( surface, m, b, iso4, n, &
8528	emission_mass_fracs(n,1), arhoh2so4, &
8529	aerosol_number(b)%source(n,j,i) )
8530	ENDIF
8531	!
8532	!-- Organic carbon
8533	IF ( ioc > 0 ) THEN
8534	CALL set_mass_flux( surface, m, b, ioc, n, &
8535	emission_mass_fracs(n,2), arhooc, &
8536	aerosol_number(b)%source(n,j,i) )
8537	ENDIF
8538	!
8539	!-- Black carbon
8540	IF ( ibc > 0 ) THEN
8541	CALL set_mass_flux( surface, m, b, ibc, n, &
8542	emission_mass_fracs(n,3), arhobc, &
8543	aerosol_number(b)%source(n,j,i) )
8544	ENDIF
8545	!
8546	!-- Dust
8547	IF ( idu > 0 ) THEN
8548	CALL set_mass_flux( surface, m, b, idu, n, &
8549	emission_mass_fracs(n,4), arhodu, &
8550	aerosol_number(b)%source(n,j,i) )
8551	ENDIF
8552	!
8553	!-- Sea salt
8554	IF ( iss > 0 ) THEN
8555	CALL set_mass_flux( surface, m, b, iss, n, &
8556	emission_mass_fracs(n,5), arhoss, &
8557	aerosol_number(b)%source(n,j,i) )
8558	ENDIF
8559	!
8560	!-- Nitric acid
8561	IF ( ino > 0 ) THEN
8562	CALL set_mass_flux( surface, m, b, ino, n, &
8563	emission_mass_fracs(n,6), arhohno3, &
8564	aerosol_number(b)%source(n,j,i) )
8565	ENDIF
8566	!
8567	!-- Ammonia
8568	IF ( inh > 0 ) THEN
8569	CALL set_mass_flux( surface, m, b, inh, n, &
8570	emission_mass_fracs(n,7), arhonh3, &
8571	aerosol_number(b)%source(n,j,i) )
8572	ENDIF
8573
8574	ENDIF
8575	!
8576	!-- Save number fluxes in the end
8577	surface%answs(m,b) = surface%answs(m,b) + &
8578	aerosol_number(b)%source(n,j,i) * rho_air_zw(k-1)
8579	aerosol_number(b)%source(n,j,i) = surface%answs(m,b)
8580	ENDDO
8581
8582	ENDDO
8583
8584	ENDDO
8585
8586	END SUBROUTINE set_flux
8587
8588	!------------------------------------------------------------------------------!
8589	! Description:
8590	! ------------
8591	!> Sets the mass emissions to aerosol arrays in 2a and 2b.
8592	!------------------------------------------------------------------------------!
8593	SUBROUTINE set_mass_flux( surface, surf_num, b, ispec, n, mass_frac, prho, &
8594	nsource )
8595
8596	USE arrays_3d, &
8597	ONLY: rho_air_zw
8598
8599	USE surface_mod, &
8600	ONLY: surf_type
8601
8602	IMPLICIT NONE
8603
8604	INTEGER(iwp), INTENT(in) :: b !< Aerosol size bin index
8605	INTEGER(iwp), INTENT(in) :: ispec !< Aerosol species index
8606	INTEGER(iwp), INTENT(in) :: n !< emission category number
8607	INTEGER(iwp), INTENT(in) :: surf_num !< index surface elements
8608	REAL(wp), INTENT(in) :: mass_frac !< mass fraction of a chemical
8609	!< compound in all bins
8610	REAL(wp), INTENT(in) :: nsource !< number source (#/m2/s)
8611	REAL(wp), INTENT(in) :: prho !< Aerosol density
8612	TYPE(surf_type), INTENT(inout) :: surface !< respective surface type
8613
8614	INTEGER(iwp) :: ee !< index: end
8615	INTEGER(iwp) :: i !< loop index
8616	INTEGER(iwp) :: j !< loop index
8617	INTEGER(iwp) :: k !< loop index
8618	INTEGER(iwp) :: c !< loop index
8619	INTEGER(iwp) :: ss !<index: start
8620
8621	!
8622	!-- Get indices of respective grid point
8623	i = surface%i(surf_num)
8624	j = surface%j(surf_num)
8625	k = surface%k(surf_num)
8626	!
8627	!-- Subrange 2a:
8628	c = ( ispec - 1 ) * nbins + b
8629	surface%amsws(surf_num,c) = surface%amsws(surf_num,c) + mass_frac * nsource&
8630	* aero(b)%core * prho * rho_air_zw(k-1)
8631	aerosol_mass(c)%source(n,j,i) = aerosol_mass(c)%source(n,j,i) + &
8632	surface%amsws(surf_num,c)
8633	!
8634	!-- Subrange 2b:
8635	IF ( .NOT. no_insoluble ) THEN
8636	WRITE(,) 'All emissions are soluble!'
8637	ENDIF
8638
8639	END SUBROUTINE set_mass_flux
8640
8641	!------------------------------------------------------------------------------!
8642	! Description:
8643	! ------------
8644	!> Sets the mass sources to aerosol arrays in 2a and 2b.
8645	!------------------------------------------------------------------------------!
8646	SUBROUTINE set_mass_source( k, j, i, ispec, mass_frac, prho, nsource, fillval )
8647
8648	USE surface_mod, &
8649	ONLY: surf_type
8650
8651	IMPLICIT NONE
8652
8653	INTEGER(iwp), INTENT(in) :: ispec !< Aerosol species index
8654	REAL(wp), INTENT(in) :: fillval !< _FillValue in the NetCDF file
8655	REAL(wp), INTENT(in) :: mass_frac !< mass fraction of a chemical
8656	!< compound in all bins
8657	REAL(wp), INTENT(in), DIMENSION(:) :: nsource !< number source
8658	REAL(wp), INTENT(in) :: prho !< Aerosol density
8659
8660	INTEGER(iwp) :: b !< loop index
8661	INTEGER(iwp) :: ee !< index: end
8662	INTEGER(iwp) :: i !< loop index
8663	INTEGER(iwp) :: j !< loop index
8664	INTEGER(iwp) :: k !< loop index
8665	INTEGER(iwp) :: c !< loop index
8666	INTEGER(iwp) :: ss !<index: start
8667	!
8668	!-- Subrange 2a:
8669	ss = ( ispec - 1 ) * nbins + in2a
8670	ee = ( ispec - 1 ) * nbins + fn2a
8671	b = in2a
8672	DO c = ss, ee
8673	IF ( nsource(b) /= fillval ) THEN
8674	aerosol_mass(c)%source(k,j,i) = aerosol_mass(c)%source(k,j,i) + &
8675	mass_frac * nsource(b) * aero(b)%core * &
8676	prho
8677	ENDIF
8678	b = b+1
8679	ENDDO
8680	!
8681	!-- Subrange 2b:
8682	IF ( .NOT. no_insoluble ) THEN
8683	WRITE(,) 'All sources are soluble!'
8684	ENDIF
8685
8686	END SUBROUTINE set_mass_source
8687
8688	!------------------------------------------------------------------------------!
8689	! Description:
8690	! ------------
8691	!> Check data output for salsa.
8692	!------------------------------------------------------------------------------!
8693	SUBROUTINE salsa_check_data_output( var, unit )
8694
8695	USE control_parameters, &
8696	ONLY: message_string
8697
8698	IMPLICIT NONE
8699
8700	CHARACTER (LEN=*) :: unit !<
8701	CHARACTER (LEN=*) :: var !<
8702
8703	SELECT CASE ( TRIM( var ) )
8704
8705	CASE ( 'g_H2SO4', 'g_HNO3', 'g_NH3', 'g_OCNV', 'g_OCSV', &
8706	'N_bin1', 'N_bin2', 'N_bin3', 'N_bin4', 'N_bin5', 'N_bin6', &
8707	'N_bin7', 'N_bin8', 'N_bin9', 'N_bin10', 'N_bin11', 'N_bin12', &
8708	'Ntot' )
8709	IF ( .NOT. salsa ) THEN
8710	message_string = 'output of "' // TRIM( var ) // '" requi' // &
8711	'res salsa = .TRUE.'
8712	CALL message( 'check_parameters', 'SA0006', 1, 2, 0, 6, 0 )
8713	ENDIF
8714	unit = '#/m3'
8715
8716	CASE ( 'LDSA' )
8717	IF ( .NOT. salsa ) THEN
8718	message_string = 'output of "' // TRIM( var ) // '" requi' // &
8719	'res salsa = .TRUE.'
8720	CALL message( 'check_parameters', 'SA0003', 1, 2, 0, 6, 0 )
8721	ENDIF
8722	unit = 'mum2/cm3'
8723
8724	CASE ( 'm_bin1', 'm_bin2', 'm_bin3', 'm_bin4', 'm_bin5', 'm_bin6', &
8725	'm_bin7', 'm_bin8', 'm_bin9', 'm_bin10', 'm_bin11', 'm_bin12', &
8726	'PM2.5', 'PM10', 's_BC', 's_DU', 's_H2O', 's_NH', &
8727	's_NO', 's_OC', 's_SO4', 's_SS' )
8728	IF ( .NOT. salsa ) THEN
8729	message_string = 'output of "' // TRIM( var ) // '" requi' // &
8730	'res salsa = .TRUE.'
8731	CALL message( 'check_parameters', 'SA0001', 1, 2, 0, 6, 0 )
8732	ENDIF
8733	unit = 'kg/m3'
8734
8735	CASE DEFAULT
8736	unit = 'illegal'
8737
8738	END SELECT
8739
8740	END SUBROUTINE salsa_check_data_output
8741
8742	!------------------------------------------------------------------------------!
8743	!
8744	! Description:
8745	! ------------
8746	!> Subroutine for averaging 3D data
8747	!------------------------------------------------------------------------------!
8748	SUBROUTINE salsa_3d_data_averaging( mode, variable )
8749
8750
8751	USE control_parameters
8752
8753	USE indices
8754
8755	USE kinds
8756
8757	IMPLICIT NONE
8758
8759	CHARACTER (LEN=*) :: mode !<
8760	CHARACTER (LEN=*) :: variable !<
8761
8762	INTEGER(iwp) :: b !<
8763	INTEGER(iwp) :: c !<
8764	INTEGER(iwp) :: i !<
8765	INTEGER(iwp) :: icc !<
8766	INTEGER(iwp) :: j !<
8767	INTEGER(iwp) :: k !<
8768
8769	REAL(wp) :: df !< For calculating LDSA: fraction of particles
8770	!< depositing in the alveolar (or tracheobronchial)
8771	!< region of the lung. Depends on the particle size
8772	REAL(wp) :: mean_d !< Particle diameter in micrometres
8773	REAL(wp) :: nc !< Particle number concentration in units 1/cm**3
8774	REAL(wp) :: temp_bin !<
8775	REAL(wp), DIMENSION(:,:,:), POINTER :: to_be_resorted !< points to
8776	!< selected output variable
8777
8778	temp_bin = 0.0_wp
8779
8780	IF ( mode == 'allocate' ) THEN
8781
8782	SELECT CASE ( TRIM( variable ) )
8783
8784	CASE ( 'g_H2SO4' )
8785	IF ( .NOT. ALLOCATED( g_H2SO4_av ) ) THEN
8786	ALLOCATE( g_H2SO4_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
8787	ENDIF
8788	g_H2SO4_av = 0.0_wp
8789
8790	CASE ( 'g_HNO3' )
8791	IF ( .NOT. ALLOCATED( g_HNO3_av ) ) THEN
8792	ALLOCATE( g_HNO3_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
8793	ENDIF
8794	g_HNO3_av = 0.0_wp
8795
8796	CASE ( 'g_NH3' )
8797	IF ( .NOT. ALLOCATED( g_NH3_av ) ) THEN
8798	ALLOCATE( g_NH3_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
8799	ENDIF
8800	g_NH3_av = 0.0_wp
8801
8802	CASE ( 'g_OCNV' )
8803	IF ( .NOT. ALLOCATED( g_OCNV_av ) ) THEN
8804	ALLOCATE( g_OCNV_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
8805	ENDIF
8806	g_OCNV_av = 0.0_wp
8807
8808	CASE ( 'g_OCSV' )
8809	IF ( .NOT. ALLOCATED( g_OCSV_av ) ) THEN
8810	ALLOCATE( g_OCSV_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
8811	ENDIF
8812	g_OCSV_av = 0.0_wp
8813
8814	CASE ( 'LDSA' )
8815	IF ( .NOT. ALLOCATED( LDSA_av ) ) THEN
8816	ALLOCATE( LDSA_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
8817	ENDIF
8818	LDSA_av = 0.0_wp
8819
8820	CASE ( 'N_bin1', 'N_bin2', 'N_bin3', 'N_bin4', 'N_bin5', 'N_bin6', &
8821	'N_bin7', 'N_bin8', 'N_bin9', 'N_bin10', 'N_bin11', 'N_bin12' )
8822	IF ( .NOT. ALLOCATED( Nbins_av ) ) THEN
8823	ALLOCATE( Nbins_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg,nbins) )
8824	ENDIF
8825	Nbins_av = 0.0_wp
8826
8827	CASE ( 'Ntot' )
8828	IF ( .NOT. ALLOCATED( Ntot_av ) ) THEN
8829	ALLOCATE( Ntot_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
8830	ENDIF
8831	Ntot_av = 0.0_wp
8832
8833	CASE ( 'm_bin1', 'm_bin2', 'm_bin3', 'm_bin4', 'm_bin5', 'm_bin6', &
8834	'm_bin7', 'm_bin8', 'm_bin9', 'm_bin10', 'm_bin11', 'm_bin12' )
8835	IF ( .NOT. ALLOCATED( mbins_av ) ) THEN
8836	ALLOCATE( mbins_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg,nbins) )
8837	ENDIF
8838	mbins_av = 0.0_wp
8839
8840	CASE ( 'PM2.5' )
8841	IF ( .NOT. ALLOCATED( PM25_av ) ) THEN
8842	ALLOCATE( PM25_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
8843	ENDIF
8844	PM25_av = 0.0_wp
8845
8846	CASE ( 'PM10' )
8847	IF ( .NOT. ALLOCATED( PM10_av ) ) THEN
8848	ALLOCATE( PM10_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
8849	ENDIF
8850	PM10_av = 0.0_wp
8851
8852	CASE ( 's_BC' )
8853	IF ( .NOT. ALLOCATED( s_BC_av ) ) THEN
8854	ALLOCATE( s_BC_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
8855	ENDIF
8856	s_BC_av = 0.0_wp
8857
8858	CASE ( 's_DU' )
8859	IF ( .NOT. ALLOCATED( s_DU_av ) ) THEN
8860	ALLOCATE( s_DU_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
8861	ENDIF
8862	s_DU_av = 0.0_wp
8863
8864	CASE ( 's_H2O' )
8865	IF ( .NOT. ALLOCATED( s_H2O_av ) ) THEN
8866	ALLOCATE( s_H2O_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
8867	ENDIF
8868	s_H2O_av = 0.0_wp
8869
8870	CASE ( 's_NH' )
8871	IF ( .NOT. ALLOCATED( s_NH_av ) ) THEN
8872	ALLOCATE( s_NH_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
8873	ENDIF
8874	s_NH_av = 0.0_wp
8875
8876	CASE ( 's_NO' )
8877	IF ( .NOT. ALLOCATED( s_NO_av ) ) THEN
8878	ALLOCATE( s_NO_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
8879	ENDIF
8880	s_NO_av = 0.0_wp
8881
8882	CASE ( 's_OC' )
8883	IF ( .NOT. ALLOCATED( s_OC_av ) ) THEN
8884	ALLOCATE( s_OC_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
8885	ENDIF
8886	s_OC_av = 0.0_wp
8887
8888	CASE ( 's_SO4' )
8889	IF ( .NOT. ALLOCATED( s_SO4_av ) ) THEN
8890	ALLOCATE( s_SO4_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
8891	ENDIF
8892	s_SO4_av = 0.0_wp
8893
8894	CASE ( 's_SS' )
8895	IF ( .NOT. ALLOCATED( s_SS_av ) ) THEN
8896	ALLOCATE( s_SS_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
8897	ENDIF
8898	s_SS_av = 0.0_wp
8899
8900	CASE DEFAULT
8901	CONTINUE
8902
8903	END SELECT
8904
8905	ELSEIF ( mode == 'sum' ) THEN
8906
8907	SELECT CASE ( TRIM( variable ) )
8908
8909	CASE ( 'g_H2SO4', 'g_HNO3', 'g_NH3', 'g_OCNV', 'g_OCSV' )
8910	IF ( TRIM( variable(3:) ) == 'H2SO4' ) THEN
8911	icc = 1
8912	to_be_resorted => g_H2SO4_av
8913	ELSEIF ( TRIM( variable(3:) ) == 'HNO3' ) THEN
8914	icc = 2
8915	to_be_resorted => g_HNO3_av
8916	ELSEIF ( TRIM( variable(3:) ) == 'NH3' ) THEN
8917	icc = 3
8918	to_be_resorted => g_NH3_av
8919	ELSEIF ( TRIM( variable(3:) ) == 'OCNV' ) THEN
8920	icc = 4
8921	to_be_resorted => g_OCNV_av
8922	ELSEIF ( TRIM( variable(3:) ) == 'OCSV' ) THEN
8923	icc = 5
8924	to_be_resorted => g_OCSV_av
8925	ENDIF
8926	DO i = nxlg, nxrg
8927	DO j = nysg, nyng
8928	DO k = nzb, nzt+1
8929	to_be_resorted(k,j,i) = to_be_resorted(k,j,i) + &
8930	salsa_gas(icc)%conc(k,j,i)
8931	ENDDO
8932	ENDDO
8933	ENDDO
8934
8935	CASE ( 'LDSA' )
8936	DO i = nxlg, nxrg
8937	DO j = nysg, nyng
8938	DO k = nzb, nzt+1
8939	temp_bin = 0.0_wp
8940	DO b = 1, nbins
8941	!
8942	!-- Diameter in micrometres
8943	mean_d = 1.0E+6_wp * Ra_dry(k,j,i,b) * 2.0_wp
8944	!
8945	!-- Deposition factor: alveolar (use Ra_dry)
8946	df = ( 0.01555_wp / mean_d ) * ( EXP( -0.416_wp * &
8947	( LOG( mean_d ) + 2.84_wp )**2.0_wp ) &
8948	+ 19.11_wp * EXP( -0.482_wp * &
8949	( LOG( mean_d ) - 1.362_wp )**2.0_wp ) )
8950	!
8951	!-- Number concentration in 1/cm3
8952	nc = 1.0E-6_wp * aerosol_number(b)%conc(k,j,i)
8953	!
8954	!-- Lung-deposited surface area LDSA (units mum2/cm3)
8955	temp_bin = temp_bin + pi * mean_d*2.0_wp df * nc
8956	ENDDO
8957	LDSA_av(k,j,i) = LDSA_av(k,j,i) + temp_bin
8958	ENDDO
8959	ENDDO
8960	ENDDO
8961
8962	CASE ( 'N_bin1', 'N_bin2', 'N_bin3', 'N_bin4', 'N_bin5', 'N_bin6', &
8963	'N_bin7', 'N_bin8', 'N_bin9', 'N_bin10', 'N_bin11', 'N_bin12' )
8964	DO i = nxlg, nxrg
8965	DO j = nysg, nyng
8966	DO k = nzb, nzt+1
8967	DO b = 1, nbins
8968	Nbins_av(k,j,i,b) = Nbins_av(k,j,i,b) + &
8969	aerosol_number(b)%conc(k,j,i)
8970	ENDDO
8971	ENDDO
8972	ENDDO
8973	ENDDO
8974
8975	CASE ( 'Ntot' )
8976	DO i = nxlg, nxrg
8977	DO j = nysg, nyng
8978	DO k = nzb, nzt+1
8979	DO b = 1, nbins
8980	Ntot_av(k,j,i) = Ntot_av(k,j,i) + &
8981	aerosol_number(b)%conc(k,j,i)
8982	ENDDO
8983	ENDDO
8984	ENDDO
8985	ENDDO
8986
8987	CASE ( 'm_bin1', 'm_bin2', 'm_bin3', 'm_bin4', 'm_bin5', 'm_bin6', &
8988	'm_bin7', 'm_bin8', 'm_bin9', 'm_bin10', 'm_bin11', 'm_bin12' )
8989	DO i = nxlg, nxrg
8990	DO j = nysg, nyng
8991	DO k = nzb, nzt+1
8992	DO b = 1, nbins
8993	DO c = b, nbins*ncc_tot, nbins
8994	mbins_av(k,j,i,b) = mbins_av(k,j,i,b) + &
8995	aerosol_mass(c)%conc(k,j,i)
8996	ENDDO
8997	ENDDO
8998	ENDDO
8999	ENDDO
9000	ENDDO
9001
9002	CASE ( 'PM2.5' )
9003	DO i = nxlg, nxrg
9004	DO j = nysg, nyng
9005	DO k = nzb, nzt+1
9006	temp_bin = 0.0_wp
9007	DO b = 1, nbins
9008	IF ( 2.0_wp * Ra_dry(k,j,i,b) <= 2.5E-6_wp ) THEN
9009	DO c = b, nbins*ncc, nbins
9010	temp_bin = temp_bin + aerosol_mass(c)%conc(k,j,i)
9011	ENDDO
9012	ENDIF
9013	ENDDO
9014	PM25_av(k,j,i) = PM25_av(k,j,i) + temp_bin
9015	ENDDO
9016	ENDDO
9017	ENDDO
9018
9019	CASE ( 'PM10' )
9020	DO i = nxlg, nxrg
9021	DO j = nysg, nyng
9022	DO k = nzb, nzt+1
9023	temp_bin = 0.0_wp
9024	DO b = 1, nbins
9025	IF ( 2.0_wp * Ra_dry(k,j,i,b) <= 10.0E-6_wp ) THEN
9026	DO c = b, nbins*ncc, nbins
9027	temp_bin = temp_bin + aerosol_mass(c)%conc(k,j,i)
9028	ENDDO
9029	ENDIF
9030	ENDDO
9031	PM10_av(k,j,i) = PM10_av(k,j,i) + temp_bin
9032	ENDDO
9033	ENDDO
9034	ENDDO
9035
9036	CASE ( 's_BC', 's_DU', 's_H2O', 's_NH', 's_NO', 's_OC', 's_SO4', &
9037	's_SS' )
9038	IF ( is_used( prtcl, TRIM( variable(3:) ) ) ) THEN
9039	icc = get_index( prtcl, TRIM( variable(3:) ) )
9040	IF ( TRIM( variable(3:) ) == 'BC' ) to_be_resorted => s_BC_av
9041	IF ( TRIM( variable(3:) ) == 'DU' ) to_be_resorted => s_DU_av
9042	IF ( TRIM( variable(3:) ) == 'NH' ) to_be_resorted => s_NH_av
9043	IF ( TRIM( variable(3:) ) == 'NO' ) to_be_resorted => s_NO_av
9044	IF ( TRIM( variable(3:) ) == 'OC' ) to_be_resorted => s_OC_av
9045	IF ( TRIM( variable(3:) ) == 'SO4' ) to_be_resorted => s_SO4_av
9046	IF ( TRIM( variable(3:) ) == 'SS' ) to_be_resorted => s_SS_av
9047	DO i = nxlg, nxrg
9048	DO j = nysg, nyng
9049	DO k = nzb, nzt+1
9050	DO c = ( icc-1 )nbins+1, iccnbins
9051	to_be_resorted(k,j,i) = to_be_resorted(k,j,i) + &
9052	aerosol_mass(c)%conc(k,j,i)
9053	ENDDO
9054	ENDDO
9055	ENDDO
9056	ENDDO
9057	ENDIF
9058
9059	CASE DEFAULT
9060	CONTINUE
9061
9062	END SELECT
9063
9064	ELSEIF ( mode == 'average' ) THEN
9065
9066	SELECT CASE ( TRIM( variable ) )
9067
9068	CASE ( 'g_H2SO4', 'g_HNO3', 'g_NH3', 'g_OCNV', 'g_OCSV' )
9069	IF ( TRIM( variable(3:) ) == 'H2SO4' ) THEN
9070	icc = 1
9071	to_be_resorted => g_H2SO4_av
9072	ELSEIF ( TRIM( variable(3:) ) == 'HNO3' ) THEN
9073	icc = 2
9074	to_be_resorted => g_HNO3_av
9075	ELSEIF ( TRIM( variable(3:) ) == 'NH3' ) THEN
9076	icc = 3
9077	to_be_resorted => g_NH3_av
9078	ELSEIF ( TRIM( variable(3:) ) == 'OCNV' ) THEN
9079	icc = 4
9080	to_be_resorted => g_OCNV_av
9081	ELSEIF ( TRIM( variable(3:) ) == 'OCSV' ) THEN
9082	icc = 5
9083	to_be_resorted => g_OCSV_av
9084	ENDIF
9085	DO i = nxlg, nxrg
9086	DO j = nysg, nyng
9087	DO k = nzb, nzt+1
9088	to_be_resorted(k,j,i) = to_be_resorted(k,j,i) &
9089	/ REAL( average_count_3d, KIND=wp )
9090	ENDDO
9091	ENDDO
9092	ENDDO
9093
9094	CASE ( 'LDSA' )
9095	DO i = nxlg, nxrg
9096	DO j = nysg, nyng
9097	DO k = nzb, nzt+1
9098	LDSA_av(k,j,i) = LDSA_av(k,j,i) &
9099	/ REAL( average_count_3d, KIND=wp )
9100	ENDDO
9101	ENDDO
9102	ENDDO
9103
9104	CASE ( 'N_bin1', 'N_bin2', 'N_bin3', 'N_bin4', 'N_bin5', 'N_bin6', &
9105	'N_bin7', 'N_bin8', 'N_bin9', 'N_bin10', 'N_bin11', 'N_bin12' )
9106	DO i = nxlg, nxrg
9107	DO j = nysg, nyng
9108	DO k = nzb, nzt+1
9109	DO b = 1, nbins
9110	Nbins_av(k,j,i,b) = Nbins_av(k,j,i,b) &
9111	/ REAL( average_count_3d, KIND=wp )
9112	ENDDO
9113	ENDDO
9114	ENDDO
9115	ENDDO
9116
9117	CASE ( 'Ntot' )
9118	DO i = nxlg, nxrg
9119	DO j = nysg, nyng
9120	DO k = nzb, nzt+1
9121	Ntot_av(k,j,i) = Ntot_av(k,j,i) &
9122	/ REAL( average_count_3d, KIND=wp )
9123	ENDDO
9124	ENDDO
9125	ENDDO
9126
9127	CASE ( 'm_bin1', 'm_bin2', 'm_bin3', 'm_bin4', 'm_bin5', 'm_bin6', &
9128	'm_bin7', 'm_bin8', 'm_bin9', 'm_bin10', 'm_bin11', 'm_bin12' )
9129	DO i = nxlg, nxrg
9130	DO j = nysg, nyng
9131	DO k = nzb, nzt+1
9132	DO b = 1, nbins
9133	DO c = b, nbins*ncc, nbins
9134	mbins_av(k,j,i,b) = mbins_av(k,j,i,b) &
9135	/ REAL( average_count_3d, KIND=wp )
9136	ENDDO
9137	ENDDO
9138	ENDDO
9139	ENDDO
9140	ENDDO
9141
9142	CASE ( 'PM2.5' )
9143	DO i = nxlg, nxrg
9144	DO j = nysg, nyng
9145	DO k = nzb, nzt+1
9146	PM25_av(k,j,i) = PM25_av(k,j,i) / &
9147	REAL( average_count_3d, KIND=wp )
9148	ENDDO
9149	ENDDO
9150	ENDDO
9151
9152	CASE ( 'PM10' )
9153	DO i = nxlg, nxrg
9154	DO j = nysg, nyng
9155	DO k = nzb, nzt+1
9156	PM10_av(k,j,i) = PM10_av(k,j,i) / &
9157	REAL( average_count_3d, KIND=wp )
9158	ENDDO
9159	ENDDO
9160	ENDDO
9161
9162	CASE ( 's_BC', 's_DU', 's_H2O', 's_NH', 's_NO', 's_OC', 's_SO4', &
9163	's_SS' )
9164	IF ( is_used( prtcl, TRIM( variable(3:) ) ) ) THEN
9165	icc = get_index( prtcl, TRIM( variable(3:) ) )
9166	IF ( TRIM( variable(3:) ) == 'BC' ) to_be_resorted => s_BC_av
9167	IF ( TRIM( variable(3:) ) == 'DU' ) to_be_resorted => s_DU_av
9168	IF ( TRIM( variable(3:) ) == 'NH' ) to_be_resorted => s_NH_av
9169	IF ( TRIM( variable(3:) ) == 'NO' ) to_be_resorted => s_NO_av
9170	IF ( TRIM( variable(3:) ) == 'OC' ) to_be_resorted => s_OC_av
9171	IF ( TRIM( variable(3:) ) == 'SO4' ) to_be_resorted => s_SO4_av
9172	IF ( TRIM( variable(3:) ) == 'SS' ) to_be_resorted => s_SS_av
9173	DO i = nxlg, nxrg
9174	DO j = nysg, nyng
9175	DO k = nzb, nzt+1
9176	to_be_resorted(k,j,i) = to_be_resorted(k,j,i) / &
9177	REAL( average_count_3d, KIND=wp )
9178	ENDDO
9179	ENDDO
9180	ENDDO
9181	ENDIF
9182
9183	END SELECT
9184
9185	ENDIF
9186
9187	END SUBROUTINE salsa_3d_data_averaging
9188
9189
9190	!------------------------------------------------------------------------------!
9191	!
9192	! Description:
9193	! ------------
9194	!> Subroutine defining 2D output variables
9195	!------------------------------------------------------------------------------!
9196	SUBROUTINE salsa_data_output_2d( av, variable, found, grid, mode, local_pf, &
9197	two_d, nzb_do, nzt_do )
9198
9199	USE indices
9200
9201	USE kinds
9202
9203
9204	IMPLICIT NONE
9205
9206	CHARACTER (LEN=*) :: grid !<
9207	CHARACTER (LEN=*) :: mode !<
9208	CHARACTER (LEN=*) :: variable !<
9209	CHARACTER (LEN=5) :: vari !< trimmed format of variable
9210
9211	INTEGER(iwp) :: av !<
9212	INTEGER(iwp) :: b !< running index: size bins
9213	INTEGER(iwp) :: c !< running index: mass bins
9214	INTEGER(iwp) :: i !<
9215	INTEGER(iwp) :: icc !< index of a chemical compound
9216	INTEGER(iwp) :: j !<
9217	INTEGER(iwp) :: k !<
9218	INTEGER(iwp) :: nzb_do !<
9219	INTEGER(iwp) :: nzt_do !<
9220
9221	LOGICAL :: found !<
9222	LOGICAL :: two_d !< flag parameter that indicates 2D variables
9223	!< (horizontal cross sections)
9224
9225	REAL(wp) :: df !< For calculating LDSA: fraction of particles
9226	!< depositing in the alveolar (or tracheobronchial)
9227	!< region of the lung. Depends on the particle size
9228	REAL(wp) :: fill_value = -9999.0_wp !< value for the _FillValue attribute
9229	REAL(wp) :: mean_d !< Particle diameter in micrometres
9230	REAL(wp) :: nc !< Particle number concentration in units 1/cm**3
9231	REAL(wp) :: temp_bin !< temporary array for calculating output variables
9232
9233	REAL(wp), DIMENSION(nxl:nxr,nys:nyn,nzb_do:nzt_do) :: local_pf !< output
9234
9235	REAL(wp), DIMENSION(:,:,:), POINTER :: to_be_resorted !< pointer
9236
9237
9238	found = .TRUE.
9239	temp_bin = 0.0_wp
9240
9241	IF ( TRIM( variable(1:2) ) == 'g_' ) THEN
9242	vari = TRIM( variable( 3:LEN( TRIM( variable ) ) - 3 ) )
9243	IF ( av == 0 ) THEN
9244	IF ( vari == 'H2SO4') icc = 1
9245	IF ( vari == 'HNO3') icc = 2
9246	IF ( vari == 'NH3') icc = 3
9247	IF ( vari == 'OCNV') icc = 4
9248	IF ( vari == 'OCSV') icc = 5
9249	DO i = nxl, nxr
9250	DO j = nys, nyn
9251	DO k = nzb_do, nzt_do
9252	local_pf(i,j,k) = MERGE( salsa_gas(icc)%conc(k,j,i), &
9253	REAL( fill_value, KIND = wp ), &
9254	BTEST( wall_flags_0(k,j,i), 0 ) )
9255	ENDDO
9256	ENDDO
9257	ENDDO
9258	ELSE
9259	IF ( vari == 'H2SO4' ) to_be_resorted => g_H2SO4_av
9260	IF ( vari == 'HNO3' ) to_be_resorted => g_HNO3_av
9261	IF ( vari == 'NH3' ) to_be_resorted => g_NH3_av
9262	IF ( vari == 'OCNV' ) to_be_resorted => g_OCNV_av
9263	IF ( vari == 'OCSV' ) to_be_resorted => g_OCSV_av
9264	DO i = nxl, nxr
9265	DO j = nys, nyn
9266	DO k = nzb_do, nzt_do
9267	local_pf(i,j,k) = MERGE( to_be_resorted(k,j,i), &
9268	REAL( fill_value, KIND = wp ), &
9269	BTEST( wall_flags_0(k,j,i), 0 ) )
9270	ENDDO
9271	ENDDO
9272	ENDDO
9273	ENDIF
9274
9275	IF ( mode == 'xy' ) grid = 'zu'
9276
9277	ELSEIF ( TRIM( variable(1:4) ) == 'LDSA' ) THEN
9278	IF ( av == 0 ) THEN
9279	DO i = nxl, nxr
9280	DO j = nys, nyn
9281	DO k = nzb_do, nzt_do
9282	temp_bin = 0.0_wp
9283	DO b = 1, nbins
9284	!
9285	!-- Diameter in micrometres
9286	mean_d = 1.0E+6_wp * Ra_dry(k,j,i,b) * 2.0_wp
9287	!
9288	!-- Deposition factor: alveolar
9289	df = ( 0.01555_wp / mean_d ) * ( EXP( -0.416_wp * ( LOG( &
9290	mean_d ) + 2.84_wp )*2.0_wp ) + 19.11_wp EXP( &
9291	-0.482_wp * ( LOG( mean_d ) - 1.362_wp )**2.0_wp ) )
9292	!
9293	!-- Number concentration in 1/cm3
9294	nc = 1.0E-6_wp * aerosol_number(b)%conc(k,j,i)
9295	!
9296	!-- Lung-deposited surface area LDSA (units mum2/cm3)
9297	temp_bin = temp_bin + pi * mean_d*2.0_wp df * nc
9298	ENDDO
9299	local_pf(i,j,k) = MERGE( temp_bin, REAL( fill_value, KIND = &
9300	wp ), BTEST( wall_flags_0(k,j,i), 0 ) )
9301	ENDDO
9302	ENDDO
9303	ENDDO
9304	ELSE
9305	DO i = nxl, nxr
9306	DO j = nys, nyn
9307	DO k = nzb_do, nzt_do
9308	local_pf(i,j,k) = MERGE( LDSA_av(k,j,i), REAL( fill_value, &
9309	KIND = wp ), BTEST( &
9310	wall_flags_0(k,j,i), 0 ) )
9311	ENDDO
9312	ENDDO
9313	ENDDO
9314	ENDIF
9315
9316	IF ( mode == 'xy' ) grid = 'zu'
9317
9318	ELSEIF ( TRIM( variable(1:5) ) == 'N_bin' ) THEN
9319
9320	vari = TRIM( variable( 6:LEN( TRIM( variable ) ) - 3 ) )
9321
9322	IF ( TRIM( vari ) == '1' ) b = 1
9323	IF ( TRIM( vari ) == '2' ) b = 2
9324	IF ( TRIM( vari ) == '3' ) b = 3
9325	IF ( TRIM( vari ) == '4' ) b = 4
9326	IF ( TRIM( vari ) == '5' ) b = 5
9327	IF ( TRIM( vari ) == '6' ) b = 6
9328	IF ( TRIM( vari ) == '7' ) b = 7
9329	IF ( TRIM( vari ) == '8' ) b = 8
9330	IF ( TRIM( vari ) == '9' ) b = 9
9331	IF ( TRIM( vari ) == '10' ) b = 10
9332	IF ( TRIM( vari ) == '11' ) b = 11
9333	IF ( TRIM( vari ) == '12' ) b = 12
9334
9335	IF ( av == 0 ) THEN
9336	DO i = nxl, nxr
9337	DO j = nys, nyn
9338	DO k = nzb_do, nzt_do
9339	local_pf(i,j,k) = MERGE( aerosol_number(b)%conc(k,j,i), &
9340	REAL( fill_value, KIND = wp ), &
9341	BTEST( wall_flags_0(k,j,i), 0 ) )
9342	ENDDO
9343	ENDDO
9344	ENDDO
9345	ELSE
9346	DO i = nxl, nxr
9347	DO j = nys, nyn
9348	DO k = nzb_do, nzt_do
9349	local_pf(i,j,k) = MERGE( Nbins_av(k,j,i,b), &
9350	REAL( fill_value, KIND = wp ), &
9351	BTEST( wall_flags_0(k,j,i), 0 ) )
9352	ENDDO
9353	ENDDO
9354	ENDDO
9355	ENDIF
9356
9357	IF ( mode == 'xy' ) grid = 'zu'
9358
9359	ELSEIF ( TRIM( variable(1:4) ) == 'Ntot' ) THEN
9360	IF ( av == 0 ) THEN
9361	DO i = nxl, nxr
9362	DO j = nys, nyn
9363	DO k = nzb_do, nzt_do
9364	temp_bin = 0.0_wp
9365	DO b = 1, nbins
9366	temp_bin = temp_bin + aerosol_number(b)%conc(k,j,i)
9367	ENDDO
9368	local_pf(i,j,k) = MERGE( temp_bin, REAL( fill_value, KIND = &
9369	wp ), BTEST( wall_flags_0(k,j,i), 0 ) )
9370	ENDDO
9371	ENDDO
9372	ENDDO
9373	ELSE
9374	DO i = nxl, nxr
9375	DO j = nys, nyn
9376	DO k = nzb_do, nzt_do
9377	local_pf(i,j,k) = MERGE( Ntot_av(k,j,i), REAL( fill_value, &
9378	KIND = wp ), BTEST( &
9379	wall_flags_0(k,j,i), 0 ) )
9380	ENDDO
9381	ENDDO
9382	ENDDO
9383	ENDIF
9384
9385	IF ( mode == 'xy' ) grid = 'zu'
9386
9387
9388	ELSEIF ( TRIM( variable(1:5) ) == 'm_bin' ) THEN
9389
9390	vari = TRIM( variable( 6:LEN( TRIM( variable ) ) - 3 ) )
9391
9392	IF ( TRIM( vari ) == '1' ) b = 1
9393	IF ( TRIM( vari ) == '2' ) b = 2
9394	IF ( TRIM( vari ) == '3' ) b = 3
9395	IF ( TRIM( vari ) == '4' ) b = 4
9396	IF ( TRIM( vari ) == '5' ) b = 5
9397	IF ( TRIM( vari ) == '6' ) b = 6
9398	IF ( TRIM( vari ) == '7' ) b = 7
9399	IF ( TRIM( vari ) == '8' ) b = 8
9400	IF ( TRIM( vari ) == '9' ) b = 9
9401	IF ( TRIM( vari ) == '10' ) b = 10
9402	IF ( TRIM( vari ) == '11' ) b = 11
9403	IF ( TRIM( vari ) == '12' ) b = 12
9404
9405	IF ( av == 0 ) THEN
9406	DO i = nxl, nxr
9407	DO j = nys, nyn
9408	DO k = nzb_do, nzt_do
9409	temp_bin = 0.0_wp
9410	DO c = b, ncc_tot * nbins, nbins
9411	temp_bin = temp_bin + aerosol_mass(c)%conc(k,j,i)
9412	ENDDO
9413	local_pf(i,j,k) = MERGE( temp_bin, REAL( fill_value, &
9414	KIND = wp ), BTEST( &
9415	wall_flags_0(k,j,i), 0 ) )
9416	ENDDO
9417	ENDDO
9418	ENDDO
9419	ELSE
9420	DO i = nxl, nxr
9421	DO j = nys, nyn
9422	DO k = nzb_do, nzt_do
9423	local_pf(i,j,k) = MERGE( mbins_av(k,j,i,b), REAL( fill_value,&
9424	KIND = wp ), BTEST( &
9425	wall_flags_0(k,j,i), 0 ) )
9426	ENDDO
9427	ENDDO
9428	ENDDO
9429	ENDIF
9430
9431	IF ( mode == 'xy' ) grid = 'zu'
9432
9433	ELSEIF ( TRIM( variable(1:5) ) == 'PM2.5' ) THEN
9434	IF ( av == 0 ) THEN
9435	DO i = nxl, nxr
9436	DO j = nys, nyn
9437	DO k = nzb_do, nzt_do
9438	temp_bin = 0.0_wp
9439	DO b = 1, nbins
9440	IF ( 2.0_wp * Ra_dry(k,j,i,b) <= 2.5E-6_wp ) THEN
9441	DO c = b, nbins*ncc, nbins
9442	temp_bin = temp_bin + aerosol_mass(c)%conc(k,j,i)
9443	ENDDO
9444	ENDIF
9445	ENDDO
9446	local_pf(i,j,k) = MERGE( temp_bin, REAL( fill_value, &
9447	KIND = wp ), BTEST( &
9448	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_do, nzt_do
9456	local_pf(i,j,k) = MERGE( PM25_av(k,j,i), REAL( fill_value, &
9457	KIND = wp ), BTEST( &
9458	wall_flags_0(k,j,i), 0 ) )
9459	ENDDO
9460	ENDDO
9461	ENDDO
9462	ENDIF
9463
9464	IF ( mode == 'xy' ) grid = 'zu'
9465
9466
9467	ELSEIF ( TRIM( variable(1:4) ) == 'PM10' ) THEN
9468	IF ( av == 0 ) THEN
9469	DO i = nxl, nxr
9470	DO j = nys, nyn
9471	DO k = nzb_do, nzt_do
9472	temp_bin = 0.0_wp
9473	DO b = 1, nbins
9474	IF ( 2.0_wp * Ra_dry(k,j,i,b) <= 10.0E-6_wp ) THEN
9475	DO c = b, nbins*ncc, nbins
9476	temp_bin = temp_bin + aerosol_mass(c)%conc(k,j,i)
9477	ENDDO
9478	ENDIF
9479	ENDDO
9480	local_pf(i,j,k) = MERGE( temp_bin, REAL( fill_value, &
9481	KIND = wp ), BTEST( &
9482	wall_flags_0(k,j,i), 0 ) )
9483	ENDDO
9484	ENDDO
9485	ENDDO
9486	ELSE
9487	DO i = nxl, nxr
9488	DO j = nys, nyn
9489	DO k = nzb_do, nzt_do
9490	local_pf(i,j,k) = MERGE( PM10_av(k,j,i), REAL( fill_value, &
9491	KIND = wp ), BTEST( &
9492	wall_flags_0(k,j,i), 0 ) )
9493	ENDDO
9494	ENDDO
9495	ENDDO
9496	ENDIF
9497
9498	IF ( mode == 'xy' ) grid = 'zu'
9499
9500	ELSEIF ( TRIM( variable(1:2) ) == 's_' ) THEN
9501	vari = TRIM( variable( 3:LEN( TRIM( variable ) ) - 3 ) )
9502	IF ( is_used( prtcl, vari ) ) THEN
9503	icc = get_index( prtcl, vari )
9504	IF ( av == 0 ) THEN
9505	DO i = nxl, nxr
9506	DO j = nys, nyn
9507	DO k = nzb_do, nzt_do
9508	temp_bin = 0.0_wp
9509	DO c = ( icc-1 )nbins+1, iccnbins, 1
9510	temp_bin = temp_bin + aerosol_mass(c)%conc(k,j,i)
9511	ENDDO
9512	local_pf(i,j,k) = MERGE( temp_bin, REAL( fill_value, &
9513	KIND = wp ), BTEST( &
9514	wall_flags_0(k,j,i), 0 ) )
9515	ENDDO
9516	ENDDO
9517	ENDDO
9518	ELSE
9519	IF ( vari == 'BC' ) to_be_resorted => s_BC_av
9520	IF ( vari == 'DU' ) to_be_resorted => s_DU_av
9521	IF ( vari == 'NH' ) to_be_resorted => s_NH_av
9522	IF ( vari == 'NO' ) to_be_resorted => s_NO_av
9523	IF ( vari == 'OC' ) to_be_resorted => s_OC_av
9524	IF ( vari == 'SO4' ) to_be_resorted => s_SO4_av
9525	IF ( vari == 'SS' ) to_be_resorted => s_SS_av
9526	DO i = nxl, nxr
9527	DO j = nys, nyn
9528	DO k = nzb_do, nzt_do
9529	local_pf(i,j,k) = MERGE( to_be_resorted(k,j,i), &
9530	REAL( fill_value, KIND = wp ), &
9531	BTEST( wall_flags_0(k,j,i), 0 ) )
9532	ENDDO
9533	ENDDO
9534	ENDDO
9535	ENDIF
9536	ELSE
9537	local_pf = fill_value
9538	ENDIF
9539
9540	IF ( mode == 'xy' ) grid = 'zu'
9541
9542	ELSE
9543	found = .FALSE.
9544	grid = 'none'
9545
9546	ENDIF
9547
9548	END SUBROUTINE salsa_data_output_2d
9549
9550
9551	!------------------------------------------------------------------------------!
9552	!
9553	! Description:
9554	! ------------
9555	!> Subroutine defining 3D output variables
9556	!------------------------------------------------------------------------------!
9557	SUBROUTINE salsa_data_output_3d( av, variable, found, local_pf, nzb_do, &
9558	nzt_do )
9559
9560	USE indices
9561
9562	USE kinds
9563
9564
9565	IMPLICIT NONE
9566
9567	CHARACTER (LEN=*), INTENT(in) :: variable !<
9568
9569	INTEGER(iwp) :: av !<
9570	INTEGER(iwp) :: b !< running index: size bins
9571	INTEGER(iwp) :: c !< running index: mass bins
9572	INTEGER(iwp) :: i !<
9573	INTEGER(iwp) :: icc !< index of a chemical compound
9574	INTEGER(iwp) :: j !<
9575	INTEGER(iwp) :: k !<
9576	INTEGER(iwp) :: nzb_do !<
9577	INTEGER(iwp) :: nzt_do !<
9578
9579	LOGICAL :: found !<
9580
9581	REAL(wp) :: df !< For calculating LDSA: fraction of particles
9582	!< depositing in the alveolar (or tracheobronchial)
9583	!< region of the lung. Depends on the particle size
9584	REAL(wp) :: fill_value = -9999.0_wp !< value for the _FillValue attribute
9585	REAL(wp) :: mean_d !< Particle diameter in micrometres
9586	REAL(wp) :: nc !< Particle number concentration in units 1/cm**3
9587	REAL(wp) :: temp_bin !< temporary array for calculating output variables
9588
9589	REAL(sp), DIMENSION(nxl:nxr,nys:nyn,nzb_do:nzt_do) :: local_pf !< local
9590
9591	REAL(wp), DIMENSION(:,:,:), POINTER :: to_be_resorted !< pointer
9592
9593
9594	found = .TRUE.
9595	temp_bin = 0.0_wp
9596
9597	SELECT CASE ( TRIM( variable ) )
9598
9599	CASE ( 'g_H2SO4', 'g_HNO3', 'g_NH3', 'g_OCNV', 'g_OCSV' )
9600	IF ( av == 0 ) THEN
9601	IF ( TRIM( variable ) == 'g_H2SO4') icc = 1
9602	IF ( TRIM( variable ) == 'g_HNO3') icc = 2
9603	IF ( TRIM( variable ) == 'g_NH3') icc = 3
9604	IF ( TRIM( variable ) == 'g_OCNV') icc = 4
9605	IF ( TRIM( variable ) == 'g_OCSV') icc = 5
9606
9607	DO i = nxl, nxr
9608	DO j = nys, nyn
9609	DO k = nzb_do, nzt_do
9610	local_pf(i,j,k) = MERGE( salsa_gas(icc)%conc(k,j,i), &
9611	REAL( fill_value, KIND = wp ), &
9612	BTEST( wall_flags_0(k,j,i), 0 ) )
9613	ENDDO
9614	ENDDO
9615	ENDDO
9616	ELSE
9617	IF ( TRIM( variable(3:) ) == 'H2SO4' ) to_be_resorted => g_H2SO4_av
9618	IF ( TRIM( variable(3:) ) == 'HNO3' ) to_be_resorted => g_HNO3_av
9619	IF ( TRIM( variable(3:) ) == 'NH3' ) to_be_resorted => g_NH3_av
9620	IF ( TRIM( variable(3:) ) == 'OCNV' ) to_be_resorted => g_OCNV_av
9621	IF ( TRIM( variable(3:) ) == 'OCSV' ) to_be_resorted => g_OCSV_av
9622	DO i = nxl, nxr
9623	DO j = nys, nyn
9624	DO k = nzb_do, nzt_do
9625	local_pf(i,j,k) = MERGE( to_be_resorted(k,j,i), &
9626	REAL( fill_value, KIND = wp ), &
9627	BTEST( wall_flags_0(k,j,i), 0 ) )
9628	ENDDO
9629	ENDDO
9630	ENDDO
9631	ENDIF
9632
9633	CASE ( 'LDSA' )
9634	IF ( av == 0 ) THEN
9635	DO i = nxl, nxr
9636	DO j = nys, nyn
9637	DO k = nzb_do, nzt_do
9638	temp_bin = 0.0_wp
9639	DO b = 1, nbins
9640	!
9641	!-- Diameter in micrometres
9642	mean_d = 1.0E+6_wp * Ra_dry(k,j,i,b) * 2.0_wp
9643	!
9644	!-- Deposition factor: alveolar
9645	df = ( 0.01555_wp / mean_d ) * ( EXP( -0.416_wp * &
9646	( LOG( mean_d ) + 2.84_wp )**2.0_wp ) + 19.11_wp &
9647	* EXP( -0.482_wp * ( LOG( mean_d ) - 1.362_wp &
9648	)**2.0_wp ) )
9649	!
9650	!-- Number concentration in 1/cm3
9651	nc = 1.0E-6_wp * aerosol_number(b)%conc(k,j,i)
9652	!
9653	!-- Lung-deposited surface area LDSA (units mum2/cm3)
9654	temp_bin = temp_bin + pi * mean_d*2.0_wp df * nc
9655	ENDDO
9656	local_pf(i,j,k) = MERGE( temp_bin, &
9657	REAL( fill_value, KIND = wp ), &
9658	BTEST( wall_flags_0(k,j,i), 0 ) )
9659	ENDDO
9660	ENDDO
9661	ENDDO
9662	ELSE
9663	DO i = nxl, nxr
9664	DO j = nys, nyn
9665	DO k = nzb_do, nzt_do
9666	local_pf(i,j,k) = MERGE( LDSA_av(k,j,i), &
9667	REAL( fill_value, KIND = wp ), &
9668	BTEST( wall_flags_0(k,j,i), 0 ) )
9669	ENDDO
9670	ENDDO
9671	ENDDO
9672	ENDIF
9673
9674	CASE ( 'N_bin1', 'N_bin2', 'N_bin3', 'N_bin4', 'N_bin5', 'N_bin6', &
9675	'N_bin7', 'N_bin8', 'N_bin9', 'N_bin10' , 'N_bin11', 'N_bin12' )
9676	IF ( TRIM( variable(6:) ) == '1' ) b = 1
9677	IF ( TRIM( variable(6:) ) == '2' ) b = 2
9678	IF ( TRIM( variable(6:) ) == '3' ) b = 3
9679	IF ( TRIM( variable(6:) ) == '4' ) b = 4
9680	IF ( TRIM( variable(6:) ) == '5' ) b = 5
9681	IF ( TRIM( variable(6:) ) == '6' ) b = 6
9682	IF ( TRIM( variable(6:) ) == '7' ) b = 7
9683	IF ( TRIM( variable(6:) ) == '8' ) b = 8
9684	IF ( TRIM( variable(6:) ) == '9' ) b = 9
9685	IF ( TRIM( variable(6:) ) == '10' ) b = 10
9686	IF ( TRIM( variable(6:) ) == '11' ) b = 11
9687	IF ( TRIM( variable(6:) ) == '12' ) b = 12
9688
9689	IF ( av == 0 ) THEN
9690	DO i = nxl, nxr
9691	DO j = nys, nyn
9692	DO k = nzb_do, nzt_do
9693	local_pf(i,j,k) = MERGE( aerosol_number(b)%conc(k,j,i), &
9694	REAL( fill_value, KIND = wp ), &
9695	BTEST( wall_flags_0(k,j,i), 0 ) )
9696	ENDDO
9697	ENDDO
9698	ENDDO
9699	ELSE
9700	DO i = nxl, nxr
9701	DO j = nys, nyn
9702	DO k = nzb_do, nzt_do
9703	local_pf(i,j,k) = MERGE( Nbins_av(k,j,i,b), &
9704	REAL( fill_value, KIND = wp ), &
9705	BTEST( wall_flags_0(k,j,i), 0 ) )
9706	ENDDO
9707	ENDDO
9708	ENDDO
9709	ENDIF
9710
9711	CASE ( 'Ntot' )
9712	IF ( av == 0 ) THEN
9713	DO i = nxl, nxr
9714	DO j = nys, nyn
9715	DO k = nzb_do, nzt_do
9716	temp_bin = 0.0_wp
9717	DO b = 1, nbins
9718	temp_bin = temp_bin + aerosol_number(b)%conc(k,j,i)
9719	ENDDO
9720	local_pf(i,j,k) = MERGE( temp_bin, &
9721	REAL( fill_value, KIND = wp ), &
9722	BTEST( wall_flags_0(k,j,i), 0 ) )
9723	ENDDO
9724	ENDDO
9725	ENDDO
9726	ELSE
9727	DO i = nxl, nxr
9728	DO j = nys, nyn
9729	DO k = nzb_do, nzt_do
9730	local_pf(i,j,k) = MERGE( Ntot_av(k,j,i), &
9731	REAL( fill_value, KIND = wp ), &
9732	BTEST( wall_flags_0(k,j,i), 0 ) )
9733	ENDDO
9734	ENDDO
9735	ENDDO
9736	ENDIF
9737
9738	CASE ( 'm_bin1', 'm_bin2', 'm_bin3', 'm_bin4', 'm_bin5', 'm_bin6', &
9739	'm_bin7', 'm_bin8', 'm_bin9', 'm_bin10' , 'm_bin11', 'm_bin12' )
9740	IF ( TRIM( variable(6:) ) == '1' ) b = 1
9741	IF ( TRIM( variable(6:) ) == '2' ) b = 2
9742	IF ( TRIM( variable(6:) ) == '3' ) b = 3
9743	IF ( TRIM( variable(6:) ) == '4' ) b = 4
9744	IF ( TRIM( variable(6:) ) == '5' ) b = 5
9745	IF ( TRIM( variable(6:) ) == '6' ) b = 6
9746	IF ( TRIM( variable(6:) ) == '7' ) b = 7
9747	IF ( TRIM( variable(6:) ) == '8' ) b = 8
9748	IF ( TRIM( variable(6:) ) == '9' ) b = 9
9749	IF ( TRIM( variable(6:) ) == '10' ) b = 10
9750	IF ( TRIM( variable(6:) ) == '11' ) b = 11
9751	IF ( TRIM( variable(6:) ) == '12' ) b = 12
9752
9753	IF ( av == 0 ) THEN
9754	DO i = nxl, nxr
9755	DO j = nys, nyn
9756	DO k = nzb_do, nzt_do
9757	temp_bin = 0.0_wp
9758	DO c = b, ncc_tot * nbins, nbins
9759	temp_bin = temp_bin + aerosol_mass(c)%conc(k,j,i)
9760	ENDDO
9761	local_pf(i,j,k) = MERGE( temp_bin, &
9762	REAL( fill_value, KIND = wp ), &
9763	BTEST( wall_flags_0(k,j,i), 0 ) )
9764	ENDDO
9765	ENDDO
9766	ENDDO
9767	ELSE
9768	DO i = nxl, nxr
9769	DO j = nys, nyn
9770	DO k = nzb_do, nzt_do
9771	local_pf(i,j,k) = MERGE( mbins_av(k,j,i,b), &
9772	REAL( fill_value, KIND = wp ), &
9773	BTEST( wall_flags_0(k,j,i), 0 ) )
9774	ENDDO
9775	ENDDO
9776	ENDDO
9777	ENDIF
9778
9779	CASE ( 'PM2.5' )
9780	IF ( av == 0 ) THEN
9781	DO i = nxl, nxr
9782	DO j = nys, nyn
9783	DO k = nzb_do, nzt_do
9784	temp_bin = 0.0_wp
9785	DO b = 1, nbins
9786	IF ( 2.0_wp * Ra_dry(k,j,i,b) <= 2.5E-6_wp ) THEN
9787	DO c = b, nbins * ncc, nbins
9788	temp_bin = temp_bin + aerosol_mass(c)%conc(k,j,i)
9789	ENDDO
9790	ENDIF
9791	ENDDO
9792	local_pf(i,j,k) = MERGE( temp_bin, &
9793	REAL( fill_value, KIND = wp ), &
9794	BTEST( wall_flags_0(k,j,i), 0 ) )
9795	ENDDO
9796	ENDDO
9797	ENDDO
9798	ELSE
9799	DO i = nxl, nxr
9800	DO j = nys, nyn
9801	DO k = nzb_do, nzt_do
9802	local_pf(i,j,k) = MERGE( PM25_av(k,j,i), &
9803	REAL( fill_value, KIND = wp ), &
9804	BTEST( wall_flags_0(k,j,i), 0 ) )
9805	ENDDO
9806	ENDDO
9807	ENDDO
9808	ENDIF
9809
9810	CASE ( 'PM10' )
9811	IF ( av == 0 ) THEN
9812	DO i = nxl, nxr
9813	DO j = nys, nyn
9814	DO k = nzb_do, nzt_do
9815	temp_bin = 0.0_wp
9816	DO b = 1, nbins
9817	IF ( 2.0_wp * Ra_dry(k,j,i,b) <= 10.0E-6_wp ) THEN
9818	DO c = b, nbins * ncc, nbins
9819	temp_bin = temp_bin + aerosol_mass(c)%conc(k,j,i)
9820	ENDDO
9821	ENDIF
9822	ENDDO
9823	local_pf(i,j,k) = MERGE( temp_bin, &
9824	REAL( fill_value, KIND = wp ), &
9825	BTEST( wall_flags_0(k,j,i), 0 ) )
9826	ENDDO
9827	ENDDO
9828	ENDDO
9829	ELSE
9830	DO i = nxl, nxr
9831	DO j = nys, nyn
9832	DO k = nzb_do, nzt_do
9833	local_pf(i,j,k) = MERGE( PM10_av(k,j,i), &
9834	REAL( fill_value, KIND = wp ), &
9835	BTEST( wall_flags_0(k,j,i), 0 ) )
9836	ENDDO
9837	ENDDO
9838	ENDDO
9839	ENDIF
9840
9841	CASE ( 's_BC', 's_DU', 's_H2O', 's_NH', 's_NO', 's_OC', 's_SO4', 's_SS' )
9842	IF ( is_used( prtcl, TRIM( variable(3:) ) ) ) THEN
9843	icc = get_index( prtcl, TRIM( variable(3:) ) )
9844	IF ( av == 0 ) THEN
9845	DO i = nxl, nxr
9846	DO j = nys, nyn
9847	DO k = nzb_do, nzt_do
9848	temp_bin = 0.0_wp
9849	DO c = ( icc-1 )nbins+1, iccnbins
9850	temp_bin = temp_bin + aerosol_mass(c)%conc(k,j,i)
9851	ENDDO
9852	local_pf(i,j,k) = MERGE( temp_bin, &
9853	REAL( fill_value, KIND = wp ), &
9854	BTEST( wall_flags_0(k,j,i), 0 ) )
9855	ENDDO
9856	ENDDO
9857	ENDDO
9858	ELSE
9859	IF ( TRIM( variable(3:) ) == 'BC' ) to_be_resorted => s_BC_av
9860	IF ( TRIM( variable(3:) ) == 'DU' ) to_be_resorted => s_DU_av
9861	IF ( TRIM( variable(3:) ) == 'NH' ) to_be_resorted => s_NH_av
9862	IF ( TRIM( variable(3:) ) == 'NO' ) to_be_resorted => s_NO_av
9863	IF ( TRIM( variable(3:) ) == 'OC' ) to_be_resorted => s_OC_av
9864	IF ( TRIM( variable(3:) ) == 'SO4' ) to_be_resorted => s_SO4_av
9865	IF ( TRIM( variable(3:) ) == 'SS' ) to_be_resorted => s_SS_av
9866	DO i = nxl, nxr
9867	DO j = nys, nyn
9868	DO k = nzb_do, nzt_do
9869	local_pf(i,j,k) = MERGE( to_be_resorted(k,j,i), &
9870	REAL( fill_value, KIND = wp ), &
9871	BTEST( wall_flags_0(k,j,i), 0 ) )
9872	ENDDO
9873	ENDDO
9874	ENDDO
9875	ENDIF
9876	ENDIF
9877	CASE DEFAULT
9878	found = .FALSE.
9879
9880	END SELECT
9881
9882	END SUBROUTINE salsa_data_output_3d
9883
9884	!------------------------------------------------------------------------------!
9885	!
9886	! Description:
9887	! ------------
9888	!> Subroutine defining mask output variables
9889	!------------------------------------------------------------------------------!
9890	SUBROUTINE salsa_data_output_mask( av, variable, found, local_pf )
9891
9892	USE arrays_3d, &
9893	ONLY: tend
9894
9895	USE control_parameters, &
9896	ONLY: mask_size_l, mask_surface, mid
9897
9898	USE surface_mod, &
9899	ONLY: get_topography_top_index_ji
9900
9901	IMPLICIT NONE
9902
9903	CHARACTER(LEN=5) :: grid !< flag to distinquish between staggered grid
9904	CHARACTER(LEN=*) :: variable !<
9905	CHARACTER(LEN=7) :: vari !< trimmed format of variable
9906
9907	INTEGER(iwp) :: av !<
9908	INTEGER(iwp) :: b !< loop index for aerosol size number bins
9909	INTEGER(iwp) :: c !< loop index for chemical components
9910	INTEGER(iwp) :: i !< loop index in x-direction
9911	INTEGER(iwp) :: icc !< index of a chemical compound
9912	INTEGER(iwp) :: j !< loop index in y-direction
9913	INTEGER(iwp) :: k !< loop index in z-direction
9914	INTEGER(iwp) :: topo_top_ind !< k index of highest horizontal surface
9915
9916	LOGICAL :: found !<
9917	LOGICAL :: resorted !<
9918
9919	REAL(wp) :: df !< For calculating LDSA: fraction of particles
9920	!< depositing in the alveolar (or tracheobronchial)
9921	!< region of the lung. Depends on the particle size
9922	REAL(wp) :: mean_d !< Particle diameter in micrometres
9923	REAL(wp) :: nc !< Particle number concentration in units 1/cm**3
9924	REAL(wp) :: temp_bin !< temporary array for calculating output variables
9925
9926	REAL(wp), DIMENSION(mask_size_l(mid,1),mask_size_l(mid,2),mask_size_l(mid,3)) :: local_pf !<
9927
9928	REAL(wp), DIMENSION(:,:,:), POINTER :: to_be_resorted !< pointer
9929
9930	found = .TRUE.
9931	resorted = .FALSE.
9932	grid = 's'
9933	temp_bin = 0.0_wp
9934
9935	SELECT CASE ( TRIM( variable ) )
9936
9937	CASE ( 'g_H2SO4', 'g_HNO3', 'g_NH3', 'g_OCNV', 'g_OCSV' )
9938	vari = TRIM( variable )
9939	IF ( av == 0 ) THEN
9940	IF ( vari == 'g_H2SO4') to_be_resorted => salsa_gas(1)%conc
9941	IF ( vari == 'g_HNO3') to_be_resorted => salsa_gas(2)%conc
9942	IF ( vari == 'g_NH3') to_be_resorted => salsa_gas(3)%conc
9943	IF ( vari == 'g_OCNV') to_be_resorted => salsa_gas(4)%conc
9944	IF ( vari == 'g_OCSV') to_be_resorted => salsa_gas(5)%conc
9945	ELSE
9946	IF ( vari == 'g_H2SO4') to_be_resorted => g_H2SO4_av
9947	IF ( vari == 'g_HNO3') to_be_resorted => g_HNO3_av
9948	IF ( vari == 'g_NH3') to_be_resorted => g_NH3_av
9949	IF ( vari == 'g_OCNV') to_be_resorted => g_OCNV_av
9950	IF ( vari == 'g_OCSV') to_be_resorted => g_OCSV_av
9951	ENDIF
9952
9953	CASE ( 'LDSA' )
9954	IF ( av == 0 ) THEN
9955	DO i = nxl, nxr
9956	DO j = nys, nyn
9957	DO k = nzb, nz_do3d
9958	temp_bin = 0.0_wp
9959	DO b = 1, nbins
9960	!
9961	!-- Diameter in micrometres
9962	mean_d = 1.0E+6_wp * Ra_dry(k,j,i,b) * 2.0_wp
9963	!
9964	!-- Deposition factor: alveolar
9965	df = ( 0.01555_wp / mean_d ) * ( EXP( -0.416_wp * &
9966	( LOG( mean_d ) + 2.84_wp )**2.0_wp ) + 19.11_wp &
9967	* EXP( -0.482_wp * ( LOG( mean_d ) - 1.362_wp &
9968	)**2.0_wp ) )
9969	!
9970	!-- Number concentration in 1/cm3
9971	nc = 1.0E-6_wp * aerosol_number(b)%conc(k,j,i)
9972	!
9973	!-- Lung-deposited surface area LDSA (units mum2/cm3)
9974	temp_bin = temp_bin + pi * mean_d*2.0_wp df * nc
9975	ENDDO
9976	tend(k,j,i) = temp_bin
9977	ENDDO
9978	ENDDO
9979	ENDDO
9980	IF ( .NOT. mask_surface(mid) ) THEN
9981	DO i = 1, mask_size_l(mid,1)
9982	DO j = 1, mask_size_l(mid,2)
9983	DO k = 1, mask_size_l(mid,3)
9984	local_pf(i,j,k) = tend( mask_k(mid,k), mask_j(mid,j),&
9985	mask_i(mid,i) )
9986	ENDDO
9987	ENDDO
9988	ENDDO
9989	ELSE
9990	DO i = 1, mask_size_l(mid,1)
9991	DO j = 1, mask_size_l(mid,2)
9992	topo_top_ind = get_topography_top_index_ji( mask_j(mid,j),&
9993	mask_i(mid,i),&
9994	grid )
9995	DO k = 1, mask_size_l(mid,3)
9996	local_pf(i,j,k) = tend( MIN( topo_top_ind+mask_k(mid,k),&
9997	nzt+1 ), &
9998	mask_j(mid,j), mask_i(mid,i) )
9999	ENDDO
10000	ENDDO
10001	ENDDO
10002	ENDIF
10003	resorted = .TRUE.
10004	ELSE
10005	to_be_resorted => LDSA_av
10006	ENDIF
10007
10008	CASE ( 'N_bin1', 'N_bin2', 'N_bin3', 'N_bin4', 'N_bin5', 'N_bin6', &
10009	'N_bin7', 'N_bin8', 'N_bin9', 'N_bin10' , 'N_bin11', 'N_bin12' )
10010	IF ( TRIM( variable(6:) ) == '1' ) b = 1
10011	IF ( TRIM( variable(6:) ) == '2' ) b = 2
10012	IF ( TRIM( variable(6:) ) == '3' ) b = 3
10013	IF ( TRIM( variable(6:) ) == '4' ) b = 4
10014	IF ( TRIM( variable(6:) ) == '5' ) b = 5
10015	IF ( TRIM( variable(6:) ) == '6' ) b = 6
10016	IF ( TRIM( variable(6:) ) == '7' ) b = 7
10017	IF ( TRIM( variable(6:) ) == '8' ) b = 8
10018	IF ( TRIM( variable(6:) ) == '9' ) b = 9
10019	IF ( TRIM( variable(6:) ) == '10' ) b = 10
10020	IF ( TRIM( variable(6:) ) == '11' ) b = 11
10021	IF ( TRIM( variable(6:) ) == '12' ) b = 12
10022
10023	IF ( av == 0 ) THEN
10024	IF ( .NOT. mask_surface(mid) ) THEN
10025	DO i = 1, mask_size_l(mid,1)
10026	DO j = 1, mask_size_l(mid,2)
10027	DO k = 1, mask_size_l(mid,3)
10028	local_pf(i,j,k) = aerosol_number(b)%conc( mask_k(mid,k),&
10029	mask_j(mid,j),&
10030	mask_i(mid,i) )
10031	ENDDO
10032	ENDDO
10033	ENDDO
10034	ELSE
10035	DO i = 1, mask_size_l(mid,1)
10036	DO j = 1, mask_size_l(mid,2)
10037	topo_top_ind = get_topography_top_index_ji( mask_j(mid,j),&
10038	mask_i(mid,i),&
10039	grid )
10040	DO k = 1, mask_size_l(mid,3)
10041	local_pf(i,j,k) = aerosol_number(b)%conc( &
10042	MIN( topo_top_ind+mask_k(mid,k), &
10043	nzt+1 ), &
10044	mask_j(mid,j), mask_i(mid,i) )
10045	ENDDO
10046	ENDDO
10047	ENDDO
10048	ENDIF
10049	resorted = .TRUE.
10050	ELSE
10051	to_be_resorted => Nbins_av(:,:,:,b)
10052	ENDIF
10053
10054	CASE ( 'Ntot' )
10055	IF ( av == 0 ) THEN
10056	DO i = nxl, nxr
10057	DO j = nys, nyn
10058	DO k = nzb, nz_do3d
10059	temp_bin = 0.0_wp
10060	DO b = 1, nbins
10061	temp_bin = temp_bin + aerosol_number(b)%conc(k,j,i)
10062	ENDDO
10063	tend(k,j,i) = temp_bin
10064	ENDDO
10065	ENDDO
10066	ENDDO
10067	IF ( .NOT. mask_surface(mid) ) THEN
10068	DO i = 1, mask_size_l(mid,1)
10069	DO j = 1, mask_size_l(mid,2)
10070	DO k = 1, mask_size_l(mid,3)
10071	local_pf(i,j,k) = tend( mask_k(mid,k), mask_j(mid,j),&
10072	mask_i(mid,i) )
10073	ENDDO
10074	ENDDO
10075	ENDDO
10076	ELSE
10077	DO i = 1, mask_size_l(mid,1)
10078	DO j = 1, mask_size_l(mid,2)
10079	topo_top_ind = get_topography_top_index_ji( mask_j(mid,j),&
10080	mask_i(mid,i),&
10081	grid )
10082	DO k = 1, mask_size_l(mid,3)
10083	local_pf(i,j,k) = tend( MIN( topo_top_ind+mask_k(mid,k),&
10084	nzt+1 ), &
10085	mask_j(mid,j), mask_i(mid,i) )
10086	ENDDO
10087	ENDDO
10088	ENDDO
10089	ENDIF
10090	resorted = .TRUE.
10091	ELSE
10092	to_be_resorted => Ntot_av
10093	ENDIF
10094
10095	CASE ( 'm_bin1', 'm_bin2', 'm_bin3', 'm_bin4', 'm_bin5', 'm_bin6', &
10096	'm_bin7', 'm_bin8', 'm_bin9', 'm_bin10' , 'm_bin11', 'm_bin12' )
10097	IF ( TRIM( variable(6:) ) == '1' ) b = 1
10098	IF ( TRIM( variable(6:) ) == '2' ) b = 2
10099	IF ( TRIM( variable(6:) ) == '3' ) b = 3
10100	IF ( TRIM( variable(6:) ) == '4' ) b = 4
10101	IF ( TRIM( variable(6:) ) == '5' ) b = 5
10102	IF ( TRIM( variable(6:) ) == '6' ) b = 6
10103	IF ( TRIM( variable(6:) ) == '7' ) b = 7
10104	IF ( TRIM( variable(6:) ) == '8' ) b = 8
10105	IF ( TRIM( variable(6:) ) == '9' ) b = 9
10106	IF ( TRIM( variable(6:) ) == '10' ) b = 10
10107	IF ( TRIM( variable(6:) ) == '11' ) b = 11
10108	IF ( TRIM( variable(6:) ) == '12' ) b = 12
10109
10110	IF ( av == 0 ) THEN
10111	DO i = nxl, nxr
10112	DO j = nys, nyn
10113	DO k = nzb, nz_do3d
10114	temp_bin = 0.0_wp
10115	DO c = b, ncc_tot*nbins, nbins
10116	temp_bin = temp_bin + aerosol_mass(c)%conc(k,j,i)
10117	ENDDO
10118	tend(k,j,i) = temp_bin
10119	ENDDO
10120	ENDDO
10121	ENDDO
10122	IF ( .NOT. mask_surface(mid) ) THEN
10123	DO i = 1, mask_size_l(mid,1)
10124	DO j = 1, mask_size_l(mid,2)
10125	DO k = 1, mask_size_l(mid,3)
10126	local_pf(i,j,k) = tend( mask_k(mid,k), mask_j(mid,j),&
10127	mask_i(mid,i) )
10128	ENDDO
10129	ENDDO
10130	ENDDO
10131	ELSE
10132	DO i = 1, mask_size_l(mid,1)
10133	DO j = 1, mask_size_l(mid,2)
10134	topo_top_ind = get_topography_top_index_ji( mask_j(mid,j),&
10135	mask_i(mid,i),&
10136	grid )
10137	DO k = 1, mask_size_l(mid,3)
10138	local_pf(i,j,k) = tend( MIN( topo_top_ind+mask_k(mid,k),&
10139	nzt+1 ), &
10140	mask_j(mid,j), mask_i(mid,i) )
10141	ENDDO
10142	ENDDO
10143	ENDDO
10144	ENDIF
10145	resorted = .TRUE.
10146	ELSE
10147	to_be_resorted => mbins_av(:,:,:,b)
10148	ENDIF
10149
10150	CASE ( 'PM2.5' )
10151	IF ( av == 0 ) THEN
10152	DO i = nxl, nxr
10153	DO j = nys, nyn
10154	DO k = nzb, nz_do3d
10155	temp_bin = 0.0_wp
10156	DO b = 1, nbins
10157	IF ( 2.0_wp * Ra_dry(k,j,i,b) <= 2.5E-6_wp ) THEN
10158	DO c = b, nbins * ncc, nbins
10159	temp_bin = temp_bin + aerosol_mass(c)%conc(k,j,i)
10160	ENDDO
10161	ENDIF
10162	ENDDO
10163	tend(k,j,i) = temp_bin
10164	ENDDO
10165	ENDDO
10166	ENDDO
10167	IF ( .NOT. mask_surface(mid) ) THEN
10168	DO i = 1, mask_size_l(mid,1)
10169	DO j = 1, mask_size_l(mid,2)
10170	DO k = 1, mask_size_l(mid,3)
10171	local_pf(i,j,k) = tend( mask_k(mid,k), mask_j(mid,j),&
10172	mask_i(mid,i) )
10173	ENDDO
10174	ENDDO
10175	ENDDO
10176	ELSE
10177	DO i = 1, mask_size_l(mid,1)
10178	DO j = 1, mask_size_l(mid,2)
10179	topo_top_ind = get_topography_top_index_ji( mask_j(mid,j),&
10180	mask_i(mid,i),&
10181	grid )
10182	DO k = 1, mask_size_l(mid,3)
10183	local_pf(i,j,k) = tend( MIN( topo_top_ind+mask_k(mid,k),&
10184	nzt+1 ), &
10185	mask_j(mid,j), mask_i(mid,i) )
10186	ENDDO
10187	ENDDO
10188	ENDDO
10189	ENDIF
10190	resorted = .TRUE.
10191	ELSE
10192	to_be_resorted => PM25_av
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, nz_do3d
10200	temp_bin = 0.0_wp
10201	DO b = 1, nbins
10202	IF ( 2.0_wp * Ra_dry(k,j,i,b) <= 10.0E-6_wp ) THEN
10203	DO c = b, nbins * ncc, nbins
10204	temp_bin = temp_bin + aerosol_mass(c)%conc(k,j,i)
10205	ENDDO
10206	ENDIF
10207	ENDDO
10208	tend(k,j,i) = temp_bin
10209	ENDDO
10210	ENDDO
10211	ENDDO
10212	IF ( .NOT. mask_surface(mid) ) THEN
10213	DO i = 1, mask_size_l(mid,1)
10214	DO j = 1, mask_size_l(mid,2)
10215	DO k = 1, mask_size_l(mid,3)
10216	local_pf(i,j,k) = tend( mask_k(mid,k), mask_j(mid,j),&
10217	mask_i(mid,i) )
10218	ENDDO
10219	ENDDO
10220	ENDDO
10221	ELSE
10222	DO i = 1, mask_size_l(mid,1)
10223	DO j = 1, mask_size_l(mid,2)
10224	topo_top_ind = get_topography_top_index_ji( mask_j(mid,j),&
10225	mask_i(mid,i),&
10226	grid )
10227	DO k = 1, mask_size_l(mid,3)
10228	local_pf(i,j,k) = tend( MIN( topo_top_ind+mask_k(mid,k),&
10229	nzt+1 ), &
10230	mask_j(mid,j), mask_i(mid,i) )
10231	ENDDO
10232	ENDDO
10233	ENDDO
10234	ENDIF
10235	resorted = .TRUE.
10236	ELSE
10237	to_be_resorted => PM10_av
10238	ENDIF
10239
10240	CASE ( 's_BC', 's_DU', 's_NH', 's_NO', 's_OC', 's_SO4', 's_SS' )
10241	IF ( av == 0 ) THEN
10242	IF ( is_used( prtcl, TRIM( variable(3:) ) ) ) THEN
10243	icc = get_index( prtcl, TRIM( variable(3:) ) )
10244	DO i = nxl, nxr
10245	DO j = nys, nyn
10246	DO k = nzb, nz_do3d
10247	temp_bin = 0.0_wp
10248	DO c = ( icc-1 )nbins+1, iccnbins
10249	temp_bin = temp_bin + aerosol_mass(c)%conc(k,j,i)
10250	ENDDO
10251	tend(k,j,i) = temp_bin
10252	ENDDO
10253	ENDDO
10254	ENDDO
10255	ELSE
10256	tend = 0.0_wp
10257	ENDIF
10258	IF ( .NOT. mask_surface(mid) ) THEN
10259	DO i = 1, mask_size_l(mid,1)
10260	DO j = 1, mask_size_l(mid,2)
10261	DO k = 1, mask_size_l(mid,3)
10262	local_pf(i,j,k) = tend( mask_k(mid,k), mask_j(mid,j), &
10263	mask_i(mid,i) )
10264	ENDDO
10265	ENDDO
10266	ENDDO
10267	ELSE
10268	DO i = 1, mask_size_l(mid,1)
10269	DO j = 1, mask_size_l(mid,2)
10270	topo_top_ind = get_topography_top_index_ji( mask_j(mid,j),&
10271	mask_i(mid,i),&
10272	grid )
10273	DO k = 1, mask_size_l(mid,3)
10274	local_pf(i,j,k) = tend( MIN( topo_top_ind+mask_k(mid,k),&
10275	nzt+1 ),&
10276	mask_j(mid,j), mask_i(mid,i) )
10277	ENDDO
10278	ENDDO
10279	ENDDO
10280	ENDIF
10281	resorted = .TRUE.
10282	ELSE
10283	IF ( TRIM( variable(3:) ) == 'BC' ) to_be_resorted => s_BC_av
10284	IF ( TRIM( variable(3:) ) == 'DU' ) to_be_resorted => s_DU_av
10285	IF ( TRIM( variable(3:) ) == 'NH' ) to_be_resorted => s_NH_av
10286	IF ( TRIM( variable(3:) ) == 'NO' ) to_be_resorted => s_NO_av
10287	IF ( TRIM( variable(3:) ) == 'OC' ) to_be_resorted => s_OC_av
10288	IF ( TRIM( variable(3:) ) == 'SO4' ) to_be_resorted => s_SO4_av
10289	IF ( TRIM( variable(3:) ) == 'SS' ) to_be_resorted => s_SS_av
10290	ENDIF
10291
10292	CASE DEFAULT
10293	found = .FALSE.
10294
10295	END SELECT
10296
10297
10298	IF ( .NOT. resorted ) THEN
10299	IF ( .NOT. mask_surface(mid) ) THEN
10300	!
10301	!-- Default masked output
10302	DO i = 1, mask_size_l(mid,1)
10303	DO j = 1, mask_size_l(mid,2)
10304	DO k = 1, mask_size_l(mid,3)
10305	local_pf(i,j,k) = to_be_resorted( mask_k(mid,k), &
10306	mask_j(mid,j),mask_i(mid,i) )
10307	ENDDO
10308	ENDDO
10309	ENDDO
10310	ELSE
10311	!
10312	!-- Terrain-following masked output
10313	DO i = 1, mask_size_l(mid,1)
10314	DO j = 1, mask_size_l(mid,2)
10315	!
10316	!-- Get k index of highest horizontal surface
10317	topo_top_ind = get_topography_top_index_ji( mask_j(mid,j), &
10318	mask_i(mid,i), grid )
10319	!
10320	!-- Save output array
10321	DO k = 1, mask_size_l(mid,3)
10322	local_pf(i,j,k) = to_be_resorted( MIN( topo_top_ind+mask_k(mid,k),&
10323	nzt+1 ), &
10324	mask_j(mid,j), mask_i(mid,i) )
10325	ENDDO
10326	ENDDO
10327	ENDDO
10328	ENDIF
10329	ENDIF
10330
10331	END SUBROUTINE salsa_data_output_mask
10332
10333
10334	END MODULE salsa_mod

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

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |