Home

Context Navigation

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

Last change on this file since 4364 was 4364, checked in by monakurppa, 5 years ago
Time in the input data set relative to the start of the simulation
Property svn:keywords set to `Id`
File size: 592.6 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 4364 2020-01-08 02:12:31Z monakurppa $
28	! Set time coordinate in the input data relative to origin_time rather than to
29	! 00:00:00 UTC
30	!
31	! 4360 2020-01-07 11:25:50Z suehring
32	! Introduction of wall_flags_total_0, which currently sets bits based on static
33	! topography information used in wall_flags_static_0
34	!
35	! 4342 2019-12-16 13:49:14Z Giersch
36	! cdc replaced by canopy_drag_coeff
37	!
38	! 4329 2019-12-10 15:46:36Z motisi
39	! Renamed wall_flags_0 to wall_flags_static_0
40	!
41	! 4315 2019-12-02 09:20:07Z monakurppa
42	! Add an additional check for the time dimension PIDS_SALSA in
43	! salsa_emission_setup and correct some error message identifiers.
44	!
45	! 4298 2019-11-21 15:59:16Z suehring
46	! Bugfix, close netcdf input files after reading
47	!
48	! 4295 2019-11-14 06:15:31Z monakurppa
49	!
50	!
51	! 4280 2019-10-29 14:34:15Z monakurppa
52	! Corrected a bug in boundary conditions and fac_dt in offline nesting
53	!
54	! 4273 2019-10-24 13:40:54Z monakurppa
55	! - Rename nest_salsa to nesting_salsa
56	! - Correct some errors in boundary condition flags
57	! - Add a check for not trying to output gas concentrations in salsa if the
58	! chemistry module is applied
59	! - Set the default value of nesting_salsa and nesting_offline_salsa to .TRUE.
60	!
61	! 4272 2019-10-23 15:18:57Z schwenkel
62	! Further modularization of boundary conditions: moved boundary conditions to
63	! respective modules
64	!
65	! 4270 2019-10-23 10:46:20Z monakurppa
66	! - Implement offline nesting for salsa
67	! - Alphabetic ordering for module interfaces
68	! - Remove init_aerosol_type and init_gases_type from salsa_parin and define them
69	! based on the initializing_actions
70	! - parameter definition removed from "season" and "season_z01" is added to parin
71	! - bugfix in application of index_hh after implementing the new
72	! palm_date_time_mod
73	! - Reformat salsa emission data with LOD=2: size distribution given for each
74	! emission category
75	!
76	! 4268 2019-10-17 11:29:38Z schwenkel
77	! Moving module specific boundary conditions from time_integration to module
78	!
79	! 4256 2019-10-07 10:08:52Z monakurppa
80	! Document previous changes: use global variables nx, ny and nz in salsa_header
81	!
82	! 4227 2019-09-10 18:04:34Z gronemeier
83	! implement new palm_date_time_mod
84	!
85	! 4226 2019-09-10 17:03:24Z suehring
86	! Netcdf input routine for dimension length renamed
87	!
88	! 4182 2019-08-22 15:20:23Z scharf
89	! Corrected "Former revisions" section
90	!
91	! 4167 2019-08-16 11:01:48Z suehring
92	! Changed behaviour of masked output over surface to follow terrain and ignore
93	! buildings (J.Resler, T.Gronemeier)
94	!
95	! 4131 2019-08-02 11:06:18Z monakurppa
96	! - Add "salsa_" before each salsa output variable
97	! - Add a possibility to output the number (salsa_N_UFP) and mass concentration
98	! (salsa_PM0.1) of ultrafine particles, i.e. particles with a diameter smaller
99	! than 100 nm
100	! - Implement aerosol emission mode "parameterized" which is based on the street
101	! type (similar to the chemistry module).
102	! - Remove unnecessary nucleation subroutines.
103	! - Add the z-dimension for gaseous emissions to correspond the implementation
104	! in the chemistry module
105	!
106	! 4118 2019-07-25 16:11:45Z suehring
107	! - When Dirichlet condition is applied in decycling, the boundary conditions are
108	! only set at the ghost points and not at the prognostic grid points as done
109	! before
110	! - Rename decycle_ns/lr to decycle_salsa_ns/lr and decycle_method to
111	! decycle_method_salsa
112	! - Allocation and initialization of special advection flags salsa_advc_flags_s
113	! used for salsa. These are exclusively used for salsa variables to
114	! distinguish from the usually-used flags which might be different when
115	! decycling is applied in combination with cyclic boundary conditions.
116	! Moreover, salsa_advc_flags_s considers extended zones around buildings where
117	! the first-order upwind scheme is applied for the horizontal advection terms.
118	! This is done to overcome high concentration peaks due to stationary numerical
119	! oscillations caused by horizontal advection discretization.
120	!
121	! 4117 2019-07-25 08:54:02Z monakurppa
122	! Pass integer flag array as well as boundary flags to WS scalar advection
123	! routine
124	!
125	! 4109 2019-07-22 17:00:34Z suehring
126	! Slightly revise setting of boundary conditions at horizontal walls, use
127	! data-structure offset index instead of pre-calculate it for each facing
128	!
129	! 4079 2019-07-09 18:04:41Z suehring
130	! Application of monotonic flux limiter for the vertical scalar advection
131	! up to the topography top (only for the cache-optimized version at the
132	! moment).
133	!
134	! 4069 2019-07-01 14:05:51Z Giersch
135	! Masked output running index mid has been introduced as a local variable to
136	! avoid runtime error (Loop variable has been modified) in time_integration
137	!
138	! 4058 2019-06-27 15:25:42Z knoop
139	! Bugfix: to_be_resorted was uninitialized in case of s_H2O in 3d_data_averaging
140	!
141	! 4012 2019-05-31 15:19:05Z monakurppa
142	! Merge salsa branch to trunk. List of changes:
143	! - Error corrected in distr_update that resulted in the aerosol number size
144	! distribution not converging if the concentration was nclim.
145	! - Added a separate output for aerosol liquid water (s_H2O)
146	! - aerosol processes for a size bin are now calculated only if the aerosol
147	! number of concentration of that bin is > 2*nclim
148	! - An initialisation error in the subroutine "deposition" corrected and the
149	! subroutine reformatted.
150	! - stuff from salsa_util_mod.f90 moved into salsa_mod.f90
151	! - calls for closing the netcdf input files added
152	!
153	! 3956 2019-05-07 12:32:52Z monakurppa
154	! - Conceptual bug in depo_surf correct for urban and land surface model
155	! - Subroutine salsa_tendency_ij optimized.
156	! - Interfaces salsa_non_advective_processes and salsa_exchange_horiz_bounds
157	! created. These are now called in module_interface.
158	! salsa_exchange_horiz_bounds after calling salsa_driver only when needed
159	! (i.e. every dt_salsa).
160	!
161	! 3924 2019-04-23 09:33:06Z monakurppa
162	! Correct a bug introduced by the previous update.
163	!
164	! 3899 2019-04-16 14:05:27Z monakurppa
165	! - remove unnecessary error / location messages
166	! - corrected some error message numbers
167	! - allocate source arrays only if emissions or dry deposition is applied.
168	!
169	! 3885 2019-04-11 11:29:34Z kanani
170	! Changes related to global restructuring of location messages and introduction
171	! of additional debug messages
172	!
173	! 3876 2019-04-08 18:41:49Z knoop
174	! Introduced salsa_actions module interface
175	!
176	! 3871 2019-04-08 14:38:39Z knoop
177	! Major changes in formatting, performance and data input structure (see branch
178	! the history for details)
179	! - Time-dependent emissions enabled: lod=1 for yearly PM emissions that are
180	! normalised depending on the time, and lod=2 for preprocessed emissions
181	! (similar to the chemistry module).
182	! - Additionally, 'uniform' emissions allowed. This emission is set constant on
183	! all horisontal upward facing surfaces and it is created based on parameters
184	! surface_aerosol_flux, aerosol_flux_dpg/sigmag/mass_fracs_a/mass_fracs_b.
185	! - All emissions are now implemented as surface fluxes! No 3D sources anymore.
186	! - Update the emission information by calling salsa_emission_update if
187	! skip_time_do_salsa >= time_since_reference_point and
188	! next_aero_emission_update <= time_since_reference_point
189	! - Aerosol background concentrations read from PIDS_DYNAMIC. The vertical grid
190	! must match the one applied in the model.
191	! - Gas emissions and background concentrations can be also read in in salsa_mod
192	! if the chemistry module is not applied.
193	! - In deposition, information on the land use type can be now imported from
194	! the land use model
195	! - Use SI units in PARIN, i.e. n_lognorm given in #/m3 and dpg in metres.
196	! - Apply 100 character line limit
197	! - Change all variable names from capital to lowercase letter
198	! - Change real exponents to integer if possible. If not, precalculate the value
199	! value of exponent
200	! - Rename in1a to start_subrange_1a, fn2a to end_subrange_1a etc.
201	! - Rename nbins --> nbins_aerosol, ncc_tot --> ncomponents_mass and ngast -->
202	! ngases_salsa
203	! - Rename ibc to index_bc, idu to index_du etc.
204	! - Renamed loop indices b, c and sg to ib, ic and ig
205	! - run_salsa subroutine removed
206	! - Corrected a bud in salsa_driver: falsely applied ino instead of inh
207	! - Call salsa_tendency within salsa_prognostic_equations which is called in
208	! module_interface_mod instead of prognostic_equations_mod
209	! - Removed tailing white spaces and unused variables
210	! - Change error message to start by PA instead of SA
211	!
212	! 3833 2019-03-28 15:04:04Z forkel
213	! added USE chem_gasphase_mod for nvar, nspec and spc_names
214	!
215	! 3787 2019-03-07 08:43:54Z raasch
216	! unused variables removed
217	!
218	! 3780 2019-03-05 11:19:45Z forkel
219	! unused variable for file index removed from rrd-subroutines parameter list
220	!
221	! 3685 2019-01-21 01:02:11Z knoop
222	! Some interface calls moved to module_interface + cleanup
223	!
224	! 3655 2019-01-07 16:51:22Z knoop
225	! Implementation of the PALM module interface
226	! 3412 2018-10-24 07:25:57Z monakurppa
227	!
228	! Authors:
229	! --------
230	! @author Mona Kurppa (University of Helsinki)
231	!
232	!
233	! Description:
234	! ------------
235	!> Sectional aerosol module for large scale applications SALSA
236	!> (Kokkola et al., 2008, ACP 8, 2469-2483). Solves the aerosol number and mass
237	!> concentration as well as chemical composition. Includes aerosol dynamic
238	!> processes: nucleation, condensation/evaporation of vapours, coagulation and
239	!> deposition on tree leaves, ground and roofs.
240	!> Implementation is based on formulations implemented in UCLALES-SALSA except
241	!> for deposition which is based on parametrisations by Zhang et al. (2001,
242	!> Atmos. Environ. 35, 549-560) or Petroff&Zhang (2010, Geosci. Model Dev. 3,
243	!> 753-769)
244	!>
245	!> @todo Apply information from emission_stack_height to lift emission sources
246	!> @todo Allow insoluble emissions
247	!------------------------------------------------------------------------------!
248	MODULE salsa_mod
249
250	USE basic_constants_and_equations_mod, &
251	ONLY: c_p, g, p_0, pi, r_d
252
253	USE chem_gasphase_mod, &
254	ONLY: nspec, nvar, spc_names
255
256	USE chem_modules, &
257	ONLY: call_chem_at_all_substeps, chem_gasphase_on, chem_species
258
259	USE control_parameters, &
260	ONLY: air_chemistry, bc_dirichlet_l, bc_dirichlet_n, bc_dirichlet_r, bc_dirichlet_s, &
261	bc_lr, bc_lr_cyc, bc_ns, bc_ns_cyc, bc_radiation_l, bc_radiation_n, bc_radiation_r, &
262	bc_radiation_s, coupling_char, debug_output, dt_3d, intermediate_timestep_count, &
263	intermediate_timestep_count_max, land_surface, max_pr_salsa, message_string, &
264	monotonic_limiter_z, plant_canopy, pt_surface, salsa, scalar_advec, &
265	surface_pressure, time_since_reference_point, timestep_scheme, tsc, urban_surface, &
266	ws_scheme_sca
267
268	USE indices, &
269	ONLY: nbgp, nx, nxl, nxlg, nxr, nxrg, ny, nyn, nyng, nys, nysg, nzb, nz, nzt, &
270	wall_flags_total_0
271
272	USE kinds
273
274	USE netcdf_data_input_mod, &
275	ONLY: chem_emis_att_type, chem_emis_val_type
276
277	USE pegrid
278
279	USE statistics, &
280	ONLY: sums_salsa_ws_l
281
282	IMPLICIT NONE
283	!
284	!-- SALSA constants:
285	!
286	!-- Local constants:
287	INTEGER(iwp), PARAMETER :: luc_urban = 15 !< default landuse type for urban
288	INTEGER(iwp), PARAMETER :: ngases_salsa = 5 !< total number of gaseous tracers:
289	!< 1 = H2SO4, 2 = HNO3, 3 = NH3, 4 = OCNV
290	!< (non-volatile OC), 5 = OCSV (semi-volatile)
291	INTEGER(iwp), PARAMETER :: nmod = 7 !< number of modes for initialising the aerosol size distribution
292	INTEGER(iwp), PARAMETER :: nreg = 2 !< Number of main size subranges
293	INTEGER(iwp), PARAMETER :: maxspec = 7 !< Max. number of aerosol species
294
295
296	REAL(wp), PARAMETER :: fill_value = -9999.0_wp !< value for the _FillValue attribute
297	!
298	!-- Universal constants
299	REAL(wp), PARAMETER :: abo = 1.380662E-23_wp !< Boltzmann constant (J/K)
300	REAL(wp), PARAMETER :: alv = 2.260E+6_wp !< latent heat for H2O vaporisation (J/kg)
301	REAL(wp), PARAMETER :: alv_d_rv = 4896.96865_wp !< alv / rv
302	REAL(wp), PARAMETER :: am_airmol = 4.8096E-26_wp !< Average mass of an air molecule (Jacobson 2005, Eq.2.3)
303	REAL(wp), PARAMETER :: api6 = 0.5235988_wp !< pi / 6
304	REAL(wp), PARAMETER :: argas = 8.314409_wp !< Gas constant (J/(mol K))
305	REAL(wp), PARAMETER :: argas_d_cpd = 8.281283865E-3_wp !< argas per cpd
306	REAL(wp), PARAMETER :: avo = 6.02214E+23_wp !< Avogadro constant (1/mol)
307	REAL(wp), PARAMETER :: d_sa = 5.539376964394570E-10_wp !< diameter of condensing H2SO4 molecule (m)
308	REAL(wp), PARAMETER :: for_ppm_to_nconc = 7.243016311E+16_wp !< ppm * avo / R (K/(Pa*m3))
309	REAL(wp), PARAMETER :: epsoc = 0.15_wp !< water uptake of organic material
310	REAL(wp), PARAMETER :: mclim = 1.0E-23_wp !< mass concentration min limit (kg/m3)
311	REAL(wp), PARAMETER :: n3 = 158.79_wp !< Number of H2SO4 molecules in 3 nm cluster if d_sa=5.54e-10m
312	REAL(wp), PARAMETER :: nclim = 1.0_wp !< number concentration min limit (#/m3)
313	REAL(wp), PARAMETER :: surfw0 = 0.073_wp !< surface tension of water at 293 K (J/m2)
314	!
315	!-- Molar masses in kg/mol
316	REAL(wp), PARAMETER :: ambc = 12.0E-3_wp !< black carbon (BC)
317	REAL(wp), PARAMETER :: amdair = 28.970E-3_wp !< dry air
318	REAL(wp), PARAMETER :: amdu = 100.0E-3_wp !< mineral dust
319	REAL(wp), PARAMETER :: amh2o = 18.0154E-3_wp !< H2O
320	REAL(wp), PARAMETER :: amh2so4 = 98.06E-3_wp !< H2SO4
321	REAL(wp), PARAMETER :: amhno3 = 63.01E-3_wp !< HNO3
322	REAL(wp), PARAMETER :: amn2o = 44.013E-3_wp !< N2O
323	REAL(wp), PARAMETER :: amnh3 = 17.031E-3_wp !< NH3
324	REAL(wp), PARAMETER :: amo2 = 31.9988E-3_wp !< O2
325	REAL(wp), PARAMETER :: amo3 = 47.998E-3_wp !< O3
326	REAL(wp), PARAMETER :: amoc = 150.0E-3_wp !< organic carbon (OC)
327	REAL(wp), PARAMETER :: amss = 58.44E-3_wp !< sea salt (NaCl)
328	!
329	!-- Densities in kg/m3
330	REAL(wp), PARAMETER :: arhobc = 2000.0_wp !< black carbon
331	REAL(wp), PARAMETER :: arhodu = 2650.0_wp !< mineral dust
332	REAL(wp), PARAMETER :: arhoh2o = 1000.0_wp !< H2O
333	REAL(wp), PARAMETER :: arhoh2so4 = 1830.0_wp !< SO4
334	REAL(wp), PARAMETER :: arhohno3 = 1479.0_wp !< HNO3
335	REAL(wp), PARAMETER :: arhonh3 = 1530.0_wp !< NH3
336	REAL(wp), PARAMETER :: arhooc = 2000.0_wp !< organic carbon
337	REAL(wp), PARAMETER :: arhoss = 2165.0_wp !< sea salt (NaCl)
338	!
339	!-- Volume of molecule in m3/#
340	REAL(wp), PARAMETER :: amvh2o = amh2o /avo / arhoh2o !< H2O
341	REAL(wp), PARAMETER :: amvh2so4 = amh2so4 / avo / arhoh2so4 !< SO4
342	REAL(wp), PARAMETER :: amvhno3 = amhno3 / avo / arhohno3 !< HNO3
343	REAL(wp), PARAMETER :: amvnh3 = amnh3 / avo / arhonh3 !< NH3
344	REAL(wp), PARAMETER :: amvoc = amoc / avo / arhooc !< OC
345	REAL(wp), PARAMETER :: amvss = amss / avo / arhoss !< sea salt
346	!
347	!-- Constants for the dry deposition model by Petroff and Zhang (2010):
348	!-- obstacle characteristic dimension "L" (cm) (plane obstacle by default) and empirical constants
349	!-- C_B, C_IN, C_IM, beta_IM and C_IT for each land use category (15, as in Zhang et al. (2001))
350	REAL(wp), DIMENSION(1:15), PARAMETER :: l_p10 = &
351	(/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/)
352	REAL(wp), DIMENSION(1:15), PARAMETER :: c_b_p10 = &
353	(/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/)
354	REAL(wp), DIMENSION(1:15), PARAMETER :: c_in_p10 = &
355	(/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/)
356	REAL(wp), DIMENSION(1:15), PARAMETER :: c_im_p10 = &
357	(/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/)
358	REAL(wp), DIMENSION(1:15), PARAMETER :: beta_im_p10 = &
359	(/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/)
360	REAL(wp), DIMENSION(1:15), PARAMETER :: c_it_p10 = &
361	(/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/)
362	!
363	!-- Constants for the dry deposition model by Zhang et al. (2001):
364	!-- empirical constants "alpha" and "gamma" and characteristic radius "A" for
365	!-- each land use category (15) and season (5)
366	REAL(wp), DIMENSION(1:15), PARAMETER :: alpha_z01 = &
367	(/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/)
368	REAL(wp), DIMENSION(1:15), PARAMETER :: gamma_z01 = &
369	(/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/)
370	REAL(wp), DIMENSION(1:15,1:5), PARAMETER :: A_z01 = RESHAPE( (/&
371	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
372	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
373	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
374	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
375	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
376	/), (/ 15, 5 /) )
377	!-- Land use categories (based on Z01 but the same applies here also for P10):
378	!-- 1 = evergreen needleleaf trees,
379	!-- 2 = evergreen broadleaf trees,
380	!-- 3 = deciduous needleleaf trees,
381	!-- 4 = deciduous broadleaf trees,
382	!-- 5 = mixed broadleaf and needleleaf trees (deciduous broadleaf trees for P10),
383	!-- 6 = grass (short grass for P10),
384	!-- 7 = crops, mixed farming,
385	!-- 8 = desert,
386	!-- 9 = tundra,
387	!-- 10 = shrubs and interrupted woodlands (thorn shrubs for P10),
388	!-- 11 = wetland with plants (long grass for P10)
389	!-- 12 = ice cap and glacier,
390	!-- 13 = inland water (inland lake for P10)
391	!-- 14 = ocean (water for P10),
392	!-- 15 = urban
393	!
394	!-- SALSA variables:
395	CHARACTER(LEN=20) :: bc_salsa_b = 'neumann' !< bottom boundary condition
396	CHARACTER(LEN=20) :: bc_salsa_t = 'neumann' !< top boundary condition
397	CHARACTER(LEN=20) :: depo_pcm_par = 'zhang2001' !< or 'petroff2010'
398	CHARACTER(LEN=20) :: depo_pcm_type = 'deciduous_broadleaf' !< leaf type
399	CHARACTER(LEN=20) :: depo_surf_par = 'zhang2001' !< or 'petroff2010'
400	CHARACTER(LEN=100) :: input_file_dynamic = 'PIDS_DYNAMIC' !< file name for dynamic input
401	CHARACTER(LEN=100) :: input_file_salsa = 'PIDS_SALSA' !< file name for emission data
402	CHARACTER(LEN=20) :: salsa_emission_mode = 'no_emission' !< 'no_emission', 'uniform',
403	!< 'parameterized', 'read_from_file'
404
405	CHARACTER(LEN=20), DIMENSION(4) :: decycle_method_salsa = &
406	(/'dirichlet','dirichlet','dirichlet','dirichlet'/)
407	!< Decycling method at horizontal boundaries
408	!< 1=left, 2=right, 3=south, 4=north
409	!< dirichlet = initial profiles for the ghost and first 3 layers
410	!< neumann = zero gradient
411
412	CHARACTER(LEN=3), DIMENSION(maxspec) :: listspec = & !< Active aerosols
413	(/'SO4',' ',' ',' ',' ',' ',' '/)
414
415	INTEGER(iwp) :: depo_pcm_par_num = 1 !< parametrisation type: 1=zhang2001, 2=petroff2010
416	INTEGER(iwp) :: depo_pcm_type_num = 0 !< index for the dry deposition type on the plant canopy
417	INTEGER(iwp) :: depo_surf_par_num = 1 !< parametrisation type: 1=zhang2001, 2=petroff2010
418	INTEGER(iwp) :: end_subrange_1a = 1 !< last index for bin subrange 1a
419	INTEGER(iwp) :: end_subrange_2a = 1 !< last index for bin subrange 2a
420	INTEGER(iwp) :: end_subrange_2b = 1 !< last index for bin subrange 2b
421	INTEGER(iwp) :: ibc_salsa_b !< index for the bottom boundary condition
422	INTEGER(iwp) :: ibc_salsa_t !< index for the top boundary condition
423	INTEGER(iwp) :: index_bc = -1 !< index for black carbon (BC)
424	INTEGER(iwp) :: index_du = -1 !< index for dust
425	INTEGER(iwp) :: index_nh = -1 !< index for NH3
426	INTEGER(iwp) :: index_no = -1 !< index for HNO3
427	INTEGER(iwp) :: index_oc = -1 !< index for organic carbon (OC)
428	INTEGER(iwp) :: index_so4 = -1 !< index for SO4 or H2SO4
429	INTEGER(iwp) :: index_ss = -1 !< index for sea salt
430	INTEGER(iwp) :: init_aerosol_type = 0 !< Initial size distribution type
431	!< 0 = uniform (read from PARIN)
432	!< 1 = read vertical profiles from an input file
433	INTEGER(iwp) :: init_gases_type = 0 !< Initial gas concentration type
434	!< 0 = uniform (read from PARIN)
435	!< 1 = read vertical profiles from an input file
436	INTEGER(iwp) :: lod_gas_emissions = 0 !< level of detail of the gaseous emission data
437	INTEGER(iwp) :: main_street_id = 0 !< lower bound of main street IDs for parameterized emission mode
438	INTEGER(iwp) :: max_street_id = 0 !< upper bound of main street IDs for parameterized emission mode
439	INTEGER(iwp) :: nbins_aerosol = 1 !< total number of size bins
440	INTEGER(iwp) :: ncc = 1 !< number of chemical components used
441	INTEGER(iwp) :: ncomponents_mass = 1 !< total number of chemical compounds (ncc+1)
442	!< if particle water is advected)
443	INTEGER(iwp) :: nj3 = 1 !< J3 parametrization (nucleation)
444	!< 1 = condensational sink (Kerminen&Kulmala, 2002)
445	!< 2 = coagulational sink (Lehtinen et al. 2007)
446	!< 3 = coagS+self-coagulation (Anttila et al. 2010)
447	INTEGER(iwp) :: nsnucl = 0 !< Choice of the nucleation scheme:
448	!< 0 = off
449	!< 1 = binary nucleation
450	!< 2 = activation type nucleation
451	!< 3 = kinetic nucleation
452	!< 4 = ternary nucleation
453	!< 5 = nucleation with ORGANICs
454	!< 6 = activation type of nucleation with H2SO4+ORG
455	!< 7 = heteromolecular nucleation with H2SO4*ORG
456	!< 8 = homomolecular nucleation of H2SO4
457	!< + heteromolecular nucleation with H2SO4*ORG
458	!< 9 = homomolecular nucleation of H2SO4 and ORG
459	!< + heteromolecular nucleation with H2SO4*ORG
460	INTEGER(iwp) :: salsa_pr_count = 0 !< counter for salsa variable profiles
461	INTEGER(iwp) :: season_z01 = 1 !< For dry deposition by Zhang et al.: 1 = summer,
462	!< 2 = autumn (no harvest yet), 3 = late autumn
463	!< (already frost), 4 = winter, 5 = transitional spring
464	INTEGER(iwp) :: side_street_id = 0 !< lower bound of side street IDs for parameterized emission mode
465	INTEGER(iwp) :: start_subrange_1a = 1 !< start index for bin subranges: subrange 1a
466	INTEGER(iwp) :: start_subrange_2a = 1 !< subrange 2a
467	INTEGER(iwp) :: start_subrange_2b = 1 !< subrange 2b
468
469	INTEGER(iwp), DIMENSION(nreg) :: nbin = (/ 3, 7/) !< Number of size bins per subrange: 1 & 2
470
471	INTEGER(iwp), DIMENSION(ngases_salsa) :: gas_index_chem = (/ 1, 1, 1, 1, 1/) !< gas indices in chemistry_model_mod
472	!< 1 = H2SO4, 2 = HNO3,
473	!< 3 = NH3, 4 = OCNV, 5 = OCSV
474	INTEGER(iwp), DIMENSION(ngases_salsa) :: emission_index_chem !< gas indices in the gas emission file
475	INTEGER(iwp), DIMENSION(99) :: salsa_pr_index = 0 !< index for salsa profiles
476
477	INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE :: k_topo_top !< vertical index of the topography top
478
479	INTEGER(iwp), DIMENSION(:,:,:), ALLOCATABLE :: salsa_advc_flags_s !< flags used to degrade order of advection
480	!< scheme for salsa variables near walls and
481	!< lateral boundaries
482	!
483	!-- SALSA switches:
484	LOGICAL :: advect_particle_water = .TRUE. !< Advect water concentration of particles
485	LOGICAL :: decycle_salsa_lr = .FALSE. !< Undo cyclic boundaries: left and right
486	LOGICAL :: decycle_salsa_ns = .FALSE. !< Undo cyclic boundaries: north and south
487	LOGICAL :: include_emission = .FALSE. !< Include or not emissions
488	LOGICAL :: feedback_to_palm = .FALSE. !< Allow feedback due to condensation of H2O
489	LOGICAL :: nesting_salsa = .TRUE. !< Apply nesting for salsa
490	LOGICAL :: nesting_offline_salsa = .TRUE. !< Apply offline nesting for salsa
491	LOGICAL :: no_insoluble = .FALSE. !< Exclude insoluble chemical components
492	LOGICAL :: read_restart_data_salsa = .FALSE. !< Read restart data for salsa
493	LOGICAL :: salsa_gases_from_chem = .FALSE. !< Transfer the gaseous components to SALSA
494	LOGICAL :: van_der_waals_coagc = .FALSE. !< Include van der Waals and viscous forces in coagulation
495	LOGICAL :: write_binary_salsa = .FALSE. !< read binary for salsa
496	!
497	!-- Process switches: nl* is read from the NAMELIST and is NOT changed.
498	!-- ls* is the switch used and will get the value of nl*
499	!-- except for special circumstances (spinup period etc.)
500	LOGICAL :: nlcoag = .FALSE. !< Coagulation master switch
501	LOGICAL :: lscoag = .FALSE. !<
502	LOGICAL :: nlcnd = .FALSE. !< Condensation master switch
503	LOGICAL :: lscnd = .FALSE. !<
504	LOGICAL :: nlcndgas = .FALSE. !< Condensation of precursor gases
505	LOGICAL :: lscndgas = .FALSE. !<
506	LOGICAL :: nlcndh2oae = .FALSE. !< Condensation of H2O on aerosol
507	LOGICAL :: lscndh2oae = .FALSE. !< particles (FALSE -> equilibrium calc.)
508	LOGICAL :: nldepo = .FALSE. !< Deposition master switch
509	LOGICAL :: lsdepo = .FALSE. !<
510	LOGICAL :: nldepo_surf = .FALSE. !< Deposition on vegetation master switch
511	LOGICAL :: lsdepo_surf = .FALSE. !<
512	LOGICAL :: nldepo_pcm = .FALSE. !< Deposition on walls master switch
513	LOGICAL :: lsdepo_pcm = .FALSE. !<
514	LOGICAL :: nldistupdate = .TRUE. !< Size distribution update master switch
515	LOGICAL :: lsdistupdate = .FALSE. !<
516	LOGICAL :: lspartition = .FALSE. !< Partition of HNO3 and NH3
517
518	REAL(wp) :: act_coeff = 1.0E-7_wp !< Activation coefficient (1/s)
519	REAL(wp) :: dt_salsa = 0.00001_wp !< Time step of SALSA
520	REAL(wp) :: emiss_factor_main = 0.0_wp !< relative emission factor for main streets
521	REAL(wp) :: emiss_factor_side = 0.0_wp !< relative emission factor for side streets
522	REAL(wp) :: h2so4_init = nclim !< Init value for sulphuric acid gas
523	REAL(wp) :: hno3_init = nclim !< Init value for nitric acid gas
524	REAL(wp) :: last_salsa_time = 0.0_wp !< previous salsa call
525	REAL(wp) :: next_aero_emission_update = 0.0_wp !< previous emission update
526	REAL(wp) :: next_gas_emission_update = 0.0_wp !< previous emission update
527	REAL(wp) :: nf2a = 1.0_wp !< Number fraction allocated to 2a-bins
528	REAL(wp) :: nh3_init = nclim !< Init value for ammonia gas
529	REAL(wp) :: ocnv_init = nclim !< Init value for non-volatile organic gases
530	REAL(wp) :: ocsv_init = nclim !< Init value for semi-volatile organic gases
531	REAL(wp) :: rhlim = 1.20_wp !< RH limit in %/100. Prevents unrealistical RH
532	REAL(wp) :: skip_time_do_salsa = 0.0_wp !< Starting time of SALSA (s)
533	!
534	!-- Initial log-normal size distribution: mode diameter (dpg, metres),
535	!-- standard deviation (sigmag) and concentration (n_lognorm, #/m3)
536	REAL(wp), DIMENSION(nmod) :: dpg = &
537	(/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/)
538	REAL(wp), DIMENSION(nmod) :: sigmag = &
539	(/1.8_wp, 2.16_wp, 2.21_wp, 2.0_wp, 2.0_wp, 2.0_wp, 2.0_wp/)
540	REAL(wp), DIMENSION(nmod) :: n_lognorm = &
541	(/1.04e+11_wp, 3.23E+10_wp, 5.4E+6_wp, 0.0_wp, 0.0_wp, 0.0_wp, 0.0_wp/)
542	!
543	!-- Initial mass fractions / chemical composition of the size distribution
544	REAL(wp), DIMENSION(maxspec) :: mass_fracs_a = & !< mass fractions between
545	(/1.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0/) !< aerosol species for A bins
546	REAL(wp), DIMENSION(maxspec) :: mass_fracs_b = & !< mass fractions between
547	(/0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0/) !< aerosol species for B bins
548	REAL(wp), DIMENSION(nreg+1) :: reglim = & !< Min&max diameters of size subranges
549	(/ 3.0E-9_wp, 5.0E-8_wp, 1.0E-5_wp/)
550	!
551	!-- Initial log-normal size distribution: mode diameter (dpg, metres), standard deviation (sigmag)
552	!-- concentration (n_lognorm, #/m3) and mass fractions of all chemical components (listed in
553	!-- listspec) for both a (soluble) and b (insoluble) bins.
554	REAL(wp), DIMENSION(nmod) :: aerosol_flux_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) :: aerosol_flux_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(maxspec) :: aerosol_flux_mass_fracs_a = &
559	(/1.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0/)
560	REAL(wp), DIMENSION(maxspec) :: aerosol_flux_mass_fracs_b = &
561	(/0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0/)
562	REAL(wp), DIMENSION(nmod) :: surface_aerosol_flux = &
563	(/1.0E+8_wp, 1.0E+9_wp, 1.0E+5_wp, 0.0_wp, 0.0_wp, 0.0_wp, 0.0_wp/)
564
565	REAL(wp), DIMENSION(:), ALLOCATABLE :: bin_low_limits !< to deliver information about
566	!< the lower diameters per bin
567	REAL(wp), DIMENSION(:), ALLOCATABLE :: bc_am_t_val !< vertical gradient of: aerosol mass
568	REAL(wp), DIMENSION(:), ALLOCATABLE :: bc_an_t_val !< of: aerosol number
569	REAL(wp), DIMENSION(:), ALLOCATABLE :: bc_gt_t_val !< salsa gases near domain top
570	REAL(wp), DIMENSION(:), ALLOCATABLE :: gas_emission_time !< Time array in gas emission data (s)
571	REAL(wp), DIMENSION(:), ALLOCATABLE :: nsect !< Background number concentrations
572	REAL(wp), DIMENSION(:), ALLOCATABLE :: massacc !< Mass accomodation coefficients
573	!
574	!-- SALSA derived datatypes:
575	!
576	!-- Component index
577	TYPE component_index
578	CHARACTER(len=3), ALLOCATABLE :: comp(:) !< Component name
579	INTEGER(iwp) :: ncomp !< Number of components
580	INTEGER(iwp), ALLOCATABLE :: ind(:) !< Component index
581	END TYPE component_index
582	!
583	!-- For matching LSM and USM surface types and the deposition module surface types
584	TYPE match_surface
585	INTEGER(iwp), DIMENSION(:), ALLOCATABLE :: match_lupg !< index for pavement / green roofs
586	INTEGER(iwp), DIMENSION(:), ALLOCATABLE :: match_luvw !< index for vegetation / walls
587	INTEGER(iwp), DIMENSION(:), ALLOCATABLE :: match_luww !< index for water / windows
588	END TYPE match_surface
589	!
590	!-- Aerosol emission data attributes
591	TYPE salsa_emission_attribute_type
592
593	CHARACTER(LEN=25) :: units
594
595	CHARACTER(LEN=25), DIMENSION(:), ALLOCATABLE :: cat_name !<
596	CHARACTER(LEN=25), DIMENSION(:), ALLOCATABLE :: cc_name !<
597	CHARACTER(LEN=25), DIMENSION(:), ALLOCATABLE :: unit_time !<
598	CHARACTER(LEN=100), DIMENSION(:), ALLOCATABLE :: var_names !<
599
600	INTEGER(iwp) :: lod = 0 !< level of detail
601	INTEGER(iwp) :: nbins = 10 !< number of aerosol size bins
602	INTEGER(iwp) :: ncat = 0 !< number of emission categories
603	INTEGER(iwp) :: ncc = 7 !< number of aerosol chemical components
604	INTEGER(iwp) :: nhoursyear = 0 !< number of hours: HOURLY mode
605	INTEGER(iwp) :: nmonthdayhour = 0 !< number of month days and hours: MDH mode
606	INTEGER(iwp) :: num_vars !< number of variables
607	INTEGER(iwp) :: nt = 0 !< number of time steps
608	INTEGER(iwp) :: nz = 0 !< number of vertical levels
609	INTEGER(iwp) :: tind !< time index for reference time in salsa emission data
610
611	INTEGER(iwp), DIMENSION(maxspec) :: cc_in2mod = 0 !<
612
613	INTEGER(iwp), DIMENSION(:), ALLOCATABLE :: cat_index !< Index of emission categories
614	INTEGER(iwp), DIMENSION(:), ALLOCATABLE :: cc_index !< Index of chemical components
615
616	REAL(wp) :: conversion_factor !< unit conversion factor for aerosol emissions
617
618	REAL(wp), DIMENSION(:), ALLOCATABLE :: dmid !< mean diameters of size bins (m)
619	REAL(wp), DIMENSION(:), ALLOCATABLE :: rho !< average density (kg/m3)
620	REAL(wp), DIMENSION(:), ALLOCATABLE :: time !< time (s)
621	REAL(wp), DIMENSION(:), ALLOCATABLE :: time_factor !< emission time factor
622	REAL(wp), DIMENSION(:), ALLOCATABLE :: z !< height (m)
623
624	REAL(wp), DIMENSION(:,:), ALLOCATABLE :: etf !< emission time factor
625	REAL(wp), DIMENSION(:,:), ALLOCATABLE :: stack_height
626
627	END TYPE salsa_emission_attribute_type
628	!
629	!-- The default size distribution and mass composition per emission category:
630	!-- 1 = traffic, 2 = road dust, 3 = wood combustion, 4 = other
631	!-- Mass fractions: H2SO4, OC, BC, DU, SS, HNO3, NH3
632	TYPE salsa_emission_mode_type
633
634	INTEGER(iwp) :: ndm = 3 !< number of default modes
635	INTEGER(iwp) :: ndc = 4 !< number of default categories
636
637	CHARACTER(LEN=25), DIMENSION(1:4) :: cat_name_table = (/'traffic exhaust', &
638	'road dust ', &
639	'wood combustion', &
640	'other '/)
641
642	INTEGER(iwp), DIMENSION(1:4) :: cat_input_to_model !<
643
644	REAL(wp), DIMENSION(1:3) :: dpg_table = (/ 13.5E-9_wp, 1.4E-6_wp, 5.4E-8_wp/) !<
645	REAL(wp), DIMENSION(1:3) :: ntot_table !<
646	REAL(wp), DIMENSION(1:3) :: sigmag_table = (/ 1.6_wp, 1.4_wp, 1.7_wp /) !<
647
648	REAL(wp), DIMENSION(1:maxspec,1:4) :: mass_frac_table = & !<
649	RESHAPE( (/ 0.04_wp, 0.48_wp, 0.48_wp, 0.0_wp, 0.0_wp, 0.0_wp, 0.0_wp, &
650	0.0_wp, 0.05_wp, 0.0_wp, 0.95_wp, 0.0_wp, 0.0_wp, 0.0_wp, &
651	0.0_wp, 0.5_wp, 0.5_wp, 0.0_wp, 0.0_wp, 0.0_wp, 0.0_wp, &
652	0.0_wp, 0.5_wp, 0.5_wp, 0.0_wp, 0.0_wp, 0.0_wp, 0.0_wp &
653	/), (/maxspec,4/) )
654
655	REAL(wp), DIMENSION(1:3,1:4) :: pm_frac_table = & !< rel. mass
656	RESHAPE( (/ 0.016_wp, 0.000_wp, 0.984_wp, &
657	0.000_wp, 1.000_wp, 0.000_wp, &
658	0.000_wp, 0.000_wp, 1.000_wp, &
659	1.000_wp, 0.000_wp, 1.000_wp &
660	/), (/3,4/) )
661
662	END TYPE salsa_emission_mode_type
663	!
664	!-- Aerosol emission data values
665	TYPE salsa_emission_value_type
666
667	REAL(wp) :: fill !< fill value
668
669	REAL(wp), DIMENSION(:,:), ALLOCATABLE :: mass_fracs !< mass fractions per emis. category
670	REAL(wp), DIMENSION(:,:), ALLOCATABLE :: num_fracs !< number fractions per emis. category
671
672	REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: def_data !< surface emission in PM
673	REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: preproc_data !< surface emission per category
674
675	END TYPE salsa_emission_value_type
676	!
677	!-- Offline nesting data type
678	TYPE salsa_nest_offl_type
679
680	CHARACTER(LEN=16) :: char_l = 'ls_forcing_left_' !< leading substring at left boundary
681	CHARACTER(LEN=17) :: char_n = 'ls_forcing_north_' !< leading substring at north boundary
682	CHARACTER(LEN=17) :: char_r = 'ls_forcing_right_' !< leading substring at right boundary
683	CHARACTER(LEN=17) :: char_s = 'ls_forcing_south_' !< leading substring at south boundary
684	CHARACTER(LEN=15) :: char_t = 'ls_forcing_top_' !< leading substring at top boundary
685
686	CHARACTER(LEN=5), DIMENSION(1:ngases_salsa) :: gas_name = (/'H2SO4','HNO3 ','NH3 ','OCNV ','OCSV '/)
687
688	CHARACTER(LEN=25), DIMENSION(:), ALLOCATABLE :: cc_name !< chemical component name
689	CHARACTER(LEN=100), DIMENSION(:), ALLOCATABLE :: var_names !< list of variable names
690
691	INTEGER(iwp) :: id_dynamic !< NetCDF id of dynamic input file
692	INTEGER(iwp) :: ncc !< number of aerosol chemical components
693	INTEGER(iwp) :: nt !< number of time levels in dynamic input file
694	INTEGER(iwp) :: nzu !< number of vertical levels on scalar grid in dynamic input file
695	INTEGER(iwp) :: tind !< time index for reference time in mesoscale-offline nesting
696	INTEGER(iwp) :: tind_p !< time index for following time in mesoscale-offline nesting
697
698	INTEGER(iwp), DIMENSION(maxspec) :: cc_in2mod = 0 !< to transfer chemical composition from input to model
699
700	LOGICAL :: init = .FALSE. !< flag indicating the initialisation of offline nesting
701
702	REAL(wp), DIMENSION(:), ALLOCATABLE :: dmid !< vertical profile of aerosol bin diameters
703	REAL(wp), DIMENSION(:), ALLOCATABLE :: time !< time in dynamic input file
704	REAL(wp), DIMENSION(:), ALLOCATABLE :: zu_atmos !< zu in dynamic input file
705
706	REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE :: gconc_left !< gas conc. at left boundary
707	REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE :: gconc_north !< gas conc. at north boundary
708	REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE :: gconc_right !< gas conc. at right boundary
709	REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE :: gconc_south !< gas conc. at south boundary
710	REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE :: gconc_top !< gas conc.at top boundary
711	REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE :: mconc_left !< aerosol mass conc. at left boundary
712	REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE :: mconc_north !< aerosol mass conc. at north boundary
713	REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE :: mconc_right !< aerosol mass conc. at right boundary
714	REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE :: mconc_south !< aerosol mass conc. at south boundary
715	REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE :: mconc_top !< aerosol mass conc. at top boundary
716	REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE :: nconc_left !< aerosol number conc. at left boundary
717	REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE :: nconc_north !< aerosol number conc. at north boundary
718	REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE :: nconc_right !< aerosol number conc. at right boundary
719	REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE :: nconc_south !< aerosol number conc. at south boundary
720	REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE :: nconc_top !< aerosol number conc. at top boundary
721
722	END TYPE salsa_nest_offl_type
723	!
724	!-- Prognostic variable: Aerosol size bin information (number (#/m3) and mass (kg/m3) concentration)
725	!-- and the concentration of gaseous tracers (#/m3). Gas tracers are contained sequentially in
726	!-- dimension 4 as:
727	!-- 1. H2SO4, 2. HNO3, 3. NH3, 4. OCNV (non-volatile organics), 5. OCSV (semi-volatile)
728	TYPE salsa_variable
729
730	REAL(wp), DIMENSION(:), ALLOCATABLE :: init !<
731
732	REAL(wp), DIMENSION(:,:), ALLOCATABLE :: diss_s !<
733	REAL(wp), DIMENSION(:,:), ALLOCATABLE :: flux_s !<
734	REAL(wp), DIMENSION(:,:), ALLOCATABLE :: source !<
735	REAL(wp), DIMENSION(:,:), ALLOCATABLE :: sums_ws_l !<
736
737	REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: diss_l !<
738	REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: flux_l !<
739
740	REAL(wp), DIMENSION(:,:,:), POINTER, CONTIGUOUS :: conc !<
741	REAL(wp), DIMENSION(:,:,:), POINTER, CONTIGUOUS :: conc_p !<
742	REAL(wp), DIMENSION(:,:,:), POINTER, CONTIGUOUS :: tconc_m !<
743
744	END TYPE salsa_variable
745	!
746	!-- Datatype used to store information about the binned size distributions of aerosols
747	TYPE t_section
748
749	REAL(wp) :: dmid !< bin middle diameter (m)
750	REAL(wp) :: vhilim !< bin volume at the high limit
751	REAL(wp) :: vlolim !< bin volume at the low limit
752	REAL(wp) :: vratiohi !< volume ratio between the center and high limit
753	REAL(wp) :: vratiolo !< volume ratio between the center and low limit
754	!******************************************************
755	! ^ Do NOT change the stuff above after initialization !
756	!******************************************************
757	REAL(wp) :: core !< Volume of dry particle
758	REAL(wp) :: dwet !< Wet diameter or mean droplet diameter (m)
759	REAL(wp) :: numc !< Number concentration of particles/droplets (#/m3)
760	REAL(wp) :: veqh2o !< Equilibrium H2O concentration for each particle
761
762	REAL(wp), DIMENSION(maxspec+1) :: volc !< Volume concentrations (m^3/m^3) of aerosols +
763	!< water. Since most of the stuff in SALSA is hard
764	!< coded, these have to be in the order
765	!< 1:SO4, 2:OC, 3:BC, 4:DU, 5:SS, 6:NO, 7:NH, 8:H2O
766	END TYPE t_section
767
768	TYPE(salsa_emission_attribute_type) :: aero_emission_att !< emission attributes
769	TYPE(salsa_emission_value_type) :: aero_emission !< emission values
770	TYPE(salsa_emission_mode_type) :: def_modes !< default emission modes
771
772	TYPE(chem_emis_att_type) :: chem_emission_att !< chemistry emission attributes
773
774	TYPE(chem_emis_val_type), DIMENSION(:), ALLOCATABLE :: chem_emission !< chemistry emissions
775
776	TYPE(t_section), DIMENSION(:), ALLOCATABLE :: aero !< local aerosol properties
777
778	TYPE(match_surface) :: lsm_to_depo_h !< to match the deposition module and horizontal LSM surfaces
779	TYPE(match_surface) :: usm_to_depo_h !< to match the deposition module and horizontal USM surfaces
780
781	TYPE(match_surface), DIMENSION(0:3) :: lsm_to_depo_v !< to match the deposition mod. and vertical LSM surfaces
782	TYPE(match_surface), DIMENSION(0:3) :: usm_to_depo_v !< to match the deposition mod. and vertical USM surfaces
783	!
784	!-- SALSA variables: as x = x(k,j,i,bin).
785	!-- The 4th dimension contains all the size bins sequentially for each aerosol species + water.
786	!
787	!-- Prognostic variables:
788	!
789	!-- Number concentration (#/m3)
790	TYPE(salsa_variable), DIMENSION(:), ALLOCATABLE, TARGET :: aerosol_number !<
791	REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE, TARGET :: nconc_1 !<
792	REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE, TARGET :: nconc_2 !<
793	REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE, TARGET :: nconc_3 !<
794	!
795	!-- Mass concentration (kg/m3)
796	TYPE(salsa_variable), DIMENSION(:), ALLOCATABLE, TARGET :: aerosol_mass !<
797	REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE, TARGET :: mconc_1 !<
798	REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE, TARGET :: mconc_2 !<
799	REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE, TARGET :: mconc_3 !<
800	!
801	!-- Gaseous concentrations (#/m3)
802	TYPE(salsa_variable), DIMENSION(:), ALLOCATABLE, TARGET :: salsa_gas !<
803	REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE, TARGET :: gconc_1 !<
804	REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE, TARGET :: gconc_2 !<
805	REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE, TARGET :: gconc_3 !<
806	!
807	!-- Diagnostic tracers
808	REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE :: sedim_vd !< sedimentation velocity per bin (m/s)
809	REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE :: ra_dry !< aerosol dry radius (m)
810
811	!-- Particle component index tables
812	TYPE(component_index) :: prtcl !< Contains "getIndex" which gives the index for a given aerosol
813	!< component name: 1:SO4, 2:OC, 3:BC, 4:DU, 5:SS, 6:NO, 7:NH, 8:H2O
814	!
815	!-- Offline nesting:
816	TYPE(salsa_nest_offl_type) :: salsa_nest_offl !< data structure for offline nesting
817	!
818	!-- Data output arrays:
819	!
820	!-- Gases:
821	REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET :: g_h2so4_av !< H2SO4
822	REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET :: g_hno3_av !< HNO3
823	REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET :: g_nh3_av !< NH3
824	REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET :: g_ocnv_av !< non-volatile OC
825	REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET :: g_ocsv_av !< semi-volatile OC
826	!
827	!-- Integrated:
828	REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET :: ldsa_av !< lung-deposited surface area
829	REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET :: ntot_av !< total number concentration
830	REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET :: nufp_av !< ultrafine particles (UFP)
831	REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET :: pm01_av !< PM0.1
832	REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET :: pm25_av !< PM2.5
833	REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET :: pm10_av !< PM10
834	!
835	!-- In the particle phase:
836	REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET :: s_bc_av !< black carbon
837	REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET :: s_du_av !< dust
838	REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET :: s_h2o_av !< liquid water
839	REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET :: s_nh_av !< ammonia
840	REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET :: s_no_av !< nitrates
841	REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET :: s_oc_av !< org. carbon
842	REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET :: s_so4_av !< sulphates
843	REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET :: s_ss_av !< sea salt
844	!
845	!-- Bin specific mass and number concentrations:
846	REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE, TARGET :: mbins_av !< bin mas
847	REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE, TARGET :: nbins_av !< bin number
848
849	!
850	!-- PALM interfaces:
851
852	INTERFACE salsa_actions
853	MODULE PROCEDURE salsa_actions
854	MODULE PROCEDURE salsa_actions_ij
855	END INTERFACE salsa_actions
856
857	INTERFACE salsa_3d_data_averaging
858	MODULE PROCEDURE salsa_3d_data_averaging
859	END INTERFACE salsa_3d_data_averaging
860
861	INTERFACE salsa_boundary_conds
862	MODULE PROCEDURE salsa_boundary_conds
863	MODULE PROCEDURE salsa_boundary_conds_decycle
864	END INTERFACE salsa_boundary_conds
865
866	INTERFACE salsa_boundary_conditions
867	MODULE PROCEDURE salsa_boundary_conditions
868	END INTERFACE salsa_boundary_conditions
869
870	INTERFACE salsa_check_data_output
871	MODULE PROCEDURE salsa_check_data_output
872	END INTERFACE salsa_check_data_output
873
874	INTERFACE salsa_check_data_output_pr
875	MODULE PROCEDURE salsa_check_data_output_pr
876	END INTERFACE salsa_check_data_output_pr
877
878	INTERFACE salsa_check_parameters
879	MODULE PROCEDURE salsa_check_parameters
880	END INTERFACE salsa_check_parameters
881
882	INTERFACE salsa_data_output_2d
883	MODULE PROCEDURE salsa_data_output_2d
884	END INTERFACE salsa_data_output_2d
885
886	INTERFACE salsa_data_output_3d
887	MODULE PROCEDURE salsa_data_output_3d
888	END INTERFACE salsa_data_output_3d
889
890	INTERFACE salsa_data_output_mask
891	MODULE PROCEDURE salsa_data_output_mask
892	END INTERFACE salsa_data_output_mask
893
894	INTERFACE salsa_define_netcdf_grid
895	MODULE PROCEDURE salsa_define_netcdf_grid
896	END INTERFACE salsa_define_netcdf_grid
897
898	INTERFACE salsa_emission_update
899	MODULE PROCEDURE salsa_emission_update
900	END INTERFACE salsa_emission_update
901
902	INTERFACE salsa_exchange_horiz_bounds
903	MODULE PROCEDURE salsa_exchange_horiz_bounds
904	END INTERFACE salsa_exchange_horiz_bounds
905
906	INTERFACE salsa_header
907	MODULE PROCEDURE salsa_header
908	END INTERFACE salsa_header
909
910	INTERFACE salsa_init
911	MODULE PROCEDURE salsa_init
912	END INTERFACE salsa_init
913
914	INTERFACE salsa_init_arrays
915	MODULE PROCEDURE salsa_init_arrays
916	END INTERFACE salsa_init_arrays
917
918	INTERFACE salsa_nesting_offl_bc
919	MODULE PROCEDURE salsa_nesting_offl_bc
920	END INTERFACE salsa_nesting_offl_bc
921
922	INTERFACE salsa_nesting_offl_init
923	MODULE PROCEDURE salsa_nesting_offl_init
924	END INTERFACE salsa_nesting_offl_init
925
926	INTERFACE salsa_nesting_offl_input
927	MODULE PROCEDURE salsa_nesting_offl_input
928	END INTERFACE salsa_nesting_offl_input
929
930	INTERFACE salsa_non_advective_processes
931	MODULE PROCEDURE salsa_non_advective_processes
932	MODULE PROCEDURE salsa_non_advective_processes_ij
933	END INTERFACE salsa_non_advective_processes
934
935	INTERFACE salsa_parin
936	MODULE PROCEDURE salsa_parin
937	END INTERFACE salsa_parin
938
939	INTERFACE salsa_prognostic_equations
940	MODULE PROCEDURE salsa_prognostic_equations
941	MODULE PROCEDURE salsa_prognostic_equations_ij
942	END INTERFACE salsa_prognostic_equations
943
944	INTERFACE salsa_rrd_local
945	MODULE PROCEDURE salsa_rrd_local
946	END INTERFACE salsa_rrd_local
947
948	INTERFACE salsa_statistics
949	MODULE PROCEDURE salsa_statistics
950	END INTERFACE salsa_statistics
951
952	INTERFACE salsa_swap_timelevel
953	MODULE PROCEDURE salsa_swap_timelevel
954	END INTERFACE salsa_swap_timelevel
955
956	INTERFACE salsa_tendency
957	MODULE PROCEDURE salsa_tendency
958	MODULE PROCEDURE salsa_tendency_ij
959	END INTERFACE salsa_tendency
960
961	INTERFACE salsa_wrd_local
962	MODULE PROCEDURE salsa_wrd_local
963	END INTERFACE salsa_wrd_local
964
965
966	SAVE
967
968	PRIVATE
969	!
970	!-- Public functions:
971	PUBLIC salsa_3d_data_averaging, &
972	salsa_actions, &
973	salsa_boundary_conds, &
974	salsa_boundary_conditions, &
975	salsa_check_data_output, &
976	salsa_check_data_output_pr, &
977	salsa_check_parameters, &
978	salsa_data_output_2d, &
979	salsa_data_output_3d, &
980	salsa_data_output_mask, &
981	salsa_define_netcdf_grid, &
982	salsa_diagnostics, &
983	salsa_emission_update, &
984	salsa_exchange_horiz_bounds, &
985	salsa_header, &
986	salsa_init, &
987	salsa_init_arrays, &
988	salsa_nesting_offl_bc, &
989	salsa_nesting_offl_init, &
990	salsa_nesting_offl_input, &
991	salsa_non_advective_processes, &
992	salsa_parin, &
993	salsa_prognostic_equations, &
994	salsa_rrd_local, &
995	salsa_statistics, &
996	salsa_swap_timelevel, &
997	salsa_wrd_local
998
999	!
1000	!-- Public parameters, constants and initial values
1001	PUBLIC bc_am_t_val, &
1002	bc_an_t_val, &
1003	bc_gt_t_val, &
1004	ibc_salsa_b, &
1005	init_aerosol_type, &
1006	init_gases_type, &
1007	nesting_salsa, &
1008	nesting_offline_salsa, &
1009	salsa_gases_from_chem, &
1010	skip_time_do_salsa
1011	!
1012	!-- Public variables
1013	PUBLIC aerosol_mass, &
1014	aerosol_number, &
1015	gconc_2, &
1016	mconc_2, &
1017	nbins_aerosol, &
1018	ncomponents_mass, &
1019	nconc_2, &
1020	ngases_salsa, &
1021	salsa_gas, &
1022	salsa_nest_offl
1023
1024
1025	CONTAINS
1026
1027	!------------------------------------------------------------------------------!
1028	! Description:
1029	! ------------
1030	!> Parin for &salsa_par for new modules
1031	!------------------------------------------------------------------------------!
1032	SUBROUTINE salsa_parin
1033
1034	USE control_parameters, &
1035	ONLY: data_output_pr
1036
1037	IMPLICIT NONE
1038
1039	CHARACTER(LEN=80) :: line !< dummy string that contains the current line of parameter file
1040
1041	INTEGER(iwp) :: i !< loop index
1042	INTEGER(iwp) :: max_pr_salsa_tmp !< dummy variable
1043
1044	NAMELIST /salsa_parameters/ aerosol_flux_dpg, &
1045	aerosol_flux_mass_fracs_a, &
1046	aerosol_flux_mass_fracs_b, &
1047	aerosol_flux_sigmag, &
1048	advect_particle_water, &
1049	bc_salsa_b, &
1050	bc_salsa_t, &
1051	decycle_salsa_lr, &
1052	decycle_method_salsa, &
1053	decycle_salsa_ns, &
1054	depo_pcm_par, &
1055	depo_pcm_type, &
1056	depo_surf_par, &
1057	dpg, &
1058	dt_salsa, &
1059	emiss_factor_main, &
1060	emiss_factor_side, &
1061	feedback_to_palm, &
1062	h2so4_init, &
1063	hno3_init, &
1064	listspec, &
1065	main_street_id, &
1066	mass_fracs_a, &
1067	mass_fracs_b, &
1068	max_street_id, &
1069	n_lognorm, &
1070	nbin, &
1071	nesting_salsa, &
1072	nesting_offline_salsa, &
1073	nf2a, &
1074	nh3_init, &
1075	nj3, &
1076	nlcnd, &
1077	nlcndgas, &
1078	nlcndh2oae, &
1079	nlcoag, &
1080	nldepo, &
1081	nldepo_pcm, &
1082	nldepo_surf, &
1083	nldistupdate, &
1084	nsnucl, &
1085	ocnv_init, &
1086	ocsv_init, &
1087	read_restart_data_salsa, &
1088	reglim, &
1089	salsa, &
1090	salsa_emission_mode, &
1091	season_z01, &
1092	sigmag, &
1093	side_street_id, &
1094	skip_time_do_salsa, &
1095	surface_aerosol_flux, &
1096	van_der_waals_coagc, &
1097	write_binary_salsa
1098
1099	line = ' '
1100	!
1101	!-- Try to find salsa package
1102	REWIND ( 11 )
1103	line = ' '
1104	DO WHILE ( INDEX( line, '&salsa_parameters' ) == 0 )
1105	READ ( 11, '(A)', END=10 ) line
1106	ENDDO
1107	BACKSPACE ( 11 )
1108	!
1109	!-- Read user-defined namelist
1110	READ ( 11, salsa_parameters )
1111	!
1112	!-- Enable salsa (salsa switch in modules.f90)
1113	salsa = .TRUE.
1114
1115	10 CONTINUE
1116	!
1117	!-- Update the number of output profiles
1118	max_pr_salsa_tmp = 0
1119	i = 1
1120	DO WHILE ( data_output_pr(i) /= ' ' .AND. i <= 100 )
1121	IF ( TRIM( data_output_pr(i)(1:6) ) == 'salsa_' ) max_pr_salsa_tmp = max_pr_salsa_tmp + 1
1122	i = i + 1
1123	ENDDO
1124	IF ( max_pr_salsa_tmp > 0 ) max_pr_salsa = max_pr_salsa_tmp
1125
1126	END SUBROUTINE salsa_parin
1127
1128	!------------------------------------------------------------------------------!
1129	! Description:
1130	! ------------
1131	!> Check parameters routine for salsa.
1132	!------------------------------------------------------------------------------!
1133	SUBROUTINE salsa_check_parameters
1134
1135	USE control_parameters, &
1136	ONLY: child_domain, humidity, initializing_actions, nesting_offline
1137
1138	IMPLICIT NONE
1139
1140	!
1141	!-- Check that humidity is switched on
1142	IF ( salsa .AND. .NOT. humidity ) THEN
1143	WRITE( message_string, * ) 'salsa = ', salsa, ' is not allowed with humidity = ', humidity
1144	CALL message( 'salsa_check_parameters', 'PA0594', 1, 2, 0, 6, 0 )
1145	ENDIF
1146	!
1147	!-- For nested runs, explicitly set nesting boundary conditions.
1148	IF ( child_domain ) THEN
1149	IF ( nesting_salsa ) THEN
1150	bc_salsa_t = 'nested'
1151	ELSE
1152	bc_salsa_t = 'neumann'
1153	ENDIF
1154	ENDIF
1155	!
1156	!-- Set boundary conditions also in case the model is offline-nested in larger-scale models.
1157	IF ( nesting_offline ) THEN
1158	IF ( nesting_offline_salsa ) THEN
1159	bc_salsa_t = 'nesting_offline'
1160	ELSE
1161	bc_salsa_t = 'neumann'
1162	ENDIF
1163	ENDIF
1164	!
1165	!-- Set bottom boundary condition flag
1166	IF ( bc_salsa_b == 'dirichlet' ) THEN
1167	ibc_salsa_b = 0
1168	ELSEIF ( bc_salsa_b == 'neumann' ) THEN
1169	ibc_salsa_b = 1
1170	ELSE
1171	message_string = 'unknown boundary condition: bc_salsa_b = "' // TRIM( bc_salsa_t ) // '"'
1172	CALL message( 'salsa_check_parameters', 'PA0595', 1, 2, 0, 6, 0 )
1173	ENDIF
1174	!
1175	!-- Set top boundary conditions flag
1176	IF ( bc_salsa_t == 'dirichlet' ) THEN
1177	ibc_salsa_t = 0
1178	ELSEIF ( bc_salsa_t == 'neumann' ) THEN
1179	ibc_salsa_t = 1
1180	ELSEIF ( bc_salsa_t == 'initial_gradient' ) THEN
1181	ibc_salsa_t = 2
1182	ELSEIF ( bc_salsa_t == 'nested' .OR. bc_salsa_t == 'nesting_offline' ) THEN
1183	ibc_salsa_t = 3
1184	ELSE
1185	message_string = 'unknown boundary condition: bc_salsa_t = "' // TRIM( bc_salsa_t ) // '"'
1186	CALL message( 'salsa_check_parameters', 'PA0596', 1, 2, 0, 6, 0 )
1187	ENDIF
1188	!
1189	!-- Check J3 parametrisation
1190	IF ( nj3 < 1 .OR. nj3 > 3 ) THEN
1191	message_string = 'unknown nj3 (must be 1-3)'
1192	CALL message( 'salsa_check_parameters', 'PA0597', 1, 2, 0, 6, 0 )
1193	ENDIF
1194	!
1195	!-- Check bottom boundary condition in case of surface emissions
1196	IF ( salsa_emission_mode /= 'no_emission' .AND. ibc_salsa_b == 0 ) THEN
1197	message_string = 'salsa_emission_mode /= "no_emission" requires bc_salsa_b = "Neumann"'
1198	CALL message( 'salsa_check_parameters','PA0598', 1, 2, 0, 6, 0 )
1199	ENDIF
1200	!
1201	!-- Check whether emissions are applied
1202	IF ( salsa_emission_mode /= 'no_emission' ) include_emission = .TRUE.
1203	!
1204	!-- Set the initialisation type: background concentration are read from PIDS_DYNAMIC if
1205	!-- initializing_actions = 'inifor set_constant_profiles'
1206	IF ( INDEX( initializing_actions, 'inifor' ) /= 0 ) THEN
1207	init_aerosol_type = 1
1208	init_gases_type = 1
1209	ENDIF
1210
1211
1212	END SUBROUTINE salsa_check_parameters
1213
1214	!------------------------------------------------------------------------------!
1215	!
1216	! Description:
1217	! ------------
1218	!> Subroutine defining appropriate grid for netcdf variables.
1219	!> It is called out from subroutine netcdf.
1220	!> Same grid as for other scalars (see netcdf_interface_mod.f90)
1221	!------------------------------------------------------------------------------!
1222	SUBROUTINE salsa_define_netcdf_grid( var, found, grid_x, grid_y, grid_z )
1223
1224	IMPLICIT NONE
1225
1226	CHARACTER(LEN=*), INTENT(OUT) :: grid_x !<
1227	CHARACTER(LEN=*), INTENT(OUT) :: grid_y !<
1228	CHARACTER(LEN=*), INTENT(OUT) :: grid_z !<
1229	CHARACTER(LEN=*), INTENT(IN) :: var !<
1230
1231	LOGICAL, INTENT(OUT) :: found !<
1232
1233	found = .TRUE.
1234	!
1235	!-- Check for the grid
1236
1237	IF ( var(1:6) == 'salsa_' ) THEN ! same grid for all salsa output variables
1238	grid_x = 'x'
1239	grid_y = 'y'
1240	grid_z = 'zu'
1241	ELSE
1242	found = .FALSE.
1243	grid_x = 'none'
1244	grid_y = 'none'
1245	grid_z = 'none'
1246	ENDIF
1247
1248	END SUBROUTINE salsa_define_netcdf_grid
1249
1250	!------------------------------------------------------------------------------!
1251	! Description:
1252	! ------------
1253	!> Header output for new module
1254	!------------------------------------------------------------------------------!
1255	SUBROUTINE salsa_header( io )
1256
1257	USE indices, &
1258	ONLY: nx, ny, nz
1259
1260	IMPLICIT NONE
1261
1262	INTEGER(iwp), INTENT(IN) :: io !< Unit of the output file
1263	!
1264	!-- Write SALSA header
1265	WRITE( io, 1 )
1266	WRITE( io, 2 ) skip_time_do_salsa
1267	WRITE( io, 3 ) dt_salsa
1268	WRITE( io, 4 ) nz, ny, nx, nbins_aerosol
1269	IF ( advect_particle_water ) THEN
1270	WRITE( io, 5 ) nz, ny, nx, ncomponents_mass*nbins_aerosol, advect_particle_water
1271	ELSE
1272	WRITE( io, 5 ) nz, ny, nx, ncc*nbins_aerosol, advect_particle_water
1273	ENDIF
1274	IF ( .NOT. salsa_gases_from_chem ) THEN
1275	WRITE( io, 6 ) nz, ny, nx, ngases_salsa, salsa_gases_from_chem
1276	ENDIF
1277	WRITE( io, 7 )
1278	IF ( nsnucl > 0 ) WRITE( io, 8 ) nsnucl, nj3
1279	IF ( nlcoag ) WRITE( io, 9 )
1280	IF ( nlcnd ) WRITE( io, 10 ) nlcndgas, nlcndh2oae
1281	IF ( lspartition ) WRITE( io, 11 )
1282	IF ( nldepo ) WRITE( io, 12 ) nldepo_pcm, nldepo_surf
1283	WRITE( io, 13 ) reglim, nbin, bin_low_limits
1284	IF ( init_aerosol_type == 0 ) WRITE( io, 14 ) nsect
1285	WRITE( io, 15 ) ncc, listspec, mass_fracs_a, mass_fracs_b
1286	IF ( .NOT. salsa_gases_from_chem ) THEN
1287	WRITE( io, 16 ) ngases_salsa, h2so4_init, hno3_init, nh3_init, ocnv_init, ocsv_init
1288	ENDIF
1289	WRITE( io, 17 ) init_aerosol_type, init_gases_type
1290	IF ( init_aerosol_type == 0 ) THEN
1291	WRITE( io, 18 ) dpg, sigmag, n_lognorm
1292	ELSE
1293	WRITE( io, 19 )
1294	ENDIF
1295	IF ( nesting_salsa ) WRITE( io, 20 ) nesting_salsa
1296	IF ( nesting_offline_salsa ) WRITE( io, 21 ) nesting_offline_salsa
1297	WRITE( io, 22 ) salsa_emission_mode
1298	IF ( salsa_emission_mode == 'uniform' ) THEN
1299	WRITE( io, 23 ) surface_aerosol_flux, aerosol_flux_dpg, aerosol_flux_sigmag, &
1300	aerosol_flux_mass_fracs_a
1301	ENDIF
1302	IF ( SUM( aerosol_flux_mass_fracs_b ) > 0.0_wp .OR. salsa_emission_mode == 'read_from_file' ) &
1303	THEN
1304	WRITE( io, 24 )
1305	ENDIF
1306
1307	1 FORMAT (//' SALSA information:'/ &
1308	' ------------------------------'/)
1309	2 FORMAT (' Starts at: skip_time_do_salsa = ', F10.2, ' s')
1310	3 FORMAT (/' Timestep: dt_salsa = ', F6.2, ' s')
1311	4 FORMAT (/' Array shape (z,y,x,bins):'/ &
1312	' aerosol_number: ', 4(I3))
1313	5 FORMAT (/' aerosol_mass: ', 4(I3),/ &
1314	' (advect_particle_water = ', L1, ')')
1315	6 FORMAT (' salsa_gas: ', 4(I3),/ &
1316	' (salsa_gases_from_chem = ', L1, ')')
1317	7 FORMAT (/' Aerosol dynamic processes included: ')
1318	8 FORMAT (/' nucleation (scheme = ', I1, ' and J3 parametrization = ', I1, ')')
1319	9 FORMAT (/' coagulation')
1320	10 FORMAT (/' condensation (of precursor gases = ', L1, ' and water vapour = ', L1, ')' )
1321	11 FORMAT (/' dissolutional growth by HNO3 and NH3')
1322	12 FORMAT (/' dry deposition (on vegetation = ', L1, ' and on topography = ', L1, ')')
1323	13 FORMAT (/' Aerosol bin subrange limits (in metres): ', 3(ES10.2E3), / &
1324	' Number of size bins for each aerosol subrange: ', 2I3,/ &
1325	' Aerosol bin limits (in metres): ', 9(ES10.2E3))
1326	14 FORMAT (' Initial number concentration in bins at the lowest level (#/m**3):', 9(ES10.2E3))
1327	15 FORMAT (/' Number of chemical components used: ', I1,/ &
1328	' Species: ',7(A6),/ &
1329	' Initial relative contribution of each species to particle volume in:',/ &
1330	' a-bins: ', 7(F6.3),/ &
1331	' b-bins: ', 7(F6.3))
1332	16 FORMAT (/' Number of gaseous tracers used: ', I1,/ &
1333	' Initial gas concentrations:',/ &
1334	' H2SO4: ',ES12.4E3, ' #/m**3',/ &
1335	' HNO3: ',ES12.4E3, ' #/m**3',/ &
1336	' NH3: ',ES12.4E3, ' #/m**3',/ &
1337	' OCNV: ',ES12.4E3, ' #/m**3',/ &
1338	' OCSV: ',ES12.4E3, ' #/m**3')
1339	17 FORMAT (/' Initialising concentrations: ', / &
1340	' Aerosol size distribution: init_aerosol_type = ', I1,/ &
1341	' Gas concentrations: init_gases_type = ', I1 )
1342	18 FORMAT ( ' Mode diametres: dpg(nmod) = ', 7(F7.3), ' (m)', / &
1343	' Standard deviation: sigmag(nmod) = ', 7(F7.2),/ &
1344	' Number concentration: n_lognorm(nmod) = ', 7(ES12.4E3), ' (#/m3)' )
1345	19 FORMAT (/' Size distribution read from a file.')
1346	20 FORMAT (/' Nesting for salsa variables: ', L1 )
1347	21 FORMAT (/' Offline nesting for salsa variables: ', L1 )
1348	22 FORMAT (/' Emissions: salsa_emission_mode = ', A )
1349	23 FORMAT (/' surface_aerosol_flux = ', ES12.4E3, ' #/m**2/s', / &
1350	' aerosol_flux_dpg = ', 7(F7.3), ' (m)', / &
1351	' aerosol_flux_sigmag = ', 7(F7.2), / &
1352	' aerosol_mass_fracs_a = ', 7(ES12.4E3) )
1353	24 FORMAT (/' (currently all emissions are soluble!)')
1354
1355	END SUBROUTINE salsa_header
1356
1357	!------------------------------------------------------------------------------!
1358	! Description:
1359	! ------------
1360	!> Allocate SALSA arrays and define pointers if required
1361	!------------------------------------------------------------------------------!
1362	SUBROUTINE salsa_init_arrays
1363
1364	USE advec_ws, &
1365	ONLY: ws_init_flags_scalar
1366
1367	USE surface_mod, &
1368	ONLY: surf_def_h, surf_def_v, surf_lsm_h, surf_lsm_v, surf_usm_h, surf_usm_v
1369
1370	IMPLICIT NONE
1371
1372	INTEGER(iwp) :: gases_available !< Number of available gas components in the chemistry model
1373	INTEGER(iwp) :: i !< loop index for allocating
1374	INTEGER(iwp) :: ii !< index for indexing chemical components
1375	INTEGER(iwp) :: l !< loop index for allocating: surfaces
1376	INTEGER(iwp) :: lsp !< loop index for chem species in the chemistry model
1377
1378	gases_available = 0
1379	!
1380	!-- Allocate prognostic variables (see salsa_swap_timelevel)
1381	!
1382	!-- Set derived indices:
1383	!-- (This does the same as the subroutine salsa_initialize in SALSA/UCLALES-SALSA)
1384	start_subrange_1a = 1 ! 1st index of subrange 1a
1385	start_subrange_2a = start_subrange_1a + nbin(1) ! 1st index of subrange 2a
1386	end_subrange_1a = start_subrange_2a - 1 ! last index of subrange 1a
1387	end_subrange_2a = end_subrange_1a + nbin(2) ! last index of subrange 2a
1388
1389	!
1390	!-- If the fraction of insoluble aerosols in subrange 2 is zero: do not allocate arrays for them
1391	IF ( nf2a > 0.999999_wp .AND. SUM( mass_fracs_b ) < 0.00001_wp ) THEN
1392	no_insoluble = .TRUE.
1393	start_subrange_2b = end_subrange_2a+1 ! 1st index of subrange 2b
1394	end_subrange_2b = end_subrange_2a ! last index of subrange 2b
1395	ELSE
1396	start_subrange_2b = start_subrange_2a + nbin(2) ! 1st index of subrange 2b
1397	end_subrange_2b = end_subrange_2a + nbin(2) ! last index of subrange 2b
1398	ENDIF
1399
1400	nbins_aerosol = end_subrange_2b ! total number of aerosol size bins
1401	!
1402	!-- Create index tables for different aerosol components
1403	CALL component_index_constructor( prtcl, ncc, maxspec, listspec )
1404
1405	ncomponents_mass = ncc
1406	IF ( advect_particle_water ) ncomponents_mass = ncc + 1 ! Add water
1407	!
1408	!-- Indices for chemical components used (-1 = not used)
1409	ii = 0
1410	IF ( is_used( prtcl, 'SO4' ) ) THEN
1411	index_so4 = get_index( prtcl,'SO4' )
1412	ii = ii + 1
1413	ENDIF
1414	IF ( is_used( prtcl,'OC' ) ) THEN
1415	index_oc = get_index(prtcl, 'OC')
1416	ii = ii + 1
1417	ENDIF
1418	IF ( is_used( prtcl, 'BC' ) ) THEN
1419	index_bc = get_index( prtcl, 'BC' )
1420	ii = ii + 1
1421	ENDIF
1422	IF ( is_used( prtcl, 'DU' ) ) THEN
1423	index_du = get_index( prtcl, 'DU' )
1424	ii = ii + 1
1425	ENDIF
1426	IF ( is_used( prtcl, 'SS' ) ) THEN
1427	index_ss = get_index( prtcl, 'SS' )
1428	ii = ii + 1
1429	ENDIF
1430	IF ( is_used( prtcl, 'NO' ) ) THEN
1431	index_no = get_index( prtcl, 'NO' )
1432	ii = ii + 1
1433	ENDIF
1434	IF ( is_used( prtcl, 'NH' ) ) THEN
1435	index_nh = get_index( prtcl, 'NH' )
1436	ii = ii + 1
1437	ENDIF
1438	!
1439	!-- All species must be known
1440	IF ( ii /= ncc ) THEN
1441	message_string = 'Unknown aerosol species/component(s) given in the initialization'
1442	CALL message( 'salsa_mod: salsa_init', 'PA0600', 1, 2, 0, 6, 0 )
1443	ENDIF
1444	!
1445	!-- Allocate:
1446	ALLOCATE( aero(nbins_aerosol), bc_am_t_val(nbins_aerosol*ncomponents_mass), &
1447	bc_an_t_val(nbins_aerosol), bc_gt_t_val(ngases_salsa), bin_low_limits(nbins_aerosol),&
1448	nsect(nbins_aerosol), massacc(nbins_aerosol) )
1449	ALLOCATE( k_topo_top(nysg:nyng,nxlg:nxrg) )
1450	IF ( nldepo ) ALLOCATE( sedim_vd(nzb:nzt+1,nysg:nyng,nxlg:nxrg,nbins_aerosol) )
1451	ALLOCATE( ra_dry(nzb:nzt+1,nysg:nyng,nxlg:nxrg,nbins_aerosol) )
1452	!
1453	!-- Initialise the sectional particle size distribution
1454	CALL set_sizebins
1455	!
1456	!-- Aerosol number concentration
1457	ALLOCATE( aerosol_number(nbins_aerosol) )
1458	ALLOCATE( nconc_1(nzb:nzt+1,nysg:nyng,nxlg:nxrg,nbins_aerosol), &
1459	nconc_2(nzb:nzt+1,nysg:nyng,nxlg:nxrg,nbins_aerosol), &
1460	nconc_3(nzb:nzt+1,nysg:nyng,nxlg:nxrg,nbins_aerosol) )
1461	nconc_1 = 0.0_wp
1462	nconc_2 = 0.0_wp
1463	nconc_3 = 0.0_wp
1464
1465	DO i = 1, nbins_aerosol
1466	aerosol_number(i)%conc(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => nconc_1(:,:,:,i)
1467	aerosol_number(i)%conc_p(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => nconc_2(:,:,:,i)
1468	aerosol_number(i)%tconc_m(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => nconc_3(:,:,:,i)
1469	ALLOCATE( aerosol_number(i)%flux_s(nzb+1:nzt,0:threads_per_task-1), &
1470	aerosol_number(i)%diss_s(nzb+1:nzt,0:threads_per_task-1), &
1471	aerosol_number(i)%flux_l(nzb+1:nzt,nys:nyn,0:threads_per_task-1), &
1472	aerosol_number(i)%diss_l(nzb+1:nzt,nys:nyn,0:threads_per_task-1), &
1473	aerosol_number(i)%init(nzb:nzt+1), &
1474	aerosol_number(i)%sums_ws_l(nzb:nzt+1,0:threads_per_task-1) )
1475	aerosol_number(i)%init = nclim
1476	IF ( include_emission .OR. ( nldepo .AND. nldepo_surf ) ) THEN
1477	ALLOCATE( aerosol_number(i)%source(nys:nyn,nxl:nxr) )
1478	aerosol_number(i)%source = 0.0_wp
1479	ENDIF
1480	ENDDO
1481
1482	!
1483	!-- Aerosol mass concentration
1484	ALLOCATE( aerosol_mass(ncomponents_mass*nbins_aerosol) )
1485	ALLOCATE( mconc_1(nzb:nzt+1,nysg:nyng,nxlg:nxrg,ncomponents_mass*nbins_aerosol), &
1486	mconc_2(nzb:nzt+1,nysg:nyng,nxlg:nxrg,ncomponents_mass*nbins_aerosol), &
1487	mconc_3(nzb:nzt+1,nysg:nyng,nxlg:nxrg,ncomponents_mass*nbins_aerosol) )
1488	mconc_1 = 0.0_wp
1489	mconc_2 = 0.0_wp
1490	mconc_3 = 0.0_wp
1491
1492	DO i = 1, ncomponents_mass*nbins_aerosol
1493	aerosol_mass(i)%conc(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => mconc_1(:,:,:,i)
1494	aerosol_mass(i)%conc_p(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => mconc_2(:,:,:,i)
1495	aerosol_mass(i)%tconc_m(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => mconc_3(:,:,:,i)
1496	ALLOCATE( aerosol_mass(i)%flux_s(nzb+1:nzt,0:threads_per_task-1), &
1497	aerosol_mass(i)%diss_s(nzb+1:nzt,0:threads_per_task-1), &
1498	aerosol_mass(i)%flux_l(nzb+1:nzt,nys:nyn,0:threads_per_task-1), &
1499	aerosol_mass(i)%diss_l(nzb+1:nzt,nys:nyn,0:threads_per_task-1), &
1500	aerosol_mass(i)%init(nzb:nzt+1), &
1501	aerosol_mass(i)%sums_ws_l(nzb:nzt+1,0:threads_per_task-1) )
1502	aerosol_mass(i)%init = mclim
1503	IF ( include_emission .OR. ( nldepo .AND. nldepo_surf ) ) THEN
1504	ALLOCATE( aerosol_mass(i)%source(nys:nyn,nxl:nxr) )
1505	aerosol_mass(i)%source = 0.0_wp
1506	ENDIF
1507	ENDDO
1508
1509	!
1510	!-- Surface fluxes: answs = aerosol number, amsws = aerosol mass
1511	!
1512	!-- Horizontal surfaces: default type
1513	DO l = 0, 2 ! upward (l=0), downward (l=1) and model top (l=2)
1514	ALLOCATE( surf_def_h(l)%answs( 1:surf_def_h(l)%ns, nbins_aerosol ) )
1515	ALLOCATE( surf_def_h(l)%amsws( 1:surf_def_h(l)%ns, nbins_aerosol*ncomponents_mass ) )
1516	surf_def_h(l)%answs = 0.0_wp
1517	surf_def_h(l)%amsws = 0.0_wp
1518	ENDDO
1519	!
1520	!-- Horizontal surfaces: natural type
1521	ALLOCATE( surf_lsm_h%answs( 1:surf_lsm_h%ns, nbins_aerosol ) )
1522	ALLOCATE( surf_lsm_h%amsws( 1:surf_lsm_h%ns, nbins_aerosol*ncomponents_mass ) )
1523	surf_lsm_h%answs = 0.0_wp
1524	surf_lsm_h%amsws = 0.0_wp
1525	!
1526	!-- Horizontal surfaces: urban type
1527	ALLOCATE( surf_usm_h%answs( 1:surf_usm_h%ns, nbins_aerosol ) )
1528	ALLOCATE( surf_usm_h%amsws( 1:surf_usm_h%ns, nbins_aerosol*ncomponents_mass ) )
1529	surf_usm_h%answs = 0.0_wp
1530	surf_usm_h%amsws = 0.0_wp
1531
1532	!
1533	!-- Vertical surfaces: northward (l=0), southward (l=1), eastward (l=2) and westward (l=3) facing
1534	DO l = 0, 3
1535	ALLOCATE( surf_def_v(l)%answs( 1:surf_def_v(l)%ns, nbins_aerosol ) )
1536	surf_def_v(l)%answs = 0.0_wp
1537	ALLOCATE( surf_def_v(l)%amsws( 1:surf_def_v(l)%ns, nbins_aerosol*ncomponents_mass ) )
1538	surf_def_v(l)%amsws = 0.0_wp
1539
1540	ALLOCATE( surf_lsm_v(l)%answs( 1:surf_lsm_v(l)%ns, nbins_aerosol ) )
1541	surf_lsm_v(l)%answs = 0.0_wp
1542	ALLOCATE( surf_lsm_v(l)%amsws( 1:surf_lsm_v(l)%ns, nbins_aerosol*ncomponents_mass ) )
1543	surf_lsm_v(l)%amsws = 0.0_wp
1544
1545	ALLOCATE( surf_usm_v(l)%answs( 1:surf_usm_v(l)%ns, nbins_aerosol ) )
1546	surf_usm_v(l)%answs = 0.0_wp
1547	ALLOCATE( surf_usm_v(l)%amsws( 1:surf_usm_v(l)%ns, nbins_aerosol*ncomponents_mass ) )
1548	surf_usm_v(l)%amsws = 0.0_wp
1549
1550	ENDDO
1551
1552	!
1553	!-- Concentration of gaseous tracers (1. SO4, 2. HNO3, 3. NH3, 4. OCNV, 5. OCSV)
1554	!-- (number concentration (#/m3) )
1555	!
1556	!-- If chemistry is on, read gas phase concentrations from there. Otherwise,
1557	!-- allocate salsa_gas array.
1558
1559	IF ( air_chemistry ) THEN
1560	DO lsp = 1, nvar
1561	SELECT CASE ( TRIM( chem_species(lsp)%name ) )
1562	CASE ( 'H2SO4', 'h2so4' )
1563	gases_available = gases_available + 1
1564	gas_index_chem(1) = lsp
1565	CASE ( 'HNO3', 'hno3' )
1566	gases_available = gases_available + 1
1567	gas_index_chem(2) = lsp
1568	CASE ( 'NH3', 'nh3' )
1569	gases_available = gases_available + 1
1570	gas_index_chem(3) = lsp
1571	CASE ( 'OCNV', 'ocnv' )
1572	gases_available = gases_available + 1
1573	gas_index_chem(4) = lsp
1574	CASE ( 'OCSV', 'ocsv' )
1575	gases_available = gases_available + 1
1576	gas_index_chem(5) = lsp
1577	END SELECT
1578	ENDDO
1579
1580	IF ( gases_available == ngases_salsa ) THEN
1581	salsa_gases_from_chem = .TRUE.
1582	ELSE
1583	WRITE( message_string, * ) 'SALSA is run together with chemistry but not all gaseous '// &
1584	'components are provided by kpp (H2SO4, HNO3, NH3, OCNV, OCSV)'
1585	CALL message( 'check_parameters', 'PA0599', 1, 2, 0, 6, 0 )
1586	ENDIF
1587
1588	ELSE
1589
1590	ALLOCATE( salsa_gas(ngases_salsa) )
1591	ALLOCATE( gconc_1(nzb:nzt+1,nysg:nyng,nxlg:nxrg,ngases_salsa), &
1592	gconc_2(nzb:nzt+1,nysg:nyng,nxlg:nxrg,ngases_salsa), &
1593	gconc_3(nzb:nzt+1,nysg:nyng,nxlg:nxrg,ngases_salsa) )
1594	gconc_1 = 0.0_wp
1595	gconc_2 = 0.0_wp
1596	gconc_3 = 0.0_wp
1597
1598	DO i = 1, ngases_salsa
1599	salsa_gas(i)%conc(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => gconc_1(:,:,:,i)
1600	salsa_gas(i)%conc_p(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => gconc_2(:,:,:,i)
1601	salsa_gas(i)%tconc_m(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => gconc_3(:,:,:,i)
1602	ALLOCATE( salsa_gas(i)%flux_s(nzb+1:nzt,0:threads_per_task-1), &
1603	salsa_gas(i)%diss_s(nzb+1:nzt,0:threads_per_task-1), &
1604	salsa_gas(i)%flux_l(nzb+1:nzt,nys:nyn,0:threads_per_task-1),&
1605	salsa_gas(i)%diss_l(nzb+1:nzt,nys:nyn,0:threads_per_task-1),&
1606	salsa_gas(i)%init(nzb:nzt+1), &
1607	salsa_gas(i)%sums_ws_l(nzb:nzt+1,0:threads_per_task-1) )
1608	salsa_gas(i)%init = nclim
1609	IF ( include_emission ) THEN
1610	ALLOCATE( salsa_gas(i)%source(nys:nys,nxl:nxr) )
1611	salsa_gas(i)%source = 0.0_wp
1612	ENDIF
1613	ENDDO
1614	!
1615	!-- Surface fluxes: gtsws = gaseous tracer flux
1616	!
1617	!-- Horizontal surfaces: default type
1618	DO l = 0, 2 ! upward (l=0), downward (l=1) and model top (l=2)
1619	ALLOCATE( surf_def_h(l)%gtsws( 1:surf_def_h(l)%ns, ngases_salsa ) )
1620	surf_def_h(l)%gtsws = 0.0_wp
1621	ENDDO
1622	!-- Horizontal surfaces: natural type
1623	ALLOCATE( surf_lsm_h%gtsws( 1:surf_lsm_h%ns, ngases_salsa ) )
1624	surf_lsm_h%gtsws = 0.0_wp
1625	!-- Horizontal surfaces: urban type
1626	ALLOCATE( surf_usm_h%gtsws( 1:surf_usm_h%ns, ngases_salsa ) )
1627	surf_usm_h%gtsws = 0.0_wp
1628	!
1629	!-- Vertical surfaces: northward (l=0), southward (l=1), eastward (l=2) and
1630	!-- westward (l=3) facing
1631	DO l = 0, 3
1632	ALLOCATE( surf_def_v(l)%gtsws( 1:surf_def_v(l)%ns, ngases_salsa ) )
1633	surf_def_v(l)%gtsws = 0.0_wp
1634	ALLOCATE( surf_lsm_v(l)%gtsws( 1:surf_lsm_v(l)%ns, ngases_salsa ) )
1635	surf_lsm_v(l)%gtsws = 0.0_wp
1636	ALLOCATE( surf_usm_v(l)%gtsws( 1:surf_usm_v(l)%ns, ngases_salsa ) )
1637	surf_usm_v(l)%gtsws = 0.0_wp
1638	ENDDO
1639	ENDIF
1640
1641	IF ( ws_scheme_sca ) THEN
1642
1643	IF ( salsa ) THEN
1644	ALLOCATE( sums_salsa_ws_l(nzb:nzt+1,0:threads_per_task-1) )
1645	sums_salsa_ws_l = 0.0_wp
1646	ENDIF
1647
1648	ENDIF
1649	!
1650	!-- Set control flags for decycling only at lateral boundary cores. Within the inner cores the
1651	!-- decycle flag is set to .FALSE.. Even though it does not affect the setting of chemistry boundary
1652	!-- conditions, this flag is used to set advection control flags appropriately.
1653	decycle_salsa_lr = MERGE( decycle_salsa_lr, .FALSE., nxl == 0 .OR. nxr == nx )
1654	decycle_salsa_ns = MERGE( decycle_salsa_ns, .FALSE., nys == 0 .OR. nyn == ny )
1655	!
1656	!-- Decycling can be applied separately for aerosol variables, while wind and other scalars may have
1657	!-- cyclic or nested boundary conditions. However, large gradients near the boundaries may produce
1658	!-- stationary numerical oscillations near the lateral boundaries when a higher-order scheme is
1659	!-- applied near these boundaries. To get rid-off this, set-up additional flags that control the
1660	!-- order of the scalar advection scheme near the lateral boundaries for passive scalars with
1661	!-- decycling.
1662	IF ( scalar_advec == 'ws-scheme' ) THEN
1663	ALLOCATE( salsa_advc_flags_s(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
1664	!
1665	!-- In case of decycling, set Neuman boundary conditions for wall_flags_total_0 bit 31 instead of
1666	!-- cyclic boundary conditions. Bit 31 is used to identify extended degradation zones (please see
1667	!-- the following comment). Note, since several also other modules may access this bit but may
1668	!-- have other boundary conditions, the original value of wall_flags_total_0 bit 31 must not be
1669	!-- modified. Hence, store the boundary conditions directly on salsa_advc_flags_s.
1670	!-- salsa_advc_flags_s will be later overwritten in ws_init_flags_scalar and bit 31 won't be used
1671	!-- to control the numerical order.
1672	!-- Initialize with flag 31 only.
1673	salsa_advc_flags_s = 0
1674	salsa_advc_flags_s = MERGE( IBSET( salsa_advc_flags_s, 31 ), 0, BTEST( wall_flags_total_0, 31 ) )
1675
1676	IF ( decycle_salsa_ns ) THEN
1677	IF ( nys == 0 ) THEN
1678	DO i = 1, nbgp
1679	salsa_advc_flags_s(:,nys-i,:) = MERGE( IBSET( salsa_advc_flags_s(:,nys,:), 31 ), &
1680	IBCLR( salsa_advc_flags_s(:,nys,:), 31 ), &
1681	BTEST( salsa_advc_flags_s(:,nys,:), 31 ) )
1682	ENDDO
1683	ENDIF
1684	IF ( nyn == ny ) THEN
1685	DO i = 1, nbgp
1686	salsa_advc_flags_s(:,nyn+i,:) = MERGE( IBSET( salsa_advc_flags_s(:,nyn,:), 31 ), &
1687	IBCLR( salsa_advc_flags_s(:,nyn,:), 31 ), &
1688	BTEST( salsa_advc_flags_s(:,nyn,:), 31 ) )
1689	ENDDO
1690	ENDIF
1691	ENDIF
1692	IF ( decycle_salsa_lr ) THEN
1693	IF ( nxl == 0 ) THEN
1694	DO i = 1, nbgp
1695	salsa_advc_flags_s(:,:,nxl-i) = MERGE( IBSET( salsa_advc_flags_s(:,:,nxl), 31 ), &
1696	IBCLR( salsa_advc_flags_s(:,:,nxl), 31 ), &
1697	BTEST( salsa_advc_flags_s(:,:,nxl), 31 ) )
1698	ENDDO
1699	ENDIF
1700	IF ( nxr == nx ) THEN
1701	DO i = 1, nbgp
1702	salsa_advc_flags_s(:,:,nxr+i) = MERGE( IBSET( salsa_advc_flags_s(:,:,nxr), 31 ), &
1703	IBCLR( salsa_advc_flags_s(:,:,nxr), 31 ), &
1704	BTEST( salsa_advc_flags_s(:,:,nxr), 31 ) )
1705	ENDDO
1706	ENDIF
1707	ENDIF
1708	!
1709	!-- To initialise the advection flags appropriately, pass the boundary flags to
1710	!-- ws_init_flags_scalar. The last argument in ws_init_flags_scalar indicates that a passive
1711	!-- scalar is being treated and the horizontal advection terms are degraded already 2 grid points
1712	!-- before the lateral boundary. Also, extended degradation zones are applied, where
1713	!-- horizontal advection of scalars is discretised by the first-order scheme at all grid points
1714	!-- in the vicinity of buildings (<= 3 grid points). Even though no building is within the
1715	!-- numerical stencil, the first-order scheme is used. At fourth and fifth grid points, the order
1716	!-- of the horizontal advection scheme is successively upgraded.
1717	!-- These degradations of the advection scheme are done to avoid stationary numerical
1718	!-- oscillations, which are responsible for high concentration maxima that may appear e.g. under
1719	!-- shear-free stable conditions.
1720	CALL ws_init_flags_scalar( bc_dirichlet_l .OR. bc_radiation_l .OR. decycle_salsa_lr, &
1721	bc_dirichlet_n .OR. bc_radiation_n .OR. decycle_salsa_ns, &
1722	bc_dirichlet_r .OR. bc_radiation_r .OR. decycle_salsa_lr, &
1723	bc_dirichlet_s .OR. bc_radiation_s .OR. decycle_salsa_ns, &
1724	salsa_advc_flags_s, .TRUE. )
1725	ENDIF
1726
1727
1728	END SUBROUTINE salsa_init_arrays
1729
1730	!------------------------------------------------------------------------------!
1731	! Description:
1732	! ------------
1733	!> Initialization of SALSA. Based on salsa_initialize in UCLALES-SALSA.
1734	!> Subroutines salsa_initialize, SALSAinit and DiagInitAero in UCLALES-SALSA are
1735	!> also merged here.
1736	!------------------------------------------------------------------------------!
1737	SUBROUTINE salsa_init
1738
1739	IMPLICIT NONE
1740
1741	INTEGER(iwp) :: i !<
1742	INTEGER(iwp) :: ib !< loop index for aerosol number bins
1743	INTEGER(iwp) :: ic !< loop index for aerosol mass bins
1744	INTEGER(iwp) :: ig !< loop index for gases
1745	INTEGER(iwp) :: j !<
1746
1747	IF ( debug_output ) CALL debug_message( 'salsa_init', 'start' )
1748
1749	bin_low_limits = 0.0_wp
1750	k_topo_top = 0
1751	nsect = 0.0_wp
1752	massacc = 1.0_wp
1753	!
1754	!-- Initialise
1755	IF ( nldepo ) sedim_vd = 0.0_wp
1756
1757	IF ( .NOT. salsa_gases_from_chem ) THEN
1758	IF ( .NOT. read_restart_data_salsa ) THEN
1759	salsa_gas(1)%conc = h2so4_init
1760	salsa_gas(2)%conc = hno3_init
1761	salsa_gas(3)%conc = nh3_init
1762	salsa_gas(4)%conc = ocnv_init
1763	salsa_gas(5)%conc = ocsv_init
1764	ENDIF
1765	DO ig = 1, ngases_salsa
1766	salsa_gas(ig)%conc_p = 0.0_wp
1767	salsa_gas(ig)%tconc_m = 0.0_wp
1768	salsa_gas(ig)%flux_s = 0.0_wp
1769	salsa_gas(ig)%diss_s = 0.0_wp
1770	salsa_gas(ig)%flux_l = 0.0_wp
1771	salsa_gas(ig)%diss_l = 0.0_wp
1772	salsa_gas(ig)%sums_ws_l = 0.0_wp
1773	salsa_gas(ig)%conc_p = salsa_gas(ig)%conc
1774	ENDDO
1775	!
1776	!-- Set initial value for gas compound tracer
1777	salsa_gas(1)%init = h2so4_init
1778	salsa_gas(2)%init = hno3_init
1779	salsa_gas(3)%init = nh3_init
1780	salsa_gas(4)%init = ocnv_init
1781	salsa_gas(5)%init = ocsv_init
1782	ENDIF
1783	!
1784	!-- Aerosol radius in each bin: dry and wet (m)
1785	ra_dry = 1.0E-10_wp
1786	!
1787	!-- Initialise location-dependent aerosol size distributions and chemical compositions:
1788	CALL aerosol_init
1789
1790	!-- Initalisation run of SALSA + calculate the vertical top index of the topography
1791	DO i = nxl, nxr
1792	DO j = nys, nyn
1793
1794	k_topo_top(j,i) = MAXLOC( MERGE( 1, 0, BTEST( wall_flags_total_0(:,j,i), 12 ) ), &
1795	DIM = 1 ) - 1
1796
1797	CALL salsa_driver( i, j, 1 )
1798	CALL salsa_diagnostics( i, j )
1799	ENDDO
1800	ENDDO
1801
1802	DO ib = 1, nbins_aerosol
1803	aerosol_number(ib)%conc_p = aerosol_number(ib)%conc
1804	aerosol_number(ib)%tconc_m = 0.0_wp
1805	aerosol_number(ib)%flux_s = 0.0_wp
1806	aerosol_number(ib)%diss_s = 0.0_wp
1807	aerosol_number(ib)%flux_l = 0.0_wp
1808	aerosol_number(ib)%diss_l = 0.0_wp
1809	aerosol_number(ib)%sums_ws_l = 0.0_wp
1810	ENDDO
1811	DO ic = 1, ncomponents_mass*nbins_aerosol
1812	aerosol_mass(ic)%conc_p = aerosol_mass(ic)%conc
1813	aerosol_mass(ic)%tconc_m = 0.0_wp
1814	aerosol_mass(ic)%flux_s = 0.0_wp
1815	aerosol_mass(ic)%diss_s = 0.0_wp
1816	aerosol_mass(ic)%flux_l = 0.0_wp
1817	aerosol_mass(ic)%diss_l = 0.0_wp
1818	aerosol_mass(ic)%sums_ws_l = 0.0_wp
1819	ENDDO
1820	!
1821	!
1822	!-- Initialise the deposition scheme and surface types
1823	IF ( nldepo ) CALL init_deposition
1824
1825	IF ( include_emission ) THEN
1826	!
1827	!-- Read in and initialize emissions
1828	CALL salsa_emission_setup( .TRUE. )
1829	IF ( .NOT. salsa_gases_from_chem .AND. salsa_emission_mode == 'read_from_file' ) THEN
1830	CALL salsa_gas_emission_setup( .TRUE. )
1831	ENDIF
1832	ENDIF
1833	!
1834	!-- Partition and dissolutional growth by gaseous HNO3 and NH3
1835	IF ( index_no > 0 .AND. index_nh > 0 .AND. index_so4 > 0 ) lspartition = .TRUE.
1836
1837	IF ( debug_output ) CALL debug_message( 'salsa_init', 'end' )
1838
1839	END SUBROUTINE salsa_init
1840
1841	!------------------------------------------------------------------------------!
1842	! Description:
1843	! ------------
1844	!> Initializes particle size distribution grid by calculating size bin limits
1845	!> and mid-size for dry particles in each bin. Called from salsa_initialize
1846	!> (only at the beginning of simulation).
1847	!> Size distribution described using:
1848	!> 1) moving center method (subranges 1 and 2)
1849	!> (Jacobson, Atmos. Env., 31, 131-144, 1997)
1850	!> 2) fixed sectional method (subrange 3)
1851	!> Size bins in each subrange are spaced logarithmically
1852	!> based on given subrange size limits and bin number.
1853	!
1854	!> Mona changed 06/2017: Use geometric mean diameter to describe the mean
1855	!> particle diameter in a size bin, not the arithmeric mean which clearly
1856	!> overestimates the total particle volume concentration.
1857	!
1858	!> Coded by:
1859	!> Hannele Korhonen (FMI) 2005
1860	!> Harri Kokkola (FMI) 2006
1861	!
1862	!> Bug fixes for box model + updated for the new aerosol datatype:
1863	!> Juha Tonttila (FMI) 2014
1864	!------------------------------------------------------------------------------!
1865	SUBROUTINE set_sizebins
1866
1867	IMPLICIT NONE
1868
1869	INTEGER(iwp) :: cc !< running index
1870	INTEGER(iwp) :: dd !< running index
1871
1872	REAL(wp) :: ratio_d !< ratio of the upper and lower diameter of subranges
1873
1874	aero(:)%dwet = 1.0E-10_wp
1875	aero(:)%veqh2o = 1.0E-10_wp
1876	aero(:)%numc = nclim
1877	aero(:)%core = 1.0E-10_wp
1878	DO cc = 1, maxspec+1 ! 1:SO4, 2:OC, 3:BC, 4:DU, 5:SS, 6:NO, 7:NH, 8:H2O
1879	aero(:)%volc(cc) = 0.0_wp
1880	ENDDO
1881	!
1882	!-- vlolim&vhilim: min & max dry volumes [fxm]
1883	!-- dmid: bin mid dry diameter (m)
1884	!-- vratiolo&vratiohi: volume ratio between the center and low/high limit
1885	!
1886	!-- 1) Size subrange 1:
1887	ratio_d = reglim(2) / reglim(1) ! section spacing (m)
1888	DO cc = start_subrange_1a, end_subrange_1a
1889	aero(cc)%vlolim = api6 * ( reglim(1) * ratio_d( REAL( cc-1 ) / nbin(1) ) )3
1890	aero(cc)%vhilim = api6 * ( reglim(1) * ratio_d( REAL( cc ) / nbin(1) ) )3
1891	aero(cc)%dmid = SQRT( ( aero(cc)%vhilim / api6 )*0.33333333_wp &
1892	( aero(cc)%vlolim / api6 )**0.33333333_wp )
1893	aero(cc)%vratiohi = aero(cc)%vhilim / ( api6 * aero(cc)%dmid**3 )
1894	aero(cc)%vratiolo = aero(cc)%vlolim / ( api6 * aero(cc)%dmid**3 )
1895	ENDDO
1896	!
1897	!-- 2) Size subrange 2:
1898	!-- 2.1) Sub-subrange 2a: high hygroscopicity
1899	ratio_d = reglim(3) / reglim(2) ! section spacing
1900	DO dd = start_subrange_2a, end_subrange_2a
1901	cc = dd - start_subrange_2a
1902	aero(dd)%vlolim = api6 * ( reglim(2) * ratio_d( REAL( cc ) / nbin(2) ) )3
1903	aero(dd)%vhilim = api6 * ( reglim(2) * ratio_d( REAL( cc+1 ) / nbin(2) ) )3
1904	aero(dd)%dmid = SQRT( ( aero(dd)%vhilim / api6 )*0.33333333_wp &
1905	( aero(dd)%vlolim / api6 )**0.33333333_wp )
1906	aero(dd)%vratiohi = aero(dd)%vhilim / ( api6 * aero(dd)%dmid**3 )
1907	aero(dd)%vratiolo = aero(dd)%vlolim / ( api6 * aero(dd)%dmid**3 )
1908	ENDDO
1909	!
1910	!-- 2.2) Sub-subrange 2b: low hygroscopicity
1911	IF ( .NOT. no_insoluble ) THEN
1912	aero(start_subrange_2b:end_subrange_2b)%vlolim = aero(start_subrange_2a:end_subrange_2a)%vlolim
1913	aero(start_subrange_2b:end_subrange_2b)%vhilim = aero(start_subrange_2a:end_subrange_2a)%vhilim
1914	aero(start_subrange_2b:end_subrange_2b)%dmid = aero(start_subrange_2a:end_subrange_2a)%dmid
1915	aero(start_subrange_2b:end_subrange_2b)%vratiohi = aero(start_subrange_2a:end_subrange_2a)%vratiohi
1916	aero(start_subrange_2b:end_subrange_2b)%vratiolo = aero(start_subrange_2a:end_subrange_2a)%vratiolo
1917	ENDIF
1918	!
1919	!-- Initialize the wet diameter with the bin dry diameter to avoid numerical problems later
1920	aero(:)%dwet = aero(:)%dmid
1921	!
1922	!-- Save bin limits (lower diameter) to be delivered to PALM if needed
1923	DO cc = 1, nbins_aerosol
1924	bin_low_limits(cc) = ( aero(cc)%vlolim / api6 )**0.33333333_wp
1925	ENDDO
1926
1927	END SUBROUTINE set_sizebins
1928
1929	!------------------------------------------------------------------------------!
1930	! Description:
1931	! ------------
1932	!> Initilize altitude-dependent aerosol size distributions and compositions.
1933	!>
1934	!> Mona added 06/2017: Correct the number and mass concentrations by normalizing
1935	!< by the given total number and mass concentration.
1936	!>
1937	!> Tomi Raatikainen, FMI, 29.2.2016
1938	!------------------------------------------------------------------------------!
1939	SUBROUTINE aerosol_init
1940
1941	USE netcdf_data_input_mod, &
1942	ONLY: check_existence, close_input_file, get_dimension_length, &
1943	get_attribute, get_variable, &
1944	inquire_num_variables, inquire_variable_names, &
1945	open_read_file
1946
1947	IMPLICIT NONE
1948
1949	CHARACTER(LEN=25), DIMENSION(:), ALLOCATABLE :: cc_name !< chemical component name
1950	CHARACTER(LEN=100), DIMENSION(:), ALLOCATABLE :: var_names !< variable names
1951
1952	INTEGER(iwp) :: ee !< index: end
1953	INTEGER(iwp) :: i !< loop index: x-direction
1954	INTEGER(iwp) :: ib !< loop index: size bins
1955	INTEGER(iwp) :: ic !< loop index: chemical components
1956	INTEGER(iwp) :: id_dyn !< NetCDF id of PIDS_DYNAMIC_SALSA
1957	INTEGER(iwp) :: ig !< loop index: gases
1958	INTEGER(iwp) :: j !< loop index: y-direction
1959	INTEGER(iwp) :: k !< loop index: z-direction
1960	INTEGER(iwp) :: lod_aero !< level of detail of inital aerosol concentrations
1961	INTEGER(iwp) :: num_vars !< number of variables
1962	INTEGER(iwp) :: pr_nbins !< number of aerosol size bins in file
1963	INTEGER(iwp) :: pr_ncc !< number of aerosol chemical components in file
1964	INTEGER(iwp) :: pr_nz !< number of vertical grid-points in file
1965	INTEGER(iwp) :: prunmode !< running mode of SALSA
1966	INTEGER(iwp) :: ss !< index: start
1967
1968	INTEGER(iwp), DIMENSION(maxspec) :: cc_in2mod
1969
1970	LOGICAL :: netcdf_extend = .FALSE. !< Flag: netcdf file exists
1971
1972	REAL(wp) :: flag !< flag to mask topography grid points
1973
1974	REAL(wp), DIMENSION(nbins_aerosol) :: core !< size of the bin mid aerosol particle
1975
1976	REAL(wp), DIMENSION(0:nz+1) :: pnf2a !< number fraction in 2a
1977	REAL(wp), DIMENSION(0:nz+1) :: pmfoc1a !< mass fraction of OC in 1a
1978
1979	REAL(wp), DIMENSION(0:nz+1,nbins_aerosol) :: pndist !< vertical profile of size dist. (#/m3)
1980	REAL(wp), DIMENSION(0:nz+1,maxspec) :: pmf2a !< mass distributions in subrange 2a
1981	REAL(wp), DIMENSION(0:nz+1,maxspec) :: pmf2b !< mass distributions in subrange 2b
1982
1983	REAL(wp), DIMENSION(:), ALLOCATABLE :: pr_dmid !< vertical profile of aerosol bin diameters
1984	REAL(wp), DIMENSION(:), ALLOCATABLE :: pr_z !< z levels of profiles
1985
1986	REAL(wp), DIMENSION(:,:), ALLOCATABLE :: pr_mass_fracs_a !< mass fraction: a
1987	REAL(wp), DIMENSION(:,:), ALLOCATABLE :: pr_mass_fracs_b !< and b
1988
1989	cc_in2mod = 0
1990	prunmode = 1
1991	!
1992	!-- Bin mean aerosol particle volume (m3)
1993	core(1:nbins_aerosol) = api6 * aero(1:nbins_aerosol)%dmid**3
1994	!
1995	!-- Set concentrations to zero
1996	pndist(:,:) = 0.0_wp
1997	pnf2a(:) = nf2a
1998	pmf2a(:,:) = 0.0_wp
1999	pmf2b(:,:) = 0.0_wp
2000	pmfoc1a(:) = 0.0_wp
2001
2002	IF ( init_aerosol_type == 1 ) THEN
2003	!
2004	!-- Read input profiles from PIDS_DYNAMIC_SALSA
2005	#if defined( __netcdf )
2006	!
2007	!-- Location-dependent size distributions and compositions.
2008	INQUIRE( FILE = TRIM( input_file_dynamic ) // TRIM( coupling_char ), EXIST = netcdf_extend )
2009	IF ( netcdf_extend ) THEN
2010	!
2011	!-- Open file in read-only mode
2012	CALL open_read_file( TRIM( input_file_dynamic ) // TRIM( coupling_char ), id_dyn )
2013	!
2014	!-- At first, inquire all variable names
2015	CALL inquire_num_variables( id_dyn, num_vars )
2016	!
2017	!-- Allocate memory to store variable names
2018	ALLOCATE( var_names(1:num_vars) )
2019	CALL inquire_variable_names( id_dyn, var_names )
2020	!
2021	!-- Inquire vertical dimension and number of aerosol chemical components
2022	CALL get_dimension_length( id_dyn, pr_nz, 'z' )
2023	IF ( pr_nz /= nz ) THEN
2024	WRITE( message_string, * ) 'Number of inifor horizontal grid points does not match '//&
2025	'the number of numeric grid points.'
2026	CALL message( 'aerosol_init', 'PA0601', 1, 2, 0, 6, 0 )
2027	ENDIF
2028	CALL get_dimension_length( id_dyn, pr_ncc, 'composition_index' )
2029	!
2030	!-- Allocate memory
2031	ALLOCATE( pr_z(1:pr_nz), pr_mass_fracs_a(nzb:nzt+1,pr_ncc), &
2032	pr_mass_fracs_b(nzb:nzt+1,pr_ncc) )
2033	pr_mass_fracs_a = 0.0_wp
2034	pr_mass_fracs_b = 0.0_wp
2035	!
2036	!-- Read vertical levels
2037	CALL get_variable( id_dyn, 'z', pr_z )
2038	!
2039	!-- Read the names of chemical components
2040	IF ( check_existence( var_names, 'composition_name' ) ) THEN
2041	CALL get_variable( id_dyn, 'composition_name', cc_name, pr_ncc )
2042	ELSE
2043	WRITE( message_string, * ) 'Missing composition_name in ' // TRIM( input_file_dynamic )
2044	CALL message( 'aerosol_init', 'PA0655', 1, 2, 0, 6, 0 )
2045	ENDIF
2046	!
2047	!-- Define the index of each chemical component in the model
2048	DO ic = 1, pr_ncc
2049	SELECT CASE ( TRIM( cc_name(ic) ) )
2050	CASE ( 'H2SO4', 'SO4', 'h2so4', 'so4' )
2051	cc_in2mod(1) = ic
2052	CASE ( 'OC', 'oc' )
2053	cc_in2mod(2) = ic
2054	CASE ( 'BC', 'bc' )
2055	cc_in2mod(3) = ic
2056	CASE ( 'DU', 'du' )
2057	cc_in2mod(4) = ic
2058	CASE ( 'SS', 'ss' )
2059	cc_in2mod(5) = ic
2060	CASE ( 'HNO3', 'hno3', 'NO3', 'no3', 'NO', 'no' )
2061	cc_in2mod(6) = ic
2062	CASE ( 'NH3', 'nh3', 'NH4', 'nh4', 'NH', 'nh' )
2063	cc_in2mod(7) = ic
2064	END SELECT
2065	ENDDO
2066
2067	IF ( SUM( cc_in2mod ) == 0 ) THEN
2068	message_string = 'None of the aerosol chemical components in ' // TRIM( &
2069	input_file_dynamic ) // ' correspond to ones applied in SALSA.'
2070	CALL message( 'salsa_mod: aerosol_init', 'PA0602', 2, 2, 0, 6, 0 )
2071	ENDIF
2072	!
2073	!-- Vertical profiles of mass fractions of different chemical components:
2074	IF ( check_existence( var_names, 'init_atmosphere_mass_fracs_a' ) ) THEN
2075	CALL get_variable( id_dyn, 'init_atmosphere_mass_fracs_a', pr_mass_fracs_a, &
2076	0, pr_ncc-1, 0, pr_nz-1 )
2077	ELSE
2078	WRITE( message_string, * ) 'Missing init_atmosphere_mass_fracs_a in ' // &
2079	TRIM( input_file_dynamic )
2080	CALL message( 'aerosol_init', 'PA0656', 1, 2, 0, 6, 0 )
2081	ENDIF
2082	CALL get_variable( id_dyn, 'init_atmosphere_mass_fracs_b', pr_mass_fracs_b, &
2083	0, pr_ncc-1, 0, pr_nz-1 )
2084	!
2085	!-- Match the input data with the chemical composition applied in the model
2086	DO ic = 1, maxspec
2087	ss = cc_in2mod(ic)
2088	IF ( ss == 0 ) CYCLE
2089	pmf2a(nzb+1:nzt+1,ic) = pr_mass_fracs_a(nzb:nzt,ss)
2090	pmf2b(nzb+1:nzt+1,ic) = pr_mass_fracs_b(nzb:nzt,ss)
2091	ENDDO
2092	!
2093	!-- Aerosol concentrations: lod=1 (vertical profile of sectional number size distribution)
2094	CALL get_attribute( id_dyn, 'lod', lod_aero, .FALSE., 'init_atmosphere_aerosol' )
2095	IF ( lod_aero /= 1 ) THEN
2096	message_string = 'Currently only lod=1 accepted for init_atmosphere_aerosol'
2097	CALL message( 'salsa_mod: aerosol_init', 'PA0603', 2, 2, 0, 6, 0 )
2098	ELSE
2099	!
2100	!-- Bin mean diameters in the input file
2101	CALL get_dimension_length( id_dyn, pr_nbins, 'Dmid')
2102	IF ( pr_nbins /= nbins_aerosol ) THEN
2103	message_string = 'Number of size bins in init_atmosphere_aerosol does not match ' &
2104	// 'with that applied in the model'
2105	CALL message( 'salsa_mod: aerosol_init', 'PA0604', 2, 2, 0, 6, 0 )
2106	ENDIF
2107
2108	ALLOCATE( pr_dmid(pr_nbins) )
2109	pr_dmid = 0.0_wp
2110
2111	CALL get_variable( id_dyn, 'Dmid', pr_dmid )
2112	!
2113	!-- Check whether the sectional representation conform to the one
2114	!-- applied in the model
2115	IF ( ANY( ABS( ( aero(1:nbins_aerosol)%dmid - pr_dmid ) / &
2116	aero(1:nbins_aerosol)%dmid ) > 0.1_wp ) ) THEN
2117	message_string = 'Mean diameters of the aerosol size bins in ' // TRIM( &
2118	input_file_dynamic ) // ' do not match with the sectional '// &
2119	'representation of the model.'
2120	CALL message( 'salsa_mod: aerosol_init', 'PA0605', 2, 2, 0, 6, 0 )
2121	ENDIF
2122	!
2123	!-- Inital aerosol concentrations
2124	CALL get_variable( id_dyn, 'init_atmosphere_aerosol', pndist(nzb+1:nzt,:), &
2125	0, pr_nbins-1, 0, pr_nz-1 )
2126	ENDIF
2127	!
2128	!-- Set bottom and top boundary condition (Neumann)
2129	pmf2a(nzb,:) = pmf2a(nzb+1,:)
2130	pmf2a(nzt+1,:) = pmf2a(nzt,:)
2131	pmf2b(nzb,:) = pmf2b(nzb+1,:)
2132	pmf2b(nzt+1,:) = pmf2b(nzt,:)
2133	pndist(nzb,:) = pndist(nzb+1,:)
2134	pndist(nzt+1,:) = pndist(nzt,:)
2135
2136	IF ( index_so4 < 0 ) THEN
2137	pmf2a(:,1) = 0.0_wp
2138	pmf2b(:,1) = 0.0_wp
2139	ENDIF
2140	IF ( index_oc < 0 ) THEN
2141	pmf2a(:,2) = 0.0_wp
2142	pmf2b(:,2) = 0.0_wp
2143	ENDIF
2144	IF ( index_bc < 0 ) THEN
2145	pmf2a(:,3) = 0.0_wp
2146	pmf2b(:,3) = 0.0_wp
2147	ENDIF
2148	IF ( index_du < 0 ) THEN
2149	pmf2a(:,4) = 0.0_wp
2150	pmf2b(:,4) = 0.0_wp
2151	ENDIF
2152	IF ( index_ss < 0 ) THEN
2153	pmf2a(:,5) = 0.0_wp
2154	pmf2b(:,5) = 0.0_wp
2155	ENDIF
2156	IF ( index_no < 0 ) THEN
2157	pmf2a(:,6) = 0.0_wp
2158	pmf2b(:,6) = 0.0_wp
2159	ENDIF
2160	IF ( index_nh < 0 ) THEN
2161	pmf2a(:,7) = 0.0_wp
2162	pmf2b(:,7) = 0.0_wp
2163	ENDIF
2164
2165	IF ( SUM( pmf2a ) < 0.00001_wp .AND. SUM( pmf2b ) < 0.00001_wp ) THEN
2166	message_string = 'Error in initialising mass fractions of chemical components. ' // &
2167	'Check that all chemical components are included in parameter file!'
2168	CALL message( 'salsa_mod: aerosol_init', 'PA0606', 2, 2, 0, 6, 0 )
2169	ENDIF
2170	!
2171	!-- Then normalise the mass fraction so that SUM = 1
2172	DO k = nzb, nzt+1
2173	pmf2a(k,:) = pmf2a(k,:) / SUM( pmf2a(k,:) )
2174	IF ( SUM( pmf2b(k,:) ) > 0.0_wp ) pmf2b(k,:) = pmf2b(k,:) / SUM( pmf2b(k,:) )
2175	ENDDO
2176
2177	DEALLOCATE( pr_z, pr_mass_fracs_a, pr_mass_fracs_b )
2178	!
2179	!-- Close input file
2180	CALL close_input_file( id_dyn )
2181
2182	ELSE
2183	message_string = 'Input file '// TRIM( input_file_dynamic ) // TRIM( coupling_char ) // &
2184	' for SALSA missing!'
2185	CALL message( 'salsa_mod: aerosol_init', 'PA0607', 1, 2, 0, 6, 0 )
2186
2187	ENDIF ! netcdf_extend
2188
2189	#else
2190	message_string = 'init_aerosol_type = 1 but preprocessor directive __netcdf is not used '// &
2191	'in compiling!'
2192	CALL message( 'salsa_mod: aerosol_init', 'PA0608', 1, 2, 0, 6, 0 )
2193
2194	#endif
2195
2196	ELSEIF ( init_aerosol_type == 0 ) THEN
2197	!
2198	!-- Mass fractions for species in a and b-bins
2199	IF ( index_so4 > 0 ) THEN
2200	pmf2a(:,1) = mass_fracs_a(index_so4)
2201	pmf2b(:,1) = mass_fracs_b(index_so4)
2202	ENDIF
2203	IF ( index_oc > 0 ) THEN
2204	pmf2a(:,2) = mass_fracs_a(index_oc)
2205	pmf2b(:,2) = mass_fracs_b(index_oc)
2206	ENDIF
2207	IF ( index_bc > 0 ) THEN
2208	pmf2a(:,3) = mass_fracs_a(index_bc)
2209	pmf2b(:,3) = mass_fracs_b(index_bc)
2210	ENDIF
2211	IF ( index_du > 0 ) THEN
2212	pmf2a(:,4) = mass_fracs_a(index_du)
2213	pmf2b(:,4) = mass_fracs_b(index_du)
2214	ENDIF
2215	IF ( index_ss > 0 ) THEN
2216	pmf2a(:,5) = mass_fracs_a(index_ss)
2217	pmf2b(:,5) = mass_fracs_b(index_ss)
2218	ENDIF
2219	IF ( index_no > 0 ) THEN
2220	pmf2a(:,6) = mass_fracs_a(index_no)
2221	pmf2b(:,6) = mass_fracs_b(index_no)
2222	ENDIF
2223	IF ( index_nh > 0 ) THEN
2224	pmf2a(:,7) = mass_fracs_a(index_nh)
2225	pmf2b(:,7) = mass_fracs_b(index_nh)
2226	ENDIF
2227	DO k = nzb, nzt+1
2228	pmf2a(k,:) = pmf2a(k,:) / SUM( pmf2a(k,:) )
2229	IF ( SUM( pmf2b(k,:) ) > 0.0_wp ) pmf2b(k,:) = pmf2b(k,:) / SUM( pmf2b(k,:) )
2230	ENDDO
2231
2232	CALL size_distribution( n_lognorm, dpg, sigmag, nsect )
2233	!
2234	!-- Normalize by the given total number concentration
2235	nsect = nsect * SUM( n_lognorm ) / SUM( nsect )
2236	DO ib = start_subrange_1a, end_subrange_2b
2237	pndist(:,ib) = nsect(ib)
2238	ENDDO
2239	ENDIF
2240
2241	IF ( init_gases_type == 1 ) THEN
2242	!
2243	!-- Read input profiles from PIDS_CHEM
2244	#if defined( __netcdf )
2245	!
2246	!-- Location-dependent size distributions and compositions.
2247	INQUIRE( FILE = TRIM( input_file_dynamic ) // TRIM( coupling_char ), EXIST = netcdf_extend )
2248	IF ( netcdf_extend .AND. .NOT. salsa_gases_from_chem ) THEN
2249	!
2250	!-- Open file in read-only mode
2251	CALL open_read_file( TRIM( input_file_dynamic ) // TRIM( coupling_char ), id_dyn )
2252	!
2253	!-- Inquire dimensions:
2254	CALL get_dimension_length( id_dyn, pr_nz, 'z' )
2255	IF ( pr_nz /= nz ) THEN
2256	WRITE( message_string, * ) 'Number of inifor horizontal grid points does not match '//&
2257	'the number of numeric grid points.'
2258	CALL message( 'aerosol_init', 'PA0609', 1, 2, 0, 6, 0 )
2259	ENDIF
2260	!
2261	!-- Read vertical profiles of gases:
2262	CALL get_variable( id_dyn, 'init_atmosphere_H2SO4', salsa_gas(1)%init(nzb+1:nzt) )
2263	CALL get_variable( id_dyn, 'init_atmosphere_HNO3', salsa_gas(2)%init(nzb+1:nzt) )
2264	CALL get_variable( id_dyn, 'init_atmosphere_NH3', salsa_gas(3)%init(nzb+1:nzt) )
2265	CALL get_variable( id_dyn, 'init_atmosphere_OCNV', salsa_gas(4)%init(nzb+1:nzt) )
2266	CALL get_variable( id_dyn, 'init_atmosphere_OCSV', salsa_gas(5)%init(nzb+1:nzt) )
2267	!
2268	!-- Set Neumann top and surface boundary condition for initial + initialise concentrations
2269	DO ig = 1, ngases_salsa
2270	salsa_gas(ig)%init(nzb) = salsa_gas(ig)%init(nzb+1)
2271	salsa_gas(ig)%init(nzt+1) = salsa_gas(ig)%init(nzt)
2272	IF ( .NOT. read_restart_data_salsa ) THEN
2273	DO k = nzb, nzt+1
2274	salsa_gas(ig)%conc(k,:,:) = salsa_gas(ig)%init(k)
2275	ENDDO
2276	ENDIF
2277	ENDDO
2278	!
2279	!-- Close input file
2280	CALL close_input_file( id_dyn )
2281
2282	ELSEIF ( .NOT. netcdf_extend .AND. .NOT. salsa_gases_from_chem ) THEN
2283	message_string = 'Input file '// TRIM( input_file_dynamic ) // TRIM( coupling_char ) // &
2284	' for SALSA missing!'
2285	CALL message( 'salsa_mod: aerosol_init', 'PA0610', 1, 2, 0, 6, 0 )
2286
2287	ENDIF ! netcdf_extend
2288	#else
2289	message_string = 'init_gases_type = 1 but preprocessor directive __netcdf is not used in '//&
2290	'compiling!'
2291	CALL message( 'salsa_mod: aerosol_init', 'PA0611', 1, 2, 0, 6, 0 )
2292
2293	#endif
2294
2295	ENDIF
2296	!
2297	!-- Both SO4 and OC are included, so use the given mass fractions
2298	IF ( index_oc > 0 .AND. index_so4 > 0 ) THEN
2299	pmfoc1a(:) = pmf2a(:,2) / ( pmf2a(:,2) + pmf2a(:,1) ) ! Normalize
2300	!
2301	!-- Pure organic carbon
2302	ELSEIF ( index_oc > 0 ) THEN
2303	pmfoc1a(:) = 1.0_wp
2304	!
2305	!-- Pure SO4
2306	ELSEIF ( index_so4 > 0 ) THEN
2307	pmfoc1a(:) = 0.0_wp
2308
2309	ELSE
2310	message_string = 'Either OC or SO4 must be active for aerosol region 1a!'
2311	CALL message( 'salsa_mod: aerosol_init', 'PA0612', 1, 2, 0, 6, 0 )
2312	ENDIF
2313
2314	!
2315	!-- Initialize concentrations
2316	DO i = nxlg, nxrg
2317	DO j = nysg, nyng
2318	DO k = nzb, nzt+1
2319	!
2320	!-- Predetermine flag to mask topography
2321	flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) )
2322	!
2323	!-- a) Number concentrations
2324	!-- Region 1:
2325	DO ib = start_subrange_1a, end_subrange_1a
2326	IF ( .NOT. read_restart_data_salsa ) THEN
2327	aerosol_number(ib)%conc(k,j,i) = pndist(k,ib) * flag
2328	ENDIF
2329	IF ( prunmode == 1 ) THEN
2330	aerosol_number(ib)%init = pndist(:,ib)
2331	ENDIF
2332	ENDDO
2333	!
2334	!-- Region 2:
2335	IF ( nreg > 1 ) THEN
2336	DO ib = start_subrange_2a, end_subrange_2a
2337	IF ( .NOT. read_restart_data_salsa ) THEN
2338	aerosol_number(ib)%conc(k,j,i) = MAX( 0.0_wp, pnf2a(k) ) * pndist(k,ib) * flag
2339	ENDIF
2340	IF ( prunmode == 1 ) THEN
2341	aerosol_number(ib)%init = MAX( 0.0_wp, nf2a ) * pndist(:,ib)
2342	ENDIF
2343	ENDDO
2344	IF ( .NOT. no_insoluble ) THEN
2345	DO ib = start_subrange_2b, end_subrange_2b
2346	IF ( pnf2a(k) < 1.0_wp ) THEN
2347	IF ( .NOT. read_restart_data_salsa ) THEN
2348	aerosol_number(ib)%conc(k,j,i) = MAX( 0.0_wp, 1.0_wp - pnf2a(k) ) * &
2349	pndist(k,ib) * flag
2350	ENDIF
2351	IF ( prunmode == 1 ) THEN
2352	aerosol_number(ib)%init = MAX( 0.0_wp, 1.0_wp - nf2a ) * pndist(:,ib)
2353	ENDIF
2354	ENDIF
2355	ENDDO
2356	ENDIF
2357	ENDIF
2358	!
2359	!-- b) Aerosol mass concentrations
2360	!-- bin subrange 1: done here separately due to the SO4/OC convention
2361	!
2362	!-- SO4:
2363	IF ( index_so4 > 0 ) THEN
2364	ss = ( index_so4 - 1 ) * nbins_aerosol + start_subrange_1a !< start
2365	ee = ( index_so4 - 1 ) * nbins_aerosol + end_subrange_1a !< end
2366	ib = start_subrange_1a
2367	DO ic = ss, ee
2368	IF ( .NOT. read_restart_data_salsa ) THEN
2369	aerosol_mass(ic)%conc(k,j,i) = MAX( 0.0_wp, 1.0_wp - pmfoc1a(k) ) * &
2370	pndist(k,ib) * core(ib) * arhoh2so4 * flag
2371	ENDIF
2372	IF ( prunmode == 1 ) THEN
2373	aerosol_mass(ic)%init(k) = MAX( 0.0_wp, 1.0_wp - pmfoc1a(k) ) * pndist(k,ib) &
2374	* core(ib) * arhoh2so4
2375	ENDIF
2376	ib = ib+1
2377	ENDDO
2378	ENDIF
2379	!
2380	!-- OC:
2381	IF ( index_oc > 0 ) THEN
2382	ss = ( index_oc - 1 ) * nbins_aerosol + start_subrange_1a !< start
2383	ee = ( index_oc - 1 ) * nbins_aerosol + end_subrange_1a !< end
2384	ib = start_subrange_1a
2385	DO ic = ss, ee
2386	IF ( .NOT. read_restart_data_salsa ) THEN
2387	aerosol_mass(ic)%conc(k,j,i) = MAX( 0.0_wp, pmfoc1a(k) ) * pndist(k,ib) * &
2388	core(ib) * arhooc * flag
2389	ENDIF
2390	IF ( prunmode == 1 ) THEN
2391	aerosol_mass(ic)%init(k) = MAX( 0.0_wp, pmfoc1a(k) ) * pndist(k,ib) * &
2392	core(ib) * arhooc
2393	ENDIF
2394	ib = ib+1
2395	ENDDO
2396	ENDIF
2397	ENDDO !< k
2398
2399	prunmode = 3 ! Init only once
2400
2401	ENDDO !< j
2402	ENDDO !< i
2403
2404	!
2405	!-- c) Aerosol mass concentrations
2406	!-- bin subrange 2:
2407	IF ( nreg > 1 ) THEN
2408
2409	IF ( index_so4 > 0 ) THEN
2410	CALL set_aero_mass( index_so4, pmf2a(:,1), pmf2b(:,1), pnf2a, pndist, core, arhoh2so4 )
2411	ENDIF
2412	IF ( index_oc > 0 ) THEN
2413	CALL set_aero_mass( index_oc, pmf2a(:,2), pmf2b(:,2), pnf2a, pndist, core, arhooc )
2414	ENDIF
2415	IF ( index_bc > 0 ) THEN
2416	CALL set_aero_mass( index_bc, pmf2a(:,3), pmf2b(:,3), pnf2a, pndist, core, arhobc )
2417	ENDIF
2418	IF ( index_du > 0 ) THEN
2419	CALL set_aero_mass( index_du, pmf2a(:,4), pmf2b(:,4), pnf2a, pndist, core, arhodu )
2420	ENDIF
2421	IF ( index_ss > 0 ) THEN
2422	CALL set_aero_mass( index_ss, pmf2a(:,5), pmf2b(:,5), pnf2a, pndist, core, arhoss )
2423	ENDIF
2424	IF ( index_no > 0 ) THEN
2425	CALL set_aero_mass( index_no, pmf2a(:,6), pmf2b(:,6), pnf2a, pndist, core, arhohno3 )
2426	ENDIF
2427	IF ( index_nh > 0 ) THEN
2428	CALL set_aero_mass( index_nh, pmf2a(:,7), pmf2b(:,7), pnf2a, pndist, core, arhonh3 )
2429	ENDIF
2430
2431	ENDIF
2432
2433	END SUBROUTINE aerosol_init
2434
2435	!------------------------------------------------------------------------------!
2436	! Description:
2437	! ------------
2438	!> Create a lognormal size distribution and discretise to a sectional
2439	!> representation.
2440	!------------------------------------------------------------------------------!
2441	SUBROUTINE size_distribution( in_ntot, in_dpg, in_sigma, psd_sect )
2442
2443	IMPLICIT NONE
2444
2445	INTEGER(iwp) :: ib !< running index: bin
2446	INTEGER(iwp) :: iteration !< running index: iteration
2447
2448	REAL(wp) :: d1 !< particle diameter (m, dummy)
2449	REAL(wp) :: d2 !< particle diameter (m, dummy)
2450	REAL(wp) :: delta_d !< (d2-d1)/10
2451	REAL(wp) :: deltadp !< bin width
2452	REAL(wp) :: dmidi !< ( d1 + d2 ) / 2
2453
2454	REAL(wp), DIMENSION(:), INTENT(in) :: in_dpg !< geometric mean diameter (m)
2455	REAL(wp), DIMENSION(:), INTENT(in) :: in_ntot !< number conc. (#/m3)
2456	REAL(wp), DIMENSION(:), INTENT(in) :: in_sigma !< standard deviation
2457
2458	REAL(wp), DIMENSION(:), INTENT(inout) :: psd_sect !< sectional size distribution
2459
2460	DO ib = start_subrange_1a, end_subrange_2b
2461	psd_sect(ib) = 0.0_wp
2462	!
2463	!-- Particle diameter at the low limit (largest in the bin) (m)
2464	d1 = ( aero(ib)%vlolim / api6 )**0.33333333_wp
2465	!
2466	!-- Particle diameter at the high limit (smallest in the bin) (m)
2467	d2 = ( aero(ib)%vhilim / api6 )**0.33333333_wp
2468	!
2469	!-- Span of particle diameter in a bin (m)
2470	delta_d = 0.1_wp * ( d2 - d1 )
2471	!
2472	!-- Iterate:
2473	DO iteration = 1, 10
2474	d1 = ( aero(ib)%vlolim / api6 )*0.33333333_wp + ( ib - 1) delta_d
2475	d2 = d1 + delta_d
2476	dmidi = 0.5_wp * ( d1 + d2 )
2477	deltadp = LOG10( d2 / d1 )
2478	!
2479	!-- Size distribution
2480	!-- in_ntot = total number, total area, or total volume concentration
2481	!-- in_dpg = geometric-mean number, area, or volume diameter
2482	!-- n(k) = number, area, or volume concentration in a bin
2483	psd_sect(ib) = psd_sect(ib) + SUM( in_ntot * deltadp / ( SQRT( 2.0_wp * pi ) * &
2484	LOG10( in_sigma ) ) * EXP( -LOG10( dmidi / in_dpg )**2.0_wp / &
2485	( 2.0_wp * LOG10( in_sigma ) ** 2.0_wp ) ) )
2486
2487	ENDDO
2488	ENDDO
2489
2490	END SUBROUTINE size_distribution
2491
2492	!------------------------------------------------------------------------------!
2493	! Description:
2494	! ------------
2495	!> Sets the mass concentrations to aerosol arrays in 2a and 2b.
2496	!>
2497	!> Tomi Raatikainen, FMI, 29.2.2016
2498	!------------------------------------------------------------------------------!
2499	SUBROUTINE set_aero_mass( ispec, pmf2a, pmf2b, pnf2a, pndist, pcore, prho )
2500
2501	IMPLICIT NONE
2502
2503	INTEGER(iwp) :: ee !< index: end
2504	INTEGER(iwp) :: i !< loop index
2505	INTEGER(iwp) :: ib !< loop index
2506	INTEGER(iwp) :: ic !< loop index
2507	INTEGER(iwp) :: j !< loop index
2508	INTEGER(iwp) :: k !< loop index
2509	INTEGER(iwp) :: prunmode !< 1 = initialise
2510	INTEGER(iwp) :: ss !< index: start
2511
2512	INTEGER(iwp), INTENT(in) :: ispec !< Aerosol species index
2513
2514	REAL(wp) :: flag !< flag to mask topography grid points
2515
2516	REAL(wp), INTENT(in) :: prho !< Aerosol density
2517
2518	REAL(wp), DIMENSION(nbins_aerosol), INTENT(in) :: pcore !< Aerosol bin mid core volume
2519	REAL(wp), DIMENSION(0:nz+1), INTENT(in) :: pnf2a !< Number fraction for 2a
2520	REAL(wp), DIMENSION(0:nz+1), INTENT(in) :: pmf2a !< Mass distributions for a
2521	REAL(wp), DIMENSION(0:nz+1), INTENT(in) :: pmf2b !< and b bins
2522
2523	REAL(wp), DIMENSION(0:nz+1,nbins_aerosol), INTENT(in) :: pndist !< Aerosol size distribution
2524
2525	prunmode = 1
2526
2527	DO i = nxlg, nxrg
2528	DO j = nysg, nyng
2529	DO k = nzb, nzt+1
2530	!
2531	!-- Predetermine flag to mask topography
2532	flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) )
2533	!
2534	!-- Regime 2a:
2535	ss = ( ispec - 1 ) * nbins_aerosol + start_subrange_2a
2536	ee = ( ispec - 1 ) * nbins_aerosol + end_subrange_2a
2537	ib = start_subrange_2a
2538	DO ic = ss, ee
2539	IF ( .NOT. read_restart_data_salsa ) THEN
2540	aerosol_mass(ic)%conc(k,j,i) = MAX( 0.0_wp, pmf2a(k) ) * pnf2a(k) * pndist(k,ib)&
2541	* pcore(ib) * prho * flag
2542	ENDIF
2543	IF ( prunmode == 1 ) THEN
2544	aerosol_mass(ic)%init(k) = MAX( 0.0_wp, pmf2a(k) ) * pnf2a(k) * pndist(k,ib) * &
2545	pcore(ib) * prho
2546	ENDIF
2547	ib = ib + 1
2548	ENDDO
2549	!
2550	!-- Regime 2b:
2551	IF ( .NOT. no_insoluble ) THEN
2552	ss = ( ispec - 1 ) * nbins_aerosol + start_subrange_2b
2553	ee = ( ispec - 1 ) * nbins_aerosol + end_subrange_2b
2554	ib = start_subrange_2a
2555	DO ic = ss, ee
2556	IF ( .NOT. read_restart_data_salsa ) THEN
2557	aerosol_mass(ic)%conc(k,j,i) = MAX( 0.0_wp, pmf2b(k) ) * ( 1.0_wp - pnf2a(k))&
2558	* pndist(k,ib) * pcore(ib) * prho * flag
2559	ENDIF
2560	IF ( prunmode == 1 ) THEN
2561	aerosol_mass(ic)%init(k) = MAX( 0.0_wp, pmf2b(k) ) * ( 1.0_wp - pnf2a(k) ) * &
2562	pndist(k,ib) * pcore(ib) * prho
2563	ENDIF
2564	ib = ib + 1
2565	ENDDO ! c
2566
2567	ENDIF
2568	ENDDO ! k
2569
2570	prunmode = 3 ! Init only once
2571
2572	ENDDO ! j
2573	ENDDO ! i
2574
2575	END SUBROUTINE set_aero_mass
2576
2577	!------------------------------------------------------------------------------!
2578	! Description:
2579	! ------------
2580	!> Initialise the matching between surface types in LSM and deposition models.
2581	!> Do the matching based on Zhang et al. (2001). Atmos. Environ. 35, 549-560
2582	!> (here referred as Z01).
2583	!------------------------------------------------------------------------------!
2584	SUBROUTINE init_deposition
2585
2586	USE surface_mod, &
2587	ONLY: surf_lsm_h, surf_lsm_v, surf_usm_h, surf_usm_v
2588
2589	IMPLICIT NONE
2590
2591	INTEGER(iwp) :: l !< loop index for vertical surfaces
2592
2593	LOGICAL :: match_lsm !< flag to initilise LSM surfaces (if false, initialise USM surfaces)
2594
2595	IF ( depo_pcm_par == 'zhang2001' ) THEN
2596	depo_pcm_par_num = 1
2597	ELSEIF ( depo_pcm_par == 'petroff2010' ) THEN
2598	depo_pcm_par_num = 2
2599	ENDIF
2600
2601	IF ( depo_surf_par == 'zhang2001' ) THEN
2602	depo_surf_par_num = 1
2603	ELSEIF ( depo_surf_par == 'petroff2010' ) THEN
2604	depo_surf_par_num = 2
2605	ENDIF
2606	!
2607	!-- LSM: Pavement, vegetation and water
2608	IF ( nldepo_surf .AND. land_surface ) THEN
2609	match_lsm = .TRUE.
2610	ALLOCATE( lsm_to_depo_h%match_lupg(1:surf_lsm_h%ns), &
2611	lsm_to_depo_h%match_luvw(1:surf_lsm_h%ns), &
2612	lsm_to_depo_h%match_luww(1:surf_lsm_h%ns) )
2613	lsm_to_depo_h%match_lupg = 0
2614	lsm_to_depo_h%match_luvw = 0
2615	lsm_to_depo_h%match_luww = 0
2616	CALL match_sm_zhang( surf_lsm_h, lsm_to_depo_h%match_lupg, lsm_to_depo_h%match_luvw, &
2617	lsm_to_depo_h%match_luww, match_lsm )
2618	DO l = 0, 3
2619	ALLOCATE( lsm_to_depo_v(l)%match_lupg(1:surf_lsm_v(l)%ns), &
2620	lsm_to_depo_v(l)%match_luvw(1:surf_lsm_v(l)%ns), &
2621	lsm_to_depo_v(l)%match_luww(1:surf_lsm_v(l)%ns) )
2622	lsm_to_depo_v(l)%match_lupg = 0
2623	lsm_to_depo_v(l)%match_luvw = 0
2624	lsm_to_depo_v(l)%match_luww = 0
2625	CALL match_sm_zhang( surf_lsm_v(l), lsm_to_depo_v(l)%match_lupg, &
2626	lsm_to_depo_v(l)%match_luvw, lsm_to_depo_v(l)%match_luww, match_lsm )
2627	ENDDO
2628	ENDIF
2629	!
2630	!-- USM: Green roofs/walls, wall surfaces and windows
2631	IF ( nldepo_surf .AND. urban_surface ) THEN
2632	match_lsm = .FALSE.
2633	ALLOCATE( usm_to_depo_h%match_lupg(1:surf_usm_h%ns), &
2634	usm_to_depo_h%match_luvw(1:surf_usm_h%ns), &
2635	usm_to_depo_h%match_luww(1:surf_usm_h%ns) )
2636	usm_to_depo_h%match_lupg = 0
2637	usm_to_depo_h%match_luvw = 0
2638	usm_to_depo_h%match_luww = 0
2639	CALL match_sm_zhang( surf_usm_h, usm_to_depo_h%match_lupg, usm_to_depo_h%match_luvw, &
2640	usm_to_depo_h%match_luww, match_lsm )
2641	DO l = 0, 3
2642	ALLOCATE( usm_to_depo_v(l)%match_lupg(1:surf_usm_v(l)%ns), &
2643	usm_to_depo_v(l)%match_luvw(1:surf_usm_v(l)%ns), &
2644	usm_to_depo_v(l)%match_luww(1:surf_usm_v(l)%ns) )
2645	usm_to_depo_v(l)%match_lupg = 0
2646	usm_to_depo_v(l)%match_luvw = 0
2647	usm_to_depo_v(l)%match_luww = 0
2648	CALL match_sm_zhang( surf_usm_v(l), usm_to_depo_v(l)%match_lupg, &
2649	usm_to_depo_v(l)%match_luvw, usm_to_depo_v(l)%match_luww, match_lsm )
2650	ENDDO
2651	ENDIF
2652
2653	IF ( nldepo_pcm ) THEN
2654	SELECT CASE ( depo_pcm_type )
2655	CASE ( 'evergreen_needleleaf' )
2656	depo_pcm_type_num = 1
2657	CASE ( 'evergreen_broadleaf' )
2658	depo_pcm_type_num = 2
2659	CASE ( 'deciduous_needleleaf' )
2660	depo_pcm_type_num = 3
2661	CASE ( 'deciduous_broadleaf' )
2662	depo_pcm_type_num = 4
2663	CASE DEFAULT
2664	message_string = 'depo_pcm_type not set correctly.'
2665	CALL message( 'salsa_mod: init_deposition', 'PA0613', 1, 2, 0, 6, 0 )
2666	END SELECT
2667	ENDIF
2668
2669	END SUBROUTINE init_deposition
2670
2671	!------------------------------------------------------------------------------!
2672	! Description:
2673	! ------------
2674	!> Match the surface types in PALM and Zhang et al. 2001 deposition module
2675	!------------------------------------------------------------------------------!
2676	SUBROUTINE match_sm_zhang( surf, match_pav_green, match_veg_wall, match_wat_win, match_lsm )
2677
2678	USE surface_mod, &
2679	ONLY: ind_pav_green, ind_veg_wall, ind_wat_win, surf_type
2680
2681	IMPLICIT NONE
2682
2683	INTEGER(iwp) :: m !< index for surface elements
2684	INTEGER(iwp) :: pav_type_palm !< pavement / green wall type in PALM
2685	INTEGER(iwp) :: veg_type_palm !< vegetation / wall type in PALM
2686	INTEGER(iwp) :: wat_type_palm !< water / window type in PALM
2687
2688	INTEGER(iwp), DIMENSION(:), INTENT(inout) :: match_pav_green !< matching pavement/green walls
2689	INTEGER(iwp), DIMENSION(:), INTENT(inout) :: match_veg_wall !< matching vegetation/walls
2690	INTEGER(iwp), DIMENSION(:), INTENT(inout) :: match_wat_win !< matching water/windows
2691
2692	LOGICAL, INTENT(in) :: match_lsm !< flag to initilise LSM surfaces (if false, initialise USM)
2693
2694	TYPE(surf_type), INTENT(in) :: surf !< respective surface type
2695
2696	DO m = 1, surf%ns
2697	IF ( match_lsm ) THEN
2698	!
2699	!-- Vegetation (LSM):
2700	IF ( surf%frac(ind_veg_wall,m) > 0 ) THEN
2701	veg_type_palm = surf%vegetation_type(m)
2702	SELECT CASE ( veg_type_palm )
2703	CASE ( 0 )
2704	message_string = 'No vegetation type defined.'
2705	CALL message( 'salsa_mod: init_depo_surfaces', 'PA0614', 1, 2, 0, 6, 0 )
2706	CASE ( 1 ) ! bare soil
2707	match_veg_wall(m) = 6 ! grass in Z01
2708	CASE ( 2 ) ! crops, mixed farming
2709	match_veg_wall(m) = 7 ! crops, mixed farming Z01
2710	CASE ( 3 ) ! short grass
2711	match_veg_wall(m) = 6 ! grass in Z01
2712	CASE ( 4 ) ! evergreen needleleaf trees
2713	match_veg_wall(m) = 1 ! evergreen needleleaf trees in Z01
2714	CASE ( 5 ) ! deciduous needleleaf trees
2715	match_veg_wall(m) = 3 ! deciduous needleleaf trees in Z01
2716	CASE ( 6 ) ! evergreen broadleaf trees
2717	match_veg_wall(m) = 2 ! evergreen broadleaf trees in Z01
2718	CASE ( 7 ) ! deciduous broadleaf trees
2719	match_veg_wall(m) = 4 ! deciduous broadleaf trees in Z01
2720	CASE ( 8 ) ! tall grass
2721	match_veg_wall(m) = 6 ! grass in Z01
2722	CASE ( 9 ) ! desert
2723	match_veg_wall(m) = 8 ! desert in Z01
2724	CASE ( 10 ) ! tundra
2725	match_veg_wall(m) = 9 ! tundra in Z01
2726	CASE ( 11 ) ! irrigated crops
2727	match_veg_wall(m) = 7 ! crops, mixed farming Z01
2728	CASE ( 12 ) ! semidesert
2729	match_veg_wall(m) = 8 ! desert in Z01
2730	CASE ( 13 ) ! ice caps and glaciers
2731	match_veg_wall(m) = 12 ! ice cap and glacier in Z01
2732	CASE ( 14 ) ! bogs and marshes
2733	match_veg_wall(m) = 11 ! wetland with plants in Z01
2734	CASE ( 15 ) ! evergreen shrubs
2735	match_veg_wall(m) = 10 ! shrubs and interrupted woodlands in Z01
2736	CASE ( 16 ) ! deciduous shrubs
2737	match_veg_wall(m) = 10 ! shrubs and interrupted woodlands in Z01
2738	CASE ( 17 ) ! mixed forest/woodland
2739	match_veg_wall(m) = 5 ! mixed broadleaf and needleleaf trees in Z01
2740	CASE ( 18 ) ! interrupted forest
2741	match_veg_wall(m) = 10 ! shrubs and interrupted woodlands in Z01
2742	END SELECT
2743	ENDIF
2744	!
2745	!-- Pavement (LSM):
2746	IF ( surf%frac(ind_pav_green,m) > 0 ) THEN
2747	pav_type_palm = surf%pavement_type(m)
2748	IF ( pav_type_palm == 0 ) THEN ! error
2749	message_string = 'No pavement type defined.'
2750	CALL message( 'salsa_mod: match_sm_zhang', 'PA0615', 1, 2, 0, 6, 0 )
2751	ELSE
2752	match_pav_green(m) = 15 ! urban in Z01
2753	ENDIF
2754	ENDIF
2755	!
2756	!-- Water (LSM):
2757	IF ( surf%frac(ind_wat_win,m) > 0 ) THEN
2758	wat_type_palm = surf%water_type(m)
2759	IF ( wat_type_palm == 0 ) THEN ! error
2760	message_string = 'No water type defined.'
2761	CALL message( 'salsa_mod: match_sm_zhang', 'PA0616', 1, 2, 0, 6, 0 )
2762	ELSEIF ( wat_type_palm == 3 ) THEN
2763	match_wat_win(m) = 14 ! ocean in Z01
2764	ELSEIF ( wat_type_palm == 1 .OR. wat_type_palm == 2 .OR. wat_type_palm == 4 &
2765	.OR. wat_type_palm == 5 ) THEN
2766	match_wat_win(m) = 13 ! inland water in Z01
2767	ENDIF
2768	ENDIF
2769	ELSE
2770	!
2771	!-- Wall surfaces (USM):
2772	IF ( surf%frac(ind_veg_wall,m) > 0 ) THEN
2773	match_veg_wall(m) = 15 ! urban in Z01
2774	ENDIF
2775	!
2776	!-- Green walls and roofs (USM):
2777	IF ( surf%frac(ind_pav_green,m) > 0 ) THEN
2778	match_pav_green(m) = 6 ! (short) grass in Z01
2779	ENDIF
2780	!
2781	!-- Windows (USM):
2782	IF ( surf%frac(ind_wat_win,m) > 0 ) THEN
2783	match_wat_win(m) = 15 ! urban in Z01
2784	ENDIF
2785	ENDIF
2786
2787	ENDDO
2788
2789	END SUBROUTINE match_sm_zhang
2790
2791	!------------------------------------------------------------------------------!
2792	! Description:
2793	! ------------
2794	!> Swapping of timelevels
2795	!------------------------------------------------------------------------------!
2796	SUBROUTINE salsa_swap_timelevel( mod_count )
2797
2798	IMPLICIT NONE
2799
2800	INTEGER(iwp) :: ib !<
2801	INTEGER(iwp) :: ic !<
2802	INTEGER(iwp) :: icc !<
2803	INTEGER(iwp) :: ig !<
2804
2805	INTEGER(iwp), INTENT(IN) :: mod_count !<
2806
2807	IF ( time_since_reference_point >= skip_time_do_salsa ) THEN
2808
2809	SELECT CASE ( mod_count )
2810
2811	CASE ( 0 )
2812
2813	DO ib = 1, nbins_aerosol
2814	aerosol_number(ib)%conc(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => nconc_1(:,:,:,ib)
2815	aerosol_number(ib)%conc_p(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => nconc_2(:,:,:,ib)
2816
2817	DO ic = 1, ncomponents_mass
2818	icc = ( ic-1 ) * nbins_aerosol + ib
2819	aerosol_mass(icc)%conc(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => mconc_1(:,:,:,icc)
2820	aerosol_mass(icc)%conc_p(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => mconc_2(:,:,:,icc)
2821	ENDDO
2822	ENDDO
2823
2824	IF ( .NOT. salsa_gases_from_chem ) THEN
2825	DO ig = 1, ngases_salsa
2826	salsa_gas(ig)%conc(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => gconc_1(:,:,:,ig)
2827	salsa_gas(ig)%conc_p(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => gconc_2(:,:,:,ig)
2828	ENDDO
2829	ENDIF
2830
2831	CASE ( 1 )
2832
2833	DO ib = 1, nbins_aerosol
2834	aerosol_number(ib)%conc(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => nconc_2(:,:,:,ib)
2835	aerosol_number(ib)%conc_p(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => nconc_1(:,:,:,ib)
2836	DO ic = 1, ncomponents_mass
2837	icc = ( ic-1 ) * nbins_aerosol + ib
2838	aerosol_mass(icc)%conc(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => mconc_2(:,:,:,icc)
2839	aerosol_mass(icc)%conc_p(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => mconc_1(:,:,:,icc)
2840	ENDDO
2841	ENDDO
2842
2843	IF ( .NOT. salsa_gases_from_chem ) THEN
2844	DO ig = 1, ngases_salsa
2845	salsa_gas(ig)%conc(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => gconc_2(:,:,:,ig)
2846	salsa_gas(ig)%conc_p(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => gconc_1(:,:,:,ig)
2847	ENDDO
2848	ENDIF
2849
2850	END SELECT
2851
2852	ENDIF
2853
2854	END SUBROUTINE salsa_swap_timelevel
2855
2856
2857	!------------------------------------------------------------------------------!
2858	! Description:
2859	! ------------
2860	!> This routine reads the respective restart data.
2861	!------------------------------------------------------------------------------!
2862	SUBROUTINE salsa_rrd_local( k, nxlf, nxlc, nxl_on_file, nxrf, nxrc, nxr_on_file, nynf, nync, &
2863	nyn_on_file, nysf, nysc, nys_on_file, tmp_3d, found )
2864
2865	USE control_parameters, &
2866	ONLY: length, restart_string
2867
2868	IMPLICIT NONE
2869
2870	INTEGER(iwp) :: ib !<
2871	INTEGER(iwp) :: ic !<
2872	INTEGER(iwp) :: ig !<
2873	INTEGER(iwp) :: k !<
2874	INTEGER(iwp) :: nxlc !<
2875	INTEGER(iwp) :: nxlf !<
2876	INTEGER(iwp) :: nxl_on_file !<
2877	INTEGER(iwp) :: nxrc !<
2878	INTEGER(iwp) :: nxrf !<
2879	INTEGER(iwp) :: nxr_on_file !<
2880	INTEGER(iwp) :: nync !<
2881	INTEGER(iwp) :: nynf !<
2882	INTEGER(iwp) :: nyn_on_file !<
2883	INTEGER(iwp) :: nysc !<
2884	INTEGER(iwp) :: nysf !<
2885	INTEGER(iwp) :: nys_on_file !<
2886
2887	LOGICAL, INTENT(OUT) :: found !<
2888
2889	REAL(wp), &
2890	DIMENSION(nzb:nzt+1,nys_on_file-nbgp:nyn_on_file+nbgp,nxl_on_file-nbgp:nxr_on_file+nbgp) :: tmp_3d !<
2891
2892	found = .FALSE.
2893
2894	IF ( read_restart_data_salsa ) THEN
2895
2896	SELECT CASE ( restart_string(1:length) )
2897
2898	CASE ( 'aerosol_number' )
2899	DO ib = 1, nbins_aerosol
2900	IF ( k == 1 ) READ ( 13 ) tmp_3d
2901	aerosol_number(ib)%conc(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) = &
2902	tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
2903	found = .TRUE.
2904	ENDDO
2905
2906	CASE ( 'aerosol_mass' )
2907	DO ic = 1, ncomponents_mass * nbins_aerosol
2908	IF ( k == 1 ) READ ( 13 ) tmp_3d
2909	aerosol_mass(ic)%conc(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) = &
2910	tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
2911	found = .TRUE.
2912	ENDDO
2913
2914	CASE ( 'salsa_gas' )
2915	DO ig = 1, ngases_salsa
2916	IF ( k == 1 ) READ ( 13 ) tmp_3d
2917	salsa_gas(ig)%conc(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) = &
2918	tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
2919	found = .TRUE.
2920	ENDDO
2921
2922	CASE DEFAULT
2923	found = .FALSE.
2924
2925	END SELECT
2926	ENDIF
2927
2928	END SUBROUTINE salsa_rrd_local
2929
2930	!------------------------------------------------------------------------------!
2931	! Description:
2932	! ------------
2933	!> This routine writes the respective restart data.
2934	!> Note that the following input variables in PARIN have to be equal between
2935	!> restart runs:
2936	!> listspec, nbin, nbin2, nf2a, ncc, mass_fracs_a, mass_fracs_b
2937	!------------------------------------------------------------------------------!
2938	SUBROUTINE salsa_wrd_local
2939
2940	USE control_parameters, &
2941	ONLY: write_binary
2942
2943	IMPLICIT NONE
2944
2945	INTEGER(iwp) :: ib !<
2946	INTEGER(iwp) :: ic !<
2947	INTEGER(iwp) :: ig !<
2948
2949	IF ( write_binary .AND. write_binary_salsa ) THEN
2950
2951	CALL wrd_write_string( 'aerosol_number' )
2952	DO ib = 1, nbins_aerosol
2953	WRITE ( 14 ) aerosol_number(ib)%conc
2954	ENDDO
2955
2956	CALL wrd_write_string( 'aerosol_mass' )
2957	DO ic = 1, nbins_aerosol * ncomponents_mass
2958	WRITE ( 14 ) aerosol_mass(ic)%conc
2959	ENDDO
2960
2961	CALL wrd_write_string( 'salsa_gas' )
2962	DO ig = 1, ngases_salsa
2963	WRITE ( 14 ) salsa_gas(ig)%conc
2964	ENDDO
2965
2966	ENDIF
2967
2968	END SUBROUTINE salsa_wrd_local
2969
2970	!------------------------------------------------------------------------------!
2971	! Description:
2972	! ------------
2973	!> Performs necessary unit and dimension conversion between the host model and
2974	!> SALSA module, and calls the main SALSA routine.
2975	!> Partially adobted form the original SALSA boxmodel version.
2976	!> Now takes masses in as kg/kg from LES!! Converted to m3/m3 for SALSA
2977	!> 05/2016 Juha: This routine is still pretty much in its original shape.
2978	!> It's dumb as a mule and twice as ugly, so implementation of
2979	!> an improved solution is necessary sooner or later.
2980	!> Juha Tonttila, FMI, 2014
2981	!> Jaakko Ahola, FMI, 2016
2982	!> Only aerosol processes included, Mona Kurppa, UHel, 2017
2983	!------------------------------------------------------------------------------!
2984	SUBROUTINE salsa_driver( i, j, prunmode )
2985
2986	USE arrays_3d, &
2987	ONLY: pt_p, q_p, u, v, w
2988
2989	USE plant_canopy_model_mod, &
2990	ONLY: lad_s
2991
2992	USE surface_mod, &
2993	ONLY: surf_def_h, surf_def_v, surf_lsm_h, surf_lsm_v, surf_usm_h, surf_usm_v
2994
2995	IMPLICIT NONE
2996
2997	INTEGER(iwp) :: endi !< end index
2998	INTEGER(iwp) :: ib !< loop index
2999	INTEGER(iwp) :: ic !< loop index
3000	INTEGER(iwp) :: ig !< loop index
3001	INTEGER(iwp) :: k_wall !< vertical index of topography top
3002	INTEGER(iwp) :: k !< loop index
3003	INTEGER(iwp) :: l !< loop index
3004	INTEGER(iwp) :: nc_h2o !< index of H2O in the prtcl index table
3005	INTEGER(iwp) :: ss !< loop index
3006	INTEGER(iwp) :: str !< start index
3007	INTEGER(iwp) :: vc !< default index in prtcl
3008
3009	INTEGER(iwp), INTENT(in) :: i !< loop index
3010	INTEGER(iwp), INTENT(in) :: j !< loop index
3011	INTEGER(iwp), INTENT(in) :: prunmode !< 1: Initialization, 2: Spinup, 3: Regular runtime
3012
3013	REAL(wp) :: cw_old !< previous H2O mixing ratio
3014	REAL(wp) :: flag !< flag to mask topography grid points
3015	REAL(wp) :: in_lad !< leaf area density (m2/m3)
3016	REAL(wp) :: in_rh !< relative humidity
3017	REAL(wp) :: zgso4 !< SO4
3018	REAL(wp) :: zghno3 !< HNO3
3019	REAL(wp) :: zgnh3 !< NH3
3020	REAL(wp) :: zgocnv !< non-volatile OC
3021	REAL(wp) :: zgocsv !< semi-volatile OC
3022
3023	REAL(wp), DIMENSION(nzb:nzt+1) :: in_adn !< air density (kg/m3)
3024	REAL(wp), DIMENSION(nzb:nzt+1) :: in_cs !< H2O sat. vapour conc.
3025	REAL(wp), DIMENSION(nzb:nzt+1) :: in_cw !< H2O vapour concentration
3026	REAL(wp), DIMENSION(nzb:nzt+1) :: in_p !< pressure (Pa)
3027	REAL(wp), DIMENSION(nzb:nzt+1) :: in_t !< temperature (K)
3028	REAL(wp), DIMENSION(nzb:nzt+1) :: in_u !< wind magnitude (m/s)
3029	REAL(wp), DIMENSION(nzb:nzt+1) :: kvis !< kinematic viscosity of air(m2/s)
3030	REAL(wp), DIMENSION(nzb:nzt+1) :: ppm_to_nconc !< Conversion factor from ppm to #/m3
3031
3032	REAL(wp), DIMENSION(nzb:nzt+1,nbins_aerosol) :: schmidt_num !< particle Schmidt number
3033	REAL(wp), DIMENSION(nzb:nzt+1,nbins_aerosol) :: vd !< particle fall seed (m/s)
3034
3035	TYPE(t_section), DIMENSION(nbins_aerosol) :: lo_aero !< additional variable for OpenMP
3036	TYPE(t_section), DIMENSION(nbins_aerosol) :: aero_old !< helper array
3037
3038	aero_old(:)%numc = 0.0_wp
3039	in_lad = 0.0_wp
3040	in_u = 0.0_wp
3041	kvis = 0.0_wp
3042	lo_aero = aero
3043	schmidt_num = 0.0_wp
3044	vd = 0.0_wp
3045	zgso4 = nclim
3046	zghno3 = nclim
3047	zgnh3 = nclim
3048	zgocnv = nclim
3049	zgocsv = nclim
3050	!
3051	!-- Aerosol number is always set, but mass can be uninitialized
3052	DO ib = 1, nbins_aerosol
3053	lo_aero(ib)%volc(:) = 0.0_wp
3054	aero_old(ib)%volc(:) = 0.0_wp
3055	ENDDO
3056	!
3057	!-- Set the salsa runtime config (How to make this more efficient?)
3058	CALL set_salsa_runtime( prunmode )
3059	!
3060	!-- Calculate thermodynamic quantities needed in SALSA
3061	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 )
3062	!
3063	!-- Magnitude of wind: needed for deposition
3064	IF ( lsdepo ) THEN
3065	in_u(nzb+1:nzt) = SQRT( ( 0.5_wp * ( u(nzb+1:nzt,j,i) + u(nzb+1:nzt,j,i+1) ) )**2 + &
3066	( 0.5_wp * ( v(nzb+1:nzt,j,i) + v(nzb+1:nzt,j+1,i) ) )**2 + &
3067	( 0.5_wp * ( w(nzb:nzt-1,j,i) + w(nzb+1:nzt,j, i) ) )**2 )
3068	ENDIF
3069	!
3070	!-- Calculate conversion factors for gas concentrations
3071	ppm_to_nconc(:) = for_ppm_to_nconc * in_p(:) / in_t(:)
3072	!
3073	!-- Determine topography-top index on scalar grid
3074	k_wall = k_topo_top(j,i)
3075
3076	DO k = nzb+1, nzt
3077	!
3078	!-- Predetermine flag to mask topography
3079	flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) )
3080	!
3081	!-- Wind velocity for dry depositon on vegetation
3082	IF ( lsdepo_pcm .AND. plant_canopy ) THEN
3083	in_lad = lad_s( MAX( k-k_wall,0 ),j,i)
3084	ENDIF
3085	!
3086	!-- For initialization and spinup, limit the RH with the parameter rhlim
3087	IF ( prunmode < 3 ) THEN
3088	in_cw(k) = MIN( in_cw(k), in_cs(k) * rhlim )
3089	ELSE
3090	in_cw(k) = in_cw(k)
3091	ENDIF
3092	cw_old = in_cw(k) !* in_adn(k)
3093	!
3094	!-- Set volume concentrations:
3095	!-- Sulphate (SO4) or sulphuric acid H2SO4
3096	IF ( index_so4 > 0 ) THEN
3097	vc = 1
3098	str = ( index_so4-1 ) * nbins_aerosol + 1 ! start index
3099	endi = index_so4 * nbins_aerosol ! end index
3100	ic = 1
3101	DO ss = str, endi
3102	lo_aero(ic)%volc(vc) = aerosol_mass(ss)%conc(k,j,i) / arhoh2so4
3103	ic = ic+1
3104	ENDDO
3105	aero_old(1:nbins_aerosol)%volc(vc) = lo_aero(1:nbins_aerosol)%volc(vc)
3106	ENDIF
3107	!
3108	!-- Organic carbon (OC) compounds
3109	IF ( index_oc > 0 ) THEN
3110	vc = 2
3111	str = ( index_oc-1 ) * nbins_aerosol + 1
3112	endi = index_oc * nbins_aerosol
3113	ic = 1
3114	DO ss = str, endi
3115	lo_aero(ic)%volc(vc) = aerosol_mass(ss)%conc(k,j,i) / arhooc
3116	ic = ic+1
3117	ENDDO
3118	aero_old(1:nbins_aerosol)%volc(vc) = lo_aero(1:nbins_aerosol)%volc(vc)
3119	ENDIF
3120	!
3121	!-- Black carbon (BC)
3122	IF ( index_bc > 0 ) THEN
3123	vc = 3
3124	str = ( index_bc-1 ) * nbins_aerosol + 1 + end_subrange_1a
3125	endi = index_bc * nbins_aerosol
3126	ic = 1 + end_subrange_1a
3127	DO ss = str, endi
3128	lo_aero(ic)%volc(vc) = aerosol_mass(ss)%conc(k,j,i) / arhobc
3129	ic = ic+1
3130	ENDDO
3131	aero_old(1:nbins_aerosol)%volc(vc) = lo_aero(1:nbins_aerosol)%volc(vc)
3132	ENDIF
3133	!
3134	!-- Dust (DU)
3135	IF ( index_du > 0 ) THEN
3136	vc = 4
3137	str = ( index_du-1 ) * nbins_aerosol + 1 + end_subrange_1a
3138	endi = index_du * nbins_aerosol
3139	ic = 1 + end_subrange_1a
3140	DO ss = str, endi
3141	lo_aero(ic)%volc(vc) = aerosol_mass(ss)%conc(k,j,i) / arhodu
3142	ic = ic+1
3143	ENDDO
3144	aero_old(1:nbins_aerosol)%volc(vc) = lo_aero(1:nbins_aerosol)%volc(vc)
3145	ENDIF
3146	!
3147	!-- Sea salt (SS)
3148	IF ( index_ss > 0 ) THEN
3149	vc = 5
3150	str = ( index_ss-1 ) * nbins_aerosol + 1 + end_subrange_1a
3151	endi = index_ss * nbins_aerosol
3152	ic = 1 + end_subrange_1a
3153	DO ss = str, endi
3154	lo_aero(ic)%volc(vc) = aerosol_mass(ss)%conc(k,j,i) / arhoss
3155	ic = ic+1
3156	ENDDO
3157	aero_old(1:nbins_aerosol)%volc(vc) = lo_aero(1:nbins_aerosol)%volc(vc)
3158	ENDIF
3159	!
3160	!-- Nitrate (NO(3-)) or nitric acid HNO3
3161	IF ( index_no > 0 ) THEN
3162	vc = 6
3163	str = ( index_no-1 ) * nbins_aerosol + 1
3164	endi = index_no * nbins_aerosol
3165	ic = 1
3166	DO ss = str, endi
3167	lo_aero(ic)%volc(vc) = aerosol_mass(ss)%conc(k,j,i) / arhohno3
3168	ic = ic+1
3169	ENDDO
3170	aero_old(1:nbins_aerosol)%volc(vc) = lo_aero(1:nbins_aerosol)%volc(vc)
3171	ENDIF
3172	!
3173	!-- Ammonium (NH(4+)) or ammonia NH3
3174	IF ( index_nh > 0 ) THEN
3175	vc = 7
3176	str = ( index_nh-1 ) * nbins_aerosol + 1
3177	endi = index_nh * nbins_aerosol
3178	ic = 1
3179	DO ss = str, endi
3180	lo_aero(ic)%volc(vc) = aerosol_mass(ss)%conc(k,j,i) / arhonh3
3181	ic = ic+1
3182	ENDDO
3183	aero_old(1:nbins_aerosol)%volc(vc) = lo_aero(1:nbins_aerosol)%volc(vc)
3184	ENDIF
3185	!
3186	!-- Water (always used)
3187	nc_h2o = get_index( prtcl,'H2O' )
3188	vc = 8
3189	str = ( nc_h2o-1 ) * nbins_aerosol + 1
3190	endi = nc_h2o * nbins_aerosol
3191	ic = 1
3192	IF ( advect_particle_water ) THEN
3193	DO ss = str, endi
3194	lo_aero(ic)%volc(vc) = aerosol_mass(ss)%conc(k,j,i) / arhoh2o
3195	ic = ic+1
3196	ENDDO
3197	ELSE
3198	lo_aero(1:nbins_aerosol)%volc(vc) = mclim
3199	ENDIF
3200	aero_old(1:nbins_aerosol)%volc(vc) = lo_aero(1:nbins_aerosol)%volc(vc)
3201	!
3202	!-- Number concentrations (numc) and particle sizes
3203	!-- (dwet = wet diameter, core = dry volume)
3204	DO ib = 1, nbins_aerosol
3205	lo_aero(ib)%numc = aerosol_number(ib)%conc(k,j,i)
3206	aero_old(ib)%numc = lo_aero(ib)%numc
3207	IF ( lo_aero(ib)%numc > nclim ) THEN
3208	lo_aero(ib)%dwet = ( SUM( lo_aero(ib)%volc(:) ) / lo_aero(ib)%numc / api6 )**0.33333333_wp
3209	lo_aero(ib)%core = SUM( lo_aero(ib)%volc(1:7) ) / lo_aero(ib)%numc
3210	ELSE
3211	lo_aero(ib)%dwet = lo_aero(ib)%dmid
3212	lo_aero(ib)%core = api6 * ( lo_aero(ib)%dwet )**3
3213	ENDIF
3214	ENDDO
3215	!
3216	!-- Calculate the ambient sizes of particles by equilibrating soluble fraction of particles with
3217	!-- water using the ZSR method.
3218	in_rh = in_cw(k) / in_cs(k)
3219	IF ( prunmode==1 .OR. .NOT. advect_particle_water ) THEN
3220	CALL equilibration( in_rh, in_t(k), lo_aero, .TRUE. )
3221	ENDIF
3222	!
3223	!-- Gaseous tracer concentrations in #/m3
3224	IF ( salsa_gases_from_chem ) THEN
3225	!
3226	!-- Convert concentrations in ppm to #/m3
3227	zgso4 = chem_species(gas_index_chem(1))%conc(k,j,i) * ppm_to_nconc(k)
3228	zghno3 = chem_species(gas_index_chem(2))%conc(k,j,i) * ppm_to_nconc(k)
3229	zgnh3 = chem_species(gas_index_chem(3))%conc(k,j,i) * ppm_to_nconc(k)
3230	zgocnv = chem_species(gas_index_chem(4))%conc(k,j,i) * ppm_to_nconc(k)
3231	zgocsv = chem_species(gas_index_chem(5))%conc(k,j,i) * ppm_to_nconc(k)
3232	ELSE
3233	zgso4 = salsa_gas(1)%conc(k,j,i)
3234	zghno3 = salsa_gas(2)%conc(k,j,i)
3235	zgnh3 = salsa_gas(3)%conc(k,j,i)
3236	zgocnv = salsa_gas(4)%conc(k,j,i)
3237	zgocsv = salsa_gas(5)%conc(k,j,i)
3238	ENDIF
3239	!
3240	!-- Calculate aerosol processes:
3241	!-- *********************************************************************************************
3242	!
3243	!-- Coagulation
3244	IF ( lscoag ) THEN
3245	CALL coagulation( lo_aero, dt_salsa, in_t(k), in_p(k) )
3246	ENDIF
3247	!
3248	!-- Condensation
3249	IF ( lscnd ) THEN
3250	CALL condensation( lo_aero, zgso4, zgocnv, zgocsv, zghno3, zgnh3, in_cw(k), in_cs(k), &
3251	in_t(k), in_p(k), dt_salsa, prtcl )
3252	ENDIF
3253	!
3254	!-- Deposition
3255	IF ( lsdepo ) THEN
3256	CALL deposition( lo_aero, in_t(k), in_adn(k), in_u(k), in_lad, kvis(k), schmidt_num(k,:),&
3257	vd(k,:) )
3258	ENDIF
3259	!
3260	!-- Size distribution bin update
3261	IF ( lsdistupdate ) THEN
3262	CALL distr_update( lo_aero )
3263	ENDIF
3264	!-- *********************************************************************************************
3265
3266	IF ( lsdepo ) sedim_vd(k,j,i,:) = vd(k,:)
3267	!
3268	!-- Calculate changes in concentrations
3269	DO ib = 1, nbins_aerosol
3270	aerosol_number(ib)%conc(k,j,i) = aerosol_number(ib)%conc(k,j,i) + ( lo_aero(ib)%numc - &
3271	aero_old(ib)%numc ) * flag
3272	ENDDO
3273
3274	IF ( index_so4 > 0 ) THEN
3275	vc = 1
3276	str = ( index_so4-1 ) * nbins_aerosol + 1
3277	endi = index_so4 * nbins_aerosol
3278	ic = 1
3279	DO ss = str, endi
3280	aerosol_mass(ss)%conc(k,j,i) = aerosol_mass(ss)%conc(k,j,i) + ( lo_aero(ic)%volc(vc) -&
3281	aero_old(ic)%volc(vc) ) * arhoh2so4 * flag
3282	ic = ic+1
3283	ENDDO
3284	ENDIF
3285
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	aerosol_mass(ss)%conc(k,j,i) = aerosol_mass(ss)%conc(k,j,i) + ( lo_aero(ic)%volc(vc) -&
3293	aero_old(ic)%volc(vc) ) * arhooc * flag
3294	ic = ic+1
3295	ENDDO
3296	ENDIF
3297
3298	IF ( index_bc > 0 ) THEN
3299	vc = 3
3300	str = ( index_bc-1 ) * nbins_aerosol + 1 + end_subrange_1a
3301	endi = index_bc * nbins_aerosol
3302	ic = 1 + end_subrange_1a
3303	DO ss = str, endi
3304	aerosol_mass(ss)%conc(k,j,i) = aerosol_mass(ss)%conc(k,j,i) + ( lo_aero(ic)%volc(vc) -&
3305	aero_old(ic)%volc(vc) ) * arhobc * flag
3306	ic = ic+1
3307	ENDDO
3308	ENDIF
3309
3310	IF ( index_du > 0 ) THEN
3311	vc = 4
3312	str = ( index_du-1 ) * nbins_aerosol + 1 + end_subrange_1a
3313	endi = index_du * nbins_aerosol
3314	ic = 1 + end_subrange_1a
3315	DO ss = str, endi
3316	aerosol_mass(ss)%conc(k,j,i) = aerosol_mass(ss)%conc(k,j,i) + ( lo_aero(ic)%volc(vc) -&
3317	aero_old(ic)%volc(vc) ) * arhodu * flag
3318	ic = ic+1
3319	ENDDO
3320	ENDIF
3321
3322	IF ( index_ss > 0 ) THEN
3323	vc = 5
3324	str = ( index_ss-1 ) * nbins_aerosol + 1 + end_subrange_1a
3325	endi = index_ss * nbins_aerosol
3326	ic = 1 + end_subrange_1a
3327	DO ss = str, endi
3328	aerosol_mass(ss)%conc(k,j,i) = aerosol_mass(ss)%conc(k,j,i) + ( lo_aero(ic)%volc(vc) -&
3329	aero_old(ic)%volc(vc) ) * arhoss * flag
3330	ic = ic+1
3331	ENDDO
3332	ENDIF
3333
3334	IF ( index_no > 0 ) THEN
3335	vc = 6
3336	str = ( index_no-1 ) * nbins_aerosol + 1
3337	endi = index_no * nbins_aerosol
3338	ic = 1
3339	DO ss = str, endi
3340	aerosol_mass(ss)%conc(k,j,i) = aerosol_mass(ss)%conc(k,j,i) + ( lo_aero(ic)%volc(vc) -&
3341	aero_old(ic)%volc(vc) ) * arhohno3 * flag
3342	ic = ic+1
3343	ENDDO
3344	ENDIF
3345
3346	IF ( index_nh > 0 ) THEN
3347	vc = 7
3348	str = ( index_nh-1 ) * nbins_aerosol + 1
3349	endi = index_nh * nbins_aerosol
3350	ic = 1
3351	DO ss = str, endi
3352	aerosol_mass(ss)%conc(k,j,i) = aerosol_mass(ss)%conc(k,j,i) + ( lo_aero(ic)%volc(vc) -&
3353	aero_old(ic)%volc(vc) ) * arhonh3 * flag
3354	ic = ic+1
3355	ENDDO
3356	ENDIF
3357
3358	IF ( advect_particle_water ) THEN
3359	nc_h2o = get_index( prtcl,'H2O' )
3360	vc = 8
3361	str = ( nc_h2o-1 ) * nbins_aerosol + 1
3362	endi = nc_h2o * nbins_aerosol
3363	ic = 1
3364	DO ss = str, endi
3365	aerosol_mass(ss)%conc(k,j,i) = aerosol_mass(ss)%conc(k,j,i) + ( lo_aero(ic)%volc(vc) -&
3366	aero_old(ic)%volc(vc) ) * arhoh2o * flag
3367	ic = ic+1
3368	ENDDO
3369	ENDIF
3370	IF ( prunmode == 1 ) THEN
3371	nc_h2o = get_index( prtcl,'H2O' )
3372	vc = 8
3373	str = ( nc_h2o-1 ) * nbins_aerosol + 1
3374	endi = nc_h2o * nbins_aerosol
3375	ic = 1
3376	DO ss = str, endi
3377	aerosol_mass(ss)%init(k) = MAX( aerosol_mass(ss)%init(k), ( lo_aero(ic)%volc(vc) - &
3378	aero_old(ic)%volc(vc) ) * arhoh2o )
3379	IF ( k == nzb+1 ) THEN
3380	aerosol_mass(ss)%init(k-1) = aerosol_mass(ss)%init(k)
3381	ELSEIF ( k == nzt ) THEN
3382	aerosol_mass(ss)%init(k+1) = aerosol_mass(ss)%init(k)
3383	aerosol_mass(ss)%conc(k+1,j,i) = aerosol_mass(ss)%init(k)
3384	ENDIF
3385	ic = ic+1
3386	ENDDO
3387	ENDIF
3388	!
3389	!-- Condensation of precursor gases
3390	IF ( lscndgas ) THEN
3391	IF ( salsa_gases_from_chem ) THEN
3392	!
3393	!-- SO4 (or H2SO4)
3394	ig = gas_index_chem(1)
3395	chem_species(ig)%conc(k,j,i) = chem_species(ig)%conc(k,j,i) + ( zgso4 / &
3396	ppm_to_nconc(k) - chem_species(ig)%conc(k,j,i) ) * flag
3397	!
3398	!-- HNO3
3399	ig = gas_index_chem(2)
3400	chem_species(ig)%conc(k,j,i) = chem_species(ig)%conc(k,j,i) + ( zghno3 / &
3401	ppm_to_nconc(k) - chem_species(ig)%conc(k,j,i) ) * flag
3402	!
3403	!-- NH3
3404	ig = gas_index_chem(3)
3405	chem_species(ig)%conc(k,j,i) = chem_species(ig)%conc(k,j,i) + ( zgnh3 / &
3406	ppm_to_nconc(k) - chem_species(ig)%conc(k,j,i) ) * flag
3407	!
3408	!-- non-volatile OC
3409	ig = gas_index_chem(4)
3410	chem_species(ig)%conc(k,j,i) = chem_species(ig)%conc(k,j,i) + ( zgocnv / &
3411	ppm_to_nconc(k) - chem_species(ig)%conc(k,j,i) ) * flag
3412	!
3413	!-- semi-volatile OC
3414	ig = gas_index_chem(5)
3415	chem_species(ig)%conc(k,j,i) = chem_species(ig)%conc(k,j,i) + ( zgocsv / &
3416	ppm_to_nconc(k) - chem_species(ig)%conc(k,j,i) ) * flag
3417
3418	ELSE
3419	!
3420	!-- SO4 (or H2SO4)
3421	salsa_gas(1)%conc(k,j,i) = salsa_gas(1)%conc(k,j,i) + ( zgso4 - &
3422	salsa_gas(1)%conc(k,j,i) ) * flag
3423	!
3424	!-- HNO3
3425	salsa_gas(2)%conc(k,j,i) = salsa_gas(2)%conc(k,j,i) + ( zghno3 - &
3426	salsa_gas(2)%conc(k,j,i) ) * flag
3427	!
3428	!-- NH3
3429	salsa_gas(3)%conc(k,j,i) = salsa_gas(3)%conc(k,j,i) + ( zgnh3 - &
3430	salsa_gas(3)%conc(k,j,i) ) * flag
3431	!
3432	!-- non-volatile OC
3433	salsa_gas(4)%conc(k,j,i) = salsa_gas(4)%conc(k,j,i) + ( zgocnv - &
3434	salsa_gas(4)%conc(k,j,i) ) * flag
3435	!
3436	!-- semi-volatile OC
3437	salsa_gas(5)%conc(k,j,i) = salsa_gas(5)%conc(k,j,i) + ( zgocsv - &
3438	salsa_gas(5)%conc(k,j,i) ) * flag
3439	ENDIF
3440	ENDIF
3441	!
3442	!-- Tendency of water vapour mixing ratio is obtained from the change in RH during SALSA run.
3443	!-- This releases heat and changes pt. Assumes no temperature change during SALSA run.
3444	!-- q = r / (1+r), Euler method for integration
3445	!
3446	IF ( feedback_to_palm ) THEN
3447	q_p(k,j,i) = q_p(k,j,i) + 1.0_wp / ( in_cw(k) * in_adn(k) + 1.0_wp )*2 &
3448	( in_cw(k) - cw_old ) * in_adn(k) * flag
3449	pt_p(k,j,i) = pt_p(k,j,i) + alv / c_p * ( in_cw(k) - cw_old ) * in_adn(k) / ( in_cw(k) / &
3450	in_adn(k) + 1.0_wp )*2 pt_p(k,j,i) / in_t(k) * flag
3451	ENDIF
3452
3453	ENDDO ! k
3454
3455	!
3456	!-- Set surfaces and wall fluxes due to deposition
3457	IF ( lsdepo .AND. lsdepo_surf .AND. prunmode == 3 ) THEN
3458	IF ( .NOT. land_surface .AND. .NOT. urban_surface ) THEN
3459	CALL depo_surf( i, j, surf_def_h(0), vd, schmidt_num, kvis, in_u, .TRUE. )
3460	DO l = 0, 3
3461	CALL depo_surf( i, j, surf_def_v(l), vd, schmidt_num, kvis, in_u, .FALSE. )
3462	ENDDO
3463	ELSE
3464	CALL depo_surf( i, j, surf_usm_h, vd, schmidt_num, kvis, in_u, .TRUE., usm_to_depo_h )
3465	DO l = 0, 3
3466	CALL depo_surf( i, j, surf_usm_v(l), vd, schmidt_num, kvis, in_u, .FALSE., &
3467	usm_to_depo_v(l) )
3468	ENDDO
3469	CALL depo_surf( i, j, surf_lsm_h, vd, schmidt_num, kvis, in_u, .TRUE., lsm_to_depo_h )
3470	DO l = 0, 3
3471	CALL depo_surf( i, j, surf_lsm_v(l), vd, schmidt_num, kvis, in_u, .FALSE., &
3472	lsm_to_depo_v(l) )
3473	ENDDO
3474	ENDIF
3475	ENDIF
3476
3477	IF ( prunmode < 3 ) THEN
3478	!$OMP MASTER
3479	aero = lo_aero
3480	!$OMP END MASTER
3481	END IF
3482
3483	END SUBROUTINE salsa_driver
3484
3485	!------------------------------------------------------------------------------!
3486	! Description:
3487	! ------------
3488	!> Set logical switches according to the salsa_parameters options.
3489	!> Juha Tonttila, FMI, 2014
3490	!> Only aerosol processes included, Mona Kurppa, UHel, 2017
3491	!------------------------------------------------------------------------------!
3492	SUBROUTINE set_salsa_runtime( prunmode )
3493
3494	IMPLICIT NONE
3495
3496	INTEGER(iwp), INTENT(in) :: prunmode
3497
3498	SELECT CASE(prunmode)
3499
3500	CASE(1) !< Initialization
3501	lscoag = .FALSE.
3502	lscnd = .FALSE.
3503	lscndgas = .FALSE.
3504	lscndh2oae = .FALSE.
3505	lsdepo = .FALSE.
3506	lsdepo_pcm = .FALSE.
3507	lsdepo_surf = .FALSE.
3508	lsdistupdate = .TRUE.
3509	lspartition = .FALSE.
3510
3511	CASE(2) !< Spinup period
3512	lscoag = ( .FALSE. .AND. nlcoag )
3513	lscnd = ( .TRUE. .AND. nlcnd )
3514	lscndgas = ( .TRUE. .AND. nlcndgas )
3515	lscndh2oae = ( .TRUE. .AND. nlcndh2oae )
3516
3517	CASE(3) !< Run
3518	lscoag = nlcoag
3519	lscnd = nlcnd
3520	lscndgas = nlcndgas
3521	lscndh2oae = nlcndh2oae
3522	lsdepo = nldepo
3523	lsdepo_pcm = nldepo_pcm
3524	lsdepo_surf = nldepo_surf
3525	lsdistupdate = nldistupdate
3526	END SELECT
3527
3528
3529	END SUBROUTINE set_salsa_runtime
3530
3531	!------------------------------------------------------------------------------!
3532	! Description:
3533	! ------------
3534	!> Calculates the absolute temperature (using hydrostatic pressure), saturation
3535	!> vapour pressure and mixing ratio over water, relative humidity and air
3536	!> density needed in the SALSA model.
3537	!> NOTE, no saturation adjustment takes place -> the resulting water vapour
3538	!> mixing ratio can be supersaturated, allowing the microphysical calculations
3539	!> in SALSA.
3540	!
3541	!> Juha Tonttila, FMI, 2014 (original SALSAthrm)
3542	!> Mona Kurppa, UHel, 2017 (adjustment for PALM and only aerosol processes)
3543	!------------------------------------------------------------------------------!
3544	SUBROUTINE salsa_thrm_ij( i, j, p_ij, temp_ij, cw_ij, cs_ij, adn_ij )
3545
3546	USE arrays_3d, &
3547	ONLY: pt, q, zu
3548
3549	USE basic_constants_and_equations_mod, &
3550	ONLY: barometric_formula, exner_function, ideal_gas_law_rho, magnus
3551
3552	IMPLICIT NONE
3553
3554	INTEGER(iwp), INTENT(in) :: i !<
3555	INTEGER(iwp), INTENT(in) :: j !<
3556
3557	REAL(wp) :: t_surface !< absolute surface temperature (K)
3558
3559	REAL(wp), DIMENSION(nzb:nzt+1) :: e_s !< saturation vapour pressure over water (Pa)
3560
3561	REAL(wp), DIMENSION(:), INTENT(inout) :: adn_ij !< air density (kg/m3)
3562	REAL(wp), DIMENSION(:), INTENT(inout) :: p_ij !< air pressure (Pa)
3563	REAL(wp), DIMENSION(:), INTENT(inout) :: temp_ij !< air temperature (K)
3564
3565	REAL(wp), DIMENSION(:), INTENT(inout), OPTIONAL :: cw_ij !< water vapour concentration (kg/m3)
3566	REAL(wp), DIMENSION(:), INTENT(inout), OPTIONAL :: cs_ij !< saturation water vap. conc.(kg/m3)
3567	!
3568	!-- Pressure p_ijk (Pa) = hydrostatic pressure
3569	t_surface = pt_surface * exner_function( surface_pressure * 100.0_wp )
3570	p_ij(:) = barometric_formula( zu, t_surface, surface_pressure * 100.0_wp )
3571	!
3572	!-- Absolute ambient temperature (K)
3573	temp_ij(:) = pt(:,j,i) * exner_function( p_ij(:) )
3574	!
3575	!-- Air density
3576	adn_ij(:) = ideal_gas_law_rho( p_ij(:), temp_ij(:) )
3577	!
3578	!-- Water vapour concentration r_v (kg/m3)
3579	IF ( PRESENT( cw_ij ) ) THEN
3580	cw_ij(:) = ( q(:,j,i) / ( 1.0_wp - q(:,j,i) ) ) * adn_ij(:)
3581	ENDIF
3582	!
3583	!-- Saturation mixing ratio r_s (kg/kg) from vapour pressure at temp (Pa)
3584	IF ( PRESENT( cs_ij ) ) THEN
3585	e_s(:) = 611.0_wp * EXP( alv_d_rv * ( 3.6609E-3_wp - 1.0_wp / &
3586	temp_ij(:) ) )! magnus( temp_ij(:) )
3587	cs_ij(:) = ( 0.622_wp * e_s / ( p_ij(:) - e_s(:) ) ) * adn_ij(:)
3588	ENDIF
3589
3590	END SUBROUTINE salsa_thrm_ij
3591
3592	!------------------------------------------------------------------------------!
3593	! Description:
3594	! ------------
3595	!> Calculates ambient sizes of particles by equilibrating soluble fraction of
3596	!> particles with water using the ZSR method (Stokes and Robinson, 1966).
3597	!> Method:
3598	!> Following chemical components are assumed water-soluble
3599	!> - (ammonium) sulphate (100%)
3600	!> - sea salt (100 %)
3601	!> - organic carbon (epsoc * 100%)
3602	!> Exact thermodynamic considerations neglected.
3603	!> - If particles contain no sea salt, calculation according to sulphate
3604	!> properties
3605	!> - If contain sea salt but no sulphate, calculation according to sea salt
3606	!> properties
3607	!> - If contain both sulphate and sea salt -> the molar fraction of these
3608	!> compounds determines which one of them is used as the basis of calculation.
3609	!> If sulphate and sea salt coexist in a particle, it is assumed that the Cl is
3610	!> replaced by sulphate; thus only either sulphate + organics or sea salt +
3611	!> organics is included in the calculation of soluble fraction.
3612	!> Molality parameterizations taken from Table 1 of Tang: Thermodynamic and
3613	!> optical properties of mixed-salt aerosols of atmospheric importance,
3614	!> J. Geophys. Res., 102 (D2), 1883-1893 (1997)
3615	!
3616	!> Coded by:
3617	!> Hannele Korhonen (FMI) 2005
3618	!> Harri Kokkola (FMI) 2006
3619	!> Matti Niskanen(FMI) 2012
3620	!> Anton Laakso (FMI) 2013
3621	!> Modified for the new aerosol datatype, Juha Tonttila (FMI) 2014
3622	!
3623	!> fxm: should sea salt form a solid particle when prh is very low (even though
3624	!> it could be mixed with e.g. sulphate)?
3625	!> fxm: crashes if no sulphate or sea salt
3626	!> fxm: do we really need to consider Kelvin effect for subrange 2
3627	!------------------------------------------------------------------------------!
3628	SUBROUTINE equilibration( prh, ptemp, paero, init )
3629
3630	IMPLICIT NONE
3631
3632	INTEGER(iwp) :: ib !< loop index
3633	INTEGER(iwp) :: counti !< loop index
3634
3635	LOGICAL, INTENT(in) :: init !< TRUE: Initialization, FALSE: Normal runtime: update water
3636	!< content only for 1a
3637
3638	REAL(wp) :: zaw !< water activity [0-1]
3639	REAL(wp) :: zcore !< Volume of dry particle
3640	REAL(wp) :: zdold !< Old diameter
3641	REAL(wp) :: zdwet !< Wet diameter or mean droplet diameter
3642	REAL(wp) :: zke !< Kelvin term in the KÃ¶hler equation
3643	REAL(wp) :: zlwc !< liquid water content [kg/m3-air]
3644	REAL(wp) :: zrh !< Relative humidity
3645
3646	REAL(wp), DIMENSION(maxspec) :: zbinmol !< binary molality of each components (mol/kg)
3647	REAL(wp), DIMENSION(maxspec) :: zvpart !< volume of chem. compounds in one particle
3648
3649	REAL(wp), INTENT(in) :: prh !< relative humidity [0-1]
3650	REAL(wp), INTENT(in) :: ptemp !< temperature (K)
3651
3652	TYPE(t_section), DIMENSION(nbins_aerosol), INTENT(inout) :: paero !< aerosol properties
3653
3654	zaw = 0.0_wp
3655	zlwc = 0.0_wp
3656	!
3657	!-- Relative humidity:
3658	zrh = prh
3659	zrh = MAX( zrh, 0.05_wp )
3660	zrh = MIN( zrh, 0.98_wp)
3661	!
3662	!-- 1) Regime 1: sulphate and partly water-soluble OC. Done for every CALL
3663	DO ib = start_subrange_1a, end_subrange_1a ! size bin
3664
3665	zbinmol = 0.0_wp
3666	zdold = 1.0_wp
3667	zke = 1.02_wp
3668
3669	IF ( paero(ib)%numc > nclim ) THEN
3670	!
3671	!-- Volume in one particle
3672	zvpart = 0.0_wp
3673	zvpart(1:2) = paero(ib)%volc(1:2) / paero(ib)%numc
3674	zvpart(6:7) = paero(ib)%volc(6:7) / paero(ib)%numc
3675	!
3676	!-- Total volume and wet diameter of one dry particle
3677	zcore = SUM( zvpart(1:2) )
3678	zdwet = paero(ib)%dwet
3679
3680	counti = 0
3681	DO WHILE ( ABS( zdwet / zdold - 1.0_wp ) > 1.0E-2_wp )
3682
3683	zdold = MAX( zdwet, 1.0E-20_wp )
3684	zaw = MAX( 1.0E-3_wp, zrh / zke ) ! To avoid underflow
3685	!
3686	!-- Binary molalities (mol/kg):
3687	!-- Sulphate
3688	zbinmol(1) = 1.1065495E+2_wp - 3.6759197E+2_wp * zaw + 5.0462934E+2_wp * zaw**2 - &
3689	3.1543839E+2_wp * zaw*3 + 6.770824E+1_wp zaw**4
3690	!-- Organic carbon
3691	zbinmol(2) = 1.0_wp / ( zaw * amh2o ) - 1.0_wp / amh2o
3692	!-- Nitric acid
3693	zbinmol(6) = 2.306844303E+1_wp - 3.563608869E+1_wp * zaw - 6.210577919E+1_wp * zaw**2 &
3694	+ 5.510176187E+2_wp * zaw*3 - 1.460055286E+3_wp zaw**4 &
3695	+ 1.894467542E+3_wp * zaw*5 - 1.220611402E+3_wp zaw**6 &
3696	+ 3.098597737E+2_wp * zaw**7
3697	!
3698	!-- Calculate the liquid water content (kg/m3-air) using ZSR (see e.g. Eq. 10.98 in
3699	!-- Seinfeld and Pandis (2006))
3700	zlwc = ( paero(ib)%volc(1) * ( arhoh2so4 / amh2so4 ) ) / zbinmol(1) + &
3701	epsoc * paero(ib)%volc(2) * ( arhooc / amoc ) / zbinmol(2) + &
3702	( paero(ib)%volc(6) * ( arhohno3/amhno3 ) ) / zbinmol(6)
3703	!
3704	!-- Particle wet diameter (m)
3705	zdwet = ( zlwc / paero(ib)%numc / arhoh2o / api6 + ( SUM( zvpart(6:7) ) / api6 ) + &
3706	zcore / api6 )**0.33333333_wp
3707	!
3708	!-- Kelvin effect (Eq. 10.85 in in Seinfeld and Pandis (2006)). Avoid
3709	!-- overflow.
3710	zke = EXP( MIN( 50.0_wp, 4.0_wp * surfw0 * amvh2so4 / ( abo * ptemp * zdwet ) ) )
3711
3712	counti = counti + 1
3713	IF ( counti > 1000 ) THEN
3714	message_string = 'Subrange 1: no convergence!'
3715	CALL message( 'salsa_mod: equilibration', 'PA0617', 1, 2, 0, 6, 0 )
3716	ENDIF
3717	ENDDO
3718	!
3719	!-- Instead of lwc, use the volume concentration of water from now on
3720	!-- (easy to convert...)
3721	paero(ib)%volc(8) = zlwc / arhoh2o
3722	!
3723	!-- If this is initialization, update the core and wet diameter
3724	IF ( init ) THEN
3725	paero(ib)%dwet = zdwet
3726	paero(ib)%core = zcore
3727	ENDIF
3728
3729	ELSE
3730	!-- If initialization
3731	!-- 1.2) empty bins given bin average values
3732	IF ( init ) THEN
3733	paero(ib)%dwet = paero(ib)%dmid
3734	paero(ib)%core = api6 * paero(ib)%dmid**3
3735	ENDIF
3736
3737	ENDIF
3738
3739	ENDDO ! ib
3740	!
3741	!-- 2) Regime 2a: sulphate, OC, BC and sea salt
3742	!-- This is done only for initialization call, otherwise the water contents
3743	!-- are computed via condensation
3744	IF ( init ) THEN
3745	DO ib = start_subrange_2a, end_subrange_2b
3746	!
3747	!-- Initialize
3748	zke = 1.02_wp
3749	zbinmol = 0.0_wp
3750	zdold = 1.0_wp
3751	!
3752	!-- 1) Particle properties calculated for non-empty bins
3753	IF ( paero(ib)%numc > nclim ) THEN
3754	!
3755	!-- Volume in one particle [fxm]
3756	zvpart = 0.0_wp
3757	zvpart(1:7) = paero(ib)%volc(1:7) / paero(ib)%numc
3758	!
3759	!-- Total volume and wet diameter of one dry particle [fxm]
3760	zcore = SUM( zvpart(1:5) )
3761	zdwet = paero(ib)%dwet
3762
3763	counti = 0
3764	DO WHILE ( ABS( zdwet / zdold - 1.0_wp ) > 1.0E-12_wp )
3765
3766	zdold = MAX( zdwet, 1.0E-20_wp )
3767	zaw = zrh / zke
3768	!
3769	!-- Binary molalities (mol/kg):
3770	!-- Sulphate
3771	zbinmol(1) = 1.1065495E+2_wp - 3.6759197E+2_wp * zaw + 5.0462934E+2_wp * zaw**2 - &
3772	3.1543839E+2_wp * zaw*3 + 6.770824E+1_wp zaw**4
3773	!-- Organic carbon
3774	zbinmol(2) = 1.0_wp / ( zaw * amh2o ) - 1.0_wp / amh2o
3775	!-- Nitric acid
3776	zbinmol(6) = 2.306844303E+1_wp - 3.563608869E+1_wp * zaw - &
3777	6.210577919E+1_wp * zaw*2 + 5.510176187E+2_wp zaw**3 - &
3778	1.460055286E+3_wp * zaw*4 + 1.894467542E+3_wp zaw**5 - &
3779	1.220611402E+3_wp * zaw*6 + 3.098597737E+2_wp zaw**7
3780	!-- Sea salt (natrium chloride)
3781	zbinmol(5) = 5.875248E+1_wp - 1.8781997E+2_wp * zaw + 2.7211377E+2_wp * zaw**2 - &
3782	1.8458287E+2_wp * zaw*3 + 4.153689E+1_wp zaw**4
3783	!
3784	!-- Calculate the liquid water content (kg/m3-air)
3785	zlwc = ( paero(ib)%volc(1) * ( arhoh2so4 / amh2so4 ) ) / zbinmol(1) + &
3786	epsoc * ( paero(ib)%volc(2) * ( arhooc / amoc ) ) / zbinmol(2) + &
3787	( paero(ib)%volc(6) * ( arhohno3 / amhno3 ) ) / zbinmol(6) + &
3788	( paero(ib)%volc(5) * ( arhoss / amss ) ) / zbinmol(5)
3789
3790	!-- Particle wet radius (m)
3791	zdwet = ( zlwc / paero(ib)%numc / arhoh2o / api6 + ( SUM( zvpart(6:7) ) / api6 ) + &
3792	zcore / api6 )**0.33333333_wp
3793	!
3794	!-- Kelvin effect (Eq. 10.85 in Seinfeld and Pandis (2006))
3795	zke = EXP( MIN( 50.0_wp, 4.0_wp * surfw0 * amvh2so4 / ( abo * zdwet * ptemp ) ) )
3796
3797	counti = counti + 1
3798	IF ( counti > 1000 ) THEN
3799	message_string = 'Subrange 2: no convergence!'
3800	CALL message( 'salsa_mod: equilibration', 'PA0618', 1, 2, 0, 6, 0 )
3801	ENDIF
3802	ENDDO
3803	!
3804	!-- Liquid water content; instead of LWC use the volume concentration
3805	paero(ib)%volc(8) = zlwc / arhoh2o
3806	paero(ib)%dwet = zdwet
3807	paero(ib)%core = zcore
3808
3809	ELSE
3810	!-- 2.2) empty bins given bin average values
3811	paero(ib)%dwet = paero(ib)%dmid
3812	paero(ib)%core = api6 * paero(ib)%dmid**3
3813	ENDIF
3814
3815	ENDDO ! ib
3816	ENDIF
3817
3818	END SUBROUTINE equilibration
3819
3820	!------------------------------------------------------------------------------!
3821	!> Description:
3822	!> ------------
3823	!> Calculation of the settling velocity vc (m/s) per aerosol size bin and
3824	!> deposition on plant canopy (lsdepo_pcm).
3825	!
3826	!> Deposition is based on either the scheme presented in:
3827	!> Zhang et al. (2001), Atmos. Environ. 35, 549-560 (includes collection due to
3828	!> Brownian diffusion, impaction, interception and sedimentation; hereafter ZO1)
3829	!> OR
3830	!> Petroff & Zhang (2010), Geosci. Model Dev. 3, 753-769 (includes also
3831	!> collection due to turbulent impaction, hereafter P10)
3832	!
3833	!> Equation numbers refer to equation in Jacobson (2005): Fundamentals of
3834	!> Atmospheric Modeling, 2nd Edition.
3835	!
3836	!> Subroutine follows closely sedim_SALSA in UCLALES-SALSA written by Juha
3837	!> Tonttila (KIT/FMI) and Zubair Maalick (UEF).
3838	!> Rewritten to PALM by Mona Kurppa (UH), 2017.
3839	!
3840	!> Call for grid point i,j,k
3841	!------------------------------------------------------------------------------!
3842
3843	SUBROUTINE deposition( paero, tk, adn, mag_u, lad, kvis, schmidt_num, vc )
3844
3845	USE plant_canopy_model_mod, &
3846	ONLY: canopy_drag_coeff
3847
3848	IMPLICIT NONE
3849
3850	INTEGER(iwp) :: ib !< loop index
3851	INTEGER(iwp) :: ic !< loop index
3852
3853	REAL(wp) :: alpha !< parameter, Table 3 in Z01
3854	REAL(wp) :: avis !< molecular viscocity of air (kg/(m*s))
3855	REAL(wp) :: beta_im !< parameter for turbulent impaction
3856	REAL(wp) :: c_brownian_diff !< coefficient for Brownian diffusion
3857	REAL(wp) :: c_impaction !< coefficient for inertial impaction
3858	REAL(wp) :: c_interception !< coefficient for interception
3859	REAL(wp) :: c_turb_impaction !< coefficient for turbulent impaction
3860	REAL(wp) :: depo !< deposition velocity (m/s)
3861	REAL(wp) :: gamma !< parameter, Table 3 in Z01
3862	REAL(wp) :: lambda !< molecular mean free path (m)
3863	REAL(wp) :: mdiff !< particle diffusivity coefficient
3864	REAL(wp) :: par_a !< parameter A for the characteristic radius of collectors,
3865	!< Table 3 in Z01
3866	REAL(wp) :: par_l !< obstacle characteristic dimension in P10
3867	REAL(wp) :: pdn !< particle density (kg/m3)
3868	REAL(wp) :: ustar !< friction velocity (m/s)
3869	REAL(wp) :: va !< thermal speed of an air molecule (m/s)
3870
3871	REAL(wp), INTENT(in) :: adn !< air density (kg/m3)
3872	REAL(wp), INTENT(in) :: lad !< leaf area density (m2/m3)
3873	REAL(wp), INTENT(in) :: mag_u !< wind velocity (m/s)
3874	REAL(wp), INTENT(in) :: tk !< abs.temperature (K)
3875
3876	REAL(wp), INTENT(inout) :: kvis !< kinematic viscosity of air (m2/s)
3877
3878	REAL(wp), DIMENSION(nbins_aerosol) :: beta !< Cunningham slip-flow correction factor
3879	REAL(wp), DIMENSION(nbins_aerosol) :: Kn !< Knudsen number
3880	REAL(wp), DIMENSION(nbins_aerosol) :: zdwet !< wet diameter (m)
3881
3882	REAL(wp), DIMENSION(:), INTENT(inout) :: schmidt_num !< particle Schmidt number
3883	REAL(wp), DIMENSION(:), INTENT(inout) :: vc !< critical fall speed i.e. settling velocity of
3884	!< an aerosol particle (m/s)
3885
3886	TYPE(t_section), DIMENSION(nbins_aerosol), INTENT(inout) :: paero !< aerosol properties
3887	!
3888	!-- Initialise
3889	depo = 0.0_wp
3890	pdn = 1500.0_wp ! default value
3891	ustar = 0.0_wp
3892	!
3893	!-- Molecular viscosity of air (Eq. 4.54)
3894	avis = 1.8325E-5_wp * ( 416.16_wp / ( tk + 120.0_wp ) ) * ( tk / 296.16_wp )**1.5_wp
3895	!
3896	!-- Kinematic viscosity (Eq. 4.55)
3897	kvis = avis / adn
3898	!
3899	!-- Thermal velocity of an air molecule (Eq. 15.32)
3900	va = SQRT( 8.0_wp * abo * tk / ( pi * am_airmol ) )
3901	!
3902	!-- Mean free path (m) (Eq. 15.24)
3903	lambda = 2.0_wp * avis / ( adn * va )
3904	!
3905	!-- Particle wet diameter (m)
3906	zdwet = paero(:)%dwet
3907	!
3908	!-- Knudsen number (Eq. 15.23)
3909	Kn = MAX( 1.0E-2_wp, lambda / ( zdwet * 0.5_wp ) ) ! To avoid underflow
3910	!
3911	!-- Cunningham slip-flow correction (Eq. 15.30)
3912	beta = 1.0_wp + Kn * ( 1.249_wp + 0.42_wp * EXP( -0.87_wp / Kn ) )
3913	!
3914	!-- Critical fall speed i.e. settling velocity (Eq. 20.4)
3915	vc = MIN( 1.0_wp, zdwet*2 ( pdn - adn ) * g * beta / ( 18.0_wp * avis ) )
3916	!
3917	!-- Deposition on vegetation
3918	IF ( lsdepo_pcm .AND. plant_canopy .AND. lad > 0.0_wp ) THEN
3919	!
3920	!-- Parameters for the land use category 'deciduous broadleaf trees'(Table 3)
3921	alpha = alpha_z01(depo_pcm_type_num)
3922	gamma = gamma_z01(depo_pcm_type_num)
3923	par_a = A_z01(depo_pcm_type_num, season_z01) * 1.0E-3_wp
3924	!
3925	!-- Deposition efficiencies from Table 1. Constants from Table 2.
3926	par_l = l_p10(depo_pcm_type_num) * 0.01_wp
3927	c_brownian_diff = c_b_p10(depo_pcm_type_num)
3928	c_interception = c_in_p10(depo_pcm_type_num)
3929	c_impaction = c_im_p10(depo_pcm_type_num)
3930	beta_im = beta_im_p10(depo_pcm_type_num)
3931	c_turb_impaction = c_it_p10(depo_pcm_type_num)
3932
3933	DO ib = 1, nbins_aerosol
3934
3935	IF ( paero(ib)%numc < ( 2.0_wp * nclim ) ) CYCLE
3936
3937	!-- Particle diffusivity coefficient (Eq. 15.29)
3938	mdiff = ( abo * tk * beta(ib) ) / ( 3.0_wp * pi * avis * zdwet(ib) )
3939	!
3940	!-- Particle Schmidt number (Eq. 15.36)
3941	schmidt_num(ib) = kvis / mdiff
3942	!
3943	!-- Friction velocity for deposition on vegetation. Calculated following Prandtl (1925):
3944	ustar = SQRT( canopy_drag_coeff ) * mag_u
3945	SELECT CASE ( depo_pcm_par_num )
3946
3947	CASE ( 1 ) ! Zhang et al. (2001)
3948	CALL depo_vel_Z01( vc(ib), ustar, schmidt_num(ib), paero(ib)%dwet, alpha, gamma, &
3949	par_a, depo )
3950	CASE ( 2 ) ! Petroff & Zhang (2010)
3951	CALL depo_vel_P10( vc(ib), mag_u, ustar, kvis, schmidt_num(ib), paero(ib)%dwet, &
3952	par_l, c_brownian_diff, c_interception, c_impaction, beta_im, &
3953	c_turb_impaction, depo )
3954	END SELECT
3955	!
3956	!-- Calculate the change in concentrations
3957	paero(ib)%numc = paero(ib)%numc - depo * lad * paero(ib)%numc * dt_salsa
3958	DO ic = 1, maxspec+1
3959	paero(ib)%volc(ic) = paero(ib)%volc(ic) - depo * lad * paero(ib)%volc(ic) * dt_salsa
3960	ENDDO
3961	ENDDO
3962
3963	ENDIF
3964
3965	END SUBROUTINE deposition
3966
3967	!------------------------------------------------------------------------------!
3968	! Description:
3969	! ------------
3970	!> Calculate deposition velocity (m/s) based on Zhan et al. (2001, case 1).
3971	!------------------------------------------------------------------------------!
3972
3973	SUBROUTINE depo_vel_Z01( vc, ustar, schmidt_num, diameter, alpha, gamma, par_a, depo )
3974
3975	IMPLICIT NONE
3976
3977	REAL(wp) :: rs !< overall quasi-laminar resistance for particles
3978	REAL(wp) :: stokes_num !< Stokes number for smooth or bluff surfaces
3979
3980	REAL(wp), INTENT(in) :: alpha !< parameter, Table 3 in Z01
3981	REAL(wp), INTENT(in) :: gamma !< parameter, Table 3 in Z01
3982	REAL(wp), INTENT(in) :: par_a !< parameter A for the characteristic diameter of
3983	!< collectors, Table 3 in Z01
3984	REAL(wp), INTENT(in) :: diameter !< particle diameter
3985	REAL(wp), INTENT(in) :: schmidt_num !< particle Schmidt number
3986	REAL(wp), INTENT(in) :: ustar !< friction velocity (m/s)
3987	REAL(wp), INTENT(in) :: vc !< terminal velocity (m/s)
3988
3989	REAL(wp), INTENT(inout) :: depo !< deposition efficiency (m/s)
3990
3991	IF ( par_a > 0.0_wp ) THEN
3992	!
3993	!-- Initialise
3994	rs = 0.0_wp
3995	!
3996	!-- Stokes number for vegetated surfaces (Seinfeld & Pandis (2006): Eq.19.24)
3997	stokes_num = vc * ustar / ( g * par_a )
3998	!
3999	!-- The overall quasi-laminar resistance for particles (Zhang et al., Eq. 5)
4000	rs = MAX( EPSILON( 1.0_wp ), ( 3.0_wp * ustar * EXP( -stokes_num*0.5_wp ) &
4001	( schmidt_num( -gamma ) + ( stokes_num / ( alpha + stokes_num ) )2 + &
4002	0.5_wp * ( diameter / par_a )**2 ) ) )
4003
4004	depo = rs + vc
4005
4006	ELSE
4007	depo = 0.0_wp
4008	ENDIF
4009
4010	END SUBROUTINE depo_vel_Z01
4011
4012	!------------------------------------------------------------------------------!
4013	! Description:
4014	! ------------
4015	!> Calculate deposition velocity (m/s) based on Petroff & Zhang (2010, case 2).
4016	!------------------------------------------------------------------------------!
4017
4018	SUBROUTINE depo_vel_P10( vc, mag_u, ustar, kvis_a, schmidt_num, diameter, par_l, c_brownian_diff, &
4019	c_interception, c_impaction, beta_im, c_turb_impaction, depo )
4020
4021	IMPLICIT NONE
4022
4023	REAL(wp) :: stokes_num !< Stokes number for smooth or bluff surfaces
4024	REAL(wp) :: tau_plus !< dimensionless particle relaxation time
4025	REAL(wp) :: v_bd !< deposition velocity due to Brownian diffusion
4026	REAL(wp) :: v_im !< deposition velocity due to impaction
4027	REAL(wp) :: v_in !< deposition velocity due to interception
4028	REAL(wp) :: v_it !< deposition velocity due to turbulent impaction
4029
4030	REAL(wp), INTENT(in) :: beta_im !< parameter for turbulent impaction
4031	REAL(wp), INTENT(in) :: c_brownian_diff !< coefficient for Brownian diffusion
4032	REAL(wp), INTENT(in) :: c_impaction !< coefficient for inertial impaction
4033	REAL(wp), INTENT(in) :: c_interception !< coefficient for interception
4034	REAL(wp), INTENT(in) :: c_turb_impaction !< coefficient for turbulent impaction
4035	REAL(wp), INTENT(in) :: kvis_a !< kinematic viscosity of air (m2/s)
4036	REAL(wp), INTENT(in) :: mag_u !< wind velocity (m/s)
4037	REAL(wp), INTENT(in) :: par_l !< obstacle characteristic dimension in P10
4038	REAL(wp), INTENT(in) :: diameter !< particle diameter
4039	REAL(wp), INTENT(in) :: schmidt_num !< particle Schmidt number
4040	REAL(wp), INTENT(in) :: ustar !< friction velocity (m/s)
4041	REAL(wp), INTENT(in) :: vc !< terminal velocity (m/s)
4042
4043	REAL(wp), INTENT(inout) :: depo !< deposition efficiency (m/s)
4044
4045	IF ( par_l > 0.0_wp ) THEN
4046	!
4047	!-- Initialise
4048	tau_plus = 0.0_wp
4049	v_bd = 0.0_wp
4050	v_im = 0.0_wp
4051	v_in = 0.0_wp
4052	v_it = 0.0_wp
4053	!
4054	!-- Stokes number for vegetated surfaces (Seinfeld & Pandis (2006): Eq.19.24)
4055	stokes_num = vc * ustar / ( g * par_l )
4056	!
4057	!-- Non-dimensional relexation time of the particle on top of canopy
4058	tau_plus = vc * ustar*2 / ( kvis_a g )
4059	!
4060	!-- Brownian diffusion
4061	v_bd = mag_u * c_brownian_diff * schmidt_num*( -0.66666666_wp ) &
4062	( mag_u * par_l / kvis_a )**( -0.5_wp )
4063	!
4064	!-- Interception
4065	v_in = mag_u * c_interception * diameter / par_l * &
4066	( 2.0_wp + LOG( 2.0_wp * par_l / diameter ) )
4067	!
4068	!-- Impaction: Petroff (2009) Eq. 18
4069	v_im = mag_u * c_impaction * ( stokes_num / ( stokes_num + beta_im ) )**2
4070	!
4071	!-- Turbulent impaction
4072	IF ( tau_plus < 20.0_wp ) THEN
4073	v_it = 2.5E-3_wp * c_turb_impaction * tau_plus**2
4074	ELSE
4075	v_it = c_turb_impaction
4076	ENDIF
4077
4078	depo = ( v_bd + v_in + v_im + v_it + vc )
4079
4080	ELSE
4081	depo = 0.0_wp
4082	ENDIF
4083
4084	END SUBROUTINE depo_vel_P10
4085
4086	!------------------------------------------------------------------------------!
4087	! Description:
4088	! ------------
4089	!> Calculate the dry deposition on horizontal and vertical surfaces. Implement
4090	!> as a surface flux.
4091	!> @todo aerodynamic resistance ignored for now (not important for
4092	! high-resolution simulations)
4093	!------------------------------------------------------------------------------!
4094	SUBROUTINE depo_surf( i, j, surf, vc, schmidt_num, kvis, mag_u, norm, match_array )
4095
4096	USE arrays_3d, &
4097	ONLY: rho_air_zw
4098
4099	USE surface_mod, &
4100	ONLY: ind_pav_green, ind_veg_wall, ind_wat_win, surf_type
4101
4102	IMPLICIT NONE
4103
4104	INTEGER(iwp) :: ib !< loop index
4105	INTEGER(iwp) :: ic !< loop index
4106	INTEGER(iwp) :: icc !< additional loop index
4107	INTEGER(iwp) :: k !< loop index
4108	INTEGER(iwp) :: m !< loop index
4109	INTEGER(iwp) :: surf_e !< End index of surface elements at (j,i)-gridpoint
4110	INTEGER(iwp) :: surf_s !< Start index of surface elements at (j,i)-gridpoint
4111
4112	INTEGER(iwp), INTENT(in) :: i !< loop index
4113	INTEGER(iwp), INTENT(in) :: j !< loop index
4114
4115	LOGICAL, INTENT(in) :: norm !< to normalise or not
4116
4117	REAL(wp) :: alpha !< parameter, Table 3 in Z01
4118	REAL(wp) :: beta_im !< parameter for turbulent impaction
4119	REAL(wp) :: c_brownian_diff !< coefficient for Brownian diffusion
4120	REAL(wp) :: c_impaction !< coefficient for inertial impaction
4121	REAL(wp) :: c_interception !< coefficient for interception
4122	REAL(wp) :: c_turb_impaction !< coefficient for turbulent impaction
4123	REAL(wp) :: gamma !< parameter, Table 3 in Z01
4124	REAL(wp) :: norm_fac !< normalisation factor (usually air density)
4125	REAL(wp) :: par_a !< parameter A for the characteristic radius of collectors,
4126	!< Table 3 in Z01
4127	REAL(wp) :: par_l !< obstacle characteristic dimension in P10
4128	REAL(wp) :: rs !< the overall quasi-laminar resistance for particles
4129	REAL(wp) :: tau_plus !< dimensionless particle relaxation time
4130	REAL(wp) :: v_bd !< deposition velocity due to Brownian diffusion
4131	REAL(wp) :: v_im !< deposition velocity due to impaction
4132	REAL(wp) :: v_in !< deposition velocity due to interception
4133	REAL(wp) :: v_it !< deposition velocity due to turbulent impaction
4134
4135	REAL(wp), DIMENSION(nbins_aerosol) :: depo !< deposition efficiency
4136	REAL(wp), DIMENSION(nbins_aerosol) :: depo_sum !< sum of deposition efficiencies
4137
4138	REAL(wp), DIMENSION(:), INTENT(in) :: kvis !< kinematic viscosity of air (m2/s)
4139	REAL(wp), DIMENSION(:), INTENT(in) :: mag_u !< wind velocity (m/s)
4140
4141	REAL(wp), DIMENSION(:,:), INTENT(in) :: schmidt_num !< particle Schmidt number
4142	REAL(wp), DIMENSION(:,:), INTENT(in) :: vc !< terminal velocity (m/s)
4143
4144	TYPE(match_surface), INTENT(in), OPTIONAL :: match_array !< match the deposition module and
4145	!< LSM/USM surfaces
4146	TYPE(surf_type), INTENT(inout) :: surf !< respective surface type
4147	!
4148	!-- Initialise
4149	depo = 0.0_wp
4150	depo_sum = 0.0_wp
4151	rs = 0.0_wp
4152	surf_s = surf%start_index(j,i)
4153	surf_e = surf%end_index(j,i)
4154	tau_plus = 0.0_wp
4155	v_bd = 0.0_wp
4156	v_im = 0.0_wp
4157	v_in = 0.0_wp
4158	v_it = 0.0_wp
4159	!
4160	!-- Model parameters for the land use category. If LSM or USM is applied, import
4161	!-- characteristics. Otherwise, apply surface type "urban".
4162	alpha = alpha_z01(luc_urban)
4163	gamma = gamma_z01(luc_urban)
4164	par_a = A_z01(luc_urban, season_z01) * 1.0E-3_wp
4165
4166	par_l = l_p10(luc_urban) * 0.01_wp
4167	c_brownian_diff = c_b_p10(luc_urban)
4168	c_interception = c_in_p10(luc_urban)
4169	c_impaction = c_im_p10(luc_urban)
4170	beta_im = beta_im_p10(luc_urban)
4171	c_turb_impaction = c_it_p10(luc_urban)
4172
4173
4174	IF ( PRESENT( match_array ) ) THEN ! land or urban surface model
4175
4176	DO m = surf_s, surf_e
4177
4178	k = surf%k(m)
4179	norm_fac = 1.0_wp
4180
4181	IF ( norm ) norm_fac = rho_air_zw(k) ! normalise vertical fluxes by air density
4182
4183	IF ( match_array%match_lupg(m) > 0 ) THEN
4184	alpha = alpha_z01( match_array%match_lupg(m) )
4185	gamma = gamma_z01( match_array%match_lupg(m) )
4186	par_a = A_z01( match_array%match_lupg(m), season_z01 ) * 1.0E-3_wp
4187
4188	beta_im = beta_im_p10( match_array%match_lupg(m) )
4189	c_brownian_diff = c_b_p10( match_array%match_lupg(m) )
4190	c_impaction = c_im_p10( match_array%match_lupg(m) )
4191	c_interception = c_in_p10( match_array%match_lupg(m) )
4192	c_turb_impaction = c_it_p10( match_array%match_lupg(m) )
4193	par_l = l_p10( match_array%match_lupg(m) ) * 0.01_wp
4194
4195	DO ib = 1, nbins_aerosol
4196	IF ( aerosol_number(ib)%conc(k,j,i) < ( 2.0_wp * nclim ) .OR. &
4197	schmidt_num(k+1,ib) < 1.0_wp ) CYCLE
4198
4199	SELECT CASE ( depo_surf_par_num )
4200
4201	CASE ( 1 )
4202	CALL depo_vel_Z01( vc(k+1,ib), surf%us(m), schmidt_num(k+1,ib), &
4203	ra_dry(k,j,i,ib), alpha, gamma, par_a, depo(ib) )
4204	CASE ( 2 )
4205	CALL depo_vel_P10( vc(k+1,ib), mag_u(k+1), surf%us(m), kvis(k+1), &
4206	schmidt_num(k+1,ib), ra_dry(k,j,i,ib), par_l, &
4207	c_brownian_diff, c_interception, c_impaction, beta_im, &
4208	c_turb_impaction, depo(ib) )
4209	END SELECT
4210	ENDDO
4211	depo_sum = depo_sum + surf%frac(ind_pav_green,m) * depo
4212	ENDIF
4213
4214	IF ( match_array%match_luvw(m) > 0 ) THEN
4215	alpha = alpha_z01( match_array%match_luvw(m) )
4216	gamma = gamma_z01( match_array%match_luvw(m) )
4217	par_a = A_z01( match_array%match_luvw(m), season_z01 ) * 1.0E-3_wp
4218
4219	beta_im = beta_im_p10( match_array%match_luvw(m) )
4220	c_brownian_diff = c_b_p10( match_array%match_luvw(m) )
4221	c_impaction = c_im_p10( match_array%match_luvw(m) )
4222	c_interception = c_in_p10( match_array%match_luvw(m) )
4223	c_turb_impaction = c_it_p10( match_array%match_luvw(m) )
4224	par_l = l_p10( match_array%match_luvw(m) ) * 0.01_wp
4225
4226	DO ib = 1, nbins_aerosol
4227	IF ( aerosol_number(ib)%conc(k,j,i) < ( 2.0_wp * nclim ) .OR. &
4228	schmidt_num(k+1,ib) < 1.0_wp ) CYCLE
4229
4230	SELECT CASE ( depo_surf_par_num )
4231
4232	CASE ( 1 )
4233	CALL depo_vel_Z01( vc(k+1,ib), surf%us(m), schmidt_num(k+1,ib), &
4234	ra_dry(k,j,i,ib), alpha, gamma, par_a, depo(ib) )
4235	CASE ( 2 )
4236	CALL depo_vel_P10( vc(k+1,ib), mag_u(k+1), surf%us(m), kvis(k+1), &
4237	schmidt_num(k+1,ib), ra_dry(k,j,i,ib), par_l, &
4238	c_brownian_diff, c_interception, c_impaction, beta_im, &
4239	c_turb_impaction, depo(ib) )
4240	END SELECT
4241	ENDDO
4242	depo_sum = depo_sum + surf%frac(ind_veg_wall,m) * depo
4243	ENDIF
4244
4245	IF ( match_array%match_luww(m) > 0 ) THEN
4246	alpha = alpha_z01( match_array%match_luww(m) )
4247	gamma = gamma_z01( match_array%match_luww(m) )
4248	par_a = A_z01( match_array%match_luww(m), season_z01 ) * 1.0E-3_wp
4249
4250	beta_im = beta_im_p10( match_array%match_luww(m) )
4251	c_brownian_diff = c_b_p10( match_array%match_luww(m) )
4252	c_impaction = c_im_p10( match_array%match_luww(m) )
4253	c_interception = c_in_p10( match_array%match_luww(m) )
4254	c_turb_impaction = c_it_p10( match_array%match_luww(m) )
4255	par_l = l_p10( match_array%match_luww(m) ) * 0.01_wp
4256
4257	DO ib = 1, nbins_aerosol
4258	IF ( aerosol_number(ib)%conc(k,j,i) < ( 2.0_wp * nclim ) .OR. &
4259	schmidt_num(k+1,ib) < 1.0_wp ) CYCLE
4260
4261	SELECT CASE ( depo_surf_par_num )
4262
4263	CASE ( 1 )
4264	CALL depo_vel_Z01( vc(k+1,ib), surf%us(m), schmidt_num(k+1,ib), &
4265	ra_dry(k,j,i,ib), alpha, gamma, par_a, depo(ib) )
4266	CASE ( 2 )
4267	CALL depo_vel_P10( vc(k+1,ib), mag_u(k+1), surf%us(m), kvis(k+1), &
4268	schmidt_num(k+1,ib), ra_dry(k,j,i,ib), par_l, &
4269	c_brownian_diff, c_interception, c_impaction, beta_im, &
4270	c_turb_impaction, depo(ib) )
4271	END SELECT
4272	ENDDO
4273	depo_sum = depo_sum + surf%frac(ind_wat_win,m) * depo
4274	ENDIF
4275
4276	DO ib = 1, nbins_aerosol
4277	IF ( aerosol_number(ib)%conc(k,j,i) < ( 2.0_wp * nclim ) ) CYCLE
4278	!
4279	!-- Calculate changes in surface fluxes due to dry deposition
4280	IF ( include_emission ) THEN
4281	surf%answs(m,ib) = aerosol_number(ib)%source(j,i) - MAX( 0.0_wp, &
4282	depo_sum(ib) * norm_fac * aerosol_number(ib)%conc(k,j,i) )
4283	DO ic = 1, ncomponents_mass
4284	icc = ( ic - 1 ) * nbins_aerosol + ib
4285	surf%amsws(m,icc) = aerosol_mass(icc)%source(j,i) - MAX( 0.0_wp, &
4286	depo_sum(ib) * norm_fac * aerosol_mass(icc)%conc(k,j,i) )
4287	ENDDO ! ic
4288	ELSE
4289	surf%answs(m,ib) = -depo_sum(ib) * norm_fac * aerosol_number(ib)%conc(k,j,i)
4290	DO ic = 1, ncomponents_mass
4291	icc = ( ic - 1 ) * nbins_aerosol + ib
4292	surf%amsws(m,icc) = -depo_sum(ib) * norm_fac * aerosol_mass(icc)%conc(k,j,i)
4293	ENDDO ! ic
4294	ENDIF
4295	ENDDO ! ib
4296
4297	ENDDO
4298
4299	ELSE ! default surfaces
4300
4301	DO m = surf_s, surf_e
4302
4303	k = surf%k(m)
4304	norm_fac = 1.0_wp
4305
4306	IF ( norm ) norm_fac = rho_air_zw(k) ! normalise vertical fluxes by air density
4307
4308	DO ib = 1, nbins_aerosol
4309	IF ( aerosol_number(ib)%conc(k,j,i) < ( 2.0_wp * nclim ) .OR. &
4310	schmidt_num(k+1,ib) < 1.0_wp ) CYCLE
4311
4312	SELECT CASE ( depo_surf_par_num )
4313
4314	CASE ( 1 )
4315	CALL depo_vel_Z01( vc(k+1,ib), surf%us(m), schmidt_num(k+1,ib), &
4316	ra_dry(k,j,i,ib), alpha, gamma, par_a, depo(ib) )
4317	CASE ( 2 )
4318	CALL depo_vel_P10( vc(k+1,ib), mag_u(k+1), surf%us(m), kvis(k+1), &
4319	schmidt_num(k+1,ib), ra_dry(k,j,i,ib), par_l, &
4320	c_brownian_diff, c_interception, c_impaction, beta_im, &
4321	c_turb_impaction, depo(ib) )
4322	END SELECT
4323	!
4324	!-- Calculate changes in surface fluxes due to dry deposition
4325	IF ( include_emission ) THEN
4326	surf%answs(m,ib) = aerosol_number(ib)%source(j,i) - MAX( 0.0_wp, &
4327	depo(ib) * norm_fac * aerosol_number(ib)%conc(k,j,i) )
4328	DO ic = 1, ncomponents_mass
4329	icc = ( ic - 1 ) * nbins_aerosol + ib
4330	surf%amsws(m,icc) = aerosol_mass(icc)%source(j,i) - MAX( 0.0_wp, &
4331	depo(ib) * norm_fac * aerosol_mass(icc)%conc(k,j,i) )
4332	ENDDO ! ic
4333	ELSE
4334	surf%answs(m,ib) = -depo(ib) * norm_fac * aerosol_number(ib)%conc(k,j,i)
4335	DO ic = 1, ncomponents_mass
4336	icc = ( ic - 1 ) * nbins_aerosol + ib
4337	surf%amsws(m,icc) = -depo(ib) * norm_fac * aerosol_mass(icc)%conc(k,j,i)
4338	ENDDO ! ic
4339	ENDIF
4340	ENDDO ! ib
4341	ENDDO
4342
4343	ENDIF
4344
4345	END SUBROUTINE depo_surf
4346
4347	!------------------------------------------------------------------------------!
4348	! Description:
4349	! ------------
4350	!> Calculates particle loss and change in size distribution due to (Brownian)
4351	!> coagulation. Only for particles with dwet < 30 micrometres.
4352	!
4353	!> Method:
4354	!> Semi-implicit, non-iterative method: (Jacobson, 1994)
4355	!> Volume concentrations of the smaller colliding particles added to the bin of
4356	!> the larger colliding particles. Start from first bin and use the updated
4357	!> number and volume for calculation of following bins. NB! Our bin numbering
4358	!> does not follow particle size in subrange 2.
4359	!
4360	!> Schematic for bin numbers in different subranges:
4361	!> 1 2
4362	!> +-------------------------------------------+
4363	!> a \| 1 \| 2 \| 3 \|\| 4 \| 5 \| 6 \| 7 \| 8 \| 9 \| 10\|\|
4364	!> b \| \|\|11 \|12 \|13 \|14 \| 15 \| 16 \| 17\|\|
4365	!> +-------------------------------------------+
4366	!
4367	!> Exact coagulation coefficients for each pressure level are scaled according
4368	!> to current particle wet size (linear scaling).
4369	!> Bins are organized in terms of the dry size of the condensation nucleus,
4370	!> while coagulation kernell is calculated with the actual hydrometeor
4371	!> size.
4372	!
4373	!> Called from salsa_driver
4374	!> fxm: Process selection should be made smarter - now just lots of IFs inside
4375	!> loops
4376	!
4377	!> Coded by:
4378	!> Hannele Korhonen (FMI) 2005
4379	!> Harri Kokkola (FMI) 2006
4380	!> Tommi Bergman (FMI) 2012
4381	!> Matti Niskanen(FMI) 2012
4382	!> Anton Laakso (FMI) 2013
4383	!> Juha Tonttila (FMI) 2014
4384	!------------------------------------------------------------------------------!
4385	SUBROUTINE coagulation( paero, ptstep, ptemp, ppres )
4386
4387	IMPLICIT NONE
4388
4389	INTEGER(iwp) :: index_2a !< corresponding bin in subrange 2a
4390	INTEGER(iwp) :: index_2b !< corresponding bin in subrange 2b
4391	INTEGER(iwp) :: ib !< loop index
4392	INTEGER(iwp) :: ll !< loop index
4393	INTEGER(iwp) :: mm !< loop index
4394	INTEGER(iwp) :: nn !< loop index
4395
4396	REAL(wp) :: pressi !< pressure
4397	REAL(wp) :: temppi !< temperature
4398	REAL(wp) :: zdpart_mm !< diameter of particle (m)
4399	REAL(wp) :: zdpart_nn !< diameter of particle (m)
4400	REAL(wp) :: zminusterm !< coagulation loss in a bin (1/s)
4401
4402	REAL(wp), INTENT(in) :: ppres !< ambient pressure (Pa)
4403	REAL(wp), INTENT(in) :: ptemp !< ambient temperature (K)
4404	REAL(wp), INTENT(in) :: ptstep !< time step (s)
4405
4406	REAL(wp), DIMENSION(nbins_aerosol) :: zmpart !< approximate mass of particles (kg)
4407	REAL(wp), DIMENSION(maxspec+1) :: zplusterm !< coagulation gain in a bin (for each
4408	!< chemical compound)
4409	REAL(wp), DIMENSION(nbins_aerosol,nbins_aerosol) :: zcc !< updated coagulation coeff. (m3/s)
4410
4411	TYPE(t_section), DIMENSION(nbins_aerosol), INTENT(inout) :: paero !< Aerosol properties
4412
4413	zdpart_mm = 0.0_wp
4414	zdpart_nn = 0.0_wp
4415	!
4416	!-- 1) Coagulation to coarse mode calculated in a simplified way:
4417	!-- CoagSink ~ Dp in continuum subrange --> 'effective' number conc. of coarse particles
4418
4419	!-- 2) Updating coagulation coefficients
4420	!
4421	!-- Aerosol mass (kg). Density of 1500 kg/m3 assumed
4422	zmpart(1:end_subrange_2b) = api6 * ( MIN( paero(1:end_subrange_2b)%dwet, 30.0E-6_wp )**3 ) &
4423	* 1500.0_wp
4424	temppi = ptemp
4425	pressi = ppres
4426	zcc = 0.0_wp
4427	!
4428	!-- Aero-aero coagulation
4429	DO mm = 1, end_subrange_2b ! smaller colliding particle
4430	IF ( paero(mm)%numc < ( 2.0_wp * nclim ) ) CYCLE
4431	DO nn = mm, end_subrange_2b ! larger colliding particle
4432	IF ( paero(nn)%numc < ( 2.0_wp * nclim ) ) CYCLE
4433
4434	zdpart_mm = MIN( paero(mm)%dwet, 30.0E-6_wp ) ! Limit to 30 um
4435	zdpart_nn = MIN( paero(nn)%dwet, 30.0E-6_wp ) ! Limit to 30 um
4436	!
4437	!-- Coagulation coefficient of particles (m3/s)
4438	zcc(mm,nn) = coagc( zdpart_mm, zdpart_nn, zmpart(mm), zmpart(nn), temppi, pressi )
4439	zcc(nn,mm) = zcc(mm,nn)
4440	ENDDO
4441	ENDDO
4442
4443	!
4444	!-- 3) New particle and volume concentrations after coagulation:
4445	!-- Calculated according to Jacobson (2005) eq. 15.9
4446	!
4447	!-- Aerosols in subrange 1a:
4448	DO ib = start_subrange_1a, end_subrange_1a
4449	IF ( paero(ib)%numc < ( 2.0_wp * nclim ) ) CYCLE
4450	zminusterm = 0.0_wp
4451	zplusterm(:) = 0.0_wp
4452	!
4453	!-- Particles lost by coagulation with larger aerosols
4454	DO ll = ib+1, end_subrange_2b
4455	zminusterm = zminusterm + zcc(ib,ll) * paero(ll)%numc
4456	ENDDO
4457	!
4458	!-- Coagulation gain in a bin: change in volume conc. (cm3/cm3):
4459	DO ll = start_subrange_1a, ib - 1
4460	zplusterm(1:2) = zplusterm(1:2) + zcc(ll,ib) * paero(ll)%volc(1:2)
4461	zplusterm(6:7) = zplusterm(6:7) + zcc(ll,ib) * paero(ll)%volc(6:7)
4462	zplusterm(8) = zplusterm(8) + zcc(ll,ib) * paero(ll)%volc(8)
4463	ENDDO
4464	!
4465	!-- Volume and number concentrations after coagulation update [fxm]
4466	paero(ib)%volc(1:2) = ( paero(ib)%volc(1:2) + ptstep * zplusterm(1:2) * paero(ib)%numc ) / &
4467	( 1.0_wp + ptstep * zminusterm )
4468	paero(ib)%volc(6:8) = ( paero(ib)%volc(6:8) + ptstep * zplusterm(6:8) * paero(ib)%numc ) / &
4469	( 1.0_wp + ptstep * zminusterm )
4470	paero(ib)%numc = paero(ib)%numc / ( 1.0_wp + ptstep * zminusterm + 0.5_wp * ptstep * &
4471	zcc(ib,ib) * paero(ib)%numc )
4472	ENDDO
4473	!
4474	!-- Aerosols in subrange 2a:
4475	DO ib = start_subrange_2a, end_subrange_2a
4476	IF ( paero(ib)%numc < ( 2.0_wp * nclim ) ) CYCLE
4477	zminusterm = 0.0_wp
4478	zplusterm(:) = 0.0_wp
4479	!
4480	!-- Find corresponding size bin in subrange 2b
4481	index_2b = ib - start_subrange_2a + start_subrange_2b
4482	!
4483	!-- Particles lost by larger particles in 2a
4484	DO ll = ib+1, end_subrange_2a
4485	zminusterm = zminusterm + zcc(ib,ll) * paero(ll)%numc
4486	ENDDO
4487	!
4488	!-- Particles lost by larger particles in 2b
4489	IF ( .NOT. no_insoluble ) THEN
4490	DO ll = index_2b+1, end_subrange_2b
4491	zminusterm = zminusterm + zcc(ib,ll) * paero(ll)%numc
4492	ENDDO
4493	ENDIF
4494	!
4495	!-- Particle volume gained from smaller particles in subranges 1, 2a and 2b
4496	DO ll = start_subrange_1a, ib-1
4497	zplusterm(1:2) = zplusterm(1:2) + zcc(ll,ib) * paero(ll)%volc(1:2)
4498	zplusterm(6:8) = zplusterm(6:8) + zcc(ll,ib) * paero(ll)%volc(6:8)
4499	ENDDO
4500	!
4501	!-- Particle volume gained from smaller particles in 2a
4502	!-- (Note, for components not included in the previous loop!)
4503	DO ll = start_subrange_2a, ib-1
4504	zplusterm(3:5) = zplusterm(3:5) + zcc(ll,ib)*paero(ll)%volc(3:5)
4505	ENDDO
4506	!
4507	!-- Particle volume gained from smaller (and equal) particles in 2b
4508	IF ( .NOT. no_insoluble ) THEN
4509	DO ll = start_subrange_2b, index_2b
4510	zplusterm(1:8) = zplusterm(1:8) + zcc(ll,ib) * paero(ll)%volc(1:8)
4511	ENDDO
4512	ENDIF
4513	!
4514	!-- Volume and number concentrations after coagulation update [fxm]
4515	paero(ib)%volc(1:8) = ( paero(ib)%volc(1:8) + ptstep * zplusterm(1:8) * paero(ib)%numc ) / &
4516	( 1.0_wp + ptstep * zminusterm )
4517	paero(ib)%numc = paero(ib)%numc / ( 1.0_wp + ptstep * zminusterm + 0.5_wp * ptstep * &
4518	zcc(ib,ib) * paero(ib)%numc )
4519	ENDDO
4520	!
4521	!-- Aerosols in subrange 2b:
4522	IF ( .NOT. no_insoluble ) THEN
4523	DO ib = start_subrange_2b, end_subrange_2b
4524	IF ( paero(ib)%numc < ( 2.0_wp * nclim ) ) CYCLE
4525	zminusterm = 0.0_wp
4526	zplusterm(:) = 0.0_wp
4527	!
4528	!-- Find corresponding size bin in subsubrange 2a
4529	index_2a = ib - start_subrange_2b + start_subrange_2a
4530	!
4531	!-- Particles lost to larger particles in subranges 2b
4532	DO ll = ib + 1, end_subrange_2b
4533	zminusterm = zminusterm + zcc(ib,ll) * paero(ll)%numc
4534	ENDDO
4535	!
4536	!-- Particles lost to larger and equal particles in 2a
4537	DO ll = index_2a, end_subrange_2a
4538	zminusterm = zminusterm + zcc(ib,ll) * paero(ll)%numc
4539	ENDDO
4540	!
4541	!-- Particle volume gained from smaller particles in subranges 1 & 2a
4542	DO ll = start_subrange_1a, index_2a - 1
4543	zplusterm(1:8) = zplusterm(1:8) + zcc(ll,ib) * paero(ll)%volc(1:8)
4544	ENDDO
4545	!
4546	!-- Particle volume gained from smaller particles in 2b
4547	DO ll = start_subrange_2b, ib - 1
4548	zplusterm(1:8) = zplusterm(1:8) + zcc(ll,ib) * paero(ll)%volc(1:8)
4549	ENDDO
4550	!
4551	!-- Volume and number concentrations after coagulation update [fxm]
4552	paero(ib)%volc(1:8) = ( paero(ib)%volc(1:8) + ptstep * zplusterm(1:8) * paero(ib)%numc ) &
4553	/ ( 1.0_wp + ptstep * zminusterm )
4554	paero(ib)%numc = paero(ib)%numc / ( 1.0_wp + ptstep * zminusterm + 0.5_wp * ptstep * &
4555	zcc(ib,ib) * paero(ib)%numc )
4556	ENDDO
4557	ENDIF
4558
4559	END SUBROUTINE coagulation
4560
4561	!------------------------------------------------------------------------------!
4562	! Description:
4563	! ------------
4564	!> Calculation of coagulation coefficients. Extended version of the function
4565	!> originally found in mo_salsa_init.
4566	!
4567	!> J. Tonttila, FMI, 05/2014
4568	!------------------------------------------------------------------------------!
4569	REAL(wp) FUNCTION coagc( diam1, diam2, mass1, mass2, temp, pres )
4570
4571	IMPLICIT NONE
4572
4573	REAL(wp) :: fmdist !< distance of flux matching (m)
4574	REAL(wp) :: knud_p !< particle Knudsen number
4575	REAL(wp) :: mdiam !< mean diameter of colliding particles (m)
4576	REAL(wp) :: mfp !< mean free path of air molecules (m)
4577	REAL(wp) :: visc !< viscosity of air (kg/(m s))
4578
4579	REAL(wp), INTENT(in) :: diam1 !< diameter of colliding particle 1 (m)
4580	REAL(wp), INTENT(in) :: diam2 !< diameter of colliding particle 2 (m)
4581	REAL(wp), INTENT(in) :: mass1 !< mass of colliding particle 1 (kg)
4582	REAL(wp), INTENT(in) :: mass2 !< mass of colliding particle 2 (kg)
4583	REAL(wp), INTENT(in) :: pres !< ambient pressure (Pa?) [fxm]
4584	REAL(wp), INTENT(in) :: temp !< ambient temperature (K)
4585
4586	REAL(wp), DIMENSION (2) :: beta !< Cunningham correction factor
4587	REAL(wp), DIMENSION (2) :: dfpart !< particle diffusion coefficient (m2/s)
4588	REAL(wp), DIMENSION (2) :: diam !< diameters of particles (m)
4589	REAL(wp), DIMENSION (2) :: flux !< flux in continuum and free molec. regime (m/s)
4590	REAL(wp), DIMENSION (2) :: knud !< particle Knudsen number
4591	REAL(wp), DIMENSION (2) :: mpart !< masses of particles (kg)
4592	REAL(wp), DIMENSION (2) :: mtvel !< particle mean thermal velocity (m/s)
4593	REAL(wp), DIMENSION (2) :: omega !< particle mean free path
4594	REAL(wp), DIMENSION (2) :: tva !< temporary variable (m)
4595	!
4596	!-- Initialisation
4597	coagc = 0.0_wp
4598	!
4599	!-- 1) Initializing particle and ambient air variables
4600	diam = (/ diam1, diam2 /) !< particle diameters (m)
4601	mpart = (/ mass1, mass2 /) !< particle masses (kg)
4602	!
4603	!-- Viscosity of air (kg/(m s))
4604	visc = ( 7.44523E-3_wp * temp ** 1.5_wp ) / ( 5093.0_wp * ( temp + 110.4_wp ) )
4605	!
4606	!-- Mean free path of air (m)
4607	mfp = ( 1.656E-10_wp * temp + 1.828E-8_wp ) * ( p_0 + 1325.0_wp ) / pres
4608	!
4609	!-- 2) Slip correction factor for small particles
4610	knud = 2.0_wp * EXP( LOG(mfp) - LOG(diam) )! Knudsen number for air (15.23)
4611	!
4612	!-- Cunningham correction factor (Allen and Raabe, Aerosol Sci. Tech. 4, 269)
4613	beta = 1.0_wp + knud * ( 1.142_wp + 0.558_wp * EXP( -0.999_wp / knud ) )
4614	!
4615	!-- 3) Particle properties
4616	!-- Diffusion coefficient (m2/s) (Jacobson (2005) eq. 15.29)
4617	dfpart = beta * abo * temp / ( 3.0_wp * pi * visc * diam )
4618	!
4619	!-- Mean thermal velocity (m/s) (Jacobson (2005) eq. 15.32)
4620	mtvel = SQRT( ( 8.0_wp * abo * temp ) / ( pi * mpart ) )
4621	!
4622	!-- Particle mean free path (m) (Jacobson (2005) eq. 15.34 )
4623	omega = 8.0_wp * dfpart / ( pi * mtvel )
4624	!
4625	!-- Mean diameter (m)
4626	mdiam = 0.5_wp * ( diam(1) + diam(2) )
4627	!
4628	!-- 4) Calculation of fluxes (Brownian collision kernels) and flux matching
4629	!-- following Jacobson (2005):
4630	!
4631	!-- Flux in continuum regime (m3/s) (eq. 15.28)
4632	flux(1) = 4.0_wp * pi * mdiam * ( dfpart(1) + dfpart(2) )
4633	!
4634	!-- Flux in free molec. regime (m3/s) (eq. 15.31)
4635	flux(2) = pi * SQRT( ( mtvel(1)2 ) + ( mtvel(2)2 ) ) * ( mdiam**2 )
4636	!
4637	!-- temporary variables (m) to calculate flux matching distance (m)
4638	tva(1) = ( ( mdiam + omega(1) )3 - ( mdiam2 + omega(1)*2 ) SQRT( ( mdiam**2 + &
4639	omega(1)*2 ) ) ) / ( 3.0_wp mdiam * omega(1) ) - mdiam
4640	tva(2) = ( ( mdiam + omega(2) )3 - ( mdiam2 + omega(2)*2 ) SQRT( ( mdiam**2 + &
4641	omega(2)*2 ) ) ) / ( 3.0_wp mdiam * omega(2) ) - mdiam
4642	!
4643	!-- Flux matching distance (m): the mean distance from the centre of a sphere reached by particles
4644	!-- that leave sphere's surface and travel a distance of particle mean free path (eq. 15.34)
4645	fmdist = SQRT( tva(1)2 + tva(2)2 )
4646	!
4647	!-- 5) Coagulation coefficient = coalescence efficiency * collision kernel (m3/s) (eq. 15.33).
4648	!-- Here assumed coalescence efficiency 1!!
4649	coagc = flux(1) / ( mdiam / ( mdiam + fmdist) + flux(1) / flux(2) )
4650	!
4651	!-- Corrected collision kernel (Karl et al., 2016 (ACP)): Include van der Waals and viscous forces
4652	IF ( van_der_waals_coagc ) THEN
4653	knud_p = SQRT( omega(1)2 + omega(2)2 ) / mdiam
4654	IF ( knud_p >= 0.1_wp .AND. knud_p <= 10.0_wp ) THEN
4655	coagc = coagc * ( 2.0_wp + 0.4_wp * LOG( knud_p ) )
4656	ELSE
4657	coagc = coagc * 3.0_wp
4658	ENDIF
4659	ENDIF
4660
4661	END FUNCTION coagc
4662
4663	!------------------------------------------------------------------------------!
4664	! Description:
4665	! ------------
4666	!> Calculates the change in particle volume and gas phase
4667	!> concentrations due to nucleation, condensation and dissolutional growth.
4668	!
4669	!> Sulphuric acid and organic vapour: only condensation and no evaporation.
4670	!
4671	!> New gas and aerosol phase concentrations calculated according to Jacobson
4672	!> (1997): Numerical techniques to solve condensational and dissolutional growth
4673	!> equations when growth is coupled to reversible reactions, Aerosol Sci. Tech.,
4674	!> 27, pp 491-498.
4675	!
4676	!> Following parameterization has been used:
4677	!> Molecular diffusion coefficient of condensing vapour (m2/s)
4678	!> (Reid et al. (1987): Properties of gases and liquids, McGraw-Hill, New York.)
4679	!> D = {1.d-7sqrt(1/M_air + 1/M_gas)T^1.75} / &
4680	! {p_atm/p_stand * (d_air^(1/3) + d_gas^(1/3))^2 }
4681	!> M_air = 28.965 : molar mass of air (g/mol)
4682	!> d_air = 19.70 : diffusion volume of air
4683	!> M_h2so4 = 98.08 : molar mass of h2so4 (g/mol)
4684	!> d_h2so4 = 51.96 : diffusion volume of h2so4
4685	!
4686	!> Called from main aerosol model
4687	!> For equations, see Jacobson, Fundamentals of Atmospheric Modeling, 2nd Edition (2005)
4688	!
4689	!> Coded by:
4690	!> Hannele Korhonen (FMI) 2005
4691	!> Harri Kokkola (FMI) 2006
4692	!> Juha Tonttila (FMI) 2014
4693	!> Rewritten to PALM by Mona Kurppa (UHel) 2017
4694	!------------------------------------------------------------------------------!
4695	SUBROUTINE condensation( paero, pc_sa, pc_ocnv, pcocsv, pchno3, pc_nh3, pcw, pcs, ptemp, ppres, &
4696	ptstep, prtcl )
4697
4698	IMPLICIT NONE
4699
4700	INTEGER(iwp) :: ss !< start index
4701	INTEGER(iwp) :: ee !< end index
4702
4703	REAL(wp) :: zcs_ocnv !< condensation sink of nonvolatile organics (1/s)
4704	REAL(wp) :: zcs_ocsv !< condensation sink of semivolatile organics (1/s)
4705	REAL(wp) :: zcs_su !< condensation sink of sulfate (1/s)
4706	REAL(wp) :: zcs_tot !< total condensation sink (1/s) (gases)
4707	REAL(wp) :: zcvap_new1 !< vapour concentration after time step (#/m3): sulphuric acid
4708	REAL(wp) :: zcvap_new2 !< nonvolatile organics
4709	REAL(wp) :: zcvap_new3 !< semivolatile organics
4710	REAL(wp) :: zdfvap !< air diffusion coefficient (m2/s)
4711	REAL(wp) :: zdvap1 !< change in vapour concentration (#/m3): sulphuric acid
4712	REAL(wp) :: zdvap2 !< nonvolatile organics
4713	REAL(wp) :: zdvap3 !< semivolatile organics
4714	REAL(wp) :: zmfp !< mean free path of condensing vapour (m)
4715	REAL(wp) :: zrh !< Relative humidity [0-1]
4716	REAL(wp) :: zvisc !< viscosity of air (kg/(m s))
4717	REAL(wp) :: zn_vs_c !< ratio of nucleation of all mass transfer in the smallest bin
4718	REAL(wp) :: zxocnv !< ratio of organic vapour in 3nm particles
4719	REAL(wp) :: zxsa !< Ratio in 3nm particles: sulphuric acid
4720
4721	REAL(wp), INTENT(in) :: ppres !< ambient pressure (Pa)
4722	REAL(wp), INTENT(in) :: pcs !< Water vapour saturation concentration (kg/m3)
4723	REAL(wp), INTENT(in) :: ptemp !< ambient temperature (K)
4724	REAL(wp), INTENT(in) :: ptstep !< timestep (s)
4725
4726	REAL(wp), INTENT(inout) :: pchno3 !< Gas concentrations (#/m3): nitric acid HNO3
4727	REAL(wp), INTENT(inout) :: pc_nh3 !< ammonia NH3
4728	REAL(wp), INTENT(inout) :: pc_ocnv !< non-volatile organics
4729	REAL(wp), INTENT(inout) :: pcocsv !< semi-volatile organics
4730	REAL(wp), INTENT(inout) :: pc_sa !< sulphuric acid H2SO4
4731	REAL(wp), INTENT(inout) :: pcw !< Water vapor concentration (kg/m3)
4732
4733	REAL(wp), DIMENSION(nbins_aerosol) :: zbeta !< transitional correction factor
4734	REAL(wp), DIMENSION(nbins_aerosol) :: zcolrate !< collision rate (1/s)
4735	REAL(wp), DIMENSION(nbins_aerosol) :: zcolrate_ocnv !< collision rate of OCNV (1/s)
4736	REAL(wp), DIMENSION(start_subrange_1a+1) :: zdfpart !< particle diffusion coef. (m2/s)
4737	REAL(wp), DIMENSION(nbins_aerosol) :: zdvoloc !< change of organics volume
4738	REAL(wp), DIMENSION(nbins_aerosol) :: zdvolsa !< change of sulphate volume
4739	REAL(wp), DIMENSION(2) :: zj3n3 !< Formation massrate of molecules
4740	!< in nucleation, (molec/m3s),
4741	!< 1: H2SO4 and 2: organic vapor
4742	REAL(wp), DIMENSION(nbins_aerosol) :: zknud !< particle Knudsen number
4743
4744	TYPE(component_index), INTENT(in) :: prtcl !< Keeps track which substances are used
4745
4746	TYPE(t_section), DIMENSION(nbins_aerosol), INTENT(inout) :: paero !< Aerosol properties
4747
4748	zj3n3 = 0.0_wp
4749	zrh = pcw / pcs
4750	zxocnv = 0.0_wp
4751	zxsa = 0.0_wp
4752	!
4753	!-- Nucleation
4754	IF ( nsnucl > 0 ) THEN
4755	CALL nucleation( paero, ptemp, zrh, ppres, pc_sa, pc_ocnv, pc_nh3, ptstep, zj3n3, zxsa, &
4756	zxocnv )
4757	ENDIF
4758	!
4759	!-- Condensation on pre-existing particles
4760	IF ( lscndgas ) THEN
4761	!
4762	!-- Initialise:
4763	zdvolsa = 0.0_wp
4764	zdvoloc = 0.0_wp
4765	zcolrate = 0.0_wp
4766	!
4767	!-- 1) Properties of air and condensing gases:
4768	!-- Viscosity of air (kg/(m s)) (Eq. 4.54 in Jabonson (2005))
4769	zvisc = ( 7.44523E-3_wp * ptemp ** 1.5_wp ) / ( 5093.0_wp * ( ptemp + 110.4_wp ) )
4770	!
4771	!-- Diffusion coefficient of air (m2/s)
4772	zdfvap = 5.1111E-10_wp * ptemp ** 1.75_wp * ( p_0 + 1325.0_wp ) / ppres
4773	!
4774	!-- Mean free path (m): same for H2SO4 and organic compounds
4775	zmfp = 3.0_wp * zdfvap * SQRT( pi * amh2so4 / ( 8.0_wp * argas * ptemp ) )
4776	!
4777	!-- 2) Transition regime correction factor zbeta for particles (Fuchs and Sutugin (1971)):
4778	!-- Size of condensing molecule considered only for nucleation mode (3 - 20 nm).
4779	!
4780	!-- Particle Knudsen number: condensation of gases on aerosols
4781	ss = start_subrange_1a
4782	ee = start_subrange_1a+1
4783	zknud(ss:ee) = 2.0_wp * zmfp / ( paero(ss:ee)%dwet + d_sa )
4784	ss = start_subrange_1a+2
4785	ee = end_subrange_2b
4786	zknud(ss:ee) = 2.0_wp * zmfp / paero(ss:ee)%dwet
4787	!
4788	!-- Transitional correction factor: aerosol + gas (the semi-empirical Fuchs- Sutugin
4789	!-- interpolation function (Fuchs and Sutugin, 1971))
4790	zbeta = ( zknud + 1.0_wp ) / ( 0.377_wp * zknud + 1.0_wp + 4.0_wp / ( 3.0_wp * massacc ) * &
4791	( zknud + zknud ** 2 ) )
4792	!
4793	!-- 3) Collision rate of molecules to particles
4794	!-- Particle diffusion coefficient considered only for nucleation mode (3 - 20 nm)
4795	!
4796	!-- Particle diffusion coefficient (m2/s) (e.g. Eq. 15.29 in Jacobson (2005))
4797	zdfpart = abo * ptemp * zbeta(start_subrange_1a:start_subrange_1a+1) / ( 3.0_wp * pi * zvisc&
4798	* paero(start_subrange_1a:start_subrange_1a+1)%dwet)
4799	!
4800	!-- Collision rate (mass-transfer coefficient): gases on aerosols (1/s) (Eq. 16.64 in
4801	!-- Jacobson (2005))
4802	ss = start_subrange_1a
4803	ee = start_subrange_1a+1
4804	zcolrate(ss:ee) = MERGE( 2.0_wp * pi * ( paero(ss:ee)%dwet + d_sa ) * ( zdfvap + zdfpart ) *&
4805	zbeta(ss:ee) * paero(ss:ee)%numc, 0.0_wp, paero(ss:ee)%numc > nclim )
4806	ss = start_subrange_1a+2
4807	ee = end_subrange_2b
4808	zcolrate(ss:ee) = MERGE( 2.0_wp * pi * paero(ss:ee)%dwet * zdfvap * zbeta(ss:ee) * &
4809	paero(ss:ee)%numc, 0.0_wp, paero(ss:ee)%numc > nclim )
4810	!
4811	!-- 4) Condensation sink (1/s)
4812	zcs_tot = SUM( zcolrate ) ! total sink
4813	!
4814	!-- 5) Changes in gas-phase concentrations and particle volume
4815	!
4816	!-- 5.1) Organic vapours
4817	!
4818	!-- 5.1.1) Non-volatile organic compound: condenses onto all bins
4819	IF ( pc_ocnv > 1.0E+10_wp .AND. zcs_tot > 1.0E-30_wp .AND. index_oc > 0 ) &
4820	THEN
4821	!-- Ratio of nucleation vs. condensation rates in the smallest bin
4822	zn_vs_c = 0.0_wp
4823	IF ( zj3n3(2) > 1.0_wp ) THEN
4824	zn_vs_c = ( zj3n3(2) ) / ( zj3n3(2) + pc_ocnv * zcolrate(start_subrange_1a) )
4825	ENDIF
4826	!
4827	!-- Collision rate in the smallest bin, including nucleation and condensation (see
4828	!-- Jacobson (2005), eq. (16.73) )
4829	zcolrate_ocnv = zcolrate
4830	zcolrate_ocnv(start_subrange_1a) = zcolrate_ocnv(start_subrange_1a) + zj3n3(2) / pc_ocnv
4831	!
4832	!-- Total sink for organic vapor
4833	zcs_ocnv = zcs_tot + zj3n3(2) / pc_ocnv
4834	!
4835	!-- New gas phase concentration (#/m3)
4836	zcvap_new2 = pc_ocnv / ( 1.0_wp + ptstep * zcs_ocnv )
4837	!
4838	!-- Change in gas concentration (#/m3)
4839	zdvap2 = pc_ocnv - zcvap_new2
4840	!
4841	!-- Updated vapour concentration (#/m3)
4842	pc_ocnv = zcvap_new2
4843	!
4844	!-- Volume change of particles (m3(OC)/m3(air))
4845	zdvoloc = zcolrate_ocnv(start_subrange_1a:end_subrange_2b) / zcs_ocnv * amvoc * zdvap2
4846	!
4847	!-- Change of volume due to condensation in 1a-2b
4848	paero(start_subrange_1a:end_subrange_2b)%volc(2) = &
4849	paero(start_subrange_1a:end_subrange_2b)%volc(2) + zdvoloc
4850	!
4851	!-- Change of number concentration in the smallest bin caused by nucleation (Jacobson (2005),
4852	!-- eq. (16.75)). If zxocnv = 0, then the chosen nucleation mechanism doesn't take into
4853	!-- account the non-volatile organic vapors and thus the paero doesn't have to be updated.
4854	IF ( zxocnv > 0.0_wp ) THEN
4855	paero(start_subrange_1a)%numc = paero(start_subrange_1a)%numc + zn_vs_c * &
4856	zdvoloc(start_subrange_1a) / amvoc / ( n3 * zxocnv )
4857	ENDIF
4858	ENDIF
4859	!
4860	!-- 5.1.2) Semivolatile organic compound: all bins except subrange 1
4861	zcs_ocsv = SUM( zcolrate(start_subrange_2a:end_subrange_2b) ) !< sink for semi-volatile org.
4862	IF ( pcocsv > 1.0E+10_wp .AND. zcs_ocsv > 1.0E-30 .AND. is_used( prtcl,'OC') ) THEN
4863	!
4864	!-- New gas phase concentration (#/m3)
4865	zcvap_new3 = pcocsv / ( 1.0_wp + ptstep * zcs_ocsv )
4866	!
4867	!-- Change in gas concentration (#/m3)
4868	zdvap3 = pcocsv - zcvap_new3
4869	!
4870	!-- Updated gas concentration (#/m3)
4871	pcocsv = zcvap_new3
4872	!
4873	!-- Volume change of particles (m3(OC)/m3(air))
4874	ss = start_subrange_2a
4875	ee = end_subrange_2b
4876	zdvoloc(ss:ee) = zdvoloc(ss:ee) + zcolrate(ss:ee) / zcs_ocsv * amvoc * zdvap3
4877	!
4878	!-- Change of volume due to condensation in 1a-2b
4879	paero(start_subrange_1a:end_subrange_2b)%volc(2) = &
4880	paero(start_subrange_1a:end_subrange_2b)%volc(2) + zdvoloc
4881	ENDIF
4882	!
4883	!-- 5.2) Sulphate: condensed on all bins
4884	IF ( pc_sa > 1.0E+10_wp .AND. zcs_tot > 1.0E-30_wp .AND. index_so4 > 0 ) THEN
4885	!
4886	!-- Ratio of mass transfer between nucleation and condensation
4887	zn_vs_c = 0.0_wp
4888	IF ( zj3n3(1) > 1.0_wp ) THEN
4889	zn_vs_c = ( zj3n3(1) ) / ( zj3n3(1) + pc_sa * zcolrate(start_subrange_1a) )
4890	ENDIF
4891	!
4892	!-- Collision rate in the smallest bin, including nucleation and condensation (see
4893	!-- Jacobson (2005), eq. (16.73))
4894	zcolrate(start_subrange_1a) = zcolrate(start_subrange_1a) + zj3n3(1) / pc_sa
4895	!
4896	!-- Total sink for sulfate (1/s)
4897	zcs_su = zcs_tot + zj3n3(1) / pc_sa
4898	!
4899	!-- Sulphuric acid:
4900	!-- New gas phase concentration (#/m3)
4901	zcvap_new1 = pc_sa / ( 1.0_wp + ptstep * zcs_su )
4902	!
4903	!-- Change in gas concentration (#/m3)
4904	zdvap1 = pc_sa - zcvap_new1
4905	!
4906	!-- Updating vapour concentration (#/m3)
4907	pc_sa = zcvap_new1
4908	!
4909	!-- Volume change of particles (m3(SO4)/m3(air)) by condensation
4910	zdvolsa = zcolrate(start_subrange_1a:end_subrange_2b) / zcs_su * amvh2so4 * zdvap1
4911	!
4912	!-- Change of volume concentration of sulphate in aerosol [fxm]
4913	paero(start_subrange_1a:end_subrange_2b)%volc(1) = &
4914	paero(start_subrange_1a:end_subrange_2b)%volc(1) + zdvolsa
4915	!
4916	!-- Change of number concentration in the smallest bin caused by nucleation
4917	!-- (Jacobson (2005), equation (16.75))
4918	IF ( zxsa > 0.0_wp ) THEN
4919	paero(start_subrange_1a)%numc = paero(start_subrange_1a)%numc + zn_vs_c * &
4920	zdvolsa(start_subrange_1a) / amvh2so4 / ( n3 * zxsa)
4921	ENDIF
4922	ENDIF
4923	!
4924	!-- Partitioning of H2O, HNO3, and NH3: Dissolutional growth
4925	IF ( lspartition .AND. ( pchno3 > 1.0E+10_wp .OR. pc_nh3 > 1.0E+10_wp ) ) THEN
4926	CALL gpparthno3( ppres, ptemp, paero, pchno3, pc_nh3, pcw, pcs, zbeta, ptstep )
4927	ENDIF
4928	ENDIF
4929	!
4930	!-- Condensation of water vapour
4931	IF ( lscndh2oae ) THEN
4932	CALL gpparth2o( paero, ptemp, ppres, pcs, pcw, ptstep )
4933	ENDIF
4934
4935	END SUBROUTINE condensation
4936
4937	!------------------------------------------------------------------------------!
4938	! Description:
4939	! ------------
4940	!> Calculates the particle number and volume increase, and gas-phase
4941	!> concentration decrease due to nucleation subsequent growth to detectable size
4942	!> of 3 nm.
4943	!
4944	!> Method:
4945	!> When the formed clusters grow by condensation (possibly also by self-
4946	!> coagulation), their number is reduced due to scavenging to pre-existing
4947	!> particles. Thus, the apparent nucleation rate at 3 nm is significantly lower
4948	!> than the real nucleation rate (at ~1 nm).
4949	!
4950	!> Calculation of the formation rate of detectable particles at 3 nm (i.e. J3):
4951	!> nj3 = 1: Kerminen, V.-M. and Kulmala, M. (2002), J. Aerosol Sci.,33, 609-622.
4952	!> nj3 = 2: Lehtinen et al. (2007), J. Aerosol Sci., 38(9), 988-994.
4953	!> nj3 = 3: Anttila et al. (2010), J. Aerosol Sci., 41(7), 621-636.
4954	!
4955	!> c = aerosol of critical radius (1 nm)
4956	!> x = aerosol with radius 3 nm
4957	!> 2 = wet or mean droplet
4958	!
4959	!> Called from subroutine condensation (in module salsa_dynamics_mod.f90)
4960	!
4961	!> Calls one of the following subroutines:
4962	!> - binnucl
4963	!> - ternucl
4964	!> - kinnucl
4965	!> - actnucl
4966	!
4967	!> fxm: currently only sulphuric acid grows particles from 1 to 3 nm
4968	!> (if asked from Markku, this is terribly wrong!!!)
4969	!
4970	!> Coded by:
4971	!> Hannele Korhonen (FMI) 2005
4972	!> Harri Kokkola (FMI) 2006
4973	!> Matti Niskanen(FMI) 2012
4974	!> Anton Laakso (FMI) 2013
4975	!------------------------------------------------------------------------------!
4976
4977	SUBROUTINE nucleation( paero, ptemp, prh, ppres, pc_sa, pc_ocnv, pc_nh3, ptstep, pj3n3, pxsa, &
4978	pxocnv )
4979
4980	IMPLICIT NONE
4981
4982	INTEGER(iwp) :: iteration
4983
4984	REAL(wp) :: zc_h2so4 !< H2SO4 conc. (#/cm3) !UNITS!
4985	REAL(wp) :: zc_org !< organic vapour conc. (#/cm3)
4986	REAL(wp) :: zcc_c !< Cunningham correct factor for c = critical (1nm)
4987	REAL(wp) :: zcc_x !< Cunningham correct factor for x = 3nm
4988	REAL(wp) :: zcoags_c !< coagulation sink (1/s) for c = critical (1nm)
4989	REAL(wp) :: zcoags_x !< coagulation sink (1/s) for x = 3nm
4990	REAL(wp) :: zcoagstot !< total particle losses due to coagulation, including condensation
4991	!< and self-coagulation
4992	REAL(wp) :: zcocnv_local !< organic vapour conc. (#/m3)
4993	REAL(wp) :: zcsink !< condensational sink (#/m2)
4994	REAL(wp) :: zcsa_local !< H2SO4 conc. (#/m3)
4995	REAL(wp) :: zcv_c !< mean relative thermal velocity (m/s) for c = critical (1nm)
4996	REAL(wp) :: zcv_x !< mean relative thermal velocity (m/s) for x = 3nm
4997	REAL(wp) :: zdcrit !< diameter of critical cluster (m)
4998	REAL(wp) :: zdelta_vap !< change of H2SO4 and organic vapour concentration (#/m3)
4999	REAL(wp) :: zdfvap !< air diffusion coefficient (m2/s)
5000	REAL(wp) :: zdmean !< mean diameter of existing particles (m)
5001	REAL(wp) :: zeta !< constant: proportional to ratio of CS/GR (m)
5002	!< (condensation sink / growth rate)
5003	REAL(wp) :: zgamma !< proportionality factor ((nm2*m2)/h)
5004	REAL(wp) :: z_gr_clust !< growth rate of formed clusters (nm/h)
5005	REAL(wp) :: z_gr_tot !< total growth rate
5006	REAL(wp) :: zj3 !< number conc. of formed 3nm particles (#/m3)
5007	REAL(wp) :: zjnuc !< nucleation rate at ~1nm (#/m3s)
5008	REAL(wp) :: z_k_eff !< effective cogulation coefficient for freshly nucleated particles
5009	REAL(wp) :: zknud_c !< Knudsen number for c = critical (1nm)
5010	REAL(wp) :: zknud_x !< Knudsen number for x = 3nm
5011	REAL(wp) :: zkocnv !< lever: zkocnv=1 --> organic compounds involved in nucleation
5012	REAL(wp) :: zksa !< lever: zksa=1 --> H2SO4 involved in nucleation
5013	REAL(wp) :: zlambda !< parameter for adjusting the growth rate due to self-coagulation
5014	REAL(wp) :: zm_c !< particle mass (kg) for c = critical (1nm)
5015	REAL(wp) :: zm_para !< Parameter m for calculating the coagulation sink (Eq. 5&6 in
5016	!< Lehtinen et al. 2007)
5017	REAL(wp) :: zm_x !< particle mass (kg) for x = 3nm
5018	REAL(wp) :: zmfp !< mean free path of condesing vapour(m)
5019	REAL(wp) :: zmixnh3 !< ammonia mixing ratio (ppt)
5020	REAL(wp) :: zmyy !< gas dynamic viscosity (N*s/m2)
5021	REAL(wp) :: z_n_nuc !< number of clusters/particles at the size range d1-dx (#/m3)
5022	REAL(wp) :: znoc !< number of organic molecules in critical cluster
5023	REAL(wp) :: znsa !< number of H2SO4 molecules in critical cluster
5024
5025	REAL(wp), INTENT(in) :: pc_nh3 !< ammonia concentration (#/m3)
5026	REAL(wp), INTENT(in) :: pc_ocnv !< conc. of non-volatile OC (#/m3)
5027	REAL(wp), INTENT(in) :: pc_sa !< sulphuric acid conc. (#/m3)
5028	REAL(wp), INTENT(in) :: ppres !< ambient air pressure (Pa)
5029	REAL(wp), INTENT(in) :: prh !< ambient rel. humidity [0-1]
5030	REAL(wp), INTENT(in) :: ptemp !< ambient temperature (K)
5031	REAL(wp), INTENT(in) :: ptstep !< time step (s) of SALSA
5032
5033	REAL(wp), INTENT(inout) :: pj3n3(2) !< formation mass rate of molecules (molec/m3s) for
5034	!< 1: H2SO4 and 2: organic vapour
5035
5036	REAL(wp), INTENT(out) :: pxocnv !< ratio of non-volatile organic vapours in 3 nm particles
5037	REAL(wp), INTENT(out) :: pxsa !< ratio of H2SO4 in 3 nm aerosol particles
5038
5039	REAL(wp), DIMENSION(nbins_aerosol) :: zbeta !< transitional correction factor
5040	REAL(wp), DIMENSION(nbins_aerosol) :: zcc_2 !< Cunningham correct factor:2
5041	REAL(wp), DIMENSION(nbins_aerosol) :: zcv_2 !< mean relative thermal velocity (m/s): 2
5042	REAL(wp), DIMENSION(nbins_aerosol) :: zcv_c2 !< average velocity after coagulation: c & 2
5043	REAL(wp), DIMENSION(nbins_aerosol) :: zcv_x2 !< average velocity after coagulation: x & 2
5044	REAL(wp), DIMENSION(nbins_aerosol) :: zdc_2 !< particle diffusion coefficient (m2/s): 2
5045	REAL(wp), DIMENSION(nbins_aerosol) :: zdc_c !< particle diffusion coefficient (m2/s): c
5046	REAL(wp), DIMENSION(nbins_aerosol) :: zdc_c2 !< sum of diffusion coef. for c and 2
5047	REAL(wp), DIMENSION(nbins_aerosol) :: zdc_x !< particle diffusion coefficient (m2/s): x
5048	REAL(wp), DIMENSION(nbins_aerosol) :: zdc_x2 !< sum of diffusion coef. for: x & 2
5049	REAL(wp), DIMENSION(nbins_aerosol) :: zgamma_f_2 !< zgamma_f for calculating zomega
5050	REAL(wp), DIMENSION(nbins_aerosol) :: zgamma_f_c !< zgamma_f for calculating zomega
5051	REAL(wp), DIMENSION(nbins_aerosol) :: zgamma_f_x !< zgamma_f for calculating zomega
5052	REAL(wp), DIMENSION(nbins_aerosol) :: z_k_c2 !< coagulation coef. in the continuum
5053	!< regime: c & 2
5054	REAL(wp), DIMENSION(nbins_aerosol) :: z_k_x2 !< coagulation coef. in the continuum
5055	!< regime: x & 2
5056	REAL(wp), DIMENSION(nbins_aerosol) :: zknud !< particle Knudsen number
5057	REAL(wp), DIMENSION(nbins_aerosol) :: zknud_2 !< particle Knudsen number: 2
5058	REAL(wp), DIMENSION(nbins_aerosol) :: zm_2 !< particle mass (kg): 2
5059	REAL(wp), DIMENSION(nbins_aerosol) :: zomega_2c !< zomega (m) for calculating zsigma: c & 2
5060	REAL(wp), DIMENSION(nbins_aerosol) :: zomega_2x !< zomega (m) for calculating zsigma: x & 2
5061	REAL(wp), DIMENSION(nbins_aerosol) :: zomega_c !< zomega (m) for calculating zsigma: c
5062	REAL(wp), DIMENSION(nbins_aerosol) :: zomega_x !< zomega (m) for calculating zsigma: x
5063	REAL(wp), DIMENSION(nbins_aerosol) :: z_r_c2 !< sum of the radii: c & 2
5064	REAL(wp), DIMENSION(nbins_aerosol) :: z_r_x2 !< sum of the radii: x & 2
5065	REAL(wp), DIMENSION(nbins_aerosol) :: zsigma_c2 !<
5066	REAL(wp), DIMENSION(nbins_aerosol) :: zsigma_x2 !<
5067
5068	TYPE(t_section), DIMENSION(nbins_aerosol), INTENT(inout) :: paero !< aerosol properties
5069	!
5070	!-- 1) Nucleation rate (zjnuc) and diameter of critical cluster (zdcrit)
5071	zjnuc = 0.0_wp
5072	znsa = 0.0_wp
5073	znoc = 0.0_wp
5074	zdcrit = 0.0_wp
5075	zksa = 0.0_wp
5076	zkocnv = 0.0_wp
5077
5078	zc_h2so4 = pc_sa * 1.0E-6_wp ! sulphuric acid conc. to #/cm3
5079	zc_org = pc_ocnv * 1.0E-6_wp ! conc. of non-volatile OC to #/cm3
5080	zmixnh3 = pc_nh3 * ptemp * argas / ( ppres * avo )
5081
5082	SELECT CASE ( nsnucl )
5083	!
5084	!-- Binary H2SO4-H2O nucleation
5085	CASE(1)
5086
5087	CALL binnucl( zc_h2so4, ptemp, prh, zjnuc, znsa, znoc, zdcrit, zksa, zkocnv )
5088	!
5089	!-- Activation type nucleation (See Riipinen et al. (2007), Atmos. Chem. Phys., 7(8), 1899-1914)
5090	CASE(2)
5091	!
5092	!-- Nucleation rate (#/(m3 s))
5093	zc_h2so4 = MAX( zc_h2so4, 1.0E4_wp )
5094	zc_h2so4 = MIN( zc_h2so4, 1.0E11_wp )
5095	zjnuc = act_coeff * pc_sa ! (#/(m3 s))
5096	!
5097	!-- Organic compounds not involved when kinetic nucleation is assumed.
5098	zdcrit = 7.9375E-10_wp ! (m)
5099	zkocnv = 0.0_wp
5100	zksa = 1.0_wp
5101	znoc = 0.0_wp
5102	znsa = 2.0_wp
5103	!
5104	!-- Kinetically limited nucleation of (NH4)HSO4 clusters
5105	!-- (See Sihto et al. (2006), Atmos. Chem. Phys., 6(12), 4079-4091.)
5106	CASE(3)
5107	!
5108	!-- Nucleation rate = coagcoeffzpcsa*2 (#/(m3 s))
5109	zc_h2so4 = MAX( zc_h2so4, 1.0E4_wp )
5110	zc_h2so4 = MIN( zc_h2so4, 1.0E11_wp )
5111	zjnuc = 5.0E-13_wp * zc_h2so4*2.0_wp 1.0E+6_wp
5112	!
5113	!-- Organic compounds not involved when kinetic nucleation is assumed.
5114	zdcrit = 7.9375E-10_wp ! (m)
5115	zkocnv = 0.0_wp
5116	zksa = 1.0_wp
5117	znoc = 0.0_wp
5118	znsa = 2.0_wp
5119	!
5120	!-- Ternary H2SO4-H2O-NH3 nucleation
5121	CASE(4)
5122
5123	CALL ternucl( zc_h2so4, zmixnh3, ptemp, prh, zjnuc, znsa, znoc, zdcrit, zksa, zkocnv )
5124	!
5125	!-- Organic nucleation, J~[ORG] or J~[ORG]**2
5126	!-- (See Paasonen et al. (2010), Atmos. Chem. Phys., 10, 11223-11242.)
5127	CASE(5)
5128	!
5129	!-- Homomolecular nuleation rate
5130	zjnuc = 1.3E-7_wp * pc_ocnv ! (1/s) (Paasonen et al. Table 4: median a_org)
5131	!
5132	!-- H2SO4 not involved when pure organic nucleation is assumed.
5133	zdcrit = 1.5E-9 ! (m)
5134	zkocnv = 1.0_wp
5135	zksa = 0.0_wp
5136	znoc = 1.0_wp
5137	znsa = 0.0_wp
5138	!
5139	!-- Sum of H2SO4 and organic activation type nucleation, J~[H2SO4]+[ORG]
5140	!-- (See Paasonen et al. (2010), Atmos. Chem. Phys., 10, 11223-11242)
5141	CASE(6)
5142	!
5143	!-- Nucleation rate (#/m3/s)
5144	zjnuc = 6.1E-7_wp * pc_sa + 0.39E-7_wp * pc_ocnv ! (Paasonen et al. Table 3.)
5145	!
5146	!-- Both organic compounds and H2SO4 are involved when sumnucleation is assumed.
5147	zdcrit = 1.5E-9_wp ! (m)
5148	zkocnv = 1.0_wp
5149	zksa = 1.0_wp
5150	znoc = 1.0_wp
5151	znsa = 1.0_wp
5152	!
5153	!-- Heteromolecular nucleation, J~[H2SO4]*[ORG]
5154	!-- (See Paasonen et al. (2010), Atmos. Chem. Phys., 10, 11223-11242.)
5155	CASE(7)
5156	!
5157	!-- Nucleation rate (#/m3/s)
5158	zjnuc = 4.1E-14_wp * pc_sa * pc_ocnv * 1.0E6_wp ! (Paasonen et al. Table 4: median)
5159	!
5160	!-- Both organic compounds and H2SO4 are involved when heteromolecular nucleation is assumed
5161	zdcrit = 1.5E-9_wp ! (m)
5162	zkocnv = 1.0_wp
5163	zksa = 1.0_wp
5164	znoc = 1.0_wp
5165	znsa = 1.0_wp
5166	!
5167	!-- Homomolecular nucleation of H2SO4 and heteromolecular nucleation of H2SO4 and organic vapour,
5168	!-- J~[H2SO4]*2 + [H2SO4][ORG] (EUCAARI project)
5169	!-- (See Paasonen et al. (2010), Atmos. Chem. Phys., 10, 11223-11242)
5170	CASE(8)
5171	!
5172	!-- Nucleation rate (#/m3/s)
5173	zjnuc = ( 1.1E-14_wp * zc_h2so4*2 + 3.2E-14_wp zc_h2so4 * zc_org ) * 1.0E+6_wp
5174	!
5175	!-- Both organic compounds and H2SO4 are involved when SAnucleation is assumed
5176	zdcrit = 1.5E-9_wp ! (m)
5177	zkocnv = 1.0_wp
5178	zksa = 1.0_wp
5179	znoc = 1.0_wp
5180	znsa = 3.0_wp
5181	!
5182	!-- Homomolecular nucleation of H2SO4 and organic vapour and heteromolecular nucleation of H2SO4
5183	!-- and organic vapour, J~[H2SO4]*2 + [H2SO4][ORG]+[ORG]**2 (EUCAARI project)
5184	CASE(9)
5185	!
5186	!-- Nucleation rate (#/m3/s)
5187	zjnuc = ( 1.4E-14_wp * zc_h2so4*2 + 2.6E-14_wp zc_h2so4 * zc_org + 0.037E-14_wp * &
5188	zc_org*2 ) 1.0E+6_wp
5189	!
5190	!-- Both organic compounds and H2SO4 are involved when SAORGnucleation is assumed
5191	zdcrit = 1.5E-9_wp ! (m)
5192	zkocnv = 1.0_wp
5193	zksa = 1.0_wp
5194	znoc = 3.0_wp
5195	znsa = 3.0_wp
5196
5197	END SELECT
5198
5199	zcsa_local = pc_sa
5200	zcocnv_local = pc_ocnv
5201	!
5202	!-- 2) Change of particle and gas concentrations due to nucleation
5203	!
5204	!-- 2.1) Check that there is enough H2SO4 and organic vapour to produce the nucleation
5205	IF ( nsnucl <= 4 ) THEN
5206	!
5207	!-- If the chosen nucleation scheme is 1-4, nucleation occurs only due to H2SO4. All of the total
5208	!-- vapour concentration that is taking part to the nucleation is there for sulphuric acid
5209	!-- (sa = H2SO4) and non-volatile organic vapour is zero.
5210	pxsa = 1.0_wp ! ratio of sulphuric acid in 3nm particles
5211	pxocnv = 0.0_wp ! ratio of non-volatile origanic vapour
5212	! in 3nm particles
5213	ELSEIF ( nsnucl > 4 ) THEN
5214	!
5215	!-- If the chosen nucleation scheme is 5-9, nucleation occurs due to organic vapour or the
5216	!-- combination of organic vapour and H2SO4. The number of needed molecules depends on the chosen
5217	!-- nucleation type and it has an effect also on the minimum ratio of the molecules present.
5218	IF ( pc_sa * znsa + pc_ocnv * znoc < 1.E-14_wp ) THEN
5219	pxsa = 0.0_wp
5220	pxocnv = 0.0_wp
5221	ELSE
5222	pxsa = pc_sa * znsa / ( pc_sa * znsa + pc_ocnv * znoc )
5223	pxocnv = pc_ocnv * znoc / ( pc_sa * znsa + pc_ocnv * znoc )
5224	ENDIF
5225	ENDIF
5226	!
5227	!-- The change in total vapour concentration is the sum of the concentrations of the vapours taking
5228	!-- part to the nucleation (depends on the chosen nucleation scheme)
5229	zdelta_vap = MIN( zjnuc * ( znoc + znsa ), ( pc_ocnv * zkocnv + pc_sa * zksa ) / ptstep )
5230	!
5231	!-- Nucleation rate J at ~1nm (#/m3s)
5232	zjnuc = zdelta_vap / ( znoc + znsa )
5233	!
5234	!-- H2SO4 concentration after nucleation (#/m3)
5235	zcsa_local = MAX( 1.0_wp, pc_sa - zdelta_vap * pxsa )
5236	!
5237	!-- Non-volative organic vapour concentration after nucleation (#/m3)
5238	zcocnv_local = MAX( 1.0_wp, pc_ocnv - zdelta_vap * pxocnv )
5239	!
5240	!-- 2.2) Formation rate of 3 nm particles (Kerminen & Kulmala, 2002)
5241	!
5242	!-- Growth rate by H2SO4 and organic vapour (nm/h, Eq. 21)
5243	z_gr_clust = 2.3623E-15_wp * SQRT( ptemp ) * ( zcsa_local + zcocnv_local )
5244	!
5245	!-- 2.2.2) Condensational sink of pre-existing particle population
5246	!
5247	!-- Diffusion coefficient (m2/s)
5248	zdfvap = 5.1111E-10_wp * ptemp*1.75_wp ( p_0 + 1325.0_wp ) / ppres
5249	!
5250	!-- Mean free path of condensing vapour (m) (Jacobson (2005), Eq. 15.25 and 16.29)
5251	zmfp = 3.0_wp * zdfvap * SQRT( pi * amh2so4 / ( 8.0_wp * argas * ptemp ) )
5252	!
5253	!-- Knudsen number
5254	zknud = 2.0_wp * zmfp / ( paero(:)%dwet + d_sa )
5255	!
5256	!-- Transitional regime correction factor (zbeta) according to Fuchs and Sutugin (1971) (Eq. 4 in
5257	!-- Kerminen and Kulmala, 2002)
5258	zbeta = ( zknud + 1.0_wp) / ( 0.377_wp * zknud + 1.0_wp + 4.0_wp / ( 3.0_wp * massacc ) * &
5259	( zknud + zknud**2 ) )
5260	!
5261	!-- Condensational sink (#/m2, Eq. 3)
5262	zcsink = SUM( paero(:)%dwet * zbeta * paero(:)%numc )
5263	!
5264	!-- 2.2.3) Parameterised formation rate of detectable 3 nm particles (i.e. J3)
5265	IF ( nj3 == 1 ) THEN ! Kerminen and Kulmala (2002)
5266	!
5267	!-- Constants needed for the parameterisation: dapp = 3 nm and dens_nuc = 1830 kg/m3
5268	IF ( zcsink < 1.0E-30_wp ) THEN
5269	zeta = 0._dp
5270	ELSE
5271	!
5272	!-- Mean diameter of backgroud population (nm)
5273	zdmean = 1.0_wp / SUM( paero(:)%numc ) * SUM( paero(:)%numc * paero(:)%dwet ) * 1.0E+9_wp
5274	!
5275	!-- Proportionality factor (nm2*m2/h) (Eq. 22)
5276	zgamma = 0.23_wp * ( zdcrit * 1.0E+9_wp )*0.2_wp ( zdmean / 150.0_wp )*0.048_wp &
5277	( ptemp / 293.0_wp )*( -0.75_wp ) ( arhoh2so4 / 1000.0_wp )**( -0.33_wp )
5278	!
5279	!-- Factor eta (nm, Eq. 11)
5280	zeta = MIN( zgamma * zcsink / z_gr_clust, zdcrit * 1.0E11_wp )
5281	ENDIF
5282	!
5283	!-- Number conc. of clusters surviving to 3 nm in a time step (#/m3, Eq.14)
5284	zj3 = zjnuc * EXP( MIN( 0.0_wp, zeta / 3.0_wp - zeta / ( zdcrit * 1.0E9_wp ) ) )
5285
5286	ELSEIF ( nj3 > 1 ) THEN ! Lehtinen et al. (2007) or Anttila et al. (2010)
5287	!
5288	!-- Defining the parameter m (zm_para) for calculating the coagulation sink onto background
5289	!-- particles (Eq. 5&6 in Lehtinen et al. 2007). The growth is investigated between
5290	!-- [d1,reglim(1)] = [zdcrit,3nm] and m = LOG( CoagS_dx / CoagX_zdcrit ) / LOG( reglim / zdcrit )
5291	!-- (Lehtinen et al. 2007, Eq. 6).
5292	!-- The steps for the coagulation sink for reglim = 3nm and zdcrit ~= 1nm are explained in
5293	!-- Kulmala et al. (2001). The particles of diameter zdcrit ~1.14 nm and reglim = 3nm are both
5294	!-- in turn the "number 1" variables (Kulmala et al. 2001).
5295	!-- c = critical (1nm), x = 3nm, 2 = wet or mean droplet
5296	!
5297	!-- Sum of the radii, R12 = R1 + R2 (m) of two particles 1 and 2
5298	z_r_c2 = zdcrit / 2.0_wp + paero(:)%dwet / 2.0_wp
5299	z_r_x2 = reglim(1) / 2.0_wp + paero(:)%dwet / 2.0_wp
5300	!
5301	!-- Particle mass (kg) (comes only from H2SO4)
5302	zm_c = 4.0_wp / 3.0_wp * pi * ( zdcrit / 2.0_wp )*3 arhoh2so4
5303	zm_x = 4.0_wp / 3.0_wp * pi * ( reglim(1) / 2.0_wp )*3 arhoh2so4
5304	zm_2 = 4.0_wp / 3.0_wp * pi * ( 0.5_wp * paero(:)%dwet )*3 arhoh2so4
5305	!
5306	!-- Mean relative thermal velocity between the particles (m/s)
5307	zcv_c = SQRT( 8.0_wp * abo * ptemp / ( pi * zm_c ) )
5308	zcv_x = SQRT( 8.0_wp * abo * ptemp / ( pi * zm_x ) )
5309	zcv_2 = SQRT( 8.0_wp * abo * ptemp / ( pi * zm_2 ) )
5310	!
5311	!-- Average velocity after coagulation
5312	zcv_c2(:) = SQRT( zcv_c2 + zcv_22 )
5313	zcv_x2(:) = SQRT( zcv_x2 + zcv_22 )
5314	!
5315	!-- Knudsen number (zmfp = mean free path of condensing vapour)
5316	zknud_c = 2.0_wp * zmfp / zdcrit
5317	zknud_x = 2.0_wp * zmfp / reglim(1)
5318	zknud_2(:) = MAX( 0.0_wp, 2.0_wp * zmfp / paero(:)%dwet )
5319	!
5320	!-- Cunningham correction factors (Allen and Raabe, 1985)
5321	zcc_c = 1.0_wp + zknud_c * ( 1.142_wp + 0.558_wp * EXP( -0.999_wp / zknud_c ) )
5322	zcc_x = 1.0_wp + zknud_x * ( 1.142_wp + 0.558_wp * EXP( -0.999_wp / zknud_x ) )
5323	zcc_2(:) = 1.0_wp + zknud_2(:) * ( 1.142_wp + 0.558_wp * EXP( -0.999_wp / zknud_2(:) ) )
5324	!
5325	!-- Gas dynamic viscosity (Ns/m2). Here, viscocity(air @20C) = 1.81e-5_dp N/m2 s (Hinds, p. 25)
5326	zmyy = 1.81E-5_wp * ( ptemp / 293.0_wp )**0.74_wp
5327	!
5328	!-- Particle diffusion coefficient (m2/s) (continuum regime)
5329	zdc_c(:) = abo * ptemp * zcc_c / ( 3.0_wp * pi * zmyy * zdcrit )
5330	zdc_x(:) = abo * ptemp * zcc_x / ( 3.0_wp * pi * zmyy * reglim(1) )
5331	zdc_2(:) = abo * ptemp * zcc_2(:) / ( 3.0_wp * pi * zmyy * paero(:)%dwet )
5332	!
5333	!-- D12 = D1+D2 (Seinfield and Pandis, 2nd ed. Eq. 13.38)
5334	zdc_c2 = zdc_c + zdc_2
5335	zdc_x2 = zdc_x + zdc_2
5336	!
5337	!-- zgamma_f = 8*D/pi/zcv (m) for calculating zomega (Fuchs, 1964)
5338	zgamma_f_c = 8.0_wp * zdc_c / pi / zcv_c
5339	zgamma_f_x = 8.0_wp * zdc_x / pi / zcv_x
5340	zgamma_f_2 = 8.0_wp * zdc_2 / pi / zcv_2
5341	!
5342	!-- zomega (m) for calculating zsigma
5343	zomega_c = ( ( z_r_c2 + zgamma_f_c )3 - ( z_r_c2 2 + zgamma_f_c )**1.5_wp ) / &
5344	( 3.0_wp * z_r_c2 * zgamma_f_c ) - z_r_c2
5345	zomega_x = ( ( z_r_x2 + zgamma_f_x )3 - ( z_r_x22 + zgamma_f_x )** 1.5_wp ) / &
5346	( 3.0_wp * z_r_x2 * zgamma_f_x ) - z_r_x2
5347	zomega_2c = ( ( z_r_c2 + zgamma_f_2 )3 - ( z_r_c22 + zgamma_f_2 )**1.5_wp ) / &
5348	( 3.0_wp * z_r_c2 * zgamma_f_2 ) - z_r_c2
5349	zomega_2x = ( ( z_r_x2 + zgamma_f_2 )3 - ( z_r_x22 + zgamma_f_2 )**1.5_wp ) / &
5350	( 3.0_wp * z_r_x2 * zgamma_f_2 ) - z_r_x2
5351	!
5352	!-- The distance (m) at which the two fluxes are matched (condensation and coagulation sinks)
5353	zsigma_c2 = SQRT( zomega_c2 + zomega_2c2 )
5354	zsigma_x2 = SQRT( zomega_x2 + zomega_2x2 )
5355	!
5356	!-- Coagulation coefficient in the continuum regime (m*m2/s, Eq. 17 in Kulmala et al., 2001)
5357	z_k_c2 = 4.0_wp * pi * z_r_c2 * zdc_c2 / ( z_r_c2 / ( z_r_c2 + zsigma_c2 ) + &
5358	4.0_wp * zdc_c2 / ( zcv_c2 * z_r_c2 ) )
5359	z_k_x2 = 4.0_wp * pi * z_r_x2 * zdc_x2 / ( z_r_x2 / ( z_r_x2 + zsigma_x2 ) + &
5360	4.0_wp * zdc_x2 / ( zcv_x2 * z_r_x2 ) )
5361	!
5362	!-- Coagulation sink (1/s, Eq. 16 in Kulmala et al., 2001)
5363	zcoags_c = MAX( 1.0E-20_wp, SUM( z_k_c2 * paero(:)%numc ) )
5364	zcoags_x = MAX( 1.0E-20_wp, SUM( z_k_x2 * paero(:)%numc ) )
5365	!
5366	!-- Parameter m for calculating the coagulation sink onto background particles (Eq. 5&6 in
5367	!-- Lehtinen et al. 2007)
5368	zm_para = LOG( zcoags_x / zcoags_c ) / LOG( reglim(1) / zdcrit )
5369	!
5370	!-- Parameter gamma for calculating the formation rate J of particles having
5371	!-- a diameter zdcrit < d < reglim(1) (Anttila et al. 2010, eq. 5 or Lehtinen et al.,2007, eq. 7)
5372	zgamma = ( ( ( reglim(1) / zdcrit )**( zm_para + 1.0_wp ) ) - 1.0_wp ) / ( zm_para + 1.0_wp )
5373
5374	IF ( nj3 == 2 ) THEN ! Lehtinen et al. (2007): coagulation sink
5375	!
5376	!-- Formation rate J before iteration (#/m3s)
5377	zj3 = zjnuc * EXP( MIN( 0.0_wp, -zgamma * zdcrit * zcoags_c / ( z_gr_clust * 1.0E-9_wp / &
5378	60.0_wp**2 ) ) )
5379
5380	ELSEIF ( nj3 == 3 ) THEN ! Anttila et al. (2010): coagulation sink and self-coag.
5381	!
5382	!-- If air is polluted, the self-coagulation becomes important. Self-coagulation of small
5383	!-- particles < 3 nm.
5384	!
5385	!-- "Effective" coagulation coefficient between freshly-nucleated particles:
5386	z_k_eff = 5.0E-16_wp ! m3/s
5387	!
5388	!-- zlambda parameter for "adjusting" the growth rate due to the self-coagulation
5389	zlambda = 6.0_wp
5390
5391	IF ( reglim(1) >= 10.0E-9_wp ) THEN ! for particles >10 nm:
5392	z_k_eff = 5.0E-17_wp
5393	zlambda = 3.0_wp
5394	ENDIF
5395	!
5396	!-- Initial values for coagulation sink and growth rate (m/s)
5397	zcoagstot = zcoags_c
5398	z_gr_tot = z_gr_clust * 1.0E-9_wp / 60.0_wp**2
5399	!
5400	!-- Number of clusters/particles at the size range [d1,dx] (#/m3):
5401	z_n_nuc = zjnuc / zcoagstot !< Initial guess
5402	!
5403	!-- Coagulation sink and growth rate due to self-coagulation:
5404	DO iteration = 1, 5
5405	zcoagstot = zcoags_c + z_k_eff * z_n_nuc * 1.0E-6_wp ! (1/s, Anttila et al., eq. 1)
5406	z_gr_tot = z_gr_clust * 2.77777777E-7_wp + 1.5708E-6_wp * zlambda * zdcrit*3 &
5407	( z_n_nuc * 1.0E-6_wp ) * zcv_c * avo * 2.77777777E-7_wp ! (Eq. 3)
5408	zeta = - zcoagstot / ( ( zm_para + 1.0_wp ) * z_gr_tot * ( zdcrit**zm_para ) ) ! (Eq.7b)
5409	!
5410	!-- Calculate Eq. 7a (Taylor series for the number of particles between [d1,dx])
5411	z_n_nuc = z_n_nuc_tayl( zdcrit, reglim(1), zm_para, zjnuc, zeta, z_gr_tot )
5412	ENDDO
5413	!
5414	!-- Calculate the final values with new z_n_nuc:
5415	zcoagstot = zcoags_c + z_k_eff * z_n_nuc * 1.0E-6_wp ! (1/s)
5416	z_gr_tot = z_gr_clust * 1.0E-9_wp / 3600.0_wp + 1.5708E-6_wp * zlambda * zdcrit*3 &
5417	( z_n_nuc * 1.0E-6_wp ) * zcv_c * avo * 1.0E-9_wp / 3600.0_wp !< (m/s)
5418	zj3 = zjnuc * EXP( MIN( 0.0_wp, -zgamma * zdcrit * zcoagstot / z_gr_tot ) ) ! (#/m3s, Eq.5a)
5419
5420	ENDIF
5421	ENDIF
5422	!
5423	!-- If J3 very small (< 1 #/cm3), neglect particle formation. In real atmosphere this would mean
5424	!-- that clusters form but coagulate to pre-existing particles who gain sulphate. Since
5425	!-- CoagS ~ CS (4piDCS'), we do not* update H2SO4 concentration here but let condensation take
5426	!-- care of it. Formation mass rate of molecules (molec/m3s) for 1: H2SO4 and 2: organic vapour
5427	pj3n3(1) = zj3 * n3 * pxsa
5428	pj3n3(2) = zj3 * n3 * pxocnv
5429
5430	END SUBROUTINE nucleation
5431
5432	!------------------------------------------------------------------------------!
5433	! Description:
5434	! ------------
5435	!> Calculate the nucleation rate and the size of critical clusters assuming
5436	!> binary nucleation.
5437	!> Parametrisation according to Vehkamaki et al. (2002), J. Geophys. Res.,
5438	!> 107(D22), 4622. Called from subroutine nucleation.
5439	!------------------------------------------------------------------------------!
5440	SUBROUTINE binnucl( pc_sa, ptemp, prh, pnuc_rate, pn_crit_sa, pn_crit_ocnv, pd_crit, pk_sa, &
5441	pk_ocnv )
5442
5443	IMPLICIT NONE
5444
5445	REAL(wp) :: za !<
5446	REAL(wp) :: zb !<
5447	REAL(wp) :: zc !<
5448	REAL(wp) :: zcoll !<
5449	REAL(wp) :: zlogsa !< LOG( zpcsa )
5450	REAL(wp) :: zlogrh !< LOG( zrh )
5451	REAL(wp) :: zm1 !<
5452	REAL(wp) :: zm2 !<
5453	REAL(wp) :: zma !<
5454	REAL(wp) :: zmw !<
5455	REAL(wp) :: zntot !< number of molecules in critical cluster
5456	REAL(wp) :: zpcsa !< sulfuric acid concentration
5457	REAL(wp) :: zrh !< relative humidity
5458	REAL(wp) :: zroo !<
5459	REAL(wp) :: zt !< temperature
5460	REAL(wp) :: zv1 !<
5461	REAL(wp) :: zv2 !<
5462	REAL(wp) :: zx !< mole fraction of sulphate in critical cluster
5463	REAL(wp) :: zxmass !<
5464
5465	REAL(wp), INTENT(in) :: pc_sa !< H2SO4 conc. (#/cm3)
5466	REAL(wp), INTENT(in) :: prh !< relative humidity [0-1
5467	REAL(wp), INTENT(in) :: ptemp !< ambient temperature (K)
5468
5469	REAL(wp), INTENT(out) :: pnuc_rate !< nucleation rate (#/(m3 s))
5470	REAL(wp), INTENT(out) :: pn_crit_sa !< number of H2SO4 molecules in cluster (#)
5471	REAL(wp), INTENT(out) :: pn_crit_ocnv !< number of organic molecules in cluster (#)
5472	REAL(wp), INTENT(out) :: pd_crit !< diameter of critical cluster (m)
5473	REAL(wp), INTENT(out) :: pk_sa !< Lever: if pk_sa = 1, H2SO4 is involved in nucleation.
5474	REAL(wp), INTENT(out) :: pk_ocnv !< Lever: if pk_ocnv = 1, organic compounds are involved
5475
5476	pnuc_rate = 0.0_wp
5477	pd_crit = 1.0E-9_wp
5478	!
5479	!-- 1) Checking that we are in the validity range of the parameterization
5480	zpcsa = MAX( pc_sa, 1.0E4_wp )
5481	zpcsa = MIN( zpcsa, 1.0E11_wp )
5482	zrh = MAX( prh, 0.0001_wp )
5483	zrh = MIN( zrh, 1.0_wp )
5484	zt = MAX( ptemp, 190.15_wp )
5485	zt = MIN( zt, 300.15_wp )
5486
5487	zlogsa = LOG( zpcsa )
5488	zlogrh = LOG( prh )
5489	!
5490	!-- 2) Mole fraction of sulphate in a critical cluster (Eq. 11)
5491	zx = 0.7409967177282139_wp - 0.002663785665140117_wp * zt + &
5492	0.002010478847383187_wp * zlogrh - 0.0001832894131464668_wp* zt * zlogrh + &
5493	0.001574072538464286_wp * zlogrh*2 - 0.00001790589121766952_wp zt * zlogrh**2 + &
5494	0.0001844027436573778_wp * zlogrh*3 - 1.503452308794887E-6_wp zt * zlogrh**3 - &
5495	0.003499978417957668_wp * zlogsa + 0.0000504021689382576_wp * zt * zlogsa
5496	!
5497	!-- 3) Nucleation rate (Eq. 12)
5498	pnuc_rate = 0.1430901615568665_wp + 2.219563673425199_wp * zt - &
5499	0.02739106114964264_wp * zt*2 + 0.00007228107239317088_wp zt**3 + &
5500	5.91822263375044_wp / zx + 0.1174886643003278_wp * zlogrh + &
5501	0.4625315047693772_wp * zt * zlogrh - 0.01180591129059253_wp * zt*2 zlogrh + &
5502	0.0000404196487152575_wp * zt*3 zlogrh + &
5503	( 15.79628615047088_wp * zlogrh ) / zx - 0.215553951893509_wp * zlogrh**2 - &
5504	0.0810269192332194_wp * zt * zlogrh**2 + &
5505	0.001435808434184642_wp * zt*2 zlogrh**2 - &
5506	4.775796947178588E-6_wp * zt*3 zlogrh**2 - &
5507	( 2.912974063702185_wp * zlogrh*2 ) / zx - 3.588557942822751_wp zlogrh**3 + &
5508	0.04950795302831703_wp * zt * zlogrh**3 - &
5509	0.0002138195118737068_wp * zt*2 zlogrh**3 + &
5510	3.108005107949533E-7_wp * zt*3 zlogrh**3 - &
5511	( 0.02933332747098296_wp * zlogrh*3 ) / zx + 1.145983818561277_wp zlogsa - &
5512	0.6007956227856778_wp * zt * zlogsa + 0.00864244733283759_wp * zt*2 zlogsa - &
5513	0.00002289467254710888_wp * zt*3 zlogsa - &
5514	( 8.44984513869014_wp * zlogsa ) / zx + 2.158548369286559_wp * zlogrh * zlogsa + &
5515	0.0808121412840917_wp * zt * zlogrh * zlogsa - &
5516	0.0004073815255395214_wp * zt*2 zlogrh * zlogsa - &
5517	4.019572560156515E-7_wp * zt*3 zlogrh * zlogsa + &
5518	( 0.7213255852557236_wp * zlogrh * zlogsa ) / zx + &
5519	1.62409850488771_wp * zlogrh*2 zlogsa - &
5520	0.01601062035325362_wp * zt * zlogrh*2 zlogsa + &
5521	0.00003771238979714162_wpzt2 zlogrh*2 zlogsa + &
5522	3.217942606371182E-8_wp * zt*3 zlogrh*2 zlogsa - &
5523	( 0.01132550810022116_wp * zlogrh*2 zlogsa ) / zx + &
5524	9.71681713056504_wp * zlogsa*2 - 0.1150478558347306_wp zt * zlogsa**2 + &
5525	0.0001570982486038294_wp * zt*2 zlogsa**2 + &
5526	4.009144680125015E-7_wp * zt*3 zlogsa**2 + &
5527	( 0.7118597859976135_wp * zlogsa**2 ) / zx - &
5528	1.056105824379897_wp * zlogrh * zlogsa**2 + &
5529	0.00903377584628419_wp * zt * zlogrh * zlogsa**2 - &
5530	0.00001984167387090606_wp * zt*2 zlogrh * zlogsa**2 + &
5531	2.460478196482179E-8_wp * zt*3 zlogrh * zlogsa**2 - &
5532	( 0.05790872906645181_wp * zlogrh * zlogsa**2 ) / zx - &
5533	0.1487119673397459_wp * zlogsa*3 + 0.002835082097822667_wp zt * zlogsa**3 - &
5534	9.24618825471694E-6_wp * zt*2 zlogsa**3 + &
5535	5.004267665960894E-9_wp * zt*3 zlogsa**3 - &
5536	( 0.01270805101481648_wp * zlogsa**3 ) / zx
5537	!
5538	!-- Nucleation rate in #/(cm3 s)
5539	pnuc_rate = EXP( pnuc_rate )
5540	!
5541	!-- Check the validity of parameterization
5542	IF ( pnuc_rate < 1.0E-7_wp ) THEN
5543	pnuc_rate = 0.0_wp
5544	pd_crit = 1.0E-9_wp
5545	ENDIF
5546	!
5547	!-- 4) Total number of molecules in the critical cluster (Eq. 13)
5548	zntot = - 0.002954125078716302_wp - 0.0976834264241286_wp * zt + &
5549	0.001024847927067835_wp * zt*2 - 2.186459697726116E-6_wp zt**3 - &
5550	0.1017165718716887_wp / zx - 0.002050640345231486_wp * zlogrh - &
5551	0.007585041382707174_wp * zt * zlogrh + 0.0001926539658089536_wp * zt*2 zlogrh - &
5552	6.70429719683894E-7_wp * zt*3 zlogrh - ( 0.2557744774673163_wp * zlogrh ) / zx + &
5553	0.003223076552477191_wp * zlogrh*2 + 0.000852636632240633_wp zt * zlogrh**2 - &
5554	0.00001547571354871789_wp * zt*2 zlogrh**2 + &
5555	5.666608424980593E-8_wp * zt*3 zlogrh**2 + &
5556	( 0.03384437400744206_wp * zlogrh**2 ) / zx + &
5557	0.04743226764572505_wp * zlogrh*3 - 0.0006251042204583412_wp zt * zlogrh**3 + &
5558	2.650663328519478E-6_wp * zt*2 zlogrh**3 - &
5559	3.674710848763778E-9_wp * zt*3 zlogrh**3 - &
5560	( 0.0002672510825259393_wp * zlogrh*3 ) / zx - 0.01252108546759328_wp zlogsa + &
5561	0.005806550506277202_wp * zt * zlogsa - 0.0001016735312443444_wp * zt*2 zlogsa + &
5562	2.881946187214505E-7_wp * zt*3 zlogsa + ( 0.0942243379396279_wp * zlogsa ) / zx - &
5563	0.0385459592773097_wp * zlogrh * zlogsa - &
5564	0.0006723156277391984_wp * zt * zlogrh * zlogsa + &
5565	2.602884877659698E-6_wp * zt*2 zlogrh * zlogsa + &
5566	1.194163699688297E-8_wp * zt*3 zlogrh * zlogsa - &
5567	( 0.00851515345806281_wp * zlogrh * zlogsa ) / zx - &
5568	0.01837488495738111_wp * zlogrh*2 zlogsa + &
5569	0.0001720723574407498_wp * zt * zlogrh*2 zlogsa - &
5570	3.717657974086814E-7_wp * zt*2 zlogrh*2 zlogsa - &
5571	5.148746022615196E-10_wp * zt*3 zlogrh*2 zlogsa + &
5572	( 0.0002686602132926594_wp * zlogrh*2 zlogsa ) / zx - &
5573	0.06199739728812199_wp * zlogsa*2 + 0.000906958053583576_wp zt * zlogsa**2 - &
5574	9.11727926129757E-7_wp * zt*2 zlogsa**2 - &
5575	5.367963396508457E-9_wp * zt*3 zlogsa**2 - &
5576	( 0.007742343393937707_wp * zlogsa**2 ) / zx + &
5577	0.0121827103101659_wp * zlogrh * zlogsa**2 - &
5578	0.0001066499571188091_wp * zt * zlogrh * zlogsa**2 + &
5579	2.534598655067518E-7_wp * zt*2 zlogrh * zlogsa**2 - &
5580	3.635186504599571E-10_wp * zt*3 zlogrh * zlogsa**2 + &
5581	( 0.0006100650851863252_wp * zlogrh * zlogsa **2 ) / zx + &
5582	0.0003201836700403512_wp * zlogsa*3 - 0.0000174761713262546_wp zt * zlogsa**3 + &
5583	6.065037668052182E-8_wp * zt*2 zlogsa**3 - &
5584	1.421771723004557E-11_wp * zt*3 zlogsa**3 + &
5585	( 0.0001357509859501723_wp * zlogsa**3 ) / zx
5586	zntot = EXP( zntot ) ! in #
5587	!
5588	!-- 5) Size of the critical cluster pd_crit (m) (diameter) (Eq. 14)
5589	pn_crit_sa = zx * zntot
5590	pd_crit = 2.0E-9_wp * EXP( -1.6524245_wp + 0.42316402_wp * zx + 0.33466487_wp * LOG( zntot ) )
5591	!
5592	!-- 6) Organic compounds not involved when binary nucleation is assumed
5593	pn_crit_ocnv = 0.0_wp ! number of organic molecules
5594	pk_sa = 1.0_wp ! if = 1, H2SO4 involved in nucleation
5595	pk_ocnv = 0.0_wp ! if = 1, organic compounds involved
5596	!
5597	!-- Set nucleation rate to collision rate
5598	IF ( pn_crit_sa < 4.0_wp ) THEN
5599	!
5600	!-- Volumes of the colliding objects
5601	zma = 96.0_wp ! molar mass of SO4 in g/mol
5602	zmw = 18.0_wp ! molar mass of water in g/mol
5603	zxmass = 1.0_wp ! mass fraction of H2SO4
5604	za = 0.7681724_wp + zxmass * ( 2.1847140_wp + zxmass * &
5605	( 7.1630022_wp + zxmass * &
5606	( -44.31447_wp + zxmass * &
5607	( 88.75606 + zxmass * &
5608	( -75.73729_wp + zxmass * 23.43228_wp ) ) ) ) )
5609	zb = 1.808225E-3_wp + zxmass * ( -9.294656E-3_wp + zxmass * &
5610	( -0.03742148_wp + zxmass * &
5611	( 0.2565321_wp + zxmass * &
5612	( -0.5362872_wp + zxmass * &
5613	( 0.4857736 - zxmass * 0.1629592_wp ) ) ) ) )
5614	zc = - 3.478524E-6_wp + zxmass * ( 1.335867E-5_wp + zxmass * &
5615	( 5.195706E-5_wp + zxmass * &
5616	( -3.717636E-4_wp + zxmass * &
5617	( 7.990811E-4_wp + zxmass * &
5618	( -7.458060E-4_wp + zxmass * 2.58139E-4_wp ) ) ) ) )
5619	!
5620	!-- Density for the sulphuric acid solution (Eq. 10 in Vehkamaki)
5621	zroo = ( za + zt * ( zb + zc * zt ) ) * 1.0E+3_wp ! (kg/m^3
5622	zm1 = 0.098_wp ! molar mass of H2SO4 in kg/mol
5623	zm2 = zm1
5624	zv1 = zm1 / avo / zroo ! volume
5625	zv2 = zv1
5626	!
5627	!-- Collision rate
5628	zcoll = zpcsa * zpcsa * ( 3.0_wp * pi / 4.0_wp )*0.16666666_wp &
5629	SQRT( 6.0_wp * argas * zt / zm1 + 6.0_wp * argas * zt / zm2 ) * &
5630	( zv10.33333333_wp + zv20.33333333_wp )*2 1.0E+6_wp ! m3 -> cm3
5631	zcoll = MIN( zcoll, 1.0E+10_wp )
5632	pnuc_rate = zcoll ! (#/(cm3 s))
5633
5634	ELSE
5635	pnuc_rate = MIN( pnuc_rate, 1.0E+10_wp )
5636	ENDIF
5637	pnuc_rate = pnuc_rate * 1.0E+6_wp ! (#/(m3 s))
5638
5639	END SUBROUTINE binnucl
5640
5641	!------------------------------------------------------------------------------!
5642	! Description:
5643	! ------------
5644	!> Calculate the nucleation rate and the size of critical clusters assuming
5645	!> ternary nucleation. Parametrisation according to:
5646	!> Napari et al. (2002), J. Chem. Phys., 116, 4221-4227 and
5647	!> Napari et al. (2002), J. Geophys. Res., 107(D19), AAC 6-1-ACC 6-6.
5648	!------------------------------------------------------------------------------!
5649	SUBROUTINE ternucl( pc_sa, pc_nh3, ptemp, prh, pnuc_rate, pn_crit_sa, pn_crit_ocnv, pd_crit, &
5650	pk_sa, pk_ocnv )
5651
5652	IMPLICIT NONE
5653
5654	REAL(wp) :: zlnj !< logarithm of nucleation rate
5655	REAL(wp) :: zlognh3 !< LOG( pc_nh3 )
5656	REAL(wp) :: zlogrh !< LOG( prh )
5657	REAL(wp) :: zlogsa !< LOG( pc_sa )
5658
5659	REAL(wp), INTENT(in) :: pc_nh3 !< ammonia mixing ratio (ppt)
5660	REAL(wp), INTENT(in) :: pc_sa !< H2SO4 conc. (#/cm3)
5661	REAL(wp), INTENT(in) :: prh !< relative humidity [0-1]
5662	REAL(wp), INTENT(in) :: ptemp !< ambient temperature (K)
5663
5664	REAL(wp), INTENT(out) :: pd_crit !< diameter of critical cluster (m)
5665	REAL(wp), INTENT(out) :: pk_ocnv !< if pk_ocnv = 1, organic compounds participate in nucleation
5666	REAL(wp), INTENT(out) :: pk_sa !< if pk_sa = 1, H2SO4 participate in nucleation
5667	REAL(wp), INTENT(out) :: pn_crit_ocnv !< number of organic molecules in cluster (#)
5668	REAL(wp), INTENT(out) :: pn_crit_sa !< number of H2SO4 molecules in cluster (#)
5669	REAL(wp), INTENT(out) :: pnuc_rate !< nucleation rate (#/(m3 s))
5670	!
5671	!-- 1) Checking that we are in the validity range of the parameterization.
5672	!-- Validity of parameterization : DO NOT REMOVE!
5673	IF ( ptemp < 240.0_wp .OR. ptemp > 300.0_wp ) THEN
5674	message_string = 'Invalid input value: ptemp'
5675	CALL message( 'salsa_mod: ternucl', 'PA0689', 1, 2, 0, 6, 0 )
5676	ENDIF
5677	IF ( prh < 0.05_wp .OR. prh > 0.95_wp ) THEN
5678	message_string = 'Invalid input value: prh'
5679	CALL message( 'salsa_mod: ternucl', 'PA0649', 1, 2, 0, 6, 0 )
5680	ENDIF
5681	IF ( pc_sa < 1.0E+4_wp .OR. pc_sa > 1.0E+9_wp ) THEN
5682	message_string = 'Invalid input value: pc_sa'
5683	CALL message( 'salsa_mod: ternucl', 'PA0650', 1, 2, 0, 6, 0 )
5684	ENDIF
5685	IF ( pc_nh3 < 0.1_wp .OR. pc_nh3 > 100.0_wp ) THEN
5686	message_string = 'Invalid input value: pc_nh3'
5687	CALL message( 'salsa_mod: ternucl', 'PA0651', 1, 2, 0, 6, 0 )
5688	ENDIF
5689
5690	zlognh3 = LOG( pc_nh3 )
5691	zlogrh = LOG( prh )
5692	zlogsa = LOG( pc_sa )
5693	!
5694	!-- 2) Nucleation rate (Eq. 7 in Napari et al., 2002: Parameterization of
5695	!-- ternary nucleation of sulfuric acid - ammonia - water.
5696	zlnj = - 84.7551114741543_wp + 0.3117595133628944_wp * prh + &
5697	1.640089605712946_wp * prh * ptemp - 0.003438516933381083_wp * prh * ptemp**2 - &
5698	0.00001097530402419113_wp * prh * ptemp**3 - 0.3552967070274677_wp / zlogsa - &
5699	( 0.06651397829765026_wp * prh ) / zlogsa - ( 33.84493989762471_wp * ptemp ) / zlogsa - &
5700	( 7.823815852128623_wp * prh * ptemp ) / zlogsa + &
5701	( 0.3453602302090915_wp * ptemp**2 ) / zlogsa + &
5702	( 0.01229375748100015_wp * prh * ptemp**2 ) / zlogsa - &
5703	( 0.000824007160514956_wp ptemp*3 ) / zlogsa + &
5704	( 0.00006185539100670249_wp * prh * ptemp**3 ) / zlogsa + &
5705	3.137345238574998_wp * zlogsa + 3.680240980277051_wp * prh * zlogsa - &
5706	0.7728606202085936_wp * ptemp * zlogsa - 0.204098217156962_wp * prh * ptemp * zlogsa + &
5707	0.005612037586790018_wp * ptemp*2 zlogsa + &
5708	0.001062588391907444_wp * prh * ptemp*2 zlogsa - &
5709	9.74575691760229E-6_wp * ptemp*3 zlogsa - &
5710	1.265595265137352E-6_wp * prh * ptemp*3 zlogsa + 19.03593713032114_wp * zlogsa**2 - &
5711	0.1709570721236754_wp * ptemp * zlogsa**2 + &
5712	0.000479808018162089_wp * ptemp*2 zlogsa**2 - &
5713	4.146989369117246E-7_wp * ptemp*3 zlogsa*2 + 1.076046750412183_wp zlognh3 + &
5714	0.6587399318567337_wp * prh * zlognh3 + 1.48932164750748_wp * ptemp * zlognh3 + &
5715	0.1905424394695381_wp * prh * ptemp * zlognh3 - &
5716	0.007960522921316015_wp * ptemp*2 zlognh3 - &
5717	0.001657184248661241_wp * prh * ptemp*2 zlognh3 + &
5718	7.612287245047392E-6_wp * ptemp*3 zlognh3 + &
5719	3.417436525881869E-6_wp * prh * ptemp*3 zlognh3 + &
5720	( 0.1655358260404061_wp * zlognh3 ) / zlogsa + &
5721	( 0.05301667612522116_wp * prh * zlognh3 ) / zlogsa + &
5722	( 3.26622914116752_wp * ptemp * zlognh3 ) / zlogsa - &
5723	( 1.988145079742164_wp * prh * ptemp * zlognh3 ) / zlogsa - &
5724	( 0.04897027401984064_wp * ptemp*2 zlognh3 ) / zlogsa + &
5725	( 0.01578269253599732_wp * prh * ptemp*2 zlognh3 ) / zlogsa + &
5726	( 0.0001469672236351303_wp * ptemp*3 zlognh3 ) / zlogsa - &
5727	( 0.00002935642836387197_wp * prh * ptemp*3 zlognh3 ) / zlogsa + &
5728	6.526451177887659_wp * zlogsa * zlognh3 - &
5729	0.2580021816722099_wp * ptemp * zlogsa * zlognh3 + &
5730	0.001434563104474292_wp * ptemp*2 zlogsa * zlognh3 - &
5731	2.020361939304473E-6_wp * ptemp*3 zlogsa * zlognh3 - &
5732	0.160335824596627_wp * zlogsa*2 zlognh3 + &
5733	0.00889880721460806_wp * ptemp * zlogsa*2 zlognh3 - &
5734	0.00005395139051155007_wp * ptemp*2 zlogsa*2 zlognh3 + &
5735	8.39521718689596E-8_wp * ptemp*3 zlogsa*2 zlognh3 + &
5736	6.091597586754857_wp * zlognh3*2 + 8.5786763679309_wp prh * zlognh3**2 - &
5737	1.253783854872055_wp * ptemp * zlognh3**2 - &
5738	0.1123577232346848_wp * prh * ptemp * zlognh3**2 + &
5739	0.00939835595219825_wp * ptemp*2 zlognh3**2 + &
5740	0.0004726256283031513_wp * prh * ptemp*2 zlognh3**2 - &
5741	0.00001749269360523252_wp * ptemp*3 zlognh3**2 - &
5742	6.483647863710339E-7_wp * prh * ptemp*3 zlognh3**2 + &
5743	( 0.7284285726576598_wp * zlognh3**2 ) / zlogsa + &
5744	( 3.647355600846383_wp * ptemp * zlognh3**2 ) / zlogsa - &
5745	( 0.02742195276078021_wp * ptemp*2 zlognh3**2 ) / zlogsa + &
5746	( 0.00004934777934047135_wp * ptemp*3 zlognh3**2 ) / zlogsa + &
5747	41.30162491567873_wp * zlogsa * zlognh3**2 - &
5748	0.357520416800604_wp * ptemp * zlogsa * zlognh3**2 + &
5749	0.000904383005178356_wp * ptemp*2 zlogsa * zlognh3**2 - &
5750	5.737876676408978E-7_wp * ptemp*3 zlogsa * zlognh3**2 - &
5751	2.327363918851818_wp * zlogsa*2 zlognh3**2 + &
5752	0.02346464261919324_wp * ptemp * zlogsa*2 zlognh3**2 - &
5753	0.000076518969516405_wp * ptemp*2 zlogsa*2 zlognh3**2 + &
5754	8.04589834836395E-8_wp * ptemp*3 zlogsa*2 zlognh3**2 - &
5755	0.02007379204248076_wp * zlogrh - 0.7521152446208771_wp * ptemp * zlogrh + &
5756	0.005258130151226247_wp * ptemp*2 zlogrh - &
5757	8.98037634284419E-6_wp * ptemp*3 zlogrh + &
5758	( 0.05993213079516759_wp * zlogrh ) / zlogsa + &
5759	( 5.964746463184173_wp * ptemp * zlogrh ) / zlogsa - &
5760	( 0.03624322255690942_wp * ptemp*2 zlogrh ) / zlogsa + &
5761	( 0.00004933369382462509_wp * ptemp*3 zlogrh ) / zlogsa - &
5762	0.7327310805365114_wp * zlognh3 * zlogrh - &
5763	0.01841792282958795_wp * ptemp * zlognh3 * zlogrh + &
5764	0.0001471855981005184_wp * ptemp*2 zlognh3 * zlogrh - &
5765	2.377113195631848E-7_wp * ptemp*3 zlognh3 * zlogrh
5766	pnuc_rate = EXP( zlnj ) ! (#/(cm3 s))
5767	!
5768	!-- Check validity of parametrization
5769	IF ( pnuc_rate < 1.0E-5_wp ) THEN
5770	pnuc_rate = 0.0_wp
5771	pd_crit = 1.0E-9_wp
5772	ELSEIF ( pnuc_rate > 1.0E6_wp ) THEN
5773	message_string = 'Invalid output value: nucleation rate > 10^6 1/cm3s'
5774	CALL message( 'salsa_mod: ternucl', 'PA0623', 1, 2, 0, 6, 0 )
5775	ENDIF
5776	pnuc_rate = pnuc_rate * 1.0E6_wp ! (#/(m3 s))
5777	!
5778	!-- 3) Number of H2SO4 molecules in a critical cluster (Eq. 9)
5779	pn_crit_sa = 38.16448247950508_wp + 0.7741058259731187_wp * zlnj + &
5780	0.002988789927230632_wp * zlnj*2 - 0.3576046920535017_wp ptemp - &
5781	0.003663583011953248_wp * zlnj * ptemp + 0.000855300153372776_wp * ptemp**2
5782	!
5783	!-- Kinetic limit: at least 2 H2SO4 molecules in a cluster
5784	pn_crit_sa = MAX( pn_crit_sa, 2.0E0_wp )
5785	!
5786	!-- 4) Size of the critical cluster in nm (Eq. 12)
5787	pd_crit = 0.1410271086638381_wp - 0.001226253898894878_wp * zlnj - &
5788	7.822111731550752E-6_wp * zlnj*2 - 0.001567273351921166_wp ptemp - &
5789	0.00003075996088273962_wp * zlnj * ptemp + 0.00001083754117202233_wp * ptemp**2
5790	pd_crit = pd_crit * 2.0E-9_wp ! Diameter in m
5791	!
5792	!-- 5) Organic compounds not involved when ternary nucleation assumed
5793	pn_crit_ocnv = 0.0_wp
5794	pk_sa = 1.0_wp
5795	pk_ocnv = 0.0_wp
5796
5797	END SUBROUTINE ternucl
5798
5799	!------------------------------------------------------------------------------!
5800	! Description:
5801	! ------------
5802	!> Function z_n_nuc_tayl is connected to the calculation of self-coagualtion of
5803	!> small particles. It calculates number of the particles in the size range
5804	!> [zdcrit,dx] using Taylor-expansion (please note that the expansion is not
5805	!> valid for certain rational numbers, e.g. -4/3 and -3/2)
5806	!------------------------------------------------------------------------------!
5807	FUNCTION z_n_nuc_tayl( d1, dx, zm_para, zjnuc_t, zeta, z_gr_tot )
5808
5809	IMPLICIT NONE
5810
5811	INTEGER(iwp) :: i !< running index
5812
5813	REAL(wp) :: d1 !< lower diameter limit
5814	REAL(wp) :: dx !< upper diameter limit
5815	REAL(wp) :: zjnuc_t !< initial nucleation rate (1/s)
5816	REAL(wp) :: zeta !< ratio of CS/GR (m) (condensation sink / growth rate)
5817	REAL(wp) :: term1 !<
5818	REAL(wp) :: term2 !<
5819	REAL(wp) :: term3 !<
5820	REAL(wp) :: term4 !<
5821	REAL(wp) :: term5 !<
5822	REAL(wp) :: z_n_nuc_tayl !< final nucleation rate (1/s)
5823	REAL(wp) :: z_gr_tot !< total growth rate (nm/h)
5824	REAL(wp) :: zm_para !< m parameter in Lehtinen et al. (2007), Eq. 6
5825
5826	z_n_nuc_tayl = 0.0_wp
5827
5828	DO i = 0, 29
5829	IF ( i == 0 .OR. i == 1 ) THEN
5830	term1 = 1.0_wp
5831	ELSE
5832	term1 = term1 * REAL( i, SELECTED_REAL_KIND(12,307) )
5833	END IF
5834	term2 = ( REAL( i, SELECTED_REAL_KIND(12,307) ) * ( zm_para + 1.0_wp ) + 1.0_wp ) * term1
5835	term3 = zeta**i
5836	term4 = term3 / term2
5837	term5 = REAL( i, SELECTED_REAL_KIND(12,307) ) * ( zm_para + 1.0_wp ) + 1.0_wp
5838	z_n_nuc_tayl = z_n_nuc_tayl + term4 * ( dxterm5 - d1term5 )
5839	ENDDO
5840	z_n_nuc_tayl = z_n_nuc_tayl * zjnuc_t * EXP( -zeta * ( d1**( zm_para + 1 ) ) ) / z_gr_tot
5841
5842	END FUNCTION z_n_nuc_tayl
5843
5844	!------------------------------------------------------------------------------!
5845	! Description:
5846	! ------------
5847	!> Calculates the condensation of water vapour on aerosol particles. Follows the
5848	!> analytical predictor method by Jacobson (2005).
5849	!> For equations, see Jacobson (2005), Fundamentals of atmospheric modelling
5850	!> (2nd edition).
5851	!------------------------------------------------------------------------------!
5852	SUBROUTINE gpparth2o( paero, ptemp, ppres, pcs, pcw, ptstep )
5853
5854	IMPLICIT NONE
5855
5856	INTEGER(iwp) :: ib !< loop index
5857	INTEGER(iwp) :: nstr !<
5858
5859	REAL(wp) :: adt !< internal timestep in this subroutine
5860	REAL(wp) :: rhoair !< air density (kg/m3)
5861	REAL(wp) :: ttot !< total time (s)
5862	REAL(wp) :: zact !< Water activity
5863	REAL(wp) :: zaelwc1 !< Current aerosol water content (kg/m3)
5864	REAL(wp) :: zaelwc2 !< New aerosol water content after equilibrium calculation (kg/m3)
5865	REAL(wp) :: zbeta !< Transitional correction factor
5866	REAL(wp) :: zcwc !< Current water vapour mole concentration in aerosols (mol/m3)
5867	REAL(wp) :: zcwint !< Current and new water vapour mole concentrations (mol/m3)
5868	REAL(wp) :: zcwn !< New water vapour mole concentration (mol/m3)
5869	REAL(wp) :: zcwtot !< Total water mole concentration (mol/m3)
5870	REAL(wp) :: zdfh2o !< molecular diffusion coefficient (cm2/s) for water
5871	REAL(wp) :: zhlp1 !< intermediate variable to calculate the mass transfer coefficient
5872	REAL(wp) :: zhlp2 !< intermediate variable to calculate the mass transfer coefficient
5873	REAL(wp) :: zhlp3 !< intermediate variable to calculate the mass transfer coefficient
5874	REAL(wp) :: zknud !< Knudsen number
5875	REAL(wp) :: zmfph2o !< mean free path of H2O gas molecule
5876	REAL(wp) :: zrh !< relative humidity [0-1]
5877	REAL(wp) :: zthcond !< thermal conductivity of air (W/m/K)
5878
5879	REAL(wp), DIMENSION(nbins_aerosol) :: zcwcae !< Current water mole concentrations
5880	REAL(wp), DIMENSION(nbins_aerosol) :: zcwintae !< Current and new aerosol water mole concentration
5881	REAL(wp), DIMENSION(nbins_aerosol) :: zcwnae !< New water mole concentration in aerosols
5882	REAL(wp), DIMENSION(nbins_aerosol) :: zcwsurfae !< Surface mole concentration
5883	REAL(wp), DIMENSION(nbins_aerosol) :: zkelvin !< Kelvin effect
5884	REAL(wp), DIMENSION(nbins_aerosol) :: zmtae !< Mass transfer coefficients
5885	REAL(wp), DIMENSION(nbins_aerosol) :: zwsatae !< Water saturation ratio above aerosols
5886
5887	REAL(wp), INTENT(in) :: ppres !< Air pressure (Pa)
5888	REAL(wp), INTENT(in) :: pcs !< Water vapour saturation concentration (kg/m3)
5889	REAL(wp), INTENT(in) :: ptemp !< Ambient temperature (K)
5890	REAL(wp), INTENT(in) :: ptstep !< timestep (s)
5891
5892	REAL(wp), INTENT(inout) :: pcw !< Water vapour concentration (kg/m3)
5893
5894	TYPE(t_section), DIMENSION(nbins_aerosol), INTENT(inout) :: paero !< Aerosol properties
5895	!
5896	!-- Relative humidity [0-1]
5897	zrh = pcw / pcs
5898	!
5899	!-- Calculate the condensation only for 2a/2b aerosol bins
5900	nstr = start_subrange_2a
5901	!
5902	!-- Save the current aerosol water content, 8 in paero is H2O
5903	zaelwc1 = SUM( paero(start_subrange_1a:end_subrange_2b)%volc(8) ) * arhoh2o
5904	!
5905	!-- Equilibration:
5906	IF ( advect_particle_water ) THEN
5907	IF ( zrh < 0.98_wp .OR. .NOT. lscndh2oae ) THEN
5908	CALL equilibration( zrh, ptemp, paero, .TRUE. )
5909	ELSE
5910	CALL equilibration( zrh, ptemp, paero, .FALSE. )
5911	ENDIF
5912	ENDIF
5913	!
5914	!-- The new aerosol water content after equilibrium calculation
5915	zaelwc2 = SUM( paero(start_subrange_1a:end_subrange_2b)%volc(8) ) * arhoh2o
5916	!
5917	!-- New water vapour mixing ratio (kg/m3)
5918	pcw = pcw - ( zaelwc2 - zaelwc1 ) * ppres * amdair / ( argas * ptemp )
5919	!
5920	!-- Initialise variables
5921	zcwsurfae(:) = 0.0_wp
5922	zhlp1 = 0.0_wp
5923	zhlp2 = 0.0_wp
5924	zhlp3 = 0.0_wp
5925	zmtae(:) = 0.0_wp
5926	zwsatae(:) = 0.0_wp
5927	!
5928	!-- Air:
5929	!-- Density (kg/m3)
5930	rhoair = amdair * ppres / ( argas * ptemp )
5931	!
5932	!-- Thermal conductivity of air
5933	zthcond = 0.023807_wp + 7.1128E-5_wp * ( ptemp - 273.16_wp )
5934	!
5935	!-- Water vapour:
5936	!-- Molecular diffusion coefficient (cm2/s) (eq.16.17)
5937	zdfh2o = ( 5.0_wp / ( 16.0_wp * avo * rhoair * 1.0E-3_wp * 3.11E-8_wp*2 ) ) SQRT( argas * &
5938	1.0E+7_wp * ptemp * amdair * 1.0E+3_wp * ( amh2o + amdair ) * 1.0E+3_wp / &
5939	( pi * amh2o * 2.0E+3_wp ) )
5940	zdfh2o = zdfh2o * 1.0E-4 ! Unit change to m^2/s
5941	!
5942	!-- Mean free path (eq. 15.25 & 16.29)
5943	zmfph2o = 3.0_wp * zdfh2o * SQRT( pi * amh2o / ( 8.0_wp * argas * ptemp ) )
5944	!
5945	!-- Kelvin effect (eq. 16.33)
5946	zkelvin(:) = EXP( 4.0_wp * surfw0 * amh2o / ( argas * ptemp * arhoh2o * paero(:)%dwet) )
5947
5948	DO ib = 1, nbins_aerosol
5949	IF ( paero(ib)%numc > nclim .AND. zrh > 0.98_wp ) THEN
5950	!
5951	!-- Water activity
5952	zact = acth2o( paero(ib) )
5953	!
5954	!-- Saturation mole concentration over flat surface. Limit the super-
5955	!-- saturation to max 1.01 for the mass transfer. Experimental!
5956	zcwsurfae(ib) = MAX( pcs, pcw / 1.01_wp ) * rhoair / amh2o
5957	!
5958	!-- Equilibrium saturation ratio
5959	zwsatae(ib) = zact * zkelvin(ib)
5960	!
5961	!-- Knudsen number (eq. 16.20)
5962	zknud = 2.0_wp * zmfph2o / paero(ib)%dwet
5963	!
5964	!-- Transitional correction factor (Fuks & Sutugin, 1971)
5965	zbeta = ( zknud + 1.0_wp ) / ( 0.377_wp * zknud + 1.0_wp + 4.0_wp / &
5966	( 3.0_wp * massacc(ib) ) * ( zknud + zknud**2 ) )
5967	!
5968	!-- Mass transfer of H2O: Eq. 16.64 but here D^eff = zdfh2o * zbeta
5969	zhlp1 = paero(ib)%numc * 2.0_wp * pi * paero(ib)%dwet * zdfh2o * zbeta
5970	!
5971	!-- 1st term on the left side of the denominator in eq. 16.55
5972	zhlp2 = amh2o * zdfh2o * alv * zwsatae(ib) * zcwsurfae(ib) / ( zthcond * ptemp )
5973	!
5974	!-- 2nd term on the left side of the denominator in eq. 16.55
5975	zhlp3 = ( ( alv * amh2o ) / ( argas * ptemp ) ) - 1.0_wp
5976	!
5977	!-- Full eq. 16.64: Mass transfer coefficient (1/s)
5978	zmtae(ib) = zhlp1 / ( zhlp2 * zhlp3 + 1.0_wp )
5979	ENDIF
5980	ENDDO
5981	!
5982	!-- Current mole concentrations of water
5983	zcwc = pcw * rhoair / amh2o ! as vapour
5984	zcwcae(:) = paero(:)%volc(8) * arhoh2o / amh2o ! in aerosols
5985	zcwtot = zcwc + SUM( zcwcae ) ! total water concentration
5986	zcwnae(:) = 0.0_wp
5987	zcwintae(:) = zcwcae(:)
5988	!
5989	!-- Substepping loop
5990	zcwint = 0.0_wp
5991	ttot = 0.0_wp
5992	DO WHILE ( ttot < ptstep )
5993	adt = 2.0E-2_wp ! internal timestep
5994	!
5995	!-- New vapour concentration: (eq. 16.71)
5996	zhlp1 = zcwc + adt * ( SUM( zmtae(nstr:nbins_aerosol) * zwsatae(nstr:nbins_aerosol) * &
5997	zcwsurfae(nstr:nbins_aerosol) ) ) ! numerator
5998	zhlp2 = 1.0_wp + adt * ( SUM( zmtae(nstr:nbins_aerosol) ) ) ! denomin.
5999	zcwint = zhlp1 / zhlp2 ! new vapour concentration
6000	zcwint = MIN( zcwint, zcwtot )
6001	IF ( ANY( paero(:)%numc > nclim ) .AND. zrh > 0.98_wp ) THEN
6002	DO ib = nstr, nbins_aerosol
6003	zcwintae(ib) = zcwcae(ib) + MIN( MAX( adt * zmtae(ib) * ( zcwint - zwsatae(ib) * &
6004	zcwsurfae(ib) ), -0.02_wp * zcwcae(ib) ), &
6005	0.05_wp * zcwcae(ib) )
6006	zwsatae(ib) = acth2o( paero(ib), zcwintae(ib) ) * zkelvin(ib)
6007	ENDDO
6008	ENDIF
6009	zcwintae(nstr:nbins_aerosol) = MAX( zcwintae(nstr:nbins_aerosol), 0.0_wp )
6010	!
6011	!-- Update vapour concentration for consistency
6012	zcwint = zcwtot - SUM( zcwintae(1:nbins_aerosol) )
6013	!
6014	!-- Update "old" values for next cycle
6015	zcwcae = zcwintae
6016
6017	ttot = ttot + adt
6018
6019	ENDDO ! ADT
6020
6021	zcwn = zcwint
6022	zcwnae(:) = zcwintae(:)
6023	pcw = zcwn * amh2o / rhoair
6024	paero(:)%volc(8) = MAX( 0.0_wp, zcwnae(:) * amh2o / arhoh2o )
6025
6026	END SUBROUTINE gpparth2o
6027
6028	!------------------------------------------------------------------------------!
6029	! Description:
6030	! ------------
6031	!> Calculates the activity coefficient of liquid water
6032	!------------------------------------------------------------------------------!
6033	REAL(wp) FUNCTION acth2o( ppart, pcw )
6034
6035	IMPLICIT NONE
6036
6037	REAL(wp) :: zns !< molar concentration of solutes (mol/m3)
6038	REAL(wp) :: znw !< molar concentration of water (mol/m3)
6039
6040	REAL(wp), INTENT(in), OPTIONAL :: pcw !< molar concentration of water (mol/m3)
6041
6042	TYPE(t_section), INTENT(in) :: ppart !< Aerosol properties of a bin
6043
6044	zns = ( 3.0_wp * ( ppart%volc(1) * arhoh2so4 / amh2so4 ) + ( ppart%volc(2) * arhooc / amoc ) + &
6045	2.0_wp * ( ppart%volc(5) * arhoss / amss ) + ( ppart%volc(6) * arhohno3 / amhno3 ) + &
6046	( ppart%volc(7) * arhonh3 / amnh3 ) )
6047
6048	IF ( PRESENT(pcw) ) THEN
6049	znw = pcw
6050	ELSE
6051	znw = ppart%volc(8) * arhoh2o / amh2o
6052	ENDIF
6053	!
6054	!-- Activity = partial pressure of water vapour / sat. vapour pressure of water over a liquid surface
6055	!-- = molality * activity coefficient (Jacobson, 2005: eq. 17.20-21)
6056	!-- Assume activity coefficient of 1 for water
6057	acth2o = MAX( 0.1_wp, znw / MAX( EPSILON( 1.0_wp ),( znw + zns ) ) )
6058
6059	END FUNCTION acth2o
6060
6061	!------------------------------------------------------------------------------!
6062	! Description:
6063	! ------------
6064	!> Calculates the dissolutional growth of particles (i.e. gas transfers to a
6065	!> particle surface and dissolves in liquid water on the surface). Treated here
6066	!> as a non-equilibrium (time-dependent) process. Gases: HNO3 and NH3
6067	!> (Chapter 17.14 in Jacobson, 2005).
6068	!
6069	!> Called from subroutine condensation.
6070	!> Coded by:
6071	!> Harri Kokkola (FMI)
6072	!------------------------------------------------------------------------------!
6073	SUBROUTINE gpparthno3( ppres, ptemp, paero, pghno3, pgnh3, pcw, pcs, pbeta, ptstep )
6074
6075	IMPLICIT NONE
6076
6077	INTEGER(iwp) :: ib !< loop index
6078
6079	REAL(wp) :: adt !< timestep
6080	REAL(wp) :: zc_nh3_c !< Current NH3 gas concentration
6081	REAL(wp) :: zc_nh3_int !< Intermediate NH3 gas concentration
6082	REAL(wp) :: zc_nh3_n !< New NH3 gas concentration
6083	REAL(wp) :: zc_nh3_tot !< Total NH3 concentration
6084	REAL(wp) :: zc_hno3_c !< Current HNO3 gas concentration
6085	REAL(wp) :: zc_hno3_int !< Intermediate HNO3 gas concentration
6086	REAL(wp) :: zc_hno3_n !< New HNO3 gas concentration
6087	REAL(wp) :: zc_hno3_tot !< Total HNO3 concentration
6088	REAL(wp) :: zdfvap !< Diffusion coefficient for vapors
6089	REAL(wp) :: zhlp1 !< intermediate variable
6090	REAL(wp) :: zhlp2 !< intermediate variable
6091	REAL(wp) :: zrh !< relative humidity
6092
6093	REAL(wp), INTENT(in) :: ppres !< ambient pressure (Pa)
6094	REAL(wp), INTENT(in) :: pcs !< water vapour saturation
6095	!< concentration (kg/m3)
6096	REAL(wp), INTENT(in) :: ptemp !< ambient temperature (K)
6097	REAL(wp), INTENT(in) :: ptstep !< time step (s)
6098
6099	REAL(wp), INTENT(inout) :: pghno3 !< nitric acid concentration (#/m3)
6100	REAL(wp), INTENT(inout) :: pgnh3 !< ammonia conc. (#/m3)
6101	REAL(wp), INTENT(inout) :: pcw !< water vapour concentration (kg/m3)
6102
6103	REAL(wp), DIMENSION(nbins_aerosol) :: zac_hno3_ae !< Activity coefficients for HNO3
6104	REAL(wp), DIMENSION(nbins_aerosol) :: zac_hhso4_ae !< Activity coefficients for HHSO4
6105	REAL(wp), DIMENSION(nbins_aerosol) :: zac_nh3_ae !< Activity coefficients for NH3
6106	REAL(wp), DIMENSION(nbins_aerosol) :: zac_nh4hso2_ae !< Activity coefficients for NH4HSO2
6107	REAL(wp), DIMENSION(nbins_aerosol) :: zcg_hno3_eq_ae !< Equilibrium gas concentration: HNO3
6108	REAL(wp), DIMENSION(nbins_aerosol) :: zcg_nh3_eq_ae !< Equilibrium gas concentration: NH3
6109	REAL(wp), DIMENSION(nbins_aerosol) :: zc_hno3_int_ae !< Intermediate HNO3 aerosol concentration
6110	REAL(wp), DIMENSION(nbins_aerosol) :: zc_hno3_c_ae !< Current HNO3 in aerosols
6111	REAL(wp), DIMENSION(nbins_aerosol) :: zc_hno3_n_ae !< New HNO3 in aerosols
6112	REAL(wp), DIMENSION(nbins_aerosol) :: zc_nh3_int_ae !< Intermediate NH3 aerosol concentration
6113	REAL(wp), DIMENSION(nbins_aerosol) :: zc_nh3_c_ae !< Current NH3 in aerosols
6114	REAL(wp), DIMENSION(nbins_aerosol) :: zc_nh3_n_ae !< New NH3 in aerosols
6115	REAL(wp), DIMENSION(nbins_aerosol) :: zkel_hno3_ae !< Kelvin effect for HNO3
6116	REAL(wp), DIMENSION(nbins_aerosol) :: zkel_nh3_ae !< Kelvin effects for NH3
6117	REAL(wp), DIMENSION(nbins_aerosol) :: zmt_hno3_ae !< Mass transfer coefficients for HNO3
6118	REAL(wp), DIMENSION(nbins_aerosol) :: zmt_nh3_ae !< Mass transfer coefficients for NH3
6119	REAL(wp), DIMENSION(nbins_aerosol) :: zsat_hno3_ae !< HNO3 saturation ratio over a surface
6120	REAL(wp), DIMENSION(nbins_aerosol) :: zsat_nh3_ae !< NH3 saturation ratio over a surface
6121
6122	REAL(wp), DIMENSION(nbins_aerosol,maxspec) :: zion_mols !< Ion molalities from pdfite aerosols
6123
6124	REAL(wp), DIMENSION(nbins_aerosol), INTENT(in) :: pbeta !< transitional correction factor for
6125
6126	TYPE(t_section), DIMENSION(nbins_aerosol), INTENT(inout) :: paero !< Aerosol properties
6127	!
6128	!-- Initialise:
6129	adt = ptstep
6130	zac_hhso4_ae = 0.0_wp
6131	zac_nh3_ae = 0.0_wp
6132	zac_nh4hso2_ae = 0.0_wp
6133	zac_hno3_ae = 0.0_wp
6134	zcg_nh3_eq_ae = 0.0_wp
6135	zcg_hno3_eq_ae = 0.0_wp
6136	zion_mols = 0.0_wp
6137	zsat_nh3_ae = 1.0_wp
6138	zsat_hno3_ae = 1.0_wp
6139	!
6140	!-- Diffusion coefficient (m2/s)
6141	zdfvap = 5.1111E-10_wp * ptemp*1.75_wp ( p_0 + 1325.0_wp ) / ppres
6142	!
6143	!-- Kelvin effects (Jacobson (2005), eq. 16.33)
6144	zkel_hno3_ae(1:nbins_aerosol) = EXP( 4.0_wp * surfw0 * amvhno3 / &
6145	( abo * ptemp * paero(1:nbins_aerosol)%dwet ) )
6146	zkel_nh3_ae(1:nbins_aerosol) = EXP( 4.0_wp * surfw0 * amvnh3 / &
6147	( abo * ptemp * paero(1:nbins_aerosol)%dwet ) )
6148	!
6149	!-- Current vapour mole concentrations (mol/m3)
6150	zc_hno3_c = pghno3 / avo ! HNO3
6151	zc_nh3_c = pgnh3 / avo ! NH3
6152	!
6153	!-- Current particle mole concentrations (mol/m3)
6154	zc_hno3_c_ae(1:nbins_aerosol) = paero(1:nbins_aerosol)%volc(6) * arhohno3 / amhno3
6155	zc_nh3_c_ae(1:nbins_aerosol) = paero(1:nbins_aerosol)%volc(7) * arhonh3 / amnh3
6156	!
6157	!-- Total mole concentrations: gas and particle phase
6158	zc_hno3_tot = zc_hno3_c + SUM( zc_hno3_c_ae(1:nbins_aerosol) )
6159	zc_nh3_tot = zc_nh3_c + SUM( zc_nh3_c_ae(1:nbins_aerosol) )
6160	!
6161	!-- Relative humidity [0-1]
6162	zrh = pcw / pcs
6163	!
6164	!-- Mass transfer coefficients (Jacobson, Eq. 16.64)
6165	zmt_hno3_ae(:) = 2.0_wp * pi * paero(:)%dwet * zdfvap * paero(:)%numc * pbeta(:)
6166	zmt_nh3_ae(:) = 2.0_wp * pi * paero(:)%dwet * zdfvap * paero(:)%numc * pbeta(:)
6167
6168	!
6169	!-- Get the equilibrium concentrations above aerosols
6170	CALL nitrate_ammonium_equilibrium( zrh, ptemp, paero, zcg_hno3_eq_ae, zcg_nh3_eq_ae, &
6171	zac_hno3_ae, zac_nh3_ae, zac_nh4hso2_ae, zac_hhso4_ae, &
6172	zion_mols )
6173	!
6174	!-- Calculate NH3 and HNO3 saturation ratios for aerosols
6175	CALL nitrate_ammonium_saturation( ptemp, paero, zac_hno3_ae, zac_nh4hso2_ae, zac_hhso4_ae, &
6176	zcg_hno3_eq_ae, zc_hno3_c_ae, zc_nh3_c_ae, zkel_hno3_ae, &
6177	zkel_nh3_ae, zsat_hno3_ae, zsat_nh3_ae )
6178	!
6179	!-- Intermediate gas concentrations of HNO3 and NH3
6180	zhlp1 = SUM( zc_hno3_c_ae(:) / ( 1.0_wp + adt * zmt_hno3_ae(:) * zsat_hno3_ae(:) ) )
6181	zhlp2 = SUM( zmt_hno3_ae(:) / ( 1.0_wp + adt * zmt_hno3_ae(:) * zsat_hno3_ae(:) ) )
6182	zc_hno3_int = ( zc_hno3_tot - zhlp1 ) / ( 1.0_wp + adt * zhlp2 )
6183
6184	zhlp1 = SUM( zc_nh3_c_ae(:) / ( 1.0_wp + adt * zmt_nh3_ae(:) * zsat_nh3_ae(:) ) )
6185	zhlp2 = SUM( zmt_nh3_ae(:) / ( 1.0_wp + adt * zmt_nh3_ae(:) * zsat_nh3_ae(:) ) )
6186	zc_nh3_int = ( zc_nh3_tot - zhlp1 )/( 1.0_wp + adt * zhlp2 )
6187
6188	zc_hno3_int = MIN( zc_hno3_int, zc_hno3_tot )
6189	zc_nh3_int = MIN( zc_nh3_int, zc_nh3_tot )
6190	!
6191	!-- Calculate the new concentration on aerosol particles
6192	zc_hno3_int_ae = zc_hno3_c_ae
6193	zc_nh3_int_ae = zc_nh3_c_ae
6194	DO ib = 1, nbins_aerosol
6195	zc_hno3_int_ae(ib) = ( zc_hno3_c_ae(ib) + adt * zmt_hno3_ae(ib) * zc_hno3_int ) / &
6196	( 1.0_wp + adt * zmt_hno3_ae(ib) * zsat_hno3_ae(ib) )
6197	zc_nh3_int_ae(ib) = ( zc_nh3_c_ae(ib) + adt * zmt_nh3_ae(ib) * zc_nh3_int ) / &
6198	( 1.0_wp + adt * zmt_nh3_ae(ib) * zsat_nh3_ae(ib) )
6199	ENDDO
6200
6201	zc_hno3_int_ae(:) = MAX( zc_hno3_int_ae(:), 0.0_wp )
6202	zc_nh3_int_ae(:) = MAX( zc_nh3_int_ae(:), 0.0_wp )
6203	!
6204	!-- Final molar gas concentration and molar particle concentration of HNO3
6205	zc_hno3_n = zc_hno3_int
6206	zc_hno3_n_ae = zc_hno3_int_ae
6207	!
6208	!-- Final molar gas concentration and molar particle concentration of NH3
6209	zc_nh3_n = zc_nh3_int
6210	zc_nh3_n_ae = zc_nh3_int_ae
6211	!
6212	!-- Model timestep reached - update the gas concentrations
6213	pghno3 = zc_hno3_n * avo
6214	pgnh3 = zc_nh3_n * avo
6215	!
6216	!-- Update the particle concentrations
6217	DO ib = start_subrange_1a, end_subrange_2b
6218	paero(ib)%volc(6) = zc_hno3_n_ae(ib) * amhno3 / arhohno3
6219	paero(ib)%volc(7) = zc_nh3_n_ae(ib) * amnh3 / arhonh3
6220	ENDDO
6221
6222	END SUBROUTINE gpparthno3
6223	!------------------------------------------------------------------------------!
6224	! Description:
6225	! ------------
6226	!> Calculate the equilibrium concentrations above aerosols (reference?)
6227	!------------------------------------------------------------------------------!
6228	SUBROUTINE nitrate_ammonium_equilibrium( prh, ptemp, ppart, pcg_hno3_eq, pcg_nh3_eq, pgamma_hno3, &
6229	pgamma_nh4, pgamma_nh4hso2, pgamma_hhso4, pmols )
6230
6231	IMPLICIT NONE
6232
6233	INTEGER(iwp) :: ib !< loop index: aerosol bins
6234
6235	REAL(wp) :: zhlp !< intermediate variable
6236	REAL(wp) :: zp_hcl !< Equilibrium vapor pressures (Pa) of HCl
6237	REAL(wp) :: zp_hno3 !< Equilibrium vapor pressures (Pa) of HNO3
6238	REAL(wp) :: zp_nh3 !< Equilibrium vapor pressures (Pa) of NH3
6239	REAL(wp) :: zwatertotal !< Total water in particles (mol/m3)
6240
6241	REAL(wp), INTENT(in) :: prh !< relative humidity
6242	REAL(wp), INTENT(in) :: ptemp !< ambient temperature (K)
6243
6244	REAL(wp), DIMENSION(maxspec) :: zgammas !< Activity coefficients
6245	REAL(wp), DIMENSION(maxspec) :: zions !< molar concentration of ion (mol/m3)
6246
6247	REAL(wp), DIMENSION(nbins_aerosol), INTENT(inout) :: pcg_nh3_eq !< equilibrium molar
6248	!< concentration: of NH3
6249	REAL(wp), DIMENSION(nbins_aerosol), INTENT(inout) :: pcg_hno3_eq !< of HNO3
6250	REAL(wp), DIMENSION(nbins_aerosol), INTENT(inout) :: pgamma_hhso4 !< activity coeff. of HHSO4
6251	REAL(wp), DIMENSION(nbins_aerosol), INTENT(inout) :: pgamma_nh4 !< activity coeff. of NH3
6252	REAL(wp), DIMENSION(nbins_aerosol), INTENT(inout) :: pgamma_nh4hso2 !< activity coeff. of NH4HSO2
6253	REAL(wp), DIMENSION(nbins_aerosol), INTENT(inout) :: pgamma_hno3 !< activity coeff. of HNO3
6254
6255	REAL(wp), DIMENSION(nbins_aerosol,maxspec), INTENT(inout) :: pmols !< Ion molalities
6256
6257	TYPE(t_section), DIMENSION(nbins_aerosol), INTENT(inout) :: ppart !< Aerosol properties
6258
6259	zgammas = 0.0_wp
6260	zhlp = 0.0_wp
6261	zions = 0.0_wp
6262	zp_hcl = 0.0_wp
6263	zp_hno3 = 0.0_wp
6264	zp_nh3 = 0.0_wp
6265	zwatertotal = 0.0_wp
6266
6267	DO ib = 1, nbins_aerosol
6268
6269	IF ( ppart(ib)%numc < nclim ) CYCLE
6270	!
6271	!-- Ion molar concentrations: 2*H2SO4 + CL + NO3 - Na - NH4
6272	zhlp = 2.0_wp * ppart(ib)%volc(1) * arhoh2so4 / amh2so4 + ppart(ib)%volc(5) * arhoss / amss &
6273	+ ppart(ib)%volc(6) * arhohno3 / amhno3 - ppart(ib)%volc(5) * arhoss / amss - &
6274	ppart(ib)%volc(7) * arhonh3 / amnh3
6275
6276	zions(1) = zhlp ! H+
6277	zions(2) = ppart(ib)%volc(7) * arhonh3 / amnh3 ! NH4+
6278	zions(3) = ppart(ib)%volc(5) * arhoss / amss ! Na+
6279	zions(4) = ppart(ib)%volc(1) * arhoh2so4 / amh2so4 ! SO4(2-)
6280	zions(5) = 0.0_wp ! HSO4-
6281	zions(6) = ppart(ib)%volc(6) * arhohno3 / amhno3 ! NO3-
6282	zions(7) = ppart(ib)%volc(5) * arhoss / amss ! Cl-
6283
6284	zwatertotal = ppart(ib)%volc(8) * arhoh2o / amh2o
6285	IF ( zwatertotal > 1.0E-30_wp ) THEN
6286	CALL inorganic_pdfite( prh, ptemp, zions, zwatertotal, zp_hno3, zp_hcl, zp_nh3, zgammas, &
6287	pmols(ib,:) )
6288	ENDIF
6289	!
6290	!-- Activity coefficients
6291	pgamma_hno3(ib) = zgammas(1) ! HNO3
6292	pgamma_nh4(ib) = zgammas(3) ! NH3
6293	pgamma_nh4hso2(ib) = zgammas(6) ! NH4HSO2
6294	pgamma_hhso4(ib) = zgammas(7) ! HHSO4
6295	!
6296	!-- Equilibrium molar concentrations (mol/m3) from equlibrium pressures (Pa)
6297	pcg_hno3_eq(ib) = zp_hno3 / ( argas * ptemp )
6298	pcg_nh3_eq(ib) = zp_nh3 / ( argas * ptemp )
6299
6300	ENDDO
6301
6302	END SUBROUTINE nitrate_ammonium_equilibrium
6303
6304	!------------------------------------------------------------------------------!
6305	! Description:
6306	! ------------
6307	!> Calculate saturation ratios of NH4 and HNO3 for aerosols
6308	!------------------------------------------------------------------------------!
6309	SUBROUTINE nitrate_ammonium_saturation( ptemp, ppart, pachno3, pacnh4hso2, pachhso4, pchno3eq, &
6310	pchno3, pc_nh3, pkelhno3, pkelnh3, psathno3, psatnh3 )
6311
6312	IMPLICIT NONE
6313
6314	INTEGER(iwp) :: ib !< running index for aerosol bins
6315
6316	REAL(wp) :: k_ll_h2o !< equilibrium constants of equilibrium reactions:
6317	!< H2O(aq) <--> H+ + OH- (mol/kg)
6318	REAL(wp) :: k_ll_nh3 !< NH3(aq) + H2O(aq) <--> NH4+ + OH- (mol/kg)
6319	REAL(wp) :: k_gl_nh3 !< NH3(g) <--> NH3(aq) (mol/kg/atm)
6320	REAL(wp) :: k_gl_hno3 !< HNO3(g) <--> H+ + NO3- (mol2/kg2/atm)
6321	REAL(wp) :: zmol_no3 !< molality of NO3- (mol/kg)
6322	REAL(wp) :: zmol_h !< molality of H+ (mol/kg)
6323	REAL(wp) :: zmol_so4 !< molality of SO4(2-) (mol/kg)
6324	REAL(wp) :: zmol_cl !< molality of Cl- (mol/kg)
6325	REAL(wp) :: zmol_nh4 !< molality of NH4+ (mol/kg)
6326	REAL(wp) :: zmol_na !< molality of Na+ (mol/kg)
6327	REAL(wp) :: zhlp1 !< intermediate variable
6328	REAL(wp) :: zhlp2 !< intermediate variable
6329	REAL(wp) :: zhlp3 !< intermediate variable
6330	REAL(wp) :: zxi !< particle mole concentration ratio: (NH3+SS)/H2SO4
6331	REAL(wp) :: zt0 !< reference temp
6332
6333	REAL(wp), PARAMETER :: a1 = -22.52_wp !<
6334	REAL(wp), PARAMETER :: a2 = -1.50_wp !<
6335	REAL(wp), PARAMETER :: a3 = 13.79_wp !<
6336	REAL(wp), PARAMETER :: a4 = 29.17_wp !<
6337	REAL(wp), PARAMETER :: b1 = 26.92_wp !<
6338	REAL(wp), PARAMETER :: b2 = 26.92_wp !<
6339	REAL(wp), PARAMETER :: b3 = -5.39_wp !<
6340	REAL(wp), PARAMETER :: b4 = 16.84_wp !<
6341	REAL(wp), PARAMETER :: K01 = 1.01E-14_wp !<
6342	REAL(wp), PARAMETER :: K02 = 1.81E-5_wp !<
6343	REAL(wp), PARAMETER :: K03 = 57.64_wp !<
6344	REAL(wp), PARAMETER :: K04 = 2.51E+6_wp !<
6345
6346	REAL(wp), INTENT(in) :: ptemp !< ambient temperature (K)
6347
6348	REAL(wp), DIMENSION(nbins_aerosol), INTENT(in) :: pachhso4 !< activity coeff. of HHSO4
6349	REAL(wp), DIMENSION(nbins_aerosol), INTENT(in) :: pacnh4hso2 !< activity coeff. of NH4HSO2
6350	REAL(wp), DIMENSION(nbins_aerosol), INTENT(in) :: pachno3 !< activity coeff. of HNO3
6351	REAL(wp), DIMENSION(nbins_aerosol), INTENT(in) :: pchno3eq !< eq. surface concentration: HNO3
6352	REAL(wp), DIMENSION(nbins_aerosol), INTENT(in) :: pchno3 !< current particle mole
6353	!< concentration of HNO3 (mol/m3)
6354	REAL(wp), DIMENSION(nbins_aerosol), INTENT(in) :: pc_nh3 !< of NH3 (mol/m3)
6355	REAL(wp), DIMENSION(nbins_aerosol), INTENT(in) :: pkelhno3 !< Kelvin effect for HNO3
6356	REAL(wp), DIMENSION(nbins_aerosol), INTENT(in) :: pkelnh3 !< Kelvin effect for NH3
6357
6358	REAL(wp), DIMENSION(nbins_aerosol), INTENT(out) :: psathno3 !< saturation ratio of HNO3
6359	REAL(wp), DIMENSION(nbins_aerosol), INTENT(out) :: psatnh3 !< saturation ratio of NH3
6360
6361	TYPE(t_section), DIMENSION(nbins_aerosol), INTENT(inout) :: ppart !< Aerosol properties
6362
6363	zmol_cl = 0.0_wp
6364	zmol_h = 0.0_wp
6365	zmol_na = 0.0_wp
6366	zmol_nh4 = 0.0_wp
6367	zmol_no3 = 0.0_wp
6368	zmol_so4 = 0.0_wp
6369	zt0 = 298.15_wp
6370	zxi = 0.0_wp
6371	!
6372	!-- Calculates equlibrium rate constants based on Table B.7 in Jacobson (2005):
6373	!-- K^ll_H20, K^ll_NH3, K^gl_NH3, K^gl_HNO3
6374	zhlp1 = zt0 / ptemp
6375	zhlp2 = zhlp1 - 1.0_wp
6376	zhlp3 = 1.0_wp + LOG( zhlp1 ) - zhlp1
6377
6378	k_ll_h2o = K01 * EXP( a1 * zhlp2 + b1 * zhlp3 )
6379	k_ll_nh3 = K02 * EXP( a2 * zhlp2 + b2 * zhlp3 )
6380	k_gl_nh3 = K03 * EXP( a3 * zhlp2 + b3 * zhlp3 )
6381	k_gl_hno3 = K04 * EXP( a4 * zhlp2 + b4 * zhlp3 )
6382
6383	DO ib = 1, nbins_aerosol
6384
6385	IF ( ppart(ib)%numc > nclim .AND. ppart(ib)%volc(8) > 1.0E-30_wp ) THEN
6386	!
6387	!-- Molality of H+ and NO3-
6388	zhlp1 = pc_nh3(ib) * amnh3 + ppart(ib)%volc(1) * arhoh2so4 + ppart(ib)%volc(2) * arhooc &
6389	+ ppart(ib)%volc(5) * arhoss + ppart(ib)%volc(8) * arhoh2o
6390	zmol_no3 = pchno3(ib) / zhlp1 !< mol/kg
6391	!
6392	!-- Particle mole concentration ratio: (NH3+SS)/H2SO4
6393	zxi = ( pc_nh3(ib) + ppart(ib)%volc(5) * arhoss / amss ) / ( ppart(ib)%volc(1) * &
6394	arhoh2so4 / amh2so4 )
6395
6396	IF ( zxi <= 2.0_wp ) THEN
6397	!
6398	!-- Molality of SO4(2-)
6399	zhlp1 = pc_nh3(ib) * amnh3 + pchno3(ib) * amhno3 + ppart(ib)%volc(2) * arhooc + &
6400	ppart(ib)%volc(5) * arhoss + ppart(ib)%volc(8) * arhoh2o
6401	zmol_so4 = ( ppart(ib)%volc(1) * arhoh2so4 / amh2so4 ) / zhlp1
6402	!
6403	!-- Molality of Cl-
6404	zhlp1 = pc_nh3(ib) * amnh3 + pchno3(ib) * amhno3 + ppart(ib)%volc(2) * arhooc + &
6405	ppart(ib)%volc(1) * arhoh2so4 + ppart(ib)%volc(8) * arhoh2o
6406	zmol_cl = ( ppart(ib)%volc(5) * arhoss / amss ) / zhlp1
6407	!
6408	!-- Molality of NH4+
6409	zhlp1 = pchno3(ib) * amhno3 + ppart(ib)%volc(1) * arhoh2so4 + ppart(ib)%volc(2) * &
6410	arhooc + ppart(ib)%volc(5) * arhoss + ppart(ib)%volc(8) * arhoh2o
6411	zmol_nh4 = pc_nh3(ib) / zhlp1
6412	!
6413	!-- Molality of Na+
6414	zmol_na = zmol_cl
6415	!
6416	!-- Molality of H+
6417	zmol_h = 2.0_wp * zmol_so4 + zmol_no3 + zmol_cl - ( zmol_nh4 + zmol_na )
6418
6419	ELSE
6420
6421	zhlp2 = pkelhno3(ib) * zmol_no3 * pachno3(ib)**2
6422
6423	IF ( zhlp2 > 1.0E-30_wp ) THEN
6424	zmol_h = k_gl_hno3 * pchno3eq(ib) / zhlp2 ! Eq. 17.38
6425	ELSE
6426	zmol_h = 0.0_wp
6427	ENDIF
6428
6429	ENDIF
6430
6431	zhlp1 = ppart(ib)%volc(8) * arhoh2o * argas * ptemp * k_gl_hno3
6432	!
6433	!-- Saturation ratio for NH3 and for HNO3
6434	IF ( zmol_h > 0.0_wp ) THEN
6435	zhlp2 = pkelnh3(ib) / ( zhlp1 * zmol_h )
6436	zhlp3 = k_ll_h2o / ( k_ll_nh3 + k_gl_nh3 )
6437	psatnh3(ib) = zhlp2 * ( ( pacnh4hso2(ib) / pachhso4(ib) )*2 ) zhlp3
6438	psathno3(ib) = ( pkelhno3(ib) * zmol_h * pachno3(ib)**2 ) / zhlp1
6439	ELSE
6440	psatnh3(ib) = 1.0_wp
6441	psathno3(ib) = 1.0_wp
6442	ENDIF
6443	ELSE
6444	psatnh3(ib) = 1.0_wp
6445	psathno3(ib) = 1.0_wp
6446	ENDIF
6447
6448	ENDDO
6449
6450	END SUBROUTINE nitrate_ammonium_saturation
6451
6452	!------------------------------------------------------------------------------!
6453	! Description:
6454	! ------------
6455	!> Prototype module for calculating the water content of a mixed inorganic/
6456	!> organic particle + equilibrium water vapour pressure above the solution
6457	!> (HNO3, HCL, NH3 and representative organic compounds. Efficient calculation
6458	!> of the partitioning of species between gas and aerosol. Based in a chamber
6459	!> study.
6460	!
6461	!> Written by Dave Topping. Pure organic component properties predicted by Mark
6462	!> Barley based on VOCs predicted in MCM simulations performed by Mike Jenkin.
6463	!> Delivered by Gordon McFiggans as Deliverable D22 from WP1.4 in the EU FP6
6464	!> EUCAARI Integrated Project.
6465	!
6466	!> REFERENCES
6467	!> Clegg et al. (1998) A Thermodynamic Model of the System H+-NH4+-Na+-SO42- -NO3--Cl--H2O at
6468	!> 298.15 K, J. Phys. Chem., 102A, 2155-2171.
6469	!> Clegg et al. (2001) Thermodynamic modelling of aqueous aerosols containing electrolytes and
6470	!> dissolved organic compounds. Journal of Aerosol Science 2001;32(6):713-738.
6471	!> Topping et al. (2005a) A curved multi-component aerosol hygroscopicity model framework: Part 1 -
6472	!> Inorganic compounds. Atmospheric Chemistry and Physics 2005;5:1205-1222.
6473	!> Topping et al. (2005b) A curved multi-component aerosol hygroscopicity model framework: Part 2 -
6474	!> Including organic compounds. Atmospheric Chemistry and Physics 2005;5:1223-1242.
6475	!> Wagman et al. (1982). The NBS tables of chemical thermodynamic properties: selected values for
6476	!> inorganic and Câ and Câ organic substances in SI units (book)
6477	!> Zaveri et al. (2005). A new method for multicomponent activity coefficients of electrolytes in
6478	!> aqueous atmospheric aerosols, JGR, 110, D02201, 2005.
6479	!
6480	!> Queries concerning the use of this code through Gordon McFiggans,
6481	!> g.mcfiggans@manchester.ac.uk,
6482	!> Ownership: D. Topping, Centre for Atmospheric Sciences, University of
6483	!> Manchester, 2007
6484	!
6485	!> Rewritten to PALM by Mona Kurppa, UHel, 2017
6486	!------------------------------------------------------------------------------!
6487	SUBROUTINE inorganic_pdfite( rh, temp, ions, water_total, press_hno3, press_hcl, press_nh3, &
6488	gamma_out, mols_out )
6489
6490	IMPLICIT NONE
6491
6492	INTEGER(iwp) :: binary_case
6493	INTEGER(iwp) :: full_complexity
6494
6495	REAL(wp) :: a !< auxiliary variable
6496	REAL(wp) :: act_product !< ionic activity coef. product:
6497	!< = (gamma_h2so43d0) / gamma_hhso42d0)
6498	REAL(wp) :: ammonium_chloride !<
6499	REAL(wp) :: ammonium_chloride_eq_frac !<
6500	REAL(wp) :: ammonium_nitrate !<
6501	REAL(wp) :: ammonium_nitrate_eq_frac !<
6502	REAL(wp) :: ammonium_sulphate !<
6503	REAL(wp) :: ammonium_sulphate_eq_frac !<
6504	REAL(wp) :: b !< auxiliary variable
6505	REAL(wp) :: binary_h2so4 !< binary H2SO4 activity coeff.
6506	REAL(wp) :: binary_hcl !< binary HCL activity coeff.
6507	REAL(wp) :: binary_hhso4 !< binary HHSO4 activity coeff.
6508	REAL(wp) :: binary_hno3 !< binary HNO3 activity coeff.
6509	REAL(wp) :: binary_nh4hso4 !< binary NH4HSO4 activity coeff.
6510	REAL(wp) :: c !< auxiliary variable
6511	REAL(wp) :: charge_sum !< sum of ionic charges
6512	REAL(wp) :: gamma_h2so4 !< activity coefficient
6513	REAL(wp) :: gamma_hcl !< activity coefficient
6514	REAL(wp) :: gamma_hhso4 !< activity coeffient
6515	REAL(wp) :: gamma_hno3 !< activity coefficient
6516	REAL(wp) :: gamma_nh3 !< activity coefficient
6517	REAL(wp) :: gamma_nh4hso4 !< activity coefficient
6518	REAL(wp) :: h_out !<
6519	REAL(wp) :: h_real !< new hydrogen ion conc.
6520	REAL(wp) :: h2so4_hcl !< contribution of H2SO4
6521	REAL(wp) :: h2so4_hno3 !< contribution of H2SO4
6522	REAL(wp) :: h2so4_nh3 !< contribution of H2SO4
6523	REAL(wp) :: h2so4_nh4hso4 !< contribution of H2SO4
6524	REAL(wp) :: hcl_h2so4 !< contribution of HCL
6525	REAL(wp) :: hcl_hhso4 !< contribution of HCL
6526	REAL(wp) :: hcl_hno3 !< contribution of HCL
6527	REAL(wp) :: hcl_nh4hso4 !< contribution of HCL
6528	REAL(wp) :: henrys_temp_dep !< temperature dependence of Henry's Law
6529	REAL(wp) :: hno3_h2so4 !< contribution of HNO3
6530	REAL(wp) :: hno3_hcl !< contribution of HNO3
6531	REAL(wp) :: hno3_hhso4 !< contribution of HNO3
6532	REAL(wp) :: hno3_nh3 !< contribution of HNO3
6533	REAL(wp) :: hno3_nh4hso4 !< contribution of HNO3
6534	REAL(wp) :: hso4_out !<
6535	REAL(wp) :: hso4_real !< new bisulphate ion conc.
6536	REAL(wp) :: hydrochloric_acid !<
6537	REAL(wp) :: hydrochloric_acid_eq_frac !<
6538	REAL(wp) :: k_h !< equilibrium constant for H+
6539	REAL(wp) :: k_hcl !< equilibrium constant of HCL
6540	REAL(wp) :: k_hno3 !< equilibrium constant of HNO3
6541	REAL(wp) :: k_nh4 !< equilibrium constant for NH4+
6542	REAL(wp) :: k_h2o !< equil. const. for water_surface
6543	REAL(wp) :: ln_h2so4_act !< gamma_h2so4 = EXP(ln_h2so4_act)
6544	REAL(wp) :: ln_HCL_act !< gamma_hcl = EXP( ln_HCL_act )
6545	REAL(wp) :: ln_hhso4_act !< gamma_hhso4 = EXP(ln_hhso4_act)
6546	REAL(wp) :: ln_hno3_act !< gamma_hno3 = EXP( ln_hno3_act )
6547	REAL(wp) :: ln_nh4hso4_act !< gamma_nh4hso4 = EXP( ln_nh4hso4_act )
6548	REAL(wp) :: molality_ratio_nh3 !< molality ratio of NH3 (NH4+ and H+)
6549	REAL(wp) :: na2so4_h2so4 !< contribution of Na2SO4
6550	REAL(wp) :: na2so4_hcl !< contribution of Na2SO4
6551	REAL(wp) :: na2so4_hhso4 !< contribution of Na2SO4
6552	REAL(wp) :: na2so4_hno3 !< contribution of Na2SO4
6553	REAL(wp) :: na2so4_nh3 !< contribution of Na2SO4
6554	REAL(wp) :: na2so4_nh4hso4 !< contribution of Na2SO4
6555	REAL(wp) :: nacl_h2so4 !< contribution of NaCl
6556	REAL(wp) :: nacl_hcl !< contribution of NaCl
6557	REAL(wp) :: nacl_hhso4 !< contribution of NaCl
6558	REAL(wp) :: nacl_hno3 !< contribution of NaCl
6559	REAL(wp) :: nacl_nh3 !< contribution of NaCl
6560	REAL(wp) :: nacl_nh4hso4 !< contribution of NaCl
6561	REAL(wp) :: nano3_h2so4 !< contribution of NaNO3
6562	REAL(wp) :: nano3_hcl !< contribution of NaNO3
6563	REAL(wp) :: nano3_hhso4 !< contribution of NaNO3
6564	REAL(wp) :: nano3_hno3 !< contribution of NaNO3
6565	REAL(wp) :: nano3_nh3 !< contribution of NaNO3
6566	REAL(wp) :: nano3_nh4hso4 !< contribution of NaNO3
6567	REAL(wp) :: nh42so4_h2so4 !< contribution of NH42SO4
6568	REAL(wp) :: nh42so4_hcl !< contribution of NH42SO4
6569	REAL(wp) :: nh42so4_hhso4 !< contribution of NH42SO4
6570	REAL(wp) :: nh42so4_hno3 !< contribution of NH42SO4
6571	REAL(wp) :: nh42so4_nh3 !< contribution of NH42SO4
6572	REAL(wp) :: nh42so4_nh4hso4 !< contribution of NH42SO4
6573	REAL(wp) :: nh4cl_h2so4 !< contribution of NH4Cl
6574	REAL(wp) :: nh4cl_hcl !< contribution of NH4Cl
6575	REAL(wp) :: nh4cl_hhso4 !< contribution of NH4Cl
6576	REAL(wp) :: nh4cl_hno3 !< contribution of NH4Cl
6577	REAL(wp) :: nh4cl_nh3 !< contribution of NH4Cl
6578	REAL(wp) :: nh4cl_nh4hso4 !< contribution of NH4Cl
6579	REAL(wp) :: nh4no3_h2so4 !< contribution of NH4NO3
6580	REAL(wp) :: nh4no3_hcl !< contribution of NH4NO3
6581	REAL(wp) :: nh4no3_hhso4 !< contribution of NH4NO3
6582	REAL(wp) :: nh4no3_hno3 !< contribution of NH4NO3
6583	REAL(wp) :: nh4no3_nh3 !< contribution of NH4NO3
6584	REAL(wp) :: nh4no3_nh4hso4 !< contribution of NH4NO3
6585	REAL(wp) :: nitric_acid !<
6586	REAL(wp) :: nitric_acid_eq_frac !< Equivalent fractions
6587	REAL(wp) :: press_hcl !< partial pressure of HCL
6588	REAL(wp) :: press_hno3 !< partial pressure of HNO3
6589	REAL(wp) :: press_nh3 !< partial pressure of NH3
6590	REAL(wp) :: rh !< relative humidity [0-1]
6591	REAL(wp) :: root1 !< auxiliary variable
6592	REAL(wp) :: root2 !< auxiliary variable
6593	REAL(wp) :: so4_out !<
6594	REAL(wp) :: so4_real !< new sulpate ion concentration
6595	REAL(wp) :: sodium_chloride !<
6596	REAL(wp) :: sodium_chloride_eq_frac !<
6597	REAL(wp) :: sodium_nitrate !<
6598	REAL(wp) :: sodium_nitrate_eq_frac !<
6599	REAL(wp) :: sodium_sulphate !<
6600	REAL(wp) :: sodium_sulphate_eq_frac !<
6601	REAL(wp) :: solutes !<
6602	REAL(wp) :: sulphuric_acid !<
6603	REAL(wp) :: sulphuric_acid_eq_frac !<
6604	REAL(wp) :: temp !< temperature
6605	REAL(wp) :: water_total !<
6606
6607	REAL(wp), DIMENSION(:) :: gamma_out !< Activity coefficient for calculating the non-ideal
6608	!< dissociation constants
6609	!< 1: HNO3, 2: HCL, 3: NH4+/H+ (NH3), 4: HHSO4**2/H2SO4,
6610	!< 5: H2SO43/HHSO42, 6: NH4HSO2, 7: HHSO4
6611	REAL(wp), DIMENSION(:) :: ions !< ion molarities (mol/m3): 1: H+, 2: NH4+, 3: Na+,
6612	!< 4: SO4(2-), 5: HSO4-, 6: NO3-, 7: Cl-
6613	REAL(wp), DIMENSION(7) :: ions_mol !< ion molalities (mol/kg): 1: H+, 2: NH4+, 3: Na+,
6614	!< 4: SO4(2-), 5: HSO4-, 6: NO3-, 7: Cl-
6615	REAL(wp), DIMENSION(:) :: mols_out !< ion molality output (mol/kg): 1: H+, 2: NH4+, 3: Na+,
6616	!< 4: SO4(2-), 5: HSO4-, 6: NO3-, 7: Cl-
6617	!
6618	!-- Value initialisation
6619	binary_h2so4 = 0.0_wp
6620	binary_hcl = 0.0_wp
6621	binary_hhso4 = 0.0_wp
6622	binary_hno3 = 0.0_wp
6623	binary_nh4hso4 = 0.0_wp
6624	henrys_temp_dep = ( 1.0_wp / temp - 0.0033557_wp ) ! 1/T - 1/298 K
6625	hcl_hno3 = 1.0_wp
6626	h2so4_hno3 = 1.0_wp
6627	nh42so4_hno3 = 1.0_wp
6628	nh4no3_hno3 = 1.0_wp
6629	nh4cl_hno3 = 1.0_wp
6630	na2so4_hno3 = 1.0_wp
6631	nano3_hno3 = 1.0_wp
6632	nacl_hno3 = 1.0_wp
6633	hno3_hcl = 1.0_wp
6634	h2so4_hcl = 1.0_wp
6635	nh42so4_hcl = 1.0_wp
6636	nh4no3_hcl = 1.0_wp
6637	nh4cl_hcl = 1.0_wp
6638	na2so4_hcl = 1.0_wp
6639	nano3_hcl = 1.0_wp
6640	nacl_hcl = 1.0_wp
6641	hno3_nh3 = 1.0_wp
6642	h2so4_nh3 = 1.0_wp
6643	nh42so4_nh3 = 1.0_wp
6644	nh4no3_nh3 = 1.0_wp
6645	nh4cl_nh3 = 1.0_wp
6646	na2so4_nh3 = 1.0_wp
6647	nano3_nh3 = 1.0_wp
6648	nacl_nh3 = 1.0_wp
6649	hno3_hhso4 = 1.0_wp
6650	hcl_hhso4 = 1.0_wp
6651	nh42so4_hhso4 = 1.0_wp
6652	nh4no3_hhso4 = 1.0_wp
6653	nh4cl_hhso4 = 1.0_wp
6654	na2so4_hhso4 = 1.0_wp
6655	nano3_hhso4 = 1.0_wp
6656	nacl_hhso4 = 1.0_wp
6657	hno3_h2so4 = 1.0_wp
6658	hcl_h2so4 = 1.0_wp
6659	nh42so4_h2so4 = 1.0_wp
6660	nh4no3_h2so4 = 1.0_wp
6661	nh4cl_h2so4 = 1.0_wp
6662	na2so4_h2so4 = 1.0_wp
6663	nano3_h2so4 = 1.0_wp
6664	nacl_h2so4 = 1.0_wp
6665	!
6666	!-- New NH3 variables
6667	hno3_nh4hso4 = 1.0_wp
6668	hcl_nh4hso4 = 1.0_wp
6669	h2so4_nh4hso4 = 1.0_wp
6670	nh42so4_nh4hso4 = 1.0_wp
6671	nh4no3_nh4hso4 = 1.0_wp
6672	nh4cl_nh4hso4 = 1.0_wp
6673	na2so4_nh4hso4 = 1.0_wp
6674	nano3_nh4hso4 = 1.0_wp
6675	nacl_nh4hso4 = 1.0_wp
6676	!
6677	!-- Juha Tonttila added
6678	mols_out = 0.0_wp
6679	press_hno3 = 0.0_wp !< Initialising vapour pressures over the
6680	press_hcl = 0.0_wp !< multicomponent particle
6681	press_nh3 = 0.0_wp
6682	gamma_out = 1.0_wp !< i.e. don't alter the ideal mixing ratios if there's nothing there.
6683	!
6684	!-- 1) - COMPOSITION DEFINITIONS
6685	!
6686	!-- a) Inorganic ion pairing:
6687	!-- In order to calculate the water content, which is also used in calculating vapour pressures, one
6688	!-- needs to pair the anions and cations for use in the ZSR mixing rule. The equation provided by
6689	!-- Clegg et al. (2001) is used for ion pairing. The solutes chosen comprise of 9 inorganic salts
6690	!-- and acids which provide a pairing between each anion and cation: (NH4)2SO4, NH4NO3, NH4Cl,
6691	!-- Na2SO4, NaNO3, NaCl, H2SO4, HNO3, HCL. The organic compound is treated as a seperate solute.
6692	!-- Ions: 1: H+, 2: NH4+, 3: Na+, 4: SO4(2-), 5: HSO4-, 6: NO3-, 7: Cl-
6693	!
6694	charge_sum = ions(1) + ions(2) + ions(3) + 2.0_wp * ions(4) + ions(5) + ions(6) + ions(7)
6695	nitric_acid = ( 2.0_wp * ions(1) * ions(6) ) / charge_sum
6696	hydrochloric_acid = ( 2.0_wp * ions(1) * ions(7) ) / charge_sum
6697	sulphuric_acid = ( 2.0_wp * ions(1) * ions(4) ) / charge_sum
6698	ammonium_sulphate = ( 2.0_wp * ions(2) * ions(4) ) / charge_sum
6699	ammonium_nitrate = ( 2.0_wp * ions(2) * ions(6) ) / charge_sum
6700	ammonium_chloride = ( 2.0_wp * ions(2) * ions(7) ) / charge_sum
6701	sodium_sulphate = ( 2.0_wp * ions(3) * ions(4) ) / charge_sum
6702	sodium_nitrate = ( 2.0_wp * ions(3) * ions(6) ) / charge_sum
6703	sodium_chloride = ( 2.0_wp * ions(3) * ions(7) ) / charge_sum
6704	solutes = 0.0_wp
6705	solutes = 3.0_wp * sulphuric_acid + 2.0_wp * hydrochloric_acid + 2.0_wp * nitric_acid + &
6706	3.0_wp * ammonium_sulphate + 2.0_wp * ammonium_nitrate + 2.0_wp * ammonium_chloride +&
6707	3.0_wp * sodium_sulphate + 2.0_wp * sodium_nitrate + 2.0_wp * sodium_chloride
6708	!
6709	!-- b) Inorganic equivalent fractions:
6710	!-- These values are calculated so that activity coefficients can be expressed by a linear additive
6711	!-- rule, thus allowing more efficient calculations and future expansion (see more detailed
6712	!-- description below)
6713	nitric_acid_eq_frac = 2.0_wp * nitric_acid / solutes
6714	hydrochloric_acid_eq_frac = 2.0_wp * hydrochloric_acid / solutes
6715	sulphuric_acid_eq_frac = 3.0_wp * sulphuric_acid / solutes
6716	ammonium_sulphate_eq_frac = 3.0_wp * ammonium_sulphate / solutes
6717	ammonium_nitrate_eq_frac = 2.0_wp * ammonium_nitrate / solutes
6718	ammonium_chloride_eq_frac = 2.0_wp * ammonium_chloride / solutes
6719	sodium_sulphate_eq_frac = 3.0_wp * sodium_sulphate / solutes
6720	sodium_nitrate_eq_frac = 2.0_wp * sodium_nitrate / solutes
6721	sodium_chloride_eq_frac = 2.0_wp * sodium_chloride / solutes
6722	!
6723	!-- Inorganic ion molalities
6724	ions_mol(1) = ions(1) / ( water_total * 18.01528E-3_wp ) ! H+
6725	ions_mol(2) = ions(2) / ( water_total * 18.01528E-3_wp ) ! NH4+
6726	ions_mol(3) = ions(3) / ( water_total * 18.01528E-3_wp ) ! Na+
6727	ions_mol(4) = ions(4) / ( water_total * 18.01528E-3_wp ) ! SO4(2-)
6728	ions_mol(5) = ions(5) / ( water_total * 18.01528E-3_wp ) ! HSO4(2-)
6729	ions_mol(6) = ions(6) / ( water_total * 18.01528E-3_wp ) ! NO3-
6730	ions_mol(7) = ions(7) / ( water_total * 18.01528E-3_wp ) ! Cl-
6731
6732	!-- ***
6733	!-- At this point we may need to introduce a method for prescribing H+ when there is no 'real' value
6734	!-- for H+..i.e. in the sulphate poor domain. This will give a value for solve quadratic proposed by
6735	!-- Zaveri et al. 2005
6736	!
6737	!-- 2) - WATER CALCULATION
6738	!
6739	!-- a) The water content is calculated using the ZSR rule with solute concentrations calculated
6740	!-- using 1a above. Whilst the usual approximation of ZSR relies on binary data consisting of 5th or
6741	!-- higher order polynomials, in this code 4 different RH regimes are used, each housing cubic
6742	!-- equations for the water associated with each solute listed above. Binary water contents for
6743	!-- inorganic components were calculated using AIM online (Clegg et al 1998). The water associated
6744	!-- with the organic compound is calculated assuming ideality and that aw = RH.
6745	!
6746	!-- b) Molality of each inorganic ion and organic solute (initial input) is calculated for use in
6747	!-- vapour pressure calculation.
6748	!
6749	!-- 3) - BISULPHATE ION DISSOCIATION CALCULATION
6750	!
6751	!-- The dissociation of the bisulphate ion is calculated explicitly. A solution to the equilibrium
6752	!-- equation between the bisulphate ion, hydrogen ion and sulphate ion is found using tabulated
6753	!-- equilibrium constants (referenced). It is necessary to calculate the activity coefficients of
6754	!-- HHSO4 and H2SO4 in a non-iterative manner. These are calculated using the same format as
6755	!-- described in 4) below, where both activity coefficients were fit to the output from ADDEM
6756	!-- (Topping et al 2005a,b) covering an extensive composition space, providing the activity
6757	!-- coefficients and bisulphate ion dissociation as a function of equivalent mole fractions and
6758	!-- relative humidity.
6759	!
6760	!-- NOTE: the flags "binary_case" and "full_complexity" are not used in this prototype. They are
6761	!-- used for simplification of the fit expressions when using limited composition regions. This
6762	!-- section of code calculates the bisulphate ion concentration.
6763	!
6764	IF ( ions(1) > 0.0_wp .AND. ions(4) > 0.0_wp ) THEN
6765	!
6766	!-- HHSO4:
6767	binary_case = 1
6768	IF ( rh > 0.1_wp .AND. rh < 0.9_wp ) THEN
6769	binary_hhso4 = -4.9521_wp * rh*3 + 9.2881_wp rh*2 - 10.777_wp rh + 6.0534_wp
6770	ELSEIF ( rh >= 0.9_wp .AND. rh < 0.955_wp ) THEN
6771	binary_hhso4 = -6.3777_wp * rh + 5.962_wp
6772	ELSEIF ( rh >= 0.955_wp .AND. rh < 0.99_wp ) THEN
6773	binary_hhso4 = 2367.2_wp * rh*3 - 6849.7_wp rh*2 + 6600.9_wp rh - 2118.7_wp
6774	ELSEIF ( rh >= 0.99_wp .AND. rh < 0.9999_wp ) THEN
6775	binary_hhso4 = 3E-7_wp * rh*5 - 2E-5_wp rh*4 + 0.0004_wp rh*3 - 0.0035_wp rh**2 &
6776	+ 0.0123_wp * rh - 0.3025_wp
6777	ENDIF
6778
6779	IF ( nitric_acid > 0.0_wp ) THEN
6780	hno3_hhso4 = -4.2204_wp * rh*4 + 12.193_wp rh*3 - 12.481_wp rh*2 + 6.459_wp rh &
6781	- 1.9004_wp
6782	ENDIF
6783
6784	IF ( hydrochloric_acid > 0.0_wp ) THEN
6785	hcl_hhso4 = -54.845_wp * rh*7 + 209.54_wp rh*6 - 336.59_wp rh*5 + 294.21_wp &
6786	rh*4 - 150.07_wp rh*3 + 43.767_wp rh*2 - 6.5495_wp rh + 0.60048_wp
6787	ENDIF
6788
6789	IF ( ammonium_sulphate > 0.0_wp ) THEN
6790	nh42so4_hhso4 = 16.768_wp * rh*3 - 28.75_wp rh*2 + 20.011_wp rh - 8.3206_wp
6791	ENDIF
6792
6793	IF ( ammonium_nitrate > 0.0_wp ) THEN
6794	nh4no3_hhso4 = -17.184_wp * rh*4 + 56.834_wp rh*3 - 65.765_wp rh**2 + &
6795	35.321_wp * rh - 9.252_wp
6796	ENDIF
6797
6798	IF (ammonium_chloride > 0.0_wp ) THEN
6799	IF ( rh < 0.2_wp .AND. rh >= 0.1_wp ) THEN
6800	nh4cl_hhso4 = 3.2809_wp * rh - 2.0637_wp
6801	ELSEIF ( rh >= 0.2_wp .AND. rh < 0.99_wp ) THEN
6802	nh4cl_hhso4 = -1.2981_wp * rh*3 + 4.7461_wp rh*2 - 2.3269_wp rh - 1.1259_wp
6803	ENDIF
6804	ENDIF
6805
6806	IF ( sodium_sulphate > 0.0_wp ) THEN
6807	na2so4_hhso4 = 118.87_wp * rh*6 - 358.63_wp rh*5 + 435.85_wp rh*4 - 272.88_wp &
6808	rh*3 + 94.411_wp rh*2 - 18.21_wp rh + 0.45935_wp
6809	ENDIF
6810
6811	IF ( sodium_nitrate > 0.0_wp ) THEN
6812	IF ( rh < 0.2_wp .AND. rh >= 0.1_wp ) THEN
6813	nano3_hhso4 = 4.8456_wp * rh - 2.5773_wp
6814	ELSEIF ( rh >= 0.2_wp .AND. rh < 0.99_wp ) THEN
6815	nano3_hhso4 = 0.5964_wp * rh*3 - 0.38967_wp rh*2 + 1.7918_wp rh - 1.9691_wp
6816	ENDIF
6817	ENDIF
6818
6819	IF ( sodium_chloride > 0.0_wp ) THEN
6820	IF ( rh < 0.2_wp ) THEN
6821	nacl_hhso4 = 0.51995_wp * rh - 1.3981_wp
6822	ELSEIF ( rh >= 0.2_wp .AND. rh < 0.99_wp ) THEN
6823	nacl_hhso4 = 1.6539_wp * rh - 1.6101_wp
6824	ENDIF
6825	ENDIF
6826
6827	ln_hhso4_act = binary_hhso4 + nitric_acid_eq_frac * hno3_hhso4 + &
6828	hydrochloric_acid_eq_frac * hcl_hhso4 + &
6829	ammonium_sulphate_eq_frac * nh42so4_hhso4 + &
6830	ammonium_nitrate_eq_frac * nh4no3_hhso4 + &
6831	ammonium_chloride_eq_frac * nh4cl_hhso4 + &
6832	sodium_sulphate_eq_frac * na2so4_hhso4 + &
6833	sodium_nitrate_eq_frac * nano3_hhso4 + sodium_chloride_eq_frac * nacl_hhso4
6834
6835	gamma_hhso4 = EXP( ln_hhso4_act ) ! molal activity coefficient of HHSO4
6836
6837	!-- H2SO4 (sulphuric acid):
6838	IF ( rh >= 0.1_wp .AND. rh < 0.9_wp ) THEN
6839	binary_h2so4 = 2.4493_wp * rh*2 - 6.2326_wp rh + 2.1763_wp
6840	ELSEIF ( rh >= 0.9_wp .AND. rh < 0.98 ) THEN
6841	binary_h2so4 = 914.68_wp * rh*3 - 2502.3_wp rh*2 + 2281.9_wp rh - 695.11_wp
6842	ELSEIF ( rh >= 0.98 .AND. rh < 0.9999 ) THEN
6843	binary_h2so4 = 3.0E-8_wp * rh*4 - 5E-6_wp rh*3 + 0.0003_wp rh*2 - 0.0022_wp &
6844	rh - 1.1305_wp
6845	ENDIF
6846
6847	IF ( nitric_acid > 0.0_wp ) THEN
6848	hno3_h2so4 = - 16.382_wp * rh*5 + 46.677_wp rh*4 - 54.149_wp rh*3 + 34.36_wp &
6849	rh*2 - 12.54_wp rh + 2.1368_wp
6850	ENDIF
6851
6852	IF ( hydrochloric_acid > 0.0_wp ) THEN
6853	hcl_h2so4 = - 14.409_wp * rh*5 + 42.804_wp rh*4 - 47.24_wp rh*3 + 24.668_wp &
6854	rh*2 - 5.8015_wp rh + 0.084627_wp
6855	ENDIF
6856
6857	IF ( ammonium_sulphate > 0.0_wp ) THEN
6858	nh42so4_h2so4 = 66.71_wp * rh*5 - 187.5_wp rh*4 + 210.57_wp rh*3 - 121.04_wp &
6859	rh*2 + 39.182_wp rh - 8.0606_wp
6860	ENDIF
6861
6862	IF ( ammonium_nitrate > 0.0_wp ) THEN
6863	nh4no3_h2so4 = - 22.532_wp * rh*4 + 66.615_wp rh*3 - 74.647_wp rh*2 + 37.638_wp &
6864	rh - 6.9711_wp
6865	ENDIF
6866
6867	IF ( ammonium_chloride > 0.0_wp ) THEN
6868	IF ( rh >= 0.1_wp .AND. rh < 0.2_wp ) THEN
6869	nh4cl_h2so4 = - 0.32089_wp * rh + 0.57738_wp
6870	ELSEIF ( rh >= 0.2_wp .AND. rh < 0.9_wp ) THEN
6871	nh4cl_h2so4 = 18.089_wp * rh*5 - 51.083_wp rh*4 + 50.32_wp rh*3 - 17.012_wp &
6872	rh*2 - 0.93435_wp rh + 1.0548_wp
6873	ELSEIF ( rh >= 0.9_wp .AND. rh < 0.99_wp ) THEN
6874	nh4cl_h2so4 = - 1.5749_wp * rh + 1.7002_wp
6875	ENDIF
6876	ENDIF
6877
6878	IF ( sodium_sulphate > 0.0_wp ) THEN
6879	na2so4_h2so4 = 29.843_wp * rh*4 - 69.417_wp rh*3 + 61.507_wp rh*2 - 29.874_wp &
6880	rh + 7.7556_wp
6881	ENDIF
6882
6883	IF ( sodium_nitrate > 0.0_wp ) THEN
6884	nano3_h2so4 = - 122.37_wp * rh*6 + 427.43_wp rh*5 - 604.68_wp rh*4 + 443.08_wp &
6885	rh*3 - 178.61_wp rh*2 + 37.242_wp rh - 1.9564_wp
6886	ENDIF
6887
6888	IF ( sodium_chloride > 0.0_wp ) THEN
6889	nacl_h2so4 = - 40.288_wp * rh*5 + 115.61_wp rh*4 - 129.99_wp rh*3 + 72.652_wp &
6890	rh*2 - 22.124_wp rh + 4.2676_wp
6891	ENDIF
6892
6893	ln_h2so4_act = binary_h2so4 + nitric_acid_eq_frac * hno3_h2so4 + &
6894	hydrochloric_acid_eq_frac * hcl_h2so4 + &
6895	ammonium_sulphate_eq_frac * nh42so4_h2so4 + &
6896	ammonium_nitrate_eq_frac * nh4no3_h2so4 + &
6897	ammonium_chloride_eq_frac * nh4cl_h2so4 + &
6898	sodium_sulphate_eq_frac * na2so4_h2so4 + &
6899	sodium_nitrate_eq_frac * nano3_h2so4 + sodium_chloride_eq_frac * nacl_h2so4
6900
6901	gamma_h2so4 = EXP( ln_h2so4_act ) ! molal activity coefficient
6902	!
6903	!-- Export activity coefficients
6904	IF ( gamma_h2so4 > 1.0E-10_wp ) THEN
6905	gamma_out(4) = gamma_hhso4**2 / gamma_h2so4
6906	ENDIF
6907	IF ( gamma_hhso4 > 1.0E-10_wp ) THEN
6908	gamma_out(5) = gamma_h2so43 / gamma_hhso42
6909	ENDIF
6910	!
6911	!-- Ionic activity coefficient product
6912	act_product = gamma_h2so43 / gamma_hhso42
6913	!
6914	!-- Solve the quadratic equation (i.e. x in ax**2 + bx + c = 0)
6915	a = 1.0_wp
6916	b = -1.0_wp * ( ions(4) + ions(1) + ( ( water_total * 18.0E-3_wp ) / &
6917	( 99.0_wp * act_product ) ) )
6918	c = ions(4) * ions(1)
6919	root1 = ( ( -1.0_wp * b ) + ( ( ( b*2 ) - 4.0_wp a * c )*0.5_wp ) ) / ( 2.0_wp a )
6920	root2 = ( ( -1.0_wp * b ) - ( ( ( b*2 ) - 4.0_wp a * c) *0.5_wp ) ) / ( 2.0_wp a )
6921
6922	IF ( root1 > ions(1) .OR. root1 < 0.0_wp ) THEN
6923	root1 = 0.0_wp
6924	ENDIF
6925
6926	IF ( root2 > ions(1) .OR. root2 < 0.0_wp ) THEN
6927	root2 = 0.0_wp
6928	ENDIF
6929	!
6930	!-- Calculate the new hydrogen ion, bisulphate ion and sulphate ion
6931	!-- concentration
6932	h_real = ions(1)
6933	so4_real = ions(4)
6934	hso4_real = MAX( root1, root2 )
6935	h_real = ions(1) - hso4_real
6936	so4_real = ions(4) - hso4_real
6937	!
6938	!-- Recalculate ion molalities
6939	ions_mol(1) = h_real / ( water_total * 18.01528E-3_wp ) ! H+
6940	ions_mol(4) = so4_real / ( water_total * 18.01528E-3_wp ) ! SO4(2-)
6941	ions_mol(5) = hso4_real / ( water_total * 18.01528E-3_wp ) ! HSO4(2-)
6942
6943	h_out = h_real
6944	hso4_out = hso4_real
6945	so4_out = so4_real
6946
6947	ELSE
6948	h_out = ions(1)
6949	hso4_out = 0.0_wp
6950	so4_out = ions(4)
6951	ENDIF
6952
6953	!
6954	!-- 4) ACTIVITY COEFFICIENTS -for vapour pressures of HNO3,HCL and NH3
6955	!
6956	!-- This section evaluates activity coefficients and vapour pressures using the water content
6957	!-- calculated above) for each inorganic condensing species: a - HNO3, b - NH3, c - HCL.
6958	!-- The following procedure is used: Zaveri et al (2005) found that one could express the variation
6959	!-- of activity coefficients linearly in log-space if equivalent mole fractions were used.
6960	!-- So, by a taylor series expansion LOG( activity coefficient ) =
6961	!-- LOG( binary activity coefficient at a given RH ) +
6962	!-- (equivalent mole fraction compound A) *
6963	!-- ('interaction' parameter between A and condensing species) +
6964	!-- equivalent mole fraction compound B) *
6965	!-- ('interaction' parameter between B and condensing species).
6966	!-- Here, the interaction parameters have been fit to ADDEM by searching the whole compositon space
6967	!-- and fit usign the Levenberg-Marquardt non-linear least squares algorithm.
6968	!
6969	!-- They are given as a function of RH and vary with complexity ranging from linear to 5th order
6970	!-- polynomial expressions, the binary activity coefficients were calculated using AIM online.
6971	!-- NOTE: for NH3, no binary activity coefficient was used and the data were fit to the ratio of the
6972	!-- activity coefficients for the ammonium and hydrogen ions. Once the activity coefficients are
6973	!-- obtained the vapour pressure can be easily calculated using tabulated equilibrium constants
6974	!-- (referenced). This procedure differs from that of Zaveri et al (2005) in that it is not assumed
6975	!-- one can carry behaviour from binary mixtures in multicomponent systems. To this end we have fit
6976	!-- the 'interaction' parameters explicitly to a general inorganic equilibrium model
6977	!-- (ADDEM - Topping et al. 2005a,b). Such parameters take into account bisulphate ion dissociation
6978	!-- and water content. This also allows us to consider one regime for all composition space, rather
6979	!-- than defining sulphate rich and sulphate poor regimes.
6980	!-- NOTE: The flags "binary_case" and "full_complexity" are not used in this prototype. They are
6981	!-- used for simplification of the fit expressions when using limited composition regions.
6982	!
6983	!-- a) - ACTIVITY COEFF/VAPOUR PRESSURE - HNO3
6984	IF ( ions(1) > 0.0_wp .AND. ions(6) > 0.0_wp ) THEN
6985	binary_case = 1
6986	IF ( rh > 0.1_wp .AND. rh < 0.98_wp ) THEN
6987	IF ( binary_case == 1 ) THEN
6988	binary_hno3 = 1.8514_wp * rh*3 - 4.6991_wp rh*2 + 1.5514_wp rh + 0.90236_wp
6989	ELSEIF ( binary_case == 2 ) THEN
6990	binary_hno3 = - 1.1751_wp * ( rh*2 ) - 0.53794_wp rh + 1.2808_wp
6991	ENDIF
6992	ELSEIF ( rh >= 0.98_wp .AND. rh < 0.9999_wp ) THEN
6993	binary_hno3 = 1244.69635941351_wp * rh*3 - 2613.93941099991_wp rh**2 + &
6994	1525.0684974546_wp * rh -155.946764059316_wp
6995	ENDIF
6996	!
6997	!-- Contributions from other solutes
6998	full_complexity = 1
6999	IF ( hydrochloric_acid > 0.0_wp ) THEN ! HCL
7000	IF ( full_complexity == 1 .OR. rh < 0.4_wp ) THEN
7001	hcl_hno3 = 16.051_wp * rh*4 - 44.357_wp rh*3 + 45.141_wp rh*2 - 21.638_wp &
7002	rh + 4.8182_wp
7003	ELSEIF ( full_complexity == 0 .AND. rh > 0.4_wp ) THEN
7004	hcl_hno3 = - 1.5833_wp * rh + 1.5569_wp
7005	ENDIF
7006	ENDIF
7007
7008	IF ( sulphuric_acid > 0.0_wp ) THEN ! H2SO4
7009	IF ( full_complexity == 1 .OR. rh < 0.4_wp ) THEN
7010	h2so4_hno3 = - 3.0849_wp * rh*3 + 5.9609_wp rh*2 - 4.468_wp rh + 1.5658_wp
7011	ELSEIF ( full_complexity == 0 .AND. rh > 0.4_wp ) THEN
7012	h2so4_hno3 = - 0.93473_wp * rh + 0.9363_wp
7013	ENDIF
7014	ENDIF
7015
7016	IF ( ammonium_sulphate > 0.0_wp ) THEN ! NH42SO4
7017	nh42so4_hno3 = 16.821_wp * rh*3 - 28.391_wp rh*2 + 18.133_wp rh - 6.7356_wp
7018	ENDIF
7019
7020	IF ( ammonium_nitrate > 0.0_wp ) THEN ! NH4NO3
7021	nh4no3_hno3 = 11.01_wp * rh*3 - 21.578_wp rh*2 + 14.808_wp rh - 4.2593_wp
7022	ENDIF
7023
7024	IF ( ammonium_chloride > 0.0_wp ) THEN ! NH4Cl
7025	IF ( full_complexity == 1 .OR. rh <= 0.4_wp ) THEN
7026	nh4cl_hno3 = - 1.176_wp * rh*3 + 5.0828_wp rh*2 - 3.8792_wp rh - 0.05518_wp
7027	ELSEIF ( full_complexity == 0 .AND. rh > 0.4_wp ) THEN
7028	nh4cl_hno3 = 2.6219_wp * rh*2 - 2.2609_wp rh - 0.38436_wp
7029	ENDIF
7030	ENDIF
7031
7032	IF ( sodium_sulphate > 0.0_wp ) THEN ! Na2SO4
7033	na2so4_hno3 = 35.504_wp * rh*4 - 80.101_wp rh*3 + 67.326_wp rh*2 - 28.461_wp &
7034	rh + 5.6016_wp
7035	ENDIF
7036
7037	IF ( sodium_nitrate > 0.0_wp ) THEN ! NaNO3
7038	IF ( full_complexity == 1 .OR. rh <= 0.4_wp ) THEN
7039	nano3_hno3 = 23.659_wp * rh*5 - 66.917_wp rh*4 + 74.686_wp rh*3 - 40.795_wp &
7040	rh*2 + 10.831_wp rh - 1.4701_wp
7041	ELSEIF ( full_complexity == 0 .AND. rh > 0.4_wp ) THEN
7042	nano3_hno3 = 14.749_wp * rh*4 - 35.237_wp rh*3 + 31.196_wp rh*2 - 12.076_wp &
7043	rh + 1.3605_wp
7044	ENDIF
7045	ENDIF
7046
7047	IF ( sodium_chloride > 0.0_wp ) THEN ! NaCl
7048	IF ( full_complexity == 1 .OR. rh <= 0.4_wp ) THEN
7049	nacl_hno3 = 13.682_wp * rh*4 - 35.122_wp rh*3 + 33.397_wp rh*2 - 14.586_wp &
7050	rh + 2.6276_wp
7051	ELSEIF ( full_complexity == 0 .AND. rh > 0.4_wp ) THEN
7052	nacl_hno3 = 1.1882_wp * rh*3 - 1.1037_wp rh*2 - 0.7642_wp rh + 0.6671_wp
7053	ENDIF
7054	ENDIF
7055
7056	ln_hno3_act = binary_hno3 + hydrochloric_acid_eq_frac * hcl_hno3 + &
7057	sulphuric_acid_eq_frac * h2so4_hno3 + &
7058	ammonium_sulphate_eq_frac * nh42so4_hno3 + &
7059	ammonium_nitrate_eq_frac * nh4no3_hno3 + &
7060	ammonium_chloride_eq_frac * nh4cl_hno3 + &
7061	sodium_sulphate_eq_frac * na2so4_hno3 + &
7062	sodium_nitrate_eq_frac * nano3_hno3 + sodium_chloride_eq_frac * nacl_hno3
7063
7064	gamma_hno3 = EXP( ln_hno3_act ) ! Molal activity coefficient of HNO3
7065	gamma_out(1) = gamma_hno3
7066	!
7067	!-- Partial pressure calculation
7068	!-- k_hno3 = 2.51 * ( 10**6 )
7069	!-- k_hno3 = 2.628145923d6 !< calculated by AIM online (Clegg et al 1998) after Chameides (1984)
7070	k_hno3 = 2.6E6_wp * EXP( 8700.0_wp * henrys_temp_dep )
7071	press_hno3 = ( ions_mol(1) * ions_mol(6) * ( gamma_hno3**2 ) ) / k_hno3
7072	ENDIF
7073	!
7074	!-- b) - ACTIVITY COEFF/VAPOUR PRESSURE - NH3
7075	!-- Follow the two solute approach of Zaveri et al. (2005)
7076	IF ( ions(2) > 0.0_wp .AND. ions_mol(1) > 0.0_wp ) THEN
7077	!
7078	!-- NH4HSO4:
7079	binary_nh4hso4 = 56.907_wp * rh*6 - 155.32_wp rh*5 + 142.94_wp rh*4 - 32.298_wp &
7080	rh*3 - 27.936_wp rh*2 + 19.502_wp rh - 4.2618_wp
7081	IF ( nitric_acid > 0.0_wp) THEN ! HNO3
7082	hno3_nh4hso4 = 104.8369_wp * rh*8 - 288.8923_wp rh*7 + 129.3445_wp rh**6 + &
7083	373.0471_wp * rh*5 - 571.0385_wp rh*4 + 326.3528_wp rh**3 - &
7084	74.169_wp * rh*2 - 2.4999_wp rh + 3.17_wp
7085	ENDIF
7086
7087	IF ( hydrochloric_acid > 0.0_wp) THEN ! HCL
7088	hcl_nh4hso4 = - 7.9133_wp * rh*8 + 126.6648_wp rh*7 - 460.7425_wp rh**6 + &
7089	731.606_wp * rh*5 - 582.7467_wp rh*4 + 216.7197_wp rh**3 - &
7090	11.3934_wp * rh*2 - 17.7728_wp rh + 5.75_wp
7091	ENDIF
7092
7093	IF ( sulphuric_acid > 0.0_wp) THEN ! H2SO4
7094	h2so4_nh4hso4 = 195.981_wp * rh*8 - 779.2067_wp rh*7 + 1226.3647_wp rh**6 - &
7095	964.0261_wp * rh*5 + 391.7911_wp rh*4 - 84.1409_wp rh**3 + &
7096	20.0602_wp * rh*2 - 10.2663_wp rh + 3.5817_wp
7097	ENDIF
7098
7099	IF ( ammonium_sulphate > 0.0_wp) THEN ! NH42SO4
7100	nh42so4_nh4hso4 = 617.777_wp * rh*8 - 2547.427_wp rh*7 + 4361.6009_wp rh**6 - &
7101	4003.162_wp * rh*5 + 2117.8281_wp rh*4 - 640.0678_wp rh**3 + &
7102	98.0902_wp * rh*2 - 2.2615_wp rh - 2.3811_wp
7103	ENDIF
7104
7105	IF ( ammonium_nitrate > 0.0_wp) THEN ! NH4NO3
7106	nh4no3_nh4hso4 = - 104.4504_wp * rh*8 + 539.5921_wp rh*7 - 1157.0498_wp rh**6 + &
7107	1322.4507_wp * rh*5 - 852.2475_wp rh*4 + 298.3734_wp rh**3 - &
7108	47.0309_wp * rh*2 + 1.297_wp rh - 0.8029_wp
7109	ENDIF
7110
7111	IF ( ammonium_chloride > 0.0_wp) THEN ! NH4Cl
7112	nh4cl_nh4hso4 = 258.1792_wp * rh*8 - 1019.3777_wp rh*7 + 1592.8918_wp rh**6 - &
7113	1221.0726_wp * rh*5 + 442.2548_wp rh*4 - 43.6278_wp rh**3 - &
7114	7.5282_wp * rh*2 - 3.8459_wp rh + 2.2728_wp
7115	ENDIF
7116
7117	IF ( sodium_sulphate > 0.0_wp) THEN ! Na2SO4
7118	na2so4_nh4hso4 = 225.4238_wp * rh*8 - 732.4113_wp rh*7 + 843.7291_wp rh**6 - &
7119	322.7328_wp * rh*5 - 88.6252_wp rh*4 + 72.4434_wp rh**3 + &
7120	22.9252_wp * rh*2 - 25.3954_wp rh + 4.6971_wp
7121	ENDIF
7122
7123	IF ( sodium_nitrate > 0.0_wp) THEN ! NaNO3
7124	nano3_nh4hso4 = 96.1348_wp * rh*8 - 341.6738_wp rh*7 + 406.5314_wp rh**6 - &
7125	98.5777_wp * rh*5 - 172.8286_wp rh*4 + 149.3151_wp rh**3 - &
7126	38.9998_wp * rh*2 - 0.2251_wp rh + 0.4953_wp
7127	ENDIF
7128
7129	IF ( sodium_chloride > 0.0_wp) THEN ! NaCl
7130	nacl_nh4hso4 = 91.7856_wp * rh*8 - 316.6773_wp rh*7 + 358.2703_wp rh**6 - &
7131	68.9142_wp * rh*5 - 156.5031_wp rh*4 + 116.9592_wp rh**3 - &
7132	22.5271_wp * rh*2 - 3.7716_wp rh + 1.56_wp
7133	ENDIF
7134
7135	ln_nh4hso4_act = binary_nh4hso4 + nitric_acid_eq_frac * hno3_nh4hso4 + &
7136	hydrochloric_acid_eq_frac * hcl_nh4hso4 + &
7137	sulphuric_acid_eq_frac * h2so4_nh4hso4 + &
7138	ammonium_sulphate_eq_frac * nh42so4_nh4hso4 + &
7139	ammonium_nitrate_eq_frac * nh4no3_nh4hso4 + &
7140	ammonium_chloride_eq_frac * nh4cl_nh4hso4 + &
7141	sodium_sulphate_eq_frac * na2so4_nh4hso4 + &
7142	sodium_nitrate_eq_frac * nano3_nh4hso4 + &
7143	sodium_chloride_eq_frac * nacl_nh4hso4
7144
7145	gamma_nh4hso4 = EXP( ln_nh4hso4_act ) ! molal act. coefficient of NH4HSO4
7146	!
7147	!-- Molal activity coefficient of NO3-
7148	gamma_out(6) = gamma_nh4hso4
7149	!
7150	!-- Molal activity coefficient of NH4+
7151	gamma_nh3 = gamma_nh4hso42 / gamma_hhso42
7152	gamma_out(3) = gamma_nh3
7153	!
7154	!-- This actually represents the ratio of the ammonium to hydrogen ion activity coefficients
7155	!-- (see Zaveri paper) - multiply this by the ratio of the ammonium to hydrogen ion molality and
7156	!-- the ratio of appropriate equilibrium constants
7157	!
7158	!-- Equilibrium constants
7159	!-- k_h = 57.64d0 ! Zaveri et al. (2005)
7160	k_h = 5.8E1_wp * EXP( 4085.0_wp * henrys_temp_dep ) ! after Chameides (1984)
7161	!-- k_nh4 = 1.81E-5_wp ! Zaveri et al. (2005)
7162	k_nh4 = 1.7E-5_wp * EXP( -4325.0_wp * henrys_temp_dep ) ! Chameides (1984)
7163	!-- k_h2o = 1.01E-14_wp ! Zaveri et al (2005)
7164	k_h2o = 1.E-14_wp * EXP( -6716.0_wp * henrys_temp_dep ) ! Chameides (1984)
7165	!
7166	molality_ratio_nh3 = ions_mol(2) / ions_mol(1)
7167	!
7168	!-- Partial pressure calculation
7169	press_nh3 = molality_ratio_nh3 * gamma_nh3 * ( k_h2o / ( k_h * k_nh4 ) )
7170
7171	ENDIF
7172	!
7173	!-- c) - ACTIVITY COEFF/VAPOUR PRESSURE - HCL
7174	IF ( ions(1) > 0.0_wp .AND. ions(7) > 0.0_wp ) THEN
7175	binary_case = 1
7176	IF ( rh > 0.1_wp .AND. rh < 0.98 ) THEN
7177	IF ( binary_case == 1 ) THEN
7178	binary_hcl = - 5.0179_wp * rh*3 + 9.8816_wp rh*2 - 10.789_wp rh + 5.4737_wp
7179	ELSEIF ( binary_case == 2 ) THEN
7180	binary_hcl = - 4.6221_wp * rh + 4.2633_wp
7181	ENDIF
7182	ELSEIF ( rh >= 0.98_wp .AND. rh < 0.9999_wp ) THEN
7183	binary_hcl = 775.6111008626_wp * rh*3 - 2146.01320888771_wp rh**2 + &
7184	1969.01979670259_wp * rh - 598.878230033926_wp
7185	ENDIF
7186	ENDIF
7187
7188	IF ( nitric_acid > 0.0_wp ) THEN ! HNO3
7189	IF ( full_complexity == 1 .OR. rh <= 0.4_wp ) THEN
7190	hno3_hcl = 9.6256_wp * rh*4 - 26.507_wp rh*3 + 27.622_wp rh*2 - 12.958_wp rh + &
7191	2.2193_wp
7192	ELSEIF ( full_complexity == 0 .AND. rh > 0.4_wp ) THEN
7193	hno3_hcl = 1.3242_wp * rh*2 - 1.8827_wp rh + 0.55706_wp
7194	ENDIF
7195	ENDIF
7196
7197	IF ( sulphuric_acid > 0.0_wp ) THEN ! H2SO4
7198	IF ( full_complexity == 1 .OR. rh <= 0.4 ) THEN
7199	h2so4_hcl = 1.4406_wp * rh*3 - 2.7132_wp rh*2 + 1.014_wp rh + 0.25226_wp
7200	ELSEIF ( full_complexity == 0 .AND. rh > 0.4_wp ) THEN
7201	h2so4_hcl = 0.30993_wp * rh*2 - 0.99171_wp rh + 0.66913_wp
7202	ENDIF
7203	ENDIF
7204
7205	IF ( ammonium_sulphate > 0.0_wp ) THEN ! NH42SO4
7206	nh42so4_hcl = 22.071_wp * rh*3 - 40.678_wp rh*2 + 27.893_wp rh - 9.4338_wp
7207	ENDIF
7208
7209	IF ( ammonium_nitrate > 0.0_wp ) THEN ! NH4NO3
7210	nh4no3_hcl = 19.935_wp * rh*3 - 42.335_wp rh*2 + 31.275_wp rh - 8.8675_wp
7211	ENDIF
7212
7213	IF ( ammonium_chloride > 0.0_wp ) THEN ! NH4Cl
7214	IF ( full_complexity == 1 .OR. rh <= 0.4_wp ) THEN
7215	nh4cl_hcl = 2.8048_wp * rh*3 - 4.3182_wp rh*2 + 3.1971_wp rh - 1.6824_wp
7216	ELSEIF ( full_complexity == 0 .AND. rh > 0.4_wp ) THEN
7217	nh4cl_hcl = 1.2304_wp * rh*2 - 0.18262_wp rh - 1.0643_wp
7218	ENDIF
7219	ENDIF
7220
7221	IF ( sodium_sulphate > 0.0_wp ) THEN ! Na2SO4
7222	na2so4_hcl = 36.104_wp * rh*4 - 78.658_wp rh*3 + 63.441_wp rh*2 - 26.727_wp rh + &
7223	5.7007_wp
7224	ENDIF
7225
7226	IF ( sodium_nitrate > 0.0_wp ) THEN ! NaNO3
7227	IF ( full_complexity == 1 .OR. rh <= 0.4_wp ) THEN
7228	nano3_hcl = 54.471_wp * rh*5 - 159.42_wp rh*4 + 180.25_wp rh*3 - 98.176_wp rh**2&
7229	+ 25.309_wp * rh - 2.4275_wp
7230	ELSEIF ( full_complexity == 0 .AND. rh > 0.4_wp ) THEN
7231	nano3_hcl = 21.632_wp * rh*4 - 53.088_wp rh*3 + 47.285_wp rh*2 - 18.519_wp rh &
7232	+ 2.6846_wp
7233	ENDIF
7234	ENDIF
7235
7236	IF ( sodium_chloride > 0.0_wp ) THEN ! NaCl
7237	IF ( full_complexity == 1 .OR. rh <= 0.4_wp ) THEN
7238	nacl_hcl = 5.4138_wp * rh*4 - 12.079_wp rh*3 + 9.627_wp rh*2 - 3.3164_wp rh + &
7239	0.35224_wp
7240	ELSEIF ( full_complexity == 0 .AND. rh > 0.4_wp ) THEN
7241	nacl_hcl = 2.432_wp * rh*3 - 4.3453_wp rh*2 + 2.3834_wp rh - 0.4762_wp
7242	ENDIF
7243	ENDIF
7244
7245	ln_HCL_act = binary_hcl + nitric_acid_eq_frac * hno3_hcl + sulphuric_acid_eq_frac * h2so4_hcl +&
7246	ammonium_sulphate_eq_frac * nh42so4_hcl + ammonium_nitrate_eq_frac * nh4no3_hcl + &
7247	ammonium_chloride_eq_frac * nh4cl_hcl + sodium_sulphate_eq_frac * na2so4_hcl + &
7248	sodium_nitrate_eq_frac * nano3_hcl + sodium_chloride_eq_frac * nacl_hcl
7249
7250	gamma_hcl = EXP( ln_HCL_act ) ! Molal activity coefficient
7251	gamma_out(2) = gamma_hcl
7252	!
7253	!-- Equilibrium constant after Wagman et al. (1982) (and NIST database)
7254	k_hcl = 2E6_wp * EXP( 9000.0_wp * henrys_temp_dep )
7255
7256	press_hcl = ( ions_mol(1) * ions_mol(7) * gamma_hcl**2 ) / k_hcl
7257	!
7258	!-- 5) Ion molility output
7259	mols_out = ions_mol
7260
7261	END SUBROUTINE inorganic_pdfite
7262
7263	!------------------------------------------------------------------------------!
7264	! Description:
7265	! ------------
7266	!> Update the particle size distribution. Put particles into corrects bins.
7267	!>
7268	!> Moving-centre method assumed, i.e. particles are allowed to grow to their
7269	!> exact size as long as they are not crossing the fixed diameter bin limits.
7270	!> If the particles in a size bin cross the lower or upper diameter limit, they
7271	!> are all moved to the adjacent diameter bin and their volume is averaged with
7272	!> the particles in the new bin, which then get a new diameter.
7273	!
7274	!> Moving-centre method minimises numerical diffusion.
7275	!------------------------------------------------------------------------------!
7276	SUBROUTINE distr_update( paero )
7277
7278	IMPLICIT NONE
7279
7280	INTEGER(iwp) :: ib !< loop index
7281	INTEGER(iwp) :: mm !< loop index
7282	INTEGER(iwp) :: counti !< number of while loops
7283
7284	LOGICAL :: within_bins !< logical (particle belongs to the bin?)
7285
7286	REAL(wp) :: znfrac !< number fraction to be moved to the larger bin
7287	REAL(wp) :: zvfrac !< volume fraction to be moved to the larger bin
7288	REAL(wp) :: zvexc !< Volume in the grown bin which exceeds the bin upper limit
7289	REAL(wp) :: zvihi !< particle volume at the high end of the bin
7290	REAL(wp) :: zvilo !< particle volume at the low end of the bin
7291	REAL(wp) :: zvpart !< particle volume (m3)
7292	REAL(wp) :: zvrat !< volume ratio of a size bin
7293
7294	real(wp), dimension(nbins_aerosol) :: dummy
7295
7296	TYPE(t_section), DIMENSION(nbins_aerosol), INTENT(inout) :: paero !< aerosol properties
7297
7298	zvpart = 0.0_wp
7299	zvfrac = 0.0_wp
7300	within_bins = .FALSE.
7301
7302	dummy = paero(:)%numc
7303	!
7304	!-- Check if the volume of the bin is within bin limits after update
7305	counti = 0
7306	DO WHILE ( .NOT. within_bins )
7307	within_bins = .TRUE.
7308	!
7309	!-- Loop from larger to smaller size bins
7310	DO ib = end_subrange_2b-1, start_subrange_1a, -1
7311	mm = 0
7312	IF ( paero(ib)%numc > nclim ) THEN
7313	zvpart = 0.0_wp
7314	zvfrac = 0.0_wp
7315
7316	IF ( ib == end_subrange_2a ) CYCLE
7317	!
7318	!-- Dry volume
7319	zvpart = SUM( paero(ib)%volc(1:7) ) / paero(ib)%numc
7320	!
7321	!-- Smallest bin cannot decrease
7322	IF ( paero(ib)%vlolim > zvpart .AND. ib == start_subrange_1a ) CYCLE
7323	!
7324	!-- Decreasing bins
7325	IF ( paero(ib)%vlolim > zvpart ) THEN
7326	mm = ib - 1
7327	IF ( ib == start_subrange_2b ) mm = end_subrange_1a ! 2b goes to 1a
7328
7329	paero(mm)%numc = paero(mm)%numc + paero(ib)%numc
7330	paero(ib)%numc = 0.0_wp
7331	paero(mm)%volc(:) = paero(mm)%volc(:) + paero(ib)%volc(:)
7332	paero(ib)%volc(:) = 0.0_wp
7333	CYCLE
7334	ENDIF
7335	!
7336	!-- If size bin has not grown, cycle.
7337	!-- Changed by Mona: compare to the arithmetic mean volume, as done originally. Now
7338	!-- particle volume is derived from the geometric mean diameter, not arithmetic (see
7339	!-- SUBROUTINE set_sizebins).
7340	IF ( zvpart <= api6 * ( ( aero(ib)%vhilim + aero(ib)%vlolim ) / ( 2.0_wp * api6 ) ) ) &
7341	CYCLE
7342	!
7343	!-- Avoid precision problems
7344	IF ( ABS( zvpart - api6 * paero(ib)%dmid**3 ) < 1.0E-35_wp ) CYCLE
7345	!
7346	!-- Volume ratio of the size bin
7347	zvrat = paero(ib)%vhilim / paero(ib)%vlolim
7348	!
7349	!-- Particle volume at the low end of the bin
7350	zvilo = 2.0_wp * zvpart / ( 1.0_wp + zvrat )
7351	!
7352	!-- Particle volume at the high end of the bin
7353	zvihi = zvrat * zvilo
7354	!
7355	!-- Volume in the grown bin which exceeds the bin upper limit
7356	zvexc = 0.5_wp * ( zvihi + paero(ib)%vhilim )
7357	!
7358	!-- Number fraction to be moved to the larger bin
7359	znfrac = MIN( 1.0_wp, ( zvihi - paero(ib)%vhilim) / ( zvihi - zvilo ) )
7360	!
7361	!-- Volume fraction to be moved to the larger bin
7362	zvfrac = MIN( 0.99_wp, znfrac * zvexc / zvpart )
7363	IF ( zvfrac < 0.0_wp ) THEN
7364	message_string = 'Error: zvfrac < 0'
7365	CALL message( 'salsa_mod: distr_update', 'PA0624', 1, 2, 0, 6, 0 )
7366	ENDIF
7367	!
7368	!-- Update bin
7369	mm = ib + 1
7370	!
7371	!-- Volume (cm3/cm3)
7372	paero(mm)%volc(:) = paero(mm)%volc(:) + znfrac * paero(ib)%numc * zvexc * &
7373	paero(ib)%volc(:) / SUM( paero(ib)%volc(1:7) )
7374	paero(ib)%volc(:) = paero(ib)%volc(:) - znfrac * paero(ib)%numc * zvexc * &
7375	paero(ib)%volc(:) / SUM( paero(ib)%volc(1:7) )
7376
7377	!-- Number concentration (#/m3)
7378	paero(mm)%numc = paero(mm)%numc + znfrac * paero(ib)%numc
7379	paero(ib)%numc = paero(ib)%numc * ( 1.0_wp - znfrac )
7380
7381	ENDIF ! nclim
7382
7383	IF ( paero(ib)%numc > nclim ) THEN
7384	zvpart = SUM( paero(ib)%volc(1:7) ) / paero(ib)%numc ! Note: dry volume!
7385	within_bins = ( paero(ib)%vlolim < zvpart .AND. zvpart < paero(ib)%vhilim )
7386	ENDIF
7387
7388	ENDDO ! - ib
7389
7390	counti = counti + 1
7391	IF ( counti > 100 ) THEN
7392	message_string = 'Error: Aerosol bin update not converged'
7393	CALL message( 'salsa_mod: distr_update', 'PA0625', 1, 2, 0, 6, 0 )
7394	ENDIF
7395
7396	ENDDO ! - within bins
7397
7398	END SUBROUTINE distr_update
7399
7400	!------------------------------------------------------------------------------!
7401	! Description:
7402	! ------------
7403	!> salsa_diagnostics: Update properties for the current timestep:
7404	!>
7405	!> Juha Tonttila, FMI, 2014
7406	!> Tomi Raatikainen, FMI, 2016
7407	!------------------------------------------------------------------------------!
7408	SUBROUTINE salsa_diagnostics( i, j )
7409
7410	USE cpulog, &
7411	ONLY: cpu_log, log_point_s
7412
7413	IMPLICIT NONE
7414
7415	INTEGER(iwp) :: ib !<
7416	INTEGER(iwp) :: ic !<
7417	INTEGER(iwp) :: icc !<
7418	INTEGER(iwp) :: ig !<
7419	INTEGER(iwp) :: k !<
7420
7421	INTEGER(iwp), INTENT(in) :: i !<
7422	INTEGER(iwp), INTENT(in) :: j !<
7423
7424	REAL(wp), DIMENSION(nzb:nzt+1) :: flag !< flag to mask topography
7425	REAL(wp), DIMENSION(nzb:nzt+1) :: flag_zddry !< flag to mask zddry
7426	REAL(wp), DIMENSION(nzb:nzt+1) :: in_adn !< air density (kg/m3)
7427	REAL(wp), DIMENSION(nzb:nzt+1) :: in_p !< pressure
7428	REAL(wp), DIMENSION(nzb:nzt+1) :: in_t !< temperature (K)
7429	REAL(wp), DIMENSION(nzb:nzt+1) :: mcsum !< sum of mass concentration
7430	REAL(wp), DIMENSION(nzb:nzt+1) :: ppm_to_nconc !< Conversion factor: ppm to #/m3
7431	REAL(wp), DIMENSION(nzb:nzt+1) :: zddry !< particle dry diameter
7432	REAL(wp), DIMENSION(nzb:nzt+1) :: zvol !< particle volume
7433
7434	flag_zddry = 0.0_wp
7435	in_adn = 0.0_wp
7436	in_p = 0.0_wp
7437	in_t = 0.0_wp
7438	ppm_to_nconc = 1.0_wp
7439	zddry = 0.0_wp
7440	zvol = 0.0_wp
7441
7442	!$OMP MASTER
7443	CALL cpu_log( log_point_s(94), 'salsa diagnostics ', 'start' )
7444	!$OMP END MASTER
7445
7446	!
7447	!-- Calculate thermodynamic quantities needed in SALSA
7448	CALL salsa_thrm_ij( i, j, p_ij=in_p, temp_ij=in_t, adn_ij=in_adn )
7449	!
7450	!-- Calculate conversion factors for gas concentrations
7451	ppm_to_nconc = for_ppm_to_nconc * in_p / in_t
7452	!
7453	!-- Predetermine flag to mask topography
7454	flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(:,j,i), 0 ) )
7455
7456	DO ib = 1, nbins_aerosol ! aerosol size bins
7457	!
7458	!-- Remove negative values
7459	aerosol_number(ib)%conc(:,j,i) = MAX( nclim, aerosol_number(ib)%conc(:,j,i) ) * flag
7460	!
7461	!-- Calculate total mass concentration per bin
7462	mcsum = 0.0_wp
7463	DO ic = 1, ncomponents_mass
7464	icc = ( ic - 1 ) * nbins_aerosol + ib
7465	mcsum = mcsum + aerosol_mass(icc)%conc(:,j,i) * flag
7466	aerosol_mass(icc)%conc(:,j,i) = MAX( mclim, aerosol_mass(icc)%conc(:,j,i) ) * flag
7467	ENDDO
7468	!
7469	!-- Check that number and mass concentration match qualitatively
7470	IF ( ANY( aerosol_number(ib)%conc(:,j,i) > nclim .AND. mcsum <= 0.0_wp ) ) THEN
7471	DO k = nzb+1, nzt
7472	IF ( aerosol_number(ib)%conc(k,j,i) >= nclim .AND. mcsum(k) <= 0.0_wp ) THEN
7473	aerosol_number(ib)%conc(k,j,i) = nclim * flag(k)
7474	DO ic = 1, ncomponents_mass
7475	icc = ( ic - 1 ) * nbins_aerosol + ib
7476	aerosol_mass(icc)%conc(k,j,i) = mclim * flag(k)
7477	ENDDO
7478	ENDIF
7479	ENDDO
7480	ENDIF
7481	!
7482	!-- Update aerosol particle radius
7483	CALL bin_mixrat( 'dry', ib, i, j, zvol )
7484	zvol = zvol / arhoh2so4 ! Why on sulphate?
7485	!
7486	!-- Particles smaller then 0.1 nm diameter are set to zero
7487	zddry = ( zvol / MAX( nclim, aerosol_number(ib)%conc(:,j,i) ) / api6 )**0.33333333_wp
7488	flag_zddry = MERGE( 1.0_wp, 0.0_wp, ( zddry < 1.0E-10_wp .AND. &
7489	aerosol_number(ib)%conc(:,j,i) > nclim ) )
7490	!
7491	!-- Volatile species to the gas phase
7492	IF ( index_so4 > 0 .AND. lscndgas ) THEN
7493	ic = ( index_so4 - 1 ) * nbins_aerosol + ib
7494	IF ( salsa_gases_from_chem ) THEN
7495	ig = gas_index_chem(1)
7496	chem_species(ig)%conc(:,j,i) = chem_species(ig)%conc(:,j,i) + &
7497	aerosol_mass(ic)%conc(:,j,i) * avo * flag_zddry / &
7498	( amh2so4 * ppm_to_nconc ) * flag
7499	ELSE
7500	salsa_gas(1)%conc(:,j,i) = salsa_gas(1)%conc(:,j,i) + aerosol_mass(ic)%conc(:,j,i) / &
7501	amh2so4 * avo * flag_zddry * flag
7502	ENDIF
7503	ENDIF
7504	IF ( index_oc > 0 .AND. lscndgas ) THEN
7505	ic = ( index_oc - 1 ) * nbins_aerosol + ib
7506	IF ( salsa_gases_from_chem ) THEN
7507	ig = gas_index_chem(5)
7508	chem_species(ig)%conc(:,j,i) = chem_species(ig)%conc(:,j,i) + &
7509	aerosol_mass(ic)%conc(:,j,i) * avo * flag_zddry / &
7510	( amoc * ppm_to_nconc ) * flag
7511	ELSE
7512	salsa_gas(5)%conc(:,j,i) = salsa_gas(5)%conc(:,j,i) + aerosol_mass(ic)%conc(:,j,i) / &
7513	amoc * avo * flag_zddry * flag
7514	ENDIF
7515	ENDIF
7516	IF ( index_no > 0 .AND. lscndgas ) THEN
7517	ic = ( index_no - 1 ) * nbins_aerosol + ib
7518	IF ( salsa_gases_from_chem ) THEN
7519	ig = gas_index_chem(2)
7520	chem_species(ig)%conc(:,j,i) = chem_species(ig)%conc(:,j,i) + &
7521	aerosol_mass(ic)%conc(:,j,i) * avo * flag_zddry / &
7522	( amhno3 * ppm_to_nconc ) *flag
7523	ELSE
7524	salsa_gas(2)%conc(:,j,i) = salsa_gas(2)%conc(:,j,i) + aerosol_mass(ic)%conc(:,j,i) / &
7525	amhno3 * avo * flag_zddry * flag
7526	ENDIF
7527	ENDIF
7528	IF ( index_nh > 0 .AND. lscndgas ) THEN
7529	ic = ( index_nh - 1 ) * nbins_aerosol + ib
7530	IF ( salsa_gases_from_chem ) THEN
7531	ig = gas_index_chem(3)
7532	chem_species(ig)%conc(:,j,i) = chem_species(ig)%conc(:,j,i) + &
7533	aerosol_mass(ic)%conc(:,j,i) * avo * flag_zddry / &
7534	( amnh3 * ppm_to_nconc ) *flag
7535	ELSE
7536	salsa_gas(3)%conc(:,j,i) = salsa_gas(3)%conc(:,j,i) + aerosol_mass(ic)%conc(:,j,i) / &
7537	amnh3 * avo * flag_zddry *flag
7538	ENDIF
7539	ENDIF
7540	!
7541	!-- Mass and number to zero (insoluble species and water are lost)
7542	DO ic = 1, ncomponents_mass
7543	icc = ( ic - 1 ) * nbins_aerosol + ib
7544	aerosol_mass(icc)%conc(:,j,i) = MERGE( mclim * flag, aerosol_mass(icc)%conc(:,j,i), &
7545	flag_zddry > 0.0_wp )
7546	ENDDO
7547	aerosol_number(ib)%conc(:,j,i) = MERGE( nclim * flag, aerosol_number(ib)%conc(:,j,i), &
7548	flag_zddry > 0.0_wp )
7549	ra_dry(:,j,i,ib) = MAX( 1.0E-10_wp, 0.5_wp * zddry )
7550
7551	ENDDO
7552	IF ( .NOT. salsa_gases_from_chem ) THEN
7553	DO ig = 1, ngases_salsa
7554	salsa_gas(ig)%conc(:,j,i) = MAX( nclim, salsa_gas(ig)%conc(:,j,i) ) * flag
7555	ENDDO
7556	ENDIF
7557
7558	!$OMP MASTER
7559	CALL cpu_log( log_point_s(94), 'salsa diagnostics ', 'stop' )
7560	!$OMP END MASTER
7561
7562	END SUBROUTINE salsa_diagnostics
7563
7564
7565	!------------------------------------------------------------------------------!
7566	! Description:
7567	! ------------
7568	!> Call for all grid points
7569	!------------------------------------------------------------------------------!
7570	SUBROUTINE salsa_actions( location )
7571
7572
7573	CHARACTER (LEN=*), INTENT(IN) :: location !< call location string
7574
7575	SELECT CASE ( location )
7576
7577	CASE ( 'before_timestep' )
7578
7579	IF ( ws_scheme_sca ) sums_salsa_ws_l = 0.0_wp
7580
7581	CASE DEFAULT
7582	CONTINUE
7583
7584	END SELECT
7585
7586	END SUBROUTINE salsa_actions
7587
7588
7589	!------------------------------------------------------------------------------!
7590	! Description:
7591	! ------------
7592	!> Call for grid points i,j
7593	!------------------------------------------------------------------------------!
7594
7595	SUBROUTINE salsa_actions_ij( i, j, location )
7596
7597
7598	INTEGER(iwp), INTENT(IN) :: i !< grid index in x-direction
7599	INTEGER(iwp), INTENT(IN) :: j !< grid index in y-direction
7600	CHARACTER (LEN=*), INTENT(IN) :: location !< call location string
7601	INTEGER(iwp) :: dummy !< call location string
7602
7603	IF ( salsa ) dummy = i + j
7604
7605	SELECT CASE ( location )
7606
7607	CASE ( 'before_timestep' )
7608
7609	IF ( ws_scheme_sca ) sums_salsa_ws_l = 0.0_wp
7610
7611	CASE DEFAULT
7612	CONTINUE
7613
7614	END SELECT
7615
7616
7617	END SUBROUTINE salsa_actions_ij
7618
7619	!------------------------------------------------------------------------------!
7620	! Description:
7621	! ------------
7622	!> Call for all grid points
7623	!------------------------------------------------------------------------------!
7624	SUBROUTINE salsa_non_advective_processes
7625
7626	USE cpulog, &
7627	ONLY: cpu_log, log_point_s
7628
7629	IMPLICIT NONE
7630
7631	INTEGER(iwp) :: i !<
7632	INTEGER(iwp) :: j !<
7633
7634	IF ( time_since_reference_point >= skip_time_do_salsa ) THEN
7635	IF ( ( time_since_reference_point - last_salsa_time ) >= dt_salsa ) THEN
7636	!
7637	!-- Calculate aerosol dynamic processes. salsa_driver can be run with a longer time step.
7638	CALL cpu_log( log_point_s(90), 'salsa processes ', 'start' )
7639	DO i = nxl, nxr
7640	DO j = nys, nyn
7641	CALL salsa_diagnostics( i, j )
7642	CALL salsa_driver( i, j, 3 )
7643	CALL salsa_diagnostics( i, j )
7644	ENDDO
7645	ENDDO
7646	CALL cpu_log( log_point_s(90), 'salsa processes ', 'stop' )
7647	ENDIF
7648	ENDIF
7649
7650	END SUBROUTINE salsa_non_advective_processes
7651
7652
7653	!------------------------------------------------------------------------------!
7654	! Description:
7655	! ------------
7656	!> Call for grid points i,j
7657	!------------------------------------------------------------------------------!
7658	SUBROUTINE salsa_non_advective_processes_ij( i, j )
7659
7660	USE cpulog, &
7661	ONLY: cpu_log, log_point_s
7662
7663	IMPLICIT NONE
7664
7665	INTEGER(iwp), INTENT(IN) :: i !< grid index in x-direction
7666	INTEGER(iwp), INTENT(IN) :: j !< grid index in y-direction
7667
7668	IF ( time_since_reference_point >= skip_time_do_salsa ) THEN
7669	IF ( ( time_since_reference_point - last_salsa_time ) >= dt_salsa ) THEN
7670	!
7671	!-- Calculate aerosol dynamic processes. salsa_driver can be run with a longer time step.
7672	CALL cpu_log( log_point_s(90), 'salsa processes ', 'start' )
7673	CALL salsa_diagnostics( i, j )
7674	CALL salsa_driver( i, j, 3 )
7675	CALL salsa_diagnostics( i, j )
7676	CALL cpu_log( log_point_s(90), 'salsa processes ', 'stop' )
7677	ENDIF
7678	ENDIF
7679
7680	END SUBROUTINE salsa_non_advective_processes_ij
7681
7682	!------------------------------------------------------------------------------!
7683	! Description:
7684	! ------------
7685	!> Routine for exchange horiz of salsa variables.
7686	!------------------------------------------------------------------------------!
7687	SUBROUTINE salsa_exchange_horiz_bounds
7688
7689	USE cpulog, &
7690	ONLY: cpu_log, log_point_s
7691
7692	IMPLICIT NONE
7693
7694	INTEGER(iwp) :: ib !<
7695	INTEGER(iwp) :: ic !<
7696	INTEGER(iwp) :: icc !<
7697	INTEGER(iwp) :: ig !<
7698
7699	IF ( time_since_reference_point >= skip_time_do_salsa ) THEN
7700	IF ( ( time_since_reference_point - last_salsa_time ) >= dt_salsa ) THEN
7701
7702	CALL cpu_log( log_point_s(91), 'salsa exch-horiz ', 'start' )
7703	!
7704	!-- Exchange ghost points and decycle if needed.
7705	DO ib = 1, nbins_aerosol
7706	CALL exchange_horiz( aerosol_number(ib)%conc, nbgp )
7707	CALL salsa_boundary_conds( aerosol_number(ib)%conc, aerosol_number(ib)%init )
7708	DO ic = 1, ncomponents_mass
7709	icc = ( ic - 1 ) * nbins_aerosol + ib
7710	CALL exchange_horiz( aerosol_mass(icc)%conc, nbgp )
7711	CALL salsa_boundary_conds( aerosol_mass(icc)%conc, aerosol_mass(icc)%init )
7712	ENDDO
7713	ENDDO
7714	IF ( .NOT. salsa_gases_from_chem ) THEN
7715	DO ig = 1, ngases_salsa
7716	CALL exchange_horiz( salsa_gas(ig)%conc, nbgp )
7717	CALL salsa_boundary_conds( salsa_gas(ig)%conc, salsa_gas(ig)%init )
7718	ENDDO
7719	ENDIF
7720	CALL cpu_log( log_point_s(91), 'salsa exch-horiz ', 'stop' )
7721	!
7722	!-- Update last_salsa_time
7723	last_salsa_time = time_since_reference_point
7724	ENDIF
7725	ENDIF
7726
7727	END SUBROUTINE salsa_exchange_horiz_bounds
7728
7729	!------------------------------------------------------------------------------!
7730	! Description:
7731	! ------------
7732	!> Calculate the prognostic equation for aerosol number and mass, and gas
7733	!> concentrations. Cache-optimized.
7734	!------------------------------------------------------------------------------!
7735	SUBROUTINE salsa_prognostic_equations_ij( i, j, i_omp_start, tn )
7736
7737	IMPLICIT NONE
7738
7739	INTEGER(iwp) :: i !<
7740	INTEGER(iwp) :: i_omp_start !<
7741	INTEGER(iwp) :: ib !< loop index for aerosol number bin OR gas index
7742	INTEGER(iwp) :: ic !< loop index for aerosol mass bin
7743	INTEGER(iwp) :: icc !< (c-1)*nbins_aerosol+b
7744	INTEGER(iwp) :: ig !< loop index for salsa gases
7745	INTEGER(iwp) :: j !<
7746	INTEGER(iwp) :: tn !<
7747
7748	IF ( time_since_reference_point >= skip_time_do_salsa ) THEN
7749	!
7750	!-- Aerosol number
7751	DO ib = 1, nbins_aerosol
7752	!kk sums_salsa_ws_l = aerosol_number(ib)%sums_ws_l
7753	CALL salsa_tendency( 'aerosol_number', aerosol_number(ib)%conc_p, aerosol_number(ib)%conc,&
7754	aerosol_number(ib)%tconc_m, i, j, i_omp_start, tn, ib, ib, &
7755	aerosol_number(ib)%flux_s, aerosol_number(ib)%diss_s, &
7756	aerosol_number(ib)%flux_l, aerosol_number(ib)%diss_l, &
7757	aerosol_number(ib)%init, .TRUE. )
7758	!kk aerosol_number(ib)%sums_ws_l = sums_salsa_ws_l
7759	!
7760	!-- Aerosol mass
7761	DO ic = 1, ncomponents_mass
7762	icc = ( ic - 1 ) * nbins_aerosol + ib
7763	!kk sums_salsa_ws_l = aerosol_mass(icc)%sums_ws_l
7764	CALL salsa_tendency( 'aerosol_mass', aerosol_mass(icc)%conc_p, aerosol_mass(icc)%conc,&
7765	aerosol_mass(icc)%tconc_m, i, j, i_omp_start, tn, ib, ic, &
7766	aerosol_mass(icc)%flux_s, aerosol_mass(icc)%diss_s, &
7767	aerosol_mass(icc)%flux_l, aerosol_mass(icc)%diss_l, &
7768	aerosol_mass(icc)%init, .TRUE. )
7769	!kk aerosol_mass(icc)%sums_ws_l = sums_salsa_ws_l
7770
7771	ENDDO ! ic
7772	ENDDO ! ib
7773	!
7774	!-- Gases
7775	IF ( .NOT. salsa_gases_from_chem ) THEN
7776
7777	DO ig = 1, ngases_salsa
7778	!kk sums_salsa_ws_l = salsa_gas(ig)%sums_ws_l
7779	CALL salsa_tendency( 'salsa_gas', salsa_gas(ig)%conc_p, salsa_gas(ig)%conc, &
7780	salsa_gas(ig)%tconc_m, i, j, i_omp_start, tn, ig, ig, &
7781	salsa_gas(ig)%flux_s, salsa_gas(ig)%diss_s, salsa_gas(ig)%flux_l,&
7782	salsa_gas(ig)%diss_l, salsa_gas(ig)%init, .FALSE. )
7783	!kk salsa_gas(ig)%sums_ws_l = sums_salsa_ws_l
7784
7785	ENDDO ! ig
7786
7787	ENDIF
7788
7789	ENDIF
7790
7791	END SUBROUTINE salsa_prognostic_equations_ij
7792	!
7793	!------------------------------------------------------------------------------!
7794	! Description:
7795	! ------------
7796	!> Calculate the prognostic equation for aerosol number and mass, and gas
7797	!> concentrations. For vector machines.
7798	!------------------------------------------------------------------------------!
7799	SUBROUTINE salsa_prognostic_equations()
7800
7801	IMPLICIT NONE
7802
7803	INTEGER(iwp) :: ib !< loop index for aerosol number bin OR gas index
7804	INTEGER(iwp) :: ic !< loop index for aerosol mass bin
7805	INTEGER(iwp) :: icc !< (c-1)*nbins_aerosol+b
7806	INTEGER(iwp) :: ig !< loop index for salsa gases
7807
7808	IF ( time_since_reference_point >= skip_time_do_salsa ) THEN
7809	!
7810	!-- Aerosol number
7811	DO ib = 1, nbins_aerosol
7812	sums_salsa_ws_l = aerosol_number(ib)%sums_ws_l
7813	CALL salsa_tendency( 'aerosol_number', aerosol_number(ib)%conc_p, aerosol_number(ib)%conc,&
7814	aerosol_number(ib)%tconc_m, ib, ib, aerosol_number(ib)%init, .TRUE. )
7815	aerosol_number(ib)%sums_ws_l = sums_salsa_ws_l
7816	!
7817	!-- Aerosol mass
7818	DO ic = 1, ncomponents_mass
7819	icc = ( ic - 1 ) * nbins_aerosol + ib
7820	sums_salsa_ws_l = aerosol_mass(icc)%sums_ws_l
7821	CALL salsa_tendency( 'aerosol_mass', aerosol_mass(icc)%conc_p, aerosol_mass(icc)%conc,&
7822	aerosol_mass(icc)%tconc_m, ib, ic, aerosol_mass(icc)%init, .TRUE. )
7823	aerosol_mass(icc)%sums_ws_l = sums_salsa_ws_l
7824
7825	ENDDO ! ic
7826	ENDDO ! ib
7827	!
7828	!-- Gases
7829	IF ( .NOT. salsa_gases_from_chem ) THEN
7830
7831	DO ig = 1, ngases_salsa
7832	sums_salsa_ws_l = salsa_gas(ig)%sums_ws_l
7833	CALL salsa_tendency( 'salsa_gas', salsa_gas(ig)%conc_p, salsa_gas(ig)%conc, &
7834	salsa_gas(ig)%tconc_m, ig, ig, salsa_gas(ig)%init, .FALSE. )
7835	salsa_gas(ig)%sums_ws_l = sums_salsa_ws_l
7836
7837	ENDDO ! ig
7838
7839	ENDIF
7840
7841	ENDIF
7842
7843	END SUBROUTINE salsa_prognostic_equations
7844	!
7845	!------------------------------------------------------------------------------!
7846	! Description:
7847	! ------------
7848	!> Tendencies for aerosol number and mass and gas concentrations.
7849	!> Cache-optimized.
7850	!------------------------------------------------------------------------------!
7851	SUBROUTINE salsa_tendency_ij( id, rs_p, rs, trs_m, i, j, i_omp_start, tn, ib, ic, flux_s, diss_s, &
7852	flux_l, diss_l, rs_init, do_sedimentation )
7853
7854	USE advec_ws, &
7855	ONLY: advec_s_ws
7856
7857	USE advec_s_pw_mod, &
7858	ONLY: advec_s_pw
7859
7860	USE advec_s_up_mod, &
7861	ONLY: advec_s_up
7862
7863	USE arrays_3d, &
7864	ONLY: ddzu, rdf_sc, tend
7865
7866	USE diffusion_s_mod, &
7867	ONLY: diffusion_s
7868
7869	USE indices, &
7870	ONLY: wall_flags_total_0
7871
7872	USE surface_mod, &
7873	ONLY : surf_def_h, surf_def_v, surf_lsm_h, surf_lsm_v, surf_usm_h, surf_usm_v
7874
7875	IMPLICIT NONE
7876
7877	CHARACTER(LEN = *) :: id !<
7878
7879	INTEGER(iwp) :: i !<
7880	INTEGER(iwp) :: i_omp_start !<
7881	INTEGER(iwp) :: ib !< loop index for aerosol number bin OR gas index
7882	INTEGER(iwp) :: ic !< loop index for aerosol mass bin
7883	INTEGER(iwp) :: icc !< (c-1)*nbins_aerosol+b
7884	INTEGER(iwp) :: j !<
7885	INTEGER(iwp) :: k !<
7886	INTEGER(iwp) :: tn !<
7887
7888	LOGICAL :: do_sedimentation !<
7889
7890	REAL(wp), DIMENSION(nzb:nzt+1) :: rs_init !<
7891
7892	REAL(wp), DIMENSION(nzb+1:nzt,0:threads_per_task-1) :: diss_s !<
7893	REAL(wp), DIMENSION(nzb+1:nzt,0:threads_per_task-1) :: flux_s !<
7894
7895	REAL(wp), DIMENSION(nzb+1:nzt,nys:nyn,0:threads_per_task-1) :: diss_l !<
7896	REAL(wp), DIMENSION(nzb+1:nzt,nys:nyn,0:threads_per_task-1) :: flux_l !<
7897
7898	REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) :: rs_p !<
7899	REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) :: rs !<
7900	REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) :: trs_m !<
7901
7902	icc = ( ic - 1 ) * nbins_aerosol + ib
7903	!
7904	!-- Tendency-terms for reactive scalar
7905	tend(:,j,i) = 0.0_wp
7906	!
7907	!-- Advection terms
7908	IF ( timestep_scheme(1:5) == 'runge' ) THEN
7909	IF ( ws_scheme_sca ) THEN
7910	CALL advec_s_ws( salsa_advc_flags_s, i, j, rs, id, flux_s, diss_s, flux_l, diss_l, &
7911	i_omp_start, tn, bc_dirichlet_l .OR. bc_radiation_l, &
7912	bc_dirichlet_n .OR. bc_radiation_n, &
7913	bc_dirichlet_r .OR. bc_radiation_r, &
7914	bc_dirichlet_s .OR. bc_radiation_s, monotonic_limiter_z )
7915	ELSE
7916	CALL advec_s_pw( i, j, rs )
7917	ENDIF
7918	ELSE
7919	CALL advec_s_up( i, j, rs )
7920	ENDIF
7921	!
7922	!-- Diffusion terms
7923	SELECT CASE ( id )
7924	CASE ( 'aerosol_number' )
7925	CALL diffusion_s( i, j, rs, surf_def_h(0)%answs(:,ib), &
7926	surf_def_h(1)%answs(:,ib), surf_def_h(2)%answs(:,ib), &
7927	surf_lsm_h%answs(:,ib), surf_usm_h%answs(:,ib), &
7928	surf_def_v(0)%answs(:,ib), surf_def_v(1)%answs(:,ib), &
7929	surf_def_v(2)%answs(:,ib), surf_def_v(3)%answs(:,ib), &
7930	surf_lsm_v(0)%answs(:,ib), surf_lsm_v(1)%answs(:,ib), &
7931	surf_lsm_v(2)%answs(:,ib), surf_lsm_v(3)%answs(:,ib), &
7932	surf_usm_v(0)%answs(:,ib), surf_usm_v(1)%answs(:,ib), &
7933	surf_usm_v(2)%answs(:,ib), surf_usm_v(3)%answs(:,ib) )
7934	CASE ( 'aerosol_mass' )
7935	CALL diffusion_s( i, j, rs, surf_def_h(0)%amsws(:,icc), &
7936	surf_def_h(1)%amsws(:,icc), surf_def_h(2)%amsws(:,icc), &
7937	surf_lsm_h%amsws(:,icc), surf_usm_h%amsws(:,icc), &
7938	surf_def_v(0)%amsws(:,icc), surf_def_v(1)%amsws(:,icc), &
7939	surf_def_v(2)%amsws(:,icc), surf_def_v(3)%amsws(:,icc), &
7940	surf_lsm_v(0)%amsws(:,icc), surf_lsm_v(1)%amsws(:,icc), &
7941	surf_lsm_v(2)%amsws(:,icc), surf_lsm_v(3)%amsws(:,icc), &
7942	surf_usm_v(0)%amsws(:,icc), surf_usm_v(1)%amsws(:,icc), &
7943	surf_usm_v(2)%amsws(:,icc), surf_usm_v(3)%amsws(:,icc) )
7944	CASE ( 'salsa_gas' )
7945	CALL diffusion_s( i, j, rs, surf_def_h(0)%gtsws(:,ib), &
7946	surf_def_h(1)%gtsws(:,ib), surf_def_h(2)%gtsws(:,ib), &
7947	surf_lsm_h%gtsws(:,ib), surf_usm_h%gtsws(:,ib), &
7948	surf_def_v(0)%gtsws(:,ib), surf_def_v(1)%gtsws(:,ib), &
7949	surf_def_v(2)%gtsws(:,ib), surf_def_v(3)%gtsws(:,ib), &
7950	surf_lsm_v(0)%gtsws(:,ib), surf_lsm_v(1)%gtsws(:,ib), &
7951	surf_lsm_v(2)%gtsws(:,ib), surf_lsm_v(3)%gtsws(:,ib), &
7952	surf_usm_v(0)%gtsws(:,ib), surf_usm_v(1)%gtsws(:,ib), &
7953	surf_usm_v(2)%gtsws(:,ib), surf_usm_v(3)%gtsws(:,ib) )
7954	END SELECT
7955	!
7956	!-- Sedimentation and prognostic equation for aerosol number and mass
7957	IF ( lsdepo .AND. do_sedimentation ) THEN
7958	!DIR$ IVDEP
7959	DO k = nzb+1, nzt
7960	tend(k,j,i) = tend(k,j,i) - MAX( 0.0_wp, ( rs(k+1,j,i) * sedim_vd(k+1,j,i,ib) - &
7961	rs(k,j,i) * sedim_vd(k,j,i,ib) ) * ddzu(k) ) &
7962	* MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k-1,j,i), 0 ) )
7963	rs_p(k,j,i) = rs(k,j,i) + ( dt_3d * ( tsc(2) * tend(k,j,i) + tsc(3) * trs_m(k,j,i) ) &
7964	- tsc(5) * rdf_sc(k) * ( rs(k,j,i) - rs_init(k) ) ) &
7965	* MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) )
7966	IF ( rs_p(k,j,i) < 0.0_wp ) rs_p(k,j,i) = 0.1_wp * rs(k,j,i)
7967	ENDDO
7968	ELSE
7969	!
7970	!-- Prognostic equation
7971	!DIR$ IVDEP
7972	DO k = nzb+1, nzt
7973	rs_p(k,j,i) = rs(k,j,i) + ( dt_3d * ( tsc(2) * tend(k,j,i) + tsc(3) * trs_m(k,j,i) ) &
7974	- tsc(5) * rdf_sc(k) * ( rs(k,j,i) - rs_init(k) ) )&
7975	* MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) )
7976	IF ( rs_p(k,j,i) < 0.0_wp ) rs_p(k,j,i) = 0.1_wp * rs(k,j,i)
7977	ENDDO
7978	ENDIF
7979	!
7980	!-- Calculate tendencies for the next Runge-Kutta step
7981	IF ( timestep_scheme(1:5) == 'runge' ) THEN
7982	IF ( intermediate_timestep_count == 1 ) THEN
7983	DO k = nzb+1, nzt
7984	trs_m(k,j,i) = tend(k,j,i)
7985	ENDDO
7986	ELSEIF ( intermediate_timestep_count < intermediate_timestep_count_max ) THEN
7987	DO k = nzb+1, nzt
7988	trs_m(k,j,i) = -9.5625_wp * tend(k,j,i) + 5.3125_wp * trs_m(k,j,i)
7989	ENDDO
7990	ENDIF
7991	ENDIF
7992
7993	END SUBROUTINE salsa_tendency_ij
7994	!
7995	!------------------------------------------------------------------------------!
7996	! Description:
7997	! ------------
7998	!> Calculate the tendencies for aerosol number and mass concentrations.
7999	!> For vector machines.
8000	!------------------------------------------------------------------------------!
8001	SUBROUTINE salsa_tendency( id, rs_p, rs, trs_m, ib, ic, rs_init, do_sedimentation )
8002
8003	USE advec_ws, &
8004	ONLY: advec_s_ws
8005	USE advec_s_pw_mod, &
8006	ONLY: advec_s_pw
8007	USE advec_s_up_mod, &
8008	ONLY: advec_s_up
8009	USE arrays_3d, &
8010	ONLY: ddzu, rdf_sc, tend
8011	USE diffusion_s_mod, &
8012	ONLY: diffusion_s
8013	USE indices, &
8014	ONLY: wall_flags_total_0
8015	USE surface_mod, &
8016	ONLY : surf_def_h, surf_def_v, surf_lsm_h, surf_lsm_v, surf_usm_h, surf_usm_v
8017
8018	IMPLICIT NONE
8019
8020	CHARACTER(LEN = *) :: id
8021
8022	INTEGER(iwp) :: ib !< loop index for aerosol number bin OR gas index
8023	INTEGER(iwp) :: ic !< loop index for aerosol mass bin
8024	INTEGER(iwp) :: icc !< (c-1)*nbins_aerosol+b
8025	INTEGER(iwp) :: i !<
8026	INTEGER(iwp) :: j !<
8027	INTEGER(iwp) :: k !<
8028
8029	LOGICAL :: do_sedimentation !<
8030
8031	REAL(wp), DIMENSION(nzb:nzt+1) :: rs_init !<
8032
8033	REAL(wp), DIMENSION(:,:,:), POINTER :: rs_p !<
8034	REAL(wp), DIMENSION(:,:,:), POINTER :: rs !<
8035	REAL(wp), DIMENSION(:,:,:), POINTER :: trs_m !<
8036
8037	icc = ( ic - 1 ) * nbins_aerosol + ib
8038	!
8039	!-- Tendency-terms for reactive scalar
8040	tend = 0.0_wp
8041	!
8042	!-- Advection terms
8043	IF ( timestep_scheme(1:5) == 'runge' ) THEN
8044	IF ( ws_scheme_sca ) THEN
8045	CALL advec_s_ws( salsa_advc_flags_s, rs, id, bc_dirichlet_l .OR. bc_radiation_l, &
8046	bc_dirichlet_n .OR. bc_radiation_n, &
8047	bc_dirichlet_r .OR. bc_radiation_r, &
8048	bc_dirichlet_s .OR. bc_radiation_s )
8049	ELSE
8050	CALL advec_s_pw( rs )
8051	ENDIF
8052	ELSE
8053	CALL advec_s_up( rs )
8054	ENDIF
8055	!
8056	!-- Diffusion terms
8057	SELECT CASE ( id )
8058	CASE ( 'aerosol_number' )
8059	CALL diffusion_s( rs, surf_def_h(0)%answs(:,ib), &
8060	surf_def_h(1)%answs(:,ib), surf_def_h(2)%answs(:,ib), &
8061	surf_lsm_h%answs(:,ib), surf_usm_h%answs(:,ib), &
8062	surf_def_v(0)%answs(:,ib), surf_def_v(1)%answs(:,ib), &
8063	surf_def_v(2)%answs(:,ib), surf_def_v(3)%answs(:,ib), &
8064	surf_lsm_v(0)%answs(:,ib), surf_lsm_v(1)%answs(:,ib), &
8065	surf_lsm_v(2)%answs(:,ib), surf_lsm_v(3)%answs(:,ib), &
8066	surf_usm_v(0)%answs(:,ib), surf_usm_v(1)%answs(:,ib), &
8067	surf_usm_v(2)%answs(:,ib), surf_usm_v(3)%answs(:,ib) )
8068	CASE ( 'aerosol_mass' )
8069	CALL diffusion_s( rs, surf_def_h(0)%amsws(:,icc), &
8070	surf_def_h(1)%amsws(:,icc), surf_def_h(2)%amsws(:,icc), &
8071	surf_lsm_h%amsws(:,icc), surf_usm_h%amsws(:,icc), &
8072	surf_def_v(0)%amsws(:,icc), surf_def_v(1)%amsws(:,icc), &
8073	surf_def_v(2)%amsws(:,icc), surf_def_v(3)%amsws(:,icc), &
8074	surf_lsm_v(0)%amsws(:,icc), surf_lsm_v(1)%amsws(:,icc), &
8075	surf_lsm_v(2)%amsws(:,icc), surf_lsm_v(3)%amsws(:,icc), &
8076	surf_usm_v(0)%amsws(:,icc), surf_usm_v(1)%amsws(:,icc), &
8077	surf_usm_v(2)%amsws(:,icc), surf_usm_v(3)%amsws(:,icc) )
8078	CASE ( 'salsa_gas' )
8079	CALL diffusion_s( rs, surf_def_h(0)%gtsws(:,ib), &
8080	surf_def_h(1)%gtsws(:,ib), surf_def_h(2)%gtsws(:,ib), &
8081	surf_lsm_h%gtsws(:,ib), surf_usm_h%gtsws(:,ib), &
8082	surf_def_v(0)%gtsws(:,ib), surf_def_v(1)%gtsws(:,ib), &
8083	surf_def_v(2)%gtsws(:,ib), surf_def_v(3)%gtsws(:,ib), &
8084	surf_lsm_v(0)%gtsws(:,ib), surf_lsm_v(1)%gtsws(:,ib), &
8085	surf_lsm_v(2)%gtsws(:,ib), surf_lsm_v(3)%gtsws(:,ib), &
8086	surf_usm_v(0)%gtsws(:,ib), surf_usm_v(1)%gtsws(:,ib), &
8087	surf_usm_v(2)%gtsws(:,ib), surf_usm_v(3)%gtsws(:,ib) )
8088	END SELECT
8089	!
8090	!-- Prognostic equation for a scalar
8091	DO i = nxl, nxr
8092	DO j = nys, nyn
8093	!
8094	!-- Sedimentation for aerosol number and mass
8095	IF ( lsdepo .AND. do_sedimentation ) THEN
8096	tend(nzb+1:nzt,j,i) = tend(nzb+1:nzt,j,i) - MAX( 0.0_wp, ( rs(nzb+2:nzt+1,j,i) * &
8097	sedim_vd(nzb+2:nzt+1,j,i,ib) - rs(nzb+1:nzt,j,i) * &
8098	sedim_vd(nzb+1:nzt,j,i,ib) ) * ddzu(nzb+1:nzt) ) * &
8099	MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(nzb:nzt-1,j,i), 0 ) )
8100	ENDIF
8101	DO k = nzb+1, nzt
8102	rs_p(k,j,i) = rs(k,j,i) + ( dt_3d * ( tsc(2) * tend(k,j,i) + tsc(3) * trs_m(k,j,i) )&
8103	- tsc(5) * rdf_sc(k) * ( rs(k,j,i) - rs_init(k) )&
8104	) * MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) )
8105	IF ( rs_p(k,j,i) < 0.0_wp ) rs_p(k,j,i) = 0.1_wp * rs(k,j,i)
8106	ENDDO
8107	ENDDO
8108	ENDDO
8109	!
8110	!-- Calculate tendencies for the next Runge-Kutta step
8111	IF ( timestep_scheme(1:5) == 'runge' ) THEN
8112	IF ( intermediate_timestep_count == 1 ) THEN
8113	DO i = nxl, nxr
8114	DO j = nys, nyn
8115	DO k = nzb+1, nzt
8116	trs_m(k,j,i) = tend(k,j,i)
8117	ENDDO
8118	ENDDO
8119	ENDDO
8120	ELSEIF ( intermediate_timestep_count < intermediate_timestep_count_max ) THEN
8121	DO i = nxl, nxr
8122	DO j = nys, nyn
8123	DO k = nzb+1, nzt
8124	trs_m(k,j,i) = -9.5625_wp * tend(k,j,i) + 5.3125_wp * trs_m(k,j,i)
8125	ENDDO
8126	ENDDO
8127	ENDDO
8128	ENDIF
8129	ENDIF
8130
8131	END SUBROUTINE salsa_tendency
8132
8133
8134	!------------------------------------------------------------------------------!
8135	! Description:
8136	! ------------
8137	!> Boundary conditions for prognostic variables in SALSA from module interface
8138	!------------------------------------------------------------------------------!
8139	SUBROUTINE salsa_boundary_conditions
8140
8141	IMPLICIT NONE
8142
8143	INTEGER(iwp) :: ib !< index for aerosol size bins
8144	INTEGER(iwp) :: ic !< index for aerosol mass bins
8145	INTEGER(iwp) :: icc !< additional index for aerosol mass bins
8146	INTEGER(iwp) :: ig !< index for salsa gases
8147
8148
8149	!
8150	!-- moved from boundary_conds
8151	CALL salsa_boundary_conds
8152	!
8153	!-- Boundary conditions for prognostic quantitites of other modules:
8154	!-- Here, only decycling is carried out
8155	IF ( time_since_reference_point >= skip_time_do_salsa ) THEN
8156
8157	DO ib = 1, nbins_aerosol
8158	CALL salsa_boundary_conds( aerosol_number(ib)%conc_p, aerosol_number(ib)%init )
8159	DO ic = 1, ncomponents_mass
8160	icc = ( ic - 1 ) * nbins_aerosol + ib
8161	CALL salsa_boundary_conds( aerosol_mass(icc)%conc_p, aerosol_mass(icc)%init )
8162	ENDDO
8163	ENDDO
8164	IF ( .NOT. salsa_gases_from_chem ) THEN
8165	DO ig = 1, ngases_salsa
8166	CALL salsa_boundary_conds( salsa_gas(ig)%conc_p, salsa_gas(ig)%init )
8167	ENDDO
8168	ENDIF
8169
8170	ENDIF
8171
8172	END SUBROUTINE salsa_boundary_conditions
8173
8174	!------------------------------------------------------------------------------!
8175	! Description:
8176	! ------------
8177	!> Boundary conditions for prognostic variables in SALSA
8178	!------------------------------------------------------------------------------!
8179	SUBROUTINE salsa_boundary_conds
8180
8181	USE arrays_3d, &
8182	ONLY: dzu
8183
8184	USE surface_mod, &
8185	ONLY : bc_h
8186
8187	IMPLICIT NONE
8188
8189	INTEGER(iwp) :: i !< grid index x direction
8190	INTEGER(iwp) :: ib !< index for aerosol size bins
8191	INTEGER(iwp) :: ic !< index for chemical compounds in aerosols
8192	INTEGER(iwp) :: icc !< additional index for chemical compounds in aerosols
8193	INTEGER(iwp) :: ig !< idex for gaseous compounds
8194	INTEGER(iwp) :: j !< grid index y direction
8195	INTEGER(iwp) :: k !< grid index y direction
8196	INTEGER(iwp) :: l !< running index boundary type, for up- and downward-facing walls
8197	INTEGER(iwp) :: m !< running index surface elements
8198
8199	IF ( time_since_reference_point >= skip_time_do_salsa ) THEN
8200	!
8201	!-- Surface conditions:
8202	IF ( ibc_salsa_b == 0 ) THEN ! Dirichlet
8203	!
8204	!-- Run loop over all non-natural and natural walls. Note, in wall-datatype the k coordinate
8205	!-- belongs to the atmospheric grid point, therefore, set s_p at k-1
8206	DO l = 0, 1
8207	!$OMP PARALLEL PRIVATE( ib, ic, icc, ig, i, j, k )
8208	!$OMP DO
8209	DO m = 1, bc_h(l)%ns
8210
8211	i = bc_h(l)%i(m)
8212	j = bc_h(l)%j(m)
8213	k = bc_h(l)%k(m)
8214
8215	DO ib = 1, nbins_aerosol
8216	aerosol_number(ib)%conc_p(k+bc_h(l)%koff,j,i) = &
8217	aerosol_number(ib)%conc(k+bc_h(l)%koff,j,i)
8218	DO ic = 1, ncomponents_mass
8219	icc = ( ic - 1 ) * nbins_aerosol + ib
8220	aerosol_mass(icc)%conc_p(k+bc_h(l)%koff,j,i) = &
8221	aerosol_mass(icc)%conc(k+bc_h(l)%koff,j,i)
8222	ENDDO
8223	ENDDO
8224	IF ( .NOT. salsa_gases_from_chem ) THEN
8225	DO ig = 1, ngases_salsa
8226	salsa_gas(ig)%conc_p(k+bc_h(l)%koff,j,i) = &
8227	salsa_gas(ig)%conc(k+bc_h(l)%koff,j,i)
8228	ENDDO
8229	ENDIF
8230
8231	ENDDO
8232	!$OMP END PARALLEL
8233
8234	ENDDO
8235
8236	ELSE ! Neumann
8237
8238	DO l = 0, 1
8239	!$OMP PARALLEL PRIVATE( ib, ic, icc, ig, i, j, k )
8240	!$OMP DO
8241	DO m = 1, bc_h(l)%ns
8242
8243	i = bc_h(l)%i(m)
8244	j = bc_h(l)%j(m)
8245	k = bc_h(l)%k(m)
8246
8247	DO ib = 1, nbins_aerosol
8248	aerosol_number(ib)%conc_p(k+bc_h(l)%koff,j,i) = &
8249	aerosol_number(ib)%conc_p(k,j,i)
8250	DO ic = 1, ncomponents_mass
8251	icc = ( ic - 1 ) * nbins_aerosol + ib
8252	aerosol_mass(icc)%conc_p(k+bc_h(l)%koff,j,i) = &
8253	aerosol_mass(icc)%conc_p(k,j,i)
8254	ENDDO
8255	ENDDO
8256	IF ( .NOT. salsa_gases_from_chem ) THEN
8257	DO ig = 1, ngases_salsa
8258	salsa_gas(ig)%conc_p(k+bc_h(l)%koff,j,i) = &
8259	salsa_gas(ig)%conc_p(k,j,i)
8260	ENDDO
8261	ENDIF
8262
8263	ENDDO
8264	!$OMP END PARALLEL
8265	ENDDO
8266
8267	ENDIF
8268	!
8269	!-- Top boundary conditions:
8270	IF ( ibc_salsa_t == 0 ) THEN ! Dirichlet
8271
8272	DO ib = 1, nbins_aerosol
8273	aerosol_number(ib)%conc_p(nzt+1,:,:) = aerosol_number(ib)%conc(nzt+1,:,:)
8274	DO ic = 1, ncomponents_mass
8275	icc = ( ic - 1 ) * nbins_aerosol + ib
8276	aerosol_mass(icc)%conc_p(nzt+1,:,:) = aerosol_mass(icc)%conc(nzt+1,:,:)
8277	ENDDO
8278	ENDDO
8279	IF ( .NOT. salsa_gases_from_chem ) THEN
8280	DO ig = 1, ngases_salsa
8281	salsa_gas(ig)%conc_p(nzt+1,:,:) = salsa_gas(ig)%conc(nzt+1,:,:)
8282	ENDDO
8283	ENDIF
8284
8285	ELSEIF ( ibc_salsa_t == 1 ) THEN ! Neumann
8286
8287	DO ib = 1, nbins_aerosol
8288	aerosol_number(ib)%conc_p(nzt+1,:,:) = aerosol_number(ib)%conc_p(nzt,:,:)
8289	DO ic = 1, ncomponents_mass
8290	icc = ( ic - 1 ) * nbins_aerosol + ib
8291	aerosol_mass(icc)%conc_p(nzt+1,:,:) = aerosol_mass(icc)%conc_p(nzt,:,:)
8292	ENDDO
8293	ENDDO
8294	IF ( .NOT. salsa_gases_from_chem ) THEN
8295	DO ig = 1, ngases_salsa
8296	salsa_gas(ig)%conc_p(nzt+1,:,:) = salsa_gas(ig)%conc_p(nzt,:,:)
8297	ENDDO
8298	ENDIF
8299
8300	ELSEIF ( ibc_salsa_t == 2 ) THEN ! Initial gradient
8301
8302	DO ib = 1, nbins_aerosol
8303	aerosol_number(ib)%conc_p(nzt+1,:,:) = aerosol_number(ib)%conc_p(nzt,:,:) + &
8304	bc_an_t_val(ib) * dzu(nzt+1)
8305	DO ic = 1, ncomponents_mass
8306	icc = ( ic - 1 ) * nbins_aerosol + ib
8307	aerosol_mass(icc)%conc_p(nzt+1,:,:) = aerosol_mass(icc)%conc_p(nzt,:,:) + &
8308	bc_am_t_val(icc) * dzu(nzt+1)
8309	ENDDO
8310	ENDDO
8311	IF ( .NOT. salsa_gases_from_chem ) THEN
8312	DO ig = 1, ngases_salsa
8313	salsa_gas(ig)%conc_p(nzt+1,:,:) = salsa_gas(ig)%conc_p(nzt,:,:) + &
8314	bc_gt_t_val(ig) * dzu(nzt+1)
8315	ENDDO
8316	ENDIF
8317
8318	ENDIF
8319	!
8320	!-- Lateral boundary conditions at the outflow
8321	IF ( bc_radiation_s ) THEN
8322	DO ib = 1, nbins_aerosol
8323	aerosol_number(ib)%conc_p(:,nys-1,:) = aerosol_number(ib)%conc_p(:,nys,:)
8324	DO ic = 1, ncomponents_mass
8325	icc = ( ic - 1 ) * nbins_aerosol + ib
8326	aerosol_mass(icc)%conc_p(:,nys-1,:) = aerosol_mass(icc)%conc_p(:,nys,:)
8327	ENDDO
8328	ENDDO
8329	IF ( .NOT. salsa_gases_from_chem ) THEN
8330	DO ig = 1, ngases_salsa
8331	salsa_gas(ig)%conc_p(:,nys-1,:) = salsa_gas(ig)%conc_p(:,nys,:)
8332	ENDDO
8333	ENDIF
8334
8335	ELSEIF ( bc_radiation_n ) THEN
8336	DO ib = 1, nbins_aerosol
8337	aerosol_number(ib)%conc_p(:,nyn+1,:) = aerosol_number(ib)%conc_p(:,nyn,:)
8338	DO ic = 1, ncomponents_mass
8339	icc = ( ic - 1 ) * nbins_aerosol + ib
8340	aerosol_mass(icc)%conc_p(:,nyn+1,:) = aerosol_mass(icc)%conc_p(:,nyn,:)
8341	ENDDO
8342	ENDDO
8343	IF ( .NOT. salsa_gases_from_chem ) THEN
8344	DO ig = 1, ngases_salsa
8345	salsa_gas(ig)%conc_p(:,nyn+1,:) = salsa_gas(ig)%conc_p(:,nyn,:)
8346	ENDDO
8347	ENDIF
8348
8349	ELSEIF ( bc_radiation_l ) THEN
8350	DO ib = 1, nbins_aerosol
8351	aerosol_number(ib)%conc_p(:,:,nxl-1) = aerosol_number(ib)%conc_p(:,:,nxl)
8352	DO ic = 1, ncomponents_mass
8353	icc = ( ic - 1 ) * nbins_aerosol + ib
8354	aerosol_mass(icc)%conc_p(:,:,nxl-1) = aerosol_mass(icc)%conc_p(:,:,nxl)
8355	ENDDO
8356	ENDDO
8357	IF ( .NOT. salsa_gases_from_chem ) THEN
8358	DO ig = 1, ngases_salsa
8359	salsa_gas(ig)%conc_p(:,:,nxl-1) = salsa_gas(ig)%conc_p(:,:,nxl)
8360	ENDDO
8361	ENDIF
8362
8363	ELSEIF ( bc_radiation_r ) THEN
8364	DO ib = 1, nbins_aerosol
8365	aerosol_number(ib)%conc_p(:,:,nxr+1) = aerosol_number(ib)%conc_p(:,:,nxr)
8366	DO ic = 1, ncomponents_mass
8367	icc = ( ic - 1 ) * nbins_aerosol + ib
8368	aerosol_mass(icc)%conc_p(:,:,nxr+1) = aerosol_mass(icc)%conc_p(:,:,nxr)
8369	ENDDO
8370	ENDDO
8371	IF ( .NOT. salsa_gases_from_chem ) THEN
8372	DO ig = 1, ngases_salsa
8373	salsa_gas(ig)%conc_p(:,:,nxr+1) = salsa_gas(ig)%conc_p(:,:,nxr)
8374	ENDDO
8375	ENDIF
8376
8377	ENDIF
8378
8379	ENDIF
8380
8381	END SUBROUTINE salsa_boundary_conds
8382
8383	!------------------------------------------------------------------------------!
8384	! Description:
8385	! ------------
8386	! Undoing of the previously done cyclic boundary conditions.
8387	!------------------------------------------------------------------------------!
8388	SUBROUTINE salsa_boundary_conds_decycle ( sq, sq_init )
8389
8390	USE control_parameters, &
8391	ONLY: nesting_offline
8392
8393	IMPLICIT NONE
8394
8395	INTEGER(iwp) :: boundary !<
8396	INTEGER(iwp) :: ee !<
8397	INTEGER(iwp) :: copied !<
8398	INTEGER(iwp) :: i !<
8399	INTEGER(iwp) :: j !<
8400	INTEGER(iwp) :: k !<
8401	INTEGER(iwp) :: ss !<
8402
8403	REAL(wp) :: flag !< flag to mask topography grid points
8404
8405	REAL(wp), DIMENSION(nzb:nzt+1) :: sq_init !< initial concentration profile
8406
8407	REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) :: sq !< concentration array
8408
8409	flag = 0.0_wp
8410	!
8411	!-- Skip input if forcing from a larger-scale models is applied.
8412	IF ( nesting_offline .AND. nesting_offline_salsa ) RETURN
8413	!
8414	!-- Left and right boundaries
8415	IF ( decycle_salsa_lr .AND. ( bc_lr_cyc .OR. bc_lr == 'nested' ) ) THEN
8416
8417	DO boundary = 1, 2
8418
8419	IF ( decycle_method_salsa(boundary) == 'dirichlet' ) THEN
8420	!
8421	!-- Initial profile is copied to ghost and first three layers
8422	ss = 1
8423	ee = 0
8424	IF ( boundary == 1 .AND. nxl == 0 ) THEN
8425	ss = nxlg
8426	ee = nxl-1
8427	ELSEIF ( boundary == 2 .AND. nxr == nx ) THEN
8428	ss = nxr+1
8429	ee = nxrg
8430	ENDIF
8431
8432	DO i = ss, ee
8433	DO j = nysg, nyng
8434	DO k = nzb+1, nzt
8435	flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) )
8436	sq(k,j,i) = sq_init(k) * flag
8437	ENDDO
8438	ENDDO
8439	ENDDO
8440
8441	ELSEIF ( decycle_method_salsa(boundary) == 'neumann' ) THEN
8442	!
8443	!-- The value at the boundary is copied to the ghost layers to simulate an outlet with
8444	!-- zero gradient
8445	ss = 1
8446	ee = 0
8447	IF ( boundary == 1 .AND. nxl == 0 ) THEN
8448	ss = nxlg
8449	ee = nxl-1
8450	copied = nxl
8451	ELSEIF ( boundary == 2 .AND. nxr == nx ) THEN
8452	ss = nxr+1
8453	ee = nxrg
8454	copied = nxr
8455	ENDIF
8456
8457	DO i = ss, ee
8458	DO j = nysg, nyng
8459	DO k = nzb+1, nzt
8460	flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) )
8461	sq(k,j,i) = sq(k,j,copied) * flag
8462	ENDDO
8463	ENDDO
8464	ENDDO
8465
8466	ELSE
8467	WRITE(message_string,*) 'unknown decycling method: decycle_method_salsa (', boundary, &
8468	') ="' // TRIM( decycle_method_salsa(boundary) ) // '"'
8469	CALL message( 'salsa_boundary_conds_decycle', 'PA0626', 1, 2, 0, 6, 0 )
8470	ENDIF
8471	ENDDO
8472	ENDIF
8473
8474	!
8475	!-- South and north boundaries
8476	IF ( decycle_salsa_ns .AND. ( bc_ns_cyc .OR. bc_ns == 'nested' ) ) THEN
8477
8478	DO boundary = 3, 4
8479
8480	IF ( decycle_method_salsa(boundary) == 'dirichlet' ) THEN
8481	!
8482	!-- Initial profile is copied to ghost and first three layers
8483	ss = 1
8484	ee = 0
8485	IF ( boundary == 3 .AND. nys == 0 ) THEN
8486	ss = nysg
8487	ee = nys-1
8488	ELSEIF ( boundary == 4 .AND. nyn == ny ) THEN
8489	ss = nyn+1
8490	ee = nyng
8491	ENDIF
8492
8493	DO i = nxlg, nxrg
8494	DO j = ss, ee
8495	DO k = nzb+1, nzt
8496	flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) )
8497	sq(k,j,i) = sq_init(k) * flag
8498	ENDDO
8499	ENDDO
8500	ENDDO
8501
8502	ELSEIF ( decycle_method_salsa(boundary) == 'neumann' ) THEN
8503	!
8504	!-- The value at the boundary is copied to the ghost layers to simulate an outlet with
8505	!-- zero gradient
8506	ss = 1
8507	ee = 0
8508	IF ( boundary == 3 .AND. nys == 0 ) THEN
8509	ss = nysg
8510	ee = nys-1
8511	copied = nys
8512	ELSEIF ( boundary == 4 .AND. nyn == ny ) THEN
8513	ss = nyn+1
8514	ee = nyng
8515	copied = nyn
8516	ENDIF
8517
8518	DO i = nxlg, nxrg
8519	DO j = ss, ee
8520	DO k = nzb+1, nzt
8521	flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) )
8522	sq(k,j,i) = sq(k,copied,i) * flag
8523	ENDDO
8524	ENDDO
8525	ENDDO
8526
8527	ELSE
8528	WRITE(message_string,*) 'unknown decycling method: decycle_method_salsa (', boundary, &
8529	') ="' // TRIM( decycle_method_salsa(boundary) ) // '"'
8530	CALL message( 'salsa_boundary_conds_decycle', 'PA0627', 1, 2, 0, 6, 0 )
8531	ENDIF
8532	ENDDO
8533	ENDIF
8534
8535	END SUBROUTINE salsa_boundary_conds_decycle
8536
8537	!------------------------------------------------------------------------------!
8538	! Description:
8539	! ------------
8540	!> Calculates the total dry or wet mass concentration for individual bins
8541	!> Juha Tonttila (FMI) 2015
8542	!> Tomi Raatikainen (FMI) 2016
8543	!------------------------------------------------------------------------------!
8544	SUBROUTINE bin_mixrat( itype, ibin, i, j, mconc )
8545
8546	IMPLICIT NONE
8547
8548	CHARACTER(len=*), INTENT(in) :: itype !< 'dry' or 'wet'
8549
8550	INTEGER(iwp) :: ic !< loop index for mass bin number
8551	INTEGER(iwp) :: iend !< end index: include water or not
8552
8553	INTEGER(iwp), INTENT(in) :: ibin !< index of the chemical component
8554	INTEGER(iwp), INTENT(in) :: i !< loop index for x-direction
8555	INTEGER(iwp), INTENT(in) :: j !< loop index for y-direction
8556
8557	REAL(wp), DIMENSION(:), INTENT(out) :: mconc !< total dry or wet mass concentration
8558
8559	!-- Number of components
8560	IF ( itype == 'dry' ) THEN
8561	iend = prtcl%ncomp - 1
8562	ELSE IF ( itype == 'wet' ) THEN
8563	iend = prtcl%ncomp
8564	ELSE
8565	message_string = 'Error in itype!'
8566	CALL message( 'bin_mixrat', 'PA0628', 2, 2, 0, 6, 0 )
8567	ENDIF
8568
8569	mconc = 0.0_wp
8570
8571	DO ic = ibin, iend*nbins_aerosol+ibin, nbins_aerosol !< every nbins'th element
8572	mconc = mconc + aerosol_mass(ic)%conc(:,j,i)
8573	ENDDO
8574
8575	END SUBROUTINE bin_mixrat
8576
8577	!------------------------------------------------------------------------------!
8578	! Description:
8579	! ------------
8580	!> Sets surface fluxes
8581	!------------------------------------------------------------------------------!
8582	SUBROUTINE salsa_emission_update
8583
8584	IMPLICIT NONE
8585
8586	IF ( include_emission ) THEN
8587
8588	IF ( time_since_reference_point >= skip_time_do_salsa ) THEN
8589
8590	IF ( next_aero_emission_update <= &
8591	MAX( time_since_reference_point, 0.0_wp ) ) THEN
8592	CALL salsa_emission_setup( .FALSE. )
8593	ENDIF
8594
8595	IF ( next_gas_emission_update <= &
8596	MAX( time_since_reference_point, 0.0_wp ) ) THEN
8597	IF ( salsa_emission_mode == 'read_from_file' .AND. .NOT. salsa_gases_from_chem ) &
8598	THEN
8599	CALL salsa_gas_emission_setup( .FALSE. )
8600	ENDIF
8601	ENDIF
8602
8603	ENDIF
8604	ENDIF
8605
8606	END SUBROUTINE salsa_emission_update
8607
8608	!------------------------------------------------------------------------------!
8609	!> Description:
8610	!> ------------
8611	!> Define aerosol fluxes: constant or read from a from file
8612	!> @todo - Emission stack height is not used yet. For default mode, emissions
8613	!> are assumed to occur on upward facing horizontal surfaces.
8614	!------------------------------------------------------------------------------!
8615	SUBROUTINE salsa_emission_setup( init )
8616
8617	USE control_parameters, &
8618	ONLY: end_time, spinup_time
8619
8620	USE netcdf_data_input_mod, &
8621	ONLY: check_existence, close_input_file, get_attribute, get_variable, &
8622	inquire_num_variables, inquire_variable_names, &
8623	get_dimension_length, open_read_file, street_type_f
8624
8625	USE palm_date_time_mod, &
8626	ONLY: days_per_week, get_date_time, hours_per_day, months_per_year, seconds_per_hour
8627
8628	USE surface_mod, &
8629	ONLY: surf_def_h, surf_lsm_h, surf_usm_h
8630
8631	IMPLICIT NONE
8632
8633	CHARACTER(LEN=80) :: daytype = 'workday' !< default day type
8634	CHARACTER(LEN=25) :: in_name !< name of a gas in the input file
8635	CHARACTER(LEN=25) :: mod_name !< name in the input file
8636
8637	INTEGER(iwp) :: day_of_month !< day of the month
8638	INTEGER(iwp) :: day_of_week !< day of the week
8639	INTEGER(iwp) :: day_of_year !< day of the year
8640	INTEGER(iwp) :: hour_of_day !< hour of the day
8641	INTEGER(iwp) :: i !< loop index
8642	INTEGER(iwp) :: ib !< loop index: aerosol number bins
8643	INTEGER(iwp) :: ic !< loop index: aerosol chemical components
8644	INTEGER(iwp) :: id_salsa !< NetCDF id of aerosol emission input file
8645	INTEGER(iwp) :: in !< loop index: emission category
8646	INTEGER(iwp) :: index_dd !< index day
8647	INTEGER(iwp) :: index_hh !< index hour
8648	INTEGER(iwp) :: index_mm !< index month
8649	INTEGER(iwp) :: inn !< loop index
8650	INTEGER(iwp) :: j !< loop index
8651	INTEGER(iwp) :: month_of_year !< month of the year
8652	INTEGER(iwp) :: ss !< loop index
8653
8654	INTEGER(iwp), DIMENSION(maxspec) :: cc_i2m !<
8655
8656	LOGICAL :: netcdf_extend = .FALSE. !< NetCDF input file exists
8657
8658	LOGICAL, INTENT(in) :: init !< if .TRUE. --> initialisation call
8659
8660	REAL(wp) :: second_of_day !< second of the day
8661
8662	REAL(wp), DIMENSION(24) :: par_emis_time_factor = & !< time factors for the parameterized mode
8663	(/ 0.009, 0.004, 0.004, 0.009, 0.029, 0.039, &
8664	0.056, 0.053, 0.051, 0.051, 0.052, 0.055, &
8665	0.059, 0.061, 0.064, 0.067, 0.069, 0.069, &
8666	0.049, 0.039, 0.039, 0.029, 0.024, 0.019 /)
8667
8668	REAL(wp), DIMENSION(:), ALLOCATABLE :: nsect_emission !< sectional number emission
8669
8670	REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: source_array !< temporary source array
8671
8672	!
8673	!-- Define emissions:
8674	SELECT CASE ( salsa_emission_mode )
8675
8676	CASE ( 'uniform', 'parameterized' )
8677
8678	IF ( init ) THEN ! Do only once
8679	!
8680	!- Form a sectional size distribution for the emissions
8681	ALLOCATE( nsect_emission(1:nbins_aerosol), &
8682	source_array(nys:nyn,nxl:nxr,1:nbins_aerosol) )
8683	!
8684	!-- Precalculate a size distribution for the emission based on the mean diameter, standard
8685	!-- deviation and number concentration per each log-normal mode
8686	CALL size_distribution( surface_aerosol_flux, aerosol_flux_dpg, aerosol_flux_sigmag, &
8687	nsect_emission )
8688	IF ( salsa_emission_mode == 'uniform' ) THEN
8689	DO ib = 1, nbins_aerosol
8690	source_array(:,:,ib) = nsect_emission(ib)
8691	ENDDO
8692	ELSE
8693	!
8694	!-- Get a time factor for the specific hour
8695	IF ( .NOT. ALLOCATED( aero_emission_att%time_factor ) ) &
8696	ALLOCATE( aero_emission_att%time_factor(1) )
8697	CALL get_date_time( MAX( time_since_reference_point, 0.0_wp ), hour=hour_of_day )
8698	index_hh = hour_of_day
8699	aero_emission_att%time_factor(1) = par_emis_time_factor(index_hh+1)
8700
8701	IF ( street_type_f%from_file ) THEN
8702	DO i = nxl, nxr
8703	DO j = nys, nyn
8704	IF ( street_type_f%var(j,i) >= main_street_id .AND. &
8705	street_type_f%var(j,i) < max_street_id ) THEN
8706	source_array(j,i,:) = nsect_emission(:) * emiss_factor_main * &
8707	aero_emission_att%time_factor(1)
8708	ELSEIF ( street_type_f%var(j,i) >= side_street_id .AND. &
8709	street_type_f%var(j,i) < main_street_id ) THEN
8710	source_array(j,i,:) = nsect_emission(:) * emiss_factor_side * &
8711	aero_emission_att%time_factor(1)
8712	ENDIF
8713	ENDDO
8714	ENDDO
8715	ELSE
8716	WRITE( message_string, * ) 'salsa_emission_mode = "parameterized" but the '// &
8717	'street_type data is missing.'
8718	CALL message( 'salsa_emission_setup', 'PA0695', 1, 2, 0, 6, 0 )
8719	ENDIF
8720	ENDIF
8721	!
8722	!-- Check which chemical components are used
8723	cc_i2m = 0
8724	IF ( index_so4 > 0 ) cc_i2m(1) = index_so4
8725	IF ( index_oc > 0 ) cc_i2m(2) = index_oc
8726	IF ( index_bc > 0 ) cc_i2m(3) = index_bc
8727	IF ( index_du > 0 ) cc_i2m(4) = index_du
8728	IF ( index_ss > 0 ) cc_i2m(5) = index_ss
8729	IF ( index_no > 0 ) cc_i2m(6) = index_no
8730	IF ( index_nh > 0 ) cc_i2m(7) = index_nh
8731	!
8732	!-- Normalise mass fractions so that their sum is 1
8733	aerosol_flux_mass_fracs_a = aerosol_flux_mass_fracs_a / &
8734	SUM( aerosol_flux_mass_fracs_a(1:ncc ) )
8735	IF ( salsa_emission_mode == 'uniform' ) THEN
8736	!
8737	!-- Set uniform fluxes of default horizontal surfaces
8738	CALL set_flux( surf_def_h(0), cc_i2m, aerosol_flux_mass_fracs_a, source_array )
8739	ELSE
8740	!
8741	!-- Set fluxes normalised based on the street type on land surfaces
8742	CALL set_flux( surf_lsm_h, cc_i2m, aerosol_flux_mass_fracs_a, source_array )
8743	ENDIF
8744
8745	DEALLOCATE( nsect_emission, source_array )
8746	ENDIF
8747
8748	CASE ( 'read_from_file' )
8749	!
8750	!-- Reset surface fluxes
8751	surf_def_h(0)%answs = 0.0_wp
8752	surf_def_h(0)%amsws = 0.0_wp
8753	surf_lsm_h%answs = 0.0_wp
8754	surf_lsm_h%amsws = 0.0_wp
8755	surf_usm_h%answs = 0.0_wp
8756	surf_usm_h%amsws = 0.0_wp
8757
8758	!
8759	!-- Reset source arrays:
8760	DO ib = 1, nbins_aerosol
8761	aerosol_number(ib)%source = 0.0_wp
8762	ENDDO
8763
8764	DO ic = 1, ncomponents_mass * nbins_aerosol
8765	aerosol_mass(ic)%source = 0.0_wp
8766	ENDDO
8767
8768	#if defined( __netcdf )
8769	!
8770	!-- Check existence of PIDS_SALSA file
8771	INQUIRE( FILE = TRIM( input_file_salsa ) // TRIM( coupling_char ), EXIST = netcdf_extend )
8772	IF ( .NOT. netcdf_extend ) THEN
8773	message_string = 'Input file '// TRIM( input_file_salsa ) // TRIM( coupling_char )&
8774	// ' missing!'
8775	CALL message( 'salsa_emission_setup', 'PA0629', 1, 2, 0, 6, 0 )
8776	ENDIF
8777	!
8778	!-- Open file in read-only mode
8779	CALL open_read_file( TRIM( input_file_salsa ) // TRIM( coupling_char ), id_salsa )
8780
8781	IF ( init ) THEN
8782	!
8783	!-- Variable names
8784	CALL inquire_num_variables( id_salsa, aero_emission_att%num_vars )
8785	ALLOCATE( aero_emission_att%var_names(1:aero_emission_att%num_vars) )
8786	CALL inquire_variable_names( id_salsa, aero_emission_att%var_names )
8787	!
8788	!-- Read the index and name of chemical components
8789	CALL get_dimension_length( id_salsa, aero_emission_att%ncc, 'composition_index' )
8790	ALLOCATE( aero_emission_att%cc_index(1:aero_emission_att%ncc) )
8791	CALL get_variable( id_salsa, 'composition_index', aero_emission_att%cc_index )
8792
8793	IF ( check_existence( aero_emission_att%var_names, 'composition_name' ) ) THEN
8794	CALL get_variable( id_salsa, 'composition_name', aero_emission_att%cc_name, &
8795	aero_emission_att%ncc )
8796	ELSE
8797	message_string = 'Missing composition_name in ' // TRIM( input_file_salsa )
8798	CALL message( 'salsa_emission_setup', 'PA0657', 1, 2, 0, 6, 0 )
8799	ENDIF
8800	!
8801	!-- Find the corresponding chemical components in the model
8802	aero_emission_att%cc_in2mod = 0
8803	DO ic = 1, aero_emission_att%ncc
8804	in_name = aero_emission_att%cc_name(ic)
8805	SELECT CASE ( TRIM( in_name ) )
8806	CASE ( 'H2SO4', 'h2so4', 'SO4', 'so4' )
8807	aero_emission_att%cc_in2mod(1) = ic
8808	CASE ( 'OC', 'oc', 'organics' )
8809	aero_emission_att%cc_in2mod(2) = ic
8810	CASE ( 'BC', 'bc' )
8811	aero_emission_att%cc_in2mod(3) = ic
8812	CASE ( 'DU', 'du' )
8813	aero_emission_att%cc_in2mod(4) = ic
8814	CASE ( 'SS', 'ss' )
8815	aero_emission_att%cc_in2mod(5) = ic
8816	CASE ( 'HNO3', 'hno3', 'NO', 'no', 'NO3', 'no3' )
8817	aero_emission_att%cc_in2mod(6) = ic
8818	CASE ( 'NH3', 'nh3', 'NH', 'nh', 'NH4', 'nh4' )
8819	aero_emission_att%cc_in2mod(7) = ic
8820	END SELECT
8821
8822	ENDDO
8823
8824	IF ( SUM( aero_emission_att%cc_in2mod ) == 0 ) THEN
8825	message_string = 'None of the aerosol chemical components in ' // TRIM( &
8826	input_file_salsa ) // ' correspond to the ones applied in SALSA.'
8827	CALL message( 'salsa_emission_setup', 'PA0630', 1, 2, 0, 6, 0 )
8828	ENDIF
8829	!
8830	!-- Get number of emission categories
8831	CALL get_dimension_length( id_salsa, aero_emission_att%ncat, 'ncat' )
8832	!
8833	!-- Get the chemical composition (i.e. mass fraction of different species) in aerosols
8834	IF ( check_existence( aero_emission_att%var_names, 'emission_mass_fracs' ) ) THEN
8835	ALLOCATE( aero_emission%mass_fracs(1:aero_emission_att%ncat, &
8836	1:aero_emission_att%ncc) )
8837	CALL get_variable( id_salsa, 'emission_mass_fracs', aero_emission%mass_fracs, &
8838	0, aero_emission_att%ncc-1, 0, aero_emission_att%ncat-1 )
8839	ELSE
8840	message_string = 'Missing emission_mass_fracs in ' // TRIM( input_file_salsa )
8841	CALL message( 'salsa_emission_setup', 'PA0694', 1, 2, 0, 6, 0 )
8842	ENDIF
8843	!
8844	!-- If the chemical component is not activated, set its mass fraction to 0 to avoid
8845	!-- inbalance between number and mass flux
8846	cc_i2m = aero_emission_att%cc_in2mod
8847	IF ( index_so4 < 0 .AND. cc_i2m(1) > 0 ) &
8848	aero_emission%mass_fracs(:,cc_i2m(1)) = 0.0_wp
8849	IF ( index_oc < 0 .AND. cc_i2m(2) > 0 ) &
8850	aero_emission%mass_fracs(:,cc_i2m(2)) = 0.0_wp
8851	IF ( index_bc < 0 .AND. cc_i2m(3) > 0 ) &
8852	aero_emission%mass_fracs(:,cc_i2m(3)) = 0.0_wp
8853	IF ( index_du < 0 .AND. cc_i2m(4) > 0 ) &
8854	aero_emission%mass_fracs(:,cc_i2m(4)) = 0.0_wp
8855	IF ( index_ss < 0 .AND. cc_i2m(5) > 0 ) &
8856	aero_emission%mass_fracs(:,cc_i2m(5)) = 0.0_wp
8857	IF ( index_no < 0 .AND. cc_i2m(6) > 0 ) &
8858	aero_emission%mass_fracs(:,cc_i2m(6)) = 0.0_wp
8859	IF ( index_nh < 0 .AND. cc_i2m(7) > 0 ) &
8860	aero_emission%mass_fracs(:,cc_i2m(7)) = 0.0_wp
8861	!
8862	!-- Then normalise the mass fraction so that SUM = 1
8863	DO in = 1, aero_emission_att%ncat
8864	aero_emission%mass_fracs(in,:) = aero_emission%mass_fracs(in,:) / &
8865	SUM( aero_emission%mass_fracs(in,:) )
8866	ENDDO
8867	!
8868	!-- Inquire the fill value
8869	CALL get_attribute( id_salsa, '_FillValue', aero_emission%fill, .FALSE., &
8870	'aerosol_emission_values' )
8871	!
8872	!-- Inquire units of emissions
8873	CALL get_attribute( id_salsa, 'units', aero_emission_att%units, .FALSE., &
8874	'aerosol_emission_values' )
8875	!
8876	!-- Inquire the level of detail (lod)
8877	CALL get_attribute( id_salsa, 'lod', aero_emission_att%lod, .FALSE., &
8878	'aerosol_emission_values' )
8879
8880	!
8881	!-- Read different emission information depending on the level of detail of emissions:
8882
8883	!
8884	!-- Default mode:
8885	IF ( aero_emission_att%lod == 1 ) THEN
8886	!
8887	!-- Unit conversion factor: convert to SI units (kg/m2/s)
8888	IF ( aero_emission_att%units == 'kg/m2/yr' ) THEN
8889	aero_emission_att%conversion_factor = 1.0_wp / 3600.0_wp
8890	ELSEIF ( aero_emission_att%units == 'g/m2/yr' ) THEN
8891	aero_emission_att%conversion_factor = 0.001_wp / 3600.0_wp
8892	ELSE
8893	message_string = 'unknown unit for aerosol emissions: ' // &
8894	TRIM( aero_emission_att%units ) // ' (lod1)'
8895	CALL message( 'salsa_emission_setup','PA0631', 1, 2, 0, 6, 0 )
8896	ENDIF
8897	!
8898	!-- Allocate emission arrays
8899	ALLOCATE( aero_emission_att%cat_index(1:aero_emission_att%ncat), &
8900	aero_emission_att%rho(1:aero_emission_att%ncat), &
8901	aero_emission_att%time_factor(1:aero_emission_att%ncat) )
8902	!
8903	!-- Get emission category names and indices
8904	IF ( check_existence( aero_emission_att%var_names, 'emission_category_name' ) ) THEN
8905	CALL get_variable( id_salsa, 'emission_category_name', &
8906	aero_emission_att%cat_name, aero_emission_att%ncat )
8907	ELSE
8908	message_string = 'Missing emission_category_name in ' // TRIM( input_file_salsa )
8909	CALL message( 'salsa_emission_setup', 'PA0658', 1, 2, 0, 6, 0 )
8910	ENDIF
8911	CALL get_variable( id_salsa, 'emission_category_index', aero_emission_att%cat_index )
8912	!
8913	!-- Find corresponding emission categories
8914	DO in = 1, aero_emission_att%ncat
8915	in_name = aero_emission_att%cat_name(in)
8916	DO ss = 1, def_modes%ndc
8917	mod_name = def_modes%cat_name_table(ss)
8918	IF ( TRIM( in_name(1:4) ) == TRIM( mod_name(1:4 ) ) ) THEN
8919	def_modes%cat_input_to_model(ss) = in
8920	ENDIF
8921	ENDDO
8922	ENDDO
8923
8924	IF ( SUM( def_modes%cat_input_to_model ) == 0 ) THEN
8925	message_string = 'None of the emission categories in ' // TRIM( &
8926	input_file_salsa ) // ' match with the ones in the model.'
8927	CALL message( 'salsa_emission_setup', 'PA0632', 1, 2, 0, 6, 0 )
8928	ENDIF
8929	!
8930	!-- Emission time factors: Find check whether emission time factors are given for each
8931	!-- hour of year OR based on month, day and hour
8932	!
8933	!-- For each hour of year:
8934	IF ( check_existence( aero_emission_att%var_names, 'nhoursyear' ) ) THEN
8935	CALL get_dimension_length( id_salsa, aero_emission_att%nhoursyear, 'nhoursyear' )
8936	ALLOCATE( aero_emission_att%etf(1:aero_emission_att%ncat, &
8937	1:aero_emission_att%nhoursyear) )
8938	CALL get_variable( id_salsa, 'emission_time_factors', aero_emission_att%etf, &
8939	0, aero_emission_att%nhoursyear-1, 0, aero_emission_att%ncat-1 )
8940	!
8941	!-- Based on the month, day and hour:
8942	ELSEIF ( check_existence( aero_emission_att%var_names, 'nmonthdayhour' ) ) THEN
8943	CALL get_dimension_length( id_salsa, aero_emission_att%nmonthdayhour, &
8944	'nmonthdayhour' )
8945	ALLOCATE( aero_emission_att%etf(1:aero_emission_att%ncat, &
8946	1:aero_emission_att%nmonthdayhour) )
8947	CALL get_variable( id_salsa, 'emission_time_factors', aero_emission_att%etf, &
8948	0, aero_emission_att%nmonthdayhour-1, 0, aero_emission_att%ncat-1 )
8949	ELSE
8950	message_string = 'emission_time_factors should be given for each nhoursyear ' //&
8951	'OR nmonthdayhour'
8952	CALL message( 'salsa_emission_setup','PA0633', 1, 2, 0, 6, 0 )
8953	ENDIF
8954	!
8955	!-- Next emission update
8956	CALL get_date_time( time_since_reference_point, second_of_day=second_of_day )
8957	next_aero_emission_update = MOD( second_of_day, seconds_per_hour ) !- seconds_per_hour
8958	!
8959	!-- Calculate average mass density (kg/m3)
8960	aero_emission_att%rho = 0.0_wp
8961
8962	IF ( cc_i2m(1) /= 0 ) aero_emission_att%rho = aero_emission_att%rho + arhoh2so4 *&
8963	aero_emission%mass_fracs(:,cc_i2m(1))
8964	IF ( cc_i2m(2) /= 0 ) aero_emission_att%rho = aero_emission_att%rho + arhooc * &
8965	aero_emission%mass_fracs(:,cc_i2m(2))
8966	IF ( cc_i2m(3) /= 0 ) aero_emission_att%rho = aero_emission_att%rho + arhobc * &
8967	aero_emission%mass_fracs(:,cc_i2m(3))
8968	IF ( cc_i2m(4) /= 0 ) aero_emission_att%rho = aero_emission_att%rho + arhodu * &
8969	aero_emission%mass_fracs(:,cc_i2m(4))
8970	IF ( cc_i2m(5) /= 0 ) aero_emission_att%rho = aero_emission_att%rho + arhoss * &
8971	aero_emission%mass_fracs(:,cc_i2m(5))
8972	IF ( cc_i2m(6) /= 0 ) aero_emission_att%rho = aero_emission_att%rho + arhohno3 * &
8973	aero_emission%mass_fracs(:,cc_i2m(6))
8974	IF ( cc_i2m(7) /= 0 ) aero_emission_att%rho = aero_emission_att%rho + arhonh3 * &
8975	aero_emission%mass_fracs(:,cc_i2m(7))
8976	!
8977	!-- Allocate and read surface emission data (in total PM, get_variable_3d_real)
8978	ALLOCATE( aero_emission%def_data(nys:nyn,nxl:nxr,1:aero_emission_att%ncat) )
8979	CALL get_variable( id_salsa, 'aerosol_emission_values', aero_emission%def_data, &
8980	0, aero_emission_att%ncat-1, nxl, nxr, nys, nyn )
8981
8982	!
8983	!-- Pre-processed mode
8984	ELSEIF ( aero_emission_att%lod == 2 ) THEN
8985	!
8986	!-- Unit conversion factor: convert to SI units (#/m2/s)
8987	IF ( aero_emission_att%units == '#/m2/s' ) THEN
8988	aero_emission_att%conversion_factor = 1.0_wp
8989	ELSE
8990	message_string = 'unknown unit for aerosol emissions: ' // &
8991	TRIM( aero_emission_att%units )
8992	CALL message( 'salsa_emission_setup','PA0634', 1, 2, 0, 6, 0 )
8993	ENDIF
8994	!
8995	!-- Number of aerosol size bins in the emission data
8996	CALL get_dimension_length( id_salsa, aero_emission_att%nbins, 'Dmid' )
8997	IF ( aero_emission_att%nbins /= nbins_aerosol ) THEN
8998	message_string = 'The number of size bins in aerosol input data does not ' // &
8999	'correspond to the model set-up'
9000	CALL message( 'salsa_emission_setup','PA0635', 1, 2, 0, 6, 0 )
9001	ENDIF
9002	!
9003	!-- Number of time steps in the emission data
9004	CALL get_dimension_length( id_salsa, aero_emission_att%nt, 'time')
9005	!
9006	!-- Allocate bin diameters, time and mass fraction array
9007	ALLOCATE( aero_emission_att%dmid(1:nbins_aerosol), &
9008	aero_emission_att%time(1:aero_emission_att%nt), &
9009	aero_emission%num_fracs(1:aero_emission_att%ncat,1:nbins_aerosol) )
9010	!
9011	!-- Read mean diameters
9012	CALL get_variable( id_salsa, 'Dmid', aero_emission_att%dmid )
9013	!
9014	!-- Check whether the sectional representation of the aerosol size distribution conform
9015	!-- to the one applied in the model
9016	IF ( ANY( ABS( ( aero(1:nbins_aerosol)%dmid - aero_emission_att%dmid ) / &
9017	aero(1:nbins_aerosol)%dmid ) > 0.1_wp ) ) THEN
9018	message_string = 'Mean diameters of size bins in ' // TRIM( input_file_salsa ) &
9019	// ' do not match with the ones in the model.'
9020	CALL message( 'salsa_emission_setup','PA0636', 1, 2, 0, 6, 0 )
9021	ENDIF
9022	!
9023	!-- Read time stamps:
9024	IF ( check_existence( aero_emission_att%var_names, 'time' ) ) THEN
9025	CALL get_variable( id_salsa, 'time', aero_emission_att%time )
9026	ELSE
9027	message_string = 'Missing time in ' // TRIM( input_file_salsa )
9028	CALL message( 'salsa_emission_setup', 'PA0660', 1, 2, 0, 6, 0 )
9029	ENDIF
9030	!
9031	!-- Check if the provided data covers the entire simulation. The spinup time is added
9032	!-- to the end_time, this must be considered here.
9033	IF ( end_time - spinup_time > aero_emission_att%time(aero_emission_att%nt-1) ) THEN
9034	message_string = 'end_time of the simulation exceeds the time dimension in ' // &
9035	'the salsa input file.'
9036	CALL message( 'salsa_emission_setup', 'PA0692', 1, 2, 0, 6, 0 )
9037	ENDIF
9038	!
9039	!-- Read emission number fractions per category
9040	IF ( check_existence( aero_emission_att%var_names, 'emission_number_fracs' ) ) THEN
9041	CALL get_variable( id_salsa, 'emission_number_fracs', aero_emission%num_fracs, &
9042	0, nbins_aerosol-1, 0, aero_emission_att%ncat-1 )
9043	ELSE
9044	message_string = 'Missing emission_number_fracs in ' // TRIM( input_file_salsa )
9045	CALL message( 'salsa_emission_setup', 'PA0694', 1, 2, 0, 6, 0 )
9046	ENDIF
9047
9048	ELSE
9049	message_string = 'Unknown lod for aerosol_emission_values.'
9050	CALL message( 'salsa_emission_setup','PA0637', 1, 2, 0, 6, 0 )
9051
9052	ENDIF ! lod
9053
9054	ENDIF ! init
9055	!
9056	!-- Define and set current emission values:
9057	!
9058	!-- Default type emissions (aerosol emission given as total mass emission per year):
9059	IF ( aero_emission_att%lod == 1 ) THEN
9060	!
9061	!-- Emission time factors for each emission category at current time step
9062	IF ( aero_emission_att%nhoursyear > aero_emission_att%nmonthdayhour ) THEN
9063	!
9064	!-- Get the index of the current hour
9065	CALL get_date_time( MAX( 0.0_wp, time_since_reference_point ), &
9066	day_of_year=day_of_year, hour=hour_of_day )
9067	index_hh = ( day_of_year - 1_iwp ) * hours_per_day + hour_of_day
9068	aero_emission_att%time_factor = aero_emission_att%etf(:,index_hh+1)
9069
9070	ELSEIF ( aero_emission_att%nhoursyear < aero_emission_att%nmonthdayhour ) THEN
9071	!
9072	!-- Get the index of current hour (index_hh) (TODO: Now "workday" is always assumed.
9073	!-- Needs to be calculated.)
9074	CALL get_date_time( MAX( 0.0_wp, time_since_reference_point ), month=month_of_year,&
9075	day=day_of_month, hour=hour_of_day, day_of_week=day_of_week )
9076	index_mm = month_of_year
9077	index_dd = months_per_year + day_of_week
9078	SELECT CASE(TRIM(daytype))
9079
9080	CASE ("workday")
9081	index_hh = months_per_year + days_per_week + hour_of_day
9082
9083	CASE ("weekend")
9084	index_hh = months_per_year + days_per_week + hours_per_day + hour_of_day
9085
9086	CASE ("holiday")
9087	index_hh = months_per_year + days_per_week + 2*hours_per_day + hour_of_day
9088
9089	END SELECT
9090	aero_emission_att%time_factor = aero_emission_att%etf(:,index_mm) * &
9091	aero_emission_att%etf(:,index_dd) * &
9092	aero_emission_att%etf(:,index_hh+1)
9093	ENDIF
9094
9095	!
9096	!-- Create a sectional number size distribution for emissions
9097	ALLOCATE( nsect_emission(1:nbins_aerosol),source_array(nys:nyn,nxl:nxr,1:nbins_aerosol) )
9098	DO in = 1, aero_emission_att%ncat
9099
9100	inn = def_modes%cat_input_to_model(in)
9101	!
9102	!-- Calculate the number concentration (1/m3) of a log-normal size distribution
9103	!-- following Jacobson (2005): Eq 13.25.
9104	def_modes%ntot_table = 6.0_wp * def_modes%pm_frac_table(:,inn) / ( pi * &
9105	( def_modes%dpg_table )*3 EXP( 4.5_wp * &
9106	LOG( def_modes%sigmag_table )**2 ) )
9107	!
9108	!-- Sectional size distibution (1/m3) from a log-normal one
9109	CALL size_distribution( def_modes%ntot_table, def_modes%dpg_table, &
9110	def_modes%sigmag_table, nsect_emission )
9111
9112	source_array = 0.0_wp
9113	DO ib = 1, nbins_aerosol
9114	source_array(:,:,ib) = aero_emission%def_data(:,:,in) * &
9115	aero_emission_att%conversion_factor / &
9116	aero_emission_att%rho(in) * nsect_emission(ib) * &
9117	aero_emission_att%time_factor(in)
9118	ENDDO
9119	!
9120	!-- Set surface fluxes of aerosol number and mass on horizontal surfaces. Set fluxes
9121	!-- only for either default, land or urban surface.
9122	IF ( .NOT. land_surface .AND. .NOT. urban_surface ) THEN
9123	CALL set_flux( surf_def_h(0), aero_emission_att%cc_in2mod, &
9124	aero_emission%mass_fracs(in,:), source_array )
9125	ELSE
9126	CALL set_flux( surf_usm_h, aero_emission_att%cc_in2mod, &
9127	aero_emission%mass_fracs(in,:), source_array )
9128	CALL set_flux( surf_lsm_h, aero_emission_att%cc_in2mod, &
9129	aero_emission%mass_fracs(in,:), source_array )
9130	ENDIF
9131	ENDDO
9132	!
9133	!-- The next emission update is again after one hour
9134	next_aero_emission_update = next_aero_emission_update + 3600.0_wp
9135
9136
9137	DEALLOCATE( nsect_emission, source_array )
9138	!
9139	!-- Pre-processed:
9140	ELSEIF ( aero_emission_att%lod == 2 ) THEN
9141	!
9142	!-- Obtain time index for current point in time.
9143	aero_emission_att%tind = MINLOC( ABS( aero_emission_att%time - &
9144	MAX( time_since_reference_point, 0.0_wp ) ), &
9145	DIM = 1 ) - 1
9146	!
9147	!-- Allocate the data input array always before reading in the data and deallocate after
9148	ALLOCATE( aero_emission%preproc_data(nys:nyn,nxl:nxr,1:aero_emission_att%ncat), &
9149	source_array(nys:nyn,nxl:nxr,1:nbins_aerosol) )
9150	!
9151	!-- Read in the next time step (get_variable_4d_to_3d_real)
9152	CALL get_variable( id_salsa, 'aerosol_emission_values', aero_emission%preproc_data, &
9153	aero_emission_att%tind, 0, aero_emission_att%ncat-1, &
9154	nxl, nxr, nys, nyn )
9155	!
9156	!-- Calculate the sources per category and set surface fluxes
9157	source_array = 0.0_wp
9158	DO in = 1, aero_emission_att%ncat
9159	DO ib = 1, nbins_aerosol
9160	source_array(:,:,ib) = aero_emission%preproc_data(:,:,in) * &
9161	aero_emission%num_fracs(in,ib)
9162	ENDDO
9163	!
9164	!-- Set fluxes only for either default, land and urban surface.
9165	IF ( .NOT. land_surface .AND. .NOT. urban_surface ) THEN
9166	CALL set_flux( surf_def_h(0), aero_emission_att%cc_in2mod, &
9167	aero_emission%mass_fracs(in,:), source_array )
9168	ELSE
9169	CALL set_flux( surf_usm_h, aero_emission_att%cc_in2mod, &
9170	aero_emission%mass_fracs(in,:), source_array )
9171	CALL set_flux( surf_lsm_h, aero_emission_att%cc_in2mod, &
9172	aero_emission%mass_fracs(in,:), source_array )
9173	ENDIF
9174	ENDDO
9175	!
9176	!-- Determine the next emission update
9177	next_aero_emission_update = aero_emission_att%time(aero_emission_att%tind+2)
9178
9179	DEALLOCATE( aero_emission%preproc_data, source_array )
9180
9181	ENDIF
9182	!
9183	!-- Close input file
9184	CALL close_input_file( id_salsa )
9185	#else
9186	message_string = 'salsa_emission_mode = "read_from_file", but preprocessor directive ' //&
9187	' __netcdf is not used in compiling!'
9188	CALL message( 'salsa_emission_setup', 'PA0638', 1, 2, 0, 6, 0 )
9189
9190	#endif
9191	CASE DEFAULT
9192	message_string = 'unknown salsa_emission_mode: ' // TRIM( salsa_emission_mode )
9193	CALL message( 'salsa_emission_setup', 'PA0639', 1, 2, 0, 6, 0 )
9194
9195	END SELECT
9196
9197	CONTAINS
9198
9199	!------------------------------------------------------------------------------!
9200	! Description:
9201	! ------------
9202	!> Sets the aerosol flux to aerosol arrays in 2a and 2b.
9203	!------------------------------------------------------------------------------!
9204	SUBROUTINE set_flux( surface, cc_i_mod, mass_fracs, source_array )
9205
9206	USE arrays_3d, &
9207	ONLY: rho_air_zw
9208
9209	USE surface_mod, &
9210	ONLY: surf_type
9211
9212	IMPLICIT NONE
9213
9214	INTEGER(iwp) :: i !< loop index
9215	INTEGER(iwp) :: ib !< loop index
9216	INTEGER(iwp) :: ic !< loop index
9217	INTEGER(iwp) :: j !< loop index
9218	INTEGER(iwp) :: k !< loop index
9219	INTEGER(iwp) :: m !< running index for surface elements
9220
9221	INTEGER(iwp), DIMENSION(:) :: cc_i_mod !< index of chemical component in the input data
9222
9223	REAL(wp) :: so4_oc !< mass fraction between SO4 and OC in 1a
9224
9225	REAL(wp), DIMENSION(:), INTENT(in) :: mass_fracs !< mass fractions of chemical components
9226
9227	REAL(wp), DIMENSION(nys:nyn,nxl:nxr,1:nbins_aerosol), INTENT(inout) :: source_array !<
9228
9229	TYPE(surf_type), INTENT(inout) :: surface !< respective surface type
9230
9231	so4_oc = 0.0_wp
9232
9233	DO m = 1, surface%ns
9234	!
9235	!-- Get indices of respective grid point
9236	i = surface%i(m)
9237	j = surface%j(m)
9238	k = surface%k(m)
9239
9240	DO ib = 1, nbins_aerosol
9241	IF ( source_array(j,i,ib) < nclim ) THEN
9242	source_array(j,i,ib) = 0.0_wp
9243	ENDIF
9244	!
9245	!-- Set mass fluxes. First bins include only SO4 and/or OC.
9246	IF ( ib <= end_subrange_1a ) THEN
9247	!
9248	!-- Both sulphate and organic carbon
9249	IF ( index_so4 > 0 .AND. index_oc > 0 ) THEN
9250
9251	ic = ( index_so4 - 1 ) * nbins_aerosol + ib
9252	so4_oc = mass_fracs(cc_i_mod(1)) / ( mass_fracs(cc_i_mod(1)) + &
9253	mass_fracs(cc_i_mod(2)) )
9254	surface%amsws(m,ic) = surface%amsws(m,ic) + so4_oc * source_array(j,i,ib) &
9255	* api6 * aero(ib)%dmid*3 arhoh2so4 * rho_air_zw(k-1)
9256	aerosol_mass(ic)%source(j,i) = aerosol_mass(ic)%source(j,i) + surface%amsws(m,ic)
9257
9258	ic = ( index_oc - 1 ) * nbins_aerosol + ib
9259	surface%amsws(m,ic) = surface%amsws(m,ic) + ( 1-so4_oc ) * source_array(j,i,ib) &
9260	* api6 * aero(ib)%dmid*3 arhooc * rho_air_zw(k-1)
9261	aerosol_mass(ic)%source(j,i) = aerosol_mass(ic)%source(j,i) + surface%amsws(m,ic)
9262	!
9263	!-- Only sulphates
9264	ELSEIF ( index_so4 > 0 .AND. index_oc < 0 ) THEN
9265	ic = ( index_so4 - 1 ) * nbins_aerosol + ib
9266	surface%amsws(m,ic) = surface%amsws(m,ic) + source_array(j,i,ib) * api6 * &
9267	aero(ib)%dmid*3 arhoh2so4 * rho_air_zw(k-1)
9268	aerosol_mass(ic)%source(j,i) = aerosol_mass(ic)%source(j,i) + surface%amsws(m,ic)
9269	!
9270	!-- Only organic carbon
9271	ELSEIF ( index_so4 < 0 .AND. index_oc > 0 ) THEN
9272	ic = ( index_oc - 1 ) * nbins_aerosol + ib
9273	surface%amsws(m,ic) = surface%amsws(m,ic) + source_array(j,i,ib) * api6 * &
9274	aero(ib)%dmid*3 arhooc * rho_air_zw(k-1)
9275	aerosol_mass(ic)%source(j,i) = aerosol_mass(ic)%source(j,i) + surface%amsws(m,ic)
9276	ENDIF
9277
9278	ELSE
9279	!
9280	!-- Sulphate
9281	IF ( index_so4 > 0 ) THEN
9282	ic = cc_i_mod(1)
9283	CALL set_mass_flux( surface, m, ib, index_so4, mass_fracs(ic), arhoh2so4, &
9284	source_array(j,i,ib) )
9285	ENDIF
9286	!
9287	!-- Organic carbon
9288	IF ( index_oc > 0 ) THEN
9289	ic = cc_i_mod(2)
9290	CALL set_mass_flux( surface, m, ib, index_oc, mass_fracs(ic),arhooc, &
9291	source_array(j,i,ib) )
9292	ENDIF
9293	!
9294	!-- Black carbon
9295	IF ( index_bc > 0 ) THEN
9296	ic = cc_i_mod(3)
9297	CALL set_mass_flux( surface, m, ib, index_bc, mass_fracs(ic), arhobc, &
9298	source_array(j,i,ib) )
9299	ENDIF
9300	!
9301	!-- Dust
9302	IF ( index_du > 0 ) THEN
9303	ic = cc_i_mod(4)
9304	CALL set_mass_flux( surface, m, ib, index_du, mass_fracs(ic), arhodu, &
9305	source_array(j,i,ib) )
9306	ENDIF
9307	!
9308	!-- Sea salt
9309	IF ( index_ss > 0 ) THEN
9310	ic = cc_i_mod(5)
9311	CALL set_mass_flux( surface, m, ib, index_ss, mass_fracs(ic), arhoss, &
9312	source_array(j,i,ib) )
9313	ENDIF
9314	!
9315	!-- Nitric acid
9316	IF ( index_no > 0 ) THEN
9317	ic = cc_i_mod(6)
9318	CALL set_mass_flux( surface, m, ib, index_no, mass_fracs(ic), arhohno3, &
9319	source_array(j,i,ib) )
9320	ENDIF
9321	!
9322	!-- Ammonia
9323	IF ( index_nh > 0 ) THEN
9324	ic = cc_i_mod(7)
9325	CALL set_mass_flux( surface, m, ib, index_nh, mass_fracs(ic), arhonh3, &
9326	source_array(j,i,ib) )
9327	ENDIF
9328
9329	ENDIF
9330	!
9331	!-- Save number fluxes in the end
9332	surface%answs(m,ib) = surface%answs(m,ib) + source_array(j,i,ib) * rho_air_zw(k-1)
9333	aerosol_number(ib)%source(j,i) = aerosol_number(ib)%source(j,i) + surface%answs(m,ib)
9334
9335	ENDDO ! ib
9336	ENDDO ! m
9337
9338	END SUBROUTINE set_flux
9339
9340	!------------------------------------------------------------------------------!
9341	! Description:
9342	! ------------
9343	!> Sets the mass emissions to aerosol arrays in 2a and 2b.
9344	!------------------------------------------------------------------------------!
9345	SUBROUTINE set_mass_flux( surface, surf_num, ib, ispec, mass_frac, prho, nsource )
9346
9347	USE arrays_3d, &
9348	ONLY: rho_air_zw
9349
9350	USE surface_mod, &
9351	ONLY: surf_type
9352
9353	IMPLICIT NONE
9354
9355	INTEGER(iwp) :: i !< loop index
9356	INTEGER(iwp) :: j !< loop index
9357	INTEGER(iwp) :: k !< loop index
9358	INTEGER(iwp) :: ic !< loop index
9359
9360	INTEGER(iwp), INTENT(in) :: ib !< Aerosol size bin index
9361	INTEGER(iwp), INTENT(in) :: ispec !< Aerosol species index
9362	INTEGER(iwp), INTENT(in) :: surf_num !< index surface elements
9363
9364	REAL(wp), INTENT(in) :: mass_frac !< mass fraction of a chemical compound in all bins
9365	REAL(wp), INTENT(in) :: nsource !< number source (#/m2/s)
9366	REAL(wp), INTENT(in) :: prho !< Aerosol density
9367
9368	TYPE(surf_type), INTENT(inout) :: surface !< respective surface type
9369	!
9370	!-- Get indices of respective grid point
9371	i = surface%i(surf_num)
9372	j = surface%j(surf_num)
9373	k = surface%k(surf_num)
9374	!
9375	!-- Subrange 2a:
9376	ic = ( ispec - 1 ) * nbins_aerosol + ib
9377	surface%amsws(surf_num,ic) = surface%amsws(surf_num,ic) + mass_frac * nsource * &
9378	aero(ib)%core * prho * rho_air_zw(k-1)
9379	aerosol_mass(ic)%source(j,i) = aerosol_mass(ic)%source(j,i) + surface%amsws(surf_num,ic)
9380
9381	END SUBROUTINE set_mass_flux
9382
9383	END SUBROUTINE salsa_emission_setup
9384
9385	!------------------------------------------------------------------------------!
9386	! Description:
9387	! ------------
9388	!> Sets the gaseous fluxes
9389	!------------------------------------------------------------------------------!
9390	SUBROUTINE salsa_gas_emission_setup( init )
9391
9392	USE netcdf_data_input_mod, &
9393	ONLY: check_existence, close_input_file, get_attribute, get_variable, &
9394	inquire_num_variables, inquire_variable_names, &
9395	get_dimension_length, open_read_file
9396
9397	USE palm_date_time_mod, &
9398	ONLY: days_per_week, get_date_time, hours_per_day, months_per_year, seconds_per_hour
9399
9400	USE surface_mod, &
9401	ONLY: surf_def_h, surf_lsm_h, surf_usm_h
9402
9403	IMPLICIT NONE
9404
9405	CHARACTER(LEN=80) :: daytype = 'workday' !< default day type
9406	CHARACTER(LEN=25) :: in_name !< name of a gas in the input file
9407
9408	CHARACTER(LEN=100), DIMENSION(:), ALLOCATABLE :: var_names !< variable names in input data
9409
9410
9411	INTEGER(iwp) :: day_of_month !< day of the month
9412	INTEGER(iwp) :: day_of_week !< day of the week
9413	INTEGER(iwp) :: day_of_year !< day of the year
9414	INTEGER(iwp) :: hour_of_day !< hour of the day
9415	INTEGER(iwp) :: id_chem !< NetCDF id of chemistry emission file
9416	INTEGER(iwp) :: i !< loop index
9417	INTEGER(iwp) :: ig !< loop index
9418	INTEGER(iwp) :: in !< running index for emission categories
9419	INTEGER(iwp) :: index_dd !< index day
9420	INTEGER(iwp) :: index_hh !< index hour
9421	INTEGER(iwp) :: index_mm !< index month
9422	INTEGER(iwp) :: j !< loop index
9423	INTEGER(iwp) :: month_of_year !< month of the year
9424	INTEGER(iwp) :: num_vars !< number of variables
9425
9426	LOGICAL :: netcdf_extend = .FALSE. !< NetCDF input file exists
9427
9428	LOGICAL, INTENT(in) :: init !< if .TRUE. --> initialisation call
9429
9430	REAL(wp) :: second_of_day !< second of the day
9431
9432	REAL(wp), DIMENSION(:), ALLOCATABLE :: time_factor !< emission time factor
9433
9434	REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: dum_var_3d !<
9435
9436	REAL(wp), DIMENSION(:,:,:,:,:), ALLOCATABLE :: dum_var_5d !<
9437
9438	!
9439	!-- Reset surface fluxes
9440	surf_def_h(0)%gtsws = 0.0_wp
9441	surf_lsm_h%gtsws = 0.0_wp
9442	surf_usm_h%gtsws = 0.0_wp
9443
9444	#if defined( __netcdf )
9445	!
9446	!-- Check existence of PIDS_CHEM file
9447	INQUIRE( FILE = 'PIDS_CHEM' // TRIM( coupling_char ), EXIST = netcdf_extend )
9448	IF ( .NOT. netcdf_extend ) THEN
9449	message_string = 'Input file PIDS_CHEM' // TRIM( coupling_char ) // ' missing!'
9450	CALL message( 'salsa_gas_emission_setup', 'PA0640', 1, 2, 0, 6, 0 )
9451	ENDIF
9452	!
9453	!-- Open file in read-only mode
9454	CALL open_read_file( 'PIDS_CHEM' // TRIM( coupling_char ), id_chem )
9455
9456	IF ( init ) THEN
9457	!
9458	!-- Read the index and name of chemical components
9459	CALL get_dimension_length( id_chem, chem_emission_att%n_emiss_species, 'nspecies' )
9460	ALLOCATE( chem_emission_att%species_index(1:chem_emission_att%n_emiss_species) )
9461	CALL get_variable( id_chem, 'emission_index', chem_emission_att%species_index )
9462	CALL get_variable( id_chem, 'emission_name', chem_emission_att%species_name, &
9463	chem_emission_att%n_emiss_species )
9464	!
9465	!-- Allocate emission data
9466	ALLOCATE( chem_emission(1:chem_emission_att%n_emiss_species) )
9467	!
9468	!-- Find the corresponding indices in the model
9469	emission_index_chem = 0
9470	DO ig = 1, chem_emission_att%n_emiss_species
9471	in_name = chem_emission_att%species_name(ig)
9472	SELECT CASE ( TRIM( in_name ) )
9473	CASE ( 'H2SO4', 'h2so4' )
9474	emission_index_chem(1) = ig
9475	CASE ( 'HNO3', 'hno3' )
9476	emission_index_chem(2) = ig
9477	CASE ( 'NH3', 'nh3' )
9478	emission_index_chem(3) = ig
9479	CASE ( 'OCNV', 'ocnv' )
9480	emission_index_chem(4) = ig
9481	CASE ( 'OCSV', 'ocsv' )
9482	emission_index_chem(5) = ig
9483	END SELECT
9484	ENDDO
9485	!
9486	!-- Inquire the fill value
9487	CALL get_attribute( id_chem, '_FillValue', aero_emission%fill, .FALSE., 'emission_values' )
9488	!
9489	!-- Inquire units of emissions
9490	CALL get_attribute( id_chem, 'units', chem_emission_att%units, .FALSE., 'emission_values' )
9491	!
9492	!-- Inquire the level of detail (lod)
9493	CALL get_attribute( id_chem, 'lod', lod_gas_emissions, .FALSE., 'emission_values' )
9494	!
9495	!-- Variable names
9496	CALL inquire_num_variables( id_chem, num_vars )
9497	ALLOCATE( var_names(1:num_vars) )
9498	CALL inquire_variable_names( id_chem, var_names )
9499	!
9500	!-- Default mode: as total emissions per year
9501	IF ( lod_gas_emissions == 1 ) THEN
9502
9503	!
9504	!-- Get number of emission categories and allocate emission arrays
9505	CALL get_dimension_length( id_chem, chem_emission_att%ncat, 'ncat' )
9506	ALLOCATE( chem_emission_att%cat_index(1:chem_emission_att%ncat), &
9507	time_factor(1:chem_emission_att%ncat) )
9508	!
9509	!-- Get emission category names and indices
9510	CALL get_variable( id_chem, 'emission_category_name', chem_emission_att%cat_name, &
9511	chem_emission_att%ncat)
9512	CALL get_variable( id_chem, 'emission_category_index', chem_emission_att%cat_index )
9513	!
9514	!-- Emission time factors: Find check whether emission time factors are given for each hour
9515	!-- of year OR based on month, day and hour
9516	!
9517	!-- For each hour of year:
9518	IF ( check_existence( var_names, 'nhoursyear' ) ) THEN
9519	CALL get_dimension_length( id_chem, chem_emission_att%nhoursyear, 'nhoursyear' )
9520	ALLOCATE( chem_emission_att%hourly_emis_time_factor(1:chem_emission_att%ncat, &
9521	1:chem_emission_att%nhoursyear) )
9522	CALL get_variable( id_chem, 'emission_time_factors', &
9523	chem_emission_att%hourly_emis_time_factor, &
9524	0, chem_emission_att%nhoursyear-1, 0, chem_emission_att%ncat-1 )
9525	!
9526	!-- Based on the month, day and hour:
9527	ELSEIF ( check_existence( var_names, 'nmonthdayhour' ) ) THEN
9528	CALL get_dimension_length( id_chem, chem_emission_att%nmonthdayhour, 'nmonthdayhour' )
9529	ALLOCATE( chem_emission_att%mdh_emis_time_factor(1:chem_emission_att%ncat, &
9530	1:chem_emission_att%nmonthdayhour) )
9531	CALL get_variable( id_chem, 'emission_time_factors', &
9532	chem_emission_att%mdh_emis_time_factor, &
9533	0, chem_emission_att%nmonthdayhour-1, 0, chem_emission_att%ncat-1 )
9534	ELSE
9535	message_string = 'emission_time_factors should be given for each nhoursyear OR ' // &
9536	'nmonthdayhour'
9537	CALL message( 'salsa_gas_emission_setup','PA0641', 1, 2, 0, 6, 0 )
9538	ENDIF
9539	!
9540	!-- Next emission update
9541	CALL get_date_time( time_since_reference_point, second_of_day=second_of_day )
9542	next_gas_emission_update = MOD( second_of_day, seconds_per_hour ) !- seconds_per_hour
9543	!
9544	!-- Allocate and read surface emission data (in total PM) (NOTE that "preprocessed" input data
9545	!-- array is applied now here)
9546	ALLOCATE( dum_var_5d(1,nys:nyn,nxl:nxr,1:chem_emission_att%n_emiss_species, &
9547	1:chem_emission_att%ncat) )
9548	CALL get_variable( id_chem, 'emission_values', dum_var_5d, 0, chem_emission_att%ncat-1, &
9549	0, chem_emission_att%n_emiss_species-1, nxl, nxr, nys, nyn, 0, 0 )
9550	DO ig = 1, chem_emission_att%n_emiss_species
9551	ALLOCATE( chem_emission(ig)%default_emission_data(nys:nyn,nxl:nxr, &
9552	1:chem_emission_att%ncat) )
9553	DO in = 1, chem_emission_att%ncat
9554	DO i = nxl, nxr
9555	DO j = nys, nyn
9556	chem_emission(ig)%default_emission_data(j,i,in) = dum_var_5d(1,j,i,ig,in)
9557	ENDDO
9558	ENDDO
9559	ENDDO
9560	ENDDO
9561	DEALLOCATE( dum_var_5d )
9562	!
9563	!-- Pre-processed mode:
9564	ELSEIF ( lod_gas_emissions == 2 ) THEN
9565	!
9566	!-- Number of time steps in the emission data
9567	CALL get_dimension_length( id_chem, chem_emission_att%dt_emission, 'time' )
9568	!
9569	!-- Allocate and read time
9570	ALLOCATE( gas_emission_time(1:chem_emission_att%dt_emission) )
9571	CALL get_variable( id_chem, 'time', gas_emission_time )
9572	ELSE
9573	message_string = 'Unknown lod for emission_values.'
9574	CALL message( 'salsa_gas_emission_setup','PA0642', 1, 2, 0, 6, 0 )
9575	ENDIF ! lod
9576
9577	ENDIF ! init
9578	!
9579	!-- Define and set current emission values:
9580
9581	IF ( lod_gas_emissions == 1 ) THEN
9582	!
9583	!-- Emission time factors for each emission category at current time step
9584	IF ( chem_emission_att%nhoursyear > chem_emission_att%nmonthdayhour ) THEN
9585	!
9586	!-- Get the index of the current hour
9587	CALL get_date_time( time_since_reference_point, &
9588	day_of_year=day_of_year, hour=hour_of_day )
9589	index_hh = ( day_of_year - 1_iwp ) * hours_per_day + hour_of_day
9590	IF ( .NOT. ALLOCATED( time_factor ) ) ALLOCATE( time_factor(1:chem_emission_att%ncat) )
9591	time_factor = 0.0_wp
9592	time_factor = chem_emission_att%hourly_emis_time_factor(:,index_hh+1)
9593
9594	ELSEIF ( chem_emission_att%nhoursyear < chem_emission_att%nmonthdayhour ) THEN
9595	!
9596	!-- Get the index of current hour (index_hh) (TODO: Now "workday" is always assumed.
9597	!-- Needs to be calculated.)
9598	CALL get_date_time( time_since_reference_point, &
9599	month=month_of_year, &
9600	day=day_of_month, &
9601	hour=hour_of_day, &
9602	day_of_week=day_of_week )
9603	index_mm = month_of_year
9604	index_dd = months_per_year + day_of_week
9605	SELECT CASE( TRIM( daytype ) )
9606
9607	CASE ("workday")
9608	index_hh = months_per_year + days_per_week + hour_of_day
9609
9610	CASE ("weekend")
9611	index_hh = months_per_year + days_per_week + hours_per_day + hour_of_day
9612
9613	CASE ("holiday")
9614	index_hh = months_per_year + days_per_week + 2*hours_per_day + hour_of_day
9615
9616	END SELECT
9617	time_factor = chem_emission_att%mdh_emis_time_factor(:,index_mm) * &
9618	chem_emission_att%mdh_emis_time_factor(:,index_dd) * &
9619	chem_emission_att%mdh_emis_time_factor(:,index_hh+1)
9620	ENDIF
9621	!
9622	!-- Set gas emissions for each emission category
9623	ALLOCATE( dum_var_3d(nys:nyn,nxl:nxr,1:chem_emission_att%n_emiss_species) )
9624
9625	DO in = 1, chem_emission_att%ncat
9626	DO ig = 1, chem_emission_att%n_emiss_species
9627	dum_var_3d(:,:,ig) = chem_emission(ig)%default_emission_data(:,:,in)
9628	ENDDO
9629	!
9630	!-- Set surface fluxes only for either default, land or urban surface
9631	IF ( .NOT. land_surface .AND. .NOT. urban_surface ) THEN
9632	CALL set_gas_flux( surf_def_h(0), emission_index_chem, chem_emission_att%units, &
9633	dum_var_3d, time_factor(in) )
9634	ELSE
9635	CALL set_gas_flux( surf_usm_h, emission_index_chem, chem_emission_att%units, &
9636	dum_var_3d, time_factor(in) )
9637	CALL set_gas_flux( surf_lsm_h, emission_index_chem, chem_emission_att%units, &
9638	dum_var_3d, time_factor(in) )
9639	ENDIF
9640	ENDDO
9641	DEALLOCATE( dum_var_3d )
9642	!
9643	!-- The next emission update is again after one hour
9644	next_gas_emission_update = next_gas_emission_update + 3600.0_wp
9645
9646	ELSEIF ( lod_gas_emissions == 2 ) THEN
9647	!
9648	!-- Obtain time index for current point in time.
9649	chem_emission_att%i_hour = MINLOC( ABS( gas_emission_time - &
9650	MAX( time_since_reference_point, 0.0_wp ) ), DIM = 1 ) - 1
9651	!
9652	!-- Allocate the data input array always before reading in the data and deallocate after (NOTE
9653	!-- that "preprocessed" input data array is applied now here)
9654	ALLOCATE( dum_var_5d(1,1,nys:nyn,nxl:nxr,1:chem_emission_att%n_emiss_species) )
9655	!
9656	!-- Read in the next time step
9657	CALL get_variable( id_chem, 'emission_values', dum_var_5d, &
9658	0, chem_emission_att%n_emiss_species-1, nxl, nxr, nys, nyn, 0, 0, &
9659	chem_emission_att%i_hour, chem_emission_att%i_hour )
9660	!
9661	!-- Set surface fluxes only for either default, land or urban surface
9662	IF ( .NOT. land_surface .AND. .NOT. urban_surface ) THEN
9663	CALL set_gas_flux( surf_def_h(0), emission_index_chem, chem_emission_att%units, &
9664	dum_var_5d(1,1,:,:,:) )
9665	ELSE
9666	CALL set_gas_flux( surf_usm_h, emission_index_chem, chem_emission_att%units, &
9667	dum_var_5d(1,1,:,:,:) )
9668	CALL set_gas_flux( surf_lsm_h, emission_index_chem, chem_emission_att%units, &
9669	dum_var_5d(1,1,:,:,:) )
9670	ENDIF
9671	DEALLOCATE ( dum_var_5d )
9672	!
9673	!-- Determine the next emission update
9674	next_gas_emission_update = gas_emission_time(chem_emission_att%i_hour+2)
9675
9676	ENDIF
9677	!
9678	!-- Close input file
9679	CALL close_input_file( id_chem )
9680
9681	#else
9682	message_string = 'salsa_emission_mode = "read_from_file", but preprocessor directive ' // &
9683	' __netcdf is not used in compiling!'
9684	CALL message( 'salsa_gas_emission_setup', 'PA0643', 1, 2, 0, 6, 0 )
9685
9686	#endif
9687
9688	CONTAINS
9689	!------------------------------------------------------------------------------!
9690	! Description:
9691	! ------------
9692	!> Set gas fluxes for selected type of surfaces
9693	!------------------------------------------------------------------------------!
9694	SUBROUTINE set_gas_flux( surface, cc_i_mod, unit, source_array, time_fac )
9695
9696	USE arrays_3d, &
9697	ONLY: dzw, hyp, pt, rho_air_zw
9698
9699	USE grid_variables, &
9700	ONLY: dx, dy
9701
9702	USE surface_mod, &
9703	ONLY: surf_type
9704
9705	IMPLICIT NONE
9706
9707	CHARACTER(LEN=*), INTENT(in) :: unit !< flux unit in the input file
9708
9709	INTEGER(iwp) :: ig !< running index for gases
9710	INTEGER(iwp) :: i !< loop index
9711	INTEGER(iwp) :: j !< loop index
9712	INTEGER(iwp) :: k !< loop index
9713	INTEGER(iwp) :: m !< running index for surface elements
9714
9715	INTEGER(iwp), DIMENSION(:) :: cc_i_mod !< index of different gases in the input data
9716
9717	LOGICAL :: use_time_fac !< .TRUE. is time_fac present
9718
9719	REAL(wp), OPTIONAL :: time_fac !< emission time factor
9720
9721	REAL(wp), DIMENSION(ngases_salsa) :: conv !< unit conversion factor
9722
9723	REAL(wp), DIMENSION(nys:nyn,nxl:nxr,1:chem_emission_att%n_emiss_species), INTENT(in) :: source_array !<
9724
9725	TYPE(surf_type), INTENT(inout) :: surface !< respective surface type
9726
9727	conv = 1.0_wp
9728	use_time_fac = PRESENT( time_fac )
9729
9730	DO m = 1, surface%ns
9731	!
9732	!-- Get indices of respective grid point
9733	i = surface%i(m)
9734	j = surface%j(m)
9735	k = surface%k(m)
9736	!
9737	!-- Unit conversion factor: convert to SI units (#/m2/s)
9738	SELECT CASE ( TRIM( unit ) )
9739	CASE ( 'kg/m2/yr' )
9740	conv(1) = avo / ( amh2so4 * 3600.0_wp )
9741	conv(2) = avo / ( amhno3 * 3600.0_wp )
9742	conv(3) = avo / ( amnh3 * 3600.0_wp )
9743	conv(4) = avo / ( amoc * 3600.0_wp )
9744	conv(5) = avo / ( amoc * 3600.0_wp )
9745	CASE ( 'g/m2/yr' )
9746	conv(1) = avo / ( amh2so4 * 3.6E+6_wp )
9747	conv(2) = avo / ( amhno3 * 3.6E+6_wp )
9748	conv(3) = avo / ( amnh3 * 3.6E+6_wp )
9749	conv(4) = avo / ( amoc * 3.6E+6_wp )
9750	conv(5) = avo / ( amoc * 3.6E+6_wp )
9751	CASE ( 'g/m2/s' )
9752	conv(1) = avo / ( amh2so4 * 1000.0_wp )
9753	conv(2) = avo / ( amhno3 * 1000.0_wp )
9754	conv(3) = avo / ( amnh3 * 1000.0_wp )
9755	conv(4) = avo / ( amoc * 1000.0_wp )
9756	conv(5) = avo / ( amoc * 1000.0_wp )
9757	CASE ( '#/m2/s' )
9758	conv = 1.0_wp
9759	CASE ( 'ppm/m2/s' )
9760	conv = for_ppm_to_nconc * hyp(k) / pt(k,j,i) * ( 1.0E5_wp / hyp(k) )*0.286_wp &
9761	dx * dy * dzw(k)
9762	CASE ( 'mumol/m2/s' )
9763	conv = 1.0E-6_wp * avo
9764	CASE DEFAULT
9765	message_string = 'unknown unit for gas emissions: ' // TRIM( chem_emission_att%units )
9766	CALL message( 'set_gas_flux','PA0644', 1, 2, 0, 6, 0 )
9767
9768	END SELECT
9769
9770	DO ig = 1, ngases_salsa
9771	IF ( use_time_fac ) THEN
9772	surface%gtsws(m,ig) = surface%gtsws(m,ig) + rho_air_zw(k-1) * conv(ig) * time_fac &
9773	* MAX( 0.0_wp, source_array(j,i,cc_i_mod(ig) ) )
9774	ELSE
9775	surface%gtsws(m,ig) = surface%gtsws(m,ig) + rho_air_zw(k-1) * conv(ig) &
9776	* MAX( 0.0_wp, source_array(j,i,cc_i_mod(ig) ) )
9777	ENDIF
9778	ENDDO ! ig
9779
9780	ENDDO ! m
9781
9782	END SUBROUTINE set_gas_flux
9783
9784	END SUBROUTINE salsa_gas_emission_setup
9785
9786	!------------------------------------------------------------------------------!
9787	! Description:
9788	! ------------
9789	!> Check data output for salsa.
9790	!------------------------------------------------------------------------------!
9791	SUBROUTINE salsa_check_data_output( var, unit )
9792
9793	IMPLICIT NONE
9794
9795	CHARACTER(LEN=*) :: unit !<
9796	CHARACTER(LEN=*) :: var !<
9797
9798	INTEGER(iwp) :: char_to_int !< for converting character to integer
9799
9800	IF ( var(1:6) /= 'salsa_' ) THEN
9801	unit = 'illegal'
9802	RETURN
9803	ENDIF
9804	!
9805	!-- Treat bin-specific outputs separately
9806	IF ( var(7:11) == 'N_bin' ) THEN
9807	READ( var(12:),* ) char_to_int
9808	IF ( char_to_int >= 1 .AND. char_to_int <= SUM( nbin ) ) THEN
9809	unit = '#/m3'
9810	ELSE
9811	unit = 'illegal'
9812	RETURN
9813	ENDIF
9814
9815	ELSEIF ( var(7:11) == 'm_bin' ) THEN
9816	READ( var(12:),* ) char_to_int
9817	IF ( char_to_int >= 1 .AND. char_to_int <= SUM( nbin ) ) THEN
9818	unit = 'kg/m3'
9819	ELSE
9820	unit = 'illegal'
9821	RETURN
9822	ENDIF
9823
9824	ELSE
9825	SELECT CASE ( TRIM( var(7:) ) )
9826
9827	CASE ( 'g_H2SO4', 'g_HNO3', 'g_NH3', 'g_OCNV', 'g_OCSV' )
9828	IF ( air_chemistry ) THEN
9829	message_string = 'gases are imported from the chemistry module and thus output '// &
9830	'of "' // TRIM( var ) // '" is not allowed'
9831	CALL message( 'check_parameters', 'PA0653', 1, 2, 0, 6, 0 )
9832	ENDIF
9833	unit = '#/m3'
9834
9835	CASE ( 'LDSA' )
9836	unit = 'mum2/cm3'
9837
9838	CASE ( 'PM0.1', 'PM2.5', 'PM10', 's_BC', 's_DU', 's_H2O', 's_NH', 's_NO', 's_OC', &
9839	's_SO4', 's_SS' )
9840	unit = 'kg/m3'
9841
9842	CASE ( 'N_UFP', 'Ntot' )
9843	unit = '#/m3'
9844
9845	CASE DEFAULT
9846	unit = 'illegal'
9847
9848	END SELECT
9849	ENDIF
9850
9851	END SUBROUTINE salsa_check_data_output
9852
9853	!------------------------------------------------------------------------------!
9854	! Description:
9855	! ------------
9856	!> Check profile data output for salsa. Currently only for diagnostic variables
9857	!> Ntot, N_UFP, PM0.1, PM2.5, PM10 and LDSA
9858	!------------------------------------------------------------------------------!
9859	SUBROUTINE salsa_check_data_output_pr( var, var_count, unit, dopr_unit )
9860
9861	USE arrays_3d, &
9862	ONLY: zu
9863
9864	USE profil_parameter, &
9865	ONLY: dopr_index
9866
9867	USE statistics, &
9868	ONLY: hom, pr_palm, statistic_regions
9869
9870	IMPLICIT NONE
9871
9872	CHARACTER(LEN=*) :: dopr_unit !<
9873	CHARACTER(LEN=*) :: unit !<
9874	CHARACTER(LEN=*) :: var !<
9875
9876	INTEGER(iwp) :: var_count !<
9877
9878	IF ( var(1:6) /= 'salsa_' ) THEN
9879	unit = 'illegal'
9880	RETURN
9881	ENDIF
9882
9883	SELECT CASE ( TRIM( var(7:) ) )
9884
9885	CASE( 'LDSA' )
9886	salsa_pr_count = salsa_pr_count + 1
9887	salsa_pr_index(salsa_pr_count) = 1
9888	dopr_index(var_count) = pr_palm + salsa_pr_count
9889	dopr_unit = 'mum2/cm3'
9890	unit = dopr_unit
9891	hom(:,2,dopr_index(var_count),:) = SPREAD( zu, 2, statistic_regions+1 )
9892
9893	CASE( 'N_UFP' )
9894	salsa_pr_count = salsa_pr_count + 1
9895	salsa_pr_index(salsa_pr_count) = 2
9896	dopr_index(var_count) = pr_palm + salsa_pr_count
9897	dopr_unit = '#/m3'
9898	unit = dopr_unit
9899	hom(:,2,dopr_index(var_count),:) = SPREAD( zu, 2, statistic_regions+1 )
9900
9901	CASE( 'Ntot' )
9902	salsa_pr_count = salsa_pr_count + 1
9903	salsa_pr_index(salsa_pr_count) = 3
9904	dopr_index(var_count) = pr_palm + salsa_pr_count
9905	dopr_unit = '#/m3'
9906	unit = dopr_unit
9907	hom(:,2,dopr_index(var_count),:) = SPREAD( zu, 2, statistic_regions+1 )
9908
9909	CASE( 'PM0.1' )
9910	salsa_pr_count = salsa_pr_count + 1
9911	salsa_pr_index(salsa_pr_count) = 4
9912	dopr_index(var_count) = pr_palm + salsa_pr_count
9913	dopr_unit = 'kg/m3'
9914	unit = dopr_unit
9915	hom(:,2,dopr_index(var_count),:) = SPREAD( zu, 2, statistic_regions+1 )
9916
9917	CASE( 'PM2.5' )
9918	salsa_pr_count = salsa_pr_count + 1
9919	salsa_pr_index(salsa_pr_count) = 5
9920	dopr_index(var_count) = pr_palm + salsa_pr_count
9921	dopr_unit = 'kg/m3'
9922	unit = dopr_unit
9923	hom(:,2,dopr_index(var_count),:) = SPREAD( zu, 2, statistic_regions+1 )
9924
9925	CASE( 'PM10' )
9926	salsa_pr_count = salsa_pr_count + 1
9927	salsa_pr_index(salsa_pr_count) = 6
9928	dopr_index(var_count) = pr_palm + salsa_pr_count
9929	dopr_unit = 'kg/m3'
9930	unit = dopr_unit
9931	hom(:,2,dopr_index(var_count),:) = SPREAD( zu, 2, statistic_regions+1 )
9932
9933	CASE DEFAULT
9934	unit = 'illegal'
9935
9936	END SELECT
9937
9938
9939	END SUBROUTINE salsa_check_data_output_pr
9940
9941	!-------------------------------------------------------------------------------!
9942	!> Description:
9943	!> Calculation of horizontally averaged profiles for salsa.
9944	!-------------------------------------------------------------------------------!
9945	SUBROUTINE salsa_statistics( mode, sr, tn )
9946
9947	USE control_parameters, &
9948	ONLY: max_pr_user
9949
9950	USE chem_modules, &
9951	ONLY: max_pr_cs
9952
9953	USE statistics, &
9954	ONLY: pr_palm, rmask, sums_l
9955
9956	IMPLICIT NONE
9957
9958	CHARACTER(LEN=*) :: mode !<
9959
9960	INTEGER(iwp) :: i !< loop index
9961	INTEGER(iwp) :: ib !< loop index
9962	INTEGER(iwp) :: ic !< loop index
9963	INTEGER(iwp) :: ii !< loop index
9964	INTEGER(iwp) :: ind !< index in the statistical output
9965	INTEGER(iwp) :: j !< loop index
9966	INTEGER(iwp) :: k !< loop index
9967	INTEGER(iwp) :: sr !< statistical region
9968	INTEGER(iwp) :: tn !< thread number
9969
9970	REAL(wp) :: df !< For calculating LDSA: fraction of particles depositing in the alveolar
9971	!< (or tracheobronchial) region of the lung. Depends on the particle size
9972	REAL(wp) :: mean_d !< Particle diameter in micrometres
9973	REAL(wp) :: temp_bin !< temporary variable
9974
9975	IF ( mode == 'profiles' ) THEN
9976	!$OMP DO
9977	DO ii = 1, salsa_pr_count
9978
9979	ind = pr_palm + max_pr_user + max_pr_cs + ii
9980
9981	SELECT CASE( salsa_pr_index(ii) )
9982
9983	CASE( 1 ) ! LDSA
9984	DO i = nxl, nxr
9985	DO j = nys, nyn
9986	DO k = nzb, nzt+1
9987	temp_bin = 0.0_wp
9988	DO ib = 1, nbins_aerosol
9989	!
9990	!-- Diameter in micrometres
9991	mean_d = 1.0E+6_wp * ra_dry(k,j,i,ib) * 2.0_wp
9992	!
9993	!-- Deposition factor: alveolar
9994	df = ( 0.01555_wp / mean_d ) * ( EXP( -0.416_wp * ( LOG( mean_d ) + &
9995	2.84_wp )*2 ) + 19.11_wp EXP( -0.482_wp * ( LOG( mean_d ) - &
9996	1.362_wp )**2 ) )
9997	!
9998	!-- Lung-deposited surface area LDSA (units mum2/cm3)
9999	temp_bin = temp_bin + pi * mean_d*2 df * 1.0E-6_wp * &
10000	aerosol_number(ib)%conc(k,j,i)
10001	ENDDO
10002	sums_l(k,ind,tn) = sums_l(k,ind,tn) + temp_bin * rmask(j,i,sr) * &
10003	MERGE( 1.0_wp, 0.0_wp, &
10004	BTEST( wall_flags_total_0(k,j,i), 22 ) )
10005	ENDDO
10006	ENDDO
10007	ENDDO
10008
10009	CASE( 2 ) ! N_UFP
10010	DO i = nxl, nxr
10011	DO j = nys, nyn
10012	DO k = nzb, nzt+1
10013	temp_bin = 0.0_wp
10014	DO ib = 1, nbins_aerosol
10015	IF ( 2.0_wp * ra_dry(k,j,i,ib) <= 0.1E-6_wp ) &
10016	temp_bin = temp_bin + aerosol_number(ib)%conc(k,j,i)
10017	ENDDO
10018	sums_l(k,ind,tn) = sums_l(k,ind,tn) + temp_bin * rmask(j,i,sr) * &
10019	MERGE( 1.0_wp, 0.0_wp, &
10020	BTEST( wall_flags_total_0(k,j,i), 22 ) )
10021	ENDDO
10022	ENDDO
10023	ENDDO
10024
10025	CASE( 3 ) ! Ntot
10026	DO i = nxl, nxr
10027	DO j = nys, nyn
10028	DO k = nzb, nzt+1
10029	temp_bin = 0.0_wp
10030	DO ib = 1, nbins_aerosol
10031	temp_bin = temp_bin + aerosol_number(ib)%conc(k,j,i)
10032	ENDDO
10033	sums_l(k,ind,tn) = sums_l(k,ind,tn) + temp_bin * rmask(j,i,sr) * &
10034	MERGE( 1.0_wp, 0.0_wp, &
10035	BTEST( wall_flags_total_0(k,j,i), 22 ) )
10036	ENDDO
10037	ENDDO
10038	ENDDO
10039
10040	CASE( 4 ) ! PM0.1
10041	DO i = nxl, nxr
10042	DO j = nys, nyn
10043	DO k = nzb, nzt+1
10044	temp_bin = 0.0_wp
10045	DO ib = 1, nbins_aerosol
10046	IF ( 2.0_wp * ra_dry(k,j,i,ib) <= 0.1E-6_wp ) THEN
10047	DO ic = ib, nbins_aerosol * ncc, nbins_aerosol
10048	temp_bin = temp_bin + aerosol_mass(ic)%conc(k,j,i)
10049	ENDDO
10050	ENDIF
10051	ENDDO
10052	sums_l(k,ind,tn) = sums_l(k,ind,tn) + temp_bin * rmask(j,i,sr) * &
10053	MERGE( 1.0_wp, 0.0_wp, &
10054	BTEST( wall_flags_total_0(k,j,i), 22 ) )
10055	ENDDO
10056	ENDDO
10057	ENDDO
10058
10059	CASE( 5 ) ! PM2.5
10060	DO i = nxl, nxr
10061	DO j = nys, nyn
10062	DO k = nzb, nzt+1
10063	temp_bin = 0.0_wp
10064	DO ib = 1, nbins_aerosol
10065	IF ( 2.0_wp * ra_dry(k,j,i,ib) <= 2.5E-6_wp ) THEN
10066	DO ic = ib, nbins_aerosol * ncc, nbins_aerosol
10067	temp_bin = temp_bin + aerosol_mass(ic)%conc(k,j,i)
10068	ENDDO
10069	ENDIF
10070	ENDDO
10071	sums_l(k,ind,tn) = sums_l(k,ind,tn) + temp_bin * rmask(j,i,sr) * &
10072	MERGE( 1.0_wp, 0.0_wp, &
10073	BTEST( wall_flags_total_0(k,j,i), 22 ) )
10074	ENDDO
10075	ENDDO
10076	ENDDO
10077
10078	CASE( 6 ) ! PM10
10079	DO i = nxl, nxr
10080	DO j = nys, nyn
10081	DO k = nzb, nzt+1
10082	temp_bin = 0.0_wp
10083	DO ib = 1, nbins_aerosol
10084	IF ( 2.0_wp * ra_dry(k,j,i,ib) <= 10.0E-6_wp ) THEN
10085	DO ic = ib, nbins_aerosol * ncc, nbins_aerosol
10086	temp_bin = temp_bin + aerosol_mass(ic)%conc(k,j,i)
10087	ENDDO
10088	ENDIF
10089	ENDDO
10090	sums_l(k,ind,tn) = sums_l(k,ind,tn) + temp_bin * rmask(j,i,sr) * &
10091	MERGE( 1.0_wp, 0.0_wp, &
10092	BTEST( wall_flags_total_0(k,j,i), 22 ) )
10093	ENDDO
10094	ENDDO
10095	ENDDO
10096
10097	END SELECT
10098	ENDDO
10099
10100	ELSEIF ( mode == 'time_series' ) THEN
10101	!
10102	!-- TODO
10103	ENDIF
10104
10105	END SUBROUTINE salsa_statistics
10106
10107
10108	!------------------------------------------------------------------------------!
10109	!
10110	! Description:
10111	! ------------
10112	!> Subroutine for averaging 3D data
10113	!------------------------------------------------------------------------------!
10114	SUBROUTINE salsa_3d_data_averaging( mode, variable )
10115
10116	USE control_parameters, &
10117	ONLY: average_count_3d
10118
10119	IMPLICIT NONE
10120
10121	CHARACTER(LEN=*) :: mode !<
10122	CHARACTER(LEN=10) :: vari !<
10123	CHARACTER(LEN=*) :: variable !<
10124
10125	INTEGER(iwp) :: char_to_int !< for converting character to integer
10126	INTEGER(iwp) :: found_index !<
10127	INTEGER(iwp) :: i !<
10128	INTEGER(iwp) :: ib !<
10129	INTEGER(iwp) :: ic !<
10130	INTEGER(iwp) :: j !<
10131	INTEGER(iwp) :: k !<
10132
10133	REAL(wp) :: df !< For calculating LDSA: fraction of particles depositing in the alveolar
10134	!< (or tracheobronchial) region of the lung. Depends on the particle size
10135	REAL(wp) :: mean_d !< Particle diameter in micrometres
10136	REAL(wp) :: temp_bin !< temporary variable
10137
10138	REAL(wp), DIMENSION(:,:,:), POINTER :: to_be_resorted !< points to selected output variable
10139
10140	temp_bin = 0.0_wp
10141
10142	IF ( mode == 'allocate' ) THEN
10143
10144	IF ( variable(7:11) == 'N_bin' ) THEN
10145	IF ( .NOT. ALLOCATED( nbins_av ) ) THEN
10146	ALLOCATE( nbins_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg,nbins_aerosol) )
10147	ENDIF
10148	nbins_av = 0.0_wp
10149
10150	ELSEIF ( variable(7:11) == 'm_bin' ) THEN
10151	IF ( .NOT. ALLOCATED( mbins_av ) ) THEN
10152	ALLOCATE( mbins_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg,nbins_aerosol) )
10153	ENDIF
10154	mbins_av = 0.0_wp
10155
10156	ELSE
10157
10158	SELECT CASE ( TRIM( variable(7:) ) )
10159
10160	CASE ( 'g_H2SO4' )
10161	IF ( .NOT. ALLOCATED( g_h2so4_av ) ) THEN
10162	ALLOCATE( g_h2so4_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
10163	ENDIF
10164	g_h2so4_av = 0.0_wp
10165
10166	CASE ( 'g_HNO3' )
10167	IF ( .NOT. ALLOCATED( g_hno3_av ) ) THEN
10168	ALLOCATE( g_hno3_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
10169	ENDIF
10170	g_hno3_av = 0.0_wp
10171
10172	CASE ( 'g_NH3' )
10173	IF ( .NOT. ALLOCATED( g_nh3_av ) ) THEN
10174	ALLOCATE( g_nh3_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
10175	ENDIF
10176	g_nh3_av = 0.0_wp
10177
10178	CASE ( 'g_OCNV' )
10179	IF ( .NOT. ALLOCATED( g_ocnv_av ) ) THEN
10180	ALLOCATE( g_ocnv_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
10181	ENDIF
10182	g_ocnv_av = 0.0_wp
10183
10184	CASE ( 'g_OCSV' )
10185	IF ( .NOT. ALLOCATED( g_ocsv_av ) ) THEN
10186	ALLOCATE( g_ocsv_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
10187	ENDIF
10188	g_ocsv_av = 0.0_wp
10189
10190	CASE ( 'LDSA' )
10191	IF ( .NOT. ALLOCATED( ldsa_av ) ) THEN
10192	ALLOCATE( ldsa_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
10193	ENDIF
10194	ldsa_av = 0.0_wp
10195
10196	CASE ( 'N_UFP' )
10197	IF ( .NOT. ALLOCATED( nufp_av ) ) THEN
10198	ALLOCATE( nufp_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
10199	ENDIF
10200	nufp_av = 0.0_wp
10201
10202	CASE ( 'Ntot' )
10203	IF ( .NOT. ALLOCATED( ntot_av ) ) THEN
10204	ALLOCATE( ntot_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
10205	ENDIF
10206	ntot_av = 0.0_wp
10207
10208	CASE ( 'PM0.1' )
10209	IF ( .NOT. ALLOCATED( pm01_av ) ) THEN
10210	ALLOCATE( pm01_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
10211	ENDIF
10212	pm01_av = 0.0_wp
10213
10214	CASE ( 'PM2.5' )
10215	IF ( .NOT. ALLOCATED( pm25_av ) ) THEN
10216	ALLOCATE( pm25_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
10217	ENDIF
10218	pm25_av = 0.0_wp
10219
10220	CASE ( 'PM10' )
10221	IF ( .NOT. ALLOCATED( pm10_av ) ) THEN
10222	ALLOCATE( pm10_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
10223	ENDIF
10224	pm10_av = 0.0_wp
10225
10226	CASE ( 's_BC' )
10227	IF ( .NOT. ALLOCATED( s_bc_av ) ) THEN
10228	ALLOCATE( s_bc_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
10229	ENDIF
10230	s_bc_av = 0.0_wp
10231
10232	CASE ( 's_DU' )
10233	IF ( .NOT. ALLOCATED( s_du_av ) ) THEN
10234	ALLOCATE( s_du_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
10235	ENDIF
10236	s_du_av = 0.0_wp
10237
10238	CASE ( 's_H2O' )
10239	IF ( .NOT. ALLOCATED( s_h2o_av ) ) THEN
10240	ALLOCATE( s_h2o_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
10241	ENDIF
10242	s_h2o_av = 0.0_wp
10243
10244	CASE ( 's_NH' )
10245	IF ( .NOT. ALLOCATED( s_nh_av ) ) THEN
10246	ALLOCATE( s_nh_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
10247	ENDIF
10248	s_nh_av = 0.0_wp
10249
10250	CASE ( 's_NO' )
10251	IF ( .NOT. ALLOCATED( s_no_av ) ) THEN
10252	ALLOCATE( s_no_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
10253	ENDIF
10254	s_no_av = 0.0_wp
10255
10256	CASE ( 's_OC' )
10257	IF ( .NOT. ALLOCATED( s_oc_av ) ) THEN
10258	ALLOCATE( s_oc_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
10259	ENDIF
10260	s_oc_av = 0.0_wp
10261
10262	CASE ( 's_SO4' )
10263	IF ( .NOT. ALLOCATED( s_so4_av ) ) THEN
10264	ALLOCATE( s_so4_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
10265	ENDIF
10266	s_so4_av = 0.0_wp
10267
10268	CASE ( 's_SS' )
10269	IF ( .NOT. ALLOCATED( s_ss_av ) ) THEN
10270	ALLOCATE( s_ss_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
10271	ENDIF
10272	s_ss_av = 0.0_wp
10273
10274	CASE DEFAULT
10275	CONTINUE
10276
10277	END SELECT
10278
10279	ENDIF
10280
10281	ELSEIF ( mode == 'sum' ) THEN
10282
10283	IF ( variable(7:11) == 'N_bin' ) THEN
10284	READ( variable(12:),* ) char_to_int
10285	IF ( char_to_int >= 1 .AND. char_to_int <= SUM( nbin ) ) THEN
10286	ib = char_to_int
10287	DO i = nxlg, nxrg
10288	DO j = nysg, nyng
10289	DO k = nzb, nzt+1
10290	nbins_av(k,j,i,ib) = nbins_av(k,j,i,ib) + aerosol_number(ib)%conc(k,j,i)
10291	ENDDO
10292	ENDDO
10293	ENDDO
10294	ENDIF
10295
10296	ELSEIF ( variable(7:11) == 'm_bin' ) THEN
10297	READ( variable(12:),* ) char_to_int
10298	IF ( char_to_int >= 1 .AND. char_to_int <= SUM( nbin ) ) THEN
10299	ib = char_to_int
10300	DO i = nxlg, nxrg
10301	DO j = nysg, nyng
10302	DO k = nzb, nzt+1
10303	temp_bin = 0.0_wp
10304	DO ic = ib, nbins_aerosol * ncomponents_mass, nbins_aerosol
10305	temp_bin = temp_bin + aerosol_mass(ic)%conc(k,j,i)
10306	ENDDO
10307	mbins_av(k,j,i,ib) = mbins_av(k,j,i,ib) + temp_bin
10308	ENDDO
10309	ENDDO
10310	ENDDO
10311	ENDIF
10312	ELSE
10313
10314	SELECT CASE ( TRIM( variable(7:) ) )
10315
10316	CASE ( 'g_H2SO4', 'g_HNO3', 'g_NH3', 'g_OCNV', 'g_OCSV' )
10317
10318	vari = TRIM( variable(9:) ) ! remove salsa_g_ from beginning
10319
10320	SELECT CASE( vari )
10321
10322	CASE( 'H2SO4' )
10323	found_index = 1
10324	to_be_resorted => g_h2so4_av
10325
10326	CASE( 'HNO3' )
10327	found_index = 2
10328	to_be_resorted => g_hno3_av
10329
10330	CASE( 'NH3' )
10331	found_index = 3
10332	to_be_resorted => g_nh3_av
10333
10334	CASE( 'OCNV' )
10335	found_index = 4
10336	to_be_resorted => g_ocnv_av
10337
10338	CASE( 'OCSV' )
10339	found_index = 5
10340	to_be_resorted => g_ocsv_av
10341
10342	END SELECT
10343
10344	DO i = nxlg, nxrg
10345	DO j = nysg, nyng
10346	DO k = nzb, nzt+1
10347	to_be_resorted(k,j,i) = to_be_resorted(k,j,i) + &
10348	salsa_gas(found_index)%conc(k,j,i)
10349	ENDDO
10350	ENDDO
10351	ENDDO
10352
10353	CASE ( 'LDSA' )
10354	DO i = nxlg, nxrg
10355	DO j = nysg, nyng
10356	DO k = nzb, nzt+1
10357	temp_bin = 0.0_wp
10358	DO ib = 1, nbins_aerosol
10359	!
10360	!-- Diameter in micrometres
10361	mean_d = 1.0E+6_wp * ra_dry(k,j,i,ib) * 2.0_wp
10362	!
10363	!-- Deposition factor: alveolar (use ra_dry)
10364	df = ( 0.01555_wp / mean_d ) * ( EXP( -0.416_wp * ( LOG( mean_d ) + &
10365	2.84_wp )*2 ) + 19.11_wp EXP( -0.482_wp * ( LOG( mean_d ) - &
10366	1.362_wp )**2 ) )
10367	!
10368	!-- Lung-deposited surface area LDSA (units mum2/cm3)
10369	temp_bin = temp_bin + pi * mean_d*2 df * 1.0E-6_wp * &
10370	aerosol_number(ib)%conc(k,j,i)
10371	ENDDO
10372	ldsa_av(k,j,i) = ldsa_av(k,j,i) + temp_bin
10373	ENDDO
10374	ENDDO
10375	ENDDO
10376
10377	CASE ( 'N_UFP' )
10378	DO i = nxlg, nxrg
10379	DO j = nysg, nyng
10380	DO k = nzb, nzt+1
10381	temp_bin = 0.0_wp
10382	DO ib = 1, nbins_aerosol
10383	IF ( 2.0_wp * ra_dry(k,j,i,ib) <= 0.1E-6_wp ) THEN
10384	temp_bin = temp_bin + aerosol_number(ib)%conc(k,j,i)
10385	ENDIF
10386	ENDDO
10387	nufp_av(k,j,i) = nufp_av(k,j,i) + temp_bin
10388	ENDDO
10389	ENDDO
10390	ENDDO
10391
10392	CASE ( 'Ntot' )
10393	DO i = nxlg, nxrg
10394	DO j = nysg, nyng
10395	DO k = nzb, nzt+1
10396	DO ib = 1, nbins_aerosol
10397	ntot_av(k,j,i) = ntot_av(k,j,i) + aerosol_number(ib)%conc(k,j,i)
10398	ENDDO
10399	ENDDO
10400	ENDDO
10401	ENDDO
10402
10403	CASE ( 'PM0.1' )
10404	DO i = nxlg, nxrg
10405	DO j = nysg, nyng
10406	DO k = nzb, nzt+1
10407	temp_bin = 0.0_wp
10408	DO ib = 1, nbins_aerosol
10409	IF ( 2.0_wp * ra_dry(k,j,i,ib) <= 0.1E-6_wp ) THEN
10410	DO ic = ib, nbins_aerosol * ncc, nbins_aerosol
10411	temp_bin = temp_bin + aerosol_mass(ic)%conc(k,j,i)
10412	ENDDO
10413	ENDIF
10414	ENDDO
10415	pm01_av(k,j,i) = pm01_av(k,j,i) + temp_bin
10416	ENDDO
10417	ENDDO
10418	ENDDO
10419
10420	CASE ( 'PM2.5' )
10421	DO i = nxlg, nxrg
10422	DO j = nysg, nyng
10423	DO k = nzb, nzt+1
10424	temp_bin = 0.0_wp
10425	DO ib = 1, nbins_aerosol
10426	IF ( 2.0_wp * ra_dry(k,j,i,ib) <= 2.5E-6_wp ) THEN
10427	DO ic = ib, nbins_aerosol * ncc, nbins_aerosol
10428	temp_bin = temp_bin + aerosol_mass(ic)%conc(k,j,i)
10429	ENDDO
10430	ENDIF
10431	ENDDO
10432	pm25_av(k,j,i) = pm25_av(k,j,i) + temp_bin
10433	ENDDO
10434	ENDDO
10435	ENDDO
10436
10437	CASE ( 'PM10' )
10438	DO i = nxlg, nxrg
10439	DO j = nysg, nyng
10440	DO k = nzb, nzt+1
10441	temp_bin = 0.0_wp
10442	DO ib = 1, nbins_aerosol
10443	IF ( 2.0_wp * ra_dry(k,j,i,ib) <= 10.0E-6_wp ) THEN
10444	DO ic = ib, nbins_aerosol * ncc, nbins_aerosol
10445	temp_bin = temp_bin + aerosol_mass(ic)%conc(k,j,i)
10446	ENDDO
10447	ENDIF
10448	ENDDO
10449	pm10_av(k,j,i) = pm10_av(k,j,i) + temp_bin
10450	ENDDO
10451	ENDDO
10452	ENDDO
10453
10454	CASE ( 's_BC', 's_DU', 's_NH', 's_NO', 's_OC', 's_SO4', 's_SS' )
10455	IF ( is_used( prtcl, TRIM( variable(9:) ) ) ) THEN ! 9: remove salsa_s_
10456	found_index = get_index( prtcl, TRIM( variable(9:) ) )
10457	IF ( TRIM( variable(9:) ) == 'BC' ) to_be_resorted => s_bc_av
10458	IF ( TRIM( variable(9:) ) == 'DU' ) to_be_resorted => s_du_av
10459	IF ( TRIM( variable(9:) ) == 'NH' ) to_be_resorted => s_nh_av
10460	IF ( TRIM( variable(9:) ) == 'NO' ) to_be_resorted => s_no_av
10461	IF ( TRIM( variable(9:) ) == 'OC' ) to_be_resorted => s_oc_av
10462	IF ( TRIM( variable(9:) ) == 'SO4' ) to_be_resorted => s_so4_av
10463	IF ( TRIM( variable(9:) ) == 'SS' ) to_be_resorted => s_ss_av
10464	DO i = nxlg, nxrg
10465	DO j = nysg, nyng
10466	DO k = nzb, nzt+1
10467	DO ic = ( found_index-1 ) * nbins_aerosol + 1, found_index * nbins_aerosol
10468	to_be_resorted(k,j,i) = to_be_resorted(k,j,i) + &
10469	aerosol_mass(ic)%conc(k,j,i)
10470	ENDDO
10471	ENDDO
10472	ENDDO
10473	ENDDO
10474	ENDIF
10475
10476	CASE ( 's_H2O' )
10477	found_index = get_index( prtcl,'H2O' )
10478	to_be_resorted => s_h2o_av
10479	DO i = nxlg, nxrg
10480	DO j = nysg, nyng
10481	DO k = nzb, nzt+1
10482	DO ic = ( found_index-1 ) * nbins_aerosol + 1, found_index * nbins_aerosol
10483	s_h2o_av(k,j,i) = s_h2o_av(k,j,i) + aerosol_mass(ic)%conc(k,j,i)
10484	ENDDO
10485	ENDDO
10486	ENDDO
10487	ENDDO
10488
10489	CASE DEFAULT
10490	CONTINUE
10491
10492	END SELECT
10493
10494	ENDIF
10495
10496	ELSEIF ( mode == 'average' ) THEN
10497
10498	IF ( variable(7:11) == 'N_bin' ) THEN
10499	READ( variable(12:),* ) char_to_int
10500	IF ( char_to_int >= 1 .AND. char_to_int <= SUM( nbin ) ) THEN
10501	ib = char_to_int
10502	DO i = nxlg, nxrg
10503	DO j = nysg, nyng
10504	DO k = nzb, nzt+1
10505	nbins_av(k,j,i,ib) = nbins_av(k,j,i,ib) / REAL( average_count_3d, KIND=wp )
10506	ENDDO
10507	ENDDO
10508	ENDDO
10509	ENDIF
10510
10511	ELSEIF ( variable(7:11) == 'm_bin' ) THEN
10512	READ( variable(12:),* ) char_to_int
10513	IF ( char_to_int >= 1 .AND. char_to_int <= SUM( nbin ) ) THEN
10514	ib = char_to_int
10515	DO i = nxlg, nxrg
10516	DO j = nysg, nyng
10517	DO k = nzb, nzt+1
10518	mbins_av(k,j,i,ib) = mbins_av(k,j,i,ib) / REAL( average_count_3d, KIND=wp)
10519	ENDDO
10520	ENDDO
10521	ENDDO
10522	ENDIF
10523	ELSE
10524
10525	SELECT CASE ( TRIM( variable(7:) ) )
10526
10527	CASE ( 'g_H2SO4', 'g_HNO3', 'g_NH3', 'g_OCNV', 'g_OCSV' )
10528	IF ( TRIM( variable(9:) ) == 'H2SO4' ) THEN ! 9: remove salsa_g_ from beginning
10529	found_index = 1
10530	to_be_resorted => g_h2so4_av
10531	ELSEIF ( TRIM( variable(9:) ) == 'HNO3' ) THEN
10532	found_index = 2
10533	to_be_resorted => g_hno3_av
10534	ELSEIF ( TRIM( variable(9:) ) == 'NH3' ) THEN
10535	found_index = 3
10536	to_be_resorted => g_nh3_av
10537	ELSEIF ( TRIM( variable(9:) ) == 'OCNV' ) THEN
10538	found_index = 4
10539	to_be_resorted => g_ocnv_av
10540	ELSEIF ( TRIM( variable(9:) ) == 'OCSV' ) THEN
10541	found_index = 5
10542	to_be_resorted => g_ocsv_av
10543	ENDIF
10544	DO i = nxlg, nxrg
10545	DO j = nysg, nyng
10546	DO k = nzb, nzt+1
10547	to_be_resorted(k,j,i) = to_be_resorted(k,j,i) / &
10548	REAL( average_count_3d, KIND=wp )
10549	ENDDO
10550	ENDDO
10551	ENDDO
10552
10553	CASE ( 'LDSA' )
10554	DO i = nxlg, nxrg
10555	DO j = nysg, nyng
10556	DO k = nzb, nzt+1
10557	ldsa_av(k,j,i) = ldsa_av(k,j,i) / REAL( average_count_3d, KIND=wp )
10558	ENDDO
10559	ENDDO
10560	ENDDO
10561
10562	CASE ( 'N_UFP' )
10563	DO i = nxlg, nxrg
10564	DO j = nysg, nyng
10565	DO k = nzb, nzt+1
10566	nufp_av(k,j,i) = nufp_av(k,j,i) / REAL( average_count_3d, KIND=wp )
10567	ENDDO
10568	ENDDO
10569	ENDDO
10570
10571	CASE ( 'Ntot' )
10572	DO i = nxlg, nxrg
10573	DO j = nysg, nyng
10574	DO k = nzb, nzt+1
10575	ntot_av(k,j,i) = ntot_av(k,j,i) / REAL( average_count_3d, KIND=wp )
10576	ENDDO
10577	ENDDO
10578	ENDDO
10579
10580
10581	CASE ( 'PM0.1' )
10582	DO i = nxlg, nxrg
10583	DO j = nysg, nyng
10584	DO k = nzb, nzt+1
10585	pm01_av(k,j,i) = pm01_av(k,j,i) / REAL( average_count_3d, KIND=wp )
10586	ENDDO
10587	ENDDO
10588	ENDDO
10589
10590	CASE ( 'PM2.5' )
10591	DO i = nxlg, nxrg
10592	DO j = nysg, nyng
10593	DO k = nzb, nzt+1
10594	pm25_av(k,j,i) = pm25_av(k,j,i) / REAL( average_count_3d, KIND=wp )
10595	ENDDO
10596	ENDDO
10597	ENDDO
10598
10599	CASE ( 'PM10' )
10600	DO i = nxlg, nxrg
10601	DO j = nysg, nyng
10602	DO k = nzb, nzt+1
10603	pm10_av(k,j,i) = pm10_av(k,j,i) / REAL( average_count_3d, KIND=wp )
10604	ENDDO
10605	ENDDO
10606	ENDDO
10607
10608	CASE ( 's_BC', 's_DU', 's_NH', 's_NO', 's_OC', 's_SO4', 's_SS' )
10609	IF ( is_used( prtcl, TRIM( variable(9:) ) ) ) THEN ! 9: remove salsa_s_
10610	IF ( TRIM( variable(9:) ) == 'BC' ) to_be_resorted => s_bc_av
10611	IF ( TRIM( variable(9:) ) == 'DU' ) to_be_resorted => s_du_av
10612	IF ( TRIM( variable(9:) ) == 'NH' ) to_be_resorted => s_nh_av
10613	IF ( TRIM( variable(9:) ) == 'NO' ) to_be_resorted => s_no_av
10614	IF ( TRIM( variable(9:) ) == 'OC' ) to_be_resorted => s_oc_av
10615	IF ( TRIM( variable(9:) ) == 'SO4' ) to_be_resorted => s_so4_av
10616	IF ( TRIM( variable(9:) ) == 'SS' ) to_be_resorted => s_ss_av
10617	DO i = nxlg, nxrg
10618	DO j = nysg, nyng
10619	DO k = nzb, nzt+1
10620	to_be_resorted(k,j,i) = to_be_resorted(k,j,i) / &
10621	REAL( average_count_3d, KIND=wp )
10622	ENDDO
10623	ENDDO
10624	ENDDO
10625	ENDIF
10626
10627	CASE ( 's_H2O' )
10628	to_be_resorted => s_h2o_av
10629	DO i = nxlg, nxrg
10630	DO j = nysg, nyng
10631	DO k = nzb, nzt+1
10632	to_be_resorted(k,j,i) = to_be_resorted(k,j,i) / &
10633	REAL( average_count_3d, KIND=wp )
10634	ENDDO
10635	ENDDO
10636	ENDDO
10637
10638	END SELECT
10639
10640	ENDIF
10641	ENDIF
10642
10643	END SUBROUTINE salsa_3d_data_averaging
10644
10645
10646	!------------------------------------------------------------------------------!
10647	!
10648	! Description:
10649	! ------------
10650	!> Subroutine defining 2D output variables
10651	!------------------------------------------------------------------------------!
10652	SUBROUTINE salsa_data_output_2d( av, variable, found, grid, mode, local_pf, two_d, nzb_do, nzt_do )
10653
10654	USE indices
10655
10656	USE kinds
10657
10658
10659	IMPLICIT NONE
10660
10661	CHARACTER(LEN=*) :: grid !<
10662	CHARACTER(LEN=*) :: mode !<
10663	CHARACTER(LEN=*) :: variable !<
10664	CHARACTER(LEN=5) :: vari !< trimmed format of variable
10665
10666	INTEGER(iwp) :: av !<
10667	INTEGER(iwp) :: char_to_int !< for converting character to integer
10668	INTEGER(iwp) :: found_index !< index of a chemical compound
10669	INTEGER(iwp) :: i !<
10670	INTEGER(iwp) :: ib !< running index: size bins
10671	INTEGER(iwp) :: ic !< running index: mass bins
10672	INTEGER(iwp) :: j !<
10673	INTEGER(iwp) :: k !<
10674	INTEGER(iwp) :: nzb_do !<
10675	INTEGER(iwp) :: nzt_do !<
10676
10677	LOGICAL :: found !<
10678	LOGICAL :: two_d !< flag parameter to indicate 2D variables (horizontal cross sections)
10679
10680	REAL(wp) :: df !< For calculating LDSA: fraction of particles
10681	!< depositing in the alveolar (or tracheobronchial)
10682	!< region of the lung. Depends on the particle size
10683	REAL(wp) :: mean_d !< Particle diameter in micrometres
10684	REAL(wp) :: temp_bin !< temporary array for calculating output variables
10685
10686	REAL(wp), DIMENSION(nxl:nxr,nys:nyn,nzb_do:nzt_do) :: local_pf !< output
10687
10688	REAL(wp), DIMENSION(:,:,:), POINTER :: to_be_resorted !< pointer
10689	!
10690	!-- Next statement is to avoid compiler warning about unused variable. May be removed in future.
10691	IF ( two_d ) CONTINUE
10692
10693	found = .TRUE.
10694	temp_bin = 0.0_wp
10695
10696	IF ( variable(7:11) == 'N_bin' ) THEN
10697
10698	READ( variable( 12:LEN( TRIM( variable ) ) - 3 ), * ) char_to_int
10699	IF ( char_to_int >= 1 .AND. char_to_int <= SUM( nbin ) ) THEN
10700
10701	ib = char_to_int
10702	IF ( av == 0 ) THEN
10703	DO i = nxl, nxr
10704	DO j = nys, nyn
10705	DO k = nzb_do, nzt_do
10706	local_pf(i,j,k) = MERGE( aerosol_number(ib)%conc(k,j,i), REAL( fill_value, &
10707	KIND = wp ), BTEST( wall_flags_total_0(k,j,i), 0 ) )
10708	ENDDO
10709	ENDDO
10710	ENDDO
10711	ELSE
10712	DO i = nxl, nxr
10713	DO j = nys, nyn
10714	DO k = nzb_do, nzt_do
10715	local_pf(i,j,k) = MERGE( nbins_av(k,j,i,ib), REAL( fill_value, KIND = wp ), &
10716	BTEST( wall_flags_total_0(k,j,i), 0 ) )
10717	ENDDO
10718	ENDDO
10719	ENDDO
10720	ENDIF
10721	IF ( mode == 'xy' ) grid = 'zu'
10722	ENDIF
10723
10724	ELSEIF ( variable(7:11) == 'm_bin' ) THEN
10725
10726	READ( variable( 12:LEN( TRIM( variable ) ) - 3 ), * ) char_to_int
10727	IF ( char_to_int >= 1 .AND. char_to_int <= SUM( nbin ) ) THEN
10728
10729	ib = char_to_int
10730	IF ( av == 0 ) THEN
10731	DO i = nxl, nxr
10732	DO j = nys, nyn
10733	DO k = nzb_do, nzt_do
10734	temp_bin = 0.0_wp
10735	DO ic = ib, ncomponents_mass * nbins_aerosol, nbins_aerosol
10736	temp_bin = temp_bin + aerosol_mass(ic)%conc(k,j,i)
10737	ENDDO
10738	local_pf(i,j,k) = MERGE( temp_bin, REAL( fill_value, KIND = wp ), &
10739	BTEST( wall_flags_total_0(k,j,i), 0 ) )
10740	ENDDO
10741	ENDDO
10742	ENDDO
10743	ELSE
10744	DO i = nxl, nxr
10745	DO j = nys, nyn
10746	DO k = nzb_do, nzt_do
10747	local_pf(i,j,k) = MERGE( mbins_av(k,j,i,ib), REAL( fill_value, KIND = wp ), &
10748	BTEST( wall_flags_total_0(k,j,i), 0 ) )
10749	ENDDO
10750	ENDDO
10751	ENDDO
10752	ENDIF
10753	IF ( mode == 'xy' ) grid = 'zu'
10754	ENDIF
10755
10756	ELSE
10757
10758	SELECT CASE ( TRIM( variable( 7:LEN( TRIM( variable ) ) - 3 ) ) ) ! cut out _xy, _xz or _yz
10759
10760	CASE ( 'g_H2SO4', 'g_HNO3', 'g_NH3', 'g_OCNV', 'g_OCSV' )
10761	vari = TRIM( variable( 9:LEN( TRIM( variable ) ) - 3 ) ) ! 9: remove salsa_g_
10762	IF ( av == 0 ) THEN
10763	IF ( vari == 'H2SO4') found_index = 1
10764	IF ( vari == 'HNO3') found_index = 2
10765	IF ( vari == 'NH3') found_index = 3
10766	IF ( vari == 'OCNV') found_index = 4
10767	IF ( vari == 'OCSV') found_index = 5
10768	DO i = nxl, nxr
10769	DO j = nys, nyn
10770	DO k = nzb_do, nzt_do
10771	local_pf(i,j,k) = MERGE( salsa_gas(found_index)%conc(k,j,i), &
10772	REAL( fill_value, KIND = wp ), &
10773	BTEST( wall_flags_total_0(k,j,i), 0 ) )
10774	ENDDO
10775	ENDDO
10776	ENDDO
10777	ELSE
10778	IF ( vari == 'H2SO4' ) to_be_resorted => g_h2so4_av
10779	IF ( vari == 'HNO3' ) to_be_resorted => g_hno3_av
10780	IF ( vari == 'NH3' ) to_be_resorted => g_nh3_av
10781	IF ( vari == 'OCNV' ) to_be_resorted => g_ocnv_av
10782	IF ( vari == 'OCSV' ) to_be_resorted => g_ocsv_av
10783	DO i = nxl, nxr
10784	DO j = nys, nyn
10785	DO k = nzb_do, nzt_do
10786	local_pf(i,j,k) = MERGE( to_be_resorted(k,j,i), REAL( fill_value, &
10787	KIND = wp ), BTEST( wall_flags_total_0(k,j,i), 0 ) )
10788	ENDDO
10789	ENDDO
10790	ENDDO
10791	ENDIF
10792
10793	IF ( mode == 'xy' ) grid = 'zu'
10794
10795	CASE ( 'LDSA' )
10796	IF ( av == 0 ) THEN
10797	DO i = nxl, nxr
10798	DO j = nys, nyn
10799	DO k = nzb_do, nzt_do
10800	temp_bin = 0.0_wp
10801	DO ib = 1, nbins_aerosol
10802	!
10803	!-- Diameter in micrometres
10804	mean_d = 1.0E+6_wp * ra_dry(k,j,i,ib) * 2.0_wp
10805	!
10806	!-- Deposition factor: alveolar
10807	df = ( 0.01555_wp / mean_d ) * ( EXP( -0.416_wp * ( LOG( mean_d ) + &
10808	2.84_wp )*2 ) + 19.11_wp EXP( -0.482_wp * ( LOG( mean_d ) - &
10809	1.362_wp )**2 ) )
10810	!
10811	!-- Lung-deposited surface area LDSA (units mum2/cm3)
10812	temp_bin = temp_bin + pi * mean_d*2 df * 1.0E-6_wp * &
10813	aerosol_number(ib)%conc(k,j,i)
10814	ENDDO
10815
10816	local_pf(i,j,k) = MERGE( temp_bin, REAL( fill_value, KIND = wp ), &
10817	BTEST( wall_flags_total_0(k,j,i), 0 ) )
10818	ENDDO
10819	ENDDO
10820	ENDDO
10821	ELSE
10822	DO i = nxl, nxr
10823	DO j = nys, nyn
10824	DO k = nzb_do, nzt_do
10825	local_pf(i,j,k) = MERGE( ldsa_av(k,j,i), REAL( fill_value, KIND = wp ), &
10826	BTEST( wall_flags_total_0(k,j,i), 0 ) )
10827	ENDDO
10828	ENDDO
10829	ENDDO
10830	ENDIF
10831
10832	IF ( mode == 'xy' ) grid = 'zu'
10833
10834	CASE ( 'N_UFP' )
10835
10836	IF ( av == 0 ) THEN
10837	DO i = nxl, nxr
10838	DO j = nys, nyn
10839	DO k = nzb_do, nzt_do
10840	temp_bin = 0.0_wp
10841	DO ib = 1, nbins_aerosol
10842	IF ( 2.0_wp * ra_dry(k,j,i,ib) <= 0.1E-6_wp ) THEN
10843	temp_bin = temp_bin + aerosol_number(ib)%conc(k,j,i)
10844	ENDIF
10845	ENDDO
10846	local_pf(i,j,k) = MERGE( temp_bin, REAL( fill_value, KIND = wp ), &
10847	BTEST( wall_flags_total_0(k,j,i), 0 ) )
10848	ENDDO
10849	ENDDO
10850	ENDDO
10851	ELSE
10852	DO i = nxl, nxr
10853	DO j = nys, nyn
10854	DO k = nzb_do, nzt_do
10855	local_pf(i,j,k) = MERGE( nufp_av(k,j,i), REAL( fill_value, KIND = wp ), &
10856	BTEST( wall_flags_total_0(k,j,i), 0 ) )
10857	ENDDO
10858	ENDDO
10859	ENDDO
10860	ENDIF
10861
10862	IF ( mode == 'xy' ) grid = 'zu'
10863
10864	CASE ( 'Ntot' )
10865
10866	IF ( av == 0 ) THEN
10867	DO i = nxl, nxr
10868	DO j = nys, nyn
10869	DO k = nzb_do, nzt_do
10870	temp_bin = 0.0_wp
10871	DO ib = 1, nbins_aerosol
10872	temp_bin = temp_bin + aerosol_number(ib)%conc(k,j,i)
10873	ENDDO
10874	local_pf(i,j,k) = MERGE( temp_bin, REAL( fill_value, KIND = wp ), &
10875	BTEST( wall_flags_total_0(k,j,i), 0 ) )
10876	ENDDO
10877	ENDDO
10878	ENDDO
10879	ELSE
10880	DO i = nxl, nxr
10881	DO j = nys, nyn
10882	DO k = nzb_do, nzt_do
10883	local_pf(i,j,k) = MERGE( ntot_av(k,j,i), REAL( fill_value, KIND = wp ), &
10884	BTEST( wall_flags_total_0(k,j,i), 0 ) )
10885	ENDDO
10886	ENDDO
10887	ENDDO
10888	ENDIF
10889
10890	IF ( mode == 'xy' ) grid = 'zu'
10891
10892	CASE ( 'PM0.1' )
10893	IF ( av == 0 ) THEN
10894	DO i = nxl, nxr
10895	DO j = nys, nyn
10896	DO k = nzb_do, nzt_do
10897	temp_bin = 0.0_wp
10898	DO ib = 1, nbins_aerosol
10899	IF ( 2.0_wp * ra_dry(k,j,i,ib) <= 0.1E-6_wp ) THEN
10900	DO ic = ib, nbins_aerosol * ncc, nbins_aerosol
10901	temp_bin = temp_bin + aerosol_mass(ic)%conc(k,j,i)
10902	ENDDO
10903	ENDIF
10904	ENDDO
10905	local_pf(i,j,k) = MERGE( temp_bin, REAL( fill_value, KIND = wp ), &
10906	BTEST( wall_flags_total_0(k,j,i), 0 ) )
10907	ENDDO
10908	ENDDO
10909	ENDDO
10910	ELSE
10911	DO i = nxl, nxr
10912	DO j = nys, nyn
10913	DO k = nzb_do, nzt_do
10914	local_pf(i,j,k) = MERGE( pm01_av(k,j,i), REAL( fill_value, KIND = wp ), &
10915	BTEST( wall_flags_total_0(k,j,i), 0 ) )
10916	ENDDO
10917	ENDDO
10918	ENDDO
10919	ENDIF
10920
10921	IF ( mode == 'xy' ) grid = 'zu'
10922
10923	CASE ( 'PM2.5' )
10924	IF ( av == 0 ) THEN
10925	DO i = nxl, nxr
10926	DO j = nys, nyn
10927	DO k = nzb_do, nzt_do
10928	temp_bin = 0.0_wp
10929	DO ib = 1, nbins_aerosol
10930	IF ( 2.0_wp * ra_dry(k,j,i,ib) <= 2.5E-6_wp ) THEN
10931	DO ic = ib, nbins_aerosol * ncc, nbins_aerosol
10932	temp_bin = temp_bin + aerosol_mass(ic)%conc(k,j,i)
10933	ENDDO
10934	ENDIF
10935	ENDDO
10936	local_pf(i,j,k) = MERGE( temp_bin, REAL( fill_value, KIND = wp ), &
10937	BTEST( wall_flags_total_0(k,j,i), 0 ) )
10938	ENDDO
10939	ENDDO
10940	ENDDO
10941	ELSE
10942	DO i = nxl, nxr
10943	DO j = nys, nyn
10944	DO k = nzb_do, nzt_do
10945	local_pf(i,j,k) = MERGE( pm25_av(k,j,i), REAL( fill_value, KIND = wp ), &
10946	BTEST( wall_flags_total_0(k,j,i), 0 ) )
10947	ENDDO
10948	ENDDO
10949	ENDDO
10950	ENDIF
10951
10952	IF ( mode == 'xy' ) grid = 'zu'
10953
10954	CASE ( 'PM10' )
10955	IF ( av == 0 ) THEN
10956	DO i = nxl, nxr
10957	DO j = nys, nyn
10958	DO k = nzb_do, nzt_do
10959	temp_bin = 0.0_wp
10960	DO ib = 1, nbins_aerosol
10961	IF ( 2.0_wp * ra_dry(k,j,i,ib) <= 10.0E-6_wp ) THEN
10962	DO ic = ib, nbins_aerosol * ncc, nbins_aerosol
10963	temp_bin = temp_bin + aerosol_mass(ic)%conc(k,j,i)
10964	ENDDO
10965	ENDIF
10966	ENDDO
10967	local_pf(i,j,k) = MERGE( temp_bin, REAL( fill_value, KIND = wp ), &
10968	BTEST( wall_flags_total_0(k,j,i), 0 ) )
10969	ENDDO
10970	ENDDO
10971	ENDDO
10972	ELSE
10973	DO i = nxl, nxr
10974	DO j = nys, nyn
10975	DO k = nzb_do, nzt_do
10976	local_pf(i,j,k) = MERGE( pm10_av(k,j,i), REAL( fill_value, KIND = wp ), &
10977	BTEST( wall_flags_total_0(k,j,i), 0 ) )
10978	ENDDO
10979	ENDDO
10980	ENDDO
10981	ENDIF
10982
10983	IF ( mode == 'xy' ) grid = 'zu'
10984
10985	CASE ( 's_BC', 's_DU', 's_NH', 's_NO', 's_OC', 's_SO4', 's_SS' )
10986	vari = TRIM( variable( 9:LEN( TRIM( variable ) ) - 3 ) ) ! 9: remove salsa_s_
10987	IF ( is_used( prtcl, vari ) ) THEN
10988	found_index = get_index( prtcl, vari )
10989	IF ( av == 0 ) THEN
10990	DO i = nxl, nxr
10991	DO j = nys, nyn
10992	DO k = nzb_do, nzt_do
10993	temp_bin = 0.0_wp
10994	DO ic = ( found_index-1 ) * nbins_aerosol+1, found_index * nbins_aerosol
10995	temp_bin = temp_bin + aerosol_mass(ic)%conc(k,j,i)
10996	ENDDO
10997	local_pf(i,j,k) = MERGE( temp_bin, REAL( fill_value, KIND = wp ), &
10998	BTEST( wall_flags_total_0(k,j,i), 0 ) )
10999	ENDDO
11000	ENDDO
11001	ENDDO
11002	ELSE
11003	IF ( vari == 'BC' ) to_be_resorted => s_bc_av
11004	IF ( vari == 'DU' ) to_be_resorted => s_du_av
11005	IF ( vari == 'NH' ) to_be_resorted => s_nh_av
11006	IF ( vari == 'NO' ) to_be_resorted => s_no_av
11007	IF ( vari == 'OC' ) to_be_resorted => s_oc_av
11008	IF ( vari == 'SO4' ) to_be_resorted => s_so4_av
11009	IF ( vari == 'SS' ) to_be_resorted => s_ss_av
11010	DO i = nxl, nxr
11011	DO j = nys, nyn
11012	DO k = nzb_do, nzt_do
11013	local_pf(i,j,k) = MERGE( to_be_resorted(k,j,i), REAL( fill_value, &
11014	KIND = wp ), BTEST( wall_flags_total_0(k,j,i), 0 ) )
11015	ENDDO
11016	ENDDO
11017	ENDDO
11018	ENDIF
11019	ELSE
11020	local_pf = fill_value
11021	ENDIF
11022
11023	IF ( mode == 'xy' ) grid = 'zu'
11024
11025	CASE ( 's_H2O' )
11026	found_index = get_index( prtcl, 'H2O' )
11027	IF ( av == 0 ) THEN
11028	DO i = nxl, nxr
11029	DO j = nys, nyn
11030	DO k = nzb_do, nzt_do
11031	temp_bin = 0.0_wp
11032	DO ic = ( found_index-1 ) * nbins_aerosol+1, found_index * nbins_aerosol
11033	temp_bin = temp_bin + aerosol_mass(ic)%conc(k,j,i)
11034	ENDDO
11035	local_pf(i,j,k) = MERGE( temp_bin, REAL( fill_value, KIND = wp ), &
11036	BTEST( wall_flags_total_0(k,j,i), 0 ) )
11037	ENDDO
11038	ENDDO
11039	ENDDO
11040	ELSE
11041	to_be_resorted => s_h2o_av
11042	DO i = nxl, nxr
11043	DO j = nys, nyn
11044	DO k = nzb_do, nzt_do
11045	local_pf(i,j,k) = MERGE( to_be_resorted(k,j,i), REAL( fill_value, &
11046	KIND = wp ), BTEST( wall_flags_total_0(k,j,i), 0 ) )
11047	ENDDO
11048	ENDDO
11049	ENDDO
11050	ENDIF
11051
11052	IF ( mode == 'xy' ) grid = 'zu'
11053
11054	CASE DEFAULT
11055	found = .FALSE.
11056	grid = 'none'
11057
11058	END SELECT
11059
11060	ENDIF
11061
11062	END SUBROUTINE salsa_data_output_2d
11063
11064	!------------------------------------------------------------------------------!
11065	!
11066	! Description:
11067	! ------------
11068	!> Subroutine defining 3D output variables
11069	!------------------------------------------------------------------------------!
11070	SUBROUTINE salsa_data_output_3d( av, variable, found, local_pf, nzb_do, nzt_do )
11071
11072	USE indices
11073
11074	USE kinds
11075
11076
11077	IMPLICIT NONE
11078
11079	CHARACTER(LEN=*), INTENT(in) :: variable !<
11080
11081	INTEGER(iwp) :: av !<
11082	INTEGER(iwp) :: char_to_int !< for converting character to integer
11083	INTEGER(iwp) :: found_index !< index of a chemical compound
11084	INTEGER(iwp) :: ib !< running index: size bins
11085	INTEGER(iwp) :: ic !< running index: mass bins
11086	INTEGER(iwp) :: i !<
11087	INTEGER(iwp) :: j !<
11088	INTEGER(iwp) :: k !<
11089	INTEGER(iwp) :: nzb_do !<
11090	INTEGER(iwp) :: nzt_do !<
11091
11092	LOGICAL :: found !<
11093
11094	REAL(wp) :: df !< For calculating LDSA: fraction of particles
11095	!< depositing in the alveolar (or tracheobronchial)
11096	!< region of the lung. Depends on the particle size
11097	REAL(wp) :: mean_d !< Particle diameter in micrometres
11098	REAL(wp) :: temp_bin !< temporary array for calculating output variables
11099
11100	REAL(sp), DIMENSION(nxl:nxr,nys:nyn,nzb_do:nzt_do) :: local_pf !< local
11101
11102	REAL(wp), DIMENSION(:,:,:), POINTER :: to_be_resorted !< pointer
11103
11104	found = .TRUE.
11105	temp_bin = 0.0_wp
11106
11107	IF ( variable(7:11) == 'N_bin' ) THEN
11108	READ( variable(12:),* ) char_to_int
11109	IF ( char_to_int >= 1 .AND. char_to_int <= SUM( nbin ) ) THEN
11110
11111	ib = char_to_int
11112	IF ( av == 0 ) THEN
11113	DO i = nxl, nxr
11114	DO j = nys, nyn
11115	DO k = nzb_do, nzt_do
11116	local_pf(i,j,k) = MERGE( aerosol_number(ib)%conc(k,j,i), REAL( fill_value, &
11117	KIND = wp ), BTEST( wall_flags_total_0(k,j,i), 0 ) )
11118	ENDDO
11119	ENDDO
11120	ENDDO
11121	ELSE
11122	DO i = nxl, nxr
11123	DO j = nys, nyn
11124	DO k = nzb_do, nzt_do
11125	local_pf(i,j,k) = MERGE( nbins_av(k,j,i,ib), REAL( fill_value, KIND = wp ), &
11126	BTEST( wall_flags_total_0(k,j,i), 0 ) )
11127	ENDDO
11128	ENDDO
11129	ENDDO
11130	ENDIF
11131	ENDIF
11132
11133	ELSEIF ( variable(7:11) == 'm_bin' ) THEN
11134	READ( variable(12:),* ) char_to_int
11135	IF ( char_to_int >= 1 .AND. char_to_int <= SUM( nbin ) ) THEN
11136
11137	ib = char_to_int
11138	IF ( av == 0 ) THEN
11139	DO i = nxl, nxr
11140	DO j = nys, nyn
11141	DO k = nzb_do, nzt_do
11142	temp_bin = 0.0_wp
11143	DO ic = ib, ncomponents_mass * nbins_aerosol, nbins_aerosol
11144	temp_bin = temp_bin + aerosol_mass(ic)%conc(k,j,i)
11145	ENDDO
11146	local_pf(i,j,k) = MERGE( temp_bin, REAL( fill_value, KIND = wp ), &
11147	BTEST( wall_flags_total_0(k,j,i), 0 ) )
11148	ENDDO
11149	ENDDO
11150	ENDDO
11151	ELSE
11152	DO i = nxl, nxr
11153	DO j = nys, nyn
11154	DO k = nzb_do, nzt_do
11155	local_pf(i,j,k) = MERGE( mbins_av(k,j,i,ib), REAL( fill_value, KIND = wp ), &
11156	BTEST( wall_flags_total_0(k,j,i), 0 ) )
11157	ENDDO
11158	ENDDO
11159	ENDDO
11160	ENDIF
11161	ENDIF
11162
11163	ELSE
11164	SELECT CASE ( TRIM( variable(7:) ) )
11165
11166	CASE ( 'g_H2SO4', 'g_HNO3', 'g_NH3', 'g_OCNV', 'g_OCSV' )
11167	IF ( av == 0 ) THEN
11168	IF ( TRIM( variable(7:) ) == 'g_H2SO4') found_index = 1
11169	IF ( TRIM( variable(7:) ) == 'g_HNO3') found_index = 2
11170	IF ( TRIM( variable(7:) ) == 'g_NH3') found_index = 3
11171	IF ( TRIM( variable(7:) ) == 'g_OCNV') found_index = 4
11172	IF ( TRIM( variable(7:) ) == 'g_OCSV') found_index = 5
11173
11174	DO i = nxl, nxr
11175	DO j = nys, nyn
11176	DO k = nzb_do, nzt_do
11177	local_pf(i,j,k) = MERGE( salsa_gas(found_index)%conc(k,j,i), &
11178	REAL( fill_value, KIND = wp ), &
11179	BTEST( wall_flags_total_0(k,j,i), 0 ) )
11180	ENDDO
11181	ENDDO
11182	ENDDO
11183	ELSE
11184	!
11185	!-- 9: remove salsa_g_ from the beginning
11186	IF ( TRIM( variable(9:) ) == 'H2SO4' ) to_be_resorted => g_h2so4_av
11187	IF ( TRIM( variable(9:) ) == 'HNO3' ) to_be_resorted => g_hno3_av
11188	IF ( TRIM( variable(9:) ) == 'NH3' ) to_be_resorted => g_nh3_av
11189	IF ( TRIM( variable(9:) ) == 'OCNV' ) to_be_resorted => g_ocnv_av
11190	IF ( TRIM( variable(9:) ) == 'OCSV' ) to_be_resorted => g_ocsv_av
11191	DO i = nxl, nxr
11192	DO j = nys, nyn
11193	DO k = nzb_do, nzt_do
11194	local_pf(i,j,k) = MERGE( to_be_resorted(k,j,i), REAL( fill_value, &
11195	KIND = wp ), BTEST( wall_flags_total_0(k,j,i), 0 ) )
11196	ENDDO
11197	ENDDO
11198	ENDDO
11199	ENDIF
11200
11201	CASE ( 'LDSA' )
11202	IF ( av == 0 ) THEN
11203	DO i = nxl, nxr
11204	DO j = nys, nyn
11205	DO k = nzb_do, nzt_do
11206	temp_bin = 0.0_wp
11207	DO ib = 1, nbins_aerosol
11208	!
11209	!-- Diameter in micrometres
11210	mean_d = 1.0E+6_wp * ra_dry(k,j,i,ib) * 2.0_wp
11211	!
11212	!-- Deposition factor: alveolar
11213	df = ( 0.01555_wp / mean_d ) * ( EXP( -0.416_wp * ( LOG( mean_d ) + &
11214	2.84_wp )*2 ) + 19.11_wp EXP( -0.482_wp * ( LOG( mean_d ) - &
11215	1.362_wp )**2 ) )
11216	!
11217	!-- Lung-deposited surface area LDSA (units mum2/cm3)
11218	temp_bin = temp_bin + pi * mean_d*2 df * 1.0E-6_wp * &
11219	aerosol_number(ib)%conc(k,j,i)
11220	ENDDO
11221	local_pf(i,j,k) = MERGE( temp_bin, REAL( fill_value, KIND = wp ), &
11222	BTEST( wall_flags_total_0(k,j,i), 0 ) )
11223	ENDDO
11224	ENDDO
11225	ENDDO
11226	ELSE
11227	DO i = nxl, nxr
11228	DO j = nys, nyn
11229	DO k = nzb_do, nzt_do
11230	local_pf(i,j,k) = MERGE( ldsa_av(k,j,i), REAL( fill_value, KIND = wp ), &
11231	BTEST( wall_flags_total_0(k,j,i), 0 ) )
11232	ENDDO
11233	ENDDO
11234	ENDDO
11235	ENDIF
11236
11237	CASE ( 'N_UFP' )
11238	IF ( av == 0 ) THEN
11239	DO i = nxl, nxr
11240	DO j = nys, nyn
11241	DO k = nzb_do, nzt_do
11242	temp_bin = 0.0_wp
11243	DO ib = 1, nbins_aerosol
11244	IF ( 2.0_wp * ra_dry(k,j,i,ib) <= 0.1E-6_wp ) THEN
11245	temp_bin = temp_bin + aerosol_number(ib)%conc(k,j,i)
11246	ENDIF
11247	ENDDO
11248	local_pf(i,j,k) = MERGE( temp_bin, REAL( fill_value, KIND = wp ), &
11249	BTEST( wall_flags_total_0(k,j,i), 0 ) )
11250	ENDDO
11251	ENDDO
11252	ENDDO
11253	ELSE
11254	DO i = nxl, nxr
11255	DO j = nys, nyn
11256	DO k = nzb_do, nzt_do
11257	local_pf(i,j,k) = MERGE( nufp_av(k,j,i), REAL( fill_value, KIND = wp ), &
11258	BTEST( wall_flags_total_0(k,j,i), 0 ) )
11259	ENDDO
11260	ENDDO
11261	ENDDO
11262	ENDIF
11263
11264	CASE ( 'Ntot' )
11265	IF ( av == 0 ) THEN
11266	DO i = nxl, nxr
11267	DO j = nys, nyn
11268	DO k = nzb_do, nzt_do
11269	temp_bin = 0.0_wp
11270	DO ib = 1, nbins_aerosol
11271	temp_bin = temp_bin + aerosol_number(ib)%conc(k,j,i)
11272	ENDDO
11273	local_pf(i,j,k) = MERGE( temp_bin, REAL( fill_value, KIND = wp ), &
11274	BTEST( wall_flags_total_0(k,j,i), 0 ) )
11275	ENDDO
11276	ENDDO
11277	ENDDO
11278	ELSE
11279	DO i = nxl, nxr
11280	DO j = nys, nyn
11281	DO k = nzb_do, nzt_do
11282	local_pf(i,j,k) = MERGE( ntot_av(k,j,i), REAL( fill_value, KIND = wp ), &
11283	BTEST( wall_flags_total_0(k,j,i), 0 ) )
11284	ENDDO
11285	ENDDO
11286	ENDDO
11287	ENDIF
11288
11289	CASE ( 'PM0.1' )
11290	IF ( av == 0 ) THEN
11291	DO i = nxl, nxr
11292	DO j = nys, nyn
11293	DO k = nzb_do, nzt_do
11294	temp_bin = 0.0_wp
11295	DO ib = 1, nbins_aerosol
11296	IF ( 2.0_wp * ra_dry(k,j,i,ib) <= 0.1E-6_wp ) THEN
11297	DO ic = ib, nbins_aerosol * ncc, nbins_aerosol
11298	temp_bin = temp_bin + aerosol_mass(ic)%conc(k,j,i)
11299	ENDDO
11300	ENDIF
11301	ENDDO
11302	local_pf(i,j,k) = MERGE( temp_bin, REAL( fill_value, KIND = wp ), &
11303	BTEST( wall_flags_total_0(k,j,i), 0 ) )
11304	ENDDO
11305	ENDDO
11306	ENDDO
11307	ELSE
11308	DO i = nxl, nxr
11309	DO j = nys, nyn
11310	DO k = nzb_do, nzt_do
11311	local_pf(i,j,k) = MERGE( pm01_av(k,j,i), REAL( fill_value, KIND = wp ), &
11312	BTEST( wall_flags_total_0(k,j,i), 0 ) )
11313	ENDDO
11314	ENDDO
11315	ENDDO
11316	ENDIF
11317
11318	CASE ( 'PM2.5' )
11319	IF ( av == 0 ) THEN
11320	DO i = nxl, nxr
11321	DO j = nys, nyn
11322	DO k = nzb_do, nzt_do
11323	temp_bin = 0.0_wp
11324	DO ib = 1, nbins_aerosol
11325	IF ( 2.0_wp * ra_dry(k,j,i,ib) <= 2.5E-6_wp ) THEN
11326	DO ic = ib, nbins_aerosol * ncc, nbins_aerosol
11327	temp_bin = temp_bin + aerosol_mass(ic)%conc(k,j,i)
11328	ENDDO
11329	ENDIF
11330	ENDDO
11331	local_pf(i,j,k) = MERGE( temp_bin, REAL( fill_value, KIND = wp ), &
11332	BTEST( wall_flags_total_0(k,j,i), 0 ) )
11333	ENDDO
11334	ENDDO
11335	ENDDO
11336	ELSE
11337	DO i = nxl, nxr
11338	DO j = nys, nyn
11339	DO k = nzb_do, nzt_do
11340	local_pf(i,j,k) = MERGE( pm25_av(k,j,i), REAL( fill_value, KIND = wp ), &
11341	BTEST( wall_flags_total_0(k,j,i), 0 ) )
11342	ENDDO
11343	ENDDO
11344	ENDDO
11345	ENDIF
11346
11347	CASE ( 'PM10' )
11348	IF ( av == 0 ) THEN
11349	DO i = nxl, nxr
11350	DO j = nys, nyn
11351	DO k = nzb_do, nzt_do
11352	temp_bin = 0.0_wp
11353	DO ib = 1, nbins_aerosol
11354	IF ( 2.0_wp * ra_dry(k,j,i,ib) <= 10.0E-6_wp ) THEN
11355	DO ic = ib, nbins_aerosol * ncc, nbins_aerosol
11356	temp_bin = temp_bin + aerosol_mass(ic)%conc(k,j,i)
11357	ENDDO
11358	ENDIF
11359	ENDDO
11360	local_pf(i,j,k) = MERGE( temp_bin, REAL( fill_value, KIND = wp ), &
11361	BTEST( wall_flags_total_0(k,j,i), 0 ) )
11362	ENDDO
11363	ENDDO
11364	ENDDO
11365	ELSE
11366	DO i = nxl, nxr
11367	DO j = nys, nyn
11368	DO k = nzb_do, nzt_do
11369	local_pf(i,j,k) = MERGE( pm10_av(k,j,i), 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 ( 's_BC', 's_DU', 's_NH', 's_NO', 's_OC', 's_SO4', 's_SS' )
11377	IF ( is_used( prtcl, TRIM( variable(9:) ) ) ) THEN ! 9: remove salsa_s_
11378	found_index = get_index( prtcl, TRIM( variable(9:) ) )
11379	IF ( av == 0 ) THEN
11380	DO i = nxl, nxr
11381	DO j = nys, nyn
11382	DO k = nzb_do, nzt_do
11383	temp_bin = 0.0_wp
11384	DO ic = ( found_index-1 ) * nbins_aerosol + 1, found_index * nbins_aerosol
11385	temp_bin = temp_bin + aerosol_mass(ic)%conc(k,j,i)
11386	ENDDO
11387	local_pf(i,j,k) = MERGE( temp_bin, REAL( fill_value, KIND = wp ), &
11388	BTEST( wall_flags_total_0(k,j,i), 0 ) )
11389	ENDDO
11390	ENDDO
11391	ENDDO
11392	ELSE
11393	!
11394	!-- 9: remove salsa_s_ from the beginning
11395	IF ( TRIM( variable(9:) ) == 'BC' ) to_be_resorted => s_bc_av
11396	IF ( TRIM( variable(9:) ) == 'DU' ) to_be_resorted => s_du_av
11397	IF ( TRIM( variable(9:) ) == 'NH' ) to_be_resorted => s_nh_av
11398	IF ( TRIM( variable(9:) ) == 'NO' ) to_be_resorted => s_no_av
11399	IF ( TRIM( variable(9:) ) == 'OC' ) to_be_resorted => s_oc_av
11400	IF ( TRIM( variable(9:) ) == 'SO4' ) to_be_resorted => s_so4_av
11401	IF ( TRIM( variable(9:) ) == 'SS' ) to_be_resorted => s_ss_av
11402	DO i = nxl, nxr
11403	DO j = nys, nyn
11404	DO k = nzb_do, nzt_do
11405	local_pf(i,j,k) = MERGE( to_be_resorted(k,j,i), REAL( fill_value, &
11406	KIND = wp ), BTEST( wall_flags_total_0(k,j,i), 0 ) )
11407	ENDDO
11408	ENDDO
11409	ENDDO
11410	ENDIF
11411	ENDIF
11412
11413	CASE ( 's_H2O' )
11414	found_index = get_index( prtcl, 'H2O' )
11415	IF ( av == 0 ) THEN
11416	DO i = nxl, nxr
11417	DO j = nys, nyn
11418	DO k = nzb_do, nzt_do
11419	temp_bin = 0.0_wp
11420	DO ic = ( found_index-1 ) * nbins_aerosol + 1, found_index * nbins_aerosol
11421	temp_bin = temp_bin + aerosol_mass(ic)%conc(k,j,i)
11422	ENDDO
11423	local_pf(i,j,k) = MERGE( temp_bin, REAL( fill_value, KIND = wp ), &
11424	BTEST( wall_flags_total_0(k,j,i), 0 ) )
11425	ENDDO
11426	ENDDO
11427	ENDDO
11428	ELSE
11429	to_be_resorted => s_h2o_av
11430	DO i = nxl, nxr
11431	DO j = nys, nyn
11432	DO k = nzb_do, nzt_do
11433	local_pf(i,j,k) = MERGE( to_be_resorted(k,j,i), REAL( fill_value, &
11434	KIND = wp ), BTEST( wall_flags_total_0(k,j,i), 0 ) )
11435	ENDDO
11436	ENDDO
11437	ENDDO
11438	ENDIF
11439
11440	CASE DEFAULT
11441	found = .FALSE.
11442
11443	END SELECT
11444	ENDIF
11445
11446	END SUBROUTINE salsa_data_output_3d
11447
11448	!------------------------------------------------------------------------------!
11449	!
11450	! Description:
11451	! ------------
11452	!> Subroutine defining mask output variables
11453	!------------------------------------------------------------------------------!
11454	SUBROUTINE salsa_data_output_mask( av, variable, found, local_pf, mid )
11455
11456	USE arrays_3d, &
11457	ONLY: tend
11458
11459	USE control_parameters, &
11460	ONLY: mask_i, mask_j, mask_k, mask_size_l, mask_surface, nz_do3d
11461
11462	IMPLICIT NONE
11463
11464	CHARACTER(LEN=5) :: grid !< flag to distinquish between staggered grid
11465	CHARACTER(LEN=*) :: variable !<
11466	CHARACTER(LEN=7) :: vari !< trimmed format of variable
11467
11468	INTEGER(iwp) :: av !<
11469	INTEGER(iwp) :: char_to_int !< for converting character to integer
11470	INTEGER(iwp) :: found_index !< index of a chemical compound
11471	INTEGER(iwp) :: ib !< loop index for aerosol size number bins
11472	INTEGER(iwp) :: ic !< loop index for chemical components
11473	INTEGER(iwp) :: i !< loop index in x-direction
11474	INTEGER(iwp) :: j !< loop index in y-direction
11475	INTEGER(iwp) :: k !< loop index in z-direction
11476	INTEGER(iwp) :: im !< loop index for masked variables
11477	INTEGER(iwp) :: jm !< loop index for masked variables
11478	INTEGER(iwp) :: kk !< loop index for masked output in z-direction
11479	INTEGER(iwp) :: mid !< masked output running index
11480	INTEGER(iwp) :: ktt !< k index of highest terrain surface
11481
11482	LOGICAL :: found !<
11483	LOGICAL :: resorted !<
11484
11485	REAL(wp) :: df !< For calculating LDSA: fraction of particles depositing in the alveolar
11486	!< (or tracheobronchial) region of the lung. Depends on the particle size
11487	REAL(wp) :: mean_d !< Particle diameter in micrometres
11488	REAL(wp) :: temp_bin !< temporary array for calculating output variables
11489
11490	REAL(wp), DIMENSION(mask_size_l(mid,1),mask_size_l(mid,2),mask_size_l(mid,3)) :: local_pf !<
11491
11492	REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg), TARGET :: temp_array !< temporary array
11493
11494	REAL(wp), DIMENSION(:,:,:), POINTER :: to_be_resorted !< pointer
11495
11496	found = .TRUE.
11497	resorted = .FALSE.
11498	grid = 's'
11499	tend = 0.0_wp
11500	temp_array = 0.0_wp
11501	temp_bin = 0.0_wp
11502
11503	IF ( variable(7:11) == 'N_bin' ) THEN
11504	READ( variable(12:),* ) char_to_int
11505	IF ( char_to_int >= 1 .AND. char_to_int <= SUM( nbin ) ) THEN
11506	ib = char_to_int
11507	IF ( av == 0 ) THEN
11508	IF ( .NOT. mask_surface(mid) ) THEN
11509	DO i = 1, mask_size_l(mid,1)
11510	DO j = 1, mask_size_l(mid,2)
11511	DO k = 1, mask_size_l(mid,3)
11512	local_pf(i,j,k) = aerosol_number(ib)%conc( mask_k(mid,k), mask_j(mid,j), &
11513	mask_i(mid,i) )
11514	ENDDO
11515	ENDDO
11516	ENDDO
11517	ELSE
11518	DO i = 1, mask_size_l(mid,1)
11519	DO j = 1, mask_size_l(mid,2)
11520	!
11521	!-- Get k index of the highest terraing surface
11522	im = mask_i(mid,i)
11523	jm = mask_j(mid,j)
11524	ktt = MINLOC( MERGE( 1, 0, BTEST( wall_flags_total_0(:,jm,im), 5 )), &
11525	DIM = 1 ) - 1
11526	DO k = 1, mask_size_l(mid,3)
11527	kk = MIN( ktt+mask_k(mid,k), nzt+1 )
11528	!
11529	!-- Set value if not in building
11530	IF ( BTEST( wall_flags_total_0(kk,jm,im), 6 ) ) THEN
11531	local_pf(i,j,k) = fill_value
11532	ELSE
11533	local_pf(i,j,k) = aerosol_number(ib)%conc(kk,jm,im)
11534	ENDIF
11535	ENDDO
11536	ENDDO
11537	ENDDO
11538	ENDIF
11539	resorted = .TRUE.
11540	ELSE
11541	temp_array = nbins_av(:,:,:,ib)
11542	to_be_resorted => temp_array
11543	ENDIF
11544	ENDIF
11545
11546	ELSEIF ( variable(7:11) == 'm_bin' ) THEN
11547
11548	READ( variable(12:),* ) char_to_int
11549	IF ( char_to_int >= 1 .AND. char_to_int <= SUM( nbin ) ) THEN
11550
11551	ib = char_to_int
11552	IF ( av == 0 ) THEN
11553	DO i = nxl, nxr
11554	DO j = nys, nyn
11555	DO k = nzb, nz_do3d
11556	temp_bin = 0.0_wp
11557	DO ic = ib, ncomponents_mass * nbins_aerosol, nbins_aerosol
11558	temp_bin = temp_bin + aerosol_mass(ic)%conc(k,j,i)
11559	ENDDO
11560	tend(k,j,i) = temp_bin
11561	ENDDO
11562	ENDDO
11563	ENDDO
11564	IF ( .NOT. mask_surface(mid) ) THEN
11565	DO i = 1, mask_size_l(mid,1)
11566	DO j = 1, mask_size_l(mid,2)
11567	DO k = 1, mask_size_l(mid,3)
11568	local_pf(i,j,k) = tend( mask_k(mid,k), mask_j(mid,j), mask_i(mid,i) )
11569	ENDDO
11570	ENDDO
11571	ENDDO
11572	ELSE
11573	DO i = 1, mask_size_l(mid,1)
11574	DO j = 1, mask_size_l(mid,2)
11575	!
11576	!-- Get k index of the highest terraing surface
11577	im = mask_i(mid,i)
11578	jm = mask_j(mid,j)
11579	ktt = MINLOC( MERGE( 1, 0, BTEST( wall_flags_total_0(:,jm,im), 5 )), &
11580	DIM = 1 ) - 1
11581	DO k = 1, mask_size_l(mid,3)
11582	kk = MIN( ktt+mask_k(mid,k), nzt+1 )
11583	!
11584	!-- Set value if not in building
11585	IF ( BTEST( wall_flags_total_0(kk,jm,im), 6 ) ) THEN
11586	local_pf(i,j,k) = fill_value
11587	ELSE
11588	local_pf(i,j,k) = tend(kk,jm,im)
11589	ENDIF
11590	ENDDO
11591	ENDDO
11592	ENDDO
11593	ENDIF
11594	resorted = .TRUE.
11595	ELSE
11596	temp_array = mbins_av(:,:,:,ib)
11597	to_be_resorted => temp_array
11598	ENDIF
11599	ENDIF
11600
11601	ELSE
11602	SELECT CASE ( TRIM( variable(7:) ) )
11603
11604	CASE ( 'g_H2SO4', 'g_HNO3', 'g_NH3', 'g_OCNV', 'g_OCSV' )
11605	vari = TRIM( variable(7:) )
11606	IF ( av == 0 ) THEN
11607	IF ( vari == 'g_H2SO4') to_be_resorted => salsa_gas(1)%conc
11608	IF ( vari == 'g_HNO3') to_be_resorted => salsa_gas(2)%conc
11609	IF ( vari == 'g_NH3') to_be_resorted => salsa_gas(3)%conc
11610	IF ( vari == 'g_OCNV') to_be_resorted => salsa_gas(4)%conc
11611	IF ( vari == 'g_OCSV') to_be_resorted => salsa_gas(5)%conc
11612	ELSE
11613	IF ( vari == 'g_H2SO4') to_be_resorted => g_h2so4_av
11614	IF ( vari == 'g_HNO3') to_be_resorted => g_hno3_av
11615	IF ( vari == 'g_NH3') to_be_resorted => g_nh3_av
11616	IF ( vari == 'g_OCNV') to_be_resorted => g_ocnv_av
11617	IF ( vari == 'g_OCSV') to_be_resorted => g_ocsv_av
11618	ENDIF
11619
11620	CASE ( 'LDSA' )
11621	IF ( av == 0 ) THEN
11622	DO i = nxl, nxr
11623	DO j = nys, nyn
11624	DO k = nzb, nz_do3d
11625	temp_bin = 0.0_wp
11626	DO ib = 1, nbins_aerosol
11627	!
11628	!-- Diameter in micrometres
11629	mean_d = 1.0E+6_wp * ra_dry(k,j,i,ib) * 2.0_wp
11630	!
11631	!-- Deposition factor: alveolar
11632	df = ( 0.01555_wp / mean_d ) * ( EXP( -0.416_wp * ( LOG( mean_d ) + &
11633	2.84_wp )*2 ) + 19.11_wp EXP( -0.482_wp * ( LOG( mean_d ) - &
11634	1.362_wp )**2 ) )
11635	!
11636	!-- Lung-deposited surface area LDSA (units mum2/cm3)
11637	temp_bin = temp_bin + pi * mean_d*2 df * 1.0E-6_wp * &
11638	aerosol_number(ib)%conc(k,j,i)
11639	ENDDO
11640	tend(k,j,i) = temp_bin
11641	ENDDO
11642	ENDDO
11643	ENDDO
11644	IF ( .NOT. mask_surface(mid) ) THEN
11645	DO i = 1, mask_size_l(mid,1)
11646	DO j = 1, mask_size_l(mid,2)
11647	DO k = 1, mask_size_l(mid,3)
11648	local_pf(i,j,k) = tend( mask_k(mid,k), mask_j(mid,j), mask_i(mid,i) )
11649	ENDDO
11650	ENDDO
11651	ENDDO
11652	ELSE
11653	DO i = 1, mask_size_l(mid,1)
11654	DO j = 1, mask_size_l(mid,2)
11655	!
11656	!-- Get k index of the highest terraing surface
11657	im = mask_i(mid,i)
11658	jm = mask_j(mid,j)
11659	ktt = MINLOC( MERGE( 1, 0, BTEST( wall_flags_total_0(:,jm,im), 5 )), &
11660	DIM = 1 ) - 1
11661	DO k = 1, mask_size_l(mid,3)
11662	kk = MIN( ktt+mask_k(mid,k), nzt+1 )
11663	!
11664	!-- Set value if not in building
11665	IF ( BTEST( wall_flags_total_0(kk,jm,im), 6 ) ) THEN
11666	local_pf(i,j,k) = fill_value
11667	ELSE
11668	local_pf(i,j,k) = tend(kk,jm,im)
11669	ENDIF
11670	ENDDO
11671	ENDDO
11672	ENDDO
11673	ENDIF
11674	resorted = .TRUE.
11675	ELSE
11676	to_be_resorted => ldsa_av
11677	ENDIF
11678
11679	CASE ( 'N_UFP' )
11680	IF ( av == 0 ) THEN
11681	DO i = nxl, nxr
11682	DO j = nys, nyn
11683	DO k = nzb, nz_do3d
11684	temp_bin = 0.0_wp
11685	DO ib = 1, nbins_aerosol
11686	IF ( 2.0_wp * ra_dry(k,j,i,ib) <= 0.1E-6_wp ) THEN
11687	temp_bin = temp_bin + aerosol_number(ib)%conc(k,j,i)
11688	ENDIF
11689	ENDDO
11690	tend(k,j,i) = temp_bin
11691	ENDDO
11692	ENDDO
11693	ENDDO
11694	IF ( .NOT. mask_surface(mid) ) THEN
11695	DO i = 1, mask_size_l(mid,1)
11696	DO j = 1, mask_size_l(mid,2)
11697	DO k = 1, mask_size_l(mid,3)
11698	local_pf(i,j,k) = tend( mask_k(mid,k), mask_j(mid,j), mask_i(mid,i) )
11699	ENDDO
11700	ENDDO
11701	ENDDO
11702	ELSE
11703	DO i = 1, mask_size_l(mid,1)
11704	DO j = 1, mask_size_l(mid,2)
11705	!
11706	!-- Get k index of the highest terraing surface
11707	im = mask_i(mid,i)
11708	jm = mask_j(mid,j)
11709	ktt = MINLOC( MERGE( 1, 0, BTEST( wall_flags_total_0(:,jm,im), 5 )), &
11710	DIM = 1 ) - 1
11711	DO k = 1, mask_size_l(mid,3)
11712	kk = MIN( ktt+mask_k(mid,k), nzt+1 )
11713	!
11714	!-- Set value if not in building
11715	IF ( BTEST( wall_flags_total_0(kk,jm,im), 6 ) ) THEN
11716	local_pf(i,j,k) = fill_value
11717	ELSE
11718	local_pf(i,j,k) = tend(kk,jm,im)
11719	ENDIF
11720	ENDDO
11721	ENDDO
11722	ENDDO
11723	ENDIF
11724	resorted = .TRUE.
11725	ELSE
11726	to_be_resorted => nufp_av
11727	ENDIF
11728
11729	CASE ( 'Ntot' )
11730	IF ( av == 0 ) THEN
11731	DO i = nxl, nxr
11732	DO j = nys, nyn
11733	DO k = nzb, nz_do3d
11734	temp_bin = 0.0_wp
11735	DO ib = 1, nbins_aerosol
11736	temp_bin = temp_bin + aerosol_number(ib)%conc(k,j,i)
11737	ENDDO
11738	tend(k,j,i) = temp_bin
11739	ENDDO
11740	ENDDO
11741	ENDDO
11742	IF ( .NOT. mask_surface(mid) ) THEN
11743	DO i = 1, mask_size_l(mid,1)
11744	DO j = 1, mask_size_l(mid,2)
11745	DO k = 1, mask_size_l(mid,3)
11746	local_pf(i,j,k) = tend( mask_k(mid,k), mask_j(mid,j), mask_i(mid,i) )
11747	ENDDO
11748	ENDDO
11749	ENDDO
11750	ELSE
11751	DO i = 1, mask_size_l(mid,1)
11752	DO j = 1, mask_size_l(mid,2)
11753	!
11754	!-- Get k index of the highest terraing surface
11755	im = mask_i(mid,i)
11756	jm = mask_j(mid,j)
11757	ktt = MINLOC( MERGE( 1, 0, BTEST( wall_flags_total_0(:,jm,im), 5 )), &
11758	DIM = 1 ) - 1
11759	DO k = 1, mask_size_l(mid,3)
11760	kk = MIN( ktt+mask_k(mid,k), nzt+1 )
11761	!
11762	!-- Set value if not in building
11763	IF ( BTEST( wall_flags_total_0(kk,jm,im), 6 ) ) THEN
11764	local_pf(i,j,k) = fill_value
11765	ELSE
11766	local_pf(i,j,k) = tend(kk,jm,im)
11767	ENDIF
11768	ENDDO
11769	ENDDO
11770	ENDDO
11771	ENDIF
11772	resorted = .TRUE.
11773	ELSE
11774	to_be_resorted => ntot_av
11775	ENDIF
11776
11777	CASE ( 'PM0.1' )
11778	IF ( av == 0 ) THEN
11779	DO i = nxl, nxr
11780	DO j = nys, nyn
11781	DO k = nzb, nz_do3d
11782	temp_bin = 0.0_wp
11783	DO ib = 1, nbins_aerosol
11784	IF ( 2.0_wp * ra_dry(k,j,i,ib) <= 0.1E-6_wp ) THEN
11785	DO ic = ib, nbins_aerosol * ncc, nbins_aerosol
11786	temp_bin = temp_bin + aerosol_mass(ic)%conc(k,j,i)
11787	ENDDO
11788	ENDIF
11789	ENDDO
11790	tend(k,j,i) = temp_bin
11791	ENDDO
11792	ENDDO
11793	ENDDO
11794	IF ( .NOT. mask_surface(mid) ) THEN
11795	DO i = 1, mask_size_l(mid,1)
11796	DO j = 1, mask_size_l(mid,2)
11797	DO k = 1, mask_size_l(mid,3)
11798	local_pf(i,j,k) = tend( mask_k(mid,k), mask_j(mid,j), mask_i(mid,i) )
11799	ENDDO
11800	ENDDO
11801	ENDDO
11802	ELSE
11803	DO i = 1, mask_size_l(mid,1)
11804	DO j = 1, mask_size_l(mid,2)
11805	!
11806	!-- Get k index of the highest terraing surface
11807	im = mask_i(mid,i)
11808	jm = mask_j(mid,j)
11809	ktt = MINLOC( MERGE( 1, 0, BTEST( wall_flags_total_0(:,jm,im), 5 )), &
11810	DIM = 1 ) - 1
11811	DO k = 1, mask_size_l(mid,3)
11812	kk = MIN( ktt+mask_k(mid,k), nzt+1 )
11813	!
11814	!-- Set value if not in building
11815	IF ( BTEST( wall_flags_total_0(kk,jm,im), 6 ) ) THEN
11816	local_pf(i,j,k) = fill_value
11817	ELSE
11818	local_pf(i,j,k) = tend(kk,jm,im)
11819	ENDIF
11820	ENDDO
11821	ENDDO
11822	ENDDO
11823	ENDIF
11824	resorted = .TRUE.
11825	ELSE
11826	to_be_resorted => pm01_av
11827	ENDIF
11828
11829	CASE ( 'PM2.5' )
11830	IF ( av == 0 ) THEN
11831	DO i = nxl, nxr
11832	DO j = nys, nyn
11833	DO k = nzb, nz_do3d
11834	temp_bin = 0.0_wp
11835	DO ib = 1, nbins_aerosol
11836	IF ( 2.0_wp * ra_dry(k,j,i,ib) <= 2.5E-6_wp ) THEN
11837	DO ic = ib, nbins_aerosol * ncc, nbins_aerosol
11838	temp_bin = temp_bin + aerosol_mass(ic)%conc(k,j,i)
11839	ENDDO
11840	ENDIF
11841	ENDDO
11842	tend(k,j,i) = temp_bin
11843	ENDDO
11844	ENDDO
11845	ENDDO
11846	IF ( .NOT. mask_surface(mid) ) THEN
11847	DO i = 1, mask_size_l(mid,1)
11848	DO j = 1, mask_size_l(mid,2)
11849	DO k = 1, mask_size_l(mid,3)
11850	local_pf(i,j,k) = tend( mask_k(mid,k), mask_j(mid,j), mask_i(mid,i) )
11851	ENDDO
11852	ENDDO
11853	ENDDO
11854	ELSE
11855	DO i = 1, mask_size_l(mid,1)
11856	DO j = 1, mask_size_l(mid,2)
11857	!
11858	!-- Get k index of the highest terraing surface
11859	im = mask_i(mid,i)
11860	jm = mask_j(mid,j)
11861	ktt = MINLOC( MERGE( 1, 0, BTEST( wall_flags_total_0(:,jm,im), 5 )), &
11862	DIM = 1 ) - 1
11863	DO k = 1, mask_size_l(mid,3)
11864	kk = MIN( ktt+mask_k(mid,k), nzt+1 )
11865	!
11866	!-- Set value if not in building
11867	IF ( BTEST( wall_flags_total_0(kk,jm,im), 6 ) ) THEN
11868	local_pf(i,j,k) = fill_value
11869	ELSE
11870	local_pf(i,j,k) = tend(kk,jm,im)
11871	ENDIF
11872	ENDDO
11873	ENDDO
11874	ENDDO
11875	ENDIF
11876	resorted = .TRUE.
11877	ELSE
11878	to_be_resorted => pm25_av
11879	ENDIF
11880
11881	CASE ( 'PM10' )
11882	IF ( av == 0 ) THEN
11883	DO i = nxl, nxr
11884	DO j = nys, nyn
11885	DO k = nzb, nz_do3d
11886	temp_bin = 0.0_wp
11887	DO ib = 1, nbins_aerosol
11888	IF ( 2.0_wp * ra_dry(k,j,i,ib) <= 10.0E-6_wp ) THEN
11889	DO ic = ib, nbins_aerosol * ncc, nbins_aerosol
11890	temp_bin = temp_bin + aerosol_mass(ic)%conc(k,j,i)
11891	ENDDO
11892	ENDIF
11893	ENDDO
11894	tend(k,j,i) = temp_bin
11895	ENDDO
11896	ENDDO
11897	ENDDO
11898	IF ( .NOT. mask_surface(mid) ) THEN
11899	DO i = 1, mask_size_l(mid,1)
11900	DO j = 1, mask_size_l(mid,2)
11901	DO k = 1, mask_size_l(mid,3)
11902	local_pf(i,j,k) = tend( mask_k(mid,k), mask_j(mid,j), mask_i(mid,i) )
11903	ENDDO
11904	ENDDO
11905	ENDDO
11906	ELSE
11907	DO i = 1, mask_size_l(mid,1)
11908	DO j = 1, mask_size_l(mid,2)
11909	!
11910	!-- Get k index of the highest terraing surface
11911	im = mask_i(mid,i)
11912	jm = mask_j(mid,j)
11913	ktt = MINLOC( MERGE( 1, 0, BTEST( wall_flags_total_0(:,jm,im), 5 )), &
11914	DIM = 1 ) - 1
11915	DO k = 1, mask_size_l(mid,3)
11916	kk = MIN( ktt+mask_k(mid,k), nzt+1 )
11917	!
11918	!-- Set value if not in building
11919	IF ( BTEST( wall_flags_total_0(kk,jm,im), 6 ) ) THEN
11920	local_pf(i,j,k) = fill_value
11921	ELSE
11922	local_pf(i,j,k) = tend(kk,jm,im)
11923	ENDIF
11924	ENDDO
11925	ENDDO
11926	ENDDO
11927	ENDIF
11928	resorted = .TRUE.
11929	ELSE
11930	to_be_resorted => pm10_av
11931	ENDIF
11932
11933	CASE ( 's_BC', 's_DU', 's_NH', 's_NO', 's_OC', 's_SO4', 's_SS' )
11934	IF ( av == 0 ) THEN
11935	IF ( is_used( prtcl, TRIM( variable(9:) ) ) ) THEN
11936	found_index = get_index( prtcl, TRIM( variable(9:) ) )
11937	DO i = nxl, nxr
11938	DO j = nys, nyn
11939	DO k = nzb, nz_do3d
11940	temp_bin = 0.0_wp
11941	DO ic = ( found_index-1 ) * nbins_aerosol + 1, found_index * nbins_aerosol
11942	temp_bin = temp_bin + aerosol_mass(ic)%conc(k,j,i)
11943	ENDDO
11944	tend(k,j,i) = temp_bin
11945	ENDDO
11946	ENDDO
11947	ENDDO
11948	ELSE
11949	tend = 0.0_wp
11950	ENDIF
11951	IF ( .NOT. mask_surface(mid) ) THEN
11952	DO i = 1, mask_size_l(mid,1)
11953	DO j = 1, mask_size_l(mid,2)
11954	DO k = 1, mask_size_l(mid,3)
11955	local_pf(i,j,k) = tend( mask_k(mid,k), mask_j(mid,j), mask_i(mid,i) )
11956	ENDDO
11957	ENDDO
11958	ENDDO
11959	ELSE
11960	DO i = 1, mask_size_l(mid,1)
11961	DO j = 1, mask_size_l(mid,2)
11962	!
11963	!-- Get k index of the highest terraing surface
11964	im = mask_i(mid,i)
11965	jm = mask_j(mid,j)
11966	ktt = MINLOC( MERGE( 1, 0, BTEST( wall_flags_total_0(:,jm,im), 5 )), &
11967	DIM = 1 ) - 1
11968	DO k = 1, mask_size_l(mid,3)
11969	kk = MIN( ktt+mask_k(mid,k), nzt+1 )
11970	!
11971	!-- Set value if not in building
11972	IF ( BTEST( wall_flags_total_0(kk,jm,im), 6 ) ) THEN
11973	local_pf(i,j,k) = fill_value
11974	ELSE
11975	local_pf(i,j,k) = tend(kk,jm,im)
11976	ENDIF
11977	ENDDO
11978	ENDDO
11979	ENDDO
11980	ENDIF
11981	resorted = .TRUE.
11982	ELSE
11983	!
11984	!-- 9: remove salsa_s_ from the beginning
11985	IF ( TRIM( variable(9:) ) == 'BC' ) to_be_resorted => s_bc_av
11986	IF ( TRIM( variable(9:) ) == 'DU' ) to_be_resorted => s_du_av
11987	IF ( TRIM( variable(9:) ) == 'NH' ) to_be_resorted => s_nh_av
11988	IF ( TRIM( variable(9:) ) == 'NO' ) to_be_resorted => s_no_av
11989	IF ( TRIM( variable(9:) ) == 'OC' ) to_be_resorted => s_oc_av
11990	IF ( TRIM( variable(9:) ) == 'SO4' ) to_be_resorted => s_so4_av
11991	IF ( TRIM( variable(9:) ) == 'SS' ) to_be_resorted => s_ss_av
11992	ENDIF
11993
11994	CASE ( 's_H2O' )
11995	IF ( av == 0 ) THEN
11996	found_index = get_index( prtcl, 'H2O' )
11997	DO i = nxl, nxr
11998	DO j = nys, nyn
11999	DO k = nzb, nz_do3d
12000	temp_bin = 0.0_wp
12001	DO ic = ( found_index-1 ) * nbins_aerosol + 1, found_index * nbins_aerosol
12002	temp_bin = temp_bin + aerosol_mass(ic)%conc(k,j,i)
12003	ENDDO
12004	tend(k,j,i) = temp_bin
12005	ENDDO
12006	ENDDO
12007	ENDDO
12008	IF ( .NOT. mask_surface(mid) ) THEN
12009	DO i = 1, mask_size_l(mid,1)
12010	DO j = 1, mask_size_l(mid,2)
12011	DO k = 1, mask_size_l(mid,3)
12012	local_pf(i,j,k) = tend( mask_k(mid,k), mask_j(mid,j), mask_i(mid,i) )
12013	ENDDO
12014	ENDDO
12015	ENDDO
12016	ELSE
12017	DO i = 1, mask_size_l(mid,1)
12018	DO j = 1, mask_size_l(mid,2)
12019	!
12020	!-- Get k index of the highest terraing surface
12021	im = mask_i(mid,i)
12022	jm = mask_j(mid,j)
12023	ktt = MINLOC( MERGE( 1, 0, BTEST( wall_flags_total_0(:,jm,im), 5 )), &
12024	DIM = 1 ) - 1
12025	DO k = 1, mask_size_l(mid,3)
12026	kk = MIN( ktt+mask_k(mid,k), nzt+1 )
12027	!
12028	!-- Set value if not in building
12029	IF ( BTEST( wall_flags_total_0(kk,jm,im), 6 ) ) THEN
12030	local_pf(i,j,k) = fill_value
12031	ELSE
12032	local_pf(i,j,k) = tend(kk,jm,im)
12033	ENDIF
12034	ENDDO
12035	ENDDO
12036	ENDDO
12037	ENDIF
12038	resorted = .TRUE.
12039	ELSE
12040	to_be_resorted => s_h2o_av
12041	ENDIF
12042
12043	CASE DEFAULT
12044	found = .FALSE.
12045
12046	END SELECT
12047	ENDIF
12048
12049	IF ( found .AND. .NOT. resorted ) THEN
12050	IF ( .NOT. mask_surface(mid) ) THEN
12051	!
12052	!-- Default masked output
12053	DO i = 1, mask_size_l(mid,1)
12054	DO j = 1, mask_size_l(mid,2)
12055	DO k = 1, mask_size_l(mid,3)
12056	local_pf(i,j,k) = to_be_resorted( mask_k(mid,k), mask_j(mid,j), mask_i(mid,i) )
12057	ENDDO
12058	ENDDO
12059	ENDDO
12060	ELSE
12061	!
12062	!-- Terrain-following masked output
12063	DO i = 1, mask_size_l(mid,1)
12064	DO j = 1, mask_size_l(mid,2)
12065	!-- Get k index of the highest terraing surface
12066	im = mask_i(mid,i)
12067	jm = mask_j(mid,j)
12068	ktt = MINLOC( MERGE( 1, 0, BTEST( wall_flags_total_0(:,jm,im), 5 )), &
12069	DIM = 1 ) - 1
12070	DO k = 1, mask_size_l(mid,3)
12071	kk = MIN( ktt+mask_k(mid,k), nzt+1 )
12072	!-- Set value if not in building
12073	IF ( BTEST( wall_flags_total_0(kk,jm,im), 6 ) ) THEN
12074	local_pf(i,j,k) = fill_value
12075	ELSE
12076	local_pf(i,j,k) = to_be_resorted(kk,jm,im)
12077	ENDIF
12078	ENDDO
12079	ENDDO
12080	ENDDO
12081	ENDIF
12082	ENDIF
12083
12084	END SUBROUTINE salsa_data_output_mask
12085
12086	!------------------------------------------------------------------------------!
12087	! Description:
12088	! ------------
12089	!> Creates index tables for different (aerosol) components
12090	!------------------------------------------------------------------------------!
12091	SUBROUTINE component_index_constructor( self, ncomp, nlist, listcomp )
12092
12093	IMPLICIT NONE
12094
12095	INTEGER(iwp) :: ii !<
12096	INTEGER(iwp) :: jj !<
12097
12098	INTEGER(iwp), INTENT(in) :: nlist ! < Maximum number of components
12099
12100	INTEGER(iwp), INTENT(inout) :: ncomp !< Number of components
12101
12102	CHARACTER(LEN=3), INTENT(in) :: listcomp(nlist) !< List cof component names
12103
12104	TYPE(component_index), INTENT(inout) :: self !< Object containing the indices of different
12105	!< aerosol components
12106
12107	ncomp = 0
12108
12109	DO WHILE ( listcomp(ncomp+1) /= ' ' .AND. ncomp < nlist )
12110	ncomp = ncomp + 1
12111	ENDDO
12112
12113	self%ncomp = ncomp
12114	ALLOCATE( self%ind(ncomp), self%comp(ncomp) )
12115
12116	DO ii = 1, ncomp
12117	self%ind(ii) = ii
12118	ENDDO
12119
12120	jj = 1
12121	DO ii = 1, nlist
12122	IF ( listcomp(ii) == '') CYCLE
12123	self%comp(jj) = listcomp(ii)
12124	jj = jj + 1
12125	ENDDO
12126
12127	END SUBROUTINE component_index_constructor
12128
12129	!------------------------------------------------------------------------------!
12130	! Description:
12131	! ------------
12132	!> Gives the index of a component in the component list
12133	!------------------------------------------------------------------------------!
12134	INTEGER FUNCTION get_index( self, incomp )
12135
12136	IMPLICIT NONE
12137
12138	CHARACTER(LEN=*), INTENT(in) :: incomp !< Component name
12139
12140	INTEGER(iwp) :: ii !< index
12141
12142	TYPE(component_index), INTENT(in) :: self !< Object containing the indices of different
12143	!< aerosol components
12144	IF ( ANY( self%comp == incomp ) ) THEN
12145	ii = 1
12146	DO WHILE ( (self%comp(ii) /= incomp) )
12147	ii = ii + 1
12148	ENDDO
12149	get_index = ii
12150	ELSEIF ( incomp == 'H2O' ) THEN
12151	get_index = self%ncomp + 1
12152	ELSE
12153	WRITE( message_string, * ) 'Incorrect component name given!'
12154	CALL message( 'get_index', 'PA0591', 1, 2, 0, 6, 0 )
12155	ENDIF
12156
12157	END FUNCTION get_index
12158
12159	!------------------------------------------------------------------------------!
12160	! Description:
12161	! ------------
12162	!> Tells if the (aerosol) component is being used in the simulation
12163	!------------------------------------------------------------------------------!
12164	LOGICAL FUNCTION is_used( self, icomp )
12165
12166	IMPLICIT NONE
12167
12168	CHARACTER(LEN=*), INTENT(in) :: icomp !< Component name
12169
12170	TYPE(component_index), INTENT(in) :: self !< Object containing the indices of different
12171	!< aerosol components
12172
12173	IF ( ANY(self%comp == icomp) ) THEN
12174	is_used = .TRUE.
12175	ELSE
12176	is_used = .FALSE.
12177	ENDIF
12178
12179	END FUNCTION
12180
12181	!------------------------------------------------------------------------------!
12182	! Description:
12183	! ------------
12184	!> Set the lateral and top boundary conditions in case the PALM domain is
12185	!> nested offline in a mesoscale model. Further, average boundary data and
12186	!> determine mean profiles, further used for correct damping in the sponge
12187	!> layer.
12188	!------------------------------------------------------------------------------!
12189	SUBROUTINE salsa_nesting_offl_bc
12190
12191	USE control_parameters, &
12192	ONLY: bc_dirichlet_l, bc_dirichlet_n, bc_dirichlet_r, bc_dirichlet_s, dt_3d, &
12193	time_since_reference_point
12194
12195	USE indices, &
12196	ONLY: nbgp, nxl, nxr, nyn, nys, nzb, nzt
12197
12198	IMPLICIT NONE
12199
12200	INTEGER(iwp) :: i !< running index x-direction
12201	INTEGER(iwp) :: ib !< running index for aerosol number bins
12202	INTEGER(iwp) :: ic !< running index for aerosol mass bins
12203	INTEGER(iwp) :: icc !< running index for aerosol mass bins
12204	INTEGER(iwp) :: ig !< running index for gaseous species
12205	INTEGER(iwp) :: j !< running index y-direction
12206	INTEGER(iwp) :: k !< running index z-direction
12207
12208	REAL(wp) :: fac_dt !< interpolation factor
12209
12210	REAL(wp), DIMENSION(:,:), ALLOCATABLE :: ref_mconc !< reference profile for aerosol mass
12211	REAL(wp), DIMENSION(:,:), ALLOCATABLE :: ref_mconc_l !< reference profile for aerosol mass: subdomain
12212	REAL(wp), DIMENSION(:,:), ALLOCATABLE :: ref_nconc !< reference profile for aerosol number
12213	REAL(wp), DIMENSION(:,:), ALLOCATABLE :: ref_nconc_l !< reference profile for aerosol_number: subdomain
12214	REAL(wp), DIMENSION(:,:), ALLOCATABLE :: ref_gconc !< reference profile for gases
12215	REAL(wp), DIMENSION(:,:), ALLOCATABLE :: ref_gconc_l !< reference profile for gases: subdomain
12216
12217	!
12218	!-- Skip input if no forcing from larger-scale models is applied.
12219	IF ( .NOT. nesting_offline_salsa ) RETURN
12220	!
12221	!-- Allocate temporary arrays to compute salsa mean profiles
12222	ALLOCATE( ref_gconc(nzb:nzt+1,1:ngases_salsa), ref_gconc_l(nzb:nzt+1,1:ngases_salsa), &
12223	ref_mconc(nzb:nzt+1,1:nbins_aerosol*ncomponents_mass), &
12224	ref_mconc_l(nzb:nzt+1,1:nbins_aerosol*ncomponents_mass), &
12225	ref_nconc(nzb:nzt+1,1:nbins_aerosol), ref_nconc_l(nzb:nzt+1,1:nbins_aerosol) )
12226	ref_gconc = 0.0_wp
12227	ref_gconc_l = 0.0_wp
12228	ref_mconc = 0.0_wp
12229	ref_mconc_l = 0.0_wp
12230	ref_nconc = 0.0_wp
12231	ref_nconc_l = 0.0_wp
12232
12233	!
12234	!-- Determine interpolation factor and limit it to 1. This is because t+dt can slightly exceed
12235	!-- time(tind_p) before boundary data is updated again.
12236	fac_dt = ( time_since_reference_point - salsa_nest_offl%time(salsa_nest_offl%tind) + dt_3d ) / &
12237	( salsa_nest_offl%time(salsa_nest_offl%tind_p) - &
12238	salsa_nest_offl%time(salsa_nest_offl%tind) )
12239	fac_dt = MIN( 1.0_wp, fac_dt )
12240
12241	IF ( bc_dirichlet_l ) THEN
12242	DO ib = 1, nbins_aerosol
12243	DO j = nys, nyn
12244	DO k = nzb+1, nzt
12245	aerosol_number(ib)%conc(k,j,-1) = ( 1.0_wp - fac_dt ) * &
12246	salsa_nest_offl%nconc_left(0,k,j,ib) + fac_dt * &
12247	salsa_nest_offl%nconc_left(1,k,j,ib)
12248	ENDDO
12249	ref_nconc_l(nzb+1:nzt,ib) = ref_nconc_l(nzb+1:nzt,ib) + &
12250	aerosol_number(ib)%conc(nzb+1:nzt,j,-1)
12251	ENDDO
12252	DO ic = 1, ncomponents_mass
12253	icc = ( ic-1 ) * nbins_aerosol + ib
12254	DO j = nys, nyn
12255	DO k = nzb+1, nzt
12256	aerosol_mass(icc)%conc(k,j,-1) = ( 1.0_wp - fac_dt ) * &
12257	salsa_nest_offl%mconc_left(0,k,j,icc) + fac_dt &
12258	* salsa_nest_offl%mconc_left(1,k,j,icc)
12259	ENDDO
12260	ref_mconc_l(nzb+1:nzt,icc) = ref_mconc_l(nzb+1:nzt,icc) + &
12261	aerosol_mass(icc)%conc(nzb+1:nzt,j,-1)
12262	ENDDO
12263	ENDDO
12264	ENDDO
12265	IF ( .NOT. salsa_gases_from_chem ) THEN
12266	DO ig = 1, ngases_salsa
12267	DO j = nys, nyn
12268	DO k = nzb+1, nzt
12269	salsa_gas(ig)%conc(k,j,-1) = ( 1.0_wp - fac_dt ) * &
12270	salsa_nest_offl%gconc_left(0,k,j,ig) + fac_dt * &
12271	salsa_nest_offl%gconc_left(1,k,j,ig)
12272	ENDDO
12273	ref_gconc_l(nzb+1:nzt,ig) = ref_gconc_l(nzb+1:nzt,ig) + &
12274	salsa_gas(ig)%conc(nzb+1:nzt,j,-1)
12275	ENDDO
12276	ENDDO
12277	ENDIF
12278	ENDIF
12279
12280	IF ( bc_dirichlet_r ) THEN
12281	DO ib = 1, nbins_aerosol
12282	DO j = nys, nyn
12283	DO k = nzb+1, nzt
12284	aerosol_number(ib)%conc(k,j,nxr+1) = ( 1.0_wp - fac_dt ) * &
12285	salsa_nest_offl%nconc_right(0,k,j,ib) + fac_dt * &
12286	salsa_nest_offl%nconc_right(1,k,j,ib)
12287	ENDDO
12288	ref_nconc_l(nzb+1:nzt,ib) = ref_nconc_l(nzb+1:nzt,ib) + &
12289	aerosol_number(ib)%conc(nzb+1:nzt,j,nxr+1)
12290	ENDDO
12291	DO ic = 1, ncomponents_mass
12292	icc = ( ic-1 ) * nbins_aerosol + ib
12293	DO j = nys, nyn
12294	DO k = nzb+1, nzt
12295	aerosol_mass(icc)%conc(k,j,nxr+1) = ( 1.0_wp - fac_dt ) * &
12296	salsa_nest_offl%mconc_right(0,k,j,icc) + fac_dt&
12297	* salsa_nest_offl%mconc_right(1,k,j,icc)
12298	ENDDO
12299	ref_mconc_l(nzb+1:nzt,icc) = ref_mconc_l(nzb+1:nzt,icc) + &
12300	aerosol_mass(icc)%conc(nzb+1:nzt,j,nxr+1)
12301	ENDDO
12302	ENDDO
12303	ENDDO
12304	IF ( .NOT. salsa_gases_from_chem ) THEN
12305	DO ig = 1, ngases_salsa
12306	DO j = nys, nyn
12307	DO k = nzb+1, nzt
12308	salsa_gas(ig)%conc(k,j,nxr+1) = ( 1.0_wp - fac_dt ) * &
12309	salsa_nest_offl%gconc_right(0,k,j,ig) + fac_dt *&
12310	salsa_nest_offl%gconc_right(1,k,j,ig)
12311	ENDDO
12312	ref_gconc_l(nzb+1:nzt,ig) = ref_gconc_l(nzb+1:nzt,ig) + &
12313	salsa_gas(ig)%conc(nzb+1:nzt,j,nxr+1)
12314	ENDDO
12315	ENDDO
12316	ENDIF
12317	ENDIF
12318
12319	IF ( bc_dirichlet_n ) THEN
12320	DO ib = 1, nbins_aerosol
12321	DO i = nxl, nxr
12322	DO k = nzb+1, nzt
12323	aerosol_number(ib)%conc(k,nyn+1,i) = ( 1.0_wp - fac_dt ) * &
12324	salsa_nest_offl%nconc_north(0,k,i,ib) + fac_dt * &
12325	salsa_nest_offl%nconc_north(1,k,i,ib)
12326	ENDDO
12327	ref_nconc_l(nzb+1:nzt,ib) = ref_nconc_l(nzb+1:nzt,ib) + &
12328	aerosol_number(ib)%conc(nzb+1:nzt,nyn+1,i)
12329	ENDDO
12330	DO ic = 1, ncomponents_mass
12331	icc = ( ic-1 ) * nbins_aerosol + ib
12332	DO i = nxl, nxr
12333	DO k = nzb+1, nzt
12334	aerosol_mass(icc)%conc(k,nyn+1,i) = ( 1.0_wp - fac_dt ) * &
12335	salsa_nest_offl%mconc_north(0,k,i,icc) + fac_dt&
12336	* salsa_nest_offl%mconc_north(1,k,i,icc)
12337	ENDDO
12338	ref_mconc_l(nzb+1:nzt,icc) = ref_mconc_l(nzb+1:nzt,icc) + &
12339	aerosol_mass(icc)%conc(nzb+1:nzt,nyn+1,i)
12340	ENDDO
12341	ENDDO
12342	ENDDO
12343	IF ( .NOT. salsa_gases_from_chem ) THEN
12344	DO ig = 1, ngases_salsa
12345	DO i = nxl, nxr
12346	DO k = nzb+1, nzt
12347	salsa_gas(ig)%conc(k,nyn+1,i) = ( 1.0_wp - fac_dt ) * &
12348	salsa_nest_offl%gconc_north(0,k,i,ig) + fac_dt *&
12349	salsa_nest_offl%gconc_north(1,k,i,ig)
12350	ENDDO
12351	ref_gconc_l(nzb+1:nzt,ig) = ref_gconc_l(nzb+1:nzt,ig) + &
12352	salsa_gas(ig)%conc(nzb+1:nzt,nyn+1,i)
12353	ENDDO
12354	ENDDO
12355	ENDIF
12356	ENDIF
12357
12358	IF ( bc_dirichlet_s ) THEN
12359	DO ib = 1, nbins_aerosol
12360	DO i = nxl, nxr
12361	DO k = nzb+1, nzt
12362	aerosol_number(ib)%conc(k,-1,i) = ( 1.0_wp - fac_dt ) * &
12363	salsa_nest_offl%nconc_south(0,k,i,ib) + fac_dt * &
12364	salsa_nest_offl%nconc_south(1,k,i,ib)
12365	ENDDO
12366	ref_nconc_l(nzb+1:nzt,ib) = ref_nconc_l(nzb+1:nzt,ib) + &
12367	aerosol_number(ib)%conc(nzb+1:nzt,-1,i)
12368	ENDDO
12369	DO ic = 1, ncomponents_mass
12370	icc = ( ic-1 ) * nbins_aerosol + ib
12371	DO i = nxl, nxr
12372	DO k = nzb+1, nzt
12373	aerosol_mass(icc)%conc(k,-1,i) = ( 1.0_wp - fac_dt ) * &
12374	salsa_nest_offl%mconc_south(0,k,i,icc) + fac_dt&
12375	* salsa_nest_offl%mconc_south(1,k,i,icc)
12376	ENDDO
12377	ref_mconc_l(nzb+1:nzt,icc) = ref_mconc_l(nzb+1:nzt,icc) + &
12378	aerosol_mass(icc)%conc(nzb+1:nzt,-1,i)
12379	ENDDO
12380	ENDDO
12381	ENDDO
12382	IF ( .NOT. salsa_gases_from_chem ) THEN
12383	DO ig = 1, ngases_salsa
12384	DO i = nxl, nxr
12385	DO k = nzb+1, nzt
12386	salsa_gas(ig)%conc(k,-1,i) = ( 1.0_wp - fac_dt ) * &
12387	salsa_nest_offl%gconc_south(0,k,i,ig) + fac_dt * &
12388	salsa_nest_offl%gconc_south(1,k,i,ig)
12389	ENDDO
12390	ref_gconc_l(nzb+1:nzt,ig) = ref_gconc_l(nzb+1:nzt,ig) + &
12391	salsa_gas(ig)%conc(nzb+1:nzt,-1,i)
12392	ENDDO
12393	ENDDO
12394	ENDIF
12395	ENDIF
12396	!
12397	!-- Top boundary
12398	DO ib = 1, nbins_aerosol
12399	DO i = nxl, nxr
12400	DO j = nys, nyn
12401	aerosol_number(ib)%conc(nzt+1,j,i) = ( 1.0_wp - fac_dt ) * &
12402	salsa_nest_offl%nconc_top(0,j,i,ib) + fac_dt * &
12403	salsa_nest_offl%nconc_top(1,j,i,ib)
12404	ref_nconc_l(nzt+1,ib) = ref_nconc_l(nzt+1,ib) + aerosol_number(ib)%conc(nzt+1,j,i)
12405	ENDDO
12406	ENDDO
12407	DO ic = 1, ncomponents_mass
12408	icc = ( ic-1 ) * nbins_aerosol + ib
12409	DO i = nxl, nxr
12410	DO j = nys, nyn
12411	aerosol_mass(icc)%conc(nzt+1,j,i) = ( 1.0_wp - fac_dt ) * &
12412	salsa_nest_offl%mconc_top(0,j,i,icc) + fac_dt *&
12413	salsa_nest_offl%mconc_top(1,j,i,icc)
12414	ref_mconc_l(nzt+1,icc) = ref_mconc_l(nzt+1,icc) + aerosol_mass(icc)%conc(nzt+1,j,i)
12415	ENDDO
12416	ENDDO
12417	ENDDO
12418	ENDDO
12419	IF ( .NOT. salsa_gases_from_chem ) THEN
12420	DO ig = 1, ngases_salsa
12421	DO i = nxl, nxr
12422	DO j = nys, nyn
12423	salsa_gas(ig)%conc(nzt+1,j,i) = ( 1.0_wp - fac_dt ) * &
12424	salsa_nest_offl%gconc_top(0,j,i,ig) + fac_dt * &
12425	salsa_nest_offl%gconc_top(1,j,i,ig)
12426	ref_gconc_l(nzt+1,ig) = ref_gconc_l(nzt+1,ig) + salsa_gas(ig)%conc(nzt+1,j,i)
12427	ENDDO
12428	ENDDO
12429	ENDDO
12430	ENDIF
12431	!
12432	!-- Do local exchange
12433	DO ib = 1, nbins_aerosol
12434	CALL exchange_horiz( aerosol_number(ib)%conc, nbgp )
12435	DO ic = 1, ncomponents_mass
12436	icc = ( ic-1 ) * nbins_aerosol + ib
12437	CALL exchange_horiz( aerosol_mass(icc)%conc, nbgp )
12438	ENDDO
12439	ENDDO
12440	IF ( .NOT. salsa_gases_from_chem ) THEN
12441	DO ig = 1, ngases_salsa
12442	CALL exchange_horiz( salsa_gas(ig)%conc, nbgp )
12443	ENDDO
12444	ENDIF
12445	!
12446	!-- In case of Rayleigh damping, where the initial profiles are still used, update these profiles
12447	!-- from the averaged boundary data. But first, average these data.
12448	#if defined( __parallel )
12449	IF ( .NOT. salsa_gases_from_chem ) &
12450	CALL MPI_ALLREDUCE( ref_gconc_l, ref_gconc, ( nzt+1-nzb+1 ) * SIZE( ref_gconc(nzb,:) ), &
12451	MPI_REAL, MPI_SUM, comm2d, ierr )
12452	CALL MPI_ALLREDUCE( ref_mconc_l, ref_mconc, ( nzt+1-nzb+1 ) * SIZE( ref_mconc(nzb,:) ), &
12453	MPI_REAL, MPI_SUM, comm2d, ierr )
12454	CALL MPI_ALLREDUCE( ref_nconc_l, ref_nconc, ( nzt+1-nzb+1 ) * SIZE( ref_nconc(nzb,:) ), &
12455	MPI_REAL, MPI_SUM, comm2d, ierr )
12456	#else
12457	IF ( .NOT. salsa_gases_from_chem ) ref_gconc = ref_gconc_l
12458	ref_mconc = ref_mconc_l
12459	ref_nconc = ref_nconc_l
12460	#endif
12461	!
12462	!-- Average data. Note, reference profiles up to nzt are derived from lateral boundaries, at the
12463	!-- model top it is derived from the top boundary. Thus, number of input data is different from
12464	!-- nzb:nzt compared to nzt+1.
12465	!-- Derived from lateral boundaries.
12466	IF ( .NOT. salsa_gases_from_chem ) &
12467	ref_gconc(nzb:nzt,:) = ref_gconc(nzb:nzt,:) / REAL( 2.0_wp * ( ny + 1 + nx + 1 ), KIND = wp )
12468	ref_mconc(nzb:nzt,:) = ref_mconc(nzb:nzt,:) / REAL( 2.0_wp * ( ny + 1 + nx + 1 ), KIND = wp )
12469	ref_nconc(nzb:nzt,:) = ref_nconc(nzb:nzt,:) / REAL( 2.0_wp * ( ny + 1 + nx + 1 ), KIND = wp )
12470	!
12471	!-- Derived from top boundary
12472	IF ( .NOT. salsa_gases_from_chem ) &
12473	ref_gconc(nzt+1,:) = ref_gconc(nzt+1,:) / REAL( ( ny + 1 ) * ( nx + 1 ), KIND = wp )
12474	ref_mconc(nzt+1,:) = ref_mconc(nzt+1,:) / REAL( ( ny + 1 ) * ( nx + 1 ), KIND = wp )
12475	ref_nconc(nzt+1,:) = ref_nconc(nzt+1,:) / REAL( ( ny + 1 ) * ( nx + 1 ), KIND = wp )
12476	!
12477	!-- Write onto init profiles, which are used for damping. Also set lower boundary condition.
12478	DO ib = 1, nbins_aerosol
12479	aerosol_number(ib)%init(:) = ref_nconc(:,ib)
12480	aerosol_number(ib)%init(nzb) = aerosol_number(ib)%init(nzb+1)
12481	DO ic = 1, ncomponents_mass
12482	icc = ( ic-1 ) * nbins_aerosol + ib
12483	aerosol_mass(icc)%init(:) = ref_mconc(:,icc)
12484	aerosol_mass(icc)%init(nzb) = aerosol_mass(icc)%init(nzb+1)
12485	ENDDO
12486	ENDDO
12487	IF ( .NOT. salsa_gases_from_chem ) THEN
12488	DO ig = 1, ngases_salsa
12489	salsa_gas(ig)%init(:) = ref_gconc(:,ig)
12490	salsa_gas(ig)%init(nzb) = salsa_gas(ig)%init(nzb+1)
12491	ENDDO
12492	ENDIF
12493
12494	DEALLOCATE( ref_gconc, ref_gconc_l, ref_mconc, ref_mconc_l, ref_nconc, ref_nconc_l )
12495
12496	END SUBROUTINE salsa_nesting_offl_bc
12497
12498	!------------------------------------------------------------------------------!
12499	! Description:
12500	! ------------
12501	!> Allocate arrays used to read boundary data from NetCDF file and initialize
12502	!> boundary data.
12503	!------------------------------------------------------------------------------!
12504	SUBROUTINE salsa_nesting_offl_init
12505
12506	USE control_parameters, &
12507	ONLY: end_time, initializing_actions, spinup_time
12508
12509	USE palm_date_time_mod, &
12510	ONLY: get_date_time
12511
12512	IMPLICIT NONE
12513
12514	INTEGER(iwp) :: ib !< running index for aerosol number bins
12515	INTEGER(iwp) :: ic !< running index for aerosol mass bins
12516	INTEGER(iwp) :: icc !< additional running index for aerosol mass bins
12517	INTEGER(iwp) :: ig !< running index for gaseous species
12518	INTEGER(iwp) :: nmass_bins !< number of aerosol mass bins
12519
12520	nmass_bins = nbins_aerosol * ncomponents_mass
12521	!
12522	!-- Allocate arrays for reading boundary values. Arrays will incorporate 2 time levels in order to
12523	!-- interpolate in between.
12524	IF ( nesting_offline_salsa ) THEN
12525	IF ( bc_dirichlet_l ) THEN
12526	ALLOCATE( salsa_nest_offl%nconc_left(0:1,nzb+1:nzt,nys:nyn,1:nbins_aerosol) )
12527	ALLOCATE( salsa_nest_offl%mconc_left(0:1,nzb+1:nzt,nys:nyn,1:nmass_bins) )
12528	ENDIF
12529	IF ( bc_dirichlet_r ) THEN
12530	ALLOCATE( salsa_nest_offl%nconc_right(0:1,nzb+1:nzt,nys:nyn,1:nbins_aerosol) )
12531	ALLOCATE( salsa_nest_offl%mconc_right(0:1,nzb+1:nzt,nys:nyn,1:nmass_bins) )
12532	ENDIF
12533	IF ( bc_dirichlet_n ) THEN
12534	ALLOCATE( salsa_nest_offl%nconc_north(0:1,nzb+1:nzt,nxl:nxr,1:nbins_aerosol) )
12535	ALLOCATE( salsa_nest_offl%mconc_north(0:1,nzb+1:nzt,nxl:nxr,1:nmass_bins) )
12536	ENDIF
12537	IF ( bc_dirichlet_s ) THEN
12538	ALLOCATE( salsa_nest_offl%nconc_south(0:1,nzb+1:nzt,nxl:nxr,1:nbins_aerosol) )
12539	ALLOCATE( salsa_nest_offl%mconc_south(0:1,nzb+1:nzt,nxl:nxr,1:nmass_bins) )
12540	ENDIF
12541	ALLOCATE( salsa_nest_offl%nconc_top(0:1,nys:nyn,nxl:nxr,1:nbins_aerosol) )
12542	ALLOCATE( salsa_nest_offl%mconc_top(0:1,nys:nyn,nxl:nxr,1:nmass_bins) )
12543
12544	IF ( .NOT. salsa_gases_from_chem ) THEN
12545	IF ( bc_dirichlet_l ) THEN
12546	ALLOCATE( salsa_nest_offl%gconc_left(0:1,nzb+1:nzt,nys:nyn,1:ngases_salsa) )
12547	ENDIF
12548	IF ( bc_dirichlet_r ) THEN
12549	ALLOCATE( salsa_nest_offl%gconc_right(0:1,nzb+1:nzt,nys:nyn,1:ngases_salsa) )
12550	ENDIF
12551	IF ( bc_dirichlet_n ) THEN
12552	ALLOCATE( salsa_nest_offl%gconc_north(0:1,nzb+1:nzt,nxl:nxr,1:ngases_salsa) )
12553	ENDIF
12554	IF ( bc_dirichlet_s ) THEN
12555	ALLOCATE( salsa_nest_offl%gconc_south(0:1,nzb+1:nzt,nxl:nxr,1:ngases_salsa) )
12556	ENDIF
12557	ALLOCATE( salsa_nest_offl%gconc_top(0:1,nys:nyn,nxl:nxr,1:ngases_salsa) )
12558	ENDIF
12559
12560	!
12561	!-- Read data at lateral and top boundaries from a larger-scale model
12562	CALL salsa_nesting_offl_input
12563	!
12564	!-- Check if sufficient time steps are provided to cover the entire simulation. Note, dynamic
12565	!-- input is only required for the 3D simulation, not for the soil/wall spinup. However, as the
12566	!-- spinup time is added to the end_time, this must be considered here.
12567	IF ( end_time - spinup_time > salsa_nest_offl%time(salsa_nest_offl%nt-1) ) THEN
12568	message_string = 'end_time of the simulation exceeds the time dimension in the dynamic'//&
12569	' input file.'
12570	CALL message( 'salsa_nesting_offl_init', 'PA0690', 1, 2, 0, 6, 0 )
12571	ENDIF
12572
12573	IF ( salsa_nest_offl%time(0) /= 0.0_wp ) THEN
12574	message_string = 'Offline nesting: time dimension must start at 0.0.'
12575	CALL message( 'salsa_nesting_offl_init', 'PA0691', 1, 2, 0, 6, 0 )
12576	ENDIF
12577	!
12578	!-- Initialize boundary data. Please note, do not initialize boundaries in case of restart runs.
12579	IF ( TRIM( initializing_actions ) /= 'read_restart_data' .AND. read_restart_data_salsa ) &
12580	THEN
12581	IF ( bc_dirichlet_l ) THEN
12582	DO ib = 1, nbins_aerosol
12583	aerosol_number(ib)%conc(nzb+1:nzt,nys:nyn,-1) = &
12584	salsa_nest_offl%nconc_left(0,nzb+1:nzt,nys:nyn,ib)
12585	DO ic = 1, ncomponents_mass
12586	icc = ( ic - 1 ) * nbins_aerosol + ib
12587	aerosol_mass(icc)%conc(nzb+1:nzt,nys:nyn,-1) = &
12588	salsa_nest_offl%mconc_left(0,nzb+1:nzt,nys:nyn,icc)
12589	ENDDO
12590	ENDDO
12591	DO ig = 1, ngases_salsa
12592	salsa_gas(ig)%conc(nzb+1:nzt,nys:nyn,-1) = &
12593	salsa_nest_offl%gconc_left(0,nzb+1:nzt,nys:nyn,ig)
12594	ENDDO
12595	ENDIF
12596	IF ( bc_dirichlet_r ) THEN
12597	DO ib = 1, nbins_aerosol
12598	aerosol_number(ib)%conc(nzb+1:nzt,nys:nyn,nxr+1) = &
12599	salsa_nest_offl%nconc_right(0,nzb+1:nzt,nys:nyn,ib)
12600	DO ic = 1, ncomponents_mass
12601	icc = ( ic - 1 ) * nbins_aerosol + ib
12602	aerosol_mass(icc)%conc(nzb+1:nzt,nys:nyn,nxr+1) = &
12603	salsa_nest_offl%mconc_right(0,nzb+1:nzt,nys:nyn,icc)
12604	ENDDO
12605	ENDDO
12606	DO ig = 1, ngases_salsa
12607	salsa_gas(ig)%conc(nzb+1:nzt,nys:nyn,nxr+1) = &
12608	salsa_nest_offl%gconc_right(0,nzb+1:nzt,nys:nyn,ig)
12609	ENDDO
12610	ENDIF
12611	IF ( bc_dirichlet_n ) THEN
12612	DO ib = 1, nbins_aerosol
12613	aerosol_number(ib)%conc(nzb+1:nzt,nyn+1,nxl:nxr) = &
12614	salsa_nest_offl%nconc_north(0,nzb+1:nzt,nxl:nxr,ib)
12615	DO ic = 1, ncomponents_mass
12616	icc = ( ic - 1 ) * nbins_aerosol + ib
12617	aerosol_mass(icc)%conc(nzb+1:nzt,nyn+1,nxl:nxr) = &
12618	salsa_nest_offl%mconc_north(0,nzb+1:nzt,nxl:nxr,icc)
12619	ENDDO
12620	ENDDO
12621	DO ig = 1, ngases_salsa
12622	salsa_gas(ig)%conc(nzb+1:nzt,nyn+1,nxl:nxr) = &
12623	salsa_nest_offl%gconc_north(0,nzb+1:nzt,nxl:nxr,ig)
12624	ENDDO
12625	ENDIF
12626	IF ( bc_dirichlet_s ) THEN
12627	DO ib = 1, nbins_aerosol
12628	aerosol_number(ib)%conc(nzb+1:nzt,-1,nxl:nxr) = &
12629	salsa_nest_offl%nconc_south(0,nzb+1:nzt,nxl:nxr,ib)
12630	DO ic = 1, ncomponents_mass
12631	icc = ( ic - 1 ) * nbins_aerosol + ib
12632	aerosol_mass(icc)%conc(nzb+1:nzt,-1,nxl:nxr) = &
12633	salsa_nest_offl%mconc_south(0,nzb+1:nzt,nxl:nxr,icc)
12634	ENDDO
12635	ENDDO
12636	DO ig = 1, ngases_salsa
12637	salsa_gas(ig)%conc(nzb+1:nzt,-1,nxl:nxr) = &
12638	salsa_nest_offl%gconc_south(0,nzb+1:nzt,nxl:nxr,ig)
12639	ENDDO
12640	ENDIF
12641	ENDIF
12642	ENDIF
12643
12644	END SUBROUTINE salsa_nesting_offl_init
12645
12646	!------------------------------------------------------------------------------!
12647	! Description:
12648	! ------------
12649	!> Set the lateral and top boundary conditions in case the PALM domain is
12650	!> nested offline in a mesoscale model. Further, average boundary data and
12651	!> determine mean profiles, further used for correct damping in the sponge
12652	!> layer.
12653	!------------------------------------------------------------------------------!
12654	SUBROUTINE salsa_nesting_offl_input
12655
12656	USE netcdf_data_input_mod, &
12657	ONLY: check_existence, close_input_file, get_attribute, get_variable, &
12658	inquire_num_variables, inquire_variable_names, &
12659	get_dimension_length, open_read_file
12660
12661	IMPLICIT NONE
12662
12663	CHARACTER(LEN=25) :: vname !< variable name
12664
12665	INTEGER(iwp) :: ic !< running index for aerosol chemical components
12666	INTEGER(iwp) :: ig !< running index for gases
12667	INTEGER(iwp) :: num_vars !< number of variables in netcdf input file
12668
12669	!
12670	!-- Skip input if no forcing from larger-scale models is applied.
12671	IF ( .NOT. nesting_offline_salsa ) RETURN
12672	!
12673	!-- Initialise
12674	IF ( .NOT. salsa_nest_offl%init ) THEN
12675
12676	#if defined ( __netcdf )
12677	!
12678	!-- Open file in read-only mode
12679	CALL open_read_file( TRIM( input_file_dynamic ) // TRIM( coupling_char ), &
12680	salsa_nest_offl%id_dynamic )
12681	!
12682	!-- At first, inquire all variable names.
12683	CALL inquire_num_variables( salsa_nest_offl%id_dynamic, num_vars )
12684	!
12685	!-- Allocate memory to store variable names.
12686	ALLOCATE( salsa_nest_offl%var_names(1:num_vars) )
12687	CALL inquire_variable_names( salsa_nest_offl%id_dynamic, salsa_nest_offl%var_names )
12688	!
12689	!-- Read time dimension, allocate memory and finally read time array
12690	CALL get_dimension_length( salsa_nest_offl%id_dynamic, salsa_nest_offl%nt,&
12691	'time' )
12692
12693	IF ( check_existence( salsa_nest_offl%var_names, 'time' ) ) THEN
12694	ALLOCATE( salsa_nest_offl%time(0:salsa_nest_offl%nt-1) )
12695	CALL get_variable( salsa_nest_offl%id_dynamic, 'time', salsa_nest_offl%time )
12696	ENDIF
12697	!
12698	!-- Read the vertical dimension
12699	CALL get_dimension_length( salsa_nest_offl%id_dynamic, salsa_nest_offl%nzu, 'z' )
12700	ALLOCATE( salsa_nest_offl%zu_atmos(1:salsa_nest_offl%nzu) )
12701	CALL get_variable( salsa_nest_offl%id_dynamic, 'z', salsa_nest_offl%zu_atmos )
12702	!
12703	!-- Read the number of aerosol chemical components
12704	CALL get_dimension_length( salsa_nest_offl%id_dynamic, salsa_nest_offl%ncc, &
12705	'composition_index' )
12706	!
12707	!-- Read the names of aerosol chemical components
12708	CALL get_variable( salsa_nest_offl%id_dynamic, 'composition_name', salsa_nest_offl%cc_name, &
12709	salsa_nest_offl%ncc )
12710	!
12711	!-- Define the index of each chemical component in the model
12712	DO ic = 1, salsa_nest_offl%ncc
12713	SELECT CASE ( TRIM( salsa_nest_offl%cc_name(ic) ) )
12714	CASE ( 'H2SO4', 'SO4', 'h2so4', 'so4' )
12715	salsa_nest_offl%cc_in2mod(1) = ic
12716	CASE ( 'OC', 'oc' )
12717	salsa_nest_offl%cc_in2mod(2) = ic
12718	CASE ( 'BC', 'bc' )
12719	salsa_nest_offl%cc_in2mod(3) = ic
12720	CASE ( 'DU', 'du' )
12721	salsa_nest_offl%cc_in2mod(4) = ic
12722	CASE ( 'SS', 'ss' )
12723	salsa_nest_offl%cc_in2mod(5) = ic
12724	CASE ( 'HNO3', 'hno3', 'NO3', 'no3', 'NO', 'no' )
12725	salsa_nest_offl%cc_in2mod(6) = ic
12726	CASE ( 'NH3', 'nh3', 'NH4', 'nh4', 'NH', 'nh' )
12727	salsa_nest_offl%cc_in2mod(7) = ic
12728	END SELECT
12729	ENDDO
12730	IF ( SUM( salsa_nest_offl%cc_in2mod ) == 0 ) THEN
12731	message_string = 'None of the aerosol chemical components in ' // &
12732	TRIM( input_file_dynamic ) // ' correspond to ones applied in SALSA.'
12733	CALL message( 'salsa_mod: salsa_nesting_offl_input', 'PA0693', 2, 2, 0, 6, 0 )
12734	ENDIF
12735
12736	CALL close_input_file( salsa_nest_offl%id_dynamic )
12737	#endif
12738	ENDIF
12739	!
12740	!-- Check if dynamic driver data input is required.
12741	IF ( salsa_nest_offl%time(salsa_nest_offl%tind_p) <= MAX( time_since_reference_point, 0.0_wp) &
12742	.OR. .NOT. salsa_nest_offl%init ) THEN
12743	CONTINUE
12744	!
12745	!-- Return otherwise
12746	ELSE
12747	RETURN
12748	ENDIF
12749	!
12750	!-- Obtain time index for current point in time.
12751	salsa_nest_offl%tind = MINLOC( ABS( salsa_nest_offl%time - &
12752	MAX( time_since_reference_point, 0.0_wp ) ), DIM = 1 ) - 1
12753	salsa_nest_offl%tind_p = salsa_nest_offl%tind + 1
12754	!
12755	!-- Open file in read-only mode
12756	#if defined ( __netcdf )
12757
12758	CALL open_read_file( TRIM( input_file_dynamic ) // TRIM( coupling_char ), &
12759	salsa_nest_offl%id_dynamic )
12760	!
12761	!-- Read data at the western boundary
12762	CALL get_variable( salsa_nest_offl%id_dynamic, 'ls_forcing_left_aerosol', &
12763	salsa_nest_offl%nconc_left, &
12764	MERGE( 0, 1, bc_dirichlet_l ), MERGE( nbins_aerosol-1, 0, bc_dirichlet_l ), &
12765	MERGE( nys, 1, bc_dirichlet_l ), MERGE( nyn, 0, bc_dirichlet_l ), &
12766	MERGE( nzb, 1, bc_dirichlet_l ), MERGE( nzt-1, 0, bc_dirichlet_l ), &
12767	MERGE( salsa_nest_offl%tind, 1, bc_dirichlet_l ), &
12768	MERGE( salsa_nest_offl%tind_p, 0, bc_dirichlet_l ) )
12769	IF ( bc_dirichlet_l ) THEN
12770	salsa_nest_offl%nconc_left = MAX( nclim, salsa_nest_offl%nconc_left )
12771	CALL nesting_offl_aero_mass( salsa_nest_offl%tind, salsa_nest_offl%tind_p, nzb+1, nzt, nys, &
12772	nyn, 'ls_forcing_left_mass_fracs_a', 1 )
12773	ENDIF
12774	IF ( .NOT. salsa_gases_from_chem ) THEN
12775	DO ig = 1, ngases_salsa
12776	vname = salsa_nest_offl%char_l // salsa_nest_offl%gas_name(ig)
12777	CALL get_variable( salsa_nest_offl%id_dynamic, TRIM( vname ), &
12778	salsa_nest_offl%gconc_left(:,:,:,ig), &
12779	MERGE( nys, 1, bc_dirichlet_l ), MERGE( nyn, 0, bc_dirichlet_l ), &
12780	MERGE( nzb, 1, bc_dirichlet_l ), MERGE( nzt-1, 0, bc_dirichlet_l ), &
12781	MERGE( salsa_nest_offl%tind, 1, bc_dirichlet_l ), &
12782	MERGE( salsa_nest_offl%tind_p, 0, bc_dirichlet_l ) )
12783	IF ( bc_dirichlet_l ) salsa_nest_offl%gconc_left(:,:,:,ig) = &
12784	MAX( nclim, salsa_nest_offl%gconc_left(:,:,:,ig) )
12785	ENDDO
12786	ENDIF
12787	!
12788	!-- Read data at the eastern boundary
12789	CALL get_variable( salsa_nest_offl%id_dynamic, 'ls_forcing_right_aerosol', &
12790	salsa_nest_offl%nconc_right, &
12791	MERGE( 0, 1, bc_dirichlet_r ), MERGE( nbins_aerosol-1, 0, bc_dirichlet_r ), &
12792	MERGE( nys, 1, bc_dirichlet_r ), MERGE( nyn, 0, bc_dirichlet_r ), &
12793	MERGE( nzb, 1, bc_dirichlet_r ), MERGE( nzt-1, 0, bc_dirichlet_r ), &
12794	MERGE( salsa_nest_offl%tind, 1, bc_dirichlet_r ), &
12795	MERGE( salsa_nest_offl%tind_p, 0, bc_dirichlet_r ) )
12796	IF ( bc_dirichlet_r ) THEN
12797	salsa_nest_offl%nconc_right = MAX( nclim, salsa_nest_offl%nconc_right )
12798	CALL nesting_offl_aero_mass( salsa_nest_offl%tind, salsa_nest_offl%tind_p, nzb+1, nzt, nys, &
12799	nyn, 'ls_forcing_right_mass_fracs_a', 2 )
12800	ENDIF
12801	IF ( .NOT. salsa_gases_from_chem ) THEN
12802	DO ig = 1, ngases_salsa
12803	vname = salsa_nest_offl%char_r // salsa_nest_offl%gas_name(ig)
12804	CALL get_variable( salsa_nest_offl%id_dynamic, TRIM( vname ), &
12805	salsa_nest_offl%gconc_right(:,:,:,ig), &
12806	MERGE( nys, 1, bc_dirichlet_r ), MERGE( nyn, 0, bc_dirichlet_r ), &
12807	MERGE( nzb, 1, bc_dirichlet_r ), MERGE( nzt-1, 0, bc_dirichlet_r ), &
12808	MERGE( salsa_nest_offl%tind, 1, bc_dirichlet_r ), &
12809	MERGE( salsa_nest_offl%tind_p, 0, bc_dirichlet_r ) )
12810	IF ( bc_dirichlet_r ) salsa_nest_offl%gconc_right(:,:,:,ig) = &
12811	MAX( nclim, salsa_nest_offl%gconc_right(:,:,:,ig) )
12812	ENDDO
12813	ENDIF
12814	!
12815	!-- Read data at the northern boundary
12816	CALL get_variable( salsa_nest_offl%id_dynamic, 'ls_forcing_north_aerosol', &
12817	salsa_nest_offl%nconc_north, &
12818	MERGE( 0, 1, bc_dirichlet_n ), MERGE( nbins_aerosol-1, 0, bc_dirichlet_n ), &
12819	MERGE( nxl, 1, bc_dirichlet_n ), MERGE( nxr, 0, bc_dirichlet_n ), &
12820	MERGE( nzb, 1, bc_dirichlet_n ), MERGE( nzt-1, 0, bc_dirichlet_n ), &
12821	MERGE( salsa_nest_offl%tind, 1, bc_dirichlet_n ), &
12822	MERGE( salsa_nest_offl%tind_p, 0, bc_dirichlet_n ) )
12823	IF ( bc_dirichlet_n ) THEN
12824	salsa_nest_offl%nconc_north = MAX( nclim, salsa_nest_offl%nconc_north )
12825	CALL nesting_offl_aero_mass( salsa_nest_offl%tind, salsa_nest_offl%tind_p, nzb+1, nzt, nxl, &
12826	nxr, 'ls_forcing_north_mass_fracs_a', 3 )
12827	ENDIF
12828	IF ( .NOT. salsa_gases_from_chem ) THEN
12829	DO ig = 1, ngases_salsa
12830	vname = salsa_nest_offl%char_n // salsa_nest_offl%gas_name(ig)
12831	CALL get_variable( salsa_nest_offl%id_dynamic, TRIM( vname ), &
12832	salsa_nest_offl%gconc_north(:,:,:,ig), &
12833	MERGE( nxl, 1, bc_dirichlet_n ), MERGE( nxr, 0, bc_dirichlet_n ), &
12834	MERGE( nzb, 1, bc_dirichlet_n ), MERGE( nzt-1, 0, bc_dirichlet_n ), &
12835	MERGE( salsa_nest_offl%tind, 1, bc_dirichlet_n ), &
12836	MERGE( salsa_nest_offl%tind_p, 0, bc_dirichlet_n ) )
12837	IF ( bc_dirichlet_n ) salsa_nest_offl%gconc_north(:,:,:,ig) = &
12838	MAX( nclim, salsa_nest_offl%gconc_north(:,:,:,ig) )
12839	ENDDO
12840	ENDIF
12841	!
12842	!-- Read data at the southern boundary
12843	CALL get_variable( salsa_nest_offl%id_dynamic, 'ls_forcing_south_aerosol', &
12844	salsa_nest_offl%nconc_south, &
12845	MERGE( 0, 1, bc_dirichlet_s ), MERGE( nbins_aerosol-1, 0, bc_dirichlet_s ), &
12846	MERGE( nxl, 1, bc_dirichlet_s ), MERGE( nxr, 0, bc_dirichlet_s ), &
12847	MERGE( nzb, 1, bc_dirichlet_s ), MERGE( nzt-1, 0, bc_dirichlet_s ), &
12848	MERGE( salsa_nest_offl%tind, 1, bc_dirichlet_s ), &
12849	MERGE( salsa_nest_offl%tind_p, 0, bc_dirichlet_s ) )
12850	IF ( bc_dirichlet_s ) THEN
12851	salsa_nest_offl%nconc_south = MAX( nclim, salsa_nest_offl%nconc_south )
12852	CALL nesting_offl_aero_mass( salsa_nest_offl%tind, salsa_nest_offl%tind_p, nzb+1, nzt, nxl, &
12853	nxr, 'ls_forcing_south_mass_fracs_a', 4 )
12854	ENDIF
12855	IF ( .NOT. salsa_gases_from_chem ) THEN
12856	DO ig = 1, ngases_salsa
12857	vname = salsa_nest_offl%char_s // salsa_nest_offl%gas_name(ig)
12858	CALL get_variable( salsa_nest_offl%id_dynamic, TRIM( vname ), &
12859	salsa_nest_offl%gconc_south(:,:,:,ig), &
12860	MERGE( nxl, 1, bc_dirichlet_s ), MERGE( nxr, 0, bc_dirichlet_s ), &
12861	MERGE( nzb, 1, bc_dirichlet_s ), MERGE( nzt-1, 0, bc_dirichlet_s ), &
12862	MERGE( salsa_nest_offl%tind, 1, bc_dirichlet_s ), &
12863	MERGE( salsa_nest_offl%tind_p, 0, bc_dirichlet_s ) )
12864	IF ( bc_dirichlet_s ) salsa_nest_offl%gconc_south(:,:,:,ig) = &
12865	MAX( nclim, salsa_nest_offl%gconc_south(:,:,:,ig) )
12866	ENDDO
12867	ENDIF
12868	!
12869	!-- Read data at the top boundary
12870	CALL get_variable( salsa_nest_offl%id_dynamic, 'ls_forcing_top_aerosol', &
12871	salsa_nest_offl%nconc_top(0:1,nys:nyn,nxl:nxr,1:nbins_aerosol), &
12872	0, nbins_aerosol-1, nxl, nxr, nys, nyn, salsa_nest_offl%tind, &
12873	salsa_nest_offl%tind_p )
12874	salsa_nest_offl%nconc_top = MAX( nclim, salsa_nest_offl%nconc_top )
12875	CALL nesting_offl_aero_mass( salsa_nest_offl%tind, salsa_nest_offl%tind_p, nys, nyn, nxl, nxr, &
12876	'ls_forcing_top_mass_fracs_a', 5 )
12877	IF ( .NOT. salsa_gases_from_chem ) THEN
12878	DO ig = 1, ngases_salsa
12879	vname = salsa_nest_offl%char_t // salsa_nest_offl%gas_name(ig)
12880	CALL get_variable( salsa_nest_offl%id_dynamic, TRIM( vname ), &
12881	salsa_nest_offl%gconc_top(:,:,:,ig), nxl, nxr, nys, nyn, &
12882	salsa_nest_offl%tind, salsa_nest_offl%tind_p )
12883	salsa_nest_offl%gconc_top(:,:,:,ig) = MAX( nclim, salsa_nest_offl%gconc_top(:,:,:,ig) )
12884	ENDDO
12885	ENDIF
12886	!
12887	!-- Close input file
12888	CALL close_input_file( salsa_nest_offl%id_dynamic )
12889
12890	#endif
12891	!
12892	!-- Set control flag to indicate that initialization is already done
12893	salsa_nest_offl%init = .TRUE.
12894
12895	END SUBROUTINE salsa_nesting_offl_input
12896
12897	!------------------------------------------------------------------------------!
12898	! Description:
12899	! ------------
12900	!> Sets the mass concentrations to aerosol arrays in 2a and 2b.
12901	!------------------------------------------------------------------------------!
12902	SUBROUTINE nesting_offl_aero_mass( ts, te, ks, ke, is, ie, varname_a, ibound )
12903
12904	USE netcdf_data_input_mod, &
12905	ONLY: get_variable
12906
12907	IMPLICIT NONE
12908
12909	CHARACTER(LEN=25) :: varname_b !< name for bins b
12910
12911	CHARACTER(LEN=*), INTENT(in) :: varname_a !< name for bins a
12912
12913	INTEGER(iwp) :: ee !< loop index: end
12914	INTEGER(iwp) :: i !< loop index
12915	INTEGER(iwp) :: ib !< loop index
12916	INTEGER(iwp) :: ic !< loop index
12917	INTEGER(iwp) :: k !< loop index
12918	INTEGER(iwp) :: ss !< loop index: start
12919	INTEGER(iwp) :: t !< loop index
12920	INTEGER(iwp) :: type_so4_oc = -1 !<
12921
12922	INTEGER(iwp), INTENT(in) :: ibound !< index: 1=left, 2=right, 3=north, 4=south, 5=top
12923	INTEGER(iwp), INTENT(in) :: ie !< loop index
12924	INTEGER(iwp), INTENT(in) :: is !< loop index
12925	INTEGER(iwp), INTENT(in) :: ks !< loop index
12926	INTEGER(iwp), INTENT(in) :: ke !< loop index
12927	INTEGER(iwp), INTENT(in) :: ts !< loop index
12928	INTEGER(iwp), INTENT(in) :: te !< loop index
12929
12930	INTEGER(iwp), DIMENSION(maxspec) :: cc_i2m !<
12931
12932	REAL(wp) :: pmf1a !< mass fraction in 1a
12933
12934	REAL(wp), DIMENSION(nbins_aerosol) :: core !< size of the bin mid aerosol particle
12935
12936	REAL(wp), DIMENSION(0:1,ks:ke,is:ie,1:nbins_aerosol) :: to_nconc !<
12937	REAL(wp), DIMENSION(0:1,ks:ke,is:ie,1:nbins_aerosol*ncomponents_mass) :: to_mconc !<
12938
12939	REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE :: mf2a !< Mass distributions for a
12940	REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE :: mf2b !< and b bins
12941
12942	!
12943	!-- Variable name for insoluble mass fraction
12944	varname_b = varname_a(1:LEN( TRIM( varname_a ) ) - 1 ) // 'b'
12945	!
12946	!-- Bin mean aerosol particle volume (m3)
12947	core(1:nbins_aerosol) = api6 * aero(1:nbins_aerosol)%dmid**3
12948	!
12949	!-- Allocate and read mass fraction arrays
12950	ALLOCATE( mf2a(0:1,ks:ke,is:ie,1:salsa_nest_offl%ncc), &
12951	mf2b(0:1,ks:ke,is:ie,1:salsa_nest_offl%ncc) )
12952	IF ( ibound == 5 ) THEN
12953	CALL get_variable( salsa_nest_offl%id_dynamic, varname_a, &
12954	mf2a(0:1,ks:ke,is:ie,1:salsa_nest_offl%ncc), 0, salsa_nest_offl%ncc-1, &
12955	is, ie, ks, ke, ts, te )
12956	ELSE
12957	CALL get_variable( salsa_nest_offl%id_dynamic, varname_a, &
12958	mf2a(0:1,ks:ke,is:ie,1:salsa_nest_offl%ncc), 0, salsa_nest_offl%ncc-1, &
12959	is, ie, ks-1, ke-1, ts, te )
12960	ENDIF
12961	!
12962	!-- If the chemical component is not activated, set its mass fraction to 0 to avoid mass inbalance
12963	cc_i2m = salsa_nest_offl%cc_in2mod
12964	IF ( index_so4 < 0 .AND. cc_i2m(1) > 0 ) mf2a(:,:,:,cc_i2m(1)) = 0.0_wp
12965	IF ( index_oc < 0 .AND. cc_i2m(2) > 0 ) mf2a(:,:,:,cc_i2m(2)) = 0.0_wp
12966	IF ( index_bc < 0 .AND. cc_i2m(3) > 0 ) mf2a(:,:,:,cc_i2m(3)) = 0.0_wp
12967	IF ( index_du < 0 .AND. cc_i2m(4) > 0 ) mf2a(:,:,:,cc_i2m(4)) = 0.0_wp
12968	IF ( index_ss < 0 .AND. cc_i2m(5) > 0 ) mf2a(:,:,:,cc_i2m(5)) = 0.0_wp
12969	IF ( index_no < 0 .AND. cc_i2m(6) > 0 ) mf2a(:,:,:,cc_i2m(6)) = 0.0_wp
12970	IF ( index_nh < 0 .AND. cc_i2m(7) > 0 ) mf2a(:,:,:,cc_i2m(7)) = 0.0_wp
12971	mf2b = 0.0_wp
12972	!
12973	!-- Initialise variable type_so4_oc to indicate whether SO4 and/OC is included in mass fraction data
12974	IF ( ( cc_i2m(1) > 0 .AND. index_so4 > 0 ) .AND. ( cc_i2m(2) > 0 .AND. index_oc > 0 ) ) &
12975	THEN
12976	type_so4_oc = 1
12977	ELSEIF ( cc_i2m(1) > 0 .AND. index_so4 > 0 ) THEN
12978	type_so4_oc = 2
12979	ELSEIF ( cc_i2m(2) > 0 .AND. index_oc > 0 ) THEN
12980	type_so4_oc = 3
12981	ENDIF
12982
12983	SELECT CASE ( ibound )
12984	CASE( 1 )
12985	to_nconc = salsa_nest_offl%nconc_left
12986	to_mconc = salsa_nest_offl%mconc_left
12987	CASE( 2 )
12988	to_nconc = salsa_nest_offl%nconc_right
12989	to_mconc = salsa_nest_offl%mconc_right
12990	CASE( 3 )
12991	to_nconc = salsa_nest_offl%nconc_north
12992	to_mconc = salsa_nest_offl%mconc_north
12993	CASE( 4 )
12994	to_nconc = salsa_nest_offl%nconc_south
12995	to_mconc = salsa_nest_offl%mconc_south
12996	CASE( 5 )
12997	to_nconc = salsa_nest_offl%nconc_top
12998	to_mconc = salsa_nest_offl%mconc_top
12999	END SELECT
13000	!
13001	!-- Set mass concentrations:
13002	!
13003	!-- Regime 1:
13004	SELECT CASE ( type_so4_oc )
13005	CASE ( 1 ) ! Both SO4 and OC given
13006
13007	ss = ( index_so4 - 1 ) * nbins_aerosol + start_subrange_1a ! start
13008	ee = ( index_so4 - 1 ) * nbins_aerosol + end_subrange_1a ! end
13009	ib = start_subrange_1a
13010	DO ic = ss, ee
13011	DO i = is, ie
13012	DO k = ks, ke
13013	DO t = 0, 1
13014	pmf1a = mf2a(t,k,i,cc_i2m(1)) / ( mf2a(t,k,i,cc_i2m(1)) + mf2a(t,k,i,cc_i2m(2)) )
13015	to_mconc(t,k,i,ic) = pmf1a * to_nconc(t,k,i,ib) * core(ib) * arhoh2so4
13016	ENDDO
13017	ENDDO
13018	ENDDO
13019	ib = ib + 1
13020	ENDDO
13021	ss = ( index_oc - 1 ) * nbins_aerosol + start_subrange_1a ! start
13022	ee = ( index_oc - 1 ) * nbins_aerosol + end_subrange_1a ! end
13023	ib = start_subrange_1a
13024	DO ic = ss, ee
13025	DO i = is, ie
13026	DO k = ks, ke
13027	DO t = 0, 1
13028	pmf1a = mf2a(t,k,i,cc_i2m(2)) / ( mf2a(t,k,i,cc_i2m(1)) + mf2a(t,k,i,cc_i2m(2)) )
13029	to_mconc(t,k,i,ic) = pmf1a * to_nconc(t,k,i,ib) * core(ib) * arhooc
13030	ENDDO
13031	ENDDO
13032	ENDDO
13033	ib = ib + 1
13034	ENDDO
13035	CASE ( 2 ) ! Only SO4
13036	ss = ( index_so4 - 1 ) * nbins_aerosol + start_subrange_1a ! start
13037	ee = ( index_so4 - 1 ) * nbins_aerosol + end_subrange_1a ! end
13038	ib = start_subrange_1a
13039	DO ic = ss, ee
13040	DO i = is, ie
13041	DO k = ks, ke
13042	DO t = 0, 1
13043	to_mconc(t,k,i,ic) = to_nconc(t,k,i,ib) * core(ib) * arhoh2so4
13044	ENDDO
13045	ENDDO
13046	ENDDO
13047	ib = ib + 1
13048	ENDDO
13049	CASE ( 3 ) ! Only OC
13050	ss = ( index_oc - 1 ) * nbins_aerosol + start_subrange_1a ! start
13051	ee = ( index_oc - 1 ) * nbins_aerosol + end_subrange_1a ! end
13052	ib = start_subrange_1a
13053	DO ic = ss, ee
13054	DO i = is, ie
13055	DO k = ks, ke
13056	DO t = 0, 1
13057	to_mconc(t,k,i,ic) = to_nconc(t,k,i,ib) * core(ib) * arhooc
13058	ENDDO
13059	ENDDO
13060	ENDDO
13061	ib = ib + 1
13062	ENDDO
13063	END SELECT
13064	!
13065	!-- Regimes 2a and 2b:
13066	IF ( index_so4 > 0 ) THEN
13067	CALL set_nest_mass( index_so4, 1, arhoh2so4 )
13068	ENDIF
13069	IF ( index_oc > 0 ) THEN
13070	CALL set_nest_mass( index_oc, 2, arhooc )
13071	ENDIF
13072	IF ( index_bc > 0 ) THEN
13073	CALL set_nest_mass( index_bc, 3, arhobc )
13074	ENDIF
13075	IF ( index_du > 0 ) THEN
13076	CALL set_nest_mass( index_du, 4, arhodu )
13077	ENDIF
13078	IF ( index_ss > 0 ) THEN
13079	CALL set_nest_mass( index_ss, 5, arhoss )
13080	ENDIF
13081	IF ( index_no > 0 ) THEN
13082	CALL set_nest_mass( index_no, 6, arhohno3 )
13083	ENDIF
13084	IF ( index_nh > 0 ) THEN
13085	CALL set_nest_mass( index_nh, 7, arhonh3 )
13086	ENDIF
13087
13088	DEALLOCATE( mf2a, mf2b )
13089
13090	SELECT CASE ( ibound )
13091	CASE( 1 )
13092	salsa_nest_offl%mconc_left = to_mconc
13093	CASE( 2 )
13094	salsa_nest_offl%mconc_right = to_mconc
13095	CASE( 3 )
13096	salsa_nest_offl%mconc_north = to_mconc
13097	CASE( 4 )
13098	salsa_nest_offl%mconc_south = to_mconc
13099	CASE( 5 )
13100	salsa_nest_offl%mconc_top = to_mconc
13101	END SELECT
13102
13103	CONTAINS
13104
13105	!------------------------------------------------------------------------------!
13106	! Description:
13107	! ------------
13108	!> Set nesting boundaries for aerosol mass.
13109	!------------------------------------------------------------------------------!
13110	SUBROUTINE set_nest_mass( ispec, ispec_def, prho )
13111
13112	IMPLICIT NONE
13113
13114	INTEGER(iwp) :: ic !< chemical component index: default
13115	INTEGER(iwp) :: icc !< loop index: mass bin
13116
13117	INTEGER(iwp), INTENT(in) :: ispec !< aerosol species index
13118	INTEGER(iwp), INTENT(in) :: ispec_def !< default aerosol species index
13119
13120	REAL(wp), INTENT(in) :: prho !< aerosol density
13121	!
13122	!-- Define the index of the chemical component in the input data
13123	ic = salsa_nest_offl%cc_in2mod(ispec_def)
13124
13125	DO i = is, ie
13126	DO k = ks, ke
13127	DO t = 0, 1
13128	!
13129	!-- Regime 2a:
13130	ss = ( ispec - 1 ) * nbins_aerosol + start_subrange_2a
13131	ee = ( ispec - 1 ) * nbins_aerosol + end_subrange_2a
13132	ib = start_subrange_2a
13133	DO icc = ss, ee
13134	to_mconc(t,k,i,icc) = MAX( 0.0_wp, mf2a(t,k,i,ic) / SUM( mf2a(t,k,i,:) ) ) * &
13135	to_nconc(t,k,i,ib) * core(ib) * prho
13136	ib = ib + 1
13137	ENDDO
13138	!
13139	!-- Regime 2b:
13140	IF ( .NOT. no_insoluble ) THEN
13141	!
13142	!-- TODO!
13143	mf2b(t,k,i,ic) = mf2b(t,k,i,ic)
13144	ENDIF
13145	ENDDO ! k
13146
13147	ENDDO ! j
13148	ENDDO ! i
13149
13150	END SUBROUTINE set_nest_mass
13151
13152	END SUBROUTINE nesting_offl_aero_mass
13153
13154
13155	END MODULE salsa_mod

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

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |