Home

Context Navigation

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

Last change on this file since 4417 was 4417, checked in by monakurppa, 5 years ago
document previous changes
Property svn:keywords set to `Id`
File size: 601.4 KB

Line
1	!> @file salsa_mod.f90
2	!--------------------------------------------------------------------------------!
3	! This file is part of PALM-4U.
4	!
5	! PALM-4U is free software: you can redistribute it and/or modify it under the
6	! terms of the GNU General Public License as published by the Free Software
7	! Foundation, either version 3 of the License, or (at your option) any later
8	! version.
9	!
10	! PALM-4U is distributed in the hope that it will be useful, but WITHOUT ANY
11	! WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
12	! A PARTICULAR PURPOSE. See the GNU General Public License for more details.
13	!
14	! You should have received a copy of the GNU General Public License along with
15	! PALM. If not, see <http://www.gnu.org/licenses/>.
16	!
17	! Copyright 2018-2019 University of Helsinki
18	! Copyright 1997-2020 Leibniz Universitaet Hannover
19	!--------------------------------------------------------------------------------!
20	!
21	! Current revisions:
22	! -----------------
23	!
24	!
25	! Former revisions:
26	! -----------------
27	! $Id: salsa_mod.f90 4417 2020-02-20 19:19:33Z monakurppa $
28	! Bug fixes and reformatting for the restart data and averaged data output
29	! - add missing arrays (averaged data output) in salsa_wrd_local and
30	! salsa_rrd_local
31	! - set write_binary_salsa and read_restart_data_salsa to .T. by default
32	! - restructure the average arrays for gases and total mass concentrations of
33	! chemical components: set to 4d arrays instead of separate arrays
34	! - add allocation checks for averaged data output arrays
35	!
36	! 4416 2020-02-20 17:53:57Z monakurppa
37	! Time index error in salsa_emission_setup
38	!
39	! 4380 2020-01-17 23:39:51Z monakurppa
40	! - Error in saving the surface fluxes in an array that is applied in the
41	! deposition scheme
42	! - Corrections in the header: aerosol bin diameters and lower bin limits not
43	! printed correctly
44	!
45	! 4364 2020-01-08 02:12:31Z monakurppa
46	! Set time coordinate in the input data relative to origin_time rather than to
47	! 00:00:00 UTC
48	!
49	! 4360 2020-01-07 11:25:50Z suehring
50	! Introduction of wall_flags_total_0, which currently sets bits based on static
51	! topography information used in wall_flags_static_0
52	!
53	! 4342 2019-12-16 13:49:14Z Giersch
54	! cdc replaced by canopy_drag_coeff
55	!
56	! 4329 2019-12-10 15:46:36Z motisi
57	! Renamed wall_flags_0 to wall_flags_static_0
58	!
59	! 4315 2019-12-02 09:20:07Z monakurppa
60	! Add an additional check for the time dimension PIDS_SALSA in
61	! salsa_emission_setup and correct some error message identifiers.
62	!
63	! 4298 2019-11-21 15:59:16Z suehring
64	! Bugfix, close netcdf input files after reading
65	!
66	! 4295 2019-11-14 06:15:31Z monakurppa
67	!
68	!
69	! 4280 2019-10-29 14:34:15Z monakurppa
70	! Corrected a bug in boundary conditions and fac_dt in offline nesting
71	!
72	! 4273 2019-10-24 13:40:54Z monakurppa
73	! - Rename nest_salsa to nesting_salsa
74	! - Correct some errors in boundary condition flags
75	! - Add a check for not trying to output gas concentrations in salsa if the
76	! chemistry module is applied
77	! - Set the default value of nesting_salsa and nesting_offline_salsa to .TRUE.
78	!
79	! 4272 2019-10-23 15:18:57Z schwenkel
80	! Further modularization of boundary conditions: moved boundary conditions to
81	! respective modules
82	!
83	! 4270 2019-10-23 10:46:20Z monakurppa
84	! - Implement offline nesting for salsa
85	! - Alphabetic ordering for module interfaces
86	! - Remove init_aerosol_type and init_gases_type from salsa_parin and define them
87	! based on the initializing_actions
88	! - parameter definition removed from "season" and "season_z01" is added to parin
89	! - bugfix in application of index_hh after implementing the new
90	! palm_date_time_mod
91	! - Reformat salsa emission data with LOD=2: size distribution given for each
92	! emission category
93	!
94	! 4268 2019-10-17 11:29:38Z schwenkel
95	! Moving module specific boundary conditions from time_integration to module
96	!
97	! 4256 2019-10-07 10:08:52Z monakurppa
98	! Document previous changes: use global variables nx, ny and nz in salsa_header
99	!
100	! 4227 2019-09-10 18:04:34Z gronemeier
101	! implement new palm_date_time_mod
102	!
103	! 4226 2019-09-10 17:03:24Z suehring
104	! Netcdf input routine for dimension length renamed
105	!
106	! 4182 2019-08-22 15:20:23Z scharf
107	! Corrected "Former revisions" section
108	!
109	! 4167 2019-08-16 11:01:48Z suehring
110	! Changed behaviour of masked output over surface to follow terrain and ignore
111	! buildings (J.Resler, T.Gronemeier)
112	!
113	! 4131 2019-08-02 11:06:18Z monakurppa
114	! - Add "salsa_" before each salsa output variable
115	! - Add a possibility to output the number (salsa_N_UFP) and mass concentration
116	! (salsa_PM0.1) of ultrafine particles, i.e. particles with a diameter smaller
117	! than 100 nm
118	! - Implement aerosol emission mode "parameterized" which is based on the street
119	! type (similar to the chemistry module).
120	! - Remove unnecessary nucleation subroutines.
121	! - Add the z-dimension for gaseous emissions to correspond the implementation
122	! in the chemistry module
123	!
124	! 4118 2019-07-25 16:11:45Z suehring
125	! - When Dirichlet condition is applied in decycling, the boundary conditions are
126	! only set at the ghost points and not at the prognostic grid points as done
127	! before
128	! - Rename decycle_ns/lr to decycle_salsa_ns/lr and decycle_method to
129	! decycle_method_salsa
130	! - Allocation and initialization of special advection flags salsa_advc_flags_s
131	! used for salsa. These are exclusively used for salsa variables to
132	! distinguish from the usually-used flags which might be different when
133	! decycling is applied in combination with cyclic boundary conditions.
134	! Moreover, salsa_advc_flags_s considers extended zones around buildings where
135	! the first-order upwind scheme is applied for the horizontal advection terms.
136	! This is done to overcome high concentration peaks due to stationary numerical
137	! oscillations caused by horizontal advection discretization.
138	!
139	! 4117 2019-07-25 08:54:02Z monakurppa
140	! Pass integer flag array as well as boundary flags to WS scalar advection
141	! routine
142	!
143	! 4109 2019-07-22 17:00:34Z suehring
144	! Slightly revise setting of boundary conditions at horizontal walls, use
145	! data-structure offset index instead of pre-calculate it for each facing
146	!
147	! 4079 2019-07-09 18:04:41Z suehring
148	! Application of monotonic flux limiter for the vertical scalar advection
149	! up to the topography top (only for the cache-optimized version at the
150	! moment).
151	!
152	! 4069 2019-07-01 14:05:51Z Giersch
153	! Masked output running index mid has been introduced as a local variable to
154	! avoid runtime error (Loop variable has been modified) in time_integration
155	!
156	! 4058 2019-06-27 15:25:42Z knoop
157	! Bugfix: to_be_resorted was uninitialized in case of s_H2O in 3d_data_averaging
158	!
159	! 4012 2019-05-31 15:19:05Z monakurppa
160	! Merge salsa branch to trunk. List of changes:
161	! - Error corrected in distr_update that resulted in the aerosol number size
162	! distribution not converging if the concentration was nclim.
163	! - Added a separate output for aerosol liquid water (s_H2O)
164	! - aerosol processes for a size bin are now calculated only if the aerosol
165	! number of concentration of that bin is > 2*nclim
166	! - An initialisation error in the subroutine "deposition" corrected and the
167	! subroutine reformatted.
168	! - stuff from salsa_util_mod.f90 moved into salsa_mod.f90
169	! - calls for closing the netcdf input files added
170	!
171	! 3956 2019-05-07 12:32:52Z monakurppa
172	! - Conceptual bug in depo_surf correct for urban and land surface model
173	! - Subroutine salsa_tendency_ij optimized.
174	! - Interfaces salsa_non_advective_processes and salsa_exchange_horiz_bounds
175	! created. These are now called in module_interface.
176	! salsa_exchange_horiz_bounds after calling salsa_driver only when needed
177	! (i.e. every dt_salsa).
178	!
179	! 3924 2019-04-23 09:33:06Z monakurppa
180	! Correct a bug introduced by the previous update.
181	!
182	! 3899 2019-04-16 14:05:27Z monakurppa
183	! - remove unnecessary error / location messages
184	! - corrected some error message numbers
185	! - allocate source arrays only if emissions or dry deposition is applied.
186	!
187	! 3885 2019-04-11 11:29:34Z kanani
188	! Changes related to global restructuring of location messages and introduction
189	! of additional debug messages
190	!
191	! 3876 2019-04-08 18:41:49Z knoop
192	! Introduced salsa_actions module interface
193	!
194	! 3871 2019-04-08 14:38:39Z knoop
195	! Major changes in formatting, performance and data input structure (see branch
196	! the history for details)
197	! - Time-dependent emissions enabled: lod=1 for yearly PM emissions that are
198	! normalised depending on the time, and lod=2 for preprocessed emissions
199	! (similar to the chemistry module).
200	! - Additionally, 'uniform' emissions allowed. This emission is set constant on
201	! all horisontal upward facing surfaces and it is created based on parameters
202	! surface_aerosol_flux, aerosol_flux_dpg/sigmag/mass_fracs_a/mass_fracs_b.
203	! - All emissions are now implemented as surface fluxes! No 3D sources anymore.
204	! - Update the emission information by calling salsa_emission_update if
205	! skip_time_do_salsa >= time_since_reference_point and
206	! next_aero_emission_update <= time_since_reference_point
207	! - Aerosol background concentrations read from PIDS_DYNAMIC. The vertical grid
208	! must match the one applied in the model.
209	! - Gas emissions and background concentrations can be also read in in salsa_mod
210	! if the chemistry module is not applied.
211	! - In deposition, information on the land use type can be now imported from
212	! the land use model
213	! - Use SI units in PARIN, i.e. n_lognorm given in #/m3 and dpg in metres.
214	! - Apply 100 character line limit
215	! - Change all variable names from capital to lowercase letter
216	! - Change real exponents to integer if possible. If not, precalculate the value
217	! value of exponent
218	! - Rename in1a to start_subrange_1a, fn2a to end_subrange_1a etc.
219	! - Rename nbins --> nbins_aerosol, ncc_tot --> ncomponents_mass and ngast -->
220	! ngases_salsa
221	! - Rename ibc to index_bc, idu to index_du etc.
222	! - Renamed loop indices b, c and sg to ib, ic and ig
223	! - run_salsa subroutine removed
224	! - Corrected a bud in salsa_driver: falsely applied ino instead of inh
225	! - Call salsa_tendency within salsa_prognostic_equations which is called in
226	! module_interface_mod instead of prognostic_equations_mod
227	! - Removed tailing white spaces and unused variables
228	! - Change error message to start by PA instead of SA
229	!
230	! 3833 2019-03-28 15:04:04Z forkel
231	! added USE chem_gasphase_mod for nvar, nspec and spc_names
232	!
233	! 3787 2019-03-07 08:43:54Z raasch
234	! unused variables removed
235	!
236	! 3780 2019-03-05 11:19:45Z forkel
237	! unused variable for file index removed from rrd-subroutines parameter list
238	!
239	! 3685 2019-01-21 01:02:11Z knoop
240	! Some interface calls moved to module_interface + cleanup
241	!
242	! 3655 2019-01-07 16:51:22Z knoop
243	! Implementation of the PALM module interface
244	! 3412 2018-10-24 07:25:57Z monakurppa
245	!
246	! Authors:
247	! --------
248	! @author Mona Kurppa (University of Helsinki)
249	!
250	!
251	! Description:
252	! ------------
253	!> Sectional aerosol module for large scale applications SALSA
254	!> (Kokkola et al., 2008, ACP 8, 2469-2483). Solves the aerosol number and mass
255	!> concentration as well as chemical composition. Includes aerosol dynamic
256	!> processes: nucleation, condensation/evaporation of vapours, coagulation and
257	!> deposition on tree leaves, ground and roofs.
258	!> Implementation is based on formulations implemented in UCLALES-SALSA except
259	!> for deposition which is based on parametrisations by Zhang et al. (2001,
260	!> Atmos. Environ. 35, 549-560) or Petroff&Zhang (2010, Geosci. Model Dev. 3,
261	!> 753-769)
262	!>
263	!> @todo Apply information from emission_stack_height to lift emission sources
264	!> @todo Allow insoluble emissions
265	!------------------------------------------------------------------------------!
266	MODULE salsa_mod
267
268	USE basic_constants_and_equations_mod, &
269	ONLY: c_p, g, p_0, pi, r_d
270
271	USE chem_gasphase_mod, &
272	ONLY: nspec, nvar, spc_names
273
274	USE chem_modules, &
275	ONLY: call_chem_at_all_substeps, chem_gasphase_on, chem_species
276
277	USE control_parameters, &
278	ONLY: air_chemistry, bc_dirichlet_l, bc_dirichlet_n, bc_dirichlet_r, bc_dirichlet_s, &
279	bc_lr, bc_lr_cyc, bc_ns, bc_ns_cyc, bc_radiation_l, bc_radiation_n, bc_radiation_r, &
280	bc_radiation_s, coupling_char, debug_output, dt_3d, intermediate_timestep_count, &
281	intermediate_timestep_count_max, land_surface, max_pr_salsa, message_string, &
282	monotonic_limiter_z, plant_canopy, pt_surface, salsa, scalar_advec, &
283	surface_pressure, time_since_reference_point, timestep_scheme, tsc, urban_surface, &
284	ws_scheme_sca
285
286	USE indices, &
287	ONLY: nbgp, nx, nxl, nxlg, nxr, nxrg, ny, nyn, nyng, nys, nysg, nzb, nz, nzt, &
288	wall_flags_total_0
289
290	USE kinds
291
292	USE netcdf_data_input_mod, &
293	ONLY: chem_emis_att_type, chem_emis_val_type
294
295	USE pegrid
296
297	USE statistics, &
298	ONLY: sums_salsa_ws_l
299
300	IMPLICIT NONE
301	!
302	!-- SALSA constants:
303	!
304	!-- Local constants:
305	INTEGER(iwp), PARAMETER :: luc_urban = 15 !< default landuse type for urban
306	INTEGER(iwp), PARAMETER :: ngases_salsa = 5 !< total number of gaseous tracers:
307	!< 1 = H2SO4, 2 = HNO3, 3 = NH3, 4 = OCNV
308	!< (non-volatile OC), 5 = OCSV (semi-volatile)
309	INTEGER(iwp), PARAMETER :: nmod = 7 !< number of modes for initialising the aerosol size distribution
310	INTEGER(iwp), PARAMETER :: nreg = 2 !< Number of main size subranges
311	INTEGER(iwp), PARAMETER :: maxspec = 7 !< Max. number of aerosol species
312
313
314	REAL(wp), PARAMETER :: fill_value = -9999.0_wp !< value for the _FillValue attribute
315	!
316	!-- Universal constants
317	REAL(wp), PARAMETER :: abo = 1.380662E-23_wp !< Boltzmann constant (J/K)
318	REAL(wp), PARAMETER :: alv = 2.260E+6_wp !< latent heat for H2O vaporisation (J/kg)
319	REAL(wp), PARAMETER :: alv_d_rv = 4896.96865_wp !< alv / rv
320	REAL(wp), PARAMETER :: am_airmol = 4.8096E-26_wp !< Average mass of an air molecule (Jacobson 2005, Eq.2.3)
321	REAL(wp), PARAMETER :: api6 = 0.5235988_wp !< pi / 6
322	REAL(wp), PARAMETER :: argas = 8.314409_wp !< Gas constant (J/(mol K))
323	REAL(wp), PARAMETER :: argas_d_cpd = 8.281283865E-3_wp !< argas per cpd
324	REAL(wp), PARAMETER :: avo = 6.02214E+23_wp !< Avogadro constant (1/mol)
325	REAL(wp), PARAMETER :: d_sa = 5.539376964394570E-10_wp !< diameter of condensing H2SO4 molecule (m)
326	REAL(wp), PARAMETER :: for_ppm_to_nconc = 7.243016311E+16_wp !< ppm * avo / R (K/(Pa*m3))
327	REAL(wp), PARAMETER :: epsoc = 0.15_wp !< water uptake of organic material
328	REAL(wp), PARAMETER :: mclim = 1.0E-23_wp !< mass concentration min limit (kg/m3)
329	REAL(wp), PARAMETER :: n3 = 158.79_wp !< Number of H2SO4 molecules in 3 nm cluster if d_sa=5.54e-10m
330	REAL(wp), PARAMETER :: nclim = 1.0_wp !< number concentration min limit (#/m3)
331	REAL(wp), PARAMETER :: surfw0 = 0.073_wp !< surface tension of water at 293 K (J/m2)
332	!
333	!-- Molar masses in kg/mol
334	REAL(wp), PARAMETER :: ambc = 12.0E-3_wp !< black carbon (BC)
335	REAL(wp), PARAMETER :: amdair = 28.970E-3_wp !< dry air
336	REAL(wp), PARAMETER :: amdu = 100.0E-3_wp !< mineral dust
337	REAL(wp), PARAMETER :: amh2o = 18.0154E-3_wp !< H2O
338	REAL(wp), PARAMETER :: amh2so4 = 98.06E-3_wp !< H2SO4
339	REAL(wp), PARAMETER :: amhno3 = 63.01E-3_wp !< HNO3
340	REAL(wp), PARAMETER :: amn2o = 44.013E-3_wp !< N2O
341	REAL(wp), PARAMETER :: amnh3 = 17.031E-3_wp !< NH3
342	REAL(wp), PARAMETER :: amo2 = 31.9988E-3_wp !< O2
343	REAL(wp), PARAMETER :: amo3 = 47.998E-3_wp !< O3
344	REAL(wp), PARAMETER :: amoc = 150.0E-3_wp !< organic carbon (OC)
345	REAL(wp), PARAMETER :: amss = 58.44E-3_wp !< sea salt (NaCl)
346	!
347	!-- Densities in kg/m3
348	REAL(wp), PARAMETER :: arhobc = 2000.0_wp !< black carbon
349	REAL(wp), PARAMETER :: arhodu = 2650.0_wp !< mineral dust
350	REAL(wp), PARAMETER :: arhoh2o = 1000.0_wp !< H2O
351	REAL(wp), PARAMETER :: arhoh2so4 = 1830.0_wp !< SO4
352	REAL(wp), PARAMETER :: arhohno3 = 1479.0_wp !< HNO3
353	REAL(wp), PARAMETER :: arhonh3 = 1530.0_wp !< NH3
354	REAL(wp), PARAMETER :: arhooc = 2000.0_wp !< organic carbon
355	REAL(wp), PARAMETER :: arhoss = 2165.0_wp !< sea salt (NaCl)
356	!
357	!-- Volume of molecule in m3/#
358	REAL(wp), PARAMETER :: amvh2o = amh2o /avo / arhoh2o !< H2O
359	REAL(wp), PARAMETER :: amvh2so4 = amh2so4 / avo / arhoh2so4 !< SO4
360	REAL(wp), PARAMETER :: amvhno3 = amhno3 / avo / arhohno3 !< HNO3
361	REAL(wp), PARAMETER :: amvnh3 = amnh3 / avo / arhonh3 !< NH3
362	REAL(wp), PARAMETER :: amvoc = amoc / avo / arhooc !< OC
363	REAL(wp), PARAMETER :: amvss = amss / avo / arhoss !< sea salt
364	!
365	!-- Constants for the dry deposition model by Petroff and Zhang (2010):
366	!-- obstacle characteristic dimension "L" (cm) (plane obstacle by default) and empirical constants
367	!-- C_B, C_IN, C_IM, beta_IM and C_IT for each land use category (15, as in Zhang et al. (2001))
368	REAL(wp), DIMENSION(1:15), PARAMETER :: l_p10 = &
369	(/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/)
370	REAL(wp), DIMENSION(1:15), PARAMETER :: c_b_p10 = &
371	(/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/)
372	REAL(wp), DIMENSION(1:15), PARAMETER :: c_in_p10 = &
373	(/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/)
374	REAL(wp), DIMENSION(1:15), PARAMETER :: c_im_p10 = &
375	(/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/)
376	REAL(wp), DIMENSION(1:15), PARAMETER :: beta_im_p10 = &
377	(/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/)
378	REAL(wp), DIMENSION(1:15), PARAMETER :: c_it_p10 = &
379	(/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/)
380	!
381	!-- Constants for the dry deposition model by Zhang et al. (2001):
382	!-- empirical constants "alpha" and "gamma" and characteristic radius "A" for
383	!-- each land use category (15) and season (5)
384	REAL(wp), DIMENSION(1:15), PARAMETER :: alpha_z01 = &
385	(/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/)
386	REAL(wp), DIMENSION(1:15), PARAMETER :: gamma_z01 = &
387	(/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/)
388	REAL(wp), DIMENSION(1:15,1:5), PARAMETER :: A_z01 = RESHAPE( (/&
389	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
390	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
391	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
392	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
393	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
394	/), (/ 15, 5 /) )
395	!-- Land use categories (based on Z01 but the same applies here also for P10):
396	!-- 1 = evergreen needleleaf trees,
397	!-- 2 = evergreen broadleaf trees,
398	!-- 3 = deciduous needleleaf trees,
399	!-- 4 = deciduous broadleaf trees,
400	!-- 5 = mixed broadleaf and needleleaf trees (deciduous broadleaf trees for P10),
401	!-- 6 = grass (short grass for P10),
402	!-- 7 = crops, mixed farming,
403	!-- 8 = desert,
404	!-- 9 = tundra,
405	!-- 10 = shrubs and interrupted woodlands (thorn shrubs for P10),
406	!-- 11 = wetland with plants (long grass for P10)
407	!-- 12 = ice cap and glacier,
408	!-- 13 = inland water (inland lake for P10)
409	!-- 14 = ocean (water for P10),
410	!-- 15 = urban
411	!
412	!-- SALSA variables:
413	CHARACTER(LEN=20) :: bc_salsa_b = 'neumann' !< bottom boundary condition
414	CHARACTER(LEN=20) :: bc_salsa_t = 'neumann' !< top boundary condition
415	CHARACTER(LEN=20) :: depo_pcm_par = 'zhang2001' !< or 'petroff2010'
416	CHARACTER(LEN=20) :: depo_pcm_type = 'deciduous_broadleaf' !< leaf type
417	CHARACTER(LEN=20) :: depo_surf_par = 'zhang2001' !< or 'petroff2010'
418	CHARACTER(LEN=100) :: input_file_dynamic = 'PIDS_DYNAMIC' !< file name for dynamic input
419	CHARACTER(LEN=100) :: input_file_salsa = 'PIDS_SALSA' !< file name for emission data
420	CHARACTER(LEN=20) :: salsa_emission_mode = 'no_emission' !< 'no_emission', 'uniform',
421	!< 'parameterized', 'read_from_file'
422
423	CHARACTER(LEN=20), DIMENSION(4) :: decycle_method_salsa = &
424	(/'dirichlet','dirichlet','dirichlet','dirichlet'/)
425	!< Decycling method at horizontal boundaries
426	!< 1=left, 2=right, 3=south, 4=north
427	!< dirichlet = initial profiles for the ghost and first 3 layers
428	!< neumann = zero gradient
429
430	CHARACTER(LEN=3), DIMENSION(maxspec) :: listspec = & !< Active aerosols
431	(/'SO4',' ',' ',' ',' ',' ',' '/)
432
433	INTEGER(iwp) :: depo_pcm_par_num = 1 !< parametrisation type: 1=zhang2001, 2=petroff2010
434	INTEGER(iwp) :: depo_pcm_type_num = 0 !< index for the dry deposition type on the plant canopy
435	INTEGER(iwp) :: depo_surf_par_num = 1 !< parametrisation type: 1=zhang2001, 2=petroff2010
436	INTEGER(iwp) :: end_subrange_1a = 1 !< last index for bin subrange 1a
437	INTEGER(iwp) :: end_subrange_2a = 1 !< last index for bin subrange 2a
438	INTEGER(iwp) :: end_subrange_2b = 1 !< last index for bin subrange 2b
439	INTEGER(iwp) :: ibc_salsa_b !< index for the bottom boundary condition
440	INTEGER(iwp) :: ibc_salsa_t !< index for the top boundary condition
441	INTEGER(iwp) :: index_bc = -1 !< index for black carbon (BC)
442	INTEGER(iwp) :: index_du = -1 !< index for dust
443	INTEGER(iwp) :: index_nh = -1 !< index for NH3
444	INTEGER(iwp) :: index_no = -1 !< index for HNO3
445	INTEGER(iwp) :: index_oc = -1 !< index for organic carbon (OC)
446	INTEGER(iwp) :: index_so4 = -1 !< index for SO4 or H2SO4
447	INTEGER(iwp) :: index_ss = -1 !< index for sea salt
448	INTEGER(iwp) :: init_aerosol_type = 0 !< Initial size distribution type
449	!< 0 = uniform (read from PARIN)
450	!< 1 = read vertical profiles from an input file
451	INTEGER(iwp) :: init_gases_type = 0 !< Initial gas concentration type
452	!< 0 = uniform (read from PARIN)
453	!< 1 = read vertical profiles from an input file
454	INTEGER(iwp) :: lod_gas_emissions = 0 !< level of detail of the gaseous emission data
455	INTEGER(iwp) :: main_street_id = 0 !< lower bound of main street IDs for parameterized emission mode
456	INTEGER(iwp) :: max_street_id = 0 !< upper bound of main street IDs for parameterized emission mode
457	INTEGER(iwp) :: nbins_aerosol = 1 !< total number of size bins
458	INTEGER(iwp) :: ncc = 1 !< number of chemical components used
459	INTEGER(iwp) :: ncomponents_mass = 1 !< total number of chemical compounds (ncc+1)
460	!< if particle water is advected)
461	INTEGER(iwp) :: nj3 = 1 !< J3 parametrization (nucleation)
462	!< 1 = condensational sink (Kerminen&Kulmala, 2002)
463	!< 2 = coagulational sink (Lehtinen et al. 2007)
464	!< 3 = coagS+self-coagulation (Anttila et al. 2010)
465	INTEGER(iwp) :: nsnucl = 0 !< Choice of the nucleation scheme:
466	!< 0 = off
467	!< 1 = binary nucleation
468	!< 2 = activation type nucleation
469	!< 3 = kinetic nucleation
470	!< 4 = ternary nucleation
471	!< 5 = nucleation with ORGANICs
472	!< 6 = activation type of nucleation with H2SO4+ORG
473	!< 7 = heteromolecular nucleation with H2SO4*ORG
474	!< 8 = homomolecular nucleation of H2SO4
475	!< + heteromolecular nucleation with H2SO4*ORG
476	!< 9 = homomolecular nucleation of H2SO4 and ORG
477	!< + heteromolecular nucleation with H2SO4*ORG
478	INTEGER(iwp) :: salsa_pr_count = 0 !< counter for salsa variable profiles
479	INTEGER(iwp) :: season_z01 = 1 !< For dry deposition by Zhang et al.: 1 = summer,
480	!< 2 = autumn (no harvest yet), 3 = late autumn
481	!< (already frost), 4 = winter, 5 = transitional spring
482	INTEGER(iwp) :: side_street_id = 0 !< lower bound of side street IDs for parameterized emission mode
483	INTEGER(iwp) :: start_subrange_1a = 1 !< start index for bin subranges: subrange 1a
484	INTEGER(iwp) :: start_subrange_2a = 1 !< subrange 2a
485	INTEGER(iwp) :: start_subrange_2b = 1 !< subrange 2b
486
487	INTEGER(iwp), DIMENSION(nreg) :: nbin = (/ 3, 7/) !< Number of size bins per subrange: 1 & 2
488
489	INTEGER(iwp), DIMENSION(ngases_salsa) :: gas_index_chem = (/ 1, 1, 1, 1, 1/) !< gas indices in chemistry_model_mod
490	!< 1 = H2SO4, 2 = HNO3,
491	!< 3 = NH3, 4 = OCNV, 5 = OCSV
492	INTEGER(iwp), DIMENSION(ngases_salsa) :: emission_index_chem !< gas indices in the gas emission file
493	INTEGER(iwp), DIMENSION(99) :: salsa_pr_index = 0 !< index for salsa profiles
494
495	INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE :: k_topo_top !< vertical index of the topography top
496
497	INTEGER(iwp), DIMENSION(:,:,:), ALLOCATABLE :: salsa_advc_flags_s !< flags used to degrade order of advection
498	!< scheme for salsa variables near walls and
499	!< lateral boundaries
500	!
501	!-- SALSA switches:
502	LOGICAL :: advect_particle_water = .TRUE. !< Advect water concentration of particles
503	LOGICAL :: decycle_salsa_lr = .FALSE. !< Undo cyclic boundaries: left and right
504	LOGICAL :: decycle_salsa_ns = .FALSE. !< Undo cyclic boundaries: north and south
505	LOGICAL :: include_emission = .FALSE. !< Include or not emissions
506	LOGICAL :: feedback_to_palm = .FALSE. !< Allow feedback due to condensation of H2O
507	LOGICAL :: nesting_salsa = .TRUE. !< Apply nesting for salsa
508	LOGICAL :: nesting_offline_salsa = .TRUE. !< Apply offline nesting for salsa
509	LOGICAL :: no_insoluble = .FALSE. !< Exclude insoluble chemical components
510	LOGICAL :: read_restart_data_salsa = .TRUE. !< Read restart data for salsa
511	LOGICAL :: salsa_gases_from_chem = .FALSE. !< Transfer the gaseous components to SALSA
512	LOGICAL :: van_der_waals_coagc = .FALSE. !< Include van der Waals and viscous forces in coagulation
513	LOGICAL :: write_binary_salsa = .TRUE. !< read binary for salsa
514	!
515	!-- Process switches: nl* is read from the NAMELIST and is NOT changed.
516	!-- ls* is the switch used and will get the value of nl*
517	!-- except for special circumstances (spinup period etc.)
518	LOGICAL :: nlcoag = .FALSE. !< Coagulation master switch
519	LOGICAL :: lscoag = .FALSE. !<
520	LOGICAL :: nlcnd = .FALSE. !< Condensation master switch
521	LOGICAL :: lscnd = .FALSE. !<
522	LOGICAL :: nlcndgas = .FALSE. !< Condensation of precursor gases
523	LOGICAL :: lscndgas = .FALSE. !<
524	LOGICAL :: nlcndh2oae = .FALSE. !< Condensation of H2O on aerosol
525	LOGICAL :: lscndh2oae = .FALSE. !< particles (FALSE -> equilibrium calc.)
526	LOGICAL :: nldepo = .FALSE. !< Deposition master switch
527	LOGICAL :: lsdepo = .FALSE. !<
528	LOGICAL :: nldepo_surf = .FALSE. !< Deposition on vegetation master switch
529	LOGICAL :: lsdepo_surf = .FALSE. !<
530	LOGICAL :: nldepo_pcm = .FALSE. !< Deposition on walls master switch
531	LOGICAL :: lsdepo_pcm = .FALSE. !<
532	LOGICAL :: nldistupdate = .TRUE. !< Size distribution update master switch
533	LOGICAL :: lsdistupdate = .FALSE. !<
534	LOGICAL :: lspartition = .FALSE. !< Partition of HNO3 and NH3
535
536	REAL(wp) :: act_coeff = 1.0E-7_wp !< Activation coefficient (1/s)
537	REAL(wp) :: dt_salsa = 0.00001_wp !< Time step of SALSA
538	REAL(wp) :: emiss_factor_main = 0.0_wp !< relative emission factor for main streets
539	REAL(wp) :: emiss_factor_side = 0.0_wp !< relative emission factor for side streets
540	REAL(wp) :: h2so4_init = nclim !< Init value for sulphuric acid gas
541	REAL(wp) :: hno3_init = nclim !< Init value for nitric acid gas
542	REAL(wp) :: last_salsa_time = 0.0_wp !< previous salsa call
543	REAL(wp) :: next_aero_emission_update = 0.0_wp !< previous emission update
544	REAL(wp) :: next_gas_emission_update = 0.0_wp !< previous emission update
545	REAL(wp) :: nf2a = 1.0_wp !< Number fraction allocated to 2a-bins
546	REAL(wp) :: nh3_init = nclim !< Init value for ammonia gas
547	REAL(wp) :: ocnv_init = nclim !< Init value for non-volatile organic gases
548	REAL(wp) :: ocsv_init = nclim !< Init value for semi-volatile organic gases
549	REAL(wp) :: rhlim = 1.20_wp !< RH limit in %/100. Prevents unrealistical RH
550	REAL(wp) :: skip_time_do_salsa = 0.0_wp !< Starting time of SALSA (s)
551	!
552	!-- Initial log-normal size distribution: mode diameter (dpg, metres),
553	!-- standard deviation (sigmag) and concentration (n_lognorm, #/m3)
554	REAL(wp), DIMENSION(nmod) :: dpg = &
555	(/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/)
556	REAL(wp), DIMENSION(nmod) :: sigmag = &
557	(/1.8_wp, 2.16_wp, 2.21_wp, 2.0_wp, 2.0_wp, 2.0_wp, 2.0_wp/)
558	REAL(wp), DIMENSION(nmod) :: n_lognorm = &
559	(/1.04e+11_wp, 3.23E+10_wp, 5.4E+6_wp, 0.0_wp, 0.0_wp, 0.0_wp, 0.0_wp/)
560	!
561	!-- Initial mass fractions / chemical composition of the size distribution
562	REAL(wp), DIMENSION(maxspec) :: mass_fracs_a = & !< mass fractions between
563	(/1.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0/) !< aerosol species for A bins
564	REAL(wp), DIMENSION(maxspec) :: mass_fracs_b = & !< mass fractions between
565	(/0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0/) !< aerosol species for B bins
566	REAL(wp), DIMENSION(nreg+1) :: reglim = & !< Min&max diameters of size subranges
567	(/ 3.0E-9_wp, 5.0E-8_wp, 1.0E-5_wp/)
568	!
569	!-- Initial log-normal size distribution: mode diameter (dpg, metres), standard deviation (sigmag)
570	!-- concentration (n_lognorm, #/m3) and mass fractions of all chemical components (listed in
571	!-- listspec) for both a (soluble) and b (insoluble) bins.
572	REAL(wp), DIMENSION(nmod) :: aerosol_flux_dpg = &
573	(/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/)
574	REAL(wp), DIMENSION(nmod) :: aerosol_flux_sigmag = &
575	(/1.8_wp, 2.16_wp, 2.21_wp, 2.0_wp, 2.0_wp, 2.0_wp, 2.0_wp/)
576	REAL(wp), DIMENSION(maxspec) :: aerosol_flux_mass_fracs_a = &
577	(/1.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0/)
578	REAL(wp), DIMENSION(maxspec) :: aerosol_flux_mass_fracs_b = &
579	(/0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0/)
580	REAL(wp), DIMENSION(nmod) :: surface_aerosol_flux = &
581	(/1.0E+8_wp, 1.0E+9_wp, 1.0E+5_wp, 0.0_wp, 0.0_wp, 0.0_wp, 0.0_wp/)
582
583	REAL(wp), DIMENSION(:), ALLOCATABLE :: bin_low_limits !< to deliver information about
584	!< the lower diameters per bin
585	REAL(wp), DIMENSION(:), ALLOCATABLE :: bc_am_t_val !< vertical gradient of: aerosol mass
586	REAL(wp), DIMENSION(:), ALLOCATABLE :: bc_an_t_val !< of: aerosol number
587	REAL(wp), DIMENSION(:), ALLOCATABLE :: bc_gt_t_val !< salsa gases near domain top
588	REAL(wp), DIMENSION(:), ALLOCATABLE :: gas_emission_time !< Time array in gas emission data (s)
589	REAL(wp), DIMENSION(:), ALLOCATABLE :: nsect !< Background number concentrations
590	REAL(wp), DIMENSION(:), ALLOCATABLE :: massacc !< Mass accomodation coefficients
591	!
592	!-- SALSA derived datatypes:
593	!
594	!-- Component index
595	TYPE component_index
596	CHARACTER(len=3), ALLOCATABLE :: comp(:) !< Component name
597	INTEGER(iwp) :: ncomp !< Number of components
598	INTEGER(iwp), ALLOCATABLE :: ind(:) !< Component index
599	END TYPE component_index
600	!
601	!-- For matching LSM and USM surface types and the deposition module surface types
602	TYPE match_surface
603	INTEGER(iwp), DIMENSION(:), ALLOCATABLE :: match_lupg !< index for pavement / green roofs
604	INTEGER(iwp), DIMENSION(:), ALLOCATABLE :: match_luvw !< index for vegetation / walls
605	INTEGER(iwp), DIMENSION(:), ALLOCATABLE :: match_luww !< index for water / windows
606	END TYPE match_surface
607	!
608	!-- Aerosol emission data attributes
609	TYPE salsa_emission_attribute_type
610
611	CHARACTER(LEN=25) :: units
612
613	CHARACTER(LEN=25), DIMENSION(:), ALLOCATABLE :: cat_name !<
614	CHARACTER(LEN=25), DIMENSION(:), ALLOCATABLE :: cc_name !<
615	CHARACTER(LEN=25), DIMENSION(:), ALLOCATABLE :: unit_time !<
616	CHARACTER(LEN=100), DIMENSION(:), ALLOCATABLE :: var_names !<
617
618	INTEGER(iwp) :: lod = 0 !< level of detail
619	INTEGER(iwp) :: nbins = 10 !< number of aerosol size bins
620	INTEGER(iwp) :: ncat = 0 !< number of emission categories
621	INTEGER(iwp) :: ncc = 7 !< number of aerosol chemical components
622	INTEGER(iwp) :: nhoursyear = 0 !< number of hours: HOURLY mode
623	INTEGER(iwp) :: nmonthdayhour = 0 !< number of month days and hours: MDH mode
624	INTEGER(iwp) :: num_vars !< number of variables
625	INTEGER(iwp) :: nt = 0 !< number of time steps
626	INTEGER(iwp) :: nz = 0 !< number of vertical levels
627	INTEGER(iwp) :: tind !< time index for reference time in salsa emission data
628
629	INTEGER(iwp), DIMENSION(maxspec) :: cc_in2mod = 0 !<
630
631	INTEGER(iwp), DIMENSION(:), ALLOCATABLE :: cat_index !< Index of emission categories
632	INTEGER(iwp), DIMENSION(:), ALLOCATABLE :: cc_index !< Index of chemical components
633
634	REAL(wp) :: conversion_factor !< unit conversion factor for aerosol emissions
635
636	REAL(wp), DIMENSION(:), ALLOCATABLE :: dmid !< mean diameters of size bins (m)
637	REAL(wp), DIMENSION(:), ALLOCATABLE :: rho !< average density (kg/m3)
638	REAL(wp), DIMENSION(:), ALLOCATABLE :: time !< time (s)
639	REAL(wp), DIMENSION(:), ALLOCATABLE :: time_factor !< emission time factor
640	REAL(wp), DIMENSION(:), ALLOCATABLE :: z !< height (m)
641
642	REAL(wp), DIMENSION(:,:), ALLOCATABLE :: etf !< emission time factor
643	REAL(wp), DIMENSION(:,:), ALLOCATABLE :: stack_height
644
645	END TYPE salsa_emission_attribute_type
646	!
647	!-- The default size distribution and mass composition per emission category:
648	!-- 1 = traffic, 2 = road dust, 3 = wood combustion, 4 = other
649	!-- Mass fractions: H2SO4, OC, BC, DU, SS, HNO3, NH3
650	TYPE salsa_emission_mode_type
651
652	INTEGER(iwp) :: ndm = 3 !< number of default modes
653	INTEGER(iwp) :: ndc = 4 !< number of default categories
654
655	CHARACTER(LEN=25), DIMENSION(1:4) :: cat_name_table = (/'traffic exhaust', &
656	'road dust ', &
657	'wood combustion', &
658	'other '/)
659
660	INTEGER(iwp), DIMENSION(1:4) :: cat_input_to_model !<
661
662	REAL(wp), DIMENSION(1:3) :: dpg_table = (/ 13.5E-9_wp, 1.4E-6_wp, 5.4E-8_wp/) !<
663	REAL(wp), DIMENSION(1:3) :: ntot_table !<
664	REAL(wp), DIMENSION(1:3) :: sigmag_table = (/ 1.6_wp, 1.4_wp, 1.7_wp /) !<
665
666	REAL(wp), DIMENSION(1:maxspec,1:4) :: mass_frac_table = & !<
667	RESHAPE( (/ 0.04_wp, 0.48_wp, 0.48_wp, 0.0_wp, 0.0_wp, 0.0_wp, 0.0_wp, &
668	0.0_wp, 0.05_wp, 0.0_wp, 0.95_wp, 0.0_wp, 0.0_wp, 0.0_wp, &
669	0.0_wp, 0.5_wp, 0.5_wp, 0.0_wp, 0.0_wp, 0.0_wp, 0.0_wp, &
670	0.0_wp, 0.5_wp, 0.5_wp, 0.0_wp, 0.0_wp, 0.0_wp, 0.0_wp &
671	/), (/maxspec,4/) )
672
673	REAL(wp), DIMENSION(1:3,1:4) :: pm_frac_table = & !< rel. mass
674	RESHAPE( (/ 0.016_wp, 0.000_wp, 0.984_wp, &
675	0.000_wp, 1.000_wp, 0.000_wp, &
676	0.000_wp, 0.000_wp, 1.000_wp, &
677	1.000_wp, 0.000_wp, 1.000_wp &
678	/), (/3,4/) )
679
680	END TYPE salsa_emission_mode_type
681	!
682	!-- Aerosol emission data values
683	TYPE salsa_emission_value_type
684
685	REAL(wp) :: fill !< fill value
686
687	REAL(wp), DIMENSION(:,:), ALLOCATABLE :: mass_fracs !< mass fractions per emis. category
688	REAL(wp), DIMENSION(:,:), ALLOCATABLE :: num_fracs !< number fractions per emis. category
689
690	REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: def_data !< surface emission in PM
691	REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: preproc_data !< surface emission per category
692
693	END TYPE salsa_emission_value_type
694	!
695	!-- Offline nesting data type
696	TYPE salsa_nest_offl_type
697
698	CHARACTER(LEN=16) :: char_l = 'ls_forcing_left_' !< leading substring at left boundary
699	CHARACTER(LEN=17) :: char_n = 'ls_forcing_north_' !< leading substring at north boundary
700	CHARACTER(LEN=17) :: char_r = 'ls_forcing_right_' !< leading substring at right boundary
701	CHARACTER(LEN=17) :: char_s = 'ls_forcing_south_' !< leading substring at south boundary
702	CHARACTER(LEN=15) :: char_t = 'ls_forcing_top_' !< leading substring at top boundary
703
704	CHARACTER(LEN=5), DIMENSION(1:ngases_salsa) :: gas_name = (/'H2SO4','HNO3 ','NH3 ','OCNV ','OCSV '/)
705
706	CHARACTER(LEN=25), DIMENSION(:), ALLOCATABLE :: cc_name !< chemical component name
707	CHARACTER(LEN=100), DIMENSION(:), ALLOCATABLE :: var_names !< list of variable names
708
709	INTEGER(iwp) :: id_dynamic !< NetCDF id of dynamic input file
710	INTEGER(iwp) :: ncc !< number of aerosol chemical components
711	INTEGER(iwp) :: nt !< number of time levels in dynamic input file
712	INTEGER(iwp) :: nzu !< number of vertical levels on scalar grid in dynamic input file
713	INTEGER(iwp) :: tind !< time index for reference time in mesoscale-offline nesting
714	INTEGER(iwp) :: tind_p !< time index for following time in mesoscale-offline nesting
715
716	INTEGER(iwp), DIMENSION(maxspec) :: cc_in2mod = 0 !< to transfer chemical composition from input to model
717
718	LOGICAL :: init = .FALSE. !< flag indicating the initialisation of offline nesting
719
720	REAL(wp), DIMENSION(:), ALLOCATABLE :: dmid !< vertical profile of aerosol bin diameters
721	REAL(wp), DIMENSION(:), ALLOCATABLE :: time !< time in dynamic input file
722	REAL(wp), DIMENSION(:), ALLOCATABLE :: zu_atmos !< zu in dynamic input file
723
724	REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE :: gconc_left !< gas conc. at left boundary
725	REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE :: gconc_north !< gas conc. at north boundary
726	REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE :: gconc_right !< gas conc. at right boundary
727	REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE :: gconc_south !< gas conc. at south boundary
728	REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE :: gconc_top !< gas conc.at top boundary
729	REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE :: mconc_left !< aerosol mass conc. at left boundary
730	REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE :: mconc_north !< aerosol mass conc. at north boundary
731	REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE :: mconc_right !< aerosol mass conc. at right boundary
732	REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE :: mconc_south !< aerosol mass conc. at south boundary
733	REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE :: mconc_top !< aerosol mass conc. at top boundary
734	REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE :: nconc_left !< aerosol number conc. at left boundary
735	REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE :: nconc_north !< aerosol number conc. at north boundary
736	REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE :: nconc_right !< aerosol number conc. at right boundary
737	REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE :: nconc_south !< aerosol number conc. at south boundary
738	REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE :: nconc_top !< aerosol number conc. at top boundary
739
740	END TYPE salsa_nest_offl_type
741	!
742	!-- Prognostic variable: Aerosol size bin information (number (#/m3) and mass (kg/m3) concentration)
743	!-- and the concentration of gaseous tracers (#/m3). Gas tracers are contained sequentially in
744	!-- dimension 4 as:
745	!-- 1. H2SO4, 2. HNO3, 3. NH3, 4. OCNV (non-volatile organics), 5. OCSV (semi-volatile)
746	TYPE salsa_variable
747
748	REAL(wp), DIMENSION(:), ALLOCATABLE :: init !<
749
750	REAL(wp), DIMENSION(:,:), ALLOCATABLE :: diss_s !<
751	REAL(wp), DIMENSION(:,:), ALLOCATABLE :: flux_s !<
752	REAL(wp), DIMENSION(:,:), ALLOCATABLE :: source !<
753	REAL(wp), DIMENSION(:,:), ALLOCATABLE :: sums_ws_l !<
754
755	REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: diss_l !<
756	REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: flux_l !<
757
758	REAL(wp), DIMENSION(:,:,:), POINTER, CONTIGUOUS :: conc !<
759	REAL(wp), DIMENSION(:,:,:), POINTER, CONTIGUOUS :: conc_p !<
760	REAL(wp), DIMENSION(:,:,:), POINTER, CONTIGUOUS :: tconc_m !<
761
762	END TYPE salsa_variable
763	!
764	!-- Datatype used to store information about the binned size distributions of aerosols
765	TYPE t_section
766
767	REAL(wp) :: dmid !< bin middle diameter (m)
768	REAL(wp) :: vhilim !< bin volume at the high limit
769	REAL(wp) :: vlolim !< bin volume at the low limit
770	REAL(wp) :: vratiohi !< volume ratio between the center and high limit
771	REAL(wp) :: vratiolo !< volume ratio between the center and low limit
772	!******************************************************
773	! ^ Do NOT change the stuff above after initialization !
774	!******************************************************
775	REAL(wp) :: core !< Volume of dry particle
776	REAL(wp) :: dwet !< Wet diameter or mean droplet diameter (m)
777	REAL(wp) :: numc !< Number concentration of particles/droplets (#/m3)
778	REAL(wp) :: veqh2o !< Equilibrium H2O concentration for each particle
779
780	REAL(wp), DIMENSION(maxspec+1) :: volc !< Volume concentrations (m^3/m^3) of aerosols +
781	!< water. Since most of the stuff in SALSA is hard
782	!< coded, these have to be in the order
783	!< 1:SO4, 2:OC, 3:BC, 4:DU, 5:SS, 6:NO, 7:NH, 8:H2O
784	END TYPE t_section
785
786	TYPE(salsa_emission_attribute_type) :: aero_emission_att !< emission attributes
787	TYPE(salsa_emission_value_type) :: aero_emission !< emission values
788	TYPE(salsa_emission_mode_type) :: def_modes !< default emission modes
789
790	TYPE(chem_emis_att_type) :: chem_emission_att !< chemistry emission attributes
791
792	TYPE(chem_emis_val_type), DIMENSION(:), ALLOCATABLE :: chem_emission !< chemistry emissions
793
794	TYPE(t_section), DIMENSION(:), ALLOCATABLE :: aero !< local aerosol properties
795
796	TYPE(match_surface) :: lsm_to_depo_h !< to match the deposition module and horizontal LSM surfaces
797	TYPE(match_surface) :: usm_to_depo_h !< to match the deposition module and horizontal USM surfaces
798
799	TYPE(match_surface), DIMENSION(0:3) :: lsm_to_depo_v !< to match the deposition mod. and vertical LSM surfaces
800	TYPE(match_surface), DIMENSION(0:3) :: usm_to_depo_v !< to match the deposition mod. and vertical USM surfaces
801	!
802	!-- SALSA variables: as x = x(k,j,i,bin).
803	!-- The 4th dimension contains all the size bins sequentially for each aerosol species + water.
804	!
805	!-- Prognostic variables:
806	!
807	!-- Number concentration (#/m3)
808	TYPE(salsa_variable), DIMENSION(:), ALLOCATABLE, TARGET :: aerosol_number !<
809	REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE, TARGET :: nconc_1 !<
810	REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE, TARGET :: nconc_2 !<
811	REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE, TARGET :: nconc_3 !<
812	!
813	!-- Mass concentration (kg/m3)
814	TYPE(salsa_variable), DIMENSION(:), ALLOCATABLE, TARGET :: aerosol_mass !<
815	REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE, TARGET :: mconc_1 !<
816	REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE, TARGET :: mconc_2 !<
817	REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE, TARGET :: mconc_3 !<
818	!
819	!-- Gaseous concentrations (#/m3)
820	TYPE(salsa_variable), DIMENSION(:), ALLOCATABLE, TARGET :: salsa_gas !<
821	REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE, TARGET :: gconc_1 !<
822	REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE, TARGET :: gconc_2 !<
823	REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE, TARGET :: gconc_3 !<
824	!
825	!-- Diagnostic tracers
826	REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE :: sedim_vd !< sedimentation velocity per bin (m/s)
827	REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE :: ra_dry !< aerosol dry radius (m)
828
829	!-- Particle component index tables
830	TYPE(component_index) :: prtcl !< Contains "getIndex" which gives the index for a given aerosol
831	!< component name: 1:SO4, 2:OC, 3:BC, 4:DU, 5:SS, 6:NO, 7:NH, 8:H2O
832	!
833	!-- Offline nesting:
834	TYPE(salsa_nest_offl_type) :: salsa_nest_offl !< data structure for offline nesting
835	!
836	!-- Data output arrays:
837	!
838	!-- Integrated:
839	REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET :: ldsa_av !< lung-deposited surface area
840	REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET :: ntot_av !< total number concentration
841	REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET :: nufp_av !< ultrafine particles (UFP)
842	REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET :: pm01_av !< PM0.1
843	REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET :: pm25_av !< PM2.5
844	REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET :: pm10_av !< PM10
845	!
846	!-- Bin specific mass and number concentrations:
847	REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE, TARGET :: mbins_av !< bin mas
848	REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE, TARGET :: nbins_av !< bin number
849	!
850	!-- Gases:
851	REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE, TARGET :: salsa_gases_av !< gases
852	!
853	!-- In the particle phase:
854	REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET :: s_h2o_av !< liquid water
855	REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE, TARGET :: s_mass_av !< mass components
856
857	!
858	!-- PALM interfaces:
859
860	INTERFACE salsa_actions
861	MODULE PROCEDURE salsa_actions
862	MODULE PROCEDURE salsa_actions_ij
863	END INTERFACE salsa_actions
864
865	INTERFACE salsa_3d_data_averaging
866	MODULE PROCEDURE salsa_3d_data_averaging
867	END INTERFACE salsa_3d_data_averaging
868
869	INTERFACE salsa_boundary_conds
870	MODULE PROCEDURE salsa_boundary_conds
871	MODULE PROCEDURE salsa_boundary_conds_decycle
872	END INTERFACE salsa_boundary_conds
873
874	INTERFACE salsa_boundary_conditions
875	MODULE PROCEDURE salsa_boundary_conditions
876	END INTERFACE salsa_boundary_conditions
877
878	INTERFACE salsa_check_data_output
879	MODULE PROCEDURE salsa_check_data_output
880	END INTERFACE salsa_check_data_output
881
882	INTERFACE salsa_check_data_output_pr
883	MODULE PROCEDURE salsa_check_data_output_pr
884	END INTERFACE salsa_check_data_output_pr
885
886	INTERFACE salsa_check_parameters
887	MODULE PROCEDURE salsa_check_parameters
888	END INTERFACE salsa_check_parameters
889
890	INTERFACE salsa_data_output_2d
891	MODULE PROCEDURE salsa_data_output_2d
892	END INTERFACE salsa_data_output_2d
893
894	INTERFACE salsa_data_output_3d
895	MODULE PROCEDURE salsa_data_output_3d
896	END INTERFACE salsa_data_output_3d
897
898	INTERFACE salsa_data_output_mask
899	MODULE PROCEDURE salsa_data_output_mask
900	END INTERFACE salsa_data_output_mask
901
902	INTERFACE salsa_define_netcdf_grid
903	MODULE PROCEDURE salsa_define_netcdf_grid
904	END INTERFACE salsa_define_netcdf_grid
905
906	INTERFACE salsa_emission_update
907	MODULE PROCEDURE salsa_emission_update
908	END INTERFACE salsa_emission_update
909
910	INTERFACE salsa_exchange_horiz_bounds
911	MODULE PROCEDURE salsa_exchange_horiz_bounds
912	END INTERFACE salsa_exchange_horiz_bounds
913
914	INTERFACE salsa_header
915	MODULE PROCEDURE salsa_header
916	END INTERFACE salsa_header
917
918	INTERFACE salsa_init
919	MODULE PROCEDURE salsa_init
920	END INTERFACE salsa_init
921
922	INTERFACE salsa_init_arrays
923	MODULE PROCEDURE salsa_init_arrays
924	END INTERFACE salsa_init_arrays
925
926	INTERFACE salsa_nesting_offl_bc
927	MODULE PROCEDURE salsa_nesting_offl_bc
928	END INTERFACE salsa_nesting_offl_bc
929
930	INTERFACE salsa_nesting_offl_init
931	MODULE PROCEDURE salsa_nesting_offl_init
932	END INTERFACE salsa_nesting_offl_init
933
934	INTERFACE salsa_nesting_offl_input
935	MODULE PROCEDURE salsa_nesting_offl_input
936	END INTERFACE salsa_nesting_offl_input
937
938	INTERFACE salsa_non_advective_processes
939	MODULE PROCEDURE salsa_non_advective_processes
940	MODULE PROCEDURE salsa_non_advective_processes_ij
941	END INTERFACE salsa_non_advective_processes
942
943	INTERFACE salsa_parin
944	MODULE PROCEDURE salsa_parin
945	END INTERFACE salsa_parin
946
947	INTERFACE salsa_prognostic_equations
948	MODULE PROCEDURE salsa_prognostic_equations
949	MODULE PROCEDURE salsa_prognostic_equations_ij
950	END INTERFACE salsa_prognostic_equations
951
952	INTERFACE salsa_rrd_local
953	MODULE PROCEDURE salsa_rrd_local
954	END INTERFACE salsa_rrd_local
955
956	INTERFACE salsa_statistics
957	MODULE PROCEDURE salsa_statistics
958	END INTERFACE salsa_statistics
959
960	INTERFACE salsa_swap_timelevel
961	MODULE PROCEDURE salsa_swap_timelevel
962	END INTERFACE salsa_swap_timelevel
963
964	INTERFACE salsa_tendency
965	MODULE PROCEDURE salsa_tendency
966	MODULE PROCEDURE salsa_tendency_ij
967	END INTERFACE salsa_tendency
968
969	INTERFACE salsa_wrd_local
970	MODULE PROCEDURE salsa_wrd_local
971	END INTERFACE salsa_wrd_local
972
973
974	SAVE
975
976	PRIVATE
977	!
978	!-- Public functions:
979	PUBLIC salsa_3d_data_averaging, &
980	salsa_actions, &
981	salsa_boundary_conds, &
982	salsa_boundary_conditions, &
983	salsa_check_data_output, &
984	salsa_check_data_output_pr, &
985	salsa_check_parameters, &
986	salsa_data_output_2d, &
987	salsa_data_output_3d, &
988	salsa_data_output_mask, &
989	salsa_define_netcdf_grid, &
990	salsa_diagnostics, &
991	salsa_emission_update, &
992	salsa_exchange_horiz_bounds, &
993	salsa_header, &
994	salsa_init, &
995	salsa_init_arrays, &
996	salsa_nesting_offl_bc, &
997	salsa_nesting_offl_init, &
998	salsa_nesting_offl_input, &
999	salsa_non_advective_processes, &
1000	salsa_parin, &
1001	salsa_prognostic_equations, &
1002	salsa_rrd_local, &
1003	salsa_statistics, &
1004	salsa_swap_timelevel, &
1005	salsa_wrd_local
1006
1007	!
1008	!-- Public parameters, constants and initial values
1009	PUBLIC bc_am_t_val, &
1010	bc_an_t_val, &
1011	bc_gt_t_val, &
1012	ibc_salsa_b, &
1013	init_aerosol_type, &
1014	init_gases_type, &
1015	nesting_salsa, &
1016	nesting_offline_salsa, &
1017	salsa_gases_from_chem, &
1018	skip_time_do_salsa
1019	!
1020	!-- Public variables
1021	PUBLIC aerosol_mass, &
1022	aerosol_number, &
1023	gconc_2, &
1024	mconc_2, &
1025	nbins_aerosol, &
1026	ncomponents_mass, &
1027	nconc_2, &
1028	ngases_salsa, &
1029	salsa_gas, &
1030	salsa_nest_offl
1031
1032
1033	CONTAINS
1034
1035	!------------------------------------------------------------------------------!
1036	! Description:
1037	! ------------
1038	!> Parin for &salsa_par for new modules
1039	!------------------------------------------------------------------------------!
1040	SUBROUTINE salsa_parin
1041
1042	USE control_parameters, &
1043	ONLY: data_output_pr
1044
1045	IMPLICIT NONE
1046
1047	CHARACTER(LEN=80) :: line !< dummy string that contains the current line of parameter file
1048
1049	INTEGER(iwp) :: i !< loop index
1050	INTEGER(iwp) :: max_pr_salsa_tmp !< dummy variable
1051
1052	NAMELIST /salsa_parameters/ aerosol_flux_dpg, &
1053	aerosol_flux_mass_fracs_a, &
1054	aerosol_flux_mass_fracs_b, &
1055	aerosol_flux_sigmag, &
1056	advect_particle_water, &
1057	bc_salsa_b, &
1058	bc_salsa_t, &
1059	decycle_salsa_lr, &
1060	decycle_method_salsa, &
1061	decycle_salsa_ns, &
1062	depo_pcm_par, &
1063	depo_pcm_type, &
1064	depo_surf_par, &
1065	dpg, &
1066	dt_salsa, &
1067	emiss_factor_main, &
1068	emiss_factor_side, &
1069	feedback_to_palm, &
1070	h2so4_init, &
1071	hno3_init, &
1072	listspec, &
1073	main_street_id, &
1074	mass_fracs_a, &
1075	mass_fracs_b, &
1076	max_street_id, &
1077	n_lognorm, &
1078	nbin, &
1079	nesting_salsa, &
1080	nesting_offline_salsa, &
1081	nf2a, &
1082	nh3_init, &
1083	nj3, &
1084	nlcnd, &
1085	nlcndgas, &
1086	nlcndh2oae, &
1087	nlcoag, &
1088	nldepo, &
1089	nldepo_pcm, &
1090	nldepo_surf, &
1091	nldistupdate, &
1092	nsnucl, &
1093	ocnv_init, &
1094	ocsv_init, &
1095	read_restart_data_salsa, &
1096	reglim, &
1097	salsa, &
1098	salsa_emission_mode, &
1099	season_z01, &
1100	sigmag, &
1101	side_street_id, &
1102	skip_time_do_salsa, &
1103	surface_aerosol_flux, &
1104	van_der_waals_coagc, &
1105	write_binary_salsa
1106
1107	line = ' '
1108	!
1109	!-- Try to find salsa package
1110	REWIND ( 11 )
1111	line = ' '
1112	DO WHILE ( INDEX( line, '&salsa_parameters' ) == 0 )
1113	READ ( 11, '(A)', END=10 ) line
1114	ENDDO
1115	BACKSPACE ( 11 )
1116	!
1117	!-- Read user-defined namelist
1118	READ ( 11, salsa_parameters )
1119	!
1120	!-- Enable salsa (salsa switch in modules.f90)
1121	salsa = .TRUE.
1122
1123	10 CONTINUE
1124	!
1125	!-- Update the number of output profiles
1126	max_pr_salsa_tmp = 0
1127	i = 1
1128	DO WHILE ( data_output_pr(i) /= ' ' .AND. i <= 100 )
1129	IF ( TRIM( data_output_pr(i)(1:6) ) == 'salsa_' ) max_pr_salsa_tmp = max_pr_salsa_tmp + 1
1130	i = i + 1
1131	ENDDO
1132	IF ( max_pr_salsa_tmp > 0 ) max_pr_salsa = max_pr_salsa_tmp
1133
1134	END SUBROUTINE salsa_parin
1135
1136	!------------------------------------------------------------------------------!
1137	! Description:
1138	! ------------
1139	!> Check parameters routine for salsa.
1140	!------------------------------------------------------------------------------!
1141	SUBROUTINE salsa_check_parameters
1142
1143	USE control_parameters, &
1144	ONLY: child_domain, humidity, initializing_actions, nesting_offline
1145
1146	IMPLICIT NONE
1147
1148	!
1149	!-- Check that humidity is switched on
1150	IF ( salsa .AND. .NOT. humidity ) THEN
1151	WRITE( message_string, * ) 'salsa = ', salsa, ' is not allowed with humidity = ', humidity
1152	CALL message( 'salsa_check_parameters', 'PA0594', 1, 2, 0, 6, 0 )
1153	ENDIF
1154	!
1155	!-- For nested runs, explicitly set nesting boundary conditions.
1156	IF ( child_domain ) THEN
1157	IF ( nesting_salsa ) THEN
1158	bc_salsa_t = 'nested'
1159	ELSE
1160	bc_salsa_t = 'neumann'
1161	ENDIF
1162	ENDIF
1163	!
1164	!-- Set boundary conditions also in case the model is offline-nested in larger-scale models.
1165	IF ( nesting_offline ) THEN
1166	IF ( nesting_offline_salsa ) THEN
1167	bc_salsa_t = 'nesting_offline'
1168	ELSE
1169	bc_salsa_t = 'neumann'
1170	ENDIF
1171	ENDIF
1172	!
1173	!-- Set bottom boundary condition flag
1174	IF ( bc_salsa_b == 'dirichlet' ) THEN
1175	ibc_salsa_b = 0
1176	ELSEIF ( bc_salsa_b == 'neumann' ) THEN
1177	ibc_salsa_b = 1
1178	ELSE
1179	message_string = 'unknown boundary condition: bc_salsa_b = "' // TRIM( bc_salsa_t ) // '"'
1180	CALL message( 'salsa_check_parameters', 'PA0595', 1, 2, 0, 6, 0 )
1181	ENDIF
1182	!
1183	!-- Set top boundary conditions flag
1184	IF ( bc_salsa_t == 'dirichlet' ) THEN
1185	ibc_salsa_t = 0
1186	ELSEIF ( bc_salsa_t == 'neumann' ) THEN
1187	ibc_salsa_t = 1
1188	ELSEIF ( bc_salsa_t == 'initial_gradient' ) THEN
1189	ibc_salsa_t = 2
1190	ELSEIF ( bc_salsa_t == 'nested' .OR. bc_salsa_t == 'nesting_offline' ) THEN
1191	ibc_salsa_t = 3
1192	ELSE
1193	message_string = 'unknown boundary condition: bc_salsa_t = "' // TRIM( bc_salsa_t ) // '"'
1194	CALL message( 'salsa_check_parameters', 'PA0596', 1, 2, 0, 6, 0 )
1195	ENDIF
1196	!
1197	!-- Check J3 parametrisation
1198	IF ( nj3 < 1 .OR. nj3 > 3 ) THEN
1199	message_string = 'unknown nj3 (must be 1-3)'
1200	CALL message( 'salsa_check_parameters', 'PA0597', 1, 2, 0, 6, 0 )
1201	ENDIF
1202	!
1203	!-- Check bottom boundary condition in case of surface emissions
1204	IF ( salsa_emission_mode /= 'no_emission' .AND. ibc_salsa_b == 0 ) THEN
1205	message_string = 'salsa_emission_mode /= "no_emission" requires bc_salsa_b = "Neumann"'
1206	CALL message( 'salsa_check_parameters','PA0598', 1, 2, 0, 6, 0 )
1207	ENDIF
1208	!
1209	!-- Check whether emissions are applied
1210	IF ( salsa_emission_mode /= 'no_emission' ) include_emission = .TRUE.
1211	!
1212	!-- Set the initialisation type: background concentration are read from PIDS_DYNAMIC if
1213	!-- initializing_actions = 'inifor set_constant_profiles'
1214	IF ( INDEX( initializing_actions, 'inifor' ) /= 0 ) THEN
1215	init_aerosol_type = 1
1216	init_gases_type = 1
1217	ENDIF
1218	!
1219	!-- If the run is not a restart run, set read_restart_data to .FALSE.
1220	IF ( TRIM( initializing_actions ) /= 'read_restart_data' ) THEN
1221	read_restart_data_salsa = .FALSE.
1222	ENDIF
1223
1224	END SUBROUTINE salsa_check_parameters
1225
1226	!------------------------------------------------------------------------------!
1227	!
1228	! Description:
1229	! ------------
1230	!> Subroutine defining appropriate grid for netcdf variables.
1231	!> It is called out from subroutine netcdf.
1232	!> Same grid as for other scalars (see netcdf_interface_mod.f90)
1233	!------------------------------------------------------------------------------!
1234	SUBROUTINE salsa_define_netcdf_grid( var, found, grid_x, grid_y, grid_z )
1235
1236	IMPLICIT NONE
1237
1238	CHARACTER(LEN=*), INTENT(OUT) :: grid_x !<
1239	CHARACTER(LEN=*), INTENT(OUT) :: grid_y !<
1240	CHARACTER(LEN=*), INTENT(OUT) :: grid_z !<
1241	CHARACTER(LEN=*), INTENT(IN) :: var !<
1242
1243	LOGICAL, INTENT(OUT) :: found !<
1244
1245	found = .TRUE.
1246	!
1247	!-- Check for the grid
1248
1249	IF ( var(1:6) == 'salsa_' ) THEN ! same grid for all salsa output variables
1250	grid_x = 'x'
1251	grid_y = 'y'
1252	grid_z = 'zu'
1253	ELSE
1254	found = .FALSE.
1255	grid_x = 'none'
1256	grid_y = 'none'
1257	grid_z = 'none'
1258	ENDIF
1259
1260	END SUBROUTINE salsa_define_netcdf_grid
1261
1262	!------------------------------------------------------------------------------!
1263	! Description:
1264	! ------------
1265	!> Header output for new module
1266	!------------------------------------------------------------------------------!
1267	SUBROUTINE salsa_header( io )
1268
1269	USE indices, &
1270	ONLY: nx, ny, nz
1271
1272	IMPLICIT NONE
1273
1274	INTEGER(iwp), INTENT(IN) :: io !< Unit of the output file
1275	!
1276	!-- Write SALSA header
1277	WRITE( io, 1 )
1278	WRITE( io, 2 ) skip_time_do_salsa
1279	WRITE( io, 3 ) dt_salsa
1280	WRITE( io, 4 ) nz, ny, nx, nbins_aerosol
1281	IF ( advect_particle_water ) THEN
1282	WRITE( io, 5 ) nz, ny, nx, ncomponents_mass*nbins_aerosol, advect_particle_water
1283	ELSE
1284	WRITE( io, 5 ) nz, ny, nx, ncc*nbins_aerosol, advect_particle_water
1285	ENDIF
1286	IF ( .NOT. salsa_gases_from_chem ) THEN
1287	WRITE( io, 6 ) nz, ny, nx, ngases_salsa, salsa_gases_from_chem
1288	ENDIF
1289	WRITE( io, 7 )
1290	IF ( nsnucl > 0 ) WRITE( io, 8 ) nsnucl, nj3
1291	IF ( nlcoag ) WRITE( io, 9 )
1292	IF ( nlcnd ) WRITE( io, 10 ) nlcndgas, nlcndh2oae
1293	IF ( lspartition ) WRITE( io, 11 )
1294	IF ( nldepo ) WRITE( io, 12 ) nldepo_pcm, nldepo_surf
1295	WRITE( io, 13 ) reglim, nbin, ( aero(:)%vlolim / api6 )**0.33333333_wp
1296	WRITE( io, 25 ) aero(:)%dmid
1297	IF ( init_aerosol_type == 0 ) WRITE( io, 14 ) nsect
1298	WRITE( io, 15 ) ncc, listspec, mass_fracs_a, mass_fracs_b
1299	IF ( .NOT. salsa_gases_from_chem ) THEN
1300	WRITE( io, 16 ) ngases_salsa, h2so4_init, hno3_init, nh3_init, ocnv_init, ocsv_init
1301	ENDIF
1302	WRITE( io, 17 ) init_aerosol_type, init_gases_type
1303	IF ( init_aerosol_type == 0 ) THEN
1304	WRITE( io, 18 ) dpg, sigmag, n_lognorm
1305	ELSE
1306	WRITE( io, 19 )
1307	ENDIF
1308	IF ( nesting_salsa ) WRITE( io, 20 ) nesting_salsa
1309	IF ( nesting_offline_salsa ) WRITE( io, 21 ) nesting_offline_salsa
1310	WRITE( io, 22 ) salsa_emission_mode
1311	IF ( salsa_emission_mode == 'uniform' ) THEN
1312	WRITE( io, 23 ) surface_aerosol_flux, aerosol_flux_dpg, aerosol_flux_sigmag, &
1313	aerosol_flux_mass_fracs_a
1314	ENDIF
1315	IF ( SUM( aerosol_flux_mass_fracs_b ) > 0.0_wp .OR. salsa_emission_mode == 'read_from_file' ) &
1316	THEN
1317	WRITE( io, 24 )
1318	ENDIF
1319
1320	1 FORMAT (//' SALSA information:'/ &
1321	' ------------------------------'/)
1322	2 FORMAT (' Starts at: skip_time_do_salsa = ', F10.2, ' s')
1323	3 FORMAT (/' Timestep: dt_salsa = ', F6.2, ' s')
1324	4 FORMAT (/' Array shape (z,y,x,bins):'/ &
1325	' aerosol_number: ', 4(I5))
1326	5 FORMAT (/' aerosol_mass: ', 4(I5),/ &
1327	' (advect_particle_water = ', L1, ')')
1328	6 FORMAT (' salsa_gas: ', 4(I5),/ &
1329	' (salsa_gases_from_chem = ', L1, ')')
1330	7 FORMAT (/' Aerosol dynamic processes included: ')
1331	8 FORMAT (/' nucleation (scheme = ', I1, ' and J3 parametrization = ', I1, ')')
1332	9 FORMAT (/' coagulation')
1333	10 FORMAT (/' condensation (of precursor gases = ', L1, ' and water vapour = ', L1, ')' )
1334	11 FORMAT (/' dissolutional growth by HNO3 and NH3')
1335	12 FORMAT (/' dry deposition (on vegetation = ', L1, ' and on topography = ', L1, ')')
1336	13 FORMAT (/' Aerosol bin subrange limits (in metres): ', 3(ES10.2E3), / &
1337	' Number of size bins for each aerosol subrange: ', 2I3,/ &
1338	' Aerosol bin lower limits (in metres): ', 12(ES10.2E3))
1339	25 FORMAT (/' Bin geometric mean diameters (in metres): ', 12(ES10.2E3))
1340	14 FORMAT (' Initial number concentration in bins at the lowest level (#/m**3):', 9(ES10.2E3))
1341	15 FORMAT (/' Number of chemical components used: ', I1,/ &
1342	' Species: ',7(A6),/ &
1343	' Initial relative contribution of each species to particle volume in:',/ &
1344	' a-bins: ', 7(F6.3),/ &
1345	' b-bins: ', 7(F6.3))
1346	16 FORMAT (/' Number of gaseous tracers used: ', I1,/ &
1347	' Initial gas concentrations:',/ &
1348	' H2SO4: ',ES12.4E3, ' #/m**3',/ &
1349	' HNO3: ',ES12.4E3, ' #/m**3',/ &
1350	' NH3: ',ES12.4E3, ' #/m**3',/ &
1351	' OCNV: ',ES12.4E3, ' #/m**3',/ &
1352	' OCSV: ',ES12.4E3, ' #/m**3')
1353	17 FORMAT (/' Initialising concentrations: ', / &
1354	' Aerosol size distribution: init_aerosol_type = ', I1,/ &
1355	' Gas concentrations: init_gases_type = ', I1 )
1356	18 FORMAT ( ' Mode diametres: dpg(nmod) = ', 7(F7.3), ' (m)', / &
1357	' Standard deviation: sigmag(nmod) = ', 7(F7.2),/ &
1358	' Number concentration: n_lognorm(nmod) = ', 7(ES12.4E3), ' (#/m3)' )
1359	19 FORMAT (/' Size distribution read from a file.')
1360	20 FORMAT (/' Nesting for salsa variables: ', L1 )
1361	21 FORMAT (/' Offline nesting for salsa variables: ', L1 )
1362	22 FORMAT (/' Emissions: salsa_emission_mode = ', A )
1363	23 FORMAT (/' surface_aerosol_flux = ', ES12.4E3, ' #/m**2/s', / &
1364	' aerosol_flux_dpg = ', 7(F7.3), ' (m)', / &
1365	' aerosol_flux_sigmag = ', 7(F7.2), / &
1366	' aerosol_mass_fracs_a = ', 7(ES12.4E3) )
1367	24 FORMAT (/' (currently all emissions are soluble!)')
1368
1369	END SUBROUTINE salsa_header
1370
1371	!------------------------------------------------------------------------------!
1372	! Description:
1373	! ------------
1374	!> Allocate SALSA arrays and define pointers if required
1375	!------------------------------------------------------------------------------!
1376	SUBROUTINE salsa_init_arrays
1377
1378	USE advec_ws, &
1379	ONLY: ws_init_flags_scalar
1380
1381	USE surface_mod, &
1382	ONLY: surf_def_h, surf_def_v, surf_lsm_h, surf_lsm_v, surf_usm_h, surf_usm_v
1383
1384	IMPLICIT NONE
1385
1386	INTEGER(iwp) :: gases_available !< Number of available gas components in the chemistry model
1387	INTEGER(iwp) :: i !< loop index for allocating
1388	INTEGER(iwp) :: ii !< index for indexing chemical components
1389	INTEGER(iwp) :: l !< loop index for allocating: surfaces
1390	INTEGER(iwp) :: lsp !< loop index for chem species in the chemistry model
1391
1392	gases_available = 0
1393	!
1394	!-- Allocate prognostic variables (see salsa_swap_timelevel)
1395	!
1396	!-- Set derived indices:
1397	!-- (This does the same as the subroutine salsa_initialize in SALSA/UCLALES-SALSA)
1398	start_subrange_1a = 1 ! 1st index of subrange 1a
1399	start_subrange_2a = start_subrange_1a + nbin(1) ! 1st index of subrange 2a
1400	end_subrange_1a = start_subrange_2a - 1 ! last index of subrange 1a
1401	end_subrange_2a = end_subrange_1a + nbin(2) ! last index of subrange 2a
1402
1403	!
1404	!-- If the fraction of insoluble aerosols in subrange 2 is zero: do not allocate arrays for them
1405	IF ( nf2a > 0.999999_wp .AND. SUM( mass_fracs_b ) < 0.00001_wp ) THEN
1406	no_insoluble = .TRUE.
1407	start_subrange_2b = end_subrange_2a+1 ! 1st index of subrange 2b
1408	end_subrange_2b = end_subrange_2a ! last index of subrange 2b
1409	ELSE
1410	start_subrange_2b = start_subrange_2a + nbin(2) ! 1st index of subrange 2b
1411	end_subrange_2b = end_subrange_2a + nbin(2) ! last index of subrange 2b
1412	ENDIF
1413
1414	nbins_aerosol = end_subrange_2b ! total number of aerosol size bins
1415	!
1416	!-- Create index tables for different aerosol components
1417	CALL component_index_constructor( prtcl, ncc, maxspec, listspec )
1418
1419	ncomponents_mass = ncc
1420	IF ( advect_particle_water ) ncomponents_mass = ncc + 1 ! Add water
1421	!
1422	!-- Indices for chemical components used (-1 = not used)
1423	ii = 0
1424	IF ( is_used( prtcl, 'SO4' ) ) THEN
1425	index_so4 = get_index( prtcl,'SO4' )
1426	ii = ii + 1
1427	ENDIF
1428	IF ( is_used( prtcl,'OC' ) ) THEN
1429	index_oc = get_index(prtcl, 'OC')
1430	ii = ii + 1
1431	ENDIF
1432	IF ( is_used( prtcl, 'BC' ) ) THEN
1433	index_bc = get_index( prtcl, 'BC' )
1434	ii = ii + 1
1435	ENDIF
1436	IF ( is_used( prtcl, 'DU' ) ) THEN
1437	index_du = get_index( prtcl, 'DU' )
1438	ii = ii + 1
1439	ENDIF
1440	IF ( is_used( prtcl, 'SS' ) ) THEN
1441	index_ss = get_index( prtcl, 'SS' )
1442	ii = ii + 1
1443	ENDIF
1444	IF ( is_used( prtcl, 'NO' ) ) THEN
1445	index_no = get_index( prtcl, 'NO' )
1446	ii = ii + 1
1447	ENDIF
1448	IF ( is_used( prtcl, 'NH' ) ) THEN
1449	index_nh = get_index( prtcl, 'NH' )
1450	ii = ii + 1
1451	ENDIF
1452	!
1453	!-- All species must be known
1454	IF ( ii /= ncc ) THEN
1455	message_string = 'Unknown aerosol species/component(s) given in the initialization'
1456	CALL message( 'salsa_mod: salsa_init', 'PA0600', 1, 2, 0, 6, 0 )
1457	ENDIF
1458	!
1459	!-- Allocate:
1460	ALLOCATE( aero(nbins_aerosol), bc_am_t_val(nbins_aerosol*ncomponents_mass), &
1461	bc_an_t_val(nbins_aerosol), bc_gt_t_val(ngases_salsa), bin_low_limits(nbins_aerosol),&
1462	nsect(nbins_aerosol), massacc(nbins_aerosol) )
1463	ALLOCATE( k_topo_top(nysg:nyng,nxlg:nxrg) )
1464	IF ( nldepo ) ALLOCATE( sedim_vd(nzb:nzt+1,nysg:nyng,nxlg:nxrg,nbins_aerosol) )
1465	ALLOCATE( ra_dry(nzb:nzt+1,nysg:nyng,nxlg:nxrg,nbins_aerosol) )
1466	!
1467	!-- Initialise the sectional particle size distribution
1468	CALL set_sizebins
1469	!
1470	!-- Aerosol number concentration
1471	ALLOCATE( aerosol_number(nbins_aerosol) )
1472	ALLOCATE( nconc_1(nzb:nzt+1,nysg:nyng,nxlg:nxrg,nbins_aerosol), &
1473	nconc_2(nzb:nzt+1,nysg:nyng,nxlg:nxrg,nbins_aerosol), &
1474	nconc_3(nzb:nzt+1,nysg:nyng,nxlg:nxrg,nbins_aerosol) )
1475	nconc_1 = 0.0_wp
1476	nconc_2 = 0.0_wp
1477	nconc_3 = 0.0_wp
1478
1479	DO i = 1, nbins_aerosol
1480	aerosol_number(i)%conc(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => nconc_1(:,:,:,i)
1481	aerosol_number(i)%conc_p(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => nconc_2(:,:,:,i)
1482	aerosol_number(i)%tconc_m(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => nconc_3(:,:,:,i)
1483	ALLOCATE( aerosol_number(i)%flux_s(nzb+1:nzt,0:threads_per_task-1), &
1484	aerosol_number(i)%diss_s(nzb+1:nzt,0:threads_per_task-1), &
1485	aerosol_number(i)%flux_l(nzb+1:nzt,nys:nyn,0:threads_per_task-1), &
1486	aerosol_number(i)%diss_l(nzb+1:nzt,nys:nyn,0:threads_per_task-1), &
1487	aerosol_number(i)%init(nzb:nzt+1), &
1488	aerosol_number(i)%sums_ws_l(nzb:nzt+1,0:threads_per_task-1) )
1489	aerosol_number(i)%init = nclim
1490	IF ( include_emission .OR. ( nldepo .AND. nldepo_surf ) ) THEN
1491	ALLOCATE( aerosol_number(i)%source(nys:nyn,nxl:nxr) )
1492	aerosol_number(i)%source = 0.0_wp
1493	ENDIF
1494	ENDDO
1495
1496	!
1497	!-- Aerosol mass concentration
1498	ALLOCATE( aerosol_mass(ncomponents_mass*nbins_aerosol) )
1499	ALLOCATE( mconc_1(nzb:nzt+1,nysg:nyng,nxlg:nxrg,ncomponents_mass*nbins_aerosol), &
1500	mconc_2(nzb:nzt+1,nysg:nyng,nxlg:nxrg,ncomponents_mass*nbins_aerosol), &
1501	mconc_3(nzb:nzt+1,nysg:nyng,nxlg:nxrg,ncomponents_mass*nbins_aerosol) )
1502	mconc_1 = 0.0_wp
1503	mconc_2 = 0.0_wp
1504	mconc_3 = 0.0_wp
1505
1506	DO i = 1, ncomponents_mass*nbins_aerosol
1507	aerosol_mass(i)%conc(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => mconc_1(:,:,:,i)
1508	aerosol_mass(i)%conc_p(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => mconc_2(:,:,:,i)
1509	aerosol_mass(i)%tconc_m(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => mconc_3(:,:,:,i)
1510	ALLOCATE( aerosol_mass(i)%flux_s(nzb+1:nzt,0:threads_per_task-1), &
1511	aerosol_mass(i)%diss_s(nzb+1:nzt,0:threads_per_task-1), &
1512	aerosol_mass(i)%flux_l(nzb+1:nzt,nys:nyn,0:threads_per_task-1), &
1513	aerosol_mass(i)%diss_l(nzb+1:nzt,nys:nyn,0:threads_per_task-1), &
1514	aerosol_mass(i)%init(nzb:nzt+1), &
1515	aerosol_mass(i)%sums_ws_l(nzb:nzt+1,0:threads_per_task-1) )
1516	aerosol_mass(i)%init = mclim
1517	IF ( include_emission .OR. ( nldepo .AND. nldepo_surf ) ) THEN
1518	ALLOCATE( aerosol_mass(i)%source(nys:nyn,nxl:nxr) )
1519	aerosol_mass(i)%source = 0.0_wp
1520	ENDIF
1521	ENDDO
1522
1523	!
1524	!-- Surface fluxes: answs = aerosol number, amsws = aerosol mass
1525	!
1526	!-- Horizontal surfaces: default type
1527	DO l = 0, 2 ! upward (l=0), downward (l=1) and model top (l=2)
1528	ALLOCATE( surf_def_h(l)%answs( 1:surf_def_h(l)%ns, nbins_aerosol ) )
1529	ALLOCATE( surf_def_h(l)%amsws( 1:surf_def_h(l)%ns, nbins_aerosol*ncomponents_mass ) )
1530	surf_def_h(l)%answs = 0.0_wp
1531	surf_def_h(l)%amsws = 0.0_wp
1532	ENDDO
1533	!
1534	!-- Horizontal surfaces: natural type
1535	ALLOCATE( surf_lsm_h%answs( 1:surf_lsm_h%ns, nbins_aerosol ) )
1536	ALLOCATE( surf_lsm_h%amsws( 1:surf_lsm_h%ns, nbins_aerosol*ncomponents_mass ) )
1537	surf_lsm_h%answs = 0.0_wp
1538	surf_lsm_h%amsws = 0.0_wp
1539	!
1540	!-- Horizontal surfaces: urban type
1541	ALLOCATE( surf_usm_h%answs( 1:surf_usm_h%ns, nbins_aerosol ) )
1542	ALLOCATE( surf_usm_h%amsws( 1:surf_usm_h%ns, nbins_aerosol*ncomponents_mass ) )
1543	surf_usm_h%answs = 0.0_wp
1544	surf_usm_h%amsws = 0.0_wp
1545
1546	!
1547	!-- Vertical surfaces: northward (l=0), southward (l=1), eastward (l=2) and westward (l=3) facing
1548	DO l = 0, 3
1549	ALLOCATE( surf_def_v(l)%answs( 1:surf_def_v(l)%ns, nbins_aerosol ) )
1550	surf_def_v(l)%answs = 0.0_wp
1551	ALLOCATE( surf_def_v(l)%amsws( 1:surf_def_v(l)%ns, nbins_aerosol*ncomponents_mass ) )
1552	surf_def_v(l)%amsws = 0.0_wp
1553
1554	ALLOCATE( surf_lsm_v(l)%answs( 1:surf_lsm_v(l)%ns, nbins_aerosol ) )
1555	surf_lsm_v(l)%answs = 0.0_wp
1556	ALLOCATE( surf_lsm_v(l)%amsws( 1:surf_lsm_v(l)%ns, nbins_aerosol*ncomponents_mass ) )
1557	surf_lsm_v(l)%amsws = 0.0_wp
1558
1559	ALLOCATE( surf_usm_v(l)%answs( 1:surf_usm_v(l)%ns, nbins_aerosol ) )
1560	surf_usm_v(l)%answs = 0.0_wp
1561	ALLOCATE( surf_usm_v(l)%amsws( 1:surf_usm_v(l)%ns, nbins_aerosol*ncomponents_mass ) )
1562	surf_usm_v(l)%amsws = 0.0_wp
1563
1564	ENDDO
1565
1566	!
1567	!-- Concentration of gaseous tracers (1. SO4, 2. HNO3, 3. NH3, 4. OCNV, 5. OCSV)
1568	!-- (number concentration (#/m3) )
1569	!
1570	!-- If chemistry is on, read gas phase concentrations from there. Otherwise,
1571	!-- allocate salsa_gas array.
1572
1573	IF ( air_chemistry ) THEN
1574	DO lsp = 1, nvar
1575	SELECT CASE ( TRIM( chem_species(lsp)%name ) )
1576	CASE ( 'H2SO4', 'h2so4' )
1577	gases_available = gases_available + 1
1578	gas_index_chem(1) = lsp
1579	CASE ( 'HNO3', 'hno3' )
1580	gases_available = gases_available + 1
1581	gas_index_chem(2) = lsp
1582	CASE ( 'NH3', 'nh3' )
1583	gases_available = gases_available + 1
1584	gas_index_chem(3) = lsp
1585	CASE ( 'OCNV', 'ocnv' )
1586	gases_available = gases_available + 1
1587	gas_index_chem(4) = lsp
1588	CASE ( 'OCSV', 'ocsv' )
1589	gases_available = gases_available + 1
1590	gas_index_chem(5) = lsp
1591	END SELECT
1592	ENDDO
1593
1594	IF ( gases_available == ngases_salsa ) THEN
1595	salsa_gases_from_chem = .TRUE.
1596	ELSE
1597	WRITE( message_string, * ) 'SALSA is run together with chemistry but not all gaseous '// &
1598	'components are provided by kpp (H2SO4, HNO3, NH3, OCNV, OCSV)'
1599	CALL message( 'check_parameters', 'PA0599', 1, 2, 0, 6, 0 )
1600	ENDIF
1601
1602	ELSE
1603
1604	ALLOCATE( salsa_gas(ngases_salsa) )
1605	ALLOCATE( gconc_1(nzb:nzt+1,nysg:nyng,nxlg:nxrg,ngases_salsa), &
1606	gconc_2(nzb:nzt+1,nysg:nyng,nxlg:nxrg,ngases_salsa), &
1607	gconc_3(nzb:nzt+1,nysg:nyng,nxlg:nxrg,ngases_salsa) )
1608	gconc_1 = 0.0_wp
1609	gconc_2 = 0.0_wp
1610	gconc_3 = 0.0_wp
1611
1612	DO i = 1, ngases_salsa
1613	salsa_gas(i)%conc(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => gconc_1(:,:,:,i)
1614	salsa_gas(i)%conc_p(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => gconc_2(:,:,:,i)
1615	salsa_gas(i)%tconc_m(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => gconc_3(:,:,:,i)
1616	ALLOCATE( salsa_gas(i)%flux_s(nzb+1:nzt,0:threads_per_task-1), &
1617	salsa_gas(i)%diss_s(nzb+1:nzt,0:threads_per_task-1), &
1618	salsa_gas(i)%flux_l(nzb+1:nzt,nys:nyn,0:threads_per_task-1),&
1619	salsa_gas(i)%diss_l(nzb+1:nzt,nys:nyn,0:threads_per_task-1),&
1620	salsa_gas(i)%init(nzb:nzt+1), &
1621	salsa_gas(i)%sums_ws_l(nzb:nzt+1,0:threads_per_task-1) )
1622	salsa_gas(i)%init = nclim
1623	IF ( include_emission ) THEN
1624	ALLOCATE( salsa_gas(i)%source(nys:nys,nxl:nxr) )
1625	salsa_gas(i)%source = 0.0_wp
1626	ENDIF
1627	ENDDO
1628	!
1629	!-- Surface fluxes: gtsws = gaseous tracer flux
1630	!
1631	!-- Horizontal surfaces: default type
1632	DO l = 0, 2 ! upward (l=0), downward (l=1) and model top (l=2)
1633	ALLOCATE( surf_def_h(l)%gtsws( 1:surf_def_h(l)%ns, ngases_salsa ) )
1634	surf_def_h(l)%gtsws = 0.0_wp
1635	ENDDO
1636	!-- Horizontal surfaces: natural type
1637	ALLOCATE( surf_lsm_h%gtsws( 1:surf_lsm_h%ns, ngases_salsa ) )
1638	surf_lsm_h%gtsws = 0.0_wp
1639	!-- Horizontal surfaces: urban type
1640	ALLOCATE( surf_usm_h%gtsws( 1:surf_usm_h%ns, ngases_salsa ) )
1641	surf_usm_h%gtsws = 0.0_wp
1642	!
1643	!-- Vertical surfaces: northward (l=0), southward (l=1), eastward (l=2) and
1644	!-- westward (l=3) facing
1645	DO l = 0, 3
1646	ALLOCATE( surf_def_v(l)%gtsws( 1:surf_def_v(l)%ns, ngases_salsa ) )
1647	surf_def_v(l)%gtsws = 0.0_wp
1648	ALLOCATE( surf_lsm_v(l)%gtsws( 1:surf_lsm_v(l)%ns, ngases_salsa ) )
1649	surf_lsm_v(l)%gtsws = 0.0_wp
1650	ALLOCATE( surf_usm_v(l)%gtsws( 1:surf_usm_v(l)%ns, ngases_salsa ) )
1651	surf_usm_v(l)%gtsws = 0.0_wp
1652	ENDDO
1653	ENDIF
1654
1655	IF ( ws_scheme_sca ) THEN
1656
1657	IF ( salsa ) THEN
1658	ALLOCATE( sums_salsa_ws_l(nzb:nzt+1,0:threads_per_task-1) )
1659	sums_salsa_ws_l = 0.0_wp
1660	ENDIF
1661
1662	ENDIF
1663	!
1664	!-- Set control flags for decycling only at lateral boundary cores. Within the inner cores the
1665	!-- decycle flag is set to .FALSE.. Even though it does not affect the setting of chemistry boundary
1666	!-- conditions, this flag is used to set advection control flags appropriately.
1667	decycle_salsa_lr = MERGE( decycle_salsa_lr, .FALSE., nxl == 0 .OR. nxr == nx )
1668	decycle_salsa_ns = MERGE( decycle_salsa_ns, .FALSE., nys == 0 .OR. nyn == ny )
1669	!
1670	!-- Decycling can be applied separately for aerosol variables, while wind and other scalars may have
1671	!-- cyclic or nested boundary conditions. However, large gradients near the boundaries may produce
1672	!-- stationary numerical oscillations near the lateral boundaries when a higher-order scheme is
1673	!-- applied near these boundaries. To get rid-off this, set-up additional flags that control the
1674	!-- order of the scalar advection scheme near the lateral boundaries for passive scalars with
1675	!-- decycling.
1676	IF ( scalar_advec == 'ws-scheme' ) THEN
1677	ALLOCATE( salsa_advc_flags_s(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
1678	!
1679	!-- In case of decycling, set Neuman boundary conditions for wall_flags_total_0 bit 31 instead of
1680	!-- cyclic boundary conditions. Bit 31 is used to identify extended degradation zones (please see
1681	!-- the following comment). Note, since several also other modules may access this bit but may
1682	!-- have other boundary conditions, the original value of wall_flags_total_0 bit 31 must not be
1683	!-- modified. Hence, store the boundary conditions directly on salsa_advc_flags_s.
1684	!-- salsa_advc_flags_s will be later overwritten in ws_init_flags_scalar and bit 31 won't be used
1685	!-- to control the numerical order.
1686	!-- Initialize with flag 31 only.
1687	salsa_advc_flags_s = 0
1688	salsa_advc_flags_s = MERGE( IBSET( salsa_advc_flags_s, 31 ), 0, BTEST( wall_flags_total_0, 31 ) )
1689
1690	IF ( decycle_salsa_ns ) THEN
1691	IF ( nys == 0 ) THEN
1692	DO i = 1, nbgp
1693	salsa_advc_flags_s(:,nys-i,:) = MERGE( IBSET( salsa_advc_flags_s(:,nys,:), 31 ), &
1694	IBCLR( salsa_advc_flags_s(:,nys,:), 31 ), &
1695	BTEST( salsa_advc_flags_s(:,nys,:), 31 ) )
1696	ENDDO
1697	ENDIF
1698	IF ( nyn == ny ) THEN
1699	DO i = 1, nbgp
1700	salsa_advc_flags_s(:,nyn+i,:) = MERGE( IBSET( salsa_advc_flags_s(:,nyn,:), 31 ), &
1701	IBCLR( salsa_advc_flags_s(:,nyn,:), 31 ), &
1702	BTEST( salsa_advc_flags_s(:,nyn,:), 31 ) )
1703	ENDDO
1704	ENDIF
1705	ENDIF
1706	IF ( decycle_salsa_lr ) THEN
1707	IF ( nxl == 0 ) THEN
1708	DO i = 1, nbgp
1709	salsa_advc_flags_s(:,:,nxl-i) = MERGE( IBSET( salsa_advc_flags_s(:,:,nxl), 31 ), &
1710	IBCLR( salsa_advc_flags_s(:,:,nxl), 31 ), &
1711	BTEST( salsa_advc_flags_s(:,:,nxl), 31 ) )
1712	ENDDO
1713	ENDIF
1714	IF ( nxr == nx ) THEN
1715	DO i = 1, nbgp
1716	salsa_advc_flags_s(:,:,nxr+i) = MERGE( IBSET( salsa_advc_flags_s(:,:,nxr), 31 ), &
1717	IBCLR( salsa_advc_flags_s(:,:,nxr), 31 ), &
1718	BTEST( salsa_advc_flags_s(:,:,nxr), 31 ) )
1719	ENDDO
1720	ENDIF
1721	ENDIF
1722	!
1723	!-- To initialise the advection flags appropriately, pass the boundary flags to
1724	!-- ws_init_flags_scalar. The last argument in ws_init_flags_scalar indicates that a passive
1725	!-- scalar is being treated and the horizontal advection terms are degraded already 2 grid points
1726	!-- before the lateral boundary. Also, extended degradation zones are applied, where
1727	!-- horizontal advection of scalars is discretised by the first-order scheme at all grid points
1728	!-- in the vicinity of buildings (<= 3 grid points). Even though no building is within the
1729	!-- numerical stencil, the first-order scheme is used. At fourth and fifth grid points, the order
1730	!-- of the horizontal advection scheme is successively upgraded.
1731	!-- These degradations of the advection scheme are done to avoid stationary numerical
1732	!-- oscillations, which are responsible for high concentration maxima that may appear e.g. under
1733	!-- shear-free stable conditions.
1734	CALL ws_init_flags_scalar( bc_dirichlet_l .OR. bc_radiation_l .OR. decycle_salsa_lr, &
1735	bc_dirichlet_n .OR. bc_radiation_n .OR. decycle_salsa_ns, &
1736	bc_dirichlet_r .OR. bc_radiation_r .OR. decycle_salsa_lr, &
1737	bc_dirichlet_s .OR. bc_radiation_s .OR. decycle_salsa_ns, &
1738	salsa_advc_flags_s, .TRUE. )
1739	ENDIF
1740
1741
1742	END SUBROUTINE salsa_init_arrays
1743
1744	!------------------------------------------------------------------------------!
1745	! Description:
1746	! ------------
1747	!> Initialization of SALSA. Based on salsa_initialize in UCLALES-SALSA.
1748	!> Subroutines salsa_initialize, SALSAinit and DiagInitAero in UCLALES-SALSA are
1749	!> also merged here.
1750	!------------------------------------------------------------------------------!
1751	SUBROUTINE salsa_init
1752
1753	IMPLICIT NONE
1754
1755	INTEGER(iwp) :: i !<
1756	INTEGER(iwp) :: ib !< loop index for aerosol number bins
1757	INTEGER(iwp) :: ic !< loop index for aerosol mass bins
1758	INTEGER(iwp) :: ig !< loop index for gases
1759	INTEGER(iwp) :: j !<
1760
1761	IF ( debug_output ) CALL debug_message( 'salsa_init', 'start' )
1762
1763	bin_low_limits = 0.0_wp
1764	k_topo_top = 0
1765	nsect = 0.0_wp
1766	massacc = 1.0_wp
1767	!
1768	!-- Initialise
1769	IF ( nldepo ) sedim_vd = 0.0_wp
1770
1771	IF ( .NOT. salsa_gases_from_chem ) THEN
1772	IF ( .NOT. read_restart_data_salsa ) THEN
1773	salsa_gas(1)%conc = h2so4_init
1774	salsa_gas(2)%conc = hno3_init
1775	salsa_gas(3)%conc = nh3_init
1776	salsa_gas(4)%conc = ocnv_init
1777	salsa_gas(5)%conc = ocsv_init
1778	ENDIF
1779	DO ig = 1, ngases_salsa
1780	salsa_gas(ig)%conc_p = 0.0_wp
1781	salsa_gas(ig)%tconc_m = 0.0_wp
1782	salsa_gas(ig)%flux_s = 0.0_wp
1783	salsa_gas(ig)%diss_s = 0.0_wp
1784	salsa_gas(ig)%flux_l = 0.0_wp
1785	salsa_gas(ig)%diss_l = 0.0_wp
1786	salsa_gas(ig)%sums_ws_l = 0.0_wp
1787	salsa_gas(ig)%conc_p = salsa_gas(ig)%conc
1788	ENDDO
1789	!
1790	!-- Set initial value for gas compound tracer
1791	salsa_gas(1)%init = h2so4_init
1792	salsa_gas(2)%init = hno3_init
1793	salsa_gas(3)%init = nh3_init
1794	salsa_gas(4)%init = ocnv_init
1795	salsa_gas(5)%init = ocsv_init
1796	ENDIF
1797	!
1798	!-- Aerosol radius in each bin: dry and wet (m)
1799	ra_dry = 1.0E-10_wp
1800	!
1801	!-- Initialise location-dependent aerosol size distributions and chemical compositions:
1802	CALL aerosol_init
1803
1804	!-- Initalisation run of SALSA + calculate the vertical top index of the topography
1805	DO i = nxl, nxr
1806	DO j = nys, nyn
1807
1808	k_topo_top(j,i) = MAXLOC( MERGE( 1, 0, BTEST( wall_flags_total_0(:,j,i), 12 ) ), &
1809	DIM = 1 ) - 1
1810
1811	CALL salsa_driver( i, j, 1 )
1812	CALL salsa_diagnostics( i, j )
1813	ENDDO
1814	ENDDO
1815
1816	DO ib = 1, nbins_aerosol
1817	aerosol_number(ib)%conc_p = aerosol_number(ib)%conc
1818	aerosol_number(ib)%tconc_m = 0.0_wp
1819	aerosol_number(ib)%flux_s = 0.0_wp
1820	aerosol_number(ib)%diss_s = 0.0_wp
1821	aerosol_number(ib)%flux_l = 0.0_wp
1822	aerosol_number(ib)%diss_l = 0.0_wp
1823	aerosol_number(ib)%sums_ws_l = 0.0_wp
1824	ENDDO
1825	DO ic = 1, ncomponents_mass*nbins_aerosol
1826	aerosol_mass(ic)%conc_p = aerosol_mass(ic)%conc
1827	aerosol_mass(ic)%tconc_m = 0.0_wp
1828	aerosol_mass(ic)%flux_s = 0.0_wp
1829	aerosol_mass(ic)%diss_s = 0.0_wp
1830	aerosol_mass(ic)%flux_l = 0.0_wp
1831	aerosol_mass(ic)%diss_l = 0.0_wp
1832	aerosol_mass(ic)%sums_ws_l = 0.0_wp
1833	ENDDO
1834	!
1835	!
1836	!-- Initialise the deposition scheme and surface types
1837	IF ( nldepo ) CALL init_deposition
1838
1839	IF ( include_emission ) THEN
1840	!
1841	!-- Read in and initialize emissions
1842	CALL salsa_emission_setup( .TRUE. )
1843	IF ( .NOT. salsa_gases_from_chem .AND. salsa_emission_mode == 'read_from_file' ) THEN
1844	CALL salsa_gas_emission_setup( .TRUE. )
1845	ENDIF
1846	ENDIF
1847	!
1848	!-- Partition and dissolutional growth by gaseous HNO3 and NH3
1849	IF ( index_no > 0 .AND. index_nh > 0 .AND. index_so4 > 0 ) lspartition = .TRUE.
1850
1851	IF ( debug_output ) CALL debug_message( 'salsa_init', 'end' )
1852
1853	END SUBROUTINE salsa_init
1854
1855	!------------------------------------------------------------------------------!
1856	! Description:
1857	! ------------
1858	!> Initializes particle size distribution grid by calculating size bin limits
1859	!> and mid-size for dry particles in each bin. Called from salsa_initialize
1860	!> (only at the beginning of simulation).
1861	!> Size distribution described using:
1862	!> 1) moving center method (subranges 1 and 2)
1863	!> (Jacobson, Atmos. Env., 31, 131-144, 1997)
1864	!> 2) fixed sectional method (subrange 3)
1865	!> Size bins in each subrange are spaced logarithmically
1866	!> based on given subrange size limits and bin number.
1867	!
1868	!> Mona changed 06/2017: Use geometric mean diameter to describe the mean
1869	!> particle diameter in a size bin, not the arithmeric mean which clearly
1870	!> overestimates the total particle volume concentration.
1871	!
1872	!> Coded by:
1873	!> Hannele Korhonen (FMI) 2005
1874	!> Harri Kokkola (FMI) 2006
1875	!
1876	!> Bug fixes for box model + updated for the new aerosol datatype:
1877	!> Juha Tonttila (FMI) 2014
1878	!------------------------------------------------------------------------------!
1879	SUBROUTINE set_sizebins
1880
1881	IMPLICIT NONE
1882
1883	INTEGER(iwp) :: cc !< running index
1884	INTEGER(iwp) :: dd !< running index
1885
1886	REAL(wp) :: ratio_d !< ratio of the upper and lower diameter of subranges
1887
1888	aero(:)%dwet = 1.0E-10_wp
1889	aero(:)%veqh2o = 1.0E-10_wp
1890	aero(:)%numc = nclim
1891	aero(:)%core = 1.0E-10_wp
1892	DO cc = 1, maxspec+1 ! 1:SO4, 2:OC, 3:BC, 4:DU, 5:SS, 6:NO, 7:NH, 8:H2O
1893	aero(:)%volc(cc) = 0.0_wp
1894	ENDDO
1895	!
1896	!-- vlolim&vhilim: min & max dry volumes [fxm]
1897	!-- dmid: bin mid dry diameter (m)
1898	!-- vratiolo&vratiohi: volume ratio between the center and low/high limit
1899	!
1900	!-- 1) Size subrange 1:
1901	ratio_d = reglim(2) / reglim(1) ! section spacing (m)
1902	DO cc = start_subrange_1a, end_subrange_1a
1903	aero(cc)%vlolim = api6 * ( reglim(1) * ratio_d( REAL( cc-1 ) / nbin(1) ) )3
1904	aero(cc)%vhilim = api6 * ( reglim(1) * ratio_d( REAL( cc ) / nbin(1) ) )3
1905	aero(cc)%dmid = SQRT( ( aero(cc)%vhilim / api6 )*0.33333333_wp &
1906	( aero(cc)%vlolim / api6 )**0.33333333_wp )
1907	aero(cc)%vratiohi = aero(cc)%vhilim / ( api6 * aero(cc)%dmid**3 )
1908	aero(cc)%vratiolo = aero(cc)%vlolim / ( api6 * aero(cc)%dmid**3 )
1909	ENDDO
1910	!
1911	!-- 2) Size subrange 2:
1912	!-- 2.1) Sub-subrange 2a: high hygroscopicity
1913	ratio_d = reglim(3) / reglim(2) ! section spacing
1914	DO dd = start_subrange_2a, end_subrange_2a
1915	cc = dd - start_subrange_2a
1916	aero(dd)%vlolim = api6 * ( reglim(2) * ratio_d( REAL( cc ) / nbin(2) ) )3
1917	aero(dd)%vhilim = api6 * ( reglim(2) * ratio_d( REAL( cc+1 ) / nbin(2) ) )3
1918	aero(dd)%dmid = SQRT( ( aero(dd)%vhilim / api6 )*0.33333333_wp &
1919	( aero(dd)%vlolim / api6 )**0.33333333_wp )
1920	aero(dd)%vratiohi = aero(dd)%vhilim / ( api6 * aero(dd)%dmid**3 )
1921	aero(dd)%vratiolo = aero(dd)%vlolim / ( api6 * aero(dd)%dmid**3 )
1922	ENDDO
1923	!
1924	!-- 2.2) Sub-subrange 2b: low hygroscopicity
1925	IF ( .NOT. no_insoluble ) THEN
1926	aero(start_subrange_2b:end_subrange_2b)%vlolim = aero(start_subrange_2a:end_subrange_2a)%vlolim
1927	aero(start_subrange_2b:end_subrange_2b)%vhilim = aero(start_subrange_2a:end_subrange_2a)%vhilim
1928	aero(start_subrange_2b:end_subrange_2b)%dmid = aero(start_subrange_2a:end_subrange_2a)%dmid
1929	aero(start_subrange_2b:end_subrange_2b)%vratiohi = aero(start_subrange_2a:end_subrange_2a)%vratiohi
1930	aero(start_subrange_2b:end_subrange_2b)%vratiolo = aero(start_subrange_2a:end_subrange_2a)%vratiolo
1931	ENDIF
1932	!
1933	!-- Initialize the wet diameter with the bin dry diameter to avoid numerical problems later
1934	aero(:)%dwet = aero(:)%dmid
1935	!
1936	!-- Save bin limits (lower diameter) to be delivered to PALM if needed
1937	DO cc = 1, nbins_aerosol
1938	bin_low_limits(cc) = ( aero(cc)%vlolim / api6 )**0.33333333_wp
1939	ENDDO
1940
1941	END SUBROUTINE set_sizebins
1942
1943	!------------------------------------------------------------------------------!
1944	! Description:
1945	! ------------
1946	!> Initilize altitude-dependent aerosol size distributions and compositions.
1947	!>
1948	!> Mona added 06/2017: Correct the number and mass concentrations by normalizing
1949	!< by the given total number and mass concentration.
1950	!>
1951	!> Tomi Raatikainen, FMI, 29.2.2016
1952	!------------------------------------------------------------------------------!
1953	SUBROUTINE aerosol_init
1954
1955	USE netcdf_data_input_mod, &
1956	ONLY: check_existence, close_input_file, get_dimension_length, &
1957	get_attribute, get_variable, &
1958	inquire_num_variables, inquire_variable_names, &
1959	open_read_file
1960
1961	IMPLICIT NONE
1962
1963	CHARACTER(LEN=25), DIMENSION(:), ALLOCATABLE :: cc_name !< chemical component name
1964	CHARACTER(LEN=100), DIMENSION(:), ALLOCATABLE :: var_names !< variable names
1965
1966	INTEGER(iwp) :: ee !< index: end
1967	INTEGER(iwp) :: i !< loop index: x-direction
1968	INTEGER(iwp) :: ib !< loop index: size bins
1969	INTEGER(iwp) :: ic !< loop index: chemical components
1970	INTEGER(iwp) :: id_dyn !< NetCDF id of PIDS_DYNAMIC_SALSA
1971	INTEGER(iwp) :: ig !< loop index: gases
1972	INTEGER(iwp) :: j !< loop index: y-direction
1973	INTEGER(iwp) :: k !< loop index: z-direction
1974	INTEGER(iwp) :: lod_aero !< level of detail of inital aerosol concentrations
1975	INTEGER(iwp) :: num_vars !< number of variables
1976	INTEGER(iwp) :: pr_nbins !< number of aerosol size bins in file
1977	INTEGER(iwp) :: pr_ncc !< number of aerosol chemical components in file
1978	INTEGER(iwp) :: pr_nz !< number of vertical grid-points in file
1979	INTEGER(iwp) :: prunmode !< running mode of SALSA
1980	INTEGER(iwp) :: ss !< index: start
1981
1982	INTEGER(iwp), DIMENSION(maxspec) :: cc_in2mod
1983
1984	LOGICAL :: netcdf_extend = .FALSE. !< Flag: netcdf file exists
1985
1986	REAL(wp) :: flag !< flag to mask topography grid points
1987
1988	REAL(wp), DIMENSION(nbins_aerosol) :: core !< size of the bin mid aerosol particle
1989
1990	REAL(wp), DIMENSION(0:nz+1) :: pnf2a !< number fraction in 2a
1991	REAL(wp), DIMENSION(0:nz+1) :: pmfoc1a !< mass fraction of OC in 1a
1992
1993	REAL(wp), DIMENSION(0:nz+1,nbins_aerosol) :: pndist !< vertical profile of size dist. (#/m3)
1994	REAL(wp), DIMENSION(0:nz+1,maxspec) :: pmf2a !< mass distributions in subrange 2a
1995	REAL(wp), DIMENSION(0:nz+1,maxspec) :: pmf2b !< mass distributions in subrange 2b
1996
1997	REAL(wp), DIMENSION(:), ALLOCATABLE :: pr_dmid !< vertical profile of aerosol bin diameters
1998	REAL(wp), DIMENSION(:), ALLOCATABLE :: pr_z !< z levels of profiles
1999
2000	REAL(wp), DIMENSION(:,:), ALLOCATABLE :: pr_mass_fracs_a !< mass fraction: a
2001	REAL(wp), DIMENSION(:,:), ALLOCATABLE :: pr_mass_fracs_b !< and b
2002
2003	cc_in2mod = 0
2004	prunmode = 1
2005	!
2006	!-- Bin mean aerosol particle volume (m3)
2007	core(1:nbins_aerosol) = api6 * aero(1:nbins_aerosol)%dmid**3
2008	!
2009	!-- Set concentrations to zero
2010	pndist(:,:) = 0.0_wp
2011	pnf2a(:) = nf2a
2012	pmf2a(:,:) = 0.0_wp
2013	pmf2b(:,:) = 0.0_wp
2014	pmfoc1a(:) = 0.0_wp
2015
2016	IF ( init_aerosol_type == 1 ) THEN
2017	!
2018	!-- Read input profiles from PIDS_DYNAMIC_SALSA
2019	#if defined( __netcdf )
2020	!
2021	!-- Location-dependent size distributions and compositions.
2022	INQUIRE( FILE = TRIM( input_file_dynamic ) // TRIM( coupling_char ), EXIST = netcdf_extend )
2023	IF ( netcdf_extend ) THEN
2024	!
2025	!-- Open file in read-only mode
2026	CALL open_read_file( TRIM( input_file_dynamic ) // TRIM( coupling_char ), id_dyn )
2027	!
2028	!-- At first, inquire all variable names
2029	CALL inquire_num_variables( id_dyn, num_vars )
2030	!
2031	!-- Allocate memory to store variable names
2032	ALLOCATE( var_names(1:num_vars) )
2033	CALL inquire_variable_names( id_dyn, var_names )
2034	!
2035	!-- Inquire vertical dimension and number of aerosol chemical components
2036	CALL get_dimension_length( id_dyn, pr_nz, 'z' )
2037	IF ( pr_nz /= nz ) THEN
2038	WRITE( message_string, * ) 'Number of inifor horizontal grid points does not match '//&
2039	'the number of numeric grid points.'
2040	CALL message( 'aerosol_init', 'PA0601', 1, 2, 0, 6, 0 )
2041	ENDIF
2042	CALL get_dimension_length( id_dyn, pr_ncc, 'composition_index' )
2043	!
2044	!-- Allocate memory
2045	ALLOCATE( pr_z(1:pr_nz), pr_mass_fracs_a(nzb:nzt+1,pr_ncc), &
2046	pr_mass_fracs_b(nzb:nzt+1,pr_ncc) )
2047	pr_mass_fracs_a = 0.0_wp
2048	pr_mass_fracs_b = 0.0_wp
2049	!
2050	!-- Read vertical levels
2051	CALL get_variable( id_dyn, 'z', pr_z )
2052	!
2053	!-- Read the names of chemical components
2054	IF ( check_existence( var_names, 'composition_name' ) ) THEN
2055	CALL get_variable( id_dyn, 'composition_name', cc_name, pr_ncc )
2056	ELSE
2057	WRITE( message_string, * ) 'Missing composition_name in ' // TRIM( input_file_dynamic )
2058	CALL message( 'aerosol_init', 'PA0655', 1, 2, 0, 6, 0 )
2059	ENDIF
2060	!
2061	!-- Define the index of each chemical component in the model
2062	DO ic = 1, pr_ncc
2063	SELECT CASE ( TRIM( cc_name(ic) ) )
2064	CASE ( 'H2SO4', 'SO4', 'h2so4', 'so4' )
2065	cc_in2mod(1) = ic
2066	CASE ( 'OC', 'oc' )
2067	cc_in2mod(2) = ic
2068	CASE ( 'BC', 'bc' )
2069	cc_in2mod(3) = ic
2070	CASE ( 'DU', 'du' )
2071	cc_in2mod(4) = ic
2072	CASE ( 'SS', 'ss' )
2073	cc_in2mod(5) = ic
2074	CASE ( 'HNO3', 'hno3', 'NO3', 'no3', 'NO', 'no' )
2075	cc_in2mod(6) = ic
2076	CASE ( 'NH3', 'nh3', 'NH4', 'nh4', 'NH', 'nh' )
2077	cc_in2mod(7) = ic
2078	END SELECT
2079	ENDDO
2080
2081	IF ( SUM( cc_in2mod ) == 0 ) THEN
2082	message_string = 'None of the aerosol chemical components in ' // TRIM( &
2083	input_file_dynamic ) // ' correspond to ones applied in SALSA.'
2084	CALL message( 'salsa_mod: aerosol_init', 'PA0602', 2, 2, 0, 6, 0 )
2085	ENDIF
2086	!
2087	!-- Vertical profiles of mass fractions of different chemical components:
2088	IF ( check_existence( var_names, 'init_atmosphere_mass_fracs_a' ) ) THEN
2089	CALL get_variable( id_dyn, 'init_atmosphere_mass_fracs_a', pr_mass_fracs_a, &
2090	0, pr_ncc-1, 0, pr_nz-1 )
2091	ELSE
2092	WRITE( message_string, * ) 'Missing init_atmosphere_mass_fracs_a in ' // &
2093	TRIM( input_file_dynamic )
2094	CALL message( 'aerosol_init', 'PA0656', 1, 2, 0, 6, 0 )
2095	ENDIF
2096	CALL get_variable( id_dyn, 'init_atmosphere_mass_fracs_b', pr_mass_fracs_b, &
2097	0, pr_ncc-1, 0, pr_nz-1 )
2098	!
2099	!-- Match the input data with the chemical composition applied in the model
2100	DO ic = 1, maxspec
2101	ss = cc_in2mod(ic)
2102	IF ( ss == 0 ) CYCLE
2103	pmf2a(nzb+1:nzt+1,ic) = pr_mass_fracs_a(nzb:nzt,ss)
2104	pmf2b(nzb+1:nzt+1,ic) = pr_mass_fracs_b(nzb:nzt,ss)
2105	ENDDO
2106	!
2107	!-- Aerosol concentrations: lod=1 (vertical profile of sectional number size distribution)
2108	CALL get_attribute( id_dyn, 'lod', lod_aero, .FALSE., 'init_atmosphere_aerosol' )
2109	IF ( lod_aero /= 1 ) THEN
2110	message_string = 'Currently only lod=1 accepted for init_atmosphere_aerosol'
2111	CALL message( 'salsa_mod: aerosol_init', 'PA0603', 2, 2, 0, 6, 0 )
2112	ELSE
2113	!
2114	!-- Bin mean diameters in the input file
2115	CALL get_dimension_length( id_dyn, pr_nbins, 'Dmid')
2116	IF ( pr_nbins /= nbins_aerosol ) THEN
2117	message_string = 'Number of size bins in init_atmosphere_aerosol does not match ' &
2118	// 'with that applied in the model'
2119	CALL message( 'salsa_mod: aerosol_init', 'PA0604', 2, 2, 0, 6, 0 )
2120	ENDIF
2121
2122	ALLOCATE( pr_dmid(pr_nbins) )
2123	pr_dmid = 0.0_wp
2124
2125	CALL get_variable( id_dyn, 'Dmid', pr_dmid )
2126	!
2127	!-- Check whether the sectional representation conform to the one
2128	!-- applied in the model
2129	IF ( ANY( ABS( ( aero(1:nbins_aerosol)%dmid - pr_dmid ) / &
2130	aero(1:nbins_aerosol)%dmid ) > 0.1_wp ) ) THEN
2131	message_string = 'Mean diameters of the aerosol size bins in ' // TRIM( &
2132	input_file_dynamic ) // ' do not match with the sectional '// &
2133	'representation of the model.'
2134	CALL message( 'salsa_mod: aerosol_init', 'PA0605', 2, 2, 0, 6, 0 )
2135	ENDIF
2136	!
2137	!-- Inital aerosol concentrations
2138	CALL get_variable( id_dyn, 'init_atmosphere_aerosol', pndist(nzb+1:nzt,:), &
2139	0, pr_nbins-1, 0, pr_nz-1 )
2140	ENDIF
2141	!
2142	!-- Set bottom and top boundary condition (Neumann)
2143	pmf2a(nzb,:) = pmf2a(nzb+1,:)
2144	pmf2a(nzt+1,:) = pmf2a(nzt,:)
2145	pmf2b(nzb,:) = pmf2b(nzb+1,:)
2146	pmf2b(nzt+1,:) = pmf2b(nzt,:)
2147	pndist(nzb,:) = pndist(nzb+1,:)
2148	pndist(nzt+1,:) = pndist(nzt,:)
2149
2150	IF ( index_so4 < 0 ) THEN
2151	pmf2a(:,1) = 0.0_wp
2152	pmf2b(:,1) = 0.0_wp
2153	ENDIF
2154	IF ( index_oc < 0 ) THEN
2155	pmf2a(:,2) = 0.0_wp
2156	pmf2b(:,2) = 0.0_wp
2157	ENDIF
2158	IF ( index_bc < 0 ) THEN
2159	pmf2a(:,3) = 0.0_wp
2160	pmf2b(:,3) = 0.0_wp
2161	ENDIF
2162	IF ( index_du < 0 ) THEN
2163	pmf2a(:,4) = 0.0_wp
2164	pmf2b(:,4) = 0.0_wp
2165	ENDIF
2166	IF ( index_ss < 0 ) THEN
2167	pmf2a(:,5) = 0.0_wp
2168	pmf2b(:,5) = 0.0_wp
2169	ENDIF
2170	IF ( index_no < 0 ) THEN
2171	pmf2a(:,6) = 0.0_wp
2172	pmf2b(:,6) = 0.0_wp
2173	ENDIF
2174	IF ( index_nh < 0 ) THEN
2175	pmf2a(:,7) = 0.0_wp
2176	pmf2b(:,7) = 0.0_wp
2177	ENDIF
2178
2179	IF ( SUM( pmf2a ) < 0.00001_wp .AND. SUM( pmf2b ) < 0.00001_wp ) THEN
2180	message_string = 'Error in initialising mass fractions of chemical components. ' // &
2181	'Check that all chemical components are included in parameter file!'
2182	CALL message( 'salsa_mod: aerosol_init', 'PA0606', 2, 2, 0, 6, 0 )
2183	ENDIF
2184	!
2185	!-- Then normalise the mass fraction so that SUM = 1
2186	DO k = nzb, nzt+1
2187	pmf2a(k,:) = pmf2a(k,:) / SUM( pmf2a(k,:) )
2188	IF ( SUM( pmf2b(k,:) ) > 0.0_wp ) pmf2b(k,:) = pmf2b(k,:) / SUM( pmf2b(k,:) )
2189	ENDDO
2190
2191	DEALLOCATE( pr_z, pr_mass_fracs_a, pr_mass_fracs_b )
2192	!
2193	!-- Close input file
2194	CALL close_input_file( id_dyn )
2195
2196	ELSE
2197	message_string = 'Input file '// TRIM( input_file_dynamic ) // TRIM( coupling_char ) // &
2198	' for SALSA missing!'
2199	CALL message( 'salsa_mod: aerosol_init', 'PA0607', 1, 2, 0, 6, 0 )
2200
2201	ENDIF ! netcdf_extend
2202
2203	#else
2204	message_string = 'init_aerosol_type = 1 but preprocessor directive __netcdf is not used '// &
2205	'in compiling!'
2206	CALL message( 'salsa_mod: aerosol_init', 'PA0608', 1, 2, 0, 6, 0 )
2207
2208	#endif
2209
2210	ELSEIF ( init_aerosol_type == 0 ) THEN
2211	!
2212	!-- Mass fractions for species in a and b-bins
2213	IF ( index_so4 > 0 ) THEN
2214	pmf2a(:,1) = mass_fracs_a(index_so4)
2215	pmf2b(:,1) = mass_fracs_b(index_so4)
2216	ENDIF
2217	IF ( index_oc > 0 ) THEN
2218	pmf2a(:,2) = mass_fracs_a(index_oc)
2219	pmf2b(:,2) = mass_fracs_b(index_oc)
2220	ENDIF
2221	IF ( index_bc > 0 ) THEN
2222	pmf2a(:,3) = mass_fracs_a(index_bc)
2223	pmf2b(:,3) = mass_fracs_b(index_bc)
2224	ENDIF
2225	IF ( index_du > 0 ) THEN
2226	pmf2a(:,4) = mass_fracs_a(index_du)
2227	pmf2b(:,4) = mass_fracs_b(index_du)
2228	ENDIF
2229	IF ( index_ss > 0 ) THEN
2230	pmf2a(:,5) = mass_fracs_a(index_ss)
2231	pmf2b(:,5) = mass_fracs_b(index_ss)
2232	ENDIF
2233	IF ( index_no > 0 ) THEN
2234	pmf2a(:,6) = mass_fracs_a(index_no)
2235	pmf2b(:,6) = mass_fracs_b(index_no)
2236	ENDIF
2237	IF ( index_nh > 0 ) THEN
2238	pmf2a(:,7) = mass_fracs_a(index_nh)
2239	pmf2b(:,7) = mass_fracs_b(index_nh)
2240	ENDIF
2241	DO k = nzb, nzt+1
2242	pmf2a(k,:) = pmf2a(k,:) / SUM( pmf2a(k,:) )
2243	IF ( SUM( pmf2b(k,:) ) > 0.0_wp ) pmf2b(k,:) = pmf2b(k,:) / SUM( pmf2b(k,:) )
2244	ENDDO
2245
2246	CALL size_distribution( n_lognorm, dpg, sigmag, nsect )
2247	!
2248	!-- Normalize by the given total number concentration
2249	nsect = nsect * SUM( n_lognorm ) / SUM( nsect )
2250	DO ib = start_subrange_1a, end_subrange_2b
2251	pndist(:,ib) = nsect(ib)
2252	ENDDO
2253	ENDIF
2254
2255	IF ( init_gases_type == 1 ) THEN
2256	!
2257	!-- Read input profiles from PIDS_CHEM
2258	#if defined( __netcdf )
2259	!
2260	!-- Location-dependent size distributions and compositions.
2261	INQUIRE( FILE = TRIM( input_file_dynamic ) // TRIM( coupling_char ), EXIST = netcdf_extend )
2262	IF ( netcdf_extend .AND. .NOT. salsa_gases_from_chem ) THEN
2263	!
2264	!-- Open file in read-only mode
2265	CALL open_read_file( TRIM( input_file_dynamic ) // TRIM( coupling_char ), id_dyn )
2266	!
2267	!-- Inquire dimensions:
2268	CALL get_dimension_length( id_dyn, pr_nz, 'z' )
2269	IF ( pr_nz /= nz ) THEN
2270	WRITE( message_string, * ) 'Number of inifor horizontal grid points does not match '//&
2271	'the number of numeric grid points.'
2272	CALL message( 'aerosol_init', 'PA0609', 1, 2, 0, 6, 0 )
2273	ENDIF
2274	!
2275	!-- Read vertical profiles of gases:
2276	CALL get_variable( id_dyn, 'init_atmosphere_H2SO4', salsa_gas(1)%init(nzb+1:nzt) )
2277	CALL get_variable( id_dyn, 'init_atmosphere_HNO3', salsa_gas(2)%init(nzb+1:nzt) )
2278	CALL get_variable( id_dyn, 'init_atmosphere_NH3', salsa_gas(3)%init(nzb+1:nzt) )
2279	CALL get_variable( id_dyn, 'init_atmosphere_OCNV', salsa_gas(4)%init(nzb+1:nzt) )
2280	CALL get_variable( id_dyn, 'init_atmosphere_OCSV', salsa_gas(5)%init(nzb+1:nzt) )
2281	!
2282	!-- Set Neumann top and surface boundary condition for initial + initialise concentrations
2283	DO ig = 1, ngases_salsa
2284	salsa_gas(ig)%init(nzb) = salsa_gas(ig)%init(nzb+1)
2285	salsa_gas(ig)%init(nzt+1) = salsa_gas(ig)%init(nzt)
2286	IF ( .NOT. read_restart_data_salsa ) THEN
2287	DO k = nzb, nzt+1
2288	salsa_gas(ig)%conc(k,:,:) = salsa_gas(ig)%init(k)
2289	ENDDO
2290	ENDIF
2291	ENDDO
2292	!
2293	!-- Close input file
2294	CALL close_input_file( id_dyn )
2295
2296	ELSEIF ( .NOT. netcdf_extend .AND. .NOT. salsa_gases_from_chem ) THEN
2297	message_string = 'Input file '// TRIM( input_file_dynamic ) // TRIM( coupling_char ) // &
2298	' for SALSA missing!'
2299	CALL message( 'salsa_mod: aerosol_init', 'PA0610', 1, 2, 0, 6, 0 )
2300
2301	ENDIF ! netcdf_extend
2302	#else
2303	message_string = 'init_gases_type = 1 but preprocessor directive __netcdf is not used in '//&
2304	'compiling!'
2305	CALL message( 'salsa_mod: aerosol_init', 'PA0611', 1, 2, 0, 6, 0 )
2306
2307	#endif
2308
2309	ENDIF
2310	!
2311	!-- Both SO4 and OC are included, so use the given mass fractions
2312	IF ( index_oc > 0 .AND. index_so4 > 0 ) THEN
2313	pmfoc1a(:) = pmf2a(:,2) / ( pmf2a(:,2) + pmf2a(:,1) ) ! Normalize
2314	!
2315	!-- Pure organic carbon
2316	ELSEIF ( index_oc > 0 ) THEN
2317	pmfoc1a(:) = 1.0_wp
2318	!
2319	!-- Pure SO4
2320	ELSEIF ( index_so4 > 0 ) THEN
2321	pmfoc1a(:) = 0.0_wp
2322
2323	ELSE
2324	message_string = 'Either OC or SO4 must be active for aerosol region 1a!'
2325	CALL message( 'salsa_mod: aerosol_init', 'PA0612', 1, 2, 0, 6, 0 )
2326	ENDIF
2327
2328	!
2329	!-- Initialize concentrations
2330	DO i = nxlg, nxrg
2331	DO j = nysg, nyng
2332	DO k = nzb, nzt+1
2333	!
2334	!-- Predetermine flag to mask topography
2335	flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) )
2336	!
2337	!-- a) Number concentrations
2338	!-- Region 1:
2339	DO ib = start_subrange_1a, end_subrange_1a
2340	IF ( .NOT. read_restart_data_salsa ) THEN
2341	aerosol_number(ib)%conc(k,j,i) = pndist(k,ib) * flag
2342	ENDIF
2343	IF ( prunmode == 1 ) THEN
2344	aerosol_number(ib)%init = pndist(:,ib)
2345	ENDIF
2346	ENDDO
2347	!
2348	!-- Region 2:
2349	IF ( nreg > 1 ) THEN
2350	DO ib = start_subrange_2a, end_subrange_2a
2351	IF ( .NOT. read_restart_data_salsa ) THEN
2352	aerosol_number(ib)%conc(k,j,i) = MAX( 0.0_wp, pnf2a(k) ) * pndist(k,ib) * flag
2353	ENDIF
2354	IF ( prunmode == 1 ) THEN
2355	aerosol_number(ib)%init = MAX( 0.0_wp, nf2a ) * pndist(:,ib)
2356	ENDIF
2357	ENDDO
2358	IF ( .NOT. no_insoluble ) THEN
2359	DO ib = start_subrange_2b, end_subrange_2b
2360	IF ( pnf2a(k) < 1.0_wp ) THEN
2361	IF ( .NOT. read_restart_data_salsa ) THEN
2362	aerosol_number(ib)%conc(k,j,i) = MAX( 0.0_wp, 1.0_wp - pnf2a(k) ) * &
2363	pndist(k,ib) * flag
2364	ENDIF
2365	IF ( prunmode == 1 ) THEN
2366	aerosol_number(ib)%init = MAX( 0.0_wp, 1.0_wp - nf2a ) * pndist(:,ib)
2367	ENDIF
2368	ENDIF
2369	ENDDO
2370	ENDIF
2371	ENDIF
2372	!
2373	!-- b) Aerosol mass concentrations
2374	!-- bin subrange 1: done here separately due to the SO4/OC convention
2375	!
2376	!-- SO4:
2377	IF ( index_so4 > 0 ) THEN
2378	ss = ( index_so4 - 1 ) * nbins_aerosol + start_subrange_1a !< start
2379	ee = ( index_so4 - 1 ) * nbins_aerosol + end_subrange_1a !< end
2380	ib = start_subrange_1a
2381	DO ic = ss, ee
2382	IF ( .NOT. read_restart_data_salsa ) THEN
2383	aerosol_mass(ic)%conc(k,j,i) = MAX( 0.0_wp, 1.0_wp - pmfoc1a(k) ) * &
2384	pndist(k,ib) * core(ib) * arhoh2so4 * flag
2385	ENDIF
2386	IF ( prunmode == 1 ) THEN
2387	aerosol_mass(ic)%init(k) = MAX( 0.0_wp, 1.0_wp - pmfoc1a(k) ) * pndist(k,ib) &
2388	* core(ib) * arhoh2so4
2389	ENDIF
2390	ib = ib+1
2391	ENDDO
2392	ENDIF
2393	!
2394	!-- OC:
2395	IF ( index_oc > 0 ) THEN
2396	ss = ( index_oc - 1 ) * nbins_aerosol + start_subrange_1a !< start
2397	ee = ( index_oc - 1 ) * nbins_aerosol + end_subrange_1a !< end
2398	ib = start_subrange_1a
2399	DO ic = ss, ee
2400	IF ( .NOT. read_restart_data_salsa ) THEN
2401	aerosol_mass(ic)%conc(k,j,i) = MAX( 0.0_wp, pmfoc1a(k) ) * pndist(k,ib) * &
2402	core(ib) * arhooc * flag
2403	ENDIF
2404	IF ( prunmode == 1 ) THEN
2405	aerosol_mass(ic)%init(k) = MAX( 0.0_wp, pmfoc1a(k) ) * pndist(k,ib) * &
2406	core(ib) * arhooc
2407	ENDIF
2408	ib = ib+1
2409	ENDDO
2410	ENDIF
2411	ENDDO !< k
2412
2413	prunmode = 3 ! Init only once
2414
2415	ENDDO !< j
2416	ENDDO !< i
2417
2418	!
2419	!-- c) Aerosol mass concentrations
2420	!-- bin subrange 2:
2421	IF ( nreg > 1 ) THEN
2422
2423	IF ( index_so4 > 0 ) THEN
2424	CALL set_aero_mass( index_so4, pmf2a(:,1), pmf2b(:,1), pnf2a, pndist, core, arhoh2so4 )
2425	ENDIF
2426	IF ( index_oc > 0 ) THEN
2427	CALL set_aero_mass( index_oc, pmf2a(:,2), pmf2b(:,2), pnf2a, pndist, core, arhooc )
2428	ENDIF
2429	IF ( index_bc > 0 ) THEN
2430	CALL set_aero_mass( index_bc, pmf2a(:,3), pmf2b(:,3), pnf2a, pndist, core, arhobc )
2431	ENDIF
2432	IF ( index_du > 0 ) THEN
2433	CALL set_aero_mass( index_du, pmf2a(:,4), pmf2b(:,4), pnf2a, pndist, core, arhodu )
2434	ENDIF
2435	IF ( index_ss > 0 ) THEN
2436	CALL set_aero_mass( index_ss, pmf2a(:,5), pmf2b(:,5), pnf2a, pndist, core, arhoss )
2437	ENDIF
2438	IF ( index_no > 0 ) THEN
2439	CALL set_aero_mass( index_no, pmf2a(:,6), pmf2b(:,6), pnf2a, pndist, core, arhohno3 )
2440	ENDIF
2441	IF ( index_nh > 0 ) THEN
2442	CALL set_aero_mass( index_nh, pmf2a(:,7), pmf2b(:,7), pnf2a, pndist, core, arhonh3 )
2443	ENDIF
2444
2445	ENDIF
2446
2447	END SUBROUTINE aerosol_init
2448
2449	!------------------------------------------------------------------------------!
2450	! Description:
2451	! ------------
2452	!> Create a lognormal size distribution and discretise to a sectional
2453	!> representation.
2454	!------------------------------------------------------------------------------!
2455	SUBROUTINE size_distribution( in_ntot, in_dpg, in_sigma, psd_sect )
2456
2457	IMPLICIT NONE
2458
2459	INTEGER(iwp) :: ib !< running index: bin
2460	INTEGER(iwp) :: iteration !< running index: iteration
2461
2462	REAL(wp) :: d1 !< particle diameter (m, dummy)
2463	REAL(wp) :: d2 !< particle diameter (m, dummy)
2464	REAL(wp) :: delta_d !< (d2-d1)/10
2465	REAL(wp) :: deltadp !< bin width
2466	REAL(wp) :: dmidi !< ( d1 + d2 ) / 2
2467
2468	REAL(wp), DIMENSION(:), INTENT(in) :: in_dpg !< geometric mean diameter (m)
2469	REAL(wp), DIMENSION(:), INTENT(in) :: in_ntot !< number conc. (#/m3)
2470	REAL(wp), DIMENSION(:), INTENT(in) :: in_sigma !< standard deviation
2471
2472	REAL(wp), DIMENSION(:), INTENT(inout) :: psd_sect !< sectional size distribution
2473
2474	DO ib = start_subrange_1a, end_subrange_2b
2475	psd_sect(ib) = 0.0_wp
2476	!
2477	!-- Particle diameter at the low limit (largest in the bin) (m)
2478	d1 = ( aero(ib)%vlolim / api6 )**0.33333333_wp
2479	!
2480	!-- Particle diameter at the high limit (smallest in the bin) (m)
2481	d2 = ( aero(ib)%vhilim / api6 )**0.33333333_wp
2482	!
2483	!-- Span of particle diameter in a bin (m)
2484	delta_d = 0.1_wp * ( d2 - d1 )
2485	!
2486	!-- Iterate:
2487	DO iteration = 1, 10
2488	d1 = ( aero(ib)%vlolim / api6 )*0.33333333_wp + ( ib - 1) delta_d
2489	d2 = d1 + delta_d
2490	dmidi = 0.5_wp * ( d1 + d2 )
2491	deltadp = LOG10( d2 / d1 )
2492	!
2493	!-- Size distribution
2494	!-- in_ntot = total number, total area, or total volume concentration
2495	!-- in_dpg = geometric-mean number, area, or volume diameter
2496	!-- n(k) = number, area, or volume concentration in a bin
2497	psd_sect(ib) = psd_sect(ib) + SUM( in_ntot * deltadp / ( SQRT( 2.0_wp * pi ) * &
2498	LOG10( in_sigma ) ) * EXP( -LOG10( dmidi / in_dpg )**2.0_wp / &
2499	( 2.0_wp * LOG10( in_sigma ) ** 2.0_wp ) ) )
2500
2501	ENDDO
2502	ENDDO
2503
2504	END SUBROUTINE size_distribution
2505
2506	!------------------------------------------------------------------------------!
2507	! Description:
2508	! ------------
2509	!> Sets the mass concentrations to aerosol arrays in 2a and 2b.
2510	!>
2511	!> Tomi Raatikainen, FMI, 29.2.2016
2512	!------------------------------------------------------------------------------!
2513	SUBROUTINE set_aero_mass( ispec, pmf2a, pmf2b, pnf2a, pndist, pcore, prho )
2514
2515	IMPLICIT NONE
2516
2517	INTEGER(iwp) :: ee !< index: end
2518	INTEGER(iwp) :: i !< loop index
2519	INTEGER(iwp) :: ib !< loop index
2520	INTEGER(iwp) :: ic !< loop index
2521	INTEGER(iwp) :: j !< loop index
2522	INTEGER(iwp) :: k !< loop index
2523	INTEGER(iwp) :: prunmode !< 1 = initialise
2524	INTEGER(iwp) :: ss !< index: start
2525
2526	INTEGER(iwp), INTENT(in) :: ispec !< Aerosol species index
2527
2528	REAL(wp) :: flag !< flag to mask topography grid points
2529
2530	REAL(wp), INTENT(in) :: prho !< Aerosol density
2531
2532	REAL(wp), DIMENSION(nbins_aerosol), INTENT(in) :: pcore !< Aerosol bin mid core volume
2533	REAL(wp), DIMENSION(0:nz+1), INTENT(in) :: pnf2a !< Number fraction for 2a
2534	REAL(wp), DIMENSION(0:nz+1), INTENT(in) :: pmf2a !< Mass distributions for a
2535	REAL(wp), DIMENSION(0:nz+1), INTENT(in) :: pmf2b !< and b bins
2536
2537	REAL(wp), DIMENSION(0:nz+1,nbins_aerosol), INTENT(in) :: pndist !< Aerosol size distribution
2538
2539	prunmode = 1
2540
2541	DO i = nxlg, nxrg
2542	DO j = nysg, nyng
2543	DO k = nzb, nzt+1
2544	!
2545	!-- Predetermine flag to mask topography
2546	flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) )
2547	!
2548	!-- Regime 2a:
2549	ss = ( ispec - 1 ) * nbins_aerosol + start_subrange_2a
2550	ee = ( ispec - 1 ) * nbins_aerosol + end_subrange_2a
2551	ib = start_subrange_2a
2552	DO ic = ss, ee
2553	IF ( .NOT. read_restart_data_salsa ) THEN
2554	aerosol_mass(ic)%conc(k,j,i) = MAX( 0.0_wp, pmf2a(k) ) * pnf2a(k) * pndist(k,ib)&
2555	* pcore(ib) * prho * flag
2556	ENDIF
2557	IF ( prunmode == 1 ) THEN
2558	aerosol_mass(ic)%init(k) = MAX( 0.0_wp, pmf2a(k) ) * pnf2a(k) * pndist(k,ib) * &
2559	pcore(ib) * prho
2560	ENDIF
2561	ib = ib + 1
2562	ENDDO
2563	!
2564	!-- Regime 2b:
2565	IF ( .NOT. no_insoluble ) THEN
2566	ss = ( ispec - 1 ) * nbins_aerosol + start_subrange_2b
2567	ee = ( ispec - 1 ) * nbins_aerosol + end_subrange_2b
2568	ib = start_subrange_2a
2569	DO ic = ss, ee
2570	IF ( .NOT. read_restart_data_salsa ) THEN
2571	aerosol_mass(ic)%conc(k,j,i) = MAX( 0.0_wp, pmf2b(k) ) * ( 1.0_wp - pnf2a(k))&
2572	* pndist(k,ib) * pcore(ib) * prho * flag
2573	ENDIF
2574	IF ( prunmode == 1 ) THEN
2575	aerosol_mass(ic)%init(k) = MAX( 0.0_wp, pmf2b(k) ) * ( 1.0_wp - pnf2a(k) ) * &
2576	pndist(k,ib) * pcore(ib) * prho
2577	ENDIF
2578	ib = ib + 1
2579	ENDDO ! c
2580
2581	ENDIF
2582	ENDDO ! k
2583
2584	prunmode = 3 ! Init only once
2585
2586	ENDDO ! j
2587	ENDDO ! i
2588
2589	END SUBROUTINE set_aero_mass
2590
2591	!------------------------------------------------------------------------------!
2592	! Description:
2593	! ------------
2594	!> Initialise the matching between surface types in LSM and deposition models.
2595	!> Do the matching based on Zhang et al. (2001). Atmos. Environ. 35, 549-560
2596	!> (here referred as Z01).
2597	!------------------------------------------------------------------------------!
2598	SUBROUTINE init_deposition
2599
2600	USE surface_mod, &
2601	ONLY: surf_lsm_h, surf_lsm_v, surf_usm_h, surf_usm_v
2602
2603	IMPLICIT NONE
2604
2605	INTEGER(iwp) :: l !< loop index for vertical surfaces
2606
2607	LOGICAL :: match_lsm !< flag to initilise LSM surfaces (if false, initialise USM surfaces)
2608
2609	IF ( depo_pcm_par == 'zhang2001' ) THEN
2610	depo_pcm_par_num = 1
2611	ELSEIF ( depo_pcm_par == 'petroff2010' ) THEN
2612	depo_pcm_par_num = 2
2613	ENDIF
2614
2615	IF ( depo_surf_par == 'zhang2001' ) THEN
2616	depo_surf_par_num = 1
2617	ELSEIF ( depo_surf_par == 'petroff2010' ) THEN
2618	depo_surf_par_num = 2
2619	ENDIF
2620	!
2621	!-- LSM: Pavement, vegetation and water
2622	IF ( nldepo_surf .AND. land_surface ) THEN
2623	match_lsm = .TRUE.
2624	ALLOCATE( lsm_to_depo_h%match_lupg(1:surf_lsm_h%ns), &
2625	lsm_to_depo_h%match_luvw(1:surf_lsm_h%ns), &
2626	lsm_to_depo_h%match_luww(1:surf_lsm_h%ns) )
2627	lsm_to_depo_h%match_lupg = 0
2628	lsm_to_depo_h%match_luvw = 0
2629	lsm_to_depo_h%match_luww = 0
2630	CALL match_sm_zhang( surf_lsm_h, lsm_to_depo_h%match_lupg, lsm_to_depo_h%match_luvw, &
2631	lsm_to_depo_h%match_luww, match_lsm )
2632	DO l = 0, 3
2633	ALLOCATE( lsm_to_depo_v(l)%match_lupg(1:surf_lsm_v(l)%ns), &
2634	lsm_to_depo_v(l)%match_luvw(1:surf_lsm_v(l)%ns), &
2635	lsm_to_depo_v(l)%match_luww(1:surf_lsm_v(l)%ns) )
2636	lsm_to_depo_v(l)%match_lupg = 0
2637	lsm_to_depo_v(l)%match_luvw = 0
2638	lsm_to_depo_v(l)%match_luww = 0
2639	CALL match_sm_zhang( surf_lsm_v(l), lsm_to_depo_v(l)%match_lupg, &
2640	lsm_to_depo_v(l)%match_luvw, lsm_to_depo_v(l)%match_luww, match_lsm )
2641	ENDDO
2642	ENDIF
2643	!
2644	!-- USM: Green roofs/walls, wall surfaces and windows
2645	IF ( nldepo_surf .AND. urban_surface ) THEN
2646	match_lsm = .FALSE.
2647	ALLOCATE( usm_to_depo_h%match_lupg(1:surf_usm_h%ns), &
2648	usm_to_depo_h%match_luvw(1:surf_usm_h%ns), &
2649	usm_to_depo_h%match_luww(1:surf_usm_h%ns) )
2650	usm_to_depo_h%match_lupg = 0
2651	usm_to_depo_h%match_luvw = 0
2652	usm_to_depo_h%match_luww = 0
2653	CALL match_sm_zhang( surf_usm_h, usm_to_depo_h%match_lupg, usm_to_depo_h%match_luvw, &
2654	usm_to_depo_h%match_luww, match_lsm )
2655	DO l = 0, 3
2656	ALLOCATE( usm_to_depo_v(l)%match_lupg(1:surf_usm_v(l)%ns), &
2657	usm_to_depo_v(l)%match_luvw(1:surf_usm_v(l)%ns), &
2658	usm_to_depo_v(l)%match_luww(1:surf_usm_v(l)%ns) )
2659	usm_to_depo_v(l)%match_lupg = 0
2660	usm_to_depo_v(l)%match_luvw = 0
2661	usm_to_depo_v(l)%match_luww = 0
2662	CALL match_sm_zhang( surf_usm_v(l), usm_to_depo_v(l)%match_lupg, &
2663	usm_to_depo_v(l)%match_luvw, usm_to_depo_v(l)%match_luww, match_lsm )
2664	ENDDO
2665	ENDIF
2666
2667	IF ( nldepo_pcm ) THEN
2668	SELECT CASE ( depo_pcm_type )
2669	CASE ( 'evergreen_needleleaf' )
2670	depo_pcm_type_num = 1
2671	CASE ( 'evergreen_broadleaf' )
2672	depo_pcm_type_num = 2
2673	CASE ( 'deciduous_needleleaf' )
2674	depo_pcm_type_num = 3
2675	CASE ( 'deciduous_broadleaf' )
2676	depo_pcm_type_num = 4
2677	CASE DEFAULT
2678	message_string = 'depo_pcm_type not set correctly.'
2679	CALL message( 'salsa_mod: init_deposition', 'PA0613', 1, 2, 0, 6, 0 )
2680	END SELECT
2681	ENDIF
2682
2683	END SUBROUTINE init_deposition
2684
2685	!------------------------------------------------------------------------------!
2686	! Description:
2687	! ------------
2688	!> Match the surface types in PALM and Zhang et al. 2001 deposition module
2689	!------------------------------------------------------------------------------!
2690	SUBROUTINE match_sm_zhang( surf, match_pav_green, match_veg_wall, match_wat_win, match_lsm )
2691
2692	USE surface_mod, &
2693	ONLY: ind_pav_green, ind_veg_wall, ind_wat_win, surf_type
2694
2695	IMPLICIT NONE
2696
2697	INTEGER(iwp) :: m !< index for surface elements
2698	INTEGER(iwp) :: pav_type_palm !< pavement / green wall type in PALM
2699	INTEGER(iwp) :: veg_type_palm !< vegetation / wall type in PALM
2700	INTEGER(iwp) :: wat_type_palm !< water / window type in PALM
2701
2702	INTEGER(iwp), DIMENSION(:), INTENT(inout) :: match_pav_green !< matching pavement/green walls
2703	INTEGER(iwp), DIMENSION(:), INTENT(inout) :: match_veg_wall !< matching vegetation/walls
2704	INTEGER(iwp), DIMENSION(:), INTENT(inout) :: match_wat_win !< matching water/windows
2705
2706	LOGICAL, INTENT(in) :: match_lsm !< flag to initilise LSM surfaces (if false, initialise USM)
2707
2708	TYPE(surf_type), INTENT(in) :: surf !< respective surface type
2709
2710	DO m = 1, surf%ns
2711	IF ( match_lsm ) THEN
2712	!
2713	!-- Vegetation (LSM):
2714	IF ( surf%frac(ind_veg_wall,m) > 0 ) THEN
2715	veg_type_palm = surf%vegetation_type(m)
2716	SELECT CASE ( veg_type_palm )
2717	CASE ( 0 )
2718	message_string = 'No vegetation type defined.'
2719	CALL message( 'salsa_mod: init_depo_surfaces', 'PA0614', 1, 2, 0, 6, 0 )
2720	CASE ( 1 ) ! bare soil
2721	match_veg_wall(m) = 6 ! grass in Z01
2722	CASE ( 2 ) ! crops, mixed farming
2723	match_veg_wall(m) = 7 ! crops, mixed farming Z01
2724	CASE ( 3 ) ! short grass
2725	match_veg_wall(m) = 6 ! grass in Z01
2726	CASE ( 4 ) ! evergreen needleleaf trees
2727	match_veg_wall(m) = 1 ! evergreen needleleaf trees in Z01
2728	CASE ( 5 ) ! deciduous needleleaf trees
2729	match_veg_wall(m) = 3 ! deciduous needleleaf trees in Z01
2730	CASE ( 6 ) ! evergreen broadleaf trees
2731	match_veg_wall(m) = 2 ! evergreen broadleaf trees in Z01
2732	CASE ( 7 ) ! deciduous broadleaf trees
2733	match_veg_wall(m) = 4 ! deciduous broadleaf trees in Z01
2734	CASE ( 8 ) ! tall grass
2735	match_veg_wall(m) = 6 ! grass in Z01
2736	CASE ( 9 ) ! desert
2737	match_veg_wall(m) = 8 ! desert in Z01
2738	CASE ( 10 ) ! tundra
2739	match_veg_wall(m) = 9 ! tundra in Z01
2740	CASE ( 11 ) ! irrigated crops
2741	match_veg_wall(m) = 7 ! crops, mixed farming Z01
2742	CASE ( 12 ) ! semidesert
2743	match_veg_wall(m) = 8 ! desert in Z01
2744	CASE ( 13 ) ! ice caps and glaciers
2745	match_veg_wall(m) = 12 ! ice cap and glacier in Z01
2746	CASE ( 14 ) ! bogs and marshes
2747	match_veg_wall(m) = 11 ! wetland with plants in Z01
2748	CASE ( 15 ) ! evergreen shrubs
2749	match_veg_wall(m) = 10 ! shrubs and interrupted woodlands in Z01
2750	CASE ( 16 ) ! deciduous shrubs
2751	match_veg_wall(m) = 10 ! shrubs and interrupted woodlands in Z01
2752	CASE ( 17 ) ! mixed forest/woodland
2753	match_veg_wall(m) = 5 ! mixed broadleaf and needleleaf trees in Z01
2754	CASE ( 18 ) ! interrupted forest
2755	match_veg_wall(m) = 10 ! shrubs and interrupted woodlands in Z01
2756	END SELECT
2757	ENDIF
2758	!
2759	!-- Pavement (LSM):
2760	IF ( surf%frac(ind_pav_green,m) > 0 ) THEN
2761	pav_type_palm = surf%pavement_type(m)
2762	IF ( pav_type_palm == 0 ) THEN ! error
2763	message_string = 'No pavement type defined.'
2764	CALL message( 'salsa_mod: match_sm_zhang', 'PA0615', 1, 2, 0, 6, 0 )
2765	ELSE
2766	match_pav_green(m) = 15 ! urban in Z01
2767	ENDIF
2768	ENDIF
2769	!
2770	!-- Water (LSM):
2771	IF ( surf%frac(ind_wat_win,m) > 0 ) THEN
2772	wat_type_palm = surf%water_type(m)
2773	IF ( wat_type_palm == 0 ) THEN ! error
2774	message_string = 'No water type defined.'
2775	CALL message( 'salsa_mod: match_sm_zhang', 'PA0616', 1, 2, 0, 6, 0 )
2776	ELSEIF ( wat_type_palm == 3 ) THEN
2777	match_wat_win(m) = 14 ! ocean in Z01
2778	ELSEIF ( wat_type_palm == 1 .OR. wat_type_palm == 2 .OR. wat_type_palm == 4 &
2779	.OR. wat_type_palm == 5 ) THEN
2780	match_wat_win(m) = 13 ! inland water in Z01
2781	ENDIF
2782	ENDIF
2783	ELSE
2784	!
2785	!-- Wall surfaces (USM):
2786	IF ( surf%frac(ind_veg_wall,m) > 0 ) THEN
2787	match_veg_wall(m) = 15 ! urban in Z01
2788	ENDIF
2789	!
2790	!-- Green walls and roofs (USM):
2791	IF ( surf%frac(ind_pav_green,m) > 0 ) THEN
2792	match_pav_green(m) = 6 ! (short) grass in Z01
2793	ENDIF
2794	!
2795	!-- Windows (USM):
2796	IF ( surf%frac(ind_wat_win,m) > 0 ) THEN
2797	match_wat_win(m) = 15 ! urban in Z01
2798	ENDIF
2799	ENDIF
2800
2801	ENDDO
2802
2803	END SUBROUTINE match_sm_zhang
2804
2805	!------------------------------------------------------------------------------!
2806	! Description:
2807	! ------------
2808	!> Swapping of timelevels
2809	!------------------------------------------------------------------------------!
2810	SUBROUTINE salsa_swap_timelevel( mod_count )
2811
2812	IMPLICIT NONE
2813
2814	INTEGER(iwp) :: ib !<
2815	INTEGER(iwp) :: ic !<
2816	INTEGER(iwp) :: icc !<
2817	INTEGER(iwp) :: ig !<
2818
2819	INTEGER(iwp), INTENT(IN) :: mod_count !<
2820
2821	IF ( time_since_reference_point >= skip_time_do_salsa ) THEN
2822
2823	SELECT CASE ( mod_count )
2824
2825	CASE ( 0 )
2826
2827	DO ib = 1, nbins_aerosol
2828	aerosol_number(ib)%conc(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => nconc_1(:,:,:,ib)
2829	aerosol_number(ib)%conc_p(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => nconc_2(:,:,:,ib)
2830
2831	DO ic = 1, ncomponents_mass
2832	icc = ( ic-1 ) * nbins_aerosol + ib
2833	aerosol_mass(icc)%conc(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => mconc_1(:,:,:,icc)
2834	aerosol_mass(icc)%conc_p(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => mconc_2(:,:,:,icc)
2835	ENDDO
2836	ENDDO
2837
2838	IF ( .NOT. salsa_gases_from_chem ) THEN
2839	DO ig = 1, ngases_salsa
2840	salsa_gas(ig)%conc(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => gconc_1(:,:,:,ig)
2841	salsa_gas(ig)%conc_p(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => gconc_2(:,:,:,ig)
2842	ENDDO
2843	ENDIF
2844
2845	CASE ( 1 )
2846
2847	DO ib = 1, nbins_aerosol
2848	aerosol_number(ib)%conc(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => nconc_2(:,:,:,ib)
2849	aerosol_number(ib)%conc_p(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => nconc_1(:,:,:,ib)
2850	DO ic = 1, ncomponents_mass
2851	icc = ( ic-1 ) * nbins_aerosol + ib
2852	aerosol_mass(icc)%conc(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => mconc_2(:,:,:,icc)
2853	aerosol_mass(icc)%conc_p(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => mconc_1(:,:,:,icc)
2854	ENDDO
2855	ENDDO
2856
2857	IF ( .NOT. salsa_gases_from_chem ) THEN
2858	DO ig = 1, ngases_salsa
2859	salsa_gas(ig)%conc(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => gconc_2(:,:,:,ig)
2860	salsa_gas(ig)%conc_p(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => gconc_1(:,:,:,ig)
2861	ENDDO
2862	ENDIF
2863
2864	END SELECT
2865
2866	ENDIF
2867
2868	END SUBROUTINE salsa_swap_timelevel
2869
2870
2871	!------------------------------------------------------------------------------!
2872	! Description:
2873	! ------------
2874	!> This routine reads the respective restart data.
2875	!------------------------------------------------------------------------------!
2876	SUBROUTINE salsa_rrd_local( k, nxlf, nxlc, nxl_on_file, nxrf, nxrc, nxr_on_file, nynf, nync, &
2877	nyn_on_file, nysf, nysc, nys_on_file, tmp_3d, found )
2878
2879	USE control_parameters, &
2880	ONLY: length, restart_string
2881
2882	IMPLICIT NONE
2883
2884	INTEGER(iwp) :: ib !<
2885	INTEGER(iwp) :: ic !<
2886	INTEGER(iwp) :: ig !<
2887	INTEGER(iwp) :: k !<
2888	INTEGER(iwp) :: nxlc !<
2889	INTEGER(iwp) :: nxlf !<
2890	INTEGER(iwp) :: nxl_on_file !<
2891	INTEGER(iwp) :: nxrc !<
2892	INTEGER(iwp) :: nxrf !<
2893	INTEGER(iwp) :: nxr_on_file !<
2894	INTEGER(iwp) :: nync !<
2895	INTEGER(iwp) :: nynf !<
2896	INTEGER(iwp) :: nyn_on_file !<
2897	INTEGER(iwp) :: nysc !<
2898	INTEGER(iwp) :: nysf !<
2899	INTEGER(iwp) :: nys_on_file !<
2900
2901	LOGICAL, INTENT(OUT) :: found !<
2902
2903	REAL(wp), &
2904	DIMENSION(nzb:nzt+1,nys_on_file-nbgp:nyn_on_file+nbgp,nxl_on_file-nbgp:nxr_on_file+nbgp) :: tmp_3d !<
2905
2906	found = .FALSE.
2907
2908	IF ( read_restart_data_salsa ) THEN
2909
2910	SELECT CASE ( restart_string(1:length) )
2911
2912	CASE ( 'aerosol_mass' )
2913	DO ic = 1, ncomponents_mass * nbins_aerosol
2914	IF ( k == 1 ) READ ( 13 ) tmp_3d
2915	aerosol_mass(ic)%conc(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) = &
2916	tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
2917	ENDDO
2918	found = .TRUE.
2919
2920	CASE ( 'aerosol_number' )
2921	DO ib = 1, nbins_aerosol
2922	IF ( k == 1 ) READ ( 13 ) tmp_3d
2923	aerosol_number(ib)%conc(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) = &
2924	tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
2925	ENDDO
2926	found = .TRUE.
2927
2928	CASE( 'salsa_gases_av' )
2929	IF ( .NOT. ALLOCATED( salsa_gases_av ) ) THEN
2930	ALLOCATE( salsa_gases_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg,ngases_salsa) )
2931	ENDIF
2932	DO ig = 1, ngases_salsa
2933	IF ( k == 1 ) READ ( 13 ) tmp_3d
2934	salsa_gases_av(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp,ig) = &
2935	tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
2936	ENDDO
2937	found = .TRUE.
2938
2939	CASE ( 'ldsa_av' )
2940	IF ( .NOT. ALLOCATED( ldsa_av ) ) ALLOCATE( ldsa_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
2941	IF ( k == 1 ) READ ( 13 ) tmp_3d
2942	ldsa_av(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) = &
2943	tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
2944	found = .TRUE.
2945
2946	CASE ( 'mbins_av' )
2947	IF ( .NOT. ALLOCATED( mbins_av ) ) THEN
2948	ALLOCATE( mbins_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg,nbins_aerosol) )
2949	ENDIF
2950	DO ib = 1, nbins_aerosol
2951	IF ( k == 1 ) READ ( 13 ) tmp_3d
2952	mbins_av(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp,ib) = &
2953	tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
2954	found = .TRUE.
2955	ENDDO
2956
2957	CASE ( 'nbins_av' )
2958	IF ( .NOT. ALLOCATED( nbins_av ) ) THEN
2959	ALLOCATE( nbins_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg,nbins_aerosol) )
2960	ENDIF
2961	DO ib = 1, nbins_aerosol
2962	IF ( k == 1 ) READ ( 13 ) tmp_3d
2963	nbins_av(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp,ib) = &
2964	tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
2965	found = .TRUE.
2966	ENDDO
2967
2968	CASE ( 'ntot_av' )
2969	IF ( .NOT. ALLOCATED( ntot_av ) ) ALLOCATE( ntot_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
2970	IF ( k == 1 ) READ ( 13 ) tmp_3d
2971	ntot_av(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) = &
2972	tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
2973	found = .TRUE.
2974
2975	CASE ( 'nufp_av' )
2976	IF ( .NOT. ALLOCATED( nufp_av ) ) ALLOCATE( nufp_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
2977	IF ( k == 1 ) READ ( 13 ) tmp_3d
2978	nufp_av(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) = &
2979	tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
2980	found = .TRUE.
2981
2982	CASE ( 'pm01_av' )
2983	IF ( .NOT. ALLOCATED( pm01_av ) ) ALLOCATE( pm01_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
2984	IF ( k == 1 ) READ ( 13 ) tmp_3d
2985	pm01_av(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) = &
2986	tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
2987	found = .TRUE.
2988
2989	CASE ( 'pm25_av' )
2990	IF ( .NOT. ALLOCATED( pm25_av ) ) ALLOCATE( pm25_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
2991	IF ( k == 1 ) READ ( 13 ) tmp_3d
2992	pm25_av(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) = &
2993	tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
2994	found = .TRUE.
2995
2996	CASE ( 'pm10_av' )
2997	IF ( .NOT. ALLOCATED( pm10_av ) ) ALLOCATE( pm10_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
2998	IF ( k == 1 ) READ ( 13 ) tmp_3d
2999	pm10_av(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) = &
3000	tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
3001	found = .TRUE.
3002
3003	CASE ( 's_mass_av' )
3004	IF ( .NOT. ALLOCATED( s_mass_av ) ) THEN
3005	ALLOCATE( s_mass_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg,ncomponents_mass) )
3006	ENDIF
3007	DO ic = 1, ncomponents_mass
3008	IF ( k == 1 ) READ ( 13 ) tmp_3d
3009	s_mass_av(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp,ic) = &
3010	tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
3011	ENDDO
3012	found = .TRUE.
3013
3014	CASE ( 's_h2o_av' )
3015	IF ( .NOT. ALLOCATED( s_h2o_av ) ) ALLOCATE( s_h2o_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
3016	IF ( k == 1 ) READ ( 13 ) tmp_3d
3017	s_h2o_av(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) = &
3018	tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
3019	found = .TRUE.
3020
3021	CASE ( 'salsa_gas' )
3022	IF ( .NOT. salsa_gases_from_chem ) THEN
3023	DO ig = 1, ngases_salsa
3024	IF ( k == 1 ) READ ( 13 ) tmp_3d
3025	salsa_gas(ig)%conc(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) = &
3026	tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
3027	ENDDO
3028	found = .TRUE.
3029	ENDIF
3030
3031	CASE DEFAULT
3032	found = .FALSE.
3033
3034	END SELECT
3035	ENDIF
3036
3037	END SUBROUTINE salsa_rrd_local
3038
3039	!------------------------------------------------------------------------------!
3040	! Description:
3041	! ------------
3042	!> This routine writes the respective restart data.
3043	!> Note that the following input variables in PARIN have to be equal between
3044	!> restart runs:
3045	!> listspec, nbin, nbin2, nf2a, ncc, mass_fracs_a, mass_fracs_b
3046	!------------------------------------------------------------------------------!
3047	SUBROUTINE salsa_wrd_local
3048
3049	USE control_parameters, &
3050	ONLY: write_binary
3051
3052	IMPLICIT NONE
3053
3054	INTEGER(iwp) :: ib !<
3055	INTEGER(iwp) :: ic !<
3056	INTEGER(iwp) :: ig !<
3057
3058	IF ( write_binary .AND. write_binary_salsa ) THEN
3059
3060	CALL wrd_write_string( 'aerosol_mass' )
3061	DO ic = 1, nbins_aerosol * ncomponents_mass
3062	WRITE ( 14 ) aerosol_mass(ic)%conc
3063	ENDDO
3064
3065	CALL wrd_write_string( 'aerosol_number' )
3066	DO ib = 1, nbins_aerosol
3067	WRITE ( 14 ) aerosol_number(ib)%conc
3068	ENDDO
3069
3070	IF ( .NOT. salsa_gases_from_chem ) THEN
3071
3072	IF ( ALLOCATED( salsa_gases_av ) ) THEN
3073	CALL wrd_write_string( 'salsa_gases_av' )
3074	DO ig = 1, ngases_salsa
3075	WRITE ( 14 ) salsa_gases_av(:,:,:,ig)
3076	ENDDO
3077	ENDIF
3078	ENDIF
3079
3080	IF ( ALLOCATED( ldsa_av ) ) THEN
3081	CALL wrd_write_string( 'ldsa_av' )
3082	WRITE ( 14 ) ldsa_av
3083	ENDIF
3084
3085	IF ( ALLOCATED( mbins_av ) ) THEN
3086	CALL wrd_write_string( 'mbins_av' )
3087	DO ib = 1, nbins_aerosol
3088	WRITE ( 14 ) mbins_av(:,:,:,ib)
3089	ENDDO
3090	ENDIF
3091
3092	IF ( ALLOCATED( nbins_av ) ) THEN
3093	CALL wrd_write_string( 'nbins_av' )
3094	DO ib = 1, nbins_aerosol
3095	WRITE ( 14 ) nbins_av(:,:,:,ib)
3096	ENDDO
3097	ENDIF
3098
3099	IF ( ALLOCATED( ldsa_av ) ) THEN
3100	CALL wrd_write_string( 'ntot_av' )
3101	WRITE ( 14 ) ntot_av
3102	ENDIF
3103
3104	IF ( ALLOCATED( nufp_av ) ) THEN
3105	CALL wrd_write_string( 'nufp_av' )
3106	WRITE ( 14 ) nufp_av
3107	ENDIF
3108
3109	IF ( ALLOCATED( pm01_av ) ) THEN
3110	CALL wrd_write_string( 'pm01_av' )
3111	WRITE ( 14 ) pm01_av
3112	ENDIF
3113
3114	IF ( ALLOCATED( pm25_av ) ) THEN
3115	CALL wrd_write_string( 'pm25_av' )
3116	WRITE ( 14 ) pm25_av
3117	ENDIF
3118
3119	IF ( ALLOCATED( pm10_av ) ) THEN
3120	CALL wrd_write_string( 'pm10_av' )
3121	WRITE ( 14 ) pm10_av
3122	ENDIF
3123
3124	IF ( ALLOCATED( s_mass_av ) ) THEN
3125	CALL wrd_write_string( 's_mass_av' )
3126	DO ic = 1, ncomponents_mass
3127	WRITE ( 14 ) s_mass_av(:,:,:,ic)
3128	ENDDO
3129	ENDIF
3130
3131	IF ( ALLOCATED( s_h2o_av ) ) THEN
3132	CALL wrd_write_string( 's_h2o_av' )
3133	WRITE ( 14 ) s_h2o_av
3134	ENDIF
3135
3136	IF ( .NOT. salsa_gases_from_chem ) THEN
3137	CALL wrd_write_string( 'salsa_gas' )
3138	DO ig = 1, ngases_salsa
3139	WRITE ( 14 ) salsa_gas(ig)%conc
3140	ENDDO
3141	ENDIF
3142
3143	ENDIF
3144
3145	END SUBROUTINE salsa_wrd_local
3146
3147	!------------------------------------------------------------------------------!
3148	! Description:
3149	! ------------
3150	!> Performs necessary unit and dimension conversion between the host model and
3151	!> SALSA module, and calls the main SALSA routine.
3152	!> Partially adobted form the original SALSA boxmodel version.
3153	!> Now takes masses in as kg/kg from LES!! Converted to m3/m3 for SALSA
3154	!> 05/2016 Juha: This routine is still pretty much in its original shape.
3155	!> It's dumb as a mule and twice as ugly, so implementation of
3156	!> an improved solution is necessary sooner or later.
3157	!> Juha Tonttila, FMI, 2014
3158	!> Jaakko Ahola, FMI, 2016
3159	!> Only aerosol processes included, Mona Kurppa, UHel, 2017
3160	!------------------------------------------------------------------------------!
3161	SUBROUTINE salsa_driver( i, j, prunmode )
3162
3163	USE arrays_3d, &
3164	ONLY: pt_p, q_p, u, v, w
3165
3166	USE plant_canopy_model_mod, &
3167	ONLY: lad_s
3168
3169	USE surface_mod, &
3170	ONLY: surf_def_h, surf_def_v, surf_lsm_h, surf_lsm_v, surf_usm_h, surf_usm_v
3171
3172	IMPLICIT NONE
3173
3174	INTEGER(iwp) :: endi !< end index
3175	INTEGER(iwp) :: ib !< loop index
3176	INTEGER(iwp) :: ic !< loop index
3177	INTEGER(iwp) :: ig !< loop index
3178	INTEGER(iwp) :: k_wall !< vertical index of topography top
3179	INTEGER(iwp) :: k !< loop index
3180	INTEGER(iwp) :: l !< loop index
3181	INTEGER(iwp) :: nc_h2o !< index of H2O in the prtcl index table
3182	INTEGER(iwp) :: ss !< loop index
3183	INTEGER(iwp) :: str !< start index
3184	INTEGER(iwp) :: vc !< default index in prtcl
3185
3186	INTEGER(iwp), INTENT(in) :: i !< loop index
3187	INTEGER(iwp), INTENT(in) :: j !< loop index
3188	INTEGER(iwp), INTENT(in) :: prunmode !< 1: Initialization, 2: Spinup, 3: Regular runtime
3189
3190	REAL(wp) :: cw_old !< previous H2O mixing ratio
3191	REAL(wp) :: flag !< flag to mask topography grid points
3192	REAL(wp) :: in_lad !< leaf area density (m2/m3)
3193	REAL(wp) :: in_rh !< relative humidity
3194	REAL(wp) :: zgso4 !< SO4
3195	REAL(wp) :: zghno3 !< HNO3
3196	REAL(wp) :: zgnh3 !< NH3
3197	REAL(wp) :: zgocnv !< non-volatile OC
3198	REAL(wp) :: zgocsv !< semi-volatile OC
3199
3200	REAL(wp), DIMENSION(nzb:nzt+1) :: in_adn !< air density (kg/m3)
3201	REAL(wp), DIMENSION(nzb:nzt+1) :: in_cs !< H2O sat. vapour conc.
3202	REAL(wp), DIMENSION(nzb:nzt+1) :: in_cw !< H2O vapour concentration
3203	REAL(wp), DIMENSION(nzb:nzt+1) :: in_p !< pressure (Pa)
3204	REAL(wp), DIMENSION(nzb:nzt+1) :: in_t !< temperature (K)
3205	REAL(wp), DIMENSION(nzb:nzt+1) :: in_u !< wind magnitude (m/s)
3206	REAL(wp), DIMENSION(nzb:nzt+1) :: kvis !< kinematic viscosity of air(m2/s)
3207	REAL(wp), DIMENSION(nzb:nzt+1) :: ppm_to_nconc !< Conversion factor from ppm to #/m3
3208
3209	REAL(wp), DIMENSION(nzb:nzt+1,nbins_aerosol) :: schmidt_num !< particle Schmidt number
3210	REAL(wp), DIMENSION(nzb:nzt+1,nbins_aerosol) :: vd !< particle fall seed (m/s)
3211
3212	TYPE(t_section), DIMENSION(nbins_aerosol) :: lo_aero !< additional variable for OpenMP
3213	TYPE(t_section), DIMENSION(nbins_aerosol) :: aero_old !< helper array
3214
3215	aero_old(:)%numc = 0.0_wp
3216	in_lad = 0.0_wp
3217	in_u = 0.0_wp
3218	kvis = 0.0_wp
3219	lo_aero = aero
3220	schmidt_num = 0.0_wp
3221	vd = 0.0_wp
3222	zgso4 = nclim
3223	zghno3 = nclim
3224	zgnh3 = nclim
3225	zgocnv = nclim
3226	zgocsv = nclim
3227	!
3228	!-- Aerosol number is always set, but mass can be uninitialized
3229	DO ib = 1, nbins_aerosol
3230	lo_aero(ib)%volc(:) = 0.0_wp
3231	aero_old(ib)%volc(:) = 0.0_wp
3232	ENDDO
3233	!
3234	!-- Set the salsa runtime config (How to make this more efficient?)
3235	CALL set_salsa_runtime( prunmode )
3236	!
3237	!-- Calculate thermodynamic quantities needed in SALSA
3238	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 )
3239	!
3240	!-- Magnitude of wind: needed for deposition
3241	IF ( lsdepo ) THEN
3242	in_u(nzb+1:nzt) = SQRT( ( 0.5_wp * ( u(nzb+1:nzt,j,i) + u(nzb+1:nzt,j,i+1) ) )**2 + &
3243	( 0.5_wp * ( v(nzb+1:nzt,j,i) + v(nzb+1:nzt,j+1,i) ) )**2 + &
3244	( 0.5_wp * ( w(nzb:nzt-1,j,i) + w(nzb+1:nzt,j, i) ) )**2 )
3245	ENDIF
3246	!
3247	!-- Calculate conversion factors for gas concentrations
3248	ppm_to_nconc(:) = for_ppm_to_nconc * in_p(:) / in_t(:)
3249	!
3250	!-- Determine topography-top index on scalar grid
3251	k_wall = k_topo_top(j,i)
3252
3253	DO k = nzb+1, nzt
3254	!
3255	!-- Predetermine flag to mask topography
3256	flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) )
3257	!
3258	!-- Wind velocity for dry depositon on vegetation
3259	IF ( lsdepo_pcm .AND. plant_canopy ) THEN
3260	in_lad = lad_s( MAX( k-k_wall,0 ),j,i)
3261	ENDIF
3262	!
3263	!-- For initialization and spinup, limit the RH with the parameter rhlim
3264	IF ( prunmode < 3 ) THEN
3265	in_cw(k) = MIN( in_cw(k), in_cs(k) * rhlim )
3266	ELSE
3267	in_cw(k) = in_cw(k)
3268	ENDIF
3269	cw_old = in_cw(k) !* in_adn(k)
3270	!
3271	!-- Set volume concentrations:
3272	!-- Sulphate (SO4) or sulphuric acid H2SO4
3273	IF ( index_so4 > 0 ) THEN
3274	vc = 1
3275	str = ( index_so4-1 ) * nbins_aerosol + 1 ! start index
3276	endi = index_so4 * nbins_aerosol ! end index
3277	ic = 1
3278	DO ss = str, endi
3279	lo_aero(ic)%volc(vc) = aerosol_mass(ss)%conc(k,j,i) / arhoh2so4
3280	ic = ic+1
3281	ENDDO
3282	aero_old(1:nbins_aerosol)%volc(vc) = lo_aero(1:nbins_aerosol)%volc(vc)
3283	ENDIF
3284	!
3285	!-- Organic carbon (OC) compounds
3286	IF ( index_oc > 0 ) THEN
3287	vc = 2
3288	str = ( index_oc-1 ) * nbins_aerosol + 1
3289	endi = index_oc * nbins_aerosol
3290	ic = 1
3291	DO ss = str, endi
3292	lo_aero(ic)%volc(vc) = aerosol_mass(ss)%conc(k,j,i) / arhooc
3293	ic = ic+1
3294	ENDDO
3295	aero_old(1:nbins_aerosol)%volc(vc) = lo_aero(1:nbins_aerosol)%volc(vc)
3296	ENDIF
3297	!
3298	!-- Black carbon (BC)
3299	IF ( index_bc > 0 ) THEN
3300	vc = 3
3301	str = ( index_bc-1 ) * nbins_aerosol + 1 + end_subrange_1a
3302	endi = index_bc * nbins_aerosol
3303	ic = 1 + end_subrange_1a
3304	DO ss = str, endi
3305	lo_aero(ic)%volc(vc) = aerosol_mass(ss)%conc(k,j,i) / arhobc
3306	ic = ic+1
3307	ENDDO
3308	aero_old(1:nbins_aerosol)%volc(vc) = lo_aero(1:nbins_aerosol)%volc(vc)
3309	ENDIF
3310	!
3311	!-- Dust (DU)
3312	IF ( index_du > 0 ) THEN
3313	vc = 4
3314	str = ( index_du-1 ) * nbins_aerosol + 1 + end_subrange_1a
3315	endi = index_du * nbins_aerosol
3316	ic = 1 + end_subrange_1a
3317	DO ss = str, endi
3318	lo_aero(ic)%volc(vc) = aerosol_mass(ss)%conc(k,j,i) / arhodu
3319	ic = ic+1
3320	ENDDO
3321	aero_old(1:nbins_aerosol)%volc(vc) = lo_aero(1:nbins_aerosol)%volc(vc)
3322	ENDIF
3323	!
3324	!-- Sea salt (SS)
3325	IF ( index_ss > 0 ) THEN
3326	vc = 5
3327	str = ( index_ss-1 ) * nbins_aerosol + 1 + end_subrange_1a
3328	endi = index_ss * nbins_aerosol
3329	ic = 1 + end_subrange_1a
3330	DO ss = str, endi
3331	lo_aero(ic)%volc(vc) = aerosol_mass(ss)%conc(k,j,i) / arhoss
3332	ic = ic+1
3333	ENDDO
3334	aero_old(1:nbins_aerosol)%volc(vc) = lo_aero(1:nbins_aerosol)%volc(vc)
3335	ENDIF
3336	!
3337	!-- Nitrate (NO(3-)) or nitric acid HNO3
3338	IF ( index_no > 0 ) THEN
3339	vc = 6
3340	str = ( index_no-1 ) * nbins_aerosol + 1
3341	endi = index_no * nbins_aerosol
3342	ic = 1
3343	DO ss = str, endi
3344	lo_aero(ic)%volc(vc) = aerosol_mass(ss)%conc(k,j,i) / arhohno3
3345	ic = ic+1
3346	ENDDO
3347	aero_old(1:nbins_aerosol)%volc(vc) = lo_aero(1:nbins_aerosol)%volc(vc)
3348	ENDIF
3349	!
3350	!-- Ammonium (NH(4+)) or ammonia NH3
3351	IF ( index_nh > 0 ) THEN
3352	vc = 7
3353	str = ( index_nh-1 ) * nbins_aerosol + 1
3354	endi = index_nh * nbins_aerosol
3355	ic = 1
3356	DO ss = str, endi
3357	lo_aero(ic)%volc(vc) = aerosol_mass(ss)%conc(k,j,i) / arhonh3
3358	ic = ic+1
3359	ENDDO
3360	aero_old(1:nbins_aerosol)%volc(vc) = lo_aero(1:nbins_aerosol)%volc(vc)
3361	ENDIF
3362	!
3363	!-- Water (always used)
3364	nc_h2o = get_index( prtcl,'H2O' )
3365	vc = 8
3366	str = ( nc_h2o-1 ) * nbins_aerosol + 1
3367	endi = nc_h2o * nbins_aerosol
3368	ic = 1
3369	IF ( advect_particle_water ) THEN
3370	DO ss = str, endi
3371	lo_aero(ic)%volc(vc) = aerosol_mass(ss)%conc(k,j,i) / arhoh2o
3372	ic = ic+1
3373	ENDDO
3374	ELSE
3375	lo_aero(1:nbins_aerosol)%volc(vc) = mclim
3376	ENDIF
3377	aero_old(1:nbins_aerosol)%volc(vc) = lo_aero(1:nbins_aerosol)%volc(vc)
3378	!
3379	!-- Number concentrations (numc) and particle sizes
3380	!-- (dwet = wet diameter, core = dry volume)
3381	DO ib = 1, nbins_aerosol
3382	lo_aero(ib)%numc = aerosol_number(ib)%conc(k,j,i)
3383	aero_old(ib)%numc = lo_aero(ib)%numc
3384	IF ( lo_aero(ib)%numc > nclim ) THEN
3385	lo_aero(ib)%dwet = ( SUM( lo_aero(ib)%volc(:) ) / lo_aero(ib)%numc / api6 )**0.33333333_wp
3386	lo_aero(ib)%core = SUM( lo_aero(ib)%volc(1:7) ) / lo_aero(ib)%numc
3387	ELSE
3388	lo_aero(ib)%dwet = lo_aero(ib)%dmid
3389	lo_aero(ib)%core = api6 * ( lo_aero(ib)%dwet )**3
3390	ENDIF
3391	ENDDO
3392	!
3393	!-- Calculate the ambient sizes of particles by equilibrating soluble fraction of particles with
3394	!-- water using the ZSR method.
3395	in_rh = in_cw(k) / in_cs(k)
3396	IF ( prunmode==1 .OR. .NOT. advect_particle_water ) THEN
3397	CALL equilibration( in_rh, in_t(k), lo_aero, .TRUE. )
3398	ENDIF
3399	!
3400	!-- Gaseous tracer concentrations in #/m3
3401	IF ( salsa_gases_from_chem ) THEN
3402	!
3403	!-- Convert concentrations in ppm to #/m3
3404	zgso4 = chem_species(gas_index_chem(1))%conc(k,j,i) * ppm_to_nconc(k)
3405	zghno3 = chem_species(gas_index_chem(2))%conc(k,j,i) * ppm_to_nconc(k)
3406	zgnh3 = chem_species(gas_index_chem(3))%conc(k,j,i) * ppm_to_nconc(k)
3407	zgocnv = chem_species(gas_index_chem(4))%conc(k,j,i) * ppm_to_nconc(k)
3408	zgocsv = chem_species(gas_index_chem(5))%conc(k,j,i) * ppm_to_nconc(k)
3409	ELSE
3410	zgso4 = salsa_gas(1)%conc(k,j,i)
3411	zghno3 = salsa_gas(2)%conc(k,j,i)
3412	zgnh3 = salsa_gas(3)%conc(k,j,i)
3413	zgocnv = salsa_gas(4)%conc(k,j,i)
3414	zgocsv = salsa_gas(5)%conc(k,j,i)
3415	ENDIF
3416	!
3417	!-- Calculate aerosol processes:
3418	!-- *********************************************************************************************
3419	!
3420	!-- Coagulation
3421	IF ( lscoag ) THEN
3422	CALL coagulation( lo_aero, dt_salsa, in_t(k), in_p(k) )
3423	ENDIF
3424	!
3425	!-- Condensation
3426	IF ( lscnd ) THEN
3427	CALL condensation( lo_aero, zgso4, zgocnv, zgocsv, zghno3, zgnh3, in_cw(k), in_cs(k), &
3428	in_t(k), in_p(k), dt_salsa, prtcl )
3429	ENDIF
3430	!
3431	!-- Deposition
3432	IF ( lsdepo ) THEN
3433	CALL deposition( lo_aero, in_t(k), in_adn(k), in_u(k), in_lad, kvis(k), schmidt_num(k,:),&
3434	vd(k,:) )
3435	ENDIF
3436	!
3437	!-- Size distribution bin update
3438	IF ( lsdistupdate ) THEN
3439	CALL distr_update( lo_aero )
3440	ENDIF
3441	!-- *********************************************************************************************
3442
3443	IF ( lsdepo ) sedim_vd(k,j,i,:) = vd(k,:)
3444	!
3445	!-- Calculate changes in concentrations
3446	DO ib = 1, nbins_aerosol
3447	aerosol_number(ib)%conc(k,j,i) = aerosol_number(ib)%conc(k,j,i) + ( lo_aero(ib)%numc - &
3448	aero_old(ib)%numc ) * flag
3449	ENDDO
3450
3451	IF ( index_so4 > 0 ) THEN
3452	vc = 1
3453	str = ( index_so4-1 ) * nbins_aerosol + 1
3454	endi = index_so4 * nbins_aerosol
3455	ic = 1
3456	DO ss = str, endi
3457	aerosol_mass(ss)%conc(k,j,i) = aerosol_mass(ss)%conc(k,j,i) + ( lo_aero(ic)%volc(vc) -&
3458	aero_old(ic)%volc(vc) ) * arhoh2so4 * flag
3459	ic = ic+1
3460	ENDDO
3461	ENDIF
3462
3463	IF ( index_oc > 0 ) THEN
3464	vc = 2
3465	str = ( index_oc-1 ) * nbins_aerosol + 1
3466	endi = index_oc * nbins_aerosol
3467	ic = 1
3468	DO ss = str, endi
3469	aerosol_mass(ss)%conc(k,j,i) = aerosol_mass(ss)%conc(k,j,i) + ( lo_aero(ic)%volc(vc) -&
3470	aero_old(ic)%volc(vc) ) * arhooc * flag
3471	ic = ic+1
3472	ENDDO
3473	ENDIF
3474
3475	IF ( index_bc > 0 ) THEN
3476	vc = 3
3477	str = ( index_bc-1 ) * nbins_aerosol + 1 + end_subrange_1a
3478	endi = index_bc * nbins_aerosol
3479	ic = 1 + end_subrange_1a
3480	DO ss = str, endi
3481	aerosol_mass(ss)%conc(k,j,i) = aerosol_mass(ss)%conc(k,j,i) + ( lo_aero(ic)%volc(vc) -&
3482	aero_old(ic)%volc(vc) ) * arhobc * flag
3483	ic = ic+1
3484	ENDDO
3485	ENDIF
3486
3487	IF ( index_du > 0 ) THEN
3488	vc = 4
3489	str = ( index_du-1 ) * nbins_aerosol + 1 + end_subrange_1a
3490	endi = index_du * nbins_aerosol
3491	ic = 1 + end_subrange_1a
3492	DO ss = str, endi
3493	aerosol_mass(ss)%conc(k,j,i) = aerosol_mass(ss)%conc(k,j,i) + ( lo_aero(ic)%volc(vc) -&
3494	aero_old(ic)%volc(vc) ) * arhodu * flag
3495	ic = ic+1
3496	ENDDO
3497	ENDIF
3498
3499	IF ( index_ss > 0 ) THEN
3500	vc = 5
3501	str = ( index_ss-1 ) * nbins_aerosol + 1 + end_subrange_1a
3502	endi = index_ss * nbins_aerosol
3503	ic = 1 + end_subrange_1a
3504	DO ss = str, endi
3505	aerosol_mass(ss)%conc(k,j,i) = aerosol_mass(ss)%conc(k,j,i) + ( lo_aero(ic)%volc(vc) -&
3506	aero_old(ic)%volc(vc) ) * arhoss * flag
3507	ic = ic+1
3508	ENDDO
3509	ENDIF
3510
3511	IF ( index_no > 0 ) THEN
3512	vc = 6
3513	str = ( index_no-1 ) * nbins_aerosol + 1
3514	endi = index_no * nbins_aerosol
3515	ic = 1
3516	DO ss = str, endi
3517	aerosol_mass(ss)%conc(k,j,i) = aerosol_mass(ss)%conc(k,j,i) + ( lo_aero(ic)%volc(vc) -&
3518	aero_old(ic)%volc(vc) ) * arhohno3 * flag
3519	ic = ic+1
3520	ENDDO
3521	ENDIF
3522
3523	IF ( index_nh > 0 ) THEN
3524	vc = 7
3525	str = ( index_nh-1 ) * nbins_aerosol + 1
3526	endi = index_nh * nbins_aerosol
3527	ic = 1
3528	DO ss = str, endi
3529	aerosol_mass(ss)%conc(k,j,i) = aerosol_mass(ss)%conc(k,j,i) + ( lo_aero(ic)%volc(vc) -&
3530	aero_old(ic)%volc(vc) ) * arhonh3 * flag
3531	ic = ic+1
3532	ENDDO
3533	ENDIF
3534
3535	IF ( advect_particle_water ) THEN
3536	nc_h2o = get_index( prtcl,'H2O' )
3537	vc = 8
3538	str = ( nc_h2o-1 ) * nbins_aerosol + 1
3539	endi = nc_h2o * nbins_aerosol
3540	ic = 1
3541	DO ss = str, endi
3542	aerosol_mass(ss)%conc(k,j,i) = aerosol_mass(ss)%conc(k,j,i) + ( lo_aero(ic)%volc(vc) -&
3543	aero_old(ic)%volc(vc) ) * arhoh2o * flag
3544	ic = ic+1
3545	ENDDO
3546	IF ( prunmode == 1 ) THEN
3547	nc_h2o = get_index( prtcl,'H2O' )
3548	vc = 8
3549	str = ( nc_h2o-1 ) * nbins_aerosol + 1
3550	endi = nc_h2o * nbins_aerosol
3551	ic = 1
3552	DO ss = str, endi
3553	aerosol_mass(ss)%init(k) = MAX( aerosol_mass(ss)%init(k), ( lo_aero(ic)%volc(vc) - &
3554	aero_old(ic)%volc(vc) ) * arhoh2o )
3555	IF ( k == nzb+1 ) THEN
3556	aerosol_mass(ss)%init(k-1) = aerosol_mass(ss)%init(k)
3557	ELSEIF ( k == nzt ) THEN
3558	aerosol_mass(ss)%init(k+1) = aerosol_mass(ss)%init(k)
3559	aerosol_mass(ss)%conc(k+1,j,i) = aerosol_mass(ss)%init(k)
3560	ENDIF
3561	ic = ic+1
3562	ENDDO
3563	ENDIF
3564	ENDIF
3565	!
3566	!-- Condensation of precursor gases
3567	IF ( lscndgas ) THEN
3568	IF ( salsa_gases_from_chem ) THEN
3569	!
3570	!-- SO4 (or H2SO4)
3571	ig = gas_index_chem(1)
3572	chem_species(ig)%conc(k,j,i) = chem_species(ig)%conc(k,j,i) + ( zgso4 / &
3573	ppm_to_nconc(k) - chem_species(ig)%conc(k,j,i) ) * flag
3574	!
3575	!-- HNO3
3576	ig = gas_index_chem(2)
3577	chem_species(ig)%conc(k,j,i) = chem_species(ig)%conc(k,j,i) + ( zghno3 / &
3578	ppm_to_nconc(k) - chem_species(ig)%conc(k,j,i) ) * flag
3579	!
3580	!-- NH3
3581	ig = gas_index_chem(3)
3582	chem_species(ig)%conc(k,j,i) = chem_species(ig)%conc(k,j,i) + ( zgnh3 / &
3583	ppm_to_nconc(k) - chem_species(ig)%conc(k,j,i) ) * flag
3584	!
3585	!-- non-volatile OC
3586	ig = gas_index_chem(4)
3587	chem_species(ig)%conc(k,j,i) = chem_species(ig)%conc(k,j,i) + ( zgocnv / &
3588	ppm_to_nconc(k) - chem_species(ig)%conc(k,j,i) ) * flag
3589	!
3590	!-- semi-volatile OC
3591	ig = gas_index_chem(5)
3592	chem_species(ig)%conc(k,j,i) = chem_species(ig)%conc(k,j,i) + ( zgocsv / &
3593	ppm_to_nconc(k) - chem_species(ig)%conc(k,j,i) ) * flag
3594
3595	ELSE
3596	!
3597	!-- SO4 (or H2SO4)
3598	salsa_gas(1)%conc(k,j,i) = salsa_gas(1)%conc(k,j,i) + ( zgso4 - &
3599	salsa_gas(1)%conc(k,j,i) ) * flag
3600	!
3601	!-- HNO3
3602	salsa_gas(2)%conc(k,j,i) = salsa_gas(2)%conc(k,j,i) + ( zghno3 - &
3603	salsa_gas(2)%conc(k,j,i) ) * flag
3604	!
3605	!-- NH3
3606	salsa_gas(3)%conc(k,j,i) = salsa_gas(3)%conc(k,j,i) + ( zgnh3 - &
3607	salsa_gas(3)%conc(k,j,i) ) * flag
3608	!
3609	!-- non-volatile OC
3610	salsa_gas(4)%conc(k,j,i) = salsa_gas(4)%conc(k,j,i) + ( zgocnv - &
3611	salsa_gas(4)%conc(k,j,i) ) * flag
3612	!
3613	!-- semi-volatile OC
3614	salsa_gas(5)%conc(k,j,i) = salsa_gas(5)%conc(k,j,i) + ( zgocsv - &
3615	salsa_gas(5)%conc(k,j,i) ) * flag
3616	ENDIF
3617	ENDIF
3618	!
3619	!-- Tendency of water vapour mixing ratio is obtained from the change in RH during SALSA run.
3620	!-- This releases heat and changes pt. Assumes no temperature change during SALSA run.
3621	!-- q = r / (1+r), Euler method for integration
3622	!
3623	IF ( feedback_to_palm ) THEN
3624	q_p(k,j,i) = q_p(k,j,i) + 1.0_wp / ( in_cw(k) * in_adn(k) + 1.0_wp )*2 &
3625	( in_cw(k) - cw_old ) * in_adn(k) * flag
3626	pt_p(k,j,i) = pt_p(k,j,i) + alv / c_p * ( in_cw(k) - cw_old ) * in_adn(k) / ( in_cw(k) / &
3627	in_adn(k) + 1.0_wp )*2 pt_p(k,j,i) / in_t(k) * flag
3628	ENDIF
3629
3630	ENDDO ! k
3631
3632	!
3633	!-- Set surfaces and wall fluxes due to deposition
3634	IF ( lsdepo .AND. lsdepo_surf .AND. prunmode == 3 ) THEN
3635	IF ( .NOT. land_surface .AND. .NOT. urban_surface ) THEN
3636	CALL depo_surf( i, j, surf_def_h(0), vd, schmidt_num, kvis, in_u, .TRUE. )
3637	DO l = 0, 3
3638	CALL depo_surf( i, j, surf_def_v(l), vd, schmidt_num, kvis, in_u, .FALSE. )
3639	ENDDO
3640	ELSE
3641	CALL depo_surf( i, j, surf_usm_h, vd, schmidt_num, kvis, in_u, .TRUE., usm_to_depo_h )
3642	DO l = 0, 3
3643	CALL depo_surf( i, j, surf_usm_v(l), vd, schmidt_num, kvis, in_u, .FALSE., &
3644	usm_to_depo_v(l) )
3645	ENDDO
3646	CALL depo_surf( i, j, surf_lsm_h, vd, schmidt_num, kvis, in_u, .TRUE., lsm_to_depo_h )
3647	DO l = 0, 3
3648	CALL depo_surf( i, j, surf_lsm_v(l), vd, schmidt_num, kvis, in_u, .FALSE., &
3649	lsm_to_depo_v(l) )
3650	ENDDO
3651	ENDIF
3652	ENDIF
3653
3654	IF ( prunmode < 3 ) THEN
3655	!$OMP MASTER
3656	aero = lo_aero
3657	!$OMP END MASTER
3658	END IF
3659
3660	END SUBROUTINE salsa_driver
3661
3662	!------------------------------------------------------------------------------!
3663	! Description:
3664	! ------------
3665	!> Set logical switches according to the salsa_parameters options.
3666	!> Juha Tonttila, FMI, 2014
3667	!> Only aerosol processes included, Mona Kurppa, UHel, 2017
3668	!------------------------------------------------------------------------------!
3669	SUBROUTINE set_salsa_runtime( prunmode )
3670
3671	IMPLICIT NONE
3672
3673	INTEGER(iwp), INTENT(in) :: prunmode
3674
3675	SELECT CASE(prunmode)
3676
3677	CASE(1) !< Initialization
3678	lscoag = .FALSE.
3679	lscnd = .FALSE.
3680	lscndgas = .FALSE.
3681	lscndh2oae = .FALSE.
3682	lsdepo = .FALSE.
3683	lsdepo_pcm = .FALSE.
3684	lsdepo_surf = .FALSE.
3685	lsdistupdate = .TRUE.
3686	lspartition = .FALSE.
3687
3688	CASE(2) !< Spinup period
3689	lscoag = ( .FALSE. .AND. nlcoag )
3690	lscnd = ( .TRUE. .AND. nlcnd )
3691	lscndgas = ( .TRUE. .AND. nlcndgas )
3692	lscndh2oae = ( .TRUE. .AND. nlcndh2oae )
3693
3694	CASE(3) !< Run
3695	lscoag = nlcoag
3696	lscnd = nlcnd
3697	lscndgas = nlcndgas
3698	lscndh2oae = nlcndh2oae
3699	lsdepo = nldepo
3700	lsdepo_pcm = nldepo_pcm
3701	lsdepo_surf = nldepo_surf
3702	lsdistupdate = nldistupdate
3703	END SELECT
3704
3705
3706	END SUBROUTINE set_salsa_runtime
3707
3708	!------------------------------------------------------------------------------!
3709	! Description:
3710	! ------------
3711	!> Calculates the absolute temperature (using hydrostatic pressure), saturation
3712	!> vapour pressure and mixing ratio over water, relative humidity and air
3713	!> density needed in the SALSA model.
3714	!> NOTE, no saturation adjustment takes place -> the resulting water vapour
3715	!> mixing ratio can be supersaturated, allowing the microphysical calculations
3716	!> in SALSA.
3717	!
3718	!> Juha Tonttila, FMI, 2014 (original SALSAthrm)
3719	!> Mona Kurppa, UHel, 2017 (adjustment for PALM and only aerosol processes)
3720	!------------------------------------------------------------------------------!
3721	SUBROUTINE salsa_thrm_ij( i, j, p_ij, temp_ij, cw_ij, cs_ij, adn_ij )
3722
3723	USE arrays_3d, &
3724	ONLY: pt, q, zu
3725
3726	USE basic_constants_and_equations_mod, &
3727	ONLY: barometric_formula, exner_function, ideal_gas_law_rho, magnus
3728
3729	IMPLICIT NONE
3730
3731	INTEGER(iwp), INTENT(in) :: i !<
3732	INTEGER(iwp), INTENT(in) :: j !<
3733
3734	REAL(wp) :: t_surface !< absolute surface temperature (K)
3735
3736	REAL(wp), DIMENSION(nzb:nzt+1) :: e_s !< saturation vapour pressure over water (Pa)
3737
3738	REAL(wp), DIMENSION(:), INTENT(inout) :: adn_ij !< air density (kg/m3)
3739	REAL(wp), DIMENSION(:), INTENT(inout) :: p_ij !< air pressure (Pa)
3740	REAL(wp), DIMENSION(:), INTENT(inout) :: temp_ij !< air temperature (K)
3741
3742	REAL(wp), DIMENSION(:), INTENT(inout), OPTIONAL :: cw_ij !< water vapour concentration (kg/m3)
3743	REAL(wp), DIMENSION(:), INTENT(inout), OPTIONAL :: cs_ij !< saturation water vap. conc.(kg/m3)
3744	!
3745	!-- Pressure p_ijk (Pa) = hydrostatic pressure
3746	t_surface = pt_surface * exner_function( surface_pressure * 100.0_wp )
3747	p_ij(:) = barometric_formula( zu, t_surface, surface_pressure * 100.0_wp )
3748	!
3749	!-- Absolute ambient temperature (K)
3750	temp_ij(:) = pt(:,j,i) * exner_function( p_ij(:) )
3751	!
3752	!-- Air density
3753	adn_ij(:) = ideal_gas_law_rho( p_ij(:), temp_ij(:) )
3754	!
3755	!-- Water vapour concentration r_v (kg/m3)
3756	IF ( PRESENT( cw_ij ) ) THEN
3757	cw_ij(:) = ( q(:,j,i) / ( 1.0_wp - q(:,j,i) ) ) * adn_ij(:)
3758	ENDIF
3759	!
3760	!-- Saturation mixing ratio r_s (kg/kg) from vapour pressure at temp (Pa)
3761	IF ( PRESENT( cs_ij ) ) THEN
3762	e_s(:) = 611.0_wp * EXP( alv_d_rv * ( 3.6609E-3_wp - 1.0_wp / &
3763	temp_ij(:) ) )! magnus( temp_ij(:) )
3764	cs_ij(:) = ( 0.622_wp * e_s / ( p_ij(:) - e_s(:) ) ) * adn_ij(:)
3765	ENDIF
3766
3767	END SUBROUTINE salsa_thrm_ij
3768
3769	!------------------------------------------------------------------------------!
3770	! Description:
3771	! ------------
3772	!> Calculates ambient sizes of particles by equilibrating soluble fraction of
3773	!> particles with water using the ZSR method (Stokes and Robinson, 1966).
3774	!> Method:
3775	!> Following chemical components are assumed water-soluble
3776	!> - (ammonium) sulphate (100%)
3777	!> - sea salt (100 %)
3778	!> - organic carbon (epsoc * 100%)
3779	!> Exact thermodynamic considerations neglected.
3780	!> - If particles contain no sea salt, calculation according to sulphate
3781	!> properties
3782	!> - If contain sea salt but no sulphate, calculation according to sea salt
3783	!> properties
3784	!> - If contain both sulphate and sea salt -> the molar fraction of these
3785	!> compounds determines which one of them is used as the basis of calculation.
3786	!> If sulphate and sea salt coexist in a particle, it is assumed that the Cl is
3787	!> replaced by sulphate; thus only either sulphate + organics or sea salt +
3788	!> organics is included in the calculation of soluble fraction.
3789	!> Molality parameterizations taken from Table 1 of Tang: Thermodynamic and
3790	!> optical properties of mixed-salt aerosols of atmospheric importance,
3791	!> J. Geophys. Res., 102 (D2), 1883-1893 (1997)
3792	!
3793	!> Coded by:
3794	!> Hannele Korhonen (FMI) 2005
3795	!> Harri Kokkola (FMI) 2006
3796	!> Matti Niskanen(FMI) 2012
3797	!> Anton Laakso (FMI) 2013
3798	!> Modified for the new aerosol datatype, Juha Tonttila (FMI) 2014
3799	!
3800	!> fxm: should sea salt form a solid particle when prh is very low (even though
3801	!> it could be mixed with e.g. sulphate)?
3802	!> fxm: crashes if no sulphate or sea salt
3803	!> fxm: do we really need to consider Kelvin effect for subrange 2
3804	!------------------------------------------------------------------------------!
3805	SUBROUTINE equilibration( prh, ptemp, paero, init )
3806
3807	IMPLICIT NONE
3808
3809	INTEGER(iwp) :: ib !< loop index
3810	INTEGER(iwp) :: counti !< loop index
3811
3812	LOGICAL, INTENT(in) :: init !< TRUE: Initialization, FALSE: Normal runtime: update water
3813	!< content only for 1a
3814
3815	REAL(wp) :: zaw !< water activity [0-1]
3816	REAL(wp) :: zcore !< Volume of dry particle
3817	REAL(wp) :: zdold !< Old diameter
3818	REAL(wp) :: zdwet !< Wet diameter or mean droplet diameter
3819	REAL(wp) :: zke !< Kelvin term in the KÃ¶hler equation
3820	REAL(wp) :: zlwc !< liquid water content [kg/m3-air]
3821	REAL(wp) :: zrh !< Relative humidity
3822
3823	REAL(wp), DIMENSION(maxspec) :: zbinmol !< binary molality of each components (mol/kg)
3824	REAL(wp), DIMENSION(maxspec) :: zvpart !< volume of chem. compounds in one particle
3825
3826	REAL(wp), INTENT(in) :: prh !< relative humidity [0-1]
3827	REAL(wp), INTENT(in) :: ptemp !< temperature (K)
3828
3829	TYPE(t_section), DIMENSION(nbins_aerosol), INTENT(inout) :: paero !< aerosol properties
3830
3831	zaw = 0.0_wp
3832	zlwc = 0.0_wp
3833	!
3834	!-- Relative humidity:
3835	zrh = prh
3836	zrh = MAX( zrh, 0.05_wp )
3837	zrh = MIN( zrh, 0.98_wp)
3838	!
3839	!-- 1) Regime 1: sulphate and partly water-soluble OC. Done for every CALL
3840	DO ib = start_subrange_1a, end_subrange_1a ! size bin
3841
3842	zbinmol = 0.0_wp
3843	zdold = 1.0_wp
3844	zke = 1.02_wp
3845
3846	IF ( paero(ib)%numc > nclim ) THEN
3847	!
3848	!-- Volume in one particle
3849	zvpart = 0.0_wp
3850	zvpart(1:2) = paero(ib)%volc(1:2) / paero(ib)%numc
3851	zvpart(6:7) = paero(ib)%volc(6:7) / paero(ib)%numc
3852	!
3853	!-- Total volume and wet diameter of one dry particle
3854	zcore = SUM( zvpart(1:2) )
3855	zdwet = paero(ib)%dwet
3856
3857	counti = 0
3858	DO WHILE ( ABS( zdwet / zdold - 1.0_wp ) > 1.0E-2_wp )
3859
3860	zdold = MAX( zdwet, 1.0E-20_wp )
3861	zaw = MAX( 1.0E-3_wp, zrh / zke ) ! To avoid underflow
3862	!
3863	!-- Binary molalities (mol/kg):
3864	!-- Sulphate
3865	zbinmol(1) = 1.1065495E+2_wp - 3.6759197E+2_wp * zaw + 5.0462934E+2_wp * zaw**2 - &
3866	3.1543839E+2_wp * zaw*3 + 6.770824E+1_wp zaw**4
3867	!-- Organic carbon
3868	zbinmol(2) = 1.0_wp / ( zaw * amh2o ) - 1.0_wp / amh2o
3869	!-- Nitric acid
3870	zbinmol(6) = 2.306844303E+1_wp - 3.563608869E+1_wp * zaw - 6.210577919E+1_wp * zaw**2 &
3871	+ 5.510176187E+2_wp * zaw*3 - 1.460055286E+3_wp zaw**4 &
3872	+ 1.894467542E+3_wp * zaw*5 - 1.220611402E+3_wp zaw**6 &
3873	+ 3.098597737E+2_wp * zaw**7
3874	!
3875	!-- Calculate the liquid water content (kg/m3-air) using ZSR (see e.g. Eq. 10.98 in
3876	!-- Seinfeld and Pandis (2006))
3877	zlwc = ( paero(ib)%volc(1) * ( arhoh2so4 / amh2so4 ) ) / zbinmol(1) + &
3878	epsoc * paero(ib)%volc(2) * ( arhooc / amoc ) / zbinmol(2) + &
3879	( paero(ib)%volc(6) * ( arhohno3/amhno3 ) ) / zbinmol(6)
3880	!
3881	!-- Particle wet diameter (m)
3882	zdwet = ( zlwc / paero(ib)%numc / arhoh2o / api6 + ( SUM( zvpart(6:7) ) / api6 ) + &
3883	zcore / api6 )**0.33333333_wp
3884	!
3885	!-- Kelvin effect (Eq. 10.85 in in Seinfeld and Pandis (2006)). Avoid
3886	!-- overflow.
3887	zke = EXP( MIN( 50.0_wp, 4.0_wp * surfw0 * amvh2so4 / ( abo * ptemp * zdwet ) ) )
3888
3889	counti = counti + 1
3890	IF ( counti > 1000 ) THEN
3891	message_string = 'Subrange 1: no convergence!'
3892	CALL message( 'salsa_mod: equilibration', 'PA0617', 1, 2, 0, 6, 0 )
3893	ENDIF
3894	ENDDO
3895	!
3896	!-- Instead of lwc, use the volume concentration of water from now on
3897	!-- (easy to convert...)
3898	paero(ib)%volc(8) = zlwc / arhoh2o
3899	!
3900	!-- If this is initialization, update the core and wet diameter
3901	IF ( init ) THEN
3902	paero(ib)%dwet = zdwet
3903	paero(ib)%core = zcore
3904	ENDIF
3905
3906	ELSE
3907	!-- If initialization
3908	!-- 1.2) empty bins given bin average values
3909	IF ( init ) THEN
3910	paero(ib)%dwet = paero(ib)%dmid
3911	paero(ib)%core = api6 * paero(ib)%dmid**3
3912	ENDIF
3913
3914	ENDIF
3915
3916	ENDDO ! ib
3917	!
3918	!-- 2) Regime 2a: sulphate, OC, BC and sea salt
3919	!-- This is done only for initialization call, otherwise the water contents
3920	!-- are computed via condensation
3921	IF ( init ) THEN
3922	DO ib = start_subrange_2a, end_subrange_2b
3923	!
3924	!-- Initialize
3925	zke = 1.02_wp
3926	zbinmol = 0.0_wp
3927	zdold = 1.0_wp
3928	!
3929	!-- 1) Particle properties calculated for non-empty bins
3930	IF ( paero(ib)%numc > nclim ) THEN
3931	!
3932	!-- Volume in one particle [fxm]
3933	zvpart = 0.0_wp
3934	zvpart(1:7) = paero(ib)%volc(1:7) / paero(ib)%numc
3935	!
3936	!-- Total volume and wet diameter of one dry particle [fxm]
3937	zcore = SUM( zvpart(1:5) )
3938	zdwet = paero(ib)%dwet
3939
3940	counti = 0
3941	DO WHILE ( ABS( zdwet / zdold - 1.0_wp ) > 1.0E-12_wp )
3942
3943	zdold = MAX( zdwet, 1.0E-20_wp )
3944	zaw = zrh / zke
3945	!
3946	!-- Binary molalities (mol/kg):
3947	!-- Sulphate
3948	zbinmol(1) = 1.1065495E+2_wp - 3.6759197E+2_wp * zaw + 5.0462934E+2_wp * zaw**2 - &
3949	3.1543839E+2_wp * zaw*3 + 6.770824E+1_wp zaw**4
3950	!-- Organic carbon
3951	zbinmol(2) = 1.0_wp / ( zaw * amh2o ) - 1.0_wp / amh2o
3952	!-- Nitric acid
3953	zbinmol(6) = 2.306844303E+1_wp - 3.563608869E+1_wp * zaw - &
3954	6.210577919E+1_wp * zaw*2 + 5.510176187E+2_wp zaw**3 - &
3955	1.460055286E+3_wp * zaw*4 + 1.894467542E+3_wp zaw**5 - &
3956	1.220611402E+3_wp * zaw*6 + 3.098597737E+2_wp zaw**7
3957	!-- Sea salt (natrium chloride)
3958	zbinmol(5) = 5.875248E+1_wp - 1.8781997E+2_wp * zaw + 2.7211377E+2_wp * zaw**2 - &
3959	1.8458287E+2_wp * zaw*3 + 4.153689E+1_wp zaw**4
3960	!
3961	!-- Calculate the liquid water content (kg/m3-air)
3962	zlwc = ( paero(ib)%volc(1) * ( arhoh2so4 / amh2so4 ) ) / zbinmol(1) + &
3963	epsoc * ( paero(ib)%volc(2) * ( arhooc / amoc ) ) / zbinmol(2) + &
3964	( paero(ib)%volc(6) * ( arhohno3 / amhno3 ) ) / zbinmol(6) + &
3965	( paero(ib)%volc(5) * ( arhoss / amss ) ) / zbinmol(5)
3966
3967	!-- Particle wet radius (m)
3968	zdwet = ( zlwc / paero(ib)%numc / arhoh2o / api6 + ( SUM( zvpart(6:7) ) / api6 ) + &
3969	zcore / api6 )**0.33333333_wp
3970	!
3971	!-- Kelvin effect (Eq. 10.85 in Seinfeld and Pandis (2006))
3972	zke = EXP( MIN( 50.0_wp, 4.0_wp * surfw0 * amvh2so4 / ( abo * zdwet * ptemp ) ) )
3973
3974	counti = counti + 1
3975	IF ( counti > 1000 ) THEN
3976	message_string = 'Subrange 2: no convergence!'
3977	CALL message( 'salsa_mod: equilibration', 'PA0618', 1, 2, 0, 6, 0 )
3978	ENDIF
3979	ENDDO
3980	!
3981	!-- Liquid water content; instead of LWC use the volume concentration
3982	paero(ib)%volc(8) = zlwc / arhoh2o
3983	paero(ib)%dwet = zdwet
3984	paero(ib)%core = zcore
3985
3986	ELSE
3987	!-- 2.2) empty bins given bin average values
3988	paero(ib)%dwet = paero(ib)%dmid
3989	paero(ib)%core = api6 * paero(ib)%dmid**3
3990	ENDIF
3991
3992	ENDDO ! ib
3993	ENDIF
3994
3995	END SUBROUTINE equilibration
3996
3997	!------------------------------------------------------------------------------!
3998	!> Description:
3999	!> ------------
4000	!> Calculation of the settling velocity vc (m/s) per aerosol size bin and
4001	!> deposition on plant canopy (lsdepo_pcm).
4002	!
4003	!> Deposition is based on either the scheme presented in:
4004	!> Zhang et al. (2001), Atmos. Environ. 35, 549-560 (includes collection due to
4005	!> Brownian diffusion, impaction, interception and sedimentation; hereafter ZO1)
4006	!> OR
4007	!> Petroff & Zhang (2010), Geosci. Model Dev. 3, 753-769 (includes also
4008	!> collection due to turbulent impaction, hereafter P10)
4009	!
4010	!> Equation numbers refer to equation in Jacobson (2005): Fundamentals of
4011	!> Atmospheric Modeling, 2nd Edition.
4012	!
4013	!> Subroutine follows closely sedim_SALSA in UCLALES-SALSA written by Juha
4014	!> Tonttila (KIT/FMI) and Zubair Maalick (UEF).
4015	!> Rewritten to PALM by Mona Kurppa (UH), 2017.
4016	!
4017	!> Call for grid point i,j,k
4018	!------------------------------------------------------------------------------!
4019
4020	SUBROUTINE deposition( paero, tk, adn, mag_u, lad, kvis, schmidt_num, vc )
4021
4022	USE plant_canopy_model_mod, &
4023	ONLY: canopy_drag_coeff
4024
4025	IMPLICIT NONE
4026
4027	INTEGER(iwp) :: ib !< loop index
4028	INTEGER(iwp) :: ic !< loop index
4029
4030	REAL(wp) :: alpha !< parameter, Table 3 in Z01
4031	REAL(wp) :: avis !< molecular viscocity of air (kg/(m*s))
4032	REAL(wp) :: beta_im !< parameter for turbulent impaction
4033	REAL(wp) :: c_brownian_diff !< coefficient for Brownian diffusion
4034	REAL(wp) :: c_impaction !< coefficient for inertial impaction
4035	REAL(wp) :: c_interception !< coefficient for interception
4036	REAL(wp) :: c_turb_impaction !< coefficient for turbulent impaction
4037	REAL(wp) :: depo !< deposition velocity (m/s)
4038	REAL(wp) :: gamma !< parameter, Table 3 in Z01
4039	REAL(wp) :: lambda !< molecular mean free path (m)
4040	REAL(wp) :: mdiff !< particle diffusivity coefficient
4041	REAL(wp) :: par_a !< parameter A for the characteristic radius of collectors,
4042	!< Table 3 in Z01
4043	REAL(wp) :: par_l !< obstacle characteristic dimension in P10
4044	REAL(wp) :: pdn !< particle density (kg/m3)
4045	REAL(wp) :: ustar !< friction velocity (m/s)
4046	REAL(wp) :: va !< thermal speed of an air molecule (m/s)
4047
4048	REAL(wp), INTENT(in) :: adn !< air density (kg/m3)
4049	REAL(wp), INTENT(in) :: lad !< leaf area density (m2/m3)
4050	REAL(wp), INTENT(in) :: mag_u !< wind velocity (m/s)
4051	REAL(wp), INTENT(in) :: tk !< abs.temperature (K)
4052
4053	REAL(wp), INTENT(inout) :: kvis !< kinematic viscosity of air (m2/s)
4054
4055	REAL(wp), DIMENSION(nbins_aerosol) :: beta !< Cunningham slip-flow correction factor
4056	REAL(wp), DIMENSION(nbins_aerosol) :: Kn !< Knudsen number
4057	REAL(wp), DIMENSION(nbins_aerosol) :: zdwet !< wet diameter (m)
4058
4059	REAL(wp), DIMENSION(:), INTENT(inout) :: schmidt_num !< particle Schmidt number
4060	REAL(wp), DIMENSION(:), INTENT(inout) :: vc !< critical fall speed i.e. settling velocity of
4061	!< an aerosol particle (m/s)
4062
4063	TYPE(t_section), DIMENSION(nbins_aerosol), INTENT(inout) :: paero !< aerosol properties
4064	!
4065	!-- Initialise
4066	depo = 0.0_wp
4067	pdn = 1500.0_wp ! default value
4068	ustar = 0.0_wp
4069	!
4070	!-- Molecular viscosity of air (Eq. 4.54)
4071	avis = 1.8325E-5_wp * ( 416.16_wp / ( tk + 120.0_wp ) ) * ( tk / 296.16_wp )**1.5_wp
4072	!
4073	!-- Kinematic viscosity (Eq. 4.55)
4074	kvis = avis / adn
4075	!
4076	!-- Thermal velocity of an air molecule (Eq. 15.32)
4077	va = SQRT( 8.0_wp * abo * tk / ( pi * am_airmol ) )
4078	!
4079	!-- Mean free path (m) (Eq. 15.24)
4080	lambda = 2.0_wp * avis / ( adn * va )
4081	!
4082	!-- Particle wet diameter (m)
4083	zdwet = paero(:)%dwet
4084	!
4085	!-- Knudsen number (Eq. 15.23)
4086	Kn = MAX( 1.0E-2_wp, lambda / ( zdwet * 0.5_wp ) ) ! To avoid underflow
4087	!
4088	!-- Cunningham slip-flow correction (Eq. 15.30)
4089	beta = 1.0_wp + Kn * ( 1.249_wp + 0.42_wp * EXP( -0.87_wp / Kn ) )
4090	!
4091	!-- Critical fall speed i.e. settling velocity (Eq. 20.4)
4092	vc = MIN( 1.0_wp, zdwet*2 ( pdn - adn ) * g * beta / ( 18.0_wp * avis ) )
4093	!
4094	!-- Deposition on vegetation
4095	IF ( lsdepo_pcm .AND. plant_canopy .AND. lad > 0.0_wp ) THEN
4096	!
4097	!-- Parameters for the land use category 'deciduous broadleaf trees'(Table 3)
4098	alpha = alpha_z01(depo_pcm_type_num)
4099	gamma = gamma_z01(depo_pcm_type_num)
4100	par_a = A_z01(depo_pcm_type_num, season_z01) * 1.0E-3_wp
4101	!
4102	!-- Deposition efficiencies from Table 1. Constants from Table 2.
4103	par_l = l_p10(depo_pcm_type_num) * 0.01_wp
4104	c_brownian_diff = c_b_p10(depo_pcm_type_num)
4105	c_interception = c_in_p10(depo_pcm_type_num)
4106	c_impaction = c_im_p10(depo_pcm_type_num)
4107	beta_im = beta_im_p10(depo_pcm_type_num)
4108	c_turb_impaction = c_it_p10(depo_pcm_type_num)
4109
4110	DO ib = 1, nbins_aerosol
4111
4112	IF ( paero(ib)%numc < ( 2.0_wp * nclim ) ) CYCLE
4113
4114	!-- Particle diffusivity coefficient (Eq. 15.29)
4115	mdiff = ( abo * tk * beta(ib) ) / ( 3.0_wp * pi * avis * zdwet(ib) )
4116	!
4117	!-- Particle Schmidt number (Eq. 15.36)
4118	schmidt_num(ib) = kvis / mdiff
4119	!
4120	!-- Friction velocity for deposition on vegetation. Calculated following Prandtl (1925):
4121	ustar = SQRT( canopy_drag_coeff ) * mag_u
4122	SELECT CASE ( depo_pcm_par_num )
4123
4124	CASE ( 1 ) ! Zhang et al. (2001)
4125	CALL depo_vel_Z01( vc(ib), ustar, schmidt_num(ib), paero(ib)%dwet, alpha, gamma, &
4126	par_a, depo )
4127	CASE ( 2 ) ! Petroff & Zhang (2010)
4128	CALL depo_vel_P10( vc(ib), mag_u, ustar, kvis, schmidt_num(ib), paero(ib)%dwet, &
4129	par_l, c_brownian_diff, c_interception, c_impaction, beta_im, &
4130	c_turb_impaction, depo )
4131	END SELECT
4132	!
4133	!-- Calculate the change in concentrations
4134	paero(ib)%numc = paero(ib)%numc - depo * lad * paero(ib)%numc * dt_salsa
4135	DO ic = 1, maxspec+1
4136	paero(ib)%volc(ic) = paero(ib)%volc(ic) - depo * lad * paero(ib)%volc(ic) * dt_salsa
4137	ENDDO
4138	ENDDO
4139
4140	ENDIF
4141
4142	END SUBROUTINE deposition
4143
4144	!------------------------------------------------------------------------------!
4145	! Description:
4146	! ------------
4147	!> Calculate deposition velocity (m/s) based on Zhan et al. (2001, case 1).
4148	!------------------------------------------------------------------------------!
4149
4150	SUBROUTINE depo_vel_Z01( vc, ustar, schmidt_num, diameter, alpha, gamma, par_a, depo )
4151
4152	IMPLICIT NONE
4153
4154	REAL(wp) :: rs !< overall quasi-laminar resistance for particles
4155	REAL(wp) :: stokes_num !< Stokes number for smooth or bluff surfaces
4156
4157	REAL(wp), INTENT(in) :: alpha !< parameter, Table 3 in Z01
4158	REAL(wp), INTENT(in) :: gamma !< parameter, Table 3 in Z01
4159	REAL(wp), INTENT(in) :: par_a !< parameter A for the characteristic diameter of
4160	!< collectors, Table 3 in Z01
4161	REAL(wp), INTENT(in) :: diameter !< particle diameter
4162	REAL(wp), INTENT(in) :: schmidt_num !< particle Schmidt number
4163	REAL(wp), INTENT(in) :: ustar !< friction velocity (m/s)
4164	REAL(wp), INTENT(in) :: vc !< terminal velocity (m/s)
4165
4166	REAL(wp), INTENT(inout) :: depo !< deposition efficiency (m/s)
4167
4168	IF ( par_a > 0.0_wp ) THEN
4169	!
4170	!-- Initialise
4171	rs = 0.0_wp
4172	!
4173	!-- Stokes number for vegetated surfaces (Seinfeld & Pandis (2006): Eq.19.24)
4174	stokes_num = vc * ustar / ( g * par_a )
4175	!
4176	!-- The overall quasi-laminar resistance for particles (Zhang et al., Eq. 5)
4177	rs = MAX( EPSILON( 1.0_wp ), ( 3.0_wp * ustar * EXP( -stokes_num*0.5_wp ) &
4178	( schmidt_num( -gamma ) + ( stokes_num / ( alpha + stokes_num ) )2 + &
4179	0.5_wp * ( diameter / par_a )**2 ) ) )
4180
4181	depo = rs + vc
4182
4183	ELSE
4184	depo = 0.0_wp
4185	ENDIF
4186
4187	END SUBROUTINE depo_vel_Z01
4188
4189	!------------------------------------------------------------------------------!
4190	! Description:
4191	! ------------
4192	!> Calculate deposition velocity (m/s) based on Petroff & Zhang (2010, case 2).
4193	!------------------------------------------------------------------------------!
4194
4195	SUBROUTINE depo_vel_P10( vc, mag_u, ustar, kvis_a, schmidt_num, diameter, par_l, c_brownian_diff, &
4196	c_interception, c_impaction, beta_im, c_turb_impaction, depo )
4197
4198	IMPLICIT NONE
4199
4200	REAL(wp) :: stokes_num !< Stokes number for smooth or bluff surfaces
4201	REAL(wp) :: tau_plus !< dimensionless particle relaxation time
4202	REAL(wp) :: v_bd !< deposition velocity due to Brownian diffusion
4203	REAL(wp) :: v_im !< deposition velocity due to impaction
4204	REAL(wp) :: v_in !< deposition velocity due to interception
4205	REAL(wp) :: v_it !< deposition velocity due to turbulent impaction
4206
4207	REAL(wp), INTENT(in) :: beta_im !< parameter for turbulent impaction
4208	REAL(wp), INTENT(in) :: c_brownian_diff !< coefficient for Brownian diffusion
4209	REAL(wp), INTENT(in) :: c_impaction !< coefficient for inertial impaction
4210	REAL(wp), INTENT(in) :: c_interception !< coefficient for interception
4211	REAL(wp), INTENT(in) :: c_turb_impaction !< coefficient for turbulent impaction
4212	REAL(wp), INTENT(in) :: kvis_a !< kinematic viscosity of air (m2/s)
4213	REAL(wp), INTENT(in) :: mag_u !< wind velocity (m/s)
4214	REAL(wp), INTENT(in) :: par_l !< obstacle characteristic dimension in P10
4215	REAL(wp), INTENT(in) :: diameter !< particle diameter
4216	REAL(wp), INTENT(in) :: schmidt_num !< particle Schmidt number
4217	REAL(wp), INTENT(in) :: ustar !< friction velocity (m/s)
4218	REAL(wp), INTENT(in) :: vc !< terminal velocity (m/s)
4219
4220	REAL(wp), INTENT(inout) :: depo !< deposition efficiency (m/s)
4221
4222	IF ( par_l > 0.0_wp ) THEN
4223	!
4224	!-- Initialise
4225	tau_plus = 0.0_wp
4226	v_bd = 0.0_wp
4227	v_im = 0.0_wp
4228	v_in = 0.0_wp
4229	v_it = 0.0_wp
4230	!
4231	!-- Stokes number for vegetated surfaces (Seinfeld & Pandis (2006): Eq.19.24)
4232	stokes_num = vc * ustar / ( g * par_l )
4233	!
4234	!-- Non-dimensional relexation time of the particle on top of canopy
4235	tau_plus = vc * ustar*2 / ( kvis_a g )
4236	!
4237	!-- Brownian diffusion
4238	v_bd = mag_u * c_brownian_diff * schmidt_num*( -0.66666666_wp ) &
4239	( mag_u * par_l / kvis_a )**( -0.5_wp )
4240	!
4241	!-- Interception
4242	v_in = mag_u * c_interception * diameter / par_l * &
4243	( 2.0_wp + LOG( 2.0_wp * par_l / diameter ) )
4244	!
4245	!-- Impaction: Petroff (2009) Eq. 18
4246	v_im = mag_u * c_impaction * ( stokes_num / ( stokes_num + beta_im ) )**2
4247	!
4248	!-- Turbulent impaction
4249	IF ( tau_plus < 20.0_wp ) THEN
4250	v_it = 2.5E-3_wp * c_turb_impaction * tau_plus**2
4251	ELSE
4252	v_it = c_turb_impaction
4253	ENDIF
4254
4255	depo = ( v_bd + v_in + v_im + v_it + vc )
4256
4257	ELSE
4258	depo = 0.0_wp
4259	ENDIF
4260
4261	END SUBROUTINE depo_vel_P10
4262
4263	!------------------------------------------------------------------------------!
4264	! Description:
4265	! ------------
4266	!> Calculate the dry deposition on horizontal and vertical surfaces. Implement
4267	!> as a surface flux.
4268	!> @todo aerodynamic resistance ignored for now (not important for
4269	! high-resolution simulations)
4270	!------------------------------------------------------------------------------!
4271	SUBROUTINE depo_surf( i, j, surf, vc, schmidt_num, kvis, mag_u, norm, match_array )
4272
4273	USE arrays_3d, &
4274	ONLY: rho_air_zw
4275
4276	USE surface_mod, &
4277	ONLY: ind_pav_green, ind_veg_wall, ind_wat_win, surf_type
4278
4279	IMPLICIT NONE
4280
4281	INTEGER(iwp) :: ib !< loop index
4282	INTEGER(iwp) :: ic !< loop index
4283	INTEGER(iwp) :: icc !< additional loop index
4284	INTEGER(iwp) :: k !< loop index
4285	INTEGER(iwp) :: m !< loop index
4286	INTEGER(iwp) :: surf_e !< End index of surface elements at (j,i)-gridpoint
4287	INTEGER(iwp) :: surf_s !< Start index of surface elements at (j,i)-gridpoint
4288
4289	INTEGER(iwp), INTENT(in) :: i !< loop index
4290	INTEGER(iwp), INTENT(in) :: j !< loop index
4291
4292	LOGICAL, INTENT(in) :: norm !< to normalise or not
4293
4294	REAL(wp) :: alpha !< parameter, Table 3 in Z01
4295	REAL(wp) :: beta_im !< parameter for turbulent impaction
4296	REAL(wp) :: c_brownian_diff !< coefficient for Brownian diffusion
4297	REAL(wp) :: c_impaction !< coefficient for inertial impaction
4298	REAL(wp) :: c_interception !< coefficient for interception
4299	REAL(wp) :: c_turb_impaction !< coefficient for turbulent impaction
4300	REAL(wp) :: gamma !< parameter, Table 3 in Z01
4301	REAL(wp) :: norm_fac !< normalisation factor (usually air density)
4302	REAL(wp) :: par_a !< parameter A for the characteristic radius of collectors,
4303	!< Table 3 in Z01
4304	REAL(wp) :: par_l !< obstacle characteristic dimension in P10
4305	REAL(wp) :: rs !< the overall quasi-laminar resistance for particles
4306	REAL(wp) :: tau_plus !< dimensionless particle relaxation time
4307	REAL(wp) :: v_bd !< deposition velocity due to Brownian diffusion
4308	REAL(wp) :: v_im !< deposition velocity due to impaction
4309	REAL(wp) :: v_in !< deposition velocity due to interception
4310	REAL(wp) :: v_it !< deposition velocity due to turbulent impaction
4311
4312	REAL(wp), DIMENSION(nbins_aerosol) :: depo !< deposition efficiency
4313	REAL(wp), DIMENSION(nbins_aerosol) :: depo_sum !< sum of deposition efficiencies
4314
4315	REAL(wp), DIMENSION(:), INTENT(in) :: kvis !< kinematic viscosity of air (m2/s)
4316	REAL(wp), DIMENSION(:), INTENT(in) :: mag_u !< wind velocity (m/s)
4317
4318	REAL(wp), DIMENSION(:,:), INTENT(in) :: schmidt_num !< particle Schmidt number
4319	REAL(wp), DIMENSION(:,:), INTENT(in) :: vc !< terminal velocity (m/s)
4320
4321	TYPE(match_surface), INTENT(in), OPTIONAL :: match_array !< match the deposition module and
4322	!< LSM/USM surfaces
4323	TYPE(surf_type), INTENT(inout) :: surf !< respective surface type
4324	!
4325	!-- Initialise
4326	depo = 0.0_wp
4327	depo_sum = 0.0_wp
4328	rs = 0.0_wp
4329	surf_s = surf%start_index(j,i)
4330	surf_e = surf%end_index(j,i)
4331	tau_plus = 0.0_wp
4332	v_bd = 0.0_wp
4333	v_im = 0.0_wp
4334	v_in = 0.0_wp
4335	v_it = 0.0_wp
4336	!
4337	!-- Model parameters for the land use category. If LSM or USM is applied, import
4338	!-- characteristics. Otherwise, apply surface type "urban".
4339	alpha = alpha_z01(luc_urban)
4340	gamma = gamma_z01(luc_urban)
4341	par_a = A_z01(luc_urban, season_z01) * 1.0E-3_wp
4342
4343	par_l = l_p10(luc_urban) * 0.01_wp
4344	c_brownian_diff = c_b_p10(luc_urban)
4345	c_interception = c_in_p10(luc_urban)
4346	c_impaction = c_im_p10(luc_urban)
4347	beta_im = beta_im_p10(luc_urban)
4348	c_turb_impaction = c_it_p10(luc_urban)
4349
4350
4351	IF ( PRESENT( match_array ) ) THEN ! land or urban surface model
4352
4353	DO m = surf_s, surf_e
4354
4355	k = surf%k(m)
4356	norm_fac = 1.0_wp
4357
4358	IF ( norm ) norm_fac = rho_air_zw(k) ! normalise vertical fluxes by air density
4359
4360	IF ( match_array%match_lupg(m) > 0 ) THEN
4361	alpha = alpha_z01( match_array%match_lupg(m) )
4362	gamma = gamma_z01( match_array%match_lupg(m) )
4363	par_a = A_z01( match_array%match_lupg(m), season_z01 ) * 1.0E-3_wp
4364
4365	beta_im = beta_im_p10( match_array%match_lupg(m) )
4366	c_brownian_diff = c_b_p10( match_array%match_lupg(m) )
4367	c_impaction = c_im_p10( match_array%match_lupg(m) )
4368	c_interception = c_in_p10( match_array%match_lupg(m) )
4369	c_turb_impaction = c_it_p10( match_array%match_lupg(m) )
4370	par_l = l_p10( match_array%match_lupg(m) ) * 0.01_wp
4371
4372	DO ib = 1, nbins_aerosol
4373	IF ( aerosol_number(ib)%conc(k,j,i) < ( 2.0_wp * nclim ) .OR. &
4374	schmidt_num(k+1,ib) < 1.0_wp ) CYCLE
4375
4376	SELECT CASE ( depo_surf_par_num )
4377
4378	CASE ( 1 )
4379	CALL depo_vel_Z01( vc(k+1,ib), surf%us(m), schmidt_num(k+1,ib), &
4380	ra_dry(k,j,i,ib), alpha, gamma, par_a, depo(ib) )
4381	CASE ( 2 )
4382	CALL depo_vel_P10( vc(k+1,ib), mag_u(k+1), surf%us(m), kvis(k+1), &
4383	schmidt_num(k+1,ib), ra_dry(k,j,i,ib), par_l, &
4384	c_brownian_diff, c_interception, c_impaction, beta_im, &
4385	c_turb_impaction, depo(ib) )
4386	END SELECT
4387	ENDDO
4388	depo_sum = depo_sum + surf%frac(ind_pav_green,m) * depo
4389	ENDIF
4390
4391	IF ( match_array%match_luvw(m) > 0 ) THEN
4392	alpha = alpha_z01( match_array%match_luvw(m) )
4393	gamma = gamma_z01( match_array%match_luvw(m) )
4394	par_a = A_z01( match_array%match_luvw(m), season_z01 ) * 1.0E-3_wp
4395
4396	beta_im = beta_im_p10( match_array%match_luvw(m) )
4397	c_brownian_diff = c_b_p10( match_array%match_luvw(m) )
4398	c_impaction = c_im_p10( match_array%match_luvw(m) )
4399	c_interception = c_in_p10( match_array%match_luvw(m) )
4400	c_turb_impaction = c_it_p10( match_array%match_luvw(m) )
4401	par_l = l_p10( match_array%match_luvw(m) ) * 0.01_wp
4402
4403	DO ib = 1, nbins_aerosol
4404	IF ( aerosol_number(ib)%conc(k,j,i) < ( 2.0_wp * nclim ) .OR. &
4405	schmidt_num(k+1,ib) < 1.0_wp ) CYCLE
4406
4407	SELECT CASE ( depo_surf_par_num )
4408
4409	CASE ( 1 )
4410	CALL depo_vel_Z01( vc(k+1,ib), surf%us(m), schmidt_num(k+1,ib), &
4411	ra_dry(k,j,i,ib), alpha, gamma, par_a, depo(ib) )
4412	CASE ( 2 )
4413	CALL depo_vel_P10( vc(k+1,ib), mag_u(k+1), surf%us(m), kvis(k+1), &
4414	schmidt_num(k+1,ib), ra_dry(k,j,i,ib), par_l, &
4415	c_brownian_diff, c_interception, c_impaction, beta_im, &
4416	c_turb_impaction, depo(ib) )
4417	END SELECT
4418	ENDDO
4419	depo_sum = depo_sum + surf%frac(ind_veg_wall,m) * depo
4420	ENDIF
4421
4422	IF ( match_array%match_luww(m) > 0 ) THEN
4423	alpha = alpha_z01( match_array%match_luww(m) )
4424	gamma = gamma_z01( match_array%match_luww(m) )
4425	par_a = A_z01( match_array%match_luww(m), season_z01 ) * 1.0E-3_wp
4426
4427	beta_im = beta_im_p10( match_array%match_luww(m) )
4428	c_brownian_diff = c_b_p10( match_array%match_luww(m) )
4429	c_impaction = c_im_p10( match_array%match_luww(m) )
4430	c_interception = c_in_p10( match_array%match_luww(m) )
4431	c_turb_impaction = c_it_p10( match_array%match_luww(m) )
4432	par_l = l_p10( match_array%match_luww(m) ) * 0.01_wp
4433
4434	DO ib = 1, nbins_aerosol
4435	IF ( aerosol_number(ib)%conc(k,j,i) < ( 2.0_wp * nclim ) .OR. &
4436	schmidt_num(k+1,ib) < 1.0_wp ) CYCLE
4437
4438	SELECT CASE ( depo_surf_par_num )
4439
4440	CASE ( 1 )
4441	CALL depo_vel_Z01( vc(k+1,ib), surf%us(m), schmidt_num(k+1,ib), &
4442	ra_dry(k,j,i,ib), alpha, gamma, par_a, depo(ib) )
4443	CASE ( 2 )
4444	CALL depo_vel_P10( vc(k+1,ib), mag_u(k+1), surf%us(m), kvis(k+1), &
4445	schmidt_num(k+1,ib), ra_dry(k,j,i,ib), par_l, &
4446	c_brownian_diff, c_interception, c_impaction, beta_im, &
4447	c_turb_impaction, depo(ib) )
4448	END SELECT
4449	ENDDO
4450	depo_sum = depo_sum + surf%frac(ind_wat_win,m) * depo
4451	ENDIF
4452
4453	DO ib = 1, nbins_aerosol
4454	IF ( aerosol_number(ib)%conc(k,j,i) < ( 2.0_wp * nclim ) ) CYCLE
4455	!
4456	!-- Calculate changes in surface fluxes due to dry deposition
4457	IF ( include_emission ) THEN
4458	surf%answs(m,ib) = aerosol_number(ib)%source(j,i) - MAX( 0.0_wp, &
4459	depo_sum(ib) * norm_fac * aerosol_number(ib)%conc(k,j,i) )
4460	DO ic = 1, ncomponents_mass
4461	icc = ( ic - 1 ) * nbins_aerosol + ib
4462	surf%amsws(m,icc) = aerosol_mass(icc)%source(j,i) - MAX( 0.0_wp, &
4463	depo_sum(ib) * norm_fac * aerosol_mass(icc)%conc(k,j,i) )
4464	ENDDO ! ic
4465	ELSE
4466	surf%answs(m,ib) = -depo_sum(ib) * norm_fac * aerosol_number(ib)%conc(k,j,i)
4467	DO ic = 1, ncomponents_mass
4468	icc = ( ic - 1 ) * nbins_aerosol + ib
4469	surf%amsws(m,icc) = -depo_sum(ib) * norm_fac * aerosol_mass(icc)%conc(k,j,i)
4470	ENDDO ! ic
4471	ENDIF
4472	ENDDO ! ib
4473
4474	ENDDO
4475
4476	ELSE ! default surfaces
4477
4478	DO m = surf_s, surf_e
4479
4480	k = surf%k(m)
4481	norm_fac = 1.0_wp
4482
4483	IF ( norm ) norm_fac = rho_air_zw(k) ! normalise vertical fluxes by air density
4484
4485	DO ib = 1, nbins_aerosol
4486	IF ( aerosol_number(ib)%conc(k,j,i) < ( 2.0_wp * nclim ) .OR. &
4487	schmidt_num(k+1,ib) < 1.0_wp ) CYCLE
4488
4489	SELECT CASE ( depo_surf_par_num )
4490
4491	CASE ( 1 )
4492	CALL depo_vel_Z01( vc(k+1,ib), surf%us(m), schmidt_num(k+1,ib), &
4493	ra_dry(k,j,i,ib), alpha, gamma, par_a, depo(ib) )
4494	CASE ( 2 )
4495	CALL depo_vel_P10( vc(k+1,ib), mag_u(k+1), surf%us(m), kvis(k+1), &
4496	schmidt_num(k+1,ib), ra_dry(k,j,i,ib), par_l, &
4497	c_brownian_diff, c_interception, c_impaction, beta_im, &
4498	c_turb_impaction, depo(ib) )
4499	END SELECT
4500	!
4501	!-- Calculate changes in surface fluxes due to dry deposition
4502	IF ( include_emission ) THEN
4503	surf%answs(m,ib) = aerosol_number(ib)%source(j,i) - MAX( 0.0_wp, &
4504	depo(ib) * norm_fac * aerosol_number(ib)%conc(k,j,i) )
4505	DO ic = 1, ncomponents_mass
4506	icc = ( ic - 1 ) * nbins_aerosol + ib
4507	surf%amsws(m,icc) = aerosol_mass(icc)%source(j,i) - MAX( 0.0_wp, &
4508	depo(ib) * norm_fac * aerosol_mass(icc)%conc(k,j,i) )
4509	ENDDO ! ic
4510	ELSE
4511	surf%answs(m,ib) = -depo(ib) * norm_fac * aerosol_number(ib)%conc(k,j,i)
4512	DO ic = 1, ncomponents_mass
4513	icc = ( ic - 1 ) * nbins_aerosol + ib
4514	surf%amsws(m,icc) = -depo(ib) * norm_fac * aerosol_mass(icc)%conc(k,j,i)
4515	ENDDO ! ic
4516	ENDIF
4517	ENDDO ! ib
4518	ENDDO
4519
4520	ENDIF
4521
4522	END SUBROUTINE depo_surf
4523
4524	!------------------------------------------------------------------------------!
4525	! Description:
4526	! ------------
4527	!> Calculates particle loss and change in size distribution due to (Brownian)
4528	!> coagulation. Only for particles with dwet < 30 micrometres.
4529	!
4530	!> Method:
4531	!> Semi-implicit, non-iterative method: (Jacobson, 1994)
4532	!> Volume concentrations of the smaller colliding particles added to the bin of
4533	!> the larger colliding particles. Start from first bin and use the updated
4534	!> number and volume for calculation of following bins. NB! Our bin numbering
4535	!> does not follow particle size in subrange 2.
4536	!
4537	!> Schematic for bin numbers in different subranges:
4538	!> 1 2
4539	!> +-------------------------------------------+
4540	!> a \| 1 \| 2 \| 3 \|\| 4 \| 5 \| 6 \| 7 \| 8 \| 9 \| 10\|\|
4541	!> b \| \|\|11 \|12 \|13 \|14 \| 15 \| 16 \| 17\|\|
4542	!> +-------------------------------------------+
4543	!
4544	!> Exact coagulation coefficients for each pressure level are scaled according
4545	!> to current particle wet size (linear scaling).
4546	!> Bins are organized in terms of the dry size of the condensation nucleus,
4547	!> while coagulation kernell is calculated with the actual hydrometeor
4548	!> size.
4549	!
4550	!> Called from salsa_driver
4551	!> fxm: Process selection should be made smarter - now just lots of IFs inside
4552	!> loops
4553	!
4554	!> Coded by:
4555	!> Hannele Korhonen (FMI) 2005
4556	!> Harri Kokkola (FMI) 2006
4557	!> Tommi Bergman (FMI) 2012
4558	!> Matti Niskanen(FMI) 2012
4559	!> Anton Laakso (FMI) 2013
4560	!> Juha Tonttila (FMI) 2014
4561	!------------------------------------------------------------------------------!
4562	SUBROUTINE coagulation( paero, ptstep, ptemp, ppres )
4563
4564	IMPLICIT NONE
4565
4566	INTEGER(iwp) :: index_2a !< corresponding bin in subrange 2a
4567	INTEGER(iwp) :: index_2b !< corresponding bin in subrange 2b
4568	INTEGER(iwp) :: ib !< loop index
4569	INTEGER(iwp) :: ll !< loop index
4570	INTEGER(iwp) :: mm !< loop index
4571	INTEGER(iwp) :: nn !< loop index
4572
4573	REAL(wp) :: pressi !< pressure
4574	REAL(wp) :: temppi !< temperature
4575	REAL(wp) :: zdpart_mm !< diameter of particle (m)
4576	REAL(wp) :: zdpart_nn !< diameter of particle (m)
4577	REAL(wp) :: zminusterm !< coagulation loss in a bin (1/s)
4578
4579	REAL(wp), INTENT(in) :: ppres !< ambient pressure (Pa)
4580	REAL(wp), INTENT(in) :: ptemp !< ambient temperature (K)
4581	REAL(wp), INTENT(in) :: ptstep !< time step (s)
4582
4583	REAL(wp), DIMENSION(nbins_aerosol) :: zmpart !< approximate mass of particles (kg)
4584	REAL(wp), DIMENSION(maxspec+1) :: zplusterm !< coagulation gain in a bin (for each
4585	!< chemical compound)
4586	REAL(wp), DIMENSION(nbins_aerosol,nbins_aerosol) :: zcc !< updated coagulation coeff. (m3/s)
4587
4588	TYPE(t_section), DIMENSION(nbins_aerosol), INTENT(inout) :: paero !< Aerosol properties
4589
4590	zdpart_mm = 0.0_wp
4591	zdpart_nn = 0.0_wp
4592	!
4593	!-- 1) Coagulation to coarse mode calculated in a simplified way:
4594	!-- CoagSink ~ Dp in continuum subrange --> 'effective' number conc. of coarse particles
4595
4596	!-- 2) Updating coagulation coefficients
4597	!
4598	!-- Aerosol mass (kg). Density of 1500 kg/m3 assumed
4599	zmpart(1:end_subrange_2b) = api6 * ( MIN( paero(1:end_subrange_2b)%dwet, 30.0E-6_wp )**3 ) &
4600	* 1500.0_wp
4601	temppi = ptemp
4602	pressi = ppres
4603	zcc = 0.0_wp
4604	!
4605	!-- Aero-aero coagulation
4606	DO mm = 1, end_subrange_2b ! smaller colliding particle
4607	IF ( paero(mm)%numc < ( 2.0_wp * nclim ) ) CYCLE
4608	DO nn = mm, end_subrange_2b ! larger colliding particle
4609	IF ( paero(nn)%numc < ( 2.0_wp * nclim ) ) CYCLE
4610
4611	zdpart_mm = MIN( paero(mm)%dwet, 30.0E-6_wp ) ! Limit to 30 um
4612	zdpart_nn = MIN( paero(nn)%dwet, 30.0E-6_wp ) ! Limit to 30 um
4613	!
4614	!-- Coagulation coefficient of particles (m3/s)
4615	zcc(mm,nn) = coagc( zdpart_mm, zdpart_nn, zmpart(mm), zmpart(nn), temppi, pressi )
4616	zcc(nn,mm) = zcc(mm,nn)
4617	ENDDO
4618	ENDDO
4619
4620	!
4621	!-- 3) New particle and volume concentrations after coagulation:
4622	!-- Calculated according to Jacobson (2005) eq. 15.9
4623	!
4624	!-- Aerosols in subrange 1a:
4625	DO ib = start_subrange_1a, end_subrange_1a
4626	IF ( paero(ib)%numc < ( 2.0_wp * nclim ) ) CYCLE
4627	zminusterm = 0.0_wp
4628	zplusterm(:) = 0.0_wp
4629	!
4630	!-- Particles lost by coagulation with larger aerosols
4631	DO ll = ib+1, end_subrange_2b
4632	zminusterm = zminusterm + zcc(ib,ll) * paero(ll)%numc
4633	ENDDO
4634	!
4635	!-- Coagulation gain in a bin: change in volume conc. (cm3/cm3):
4636	DO ll = start_subrange_1a, ib - 1
4637	zplusterm(1:2) = zplusterm(1:2) + zcc(ll,ib) * paero(ll)%volc(1:2)
4638	zplusterm(6:7) = zplusterm(6:7) + zcc(ll,ib) * paero(ll)%volc(6:7)
4639	zplusterm(8) = zplusterm(8) + zcc(ll,ib) * paero(ll)%volc(8)
4640	ENDDO
4641	!
4642	!-- Volume and number concentrations after coagulation update [fxm]
4643	paero(ib)%volc(1:2) = ( paero(ib)%volc(1:2) + ptstep * zplusterm(1:2) * paero(ib)%numc ) / &
4644	( 1.0_wp + ptstep * zminusterm )
4645	paero(ib)%volc(6:8) = ( paero(ib)%volc(6:8) + ptstep * zplusterm(6:8) * paero(ib)%numc ) / &
4646	( 1.0_wp + ptstep * zminusterm )
4647	paero(ib)%numc = paero(ib)%numc / ( 1.0_wp + ptstep * zminusterm + 0.5_wp * ptstep * &
4648	zcc(ib,ib) * paero(ib)%numc )
4649	ENDDO
4650	!
4651	!-- Aerosols in subrange 2a:
4652	DO ib = start_subrange_2a, end_subrange_2a
4653	IF ( paero(ib)%numc < ( 2.0_wp * nclim ) ) CYCLE
4654	zminusterm = 0.0_wp
4655	zplusterm(:) = 0.0_wp
4656	!
4657	!-- Find corresponding size bin in subrange 2b
4658	index_2b = ib - start_subrange_2a + start_subrange_2b
4659	!
4660	!-- Particles lost by larger particles in 2a
4661	DO ll = ib+1, end_subrange_2a
4662	zminusterm = zminusterm + zcc(ib,ll) * paero(ll)%numc
4663	ENDDO
4664	!
4665	!-- Particles lost by larger particles in 2b
4666	IF ( .NOT. no_insoluble ) THEN
4667	DO ll = index_2b+1, end_subrange_2b
4668	zminusterm = zminusterm + zcc(ib,ll) * paero(ll)%numc
4669	ENDDO
4670	ENDIF
4671	!
4672	!-- Particle volume gained from smaller particles in subranges 1, 2a and 2b
4673	DO ll = start_subrange_1a, ib-1
4674	zplusterm(1:2) = zplusterm(1:2) + zcc(ll,ib) * paero(ll)%volc(1:2)
4675	zplusterm(6:8) = zplusterm(6:8) + zcc(ll,ib) * paero(ll)%volc(6:8)
4676	ENDDO
4677	!
4678	!-- Particle volume gained from smaller particles in 2a
4679	!-- (Note, for components not included in the previous loop!)
4680	DO ll = start_subrange_2a, ib-1
4681	zplusterm(3:5) = zplusterm(3:5) + zcc(ll,ib)*paero(ll)%volc(3:5)
4682	ENDDO
4683	!
4684	!-- Particle volume gained from smaller (and equal) particles in 2b
4685	IF ( .NOT. no_insoluble ) THEN
4686	DO ll = start_subrange_2b, index_2b
4687	zplusterm(1:8) = zplusterm(1:8) + zcc(ll,ib) * paero(ll)%volc(1:8)
4688	ENDDO
4689	ENDIF
4690	!
4691	!-- Volume and number concentrations after coagulation update [fxm]
4692	paero(ib)%volc(1:8) = ( paero(ib)%volc(1:8) + ptstep * zplusterm(1:8) * paero(ib)%numc ) / &
4693	( 1.0_wp + ptstep * zminusterm )
4694	paero(ib)%numc = paero(ib)%numc / ( 1.0_wp + ptstep * zminusterm + 0.5_wp * ptstep * &
4695	zcc(ib,ib) * paero(ib)%numc )
4696	ENDDO
4697	!
4698	!-- Aerosols in subrange 2b:
4699	IF ( .NOT. no_insoluble ) THEN
4700	DO ib = start_subrange_2b, end_subrange_2b
4701	IF ( paero(ib)%numc < ( 2.0_wp * nclim ) ) CYCLE
4702	zminusterm = 0.0_wp
4703	zplusterm(:) = 0.0_wp
4704	!
4705	!-- Find corresponding size bin in subsubrange 2a
4706	index_2a = ib - start_subrange_2b + start_subrange_2a
4707	!
4708	!-- Particles lost to larger particles in subranges 2b
4709	DO ll = ib + 1, end_subrange_2b
4710	zminusterm = zminusterm + zcc(ib,ll) * paero(ll)%numc
4711	ENDDO
4712	!
4713	!-- Particles lost to larger and equal particles in 2a
4714	DO ll = index_2a, end_subrange_2a
4715	zminusterm = zminusterm + zcc(ib,ll) * paero(ll)%numc
4716	ENDDO
4717	!
4718	!-- Particle volume gained from smaller particles in subranges 1 & 2a
4719	DO ll = start_subrange_1a, index_2a - 1
4720	zplusterm(1:8) = zplusterm(1:8) + zcc(ll,ib) * paero(ll)%volc(1:8)
4721	ENDDO
4722	!
4723	!-- Particle volume gained from smaller particles in 2b
4724	DO ll = start_subrange_2b, ib - 1
4725	zplusterm(1:8) = zplusterm(1:8) + zcc(ll,ib) * paero(ll)%volc(1:8)
4726	ENDDO
4727	!
4728	!-- Volume and number concentrations after coagulation update [fxm]
4729	paero(ib)%volc(1:8) = ( paero(ib)%volc(1:8) + ptstep * zplusterm(1:8) * paero(ib)%numc ) &
4730	/ ( 1.0_wp + ptstep * zminusterm )
4731	paero(ib)%numc = paero(ib)%numc / ( 1.0_wp + ptstep * zminusterm + 0.5_wp * ptstep * &
4732	zcc(ib,ib) * paero(ib)%numc )
4733	ENDDO
4734	ENDIF
4735
4736	END SUBROUTINE coagulation
4737
4738	!------------------------------------------------------------------------------!
4739	! Description:
4740	! ------------
4741	!> Calculation of coagulation coefficients. Extended version of the function
4742	!> originally found in mo_salsa_init.
4743	!
4744	!> J. Tonttila, FMI, 05/2014
4745	!------------------------------------------------------------------------------!
4746	REAL(wp) FUNCTION coagc( diam1, diam2, mass1, mass2, temp, pres )
4747
4748	IMPLICIT NONE
4749
4750	REAL(wp) :: fmdist !< distance of flux matching (m)
4751	REAL(wp) :: knud_p !< particle Knudsen number
4752	REAL(wp) :: mdiam !< mean diameter of colliding particles (m)
4753	REAL(wp) :: mfp !< mean free path of air molecules (m)
4754	REAL(wp) :: visc !< viscosity of air (kg/(m s))
4755
4756	REAL(wp), INTENT(in) :: diam1 !< diameter of colliding particle 1 (m)
4757	REAL(wp), INTENT(in) :: diam2 !< diameter of colliding particle 2 (m)
4758	REAL(wp), INTENT(in) :: mass1 !< mass of colliding particle 1 (kg)
4759	REAL(wp), INTENT(in) :: mass2 !< mass of colliding particle 2 (kg)
4760	REAL(wp), INTENT(in) :: pres !< ambient pressure (Pa?) [fxm]
4761	REAL(wp), INTENT(in) :: temp !< ambient temperature (K)
4762
4763	REAL(wp), DIMENSION (2) :: beta !< Cunningham correction factor
4764	REAL(wp), DIMENSION (2) :: dfpart !< particle diffusion coefficient (m2/s)
4765	REAL(wp), DIMENSION (2) :: diam !< diameters of particles (m)
4766	REAL(wp), DIMENSION (2) :: flux !< flux in continuum and free molec. regime (m/s)
4767	REAL(wp), DIMENSION (2) :: knud !< particle Knudsen number
4768	REAL(wp), DIMENSION (2) :: mpart !< masses of particles (kg)
4769	REAL(wp), DIMENSION (2) :: mtvel !< particle mean thermal velocity (m/s)
4770	REAL(wp), DIMENSION (2) :: omega !< particle mean free path
4771	REAL(wp), DIMENSION (2) :: tva !< temporary variable (m)
4772	!
4773	!-- Initialisation
4774	coagc = 0.0_wp
4775	!
4776	!-- 1) Initializing particle and ambient air variables
4777	diam = (/ diam1, diam2 /) !< particle diameters (m)
4778	mpart = (/ mass1, mass2 /) !< particle masses (kg)
4779	!
4780	!-- Viscosity of air (kg/(m s))
4781	visc = ( 7.44523E-3_wp * temp ** 1.5_wp ) / ( 5093.0_wp * ( temp + 110.4_wp ) )
4782	!
4783	!-- Mean free path of air (m)
4784	mfp = ( 1.656E-10_wp * temp + 1.828E-8_wp ) * ( p_0 + 1325.0_wp ) / pres
4785	!
4786	!-- 2) Slip correction factor for small particles
4787	knud = 2.0_wp * EXP( LOG(mfp) - LOG(diam) )! Knudsen number for air (15.23)
4788	!
4789	!-- Cunningham correction factor (Allen and Raabe, Aerosol Sci. Tech. 4, 269)
4790	beta = 1.0_wp + knud * ( 1.142_wp + 0.558_wp * EXP( -0.999_wp / knud ) )
4791	!
4792	!-- 3) Particle properties
4793	!-- Diffusion coefficient (m2/s) (Jacobson (2005) eq. 15.29)
4794	dfpart = beta * abo * temp / ( 3.0_wp * pi * visc * diam )
4795	!
4796	!-- Mean thermal velocity (m/s) (Jacobson (2005) eq. 15.32)
4797	mtvel = SQRT( ( 8.0_wp * abo * temp ) / ( pi * mpart ) )
4798	!
4799	!-- Particle mean free path (m) (Jacobson (2005) eq. 15.34 )
4800	omega = 8.0_wp * dfpart / ( pi * mtvel )
4801	!
4802	!-- Mean diameter (m)
4803	mdiam = 0.5_wp * ( diam(1) + diam(2) )
4804	!
4805	!-- 4) Calculation of fluxes (Brownian collision kernels) and flux matching
4806	!-- following Jacobson (2005):
4807	!
4808	!-- Flux in continuum regime (m3/s) (eq. 15.28)
4809	flux(1) = 4.0_wp * pi * mdiam * ( dfpart(1) + dfpart(2) )
4810	!
4811	!-- Flux in free molec. regime (m3/s) (eq. 15.31)
4812	flux(2) = pi * SQRT( ( mtvel(1)2 ) + ( mtvel(2)2 ) ) * ( mdiam**2 )
4813	!
4814	!-- temporary variables (m) to calculate flux matching distance (m)
4815	tva(1) = ( ( mdiam + omega(1) )3 - ( mdiam2 + omega(1)*2 ) SQRT( ( mdiam**2 + &
4816	omega(1)*2 ) ) ) / ( 3.0_wp mdiam * omega(1) ) - mdiam
4817	tva(2) = ( ( mdiam + omega(2) )3 - ( mdiam2 + omega(2)*2 ) SQRT( ( mdiam**2 + &
4818	omega(2)*2 ) ) ) / ( 3.0_wp mdiam * omega(2) ) - mdiam
4819	!
4820	!-- Flux matching distance (m): the mean distance from the centre of a sphere reached by particles
4821	!-- that leave sphere's surface and travel a distance of particle mean free path (eq. 15.34)
4822	fmdist = SQRT( tva(1)2 + tva(2)2 )
4823	!
4824	!-- 5) Coagulation coefficient = coalescence efficiency * collision kernel (m3/s) (eq. 15.33).
4825	!-- Here assumed coalescence efficiency 1!!
4826	coagc = flux(1) / ( mdiam / ( mdiam + fmdist) + flux(1) / flux(2) )
4827	!
4828	!-- Corrected collision kernel (Karl et al., 2016 (ACP)): Include van der Waals and viscous forces
4829	IF ( van_der_waals_coagc ) THEN
4830	knud_p = SQRT( omega(1)2 + omega(2)2 ) / mdiam
4831	IF ( knud_p >= 0.1_wp .AND. knud_p <= 10.0_wp ) THEN
4832	coagc = coagc * ( 2.0_wp + 0.4_wp * LOG( knud_p ) )
4833	ELSE
4834	coagc = coagc * 3.0_wp
4835	ENDIF
4836	ENDIF
4837
4838	END FUNCTION coagc
4839
4840	!------------------------------------------------------------------------------!
4841	! Description:
4842	! ------------
4843	!> Calculates the change in particle volume and gas phase
4844	!> concentrations due to nucleation, condensation and dissolutional growth.
4845	!
4846	!> Sulphuric acid and organic vapour: only condensation and no evaporation.
4847	!
4848	!> New gas and aerosol phase concentrations calculated according to Jacobson
4849	!> (1997): Numerical techniques to solve condensational and dissolutional growth
4850	!> equations when growth is coupled to reversible reactions, Aerosol Sci. Tech.,
4851	!> 27, pp 491-498.
4852	!
4853	!> Following parameterization has been used:
4854	!> Molecular diffusion coefficient of condensing vapour (m2/s)
4855	!> (Reid et al. (1987): Properties of gases and liquids, McGraw-Hill, New York.)
4856	!> D = {1.d-7sqrt(1/M_air + 1/M_gas)T^1.75} / &
4857	! {p_atm/p_stand * (d_air^(1/3) + d_gas^(1/3))^2 }
4858	!> M_air = 28.965 : molar mass of air (g/mol)
4859	!> d_air = 19.70 : diffusion volume of air
4860	!> M_h2so4 = 98.08 : molar mass of h2so4 (g/mol)
4861	!> d_h2so4 = 51.96 : diffusion volume of h2so4
4862	!
4863	!> Called from main aerosol model
4864	!> For equations, see Jacobson, Fundamentals of Atmospheric Modeling, 2nd Edition (2005)
4865	!
4866	!> Coded by:
4867	!> Hannele Korhonen (FMI) 2005
4868	!> Harri Kokkola (FMI) 2006
4869	!> Juha Tonttila (FMI) 2014
4870	!> Rewritten to PALM by Mona Kurppa (UHel) 2017
4871	!------------------------------------------------------------------------------!
4872	SUBROUTINE condensation( paero, pc_sa, pc_ocnv, pcocsv, pchno3, pc_nh3, pcw, pcs, ptemp, ppres, &
4873	ptstep, prtcl )
4874
4875	IMPLICIT NONE
4876
4877	INTEGER(iwp) :: ss !< start index
4878	INTEGER(iwp) :: ee !< end index
4879
4880	REAL(wp) :: zcs_ocnv !< condensation sink of nonvolatile organics (1/s)
4881	REAL(wp) :: zcs_ocsv !< condensation sink of semivolatile organics (1/s)
4882	REAL(wp) :: zcs_su !< condensation sink of sulfate (1/s)
4883	REAL(wp) :: zcs_tot !< total condensation sink (1/s) (gases)
4884	REAL(wp) :: zcvap_new1 !< vapour concentration after time step (#/m3): sulphuric acid
4885	REAL(wp) :: zcvap_new2 !< nonvolatile organics
4886	REAL(wp) :: zcvap_new3 !< semivolatile organics
4887	REAL(wp) :: zdfvap !< air diffusion coefficient (m2/s)
4888	REAL(wp) :: zdvap1 !< change in vapour concentration (#/m3): sulphuric acid
4889	REAL(wp) :: zdvap2 !< nonvolatile organics
4890	REAL(wp) :: zdvap3 !< semivolatile organics
4891	REAL(wp) :: zmfp !< mean free path of condensing vapour (m)
4892	REAL(wp) :: zrh !< Relative humidity [0-1]
4893	REAL(wp) :: zvisc !< viscosity of air (kg/(m s))
4894	REAL(wp) :: zn_vs_c !< ratio of nucleation of all mass transfer in the smallest bin
4895	REAL(wp) :: zxocnv !< ratio of organic vapour in 3nm particles
4896	REAL(wp) :: zxsa !< Ratio in 3nm particles: sulphuric acid
4897
4898	REAL(wp), INTENT(in) :: ppres !< ambient pressure (Pa)
4899	REAL(wp), INTENT(in) :: pcs !< Water vapour saturation concentration (kg/m3)
4900	REAL(wp), INTENT(in) :: ptemp !< ambient temperature (K)
4901	REAL(wp), INTENT(in) :: ptstep !< timestep (s)
4902
4903	REAL(wp), INTENT(inout) :: pchno3 !< Gas concentrations (#/m3): nitric acid HNO3
4904	REAL(wp), INTENT(inout) :: pc_nh3 !< ammonia NH3
4905	REAL(wp), INTENT(inout) :: pc_ocnv !< non-volatile organics
4906	REAL(wp), INTENT(inout) :: pcocsv !< semi-volatile organics
4907	REAL(wp), INTENT(inout) :: pc_sa !< sulphuric acid H2SO4
4908	REAL(wp), INTENT(inout) :: pcw !< Water vapor concentration (kg/m3)
4909
4910	REAL(wp), DIMENSION(nbins_aerosol) :: zbeta !< transitional correction factor
4911	REAL(wp), DIMENSION(nbins_aerosol) :: zcolrate !< collision rate (1/s)
4912	REAL(wp), DIMENSION(nbins_aerosol) :: zcolrate_ocnv !< collision rate of OCNV (1/s)
4913	REAL(wp), DIMENSION(start_subrange_1a+1) :: zdfpart !< particle diffusion coef. (m2/s)
4914	REAL(wp), DIMENSION(nbins_aerosol) :: zdvoloc !< change of organics volume
4915	REAL(wp), DIMENSION(nbins_aerosol) :: zdvolsa !< change of sulphate volume
4916	REAL(wp), DIMENSION(2) :: zj3n3 !< Formation massrate of molecules
4917	!< in nucleation, (molec/m3s),
4918	!< 1: H2SO4 and 2: organic vapor
4919	REAL(wp), DIMENSION(nbins_aerosol) :: zknud !< particle Knudsen number
4920
4921	TYPE(component_index), INTENT(in) :: prtcl !< Keeps track which substances are used
4922
4923	TYPE(t_section), DIMENSION(nbins_aerosol), INTENT(inout) :: paero !< Aerosol properties
4924
4925	zj3n3 = 0.0_wp
4926	zrh = pcw / pcs
4927	zxocnv = 0.0_wp
4928	zxsa = 0.0_wp
4929	!
4930	!-- Nucleation
4931	IF ( nsnucl > 0 ) THEN
4932	CALL nucleation( paero, ptemp, zrh, ppres, pc_sa, pc_ocnv, pc_nh3, ptstep, zj3n3, zxsa, &
4933	zxocnv )
4934	ENDIF
4935	!
4936	!-- Condensation on pre-existing particles
4937	IF ( lscndgas ) THEN
4938	!
4939	!-- Initialise:
4940	zdvolsa = 0.0_wp
4941	zdvoloc = 0.0_wp
4942	zcolrate = 0.0_wp
4943	!
4944	!-- 1) Properties of air and condensing gases:
4945	!-- Viscosity of air (kg/(m s)) (Eq. 4.54 in Jabonson (2005))
4946	zvisc = ( 7.44523E-3_wp * ptemp ** 1.5_wp ) / ( 5093.0_wp * ( ptemp + 110.4_wp ) )
4947	!
4948	!-- Diffusion coefficient of air (m2/s)
4949	zdfvap = 5.1111E-10_wp * ptemp ** 1.75_wp * ( p_0 + 1325.0_wp ) / ppres
4950	!
4951	!-- Mean free path (m): same for H2SO4 and organic compounds
4952	zmfp = 3.0_wp * zdfvap * SQRT( pi * amh2so4 / ( 8.0_wp * argas * ptemp ) )
4953	!
4954	!-- 2) Transition regime correction factor zbeta for particles (Fuchs and Sutugin (1971)):
4955	!-- Size of condensing molecule considered only for nucleation mode (3 - 20 nm).
4956	!
4957	!-- Particle Knudsen number: condensation of gases on aerosols
4958	ss = start_subrange_1a
4959	ee = start_subrange_1a+1
4960	zknud(ss:ee) = 2.0_wp * zmfp / ( paero(ss:ee)%dwet + d_sa )
4961	ss = start_subrange_1a+2
4962	ee = end_subrange_2b
4963	zknud(ss:ee) = 2.0_wp * zmfp / paero(ss:ee)%dwet
4964	!
4965	!-- Transitional correction factor: aerosol + gas (the semi-empirical Fuchs- Sutugin
4966	!-- interpolation function (Fuchs and Sutugin, 1971))
4967	zbeta = ( zknud + 1.0_wp ) / ( 0.377_wp * zknud + 1.0_wp + 4.0_wp / ( 3.0_wp * massacc ) * &
4968	( zknud + zknud ** 2 ) )
4969	!
4970	!-- 3) Collision rate of molecules to particles
4971	!-- Particle diffusion coefficient considered only for nucleation mode (3 - 20 nm)
4972	!
4973	!-- Particle diffusion coefficient (m2/s) (e.g. Eq. 15.29 in Jacobson (2005))
4974	zdfpart = abo * ptemp * zbeta(start_subrange_1a:start_subrange_1a+1) / ( 3.0_wp * pi * zvisc&
4975	* paero(start_subrange_1a:start_subrange_1a+1)%dwet)
4976	!
4977	!-- Collision rate (mass-transfer coefficient): gases on aerosols (1/s) (Eq. 16.64 in
4978	!-- Jacobson (2005))
4979	ss = start_subrange_1a
4980	ee = start_subrange_1a+1
4981	zcolrate(ss:ee) = MERGE( 2.0_wp * pi * ( paero(ss:ee)%dwet + d_sa ) * ( zdfvap + zdfpart ) *&
4982	zbeta(ss:ee) * paero(ss:ee)%numc, 0.0_wp, paero(ss:ee)%numc > nclim )
4983	ss = start_subrange_1a+2
4984	ee = end_subrange_2b
4985	zcolrate(ss:ee) = MERGE( 2.0_wp * pi * paero(ss:ee)%dwet * zdfvap * zbeta(ss:ee) * &
4986	paero(ss:ee)%numc, 0.0_wp, paero(ss:ee)%numc > nclim )
4987	!
4988	!-- 4) Condensation sink (1/s)
4989	zcs_tot = SUM( zcolrate ) ! total sink
4990	!
4991	!-- 5) Changes in gas-phase concentrations and particle volume
4992	!
4993	!-- 5.1) Organic vapours
4994	!
4995	!-- 5.1.1) Non-volatile organic compound: condenses onto all bins
4996	IF ( pc_ocnv > 1.0E+10_wp .AND. zcs_tot > 1.0E-30_wp .AND. index_oc > 0 ) &
4997	THEN
4998	!-- Ratio of nucleation vs. condensation rates in the smallest bin
4999	zn_vs_c = 0.0_wp
5000	IF ( zj3n3(2) > 1.0_wp ) THEN
5001	zn_vs_c = ( zj3n3(2) ) / ( zj3n3(2) + pc_ocnv * zcolrate(start_subrange_1a) )
5002	ENDIF
5003	!
5004	!-- Collision rate in the smallest bin, including nucleation and condensation (see
5005	!-- Jacobson (2005), eq. (16.73) )
5006	zcolrate_ocnv = zcolrate
5007	zcolrate_ocnv(start_subrange_1a) = zcolrate_ocnv(start_subrange_1a) + zj3n3(2) / pc_ocnv
5008	!
5009	!-- Total sink for organic vapor
5010	zcs_ocnv = zcs_tot + zj3n3(2) / pc_ocnv
5011	!
5012	!-- New gas phase concentration (#/m3)
5013	zcvap_new2 = pc_ocnv / ( 1.0_wp + ptstep * zcs_ocnv )
5014	!
5015	!-- Change in gas concentration (#/m3)
5016	zdvap2 = pc_ocnv - zcvap_new2
5017	!
5018	!-- Updated vapour concentration (#/m3)
5019	pc_ocnv = zcvap_new2
5020	!
5021	!-- Volume change of particles (m3(OC)/m3(air))
5022	zdvoloc = zcolrate_ocnv(start_subrange_1a:end_subrange_2b) / zcs_ocnv * amvoc * zdvap2
5023	!
5024	!-- Change of volume due to condensation in 1a-2b
5025	paero(start_subrange_1a:end_subrange_2b)%volc(2) = &
5026	paero(start_subrange_1a:end_subrange_2b)%volc(2) + zdvoloc
5027	!
5028	!-- Change of number concentration in the smallest bin caused by nucleation (Jacobson (2005),
5029	!-- eq. (16.75)). If zxocnv = 0, then the chosen nucleation mechanism doesn't take into
5030	!-- account the non-volatile organic vapors and thus the paero doesn't have to be updated.
5031	IF ( zxocnv > 0.0_wp ) THEN
5032	paero(start_subrange_1a)%numc = paero(start_subrange_1a)%numc + zn_vs_c * &
5033	zdvoloc(start_subrange_1a) / amvoc / ( n3 * zxocnv )
5034	ENDIF
5035	ENDIF
5036	!
5037	!-- 5.1.2) Semivolatile organic compound: all bins except subrange 1
5038	zcs_ocsv = SUM( zcolrate(start_subrange_2a:end_subrange_2b) ) !< sink for semi-volatile org.
5039	IF ( pcocsv > 1.0E+10_wp .AND. zcs_ocsv > 1.0E-30 .AND. is_used( prtcl,'OC') ) THEN
5040	!
5041	!-- New gas phase concentration (#/m3)
5042	zcvap_new3 = pcocsv / ( 1.0_wp + ptstep * zcs_ocsv )
5043	!
5044	!-- Change in gas concentration (#/m3)
5045	zdvap3 = pcocsv - zcvap_new3
5046	!
5047	!-- Updated gas concentration (#/m3)
5048	pcocsv = zcvap_new3
5049	!
5050	!-- Volume change of particles (m3(OC)/m3(air))
5051	ss = start_subrange_2a
5052	ee = end_subrange_2b
5053	zdvoloc(ss:ee) = zdvoloc(ss:ee) + zcolrate(ss:ee) / zcs_ocsv * amvoc * zdvap3
5054	!
5055	!-- Change of volume due to condensation in 1a-2b
5056	paero(start_subrange_1a:end_subrange_2b)%volc(2) = &
5057	paero(start_subrange_1a:end_subrange_2b)%volc(2) + zdvoloc
5058	ENDIF
5059	!
5060	!-- 5.2) Sulphate: condensed on all bins
5061	IF ( pc_sa > 1.0E+10_wp .AND. zcs_tot > 1.0E-30_wp .AND. index_so4 > 0 ) THEN
5062	!
5063	!-- Ratio of mass transfer between nucleation and condensation
5064	zn_vs_c = 0.0_wp
5065	IF ( zj3n3(1) > 1.0_wp ) THEN
5066	zn_vs_c = ( zj3n3(1) ) / ( zj3n3(1) + pc_sa * zcolrate(start_subrange_1a) )
5067	ENDIF
5068	!
5069	!-- Collision rate in the smallest bin, including nucleation and condensation (see
5070	!-- Jacobson (2005), eq. (16.73))
5071	zcolrate(start_subrange_1a) = zcolrate(start_subrange_1a) + zj3n3(1) / pc_sa
5072	!
5073	!-- Total sink for sulfate (1/s)
5074	zcs_su = zcs_tot + zj3n3(1) / pc_sa
5075	!
5076	!-- Sulphuric acid:
5077	!-- New gas phase concentration (#/m3)
5078	zcvap_new1 = pc_sa / ( 1.0_wp + ptstep * zcs_su )
5079	!
5080	!-- Change in gas concentration (#/m3)
5081	zdvap1 = pc_sa - zcvap_new1
5082	!
5083	!-- Updating vapour concentration (#/m3)
5084	pc_sa = zcvap_new1
5085	!
5086	!-- Volume change of particles (m3(SO4)/m3(air)) by condensation
5087	zdvolsa = zcolrate(start_subrange_1a:end_subrange_2b) / zcs_su * amvh2so4 * zdvap1
5088	!
5089	!-- Change of volume concentration of sulphate in aerosol [fxm]
5090	paero(start_subrange_1a:end_subrange_2b)%volc(1) = &
5091	paero(start_subrange_1a:end_subrange_2b)%volc(1) + zdvolsa
5092	!
5093	!-- Change of number concentration in the smallest bin caused by nucleation
5094	!-- (Jacobson (2005), equation (16.75))
5095	IF ( zxsa > 0.0_wp ) THEN
5096	paero(start_subrange_1a)%numc = paero(start_subrange_1a)%numc + zn_vs_c * &
5097	zdvolsa(start_subrange_1a) / amvh2so4 / ( n3 * zxsa)
5098	ENDIF
5099	ENDIF
5100	!
5101	!-- Partitioning of H2O, HNO3, and NH3: Dissolutional growth
5102	IF ( lspartition .AND. ( pchno3 > 1.0E+10_wp .OR. pc_nh3 > 1.0E+10_wp ) ) THEN
5103	CALL gpparthno3( ppres, ptemp, paero, pchno3, pc_nh3, pcw, pcs, zbeta, ptstep )
5104	ENDIF
5105	ENDIF
5106	!
5107	!-- Condensation of water vapour
5108	IF ( lscndh2oae ) THEN
5109	CALL gpparth2o( paero, ptemp, ppres, pcs, pcw, ptstep )
5110	ENDIF
5111
5112	END SUBROUTINE condensation
5113
5114	!------------------------------------------------------------------------------!
5115	! Description:
5116	! ------------
5117	!> Calculates the particle number and volume increase, and gas-phase
5118	!> concentration decrease due to nucleation subsequent growth to detectable size
5119	!> of 3 nm.
5120	!
5121	!> Method:
5122	!> When the formed clusters grow by condensation (possibly also by self-
5123	!> coagulation), their number is reduced due to scavenging to pre-existing
5124	!> particles. Thus, the apparent nucleation rate at 3 nm is significantly lower
5125	!> than the real nucleation rate (at ~1 nm).
5126	!
5127	!> Calculation of the formation rate of detectable particles at 3 nm (i.e. J3):
5128	!> nj3 = 1: Kerminen, V.-M. and Kulmala, M. (2002), J. Aerosol Sci.,33, 609-622.
5129	!> nj3 = 2: Lehtinen et al. (2007), J. Aerosol Sci., 38(9), 988-994.
5130	!> nj3 = 3: Anttila et al. (2010), J. Aerosol Sci., 41(7), 621-636.
5131	!
5132	!> c = aerosol of critical radius (1 nm)
5133	!> x = aerosol with radius 3 nm
5134	!> 2 = wet or mean droplet
5135	!
5136	!> Called from subroutine condensation (in module salsa_dynamics_mod.f90)
5137	!
5138	!> Calls one of the following subroutines:
5139	!> - binnucl
5140	!> - ternucl
5141	!> - kinnucl
5142	!> - actnucl
5143	!
5144	!> fxm: currently only sulphuric acid grows particles from 1 to 3 nm
5145	!> (if asked from Markku, this is terribly wrong!!!)
5146	!
5147	!> Coded by:
5148	!> Hannele Korhonen (FMI) 2005
5149	!> Harri Kokkola (FMI) 2006
5150	!> Matti Niskanen(FMI) 2012
5151	!> Anton Laakso (FMI) 2013
5152	!------------------------------------------------------------------------------!
5153
5154	SUBROUTINE nucleation( paero, ptemp, prh, ppres, pc_sa, pc_ocnv, pc_nh3, ptstep, pj3n3, pxsa, &
5155	pxocnv )
5156
5157	IMPLICIT NONE
5158
5159	INTEGER(iwp) :: iteration
5160
5161	REAL(wp) :: zc_h2so4 !< H2SO4 conc. (#/cm3) !UNITS!
5162	REAL(wp) :: zc_org !< organic vapour conc. (#/cm3)
5163	REAL(wp) :: zcc_c !< Cunningham correct factor for c = critical (1nm)
5164	REAL(wp) :: zcc_x !< Cunningham correct factor for x = 3nm
5165	REAL(wp) :: zcoags_c !< coagulation sink (1/s) for c = critical (1nm)
5166	REAL(wp) :: zcoags_x !< coagulation sink (1/s) for x = 3nm
5167	REAL(wp) :: zcoagstot !< total particle losses due to coagulation, including condensation
5168	!< and self-coagulation
5169	REAL(wp) :: zcocnv_local !< organic vapour conc. (#/m3)
5170	REAL(wp) :: zcsink !< condensational sink (#/m2)
5171	REAL(wp) :: zcsa_local !< H2SO4 conc. (#/m3)
5172	REAL(wp) :: zcv_c !< mean relative thermal velocity (m/s) for c = critical (1nm)
5173	REAL(wp) :: zcv_x !< mean relative thermal velocity (m/s) for x = 3nm
5174	REAL(wp) :: zdcrit !< diameter of critical cluster (m)
5175	REAL(wp) :: zdelta_vap !< change of H2SO4 and organic vapour concentration (#/m3)
5176	REAL(wp) :: zdfvap !< air diffusion coefficient (m2/s)
5177	REAL(wp) :: zdmean !< mean diameter of existing particles (m)
5178	REAL(wp) :: zeta !< constant: proportional to ratio of CS/GR (m)
5179	!< (condensation sink / growth rate)
5180	REAL(wp) :: zgamma !< proportionality factor ((nm2*m2)/h)
5181	REAL(wp) :: z_gr_clust !< growth rate of formed clusters (nm/h)
5182	REAL(wp) :: z_gr_tot !< total growth rate
5183	REAL(wp) :: zj3 !< number conc. of formed 3nm particles (#/m3)
5184	REAL(wp) :: zjnuc !< nucleation rate at ~1nm (#/m3s)
5185	REAL(wp) :: z_k_eff !< effective cogulation coefficient for freshly nucleated particles
5186	REAL(wp) :: zknud_c !< Knudsen number for c = critical (1nm)
5187	REAL(wp) :: zknud_x !< Knudsen number for x = 3nm
5188	REAL(wp) :: zkocnv !< lever: zkocnv=1 --> organic compounds involved in nucleation
5189	REAL(wp) :: zksa !< lever: zksa=1 --> H2SO4 involved in nucleation
5190	REAL(wp) :: zlambda !< parameter for adjusting the growth rate due to self-coagulation
5191	REAL(wp) :: zm_c !< particle mass (kg) for c = critical (1nm)
5192	REAL(wp) :: zm_para !< Parameter m for calculating the coagulation sink (Eq. 5&6 in
5193	!< Lehtinen et al. 2007)
5194	REAL(wp) :: zm_x !< particle mass (kg) for x = 3nm
5195	REAL(wp) :: zmfp !< mean free path of condesing vapour(m)
5196	REAL(wp) :: zmixnh3 !< ammonia mixing ratio (ppt)
5197	REAL(wp) :: zmyy !< gas dynamic viscosity (N*s/m2)
5198	REAL(wp) :: z_n_nuc !< number of clusters/particles at the size range d1-dx (#/m3)
5199	REAL(wp) :: znoc !< number of organic molecules in critical cluster
5200	REAL(wp) :: znsa !< number of H2SO4 molecules in critical cluster
5201
5202	REAL(wp), INTENT(in) :: pc_nh3 !< ammonia concentration (#/m3)
5203	REAL(wp), INTENT(in) :: pc_ocnv !< conc. of non-volatile OC (#/m3)
5204	REAL(wp), INTENT(in) :: pc_sa !< sulphuric acid conc. (#/m3)
5205	REAL(wp), INTENT(in) :: ppres !< ambient air pressure (Pa)
5206	REAL(wp), INTENT(in) :: prh !< ambient rel. humidity [0-1]
5207	REAL(wp), INTENT(in) :: ptemp !< ambient temperature (K)
5208	REAL(wp), INTENT(in) :: ptstep !< time step (s) of SALSA
5209
5210	REAL(wp), INTENT(inout) :: pj3n3(2) !< formation mass rate of molecules (molec/m3s) for
5211	!< 1: H2SO4 and 2: organic vapour
5212
5213	REAL(wp), INTENT(out) :: pxocnv !< ratio of non-volatile organic vapours in 3 nm particles
5214	REAL(wp), INTENT(out) :: pxsa !< ratio of H2SO4 in 3 nm aerosol particles
5215
5216	REAL(wp), DIMENSION(nbins_aerosol) :: zbeta !< transitional correction factor
5217	REAL(wp), DIMENSION(nbins_aerosol) :: zcc_2 !< Cunningham correct factor:2
5218	REAL(wp), DIMENSION(nbins_aerosol) :: zcv_2 !< mean relative thermal velocity (m/s): 2
5219	REAL(wp), DIMENSION(nbins_aerosol) :: zcv_c2 !< average velocity after coagulation: c & 2
5220	REAL(wp), DIMENSION(nbins_aerosol) :: zcv_x2 !< average velocity after coagulation: x & 2
5221	REAL(wp), DIMENSION(nbins_aerosol) :: zdc_2 !< particle diffusion coefficient (m2/s): 2
5222	REAL(wp), DIMENSION(nbins_aerosol) :: zdc_c !< particle diffusion coefficient (m2/s): c
5223	REAL(wp), DIMENSION(nbins_aerosol) :: zdc_c2 !< sum of diffusion coef. for c and 2
5224	REAL(wp), DIMENSION(nbins_aerosol) :: zdc_x !< particle diffusion coefficient (m2/s): x
5225	REAL(wp), DIMENSION(nbins_aerosol) :: zdc_x2 !< sum of diffusion coef. for: x & 2
5226	REAL(wp), DIMENSION(nbins_aerosol) :: zgamma_f_2 !< zgamma_f for calculating zomega
5227	REAL(wp), DIMENSION(nbins_aerosol) :: zgamma_f_c !< zgamma_f for calculating zomega
5228	REAL(wp), DIMENSION(nbins_aerosol) :: zgamma_f_x !< zgamma_f for calculating zomega
5229	REAL(wp), DIMENSION(nbins_aerosol) :: z_k_c2 !< coagulation coef. in the continuum
5230	!< regime: c & 2
5231	REAL(wp), DIMENSION(nbins_aerosol) :: z_k_x2 !< coagulation coef. in the continuum
5232	!< regime: x & 2
5233	REAL(wp), DIMENSION(nbins_aerosol) :: zknud !< particle Knudsen number
5234	REAL(wp), DIMENSION(nbins_aerosol) :: zknud_2 !< particle Knudsen number: 2
5235	REAL(wp), DIMENSION(nbins_aerosol) :: zm_2 !< particle mass (kg): 2
5236	REAL(wp), DIMENSION(nbins_aerosol) :: zomega_2c !< zomega (m) for calculating zsigma: c & 2
5237	REAL(wp), DIMENSION(nbins_aerosol) :: zomega_2x !< zomega (m) for calculating zsigma: x & 2
5238	REAL(wp), DIMENSION(nbins_aerosol) :: zomega_c !< zomega (m) for calculating zsigma: c
5239	REAL(wp), DIMENSION(nbins_aerosol) :: zomega_x !< zomega (m) for calculating zsigma: x
5240	REAL(wp), DIMENSION(nbins_aerosol) :: z_r_c2 !< sum of the radii: c & 2
5241	REAL(wp), DIMENSION(nbins_aerosol) :: z_r_x2 !< sum of the radii: x & 2
5242	REAL(wp), DIMENSION(nbins_aerosol) :: zsigma_c2 !<
5243	REAL(wp), DIMENSION(nbins_aerosol) :: zsigma_x2 !<
5244
5245	TYPE(t_section), DIMENSION(nbins_aerosol), INTENT(inout) :: paero !< aerosol properties
5246	!
5247	!-- 1) Nucleation rate (zjnuc) and diameter of critical cluster (zdcrit)
5248	zjnuc = 0.0_wp
5249	znsa = 0.0_wp
5250	znoc = 0.0_wp
5251	zdcrit = 0.0_wp
5252	zksa = 0.0_wp
5253	zkocnv = 0.0_wp
5254
5255	zc_h2so4 = pc_sa * 1.0E-6_wp ! sulphuric acid conc. to #/cm3
5256	zc_org = pc_ocnv * 1.0E-6_wp ! conc. of non-volatile OC to #/cm3
5257	zmixnh3 = pc_nh3 * ptemp * argas / ( ppres * avo )
5258
5259	SELECT CASE ( nsnucl )
5260	!
5261	!-- Binary H2SO4-H2O nucleation
5262	CASE(1)
5263
5264	CALL binnucl( zc_h2so4, ptemp, prh, zjnuc, znsa, znoc, zdcrit, zksa, zkocnv )
5265	!
5266	!-- Activation type nucleation (See Riipinen et al. (2007), Atmos. Chem. Phys., 7(8), 1899-1914)
5267	CASE(2)
5268	!
5269	!-- Nucleation rate (#/(m3 s))
5270	zc_h2so4 = MAX( zc_h2so4, 1.0E4_wp )
5271	zc_h2so4 = MIN( zc_h2so4, 1.0E11_wp )
5272	zjnuc = act_coeff * pc_sa ! (#/(m3 s))
5273	!
5274	!-- Organic compounds not involved when kinetic nucleation is assumed.
5275	zdcrit = 7.9375E-10_wp ! (m)
5276	zkocnv = 0.0_wp
5277	zksa = 1.0_wp
5278	znoc = 0.0_wp
5279	znsa = 2.0_wp
5280	!
5281	!-- Kinetically limited nucleation of (NH4)HSO4 clusters
5282	!-- (See Sihto et al. (2006), Atmos. Chem. Phys., 6(12), 4079-4091.)
5283	CASE(3)
5284	!
5285	!-- Nucleation rate = coagcoeffzpcsa*2 (#/(m3 s))
5286	zc_h2so4 = MAX( zc_h2so4, 1.0E4_wp )
5287	zc_h2so4 = MIN( zc_h2so4, 1.0E11_wp )
5288	zjnuc = 5.0E-13_wp * zc_h2so4*2.0_wp 1.0E+6_wp
5289	!
5290	!-- Organic compounds not involved when kinetic nucleation is assumed.
5291	zdcrit = 7.9375E-10_wp ! (m)
5292	zkocnv = 0.0_wp
5293	zksa = 1.0_wp
5294	znoc = 0.0_wp
5295	znsa = 2.0_wp
5296	!
5297	!-- Ternary H2SO4-H2O-NH3 nucleation
5298	CASE(4)
5299
5300	CALL ternucl( zc_h2so4, zmixnh3, ptemp, prh, zjnuc, znsa, znoc, zdcrit, zksa, zkocnv )
5301	!
5302	!-- Organic nucleation, J~[ORG] or J~[ORG]**2
5303	!-- (See Paasonen et al. (2010), Atmos. Chem. Phys., 10, 11223-11242.)
5304	CASE(5)
5305	!
5306	!-- Homomolecular nuleation rate
5307	zjnuc = 1.3E-7_wp * pc_ocnv ! (1/s) (Paasonen et al. Table 4: median a_org)
5308	!
5309	!-- H2SO4 not involved when pure organic nucleation is assumed.
5310	zdcrit = 1.5E-9 ! (m)
5311	zkocnv = 1.0_wp
5312	zksa = 0.0_wp
5313	znoc = 1.0_wp
5314	znsa = 0.0_wp
5315	!
5316	!-- Sum of H2SO4 and organic activation type nucleation, J~[H2SO4]+[ORG]
5317	!-- (See Paasonen et al. (2010), Atmos. Chem. Phys., 10, 11223-11242)
5318	CASE(6)
5319	!
5320	!-- Nucleation rate (#/m3/s)
5321	zjnuc = 6.1E-7_wp * pc_sa + 0.39E-7_wp * pc_ocnv ! (Paasonen et al. Table 3.)
5322	!
5323	!-- Both organic compounds and H2SO4 are involved when sumnucleation is assumed.
5324	zdcrit = 1.5E-9_wp ! (m)
5325	zkocnv = 1.0_wp
5326	zksa = 1.0_wp
5327	znoc = 1.0_wp
5328	znsa = 1.0_wp
5329	!
5330	!-- Heteromolecular nucleation, J~[H2SO4]*[ORG]
5331	!-- (See Paasonen et al. (2010), Atmos. Chem. Phys., 10, 11223-11242.)
5332	CASE(7)
5333	!
5334	!-- Nucleation rate (#/m3/s)
5335	zjnuc = 4.1E-14_wp * pc_sa * pc_ocnv * 1.0E6_wp ! (Paasonen et al. Table 4: median)
5336	!
5337	!-- Both organic compounds and H2SO4 are involved when heteromolecular nucleation is assumed
5338	zdcrit = 1.5E-9_wp ! (m)
5339	zkocnv = 1.0_wp
5340	zksa = 1.0_wp
5341	znoc = 1.0_wp
5342	znsa = 1.0_wp
5343	!
5344	!-- Homomolecular nucleation of H2SO4 and heteromolecular nucleation of H2SO4 and organic vapour,
5345	!-- J~[H2SO4]*2 + [H2SO4][ORG] (EUCAARI project)
5346	!-- (See Paasonen et al. (2010), Atmos. Chem. Phys., 10, 11223-11242)
5347	CASE(8)
5348	!
5349	!-- Nucleation rate (#/m3/s)
5350	zjnuc = ( 1.1E-14_wp * zc_h2so4*2 + 3.2E-14_wp zc_h2so4 * zc_org ) * 1.0E+6_wp
5351	!
5352	!-- Both organic compounds and H2SO4 are involved when SAnucleation is assumed
5353	zdcrit = 1.5E-9_wp ! (m)
5354	zkocnv = 1.0_wp
5355	zksa = 1.0_wp
5356	znoc = 1.0_wp
5357	znsa = 3.0_wp
5358	!
5359	!-- Homomolecular nucleation of H2SO4 and organic vapour and heteromolecular nucleation of H2SO4
5360	!-- and organic vapour, J~[H2SO4]*2 + [H2SO4][ORG]+[ORG]**2 (EUCAARI project)
5361	CASE(9)
5362	!
5363	!-- Nucleation rate (#/m3/s)
5364	zjnuc = ( 1.4E-14_wp * zc_h2so4*2 + 2.6E-14_wp zc_h2so4 * zc_org + 0.037E-14_wp * &
5365	zc_org*2 ) 1.0E+6_wp
5366	!
5367	!-- Both organic compounds and H2SO4 are involved when SAORGnucleation is assumed
5368	zdcrit = 1.5E-9_wp ! (m)
5369	zkocnv = 1.0_wp
5370	zksa = 1.0_wp
5371	znoc = 3.0_wp
5372	znsa = 3.0_wp
5373
5374	END SELECT
5375
5376	zcsa_local = pc_sa
5377	zcocnv_local = pc_ocnv
5378	!
5379	!-- 2) Change of particle and gas concentrations due to nucleation
5380	!
5381	!-- 2.1) Check that there is enough H2SO4 and organic vapour to produce the nucleation
5382	IF ( nsnucl <= 4 ) THEN
5383	!
5384	!-- If the chosen nucleation scheme is 1-4, nucleation occurs only due to H2SO4. All of the total
5385	!-- vapour concentration that is taking part to the nucleation is there for sulphuric acid
5386	!-- (sa = H2SO4) and non-volatile organic vapour is zero.
5387	pxsa = 1.0_wp ! ratio of sulphuric acid in 3nm particles
5388	pxocnv = 0.0_wp ! ratio of non-volatile origanic vapour
5389	! in 3nm particles
5390	ELSEIF ( nsnucl > 4 ) THEN
5391	!
5392	!-- If the chosen nucleation scheme is 5-9, nucleation occurs due to organic vapour or the
5393	!-- combination of organic vapour and H2SO4. The number of needed molecules depends on the chosen
5394	!-- nucleation type and it has an effect also on the minimum ratio of the molecules present.
5395	IF ( pc_sa * znsa + pc_ocnv * znoc < 1.E-14_wp ) THEN
5396	pxsa = 0.0_wp
5397	pxocnv = 0.0_wp
5398	ELSE
5399	pxsa = pc_sa * znsa / ( pc_sa * znsa + pc_ocnv * znoc )
5400	pxocnv = pc_ocnv * znoc / ( pc_sa * znsa + pc_ocnv * znoc )
5401	ENDIF
5402	ENDIF
5403	!
5404	!-- The change in total vapour concentration is the sum of the concentrations of the vapours taking
5405	!-- part to the nucleation (depends on the chosen nucleation scheme)
5406	zdelta_vap = MIN( zjnuc * ( znoc + znsa ), ( pc_ocnv * zkocnv + pc_sa * zksa ) / ptstep )
5407	!
5408	!-- Nucleation rate J at ~1nm (#/m3s)
5409	zjnuc = zdelta_vap / ( znoc + znsa )
5410	!
5411	!-- H2SO4 concentration after nucleation (#/m3)
5412	zcsa_local = MAX( 1.0_wp, pc_sa - zdelta_vap * pxsa )
5413	!
5414	!-- Non-volative organic vapour concentration after nucleation (#/m3)
5415	zcocnv_local = MAX( 1.0_wp, pc_ocnv - zdelta_vap * pxocnv )
5416	!
5417	!-- 2.2) Formation rate of 3 nm particles (Kerminen & Kulmala, 2002)
5418	!
5419	!-- Growth rate by H2SO4 and organic vapour (nm/h, Eq. 21)
5420	z_gr_clust = 2.3623E-15_wp * SQRT( ptemp ) * ( zcsa_local + zcocnv_local )
5421	!
5422	!-- 2.2.2) Condensational sink of pre-existing particle population
5423	!
5424	!-- Diffusion coefficient (m2/s)
5425	zdfvap = 5.1111E-10_wp * ptemp*1.75_wp ( p_0 + 1325.0_wp ) / ppres
5426	!
5427	!-- Mean free path of condensing vapour (m) (Jacobson (2005), Eq. 15.25 and 16.29)
5428	zmfp = 3.0_wp * zdfvap * SQRT( pi * amh2so4 / ( 8.0_wp * argas * ptemp ) )
5429	!
5430	!-- Knudsen number
5431	zknud = 2.0_wp * zmfp / ( paero(:)%dwet + d_sa )
5432	!
5433	!-- Transitional regime correction factor (zbeta) according to Fuchs and Sutugin (1971) (Eq. 4 in
5434	!-- Kerminen and Kulmala, 2002)
5435	zbeta = ( zknud + 1.0_wp) / ( 0.377_wp * zknud + 1.0_wp + 4.0_wp / ( 3.0_wp * massacc ) * &
5436	( zknud + zknud**2 ) )
5437	!
5438	!-- Condensational sink (#/m2, Eq. 3)
5439	zcsink = SUM( paero(:)%dwet * zbeta * paero(:)%numc )
5440	!
5441	!-- 2.2.3) Parameterised formation rate of detectable 3 nm particles (i.e. J3)
5442	IF ( nj3 == 1 ) THEN ! Kerminen and Kulmala (2002)
5443	!
5444	!-- Constants needed for the parameterisation: dapp = 3 nm and dens_nuc = 1830 kg/m3
5445	IF ( zcsink < 1.0E-30_wp ) THEN
5446	zeta = 0._dp
5447	ELSE
5448	!
5449	!-- Mean diameter of backgroud population (nm)
5450	zdmean = 1.0_wp / SUM( paero(:)%numc ) * SUM( paero(:)%numc * paero(:)%dwet ) * 1.0E+9_wp
5451	!
5452	!-- Proportionality factor (nm2*m2/h) (Eq. 22)
5453	zgamma = 0.23_wp * ( zdcrit * 1.0E+9_wp )*0.2_wp ( zdmean / 150.0_wp )*0.048_wp &
5454	( ptemp / 293.0_wp )*( -0.75_wp ) ( arhoh2so4 / 1000.0_wp )**( -0.33_wp )
5455	!
5456	!-- Factor eta (nm, Eq. 11)
5457	zeta = MIN( zgamma * zcsink / z_gr_clust, zdcrit * 1.0E11_wp )
5458	ENDIF
5459	!
5460	!-- Number conc. of clusters surviving to 3 nm in a time step (#/m3, Eq.14)
5461	zj3 = zjnuc * EXP( MIN( 0.0_wp, zeta / 3.0_wp - zeta / ( zdcrit * 1.0E9_wp ) ) )
5462
5463	ELSEIF ( nj3 > 1 ) THEN ! Lehtinen et al. (2007) or Anttila et al. (2010)
5464	!
5465	!-- Defining the parameter m (zm_para) for calculating the coagulation sink onto background
5466	!-- particles (Eq. 5&6 in Lehtinen et al. 2007). The growth is investigated between
5467	!-- [d1,reglim(1)] = [zdcrit,3nm] and m = LOG( CoagS_dx / CoagX_zdcrit ) / LOG( reglim / zdcrit )
5468	!-- (Lehtinen et al. 2007, Eq. 6).
5469	!-- The steps for the coagulation sink for reglim = 3nm and zdcrit ~= 1nm are explained in
5470	!-- Kulmala et al. (2001). The particles of diameter zdcrit ~1.14 nm and reglim = 3nm are both
5471	!-- in turn the "number 1" variables (Kulmala et al. 2001).
5472	!-- c = critical (1nm), x = 3nm, 2 = wet or mean droplet
5473	!
5474	!-- Sum of the radii, R12 = R1 + R2 (m) of two particles 1 and 2
5475	z_r_c2 = zdcrit / 2.0_wp + paero(:)%dwet / 2.0_wp
5476	z_r_x2 = reglim(1) / 2.0_wp + paero(:)%dwet / 2.0_wp
5477	!
5478	!-- Particle mass (kg) (comes only from H2SO4)
5479	zm_c = 4.0_wp / 3.0_wp * pi * ( zdcrit / 2.0_wp )*3 arhoh2so4
5480	zm_x = 4.0_wp / 3.0_wp * pi * ( reglim(1) / 2.0_wp )*3 arhoh2so4
5481	zm_2 = 4.0_wp / 3.0_wp * pi * ( 0.5_wp * paero(:)%dwet )*3 arhoh2so4
5482	!
5483	!-- Mean relative thermal velocity between the particles (m/s)
5484	zcv_c = SQRT( 8.0_wp * abo * ptemp / ( pi * zm_c ) )
5485	zcv_x = SQRT( 8.0_wp * abo * ptemp / ( pi * zm_x ) )
5486	zcv_2 = SQRT( 8.0_wp * abo * ptemp / ( pi * zm_2 ) )
5487	!
5488	!-- Average velocity after coagulation
5489	zcv_c2(:) = SQRT( zcv_c2 + zcv_22 )
5490	zcv_x2(:) = SQRT( zcv_x2 + zcv_22 )
5491	!
5492	!-- Knudsen number (zmfp = mean free path of condensing vapour)
5493	zknud_c = 2.0_wp * zmfp / zdcrit
5494	zknud_x = 2.0_wp * zmfp / reglim(1)
5495	zknud_2(:) = MAX( 0.0_wp, 2.0_wp * zmfp / paero(:)%dwet )
5496	!
5497	!-- Cunningham correction factors (Allen and Raabe, 1985)
5498	zcc_c = 1.0_wp + zknud_c * ( 1.142_wp + 0.558_wp * EXP( -0.999_wp / zknud_c ) )
5499	zcc_x = 1.0_wp + zknud_x * ( 1.142_wp + 0.558_wp * EXP( -0.999_wp / zknud_x ) )
5500	zcc_2(:) = 1.0_wp + zknud_2(:) * ( 1.142_wp + 0.558_wp * EXP( -0.999_wp / zknud_2(:) ) )
5501	!
5502	!-- Gas dynamic viscosity (Ns/m2). Here, viscocity(air @20C) = 1.81e-5_dp N/m2 s (Hinds, p. 25)
5503	zmyy = 1.81E-5_wp * ( ptemp / 293.0_wp )**0.74_wp
5504	!
5505	!-- Particle diffusion coefficient (m2/s) (continuum regime)
5506	zdc_c(:) = abo * ptemp * zcc_c / ( 3.0_wp * pi * zmyy * zdcrit )
5507	zdc_x(:) = abo * ptemp * zcc_x / ( 3.0_wp * pi * zmyy * reglim(1) )
5508	zdc_2(:) = abo * ptemp * zcc_2(:) / ( 3.0_wp * pi * zmyy * paero(:)%dwet )
5509	!
5510	!-- D12 = D1+D2 (Seinfield and Pandis, 2nd ed. Eq. 13.38)
5511	zdc_c2 = zdc_c + zdc_2
5512	zdc_x2 = zdc_x + zdc_2
5513	!
5514	!-- zgamma_f = 8*D/pi/zcv (m) for calculating zomega (Fuchs, 1964)
5515	zgamma_f_c = 8.0_wp * zdc_c / pi / zcv_c
5516	zgamma_f_x = 8.0_wp * zdc_x / pi / zcv_x
5517	zgamma_f_2 = 8.0_wp * zdc_2 / pi / zcv_2
5518	!
5519	!-- zomega (m) for calculating zsigma
5520	zomega_c = ( ( z_r_c2 + zgamma_f_c )3 - ( z_r_c2 2 + zgamma_f_c )**1.5_wp ) / &
5521	( 3.0_wp * z_r_c2 * zgamma_f_c ) - z_r_c2
5522	zomega_x = ( ( z_r_x2 + zgamma_f_x )3 - ( z_r_x22 + zgamma_f_x )** 1.5_wp ) / &
5523	( 3.0_wp * z_r_x2 * zgamma_f_x ) - z_r_x2
5524	zomega_2c = ( ( z_r_c2 + zgamma_f_2 )3 - ( z_r_c22 + zgamma_f_2 )**1.5_wp ) / &
5525	( 3.0_wp * z_r_c2 * zgamma_f_2 ) - z_r_c2
5526	zomega_2x = ( ( z_r_x2 + zgamma_f_2 )3 - ( z_r_x22 + zgamma_f_2 )**1.5_wp ) / &
5527	( 3.0_wp * z_r_x2 * zgamma_f_2 ) - z_r_x2
5528	!
5529	!-- The distance (m) at which the two fluxes are matched (condensation and coagulation sinks)
5530	zsigma_c2 = SQRT( zomega_c2 + zomega_2c2 )
5531	zsigma_x2 = SQRT( zomega_x2 + zomega_2x2 )
5532	!
5533	!-- Coagulation coefficient in the continuum regime (m*m2/s, Eq. 17 in Kulmala et al., 2001)
5534	z_k_c2 = 4.0_wp * pi * z_r_c2 * zdc_c2 / ( z_r_c2 / ( z_r_c2 + zsigma_c2 ) + &
5535	4.0_wp * zdc_c2 / ( zcv_c2 * z_r_c2 ) )
5536	z_k_x2 = 4.0_wp * pi * z_r_x2 * zdc_x2 / ( z_r_x2 / ( z_r_x2 + zsigma_x2 ) + &
5537	4.0_wp * zdc_x2 / ( zcv_x2 * z_r_x2 ) )
5538	!
5539	!-- Coagulation sink (1/s, Eq. 16 in Kulmala et al., 2001)
5540	zcoags_c = MAX( 1.0E-20_wp, SUM( z_k_c2 * paero(:)%numc ) )
5541	zcoags_x = MAX( 1.0E-20_wp, SUM( z_k_x2 * paero(:)%numc ) )
5542	!
5543	!-- Parameter m for calculating the coagulation sink onto background particles (Eq. 5&6 in
5544	!-- Lehtinen et al. 2007)
5545	zm_para = LOG( zcoags_x / zcoags_c ) / LOG( reglim(1) / zdcrit )
5546	!
5547	!-- Parameter gamma for calculating the formation rate J of particles having
5548	!-- a diameter zdcrit < d < reglim(1) (Anttila et al. 2010, eq. 5 or Lehtinen et al.,2007, eq. 7)
5549	zgamma = ( ( ( reglim(1) / zdcrit )**( zm_para + 1.0_wp ) ) - 1.0_wp ) / ( zm_para + 1.0_wp )
5550
5551	IF ( nj3 == 2 ) THEN ! Lehtinen et al. (2007): coagulation sink
5552	!
5553	!-- Formation rate J before iteration (#/m3s)
5554	zj3 = zjnuc * EXP( MIN( 0.0_wp, -zgamma * zdcrit * zcoags_c / ( z_gr_clust * 1.0E-9_wp / &
5555	60.0_wp**2 ) ) )
5556
5557	ELSEIF ( nj3 == 3 ) THEN ! Anttila et al. (2010): coagulation sink and self-coag.
5558	!
5559	!-- If air is polluted, the self-coagulation becomes important. Self-coagulation of small
5560	!-- particles < 3 nm.
5561	!
5562	!-- "Effective" coagulation coefficient between freshly-nucleated particles:
5563	z_k_eff = 5.0E-16_wp ! m3/s
5564	!
5565	!-- zlambda parameter for "adjusting" the growth rate due to the self-coagulation
5566	zlambda = 6.0_wp
5567
5568	IF ( reglim(1) >= 10.0E-9_wp ) THEN ! for particles >10 nm:
5569	z_k_eff = 5.0E-17_wp
5570	zlambda = 3.0_wp
5571	ENDIF
5572	!
5573	!-- Initial values for coagulation sink and growth rate (m/s)
5574	zcoagstot = zcoags_c
5575	z_gr_tot = z_gr_clust * 1.0E-9_wp / 60.0_wp**2
5576	!
5577	!-- Number of clusters/particles at the size range [d1,dx] (#/m3):
5578	z_n_nuc = zjnuc / zcoagstot !< Initial guess
5579	!
5580	!-- Coagulation sink and growth rate due to self-coagulation:
5581	DO iteration = 1, 5
5582	zcoagstot = zcoags_c + z_k_eff * z_n_nuc * 1.0E-6_wp ! (1/s, Anttila et al., eq. 1)
5583	z_gr_tot = z_gr_clust * 2.77777777E-7_wp + 1.5708E-6_wp * zlambda * zdcrit*3 &
5584	( z_n_nuc * 1.0E-6_wp ) * zcv_c * avo * 2.77777777E-7_wp ! (Eq. 3)
5585	zeta = - zcoagstot / ( ( zm_para + 1.0_wp ) * z_gr_tot * ( zdcrit**zm_para ) ) ! (Eq.7b)
5586	!
5587	!-- Calculate Eq. 7a (Taylor series for the number of particles between [d1,dx])
5588	z_n_nuc = z_n_nuc_tayl( zdcrit, reglim(1), zm_para, zjnuc, zeta, z_gr_tot )
5589	ENDDO
5590	!
5591	!-- Calculate the final values with new z_n_nuc:
5592	zcoagstot = zcoags_c + z_k_eff * z_n_nuc * 1.0E-6_wp ! (1/s)
5593	z_gr_tot = z_gr_clust * 1.0E-9_wp / 3600.0_wp + 1.5708E-6_wp * zlambda * zdcrit*3 &
5594	( z_n_nuc * 1.0E-6_wp ) * zcv_c * avo * 1.0E-9_wp / 3600.0_wp !< (m/s)
5595	zj3 = zjnuc * EXP( MIN( 0.0_wp, -zgamma * zdcrit * zcoagstot / z_gr_tot ) ) ! (#/m3s, Eq.5a)
5596
5597	ENDIF
5598	ENDIF
5599	!
5600	!-- If J3 very small (< 1 #/cm3), neglect particle formation. In real atmosphere this would mean
5601	!-- that clusters form but coagulate to pre-existing particles who gain sulphate. Since
5602	!-- CoagS ~ CS (4piDCS'), we do not* update H2SO4 concentration here but let condensation take
5603	!-- care of it. Formation mass rate of molecules (molec/m3s) for 1: H2SO4 and 2: organic vapour
5604	pj3n3(1) = zj3 * n3 * pxsa
5605	pj3n3(2) = zj3 * n3 * pxocnv
5606
5607	END SUBROUTINE nucleation
5608
5609	!------------------------------------------------------------------------------!
5610	! Description:
5611	! ------------
5612	!> Calculate the nucleation rate and the size of critical clusters assuming
5613	!> binary nucleation.
5614	!> Parametrisation according to Vehkamaki et al. (2002), J. Geophys. Res.,
5615	!> 107(D22), 4622. Called from subroutine nucleation.
5616	!------------------------------------------------------------------------------!
5617	SUBROUTINE binnucl( pc_sa, ptemp, prh, pnuc_rate, pn_crit_sa, pn_crit_ocnv, pd_crit, pk_sa, &
5618	pk_ocnv )
5619
5620	IMPLICIT NONE
5621
5622	REAL(wp) :: za !<
5623	REAL(wp) :: zb !<
5624	REAL(wp) :: zc !<
5625	REAL(wp) :: zcoll !<
5626	REAL(wp) :: zlogsa !< LOG( zpcsa )
5627	REAL(wp) :: zlogrh !< LOG( zrh )
5628	REAL(wp) :: zm1 !<
5629	REAL(wp) :: zm2 !<
5630	REAL(wp) :: zma !<
5631	REAL(wp) :: zmw !<
5632	REAL(wp) :: zntot !< number of molecules in critical cluster
5633	REAL(wp) :: zpcsa !< sulfuric acid concentration
5634	REAL(wp) :: zrh !< relative humidity
5635	REAL(wp) :: zroo !<
5636	REAL(wp) :: zt !< temperature
5637	REAL(wp) :: zv1 !<
5638	REAL(wp) :: zv2 !<
5639	REAL(wp) :: zx !< mole fraction of sulphate in critical cluster
5640	REAL(wp) :: zxmass !<
5641
5642	REAL(wp), INTENT(in) :: pc_sa !< H2SO4 conc. (#/cm3)
5643	REAL(wp), INTENT(in) :: prh !< relative humidity [0-1
5644	REAL(wp), INTENT(in) :: ptemp !< ambient temperature (K)
5645
5646	REAL(wp), INTENT(out) :: pnuc_rate !< nucleation rate (#/(m3 s))
5647	REAL(wp), INTENT(out) :: pn_crit_sa !< number of H2SO4 molecules in cluster (#)
5648	REAL(wp), INTENT(out) :: pn_crit_ocnv !< number of organic molecules in cluster (#)
5649	REAL(wp), INTENT(out) :: pd_crit !< diameter of critical cluster (m)
5650	REAL(wp), INTENT(out) :: pk_sa !< Lever: if pk_sa = 1, H2SO4 is involved in nucleation.
5651	REAL(wp), INTENT(out) :: pk_ocnv !< Lever: if pk_ocnv = 1, organic compounds are involved
5652
5653	pnuc_rate = 0.0_wp
5654	pd_crit = 1.0E-9_wp
5655	!
5656	!-- 1) Checking that we are in the validity range of the parameterization
5657	zpcsa = MAX( pc_sa, 1.0E4_wp )
5658	zpcsa = MIN( zpcsa, 1.0E11_wp )
5659	zrh = MAX( prh, 0.0001_wp )
5660	zrh = MIN( zrh, 1.0_wp )
5661	zt = MAX( ptemp, 190.15_wp )
5662	zt = MIN( zt, 300.15_wp )
5663
5664	zlogsa = LOG( zpcsa )
5665	zlogrh = LOG( prh )
5666	!
5667	!-- 2) Mole fraction of sulphate in a critical cluster (Eq. 11)
5668	zx = 0.7409967177282139_wp - 0.002663785665140117_wp * zt + &
5669	0.002010478847383187_wp * zlogrh - 0.0001832894131464668_wp* zt * zlogrh + &
5670	0.001574072538464286_wp * zlogrh*2 - 0.00001790589121766952_wp zt * zlogrh**2 + &
5671	0.0001844027436573778_wp * zlogrh*3 - 1.503452308794887E-6_wp zt * zlogrh**3 - &
5672	0.003499978417957668_wp * zlogsa + 0.0000504021689382576_wp * zt * zlogsa
5673	!
5674	!-- 3) Nucleation rate (Eq. 12)
5675	pnuc_rate = 0.1430901615568665_wp + 2.219563673425199_wp * zt - &
5676	0.02739106114964264_wp * zt*2 + 0.00007228107239317088_wp zt**3 + &
5677	5.91822263375044_wp / zx + 0.1174886643003278_wp * zlogrh + &
5678	0.4625315047693772_wp * zt * zlogrh - 0.01180591129059253_wp * zt*2 zlogrh + &
5679	0.0000404196487152575_wp * zt*3 zlogrh + &
5680	( 15.79628615047088_wp * zlogrh ) / zx - 0.215553951893509_wp * zlogrh**2 - &
5681	0.0810269192332194_wp * zt * zlogrh**2 + &
5682	0.001435808434184642_wp * zt*2 zlogrh**2 - &
5683	4.775796947178588E-6_wp * zt*3 zlogrh**2 - &
5684	( 2.912974063702185_wp * zlogrh*2 ) / zx - 3.588557942822751_wp zlogrh**3 + &
5685	0.04950795302831703_wp * zt * zlogrh**3 - &
5686	0.0002138195118737068_wp * zt*2 zlogrh**3 + &
5687	3.108005107949533E-7_wp * zt*3 zlogrh**3 - &
5688	( 0.02933332747098296_wp * zlogrh*3 ) / zx + 1.145983818561277_wp zlogsa - &
5689	0.6007956227856778_wp * zt * zlogsa + 0.00864244733283759_wp * zt*2 zlogsa - &
5690	0.00002289467254710888_wp * zt*3 zlogsa - &
5691	( 8.44984513869014_wp * zlogsa ) / zx + 2.158548369286559_wp * zlogrh * zlogsa + &
5692	0.0808121412840917_wp * zt * zlogrh * zlogsa - &
5693	0.0004073815255395214_wp * zt*2 zlogrh * zlogsa - &
5694	4.019572560156515E-7_wp * zt*3 zlogrh * zlogsa + &
5695	( 0.7213255852557236_wp * zlogrh * zlogsa ) / zx + &
5696	1.62409850488771_wp * zlogrh*2 zlogsa - &
5697	0.01601062035325362_wp * zt * zlogrh*2 zlogsa + &
5698	0.00003771238979714162_wpzt2 zlogrh*2 zlogsa + &
5699	3.217942606371182E-8_wp * zt*3 zlogrh*2 zlogsa - &
5700	( 0.01132550810022116_wp * zlogrh*2 zlogsa ) / zx + &
5701	9.71681713056504_wp * zlogsa*2 - 0.1150478558347306_wp zt * zlogsa**2 + &
5702	0.0001570982486038294_wp * zt*2 zlogsa**2 + &
5703	4.009144680125015E-7_wp * zt*3 zlogsa**2 + &
5704	( 0.7118597859976135_wp * zlogsa**2 ) / zx - &
5705	1.056105824379897_wp * zlogrh * zlogsa**2 + &
5706	0.00903377584628419_wp * zt * zlogrh * zlogsa**2 - &
5707	0.00001984167387090606_wp * zt*2 zlogrh * zlogsa**2 + &
5708	2.460478196482179E-8_wp * zt*3 zlogrh * zlogsa**2 - &
5709	( 0.05790872906645181_wp * zlogrh * zlogsa**2 ) / zx - &
5710	0.1487119673397459_wp * zlogsa*3 + 0.002835082097822667_wp zt * zlogsa**3 - &
5711	9.24618825471694E-6_wp * zt*2 zlogsa**3 + &
5712	5.004267665960894E-9_wp * zt*3 zlogsa**3 - &
5713	( 0.01270805101481648_wp * zlogsa**3 ) / zx
5714	!
5715	!-- Nucleation rate in #/(cm3 s)
5716	pnuc_rate = EXP( pnuc_rate )
5717	!
5718	!-- Check the validity of parameterization
5719	IF ( pnuc_rate < 1.0E-7_wp ) THEN
5720	pnuc_rate = 0.0_wp
5721	pd_crit = 1.0E-9_wp
5722	ENDIF
5723	!
5724	!-- 4) Total number of molecules in the critical cluster (Eq. 13)
5725	zntot = - 0.002954125078716302_wp - 0.0976834264241286_wp * zt + &
5726	0.001024847927067835_wp * zt*2 - 2.186459697726116E-6_wp zt**3 - &
5727	0.1017165718716887_wp / zx - 0.002050640345231486_wp * zlogrh - &
5728	0.007585041382707174_wp * zt * zlogrh + 0.0001926539658089536_wp * zt*2 zlogrh - &
5729	6.70429719683894E-7_wp * zt*3 zlogrh - ( 0.2557744774673163_wp * zlogrh ) / zx + &
5730	0.003223076552477191_wp * zlogrh*2 + 0.000852636632240633_wp zt * zlogrh**2 - &
5731	0.00001547571354871789_wp * zt*2 zlogrh**2 + &
5732	5.666608424980593E-8_wp * zt*3 zlogrh**2 + &
5733	( 0.03384437400744206_wp * zlogrh**2 ) / zx + &
5734	0.04743226764572505_wp * zlogrh*3 - 0.0006251042204583412_wp zt * zlogrh**3 + &
5735	2.650663328519478E-6_wp * zt*2 zlogrh**3 - &
5736	3.674710848763778E-9_wp * zt*3 zlogrh**3 - &
5737	( 0.0002672510825259393_wp * zlogrh*3 ) / zx - 0.01252108546759328_wp zlogsa + &
5738	0.005806550506277202_wp * zt * zlogsa - 0.0001016735312443444_wp * zt*2 zlogsa + &
5739	2.881946187214505E-7_wp * zt*3 zlogsa + ( 0.0942243379396279_wp * zlogsa ) / zx - &
5740	0.0385459592773097_wp * zlogrh * zlogsa - &
5741	0.0006723156277391984_wp * zt * zlogrh * zlogsa + &
5742	2.602884877659698E-6_wp * zt*2 zlogrh * zlogsa + &
5743	1.194163699688297E-8_wp * zt*3 zlogrh * zlogsa - &
5744	( 0.00851515345806281_wp * zlogrh * zlogsa ) / zx - &
5745	0.01837488495738111_wp * zlogrh*2 zlogsa + &
5746	0.0001720723574407498_wp * zt * zlogrh*2 zlogsa - &
5747	3.717657974086814E-7_wp * zt*2 zlogrh*2 zlogsa - &
5748	5.148746022615196E-10_wp * zt*3 zlogrh*2 zlogsa + &
5749	( 0.0002686602132926594_wp * zlogrh*2 zlogsa ) / zx - &
5750	0.06199739728812199_wp * zlogsa*2 + 0.000906958053583576_wp zt * zlogsa**2 - &
5751	9.11727926129757E-7_wp * zt*2 zlogsa**2 - &
5752	5.367963396508457E-9_wp * zt*3 zlogsa**2 - &
5753	( 0.007742343393937707_wp * zlogsa**2 ) / zx + &
5754	0.0121827103101659_wp * zlogrh * zlogsa**2 - &
5755	0.0001066499571188091_wp * zt * zlogrh * zlogsa**2 + &
5756	2.534598655067518E-7_wp * zt*2 zlogrh * zlogsa**2 - &
5757	3.635186504599571E-10_wp * zt*3 zlogrh * zlogsa**2 + &
5758	( 0.0006100650851863252_wp * zlogrh * zlogsa **2 ) / zx + &
5759	0.0003201836700403512_wp * zlogsa*3 - 0.0000174761713262546_wp zt * zlogsa**3 + &
5760	6.065037668052182E-8_wp * zt*2 zlogsa**3 - &
5761	1.421771723004557E-11_wp * zt*3 zlogsa**3 + &
5762	( 0.0001357509859501723_wp * zlogsa**3 ) / zx
5763	zntot = EXP( zntot ) ! in #
5764	!
5765	!-- 5) Size of the critical cluster pd_crit (m) (diameter) (Eq. 14)
5766	pn_crit_sa = zx * zntot
5767	pd_crit = 2.0E-9_wp * EXP( -1.6524245_wp + 0.42316402_wp * zx + 0.33466487_wp * LOG( zntot ) )
5768	!
5769	!-- 6) Organic compounds not involved when binary nucleation is assumed
5770	pn_crit_ocnv = 0.0_wp ! number of organic molecules
5771	pk_sa = 1.0_wp ! if = 1, H2SO4 involved in nucleation
5772	pk_ocnv = 0.0_wp ! if = 1, organic compounds involved
5773	!
5774	!-- Set nucleation rate to collision rate
5775	IF ( pn_crit_sa < 4.0_wp ) THEN
5776	!
5777	!-- Volumes of the colliding objects
5778	zma = 96.0_wp ! molar mass of SO4 in g/mol
5779	zmw = 18.0_wp ! molar mass of water in g/mol
5780	zxmass = 1.0_wp ! mass fraction of H2SO4
5781	za = 0.7681724_wp + zxmass * ( 2.1847140_wp + zxmass * &
5782	( 7.1630022_wp + zxmass * &
5783	( -44.31447_wp + zxmass * &
5784	( 88.75606 + zxmass * &
5785	( -75.73729_wp + zxmass * 23.43228_wp ) ) ) ) )
5786	zb = 1.808225E-3_wp + zxmass * ( -9.294656E-3_wp + zxmass * &
5787	( -0.03742148_wp + zxmass * &
5788	( 0.2565321_wp + zxmass * &
5789	( -0.5362872_wp + zxmass * &
5790	( 0.4857736 - zxmass * 0.1629592_wp ) ) ) ) )
5791	zc = - 3.478524E-6_wp + zxmass * ( 1.335867E-5_wp + zxmass * &
5792	( 5.195706E-5_wp + zxmass * &
5793	( -3.717636E-4_wp + zxmass * &
5794	( 7.990811E-4_wp + zxmass * &
5795	( -7.458060E-4_wp + zxmass * 2.58139E-4_wp ) ) ) ) )
5796	!
5797	!-- Density for the sulphuric acid solution (Eq. 10 in Vehkamaki)
5798	zroo = ( za + zt * ( zb + zc * zt ) ) * 1.0E+3_wp ! (kg/m^3
5799	zm1 = 0.098_wp ! molar mass of H2SO4 in kg/mol
5800	zm2 = zm1
5801	zv1 = zm1 / avo / zroo ! volume
5802	zv2 = zv1
5803	!
5804	!-- Collision rate
5805	zcoll = zpcsa * zpcsa * ( 3.0_wp * pi / 4.0_wp )*0.16666666_wp &
5806	SQRT( 6.0_wp * argas * zt / zm1 + 6.0_wp * argas * zt / zm2 ) * &
5807	( zv10.33333333_wp + zv20.33333333_wp )*2 1.0E+6_wp ! m3 -> cm3
5808	zcoll = MIN( zcoll, 1.0E+10_wp )
5809	pnuc_rate = zcoll ! (#/(cm3 s))
5810
5811	ELSE
5812	pnuc_rate = MIN( pnuc_rate, 1.0E+10_wp )
5813	ENDIF
5814	pnuc_rate = pnuc_rate * 1.0E+6_wp ! (#/(m3 s))
5815
5816	END SUBROUTINE binnucl
5817
5818	!------------------------------------------------------------------------------!
5819	! Description:
5820	! ------------
5821	!> Calculate the nucleation rate and the size of critical clusters assuming
5822	!> ternary nucleation. Parametrisation according to:
5823	!> Napari et al. (2002), J. Chem. Phys., 116, 4221-4227 and
5824	!> Napari et al. (2002), J. Geophys. Res., 107(D19), AAC 6-1-ACC 6-6.
5825	!------------------------------------------------------------------------------!
5826	SUBROUTINE ternucl( pc_sa, pc_nh3, ptemp, prh, pnuc_rate, pn_crit_sa, pn_crit_ocnv, pd_crit, &
5827	pk_sa, pk_ocnv )
5828
5829	IMPLICIT NONE
5830
5831	REAL(wp) :: zlnj !< logarithm of nucleation rate
5832	REAL(wp) :: zlognh3 !< LOG( pc_nh3 )
5833	REAL(wp) :: zlogrh !< LOG( prh )
5834	REAL(wp) :: zlogsa !< LOG( pc_sa )
5835
5836	REAL(wp), INTENT(in) :: pc_nh3 !< ammonia mixing ratio (ppt)
5837	REAL(wp), INTENT(in) :: pc_sa !< H2SO4 conc. (#/cm3)
5838	REAL(wp), INTENT(in) :: prh !< relative humidity [0-1]
5839	REAL(wp), INTENT(in) :: ptemp !< ambient temperature (K)
5840
5841	REAL(wp), INTENT(out) :: pd_crit !< diameter of critical cluster (m)
5842	REAL(wp), INTENT(out) :: pk_ocnv !< if pk_ocnv = 1, organic compounds participate in nucleation
5843	REAL(wp), INTENT(out) :: pk_sa !< if pk_sa = 1, H2SO4 participate in nucleation
5844	REAL(wp), INTENT(out) :: pn_crit_ocnv !< number of organic molecules in cluster (#)
5845	REAL(wp), INTENT(out) :: pn_crit_sa !< number of H2SO4 molecules in cluster (#)
5846	REAL(wp), INTENT(out) :: pnuc_rate !< nucleation rate (#/(m3 s))
5847	!
5848	!-- 1) Checking that we are in the validity range of the parameterization.
5849	!-- Validity of parameterization : DO NOT REMOVE!
5850	IF ( ptemp < 240.0_wp .OR. ptemp > 300.0_wp ) THEN
5851	message_string = 'Invalid input value: ptemp'
5852	CALL message( 'salsa_mod: ternucl', 'PA0689', 1, 2, 0, 6, 0 )
5853	ENDIF
5854	IF ( prh < 0.05_wp .OR. prh > 0.95_wp ) THEN
5855	message_string = 'Invalid input value: prh'
5856	CALL message( 'salsa_mod: ternucl', 'PA0649', 1, 2, 0, 6, 0 )
5857	ENDIF
5858	IF ( pc_sa < 1.0E+4_wp .OR. pc_sa > 1.0E+9_wp ) THEN
5859	message_string = 'Invalid input value: pc_sa'
5860	CALL message( 'salsa_mod: ternucl', 'PA0650', 1, 2, 0, 6, 0 )
5861	ENDIF
5862	IF ( pc_nh3 < 0.1_wp .OR. pc_nh3 > 100.0_wp ) THEN
5863	message_string = 'Invalid input value: pc_nh3'
5864	CALL message( 'salsa_mod: ternucl', 'PA0651', 1, 2, 0, 6, 0 )
5865	ENDIF
5866
5867	zlognh3 = LOG( pc_nh3 )
5868	zlogrh = LOG( prh )
5869	zlogsa = LOG( pc_sa )
5870	!
5871	!-- 2) Nucleation rate (Eq. 7 in Napari et al., 2002: Parameterization of
5872	!-- ternary nucleation of sulfuric acid - ammonia - water.
5873	zlnj = - 84.7551114741543_wp + 0.3117595133628944_wp * prh + &
5874	1.640089605712946_wp * prh * ptemp - 0.003438516933381083_wp * prh * ptemp**2 - &
5875	0.00001097530402419113_wp * prh * ptemp**3 - 0.3552967070274677_wp / zlogsa - &
5876	( 0.06651397829765026_wp * prh ) / zlogsa - ( 33.84493989762471_wp * ptemp ) / zlogsa - &
5877	( 7.823815852128623_wp * prh * ptemp ) / zlogsa + &
5878	( 0.3453602302090915_wp * ptemp**2 ) / zlogsa + &
5879	( 0.01229375748100015_wp * prh * ptemp**2 ) / zlogsa - &
5880	( 0.000824007160514956_wp ptemp*3 ) / zlogsa + &
5881	( 0.00006185539100670249_wp * prh * ptemp**3 ) / zlogsa + &
5882	3.137345238574998_wp * zlogsa + 3.680240980277051_wp * prh * zlogsa - &
5883	0.7728606202085936_wp * ptemp * zlogsa - 0.204098217156962_wp * prh * ptemp * zlogsa + &
5884	0.005612037586790018_wp * ptemp*2 zlogsa + &
5885	0.001062588391907444_wp * prh * ptemp*2 zlogsa - &
5886	9.74575691760229E-6_wp * ptemp*3 zlogsa - &
5887	1.265595265137352E-6_wp * prh * ptemp*3 zlogsa + 19.03593713032114_wp * zlogsa**2 - &
5888	0.1709570721236754_wp * ptemp * zlogsa**2 + &
5889	0.000479808018162089_wp * ptemp*2 zlogsa**2 - &
5890	4.146989369117246E-7_wp * ptemp*3 zlogsa*2 + 1.076046750412183_wp zlognh3 + &
5891	0.6587399318567337_wp * prh * zlognh3 + 1.48932164750748_wp * ptemp * zlognh3 + &
5892	0.1905424394695381_wp * prh * ptemp * zlognh3 - &
5893	0.007960522921316015_wp * ptemp*2 zlognh3 - &
5894	0.001657184248661241_wp * prh * ptemp*2 zlognh3 + &
5895	7.612287245047392E-6_wp * ptemp*3 zlognh3 + &
5896	3.417436525881869E-6_wp * prh * ptemp*3 zlognh3 + &
5897	( 0.1655358260404061_wp * zlognh3 ) / zlogsa + &
5898	( 0.05301667612522116_wp * prh * zlognh3 ) / zlogsa + &
5899	( 3.26622914116752_wp * ptemp * zlognh3 ) / zlogsa - &
5900	( 1.988145079742164_wp * prh * ptemp * zlognh3 ) / zlogsa - &
5901	( 0.04897027401984064_wp * ptemp*2 zlognh3 ) / zlogsa + &
5902	( 0.01578269253599732_wp * prh * ptemp*2 zlognh3 ) / zlogsa + &
5903	( 0.0001469672236351303_wp * ptemp*3 zlognh3 ) / zlogsa - &
5904	( 0.00002935642836387197_wp * prh * ptemp*3 zlognh3 ) / zlogsa + &
5905	6.526451177887659_wp * zlogsa * zlognh3 - &
5906	0.2580021816722099_wp * ptemp * zlogsa * zlognh3 + &
5907	0.001434563104474292_wp * ptemp*2 zlogsa * zlognh3 - &
5908	2.020361939304473E-6_wp * ptemp*3 zlogsa * zlognh3 - &
5909	0.160335824596627_wp * zlogsa*2 zlognh3 + &
5910	0.00889880721460806_wp * ptemp * zlogsa*2 zlognh3 - &
5911	0.00005395139051155007_wp * ptemp*2 zlogsa*2 zlognh3 + &
5912	8.39521718689596E-8_wp * ptemp*3 zlogsa*2 zlognh3 + &
5913	6.091597586754857_wp * zlognh3*2 + 8.5786763679309_wp prh * zlognh3**2 - &
5914	1.253783854872055_wp * ptemp * zlognh3**2 - &
5915	0.1123577232346848_wp * prh * ptemp * zlognh3**2 + &
5916	0.00939835595219825_wp * ptemp*2 zlognh3**2 + &
5917	0.0004726256283031513_wp * prh * ptemp*2 zlognh3**2 - &
5918	0.00001749269360523252_wp * ptemp*3 zlognh3**2 - &
5919	6.483647863710339E-7_wp * prh * ptemp*3 zlognh3**2 + &
5920	( 0.7284285726576598_wp * zlognh3**2 ) / zlogsa + &
5921	( 3.647355600846383_wp * ptemp * zlognh3**2 ) / zlogsa - &
5922	( 0.02742195276078021_wp * ptemp*2 zlognh3**2 ) / zlogsa + &
5923	( 0.00004934777934047135_wp * ptemp*3 zlognh3**2 ) / zlogsa + &
5924	41.30162491567873_wp * zlogsa * zlognh3**2 - &
5925	0.357520416800604_wp * ptemp * zlogsa * zlognh3**2 + &
5926	0.000904383005178356_wp * ptemp*2 zlogsa * zlognh3**2 - &
5927	5.737876676408978E-7_wp * ptemp*3 zlogsa * zlognh3**2 - &
5928	2.327363918851818_wp * zlogsa*2 zlognh3**2 + &
5929	0.02346464261919324_wp * ptemp * zlogsa*2 zlognh3**2 - &
5930	0.000076518969516405_wp * ptemp*2 zlogsa*2 zlognh3**2 + &
5931	8.04589834836395E-8_wp * ptemp*3 zlogsa*2 zlognh3**2 - &
5932	0.02007379204248076_wp * zlogrh - 0.7521152446208771_wp * ptemp * zlogrh + &
5933	0.005258130151226247_wp * ptemp*2 zlogrh - &
5934	8.98037634284419E-6_wp * ptemp*3 zlogrh + &
5935	( 0.05993213079516759_wp * zlogrh ) / zlogsa + &
5936	( 5.964746463184173_wp * ptemp * zlogrh ) / zlogsa - &
5937	( 0.03624322255690942_wp * ptemp*2 zlogrh ) / zlogsa + &
5938	( 0.00004933369382462509_wp * ptemp*3 zlogrh ) / zlogsa - &
5939	0.7327310805365114_wp * zlognh3 * zlogrh - &
5940	0.01841792282958795_wp * ptemp * zlognh3 * zlogrh + &
5941	0.0001471855981005184_wp * ptemp*2 zlognh3 * zlogrh - &
5942	2.377113195631848E-7_wp * ptemp*3 zlognh3 * zlogrh
5943	pnuc_rate = EXP( zlnj ) ! (#/(cm3 s))
5944	!
5945	!-- Check validity of parametrization
5946	IF ( pnuc_rate < 1.0E-5_wp ) THEN
5947	pnuc_rate = 0.0_wp
5948	pd_crit = 1.0E-9_wp
5949	ELSEIF ( pnuc_rate > 1.0E6_wp ) THEN
5950	message_string = 'Invalid output value: nucleation rate > 10^6 1/cm3s'
5951	CALL message( 'salsa_mod: ternucl', 'PA0623', 1, 2, 0, 6, 0 )
5952	ENDIF
5953	pnuc_rate = pnuc_rate * 1.0E6_wp ! (#/(m3 s))
5954	!
5955	!-- 3) Number of H2SO4 molecules in a critical cluster (Eq. 9)
5956	pn_crit_sa = 38.16448247950508_wp + 0.7741058259731187_wp * zlnj + &
5957	0.002988789927230632_wp * zlnj*2 - 0.3576046920535017_wp ptemp - &
5958	0.003663583011953248_wp * zlnj * ptemp + 0.000855300153372776_wp * ptemp**2
5959	!
5960	!-- Kinetic limit: at least 2 H2SO4 molecules in a cluster
5961	pn_crit_sa = MAX( pn_crit_sa, 2.0E0_wp )
5962	!
5963	!-- 4) Size of the critical cluster in nm (Eq. 12)
5964	pd_crit = 0.1410271086638381_wp - 0.001226253898894878_wp * zlnj - &
5965	7.822111731550752E-6_wp * zlnj*2 - 0.001567273351921166_wp ptemp - &
5966	0.00003075996088273962_wp * zlnj * ptemp + 0.00001083754117202233_wp * ptemp**2
5967	pd_crit = pd_crit * 2.0E-9_wp ! Diameter in m
5968	!
5969	!-- 5) Organic compounds not involved when ternary nucleation assumed
5970	pn_crit_ocnv = 0.0_wp
5971	pk_sa = 1.0_wp
5972	pk_ocnv = 0.0_wp
5973
5974	END SUBROUTINE ternucl
5975
5976	!------------------------------------------------------------------------------!
5977	! Description:
5978	! ------------
5979	!> Function z_n_nuc_tayl is connected to the calculation of self-coagualtion of
5980	!> small particles. It calculates number of the particles in the size range
5981	!> [zdcrit,dx] using Taylor-expansion (please note that the expansion is not
5982	!> valid for certain rational numbers, e.g. -4/3 and -3/2)
5983	!------------------------------------------------------------------------------!
5984	FUNCTION z_n_nuc_tayl( d1, dx, zm_para, zjnuc_t, zeta, z_gr_tot )
5985
5986	IMPLICIT NONE
5987
5988	INTEGER(iwp) :: i !< running index
5989
5990	REAL(wp) :: d1 !< lower diameter limit
5991	REAL(wp) :: dx !< upper diameter limit
5992	REAL(wp) :: zjnuc_t !< initial nucleation rate (1/s)
5993	REAL(wp) :: zeta !< ratio of CS/GR (m) (condensation sink / growth rate)
5994	REAL(wp) :: term1 !<
5995	REAL(wp) :: term2 !<
5996	REAL(wp) :: term3 !<
5997	REAL(wp) :: term4 !<
5998	REAL(wp) :: term5 !<
5999	REAL(wp) :: z_n_nuc_tayl !< final nucleation rate (1/s)
6000	REAL(wp) :: z_gr_tot !< total growth rate (nm/h)
6001	REAL(wp) :: zm_para !< m parameter in Lehtinen et al. (2007), Eq. 6
6002
6003	z_n_nuc_tayl = 0.0_wp
6004
6005	DO i = 0, 29
6006	IF ( i == 0 .OR. i == 1 ) THEN
6007	term1 = 1.0_wp
6008	ELSE
6009	term1 = term1 * REAL( i, SELECTED_REAL_KIND(12,307) )
6010	END IF
6011	term2 = ( REAL( i, SELECTED_REAL_KIND(12,307) ) * ( zm_para + 1.0_wp ) + 1.0_wp ) * term1
6012	term3 = zeta**i
6013	term4 = term3 / term2
6014	term5 = REAL( i, SELECTED_REAL_KIND(12,307) ) * ( zm_para + 1.0_wp ) + 1.0_wp
6015	z_n_nuc_tayl = z_n_nuc_tayl + term4 * ( dxterm5 - d1term5 )
6016	ENDDO
6017	z_n_nuc_tayl = z_n_nuc_tayl * zjnuc_t * EXP( -zeta * ( d1**( zm_para + 1 ) ) ) / z_gr_tot
6018
6019	END FUNCTION z_n_nuc_tayl
6020
6021	!------------------------------------------------------------------------------!
6022	! Description:
6023	! ------------
6024	!> Calculates the condensation of water vapour on aerosol particles. Follows the
6025	!> analytical predictor method by Jacobson (2005).
6026	!> For equations, see Jacobson (2005), Fundamentals of atmospheric modelling
6027	!> (2nd edition).
6028	!------------------------------------------------------------------------------!
6029	SUBROUTINE gpparth2o( paero, ptemp, ppres, pcs, pcw, ptstep )
6030
6031	IMPLICIT NONE
6032
6033	INTEGER(iwp) :: ib !< loop index
6034	INTEGER(iwp) :: nstr !<
6035
6036	REAL(wp) :: adt !< internal timestep in this subroutine
6037	REAL(wp) :: rhoair !< air density (kg/m3)
6038	REAL(wp) :: ttot !< total time (s)
6039	REAL(wp) :: zact !< Water activity
6040	REAL(wp) :: zaelwc1 !< Current aerosol water content (kg/m3)
6041	REAL(wp) :: zaelwc2 !< New aerosol water content after equilibrium calculation (kg/m3)
6042	REAL(wp) :: zbeta !< Transitional correction factor
6043	REAL(wp) :: zcwc !< Current water vapour mole concentration in aerosols (mol/m3)
6044	REAL(wp) :: zcwint !< Current and new water vapour mole concentrations (mol/m3)
6045	REAL(wp) :: zcwn !< New water vapour mole concentration (mol/m3)
6046	REAL(wp) :: zcwtot !< Total water mole concentration (mol/m3)
6047	REAL(wp) :: zdfh2o !< molecular diffusion coefficient (cm2/s) for water
6048	REAL(wp) :: zhlp1 !< intermediate variable to calculate the mass transfer coefficient
6049	REAL(wp) :: zhlp2 !< intermediate variable to calculate the mass transfer coefficient
6050	REAL(wp) :: zhlp3 !< intermediate variable to calculate the mass transfer coefficient
6051	REAL(wp) :: zknud !< Knudsen number
6052	REAL(wp) :: zmfph2o !< mean free path of H2O gas molecule
6053	REAL(wp) :: zrh !< relative humidity [0-1]
6054	REAL(wp) :: zthcond !< thermal conductivity of air (W/m/K)
6055
6056	REAL(wp), DIMENSION(nbins_aerosol) :: zcwcae !< Current water mole concentrations
6057	REAL(wp), DIMENSION(nbins_aerosol) :: zcwintae !< Current and new aerosol water mole concentration
6058	REAL(wp), DIMENSION(nbins_aerosol) :: zcwnae !< New water mole concentration in aerosols
6059	REAL(wp), DIMENSION(nbins_aerosol) :: zcwsurfae !< Surface mole concentration
6060	REAL(wp), DIMENSION(nbins_aerosol) :: zkelvin !< Kelvin effect
6061	REAL(wp), DIMENSION(nbins_aerosol) :: zmtae !< Mass transfer coefficients
6062	REAL(wp), DIMENSION(nbins_aerosol) :: zwsatae !< Water saturation ratio above aerosols
6063
6064	REAL(wp), INTENT(in) :: ppres !< Air pressure (Pa)
6065	REAL(wp), INTENT(in) :: pcs !< Water vapour saturation concentration (kg/m3)
6066	REAL(wp), INTENT(in) :: ptemp !< Ambient temperature (K)
6067	REAL(wp), INTENT(in) :: ptstep !< timestep (s)
6068
6069	REAL(wp), INTENT(inout) :: pcw !< Water vapour concentration (kg/m3)
6070
6071	TYPE(t_section), DIMENSION(nbins_aerosol), INTENT(inout) :: paero !< Aerosol properties
6072	!
6073	!-- Relative humidity [0-1]
6074	zrh = pcw / pcs
6075	!
6076	!-- Calculate the condensation only for 2a/2b aerosol bins
6077	nstr = start_subrange_2a
6078	!
6079	!-- Save the current aerosol water content, 8 in paero is H2O
6080	zaelwc1 = SUM( paero(start_subrange_1a:end_subrange_2b)%volc(8) ) * arhoh2o
6081	!
6082	!-- Equilibration:
6083	IF ( advect_particle_water ) THEN
6084	IF ( zrh < 0.98_wp .OR. .NOT. lscndh2oae ) THEN
6085	CALL equilibration( zrh, ptemp, paero, .TRUE. )
6086	ELSE
6087	CALL equilibration( zrh, ptemp, paero, .FALSE. )
6088	ENDIF
6089	ENDIF
6090	!
6091	!-- The new aerosol water content after equilibrium calculation
6092	zaelwc2 = SUM( paero(start_subrange_1a:end_subrange_2b)%volc(8) ) * arhoh2o
6093	!
6094	!-- New water vapour mixing ratio (kg/m3)
6095	pcw = pcw - ( zaelwc2 - zaelwc1 ) * ppres * amdair / ( argas * ptemp )
6096	!
6097	!-- Initialise variables
6098	zcwsurfae(:) = 0.0_wp
6099	zhlp1 = 0.0_wp
6100	zhlp2 = 0.0_wp
6101	zhlp3 = 0.0_wp
6102	zmtae(:) = 0.0_wp
6103	zwsatae(:) = 0.0_wp
6104	!
6105	!-- Air:
6106	!-- Density (kg/m3)
6107	rhoair = amdair * ppres / ( argas * ptemp )
6108	!
6109	!-- Thermal conductivity of air
6110	zthcond = 0.023807_wp + 7.1128E-5_wp * ( ptemp - 273.16_wp )
6111	!
6112	!-- Water vapour:
6113	!-- Molecular diffusion coefficient (cm2/s) (eq.16.17)
6114	zdfh2o = ( 5.0_wp / ( 16.0_wp * avo * rhoair * 1.0E-3_wp * 3.11E-8_wp*2 ) ) SQRT( argas * &
6115	1.0E+7_wp * ptemp * amdair * 1.0E+3_wp * ( amh2o + amdair ) * 1.0E+3_wp / &
6116	( pi * amh2o * 2.0E+3_wp ) )
6117	zdfh2o = zdfh2o * 1.0E-4 ! Unit change to m^2/s
6118	!
6119	!-- Mean free path (eq. 15.25 & 16.29)
6120	zmfph2o = 3.0_wp * zdfh2o * SQRT( pi * amh2o / ( 8.0_wp * argas * ptemp ) )
6121	!
6122	!-- Kelvin effect (eq. 16.33)
6123	zkelvin(:) = EXP( 4.0_wp * surfw0 * amh2o / ( argas * ptemp * arhoh2o * paero(:)%dwet) )
6124
6125	DO ib = 1, nbins_aerosol
6126	IF ( paero(ib)%numc > nclim .AND. zrh > 0.98_wp ) THEN
6127	!
6128	!-- Water activity
6129	zact = acth2o( paero(ib) )
6130	!
6131	!-- Saturation mole concentration over flat surface. Limit the super-
6132	!-- saturation to max 1.01 for the mass transfer. Experimental!
6133	zcwsurfae(ib) = MAX( pcs, pcw / 1.01_wp ) * rhoair / amh2o
6134	!
6135	!-- Equilibrium saturation ratio
6136	zwsatae(ib) = zact * zkelvin(ib)
6137	!
6138	!-- Knudsen number (eq. 16.20)
6139	zknud = 2.0_wp * zmfph2o / paero(ib)%dwet
6140	!
6141	!-- Transitional correction factor (Fuks & Sutugin, 1971)
6142	zbeta = ( zknud + 1.0_wp ) / ( 0.377_wp * zknud + 1.0_wp + 4.0_wp / &
6143	( 3.0_wp * massacc(ib) ) * ( zknud + zknud**2 ) )
6144	!
6145	!-- Mass transfer of H2O: Eq. 16.64 but here D^eff = zdfh2o * zbeta
6146	zhlp1 = paero(ib)%numc * 2.0_wp * pi * paero(ib)%dwet * zdfh2o * zbeta
6147	!
6148	!-- 1st term on the left side of the denominator in eq. 16.55
6149	zhlp2 = amh2o * zdfh2o * alv * zwsatae(ib) * zcwsurfae(ib) / ( zthcond * ptemp )
6150	!
6151	!-- 2nd term on the left side of the denominator in eq. 16.55
6152	zhlp3 = ( ( alv * amh2o ) / ( argas * ptemp ) ) - 1.0_wp
6153	!
6154	!-- Full eq. 16.64: Mass transfer coefficient (1/s)
6155	zmtae(ib) = zhlp1 / ( zhlp2 * zhlp3 + 1.0_wp )
6156	ENDIF
6157	ENDDO
6158	!
6159	!-- Current mole concentrations of water
6160	zcwc = pcw * rhoair / amh2o ! as vapour
6161	zcwcae(:) = paero(:)%volc(8) * arhoh2o / amh2o ! in aerosols
6162	zcwtot = zcwc + SUM( zcwcae ) ! total water concentration
6163	zcwnae(:) = 0.0_wp
6164	zcwintae(:) = zcwcae(:)
6165	!
6166	!-- Substepping loop
6167	zcwint = 0.0_wp
6168	ttot = 0.0_wp
6169	DO WHILE ( ttot < ptstep )
6170	adt = 2.0E-2_wp ! internal timestep
6171	!
6172	!-- New vapour concentration: (eq. 16.71)
6173	zhlp1 = zcwc + adt * ( SUM( zmtae(nstr:nbins_aerosol) * zwsatae(nstr:nbins_aerosol) * &
6174	zcwsurfae(nstr:nbins_aerosol) ) ) ! numerator
6175	zhlp2 = 1.0_wp + adt * ( SUM( zmtae(nstr:nbins_aerosol) ) ) ! denomin.
6176	zcwint = zhlp1 / zhlp2 ! new vapour concentration
6177	zcwint = MIN( zcwint, zcwtot )
6178	IF ( ANY( paero(:)%numc > nclim ) .AND. zrh > 0.98_wp ) THEN
6179	DO ib = nstr, nbins_aerosol
6180	zcwintae(ib) = zcwcae(ib) + MIN( MAX( adt * zmtae(ib) * ( zcwint - zwsatae(ib) * &
6181	zcwsurfae(ib) ), -0.02_wp * zcwcae(ib) ), &
6182	0.05_wp * zcwcae(ib) )
6183	zwsatae(ib) = acth2o( paero(ib), zcwintae(ib) ) * zkelvin(ib)
6184	ENDDO
6185	ENDIF
6186	zcwintae(nstr:nbins_aerosol) = MAX( zcwintae(nstr:nbins_aerosol), 0.0_wp )
6187	!
6188	!-- Update vapour concentration for consistency
6189	zcwint = zcwtot - SUM( zcwintae(1:nbins_aerosol) )
6190	!
6191	!-- Update "old" values for next cycle
6192	zcwcae = zcwintae
6193
6194	ttot = ttot + adt
6195
6196	ENDDO ! ADT
6197
6198	zcwn = zcwint
6199	zcwnae(:) = zcwintae(:)
6200	pcw = zcwn * amh2o / rhoair
6201	paero(:)%volc(8) = MAX( 0.0_wp, zcwnae(:) * amh2o / arhoh2o )
6202
6203	END SUBROUTINE gpparth2o
6204
6205	!------------------------------------------------------------------------------!
6206	! Description:
6207	! ------------
6208	!> Calculates the activity coefficient of liquid water
6209	!------------------------------------------------------------------------------!
6210	REAL(wp) FUNCTION acth2o( ppart, pcw )
6211
6212	IMPLICIT NONE
6213
6214	REAL(wp) :: zns !< molar concentration of solutes (mol/m3)
6215	REAL(wp) :: znw !< molar concentration of water (mol/m3)
6216
6217	REAL(wp), INTENT(in), OPTIONAL :: pcw !< molar concentration of water (mol/m3)
6218
6219	TYPE(t_section), INTENT(in) :: ppart !< Aerosol properties of a bin
6220
6221	zns = ( 3.0_wp * ( ppart%volc(1) * arhoh2so4 / amh2so4 ) + ( ppart%volc(2) * arhooc / amoc ) + &
6222	2.0_wp * ( ppart%volc(5) * arhoss / amss ) + ( ppart%volc(6) * arhohno3 / amhno3 ) + &
6223	( ppart%volc(7) * arhonh3 / amnh3 ) )
6224
6225	IF ( PRESENT(pcw) ) THEN
6226	znw = pcw
6227	ELSE
6228	znw = ppart%volc(8) * arhoh2o / amh2o
6229	ENDIF
6230	!
6231	!-- Activity = partial pressure of water vapour / sat. vapour pressure of water over a liquid surface
6232	!-- = molality * activity coefficient (Jacobson, 2005: eq. 17.20-21)
6233	!-- Assume activity coefficient of 1 for water
6234	acth2o = MAX( 0.1_wp, znw / MAX( EPSILON( 1.0_wp ),( znw + zns ) ) )
6235
6236	END FUNCTION acth2o
6237
6238	!------------------------------------------------------------------------------!
6239	! Description:
6240	! ------------
6241	!> Calculates the dissolutional growth of particles (i.e. gas transfers to a
6242	!> particle surface and dissolves in liquid water on the surface). Treated here
6243	!> as a non-equilibrium (time-dependent) process. Gases: HNO3 and NH3
6244	!> (Chapter 17.14 in Jacobson, 2005).
6245	!
6246	!> Called from subroutine condensation.
6247	!> Coded by:
6248	!> Harri Kokkola (FMI)
6249	!------------------------------------------------------------------------------!
6250	SUBROUTINE gpparthno3( ppres, ptemp, paero, pghno3, pgnh3, pcw, pcs, pbeta, ptstep )
6251
6252	IMPLICIT NONE
6253
6254	INTEGER(iwp) :: ib !< loop index
6255
6256	REAL(wp) :: adt !< timestep
6257	REAL(wp) :: zc_nh3_c !< Current NH3 gas concentration
6258	REAL(wp) :: zc_nh3_int !< Intermediate NH3 gas concentration
6259	REAL(wp) :: zc_nh3_n !< New NH3 gas concentration
6260	REAL(wp) :: zc_nh3_tot !< Total NH3 concentration
6261	REAL(wp) :: zc_hno3_c !< Current HNO3 gas concentration
6262	REAL(wp) :: zc_hno3_int !< Intermediate HNO3 gas concentration
6263	REAL(wp) :: zc_hno3_n !< New HNO3 gas concentration
6264	REAL(wp) :: zc_hno3_tot !< Total HNO3 concentration
6265	REAL(wp) :: zdfvap !< Diffusion coefficient for vapors
6266	REAL(wp) :: zhlp1 !< intermediate variable
6267	REAL(wp) :: zhlp2 !< intermediate variable
6268	REAL(wp) :: zrh !< relative humidity
6269
6270	REAL(wp), INTENT(in) :: ppres !< ambient pressure (Pa)
6271	REAL(wp), INTENT(in) :: pcs !< water vapour saturation
6272	!< concentration (kg/m3)
6273	REAL(wp), INTENT(in) :: ptemp !< ambient temperature (K)
6274	REAL(wp), INTENT(in) :: ptstep !< time step (s)
6275
6276	REAL(wp), INTENT(inout) :: pghno3 !< nitric acid concentration (#/m3)
6277	REAL(wp), INTENT(inout) :: pgnh3 !< ammonia conc. (#/m3)
6278	REAL(wp), INTENT(inout) :: pcw !< water vapour concentration (kg/m3)
6279
6280	REAL(wp), DIMENSION(nbins_aerosol) :: zac_hno3_ae !< Activity coefficients for HNO3
6281	REAL(wp), DIMENSION(nbins_aerosol) :: zac_hhso4_ae !< Activity coefficients for HHSO4
6282	REAL(wp), DIMENSION(nbins_aerosol) :: zac_nh3_ae !< Activity coefficients for NH3
6283	REAL(wp), DIMENSION(nbins_aerosol) :: zac_nh4hso2_ae !< Activity coefficients for NH4HSO2
6284	REAL(wp), DIMENSION(nbins_aerosol) :: zcg_hno3_eq_ae !< Equilibrium gas concentration: HNO3
6285	REAL(wp), DIMENSION(nbins_aerosol) :: zcg_nh3_eq_ae !< Equilibrium gas concentration: NH3
6286	REAL(wp), DIMENSION(nbins_aerosol) :: zc_hno3_int_ae !< Intermediate HNO3 aerosol concentration
6287	REAL(wp), DIMENSION(nbins_aerosol) :: zc_hno3_c_ae !< Current HNO3 in aerosols
6288	REAL(wp), DIMENSION(nbins_aerosol) :: zc_hno3_n_ae !< New HNO3 in aerosols
6289	REAL(wp), DIMENSION(nbins_aerosol) :: zc_nh3_int_ae !< Intermediate NH3 aerosol concentration
6290	REAL(wp), DIMENSION(nbins_aerosol) :: zc_nh3_c_ae !< Current NH3 in aerosols
6291	REAL(wp), DIMENSION(nbins_aerosol) :: zc_nh3_n_ae !< New NH3 in aerosols
6292	REAL(wp), DIMENSION(nbins_aerosol) :: zkel_hno3_ae !< Kelvin effect for HNO3
6293	REAL(wp), DIMENSION(nbins_aerosol) :: zkel_nh3_ae !< Kelvin effects for NH3
6294	REAL(wp), DIMENSION(nbins_aerosol) :: zmt_hno3_ae !< Mass transfer coefficients for HNO3
6295	REAL(wp), DIMENSION(nbins_aerosol) :: zmt_nh3_ae !< Mass transfer coefficients for NH3
6296	REAL(wp), DIMENSION(nbins_aerosol) :: zsat_hno3_ae !< HNO3 saturation ratio over a surface
6297	REAL(wp), DIMENSION(nbins_aerosol) :: zsat_nh3_ae !< NH3 saturation ratio over a surface
6298
6299	REAL(wp), DIMENSION(nbins_aerosol,maxspec) :: zion_mols !< Ion molalities from pdfite aerosols
6300
6301	REAL(wp), DIMENSION(nbins_aerosol), INTENT(in) :: pbeta !< transitional correction factor for
6302
6303	TYPE(t_section), DIMENSION(nbins_aerosol), INTENT(inout) :: paero !< Aerosol properties
6304	!
6305	!-- Initialise:
6306	adt = ptstep
6307	zac_hhso4_ae = 0.0_wp
6308	zac_nh3_ae = 0.0_wp
6309	zac_nh4hso2_ae = 0.0_wp
6310	zac_hno3_ae = 0.0_wp
6311	zcg_nh3_eq_ae = 0.0_wp
6312	zcg_hno3_eq_ae = 0.0_wp
6313	zion_mols = 0.0_wp
6314	zsat_nh3_ae = 1.0_wp
6315	zsat_hno3_ae = 1.0_wp
6316	!
6317	!-- Diffusion coefficient (m2/s)
6318	zdfvap = 5.1111E-10_wp * ptemp*1.75_wp ( p_0 + 1325.0_wp ) / ppres
6319	!
6320	!-- Kelvin effects (Jacobson (2005), eq. 16.33)
6321	zkel_hno3_ae(1:nbins_aerosol) = EXP( 4.0_wp * surfw0 * amvhno3 / &
6322	( abo * ptemp * paero(1:nbins_aerosol)%dwet ) )
6323	zkel_nh3_ae(1:nbins_aerosol) = EXP( 4.0_wp * surfw0 * amvnh3 / &
6324	( abo * ptemp * paero(1:nbins_aerosol)%dwet ) )
6325	!
6326	!-- Current vapour mole concentrations (mol/m3)
6327	zc_hno3_c = pghno3 / avo ! HNO3
6328	zc_nh3_c = pgnh3 / avo ! NH3
6329	!
6330	!-- Current particle mole concentrations (mol/m3)
6331	zc_hno3_c_ae(1:nbins_aerosol) = paero(1:nbins_aerosol)%volc(6) * arhohno3 / amhno3
6332	zc_nh3_c_ae(1:nbins_aerosol) = paero(1:nbins_aerosol)%volc(7) * arhonh3 / amnh3
6333	!
6334	!-- Total mole concentrations: gas and particle phase
6335	zc_hno3_tot = zc_hno3_c + SUM( zc_hno3_c_ae(1:nbins_aerosol) )
6336	zc_nh3_tot = zc_nh3_c + SUM( zc_nh3_c_ae(1:nbins_aerosol) )
6337	!
6338	!-- Relative humidity [0-1]
6339	zrh = pcw / pcs
6340	!
6341	!-- Mass transfer coefficients (Jacobson, Eq. 16.64)
6342	zmt_hno3_ae(:) = 2.0_wp * pi * paero(:)%dwet * zdfvap * paero(:)%numc * pbeta(:)
6343	zmt_nh3_ae(:) = 2.0_wp * pi * paero(:)%dwet * zdfvap * paero(:)%numc * pbeta(:)
6344
6345	!
6346	!-- Get the equilibrium concentrations above aerosols
6347	CALL nitrate_ammonium_equilibrium( zrh, ptemp, paero, zcg_hno3_eq_ae, zcg_nh3_eq_ae, &
6348	zac_hno3_ae, zac_nh3_ae, zac_nh4hso2_ae, zac_hhso4_ae, &
6349	zion_mols )
6350	!
6351	!-- Calculate NH3 and HNO3 saturation ratios for aerosols
6352	CALL nitrate_ammonium_saturation( ptemp, paero, zac_hno3_ae, zac_nh4hso2_ae, zac_hhso4_ae, &
6353	zcg_hno3_eq_ae, zc_hno3_c_ae, zc_nh3_c_ae, zkel_hno3_ae, &
6354	zkel_nh3_ae, zsat_hno3_ae, zsat_nh3_ae )
6355	!
6356	!-- Intermediate gas concentrations of HNO3 and NH3
6357	zhlp1 = SUM( zc_hno3_c_ae(:) / ( 1.0_wp + adt * zmt_hno3_ae(:) * zsat_hno3_ae(:) ) )
6358	zhlp2 = SUM( zmt_hno3_ae(:) / ( 1.0_wp + adt * zmt_hno3_ae(:) * zsat_hno3_ae(:) ) )
6359	zc_hno3_int = ( zc_hno3_tot - zhlp1 ) / ( 1.0_wp + adt * zhlp2 )
6360
6361	zhlp1 = SUM( zc_nh3_c_ae(:) / ( 1.0_wp + adt * zmt_nh3_ae(:) * zsat_nh3_ae(:) ) )
6362	zhlp2 = SUM( zmt_nh3_ae(:) / ( 1.0_wp + adt * zmt_nh3_ae(:) * zsat_nh3_ae(:) ) )
6363	zc_nh3_int = ( zc_nh3_tot - zhlp1 )/( 1.0_wp + adt * zhlp2 )
6364
6365	zc_hno3_int = MIN( zc_hno3_int, zc_hno3_tot )
6366	zc_nh3_int = MIN( zc_nh3_int, zc_nh3_tot )
6367	!
6368	!-- Calculate the new concentration on aerosol particles
6369	zc_hno3_int_ae = zc_hno3_c_ae
6370	zc_nh3_int_ae = zc_nh3_c_ae
6371	DO ib = 1, nbins_aerosol
6372	zc_hno3_int_ae(ib) = ( zc_hno3_c_ae(ib) + adt * zmt_hno3_ae(ib) * zc_hno3_int ) / &
6373	( 1.0_wp + adt * zmt_hno3_ae(ib) * zsat_hno3_ae(ib) )
6374	zc_nh3_int_ae(ib) = ( zc_nh3_c_ae(ib) + adt * zmt_nh3_ae(ib) * zc_nh3_int ) / &
6375	( 1.0_wp + adt * zmt_nh3_ae(ib) * zsat_nh3_ae(ib) )
6376	ENDDO
6377
6378	zc_hno3_int_ae(:) = MAX( zc_hno3_int_ae(:), 0.0_wp )
6379	zc_nh3_int_ae(:) = MAX( zc_nh3_int_ae(:), 0.0_wp )
6380	!
6381	!-- Final molar gas concentration and molar particle concentration of HNO3
6382	zc_hno3_n = zc_hno3_int
6383	zc_hno3_n_ae = zc_hno3_int_ae
6384	!
6385	!-- Final molar gas concentration and molar particle concentration of NH3
6386	zc_nh3_n = zc_nh3_int
6387	zc_nh3_n_ae = zc_nh3_int_ae
6388	!
6389	!-- Model timestep reached - update the gas concentrations
6390	pghno3 = zc_hno3_n * avo
6391	pgnh3 = zc_nh3_n * avo
6392	!
6393	!-- Update the particle concentrations
6394	DO ib = start_subrange_1a, end_subrange_2b
6395	paero(ib)%volc(6) = zc_hno3_n_ae(ib) * amhno3 / arhohno3
6396	paero(ib)%volc(7) = zc_nh3_n_ae(ib) * amnh3 / arhonh3
6397	ENDDO
6398
6399	END SUBROUTINE gpparthno3
6400	!------------------------------------------------------------------------------!
6401	! Description:
6402	! ------------
6403	!> Calculate the equilibrium concentrations above aerosols (reference?)
6404	!------------------------------------------------------------------------------!
6405	SUBROUTINE nitrate_ammonium_equilibrium( prh, ptemp, ppart, pcg_hno3_eq, pcg_nh3_eq, pgamma_hno3, &
6406	pgamma_nh4, pgamma_nh4hso2, pgamma_hhso4, pmols )
6407
6408	IMPLICIT NONE
6409
6410	INTEGER(iwp) :: ib !< loop index: aerosol bins
6411
6412	REAL(wp) :: zhlp !< intermediate variable
6413	REAL(wp) :: zp_hcl !< Equilibrium vapor pressures (Pa) of HCl
6414	REAL(wp) :: zp_hno3 !< Equilibrium vapor pressures (Pa) of HNO3
6415	REAL(wp) :: zp_nh3 !< Equilibrium vapor pressures (Pa) of NH3
6416	REAL(wp) :: zwatertotal !< Total water in particles (mol/m3)
6417
6418	REAL(wp), INTENT(in) :: prh !< relative humidity
6419	REAL(wp), INTENT(in) :: ptemp !< ambient temperature (K)
6420
6421	REAL(wp), DIMENSION(maxspec) :: zgammas !< Activity coefficients
6422	REAL(wp), DIMENSION(maxspec) :: zions !< molar concentration of ion (mol/m3)
6423
6424	REAL(wp), DIMENSION(nbins_aerosol), INTENT(inout) :: pcg_nh3_eq !< equilibrium molar
6425	!< concentration: of NH3
6426	REAL(wp), DIMENSION(nbins_aerosol), INTENT(inout) :: pcg_hno3_eq !< of HNO3
6427	REAL(wp), DIMENSION(nbins_aerosol), INTENT(inout) :: pgamma_hhso4 !< activity coeff. of HHSO4
6428	REAL(wp), DIMENSION(nbins_aerosol), INTENT(inout) :: pgamma_nh4 !< activity coeff. of NH3
6429	REAL(wp), DIMENSION(nbins_aerosol), INTENT(inout) :: pgamma_nh4hso2 !< activity coeff. of NH4HSO2
6430	REAL(wp), DIMENSION(nbins_aerosol), INTENT(inout) :: pgamma_hno3 !< activity coeff. of HNO3
6431
6432	REAL(wp), DIMENSION(nbins_aerosol,maxspec), INTENT(inout) :: pmols !< Ion molalities
6433
6434	TYPE(t_section), DIMENSION(nbins_aerosol), INTENT(inout) :: ppart !< Aerosol properties
6435
6436	zgammas = 0.0_wp
6437	zhlp = 0.0_wp
6438	zions = 0.0_wp
6439	zp_hcl = 0.0_wp
6440	zp_hno3 = 0.0_wp
6441	zp_nh3 = 0.0_wp
6442	zwatertotal = 0.0_wp
6443
6444	DO ib = 1, nbins_aerosol
6445
6446	IF ( ppart(ib)%numc < nclim ) CYCLE
6447	!
6448	!-- Ion molar concentrations: 2*H2SO4 + CL + NO3 - Na - NH4
6449	zhlp = 2.0_wp * ppart(ib)%volc(1) * arhoh2so4 / amh2so4 + ppart(ib)%volc(5) * arhoss / amss &
6450	+ ppart(ib)%volc(6) * arhohno3 / amhno3 - ppart(ib)%volc(5) * arhoss / amss - &
6451	ppart(ib)%volc(7) * arhonh3 / amnh3
6452
6453	zions(1) = zhlp ! H+
6454	zions(2) = ppart(ib)%volc(7) * arhonh3 / amnh3 ! NH4+
6455	zions(3) = ppart(ib)%volc(5) * arhoss / amss ! Na+
6456	zions(4) = ppart(ib)%volc(1) * arhoh2so4 / amh2so4 ! SO4(2-)
6457	zions(5) = 0.0_wp ! HSO4-
6458	zions(6) = ppart(ib)%volc(6) * arhohno3 / amhno3 ! NO3-
6459	zions(7) = ppart(ib)%volc(5) * arhoss / amss ! Cl-
6460
6461	zwatertotal = ppart(ib)%volc(8) * arhoh2o / amh2o
6462	IF ( zwatertotal > 1.0E-30_wp ) THEN
6463	CALL inorganic_pdfite( prh, ptemp, zions, zwatertotal, zp_hno3, zp_hcl, zp_nh3, zgammas, &
6464	pmols(ib,:) )
6465	ENDIF
6466	!
6467	!-- Activity coefficients
6468	pgamma_hno3(ib) = zgammas(1) ! HNO3
6469	pgamma_nh4(ib) = zgammas(3) ! NH3
6470	pgamma_nh4hso2(ib) = zgammas(6) ! NH4HSO2
6471	pgamma_hhso4(ib) = zgammas(7) ! HHSO4
6472	!
6473	!-- Equilibrium molar concentrations (mol/m3) from equlibrium pressures (Pa)
6474	pcg_hno3_eq(ib) = zp_hno3 / ( argas * ptemp )
6475	pcg_nh3_eq(ib) = zp_nh3 / ( argas * ptemp )
6476
6477	ENDDO
6478
6479	END SUBROUTINE nitrate_ammonium_equilibrium
6480
6481	!------------------------------------------------------------------------------!
6482	! Description:
6483	! ------------
6484	!> Calculate saturation ratios of NH4 and HNO3 for aerosols
6485	!------------------------------------------------------------------------------!
6486	SUBROUTINE nitrate_ammonium_saturation( ptemp, ppart, pachno3, pacnh4hso2, pachhso4, pchno3eq, &
6487	pchno3, pc_nh3, pkelhno3, pkelnh3, psathno3, psatnh3 )
6488
6489	IMPLICIT NONE
6490
6491	INTEGER(iwp) :: ib !< running index for aerosol bins
6492
6493	REAL(wp) :: k_ll_h2o !< equilibrium constants of equilibrium reactions:
6494	!< H2O(aq) <--> H+ + OH- (mol/kg)
6495	REAL(wp) :: k_ll_nh3 !< NH3(aq) + H2O(aq) <--> NH4+ + OH- (mol/kg)
6496	REAL(wp) :: k_gl_nh3 !< NH3(g) <--> NH3(aq) (mol/kg/atm)
6497	REAL(wp) :: k_gl_hno3 !< HNO3(g) <--> H+ + NO3- (mol2/kg2/atm)
6498	REAL(wp) :: zmol_no3 !< molality of NO3- (mol/kg)
6499	REAL(wp) :: zmol_h !< molality of H+ (mol/kg)
6500	REAL(wp) :: zmol_so4 !< molality of SO4(2-) (mol/kg)
6501	REAL(wp) :: zmol_cl !< molality of Cl- (mol/kg)
6502	REAL(wp) :: zmol_nh4 !< molality of NH4+ (mol/kg)
6503	REAL(wp) :: zmol_na !< molality of Na+ (mol/kg)
6504	REAL(wp) :: zhlp1 !< intermediate variable
6505	REAL(wp) :: zhlp2 !< intermediate variable
6506	REAL(wp) :: zhlp3 !< intermediate variable
6507	REAL(wp) :: zxi !< particle mole concentration ratio: (NH3+SS)/H2SO4
6508	REAL(wp) :: zt0 !< reference temp
6509
6510	REAL(wp), PARAMETER :: a1 = -22.52_wp !<
6511	REAL(wp), PARAMETER :: a2 = -1.50_wp !<
6512	REAL(wp), PARAMETER :: a3 = 13.79_wp !<
6513	REAL(wp), PARAMETER :: a4 = 29.17_wp !<
6514	REAL(wp), PARAMETER :: b1 = 26.92_wp !<
6515	REAL(wp), PARAMETER :: b2 = 26.92_wp !<
6516	REAL(wp), PARAMETER :: b3 = -5.39_wp !<
6517	REAL(wp), PARAMETER :: b4 = 16.84_wp !<
6518	REAL(wp), PARAMETER :: K01 = 1.01E-14_wp !<
6519	REAL(wp), PARAMETER :: K02 = 1.81E-5_wp !<
6520	REAL(wp), PARAMETER :: K03 = 57.64_wp !<
6521	REAL(wp), PARAMETER :: K04 = 2.51E+6_wp !<
6522
6523	REAL(wp), INTENT(in) :: ptemp !< ambient temperature (K)
6524
6525	REAL(wp), DIMENSION(nbins_aerosol), INTENT(in) :: pachhso4 !< activity coeff. of HHSO4
6526	REAL(wp), DIMENSION(nbins_aerosol), INTENT(in) :: pacnh4hso2 !< activity coeff. of NH4HSO2
6527	REAL(wp), DIMENSION(nbins_aerosol), INTENT(in) :: pachno3 !< activity coeff. of HNO3
6528	REAL(wp), DIMENSION(nbins_aerosol), INTENT(in) :: pchno3eq !< eq. surface concentration: HNO3
6529	REAL(wp), DIMENSION(nbins_aerosol), INTENT(in) :: pchno3 !< current particle mole
6530	!< concentration of HNO3 (mol/m3)
6531	REAL(wp), DIMENSION(nbins_aerosol), INTENT(in) :: pc_nh3 !< of NH3 (mol/m3)
6532	REAL(wp), DIMENSION(nbins_aerosol), INTENT(in) :: pkelhno3 !< Kelvin effect for HNO3
6533	REAL(wp), DIMENSION(nbins_aerosol), INTENT(in) :: pkelnh3 !< Kelvin effect for NH3
6534
6535	REAL(wp), DIMENSION(nbins_aerosol), INTENT(out) :: psathno3 !< saturation ratio of HNO3
6536	REAL(wp), DIMENSION(nbins_aerosol), INTENT(out) :: psatnh3 !< saturation ratio of NH3
6537
6538	TYPE(t_section), DIMENSION(nbins_aerosol), INTENT(inout) :: ppart !< Aerosol properties
6539
6540	zmol_cl = 0.0_wp
6541	zmol_h = 0.0_wp
6542	zmol_na = 0.0_wp
6543	zmol_nh4 = 0.0_wp
6544	zmol_no3 = 0.0_wp
6545	zmol_so4 = 0.0_wp
6546	zt0 = 298.15_wp
6547	zxi = 0.0_wp
6548	!
6549	!-- Calculates equlibrium rate constants based on Table B.7 in Jacobson (2005):
6550	!-- K^ll_H20, K^ll_NH3, K^gl_NH3, K^gl_HNO3
6551	zhlp1 = zt0 / ptemp
6552	zhlp2 = zhlp1 - 1.0_wp
6553	zhlp3 = 1.0_wp + LOG( zhlp1 ) - zhlp1
6554
6555	k_ll_h2o = K01 * EXP( a1 * zhlp2 + b1 * zhlp3 )
6556	k_ll_nh3 = K02 * EXP( a2 * zhlp2 + b2 * zhlp3 )
6557	k_gl_nh3 = K03 * EXP( a3 * zhlp2 + b3 * zhlp3 )
6558	k_gl_hno3 = K04 * EXP( a4 * zhlp2 + b4 * zhlp3 )
6559
6560	DO ib = 1, nbins_aerosol
6561
6562	IF ( ppart(ib)%numc > nclim .AND. ppart(ib)%volc(8) > 1.0E-30_wp ) THEN
6563	!
6564	!-- Molality of H+ and NO3-
6565	zhlp1 = pc_nh3(ib) * amnh3 + ppart(ib)%volc(1) * arhoh2so4 + ppart(ib)%volc(2) * arhooc &
6566	+ ppart(ib)%volc(5) * arhoss + ppart(ib)%volc(8) * arhoh2o
6567	zmol_no3 = pchno3(ib) / zhlp1 !< mol/kg
6568	!
6569	!-- Particle mole concentration ratio: (NH3+SS)/H2SO4
6570	zxi = ( pc_nh3(ib) + ppart(ib)%volc(5) * arhoss / amss ) / ( ppart(ib)%volc(1) * &
6571	arhoh2so4 / amh2so4 )
6572
6573	IF ( zxi <= 2.0_wp ) THEN
6574	!
6575	!-- Molality of SO4(2-)
6576	zhlp1 = pc_nh3(ib) * amnh3 + pchno3(ib) * amhno3 + ppart(ib)%volc(2) * arhooc + &
6577	ppart(ib)%volc(5) * arhoss + ppart(ib)%volc(8) * arhoh2o
6578	zmol_so4 = ( ppart(ib)%volc(1) * arhoh2so4 / amh2so4 ) / zhlp1
6579	!
6580	!-- Molality of Cl-
6581	zhlp1 = pc_nh3(ib) * amnh3 + pchno3(ib) * amhno3 + ppart(ib)%volc(2) * arhooc + &
6582	ppart(ib)%volc(1) * arhoh2so4 + ppart(ib)%volc(8) * arhoh2o
6583	zmol_cl = ( ppart(ib)%volc(5) * arhoss / amss ) / zhlp1
6584	!
6585	!-- Molality of NH4+
6586	zhlp1 = pchno3(ib) * amhno3 + ppart(ib)%volc(1) * arhoh2so4 + ppart(ib)%volc(2) * &
6587	arhooc + ppart(ib)%volc(5) * arhoss + ppart(ib)%volc(8) * arhoh2o
6588	zmol_nh4 = pc_nh3(ib) / zhlp1
6589	!
6590	!-- Molality of Na+
6591	zmol_na = zmol_cl
6592	!
6593	!-- Molality of H+
6594	zmol_h = 2.0_wp * zmol_so4 + zmol_no3 + zmol_cl - ( zmol_nh4 + zmol_na )
6595
6596	ELSE
6597
6598	zhlp2 = pkelhno3(ib) * zmol_no3 * pachno3(ib)**2
6599
6600	IF ( zhlp2 > 1.0E-30_wp ) THEN
6601	zmol_h = k_gl_hno3 * pchno3eq(ib) / zhlp2 ! Eq. 17.38
6602	ELSE
6603	zmol_h = 0.0_wp
6604	ENDIF
6605
6606	ENDIF
6607
6608	zhlp1 = ppart(ib)%volc(8) * arhoh2o * argas * ptemp * k_gl_hno3
6609	!
6610	!-- Saturation ratio for NH3 and for HNO3
6611	IF ( zmol_h > 0.0_wp ) THEN
6612	zhlp2 = pkelnh3(ib) / ( zhlp1 * zmol_h )
6613	zhlp3 = k_ll_h2o / ( k_ll_nh3 + k_gl_nh3 )
6614	psatnh3(ib) = zhlp2 * ( ( pacnh4hso2(ib) / pachhso4(ib) )*2 ) zhlp3
6615	psathno3(ib) = ( pkelhno3(ib) * zmol_h * pachno3(ib)**2 ) / zhlp1
6616	ELSE
6617	psatnh3(ib) = 1.0_wp
6618	psathno3(ib) = 1.0_wp
6619	ENDIF
6620	ELSE
6621	psatnh3(ib) = 1.0_wp
6622	psathno3(ib) = 1.0_wp
6623	ENDIF
6624
6625	ENDDO
6626
6627	END SUBROUTINE nitrate_ammonium_saturation
6628
6629	!------------------------------------------------------------------------------!
6630	! Description:
6631	! ------------
6632	!> Prototype module for calculating the water content of a mixed inorganic/
6633	!> organic particle + equilibrium water vapour pressure above the solution
6634	!> (HNO3, HCL, NH3 and representative organic compounds. Efficient calculation
6635	!> of the partitioning of species between gas and aerosol. Based in a chamber
6636	!> study.
6637	!
6638	!> Written by Dave Topping. Pure organic component properties predicted by Mark
6639	!> Barley based on VOCs predicted in MCM simulations performed by Mike Jenkin.
6640	!> Delivered by Gordon McFiggans as Deliverable D22 from WP1.4 in the EU FP6
6641	!> EUCAARI Integrated Project.
6642	!
6643	!> REFERENCES
6644	!> Clegg et al. (1998) A Thermodynamic Model of the System H+-NH4+-Na+-SO42- -NO3--Cl--H2O at
6645	!> 298.15 K, J. Phys. Chem., 102A, 2155-2171.
6646	!> Clegg et al. (2001) Thermodynamic modelling of aqueous aerosols containing electrolytes and
6647	!> dissolved organic compounds. Journal of Aerosol Science 2001;32(6):713-738.
6648	!> Topping et al. (2005a) A curved multi-component aerosol hygroscopicity model framework: Part 1 -
6649	!> Inorganic compounds. Atmospheric Chemistry and Physics 2005;5:1205-1222.
6650	!> Topping et al. (2005b) A curved multi-component aerosol hygroscopicity model framework: Part 2 -
6651	!> Including organic compounds. Atmospheric Chemistry and Physics 2005;5:1223-1242.
6652	!> Wagman et al. (1982). The NBS tables of chemical thermodynamic properties: selected values for
6653	!> inorganic and Câ and Câ organic substances in SI units (book)
6654	!> Zaveri et al. (2005). A new method for multicomponent activity coefficients of electrolytes in
6655	!> aqueous atmospheric aerosols, JGR, 110, D02201, 2005.
6656	!
6657	!> Queries concerning the use of this code through Gordon McFiggans,
6658	!> g.mcfiggans@manchester.ac.uk,
6659	!> Ownership: D. Topping, Centre for Atmospheric Sciences, University of
6660	!> Manchester, 2007
6661	!
6662	!> Rewritten to PALM by Mona Kurppa, UHel, 2017
6663	!------------------------------------------------------------------------------!
6664	SUBROUTINE inorganic_pdfite( rh, temp, ions, water_total, press_hno3, press_hcl, press_nh3, &
6665	gamma_out, mols_out )
6666
6667	IMPLICIT NONE
6668
6669	INTEGER(iwp) :: binary_case
6670	INTEGER(iwp) :: full_complexity
6671
6672	REAL(wp) :: a !< auxiliary variable
6673	REAL(wp) :: act_product !< ionic activity coef. product:
6674	!< = (gamma_h2so43d0) / gamma_hhso42d0)
6675	REAL(wp) :: ammonium_chloride !<
6676	REAL(wp) :: ammonium_chloride_eq_frac !<
6677	REAL(wp) :: ammonium_nitrate !<
6678	REAL(wp) :: ammonium_nitrate_eq_frac !<
6679	REAL(wp) :: ammonium_sulphate !<
6680	REAL(wp) :: ammonium_sulphate_eq_frac !<
6681	REAL(wp) :: b !< auxiliary variable
6682	REAL(wp) :: binary_h2so4 !< binary H2SO4 activity coeff.
6683	REAL(wp) :: binary_hcl !< binary HCL activity coeff.
6684	REAL(wp) :: binary_hhso4 !< binary HHSO4 activity coeff.
6685	REAL(wp) :: binary_hno3 !< binary HNO3 activity coeff.
6686	REAL(wp) :: binary_nh4hso4 !< binary NH4HSO4 activity coeff.
6687	REAL(wp) :: c !< auxiliary variable
6688	REAL(wp) :: charge_sum !< sum of ionic charges
6689	REAL(wp) :: gamma_h2so4 !< activity coefficient
6690	REAL(wp) :: gamma_hcl !< activity coefficient
6691	REAL(wp) :: gamma_hhso4 !< activity coeffient
6692	REAL(wp) :: gamma_hno3 !< activity coefficient
6693	REAL(wp) :: gamma_nh3 !< activity coefficient
6694	REAL(wp) :: gamma_nh4hso4 !< activity coefficient
6695	REAL(wp) :: h_out !<
6696	REAL(wp) :: h_real !< new hydrogen ion conc.
6697	REAL(wp) :: h2so4_hcl !< contribution of H2SO4
6698	REAL(wp) :: h2so4_hno3 !< contribution of H2SO4
6699	REAL(wp) :: h2so4_nh3 !< contribution of H2SO4
6700	REAL(wp) :: h2so4_nh4hso4 !< contribution of H2SO4
6701	REAL(wp) :: hcl_h2so4 !< contribution of HCL
6702	REAL(wp) :: hcl_hhso4 !< contribution of HCL
6703	REAL(wp) :: hcl_hno3 !< contribution of HCL
6704	REAL(wp) :: hcl_nh4hso4 !< contribution of HCL
6705	REAL(wp) :: henrys_temp_dep !< temperature dependence of Henry's Law
6706	REAL(wp) :: hno3_h2so4 !< contribution of HNO3
6707	REAL(wp) :: hno3_hcl !< contribution of HNO3
6708	REAL(wp) :: hno3_hhso4 !< contribution of HNO3
6709	REAL(wp) :: hno3_nh3 !< contribution of HNO3
6710	REAL(wp) :: hno3_nh4hso4 !< contribution of HNO3
6711	REAL(wp) :: hso4_out !<
6712	REAL(wp) :: hso4_real !< new bisulphate ion conc.
6713	REAL(wp) :: hydrochloric_acid !<
6714	REAL(wp) :: hydrochloric_acid_eq_frac !<
6715	REAL(wp) :: k_h !< equilibrium constant for H+
6716	REAL(wp) :: k_hcl !< equilibrium constant of HCL
6717	REAL(wp) :: k_hno3 !< equilibrium constant of HNO3
6718	REAL(wp) :: k_nh4 !< equilibrium constant for NH4+
6719	REAL(wp) :: k_h2o !< equil. const. for water_surface
6720	REAL(wp) :: ln_h2so4_act !< gamma_h2so4 = EXP(ln_h2so4_act)
6721	REAL(wp) :: ln_HCL_act !< gamma_hcl = EXP( ln_HCL_act )
6722	REAL(wp) :: ln_hhso4_act !< gamma_hhso4 = EXP(ln_hhso4_act)
6723	REAL(wp) :: ln_hno3_act !< gamma_hno3 = EXP( ln_hno3_act )
6724	REAL(wp) :: ln_nh4hso4_act !< gamma_nh4hso4 = EXP( ln_nh4hso4_act )
6725	REAL(wp) :: molality_ratio_nh3 !< molality ratio of NH3 (NH4+ and H+)
6726	REAL(wp) :: na2so4_h2so4 !< contribution of Na2SO4
6727	REAL(wp) :: na2so4_hcl !< contribution of Na2SO4
6728	REAL(wp) :: na2so4_hhso4 !< contribution of Na2SO4
6729	REAL(wp) :: na2so4_hno3 !< contribution of Na2SO4
6730	REAL(wp) :: na2so4_nh3 !< contribution of Na2SO4
6731	REAL(wp) :: na2so4_nh4hso4 !< contribution of Na2SO4
6732	REAL(wp) :: nacl_h2so4 !< contribution of NaCl
6733	REAL(wp) :: nacl_hcl !< contribution of NaCl
6734	REAL(wp) :: nacl_hhso4 !< contribution of NaCl
6735	REAL(wp) :: nacl_hno3 !< contribution of NaCl
6736	REAL(wp) :: nacl_nh3 !< contribution of NaCl
6737	REAL(wp) :: nacl_nh4hso4 !< contribution of NaCl
6738	REAL(wp) :: nano3_h2so4 !< contribution of NaNO3
6739	REAL(wp) :: nano3_hcl !< contribution of NaNO3
6740	REAL(wp) :: nano3_hhso4 !< contribution of NaNO3
6741	REAL(wp) :: nano3_hno3 !< contribution of NaNO3
6742	REAL(wp) :: nano3_nh3 !< contribution of NaNO3
6743	REAL(wp) :: nano3_nh4hso4 !< contribution of NaNO3
6744	REAL(wp) :: nh42so4_h2so4 !< contribution of NH42SO4
6745	REAL(wp) :: nh42so4_hcl !< contribution of NH42SO4
6746	REAL(wp) :: nh42so4_hhso4 !< contribution of NH42SO4
6747	REAL(wp) :: nh42so4_hno3 !< contribution of NH42SO4
6748	REAL(wp) :: nh42so4_nh3 !< contribution of NH42SO4
6749	REAL(wp) :: nh42so4_nh4hso4 !< contribution of NH42SO4
6750	REAL(wp) :: nh4cl_h2so4 !< contribution of NH4Cl
6751	REAL(wp) :: nh4cl_hcl !< contribution of NH4Cl
6752	REAL(wp) :: nh4cl_hhso4 !< contribution of NH4Cl
6753	REAL(wp) :: nh4cl_hno3 !< contribution of NH4Cl
6754	REAL(wp) :: nh4cl_nh3 !< contribution of NH4Cl
6755	REAL(wp) :: nh4cl_nh4hso4 !< contribution of NH4Cl
6756	REAL(wp) :: nh4no3_h2so4 !< contribution of NH4NO3
6757	REAL(wp) :: nh4no3_hcl !< contribution of NH4NO3
6758	REAL(wp) :: nh4no3_hhso4 !< contribution of NH4NO3
6759	REAL(wp) :: nh4no3_hno3 !< contribution of NH4NO3
6760	REAL(wp) :: nh4no3_nh3 !< contribution of NH4NO3
6761	REAL(wp) :: nh4no3_nh4hso4 !< contribution of NH4NO3
6762	REAL(wp) :: nitric_acid !<
6763	REAL(wp) :: nitric_acid_eq_frac !< Equivalent fractions
6764	REAL(wp) :: press_hcl !< partial pressure of HCL
6765	REAL(wp) :: press_hno3 !< partial pressure of HNO3
6766	REAL(wp) :: press_nh3 !< partial pressure of NH3
6767	REAL(wp) :: rh !< relative humidity [0-1]
6768	REAL(wp) :: root1 !< auxiliary variable
6769	REAL(wp) :: root2 !< auxiliary variable
6770	REAL(wp) :: so4_out !<
6771	REAL(wp) :: so4_real !< new sulpate ion concentration
6772	REAL(wp) :: sodium_chloride !<
6773	REAL(wp) :: sodium_chloride_eq_frac !<
6774	REAL(wp) :: sodium_nitrate !<
6775	REAL(wp) :: sodium_nitrate_eq_frac !<
6776	REAL(wp) :: sodium_sulphate !<
6777	REAL(wp) :: sodium_sulphate_eq_frac !<
6778	REAL(wp) :: solutes !<
6779	REAL(wp) :: sulphuric_acid !<
6780	REAL(wp) :: sulphuric_acid_eq_frac !<
6781	REAL(wp) :: temp !< temperature
6782	REAL(wp) :: water_total !<
6783
6784	REAL(wp), DIMENSION(:) :: gamma_out !< Activity coefficient for calculating the non-ideal
6785	!< dissociation constants
6786	!< 1: HNO3, 2: HCL, 3: NH4+/H+ (NH3), 4: HHSO4**2/H2SO4,
6787	!< 5: H2SO43/HHSO42, 6: NH4HSO2, 7: HHSO4
6788	REAL(wp), DIMENSION(:) :: ions !< ion molarities (mol/m3): 1: H+, 2: NH4+, 3: Na+,
6789	!< 4: SO4(2-), 5: HSO4-, 6: NO3-, 7: Cl-
6790	REAL(wp), DIMENSION(7) :: ions_mol !< ion molalities (mol/kg): 1: H+, 2: NH4+, 3: Na+,
6791	!< 4: SO4(2-), 5: HSO4-, 6: NO3-, 7: Cl-
6792	REAL(wp), DIMENSION(:) :: mols_out !< ion molality output (mol/kg): 1: H+, 2: NH4+, 3: Na+,
6793	!< 4: SO4(2-), 5: HSO4-, 6: NO3-, 7: Cl-
6794	!
6795	!-- Value initialisation
6796	binary_h2so4 = 0.0_wp
6797	binary_hcl = 0.0_wp
6798	binary_hhso4 = 0.0_wp
6799	binary_hno3 = 0.0_wp
6800	binary_nh4hso4 = 0.0_wp
6801	henrys_temp_dep = ( 1.0_wp / temp - 0.0033557_wp ) ! 1/T - 1/298 K
6802	hcl_hno3 = 1.0_wp
6803	h2so4_hno3 = 1.0_wp
6804	nh42so4_hno3 = 1.0_wp
6805	nh4no3_hno3 = 1.0_wp
6806	nh4cl_hno3 = 1.0_wp
6807	na2so4_hno3 = 1.0_wp
6808	nano3_hno3 = 1.0_wp
6809	nacl_hno3 = 1.0_wp
6810	hno3_hcl = 1.0_wp
6811	h2so4_hcl = 1.0_wp
6812	nh42so4_hcl = 1.0_wp
6813	nh4no3_hcl = 1.0_wp
6814	nh4cl_hcl = 1.0_wp
6815	na2so4_hcl = 1.0_wp
6816	nano3_hcl = 1.0_wp
6817	nacl_hcl = 1.0_wp
6818	hno3_nh3 = 1.0_wp
6819	h2so4_nh3 = 1.0_wp
6820	nh42so4_nh3 = 1.0_wp
6821	nh4no3_nh3 = 1.0_wp
6822	nh4cl_nh3 = 1.0_wp
6823	na2so4_nh3 = 1.0_wp
6824	nano3_nh3 = 1.0_wp
6825	nacl_nh3 = 1.0_wp
6826	hno3_hhso4 = 1.0_wp
6827	hcl_hhso4 = 1.0_wp
6828	nh42so4_hhso4 = 1.0_wp
6829	nh4no3_hhso4 = 1.0_wp
6830	nh4cl_hhso4 = 1.0_wp
6831	na2so4_hhso4 = 1.0_wp
6832	nano3_hhso4 = 1.0_wp
6833	nacl_hhso4 = 1.0_wp
6834	hno3_h2so4 = 1.0_wp
6835	hcl_h2so4 = 1.0_wp
6836	nh42so4_h2so4 = 1.0_wp
6837	nh4no3_h2so4 = 1.0_wp
6838	nh4cl_h2so4 = 1.0_wp
6839	na2so4_h2so4 = 1.0_wp
6840	nano3_h2so4 = 1.0_wp
6841	nacl_h2so4 = 1.0_wp
6842	!
6843	!-- New NH3 variables
6844	hno3_nh4hso4 = 1.0_wp
6845	hcl_nh4hso4 = 1.0_wp
6846	h2so4_nh4hso4 = 1.0_wp
6847	nh42so4_nh4hso4 = 1.0_wp
6848	nh4no3_nh4hso4 = 1.0_wp
6849	nh4cl_nh4hso4 = 1.0_wp
6850	na2so4_nh4hso4 = 1.0_wp
6851	nano3_nh4hso4 = 1.0_wp
6852	nacl_nh4hso4 = 1.0_wp
6853	!
6854	!-- Juha Tonttila added
6855	mols_out = 0.0_wp
6856	press_hno3 = 0.0_wp !< Initialising vapour pressures over the
6857	press_hcl = 0.0_wp !< multicomponent particle
6858	press_nh3 = 0.0_wp
6859	gamma_out = 1.0_wp !< i.e. don't alter the ideal mixing ratios if there's nothing there.
6860	!
6861	!-- 1) - COMPOSITION DEFINITIONS
6862	!
6863	!-- a) Inorganic ion pairing:
6864	!-- In order to calculate the water content, which is also used in calculating vapour pressures, one
6865	!-- needs to pair the anions and cations for use in the ZSR mixing rule. The equation provided by
6866	!-- Clegg et al. (2001) is used for ion pairing. The solutes chosen comprise of 9 inorganic salts
6867	!-- and acids which provide a pairing between each anion and cation: (NH4)2SO4, NH4NO3, NH4Cl,
6868	!-- Na2SO4, NaNO3, NaCl, H2SO4, HNO3, HCL. The organic compound is treated as a seperate solute.
6869	!-- Ions: 1: H+, 2: NH4+, 3: Na+, 4: SO4(2-), 5: HSO4-, 6: NO3-, 7: Cl-
6870	!
6871	charge_sum = ions(1) + ions(2) + ions(3) + 2.0_wp * ions(4) + ions(5) + ions(6) + ions(7)
6872	nitric_acid = ( 2.0_wp * ions(1) * ions(6) ) / charge_sum
6873	hydrochloric_acid = ( 2.0_wp * ions(1) * ions(7) ) / charge_sum
6874	sulphuric_acid = ( 2.0_wp * ions(1) * ions(4) ) / charge_sum
6875	ammonium_sulphate = ( 2.0_wp * ions(2) * ions(4) ) / charge_sum
6876	ammonium_nitrate = ( 2.0_wp * ions(2) * ions(6) ) / charge_sum
6877	ammonium_chloride = ( 2.0_wp * ions(2) * ions(7) ) / charge_sum
6878	sodium_sulphate = ( 2.0_wp * ions(3) * ions(4) ) / charge_sum
6879	sodium_nitrate = ( 2.0_wp * ions(3) * ions(6) ) / charge_sum
6880	sodium_chloride = ( 2.0_wp * ions(3) * ions(7) ) / charge_sum
6881	solutes = 0.0_wp
6882	solutes = 3.0_wp * sulphuric_acid + 2.0_wp * hydrochloric_acid + 2.0_wp * nitric_acid + &
6883	3.0_wp * ammonium_sulphate + 2.0_wp * ammonium_nitrate + 2.0_wp * ammonium_chloride +&
6884	3.0_wp * sodium_sulphate + 2.0_wp * sodium_nitrate + 2.0_wp * sodium_chloride
6885	!
6886	!-- b) Inorganic equivalent fractions:
6887	!-- These values are calculated so that activity coefficients can be expressed by a linear additive
6888	!-- rule, thus allowing more efficient calculations and future expansion (see more detailed
6889	!-- description below)
6890	nitric_acid_eq_frac = 2.0_wp * nitric_acid / solutes
6891	hydrochloric_acid_eq_frac = 2.0_wp * hydrochloric_acid / solutes
6892	sulphuric_acid_eq_frac = 3.0_wp * sulphuric_acid / solutes
6893	ammonium_sulphate_eq_frac = 3.0_wp * ammonium_sulphate / solutes
6894	ammonium_nitrate_eq_frac = 2.0_wp * ammonium_nitrate / solutes
6895	ammonium_chloride_eq_frac = 2.0_wp * ammonium_chloride / solutes
6896	sodium_sulphate_eq_frac = 3.0_wp * sodium_sulphate / solutes
6897	sodium_nitrate_eq_frac = 2.0_wp * sodium_nitrate / solutes
6898	sodium_chloride_eq_frac = 2.0_wp * sodium_chloride / solutes
6899	!
6900	!-- Inorganic ion molalities
6901	ions_mol(1) = ions(1) / ( water_total * 18.01528E-3_wp ) ! H+
6902	ions_mol(2) = ions(2) / ( water_total * 18.01528E-3_wp ) ! NH4+
6903	ions_mol(3) = ions(3) / ( water_total * 18.01528E-3_wp ) ! Na+
6904	ions_mol(4) = ions(4) / ( water_total * 18.01528E-3_wp ) ! SO4(2-)
6905	ions_mol(5) = ions(5) / ( water_total * 18.01528E-3_wp ) ! HSO4(2-)
6906	ions_mol(6) = ions(6) / ( water_total * 18.01528E-3_wp ) ! NO3-
6907	ions_mol(7) = ions(7) / ( water_total * 18.01528E-3_wp ) ! Cl-
6908
6909	!-- ***
6910	!-- At this point we may need to introduce a method for prescribing H+ when there is no 'real' value
6911	!-- for H+..i.e. in the sulphate poor domain. This will give a value for solve quadratic proposed by
6912	!-- Zaveri et al. 2005
6913	!
6914	!-- 2) - WATER CALCULATION
6915	!
6916	!-- a) The water content is calculated using the ZSR rule with solute concentrations calculated
6917	!-- using 1a above. Whilst the usual approximation of ZSR relies on binary data consisting of 5th or
6918	!-- higher order polynomials, in this code 4 different RH regimes are used, each housing cubic
6919	!-- equations for the water associated with each solute listed above. Binary water contents for
6920	!-- inorganic components were calculated using AIM online (Clegg et al 1998). The water associated
6921	!-- with the organic compound is calculated assuming ideality and that aw = RH.
6922	!
6923	!-- b) Molality of each inorganic ion and organic solute (initial input) is calculated for use in
6924	!-- vapour pressure calculation.
6925	!
6926	!-- 3) - BISULPHATE ION DISSOCIATION CALCULATION
6927	!
6928	!-- The dissociation of the bisulphate ion is calculated explicitly. A solution to the equilibrium
6929	!-- equation between the bisulphate ion, hydrogen ion and sulphate ion is found using tabulated
6930	!-- equilibrium constants (referenced). It is necessary to calculate the activity coefficients of
6931	!-- HHSO4 and H2SO4 in a non-iterative manner. These are calculated using the same format as
6932	!-- described in 4) below, where both activity coefficients were fit to the output from ADDEM
6933	!-- (Topping et al 2005a,b) covering an extensive composition space, providing the activity
6934	!-- coefficients and bisulphate ion dissociation as a function of equivalent mole fractions and
6935	!-- relative humidity.
6936	!
6937	!-- NOTE: the flags "binary_case" and "full_complexity" are not used in this prototype. They are
6938	!-- used for simplification of the fit expressions when using limited composition regions. This
6939	!-- section of code calculates the bisulphate ion concentration.
6940	!
6941	IF ( ions(1) > 0.0_wp .AND. ions(4) > 0.0_wp ) THEN
6942	!
6943	!-- HHSO4:
6944	binary_case = 1
6945	IF ( rh > 0.1_wp .AND. rh < 0.9_wp ) THEN
6946	binary_hhso4 = -4.9521_wp * rh*3 + 9.2881_wp rh*2 - 10.777_wp rh + 6.0534_wp
6947	ELSEIF ( rh >= 0.9_wp .AND. rh < 0.955_wp ) THEN
6948	binary_hhso4 = -6.3777_wp * rh + 5.962_wp
6949	ELSEIF ( rh >= 0.955_wp .AND. rh < 0.99_wp ) THEN
6950	binary_hhso4 = 2367.2_wp * rh*3 - 6849.7_wp rh*2 + 6600.9_wp rh - 2118.7_wp
6951	ELSEIF ( rh >= 0.99_wp .AND. rh < 0.9999_wp ) THEN
6952	binary_hhso4 = 3E-7_wp * rh*5 - 2E-5_wp rh*4 + 0.0004_wp rh*3 - 0.0035_wp rh**2 &
6953	+ 0.0123_wp * rh - 0.3025_wp
6954	ENDIF
6955
6956	IF ( nitric_acid > 0.0_wp ) THEN
6957	hno3_hhso4 = -4.2204_wp * rh*4 + 12.193_wp rh*3 - 12.481_wp rh*2 + 6.459_wp rh &
6958	- 1.9004_wp
6959	ENDIF
6960
6961	IF ( hydrochloric_acid > 0.0_wp ) THEN
6962	hcl_hhso4 = -54.845_wp * rh*7 + 209.54_wp rh*6 - 336.59_wp rh*5 + 294.21_wp &
6963	rh*4 - 150.07_wp rh*3 + 43.767_wp rh*2 - 6.5495_wp rh + 0.60048_wp
6964	ENDIF
6965
6966	IF ( ammonium_sulphate > 0.0_wp ) THEN
6967	nh42so4_hhso4 = 16.768_wp * rh*3 - 28.75_wp rh*2 + 20.011_wp rh - 8.3206_wp
6968	ENDIF
6969
6970	IF ( ammonium_nitrate > 0.0_wp ) THEN
6971	nh4no3_hhso4 = -17.184_wp * rh*4 + 56.834_wp rh*3 - 65.765_wp rh**2 + &
6972	35.321_wp * rh - 9.252_wp
6973	ENDIF
6974
6975	IF (ammonium_chloride > 0.0_wp ) THEN
6976	IF ( rh < 0.2_wp .AND. rh >= 0.1_wp ) THEN
6977	nh4cl_hhso4 = 3.2809_wp * rh - 2.0637_wp
6978	ELSEIF ( rh >= 0.2_wp .AND. rh < 0.99_wp ) THEN
6979	nh4cl_hhso4 = -1.2981_wp * rh*3 + 4.7461_wp rh*2 - 2.3269_wp rh - 1.1259_wp
6980	ENDIF
6981	ENDIF
6982
6983	IF ( sodium_sulphate > 0.0_wp ) THEN
6984	na2so4_hhso4 = 118.87_wp * rh*6 - 358.63_wp rh*5 + 435.85_wp rh*4 - 272.88_wp &
6985	rh*3 + 94.411_wp rh*2 - 18.21_wp rh + 0.45935_wp
6986	ENDIF
6987
6988	IF ( sodium_nitrate > 0.0_wp ) THEN
6989	IF ( rh < 0.2_wp .AND. rh >= 0.1_wp ) THEN
6990	nano3_hhso4 = 4.8456_wp * rh - 2.5773_wp
6991	ELSEIF ( rh >= 0.2_wp .AND. rh < 0.99_wp ) THEN
6992	nano3_hhso4 = 0.5964_wp * rh*3 - 0.38967_wp rh*2 + 1.7918_wp rh - 1.9691_wp
6993	ENDIF
6994	ENDIF
6995
6996	IF ( sodium_chloride > 0.0_wp ) THEN
6997	IF ( rh < 0.2_wp ) THEN
6998	nacl_hhso4 = 0.51995_wp * rh - 1.3981_wp
6999	ELSEIF ( rh >= 0.2_wp .AND. rh < 0.99_wp ) THEN
7000	nacl_hhso4 = 1.6539_wp * rh - 1.6101_wp
7001	ENDIF
7002	ENDIF
7003
7004	ln_hhso4_act = binary_hhso4 + nitric_acid_eq_frac * hno3_hhso4 + &
7005	hydrochloric_acid_eq_frac * hcl_hhso4 + &
7006	ammonium_sulphate_eq_frac * nh42so4_hhso4 + &
7007	ammonium_nitrate_eq_frac * nh4no3_hhso4 + &
7008	ammonium_chloride_eq_frac * nh4cl_hhso4 + &
7009	sodium_sulphate_eq_frac * na2so4_hhso4 + &
7010	sodium_nitrate_eq_frac * nano3_hhso4 + sodium_chloride_eq_frac * nacl_hhso4
7011
7012	gamma_hhso4 = EXP( ln_hhso4_act ) ! molal activity coefficient of HHSO4
7013
7014	!-- H2SO4 (sulphuric acid):
7015	IF ( rh >= 0.1_wp .AND. rh < 0.9_wp ) THEN
7016	binary_h2so4 = 2.4493_wp * rh*2 - 6.2326_wp rh + 2.1763_wp
7017	ELSEIF ( rh >= 0.9_wp .AND. rh < 0.98 ) THEN
7018	binary_h2so4 = 914.68_wp * rh*3 - 2502.3_wp rh*2 + 2281.9_wp rh - 695.11_wp
7019	ELSEIF ( rh >= 0.98 .AND. rh < 0.9999 ) THEN
7020	binary_h2so4 = 3.0E-8_wp * rh*4 - 5E-6_wp rh*3 + 0.0003_wp rh*2 - 0.0022_wp &
7021	rh - 1.1305_wp
7022	ENDIF
7023
7024	IF ( nitric_acid > 0.0_wp ) THEN
7025	hno3_h2so4 = - 16.382_wp * rh*5 + 46.677_wp rh*4 - 54.149_wp rh*3 + 34.36_wp &
7026	rh*2 - 12.54_wp rh + 2.1368_wp
7027	ENDIF
7028
7029	IF ( hydrochloric_acid > 0.0_wp ) THEN
7030	hcl_h2so4 = - 14.409_wp * rh*5 + 42.804_wp rh*4 - 47.24_wp rh*3 + 24.668_wp &
7031	rh*2 - 5.8015_wp rh + 0.084627_wp
7032	ENDIF
7033
7034	IF ( ammonium_sulphate > 0.0_wp ) THEN
7035	nh42so4_h2so4 = 66.71_wp * rh*5 - 187.5_wp rh*4 + 210.57_wp rh*3 - 121.04_wp &
7036	rh*2 + 39.182_wp rh - 8.0606_wp
7037	ENDIF
7038
7039	IF ( ammonium_nitrate > 0.0_wp ) THEN
7040	nh4no3_h2so4 = - 22.532_wp * rh*4 + 66.615_wp rh*3 - 74.647_wp rh*2 + 37.638_wp &
7041	rh - 6.9711_wp
7042	ENDIF
7043
7044	IF ( ammonium_chloride > 0.0_wp ) THEN
7045	IF ( rh >= 0.1_wp .AND. rh < 0.2_wp ) THEN
7046	nh4cl_h2so4 = - 0.32089_wp * rh + 0.57738_wp
7047	ELSEIF ( rh >= 0.2_wp .AND. rh < 0.9_wp ) THEN
7048	nh4cl_h2so4 = 18.089_wp * rh*5 - 51.083_wp rh*4 + 50.32_wp rh*3 - 17.012_wp &
7049	rh*2 - 0.93435_wp rh + 1.0548_wp
7050	ELSEIF ( rh >= 0.9_wp .AND. rh < 0.99_wp ) THEN
7051	nh4cl_h2so4 = - 1.5749_wp * rh + 1.7002_wp
7052	ENDIF
7053	ENDIF
7054
7055	IF ( sodium_sulphate > 0.0_wp ) THEN
7056	na2so4_h2so4 = 29.843_wp * rh*4 - 69.417_wp rh*3 + 61.507_wp rh*2 - 29.874_wp &
7057	rh + 7.7556_wp
7058	ENDIF
7059
7060	IF ( sodium_nitrate > 0.0_wp ) THEN
7061	nano3_h2so4 = - 122.37_wp * rh*6 + 427.43_wp rh*5 - 604.68_wp rh*4 + 443.08_wp &
7062	rh*3 - 178.61_wp rh*2 + 37.242_wp rh - 1.9564_wp
7063	ENDIF
7064
7065	IF ( sodium_chloride > 0.0_wp ) THEN
7066	nacl_h2so4 = - 40.288_wp * rh*5 + 115.61_wp rh*4 - 129.99_wp rh*3 + 72.652_wp &
7067	rh*2 - 22.124_wp rh + 4.2676_wp
7068	ENDIF
7069
7070	ln_h2so4_act = binary_h2so4 + nitric_acid_eq_frac * hno3_h2so4 + &
7071	hydrochloric_acid_eq_frac * hcl_h2so4 + &
7072	ammonium_sulphate_eq_frac * nh42so4_h2so4 + &
7073	ammonium_nitrate_eq_frac * nh4no3_h2so4 + &
7074	ammonium_chloride_eq_frac * nh4cl_h2so4 + &
7075	sodium_sulphate_eq_frac * na2so4_h2so4 + &
7076	sodium_nitrate_eq_frac * nano3_h2so4 + sodium_chloride_eq_frac * nacl_h2so4
7077
7078	gamma_h2so4 = EXP( ln_h2so4_act ) ! molal activity coefficient
7079	!
7080	!-- Export activity coefficients
7081	IF ( gamma_h2so4 > 1.0E-10_wp ) THEN
7082	gamma_out(4) = gamma_hhso4**2 / gamma_h2so4
7083	ENDIF
7084	IF ( gamma_hhso4 > 1.0E-10_wp ) THEN
7085	gamma_out(5) = gamma_h2so43 / gamma_hhso42
7086	ENDIF
7087	!
7088	!-- Ionic activity coefficient product
7089	act_product = gamma_h2so43 / gamma_hhso42
7090	!
7091	!-- Solve the quadratic equation (i.e. x in ax**2 + bx + c = 0)
7092	a = 1.0_wp
7093	b = -1.0_wp * ( ions(4) + ions(1) + ( ( water_total * 18.0E-3_wp ) / &
7094	( 99.0_wp * act_product ) ) )
7095	c = ions(4) * ions(1)
7096	root1 = ( ( -1.0_wp * b ) + ( ( ( b*2 ) - 4.0_wp a * c )*0.5_wp ) ) / ( 2.0_wp a )
7097	root2 = ( ( -1.0_wp * b ) - ( ( ( b*2 ) - 4.0_wp a * c) *0.5_wp ) ) / ( 2.0_wp a )
7098
7099	IF ( root1 > ions(1) .OR. root1 < 0.0_wp ) THEN
7100	root1 = 0.0_wp
7101	ENDIF
7102
7103	IF ( root2 > ions(1) .OR. root2 < 0.0_wp ) THEN
7104	root2 = 0.0_wp
7105	ENDIF
7106	!
7107	!-- Calculate the new hydrogen ion, bisulphate ion and sulphate ion
7108	!-- concentration
7109	h_real = ions(1)
7110	so4_real = ions(4)
7111	hso4_real = MAX( root1, root2 )
7112	h_real = ions(1) - hso4_real
7113	so4_real = ions(4) - hso4_real
7114	!
7115	!-- Recalculate ion molalities
7116	ions_mol(1) = h_real / ( water_total * 18.01528E-3_wp ) ! H+
7117	ions_mol(4) = so4_real / ( water_total * 18.01528E-3_wp ) ! SO4(2-)
7118	ions_mol(5) = hso4_real / ( water_total * 18.01528E-3_wp ) ! HSO4(2-)
7119
7120	h_out = h_real
7121	hso4_out = hso4_real
7122	so4_out = so4_real
7123
7124	ELSE
7125	h_out = ions(1)
7126	hso4_out = 0.0_wp
7127	so4_out = ions(4)
7128	ENDIF
7129
7130	!
7131	!-- 4) ACTIVITY COEFFICIENTS -for vapour pressures of HNO3,HCL and NH3
7132	!
7133	!-- This section evaluates activity coefficients and vapour pressures using the water content
7134	!-- calculated above) for each inorganic condensing species: a - HNO3, b - NH3, c - HCL.
7135	!-- The following procedure is used: Zaveri et al (2005) found that one could express the variation
7136	!-- of activity coefficients linearly in log-space if equivalent mole fractions were used.
7137	!-- So, by a taylor series expansion LOG( activity coefficient ) =
7138	!-- LOG( binary activity coefficient at a given RH ) +
7139	!-- (equivalent mole fraction compound A) *
7140	!-- ('interaction' parameter between A and condensing species) +
7141	!-- equivalent mole fraction compound B) *
7142	!-- ('interaction' parameter between B and condensing species).
7143	!-- Here, the interaction parameters have been fit to ADDEM by searching the whole compositon space
7144	!-- and fit usign the Levenberg-Marquardt non-linear least squares algorithm.
7145	!
7146	!-- They are given as a function of RH and vary with complexity ranging from linear to 5th order
7147	!-- polynomial expressions, the binary activity coefficients were calculated using AIM online.
7148	!-- NOTE: for NH3, no binary activity coefficient was used and the data were fit to the ratio of the
7149	!-- activity coefficients for the ammonium and hydrogen ions. Once the activity coefficients are
7150	!-- obtained the vapour pressure can be easily calculated using tabulated equilibrium constants
7151	!-- (referenced). This procedure differs from that of Zaveri et al (2005) in that it is not assumed
7152	!-- one can carry behaviour from binary mixtures in multicomponent systems. To this end we have fit
7153	!-- the 'interaction' parameters explicitly to a general inorganic equilibrium model
7154	!-- (ADDEM - Topping et al. 2005a,b). Such parameters take into account bisulphate ion dissociation
7155	!-- and water content. This also allows us to consider one regime for all composition space, rather
7156	!-- than defining sulphate rich and sulphate poor regimes.
7157	!-- NOTE: The flags "binary_case" and "full_complexity" are not used in this prototype. They are
7158	!-- used for simplification of the fit expressions when using limited composition regions.
7159	!
7160	!-- a) - ACTIVITY COEFF/VAPOUR PRESSURE - HNO3
7161	IF ( ions(1) > 0.0_wp .AND. ions(6) > 0.0_wp ) THEN
7162	binary_case = 1
7163	IF ( rh > 0.1_wp .AND. rh < 0.98_wp ) THEN
7164	IF ( binary_case == 1 ) THEN
7165	binary_hno3 = 1.8514_wp * rh*3 - 4.6991_wp rh*2 + 1.5514_wp rh + 0.90236_wp
7166	ELSEIF ( binary_case == 2 ) THEN
7167	binary_hno3 = - 1.1751_wp * ( rh*2 ) - 0.53794_wp rh + 1.2808_wp
7168	ENDIF
7169	ELSEIF ( rh >= 0.98_wp .AND. rh < 0.9999_wp ) THEN
7170	binary_hno3 = 1244.69635941351_wp * rh*3 - 2613.93941099991_wp rh**2 + &
7171	1525.0684974546_wp * rh -155.946764059316_wp
7172	ENDIF
7173	!
7174	!-- Contributions from other solutes
7175	full_complexity = 1
7176	IF ( hydrochloric_acid > 0.0_wp ) THEN ! HCL
7177	IF ( full_complexity == 1 .OR. rh < 0.4_wp ) THEN
7178	hcl_hno3 = 16.051_wp * rh*4 - 44.357_wp rh*3 + 45.141_wp rh*2 - 21.638_wp &
7179	rh + 4.8182_wp
7180	ELSEIF ( full_complexity == 0 .AND. rh > 0.4_wp ) THEN
7181	hcl_hno3 = - 1.5833_wp * rh + 1.5569_wp
7182	ENDIF
7183	ENDIF
7184
7185	IF ( sulphuric_acid > 0.0_wp ) THEN ! H2SO4
7186	IF ( full_complexity == 1 .OR. rh < 0.4_wp ) THEN
7187	h2so4_hno3 = - 3.0849_wp * rh*3 + 5.9609_wp rh*2 - 4.468_wp rh + 1.5658_wp
7188	ELSEIF ( full_complexity == 0 .AND. rh > 0.4_wp ) THEN
7189	h2so4_hno3 = - 0.93473_wp * rh + 0.9363_wp
7190	ENDIF
7191	ENDIF
7192
7193	IF ( ammonium_sulphate > 0.0_wp ) THEN ! NH42SO4
7194	nh42so4_hno3 = 16.821_wp * rh*3 - 28.391_wp rh*2 + 18.133_wp rh - 6.7356_wp
7195	ENDIF
7196
7197	IF ( ammonium_nitrate > 0.0_wp ) THEN ! NH4NO3
7198	nh4no3_hno3 = 11.01_wp * rh*3 - 21.578_wp rh*2 + 14.808_wp rh - 4.2593_wp
7199	ENDIF
7200
7201	IF ( ammonium_chloride > 0.0_wp ) THEN ! NH4Cl
7202	IF ( full_complexity == 1 .OR. rh <= 0.4_wp ) THEN
7203	nh4cl_hno3 = - 1.176_wp * rh*3 + 5.0828_wp rh*2 - 3.8792_wp rh - 0.05518_wp
7204	ELSEIF ( full_complexity == 0 .AND. rh > 0.4_wp ) THEN
7205	nh4cl_hno3 = 2.6219_wp * rh*2 - 2.2609_wp rh - 0.38436_wp
7206	ENDIF
7207	ENDIF
7208
7209	IF ( sodium_sulphate > 0.0_wp ) THEN ! Na2SO4
7210	na2so4_hno3 = 35.504_wp * rh*4 - 80.101_wp rh*3 + 67.326_wp rh*2 - 28.461_wp &
7211	rh + 5.6016_wp
7212	ENDIF
7213
7214	IF ( sodium_nitrate > 0.0_wp ) THEN ! NaNO3
7215	IF ( full_complexity == 1 .OR. rh <= 0.4_wp ) THEN
7216	nano3_hno3 = 23.659_wp * rh*5 - 66.917_wp rh*4 + 74.686_wp rh*3 - 40.795_wp &
7217	rh*2 + 10.831_wp rh - 1.4701_wp
7218	ELSEIF ( full_complexity == 0 .AND. rh > 0.4_wp ) THEN
7219	nano3_hno3 = 14.749_wp * rh*4 - 35.237_wp rh*3 + 31.196_wp rh*2 - 12.076_wp &
7220	rh + 1.3605_wp
7221	ENDIF
7222	ENDIF
7223
7224	IF ( sodium_chloride > 0.0_wp ) THEN ! NaCl
7225	IF ( full_complexity == 1 .OR. rh <= 0.4_wp ) THEN
7226	nacl_hno3 = 13.682_wp * rh*4 - 35.122_wp rh*3 + 33.397_wp rh*2 - 14.586_wp &
7227	rh + 2.6276_wp
7228	ELSEIF ( full_complexity == 0 .AND. rh > 0.4_wp ) THEN
7229	nacl_hno3 = 1.1882_wp * rh*3 - 1.1037_wp rh*2 - 0.7642_wp rh + 0.6671_wp
7230	ENDIF
7231	ENDIF
7232
7233	ln_hno3_act = binary_hno3 + hydrochloric_acid_eq_frac * hcl_hno3 + &
7234	sulphuric_acid_eq_frac * h2so4_hno3 + &
7235	ammonium_sulphate_eq_frac * nh42so4_hno3 + &
7236	ammonium_nitrate_eq_frac * nh4no3_hno3 + &
7237	ammonium_chloride_eq_frac * nh4cl_hno3 + &
7238	sodium_sulphate_eq_frac * na2so4_hno3 + &
7239	sodium_nitrate_eq_frac * nano3_hno3 + sodium_chloride_eq_frac * nacl_hno3
7240
7241	gamma_hno3 = EXP( ln_hno3_act ) ! Molal activity coefficient of HNO3
7242	gamma_out(1) = gamma_hno3
7243	!
7244	!-- Partial pressure calculation
7245	!-- k_hno3 = 2.51 * ( 10**6 )
7246	!-- k_hno3 = 2.628145923d6 !< calculated by AIM online (Clegg et al 1998) after Chameides (1984)
7247	k_hno3 = 2.6E6_wp * EXP( 8700.0_wp * henrys_temp_dep )
7248	press_hno3 = ( ions_mol(1) * ions_mol(6) * ( gamma_hno3**2 ) ) / k_hno3
7249	ENDIF
7250	!
7251	!-- b) - ACTIVITY COEFF/VAPOUR PRESSURE - NH3
7252	!-- Follow the two solute approach of Zaveri et al. (2005)
7253	IF ( ions(2) > 0.0_wp .AND. ions_mol(1) > 0.0_wp ) THEN
7254	!
7255	!-- NH4HSO4:
7256	binary_nh4hso4 = 56.907_wp * rh*6 - 155.32_wp rh*5 + 142.94_wp rh*4 - 32.298_wp &
7257	rh*3 - 27.936_wp rh*2 + 19.502_wp rh - 4.2618_wp
7258	IF ( nitric_acid > 0.0_wp) THEN ! HNO3
7259	hno3_nh4hso4 = 104.8369_wp * rh*8 - 288.8923_wp rh*7 + 129.3445_wp rh**6 + &
7260	373.0471_wp * rh*5 - 571.0385_wp rh*4 + 326.3528_wp rh**3 - &
7261	74.169_wp * rh*2 - 2.4999_wp rh + 3.17_wp
7262	ENDIF
7263
7264	IF ( hydrochloric_acid > 0.0_wp) THEN ! HCL
7265	hcl_nh4hso4 = - 7.9133_wp * rh*8 + 126.6648_wp rh*7 - 460.7425_wp rh**6 + &
7266	731.606_wp * rh*5 - 582.7467_wp rh*4 + 216.7197_wp rh**3 - &
7267	11.3934_wp * rh*2 - 17.7728_wp rh + 5.75_wp
7268	ENDIF
7269
7270	IF ( sulphuric_acid > 0.0_wp) THEN ! H2SO4
7271	h2so4_nh4hso4 = 195.981_wp * rh*8 - 779.2067_wp rh*7 + 1226.3647_wp rh**6 - &
7272	964.0261_wp * rh*5 + 391.7911_wp rh*4 - 84.1409_wp rh**3 + &
7273	20.0602_wp * rh*2 - 10.2663_wp rh + 3.5817_wp
7274	ENDIF
7275
7276	IF ( ammonium_sulphate > 0.0_wp) THEN ! NH42SO4
7277	nh42so4_nh4hso4 = 617.777_wp * rh*8 - 2547.427_wp rh*7 + 4361.6009_wp rh**6 - &
7278	4003.162_wp * rh*5 + 2117.8281_wp rh*4 - 640.0678_wp rh**3 + &
7279	98.0902_wp * rh*2 - 2.2615_wp rh - 2.3811_wp
7280	ENDIF
7281
7282	IF ( ammonium_nitrate > 0.0_wp) THEN ! NH4NO3
7283	nh4no3_nh4hso4 = - 104.4504_wp * rh*8 + 539.5921_wp rh*7 - 1157.0498_wp rh**6 + &
7284	1322.4507_wp * rh*5 - 852.2475_wp rh*4 + 298.3734_wp rh**3 - &
7285	47.0309_wp * rh*2 + 1.297_wp rh - 0.8029_wp
7286	ENDIF
7287
7288	IF ( ammonium_chloride > 0.0_wp) THEN ! NH4Cl
7289	nh4cl_nh4hso4 = 258.1792_wp * rh*8 - 1019.3777_wp rh*7 + 1592.8918_wp rh**6 - &
7290	1221.0726_wp * rh*5 + 442.2548_wp rh*4 - 43.6278_wp rh**3 - &
7291	7.5282_wp * rh*2 - 3.8459_wp rh + 2.2728_wp
7292	ENDIF
7293
7294	IF ( sodium_sulphate > 0.0_wp) THEN ! Na2SO4
7295	na2so4_nh4hso4 = 225.4238_wp * rh*8 - 732.4113_wp rh*7 + 843.7291_wp rh**6 - &
7296	322.7328_wp * rh*5 - 88.6252_wp rh*4 + 72.4434_wp rh**3 + &
7297	22.9252_wp * rh*2 - 25.3954_wp rh + 4.6971_wp
7298	ENDIF
7299
7300	IF ( sodium_nitrate > 0.0_wp) THEN ! NaNO3
7301	nano3_nh4hso4 = 96.1348_wp * rh*8 - 341.6738_wp rh*7 + 406.5314_wp rh**6 - &
7302	98.5777_wp * rh*5 - 172.8286_wp rh*4 + 149.3151_wp rh**3 - &
7303	38.9998_wp * rh*2 - 0.2251_wp rh + 0.4953_wp
7304	ENDIF
7305
7306	IF ( sodium_chloride > 0.0_wp) THEN ! NaCl
7307	nacl_nh4hso4 = 91.7856_wp * rh*8 - 316.6773_wp rh*7 + 358.2703_wp rh**6 - &
7308	68.9142_wp * rh*5 - 156.5031_wp rh*4 + 116.9592_wp rh**3 - &
7309	22.5271_wp * rh*2 - 3.7716_wp rh + 1.56_wp
7310	ENDIF
7311
7312	ln_nh4hso4_act = binary_nh4hso4 + nitric_acid_eq_frac * hno3_nh4hso4 + &
7313	hydrochloric_acid_eq_frac * hcl_nh4hso4 + &
7314	sulphuric_acid_eq_frac * h2so4_nh4hso4 + &
7315	ammonium_sulphate_eq_frac * nh42so4_nh4hso4 + &
7316	ammonium_nitrate_eq_frac * nh4no3_nh4hso4 + &
7317	ammonium_chloride_eq_frac * nh4cl_nh4hso4 + &
7318	sodium_sulphate_eq_frac * na2so4_nh4hso4 + &
7319	sodium_nitrate_eq_frac * nano3_nh4hso4 + &
7320	sodium_chloride_eq_frac * nacl_nh4hso4
7321
7322	gamma_nh4hso4 = EXP( ln_nh4hso4_act ) ! molal act. coefficient of NH4HSO4
7323	!
7324	!-- Molal activity coefficient of NO3-
7325	gamma_out(6) = gamma_nh4hso4
7326	!
7327	!-- Molal activity coefficient of NH4+
7328	gamma_nh3 = gamma_nh4hso42 / gamma_hhso42
7329	gamma_out(3) = gamma_nh3
7330	!
7331	!-- This actually represents the ratio of the ammonium to hydrogen ion activity coefficients
7332	!-- (see Zaveri paper) - multiply this by the ratio of the ammonium to hydrogen ion molality and
7333	!-- the ratio of appropriate equilibrium constants
7334	!
7335	!-- Equilibrium constants
7336	!-- k_h = 57.64d0 ! Zaveri et al. (2005)
7337	k_h = 5.8E1_wp * EXP( 4085.0_wp * henrys_temp_dep ) ! after Chameides (1984)
7338	!-- k_nh4 = 1.81E-5_wp ! Zaveri et al. (2005)
7339	k_nh4 = 1.7E-5_wp * EXP( -4325.0_wp * henrys_temp_dep ) ! Chameides (1984)
7340	!-- k_h2o = 1.01E-14_wp ! Zaveri et al (2005)
7341	k_h2o = 1.E-14_wp * EXP( -6716.0_wp * henrys_temp_dep ) ! Chameides (1984)
7342	!
7343	molality_ratio_nh3 = ions_mol(2) / ions_mol(1)
7344	!
7345	!-- Partial pressure calculation
7346	press_nh3 = molality_ratio_nh3 * gamma_nh3 * ( k_h2o / ( k_h * k_nh4 ) )
7347
7348	ENDIF
7349	!
7350	!-- c) - ACTIVITY COEFF/VAPOUR PRESSURE - HCL
7351	IF ( ions(1) > 0.0_wp .AND. ions(7) > 0.0_wp ) THEN
7352	binary_case = 1
7353	IF ( rh > 0.1_wp .AND. rh < 0.98 ) THEN
7354	IF ( binary_case == 1 ) THEN
7355	binary_hcl = - 5.0179_wp * rh*3 + 9.8816_wp rh*2 - 10.789_wp rh + 5.4737_wp
7356	ELSEIF ( binary_case == 2 ) THEN
7357	binary_hcl = - 4.6221_wp * rh + 4.2633_wp
7358	ENDIF
7359	ELSEIF ( rh >= 0.98_wp .AND. rh < 0.9999_wp ) THEN
7360	binary_hcl = 775.6111008626_wp * rh*3 - 2146.01320888771_wp rh**2 + &
7361	1969.01979670259_wp * rh - 598.878230033926_wp
7362	ENDIF
7363	ENDIF
7364
7365	IF ( nitric_acid > 0.0_wp ) THEN ! HNO3
7366	IF ( full_complexity == 1 .OR. rh <= 0.4_wp ) THEN
7367	hno3_hcl = 9.6256_wp * rh*4 - 26.507_wp rh*3 + 27.622_wp rh*2 - 12.958_wp rh + &
7368	2.2193_wp
7369	ELSEIF ( full_complexity == 0 .AND. rh > 0.4_wp ) THEN
7370	hno3_hcl = 1.3242_wp * rh*2 - 1.8827_wp rh + 0.55706_wp
7371	ENDIF
7372	ENDIF
7373
7374	IF ( sulphuric_acid > 0.0_wp ) THEN ! H2SO4
7375	IF ( full_complexity == 1 .OR. rh <= 0.4 ) THEN
7376	h2so4_hcl = 1.4406_wp * rh*3 - 2.7132_wp rh*2 + 1.014_wp rh + 0.25226_wp
7377	ELSEIF ( full_complexity == 0 .AND. rh > 0.4_wp ) THEN
7378	h2so4_hcl = 0.30993_wp * rh*2 - 0.99171_wp rh + 0.66913_wp
7379	ENDIF
7380	ENDIF
7381
7382	IF ( ammonium_sulphate > 0.0_wp ) THEN ! NH42SO4
7383	nh42so4_hcl = 22.071_wp * rh*3 - 40.678_wp rh*2 + 27.893_wp rh - 9.4338_wp
7384	ENDIF
7385
7386	IF ( ammonium_nitrate > 0.0_wp ) THEN ! NH4NO3
7387	nh4no3_hcl = 19.935_wp * rh*3 - 42.335_wp rh*2 + 31.275_wp rh - 8.8675_wp
7388	ENDIF
7389
7390	IF ( ammonium_chloride > 0.0_wp ) THEN ! NH4Cl
7391	IF ( full_complexity == 1 .OR. rh <= 0.4_wp ) THEN
7392	nh4cl_hcl = 2.8048_wp * rh*3 - 4.3182_wp rh*2 + 3.1971_wp rh - 1.6824_wp
7393	ELSEIF ( full_complexity == 0 .AND. rh > 0.4_wp ) THEN
7394	nh4cl_hcl = 1.2304_wp * rh*2 - 0.18262_wp rh - 1.0643_wp
7395	ENDIF
7396	ENDIF
7397
7398	IF ( sodium_sulphate > 0.0_wp ) THEN ! Na2SO4
7399	na2so4_hcl = 36.104_wp * rh*4 - 78.658_wp rh*3 + 63.441_wp rh*2 - 26.727_wp rh + &
7400	5.7007_wp
7401	ENDIF
7402
7403	IF ( sodium_nitrate > 0.0_wp ) THEN ! NaNO3
7404	IF ( full_complexity == 1 .OR. rh <= 0.4_wp ) THEN
7405	nano3_hcl = 54.471_wp * rh*5 - 159.42_wp rh*4 + 180.25_wp rh*3 - 98.176_wp rh**2&
7406	+ 25.309_wp * rh - 2.4275_wp
7407	ELSEIF ( full_complexity == 0 .AND. rh > 0.4_wp ) THEN
7408	nano3_hcl = 21.632_wp * rh*4 - 53.088_wp rh*3 + 47.285_wp rh*2 - 18.519_wp rh &
7409	+ 2.6846_wp
7410	ENDIF
7411	ENDIF
7412
7413	IF ( sodium_chloride > 0.0_wp ) THEN ! NaCl
7414	IF ( full_complexity == 1 .OR. rh <= 0.4_wp ) THEN
7415	nacl_hcl = 5.4138_wp * rh*4 - 12.079_wp rh*3 + 9.627_wp rh*2 - 3.3164_wp rh + &
7416	0.35224_wp
7417	ELSEIF ( full_complexity == 0 .AND. rh > 0.4_wp ) THEN
7418	nacl_hcl = 2.432_wp * rh*3 - 4.3453_wp rh*2 + 2.3834_wp rh - 0.4762_wp
7419	ENDIF
7420	ENDIF
7421
7422	ln_HCL_act = binary_hcl + nitric_acid_eq_frac * hno3_hcl + sulphuric_acid_eq_frac * h2so4_hcl +&
7423	ammonium_sulphate_eq_frac * nh42so4_hcl + ammonium_nitrate_eq_frac * nh4no3_hcl + &
7424	ammonium_chloride_eq_frac * nh4cl_hcl + sodium_sulphate_eq_frac * na2so4_hcl + &
7425	sodium_nitrate_eq_frac * nano3_hcl + sodium_chloride_eq_frac * nacl_hcl
7426
7427	gamma_hcl = EXP( ln_HCL_act ) ! Molal activity coefficient
7428	gamma_out(2) = gamma_hcl
7429	!
7430	!-- Equilibrium constant after Wagman et al. (1982) (and NIST database)
7431	k_hcl = 2E6_wp * EXP( 9000.0_wp * henrys_temp_dep )
7432
7433	press_hcl = ( ions_mol(1) * ions_mol(7) * gamma_hcl**2 ) / k_hcl
7434	!
7435	!-- 5) Ion molility output
7436	mols_out = ions_mol
7437
7438	END SUBROUTINE inorganic_pdfite
7439
7440	!------------------------------------------------------------------------------!
7441	! Description:
7442	! ------------
7443	!> Update the particle size distribution. Put particles into corrects bins.
7444	!>
7445	!> Moving-centre method assumed, i.e. particles are allowed to grow to their
7446	!> exact size as long as they are not crossing the fixed diameter bin limits.
7447	!> If the particles in a size bin cross the lower or upper diameter limit, they
7448	!> are all moved to the adjacent diameter bin and their volume is averaged with
7449	!> the particles in the new bin, which then get a new diameter.
7450	!
7451	!> Moving-centre method minimises numerical diffusion.
7452	!------------------------------------------------------------------------------!
7453	SUBROUTINE distr_update( paero )
7454
7455	IMPLICIT NONE
7456
7457	INTEGER(iwp) :: ib !< loop index
7458	INTEGER(iwp) :: mm !< loop index
7459	INTEGER(iwp) :: counti !< number of while loops
7460
7461	LOGICAL :: within_bins !< logical (particle belongs to the bin?)
7462
7463	REAL(wp) :: znfrac !< number fraction to be moved to the larger bin
7464	REAL(wp) :: zvfrac !< volume fraction to be moved to the larger bin
7465	REAL(wp) :: zvexc !< Volume in the grown bin which exceeds the bin upper limit
7466	REAL(wp) :: zvihi !< particle volume at the high end of the bin
7467	REAL(wp) :: zvilo !< particle volume at the low end of the bin
7468	REAL(wp) :: zvpart !< particle volume (m3)
7469	REAL(wp) :: zvrat !< volume ratio of a size bin
7470
7471	real(wp), dimension(nbins_aerosol) :: dummy
7472
7473	TYPE(t_section), DIMENSION(nbins_aerosol), INTENT(inout) :: paero !< aerosol properties
7474
7475	zvpart = 0.0_wp
7476	zvfrac = 0.0_wp
7477	within_bins = .FALSE.
7478
7479	dummy = paero(:)%numc
7480	!
7481	!-- Check if the volume of the bin is within bin limits after update
7482	counti = 0
7483	DO WHILE ( .NOT. within_bins )
7484	within_bins = .TRUE.
7485	!
7486	!-- Loop from larger to smaller size bins
7487	DO ib = end_subrange_2b-1, start_subrange_1a, -1
7488	mm = 0
7489	IF ( paero(ib)%numc > nclim ) THEN
7490	zvpart = 0.0_wp
7491	zvfrac = 0.0_wp
7492
7493	IF ( ib == end_subrange_2a ) CYCLE
7494	!
7495	!-- Dry volume
7496	zvpart = SUM( paero(ib)%volc(1:7) ) / paero(ib)%numc
7497	!
7498	!-- Smallest bin cannot decrease
7499	IF ( paero(ib)%vlolim > zvpart .AND. ib == start_subrange_1a ) CYCLE
7500	!
7501	!-- Decreasing bins
7502	IF ( paero(ib)%vlolim > zvpart ) THEN
7503	mm = ib - 1
7504	IF ( ib == start_subrange_2b ) mm = end_subrange_1a ! 2b goes to 1a
7505
7506	paero(mm)%numc = paero(mm)%numc + paero(ib)%numc
7507	paero(ib)%numc = 0.0_wp
7508	paero(mm)%volc(:) = paero(mm)%volc(:) + paero(ib)%volc(:)
7509	paero(ib)%volc(:) = 0.0_wp
7510	CYCLE
7511	ENDIF
7512	!
7513	!-- If size bin has not grown, cycle.
7514	!-- Changed by Mona: compare to the arithmetic mean volume, as done originally. Now
7515	!-- particle volume is derived from the geometric mean diameter, not arithmetic (see
7516	!-- SUBROUTINE set_sizebins).
7517	IF ( zvpart <= api6 * ( ( aero(ib)%vhilim + aero(ib)%vlolim ) / ( 2.0_wp * api6 ) ) ) &
7518	CYCLE
7519	!
7520	!-- Avoid precision problems
7521	IF ( ABS( zvpart - api6 * paero(ib)%dmid**3 ) < 1.0E-35_wp ) CYCLE
7522	!
7523	!-- Volume ratio of the size bin
7524	zvrat = paero(ib)%vhilim / paero(ib)%vlolim
7525	!
7526	!-- Particle volume at the low end of the bin
7527	zvilo = 2.0_wp * zvpart / ( 1.0_wp + zvrat )
7528	!
7529	!-- Particle volume at the high end of the bin
7530	zvihi = zvrat * zvilo
7531	!
7532	!-- Volume in the grown bin which exceeds the bin upper limit
7533	zvexc = 0.5_wp * ( zvihi + paero(ib)%vhilim )
7534	!
7535	!-- Number fraction to be moved to the larger bin
7536	znfrac = MIN( 1.0_wp, ( zvihi - paero(ib)%vhilim) / ( zvihi - zvilo ) )
7537	!
7538	!-- Volume fraction to be moved to the larger bin
7539	zvfrac = MIN( 0.99_wp, znfrac * zvexc / zvpart )
7540	IF ( zvfrac < 0.0_wp ) THEN
7541	message_string = 'Error: zvfrac < 0'
7542	CALL message( 'salsa_mod: distr_update', 'PA0624', 1, 2, 0, 6, 0 )
7543	ENDIF
7544	!
7545	!-- Update bin
7546	mm = ib + 1
7547	!
7548	!-- Volume (cm3/cm3)
7549	paero(mm)%volc(:) = paero(mm)%volc(:) + znfrac * paero(ib)%numc * zvexc * &
7550	paero(ib)%volc(:) / SUM( paero(ib)%volc(1:7) )
7551	paero(ib)%volc(:) = paero(ib)%volc(:) - znfrac * paero(ib)%numc * zvexc * &
7552	paero(ib)%volc(:) / SUM( paero(ib)%volc(1:7) )
7553
7554	!-- Number concentration (#/m3)
7555	paero(mm)%numc = paero(mm)%numc + znfrac * paero(ib)%numc
7556	paero(ib)%numc = paero(ib)%numc * ( 1.0_wp - znfrac )
7557
7558	ENDIF ! nclim
7559
7560	IF ( paero(ib)%numc > nclim ) THEN
7561	zvpart = SUM( paero(ib)%volc(1:7) ) / paero(ib)%numc ! Note: dry volume!
7562	within_bins = ( paero(ib)%vlolim < zvpart .AND. zvpart < paero(ib)%vhilim )
7563	ENDIF
7564
7565	ENDDO ! - ib
7566
7567	counti = counti + 1
7568	IF ( counti > 100 ) THEN
7569	message_string = 'Error: Aerosol bin update not converged'
7570	CALL message( 'salsa_mod: distr_update', 'PA0625', 1, 2, 0, 6, 0 )
7571	ENDIF
7572
7573	ENDDO ! - within bins
7574
7575	END SUBROUTINE distr_update
7576
7577	!------------------------------------------------------------------------------!
7578	! Description:
7579	! ------------
7580	!> salsa_diagnostics: Update properties for the current timestep:
7581	!>
7582	!> Juha Tonttila, FMI, 2014
7583	!> Tomi Raatikainen, FMI, 2016
7584	!------------------------------------------------------------------------------!
7585	SUBROUTINE salsa_diagnostics( i, j )
7586
7587	USE cpulog, &
7588	ONLY: cpu_log, log_point_s
7589
7590	IMPLICIT NONE
7591
7592	INTEGER(iwp) :: ib !<
7593	INTEGER(iwp) :: ic !<
7594	INTEGER(iwp) :: icc !<
7595	INTEGER(iwp) :: ig !<
7596	INTEGER(iwp) :: k !<
7597
7598	INTEGER(iwp), INTENT(in) :: i !<
7599	INTEGER(iwp), INTENT(in) :: j !<
7600
7601	REAL(wp), DIMENSION(nzb:nzt+1) :: flag !< flag to mask topography
7602	REAL(wp), DIMENSION(nzb:nzt+1) :: flag_zddry !< flag to mask zddry
7603	REAL(wp), DIMENSION(nzb:nzt+1) :: in_adn !< air density (kg/m3)
7604	REAL(wp), DIMENSION(nzb:nzt+1) :: in_p !< pressure
7605	REAL(wp), DIMENSION(nzb:nzt+1) :: in_t !< temperature (K)
7606	REAL(wp), DIMENSION(nzb:nzt+1) :: mcsum !< sum of mass concentration
7607	REAL(wp), DIMENSION(nzb:nzt+1) :: ppm_to_nconc !< Conversion factor: ppm to #/m3
7608	REAL(wp), DIMENSION(nzb:nzt+1) :: zddry !< particle dry diameter
7609	REAL(wp), DIMENSION(nzb:nzt+1) :: zvol !< particle volume
7610
7611	flag_zddry = 0.0_wp
7612	in_adn = 0.0_wp
7613	in_p = 0.0_wp
7614	in_t = 0.0_wp
7615	ppm_to_nconc = 1.0_wp
7616	zddry = 0.0_wp
7617	zvol = 0.0_wp
7618
7619	!$OMP MASTER
7620	CALL cpu_log( log_point_s(94), 'salsa diagnostics ', 'start' )
7621	!$OMP END MASTER
7622
7623	!
7624	!-- Calculate thermodynamic quantities needed in SALSA
7625	CALL salsa_thrm_ij( i, j, p_ij=in_p, temp_ij=in_t, adn_ij=in_adn )
7626	!
7627	!-- Calculate conversion factors for gas concentrations
7628	ppm_to_nconc = for_ppm_to_nconc * in_p / in_t
7629	!
7630	!-- Predetermine flag to mask topography
7631	flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(:,j,i), 0 ) )
7632
7633	DO ib = 1, nbins_aerosol ! aerosol size bins
7634	!
7635	!-- Remove negative values
7636	aerosol_number(ib)%conc(:,j,i) = MAX( nclim, aerosol_number(ib)%conc(:,j,i) ) * flag
7637	!
7638	!-- Calculate total mass concentration per bin
7639	mcsum = 0.0_wp
7640	DO ic = 1, ncomponents_mass
7641	icc = ( ic - 1 ) * nbins_aerosol + ib
7642	mcsum = mcsum + aerosol_mass(icc)%conc(:,j,i) * flag
7643	aerosol_mass(icc)%conc(:,j,i) = MAX( mclim, aerosol_mass(icc)%conc(:,j,i) ) * flag
7644	ENDDO
7645	!
7646	!-- Check that number and mass concentration match qualitatively
7647	IF ( ANY( aerosol_number(ib)%conc(:,j,i) > nclim .AND. mcsum <= 0.0_wp ) ) THEN
7648	DO k = nzb+1, nzt
7649	IF ( aerosol_number(ib)%conc(k,j,i) >= nclim .AND. mcsum(k) <= 0.0_wp ) THEN
7650	aerosol_number(ib)%conc(k,j,i) = nclim * flag(k)
7651	DO ic = 1, ncomponents_mass
7652	icc = ( ic - 1 ) * nbins_aerosol + ib
7653	aerosol_mass(icc)%conc(k,j,i) = mclim * flag(k)
7654	ENDDO
7655	ENDIF
7656	ENDDO
7657	ENDIF
7658	!
7659	!-- Update aerosol particle radius
7660	CALL bin_mixrat( 'dry', ib, i, j, zvol )
7661	zvol = zvol / arhoh2so4 ! Why on sulphate?
7662	!
7663	!-- Particles smaller then 0.1 nm diameter are set to zero
7664	zddry = ( zvol / MAX( nclim, aerosol_number(ib)%conc(:,j,i) ) / api6 )**0.33333333_wp
7665	flag_zddry = MERGE( 1.0_wp, 0.0_wp, ( zddry < 1.0E-10_wp .AND. &
7666	aerosol_number(ib)%conc(:,j,i) > nclim ) )
7667	!
7668	!-- Volatile species to the gas phase
7669	IF ( index_so4 > 0 .AND. lscndgas ) THEN
7670	ic = ( index_so4 - 1 ) * nbins_aerosol + ib
7671	IF ( salsa_gases_from_chem ) THEN
7672	ig = gas_index_chem(1)
7673	chem_species(ig)%conc(:,j,i) = chem_species(ig)%conc(:,j,i) + &
7674	aerosol_mass(ic)%conc(:,j,i) * avo * flag_zddry / &
7675	( amh2so4 * ppm_to_nconc ) * flag
7676	ELSE
7677	salsa_gas(1)%conc(:,j,i) = salsa_gas(1)%conc(:,j,i) + aerosol_mass(ic)%conc(:,j,i) / &
7678	amh2so4 * avo * flag_zddry * flag
7679	ENDIF
7680	ENDIF
7681	IF ( index_oc > 0 .AND. lscndgas ) THEN
7682	ic = ( index_oc - 1 ) * nbins_aerosol + ib
7683	IF ( salsa_gases_from_chem ) THEN
7684	ig = gas_index_chem(5)
7685	chem_species(ig)%conc(:,j,i) = chem_species(ig)%conc(:,j,i) + &
7686	aerosol_mass(ic)%conc(:,j,i) * avo * flag_zddry / &
7687	( amoc * ppm_to_nconc ) * flag
7688	ELSE
7689	salsa_gas(5)%conc(:,j,i) = salsa_gas(5)%conc(:,j,i) + aerosol_mass(ic)%conc(:,j,i) / &
7690	amoc * avo * flag_zddry * flag
7691	ENDIF
7692	ENDIF
7693	IF ( index_no > 0 .AND. lscndgas ) THEN
7694	ic = ( index_no - 1 ) * nbins_aerosol + ib
7695	IF ( salsa_gases_from_chem ) THEN
7696	ig = gas_index_chem(2)
7697	chem_species(ig)%conc(:,j,i) = chem_species(ig)%conc(:,j,i) + &
7698	aerosol_mass(ic)%conc(:,j,i) * avo * flag_zddry / &
7699	( amhno3 * ppm_to_nconc ) *flag
7700	ELSE
7701	salsa_gas(2)%conc(:,j,i) = salsa_gas(2)%conc(:,j,i) + aerosol_mass(ic)%conc(:,j,i) / &
7702	amhno3 * avo * flag_zddry * flag
7703	ENDIF
7704	ENDIF
7705	IF ( index_nh > 0 .AND. lscndgas ) THEN
7706	ic = ( index_nh - 1 ) * nbins_aerosol + ib
7707	IF ( salsa_gases_from_chem ) THEN
7708	ig = gas_index_chem(3)
7709	chem_species(ig)%conc(:,j,i) = chem_species(ig)%conc(:,j,i) + &
7710	aerosol_mass(ic)%conc(:,j,i) * avo * flag_zddry / &
7711	( amnh3 * ppm_to_nconc ) *flag
7712	ELSE
7713	salsa_gas(3)%conc(:,j,i) = salsa_gas(3)%conc(:,j,i) + aerosol_mass(ic)%conc(:,j,i) / &
7714	amnh3 * avo * flag_zddry *flag
7715	ENDIF
7716	ENDIF
7717	!
7718	!-- Mass and number to zero (insoluble species and water are lost)
7719	DO ic = 1, ncomponents_mass
7720	icc = ( ic - 1 ) * nbins_aerosol + ib
7721	aerosol_mass(icc)%conc(:,j,i) = MERGE( mclim * flag, aerosol_mass(icc)%conc(:,j,i), &
7722	flag_zddry > 0.0_wp )
7723	ENDDO
7724	aerosol_number(ib)%conc(:,j,i) = MERGE( nclim * flag, aerosol_number(ib)%conc(:,j,i), &
7725	flag_zddry > 0.0_wp )
7726	ra_dry(:,j,i,ib) = MAX( 1.0E-10_wp, 0.5_wp * zddry )
7727
7728	ENDDO
7729	IF ( .NOT. salsa_gases_from_chem ) THEN
7730	DO ig = 1, ngases_salsa
7731	salsa_gas(ig)%conc(:,j,i) = MAX( nclim, salsa_gas(ig)%conc(:,j,i) ) * flag
7732	ENDDO
7733	ENDIF
7734
7735	!$OMP MASTER
7736	CALL cpu_log( log_point_s(94), 'salsa diagnostics ', 'stop' )
7737	!$OMP END MASTER
7738
7739	END SUBROUTINE salsa_diagnostics
7740
7741
7742	!------------------------------------------------------------------------------!
7743	! Description:
7744	! ------------
7745	!> Call for all grid points
7746	!------------------------------------------------------------------------------!
7747	SUBROUTINE salsa_actions( location )
7748
7749
7750	CHARACTER (LEN=*), INTENT(IN) :: location !< call location string
7751
7752	SELECT CASE ( location )
7753
7754	CASE ( 'before_timestep' )
7755
7756	IF ( ws_scheme_sca ) sums_salsa_ws_l = 0.0_wp
7757
7758	CASE DEFAULT
7759	CONTINUE
7760
7761	END SELECT
7762
7763	END SUBROUTINE salsa_actions
7764
7765
7766	!------------------------------------------------------------------------------!
7767	! Description:
7768	! ------------
7769	!> Call for grid points i,j
7770	!------------------------------------------------------------------------------!
7771
7772	SUBROUTINE salsa_actions_ij( i, j, location )
7773
7774
7775	INTEGER(iwp), INTENT(IN) :: i !< grid index in x-direction
7776	INTEGER(iwp), INTENT(IN) :: j !< grid index in y-direction
7777	CHARACTER (LEN=*), INTENT(IN) :: location !< call location string
7778	INTEGER(iwp) :: dummy !< call location string
7779
7780	IF ( salsa ) dummy = i + j
7781
7782	SELECT CASE ( location )
7783
7784	CASE ( 'before_timestep' )
7785
7786	IF ( ws_scheme_sca ) sums_salsa_ws_l = 0.0_wp
7787
7788	CASE DEFAULT
7789	CONTINUE
7790
7791	END SELECT
7792
7793
7794	END SUBROUTINE salsa_actions_ij
7795
7796	!------------------------------------------------------------------------------!
7797	! Description:
7798	! ------------
7799	!> Call for all grid points
7800	!------------------------------------------------------------------------------!
7801	SUBROUTINE salsa_non_advective_processes
7802
7803	USE cpulog, &
7804	ONLY: cpu_log, log_point_s
7805
7806	IMPLICIT NONE
7807
7808	INTEGER(iwp) :: i !<
7809	INTEGER(iwp) :: j !<
7810
7811	IF ( time_since_reference_point >= skip_time_do_salsa ) THEN
7812	IF ( ( time_since_reference_point - last_salsa_time ) >= dt_salsa ) THEN
7813	!
7814	!-- Calculate aerosol dynamic processes. salsa_driver can be run with a longer time step.
7815	CALL cpu_log( log_point_s(90), 'salsa processes ', 'start' )
7816	DO i = nxl, nxr
7817	DO j = nys, nyn
7818	CALL salsa_diagnostics( i, j )
7819	CALL salsa_driver( i, j, 3 )
7820	CALL salsa_diagnostics( i, j )
7821	ENDDO
7822	ENDDO
7823	CALL cpu_log( log_point_s(90), 'salsa processes ', 'stop' )
7824	ENDIF
7825	ENDIF
7826
7827	END SUBROUTINE salsa_non_advective_processes
7828
7829
7830	!------------------------------------------------------------------------------!
7831	! Description:
7832	! ------------
7833	!> Call for grid points i,j
7834	!------------------------------------------------------------------------------!
7835	SUBROUTINE salsa_non_advective_processes_ij( i, j )
7836
7837	USE cpulog, &
7838	ONLY: cpu_log, log_point_s
7839
7840	IMPLICIT NONE
7841
7842	INTEGER(iwp), INTENT(IN) :: i !< grid index in x-direction
7843	INTEGER(iwp), INTENT(IN) :: j !< grid index in y-direction
7844
7845	IF ( time_since_reference_point >= skip_time_do_salsa ) THEN
7846	IF ( ( time_since_reference_point - last_salsa_time ) >= dt_salsa ) THEN
7847	!
7848	!-- Calculate aerosol dynamic processes. salsa_driver can be run with a longer time step.
7849	CALL cpu_log( log_point_s(90), 'salsa processes ', 'start' )
7850	CALL salsa_diagnostics( i, j )
7851	CALL salsa_driver( i, j, 3 )
7852	CALL salsa_diagnostics( i, j )
7853	CALL cpu_log( log_point_s(90), 'salsa processes ', 'stop' )
7854	ENDIF
7855	ENDIF
7856
7857	END SUBROUTINE salsa_non_advective_processes_ij
7858
7859	!------------------------------------------------------------------------------!
7860	! Description:
7861	! ------------
7862	!> Routine for exchange horiz of salsa variables.
7863	!------------------------------------------------------------------------------!
7864	SUBROUTINE salsa_exchange_horiz_bounds
7865
7866	USE cpulog, &
7867	ONLY: cpu_log, log_point_s
7868
7869	IMPLICIT NONE
7870
7871	INTEGER(iwp) :: ib !<
7872	INTEGER(iwp) :: ic !<
7873	INTEGER(iwp) :: icc !<
7874	INTEGER(iwp) :: ig !<
7875
7876	IF ( time_since_reference_point >= skip_time_do_salsa ) THEN
7877	IF ( ( time_since_reference_point - last_salsa_time ) >= dt_salsa ) THEN
7878
7879	CALL cpu_log( log_point_s(91), 'salsa exch-horiz ', 'start' )
7880	!
7881	!-- Exchange ghost points and decycle if needed.
7882	DO ib = 1, nbins_aerosol
7883	CALL exchange_horiz( aerosol_number(ib)%conc, nbgp )
7884	CALL salsa_boundary_conds( aerosol_number(ib)%conc, aerosol_number(ib)%init )
7885	DO ic = 1, ncomponents_mass
7886	icc = ( ic - 1 ) * nbins_aerosol + ib
7887	CALL exchange_horiz( aerosol_mass(icc)%conc, nbgp )
7888	CALL salsa_boundary_conds( aerosol_mass(icc)%conc, aerosol_mass(icc)%init )
7889	ENDDO
7890	ENDDO
7891	IF ( .NOT. salsa_gases_from_chem ) THEN
7892	DO ig = 1, ngases_salsa
7893	CALL exchange_horiz( salsa_gas(ig)%conc, nbgp )
7894	CALL salsa_boundary_conds( salsa_gas(ig)%conc, salsa_gas(ig)%init )
7895	ENDDO
7896	ENDIF
7897	CALL cpu_log( log_point_s(91), 'salsa exch-horiz ', 'stop' )
7898	!
7899	!-- Update last_salsa_time
7900	last_salsa_time = time_since_reference_point
7901	ENDIF
7902	ENDIF
7903
7904	END SUBROUTINE salsa_exchange_horiz_bounds
7905
7906	!------------------------------------------------------------------------------!
7907	! Description:
7908	! ------------
7909	!> Calculate the prognostic equation for aerosol number and mass, and gas
7910	!> concentrations. Cache-optimized.
7911	!------------------------------------------------------------------------------!
7912	SUBROUTINE salsa_prognostic_equations_ij( i, j, i_omp_start, tn )
7913
7914	IMPLICIT NONE
7915
7916	INTEGER(iwp) :: i !<
7917	INTEGER(iwp) :: i_omp_start !<
7918	INTEGER(iwp) :: ib !< loop index for aerosol number bin OR gas index
7919	INTEGER(iwp) :: ic !< loop index for aerosol mass bin
7920	INTEGER(iwp) :: icc !< (c-1)*nbins_aerosol+b
7921	INTEGER(iwp) :: ig !< loop index for salsa gases
7922	INTEGER(iwp) :: j !<
7923	INTEGER(iwp) :: tn !<
7924
7925	IF ( time_since_reference_point >= skip_time_do_salsa ) THEN
7926	!
7927	!-- Aerosol number
7928	DO ib = 1, nbins_aerosol
7929	!kk sums_salsa_ws_l = aerosol_number(ib)%sums_ws_l
7930	CALL salsa_tendency( 'aerosol_number', aerosol_number(ib)%conc_p, aerosol_number(ib)%conc,&
7931	aerosol_number(ib)%tconc_m, i, j, i_omp_start, tn, ib, ib, &
7932	aerosol_number(ib)%flux_s, aerosol_number(ib)%diss_s, &
7933	aerosol_number(ib)%flux_l, aerosol_number(ib)%diss_l, &
7934	aerosol_number(ib)%init, .TRUE. )
7935	!kk aerosol_number(ib)%sums_ws_l = sums_salsa_ws_l
7936	!
7937	!-- Aerosol mass
7938	DO ic = 1, ncomponents_mass
7939	icc = ( ic - 1 ) * nbins_aerosol + ib
7940	!kk sums_salsa_ws_l = aerosol_mass(icc)%sums_ws_l
7941	CALL salsa_tendency( 'aerosol_mass', aerosol_mass(icc)%conc_p, aerosol_mass(icc)%conc,&
7942	aerosol_mass(icc)%tconc_m, i, j, i_omp_start, tn, ib, ic, &
7943	aerosol_mass(icc)%flux_s, aerosol_mass(icc)%diss_s, &
7944	aerosol_mass(icc)%flux_l, aerosol_mass(icc)%diss_l, &
7945	aerosol_mass(icc)%init, .TRUE. )
7946	!kk aerosol_mass(icc)%sums_ws_l = sums_salsa_ws_l
7947
7948	ENDDO ! ic
7949	ENDDO ! ib
7950	!
7951	!-- Gases
7952	IF ( .NOT. salsa_gases_from_chem ) THEN
7953
7954	DO ig = 1, ngases_salsa
7955	!kk sums_salsa_ws_l = salsa_gas(ig)%sums_ws_l
7956	CALL salsa_tendency( 'salsa_gas', salsa_gas(ig)%conc_p, salsa_gas(ig)%conc, &
7957	salsa_gas(ig)%tconc_m, i, j, i_omp_start, tn, ig, ig, &
7958	salsa_gas(ig)%flux_s, salsa_gas(ig)%diss_s, salsa_gas(ig)%flux_l,&
7959	salsa_gas(ig)%diss_l, salsa_gas(ig)%init, .FALSE. )
7960	!kk salsa_gas(ig)%sums_ws_l = sums_salsa_ws_l
7961
7962	ENDDO ! ig
7963
7964	ENDIF
7965
7966	ENDIF
7967
7968	END SUBROUTINE salsa_prognostic_equations_ij
7969	!
7970	!------------------------------------------------------------------------------!
7971	! Description:
7972	! ------------
7973	!> Calculate the prognostic equation for aerosol number and mass, and gas
7974	!> concentrations. For vector machines.
7975	!------------------------------------------------------------------------------!
7976	SUBROUTINE salsa_prognostic_equations()
7977
7978	IMPLICIT NONE
7979
7980	INTEGER(iwp) :: ib !< loop index for aerosol number bin OR gas index
7981	INTEGER(iwp) :: ic !< loop index for aerosol mass bin
7982	INTEGER(iwp) :: icc !< (c-1)*nbins_aerosol+b
7983	INTEGER(iwp) :: ig !< loop index for salsa gases
7984
7985	IF ( time_since_reference_point >= skip_time_do_salsa ) THEN
7986	!
7987	!-- Aerosol number
7988	DO ib = 1, nbins_aerosol
7989	sums_salsa_ws_l = aerosol_number(ib)%sums_ws_l
7990	CALL salsa_tendency( 'aerosol_number', aerosol_number(ib)%conc_p, aerosol_number(ib)%conc,&
7991	aerosol_number(ib)%tconc_m, ib, ib, aerosol_number(ib)%init, .TRUE. )
7992	aerosol_number(ib)%sums_ws_l = sums_salsa_ws_l
7993	!
7994	!-- Aerosol mass
7995	DO ic = 1, ncomponents_mass
7996	icc = ( ic - 1 ) * nbins_aerosol + ib
7997	sums_salsa_ws_l = aerosol_mass(icc)%sums_ws_l
7998	CALL salsa_tendency( 'aerosol_mass', aerosol_mass(icc)%conc_p, aerosol_mass(icc)%conc,&
7999	aerosol_mass(icc)%tconc_m, ib, ic, aerosol_mass(icc)%init, .TRUE. )
8000	aerosol_mass(icc)%sums_ws_l = sums_salsa_ws_l
8001
8002	ENDDO ! ic
8003	ENDDO ! ib
8004	!
8005	!-- Gases
8006	IF ( .NOT. salsa_gases_from_chem ) THEN
8007
8008	DO ig = 1, ngases_salsa
8009	sums_salsa_ws_l = salsa_gas(ig)%sums_ws_l
8010	CALL salsa_tendency( 'salsa_gas', salsa_gas(ig)%conc_p, salsa_gas(ig)%conc, &
8011	salsa_gas(ig)%tconc_m, ig, ig, salsa_gas(ig)%init, .FALSE. )
8012	salsa_gas(ig)%sums_ws_l = sums_salsa_ws_l
8013
8014	ENDDO ! ig
8015
8016	ENDIF
8017
8018	ENDIF
8019
8020	END SUBROUTINE salsa_prognostic_equations
8021	!
8022	!------------------------------------------------------------------------------!
8023	! Description:
8024	! ------------
8025	!> Tendencies for aerosol number and mass and gas concentrations.
8026	!> Cache-optimized.
8027	!------------------------------------------------------------------------------!
8028	SUBROUTINE salsa_tendency_ij( id, rs_p, rs, trs_m, i, j, i_omp_start, tn, ib, ic, flux_s, diss_s, &
8029	flux_l, diss_l, rs_init, do_sedimentation )
8030
8031	USE advec_ws, &
8032	ONLY: advec_s_ws
8033
8034	USE advec_s_pw_mod, &
8035	ONLY: advec_s_pw
8036
8037	USE advec_s_up_mod, &
8038	ONLY: advec_s_up
8039
8040	USE arrays_3d, &
8041	ONLY: ddzu, rdf_sc, tend
8042
8043	USE diffusion_s_mod, &
8044	ONLY: diffusion_s
8045
8046	USE indices, &
8047	ONLY: wall_flags_total_0
8048
8049	USE surface_mod, &
8050	ONLY : surf_def_h, surf_def_v, surf_lsm_h, surf_lsm_v, surf_usm_h, surf_usm_v
8051
8052	IMPLICIT NONE
8053
8054	CHARACTER(LEN = *) :: id !<
8055
8056	INTEGER(iwp) :: i !<
8057	INTEGER(iwp) :: i_omp_start !<
8058	INTEGER(iwp) :: ib !< loop index for aerosol number bin OR gas index
8059	INTEGER(iwp) :: ic !< loop index for aerosol mass bin
8060	INTEGER(iwp) :: icc !< (c-1)*nbins_aerosol+b
8061	INTEGER(iwp) :: j !<
8062	INTEGER(iwp) :: k !<
8063	INTEGER(iwp) :: tn !<
8064
8065	LOGICAL :: do_sedimentation !<
8066
8067	REAL(wp), DIMENSION(nzb:nzt+1) :: rs_init !<
8068
8069	REAL(wp), DIMENSION(nzb+1:nzt,0:threads_per_task-1) :: diss_s !<
8070	REAL(wp), DIMENSION(nzb+1:nzt,0:threads_per_task-1) :: flux_s !<
8071
8072	REAL(wp), DIMENSION(nzb+1:nzt,nys:nyn,0:threads_per_task-1) :: diss_l !<
8073	REAL(wp), DIMENSION(nzb+1:nzt,nys:nyn,0:threads_per_task-1) :: flux_l !<
8074
8075	REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) :: rs_p !<
8076	REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) :: rs !<
8077	REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) :: trs_m !<
8078
8079	icc = ( ic - 1 ) * nbins_aerosol + ib
8080	!
8081	!-- Tendency-terms for reactive scalar
8082	tend(:,j,i) = 0.0_wp
8083	!
8084	!-- Advection terms
8085	IF ( timestep_scheme(1:5) == 'runge' ) THEN
8086	IF ( ws_scheme_sca ) THEN
8087	CALL advec_s_ws( salsa_advc_flags_s, i, j, rs, id, flux_s, diss_s, flux_l, diss_l, &
8088	i_omp_start, tn, bc_dirichlet_l .OR. bc_radiation_l, &
8089	bc_dirichlet_n .OR. bc_radiation_n, &
8090	bc_dirichlet_r .OR. bc_radiation_r, &
8091	bc_dirichlet_s .OR. bc_radiation_s, monotonic_limiter_z )
8092	ELSE
8093	CALL advec_s_pw( i, j, rs )
8094	ENDIF
8095	ELSE
8096	CALL advec_s_up( i, j, rs )
8097	ENDIF
8098	!
8099	!-- Diffusion terms
8100	SELECT CASE ( id )
8101	CASE ( 'aerosol_number' )
8102	CALL diffusion_s( i, j, rs, surf_def_h(0)%answs(:,ib), &
8103	surf_def_h(1)%answs(:,ib), surf_def_h(2)%answs(:,ib), &
8104	surf_lsm_h%answs(:,ib), surf_usm_h%answs(:,ib), &
8105	surf_def_v(0)%answs(:,ib), surf_def_v(1)%answs(:,ib), &
8106	surf_def_v(2)%answs(:,ib), surf_def_v(3)%answs(:,ib), &
8107	surf_lsm_v(0)%answs(:,ib), surf_lsm_v(1)%answs(:,ib), &
8108	surf_lsm_v(2)%answs(:,ib), surf_lsm_v(3)%answs(:,ib), &
8109	surf_usm_v(0)%answs(:,ib), surf_usm_v(1)%answs(:,ib), &
8110	surf_usm_v(2)%answs(:,ib), surf_usm_v(3)%answs(:,ib) )
8111	CASE ( 'aerosol_mass' )
8112	CALL diffusion_s( i, j, rs, surf_def_h(0)%amsws(:,icc), &
8113	surf_def_h(1)%amsws(:,icc), surf_def_h(2)%amsws(:,icc), &
8114	surf_lsm_h%amsws(:,icc), surf_usm_h%amsws(:,icc), &
8115	surf_def_v(0)%amsws(:,icc), surf_def_v(1)%amsws(:,icc), &
8116	surf_def_v(2)%amsws(:,icc), surf_def_v(3)%amsws(:,icc), &
8117	surf_lsm_v(0)%amsws(:,icc), surf_lsm_v(1)%amsws(:,icc), &
8118	surf_lsm_v(2)%amsws(:,icc), surf_lsm_v(3)%amsws(:,icc), &
8119	surf_usm_v(0)%amsws(:,icc), surf_usm_v(1)%amsws(:,icc), &
8120	surf_usm_v(2)%amsws(:,icc), surf_usm_v(3)%amsws(:,icc) )
8121	CASE ( 'salsa_gas' )
8122	CALL diffusion_s( i, j, rs, surf_def_h(0)%gtsws(:,ib), &
8123	surf_def_h(1)%gtsws(:,ib), surf_def_h(2)%gtsws(:,ib), &
8124	surf_lsm_h%gtsws(:,ib), surf_usm_h%gtsws(:,ib), &
8125	surf_def_v(0)%gtsws(:,ib), surf_def_v(1)%gtsws(:,ib), &
8126	surf_def_v(2)%gtsws(:,ib), surf_def_v(3)%gtsws(:,ib), &
8127	surf_lsm_v(0)%gtsws(:,ib), surf_lsm_v(1)%gtsws(:,ib), &
8128	surf_lsm_v(2)%gtsws(:,ib), surf_lsm_v(3)%gtsws(:,ib), &
8129	surf_usm_v(0)%gtsws(:,ib), surf_usm_v(1)%gtsws(:,ib), &
8130	surf_usm_v(2)%gtsws(:,ib), surf_usm_v(3)%gtsws(:,ib) )
8131	END SELECT
8132	!
8133	!-- Sedimentation and prognostic equation for aerosol number and mass
8134	IF ( lsdepo .AND. do_sedimentation ) THEN
8135	!DIR$ IVDEP
8136	DO k = nzb+1, nzt
8137	tend(k,j,i) = tend(k,j,i) - MAX( 0.0_wp, ( rs(k+1,j,i) * sedim_vd(k+1,j,i,ib) - &
8138	rs(k,j,i) * sedim_vd(k,j,i,ib) ) * ddzu(k) ) &
8139	* MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k-1,j,i), 0 ) )
8140	rs_p(k,j,i) = rs(k,j,i) + ( dt_3d * ( tsc(2) * tend(k,j,i) + tsc(3) * trs_m(k,j,i) ) &
8141	- tsc(5) * rdf_sc(k) * ( rs(k,j,i) - rs_init(k) ) ) &
8142	* MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) )
8143	IF ( rs_p(k,j,i) < 0.0_wp ) rs_p(k,j,i) = 0.1_wp * rs(k,j,i)
8144	ENDDO
8145	ELSE
8146	!
8147	!-- Prognostic equation
8148	!DIR$ IVDEP
8149	DO k = nzb+1, nzt
8150	rs_p(k,j,i) = rs(k,j,i) + ( dt_3d * ( tsc(2) * tend(k,j,i) + tsc(3) * trs_m(k,j,i) ) &
8151	- tsc(5) * rdf_sc(k) * ( rs(k,j,i) - rs_init(k) ) )&
8152	* MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) )
8153	IF ( rs_p(k,j,i) < 0.0_wp ) rs_p(k,j,i) = 0.1_wp * rs(k,j,i)
8154	ENDDO
8155	ENDIF
8156	!
8157	!-- Calculate tendencies for the next Runge-Kutta step
8158	IF ( timestep_scheme(1:5) == 'runge' ) THEN
8159	IF ( intermediate_timestep_count == 1 ) THEN
8160	DO k = nzb+1, nzt
8161	trs_m(k,j,i) = tend(k,j,i)
8162	ENDDO
8163	ELSEIF ( intermediate_timestep_count < intermediate_timestep_count_max ) THEN
8164	DO k = nzb+1, nzt
8165	trs_m(k,j,i) = -9.5625_wp * tend(k,j,i) + 5.3125_wp * trs_m(k,j,i)
8166	ENDDO
8167	ENDIF
8168	ENDIF
8169
8170	END SUBROUTINE salsa_tendency_ij
8171	!
8172	!------------------------------------------------------------------------------!
8173	! Description:
8174	! ------------
8175	!> Calculate the tendencies for aerosol number and mass concentrations.
8176	!> For vector machines.
8177	!------------------------------------------------------------------------------!
8178	SUBROUTINE salsa_tendency( id, rs_p, rs, trs_m, ib, ic, rs_init, do_sedimentation )
8179
8180	USE advec_ws, &
8181	ONLY: advec_s_ws
8182	USE advec_s_pw_mod, &
8183	ONLY: advec_s_pw
8184	USE advec_s_up_mod, &
8185	ONLY: advec_s_up
8186	USE arrays_3d, &
8187	ONLY: ddzu, rdf_sc, tend
8188	USE diffusion_s_mod, &
8189	ONLY: diffusion_s
8190	USE indices, &
8191	ONLY: wall_flags_total_0
8192	USE surface_mod, &
8193	ONLY : surf_def_h, surf_def_v, surf_lsm_h, surf_lsm_v, surf_usm_h, surf_usm_v
8194
8195	IMPLICIT NONE
8196
8197	CHARACTER(LEN = *) :: id
8198
8199	INTEGER(iwp) :: ib !< loop index for aerosol number bin OR gas index
8200	INTEGER(iwp) :: ic !< loop index for aerosol mass bin
8201	INTEGER(iwp) :: icc !< (c-1)*nbins_aerosol+b
8202	INTEGER(iwp) :: i !<
8203	INTEGER(iwp) :: j !<
8204	INTEGER(iwp) :: k !<
8205
8206	LOGICAL :: do_sedimentation !<
8207
8208	REAL(wp), DIMENSION(nzb:nzt+1) :: rs_init !<
8209
8210	REAL(wp), DIMENSION(:,:,:), POINTER :: rs_p !<
8211	REAL(wp), DIMENSION(:,:,:), POINTER :: rs !<
8212	REAL(wp), DIMENSION(:,:,:), POINTER :: trs_m !<
8213
8214	icc = ( ic - 1 ) * nbins_aerosol + ib
8215	!
8216	!-- Tendency-terms for reactive scalar
8217	tend = 0.0_wp
8218	!
8219	!-- Advection terms
8220	IF ( timestep_scheme(1:5) == 'runge' ) THEN
8221	IF ( ws_scheme_sca ) THEN
8222	CALL advec_s_ws( salsa_advc_flags_s, rs, id, bc_dirichlet_l .OR. bc_radiation_l, &
8223	bc_dirichlet_n .OR. bc_radiation_n, &
8224	bc_dirichlet_r .OR. bc_radiation_r, &
8225	bc_dirichlet_s .OR. bc_radiation_s )
8226	ELSE
8227	CALL advec_s_pw( rs )
8228	ENDIF
8229	ELSE
8230	CALL advec_s_up( rs )
8231	ENDIF
8232	!
8233	!-- Diffusion terms
8234	SELECT CASE ( id )
8235	CASE ( 'aerosol_number' )
8236	CALL diffusion_s( rs, surf_def_h(0)%answs(:,ib), &
8237	surf_def_h(1)%answs(:,ib), surf_def_h(2)%answs(:,ib), &
8238	surf_lsm_h%answs(:,ib), surf_usm_h%answs(:,ib), &
8239	surf_def_v(0)%answs(:,ib), surf_def_v(1)%answs(:,ib), &
8240	surf_def_v(2)%answs(:,ib), surf_def_v(3)%answs(:,ib), &
8241	surf_lsm_v(0)%answs(:,ib), surf_lsm_v(1)%answs(:,ib), &
8242	surf_lsm_v(2)%answs(:,ib), surf_lsm_v(3)%answs(:,ib), &
8243	surf_usm_v(0)%answs(:,ib), surf_usm_v(1)%answs(:,ib), &
8244	surf_usm_v(2)%answs(:,ib), surf_usm_v(3)%answs(:,ib) )
8245	CASE ( 'aerosol_mass' )
8246	CALL diffusion_s( rs, surf_def_h(0)%amsws(:,icc), &
8247	surf_def_h(1)%amsws(:,icc), surf_def_h(2)%amsws(:,icc), &
8248	surf_lsm_h%amsws(:,icc), surf_usm_h%amsws(:,icc), &
8249	surf_def_v(0)%amsws(:,icc), surf_def_v(1)%amsws(:,icc), &
8250	surf_def_v(2)%amsws(:,icc), surf_def_v(3)%amsws(:,icc), &
8251	surf_lsm_v(0)%amsws(:,icc), surf_lsm_v(1)%amsws(:,icc), &
8252	surf_lsm_v(2)%amsws(:,icc), surf_lsm_v(3)%amsws(:,icc), &
8253	surf_usm_v(0)%amsws(:,icc), surf_usm_v(1)%amsws(:,icc), &
8254	surf_usm_v(2)%amsws(:,icc), surf_usm_v(3)%amsws(:,icc) )
8255	CASE ( 'salsa_gas' )
8256	CALL diffusion_s( rs, surf_def_h(0)%gtsws(:,ib), &
8257	surf_def_h(1)%gtsws(:,ib), surf_def_h(2)%gtsws(:,ib), &
8258	surf_lsm_h%gtsws(:,ib), surf_usm_h%gtsws(:,ib), &
8259	surf_def_v(0)%gtsws(:,ib), surf_def_v(1)%gtsws(:,ib), &
8260	surf_def_v(2)%gtsws(:,ib), surf_def_v(3)%gtsws(:,ib), &
8261	surf_lsm_v(0)%gtsws(:,ib), surf_lsm_v(1)%gtsws(:,ib), &
8262	surf_lsm_v(2)%gtsws(:,ib), surf_lsm_v(3)%gtsws(:,ib), &
8263	surf_usm_v(0)%gtsws(:,ib), surf_usm_v(1)%gtsws(:,ib), &
8264	surf_usm_v(2)%gtsws(:,ib), surf_usm_v(3)%gtsws(:,ib) )
8265	END SELECT
8266	!
8267	!-- Prognostic equation for a scalar
8268	DO i = nxl, nxr
8269	DO j = nys, nyn
8270	!
8271	!-- Sedimentation for aerosol number and mass
8272	IF ( lsdepo .AND. do_sedimentation ) THEN
8273	tend(nzb+1:nzt,j,i) = tend(nzb+1:nzt,j,i) - MAX( 0.0_wp, ( rs(nzb+2:nzt+1,j,i) * &
8274	sedim_vd(nzb+2:nzt+1,j,i,ib) - rs(nzb+1:nzt,j,i) * &
8275	sedim_vd(nzb+1:nzt,j,i,ib) ) * ddzu(nzb+1:nzt) ) * &
8276	MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(nzb:nzt-1,j,i), 0 ) )
8277	ENDIF
8278	DO k = nzb+1, nzt
8279	rs_p(k,j,i) = rs(k,j,i) + ( dt_3d * ( tsc(2) * tend(k,j,i) + tsc(3) * trs_m(k,j,i) )&
8280	- tsc(5) * rdf_sc(k) * ( rs(k,j,i) - rs_init(k) )&
8281	) * MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) )
8282	IF ( rs_p(k,j,i) < 0.0_wp ) rs_p(k,j,i) = 0.1_wp * rs(k,j,i)
8283	ENDDO
8284	ENDDO
8285	ENDDO
8286	!
8287	!-- Calculate tendencies for the next Runge-Kutta step
8288	IF ( timestep_scheme(1:5) == 'runge' ) THEN
8289	IF ( intermediate_timestep_count == 1 ) THEN
8290	DO i = nxl, nxr
8291	DO j = nys, nyn
8292	DO k = nzb+1, nzt
8293	trs_m(k,j,i) = tend(k,j,i)
8294	ENDDO
8295	ENDDO
8296	ENDDO
8297	ELSEIF ( intermediate_timestep_count < intermediate_timestep_count_max ) THEN
8298	DO i = nxl, nxr
8299	DO j = nys, nyn
8300	DO k = nzb+1, nzt
8301	trs_m(k,j,i) = -9.5625_wp * tend(k,j,i) + 5.3125_wp * trs_m(k,j,i)
8302	ENDDO
8303	ENDDO
8304	ENDDO
8305	ENDIF
8306	ENDIF
8307
8308	END SUBROUTINE salsa_tendency
8309
8310
8311	!------------------------------------------------------------------------------!
8312	! Description:
8313	! ------------
8314	!> Boundary conditions for prognostic variables in SALSA from module interface
8315	!------------------------------------------------------------------------------!
8316	SUBROUTINE salsa_boundary_conditions
8317
8318	IMPLICIT NONE
8319
8320	INTEGER(iwp) :: ib !< index for aerosol size bins
8321	INTEGER(iwp) :: ic !< index for aerosol mass bins
8322	INTEGER(iwp) :: icc !< additional index for aerosol mass bins
8323	INTEGER(iwp) :: ig !< index for salsa gases
8324
8325
8326	!
8327	!-- moved from boundary_conds
8328	CALL salsa_boundary_conds
8329	!
8330	!-- Boundary conditions for prognostic quantitites of other modules:
8331	!-- Here, only decycling is carried out
8332	IF ( time_since_reference_point >= skip_time_do_salsa ) THEN
8333
8334	DO ib = 1, nbins_aerosol
8335	CALL salsa_boundary_conds( aerosol_number(ib)%conc_p, aerosol_number(ib)%init )
8336	DO ic = 1, ncomponents_mass
8337	icc = ( ic - 1 ) * nbins_aerosol + ib
8338	CALL salsa_boundary_conds( aerosol_mass(icc)%conc_p, aerosol_mass(icc)%init )
8339	ENDDO
8340	ENDDO
8341	IF ( .NOT. salsa_gases_from_chem ) THEN
8342	DO ig = 1, ngases_salsa
8343	CALL salsa_boundary_conds( salsa_gas(ig)%conc_p, salsa_gas(ig)%init )
8344	ENDDO
8345	ENDIF
8346
8347	ENDIF
8348
8349	END SUBROUTINE salsa_boundary_conditions
8350
8351	!------------------------------------------------------------------------------!
8352	! Description:
8353	! ------------
8354	!> Boundary conditions for prognostic variables in SALSA
8355	!------------------------------------------------------------------------------!
8356	SUBROUTINE salsa_boundary_conds
8357
8358	USE arrays_3d, &
8359	ONLY: dzu
8360
8361	USE surface_mod, &
8362	ONLY : bc_h
8363
8364	IMPLICIT NONE
8365
8366	INTEGER(iwp) :: i !< grid index x direction
8367	INTEGER(iwp) :: ib !< index for aerosol size bins
8368	INTEGER(iwp) :: ic !< index for chemical compounds in aerosols
8369	INTEGER(iwp) :: icc !< additional index for chemical compounds in aerosols
8370	INTEGER(iwp) :: ig !< idex for gaseous compounds
8371	INTEGER(iwp) :: j !< grid index y direction
8372	INTEGER(iwp) :: k !< grid index y direction
8373	INTEGER(iwp) :: l !< running index boundary type, for up- and downward-facing walls
8374	INTEGER(iwp) :: m !< running index surface elements
8375
8376	IF ( time_since_reference_point >= skip_time_do_salsa ) THEN
8377	!
8378	!-- Surface conditions:
8379	IF ( ibc_salsa_b == 0 ) THEN ! Dirichlet
8380	!
8381	!-- Run loop over all non-natural and natural walls. Note, in wall-datatype the k coordinate
8382	!-- belongs to the atmospheric grid point, therefore, set s_p at k-1
8383	DO l = 0, 1
8384	!$OMP PARALLEL PRIVATE( ib, ic, icc, ig, i, j, k )
8385	!$OMP DO
8386	DO m = 1, bc_h(l)%ns
8387
8388	i = bc_h(l)%i(m)
8389	j = bc_h(l)%j(m)
8390	k = bc_h(l)%k(m)
8391
8392	DO ib = 1, nbins_aerosol
8393	aerosol_number(ib)%conc_p(k+bc_h(l)%koff,j,i) = &
8394	aerosol_number(ib)%conc(k+bc_h(l)%koff,j,i)
8395	DO ic = 1, ncomponents_mass
8396	icc = ( ic - 1 ) * nbins_aerosol + ib
8397	aerosol_mass(icc)%conc_p(k+bc_h(l)%koff,j,i) = &
8398	aerosol_mass(icc)%conc(k+bc_h(l)%koff,j,i)
8399	ENDDO
8400	ENDDO
8401	IF ( .NOT. salsa_gases_from_chem ) THEN
8402	DO ig = 1, ngases_salsa
8403	salsa_gas(ig)%conc_p(k+bc_h(l)%koff,j,i) = &
8404	salsa_gas(ig)%conc(k+bc_h(l)%koff,j,i)
8405	ENDDO
8406	ENDIF
8407
8408	ENDDO
8409	!$OMP END PARALLEL
8410
8411	ENDDO
8412
8413	ELSE ! Neumann
8414
8415	DO l = 0, 1
8416	!$OMP PARALLEL PRIVATE( ib, ic, icc, ig, i, j, k )
8417	!$OMP DO
8418	DO m = 1, bc_h(l)%ns
8419
8420	i = bc_h(l)%i(m)
8421	j = bc_h(l)%j(m)
8422	k = bc_h(l)%k(m)
8423
8424	DO ib = 1, nbins_aerosol
8425	aerosol_number(ib)%conc_p(k+bc_h(l)%koff,j,i) = &
8426	aerosol_number(ib)%conc_p(k,j,i)
8427	DO ic = 1, ncomponents_mass
8428	icc = ( ic - 1 ) * nbins_aerosol + ib
8429	aerosol_mass(icc)%conc_p(k+bc_h(l)%koff,j,i) = &
8430	aerosol_mass(icc)%conc_p(k,j,i)
8431	ENDDO
8432	ENDDO
8433	IF ( .NOT. salsa_gases_from_chem ) THEN
8434	DO ig = 1, ngases_salsa
8435	salsa_gas(ig)%conc_p(k+bc_h(l)%koff,j,i) = &
8436	salsa_gas(ig)%conc_p(k,j,i)
8437	ENDDO
8438	ENDIF
8439
8440	ENDDO
8441	!$OMP END PARALLEL
8442	ENDDO
8443
8444	ENDIF
8445	!
8446	!-- Top boundary conditions:
8447	IF ( ibc_salsa_t == 0 ) THEN ! Dirichlet
8448
8449	DO ib = 1, nbins_aerosol
8450	aerosol_number(ib)%conc_p(nzt+1,:,:) = aerosol_number(ib)%conc(nzt+1,:,:)
8451	DO ic = 1, ncomponents_mass
8452	icc = ( ic - 1 ) * nbins_aerosol + ib
8453	aerosol_mass(icc)%conc_p(nzt+1,:,:) = aerosol_mass(icc)%conc(nzt+1,:,:)
8454	ENDDO
8455	ENDDO
8456	IF ( .NOT. salsa_gases_from_chem ) THEN
8457	DO ig = 1, ngases_salsa
8458	salsa_gas(ig)%conc_p(nzt+1,:,:) = salsa_gas(ig)%conc(nzt+1,:,:)
8459	ENDDO
8460	ENDIF
8461
8462	ELSEIF ( ibc_salsa_t == 1 ) THEN ! Neumann
8463
8464	DO ib = 1, nbins_aerosol
8465	aerosol_number(ib)%conc_p(nzt+1,:,:) = aerosol_number(ib)%conc_p(nzt,:,:)
8466	DO ic = 1, ncomponents_mass
8467	icc = ( ic - 1 ) * nbins_aerosol + ib
8468	aerosol_mass(icc)%conc_p(nzt+1,:,:) = aerosol_mass(icc)%conc_p(nzt,:,:)
8469	ENDDO
8470	ENDDO
8471	IF ( .NOT. salsa_gases_from_chem ) THEN
8472	DO ig = 1, ngases_salsa
8473	salsa_gas(ig)%conc_p(nzt+1,:,:) = salsa_gas(ig)%conc_p(nzt,:,:)
8474	ENDDO
8475	ENDIF
8476
8477	ELSEIF ( ibc_salsa_t == 2 ) THEN ! Initial gradient
8478
8479	DO ib = 1, nbins_aerosol
8480	aerosol_number(ib)%conc_p(nzt+1,:,:) = aerosol_number(ib)%conc_p(nzt,:,:) + &
8481	bc_an_t_val(ib) * dzu(nzt+1)
8482	DO ic = 1, ncomponents_mass
8483	icc = ( ic - 1 ) * nbins_aerosol + ib
8484	aerosol_mass(icc)%conc_p(nzt+1,:,:) = aerosol_mass(icc)%conc_p(nzt,:,:) + &
8485	bc_am_t_val(icc) * dzu(nzt+1)
8486	ENDDO
8487	ENDDO
8488	IF ( .NOT. salsa_gases_from_chem ) THEN
8489	DO ig = 1, ngases_salsa
8490	salsa_gas(ig)%conc_p(nzt+1,:,:) = salsa_gas(ig)%conc_p(nzt,:,:) + &
8491	bc_gt_t_val(ig) * dzu(nzt+1)
8492	ENDDO
8493	ENDIF
8494
8495	ENDIF
8496	!
8497	!-- Lateral boundary conditions at the outflow
8498	IF ( bc_radiation_s ) THEN
8499	DO ib = 1, nbins_aerosol
8500	aerosol_number(ib)%conc_p(:,nys-1,:) = aerosol_number(ib)%conc_p(:,nys,:)
8501	DO ic = 1, ncomponents_mass
8502	icc = ( ic - 1 ) * nbins_aerosol + ib
8503	aerosol_mass(icc)%conc_p(:,nys-1,:) = aerosol_mass(icc)%conc_p(:,nys,:)
8504	ENDDO
8505	ENDDO
8506	IF ( .NOT. salsa_gases_from_chem ) THEN
8507	DO ig = 1, ngases_salsa
8508	salsa_gas(ig)%conc_p(:,nys-1,:) = salsa_gas(ig)%conc_p(:,nys,:)
8509	ENDDO
8510	ENDIF
8511
8512	ELSEIF ( bc_radiation_n ) THEN
8513	DO ib = 1, nbins_aerosol
8514	aerosol_number(ib)%conc_p(:,nyn+1,:) = aerosol_number(ib)%conc_p(:,nyn,:)
8515	DO ic = 1, ncomponents_mass
8516	icc = ( ic - 1 ) * nbins_aerosol + ib
8517	aerosol_mass(icc)%conc_p(:,nyn+1,:) = aerosol_mass(icc)%conc_p(:,nyn,:)
8518	ENDDO
8519	ENDDO
8520	IF ( .NOT. salsa_gases_from_chem ) THEN
8521	DO ig = 1, ngases_salsa
8522	salsa_gas(ig)%conc_p(:,nyn+1,:) = salsa_gas(ig)%conc_p(:,nyn,:)
8523	ENDDO
8524	ENDIF
8525
8526	ELSEIF ( bc_radiation_l ) THEN
8527	DO ib = 1, nbins_aerosol
8528	aerosol_number(ib)%conc_p(:,:,nxl-1) = aerosol_number(ib)%conc_p(:,:,nxl)
8529	DO ic = 1, ncomponents_mass
8530	icc = ( ic - 1 ) * nbins_aerosol + ib
8531	aerosol_mass(icc)%conc_p(:,:,nxl-1) = aerosol_mass(icc)%conc_p(:,:,nxl)
8532	ENDDO
8533	ENDDO
8534	IF ( .NOT. salsa_gases_from_chem ) THEN
8535	DO ig = 1, ngases_salsa
8536	salsa_gas(ig)%conc_p(:,:,nxl-1) = salsa_gas(ig)%conc_p(:,:,nxl)
8537	ENDDO
8538	ENDIF
8539
8540	ELSEIF ( bc_radiation_r ) THEN
8541	DO ib = 1, nbins_aerosol
8542	aerosol_number(ib)%conc_p(:,:,nxr+1) = aerosol_number(ib)%conc_p(:,:,nxr)
8543	DO ic = 1, ncomponents_mass
8544	icc = ( ic - 1 ) * nbins_aerosol + ib
8545	aerosol_mass(icc)%conc_p(:,:,nxr+1) = aerosol_mass(icc)%conc_p(:,:,nxr)
8546	ENDDO
8547	ENDDO
8548	IF ( .NOT. salsa_gases_from_chem ) THEN
8549	DO ig = 1, ngases_salsa
8550	salsa_gas(ig)%conc_p(:,:,nxr+1) = salsa_gas(ig)%conc_p(:,:,nxr)
8551	ENDDO
8552	ENDIF
8553
8554	ENDIF
8555
8556	ENDIF
8557
8558	END SUBROUTINE salsa_boundary_conds
8559
8560	!------------------------------------------------------------------------------!
8561	! Description:
8562	! ------------
8563	! Undoing of the previously done cyclic boundary conditions.
8564	!------------------------------------------------------------------------------!
8565	SUBROUTINE salsa_boundary_conds_decycle ( sq, sq_init )
8566
8567	USE control_parameters, &
8568	ONLY: nesting_offline
8569
8570	IMPLICIT NONE
8571
8572	INTEGER(iwp) :: boundary !<
8573	INTEGER(iwp) :: ee !<
8574	INTEGER(iwp) :: copied !<
8575	INTEGER(iwp) :: i !<
8576	INTEGER(iwp) :: j !<
8577	INTEGER(iwp) :: k !<
8578	INTEGER(iwp) :: ss !<
8579
8580	REAL(wp) :: flag !< flag to mask topography grid points
8581
8582	REAL(wp), DIMENSION(nzb:nzt+1) :: sq_init !< initial concentration profile
8583
8584	REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) :: sq !< concentration array
8585
8586	flag = 0.0_wp
8587	!
8588	!-- Skip input if forcing from a larger-scale models is applied.
8589	IF ( nesting_offline .AND. nesting_offline_salsa ) RETURN
8590	!
8591	!-- Left and right boundaries
8592	IF ( decycle_salsa_lr .AND. ( bc_lr_cyc .OR. bc_lr == 'nested' ) ) THEN
8593
8594	DO boundary = 1, 2
8595
8596	IF ( decycle_method_salsa(boundary) == 'dirichlet' ) THEN
8597	!
8598	!-- Initial profile is copied to ghost and first three layers
8599	ss = 1
8600	ee = 0
8601	IF ( boundary == 1 .AND. nxl == 0 ) THEN
8602	ss = nxlg
8603	ee = nxl-1
8604	ELSEIF ( boundary == 2 .AND. nxr == nx ) THEN
8605	ss = nxr+1
8606	ee = nxrg
8607	ENDIF
8608
8609	DO i = ss, ee
8610	DO j = nysg, nyng
8611	DO k = nzb+1, nzt
8612	flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) )
8613	sq(k,j,i) = sq_init(k) * flag
8614	ENDDO
8615	ENDDO
8616	ENDDO
8617
8618	ELSEIF ( decycle_method_salsa(boundary) == 'neumann' ) THEN
8619	!
8620	!-- The value at the boundary is copied to the ghost layers to simulate an outlet with
8621	!-- zero gradient
8622	ss = 1
8623	ee = 0
8624	IF ( boundary == 1 .AND. nxl == 0 ) THEN
8625	ss = nxlg
8626	ee = nxl-1
8627	copied = nxl
8628	ELSEIF ( boundary == 2 .AND. nxr == nx ) THEN
8629	ss = nxr+1
8630	ee = nxrg
8631	copied = nxr
8632	ENDIF
8633
8634	DO i = ss, ee
8635	DO j = nysg, nyng
8636	DO k = nzb+1, nzt
8637	flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) )
8638	sq(k,j,i) = sq(k,j,copied) * flag
8639	ENDDO
8640	ENDDO
8641	ENDDO
8642
8643	ELSE
8644	WRITE(message_string,*) 'unknown decycling method: decycle_method_salsa (', boundary, &
8645	') ="' // TRIM( decycle_method_salsa(boundary) ) // '"'
8646	CALL message( 'salsa_boundary_conds_decycle', 'PA0626', 1, 2, 0, 6, 0 )
8647	ENDIF
8648	ENDDO
8649	ENDIF
8650
8651	!
8652	!-- South and north boundaries
8653	IF ( decycle_salsa_ns .AND. ( bc_ns_cyc .OR. bc_ns == 'nested' ) ) THEN
8654
8655	DO boundary = 3, 4
8656
8657	IF ( decycle_method_salsa(boundary) == 'dirichlet' ) THEN
8658	!
8659	!-- Initial profile is copied to ghost and first three layers
8660	ss = 1
8661	ee = 0
8662	IF ( boundary == 3 .AND. nys == 0 ) THEN
8663	ss = nysg
8664	ee = nys-1
8665	ELSEIF ( boundary == 4 .AND. nyn == ny ) THEN
8666	ss = nyn+1
8667	ee = nyng
8668	ENDIF
8669
8670	DO i = nxlg, nxrg
8671	DO j = ss, ee
8672	DO k = nzb+1, nzt
8673	flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) )
8674	sq(k,j,i) = sq_init(k) * flag
8675	ENDDO
8676	ENDDO
8677	ENDDO
8678
8679	ELSEIF ( decycle_method_salsa(boundary) == 'neumann' ) THEN
8680	!
8681	!-- The value at the boundary is copied to the ghost layers to simulate an outlet with
8682	!-- zero gradient
8683	ss = 1
8684	ee = 0
8685	IF ( boundary == 3 .AND. nys == 0 ) THEN
8686	ss = nysg
8687	ee = nys-1
8688	copied = nys
8689	ELSEIF ( boundary == 4 .AND. nyn == ny ) THEN
8690	ss = nyn+1
8691	ee = nyng
8692	copied = nyn
8693	ENDIF
8694
8695	DO i = nxlg, nxrg
8696	DO j = ss, ee
8697	DO k = nzb+1, nzt
8698	flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) )
8699	sq(k,j,i) = sq(k,copied,i) * flag
8700	ENDDO
8701	ENDDO
8702	ENDDO
8703
8704	ELSE
8705	WRITE(message_string,*) 'unknown decycling method: decycle_method_salsa (', boundary, &
8706	') ="' // TRIM( decycle_method_salsa(boundary) ) // '"'
8707	CALL message( 'salsa_boundary_conds_decycle', 'PA0627', 1, 2, 0, 6, 0 )
8708	ENDIF
8709	ENDDO
8710	ENDIF
8711
8712	END SUBROUTINE salsa_boundary_conds_decycle
8713
8714	!------------------------------------------------------------------------------!
8715	! Description:
8716	! ------------
8717	!> Calculates the total dry or wet mass concentration for individual bins
8718	!> Juha Tonttila (FMI) 2015
8719	!> Tomi Raatikainen (FMI) 2016
8720	!------------------------------------------------------------------------------!
8721	SUBROUTINE bin_mixrat( itype, ibin, i, j, mconc )
8722
8723	IMPLICIT NONE
8724
8725	CHARACTER(len=*), INTENT(in) :: itype !< 'dry' or 'wet'
8726
8727	INTEGER(iwp) :: ic !< loop index for mass bin number
8728	INTEGER(iwp) :: iend !< end index: include water or not
8729
8730	INTEGER(iwp), INTENT(in) :: ibin !< index of the chemical component
8731	INTEGER(iwp), INTENT(in) :: i !< loop index for x-direction
8732	INTEGER(iwp), INTENT(in) :: j !< loop index for y-direction
8733
8734	REAL(wp), DIMENSION(:), INTENT(out) :: mconc !< total dry or wet mass concentration
8735
8736	!-- Number of components
8737	IF ( itype == 'dry' ) THEN
8738	iend = prtcl%ncomp - 1
8739	ELSE IF ( itype == 'wet' ) THEN
8740	iend = prtcl%ncomp
8741	ELSE
8742	message_string = 'Error in itype!'
8743	CALL message( 'bin_mixrat', 'PA0628', 2, 2, 0, 6, 0 )
8744	ENDIF
8745
8746	mconc = 0.0_wp
8747
8748	DO ic = ibin, iend*nbins_aerosol+ibin, nbins_aerosol !< every nbins'th element
8749	mconc = mconc + aerosol_mass(ic)%conc(:,j,i)
8750	ENDDO
8751
8752	END SUBROUTINE bin_mixrat
8753
8754	!------------------------------------------------------------------------------!
8755	! Description:
8756	! ------------
8757	!> Sets surface fluxes
8758	!------------------------------------------------------------------------------!
8759	SUBROUTINE salsa_emission_update
8760
8761	IMPLICIT NONE
8762
8763	IF ( include_emission ) THEN
8764
8765	IF ( time_since_reference_point >= skip_time_do_salsa ) THEN
8766
8767	IF ( next_aero_emission_update <= &
8768	MAX( time_since_reference_point, 0.0_wp ) ) THEN
8769	CALL salsa_emission_setup( .FALSE. )
8770	ENDIF
8771
8772	IF ( next_gas_emission_update <= &
8773	MAX( time_since_reference_point, 0.0_wp ) ) THEN
8774	IF ( salsa_emission_mode == 'read_from_file' .AND. .NOT. salsa_gases_from_chem ) &
8775	THEN
8776	CALL salsa_gas_emission_setup( .FALSE. )
8777	ENDIF
8778	ENDIF
8779
8780	ENDIF
8781	ENDIF
8782
8783	END SUBROUTINE salsa_emission_update
8784
8785	!------------------------------------------------------------------------------!
8786	!> Description:
8787	!> ------------
8788	!> Define aerosol fluxes: constant or read from a from file
8789	!> @todo - Emission stack height is not used yet. For default mode, emissions
8790	!> are assumed to occur on upward facing horizontal surfaces.
8791	!------------------------------------------------------------------------------!
8792	SUBROUTINE salsa_emission_setup( init )
8793
8794	USE control_parameters, &
8795	ONLY: end_time, spinup_time
8796
8797	USE netcdf_data_input_mod, &
8798	ONLY: check_existence, close_input_file, get_attribute, get_variable, &
8799	inquire_num_variables, inquire_variable_names, &
8800	get_dimension_length, open_read_file, street_type_f
8801
8802	USE palm_date_time_mod, &
8803	ONLY: days_per_week, get_date_time, hours_per_day, months_per_year, seconds_per_hour
8804
8805	USE surface_mod, &
8806	ONLY: surf_def_h, surf_lsm_h, surf_usm_h
8807
8808	IMPLICIT NONE
8809
8810	CHARACTER(LEN=80) :: daytype = 'workday' !< default day type
8811	CHARACTER(LEN=25) :: in_name !< name of a gas in the input file
8812	CHARACTER(LEN=25) :: mod_name !< name in the input file
8813
8814	INTEGER(iwp) :: day_of_month !< day of the month
8815	INTEGER(iwp) :: day_of_week !< day of the week
8816	INTEGER(iwp) :: day_of_year !< day of the year
8817	INTEGER(iwp) :: hour_of_day !< hour of the day
8818	INTEGER(iwp) :: i !< loop index
8819	INTEGER(iwp) :: ib !< loop index: aerosol number bins
8820	INTEGER(iwp) :: ic !< loop index: aerosol chemical components
8821	INTEGER(iwp) :: id_salsa !< NetCDF id of aerosol emission input file
8822	INTEGER(iwp) :: in !< loop index: emission category
8823	INTEGER(iwp) :: index_dd !< index day
8824	INTEGER(iwp) :: index_hh !< index hour
8825	INTEGER(iwp) :: index_mm !< index month
8826	INTEGER(iwp) :: inn !< loop index
8827	INTEGER(iwp) :: j !< loop index
8828	INTEGER(iwp) :: month_of_year !< month of the year
8829	INTEGER(iwp) :: ss !< loop index
8830
8831	INTEGER(iwp), DIMENSION(maxspec) :: cc_i2m !<
8832
8833	LOGICAL :: netcdf_extend = .FALSE. !< NetCDF input file exists
8834
8835	LOGICAL, INTENT(in) :: init !< if .TRUE. --> initialisation call
8836
8837	REAL(wp) :: second_of_day !< second of the day
8838
8839	REAL(wp), DIMENSION(24) :: par_emis_time_factor = & !< time factors for the parameterized mode
8840	(/ 0.009, 0.004, 0.004, 0.009, 0.029, 0.039, &
8841	0.056, 0.053, 0.051, 0.051, 0.052, 0.055, &
8842	0.059, 0.061, 0.064, 0.067, 0.069, 0.069, &
8843	0.049, 0.039, 0.039, 0.029, 0.024, 0.019 /)
8844
8845	REAL(wp), DIMENSION(:), ALLOCATABLE :: nsect_emission !< sectional number emission
8846
8847	REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: source_array !< temporary source array
8848
8849	!
8850	!-- Define emissions:
8851	SELECT CASE ( salsa_emission_mode )
8852
8853	CASE ( 'uniform', 'parameterized' )
8854
8855	IF ( init ) THEN ! Do only once
8856	!
8857	!- Form a sectional size distribution for the emissions
8858	ALLOCATE( nsect_emission(1:nbins_aerosol), &
8859	source_array(nys:nyn,nxl:nxr,1:nbins_aerosol) )
8860	!
8861	!-- Precalculate a size distribution for the emission based on the mean diameter, standard
8862	!-- deviation and number concentration per each log-normal mode
8863	CALL size_distribution( surface_aerosol_flux, aerosol_flux_dpg, aerosol_flux_sigmag, &
8864	nsect_emission )
8865	IF ( salsa_emission_mode == 'uniform' ) THEN
8866	DO ib = 1, nbins_aerosol
8867	source_array(:,:,ib) = nsect_emission(ib)
8868	ENDDO
8869	ELSE
8870	!
8871	!-- Get a time factor for the specific hour
8872	IF ( .NOT. ALLOCATED( aero_emission_att%time_factor ) ) &
8873	ALLOCATE( aero_emission_att%time_factor(1) )
8874	CALL get_date_time( MAX( time_since_reference_point, 0.0_wp ), hour=hour_of_day )
8875	index_hh = hour_of_day
8876	aero_emission_att%time_factor(1) = par_emis_time_factor(index_hh+1)
8877
8878	IF ( street_type_f%from_file ) THEN
8879	DO i = nxl, nxr
8880	DO j = nys, nyn
8881	IF ( street_type_f%var(j,i) >= main_street_id .AND. &
8882	street_type_f%var(j,i) < max_street_id ) THEN
8883	source_array(j,i,:) = nsect_emission(:) * emiss_factor_main * &
8884	aero_emission_att%time_factor(1)
8885	ELSEIF ( street_type_f%var(j,i) >= side_street_id .AND. &
8886	street_type_f%var(j,i) < main_street_id ) THEN
8887	source_array(j,i,:) = nsect_emission(:) * emiss_factor_side * &
8888	aero_emission_att%time_factor(1)
8889	ENDIF
8890	ENDDO
8891	ENDDO
8892	ELSE
8893	WRITE( message_string, * ) 'salsa_emission_mode = "parameterized" but the '// &
8894	'street_type data is missing.'
8895	CALL message( 'salsa_emission_setup', 'PA0695', 1, 2, 0, 6, 0 )
8896	ENDIF
8897	ENDIF
8898	!
8899	!-- Check which chemical components are used
8900	cc_i2m = 0
8901	IF ( index_so4 > 0 ) cc_i2m(1) = index_so4
8902	IF ( index_oc > 0 ) cc_i2m(2) = index_oc
8903	IF ( index_bc > 0 ) cc_i2m(3) = index_bc
8904	IF ( index_du > 0 ) cc_i2m(4) = index_du
8905	IF ( index_ss > 0 ) cc_i2m(5) = index_ss
8906	IF ( index_no > 0 ) cc_i2m(6) = index_no
8907	IF ( index_nh > 0 ) cc_i2m(7) = index_nh
8908	!
8909	!-- Normalise mass fractions so that their sum is 1
8910	aerosol_flux_mass_fracs_a = aerosol_flux_mass_fracs_a / &
8911	SUM( aerosol_flux_mass_fracs_a(1:ncc ) )
8912	IF ( salsa_emission_mode == 'uniform' ) THEN
8913	!
8914	!-- Set uniform fluxes of default horizontal surfaces
8915	CALL set_flux( surf_def_h(0), cc_i2m, aerosol_flux_mass_fracs_a, source_array )
8916	ELSE
8917	!
8918	!-- Set fluxes normalised based on the street type on land surfaces
8919	CALL set_flux( surf_lsm_h, cc_i2m, aerosol_flux_mass_fracs_a, source_array )
8920	ENDIF
8921
8922	DEALLOCATE( nsect_emission, source_array )
8923	ENDIF
8924
8925	CASE ( 'read_from_file' )
8926	!
8927	!-- Reset surface fluxes
8928	surf_def_h(0)%answs = 0.0_wp
8929	surf_def_h(0)%amsws = 0.0_wp
8930	surf_lsm_h%answs = 0.0_wp
8931	surf_lsm_h%amsws = 0.0_wp
8932	surf_usm_h%answs = 0.0_wp
8933	surf_usm_h%amsws = 0.0_wp
8934
8935	!
8936	!-- Reset source arrays:
8937	DO ib = 1, nbins_aerosol
8938	aerosol_number(ib)%source = 0.0_wp
8939	ENDDO
8940
8941	DO ic = 1, ncomponents_mass * nbins_aerosol
8942	aerosol_mass(ic)%source = 0.0_wp
8943	ENDDO
8944
8945	#if defined( __netcdf )
8946	!
8947	!-- Check existence of PIDS_SALSA file
8948	INQUIRE( FILE = TRIM( input_file_salsa ) // TRIM( coupling_char ), EXIST = netcdf_extend )
8949	IF ( .NOT. netcdf_extend ) THEN
8950	message_string = 'Input file '// TRIM( input_file_salsa ) // TRIM( coupling_char )&
8951	// ' missing!'
8952	CALL message( 'salsa_emission_setup', 'PA0629', 1, 2, 0, 6, 0 )
8953	ENDIF
8954	!
8955	!-- Open file in read-only mode
8956	CALL open_read_file( TRIM( input_file_salsa ) // TRIM( coupling_char ), id_salsa )
8957
8958	IF ( init ) THEN
8959	!
8960	!-- Variable names
8961	CALL inquire_num_variables( id_salsa, aero_emission_att%num_vars )
8962	ALLOCATE( aero_emission_att%var_names(1:aero_emission_att%num_vars) )
8963	CALL inquire_variable_names( id_salsa, aero_emission_att%var_names )
8964	!
8965	!-- Read the index and name of chemical components
8966	CALL get_dimension_length( id_salsa, aero_emission_att%ncc, 'composition_index' )
8967	ALLOCATE( aero_emission_att%cc_index(1:aero_emission_att%ncc) )
8968	CALL get_variable( id_salsa, 'composition_index', aero_emission_att%cc_index )
8969
8970	IF ( check_existence( aero_emission_att%var_names, 'composition_name' ) ) THEN
8971	CALL get_variable( id_salsa, 'composition_name', aero_emission_att%cc_name, &
8972	aero_emission_att%ncc )
8973	ELSE
8974	message_string = 'Missing composition_name in ' // TRIM( input_file_salsa )
8975	CALL message( 'salsa_emission_setup', 'PA0657', 1, 2, 0, 6, 0 )
8976	ENDIF
8977	!
8978	!-- Find the corresponding chemical components in the model
8979	aero_emission_att%cc_in2mod = 0
8980	DO ic = 1, aero_emission_att%ncc
8981	in_name = aero_emission_att%cc_name(ic)
8982	SELECT CASE ( TRIM( in_name ) )
8983	CASE ( 'H2SO4', 'h2so4', 'SO4', 'so4' )
8984	aero_emission_att%cc_in2mod(1) = ic
8985	CASE ( 'OC', 'oc', 'organics' )
8986	aero_emission_att%cc_in2mod(2) = ic
8987	CASE ( 'BC', 'bc' )
8988	aero_emission_att%cc_in2mod(3) = ic
8989	CASE ( 'DU', 'du' )
8990	aero_emission_att%cc_in2mod(4) = ic
8991	CASE ( 'SS', 'ss' )
8992	aero_emission_att%cc_in2mod(5) = ic
8993	CASE ( 'HNO3', 'hno3', 'NO', 'no', 'NO3', 'no3' )
8994	aero_emission_att%cc_in2mod(6) = ic
8995	CASE ( 'NH3', 'nh3', 'NH', 'nh', 'NH4', 'nh4' )
8996	aero_emission_att%cc_in2mod(7) = ic
8997	END SELECT
8998
8999	ENDDO
9000
9001	IF ( SUM( aero_emission_att%cc_in2mod ) == 0 ) THEN
9002	message_string = 'None of the aerosol chemical components in ' // TRIM( &
9003	input_file_salsa ) // ' correspond to the ones applied in SALSA.'
9004	CALL message( 'salsa_emission_setup', 'PA0630', 1, 2, 0, 6, 0 )
9005	ENDIF
9006	!
9007	!-- Get number of emission categories
9008	CALL get_dimension_length( id_salsa, aero_emission_att%ncat, 'ncat' )
9009	!
9010	!-- Get the chemical composition (i.e. mass fraction of different species) in aerosols
9011	IF ( check_existence( aero_emission_att%var_names, 'emission_mass_fracs' ) ) THEN
9012	ALLOCATE( aero_emission%mass_fracs(1:aero_emission_att%ncat, &
9013	1:aero_emission_att%ncc) )
9014	CALL get_variable( id_salsa, 'emission_mass_fracs', aero_emission%mass_fracs, &
9015	0, aero_emission_att%ncc-1, 0, aero_emission_att%ncat-1 )
9016	ELSE
9017	message_string = 'Missing emission_mass_fracs in ' // TRIM( input_file_salsa )
9018	CALL message( 'salsa_emission_setup', 'PA0694', 1, 2, 0, 6, 0 )
9019	ENDIF
9020	!
9021	!-- If the chemical component is not activated, set its mass fraction to 0 to avoid
9022	!-- inbalance between number and mass flux
9023	cc_i2m = aero_emission_att%cc_in2mod
9024	IF ( index_so4 < 0 .AND. cc_i2m(1) > 0 ) &
9025	aero_emission%mass_fracs(:,cc_i2m(1)) = 0.0_wp
9026	IF ( index_oc < 0 .AND. cc_i2m(2) > 0 ) &
9027	aero_emission%mass_fracs(:,cc_i2m(2)) = 0.0_wp
9028	IF ( index_bc < 0 .AND. cc_i2m(3) > 0 ) &
9029	aero_emission%mass_fracs(:,cc_i2m(3)) = 0.0_wp
9030	IF ( index_du < 0 .AND. cc_i2m(4) > 0 ) &
9031	aero_emission%mass_fracs(:,cc_i2m(4)) = 0.0_wp
9032	IF ( index_ss < 0 .AND. cc_i2m(5) > 0 ) &
9033	aero_emission%mass_fracs(:,cc_i2m(5)) = 0.0_wp
9034	IF ( index_no < 0 .AND. cc_i2m(6) > 0 ) &
9035	aero_emission%mass_fracs(:,cc_i2m(6)) = 0.0_wp
9036	IF ( index_nh < 0 .AND. cc_i2m(7) > 0 ) &
9037	aero_emission%mass_fracs(:,cc_i2m(7)) = 0.0_wp
9038	!
9039	!-- Then normalise the mass fraction so that SUM = 1
9040	DO in = 1, aero_emission_att%ncat
9041	aero_emission%mass_fracs(in,:) = aero_emission%mass_fracs(in,:) / &
9042	SUM( aero_emission%mass_fracs(in,:) )
9043	ENDDO
9044	!
9045	!-- Inquire the fill value
9046	CALL get_attribute( id_salsa, '_FillValue', aero_emission%fill, .FALSE., &
9047	'aerosol_emission_values' )
9048	!
9049	!-- Inquire units of emissions
9050	CALL get_attribute( id_salsa, 'units', aero_emission_att%units, .FALSE., &
9051	'aerosol_emission_values' )
9052	!
9053	!-- Inquire the level of detail (lod)
9054	CALL get_attribute( id_salsa, 'lod', aero_emission_att%lod, .FALSE., &
9055	'aerosol_emission_values' )
9056
9057	!
9058	!-- Read different emission information depending on the level of detail of emissions:
9059
9060	!
9061	!-- Default mode:
9062	IF ( aero_emission_att%lod == 1 ) THEN
9063	!
9064	!-- Unit conversion factor: convert to SI units (kg/m2/s)
9065	IF ( aero_emission_att%units == 'kg/m2/yr' ) THEN
9066	aero_emission_att%conversion_factor = 1.0_wp / 3600.0_wp
9067	ELSEIF ( aero_emission_att%units == 'g/m2/yr' ) THEN
9068	aero_emission_att%conversion_factor = 0.001_wp / 3600.0_wp
9069	ELSE
9070	message_string = 'unknown unit for aerosol emissions: ' // &
9071	TRIM( aero_emission_att%units ) // ' (lod1)'
9072	CALL message( 'salsa_emission_setup','PA0631', 1, 2, 0, 6, 0 )
9073	ENDIF
9074	!
9075	!-- Allocate emission arrays
9076	ALLOCATE( aero_emission_att%cat_index(1:aero_emission_att%ncat), &
9077	aero_emission_att%rho(1:aero_emission_att%ncat), &
9078	aero_emission_att%time_factor(1:aero_emission_att%ncat) )
9079	!
9080	!-- Get emission category names and indices
9081	IF ( check_existence( aero_emission_att%var_names, 'emission_category_name' ) ) THEN
9082	CALL get_variable( id_salsa, 'emission_category_name', &
9083	aero_emission_att%cat_name, aero_emission_att%ncat )
9084	ELSE
9085	message_string = 'Missing emission_category_name in ' // TRIM( input_file_salsa )
9086	CALL message( 'salsa_emission_setup', 'PA0658', 1, 2, 0, 6, 0 )
9087	ENDIF
9088	CALL get_variable( id_salsa, 'emission_category_index', aero_emission_att%cat_index )
9089	!
9090	!-- Find corresponding emission categories
9091	DO in = 1, aero_emission_att%ncat
9092	in_name = aero_emission_att%cat_name(in)
9093	DO ss = 1, def_modes%ndc
9094	mod_name = def_modes%cat_name_table(ss)
9095	IF ( TRIM( in_name(1:4) ) == TRIM( mod_name(1:4 ) ) ) THEN
9096	def_modes%cat_input_to_model(ss) = in
9097	ENDIF
9098	ENDDO
9099	ENDDO
9100
9101	IF ( SUM( def_modes%cat_input_to_model ) == 0 ) THEN
9102	message_string = 'None of the emission categories in ' // TRIM( &
9103	input_file_salsa ) // ' match with the ones in the model.'
9104	CALL message( 'salsa_emission_setup', 'PA0632', 1, 2, 0, 6, 0 )
9105	ENDIF
9106	!
9107	!-- Emission time factors: Find check whether emission time factors are given for each
9108	!-- hour of year OR based on month, day and hour
9109	!
9110	!-- For each hour of year:
9111	IF ( check_existence( aero_emission_att%var_names, 'nhoursyear' ) ) THEN
9112	CALL get_dimension_length( id_salsa, aero_emission_att%nhoursyear, 'nhoursyear' )
9113	ALLOCATE( aero_emission_att%etf(1:aero_emission_att%ncat, &
9114	1:aero_emission_att%nhoursyear) )
9115	CALL get_variable( id_salsa, 'emission_time_factors', aero_emission_att%etf, &
9116	0, aero_emission_att%nhoursyear-1, 0, aero_emission_att%ncat-1 )
9117	!
9118	!-- Based on the month, day and hour:
9119	ELSEIF ( check_existence( aero_emission_att%var_names, 'nmonthdayhour' ) ) THEN
9120	CALL get_dimension_length( id_salsa, aero_emission_att%nmonthdayhour, &
9121	'nmonthdayhour' )
9122	ALLOCATE( aero_emission_att%etf(1:aero_emission_att%ncat, &
9123	1:aero_emission_att%nmonthdayhour) )
9124	CALL get_variable( id_salsa, 'emission_time_factors', aero_emission_att%etf, &
9125	0, aero_emission_att%nmonthdayhour-1, 0, aero_emission_att%ncat-1 )
9126	ELSE
9127	message_string = 'emission_time_factors should be given for each nhoursyear ' //&
9128	'OR nmonthdayhour'
9129	CALL message( 'salsa_emission_setup','PA0633', 1, 2, 0, 6, 0 )
9130	ENDIF
9131	!
9132	!-- Next emission update
9133	CALL get_date_time( time_since_reference_point, second_of_day=second_of_day )
9134	next_aero_emission_update = MOD( second_of_day, seconds_per_hour ) !- seconds_per_hour
9135	!
9136	!-- Calculate average mass density (kg/m3)
9137	aero_emission_att%rho = 0.0_wp
9138
9139	IF ( cc_i2m(1) /= 0 ) aero_emission_att%rho = aero_emission_att%rho + arhoh2so4 *&
9140	aero_emission%mass_fracs(:,cc_i2m(1))
9141	IF ( cc_i2m(2) /= 0 ) aero_emission_att%rho = aero_emission_att%rho + arhooc * &
9142	aero_emission%mass_fracs(:,cc_i2m(2))
9143	IF ( cc_i2m(3) /= 0 ) aero_emission_att%rho = aero_emission_att%rho + arhobc * &
9144	aero_emission%mass_fracs(:,cc_i2m(3))
9145	IF ( cc_i2m(4) /= 0 ) aero_emission_att%rho = aero_emission_att%rho + arhodu * &
9146	aero_emission%mass_fracs(:,cc_i2m(4))
9147	IF ( cc_i2m(5) /= 0 ) aero_emission_att%rho = aero_emission_att%rho + arhoss * &
9148	aero_emission%mass_fracs(:,cc_i2m(5))
9149	IF ( cc_i2m(6) /= 0 ) aero_emission_att%rho = aero_emission_att%rho + arhohno3 * &
9150	aero_emission%mass_fracs(:,cc_i2m(6))
9151	IF ( cc_i2m(7) /= 0 ) aero_emission_att%rho = aero_emission_att%rho + arhonh3 * &
9152	aero_emission%mass_fracs(:,cc_i2m(7))
9153	!
9154	!-- Allocate and read surface emission data (in total PM, get_variable_3d_real)
9155	ALLOCATE( aero_emission%def_data(nys:nyn,nxl:nxr,1:aero_emission_att%ncat) )
9156	CALL get_variable( id_salsa, 'aerosol_emission_values', aero_emission%def_data, &
9157	0, aero_emission_att%ncat-1, nxl, nxr, nys, nyn )
9158
9159	!
9160	!-- Pre-processed mode
9161	ELSEIF ( aero_emission_att%lod == 2 ) THEN
9162	!
9163	!-- Unit conversion factor: convert to SI units (#/m2/s)
9164	IF ( aero_emission_att%units == '#/m2/s' ) THEN
9165	aero_emission_att%conversion_factor = 1.0_wp
9166	ELSE
9167	message_string = 'unknown unit for aerosol emissions: ' // &
9168	TRIM( aero_emission_att%units )
9169	CALL message( 'salsa_emission_setup','PA0634', 1, 2, 0, 6, 0 )
9170	ENDIF
9171	!
9172	!-- Number of aerosol size bins in the emission data
9173	CALL get_dimension_length( id_salsa, aero_emission_att%nbins, 'Dmid' )
9174	IF ( aero_emission_att%nbins /= nbins_aerosol ) THEN
9175	message_string = 'The number of size bins in aerosol input data does not ' // &
9176	'correspond to the model set-up'
9177	CALL message( 'salsa_emission_setup','PA0635', 1, 2, 0, 6, 0 )
9178	ENDIF
9179	!
9180	!-- Number of time steps in the emission data
9181	CALL get_dimension_length( id_salsa, aero_emission_att%nt, 'time')
9182	!
9183	!-- Allocate bin diameters, time and mass fraction array
9184	ALLOCATE( aero_emission_att%dmid(1:nbins_aerosol), &
9185	aero_emission_att%time(0:aero_emission_att%nt-1), &
9186	aero_emission%num_fracs(1:aero_emission_att%ncat,1:nbins_aerosol) )
9187	!
9188	!-- Read mean diameters
9189	CALL get_variable( id_salsa, 'Dmid', aero_emission_att%dmid )
9190	!
9191	!-- Check whether the sectional representation of the aerosol size distribution conform
9192	!-- to the one applied in the model
9193	IF ( ANY( ABS( ( aero(1:nbins_aerosol)%dmid - aero_emission_att%dmid ) / &
9194	aero(1:nbins_aerosol)%dmid ) > 0.1_wp ) ) THEN
9195	message_string = 'Mean diameters of size bins in ' // TRIM( input_file_salsa ) &
9196	// ' do not match with the ones in the model.'
9197	CALL message( 'salsa_emission_setup','PA0636', 1, 2, 0, 6, 0 )
9198	ENDIF
9199	!
9200	!-- Read time stamps:
9201	IF ( check_existence( aero_emission_att%var_names, 'time' ) ) THEN
9202	CALL get_variable( id_salsa, 'time', aero_emission_att%time )
9203	ELSE
9204	message_string = 'Missing time in ' // TRIM( input_file_salsa )
9205	CALL message( 'salsa_emission_setup', 'PA0660', 1, 2, 0, 6, 0 )
9206	ENDIF
9207	!
9208	!-- Check if the provided data covers the entire simulation. The spinup time is added
9209	!-- to the end_time, this must be considered here.
9210	IF ( end_time - spinup_time > aero_emission_att%time(aero_emission_att%nt-1) ) THEN
9211	message_string = 'end_time of the simulation exceeds the time dimension in ' // &
9212	'the salsa input file.'
9213	CALL message( 'salsa_emission_setup', 'PA0692', 1, 2, 0, 6, 0 )
9214	ENDIF
9215	!
9216	!-- Read emission number fractions per category
9217	IF ( check_existence( aero_emission_att%var_names, 'emission_number_fracs' ) ) THEN
9218	CALL get_variable( id_salsa, 'emission_number_fracs', aero_emission%num_fracs, &
9219	0, nbins_aerosol-1, 0, aero_emission_att%ncat-1 )
9220	ELSE
9221	message_string = 'Missing emission_number_fracs in ' // TRIM( input_file_salsa )
9222	CALL message( 'salsa_emission_setup', 'PA0694', 1, 2, 0, 6, 0 )
9223	ENDIF
9224
9225	ELSE
9226	message_string = 'Unknown lod for aerosol_emission_values.'
9227	CALL message( 'salsa_emission_setup','PA0637', 1, 2, 0, 6, 0 )
9228
9229	ENDIF ! lod
9230
9231	ENDIF ! init
9232	!
9233	!-- Define and set current emission values:
9234	!
9235	!-- Default type emissions (aerosol emission given as total mass emission per year):
9236	IF ( aero_emission_att%lod == 1 ) THEN
9237	!
9238	!-- Emission time factors for each emission category at current time step
9239	IF ( aero_emission_att%nhoursyear > aero_emission_att%nmonthdayhour ) THEN
9240	!
9241	!-- Get the index of the current hour
9242	CALL get_date_time( MAX( 0.0_wp, time_since_reference_point ), &
9243	day_of_year=day_of_year, hour=hour_of_day )
9244	index_hh = ( day_of_year - 1_iwp ) * hours_per_day + hour_of_day
9245	aero_emission_att%time_factor = aero_emission_att%etf(:,index_hh+1)
9246
9247	ELSEIF ( aero_emission_att%nhoursyear < aero_emission_att%nmonthdayhour ) THEN
9248	!
9249	!-- Get the index of current hour (index_hh) (TODO: Now "workday" is always assumed.
9250	!-- Needs to be calculated.)
9251	CALL get_date_time( MAX( 0.0_wp, time_since_reference_point ), month=month_of_year,&
9252	day=day_of_month, hour=hour_of_day, day_of_week=day_of_week )
9253	index_mm = month_of_year
9254	index_dd = months_per_year + day_of_week
9255	SELECT CASE(TRIM(daytype))
9256
9257	CASE ("workday")
9258	index_hh = months_per_year + days_per_week + hour_of_day
9259
9260	CASE ("weekend")
9261	index_hh = months_per_year + days_per_week + hours_per_day + hour_of_day
9262
9263	CASE ("holiday")
9264	index_hh = months_per_year + days_per_week + 2*hours_per_day + hour_of_day
9265
9266	END SELECT
9267	aero_emission_att%time_factor = aero_emission_att%etf(:,index_mm) * &
9268	aero_emission_att%etf(:,index_dd) * &
9269	aero_emission_att%etf(:,index_hh+1)
9270	ENDIF
9271
9272	!
9273	!-- Create a sectional number size distribution for emissions
9274	ALLOCATE( nsect_emission(1:nbins_aerosol),source_array(nys:nyn,nxl:nxr,1:nbins_aerosol) )
9275	DO in = 1, aero_emission_att%ncat
9276
9277	inn = def_modes%cat_input_to_model(in)
9278	!
9279	!-- Calculate the number concentration (1/m3) of a log-normal size distribution
9280	!-- following Jacobson (2005): Eq 13.25.
9281	def_modes%ntot_table = 6.0_wp * def_modes%pm_frac_table(:,inn) / ( pi * &
9282	( def_modes%dpg_table )*3 EXP( 4.5_wp * &
9283	LOG( def_modes%sigmag_table )**2 ) )
9284	!
9285	!-- Sectional size distibution (1/m3) from a log-normal one
9286	CALL size_distribution( def_modes%ntot_table, def_modes%dpg_table, &
9287	def_modes%sigmag_table, nsect_emission )
9288
9289	source_array = 0.0_wp
9290	DO ib = 1, nbins_aerosol
9291	source_array(:,:,ib) = aero_emission%def_data(:,:,in) * &
9292	aero_emission_att%conversion_factor / &
9293	aero_emission_att%rho(in) * nsect_emission(ib) * &
9294	aero_emission_att%time_factor(in)
9295	ENDDO
9296	!
9297	!-- Set surface fluxes of aerosol number and mass on horizontal surfaces. Set fluxes
9298	!-- only for either default, land or urban surface.
9299	IF ( .NOT. land_surface .AND. .NOT. urban_surface ) THEN
9300	CALL set_flux( surf_def_h(0), aero_emission_att%cc_in2mod, &
9301	aero_emission%mass_fracs(in,:), source_array )
9302	ELSE
9303	CALL set_flux( surf_usm_h, aero_emission_att%cc_in2mod, &
9304	aero_emission%mass_fracs(in,:), source_array )
9305	CALL set_flux( surf_lsm_h, aero_emission_att%cc_in2mod, &
9306	aero_emission%mass_fracs(in,:), source_array )
9307	ENDIF
9308	ENDDO
9309	!
9310	!-- The next emission update is again after one hour
9311	next_aero_emission_update = next_aero_emission_update + 3600.0_wp
9312
9313
9314	DEALLOCATE( nsect_emission, source_array )
9315	!
9316	!-- Pre-processed:
9317	ELSEIF ( aero_emission_att%lod == 2 ) THEN
9318	!
9319	!-- Obtain time index for current point in time.
9320	aero_emission_att%tind = MINLOC( ABS( aero_emission_att%time - &
9321	MAX( time_since_reference_point, 0.0_wp ) ), &
9322	DIM = 1 ) - 1
9323	!
9324	!-- Allocate the data input array always before reading in the data and deallocate after
9325	ALLOCATE( aero_emission%preproc_data(nys:nyn,nxl:nxr,1:aero_emission_att%ncat), &
9326	source_array(nys:nyn,nxl:nxr,1:nbins_aerosol) )
9327	!
9328	!-- Read in the next time step (get_variable_4d_to_3d_real)
9329	CALL get_variable( id_salsa, 'aerosol_emission_values', aero_emission%preproc_data, &
9330	aero_emission_att%tind, 0, aero_emission_att%ncat-1, &
9331	nxl, nxr, nys, nyn )
9332	!
9333	!-- Calculate the sources per category and set surface fluxes
9334	source_array = 0.0_wp
9335	DO in = 1, aero_emission_att%ncat
9336	DO ib = 1, nbins_aerosol
9337	source_array(:,:,ib) = aero_emission%preproc_data(:,:,in) * &
9338	aero_emission%num_fracs(in,ib)
9339	ENDDO
9340	!
9341	!-- Set fluxes only for either default, land and urban surface.
9342	IF ( .NOT. land_surface .AND. .NOT. urban_surface ) THEN
9343	CALL set_flux( surf_def_h(0), aero_emission_att%cc_in2mod, &
9344	aero_emission%mass_fracs(in,:), source_array )
9345	ELSE
9346	CALL set_flux( surf_usm_h, aero_emission_att%cc_in2mod, &
9347	aero_emission%mass_fracs(in,:), source_array )
9348	CALL set_flux( surf_lsm_h, aero_emission_att%cc_in2mod, &
9349	aero_emission%mass_fracs(in,:), source_array )
9350	ENDIF
9351	ENDDO
9352	!
9353	!-- Determine the next emission update
9354	next_aero_emission_update = aero_emission_att%time(aero_emission_att%tind+2)
9355
9356	DEALLOCATE( aero_emission%preproc_data, source_array )
9357
9358	ENDIF
9359	!
9360	!-- Close input file
9361	CALL close_input_file( id_salsa )
9362	#else
9363	message_string = 'salsa_emission_mode = "read_from_file", but preprocessor directive ' //&
9364	' __netcdf is not used in compiling!'
9365	CALL message( 'salsa_emission_setup', 'PA0638', 1, 2, 0, 6, 0 )
9366
9367	#endif
9368	CASE DEFAULT
9369	message_string = 'unknown salsa_emission_mode: ' // TRIM( salsa_emission_mode )
9370	CALL message( 'salsa_emission_setup', 'PA0639', 1, 2, 0, 6, 0 )
9371
9372	END SELECT
9373
9374	CONTAINS
9375
9376	!------------------------------------------------------------------------------!
9377	! Description:
9378	! ------------
9379	!> Sets the aerosol flux to aerosol arrays in 2a and 2b.
9380	!------------------------------------------------------------------------------!
9381	SUBROUTINE set_flux( surface, cc_i_mod, mass_fracs, source_array )
9382
9383	USE arrays_3d, &
9384	ONLY: rho_air_zw
9385
9386	USE surface_mod, &
9387	ONLY: surf_type
9388
9389	IMPLICIT NONE
9390
9391	INTEGER(iwp) :: i !< loop index
9392	INTEGER(iwp) :: ib !< loop index
9393	INTEGER(iwp) :: ic !< loop index
9394	INTEGER(iwp) :: j !< loop index
9395	INTEGER(iwp) :: k !< loop index
9396	INTEGER(iwp) :: m !< running index for surface elements
9397
9398	INTEGER(iwp), DIMENSION(:) :: cc_i_mod !< index of chemical component in the input data
9399
9400	REAL(wp) :: so4_oc !< mass fraction between SO4 and OC in 1a
9401
9402	REAL(wp), DIMENSION(:), INTENT(in) :: mass_fracs !< mass fractions of chemical components
9403
9404	REAL(wp), DIMENSION(nys:nyn,nxl:nxr,1:nbins_aerosol), INTENT(inout) :: source_array !<
9405
9406	TYPE(surf_type), INTENT(inout) :: surface !< respective surface type
9407
9408	so4_oc = 0.0_wp
9409
9410	DO m = 1, surface%ns
9411	!
9412	!-- Get indices of respective grid point
9413	i = surface%i(m)
9414	j = surface%j(m)
9415	k = surface%k(m)
9416
9417	DO ib = 1, nbins_aerosol
9418	IF ( source_array(j,i,ib) < nclim ) THEN
9419	source_array(j,i,ib) = 0.0_wp
9420	ENDIF
9421	!
9422	!-- Set mass fluxes. First bins include only SO4 and/or OC.
9423	IF ( ib <= end_subrange_1a ) THEN
9424	!
9425	!-- Both sulphate and organic carbon
9426	IF ( index_so4 > 0 .AND. index_oc > 0 ) THEN
9427
9428	ic = ( index_so4 - 1 ) * nbins_aerosol + ib
9429	so4_oc = mass_fracs(cc_i_mod(1)) / ( mass_fracs(cc_i_mod(1)) + &
9430	mass_fracs(cc_i_mod(2)) )
9431	surface%amsws(m,ic) = surface%amsws(m,ic) + so4_oc * source_array(j,i,ib) &
9432	* api6 * aero(ib)%dmid*3 arhoh2so4 * rho_air_zw(k-1)
9433	aerosol_mass(ic)%source(j,i) = aerosol_mass(ic)%source(j,i) + surface%amsws(m,ic)
9434
9435	ic = ( index_oc - 1 ) * nbins_aerosol + ib
9436	surface%amsws(m,ic) = surface%amsws(m,ic) + ( 1-so4_oc ) * source_array(j,i,ib) &
9437	* api6 * aero(ib)%dmid*3 arhooc * rho_air_zw(k-1)
9438	aerosol_mass(ic)%source(j,i) = aerosol_mass(ic)%source(j,i) + surface%amsws(m,ic)
9439	!
9440	!-- Only sulphates
9441	ELSEIF ( index_so4 > 0 .AND. index_oc < 0 ) THEN
9442	ic = ( index_so4 - 1 ) * nbins_aerosol + ib
9443	surface%amsws(m,ic) = surface%amsws(m,ic) + source_array(j,i,ib) * api6 * &
9444	aero(ib)%dmid*3 arhoh2so4 * rho_air_zw(k-1)
9445	aerosol_mass(ic)%source(j,i) = aerosol_mass(ic)%source(j,i) + surface%amsws(m,ic)
9446	!
9447	!-- Only organic carbon
9448	ELSEIF ( index_so4 < 0 .AND. index_oc > 0 ) THEN
9449	ic = ( index_oc - 1 ) * nbins_aerosol + ib
9450	surface%amsws(m,ic) = surface%amsws(m,ic) + source_array(j,i,ib) * api6 * &
9451	aero(ib)%dmid*3 arhooc * rho_air_zw(k-1)
9452	aerosol_mass(ic)%source(j,i) = aerosol_mass(ic)%source(j,i) + surface%amsws(m,ic)
9453	ENDIF
9454
9455	ELSE
9456	!
9457	!-- Sulphate
9458	IF ( index_so4 > 0 ) THEN
9459	ic = cc_i_mod(1)
9460	CALL set_mass_flux( surface, m, ib, index_so4, mass_fracs(ic), arhoh2so4, &
9461	source_array(j,i,ib) )
9462	ENDIF
9463	!
9464	!-- Organic carbon
9465	IF ( index_oc > 0 ) THEN
9466	ic = cc_i_mod(2)
9467	CALL set_mass_flux( surface, m, ib, index_oc, mass_fracs(ic),arhooc, &
9468	source_array(j,i,ib) )
9469	ENDIF
9470	!
9471	!-- Black carbon
9472	IF ( index_bc > 0 ) THEN
9473	ic = cc_i_mod(3)
9474	CALL set_mass_flux( surface, m, ib, index_bc, mass_fracs(ic), arhobc, &
9475	source_array(j,i,ib) )
9476	ENDIF
9477	!
9478	!-- Dust
9479	IF ( index_du > 0 ) THEN
9480	ic = cc_i_mod(4)
9481	CALL set_mass_flux( surface, m, ib, index_du, mass_fracs(ic), arhodu, &
9482	source_array(j,i,ib) )
9483	ENDIF
9484	!
9485	!-- Sea salt
9486	IF ( index_ss > 0 ) THEN
9487	ic = cc_i_mod(5)
9488	CALL set_mass_flux( surface, m, ib, index_ss, mass_fracs(ic), arhoss, &
9489	source_array(j,i,ib) )
9490	ENDIF
9491	!
9492	!-- Nitric acid
9493	IF ( index_no > 0 ) THEN
9494	ic = cc_i_mod(6)
9495	CALL set_mass_flux( surface, m, ib, index_no, mass_fracs(ic), arhohno3, &
9496	source_array(j,i,ib) )
9497	ENDIF
9498	!
9499	!-- Ammonia
9500	IF ( index_nh > 0 ) THEN
9501	ic = cc_i_mod(7)
9502	CALL set_mass_flux( surface, m, ib, index_nh, mass_fracs(ic), arhonh3, &
9503	source_array(j,i,ib) )
9504	ENDIF
9505
9506	ENDIF
9507	!
9508	!-- Save number fluxes in the end
9509	surface%answs(m,ib) = surface%answs(m,ib) + source_array(j,i,ib) * rho_air_zw(k-1)
9510	aerosol_number(ib)%source(j,i) = surface%answs(m,ib)
9511
9512	ENDDO ! ib
9513	ENDDO ! m
9514
9515	END SUBROUTINE set_flux
9516
9517	!------------------------------------------------------------------------------!
9518	! Description:
9519	! ------------
9520	!> Sets the mass emissions to aerosol arrays in 2a and 2b.
9521	!------------------------------------------------------------------------------!
9522	SUBROUTINE set_mass_flux( surface, surf_num, ib, ispec, mass_frac, prho, nsource )
9523
9524	USE arrays_3d, &
9525	ONLY: rho_air_zw
9526
9527	USE surface_mod, &
9528	ONLY: surf_type
9529
9530	IMPLICIT NONE
9531
9532	INTEGER(iwp) :: i !< loop index
9533	INTEGER(iwp) :: j !< loop index
9534	INTEGER(iwp) :: k !< loop index
9535	INTEGER(iwp) :: ic !< loop index
9536
9537	INTEGER(iwp), INTENT(in) :: ib !< Aerosol size bin index
9538	INTEGER(iwp), INTENT(in) :: ispec !< Aerosol species index
9539	INTEGER(iwp), INTENT(in) :: surf_num !< index surface elements
9540
9541	REAL(wp), INTENT(in) :: mass_frac !< mass fraction of a chemical compound in all bins
9542	REAL(wp), INTENT(in) :: nsource !< number source (#/m2/s)
9543	REAL(wp), INTENT(in) :: prho !< Aerosol density
9544
9545	TYPE(surf_type), INTENT(inout) :: surface !< respective surface type
9546	!
9547	!-- Get indices of respective grid point
9548	i = surface%i(surf_num)
9549	j = surface%j(surf_num)
9550	k = surface%k(surf_num)
9551	!
9552	!-- Subrange 2a:
9553	ic = ( ispec - 1 ) * nbins_aerosol + ib
9554	surface%amsws(surf_num,ic) = surface%amsws(surf_num,ic) + mass_frac * nsource * &
9555	aero(ib)%core * prho * rho_air_zw(k-1)
9556	aerosol_mass(ic)%source(j,i) = surface%amsws(surf_num,ic)
9557
9558	END SUBROUTINE set_mass_flux
9559
9560	END SUBROUTINE salsa_emission_setup
9561
9562	!------------------------------------------------------------------------------!
9563	! Description:
9564	! ------------
9565	!> Sets the gaseous fluxes
9566	!------------------------------------------------------------------------------!
9567	SUBROUTINE salsa_gas_emission_setup( init )
9568
9569	USE netcdf_data_input_mod, &
9570	ONLY: check_existence, close_input_file, get_attribute, get_variable, &
9571	inquire_num_variables, inquire_variable_names, &
9572	get_dimension_length, open_read_file
9573
9574	USE palm_date_time_mod, &
9575	ONLY: days_per_week, get_date_time, hours_per_day, months_per_year, seconds_per_hour
9576
9577	USE surface_mod, &
9578	ONLY: surf_def_h, surf_lsm_h, surf_usm_h
9579
9580	IMPLICIT NONE
9581
9582	CHARACTER(LEN=80) :: daytype = 'workday' !< default day type
9583	CHARACTER(LEN=25) :: in_name !< name of a gas in the input file
9584
9585	CHARACTER(LEN=100), DIMENSION(:), ALLOCATABLE :: var_names !< variable names in input data
9586
9587
9588	INTEGER(iwp) :: day_of_month !< day of the month
9589	INTEGER(iwp) :: day_of_week !< day of the week
9590	INTEGER(iwp) :: day_of_year !< day of the year
9591	INTEGER(iwp) :: hour_of_day !< hour of the day
9592	INTEGER(iwp) :: id_chem !< NetCDF id of chemistry emission file
9593	INTEGER(iwp) :: i !< loop index
9594	INTEGER(iwp) :: ig !< loop index
9595	INTEGER(iwp) :: in !< running index for emission categories
9596	INTEGER(iwp) :: index_dd !< index day
9597	INTEGER(iwp) :: index_hh !< index hour
9598	INTEGER(iwp) :: index_mm !< index month
9599	INTEGER(iwp) :: j !< loop index
9600	INTEGER(iwp) :: month_of_year !< month of the year
9601	INTEGER(iwp) :: num_vars !< number of variables
9602
9603	LOGICAL :: netcdf_extend = .FALSE. !< NetCDF input file exists
9604
9605	LOGICAL, INTENT(in) :: init !< if .TRUE. --> initialisation call
9606
9607	REAL(wp) :: second_of_day !< second of the day
9608
9609	REAL(wp), DIMENSION(:), ALLOCATABLE :: time_factor !< emission time factor
9610
9611	REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: dum_var_3d !<
9612
9613	REAL(wp), DIMENSION(:,:,:,:,:), ALLOCATABLE :: dum_var_5d !<
9614
9615	!
9616	!-- Reset surface fluxes
9617	surf_def_h(0)%gtsws = 0.0_wp
9618	surf_lsm_h%gtsws = 0.0_wp
9619	surf_usm_h%gtsws = 0.0_wp
9620
9621	#if defined( __netcdf )
9622	!
9623	!-- Check existence of PIDS_CHEM file
9624	INQUIRE( FILE = 'PIDS_CHEM' // TRIM( coupling_char ), EXIST = netcdf_extend )
9625	IF ( .NOT. netcdf_extend ) THEN
9626	message_string = 'Input file PIDS_CHEM' // TRIM( coupling_char ) // ' missing!'
9627	CALL message( 'salsa_gas_emission_setup', 'PA0640', 1, 2, 0, 6, 0 )
9628	ENDIF
9629	!
9630	!-- Open file in read-only mode
9631	CALL open_read_file( 'PIDS_CHEM' // TRIM( coupling_char ), id_chem )
9632
9633	IF ( init ) THEN
9634	!
9635	!-- Read the index and name of chemical components
9636	CALL get_dimension_length( id_chem, chem_emission_att%n_emiss_species, 'nspecies' )
9637	ALLOCATE( chem_emission_att%species_index(1:chem_emission_att%n_emiss_species) )
9638	CALL get_variable( id_chem, 'emission_index', chem_emission_att%species_index )
9639	CALL get_variable( id_chem, 'emission_name', chem_emission_att%species_name, &
9640	chem_emission_att%n_emiss_species )
9641	!
9642	!-- Allocate emission data
9643	ALLOCATE( chem_emission(1:chem_emission_att%n_emiss_species) )
9644	!
9645	!-- Find the corresponding indices in the model
9646	emission_index_chem = 0
9647	DO ig = 1, chem_emission_att%n_emiss_species
9648	in_name = chem_emission_att%species_name(ig)
9649	SELECT CASE ( TRIM( in_name ) )
9650	CASE ( 'H2SO4', 'h2so4' )
9651	emission_index_chem(1) = ig
9652	CASE ( 'HNO3', 'hno3' )
9653	emission_index_chem(2) = ig
9654	CASE ( 'NH3', 'nh3' )
9655	emission_index_chem(3) = ig
9656	CASE ( 'OCNV', 'ocnv' )
9657	emission_index_chem(4) = ig
9658	CASE ( 'OCSV', 'ocsv' )
9659	emission_index_chem(5) = ig
9660	END SELECT
9661	ENDDO
9662	!
9663	!-- Inquire the fill value
9664	CALL get_attribute( id_chem, '_FillValue', aero_emission%fill, .FALSE., 'emission_values' )
9665	!
9666	!-- Inquire units of emissions
9667	CALL get_attribute( id_chem, 'units', chem_emission_att%units, .FALSE., 'emission_values' )
9668	!
9669	!-- Inquire the level of detail (lod)
9670	CALL get_attribute( id_chem, 'lod', lod_gas_emissions, .FALSE., 'emission_values' )
9671	!
9672	!-- Variable names
9673	CALL inquire_num_variables( id_chem, num_vars )
9674	ALLOCATE( var_names(1:num_vars) )
9675	CALL inquire_variable_names( id_chem, var_names )
9676	!
9677	!-- Default mode: as total emissions per year
9678	IF ( lod_gas_emissions == 1 ) THEN
9679
9680	!
9681	!-- Get number of emission categories and allocate emission arrays
9682	CALL get_dimension_length( id_chem, chem_emission_att%ncat, 'ncat' )
9683	ALLOCATE( chem_emission_att%cat_index(1:chem_emission_att%ncat), &
9684	time_factor(1:chem_emission_att%ncat) )
9685	!
9686	!-- Get emission category names and indices
9687	CALL get_variable( id_chem, 'emission_category_name', chem_emission_att%cat_name, &
9688	chem_emission_att%ncat)
9689	CALL get_variable( id_chem, 'emission_category_index', chem_emission_att%cat_index )
9690	!
9691	!-- Emission time factors: Find check whether emission time factors are given for each hour
9692	!-- of year OR based on month, day and hour
9693	!
9694	!-- For each hour of year:
9695	IF ( check_existence( var_names, 'nhoursyear' ) ) THEN
9696	CALL get_dimension_length( id_chem, chem_emission_att%nhoursyear, 'nhoursyear' )
9697	ALLOCATE( chem_emission_att%hourly_emis_time_factor(1:chem_emission_att%ncat, &
9698	1:chem_emission_att%nhoursyear) )
9699	CALL get_variable( id_chem, 'emission_time_factors', &
9700	chem_emission_att%hourly_emis_time_factor, &
9701	0, chem_emission_att%nhoursyear-1, 0, chem_emission_att%ncat-1 )
9702	!
9703	!-- Based on the month, day and hour:
9704	ELSEIF ( check_existence( var_names, 'nmonthdayhour' ) ) THEN
9705	CALL get_dimension_length( id_chem, chem_emission_att%nmonthdayhour, 'nmonthdayhour' )
9706	ALLOCATE( chem_emission_att%mdh_emis_time_factor(1:chem_emission_att%ncat, &
9707	1:chem_emission_att%nmonthdayhour) )
9708	CALL get_variable( id_chem, 'emission_time_factors', &
9709	chem_emission_att%mdh_emis_time_factor, &
9710	0, chem_emission_att%nmonthdayhour-1, 0, chem_emission_att%ncat-1 )
9711	ELSE
9712	message_string = 'emission_time_factors should be given for each nhoursyear OR ' // &
9713	'nmonthdayhour'
9714	CALL message( 'salsa_gas_emission_setup','PA0641', 1, 2, 0, 6, 0 )
9715	ENDIF
9716	!
9717	!-- Next emission update
9718	CALL get_date_time( time_since_reference_point, second_of_day=second_of_day )
9719	next_gas_emission_update = MOD( second_of_day, seconds_per_hour ) !- seconds_per_hour
9720	!
9721	!-- Allocate and read surface emission data (in total PM) (NOTE that "preprocessed" input data
9722	!-- array is applied now here)
9723	ALLOCATE( dum_var_5d(1,nys:nyn,nxl:nxr,1:chem_emission_att%n_emiss_species, &
9724	1:chem_emission_att%ncat) )
9725	CALL get_variable( id_chem, 'emission_values', dum_var_5d, 0, chem_emission_att%ncat-1, &
9726	0, chem_emission_att%n_emiss_species-1, nxl, nxr, nys, nyn, 0, 0 )
9727	DO ig = 1, chem_emission_att%n_emiss_species
9728	ALLOCATE( chem_emission(ig)%default_emission_data(nys:nyn,nxl:nxr, &
9729	1:chem_emission_att%ncat) )
9730	DO in = 1, chem_emission_att%ncat
9731	DO i = nxl, nxr
9732	DO j = nys, nyn
9733	chem_emission(ig)%default_emission_data(j,i,in) = dum_var_5d(1,j,i,ig,in)
9734	ENDDO
9735	ENDDO
9736	ENDDO
9737	ENDDO
9738	DEALLOCATE( dum_var_5d )
9739	!
9740	!-- Pre-processed mode:
9741	ELSEIF ( lod_gas_emissions == 2 ) THEN
9742	!
9743	!-- Number of time steps in the emission data
9744	CALL get_dimension_length( id_chem, chem_emission_att%dt_emission, 'time' )
9745	!
9746	!-- Allocate and read time
9747	ALLOCATE( gas_emission_time(1:chem_emission_att%dt_emission) )
9748	CALL get_variable( id_chem, 'time', gas_emission_time )
9749	ELSE
9750	message_string = 'Unknown lod for emission_values.'
9751	CALL message( 'salsa_gas_emission_setup','PA0642', 1, 2, 0, 6, 0 )
9752	ENDIF ! lod
9753
9754	ENDIF ! init
9755	!
9756	!-- Define and set current emission values:
9757
9758	IF ( lod_gas_emissions == 1 ) THEN
9759	!
9760	!-- Emission time factors for each emission category at current time step
9761	IF ( chem_emission_att%nhoursyear > chem_emission_att%nmonthdayhour ) THEN
9762	!
9763	!-- Get the index of the current hour
9764	CALL get_date_time( time_since_reference_point, &
9765	day_of_year=day_of_year, hour=hour_of_day )
9766	index_hh = ( day_of_year - 1_iwp ) * hours_per_day + hour_of_day
9767	IF ( .NOT. ALLOCATED( time_factor ) ) ALLOCATE( time_factor(1:chem_emission_att%ncat) )
9768	time_factor = 0.0_wp
9769	time_factor = chem_emission_att%hourly_emis_time_factor(:,index_hh+1)
9770
9771	ELSEIF ( chem_emission_att%nhoursyear < chem_emission_att%nmonthdayhour ) THEN
9772	!
9773	!-- Get the index of current hour (index_hh) (TODO: Now "workday" is always assumed.
9774	!-- Needs to be calculated.)
9775	CALL get_date_time( time_since_reference_point, &
9776	month=month_of_year, &
9777	day=day_of_month, &
9778	hour=hour_of_day, &
9779	day_of_week=day_of_week )
9780	index_mm = month_of_year
9781	index_dd = months_per_year + day_of_week
9782	SELECT CASE( TRIM( daytype ) )
9783
9784	CASE ("workday")
9785	index_hh = months_per_year + days_per_week + hour_of_day
9786
9787	CASE ("weekend")
9788	index_hh = months_per_year + days_per_week + hours_per_day + hour_of_day
9789
9790	CASE ("holiday")
9791	index_hh = months_per_year + days_per_week + 2*hours_per_day + hour_of_day
9792
9793	END SELECT
9794	time_factor = chem_emission_att%mdh_emis_time_factor(:,index_mm) * &
9795	chem_emission_att%mdh_emis_time_factor(:,index_dd) * &
9796	chem_emission_att%mdh_emis_time_factor(:,index_hh+1)
9797	ENDIF
9798	!
9799	!-- Set gas emissions for each emission category
9800	ALLOCATE( dum_var_3d(nys:nyn,nxl:nxr,1:chem_emission_att%n_emiss_species) )
9801
9802	DO in = 1, chem_emission_att%ncat
9803	DO ig = 1, chem_emission_att%n_emiss_species
9804	dum_var_3d(:,:,ig) = chem_emission(ig)%default_emission_data(:,:,in)
9805	ENDDO
9806	!
9807	!-- Set surface fluxes only for either default, land or urban surface
9808	IF ( .NOT. land_surface .AND. .NOT. urban_surface ) THEN
9809	CALL set_gas_flux( surf_def_h(0), emission_index_chem, chem_emission_att%units, &
9810	dum_var_3d, time_factor(in) )
9811	ELSE
9812	CALL set_gas_flux( surf_usm_h, emission_index_chem, chem_emission_att%units, &
9813	dum_var_3d, time_factor(in) )
9814	CALL set_gas_flux( surf_lsm_h, emission_index_chem, chem_emission_att%units, &
9815	dum_var_3d, time_factor(in) )
9816	ENDIF
9817	ENDDO
9818	DEALLOCATE( dum_var_3d )
9819	!
9820	!-- The next emission update is again after one hour
9821	next_gas_emission_update = next_gas_emission_update + 3600.0_wp
9822
9823	ELSEIF ( lod_gas_emissions == 2 ) THEN
9824	!
9825	!-- Obtain time index for current point in time.
9826	chem_emission_att%i_hour = MINLOC( ABS( gas_emission_time - &
9827	MAX( time_since_reference_point, 0.0_wp ) ), DIM = 1 ) - 1
9828	!
9829	!-- Allocate the data input array always before reading in the data and deallocate after (NOTE
9830	!-- that "preprocessed" input data array is applied now here)
9831	ALLOCATE( dum_var_5d(1,1,nys:nyn,nxl:nxr,1:chem_emission_att%n_emiss_species) )
9832	!
9833	!-- Read in the next time step
9834	CALL get_variable( id_chem, 'emission_values', dum_var_5d, &
9835	0, chem_emission_att%n_emiss_species-1, nxl, nxr, nys, nyn, 0, 0, &
9836	chem_emission_att%i_hour, chem_emission_att%i_hour )
9837	!
9838	!-- Set surface fluxes only for either default, land or urban surface
9839	IF ( .NOT. land_surface .AND. .NOT. urban_surface ) THEN
9840	CALL set_gas_flux( surf_def_h(0), emission_index_chem, chem_emission_att%units, &
9841	dum_var_5d(1,1,:,:,:) )
9842	ELSE
9843	CALL set_gas_flux( surf_usm_h, emission_index_chem, chem_emission_att%units, &
9844	dum_var_5d(1,1,:,:,:) )
9845	CALL set_gas_flux( surf_lsm_h, emission_index_chem, chem_emission_att%units, &
9846	dum_var_5d(1,1,:,:,:) )
9847	ENDIF
9848	DEALLOCATE ( dum_var_5d )
9849	!
9850	!-- Determine the next emission update
9851	next_gas_emission_update = gas_emission_time(chem_emission_att%i_hour+2)
9852
9853	ENDIF
9854	!
9855	!-- Close input file
9856	CALL close_input_file( id_chem )
9857
9858	#else
9859	message_string = 'salsa_emission_mode = "read_from_file", but preprocessor directive ' // &
9860	' __netcdf is not used in compiling!'
9861	CALL message( 'salsa_gas_emission_setup', 'PA0643', 1, 2, 0, 6, 0 )
9862
9863	#endif
9864
9865	CONTAINS
9866	!------------------------------------------------------------------------------!
9867	! Description:
9868	! ------------
9869	!> Set gas fluxes for selected type of surfaces
9870	!------------------------------------------------------------------------------!
9871	SUBROUTINE set_gas_flux( surface, cc_i_mod, unit, source_array, time_fac )
9872
9873	USE arrays_3d, &
9874	ONLY: dzw, hyp, pt, rho_air_zw
9875
9876	USE grid_variables, &
9877	ONLY: dx, dy
9878
9879	USE surface_mod, &
9880	ONLY: surf_type
9881
9882	IMPLICIT NONE
9883
9884	CHARACTER(LEN=*), INTENT(in) :: unit !< flux unit in the input file
9885
9886	INTEGER(iwp) :: ig !< running index for gases
9887	INTEGER(iwp) :: i !< loop index
9888	INTEGER(iwp) :: j !< loop index
9889	INTEGER(iwp) :: k !< loop index
9890	INTEGER(iwp) :: m !< running index for surface elements
9891
9892	INTEGER(iwp), DIMENSION(:) :: cc_i_mod !< index of different gases in the input data
9893
9894	LOGICAL :: use_time_fac !< .TRUE. is time_fac present
9895
9896	REAL(wp), OPTIONAL :: time_fac !< emission time factor
9897
9898	REAL(wp), DIMENSION(ngases_salsa) :: conv !< unit conversion factor
9899
9900	REAL(wp), DIMENSION(nys:nyn,nxl:nxr,1:chem_emission_att%n_emiss_species), INTENT(in) :: source_array !<
9901
9902	TYPE(surf_type), INTENT(inout) :: surface !< respective surface type
9903
9904	conv = 1.0_wp
9905	use_time_fac = PRESENT( time_fac )
9906
9907	DO m = 1, surface%ns
9908	!
9909	!-- Get indices of respective grid point
9910	i = surface%i(m)
9911	j = surface%j(m)
9912	k = surface%k(m)
9913	!
9914	!-- Unit conversion factor: convert to SI units (#/m2/s)
9915	SELECT CASE ( TRIM( unit ) )
9916	CASE ( 'kg/m2/yr' )
9917	conv(1) = avo / ( amh2so4 * 3600.0_wp )
9918	conv(2) = avo / ( amhno3 * 3600.0_wp )
9919	conv(3) = avo / ( amnh3 * 3600.0_wp )
9920	conv(4) = avo / ( amoc * 3600.0_wp )
9921	conv(5) = avo / ( amoc * 3600.0_wp )
9922	CASE ( 'g/m2/yr' )
9923	conv(1) = avo / ( amh2so4 * 3.6E+6_wp )
9924	conv(2) = avo / ( amhno3 * 3.6E+6_wp )
9925	conv(3) = avo / ( amnh3 * 3.6E+6_wp )
9926	conv(4) = avo / ( amoc * 3.6E+6_wp )
9927	conv(5) = avo / ( amoc * 3.6E+6_wp )
9928	CASE ( 'g/m2/s' )
9929	conv(1) = avo / ( amh2so4 * 1000.0_wp )
9930	conv(2) = avo / ( amhno3 * 1000.0_wp )
9931	conv(3) = avo / ( amnh3 * 1000.0_wp )
9932	conv(4) = avo / ( amoc * 1000.0_wp )
9933	conv(5) = avo / ( amoc * 1000.0_wp )
9934	CASE ( '#/m2/s' )
9935	conv = 1.0_wp
9936	CASE ( 'ppm/m2/s' )
9937	conv = for_ppm_to_nconc * hyp(k) / pt(k,j,i) * ( 1.0E5_wp / hyp(k) )*0.286_wp &
9938	dx * dy * dzw(k)
9939	CASE ( 'mumol/m2/s' )
9940	conv = 1.0E-6_wp * avo
9941	CASE DEFAULT
9942	message_string = 'unknown unit for gas emissions: ' // TRIM( chem_emission_att%units )
9943	CALL message( 'set_gas_flux','PA0644', 1, 2, 0, 6, 0 )
9944
9945	END SELECT
9946
9947	DO ig = 1, ngases_salsa
9948	IF ( use_time_fac ) THEN
9949	surface%gtsws(m,ig) = surface%gtsws(m,ig) + rho_air_zw(k-1) * conv(ig) * time_fac &
9950	* MAX( 0.0_wp, source_array(j,i,cc_i_mod(ig) ) )
9951	ELSE
9952	surface%gtsws(m,ig) = surface%gtsws(m,ig) + rho_air_zw(k-1) * conv(ig) &
9953	* MAX( 0.0_wp, source_array(j,i,cc_i_mod(ig) ) )
9954	ENDIF
9955	ENDDO ! ig
9956
9957	ENDDO ! m
9958
9959	END SUBROUTINE set_gas_flux
9960
9961	END SUBROUTINE salsa_gas_emission_setup
9962
9963	!------------------------------------------------------------------------------!
9964	! Description:
9965	! ------------
9966	!> Check data output for salsa.
9967	!------------------------------------------------------------------------------!
9968	SUBROUTINE salsa_check_data_output( var, unit )
9969
9970	IMPLICIT NONE
9971
9972	CHARACTER(LEN=*) :: unit !<
9973	CHARACTER(LEN=*) :: var !<
9974
9975	INTEGER(iwp) :: char_to_int !< for converting character to integer
9976
9977	IF ( var(1:6) /= 'salsa_' ) THEN
9978	unit = 'illegal'
9979	RETURN
9980	ENDIF
9981	!
9982	!-- Treat bin-specific outputs separately
9983	IF ( var(7:11) == 'N_bin' ) THEN
9984	READ( var(12:),* ) char_to_int
9985	IF ( char_to_int >= 1 .AND. char_to_int <= SUM( nbin ) ) THEN
9986	unit = '#/m3'
9987	ELSE
9988	unit = 'illegal'
9989	RETURN
9990	ENDIF
9991
9992	ELSEIF ( var(7:11) == 'm_bin' ) THEN
9993	READ( var(12:),* ) char_to_int
9994	IF ( char_to_int >= 1 .AND. char_to_int <= SUM( nbin ) ) THEN
9995	unit = 'kg/m3'
9996	ELSE
9997	unit = 'illegal'
9998	RETURN
9999	ENDIF
10000
10001	ELSEIF ( var(7:11) == 's_H2O' ) THEN
10002	IF ( .NOT. advect_particle_water ) THEN
10003	message_string = 'to output s_H2O/s_H2O_av requires that advect_particle_water = .T.'
10004	CALL message( 'check_parameters', 'PA0707', 1, 2, 0, 6, 0 )
10005	ENDIF
10006
10007	ELSE
10008	SELECT CASE ( TRIM( var(7:) ) )
10009
10010	CASE ( 'g_H2SO4', 'g_HNO3', 'g_NH3', 'g_OCNV', 'g_OCSV' )
10011	IF ( air_chemistry ) THEN
10012	message_string = 'gases are imported from the chemistry module and thus output '// &
10013	'of "' // TRIM( var ) // '" is not allowed'
10014	CALL message( 'check_parameters', 'PA0653', 1, 2, 0, 6, 0 )
10015	ENDIF
10016	unit = '#/m3'
10017
10018	CASE ( 'LDSA' )
10019	unit = 'mum2/cm3'
10020
10021	CASE ( 'PM0.1', 'PM2.5', 'PM10', 's_BC', 's_DU', 's_H2O', 's_NH', 's_NO', 's_OC', &
10022	's_SO4', 's_SS' )
10023	unit = 'kg/m3'
10024
10025	CASE ( 'N_UFP', 'Ntot' )
10026	unit = '#/m3'
10027
10028	CASE DEFAULT
10029	unit = 'illegal'
10030
10031	END SELECT
10032	ENDIF
10033
10034	END SUBROUTINE salsa_check_data_output
10035
10036	!------------------------------------------------------------------------------!
10037	! Description:
10038	! ------------
10039	!> Check profile data output for salsa. Currently only for diagnostic variables
10040	!> Ntot, N_UFP, PM0.1, PM2.5, PM10 and LDSA
10041	!------------------------------------------------------------------------------!
10042	SUBROUTINE salsa_check_data_output_pr( var, var_count, unit, dopr_unit )
10043
10044	USE arrays_3d, &
10045	ONLY: zu
10046
10047	USE profil_parameter, &
10048	ONLY: dopr_index
10049
10050	USE statistics, &
10051	ONLY: hom, pr_palm, statistic_regions
10052
10053	IMPLICIT NONE
10054
10055	CHARACTER(LEN=*) :: dopr_unit !<
10056	CHARACTER(LEN=*) :: unit !<
10057	CHARACTER(LEN=*) :: var !<
10058
10059	INTEGER(iwp) :: var_count !<
10060
10061	IF ( var(1:6) /= 'salsa_' ) THEN
10062	unit = 'illegal'
10063	RETURN
10064	ENDIF
10065
10066	SELECT CASE ( TRIM( var(7:) ) )
10067
10068	CASE( 'LDSA' )
10069	salsa_pr_count = salsa_pr_count + 1
10070	salsa_pr_index(salsa_pr_count) = 1
10071	dopr_index(var_count) = pr_palm + salsa_pr_count
10072	dopr_unit = 'mum2/cm3'
10073	unit = dopr_unit
10074	hom(:,2,dopr_index(var_count),:) = SPREAD( zu, 2, statistic_regions+1 )
10075
10076	CASE( 'N_UFP' )
10077	salsa_pr_count = salsa_pr_count + 1
10078	salsa_pr_index(salsa_pr_count) = 2
10079	dopr_index(var_count) = pr_palm + salsa_pr_count
10080	dopr_unit = '#/m3'
10081	unit = dopr_unit
10082	hom(:,2,dopr_index(var_count),:) = SPREAD( zu, 2, statistic_regions+1 )
10083
10084	CASE( 'Ntot' )
10085	salsa_pr_count = salsa_pr_count + 1
10086	salsa_pr_index(salsa_pr_count) = 3
10087	dopr_index(var_count) = pr_palm + salsa_pr_count
10088	dopr_unit = '#/m3'
10089	unit = dopr_unit
10090	hom(:,2,dopr_index(var_count),:) = SPREAD( zu, 2, statistic_regions+1 )
10091
10092	CASE( 'PM0.1' )
10093	salsa_pr_count = salsa_pr_count + 1
10094	salsa_pr_index(salsa_pr_count) = 4
10095	dopr_index(var_count) = pr_palm + salsa_pr_count
10096	dopr_unit = 'kg/m3'
10097	unit = dopr_unit
10098	hom(:,2,dopr_index(var_count),:) = SPREAD( zu, 2, statistic_regions+1 )
10099
10100	CASE( 'PM2.5' )
10101	salsa_pr_count = salsa_pr_count + 1
10102	salsa_pr_index(salsa_pr_count) = 5
10103	dopr_index(var_count) = pr_palm + salsa_pr_count
10104	dopr_unit = 'kg/m3'
10105	unit = dopr_unit
10106	hom(:,2,dopr_index(var_count),:) = SPREAD( zu, 2, statistic_regions+1 )
10107
10108	CASE( 'PM10' )
10109	salsa_pr_count = salsa_pr_count + 1
10110	salsa_pr_index(salsa_pr_count) = 6
10111	dopr_index(var_count) = pr_palm + salsa_pr_count
10112	dopr_unit = 'kg/m3'
10113	unit = dopr_unit
10114	hom(:,2,dopr_index(var_count),:) = SPREAD( zu, 2, statistic_regions+1 )
10115
10116	CASE DEFAULT
10117	unit = 'illegal'
10118
10119	END SELECT
10120
10121
10122	END SUBROUTINE salsa_check_data_output_pr
10123
10124	!-------------------------------------------------------------------------------!
10125	!> Description:
10126	!> Calculation of horizontally averaged profiles for salsa.
10127	!-------------------------------------------------------------------------------!
10128	SUBROUTINE salsa_statistics( mode, sr, tn )
10129
10130	USE control_parameters, &
10131	ONLY: max_pr_user
10132
10133	USE chem_modules, &
10134	ONLY: max_pr_cs
10135
10136	USE statistics, &
10137	ONLY: pr_palm, rmask, sums_l
10138
10139	IMPLICIT NONE
10140
10141	CHARACTER(LEN=*) :: mode !<
10142
10143	INTEGER(iwp) :: i !< loop index
10144	INTEGER(iwp) :: ib !< loop index
10145	INTEGER(iwp) :: ic !< loop index
10146	INTEGER(iwp) :: ii !< loop index
10147	INTEGER(iwp) :: ind !< index in the statistical output
10148	INTEGER(iwp) :: j !< loop index
10149	INTEGER(iwp) :: k !< loop index
10150	INTEGER(iwp) :: sr !< statistical region
10151	INTEGER(iwp) :: tn !< thread number
10152
10153	REAL(wp) :: df !< For calculating LDSA: fraction of particles depositing in the alveolar
10154	!< (or tracheobronchial) region of the lung. Depends on the particle size
10155	REAL(wp) :: mean_d !< Particle diameter in micrometres
10156	REAL(wp) :: temp_bin !< temporary variable
10157
10158	IF ( mode == 'profiles' ) THEN
10159	!$OMP DO
10160	DO ii = 1, salsa_pr_count
10161
10162	ind = pr_palm + max_pr_user + max_pr_cs + ii
10163
10164	SELECT CASE( salsa_pr_index(ii) )
10165
10166	CASE( 1 ) ! LDSA
10167	DO i = nxl, nxr
10168	DO j = nys, nyn
10169	DO k = nzb, nzt+1
10170	temp_bin = 0.0_wp
10171	DO ib = 1, nbins_aerosol
10172	!
10173	!-- Diameter in micrometres
10174	mean_d = 1.0E+6_wp * ra_dry(k,j,i,ib) * 2.0_wp
10175	!
10176	!-- Deposition factor: alveolar
10177	df = ( 0.01555_wp / mean_d ) * ( EXP( -0.416_wp * ( LOG( mean_d ) + &
10178	2.84_wp )*2 ) + 19.11_wp EXP( -0.482_wp * ( LOG( mean_d ) - &
10179	1.362_wp )**2 ) )
10180	!
10181	!-- Lung-deposited surface area LDSA (units mum2/cm3)
10182	temp_bin = temp_bin + pi * mean_d*2 df * 1.0E-6_wp * &
10183	aerosol_number(ib)%conc(k,j,i)
10184	ENDDO
10185	sums_l(k,ind,tn) = sums_l(k,ind,tn) + temp_bin * rmask(j,i,sr) * &
10186	MERGE( 1.0_wp, 0.0_wp, &
10187	BTEST( wall_flags_total_0(k,j,i), 22 ) )
10188	ENDDO
10189	ENDDO
10190	ENDDO
10191
10192	CASE( 2 ) ! N_UFP
10193	DO i = nxl, nxr
10194	DO j = nys, nyn
10195	DO k = nzb, nzt+1
10196	temp_bin = 0.0_wp
10197	DO ib = 1, nbins_aerosol
10198	IF ( 2.0_wp * ra_dry(k,j,i,ib) <= 0.1E-6_wp ) &
10199	temp_bin = temp_bin + aerosol_number(ib)%conc(k,j,i)
10200	ENDDO
10201	sums_l(k,ind,tn) = sums_l(k,ind,tn) + temp_bin * rmask(j,i,sr) * &
10202	MERGE( 1.0_wp, 0.0_wp, &
10203	BTEST( wall_flags_total_0(k,j,i), 22 ) )
10204	ENDDO
10205	ENDDO
10206	ENDDO
10207
10208	CASE( 3 ) ! Ntot
10209	DO i = nxl, nxr
10210	DO j = nys, nyn
10211	DO k = nzb, nzt+1
10212	temp_bin = 0.0_wp
10213	DO ib = 1, nbins_aerosol
10214	temp_bin = temp_bin + aerosol_number(ib)%conc(k,j,i)
10215	ENDDO
10216	sums_l(k,ind,tn) = sums_l(k,ind,tn) + temp_bin * rmask(j,i,sr) * &
10217	MERGE( 1.0_wp, 0.0_wp, &
10218	BTEST( wall_flags_total_0(k,j,i), 22 ) )
10219	ENDDO
10220	ENDDO
10221	ENDDO
10222
10223	CASE( 4 ) ! PM0.1
10224	DO i = nxl, nxr
10225	DO j = nys, nyn
10226	DO k = nzb, nzt+1
10227	temp_bin = 0.0_wp
10228	DO ib = 1, nbins_aerosol
10229	IF ( 2.0_wp * ra_dry(k,j,i,ib) <= 0.1E-6_wp ) THEN
10230	DO ic = ib, nbins_aerosol * ncc, nbins_aerosol
10231	temp_bin = temp_bin + aerosol_mass(ic)%conc(k,j,i)
10232	ENDDO
10233	ENDIF
10234	ENDDO
10235	sums_l(k,ind,tn) = sums_l(k,ind,tn) + temp_bin * rmask(j,i,sr) * &
10236	MERGE( 1.0_wp, 0.0_wp, &
10237	BTEST( wall_flags_total_0(k,j,i), 22 ) )
10238	ENDDO
10239	ENDDO
10240	ENDDO
10241
10242	CASE( 5 ) ! PM2.5
10243	DO i = nxl, nxr
10244	DO j = nys, nyn
10245	DO k = nzb, nzt+1
10246	temp_bin = 0.0_wp
10247	DO ib = 1, nbins_aerosol
10248	IF ( 2.0_wp * ra_dry(k,j,i,ib) <= 2.5E-6_wp ) THEN
10249	DO ic = ib, nbins_aerosol * ncc, nbins_aerosol
10250	temp_bin = temp_bin + aerosol_mass(ic)%conc(k,j,i)
10251	ENDDO
10252	ENDIF
10253	ENDDO
10254	sums_l(k,ind,tn) = sums_l(k,ind,tn) + temp_bin * rmask(j,i,sr) * &
10255	MERGE( 1.0_wp, 0.0_wp, &
10256	BTEST( wall_flags_total_0(k,j,i), 22 ) )
10257	ENDDO
10258	ENDDO
10259	ENDDO
10260
10261	CASE( 6 ) ! PM10
10262	DO i = nxl, nxr
10263	DO j = nys, nyn
10264	DO k = nzb, nzt+1
10265	temp_bin = 0.0_wp
10266	DO ib = 1, nbins_aerosol
10267	IF ( 2.0_wp * ra_dry(k,j,i,ib) <= 10.0E-6_wp ) THEN
10268	DO ic = ib, nbins_aerosol * ncc, nbins_aerosol
10269	temp_bin = temp_bin + aerosol_mass(ic)%conc(k,j,i)
10270	ENDDO
10271	ENDIF
10272	ENDDO
10273	sums_l(k,ind,tn) = sums_l(k,ind,tn) + temp_bin * rmask(j,i,sr) * &
10274	MERGE( 1.0_wp, 0.0_wp, &
10275	BTEST( wall_flags_total_0(k,j,i), 22 ) )
10276	ENDDO
10277	ENDDO
10278	ENDDO
10279
10280	END SELECT
10281	ENDDO
10282
10283	ELSEIF ( mode == 'time_series' ) THEN
10284	!
10285	!-- TODO
10286	ENDIF
10287
10288	END SUBROUTINE salsa_statistics
10289
10290
10291	!------------------------------------------------------------------------------!
10292	!
10293	! Description:
10294	! ------------
10295	!> Subroutine for averaging 3D data
10296	!------------------------------------------------------------------------------!
10297	SUBROUTINE salsa_3d_data_averaging( mode, variable )
10298
10299	USE control_parameters, &
10300	ONLY: average_count_3d
10301
10302	IMPLICIT NONE
10303
10304	CHARACTER(LEN=*) :: mode !<
10305	CHARACTER(LEN=10) :: vari !<
10306	CHARACTER(LEN=*) :: variable !<
10307
10308	INTEGER(iwp) :: char_to_int !< for converting character to integer
10309	INTEGER(iwp) :: found_index !<
10310	INTEGER(iwp) :: i !<
10311	INTEGER(iwp) :: ib !<
10312	INTEGER(iwp) :: ic !<
10313	INTEGER(iwp) :: j !<
10314	INTEGER(iwp) :: k !<
10315
10316	REAL(wp) :: df !< For calculating LDSA: fraction of particles depositing in the alveolar
10317	!< (or tracheobronchial) region of the lung. Depends on the particle size
10318	REAL(wp) :: mean_d !< Particle diameter in micrometres
10319	REAL(wp) :: temp_bin !< temporary variable
10320
10321	REAL(wp), DIMENSION(:,:,:), POINTER :: to_be_resorted !< points to selected output variable
10322
10323	temp_bin = 0.0_wp
10324
10325	IF ( mode == 'allocate' ) THEN
10326
10327	IF ( variable(7:11) == 'N_bin' ) THEN
10328	IF ( .NOT. ALLOCATED( nbins_av ) ) THEN
10329	ALLOCATE( nbins_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg,nbins_aerosol) )
10330	ENDIF
10331	nbins_av = 0.0_wp
10332
10333	ELSEIF ( variable(7:11) == 'm_bin' ) THEN
10334	IF ( .NOT. ALLOCATED( mbins_av ) ) THEN
10335	ALLOCATE( mbins_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg,nbins_aerosol) )
10336	ENDIF
10337	mbins_av = 0.0_wp
10338
10339	ELSE
10340
10341	SELECT CASE ( TRIM( variable(7:) ) )
10342
10343	CASE ( 'g_H2SO4', 'g_HNO3', 'g_NH3', 'g_OCNV', 'g_OCSV' )
10344	IF ( .NOT. ALLOCATED( salsa_gases_av ) ) THEN
10345	ALLOCATE( salsa_gases_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg,ngases_salsa) )
10346	ENDIF
10347	salsa_gases_av = 0.0_wp
10348
10349	CASE ( 'LDSA' )
10350	IF ( .NOT. ALLOCATED( ldsa_av ) ) THEN
10351	ALLOCATE( ldsa_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
10352	ENDIF
10353	ldsa_av = 0.0_wp
10354
10355	CASE ( 'N_UFP' )
10356	IF ( .NOT. ALLOCATED( nufp_av ) ) THEN
10357	ALLOCATE( nufp_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
10358	ENDIF
10359	nufp_av = 0.0_wp
10360
10361	CASE ( 'Ntot' )
10362	IF ( .NOT. ALLOCATED( ntot_av ) ) THEN
10363	ALLOCATE( ntot_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
10364	ENDIF
10365	ntot_av = 0.0_wp
10366
10367	CASE ( 'PM0.1' )
10368	IF ( .NOT. ALLOCATED( pm01_av ) ) THEN
10369	ALLOCATE( pm01_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
10370	ENDIF
10371	pm01_av = 0.0_wp
10372
10373	CASE ( 'PM2.5' )
10374	IF ( .NOT. ALLOCATED( pm25_av ) ) THEN
10375	ALLOCATE( pm25_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
10376	ENDIF
10377	pm25_av = 0.0_wp
10378
10379	CASE ( 'PM10' )
10380	IF ( .NOT. ALLOCATED( pm10_av ) ) THEN
10381	ALLOCATE( pm10_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
10382	ENDIF
10383	pm10_av = 0.0_wp
10384
10385	CASE ( 's_BC', 's_DU', 's_NH', 's_NO', 's_OC', 's_SO4', 's_SS' )
10386	IF ( .NOT. ALLOCATED( s_mass_av ) ) THEN
10387	ALLOCATE( s_mass_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg,ncomponents_mass+1) )
10388	ENDIF
10389	s_mass_av = 0.0_wp
10390
10391	CASE ( 's_H2O' )
10392	IF ( .NOT. ALLOCATED( s_h2o_av ) ) THEN
10393	ALLOCATE( s_h2o_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
10394	ENDIF
10395	s_h2o_av = 0.0_wp
10396
10397	CASE DEFAULT
10398	CONTINUE
10399
10400	END SELECT
10401
10402	ENDIF
10403
10404	ELSEIF ( mode == 'sum' ) THEN
10405
10406	IF ( variable(7:11) == 'N_bin' ) THEN
10407	IF ( ALLOCATED( nbins_av ) ) THEN
10408	READ( variable(12:),* ) char_to_int
10409	IF ( char_to_int >= 1 .AND. char_to_int <= SUM( nbin ) ) THEN
10410	ib = char_to_int
10411	DO i = nxlg, nxrg
10412	DO j = nysg, nyng
10413	DO k = nzb, nzt+1
10414	nbins_av(k,j,i,ib) = nbins_av(k,j,i,ib) + aerosol_number(ib)%conc(k,j,i)
10415	ENDDO
10416	ENDDO
10417	ENDDO
10418	ENDIF
10419	ENDIF
10420
10421	ELSEIF ( variable(7:11) == 'm_bin' ) THEN
10422	IF ( ALLOCATED( mbins_av ) ) THEN
10423	READ( variable(12:),* ) char_to_int
10424	IF ( char_to_int >= 1 .AND. char_to_int <= SUM( nbin ) ) THEN
10425	ib = char_to_int
10426	DO i = nxlg, nxrg
10427	DO j = nysg, nyng
10428	DO k = nzb, nzt+1
10429	temp_bin = 0.0_wp
10430	DO ic = ib, nbins_aerosol * ncomponents_mass, nbins_aerosol
10431	temp_bin = temp_bin + aerosol_mass(ic)%conc(k,j,i)
10432	ENDDO
10433	mbins_av(k,j,i,ib) = mbins_av(k,j,i,ib) + temp_bin
10434	ENDDO
10435	ENDDO
10436	ENDDO
10437	ENDIF
10438	ENDIF
10439	ELSE
10440
10441	SELECT CASE ( TRIM( variable(7:) ) )
10442
10443	CASE ( 'g_H2SO4', 'g_HNO3', 'g_NH3', 'g_OCNV', 'g_OCSV' )
10444	IF ( ALLOCATED( salsa_gases_av ) ) THEN
10445
10446	vari = TRIM( variable(9:) ) ! remove salsa_g_ from beginning
10447
10448	SELECT CASE( vari )
10449
10450	CASE( 'H2SO4' )
10451	found_index = 1
10452	CASE( 'HNO3' )
10453	found_index = 2
10454	CASE( 'NH3' )
10455	found_index = 3
10456	CASE( 'OCNV' )
10457	found_index = 4
10458	CASE( 'OCSV' )
10459	found_index = 5
10460
10461	END SELECT
10462
10463	DO i = nxlg, nxrg
10464	DO j = nysg, nyng
10465	DO k = nzb, nzt+1
10466	salsa_gases_av(k,j,i,found_index) = salsa_gases_av(k,j,i,found_index) &
10467	+ salsa_gas(found_index)%conc(k,j,i)
10468	ENDDO
10469	ENDDO
10470	ENDDO
10471	ENDIF
10472
10473	CASE ( 'LDSA' )
10474	IF ( ALLOCATED( ldsa_av ) ) THEN
10475	DO i = nxlg, nxrg
10476	DO j = nysg, nyng
10477	DO k = nzb, nzt+1
10478	temp_bin = 0.0_wp
10479	DO ib = 1, nbins_aerosol
10480	!
10481	!-- Diameter in micrometres
10482	mean_d = 1.0E+6_wp * ra_dry(k,j,i,ib) * 2.0_wp
10483	!
10484	!-- Deposition factor: alveolar (use ra_dry)
10485	df = ( 0.01555_wp / mean_d ) * ( EXP( -0.416_wp * ( LOG( mean_d ) + &
10486	2.84_wp )*2 ) + 19.11_wp EXP( -0.482_wp * ( LOG( mean_d ) &
10487	- 1.362_wp )**2 ) )
10488	!
10489	!-- Lung-deposited surface area LDSA (units mum2/cm3)
10490	temp_bin = temp_bin + pi * mean_d*2 df * 1.0E-6_wp * &
10491	aerosol_number(ib)%conc(k,j,i)
10492	ENDDO
10493	ldsa_av(k,j,i) = ldsa_av(k,j,i) + temp_bin
10494	ENDDO
10495	ENDDO
10496	ENDDO
10497	ENDIF
10498
10499	CASE ( 'N_UFP' )
10500	IF ( ALLOCATED( nufp_av ) ) THEN
10501	DO i = nxlg, nxrg
10502	DO j = nysg, nyng
10503	DO k = nzb, nzt+1
10504	temp_bin = 0.0_wp
10505	DO ib = 1, nbins_aerosol
10506	IF ( 2.0_wp * ra_dry(k,j,i,ib) <= 0.1E-6_wp ) THEN
10507	temp_bin = temp_bin + aerosol_number(ib)%conc(k,j,i)
10508	ENDIF
10509	ENDDO
10510	nufp_av(k,j,i) = nufp_av(k,j,i) + temp_bin
10511	ENDDO
10512	ENDDO
10513	ENDDO
10514	ENDIF
10515
10516	CASE ( 'Ntot' )
10517	IF ( ALLOCATED( ntot_av ) ) THEN
10518	DO i = nxlg, nxrg
10519	DO j = nysg, nyng
10520	DO k = nzb, nzt+1
10521	DO ib = 1, nbins_aerosol
10522	ntot_av(k,j,i) = ntot_av(k,j,i) + aerosol_number(ib)%conc(k,j,i)
10523	ENDDO
10524	ENDDO
10525	ENDDO
10526	ENDDO
10527	ENDIF
10528
10529	CASE ( 'PM0.1' )
10530	IF ( ALLOCATED( pm01_av ) ) THEN
10531	DO i = nxlg, nxrg
10532	DO j = nysg, nyng
10533	DO k = nzb, nzt+1
10534	temp_bin = 0.0_wp
10535	DO ib = 1, nbins_aerosol
10536	IF ( 2.0_wp * ra_dry(k,j,i,ib) <= 0.1E-6_wp ) THEN
10537	DO ic = ib, nbins_aerosol * ncc, nbins_aerosol
10538	temp_bin = temp_bin + aerosol_mass(ic)%conc(k,j,i)
10539	ENDDO
10540	ENDIF
10541	ENDDO
10542	pm01_av(k,j,i) = pm01_av(k,j,i) + temp_bin
10543	ENDDO
10544	ENDDO
10545	ENDDO
10546	ENDIF
10547
10548	CASE ( 'PM2.5' )
10549	IF ( ALLOCATED( pm25_av ) ) THEN
10550	DO i = nxlg, nxrg
10551	DO j = nysg, nyng
10552	DO k = nzb, nzt+1
10553	temp_bin = 0.0_wp
10554	DO ib = 1, nbins_aerosol
10555	IF ( 2.0_wp * ra_dry(k,j,i,ib) <= 2.5E-6_wp ) THEN
10556	DO ic = ib, nbins_aerosol * ncc, nbins_aerosol
10557	temp_bin = temp_bin + aerosol_mass(ic)%conc(k,j,i)
10558	ENDDO
10559	ENDIF
10560	ENDDO
10561	pm25_av(k,j,i) = pm25_av(k,j,i) + temp_bin
10562	ENDDO
10563	ENDDO
10564	ENDDO
10565	ENDIF
10566
10567	CASE ( 'PM10' )
10568	IF ( ALLOCATED( pm10_av ) ) THEN
10569	DO i = nxlg, nxrg
10570	DO j = nysg, nyng
10571	DO k = nzb, nzt+1
10572	temp_bin = 0.0_wp
10573	DO ib = 1, nbins_aerosol
10574	IF ( 2.0_wp * ra_dry(k,j,i,ib) <= 10.0E-6_wp ) THEN
10575	DO ic = ib, nbins_aerosol * ncc, nbins_aerosol
10576	temp_bin = temp_bin + aerosol_mass(ic)%conc(k,j,i)
10577	ENDDO
10578	ENDIF
10579	ENDDO
10580	pm10_av(k,j,i) = pm10_av(k,j,i) + temp_bin
10581	ENDDO
10582	ENDDO
10583	ENDDO
10584	ENDIF
10585
10586	CASE ( 's_BC', 's_DU', 's_NH', 's_NO', 's_OC', 's_SO4', 's_SS' )
10587	IF ( ALLOCATED( s_mass_av ) ) THEN
10588	IF ( is_used( prtcl, TRIM( variable(9:) ) ) ) THEN ! 9: remove salsa_s_
10589	found_index = get_index( prtcl, TRIM( variable(9:) ) )
10590	DO i = nxlg, nxrg
10591	DO j = nysg, nyng
10592	DO k = nzb, nzt+1
10593	DO ic = ( found_index-1 ) * nbins_aerosol + 1, found_index * nbins_aerosol
10594	s_mass_av(k,j,i,found_index) = s_mass_av(k,j,i,found_index) + &
10595	aerosol_mass(ic)%conc(k,j,i)
10596	ENDDO
10597	ENDDO
10598	ENDDO
10599	ENDDO
10600	ENDIF
10601	ENDIF
10602
10603	CASE ( 's_H2O' )
10604	IF ( ALLOCATED( s_H2O_av ) ) THEN
10605	found_index = get_index( prtcl,'H2O' )
10606	to_be_resorted => s_h2o_av
10607	DO i = nxlg, nxrg
10608	DO j = nysg, nyng
10609	DO k = nzb, nzt+1
10610	DO ic = ( found_index-1 ) * nbins_aerosol + 1, found_index * nbins_aerosol
10611	s_h2o_av(k,j,i) = s_h2o_av(k,j,i) + aerosol_mass(ic)%conc(k,j,i)
10612	ENDDO
10613	ENDDO
10614	ENDDO
10615	ENDDO
10616	ENDIF
10617
10618	CASE DEFAULT
10619	CONTINUE
10620
10621	END SELECT
10622
10623	ENDIF
10624
10625	ELSEIF ( mode == 'average' ) THEN
10626
10627	IF ( variable(7:11) == 'N_bin' ) THEN
10628	IF ( ALLOCATED( nbins_av ) ) THEN
10629	READ( variable(12:),* ) char_to_int
10630	IF ( char_to_int >= 1 .AND. char_to_int <= SUM( nbin ) ) THEN
10631	ib = char_to_int
10632	DO i = nxlg, nxrg
10633	DO j = nysg, nyng
10634	DO k = nzb, nzt+1
10635	nbins_av(k,j,i,ib) = nbins_av(k,j,i,ib) / REAL( average_count_3d, KIND=wp )
10636	ENDDO
10637	ENDDO
10638	ENDDO
10639	ENDIF
10640	ENDIF
10641
10642	ELSEIF ( variable(7:11) == 'm_bin' ) THEN
10643	IF ( ALLOCATED( mbins_av ) ) THEN
10644	READ( variable(12:),* ) char_to_int
10645	IF ( char_to_int >= 1 .AND. char_to_int <= SUM( nbin ) ) THEN
10646	ib = char_to_int
10647	DO i = nxlg, nxrg
10648	DO j = nysg, nyng
10649	DO k = nzb, nzt+1
10650	mbins_av(k,j,i,ib) = mbins_av(k,j,i,ib) / REAL( average_count_3d, KIND=wp)
10651	ENDDO
10652	ENDDO
10653	ENDDO
10654	ENDIF
10655	ENDIF
10656	ELSE
10657
10658	SELECT CASE ( TRIM( variable(7:) ) )
10659
10660	CASE ( 'g_H2SO4', 'g_HNO3', 'g_NH3', 'g_OCNV', 'g_OCSV' )
10661	IF ( ALLOCATED( salsa_gases_av ) ) THEN
10662	IF ( TRIM( variable(9:) ) == 'H2SO4' ) THEN ! 9: remove salsa_g_ from beginning
10663	found_index = 1
10664	ELSEIF ( TRIM( variable(9:) ) == 'HNO3' ) THEN
10665	found_index = 2
10666	ELSEIF ( TRIM( variable(9:) ) == 'NH3' ) THEN
10667	found_index = 3
10668	ELSEIF ( TRIM( variable(9:) ) == 'OCNV' ) THEN
10669	found_index = 4
10670	ELSEIF ( TRIM( variable(9:) ) == 'OCSV' ) THEN
10671	found_index = 5
10672	ENDIF
10673	DO i = nxlg, nxrg
10674	DO j = nysg, nyng
10675	DO k = nzb, nzt+1
10676	salsa_gases_av(k,j,i,found_index) = salsa_gases_av(k,j,i,found_index) &
10677	/ REAL( average_count_3d, KIND=wp )
10678	ENDDO
10679	ENDDO
10680	ENDDO
10681	ENDIF
10682
10683	CASE ( 'LDSA' )
10684	IF ( ALLOCATED( ldsa_av ) ) THEN
10685	DO i = nxlg, nxrg
10686	DO j = nysg, nyng
10687	DO k = nzb, nzt+1
10688	ldsa_av(k,j,i) = ldsa_av(k,j,i) / REAL( average_count_3d, KIND=wp )
10689	ENDDO
10690	ENDDO
10691	ENDDO
10692	ENDIF
10693
10694	CASE ( 'N_UFP' )
10695	IF ( ALLOCATED( nufp_av ) ) THEN
10696	DO i = nxlg, nxrg
10697	DO j = nysg, nyng
10698	DO k = nzb, nzt+1
10699	nufp_av(k,j,i) = nufp_av(k,j,i) / REAL( average_count_3d, KIND=wp )
10700	ENDDO
10701	ENDDO
10702	ENDDO
10703	ENDIF
10704
10705	CASE ( 'Ntot' )
10706	IF ( ALLOCATED( ntot_av ) ) THEN
10707	DO i = nxlg, nxrg
10708	DO j = nysg, nyng
10709	DO k = nzb, nzt+1
10710	ntot_av(k,j,i) = ntot_av(k,j,i) / REAL( average_count_3d, KIND=wp )
10711	ENDDO
10712	ENDDO
10713	ENDDO
10714	ENDIF
10715
10716	CASE ( 'PM0.1' )
10717	IF ( ALLOCATED( pm01_av ) ) THEN
10718	DO i = nxlg, nxrg
10719	DO j = nysg, nyng
10720	DO k = nzb, nzt+1
10721	pm01_av(k,j,i) = pm01_av(k,j,i) / REAL( average_count_3d, KIND=wp )
10722	ENDDO
10723	ENDDO
10724	ENDDO
10725	ENDIF
10726
10727	CASE ( 'PM2.5' )
10728	IF ( ALLOCATED( pm25_av ) ) THEN
10729	DO i = nxlg, nxrg
10730	DO j = nysg, nyng
10731	DO k = nzb, nzt+1
10732	pm25_av(k,j,i) = pm25_av(k,j,i) / REAL( average_count_3d, KIND=wp )
10733	ENDDO
10734	ENDDO
10735	ENDDO
10736	ENDIF
10737
10738	CASE ( 'PM10' )
10739	IF ( ALLOCATED( pm10_av ) ) THEN
10740	DO i = nxlg, nxrg
10741	DO j = nysg, nyng
10742	DO k = nzb, nzt+1
10743	pm10_av(k,j,i) = pm10_av(k,j,i) / REAL( average_count_3d, KIND=wp )
10744	ENDDO
10745	ENDDO
10746	ENDDO
10747	ENDIF
10748
10749	CASE ( 's_BC', 's_DU', 's_NH', 's_NO', 's_OC', 's_SO4', 's_SS' )
10750	IF ( ALLOCATED( s_mass_av ) ) THEN
10751	IF ( is_used( prtcl, TRIM( variable(9:) ) ) ) THEN ! 9: remove salsa_s_
10752	found_index = get_index( prtcl, TRIM( variable(9:) ) )
10753	DO i = nxlg, nxrg
10754	DO j = nysg, nyng
10755	DO k = nzb, nzt+1
10756	s_mass_av(k,j,i,found_index) = s_mass_av(k,j,i,found_index) / &
10757	REAL( average_count_3d, KIND=wp )
10758	ENDDO
10759	ENDDO
10760	ENDDO
10761	ENDIF
10762	ENDIF
10763
10764	CASE ( 's_H2O' )
10765	to_be_resorted => s_h2o_av
10766	DO i = nxlg, nxrg
10767	DO j = nysg, nyng
10768	DO k = nzb, nzt+1
10769	to_be_resorted(k,j,i) = to_be_resorted(k,j,i) / &
10770	REAL( average_count_3d, KIND=wp )
10771	ENDDO
10772	ENDDO
10773	ENDDO
10774
10775	END SELECT
10776
10777	ENDIF
10778	ENDIF
10779
10780	END SUBROUTINE salsa_3d_data_averaging
10781
10782
10783	!------------------------------------------------------------------------------!
10784	!
10785	! Description:
10786	! ------------
10787	!> Subroutine defining 2D output variables
10788	!------------------------------------------------------------------------------!
10789	SUBROUTINE salsa_data_output_2d( av, variable, found, grid, mode, local_pf, two_d, nzb_do, nzt_do )
10790
10791	USE indices
10792
10793	USE kinds
10794
10795
10796	IMPLICIT NONE
10797
10798	CHARACTER(LEN=*) :: grid !<
10799	CHARACTER(LEN=*) :: mode !<
10800	CHARACTER(LEN=*) :: variable !<
10801	CHARACTER(LEN=5) :: vari !< trimmed format of variable
10802
10803	INTEGER(iwp) :: av !<
10804	INTEGER(iwp) :: char_to_int !< for converting character to integer
10805	INTEGER(iwp) :: found_index !< index of a chemical compound
10806	INTEGER(iwp) :: i !<
10807	INTEGER(iwp) :: ib !< running index: size bins
10808	INTEGER(iwp) :: ic !< running index: mass bins
10809	INTEGER(iwp) :: j !<
10810	INTEGER(iwp) :: k !<
10811	INTEGER(iwp) :: nzb_do !<
10812	INTEGER(iwp) :: nzt_do !<
10813
10814	LOGICAL :: found !<
10815	LOGICAL :: two_d !< flag parameter to indicate 2D variables (horizontal cross sections)
10816
10817	REAL(wp) :: df !< For calculating LDSA: fraction of particles
10818	!< depositing in the alveolar (or tracheobronchial)
10819	!< region of the lung. Depends on the particle size
10820	REAL(wp) :: mean_d !< Particle diameter in micrometres
10821	REAL(wp) :: temp_bin !< temporary array for calculating output variables
10822
10823	REAL(wp), DIMENSION(nxl:nxr,nys:nyn,nzb_do:nzt_do) :: local_pf !< output
10824	!
10825	!-- Next statement is to avoid compiler warning about unused variable. May be removed in future.
10826	IF ( two_d ) CONTINUE
10827
10828	found = .TRUE.
10829	temp_bin = 0.0_wp
10830
10831	IF ( variable(7:11) == 'N_bin' ) THEN
10832
10833	READ( variable( 12:LEN( TRIM( variable ) ) - 3 ), * ) char_to_int
10834	IF ( char_to_int >= 1 .AND. char_to_int <= SUM( nbin ) ) THEN
10835
10836	ib = char_to_int
10837	IF ( av == 0 ) THEN
10838	DO i = nxl, nxr
10839	DO j = nys, nyn
10840	DO k = nzb_do, nzt_do
10841	local_pf(i,j,k) = MERGE( aerosol_number(ib)%conc(k,j,i), REAL( fill_value, &
10842	KIND = wp ), BTEST( wall_flags_total_0(k,j,i), 0 ) )
10843	ENDDO
10844	ENDDO
10845	ENDDO
10846	ELSE
10847	IF ( .NOT. ALLOCATED( nbins_av ) ) THEN
10848	ALLOCATE( nbins_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg,nbins_aerosol) )
10849	nbins_av = REAL( fill_value, KIND = wp )
10850	ENDIF
10851	DO i = nxl, nxr
10852	DO j = nys, nyn
10853	DO k = nzb_do, nzt_do
10854	local_pf(i,j,k) = MERGE( nbins_av(k,j,i,ib), REAL( fill_value, KIND = wp ), &
10855	BTEST( wall_flags_total_0(k,j,i), 0 ) )
10856	ENDDO
10857	ENDDO
10858	ENDDO
10859	ENDIF
10860	IF ( mode == 'xy' ) grid = 'zu'
10861	ENDIF
10862
10863	ELSEIF ( variable(7:11) == 'm_bin' ) THEN
10864
10865	READ( variable( 12:LEN( TRIM( variable ) ) - 3 ), * ) char_to_int
10866	IF ( char_to_int >= 1 .AND. char_to_int <= SUM( nbin ) ) THEN
10867
10868	ib = char_to_int
10869	IF ( av == 0 ) THEN
10870	DO i = nxl, nxr
10871	DO j = nys, nyn
10872	DO k = nzb_do, nzt_do
10873	temp_bin = 0.0_wp
10874	DO ic = ib, ncomponents_mass * nbins_aerosol, nbins_aerosol
10875	temp_bin = temp_bin + aerosol_mass(ic)%conc(k,j,i)
10876	ENDDO
10877	local_pf(i,j,k) = MERGE( temp_bin, REAL( fill_value, KIND = wp ), &
10878	BTEST( wall_flags_total_0(k,j,i), 0 ) )
10879	ENDDO
10880	ENDDO
10881	ENDDO
10882	ELSE
10883	IF ( .NOT. ALLOCATED( mbins_av ) ) THEN
10884	ALLOCATE( mbins_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg,nbins_aerosol) )
10885	mbins_av = REAL( fill_value, KIND = wp )
10886	ENDIF
10887	DO i = nxl, nxr
10888	DO j = nys, nyn
10889	DO k = nzb_do, nzt_do
10890	local_pf(i,j,k) = MERGE( mbins_av(k,j,i,ib), REAL( fill_value, KIND = wp ), &
10891	BTEST( wall_flags_total_0(k,j,i), 0 ) )
10892	ENDDO
10893	ENDDO
10894	ENDDO
10895	ENDIF
10896	IF ( mode == 'xy' ) grid = 'zu'
10897	ENDIF
10898
10899	ELSE
10900
10901	SELECT CASE ( TRIM( variable( 7:LEN( TRIM( variable ) ) - 3 ) ) ) ! cut out _xy, _xz or _yz
10902
10903	CASE ( 'g_H2SO4', 'g_HNO3', 'g_NH3', 'g_OCNV', 'g_OCSV' )
10904	vari = TRIM( variable( 9:LEN( TRIM( variable ) ) - 3 ) ) ! 9: remove salsa_g_
10905	IF ( vari == 'H2SO4') found_index = 1
10906	IF ( vari == 'HNO3') found_index = 2
10907	IF ( vari == 'NH3') found_index = 3
10908	IF ( vari == 'OCNV') found_index = 4
10909	IF ( vari == 'OCSV') found_index = 5
10910	IF ( av == 0 ) THEN
10911	DO i = nxl, nxr
10912	DO j = nys, nyn
10913	DO k = nzb_do, nzt_do
10914	local_pf(i,j,k) = MERGE( salsa_gas(found_index)%conc(k,j,i), &
10915	REAL( fill_value, KIND = wp ), &
10916	BTEST( wall_flags_total_0(k,j,i), 0 ) )
10917	ENDDO
10918	ENDDO
10919	ENDDO
10920	ELSE
10921	IF ( .NOT. ALLOCATED( salsa_gases_av ) ) THEN
10922	ALLOCATE( salsa_gases_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg,ngases_salsa) )
10923	salsa_gases_av = REAL( fill_value, KIND = wp )
10924	ENDIF
10925	DO i = nxl, nxr
10926	DO j = nys, nyn
10927	DO k = nzb_do, nzt_do
10928	local_pf(i,j,k) = MERGE( salsa_gases_av(k,j,i,found_index), &
10929	REAL( fill_value, KIND = wp ), &
10930	BTEST( wall_flags_total_0(k,j,i), 0 ) )
10931	ENDDO
10932	ENDDO
10933	ENDDO
10934	ENDIF
10935
10936	IF ( mode == 'xy' ) grid = 'zu'
10937
10938	CASE ( 'LDSA' )
10939	IF ( av == 0 ) THEN
10940	DO i = nxl, nxr
10941	DO j = nys, nyn
10942	DO k = nzb_do, nzt_do
10943	temp_bin = 0.0_wp
10944	DO ib = 1, nbins_aerosol
10945	!
10946	!-- Diameter in micrometres
10947	mean_d = 1.0E+6_wp * ra_dry(k,j,i,ib) * 2.0_wp
10948	!
10949	!-- Deposition factor: alveolar
10950	df = ( 0.01555_wp / mean_d ) * ( EXP( -0.416_wp * ( LOG( mean_d ) + &
10951	2.84_wp )*2 ) + 19.11_wp EXP( -0.482_wp * ( LOG( mean_d ) - &
10952	1.362_wp )**2 ) )
10953	!
10954	!-- Lung-deposited surface area LDSA (units mum2/cm3)
10955	temp_bin = temp_bin + pi * mean_d*2 df * 1.0E-6_wp * &
10956	aerosol_number(ib)%conc(k,j,i)
10957	ENDDO
10958
10959	local_pf(i,j,k) = MERGE( temp_bin, REAL( fill_value, KIND = wp ), &
10960	BTEST( wall_flags_total_0(k,j,i), 0 ) )
10961	ENDDO
10962	ENDDO
10963	ENDDO
10964	ELSE
10965	IF ( .NOT. ALLOCATED( ldsa_av ) ) THEN
10966	ALLOCATE( ldsa_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
10967	ldsa_av = REAL( fill_value, KIND = wp )
10968	ENDIF
10969	DO i = nxl, nxr
10970	DO j = nys, nyn
10971	DO k = nzb_do, nzt_do
10972	local_pf(i,j,k) = MERGE( ldsa_av(k,j,i), REAL( fill_value, KIND = wp ), &
10973	BTEST( wall_flags_total_0(k,j,i), 0 ) )
10974	ENDDO
10975	ENDDO
10976	ENDDO
10977	ENDIF
10978
10979	IF ( mode == 'xy' ) grid = 'zu'
10980
10981	CASE ( 'N_UFP' )
10982
10983	IF ( av == 0 ) THEN
10984	DO i = nxl, nxr
10985	DO j = nys, nyn
10986	DO k = nzb_do, nzt_do
10987	temp_bin = 0.0_wp
10988	DO ib = 1, nbins_aerosol
10989	IF ( 2.0_wp * ra_dry(k,j,i,ib) <= 0.1E-6_wp ) THEN
10990	temp_bin = temp_bin + aerosol_number(ib)%conc(k,j,i)
10991	ENDIF
10992	ENDDO
10993	local_pf(i,j,k) = MERGE( temp_bin, REAL( fill_value, KIND = wp ), &
10994	BTEST( wall_flags_total_0(k,j,i), 0 ) )
10995	ENDDO
10996	ENDDO
10997	ENDDO
10998	ELSE
10999	IF ( .NOT. ALLOCATED( nufp_av ) ) THEN
11000	ALLOCATE( nufp_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
11001	nufp_av = REAL( fill_value, KIND = wp )
11002	ENDIF
11003	DO i = nxl, nxr
11004	DO j = nys, nyn
11005	DO k = nzb_do, nzt_do
11006	local_pf(i,j,k) = MERGE( nufp_av(k,j,i), REAL( fill_value, KIND = wp ), &
11007	BTEST( wall_flags_total_0(k,j,i), 0 ) )
11008	ENDDO
11009	ENDDO
11010	ENDDO
11011	ENDIF
11012
11013	IF ( mode == 'xy' ) grid = 'zu'
11014
11015	CASE ( 'Ntot' )
11016
11017	IF ( av == 0 ) THEN
11018	DO i = nxl, nxr
11019	DO j = nys, nyn
11020	DO k = nzb_do, nzt_do
11021	temp_bin = 0.0_wp
11022	DO ib = 1, nbins_aerosol
11023	temp_bin = temp_bin + aerosol_number(ib)%conc(k,j,i)
11024	ENDDO
11025	local_pf(i,j,k) = MERGE( temp_bin, REAL( fill_value, KIND = wp ), &
11026	BTEST( wall_flags_total_0(k,j,i), 0 ) )
11027	ENDDO
11028	ENDDO
11029	ENDDO
11030	ELSE
11031	IF ( .NOT. ALLOCATED( ntot_av ) ) THEN
11032	ALLOCATE( ntot_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
11033	ntot_av = REAL( fill_value, KIND = wp )
11034	ENDIF
11035	DO i = nxl, nxr
11036	DO j = nys, nyn
11037	DO k = nzb_do, nzt_do
11038	local_pf(i,j,k) = MERGE( ntot_av(k,j,i), REAL( fill_value, KIND = wp ), &
11039	BTEST( wall_flags_total_0(k,j,i), 0 ) )
11040	ENDDO
11041	ENDDO
11042	ENDDO
11043	ENDIF
11044
11045	IF ( mode == 'xy' ) grid = 'zu'
11046
11047	CASE ( 'PM0.1' )
11048	IF ( av == 0 ) THEN
11049	DO i = nxl, nxr
11050	DO j = nys, nyn
11051	DO k = nzb_do, nzt_do
11052	temp_bin = 0.0_wp
11053	DO ib = 1, nbins_aerosol
11054	IF ( 2.0_wp * ra_dry(k,j,i,ib) <= 0.1E-6_wp ) THEN
11055	DO ic = ib, nbins_aerosol * ncc, nbins_aerosol
11056	temp_bin = temp_bin + aerosol_mass(ic)%conc(k,j,i)
11057	ENDDO
11058	ENDIF
11059	ENDDO
11060	local_pf(i,j,k) = MERGE( temp_bin, REAL( fill_value, KIND = wp ), &
11061	BTEST( wall_flags_total_0(k,j,i), 0 ) )
11062	ENDDO
11063	ENDDO
11064	ENDDO
11065	ELSE
11066	IF ( .NOT. ALLOCATED( pm01_av ) ) THEN
11067	ALLOCATE( pm01_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
11068	pm01_av = REAL( fill_value, KIND = wp )
11069	ENDIF
11070	DO i = nxl, nxr
11071	DO j = nys, nyn
11072	DO k = nzb_do, nzt_do
11073	local_pf(i,j,k) = MERGE( pm01_av(k,j,i), REAL( fill_value, KIND = wp ), &
11074	BTEST( wall_flags_total_0(k,j,i), 0 ) )
11075	ENDDO
11076	ENDDO
11077	ENDDO
11078	ENDIF
11079
11080	IF ( mode == 'xy' ) grid = 'zu'
11081
11082	CASE ( 'PM2.5' )
11083	IF ( av == 0 ) THEN
11084	DO i = nxl, nxr
11085	DO j = nys, nyn
11086	DO k = nzb_do, nzt_do
11087	temp_bin = 0.0_wp
11088	DO ib = 1, nbins_aerosol
11089	IF ( 2.0_wp * ra_dry(k,j,i,ib) <= 2.5E-6_wp ) THEN
11090	DO ic = ib, nbins_aerosol * ncc, nbins_aerosol
11091	temp_bin = temp_bin + aerosol_mass(ic)%conc(k,j,i)
11092	ENDDO
11093	ENDIF
11094	ENDDO
11095	local_pf(i,j,k) = MERGE( temp_bin, REAL( fill_value, KIND = wp ), &
11096	BTEST( wall_flags_total_0(k,j,i), 0 ) )
11097	ENDDO
11098	ENDDO
11099	ENDDO
11100	ELSE
11101	IF ( .NOT. ALLOCATED( pm25_av ) ) THEN
11102	ALLOCATE( pm25_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
11103	pm25_av = REAL( fill_value, KIND = wp )
11104	ENDIF
11105	DO i = nxl, nxr
11106	DO j = nys, nyn
11107	DO k = nzb_do, nzt_do
11108	local_pf(i,j,k) = MERGE( pm25_av(k,j,i), REAL( fill_value, KIND = wp ), &
11109	BTEST( wall_flags_total_0(k,j,i), 0 ) )
11110	ENDDO
11111	ENDDO
11112	ENDDO
11113	ENDIF
11114
11115	IF ( mode == 'xy' ) grid = 'zu'
11116
11117	CASE ( 'PM10' )
11118	IF ( av == 0 ) THEN
11119	DO i = nxl, nxr
11120	DO j = nys, nyn
11121	DO k = nzb_do, nzt_do
11122	temp_bin = 0.0_wp
11123	DO ib = 1, nbins_aerosol
11124	IF ( 2.0_wp * ra_dry(k,j,i,ib) <= 10.0E-6_wp ) THEN
11125	DO ic = ib, nbins_aerosol * ncc, nbins_aerosol
11126	temp_bin = temp_bin + aerosol_mass(ic)%conc(k,j,i)
11127	ENDDO
11128	ENDIF
11129	ENDDO
11130	local_pf(i,j,k) = MERGE( temp_bin, REAL( fill_value, KIND = wp ), &
11131	BTEST( wall_flags_total_0(k,j,i), 0 ) )
11132	ENDDO
11133	ENDDO
11134	ENDDO
11135	ELSE
11136	IF ( .NOT. ALLOCATED( pm10_av ) ) THEN
11137	ALLOCATE( pm10_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
11138	pm10_av = REAL( fill_value, KIND = wp )
11139	ENDIF
11140	DO i = nxl, nxr
11141	DO j = nys, nyn
11142	DO k = nzb_do, nzt_do
11143	local_pf(i,j,k) = MERGE( pm10_av(k,j,i), REAL( fill_value, KIND = wp ), &
11144	BTEST( wall_flags_total_0(k,j,i), 0 ) )
11145	ENDDO
11146	ENDDO
11147	ENDDO
11148	ENDIF
11149
11150	IF ( mode == 'xy' ) grid = 'zu'
11151
11152	CASE ( 's_BC', 's_DU', 's_NH', 's_NO', 's_OC', 's_SO4', 's_SS' )
11153	vari = TRIM( variable( 9:LEN( TRIM( variable ) ) - 3 ) ) ! 9: remove salsa_s_
11154	IF ( is_used( prtcl, vari ) ) THEN
11155	found_index = get_index( prtcl, vari )
11156	IF ( av == 0 ) THEN
11157	DO i = nxl, nxr
11158	DO j = nys, nyn
11159	DO k = nzb_do, nzt_do
11160	temp_bin = 0.0_wp
11161	DO ic = ( found_index-1 ) * nbins_aerosol+1, found_index * nbins_aerosol
11162	temp_bin = temp_bin + aerosol_mass(ic)%conc(k,j,i)
11163	ENDDO
11164	local_pf(i,j,k) = MERGE( temp_bin, REAL( fill_value, KIND = wp ), &
11165	BTEST( wall_flags_total_0(k,j,i), 0 ) )
11166	ENDDO
11167	ENDDO
11168	ENDDO
11169	ELSE
11170	IF ( .NOT. ALLOCATED( s_mass_av ) ) THEN
11171	ALLOCATE( s_mass_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg,ncomponents_mass) )
11172	s_mass_av = REAL( fill_value, KIND = wp )
11173	ENDIF
11174	DO i = nxl, nxr
11175	DO j = nys, nyn
11176	DO k = nzb_do, nzt_do
11177	local_pf(i,j,k) = MERGE( s_mass_av(k,j,i,found_index), &
11178	REAL( fill_value, KIND = wp ), &
11179	BTEST( wall_flags_total_0(k,j,i), 0 ) )
11180	ENDDO
11181	ENDDO
11182	ENDDO
11183	ENDIF
11184	ELSE
11185	local_pf = fill_value
11186	ENDIF
11187
11188	IF ( mode == 'xy' ) grid = 'zu'
11189
11190	CASE ( 's_H2O' )
11191	found_index = get_index( prtcl, 'H2O' )
11192	IF ( av == 0 ) THEN
11193	DO i = nxl, nxr
11194	DO j = nys, nyn
11195	DO k = nzb_do, nzt_do
11196	temp_bin = 0.0_wp
11197	DO ic = ( found_index-1 ) * nbins_aerosol+1, found_index * nbins_aerosol
11198	temp_bin = temp_bin + aerosol_mass(ic)%conc(k,j,i)
11199	ENDDO
11200	local_pf(i,j,k) = MERGE( temp_bin, REAL( fill_value, KIND = wp ), &
11201	BTEST( wall_flags_total_0(k,j,i), 0 ) )
11202	ENDDO
11203	ENDDO
11204	ENDDO
11205	ELSE
11206	! to_be_resorted => s_h2o_av
11207	IF ( .NOT. ALLOCATED( s_h2o_av ) ) THEN
11208	ALLOCATE( s_h2o_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
11209	s_h2o_av = REAL( fill_value, KIND = wp )
11210	ENDIF
11211	DO i = nxl, nxr
11212	DO j = nys, nyn
11213	DO k = nzb_do, nzt_do
11214	local_pf(i,j,k) = MERGE( s_h2o_av(k,j,i), REAL( fill_value, KIND = wp ), &
11215	BTEST( wall_flags_total_0(k,j,i), 0 ) )
11216	ENDDO
11217	ENDDO
11218	ENDDO
11219	ENDIF
11220
11221	IF ( mode == 'xy' ) grid = 'zu'
11222
11223	CASE DEFAULT
11224	found = .FALSE.
11225	grid = 'none'
11226
11227	END SELECT
11228
11229	ENDIF
11230
11231	END SUBROUTINE salsa_data_output_2d
11232
11233	!------------------------------------------------------------------------------!
11234	!
11235	! Description:
11236	! ------------
11237	!> Subroutine defining 3D output variables
11238	!------------------------------------------------------------------------------!
11239	SUBROUTINE salsa_data_output_3d( av, variable, found, local_pf, nzb_do, nzt_do )
11240
11241	USE indices
11242
11243	USE kinds
11244
11245
11246	IMPLICIT NONE
11247
11248	CHARACTER(LEN=*), INTENT(in) :: variable !<
11249
11250	INTEGER(iwp) :: av !<
11251	INTEGER(iwp) :: char_to_int !< for converting character to integer
11252	INTEGER(iwp) :: found_index !< index of a chemical compound
11253	INTEGER(iwp) :: ib !< running index: size bins
11254	INTEGER(iwp) :: ic !< running index: mass bins
11255	INTEGER(iwp) :: i !<
11256	INTEGER(iwp) :: j !<
11257	INTEGER(iwp) :: k !<
11258	INTEGER(iwp) :: nzb_do !<
11259	INTEGER(iwp) :: nzt_do !<
11260
11261	LOGICAL :: found !<
11262
11263	REAL(wp) :: df !< For calculating LDSA: fraction of particles
11264	!< depositing in the alveolar (or tracheobronchial)
11265	!< region of the lung. Depends on the particle size
11266	REAL(wp) :: mean_d !< Particle diameter in micrometres
11267	REAL(wp) :: temp_bin !< temporary array for calculating output variables
11268
11269	REAL(sp), DIMENSION(nxl:nxr,nys:nyn,nzb_do:nzt_do) :: local_pf !< local
11270
11271	found = .TRUE.
11272	temp_bin = 0.0_wp
11273
11274	IF ( variable(7:11) == 'N_bin' ) THEN
11275	READ( variable(12:),* ) char_to_int
11276	IF ( char_to_int >= 1 .AND. char_to_int <= SUM( nbin ) ) THEN
11277
11278	ib = char_to_int
11279	IF ( av == 0 ) THEN
11280	DO i = nxl, nxr
11281	DO j = nys, nyn
11282	DO k = nzb_do, nzt_do
11283	local_pf(i,j,k) = MERGE( aerosol_number(ib)%conc(k,j,i), REAL( fill_value, &
11284	KIND = wp ), BTEST( wall_flags_total_0(k,j,i), 0 ) )
11285	ENDDO
11286	ENDDO
11287	ENDDO
11288	ELSE
11289	IF ( .NOT. ALLOCATED( nbins_av ) ) THEN
11290	ALLOCATE( nbins_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg,nbins_aerosol) )
11291	nbins_av = REAL( fill_value, KIND = wp )
11292	ENDIF
11293	DO i = nxl, nxr
11294	DO j = nys, nyn
11295	DO k = nzb_do, nzt_do
11296	local_pf(i,j,k) = MERGE( nbins_av(k,j,i,ib), REAL( fill_value, KIND = wp ), &
11297	BTEST( wall_flags_total_0(k,j,i), 0 ) )
11298	ENDDO
11299	ENDDO
11300	ENDDO
11301	ENDIF
11302	ENDIF
11303
11304	ELSEIF ( variable(7:11) == 'm_bin' ) THEN
11305	READ( variable(12:),* ) char_to_int
11306	IF ( char_to_int >= 1 .AND. char_to_int <= SUM( nbin ) ) THEN
11307
11308	ib = char_to_int
11309	IF ( av == 0 ) THEN
11310	DO i = nxl, nxr
11311	DO j = nys, nyn
11312	DO k = nzb_do, nzt_do
11313	temp_bin = 0.0_wp
11314	DO ic = ib, ncomponents_mass * nbins_aerosol, nbins_aerosol
11315	temp_bin = temp_bin + aerosol_mass(ic)%conc(k,j,i)
11316	ENDDO
11317	local_pf(i,j,k) = MERGE( temp_bin, REAL( fill_value, KIND = wp ), &
11318	BTEST( wall_flags_total_0(k,j,i), 0 ) )
11319	ENDDO
11320	ENDDO
11321	ENDDO
11322	ELSE
11323	IF ( .NOT. ALLOCATED( mbins_av ) ) THEN
11324	ALLOCATE( mbins_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg,nbins_aerosol) )
11325	mbins_av = REAL( fill_value, KIND = wp )
11326	ENDIF
11327	DO i = nxl, nxr
11328	DO j = nys, nyn
11329	DO k = nzb_do, nzt_do
11330	local_pf(i,j,k) = MERGE( mbins_av(k,j,i,ib), REAL( fill_value, KIND = wp ), &
11331	BTEST( wall_flags_total_0(k,j,i), 0 ) )
11332	ENDDO
11333	ENDDO
11334	ENDDO
11335	ENDIF
11336	ENDIF
11337
11338	ELSE
11339	SELECT CASE ( TRIM( variable(7:) ) )
11340
11341	CASE ( 'g_H2SO4', 'g_HNO3', 'g_NH3', 'g_OCNV', 'g_OCSV' )
11342	IF ( TRIM( variable(7:) ) == 'g_H2SO4') found_index = 1
11343	IF ( TRIM( variable(7:) ) == 'g_HNO3') found_index = 2
11344	IF ( TRIM( variable(7:) ) == 'g_NH3') found_index = 3
11345	IF ( TRIM( variable(7:) ) == 'g_OCNV') found_index = 4
11346	IF ( TRIM( variable(7:) ) == 'g_OCSV') found_index = 5
11347
11348	IF ( av == 0 ) THEN
11349	DO i = nxl, nxr
11350	DO j = nys, nyn
11351	DO k = nzb_do, nzt_do
11352	local_pf(i,j,k) = MERGE( salsa_gas(found_index)%conc(k,j,i), &
11353	REAL( fill_value, KIND = wp ), &
11354	BTEST( wall_flags_total_0(k,j,i), 0 ) )
11355	ENDDO
11356	ENDDO
11357	ENDDO
11358	ELSE
11359	IF ( .NOT. ALLOCATED( salsa_gases_av ) ) THEN
11360	ALLOCATE( salsa_gases_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg,ngases_salsa) )
11361	salsa_gases_av = REAL( fill_value, KIND = wp )
11362	ENDIF
11363	DO i = nxl, nxr
11364	DO j = nys, nyn
11365	DO k = nzb_do, nzt_do
11366	! local_pf(i,j,k) = MERGE( to_be_resorted(k,j,i), REAL( fill_value, &
11367	! KIND = wp ), BTEST( wall_flags_total_0(k,j,i), 0 ) )
11368	local_pf(i,j,k) = MERGE( salsa_gases_av(k,j,i,found_index), &
11369	REAL( fill_value, KIND = wp ), &
11370	BTEST( wall_flags_total_0(k,j,i), 0 ) )
11371	ENDDO
11372	ENDDO
11373	ENDDO
11374	ENDIF
11375
11376	CASE ( 'LDSA' )
11377	IF ( av == 0 ) THEN
11378	DO i = nxl, nxr
11379	DO j = nys, nyn
11380	DO k = nzb_do, nzt_do
11381	temp_bin = 0.0_wp
11382	DO ib = 1, nbins_aerosol
11383	!
11384	!-- Diameter in micrometres
11385	mean_d = 1.0E+6_wp * ra_dry(k,j,i,ib) * 2.0_wp
11386	!
11387	!-- Deposition factor: alveolar
11388	df = ( 0.01555_wp / mean_d ) * ( EXP( -0.416_wp * ( LOG( mean_d ) + &
11389	2.84_wp )*2 ) + 19.11_wp EXP( -0.482_wp * ( LOG( mean_d ) - &
11390	1.362_wp )**2 ) )
11391	!
11392	!-- Lung-deposited surface area LDSA (units mum2/cm3)
11393	temp_bin = temp_bin + pi * mean_d*2 df * 1.0E-6_wp * &
11394	aerosol_number(ib)%conc(k,j,i)
11395	ENDDO
11396	local_pf(i,j,k) = MERGE( temp_bin, REAL( fill_value, KIND = wp ), &
11397	BTEST( wall_flags_total_0(k,j,i), 0 ) )
11398	ENDDO
11399	ENDDO
11400	ENDDO
11401	ELSE
11402	IF ( .NOT. ALLOCATED( ldsa_av ) ) THEN
11403	ALLOCATE( ldsa_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
11404	ldsa_av = REAL( fill_value, KIND = wp )
11405	ENDIF
11406	DO i = nxl, nxr
11407	DO j = nys, nyn
11408	DO k = nzb_do, nzt_do
11409	local_pf(i,j,k) = MERGE( ldsa_av(k,j,i), REAL( fill_value, KIND = wp ), &
11410	BTEST( wall_flags_total_0(k,j,i), 0 ) )
11411	ENDDO
11412	ENDDO
11413	ENDDO
11414	ENDIF
11415
11416	CASE ( 'N_UFP' )
11417	IF ( av == 0 ) THEN
11418	DO i = nxl, nxr
11419	DO j = nys, nyn
11420	DO k = nzb_do, nzt_do
11421	temp_bin = 0.0_wp
11422	DO ib = 1, nbins_aerosol
11423	IF ( 2.0_wp * ra_dry(k,j,i,ib) <= 0.1E-6_wp ) THEN
11424	temp_bin = temp_bin + aerosol_number(ib)%conc(k,j,i)
11425	ENDIF
11426	ENDDO
11427	local_pf(i,j,k) = MERGE( temp_bin, REAL( fill_value, KIND = wp ), &
11428	BTEST( wall_flags_total_0(k,j,i), 0 ) )
11429	ENDDO
11430	ENDDO
11431	ENDDO
11432	ELSE
11433	IF ( .NOT. ALLOCATED( nufp_av ) ) THEN
11434	ALLOCATE( nufp_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
11435	nufp_av = REAL( fill_value, KIND = wp )
11436	ENDIF
11437	DO i = nxl, nxr
11438	DO j = nys, nyn
11439	DO k = nzb_do, nzt_do
11440	local_pf(i,j,k) = MERGE( nufp_av(k,j,i), REAL( fill_value, KIND = wp ), &
11441	BTEST( wall_flags_total_0(k,j,i), 0 ) )
11442	ENDDO
11443	ENDDO
11444	ENDDO
11445	ENDIF
11446
11447	CASE ( 'Ntot' )
11448	IF ( av == 0 ) THEN
11449	DO i = nxl, nxr
11450	DO j = nys, nyn
11451	DO k = nzb_do, nzt_do
11452	temp_bin = 0.0_wp
11453	DO ib = 1, nbins_aerosol
11454	temp_bin = temp_bin + aerosol_number(ib)%conc(k,j,i)
11455	ENDDO
11456	local_pf(i,j,k) = MERGE( temp_bin, REAL( fill_value, KIND = wp ), &
11457	BTEST( wall_flags_total_0(k,j,i), 0 ) )
11458	ENDDO
11459	ENDDO
11460	ENDDO
11461	ELSE
11462	IF ( .NOT. ALLOCATED( ntot_av ) ) THEN
11463	ALLOCATE( ntot_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
11464	ntot_av = REAL( fill_value, KIND = wp )
11465	ENDIF
11466	DO i = nxl, nxr
11467	DO j = nys, nyn
11468	DO k = nzb_do, nzt_do
11469	local_pf(i,j,k) = MERGE( ntot_av(k,j,i), REAL( fill_value, KIND = wp ), &
11470	BTEST( wall_flags_total_0(k,j,i), 0 ) )
11471	ENDDO
11472	ENDDO
11473	ENDDO
11474	ENDIF
11475
11476	CASE ( 'PM0.1' )
11477	IF ( av == 0 ) THEN
11478	DO i = nxl, nxr
11479	DO j = nys, nyn
11480	DO k = nzb_do, nzt_do
11481	temp_bin = 0.0_wp
11482	DO ib = 1, nbins_aerosol
11483	IF ( 2.0_wp * ra_dry(k,j,i,ib) <= 0.1E-6_wp ) THEN
11484	DO ic = ib, nbins_aerosol * ncc, nbins_aerosol
11485	temp_bin = temp_bin + aerosol_mass(ic)%conc(k,j,i)
11486	ENDDO
11487	ENDIF
11488	ENDDO
11489	local_pf(i,j,k) = MERGE( temp_bin, REAL( fill_value, KIND = wp ), &
11490	BTEST( wall_flags_total_0(k,j,i), 0 ) )
11491	ENDDO
11492	ENDDO
11493	ENDDO
11494	ELSE
11495	IF ( .NOT. ALLOCATED( pm01_av ) ) THEN
11496	ALLOCATE( pm01_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
11497	pm01_av = REAL( fill_value, KIND = wp )
11498	ENDIF
11499	DO i = nxl, nxr
11500	DO j = nys, nyn
11501	DO k = nzb_do, nzt_do
11502	local_pf(i,j,k) = MERGE( pm01_av(k,j,i), REAL( fill_value, KIND = wp ), &
11503	BTEST( wall_flags_total_0(k,j,i), 0 ) )
11504	ENDDO
11505	ENDDO
11506	ENDDO
11507	ENDIF
11508
11509	CASE ( 'PM2.5' )
11510	IF ( av == 0 ) THEN
11511	DO i = nxl, nxr
11512	DO j = nys, nyn
11513	DO k = nzb_do, nzt_do
11514	temp_bin = 0.0_wp
11515	DO ib = 1, nbins_aerosol
11516	IF ( 2.0_wp * ra_dry(k,j,i,ib) <= 2.5E-6_wp ) THEN
11517	DO ic = ib, nbins_aerosol * ncc, nbins_aerosol
11518	temp_bin = temp_bin + aerosol_mass(ic)%conc(k,j,i)
11519	ENDDO
11520	ENDIF
11521	ENDDO
11522	local_pf(i,j,k) = MERGE( temp_bin, REAL( fill_value, KIND = wp ), &
11523	BTEST( wall_flags_total_0(k,j,i), 0 ) )
11524	ENDDO
11525	ENDDO
11526	ENDDO
11527	ELSE
11528	IF ( .NOT. ALLOCATED( pm25_av ) ) THEN
11529	ALLOCATE( pm25_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
11530	pm25_av = REAL( fill_value, KIND = wp )
11531	ENDIF
11532	DO i = nxl, nxr
11533	DO j = nys, nyn
11534	DO k = nzb_do, nzt_do
11535	local_pf(i,j,k) = MERGE( pm25_av(k,j,i), REAL( fill_value, KIND = wp ), &
11536	BTEST( wall_flags_total_0(k,j,i), 0 ) )
11537	ENDDO
11538	ENDDO
11539	ENDDO
11540	ENDIF
11541
11542	CASE ( 'PM10' )
11543	IF ( av == 0 ) THEN
11544	DO i = nxl, nxr
11545	DO j = nys, nyn
11546	DO k = nzb_do, nzt_do
11547	temp_bin = 0.0_wp
11548	DO ib = 1, nbins_aerosol
11549	IF ( 2.0_wp * ra_dry(k,j,i,ib) <= 10.0E-6_wp ) THEN
11550	DO ic = ib, nbins_aerosol * ncc, nbins_aerosol
11551	temp_bin = temp_bin + aerosol_mass(ic)%conc(k,j,i)
11552	ENDDO
11553	ENDIF
11554	ENDDO
11555	local_pf(i,j,k) = MERGE( temp_bin, REAL( fill_value, KIND = wp ), &
11556	BTEST( wall_flags_total_0(k,j,i), 0 ) )
11557	ENDDO
11558	ENDDO
11559	ENDDO
11560	ELSE
11561	IF ( .NOT. ALLOCATED( pm10_av ) ) THEN
11562	ALLOCATE( pm10_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
11563	pm10_av = REAL( fill_value, KIND = wp )
11564	ENDIF
11565	DO i = nxl, nxr
11566	DO j = nys, nyn
11567	DO k = nzb_do, nzt_do
11568	local_pf(i,j,k) = MERGE( pm10_av(k,j,i), REAL( fill_value, KIND = wp ), &
11569	BTEST( wall_flags_total_0(k,j,i), 0 ) )
11570	ENDDO
11571	ENDDO
11572	ENDDO
11573	ENDIF
11574
11575	CASE ( 's_BC', 's_DU', 's_NH', 's_NO', 's_OC', 's_SO4', 's_SS' )
11576	IF ( is_used( prtcl, TRIM( variable(9:) ) ) ) THEN ! 9: remove salsa_s_
11577	found_index = get_index( prtcl, TRIM( variable(9:) ) )
11578	IF ( av == 0 ) THEN
11579	DO i = nxl, nxr
11580	DO j = nys, nyn
11581	DO k = nzb_do, nzt_do
11582	temp_bin = 0.0_wp
11583	DO ic = ( found_index-1 ) * nbins_aerosol + 1, found_index * nbins_aerosol
11584	temp_bin = temp_bin + aerosol_mass(ic)%conc(k,j,i)
11585	ENDDO
11586	local_pf(i,j,k) = MERGE( temp_bin, REAL( fill_value, KIND = wp ), &
11587	BTEST( wall_flags_total_0(k,j,i), 0 ) )
11588	ENDDO
11589	ENDDO
11590	ENDDO
11591	ELSE
11592	IF ( .NOT. ALLOCATED( s_mass_av ) ) THEN
11593	ALLOCATE( s_mass_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg,ncomponents_mass) )
11594	s_mass_av = REAL( fill_value, KIND = wp )
11595	ENDIF
11596	DO i = nxl, nxr
11597	DO j = nys, nyn
11598	DO k = nzb_do, nzt_do
11599	local_pf(i,j,k) = MERGE( s_mass_av(k,j,i,found_index), &
11600	REAL( fill_value, KIND = wp ), &
11601	BTEST( wall_flags_total_0(k,j,i), 0 ) )
11602	ENDDO
11603	ENDDO
11604	ENDDO
11605	ENDIF
11606	ENDIF
11607
11608	CASE ( 's_H2O' )
11609	found_index = get_index( prtcl, 'H2O' )
11610	IF ( av == 0 ) THEN
11611	DO i = nxl, nxr
11612	DO j = nys, nyn
11613	DO k = nzb_do, nzt_do
11614	temp_bin = 0.0_wp
11615	DO ic = ( found_index-1 ) * nbins_aerosol + 1, found_index * nbins_aerosol
11616	temp_bin = temp_bin + aerosol_mass(ic)%conc(k,j,i)
11617	ENDDO
11618	local_pf(i,j,k) = MERGE( temp_bin, REAL( fill_value, KIND = wp ), &
11619	BTEST( wall_flags_total_0(k,j,i), 0 ) )
11620	ENDDO
11621	ENDDO
11622	ENDDO
11623	ELSE
11624	IF ( .NOT. ALLOCATED( s_h2o_av ) ) THEN
11625	ALLOCATE( s_h2o_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
11626	s_h2o_av = REAL( fill_value, KIND = wp )
11627	ENDIF
11628	DO i = nxl, nxr
11629	DO j = nys, nyn
11630	DO k = nzb_do, nzt_do
11631	local_pf(i,j,k) = MERGE( s_h2o_av(k,j,i), REAL( fill_value, KIND = wp ), &
11632	BTEST( wall_flags_total_0(k,j,i), 0 ) )
11633	ENDDO
11634	ENDDO
11635	ENDDO
11636	ENDIF
11637
11638	CASE DEFAULT
11639	found = .FALSE.
11640
11641	END SELECT
11642	ENDIF
11643
11644	END SUBROUTINE salsa_data_output_3d
11645
11646	!------------------------------------------------------------------------------!
11647	!
11648	! Description:
11649	! ------------
11650	!> Subroutine defining mask output variables
11651	!------------------------------------------------------------------------------!
11652	SUBROUTINE salsa_data_output_mask( av, variable, found, local_pf, mid )
11653
11654	USE arrays_3d, &
11655	ONLY: tend
11656
11657	USE control_parameters, &
11658	ONLY: mask_i, mask_j, mask_k, mask_size_l, mask_surface, nz_do3d
11659
11660	IMPLICIT NONE
11661
11662	CHARACTER(LEN=5) :: grid !< flag to distinquish between staggered grid
11663	CHARACTER(LEN=*) :: variable !<
11664	CHARACTER(LEN=7) :: vari !< trimmed format of variable
11665
11666	INTEGER(iwp) :: av !<
11667	INTEGER(iwp) :: char_to_int !< for converting character to integer
11668	INTEGER(iwp) :: found_index !< index of a chemical compound
11669	INTEGER(iwp) :: ib !< loop index for aerosol size number bins
11670	INTEGER(iwp) :: ic !< loop index for chemical components
11671	INTEGER(iwp) :: i !< loop index in x-direction
11672	INTEGER(iwp) :: j !< loop index in y-direction
11673	INTEGER(iwp) :: k !< loop index in z-direction
11674	INTEGER(iwp) :: im !< loop index for masked variables
11675	INTEGER(iwp) :: jm !< loop index for masked variables
11676	INTEGER(iwp) :: kk !< loop index for masked output in z-direction
11677	INTEGER(iwp) :: mid !< masked output running index
11678	INTEGER(iwp) :: ktt !< k index of highest terrain surface
11679
11680	LOGICAL :: found !<
11681	LOGICAL :: resorted !<
11682
11683	REAL(wp) :: df !< For calculating LDSA: fraction of particles depositing in the alveolar
11684	!< (or tracheobronchial) region of the lung. Depends on the particle size
11685	REAL(wp) :: mean_d !< Particle diameter in micrometres
11686	REAL(wp) :: temp_bin !< temporary array for calculating output variables
11687
11688	REAL(wp), DIMENSION(mask_size_l(mid,1),mask_size_l(mid,2),mask_size_l(mid,3)) :: local_pf !<
11689
11690	REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg), TARGET :: temp_array !< temporary array
11691
11692	REAL(wp), DIMENSION(:,:,:), POINTER :: to_be_resorted !< pointer
11693
11694	found = .TRUE.
11695	resorted = .FALSE.
11696	grid = 's'
11697	tend = 0.0_wp
11698	temp_array = 0.0_wp
11699	temp_bin = 0.0_wp
11700
11701	IF ( variable(7:11) == 'N_bin' ) THEN
11702	READ( variable(12:),* ) char_to_int
11703	IF ( char_to_int >= 1 .AND. char_to_int <= SUM( nbin ) ) THEN
11704	ib = char_to_int
11705	IF ( av == 0 ) THEN
11706	IF ( .NOT. mask_surface(mid) ) THEN
11707	DO i = 1, mask_size_l(mid,1)
11708	DO j = 1, mask_size_l(mid,2)
11709	DO k = 1, mask_size_l(mid,3)
11710	local_pf(i,j,k) = aerosol_number(ib)%conc( mask_k(mid,k), mask_j(mid,j), &
11711	mask_i(mid,i) )
11712	ENDDO
11713	ENDDO
11714	ENDDO
11715	ELSE
11716	DO i = 1, mask_size_l(mid,1)
11717	DO j = 1, mask_size_l(mid,2)
11718	!
11719	!-- Get k index of the highest terraing surface
11720	im = mask_i(mid,i)
11721	jm = mask_j(mid,j)
11722	ktt = MINLOC( MERGE( 1, 0, BTEST( wall_flags_total_0(:,jm,im), 5 )), &
11723	DIM = 1 ) - 1
11724	DO k = 1, mask_size_l(mid,3)
11725	kk = MIN( ktt+mask_k(mid,k), nzt+1 )
11726	!
11727	!-- Set value if not in building
11728	IF ( BTEST( wall_flags_total_0(kk,jm,im), 6 ) ) THEN
11729	local_pf(i,j,k) = fill_value
11730	ELSE
11731	local_pf(i,j,k) = aerosol_number(ib)%conc(kk,jm,im)
11732	ENDIF
11733	ENDDO
11734	ENDDO
11735	ENDDO
11736	ENDIF
11737	resorted = .TRUE.
11738	ELSE
11739	temp_array = nbins_av(:,:,:,ib)
11740	to_be_resorted => temp_array
11741	ENDIF
11742	ENDIF
11743
11744	ELSEIF ( variable(7:11) == 'm_bin' ) THEN
11745
11746	READ( variable(12:),* ) char_to_int
11747	IF ( char_to_int >= 1 .AND. char_to_int <= SUM( nbin ) ) THEN
11748
11749	ib = char_to_int
11750	IF ( av == 0 ) THEN
11751	DO i = nxl, nxr
11752	DO j = nys, nyn
11753	DO k = nzb, nz_do3d
11754	temp_bin = 0.0_wp
11755	DO ic = ib, ncomponents_mass * nbins_aerosol, nbins_aerosol
11756	temp_bin = temp_bin + aerosol_mass(ic)%conc(k,j,i)
11757	ENDDO
11758	tend(k,j,i) = temp_bin
11759	ENDDO
11760	ENDDO
11761	ENDDO
11762	IF ( .NOT. mask_surface(mid) ) THEN
11763	DO i = 1, mask_size_l(mid,1)
11764	DO j = 1, mask_size_l(mid,2)
11765	DO k = 1, mask_size_l(mid,3)
11766	local_pf(i,j,k) = tend( mask_k(mid,k), mask_j(mid,j), mask_i(mid,i) )
11767	ENDDO
11768	ENDDO
11769	ENDDO
11770	ELSE
11771	DO i = 1, mask_size_l(mid,1)
11772	DO j = 1, mask_size_l(mid,2)
11773	!
11774	!-- Get k index of the highest terraing surface
11775	im = mask_i(mid,i)
11776	jm = mask_j(mid,j)
11777	ktt = MINLOC( MERGE( 1, 0, BTEST( wall_flags_total_0(:,jm,im), 5 )), &
11778	DIM = 1 ) - 1
11779	DO k = 1, mask_size_l(mid,3)
11780	kk = MIN( ktt+mask_k(mid,k), nzt+1 )
11781	!
11782	!-- Set value if not in building
11783	IF ( BTEST( wall_flags_total_0(kk,jm,im), 6 ) ) THEN
11784	local_pf(i,j,k) = fill_value
11785	ELSE
11786	local_pf(i,j,k) = tend(kk,jm,im)
11787	ENDIF
11788	ENDDO
11789	ENDDO
11790	ENDDO
11791	ENDIF
11792	resorted = .TRUE.
11793	ELSE
11794	temp_array = mbins_av(:,:,:,ib)
11795	to_be_resorted => temp_array
11796	ENDIF
11797	ENDIF
11798
11799	ELSE
11800	SELECT CASE ( TRIM( variable(7:) ) )
11801
11802	CASE ( 'g_H2SO4', 'g_HNO3', 'g_NH3', 'g_OCNV', 'g_OCSV' )
11803	vari = TRIM( variable(7:) )
11804	IF ( av == 0 ) THEN
11805	IF ( vari == 'g_H2SO4') to_be_resorted => salsa_gas(1)%conc
11806	IF ( vari == 'g_HNO3') to_be_resorted => salsa_gas(2)%conc
11807	IF ( vari == 'g_NH3') to_be_resorted => salsa_gas(3)%conc
11808	IF ( vari == 'g_OCNV') to_be_resorted => salsa_gas(4)%conc
11809	IF ( vari == 'g_OCSV') to_be_resorted => salsa_gas(5)%conc
11810	ELSE
11811	IF ( vari == 'g_H2SO4') temp_array = salsa_gases_av(:,:,:,1)
11812	IF ( vari == 'g_HNO3') temp_array = salsa_gases_av(:,:,:,2)
11813	IF ( vari == 'g_NH3') temp_array = salsa_gases_av(:,:,:,3)
11814	IF ( vari == 'g_OCNV') temp_array = salsa_gases_av(:,:,:,4)
11815	IF ( vari == 'g_OCSV') temp_array = salsa_gases_av(:,:,:,5)
11816	to_be_resorted => temp_array
11817	ENDIF
11818
11819	CASE ( 'LDSA' )
11820	IF ( av == 0 ) THEN
11821	DO i = nxl, nxr
11822	DO j = nys, nyn
11823	DO k = nzb, nz_do3d
11824	temp_bin = 0.0_wp
11825	DO ib = 1, nbins_aerosol
11826	!
11827	!-- Diameter in micrometres
11828	mean_d = 1.0E+6_wp * ra_dry(k,j,i,ib) * 2.0_wp
11829	!
11830	!-- Deposition factor: alveolar
11831	df = ( 0.01555_wp / mean_d ) * ( EXP( -0.416_wp * ( LOG( mean_d ) + &
11832	2.84_wp )*2 ) + 19.11_wp EXP( -0.482_wp * ( LOG( mean_d ) - &
11833	1.362_wp )**2 ) )
11834	!
11835	!-- Lung-deposited surface area LDSA (units mum2/cm3)
11836	temp_bin = temp_bin + pi * mean_d*2 df * 1.0E-6_wp * &
11837	aerosol_number(ib)%conc(k,j,i)
11838	ENDDO
11839	tend(k,j,i) = temp_bin
11840	ENDDO
11841	ENDDO
11842	ENDDO
11843	IF ( .NOT. mask_surface(mid) ) THEN
11844	DO i = 1, mask_size_l(mid,1)
11845	DO j = 1, mask_size_l(mid,2)
11846	DO k = 1, mask_size_l(mid,3)
11847	local_pf(i,j,k) = tend( mask_k(mid,k), mask_j(mid,j), mask_i(mid,i) )
11848	ENDDO
11849	ENDDO
11850	ENDDO
11851	ELSE
11852	DO i = 1, mask_size_l(mid,1)
11853	DO j = 1, mask_size_l(mid,2)
11854	!
11855	!-- Get k index of the highest terraing surface
11856	im = mask_i(mid,i)
11857	jm = mask_j(mid,j)
11858	ktt = MINLOC( MERGE( 1, 0, BTEST( wall_flags_total_0(:,jm,im), 5 )), &
11859	DIM = 1 ) - 1
11860	DO k = 1, mask_size_l(mid,3)
11861	kk = MIN( ktt+mask_k(mid,k), nzt+1 )
11862	!
11863	!-- Set value if not in building
11864	IF ( BTEST( wall_flags_total_0(kk,jm,im), 6 ) ) THEN
11865	local_pf(i,j,k) = fill_value
11866	ELSE
11867	local_pf(i,j,k) = tend(kk,jm,im)
11868	ENDIF
11869	ENDDO
11870	ENDDO
11871	ENDDO
11872	ENDIF
11873	resorted = .TRUE.
11874	ELSE
11875	to_be_resorted => ldsa_av
11876	ENDIF
11877
11878	CASE ( 'N_UFP' )
11879	IF ( av == 0 ) THEN
11880	DO i = nxl, nxr
11881	DO j = nys, nyn
11882	DO k = nzb, nz_do3d
11883	temp_bin = 0.0_wp
11884	DO ib = 1, nbins_aerosol
11885	IF ( 2.0_wp * ra_dry(k,j,i,ib) <= 0.1E-6_wp ) THEN
11886	temp_bin = temp_bin + aerosol_number(ib)%conc(k,j,i)
11887	ENDIF
11888	ENDDO
11889	tend(k,j,i) = temp_bin
11890	ENDDO
11891	ENDDO
11892	ENDDO
11893	IF ( .NOT. mask_surface(mid) ) THEN
11894	DO i = 1, mask_size_l(mid,1)
11895	DO j = 1, mask_size_l(mid,2)
11896	DO k = 1, mask_size_l(mid,3)
11897	local_pf(i,j,k) = tend( mask_k(mid,k), mask_j(mid,j), mask_i(mid,i) )
11898	ENDDO
11899	ENDDO
11900	ENDDO
11901	ELSE
11902	DO i = 1, mask_size_l(mid,1)
11903	DO j = 1, mask_size_l(mid,2)
11904	!
11905	!-- Get k index of the highest terraing surface
11906	im = mask_i(mid,i)
11907	jm = mask_j(mid,j)
11908	ktt = MINLOC( MERGE( 1, 0, BTEST( wall_flags_total_0(:,jm,im), 5 )), &
11909	DIM = 1 ) - 1
11910	DO k = 1, mask_size_l(mid,3)
11911	kk = MIN( ktt+mask_k(mid,k), nzt+1 )
11912	!
11913	!-- Set value if not in building
11914	IF ( BTEST( wall_flags_total_0(kk,jm,im), 6 ) ) THEN
11915	local_pf(i,j,k) = fill_value
11916	ELSE
11917	local_pf(i,j,k) = tend(kk,jm,im)
11918	ENDIF
11919	ENDDO
11920	ENDDO
11921	ENDDO
11922	ENDIF
11923	resorted = .TRUE.
11924	ELSE
11925	to_be_resorted => nufp_av
11926	ENDIF
11927
11928	CASE ( 'Ntot' )
11929	IF ( av == 0 ) THEN
11930	DO i = nxl, nxr
11931	DO j = nys, nyn
11932	DO k = nzb, nz_do3d
11933	temp_bin = 0.0_wp
11934	DO ib = 1, nbins_aerosol
11935	temp_bin = temp_bin + aerosol_number(ib)%conc(k,j,i)
11936	ENDDO
11937	tend(k,j,i) = temp_bin
11938	ENDDO
11939	ENDDO
11940	ENDDO
11941	IF ( .NOT. mask_surface(mid) ) THEN
11942	DO i = 1, mask_size_l(mid,1)
11943	DO j = 1, mask_size_l(mid,2)
11944	DO k = 1, mask_size_l(mid,3)
11945	local_pf(i,j,k) = tend( mask_k(mid,k), mask_j(mid,j), mask_i(mid,i) )
11946	ENDDO
11947	ENDDO
11948	ENDDO
11949	ELSE
11950	DO i = 1, mask_size_l(mid,1)
11951	DO j = 1, mask_size_l(mid,2)
11952	!
11953	!-- Get k index of the highest terraing surface
11954	im = mask_i(mid,i)
11955	jm = mask_j(mid,j)
11956	ktt = MINLOC( MERGE( 1, 0, BTEST( wall_flags_total_0(:,jm,im), 5 )), &
11957	DIM = 1 ) - 1
11958	DO k = 1, mask_size_l(mid,3)
11959	kk = MIN( ktt+mask_k(mid,k), nzt+1 )
11960	!
11961	!-- Set value if not in building
11962	IF ( BTEST( wall_flags_total_0(kk,jm,im), 6 ) ) THEN
11963	local_pf(i,j,k) = fill_value
11964	ELSE
11965	local_pf(i,j,k) = tend(kk,jm,im)
11966	ENDIF
11967	ENDDO
11968	ENDDO
11969	ENDDO
11970	ENDIF
11971	resorted = .TRUE.
11972	ELSE
11973	to_be_resorted => ntot_av
11974	ENDIF
11975
11976	CASE ( 'PM0.1' )
11977	IF ( av == 0 ) THEN
11978	DO i = nxl, nxr
11979	DO j = nys, nyn
11980	DO k = nzb, nz_do3d
11981	temp_bin = 0.0_wp
11982	DO ib = 1, nbins_aerosol
11983	IF ( 2.0_wp * ra_dry(k,j,i,ib) <= 0.1E-6_wp ) THEN
11984	DO ic = ib, nbins_aerosol * ncc, nbins_aerosol
11985	temp_bin = temp_bin + aerosol_mass(ic)%conc(k,j,i)
11986	ENDDO
11987	ENDIF
11988	ENDDO
11989	tend(k,j,i) = temp_bin
11990	ENDDO
11991	ENDDO
11992	ENDDO
11993	IF ( .NOT. mask_surface(mid) ) THEN
11994	DO i = 1, mask_size_l(mid,1)
11995	DO j = 1, mask_size_l(mid,2)
11996	DO k = 1, mask_size_l(mid,3)
11997	local_pf(i,j,k) = tend( mask_k(mid,k), mask_j(mid,j), mask_i(mid,i) )
11998	ENDDO
11999	ENDDO
12000	ENDDO
12001	ELSE
12002	DO i = 1, mask_size_l(mid,1)
12003	DO j = 1, mask_size_l(mid,2)
12004	!
12005	!-- Get k index of the highest terraing surface
12006	im = mask_i(mid,i)
12007	jm = mask_j(mid,j)
12008	ktt = MINLOC( MERGE( 1, 0, BTEST( wall_flags_total_0(:,jm,im), 5 )), &
12009	DIM = 1 ) - 1
12010	DO k = 1, mask_size_l(mid,3)
12011	kk = MIN( ktt+mask_k(mid,k), nzt+1 )
12012	!
12013	!-- Set value if not in building
12014	IF ( BTEST( wall_flags_total_0(kk,jm,im), 6 ) ) THEN
12015	local_pf(i,j,k) = fill_value
12016	ELSE
12017	local_pf(i,j,k) = tend(kk,jm,im)
12018	ENDIF
12019	ENDDO
12020	ENDDO
12021	ENDDO
12022	ENDIF
12023	resorted = .TRUE.
12024	ELSE
12025	to_be_resorted => pm01_av
12026	ENDIF
12027
12028	CASE ( 'PM2.5' )
12029	IF ( av == 0 ) THEN
12030	DO i = nxl, nxr
12031	DO j = nys, nyn
12032	DO k = nzb, nz_do3d
12033	temp_bin = 0.0_wp
12034	DO ib = 1, nbins_aerosol
12035	IF ( 2.0_wp * ra_dry(k,j,i,ib) <= 2.5E-6_wp ) THEN
12036	DO ic = ib, nbins_aerosol * ncc, nbins_aerosol
12037	temp_bin = temp_bin + aerosol_mass(ic)%conc(k,j,i)
12038	ENDDO
12039	ENDIF
12040	ENDDO
12041	tend(k,j,i) = temp_bin
12042	ENDDO
12043	ENDDO
12044	ENDDO
12045	IF ( .NOT. mask_surface(mid) ) THEN
12046	DO i = 1, mask_size_l(mid,1)
12047	DO j = 1, mask_size_l(mid,2)
12048	DO k = 1, mask_size_l(mid,3)
12049	local_pf(i,j,k) = tend( mask_k(mid,k), mask_j(mid,j), mask_i(mid,i) )
12050	ENDDO
12051	ENDDO
12052	ENDDO
12053	ELSE
12054	DO i = 1, mask_size_l(mid,1)
12055	DO j = 1, mask_size_l(mid,2)
12056	!
12057	!-- Get k index of the highest terraing surface
12058	im = mask_i(mid,i)
12059	jm = mask_j(mid,j)
12060	ktt = MINLOC( MERGE( 1, 0, BTEST( wall_flags_total_0(:,jm,im), 5 )), &
12061	DIM = 1 ) - 1
12062	DO k = 1, mask_size_l(mid,3)
12063	kk = MIN( ktt+mask_k(mid,k), nzt+1 )
12064	!
12065	!-- Set value if not in building
12066	IF ( BTEST( wall_flags_total_0(kk,jm,im), 6 ) ) THEN
12067	local_pf(i,j,k) = fill_value
12068	ELSE
12069	local_pf(i,j,k) = tend(kk,jm,im)
12070	ENDIF
12071	ENDDO
12072	ENDDO
12073	ENDDO
12074	ENDIF
12075	resorted = .TRUE.
12076	ELSE
12077	to_be_resorted => pm25_av
12078	ENDIF
12079
12080	CASE ( 'PM10' )
12081	IF ( av == 0 ) THEN
12082	DO i = nxl, nxr
12083	DO j = nys, nyn
12084	DO k = nzb, nz_do3d
12085	temp_bin = 0.0_wp
12086	DO ib = 1, nbins_aerosol
12087	IF ( 2.0_wp * ra_dry(k,j,i,ib) <= 10.0E-6_wp ) THEN
12088	DO ic = ib, nbins_aerosol * ncc, nbins_aerosol
12089	temp_bin = temp_bin + aerosol_mass(ic)%conc(k,j,i)
12090	ENDDO
12091	ENDIF
12092	ENDDO
12093	tend(k,j,i) = temp_bin
12094	ENDDO
12095	ENDDO
12096	ENDDO
12097	IF ( .NOT. mask_surface(mid) ) THEN
12098	DO i = 1, mask_size_l(mid,1)
12099	DO j = 1, mask_size_l(mid,2)
12100	DO k = 1, mask_size_l(mid,3)
12101	local_pf(i,j,k) = tend( mask_k(mid,k), mask_j(mid,j), mask_i(mid,i) )
12102	ENDDO
12103	ENDDO
12104	ENDDO
12105	ELSE
12106	DO i = 1, mask_size_l(mid,1)
12107	DO j = 1, mask_size_l(mid,2)
12108	!
12109	!-- Get k index of the highest terraing surface
12110	im = mask_i(mid,i)
12111	jm = mask_j(mid,j)
12112	ktt = MINLOC( MERGE( 1, 0, BTEST( wall_flags_total_0(:,jm,im), 5 )), &
12113	DIM = 1 ) - 1
12114	DO k = 1, mask_size_l(mid,3)
12115	kk = MIN( ktt+mask_k(mid,k), nzt+1 )
12116	!
12117	!-- Set value if not in building
12118	IF ( BTEST( wall_flags_total_0(kk,jm,im), 6 ) ) THEN
12119	local_pf(i,j,k) = fill_value
12120	ELSE
12121	local_pf(i,j,k) = tend(kk,jm,im)
12122	ENDIF
12123	ENDDO
12124	ENDDO
12125	ENDDO
12126	ENDIF
12127	resorted = .TRUE.
12128	ELSE
12129	to_be_resorted => pm10_av
12130	ENDIF
12131
12132	CASE ( 's_BC', 's_DU', 's_NH', 's_NO', 's_OC', 's_SO4', 's_SS' )
12133	IF ( is_used( prtcl, TRIM( variable(9:) ) ) ) THEN
12134	found_index = get_index( prtcl, TRIM( variable(9:) ) )
12135	IF ( av == 0 ) THEN
12136	DO i = nxl, nxr
12137	DO j = nys, nyn
12138	DO k = nzb, nz_do3d
12139	temp_bin = 0.0_wp
12140	DO ic = ( found_index-1 ) * nbins_aerosol + 1, found_index * nbins_aerosol
12141	temp_bin = temp_bin + aerosol_mass(ic)%conc(k,j,i)
12142	ENDDO
12143	tend(k,j,i) = temp_bin
12144	ENDDO
12145	ENDDO
12146	ENDDO
12147	IF ( .NOT. mask_surface(mid) ) THEN
12148	DO i = 1, mask_size_l(mid,1)
12149	DO j = 1, mask_size_l(mid,2)
12150	DO k = 1, mask_size_l(mid,3)
12151	local_pf(i,j,k) = tend( mask_k(mid,k), mask_j(mid,j), mask_i(mid,i) )
12152	ENDDO
12153	ENDDO
12154	ENDDO
12155	ELSE
12156	DO i = 1, mask_size_l(mid,1)
12157	DO j = 1, mask_size_l(mid,2)
12158	!
12159	!-- Get k index of the highest terraing surface
12160	im = mask_i(mid,i)
12161	jm = mask_j(mid,j)
12162	ktt = MINLOC( MERGE( 1, 0, BTEST( wall_flags_total_0(:,jm,im), 5 )), &
12163	DIM = 1 ) - 1
12164	DO k = 1, mask_size_l(mid,3)
12165	kk = MIN( ktt+mask_k(mid,k), nzt+1 )
12166	!
12167	!-- Set value if not in building
12168	IF ( BTEST( wall_flags_total_0(kk,jm,im), 6 ) ) THEN
12169	local_pf(i,j,k) = fill_value
12170	ELSE
12171	local_pf(i,j,k) = tend(kk,jm,im)
12172	ENDIF
12173	ENDDO
12174	ENDDO
12175	ENDDO
12176	ENDIF
12177	resorted = .TRUE.
12178	ELSE
12179	temp_array = s_mass_av(:,:,:,found_index)
12180	to_be_resorted => temp_array
12181	ENDIF
12182	ELSE
12183	local_pf = fill_value
12184	ENDIF
12185
12186	CASE ( 's_H2O' )
12187	IF ( av == 0 ) THEN
12188	found_index = get_index( prtcl, 'H2O' )
12189	DO i = nxl, nxr
12190	DO j = nys, nyn
12191	DO k = nzb, nz_do3d
12192	temp_bin = 0.0_wp
12193	DO ic = ( found_index-1 ) * nbins_aerosol + 1, found_index * nbins_aerosol
12194	temp_bin = temp_bin + aerosol_mass(ic)%conc(k,j,i)
12195	ENDDO
12196	tend(k,j,i) = temp_bin
12197	ENDDO
12198	ENDDO
12199	ENDDO
12200	IF ( .NOT. mask_surface(mid) ) THEN
12201	DO i = 1, mask_size_l(mid,1)
12202	DO j = 1, mask_size_l(mid,2)
12203	DO k = 1, mask_size_l(mid,3)
12204	local_pf(i,j,k) = tend( mask_k(mid,k), mask_j(mid,j), mask_i(mid,i) )
12205	ENDDO
12206	ENDDO
12207	ENDDO
12208	ELSE
12209	DO i = 1, mask_size_l(mid,1)
12210	DO j = 1, mask_size_l(mid,2)
12211	!
12212	!-- Get k index of the highest terraing surface
12213	im = mask_i(mid,i)
12214	jm = mask_j(mid,j)
12215	ktt = MINLOC( MERGE( 1, 0, BTEST( wall_flags_total_0(:,jm,im), 5 )), &
12216	DIM = 1 ) - 1
12217	DO k = 1, mask_size_l(mid,3)
12218	kk = MIN( ktt+mask_k(mid,k), nzt+1 )
12219	!
12220	!-- Set value if not in building
12221	IF ( BTEST( wall_flags_total_0(kk,jm,im), 6 ) ) THEN
12222	local_pf(i,j,k) = fill_value
12223	ELSE
12224	local_pf(i,j,k) = tend(kk,jm,im)
12225	ENDIF
12226	ENDDO
12227	ENDDO
12228	ENDDO
12229	ENDIF
12230	resorted = .TRUE.
12231	ELSE
12232	to_be_resorted => s_h2o_av
12233	ENDIF
12234
12235	CASE DEFAULT
12236	found = .FALSE.
12237
12238	END SELECT
12239	ENDIF
12240
12241	IF ( found .AND. .NOT. resorted ) THEN
12242	IF ( .NOT. mask_surface(mid) ) THEN
12243	!
12244	!-- Default masked output
12245	DO i = 1, mask_size_l(mid,1)
12246	DO j = 1, mask_size_l(mid,2)
12247	DO k = 1, mask_size_l(mid,3)
12248	local_pf(i,j,k) = to_be_resorted( mask_k(mid,k), mask_j(mid,j), mask_i(mid,i) )
12249	ENDDO
12250	ENDDO
12251	ENDDO
12252	ELSE
12253	!
12254	!-- Terrain-following masked output
12255	DO i = 1, mask_size_l(mid,1)
12256	DO j = 1, mask_size_l(mid,2)
12257	!
12258	!-- Get k index of the highest terraing surface
12259	im = mask_i(mid,i)
12260	jm = mask_j(mid,j)
12261	ktt = MINLOC( MERGE( 1, 0, BTEST( wall_flags_total_0(:,jm,im), 5 )), &
12262	DIM = 1 ) - 1
12263	DO k = 1, mask_size_l(mid,3)
12264	kk = MIN( ktt+mask_k(mid,k), nzt+1 )
12265	!
12266	!-- Set value if not in building
12267	IF ( BTEST( wall_flags_total_0(kk,jm,im), 6 ) ) THEN
12268	local_pf(i,j,k) = fill_value
12269	ELSE
12270	local_pf(i,j,k) = to_be_resorted(kk,jm,im)
12271	ENDIF
12272	ENDDO
12273	ENDDO
12274	ENDDO
12275	ENDIF
12276	ENDIF
12277
12278	END SUBROUTINE salsa_data_output_mask
12279
12280	!------------------------------------------------------------------------------!
12281	! Description:
12282	! ------------
12283	!> Creates index tables for different (aerosol) components
12284	!------------------------------------------------------------------------------!
12285	SUBROUTINE component_index_constructor( self, ncomp, nlist, listcomp )
12286
12287	IMPLICIT NONE
12288
12289	INTEGER(iwp) :: ii !<
12290	INTEGER(iwp) :: jj !<
12291
12292	INTEGER(iwp), INTENT(in) :: nlist ! < Maximum number of components
12293
12294	INTEGER(iwp), INTENT(inout) :: ncomp !< Number of components
12295
12296	CHARACTER(LEN=3), INTENT(in) :: listcomp(nlist) !< List cof component names
12297
12298	TYPE(component_index), INTENT(inout) :: self !< Object containing the indices of different
12299	!< aerosol components
12300
12301	ncomp = 0
12302
12303	DO WHILE ( listcomp(ncomp+1) /= ' ' .AND. ncomp < nlist )
12304	ncomp = ncomp + 1
12305	ENDDO
12306
12307	self%ncomp = ncomp
12308	ALLOCATE( self%ind(ncomp), self%comp(ncomp) )
12309
12310	DO ii = 1, ncomp
12311	self%ind(ii) = ii
12312	ENDDO
12313
12314	jj = 1
12315	DO ii = 1, nlist
12316	IF ( listcomp(ii) == '') CYCLE
12317	self%comp(jj) = listcomp(ii)
12318	jj = jj + 1
12319	ENDDO
12320
12321	END SUBROUTINE component_index_constructor
12322
12323	!------------------------------------------------------------------------------!
12324	! Description:
12325	! ------------
12326	!> Gives the index of a component in the component list
12327	!------------------------------------------------------------------------------!
12328	INTEGER FUNCTION get_index( self, incomp )
12329
12330	IMPLICIT NONE
12331
12332	CHARACTER(LEN=*), INTENT(in) :: incomp !< Component name
12333
12334	INTEGER(iwp) :: ii !< index
12335
12336	TYPE(component_index), INTENT(in) :: self !< Object containing the indices of different
12337	!< aerosol components
12338	IF ( ANY( self%comp == incomp ) ) THEN
12339	ii = 1
12340	DO WHILE ( (self%comp(ii) /= incomp) )
12341	ii = ii + 1
12342	ENDDO
12343	get_index = ii
12344	ELSEIF ( incomp == 'H2O' ) THEN
12345	get_index = self%ncomp + 1
12346	ELSE
12347	WRITE( message_string, * ) 'Incorrect component name given!'
12348	CALL message( 'get_index', 'PA0591', 1, 2, 0, 6, 0 )
12349	ENDIF
12350
12351	END FUNCTION get_index
12352
12353	!------------------------------------------------------------------------------!
12354	! Description:
12355	! ------------
12356	!> Tells if the (aerosol) component is being used in the simulation
12357	!------------------------------------------------------------------------------!
12358	LOGICAL FUNCTION is_used( self, icomp )
12359
12360	IMPLICIT NONE
12361
12362	CHARACTER(LEN=*), INTENT(in) :: icomp !< Component name
12363
12364	TYPE(component_index), INTENT(in) :: self !< Object containing the indices of different
12365	!< aerosol components
12366
12367	IF ( ANY(self%comp == icomp) ) THEN
12368	is_used = .TRUE.
12369	ELSE
12370	is_used = .FALSE.
12371	ENDIF
12372
12373	END FUNCTION
12374
12375	!------------------------------------------------------------------------------!
12376	! Description:
12377	! ------------
12378	!> Set the lateral and top boundary conditions in case the PALM domain is
12379	!> nested offline in a mesoscale model. Further, average boundary data and
12380	!> determine mean profiles, further used for correct damping in the sponge
12381	!> layer.
12382	!------------------------------------------------------------------------------!
12383	SUBROUTINE salsa_nesting_offl_bc
12384
12385	USE control_parameters, &
12386	ONLY: bc_dirichlet_l, bc_dirichlet_n, bc_dirichlet_r, bc_dirichlet_s, dt_3d, &
12387	time_since_reference_point
12388
12389	USE indices, &
12390	ONLY: nbgp, nxl, nxr, nyn, nys, nzb, nzt
12391
12392	IMPLICIT NONE
12393
12394	INTEGER(iwp) :: i !< running index x-direction
12395	INTEGER(iwp) :: ib !< running index for aerosol number bins
12396	INTEGER(iwp) :: ic !< running index for aerosol mass bins
12397	INTEGER(iwp) :: icc !< running index for aerosol mass bins
12398	INTEGER(iwp) :: ig !< running index for gaseous species
12399	INTEGER(iwp) :: j !< running index y-direction
12400	INTEGER(iwp) :: k !< running index z-direction
12401
12402	REAL(wp) :: fac_dt !< interpolation factor
12403
12404	REAL(wp), DIMENSION(:,:), ALLOCATABLE :: ref_mconc !< reference profile for aerosol mass
12405	REAL(wp), DIMENSION(:,:), ALLOCATABLE :: ref_mconc_l !< reference profile for aerosol mass: subdomain
12406	REAL(wp), DIMENSION(:,:), ALLOCATABLE :: ref_nconc !< reference profile for aerosol number
12407	REAL(wp), DIMENSION(:,:), ALLOCATABLE :: ref_nconc_l !< reference profile for aerosol_number: subdomain
12408	REAL(wp), DIMENSION(:,:), ALLOCATABLE :: ref_gconc !< reference profile for gases
12409	REAL(wp), DIMENSION(:,:), ALLOCATABLE :: ref_gconc_l !< reference profile for gases: subdomain
12410
12411	!
12412	!-- Skip input if no forcing from larger-scale models is applied.
12413	IF ( .NOT. nesting_offline_salsa ) RETURN
12414	!
12415	!-- Allocate temporary arrays to compute salsa mean profiles
12416	ALLOCATE( ref_gconc(nzb:nzt+1,1:ngases_salsa), ref_gconc_l(nzb:nzt+1,1:ngases_salsa), &
12417	ref_mconc(nzb:nzt+1,1:nbins_aerosol*ncomponents_mass), &
12418	ref_mconc_l(nzb:nzt+1,1:nbins_aerosol*ncomponents_mass), &
12419	ref_nconc(nzb:nzt+1,1:nbins_aerosol), ref_nconc_l(nzb:nzt+1,1:nbins_aerosol) )
12420	ref_gconc = 0.0_wp
12421	ref_gconc_l = 0.0_wp
12422	ref_mconc = 0.0_wp
12423	ref_mconc_l = 0.0_wp
12424	ref_nconc = 0.0_wp
12425	ref_nconc_l = 0.0_wp
12426
12427	!
12428	!-- Determine interpolation factor and limit it to 1. This is because t+dt can slightly exceed
12429	!-- time(tind_p) before boundary data is updated again.
12430	fac_dt = ( time_since_reference_point - salsa_nest_offl%time(salsa_nest_offl%tind) + dt_3d ) / &
12431	( salsa_nest_offl%time(salsa_nest_offl%tind_p) - &
12432	salsa_nest_offl%time(salsa_nest_offl%tind) )
12433	fac_dt = MIN( 1.0_wp, fac_dt )
12434
12435	IF ( bc_dirichlet_l ) THEN
12436	DO ib = 1, nbins_aerosol
12437	DO j = nys, nyn
12438	DO k = nzb+1, nzt
12439	aerosol_number(ib)%conc(k,j,-1) = ( 1.0_wp - fac_dt ) * &
12440	salsa_nest_offl%nconc_left(0,k,j,ib) + fac_dt * &
12441	salsa_nest_offl%nconc_left(1,k,j,ib)
12442	ENDDO
12443	ref_nconc_l(nzb+1:nzt,ib) = ref_nconc_l(nzb+1:nzt,ib) + &
12444	aerosol_number(ib)%conc(nzb+1:nzt,j,-1)
12445	ENDDO
12446	DO ic = 1, ncomponents_mass
12447	icc = ( ic-1 ) * nbins_aerosol + ib
12448	DO j = nys, nyn
12449	DO k = nzb+1, nzt
12450	aerosol_mass(icc)%conc(k,j,-1) = ( 1.0_wp - fac_dt ) * &
12451	salsa_nest_offl%mconc_left(0,k,j,icc) + fac_dt &
12452	* salsa_nest_offl%mconc_left(1,k,j,icc)
12453	ENDDO
12454	ref_mconc_l(nzb+1:nzt,icc) = ref_mconc_l(nzb+1:nzt,icc) + &
12455	aerosol_mass(icc)%conc(nzb+1:nzt,j,-1)
12456	ENDDO
12457	ENDDO
12458	ENDDO
12459	IF ( .NOT. salsa_gases_from_chem ) THEN
12460	DO ig = 1, ngases_salsa
12461	DO j = nys, nyn
12462	DO k = nzb+1, nzt
12463	salsa_gas(ig)%conc(k,j,-1) = ( 1.0_wp - fac_dt ) * &
12464	salsa_nest_offl%gconc_left(0,k,j,ig) + fac_dt * &
12465	salsa_nest_offl%gconc_left(1,k,j,ig)
12466	ENDDO
12467	ref_gconc_l(nzb+1:nzt,ig) = ref_gconc_l(nzb+1:nzt,ig) + &
12468	salsa_gas(ig)%conc(nzb+1:nzt,j,-1)
12469	ENDDO
12470	ENDDO
12471	ENDIF
12472	ENDIF
12473
12474	IF ( bc_dirichlet_r ) THEN
12475	DO ib = 1, nbins_aerosol
12476	DO j = nys, nyn
12477	DO k = nzb+1, nzt
12478	aerosol_number(ib)%conc(k,j,nxr+1) = ( 1.0_wp - fac_dt ) * &
12479	salsa_nest_offl%nconc_right(0,k,j,ib) + fac_dt * &
12480	salsa_nest_offl%nconc_right(1,k,j,ib)
12481	ENDDO
12482	ref_nconc_l(nzb+1:nzt,ib) = ref_nconc_l(nzb+1:nzt,ib) + &
12483	aerosol_number(ib)%conc(nzb+1:nzt,j,nxr+1)
12484	ENDDO
12485	DO ic = 1, ncomponents_mass
12486	icc = ( ic-1 ) * nbins_aerosol + ib
12487	DO j = nys, nyn
12488	DO k = nzb+1, nzt
12489	aerosol_mass(icc)%conc(k,j,nxr+1) = ( 1.0_wp - fac_dt ) * &
12490	salsa_nest_offl%mconc_right(0,k,j,icc) + fac_dt&
12491	* salsa_nest_offl%mconc_right(1,k,j,icc)
12492	ENDDO
12493	ref_mconc_l(nzb+1:nzt,icc) = ref_mconc_l(nzb+1:nzt,icc) + &
12494	aerosol_mass(icc)%conc(nzb+1:nzt,j,nxr+1)
12495	ENDDO
12496	ENDDO
12497	ENDDO
12498	IF ( .NOT. salsa_gases_from_chem ) THEN
12499	DO ig = 1, ngases_salsa
12500	DO j = nys, nyn
12501	DO k = nzb+1, nzt
12502	salsa_gas(ig)%conc(k,j,nxr+1) = ( 1.0_wp - fac_dt ) * &
12503	salsa_nest_offl%gconc_right(0,k,j,ig) + fac_dt *&
12504	salsa_nest_offl%gconc_right(1,k,j,ig)
12505	ENDDO
12506	ref_gconc_l(nzb+1:nzt,ig) = ref_gconc_l(nzb+1:nzt,ig) + &
12507	salsa_gas(ig)%conc(nzb+1:nzt,j,nxr+1)
12508	ENDDO
12509	ENDDO
12510	ENDIF
12511	ENDIF
12512
12513	IF ( bc_dirichlet_n ) THEN
12514	DO ib = 1, nbins_aerosol
12515	DO i = nxl, nxr
12516	DO k = nzb+1, nzt
12517	aerosol_number(ib)%conc(k,nyn+1,i) = ( 1.0_wp - fac_dt ) * &
12518	salsa_nest_offl%nconc_north(0,k,i,ib) + fac_dt * &
12519	salsa_nest_offl%nconc_north(1,k,i,ib)
12520	ENDDO
12521	ref_nconc_l(nzb+1:nzt,ib) = ref_nconc_l(nzb+1:nzt,ib) + &
12522	aerosol_number(ib)%conc(nzb+1:nzt,nyn+1,i)
12523	ENDDO
12524	DO ic = 1, ncomponents_mass
12525	icc = ( ic-1 ) * nbins_aerosol + ib
12526	DO i = nxl, nxr
12527	DO k = nzb+1, nzt
12528	aerosol_mass(icc)%conc(k,nyn+1,i) = ( 1.0_wp - fac_dt ) * &
12529	salsa_nest_offl%mconc_north(0,k,i,icc) + fac_dt&
12530	* salsa_nest_offl%mconc_north(1,k,i,icc)
12531	ENDDO
12532	ref_mconc_l(nzb+1:nzt,icc) = ref_mconc_l(nzb+1:nzt,icc) + &
12533	aerosol_mass(icc)%conc(nzb+1:nzt,nyn+1,i)
12534	ENDDO
12535	ENDDO
12536	ENDDO
12537	IF ( .NOT. salsa_gases_from_chem ) THEN
12538	DO ig = 1, ngases_salsa
12539	DO i = nxl, nxr
12540	DO k = nzb+1, nzt
12541	salsa_gas(ig)%conc(k,nyn+1,i) = ( 1.0_wp - fac_dt ) * &
12542	salsa_nest_offl%gconc_north(0,k,i,ig) + fac_dt *&
12543	salsa_nest_offl%gconc_north(1,k,i,ig)
12544	ENDDO
12545	ref_gconc_l(nzb+1:nzt,ig) = ref_gconc_l(nzb+1:nzt,ig) + &
12546	salsa_gas(ig)%conc(nzb+1:nzt,nyn+1,i)
12547	ENDDO
12548	ENDDO
12549	ENDIF
12550	ENDIF
12551
12552	IF ( bc_dirichlet_s ) THEN
12553	DO ib = 1, nbins_aerosol
12554	DO i = nxl, nxr
12555	DO k = nzb+1, nzt
12556	aerosol_number(ib)%conc(k,-1,i) = ( 1.0_wp - fac_dt ) * &
12557	salsa_nest_offl%nconc_south(0,k,i,ib) + fac_dt * &
12558	salsa_nest_offl%nconc_south(1,k,i,ib)
12559	ENDDO
12560	ref_nconc_l(nzb+1:nzt,ib) = ref_nconc_l(nzb+1:nzt,ib) + &
12561	aerosol_number(ib)%conc(nzb+1:nzt,-1,i)
12562	ENDDO
12563	DO ic = 1, ncomponents_mass
12564	icc = ( ic-1 ) * nbins_aerosol + ib
12565	DO i = nxl, nxr
12566	DO k = nzb+1, nzt
12567	aerosol_mass(icc)%conc(k,-1,i) = ( 1.0_wp - fac_dt ) * &
12568	salsa_nest_offl%mconc_south(0,k,i,icc) + fac_dt&
12569	* salsa_nest_offl%mconc_south(1,k,i,icc)
12570	ENDDO
12571	ref_mconc_l(nzb+1:nzt,icc) = ref_mconc_l(nzb+1:nzt,icc) + &
12572	aerosol_mass(icc)%conc(nzb+1:nzt,-1,i)
12573	ENDDO
12574	ENDDO
12575	ENDDO
12576	IF ( .NOT. salsa_gases_from_chem ) THEN
12577	DO ig = 1, ngases_salsa
12578	DO i = nxl, nxr
12579	DO k = nzb+1, nzt
12580	salsa_gas(ig)%conc(k,-1,i) = ( 1.0_wp - fac_dt ) * &
12581	salsa_nest_offl%gconc_south(0,k,i,ig) + fac_dt * &
12582	salsa_nest_offl%gconc_south(1,k,i,ig)
12583	ENDDO
12584	ref_gconc_l(nzb+1:nzt,ig) = ref_gconc_l(nzb+1:nzt,ig) + &
12585	salsa_gas(ig)%conc(nzb+1:nzt,-1,i)
12586	ENDDO
12587	ENDDO
12588	ENDIF
12589	ENDIF
12590	!
12591	!-- Top boundary
12592	DO ib = 1, nbins_aerosol
12593	DO i = nxl, nxr
12594	DO j = nys, nyn
12595	aerosol_number(ib)%conc(nzt+1,j,i) = ( 1.0_wp - fac_dt ) * &
12596	salsa_nest_offl%nconc_top(0,j,i,ib) + fac_dt * &
12597	salsa_nest_offl%nconc_top(1,j,i,ib)
12598	ref_nconc_l(nzt+1,ib) = ref_nconc_l(nzt+1,ib) + aerosol_number(ib)%conc(nzt+1,j,i)
12599	ENDDO
12600	ENDDO
12601	DO ic = 1, ncomponents_mass
12602	icc = ( ic-1 ) * nbins_aerosol + ib
12603	DO i = nxl, nxr
12604	DO j = nys, nyn
12605	aerosol_mass(icc)%conc(nzt+1,j,i) = ( 1.0_wp - fac_dt ) * &
12606	salsa_nest_offl%mconc_top(0,j,i,icc) + fac_dt *&
12607	salsa_nest_offl%mconc_top(1,j,i,icc)
12608	ref_mconc_l(nzt+1,icc) = ref_mconc_l(nzt+1,icc) + aerosol_mass(icc)%conc(nzt+1,j,i)
12609	ENDDO
12610	ENDDO
12611	ENDDO
12612	ENDDO
12613	IF ( .NOT. salsa_gases_from_chem ) THEN
12614	DO ig = 1, ngases_salsa
12615	DO i = nxl, nxr
12616	DO j = nys, nyn
12617	salsa_gas(ig)%conc(nzt+1,j,i) = ( 1.0_wp - fac_dt ) * &
12618	salsa_nest_offl%gconc_top(0,j,i,ig) + fac_dt * &
12619	salsa_nest_offl%gconc_top(1,j,i,ig)
12620	ref_gconc_l(nzt+1,ig) = ref_gconc_l(nzt+1,ig) + salsa_gas(ig)%conc(nzt+1,j,i)
12621	ENDDO
12622	ENDDO
12623	ENDDO
12624	ENDIF
12625	!
12626	!-- Do local exchange
12627	DO ib = 1, nbins_aerosol
12628	CALL exchange_horiz( aerosol_number(ib)%conc, nbgp )
12629	DO ic = 1, ncomponents_mass
12630	icc = ( ic-1 ) * nbins_aerosol + ib
12631	CALL exchange_horiz( aerosol_mass(icc)%conc, nbgp )
12632	ENDDO
12633	ENDDO
12634	IF ( .NOT. salsa_gases_from_chem ) THEN
12635	DO ig = 1, ngases_salsa
12636	CALL exchange_horiz( salsa_gas(ig)%conc, nbgp )
12637	ENDDO
12638	ENDIF
12639	!
12640	!-- In case of Rayleigh damping, where the initial profiles are still used, update these profiles
12641	!-- from the averaged boundary data. But first, average these data.
12642	#if defined( __parallel )
12643	IF ( .NOT. salsa_gases_from_chem ) &
12644	CALL MPI_ALLREDUCE( ref_gconc_l, ref_gconc, ( nzt+1-nzb+1 ) * SIZE( ref_gconc(nzb,:) ), &
12645	MPI_REAL, MPI_SUM, comm2d, ierr )
12646	CALL MPI_ALLREDUCE( ref_mconc_l, ref_mconc, ( nzt+1-nzb+1 ) * SIZE( ref_mconc(nzb,:) ), &
12647	MPI_REAL, MPI_SUM, comm2d, ierr )
12648	CALL MPI_ALLREDUCE( ref_nconc_l, ref_nconc, ( nzt+1-nzb+1 ) * SIZE( ref_nconc(nzb,:) ), &
12649	MPI_REAL, MPI_SUM, comm2d, ierr )
12650	#else
12651	IF ( .NOT. salsa_gases_from_chem ) ref_gconc = ref_gconc_l
12652	ref_mconc = ref_mconc_l
12653	ref_nconc = ref_nconc_l
12654	#endif
12655	!
12656	!-- Average data. Note, reference profiles up to nzt are derived from lateral boundaries, at the
12657	!-- model top it is derived from the top boundary. Thus, number of input data is different from
12658	!-- nzb:nzt compared to nzt+1.
12659	!-- Derived from lateral boundaries.
12660	IF ( .NOT. salsa_gases_from_chem ) &
12661	ref_gconc(nzb:nzt,:) = ref_gconc(nzb:nzt,:) / REAL( 2.0_wp * ( ny + 1 + nx + 1 ), KIND = wp )
12662	ref_mconc(nzb:nzt,:) = ref_mconc(nzb:nzt,:) / REAL( 2.0_wp * ( ny + 1 + nx + 1 ), KIND = wp )
12663	ref_nconc(nzb:nzt,:) = ref_nconc(nzb:nzt,:) / REAL( 2.0_wp * ( ny + 1 + nx + 1 ), KIND = wp )
12664	!
12665	!-- Derived from top boundary
12666	IF ( .NOT. salsa_gases_from_chem ) &
12667	ref_gconc(nzt+1,:) = ref_gconc(nzt+1,:) / REAL( ( ny + 1 ) * ( nx + 1 ), KIND = wp )
12668	ref_mconc(nzt+1,:) = ref_mconc(nzt+1,:) / REAL( ( ny + 1 ) * ( nx + 1 ), KIND = wp )
12669	ref_nconc(nzt+1,:) = ref_nconc(nzt+1,:) / REAL( ( ny + 1 ) * ( nx + 1 ), KIND = wp )
12670	!
12671	!-- Write onto init profiles, which are used for damping. Also set lower boundary condition.
12672	DO ib = 1, nbins_aerosol
12673	aerosol_number(ib)%init(:) = ref_nconc(:,ib)
12674	aerosol_number(ib)%init(nzb) = aerosol_number(ib)%init(nzb+1)
12675	DO ic = 1, ncomponents_mass
12676	icc = ( ic-1 ) * nbins_aerosol + ib
12677	aerosol_mass(icc)%init(:) = ref_mconc(:,icc)
12678	aerosol_mass(icc)%init(nzb) = aerosol_mass(icc)%init(nzb+1)
12679	ENDDO
12680	ENDDO
12681	IF ( .NOT. salsa_gases_from_chem ) THEN
12682	DO ig = 1, ngases_salsa
12683	salsa_gas(ig)%init(:) = ref_gconc(:,ig)
12684	salsa_gas(ig)%init(nzb) = salsa_gas(ig)%init(nzb+1)
12685	ENDDO
12686	ENDIF
12687
12688	DEALLOCATE( ref_gconc, ref_gconc_l, ref_mconc, ref_mconc_l, ref_nconc, ref_nconc_l )
12689
12690	END SUBROUTINE salsa_nesting_offl_bc
12691
12692	!------------------------------------------------------------------------------!
12693	! Description:
12694	! ------------
12695	!> Allocate arrays used to read boundary data from NetCDF file and initialize
12696	!> boundary data.
12697	!------------------------------------------------------------------------------!
12698	SUBROUTINE salsa_nesting_offl_init
12699
12700	USE control_parameters, &
12701	ONLY: end_time, initializing_actions, spinup_time
12702
12703	USE palm_date_time_mod, &
12704	ONLY: get_date_time
12705
12706	IMPLICIT NONE
12707
12708	INTEGER(iwp) :: ib !< running index for aerosol number bins
12709	INTEGER(iwp) :: ic !< running index for aerosol mass bins
12710	INTEGER(iwp) :: icc !< additional running index for aerosol mass bins
12711	INTEGER(iwp) :: ig !< running index for gaseous species
12712	INTEGER(iwp) :: nmass_bins !< number of aerosol mass bins
12713
12714	nmass_bins = nbins_aerosol * ncomponents_mass
12715	!
12716	!-- Allocate arrays for reading boundary values. Arrays will incorporate 2 time levels in order to
12717	!-- interpolate in between.
12718	IF ( nesting_offline_salsa ) THEN
12719	IF ( bc_dirichlet_l ) THEN
12720	ALLOCATE( salsa_nest_offl%nconc_left(0:1,nzb+1:nzt,nys:nyn,1:nbins_aerosol) )
12721	ALLOCATE( salsa_nest_offl%mconc_left(0:1,nzb+1:nzt,nys:nyn,1:nmass_bins) )
12722	ENDIF
12723	IF ( bc_dirichlet_r ) THEN
12724	ALLOCATE( salsa_nest_offl%nconc_right(0:1,nzb+1:nzt,nys:nyn,1:nbins_aerosol) )
12725	ALLOCATE( salsa_nest_offl%mconc_right(0:1,nzb+1:nzt,nys:nyn,1:nmass_bins) )
12726	ENDIF
12727	IF ( bc_dirichlet_n ) THEN
12728	ALLOCATE( salsa_nest_offl%nconc_north(0:1,nzb+1:nzt,nxl:nxr,1:nbins_aerosol) )
12729	ALLOCATE( salsa_nest_offl%mconc_north(0:1,nzb+1:nzt,nxl:nxr,1:nmass_bins) )
12730	ENDIF
12731	IF ( bc_dirichlet_s ) THEN
12732	ALLOCATE( salsa_nest_offl%nconc_south(0:1,nzb+1:nzt,nxl:nxr,1:nbins_aerosol) )
12733	ALLOCATE( salsa_nest_offl%mconc_south(0:1,nzb+1:nzt,nxl:nxr,1:nmass_bins) )
12734	ENDIF
12735	ALLOCATE( salsa_nest_offl%nconc_top(0:1,nys:nyn,nxl:nxr,1:nbins_aerosol) )
12736	ALLOCATE( salsa_nest_offl%mconc_top(0:1,nys:nyn,nxl:nxr,1:nmass_bins) )
12737
12738	IF ( .NOT. salsa_gases_from_chem ) THEN
12739	IF ( bc_dirichlet_l ) THEN
12740	ALLOCATE( salsa_nest_offl%gconc_left(0:1,nzb+1:nzt,nys:nyn,1:ngases_salsa) )
12741	ENDIF
12742	IF ( bc_dirichlet_r ) THEN
12743	ALLOCATE( salsa_nest_offl%gconc_right(0:1,nzb+1:nzt,nys:nyn,1:ngases_salsa) )
12744	ENDIF
12745	IF ( bc_dirichlet_n ) THEN
12746	ALLOCATE( salsa_nest_offl%gconc_north(0:1,nzb+1:nzt,nxl:nxr,1:ngases_salsa) )
12747	ENDIF
12748	IF ( bc_dirichlet_s ) THEN
12749	ALLOCATE( salsa_nest_offl%gconc_south(0:1,nzb+1:nzt,nxl:nxr,1:ngases_salsa) )
12750	ENDIF
12751	ALLOCATE( salsa_nest_offl%gconc_top(0:1,nys:nyn,nxl:nxr,1:ngases_salsa) )
12752	ENDIF
12753
12754	!
12755	!-- Read data at lateral and top boundaries from a larger-scale model
12756	CALL salsa_nesting_offl_input
12757	!
12758	!-- Check if sufficient time steps are provided to cover the entire simulation. Note, dynamic
12759	!-- input is only required for the 3D simulation, not for the soil/wall spinup. However, as the
12760	!-- spinup time is added to the end_time, this must be considered here.
12761	IF ( end_time - spinup_time > salsa_nest_offl%time(salsa_nest_offl%nt-1) ) THEN
12762	message_string = 'end_time of the simulation exceeds the time dimension in the dynamic'//&
12763	' input file.'
12764	CALL message( 'salsa_nesting_offl_init', 'PA0690', 1, 2, 0, 6, 0 )
12765	ENDIF
12766
12767	IF ( salsa_nest_offl%time(0) /= 0.0_wp ) THEN
12768	message_string = 'Offline nesting: time dimension must start at 0.0.'
12769	CALL message( 'salsa_nesting_offl_init', 'PA0691', 1, 2, 0, 6, 0 )
12770	ENDIF
12771	!
12772	!-- Initialize boundary data. Please note, do not initialize boundaries in case of restart runs.
12773	IF ( TRIM( initializing_actions ) /= 'read_restart_data' .AND. read_restart_data_salsa ) &
12774	THEN
12775	IF ( bc_dirichlet_l ) THEN
12776	DO ib = 1, nbins_aerosol
12777	aerosol_number(ib)%conc(nzb+1:nzt,nys:nyn,-1) = &
12778	salsa_nest_offl%nconc_left(0,nzb+1:nzt,nys:nyn,ib)
12779	DO ic = 1, ncomponents_mass
12780	icc = ( ic - 1 ) * nbins_aerosol + ib
12781	aerosol_mass(icc)%conc(nzb+1:nzt,nys:nyn,-1) = &
12782	salsa_nest_offl%mconc_left(0,nzb+1:nzt,nys:nyn,icc)
12783	ENDDO
12784	ENDDO
12785	DO ig = 1, ngases_salsa
12786	salsa_gas(ig)%conc(nzb+1:nzt,nys:nyn,-1) = &
12787	salsa_nest_offl%gconc_left(0,nzb+1:nzt,nys:nyn,ig)
12788	ENDDO
12789	ENDIF
12790	IF ( bc_dirichlet_r ) THEN
12791	DO ib = 1, nbins_aerosol
12792	aerosol_number(ib)%conc(nzb+1:nzt,nys:nyn,nxr+1) = &
12793	salsa_nest_offl%nconc_right(0,nzb+1:nzt,nys:nyn,ib)
12794	DO ic = 1, ncomponents_mass
12795	icc = ( ic - 1 ) * nbins_aerosol + ib
12796	aerosol_mass(icc)%conc(nzb+1:nzt,nys:nyn,nxr+1) = &
12797	salsa_nest_offl%mconc_right(0,nzb+1:nzt,nys:nyn,icc)
12798	ENDDO
12799	ENDDO
12800	DO ig = 1, ngases_salsa
12801	salsa_gas(ig)%conc(nzb+1:nzt,nys:nyn,nxr+1) = &
12802	salsa_nest_offl%gconc_right(0,nzb+1:nzt,nys:nyn,ig)
12803	ENDDO
12804	ENDIF
12805	IF ( bc_dirichlet_n ) THEN
12806	DO ib = 1, nbins_aerosol
12807	aerosol_number(ib)%conc(nzb+1:nzt,nyn+1,nxl:nxr) = &
12808	salsa_nest_offl%nconc_north(0,nzb+1:nzt,nxl:nxr,ib)
12809	DO ic = 1, ncomponents_mass
12810	icc = ( ic - 1 ) * nbins_aerosol + ib
12811	aerosol_mass(icc)%conc(nzb+1:nzt,nyn+1,nxl:nxr) = &
12812	salsa_nest_offl%mconc_north(0,nzb+1:nzt,nxl:nxr,icc)
12813	ENDDO
12814	ENDDO
12815	DO ig = 1, ngases_salsa
12816	salsa_gas(ig)%conc(nzb+1:nzt,nyn+1,nxl:nxr) = &
12817	salsa_nest_offl%gconc_north(0,nzb+1:nzt,nxl:nxr,ig)
12818	ENDDO
12819	ENDIF
12820	IF ( bc_dirichlet_s ) THEN
12821	DO ib = 1, nbins_aerosol
12822	aerosol_number(ib)%conc(nzb+1:nzt,-1,nxl:nxr) = &
12823	salsa_nest_offl%nconc_south(0,nzb+1:nzt,nxl:nxr,ib)
12824	DO ic = 1, ncomponents_mass
12825	icc = ( ic - 1 ) * nbins_aerosol + ib
12826	aerosol_mass(icc)%conc(nzb+1:nzt,-1,nxl:nxr) = &
12827	salsa_nest_offl%mconc_south(0,nzb+1:nzt,nxl:nxr,icc)
12828	ENDDO
12829	ENDDO
12830	DO ig = 1, ngases_salsa
12831	salsa_gas(ig)%conc(nzb+1:nzt,-1,nxl:nxr) = &
12832	salsa_nest_offl%gconc_south(0,nzb+1:nzt,nxl:nxr,ig)
12833	ENDDO
12834	ENDIF
12835	ENDIF
12836	ENDIF
12837
12838	END SUBROUTINE salsa_nesting_offl_init
12839
12840	!------------------------------------------------------------------------------!
12841	! Description:
12842	! ------------
12843	!> Set the lateral and top boundary conditions in case the PALM domain is
12844	!> nested offline in a mesoscale model. Further, average boundary data and
12845	!> determine mean profiles, further used for correct damping in the sponge
12846	!> layer.
12847	!------------------------------------------------------------------------------!
12848	SUBROUTINE salsa_nesting_offl_input
12849
12850	USE netcdf_data_input_mod, &
12851	ONLY: check_existence, close_input_file, get_attribute, get_variable, &
12852	inquire_num_variables, inquire_variable_names, &
12853	get_dimension_length, open_read_file
12854
12855	IMPLICIT NONE
12856
12857	CHARACTER(LEN=25) :: vname !< variable name
12858
12859	INTEGER(iwp) :: ic !< running index for aerosol chemical components
12860	INTEGER(iwp) :: ig !< running index for gases
12861	INTEGER(iwp) :: num_vars !< number of variables in netcdf input file
12862
12863	!
12864	!-- Skip input if no forcing from larger-scale models is applied.
12865	IF ( .NOT. nesting_offline_salsa ) RETURN
12866	!
12867	!-- Initialise
12868	IF ( .NOT. salsa_nest_offl%init ) THEN
12869
12870	#if defined ( __netcdf )
12871	!
12872	!-- Open file in read-only mode
12873	CALL open_read_file( TRIM( input_file_dynamic ) // TRIM( coupling_char ), &
12874	salsa_nest_offl%id_dynamic )
12875	!
12876	!-- At first, inquire all variable names.
12877	CALL inquire_num_variables( salsa_nest_offl%id_dynamic, num_vars )
12878	!
12879	!-- Allocate memory to store variable names.
12880	ALLOCATE( salsa_nest_offl%var_names(1:num_vars) )
12881	CALL inquire_variable_names( salsa_nest_offl%id_dynamic, salsa_nest_offl%var_names )
12882	!
12883	!-- Read time dimension, allocate memory and finally read time array
12884	CALL get_dimension_length( salsa_nest_offl%id_dynamic, salsa_nest_offl%nt,&
12885	'time' )
12886
12887	IF ( check_existence( salsa_nest_offl%var_names, 'time' ) ) THEN
12888	ALLOCATE( salsa_nest_offl%time(0:salsa_nest_offl%nt-1) )
12889	CALL get_variable( salsa_nest_offl%id_dynamic, 'time', salsa_nest_offl%time )
12890	ENDIF
12891	!
12892	!-- Read the vertical dimension
12893	CALL get_dimension_length( salsa_nest_offl%id_dynamic, salsa_nest_offl%nzu, 'z' )
12894	ALLOCATE( salsa_nest_offl%zu_atmos(1:salsa_nest_offl%nzu) )
12895	CALL get_variable( salsa_nest_offl%id_dynamic, 'z', salsa_nest_offl%zu_atmos )
12896	!
12897	!-- Read the number of aerosol chemical components
12898	CALL get_dimension_length( salsa_nest_offl%id_dynamic, salsa_nest_offl%ncc, &
12899	'composition_index' )
12900	!
12901	!-- Read the names of aerosol chemical components
12902	CALL get_variable( salsa_nest_offl%id_dynamic, 'composition_name', salsa_nest_offl%cc_name, &
12903	salsa_nest_offl%ncc )
12904	!
12905	!-- Define the index of each chemical component in the model
12906	DO ic = 1, salsa_nest_offl%ncc
12907	SELECT CASE ( TRIM( salsa_nest_offl%cc_name(ic) ) )
12908	CASE ( 'H2SO4', 'SO4', 'h2so4', 'so4' )
12909	salsa_nest_offl%cc_in2mod(1) = ic
12910	CASE ( 'OC', 'oc' )
12911	salsa_nest_offl%cc_in2mod(2) = ic
12912	CASE ( 'BC', 'bc' )
12913	salsa_nest_offl%cc_in2mod(3) = ic
12914	CASE ( 'DU', 'du' )
12915	salsa_nest_offl%cc_in2mod(4) = ic
12916	CASE ( 'SS', 'ss' )
12917	salsa_nest_offl%cc_in2mod(5) = ic
12918	CASE ( 'HNO3', 'hno3', 'NO3', 'no3', 'NO', 'no' )
12919	salsa_nest_offl%cc_in2mod(6) = ic
12920	CASE ( 'NH3', 'nh3', 'NH4', 'nh4', 'NH', 'nh' )
12921	salsa_nest_offl%cc_in2mod(7) = ic
12922	END SELECT
12923	ENDDO
12924	IF ( SUM( salsa_nest_offl%cc_in2mod ) == 0 ) THEN
12925	message_string = 'None of the aerosol chemical components in ' // &
12926	TRIM( input_file_dynamic ) // ' correspond to ones applied in SALSA.'
12927	CALL message( 'salsa_mod: salsa_nesting_offl_input', 'PA0693', 2, 2, 0, 6, 0 )
12928	ENDIF
12929
12930	CALL close_input_file( salsa_nest_offl%id_dynamic )
12931	#endif
12932	ENDIF
12933	!
12934	!-- Check if dynamic driver data input is required.
12935	IF ( salsa_nest_offl%time(salsa_nest_offl%tind_p) <= MAX( time_since_reference_point, 0.0_wp) &
12936	.OR. .NOT. salsa_nest_offl%init ) THEN
12937	CONTINUE
12938	!
12939	!-- Return otherwise
12940	ELSE
12941	RETURN
12942	ENDIF
12943	!
12944	!-- Obtain time index for current point in time.
12945	salsa_nest_offl%tind = MINLOC( ABS( salsa_nest_offl%time - &
12946	MAX( time_since_reference_point, 0.0_wp ) ), DIM = 1 ) - 1
12947	salsa_nest_offl%tind_p = salsa_nest_offl%tind + 1
12948	!
12949	!-- Open file in read-only mode
12950	#if defined ( __netcdf )
12951
12952	CALL open_read_file( TRIM( input_file_dynamic ) // TRIM( coupling_char ), &
12953	salsa_nest_offl%id_dynamic )
12954	!
12955	!-- Read data at the western boundary
12956	CALL get_variable( salsa_nest_offl%id_dynamic, 'ls_forcing_left_aerosol', &
12957	salsa_nest_offl%nconc_left, &
12958	MERGE( 0, 1, bc_dirichlet_l ), MERGE( nbins_aerosol-1, 0, bc_dirichlet_l ), &
12959	MERGE( nys, 1, bc_dirichlet_l ), MERGE( nyn, 0, bc_dirichlet_l ), &
12960	MERGE( nzb, 1, bc_dirichlet_l ), MERGE( nzt-1, 0, bc_dirichlet_l ), &
12961	MERGE( salsa_nest_offl%tind, 1, bc_dirichlet_l ), &
12962	MERGE( salsa_nest_offl%tind_p, 0, bc_dirichlet_l ) )
12963	IF ( bc_dirichlet_l ) THEN
12964	salsa_nest_offl%nconc_left = MAX( nclim, salsa_nest_offl%nconc_left )
12965	CALL nesting_offl_aero_mass( salsa_nest_offl%tind, salsa_nest_offl%tind_p, nzb+1, nzt, nys, &
12966	nyn, 'ls_forcing_left_mass_fracs_a', 1 )
12967	ENDIF
12968	IF ( .NOT. salsa_gases_from_chem ) THEN
12969	DO ig = 1, ngases_salsa
12970	vname = salsa_nest_offl%char_l // salsa_nest_offl%gas_name(ig)
12971	CALL get_variable( salsa_nest_offl%id_dynamic, TRIM( vname ), &
12972	salsa_nest_offl%gconc_left(:,:,:,ig), &
12973	MERGE( nys, 1, bc_dirichlet_l ), MERGE( nyn, 0, bc_dirichlet_l ), &
12974	MERGE( nzb, 1, bc_dirichlet_l ), MERGE( nzt-1, 0, bc_dirichlet_l ), &
12975	MERGE( salsa_nest_offl%tind, 1, bc_dirichlet_l ), &
12976	MERGE( salsa_nest_offl%tind_p, 0, bc_dirichlet_l ) )
12977	IF ( bc_dirichlet_l ) salsa_nest_offl%gconc_left(:,:,:,ig) = &
12978	MAX( nclim, salsa_nest_offl%gconc_left(:,:,:,ig) )
12979	ENDDO
12980	ENDIF
12981	!
12982	!-- Read data at the eastern boundary
12983	CALL get_variable( salsa_nest_offl%id_dynamic, 'ls_forcing_right_aerosol', &
12984	salsa_nest_offl%nconc_right, &
12985	MERGE( 0, 1, bc_dirichlet_r ), MERGE( nbins_aerosol-1, 0, bc_dirichlet_r ), &
12986	MERGE( nys, 1, bc_dirichlet_r ), MERGE( nyn, 0, bc_dirichlet_r ), &
12987	MERGE( nzb, 1, bc_dirichlet_r ), MERGE( nzt-1, 0, bc_dirichlet_r ), &
12988	MERGE( salsa_nest_offl%tind, 1, bc_dirichlet_r ), &
12989	MERGE( salsa_nest_offl%tind_p, 0, bc_dirichlet_r ) )
12990	IF ( bc_dirichlet_r ) THEN
12991	salsa_nest_offl%nconc_right = MAX( nclim, salsa_nest_offl%nconc_right )
12992	CALL nesting_offl_aero_mass( salsa_nest_offl%tind, salsa_nest_offl%tind_p, nzb+1, nzt, nys, &
12993	nyn, 'ls_forcing_right_mass_fracs_a', 2 )
12994	ENDIF
12995	IF ( .NOT. salsa_gases_from_chem ) THEN
12996	DO ig = 1, ngases_salsa
12997	vname = salsa_nest_offl%char_r // salsa_nest_offl%gas_name(ig)
12998	CALL get_variable( salsa_nest_offl%id_dynamic, TRIM( vname ), &
12999	salsa_nest_offl%gconc_right(:,:,:,ig), &
13000	MERGE( nys, 1, bc_dirichlet_r ), MERGE( nyn, 0, bc_dirichlet_r ), &
13001	MERGE( nzb, 1, bc_dirichlet_r ), MERGE( nzt-1, 0, bc_dirichlet_r ), &
13002	MERGE( salsa_nest_offl%tind, 1, bc_dirichlet_r ), &
13003	MERGE( salsa_nest_offl%tind_p, 0, bc_dirichlet_r ) )
13004	IF ( bc_dirichlet_r ) salsa_nest_offl%gconc_right(:,:,:,ig) = &
13005	MAX( nclim, salsa_nest_offl%gconc_right(:,:,:,ig) )
13006	ENDDO
13007	ENDIF
13008	!
13009	!-- Read data at the northern boundary
13010	CALL get_variable( salsa_nest_offl%id_dynamic, 'ls_forcing_north_aerosol', &
13011	salsa_nest_offl%nconc_north, &
13012	MERGE( 0, 1, bc_dirichlet_n ), MERGE( nbins_aerosol-1, 0, bc_dirichlet_n ), &
13013	MERGE( nxl, 1, bc_dirichlet_n ), MERGE( nxr, 0, bc_dirichlet_n ), &
13014	MERGE( nzb, 1, bc_dirichlet_n ), MERGE( nzt-1, 0, bc_dirichlet_n ), &
13015	MERGE( salsa_nest_offl%tind, 1, bc_dirichlet_n ), &
13016	MERGE( salsa_nest_offl%tind_p, 0, bc_dirichlet_n ) )
13017	IF ( bc_dirichlet_n ) THEN
13018	salsa_nest_offl%nconc_north = MAX( nclim, salsa_nest_offl%nconc_north )
13019	CALL nesting_offl_aero_mass( salsa_nest_offl%tind, salsa_nest_offl%tind_p, nzb+1, nzt, nxl, &
13020	nxr, 'ls_forcing_north_mass_fracs_a', 3 )
13021	ENDIF
13022	IF ( .NOT. salsa_gases_from_chem ) THEN
13023	DO ig = 1, ngases_salsa
13024	vname = salsa_nest_offl%char_n // salsa_nest_offl%gas_name(ig)
13025	CALL get_variable( salsa_nest_offl%id_dynamic, TRIM( vname ), &
13026	salsa_nest_offl%gconc_north(:,:,:,ig), &
13027	MERGE( nxl, 1, bc_dirichlet_n ), MERGE( nxr, 0, bc_dirichlet_n ), &
13028	MERGE( nzb, 1, bc_dirichlet_n ), MERGE( nzt-1, 0, bc_dirichlet_n ), &
13029	MERGE( salsa_nest_offl%tind, 1, bc_dirichlet_n ), &
13030	MERGE( salsa_nest_offl%tind_p, 0, bc_dirichlet_n ) )
13031	IF ( bc_dirichlet_n ) salsa_nest_offl%gconc_north(:,:,:,ig) = &
13032	MAX( nclim, salsa_nest_offl%gconc_north(:,:,:,ig) )
13033	ENDDO
13034	ENDIF
13035	!
13036	!-- Read data at the southern boundary
13037	CALL get_variable( salsa_nest_offl%id_dynamic, 'ls_forcing_south_aerosol', &
13038	salsa_nest_offl%nconc_south, &
13039	MERGE( 0, 1, bc_dirichlet_s ), MERGE( nbins_aerosol-1, 0, bc_dirichlet_s ), &
13040	MERGE( nxl, 1, bc_dirichlet_s ), MERGE( nxr, 0, bc_dirichlet_s ), &
13041	MERGE( nzb, 1, bc_dirichlet_s ), MERGE( nzt-1, 0, bc_dirichlet_s ), &
13042	MERGE( salsa_nest_offl%tind, 1, bc_dirichlet_s ), &
13043	MERGE( salsa_nest_offl%tind_p, 0, bc_dirichlet_s ) )
13044	IF ( bc_dirichlet_s ) THEN
13045	salsa_nest_offl%nconc_south = MAX( nclim, salsa_nest_offl%nconc_south )
13046	CALL nesting_offl_aero_mass( salsa_nest_offl%tind, salsa_nest_offl%tind_p, nzb+1, nzt, nxl, &
13047	nxr, 'ls_forcing_south_mass_fracs_a', 4 )
13048	ENDIF
13049	IF ( .NOT. salsa_gases_from_chem ) THEN
13050	DO ig = 1, ngases_salsa
13051	vname = salsa_nest_offl%char_s // salsa_nest_offl%gas_name(ig)
13052	CALL get_variable( salsa_nest_offl%id_dynamic, TRIM( vname ), &
13053	salsa_nest_offl%gconc_south(:,:,:,ig), &
13054	MERGE( nxl, 1, bc_dirichlet_s ), MERGE( nxr, 0, bc_dirichlet_s ), &
13055	MERGE( nzb, 1, bc_dirichlet_s ), MERGE( nzt-1, 0, bc_dirichlet_s ), &
13056	MERGE( salsa_nest_offl%tind, 1, bc_dirichlet_s ), &
13057	MERGE( salsa_nest_offl%tind_p, 0, bc_dirichlet_s ) )
13058	IF ( bc_dirichlet_s ) salsa_nest_offl%gconc_south(:,:,:,ig) = &
13059	MAX( nclim, salsa_nest_offl%gconc_south(:,:,:,ig) )
13060	ENDDO
13061	ENDIF
13062	!
13063	!-- Read data at the top boundary
13064	CALL get_variable( salsa_nest_offl%id_dynamic, 'ls_forcing_top_aerosol', &
13065	salsa_nest_offl%nconc_top(0:1,nys:nyn,nxl:nxr,1:nbins_aerosol), &
13066	0, nbins_aerosol-1, nxl, nxr, nys, nyn, salsa_nest_offl%tind, &
13067	salsa_nest_offl%tind_p )
13068	salsa_nest_offl%nconc_top = MAX( nclim, salsa_nest_offl%nconc_top )
13069	CALL nesting_offl_aero_mass( salsa_nest_offl%tind, salsa_nest_offl%tind_p, nys, nyn, nxl, nxr, &
13070	'ls_forcing_top_mass_fracs_a', 5 )
13071	IF ( .NOT. salsa_gases_from_chem ) THEN
13072	DO ig = 1, ngases_salsa
13073	vname = salsa_nest_offl%char_t // salsa_nest_offl%gas_name(ig)
13074	CALL get_variable( salsa_nest_offl%id_dynamic, TRIM( vname ), &
13075	salsa_nest_offl%gconc_top(:,:,:,ig), nxl, nxr, nys, nyn, &
13076	salsa_nest_offl%tind, salsa_nest_offl%tind_p )
13077	salsa_nest_offl%gconc_top(:,:,:,ig) = MAX( nclim, salsa_nest_offl%gconc_top(:,:,:,ig) )
13078	ENDDO
13079	ENDIF
13080	!
13081	!-- Close input file
13082	CALL close_input_file( salsa_nest_offl%id_dynamic )
13083
13084	#endif
13085	!
13086	!-- Set control flag to indicate that initialization is already done
13087	salsa_nest_offl%init = .TRUE.
13088
13089	END SUBROUTINE salsa_nesting_offl_input
13090
13091	!------------------------------------------------------------------------------!
13092	! Description:
13093	! ------------
13094	!> Sets the mass concentrations to aerosol arrays in 2a and 2b.
13095	!------------------------------------------------------------------------------!
13096	SUBROUTINE nesting_offl_aero_mass( ts, te, ks, ke, is, ie, varname_a, ibound )
13097
13098	USE netcdf_data_input_mod, &
13099	ONLY: get_variable
13100
13101	IMPLICIT NONE
13102
13103	CHARACTER(LEN=25) :: varname_b !< name for bins b
13104
13105	CHARACTER(LEN=*), INTENT(in) :: varname_a !< name for bins a
13106
13107	INTEGER(iwp) :: ee !< loop index: end
13108	INTEGER(iwp) :: i !< loop index
13109	INTEGER(iwp) :: ib !< loop index
13110	INTEGER(iwp) :: ic !< loop index
13111	INTEGER(iwp) :: k !< loop index
13112	INTEGER(iwp) :: ss !< loop index: start
13113	INTEGER(iwp) :: t !< loop index
13114	INTEGER(iwp) :: type_so4_oc = -1 !<
13115
13116	INTEGER(iwp), INTENT(in) :: ibound !< index: 1=left, 2=right, 3=north, 4=south, 5=top
13117	INTEGER(iwp), INTENT(in) :: ie !< loop index
13118	INTEGER(iwp), INTENT(in) :: is !< loop index
13119	INTEGER(iwp), INTENT(in) :: ks !< loop index
13120	INTEGER(iwp), INTENT(in) :: ke !< loop index
13121	INTEGER(iwp), INTENT(in) :: ts !< loop index
13122	INTEGER(iwp), INTENT(in) :: te !< loop index
13123
13124	INTEGER(iwp), DIMENSION(maxspec) :: cc_i2m !<
13125
13126	REAL(wp) :: pmf1a !< mass fraction in 1a
13127
13128	REAL(wp), DIMENSION(nbins_aerosol) :: core !< size of the bin mid aerosol particle
13129
13130	REAL(wp), DIMENSION(0:1,ks:ke,is:ie,1:nbins_aerosol) :: to_nconc !<
13131	REAL(wp), DIMENSION(0:1,ks:ke,is:ie,1:nbins_aerosol*ncomponents_mass) :: to_mconc !<
13132
13133	REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE :: mf2a !< Mass distributions for a
13134	REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE :: mf2b !< and b bins
13135
13136	!
13137	!-- Variable name for insoluble mass fraction
13138	varname_b = varname_a(1:LEN( TRIM( varname_a ) ) - 1 ) // 'b'
13139	!
13140	!-- Bin mean aerosol particle volume (m3)
13141	core(1:nbins_aerosol) = api6 * aero(1:nbins_aerosol)%dmid**3
13142	!
13143	!-- Allocate and read mass fraction arrays
13144	ALLOCATE( mf2a(0:1,ks:ke,is:ie,1:salsa_nest_offl%ncc), &
13145	mf2b(0:1,ks:ke,is:ie,1:salsa_nest_offl%ncc) )
13146	IF ( ibound == 5 ) THEN
13147	CALL get_variable( salsa_nest_offl%id_dynamic, varname_a, &
13148	mf2a(0:1,ks:ke,is:ie,1:salsa_nest_offl%ncc), 0, salsa_nest_offl%ncc-1, &
13149	is, ie, ks, ke, ts, te )
13150	ELSE
13151	CALL get_variable( salsa_nest_offl%id_dynamic, varname_a, &
13152	mf2a(0:1,ks:ke,is:ie,1:salsa_nest_offl%ncc), 0, salsa_nest_offl%ncc-1, &
13153	is, ie, ks-1, ke-1, ts, te )
13154	ENDIF
13155	!
13156	!-- If the chemical component is not activated, set its mass fraction to 0 to avoid mass inbalance
13157	cc_i2m = salsa_nest_offl%cc_in2mod
13158	IF ( index_so4 < 0 .AND. cc_i2m(1) > 0 ) mf2a(:,:,:,cc_i2m(1)) = 0.0_wp
13159	IF ( index_oc < 0 .AND. cc_i2m(2) > 0 ) mf2a(:,:,:,cc_i2m(2)) = 0.0_wp
13160	IF ( index_bc < 0 .AND. cc_i2m(3) > 0 ) mf2a(:,:,:,cc_i2m(3)) = 0.0_wp
13161	IF ( index_du < 0 .AND. cc_i2m(4) > 0 ) mf2a(:,:,:,cc_i2m(4)) = 0.0_wp
13162	IF ( index_ss < 0 .AND. cc_i2m(5) > 0 ) mf2a(:,:,:,cc_i2m(5)) = 0.0_wp
13163	IF ( index_no < 0 .AND. cc_i2m(6) > 0 ) mf2a(:,:,:,cc_i2m(6)) = 0.0_wp
13164	IF ( index_nh < 0 .AND. cc_i2m(7) > 0 ) mf2a(:,:,:,cc_i2m(7)) = 0.0_wp
13165	mf2b = 0.0_wp
13166	!
13167	!-- Initialise variable type_so4_oc to indicate whether SO4 and/OC is included in mass fraction data
13168	IF ( ( cc_i2m(1) > 0 .AND. index_so4 > 0 ) .AND. ( cc_i2m(2) > 0 .AND. index_oc > 0 ) ) &
13169	THEN
13170	type_so4_oc = 1
13171	ELSEIF ( cc_i2m(1) > 0 .AND. index_so4 > 0 ) THEN
13172	type_so4_oc = 2
13173	ELSEIF ( cc_i2m(2) > 0 .AND. index_oc > 0 ) THEN
13174	type_so4_oc = 3
13175	ENDIF
13176
13177	SELECT CASE ( ibound )
13178	CASE( 1 )
13179	to_nconc = salsa_nest_offl%nconc_left
13180	to_mconc = salsa_nest_offl%mconc_left
13181	CASE( 2 )
13182	to_nconc = salsa_nest_offl%nconc_right
13183	to_mconc = salsa_nest_offl%mconc_right
13184	CASE( 3 )
13185	to_nconc = salsa_nest_offl%nconc_north
13186	to_mconc = salsa_nest_offl%mconc_north
13187	CASE( 4 )
13188	to_nconc = salsa_nest_offl%nconc_south
13189	to_mconc = salsa_nest_offl%mconc_south
13190	CASE( 5 )
13191	to_nconc = salsa_nest_offl%nconc_top
13192	to_mconc = salsa_nest_offl%mconc_top
13193	END SELECT
13194	!
13195	!-- Set mass concentrations:
13196	!
13197	!-- Regime 1:
13198	SELECT CASE ( type_so4_oc )
13199	CASE ( 1 ) ! Both SO4 and OC given
13200
13201	ss = ( index_so4 - 1 ) * nbins_aerosol + start_subrange_1a ! start
13202	ee = ( index_so4 - 1 ) * nbins_aerosol + end_subrange_1a ! end
13203	ib = start_subrange_1a
13204	DO ic = ss, ee
13205	DO i = is, ie
13206	DO k = ks, ke
13207	DO t = 0, 1
13208	pmf1a = mf2a(t,k,i,cc_i2m(1)) / ( mf2a(t,k,i,cc_i2m(1)) + mf2a(t,k,i,cc_i2m(2)) )
13209	to_mconc(t,k,i,ic) = pmf1a * to_nconc(t,k,i,ib) * core(ib) * arhoh2so4
13210	ENDDO
13211	ENDDO
13212	ENDDO
13213	ib = ib + 1
13214	ENDDO
13215	ss = ( index_oc - 1 ) * nbins_aerosol + start_subrange_1a ! start
13216	ee = ( index_oc - 1 ) * nbins_aerosol + end_subrange_1a ! end
13217	ib = start_subrange_1a
13218	DO ic = ss, ee
13219	DO i = is, ie
13220	DO k = ks, ke
13221	DO t = 0, 1
13222	pmf1a = mf2a(t,k,i,cc_i2m(2)) / ( mf2a(t,k,i,cc_i2m(1)) + mf2a(t,k,i,cc_i2m(2)) )
13223	to_mconc(t,k,i,ic) = pmf1a * to_nconc(t,k,i,ib) * core(ib) * arhooc
13224	ENDDO
13225	ENDDO
13226	ENDDO
13227	ib = ib + 1
13228	ENDDO
13229	CASE ( 2 ) ! Only SO4
13230	ss = ( index_so4 - 1 ) * nbins_aerosol + start_subrange_1a ! start
13231	ee = ( index_so4 - 1 ) * nbins_aerosol + end_subrange_1a ! end
13232	ib = start_subrange_1a
13233	DO ic = ss, ee
13234	DO i = is, ie
13235	DO k = ks, ke
13236	DO t = 0, 1
13237	to_mconc(t,k,i,ic) = to_nconc(t,k,i,ib) * core(ib) * arhoh2so4
13238	ENDDO
13239	ENDDO
13240	ENDDO
13241	ib = ib + 1
13242	ENDDO
13243	CASE ( 3 ) ! Only OC
13244	ss = ( index_oc - 1 ) * nbins_aerosol + start_subrange_1a ! start
13245	ee = ( index_oc - 1 ) * nbins_aerosol + end_subrange_1a ! end
13246	ib = start_subrange_1a
13247	DO ic = ss, ee
13248	DO i = is, ie
13249	DO k = ks, ke
13250	DO t = 0, 1
13251	to_mconc(t,k,i,ic) = to_nconc(t,k,i,ib) * core(ib) * arhooc
13252	ENDDO
13253	ENDDO
13254	ENDDO
13255	ib = ib + 1
13256	ENDDO
13257	END SELECT
13258	!
13259	!-- Regimes 2a and 2b:
13260	IF ( index_so4 > 0 ) THEN
13261	CALL set_nest_mass( index_so4, 1, arhoh2so4 )
13262	ENDIF
13263	IF ( index_oc > 0 ) THEN
13264	CALL set_nest_mass( index_oc, 2, arhooc )
13265	ENDIF
13266	IF ( index_bc > 0 ) THEN
13267	CALL set_nest_mass( index_bc, 3, arhobc )
13268	ENDIF
13269	IF ( index_du > 0 ) THEN
13270	CALL set_nest_mass( index_du, 4, arhodu )
13271	ENDIF
13272	IF ( index_ss > 0 ) THEN
13273	CALL set_nest_mass( index_ss, 5, arhoss )
13274	ENDIF
13275	IF ( index_no > 0 ) THEN
13276	CALL set_nest_mass( index_no, 6, arhohno3 )
13277	ENDIF
13278	IF ( index_nh > 0 ) THEN
13279	CALL set_nest_mass( index_nh, 7, arhonh3 )
13280	ENDIF
13281
13282	DEALLOCATE( mf2a, mf2b )
13283
13284	SELECT CASE ( ibound )
13285	CASE( 1 )
13286	salsa_nest_offl%mconc_left = to_mconc
13287	CASE( 2 )
13288	salsa_nest_offl%mconc_right = to_mconc
13289	CASE( 3 )
13290	salsa_nest_offl%mconc_north = to_mconc
13291	CASE( 4 )
13292	salsa_nest_offl%mconc_south = to_mconc
13293	CASE( 5 )
13294	salsa_nest_offl%mconc_top = to_mconc
13295	END SELECT
13296
13297	CONTAINS
13298
13299	!------------------------------------------------------------------------------!
13300	! Description:
13301	! ------------
13302	!> Set nesting boundaries for aerosol mass.
13303	!------------------------------------------------------------------------------!
13304	SUBROUTINE set_nest_mass( ispec, ispec_def, prho )
13305
13306	IMPLICIT NONE
13307
13308	INTEGER(iwp) :: ic !< chemical component index: default
13309	INTEGER(iwp) :: icc !< loop index: mass bin
13310
13311	INTEGER(iwp), INTENT(in) :: ispec !< aerosol species index
13312	INTEGER(iwp), INTENT(in) :: ispec_def !< default aerosol species index
13313
13314	REAL(wp), INTENT(in) :: prho !< aerosol density
13315	!
13316	!-- Define the index of the chemical component in the input data
13317	ic = salsa_nest_offl%cc_in2mod(ispec_def)
13318
13319	DO i = is, ie
13320	DO k = ks, ke
13321	DO t = 0, 1
13322	!
13323	!-- Regime 2a:
13324	ss = ( ispec - 1 ) * nbins_aerosol + start_subrange_2a
13325	ee = ( ispec - 1 ) * nbins_aerosol + end_subrange_2a
13326	ib = start_subrange_2a
13327	DO icc = ss, ee
13328	to_mconc(t,k,i,icc) = MAX( 0.0_wp, mf2a(t,k,i,ic) / SUM( mf2a(t,k,i,:) ) ) * &
13329	to_nconc(t,k,i,ib) * core(ib) * prho
13330	ib = ib + 1
13331	ENDDO
13332	!
13333	!-- Regime 2b:
13334	IF ( .NOT. no_insoluble ) THEN
13335	!
13336	!-- TODO!
13337	mf2b(t,k,i,ic) = mf2b(t,k,i,ic)
13338	ENDIF
13339	ENDDO ! k
13340
13341	ENDDO ! j
13342	ENDDO ! i
13343
13344	END SUBROUTINE set_nest_mass
13345
13346	END SUBROUTINE nesting_offl_aero_mass
13347
13348
13349	END MODULE salsa_mod

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

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |