Home

Context Navigation

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

Last change on this file since 3956 was 3956, checked in by monakurppa, 6 years ago
Remove salsa calls from prognostic_equations and correct a bug in the salsa deposition for urban and land surface models
Property svn:keywords set to `Id`
File size: 493.9 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-2019 University of Helsinki
18	! Copyright 1997-2019 Leibniz Universitaet Hannover
19	!--------------------------------------------------------------------------------!
20	!
21	! Current revisions:
22	! -----------------
23	!
24	!
25	! Former revisions:
26	! -----------------
27	! $Id: salsa_mod.f90 3956 2019-05-07 12:32:52Z monakurppa $
28	! - Conceptual bug in depo_surf correct for urban and land surface model
29	! - Subroutine salsa_tendency_ij optimized.
30	! - Interfaces salsa_non_advective_processes and salsa_exchange_horiz_bounds
31	! created. These are now called in module_interface.
32	! salsa_exchange_horiz_bounds after calling salsa_driver only when needed
33	! (i.e. every dt_salsa).
34	!
35	! 3924 2019-04-23 09:33:06Z monakurppa
36	! Correct a bug introduced by the previous update.
37	!
38	! 3899 2019-04-16 14:05:27Z monakurppa
39	! - remove unnecessary error / location messages
40	! - corrected some error message numbers
41	! - allocate source arrays only if emissions or dry deposition is applied.
42	!
43	! 3885 2019-04-11 11:29:34Z kanani
44	! Changes related to global restructuring of location messages and introduction
45	! of additional debug messages
46	!
47	! 3876 2019-04-08 18:41:49Z knoop
48	! Introduced salsa_actions module interface
49	!
50	! 3871 2019-04-08 14:38:39Z knoop
51	! Major changes in formatting, performance and data input structure (see branch
52	! the history for details)
53	! - Time-dependent emissions enabled: lod=1 for yearly PM emissions that are
54	! normalised depending on the time, and lod=2 for preprocessed emissions
55	! (similar to the chemistry module).
56	! - Additionally, 'uniform' emissions allowed. This emission is set constant on
57	! all horisontal upward facing surfaces and it is created based on parameters
58	! surface_aerosol_flux, aerosol_flux_dpg/sigmag/mass_fracs_a/mass_fracs_b.
59	! - All emissions are now implemented as surface fluxes! No 3D sources anymore.
60	! - Update the emission information by calling salsa_emission_update if
61	! skip_time_do_salsa >= time_since_reference_point and
62	! next_aero_emission_update <= time_since_reference_point
63	! - Aerosol background concentrations read from PIDS_DYNAMIC. The vertical grid
64	! must match the one applied in the model.
65	! - Gas emissions and background concentrations can be also read in in salsa_mod
66	! if the chemistry module is not applied.
67	! - In deposition, information on the land use type can be now imported from
68	! the land use model
69	! - Use SI units in PARIN, i.e. n_lognorm given in #/m3 and dpg in metres.
70	! - Apply 100 character line limit
71	! - Change all variable names from capital to lowercase letter
72	! - Change real exponents to integer if possible. If not, precalculate the value
73	! value of exponent
74	! - Rename in1a to start_subrange_1a, fn2a to end_subrange_1a etc.
75	! - Rename nbins --> nbins_aerosol, ncc_tot --> ncomponents_mass and ngast -->
76	! ngases_salsa
77	! - Rename ibc to index_bc, idu to index_du etc.
78	! - Renamed loop indices b, c and sg to ib, ic and ig
79	! - run_salsa subroutine removed
80	! - Corrected a bud in salsa_driver: falsely applied ino instead of inh
81	! - Call salsa_tendency within salsa_prognostic_equations which is called in
82	! module_interface_mod instead of prognostic_equations_mod
83	! - Removed tailing white spaces and unused variables
84	! - Change error message to start by PA instead of SA
85	!
86	! 3833 2019-03-28 15:04:04Z forkel
87	! added USE chem_gasphase_mod for nvar, nspec and spc_names
88	!
89	! 3787 2019-03-07 08:43:54Z raasch
90	! unused variables removed
91	!
92	! 3780 2019-03-05 11:19:45Z forkel
93	! unused variable for file index removed from rrd-subroutines parameter list
94	!
95	! 3685 2019-01-21 01:02:11Z knoop
96	! Some interface calls moved to module_interface + cleanup
97	!
98	! 3655 2019-01-07 16:51:22Z knoop
99	! Implementation of the PALM module interface
100	!
101	! 3636 2018-12-19 13:48:34Z raasch
102	! nopointer option removed
103	!
104	! 3630 2018-12-17 11:04:17Z knoop
105	! - Moved the control parameter "salsa" from salsa_mod.f90 to control_parameters
106	! - Updated salsa_rrd_local and salsa_wrd_local
107	! - Add target attribute
108	! - Revise initialization in case of restarts
109	! - Revise masked data output
110	!
111	! 3582 2018-11-29 19:16:36Z suehring
112	! missing comma separator inserted
113	!
114	! 3483 2018-11-02 14:19:26Z raasch
115	! bugfix: directives added to allow compilation without netCDF
116	!
117	! 3481 2018-11-02 09:14:13Z raasch
118	! temporary variable cc introduced to circumvent a possible Intel18 compiler bug
119	! related to contiguous/non-contguous pointer/target attributes
120	!
121	! 3473 2018-10-30 20:50:15Z suehring
122	! NetCDF input routine renamed
123	!
124	! 3467 2018-10-30 19:05:21Z suehring
125	! Initial revision
126	!
127	! 3412 2018-10-24 07:25:57Z monakurppa
128	!
129	! Authors:
130	! --------
131	! @author Mona Kurppa (University of Helsinki)
132	!
133	!
134	! Description:
135	! ------------
136	!> Sectional aerosol module for large scale applications SALSA
137	!> (Kokkola et al., 2008, ACP 8, 2469-2483). Solves the aerosol number and mass
138	!> concentration as well as chemical composition. Includes aerosol dynamic
139	!> processes: nucleation, condensation/evaporation of vapours, coagulation and
140	!> deposition on tree leaves, ground and roofs.
141	!> Implementation is based on formulations implemented in UCLALES-SALSA except
142	!> for deposition which is based on parametrisations by Zhang et al. (2001,
143	!> Atmos. Environ. 35, 549-560) or Petroff&Zhang (2010, Geosci. Model Dev. 3,
144	!> 753-769)
145	!>
146	!> @todo Apply information from emission_stack_height to lift emission sources
147	!> @todo emission mode "parameterized", i.e. based on street type
148	!> @todo Allow insoluble emissions
149	!> @todo two-way nesting is not working properly
150	!------------------------------------------------------------------------------!
151	MODULE salsa_mod
152
153	USE basic_constants_and_equations_mod, &
154	ONLY: c_p, g, p_0, pi, r_d
155
156	USE chem_gasphase_mod, &
157	ONLY: nspec, nvar, spc_names
158
159	USE chem_modules, &
160	ONLY: call_chem_at_all_substeps, chem_gasphase_on, chem_species
161
162	USE control_parameters
163
164	USE indices, &
165	ONLY: nbgp, nx, nxl, nxlg, nxr, nxrg, ny, nyn, nyng, nys, nysg, nzb, &
166	nzb_s_inner, nz, nzt, wall_flags_0
167
168	USE kinds
169
170	USE pegrid
171
172	USE salsa_util_mod
173
174	USE statistics, &
175	ONLY: sums_salsa_ws_l
176
177	IMPLICIT NONE
178	!
179	!-- SALSA constants:
180	!
181	!-- Local constants:
182	INTEGER(iwp), PARAMETER :: luc_urban = 15 !< default landuse type for urban
183	INTEGER(iwp), PARAMETER :: ngases_salsa = 5 !< total number of gaseous tracers:
184	!< 1 = H2SO4, 2 = HNO3, 3 = NH3, 4 = OCNV
185	!< (non-volatile OC), 5 = OCSV (semi-volatile)
186	INTEGER(iwp), PARAMETER :: nmod = 7 !< number of modes for initialising the aerosol size
187	!< distribution
188	INTEGER(iwp), PARAMETER :: nreg = 2 !< Number of main size subranges
189	INTEGER(iwp), PARAMETER :: maxspec = 7 !< Max. number of aerosol species
190	INTEGER(iwp), PARAMETER :: season = 1 !< For dry depostion by Zhang et al.: 1 = summer,
191	!< 2 = autumn (no harvest yet), 3 = late autumn
192	!< (already frost), 4 = winter, 5 = transitional spring
193	!
194	!-- Universal constants
195	REAL(wp), PARAMETER :: abo = 1.380662E-23_wp !< Boltzmann constant (J/K)
196	REAL(wp), PARAMETER :: alv = 2.260E+6_wp !< latent heat for H2O
197	!< vaporisation (J/kg)
198	REAL(wp), PARAMETER :: alv_d_rv = 4896.96865_wp !< alv / rv
199	REAL(wp), PARAMETER :: am_airmol = 4.8096E-26_wp !< Average mass of one air
200	!< molecule (Jacobson,
201	!< 2005, Eq. 2.3)
202	REAL(wp), PARAMETER :: api6 = 0.5235988_wp !< pi / 6
203	REAL(wp), PARAMETER :: argas = 8.314409_wp !< Gas constant (J/(mol K))
204	REAL(wp), PARAMETER :: argas_d_cpd = 8.281283865E-3_wp !< argas per cpd
205	REAL(wp), PARAMETER :: avo = 6.02214E+23_wp !< Avogadro constant (1/mol)
206	REAL(wp), PARAMETER :: d_sa = 5.539376964394570E-10_wp !< diameter of condensing sulphuric
207	!< acid molecule (m)
208	REAL(wp), PARAMETER :: for_ppm_to_nconc = 7.243016311E+16_wp !< ppm * avo / R (K/(Pa*m3))
209	REAL(wp), PARAMETER :: epsoc = 0.15_wp !< water uptake of organic
210	!< material
211	REAL(wp), PARAMETER :: mclim = 1.0E-23_wp !< mass concentration min limit (kg/m3)
212	REAL(wp), PARAMETER :: n3 = 158.79_wp !< Number of H2SO4 molecules in 3 nm cluster
213	!< if d_sa=5.54e-10m
214	REAL(wp), PARAMETER :: nclim = 1.0_wp !< number concentration min limit (#/m3)
215	REAL(wp), PARAMETER :: surfw0 = 0.073_wp !< surface tension of water at 293 K (J/m2)
216	!
217	!-- Molar masses in kg/mol
218	REAL(wp), PARAMETER :: ambc = 12.0E-3_wp !< black carbon (BC)
219	REAL(wp), PARAMETER :: amdair = 28.970E-3_wp !< dry air
220	REAL(wp), PARAMETER :: amdu = 100.E-3_wp !< mineral dust
221	REAL(wp), PARAMETER :: amh2o = 18.0154E-3_wp !< H2O
222	REAL(wp), PARAMETER :: amh2so4 = 98.06E-3_wp !< H2SO4
223	REAL(wp), PARAMETER :: amhno3 = 63.01E-3_wp !< HNO3
224	REAL(wp), PARAMETER :: amn2o = 44.013E-3_wp !< N2O
225	REAL(wp), PARAMETER :: amnh3 = 17.031E-3_wp !< NH3
226	REAL(wp), PARAMETER :: amo2 = 31.9988E-3_wp !< O2
227	REAL(wp), PARAMETER :: amo3 = 47.998E-3_wp !< O3
228	REAL(wp), PARAMETER :: amoc = 150.E-3_wp !< organic carbon (OC)
229	REAL(wp), PARAMETER :: amss = 58.44E-3_wp !< sea salt (NaCl)
230	!
231	!-- Densities in kg/m3
232	REAL(wp), PARAMETER :: arhobc = 2000.0_wp !< black carbon
233	REAL(wp), PARAMETER :: arhodu = 2650.0_wp !< mineral dust
234	REAL(wp), PARAMETER :: arhoh2o = 1000.0_wp !< H2O
235	REAL(wp), PARAMETER :: arhoh2so4 = 1830.0_wp !< SO4
236	REAL(wp), PARAMETER :: arhohno3 = 1479.0_wp !< HNO3
237	REAL(wp), PARAMETER :: arhonh3 = 1530.0_wp !< NH3
238	REAL(wp), PARAMETER :: arhooc = 2000.0_wp !< organic carbon
239	REAL(wp), PARAMETER :: arhoss = 2165.0_wp !< sea salt (NaCl)
240	!
241	!-- Volume of molecule in m3/#
242	REAL(wp), PARAMETER :: amvh2o = amh2o /avo / arhoh2o !< H2O
243	REAL(wp), PARAMETER :: amvh2so4 = amh2so4 / avo / arhoh2so4 !< SO4
244	REAL(wp), PARAMETER :: amvhno3 = amhno3 / avo / arhohno3 !< HNO3
245	REAL(wp), PARAMETER :: amvnh3 = amnh3 / avo / arhonh3 !< NH3
246	REAL(wp), PARAMETER :: amvoc = amoc / avo / arhooc !< OC
247	REAL(wp), PARAMETER :: amvss = amss / avo / arhoss !< sea salt
248	!
249	!-- Constants for the dry deposition model by Petroff and Zhang (2010):
250	!-- obstacle characteristic dimension "L" (cm) (plane obstacle by default) and empirical constants
251	!-- C_B, C_IN, C_IM, beta_IM and C_IT for each land use category (15, as in Zhang et al. (2001))
252	REAL(wp), DIMENSION(1:15), PARAMETER :: l_p10 = &
253	(/0.15, 4.0, 0.15, 3.0, 3.0, 0.5, 3.0, -99., 0.5, 2.0, 1.0, -99., -99., -99., 3.0/)
254	REAL(wp), DIMENSION(1:15), PARAMETER :: c_b_p10 = &
255	(/0.887, 1.262, 0.887, 1.262, 1.262, 0.996, 0.996, -99., 0.7, 0.93, 0.996, -99., -99., -99., 1.262/)
256	REAL(wp), DIMENSION(1:15), PARAMETER :: c_in_p10 = &
257	(/0.81, 0.216, 0.81, 0.216, 0.216, 0.191, 0.162, -99., 0.7, 0.14, 0.162, -99., -99., -99., 0.216/)
258	REAL(wp), DIMENSION(1:15), PARAMETER :: c_im_p10 = &
259	(/0.162, 0.13, 0.162, 0.13, 0.13, 0.191, 0.081, -99., 0.191,0.086,0.081, -99., -99., -99., 0.13/)
260	REAL(wp), DIMENSION(1:15), PARAMETER :: beta_im_p10 = &
261	(/0.6, 0.47, 0.6, 0.47, 0.47, 0.47, 0.47, -99., 0.6, 0.47, 0.47, -99., -99., -99., 0.47/)
262	REAL(wp), DIMENSION(1:15), PARAMETER :: c_it_p10 = &
263	(/0.0, 0.056, 0.0, 0.056, 0.056, 0.042, 0.056, -99., 0.042,0.014,0.056, -99., -99., -99., 0.056/)
264	!
265	!-- Constants for the dry deposition model by Zhang et al. (2001):
266	!-- empirical constants "alpha" and "gamma" and characteristic radius "A" for
267	!-- each land use category (15) and season (5)
268	REAL(wp), DIMENSION(1:15), PARAMETER :: alpha_z01 = &
269	(/1.0, 0.6, 1.1, 0.8, 0.8, 1.2, 1.2, 50.0, 50.0, 1.3, 2.0, 50.0, 100.0, 100.0, 1.5/)
270	REAL(wp), DIMENSION(1:15), PARAMETER :: gamma_z01 = &
271	(/0.56, 0.58, 0.56, 0.56, 0.56, 0.54, 0.54, 0.54, 0.54, 0.54, 0.54, 0.54, 0.50, 0.50, 0.56/)
272	REAL(wp), DIMENSION(1:15,1:5), PARAMETER :: A_z01 = RESHAPE( (/&
273	2.0, 5.0, 2.0, 5.0, 5.0, 2.0, 2.0, -99., -99., 10.0, 10.0, -99., -99., -99., 10.0,& ! SC1
274	2.0, 5.0, 2.0, 5.0, 5.0, 2.0, 2.0, -99., -99., 10.0, 10.0, -99., -99., -99., 10.0,& ! SC2
275	2.0, 5.0, 5.0, 10.0, 5.0, 5.0, 5.0, -99., -99., 10.0, 10.0, -99., -99., -99., 10.0,& ! SC3
276	2.0, 5.0, 5.0, 10.0, 5.0, 5.0, 5.0, -99., -99., 10.0, 10.0, -99., -99., -99., 10.0,& ! SC4
277	2.0, 5.0, 2.0, 5.0, 5.0, 2.0, 2.0, -99., -99., 10.0, 10.0, -99., -99., -99., 10.0 & ! SC5
278	/), (/ 15, 5 /) )
279	!-- Land use categories (based on Z01 but the same applies here also for P10):
280	!-- 1 = evergreen needleleaf trees,
281	!-- 2 = evergreen broadleaf trees,
282	!-- 3 = deciduous needleleaf trees,
283	!-- 4 = deciduous broadleaf trees,
284	!-- 5 = mixed broadleaf and needleleaf trees (deciduous broadleaf trees for P10),
285	!-- 6 = grass (short grass for P10),
286	!-- 7 = crops, mixed farming,
287	!-- 8 = desert,
288	!-- 9 = tundra,
289	!-- 10 = shrubs and interrupted woodlands (thorn shrubs for P10),
290	!-- 11 = wetland with plants (long grass for P10)
291	!-- 12 = ice cap and glacier,
292	!-- 13 = inland water (inland lake for P10)
293	!-- 14 = ocean (water for P10),
294	!-- 15 = urban
295	!
296	!-- SALSA variables:
297	CHARACTER(LEN=20) :: bc_salsa_b = 'neumann' !< bottom boundary condition
298	CHARACTER(LEN=20) :: bc_salsa_t = 'neumann' !< top boundary condition
299	CHARACTER(LEN=20) :: depo_pcm_par = 'zhang2001' !< or 'petroff2010'
300	CHARACTER(LEN=20) :: depo_pcm_type = 'deciduous_broadleaf' !< leaf type
301	CHARACTER(LEN=20) :: depo_surf_par = 'zhang2001' !< or 'petroff2010'
302	CHARACTER(LEN=100) :: input_file_dynamic = 'PIDS_DYNAMIC' !< file name for dynamic input
303	CHARACTER(LEN=100) :: input_file_salsa = 'PIDS_SALSA' !< file name for emission data
304	CHARACTER(LEN=20) :: salsa_emission_mode = 'no_emission' !< 'no_emission', 'uniform',
305	!< 'parameterized', 'read_from_file'
306
307	CHARACTER(LEN=20), DIMENSION(4) :: decycle_method = &
308	(/'dirichlet','dirichlet','dirichlet','dirichlet'/)
309	!< Decycling method at horizontal boundaries
310	!< 1=left, 2=right, 3=south, 4=north
311	!< dirichlet = initial profiles for the ghost and first 3 layers
312	!< neumann = zero gradient
313
314	CHARACTER(LEN=3), DIMENSION(maxspec) :: listspec = & !< Active aerosols
315	(/'SO4',' ',' ',' ',' ',' ',' '/)
316
317	INTEGER(iwp) :: depo_pcm_par_num = 1 !< parametrisation type: 1=zhang2001, 2=petroff2010
318	INTEGER(iwp) :: depo_pcm_type_num = 0 !< index for the dry deposition type on the plant canopy
319	INTEGER(iwp) :: depo_surf_par_num = 1 !< parametrisation type: 1=zhang2001, 2=petroff2010
320	INTEGER(iwp) :: dots_salsa = 0 !< starting index for salsa-timeseries
321	INTEGER(iwp) :: end_subrange_1a = 1 !< last index for bin subrange 1a
322	INTEGER(iwp) :: end_subrange_2a = 1 !< last index for bin subrange 2a
323	INTEGER(iwp) :: end_subrange_2b = 1 !< last index for bin subrange 2b
324	INTEGER(iwp) :: ibc_salsa_b !< index for the bottom boundary condition
325	INTEGER(iwp) :: ibc_salsa_t !< index for the top boundary condition
326	INTEGER(iwp) :: index_bc = -1 !< index for black carbon (BC)
327	INTEGER(iwp) :: index_du = -1 !< index for dust
328	INTEGER(iwp) :: index_nh = -1 !< index for NH3
329	INTEGER(iwp) :: index_no = -1 !< index for HNO3
330	INTEGER(iwp) :: index_oc = -1 !< index for organic carbon (OC)
331	INTEGER(iwp) :: index_so4 = -1 !< index for SO4 or H2SO4
332	INTEGER(iwp) :: index_ss = -1 !< index for sea salt
333	INTEGER(iwp) :: init_aerosol_type = 0 !< Initial size distribution type
334	!< 0 = uniform (read from PARIN)
335	!< 1 = read vertical profile of the mode number
336	!< concentration from an input file
337	INTEGER(iwp) :: init_gases_type = 0 !< Initial gas concentration type
338	!< 0 = uniform (read from PARIN)
339	!< 1 = read vertical profile from an input file
340	INTEGER(iwp) :: lod_gas_emissions = 0 !< level of detail of the gaseous emission data
341	INTEGER(iwp) :: nbins_aerosol = 1 !< total number of size bins
342	INTEGER(iwp) :: ncc = 1 !< number of chemical components used
343	INTEGER(iwp) :: ncomponents_mass = 1 !< total number of chemical compounds (ncc+1)
344	!< if particle water is advected)
345	INTEGER(iwp) :: nj3 = 1 !< J3 parametrization (nucleation)
346	!< 1 = condensational sink (Kerminen&Kulmala, 2002)
347	!< 2 = coagulational sink (Lehtinen et al. 2007)
348	!< 3 = coagS+self-coagulation (Anttila et al. 2010)
349	INTEGER(iwp) :: nsnucl = 0 !< Choice of the nucleation scheme:
350	!< 0 = off
351	!< 1 = binary nucleation
352	!< 2 = activation type nucleation
353	!< 3 = kinetic nucleation
354	!< 4 = ternary nucleation
355	!< 5 = nucleation with ORGANICs
356	!< 6 = activation type of nucleation with H2SO4+ORG
357	!< 7 = heteromolecular nucleation with H2SO4*ORG
358	!< 8 = homomolecular nucleation of H2SO4
359	!< + heteromolecular nucleation with H2SO4*ORG
360	!< 9 = homomolecular nucleation of H2SO4 and ORG
361	!< + heteromolecular nucleation with H2SO4*ORG
362	INTEGER(iwp) :: start_subrange_1a = 1 !< start index for bin subranges: subrange 1a
363	INTEGER(iwp) :: start_subrange_2a = 1 !< subrange 2a
364	INTEGER(iwp) :: start_subrange_2b = 1 !< subrange 2b
365
366	INTEGER(iwp), DIMENSION(nreg) :: nbin = (/ 3, 7/) !< Number of size bins per subrange: 1 & 2
367
368	INTEGER(iwp), DIMENSION(ngases_salsa) :: gas_index_chem = &
369	(/ 1, 1, 1, 1, 1/) !< gas indices in chemistry_model_mod
370	!< 1 = H2SO4, 2 = HNO3, 3 = NH3, 4 = OCNV, 5 = OCSV
371	INTEGER(iwp), DIMENSION(ngases_salsa) :: emission_index_chem !< gas indices in the gas emission file
372
373	INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE :: k_topo_top !< vertical index of the topography top
374	!
375	!-- SALSA switches:
376	LOGICAL :: advect_particle_water = .TRUE. !< Advect water concentration of particles
377	LOGICAL :: decycle_lr = .FALSE. !< Undo cyclic boundaries: left and right
378	LOGICAL :: decycle_ns = .FALSE. !< Undo cyclic boundaries: north and south
379	LOGICAL :: include_emission = .FALSE. !< Include or not emissions
380	LOGICAL :: feedback_to_palm = .FALSE. !< Allow feedback due to condensation of H2O
381	LOGICAL :: nest_salsa = .FALSE. !< Apply nesting for salsa
382	LOGICAL :: no_insoluble = .FALSE. !< Exclude insoluble chemical components
383	LOGICAL :: read_restart_data_salsa = .FALSE. !< Read restart data for salsa
384	LOGICAL :: salsa_gases_from_chem = .FALSE. !< Transfer the gaseous components to SALSA from
385	!< the chemistry model
386	LOGICAL :: van_der_waals_coagc = .FALSE. !< Enhancement of coagulation kernel by van der
387	!< Waals and viscous forces
388	LOGICAL :: write_binary_salsa = .FALSE. !< read binary for salsa
389	!
390	!-- Process switches: nl* is read from the NAMELIST and is NOT changed.
391	!-- ls* is the switch used and will get the value of nl*
392	!-- except for special circumstances (spinup period etc.)
393	LOGICAL :: nlcoag = .FALSE. !< Coagulation master switch
394	LOGICAL :: lscoag = .FALSE. !<
395	LOGICAL :: nlcnd = .FALSE. !< Condensation master switch
396	LOGICAL :: lscnd = .FALSE. !<
397	LOGICAL :: nlcndgas = .FALSE. !< Condensation of precursor gases
398	LOGICAL :: lscndgas = .FALSE. !<
399	LOGICAL :: nlcndh2oae = .FALSE. !< Condensation of H2O on aerosol
400	LOGICAL :: lscndh2oae = .FALSE. !< particles (FALSE -> equilibrium calc.)
401	LOGICAL :: nldepo = .FALSE. !< Deposition master switch
402	LOGICAL :: lsdepo = .FALSE. !<
403	LOGICAL :: nldepo_surf = .FALSE. !< Deposition on vegetation master switch
404	LOGICAL :: lsdepo_surf = .FALSE. !<
405	LOGICAL :: nldepo_pcm = .FALSE. !< Deposition on walls master switch
406	LOGICAL :: lsdepo_pcm = .FALSE. !<
407	LOGICAL :: nldistupdate = .TRUE. !< Size distribution update master switch
408	LOGICAL :: lsdistupdate = .FALSE. !<
409	LOGICAL :: lspartition = .FALSE. !< Partition of HNO3 and NH3
410
411	REAL(wp) :: act_coeff = 1.0E-7_wp !< Activation coefficient
412	REAL(wp) :: dt_salsa = 0.00001_wp !< Time step of SALSA
413	REAL(wp) :: h2so4_init = nclim !< Init value for sulphuric acid gas
414	REAL(wp) :: hno3_init = nclim !< Init value for nitric acid gas
415	REAL(wp) :: last_salsa_time = 0.0_wp !< previous salsa call
416	REAL(wp) :: next_aero_emission_update = 0.0_wp !< previous emission update
417	REAL(wp) :: next_gas_emission_update = 0.0_wp !< previous emission update
418	REAL(wp) :: nf2a = 1.0_wp !< Number fraction allocated to 2a-bins
419	REAL(wp) :: nh3_init = nclim !< Init value for ammonia gas
420	REAL(wp) :: ocnv_init = nclim !< Init value for non-volatile organic gases
421	REAL(wp) :: ocsv_init = nclim !< Init value for semi-volatile organic gases
422	REAL(wp) :: rhlim = 1.20_wp !< RH limit in %/100. Prevents unrealistical RH
423	REAL(wp) :: skip_time_do_salsa = 0.0_wp !< Starting time of SALSA (s)
424	!
425	!-- Initial log-normal size distribution: mode diameter (dpg, metres),
426	!-- standard deviation (sigmag) and concentration (n_lognorm, #/m3)
427	REAL(wp), DIMENSION(nmod) :: dpg = &
428	(/1.3E-8_wp, 5.4E-8_wp, 8.6E-7_wp, 2.0E-7_wp, 2.0E-7_wp, 2.0E-7_wp, 2.0E-7_wp/)
429	REAL(wp), DIMENSION(nmod) :: sigmag = &
430	(/1.8_wp, 2.16_wp, 2.21_wp, 2.0_wp, 2.0_wp, 2.0_wp, 2.0_wp/)
431	REAL(wp), DIMENSION(nmod) :: n_lognorm = &
432	(/1.04e+11_wp, 3.23E+10_wp, 5.4E+6_wp, 0.0_wp, 0.0_wp, 0.0_wp, 0.0_wp/)
433	!
434	!-- Initial mass fractions / chemical composition of the size distribution
435	REAL(wp), DIMENSION(maxspec) :: mass_fracs_a = & !< mass fractions between
436	(/1.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0/) !< aerosol species for A bins
437	REAL(wp), DIMENSION(maxspec) :: mass_fracs_b = & !< mass fractions between
438	(/0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0/) !< aerosol species for B bins
439	REAL(wp), DIMENSION(nreg+1) :: reglim = & !< Min&max diameters of size subranges
440	(/ 3.0E-9_wp, 5.0E-8_wp, 1.0E-5_wp/)
441	!
442	!-- Initial log-normal size distribution: mode diameter (dpg, metres), standard deviation (sigmag)
443	!-- concentration (n_lognorm, #/m3) and mass fractions of all chemical components (listed in
444	!-- listspec) for both a (soluble) and b (insoluble) bins.
445	REAL(wp), DIMENSION(nmod) :: aerosol_flux_dpg = &
446	(/1.3E-8_wp, 5.4E-8_wp, 8.6E-7_wp, 2.0E-7_wp, 2.0E-7_wp, 2.0E-7_wp, 2.0E-7_wp/)
447	REAL(wp), DIMENSION(nmod) :: aerosol_flux_sigmag = &
448	(/1.8_wp, 2.16_wp, 2.21_wp, 2.0_wp, 2.0_wp, 2.0_wp, 2.0_wp/)
449	REAL(wp), DIMENSION(maxspec) :: aerosol_flux_mass_fracs_a = &
450	(/1.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0/)
451	REAL(wp), DIMENSION(maxspec) :: aerosol_flux_mass_fracs_b = &
452	(/0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0/)
453	REAL(wp), DIMENSION(nmod) :: surface_aerosol_flux = &
454	(/1.04e+11_wp, 3.23E+10_wp, 5.4E+6_wp, 0.0_wp, 0.0_wp, 0.0_wp, 0.0_wp/)
455
456	REAL(wp), DIMENSION(:), ALLOCATABLE :: bin_low_limits !< to deliver information about
457	!< the lower diameters per bin
458	REAL(wp), DIMENSION(:), ALLOCATABLE :: bc_am_t_val !< vertical gradient of: aerosol mass
459	REAL(wp), DIMENSION(:), ALLOCATABLE :: bc_an_t_val !< of: aerosol number
460	REAL(wp), DIMENSION(:), ALLOCATABLE :: bc_gt_t_val !< salsa gases near domain top
461	REAL(wp), DIMENSION(:), ALLOCATABLE :: gas_emission_time !< Time array in gas emission data (s)
462	REAL(wp), DIMENSION(:), ALLOCATABLE :: nsect !< Background number concentrations
463	REAL(wp), DIMENSION(:), ALLOCATABLE :: massacc !< Mass accomodation coefficients
464	!
465	!-- SALSA derived datatypes:
466	!
467	!-- For matching LSM and USM surface types and the deposition module surface types
468	TYPE match_surface
469	INTEGER(iwp), DIMENSION(:), ALLOCATABLE :: match_lupg !< index for pavement / green roofs
470	INTEGER(iwp), DIMENSION(:), ALLOCATABLE :: match_luvw !< index for vegetation / walls
471	INTEGER(iwp), DIMENSION(:), ALLOCATABLE :: match_luww !< index for water / windows
472	END TYPE match_surface
473	!
474	!-- Aerosol emission data attributes
475	TYPE salsa_emission_attribute_type
476
477	CHARACTER(LEN=25) :: units
478
479	CHARACTER(LEN=25), DIMENSION(:), ALLOCATABLE :: cat_name !<
480	CHARACTER(LEN=25), DIMENSION(:), ALLOCATABLE :: cc_name !<
481	CHARACTER(LEN=25), DIMENSION(:), ALLOCATABLE :: unit_time !<
482	CHARACTER(LEN=100), DIMENSION(:), ALLOCATABLE :: var_names !<
483
484	INTEGER(iwp) :: lod = 0 !< level of detail
485	INTEGER(iwp) :: nbins = 10 !< number of aerosol size bins
486	INTEGER(iwp) :: ncat = 0 !< number of emission categories
487	INTEGER(iwp) :: ncc = 7 !< number of aerosol chemical components
488	INTEGER(iwp) :: nhoursyear = 0 !< number of hours: HOURLY mode
489	INTEGER(iwp) :: nmonthdayhour = 0 !< number of month days and hours: MDH mode
490	INTEGER(iwp) :: num_vars !< number of variables
491	INTEGER(iwp) :: nt = 0 !< number of time steps
492	INTEGER(iwp) :: nz = 0 !< number of vertical levels
493	INTEGER(iwp) :: tind !< time index for reference time in salsa emission data
494
495	INTEGER(iwp), DIMENSION(maxspec) :: cc_input_to_model !<
496
497	INTEGER(iwp), DIMENSION(:), ALLOCATABLE :: cat_index !< Index of emission categories
498	INTEGER(iwp), DIMENSION(:), ALLOCATABLE :: cc_index !< Index of chemical components
499
500	REAL(wp) :: conversion_factor !< unit conversion factor for aerosol emissions
501
502	REAL(wp), DIMENSION(:), ALLOCATABLE :: dmid !< mean diameters of size bins (m)
503	REAL(wp), DIMENSION(:), ALLOCATABLE :: rho !< average density (kg/m3)
504	REAL(wp), DIMENSION(:), ALLOCATABLE :: time !< time (s)
505	REAL(wp), DIMENSION(:), ALLOCATABLE :: time_factor !< emission time factor
506	REAL(wp), DIMENSION(:), ALLOCATABLE :: z !< height (m)
507
508	REAL(wp), DIMENSION(:,:), ALLOCATABLE :: etf !< emission time factor
509	REAL(wp), DIMENSION(:,:), ALLOCATABLE :: stack_height
510
511	END TYPE salsa_emission_attribute_type
512	!
513	!-- The default size distribution and mass composition per emission category:
514	!-- 1 = traffic, 2 = road dust, 3 = wood combustion, 4 = other
515	!-- Mass fractions: H2SO4, OC, BC, DU, SS, HNO3, NH3
516	TYPE salsa_emission_mode_type
517
518	INTEGER(iwp) :: ndm = 3 !< number of default modes
519	INTEGER(iwp) :: ndc = 4 !< number of default categories
520
521	CHARACTER(LEN=25), DIMENSION(1:4) :: cat_name_table = (/'traffic exhaust', &
522	'road dust ', &
523	'wood combustion', &
524	'other '/)
525
526	INTEGER(iwp), DIMENSION(1:4) :: cat_input_to_model !<
527
528	REAL(wp), DIMENSION(1:3) :: dpg_table = (/ 13.5E-9_wp, 1.4E-6_wp, 5.4E-8_wp/) !<
529	REAL(wp), DIMENSION(1:3) :: ntot_table !<
530	REAL(wp), DIMENSION(1:3) :: sigmag_table = (/ 1.6_wp, 1.4_wp, 1.7_wp /) !<
531
532	REAL(wp), DIMENSION(1:maxspec,1:4) :: mass_frac_table = & !<
533	RESHAPE( (/ 0.04_wp, 0.48_wp, 0.48_wp, 0.0_wp, 0.0_wp, 0.0_wp, 0.0_wp, &
534	0.0_wp, 0.05_wp, 0.0_wp, 0.95_wp, 0.0_wp, 0.0_wp, 0.0_wp, &
535	0.0_wp, 0.5_wp, 0.5_wp, 0.0_wp, 0.0_wp, 0.0_wp, 0.0_wp, &
536	0.0_wp, 0.5_wp, 0.5_wp, 0.0_wp, 0.0_wp, 0.0_wp, 0.0_wp &
537	/), (/maxspec,4/) )
538
539	REAL(wp), DIMENSION(1:3,1:4) :: pm_frac_table = & !< rel. mass
540	RESHAPE( (/ 0.016_wp, 0.000_wp, 0.984_wp, &
541	0.000_wp, 1.000_wp, 0.000_wp, &
542	0.000_wp, 0.000_wp, 1.000_wp, &
543	1.000_wp, 0.000_wp, 1.000_wp &
544	/), (/3,4/) )
545
546	END TYPE salsa_emission_mode_type
547	!
548	!-- Aerosol emission data values
549	TYPE salsa_emission_value_type
550
551	REAL(wp) :: fill !< fill value
552
553	REAL(wp), DIMENSION(:), ALLOCATABLE :: preproc_mass_fracs !< mass fractions
554
555	REAL(wp), DIMENSION(:,:), ALLOCATABLE :: def_mass_fracs !< mass fractions per emis. category
556
557	REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: def_data !< surface emission values in PM
558	REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: preproc_data !< surface emission values per bin
559
560	END TYPE salsa_emission_value_type
561	!
562	!-- Prognostic variable: Aerosol size bin information (number (#/m3) and mass (kg/m3) concentration)
563	!-- and the concentration of gaseous tracers (#/m3). Gas tracers are contained sequentially in
564	!-- dimension 4 as:
565	!-- 1. H2SO4, 2. HNO3, 3. NH3, 4. OCNV (non-volatile organics), 5. OCSV (semi-volatile)
566	TYPE salsa_variable
567
568	REAL(wp), ALLOCATABLE, DIMENSION(:) :: init !<
569
570	REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: diss_s !<
571	REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: flux_s !<
572	REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: source !<
573	REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: sums_ws_l !<
574
575	REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: diss_l !<
576	REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: flux_l !<
577
578	REAL(wp), POINTER, DIMENSION(:,:,:), CONTIGUOUS :: conc !<
579	REAL(wp), POINTER, DIMENSION(:,:,:), CONTIGUOUS :: conc_p !<
580	REAL(wp), POINTER, DIMENSION(:,:,:), CONTIGUOUS :: tconc_m !<
581
582	END TYPE salsa_variable
583	!
584	!-- Datatype used to store information about the binned size distributions of aerosols
585	TYPE t_section
586
587	REAL(wp) :: dmid !< bin middle diameter (m)
588	REAL(wp) :: vhilim !< bin volume at the high limit
589	REAL(wp) :: vlolim !< bin volume at the low limit
590	REAL(wp) :: vratiohi !< volume ratio between the center and high limit
591	REAL(wp) :: vratiolo !< volume ratio between the center and low limit
592	!******************************************************
593	! ^ Do NOT change the stuff above after initialization !
594	!******************************************************
595	REAL(wp) :: core !< Volume of dry particle
596	REAL(wp) :: dwet !< Wet diameter or mean droplet diameter (m)
597	REAL(wp) :: numc !< Number concentration of particles/droplets (#/m3)
598	REAL(wp) :: veqh2o !< Equilibrium H2O concentration for each particle
599
600	REAL(wp), DIMENSION(maxspec+1) :: volc !< Volume concentrations (m^3/m^3) of aerosols +
601	!< water. Since most of the stuff in SALSA is hard
602	!< coded, these have to be in the order
603	!< 1:SO4, 2:OC, 3:BC, 4:DU, 5:SS, 6:NO, 7:NH, 8:H2O
604	END TYPE t_section
605
606	TYPE(salsa_emission_attribute_type) :: aero_emission_att !< emission attributes
607	TYPE(salsa_emission_value_type) :: aero_emission !< emission values
608	TYPE(salsa_emission_mode_type) :: def_modes !< default emission modes
609
610	TYPE(t_section), DIMENSION(:), ALLOCATABLE :: aero !< local aerosol properties
611
612	TYPE(match_surface) :: lsm_to_depo_h !< to match the deposition module and horizontal LSM surfaces
613	TYPE(match_surface) :: usm_to_depo_h !< to match the deposition module and horizontal USM surfaces
614
615	TYPE(match_surface), DIMENSION(0:3) :: lsm_to_depo_v !< to match the deposition mod. and vertical LSM surfaces
616	TYPE(match_surface), DIMENSION(0:3) :: usm_to_depo_v !< to match the deposition mod. and vertical USM surfaces
617	!
618	!-- SALSA variables: as x = x(k,j,i,bin).
619	!-- The 4th dimension contains all the size bins sequentially for each aerosol species + water.
620	!
621	!-- Prognostic variables:
622	!
623	!-- Number concentration (#/m3)
624	TYPE(salsa_variable), ALLOCATABLE, DIMENSION(:), TARGET :: aerosol_number !<
625	REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:), TARGET :: nconc_1 !<
626	REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:), TARGET :: nconc_2 !<
627	REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:), TARGET :: nconc_3 !<
628	!
629	!-- Mass concentration (kg/m3)
630	TYPE(salsa_variable), ALLOCATABLE, DIMENSION(:), TARGET :: aerosol_mass !<
631	REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:), TARGET :: mconc_1 !<
632	REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:), TARGET :: mconc_2 !<
633	REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:), TARGET :: mconc_3 !<
634	!
635	!-- Gaseous concentrations (#/m3)
636	TYPE(salsa_variable), ALLOCATABLE, DIMENSION(:), TARGET :: salsa_gas !<
637	REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:), TARGET :: gconc_1 !<
638	REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:), TARGET :: gconc_2 !<
639	REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:), TARGET :: gconc_3 !<
640	!
641	!-- Diagnostic tracers
642	REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:) :: sedim_vd !< sedimentation velocity per bin (m/s)
643	REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:) :: ra_dry !< aerosol dry radius (m)
644
645	!-- Particle component index tables
646	TYPE(component_index) :: prtcl !< Contains "getIndex" which gives the index for a given aerosol
647	!< component name: 1:SO4, 2:OC, 3:BC, 4:DU, 5:SS, 6:NO, 7:NH, 8:H2O
648	!
649	!-- Data output arrays:
650	!
651	!-- Gases:
652	REAL(wp), ALLOCATABLE, DIMENSION(:,:,:), TARGET :: g_h2so4_av !< H2SO4
653	REAL(wp), ALLOCATABLE, DIMENSION(:,:,:), TARGET :: g_hno3_av !< HNO3
654	REAL(wp), ALLOCATABLE, DIMENSION(:,:,:), TARGET :: g_nh3_av !< NH3
655	REAL(wp), ALLOCATABLE, DIMENSION(:,:,:), TARGET :: g_ocnv_av !< non-volatile OC
656	REAL(wp), ALLOCATABLE, DIMENSION(:,:,:), TARGET :: g_ocsv_av !< semi-volatile OC
657	!
658	!-- Integrated:
659	REAL(wp), ALLOCATABLE, DIMENSION(:,:,:), TARGET :: ldsa_av !< lung-deposited surface area
660	REAL(wp), ALLOCATABLE, DIMENSION(:,:,:), TARGET :: ntot_av !< total number concentration
661	REAL(wp), ALLOCATABLE, DIMENSION(:,:,:), TARGET :: pm25_av !< PM2.5
662	REAL(wp), ALLOCATABLE, DIMENSION(:,:,:), TARGET :: pm10_av !< PM10
663	!
664	!-- In the particle phase:
665	REAL(wp), ALLOCATABLE, DIMENSION(:,:,:), TARGET :: s_bc_av !< black carbon
666	REAL(wp), ALLOCATABLE, DIMENSION(:,:,:), TARGET :: s_du_av !< dust
667	REAL(wp), ALLOCATABLE, DIMENSION(:,:,:), TARGET :: s_h2o_av !< liquid water
668	REAL(wp), ALLOCATABLE, DIMENSION(:,:,:), TARGET :: s_nh_av !< ammonia
669	REAL(wp), ALLOCATABLE, DIMENSION(:,:,:), TARGET :: s_no_av !< nitrates
670	REAL(wp), ALLOCATABLE, DIMENSION(:,:,:), TARGET :: s_oc_av !< org. carbon
671	REAL(wp), ALLOCATABLE, DIMENSION(:,:,:), TARGET :: s_so4_av !< sulphates
672	REAL(wp), ALLOCATABLE, DIMENSION(:,:,:), TARGET :: s_ss_av !< sea salt
673	!
674	!-- Bin specific mass and number concentrations:
675	REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:), TARGET :: mbins_av !< bin mas
676	REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:), TARGET :: nbins_av !< bin number
677
678	!
679	!-- PALM interfaces:
680	!
681	!-- Boundary conditions:
682	INTERFACE salsa_boundary_conds
683	MODULE PROCEDURE salsa_boundary_conds
684	MODULE PROCEDURE salsa_boundary_conds_decycle
685	END INTERFACE salsa_boundary_conds
686	!
687	!-- Data output checks for 2D/3D data to be done in check_parameters
688	INTERFACE salsa_check_data_output
689	MODULE PROCEDURE salsa_check_data_output
690	END INTERFACE salsa_check_data_output
691	!
692	!-- Input parameter checks to be done in check_parameters
693	INTERFACE salsa_check_parameters
694	MODULE PROCEDURE salsa_check_parameters
695	END INTERFACE salsa_check_parameters
696	!
697	!-- Averaging of 3D data for output
698	INTERFACE salsa_3d_data_averaging
699	MODULE PROCEDURE salsa_3d_data_averaging
700	END INTERFACE salsa_3d_data_averaging
701	!
702	!-- Data output of 2D quantities
703	INTERFACE salsa_data_output_2d
704	MODULE PROCEDURE salsa_data_output_2d
705	END INTERFACE salsa_data_output_2d
706	!
707	!-- Data output of 3D data
708	INTERFACE salsa_data_output_3d
709	MODULE PROCEDURE salsa_data_output_3d
710	END INTERFACE salsa_data_output_3d
711	!
712	!-- Data output of 3D data
713	INTERFACE salsa_data_output_mask
714	MODULE PROCEDURE salsa_data_output_mask
715	END INTERFACE salsa_data_output_mask
716	!
717	!-- Definition of data output quantities
718	INTERFACE salsa_define_netcdf_grid
719	MODULE PROCEDURE salsa_define_netcdf_grid
720	END INTERFACE salsa_define_netcdf_grid
721	!
722	!-- Output of information to the header file
723	INTERFACE salsa_header
724	MODULE PROCEDURE salsa_header
725	END INTERFACE salsa_header
726	!
727	!-- Initialization actions
728	INTERFACE salsa_init
729	MODULE PROCEDURE salsa_init
730	END INTERFACE salsa_init
731	!
732	!-- Initialization of arrays
733	INTERFACE salsa_init_arrays
734	MODULE PROCEDURE salsa_init_arrays
735	END INTERFACE salsa_init_arrays
736	!
737	!-- Writing of binary output for restart runs !!! renaming?!
738	INTERFACE salsa_wrd_local
739	MODULE PROCEDURE salsa_wrd_local
740	END INTERFACE salsa_wrd_local
741	!
742	!-- Reading of NAMELIST parameters
743	INTERFACE salsa_parin
744	MODULE PROCEDURE salsa_parin
745	END INTERFACE salsa_parin
746	!
747	!-- Reading of parameters for restart runs
748	INTERFACE salsa_rrd_local
749	MODULE PROCEDURE salsa_rrd_local
750	END INTERFACE salsa_rrd_local
751	!
752	!-- Swapping of time levels (required for prognostic variables)
753	INTERFACE salsa_swap_timelevel
754	MODULE PROCEDURE salsa_swap_timelevel
755	END INTERFACE salsa_swap_timelevel
756	!
757	!-- Interface between PALM and salsa
758	INTERFACE salsa_driver
759	MODULE PROCEDURE salsa_driver
760	END INTERFACE salsa_driver
761
762	!-- Actions salsa variables
763	INTERFACE salsa_actions
764	MODULE PROCEDURE salsa_actions
765	MODULE PROCEDURE salsa_actions_ij
766	END INTERFACE salsa_actions
767	!
768	!-- Non-advective processes (i.e. aerosol dynamic reactions) for salsa variables
769	INTERFACE salsa_non_advective_processes
770	MODULE PROCEDURE salsa_non_advective_processes
771	MODULE PROCEDURE salsa_non_advective_processes_ij
772	END INTERFACE salsa_non_advective_processes
773	!
774	!-- Exchange horiz for salsa variables
775	INTERFACE salsa_exchange_horiz_bounds
776	MODULE PROCEDURE salsa_exchange_horiz_bounds
777	END INTERFACE salsa_exchange_horiz_bounds
778	!
779	!-- Prognostics equations for salsa variables
780	INTERFACE salsa_prognostic_equations
781	MODULE PROCEDURE salsa_prognostic_equations
782	MODULE PROCEDURE salsa_prognostic_equations_ij
783	END INTERFACE salsa_prognostic_equations
784	!
785	!-- Tendency salsa variables
786	INTERFACE salsa_tendency
787	MODULE PROCEDURE salsa_tendency
788	MODULE PROCEDURE salsa_tendency_ij
789	END INTERFACE salsa_tendency
790
791
792	SAVE
793
794	PRIVATE
795	!
796	!-- Public functions:
797	PUBLIC salsa_boundary_conds, salsa_check_data_output, salsa_check_parameters, &
798	salsa_3d_data_averaging, salsa_data_output_2d, salsa_data_output_3d, &
799	salsa_data_output_mask, salsa_define_netcdf_grid, salsa_diagnostics, salsa_driver, &
800	salsa_emission_update, salsa_header, salsa_init, salsa_init_arrays, salsa_parin, &
801	salsa_rrd_local, salsa_swap_timelevel, salsa_prognostic_equations, salsa_wrd_local, &
802	salsa_actions, salsa_non_advective_processes, salsa_exchange_horiz_bounds
803	!
804	!-- Public parameters, constants and initial values
805	PUBLIC bc_am_t_val, bc_an_t_val, bc_gt_t_val, dots_salsa, dt_salsa, &
806	ibc_salsa_b, last_salsa_time, lsdepo, nest_salsa, salsa, salsa_gases_from_chem, &
807	skip_time_do_salsa
808	!
809	!-- Public prognostic variables
810	PUBLIC aerosol_mass, aerosol_number, gconc_2, mconc_2, nbins_aerosol, ncc, ncomponents_mass, &
811	nclim, nconc_2, ngases_salsa, prtcl, ra_dry, salsa_gas, sedim_vd
812
813
814	CONTAINS
815
816	!------------------------------------------------------------------------------!
817	! Description:
818	! ------------
819	!> Parin for &salsa_par for new modules
820	!------------------------------------------------------------------------------!
821	SUBROUTINE salsa_parin
822
823	IMPLICIT NONE
824
825	CHARACTER(LEN=80) :: line !< dummy string that contains the current line
826	!< of the parameter file
827
828	NAMELIST /salsa_parameters/ aerosol_flux_dpg, aerosol_flux_mass_fracs_a, &
829	aerosol_flux_mass_fracs_b, aerosol_flux_sigmag, &
830	advect_particle_water, bc_salsa_b, bc_salsa_t, decycle_lr, &
831	decycle_method, decycle_ns, depo_pcm_par, depo_pcm_type, &
832	depo_surf_par, dpg, dt_salsa, feedback_to_palm, h2so4_init, &
833	hno3_init, init_gases_type, init_aerosol_type, listspec, &
834	mass_fracs_a, mass_fracs_b, n_lognorm, nbin, nest_salsa, nf2a,&
835	nh3_init, nj3, nlcnd, nlcndgas, nlcndh2oae, nlcoag, nldepo, &
836	nldepo_pcm, nldepo_surf, nldistupdate, nsnucl, ocnv_init, &
837	ocsv_init, read_restart_data_salsa, reglim, salsa, &
838	salsa_emission_mode, sigmag, skip_time_do_salsa, &
839	surface_aerosol_flux, van_der_waals_coagc, write_binary_salsa
840
841	line = ' '
842	!
843	!-- Try to find salsa package
844	REWIND ( 11 )
845	line = ' '
846	DO WHILE ( INDEX( line, '&salsa_parameters' ) == 0 )
847	READ ( 11, '(A)', END=10 ) line
848	ENDDO
849	BACKSPACE ( 11 )
850	!
851	!-- Read user-defined namelist
852	READ ( 11, salsa_parameters )
853	!
854	!-- Enable salsa (salsa switch in modules.f90)
855	salsa = .TRUE.
856
857	10 CONTINUE
858
859	END SUBROUTINE salsa_parin
860
861	!------------------------------------------------------------------------------!
862	! Description:
863	! ------------
864	!> Check parameters routine for salsa.
865	!------------------------------------------------------------------------------!
866	SUBROUTINE salsa_check_parameters
867
868	USE control_parameters, &
869	ONLY: message_string
870
871	IMPLICIT NONE
872
873	!
874	!-- Checks go here (cf. check_parameters.f90).
875	IF ( salsa .AND. .NOT. humidity ) THEN
876	WRITE( message_string, * ) 'salsa = ', salsa, ' is not allowed with humidity = ', humidity
877	CALL message( 'salsa_check_parameters', 'PA0594', 1, 2, 0, 6, 0 )
878	ENDIF
879
880	IF ( bc_salsa_b == 'dirichlet' ) THEN
881	ibc_salsa_b = 0
882	ELSEIF ( bc_salsa_b == 'neumann' ) THEN
883	ibc_salsa_b = 1
884	ELSE
885	message_string = 'unknown boundary condition: bc_salsa_b = "' // TRIM( bc_salsa_t ) // '"'
886	CALL message( 'salsa_check_parameters', 'PA0595', 1, 2, 0, 6, 0 )
887	ENDIF
888
889	IF ( bc_salsa_t == 'dirichlet' ) THEN
890	ibc_salsa_t = 0
891	ELSEIF ( bc_salsa_t == 'neumann' ) THEN
892	ibc_salsa_t = 1
893	ELSEIF ( bc_salsa_t == 'nested' ) THEN
894	ibc_salsa_t = 2
895	ELSE
896	message_string = 'unknown boundary condition: bc_salsa_t = "' // TRIM( bc_salsa_t ) // '"'
897	CALL message( 'salsa_check_parameters', 'PA0596', 1, 2, 0, 6, 0 )
898	ENDIF
899
900	IF ( nj3 < 1 .OR. nj3 > 3 ) THEN
901	message_string = 'unknown nj3 (must be 1-3)'
902	CALL message( 'salsa_check_parameters', 'PA0597', 1, 2, 0, 6, 0 )
903	ENDIF
904
905	IF ( salsa_emission_mode /= 'no_emission' .AND. ibc_salsa_b == 0 ) THEN
906	message_string = 'salsa_emission_mode /= "no_emission" requires bc_salsa_b = "Neumann"'
907	CALL message( 'salsa_check_parameters','PA0598', 1, 2, 0, 6, 0 )
908	ENDIF
909
910	IF ( salsa_emission_mode /= 'no_emission' ) include_emission = .TRUE.
911
912	END SUBROUTINE salsa_check_parameters
913
914	!------------------------------------------------------------------------------!
915	!
916	! Description:
917	! ------------
918	!> Subroutine defining appropriate grid for netcdf variables.
919	!> It is called out from subroutine netcdf.
920	!> Same grid as for other scalars (see netcdf_interface_mod.f90)
921	!------------------------------------------------------------------------------!
922	SUBROUTINE salsa_define_netcdf_grid( var, found, grid_x, grid_y, grid_z )
923
924	IMPLICIT NONE
925
926	CHARACTER(LEN=*), INTENT(OUT) :: grid_x !<
927	CHARACTER(LEN=*), INTENT(OUT) :: grid_y !<
928	CHARACTER(LEN=*), INTENT(OUT) :: grid_z !<
929	CHARACTER(LEN=*), INTENT(IN) :: var !<
930
931	LOGICAL, INTENT(OUT) :: found !<
932
933	found = .TRUE.
934	!
935	!-- Check for the grid
936
937	IF ( var(1:2) == 'g_' ) THEN
938	grid_x = 'x'
939	grid_y = 'y'
940	grid_z = 'zu'
941	ELSEIF ( var(1:4) == 'LDSA' ) THEN
942	grid_x = 'x'
943	grid_y = 'y'
944	grid_z = 'zu'
945	ELSEIF ( var(1:5) == 'm_bin' ) THEN
946	grid_x = 'x'
947	grid_y = 'y'
948	grid_z = 'zu'
949	ELSEIF ( var(1:5) == 'N_bin' ) THEN
950	grid_x = 'x'
951	grid_y = 'y'
952	grid_z = 'zu'
953	ELSEIF ( var(1:4) == 'Ntot' ) THEN
954	grid_x = 'x'
955	grid_y = 'y'
956	grid_z = 'zu'
957	ELSEIF ( var(1:2) == 'PM' ) THEN
958	grid_x = 'x'
959	grid_y = 'y'
960	grid_z = 'zu'
961	ELSEIF ( var(1:2) == 's_' ) THEN
962	grid_x = 'x'
963	grid_y = 'y'
964	grid_z = 'zu'
965	ELSE
966	found = .FALSE.
967	grid_x = 'none'
968	grid_y = 'none'
969	grid_z = 'none'
970	ENDIF
971
972	END SUBROUTINE salsa_define_netcdf_grid
973
974	!------------------------------------------------------------------------------!
975	! Description:
976	! ------------
977	!> Header output for new module
978	!------------------------------------------------------------------------------!
979	SUBROUTINE salsa_header( io )
980
981	IMPLICIT NONE
982
983	INTEGER(iwp), INTENT(IN) :: io !< Unit of the output file
984	!
985	!-- Write SALSA header
986	WRITE( io, 1 )
987	WRITE( io, 2 ) skip_time_do_salsa
988	WRITE( io, 3 ) dt_salsa
989	WRITE( io, 4 ) SHAPE( aerosol_number(1)%conc ), nbins_aerosol
990	IF ( advect_particle_water ) THEN
991	WRITE( io, 5 ) SHAPE( aerosol_mass(1)%conc ), ncomponents_mass*nbins_aerosol, &
992	advect_particle_water
993	ELSE
994	WRITE( io, 5 ) SHAPE( aerosol_mass(1)%conc ), ncc*nbins_aerosol, advect_particle_water
995	ENDIF
996	IF ( .NOT. salsa_gases_from_chem ) THEN
997	WRITE( io, 6 ) SHAPE( aerosol_mass(1)%conc ), ngases_salsa, salsa_gases_from_chem
998	ENDIF
999	WRITE( io, 7 )
1000	IF ( nsnucl > 0 ) WRITE( io, 8 ) nsnucl, nj3
1001	IF ( nlcoag ) WRITE( io, 9 )
1002	IF ( nlcnd ) WRITE( io, 10 ) nlcndgas, nlcndh2oae
1003	IF ( lspartition ) WRITE( io, 11 )
1004	IF ( nldepo ) WRITE( io, 12 ) nldepo_pcm, nldepo_surf
1005	WRITE( io, 13 ) reglim, nbin, bin_low_limits
1006	IF ( init_aerosol_type == 0 ) WRITE( io, 14 ) nsect
1007	WRITE( io, 15 ) ncc, listspec, mass_fracs_a, mass_fracs_b
1008	IF ( .NOT. salsa_gases_from_chem ) THEN
1009	WRITE( io, 16 ) ngases_salsa, h2so4_init, hno3_init, nh3_init, ocnv_init, ocsv_init
1010	ENDIF
1011	WRITE( io, 17 ) init_aerosol_type, init_gases_type
1012	IF ( init_aerosol_type == 0 ) THEN
1013	WRITE( io, 18 ) dpg, sigmag, n_lognorm
1014	ELSE
1015	WRITE( io, 19 )
1016	ENDIF
1017	IF ( nest_salsa ) WRITE( io, 20 ) nest_salsa
1018	WRITE( io, 21 ) salsa_emission_mode
1019	IF ( salsa_emission_mode == 'uniform' ) THEN
1020	WRITE( io, 22 ) surface_aerosol_flux, aerosol_flux_dpg, aerosol_flux_sigmag, &
1021	aerosol_flux_mass_fracs_a
1022	ENDIF
1023	IF ( SUM( aerosol_flux_mass_fracs_b ) > 0.0_wp .OR. salsa_emission_mode == 'read_from_file' ) &
1024	THEN
1025	WRITE( io, 23 )
1026	ENDIF
1027
1028	1 FORMAT (//' SALSA information:'/ &
1029	' ------------------------------'/)
1030	2 FORMAT (' Starts at: skip_time_do_salsa = ', F10.2, ' s')
1031	3 FORMAT (/' Timestep: dt_salsa = ', F6.2, ' s')
1032	4 FORMAT (/' Array shape (z,y,x,bins):'/ &
1033	' aerosol_number: ', 4(I3))
1034	5 FORMAT (/' aerosol_mass: ', 4(I3),/ &
1035	' (advect_particle_water = ', L1, ')')
1036	6 FORMAT (' salsa_gas: ', 4(I3),/ &
1037	' (salsa_gases_from_chem = ', L1, ')')
1038	7 FORMAT (/' Aerosol dynamic processes included: ')
1039	8 FORMAT (/' nucleation (scheme = ', I1, ' and J3 parametrization = ', I1, ')')
1040	9 FORMAT (/' coagulation')
1041	10 FORMAT (/' condensation (of precursor gases = ', L1, ' and water vapour = ', L1, ')' )
1042	11 FORMAT (/' dissolutional growth by HNO3 and NH3')
1043	12 FORMAT (/' dry deposition (on vegetation = ', L1, ' and on topography = ', L1, ')')
1044	13 FORMAT (/' Aerosol bin subrange limits (in metres): ', 3(ES10.2E3), / &
1045	' Number of size bins for each aerosol subrange: ', 2I3,/ &
1046	' Aerosol bin limits (in metres): ', 9(ES10.2E3))
1047	14 FORMAT (' Initial number concentration in bins at the lowest level (#/m**3):', 9(ES10.2E3))
1048	15 FORMAT (/' Number of chemical components used: ', I1,/ &
1049	' Species: ',7(A6),/ &
1050	' Initial relative contribution of each species to particle volume in:',/ &
1051	' a-bins: ', 7(F6.3),/ &
1052	' b-bins: ', 7(F6.3))
1053	16 FORMAT (/' Number of gaseous tracers used: ', I1,/ &
1054	' Initial gas concentrations:',/ &
1055	' H2SO4: ',ES12.4E3, ' #/m**3',/ &
1056	' HNO3: ',ES12.4E3, ' #/m**3',/ &
1057	' NH3: ',ES12.4E3, ' #/m**3',/ &
1058	' OCNV: ',ES12.4E3, ' #/m**3',/ &
1059	' OCSV: ',ES12.4E3, ' #/m**3')
1060	17 FORMAT (/' Initialising concentrations: ', / &
1061	' Aerosol size distribution: init_aerosol_type = ', I1,/ &
1062	' Gas concentrations: init_gases_type = ', I1 )
1063	18 FORMAT ( ' Mode diametres: dpg(nmod) = ', 7(F7.3), ' (m)', / &
1064	' Standard deviation: sigmag(nmod) = ', 7(F7.2),/ &
1065	' Number concentration: n_lognorm(nmod) = ', 7(ES12.4E3), ' (#/m3)' )
1066	19 FORMAT (/' Size distribution read from a file.')
1067	20 FORMAT (/' Nesting for salsa variables: ', L1 )
1068	21 FORMAT (/' Emissions: salsa_emission_mode = ', A )
1069	22 FORMAT (/' surface_aerosol_flux = ', ES12.4E3, ' #/m**2/s', / &
1070	' aerosol_flux_dpg = ', 7(F7.3), ' (m)', / &
1071	' aerosol_flux_sigmag = ', 7(F7.2), / &
1072	' aerosol_mass_fracs_a = ', 7(ES12.4E3) )
1073	23 FORMAT (/' (currently all emissions are soluble!)')
1074
1075	END SUBROUTINE salsa_header
1076
1077	!------------------------------------------------------------------------------!
1078	! Description:
1079	! ------------
1080	!> Allocate SALSA arrays and define pointers if required
1081	!------------------------------------------------------------------------------!
1082	SUBROUTINE salsa_init_arrays
1083
1084	USE chem_gasphase_mod, &
1085	ONLY: nvar
1086
1087	USE surface_mod, &
1088	ONLY: surf_def_h, surf_def_v, surf_lsm_h, surf_lsm_v, surf_usm_h, surf_usm_v
1089
1090	IMPLICIT NONE
1091
1092	INTEGER(iwp) :: gases_available !< Number of available gas components in the chemistry model
1093	INTEGER(iwp) :: i !< loop index for allocating
1094	INTEGER(iwp) :: l !< loop index for allocating: surfaces
1095	INTEGER(iwp) :: lsp !< loop index for chem species in the chemistry model
1096
1097	gases_available = 0
1098	!
1099	!-- Allocate prognostic variables (see salsa_swap_timelevel)
1100	!
1101	!-- Set derived indices:
1102	!-- (This does the same as the subroutine salsa_initialize in SALSA/UCLALES-SALSA)
1103	start_subrange_1a = 1 ! 1st index of subrange 1a
1104	start_subrange_2a = start_subrange_1a + nbin(1) ! 1st index of subrange 2a
1105	end_subrange_1a = start_subrange_2a - 1 ! last index of subrange 1a
1106	end_subrange_2a = end_subrange_1a + nbin(2) ! last index of subrange 2a
1107
1108	!
1109	!-- If the fraction of insoluble aerosols in subrange 2 is zero: do not allocate arrays for them
1110	IF ( nf2a > 0.999999_wp .AND. SUM( mass_fracs_b ) < 0.00001_wp ) THEN
1111	no_insoluble = .TRUE.
1112	start_subrange_2b = end_subrange_2a+1 ! 1st index of subrange 2b
1113	end_subrange_2b = end_subrange_2a ! last index of subrange 2b
1114	ELSE
1115	start_subrange_2b = start_subrange_2a + nbin(2) ! 1st index of subrange 2b
1116	end_subrange_2b = end_subrange_2a + nbin(2) ! last index of subrange 2b
1117	ENDIF
1118
1119	nbins_aerosol = end_subrange_2b ! total number of aerosol size bins
1120	!
1121	!-- Create index tables for different aerosol components
1122	CALL component_index_constructor( prtcl, ncc, maxspec, listspec )
1123
1124	ncomponents_mass = ncc
1125	IF ( advect_particle_water ) ncomponents_mass = ncc + 1 ! Add water
1126
1127	!
1128	!-- Allocate:
1129	ALLOCATE( aero(nbins_aerosol), bc_am_t_val(nbins_aerosol*ncomponents_mass), &
1130	bc_an_t_val(nbins_aerosol), bc_gt_t_val(ngases_salsa), bin_low_limits(nbins_aerosol),&
1131	nsect(nbins_aerosol), massacc(nbins_aerosol) )
1132	ALLOCATE( k_topo_top(nysg:nyng,nxlg:nxrg) )
1133	IF ( nldepo ) ALLOCATE( sedim_vd(nzb:nzt+1,nysg:nyng,nxlg:nxrg,nbins_aerosol) )
1134	ALLOCATE( ra_dry(nzb:nzt+1,nysg:nyng,nxlg:nxrg,nbins_aerosol) )
1135
1136	!
1137	!-- Aerosol number concentration
1138	ALLOCATE( aerosol_number(nbins_aerosol) )
1139	ALLOCATE( nconc_1(nzb:nzt+1,nysg:nyng,nxlg:nxrg,nbins_aerosol), &
1140	nconc_2(nzb:nzt+1,nysg:nyng,nxlg:nxrg,nbins_aerosol), &
1141	nconc_3(nzb:nzt+1,nysg:nyng,nxlg:nxrg,nbins_aerosol) )
1142	nconc_1 = 0.0_wp
1143	nconc_2 = 0.0_wp
1144	nconc_3 = 0.0_wp
1145
1146	DO i = 1, nbins_aerosol
1147	aerosol_number(i)%conc(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => nconc_1(:,:,:,i)
1148	aerosol_number(i)%conc_p(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => nconc_2(:,:,:,i)
1149	aerosol_number(i)%tconc_m(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => nconc_3(:,:,:,i)
1150	ALLOCATE( aerosol_number(i)%flux_s(nzb+1:nzt,0:threads_per_task-1), &
1151	aerosol_number(i)%diss_s(nzb+1:nzt,0:threads_per_task-1), &
1152	aerosol_number(i)%flux_l(nzb+1:nzt,nys:nyn,0:threads_per_task-1), &
1153	aerosol_number(i)%diss_l(nzb+1:nzt,nys:nyn,0:threads_per_task-1), &
1154	aerosol_number(i)%init(nzb:nzt+1), &
1155	aerosol_number(i)%sums_ws_l(nzb:nzt+1,0:threads_per_task-1) )
1156	IF ( include_emission .OR. ( nldepo .AND. nldepo_surf ) ) THEN
1157	ALLOCATE( aerosol_number(i)%source(nys:nyn,nxl:nxr) )
1158	ENDIF
1159	ENDDO
1160
1161	!
1162	!-- Aerosol mass concentration
1163	ALLOCATE( aerosol_mass(ncomponents_mass*nbins_aerosol) )
1164	ALLOCATE( mconc_1(nzb:nzt+1,nysg:nyng,nxlg:nxrg,ncomponents_mass*nbins_aerosol), &
1165	mconc_2(nzb:nzt+1,nysg:nyng,nxlg:nxrg,ncomponents_mass*nbins_aerosol), &
1166	mconc_3(nzb:nzt+1,nysg:nyng,nxlg:nxrg,ncomponents_mass*nbins_aerosol) )
1167	mconc_1 = 0.0_wp
1168	mconc_2 = 0.0_wp
1169	mconc_3 = 0.0_wp
1170
1171	DO i = 1, ncomponents_mass*nbins_aerosol
1172	aerosol_mass(i)%conc(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => mconc_1(:,:,:,i)
1173	aerosol_mass(i)%conc_p(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => mconc_2(:,:,:,i)
1174	aerosol_mass(i)%tconc_m(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => mconc_3(:,:,:,i)
1175	ALLOCATE( aerosol_mass(i)%flux_s(nzb+1:nzt,0:threads_per_task-1), &
1176	aerosol_mass(i)%diss_s(nzb+1:nzt,0:threads_per_task-1), &
1177	aerosol_mass(i)%flux_l(nzb+1:nzt,nys:nyn,0:threads_per_task-1), &
1178	aerosol_mass(i)%diss_l(nzb+1:nzt,nys:nyn,0:threads_per_task-1), &
1179	aerosol_mass(i)%init(nzb:nzt+1), &
1180	aerosol_mass(i)%sums_ws_l(nzb:nzt+1,0:threads_per_task-1) )
1181	IF ( include_emission .OR. ( nldepo .AND. nldepo_surf ) ) THEN
1182	ALLOCATE( aerosol_mass(i)%source(nys:nyn,nxl:nxr) )
1183	ENDIF
1184	ENDDO
1185
1186	!
1187	!-- Surface fluxes: answs = aerosol number, amsws = aerosol mass
1188	!
1189	!-- Horizontal surfaces: default type
1190	DO l = 0, 2 ! upward (l=0), downward (l=1) and model top (l=2)
1191	ALLOCATE( surf_def_h(l)%answs( 1:surf_def_h(l)%ns, nbins_aerosol ) )
1192	ALLOCATE( surf_def_h(l)%amsws( 1:surf_def_h(l)%ns, nbins_aerosol*ncomponents_mass ) )
1193	surf_def_h(l)%answs = 0.0_wp
1194	surf_def_h(l)%amsws = 0.0_wp
1195	ENDDO
1196	!
1197	!-- Horizontal surfaces: natural type
1198	ALLOCATE( surf_lsm_h%answs( 1:surf_lsm_h%ns, nbins_aerosol ) )
1199	ALLOCATE( surf_lsm_h%amsws( 1:surf_lsm_h%ns, nbins_aerosol*ncomponents_mass ) )
1200	surf_lsm_h%answs = 0.0_wp
1201	surf_lsm_h%amsws = 0.0_wp
1202	!
1203	!-- Horizontal surfaces: urban type
1204	ALLOCATE( surf_usm_h%answs( 1:surf_usm_h%ns, nbins_aerosol ) )
1205	ALLOCATE( surf_usm_h%amsws( 1:surf_usm_h%ns, nbins_aerosol*ncomponents_mass ) )
1206	surf_usm_h%answs = 0.0_wp
1207	surf_usm_h%amsws = 0.0_wp
1208
1209	!
1210	!-- Vertical surfaces: northward (l=0), southward (l=1), eastward (l=2) and westward (l=3) facing
1211	DO l = 0, 3
1212	ALLOCATE( surf_def_v(l)%answs( 1:surf_def_v(l)%ns, nbins_aerosol ) )
1213	surf_def_v(l)%answs = 0.0_wp
1214	ALLOCATE( surf_def_v(l)%amsws( 1:surf_def_v(l)%ns, nbins_aerosol*ncomponents_mass ) )
1215	surf_def_v(l)%amsws = 0.0_wp
1216
1217	ALLOCATE( surf_lsm_v(l)%answs( 1:surf_lsm_v(l)%ns, nbins_aerosol ) )
1218	surf_lsm_v(l)%answs = 0.0_wp
1219	ALLOCATE( surf_lsm_v(l)%amsws( 1:surf_lsm_v(l)%ns, nbins_aerosol*ncomponents_mass ) )
1220	surf_lsm_v(l)%amsws = 0.0_wp
1221
1222	ALLOCATE( surf_usm_v(l)%answs( 1:surf_usm_v(l)%ns, nbins_aerosol ) )
1223	surf_usm_v(l)%answs = 0.0_wp
1224	ALLOCATE( surf_usm_v(l)%amsws( 1:surf_usm_v(l)%ns, nbins_aerosol*ncomponents_mass ) )
1225	surf_usm_v(l)%amsws = 0.0_wp
1226
1227	ENDDO
1228
1229	!
1230	!-- Concentration of gaseous tracers (1. SO4, 2. HNO3, 3. NH3, 4. OCNV, 5. OCSV)
1231	!-- (number concentration (#/m3) )
1232	!
1233	!-- If chemistry is on, read gas phase concentrations from there. Otherwise,
1234	!-- allocate salsa_gas array.
1235
1236	IF ( air_chemistry ) THEN
1237	DO lsp = 1, nvar
1238	SELECT CASE ( TRIM( chem_species(lsp)%name ) )
1239	CASE ( 'H2SO4', 'h2so4' )
1240	gases_available = gases_available + 1
1241	gas_index_chem(1) = lsp
1242	CASE ( 'HNO3', 'hno3' )
1243	gases_available = gases_available + 1
1244	gas_index_chem(2) = lsp
1245	CASE ( 'NH3', 'nh3' )
1246	gases_available = gases_available + 1
1247	gas_index_chem(3) = lsp
1248	CASE ( 'OCNV', 'ocnv' )
1249	gases_available = gases_available + 1
1250	gas_index_chem(4) = lsp
1251	CASE ( 'OCSV', 'ocsv' )
1252	gases_available = gases_available + 1
1253	gas_index_chem(5) = lsp
1254	END SELECT
1255	ENDDO
1256
1257	IF ( gases_available == ngases_salsa ) THEN
1258	salsa_gases_from_chem = .TRUE.
1259	ELSE
1260	WRITE( message_string, * ) 'SALSA is run together with chemistry but not all gaseous '// &
1261	'components are provided by kpp (H2SO4, HNO3, NH3, OCNV, OCSV)'
1262	CALL message( 'check_parameters', 'PA0599', 1, 2, 0, 6, 0 )
1263	ENDIF
1264
1265	ELSE
1266
1267	ALLOCATE( salsa_gas(ngases_salsa) )
1268	ALLOCATE( gconc_1(nzb:nzt+1,nysg:nyng,nxlg:nxrg,ngases_salsa), &
1269	gconc_2(nzb:nzt+1,nysg:nyng,nxlg:nxrg,ngases_salsa), &
1270	gconc_3(nzb:nzt+1,nysg:nyng,nxlg:nxrg,ngases_salsa) )
1271	gconc_1 = 0.0_wp
1272	gconc_2 = 0.0_wp
1273	gconc_3 = 0.0_wp
1274
1275	DO i = 1, ngases_salsa
1276	salsa_gas(i)%conc(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => gconc_1(:,:,:,i)
1277	salsa_gas(i)%conc_p(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => gconc_2(:,:,:,i)
1278	salsa_gas(i)%tconc_m(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => gconc_3(:,:,:,i)
1279	ALLOCATE( salsa_gas(i)%flux_s(nzb+1:nzt,0:threads_per_task-1), &
1280	salsa_gas(i)%diss_s(nzb+1:nzt,0:threads_per_task-1), &
1281	salsa_gas(i)%flux_l(nzb+1:nzt,nys:nyn,0:threads_per_task-1),&
1282	salsa_gas(i)%diss_l(nzb+1:nzt,nys:nyn,0:threads_per_task-1),&
1283	salsa_gas(i)%init(nzb:nzt+1), &
1284	salsa_gas(i)%sums_ws_l(nzb:nzt+1,0:threads_per_task-1) )
1285	IF ( include_emission ) ALLOCATE( salsa_gas(i)%source(nys:nys,nxl:nxr) )
1286	ENDDO
1287	!
1288	!-- Surface fluxes: gtsws = gaseous tracer flux
1289	!
1290	!-- Horizontal surfaces: default type
1291	DO l = 0, 2 ! upward (l=0), downward (l=1) and model top (l=2)
1292	ALLOCATE( surf_def_h(l)%gtsws( 1:surf_def_h(l)%ns, ngases_salsa ) )
1293	surf_def_h(l)%gtsws = 0.0_wp
1294	ENDDO
1295	!-- Horizontal surfaces: natural type
1296	ALLOCATE( surf_lsm_h%gtsws( 1:surf_lsm_h%ns, ngases_salsa ) )
1297	surf_lsm_h%gtsws = 0.0_wp
1298	!-- Horizontal surfaces: urban type
1299	ALLOCATE( surf_usm_h%gtsws( 1:surf_usm_h%ns, ngases_salsa ) )
1300	surf_usm_h%gtsws = 0.0_wp
1301	!
1302	!-- Vertical surfaces: northward (l=0), southward (l=1), eastward (l=2) and
1303	!-- westward (l=3) facing
1304	DO l = 0, 3
1305	ALLOCATE( surf_def_v(l)%gtsws( 1:surf_def_v(l)%ns, ngases_salsa ) )
1306	surf_def_v(l)%gtsws = 0.0_wp
1307	ALLOCATE( surf_lsm_v(l)%gtsws( 1:surf_lsm_v(l)%ns, ngases_salsa ) )
1308	surf_lsm_v(l)%gtsws = 0.0_wp
1309	ALLOCATE( surf_usm_v(l)%gtsws( 1:surf_usm_v(l)%ns, ngases_salsa ) )
1310	surf_usm_v(l)%gtsws = 0.0_wp
1311	ENDDO
1312	ENDIF
1313
1314	IF ( ws_scheme_sca ) THEN
1315
1316	IF ( salsa ) THEN
1317	ALLOCATE( sums_salsa_ws_l(nzb:nzt+1,0:threads_per_task-1) )
1318	sums_salsa_ws_l = 0.0_wp
1319	ENDIF
1320
1321	ENDIF
1322
1323	END SUBROUTINE salsa_init_arrays
1324
1325	!------------------------------------------------------------------------------!
1326	! Description:
1327	! ------------
1328	!> Initialization of SALSA. Based on salsa_initialize in UCLALES-SALSA.
1329	!> Subroutines salsa_initialize, SALSAinit and DiagInitAero in UCLALES-SALSA are
1330	!> also merged here.
1331	!------------------------------------------------------------------------------!
1332	SUBROUTINE salsa_init
1333
1334	IMPLICIT NONE
1335
1336	INTEGER(iwp) :: i !<
1337	INTEGER(iwp) :: ib !< loop index for aerosol number bins
1338	INTEGER(iwp) :: ic !< loop index for aerosol mass bins
1339	INTEGER(iwp) :: ig !< loop index for gases
1340	INTEGER(iwp) :: ii !< index for indexing
1341	INTEGER(iwp) :: j !<
1342
1343	IF ( debug_output ) CALL debug_message( 'salsa_init', 'start' )
1344
1345	bin_low_limits = 0.0_wp
1346	k_topo_top = 0
1347	nsect = 0.0_wp
1348	massacc = 1.0_wp
1349
1350	!
1351	!-- Indices for chemical components used (-1 = not used)
1352	ii = 0
1353	IF ( is_used( prtcl, 'SO4' ) ) THEN
1354	index_so4 = get_index( prtcl,'SO4' )
1355	ii = ii + 1
1356	ENDIF
1357	IF ( is_used( prtcl,'OC' ) ) THEN
1358	index_oc = get_index(prtcl, 'OC')
1359	ii = ii + 1
1360	ENDIF
1361	IF ( is_used( prtcl, 'BC' ) ) THEN
1362	index_bc = get_index( prtcl, 'BC' )
1363	ii = ii + 1
1364	ENDIF
1365	IF ( is_used( prtcl, 'DU' ) ) THEN
1366	index_du = get_index( prtcl, 'DU' )
1367	ii = ii + 1
1368	ENDIF
1369	IF ( is_used( prtcl, 'SS' ) ) THEN
1370	index_ss = get_index( prtcl, 'SS' )
1371	ii = ii + 1
1372	ENDIF
1373	IF ( is_used( prtcl, 'NO' ) ) THEN
1374	index_no = get_index( prtcl, 'NO' )
1375	ii = ii + 1
1376	ENDIF
1377	IF ( is_used( prtcl, 'NH' ) ) THEN
1378	index_nh = get_index( prtcl, 'NH' )
1379	ii = ii + 1
1380	ENDIF
1381	!
1382	!-- All species must be known
1383	IF ( ii /= ncc ) THEN
1384	message_string = 'Unknown aerosol species/component(s) given in the initialization'
1385	CALL message( 'salsa_mod: salsa_init', 'PA0600', 1, 2, 0, 6, 0 )
1386	ENDIF
1387	!
1388	!-- Partition and dissolutional growth by gaseous HNO3 and NH3
1389	IF ( index_no > 0 .AND. index_nh > 0 .AND. index_so4 > 0 ) lspartition = .TRUE.
1390	!
1391	!-- Initialise
1392	!
1393	!-- Aerosol size distribution (TYPE t_section)
1394	aero(:)%dwet = 1.0E-10_wp
1395	aero(:)%veqh2o = 1.0E-10_wp
1396	aero(:)%numc = nclim
1397	aero(:)%core = 1.0E-10_wp
1398	DO ic = 1, maxspec+1 ! 1:SO4, 2:OC, 3:BC, 4:DU, 5:SS, 6:NO, 7:NH, 8:H2O
1399	aero(:)%volc(ic) = 0.0_wp
1400	ENDDO
1401
1402	IF ( nldepo ) sedim_vd = 0.0_wp
1403
1404	DO ib = 1, nbins_aerosol
1405	IF ( .NOT. read_restart_data_salsa ) aerosol_number(ib)%conc = nclim
1406	aerosol_number(ib)%conc_p = 0.0_wp
1407	aerosol_number(ib)%tconc_m = 0.0_wp
1408	aerosol_number(ib)%flux_s = 0.0_wp
1409	aerosol_number(ib)%diss_s = 0.0_wp
1410	aerosol_number(ib)%flux_l = 0.0_wp
1411	aerosol_number(ib)%diss_l = 0.0_wp
1412	aerosol_number(ib)%init = nclim
1413	aerosol_number(ib)%sums_ws_l = 0.0_wp
1414	ENDDO
1415	DO ic = 1, ncomponents_mass*nbins_aerosol
1416	IF ( .NOT. read_restart_data_salsa ) aerosol_mass(ic)%conc = mclim
1417	aerosol_mass(ic)%conc_p = 0.0_wp
1418	aerosol_mass(ic)%tconc_m = 0.0_wp
1419	aerosol_mass(ic)%flux_s = 0.0_wp
1420	aerosol_mass(ic)%diss_s = 0.0_wp
1421	aerosol_mass(ic)%flux_l = 0.0_wp
1422	aerosol_mass(ic)%diss_l = 0.0_wp
1423	aerosol_mass(ic)%init = mclim
1424	aerosol_mass(ic)%sums_ws_l = 0.0_wp
1425	ENDDO
1426
1427	IF ( .NOT. salsa_gases_from_chem ) THEN
1428	DO ig = 1, ngases_salsa
1429	salsa_gas(ig)%conc_p = 0.0_wp
1430	salsa_gas(ig)%tconc_m = 0.0_wp
1431	salsa_gas(ig)%flux_s = 0.0_wp
1432	salsa_gas(ig)%diss_s = 0.0_wp
1433	salsa_gas(ig)%flux_l = 0.0_wp
1434	salsa_gas(ig)%diss_l = 0.0_wp
1435	salsa_gas(ig)%sums_ws_l = 0.0_wp
1436	ENDDO
1437	IF ( .NOT. read_restart_data_salsa ) THEN
1438	salsa_gas(1)%conc = h2so4_init
1439	salsa_gas(2)%conc = hno3_init
1440	salsa_gas(3)%conc = nh3_init
1441	salsa_gas(4)%conc = ocnv_init
1442	salsa_gas(5)%conc = ocsv_init
1443	ENDIF
1444	!
1445	!-- Set initial value for gas compound tracers and initial values
1446	salsa_gas(1)%init = h2so4_init
1447	salsa_gas(2)%init = hno3_init
1448	salsa_gas(3)%init = nh3_init
1449	salsa_gas(4)%init = ocnv_init
1450	salsa_gas(5)%init = ocsv_init
1451	ENDIF
1452	!
1453	!-- Aerosol radius in each bin: dry and wet (m)
1454	ra_dry = 1.0E-10_wp
1455	!
1456	!-- Initialise aerosol tracers
1457	aero(:)%vhilim = 0.0_wp
1458	aero(:)%vlolim = 0.0_wp
1459	aero(:)%vratiohi = 0.0_wp
1460	aero(:)%vratiolo = 0.0_wp
1461	aero(:)%dmid = 0.0_wp
1462	!
1463	!-- Initialise the sectional particle size distribution
1464	CALL set_sizebins
1465	!
1466	!-- Initialise location-dependent aerosol size distributions and chemical compositions:
1467	CALL aerosol_init
1468	!
1469	!-- Initalisation run of SALSA + calculate the vertical top index of the topography
1470	DO i = nxl, nxr
1471	DO j = nys, nyn
1472
1473	k_topo_top(j,i) = MAXLOC( MERGE( 1, 0, BTEST( wall_flags_0(:,j,i), 12 ) ), DIM = 1 ) - 1
1474
1475	CALL salsa_driver( i, j, 1 )
1476	CALL salsa_diagnostics( i, j )
1477	ENDDO
1478	ENDDO
1479	!
1480	!-- Initialise the deposition scheme and surface types
1481	IF ( nldepo ) CALL init_deposition
1482
1483	IF ( include_emission ) THEN
1484	!
1485	!-- Read in and initialize emissions
1486	CALL salsa_emission_setup( .TRUE. )
1487	IF ( .NOT. salsa_gases_from_chem .AND. salsa_emission_mode == 'read_from_file' ) THEN
1488	CALL salsa_gas_emission_setup( .TRUE. )
1489	ENDIF
1490	ENDIF
1491
1492	IF ( debug_output ) CALL debug_message( 'salsa_init', 'end' )
1493
1494	END SUBROUTINE salsa_init
1495
1496	!------------------------------------------------------------------------------!
1497	! Description:
1498	! ------------
1499	!> Initializes particle size distribution grid by calculating size bin limits
1500	!> and mid-size for dry particles in each bin. Called from salsa_initialize
1501	!> (only at the beginning of simulation).
1502	!> Size distribution described using:
1503	!> 1) moving center method (subranges 1 and 2)
1504	!> (Jacobson, Atmos. Env., 31, 131-144, 1997)
1505	!> 2) fixed sectional method (subrange 3)
1506	!> Size bins in each subrange are spaced logarithmically
1507	!> based on given subrange size limits and bin number.
1508	!
1509	!> Mona changed 06/2017: Use geometric mean diameter to describe the mean
1510	!> particle diameter in a size bin, not the arithmeric mean which clearly
1511	!> overestimates the total particle volume concentration.
1512	!
1513	!> Coded by:
1514	!> Hannele Korhonen (FMI) 2005
1515	!> Harri Kokkola (FMI) 2006
1516	!
1517	!> Bug fixes for box model + updated for the new aerosol datatype:
1518	!> Juha Tonttila (FMI) 2014
1519	!------------------------------------------------------------------------------!
1520	SUBROUTINE set_sizebins
1521
1522	IMPLICIT NONE
1523
1524	INTEGER(iwp) :: cc !< running index
1525	INTEGER(iwp) :: dd !< running index
1526
1527	REAL(wp) :: ratio_d !< ratio of the upper and lower diameter of subranges
1528	!
1529	!-- vlolim&vhilim: min & max dry volumes [fxm]
1530	!-- dmid: bin mid dry diameter (m)
1531	!-- vratiolo&vratiohi: volume ratio between the center and low/high limit
1532	!
1533	!-- 1) Size subrange 1:
1534	ratio_d = reglim(2) / reglim(1) ! section spacing (m)
1535	DO cc = start_subrange_1a, end_subrange_1a
1536	aero(cc)%vlolim = api6 * ( reglim(1) * ratio_d( REAL( cc-1 ) / nbin(1) ) )3
1537	aero(cc)%vhilim = api6 * ( reglim(1) * ratio_d( REAL( cc ) / nbin(1) ) )3
1538	aero(cc)%dmid = SQRT( ( aero(cc)%vhilim / api6 )*0.33333333_wp &
1539	( aero(cc)%vlolim / api6 )**0.33333333_wp )
1540	aero(cc)%vratiohi = aero(cc)%vhilim / ( api6 * aero(cc)%dmid**3 )
1541	aero(cc)%vratiolo = aero(cc)%vlolim / ( api6 * aero(cc)%dmid**3 )
1542	ENDDO
1543	!
1544	!-- 2) Size subrange 2:
1545	!-- 2.1) Sub-subrange 2a: high hygroscopicity
1546	ratio_d = reglim(3) / reglim(2) ! section spacing
1547	DO dd = start_subrange_2a, end_subrange_2a
1548	cc = dd - start_subrange_2a
1549	aero(dd)%vlolim = api6 * ( reglim(2) * ratio_d( REAL( cc ) / nbin(2) ) )3
1550	aero(dd)%vhilim = api6 * ( reglim(2) * ratio_d( REAL( cc+1 ) / nbin(2) ) )3
1551	aero(dd)%dmid = SQRT( ( aero(dd)%vhilim / api6 )*0.33333333_wp &
1552	( aero(dd)%vlolim / api6 )**0.33333333_wp )
1553	aero(dd)%vratiohi = aero(dd)%vhilim / ( api6 * aero(dd)%dmid**3 )
1554	aero(dd)%vratiolo = aero(dd)%vlolim / ( api6 * aero(dd)%dmid**3 )
1555	ENDDO
1556	!
1557	!-- 2.2) Sub-subrange 2b: low hygroscopicity
1558	IF ( .NOT. no_insoluble ) THEN
1559	aero(start_subrange_2b:end_subrange_2b)%vlolim = aero(start_subrange_2a:end_subrange_2a)%vlolim
1560	aero(start_subrange_2b:end_subrange_2b)%vhilim = aero(start_subrange_2a:end_subrange_2a)%vhilim
1561	aero(start_subrange_2b:end_subrange_2b)%dmid = aero(start_subrange_2a:end_subrange_2a)%dmid
1562	aero(start_subrange_2b:end_subrange_2b)%vratiohi = aero(start_subrange_2a:end_subrange_2a)%vratiohi
1563	aero(start_subrange_2b:end_subrange_2b)%vratiolo = aero(start_subrange_2a:end_subrange_2a)%vratiolo
1564	ENDIF
1565	!
1566	!-- Initialize the wet diameter with the bin dry diameter to avoid numerical problems later
1567	aero(:)%dwet = aero(:)%dmid
1568	!
1569	!-- Save bin limits (lower diameter) to be delivered to PALM if needed
1570	DO cc = 1, nbins_aerosol
1571	bin_low_limits(cc) = ( aero(cc)%vlolim / api6 )**0.33333333_wp
1572	ENDDO
1573
1574	END SUBROUTINE set_sizebins
1575
1576	!------------------------------------------------------------------------------!
1577	! Description:
1578	! ------------
1579	!> Initilize altitude-dependent aerosol size distributions and compositions.
1580	!>
1581	!> Mona added 06/2017: Correct the number and mass concentrations by normalizing
1582	!< by the given total number and mass concentration.
1583	!>
1584	!> Tomi Raatikainen, FMI, 29.2.2016
1585	!------------------------------------------------------------------------------!
1586	SUBROUTINE aerosol_init
1587
1588	USE netcdf_data_input_mod, &
1589	ONLY: get_attribute, get_variable, netcdf_data_input_get_dimension_length, open_read_file
1590
1591	IMPLICIT NONE
1592
1593	CHARACTER(LEN=25), DIMENSION(:), ALLOCATABLE :: cc_name !< chemical component name
1594
1595	INTEGER(iwp) :: ee !< index: end
1596	INTEGER(iwp) :: i !< loop index: x-direction
1597	INTEGER(iwp) :: ib !< loop index: size bins
1598	INTEGER(iwp) :: ic !< loop index: chemical components
1599	INTEGER(iwp) :: id_dyn !< NetCDF id of PIDS_DYNAMIC_SALSA
1600	INTEGER(iwp) :: ig !< loop index: gases
1601	INTEGER(iwp) :: j !< loop index: y-direction
1602	INTEGER(iwp) :: k !< loop index: z-direction
1603	INTEGER(iwp) :: lod_aero !< level of detail of inital aerosol concentrations
1604	INTEGER(iwp) :: pr_nbins !< Number of aerosol size bins in file
1605	INTEGER(iwp) :: pr_ncc !< Number of aerosol chemical components in file
1606	INTEGER(iwp) :: pr_nz !< Number of vertical grid-points in file
1607	INTEGER(iwp) :: prunmode !< running mode of SALSA
1608	INTEGER(iwp) :: ss !< index: start
1609
1610	INTEGER(iwp), DIMENSION(maxspec) :: cc_input_to_model
1611
1612	LOGICAL :: netcdf_extend = .FALSE. !< Flag: netcdf file exists
1613
1614	REAL(wp) :: flag !< flag to mask topography grid points
1615
1616	REAL(wp), DIMENSION(nbins_aerosol) :: core !< size of the bin mid aerosol particle
1617	REAL(wp), DIMENSION(nbins_aerosol) :: nsect !< size distribution (#/m3)
1618
1619	REAL(wp), DIMENSION(0:nz+1) :: pnf2a !< number fraction in 2a
1620	REAL(wp), DIMENSION(0:nz+1) :: pmfoc1a !< mass fraction of OC in 1a
1621
1622	REAL(wp), DIMENSION(0:nz+1,nbins_aerosol) :: pndist !< size dist as a function of height (#/m3)
1623	REAL(wp), DIMENSION(0:nz+1,maxspec) :: pmf2a !< mass distributions in subrange 2a
1624	REAL(wp), DIMENSION(0:nz+1,maxspec) :: pmf2b !< mass distributions in subrange 2b
1625
1626	REAL(wp), DIMENSION(:), ALLOCATABLE :: pr_dmid !< vertical profile of aerosol bin diameters
1627	REAL(wp), DIMENSION(:), ALLOCATABLE :: pr_z !< z levels of profiles
1628
1629	REAL(wp), DIMENSION(:,:), ALLOCATABLE :: pr_mass_fracs_a !< mass fraction: a
1630	REAL(wp), DIMENSION(:,:), ALLOCATABLE :: pr_mass_fracs_b !< and b
1631
1632	cc_input_to_model = 0
1633	prunmode = 1
1634	!
1635	!-- Bin mean aerosol particle volume (m3)
1636	core(:) = 0.0_wp
1637	core(1:nbins_aerosol) = api6 * aero(1:nbins_aerosol)%dmid**3
1638	!
1639	!-- Set concentrations to zero
1640	nsect(:) = 0.0_wp
1641	pndist(:,:) = 0.0_wp
1642	pnf2a(:) = nf2a
1643	pmf2a(:,:) = 0.0_wp
1644	pmf2b(:,:) = 0.0_wp
1645	pmfoc1a(:) = 0.0_wp
1646
1647	IF ( init_aerosol_type == 1 ) THEN
1648	!
1649	!-- Read input profiles from PIDS_DYNAMIC_SALSA
1650	#if defined( __netcdf )
1651	!
1652	!-- Location-dependent size distributions and compositions.
1653	INQUIRE( FILE = TRIM( input_file_dynamic ) // TRIM( coupling_char ), EXIST = netcdf_extend )
1654	IF ( netcdf_extend ) THEN
1655	!
1656	!-- Open file in read-only mode
1657	CALL open_read_file( TRIM( input_file_dynamic ) // TRIM( coupling_char ), id_dyn )
1658	!
1659	!-- Inquire dimensions:
1660	CALL netcdf_data_input_get_dimension_length( id_dyn, pr_nz, 'z' )
1661	IF ( pr_nz /= nz ) THEN
1662	WRITE( message_string, * ) 'Number of inifor horizontal grid points does not match '//&
1663	'the number of numeric grid points.'
1664	CALL message( 'aerosol_init', 'PA0601', 1, 2, 0, 6, 0 )
1665	ENDIF
1666	CALL netcdf_data_input_get_dimension_length( id_dyn, pr_ncc, 'composition_index' )
1667	!
1668	!-- Allocate memory
1669	ALLOCATE( pr_z(1:pr_nz), pr_mass_fracs_a(nzb:nzt+1,pr_ncc), &
1670	pr_mass_fracs_b(nzb:nzt+1,pr_ncc) )
1671	pr_mass_fracs_a = 0.0_wp
1672	pr_mass_fracs_b = 0.0_wp
1673	!
1674	!-- Read vertical levels
1675	CALL get_variable( id_dyn, 'z', pr_z )
1676	!
1677	!-- Read name and index of chemical components
1678	CALL get_variable( id_dyn, 'composition_name', cc_name, pr_ncc )
1679	DO ic = 1, pr_ncc
1680	SELECT CASE ( TRIM( cc_name(ic) ) )
1681	CASE ( 'H2SO4', 'SO4', 'h2so4', 'so4' )
1682	cc_input_to_model(1) = ic
1683	CASE ( 'OC', 'oc' )
1684	cc_input_to_model(2) = ic
1685	CASE ( 'BC', 'bc' )
1686	cc_input_to_model(3) = ic
1687	CASE ( 'DU', 'du' )
1688	cc_input_to_model(4) = ic
1689	CASE ( 'SS', 'ss' )
1690	cc_input_to_model(5) = ic
1691	CASE ( 'HNO3', 'hno3', 'NO', 'no' )
1692	cc_input_to_model(6) = ic
1693	CASE ( 'NH3', 'nh3', 'NH', 'nh' )
1694	cc_input_to_model(7) = ic
1695	END SELECT
1696	ENDDO
1697
1698	IF ( SUM( cc_input_to_model ) == 0 ) THEN
1699	message_string = 'None of the aerosol chemical components in ' // TRIM( &
1700	input_file_dynamic ) // ' correspond to ones applied in SALSA.'
1701	CALL message( 'salsa_mod: aerosol_init', 'PA0602', 2, 2, 0, 6, 0 )
1702	ENDIF
1703	!
1704	!-- Vertical profiles of mass fractions of different chemical components:
1705	CALL get_variable( id_dyn, 'init_atmosphere_mass_fracs_a', pr_mass_fracs_a, &
1706	0, pr_ncc-1, 0, pr_nz-1 )
1707	CALL get_variable( id_dyn, 'init_atmosphere_mass_fracs_b', pr_mass_fracs_b, &
1708	0, pr_ncc-1, 0, pr_nz-1 )
1709	!
1710	!-- Match the input data with the chemical composition applied in the model
1711	DO ic = 1, maxspec
1712	ss = cc_input_to_model(ic)
1713	IF ( ss == 0 ) CYCLE
1714	pmf2a(nzb+1:nzt+1,ic) = pr_mass_fracs_a(nzb:nzt,ss)
1715	pmf2b(nzb+1:nzt+1,ic) = pr_mass_fracs_b(nzb:nzt,ss)
1716	ENDDO
1717	!
1718	!-- Aerosol concentrations: lod=1 (total PM) or lod=2 (sectional number size distribution)
1719	CALL get_attribute( id_dyn, 'lod', lod_aero, .FALSE., 'init_atmosphere_aerosol' )
1720	IF ( lod_aero /= 1 ) THEN
1721	message_string = 'Currently only lod=1 accepted for init_atmosphere_aerosol'
1722	CALL message( 'salsa_mod: aerosol_init', 'PA0603', 2, 2, 0, 6, 0 )
1723	ELSE
1724	!
1725	!-- Bin mean diameters in the input file
1726	CALL netcdf_data_input_get_dimension_length( id_dyn, pr_nbins, 'Dmid')
1727	IF ( pr_nbins /= nbins_aerosol ) THEN
1728	message_string = 'Number of size bins in init_atmosphere_aerosol does not match ' &
1729	// 'with that applied in the model'
1730	CALL message( 'salsa_mod: aerosol_init', 'PA0604', 2, 2, 0, 6, 0 )
1731	ENDIF
1732
1733	ALLOCATE( pr_dmid(pr_nbins) )
1734	pr_dmid = 0.0_wp
1735
1736	CALL get_variable( id_dyn, 'Dmid', pr_dmid )
1737	!
1738	!-- Check whether the sectional representation conform to the one
1739	!-- applied in the model
1740	IF ( ANY( ABS( ( aero(1:nbins_aerosol)%dmid - pr_dmid ) / &
1741	aero(1:nbins_aerosol)%dmid ) > 0.1_wp ) ) THEN
1742	message_string = 'Mean diameters of the aerosol size bins in ' // TRIM( &
1743	input_file_dynamic ) // ' do not match with the sectional '// &
1744	'representation of the model.'
1745	CALL message( 'salsa_mod: aerosol_init', 'PA0605', 2, 2, 0, 6, 0 )
1746	ENDIF
1747	!
1748	!-- Inital aerosol concentrations
1749	CALL get_variable( id_dyn, 'init_atmosphere_aerosol', pndist(nzb+1:nzt,:), &
1750	0, pr_nbins-1, 0, pr_nz-1 )
1751	ENDIF
1752	!
1753	!-- Set bottom and top boundary condition (Neumann)
1754	pmf2a(nzb,:) = pmf2a(nzb+1,:)
1755	pmf2a(nzt+1,:) = pmf2a(nzt,:)
1756	pmf2b(nzb,:) = pmf2b(nzb+1,:)
1757	pmf2b(nzt+1,:) = pmf2b(nzt,:)
1758	pndist(nzb,:) = pndist(nzb+1,:)
1759	pndist(nzt+1,:) = pndist(nzt,:)
1760
1761	IF ( index_so4 < 0 ) THEN
1762	pmf2a(:,1) = 0.0_wp
1763	pmf2b(:,1) = 0.0_wp
1764	ENDIF
1765	IF ( index_oc < 0 ) THEN
1766	pmf2a(:,2) = 0.0_wp
1767	pmf2b(:,2) = 0.0_wp
1768	ENDIF
1769	IF ( index_bc < 0 ) THEN
1770	pmf2a(:,3) = 0.0_wp
1771	pmf2b(:,3) = 0.0_wp
1772	ENDIF
1773	IF ( index_du < 0 ) THEN
1774	pmf2a(:,4) = 0.0_wp
1775	pmf2b(:,4) = 0.0_wp
1776	ENDIF
1777	IF ( index_ss < 0 ) THEN
1778	pmf2a(:,5) = 0.0_wp
1779	pmf2b(:,5) = 0.0_wp
1780	ENDIF
1781	IF ( index_no < 0 ) THEN
1782	pmf2a(:,6) = 0.0_wp
1783	pmf2b(:,6) = 0.0_wp
1784	ENDIF
1785	IF ( index_nh < 0 ) THEN
1786	pmf2a(:,7) = 0.0_wp
1787	pmf2b(:,7) = 0.0_wp
1788	ENDIF
1789
1790	IF ( SUM( pmf2a ) < 0.00001_wp .AND. SUM( pmf2b ) < 0.00001_wp ) THEN
1791	message_string = 'Error in initialising mass fractions of chemical components. ' // &
1792	'Check that all chemical components are included in parameter file!'
1793	CALL message( 'salsa_mod: aerosol_init', 'PA0606', 2, 2, 0, 6, 0 )
1794	ENDIF
1795	!
1796	!-- Then normalise the mass fraction so that SUM = 1
1797	DO k = nzb, nzt+1
1798	pmf2a(k,:) = pmf2a(k,:) / SUM( pmf2a(k,:) )
1799	IF ( SUM( pmf2b(k,:) ) > 0.0_wp ) pmf2b(k,:) = pmf2b(k,:) / SUM( pmf2b(k,:) )
1800	ENDDO
1801
1802	DEALLOCATE( pr_z, pr_mass_fracs_a, pr_mass_fracs_b )
1803
1804	ELSE
1805	message_string = 'Input file '// TRIM( input_file_dynamic ) // TRIM( coupling_char ) // &
1806	' for SALSA missing!'
1807	CALL message( 'salsa_mod: aerosol_init', 'PA0607', 1, 2, 0, 6, 0 )
1808
1809	ENDIF ! netcdf_extend
1810
1811	#else
1812	message_string = 'init_aerosol_type = 1 but preprocessor directive __netcdf is not used '// &
1813	'in compiling!'
1814	CALL message( 'salsa_mod: aerosol_init', 'PA0608', 1, 2, 0, 6, 0 )
1815
1816	#endif
1817
1818	ELSEIF ( init_aerosol_type == 0 ) THEN
1819	!
1820	!-- Mass fractions for species in a and b-bins
1821	IF ( index_so4 > 0 ) THEN
1822	pmf2a(:,1) = mass_fracs_a(index_so4)
1823	pmf2b(:,1) = mass_fracs_b(index_so4)
1824	ENDIF
1825	IF ( index_oc > 0 ) THEN
1826	pmf2a(:,2) = mass_fracs_a(index_oc)
1827	pmf2b(:,2) = mass_fracs_b(index_oc)
1828	ENDIF
1829	IF ( index_bc > 0 ) THEN
1830	pmf2a(:,3) = mass_fracs_a(index_bc)
1831	pmf2b(:,3) = mass_fracs_b(index_bc)
1832	ENDIF
1833	IF ( index_du > 0 ) THEN
1834	pmf2a(:,4) = mass_fracs_a(index_du)
1835	pmf2b(:,4) = mass_fracs_b(index_du)
1836	ENDIF
1837	IF ( index_ss > 0 ) THEN
1838	pmf2a(:,5) = mass_fracs_a(index_ss)
1839	pmf2b(:,5) = mass_fracs_b(index_ss)
1840	ENDIF
1841	IF ( index_no > 0 ) THEN
1842	pmf2a(:,6) = mass_fracs_a(index_no)
1843	pmf2b(:,6) = mass_fracs_b(index_no)
1844	ENDIF
1845	IF ( index_nh > 0 ) THEN
1846	pmf2a(:,7) = mass_fracs_a(index_nh)
1847	pmf2b(:,7) = mass_fracs_b(index_nh)
1848	ENDIF
1849	DO k = nzb, nzt+1
1850	pmf2a(k,:) = pmf2a(k,:) / SUM( pmf2a(k,:) )
1851	IF ( SUM( pmf2b(k,:) ) > 0.0_wp ) pmf2b(k,:) = pmf2b(k,:) / SUM( pmf2b(k,:) )
1852	ENDDO
1853
1854	CALL size_distribution( n_lognorm, dpg, sigmag, nsect )
1855	!
1856	!-- Normalize by the given total number concentration
1857	nsect = nsect * SUM( n_lognorm ) / SUM( nsect )
1858	DO ib = start_subrange_1a, end_subrange_2b
1859	pndist(:,ib) = nsect(ib)
1860	ENDDO
1861	ENDIF
1862
1863	IF ( init_gases_type == 1 ) THEN
1864	!
1865	!-- Read input profiles from PIDS_CHEM
1866	#if defined( __netcdf )
1867	!
1868	!-- Location-dependent size distributions and compositions.
1869	INQUIRE( FILE = TRIM( input_file_dynamic ) // TRIM( coupling_char ), EXIST = netcdf_extend )
1870	IF ( netcdf_extend .AND. .NOT. salsa_gases_from_chem ) THEN
1871	!
1872	!-- Open file in read-only mode
1873	CALL open_read_file( TRIM( input_file_dynamic ) // TRIM( coupling_char ), id_dyn )
1874	!
1875	!-- Inquire dimensions:
1876	CALL netcdf_data_input_get_dimension_length( id_dyn, pr_nz, 'z' )
1877	IF ( pr_nz /= nz ) THEN
1878	WRITE( message_string, * ) 'Number of inifor horizontal grid points does not match '//&
1879	'the number of numeric grid points.'
1880	CALL message( 'aerosol_init', 'PA0609', 1, 2, 0, 6, 0 )
1881	ENDIF
1882	!
1883	!-- Read vertical profiles of gases:
1884	CALL get_variable( id_dyn, 'init_atmosphere_h2so4', salsa_gas(1)%init(nzb+1:nzt) )
1885	CALL get_variable( id_dyn, 'init_atmosphere_hno3', salsa_gas(2)%init(nzb+1:nzt) )
1886	CALL get_variable( id_dyn, 'init_atmosphere_nh3', salsa_gas(3)%init(nzb+1:nzt) )
1887	CALL get_variable( id_dyn, 'init_atmosphere_ocnv', salsa_gas(4)%init(nzb+1:nzt) )
1888	CALL get_variable( id_dyn, 'init_atmosphere_ocsv', salsa_gas(5)%init(nzb+1:nzt) )
1889	!
1890	!-- Set Neumann top and surface boundary condition for initial + initialise concentrations
1891	DO ig = 1, ngases_salsa
1892	salsa_gas(ig)%init(nzb) = salsa_gas(ig)%init(nzb+1)
1893	salsa_gas(ig)%init(nzt+1) = salsa_gas(ig)%init(nzt)
1894	DO k = nzb, nzt+1
1895	salsa_gas(ig)%conc(k,:,:) = salsa_gas(ig)%init(k)
1896	ENDDO
1897	ENDDO
1898
1899	ELSEIF ( .NOT. netcdf_extend .AND. .NOT. salsa_gases_from_chem ) THEN
1900	message_string = 'Input file '// TRIM( input_file_dynamic ) // TRIM( coupling_char ) // &
1901	' for SALSA missing!'
1902	CALL message( 'salsa_mod: aerosol_init', 'PA0610', 1, 2, 0, 6, 0 )
1903	ENDIF ! netcdf_extend
1904	#else
1905	message_string = 'init_gases_type = 1 but preprocessor directive __netcdf is not used in '//&
1906	'compiling!'
1907	CALL message( 'salsa_mod: aerosol_init', 'PA0611', 1, 2, 0, 6, 0 )
1908
1909	#endif
1910
1911	ENDIF
1912	!
1913	!-- Both SO4 and OC are included, so use the given mass fractions
1914	IF ( index_oc > 0 .AND. index_so4 > 0 ) THEN
1915	pmfoc1a(:) = pmf2a(:,2) / ( pmf2a(:,2) + pmf2a(:,1) ) ! Normalize
1916	!
1917	!-- Pure organic carbon
1918	ELSEIF ( index_oc > 0 ) THEN
1919	pmfoc1a(:) = 1.0_wp
1920	!
1921	!-- Pure SO4
1922	ELSEIF ( index_so4 > 0 ) THEN
1923	pmfoc1a(:) = 0.0_wp
1924
1925	ELSE
1926	message_string = 'Either OC or SO4 must be active for aerosol region 1a!'
1927	CALL message( 'salsa_mod: aerosol_init', 'PA0612', 1, 2, 0, 6, 0 )
1928	ENDIF
1929
1930	!
1931	!-- Initialize concentrations
1932	DO i = nxlg, nxrg
1933	DO j = nysg, nyng
1934	DO k = nzb, nzt+1
1935	!
1936	!-- Predetermine flag to mask topography
1937	flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_0(k,j,i), 0 ) )
1938	!
1939	!-- a) Number concentrations
1940	!-- Region 1:
1941	DO ib = start_subrange_1a, end_subrange_1a
1942	aerosol_number(ib)%conc(k,j,i) = pndist(k,ib) * flag
1943	IF ( prunmode == 1 ) THEN
1944	aerosol_number(ib)%init = pndist(:,ib)
1945	ENDIF
1946	ENDDO
1947	!
1948	!-- Region 2:
1949	IF ( nreg > 1 ) THEN
1950	DO ib = start_subrange_2a, end_subrange_2a
1951	aerosol_number(ib)%conc(k,j,i) = MAX( 0.0_wp, pnf2a(k) ) * pndist(k,ib) * flag
1952	IF ( prunmode == 1 ) THEN
1953	aerosol_number(ib)%init = MAX( 0.0_wp, nf2a ) * pndist(:,ib)
1954	ENDIF
1955	ENDDO
1956	IF ( .NOT. no_insoluble ) THEN
1957	DO ib = start_subrange_2b, end_subrange_2b
1958	IF ( pnf2a(k) < 1.0_wp ) THEN
1959	aerosol_number(ib)%conc(k,j,i) = MAX( 0.0_wp, 1.0_wp - pnf2a(k) ) * &
1960	pndist(k,ib) * flag
1961	IF ( prunmode == 1 ) THEN
1962	aerosol_number(ib)%init = MAX( 0.0_wp, 1.0_wp - nf2a ) * pndist(:,ib)
1963	ENDIF
1964	ENDIF
1965	ENDDO
1966	ENDIF
1967	ENDIF
1968	!
1969	!-- b) Aerosol mass concentrations
1970	!-- bin subrange 1: done here separately due to the SO4/OC convention
1971	!
1972	!-- SO4:
1973	IF ( index_so4 > 0 ) THEN
1974	ss = ( index_so4 - 1 ) * nbins_aerosol + start_subrange_1a !< start
1975	ee = ( index_so4 - 1 ) * nbins_aerosol + end_subrange_1a !< end
1976	ib = start_subrange_1a
1977	DO ic = ss, ee
1978	aerosol_mass(ic)%conc(k,j,i) = MAX( 0.0_wp, 1.0_wp - pmfoc1a(k) ) * pndist(k,ib)&
1979	* core(ib) * arhoh2so4 * flag
1980	IF ( prunmode == 1 ) THEN
1981	aerosol_mass(ic)%init(k) = MAX( 0.0_wp, 1.0_wp - pmfoc1a(k) ) * pndist(k,ib) &
1982	* core(ib) * arhoh2so4
1983	ENDIF
1984	ib = ib+1
1985	ENDDO
1986	ENDIF
1987	!
1988	!-- OC:
1989	IF ( index_oc > 0 ) THEN
1990	ss = ( index_oc - 1 ) * nbins_aerosol + start_subrange_1a !< start
1991	ee = ( index_oc - 1 ) * nbins_aerosol + end_subrange_1a !< end
1992	ib = start_subrange_1a
1993	DO ic = ss, ee
1994	aerosol_mass(ic)%conc(k,j,i) = MAX( 0.0_wp, pmfoc1a(k) ) * pndist(k,ib) * &
1995	core(ib) * arhooc * flag
1996	IF ( prunmode == 1 ) THEN
1997	aerosol_mass(ic)%init(k) = MAX( 0.0_wp, pmfoc1a(k) ) * pndist(k,ib) * &
1998	core(ib) * arhooc
1999	ENDIF
2000	ib = ib+1
2001	ENDDO
2002	ENDIF
2003	ENDDO !< k
2004
2005	prunmode = 3 ! Init only once
2006
2007	ENDDO !< j
2008	ENDDO !< i
2009
2010	!
2011	!-- c) Aerosol mass concentrations
2012	!-- bin subrange 2:
2013	IF ( nreg > 1 ) THEN
2014
2015	IF ( index_so4 > 0 ) THEN
2016	CALL set_aero_mass( index_so4, pmf2a(:,1), pmf2b(:,1), pnf2a, pndist, core, arhoh2so4 )
2017	ENDIF
2018	IF ( index_oc > 0 ) THEN
2019	CALL set_aero_mass( index_oc, pmf2a(:,2), pmf2b(:,2), pnf2a, pndist, core, arhooc )
2020	ENDIF
2021	IF ( index_bc > 0 ) THEN
2022	CALL set_aero_mass( index_bc, pmf2a(:,3), pmf2b(:,3), pnf2a, pndist, core, arhobc )
2023	ENDIF
2024	IF ( index_du > 0 ) THEN
2025	CALL set_aero_mass( index_du, pmf2a(:,4), pmf2b(:,4), pnf2a, pndist, core, arhodu )
2026	ENDIF
2027	IF ( index_ss > 0 ) THEN
2028	CALL set_aero_mass( index_ss, pmf2a(:,5), pmf2b(:,5), pnf2a, pndist, core, arhoss )
2029	ENDIF
2030	IF ( index_no > 0 ) THEN
2031	CALL set_aero_mass( index_no, pmf2a(:,6), pmf2b(:,6), pnf2a, pndist, core, arhohno3 )
2032	ENDIF
2033	IF ( index_nh > 0 ) THEN
2034	CALL set_aero_mass( index_nh, pmf2a(:,7), pmf2b(:,7), pnf2a, pndist, core, arhonh3 )
2035	ENDIF
2036
2037	ENDIF
2038
2039	END SUBROUTINE aerosol_init
2040
2041	!------------------------------------------------------------------------------!
2042	! Description:
2043	! ------------
2044	!> Create a lognormal size distribution and discretise to a sectional
2045	!> representation.
2046	!------------------------------------------------------------------------------!
2047	SUBROUTINE size_distribution( in_ntot, in_dpg, in_sigma, psd_sect )
2048
2049	IMPLICIT NONE
2050
2051	INTEGER(iwp) :: ib !< running index: bin
2052	INTEGER(iwp) :: iteration !< running index: iteration
2053
2054	REAL(wp) :: d1 !< particle diameter (m, dummy)
2055	REAL(wp) :: d2 !< particle diameter (m, dummy)
2056	REAL(wp) :: delta_d !< (d2-d1)/10
2057	REAL(wp) :: deltadp !< bin width
2058	REAL(wp) :: dmidi !< ( d1 + d2 ) / 2
2059
2060	REAL(wp), DIMENSION(:), INTENT(in) :: in_dpg !< geometric mean diameter (m)
2061	REAL(wp), DIMENSION(:), INTENT(in) :: in_ntot !< number conc. (#/m3)
2062	REAL(wp), DIMENSION(:), INTENT(in) :: in_sigma !< standard deviation
2063
2064	REAL(wp), DIMENSION(:), INTENT(inout) :: psd_sect !< sectional size distribution
2065
2066	DO ib = start_subrange_1a, end_subrange_2b
2067	psd_sect(ib) = 0.0_wp
2068	!
2069	!-- Particle diameter at the low limit (largest in the bin) (m)
2070	d1 = ( aero(ib)%vlolim / api6 )**0.33333333_wp
2071	!
2072	!-- Particle diameter at the high limit (smallest in the bin) (m)
2073	d2 = ( aero(ib)%vhilim / api6 )**0.33333333_wp
2074	!
2075	!-- Span of particle diameter in a bin (m)
2076	delta_d = 0.1_wp * ( d2 - d1 )
2077	!
2078	!-- Iterate:
2079	DO iteration = 1, 10
2080	d1 = ( aero(ib)%vlolim / api6 )*0.33333333_wp + ( ib - 1) delta_d
2081	d2 = d1 + delta_d
2082	dmidi = 0.5_wp * ( d1 + d2 )
2083	deltadp = LOG10( d2 / d1 )
2084	!
2085	!-- Size distribution
2086	!-- in_ntot = total number, total area, or total volume concentration
2087	!-- in_dpg = geometric-mean number, area, or volume diameter
2088	!-- n(k) = number, area, or volume concentration in a bin
2089	psd_sect(ib) = psd_sect(ib) + SUM( in_ntot * deltadp / ( SQRT( 2.0_wp * pi ) * &
2090	LOG10( in_sigma ) ) * EXP( -LOG10( dmidi / in_dpg )**2.0_wp / &
2091	( 2.0_wp * LOG10( in_sigma ) ** 2.0_wp ) ) )
2092
2093	ENDDO
2094	ENDDO
2095
2096	END SUBROUTINE size_distribution
2097
2098	!------------------------------------------------------------------------------!
2099	! Description:
2100	! ------------
2101	!> Sets the mass concentrations to aerosol arrays in 2a and 2b.
2102	!>
2103	!> Tomi Raatikainen, FMI, 29.2.2016
2104	!------------------------------------------------------------------------------!
2105	SUBROUTINE set_aero_mass( ispec, pmf2a, pmf2b, pnf2a, pndist, pcore, prho )
2106
2107	IMPLICIT NONE
2108
2109	INTEGER(iwp) :: ee !< index: end
2110	INTEGER(iwp) :: i !< loop index
2111	INTEGER(iwp) :: ib !< loop index
2112	INTEGER(iwp) :: ic !< loop index
2113	INTEGER(iwp) :: j !< loop index
2114	INTEGER(iwp) :: k !< loop index
2115	INTEGER(iwp) :: prunmode !< 1 = initialise
2116	INTEGER(iwp) :: ss !< index: start
2117
2118	INTEGER(iwp), INTENT(in) :: ispec !< Aerosol species index
2119
2120	REAL(wp) :: flag !< flag to mask topography grid points
2121
2122	REAL(wp), INTENT(in) :: prho !< Aerosol density
2123
2124	REAL(wp), DIMENSION(nbins_aerosol), INTENT(in) :: pcore !< Aerosol bin mid core volume
2125	REAL(wp), DIMENSION(0:nz+1), INTENT(in) :: pnf2a !< Number fraction for 2a
2126	REAL(wp), DIMENSION(0:nz+1), INTENT(in) :: pmf2a !< Mass distributions for a
2127	REAL(wp), DIMENSION(0:nz+1), INTENT(in) :: pmf2b !< and b bins
2128
2129	REAL(wp), DIMENSION(0:nz+1,nbins_aerosol), INTENT(in) :: pndist !< Aerosol size distribution
2130
2131	prunmode = 1
2132
2133	DO i = nxlg, nxrg
2134	DO j = nysg, nyng
2135	DO k = nzb, nzt+1
2136	!
2137	!-- Predetermine flag to mask topography
2138	flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_0(k,j,i), 0 ) )
2139	!
2140	!-- Regime 2a:
2141	ss = ( ispec - 1 ) * nbins_aerosol + start_subrange_2a
2142	ee = ( ispec - 1 ) * nbins_aerosol + end_subrange_2a
2143	ib = start_subrange_2a
2144	DO ic = ss, ee
2145	aerosol_mass(ic)%conc(k,j,i) = MAX( 0.0_wp, pmf2a(k) ) * pnf2a(k) * pndist(k,ib) * &
2146	pcore(ib) * prho * flag
2147	IF ( prunmode == 1 ) THEN
2148	aerosol_mass(ic)%init(k) = MAX( 0.0_wp, pmf2a(k) ) * pnf2a(k) * pndist(k,ib) * &
2149	pcore(ib) * prho
2150	ENDIF
2151	ib = ib + 1
2152	ENDDO
2153	!
2154	!-- Regime 2b:
2155	IF ( .NOT. no_insoluble ) THEN
2156	ss = ( ispec - 1 ) * nbins_aerosol + start_subrange_2b
2157	ee = ( ispec - 1 ) * nbins_aerosol + end_subrange_2b
2158	ib = start_subrange_2a
2159	DO ic = ss, ee
2160	aerosol_mass(ic)%conc(k,j,i) = MAX( 0.0_wp, pmf2b(k) ) * ( 1.0_wp - pnf2a(k) ) *&
2161	pndist(k,ib) * pcore(ib) * prho * flag
2162	IF ( prunmode == 1 ) THEN
2163	aerosol_mass(ic)%init(k) = MAX( 0.0_wp, pmf2b(k) ) * ( 1.0_wp - pnf2a(k) ) * &
2164	pndist(k,ib) * pcore(ib) * prho
2165	ENDIF
2166	ib = ib + 1
2167	ENDDO ! c
2168
2169	ENDIF
2170	ENDDO ! k
2171
2172	prunmode = 3 ! Init only once
2173
2174	ENDDO ! j
2175	ENDDO ! i
2176
2177	END SUBROUTINE set_aero_mass
2178
2179	!------------------------------------------------------------------------------!
2180	! Description:
2181	! ------------
2182	!> Initialise the matching between surface types in LSM and deposition models.
2183	!> Do the matching based on Zhang et al. (2001). Atmos. Environ. 35, 549-560
2184	!> (here referred as Z01).
2185	!------------------------------------------------------------------------------!
2186	SUBROUTINE init_deposition
2187
2188	USE surface_mod, &
2189	ONLY: surf_lsm_h, surf_lsm_v, surf_usm_h, surf_usm_v
2190
2191	IMPLICIT NONE
2192
2193	INTEGER(iwp) :: l !< loop index for vertical surfaces
2194
2195	LOGICAL :: match_lsm !< flag to initilise LSM surfaces (if false, initialise USM surfaces)
2196
2197	IF ( depo_pcm_par == 'zhang2001' ) THEN
2198	depo_pcm_par_num = 1
2199	ELSEIF ( depo_pcm_par == 'petroff2010' ) THEN
2200	depo_pcm_par_num = 2
2201	ENDIF
2202
2203	IF ( depo_surf_par == 'zhang2001' ) THEN
2204	depo_surf_par_num = 1
2205	ELSEIF ( depo_surf_par == 'petroff2010' ) THEN
2206	depo_surf_par_num = 2
2207	ENDIF
2208	!
2209	!-- LSM: Pavement, vegetation and water
2210	IF ( nldepo_surf .AND. land_surface ) THEN
2211	match_lsm = .TRUE.
2212	ALLOCATE( lsm_to_depo_h%match_lupg(1:surf_lsm_h%ns), &
2213	lsm_to_depo_h%match_luvw(1:surf_lsm_h%ns), &
2214	lsm_to_depo_h%match_luww(1:surf_lsm_h%ns) )
2215	lsm_to_depo_h%match_lupg = 0
2216	lsm_to_depo_h%match_luvw = 0
2217	lsm_to_depo_h%match_luww = 0
2218	CALL match_sm_zhang( surf_lsm_h, lsm_to_depo_h%match_lupg, lsm_to_depo_h%match_luvw, &
2219	lsm_to_depo_h%match_luww, match_lsm )
2220	DO l = 0, 3
2221	ALLOCATE( lsm_to_depo_v(l)%match_lupg(1:surf_lsm_v(l)%ns), &
2222	lsm_to_depo_v(l)%match_luvw(1:surf_lsm_v(l)%ns), &
2223	lsm_to_depo_v(l)%match_luww(1:surf_lsm_v(l)%ns) )
2224	lsm_to_depo_v(l)%match_lupg = 0
2225	lsm_to_depo_v(l)%match_luvw = 0
2226	lsm_to_depo_v(l)%match_luww = 0
2227	CALL match_sm_zhang( surf_lsm_v(l), lsm_to_depo_v(l)%match_lupg, &
2228	lsm_to_depo_v(l)%match_luvw, lsm_to_depo_v(l)%match_luww, match_lsm )
2229	ENDDO
2230	ENDIF
2231	!
2232	!-- USM: Green roofs/walls, wall surfaces and windows
2233	IF ( nldepo_surf .AND. urban_surface ) THEN
2234	match_lsm = .FALSE.
2235	ALLOCATE( usm_to_depo_h%match_lupg(1:surf_usm_h%ns), &
2236	usm_to_depo_h%match_luvw(1:surf_usm_h%ns), &
2237	usm_to_depo_h%match_luww(1:surf_usm_h%ns) )
2238	usm_to_depo_h%match_lupg = 0
2239	usm_to_depo_h%match_luvw = 0
2240	usm_to_depo_h%match_luww = 0
2241	CALL match_sm_zhang( surf_usm_h, usm_to_depo_h%match_lupg, usm_to_depo_h%match_luvw, &
2242	usm_to_depo_h%match_luww, match_lsm )
2243	DO l = 0, 3
2244	ALLOCATE( usm_to_depo_v(l)%match_lupg(1:surf_usm_v(l)%ns), &
2245	usm_to_depo_v(l)%match_luvw(1:surf_usm_v(l)%ns), &
2246	usm_to_depo_v(l)%match_luww(1:surf_usm_v(l)%ns) )
2247	usm_to_depo_v(l)%match_lupg = 0
2248	usm_to_depo_v(l)%match_luvw = 0
2249	usm_to_depo_v(l)%match_luww = 0
2250	CALL match_sm_zhang( surf_usm_v(l), usm_to_depo_v(l)%match_lupg, &
2251	usm_to_depo_v(l)%match_luvw, usm_to_depo_v(l)%match_luww, match_lsm )
2252	ENDDO
2253	ENDIF
2254
2255	IF ( nldepo_pcm ) THEN
2256	SELECT CASE ( depo_pcm_type )
2257	CASE ( 'evergreen_needleleaf' )
2258	depo_pcm_type_num = 1
2259	CASE ( 'evergreen_broadleaf' )
2260	depo_pcm_type_num = 2
2261	CASE ( 'deciduous_needleleaf' )
2262	depo_pcm_type_num = 3
2263	CASE ( 'deciduous_broadleaf' )
2264	depo_pcm_type_num = 4
2265	CASE DEFAULT
2266	message_string = 'depo_pcm_type not set correctly.'
2267	CALL message( 'salsa_mod: init_deposition', 'PA0613', 1, 2, 0, 6, 0 )
2268	END SELECT
2269	ENDIF
2270
2271	END SUBROUTINE init_deposition
2272
2273	!------------------------------------------------------------------------------!
2274	! Description:
2275	! ------------
2276	!> Match the surface types in PALM and Zhang et al. 2001 deposition module
2277	!------------------------------------------------------------------------------!
2278	SUBROUTINE match_sm_zhang( surf, match_pav_green, match_veg_wall, match_wat_win, match_lsm )
2279
2280	USE surface_mod, &
2281	ONLY: ind_pav_green, ind_veg_wall, ind_wat_win, surf_type
2282
2283	IMPLICIT NONE
2284
2285	INTEGER(iwp) :: m !< index for surface elements
2286	INTEGER(iwp) :: pav_type_palm !< pavement / green wall type in PALM
2287	INTEGER(iwp) :: veg_type_palm !< vegetation / wall type in PALM
2288	INTEGER(iwp) :: wat_type_palm !< water / window type in PALM
2289
2290	INTEGER(iwp), DIMENSION(:), INTENT(inout) :: match_pav_green !< matching pavement/green walls
2291	INTEGER(iwp), DIMENSION(:), INTENT(inout) :: match_veg_wall !< matching vegetation/walls
2292	INTEGER(iwp), DIMENSION(:), INTENT(inout) :: match_wat_win !< matching water/windows
2293
2294	LOGICAL, INTENT(in) :: match_lsm !< flag to initilise LSM surfaces (if false, initialise USM)
2295
2296	TYPE(surf_type), INTENT(in) :: surf !< respective surface type
2297
2298	DO m = 1, surf%ns
2299	IF ( match_lsm ) THEN
2300	!
2301	!-- Vegetation (LSM):
2302	IF ( surf%frac(ind_veg_wall,m) > 0 ) THEN
2303	veg_type_palm = surf%vegetation_type(m)
2304	SELECT CASE ( veg_type_palm )
2305	CASE ( 0 )
2306	message_string = 'No vegetation type defined.'
2307	CALL message( 'salsa_mod: init_depo_surfaces', 'PA0614', 1, 2, 0, 6, 0 )
2308	CASE ( 1 ) ! bare soil
2309	match_veg_wall(m) = 6 ! grass in Z01
2310	CASE ( 2 ) ! crops, mixed farming
2311	match_veg_wall(m) = 7 ! crops, mixed farming Z01
2312	CASE ( 3 ) ! short grass
2313	match_veg_wall(m) = 6 ! grass in Z01
2314	CASE ( 4 ) ! evergreen needleleaf trees
2315	match_veg_wall(m) = 1 ! evergreen needleleaf trees in Z01
2316	CASE ( 5 ) ! deciduous needleleaf trees
2317	match_veg_wall(m) = 3 ! deciduous needleleaf trees in Z01
2318	CASE ( 6 ) ! evergreen broadleaf trees
2319	match_veg_wall(m) = 2 ! evergreen broadleaf trees in Z01
2320	CASE ( 7 ) ! deciduous broadleaf trees
2321	match_veg_wall(m) = 4 ! deciduous broadleaf trees in Z01
2322	CASE ( 8 ) ! tall grass
2323	match_veg_wall(m) = 6 ! grass in Z01
2324	CASE ( 9 ) ! desert
2325	match_veg_wall(m) = 8 ! desert in Z01
2326	CASE ( 10 ) ! tundra
2327	match_veg_wall(m) = 9 ! tundra in Z01
2328	CASE ( 11 ) ! irrigated crops
2329	match_veg_wall(m) = 7 ! crops, mixed farming Z01
2330	CASE ( 12 ) ! semidesert
2331	match_veg_wall(m) = 8 ! desert in Z01
2332	CASE ( 13 ) ! ice caps and glaciers
2333	match_veg_wall(m) = 12 ! ice cap and glacier in Z01
2334	CASE ( 14 ) ! bogs and marshes
2335	match_veg_wall(m) = 11 ! wetland with plants in Z01
2336	CASE ( 15 ) ! evergreen shrubs
2337	match_veg_wall(m) = 10 ! shrubs and interrupted woodlands in Z01
2338	CASE ( 16 ) ! deciduous shrubs
2339	match_veg_wall(m) = 10 ! shrubs and interrupted woodlands in Z01
2340	CASE ( 17 ) ! mixed forest/woodland
2341	match_veg_wall(m) = 5 ! mixed broadleaf and needleleaf trees in Z01
2342	CASE ( 18 ) ! interrupted forest
2343	match_veg_wall(m) = 10 ! shrubs and interrupted woodlands in Z01
2344	END SELECT
2345	ENDIF
2346	!
2347	!-- Pavement (LSM):
2348	IF ( surf%frac(ind_pav_green,m) > 0 ) THEN
2349	pav_type_palm = surf%pavement_type(m)
2350	IF ( pav_type_palm == 0 ) THEN ! error
2351	message_string = 'No pavement type defined.'
2352	CALL message( 'salsa_mod: match_sm_zhang', 'PA0615', 1, 2, 0, 6, 0 )
2353	ELSE
2354	match_pav_green(m) = 15 ! urban in Z01
2355	ENDIF
2356	ENDIF
2357	!
2358	!-- Water (LSM):
2359	IF ( surf%frac(ind_wat_win,m) > 0 ) THEN
2360	wat_type_palm = surf%water_type(m)
2361	IF ( wat_type_palm == 0 ) THEN ! error
2362	message_string = 'No water type defined.'
2363	CALL message( 'salsa_mod: match_sm_zhang', 'PA0616', 1, 2, 0, 6, 0 )
2364	ELSEIF ( wat_type_palm == 3 ) THEN
2365	match_wat_win(m) = 14 ! ocean in Z01
2366	ELSEIF ( wat_type_palm == 1 .OR. wat_type_palm == 2 .OR. wat_type_palm == 4 &
2367	.OR. wat_type_palm == 5 ) THEN
2368	match_wat_win(m) = 13 ! inland water in Z01
2369	ENDIF
2370	ENDIF
2371	ELSE
2372	!
2373	!-- Wall surfaces (USM):
2374	IF ( surf%frac(ind_veg_wall,m) > 0 ) THEN
2375	match_veg_wall(m) = 15 ! urban in Z01
2376	ENDIF
2377	!
2378	!-- Green walls and roofs (USM):
2379	IF ( surf%frac(ind_pav_green,m) > 0 ) THEN
2380	match_pav_green(m) = 6 ! (short) grass in Z01
2381	ENDIF
2382	!
2383	!-- Windows (USM):
2384	IF ( surf%frac(ind_wat_win,m) > 0 ) THEN
2385	match_wat_win(m) = 15 ! urban in Z01
2386	ENDIF
2387	ENDIF
2388
2389	ENDDO
2390
2391	END SUBROUTINE match_sm_zhang
2392
2393	!------------------------------------------------------------------------------!
2394	! Description:
2395	! ------------
2396	!> Swapping of timelevels
2397	!------------------------------------------------------------------------------!
2398	SUBROUTINE salsa_swap_timelevel( mod_count )
2399
2400	IMPLICIT NONE
2401
2402	INTEGER(iwp) :: ib !<
2403	INTEGER(iwp) :: ic !<
2404	INTEGER(iwp) :: icc !<
2405	INTEGER(iwp) :: ig !<
2406
2407	INTEGER(iwp), INTENT(IN) :: mod_count !<
2408
2409	IF ( time_since_reference_point >= skip_time_do_salsa ) THEN
2410
2411	SELECT CASE ( mod_count )
2412
2413	CASE ( 0 )
2414
2415	DO ib = 1, nbins_aerosol
2416	aerosol_number(ib)%conc(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => nconc_1(:,:,:,ib)
2417	aerosol_number(ib)%conc_p(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => nconc_2(:,:,:,ib)
2418
2419	DO ic = 1, ncomponents_mass
2420	icc = ( ic-1 ) * nbins_aerosol + ib
2421	aerosol_mass(icc)%conc(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => mconc_1(:,:,:,icc)
2422	aerosol_mass(icc)%conc_p(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => mconc_2(:,:,:,icc)
2423	ENDDO
2424	ENDDO
2425
2426	IF ( .NOT. salsa_gases_from_chem ) THEN
2427	DO ig = 1, ngases_salsa
2428	salsa_gas(ig)%conc(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => gconc_1(:,:,:,ig)
2429	salsa_gas(ig)%conc_p(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => gconc_2(:,:,:,ig)
2430	ENDDO
2431	ENDIF
2432
2433	CASE ( 1 )
2434
2435	DO ib = 1, nbins_aerosol
2436	aerosol_number(ib)%conc(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => nconc_2(:,:,:,ib)
2437	aerosol_number(ib)%conc_p(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => nconc_1(:,:,:,ib)
2438	DO ic = 1, ncomponents_mass
2439	icc = ( ic-1 ) * nbins_aerosol + ib
2440	aerosol_mass(icc)%conc(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => mconc_2(:,:,:,icc)
2441	aerosol_mass(icc)%conc_p(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => mconc_1(:,:,:,icc)
2442	ENDDO
2443	ENDDO
2444
2445	IF ( .NOT. salsa_gases_from_chem ) THEN
2446	DO ig = 1, ngases_salsa
2447	salsa_gas(ig)%conc(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => gconc_2(:,:,:,ig)
2448	salsa_gas(ig)%conc_p(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => gconc_1(:,:,:,ig)
2449	ENDDO
2450	ENDIF
2451
2452	END SELECT
2453
2454	ENDIF
2455
2456	END SUBROUTINE salsa_swap_timelevel
2457
2458
2459	!------------------------------------------------------------------------------!
2460	! Description:
2461	! ------------
2462	!> This routine reads the respective restart data.
2463	!------------------------------------------------------------------------------!
2464	SUBROUTINE salsa_rrd_local( k, nxlf, nxlc, nxl_on_file, nxrf, nxrc, nxr_on_file, nynf, nync, &
2465	nyn_on_file, nysf, nysc, nys_on_file, tmp_3d, found )
2466
2467	IMPLICIT NONE
2468
2469	INTEGER(iwp) :: ib !<
2470	INTEGER(iwp) :: ic !<
2471	INTEGER(iwp) :: ig !<
2472	INTEGER(iwp) :: k !<
2473	INTEGER(iwp) :: nxlc !<
2474	INTEGER(iwp) :: nxlf !<
2475	INTEGER(iwp) :: nxl_on_file !<
2476	INTEGER(iwp) :: nxrc !<
2477	INTEGER(iwp) :: nxrf !<
2478	INTEGER(iwp) :: nxr_on_file !<
2479	INTEGER(iwp) :: nync !<
2480	INTEGER(iwp) :: nynf !<
2481	INTEGER(iwp) :: nyn_on_file !<
2482	INTEGER(iwp) :: nysc !<
2483	INTEGER(iwp) :: nysf !<
2484	INTEGER(iwp) :: nys_on_file !<
2485
2486	LOGICAL, INTENT(OUT) :: found !<
2487
2488	REAL(wp), &
2489	DIMENSION(nzb:nzt+1,nys_on_file-nbgp:nyn_on_file+nbgp,nxl_on_file-nbgp:nxr_on_file+nbgp) :: tmp_3d !<
2490
2491	found = .FALSE.
2492
2493	IF ( read_restart_data_salsa ) THEN
2494
2495	SELECT CASE ( restart_string(1:length) )
2496
2497	CASE ( 'aerosol_number' )
2498	DO ib = 1, nbins_aerosol
2499	IF ( k == 1 ) READ ( 13 ) tmp_3d
2500	aerosol_number(ib)%conc(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) = &
2501	tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
2502	found = .TRUE.
2503	ENDDO
2504
2505	CASE ( 'aerosol_mass' )
2506	DO ic = 1, ncomponents_mass * nbins_aerosol
2507	IF ( k == 1 ) READ ( 13 ) tmp_3d
2508	aerosol_mass(ic)%conc(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) = &
2509	tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
2510	found = .TRUE.
2511	ENDDO
2512
2513	CASE ( 'salsa_gas' )
2514	DO ig = 1, ngases_salsa
2515	IF ( k == 1 ) READ ( 13 ) tmp_3d
2516	salsa_gas(ig)%conc(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) = &
2517	tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
2518	found = .TRUE.
2519	ENDDO
2520
2521	CASE DEFAULT
2522	found = .FALSE.
2523
2524	END SELECT
2525	ENDIF
2526
2527	END SUBROUTINE salsa_rrd_local
2528
2529	!------------------------------------------------------------------------------!
2530	! Description:
2531	! ------------
2532	!> This routine writes the respective restart data.
2533	!> Note that the following input variables in PARIN have to be equal between
2534	!> restart runs:
2535	!> listspec, nbin, nbin2, nf2a, ncc, mass_fracs_a, mass_fracs_b
2536	!------------------------------------------------------------------------------!
2537	SUBROUTINE salsa_wrd_local
2538
2539	IMPLICIT NONE
2540
2541	INTEGER(iwp) :: ib !<
2542	INTEGER(iwp) :: ic !<
2543	INTEGER(iwp) :: ig !<
2544
2545	IF ( write_binary .AND. write_binary_salsa ) THEN
2546
2547	CALL wrd_write_string( 'aerosol_number' )
2548	DO ib = 1, nbins_aerosol
2549	WRITE ( 14 ) aerosol_number(ib)%conc
2550	ENDDO
2551
2552	CALL wrd_write_string( 'aerosol_mass' )
2553	DO ic = 1, nbins_aerosol * ncomponents_mass
2554	WRITE ( 14 ) aerosol_mass(ic)%conc
2555	ENDDO
2556
2557	CALL wrd_write_string( 'salsa_gas' )
2558	DO ig = 1, ngases_salsa
2559	WRITE ( 14 ) salsa_gas(ig)%conc
2560	ENDDO
2561
2562	ENDIF
2563
2564	END SUBROUTINE salsa_wrd_local
2565
2566	!------------------------------------------------------------------------------!
2567	! Description:
2568	! ------------
2569	!> Performs necessary unit and dimension conversion between the host model and
2570	!> SALSA module, and calls the main SALSA routine.
2571	!> Partially adobted form the original SALSA boxmodel version.
2572	!> Now takes masses in as kg/kg from LES!! Converted to m3/m3 for SALSA
2573	!> 05/2016 Juha: This routine is still pretty much in its original shape.
2574	!> It's dumb as a mule and twice as ugly, so implementation of
2575	!> an improved solution is necessary sooner or later.
2576	!> Juha Tonttila, FMI, 2014
2577	!> Jaakko Ahola, FMI, 2016
2578	!> Only aerosol processes included, Mona Kurppa, UHel, 2017
2579	!------------------------------------------------------------------------------!
2580	SUBROUTINE salsa_driver( i, j, prunmode )
2581
2582	USE arrays_3d, &
2583	ONLY: pt_p, q_p, u, v, w
2584
2585	USE plant_canopy_model_mod, &
2586	ONLY: lad_s
2587
2588	USE surface_mod, &
2589	ONLY: surf_def_h, surf_def_v, surf_lsm_h, surf_lsm_v, surf_usm_h, surf_usm_v
2590
2591	IMPLICIT NONE
2592
2593	INTEGER(iwp) :: endi !< end index
2594	INTEGER(iwp) :: ib !< loop index
2595	INTEGER(iwp) :: ic !< loop index
2596	INTEGER(iwp) :: ig !< loop index
2597	INTEGER(iwp) :: k_wall !< vertical index of topography top
2598	INTEGER(iwp) :: k !< loop index
2599	INTEGER(iwp) :: l !< loop index
2600	INTEGER(iwp) :: nc_h2o !< index of H2O in the prtcl index table
2601	INTEGER(iwp) :: ss !< loop index
2602	INTEGER(iwp) :: str !< start index
2603	INTEGER(iwp) :: vc !< default index in prtcl
2604
2605	INTEGER(iwp), INTENT(in) :: i !< loop index
2606	INTEGER(iwp), INTENT(in) :: j !< loop index
2607	INTEGER(iwp), INTENT(in) :: prunmode !< 1: Initialization, 2: Spinup, 3: Regular runtime
2608
2609	REAL(wp) :: cw_old !< previous H2O mixing ratio
2610	REAL(wp) :: flag !< flag to mask topography grid points
2611	REAL(wp) :: in_lad !< leaf area density (m2/m3)
2612	REAL(wp) :: in_rh !< relative humidity
2613	REAL(wp) :: zgso4 !< SO4
2614	REAL(wp) :: zghno3 !< HNO3
2615	REAL(wp) :: zgnh3 !< NH3
2616	REAL(wp) :: zgocnv !< non-volatile OC
2617	REAL(wp) :: zgocsv !< semi-volatile OC
2618
2619	REAL(wp), DIMENSION(nzb:nzt+1) :: in_adn !< air density (kg/m3)
2620	REAL(wp), DIMENSION(nzb:nzt+1) :: in_cs !< H2O sat. vapour conc.
2621	REAL(wp), DIMENSION(nzb:nzt+1) :: in_cw !< H2O vapour concentration
2622	REAL(wp), DIMENSION(nzb:nzt+1) :: in_p !< pressure (Pa)
2623	REAL(wp), DIMENSION(nzb:nzt+1) :: in_t !< temperature (K)
2624	REAL(wp), DIMENSION(nzb:nzt+1) :: in_u !< wind magnitude (m/s)
2625	REAL(wp), DIMENSION(nzb:nzt+1) :: kvis !< kinematic viscosity of air(m2/s)
2626	REAL(wp), DIMENSION(nzb:nzt+1) :: ppm_to_nconc !< Conversion factor from ppm to #/m3
2627
2628	REAL(wp), DIMENSION(nzb:nzt+1,nbins_aerosol) :: schmidt_num !< particle Schmidt number
2629	REAL(wp), DIMENSION(nzb:nzt+1,nbins_aerosol) :: vd !< particle fall seed (m/s)
2630
2631	TYPE(t_section), DIMENSION(nbins_aerosol) :: lo_aero !< additional variable for OpenMP
2632	TYPE(t_section), DIMENSION(nbins_aerosol) :: aero_old !< helper array
2633
2634	aero_old(:)%numc = 0.0_wp
2635	in_lad = 0.0_wp
2636	in_u = 0.0_wp
2637	kvis = 0.0_wp
2638	lo_aero = aero
2639	schmidt_num = 0.0_wp
2640	vd = 0.0_wp
2641	zgso4 = nclim
2642	zghno3 = nclim
2643	zgnh3 = nclim
2644	zgocnv = nclim
2645	zgocsv = nclim
2646	!
2647	!-- Aerosol number is always set, but mass can be uninitialized
2648	DO ib = 1, nbins_aerosol
2649	lo_aero(ib)%volc(:) = 0.0_wp
2650	aero_old(ib)%volc(:) = 0.0_wp
2651	ENDDO
2652	!
2653	!-- Set the salsa runtime config (How to make this more efficient?)
2654	CALL set_salsa_runtime( prunmode )
2655	!
2656	!-- Calculate thermodynamic quantities needed in SALSA
2657	CALL salsa_thrm_ij( i, j, p_ij=in_p, temp_ij=in_t, cw_ij=in_cw, cs_ij=in_cs, adn_ij=in_adn )
2658	!
2659	!-- Magnitude of wind: needed for deposition
2660	IF ( lsdepo ) THEN
2661	in_u(nzb+1:nzt) = SQRT( ( 0.5_wp * ( u(nzb+1:nzt,j,i) + u(nzb+1:nzt,j,i+1) ) )**2 + &
2662	( 0.5_wp * ( v(nzb+1:nzt,j,i) + v(nzb+1:nzt,j+1,i) ) )**2 + &
2663	( 0.5_wp * ( w(nzb:nzt-1,j,i) + w(nzb+1:nzt,j, i) ) )**2 )
2664	ENDIF
2665	!
2666	!-- Calculate conversion factors for gas concentrations
2667	ppm_to_nconc(:) = for_ppm_to_nconc * in_p(:) / in_t(:)
2668	!
2669	!-- Determine topography-top index on scalar grid
2670	k_wall = k_topo_top(j,i)
2671
2672	DO k = nzb+1, nzt
2673	!
2674	!-- Predetermine flag to mask topography
2675	flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_0(k,j,i), 0 ) )
2676	!
2677	!-- Wind velocity for dry depositon on vegetation
2678	IF ( lsdepo_pcm .AND. plant_canopy ) THEN
2679	in_lad = lad_s( MAX( k-k_wall,0 ),j,i)
2680	ENDIF
2681	!
2682	!-- For initialization and spinup, limit the RH with the parameter rhlim
2683	IF ( prunmode < 3 ) THEN
2684	in_cw(k) = MIN( in_cw(k), in_cs(k) * rhlim )
2685	ELSE
2686	in_cw(k) = in_cw(k)
2687	ENDIF
2688	cw_old = in_cw(k) !* in_adn(k)
2689	!
2690	!-- Set volume concentrations:
2691	!-- Sulphate (SO4) or sulphuric acid H2SO4
2692	IF ( index_so4 > 0 ) THEN
2693	vc = 1
2694	str = ( index_so4-1 ) * nbins_aerosol + 1 ! start index
2695	endi = index_so4 * nbins_aerosol ! end index
2696	ic = 1
2697	DO ss = str, endi
2698	lo_aero(ic)%volc(vc) = aerosol_mass(ss)%conc(k,j,i) / arhoh2so4
2699	ic = ic+1
2700	ENDDO
2701	aero_old(1:nbins_aerosol)%volc(vc) = lo_aero(1:nbins_aerosol)%volc(vc)
2702	ENDIF
2703	!
2704	!-- Organic carbon (OC) compounds
2705	IF ( index_oc > 0 ) THEN
2706	vc = 2
2707	str = ( index_oc-1 ) * nbins_aerosol + 1
2708	endi = index_oc * nbins_aerosol
2709	ic = 1
2710	DO ss = str, endi
2711	lo_aero(ic)%volc(vc) = aerosol_mass(ss)%conc(k,j,i) / arhooc
2712	ic = ic+1
2713	ENDDO
2714	aero_old(1:nbins_aerosol)%volc(vc) = lo_aero(1:nbins_aerosol)%volc(vc)
2715	ENDIF
2716	!
2717	!-- Black carbon (BC)
2718	IF ( index_bc > 0 ) THEN
2719	vc = 3
2720	str = ( index_bc-1 ) * nbins_aerosol + 1 + end_subrange_1a
2721	endi = index_bc * nbins_aerosol
2722	ic = 1 + end_subrange_1a
2723	DO ss = str, endi
2724	lo_aero(ic)%volc(vc) = aerosol_mass(ss)%conc(k,j,i) / arhobc
2725	ic = ic+1
2726	ENDDO
2727	aero_old(1:nbins_aerosol)%volc(vc) = lo_aero(1:nbins_aerosol)%volc(vc)
2728	ENDIF
2729	!
2730	!-- Dust (DU)
2731	IF ( index_du > 0 ) THEN
2732	vc = 4
2733	str = ( index_du-1 ) * nbins_aerosol + 1 + end_subrange_1a
2734	endi = index_du * nbins_aerosol
2735	ic = 1 + end_subrange_1a
2736	DO ss = str, endi
2737	lo_aero(ic)%volc(vc) = aerosol_mass(ss)%conc(k,j,i) / arhodu
2738	ic = ic+1
2739	ENDDO
2740	aero_old(1:nbins_aerosol)%volc(vc) = lo_aero(1:nbins_aerosol)%volc(vc)
2741	ENDIF
2742	!
2743	!-- Sea salt (SS)
2744	IF ( index_ss > 0 ) THEN
2745	vc = 5
2746	str = ( index_ss-1 ) * nbins_aerosol + 1 + end_subrange_1a
2747	endi = index_ss * nbins_aerosol
2748	ic = 1 + end_subrange_1a
2749	DO ss = str, endi
2750	lo_aero(ic)%volc(vc) = aerosol_mass(ss)%conc(k,j,i) / arhoss
2751	ic = ic+1
2752	ENDDO
2753	aero_old(1:nbins_aerosol)%volc(vc) = lo_aero(1:nbins_aerosol)%volc(vc)
2754	ENDIF
2755	!
2756	!-- Nitrate (NO(3-)) or nitric acid HNO3
2757	IF ( index_no > 0 ) THEN
2758	vc = 6
2759	str = ( index_no-1 ) * nbins_aerosol + 1
2760	endi = index_no * nbins_aerosol
2761	ic = 1
2762	DO ss = str, endi
2763	lo_aero(ic)%volc(vc) = aerosol_mass(ss)%conc(k,j,i) / arhohno3
2764	ic = ic+1
2765	ENDDO
2766	aero_old(1:nbins_aerosol)%volc(vc) = lo_aero(1:nbins_aerosol)%volc(vc)
2767	ENDIF
2768	!
2769	!-- Ammonium (NH(4+)) or ammonia NH3
2770	IF ( index_nh > 0 ) THEN
2771	vc = 7
2772	str = ( index_nh-1 ) * nbins_aerosol + 1
2773	endi = index_nh * nbins_aerosol
2774	ic = 1
2775	DO ss = str, endi
2776	lo_aero(ic)%volc(vc) = aerosol_mass(ss)%conc(k,j,i) / arhonh3
2777	ic = ic+1
2778	ENDDO
2779	aero_old(1:nbins_aerosol)%volc(vc) = lo_aero(1:nbins_aerosol)%volc(vc)
2780	ENDIF
2781	!
2782	!-- Water (always used)
2783	nc_h2o = get_index( prtcl,'H2O' )
2784	vc = 8
2785	str = ( nc_h2o-1 ) * nbins_aerosol + 1
2786	endi = nc_h2o * nbins_aerosol
2787	ic = 1
2788	IF ( advect_particle_water ) THEN
2789	DO ss = str, endi
2790	lo_aero(ic)%volc(vc) = aerosol_mass(ss)%conc(k,j,i) / arhoh2o
2791	ic = ic+1
2792	ENDDO
2793	ELSE
2794	lo_aero(1:nbins_aerosol)%volc(vc) = mclim
2795	ENDIF
2796	aero_old(1:nbins_aerosol)%volc(vc) = lo_aero(1:nbins_aerosol)%volc(vc)
2797	!
2798	!-- Number concentrations (numc) and particle sizes
2799	!-- (dwet = wet diameter, core = dry volume)
2800	DO ib = 1, nbins_aerosol
2801	lo_aero(ib)%numc = aerosol_number(ib)%conc(k,j,i)
2802	aero_old(ib)%numc = lo_aero(ib)%numc
2803	IF ( lo_aero(ib)%numc > nclim ) THEN
2804	lo_aero(ib)%dwet = ( SUM( lo_aero(ib)%volc(:) ) / lo_aero(ib)%numc / api6 )**0.33333333_wp
2805	lo_aero(ib)%core = SUM( lo_aero(ib)%volc(1:7) ) / lo_aero(ib)%numc
2806	ELSE
2807	lo_aero(ib)%dwet = lo_aero(ib)%dmid
2808	lo_aero(ib)%core = api6 * ( lo_aero(ib)%dwet )**3
2809	ENDIF
2810	ENDDO
2811	!
2812	!-- On EACH call of salsa_driver, calculate the ambient sizes of
2813	!-- particles by equilibrating soluble fraction of particles with water
2814	!-- using the ZSR method.
2815	in_rh = in_cw(k) / in_cs(k)
2816	IF ( prunmode==1 .OR. .NOT. advect_particle_water ) THEN
2817	CALL equilibration( in_rh, in_t(k), lo_aero, .TRUE. )
2818	ENDIF
2819	!
2820	!-- Gaseous tracer concentrations in #/m3
2821	IF ( salsa_gases_from_chem ) THEN
2822	!
2823	!-- Convert concentrations in ppm to #/m3
2824	zgso4 = chem_species(gas_index_chem(1))%conc(k,j,i) * ppm_to_nconc(k)
2825	zghno3 = chem_species(gas_index_chem(2))%conc(k,j,i) * ppm_to_nconc(k)
2826	zgnh3 = chem_species(gas_index_chem(3))%conc(k,j,i) * ppm_to_nconc(k)
2827	zgocnv = chem_species(gas_index_chem(4))%conc(k,j,i) * ppm_to_nconc(k)
2828	zgocsv = chem_species(gas_index_chem(5))%conc(k,j,i) * ppm_to_nconc(k)
2829	ELSE
2830	zgso4 = salsa_gas(1)%conc(k,j,i)
2831	zghno3 = salsa_gas(2)%conc(k,j,i)
2832	zgnh3 = salsa_gas(3)%conc(k,j,i)
2833	zgocnv = salsa_gas(4)%conc(k,j,i)
2834	zgocsv = salsa_gas(5)%conc(k,j,i)
2835	ENDIF
2836	!
2837	!-- Calculate aerosol processes:
2838	!-- *********************************************************************************************
2839	!
2840	!-- Coagulation
2841	IF ( lscoag ) THEN
2842	CALL coagulation( lo_aero, dt_salsa, in_t(k), in_p(k) )
2843	ENDIF
2844	!
2845	!-- Condensation
2846	IF ( lscnd ) THEN
2847	CALL condensation( lo_aero, zgso4, zgocnv, zgocsv, zghno3, zgnh3, in_cw(k), in_cs(k), &
2848	in_t(k), in_p(k), dt_salsa, prtcl )
2849	ENDIF
2850	!
2851	!-- Deposition
2852	IF ( lsdepo ) THEN
2853	CALL deposition( lo_aero, in_t(k), in_adn(k), in_u(k), in_lad, kvis(k), schmidt_num(k,:), &
2854	vd(k,:) )
2855	ENDIF
2856	!
2857	!-- Size distribution bin update
2858	IF ( lsdistupdate ) THEN
2859	CALL distr_update( lo_aero )
2860	ENDIF
2861	!-- *********************************************************************************************
2862
2863	IF ( lsdepo ) sedim_vd(k,j,i,:) = vd(k,:)
2864	!
2865	!-- Calculate changes in concentrations
2866	DO ib = 1, nbins_aerosol
2867	aerosol_number(ib)%conc(k,j,i) = aerosol_number(ib)%conc(k,j,i) + ( lo_aero(ib)%numc - &
2868	aero_old(ib)%numc ) * flag
2869	ENDDO
2870
2871	IF ( index_so4 > 0 ) THEN
2872	vc = 1
2873	str = ( index_so4-1 ) * nbins_aerosol + 1
2874	endi = index_so4 * nbins_aerosol
2875	ic = 1
2876	DO ss = str, endi
2877	aerosol_mass(ss)%conc(k,j,i) = aerosol_mass(ss)%conc(k,j,i) + ( lo_aero(ic)%volc(vc) - &
2878	aero_old(ic)%volc(vc) ) * arhoh2so4 * flag
2879	ic = ic+1
2880	ENDDO
2881	ENDIF
2882
2883	IF ( index_oc > 0 ) THEN
2884	vc = 2
2885	str = ( index_oc-1 ) * nbins_aerosol + 1
2886	endi = index_oc * nbins_aerosol
2887	ic = 1
2888	DO ss = str, endi
2889	aerosol_mass(ss)%conc(k,j,i) = aerosol_mass(ss)%conc(k,j,i) + ( lo_aero(ic)%volc(vc) - &
2890	aero_old(ic)%volc(vc) ) * arhooc * flag
2891	ic = ic+1
2892	ENDDO
2893	ENDIF
2894
2895	IF ( index_bc > 0 ) THEN
2896	vc = 3
2897	str = ( index_bc-1 ) * nbins_aerosol + 1 + end_subrange_1a
2898	endi = index_bc * nbins_aerosol
2899	ic = 1 + end_subrange_1a
2900	DO ss = str, endi
2901	aerosol_mass(ss)%conc(k,j,i) = aerosol_mass(ss)%conc(k,j,i) + ( lo_aero(ic)%volc(vc) - &
2902	aero_old(ic)%volc(vc) ) * arhobc * flag
2903	ic = ic+1
2904	ENDDO
2905	ENDIF
2906
2907	IF ( index_du > 0 ) THEN
2908	vc = 4
2909	str = ( index_du-1 ) * nbins_aerosol + 1 + end_subrange_1a
2910	endi = index_du * nbins_aerosol
2911	ic = 1 + end_subrange_1a
2912	DO ss = str, endi
2913	aerosol_mass(ss)%conc(k,j,i) = aerosol_mass(ss)%conc(k,j,i) + ( lo_aero(ic)%volc(vc) - &
2914	aero_old(ic)%volc(vc) ) * arhodu * flag
2915	ic = ic+1
2916	ENDDO
2917	ENDIF
2918
2919	IF ( index_ss > 0 ) THEN
2920	vc = 5
2921	str = ( index_ss-1 ) * nbins_aerosol + 1 + end_subrange_1a
2922	endi = index_ss * nbins_aerosol
2923	ic = 1 + end_subrange_1a
2924	DO ss = str, endi
2925	aerosol_mass(ss)%conc(k,j,i) = aerosol_mass(ss)%conc(k,j,i) + ( lo_aero(ic)%volc(vc) - &
2926	aero_old(ic)%volc(vc) ) * arhoss * flag
2927	ic = ic+1
2928	ENDDO
2929	ENDIF
2930
2931	IF ( index_no > 0 ) THEN
2932	vc = 6
2933	str = ( index_no-1 ) * nbins_aerosol + 1
2934	endi = index_no * nbins_aerosol
2935	ic = 1
2936	DO ss = str, endi
2937	aerosol_mass(ss)%conc(k,j,i) = aerosol_mass(ss)%conc(k,j,i) + ( lo_aero(ic)%volc(vc) - &
2938	aero_old(ic)%volc(vc) ) * arhohno3 * flag
2939	ic = ic+1
2940	ENDDO
2941	ENDIF
2942
2943	IF ( index_nh > 0 ) THEN
2944	vc = 7
2945	str = ( index_nh-1 ) * nbins_aerosol + 1
2946	endi = index_nh * nbins_aerosol
2947	ic = 1
2948	DO ss = str, endi
2949	aerosol_mass(ss)%conc(k,j,i) = aerosol_mass(ss)%conc(k,j,i) + ( lo_aero(ic)%volc(vc) - &
2950	aero_old(ic)%volc(vc) ) * arhonh3 * flag
2951	ic = ic+1
2952	ENDDO
2953	ENDIF
2954
2955	IF ( advect_particle_water ) THEN
2956	nc_h2o = get_index( prtcl,'H2O' )
2957	vc = 8
2958	str = ( nc_h2o-1 ) * nbins_aerosol + 1
2959	endi = nc_h2o * nbins_aerosol
2960	ic = 1
2961	DO ss = str, endi
2962	aerosol_mass(ss)%conc(k,j,i) = aerosol_mass(ss)%conc(k,j,i) + ( lo_aero(ic)%volc(vc) - &
2963	aero_old(ic)%volc(vc) ) * arhoh2o * flag
2964	IF ( prunmode == 1 ) THEN
2965	aerosol_mass(ss)%init(k) = MAX( aerosol_mass(ss)%init(k), &
2966	aerosol_mass(ss)%conc(k,j,i) )
2967	IF ( k == nzb+1 ) THEN
2968	aerosol_mass(ss)%init(k-1) = 0.0_wp
2969	ELSEIF ( k == nzt ) THEN
2970	aerosol_mass(ss)%init(k+1) = aerosol_mass(ss)%init(k)
2971	ENDIF
2972	ENDIF
2973	ic = ic+1
2974	ENDDO
2975	ENDIF
2976	!
2977	!-- Condensation of precursor gases
2978	IF ( lscndgas ) THEN
2979	IF ( salsa_gases_from_chem ) THEN
2980	!
2981	!-- SO4 (or H2SO4)
2982	ig = gas_index_chem(1)
2983	chem_species(ig)%conc(k,j,i) = chem_species(ig)%conc(k,j,i) + ( zgso4 / &
2984	ppm_to_nconc(k) - chem_species(ig)%conc(k,j,i) ) * flag
2985	!
2986	!-- HNO3
2987	ig = gas_index_chem(2)
2988	chem_species(ig)%conc(k,j,i) = chem_species(ig)%conc(k,j,i) + ( zghno3 / &
2989	ppm_to_nconc(k) - chem_species(ig)%conc(k,j,i) ) * flag
2990	!
2991	!-- NH3
2992	ig = gas_index_chem(3)
2993	chem_species(ig)%conc(k,j,i) = chem_species(ig)%conc(k,j,i) + ( zgnh3 / &
2994	ppm_to_nconc(k) - chem_species(ig)%conc(k,j,i) ) * flag
2995	!
2996	!-- non-volatile OC
2997	ig = gas_index_chem(4)
2998	chem_species(ig)%conc(k,j,i) = chem_species(ig)%conc(k,j,i) + ( zgocnv / &
2999	ppm_to_nconc(k) - chem_species(ig)%conc(k,j,i) ) * flag
3000	!
3001	!-- semi-volatile OC
3002	ig = gas_index_chem(5)
3003	chem_species(ig)%conc(k,j,i) = chem_species(ig)%conc(k,j,i) + ( zgocsv / &
3004	ppm_to_nconc(k) - chem_species(ig)%conc(k,j,i) ) * flag
3005
3006	ELSE
3007	!
3008	!-- SO4 (or H2SO4)
3009	salsa_gas(1)%conc(k,j,i) = salsa_gas(1)%conc(k,j,i) + ( zgso4 - &
3010	salsa_gas(1)%conc(k,j,i) ) * flag
3011	!
3012	!-- HNO3
3013	salsa_gas(2)%conc(k,j,i) = salsa_gas(2)%conc(k,j,i) + ( zghno3 - &
3014	salsa_gas(2)%conc(k,j,i) ) * flag
3015	!
3016	!-- NH3
3017	salsa_gas(3)%conc(k,j,i) = salsa_gas(3)%conc(k,j,i) + ( zgnh3 - &
3018	salsa_gas(3)%conc(k,j,i) ) * flag
3019	!
3020	!-- non-volatile OC
3021	salsa_gas(4)%conc(k,j,i) = salsa_gas(4)%conc(k,j,i) + ( zgocnv - &
3022	salsa_gas(4)%conc(k,j,i) ) * flag
3023	!
3024	!-- semi-volatile OC
3025	salsa_gas(5)%conc(k,j,i) = salsa_gas(5)%conc(k,j,i) + ( zgocsv - &
3026	salsa_gas(5)%conc(k,j,i) ) * flag
3027	ENDIF
3028	ENDIF
3029	!
3030	!-- Tendency of water vapour mixing ratio is obtained from the change in RH during SALSA run.
3031	!-- This releases heat and changes pt. Assumes no temperature change during SALSA run.
3032	!-- q = r / (1+r), Euler method for integration
3033	!
3034	IF ( feedback_to_palm ) THEN
3035	q_p(k,j,i) = q_p(k,j,i) + 1.0_wp / ( in_cw(k) * in_adn(k) + 1.0_wp )*2 &
3036	( in_cw(k) - cw_old ) * in_adn(k) * flag
3037	pt_p(k,j,i) = pt_p(k,j,i) + alv / c_p * ( in_cw(k) - cw_old ) * in_adn(k) / ( in_cw(k) / &
3038	in_adn(k) + 1.0_wp )*2 pt_p(k,j,i) / in_t(k) * flag
3039	ENDIF
3040
3041	ENDDO ! k
3042
3043	!
3044	!-- Set surfaces and wall fluxes due to deposition
3045	IF ( lsdepo .AND. lsdepo_surf .AND. prunmode == 3 ) THEN
3046	IF ( .NOT. land_surface .AND. .NOT. urban_surface ) THEN
3047	CALL depo_surf( i, j, surf_def_h(0), vd, schmidt_num, kvis, in_u, .TRUE. )
3048	DO l = 0, 3
3049	CALL depo_surf( i, j, surf_def_v(l), vd, schmidt_num, kvis, in_u, .FALSE. )
3050	ENDDO
3051	ELSE
3052	CALL depo_surf( i, j, surf_usm_h, vd, schmidt_num, kvis, in_u, .TRUE., usm_to_depo_h )
3053	DO l = 0, 3
3054	CALL depo_surf( i, j, surf_usm_v(l), vd, schmidt_num, kvis, in_u, .FALSE., &
3055	usm_to_depo_v(l) )
3056	ENDDO
3057	CALL depo_surf( i, j, surf_lsm_h, vd, schmidt_num, kvis, in_u, .TRUE., lsm_to_depo_h )
3058	DO l = 0, 3
3059	CALL depo_surf( i, j, surf_lsm_v(l), vd, schmidt_num, kvis, in_u, .FALSE., &
3060	lsm_to_depo_v(l) )
3061	ENDDO
3062	ENDIF
3063	ENDIF
3064
3065	IF ( prunmode < 3 ) THEN
3066	!$OMP MASTER
3067	aero = lo_aero
3068	!$OMP END MASTER
3069	END IF
3070
3071	END SUBROUTINE salsa_driver
3072
3073	!------------------------------------------------------------------------------!
3074	! Description:
3075	! ------------
3076	!> Set logical switches according to the host model state and user-specified
3077	!> NAMELIST options.
3078	!> Juha Tonttila, FMI, 2014
3079	!> Only aerosol processes included, Mona Kurppa, UHel, 2017
3080	!------------------------------------------------------------------------------!
3081	SUBROUTINE set_salsa_runtime( prunmode )
3082
3083	IMPLICIT NONE
3084
3085	INTEGER(iwp), INTENT(in) :: prunmode
3086
3087	SELECT CASE(prunmode)
3088
3089	CASE(1) !< Initialization
3090	lscoag = .FALSE.
3091	lscnd = .FALSE.
3092	lscndgas = .FALSE.
3093	lscndh2oae = .FALSE.
3094	lsdepo = .FALSE.
3095	lsdepo_pcm = .FALSE.
3096	lsdepo_surf = .FALSE.
3097	lsdistupdate = .TRUE.
3098	lspartition = .FALSE.
3099
3100	CASE(2) !< Spinup period
3101	lscoag = ( .FALSE. .AND. nlcoag )
3102	lscnd = ( .TRUE. .AND. nlcnd )
3103	lscndgas = ( .TRUE. .AND. nlcndgas )
3104	lscndh2oae = ( .TRUE. .AND. nlcndh2oae )
3105
3106	CASE(3) !< Run
3107	lscoag = nlcoag
3108	lscnd = nlcnd
3109	lscndgas = nlcndgas
3110	lscndh2oae = nlcndh2oae
3111	lsdepo = nldepo
3112	lsdepo_pcm = nldepo_pcm
3113	lsdepo_surf = nldepo_surf
3114	lsdistupdate = nldistupdate
3115	END SELECT
3116
3117
3118	END SUBROUTINE set_salsa_runtime
3119
3120	!------------------------------------------------------------------------------!
3121	! Description:
3122	! ------------
3123	!> Calculates the absolute temperature (using hydrostatic pressure), saturation
3124	!> vapour pressure and mixing ratio over water, relative humidity and air
3125	!> density needed in the SALSA model.
3126	!> NOTE, no saturation adjustment takes place -> the resulting water vapour
3127	!> mixing ratio can be supersaturated, allowing the microphysical calculations
3128	!> in SALSA.
3129	!
3130	!> Juha Tonttila, FMI, 2014 (original SALSAthrm)
3131	!> Mona Kurppa, UHel, 2017 (adjustment for PALM and only aerosol processes)
3132	!------------------------------------------------------------------------------!
3133	SUBROUTINE salsa_thrm_ij( i, j, p_ij, temp_ij, cw_ij, cs_ij, adn_ij )
3134
3135	USE arrays_3d, &
3136	ONLY: pt, q, zu
3137
3138	USE basic_constants_and_equations_mod, &
3139	ONLY: barometric_formula, exner_function, ideal_gas_law_rho, magnus
3140
3141	USE control_parameters, &
3142	ONLY: pt_surface, surface_pressure
3143
3144	IMPLICIT NONE
3145
3146	INTEGER(iwp), INTENT(in) :: i !<
3147	INTEGER(iwp), INTENT(in) :: j !<
3148
3149	REAL(wp) :: t_surface !< absolute surface temperature (K)
3150
3151	REAL(wp), DIMENSION(nzb:nzt+1) :: e_s !< saturation vapour pressure over water (Pa)
3152
3153	REAL(wp), DIMENSION(:), INTENT(inout) :: adn_ij !< air density (kg/m3)
3154	REAL(wp), DIMENSION(:), INTENT(inout) :: p_ij !< air pressure (Pa)
3155	REAL(wp), DIMENSION(:), INTENT(inout) :: temp_ij !< air temperature (K)
3156
3157	REAL(wp), DIMENSION(:), INTENT(inout), OPTIONAL :: cw_ij !< water vapour concentration (kg/m3)
3158	REAL(wp), DIMENSION(:), INTENT(inout), OPTIONAL :: cs_ij !< saturation water vap. conc.(kg/m3)
3159	!
3160	!-- Pressure p_ijk (Pa) = hydrostatic pressure
3161	t_surface = pt_surface * exner_function( surface_pressure * 100.0_wp )
3162	p_ij(:) = barometric_formula( zu, t_surface, surface_pressure * 100.0_wp )
3163	!
3164	!-- Absolute ambient temperature (K)
3165	temp_ij(:) = pt(:,j,i) * exner_function( p_ij(:) )
3166	!
3167	!-- Air density
3168	adn_ij(:) = ideal_gas_law_rho( p_ij(:), temp_ij(:) )
3169	!
3170	!-- Water vapour concentration r_v (kg/m3)
3171	IF ( PRESENT( cw_ij ) ) THEN
3172	cw_ij(:) = ( q(:,j,i) / ( 1.0_wp - q(:,j,i) ) ) * adn_ij(:)
3173	ENDIF
3174	!
3175	!-- Saturation mixing ratio r_s (kg/kg) from vapour pressure at temp (Pa)
3176	IF ( PRESENT( cs_ij ) ) THEN
3177	e_s(:) = 611.0_wp * EXP( alv_d_rv * ( 3.6609E-3_wp - 1.0_wp / &
3178	temp_ij(:) ) )! magnus( temp_ij(:) )
3179	cs_ij(:) = ( 0.622_wp * e_s / ( p_ij(:) - e_s(:) ) ) * adn_ij(:)
3180	ENDIF
3181
3182	END SUBROUTINE salsa_thrm_ij
3183
3184	!------------------------------------------------------------------------------!
3185	! Description:
3186	! ------------
3187	!> Calculates ambient sizes of particles by equilibrating soluble fraction of
3188	!> particles with water using the ZSR method (Stokes and Robinson, 1966).
3189	!> Method:
3190	!> Following chemical components are assumed water-soluble
3191	!> - (ammonium) sulphate (100%)
3192	!> - sea salt (100 %)
3193	!> - organic carbon (epsoc * 100%)
3194	!> Exact thermodynamic considerations neglected.
3195	!> - If particles contain no sea salt, calculation according to sulphate
3196	!> properties
3197	!> - If contain sea salt but no sulphate, calculation according to sea salt
3198	!> properties
3199	!> - If contain both sulphate and sea salt -> the molar fraction of these
3200	!> compounds determines which one of them is used as the basis of calculation.
3201	!> If sulphate and sea salt coexist in a particle, it is assumed that the Cl is
3202	!> replaced by sulphate; thus only either sulphate + organics or sea salt +
3203	!> organics is included in the calculation of soluble fraction.
3204	!> Molality parameterizations taken from Table 1 of Tang: Thermodynamic and
3205	!> optical properties of mixed-salt aerosols of atmospheric importance,
3206	!> J. Geophys. Res., 102 (D2), 1883-1893 (1997)
3207	!
3208	!> Coded by:
3209	!> Hannele Korhonen (FMI) 2005
3210	!> Harri Kokkola (FMI) 2006
3211	!> Matti Niskanen(FMI) 2012
3212	!> Anton Laakso (FMI) 2013
3213	!> Modified for the new aerosol datatype, Juha Tonttila (FMI) 2014
3214	!
3215	!> fxm: should sea salt form a solid particle when prh is very low (even though
3216	!> it could be mixed with e.g. sulphate)?
3217	!> fxm: crashes if no sulphate or sea salt
3218	!> fxm: do we really need to consider Kelvin effect for subrange 2
3219	!------------------------------------------------------------------------------!
3220	SUBROUTINE equilibration( prh, ptemp, paero, init )
3221
3222	IMPLICIT NONE
3223
3224	INTEGER(iwp) :: ib !< loop index
3225	INTEGER(iwp) :: counti !< loop index
3226
3227	LOGICAL, INTENT(in) :: init !< TRUE: Initialization, FALSE: Normal runtime: update water
3228	!< content only for 1a
3229
3230	REAL(wp) :: zaw !< water activity [0-1]
3231	REAL(wp) :: zcore !< Volume of dry particle
3232	REAL(wp) :: zdold !< Old diameter
3233	REAL(wp) :: zdwet !< Wet diameter or mean droplet diameter
3234	REAL(wp) :: zke !< Kelvin term in the KÃ¶hler equation
3235	REAL(wp) :: zlwc !< liquid water content [kg/m3-air]
3236	REAL(wp) :: zrh !< Relative humidity
3237
3238	REAL(wp), DIMENSION(maxspec) :: zbinmol !< binary molality of each components (mol/kg)
3239	REAL(wp), DIMENSION(maxspec) :: zvpart !< volume of chem. compounds in one particle
3240
3241	REAL(wp), INTENT(in) :: prh !< relative humidity [0-1]
3242	REAL(wp), INTENT(in) :: ptemp !< temperature (K)
3243
3244	TYPE(t_section), DIMENSION(nbins_aerosol), INTENT(inout) :: paero !< aerosol properties
3245
3246	zaw = 0.0_wp
3247	zlwc = 0.0_wp
3248	!
3249	!-- Relative humidity:
3250	zrh = prh
3251	zrh = MAX( zrh, 0.05_wp )
3252	zrh = MIN( zrh, 0.98_wp)
3253	!
3254	!-- 1) Regime 1: sulphate and partly water-soluble OC. Done for every CALL
3255	DO ib = start_subrange_1a, end_subrange_1a ! size bin
3256
3257	zbinmol = 0.0_wp
3258	zdold = 1.0_wp
3259	zke = 1.02_wp
3260
3261	IF ( paero(ib)%numc > nclim ) THEN
3262	!
3263	!-- Volume in one particle
3264	zvpart = 0.0_wp
3265	zvpart(1:2) = paero(ib)%volc(1:2) / paero(ib)%numc
3266	zvpart(6:7) = paero(ib)%volc(6:7) / paero(ib)%numc
3267	!
3268	!-- Total volume and wet diameter of one dry particle
3269	zcore = SUM( zvpart(1:2) )
3270	zdwet = paero(ib)%dwet
3271
3272	counti = 0
3273	DO WHILE ( ABS( zdwet / zdold - 1.0_wp ) > 1.0E-2_wp )
3274
3275	zdold = MAX( zdwet, 1.0E-20_wp )
3276	zaw = MAX( 1.0E-3_wp, zrh / zke ) ! To avoid underflow
3277	!
3278	!-- Binary molalities (mol/kg):
3279	!-- Sulphate
3280	zbinmol(1) = 1.1065495E+2_wp - 3.6759197E+2_wp * zaw + 5.0462934E+2_wp * zaw**2 - &
3281	3.1543839E+2_wp * zaw*3 + 6.770824E+1_wp zaw**4
3282	!-- Organic carbon
3283	zbinmol(2) = 1.0_wp / ( zaw * amh2o ) - 1.0_wp / amh2o
3284	!-- Nitric acid
3285	zbinmol(6) = 2.306844303E+1_wp - 3.563608869E+1_wp * zaw - 6.210577919E+1_wp * zaw**2 &
3286	+ 5.510176187E+2_wp * zaw*3 - 1.460055286E+3_wp zaw**4 &
3287	+ 1.894467542E+3_wp * zaw*5 - 1.220611402E+3_wp zaw**6 &
3288	+ 3.098597737E+2_wp * zaw**7
3289	!
3290	!-- Calculate the liquid water content (kg/m3-air) using ZSR (see e.g. Eq. 10.98 in
3291	!-- Seinfeld and Pandis (2006))
3292	zlwc = ( paero(ib)%volc(1) * ( arhoh2so4 / amh2so4 ) ) / zbinmol(1) + &
3293	epsoc * paero(ib)%volc(2) * ( arhooc / amoc ) / zbinmol(2) + &
3294	( paero(ib)%volc(6) * ( arhohno3/amhno3 ) ) / zbinmol(6)
3295	!
3296	!-- Particle wet diameter (m)
3297	zdwet = ( zlwc / paero(ib)%numc / arhoh2o / api6 + ( SUM( zvpart(6:7) ) / api6 ) + &
3298	zcore / api6 )**0.33333333_wp
3299	!
3300	!-- Kelvin effect (Eq. 10.85 in in Seinfeld and Pandis (2006)). Avoid
3301	!-- overflow.
3302	zke = EXP( MIN( 50.0_wp, 4.0_wp * surfw0 * amvh2so4 / ( abo * ptemp * zdwet ) ) )
3303
3304	counti = counti + 1
3305	IF ( counti > 1000 ) THEN
3306	message_string = 'Subrange 1: no convergence!'
3307	CALL message( 'salsa_mod: equilibration', 'PA0617', 1, 2, 0, 6, 0 )
3308	ENDIF
3309	ENDDO
3310	!
3311	!-- Instead of lwc, use the volume concentration of water from now on
3312	!-- (easy to convert...)
3313	paero(ib)%volc(8) = zlwc / arhoh2o
3314	!
3315	!-- If this is initialization, update the core and wet diameter
3316	IF ( init ) THEN
3317	paero(ib)%dwet = zdwet
3318	paero(ib)%core = zcore
3319	ENDIF
3320
3321	ELSE
3322	!-- If initialization
3323	!-- 1.2) empty bins given bin average values
3324	IF ( init ) THEN
3325	paero(ib)%dwet = paero(ib)%dmid
3326	paero(ib)%core = api6 * paero(ib)%dmid**3
3327	ENDIF
3328
3329	ENDIF
3330
3331	ENDDO ! ib
3332	!
3333	!-- 2) Regime 2a: sulphate, OC, BC and sea salt
3334	!-- This is done only for initialization call, otherwise the water contents
3335	!-- are computed via condensation
3336	IF ( init ) THEN
3337	DO ib = start_subrange_2a, end_subrange_2b
3338	!
3339	!-- Initialize
3340	zke = 1.02_wp
3341	zbinmol = 0.0_wp
3342	zdold = 1.0_wp
3343	!
3344	!-- 1) Particle properties calculated for non-empty bins
3345	IF ( paero(ib)%numc > nclim ) THEN
3346	!
3347	!-- Volume in one particle [fxm]
3348	zvpart = 0.0_wp
3349	zvpart(1:7) = paero(ib)%volc(1:7) / paero(ib)%numc
3350	!
3351	!-- Total volume and wet diameter of one dry particle [fxm]
3352	zcore = SUM( zvpart(1:5) )
3353	zdwet = paero(ib)%dwet
3354
3355	counti = 0
3356	DO WHILE ( ABS( zdwet / zdold - 1.0_wp ) > 1.0E-12_wp )
3357
3358	zdold = MAX( zdwet, 1.0E-20_wp )
3359	zaw = zrh / zke
3360	!
3361	!-- Binary molalities (mol/kg):
3362	!-- Sulphate
3363	zbinmol(1) = 1.1065495E+2_wp - 3.6759197E+2_wp * zaw + 5.0462934E+2_wp * zaw**2 - &
3364	3.1543839E+2_wp * zaw*3 + 6.770824E+1_wp zaw**4
3365	!-- Organic carbon
3366	zbinmol(2) = 1.0_wp / ( zaw * amh2o ) - 1.0_wp / amh2o
3367	!-- Nitric acid
3368	zbinmol(6) = 2.306844303E+1_wp - 3.563608869E+1_wp * zaw - &
3369	6.210577919E+1_wp * zaw*2 + 5.510176187E+2_wp zaw**3 - &
3370	1.460055286E+3_wp * zaw*4 + 1.894467542E+3_wp zaw**5 - &
3371	1.220611402E+3_wp * zaw*6 + 3.098597737E+2_wp zaw**7
3372	!-- Sea salt (natrium chloride)
3373	zbinmol(5) = 5.875248E+1_wp - 1.8781997E+2_wp * zaw + 2.7211377E+2_wp * zaw**2 - &
3374	1.8458287E+2_wp * zaw*3 + 4.153689E+1_wp zaw**4
3375	!
3376	!-- Calculate the liquid water content (kg/m3-air)
3377	zlwc = ( paero(ib)%volc(1) * ( arhoh2so4 / amh2so4 ) ) / zbinmol(1) + &
3378	epsoc * ( paero(ib)%volc(2) * ( arhooc / amoc ) ) / zbinmol(2) + &
3379	( paero(ib)%volc(6) * ( arhohno3 / amhno3 ) ) / zbinmol(6) + &
3380	( paero(ib)%volc(5) * ( arhoss / amss ) ) / zbinmol(5)
3381
3382	!-- Particle wet radius (m)
3383	zdwet = ( zlwc / paero(ib)%numc / arhoh2o / api6 + ( SUM( zvpart(6:7) ) / api6 ) + &
3384	zcore / api6 )**0.33333333_wp
3385	!
3386	!-- Kelvin effect (Eq. 10.85 in Seinfeld and Pandis (2006))
3387	zke = EXP( MIN( 50.0_wp, 4.0_wp * surfw0 * amvh2so4 / ( abo * zdwet * ptemp ) ) )
3388
3389	counti = counti + 1
3390	IF ( counti > 1000 ) THEN
3391	message_string = 'Subrange 2: no convergence!'
3392	CALL message( 'salsa_mod: equilibration', 'PA0618', 1, 2, 0, 6, 0 )
3393	ENDIF
3394	ENDDO
3395	!
3396	!-- Liquid water content; instead of LWC use the volume concentration
3397	paero(ib)%volc(8) = zlwc / arhoh2o
3398	paero(ib)%dwet = zdwet
3399	paero(ib)%core = zcore
3400
3401	ELSE
3402	!-- 2.2) empty bins given bin average values
3403	paero(ib)%dwet = paero(ib)%dmid
3404	paero(ib)%core = api6 * paero(ib)%dmid**3
3405	ENDIF
3406
3407	ENDDO ! ib
3408	ENDIF
3409
3410	END SUBROUTINE equilibration
3411
3412	!------------------------------------------------------------------------------!
3413	!> Description:
3414	!> ------------
3415	!> Calculation of the settling velocity vc (m/s) per aerosol size bin and
3416	!> deposition on plant canopy (lsdepo_pcm).
3417	!
3418	!> Deposition is based on either the scheme presented in:
3419	!> Zhang et al. (2001), Atmos. Environ. 35, 549-560 (includes collection due to
3420	!> Brownian diffusion, impaction, interception and sedimentation; hereafter ZO1)
3421	!> OR
3422	!> Petroff & Zhang (2010), Geosci. Model Dev. 3, 753-769 (includes also
3423	!> collection due to turbulent impaction, hereafter P10)
3424	!
3425	!> Equation numbers refer to equation in Jacobson (2005): Fundamentals of
3426	!> Atmospheric Modeling, 2nd Edition.
3427	!
3428	!> Subroutine follows closely sedim_SALSA in UCLALES-SALSA written by Juha
3429	!> Tonttila (KIT/FMI) and Zubair Maalick (UEF).
3430	!> Rewritten to PALM by Mona Kurppa (UH), 2017.
3431	!
3432	!> Call for grid point i,j,k
3433	!------------------------------------------------------------------------------!
3434
3435	SUBROUTINE deposition( paero, tk, adn, mag_u, lad, kvis, schmidt_num, vc )
3436
3437	USE plant_canopy_model_mod, &
3438	ONLY: cdc
3439
3440	IMPLICIT NONE
3441
3442	INTEGER(iwp) :: ib !< loop index
3443	INTEGER(iwp) :: ic !< loop index
3444
3445	REAL(wp) :: alpha !< parameter, Table 3 in Z01
3446	REAL(wp) :: avis !< molecular viscocity of air (kg/(m*s))
3447	REAL(wp) :: beta_im !< parameter for turbulent impaction
3448	REAL(wp) :: beta !< Cunningham slip-flow correction factor
3449	REAL(wp) :: c_brownian_diff !< coefficient for Brownian diffusion
3450	REAL(wp) :: c_impaction !< coefficient for inertial impaction
3451	REAL(wp) :: c_interception !< coefficient for interception
3452	REAL(wp) :: c_turb_impaction !< coefficient for turbulent impaction
3453	REAL(wp) :: depo !< deposition velocity (m/s)
3454	REAL(wp) :: gamma !< parameter, Table 3 in Z01
3455	REAL(wp) :: Kn !< Knudsen number
3456	REAL(wp) :: lambda !< molecular mean free path (m)
3457	REAL(wp) :: mdiff !< particle diffusivity coefficient
3458	REAL(wp) :: par_a !< parameter A for the characteristic radius of collectors,
3459	!< Table 3 in Z01
3460	REAL(wp) :: par_l !< obstacle characteristic dimension in P10
3461	REAL(wp) :: pdn !< particle density (kg/m3)
3462	REAL(wp) :: ustar !< friction velocity (m/s)
3463	REAL(wp) :: va !< thermal speed of an air molecule (m/s)
3464	REAL(wp) :: zdwet !< wet diameter (m)
3465
3466	REAL(wp), INTENT(in) :: adn !< air density (kg/m3)
3467	REAL(wp), INTENT(in) :: lad !< leaf area density (m2/m3)
3468	REAL(wp), INTENT(in) :: mag_u !< wind velocity (m/s)
3469	REAL(wp), INTENT(in) :: tk !< abs.temperature (K)
3470
3471	REAL(wp), INTENT(inout) :: kvis !< kinematic viscosity of air (m2/s)
3472
3473	REAL(wp), DIMENSION(:), INTENT(inout) :: schmidt_num !< particle Schmidt number
3474	REAL(wp), DIMENSION(:), INTENT(inout) :: vc !< critical fall speed i.e. settling velocity of
3475	!< an aerosol particle (m/s)
3476
3477	TYPE(t_section), DIMENSION(nbins_aerosol), INTENT(inout) :: paero !< aerosol properties
3478	!
3479	!-- Initialise
3480	depo = 0.0_wp
3481	pdn = 1500.0_wp ! default value
3482	ustar = 0.0_wp
3483	!
3484	!-- Molecular viscosity of air (Eq. 4.54)
3485	avis = 1.8325E-5_wp * ( 416.16_wp / ( tk + 120.0_wp ) ) * ( tk / 296.16_wp )**1.5_wp
3486	!
3487	!-- Kinematic viscosity (Eq. 4.55)
3488	kvis = avis / adn
3489	!
3490	!-- Thermal velocity of an air molecule (Eq. 15.32)
3491	va = SQRT( 8.0_wp * abo * tk / ( pi * am_airmol ) )
3492	!
3493	!-- Mean free path (m) (Eq. 15.24)
3494	lambda = 2.0_wp * avis / ( adn * va )
3495	!
3496	!-- Parameters for the land use category 'deciduous broadleaf trees'(Table 3)
3497	alpha = alpha_z01(depo_pcm_type_num)
3498	gamma = gamma_z01(depo_pcm_type_num)
3499	par_a = A_z01(depo_pcm_type_num, season) * 1.0E-3_wp
3500	!
3501	!-- Deposition efficiencies from Table 1. Constants from Table 2.
3502	par_l = l_p10(depo_pcm_type_num) * 0.01_wp
3503	c_brownian_diff = c_b_p10(depo_pcm_type_num)
3504	c_interception = c_in_p10(depo_pcm_type_num)
3505	c_impaction = c_im_p10(depo_pcm_type_num)
3506	beta_im = beta_im_p10(depo_pcm_type_num)
3507	c_turb_impaction = c_it_p10(depo_pcm_type_num)
3508
3509	DO ib = 1, nbins_aerosol
3510
3511	IF ( paero(ib)%numc < nclim ) CYCLE
3512	zdwet = paero(ib)%dwet
3513	!
3514	!-- Knudsen number (Eq. 15.23)
3515	Kn = MAX( 1.0E-2_wp, lambda / ( zdwet * 0.5_wp ) ) ! To avoid underflow
3516	!
3517	!-- Cunningham slip-flow correction (Eq. 15.30)
3518	beta = 1.0_wp + Kn * ( 1.249_wp + 0.42_wp * EXP( -0.87_wp / Kn ) )
3519
3520	!-- Particle diffusivity coefficient (Eq. 15.29)
3521	mdiff = ( abo * tk * beta ) / ( 3.0_wp * pi * avis * zdwet )
3522	!
3523	!-- Particle Schmidt number (Eq. 15.36)
3524	schmidt_num(ib) = kvis / mdiff
3525	!
3526	!-- Critical fall speed i.e. settling velocity (Eq. 20.4)
3527	vc(ib) = MIN( 1.0_wp, terminal_vel( 0.5_wp * zdwet, pdn, adn, avis, beta) )
3528	!
3529	!-- Friction velocity for deposition on vegetation. Calculated following Prandtl (1925):
3530	IF ( lsdepo_pcm .AND. plant_canopy .AND. lad > 0.0_wp ) THEN
3531	ustar = SQRT( cdc ) * mag_u
3532	SELECT CASE ( depo_pcm_par_num )
3533
3534	CASE ( 1 ) ! Zhang et al. (2001)
3535	CALL depo_vel_Z01( vc(ib), ustar, schmidt_num(ib), paero(ib)%dwet, alpha, gamma, &
3536	par_a, depo )
3537	CASE ( 2 ) ! Petroff & Zhang (2010)
3538	CALL depo_vel_P10( vc(ib), mag_u, ustar, kvis, schmidt_num(ib), paero(ib)%dwet, &
3539	par_l, c_brownian_diff, c_interception, c_impaction, beta_im, &
3540	c_turb_impaction, depo )
3541	END SELECT
3542	!
3543	!-- Calculate the change in concentrations
3544	paero(ib)%numc = paero(ib)%numc - depo * lad * paero(ib)%numc * dt_salsa
3545	DO ic = 1, maxspec+1
3546	paero(ib)%volc(ic) = paero(ib)%volc(ic) - depo * lad * paero(ib)%volc(ic) * dt_salsa
3547	ENDDO
3548	ENDIF
3549	ENDDO
3550
3551	END SUBROUTINE deposition
3552
3553	!------------------------------------------------------------------------------!
3554	! Description:
3555	! ------------
3556	!> Calculate deposition velocity (m/s) based on Zhan et al. (2001, case 1).
3557	!------------------------------------------------------------------------------!
3558
3559	SUBROUTINE depo_vel_Z01( vc, ustar, schmidt_num, diameter, alpha, gamma, par_a, depo )
3560
3561	IMPLICIT NONE
3562
3563	REAL(wp) :: rs !< overall quasi-laminar resistance for particles
3564	REAL(wp) :: stokes_num !< Stokes number for smooth or bluff surfaces
3565
3566	REAL(wp), INTENT(in) :: alpha !< parameter, Table 3 in Z01
3567	REAL(wp), INTENT(in) :: gamma !< parameter, Table 3 in Z01
3568	REAL(wp), INTENT(in) :: par_a !< parameter A for the characteristic diameter of
3569	!< collectors, Table 3 in Z01
3570	REAL(wp), INTENT(in) :: diameter !< particle diameter
3571	REAL(wp), INTENT(in) :: schmidt_num !< particle Schmidt number
3572	REAL(wp), INTENT(in) :: ustar !< friction velocity (m/s)
3573	REAL(wp), INTENT(in) :: vc !< terminal velocity (m/s)
3574
3575	REAL(wp), INTENT(inout) :: depo !< deposition efficiency (m/s)
3576
3577	IF ( par_a > 0.0_wp ) THEN
3578	!
3579	!-- Initialise
3580	rs = 0.0_wp
3581	!
3582	!-- Stokes number for vegetated surfaces (Seinfeld & Pandis (2006): Eq.19.24)
3583	stokes_num = vc * ustar / ( g * par_a )
3584	!
3585	!-- The overall quasi-laminar resistance for particles (Zhang et al., Eq. 5)
3586	rs = MAX( EPSILON( 1.0_wp ), ( 3.0_wp * ustar * EXP( -stokes_num*0.5_wp ) &
3587	( schmidt_num( -gamma ) + ( stokes_num / ( alpha + stokes_num ) )2 + &
3588	0.5_wp * ( diameter / par_a )**2 ) ) )
3589
3590	depo = rs + vc
3591
3592	ELSE
3593	depo = 0.0_wp
3594	ENDIF
3595
3596	END SUBROUTINE depo_vel_Z01
3597
3598	!------------------------------------------------------------------------------!
3599	! Description:
3600	! ------------
3601	!> Calculate deposition velocity (m/s) based on Petroff & Zhang (2010, case 2).
3602	!------------------------------------------------------------------------------!
3603
3604	SUBROUTINE depo_vel_P10( vc, mag_u, ustar, kvis_a, schmidt_num, diameter, par_l, c_brownian_diff, &
3605	c_interception, c_impaction, beta_im, c_turb_impaction, depo )
3606
3607	IMPLICIT NONE
3608
3609	REAL(wp) :: stokes_num !< Stokes number for smooth or bluff surfaces
3610	REAL(wp) :: tau_plus !< dimensionless particle relaxation time
3611	REAL(wp) :: v_bd !< deposition velocity due to Brownian diffusion
3612	REAL(wp) :: v_im !< deposition velocity due to impaction
3613	REAL(wp) :: v_in !< deposition velocity due to interception
3614	REAL(wp) :: v_it !< deposition velocity due to turbulent impaction
3615
3616	REAL(wp), INTENT(in) :: beta_im !< parameter for turbulent impaction
3617	REAL(wp), INTENT(in) :: c_brownian_diff !< coefficient for Brownian diffusion
3618	REAL(wp), INTENT(in) :: c_impaction !< coefficient for inertial impaction
3619	REAL(wp), INTENT(in) :: c_interception !< coefficient for interception
3620	REAL(wp), INTENT(in) :: c_turb_impaction !< coefficient for turbulent impaction
3621	REAL(wp), INTENT(in) :: kvis_a !< kinematic viscosity of air (m2/s)
3622	REAL(wp), INTENT(in) :: mag_u !< wind velocity (m/s)
3623	REAL(wp), INTENT(in) :: par_l !< obstacle characteristic dimension in P10
3624	REAL(wp), INTENT(in) :: diameter !< particle diameter
3625	REAL(wp), INTENT(in) :: schmidt_num !< particle Schmidt number
3626	REAL(wp), INTENT(in) :: ustar !< friction velocity (m/s)
3627	REAL(wp), INTENT(in) :: vc !< terminal velocity (m/s)
3628
3629	REAL(wp), INTENT(inout) :: depo !< deposition efficiency (m/s)
3630
3631	IF ( par_l > 0.0_wp ) THEN
3632	!
3633	!-- Initialise
3634	tau_plus = 0.0_wp
3635	v_bd = 0.0_wp
3636	v_im = 0.0_wp
3637	v_in = 0.0_wp
3638	v_it = 0.0_wp
3639	!
3640	!-- Stokes number for vegetated surfaces (Seinfeld & Pandis (2006): Eq.19.24)
3641	stokes_num = vc * ustar / ( g * par_l )
3642	!
3643	!-- Non-dimensional relexation time of the particle on top of canopy
3644	tau_plus = vc * ustar*2 / ( kvis_a g )
3645	!
3646	!-- Brownian diffusion
3647	v_bd = mag_u * c_brownian_diff * schmidt_num*( -0.66666666_wp ) &
3648	( mag_u * par_l / kvis_a )**( -0.5_wp )
3649	!
3650	!-- Interception
3651	v_in = mag_u * c_interception * diameter / par_l * ( 2.0_wp + LOG( 2.0_wp * par_l / diameter ) )
3652	!
3653	!-- Impaction: Petroff (2009) Eq. 18
3654	v_im = mag_u * c_impaction * ( stokes_num / ( stokes_num + beta_im ) )**2
3655	!
3656	!-- Turbulent impaction
3657	IF ( tau_plus < 20.0_wp ) THEN
3658	v_it = 2.5E-3_wp * c_turb_impaction * tau_plus**2
3659	ELSE
3660	v_it = c_turb_impaction
3661	ENDIF
3662
3663	depo = ( v_bd + v_in + v_im + v_it + vc )
3664
3665	ELSE
3666	depo = 0.0_wp
3667	ENDIF
3668
3669	END SUBROUTINE depo_vel_P10
3670
3671	!------------------------------------------------------------------------------!
3672	! Description:
3673	! ------------
3674	!> Calculate the dry deposition on horizontal and vertical surfaces. Implement
3675	!> as a surface flux.
3676	!> @todo aerodynamic resistance ignored for now (not important for
3677	! high-resolution simulations)
3678	!------------------------------------------------------------------------------!
3679	SUBROUTINE depo_surf( i, j, surf, vc, schmidt_num, kvis, mag_u, norm, match_array )
3680
3681	USE arrays_3d, &
3682	ONLY: rho_air_zw
3683
3684	USE surface_mod, &
3685	ONLY: ind_pav_green, ind_veg_wall, ind_wat_win, surf_type
3686
3687	IMPLICIT NONE
3688
3689	INTEGER(iwp) :: ib !< loop index
3690	INTEGER(iwp) :: ic !< loop index
3691	INTEGER(iwp) :: icc !< additional loop index
3692	INTEGER(iwp) :: k !< loop index
3693	INTEGER(iwp) :: m !< loop index
3694	INTEGER(iwp) :: surf_e !< End index of surface elements at (j,i)-gridpoint
3695	INTEGER(iwp) :: surf_s !< Start index of surface elements at (j,i)-gridpoint
3696
3697	INTEGER(iwp), INTENT(in) :: i !< loop index
3698	INTEGER(iwp), INTENT(in) :: j !< loop index
3699
3700	LOGICAL, INTENT(in) :: norm !< to normalise or not
3701
3702	REAL(wp) :: alpha !< parameter, Table 3 in Z01
3703	REAL(wp) :: beta_im !< parameter for turbulent impaction
3704	REAL(wp) :: c_brownian_diff !< coefficient for Brownian diffusion
3705	REAL(wp) :: c_impaction !< coefficient for inertial impaction
3706	REAL(wp) :: c_interception !< coefficient for interception
3707	REAL(wp) :: c_turb_impaction !< coefficient for turbulent impaction
3708	REAL(wp) :: gamma !< parameter, Table 3 in Z01
3709	REAL(wp) :: norm_fac !< normalisation factor (usually air density)
3710	REAL(wp) :: par_a !< parameter A for the characteristic radius of collectors,
3711	!< Table 3 in Z01
3712	REAL(wp) :: par_l !< obstacle characteristic dimension in P10
3713	REAL(wp) :: rs !< the overall quasi-laminar resistance for particles
3714	REAL(wp) :: tau_plus !< dimensionless particle relaxation time
3715	REAL(wp) :: v_bd !< deposition velocity due to Brownian diffusion
3716	REAL(wp) :: v_im !< deposition velocity due to impaction
3717	REAL(wp) :: v_in !< deposition velocity due to interception
3718	REAL(wp) :: v_it !< deposition velocity due to turbulent impaction
3719
3720	REAL(wp), DIMENSION(nbins_aerosol) :: depo !< deposition efficiency
3721	REAL(wp), DIMENSION(nbins_aerosol) :: depo_sum !< sum of deposition efficiencies
3722
3723	REAL(wp), DIMENSION(:), INTENT(in) :: kvis !< kinematic viscosity of air (m2/s)
3724	REAL(wp), DIMENSION(:), INTENT(in) :: mag_u !< wind velocity (m/s)
3725
3726	REAL(wp), DIMENSION(:,:), INTENT(in) :: schmidt_num !< particle Schmidt number
3727	REAL(wp), DIMENSION(:,:), INTENT(in) :: vc !< terminal velocity (m/s)
3728
3729	TYPE(match_surface), INTENT(in), OPTIONAL :: match_array !< match the deposition module and
3730	!< LSM/USM surfaces
3731	TYPE(surf_type), INTENT(inout) :: surf !< respective surface type
3732	!
3733	!-- Initialise
3734	depo = 0.0_wp
3735	depo_sum = 0.0_wp
3736	rs = 0.0_wp
3737	surf_s = surf%start_index(j,i)
3738	surf_e = surf%end_index(j,i)
3739	tau_plus = 0.0_wp
3740	v_bd = 0.0_wp
3741	v_im = 0.0_wp
3742	v_in = 0.0_wp
3743	v_it = 0.0_wp
3744	!
3745	!-- Model parameters for the land use category. If LSM or USM is applied, import
3746	!-- characteristics. Otherwise, apply surface type "urban".
3747	alpha = alpha_z01(luc_urban)
3748	gamma = gamma_z01(luc_urban)
3749	par_a = A_z01(luc_urban, season) * 1.0E-3_wp
3750
3751	par_l = l_p10(luc_urban) * 0.01_wp
3752	c_brownian_diff = c_b_p10(luc_urban)
3753	c_interception = c_in_p10(luc_urban)
3754	c_impaction = c_im_p10(luc_urban)
3755	beta_im = beta_im_p10(luc_urban)
3756	c_turb_impaction = c_it_p10(luc_urban)
3757
3758
3759	IF ( PRESENT( match_array ) ) THEN ! land or urban surface model
3760
3761	DO m = surf_s, surf_e
3762
3763	k = surf%k(m)
3764	norm_fac = 1.0_wp
3765
3766	IF ( norm ) norm_fac = rho_air_zw(k) ! normalise vertical fluxes by air density
3767
3768	IF ( match_array%match_lupg(m) > 0 ) THEN
3769	alpha = alpha_z01( match_array%match_lupg(m) )
3770	gamma = gamma_z01( match_array%match_lupg(m) )
3771	par_a = A_z01( match_array%match_lupg(m), season ) * 1.0E-3_wp
3772
3773	beta_im = beta_im_p10( match_array%match_lupg(m) )
3774	c_brownian_diff = c_b_p10( match_array%match_lupg(m) )
3775	c_impaction = c_im_p10( match_array%match_lupg(m) )
3776	c_interception = c_in_p10( match_array%match_lupg(m) )
3777	c_turb_impaction = c_it_p10( match_array%match_lupg(m) )
3778	par_l = l_p10( match_array%match_lupg(m) ) * 0.01_wp
3779
3780	DO ib = 1, nbins_aerosol
3781	IF ( aerosol_number(ib)%conc(k,j,i) <= nclim .OR. schmidt_num(k+1,ib) < 1.0_wp ) &
3782	CYCLE
3783
3784	SELECT CASE ( depo_surf_par_num )
3785
3786	CASE ( 1 )
3787	CALL depo_vel_Z01( vc(k+1,ib), surf%us(m), schmidt_num(k+1,ib), &
3788	ra_dry(k,j,i,ib), alpha, gamma, par_a, depo(ib) )
3789	CASE ( 2 )
3790	CALL depo_vel_P10( vc(k+1,ib), mag_u(k+1), surf%us(m), kvis(k+1), &
3791	schmidt_num(k+1,ib), ra_dry(k,j,i,ib), par_l, &
3792	c_brownian_diff, c_interception, c_impaction, beta_im, &
3793	c_turb_impaction, depo(ib) )
3794	END SELECT
3795	ENDDO
3796	depo_sum = depo_sum + surf%frac(ind_pav_green,m) * depo
3797	ENDIF
3798
3799	IF ( match_array%match_luvw(m) > 0 ) THEN
3800	alpha = alpha_z01( match_array%match_luvw(m) )
3801	gamma = gamma_z01( match_array%match_luvw(m) )
3802	par_a = A_z01( match_array%match_luvw(m), season ) * 1.0E-3_wp
3803
3804	beta_im = beta_im_p10( match_array%match_luvw(m) )
3805	c_brownian_diff = c_b_p10( match_array%match_luvw(m) )
3806	c_impaction = c_im_p10( match_array%match_luvw(m) )
3807	c_interception = c_in_p10( match_array%match_luvw(m) )
3808	c_turb_impaction = c_it_p10( match_array%match_luvw(m) )
3809	par_l = l_p10( match_array%match_luvw(m) ) * 0.01_wp
3810
3811	DO ib = 1, nbins_aerosol
3812	IF ( aerosol_number(ib)%conc(k,j,i) <= nclim .OR. schmidt_num(k+1,ib) < 1.0_wp ) &
3813	CYCLE
3814
3815	SELECT CASE ( depo_surf_par_num )
3816
3817	CASE ( 1 )
3818	CALL depo_vel_Z01( vc(k+1,ib), surf%us(m), schmidt_num(k+1,ib), &
3819	ra_dry(k,j,i,ib), alpha, gamma, par_a, depo(ib) )
3820	CASE ( 2 )
3821	CALL depo_vel_P10( vc(k+1,ib), mag_u(k+1), surf%us(m), kvis(k+1), &
3822	schmidt_num(k+1,ib), ra_dry(k,j,i,ib), par_l, &
3823	c_brownian_diff, c_interception, c_impaction, beta_im, &
3824	c_turb_impaction, depo(ib) )
3825	END SELECT
3826	ENDDO
3827	depo_sum = depo_sum + surf%frac(ind_veg_wall,m) * depo
3828	ENDIF
3829
3830	IF ( match_array%match_luww(m) > 0 ) THEN
3831	alpha = alpha_z01( match_array%match_luww(m) )
3832	gamma = gamma_z01( match_array%match_luww(m) )
3833	par_a = A_z01( match_array%match_luww(m), season ) * 1.0E-3_wp
3834
3835	beta_im = beta_im_p10( match_array%match_luww(m) )
3836	c_brownian_diff = c_b_p10( match_array%match_luww(m) )
3837	c_impaction = c_im_p10( match_array%match_luww(m) )
3838	c_interception = c_in_p10( match_array%match_luww(m) )
3839	c_turb_impaction = c_it_p10( match_array%match_luww(m) )
3840	par_l = l_p10( match_array%match_luww(m) ) * 0.01_wp
3841
3842	DO ib = 1, nbins_aerosol
3843	IF ( aerosol_number(ib)%conc(k,j,i) <= nclim .OR. schmidt_num(k+1,ib) < 1.0_wp ) &
3844	CYCLE
3845
3846	SELECT CASE ( depo_surf_par_num )
3847
3848	CASE ( 1 )
3849	CALL depo_vel_Z01( vc(k+1,ib), surf%us(m), schmidt_num(k+1,ib), &
3850	ra_dry(k,j,i,ib), alpha, gamma, par_a, depo(ib) )
3851	CASE ( 2 )
3852	CALL depo_vel_P10( vc(k+1,ib), mag_u(k+1), surf%us(m), kvis(k+1), &
3853	schmidt_num(k+1,ib), ra_dry(k,j,i,ib), par_l, &
3854	c_brownian_diff, c_interception, c_impaction, beta_im, &
3855	c_turb_impaction, depo(ib) )
3856	END SELECT
3857	ENDDO
3858	depo_sum = depo_sum + surf%frac(ind_wat_win,m) * depo
3859	ENDIF
3860
3861	DO ib = 1, nbins_aerosol
3862	!
3863	!-- Calculate changes in surface fluxes due to dry deposition
3864	IF ( include_emission ) THEN
3865	surf%answs(m,ib) = aerosol_number(ib)%source(j,i) - MAX( 0.0_wp, &
3866	depo_sum(ib) * norm_fac * aerosol_number(ib)%conc(k,j,i) )
3867	DO ic = 1, ncomponents_mass
3868	icc = ( ic - 1 ) * nbins_aerosol + ib
3869	surf%amsws(m,icc) = aerosol_mass(icc)%source(j,i) - MAX( 0.0_wp, &
3870	depo_sum(ib) * norm_fac * aerosol_mass(icc)%conc(k,j,i) )
3871	ENDDO ! ic
3872	ELSE
3873	surf%answs(m,ib) = -depo_sum(ib) * norm_fac * aerosol_number(ib)%conc(k,j,i)
3874	DO ic = 1, ncomponents_mass
3875	icc = ( ic - 1 ) * nbins_aerosol + ib
3876	surf%amsws(m,icc) = -depo_sum(ib) * norm_fac * aerosol_mass(icc)%conc(k,j,i)
3877	ENDDO ! ic
3878	ENDIF
3879	ENDDO ! ib
3880
3881	ENDDO
3882
3883	ELSE ! default surfaces
3884
3885	DO m = surf_s, surf_e
3886
3887	k = surf%k(m)
3888	norm_fac = 1.0_wp
3889
3890	IF ( norm ) norm_fac = rho_air_zw(k) ! normalise vertical fluxes by air density
3891
3892	DO ib = 1, nbins_aerosol
3893	IF ( aerosol_number(ib)%conc(k,j,i) <= nclim .OR. schmidt_num(k+1,ib) < 1.0_wp ) &
3894	CYCLE
3895
3896	SELECT CASE ( depo_surf_par_num )
3897
3898	CASE ( 1 )
3899	CALL depo_vel_Z01( vc(k+1,ib), surf%us(m), schmidt_num(k+1,ib), &
3900	ra_dry(k,j,i,ib), alpha, gamma, par_a, depo(ib) )
3901	CASE ( 2 )
3902	CALL depo_vel_P10( vc(k+1,ib), mag_u(k+1), surf%us(m), kvis(k+1), &
3903	schmidt_num(k+1,ib), ra_dry(k,j,i,ib), par_l, &
3904	c_brownian_diff, c_interception, c_impaction, beta_im, &
3905	c_turb_impaction, depo(ib) )
3906	END SELECT
3907	!
3908	!-- Calculate changes in surface fluxes due to dry deposition
3909	IF ( include_emission ) THEN
3910	surf%answs(m,ib) = aerosol_number(ib)%source(j,i) - MAX( 0.0_wp, &
3911	depo(ib) * norm_fac * aerosol_number(ib)%conc(k,j,i) )
3912	DO ic = 1, ncomponents_mass
3913	icc = ( ic - 1 ) * nbins_aerosol + ib
3914	surf%amsws(m,icc) = aerosol_mass(icc)%source(j,i) - MAX( 0.0_wp, &
3915	depo(ib) * norm_fac * aerosol_mass(icc)%conc(k,j,i) )
3916	ENDDO ! ic
3917	ELSE
3918	surf%answs(m,ib) = -depo(ib) * norm_fac * aerosol_number(ib)%conc(k,j,i)
3919	DO ic = 1, ncomponents_mass
3920	icc = ( ic - 1 ) * nbins_aerosol + ib
3921	surf%amsws(m,icc) = -depo(ib) * norm_fac * aerosol_mass(icc)%conc(k,j,i)
3922	ENDDO ! ic
3923	ENDIF
3924	ENDDO ! ib
3925	ENDDO
3926
3927	ENDIF
3928
3929	END SUBROUTINE depo_surf
3930
3931	!------------------------------------------------------------------------------!
3932	! Description:
3933	! ------------
3934	! Function for calculating terminal velocities for different particles sizes.
3935	!------------------------------------------------------------------------------!
3936	REAL(wp) FUNCTION terminal_vel( radius, rhop, rhoa, visc, beta )
3937
3938	IMPLICIT NONE
3939
3940	REAL(wp), INTENT(in) :: beta !< Cunningham correction factor
3941	REAL(wp), INTENT(in) :: radius !< particle radius (m)
3942	REAL(wp), INTENT(in) :: rhop !< particle density (kg/m3)
3943	REAL(wp), INTENT(in) :: rhoa !< air density (kg/m3)
3944	REAL(wp), INTENT(in) :: visc !< molecular viscosity of air (kg/(m*s))
3945
3946	!
3947	!-- Stokes law with Cunningham slip correction factor
3948	terminal_vel = 4.0_wp * radius*2 ( rhop - rhoa ) * g * beta / ( 18.0_wp * visc ) ! (m/s)
3949
3950	END FUNCTION terminal_vel
3951
3952	!------------------------------------------------------------------------------!
3953	! Description:
3954	! ------------
3955	!> Calculates particle loss and change in size distribution due to (Brownian)
3956	!> coagulation. Only for particles with dwet < 30 micrometres.
3957	!
3958	!> Method:
3959	!> Semi-implicit, non-iterative method: (Jacobson, 1994)
3960	!> Volume concentrations of the smaller colliding particles added to the bin of
3961	!> the larger colliding particles. Start from first bin and use the updated
3962	!> number and volume for calculation of following bins. NB! Our bin numbering
3963	!> does not follow particle size in subrange 2.
3964	!
3965	!> Schematic for bin numbers in different subranges:
3966	!> 1 2
3967	!> +-------------------------------------------+
3968	!> a \| 1 \| 2 \| 3 \|\| 4 \| 5 \| 6 \| 7 \| 8 \| 9 \| 10\|\|
3969	!> b \| \|\|11 \|12 \|13 \|14 \| 15 \| 16 \| 17\|\|
3970	!> +-------------------------------------------+
3971	!
3972	!> Exact coagulation coefficients for each pressure level are scaled according
3973	!> to current particle wet size (linear scaling).
3974	!> Bins are organized in terms of the dry size of the condensation nucleus,
3975	!> while coagulation kernell is calculated with the actual hydrometeor
3976	!> size.
3977	!
3978	!> Called from salsa_driver
3979	!> fxm: Process selection should be made smarter - now just lots of IFs inside
3980	!> loops
3981	!
3982	!> Coded by:
3983	!> Hannele Korhonen (FMI) 2005
3984	!> Harri Kokkola (FMI) 2006
3985	!> Tommi Bergman (FMI) 2012
3986	!> Matti Niskanen(FMI) 2012
3987	!> Anton Laakso (FMI) 2013
3988	!> Juha Tonttila (FMI) 2014
3989	!------------------------------------------------------------------------------!
3990	SUBROUTINE coagulation( paero, ptstep, ptemp, ppres )
3991
3992	IMPLICIT NONE
3993
3994	INTEGER(iwp) :: index_2a !< corresponding bin in subrange 2a
3995	INTEGER(iwp) :: index_2b !< corresponding bin in subrange 2b
3996	INTEGER(iwp) :: ib !< loop index
3997	INTEGER(iwp) :: ll !< loop index
3998	INTEGER(iwp) :: mm !< loop index
3999	INTEGER(iwp) :: nn !< loop index
4000
4001	REAL(wp) :: pressi !< pressure
4002	REAL(wp) :: temppi !< temperature
4003	REAL(wp) :: zdpart_mm !< diameter of particle (m)
4004	REAL(wp) :: zdpart_nn !< diameter of particle (m)
4005	REAL(wp) :: zminusterm !< coagulation loss in a bin (1/s)
4006
4007	REAL(wp), INTENT(in) :: ppres !< ambient pressure (Pa)
4008	REAL(wp), INTENT(in) :: ptemp !< ambient temperature (K)
4009	REAL(wp), INTENT(in) :: ptstep !< time step (s)
4010
4011	REAL(wp), DIMENSION(nbins_aerosol) :: zmpart !< approximate mass of particles (kg)
4012	REAL(wp), DIMENSION(maxspec+1) :: zplusterm !< coagulation gain in a bin (for each
4013	!< chemical compound)
4014	REAL(wp), DIMENSION(nbins_aerosol,nbins_aerosol) :: zcc !< updated coagulation coefficients (m3/s)
4015
4016	TYPE(t_section), DIMENSION(nbins_aerosol), INTENT(inout) :: paero !< Aerosol properties
4017
4018	zdpart_mm = 0.0_wp
4019	zdpart_nn = 0.0_wp
4020	!
4021	!-- 1) Coagulation to coarse mode calculated in a simplified way:
4022	!-- CoagSink ~ Dp in continuum subrange, thus we calculate 'effective'
4023	!-- number concentration of coarse particles
4024
4025	!-- 2) Updating coagulation coefficients
4026	!
4027	!-- Aerosol mass (kg). Density of 1500 kg/m3 assumed
4028	zmpart(1:end_subrange_2b) = api6 * ( MIN( paero(1:end_subrange_2b)%dwet, 30.0E-6_wp )**3 ) &
4029	* 1500.0_wp
4030	temppi = ptemp
4031	pressi = ppres
4032	zcc = 0.0_wp
4033	!
4034	!-- Aero-aero coagulation
4035	DO mm = 1, end_subrange_2b ! smaller colliding particle
4036	IF ( paero(mm)%numc < nclim ) CYCLE
4037	DO nn = mm, end_subrange_2b ! larger colliding particle
4038	IF ( paero(nn)%numc < nclim ) CYCLE
4039
4040	zdpart_mm = MIN( paero(mm)%dwet, 30.0E-6_wp ) ! Limit to 30 um
4041	zdpart_nn = MIN( paero(nn)%dwet, 30.0E-6_wp ) ! Limit to 30 um
4042	!
4043	!-- Coagulation coefficient of particles (m3/s)
4044	zcc(mm,nn) = coagc( zdpart_mm, zdpart_nn, zmpart(mm), zmpart(nn), temppi, pressi )
4045	zcc(nn,mm) = zcc(mm,nn)
4046	ENDDO
4047	ENDDO
4048
4049	!
4050	!-- 3) New particle and volume concentrations after coagulation:
4051	!-- Calculated according to Jacobson (2005) eq. 15.9
4052	!
4053	!-- Aerosols in subrange 1a:
4054	DO ib = start_subrange_1a, end_subrange_1a
4055	IF ( paero(ib)%numc < nclim ) CYCLE
4056	zminusterm = 0.0_wp
4057	zplusterm(:) = 0.0_wp
4058	!
4059	!-- Particles lost by coagulation with larger aerosols
4060	DO ll = ib+1, end_subrange_2b
4061	zminusterm = zminusterm + zcc(ib,ll) * paero(ll)%numc
4062	ENDDO
4063	!
4064	!-- Coagulation gain in a bin: change in volume conc. (cm3/cm3):
4065	DO ll = start_subrange_1a, ib - 1
4066	zplusterm(1:2) = zplusterm(1:2) + zcc(ll,ib) * paero(ll)%volc(1:2)
4067	zplusterm(6:7) = zplusterm(6:7) + zcc(ll,ib) * paero(ll)%volc(6:7)
4068	zplusterm(8) = zplusterm(8) + zcc(ll,ib) * paero(ll)%volc(8)
4069	ENDDO
4070	!
4071	!-- Volume and number concentrations after coagulation update [fxm]
4072	paero(ib)%volc(1:2) = ( paero(ib)%volc(1:2) + ptstep * zplusterm(1:2) * paero(ib)%numc ) / &
4073	( 1.0_wp + ptstep * zminusterm )
4074	paero(ib)%volc(6:8) = ( paero(ib)%volc(6:8) + ptstep * zplusterm(6:8) * paero(ib)%numc ) / &
4075	( 1.0_wp + ptstep * zminusterm )
4076	paero(ib)%numc = paero(ib)%numc / ( 1.0_wp + ptstep * zminusterm + 0.5_wp * ptstep * &
4077	zcc(ib,ib) * paero(ib)%numc )
4078	ENDDO
4079	!
4080	!-- Aerosols in subrange 2a:
4081	DO ib = start_subrange_2a, end_subrange_2a
4082	IF ( paero(ib)%numc < nclim ) CYCLE
4083	zminusterm = 0.0_wp
4084	zplusterm(:) = 0.0_wp
4085	!
4086	!-- Find corresponding size bin in subrange 2b
4087	index_2b = ib - start_subrange_2a + start_subrange_2b
4088	!
4089	!-- Particles lost by larger particles in 2a
4090	DO ll = ib+1, end_subrange_2a
4091	zminusterm = zminusterm + zcc(ib,ll) * paero(ll)%numc
4092	ENDDO
4093	!
4094	!-- Particles lost by larger particles in 2b
4095	IF ( .NOT. no_insoluble ) THEN
4096	DO ll = index_2b+1, end_subrange_2b
4097	zminusterm = zminusterm + zcc(ib,ll) * paero(ll)%numc
4098	ENDDO
4099	ENDIF
4100	!
4101	!-- Particle volume gained from smaller particles in subranges 1, 2a and 2b
4102	DO ll = start_subrange_1a, ib-1
4103	zplusterm(1:2) = zplusterm(1:2) + zcc(ll,ib) * paero(ll)%volc(1:2)
4104	zplusterm(6:8) = zplusterm(6:8) + zcc(ll,ib) * paero(ll)%volc(6:8)
4105	ENDDO
4106	!
4107	!-- Particle volume gained from smaller particles in 2a
4108	!-- (Note, for components not included in the previous loop!)
4109	DO ll = start_subrange_2a, ib-1
4110	zplusterm(3:5) = zplusterm(3:5) + zcc(ll,ib)*paero(ll)%volc(3:5)
4111	ENDDO
4112	!
4113	!-- Particle volume gained from smaller (and equal) particles in 2b
4114	IF ( .NOT. no_insoluble ) THEN
4115	DO ll = start_subrange_2b, index_2b
4116	zplusterm(1:8) = zplusterm(1:8) + zcc(ll,ib) * paero(ll)%volc(1:8)
4117	ENDDO
4118	ENDIF
4119	!
4120	!-- Volume and number concentrations after coagulation update [fxm]
4121	paero(ib)%volc(1:8) = ( paero(ib)%volc(1:8) + ptstep * zplusterm(1:8) * paero(ib)%numc ) / &
4122	( 1.0_wp + ptstep * zminusterm )
4123	paero(ib)%numc = paero(ib)%numc / ( 1.0_wp + ptstep * zminusterm + 0.5_wp * ptstep * &
4124	zcc(ib,ib) * paero(ib)%numc )
4125	ENDDO
4126	!
4127	!-- Aerosols in subrange 2b:
4128	IF ( .NOT. no_insoluble ) THEN
4129	DO ib = start_subrange_2b, end_subrange_2b
4130	IF ( paero(ib)%numc < nclim ) CYCLE
4131	zminusterm = 0.0_wp
4132	zplusterm(:) = 0.0_wp
4133	!
4134	!-- Find corresponding size bin in subsubrange 2a
4135	index_2a = ib - start_subrange_2b + start_subrange_2a
4136	!
4137	!-- Particles lost to larger particles in subranges 2b
4138	DO ll = ib + 1, end_subrange_2b
4139	zminusterm = zminusterm + zcc(ib,ll) * paero(ll)%numc
4140	ENDDO
4141	!
4142	!-- Particles lost to larger and equal particles in 2a
4143	DO ll = index_2a, end_subrange_2a
4144	zminusterm = zminusterm + zcc(ib,ll) * paero(ll)%numc
4145	ENDDO
4146	!
4147	!-- Particle volume gained from smaller particles in subranges 1 & 2a
4148	DO ll = start_subrange_1a, index_2a - 1
4149	zplusterm(1:8) = zplusterm(1:8) + zcc(ll,ib) * paero(ll)%volc(1:8)
4150	ENDDO
4151	!
4152	!-- Particle volume gained from smaller particles in 2b
4153	DO ll = start_subrange_2b, ib - 1
4154	zplusterm(1:8) = zplusterm(1:8) + zcc(ll,ib) * paero(ll)%volc(1:8)
4155	ENDDO
4156	!
4157	!-- Volume and number concentrations after coagulation update [fxm]
4158	paero(ib)%volc(1:8) = ( paero(ib)%volc(1:8) + ptstep * zplusterm(1:8) * paero(ib)%numc ) &
4159	/ ( 1.0_wp + ptstep * zminusterm )
4160	paero(ib)%numc = paero(ib)%numc / ( 1.0_wp + ptstep * zminusterm + 0.5_wp * ptstep * &
4161	zcc(ib,ib) * paero(ib)%numc )
4162	ENDDO
4163	ENDIF
4164
4165	END SUBROUTINE coagulation
4166
4167	!------------------------------------------------------------------------------!
4168	! Description:
4169	! ------------
4170	!> Calculation of coagulation coefficients. Extended version of the function
4171	!> originally found in mo_salsa_init.
4172	!
4173	!> J. Tonttila, FMI, 05/2014
4174	!------------------------------------------------------------------------------!
4175	REAL(wp) FUNCTION coagc( diam1, diam2, mass1, mass2, temp, pres )
4176
4177	IMPLICIT NONE
4178
4179	REAL(wp) :: fmdist !< distance of flux matching (m)
4180	REAL(wp) :: knud_p !< particle Knudsen number
4181	REAL(wp) :: mdiam !< mean diameter of colliding particles (m)
4182	REAL(wp) :: mfp !< mean free path of air molecules (m)
4183	REAL(wp) :: visc !< viscosity of air (kg/(m s))
4184
4185	REAL(wp), INTENT(in) :: diam1 !< diameter of colliding particle 1 (m)
4186	REAL(wp), INTENT(in) :: diam2 !< diameter of colliding particle 2 (m)
4187	REAL(wp), INTENT(in) :: mass1 !< mass of colliding particle 1 (kg)
4188	REAL(wp), INTENT(in) :: mass2 !< mass of colliding particle 2 (kg)
4189	REAL(wp), INTENT(in) :: pres !< ambient pressure (Pa?) [fxm]
4190	REAL(wp), INTENT(in) :: temp !< ambient temperature (K)
4191
4192	REAL(wp), DIMENSION (2) :: beta !< Cunningham correction factor
4193	REAL(wp), DIMENSION (2) :: dfpart !< particle diffusion coefficient (m2/s)
4194	REAL(wp), DIMENSION (2) :: diam !< diameters of particles (m)
4195	REAL(wp), DIMENSION (2) :: flux !< flux in continuum and free molec. regime (m/s)
4196	REAL(wp), DIMENSION (2) :: knud !< particle Knudsen number
4197	REAL(wp), DIMENSION (2) :: mpart !< masses of particles (kg)
4198	REAL(wp), DIMENSION (2) :: mtvel !< particle mean thermal velocity (m/s)
4199	REAL(wp), DIMENSION (2) :: omega !< particle mean free path
4200	REAL(wp), DIMENSION (2) :: tva !< temporary variable (m)
4201	!
4202	!-- Initialisation
4203	coagc = 0.0_wp
4204	!
4205	!-- 1) Initializing particle and ambient air variables
4206	diam = (/ diam1, diam2 /) !< particle diameters (m)
4207	mpart = (/ mass1, mass2 /) !< particle masses (kg)
4208	!
4209	!-- Viscosity of air (kg/(m s))
4210	visc = ( 7.44523E-3_wp * temp ** 1.5_wp ) / ( 5093.0_wp * ( temp + 110.4_wp ) )
4211	!
4212	!-- Mean free path of air (m)
4213	mfp = ( 1.656E-10_wp * temp + 1.828E-8_wp ) * ( p_0 + 1325.0_wp ) / pres
4214	!
4215	!-- 2) Slip correction factor for small particles
4216	knud = 2.0_wp * EXP( LOG(mfp) - LOG(diam) )! Knudsen number for air (15.23)
4217	!
4218	!-- Cunningham correction factor (Allen and Raabe, Aerosol Sci. Tech. 4, 269)
4219	beta = 1.0_wp + knud * ( 1.142_wp + 0.558_wp * EXP( -0.999_wp / knud ) )
4220	!
4221	!-- 3) Particle properties
4222	!-- Diffusion coefficient (m2/s) (Jacobson (2005) eq. 15.29)
4223	dfpart = beta * abo * temp / ( 3.0_wp * pi * visc * diam )
4224	!
4225	!-- Mean thermal velocity (m/s) (Jacobson (2005) eq. 15.32)
4226	mtvel = SQRT( ( 8.0_wp * abo * temp ) / ( pi * mpart ) )
4227	!
4228	!-- Particle mean free path (m) (Jacobson (2005) eq. 15.34 )
4229	omega = 8.0_wp * dfpart / ( pi * mtvel )
4230	!
4231	!-- Mean diameter (m)
4232	mdiam = 0.5_wp * ( diam(1) + diam(2) )
4233	!
4234	!-- 4) Calculation of fluxes (Brownian collision kernels) and flux matching
4235	!-- following Jacobson (2005):
4236	!
4237	!-- Flux in continuum regime (m3/s) (eq. 15.28)
4238	flux(1) = 4.0_wp * pi * mdiam * ( dfpart(1) + dfpart(2) )
4239	!
4240	!-- Flux in free molec. regime (m3/s) (eq. 15.31)
4241	flux(2) = pi * SQRT( ( mtvel(1)2 ) + ( mtvel(2)2 ) ) * ( mdiam**2 )
4242	!
4243	!-- temporary variables (m) to calculate flux matching distance (m)
4244	tva(1) = ( ( mdiam + omega(1) )3 - ( mdiam2 + omega(1)*2 ) SQRT( ( mdiam**2 + &
4245	omega(1)*2 ) ) ) / ( 3.0_wp mdiam * omega(1) ) - mdiam
4246	tva(2) = ( ( mdiam + omega(2) )3 - ( mdiam2 + omega(2)*2 ) SQRT( ( mdiam**2 + &
4247	omega(2)*2 ) ) ) / ( 3.0_wp mdiam * omega(2) ) - mdiam
4248	!
4249	!-- Flux matching distance (m): the mean distance from the centre of a sphere reached by particles
4250	!-- that leave sphere's surface and travel a distance of particle mean free path (eq. 15.34)
4251	fmdist = SQRT( tva(1)2 + tva(2)2 )
4252	!
4253	!-- 5) Coagulation coefficient = coalescence efficiency * collision kernel (m3/s) (eq. 15.33).
4254	!-- Here assumed coalescence efficiency 1!!
4255	coagc = flux(1) / ( mdiam / ( mdiam + fmdist) + flux(1) / flux(2) )
4256	!
4257	!-- Corrected collision kernel (Karl et al., 2016 (ACP)): Include van der Waals and viscous forces
4258	IF ( van_der_waals_coagc ) THEN
4259	knud_p = SQRT( omega(1)2 + omega(2)2 ) / mdiam
4260	IF ( knud_p >= 0.1_wp .AND. knud_p <= 10.0_wp ) THEN
4261	coagc = coagc * ( 2.0_wp + 0.4_wp * LOG( knud_p ) )
4262	ELSE
4263	coagc = coagc * 3.0_wp
4264	ENDIF
4265	ENDIF
4266
4267	END FUNCTION coagc
4268
4269	!------------------------------------------------------------------------------!
4270	! Description:
4271	! ------------
4272	!> Calculates the change in particle volume and gas phase
4273	!> concentrations due to nucleation, condensation and dissolutional growth.
4274	!
4275	!> Sulphuric acid and organic vapour: only condensation and no evaporation.
4276	!
4277	!> New gas and aerosol phase concentrations calculated according to Jacobson
4278	!> (1997): Numerical techniques to solve condensational and dissolutional growth
4279	!> equations when growth is coupled to reversible reactions, Aerosol Sci. Tech.,
4280	!> 27, pp 491-498.
4281	!
4282	!> Following parameterization has been used:
4283	!> Molecular diffusion coefficient of condensing vapour (m2/s)
4284	!> (Reid et al. (1987): Properties of gases and liquids, McGraw-Hill, New York.)
4285	!> D = {1.d-7sqrt(1/M_air + 1/M_gas)T^1.75} / &
4286	! {p_atm/p_stand * (d_air^(1/3) + d_gas^(1/3))^2 }
4287	!> M_air = 28.965 : molar mass of air (g/mol)
4288	!> d_air = 19.70 : diffusion volume of air
4289	!> M_h2so4 = 98.08 : molar mass of h2so4 (g/mol)
4290	!> d_h2so4 = 51.96 : diffusion volume of h2so4
4291	!
4292	!> Called from main aerosol model
4293	!> For equations, see Jacobson, Fundamentals of Atmospheric Modeling, 2nd Edition (2005)
4294	!
4295	!> Coded by:
4296	!> Hannele Korhonen (FMI) 2005
4297	!> Harri Kokkola (FMI) 2006
4298	!> Juha Tonttila (FMI) 2014
4299	!> Rewritten to PALM by Mona Kurppa (UHel) 2017
4300	!------------------------------------------------------------------------------!
4301	SUBROUTINE condensation( paero, pc_sa, pc_ocnv, pcocsv, pchno3, pc_nh3, pcw, pcs, ptemp, ppres, &
4302	ptstep, prtcl )
4303
4304	IMPLICIT NONE
4305
4306	INTEGER(iwp) :: ss !< start index
4307	INTEGER(iwp) :: ee !< end index
4308
4309	REAL(wp) :: zcs_ocnv !< condensation sink of nonvolatile organics (1/s)
4310	REAL(wp) :: zcs_ocsv !< condensation sink of semivolatile organics (1/s)
4311	REAL(wp) :: zcs_su !< condensation sink of sulfate (1/s)
4312	REAL(wp) :: zcs_tot !< total condensation sink (1/s) (gases)
4313	REAL(wp) :: zcvap_new1 !< vapour concentration after time step (#/m3): sulphuric acid
4314	REAL(wp) :: zcvap_new2 !< nonvolatile organics
4315	REAL(wp) :: zcvap_new3 !< semivolatile organics
4316	REAL(wp) :: zdfvap !< air diffusion coefficient (m2/s)
4317	REAL(wp) :: zdvap1 !< change in vapour concentration (#/m3): sulphuric acid
4318	REAL(wp) :: zdvap2 !< nonvolatile organics
4319	REAL(wp) :: zdvap3 !< semivolatile organics
4320	REAL(wp) :: zmfp !< mean free path of condensing vapour (m)
4321	REAL(wp) :: zrh !< Relative humidity [0-1]
4322	REAL(wp) :: zvisc !< viscosity of air (kg/(m s))
4323	REAL(wp) :: zn_vs_c !< ratio of nucleation of all mass transfer in the smallest bin
4324	REAL(wp) :: zxocnv !< ratio of organic vapour in 3nm particles
4325	REAL(wp) :: zxsa !< Ratio in 3nm particles: sulphuric acid
4326
4327	REAL(wp), INTENT(in) :: ppres !< ambient pressure (Pa)
4328	REAL(wp), INTENT(in) :: pcs !< Water vapour saturation concentration (kg/m3)
4329	REAL(wp), INTENT(in) :: ptemp !< ambient temperature (K)
4330	REAL(wp), INTENT(in) :: ptstep !< timestep (s)
4331
4332	REAL(wp), INTENT(inout) :: pchno3 !< Gas concentrations (#/m3): nitric acid HNO3
4333	REAL(wp), INTENT(inout) :: pc_nh3 !< ammonia NH3
4334	REAL(wp), INTENT(inout) :: pc_ocnv !< non-volatile organics
4335	REAL(wp), INTENT(inout) :: pcocsv !< semi-volatile organics
4336	REAL(wp), INTENT(inout) :: pc_sa !< sulphuric acid H2SO4
4337	REAL(wp), INTENT(inout) :: pcw !< Water vapor concentration (kg/m3)
4338
4339	REAL(wp), DIMENSION(nbins_aerosol) :: zbeta !< transitional correction factor
4340	REAL(wp), DIMENSION(nbins_aerosol) :: zcolrate !< collision rate (1/s)
4341	REAL(wp), DIMENSION(nbins_aerosol) :: zcolrate_ocnv !< collision rate of non-vol. OC (1/s)
4342	REAL(wp), DIMENSION(start_subrange_1a+1) :: zdfpart !< particle diffusion coefficient (m2/s)
4343	REAL(wp), DIMENSION(nbins_aerosol) :: zdvoloc !< change of organics volume
4344	REAL(wp), DIMENSION(nbins_aerosol) :: zdvolsa !< change of sulphate volume
4345	REAL(wp), DIMENSION(2) :: zj3n3 !< Formation massrate of molecules
4346	!< in nucleation, (molec/m3s),
4347	!< 1: H2SO4 and 2: organic vapor
4348	REAL(wp), DIMENSION(nbins_aerosol) :: zknud !< particle Knudsen number
4349
4350	TYPE(component_index), INTENT(in) :: prtcl !< Keeps track which substances are used
4351
4352	TYPE(t_section), DIMENSION(nbins_aerosol), INTENT(inout) :: paero !< Aerosol properties
4353
4354	zj3n3 = 0.0_wp
4355	zrh = pcw / pcs
4356	zxocnv = 0.0_wp
4357	zxsa = 0.0_wp
4358	!
4359	!-- Nucleation
4360	IF ( nsnucl > 0 ) THEN
4361	CALL nucleation( paero, ptemp, zrh, ppres, pc_sa, pc_ocnv, pc_nh3, ptstep, zj3n3, zxsa, &
4362	zxocnv )
4363	ENDIF
4364	!
4365	!-- Condensation on pre-existing particles
4366	IF ( lscndgas ) THEN
4367	!
4368	!-- Initialise:
4369	zdvolsa = 0.0_wp
4370	zdvoloc = 0.0_wp
4371	zcolrate = 0.0_wp
4372	!
4373	!-- 1) Properties of air and condensing gases:
4374	!-- Viscosity of air (kg/(m s)) (Eq. 4.54 in Jabonson (2005))
4375	zvisc = ( 7.44523E-3_wp * ptemp ** 1.5_wp ) / ( 5093.0_wp * ( ptemp + 110.4_wp ) )
4376	!
4377	!-- Diffusion coefficient of air (m2/s)
4378	zdfvap = 5.1111E-10_wp * ptemp ** 1.75_wp * ( p_0 + 1325.0_wp ) / ppres
4379	!
4380	!-- Mean free path (m): same for H2SO4 and organic compounds
4381	zmfp = 3.0_wp * zdfvap * SQRT( pi * amh2so4 / ( 8.0_wp * argas * ptemp ) )
4382	!
4383	!-- 2) Transition regime correction factor zbeta for particles (Fuchs and Sutugin (1971)):
4384	!-- Size of condensing molecule considered only for nucleation mode (3 - 20 nm).
4385	!
4386	!-- Particle Knudsen number: condensation of gases on aerosols
4387	ss = start_subrange_1a
4388	ee = start_subrange_1a+1
4389	zknud(ss:ee) = 2.0_wp * zmfp / ( paero(ss:ee)%dwet + d_sa )
4390	ss = start_subrange_1a+2
4391	ee = end_subrange_2b
4392	zknud(ss:ee) = 2.0_wp * zmfp / paero(ss:ee)%dwet
4393	!
4394	!-- Transitional correction factor: aerosol + gas (the semi-empirical Fuchs- Sutugin
4395	!-- interpolation function (Fuchs and Sutugin, 1971))
4396	zbeta = ( zknud + 1.0_wp ) / ( 0.377_wp * zknud + 1.0_wp + 4.0_wp / ( 3.0_wp * massacc ) * &
4397	( zknud + zknud ** 2 ) )
4398	!
4399	!-- 3) Collision rate of molecules to particles
4400	!-- Particle diffusion coefficient considered only for nucleation mode (3 - 20 nm)
4401	!
4402	!-- Particle diffusion coefficient (m2/s) (e.g. Eq. 15.29 in Jacobson (2005))
4403	zdfpart = abo * ptemp * zbeta(start_subrange_1a:start_subrange_1a+1) / ( 3.0_wp * pi * zvisc&
4404	* paero(start_subrange_1a:start_subrange_1a+1)%dwet)
4405	!
4406	!-- Collision rate (mass-transfer coefficient): gases on aerosols (1/s) (Eq. 16.64 in
4407	!-- Jacobson (2005))
4408	ss = start_subrange_1a
4409	ee = start_subrange_1a+1
4410	zcolrate(ss:ee) = MERGE( 2.0_wp * pi * ( paero(ss:ee)%dwet + d_sa ) * ( zdfvap + zdfpart ) *&
4411	zbeta(ss:ee) * paero(ss:ee)%numc, 0.0_wp, paero(ss:ee)%numc > nclim )
4412	ss = start_subrange_1a+2
4413	ee = end_subrange_2b
4414	zcolrate(ss:ee) = MERGE( 2.0_wp * pi * paero(ss:ee)%dwet * zdfvap * zbeta(ss:ee) * &
4415	paero(ss:ee)%numc, 0.0_wp, paero(ss:ee)%numc > nclim )
4416	!
4417	!-- 4) Condensation sink (1/s)
4418	zcs_tot = SUM( zcolrate ) ! total sink
4419	!
4420	!-- 5) Changes in gas-phase concentrations and particle volume
4421	!
4422	!-- 5.1) Organic vapours
4423	!
4424	!-- 5.1.1) Non-volatile organic compound: condenses onto all bins
4425	IF ( pc_ocnv > 1.0E+10_wp .AND. zcs_tot > 1.0E-30_wp .AND. index_oc > 0 ) &
4426	THEN
4427	!-- Ratio of nucleation vs. condensation rates in the smallest bin
4428	zn_vs_c = 0.0_wp
4429	IF ( zj3n3(2) > 1.0_wp ) THEN
4430	zn_vs_c = ( zj3n3(2) ) / ( zj3n3(2) + pc_ocnv * zcolrate(start_subrange_1a) )
4431	ENDIF
4432	!
4433	!-- Collision rate in the smallest bin, including nucleation and condensation (see
4434	!-- Jacobson (2005), eq. (16.73) )
4435	zcolrate_ocnv = zcolrate
4436	zcolrate_ocnv(start_subrange_1a) = zcolrate_ocnv(start_subrange_1a) + zj3n3(2) / pc_ocnv
4437	!
4438	!-- Total sink for organic vapor
4439	zcs_ocnv = zcs_tot + zj3n3(2) / pc_ocnv
4440	!
4441	!-- New gas phase concentration (#/m3)
4442	zcvap_new2 = pc_ocnv / ( 1.0_wp + ptstep * zcs_ocnv )
4443	!
4444	!-- Change in gas concentration (#/m3)
4445	zdvap2 = pc_ocnv - zcvap_new2
4446	!
4447	!-- Updated vapour concentration (#/m3)
4448	pc_ocnv = zcvap_new2
4449	!
4450	!-- Volume change of particles (m3(OC)/m3(air))
4451	zdvoloc = zcolrate_ocnv(start_subrange_1a:end_subrange_2b) / zcs_ocnv * amvoc * zdvap2
4452	!
4453	!-- Change of volume due to condensation in 1a-2b
4454	paero(start_subrange_1a:end_subrange_2b)%volc(2) = &
4455	paero(start_subrange_1a:end_subrange_2b)%volc(2) + zdvoloc
4456	!
4457	!-- Change of number concentration in the smallest bin caused by nucleation (Jacobson (2005),
4458	!-- eq. (16.75)). If zxocnv = 0, then the chosen nucleation mechanism doesn't take into
4459	!-- account the non-volatile organic vapors and thus the paero doesn't have to be updated.
4460	IF ( zxocnv > 0.0_wp ) THEN
4461	paero(start_subrange_1a)%numc = paero(start_subrange_1a)%numc + zn_vs_c * &
4462	zdvoloc(start_subrange_1a) / amvoc / ( n3 * zxocnv )
4463	ENDIF
4464	ENDIF
4465	!
4466	!-- 5.1.2) Semivolatile organic compound: all bins except subrange 1
4467	zcs_ocsv = SUM( zcolrate(start_subrange_2a:end_subrange_2b) ) !< sink for semi-volatile organics
4468	IF ( pcocsv > 1.0E+10_wp .AND. zcs_ocsv > 1.0E-30 .AND. is_used( prtcl,'OC') ) THEN
4469	!
4470	!-- New gas phase concentration (#/m3)
4471	zcvap_new3 = pcocsv / ( 1.0_wp + ptstep * zcs_ocsv )
4472	!
4473	!-- Change in gas concentration (#/m3)
4474	zdvap3 = pcocsv - zcvap_new3
4475	!
4476	!-- Updated gas concentration (#/m3)
4477	pcocsv = zcvap_new3
4478	!
4479	!-- Volume change of particles (m3(OC)/m3(air))
4480	ss = start_subrange_2a
4481	ee = end_subrange_2b
4482	zdvoloc(ss:ee) = zdvoloc(ss:ee) + zcolrate(ss:ee) / zcs_ocsv * amvoc * zdvap3
4483	!
4484	!-- Change of volume due to condensation in 1a-2b
4485	paero(start_subrange_1a:end_subrange_2b)%volc(2) = &
4486	paero(start_subrange_1a:end_subrange_2b)%volc(2) + zdvoloc
4487	ENDIF
4488	!
4489	!-- 5.2) Sulphate: condensed on all bins
4490	IF ( pc_sa > 1.0E+10_wp .AND. zcs_tot > 1.0E-30_wp .AND. index_so4 > 0 ) THEN
4491	!
4492	!-- Ratio of mass transfer between nucleation and condensation
4493	zn_vs_c = 0.0_wp
4494	IF ( zj3n3(1) > 1.0_wp ) THEN
4495	zn_vs_c = ( zj3n3(1) ) / ( zj3n3(1) + pc_sa * zcolrate(start_subrange_1a) )
4496	ENDIF
4497	!
4498	!-- Collision rate in the smallest bin, including nucleation and condensation (see
4499	!-- Jacobson (2005), eq. (16.73))
4500	zcolrate(start_subrange_1a) = zcolrate(start_subrange_1a) + zj3n3(1) / pc_sa
4501	!
4502	!-- Total sink for sulfate (1/s)
4503	zcs_su = zcs_tot + zj3n3(1) / pc_sa
4504	!
4505	!-- Sulphuric acid:
4506	!-- New gas phase concentration (#/m3)
4507	zcvap_new1 = pc_sa / ( 1.0_wp + ptstep * zcs_su )
4508	!
4509	!-- Change in gas concentration (#/m3)
4510	zdvap1 = pc_sa - zcvap_new1
4511	!
4512	!-- Updating vapour concentration (#/m3)
4513	pc_sa = zcvap_new1
4514	!
4515	!-- Volume change of particles (m3(SO4)/m3(air)) by condensation
4516	zdvolsa = zcolrate(start_subrange_1a:end_subrange_2b) / zcs_su * amvh2so4 * zdvap1
4517	!
4518	!-- Change of volume concentration of sulphate in aerosol [fxm]
4519	paero(start_subrange_1a:end_subrange_2b)%volc(1) = &
4520	paero(start_subrange_1a:end_subrange_2b)%volc(1) + zdvolsa
4521	!
4522	!-- Change of number concentration in the smallest bin caused by nucleation
4523	!-- (Jacobson (2005), equation (16.75))
4524	IF ( zxsa > 0.0_wp ) THEN
4525	paero(start_subrange_1a)%numc = paero(start_subrange_1a)%numc + zn_vs_c * &
4526	zdvolsa(start_subrange_1a) / amvh2so4 / ( n3 * zxsa)
4527	ENDIF
4528	ENDIF
4529	!
4530	!-- Partitioning of H2O, HNO3, and NH3: Dissolutional growth
4531	IF ( lspartition .AND. ( pchno3 > 1.0E+10_wp .OR. pc_nh3 > 1.0E+10_wp ) ) THEN
4532	CALL gpparthno3( ppres, ptemp, paero, pchno3, pc_nh3, pcw, pcs, zbeta, ptstep )
4533	ENDIF
4534	ENDIF
4535	!
4536	!-- Condensation of water vapour
4537	IF ( lscndh2oae ) THEN
4538	CALL gpparth2o( paero, ptemp, ppres, pcs, pcw, ptstep )
4539	ENDIF
4540
4541	END SUBROUTINE condensation
4542
4543	!------------------------------------------------------------------------------!
4544	! Description:
4545	! ------------
4546	!> Calculates the particle number and volume increase, and gas-phase
4547	!> concentration decrease due to nucleation subsequent growth to detectable size
4548	!> of 3 nm.
4549	!
4550	!> Method:
4551	!> When the formed clusters grow by condensation (possibly also by self-
4552	!> coagulation), their number is reduced due to scavenging to pre-existing
4553	!> particles. Thus, the apparent nucleation rate at 3 nm is significantly lower
4554	!> than the real nucleation rate (at ~1 nm).
4555	!
4556	!> Calculation of the formation rate of detectable particles at 3 nm (i.e. J3):
4557	!> nj3 = 1: Kerminen, V.-M. and Kulmala, M. (2002), J. Aerosol Sci.,33, 609-622.
4558	!> nj3 = 2: Lehtinen et al. (2007), J. Aerosol Sci., 38(9), 988-994.
4559	!> nj3 = 3: Anttila et al. (2010), J. Aerosol Sci., 41(7), 621-636.
4560	!
4561	!> c = aerosol of critical radius (1 nm)
4562	!> x = aerosol with radius 3 nm
4563	!> 2 = wet or mean droplet
4564	!
4565	!> Called from subroutine condensation (in module salsa_dynamics_mod.f90)
4566	!
4567	!> Calls one of the following subroutines:
4568	!> - binnucl
4569	!> - ternucl
4570	!> - kinnucl
4571	!> - actnucl
4572	!
4573	!> fxm: currently only sulphuric acid grows particles from 1 to 3 nm
4574	!> (if asked from Markku, this is terribly wrong!!!)
4575	!
4576	!> Coded by:
4577	!> Hannele Korhonen (FMI) 2005
4578	!> Harri Kokkola (FMI) 2006
4579	!> Matti Niskanen(FMI) 2012
4580	!> Anton Laakso (FMI) 2013
4581	!------------------------------------------------------------------------------!
4582
4583	SUBROUTINE nucleation( paero, ptemp, prh, ppres, pc_sa, pc_ocnv, pc_nh3, ptstep, pj3n3, pxsa, &
4584	pxocnv )
4585
4586	IMPLICIT NONE
4587
4588	INTEGER(iwp) :: iteration
4589
4590	REAL(wp) :: zc_h2so4 !< H2SO4 conc. (#/cm3) !UNITS!
4591	REAL(wp) :: zc_org !< organic vapour conc. (#/cm3)
4592	REAL(wp) :: zcc_c !< Cunningham correct factor for c = critical (1nm)
4593	REAL(wp) :: zcc_x !< Cunningham correct factor for x = 3nm
4594	REAL(wp) :: zcoags_c !< coagulation sink (1/s) for c = critical (1nm)
4595	REAL(wp) :: zcoags_x !< coagulation sink (1/s) for x = 3nm
4596	REAL(wp) :: zcoagstot !< total particle losses due to coagulation, including condensation
4597	!< and self-coagulation
4598	REAL(wp) :: zcocnv_local !< organic vapour conc. (#/m3)
4599	REAL(wp) :: zcsink !< condensational sink (#/m2)
4600	REAL(wp) :: zcsa_local !< H2SO4 conc. (#/m3)
4601	REAL(wp) :: zcv_c !< mean relative thermal velocity (m/s) for c = critical (1nm)
4602	REAL(wp) :: zcv_x !< mean relative thermal velocity (m/s) for x = 3nm
4603	REAL(wp) :: zdcrit !< diameter of critical cluster (m)
4604	REAL(wp) :: zdelta_vap !< change of H2SO4 and organic vapour concentration (#/m3)
4605	REAL(wp) :: zdfvap !< air diffusion coefficient (m2/s)
4606	REAL(wp) :: zdmean !< mean diameter of existing particles (m)
4607	REAL(wp) :: zeta !< constant: proportional to ratio of CS/GR (m)
4608	!< (condensation sink / growth rate)
4609	REAL(wp) :: zgamma !< proportionality factor ((nm2*m2)/h)
4610	REAL(wp) :: z_gr_clust !< growth rate of formed clusters (nm/h)
4611	REAL(wp) :: z_gr_tot !< total growth rate
4612	REAL(wp) :: zj3 !< number conc. of formed 3nm particles (#/m3)
4613	REAL(wp) :: zjnuc !< nucleation rate at ~1nm (#/m3s)
4614	REAL(wp) :: z_k_eff !< effective cogulation coefficient for freshly nucleated particles
4615	REAL(wp) :: zknud_c !< Knudsen number for c = critical (1nm)
4616	REAL(wp) :: zknud_x !< Knudsen number for x = 3nm
4617	REAL(wp) :: zkocnv !< lever: zkocnv=1 --> organic compounds involved in nucleation
4618	REAL(wp) :: zksa !< lever: zksa=1 --> H2SO4 involved in nucleation
4619	REAL(wp) :: zlambda !< parameter for adjusting the growth rate due to self-coagulation
4620	REAL(wp) :: zm_c !< particle mass (kg) for c = critical (1nm)
4621	REAL(wp) :: zm_para !< Parameter m for calculating the coagulation sink (Eq. 5&6 in
4622	!< Lehtinen et al. 2007)
4623	REAL(wp) :: zm_x !< particle mass (kg) for x = 3nm
4624	REAL(wp) :: zmfp !< mean free path of condesing vapour(m)
4625	REAL(wp) :: zmixnh3 !< ammonia mixing ratio (ppt)
4626	REAL(wp) :: zmyy !< gas dynamic viscosity (N*s/m2)
4627	REAL(wp) :: z_n_nuc !< number of clusters/particles at the size range d1-dx (#/m3)
4628	REAL(wp) :: znoc !< number of organic molecules in critical cluster
4629	REAL(wp) :: znsa !< number of H2SO4 molecules in critical cluster
4630
4631	REAL(wp), INTENT(in) :: pc_nh3 !< ammonia concentration (#/m3)
4632	REAL(wp), INTENT(in) :: pc_ocnv !< conc. of non-volatile OC (#/m3)
4633	REAL(wp), INTENT(in) :: pc_sa !< sulphuric acid conc. (#/m3)
4634	REAL(wp), INTENT(in) :: ppres !< ambient air pressure (Pa)
4635	REAL(wp), INTENT(in) :: prh !< ambient rel. humidity [0-1]
4636	REAL(wp), INTENT(in) :: ptemp !< ambient temperature (K)
4637	REAL(wp), INTENT(in) :: ptstep !< time step (s) of SALSA
4638
4639	REAL(wp), INTENT(inout) :: pj3n3(2) !< formation mass rate of molecules (molec/m3s) for
4640	!< 1: H2SO4 and 2: organic vapour
4641
4642	REAL(wp), INTENT(out) :: pxocnv !< ratio of non-volatile organic vapours in 3 nm particles
4643	REAL(wp), INTENT(out) :: pxsa !< ratio of H2SO4 in 3 nm aerosol particles
4644
4645	REAL(wp), DIMENSION(nbins_aerosol) :: zbeta !< transitional correction factor
4646	REAL(wp), DIMENSION(nbins_aerosol) :: zcc_2 !< Cunningham correct factor:2
4647	REAL(wp), DIMENSION(nbins_aerosol) :: zcv_2 !< mean relative thermal velocity (m/s): 2
4648	REAL(wp), DIMENSION(nbins_aerosol) :: zcv_c2 !< average velocity after coagulation: c & 2
4649	REAL(wp), DIMENSION(nbins_aerosol) :: zcv_x2 !< average velocity after coagulation: x & 2
4650	REAL(wp), DIMENSION(nbins_aerosol) :: zdc_2 !< particle diffusion coefficient (m2/s): 2
4651	REAL(wp), DIMENSION(nbins_aerosol) :: zdc_c !< particle diffusion coefficient (m2/s): c
4652	REAL(wp), DIMENSION(nbins_aerosol) :: zdc_c2 !< sum of diffusion coef. for c and 2
4653	REAL(wp), DIMENSION(nbins_aerosol) :: zdc_x !< particle diffusion coefficient (m2/s): x
4654	REAL(wp), DIMENSION(nbins_aerosol) :: zdc_x2 !< sum of diffusion coef. for: x & 2
4655	REAL(wp), DIMENSION(nbins_aerosol) :: zgamma_f_2 !< zgamma_f for calculating zomega
4656	REAL(wp), DIMENSION(nbins_aerosol) :: zgamma_f_c !< zgamma_f for calculating zomega
4657	REAL(wp), DIMENSION(nbins_aerosol) :: zgamma_f_x !< zgamma_f for calculating zomega
4658	REAL(wp), DIMENSION(nbins_aerosol) :: z_k_c2 !< coagulation coef. in the continuum
4659	!< regime: c & 2
4660	REAL(wp), DIMENSION(nbins_aerosol) :: z_k_x2 !< coagulation coef. in the continuum
4661	!< regime: x & 2
4662	REAL(wp), DIMENSION(nbins_aerosol) :: zknud !< particle Knudsen number
4663	REAL(wp), DIMENSION(nbins_aerosol) :: zknud_2 !< particle Knudsen number: 2
4664	REAL(wp), DIMENSION(nbins_aerosol) :: zm_2 !< particle mass (kg): 2
4665	REAL(wp), DIMENSION(nbins_aerosol) :: zomega_2c !< zomega (m) for calculating zsigma: c & 2
4666	REAL(wp), DIMENSION(nbins_aerosol) :: zomega_2x !< zomega (m) for calculating zsigma: x & 2
4667	REAL(wp), DIMENSION(nbins_aerosol) :: zomega_c !< zomega (m) for calculating zsigma: c
4668	REAL(wp), DIMENSION(nbins_aerosol) :: zomega_x !< zomega (m) for calculating zsigma: x
4669	REAL(wp), DIMENSION(nbins_aerosol) :: z_r_c2 !< sum of the radii: c & 2
4670	REAL(wp), DIMENSION(nbins_aerosol) :: z_r_x2 !< sum of the radii: x & 2
4671	REAL(wp), DIMENSION(nbins_aerosol) :: zsigma_c2 !<
4672	REAL(wp), DIMENSION(nbins_aerosol) :: zsigma_x2 !<
4673
4674	TYPE(t_section), DIMENSION(nbins_aerosol), INTENT(inout) :: paero !< aerosol properties
4675	!
4676	!-- 1) Nucleation rate (zjnuc) and diameter of critical cluster (zdcrit)
4677	zjnuc = 0.0_wp
4678	znsa = 0.0_wp
4679	znoc = 0.0_wp
4680	zdcrit = 0.0_wp
4681	zksa = 0.0_wp
4682	zkocnv = 0.0_wp
4683
4684	SELECT CASE ( nsnucl )
4685	!
4686	!-- Binary H2SO4-H2O nucleation
4687	CASE(1)
4688
4689	zc_h2so4 = pc_sa * 1.0E-6_wp ! sulphuric acid conc. to #/cm3
4690	CALL binnucl( zc_h2so4, ptemp, prh, zjnuc, znsa, znoc, zdcrit, zksa, zkocnv )
4691	!
4692	!-- Activation type nucleation
4693	CASE(2)
4694
4695	zc_h2so4 = pc_sa * 1.0E-6_wp ! sulphuric acid conc. to #/cm3
4696	CALL binnucl( zc_h2so4, ptemp, prh, zjnuc, znsa, znoc, zdcrit, zksa, zkocnv )
4697	CALL actnucl( pc_sa, zjnuc, zdcrit, znsa, znoc, zksa, zkocnv, act_coeff )
4698	!
4699	!-- Kinetically limited nucleation of (NH4)HSO4 clusters
4700	CASE(3)
4701
4702	zc_h2so4 = pc_sa * 1.0E-6_wp ! sulphuric acid conc. to #/cm3
4703	CALL binnucl( zc_h2so4, ptemp, prh, zjnuc, znsa, znoc, zdcrit, zksa, zkocnv )
4704	CALL kinnucl( zc_h2so4, zjnuc, zdcrit, znsa, znoc, zksa, zkocnv )
4705	!
4706	!-- Ternary H2SO4-H2O-NH3 nucleation
4707	CASE(4)
4708
4709	zmixnh3 = pc_nh3 * ptemp * argas / ( ppres * avo )
4710	zc_h2so4 = pc_sa * 1.0E-6_wp ! sulphuric acid conc. to #/cm3
4711	CALL ternucl( zc_h2so4, zmixnh3, ptemp, prh, zjnuc, znsa, znoc, zdcrit, zksa, zkocnv )
4712	!
4713	!-- Organic nucleation, J~[ORG] or J~[ORG]**2
4714	CASE(5)
4715
4716	zc_org = pc_ocnv * 1.0E-6_wp ! conc. of non-volatile OC to #/cm3
4717	zc_h2so4 = pc_sa * 1.0E-6_wp ! sulphuric acid conc. to #/cm3
4718	CALL binnucl( zc_h2so4, ptemp, prh, zjnuc, znsa, znoc, zdcrit, zksa, zkocnv )
4719	CALL orgnucl( pc_ocnv, zjnuc, zdcrit, znsa, znoc, zksa, zkocnv )
4720	!
4721	!-- Sum of H2SO4 and organic activation type nucleation, J~[H2SO4]+[ORG]
4722	CASE(6)
4723
4724	zc_h2so4 = pc_sa * 1.0E-6_wp ! sulphuric acid conc. to #/cm3
4725	CALL binnucl( zc_h2so4, ptemp, prh, zjnuc, znsa, znoc, zdcrit, zksa, zkocnv )
4726	CALL sumnucl( pc_sa, pc_ocnv, zjnuc, zdcrit, znsa, znoc, zksa, zkocnv )
4727	!
4728	!-- Heteromolecular nucleation, J~[H2SO4]*[ORG]
4729	CASE(7)
4730
4731	zc_h2so4 = pc_sa * 1.0E-6_wp ! sulphuric acid conc. to #/cm3
4732	zc_org = pc_ocnv * 1.0E-6_wp ! conc. of non-volatile OC to #/cm3
4733	CALL binnucl( zc_h2so4, ptemp, prh, zjnuc, znsa, znoc, zdcrit, zksa, zkocnv )
4734	CALL hetnucl( zc_h2so4, zc_org, zjnuc, zdcrit, znsa, znoc, zksa, zkocnv )
4735	!
4736	!-- Homomolecular nucleation of H2SO4 and heteromolecular nucleation of H2SO4 and organic vapour,
4737	!-- J~[H2SO4]*2 + [H2SO4][ORG] (EUCAARI project)
4738	CASE(8)
4739	zc_h2so4 = pc_sa * 1.0E-6_wp ! sulphuric acid conc. to #/cm3
4740	zc_org = pc_ocnv * 1.0E-6_wp ! conc. of non-volatile OC to #/cm3
4741	CALL binnucl( zc_h2so4, ptemp, prh, zjnuc, znsa, znoc, zdcrit, zksa, zkocnv )
4742	CALL SAnucl( zc_h2so4, zc_org, zjnuc, zdcrit, znsa, znoc, zksa, zkocnv )
4743	!
4744	!-- Homomolecular nucleation of H2SO4 and organic vapour and heteromolecular nucleation of H2SO4
4745	!-- and organic vapour, J~[H2SO4]*2 + [H2SO4][ORG]+[ORG]**2 (EUCAARI project)
4746	CASE(9)
4747
4748	zc_h2so4 = pc_sa * 1.0E-6_wp ! sulphuric acid conc. to #/cm3
4749	zc_org = pc_ocnv * 1.0E-6_wp ! conc. of non-volatile OC to #/cm3
4750	CALL binnucl( zc_h2so4, ptemp, prh, zjnuc, znsa, znoc, zdcrit, zksa, zkocnv )
4751	CALL SAORGnucl( zc_h2so4, zc_org, zjnuc, zdcrit, znsa, znoc, zksa, zkocnv )
4752
4753	END SELECT
4754
4755	zcsa_local = pc_sa
4756	zcocnv_local = pc_ocnv
4757	!
4758	!-- 2) Change of particle and gas concentrations due to nucleation
4759	!
4760	!-- 2.1) Check that there is enough H2SO4 and organic vapour to produce the nucleation
4761	IF ( nsnucl <= 4 ) THEN
4762	!
4763	!-- If the chosen nucleation scheme is 1-4, nucleation occurs only due to H2SO4. All of the total
4764	!-- vapour concentration that is taking part to the nucleation is there for sulphuric acid
4765	!-- (sa = H2SO4) and non-volatile organic vapour is zero.
4766	pxsa = 1.0_wp ! ratio of sulphuric acid in 3nm particles
4767	pxocnv = 0.0_wp ! ratio of non-volatile origanic vapour
4768	! in 3nm particles
4769	ELSEIF ( nsnucl > 4 ) THEN
4770	!
4771	!-- If the chosen nucleation scheme is 5-9, nucleation occurs due to organic vapour or the
4772	!-- combination of organic vapour and H2SO4. The number of needed molecules depends on the chosen
4773	!-- nucleation type and it has an effect also on the minimum ratio of the molecules present.
4774	IF ( pc_sa * znsa + pc_ocnv * znoc < 1.E-14_wp ) THEN
4775	pxsa = 0.0_wp
4776	pxocnv = 0.0_wp
4777	ELSE
4778	pxsa = pc_sa * znsa / ( pc_sa * znsa + pc_ocnv * znoc )
4779	pxocnv = pc_ocnv * znoc / ( pc_sa * znsa + pc_ocnv * znoc )
4780	ENDIF
4781	ENDIF
4782	!
4783	!-- The change in total vapour concentration is the sum of the concentrations of the vapours taking
4784	!-- part to the nucleation (depends on the chosen nucleation scheme)
4785	zdelta_vap = MIN( zjnuc * ( znoc + znsa ), ( pc_ocnv * zkocnv + pc_sa * zksa ) / ptstep )
4786	!
4787	!-- Nucleation rate J at ~1nm (#/m3s)
4788	zjnuc = zdelta_vap / ( znoc + znsa )
4789	!
4790	!-- H2SO4 concentration after nucleation (#/m3)
4791	zcsa_local = MAX( 1.0_wp, pc_sa - zdelta_vap * pxsa )
4792	!
4793	!-- Non-volative organic vapour concentration after nucleation (#/m3)
4794	zcocnv_local = MAX( 1.0_wp, pc_ocnv - zdelta_vap * pxocnv )
4795	!
4796	!-- 2.2) Formation rate of 3 nm particles (Kerminen & Kulmala, 2002)
4797	!
4798	!-- Growth rate by H2SO4 and organic vapour (nm/h, Eq. 21)
4799	z_gr_clust = 2.3623E-15_wp * SQRT( ptemp ) * ( zcsa_local + zcocnv_local )
4800	!
4801	!-- 2.2.2) Condensational sink of pre-existing particle population
4802	!
4803	!-- Diffusion coefficient (m2/s)
4804	zdfvap = 5.1111E-10_wp * ptemp*1.75_wp ( p_0 + 1325.0_wp ) / ppres
4805	!
4806	!-- Mean free path of condensing vapour (m) (Jacobson (2005), Eq. 15.25 and 16.29)
4807	zmfp = 3.0_wp * zdfvap * SQRT( pi * amh2so4 / ( 8.0_wp * argas * ptemp ) )
4808	!
4809	!-- Knudsen number
4810	zknud = 2.0_wp * zmfp / ( paero(:)%dwet + d_sa )
4811	!
4812	!-- Transitional regime correction factor (zbeta) according to Fuchs and Sutugin (1971) (Eq. 4 in
4813	!-- Kerminen and Kulmala, 2002)
4814	zbeta = ( zknud + 1.0_wp) / ( 0.377_wp * zknud + 1.0_wp + 4.0_wp / ( 3.0_wp * massacc ) * &
4815	( zknud + zknud**2 ) )
4816	!
4817	!-- Condensational sink (#/m2, Eq. 3)
4818	zcsink = SUM( paero(:)%dwet * zbeta * paero(:)%numc )
4819	!
4820	!-- 2.2.3) Parameterised formation rate of detectable 3 nm particles (i.e. J3)
4821	IF ( nj3 == 1 ) THEN ! Kerminen and Kulmala (2002)
4822	!
4823	!-- Constants needed for the parameterisation: dapp = 3 nm and dens_nuc = 1830 kg/m3
4824	IF ( zcsink < 1.0E-30_wp ) THEN
4825	zeta = 0._dp
4826	ELSE
4827	!
4828	!-- Mean diameter of backgroud population (nm)
4829	zdmean = 1.0_wp / SUM( paero(:)%numc ) * SUM( paero(:)%numc * paero(:)%dwet ) * 1.0E+9_wp
4830	!
4831	!-- Proportionality factor (nm2*m2/h) (Eq. 22)
4832	zgamma = 0.23_wp * ( zdcrit * 1.0E+9_wp )*0.2_wp ( zdmean / 150.0_wp )*0.048_wp &
4833	( ptemp / 293.0_wp )*( -0.75_wp ) ( arhoh2so4 / 1000.0_wp )**( -0.33_wp )
4834	!
4835	!-- Factor eta (nm, Eq. 11)
4836	zeta = MIN( zgamma * zcsink / z_gr_clust, zdcrit * 1.0E11_wp )
4837	ENDIF
4838	!
4839	!-- Number conc. of clusters surviving to 3 nm in a time step (#/m3, Eq.14)
4840	zj3 = zjnuc * EXP( MIN( 0.0_wp, zeta / 3.0_wp - zeta / ( zdcrit * 1.0E9_wp ) ) )
4841
4842	ELSEIF ( nj3 > 1 ) THEN ! Lehtinen et al. (2007) or Anttila et al. (2010)
4843	!
4844	!-- Defining the parameter m (zm_para) for calculating the coagulation sink onto background
4845	!-- particles (Eq. 5&6 in Lehtinen et al. 2007). The growth is investigated between
4846	!-- [d1,reglim(1)] = [zdcrit,3nm] and m = LOG( CoagS_dx / CoagX_zdcrit ) / LOG( reglim / zdcrit )
4847	!-- (Lehtinen et al. 2007, Eq. 6).
4848	!-- The steps for the coagulation sink for reglim = 3nm and zdcrit ~= 1nm are explained in
4849	!-- Kulmala et al. (2001). The particles of diameter zdcrit ~1.14 nm and reglim = 3nm are both
4850	!-- in turn the "number 1" variables (Kulmala et al. 2001).
4851	!-- c = critical (1nm), x = 3nm, 2 = wet or mean droplet
4852	!
4853	!-- Sum of the radii, R12 = R1 + R2 (m) of two particles 1 and 2
4854	z_r_c2 = zdcrit / 2.0_wp + paero(:)%dwet / 2.0_wp
4855	z_r_x2 = reglim(1) / 2.0_wp + paero(:)%dwet / 2.0_wp
4856	!
4857	!-- Particle mass (kg) (comes only from H2SO4)
4858	zm_c = 4.0_wp / 3.0_wp * pi * ( zdcrit / 2.0_wp )*3 arhoh2so4
4859	zm_x = 4.0_wp / 3.0_wp * pi * ( reglim(1) / 2.0_wp )*3 arhoh2so4
4860	zm_2 = 4.0_wp / 3.0_wp * pi * ( 0.5_wp * paero(:)%dwet )*3 arhoh2so4
4861	!
4862	!-- Mean relative thermal velocity between the particles (m/s)
4863	zcv_c = SQRT( 8.0_wp * abo * ptemp / ( pi * zm_c ) )
4864	zcv_x = SQRT( 8.0_wp * abo * ptemp / ( pi * zm_x ) )
4865	zcv_2 = SQRT( 8.0_wp * abo * ptemp / ( pi * zm_2 ) )
4866	!
4867	!-- Average velocity after coagulation
4868	zcv_c2(:) = SQRT( zcv_c2 + zcv_22 )
4869	zcv_x2(:) = SQRT( zcv_x2 + zcv_22 )
4870	!
4871	!-- Knudsen number (zmfp = mean free path of condensing vapour)
4872	zknud_c = 2.0_wp * zmfp / zdcrit
4873	zknud_x = 2.0_wp * zmfp / reglim(1)
4874	zknud_2(:) = MAX( 0.0_wp, 2.0_wp * zmfp / paero(:)%dwet )
4875	!
4876	!-- Cunningham correction factors (Allen and Raabe, 1985)
4877	zcc_c = 1.0_wp + zknud_c * ( 1.142_wp + 0.558_wp * EXP( -0.999_wp / zknud_c ) )
4878	zcc_x = 1.0_wp + zknud_x * ( 1.142_wp + 0.558_wp * EXP( -0.999_wp / zknud_x ) )
4879	zcc_2(:) = 1.0_wp + zknud_2(:) * ( 1.142_wp + 0.558_wp * EXP( -0.999_wp / zknud_2(:) ) )
4880	!
4881	!-- Gas dynamic viscosity (Ns/m2). Here, viscocity(air @20C) = 1.81e-5_dp N/m2 s (Hinds, p. 25)
4882	zmyy = 1.81E-5_wp * ( ptemp / 293.0_wp )**0.74_wp
4883	!
4884	!-- Particle diffusion coefficient (m2/s) (continuum regime)
4885	zdc_c(:) = abo * ptemp * zcc_c / ( 3.0_wp * pi * zmyy * zdcrit )
4886	zdc_x(:) = abo * ptemp * zcc_x / ( 3.0_wp * pi * zmyy * reglim(1) )
4887	zdc_2(:) = abo * ptemp * zcc_2(:) / ( 3.0_wp * pi * zmyy * paero(:)%dwet )
4888	!
4889	!-- D12 = D1+D2 (Seinfield and Pandis, 2nd ed. Eq. 13.38)
4890	zdc_c2 = zdc_c + zdc_2
4891	zdc_x2 = zdc_x + zdc_2
4892	!
4893	!-- zgamma_f = 8*D/pi/zcv (m) for calculating zomega (Fuchs, 1964)
4894	zgamma_f_c = 8.0_wp * zdc_c / pi / zcv_c
4895	zgamma_f_x = 8.0_wp * zdc_x / pi / zcv_x
4896	zgamma_f_2 = 8.0_wp * zdc_2 / pi / zcv_2
4897	!
4898	!-- zomega (m) for calculating zsigma
4899	zomega_c = ( ( z_r_c2 + zgamma_f_c )3 - ( z_r_c2 2 + zgamma_f_c )**1.5_wp ) / &
4900	( 3.0_wp * z_r_c2 * zgamma_f_c ) - z_r_c2
4901	zomega_x = ( ( z_r_x2 + zgamma_f_x )3 - ( z_r_x22 + zgamma_f_x )** 1.5_wp ) / &
4902	( 3.0_wp * z_r_x2 * zgamma_f_x ) - z_r_x2
4903	zomega_2c = ( ( z_r_c2 + zgamma_f_2 )3 - ( z_r_c22 + zgamma_f_2 )**1.5_wp ) / &
4904	( 3.0_wp * z_r_c2 * zgamma_f_2 ) - z_r_c2
4905	zomega_2x = ( ( z_r_x2 + zgamma_f_2 )3 - ( z_r_x22 + zgamma_f_2 )**1.5_wp ) / &
4906	( 3.0_wp * z_r_x2 * zgamma_f_2 ) - z_r_x2
4907	!
4908	!-- The distance (m) at which the two fluxes are matched (condensation and coagulation sinks)
4909	zsigma_c2 = SQRT( zomega_c2 + zomega_2c2 )
4910	zsigma_x2 = SQRT( zomega_x2 + zomega_2x2 )
4911	!
4912	!-- Coagulation coefficient in the continuum regime (m*m2/s, Eq. 17 in Kulmala et al., 2001)
4913	z_k_c2 = 4.0_wp * pi * z_r_c2 * zdc_c2 / ( z_r_c2 / ( z_r_c2 + zsigma_c2 ) + &
4914	4.0_wp * zdc_c2 / ( zcv_c2 * z_r_c2 ) )
4915	z_k_x2 = 4.0_wp * pi * z_r_x2 * zdc_x2 / ( z_r_x2 / ( z_r_x2 + zsigma_x2 ) + &
4916	4.0_wp * zdc_x2 / ( zcv_x2 * z_r_x2 ) )
4917	!
4918	!-- Coagulation sink (1/s, Eq. 16 in Kulmala et al., 2001)
4919	zcoags_c = MAX( 1.0E-20_wp, SUM( z_k_c2 * paero(:)%numc ) )
4920	zcoags_x = MAX( 1.0E-20_wp, SUM( z_k_x2 * paero(:)%numc ) )
4921	!
4922	!-- Parameter m for calculating the coagulation sink onto background particles (Eq. 5&6 in
4923	!-- Lehtinen et al. 2007)
4924	zm_para = LOG( zcoags_x / zcoags_c ) / LOG( reglim(1) / zdcrit )
4925	!
4926	!-- Parameter gamma for calculating the formation rate J of particles having
4927	!-- a diameter zdcrit < d < reglim(1) (Anttila et al. 2010, eq. 5 or Lehtinen et al.,2007, eq. 7)
4928	zgamma = ( ( ( reglim(1) / zdcrit )**( zm_para + 1.0_wp ) ) - 1.0_wp ) / ( zm_para + 1.0_wp )
4929
4930	IF ( nj3 == 2 ) THEN ! Lehtinen et al. (2007): coagulation sink
4931	!
4932	!-- Formation rate J before iteration (#/m3s)
4933	zj3 = zjnuc * EXP( MIN( 0.0_wp, -zgamma * zdcrit * zcoags_c / ( z_gr_clust * 1.0E-9_wp / &
4934	60.0_wp**2 ) ) )
4935
4936	ELSEIF ( nj3 == 3 ) THEN ! Anttila et al. (2010): coagulation sink and self-coag.
4937	!
4938	!-- If air is polluted, the self-coagulation becomes important. Self-coagulation of small
4939	!-- particles < 3 nm.
4940	!
4941	!-- "Effective" coagulation coefficient between freshly-nucleated particles:
4942	z_k_eff = 5.0E-16_wp ! m3/s
4943	!
4944	!-- zlambda parameter for "adjusting" the growth rate due to the self-coagulation
4945	zlambda = 6.0_wp
4946
4947	IF ( reglim(1) >= 10.0E-9_wp ) THEN ! for particles >10 nm:
4948	z_k_eff = 5.0E-17_wp
4949	zlambda = 3.0_wp
4950	ENDIF
4951	!
4952	!-- Initial values for coagulation sink and growth rate (m/s)
4953	zcoagstot = zcoags_c
4954	z_gr_tot = z_gr_clust * 1.0E-9_wp / 60.0_wp**2
4955	!
4956	!-- Number of clusters/particles at the size range [d1,dx] (#/m3):
4957	z_n_nuc = zjnuc / zcoagstot !< Initial guess
4958	!
4959	!-- Coagulation sink and growth rate due to self-coagulation:
4960	DO iteration = 1, 5
4961	zcoagstot = zcoags_c + z_k_eff * z_n_nuc * 1.0E-6_wp ! (1/s, Anttila et al., eq. 1)
4962	z_gr_tot = z_gr_clust * 2.77777777E-7_wp + 1.5708E-6_wp * zlambda * zdcrit*3 &
4963	( z_n_nuc * 1.0E-6_wp ) * zcv_c * avo * 2.77777777E-7_wp ! (Eq. 3)
4964	zeta = - zcoagstot / ( ( zm_para + 1.0_wp ) * z_gr_tot * ( zdcrit**zm_para ) ) ! (Eq. 7b)
4965	!
4966	!-- Calculate Eq. 7a (Taylor series for the number of particles between [d1,dx])
4967	z_n_nuc = z_n_nuc_tayl( zdcrit, reglim(1), zm_para, zjnuc, zeta, z_gr_tot )
4968	ENDDO
4969	!
4970	!-- Calculate the final values with new z_n_nuc:
4971	zcoagstot = zcoags_c + z_k_eff * z_n_nuc * 1.0E-6_wp ! (1/s)
4972	z_gr_tot = z_gr_clust * 1.0E-9_wp / 3600.0_wp + 1.5708E-6_wp * zlambda * zdcrit*3 &
4973	( z_n_nuc * 1.0E-6_wp ) * zcv_c * avo * 1.0E-9_wp / 3600.0_wp !< (m/s)
4974	zj3 = zjnuc * EXP( MIN( 0.0_wp, -zgamma * zdcrit * zcoagstot / z_gr_tot ) ) ! (#/m3s, Eq. 5a)
4975
4976	ENDIF
4977	ENDIF
4978	!
4979	!-- If J3 very small (< 1 #/cm3), neglect particle formation. In real atmosphere this would mean
4980	!-- that clusters form but coagulate to pre-existing particles who gain sulphate. Since
4981	!-- CoagS ~ CS (4piDCS'), we do not* update H2SO4 concentration here but let condensation take
4982	!-- care of it. Formation mass rate of molecules (molec/m3s) for 1: H2SO4 and 2: organic vapour
4983	pj3n3(1) = zj3 * n3 * pxsa
4984	pj3n3(2) = zj3 * n3 * pxocnv
4985
4986	END SUBROUTINE nucleation
4987
4988	!------------------------------------------------------------------------------!
4989	! Description:
4990	! ------------
4991	!> Calculate the nucleation rate and the size of critical clusters assuming
4992	!> binary nucleation.
4993	!> Parametrisation according to Vehkamaki et al. (2002), J. Geophys. Res.,
4994	!> 107(D22), 4622. Called from subroutine nucleation.
4995	!------------------------------------------------------------------------------!
4996	SUBROUTINE binnucl( pc_sa, ptemp, prh, pnuc_rate, pn_crit_sa, pn_crit_ocnv, pd_crit, pk_sa, &
4997	pk_ocnv )
4998
4999	IMPLICIT NONE
5000
5001	REAL(wp) :: za !<
5002	REAL(wp) :: zb !<
5003	REAL(wp) :: zc !<
5004	REAL(wp) :: zcoll !<
5005	REAL(wp) :: zlogsa !< LOG( zpcsa )
5006	REAL(wp) :: zlogrh !< LOG( zrh )
5007	REAL(wp) :: zm1 !<
5008	REAL(wp) :: zm2 !<
5009	REAL(wp) :: zma !<
5010	REAL(wp) :: zmw !<
5011	REAL(wp) :: zntot !< number of molecules in critical cluster
5012	REAL(wp) :: zpcsa !< sulfuric acid concentration
5013	REAL(wp) :: zrh !< relative humidity
5014	REAL(wp) :: zroo !<
5015	REAL(wp) :: zt !< temperature
5016	REAL(wp) :: zv1 !<
5017	REAL(wp) :: zv2 !<
5018	REAL(wp) :: zx !< mole fraction of sulphate in critical cluster
5019	REAL(wp) :: zxmass !<
5020
5021	REAL(wp), INTENT(in) :: pc_sa !< H2SO4 conc. (#/cm3)
5022	REAL(wp), INTENT(in) :: prh !< relative humidity [0-1
5023	REAL(wp), INTENT(in) :: ptemp !< ambient temperature (K)
5024
5025	REAL(wp), INTENT(out) :: pnuc_rate !< nucleation rate (#/(m3 s))
5026	REAL(wp), INTENT(out) :: pn_crit_sa !< number of H2SO4 molecules in cluster (#)
5027	REAL(wp), INTENT(out) :: pn_crit_ocnv !< number of organic molecules in cluster (#)
5028	REAL(wp), INTENT(out) :: pd_crit !< diameter of critical cluster (m)
5029	REAL(wp), INTENT(out) :: pk_sa !< Lever: if pk_sa = 1, H2SO4 is involved in nucleation.
5030	REAL(wp), INTENT(out) :: pk_ocnv !< Lever: if pk_ocnv = 1, organic compounds are involved
5031
5032	pnuc_rate = 0.0_wp
5033	pd_crit = 1.0E-9_wp
5034	!
5035	!-- 1) Checking that we are in the validity range of the parameterization
5036	zpcsa = MAX( pc_sa, 1.0E4_wp )
5037	zpcsa = MIN( zpcsa, 1.0E11_wp )
5038	zrh = MAX( prh, 0.0001_wp )
5039	zrh = MIN( zrh, 1.0_wp )
5040	zt = MAX( ptemp, 190.15_wp )
5041	zt = MIN( zt, 300.15_wp )
5042
5043	zlogsa = LOG( zpcsa )
5044	zlogrh = LOG( prh )
5045	!
5046	!-- 2) Mole fraction of sulphate in a critical cluster (Eq. 11)
5047	zx = 0.7409967177282139_wp - 0.002663785665140117_wp * zt + &
5048	0.002010478847383187_wp * zlogrh - 0.0001832894131464668_wp* zt * zlogrh + &
5049	0.001574072538464286_wp * zlogrh*2 - 0.00001790589121766952_wp zt * zlogrh**2 + &
5050	0.0001844027436573778_wp * zlogrh*3 - 1.503452308794887E-6_wp zt * zlogrh**3 - &
5051	0.003499978417957668_wp * zlogsa + 0.0000504021689382576_wp * zt * zlogsa
5052	!
5053	!-- 3) Nucleation rate (Eq. 12)
5054	pnuc_rate = 0.1430901615568665_wp + 2.219563673425199_wp * zt - &
5055	0.02739106114964264_wp * zt*2 + 0.00007228107239317088_wp zt**3 + &
5056	5.91822263375044_wp / zx + 0.1174886643003278_wp * zlogrh + &
5057	0.4625315047693772_wp * zt * zlogrh - 0.01180591129059253_wp * zt*2 zlogrh + &
5058	0.0000404196487152575_wp * zt*3 zlogrh + &
5059	( 15.79628615047088_wp * zlogrh ) / zx - 0.215553951893509_wp * zlogrh**2 - &
5060	0.0810269192332194_wp * zt * zlogrh**2 + &
5061	0.001435808434184642_wp * zt*2 zlogrh**2 - &
5062	4.775796947178588E-6_wp * zt*3 zlogrh**2 - &
5063	( 2.912974063702185_wp * zlogrh*2 ) / zx - 3.588557942822751_wp zlogrh**3 + &
5064	0.04950795302831703_wp * zt * zlogrh**3 - &
5065	0.0002138195118737068_wp * zt*2 zlogrh**3 + &
5066	3.108005107949533E-7_wp * zt*3 zlogrh**3 - &
5067	( 0.02933332747098296_wp * zlogrh*3 ) / zx + 1.145983818561277_wp zlogsa - &
5068	0.6007956227856778_wp * zt * zlogsa + 0.00864244733283759_wp * zt*2 zlogsa - &
5069	0.00002289467254710888_wp * zt*3 zlogsa - &
5070	( 8.44984513869014_wp * zlogsa ) / zx + 2.158548369286559_wp * zlogrh * zlogsa + &
5071	0.0808121412840917_wp * zt * zlogrh * zlogsa - &
5072	0.0004073815255395214_wp * zt*2 zlogrh * zlogsa - &
5073	4.019572560156515E-7_wp * zt*3 zlogrh * zlogsa + &
5074	( 0.7213255852557236_wp * zlogrh * zlogsa ) / zx + &
5075	1.62409850488771_wp * zlogrh*2 zlogsa - &
5076	0.01601062035325362_wp * zt * zlogrh*2 zlogsa + &
5077	0.00003771238979714162_wpzt2 zlogrh*2 zlogsa + &
5078	3.217942606371182E-8_wp * zt*3 zlogrh*2 zlogsa - &
5079	( 0.01132550810022116_wp * zlogrh*2 zlogsa ) / zx + &
5080	9.71681713056504_wp * zlogsa*2 - 0.1150478558347306_wp zt * zlogsa**2 + &
5081	0.0001570982486038294_wp * zt*2 zlogsa**2 + &
5082	4.009144680125015E-7_wp * zt*3 zlogsa**2 + &
5083	( 0.7118597859976135_wp * zlogsa**2 ) / zx - &
5084	1.056105824379897_wp * zlogrh * zlogsa**2 + &
5085	0.00903377584628419_wp * zt * zlogrh * zlogsa**2 - &
5086	0.00001984167387090606_wp * zt*2 zlogrh * zlogsa**2 + &
5087	2.460478196482179E-8_wp * zt*3 zlogrh * zlogsa**2 - &
5088	( 0.05790872906645181_wp * zlogrh * zlogsa**2 ) / zx - &
5089	0.1487119673397459_wp * zlogsa*3 + 0.002835082097822667_wp zt * zlogsa**3 - &
5090	9.24618825471694E-6_wp * zt*2 zlogsa**3 + &
5091	5.004267665960894E-9_wp * zt*3 zlogsa**3 - &
5092	( 0.01270805101481648_wp * zlogsa**3 ) / zx
5093	!
5094	!-- Nucleation rate in #/(cm3 s)
5095	pnuc_rate = EXP( pnuc_rate )
5096	!
5097	!-- Check the validity of parameterization
5098	IF ( pnuc_rate < 1.0E-7_wp ) THEN
5099	pnuc_rate = 0.0_wp
5100	pd_crit = 1.0E-9_wp
5101	ENDIF
5102	!
5103	!-- 4) Total number of molecules in the critical cluster (Eq. 13)
5104	zntot = - 0.002954125078716302_wp - 0.0976834264241286_wp * zt + &
5105	0.001024847927067835_wp * zt*2 - 2.186459697726116E-6_wp zt**3 - &
5106	0.1017165718716887_wp / zx - 0.002050640345231486_wp * zlogrh - &
5107	0.007585041382707174_wp * zt * zlogrh + 0.0001926539658089536_wp * zt*2 zlogrh - &
5108	6.70429719683894E-7_wp * zt*3 zlogrh - ( 0.2557744774673163_wp * zlogrh ) / zx + &
5109	0.003223076552477191_wp * zlogrh*2 + 0.000852636632240633_wp zt * zlogrh**2 - &
5110	0.00001547571354871789_wp * zt*2 zlogrh**2 + &
5111	5.666608424980593E-8_wp * zt*3 zlogrh**2 + &
5112	( 0.03384437400744206_wp * zlogrh**2 ) / zx + &
5113	0.04743226764572505_wp * zlogrh*3 - 0.0006251042204583412_wp zt * zlogrh**3 + &
5114	2.650663328519478E-6_wp * zt*2 zlogrh**3 - &
5115	3.674710848763778E-9_wp * zt*3 zlogrh**3 - &
5116	( 0.0002672510825259393_wp * zlogrh*3 ) / zx - 0.01252108546759328_wp zlogsa + &
5117	0.005806550506277202_wp * zt * zlogsa - 0.0001016735312443444_wp * zt*2 zlogsa + &
5118	2.881946187214505E-7_wp * zt*3 zlogsa + ( 0.0942243379396279_wp * zlogsa ) / zx - &
5119	0.0385459592773097_wp * zlogrh * zlogsa - &
5120	0.0006723156277391984_wp * zt * zlogrh * zlogsa + &
5121	2.602884877659698E-6_wp * zt*2 zlogrh * zlogsa + &
5122	1.194163699688297E-8_wp * zt*3 zlogrh * zlogsa - &
5123	( 0.00851515345806281_wp * zlogrh * zlogsa ) / zx - &
5124	0.01837488495738111_wp * zlogrh*2 zlogsa + &
5125	0.0001720723574407498_wp * zt * zlogrh*2 zlogsa - &
5126	3.717657974086814E-7_wp * zt*2 zlogrh*2 zlogsa - &
5127	5.148746022615196E-10_wp * zt*3 zlogrh*2 zlogsa + &
5128	( 0.0002686602132926594_wp * zlogrh*2 zlogsa ) / zx - &
5129	0.06199739728812199_wp * zlogsa*2 + 0.000906958053583576_wp zt * zlogsa**2 - &
5130	9.11727926129757E-7_wp * zt*2 zlogsa**2 - &
5131	5.367963396508457E-9_wp * zt*3 zlogsa**2 - &
5132	( 0.007742343393937707_wp * zlogsa**2 ) / zx + &
5133	0.0121827103101659_wp * zlogrh * zlogsa**2 - &
5134	0.0001066499571188091_wp * zt * zlogrh * zlogsa**2 + &
5135	2.534598655067518E-7_wp * zt*2 zlogrh * zlogsa**2 - &
5136	3.635186504599571E-10_wp * zt*3 zlogrh * zlogsa**2 + &
5137	( 0.0006100650851863252_wp * zlogrh * zlogsa **2 ) / zx + &
5138	0.0003201836700403512_wp * zlogsa*3 - 0.0000174761713262546_wp zt * zlogsa**3 + &
5139	6.065037668052182E-8_wp * zt*2 zlogsa**3 - &
5140	1.421771723004557E-11_wp * zt*3 zlogsa**3 + &
5141	( 0.0001357509859501723_wp * zlogsa**3 ) / zx
5142	zntot = EXP( zntot ) ! in #
5143	!
5144	!-- 5) Size of the critical cluster pd_crit (m) (diameter) (Eq. 14)
5145	pn_crit_sa = zx * zntot
5146	pd_crit = 2.0E-9_wp * EXP( -1.6524245_wp + 0.42316402_wp * zx + 0.33466487_wp * LOG( zntot ) )
5147	!
5148	!-- 6) Organic compounds not involved when binary nucleation is assumed
5149	pn_crit_ocnv = 0.0_wp ! number of organic molecules
5150	pk_sa = 1.0_wp ! if = 1, H2SO4 involved in nucleation
5151	pk_ocnv = 0.0_wp ! if = 1, organic compounds involved
5152	!
5153	!-- Set nucleation rate to collision rate
5154	IF ( pn_crit_sa < 4.0_wp ) THEN
5155	!
5156	!-- Volumes of the colliding objects
5157	zma = 96.0_wp ! molar mass of SO4 in g/mol
5158	zmw = 18.0_wp ! molar mass of water in g/mol
5159	zxmass = 1.0_wp ! mass fraction of H2SO4
5160	za = 0.7681724_wp + zxmass * ( 2.1847140_wp + zxmass * &
5161	( 7.1630022_wp + zxmass * &
5162	( -44.31447_wp + zxmass * &
5163	( 88.75606 + zxmass * &
5164	( -75.73729_wp + zxmass * 23.43228_wp ) ) ) ) )
5165	zb = 1.808225E-3_wp + zxmass * ( -9.294656E-3_wp + zxmass * &
5166	( -0.03742148_wp + zxmass * &
5167	( 0.2565321_wp + zxmass * &
5168	( -0.5362872_wp + zxmass * &
5169	( 0.4857736 - zxmass * 0.1629592_wp ) ) ) ) )
5170	zc = - 3.478524E-6_wp + zxmass * ( 1.335867E-5_wp + zxmass * &
5171	( 5.195706E-5_wp + zxmass * &
5172	( -3.717636E-4_wp + zxmass * &
5173	( 7.990811E-4_wp + zxmass * &
5174	( -7.458060E-4_wp + zxmass * 2.58139E-4_wp ) ) ) ) )
5175	!
5176	!-- Density for the sulphuric acid solution (Eq. 10 in Vehkamaki)
5177	zroo = ( za + zt * ( zb + zc * zt ) ) * 1.0E+3_wp ! (kg/m^3
5178	zm1 = 0.098_wp ! molar mass of H2SO4 in kg/mol
5179	zm2 = zm1
5180	zv1 = zm1 / avo / zroo ! volume
5181	zv2 = zv1
5182	!
5183	!-- Collision rate
5184	zcoll = zpcsa * zpcsa * ( 3.0_wp * pi / 4.0_wp )*0.16666666_wp &
5185	SQRT( 6.0_wp * argas * zt / zm1 + 6.0_wp * argas * zt / zm2 ) * &
5186	( zv10.33333333_wp + zv20.33333333_wp )*2 1.0E+6_wp ! m3 -> cm3
5187	zcoll = MIN( zcoll, 1.0E+10_wp )
5188	pnuc_rate = zcoll ! (#/(cm3 s))
5189
5190	ELSE
5191	pnuc_rate = MIN( pnuc_rate, 1.0E+10_wp )
5192	ENDIF
5193	pnuc_rate = pnuc_rate * 1.0E+6_wp ! (#/(m3 s))
5194
5195	END SUBROUTINE binnucl
5196
5197	!------------------------------------------------------------------------------!
5198	! Description:
5199	! ------------
5200	!> Calculate the nucleation rate and the size of critical clusters assuming
5201	!> ternary nucleation. Parametrisation according to:
5202	!> Napari et al. (2002), J. Chem. Phys., 116, 4221-4227 and
5203	!> Napari et al. (2002), J. Geophys. Res., 107(D19), AAC 6-1-ACC 6-6.
5204	!------------------------------------------------------------------------------!
5205	SUBROUTINE ternucl( pc_sa, pc_nh3, ptemp, prh, pnuc_rate, pn_crit_sa, pn_crit_ocnv, pd_crit, &
5206	pk_sa, pk_ocnv )
5207
5208	IMPLICIT NONE
5209
5210	REAL(wp) :: zlnj !< logarithm of nucleation rate
5211	REAL(wp) :: zlognh3 !< LOG( pc_nh3 )
5212	REAL(wp) :: zlogrh !< LOG( prh )
5213	REAL(wp) :: zlogsa !< LOG( pc_sa )
5214
5215	REAL(wp), INTENT(in) :: pc_nh3 !< ammonia mixing ratio (ppt)
5216	REAL(wp), INTENT(in) :: pc_sa !< H2SO4 conc. (#/cm3)
5217	REAL(wp), INTENT(in) :: prh !< relative humidity [0-1]
5218	REAL(wp), INTENT(in) :: ptemp !< ambient temperature (K)
5219
5220	REAL(wp), INTENT(out) :: pd_crit !< diameter of critical cluster (m)
5221	REAL(wp), INTENT(out) :: pk_ocnv !< if pk_ocnv = 1, organic compounds participate in nucleation
5222	REAL(wp), INTENT(out) :: pk_sa !< if pk_sa = 1, H2SO4 participate in nucleation
5223	REAL(wp), INTENT(out) :: pn_crit_ocnv !< number of organic molecules in cluster (#)
5224	REAL(wp), INTENT(out) :: pn_crit_sa !< number of H2SO4 molecules in cluster (#)
5225	REAL(wp), INTENT(out) :: pnuc_rate !< nucleation rate (#/(m3 s))
5226	!
5227	!-- 1) Checking that we are in the validity range of the parameterization.
5228	!-- Validity of parameterization : DO NOT REMOVE!
5229	IF ( ptemp < 240.0_wp .OR. ptemp > 300.0_wp ) THEN
5230	message_string = 'Invalid input value: ptemp'
5231	CALL message( 'salsa_mod: ternucl', 'PA0648', 1, 2, 0, 6, 0 )
5232	ENDIF
5233	IF ( prh < 0.05_wp .OR. prh > 0.95_wp ) THEN
5234	message_string = 'Invalid input value: prh'
5235	CALL message( 'salsa_mod: ternucl', 'PA0649', 1, 2, 0, 6, 0 )
5236	ENDIF
5237	IF ( pc_sa < 1.0E+4_wp .OR. pc_sa > 1.0E+9_wp ) THEN
5238	message_string = 'Invalid input value: pc_sa'
5239	CALL message( 'salsa_mod: ternucl', 'PA0650', 1, 2, 0, 6, 0 )
5240	ENDIF
5241	IF ( pc_nh3 < 0.1_wp .OR. pc_nh3 > 100.0_wp ) THEN
5242	message_string = 'Invalid input value: pc_nh3'
5243	CALL message( 'salsa_mod: ternucl', 'PA0651', 1, 2, 0, 6, 0 )
5244	ENDIF
5245
5246	zlognh3 = LOG( pc_nh3 )
5247	zlogrh = LOG( prh )
5248	zlogsa = LOG( pc_sa )
5249	!
5250	!-- 2) Nucleation rate (Eq. 7 in Napari et al., 2002: Parameterization of
5251	!-- ternary nucleation of sulfuric acid - ammonia - water.
5252	zlnj = - 84.7551114741543_wp + 0.3117595133628944_wp * prh + &
5253	1.640089605712946_wp * prh * ptemp - 0.003438516933381083_wp * prh * ptemp**2 - &
5254	0.00001097530402419113_wp * prh * ptemp**3 - 0.3552967070274677_wp / zlogsa - &
5255	( 0.06651397829765026_wp * prh ) / zlogsa - ( 33.84493989762471_wp * ptemp ) / zlogsa - &
5256	( 7.823815852128623_wp * prh * ptemp ) / zlogsa + &
5257	( 0.3453602302090915_wp * ptemp**2 ) / zlogsa + &
5258	( 0.01229375748100015_wp * prh * ptemp**2 ) / zlogsa - &
5259	( 0.000824007160514956_wp ptemp*3 ) / zlogsa + &
5260	( 0.00006185539100670249_wp * prh * ptemp**3 ) / zlogsa + &
5261	3.137345238574998_wp * zlogsa + 3.680240980277051_wp * prh * zlogsa - &
5262	0.7728606202085936_wp * ptemp * zlogsa - 0.204098217156962_wp * prh * ptemp * zlogsa + &
5263	0.005612037586790018_wp * ptemp*2 zlogsa + &
5264	0.001062588391907444_wp * prh * ptemp*2 zlogsa - &
5265	9.74575691760229E-6_wp * ptemp*3 zlogsa - &
5266	1.265595265137352E-6_wp * prh * ptemp*3 zlogsa + 19.03593713032114_wp * zlogsa**2 - &
5267	0.1709570721236754_wp * ptemp * zlogsa**2 + &
5268	0.000479808018162089_wp * ptemp*2 zlogsa**2 - &
5269	4.146989369117246E-7_wp * ptemp*3 zlogsa*2 + 1.076046750412183_wp zlognh3 + &
5270	0.6587399318567337_wp * prh * zlognh3 + 1.48932164750748_wp * ptemp * zlognh3 + &
5271	0.1905424394695381_wp * prh * ptemp * zlognh3 - &
5272	0.007960522921316015_wp * ptemp*2 zlognh3 - &
5273	0.001657184248661241_wp * prh * ptemp*2 zlognh3 + &
5274	7.612287245047392E-6_wp * ptemp*3 zlognh3 + &
5275	3.417436525881869E-6_wp * prh * ptemp*3 zlognh3 + &
5276	( 0.1655358260404061_wp * zlognh3 ) / zlogsa + &
5277	( 0.05301667612522116_wp * prh * zlognh3 ) / zlogsa + &
5278	( 3.26622914116752_wp * ptemp * zlognh3 ) / zlogsa - &
5279	( 1.988145079742164_wp * prh * ptemp * zlognh3 ) / zlogsa - &
5280	( 0.04897027401984064_wp * ptemp*2 zlognh3 ) / zlogsa + &
5281	( 0.01578269253599732_wp * prh * ptemp*2 zlognh3 ) / zlogsa + &
5282	( 0.0001469672236351303_wp * ptemp*3 zlognh3 ) / zlogsa - &
5283	( 0.00002935642836387197_wp * prh * ptemp*3 zlognh3 ) / zlogsa + &
5284	6.526451177887659_wp * zlogsa * zlognh3 - &
5285	0.2580021816722099_wp * ptemp * zlogsa * zlognh3 + &
5286	0.001434563104474292_wp * ptemp*2 zlogsa * zlognh3 - &
5287	2.020361939304473E-6_wp * ptemp*3 zlogsa * zlognh3 - &
5288	0.160335824596627_wp * zlogsa*2 zlognh3 + &
5289	0.00889880721460806_wp * ptemp * zlogsa*2 zlognh3 - &
5290	0.00005395139051155007_wp * ptemp*2 zlogsa*2 zlognh3 + &
5291	8.39521718689596E-8_wp * ptemp*3 zlogsa*2 zlognh3 + &
5292	6.091597586754857_wp * zlognh3*2 + 8.5786763679309_wp prh * zlognh3**2 - &
5293	1.253783854872055_wp * ptemp * zlognh3**2 - &
5294	0.1123577232346848_wp * prh * ptemp * zlognh3**2 + &
5295	0.00939835595219825_wp * ptemp*2 zlognh3**2 + &
5296	0.0004726256283031513_wp * prh * ptemp*2 zlognh3**2 - &
5297	0.00001749269360523252_wp * ptemp*3 zlognh3**2 - &
5298	6.483647863710339E-7_wp * prh * ptemp*3 zlognh3**2 + &
5299	( 0.7284285726576598_wp * zlognh3**2 ) / zlogsa + &
5300	( 3.647355600846383_wp * ptemp * zlognh3**2 ) / zlogsa - &
5301	( 0.02742195276078021_wp * ptemp*2 zlognh3**2 ) / zlogsa + &
5302	( 0.00004934777934047135_wp * ptemp*3 zlognh3**2 ) / zlogsa + &
5303	41.30162491567873_wp * zlogsa * zlognh3**2 - &
5304	0.357520416800604_wp * ptemp * zlogsa * zlognh3**2 + &
5305	0.000904383005178356_wp * ptemp*2 zlogsa * zlognh3**2 - &
5306	5.737876676408978E-7_wp * ptemp*3 zlogsa * zlognh3**2 - &
5307	2.327363918851818_wp * zlogsa*2 zlognh3**2 + &
5308	0.02346464261919324_wp * ptemp * zlogsa*2 zlognh3**2 - &
5309	0.000076518969516405_wp * ptemp*2 zlogsa*2 zlognh3**2 + &
5310	8.04589834836395E-8_wp * ptemp*3 zlogsa*2 zlognh3**2 - &
5311	0.02007379204248076_wp * zlogrh - 0.7521152446208771_wp * ptemp * zlogrh + &
5312	0.005258130151226247_wp * ptemp*2 zlogrh - &
5313	8.98037634284419E-6_wp * ptemp*3 zlogrh + &
5314	( 0.05993213079516759_wp * zlogrh ) / zlogsa + &
5315	( 5.964746463184173_wp * ptemp * zlogrh ) / zlogsa - &
5316	( 0.03624322255690942_wp * ptemp*2 zlogrh ) / zlogsa + &
5317	( 0.00004933369382462509_wp * ptemp*3 zlogrh ) / zlogsa - &
5318	0.7327310805365114_wp * zlognh3 * zlogrh - &
5319	0.01841792282958795_wp * ptemp * zlognh3 * zlogrh + &
5320	0.0001471855981005184_wp * ptemp*2 zlognh3 * zlogrh - &
5321	2.377113195631848E-7_wp * ptemp*3 zlognh3 * zlogrh
5322	pnuc_rate = EXP( zlnj ) ! (#/(cm3 s))
5323	!
5324	!-- Check validity of parametrization
5325	IF ( pnuc_rate < 1.0E-5_wp ) THEN
5326	pnuc_rate = 0.0_wp
5327	pd_crit = 1.0E-9_wp
5328	ELSEIF ( pnuc_rate > 1.0E6_wp ) THEN
5329	message_string = 'Invalid output value: nucleation rate > 10^6 1/cm3s'
5330	CALL message( 'salsa_mod: ternucl', 'PA0623', 1, 2, 0, 6, 0 )
5331	ENDIF
5332	pnuc_rate = pnuc_rate * 1.0E6_wp ! (#/(m3 s))
5333	!
5334	!-- 3) Number of H2SO4 molecules in a critical cluster (Eq. 9)
5335	pn_crit_sa = 38.16448247950508_wp + 0.7741058259731187_wp * zlnj + &
5336	0.002988789927230632_wp * zlnj*2 - 0.3576046920535017_wp ptemp - &
5337	0.003663583011953248_wp * zlnj * ptemp + 0.000855300153372776_wp * ptemp**2
5338	!
5339	!-- Kinetic limit: at least 2 H2SO4 molecules in a cluster
5340	pn_crit_sa = MAX( pn_crit_sa, 2.0E0_wp )
5341	!
5342	!-- 4) Size of the critical cluster in nm (Eq. 12)
5343	pd_crit = 0.1410271086638381_wp - 0.001226253898894878_wp * zlnj - &
5344	7.822111731550752E-6_wp * zlnj*2 - 0.001567273351921166_wp ptemp - &
5345	0.00003075996088273962_wp * zlnj * ptemp + 0.00001083754117202233_wp * ptemp**2
5346	pd_crit = pd_crit * 2.0E-9_wp ! Diameter in m
5347	!
5348	!-- 5) Organic compounds not involved when ternary nucleation assumed
5349	pn_crit_ocnv = 0.0_wp
5350	pk_sa = 1.0_wp
5351	pk_ocnv = 0.0_wp
5352
5353	END SUBROUTINE ternucl
5354
5355	!------------------------------------------------------------------------------!
5356	! Description:
5357	! ------------
5358	!> Calculate the nucleation rate and the size of critical clusters assuming
5359	!> kinetic nucleation. Each sulphuric acid molecule forms an (NH4)HSO4 molecule
5360	!> in the atmosphere and two colliding (NH4)HSO4 molecules form a stable
5361	!> cluster. See Sihto et al. (2006), Atmos. Chem. Phys., 6(12), 4079-4091.
5362	!>
5363	!> Below the following assumption have been made:
5364	!> nucrate = coagcoeffzpcsa*2
5365	!> coagcoeff = 8sqrt(3boltzptempr_abs/dens_abs)
5366	!> r_abs = 0.315d-9 radius of bisulphate molecule [m]
5367	!> dens_abs = 1465 density of - " - [kg/m3]
5368	!------------------------------------------------------------------------------!
5369	SUBROUTINE kinnucl( pc_sa, pnuc_rate, pd_crit, pn_crit_sa, pn_crit_ocnv, pk_sa, pk_ocnv )
5370
5371	IMPLICIT NONE
5372
5373	REAL(wp), INTENT(in) :: pc_sa !< H2SO4 conc. (#/m3)
5374
5375	REAL(wp), INTENT(out) :: pd_crit !< critical diameter of clusters (m)
5376	REAL(wp), INTENT(out) :: pk_ocnv !< if pk_ocnv = 1, organic compounds participate in nucleation
5377	REAL(wp), INTENT(out) :: pk_sa !< if pk_sa = 1, H2SO4 is participate in nucleation
5378	REAL(wp), INTENT(out) :: pn_crit_ocnv !< number of organic molecules in cluster (#)
5379	REAL(wp), INTENT(out) :: pn_crit_sa !< number of H2SO4 molecules in cluster (#)
5380	REAL(wp), INTENT(out) :: pnuc_rate !< nucl. rate (#/(m3 s))
5381	!
5382	!-- Nucleation rate (#/(m3 s))
5383	pnuc_rate = 5.0E-13_wp * pc_sa*2.0_wp 1.0E+6_wp
5384	!
5385	!-- Organic compounds not involved when kinetic nucleation is assumed.
5386	pn_crit_sa = 2.0_wp
5387	pn_crit_ocnv = 0.0_wp
5388	pk_sa = 1.0_wp
5389	pk_ocnv = 0.0_wp
5390	pd_crit = 7.9375E-10_wp ! (m)
5391
5392	END SUBROUTINE kinnucl
5393
5394	!------------------------------------------------------------------------------!
5395	! Description:
5396	! ------------
5397	!> Calculate the nucleation rate and the size of critical clusters assuming
5398	!> activation type nucleation.
5399	!> See Riipinen et al. (2007), Atmos. Chem. Phys., 7(8), 1899-1914.
5400	!------------------------------------------------------------------------------!
5401	SUBROUTINE actnucl( psa_conc, pnuc_rate, pd_crit, pn_crit_sa, pn_crit_ocnv, pk_sa, pk_ocnv, activ )
5402
5403	IMPLICIT NONE
5404
5405	REAL(wp), INTENT(in) :: activ !< activation coefficient (1e-7 by default)
5406	REAL(wp), INTENT(in) :: psa_conc !< H2SO4 conc. (#/m3)
5407
5408	REAL(wp), INTENT(out) :: pd_crit !< critical diameter of clusters (m)
5409	REAL(wp), INTENT(out) :: pk_ocnv !< if pk_ocnv = 1, organic compounds participate in nucleation
5410	REAL(wp), INTENT(out) :: pk_sa !< if pk_sa = 1, H2SO4 participate in nucleation
5411	REAL(wp), INTENT(out) :: pn_crit_ocnv !< number of organic molecules in cluster (#)
5412	REAL(wp), INTENT(out) :: pn_crit_sa !< number of H2SO4 molecules in cluster (#)
5413	REAL(wp), INTENT(out) :: pnuc_rate !< nucl. rate (#/(m3 s))
5414	!
5415	!-- Nucleation rate (#/(m3 s))
5416	pnuc_rate = activ * psa_conc ! (#/(m3 s))
5417	!
5418	!-- Organic compounds not involved when kinetic nucleation is assumed.
5419	pn_crit_sa = 2.0_wp
5420	pn_crit_ocnv = 0.0_wp
5421	pk_sa = 1.0_wp
5422	pk_ocnv = 0.0_wp
5423	pd_crit = 7.9375E-10_wp ! (m)
5424
5425	END SUBROUTINE actnucl
5426
5427	!------------------------------------------------------------------------------!
5428	! Description:
5429	! ------------
5430	!> Conciders only the organic matter in nucleation. Paasonen et al. (2010)
5431	!> determined particle formation rates for 2 nm particles, J2, from different
5432	!> kind of combinations of sulphuric acid and organic matter concentration.
5433	!> See Paasonen et al. (2010), Atmos. Chem. Phys., 10, 11223-11242.
5434	!------------------------------------------------------------------------------!
5435	SUBROUTINE orgnucl( pc_org, pnuc_rate, pd_crit, pn_crit_sa, pn_crit_ocnv, &
5436	pk_sa, pk_ocnv )
5437
5438	IMPLICIT NONE
5439
5440	REAL(wp) :: a_org = 1.3E-7_wp !< (1/s) (Paasonen et al. Table 4: median)
5441
5442	REAL(wp), INTENT(in) :: pc_org !< organic vapour concentration (#/m3)
5443
5444	REAL(wp), INTENT(out) :: pd_crit !< critical diameter of clusters (m)
5445	REAL(wp), INTENT(out) :: pk_ocnv !< if pk_ocnv = 1, organic compounds participate in nucleation
5446	REAL(wp), INTENT(out) :: pk_sa !< if pk_sa = 1, H2SO4 participate in nucleation
5447	REAL(wp), INTENT(out) :: pn_crit_ocnv !< number of organic molecules in cluster (#)
5448	REAL(wp), INTENT(out) :: pn_crit_sa !< number of H2SO4 molecules in cluster (#)
5449	REAL(wp), INTENT(out) :: pnuc_rate !< nucl. rate (#/(m3 s))
5450	!
5451	!-- Homomolecular nuleation rate
5452	pnuc_rate = a_org * pc_org
5453	!
5454	!-- H2SO4 not involved when pure organic nucleation is assumed.
5455	pn_crit_sa = 0.0_wp
5456	pn_crit_ocnv = 1.0_wp
5457	pk_sa = 0.0_wp
5458	pk_ocnv = 1.0_wp
5459	pd_crit = 1.5E-9_wp ! (m)
5460
5461	END SUBROUTINE orgnucl
5462
5463	!------------------------------------------------------------------------------!
5464	! Description:
5465	! ------------
5466	!> Conciders both the organic vapor and H2SO4 in nucleation - activation type
5467	!> of nucleation.
5468	!> See Paasonen et al. (2010), Atmos. Chem. Phys., 10, 11223-11242.
5469	!------------------------------------------------------------------------------!
5470	SUBROUTINE sumnucl( pc_sa, pc_org, pnuc_rate, pd_crit, pn_crit_sa, pn_crit_ocnv, pk_sa, pk_ocnv )
5471
5472	IMPLICIT NONE
5473
5474	REAL(wp) :: a_s1 = 6.1E-7_wp !< (1/s)
5475	REAL(wp) :: a_s2 = 0.39E-7_wp !< (1/s) (Paasonen et al. Table 3.)
5476
5477	REAL(wp), INTENT(in) :: pc_org !< organic vapour concentration (#/m3)
5478	REAL(wp), INTENT(in) :: pc_sa !< H2SO4 conc. (#/m3)
5479
5480	REAL(wp), INTENT(out) :: pd_crit !< critical diameter of clusters (m)
5481	REAL(wp), INTENT(out) :: pk_ocnv !< if pk_ocnv = 1, organic compounds participate in nucleation
5482	REAL(wp), INTENT(out) :: pk_sa !< if pk_sa = 1, H2SO4 participate in nucleation
5483	REAL(wp), INTENT(out) :: pn_crit_ocnv !< number of organic molecules in cluster (#)
5484	REAL(wp), INTENT(out) :: pn_crit_sa !< number of H2SO4 molecules in cluster (#)
5485	REAL(wp), INTENT(out) :: pnuc_rate !< nucl. rate (#/(m3 s))
5486	!
5487	!-- Nucleation rate (#/m3/s)
5488	pnuc_rate = a_s1 * pc_sa + a_s2 * pc_org
5489	!
5490	!-- Both organic compounds and H2SO4 are involved when sumnucleation is assumed.
5491	pn_crit_sa = 1.0_wp
5492	pn_crit_ocnv = 1.0_wp
5493	pk_sa = 1.0_wp
5494	pk_ocnv = 1.0_wp
5495	pd_crit = 1.5E-9_wp ! (m)
5496
5497	END SUBROUTINE sumnucl
5498
5499	!------------------------------------------------------------------------------!
5500	! Description:
5501	! ------------
5502	!> Conciders both the organic vapor and H2SO4 in nucleation - heteromolecular
5503	!> nucleation.
5504	!> See Paasonen et al. (2010), Atmos. Chem. Phys., 10, 11223-11242.
5505	!------------------------------------------------------------------------------!
5506	SUBROUTINE hetnucl( pc_sa, pc_org, pnuc_rate, pd_crit, pn_crit_sa, pn_crit_ocnv, pk_sa, pk_ocnv )
5507
5508	IMPLICIT NONE
5509
5510	REAL(wp) :: z_k_het = 4.1E-14_wp !< (cm3/s) (Paasonen et al. Table 4: median)
5511
5512	REAL(wp), INTENT(in) :: pc_org !< organic vapour concentration (#/m3)
5513	REAL(wp), INTENT(in) :: pc_sa !< H2SO4 conc. (#/m3)
5514
5515	REAL(wp), INTENT(out) :: pd_crit !< critical diameter of clusters (m)
5516	REAL(wp), INTENT(out) :: pk_ocnv !< if pk_ocnv = 1, organic compounds participate in nucleation
5517	REAL(wp), INTENT(out) :: pk_sa !< if pk_sa = 1, H2SO4 participate in nucleation
5518	REAL(wp), INTENT(out) :: pn_crit_ocnv !< number of organic molecules in cluster (#)
5519	REAL(wp), INTENT(out) :: pn_crit_sa !< number of H2SO4 molecules in cluster (#)
5520	REAL(wp), INTENT(out) :: pnuc_rate !< nucl. rate (#/(m3 s))
5521	!
5522	!-- Nucleation rate (#/m3/s)
5523	pnuc_rate = z_k_het * pc_sa * pc_org * 1.0E6_wp
5524	!
5525	!-- Both organic compounds and H2SO4 are involved when heteromolecular
5526	!-- nucleation is assumed.
5527	pn_crit_sa = 1.0_wp
5528	pn_crit_ocnv = 1.0_wp
5529	pk_sa = 1.0_wp
5530	pk_ocnv = 1.0_wp
5531	pd_crit = 1.5E-9_wp ! (m)
5532
5533	END SUBROUTINE hetnucl
5534
5535	!------------------------------------------------------------------------------!
5536	! Description:
5537	! ------------
5538	!> Takes into account the homomolecular nucleation of sulphuric acid H2SO4 with
5539	!> both of the available vapours.
5540	!> See Paasonen et al. (2010), Atmos. Chem. Phys., 10, 11223-11242.
5541	!------------------------------------------------------------------------------!
5542	SUBROUTINE SAnucl( pc_sa, pc_org, pnuc_rate, pd_crit, pn_crit_sa, pn_crit_ocnv, pk_sa, pk_ocnv )
5543
5544	IMPLICIT NONE
5545
5546	REAL(wp) :: z_k_sa1 = 1.1E-14_wp !< (cm3/s)
5547	REAL(wp) :: z_k_sa2 = 3.2E-14_wp !< (cm3/s) (Paasonen et al. Table 3.)
5548
5549	REAL(wp), INTENT(in) :: pc_org !< organic vapour concentration (#/m3)
5550	REAL(wp), INTENT(in) :: pc_sa !< H2SO4 conc. (#/m3)
5551
5552	REAL(wp), INTENT(out) :: pd_crit !< critical diameter of clusters (m)
5553	REAL(wp), INTENT(out) :: pk_ocnv !< if pk_ocnv = 1, organic compounds participate nucleation
5554	REAL(wp), INTENT(out) :: pk_sa !< if pk_sa = 1, H2SO4 participate in nucleation
5555	REAL(wp), INTENT(out) :: pn_crit_ocnv !< number of organic molecules in cluster (#)
5556	REAL(wp), INTENT(out) :: pn_crit_sa !< number of H2SO4 molecules in cluster (#)
5557	REAL(wp), INTENT(out) :: pnuc_rate !< nucleation rate (#/(m3 s))
5558	!
5559	!-- Nucleation rate (#/m3/s)
5560	pnuc_rate = ( z_k_sa1 * pc_sa*2 + z_k_sa2 pc_sa * pc_org ) * 1.0E+6_wp
5561	!
5562	!-- Both organic compounds and H2SO4 are involved when SAnucleation is assumed.
5563	pn_crit_sa = 3.0_wp
5564	pn_crit_ocnv = 1.0_wp
5565	pk_sa = 1.0_wp
5566	pk_ocnv = 1.0_wp
5567	pd_crit = 1.5E-9_wp ! (m)
5568
5569	END SUBROUTINE SAnucl
5570
5571	!------------------------------------------------------------------------------!
5572	! Description:
5573	! ------------
5574	!> Takes into account the homomolecular nucleation of both sulphuric acid and
5575	!> Lorganic with heteromolecular nucleation.
5576	!> See Paasonen et al. (2010), Atmos. Chem. Phys., 10, 11223-11242.
5577	!------------------------------------------------------------------------------!
5578	SUBROUTINE SAORGnucl( pc_sa, pc_org, pnuc_rate, pd_crit, pn_crit_sa, pn_crit_ocnv, pk_sa, pk_ocnv )
5579
5580	IMPLICIT NONE
5581
5582	REAL(wp) :: z_k_s1 = 1.4E-14_wp !< (cm3/s])
5583	REAL(wp) :: z_k_s2 = 2.6E-14_wp !< (cm3/s])
5584	REAL(wp) :: z_k_s3 = 0.037E-14_wp !< (cm3/s]) (Paasonen et al. Table 3.)
5585
5586	REAL(wp), INTENT(in) :: pc_org !< organic vapour concentration (#/m3)
5587	REAL(wp), INTENT(in) :: pc_sa !< H2SO4 conc. (#/m3)
5588
5589	REAL(wp), INTENT(out) :: pd_crit !< critical diameter of clusters (m)
5590	REAL(wp), INTENT(out) :: pk_ocnv !< if pk_ocnv = 1, organic compounds participate in nucleation
5591	REAL(wp), INTENT(out) :: pk_sa !< if pk_sa = 1, H2SO4 participate in nucleation
5592	REAL(wp), INTENT(out) :: pn_crit_ocnv !< number of organic molecules in cluster (#)
5593	REAL(wp), INTENT(out) :: pn_crit_sa !< number of H2SO4 molecules in cluster (#)
5594	REAL(wp), INTENT(out) :: pnuc_rate !< nucl. rate (#/(m3 s))
5595	!
5596	!-- Nucleation rate (#/m3/s)
5597	pnuc_rate = ( z_k_s1 * pc_sa*2 + z_k_s2 pc_sa * pc_org + z_k_s3 * pc_org*2 ) 1.0E+6_wp
5598	!
5599	!-- Organic compounds not involved when kinetic nucleation is assumed.
5600	pn_crit_sa = 3.0_wp
5601	pn_crit_ocnv = 3.0_wp
5602	pk_sa = 1.0_wp
5603	pk_ocnv = 1.0_wp
5604	pd_crit = 1.5E-9_wp ! (m)
5605
5606	END SUBROUTINE SAORGnucl
5607
5608	!------------------------------------------------------------------------------!
5609	! Description:
5610	! ------------
5611	!> Function z_n_nuc_tayl is connected to the calculation of self-coagualtion of
5612	!> small particles. It calculates number of the particles in the size range
5613	!> [zdcrit,dx] using Taylor-expansion (please note that the expansion is not
5614	!> valid for certain rational numbers, e.g. -4/3 and -3/2)
5615	!------------------------------------------------------------------------------!
5616	FUNCTION z_n_nuc_tayl( d1, dx, zm_para, zjnuc_t, zeta, z_gr_tot )
5617
5618	IMPLICIT NONE
5619
5620	INTEGER(iwp) :: i !< running index
5621
5622	REAL(wp) :: d1 !< lower diameter limit
5623	REAL(wp) :: dx !< upper diameter limit
5624	REAL(wp) :: zjnuc_t !< initial nucleation rate (1/s)
5625	REAL(wp) :: zeta !< ratio of CS/GR (m) (condensation sink / growth rate)
5626	REAL(wp) :: term1 !<
5627	REAL(wp) :: term2 !<
5628	REAL(wp) :: term3 !<
5629	REAL(wp) :: term4 !<
5630	REAL(wp) :: term5 !<
5631	REAL(wp) :: z_n_nuc_tayl !< final nucleation rate (1/s)
5632	REAL(wp) :: z_gr_tot !< total growth rate (nm/h)
5633	REAL(wp) :: zm_para !< m parameter in Lehtinen et al. (2007), Eq. 6
5634
5635	z_n_nuc_tayl = 0.0_wp
5636
5637	DO i = 0, 29
5638	IF ( i == 0 .OR. i == 1 ) THEN
5639	term1 = 1.0_wp
5640	ELSE
5641	term1 = term1 * REAL( i, SELECTED_REAL_KIND(12,307) )
5642	END IF
5643	term2 = ( REAL( i, SELECTED_REAL_KIND(12,307) ) * ( zm_para + 1.0_wp ) + 1.0_wp ) * term1
5644	term3 = zeta**i
5645	term4 = term3 / term2
5646	term5 = REAL( i, SELECTED_REAL_KIND(12,307) ) * ( zm_para + 1.0_wp ) + 1.0_wp
5647	z_n_nuc_tayl = z_n_nuc_tayl + term4 * ( dxterm5 - d1term5 )
5648	ENDDO
5649	z_n_nuc_tayl = z_n_nuc_tayl * zjnuc_t * EXP( -zeta * ( d1**( zm_para + 1 ) ) ) / z_gr_tot
5650
5651	END FUNCTION z_n_nuc_tayl
5652
5653	!------------------------------------------------------------------------------!
5654	! Description:
5655	! ------------
5656	!> Calculates the condensation of water vapour on aerosol particles. Follows the
5657	!> analytical predictor method by Jacobson (2005).
5658	!> For equations, see Jacobson (2005), Fundamentals of atmospheric modelling
5659	!> (2nd edition).
5660	!------------------------------------------------------------------------------!
5661	SUBROUTINE gpparth2o( paero, ptemp, ppres, pcs, pcw, ptstep )
5662
5663	IMPLICIT NONE
5664
5665	INTEGER(iwp) :: ib !< loop index
5666	INTEGER(iwp) :: nstr !<
5667
5668	REAL(wp) :: adt !< internal timestep in this subroutine
5669	REAL(wp) :: rhoair !< air density (kg/m3)
5670	REAL(wp) :: ttot !< total time (s)
5671	REAL(wp) :: zact !< Water activity
5672	REAL(wp) :: zaelwc1 !< Current aerosol water content (kg/m3)
5673	REAL(wp) :: zaelwc2 !< New aerosol water content after equilibrium calculation (kg/m3)
5674	REAL(wp) :: zbeta !< Transitional correction factor
5675	REAL(wp) :: zcwc !< Current water vapour mole concentration in aerosols (mol/m3)
5676	REAL(wp) :: zcwint !< Current and new water vapour mole concentrations (mol/m3)
5677	REAL(wp) :: zcwn !< New water vapour mole concentration (mol/m3)
5678	REAL(wp) :: zcwtot !< Total water mole concentration (mol/m3)
5679	REAL(wp) :: zdfh2o !< molecular diffusion coefficient (cm2/s) for water
5680	REAL(wp) :: zhlp1 !< intermediate variable to calculate the mass transfer coefficient
5681	REAL(wp) :: zhlp2 !< intermediate variable to calculate the mass transfer coefficient
5682	REAL(wp) :: zhlp3 !< intermediate variable to calculate the mass transfer coefficient
5683	REAL(wp) :: zknud !< Knudsen number
5684	REAL(wp) :: zmfph2o !< mean free path of H2O gas molecule
5685	REAL(wp) :: zrh !< relative humidity [0-1]
5686	REAL(wp) :: zthcond !< thermal conductivity of air (W/m/K)
5687
5688	REAL(wp), DIMENSION(nbins_aerosol) :: zcwcae !< Current water mole concentrations
5689	REAL(wp), DIMENSION(nbins_aerosol) :: zcwintae !< Current and new aerosol water mole concentration
5690	REAL(wp), DIMENSION(nbins_aerosol) :: zcwnae !< New water mole concentration in aerosols
5691	REAL(wp), DIMENSION(nbins_aerosol) :: zcwsurfae !< Surface mole concentration
5692	REAL(wp), DIMENSION(nbins_aerosol) :: zkelvin !< Kelvin effect
5693	REAL(wp), DIMENSION(nbins_aerosol) :: zmtae !< Mass transfer coefficients
5694	REAL(wp), DIMENSION(nbins_aerosol) :: zwsatae !< Water saturation ratio above aerosols
5695
5696	REAL(wp), INTENT(in) :: ppres !< Air pressure (Pa)
5697	REAL(wp), INTENT(in) :: pcs !< Water vapour saturation concentration (kg/m3)
5698	REAL(wp), INTENT(in) :: ptemp !< Ambient temperature (K)
5699	REAL(wp), INTENT(in) :: ptstep !< timestep (s)
5700
5701	REAL(wp), INTENT(inout) :: pcw !< Water vapour concentration (kg/m3)
5702
5703	TYPE(t_section), DIMENSION(nbins_aerosol), INTENT(inout) :: paero !< Aerosol properties
5704	!
5705	!-- Relative humidity [0-1]
5706	zrh = pcw / pcs
5707	!
5708	!-- Calculate the condensation only for 2a/2b aerosol bins
5709	nstr = start_subrange_2a
5710	!
5711	!-- Save the current aerosol water content, 8 in paero is H2O
5712	zaelwc1 = SUM( paero(start_subrange_1a:end_subrange_2b)%volc(8) ) * arhoh2o
5713	!
5714	!-- Equilibration:
5715	IF ( advect_particle_water ) THEN
5716	IF ( zrh < 0.98_wp .OR. .NOT. lscndh2oae ) THEN
5717	CALL equilibration( zrh, ptemp, paero, .TRUE. )
5718	ELSE
5719	CALL equilibration( zrh, ptemp, paero, .FALSE. )
5720	ENDIF
5721	ENDIF
5722	!
5723	!-- The new aerosol water content after equilibrium calculation
5724	zaelwc2 = SUM( paero(start_subrange_1a:end_subrange_2b)%volc(8) ) * arhoh2o
5725	!
5726	!-- New water vapour mixing ratio (kg/m3)
5727	pcw = pcw - ( zaelwc2 - zaelwc1 ) * ppres * amdair / ( argas * ptemp )
5728	!
5729	!-- Initialise variables
5730	zcwsurfae(:) = 0.0_wp
5731	zhlp1 = 0.0_wp
5732	zhlp2 = 0.0_wp
5733	zhlp3 = 0.0_wp
5734	zmtae(:) = 0.0_wp
5735	zwsatae(:) = 0.0_wp
5736	!
5737	!-- Air:
5738	!-- Density (kg/m3)
5739	rhoair = amdair * ppres / ( argas * ptemp )
5740	!
5741	!-- Thermal conductivity of air
5742	zthcond = 0.023807_wp + 7.1128E-5_wp * ( ptemp - 273.16_wp )
5743	!
5744	!-- Water vapour:
5745	!-- Molecular diffusion coefficient (cm2/s) (eq.16.17)
5746	zdfh2o = ( 5.0_wp / ( 16.0_wp * avo * rhoair * 1.0E-3_wp * 3.11E-8_wp*2 ) ) SQRT( argas * &
5747	1.0E+7_wp * ptemp * amdair * 1.0E+3_wp * ( amh2o + amdair ) * 1.0E+3_wp / &
5748	( pi * amh2o * 2.0E+3_wp ) )
5749	zdfh2o = zdfh2o * 1.0E-4 ! Unit change to m^2/s
5750	!
5751	!-- Mean free path (eq. 15.25 & 16.29)
5752	zmfph2o = 3.0_wp * zdfh2o * SQRT( pi * amh2o / ( 8.0_wp * argas * ptemp ) )
5753	!
5754	!-- Kelvin effect (eq. 16.33)
5755	zkelvin(:) = EXP( 4.0_wp * surfw0 * amh2o / ( argas * ptemp * arhoh2o * paero(:)%dwet) )
5756
5757	DO ib = 1, nbins_aerosol
5758	IF ( paero(ib)%numc > nclim .AND. zrh > 0.98_wp ) THEN
5759	!
5760	!-- Water activity
5761	zact = acth2o( paero(ib) )
5762	!
5763	!-- Saturation mole concentration over flat surface. Limit the super-
5764	!-- saturation to max 1.01 for the mass transfer. Experimental!
5765	zcwsurfae(ib) = MAX( pcs, pcw / 1.01_wp ) * rhoair / amh2o
5766	!
5767	!-- Equilibrium saturation ratio
5768	zwsatae(ib) = zact * zkelvin(ib)
5769	!
5770	!-- Knudsen number (eq. 16.20)
5771	zknud = 2.0_wp * zmfph2o / paero(ib)%dwet
5772	!
5773	!-- Transitional correction factor (Fuks & Sutugin, 1971)
5774	zbeta = ( zknud + 1.0_wp ) / ( 0.377_wp * zknud + 1.0_wp + 4.0_wp / &
5775	( 3.0_wp * massacc(ib) ) * ( zknud + zknud**2 ) )
5776	!
5777	!-- Mass transfer of H2O: Eq. 16.64 but here D^eff = zdfh2o * zbeta
5778	zhlp1 = paero(ib)%numc * 2.0_wp * pi * paero(ib)%dwet * zdfh2o * zbeta
5779	!
5780	!-- 1st term on the left side of the denominator in eq. 16.55
5781	zhlp2 = amh2o * zdfh2o * alv * zwsatae(ib) * zcwsurfae(ib) / ( zthcond * ptemp )
5782	!
5783	!-- 2nd term on the left side of the denominator in eq. 16.55
5784	zhlp3 = ( ( alv * amh2o ) / ( argas * ptemp ) ) - 1.0_wp
5785	!
5786	!-- Full eq. 16.64: Mass transfer coefficient (1/s)
5787	zmtae(ib) = zhlp1 / ( zhlp2 * zhlp3 + 1.0_wp )
5788	ENDIF
5789	ENDDO
5790	!
5791	!-- Current mole concentrations of water
5792	zcwc = pcw * rhoair / amh2o ! as vapour
5793	zcwcae(:) = paero(:)%volc(8) * arhoh2o / amh2o ! in aerosols
5794	zcwtot = zcwc + SUM( zcwcae ) ! total water concentration
5795	zcwnae(:) = 0.0_wp
5796	zcwintae(:) = zcwcae(:)
5797	!
5798	!-- Substepping loop
5799	zcwint = 0.0_wp
5800	ttot = 0.0_wp
5801	DO WHILE ( ttot < ptstep )
5802	adt = 2.0E-2_wp ! internal timestep
5803	!
5804	!-- New vapour concentration: (eq. 16.71)
5805	zhlp1 = zcwc + adt * ( SUM( zmtae(nstr:nbins_aerosol) * zwsatae(nstr:nbins_aerosol) * &
5806	zcwsurfae(nstr:nbins_aerosol) ) ) ! numerator
5807	zhlp2 = 1.0_wp + adt * ( SUM( zmtae(nstr:nbins_aerosol) ) ) ! denomin.
5808	zcwint = zhlp1 / zhlp2 ! new vapour concentration
5809	zcwint = MIN( zcwint, zcwtot )
5810	IF ( ANY( paero(:)%numc > nclim ) .AND. zrh > 0.98_wp ) THEN
5811	DO ib = nstr, nbins_aerosol
5812	zcwintae(ib) = zcwcae(ib) + MIN( MAX( adt * zmtae(ib) * ( zcwint - zwsatae(ib) * &
5813	zcwsurfae(ib) ), -0.02_wp * zcwcae(ib) ), &
5814	0.05_wp * zcwcae(ib) )
5815	zwsatae(ib) = acth2o( paero(ib), zcwintae(ib) ) * zkelvin(ib)
5816	ENDDO
5817	ENDIF
5818	zcwintae(nstr:nbins_aerosol) = MAX( zcwintae(nstr:nbins_aerosol), 0.0_wp )
5819	!
5820	!-- Update vapour concentration for consistency
5821	zcwint = zcwtot - SUM( zcwintae(1:nbins_aerosol) )
5822	!
5823	!-- Update "old" values for next cycle
5824	zcwcae = zcwintae
5825
5826	ttot = ttot + adt
5827
5828	ENDDO ! ADT
5829
5830	zcwn = zcwint
5831	zcwnae(:) = zcwintae(:)
5832	pcw = zcwn * amh2o / rhoair
5833	paero(:)%volc(8) = MAX( 0.0_wp, zcwnae(:) * amh2o / arhoh2o )
5834
5835	END SUBROUTINE gpparth2o
5836
5837	!------------------------------------------------------------------------------!
5838	! Description:
5839	! ------------
5840	!> Calculates the activity coefficient of liquid water
5841	!------------------------------------------------------------------------------!
5842	REAL(wp) FUNCTION acth2o( ppart, pcw )
5843
5844	IMPLICIT NONE
5845
5846	REAL(wp) :: zns !< molar concentration of solutes (mol/m3)
5847	REAL(wp) :: znw !< molar concentration of water (mol/m3)
5848
5849	REAL(wp), INTENT(in), OPTIONAL :: pcw !< molar concentration of water (mol/m3)
5850
5851	TYPE(t_section), INTENT(in) :: ppart !< Aerosol properties of a bin
5852
5853	zns = ( 3.0_wp * ( ppart%volc(1) * arhoh2so4 / amh2so4 ) + ( ppart%volc(2) * arhooc / amoc ) + &
5854	2.0_wp * ( ppart%volc(5) * arhoss / amss ) + ( ppart%volc(6) * arhohno3 / amhno3 ) + &
5855	( ppart%volc(7) * arhonh3 / amnh3 ) )
5856
5857	IF ( PRESENT(pcw) ) THEN
5858	znw = pcw
5859	ELSE
5860	znw = ppart%volc(8) * arhoh2o / amh2o
5861	ENDIF
5862	!
5863	!-- Activity = partial pressure of water vapour / sat. vapour pressure of water over a liquid surface
5864	!-- = molality * activity coefficient (Jacobson, 2005: eq. 17.20-21)
5865	!-- Assume activity coefficient of 1 for water
5866	acth2o = MAX( 0.1_wp, znw / MAX( EPSILON( 1.0_wp ),( znw + zns ) ) )
5867
5868	END FUNCTION acth2o
5869
5870	!------------------------------------------------------------------------------!
5871	! Description:
5872	! ------------
5873	!> Calculates the dissolutional growth of particles (i.e. gas transfers to a
5874	!> particle surface and dissolves in liquid water on the surface). Treated here
5875	!> as a non-equilibrium (time-dependent) process. Gases: HNO3 and NH3
5876	!> (Chapter 17.14 in Jacobson, 2005).
5877	!
5878	!> Called from subroutine condensation.
5879	!> Coded by:
5880	!> Harri Kokkola (FMI)
5881	!------------------------------------------------------------------------------!
5882	SUBROUTINE gpparthno3( ppres, ptemp, paero, pghno3, pgnh3, pcw, pcs, pbeta, ptstep )
5883
5884	IMPLICIT NONE
5885
5886	INTEGER(iwp) :: ib !< loop index
5887
5888	REAL(wp) :: adt !< timestep
5889	REAL(wp) :: zc_nh3_c !< Current NH3 gas concentration
5890	REAL(wp) :: zc_nh3_int !< Intermediate NH3 gas concentration
5891	REAL(wp) :: zc_nh3_n !< New NH3 gas concentration
5892	REAL(wp) :: zc_nh3_tot !< Total NH3 concentration
5893	REAL(wp) :: zc_hno3_c !< Current HNO3 gas concentration
5894	REAL(wp) :: zc_hno3_int !< Intermediate HNO3 gas concentration
5895	REAL(wp) :: zc_hno3_n !< New HNO3 gas concentration
5896	REAL(wp) :: zc_hno3_tot !< Total HNO3 concentration
5897	REAL(wp) :: zdfvap !< Diffusion coefficient for vapors
5898	REAL(wp) :: zhlp1 !< intermediate variable
5899	REAL(wp) :: zhlp2 !< intermediate variable
5900	REAL(wp) :: zrh !< relative humidity
5901
5902	REAL(wp), INTENT(in) :: ppres !< ambient pressure (Pa)
5903	REAL(wp), INTENT(in) :: pcs !< water vapour saturation
5904	!< concentration (kg/m3)
5905	REAL(wp), INTENT(in) :: ptemp !< ambient temperature (K)
5906	REAL(wp), INTENT(in) :: ptstep !< time step (s)
5907
5908	REAL(wp), INTENT(inout) :: pghno3 !< nitric acid concentration (#/m3)
5909	REAL(wp), INTENT(inout) :: pgnh3 !< ammonia conc. (#/m3)
5910	REAL(wp), INTENT(inout) :: pcw !< water vapour concentration (kg/m3)
5911
5912	REAL(wp), DIMENSION(nbins_aerosol) :: zac_hno3_ae !< Activity coefficients for HNO3
5913	REAL(wp), DIMENSION(nbins_aerosol) :: zac_hhso4_ae !< Activity coefficients for HHSO4
5914	REAL(wp), DIMENSION(nbins_aerosol) :: zac_nh3_ae !< Activity coefficients for NH3
5915	REAL(wp), DIMENSION(nbins_aerosol) :: zac_nh4hso2_ae !< Activity coefficients for NH4HSO2
5916	REAL(wp), DIMENSION(nbins_aerosol) :: zcg_hno3_eq_ae !< Equilibrium gas concentration: HNO3
5917	REAL(wp), DIMENSION(nbins_aerosol) :: zcg_nh3_eq_ae !< Equilibrium gas concentration: NH3
5918	REAL(wp), DIMENSION(nbins_aerosol) :: zc_hno3_int_ae !< Intermediate HNO3 aerosol concentration
5919	REAL(wp), DIMENSION(nbins_aerosol) :: zc_hno3_c_ae !< Current HNO3 in aerosols
5920	REAL(wp), DIMENSION(nbins_aerosol) :: zc_hno3_n_ae !< New HNO3 in aerosols
5921	REAL(wp), DIMENSION(nbins_aerosol) :: zc_nh3_int_ae !< Intermediate NH3 aerosol concentration
5922	REAL(wp), DIMENSION(nbins_aerosol) :: zc_nh3_c_ae !< Current NH3 in aerosols
5923	REAL(wp), DIMENSION(nbins_aerosol) :: zc_nh3_n_ae !< New NH3 in aerosols
5924	REAL(wp), DIMENSION(nbins_aerosol) :: zkel_hno3_ae !< Kelvin effect for HNO3
5925	REAL(wp), DIMENSION(nbins_aerosol) :: zkel_nh3_ae !< Kelvin effects for NH3
5926	REAL(wp), DIMENSION(nbins_aerosol) :: zmt_hno3_ae !< Mass transfer coefficients for HNO3
5927	REAL(wp), DIMENSION(nbins_aerosol) :: zmt_nh3_ae !< Mass transfer coefficients for NH3
5928	REAL(wp), DIMENSION(nbins_aerosol) :: zsat_hno3_ae !< HNO3 saturation ratio over a surface
5929	REAL(wp), DIMENSION(nbins_aerosol) :: zsat_nh3_ae !< NH3 saturation ratio over a surface
5930
5931	REAL(wp), DIMENSION(nbins_aerosol,maxspec) :: zion_mols !< Ion molalities from pdfite aerosols
5932
5933	REAL(wp), DIMENSION(nbins_aerosol), INTENT(in) :: pbeta !< transitional correction factor for
5934
5935	TYPE(t_section), DIMENSION(nbins_aerosol), INTENT(inout) :: paero !< Aerosol properties
5936	!
5937	!-- Initialise:
5938	adt = ptstep
5939	zac_hhso4_ae = 0.0_wp
5940	zac_nh3_ae = 0.0_wp
5941	zac_nh4hso2_ae = 0.0_wp
5942	zac_hno3_ae = 0.0_wp
5943	zcg_nh3_eq_ae = 0.0_wp
5944	zcg_hno3_eq_ae = 0.0_wp
5945	zion_mols = 0.0_wp
5946	zsat_nh3_ae = 1.0_wp
5947	zsat_hno3_ae = 1.0_wp
5948	!
5949	!-- Diffusion coefficient (m2/s)
5950	zdfvap = 5.1111E-10_wp * ptemp*1.75_wp ( p_0 + 1325.0_wp ) / ppres
5951	!
5952	!-- Kelvin effects (Jacobson (2005), eq. 16.33)
5953	zkel_hno3_ae(1:nbins_aerosol) = EXP( 4.0_wp * surfw0 * amvhno3 / &
5954	( abo * ptemp * paero(1:nbins_aerosol)%dwet ) )
5955	zkel_nh3_ae(1:nbins_aerosol) = EXP( 4.0_wp * surfw0 * amvnh3 / &
5956	( abo * ptemp * paero(1:nbins_aerosol)%dwet ) )
5957	!
5958	!-- Current vapour mole concentrations (mol/m3)
5959	zc_hno3_c = pghno3 / avo ! HNO3
5960	zc_nh3_c = pgnh3 / avo ! NH3
5961	!
5962	!-- Current particle mole concentrations (mol/m3)
5963	zc_hno3_c_ae(1:nbins_aerosol) = paero(1:nbins_aerosol)%volc(6) * arhohno3 / amhno3
5964	zc_nh3_c_ae(1:nbins_aerosol) = paero(1:nbins_aerosol)%volc(7) * arhonh3 / amnh3
5965	!
5966	!-- Total mole concentrations: gas and particle phase
5967	zc_hno3_tot = zc_hno3_c + SUM( zc_hno3_c_ae(1:nbins_aerosol) )
5968	zc_nh3_tot = zc_nh3_c + SUM( zc_nh3_c_ae(1:nbins_aerosol) )
5969	!
5970	!-- Relative humidity [0-1]
5971	zrh = pcw / pcs
5972	!
5973	!-- Mass transfer coefficients (Jacobson, Eq. 16.64)
5974	zmt_hno3_ae(:) = 2.0_wp * pi * paero(:)%dwet * zdfvap * paero(:)%numc * pbeta(:)
5975	zmt_nh3_ae(:) = 2.0_wp * pi * paero(:)%dwet * zdfvap * paero(:)%numc * pbeta(:)
5976
5977	!
5978	!-- Get the equilibrium concentrations above aerosols
5979	CALL nitrate_ammonium_equilibrium( zrh, ptemp, paero, zcg_hno3_eq_ae, zcg_nh3_eq_ae, &
5980	zac_hno3_ae, zac_nh3_ae, zac_nh4hso2_ae, zac_hhso4_ae, &
5981	zion_mols )
5982	!
5983	!-- Calculate NH3 and HNO3 saturation ratios for aerosols
5984	CALL nitrate_ammonium_saturation( ptemp, paero, zac_hno3_ae, zac_nh4hso2_ae, zac_hhso4_ae, &
5985	zcg_hno3_eq_ae, zc_hno3_c_ae, zc_nh3_c_ae, zkel_hno3_ae, &
5986	zkel_nh3_ae, zsat_hno3_ae, zsat_nh3_ae )
5987	!
5988	!-- Intermediate gas concentrations of HNO3 and NH3
5989	zhlp1 = SUM( zc_hno3_c_ae(:) / ( 1.0_wp + adt * zmt_hno3_ae(:) * zsat_hno3_ae(:) ) )
5990	zhlp2 = SUM( zmt_hno3_ae(:) / ( 1.0_wp + adt * zmt_hno3_ae(:) * zsat_hno3_ae(:) ) )
5991	zc_hno3_int = ( zc_hno3_tot - zhlp1 ) / ( 1.0_wp + adt * zhlp2 )
5992
5993	zhlp1 = SUM( zc_nh3_c_ae(:) / ( 1.0_wp + adt * zmt_nh3_ae(:) * zsat_nh3_ae(:) ) )
5994	zhlp2 = SUM( zmt_nh3_ae(:) / ( 1.0_wp + adt * zmt_nh3_ae(:) * zsat_nh3_ae(:) ) )
5995	zc_nh3_int = ( zc_nh3_tot - zhlp1 )/( 1.0_wp + adt * zhlp2 )
5996
5997	zc_hno3_int = MIN( zc_hno3_int, zc_hno3_tot )
5998	zc_nh3_int = MIN( zc_nh3_int, zc_nh3_tot )
5999	!
6000	!-- Calculate the new concentration on aerosol particles
6001	zc_hno3_int_ae = zc_hno3_c_ae
6002	zc_nh3_int_ae = zc_nh3_c_ae
6003	DO ib = 1, nbins_aerosol
6004	zc_hno3_int_ae(ib) = ( zc_hno3_c_ae(ib) + adt * zmt_hno3_ae(ib) * zc_hno3_int ) / &
6005	( 1.0_wp + adt * zmt_hno3_ae(ib) * zsat_hno3_ae(ib) )
6006	zc_nh3_int_ae(ib) = ( zc_nh3_c_ae(ib) + adt * zmt_nh3_ae(ib) * zc_nh3_int ) / &
6007	( 1.0_wp + adt * zmt_nh3_ae(ib) * zsat_nh3_ae(ib) )
6008	ENDDO
6009
6010	zc_hno3_int_ae(:) = MAX( zc_hno3_int_ae(:), 0.0_wp )
6011	zc_nh3_int_ae(:) = MAX( zc_nh3_int_ae(:), 0.0_wp )
6012	!
6013	!-- Final molar gas concentration and molar particle concentration of HNO3
6014	zc_hno3_n = zc_hno3_int
6015	zc_hno3_n_ae = zc_hno3_int_ae
6016	!
6017	!-- Final molar gas concentration and molar particle concentration of NH3
6018	zc_nh3_n = zc_nh3_int
6019	zc_nh3_n_ae = zc_nh3_int_ae
6020	!
6021	!-- Model timestep reached - update the gas concentrations
6022	pghno3 = zc_hno3_n * avo
6023	pgnh3 = zc_nh3_n * avo
6024	!
6025	!-- Update the particle concentrations
6026	DO ib = start_subrange_1a, end_subrange_2b
6027	paero(ib)%volc(6) = zc_hno3_n_ae(ib) * amhno3 / arhohno3
6028	paero(ib)%volc(7) = zc_nh3_n_ae(ib) * amnh3 / arhonh3
6029	ENDDO
6030
6031	END SUBROUTINE gpparthno3
6032	!------------------------------------------------------------------------------!
6033	! Description:
6034	! ------------
6035	!> Calculate the equilibrium concentrations above aerosols (reference?)
6036	!------------------------------------------------------------------------------!
6037	SUBROUTINE nitrate_ammonium_equilibrium( prh, ptemp, ppart, pcg_hno3_eq, pcg_nh3_eq, pgamma_hno3, &
6038	pgamma_nh4, pgamma_nh4hso2, pgamma_hhso4, pmols )
6039
6040	IMPLICIT NONE
6041
6042	INTEGER(iwp) :: ib !< loop index: aerosol bins
6043
6044	REAL(wp) :: zhlp !< intermediate variable
6045	REAL(wp) :: zp_hcl !< Equilibrium vapor pressures (Pa) of HCl
6046	REAL(wp) :: zp_hno3 !< Equilibrium vapor pressures (Pa) of HNO3
6047	REAL(wp) :: zp_nh3 !< Equilibrium vapor pressures (Pa) of NH3
6048	REAL(wp) :: zwatertotal !< Total water in particles (mol/m3)
6049
6050	REAL(wp), INTENT(in) :: prh !< relative humidity
6051	REAL(wp), INTENT(in) :: ptemp !< ambient temperature (K)
6052
6053	REAL(wp), DIMENSION(maxspec) :: zgammas !< Activity coefficients
6054	REAL(wp), DIMENSION(maxspec) :: zions !< molar concentration of ion (mol/m3)
6055
6056	REAL(wp), DIMENSION(nbins_aerosol), INTENT(inout) :: pcg_nh3_eq !< equilibrium molar
6057	!< concentration: of NH3
6058	REAL(wp), DIMENSION(nbins_aerosol), INTENT(inout) :: pcg_hno3_eq !< of HNO3
6059	REAL(wp), DIMENSION(nbins_aerosol), INTENT(inout) :: pgamma_hhso4 !< activity coeff. of HHSO4
6060	REAL(wp), DIMENSION(nbins_aerosol), INTENT(inout) :: pgamma_nh4 !< activity coeff. of NH3
6061	REAL(wp), DIMENSION(nbins_aerosol), INTENT(inout) :: pgamma_nh4hso2 !< activity coeff. of NH4HSO2
6062	REAL(wp), DIMENSION(nbins_aerosol), INTENT(inout) :: pgamma_hno3 !< activity coeff. of HNO3
6063
6064	REAL(wp), DIMENSION(nbins_aerosol,maxspec), INTENT(inout) :: pmols !< Ion molalities
6065
6066	TYPE(t_section), DIMENSION(nbins_aerosol), INTENT(inout) :: ppart !< Aerosol properties
6067
6068	zgammas = 0.0_wp
6069	zhlp = 0.0_wp
6070	zions = 0.0_wp
6071	zp_hcl = 0.0_wp
6072	zp_hno3 = 0.0_wp
6073	zp_nh3 = 0.0_wp
6074	zwatertotal = 0.0_wp
6075
6076	DO ib = 1, nbins_aerosol
6077
6078	IF ( ppart(ib)%numc < nclim ) CYCLE
6079	!
6080	!-- Ion molar concentrations: 2*H2SO4 + CL + NO3 - Na - NH4
6081	zhlp = 2.0_wp * ppart(ib)%volc(1) * arhoh2so4 / amh2so4 + ppart(ib)%volc(5) * arhoss / amss &
6082	+ ppart(ib)%volc(6) * arhohno3 / amhno3 - ppart(ib)%volc(5) * arhoss / amss - &
6083	ppart(ib)%volc(7) * arhonh3 / amnh3
6084
6085	zions(1) = zhlp ! H+
6086	zions(2) = ppart(ib)%volc(7) * arhonh3 / amnh3 ! NH4+
6087	zions(3) = ppart(ib)%volc(5) * arhoss / amss ! Na+
6088	zions(4) = ppart(ib)%volc(1) * arhoh2so4 / amh2so4 ! SO4(2-)
6089	zions(5) = 0.0_wp ! HSO4-
6090	zions(6) = ppart(ib)%volc(6) * arhohno3 / amhno3 ! NO3-
6091	zions(7) = ppart(ib)%volc(5) * arhoss / amss ! Cl-
6092
6093	zwatertotal = ppart(ib)%volc(8) * arhoh2o / amh2o
6094	IF ( zwatertotal > 1.0E-30_wp ) THEN
6095	CALL inorganic_pdfite( prh, ptemp, zions, zwatertotal, zp_hno3, zp_hcl, zp_nh3, zgammas, &
6096	pmols(ib,:) )
6097	ENDIF
6098	!
6099	!-- Activity coefficients
6100	pgamma_hno3(ib) = zgammas(1) ! HNO3
6101	pgamma_nh4(ib) = zgammas(3) ! NH3
6102	pgamma_nh4hso2(ib) = zgammas(6) ! NH4HSO2
6103	pgamma_hhso4(ib) = zgammas(7) ! HHSO4
6104	!
6105	!-- Equilibrium molar concentrations (mol/m3) from equlibrium pressures (Pa)
6106	pcg_hno3_eq(ib) = zp_hno3 / ( argas * ptemp )
6107	pcg_nh3_eq(ib) = zp_nh3 / ( argas * ptemp )
6108
6109	ENDDO
6110
6111	END SUBROUTINE nitrate_ammonium_equilibrium
6112
6113	!------------------------------------------------------------------------------!
6114	! Description:
6115	! ------------
6116	!> Calculate saturation ratios of NH4 and HNO3 for aerosols
6117	!------------------------------------------------------------------------------!
6118	SUBROUTINE nitrate_ammonium_saturation( ptemp, ppart, pachno3, pacnh4hso2, pachhso4, pchno3eq, &
6119	pchno3, pc_nh3, pkelhno3, pkelnh3, psathno3, psatnh3 )
6120
6121	IMPLICIT NONE
6122
6123	INTEGER(iwp) :: ib !< running index for aerosol bins
6124
6125	REAL(wp) :: k_ll_h2o !< equilibrium constants of equilibrium reactions:
6126	!< H2O(aq) <--> H+ + OH- (mol/kg)
6127	REAL(wp) :: k_ll_nh3 !< NH3(aq) + H2O(aq) <--> NH4+ + OH- (mol/kg)
6128	REAL(wp) :: k_gl_nh3 !< NH3(g) <--> NH3(aq) (mol/kg/atm)
6129	REAL(wp) :: k_gl_hno3 !< HNO3(g) <--> H+ + NO3- (mol2/kg2/atm)
6130	REAL(wp) :: zmol_no3 !< molality of NO3- (mol/kg)
6131	REAL(wp) :: zmol_h !< molality of H+ (mol/kg)
6132	REAL(wp) :: zmol_so4 !< molality of SO4(2-) (mol/kg)
6133	REAL(wp) :: zmol_cl !< molality of Cl- (mol/kg)
6134	REAL(wp) :: zmol_nh4 !< molality of NH4+ (mol/kg)
6135	REAL(wp) :: zmol_na !< molality of Na+ (mol/kg)
6136	REAL(wp) :: zhlp1 !< intermediate variable
6137	REAL(wp) :: zhlp2 !< intermediate variable
6138	REAL(wp) :: zhlp3 !< intermediate variable
6139	REAL(wp) :: zxi !< particle mole concentration ratio: (NH3+SS)/H2SO4
6140	REAL(wp) :: zt0 !< reference temp
6141
6142	REAL(wp), PARAMETER :: a1 = -22.52_wp !<
6143	REAL(wp), PARAMETER :: a2 = -1.50_wp !<
6144	REAL(wp), PARAMETER :: a3 = 13.79_wp !<
6145	REAL(wp), PARAMETER :: a4 = 29.17_wp !<
6146	REAL(wp), PARAMETER :: b1 = 26.92_wp !<
6147	REAL(wp), PARAMETER :: b2 = 26.92_wp !<
6148	REAL(wp), PARAMETER :: b3 = -5.39_wp !<
6149	REAL(wp), PARAMETER :: b4 = 16.84_wp !<
6150	REAL(wp), PARAMETER :: K01 = 1.01E-14_wp !<
6151	REAL(wp), PARAMETER :: K02 = 1.81E-5_wp !<
6152	REAL(wp), PARAMETER :: K03 = 57.64_wp !<
6153	REAL(wp), PARAMETER :: K04 = 2.51E+6_wp !<
6154
6155	REAL(wp), INTENT(in) :: ptemp !< ambient temperature (K)
6156
6157	REAL(wp), DIMENSION(nbins_aerosol), INTENT(in) :: pachhso4 !< activity coeff. of HHSO4
6158	REAL(wp), DIMENSION(nbins_aerosol), INTENT(in) :: pacnh4hso2 !< activity coeff. of NH4HSO2
6159	REAL(wp), DIMENSION(nbins_aerosol), INTENT(in) :: pachno3 !< activity coeff. of HNO3
6160	REAL(wp), DIMENSION(nbins_aerosol), INTENT(in) :: pchno3eq !< eq. surface concentration: HNO3
6161	REAL(wp), DIMENSION(nbins_aerosol), INTENT(in) :: pchno3 !< current particle mole
6162	!< concentration of HNO3 (mol/m3)
6163	REAL(wp), DIMENSION(nbins_aerosol), INTENT(in) :: pc_nh3 !< of NH3 (mol/m3)
6164	REAL(wp), DIMENSION(nbins_aerosol), INTENT(in) :: pkelhno3 !< Kelvin effect for HNO3
6165	REAL(wp), DIMENSION(nbins_aerosol), INTENT(in) :: pkelnh3 !< Kelvin effect for NH3
6166
6167	REAL(wp), DIMENSION(nbins_aerosol), INTENT(out) :: psathno3 !< saturation ratio of HNO3
6168	REAL(wp), DIMENSION(nbins_aerosol), INTENT(out) :: psatnh3 !< saturation ratio of NH3
6169
6170	TYPE(t_section), DIMENSION(nbins_aerosol), INTENT(inout) :: ppart !< Aerosol properties
6171
6172	zmol_cl = 0.0_wp
6173	zmol_h = 0.0_wp
6174	zmol_na = 0.0_wp
6175	zmol_nh4 = 0.0_wp
6176	zmol_no3 = 0.0_wp
6177	zmol_so4 = 0.0_wp
6178	zt0 = 298.15_wp
6179	zxi = 0.0_wp
6180	!
6181	!-- Calculates equlibrium rate constants based on Table B.7 in Jacobson (2005):
6182	!-- K^ll_H20, K^ll_NH3, K^gl_NH3, K^gl_HNO3
6183	zhlp1 = zt0 / ptemp
6184	zhlp2 = zhlp1 - 1.0_wp
6185	zhlp3 = 1.0_wp + LOG( zhlp1 ) - zhlp1
6186
6187	k_ll_h2o = K01 * EXP( a1 * zhlp2 + b1 * zhlp3 )
6188	k_ll_nh3 = K02 * EXP( a2 * zhlp2 + b2 * zhlp3 )
6189	k_gl_nh3 = K03 * EXP( a3 * zhlp2 + b3 * zhlp3 )
6190	k_gl_hno3 = K04 * EXP( a4 * zhlp2 + b4 * zhlp3 )
6191
6192	DO ib = 1, nbins_aerosol
6193
6194	IF ( ppart(ib)%numc > nclim .AND. ppart(ib)%volc(8) > 1.0E-30_wp ) THEN
6195	!
6196	!-- Molality of H+ and NO3-
6197	zhlp1 = pc_nh3(ib) * amnh3 + ppart(ib)%volc(1) * arhoh2so4 + ppart(ib)%volc(2) * arhooc &
6198	+ ppart(ib)%volc(5) * arhoss + ppart(ib)%volc(8) * arhoh2o
6199	zmol_no3 = pchno3(ib) / zhlp1 !< mol/kg
6200	!
6201	!-- Particle mole concentration ratio: (NH3+SS)/H2SO4
6202	zxi = ( pc_nh3(ib) + ppart(ib)%volc(5) * arhoss / amss ) / ( ppart(ib)%volc(1) * &
6203	arhoh2so4 / amh2so4 )
6204
6205	IF ( zxi <= 2.0_wp ) THEN
6206	!
6207	!-- Molality of SO4(2-)
6208	zhlp1 = pc_nh3(ib) * amnh3 + pchno3(ib) * amhno3 + ppart(ib)%volc(2) * arhooc + &
6209	ppart(ib)%volc(5) * arhoss + ppart(ib)%volc(8) * arhoh2o
6210	zmol_so4 = ( ppart(ib)%volc(1) * arhoh2so4 / amh2so4 ) / zhlp1
6211	!
6212	!-- Molality of Cl-
6213	zhlp1 = pc_nh3(ib) * amnh3 + pchno3(ib) * amhno3 + ppart(ib)%volc(2) * arhooc + &
6214	ppart(ib)%volc(1) * arhoh2so4 + ppart(ib)%volc(8) * arhoh2o
6215	zmol_cl = ( ppart(ib)%volc(5) * arhoss / amss ) / zhlp1
6216	!
6217	!-- Molality of NH4+
6218	zhlp1 = pchno3(ib) * amhno3 + ppart(ib)%volc(1) * arhoh2so4 + ppart(ib)%volc(2) * &
6219	arhooc + ppart(ib)%volc(5) * arhoss + ppart(ib)%volc(8) * arhoh2o
6220	zmol_nh4 = pc_nh3(ib) / zhlp1
6221	!
6222	!-- Molality of Na+
6223	zmol_na = zmol_cl
6224	!
6225	!-- Molality of H+
6226	zmol_h = 2.0_wp * zmol_so4 + zmol_no3 + zmol_cl - ( zmol_nh4 + zmol_na )
6227
6228	ELSE
6229
6230	zhlp2 = pkelhno3(ib) * zmol_no3 * pachno3(ib)**2
6231
6232	IF ( zhlp2 > 1.0E-30_wp ) THEN
6233	zmol_h = k_gl_hno3 * pchno3eq(ib) / zhlp2 ! Eq. 17.38
6234	ELSE
6235	zmol_h = 0.0_wp
6236	ENDIF
6237
6238	ENDIF
6239
6240	zhlp1 = ppart(ib)%volc(8) * arhoh2o * argas * ptemp * k_gl_hno3
6241	!
6242	!-- Saturation ratio for NH3 and for HNO3
6243	IF ( zmol_h > 0.0_wp ) THEN
6244	zhlp2 = pkelnh3(ib) / ( zhlp1 * zmol_h )
6245	zhlp3 = k_ll_h2o / ( k_ll_nh3 + k_gl_nh3 )
6246	psatnh3(ib) = zhlp2 * ( ( pacnh4hso2(ib) / pachhso4(ib) )*2 ) zhlp3
6247	psathno3(ib) = ( pkelhno3(ib) * zmol_h * pachno3(ib)**2 ) / zhlp1
6248	ELSE
6249	psatnh3(ib) = 1.0_wp
6250	psathno3(ib) = 1.0_wp
6251	ENDIF
6252	ELSE
6253	psatnh3(ib) = 1.0_wp
6254	psathno3(ib) = 1.0_wp
6255	ENDIF
6256
6257	ENDDO
6258
6259	END SUBROUTINE nitrate_ammonium_saturation
6260
6261	!------------------------------------------------------------------------------!
6262	! Description:
6263	! ------------
6264	!> Prototype module for calculating the water content of a mixed inorganic/
6265	!> organic particle + equilibrium water vapour pressure above the solution
6266	!> (HNO3, HCL, NH3 and representative organic compounds. Efficient calculation
6267	!> of the partitioning of species between gas and aerosol. Based in a chamber
6268	!> study.
6269	!
6270	!> Written by Dave Topping. Pure organic component properties predicted by Mark
6271	!> Barley based on VOCs predicted in MCM simulations performed by Mike Jenkin.
6272	!> Delivered by Gordon McFiggans as Deliverable D22 from WP1.4 in the EU FP6
6273	!> EUCAARI Integrated Project.
6274	!
6275	!> REFERENCES
6276	!> Clegg et al. (1998) A Thermodynamic Model of the System H+-NH4+-Na+-SO42- -NO3--Cl--H2O at
6277	!> 298.15 K, J. Phys. Chem., 102A, 2155-2171.
6278	!> Clegg et al. (2001) Thermodynamic modelling of aqueous aerosols containing electrolytes and
6279	!> dissolved organic compounds. Journal of Aerosol Science 2001;32(6):713-738.
6280	!> Topping et al. (2005a) A curved multi-component aerosol hygroscopicity model framework: Part 1 -
6281	!> Inorganic compounds. Atmospheric Chemistry and Physics 2005;5:1205-1222.
6282	!> Topping et al. (2005b) A curved multi-component aerosol hygroscopicity model framework: Part 2 -
6283	!> Including organic compounds. Atmospheric Chemistry and Physics 2005;5:1223-1242.
6284	!> Wagman et al. (1982). The NBS tables of chemical thermodynamic properties: selected values for
6285	!> inorganic and Câ and Câ organic substances in SI units (book)
6286	!> Zaveri et al. (2005). A new method for multicomponent activity coefficients of electrolytes in
6287	!> aqueous atmospheric aerosols, JGR, 110, D02201, 2005.
6288	!
6289	!> Queries concerning the use of this code through Gordon McFiggans,
6290	!> g.mcfiggans@manchester.ac.uk,
6291	!> Ownership: D. Topping, Centre for Atmospheric Sciences, University of
6292	!> Manchester, 2007
6293	!
6294	!> Rewritten to PALM by Mona Kurppa, UHel, 2017
6295	!------------------------------------------------------------------------------!
6296	SUBROUTINE inorganic_pdfite( rh, temp, ions, water_total, press_hno3, press_hcl, press_nh3, &
6297	gamma_out, mols_out )
6298
6299	IMPLICIT NONE
6300
6301	INTEGER(iwp) :: binary_case
6302	INTEGER(iwp) :: full_complexity
6303
6304	REAL(wp) :: a !< auxiliary variable
6305	REAL(wp) :: act_product !< ionic activity coef. product:
6306	!< = (gamma_h2so43d0) / gamma_hhso42d0)
6307	REAL(wp) :: ammonium_chloride !<
6308	REAL(wp) :: ammonium_chloride_eq_frac !<
6309	REAL(wp) :: ammonium_nitrate !<
6310	REAL(wp) :: ammonium_nitrate_eq_frac !<
6311	REAL(wp) :: ammonium_sulphate !<
6312	REAL(wp) :: ammonium_sulphate_eq_frac !<
6313	REAL(wp) :: b !< auxiliary variable
6314	REAL(wp) :: binary_h2so4 !< binary H2SO4 activity coeff.
6315	REAL(wp) :: binary_hcl !< binary HCL activity coeff.
6316	REAL(wp) :: binary_hhso4 !< binary HHSO4 activity coeff.
6317	REAL(wp) :: binary_hno3 !< binary HNO3 activity coeff.
6318	REAL(wp) :: binary_nh4hso4 !< binary NH4HSO4 activity coeff.
6319	REAL(wp) :: c !< auxiliary variable
6320	REAL(wp) :: charge_sum !< sum of ionic charges
6321	REAL(wp) :: gamma_h2so4 !< activity coefficient
6322	REAL(wp) :: gamma_hcl !< activity coefficient
6323	REAL(wp) :: gamma_hhso4 !< activity coeffient
6324	REAL(wp) :: gamma_hno3 !< activity coefficient
6325	REAL(wp) :: gamma_nh3 !< activity coefficient
6326	REAL(wp) :: gamma_nh4hso4 !< activity coefficient
6327	REAL(wp) :: h_out !<
6328	REAL(wp) :: h_real !< new hydrogen ion conc.
6329	REAL(wp) :: h2so4_hcl !< contribution of H2SO4
6330	REAL(wp) :: h2so4_hno3 !< contribution of H2SO4
6331	REAL(wp) :: h2so4_nh3 !< contribution of H2SO4
6332	REAL(wp) :: h2so4_nh4hso4 !< contribution of H2SO4
6333	REAL(wp) :: hcl_h2so4 !< contribution of HCL
6334	REAL(wp) :: hcl_hhso4 !< contribution of HCL
6335	REAL(wp) :: hcl_hno3 !< contribution of HCL
6336	REAL(wp) :: hcl_nh4hso4 !< contribution of HCL
6337	REAL(wp) :: henrys_temp_dep !< temperature dependence of Henry's Law
6338	REAL(wp) :: hno3_h2so4 !< contribution of HNO3
6339	REAL(wp) :: hno3_hcl !< contribution of HNO3
6340	REAL(wp) :: hno3_hhso4 !< contribution of HNO3
6341	REAL(wp) :: hno3_nh3 !< contribution of HNO3
6342	REAL(wp) :: hno3_nh4hso4 !< contribution of HNO3
6343	REAL(wp) :: hso4_out !<
6344	REAL(wp) :: hso4_real !< new bisulphate ion conc.
6345	REAL(wp) :: hydrochloric_acid !<
6346	REAL(wp) :: hydrochloric_acid_eq_frac !<
6347	REAL(wp) :: k_h !< equilibrium constant for H+
6348	REAL(wp) :: k_hcl !< equilibrium constant of HCL
6349	REAL(wp) :: k_hno3 !< equilibrium constant of HNO3
6350	REAL(wp) :: k_nh4 !< equilibrium constant for NH4+
6351	REAL(wp) :: k_h2o !< equil. const. for water_surface
6352	REAL(wp) :: ln_h2so4_act !< gamma_h2so4 = EXP(ln_h2so4_act)
6353	REAL(wp) :: ln_HCL_act !< gamma_hcl = EXP( ln_HCL_act )
6354	REAL(wp) :: ln_hhso4_act !< gamma_hhso4 = EXP(ln_hhso4_act)
6355	REAL(wp) :: ln_hno3_act !< gamma_hno3 = EXP( ln_hno3_act )
6356	REAL(wp) :: ln_nh4hso4_act !< gamma_nh4hso4 = EXP( ln_nh4hso4_act )
6357	REAL(wp) :: molality_ratio_nh3 !< molality ratio of NH3 (NH4+ and H+)
6358	REAL(wp) :: na2so4_h2so4 !< contribution of Na2SO4
6359	REAL(wp) :: na2so4_hcl !< contribution of Na2SO4
6360	REAL(wp) :: na2so4_hhso4 !< contribution of Na2SO4
6361	REAL(wp) :: na2so4_hno3 !< contribution of Na2SO4
6362	REAL(wp) :: na2so4_nh3 !< contribution of Na2SO4
6363	REAL(wp) :: na2so4_nh4hso4 !< contribution of Na2SO4
6364	REAL(wp) :: nacl_h2so4 !< contribution of NaCl
6365	REAL(wp) :: nacl_hcl !< contribution of NaCl
6366	REAL(wp) :: nacl_hhso4 !< contribution of NaCl
6367	REAL(wp) :: nacl_hno3 !< contribution of NaCl
6368	REAL(wp) :: nacl_nh3 !< contribution of NaCl
6369	REAL(wp) :: nacl_nh4hso4 !< contribution of NaCl
6370	REAL(wp) :: nano3_h2so4 !< contribution of NaNO3
6371	REAL(wp) :: nano3_hcl !< contribution of NaNO3
6372	REAL(wp) :: nano3_hhso4 !< contribution of NaNO3
6373	REAL(wp) :: nano3_hno3 !< contribution of NaNO3
6374	REAL(wp) :: nano3_nh3 !< contribution of NaNO3
6375	REAL(wp) :: nano3_nh4hso4 !< contribution of NaNO3
6376	REAL(wp) :: nh42so4_h2so4 !< contribution of NH42SO4
6377	REAL(wp) :: nh42so4_hcl !< contribution of NH42SO4
6378	REAL(wp) :: nh42so4_hhso4 !< contribution of NH42SO4
6379	REAL(wp) :: nh42so4_hno3 !< contribution of NH42SO4
6380	REAL(wp) :: nh42so4_nh3 !< contribution of NH42SO4
6381	REAL(wp) :: nh42so4_nh4hso4 !< contribution of NH42SO4
6382	REAL(wp) :: nh4cl_h2so4 !< contribution of NH4Cl
6383	REAL(wp) :: nh4cl_hcl !< contribution of NH4Cl
6384	REAL(wp) :: nh4cl_hhso4 !< contribution of NH4Cl
6385	REAL(wp) :: nh4cl_hno3 !< contribution of NH4Cl
6386	REAL(wp) :: nh4cl_nh3 !< contribution of NH4Cl
6387	REAL(wp) :: nh4cl_nh4hso4 !< contribution of NH4Cl
6388	REAL(wp) :: nh4no3_h2so4 !< contribution of NH4NO3
6389	REAL(wp) :: nh4no3_hcl !< contribution of NH4NO3
6390	REAL(wp) :: nh4no3_hhso4 !< contribution of NH4NO3
6391	REAL(wp) :: nh4no3_hno3 !< contribution of NH4NO3
6392	REAL(wp) :: nh4no3_nh3 !< contribution of NH4NO3
6393	REAL(wp) :: nh4no3_nh4hso4 !< contribution of NH4NO3
6394	REAL(wp) :: nitric_acid !<
6395	REAL(wp) :: nitric_acid_eq_frac !< Equivalent fractions
6396	REAL(wp) :: press_hcl !< partial pressure of HCL
6397	REAL(wp) :: press_hno3 !< partial pressure of HNO3
6398	REAL(wp) :: press_nh3 !< partial pressure of NH3
6399	REAL(wp) :: rh !< relative humidity [0-1]
6400	REAL(wp) :: root1 !< auxiliary variable
6401	REAL(wp) :: root2 !< auxiliary variable
6402	REAL(wp) :: so4_out !<
6403	REAL(wp) :: so4_real !< new sulpate ion concentration
6404	REAL(wp) :: sodium_chloride !<
6405	REAL(wp) :: sodium_chloride_eq_frac !<
6406	REAL(wp) :: sodium_nitrate !<
6407	REAL(wp) :: sodium_nitrate_eq_frac !<
6408	REAL(wp) :: sodium_sulphate !<
6409	REAL(wp) :: sodium_sulphate_eq_frac !<
6410	REAL(wp) :: solutes !<
6411	REAL(wp) :: sulphuric_acid !<
6412	REAL(wp) :: sulphuric_acid_eq_frac !<
6413	REAL(wp) :: temp !< temperature
6414	REAL(wp) :: water_total !<
6415
6416	REAL(wp), DIMENSION(:) :: gamma_out !< Activity coefficient for calculating the non-ideal
6417	!< dissociation constants
6418	!< 1: HNO3, 2: HCL, 3: NH4+/H+ (NH3), 4: HHSO4**2/H2SO4,
6419	!< 5: H2SO43/HHSO42, 6: NH4HSO2, 7: HHSO4
6420	REAL(wp), DIMENSION(:) :: ions !< ion molarities (mol/m3): 1: H+, 2: NH4+, 3: Na+,
6421	!< 4: SO4(2-), 5: HSO4-, 6: NO3-, 7: Cl-
6422	REAL(wp), DIMENSION(7) :: ions_mol !< ion molalities (mol/kg): 1: H+, 2: NH4+, 3: Na+,
6423	!< 4: SO4(2-), 5: HSO4-, 6: NO3-, 7: Cl-
6424	REAL(wp), DIMENSION(:) :: mols_out !< ion molality output (mol/kg): 1: H+, 2: NH4+, 3: Na+,
6425	!< 4: SO4(2-), 5: HSO4-, 6: NO3-, 7: Cl-
6426	!
6427	!-- Value initialisation
6428	binary_h2so4 = 0.0_wp
6429	binary_hcl = 0.0_wp
6430	binary_hhso4 = 0.0_wp
6431	binary_hno3 = 0.0_wp
6432	binary_nh4hso4 = 0.0_wp
6433	henrys_temp_dep = ( 1.0_wp / temp - 0.0033557_wp ) ! 1/T - 1/298 K
6434	hcl_hno3 = 1.0_wp
6435	h2so4_hno3 = 1.0_wp
6436	nh42so4_hno3 = 1.0_wp
6437	nh4no3_hno3 = 1.0_wp
6438	nh4cl_hno3 = 1.0_wp
6439	na2so4_hno3 = 1.0_wp
6440	nano3_hno3 = 1.0_wp
6441	nacl_hno3 = 1.0_wp
6442	hno3_hcl = 1.0_wp
6443	h2so4_hcl = 1.0_wp
6444	nh42so4_hcl = 1.0_wp
6445	nh4no3_hcl = 1.0_wp
6446	nh4cl_hcl = 1.0_wp
6447	na2so4_hcl = 1.0_wp
6448	nano3_hcl = 1.0_wp
6449	nacl_hcl = 1.0_wp
6450	hno3_nh3 = 1.0_wp
6451	h2so4_nh3 = 1.0_wp
6452	nh42so4_nh3 = 1.0_wp
6453	nh4no3_nh3 = 1.0_wp
6454	nh4cl_nh3 = 1.0_wp
6455	na2so4_nh3 = 1.0_wp
6456	nano3_nh3 = 1.0_wp
6457	nacl_nh3 = 1.0_wp
6458	hno3_hhso4 = 1.0_wp
6459	hcl_hhso4 = 1.0_wp
6460	nh42so4_hhso4 = 1.0_wp
6461	nh4no3_hhso4 = 1.0_wp
6462	nh4cl_hhso4 = 1.0_wp
6463	na2so4_hhso4 = 1.0_wp
6464	nano3_hhso4 = 1.0_wp
6465	nacl_hhso4 = 1.0_wp
6466	hno3_h2so4 = 1.0_wp
6467	hcl_h2so4 = 1.0_wp
6468	nh42so4_h2so4 = 1.0_wp
6469	nh4no3_h2so4 = 1.0_wp
6470	nh4cl_h2so4 = 1.0_wp
6471	na2so4_h2so4 = 1.0_wp
6472	nano3_h2so4 = 1.0_wp
6473	nacl_h2so4 = 1.0_wp
6474	!
6475	!-- New NH3 variables
6476	hno3_nh4hso4 = 1.0_wp
6477	hcl_nh4hso4 = 1.0_wp
6478	h2so4_nh4hso4 = 1.0_wp
6479	nh42so4_nh4hso4 = 1.0_wp
6480	nh4no3_nh4hso4 = 1.0_wp
6481	nh4cl_nh4hso4 = 1.0_wp
6482	na2so4_nh4hso4 = 1.0_wp
6483	nano3_nh4hso4 = 1.0_wp
6484	nacl_nh4hso4 = 1.0_wp
6485	!
6486	!-- Juha Tonttila added
6487	mols_out = 0.0_wp
6488	press_hno3 = 0.0_wp !< Initialising vapour pressures over the
6489	press_hcl = 0.0_wp !< multicomponent particle
6490	press_nh3 = 0.0_wp
6491	gamma_out = 1.0_wp !< i.e. don't alter the ideal mixing ratios if there's nothing there.
6492	!
6493	!-- 1) - COMPOSITION DEFINITIONS
6494	!
6495	!-- a) Inorganic ion pairing:
6496	!-- In order to calculate the water content, which is also used in calculating vapour pressures, one
6497	!-- needs to pair the anions and cations for use in the ZSR mixing rule. The equation provided by
6498	!-- Clegg et al. (2001) is used for ion pairing. The solutes chosen comprise of 9 inorganic salts
6499	!-- and acids which provide a pairing between each anion and cation: (NH4)2SO4, NH4NO3, NH4Cl,
6500	!-- Na2SO4, NaNO3, NaCl, H2SO4, HNO3, HCL. The organic compound is treated as a seperate solute.
6501	!-- Ions: 1: H+, 2: NH4+, 3: Na+, 4: SO4(2-), 5: HSO4-, 6: NO3-, 7: Cl-
6502	!
6503	charge_sum = ions(1) + ions(2) + ions(3) + 2.0_wp * ions(4) + ions(5) + ions(6) + ions(7)
6504	nitric_acid = ( 2.0_wp * ions(1) * ions(6) ) / charge_sum
6505	hydrochloric_acid = ( 2.0_wp * ions(1) * ions(7) ) / charge_sum
6506	sulphuric_acid = ( 2.0_wp * ions(1) * ions(4) ) / charge_sum
6507	ammonium_sulphate = ( 2.0_wp * ions(2) * ions(4) ) / charge_sum
6508	ammonium_nitrate = ( 2.0_wp * ions(2) * ions(6) ) / charge_sum
6509	ammonium_chloride = ( 2.0_wp * ions(2) * ions(7) ) / charge_sum
6510	sodium_sulphate = ( 2.0_wp * ions(3) * ions(4) ) / charge_sum
6511	sodium_nitrate = ( 2.0_wp * ions(3) * ions(6) ) / charge_sum
6512	sodium_chloride = ( 2.0_wp * ions(3) * ions(7) ) / charge_sum
6513	solutes = 0.0_wp
6514	solutes = 3.0_wp * sulphuric_acid + 2.0_wp * hydrochloric_acid + 2.0_wp * nitric_acid + &
6515	3.0_wp * ammonium_sulphate + 2.0_wp * ammonium_nitrate + 2.0_wp * ammonium_chloride +&
6516	3.0_wp * sodium_sulphate + 2.0_wp * sodium_nitrate + 2.0_wp * sodium_chloride
6517	!
6518	!-- b) Inorganic equivalent fractions:
6519	!-- These values are calculated so that activity coefficients can be expressed by a linear additive
6520	!-- rule, thus allowing more efficient calculations and future expansion (see more detailed
6521	!-- description below)
6522	nitric_acid_eq_frac = 2.0_wp * nitric_acid / solutes
6523	hydrochloric_acid_eq_frac = 2.0_wp * hydrochloric_acid / solutes
6524	sulphuric_acid_eq_frac = 3.0_wp * sulphuric_acid / solutes
6525	ammonium_sulphate_eq_frac = 3.0_wp * ammonium_sulphate / solutes
6526	ammonium_nitrate_eq_frac = 2.0_wp * ammonium_nitrate / solutes
6527	ammonium_chloride_eq_frac = 2.0_wp * ammonium_chloride / solutes
6528	sodium_sulphate_eq_frac = 3.0_wp * sodium_sulphate / solutes
6529	sodium_nitrate_eq_frac = 2.0_wp * sodium_nitrate / solutes
6530	sodium_chloride_eq_frac = 2.0_wp * sodium_chloride / solutes
6531	!
6532	!-- Inorganic ion molalities
6533	ions_mol(1) = ions(1) / ( water_total * 18.01528E-3_wp ) ! H+
6534	ions_mol(2) = ions(2) / ( water_total * 18.01528E-3_wp ) ! NH4+
6535	ions_mol(3) = ions(3) / ( water_total * 18.01528E-3_wp ) ! Na+
6536	ions_mol(4) = ions(4) / ( water_total * 18.01528E-3_wp ) ! SO4(2-)
6537	ions_mol(5) = ions(5) / ( water_total * 18.01528E-3_wp ) ! HSO4(2-)
6538	ions_mol(6) = ions(6) / ( water_total * 18.01528E-3_wp ) ! NO3-
6539	ions_mol(7) = ions(7) / ( water_total * 18.01528E-3_wp ) ! Cl-
6540
6541	!-- ***
6542	!-- At this point we may need to introduce a method for prescribing H+ when there is no 'real' value
6543	!-- for H+..i.e. in the sulphate poor domain. This will give a value for solve quadratic proposed by
6544	!-- Zaveri et al. 2005
6545	!
6546	!-- 2) - WATER CALCULATION
6547	!
6548	!-- a) The water content is calculated using the ZSR rule with solute concentrations calculated
6549	!-- using 1a above. Whilst the usual approximation of ZSR relies on binary data consisting of 5th or
6550	!-- higher order polynomials, in this code 4 different RH regimes are used, each housing cubic
6551	!-- equations for the water associated with each solute listed above. Binary water contents for
6552	!-- inorganic components were calculated using AIM online (Clegg et al 1998). The water associated
6553	!-- with the organic compound is calculated assuming ideality and that aw = RH.
6554	!
6555	!-- b) Molality of each inorganic ion and organic solute (initial input) is calculated for use in
6556	!-- vapour pressure calculation.
6557	!
6558	!-- 3) - BISULPHATE ION DISSOCIATION CALCULATION
6559	!
6560	!-- The dissociation of the bisulphate ion is calculated explicitly. A solution to the equilibrium
6561	!-- equation between the bisulphate ion, hydrogen ion and sulphate ion is found using tabulated
6562	!-- equilibrium constants (referenced). It is necessary to calculate the activity coefficients of
6563	!-- HHSO4 and H2SO4 in a non-iterative manner. These are calculated using the same format as
6564	!-- described in 4) below, where both activity coefficients were fit to the output from ADDEM
6565	!-- (Topping et al 2005a,b) covering an extensive composition space, providing the activity
6566	!-- coefficients and bisulphate ion dissociation as a function of equivalent mole fractions and
6567	!-- relative humidity.
6568	!
6569	!-- NOTE: the flags "binary_case" and "full_complexity" are not used in this prototype. They are
6570	!-- used for simplification of the fit expressions when using limited composition regions. This
6571	!-- section of code calculates the bisulphate ion concentration.
6572	!
6573	IF ( ions(1) > 0.0_wp .AND. ions(4) > 0.0_wp ) THEN
6574	!
6575	!-- HHSO4:
6576	binary_case = 1
6577	IF ( rh > 0.1_wp .AND. rh < 0.9_wp ) THEN
6578	binary_hhso4 = -4.9521_wp * rh*3 + 9.2881_wp rh*2 - 10.777_wp rh + 6.0534_wp
6579	ELSEIF ( rh >= 0.9_wp .AND. rh < 0.955_wp ) THEN
6580	binary_hhso4 = -6.3777_wp * rh + 5.962_wp
6581	ELSEIF ( rh >= 0.955_wp .AND. rh < 0.99_wp ) THEN
6582	binary_hhso4 = 2367.2_wp * rh*3 - 6849.7_wp rh*2 + 6600.9_wp rh - 2118.7_wp
6583	ELSEIF ( rh >= 0.99_wp .AND. rh < 0.9999_wp ) THEN
6584	binary_hhso4 = 3E-7_wp * rh*5 - 2E-5_wp rh*4 + 0.0004_wp rh*3 - 0.0035_wp rh**2 &
6585	+ 0.0123_wp * rh - 0.3025_wp
6586	ENDIF
6587
6588	IF ( nitric_acid > 0.0_wp ) THEN
6589	hno3_hhso4 = -4.2204_wp * rh*4 + 12.193_wp rh*3 - 12.481_wp rh*2 + 6.459_wp rh &
6590	- 1.9004_wp
6591	ENDIF
6592
6593	IF ( hydrochloric_acid > 0.0_wp ) THEN
6594	hcl_hhso4 = -54.845_wp * rh*7 + 209.54_wp rh*6 - 336.59_wp rh*5 + 294.21_wp &
6595	rh*4 - 150.07_wp rh*3 + 43.767_wp rh*2 - 6.5495_wp rh + 0.60048_wp
6596	ENDIF
6597
6598	IF ( ammonium_sulphate > 0.0_wp ) THEN
6599	nh42so4_hhso4 = 16.768_wp * rh*3 - 28.75_wp rh*2 + 20.011_wp rh - 8.3206_wp
6600	ENDIF
6601
6602	IF ( ammonium_nitrate > 0.0_wp ) THEN
6603	nh4no3_hhso4 = -17.184_wp * rh*4 + 56.834_wp rh*3 - 65.765_wp rh**2 + &
6604	35.321_wp * rh - 9.252_wp
6605	ENDIF
6606
6607	IF (ammonium_chloride > 0.0_wp ) THEN
6608	IF ( rh < 0.2_wp .AND. rh >= 0.1_wp ) THEN
6609	nh4cl_hhso4 = 3.2809_wp * rh - 2.0637_wp
6610	ELSEIF ( rh >= 0.2_wp .AND. rh < 0.99_wp ) THEN
6611	nh4cl_hhso4 = -1.2981_wp * rh*3 + 4.7461_wp rh*2 - 2.3269_wp rh - 1.1259_wp
6612	ENDIF
6613	ENDIF
6614
6615	IF ( sodium_sulphate > 0.0_wp ) THEN
6616	na2so4_hhso4 = 118.87_wp * rh*6 - 358.63_wp rh*5 + 435.85_wp rh*4 - 272.88_wp &
6617	rh*3 + 94.411_wp rh*2 - 18.21_wp rh + 0.45935_wp
6618	ENDIF
6619
6620	IF ( sodium_nitrate > 0.0_wp ) THEN
6621	IF ( rh < 0.2_wp .AND. rh >= 0.1_wp ) THEN
6622	nano3_hhso4 = 4.8456_wp * rh - 2.5773_wp
6623	ELSEIF ( rh >= 0.2_wp .AND. rh < 0.99_wp ) THEN
6624	nano3_hhso4 = 0.5964_wp * rh*3 - 0.38967_wp rh*2 + 1.7918_wp rh - 1.9691_wp
6625	ENDIF
6626	ENDIF
6627
6628	IF ( sodium_chloride > 0.0_wp ) THEN
6629	IF ( rh < 0.2_wp ) THEN
6630	nacl_hhso4 = 0.51995_wp * rh - 1.3981_wp
6631	ELSEIF ( rh >= 0.2_wp .AND. rh < 0.99_wp ) THEN
6632	nacl_hhso4 = 1.6539_wp * rh - 1.6101_wp
6633	ENDIF
6634	ENDIF
6635
6636	ln_hhso4_act = binary_hhso4 + nitric_acid_eq_frac * hno3_hhso4 + &
6637	hydrochloric_acid_eq_frac * hcl_hhso4 + &
6638	ammonium_sulphate_eq_frac * nh42so4_hhso4 + &
6639	ammonium_nitrate_eq_frac * nh4no3_hhso4 + &
6640	ammonium_chloride_eq_frac * nh4cl_hhso4 + &
6641	sodium_sulphate_eq_frac * na2so4_hhso4 + &
6642	sodium_nitrate_eq_frac * nano3_hhso4 + sodium_chloride_eq_frac * nacl_hhso4
6643
6644	gamma_hhso4 = EXP( ln_hhso4_act ) ! molal activity coefficient of HHSO4
6645
6646	!-- H2SO4 (sulphuric acid):
6647	IF ( rh >= 0.1_wp .AND. rh < 0.9_wp ) THEN
6648	binary_h2so4 = 2.4493_wp * rh*2 - 6.2326_wp rh + 2.1763_wp
6649	ELSEIF ( rh >= 0.9_wp .AND. rh < 0.98 ) THEN
6650	binary_h2so4 = 914.68_wp * rh*3 - 2502.3_wp rh*2 + 2281.9_wp rh - 695.11_wp
6651	ELSEIF ( rh >= 0.98 .AND. rh < 0.9999 ) THEN
6652	binary_h2so4 = 3.0E-8_wp * rh*4 - 5E-6_wp rh*3 + 0.0003_wp rh*2 - 0.0022_wp &
6653	rh - 1.1305_wp
6654	ENDIF
6655
6656	IF ( nitric_acid > 0.0_wp ) THEN
6657	hno3_h2so4 = - 16.382_wp * rh*5 + 46.677_wp rh*4 - 54.149_wp rh*3 + 34.36_wp &
6658	rh*2 - 12.54_wp rh + 2.1368_wp
6659	ENDIF
6660
6661	IF ( hydrochloric_acid > 0.0_wp ) THEN
6662	hcl_h2so4 = - 14.409_wp * rh*5 + 42.804_wp rh*4 - 47.24_wp rh*3 + 24.668_wp &
6663	rh*2 - 5.8015_wp rh + 0.084627_wp
6664	ENDIF
6665
6666	IF ( ammonium_sulphate > 0.0_wp ) THEN
6667	nh42so4_h2so4 = 66.71_wp * rh*5 - 187.5_wp rh*4 + 210.57_wp rh*3 - 121.04_wp &
6668	rh*2 + 39.182_wp rh - 8.0606_wp
6669	ENDIF
6670
6671	IF ( ammonium_nitrate > 0.0_wp ) THEN
6672	nh4no3_h2so4 = - 22.532_wp * rh*4 + 66.615_wp rh*3 - 74.647_wp rh*2 + 37.638_wp &
6673	rh - 6.9711_wp
6674	ENDIF
6675
6676	IF ( ammonium_chloride > 0.0_wp ) THEN
6677	IF ( rh >= 0.1_wp .AND. rh < 0.2_wp ) THEN
6678	nh4cl_h2so4 = - 0.32089_wp * rh + 0.57738_wp
6679	ELSEIF ( rh >= 0.2_wp .AND. rh < 0.9_wp ) THEN
6680	nh4cl_h2so4 = 18.089_wp * rh*5 - 51.083_wp rh*4 + 50.32_wp rh*3 - 17.012_wp &
6681	rh*2 - 0.93435_wp rh + 1.0548_wp
6682	ELSEIF ( rh >= 0.9_wp .AND. rh < 0.99_wp ) THEN
6683	nh4cl_h2so4 = - 1.5749_wp * rh + 1.7002_wp
6684	ENDIF
6685	ENDIF
6686
6687	IF ( sodium_sulphate > 0.0_wp ) THEN
6688	na2so4_h2so4 = 29.843_wp * rh*4 - 69.417_wp rh*3 + 61.507_wp rh*2 - 29.874_wp &
6689	rh + 7.7556_wp
6690	ENDIF
6691
6692	IF ( sodium_nitrate > 0.0_wp ) THEN
6693	nano3_h2so4 = - 122.37_wp * rh*6 + 427.43_wp rh*5 - 604.68_wp rh*4 + 443.08_wp &
6694	rh*3 - 178.61_wp rh*2 + 37.242_wp rh - 1.9564_wp
6695	ENDIF
6696
6697	IF ( sodium_chloride > 0.0_wp ) THEN
6698	nacl_h2so4 = - 40.288_wp * rh*5 + 115.61_wp rh*4 - 129.99_wp rh*3 + 72.652_wp &
6699	rh*2 - 22.124_wp rh + 4.2676_wp
6700	ENDIF
6701
6702	ln_h2so4_act = binary_h2so4 + nitric_acid_eq_frac * hno3_h2so4 + &
6703	hydrochloric_acid_eq_frac * hcl_h2so4 + &
6704	ammonium_sulphate_eq_frac * nh42so4_h2so4 + &
6705	ammonium_nitrate_eq_frac * nh4no3_h2so4 + &
6706	ammonium_chloride_eq_frac * nh4cl_h2so4 + &
6707	sodium_sulphate_eq_frac * na2so4_h2so4 + &
6708	sodium_nitrate_eq_frac * nano3_h2so4 + sodium_chloride_eq_frac * nacl_h2so4
6709
6710	gamma_h2so4 = EXP( ln_h2so4_act ) ! molal activity coefficient
6711	!
6712	!-- Export activity coefficients
6713	IF ( gamma_h2so4 > 1.0E-10_wp ) THEN
6714	gamma_out(4) = gamma_hhso4**2 / gamma_h2so4
6715	ENDIF
6716	IF ( gamma_hhso4 > 1.0E-10_wp ) THEN
6717	gamma_out(5) = gamma_h2so43 / gamma_hhso42
6718	ENDIF
6719	!
6720	!-- Ionic activity coefficient product
6721	act_product = gamma_h2so43 / gamma_hhso42
6722	!
6723	!-- Solve the quadratic equation (i.e. x in ax**2 + bx + c = 0)
6724	a = 1.0_wp
6725	b = -1.0_wp * ( ions(4) + ions(1) + ( ( water_total * 18.0E-3_wp ) / &
6726	( 99.0_wp * act_product ) ) )
6727	c = ions(4) * ions(1)
6728	root1 = ( ( -1.0_wp * b ) + ( ( ( b*2 ) - 4.0_wp a * c )*0.5_wp ) ) / ( 2.0_wp a )
6729	root2 = ( ( -1.0_wp * b ) - ( ( ( b*2 ) - 4.0_wp a * c) *0.5_wp ) ) / ( 2.0_wp a )
6730
6731	IF ( root1 > ions(1) .OR. root1 < 0.0_wp ) THEN
6732	root1 = 0.0_wp
6733	ENDIF
6734
6735	IF ( root2 > ions(1) .OR. root2 < 0.0_wp ) THEN
6736	root2 = 0.0_wp
6737	ENDIF
6738	!
6739	!-- Calculate the new hydrogen ion, bisulphate ion and sulphate ion
6740	!-- concentration
6741	h_real = ions(1)
6742	so4_real = ions(4)
6743	hso4_real = MAX( root1, root2 )
6744	h_real = ions(1) - hso4_real
6745	so4_real = ions(4) - hso4_real
6746	!
6747	!-- Recalculate ion molalities
6748	ions_mol(1) = h_real / ( water_total * 18.01528E-3_wp ) ! H+
6749	ions_mol(4) = so4_real / ( water_total * 18.01528E-3_wp ) ! SO4(2-)
6750	ions_mol(5) = hso4_real / ( water_total * 18.01528E-3_wp ) ! HSO4(2-)
6751
6752	h_out = h_real
6753	hso4_out = hso4_real
6754	so4_out = so4_real
6755
6756	ELSE
6757	h_out = ions(1)
6758	hso4_out = 0.0_wp
6759	so4_out = ions(4)
6760	ENDIF
6761
6762	!
6763	!-- 4) ACTIVITY COEFFICIENTS -for vapour pressures of HNO3,HCL and NH3
6764	!
6765	!-- This section evaluates activity coefficients and vapour pressures using the water content
6766	!-- calculated above) for each inorganic condensing species: a - HNO3, b - NH3, c - HCL.
6767	!-- The following procedure is used: Zaveri et al (2005) found that one could express the variation
6768	!-- of activity coefficients linearly in log-space if equivalent mole fractions were used.
6769	!-- So, by a taylor series expansion LOG( activity coefficient ) =
6770	!-- LOG( binary activity coefficient at a given RH ) +
6771	!-- (equivalent mole fraction compound A) *
6772	!-- ('interaction' parameter between A and condensing species) +
6773	!-- equivalent mole fraction compound B) *
6774	!-- ('interaction' parameter between B and condensing species).
6775	!-- Here, the interaction parameters have been fit to ADDEM by searching the whole compositon space
6776	!-- and fit usign the Levenberg-Marquardt non-linear least squares algorithm.
6777	!
6778	!-- They are given as a function of RH and vary with complexity ranging from linear to 5th order
6779	!-- polynomial expressions, the binary activity coefficients were calculated using AIM online.
6780	!-- NOTE: for NH3, no binary activity coefficient was used and the data were fit to the ratio of the
6781	!-- activity coefficients for the ammonium and hydrogen ions. Once the activity coefficients are
6782	!-- obtained the vapour pressure can be easily calculated using tabulated equilibrium constants
6783	!-- (referenced). This procedure differs from that of Zaveri et al (2005) in that it is not assumed
6784	!-- one can carry behaviour from binary mixtures in multicomponent systems. To this end we have fit
6785	!-- the 'interaction' parameters explicitly to a general inorganic equilibrium model
6786	!-- (ADDEM - Topping et al. 2005a,b). Such parameters take into account bisulphate ion dissociation
6787	!-- and water content. This also allows us to consider one regime for all composition space, rather
6788	!-- than defining sulphate rich and sulphate poor regimes.
6789	!-- NOTE: The flags "binary_case" and "full_complexity" are not used in this prototype. They are
6790	!-- used for simplification of the fit expressions when using limited composition regions.
6791	!
6792	!-- a) - ACTIVITY COEFF/VAPOUR PRESSURE - HNO3
6793	IF ( ions(1) > 0.0_wp .AND. ions(6) > 0.0_wp ) THEN
6794	binary_case = 1
6795	IF ( rh > 0.1_wp .AND. rh < 0.98_wp ) THEN
6796	IF ( binary_case == 1 ) THEN
6797	binary_hno3 = 1.8514_wp * rh*3 - 4.6991_wp rh*2 + 1.5514_wp rh + 0.90236_wp
6798	ELSEIF ( binary_case == 2 ) THEN
6799	binary_hno3 = - 1.1751_wp * ( rh*2 ) - 0.53794_wp rh + 1.2808_wp
6800	ENDIF
6801	ELSEIF ( rh >= 0.98_wp .AND. rh < 0.9999_wp ) THEN
6802	binary_hno3 = 1244.69635941351_wp * rh*3 - 2613.93941099991_wp rh**2 + &
6803	1525.0684974546_wp * rh -155.946764059316_wp
6804	ENDIF
6805	!
6806	!-- Contributions from other solutes
6807	full_complexity = 1
6808	IF ( hydrochloric_acid > 0.0_wp ) THEN ! HCL
6809	IF ( full_complexity == 1 .OR. rh < 0.4_wp ) THEN
6810	hcl_hno3 = 16.051_wp * rh*4 - 44.357_wp rh*3 + 45.141_wp rh*2 - 21.638_wp &
6811	rh + 4.8182_wp
6812	ELSEIF ( full_complexity == 0 .AND. rh > 0.4_wp ) THEN
6813	hcl_hno3 = - 1.5833_wp * rh + 1.5569_wp
6814	ENDIF
6815	ENDIF
6816
6817	IF ( sulphuric_acid > 0.0_wp ) THEN ! H2SO4
6818	IF ( full_complexity == 1 .OR. rh < 0.4_wp ) THEN
6819	h2so4_hno3 = - 3.0849_wp * rh*3 + 5.9609_wp rh*2 - 4.468_wp rh + 1.5658_wp
6820	ELSEIF ( full_complexity == 0 .AND. rh > 0.4_wp ) THEN
6821	h2so4_hno3 = - 0.93473_wp * rh + 0.9363_wp
6822	ENDIF
6823	ENDIF
6824
6825	IF ( ammonium_sulphate > 0.0_wp ) THEN ! NH42SO4
6826	nh42so4_hno3 = 16.821_wp * rh*3 - 28.391_wp rh*2 + 18.133_wp rh - 6.7356_wp
6827	ENDIF
6828
6829	IF ( ammonium_nitrate > 0.0_wp ) THEN ! NH4NO3
6830	nh4no3_hno3 = 11.01_wp * rh*3 - 21.578_wp rh*2 + 14.808_wp rh - 4.2593_wp
6831	ENDIF
6832
6833	IF ( ammonium_chloride > 0.0_wp ) THEN ! NH4Cl
6834	IF ( full_complexity == 1 .OR. rh <= 0.4_wp ) THEN
6835	nh4cl_hno3 = - 1.176_wp * rh*3 + 5.0828_wp rh*2 - 3.8792_wp rh - 0.05518_wp
6836	ELSEIF ( full_complexity == 0 .AND. rh > 0.4_wp ) THEN
6837	nh4cl_hno3 = 2.6219_wp * rh*2 - 2.2609_wp rh - 0.38436_wp
6838	ENDIF
6839	ENDIF
6840
6841	IF ( sodium_sulphate > 0.0_wp ) THEN ! Na2SO4
6842	na2so4_hno3 = 35.504_wp * rh*4 - 80.101_wp rh*3 + 67.326_wp rh*2 - 28.461_wp &
6843	rh + 5.6016_wp
6844	ENDIF
6845
6846	IF ( sodium_nitrate > 0.0_wp ) THEN ! NaNO3
6847	IF ( full_complexity == 1 .OR. rh <= 0.4_wp ) THEN
6848	nano3_hno3 = 23.659_wp * rh*5 - 66.917_wp rh*4 + 74.686_wp rh*3 - 40.795_wp &
6849	rh*2 + 10.831_wp rh - 1.4701_wp
6850	ELSEIF ( full_complexity == 0 .AND. rh > 0.4_wp ) THEN
6851	nano3_hno3 = 14.749_wp * rh*4 - 35.237_wp rh*3 + 31.196_wp rh*2 - 12.076_wp &
6852	rh + 1.3605_wp
6853	ENDIF
6854	ENDIF
6855
6856	IF ( sodium_chloride > 0.0_wp ) THEN ! NaCl
6857	IF ( full_complexity == 1 .OR. rh <= 0.4_wp ) THEN
6858	nacl_hno3 = 13.682_wp * rh*4 - 35.122_wp rh*3 + 33.397_wp rh*2 - 14.586_wp &
6859	rh + 2.6276_wp
6860	ELSEIF ( full_complexity == 0 .AND. rh > 0.4_wp ) THEN
6861	nacl_hno3 = 1.1882_wp * rh*3 - 1.1037_wp rh*2 - 0.7642_wp rh + 0.6671_wp
6862	ENDIF
6863	ENDIF
6864
6865	ln_hno3_act = binary_hno3 + hydrochloric_acid_eq_frac * hcl_hno3 + &
6866	sulphuric_acid_eq_frac * h2so4_hno3 + &
6867	ammonium_sulphate_eq_frac * nh42so4_hno3 + &
6868	ammonium_nitrate_eq_frac * nh4no3_hno3 + &
6869	ammonium_chloride_eq_frac * nh4cl_hno3 + &
6870	sodium_sulphate_eq_frac * na2so4_hno3 + &
6871	sodium_nitrate_eq_frac * nano3_hno3 + sodium_chloride_eq_frac * nacl_hno3
6872
6873	gamma_hno3 = EXP( ln_hno3_act ) ! Molal activity coefficient of HNO3
6874	gamma_out(1) = gamma_hno3
6875	!
6876	!-- Partial pressure calculation
6877	!-- k_hno3 = 2.51 * ( 10**6 )
6878	!-- k_hno3 = 2.628145923d6 !< calculated by AIM online (Clegg et al 1998) after Chameides (1984)
6879	k_hno3 = 2.6E6_wp * EXP( 8700.0_wp * henrys_temp_dep )
6880	press_hno3 = ( ions_mol(1) * ions_mol(6) * ( gamma_hno3**2 ) ) / k_hno3
6881	ENDIF
6882	!
6883	!-- b) - ACTIVITY COEFF/VAPOUR PRESSURE - NH3
6884	!-- Follow the two solute approach of Zaveri et al. (2005)
6885	IF ( ions(2) > 0.0_wp .AND. ions_mol(1) > 0.0_wp ) THEN
6886	!
6887	!-- NH4HSO4:
6888	binary_nh4hso4 = 56.907_wp * rh*6 - 155.32_wp rh*5 + 142.94_wp rh*4 - 32.298_wp &
6889	rh*3 - 27.936_wp rh*2 + 19.502_wp rh - 4.2618_wp
6890	IF ( nitric_acid > 0.0_wp) THEN ! HNO3
6891	hno3_nh4hso4 = 104.8369_wp * rh*8 - 288.8923_wp rh*7 + 129.3445_wp rh**6 + &
6892	373.0471_wp * rh*5 - 571.0385_wp rh*4 + 326.3528_wp rh**3 - &
6893	74.169_wp * rh*2 - 2.4999_wp rh + 3.17_wp
6894	ENDIF
6895
6896	IF ( hydrochloric_acid > 0.0_wp) THEN ! HCL
6897	hcl_nh4hso4 = - 7.9133_wp * rh*8 + 126.6648_wp rh*7 - 460.7425_wp rh**6 + &
6898	731.606_wp * rh*5 - 582.7467_wp rh*4 + 216.7197_wp rh**3 - &
6899	11.3934_wp * rh*2 - 17.7728_wp rh + 5.75_wp
6900	ENDIF
6901
6902	IF ( sulphuric_acid > 0.0_wp) THEN ! H2SO4
6903	h2so4_nh4hso4 = 195.981_wp * rh*8 - 779.2067_wp rh*7 + 1226.3647_wp rh**6 - &
6904	964.0261_wp * rh*5 + 391.7911_wp rh*4 - 84.1409_wp rh**3 + &
6905	20.0602_wp * rh*2 - 10.2663_wp rh + 3.5817_wp
6906	ENDIF
6907
6908	IF ( ammonium_sulphate > 0.0_wp) THEN ! NH42SO4
6909	nh42so4_nh4hso4 = 617.777_wp * rh*8 - 2547.427_wp rh*7 + 4361.6009_wp rh**6 - &
6910	4003.162_wp * rh*5 + 2117.8281_wp rh*4 - 640.0678_wp rh**3 + &
6911	98.0902_wp * rh*2 - 2.2615_wp rh - 2.3811_wp
6912	ENDIF
6913
6914	IF ( ammonium_nitrate > 0.0_wp) THEN ! NH4NO3
6915	nh4no3_nh4hso4 = - 104.4504_wp * rh*8 + 539.5921_wp rh*7 - 1157.0498_wp rh**6 + &
6916	1322.4507_wp * rh*5 - 852.2475_wp rh*4 + 298.3734_wp rh**3 - &
6917	47.0309_wp * rh*2 + 1.297_wp rh - 0.8029_wp
6918	ENDIF
6919
6920	IF ( ammonium_chloride > 0.0_wp) THEN ! NH4Cl
6921	nh4cl_nh4hso4 = 258.1792_wp * rh*8 - 1019.3777_wp rh*7 + 1592.8918_wp rh**6 - &
6922	1221.0726_wp * rh*5 + 442.2548_wp rh*4 - 43.6278_wp rh**3 - &
6923	7.5282_wp * rh*2 - 3.8459_wp rh + 2.2728_wp
6924	ENDIF
6925
6926	IF ( sodium_sulphate > 0.0_wp) THEN ! Na2SO4
6927	na2so4_nh4hso4 = 225.4238_wp * rh*8 - 732.4113_wp rh*7 + 843.7291_wp rh**6 - &
6928	322.7328_wp * rh*5 - 88.6252_wp rh*4 + 72.4434_wp rh**3 + &
6929	22.9252_wp * rh*2 - 25.3954_wp rh + 4.6971_wp
6930	ENDIF
6931
6932	IF ( sodium_nitrate > 0.0_wp) THEN ! NaNO3
6933	nano3_nh4hso4 = 96.1348_wp * rh*8 - 341.6738_wp rh*7 + 406.5314_wp rh**6 - &
6934	98.5777_wp * rh*5 - 172.8286_wp rh*4 + 149.3151_wp rh**3 - &
6935	38.9998_wp * rh*2 - 0.2251_wp rh + 0.4953_wp
6936	ENDIF
6937
6938	IF ( sodium_chloride > 0.0_wp) THEN ! NaCl
6939	nacl_nh4hso4 = 91.7856_wp * rh*8 - 316.6773_wp rh*7 + 358.2703_wp rh**6 - &
6940	68.9142_wp * rh*5 - 156.5031_wp rh*4 + 116.9592_wp rh**3 - &
6941	22.5271_wp * rh*2 - 3.7716_wp rh + 1.56_wp
6942	ENDIF
6943
6944	ln_nh4hso4_act = binary_nh4hso4 + nitric_acid_eq_frac * hno3_nh4hso4 + &
6945	hydrochloric_acid_eq_frac * hcl_nh4hso4 + &
6946	sulphuric_acid_eq_frac * h2so4_nh4hso4 + &
6947	ammonium_sulphate_eq_frac * nh42so4_nh4hso4 + &
6948	ammonium_nitrate_eq_frac * nh4no3_nh4hso4 + &
6949	ammonium_chloride_eq_frac * nh4cl_nh4hso4 + &
6950	sodium_sulphate_eq_frac * na2so4_nh4hso4 + &
6951	sodium_nitrate_eq_frac * nano3_nh4hso4 + &
6952	sodium_chloride_eq_frac * nacl_nh4hso4
6953
6954	gamma_nh4hso4 = EXP( ln_nh4hso4_act ) ! molal act. coefficient of NH4HSO4
6955	!
6956	!-- Molal activity coefficient of NO3-
6957	gamma_out(6) = gamma_nh4hso4
6958	!
6959	!-- Molal activity coefficient of NH4+
6960	gamma_nh3 = gamma_nh4hso42 / gamma_hhso42
6961	gamma_out(3) = gamma_nh3
6962	!
6963	!-- This actually represents the ratio of the ammonium to hydrogen ion activity coefficients
6964	!-- (see Zaveri paper) - multiply this by the ratio of the ammonium to hydrogen ion molality and
6965	!-- the ratio of appropriate equilibrium constants
6966	!
6967	!-- Equilibrium constants
6968	!-- k_h = 57.64d0 ! Zaveri et al. (2005)
6969	k_h = 5.8E1_wp * EXP( 4085.0_wp * henrys_temp_dep ) ! after Chameides (1984)
6970	!-- k_nh4 = 1.81E-5_wp ! Zaveri et al. (2005)
6971	k_nh4 = 1.7E-5_wp * EXP( -4325.0_wp * henrys_temp_dep ) ! Chameides (1984)
6972	!-- k_h2o = 1.01E-14_wp ! Zaveri et al (2005)
6973	k_h2o = 1.E-14_wp * EXP( -6716.0_wp * henrys_temp_dep ) ! Chameides (1984)
6974	!
6975	molality_ratio_nh3 = ions_mol(2) / ions_mol(1)
6976	!
6977	!-- Partial pressure calculation
6978	press_nh3 = molality_ratio_nh3 * gamma_nh3 * ( k_h2o / ( k_h * k_nh4 ) )
6979
6980	ENDIF
6981	!
6982	!-- c) - ACTIVITY COEFF/VAPOUR PRESSURE - HCL
6983	IF ( ions(1) > 0.0_wp .AND. ions(7) > 0.0_wp ) THEN
6984	binary_case = 1
6985	IF ( rh > 0.1_wp .AND. rh < 0.98 ) THEN
6986	IF ( binary_case == 1 ) THEN
6987	binary_hcl = - 5.0179_wp * rh*3 + 9.8816_wp rh*2 - 10.789_wp rh + 5.4737_wp
6988	ELSEIF ( binary_case == 2 ) THEN
6989	binary_hcl = - 4.6221_wp * rh + 4.2633_wp
6990	ENDIF
6991	ELSEIF ( rh >= 0.98_wp .AND. rh < 0.9999_wp ) THEN
6992	binary_hcl = 775.6111008626_wp * rh*3 - 2146.01320888771_wp rh**2 + &
6993	1969.01979670259_wp * rh - 598.878230033926_wp
6994	ENDIF
6995	ENDIF
6996
6997	IF ( nitric_acid > 0.0_wp ) THEN ! HNO3
6998	IF ( full_complexity == 1 .OR. rh <= 0.4_wp ) THEN
6999	hno3_hcl = 9.6256_wp * rh*4 - 26.507_wp rh*3 + 27.622_wp rh*2 - 12.958_wp rh + &
7000	2.2193_wp
7001	ELSEIF ( full_complexity == 0 .AND. rh > 0.4_wp ) THEN
7002	hno3_hcl = 1.3242_wp * rh*2 - 1.8827_wp rh + 0.55706_wp
7003	ENDIF
7004	ENDIF
7005
7006	IF ( sulphuric_acid > 0.0_wp ) THEN ! H2SO4
7007	IF ( full_complexity == 1 .OR. rh <= 0.4 ) THEN
7008	h2so4_hcl = 1.4406_wp * rh*3 - 2.7132_wp rh*2 + 1.014_wp rh + 0.25226_wp
7009	ELSEIF ( full_complexity == 0 .AND. rh > 0.4_wp ) THEN
7010	h2so4_hcl = 0.30993_wp * rh*2 - 0.99171_wp rh + 0.66913_wp
7011	ENDIF
7012	ENDIF
7013
7014	IF ( ammonium_sulphate > 0.0_wp ) THEN ! NH42SO4
7015	nh42so4_hcl = 22.071_wp * rh*3 - 40.678_wp rh*2 + 27.893_wp rh - 9.4338_wp
7016	ENDIF
7017
7018	IF ( ammonium_nitrate > 0.0_wp ) THEN ! NH4NO3
7019	nh4no3_hcl = 19.935_wp * rh*3 - 42.335_wp rh*2 + 31.275_wp rh - 8.8675_wp
7020	ENDIF
7021
7022	IF ( ammonium_chloride > 0.0_wp ) THEN ! NH4Cl
7023	IF ( full_complexity == 1 .OR. rh <= 0.4_wp ) THEN
7024	nh4cl_hcl = 2.8048_wp * rh*3 - 4.3182_wp rh*2 + 3.1971_wp rh - 1.6824_wp
7025	ELSEIF ( full_complexity == 0 .AND. rh > 0.4_wp ) THEN
7026	nh4cl_hcl = 1.2304_wp * rh*2 - 0.18262_wp rh - 1.0643_wp
7027	ENDIF
7028	ENDIF
7029
7030	IF ( sodium_sulphate > 0.0_wp ) THEN ! Na2SO4
7031	na2so4_hcl = 36.104_wp * rh*4 - 78.658_wp rh*3 + 63.441_wp rh*2 - 26.727_wp rh + &
7032	5.7007_wp
7033	ENDIF
7034
7035	IF ( sodium_nitrate > 0.0_wp ) THEN ! NaNO3
7036	IF ( full_complexity == 1 .OR. rh <= 0.4_wp ) THEN
7037	nano3_hcl = 54.471_wp * rh*5 - 159.42_wp rh*4 + 180.25_wp rh*3 - 98.176_wp rh**2&
7038	+ 25.309_wp * rh - 2.4275_wp
7039	ELSEIF ( full_complexity == 0 .AND. rh > 0.4_wp ) THEN
7040	nano3_hcl = 21.632_wp * rh*4 - 53.088_wp rh*3 + 47.285_wp rh*2 - 18.519_wp rh &
7041	+ 2.6846_wp
7042	ENDIF
7043	ENDIF
7044
7045	IF ( sodium_chloride > 0.0_wp ) THEN ! NaCl
7046	IF ( full_complexity == 1 .OR. rh <= 0.4_wp ) THEN
7047	nacl_hcl = 5.4138_wp * rh*4 - 12.079_wp rh*3 + 9.627_wp rh*2 - 3.3164_wp rh + &
7048	0.35224_wp
7049	ELSEIF ( full_complexity == 0 .AND. rh > 0.4_wp ) THEN
7050	nacl_hcl = 2.432_wp * rh*3 - 4.3453_wp rh*2 + 2.3834_wp rh - 0.4762_wp
7051	ENDIF
7052	ENDIF
7053
7054	ln_HCL_act = binary_hcl + nitric_acid_eq_frac * hno3_hcl + sulphuric_acid_eq_frac * h2so4_hcl +&
7055	ammonium_sulphate_eq_frac * nh42so4_hcl + ammonium_nitrate_eq_frac * nh4no3_hcl + &
7056	ammonium_chloride_eq_frac * nh4cl_hcl + sodium_sulphate_eq_frac * na2so4_hcl + &
7057	sodium_nitrate_eq_frac * nano3_hcl + sodium_chloride_eq_frac * nacl_hcl
7058
7059	gamma_hcl = EXP( ln_HCL_act ) ! Molal activity coefficient
7060	gamma_out(2) = gamma_hcl
7061	!
7062	!-- Equilibrium constant after Wagman et al. (1982) (and NIST database)
7063	k_hcl = 2E6_wp * EXP( 9000.0_wp * henrys_temp_dep )
7064
7065	press_hcl = ( ions_mol(1) * ions_mol(7) * gamma_hcl**2 ) / k_hcl
7066	!
7067	!-- 5) Ion molility output
7068	mols_out = ions_mol
7069
7070	END SUBROUTINE inorganic_pdfite
7071
7072	!------------------------------------------------------------------------------!
7073	! Description:
7074	! ------------
7075	!> Update the particle size distribution. Put particles into corrects bins.
7076	!>
7077	!> Moving-centre method assumed, i.e. particles are allowed to grow to their
7078	!> exact size as long as they are not crossing the fixed diameter bin limits.
7079	!> If the particles in a size bin cross the lower or upper diameter limit, they
7080	!> are all moved to the adjacent diameter bin and their volume is averaged with
7081	!> the particles in the new bin, which then get a new diameter.
7082	!
7083	!> Moving-centre method minimises numerical diffusion.
7084	!------------------------------------------------------------------------------!
7085	SUBROUTINE distr_update( paero )
7086
7087	IMPLICIT NONE
7088
7089	INTEGER(iwp) :: ib !< loop index
7090	INTEGER(iwp) :: mm !< loop index
7091	INTEGER(iwp) :: counti !< number of while loops
7092
7093	LOGICAL :: within_bins !< logical (particle belongs to the bin?)
7094
7095	REAL(wp) :: znfrac !< number fraction to be moved to the larger bin
7096	REAL(wp) :: zvfrac !< volume fraction to be moved to the larger bin
7097	REAL(wp) :: zVexc !< Volume in the grown bin which exceeds the bin upper limit
7098	REAL(wp) :: zVihi !< particle volume at the high end of the bin
7099	REAL(wp) :: zVilo !< particle volume at the low end of the bin
7100	REAL(wp) :: zvpart !< particle volume (m3)
7101	REAL(wp) :: zVrat !< volume ratio of a size bin
7102
7103	TYPE(t_section), DIMENSION(nbins_aerosol), INTENT(inout) :: paero !< aerosol properties
7104
7105	zvpart = 0.0_wp
7106	zvfrac = 0.0_wp
7107	within_bins = .FALSE.
7108	!
7109	!-- Check if the volume of the bin is within bin limits after update
7110	counti = 0
7111	DO WHILE ( .NOT. within_bins )
7112	within_bins = .TRUE.
7113	!
7114	!-- Loop from larger to smaller size bins
7115	DO ib = end_subrange_2b-1, start_subrange_1a, -1
7116	mm = 0
7117	IF ( paero(ib)%numc > nclim ) THEN
7118	zvpart = 0.0_wp
7119	zvfrac = 0.0_wp
7120
7121	IF ( ib == end_subrange_2a ) CYCLE
7122	!
7123	!-- Dry volume
7124	zvpart = SUM( paero(ib)%volc(1:7) ) / paero(ib)%numc
7125	!
7126	!-- Smallest bin cannot decrease
7127	IF ( paero(ib)%vlolim > zvpart .AND. ib == start_subrange_1a ) CYCLE
7128	!
7129	!-- Decreasing bins
7130	IF ( paero(ib)%vlolim > zvpart ) THEN
7131	mm = ib - 1
7132	IF ( ib == start_subrange_2b ) mm = end_subrange_1a ! 2b goes to 1a
7133
7134	paero(mm)%numc = paero(mm)%numc + paero(ib)%numc
7135	paero(ib)%numc = 0.0_wp
7136	paero(mm)%volc(:) = paero(mm)%volc(:) + paero(ib)%volc(:)
7137	paero(ib)%volc(:) = 0.0_wp
7138	CYCLE
7139	ENDIF
7140	!
7141	!-- If size bin has not grown, cycle.
7142	!-- Changed by Mona: compare to the arithmetic mean volume, as done originally. Now
7143	!-- particle volume is derived from the geometric mean diameter, not arithmetic (see
7144	!-- SUBROUTINE set_sizebins).
7145	IF ( zvpart <= api6 * ( ( aero(ib)%vhilim + aero(ib)%vlolim ) / ( 2.0_wp * api6 ) ) ) &
7146	CYCLE
7147	!
7148	!-- Avoid precision problems
7149	IF ( ABS( zvpart - api6 * paero(ib)%dmid**3 ) < 1.0E-35_wp ) CYCLE
7150	!
7151	!-- Volume ratio of the size bin
7152	zVrat = paero(ib)%vhilim / paero(ib)%vlolim
7153	!
7154	!-- Particle volume at the low end of the bin
7155	zVilo = 2.0_wp * zvpart / ( 1.0_wp + zVrat )
7156	!
7157	!-- Particle volume at the high end of the bin
7158	zVihi = zVrat * zVilo
7159	!
7160	!-- Volume in the grown bin which exceeds the bin upper limit
7161	zVexc = 0.5_wp * ( zVihi + paero(ib)%vhilim )
7162	!
7163	!-- Number fraction to be moved to the larger bin
7164	znfrac = MIN( 1.0_wp, ( zVihi - paero(ib)%vhilim) / ( zVihi - zVilo ) )
7165	!
7166	!-- Volume fraction to be moved to the larger bin
7167	zvfrac = MIN( 0.99_wp, znfrac * zVexc / zvpart )
7168	IF ( zvfrac < 0.0_wp ) THEN
7169	message_string = 'Error: zvfrac < 0'
7170	CALL message( 'salsa_mod: distr_update', 'PA0624', 1, 2, 0, 6, 0 )
7171	ENDIF
7172	!
7173	!-- Update bin
7174	mm = ib + 1
7175	!
7176	!-- Volume (cm3/cm3)
7177	paero(mm)%volc(:) = paero(mm)%volc(:) + znfrac * paero(ib)%numc * zVexc * &
7178	paero(ib)%volc(:) / SUM( paero(ib)%volc(:) )
7179	paero(ib)%volc(:) = paero(ib)%volc(:) - znfrac * paero(ib)%numc * zVexc * &
7180	paero(ib)%volc(:) / SUM( paero(ib)%volc(:) )
7181
7182	!-- Number concentration (#/m3)
7183	paero(mm)%numc = paero(mm)%numc + znfrac * paero(ib)%numc
7184	paero(ib)%numc = paero(ib)%numc * ( 1.0_wp - znfrac )
7185
7186	ENDIF ! nclim
7187
7188	IF ( paero(ib)%numc > nclim ) THEN
7189	zvpart = SUM( paero(ib)%volc(1:7) ) / paero(ib)%numc ! Note: dry volume!
7190	within_bins = ( paero(ib)%vlolim < zvpart .AND. zvpart < paero(ib)%vhilim )
7191	ENDIF
7192
7193	ENDDO ! - ib
7194
7195	counti = counti + 1
7196	IF ( counti > 100 ) THEN
7197	message_string = 'Error: Aerosol bin update not converged'
7198	CALL message( 'salsa_mod: distr_update', 'PA0625', 1, 2, 0, 6, 0 )
7199	ENDIF
7200
7201	ENDDO ! - within bins
7202
7203	END SUBROUTINE distr_update
7204
7205	!------------------------------------------------------------------------------!
7206	! Description:
7207	! ------------
7208	!> salsa_diagnostics: Update properties for the current timestep:
7209	!>
7210	!> Juha Tonttila, FMI, 2014
7211	!> Tomi Raatikainen, FMI, 2016
7212	!------------------------------------------------------------------------------!
7213	SUBROUTINE salsa_diagnostics( i, j )
7214
7215	USE cpulog, &
7216	ONLY: cpu_log, log_point_s
7217
7218	IMPLICIT NONE
7219
7220	INTEGER(iwp) :: ib !<
7221	INTEGER(iwp) :: ic !<
7222	INTEGER(iwp) :: icc !<
7223	INTEGER(iwp) :: ig !<
7224	INTEGER(iwp) :: k !<
7225
7226	INTEGER(iwp), INTENT(in) :: i !<
7227	INTEGER(iwp), INTENT(in) :: j !<
7228
7229	REAL(wp), DIMENSION(nzb:nzt+1) :: flag !< flag to mask topography
7230	REAL(wp), DIMENSION(nzb:nzt+1) :: flag_zddry !< flag to mask zddry
7231	REAL(wp), DIMENSION(nzb:nzt+1) :: in_adn !< air density (kg/m3)
7232	REAL(wp), DIMENSION(nzb:nzt+1) :: in_p !< pressure
7233	REAL(wp), DIMENSION(nzb:nzt+1) :: in_t !< temperature (K)
7234	REAL(wp), DIMENSION(nzb:nzt+1) :: mcsum !< sum of mass concentration
7235	REAL(wp), DIMENSION(nzb:nzt+1) :: ppm_to_nconc !< Conversion factor: ppm to #/m3
7236	REAL(wp), DIMENSION(nzb:nzt+1) :: zddry !< particle dry diameter
7237	REAL(wp), DIMENSION(nzb:nzt+1) :: zvol !< particle volume
7238
7239	flag_zddry = 0.0_wp
7240	in_adn = 0.0_wp
7241	in_p = 0.0_wp
7242	in_t = 0.0_wp
7243	ppm_to_nconc = 1.0_wp
7244	zddry = 0.0_wp
7245	zvol = 0.0_wp
7246
7247	!$OMP MASTER
7248	CALL cpu_log( log_point_s(94), 'salsa diagnostics ', 'start' )
7249	!$OMP END MASTER
7250
7251	!
7252	!-- Calculate thermodynamic quantities needed in SALSA
7253	CALL salsa_thrm_ij( i, j, p_ij=in_p, temp_ij=in_t, adn_ij=in_adn )
7254	!
7255	!-- Calculate conversion factors for gas concentrations
7256	ppm_to_nconc = for_ppm_to_nconc * in_p / in_t
7257	!
7258	!-- Predetermine flag to mask topography
7259	flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_0(:,j,i), 0 ) )
7260
7261	DO ib = 1, nbins_aerosol ! aerosol size bins
7262	!
7263	!-- Remove negative values
7264	aerosol_number(ib)%conc(:,j,i) = MAX( nclim, aerosol_number(ib)%conc(:,j,i) ) * flag
7265	!
7266	!-- Calculate total mass concentration per bin
7267	mcsum = 0.0_wp
7268	DO ic = 1, ncc
7269	icc = ( ic - 1 ) * nbins_aerosol + ib
7270	mcsum = mcsum + aerosol_mass(icc)%conc(:,j,i) * flag
7271	ENDDO
7272	!
7273	!-- Check that number and mass concentration match qualitatively
7274	IF ( ANY ( aerosol_number(ib)%conc(:,j,i) >= nclim .AND. mcsum <= 0.0_wp ) ) THEN
7275	DO k = nzb+1, nzt
7276	IF ( aerosol_number(ib)%conc(k,j,i) >= nclim .AND. mcsum(k) <= 0.0_wp ) THEN
7277	aerosol_number(ib)%conc(k,j,i) = nclim * flag(k)
7278	DO ic = 1, ncomponents_mass
7279	icc = ( ic - 1 ) * nbins_aerosol + ib
7280	aerosol_mass(icc)%conc(k,j,i) = mclim * flag(k)
7281	ENDDO
7282	ENDIF
7283	ENDDO
7284	ENDIF
7285	!
7286	!-- Update aerosol particle radius
7287	CALL bin_mixrat( 'dry', ib, i, j, zvol )
7288	zvol = zvol / arhoh2so4 ! Why on sulphate?
7289	!
7290	!-- Particles smaller then 0.1 nm diameter are set to zero
7291	zddry = ( zvol / MAX( nclim, aerosol_number(ib)%conc(:,j,i) ) / api6 )**0.33333333_wp
7292	flag_zddry = MERGE( 1.0_wp, 0.0_wp, ( zddry < 1.0E-10_wp .AND. &
7293	aerosol_number(ib)%conc(:,j,i) > nclim ) )
7294	!
7295	!-- Volatile species to the gas phase
7296	IF ( index_so4 > 0 .AND. lscndgas ) THEN
7297	ic = ( index_so4 - 1 ) * nbins_aerosol + ib
7298	IF ( salsa_gases_from_chem ) THEN
7299	ig = gas_index_chem(1)
7300	chem_species(ig)%conc(:,j,i) = chem_species(ig)%conc(:,j,i) + &
7301	aerosol_mass(ic)%conc(:,j,i) * avo * flag_zddry / &
7302	( amh2so4 * ppm_to_nconc ) * flag
7303	ELSE
7304	salsa_gas(1)%conc(:,j,i) = salsa_gas(1)%conc(:,j,i) + aerosol_mass(ic)%conc(:,j,i) / &
7305	amh2so4 * avo * flag_zddry * flag
7306	ENDIF
7307	ENDIF
7308	IF ( index_oc > 0 .AND. lscndgas ) THEN
7309	ic = ( index_oc - 1 ) * nbins_aerosol + ib
7310	IF ( salsa_gases_from_chem ) THEN
7311	ig = gas_index_chem(5)
7312	chem_species(ig)%conc(:,j,i) = chem_species(ig)%conc(:,j,i) + &
7313	aerosol_mass(ic)%conc(:,j,i) * avo * flag_zddry / &
7314	( amoc * ppm_to_nconc ) * flag
7315	ELSE
7316	salsa_gas(5)%conc(:,j,i) = salsa_gas(5)%conc(:,j,i) + aerosol_mass(ic)%conc(:,j,i) / &
7317	amoc * avo * flag_zddry * flag
7318	ENDIF
7319	ENDIF
7320	IF ( index_no > 0 .AND. lscndgas ) THEN
7321	ic = ( index_no - 1 ) * nbins_aerosol + ib
7322	IF ( salsa_gases_from_chem ) THEN
7323	ig = gas_index_chem(2)
7324	chem_species(ig)%conc(:,j,i) = chem_species(ig)%conc(:,j,i) + &
7325	aerosol_mass(ic)%conc(:,j,i) * avo * flag_zddry / &
7326	( amhno3 * ppm_to_nconc ) *flag
7327	ELSE
7328	salsa_gas(2)%conc(:,j,i) = salsa_gas(2)%conc(:,j,i) + aerosol_mass(ic)%conc(:,j,i) / &
7329	amhno3 * avo * flag_zddry * flag
7330	ENDIF
7331	ENDIF
7332	IF ( index_nh > 0 .AND. lscndgas ) THEN
7333	ic = ( index_nh - 1 ) * nbins_aerosol + ib
7334	IF ( salsa_gases_from_chem ) THEN
7335	ig = gas_index_chem(3)
7336	chem_species(ig)%conc(:,j,i) = chem_species(ig)%conc(:,j,i) + &
7337	aerosol_mass(ic)%conc(:,j,i) * avo * flag_zddry / &
7338	( amnh3 * ppm_to_nconc ) *flag
7339	ELSE
7340	salsa_gas(3)%conc(:,j,i) = salsa_gas(3)%conc(:,j,i) + aerosol_mass(ic)%conc(:,j,i) / &
7341	amnh3 * avo * flag_zddry *flag
7342	ENDIF
7343	ENDIF
7344	!
7345	!-- Mass and number to zero (insoluble species and water are lost)
7346	DO ic = 1, ncomponents_mass
7347	icc = ( ic - 1 ) * nbins_aerosol + ib
7348	aerosol_mass(icc)%conc(:,j,i) = MERGE( mclim * flag, aerosol_mass(icc)%conc(:,j,i), &
7349	flag_zddry > 0.0_wp )
7350	ENDDO
7351	aerosol_number(ib)%conc(:,j,i) = MERGE( nclim, aerosol_number(ib)%conc(:,j,i), &
7352	flag_zddry > 0.0_wp )
7353	ra_dry(:,j,i,ib) = MAX( 1.0E-10_wp, 0.5_wp * zddry )
7354
7355	ENDDO
7356	IF ( .NOT. salsa_gases_from_chem ) THEN
7357	DO ig = 1, ngases_salsa
7358	salsa_gas(ig)%conc(:,j,i) = MAX( nclim, salsa_gas(ig)%conc(:,j,i) ) * flag
7359	ENDDO
7360	ENDIF
7361
7362	!$OMP MASTER
7363	CALL cpu_log( log_point_s(94), 'salsa diagnostics ', 'stop' )
7364	!$OMP END MASTER
7365
7366	END SUBROUTINE salsa_diagnostics
7367
7368
7369	!------------------------------------------------------------------------------!
7370	! Description:
7371	! ------------
7372	!> Call for all grid points
7373	!------------------------------------------------------------------------------!
7374	SUBROUTINE salsa_actions( location )
7375
7376
7377	CHARACTER (LEN=*), INTENT(IN) :: location !< call location string
7378
7379	SELECT CASE ( location )
7380
7381	CASE ( 'before_timestep' )
7382
7383	IF ( ws_scheme_sca ) sums_salsa_ws_l = 0.0_wp
7384
7385	CASE DEFAULT
7386	CONTINUE
7387
7388	END SELECT
7389
7390	END SUBROUTINE salsa_actions
7391
7392
7393	!------------------------------------------------------------------------------!
7394	! Description:
7395	! ------------
7396	!> Call for grid points i,j
7397	!------------------------------------------------------------------------------!
7398
7399	SUBROUTINE salsa_actions_ij( i, j, location )
7400
7401
7402	INTEGER(iwp), INTENT(IN) :: i !< grid index in x-direction
7403	INTEGER(iwp), INTENT(IN) :: j !< grid index in y-direction
7404	CHARACTER (LEN=*), INTENT(IN) :: location !< call location string
7405	INTEGER(iwp) :: dummy !< call location string
7406
7407	IF ( salsa ) dummy = i + j
7408
7409	SELECT CASE ( location )
7410
7411	CASE ( 'before_timestep' )
7412
7413	IF ( ws_scheme_sca ) sums_salsa_ws_l = 0.0_wp
7414
7415	CASE DEFAULT
7416	CONTINUE
7417
7418	END SELECT
7419
7420
7421	END SUBROUTINE salsa_actions_ij
7422
7423	!------------------------------------------------------------------------------!
7424	! Description:
7425	! ------------
7426	!> Call for all grid points
7427	!------------------------------------------------------------------------------!
7428	SUBROUTINE salsa_non_advective_processes
7429
7430	USE cpulog, &
7431	ONLY: cpu_log, log_point_s
7432
7433	IMPLICIT NONE
7434
7435	INTEGER(iwp) :: i !<
7436	INTEGER(iwp) :: j !<
7437
7438	IF ( time_since_reference_point >= skip_time_do_salsa ) THEN
7439	IF ( ( time_since_reference_point - last_salsa_time ) >= dt_salsa ) THEN
7440	!
7441	!-- Calculate aerosol dynamic processes. salsa_driver can be run with a longer time step.
7442	CALL cpu_log( log_point_s(90), 'salsa processes ', 'start' )
7443	DO i = nxl, nxr
7444	DO j = nys, nyn
7445	CALL salsa_diagnostics( i, j )
7446	CALL salsa_driver( i, j, 3 )
7447	CALL salsa_diagnostics( i, j )
7448	ENDDO
7449	ENDDO
7450	CALL cpu_log( log_point_s(90), 'salsa processes ', 'stop' )
7451	ENDIF
7452	ENDIF
7453
7454	END SUBROUTINE salsa_non_advective_processes
7455
7456
7457	!------------------------------------------------------------------------------!
7458	! Description:
7459	! ------------
7460	!> Call for grid points i,j
7461	!------------------------------------------------------------------------------!
7462	SUBROUTINE salsa_non_advective_processes_ij( i, j )
7463
7464	USE cpulog, &
7465	ONLY: cpu_log, log_point_s
7466
7467	IMPLICIT NONE
7468
7469	INTEGER(iwp), INTENT(IN) :: i !< grid index in x-direction
7470	INTEGER(iwp), INTENT(IN) :: j !< grid index in y-direction
7471
7472	IF ( time_since_reference_point >= skip_time_do_salsa ) THEN
7473	IF ( ( time_since_reference_point - last_salsa_time ) >= dt_salsa ) THEN
7474	!
7475	!-- Calculate aerosol dynamic processes. salsa_driver can be run with a longer time step.
7476	CALL cpu_log( log_point_s(90), 'salsa processes ', 'start' )
7477	CALL salsa_diagnostics( i, j )
7478	CALL salsa_driver( i, j, 3 )
7479	CALL salsa_diagnostics( i, j )
7480	CALL cpu_log( log_point_s(90), 'salsa processes ', 'stop' )
7481	ENDIF
7482	ENDIF
7483
7484	END SUBROUTINE salsa_non_advective_processes_ij
7485
7486	!------------------------------------------------------------------------------!
7487	! Description:
7488	! ------------
7489	!> Routine for exchange horiz of salsa variables.
7490	!------------------------------------------------------------------------------!
7491	SUBROUTINE salsa_exchange_horiz_bounds
7492
7493	USE cpulog, &
7494	ONLY: cpu_log, log_point_s
7495
7496	IMPLICIT NONE
7497
7498	INTEGER(iwp) :: ib !<
7499	INTEGER(iwp) :: ic !<
7500	INTEGER(iwp) :: icc !<
7501	INTEGER(iwp) :: ig !<
7502
7503	IF ( time_since_reference_point >= skip_time_do_salsa ) THEN
7504	IF ( ( time_since_reference_point - last_salsa_time ) >= dt_salsa ) THEN
7505
7506	CALL cpu_log( log_point_s(91), 'salsa exch-horiz ', 'start' )
7507	!
7508	!-- Exchange ghost points and decycle if needed.
7509	DO ib = 1, nbins_aerosol
7510	CALL exchange_horiz( aerosol_number(ib)%conc, nbgp )
7511	CALL salsa_boundary_conds( aerosol_number(ib)%conc, aerosol_number(ib)%init )
7512	DO ic = 1, ncomponents_mass
7513	icc = ( ic - 1 ) * nbins_aerosol + ib
7514	CALL exchange_horiz( aerosol_mass(icc)%conc, nbgp )
7515	CALL salsa_boundary_conds( aerosol_mass(icc)%conc, aerosol_mass(icc)%init )
7516	ENDDO
7517	ENDDO
7518	IF ( .NOT. salsa_gases_from_chem ) THEN
7519	DO ig = 1, ngases_salsa
7520	CALL exchange_horiz( salsa_gas(ig)%conc, nbgp )
7521	CALL salsa_boundary_conds( salsa_gas(ig)%conc, salsa_gas(ig)%init )
7522	ENDDO
7523	ENDIF
7524	CALL cpu_log( log_point_s(91), 'salsa exch-horiz ', 'stop' )
7525	!
7526	!-- Update last_salsa_time
7527	last_salsa_time = time_since_reference_point
7528	ENDIF
7529	ENDIF
7530
7531	END SUBROUTINE salsa_exchange_horiz_bounds
7532
7533	!------------------------------------------------------------------------------!
7534	! Description:
7535	! ------------
7536	!> Calculate the prognostic equation for aerosol number and mass, and gas
7537	!> concentrations. Cache-optimized.
7538	!------------------------------------------------------------------------------!
7539	SUBROUTINE salsa_prognostic_equations_ij( i, j, i_omp_start, tn )
7540
7541	USE control_parameters, &
7542	ONLY: time_since_reference_point
7543
7544	IMPLICIT NONE
7545
7546	INTEGER(iwp) :: i !<
7547	INTEGER(iwp) :: i_omp_start !<
7548	INTEGER(iwp) :: ib !< loop index for aerosol number bin OR gas index
7549	INTEGER(iwp) :: ic !< loop index for aerosol mass bin
7550	INTEGER(iwp) :: icc !< (c-1)*nbins_aerosol+b
7551	INTEGER(iwp) :: ig !< loop index for salsa gases
7552	INTEGER(iwp) :: j !<
7553	INTEGER(iwp) :: tn !<
7554
7555	IF ( time_since_reference_point >= skip_time_do_salsa ) THEN
7556	!
7557	!-- Aerosol number
7558	DO ib = 1, nbins_aerosol
7559	!kk sums_salsa_ws_l = aerosol_number(ib)%sums_ws_l
7560	CALL salsa_tendency( 'aerosol_number', aerosol_number(ib)%conc_p, aerosol_number(ib)%conc,&
7561	aerosol_number(ib)%tconc_m, i, j, i_omp_start, tn, ib, ib, &
7562	aerosol_number(ib)%flux_s, aerosol_number(ib)%diss_s, &
7563	aerosol_number(ib)%flux_l, aerosol_number(ib)%diss_l, &
7564	aerosol_number(ib)%init, .TRUE. )
7565	!kk aerosol_number(ib)%sums_ws_l = sums_salsa_ws_l
7566	!
7567	!-- Aerosol mass
7568	DO ic = 1, ncomponents_mass
7569	icc = ( ic - 1 ) * nbins_aerosol + ib
7570	!kk sums_salsa_ws_l = aerosol_mass(icc)%sums_ws_l
7571	CALL salsa_tendency( 'aerosol_mass', aerosol_mass(icc)%conc_p, aerosol_mass(icc)%conc,&
7572	aerosol_mass(icc)%tconc_m, i, j, i_omp_start, tn, ib, ic, &
7573	aerosol_mass(icc)%flux_s, aerosol_mass(icc)%diss_s, &
7574	aerosol_mass(icc)%flux_l, aerosol_mass(icc)%diss_l, &
7575	aerosol_mass(icc)%init, .TRUE. )
7576	!kk aerosol_mass(icc)%sums_ws_l = sums_salsa_ws_l
7577
7578	ENDDO ! ic
7579	ENDDO ! ib
7580	!
7581	!-- Gases
7582	IF ( .NOT. salsa_gases_from_chem ) THEN
7583
7584	DO ig = 1, ngases_salsa
7585	!kk sums_salsa_ws_l = salsa_gas(ig)%sums_ws_l
7586	CALL salsa_tendency( 'salsa_gas', salsa_gas(ig)%conc_p, salsa_gas(ig)%conc, &
7587	salsa_gas(ig)%tconc_m, i, j, i_omp_start, tn, ig, ig, &
7588	salsa_gas(ig)%flux_s, salsa_gas(ig)%diss_s, salsa_gas(ig)%flux_l,&
7589	salsa_gas(ig)%diss_l, salsa_gas(ig)%init, .FALSE. )
7590	!kk salsa_gas(ig)%sums_ws_l = sums_salsa_ws_l
7591
7592	ENDDO ! ig
7593
7594	ENDIF
7595
7596	ENDIF
7597
7598	END SUBROUTINE salsa_prognostic_equations_ij
7599	!
7600	!------------------------------------------------------------------------------!
7601	! Description:
7602	! ------------
7603	!> Calculate the prognostic equation for aerosol number and mass, and gas
7604	!> concentrations. For vector machines.
7605	!------------------------------------------------------------------------------!
7606	SUBROUTINE salsa_prognostic_equations()
7607
7608	USE control_parameters, &
7609	ONLY: time_since_reference_point
7610
7611	IMPLICIT NONE
7612
7613	INTEGER(iwp) :: ib !< loop index for aerosol number bin OR gas index
7614	INTEGER(iwp) :: ic !< loop index for aerosol mass bin
7615	INTEGER(iwp) :: icc !< (c-1)*nbins_aerosol+b
7616	INTEGER(iwp) :: ig !< loop index for salsa gases
7617
7618	IF ( time_since_reference_point >= skip_time_do_salsa ) THEN
7619	!
7620	!-- Aerosol number
7621	DO ib = 1, nbins_aerosol
7622	sums_salsa_ws_l = aerosol_number(ib)%sums_ws_l
7623	CALL salsa_tendency( 'aerosol_number', aerosol_number(ib)%conc_p, aerosol_number(ib)%conc,&
7624	aerosol_number(ib)%tconc_m, ib, ib, aerosol_number(ib)%init, .TRUE. )
7625	aerosol_number(ib)%sums_ws_l = sums_salsa_ws_l
7626	!
7627	!-- Aerosol mass
7628	DO ic = 1, ncomponents_mass
7629	icc = ( ic - 1 ) * nbins_aerosol + ib
7630	sums_salsa_ws_l = aerosol_mass(icc)%sums_ws_l
7631	CALL salsa_tendency( 'aerosol_mass', aerosol_mass(icc)%conc_p, aerosol_mass(icc)%conc,&
7632	aerosol_mass(icc)%tconc_m, ib, ic, aerosol_mass(icc)%init, .TRUE. )
7633	aerosol_mass(icc)%sums_ws_l = sums_salsa_ws_l
7634
7635	ENDDO ! ic
7636	ENDDO ! ib
7637	!
7638	!-- Gases
7639	IF ( .NOT. salsa_gases_from_chem ) THEN
7640
7641	DO ig = 1, ngases_salsa
7642	sums_salsa_ws_l = salsa_gas(ig)%sums_ws_l
7643	CALL salsa_tendency( 'salsa_gas', salsa_gas(ig)%conc_p, salsa_gas(ig)%conc, &
7644	salsa_gas(ig)%tconc_m, ig, ig, salsa_gas(ig)%init, .FALSE. )
7645	salsa_gas(ig)%sums_ws_l = sums_salsa_ws_l
7646
7647	ENDDO ! ig
7648
7649	ENDIF
7650
7651	ENDIF
7652
7653	END SUBROUTINE salsa_prognostic_equations
7654	!
7655	!------------------------------------------------------------------------------!
7656	! Description:
7657	! ------------
7658	!> Tendencies for aerosol number and mass and gas concentrations.
7659	!> Cache-optimized.
7660	!------------------------------------------------------------------------------!
7661	SUBROUTINE salsa_tendency_ij( id, rs_p, rs, trs_m, i, j, i_omp_start, tn, ib, ic, flux_s, diss_s, &
7662	flux_l, diss_l, rs_init, do_sedimentation )
7663
7664	USE advec_ws, &
7665	ONLY: advec_s_ws
7666
7667	USE advec_s_pw_mod, &
7668	ONLY: advec_s_pw
7669
7670	USE advec_s_up_mod, &
7671	ONLY: advec_s_up
7672
7673	USE arrays_3d, &
7674	ONLY: ddzu, rdf_sc, tend
7675
7676	USE diffusion_s_mod, &
7677	ONLY: diffusion_s
7678
7679	USE indices, &
7680	ONLY: wall_flags_0
7681
7682	USE pegrid, &
7683	ONLY: threads_per_task
7684
7685	USE surface_mod, &
7686	ONLY : surf_def_h, surf_def_v, surf_lsm_h, surf_lsm_v, surf_usm_h, surf_usm_v
7687
7688	IMPLICIT NONE
7689
7690	CHARACTER(LEN = *) :: id !<
7691
7692	INTEGER(iwp) :: i !<
7693	INTEGER(iwp) :: i_omp_start !<
7694	INTEGER(iwp) :: ib !< loop index for aerosol number bin OR gas index
7695	INTEGER(iwp) :: ic !< loop index for aerosol mass bin
7696	INTEGER(iwp) :: icc !< (c-1)*nbins_aerosol+b
7697	INTEGER(iwp) :: j !<
7698	INTEGER(iwp) :: k !<
7699	INTEGER(iwp) :: tn !<
7700
7701	LOGICAL :: do_sedimentation !<
7702
7703	REAL(wp), DIMENSION(nzb:nzt+1) :: rs_init !<
7704
7705	REAL(wp), DIMENSION(nzb+1:nzt,0:threads_per_task-1) :: diss_s !<
7706	REAL(wp), DIMENSION(nzb+1:nzt,0:threads_per_task-1) :: flux_s !<
7707
7708	REAL(wp), DIMENSION(nzb+1:nzt,nys:nyn,0:threads_per_task-1) :: diss_l !<
7709	REAL(wp), DIMENSION(nzb+1:nzt,nys:nyn,0:threads_per_task-1) :: flux_l !<
7710
7711	REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) :: rs_p !<
7712	REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) :: rs !<
7713	REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) :: trs_m !<
7714
7715	icc = ( ic - 1 ) * nbins_aerosol + ib
7716	!
7717	!-- Tendency-terms for reactive scalar
7718	tend(:,j,i) = 0.0_wp
7719	!
7720	!-- Advection terms
7721	IF ( timestep_scheme(1:5) == 'runge' ) THEN
7722	IF ( ws_scheme_sca ) THEN
7723	CALL advec_s_ws( i, j, rs, id, flux_s, diss_s, flux_l, diss_l, i_omp_start, tn )
7724	ELSE
7725	CALL advec_s_pw( i, j, rs )
7726	ENDIF
7727	ELSE
7728	CALL advec_s_up( i, j, rs )
7729	ENDIF
7730	!
7731	!-- Diffusion terms
7732	SELECT CASE ( id )
7733	CASE ( 'aerosol_number' )
7734	CALL diffusion_s( i, j, rs, surf_def_h(0)%answs(:,ib), &
7735	surf_def_h(1)%answs(:,ib), surf_def_h(2)%answs(:,ib), &
7736	surf_lsm_h%answs(:,ib), surf_usm_h%answs(:,ib), &
7737	surf_def_v(0)%answs(:,ib), surf_def_v(1)%answs(:,ib), &
7738	surf_def_v(2)%answs(:,ib), surf_def_v(3)%answs(:,ib), &
7739	surf_lsm_v(0)%answs(:,ib), surf_lsm_v(1)%answs(:,ib), &
7740	surf_lsm_v(2)%answs(:,ib), surf_lsm_v(3)%answs(:,ib), &
7741	surf_usm_v(0)%answs(:,ib), surf_usm_v(1)%answs(:,ib), &
7742	surf_usm_v(2)%answs(:,ib), surf_usm_v(3)%answs(:,ib) )
7743	CASE ( 'aerosol_mass' )
7744	CALL diffusion_s( i, j, rs, surf_def_h(0)%amsws(:,icc), &
7745	surf_def_h(1)%amsws(:,icc), surf_def_h(2)%amsws(:,icc), &
7746	surf_lsm_h%amsws(:,icc), surf_usm_h%amsws(:,icc), &
7747	surf_def_v(0)%amsws(:,icc), surf_def_v(1)%amsws(:,icc), &
7748	surf_def_v(2)%amsws(:,icc), surf_def_v(3)%amsws(:,icc), &
7749	surf_lsm_v(0)%amsws(:,icc), surf_lsm_v(1)%amsws(:,icc), &
7750	surf_lsm_v(2)%amsws(:,icc), surf_lsm_v(3)%amsws(:,icc), &
7751	surf_usm_v(0)%amsws(:,icc), surf_usm_v(1)%amsws(:,icc), &
7752	surf_usm_v(2)%amsws(:,icc), surf_usm_v(3)%amsws(:,icc) )
7753	CASE ( 'salsa_gas' )
7754	CALL diffusion_s( i, j, rs, surf_def_h(0)%gtsws(:,ib), &
7755	surf_def_h(1)%gtsws(:,ib), surf_def_h(2)%gtsws(:,ib), &
7756	surf_lsm_h%gtsws(:,ib), surf_usm_h%gtsws(:,ib), &
7757	surf_def_v(0)%gtsws(:,ib), surf_def_v(1)%gtsws(:,ib), &
7758	surf_def_v(2)%gtsws(:,ib), surf_def_v(3)%gtsws(:,ib), &
7759	surf_lsm_v(0)%gtsws(:,ib), surf_lsm_v(1)%gtsws(:,ib), &
7760	surf_lsm_v(2)%gtsws(:,ib), surf_lsm_v(3)%gtsws(:,ib), &
7761	surf_usm_v(0)%gtsws(:,ib), surf_usm_v(1)%gtsws(:,ib), &
7762	surf_usm_v(2)%gtsws(:,ib), surf_usm_v(3)%gtsws(:,ib) )
7763	END SELECT
7764	!
7765	!-- Sedimentation and prognostic equation for aerosol number and mass
7766	IF ( lsdepo .AND. do_sedimentation ) THEN
7767	!DIR$ IVDEP
7768	DO k = nzb+1, nzt
7769	tend(k,j,i) = tend(k,j,i) - MAX( 0.0_wp, ( rs(k+1,j,i) * sedim_vd(k+1,j,i,ib) - &
7770	rs(k,j,i) * sedim_vd(k,j,i,ib) ) * ddzu(k) ) &
7771	* MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_0(k-1,j,i), 0 ) )
7772	rs_p(k,j,i) = rs(k,j,i) + ( dt_3d * ( tsc(2) * tend(k,j,i) + tsc(3) * trs_m(k,j,i) ) &
7773	- tsc(5) * rdf_sc(k) * ( rs(k,j,i) - rs_init(k) ) ) &
7774	* MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_0(k,j,i), 0 ) )
7775	IF ( rs_p(k,j,i) < 0.0_wp ) rs_p(k,j,i) = 0.1_wp * rs(k,j,i)
7776	ENDDO
7777	ELSE
7778	!
7779	!-- Prognostic equation
7780	!DIR$ IVDEP
7781	DO k = nzb+1, nzt
7782	rs_p(k,j,i) = rs(k,j,i) + ( dt_3d * ( tsc(2) * tend(k,j,i) + tsc(3) * trs_m(k,j,i) ) &
7783	- tsc(5) * rdf_sc(k) * ( rs(k,j,i) - rs_init(k) ) )&
7784	* MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_0(k,j,i), 0 ) )
7785	IF ( rs_p(k,j,i) < 0.0_wp ) rs_p(k,j,i) = 0.1_wp * rs(k,j,i)
7786	ENDDO
7787	ENDIF
7788	!
7789	!-- Calculate tendencies for the next Runge-Kutta step
7790	IF ( timestep_scheme(1:5) == 'runge' ) THEN
7791	IF ( intermediate_timestep_count == 1 ) THEN
7792	DO k = nzb+1, nzt
7793	trs_m(k,j,i) = tend(k,j,i)
7794	ENDDO
7795	ELSEIF ( intermediate_timestep_count < intermediate_timestep_count_max ) THEN
7796	DO k = nzb+1, nzt
7797	trs_m(k,j,i) = -9.5625_wp * tend(k,j,i) + 5.3125_wp * trs_m(k,j,i)
7798	ENDDO
7799	ENDIF
7800	ENDIF
7801
7802	END SUBROUTINE salsa_tendency_ij
7803	!
7804	!------------------------------------------------------------------------------!
7805	! Description:
7806	! ------------
7807	!> Calculate the tendencies for aerosol number and mass concentrations.
7808	!> For vector machines.
7809	!------------------------------------------------------------------------------!
7810	SUBROUTINE salsa_tendency( id, rs_p, rs, trs_m, ib, ic, rs_init, do_sedimentation )
7811
7812	USE advec_ws, &
7813	ONLY: advec_s_ws
7814	USE advec_s_pw_mod, &
7815	ONLY: advec_s_pw
7816	USE advec_s_up_mod, &
7817	ONLY: advec_s_up
7818	USE arrays_3d, &
7819	ONLY: ddzu, rdf_sc, tend
7820	USE diffusion_s_mod, &
7821	ONLY: diffusion_s
7822	USE indices, &
7823	ONLY: wall_flags_0
7824	USE surface_mod, &
7825	ONLY : surf_def_h, surf_def_v, surf_lsm_h, surf_lsm_v, surf_usm_h, surf_usm_v
7826
7827	IMPLICIT NONE
7828
7829	CHARACTER(LEN = *) :: id
7830
7831	INTEGER(iwp) :: ib !< loop index for aerosol number bin OR gas index
7832	INTEGER(iwp) :: ic !< loop index for aerosol mass bin
7833	INTEGER(iwp) :: icc !< (c-1)*nbins_aerosol+b
7834	INTEGER(iwp) :: i !<
7835	INTEGER(iwp) :: j !<
7836	INTEGER(iwp) :: k !<
7837
7838	LOGICAL :: do_sedimentation !<
7839
7840	REAL(wp), DIMENSION(nzb:nzt+1) :: rs_init !<
7841
7842	REAL(wp), DIMENSION(:,:,:), POINTER :: rs_p !<
7843	REAL(wp), DIMENSION(:,:,:), POINTER :: rs !<
7844	REAL(wp), DIMENSION(:,:,:), POINTER :: trs_m !<
7845
7846	icc = ( ic - 1 ) * nbins_aerosol + ib
7847	!
7848	!-- Tendency-terms for reactive scalar
7849	tend = 0.0_wp
7850	!
7851	!-- Advection terms
7852	IF ( timestep_scheme(1:5) == 'runge' ) THEN
7853	IF ( ws_scheme_sca ) THEN
7854	CALL advec_s_ws( rs, id )
7855	ELSE
7856	CALL advec_s_pw( rs )
7857	ENDIF
7858	ELSE
7859	CALL advec_s_up( rs )
7860	ENDIF
7861	!
7862	!-- Diffusion terms
7863	SELECT CASE ( id )
7864	CASE ( 'aerosol_number' )
7865	CALL diffusion_s( rs, surf_def_h(0)%answs(:,ib), &
7866	surf_def_h(1)%answs(:,ib), surf_def_h(2)%answs(:,ib), &
7867	surf_lsm_h%answs(:,ib), surf_usm_h%answs(:,ib), &
7868	surf_def_v(0)%answs(:,ib), surf_def_v(1)%answs(:,ib), &
7869	surf_def_v(2)%answs(:,ib), surf_def_v(3)%answs(:,ib), &
7870	surf_lsm_v(0)%answs(:,ib), surf_lsm_v(1)%answs(:,ib), &
7871	surf_lsm_v(2)%answs(:,ib), surf_lsm_v(3)%answs(:,ib), &
7872	surf_usm_v(0)%answs(:,ib), surf_usm_v(1)%answs(:,ib), &
7873	surf_usm_v(2)%answs(:,ib), surf_usm_v(3)%answs(:,ib) )
7874	CASE ( 'aerosol_mass' )
7875	CALL diffusion_s( rs, surf_def_h(0)%amsws(:,icc), &
7876	surf_def_h(1)%amsws(:,icc), surf_def_h(2)%amsws(:,icc), &
7877	surf_lsm_h%amsws(:,icc), surf_usm_h%amsws(:,icc), &
7878	surf_def_v(0)%amsws(:,icc), surf_def_v(1)%amsws(:,icc), &
7879	surf_def_v(2)%amsws(:,icc), surf_def_v(3)%amsws(:,icc), &
7880	surf_lsm_v(0)%amsws(:,icc), surf_lsm_v(1)%amsws(:,icc), &
7881	surf_lsm_v(2)%amsws(:,icc), surf_lsm_v(3)%amsws(:,icc), &
7882	surf_usm_v(0)%amsws(:,icc), surf_usm_v(1)%amsws(:,icc), &
7883	surf_usm_v(2)%amsws(:,icc), surf_usm_v(3)%amsws(:,icc) )
7884	CASE ( 'salsa_gas' )
7885	CALL diffusion_s( rs, surf_def_h(0)%gtsws(:,ib), &
7886	surf_def_h(1)%gtsws(:,ib), surf_def_h(2)%gtsws(:,ib), &
7887	surf_lsm_h%gtsws(:,ib), surf_usm_h%gtsws(:,ib), &
7888	surf_def_v(0)%gtsws(:,ib), surf_def_v(1)%gtsws(:,ib), &
7889	surf_def_v(2)%gtsws(:,ib), surf_def_v(3)%gtsws(:,ib), &
7890	surf_lsm_v(0)%gtsws(:,ib), surf_lsm_v(1)%gtsws(:,ib), &
7891	surf_lsm_v(2)%gtsws(:,ib), surf_lsm_v(3)%gtsws(:,ib), &
7892	surf_usm_v(0)%gtsws(:,ib), surf_usm_v(1)%gtsws(:,ib), &
7893	surf_usm_v(2)%gtsws(:,ib), surf_usm_v(3)%gtsws(:,ib) )
7894	END SELECT
7895	!
7896	!-- Prognostic equation for a scalar
7897	DO i = nxl, nxr
7898	DO j = nys, nyn
7899	!
7900	!-- Sedimentation for aerosol number and mass
7901	IF ( lsdepo .AND. do_sedimentation ) THEN
7902	tend(nzb+1:nzt,j,i) = tend(nzb+1:nzt,j,i) - MAX( 0.0_wp, ( rs(nzb+2:nzt+1,j,i) * &
7903	sedim_vd(nzb+2:nzt+1,j,i,ib) - rs(nzb+1:nzt,j,i) * &
7904	sedim_vd(nzb+1:nzt,j,i,ib) ) * ddzu(nzb+1:nzt) ) * &
7905	MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_0(nzb:nzt-1,j,i), 0 ) )
7906	ENDIF
7907	DO k = nzb+1, nzt
7908	rs_p(k,j,i) = rs(k,j,i) + ( dt_3d * ( tsc(2) * tend(k,j,i) + tsc(3) * trs_m(k,j,i) )&
7909	- tsc(5) * rdf_sc(k) * ( rs(k,j,i) - rs_init(k) )&
7910	) * MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_0(k,j,i), 0 ) )
7911	IF ( rs_p(k,j,i) < 0.0_wp ) rs_p(k,j,i) = 0.1_wp * rs(k,j,i)
7912	ENDDO
7913	ENDDO
7914	ENDDO
7915	!
7916	!-- Calculate tendencies for the next Runge-Kutta step
7917	IF ( timestep_scheme(1:5) == 'runge' ) THEN
7918	IF ( intermediate_timestep_count == 1 ) THEN
7919	DO i = nxl, nxr
7920	DO j = nys, nyn
7921	DO k = nzb+1, nzt
7922	trs_m(k,j,i) = tend(k,j,i)
7923	ENDDO
7924	ENDDO
7925	ENDDO
7926	ELSEIF ( intermediate_timestep_count < intermediate_timestep_count_max ) THEN
7927	DO i = nxl, nxr
7928	DO j = nys, nyn
7929	DO k = nzb+1, nzt
7930	trs_m(k,j,i) = -9.5625_wp * tend(k,j,i) + 5.3125_wp * trs_m(k,j,i)
7931	ENDDO
7932	ENDDO
7933	ENDDO
7934	ENDIF
7935	ENDIF
7936
7937	END SUBROUTINE salsa_tendency
7938
7939	!------------------------------------------------------------------------------!
7940	! Description:
7941	! ------------
7942	!> Boundary conditions for prognostic variables in SALSA
7943	!------------------------------------------------------------------------------!
7944	SUBROUTINE salsa_boundary_conds
7945
7946	USE arrays_3d, &
7947	ONLY: dzu
7948
7949	USE surface_mod, &
7950	ONLY : bc_h
7951
7952	IMPLICIT NONE
7953
7954	INTEGER(iwp) :: i !< grid index x direction
7955	INTEGER(iwp) :: ib !< index for aerosol size bins
7956	INTEGER(iwp) :: ic !< index for chemical compounds in aerosols
7957	INTEGER(iwp) :: icc !< additional index for chemical compounds in aerosols
7958	INTEGER(iwp) :: ig !< idex for gaseous compounds
7959	INTEGER(iwp) :: j !< grid index y direction
7960	INTEGER(iwp) :: k !< grid index y direction
7961	INTEGER(iwp) :: kb !< variable to set respective boundary value, depends on facing.
7962	INTEGER(iwp) :: l !< running index boundary type, for up- and downward-facing walls
7963	INTEGER(iwp) :: m !< running index surface elements
7964
7965	IF ( time_since_reference_point >= skip_time_do_salsa ) THEN
7966
7967	!
7968	!-- Surface conditions:
7969	IF ( ibc_salsa_b == 0 ) THEN ! Dirichlet
7970	!
7971	!-- Run loop over all non-natural and natural walls. Note, in wall-datatype the k coordinate
7972	!-- belongs to the atmospheric grid point, therefore, set s_p at k-1
7973	DO l = 0, 1
7974	!
7975	!-- Set kb, for upward-facing surfaces value at topography top (k-1) is
7976	!-- set, for downward-facing surfaces at topography bottom (k+1)
7977	kb = MERGE ( -1, 1, l == 0 )
7978	!$OMP PARALLEL PRIVATE( ib, ic, icc, ig, i, j, k )
7979	!$OMP DO
7980	DO m = 1, bc_h(l)%ns
7981
7982	i = bc_h(l)%i(m)
7983	j = bc_h(l)%j(m)
7984	k = bc_h(l)%k(m)
7985
7986	DO ib = 1, nbins_aerosol
7987	aerosol_number(ib)%conc_p(k+kb,j,i) = aerosol_number(ib)%conc(k+kb,j,i)
7988	DO ic = 1, ncomponents_mass
7989	icc = ( ic - 1 ) * nbins_aerosol + ib
7990	aerosol_mass(icc)%conc_p(k+kb,j,i) = aerosol_mass(icc)%conc(k+kb,j,i)
7991	ENDDO
7992	ENDDO
7993	IF ( .NOT. salsa_gases_from_chem ) THEN
7994	DO ig = 1, ngases_salsa
7995	salsa_gas(ig)%conc_p(k+kb,j,i) = salsa_gas(ig)%conc(k+kb,j,i)
7996	ENDDO
7997	ENDIF
7998
7999	ENDDO
8000	!$OMP END PARALLEL
8001
8002	ENDDO
8003
8004	ELSE ! Neumann
8005
8006	DO l = 0, 1
8007	!
8008	!-- Set kb, for upward-facing surfaces value at topography top (k-1) is
8009	!-- set, for downward-facing surfaces at topography bottom (k+1)
8010	kb = MERGE( -1, 1, l == 0 )
8011	!$OMP PARALLEL PRIVATE( ib, ic, icc, ig, i, j, k )
8012	!$OMP DO
8013	DO m = 1, bc_h(l)%ns
8014
8015	i = bc_h(l)%i(m)
8016	j = bc_h(l)%j(m)
8017	k = bc_h(l)%k(m)
8018
8019	DO ib = 1, nbins_aerosol
8020	aerosol_number(ib)%conc_p(k+kb,j,i) = aerosol_number(ib)%conc_p(k,j,i)
8021	DO ic = 1, ncomponents_mass
8022	icc = ( ic - 1 ) * nbins_aerosol + ib
8023	aerosol_mass(icc)%conc_p(k+kb,j,i) = aerosol_mass(icc)%conc_p(k,j,i)
8024	ENDDO
8025	ENDDO
8026	IF ( .NOT. salsa_gases_from_chem ) THEN
8027	DO ig = 1, ngases_salsa
8028	salsa_gas(ig)%conc_p(k+kb,j,i) = salsa_gas(ig)%conc_p(k,j,i)
8029	ENDDO
8030	ENDIF
8031
8032	ENDDO
8033	!$OMP END PARALLEL
8034	ENDDO
8035
8036	ENDIF
8037	!
8038	!-- Top boundary conditions:
8039	IF ( ibc_salsa_t == 0 ) THEN ! Dirichlet
8040
8041	DO ib = 1, nbins_aerosol
8042	aerosol_number(ib)%conc_p(nzt+1,:,:) = aerosol_number(ib)%conc(nzt+1,:,:)
8043	DO ic = 1, ncomponents_mass
8044	icc = ( ic - 1 ) * nbins_aerosol + ib
8045	aerosol_mass(icc)%conc_p(nzt+1,:,:) = aerosol_mass(icc)%conc(nzt+1,:,:)
8046	ENDDO
8047	ENDDO
8048	IF ( .NOT. salsa_gases_from_chem ) THEN
8049	DO ig = 1, ngases_salsa
8050	salsa_gas(ig)%conc_p(nzt+1,:,:) = salsa_gas(ig)%conc(nzt+1,:,:)
8051	ENDDO
8052	ENDIF
8053
8054	ELSEIF ( ibc_salsa_t == 1 ) THEN ! Neumann
8055
8056	DO ib = 1, nbins_aerosol
8057	aerosol_number(ib)%conc_p(nzt+1,:,:) = aerosol_number(ib)%conc_p(nzt,:,:)
8058	DO ic = 1, ncomponents_mass
8059	icc = ( ic - 1 ) * nbins_aerosol + ib
8060	aerosol_mass(icc)%conc_p(nzt+1,:,:) = aerosol_mass(icc)%conc_p(nzt,:,:)
8061	ENDDO
8062	ENDDO
8063	IF ( .NOT. salsa_gases_from_chem ) THEN
8064	DO ig = 1, ngases_salsa
8065	salsa_gas(ig)%conc_p(nzt+1,:,:) = salsa_gas(ig)%conc_p(nzt,:,:)
8066	ENDDO
8067	ENDIF
8068
8069	ELSEIF ( ibc_salsa_t == 2 ) THEN ! nested
8070
8071	DO ib = 1, nbins_aerosol
8072	aerosol_number(ib)%conc_p(nzt+1,:,:) = aerosol_number(ib)%conc_p(nzt,:,:) + &
8073	bc_an_t_val(ib) * dzu(nzt+1)
8074	DO ic = 1, ncomponents_mass
8075	icc = ( ic - 1 ) * nbins_aerosol + ib
8076	aerosol_mass(icc)%conc_p(nzt+1,:,:) = aerosol_mass(icc)%conc_p(nzt,:,:) + &
8077	bc_am_t_val(icc) * dzu(nzt+1)
8078	ENDDO
8079	ENDDO
8080	IF ( .NOT. salsa_gases_from_chem ) THEN
8081	DO ig = 1, ngases_salsa
8082	salsa_gas(ig)%conc_p(nzt+1,:,:) = salsa_gas(ig)%conc_p(nzt,:,:) + &
8083	bc_gt_t_val(ig) * dzu(nzt+1)
8084	ENDDO
8085	ENDIF
8086
8087	ENDIF
8088	!
8089	!-- Lateral boundary conditions at the outflow
8090	IF ( bc_radiation_s ) THEN
8091	DO ib = 1, nbins_aerosol
8092	aerosol_number(ib)%conc_p(:,nys-1,:) = aerosol_number(ib)%conc_p(:,nys,:)
8093	DO ic = 1, ncomponents_mass
8094	icc = ( ic - 1 ) * nbins_aerosol + ib
8095	aerosol_mass(icc)%conc_p(:,nys-1,:) = aerosol_mass(icc)%conc_p(:,nys,:)
8096	ENDDO
8097	ENDDO
8098	IF ( .NOT. salsa_gases_from_chem ) THEN
8099	DO ig = 1, ngases_salsa
8100	salsa_gas(ig)%conc_p(:,nys-1,:) = salsa_gas(ig)%conc_p(:,nys,:)
8101	ENDDO
8102	ENDIF
8103
8104	ELSEIF ( bc_radiation_n ) THEN
8105	DO ib = 1, nbins_aerosol
8106	aerosol_number(ib)%conc_p(:,nyn+1,:) = aerosol_number(ib)%conc_p(:,nyn,:)
8107	DO ic = 1, ncomponents_mass
8108	icc = ( ic - 1 ) * nbins_aerosol + ib
8109	aerosol_mass(icc)%conc_p(:,nyn+1,:) = aerosol_mass(icc)%conc_p(:,nyn,:)
8110	ENDDO
8111	ENDDO
8112	IF ( .NOT. salsa_gases_from_chem ) THEN
8113	DO ig = 1, ngases_salsa
8114	salsa_gas(ig)%conc_p(:,nyn+1,:) = salsa_gas(ig)%conc_p(:,nyn,:)
8115	ENDDO
8116	ENDIF
8117
8118	ELSEIF ( bc_radiation_l ) THEN
8119	DO ib = 1, nbins_aerosol
8120	aerosol_number(ib)%conc_p(:,:,nxl-1) = aerosol_number(ib)%conc_p(:,:,nxl)
8121	DO ic = 1, ncomponents_mass
8122	icc = ( ic - 1 ) * nbins_aerosol + ib
8123	aerosol_mass(icc)%conc_p(:,:,nxl-1) = aerosol_mass(icc)%conc_p(:,:,nxl)
8124	ENDDO
8125	ENDDO
8126	IF ( .NOT. salsa_gases_from_chem ) THEN
8127	DO ig = 1, ngases_salsa
8128	salsa_gas(ig)%conc_p(:,:,nxl-1) = salsa_gas(ig)%conc_p(:,:,nxl)
8129	ENDDO
8130	ENDIF
8131
8132	ELSEIF ( bc_radiation_r ) THEN
8133	DO ib = 1, nbins_aerosol
8134	aerosol_number(ib)%conc_p(:,:,nxr+1) = aerosol_number(ib)%conc_p(:,:,nxr)
8135	DO ic = 1, ncomponents_mass
8136	icc = ( ic - 1 ) * nbins_aerosol + ib
8137	aerosol_mass(icc)%conc_p(:,:,nxr+1) = aerosol_mass(icc)%conc_p(:,:,nxr)
8138	ENDDO
8139	ENDDO
8140	IF ( .NOT. salsa_gases_from_chem ) THEN
8141	DO ig = 1, ngases_salsa
8142	salsa_gas(ig)%conc_p(:,:,nxr+1) = salsa_gas(ig)%conc_p(:,:,nxr)
8143	ENDDO
8144	ENDIF
8145
8146	ENDIF
8147
8148	ENDIF
8149
8150	END SUBROUTINE salsa_boundary_conds
8151
8152	!------------------------------------------------------------------------------!
8153	! Description:
8154	! ------------
8155	! Undoing of the previously done cyclic boundary conditions.
8156	!------------------------------------------------------------------------------!
8157	SUBROUTINE salsa_boundary_conds_decycle ( sq, sq_init )
8158
8159	IMPLICIT NONE
8160
8161	INTEGER(iwp) :: boundary !<
8162	INTEGER(iwp) :: ee !<
8163	INTEGER(iwp) :: copied !<
8164	INTEGER(iwp) :: i !<
8165	INTEGER(iwp) :: j !<
8166	INTEGER(iwp) :: k !<
8167	INTEGER(iwp) :: ss !<
8168
8169	REAL(wp) :: flag !< flag to mask topography grid points
8170
8171	REAL(wp), DIMENSION(nzb:nzt+1) :: sq_init !< initial concentration profile
8172
8173	REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) :: sq !< concentration array
8174
8175	flag = 0.0_wp
8176	!
8177	!-- Left and right boundaries
8178	IF ( decycle_lr .AND. ( bc_lr_cyc .OR. bc_lr == 'nested' ) ) THEN
8179
8180	DO boundary = 1, 2
8181
8182	IF ( decycle_method(boundary) == 'dirichlet' ) THEN
8183	!
8184	!-- Initial profile is copied to ghost and first three layers
8185	ss = 1
8186	ee = 0
8187	IF ( boundary == 1 .AND. nxl == 0 ) THEN
8188	ss = nxlg
8189	ee = nxl+2
8190	ELSEIF ( boundary == 2 .AND. nxr == nx ) THEN
8191	ss = nxr-2
8192	ee = nxrg
8193	ENDIF
8194
8195	DO i = ss, ee
8196	DO j = nysg, nyng
8197	DO k = nzb+1, nzt
8198	flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_0(k,j,i), 0 ) )
8199	sq(k,j,i) = sq_init(k) * flag
8200	ENDDO
8201	ENDDO
8202	ENDDO
8203
8204	ELSEIF ( decycle_method(boundary) == 'neumann' ) THEN
8205	!
8206	!-- The value at the boundary is copied to the ghost layers to simulate an outlet with
8207	!-- zero gradient
8208	ss = 1
8209	ee = 0
8210	IF ( boundary == 1 .AND. nxl == 0 ) THEN
8211	ss = nxlg
8212	ee = nxl-1
8213	copied = nxl
8214	ELSEIF ( boundary == 2 .AND. nxr == nx ) THEN
8215	ss = nxr+1
8216	ee = nxrg
8217	copied = nxr
8218	ENDIF
8219
8220	DO i = ss, ee
8221	DO j = nysg, nyng
8222	DO k = nzb+1, nzt
8223	flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_0(k,j,i), 0 ) )
8224	sq(k,j,i) = sq(k,j,copied) * flag
8225	ENDDO
8226	ENDDO
8227	ENDDO
8228
8229	ELSE
8230	WRITE(message_string,*) 'unknown decycling method: decycle_method (', boundary, &
8231	') ="' // TRIM( decycle_method(boundary) ) // '"'
8232	CALL message( 'salsa_boundary_conds_decycle', 'PA0626', 1, 2, 0, 6, 0 )
8233	ENDIF
8234	ENDDO
8235	ENDIF
8236
8237	!
8238	!-- South and north boundaries
8239	IF ( decycle_ns .AND. ( bc_ns_cyc .OR. bc_ns == 'nested' ) ) THEN
8240
8241	DO boundary = 3, 4
8242
8243	IF ( decycle_method(boundary) == 'dirichlet' ) THEN
8244	!
8245	!-- Initial profile is copied to ghost and first three layers
8246	ss = 1
8247	ee = 0
8248	IF ( boundary == 3 .AND. nys == 0 ) THEN
8249	ss = nysg
8250	ee = nys+2
8251	ELSEIF ( boundary == 4 .AND. nyn == ny ) THEN
8252	ss = nyn-2
8253	ee = nyng
8254	ENDIF
8255
8256	DO i = nxlg, nxrg
8257	DO j = ss, ee
8258	DO k = nzb+1, nzt
8259	flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_0(k,j,i), 0 ) )
8260	sq(k,j,i) = sq_init(k) * flag
8261	ENDDO
8262	ENDDO
8263	ENDDO
8264
8265	ELSEIF ( decycle_method(boundary) == 'neumann' ) THEN
8266	!
8267	!-- The value at the boundary is copied to the ghost layers to simulate an outlet with
8268	!-- zero gradient
8269	ss = 1
8270	ee = 0
8271	IF ( boundary == 3 .AND. nys == 0 ) THEN
8272	ss = nysg
8273	ee = nys-1
8274	copied = nys
8275	ELSEIF ( boundary == 4 .AND. nyn == ny ) THEN
8276	ss = nyn+1
8277	ee = nyng
8278	copied = nyn
8279	ENDIF
8280
8281	DO i = nxlg, nxrg
8282	DO j = ss, ee
8283	DO k = nzb+1, nzt
8284	flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_0(k,j,i), 0 ) )
8285	sq(k,j,i) = sq(k,copied,i) * flag
8286	ENDDO
8287	ENDDO
8288	ENDDO
8289
8290	ELSE
8291	WRITE(message_string,*) 'unknown decycling method: decycle_method (', boundary, &
8292	') ="' // TRIM( decycle_method(boundary) ) // '"'
8293	CALL message( 'salsa_boundary_conds_decycle', 'PA0627', 1, 2, 0, 6, 0 )
8294	ENDIF
8295	ENDDO
8296	ENDIF
8297
8298	END SUBROUTINE salsa_boundary_conds_decycle
8299
8300	!------------------------------------------------------------------------------!
8301	! Description:
8302	! ------------
8303	!> Calculates the total dry or wet mass concentration for individual bins
8304	!> Juha Tonttila (FMI) 2015
8305	!> Tomi Raatikainen (FMI) 2016
8306	!------------------------------------------------------------------------------!
8307	SUBROUTINE bin_mixrat( itype, ibin, i, j, mconc )
8308
8309	IMPLICIT NONE
8310
8311	CHARACTER(len=*), INTENT(in) :: itype !< 'dry' or 'wet'
8312
8313	INTEGER(iwp) :: ic !< loop index for mass bin number
8314	INTEGER(iwp) :: iend !< end index: include water or not
8315
8316	INTEGER(iwp), INTENT(in) :: ibin !< index of the chemical component
8317	INTEGER(iwp), INTENT(in) :: i !< loop index for x-direction
8318	INTEGER(iwp), INTENT(in) :: j !< loop index for y-direction
8319
8320	REAL(wp), DIMENSION(:), INTENT(out) :: mconc !< total dry or wet mass concentration
8321
8322	!-- Number of components
8323	IF ( itype == 'dry' ) THEN
8324	iend = prtcl%ncomp - 1
8325	ELSE IF ( itype == 'wet' ) THEN
8326	iend = prtcl%ncomp
8327	ELSE
8328	message_string = 'Error in itype!'
8329	CALL message( 'bin_mixrat', 'PA0628', 2, 2, 0, 6, 0 )
8330	ENDIF
8331
8332	mconc = 0.0_wp
8333
8334	DO ic = ibin, iend*nbins_aerosol+ibin, nbins_aerosol !< every nbins'th element
8335	mconc = mconc + aerosol_mass(ic)%conc(:,j,i)
8336	ENDDO
8337
8338	END SUBROUTINE bin_mixrat
8339
8340	!------------------------------------------------------------------------------!
8341	! Description:
8342	! ------------
8343	!> Sets surface fluxes
8344	!------------------------------------------------------------------------------!
8345	SUBROUTINE salsa_emission_update
8346
8347	USE control_parameters, &
8348	ONLY: time_since_reference_point
8349
8350	IMPLICIT NONE
8351
8352	IF ( include_emission ) THEN
8353
8354	IF ( time_since_reference_point >= skip_time_do_salsa ) THEN
8355
8356	IF ( next_aero_emission_update <= time_since_reference_point ) THEN
8357	CALL salsa_emission_setup( .FALSE. )
8358	ENDIF
8359
8360	IF ( next_gas_emission_update <= time_since_reference_point ) THEN
8361	IF ( salsa_emission_mode == 'read_from_file' .AND. .NOT. salsa_gases_from_chem ) &
8362	THEN
8363	CALL salsa_gas_emission_setup( .FALSE. )
8364	ENDIF
8365	ENDIF
8366
8367	ENDIF
8368	ENDIF
8369
8370	END SUBROUTINE salsa_emission_update
8371
8372	!------------------------------------------------------------------------------!
8373	!> Description:
8374	!> ------------
8375	!> Define aerosol fluxes: constant or read from a from file
8376	!> @todo - Emission stack height is not used yet. For default mode, emissions
8377	!> are assumed to occur on upward facing horizontal surfaces.
8378	!------------------------------------------------------------------------------!
8379	SUBROUTINE salsa_emission_setup( init )
8380
8381	USE control_parameters, &
8382	ONLY: time_since_reference_point
8383
8384	USE date_and_time_mod, &
8385	ONLY: day_of_month, hour_of_day, index_dd, index_hh, index_mm, month_of_year, &
8386	time_default_indices, time_utc_init
8387
8388	USE netcdf_data_input_mod, &
8389	ONLY: check_existence, get_attribute, get_variable, inquire_num_variables, &
8390	inquire_variable_names, netcdf_data_input_get_dimension_length, open_read_file
8391
8392	USE surface_mod, &
8393	ONLY: surf_def_h, surf_lsm_h, surf_usm_h
8394
8395	IMPLICIT NONE
8396
8397	CHARACTER(LEN=80) :: daytype = 'workday' !< default day type
8398	CHARACTER(LEN=25) :: in_name !< name of a gas in the input file
8399	CHARACTER(LEN=25) :: mod_name !< name in the input file
8400
8401	INTEGER(iwp) :: ib !< loop index: aerosol number bins
8402	INTEGER(iwp) :: ic !< loop index: aerosol chemical components
8403	INTEGER(iwp) :: id_salsa !< NetCDF id of aerosol emission input file
8404	INTEGER(iwp) :: in !< loop index: emission category
8405	INTEGER(iwp) :: inn !< loop index
8406	INTEGER(iwp) :: ss !< loop index
8407
8408	INTEGER(iwp), DIMENSION(maxspec) :: cc_i2m !<
8409
8410	LOGICAL :: netcdf_extend = .FALSE. !< NetCDF input file exists
8411
8412	LOGICAL, INTENT(in) :: init !< if .TRUE. --> initialisation call
8413
8414	REAL(wp), DIMENSION(:), ALLOCATABLE :: nsect_emission !< sectional number emission
8415
8416	REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: source_array !< temporary source array
8417
8418	!
8419	!-- Set source arrays to zero:
8420	DO ib = 1, nbins_aerosol
8421	aerosol_number(ib)%source = 0.0_wp
8422	ENDDO
8423
8424	DO ic = 1, ncomponents_mass * nbins_aerosol
8425	aerosol_mass(ic)%source = 0.0_wp
8426	ENDDO
8427
8428	!
8429	!-- Define emissions:
8430
8431	SELECT CASE ( salsa_emission_mode )
8432
8433	CASE ( 'uniform' )
8434
8435	IF ( init ) THEN ! Do only once
8436	!
8437	!- Form a sectional size distribution for the emissions
8438	ALLOCATE( nsect_emission(1:nbins_aerosol), &
8439	source_array(nys:nyn,nxl:nxr,1:nbins_aerosol) )
8440	!
8441	!-- Precalculate a size distribution for the emission based on the mean diameter, standard
8442	!-- deviation and number concentration per each log-normal mode
8443	CALL size_distribution( surface_aerosol_flux, aerosol_flux_dpg, aerosol_flux_sigmag, &
8444	nsect_emission )
8445	DO ib = 1, nbins_aerosol
8446	source_array(:,:,ib) = nsect_emission(ib)
8447	ENDDO
8448	!
8449	!-- Check which chemical components are used
8450	cc_i2m = 0
8451	IF ( index_so4 > 0 ) cc_i2m(1) = index_so4
8452	IF ( index_oc > 0 ) cc_i2m(2) = index_oc
8453	IF ( index_bc > 0 ) cc_i2m(3) = index_bc
8454	IF ( index_du > 0 ) cc_i2m(4) = index_du
8455	IF ( index_ss > 0 ) cc_i2m(5) = index_ss
8456	IF ( index_no > 0 ) cc_i2m(6) = index_no
8457	IF ( index_nh > 0 ) cc_i2m(7) = index_nh
8458	!
8459	!-- Normalise mass fractions so that their sum is 1
8460	aerosol_flux_mass_fracs_a = aerosol_flux_mass_fracs_a / &
8461	SUM( aerosol_flux_mass_fracs_a(1:ncc ) )
8462	!
8463	!-- Set uniform fluxes of default horizontal surfaces
8464	CALL set_flux( surf_def_h(0), cc_i2m, aerosol_flux_mass_fracs_a, source_array )
8465
8466	DEALLOCATE( nsect_emission, source_array )
8467	ENDIF
8468
8469	CASE ( 'parameterized' )
8470	!
8471	!-- TO DO
8472
8473	CASE ( 'read_from_file' )
8474	!
8475	!-- Reset surface fluxes
8476	surf_def_h(0)%answs = 0.0_wp
8477	surf_def_h(0)%amsws = 0.0_wp
8478	surf_lsm_h%answs = 0.0_wp
8479	surf_lsm_h%amsws = 0.0_wp
8480	surf_usm_h%answs = 0.0_wp
8481	surf_usm_h%amsws = 0.0_wp
8482
8483	#if defined( __netcdf )
8484	IF ( init ) THEN
8485	!
8486	!-- Check existence of PIDS_SALSA file
8487	INQUIRE( FILE = TRIM( input_file_salsa ) // TRIM( coupling_char ), &
8488	EXIST = netcdf_extend )
8489	IF ( .NOT. netcdf_extend ) THEN
8490	message_string = 'Input file '// TRIM( input_file_salsa ) // TRIM( coupling_char )&
8491	// ' missing!'
8492	CALL message( 'salsa_emission_setup', 'PA0629', 1, 2, 0, 6, 0 )
8493	ENDIF
8494	!
8495	!-- Open file in read-only mode
8496	CALL open_read_file( TRIM( input_file_salsa ) // TRIM( coupling_char ), id_salsa )
8497	!
8498	!-- Read the index and name of chemical components
8499	CALL netcdf_data_input_get_dimension_length( id_salsa, aero_emission_att%ncc, &
8500	'composition_index' )
8501	ALLOCATE( aero_emission_att%cc_index(1:aero_emission_att%ncc) )
8502	CALL get_variable( id_salsa, 'composition_index', aero_emission_att%cc_index )
8503	CALL get_variable( id_salsa, 'composition_name', aero_emission_att%cc_name, &
8504	aero_emission_att%ncc )
8505	!
8506	!-- Find the corresponding chemical components in the model
8507	aero_emission_att%cc_input_to_model = 0
8508	DO ic = 1, aero_emission_att%ncc
8509	in_name = aero_emission_att%cc_name(ic)
8510	SELECT CASE ( TRIM( in_name ) )
8511	CASE ( 'H2SO4', 'h2so4', 'SO4', 'so4' )
8512	aero_emission_att%cc_input_to_model(1) = ic
8513	CASE ( 'OC', 'oc', 'organics' )
8514	aero_emission_att%cc_input_to_model(2) = ic
8515	CASE ( 'BC', 'bc' )
8516	aero_emission_att%cc_input_to_model(3) = ic
8517	CASE ( 'DU', 'du' )
8518	aero_emission_att%cc_input_to_model(4) = ic
8519	CASE ( 'SS', 'ss' )
8520	aero_emission_att%cc_input_to_model(5) = ic
8521	CASE ( 'HNO3', 'hno3', 'NO', 'no' )
8522	aero_emission_att%cc_input_to_model(6) = ic
8523	CASE ( 'NH3', 'nh3', 'NH', 'nh' )
8524	aero_emission_att%cc_input_to_model(7) = ic
8525	END SELECT
8526
8527	ENDDO
8528
8529	IF ( SUM( aero_emission_att%cc_input_to_model ) == 0 ) THEN
8530	message_string = 'None of the aerosol chemical components in ' // TRIM( &
8531	input_file_salsa ) // ' correspond to the ones applied in SALSA.'
8532	CALL message( 'salsa_emission_setup', 'PA0630', 1, 2, 0, 6, 0 )
8533	ENDIF
8534	!
8535	!-- Inquire the fill value
8536	CALL get_attribute( id_salsa, '_FillValue', aero_emission%fill, .FALSE., &
8537	'aerosol_emission_values' )
8538	!
8539	!-- Inquire units of emissions
8540	CALL get_attribute( id_salsa, 'units', aero_emission_att%units, .FALSE., &
8541	'aerosol_emission_values' )
8542	!
8543	!-- Inquire the level of detail (lod)
8544	CALL get_attribute( id_salsa, 'lod', aero_emission_att%lod, .FALSE., &
8545	'aerosol_emission_values' )
8546	!
8547	!-- Variable names
8548	CALL inquire_num_variables( id_salsa, aero_emission_att%num_vars )
8549	ALLOCATE( aero_emission_att%var_names(1:aero_emission_att%num_vars) )
8550	CALL inquire_variable_names( id_salsa, aero_emission_att%var_names )
8551
8552	!
8553	!-- Read different emission information depending on the level of detail of emissions:
8554
8555	!
8556	!-- Default mode:
8557	IF ( aero_emission_att%lod == 1 ) THEN
8558	!
8559	!-- Unit conversion factor: convert to SI units (kg/m2/s)
8560	IF ( aero_emission_att%units == 'kg/m2/yr' ) THEN
8561	aero_emission_att%conversion_factor = 1.0_wp / 3600.0_wp
8562	ELSEIF ( aero_emission_att%units == 'g/m2/yr' ) THEN
8563	aero_emission_att%conversion_factor = 0.001_wp / 3600.0_wp
8564	ELSE
8565	message_string = 'unknown unit for aerosol emissions: ' // &
8566	TRIM( aero_emission_att%units ) // ' (lod1)'
8567	CALL message( 'salsa_emission_setup','PA0631', 1, 2, 0, 6, 0 )
8568	ENDIF
8569	!
8570	!-- Get number of emission categories and allocate emission arrays
8571	CALL netcdf_data_input_get_dimension_length( id_salsa, aero_emission_att%ncat, &
8572	'ncat' )
8573	ALLOCATE( aero_emission_att%cat_index(1:aero_emission_att%ncat), &
8574	aero_emission_att%rho(1:aero_emission_att%ncat), &
8575	aero_emission_att%time_factor(1:aero_emission_att%ncat) )
8576	!
8577	!-- Get emission category names and indices
8578	CALL get_variable( id_salsa, 'emission_category_name', aero_emission_att%cat_name, &
8579	aero_emission_att%ncat)
8580	CALL get_variable( id_salsa, 'emission_category_index', aero_emission_att%cat_index )
8581	!
8582	!-- Find corresponding emission categories
8583	DO in = 1, aero_emission_att%ncat
8584	in_name = aero_emission_att%cat_name(in)
8585	DO ss = 1, def_modes%ndc
8586	mod_name = def_modes%cat_name_table(ss)
8587	IF ( TRIM( in_name(1:4) ) == TRIM( mod_name(1:4 ) ) ) THEN
8588	def_modes%cat_input_to_model(ss) = in
8589	ENDIF
8590	ENDDO
8591	ENDDO
8592
8593	IF ( SUM( def_modes%cat_input_to_model ) == 0 ) THEN
8594	message_string = 'None of the emission categories in ' // TRIM( &
8595	input_file_salsa ) // ' match with the ones in the model.'
8596	CALL message( 'salsa_emission_setup', 'PA0632', 1, 2, 0, 6, 0 )
8597	ENDIF
8598	!
8599	!-- Emission time factors: Find check whether emission time factors are given for each
8600	!-- hour of year OR based on month, day and hour
8601	!
8602	!-- For each hour of year:
8603	IF ( check_existence( aero_emission_att%var_names, 'nhoursyear' ) ) THEN
8604	CALL netcdf_data_input_get_dimension_length( id_salsa, aero_emission_att%nhoursyear,&
8605	'nhoursyear' )
8606	ALLOCATE( aero_emission_att%etf(1:aero_emission_att%ncat, &
8607	1:aero_emission_att%nhoursyear) )
8608	CALL get_variable( id_salsa, 'emission_time_factors', aero_emission_att%etf, &
8609	0, aero_emission_att%nhoursyear-1, 0, aero_emission_att%ncat-1 )
8610	!
8611	!-- Based on the month, day and hour:
8612	ELSEIF ( check_existence( aero_emission_att%var_names, 'nmonthdayhour' ) ) THEN
8613	CALL netcdf_data_input_get_dimension_length( id_salsa, &
8614	aero_emission_att%nmonthdayhour, &
8615	'nmonthdayhour' )
8616	ALLOCATE( aero_emission_att%etf(1:aero_emission_att%ncat, &
8617	1:aero_emission_att%nmonthdayhour) )
8618	CALL get_variable( id_salsa, 'emission_time_factors', aero_emission_att%etf, &
8619	0, aero_emission_att%nmonthdayhour-1, 0, aero_emission_att%ncat-1 )
8620	ELSE
8621	message_string = 'emission_time_factors should be given for each nhoursyear ' //&
8622	'OR nmonthdayhour'
8623	CALL message( 'salsa_emission_setup','PA0633', 1, 2, 0, 6, 0 )
8624	ENDIF
8625	!
8626	!-- Next emission update
8627	next_aero_emission_update = MOD( time_utc_init, 3600.0_wp ) - 3600.0_wp
8628	!
8629	!-- Get chemical composition (i.e. mass fraction of different species) in aerosols
8630	ALLOCATE( aero_emission%def_mass_fracs(1:aero_emission_att%ncat, &
8631	1:aero_emission_att%ncc) )
8632	aero_emission%def_mass_fracs = 0.0_wp
8633	CALL get_variable( id_salsa, 'emission_mass_fracs', aero_emission%def_mass_fracs, &
8634	0, aero_emission_att%ncc-1, 0, aero_emission_att%ncat-1 )
8635	!
8636	!-- If the chemical component is not activated, set its mass fraction to 0 to avoid
8637	!-- inbalance between number and mass flux
8638	cc_i2m = aero_emission_att%cc_input_to_model
8639	IF ( index_so4 < 0 .AND. cc_i2m(1) /= 0 ) &
8640	aero_emission%def_mass_fracs(:,cc_i2m(1)) = 0.0_wp
8641	IF ( index_oc < 0 .AND. cc_i2m(2) /= 0 ) &
8642	aero_emission%def_mass_fracs(:,cc_i2m(2)) = 0.0_wp
8643	IF ( index_bc < 0 .AND. cc_i2m(3) /= 0 ) &
8644	aero_emission%def_mass_fracs(:,cc_i2m(3)) = 0.0_wp
8645	IF ( index_du < 0 .AND. cc_i2m(4) /= 0 ) &
8646	aero_emission%def_mass_fracs(:,cc_i2m(4)) = 0.0_wp
8647	IF ( index_ss < 0 .AND. cc_i2m(5) /= 0 ) &
8648	aero_emission%def_mass_fracs(:,cc_i2m(5)) = 0.0_wp
8649	IF ( index_no < 0 .AND. cc_i2m(6) /= 0 ) &
8650	aero_emission%def_mass_fracs(:,cc_i2m(6)) = 0.0_wp
8651	IF ( index_nh < 0 .AND. cc_i2m(7) /= 0 ) &
8652	aero_emission%def_mass_fracs(:,cc_i2m(7)) = 0.0_wp
8653	!
8654	!-- Then normalise the mass fraction so that SUM = 1
8655	DO in = 1, aero_emission_att%ncat
8656	aero_emission%def_mass_fracs(in,:) = aero_emission%def_mass_fracs(in,:) / &
8657	SUM( aero_emission%def_mass_fracs(in,:) )
8658	ENDDO
8659	!
8660	!-- Calculate average mass density (kg/m3)
8661	aero_emission_att%rho = 0.0_wp
8662
8663	IF ( cc_i2m(1) /= 0 ) aero_emission_att%rho = aero_emission_att%rho + arhoh2so4 *&
8664	aero_emission%def_mass_fracs(:,cc_i2m(1))
8665	IF ( cc_i2m(2) /= 0 ) aero_emission_att%rho = aero_emission_att%rho + arhooc * &
8666	aero_emission%def_mass_fracs(:,cc_i2m(2))
8667	IF ( cc_i2m(3) /= 0 ) aero_emission_att%rho = aero_emission_att%rho + arhobc * &
8668	aero_emission%def_mass_fracs(:,cc_i2m(3))
8669	IF ( cc_i2m(4) /= 0 ) aero_emission_att%rho = aero_emission_att%rho + arhodu * &
8670	aero_emission%def_mass_fracs(:,cc_i2m(4))
8671	IF ( cc_i2m(5) /= 0 ) aero_emission_att%rho = aero_emission_att%rho + arhoss * &
8672	aero_emission%def_mass_fracs(:,cc_i2m(5))
8673	IF ( cc_i2m(6) /= 0 ) aero_emission_att%rho = aero_emission_att%rho + arhohno3 * &
8674	aero_emission%def_mass_fracs(:,cc_i2m(6))
8675	IF ( cc_i2m(7) /= 0 ) aero_emission_att%rho = aero_emission_att%rho + arhonh3 * &
8676	aero_emission%def_mass_fracs(:,cc_i2m(7))
8677	!
8678	!-- Allocate and read surface emission data (in total PM)
8679	ALLOCATE( aero_emission%def_data(nys:nyn,nxl:nxr,1:aero_emission_att%ncat) )
8680	CALL get_variable( id_salsa, 'aerosol_emission_values', aero_emission%def_data, &
8681	0, aero_emission_att%ncat-1, nxl, nxr, nys, nyn )
8682
8683	!
8684	!-- Pre-processed mode
8685	ELSEIF ( aero_emission_att%lod == 2 ) THEN
8686	!
8687	!-- Unit conversion factor: convert to SI units (#/m2/s)
8688	IF ( aero_emission_att%units == '#/m2/s' ) THEN
8689	aero_emission_att%conversion_factor = 1.0_wp
8690	ELSE
8691	message_string = 'unknown unit for aerosol emissions: ' // &
8692	TRIM( aero_emission_att%units )
8693	CALL message( 'salsa_emission_setup','PA0634', 1, 2, 0, 6, 0 )
8694	ENDIF
8695	!
8696	!-- Number of aerosol size bins in the emission data
8697	CALL netcdf_data_input_get_dimension_length( id_salsa, aero_emission_att%nbins, &
8698	'Dmid' )
8699	IF ( aero_emission_att%nbins /= nbins_aerosol ) THEN
8700	message_string = 'The number of size bins in aerosol input data does not ' // &
8701	'correspond to the model set-up'
8702	CALL message( 'salsa_emission_setup','PA0635', 1, 2, 0, 6, 0 )
8703	ENDIF
8704	!
8705	!-- Number of time steps in the emission data
8706	CALL netcdf_data_input_get_dimension_length( id_salsa, aero_emission_att%nt, 'time')
8707	!
8708	!-- Allocate bin diameters, time and mass fraction array
8709	ALLOCATE( aero_emission_att%dmid(1:nbins_aerosol), &
8710	aero_emission_att%time(1:aero_emission_att%nt), &
8711	aero_emission%preproc_mass_fracs(1:aero_emission_att%ncc) )
8712	!
8713	!-- Read mean diameters
8714	CALL get_variable( id_salsa, 'Dmid', aero_emission_att%dmid )
8715	!
8716	!-- Check whether the sectional representation of the aerosol size distribution conform
8717	!-- to the one applied in the model
8718	IF ( ANY( ABS( ( aero(1:nbins_aerosol)%dmid - aero_emission_att%dmid ) / &
8719	aero(1:nbins_aerosol)%dmid ) > 0.1_wp ) ) THEN
8720	message_string = 'Mean diameters of size bins in ' // TRIM( input_file_salsa ) &
8721	// ' do not match with the ones in the model.'
8722	CALL message( 'salsa_emission_setup','PA0636', 1, 2, 0, 6, 0 )
8723	ENDIF
8724	!
8725	!-- Read time stamps:
8726	CALL get_variable( id_salsa, 'time', aero_emission_att%time )
8727	!
8728	!-- Read emission mass fractions
8729	CALL get_variable( id_salsa, 'emission_mass_fracs', aero_emission%preproc_mass_fracs )
8730	!
8731	!-- If the chemical component is not activated, set its mass fraction to 0
8732	cc_i2m = aero_emission_att%cc_input_to_model
8733	IF ( index_so4 < 0 .AND. cc_i2m(1) /= 0 ) &
8734	aero_emission%preproc_mass_fracs(cc_i2m(1)) = 0.0_wp
8735	IF ( index_oc < 0 .AND. cc_i2m(2) /= 0 ) &
8736	aero_emission%preproc_mass_fracs(cc_i2m(2)) = 0.0_wp
8737	IF ( index_bc < 0 .AND. cc_i2m(3) /= 0 ) &
8738	aero_emission%preproc_mass_fracs(cc_i2m(3)) = 0.0_wp
8739	IF ( index_du < 0 .AND. cc_i2m(4) /= 0 ) &
8740	aero_emission%preproc_mass_fracs(cc_i2m(4)) = 0.0_wp
8741	IF ( index_ss < 0 .AND. cc_i2m(5) /= 0 ) &
8742	aero_emission%preproc_mass_fracs(cc_i2m(5)) = 0.0_wp
8743	IF ( index_no < 0 .AND. cc_i2m(6) /= 0 ) &
8744	aero_emission%preproc_mass_fracs(cc_i2m(6)) = 0.0_wp
8745	IF ( index_nh < 0 .AND. cc_i2m(7) /= 0 ) &
8746	aero_emission%preproc_mass_fracs(cc_i2m(7)) = 0.0_wp
8747	!
8748	!-- Then normalise the mass fraction so that SUM = 1
8749	aero_emission%preproc_mass_fracs = aero_emission%preproc_mass_fracs / &
8750	SUM( aero_emission%preproc_mass_fracs )
8751
8752	ELSE
8753	message_string = 'Unknown lod for aerosol_emission_values.'
8754	CALL message( 'salsa_emission','PA0637', 1, 2, 0, 6, 0 )
8755	ENDIF
8756
8757	ENDIF ! init
8758	!
8759	!-- Define and set current emission values:
8760	!
8761	!-- Default type emissions (aerosol emission given as total mass emission per year):
8762	IF ( aero_emission_att%lod == 1 ) THEN
8763	!
8764	!-- Emission time factors for each emission category at current time step
8765	IF ( aero_emission_att%nhoursyear > aero_emission_att%nmonthdayhour ) THEN
8766	!
8767	!-- Get the index of the current hour
8768	CALL time_default_indices( month_of_year, day_of_month, hour_of_day, index_hh )
8769	aero_emission_att%time_factor = aero_emission_att%etf(:,index_hh)
8770
8771	ELSEIF ( aero_emission_att%nhoursyear < aero_emission_att%nmonthdayhour ) THEN
8772	!
8773	!-- Get the index of current hour (index_hh) (TODO: Now "workday" is always assumed.
8774	!-- Needs to be calculated.)
8775	CALL time_default_indices( daytype, month_of_year, day_of_month, hour_of_day, &
8776	index_mm, index_dd, index_hh )
8777	aero_emission_att%time_factor = aero_emission_att%etf(:,index_mm) * &
8778	aero_emission_att%etf(:,index_dd) * &
8779	aero_emission_att%etf(:,index_hh)
8780	ENDIF
8781
8782	!
8783	!-- Create a sectional number size distribution for emissions
8784	ALLOCATE( nsect_emission(1:nbins_aerosol),source_array(nys:nyn,nxl:nxr,1:nbins_aerosol) )
8785	DO in = 1, aero_emission_att%ncat
8786
8787	inn = def_modes%cat_input_to_model(in)
8788	!
8789	!-- Calculate the number concentration (1/m3) of a log-normal size distribution
8790	!-- following Jacobson (2005): Eq 13.25.
8791	def_modes%ntot_table = 6.0_wp * def_modes%pm_frac_table(:,inn) / ( pi * &
8792	( def_modes%dpg_table )*3 EXP( 4.5_wp * &
8793	LOG( def_modes%sigmag_table )**2 ) )
8794	!
8795	!-- Sectional size distibution (1/m3) from a log-normal one
8796	CALL size_distribution( def_modes%ntot_table, def_modes%dpg_table, &
8797	def_modes%sigmag_table, nsect_emission )
8798
8799	source_array = 0.0_wp
8800	DO ib = 1, nbins_aerosol
8801	source_array(:,:,ib) = aero_emission%def_data(:,:,in) * &
8802	aero_emission_att%conversion_factor / &
8803	aero_emission_att%rho(in) * nsect_emission(ib) * &
8804	aero_emission_att%time_factor(in)
8805	ENDDO
8806	!
8807	!-- Set surface fluxes of aerosol number and mass on horizontal surfaces. Set fluxes
8808	!-- only for either default, land or urban surface.
8809	IF ( .NOT. land_surface .AND. .NOT. urban_surface ) THEN
8810	CALL set_flux( surf_def_h(0), aero_emission_att%cc_input_to_model, &
8811	aero_emission%def_mass_fracs(in,:), source_array )
8812	ELSE
8813	CALL set_flux( surf_usm_h, aero_emission_att%cc_input_to_model, &
8814	aero_emission%def_mass_fracs(in,:), source_array )
8815	CALL set_flux( surf_lsm_h, aero_emission_att%cc_input_to_model, &
8816	aero_emission%def_mass_fracs(in,:), source_array )
8817	ENDIF
8818	ENDDO
8819	!
8820	!-- The next emission update is again after one hour
8821	next_aero_emission_update = next_aero_emission_update + 3600.0_wp
8822
8823
8824	DEALLOCATE( source_array )
8825	!
8826	!-- Pre-processed:
8827	ELSEIF ( aero_emission_att%lod == 2 ) THEN
8828	!
8829	!-- Obtain time index for current input starting at 0.
8830	!-- @todo: At the moment emission data and simulated time correspond to each other.
8831	aero_emission_att%tind = MINLOC( ABS( aero_emission_att%time - &
8832	time_since_reference_point ), DIM = 1 ) - 1
8833	!
8834	!-- Allocate the data input array always before reading in the data and deallocate after
8835	ALLOCATE( aero_emission%preproc_data(nys:nyn,nxl:nxr,1:nbins_aerosol) )
8836	!
8837	!-- Read in the next time step
8838	CALL get_variable( id_salsa, 'aerosol_emission_values', aero_emission%preproc_data,&
8839	aero_emission_att%tind, 0, nbins_aerosol-1, nxl, nxr, nys, nyn )
8840	!
8841	!-- Set surface fluxes of aerosol number and mass on horizontal surfaces. Set fluxes only
8842	!-- for either default, land and urban surface.
8843	IF ( .NOT. land_surface .AND. .NOT. urban_surface ) THEN
8844	CALL set_flux( surf_def_h(0), aero_emission_att%cc_input_to_model, &
8845	aero_emission%preproc_mass_fracs, aero_emission%preproc_data )
8846	ELSE
8847	CALL set_flux( surf_usm_h, aero_emission_att%cc_input_to_model, &
8848	aero_emission%preproc_mass_fracs, aero_emission%preproc_data )
8849	CALL set_flux( surf_lsm_h, aero_emission_att%cc_input_to_model, &
8850	aero_emission%preproc_mass_fracs, aero_emission%preproc_data )
8851	ENDIF
8852	!
8853	!-- Determine the next emission update
8854	next_aero_emission_update = aero_emission_att%time(aero_emission_att%tind+2)
8855
8856	DEALLOCATE( aero_emission%preproc_data )
8857
8858	ENDIF
8859
8860	#else
8861	message_string = 'salsa_emission_mode = "read_from_file", but preprocessor directive ' //&
8862	' __netcdf is not used in compiling!'
8863	CALL message( 'salsa_emission_setup', 'PA0638', 1, 2, 0, 6, 0 )
8864
8865	#endif
8866	CASE DEFAULT
8867	message_string = 'unknown salsa_emission_mode: ' // TRIM( salsa_emission_mode )
8868	CALL message( 'salsa_emission_setup', 'PA0639', 1, 2, 0, 6, 0 )
8869
8870	END SELECT
8871
8872	CONTAINS
8873
8874	!------------------------------------------------------------------------------!
8875	! Description:
8876	! ------------
8877	!> Sets the aerosol flux to aerosol arrays in 2a and 2b.
8878	!------------------------------------------------------------------------------!
8879	SUBROUTINE set_flux( surface, cc_i_mod, mass_fracs, source_array )
8880
8881	USE arrays_3d, &
8882	ONLY: rho_air_zw
8883
8884	USE surface_mod, &
8885	ONLY: surf_type
8886
8887	IMPLICIT NONE
8888
8889	INTEGER(iwp) :: i !< loop index
8890	INTEGER(iwp) :: ib !< loop index
8891	INTEGER(iwp) :: ic !< loop index
8892	INTEGER(iwp) :: j !< loop index
8893	INTEGER(iwp) :: k !< loop index
8894	INTEGER(iwp) :: m !< running index for surface elements
8895
8896	INTEGER(iwp), DIMENSION(:) :: cc_i_mod !< index of chemical component in the input data
8897
8898	REAL(wp) :: so4_oc !< mass fraction between SO4 and OC in 1a
8899
8900	REAL(wp), DIMENSION(:), INTENT(in) :: mass_fracs !< mass fractions of chemical components
8901
8902	REAL(wp), DIMENSION(nys:nyn,nxl:nxr,1:nbins_aerosol), INTENT(inout) :: source_array !<
8903
8904	TYPE(surf_type), INTENT(inout) :: surface !< respective surface type
8905
8906	so4_oc = 0.0_wp
8907
8908	DO m = 1, surface%ns
8909	!
8910	!-- Get indices of respective grid point
8911	i = surface%i(m)
8912	j = surface%j(m)
8913	k = surface%k(m)
8914
8915	DO ib = 1, nbins_aerosol
8916	IF ( source_array(j,i,ib) < nclim ) THEN
8917	source_array(j,i,ib) = 0.0_wp
8918	ENDIF
8919	!
8920	!-- Set mass fluxes. First bins include only SO4 and/or OC.
8921	IF ( ib <= end_subrange_1a ) THEN
8922	!
8923	!-- Both sulphate and organic carbon
8924	IF ( index_so4 > 0 .AND. index_oc > 0 ) THEN
8925
8926	ic = ( index_so4 - 1 ) * nbins_aerosol + ib
8927	so4_oc = mass_fracs(cc_i_mod(1)) / ( mass_fracs(cc_i_mod(1)) + &
8928	mass_fracs(cc_i_mod(2)) )
8929	surface%amsws(m,ic) = surface%amsws(m,ic) + so4_oc * source_array(j,i,ib) &
8930	* api6 * aero(ib)%dmid*3 arhoh2so4 * rho_air_zw(k-1)
8931	aerosol_mass(ic)%source(j,i) = aerosol_mass(ic)%source(j,i) + surface%amsws(m,ic)
8932
8933	ic = ( index_oc - 1 ) * nbins_aerosol + ib
8934	surface%amsws(m,ic) = surface%amsws(m,ic) + ( 1-so4_oc ) * source_array(j,i,ib) &
8935	* api6 * aero(ib)%dmid*3 arhooc * rho_air_zw(k-1)
8936	aerosol_mass(ic)%source(j,i) = aerosol_mass(ic)%source(j,i) + surface%amsws(m,ic)
8937	!
8938	!-- Only sulphates
8939	ELSEIF ( index_so4 > 0 .AND. index_oc < 0 ) THEN
8940	ic = ( index_so4 - 1 ) * nbins_aerosol + ib
8941	surface%amsws(m,ic) = surface%amsws(m,ic) + source_array(j,i,ib) * api6 * &
8942	aero(ib)%dmid*3 arhoh2so4 * rho_air_zw(k-1)
8943	aerosol_mass(ic)%source(j,i) = aerosol_mass(ic)%source(j,i) + surface%amsws(m,ic)
8944	!
8945	!-- Only organic carbon
8946	ELSEIF ( index_so4 < 0 .AND. index_oc > 0 ) THEN
8947	ic = ( index_oc - 1 ) * nbins_aerosol + ib
8948	surface%amsws(m,ic) = surface%amsws(m,ic) + source_array(j,i,ib) * api6 * &
8949	aero(ib)%dmid*3 arhooc * rho_air_zw(k-1)
8950	aerosol_mass(ic)%source(j,i) = aerosol_mass(ic)%source(j,i) + surface%amsws(m,ic)
8951	ENDIF
8952
8953	ELSE
8954	!
8955	!-- Sulphate
8956	IF ( index_so4 > 0 ) THEN
8957	ic = cc_i_mod(1)
8958	CALL set_mass_flux( surface, m, ib, index_so4, mass_fracs(ic), arhoh2so4, &
8959	source_array(j,i,ib) )
8960	ENDIF
8961	!
8962	!-- Organic carbon
8963	IF ( index_oc > 0 ) THEN
8964	ic = cc_i_mod(2)
8965	CALL set_mass_flux( surface, m, ib, index_oc, mass_fracs(ic),arhooc, &
8966	source_array(j,i,ib) )
8967	ENDIF
8968	!
8969	!-- Black carbon
8970	IF ( index_bc > 0 ) THEN
8971	ic = cc_i_mod(3)
8972	CALL set_mass_flux( surface, m, ib, index_bc, mass_fracs(ic), arhobc, &
8973	source_array(j,i,ib) )
8974	ENDIF
8975	!
8976	!-- Dust
8977	IF ( index_du > 0 ) THEN
8978	ic = cc_i_mod(4)
8979	CALL set_mass_flux( surface, m, ib, index_du, mass_fracs(ic), arhodu, &
8980	source_array(j,i,ib) )
8981	ENDIF
8982	!
8983	!-- Sea salt
8984	IF ( index_ss > 0 ) THEN
8985	ic = cc_i_mod(5)
8986	CALL set_mass_flux( surface, m, ib, index_ss, mass_fracs(ic), arhoss, &
8987	source_array(j,i,ib) )
8988	ENDIF
8989	!
8990	!-- Nitric acid
8991	IF ( index_no > 0 ) THEN
8992	ic = cc_i_mod(6)
8993	CALL set_mass_flux( surface, m, ib, index_no, mass_fracs(ic), arhohno3, &
8994	source_array(j,i,ib) )
8995	ENDIF
8996	!
8997	!-- Ammonia
8998	IF ( index_nh > 0 ) THEN
8999	ic = cc_i_mod(7)
9000	CALL set_mass_flux( surface, m, ib, index_nh, mass_fracs(ic), arhonh3, &
9001	source_array(j,i,ib) )
9002	ENDIF
9003
9004	ENDIF
9005	!
9006	!-- Save number fluxes in the end
9007	surface%answs(m,ib) = surface%answs(m,ib) + source_array(j,i,ib) * rho_air_zw(k-1)
9008	aerosol_number(ib)%source(j,i) = aerosol_number(ib)%source(j,i) + surface%answs(m,ib)
9009
9010	ENDDO ! ib
9011	ENDDO ! m
9012
9013	END SUBROUTINE set_flux
9014
9015	!------------------------------------------------------------------------------!
9016	! Description:
9017	! ------------
9018	!> Sets the mass emissions to aerosol arrays in 2a and 2b.
9019	!------------------------------------------------------------------------------!
9020	SUBROUTINE set_mass_flux( surface, surf_num, ib, ispec, mass_frac, prho, nsource )
9021
9022	USE arrays_3d, &
9023	ONLY: rho_air_zw
9024
9025	USE surface_mod, &
9026	ONLY: surf_type
9027
9028	IMPLICIT NONE
9029
9030	INTEGER(iwp) :: i !< loop index
9031	INTEGER(iwp) :: j !< loop index
9032	INTEGER(iwp) :: k !< loop index
9033	INTEGER(iwp) :: ic !< loop index
9034
9035	INTEGER(iwp), INTENT(in) :: ib !< Aerosol size bin index
9036	INTEGER(iwp), INTENT(in) :: ispec !< Aerosol species index
9037	INTEGER(iwp), INTENT(in) :: surf_num !< index surface elements
9038
9039	REAL(wp), INTENT(in) :: mass_frac !< mass fraction of a chemical compound in all bins
9040	REAL(wp), INTENT(in) :: nsource !< number source (#/m2/s)
9041	REAL(wp), INTENT(in) :: prho !< Aerosol density
9042
9043	TYPE(surf_type), INTENT(inout) :: surface !< respective surface type
9044	!
9045	!-- Get indices of respective grid point
9046	i = surface%i(surf_num)
9047	j = surface%j(surf_num)
9048	k = surface%k(surf_num)
9049	!
9050	!-- Subrange 2a:
9051	ic = ( ispec - 1 ) * nbins_aerosol + ib
9052	surface%amsws(surf_num,ic) = surface%amsws(surf_num,ic) + mass_frac * nsource * &
9053	aero(ib)%core * prho * rho_air_zw(k-1)
9054	aerosol_mass(ic)%source(j,i) = aerosol_mass(ic)%source(j,i) + surface%amsws(surf_num,ic)
9055
9056	END SUBROUTINE set_mass_flux
9057
9058	END SUBROUTINE salsa_emission_setup
9059
9060	!------------------------------------------------------------------------------!
9061	! Description:
9062	! ------------
9063	!> Sets the gaseous fluxes
9064	!------------------------------------------------------------------------------!
9065	SUBROUTINE salsa_gas_emission_setup( init )
9066
9067	USE control_parameters, &
9068	ONLY: time_since_reference_point
9069
9070	USE date_and_time_mod, &
9071	ONLY: day_of_month, hour_of_day, index_dd, index_hh, index_mm, month_of_year, &
9072	time_default_indices, time_utc_init
9073
9074	USE netcdf_data_input_mod, &
9075	ONLY: check_existence, chem_emis_att_type, chem_emis_val_type, get_attribute, &
9076	get_variable, inquire_num_variables, inquire_variable_names, &
9077	netcdf_data_input_get_dimension_length, open_read_file
9078
9079	USE surface_mod, &
9080	ONLY: surf_def_h, surf_lsm_h, surf_usm_h
9081
9082	IMPLICIT NONE
9083
9084	CHARACTER(LEN=80) :: daytype = 'workday' !< default day type
9085	CHARACTER(LEN=25) :: in_name !< name of a gas in the input file
9086
9087	CHARACTER(LEN=100), DIMENSION(:), ALLOCATABLE :: var_names !< variable names in input data
9088
9089	INTEGER(iwp) :: id_chem !< NetCDF id of chemistry emission file
9090	INTEGER(iwp) :: ig !< loop index
9091	INTEGER(iwp) :: in !< running index for emission categories
9092	INTEGER(iwp) :: num_vars !< number of variables
9093
9094	LOGICAL :: netcdf_extend = .FALSE. !< NetCDF input file exists
9095
9096	LOGICAL, INTENT(in) :: init !< if .TRUE. --> initialisation call
9097
9098	REAL(wp), DIMENSION(:), ALLOCATABLE :: time_factor !< emission time factor
9099
9100	TYPE(chem_emis_att_type) :: chem_emission_att !< chemistry emission attributes
9101	TYPE(chem_emis_val_type) :: chem_emission !< chemistry emission values
9102
9103	!
9104	!-- Reset surface fluxes
9105	surf_def_h(0)%gtsws = 0.0_wp
9106	surf_lsm_h%gtsws = 0.0_wp
9107	surf_usm_h%gtsws = 0.0_wp
9108
9109	#if defined( __netcdf )
9110	IF ( init ) THEN
9111	!
9112	!-- Check existence of PIDS_CHEM file
9113	INQUIRE( FILE = 'PIDS_CHEM' // TRIM( coupling_char ), EXIST = netcdf_extend )
9114	IF ( .NOT. netcdf_extend ) THEN
9115	message_string = 'Input file PIDS_CHEM' // TRIM( coupling_char ) // ' missing!'
9116	CALL message( 'salsa_gas_emission_setup', 'PA0640', 1, 2, 0, 6, 0 )
9117	ENDIF
9118	!
9119	!-- Open file in read-only mode
9120	CALL open_read_file( 'PIDS_CHEM' // TRIM( coupling_char ), id_chem )
9121	!
9122	!-- Read the index and name of chemical components
9123	CALL netcdf_data_input_get_dimension_length( id_chem, chem_emission_att%nspec, &
9124	'nspecies' )
9125	ALLOCATE( chem_emission_att%species_index(1:chem_emission_att%nspec) )
9126	CALL get_variable( id_chem, 'emission_index', chem_emission_att%species_index )
9127	CALL get_variable( id_chem, 'emission_name', chem_emission_att%species_name, &
9128	chem_emission_att%nspec )
9129	!
9130	!-- Find the corresponding indices in the model
9131	emission_index_chem = 0
9132	DO ig = 1, chem_emission_att%nspec
9133	in_name = chem_emission_att%species_name(ig)
9134	SELECT CASE ( TRIM( in_name ) )
9135	CASE ( 'H2SO4', 'h2so4' )
9136	emission_index_chem(1) = ig
9137	CASE ( 'HNO3', 'hno3' )
9138	emission_index_chem(2) = ig
9139	CASE ( 'NH3', 'nh3' )
9140	emission_index_chem(3) = ig
9141	CASE ( 'OCNV', 'ocnv' )
9142	emission_index_chem(4) = ig
9143	CASE ( 'OCSV', 'ocsv' )
9144	emission_index_chem(5) = ig
9145	END SELECT
9146	ENDDO
9147	!
9148	!-- Inquire the fill value
9149	CALL get_attribute( id_chem, '_FillValue', aero_emission%fill, .FALSE., 'emission_values' )
9150	!
9151	!-- Inquire units of emissions
9152	CALL get_attribute( id_chem, 'units', chem_emission_att%units, .FALSE., 'emission_values' )
9153	!
9154	!-- Inquire the level of detail (lod)
9155	CALL get_attribute( id_chem, 'lod', lod_gas_emissions, .FALSE., 'emission_values' )
9156	!
9157	!-- Variable names
9158	CALL inquire_num_variables( id_chem, num_vars )
9159	ALLOCATE( var_names(1:num_vars) )
9160	CALL inquire_variable_names( id_chem, var_names )
9161	!
9162	!-- Default mode: as total emissions per year
9163	IF ( lod_gas_emissions == 1 ) THEN
9164
9165	!
9166	!-- Get number of emission categories and allocate emission arrays
9167	CALL netcdf_data_input_get_dimension_length( id_chem, chem_emission_att%ncat, 'ncat' )
9168	ALLOCATE( chem_emission_att%cat_index(1:chem_emission_att%ncat), &
9169	time_factor(1:chem_emission_att%ncat) )
9170	!
9171	!-- Get emission category names and indices
9172	CALL get_variable( id_chem, 'emission_category_name', chem_emission_att%cat_name, &
9173	chem_emission_att%ncat)
9174	CALL get_variable( id_chem, 'emission_category_index', chem_emission_att%cat_index )
9175	!
9176	!-- Emission time factors: Find check whether emission time factors are given for each hour
9177	!-- of year OR based on month, day and hour
9178	!
9179	!-- For each hour of year:
9180	IF ( check_existence( var_names, 'nhoursyear' ) ) THEN
9181	CALL netcdf_data_input_get_dimension_length( id_chem, chem_emission_att%nhoursyear, &
9182	'nhoursyear' )
9183	ALLOCATE( chem_emission_att%hourly_emis_time_factor(1:chem_emission_att%ncat, &
9184	1:chem_emission_att%nhoursyear) )
9185	CALL get_variable( id_chem, 'emission_time_factors', &
9186	chem_emission_att%hourly_emis_time_factor, &
9187	0, chem_emission_att%nhoursyear-1, 0, chem_emission_att%ncat-1 )
9188	!
9189	!-- Based on the month, day and hour:
9190	ELSEIF ( check_existence( var_names, 'nmonthdayhour' ) ) THEN
9191	CALL netcdf_data_input_get_dimension_length( id_chem, chem_emission_att%nmonthdayhour,&
9192	'nmonthdayhour' )
9193	ALLOCATE( chem_emission_att%mdh_emis_time_factor(1:chem_emission_att%ncat, &
9194	1:chem_emission_att%nmonthdayhour) )
9195	CALL get_variable( id_chem, 'emission_time_factors', &
9196	chem_emission_att%mdh_emis_time_factor, &
9197	0, chem_emission_att%nmonthdayhour-1, 0, chem_emission_att%ncat-1 )
9198	ELSE
9199	message_string = 'emission_time_factors should be given for each nhoursyear OR ' // &
9200	'nmonthdayhour'
9201	CALL message( 'salsa_gas_emission_setup','PA0641', 1, 2, 0, 6, 0 )
9202	ENDIF
9203	!
9204	!-- Next emission update
9205	next_gas_emission_update = MOD( time_utc_init, 3600.0_wp ) - 3600.0_wp
9206	!
9207	!-- Allocate and read surface emission data (in total PM) (NOTE that "preprocessed" input data
9208	!-- array is applied now here)
9209	ALLOCATE( chem_emission%preproc_emission_data(nys:nyn,nxl:nxr, 1:chem_emission_att%nspec,&
9210	1:chem_emission_att%ncat) )
9211	CALL get_variable( id_chem, 'emission_values', chem_emission%preproc_emission_data, &
9212	0, chem_emission_att%ncat-1, 0, chem_emission_att%nspec-1, &
9213	nxl, nxr, nys, nyn )
9214	!
9215	!-- Pre-processed mode:
9216	ELSEIF ( lod_gas_emissions == 2 ) THEN
9217	!
9218	!-- Number of time steps in the emission data
9219	CALL netcdf_data_input_get_dimension_length( id_chem, chem_emission_att%dt_emission, &
9220	'time' )
9221	!
9222	!-- Allocate and read time
9223	ALLOCATE( gas_emission_time(1:chem_emission_att%dt_emission) )
9224	CALL get_variable( id_chem, 'time', gas_emission_time )
9225	ELSE
9226	message_string = 'Unknown lod for emission_values.'
9227	CALL message( 'salsa_gas_emission_setup','PA0642', 1, 2, 0, 6, 0 )
9228	ENDIF ! lod
9229
9230	ENDIF ! init
9231	!
9232	!-- Define and set current emission values:
9233
9234	IF ( lod_gas_emissions == 1 ) THEN
9235	!
9236	!-- Emission time factors for each emission category at current time step
9237	IF ( chem_emission_att%nhoursyear > chem_emission_att%nmonthdayhour ) THEN
9238	!
9239	!-- Get the index of the current hour
9240	CALL time_default_indices( month_of_year, day_of_month, hour_of_day, index_hh )
9241	time_factor = chem_emission_att%hourly_emis_time_factor(:,index_hh)
9242
9243	ELSEIF ( chem_emission_att%nhoursyear < chem_emission_att%nmonthdayhour ) THEN
9244	!
9245	!-- Get the index of current hour (index_hh) (TODO: Now "workday" is always assumed.
9246	!-- Needs to be calculated.)
9247	CALL time_default_indices( daytype, month_of_year, day_of_month, hour_of_day, &
9248	index_mm, index_dd, index_hh )
9249	time_factor = chem_emission_att%mdh_emis_time_factor(:,index_mm) * &
9250	chem_emission_att%mdh_emis_time_factor(:,index_dd) * &
9251	chem_emission_att%mdh_emis_time_factor(:,index_hh)
9252	ENDIF
9253	!
9254	!-- Set gas emissions for each emission category
9255	DO in = 1, chem_emission_att%ncat
9256	!
9257	!-- Set surface fluxes only for either default, land or urban surface
9258	IF ( .NOT. land_surface .AND. .NOT. urban_surface ) THEN
9259	CALL set_gas_flux( surf_def_h(0), emission_index_chem, chem_emission_att%units, &
9260	chem_emission%preproc_emission_data(:,:,:,in), time_factor(in) )
9261	ELSE
9262	CALL set_gas_flux( surf_usm_h, emission_index_chem, chem_emission_att%units, &
9263	chem_emission%preproc_emission_data(:,:,:,in), time_factor(in) )
9264	CALL set_gas_flux( surf_lsm_h, emission_index_chem, chem_emission_att%units, &
9265	chem_emission%preproc_emission_data(:,:,:,in), time_factor(in) )
9266	ENDIF
9267	ENDDO
9268	!
9269	!-- The next emission update is again after one hour
9270	next_gas_emission_update = next_gas_emission_update + 3600.0_wp
9271
9272	ELSEIF ( lod_gas_emissions == 2 ) THEN
9273	!
9274	!-- Obtain time index for current input starting at 0.
9275	!-- @todo: At the moment emission data and simulated time correspond to each other.
9276	chem_emission_att%i_hour = MINLOC( ABS( gas_emission_time - time_since_reference_point ), &
9277	DIM = 1 ) - 1
9278	!
9279	!-- Allocate the data input array always before reading in the data and deallocate after (NOTE
9280	!-- that "preprocessed" input data array is applied now here)
9281	ALLOCATE( chem_emission%default_emission_data(nys:nyn,nxl:nxr,1:nbins_aerosol) )
9282	!
9283	!-- Read in the next time step
9284	CALL get_variable( id_chem, 'emission_values', chem_emission%default_emission_data, &
9285	chem_emission_att%i_hour, 0, chem_emission_att%nspec-1, nxl, nxr, nys, nyn )
9286	!
9287	!-- Set surface fluxes only for either default, land or urban surface
9288	IF ( .NOT. land_surface .AND. .NOT. urban_surface ) THEN
9289	CALL set_gas_flux( surf_def_h(0), emission_index_chem, chem_emission_att%units, &
9290	chem_emission%default_emission_data )
9291	ELSE
9292	CALL set_gas_flux( surf_usm_h, emission_index_chem, chem_emission_att%units, &
9293	chem_emission%default_emission_data )
9294	CALL set_gas_flux( surf_lsm_h, emission_index_chem, chem_emission_att%units, &
9295	chem_emission%default_emission_data )
9296	ENDIF
9297	!
9298	!-- Determine the next emission update
9299	next_gas_emission_update = gas_emission_time(chem_emission_att%i_hour+2)
9300
9301	DEALLOCATE( chem_emission%default_emission_data )
9302	ENDIF
9303	#else
9304	message_string = 'salsa_emission_mode = "read_from_file", but preprocessor directive ' // &
9305	' __netcdf is not used in compiling!'
9306	CALL message( 'salsa_gas_emission_setup', 'PA0643', 1, 2, 0, 6, 0 )
9307
9308	#endif
9309
9310	CONTAINS
9311	!------------------------------------------------------------------------------!
9312	! Description:
9313	! ------------
9314	!> Set gas fluxes for selected type of surfaces
9315	!------------------------------------------------------------------------------!
9316	SUBROUTINE set_gas_flux( surface, cc_i_mod, unit, source_array, time_fac )
9317
9318	USE arrays_3d, &
9319	ONLY: dzw, hyp, pt, rho_air_zw
9320
9321	USE grid_variables, &
9322	ONLY: dx, dy
9323
9324	USE surface_mod, &
9325	ONLY: surf_type
9326
9327	IMPLICIT NONE
9328
9329	CHARACTER(LEN=*), INTENT(in) :: unit !< flux unit in the input file
9330
9331	INTEGER(iwp) :: ig !< running index for gases
9332	INTEGER(iwp) :: i !< loop index
9333	INTEGER(iwp) :: j !< loop index
9334	INTEGER(iwp) :: k !< loop index
9335	INTEGER(iwp) :: m !< running index for surface elements
9336
9337	INTEGER(iwp), DIMENSION(:) :: cc_i_mod !< index of different gases in the input data
9338
9339	LOGICAL :: use_time_fac !< .TRUE. is time_fac present
9340
9341	REAL(wp), OPTIONAL :: time_fac !< emission time factor
9342
9343	REAL(wp), DIMENSION(ngases_salsa) :: conv !< unit conversion factor
9344
9345	REAL(wp), DIMENSION(nys:nyn,nxl:nxr,chem_emission_att%nspec), INTENT(in) :: source_array !<
9346
9347	TYPE(surf_type), INTENT(inout) :: surface !< respective surface type
9348
9349	use_time_fac = PRESENT( time_fac )
9350
9351	DO m = 1, surface%ns
9352	!
9353	!-- Get indices of respective grid point
9354	i = surface%i(m)
9355	j = surface%j(m)
9356	k = surface%k(m)
9357	!
9358	!-- Unit conversion factor: convert to SI units (#/m2/s)
9359	SELECT CASE ( TRIM( unit ) )
9360	CASE ( 'kg/m2/yr' )
9361	conv(1) = avo / ( amh2so4 * 3600.0_wp )
9362	conv(2) = avo / ( amhno3 * 3600.0_wp )
9363	conv(3) = avo / ( amnh3 * 3600.0_wp )
9364	conv(4) = avo / ( amoc * 3600.0_wp )
9365	conv(5) = avo / ( amoc * 3600.0_wp )
9366	CASE ( 'g/m2/yr' )
9367	conv(1) = avo / ( amh2so4 * 3.6E+6_wp )
9368	conv(2) = avo / ( amhno3 * 3.6E+6_wp )
9369	conv(3) = avo / ( amnh3 * 3.6E+6_wp )
9370	conv(4) = avo / ( amoc * 3.6E+6_wp )
9371	conv(5) = avo / ( amoc * 3.6E+6_wp )
9372	CASE ( 'g/m2/s' )
9373	conv(1) = avo / ( amh2so4 * 1000.0_wp )
9374	conv(2) = avo / ( amhno3 * 1000.0_wp )
9375	conv(3) = avo / ( amnh3 * 1000.0_wp )
9376	conv(4) = avo / ( amoc * 1000.0_wp )
9377	conv(5) = avo / ( amoc * 1000.0_wp )
9378	CASE ( '#/m2/s' )
9379	conv = 1.0_wp
9380	CASE ( 'ppm/m2/s' )
9381	conv = for_ppm_to_nconc * hyp(k) / pt(k,j,i) * ( 1.0E5_wp / hyp(k) )*0.286_wp &
9382	dx * dy * dzw(k)
9383	CASE ( 'mumol/m2/s' )
9384	conv = 1.0E-6_wp * avo
9385	CASE DEFAULT
9386	message_string = 'unknown unit for gas emissions: ' // TRIM( chem_emission_att%units )
9387	CALL message( 'set_gas_flux','PA0644', 1, 2, 0, 6, 0 )
9388
9389	END SELECT
9390
9391	DO ig = 1, ngases_salsa
9392	IF ( use_time_fac ) THEN
9393	surface%gtsws(m,ig) = surface%gtsws(m,ig) + rho_air_zw(k-1) * conv(ig) * time_fac &
9394	* MAX( 0.0_wp, source_array(j,i,cc_i_mod(ig) ) )
9395	ELSE
9396	surface%gtsws(m,ig) = surface%gtsws(m,ig) + rho_air_zw(k-1) * conv(ig) &
9397	* MAX( 0.0_wp, source_array(j,i,cc_i_mod(ig) ) )
9398	ENDIF
9399	ENDDO ! ig
9400
9401	ENDDO ! m
9402
9403	END SUBROUTINE set_gas_flux
9404
9405	END SUBROUTINE salsa_gas_emission_setup
9406
9407	!------------------------------------------------------------------------------!
9408	! Description:
9409	! ------------
9410	!> Check data output for salsa.
9411	!------------------------------------------------------------------------------!
9412	SUBROUTINE salsa_check_data_output( var, unit )
9413
9414	USE control_parameters, &
9415	ONLY: message_string
9416
9417	IMPLICIT NONE
9418
9419	CHARACTER(LEN=*) :: unit !<
9420	CHARACTER(LEN=*) :: var !<
9421
9422	SELECT CASE ( TRIM( var ) )
9423
9424	CASE ( 'g_H2SO4', 'g_HNO3', 'g_NH3', 'g_OCNV', 'g_OCSV' )
9425	IF ( .NOT. salsa ) THEN
9426	message_string = 'output of "' // TRIM( var ) // '" requires salsa = .TRUE.'
9427	CALL message( 'check_parameters', 'PA0652', 1, 2, 0, 6, 0 )
9428	ENDIF
9429	IF ( salsa_gases_from_chem ) THEN
9430	message_string = 'gases are imported from the chemistry module and thus output of "' &
9431	// TRIM( var ) // '" is not allowed'
9432	CALL message( 'check_parameters', 'PA0653', 1, 2, 0, 6, 0 )
9433	ENDIF
9434	unit = '#/m3'
9435
9436	CASE ( 'LDSA' )
9437	IF ( .NOT. salsa ) THEN
9438	message_string = 'output of "' // TRIM( var ) // '" requires salsa = .TRUE.'
9439	CALL message( 'check_parameters', 'PA0646', 1, 2, 0, 6, 0 )
9440	ENDIF
9441	unit = 'mum2/cm3'
9442
9443	CASE ( 'm_bin1', 'm_bin2', 'm_bin3', 'm_bin4', 'm_bin5', 'm_bin6', 'm_bin7', 'm_bin8', &
9444	'm_bin9', 'm_bin10', 'm_bin11', 'm_bin12', 'PM2.5', 'PM10', 's_BC', 's_DU', &
9445	's_H2O', 's_NH', 's_NO', 's_OC', 's_SO4', 's_SS' )
9446	IF ( .NOT. salsa ) THEN
9447	message_string = 'output of "' // TRIM( var ) // '" requires salsa = .TRUE.'
9448	CALL message( 'check_parameters', 'PA0647', 1, 2, 0, 6, 0 )
9449	ENDIF
9450	unit = 'kg/m3'
9451
9452	CASE ( 'N_bin1', 'N_bin2', 'N_bin3', 'N_bin4', 'N_bin5', 'N_bin6', 'N_bin7', 'N_bin8', &
9453	'N_bin9', 'N_bin10', 'N_bin11', 'N_bin12', 'Ntot' )
9454	IF ( .NOT. salsa ) THEN
9455	message_string = 'output of "' // TRIM( var ) // '" requires salsa = .TRUE.'
9456	CALL message( 'check_parameters', 'PA0645', 1, 2, 0, 6, 0 )
9457	ENDIF
9458	unit = '#/m3'
9459
9460	CASE DEFAULT
9461	unit = 'illegal'
9462
9463	END SELECT
9464
9465	END SUBROUTINE salsa_check_data_output
9466
9467	!------------------------------------------------------------------------------!
9468	!
9469	! Description:
9470	! ------------
9471	!> Subroutine for averaging 3D data
9472	!------------------------------------------------------------------------------!
9473	SUBROUTINE salsa_3d_data_averaging( mode, variable )
9474
9475	USE control_parameters
9476
9477	USE indices
9478
9479	USE kinds
9480
9481	IMPLICIT NONE
9482
9483	CHARACTER(LEN=*) :: mode !<
9484	CHARACTER(LEN=10) :: vari !<
9485	CHARACTER(LEN=*) :: variable !<
9486
9487	INTEGER(iwp) :: found_index !<
9488	INTEGER(iwp) :: i !<
9489	INTEGER(iwp) :: ib !<
9490	INTEGER(iwp) :: ic !<
9491	INTEGER(iwp) :: j !<
9492	INTEGER(iwp) :: k !<
9493
9494	REAL(wp) :: df !< For calculating LDSA: fraction of particles depositing in the alveolar
9495	!< (or tracheobronchial) region of the lung. Depends on the particle size
9496	REAL(wp) :: mean_d !< Particle diameter in micrometres
9497	REAL(wp) :: nc !< Particle number concentration in units 1/cm**3
9498	REAL(wp) :: temp_bin !< temporary variable
9499
9500	REAL(wp), DIMENSION(:,:,:), POINTER :: to_be_resorted !< points to selected output variable
9501
9502	temp_bin = 0.0_wp
9503
9504	IF ( mode == 'allocate' ) THEN
9505
9506	SELECT CASE ( TRIM( variable ) )
9507
9508	CASE ( 'g_H2SO4' )
9509	IF ( .NOT. ALLOCATED( g_h2so4_av ) ) THEN
9510	ALLOCATE( g_h2so4_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
9511	ENDIF
9512	g_h2so4_av = 0.0_wp
9513
9514	CASE ( 'g_HNO3' )
9515	IF ( .NOT. ALLOCATED( g_hno3_av ) ) THEN
9516	ALLOCATE( g_hno3_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
9517	ENDIF
9518	g_hno3_av = 0.0_wp
9519
9520	CASE ( 'g_NH3' )
9521	IF ( .NOT. ALLOCATED( g_nh3_av ) ) THEN
9522	ALLOCATE( g_nh3_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
9523	ENDIF
9524	g_nh3_av = 0.0_wp
9525
9526	CASE ( 'g_OCNV' )
9527	IF ( .NOT. ALLOCATED( g_ocnv_av ) ) THEN
9528	ALLOCATE( g_ocnv_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
9529	ENDIF
9530	g_ocnv_av = 0.0_wp
9531
9532	CASE ( 'g_OCSV' )
9533	IF ( .NOT. ALLOCATED( g_ocsv_av ) ) THEN
9534	ALLOCATE( g_ocsv_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
9535	ENDIF
9536	g_ocsv_av = 0.0_wp
9537
9538	CASE ( 'LDSA' )
9539	IF ( .NOT. ALLOCATED( ldsa_av ) ) THEN
9540	ALLOCATE( ldsa_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
9541	ENDIF
9542	ldsa_av = 0.0_wp
9543
9544	CASE ( 'N_bin1', 'N_bin2', 'N_bin3', 'N_bin4', 'N_bin5', 'N_bin6', 'N_bin7', 'N_bin8', &
9545	'N_bin9', 'N_bin10', 'N_bin11', 'N_bin12' )
9546	IF ( .NOT. ALLOCATED( nbins_av ) ) THEN
9547	ALLOCATE( nbins_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg,nbins_aerosol) )
9548	ENDIF
9549	nbins_av = 0.0_wp
9550
9551	CASE ( 'Ntot' )
9552	IF ( .NOT. ALLOCATED( ntot_av ) ) THEN
9553	ALLOCATE( ntot_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
9554	ENDIF
9555	ntot_av = 0.0_wp
9556
9557	CASE ( 'm_bin1', 'm_bin2', 'm_bin3', 'm_bin4', 'm_bin5', 'm_bin6', 'm_bin7', 'm_bin8', &
9558	'm_bin9', 'm_bin10', 'm_bin11', 'm_bin12' )
9559	IF ( .NOT. ALLOCATED( mbins_av ) ) THEN
9560	ALLOCATE( mbins_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg,nbins_aerosol) )
9561	ENDIF
9562	mbins_av = 0.0_wp
9563
9564	CASE ( 'PM2.5' )
9565	IF ( .NOT. ALLOCATED( pm25_av ) ) THEN
9566	ALLOCATE( pm25_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
9567	ENDIF
9568	pm25_av = 0.0_wp
9569
9570	CASE ( 'PM10' )
9571	IF ( .NOT. ALLOCATED( pm10_av ) ) THEN
9572	ALLOCATE( pm10_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
9573	ENDIF
9574	pm10_av = 0.0_wp
9575
9576	CASE ( 's_BC' )
9577	IF ( .NOT. ALLOCATED( s_bc_av ) ) THEN
9578	ALLOCATE( s_bc_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
9579	ENDIF
9580	s_bc_av = 0.0_wp
9581
9582	CASE ( 's_DU' )
9583	IF ( .NOT. ALLOCATED( s_du_av ) ) THEN
9584	ALLOCATE( s_du_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
9585	ENDIF
9586	s_du_av = 0.0_wp
9587
9588	CASE ( 's_H2O' )
9589	IF ( .NOT. ALLOCATED( s_h2o_av ) ) THEN
9590	ALLOCATE( s_h2o_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
9591	ENDIF
9592	s_h2o_av = 0.0_wp
9593
9594	CASE ( 's_NH' )
9595	IF ( .NOT. ALLOCATED( s_nh_av ) ) THEN
9596	ALLOCATE( s_nh_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
9597	ENDIF
9598	s_nh_av = 0.0_wp
9599
9600	CASE ( 's_NO' )
9601	IF ( .NOT. ALLOCATED( s_no_av ) ) THEN
9602	ALLOCATE( s_no_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
9603	ENDIF
9604	s_no_av = 0.0_wp
9605
9606	CASE ( 's_OC' )
9607	IF ( .NOT. ALLOCATED( s_oc_av ) ) THEN
9608	ALLOCATE( s_oc_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
9609	ENDIF
9610	s_oc_av = 0.0_wp
9611
9612	CASE ( 's_SO4' )
9613	IF ( .NOT. ALLOCATED( s_so4_av ) ) THEN
9614	ALLOCATE( s_so4_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
9615	ENDIF
9616	s_so4_av = 0.0_wp
9617
9618	CASE ( 's_SS' )
9619	IF ( .NOT. ALLOCATED( s_ss_av ) ) THEN
9620	ALLOCATE( s_ss_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
9621	ENDIF
9622	s_ss_av = 0.0_wp
9623
9624	CASE DEFAULT
9625	CONTINUE
9626
9627	END SELECT
9628
9629	ELSEIF ( mode == 'sum' ) THEN
9630
9631	SELECT CASE ( TRIM( variable ) )
9632
9633	CASE ( 'g_H2SO4', 'g_HNO3', 'g_NH3', 'g_OCNV', 'g_OCSV' )
9634
9635	vari = TRIM( variable(3:) )
9636
9637	SELECT CASE( vari )
9638
9639	CASE( 'H2SO4' )
9640	found_index = 1
9641	to_be_resorted => g_h2so4_av
9642
9643	CASE( 'HNO3' )
9644	found_index = 2
9645	to_be_resorted => g_hno3_av
9646
9647	CASE( 'NH3' )
9648	found_index = 3
9649	to_be_resorted => g_nh3_av
9650
9651	CASE( 'OCNV' )
9652	found_index = 4
9653	to_be_resorted => g_ocnv_av
9654
9655	CASE( 'OCSN' )
9656	found_index = 5
9657	to_be_resorted => g_ocsv_av
9658
9659	END SELECT
9660
9661	DO i = nxlg, nxrg
9662	DO j = nysg, nyng
9663	DO k = nzb, nzt+1
9664	to_be_resorted(k,j,i) = to_be_resorted(k,j,i) + &
9665	salsa_gas(found_index)%conc(k,j,i)
9666	ENDDO
9667	ENDDO
9668	ENDDO
9669
9670	CASE ( 'LDSA' )
9671	DO i = nxlg, nxrg
9672	DO j = nysg, nyng
9673	DO k = nzb, nzt+1
9674	temp_bin = 0.0_wp
9675	DO ib = 1, nbins_aerosol
9676	!
9677	!-- Diameter in micrometres
9678	mean_d = 1.0E+6_wp * ra_dry(k,j,i,ib) * 2.0_wp
9679	!
9680	!-- Deposition factor: alveolar (use ra_dry)
9681	df = ( 0.01555_wp / mean_d ) * ( EXP( -0.416_wp * ( LOG( mean_d ) + &
9682	2.84_wp )*2 ) + 19.11_wp EXP( -0.482_wp * ( LOG( mean_d ) - &
9683	1.362_wp )**2 ) )
9684	!
9685	!-- Number concentration in 1/cm3
9686	nc = 1.0E-6_wp * aerosol_number(ib)%conc(k,j,i)
9687	!
9688	!-- Lung-deposited surface area LDSA (units mum2/cm3)
9689	temp_bin = temp_bin + pi * mean_d*2 df * nc
9690	ENDDO
9691	ldsa_av(k,j,i) = ldsa_av(k,j,i) + temp_bin
9692	ENDDO
9693	ENDDO
9694	ENDDO
9695
9696	CASE ( 'N_bin1', 'N_bin2', 'N_bin3', 'N_bin4', 'N_bin5', 'N_bin6', 'N_bin7', 'N_bin8', &
9697	'N_bin9', 'N_bin10', 'N_bin11', 'N_bin12' )
9698	DO i = nxlg, nxrg
9699	DO j = nysg, nyng
9700	DO k = nzb, nzt+1
9701	DO ib = 1, nbins_aerosol
9702	nbins_av(k,j,i,ib) = nbins_av(k,j,i,ib) + aerosol_number(ib)%conc(k,j,i)
9703	ENDDO
9704	ENDDO
9705	ENDDO
9706	ENDDO
9707
9708	CASE ( 'Ntot' )
9709	DO i = nxlg, nxrg
9710	DO j = nysg, nyng
9711	DO k = nzb, nzt+1
9712	DO ib = 1, nbins_aerosol
9713	ntot_av(k,j,i) = ntot_av(k,j,i) + aerosol_number(ib)%conc(k,j,i)
9714	ENDDO
9715	ENDDO
9716	ENDDO
9717	ENDDO
9718
9719	CASE ( 'm_bin1', 'm_bin2', 'm_bin3', 'm_bin4', 'm_bin5', 'm_bin6', 'm_bin7', 'm_bin8', &
9720	'm_bin9', 'm_bin10', 'm_bin11', 'm_bin12' )
9721	DO i = nxlg, nxrg
9722	DO j = nysg, nyng
9723	DO k = nzb, nzt+1
9724	DO ib = 1, nbins_aerosol
9725	DO ic = ib, nbins_aerosol * ncomponents_mass, nbins_aerosol
9726	mbins_av(k,j,i,ib) = mbins_av(k,j,i,ib) + aerosol_mass(ic)%conc(k,j,i)
9727	ENDDO
9728	ENDDO
9729	ENDDO
9730	ENDDO
9731	ENDDO
9732
9733	CASE ( 'PM2.5' )
9734	DO i = nxlg, nxrg
9735	DO j = nysg, nyng
9736	DO k = nzb, nzt+1
9737	temp_bin = 0.0_wp
9738	DO ib = 1, nbins_aerosol
9739	IF ( 2.0_wp * ra_dry(k,j,i,ib) <= 2.5E-6_wp ) THEN
9740	DO ic = ib, nbins_aerosol * ncc, nbins_aerosol
9741	temp_bin = temp_bin + aerosol_mass(ic)%conc(k,j,i)
9742	ENDDO
9743	ENDIF
9744	ENDDO
9745	pm25_av(k,j,i) = pm25_av(k,j,i) + temp_bin
9746	ENDDO
9747	ENDDO
9748	ENDDO
9749
9750	CASE ( 'PM10' )
9751	DO i = nxlg, nxrg
9752	DO j = nysg, nyng
9753	DO k = nzb, nzt+1
9754	temp_bin = 0.0_wp
9755	DO ib = 1, nbins_aerosol
9756	IF ( 2.0_wp * ra_dry(k,j,i,ib) <= 10.0E-6_wp ) THEN
9757	DO ic = ib, nbins_aerosol * ncc, nbins_aerosol
9758	temp_bin = temp_bin + aerosol_mass(ic)%conc(k,j,i)
9759	ENDDO
9760	ENDIF
9761	ENDDO
9762	pm10_av(k,j,i) = pm10_av(k,j,i) + temp_bin
9763	ENDDO
9764	ENDDO
9765	ENDDO
9766
9767	CASE ( 's_BC', 's_DU', 's_H2O', 's_NH', 's_NO', 's_OC', 's_SO4', 's_SS' )
9768	IF ( is_used( prtcl, TRIM( variable(3:) ) ) ) THEN
9769	found_index = get_index( prtcl, TRIM( variable(3:) ) )
9770	IF ( TRIM( variable(3:) ) == 'BC' ) to_be_resorted => s_bc_av
9771	IF ( TRIM( variable(3:) ) == 'DU' ) to_be_resorted => s_du_av
9772	IF ( TRIM( variable(3:) ) == 'NH' ) to_be_resorted => s_nh_av
9773	IF ( TRIM( variable(3:) ) == 'NO' ) to_be_resorted => s_no_av
9774	IF ( TRIM( variable(3:) ) == 'OC' ) to_be_resorted => s_oc_av
9775	IF ( TRIM( variable(3:) ) == 'SO4' ) to_be_resorted => s_so4_av
9776	IF ( TRIM( variable(3:) ) == 'SS' ) to_be_resorted => s_ss_av
9777	DO i = nxlg, nxrg
9778	DO j = nysg, nyng
9779	DO k = nzb, nzt+1
9780	DO ic = ( found_index-1 ) * nbins_aerosol + 1, found_index * nbins_aerosol
9781	to_be_resorted(k,j,i) = to_be_resorted(k,j,i) + &
9782	aerosol_mass(ic)%conc(k,j,i)
9783	ENDDO
9784	ENDDO
9785	ENDDO
9786	ENDDO
9787	ENDIF
9788
9789	CASE DEFAULT
9790	CONTINUE
9791
9792	END SELECT
9793
9794	ELSEIF ( mode == 'average' ) THEN
9795
9796	SELECT CASE ( TRIM( variable ) )
9797
9798	CASE ( 'g_H2SO4', 'g_HNO3', 'g_NH3', 'g_OCNV', 'g_OCSV' )
9799	IF ( TRIM( variable(3:) ) == 'H2SO4' ) THEN
9800	found_index = 1
9801	to_be_resorted => g_h2so4_av
9802	ELSEIF ( TRIM( variable(3:) ) == 'HNO3' ) THEN
9803	found_index = 2
9804	to_be_resorted => g_hno3_av
9805	ELSEIF ( TRIM( variable(3:) ) == 'NH3' ) THEN
9806	found_index = 3
9807	to_be_resorted => g_nh3_av
9808	ELSEIF ( TRIM( variable(3:) ) == 'OCNV' ) THEN
9809	found_index = 4
9810	to_be_resorted => g_ocnv_av
9811	ELSEIF ( TRIM( variable(3:) ) == 'OCSV' ) THEN
9812	found_index = 5
9813	to_be_resorted => g_ocsv_av
9814	ENDIF
9815	DO i = nxlg, nxrg
9816	DO j = nysg, nyng
9817	DO k = nzb, nzt+1
9818	to_be_resorted(k,j,i) = to_be_resorted(k,j,i) / &
9819	REAL( average_count_3d, KIND=wp )
9820	ENDDO
9821	ENDDO
9822	ENDDO
9823
9824	CASE ( 'LDSA' )
9825	DO i = nxlg, nxrg
9826	DO j = nysg, nyng
9827	DO k = nzb, nzt+1
9828	ldsa_av(k,j,i) = ldsa_av(k,j,i) / REAL( average_count_3d, KIND=wp )
9829	ENDDO
9830	ENDDO
9831	ENDDO
9832
9833	CASE ( 'N_bin1', 'N_bin2', 'N_bin3', 'N_bin4', 'N_bin5', 'N_bin6', 'N_bin7', 'N_bin8', &
9834	'N_bin9', 'N_bin10', 'N_bin11', 'N_bin12' )
9835	DO i = nxlg, nxrg
9836	DO j = nysg, nyng
9837	DO k = nzb, nzt+1
9838	DO ib = 1, nbins_aerosol
9839	nbins_av(k,j,i,ib) = nbins_av(k,j,i,ib) / REAL( average_count_3d, KIND=wp )
9840	ENDDO
9841	ENDDO
9842	ENDDO
9843	ENDDO
9844
9845	CASE ( 'Ntot' )
9846	DO i = nxlg, nxrg
9847	DO j = nysg, nyng
9848	DO k = nzb, nzt+1
9849	ntot_av(k,j,i) = ntot_av(k,j,i) / REAL( average_count_3d, KIND=wp )
9850	ENDDO
9851	ENDDO
9852	ENDDO
9853
9854	CASE ( 'm_bin1', 'm_bin2', 'm_bin3', 'm_bin4', 'm_bin5', 'm_bin6', 'm_bin7', 'm_bin8', &
9855	'm_bin9', 'm_bin10', 'm_bin11', 'm_bin12' )
9856	DO i = nxlg, nxrg
9857	DO j = nysg, nyng
9858	DO k = nzb, nzt+1
9859	DO ib = 1, nbins_aerosol
9860	DO ic = ib, nbins_aerosol * ncomponents_mass, nbins_aerosol
9861	mbins_av(k,j,i,ib) = mbins_av(k,j,i,ib) / &
9862	REAL( average_count_3d, KIND=wp)
9863	ENDDO
9864	ENDDO
9865	ENDDO
9866	ENDDO
9867	ENDDO
9868
9869	CASE ( 'PM2.5' )
9870	DO i = nxlg, nxrg
9871	DO j = nysg, nyng
9872	DO k = nzb, nzt+1
9873	pm25_av(k,j,i) = pm25_av(k,j,i) / REAL( average_count_3d, KIND=wp )
9874	ENDDO
9875	ENDDO
9876	ENDDO
9877
9878	CASE ( 'PM10' )
9879	DO i = nxlg, nxrg
9880	DO j = nysg, nyng
9881	DO k = nzb, nzt+1
9882	pm10_av(k,j,i) = pm10_av(k,j,i) / REAL( average_count_3d, KIND=wp )
9883	ENDDO
9884	ENDDO
9885	ENDDO
9886
9887	CASE ( 's_BC', 's_DU', 's_H2O', 's_NH', 's_NO', 's_OC', 's_SO4', 's_SS' )
9888	IF ( is_used( prtcl, TRIM( variable(3:) ) ) ) THEN
9889	found_index = get_index( prtcl, TRIM( variable(3:) ) )
9890	IF ( TRIM( variable(3:) ) == 'BC' ) to_be_resorted => s_bc_av
9891	IF ( TRIM( variable(3:) ) == 'DU' ) to_be_resorted => s_du_av
9892	IF ( TRIM( variable(3:) ) == 'NH' ) to_be_resorted => s_nh_av
9893	IF ( TRIM( variable(3:) ) == 'NO' ) to_be_resorted => s_no_av
9894	IF ( TRIM( variable(3:) ) == 'OC' ) to_be_resorted => s_oc_av
9895	IF ( TRIM( variable(3:) ) == 'SO4' ) to_be_resorted => s_so4_av
9896	IF ( TRIM( variable(3:) ) == 'SS' ) to_be_resorted => s_ss_av
9897	DO i = nxlg, nxrg
9898	DO j = nysg, nyng
9899	DO k = nzb, nzt+1
9900	to_be_resorted(k,j,i) = to_be_resorted(k,j,i) / &
9901	REAL( average_count_3d, KIND=wp )
9902	ENDDO
9903	ENDDO
9904	ENDDO
9905	ENDIF
9906
9907	END SELECT
9908
9909	ENDIF
9910
9911	END SUBROUTINE salsa_3d_data_averaging
9912
9913
9914	!------------------------------------------------------------------------------!
9915	!
9916	! Description:
9917	! ------------
9918	!> Subroutine defining 2D output variables
9919	!------------------------------------------------------------------------------!
9920	SUBROUTINE salsa_data_output_2d( av, variable, found, grid, mode, local_pf, two_d, nzb_do, nzt_do )
9921
9922	USE indices
9923
9924	USE kinds
9925
9926
9927	IMPLICIT NONE
9928
9929	CHARACTER(LEN=*) :: grid !<
9930	CHARACTER(LEN=*) :: mode !<
9931	CHARACTER(LEN=*) :: variable !<
9932	CHARACTER(LEN=5) :: vari !< trimmed format of variable
9933
9934	INTEGER(iwp) :: av !<
9935	INTEGER(iwp) :: found_index !< index of a chemical compound
9936	INTEGER(iwp) :: i !<
9937	INTEGER(iwp) :: ib !< running index: size bins
9938	INTEGER(iwp) :: ic !< running index: mass bins
9939	INTEGER(iwp) :: j !<
9940	INTEGER(iwp) :: k !<
9941	INTEGER(iwp) :: nzb_do !<
9942	INTEGER(iwp) :: nzt_do !<
9943
9944	LOGICAL :: found !<
9945	LOGICAL :: two_d !< flag parameter to indicate 2D variables (horizontal cross sections)
9946
9947	REAL(wp) :: df !< For calculating LDSA: fraction of particles
9948	!< depositing in the alveolar (or tracheobronchial)
9949	!< region of the lung. Depends on the particle size
9950	REAL(wp) :: fill_value = -9999.0_wp !< value for the _FillValue attribute
9951	REAL(wp) :: mean_d !< Particle diameter in micrometres
9952	REAL(wp) :: nc !< Particle number concentration in units 1/cm**3
9953	REAL(wp) :: temp_bin !< temporary array for calculating output variables
9954
9955	REAL(wp), DIMENSION(nxl:nxr,nys:nyn,nzb_do:nzt_do) :: local_pf !< output
9956
9957	REAL(wp), DIMENSION(:,:,:), POINTER :: to_be_resorted !< pointer
9958	!
9959	!-- Next statement is to avoid compiler warning about unused variable. May be removed in future.
9960	IF ( two_d ) CONTINUE
9961
9962	found = .TRUE.
9963	temp_bin = 0.0_wp
9964
9965	SELECT CASE ( TRIM( variable( 1:LEN( TRIM( variable ) ) - 3 ) ) ) ! cut out _xy, _xz or _yz
9966
9967	CASE ( 'g_H2SO4', 'g_HNO3', 'g_NH3', 'g_OCNV', 'g_OCSV' )
9968	vari = TRIM( variable( 3:LEN( TRIM( variable ) ) - 3 ) )
9969	IF ( av == 0 ) THEN
9970	IF ( vari == 'H2SO4') found_index = 1
9971	IF ( vari == 'HNO3') found_index = 2
9972	IF ( vari == 'NH3') found_index = 3
9973	IF ( vari == 'OCNV') found_index = 4
9974	IF ( vari == 'OCSV') found_index = 5
9975	DO i = nxl, nxr
9976	DO j = nys, nyn
9977	DO k = nzb_do, nzt_do
9978	local_pf(i,j,k) = MERGE( salsa_gas(found_index)%conc(k,j,i), REAL( fill_value, &
9979	KIND = wp ), BTEST( wall_flags_0(k,j,i), 0 ) )
9980	ENDDO
9981	ENDDO
9982	ENDDO
9983	ELSE
9984	IF ( vari == 'H2SO4' ) to_be_resorted => g_h2so4_av
9985	IF ( vari == 'HNO3' ) to_be_resorted => g_hno3_av
9986	IF ( vari == 'NH3' ) to_be_resorted => g_nh3_av
9987	IF ( vari == 'OCNV' ) to_be_resorted => g_ocnv_av
9988	IF ( vari == 'OCSV' ) to_be_resorted => g_ocsv_av
9989	DO i = nxl, nxr
9990	DO j = nys, nyn
9991	DO k = nzb_do, nzt_do
9992	local_pf(i,j,k) = MERGE( to_be_resorted(k,j,i), REAL( fill_value, &
9993	KIND = wp ), BTEST( wall_flags_0(k,j,i), 0 ) )
9994	ENDDO
9995	ENDDO
9996	ENDDO
9997	ENDIF
9998
9999	IF ( mode == 'xy' ) grid = 'zu'
10000
10001	CASE ( 'LDSA' )
10002	IF ( av == 0 ) THEN
10003	DO i = nxl, nxr
10004	DO j = nys, nyn
10005	DO k = nzb_do, nzt_do
10006	temp_bin = 0.0_wp
10007	DO ib = 1, nbins_aerosol
10008	!
10009	!-- Diameter in micrometres
10010	mean_d = 1.0E+6_wp * ra_dry(k,j,i,ib) * 2.0_wp
10011	!
10012	!-- Deposition factor: alveolar
10013	df = ( 0.01555_wp / mean_d ) * ( EXP( -0.416_wp * ( LOG( mean_d ) + &
10014	2.84_wp )*2 ) + 19.11_wp EXP( -0.482_wp * ( LOG( mean_d ) - &
10015	1.362_wp )**2 ) )
10016	!
10017	!-- Number concentration in 1/cm3
10018	nc = 1.0E-6_wp * aerosol_number(ib)%conc(k,j,i)
10019	!
10020	!-- Lung-deposited surface area LDSA (units mum2/cm3)
10021	temp_bin = temp_bin + pi * mean_d*2 df * nc
10022	ENDDO
10023
10024	local_pf(i,j,k) = MERGE( temp_bin, REAL( fill_value, KIND = wp ), &
10025	BTEST( wall_flags_0(k,j,i), 0 ) )
10026	ENDDO
10027	ENDDO
10028	ENDDO
10029	ELSE
10030	DO i = nxl, nxr
10031	DO j = nys, nyn
10032	DO k = nzb_do, nzt_do
10033	local_pf(i,j,k) = MERGE( ldsa_av(k,j,i), REAL( fill_value, KIND = wp ), &
10034	BTEST( wall_flags_0(k,j,i), 0 ) )
10035	ENDDO
10036	ENDDO
10037	ENDDO
10038	ENDIF
10039
10040	IF ( mode == 'xy' ) grid = 'zu'
10041
10042	CASE ( 'N_bin1', 'N_bin2', 'N_bin3', 'N_bin4', 'N_bin5', 'N_bin6', 'N_bin7', 'N_bin8', &
10043	'N_bin9', 'N_bin10' , 'N_bin11', 'N_bin12' )
10044	vari = TRIM( variable( 6:LEN( TRIM( variable ) ) - 3 ) )
10045
10046	IF ( vari == '1' ) ib = 1
10047	IF ( vari == '2' ) ib = 2
10048	IF ( vari == '3' ) ib = 3
10049	IF ( vari == '4' ) ib = 4
10050	IF ( vari == '5' ) ib = 5
10051	IF ( vari == '6' ) ib = 6
10052	IF ( vari == '7' ) ib = 7
10053	IF ( vari == '8' ) ib = 8
10054	IF ( vari == '9' ) ib = 9
10055	IF ( vari == '10' ) ib = 10
10056	IF ( vari == '11' ) ib = 11
10057	IF ( vari == '12' ) ib = 12
10058
10059	IF ( av == 0 ) THEN
10060	DO i = nxl, nxr
10061	DO j = nys, nyn
10062	DO k = nzb_do, nzt_do
10063	local_pf(i,j,k) = MERGE( aerosol_number(ib)%conc(k,j,i), REAL( fill_value, &
10064	KIND = wp ), BTEST( wall_flags_0(k,j,i), 0 ) )
10065	ENDDO
10066	ENDDO
10067	ENDDO
10068	ELSE
10069	DO i = nxl, nxr
10070	DO j = nys, nyn
10071	DO k = nzb_do, nzt_do
10072	local_pf(i,j,k) = MERGE( nbins_av(k,j,i,ib), REAL( fill_value, KIND = wp ), &
10073	BTEST( wall_flags_0(k,j,i), 0 ) )
10074	ENDDO
10075	ENDDO
10076	ENDDO
10077	ENDIF
10078
10079	IF ( mode == 'xy' ) grid = 'zu'
10080
10081	CASE ( 'Ntot' )
10082
10083	IF ( av == 0 ) THEN
10084	DO i = nxl, nxr
10085	DO j = nys, nyn
10086	DO k = nzb_do, nzt_do
10087	temp_bin = 0.0_wp
10088	DO ib = 1, nbins_aerosol
10089	temp_bin = temp_bin + aerosol_number(ib)%conc(k,j,i)
10090	ENDDO
10091	local_pf(i,j,k) = MERGE( temp_bin, REAL( fill_value, KIND = wp ), &
10092	BTEST( wall_flags_0(k,j,i), 0 ) )
10093	ENDDO
10094	ENDDO
10095	ENDDO
10096	ELSE
10097	DO i = nxl, nxr
10098	DO j = nys, nyn
10099	DO k = nzb_do, nzt_do
10100	local_pf(i,j,k) = MERGE( ntot_av(k,j,i), REAL( fill_value, KIND = wp ), &
10101	BTEST( wall_flags_0(k,j,i), 0 ) )
10102	ENDDO
10103	ENDDO
10104	ENDDO
10105	ENDIF
10106
10107	IF ( mode == 'xy' ) grid = 'zu'
10108
10109	CASE ( 'm_bin1', 'm_bin2', 'm_bin3', 'm_bin4', 'm_bin5', 'm_bin6', 'm_bin7', 'm_bin8', &
10110	'm_bin9', 'm_bin10' , 'm_bin11', 'm_bin12' )
10111	vari = TRIM( variable( 6:LEN( TRIM( variable ) ) - 3 ) )
10112
10113	IF ( vari == '1' ) ib = 1
10114	IF ( vari == '2' ) ib = 2
10115	IF ( vari == '3' ) ib = 3
10116	IF ( vari == '4' ) ib = 4
10117	IF ( vari == '5' ) ib = 5
10118	IF ( vari == '6' ) ib = 6
10119	IF ( vari == '7' ) ib = 7
10120	IF ( vari == '8' ) ib = 8
10121	IF ( vari == '9' ) ib = 9
10122	IF ( vari == '10' ) ib = 10
10123	IF ( vari == '11' ) ib = 11
10124	IF ( vari == '12' ) ib = 12
10125
10126	IF ( av == 0 ) THEN
10127	DO i = nxl, nxr
10128	DO j = nys, nyn
10129	DO k = nzb_do, nzt_do
10130	temp_bin = 0.0_wp
10131	DO ic = ib, ncomponents_mass * nbins_aerosol, nbins_aerosol
10132	temp_bin = temp_bin + aerosol_mass(ic)%conc(k,j,i)
10133	ENDDO
10134	local_pf(i,j,k) = MERGE( temp_bin, REAL( fill_value, KIND = wp ), &
10135	BTEST( wall_flags_0(k,j,i), 0 ) )
10136	ENDDO
10137	ENDDO
10138	ENDDO
10139	ELSE
10140	DO i = nxl, nxr
10141	DO j = nys, nyn
10142	DO k = nzb_do, nzt_do
10143	local_pf(i,j,k) = MERGE( mbins_av(k,j,i,ib), REAL( fill_value, KIND = wp ), &
10144	BTEST( wall_flags_0(k,j,i), 0 ) )
10145	ENDDO
10146	ENDDO
10147	ENDDO
10148	ENDIF
10149
10150	IF ( mode == 'xy' ) grid = 'zu'
10151
10152	CASE ( 'PM2.5' )
10153	IF ( av == 0 ) THEN
10154	DO i = nxl, nxr
10155	DO j = nys, nyn
10156	DO k = nzb_do, nzt_do
10157	temp_bin = 0.0_wp
10158	DO ib = 1, nbins_aerosol
10159	IF ( 2.0_wp * ra_dry(k,j,i,ib) <= 2.5E-6_wp ) THEN
10160	DO ic = ib, nbins_aerosol * ncc, nbins_aerosol
10161	temp_bin = temp_bin + aerosol_mass(ic)%conc(k,j,i)
10162	ENDDO
10163	ENDIF
10164	ENDDO
10165	local_pf(i,j,k) = MERGE( temp_bin, REAL( fill_value, KIND = wp ), &
10166	BTEST( wall_flags_0(k,j,i), 0 ) )
10167	ENDDO
10168	ENDDO
10169	ENDDO
10170	ELSE
10171	DO i = nxl, nxr
10172	DO j = nys, nyn
10173	DO k = nzb_do, nzt_do
10174	local_pf(i,j,k) = MERGE( pm25_av(k,j,i), REAL( fill_value, KIND = wp ), &
10175	BTEST( wall_flags_0(k,j,i), 0 ) )
10176	ENDDO
10177	ENDDO
10178	ENDDO
10179	ENDIF
10180
10181	IF ( mode == 'xy' ) grid = 'zu'
10182
10183	CASE ( 'PM10' )
10184	IF ( av == 0 ) THEN
10185	DO i = nxl, nxr
10186	DO j = nys, nyn
10187	DO k = nzb_do, nzt_do
10188	temp_bin = 0.0_wp
10189	DO ib = 1, nbins_aerosol
10190	IF ( 2.0_wp * ra_dry(k,j,i,ib) <= 10.0E-6_wp ) THEN
10191	DO ic = ib, nbins_aerosol * ncc, nbins_aerosol
10192	temp_bin = temp_bin + aerosol_mass(ic)%conc(k,j,i)
10193	ENDDO
10194	ENDIF
10195	ENDDO
10196	local_pf(i,j,k) = MERGE( temp_bin, REAL( fill_value, KIND = wp ), &
10197	BTEST( wall_flags_0(k,j,i), 0 ) )
10198	ENDDO
10199	ENDDO
10200	ENDDO
10201	ELSE
10202	DO i = nxl, nxr
10203	DO j = nys, nyn
10204	DO k = nzb_do, nzt_do
10205	local_pf(i,j,k) = MERGE( pm10_av(k,j,i), REAL( fill_value, KIND = wp ), &
10206	BTEST( wall_flags_0(k,j,i), 0 ) )
10207	ENDDO
10208	ENDDO
10209	ENDDO
10210	ENDIF
10211
10212	IF ( mode == 'xy' ) grid = 'zu'
10213
10214	CASE ( 's_BC', 's_DU', 's_H2O', 's_NH', 's_NO', 's_OC', 's_SO4', 's_SS' )
10215	vari = TRIM( variable( 3:LEN( TRIM( variable ) ) - 3 ) )
10216	IF ( is_used( prtcl, vari ) ) THEN
10217	found_index = get_index( prtcl, vari )
10218	IF ( av == 0 ) THEN
10219	DO i = nxl, nxr
10220	DO j = nys, nyn
10221	DO k = nzb_do, nzt_do
10222	temp_bin = 0.0_wp
10223	DO ic = ( found_index-1 ) * nbins_aerosol+1, found_index * nbins_aerosol
10224	temp_bin = temp_bin + aerosol_mass(ic)%conc(k,j,i)
10225	ENDDO
10226	local_pf(i,j,k) = MERGE( temp_bin, REAL( fill_value, KIND = wp ), &
10227	BTEST( wall_flags_0(k,j,i), 0 ) )
10228	ENDDO
10229	ENDDO
10230	ENDDO
10231	ELSE
10232	IF ( vari == 'BC' ) to_be_resorted => s_bc_av
10233	IF ( vari == 'DU' ) to_be_resorted => s_du_av
10234	IF ( vari == 'NH' ) to_be_resorted => s_nh_av
10235	IF ( vari == 'NO' ) to_be_resorted => s_no_av
10236	IF ( vari == 'OC' ) to_be_resorted => s_oc_av
10237	IF ( vari == 'SO4' ) to_be_resorted => s_so4_av
10238	IF ( vari == 'SS' ) to_be_resorted => s_ss_av
10239	DO i = nxl, nxr
10240	DO j = nys, nyn
10241	DO k = nzb_do, nzt_do
10242	local_pf(i,j,k) = MERGE( to_be_resorted(k,j,i), REAL( fill_value, &
10243	KIND = wp ), BTEST( wall_flags_0(k,j,i), 0 ) )
10244	ENDDO
10245	ENDDO
10246	ENDDO
10247	ENDIF
10248	ELSE
10249	local_pf = fill_value
10250	ENDIF
10251
10252	IF ( mode == 'xy' ) grid = 'zu'
10253
10254	CASE DEFAULT
10255	found = .FALSE.
10256	grid = 'none'
10257
10258	END SELECT
10259
10260	END SUBROUTINE salsa_data_output_2d
10261
10262	!------------------------------------------------------------------------------!
10263	!
10264	! Description:
10265	! ------------
10266	!> Subroutine defining 3D output variables
10267	!------------------------------------------------------------------------------!
10268	SUBROUTINE salsa_data_output_3d( av, variable, found, local_pf, nzb_do, nzt_do )
10269
10270	USE indices
10271
10272	USE kinds
10273
10274
10275	IMPLICIT NONE
10276
10277	CHARACTER(LEN=*), INTENT(in) :: variable !<
10278
10279	INTEGER(iwp) :: av !<
10280	INTEGER(iwp) :: found_index !< index of a chemical compound
10281	INTEGER(iwp) :: ib !< running index: size bins
10282	INTEGER(iwp) :: ic !< running index: mass bins
10283	INTEGER(iwp) :: i !<
10284	INTEGER(iwp) :: j !<
10285	INTEGER(iwp) :: k !<
10286	INTEGER(iwp) :: nzb_do !<
10287	INTEGER(iwp) :: nzt_do !<
10288
10289	LOGICAL :: found !<
10290
10291	REAL(wp) :: df !< For calculating LDSA: fraction of particles
10292	!< depositing in the alveolar (or tracheobronchial)
10293	!< region of the lung. Depends on the particle size
10294	REAL(wp) :: fill_value = -9999.0_wp !< value for the _FillValue attribute
10295	REAL(wp) :: mean_d !< Particle diameter in micrometres
10296	REAL(wp) :: nc !< Particle number concentration in units 1/cm**3
10297	REAL(wp) :: temp_bin !< temporary array for calculating output variables
10298
10299	REAL(sp), DIMENSION(nxl:nxr,nys:nyn,nzb_do:nzt_do) :: local_pf !< local
10300
10301	REAL(wp), DIMENSION(:,:,:), POINTER :: to_be_resorted !< pointer
10302
10303	found = .TRUE.
10304	temp_bin = 0.0_wp
10305
10306	SELECT CASE ( TRIM( variable ) )
10307
10308	CASE ( 'g_H2SO4', 'g_HNO3', 'g_NH3', 'g_OCNV', 'g_OCSV' )
10309	IF ( av == 0 ) THEN
10310	IF ( TRIM( variable ) == 'g_H2SO4') found_index = 1
10311	IF ( TRIM( variable ) == 'g_HNO3') found_index = 2
10312	IF ( TRIM( variable ) == 'g_NH3') found_index = 3
10313	IF ( TRIM( variable ) == 'g_OCNV') found_index = 4
10314	IF ( TRIM( variable ) == 'g_OCSV') found_index = 5
10315
10316	DO i = nxl, nxr
10317	DO j = nys, nyn
10318	DO k = nzb_do, nzt_do
10319	local_pf(i,j,k) = MERGE( salsa_gas(found_index)%conc(k,j,i), &
10320	REAL( fill_value, KIND = wp ), &
10321	BTEST( wall_flags_0(k,j,i), 0 ) )
10322	ENDDO
10323	ENDDO
10324	ENDDO
10325	ELSE
10326	IF ( TRIM( variable(3:) ) == 'H2SO4' ) to_be_resorted => g_h2so4_av
10327	IF ( TRIM( variable(3:) ) == 'HNO3' ) to_be_resorted => g_hno3_av
10328	IF ( TRIM( variable(3:) ) == 'NH3' ) to_be_resorted => g_nh3_av
10329	IF ( TRIM( variable(3:) ) == 'OCNV' ) to_be_resorted => g_ocnv_av
10330	IF ( TRIM( variable(3:) ) == 'OCSV' ) to_be_resorted => g_ocsv_av
10331	DO i = nxl, nxr
10332	DO j = nys, nyn
10333	DO k = nzb_do, nzt_do
10334	local_pf(i,j,k) = MERGE( to_be_resorted(k,j,i), REAL( fill_value, &
10335	KIND = wp ), BTEST( wall_flags_0(k,j,i), 0 ) )
10336	ENDDO
10337	ENDDO
10338	ENDDO
10339	ENDIF
10340
10341	CASE ( 'LDSA' )
10342	IF ( av == 0 ) THEN
10343	DO i = nxl, nxr
10344	DO j = nys, nyn
10345	DO k = nzb_do, nzt_do
10346	temp_bin = 0.0_wp
10347	DO ib = 1, nbins_aerosol
10348	!
10349	!-- Diameter in micrometres
10350	mean_d = 1.0E+6_wp * ra_dry(k,j,i,ib) * 2.0_wp
10351	!
10352	!-- Deposition factor: alveolar
10353	df = ( 0.01555_wp / mean_d ) * ( EXP( -0.416_wp * ( LOG( mean_d ) + &
10354	2.84_wp )*2 ) + 19.11_wp EXP( -0.482_wp * ( LOG( mean_d ) - &
10355	1.362_wp )**2 ) )
10356	!
10357	!-- Number concentration in 1/cm3
10358	nc = 1.0E-6_wp * aerosol_number(ib)%conc(k,j,i)
10359	!
10360	!-- Lung-deposited surface area LDSA (units mum2/cm3)
10361	temp_bin = temp_bin + pi * mean_d*2 df * nc
10362	ENDDO
10363	local_pf(i,j,k) = MERGE( temp_bin, REAL( fill_value, KIND = wp ), &
10364	BTEST( wall_flags_0(k,j,i), 0 ) )
10365	ENDDO
10366	ENDDO
10367	ENDDO
10368	ELSE
10369	DO i = nxl, nxr
10370	DO j = nys, nyn
10371	DO k = nzb_do, nzt_do
10372	local_pf(i,j,k) = MERGE( ldsa_av(k,j,i), REAL( fill_value, KIND = wp ), &
10373	BTEST( wall_flags_0(k,j,i), 0 ) )
10374	ENDDO
10375	ENDDO
10376	ENDDO
10377	ENDIF
10378
10379	CASE ( 'N_bin1', 'N_bin2', 'N_bin3', 'N_bin4', 'N_bin5', 'N_bin6', 'N_bin7', 'N_bin8', &
10380	'N_bin9', 'N_bin10', 'N_bin11', 'N_bin12' )
10381	IF ( TRIM( variable(6:) ) == '1' ) ib = 1
10382	IF ( TRIM( variable(6:) ) == '2' ) ib = 2
10383	IF ( TRIM( variable(6:) ) == '3' ) ib = 3
10384	IF ( TRIM( variable(6:) ) == '4' ) ib = 4
10385	IF ( TRIM( variable(6:) ) == '5' ) ib = 5
10386	IF ( TRIM( variable(6:) ) == '6' ) ib = 6
10387	IF ( TRIM( variable(6:) ) == '7' ) ib = 7
10388	IF ( TRIM( variable(6:) ) == '8' ) ib = 8
10389	IF ( TRIM( variable(6:) ) == '9' ) ib = 9
10390	IF ( TRIM( variable(6:) ) == '10' ) ib = 10
10391	IF ( TRIM( variable(6:) ) == '11' ) ib = 11
10392	IF ( TRIM( variable(6:) ) == '12' ) ib = 12
10393
10394	IF ( av == 0 ) THEN
10395	DO i = nxl, nxr
10396	DO j = nys, nyn
10397	DO k = nzb_do, nzt_do
10398	local_pf(i,j,k) = MERGE( aerosol_number(ib)%conc(k,j,i), REAL( fill_value, &
10399	KIND = wp ), BTEST( wall_flags_0(k,j,i), 0 ) )
10400	ENDDO
10401	ENDDO
10402	ENDDO
10403	ELSE
10404	DO i = nxl, nxr
10405	DO j = nys, nyn
10406	DO k = nzb_do, nzt_do
10407	local_pf(i,j,k) = MERGE( nbins_av(k,j,i,ib), REAL( fill_value, KIND = wp ), &
10408	BTEST( wall_flags_0(k,j,i), 0 ) )
10409	ENDDO
10410	ENDDO
10411	ENDDO
10412	ENDIF
10413
10414	CASE ( 'Ntot' )
10415	IF ( av == 0 ) THEN
10416	DO i = nxl, nxr
10417	DO j = nys, nyn
10418	DO k = nzb_do, nzt_do
10419	temp_bin = 0.0_wp
10420	DO ib = 1, nbins_aerosol
10421	temp_bin = temp_bin + aerosol_number(ib)%conc(k,j,i)
10422	ENDDO
10423	local_pf(i,j,k) = MERGE( temp_bin, REAL( fill_value, KIND = wp ), &
10424	BTEST( wall_flags_0(k,j,i), 0 ) )
10425	ENDDO
10426	ENDDO
10427	ENDDO
10428	ELSE
10429	DO i = nxl, nxr
10430	DO j = nys, nyn
10431	DO k = nzb_do, nzt_do
10432	local_pf(i,j,k) = MERGE( ntot_av(k,j,i), REAL( fill_value, KIND = wp ), &
10433	BTEST( wall_flags_0(k,j,i), 0 ) )
10434	ENDDO
10435	ENDDO
10436	ENDDO
10437	ENDIF
10438
10439	CASE ( 'm_bin1', 'm_bin2', 'm_bin3', 'm_bin4', 'm_bin5', 'm_bin6', 'm_bin7', 'm_bin8', &
10440	'm_bin9', 'm_bin10' , 'm_bin11', 'm_bin12' )
10441	IF ( TRIM( variable(6:) ) == '1' ) ib = 1
10442	IF ( TRIM( variable(6:) ) == '2' ) ib = 2
10443	IF ( TRIM( variable(6:) ) == '3' ) ib = 3
10444	IF ( TRIM( variable(6:) ) == '4' ) ib = 4
10445	IF ( TRIM( variable(6:) ) == '5' ) ib = 5
10446	IF ( TRIM( variable(6:) ) == '6' ) ib = 6
10447	IF ( TRIM( variable(6:) ) == '7' ) ib = 7
10448	IF ( TRIM( variable(6:) ) == '8' ) ib = 8
10449	IF ( TRIM( variable(6:) ) == '9' ) ib = 9
10450	IF ( TRIM( variable(6:) ) == '10' ) ib = 10
10451	IF ( TRIM( variable(6:) ) == '11' ) ib = 11
10452	IF ( TRIM( variable(6:) ) == '12' ) ib = 12
10453
10454	IF ( av == 0 ) THEN
10455	DO i = nxl, nxr
10456	DO j = nys, nyn
10457	DO k = nzb_do, nzt_do
10458	temp_bin = 0.0_wp
10459	DO ic = ib, ncomponents_mass * nbins_aerosol, nbins_aerosol
10460	temp_bin = temp_bin + aerosol_mass(ic)%conc(k,j,i)
10461	ENDDO
10462	local_pf(i,j,k) = MERGE( temp_bin, REAL( fill_value, KIND = wp ), &
10463	BTEST( wall_flags_0(k,j,i), 0 ) )
10464	ENDDO
10465	ENDDO
10466	ENDDO
10467	ELSE
10468	DO i = nxl, nxr
10469	DO j = nys, nyn
10470	DO k = nzb_do, nzt_do
10471	local_pf(i,j,k) = MERGE( mbins_av(k,j,i,ib), REAL( fill_value, KIND = wp ), &
10472	BTEST( wall_flags_0(k,j,i), 0 ) )
10473	ENDDO
10474	ENDDO
10475	ENDDO
10476	ENDIF
10477
10478	CASE ( 'PM2.5' )
10479	IF ( av == 0 ) THEN
10480	DO i = nxl, nxr
10481	DO j = nys, nyn
10482	DO k = nzb_do, nzt_do
10483	temp_bin = 0.0_wp
10484	DO ib = 1, nbins_aerosol
10485	IF ( 2.0_wp * ra_dry(k,j,i,ib) <= 2.5E-6_wp ) THEN
10486	DO ic = ib, nbins_aerosol * ncc, nbins_aerosol
10487	temp_bin = temp_bin + aerosol_mass(ic)%conc(k,j,i)
10488	ENDDO
10489	ENDIF
10490	ENDDO
10491	local_pf(i,j,k) = MERGE( temp_bin, REAL( fill_value, KIND = wp ), &
10492	BTEST( wall_flags_0(k,j,i), 0 ) )
10493	ENDDO
10494	ENDDO
10495	ENDDO
10496	ELSE
10497	DO i = nxl, nxr
10498	DO j = nys, nyn
10499	DO k = nzb_do, nzt_do
10500	local_pf(i,j,k) = MERGE( pm25_av(k,j,i), REAL( fill_value, KIND = wp ), &
10501	BTEST( wall_flags_0(k,j,i), 0 ) )
10502	ENDDO
10503	ENDDO
10504	ENDDO
10505	ENDIF
10506
10507	CASE ( 'PM10' )
10508	IF ( av == 0 ) THEN
10509	DO i = nxl, nxr
10510	DO j = nys, nyn
10511	DO k = nzb_do, nzt_do
10512	temp_bin = 0.0_wp
10513	DO ib = 1, nbins_aerosol
10514	IF ( 2.0_wp * ra_dry(k,j,i,ib) <= 10.0E-6_wp ) THEN
10515	DO ic = ib, nbins_aerosol * ncc, nbins_aerosol
10516	temp_bin = temp_bin + aerosol_mass(ic)%conc(k,j,i)
10517	ENDDO
10518	ENDIF
10519	ENDDO
10520	local_pf(i,j,k) = MERGE( temp_bin, REAL( fill_value, KIND = wp ), &
10521	BTEST( wall_flags_0(k,j,i), 0 ) )
10522	ENDDO
10523	ENDDO
10524	ENDDO
10525	ELSE
10526	DO i = nxl, nxr
10527	DO j = nys, nyn
10528	DO k = nzb_do, nzt_do
10529	local_pf(i,j,k) = MERGE( pm10_av(k,j,i), REAL( fill_value, KIND = wp ), &
10530	BTEST( wall_flags_0(k,j,i), 0 ) )
10531	ENDDO
10532	ENDDO
10533	ENDDO
10534	ENDIF
10535
10536	CASE ( 's_BC', 's_DU', 's_H2O', 's_NH', 's_NO', 's_OC', 's_SO4', 's_SS' )
10537	IF ( is_used( prtcl, TRIM( variable(3:) ) ) ) THEN
10538	found_index = get_index( prtcl, TRIM( variable(3:) ) )
10539	IF ( av == 0 ) THEN
10540	DO i = nxl, nxr
10541	DO j = nys, nyn
10542	DO k = nzb_do, nzt_do
10543	temp_bin = 0.0_wp
10544	DO ic = ( found_index-1 ) * nbins_aerosol + 1, found_index * nbins_aerosol
10545	temp_bin = temp_bin + aerosol_mass(ic)%conc(k,j,i)
10546	ENDDO
10547	local_pf(i,j,k) = MERGE( temp_bin, REAL( fill_value, KIND = wp ), &
10548	BTEST( wall_flags_0(k,j,i), 0 ) )
10549	ENDDO
10550	ENDDO
10551	ENDDO
10552	ELSE
10553	IF ( TRIM( variable(3:) ) == 'BC' ) to_be_resorted => s_bc_av
10554	IF ( TRIM( variable(3:) ) == 'DU' ) to_be_resorted => s_du_av
10555	IF ( TRIM( variable(3:) ) == 'NH' ) to_be_resorted => s_nh_av
10556	IF ( TRIM( variable(3:) ) == 'NO' ) to_be_resorted => s_no_av
10557	IF ( TRIM( variable(3:) ) == 'OC' ) to_be_resorted => s_oc_av
10558	IF ( TRIM( variable(3:) ) == 'SO4' ) to_be_resorted => s_so4_av
10559	IF ( TRIM( variable(3:) ) == 'SS' ) to_be_resorted => s_ss_av
10560	DO i = nxl, nxr
10561	DO j = nys, nyn
10562	DO k = nzb_do, nzt_do
10563	local_pf(i,j,k) = MERGE( to_be_resorted(k,j,i), REAL( fill_value, &
10564	KIND = wp ), BTEST( wall_flags_0(k,j,i), 0 ) )
10565	ENDDO
10566	ENDDO
10567	ENDDO
10568	ENDIF
10569	ENDIF
10570
10571	CASE DEFAULT
10572	found = .FALSE.
10573
10574	END SELECT
10575
10576	END SUBROUTINE salsa_data_output_3d
10577
10578	!------------------------------------------------------------------------------!
10579	!
10580	! Description:
10581	! ------------
10582	!> Subroutine defining mask output variables
10583	!------------------------------------------------------------------------------!
10584	SUBROUTINE salsa_data_output_mask( av, variable, found, local_pf )
10585
10586	USE arrays_3d, &
10587	ONLY: tend
10588
10589	USE control_parameters, &
10590	ONLY: mask_size_l, mask_surface, mid
10591
10592	USE surface_mod, &
10593	ONLY: get_topography_top_index_ji
10594
10595	IMPLICIT NONE
10596
10597	CHARACTER(LEN=5) :: grid !< flag to distinquish between staggered grid
10598	CHARACTER(LEN=*) :: variable !<
10599	CHARACTER(LEN=7) :: vari !< trimmed format of variable
10600
10601	INTEGER(iwp) :: av !<
10602	INTEGER(iwp) :: found_index !< index of a chemical compound
10603	INTEGER(iwp) :: ib !< loop index for aerosol size number bins
10604	INTEGER(iwp) :: ic !< loop index for chemical components
10605	INTEGER(iwp) :: i !< loop index in x-direction
10606	INTEGER(iwp) :: j !< loop index in y-direction
10607	INTEGER(iwp) :: k !< loop index in z-direction
10608	INTEGER(iwp) :: topo_top_ind !< k index of highest horizontal surface
10609
10610	LOGICAL :: found !<
10611	LOGICAL :: resorted !<
10612
10613	REAL(wp) :: df !< For calculating LDSA: fraction of particles
10614	!< depositing in the alveolar (or tracheobronchial)
10615	!< region of the lung. Depends on the particle size
10616	REAL(wp) :: mean_d !< Particle diameter in micrometres
10617	REAL(wp) :: nc !< Particle number concentration in units 1/cm**3
10618	REAL(wp) :: temp_bin !< temporary array for calculating output variables
10619
10620	REAL(wp), DIMENSION(mask_size_l(mid,1),mask_size_l(mid,2),mask_size_l(mid,3)) :: local_pf !<
10621
10622	REAL(wp), DIMENSION(:,:,:), POINTER :: to_be_resorted !< pointer
10623
10624	found = .TRUE.
10625	resorted = .FALSE.
10626	grid = 's'
10627	temp_bin = 0.0_wp
10628
10629	SELECT CASE ( TRIM( variable ) )
10630
10631	CASE ( 'g_H2SO4', 'g_HNO3', 'g_NH3', 'g_OCNV', 'g_OCSV' )
10632	vari = TRIM( variable )
10633	IF ( av == 0 ) THEN
10634	IF ( vari == 'g_H2SO4') to_be_resorted => salsa_gas(1)%conc
10635	IF ( vari == 'g_HNO3') to_be_resorted => salsa_gas(2)%conc
10636	IF ( vari == 'g_NH3') to_be_resorted => salsa_gas(3)%conc
10637	IF ( vari == 'g_OCNV') to_be_resorted => salsa_gas(4)%conc
10638	IF ( vari == 'g_OCSV') to_be_resorted => salsa_gas(5)%conc
10639	ELSE
10640	IF ( vari == 'g_H2SO4') to_be_resorted => g_h2so4_av
10641	IF ( vari == 'g_HNO3') to_be_resorted => g_hno3_av
10642	IF ( vari == 'g_NH3') to_be_resorted => g_nh3_av
10643	IF ( vari == 'g_OCNV') to_be_resorted => g_ocnv_av
10644	IF ( vari == 'g_OCSV') to_be_resorted => g_ocsv_av
10645	ENDIF
10646
10647	CASE ( 'LDSA' )
10648	IF ( av == 0 ) THEN
10649	DO i = nxl, nxr
10650	DO j = nys, nyn
10651	DO k = nzb, nz_do3d
10652	temp_bin = 0.0_wp
10653	DO ib = 1, nbins_aerosol
10654	!
10655	!-- Diameter in micrometres
10656	mean_d = 1.0E+6_wp * ra_dry(k,j,i,ib) * 2.0_wp
10657	!
10658	!-- Deposition factor: alveolar
10659	df = ( 0.01555_wp / mean_d ) * ( EXP( -0.416_wp * ( LOG( mean_d ) + &
10660	2.84_wp )*2 ) + 19.11_wp EXP( -0.482_wp * ( LOG( mean_d ) - &
10661	1.362_wp )**2 ) )
10662	!
10663	!-- Number concentration in 1/cm3
10664	nc = 1.0E-6_wp * aerosol_number(ib)%conc(k,j,i)
10665	!
10666	!-- Lung-deposited surface area LDSA (units mum2/cm3)
10667	temp_bin = temp_bin + pi * mean_d*2 df * nc
10668	ENDDO
10669	tend(k,j,i) = temp_bin
10670	ENDDO
10671	ENDDO
10672	ENDDO
10673	IF ( .NOT. mask_surface(mid) ) THEN
10674	DO i = 1, mask_size_l(mid,1)
10675	DO j = 1, mask_size_l(mid,2)
10676	DO k = 1, mask_size_l(mid,3)
10677	local_pf(i,j,k) = tend( mask_k(mid,k), mask_j(mid,j), mask_i(mid,i) )
10678	ENDDO
10679	ENDDO
10680	ENDDO
10681	ELSE
10682	DO i = 1, mask_size_l(mid,1)
10683	DO j = 1, mask_size_l(mid,2)
10684	topo_top_ind = get_topography_top_index_ji( mask_j(mid,j), mask_i(mid,i), &
10685	grid )
10686	DO k = 1, mask_size_l(mid,3)
10687	local_pf(i,j,k) = tend( MIN( topo_top_ind+mask_k(mid,k), nzt+1 ), &
10688	mask_j(mid,j), mask_i(mid,i) )
10689	ENDDO
10690	ENDDO
10691	ENDDO
10692	ENDIF
10693	resorted = .TRUE.
10694	ELSE
10695	to_be_resorted => ldsa_av
10696	ENDIF
10697
10698	CASE ( 'N_bin1', 'N_bin2', 'N_bin3', 'N_bin4', 'N_bin5', 'N_bin6', 'N_bin7', 'N_bin8', &
10699	'N_bin9', 'N_bin10' , 'N_bin11', 'N_bin12' )
10700	IF ( TRIM( variable(6:) ) == '1' ) ib = 1
10701	IF ( TRIM( variable(6:) ) == '2' ) ib = 2
10702	IF ( TRIM( variable(6:) ) == '3' ) ib = 3
10703	IF ( TRIM( variable(6:) ) == '4' ) ib = 4
10704	IF ( TRIM( variable(6:) ) == '5' ) ib = 5
10705	IF ( TRIM( variable(6:) ) == '6' ) ib = 6
10706	IF ( TRIM( variable(6:) ) == '7' ) ib = 7
10707	IF ( TRIM( variable(6:) ) == '8' ) ib = 8
10708	IF ( TRIM( variable(6:) ) == '9' ) ib = 9
10709	IF ( TRIM( variable(6:) ) == '10' ) ib = 10
10710	IF ( TRIM( variable(6:) ) == '11' ) ib = 11
10711	IF ( TRIM( variable(6:) ) == '12' ) ib = 12
10712
10713	IF ( av == 0 ) THEN
10714	IF ( .NOT. mask_surface(mid) ) THEN
10715	DO i = 1, mask_size_l(mid,1)
10716	DO j = 1, mask_size_l(mid,2)
10717	DO k = 1, mask_size_l(mid,3)
10718	local_pf(i,j,k) = aerosol_number(ib)%conc( mask_k(mid,k), mask_j(mid,j), &
10719	mask_i(mid,i) )
10720	ENDDO
10721	ENDDO
10722	ENDDO
10723	ELSE
10724	DO i = 1, mask_size_l(mid,1)
10725	DO j = 1, mask_size_l(mid,2)
10726	topo_top_ind = get_topography_top_index_ji( mask_j(mid,j), mask_i(mid,i), &
10727	grid )
10728	DO k = 1, mask_size_l(mid,3)
10729	local_pf(i,j,k) = aerosol_number(ib)%conc(MIN( topo_top_ind+mask_k(mid,k),&
10730	nzt+1 ), &
10731	mask_j(mid,j), mask_i(mid,i) )
10732	ENDDO
10733	ENDDO
10734	ENDDO
10735	ENDIF
10736	resorted = .TRUE.
10737	ELSE
10738	to_be_resorted => nbins_av(:,:,:,ib)
10739	ENDIF
10740
10741	CASE ( 'Ntot' )
10742	IF ( av == 0 ) THEN
10743	DO i = nxl, nxr
10744	DO j = nys, nyn
10745	DO k = nzb, nz_do3d
10746	temp_bin = 0.0_wp
10747	DO ib = 1, nbins_aerosol
10748	temp_bin = temp_bin + aerosol_number(ib)%conc(k,j,i)
10749	ENDDO
10750	tend(k,j,i) = temp_bin
10751	ENDDO
10752	ENDDO
10753	ENDDO
10754	IF ( .NOT. mask_surface(mid) ) THEN
10755	DO i = 1, mask_size_l(mid,1)
10756	DO j = 1, mask_size_l(mid,2)
10757	DO k = 1, mask_size_l(mid,3)
10758	local_pf(i,j,k) = tend( mask_k(mid,k), mask_j(mid,j), mask_i(mid,i) )
10759	ENDDO
10760	ENDDO
10761	ENDDO
10762	ELSE
10763	DO i = 1, mask_size_l(mid,1)
10764	DO j = 1, mask_size_l(mid,2)
10765	topo_top_ind = get_topography_top_index_ji( mask_j(mid,j), mask_i(mid,i), &
10766	grid )
10767	DO k = 1, mask_size_l(mid,3)
10768	local_pf(i,j,k) = tend( MIN( topo_top_ind+mask_k(mid,k), nzt+1 ), &
10769	mask_j(mid,j), mask_i(mid,i) )
10770	ENDDO
10771	ENDDO
10772	ENDDO
10773	ENDIF
10774	resorted = .TRUE.
10775	ELSE
10776	to_be_resorted => ntot_av
10777	ENDIF
10778
10779	CASE ( 'm_bin1', 'm_bin2', 'm_bin3', 'm_bin4', 'm_bin5', 'm_bin6', 'm_bin7', 'm_bin8', &
10780	'm_bin9', 'm_bin10', 'm_bin11', 'm_bin12' )
10781	IF ( TRIM( variable(6:) ) == '1' ) ib = 1
10782	IF ( TRIM( variable(6:) ) == '2' ) ib = 2
10783	IF ( TRIM( variable(6:) ) == '3' ) ib = 3
10784	IF ( TRIM( variable(6:) ) == '4' ) ib = 4
10785	IF ( TRIM( variable(6:) ) == '5' ) ib = 5
10786	IF ( TRIM( variable(6:) ) == '6' ) ib = 6
10787	IF ( TRIM( variable(6:) ) == '7' ) ib = 7
10788	IF ( TRIM( variable(6:) ) == '8' ) ib = 8
10789	IF ( TRIM( variable(6:) ) == '9' ) ib = 9
10790	IF ( TRIM( variable(6:) ) == '10' ) ib = 10
10791	IF ( TRIM( variable(6:) ) == '11' ) ib = 11
10792	IF ( TRIM( variable(6:) ) == '12' ) ib = 12
10793
10794	IF ( av == 0 ) THEN
10795	DO i = nxl, nxr
10796	DO j = nys, nyn
10797	DO k = nzb, nz_do3d
10798	temp_bin = 0.0_wp
10799	DO ic = ib, ncomponents_mass * nbins_aerosol, nbins_aerosol
10800	temp_bin = temp_bin + aerosol_mass(ic)%conc(k,j,i)
10801	ENDDO
10802	tend(k,j,i) = temp_bin
10803	ENDDO
10804	ENDDO
10805	ENDDO
10806	IF ( .NOT. mask_surface(mid) ) THEN
10807	DO i = 1, mask_size_l(mid,1)
10808	DO j = 1, mask_size_l(mid,2)
10809	DO k = 1, mask_size_l(mid,3)
10810	local_pf(i,j,k) = tend( mask_k(mid,k), mask_j(mid,j), mask_i(mid,i) )
10811	ENDDO
10812	ENDDO
10813	ENDDO
10814	ELSE
10815	DO i = 1, mask_size_l(mid,1)
10816	DO j = 1, mask_size_l(mid,2)
10817	topo_top_ind = get_topography_top_index_ji( mask_j(mid,j), mask_i(mid,i), &
10818	grid )
10819	DO k = 1, mask_size_l(mid,3)
10820	local_pf(i,j,k) = tend( MIN( topo_top_ind+mask_k(mid,k), nzt+1 ), &
10821	mask_j(mid,j), mask_i(mid,i) )
10822	ENDDO
10823	ENDDO
10824	ENDDO
10825	ENDIF
10826	resorted = .TRUE.
10827	ELSE
10828	to_be_resorted => mbins_av(:,:,:,ib)
10829	ENDIF
10830
10831	CASE ( 'PM2.5' )
10832	IF ( av == 0 ) THEN
10833	DO i = nxl, nxr
10834	DO j = nys, nyn
10835	DO k = nzb, nz_do3d
10836	temp_bin = 0.0_wp
10837	DO ib = 1, nbins_aerosol
10838	IF ( 2.0_wp * ra_dry(k,j,i,ib) <= 2.5E-6_wp ) THEN
10839	DO ic = ib, nbins_aerosol * ncc, nbins_aerosol
10840	temp_bin = temp_bin + aerosol_mass(ic)%conc(k,j,i)
10841	ENDDO
10842	ENDIF
10843	ENDDO
10844	tend(k,j,i) = temp_bin
10845	ENDDO
10846	ENDDO
10847	ENDDO
10848	IF ( .NOT. mask_surface(mid) ) THEN
10849	DO i = 1, mask_size_l(mid,1)
10850	DO j = 1, mask_size_l(mid,2)
10851	DO k = 1, mask_size_l(mid,3)
10852	local_pf(i,j,k) = tend( mask_k(mid,k), mask_j(mid,j), mask_i(mid,i) )
10853	ENDDO
10854	ENDDO
10855	ENDDO
10856	ELSE
10857	DO i = 1, mask_size_l(mid,1)
10858	DO j = 1, mask_size_l(mid,2)
10859	topo_top_ind = get_topography_top_index_ji( mask_j(mid,j), mask_i(mid,i), &
10860	grid )
10861	DO k = 1, mask_size_l(mid,3)
10862	local_pf(i,j,k) = tend( MIN( topo_top_ind+mask_k(mid,k), nzt+1 ), &
10863	mask_j(mid,j), mask_i(mid,i) )
10864	ENDDO
10865	ENDDO
10866	ENDDO
10867	ENDIF
10868	resorted = .TRUE.
10869	ELSE
10870	to_be_resorted => pm25_av
10871	ENDIF
10872
10873	CASE ( 'PM10' )
10874	IF ( av == 0 ) THEN
10875	DO i = nxl, nxr
10876	DO j = nys, nyn
10877	DO k = nzb, nz_do3d
10878	temp_bin = 0.0_wp
10879	DO ib = 1, nbins_aerosol
10880	IF ( 2.0_wp * ra_dry(k,j,i,ib) <= 10.0E-6_wp ) THEN
10881	DO ic = ib, nbins_aerosol * ncc, nbins_aerosol
10882	temp_bin = temp_bin + aerosol_mass(ic)%conc(k,j,i)
10883	ENDDO
10884	ENDIF
10885	ENDDO
10886	tend(k,j,i) = temp_bin
10887	ENDDO
10888	ENDDO
10889	ENDDO
10890	IF ( .NOT. mask_surface(mid) ) THEN
10891	DO i = 1, mask_size_l(mid,1)
10892	DO j = 1, mask_size_l(mid,2)
10893	DO k = 1, mask_size_l(mid,3)
10894	local_pf(i,j,k) = tend( mask_k(mid,k), mask_j(mid,j), mask_i(mid,i) )
10895	ENDDO
10896	ENDDO
10897	ENDDO
10898	ELSE
10899	DO i = 1, mask_size_l(mid,1)
10900	DO j = 1, mask_size_l(mid,2)
10901	topo_top_ind = get_topography_top_index_ji( mask_j(mid,j), mask_i(mid,i), &
10902	grid )
10903	DO k = 1, mask_size_l(mid,3)
10904	local_pf(i,j,k) = tend( MIN( topo_top_ind+mask_k(mid,k), nzt+1 ), &
10905	mask_j(mid,j), mask_i(mid,i) )
10906	ENDDO
10907	ENDDO
10908	ENDDO
10909	ENDIF
10910	resorted = .TRUE.
10911	ELSE
10912	to_be_resorted => pm10_av
10913	ENDIF
10914
10915	CASE ( 's_BC', 's_DU', 's_NH', 's_NO', 's_OC', 's_SO4', 's_SS' )
10916	IF ( av == 0 ) THEN
10917	IF ( is_used( prtcl, TRIM( variable(3:) ) ) ) THEN
10918	found_index = get_index( prtcl, TRIM( variable(3:) ) )
10919	DO i = nxl, nxr
10920	DO j = nys, nyn
10921	DO k = nzb, nz_do3d
10922	temp_bin = 0.0_wp
10923	DO ic = ( found_index-1 ) * nbins_aerosol + 1, found_index * nbins_aerosol
10924	temp_bin = temp_bin + aerosol_mass(ic)%conc(k,j,i)
10925	ENDDO
10926	tend(k,j,i) = temp_bin
10927	ENDDO
10928	ENDDO
10929	ENDDO
10930	ELSE
10931	tend = 0.0_wp
10932	ENDIF
10933	IF ( .NOT. mask_surface(mid) ) THEN
10934	DO i = 1, mask_size_l(mid,1)
10935	DO j = 1, mask_size_l(mid,2)
10936	DO k = 1, mask_size_l(mid,3)
10937	local_pf(i,j,k) = tend( mask_k(mid,k), mask_j(mid,j), mask_i(mid,i) )
10938	ENDDO
10939	ENDDO
10940	ENDDO
10941	ELSE
10942	DO i = 1, mask_size_l(mid,1)
10943	DO j = 1, mask_size_l(mid,2)
10944	topo_top_ind = get_topography_top_index_ji( mask_j(mid,j), mask_i(mid,i), &
10945	grid )
10946	DO k = 1, mask_size_l(mid,3)
10947	local_pf(i,j,k) = tend( MIN( topo_top_ind+mask_k(mid,k), nzt+1 ), &
10948	mask_j(mid,j), mask_i(mid,i) )
10949	ENDDO
10950	ENDDO
10951	ENDDO
10952	ENDIF
10953	resorted = .TRUE.
10954	ELSE
10955	IF ( TRIM( variable(3:) ) == 'BC' ) to_be_resorted => s_bc_av
10956	IF ( TRIM( variable(3:) ) == 'DU' ) to_be_resorted => s_du_av
10957	IF ( TRIM( variable(3:) ) == 'NH' ) to_be_resorted => s_nh_av
10958	IF ( TRIM( variable(3:) ) == 'NO' ) to_be_resorted => s_no_av
10959	IF ( TRIM( variable(3:) ) == 'OC' ) to_be_resorted => s_oc_av
10960	IF ( TRIM( variable(3:) ) == 'SO4' ) to_be_resorted => s_so4_av
10961	IF ( TRIM( variable(3:) ) == 'SS' ) to_be_resorted => s_ss_av
10962	ENDIF
10963
10964	CASE DEFAULT
10965	found = .FALSE.
10966
10967	END SELECT
10968
10969	IF ( .NOT. resorted ) THEN
10970	IF ( .NOT. mask_surface(mid) ) THEN
10971	!
10972	!-- Default masked output
10973	DO i = 1, mask_size_l(mid,1)
10974	DO j = 1, mask_size_l(mid,2)
10975	DO k = 1, mask_size_l(mid,3)
10976	local_pf(i,j,k) = to_be_resorted( mask_k(mid,k), mask_j(mid,j),mask_i(mid,i) )
10977	ENDDO
10978	ENDDO
10979	ENDDO
10980	ELSE
10981	!
10982	!-- Terrain-following masked output
10983	DO i = 1, mask_size_l(mid,1)
10984	DO j = 1, mask_size_l(mid,2)
10985	!
10986	!-- Get k index of highest horizontal surface
10987	topo_top_ind = get_topography_top_index_ji( mask_j(mid,j), mask_i(mid,i), grid )
10988	!
10989	!-- Save output array
10990	DO k = 1, mask_size_l(mid,3)
10991	local_pf(i,j,k) = to_be_resorted( MIN( topo_top_ind+mask_k(mid,k), nzt+1 ), &
10992	mask_j(mid,j), mask_i(mid,i) )
10993	ENDDO
10994	ENDDO
10995	ENDDO
10996	ENDIF
10997	ENDIF
10998
10999	END SUBROUTINE salsa_data_output_mask
11000
11001	END MODULE salsa_mod

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

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |