Home

Context Navigation

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

Last change on this file since 4360 was 4360, checked in by suehring, 5 years ago
Bugfix in output of time-averaged plant-canopy quanities; Output of plant-canopy data only where tall canopy is defined; land-surface model: fix wrong location strings; tests: update urban test case; all source code files: copyright update
Property svn:keywords set to `Id`
File size: 593.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 4360 2020-01-07 11:25:50Z suehring $
28	! Introduction of wall_flags_total_0, which currently sets bits based on static
29	! topography information used in wall_flags_static_0
30	!
31	! 4342 2019-12-16 13:49:14Z Giersch
32	! cdc replaced by canopy_drag_coeff
33	!
34	! 4329 2019-12-10 15:46:36Z motisi
35	! Renamed wall_flags_0 to wall_flags_static_0
36	!
37	! 4315 2019-12-02 09:20:07Z monakurppa
38	! Add an additional check for the time dimension PIDS_SALSA in
39	! salsa_emission_setup and correct some error message identifiers.
40	!
41	! 4298 2019-11-21 15:59:16Z suehring
42	! Bugfix, close netcdf input files after reading
43	!
44	! 4295 2019-11-14 06:15:31Z monakurppa
45	!
46	!
47	! 4280 2019-10-29 14:34:15Z monakurppa
48	! Corrected a bug in boundary conditions and fac_dt in offline nesting
49	!
50	! 4273 2019-10-24 13:40:54Z monakurppa
51	! - Rename nest_salsa to nesting_salsa
52	! - Correct some errors in boundary condition flags
53	! - Add a check for not trying to output gas concentrations in salsa if the
54	! chemistry module is applied
55	! - Set the default value of nesting_salsa and nesting_offline_salsa to .TRUE.
56	!
57	! 4272 2019-10-23 15:18:57Z schwenkel
58	! Further modularization of boundary conditions: moved boundary conditions to
59	! respective modules
60	!
61	! 4270 2019-10-23 10:46:20Z monakurppa
62	! - Implement offline nesting for salsa
63	! - Alphabetic ordering for module interfaces
64	! - Remove init_aerosol_type and init_gases_type from salsa_parin and define them
65	! based on the initializing_actions
66	! - parameter definition removed from "season" and "season_z01" is added to parin
67	! - bugfix in application of index_hh after implementing the new
68	! palm_date_time_mod
69	! - Reformat salsa emission data with LOD=2: size distribution given for each
70	! emission category
71	!
72	! 4268 2019-10-17 11:29:38Z schwenkel
73	! Moving module specific boundary conditions from time_integration to module
74	!
75	! 4256 2019-10-07 10:08:52Z monakurppa
76	! Document previous changes: use global variables nx, ny and nz in salsa_header
77	!
78	! 4227 2019-09-10 18:04:34Z gronemeier
79	! implement new palm_date_time_mod
80	!
81	! 4226 2019-09-10 17:03:24Z suehring
82	! Netcdf input routine for dimension length renamed
83	!
84	! 4182 2019-08-22 15:20:23Z scharf
85	! Corrected "Former revisions" section
86	!
87	! 4167 2019-08-16 11:01:48Z suehring
88	! Changed behaviour of masked output over surface to follow terrain and ignore
89	! buildings (J.Resler, T.Gronemeier)
90	!
91	! 4131 2019-08-02 11:06:18Z monakurppa
92	! - Add "salsa_" before each salsa output variable
93	! - Add a possibility to output the number (salsa_N_UFP) and mass concentration
94	! (salsa_PM0.1) of ultrafine particles, i.e. particles with a diameter smaller
95	! than 100 nm
96	! - Implement aerosol emission mode "parameterized" which is based on the street
97	! type (similar to the chemistry module).
98	! - Remove unnecessary nucleation subroutines.
99	! - Add the z-dimension for gaseous emissions to correspond the implementation
100	! in the chemistry module
101	!
102	! 4118 2019-07-25 16:11:45Z suehring
103	! - When Dirichlet condition is applied in decycling, the boundary conditions are
104	! only set at the ghost points and not at the prognostic grid points as done
105	! before
106	! - Rename decycle_ns/lr to decycle_salsa_ns/lr and decycle_method to
107	! decycle_method_salsa
108	! - Allocation and initialization of special advection flags salsa_advc_flags_s
109	! used for salsa. These are exclusively used for salsa variables to
110	! distinguish from the usually-used flags which might be different when
111	! decycling is applied in combination with cyclic boundary conditions.
112	! Moreover, salsa_advc_flags_s considers extended zones around buildings where
113	! the first-order upwind scheme is applied for the horizontal advection terms.
114	! This is done to overcome high concentration peaks due to stationary numerical
115	! oscillations caused by horizontal advection discretization.
116	!
117	! 4117 2019-07-25 08:54:02Z monakurppa
118	! Pass integer flag array as well as boundary flags to WS scalar advection
119	! routine
120	!
121	! 4109 2019-07-22 17:00:34Z suehring
122	! Slightly revise setting of boundary conditions at horizontal walls, use
123	! data-structure offset index instead of pre-calculate it for each facing
124	!
125	! 4079 2019-07-09 18:04:41Z suehring
126	! Application of monotonic flux limiter for the vertical scalar advection
127	! up to the topography top (only for the cache-optimized version at the
128	! moment).
129	!
130	! 4069 2019-07-01 14:05:51Z Giersch
131	! Masked output running index mid has been introduced as a local variable to
132	! avoid runtime error (Loop variable has been modified) in time_integration
133	!
134	! 4058 2019-06-27 15:25:42Z knoop
135	! Bugfix: to_be_resorted was uninitialized in case of s_H2O in 3d_data_averaging
136	!
137	! 4012 2019-05-31 15:19:05Z monakurppa
138	! Merge salsa branch to trunk. List of changes:
139	! - Error corrected in distr_update that resulted in the aerosol number size
140	! distribution not converging if the concentration was nclim.
141	! - Added a separate output for aerosol liquid water (s_H2O)
142	! - aerosol processes for a size bin are now calculated only if the aerosol
143	! number of concentration of that bin is > 2*nclim
144	! - An initialisation error in the subroutine "deposition" corrected and the
145	! subroutine reformatted.
146	! - stuff from salsa_util_mod.f90 moved into salsa_mod.f90
147	! - calls for closing the netcdf input files added
148	!
149	! 3956 2019-05-07 12:32:52Z monakurppa
150	! - Conceptual bug in depo_surf correct for urban and land surface model
151	! - Subroutine salsa_tendency_ij optimized.
152	! - Interfaces salsa_non_advective_processes and salsa_exchange_horiz_bounds
153	! created. These are now called in module_interface.
154	! salsa_exchange_horiz_bounds after calling salsa_driver only when needed
155	! (i.e. every dt_salsa).
156	!
157	! 3924 2019-04-23 09:33:06Z monakurppa
158	! Correct a bug introduced by the previous update.
159	!
160	! 3899 2019-04-16 14:05:27Z monakurppa
161	! - remove unnecessary error / location messages
162	! - corrected some error message numbers
163	! - allocate source arrays only if emissions or dry deposition is applied.
164	!
165	! 3885 2019-04-11 11:29:34Z kanani
166	! Changes related to global restructuring of location messages and introduction
167	! of additional debug messages
168	!
169	! 3876 2019-04-08 18:41:49Z knoop
170	! Introduced salsa_actions module interface
171	!
172	! 3871 2019-04-08 14:38:39Z knoop
173	! Major changes in formatting, performance and data input structure (see branch
174	! the history for details)
175	! - Time-dependent emissions enabled: lod=1 for yearly PM emissions that are
176	! normalised depending on the time, and lod=2 for preprocessed emissions
177	! (similar to the chemistry module).
178	! - Additionally, 'uniform' emissions allowed. This emission is set constant on
179	! all horisontal upward facing surfaces and it is created based on parameters
180	! surface_aerosol_flux, aerosol_flux_dpg/sigmag/mass_fracs_a/mass_fracs_b.
181	! - All emissions are now implemented as surface fluxes! No 3D sources anymore.
182	! - Update the emission information by calling salsa_emission_update if
183	! skip_time_do_salsa >= time_since_reference_point and
184	! next_aero_emission_update <= time_since_reference_point
185	! - Aerosol background concentrations read from PIDS_DYNAMIC. The vertical grid
186	! must match the one applied in the model.
187	! - Gas emissions and background concentrations can be also read in in salsa_mod
188	! if the chemistry module is not applied.
189	! - In deposition, information on the land use type can be now imported from
190	! the land use model
191	! - Use SI units in PARIN, i.e. n_lognorm given in #/m3 and dpg in metres.
192	! - Apply 100 character line limit
193	! - Change all variable names from capital to lowercase letter
194	! - Change real exponents to integer if possible. If not, precalculate the value
195	! value of exponent
196	! - Rename in1a to start_subrange_1a, fn2a to end_subrange_1a etc.
197	! - Rename nbins --> nbins_aerosol, ncc_tot --> ncomponents_mass and ngast -->
198	! ngases_salsa
199	! - Rename ibc to index_bc, idu to index_du etc.
200	! - Renamed loop indices b, c and sg to ib, ic and ig
201	! - run_salsa subroutine removed
202	! - Corrected a bud in salsa_driver: falsely applied ino instead of inh
203	! - Call salsa_tendency within salsa_prognostic_equations which is called in
204	! module_interface_mod instead of prognostic_equations_mod
205	! - Removed tailing white spaces and unused variables
206	! - Change error message to start by PA instead of SA
207	!
208	! 3833 2019-03-28 15:04:04Z forkel
209	! added USE chem_gasphase_mod for nvar, nspec and spc_names
210	!
211	! 3787 2019-03-07 08:43:54Z raasch
212	! unused variables removed
213	!
214	! 3780 2019-03-05 11:19:45Z forkel
215	! unused variable for file index removed from rrd-subroutines parameter list
216	!
217	! 3685 2019-01-21 01:02:11Z knoop
218	! Some interface calls moved to module_interface + cleanup
219	!
220	! 3655 2019-01-07 16:51:22Z knoop
221	! Implementation of the PALM module interface
222	! 3412 2018-10-24 07:25:57Z monakurppa
223	!
224	! Authors:
225	! --------
226	! @author Mona Kurppa (University of Helsinki)
227	!
228	!
229	! Description:
230	! ------------
231	!> Sectional aerosol module for large scale applications SALSA
232	!> (Kokkola et al., 2008, ACP 8, 2469-2483). Solves the aerosol number and mass
233	!> concentration as well as chemical composition. Includes aerosol dynamic
234	!> processes: nucleation, condensation/evaporation of vapours, coagulation and
235	!> deposition on tree leaves, ground and roofs.
236	!> Implementation is based on formulations implemented in UCLALES-SALSA except
237	!> for deposition which is based on parametrisations by Zhang et al. (2001,
238	!> Atmos. Environ. 35, 549-560) or Petroff&Zhang (2010, Geosci. Model Dev. 3,
239	!> 753-769)
240	!>
241	!> @todo Apply information from emission_stack_height to lift emission sources
242	!> @todo Allow insoluble emissions
243	!------------------------------------------------------------------------------!
244	MODULE salsa_mod
245
246	USE basic_constants_and_equations_mod, &
247	ONLY: c_p, g, p_0, pi, r_d
248
249	USE chem_gasphase_mod, &
250	ONLY: nspec, nvar, spc_names
251
252	USE chem_modules, &
253	ONLY: call_chem_at_all_substeps, chem_gasphase_on, chem_species
254
255	USE control_parameters, &
256	ONLY: air_chemistry, bc_dirichlet_l, bc_dirichlet_n, bc_dirichlet_r, bc_dirichlet_s, &
257	bc_lr, bc_lr_cyc, bc_ns, bc_ns_cyc, bc_radiation_l, bc_radiation_n, bc_radiation_r, &
258	bc_radiation_s, coupling_char, debug_output, dt_3d, intermediate_timestep_count, &
259	intermediate_timestep_count_max, land_surface, max_pr_salsa, message_string, &
260	monotonic_limiter_z, plant_canopy, pt_surface, salsa, scalar_advec, &
261	surface_pressure, time_since_reference_point, timestep_scheme, tsc, urban_surface, &
262	ws_scheme_sca
263
264	USE indices, &
265	ONLY: nbgp, nx, nxl, nxlg, nxr, nxrg, ny, nyn, nyng, nys, nysg, nzb, nz, nzt, &
266	wall_flags_total_0
267
268	USE kinds
269
270	USE netcdf_data_input_mod, &
271	ONLY: chem_emis_att_type, chem_emis_val_type
272
273	USE pegrid
274
275	USE statistics, &
276	ONLY: sums_salsa_ws_l
277
278	IMPLICIT NONE
279	!
280	!-- SALSA constants:
281	!
282	!-- Local constants:
283	INTEGER(iwp), PARAMETER :: luc_urban = 15 !< default landuse type for urban
284	INTEGER(iwp), PARAMETER :: ngases_salsa = 5 !< total number of gaseous tracers:
285	!< 1 = H2SO4, 2 = HNO3, 3 = NH3, 4 = OCNV
286	!< (non-volatile OC), 5 = OCSV (semi-volatile)
287	INTEGER(iwp), PARAMETER :: nmod = 7 !< number of modes for initialising the aerosol size distribution
288	INTEGER(iwp), PARAMETER :: nreg = 2 !< Number of main size subranges
289	INTEGER(iwp), PARAMETER :: maxspec = 7 !< Max. number of aerosol species
290
291
292	REAL(wp), PARAMETER :: fill_value = -9999.0_wp !< value for the _FillValue attribute
293	!
294	!-- Universal constants
295	REAL(wp), PARAMETER :: abo = 1.380662E-23_wp !< Boltzmann constant (J/K)
296	REAL(wp), PARAMETER :: alv = 2.260E+6_wp !< latent heat for H2O vaporisation (J/kg)
297	REAL(wp), PARAMETER :: alv_d_rv = 4896.96865_wp !< alv / rv
298	REAL(wp), PARAMETER :: am_airmol = 4.8096E-26_wp !< Average mass of an air molecule (Jacobson 2005, Eq.2.3)
299	REAL(wp), PARAMETER :: api6 = 0.5235988_wp !< pi / 6
300	REAL(wp), PARAMETER :: argas = 8.314409_wp !< Gas constant (J/(mol K))
301	REAL(wp), PARAMETER :: argas_d_cpd = 8.281283865E-3_wp !< argas per cpd
302	REAL(wp), PARAMETER :: avo = 6.02214E+23_wp !< Avogadro constant (1/mol)
303	REAL(wp), PARAMETER :: d_sa = 5.539376964394570E-10_wp !< diameter of condensing H2SO4 molecule (m)
304	REAL(wp), PARAMETER :: for_ppm_to_nconc = 7.243016311E+16_wp !< ppm * avo / R (K/(Pa*m3))
305	REAL(wp), PARAMETER :: epsoc = 0.15_wp !< water uptake of organic material
306	REAL(wp), PARAMETER :: mclim = 1.0E-23_wp !< mass concentration min limit (kg/m3)
307	REAL(wp), PARAMETER :: n3 = 158.79_wp !< Number of H2SO4 molecules in 3 nm cluster if d_sa=5.54e-10m
308	REAL(wp), PARAMETER :: nclim = 1.0_wp !< number concentration min limit (#/m3)
309	REAL(wp), PARAMETER :: surfw0 = 0.073_wp !< surface tension of water at 293 K (J/m2)
310	!
311	!-- Molar masses in kg/mol
312	REAL(wp), PARAMETER :: ambc = 12.0E-3_wp !< black carbon (BC)
313	REAL(wp), PARAMETER :: amdair = 28.970E-3_wp !< dry air
314	REAL(wp), PARAMETER :: amdu = 100.0E-3_wp !< mineral dust
315	REAL(wp), PARAMETER :: amh2o = 18.0154E-3_wp !< H2O
316	REAL(wp), PARAMETER :: amh2so4 = 98.06E-3_wp !< H2SO4
317	REAL(wp), PARAMETER :: amhno3 = 63.01E-3_wp !< HNO3
318	REAL(wp), PARAMETER :: amn2o = 44.013E-3_wp !< N2O
319	REAL(wp), PARAMETER :: amnh3 = 17.031E-3_wp !< NH3
320	REAL(wp), PARAMETER :: amo2 = 31.9988E-3_wp !< O2
321	REAL(wp), PARAMETER :: amo3 = 47.998E-3_wp !< O3
322	REAL(wp), PARAMETER :: amoc = 150.0E-3_wp !< organic carbon (OC)
323	REAL(wp), PARAMETER :: amss = 58.44E-3_wp !< sea salt (NaCl)
324	!
325	!-- Densities in kg/m3
326	REAL(wp), PARAMETER :: arhobc = 2000.0_wp !< black carbon
327	REAL(wp), PARAMETER :: arhodu = 2650.0_wp !< mineral dust
328	REAL(wp), PARAMETER :: arhoh2o = 1000.0_wp !< H2O
329	REAL(wp), PARAMETER :: arhoh2so4 = 1830.0_wp !< SO4
330	REAL(wp), PARAMETER :: arhohno3 = 1479.0_wp !< HNO3
331	REAL(wp), PARAMETER :: arhonh3 = 1530.0_wp !< NH3
332	REAL(wp), PARAMETER :: arhooc = 2000.0_wp !< organic carbon
333	REAL(wp), PARAMETER :: arhoss = 2165.0_wp !< sea salt (NaCl)
334	!
335	!-- Volume of molecule in m3/#
336	REAL(wp), PARAMETER :: amvh2o = amh2o /avo / arhoh2o !< H2O
337	REAL(wp), PARAMETER :: amvh2so4 = amh2so4 / avo / arhoh2so4 !< SO4
338	REAL(wp), PARAMETER :: amvhno3 = amhno3 / avo / arhohno3 !< HNO3
339	REAL(wp), PARAMETER :: amvnh3 = amnh3 / avo / arhonh3 !< NH3
340	REAL(wp), PARAMETER :: amvoc = amoc / avo / arhooc !< OC
341	REAL(wp), PARAMETER :: amvss = amss / avo / arhoss !< sea salt
342	!
343	!-- Constants for the dry deposition model by Petroff and Zhang (2010):
344	!-- obstacle characteristic dimension "L" (cm) (plane obstacle by default) and empirical constants
345	!-- C_B, C_IN, C_IM, beta_IM and C_IT for each land use category (15, as in Zhang et al. (2001))
346	REAL(wp), DIMENSION(1:15), PARAMETER :: l_p10 = &
347	(/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/)
348	REAL(wp), DIMENSION(1:15), PARAMETER :: c_b_p10 = &
349	(/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/)
350	REAL(wp), DIMENSION(1:15), PARAMETER :: c_in_p10 = &
351	(/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/)
352	REAL(wp), DIMENSION(1:15), PARAMETER :: c_im_p10 = &
353	(/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/)
354	REAL(wp), DIMENSION(1:15), PARAMETER :: beta_im_p10 = &
355	(/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/)
356	REAL(wp), DIMENSION(1:15), PARAMETER :: c_it_p10 = &
357	(/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/)
358	!
359	!-- Constants for the dry deposition model by Zhang et al. (2001):
360	!-- empirical constants "alpha" and "gamma" and characteristic radius "A" for
361	!-- each land use category (15) and season (5)
362	REAL(wp), DIMENSION(1:15), PARAMETER :: alpha_z01 = &
363	(/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/)
364	REAL(wp), DIMENSION(1:15), PARAMETER :: gamma_z01 = &
365	(/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/)
366	REAL(wp), DIMENSION(1:15,1:5), PARAMETER :: A_z01 = RESHAPE( (/&
367	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
368	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
369	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
370	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
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 & ! SC5
372	/), (/ 15, 5 /) )
373	!-- Land use categories (based on Z01 but the same applies here also for P10):
374	!-- 1 = evergreen needleleaf trees,
375	!-- 2 = evergreen broadleaf trees,
376	!-- 3 = deciduous needleleaf trees,
377	!-- 4 = deciduous broadleaf trees,
378	!-- 5 = mixed broadleaf and needleleaf trees (deciduous broadleaf trees for P10),
379	!-- 6 = grass (short grass for P10),
380	!-- 7 = crops, mixed farming,
381	!-- 8 = desert,
382	!-- 9 = tundra,
383	!-- 10 = shrubs and interrupted woodlands (thorn shrubs for P10),
384	!-- 11 = wetland with plants (long grass for P10)
385	!-- 12 = ice cap and glacier,
386	!-- 13 = inland water (inland lake for P10)
387	!-- 14 = ocean (water for P10),
388	!-- 15 = urban
389	!
390	!-- SALSA variables:
391	CHARACTER(LEN=20) :: bc_salsa_b = 'neumann' !< bottom boundary condition
392	CHARACTER(LEN=20) :: bc_salsa_t = 'neumann' !< top boundary condition
393	CHARACTER(LEN=20) :: depo_pcm_par = 'zhang2001' !< or 'petroff2010'
394	CHARACTER(LEN=20) :: depo_pcm_type = 'deciduous_broadleaf' !< leaf type
395	CHARACTER(LEN=20) :: depo_surf_par = 'zhang2001' !< or 'petroff2010'
396	CHARACTER(LEN=100) :: input_file_dynamic = 'PIDS_DYNAMIC' !< file name for dynamic input
397	CHARACTER(LEN=100) :: input_file_salsa = 'PIDS_SALSA' !< file name for emission data
398	CHARACTER(LEN=20) :: salsa_emission_mode = 'no_emission' !< 'no_emission', 'uniform',
399	!< 'parameterized', 'read_from_file'
400
401	CHARACTER(LEN=20), DIMENSION(4) :: decycle_method_salsa = &
402	(/'dirichlet','dirichlet','dirichlet','dirichlet'/)
403	!< Decycling method at horizontal boundaries
404	!< 1=left, 2=right, 3=south, 4=north
405	!< dirichlet = initial profiles for the ghost and first 3 layers
406	!< neumann = zero gradient
407
408	CHARACTER(LEN=3), DIMENSION(maxspec) :: listspec = & !< Active aerosols
409	(/'SO4',' ',' ',' ',' ',' ',' '/)
410
411	INTEGER(iwp) :: depo_pcm_par_num = 1 !< parametrisation type: 1=zhang2001, 2=petroff2010
412	INTEGER(iwp) :: depo_pcm_type_num = 0 !< index for the dry deposition type on the plant canopy
413	INTEGER(iwp) :: depo_surf_par_num = 1 !< parametrisation type: 1=zhang2001, 2=petroff2010
414	INTEGER(iwp) :: end_subrange_1a = 1 !< last index for bin subrange 1a
415	INTEGER(iwp) :: end_subrange_2a = 1 !< last index for bin subrange 2a
416	INTEGER(iwp) :: end_subrange_2b = 1 !< last index for bin subrange 2b
417	INTEGER(iwp) :: ibc_salsa_b !< index for the bottom boundary condition
418	INTEGER(iwp) :: ibc_salsa_t !< index for the top boundary condition
419	INTEGER(iwp) :: index_bc = -1 !< index for black carbon (BC)
420	INTEGER(iwp) :: index_du = -1 !< index for dust
421	INTEGER(iwp) :: index_nh = -1 !< index for NH3
422	INTEGER(iwp) :: index_no = -1 !< index for HNO3
423	INTEGER(iwp) :: index_oc = -1 !< index for organic carbon (OC)
424	INTEGER(iwp) :: index_so4 = -1 !< index for SO4 or H2SO4
425	INTEGER(iwp) :: index_ss = -1 !< index for sea salt
426	INTEGER(iwp) :: init_aerosol_type = 0 !< Initial size distribution type
427	!< 0 = uniform (read from PARIN)
428	!< 1 = read vertical profiles from an input file
429	INTEGER(iwp) :: init_gases_type = 0 !< Initial gas concentration type
430	!< 0 = uniform (read from PARIN)
431	!< 1 = read vertical profiles from an input file
432	INTEGER(iwp) :: lod_gas_emissions = 0 !< level of detail of the gaseous emission data
433	INTEGER(iwp) :: main_street_id = 0 !< lower bound of main street IDs for parameterized emission mode
434	INTEGER(iwp) :: max_street_id = 0 !< upper bound of main street IDs for parameterized emission mode
435	INTEGER(iwp) :: nbins_aerosol = 1 !< total number of size bins
436	INTEGER(iwp) :: ncc = 1 !< number of chemical components used
437	INTEGER(iwp) :: ncomponents_mass = 1 !< total number of chemical compounds (ncc+1)
438	!< if particle water is advected)
439	INTEGER(iwp) :: nj3 = 1 !< J3 parametrization (nucleation)
440	!< 1 = condensational sink (Kerminen&Kulmala, 2002)
441	!< 2 = coagulational sink (Lehtinen et al. 2007)
442	!< 3 = coagS+self-coagulation (Anttila et al. 2010)
443	INTEGER(iwp) :: nsnucl = 0 !< Choice of the nucleation scheme:
444	!< 0 = off
445	!< 1 = binary nucleation
446	!< 2 = activation type nucleation
447	!< 3 = kinetic nucleation
448	!< 4 = ternary nucleation
449	!< 5 = nucleation with ORGANICs
450	!< 6 = activation type of nucleation with H2SO4+ORG
451	!< 7 = heteromolecular nucleation with H2SO4*ORG
452	!< 8 = homomolecular nucleation of H2SO4
453	!< + heteromolecular nucleation with H2SO4*ORG
454	!< 9 = homomolecular nucleation of H2SO4 and ORG
455	!< + heteromolecular nucleation with H2SO4*ORG
456	INTEGER(iwp) :: salsa_pr_count = 0 !< counter for salsa variable profiles
457	INTEGER(iwp) :: season_z01 = 1 !< For dry deposition by Zhang et al.: 1 = summer,
458	!< 2 = autumn (no harvest yet), 3 = late autumn
459	!< (already frost), 4 = winter, 5 = transitional spring
460	INTEGER(iwp) :: side_street_id = 0 !< lower bound of side street IDs for parameterized emission mode
461	INTEGER(iwp) :: start_subrange_1a = 1 !< start index for bin subranges: subrange 1a
462	INTEGER(iwp) :: start_subrange_2a = 1 !< subrange 2a
463	INTEGER(iwp) :: start_subrange_2b = 1 !< subrange 2b
464
465	INTEGER(iwp), DIMENSION(nreg) :: nbin = (/ 3, 7/) !< Number of size bins per subrange: 1 & 2
466
467	INTEGER(iwp), DIMENSION(ngases_salsa) :: gas_index_chem = (/ 1, 1, 1, 1, 1/) !< gas indices in chemistry_model_mod
468	!< 1 = H2SO4, 2 = HNO3,
469	!< 3 = NH3, 4 = OCNV, 5 = OCSV
470	INTEGER(iwp), DIMENSION(ngases_salsa) :: emission_index_chem !< gas indices in the gas emission file
471	INTEGER(iwp), DIMENSION(99) :: salsa_pr_index = 0 !< index for salsa profiles
472
473	INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE :: k_topo_top !< vertical index of the topography top
474
475	INTEGER(iwp), DIMENSION(:,:,:), ALLOCATABLE :: salsa_advc_flags_s !< flags used to degrade order of advection
476	!< scheme for salsa variables near walls and
477	!< lateral boundaries
478	!
479	!-- SALSA switches:
480	LOGICAL :: advect_particle_water = .TRUE. !< Advect water concentration of particles
481	LOGICAL :: decycle_salsa_lr = .FALSE. !< Undo cyclic boundaries: left and right
482	LOGICAL :: decycle_salsa_ns = .FALSE. !< Undo cyclic boundaries: north and south
483	LOGICAL :: include_emission = .FALSE. !< Include or not emissions
484	LOGICAL :: feedback_to_palm = .FALSE. !< Allow feedback due to condensation of H2O
485	LOGICAL :: nesting_salsa = .TRUE. !< Apply nesting for salsa
486	LOGICAL :: nesting_offline_salsa = .TRUE. !< Apply offline nesting for salsa
487	LOGICAL :: no_insoluble = .FALSE. !< Exclude insoluble chemical components
488	LOGICAL :: read_restart_data_salsa = .FALSE. !< Read restart data for salsa
489	LOGICAL :: salsa_gases_from_chem = .FALSE. !< Transfer the gaseous components to SALSA
490	LOGICAL :: van_der_waals_coagc = .FALSE. !< Include van der Waals and viscous forces in coagulation
491	LOGICAL :: write_binary_salsa = .FALSE. !< read binary for salsa
492	!
493	!-- Process switches: nl* is read from the NAMELIST and is NOT changed.
494	!-- ls* is the switch used and will get the value of nl*
495	!-- except for special circumstances (spinup period etc.)
496	LOGICAL :: nlcoag = .FALSE. !< Coagulation master switch
497	LOGICAL :: lscoag = .FALSE. !<
498	LOGICAL :: nlcnd = .FALSE. !< Condensation master switch
499	LOGICAL :: lscnd = .FALSE. !<
500	LOGICAL :: nlcndgas = .FALSE. !< Condensation of precursor gases
501	LOGICAL :: lscndgas = .FALSE. !<
502	LOGICAL :: nlcndh2oae = .FALSE. !< Condensation of H2O on aerosol
503	LOGICAL :: lscndh2oae = .FALSE. !< particles (FALSE -> equilibrium calc.)
504	LOGICAL :: nldepo = .FALSE. !< Deposition master switch
505	LOGICAL :: lsdepo = .FALSE. !<
506	LOGICAL :: nldepo_surf = .FALSE. !< Deposition on vegetation master switch
507	LOGICAL :: lsdepo_surf = .FALSE. !<
508	LOGICAL :: nldepo_pcm = .FALSE. !< Deposition on walls master switch
509	LOGICAL :: lsdepo_pcm = .FALSE. !<
510	LOGICAL :: nldistupdate = .TRUE. !< Size distribution update master switch
511	LOGICAL :: lsdistupdate = .FALSE. !<
512	LOGICAL :: lspartition = .FALSE. !< Partition of HNO3 and NH3
513
514	REAL(wp) :: act_coeff = 1.0E-7_wp !< Activation coefficient (1/s)
515	REAL(wp) :: dt_salsa = 0.00001_wp !< Time step of SALSA
516	REAL(wp) :: emiss_factor_main = 0.0_wp !< relative emission factor for main streets
517	REAL(wp) :: emiss_factor_side = 0.0_wp !< relative emission factor for side streets
518	REAL(wp) :: h2so4_init = nclim !< Init value for sulphuric acid gas
519	REAL(wp) :: hno3_init = nclim !< Init value for nitric acid gas
520	REAL(wp) :: last_salsa_time = 0.0_wp !< previous salsa call
521	REAL(wp) :: next_aero_emission_update = 0.0_wp !< previous emission update
522	REAL(wp) :: next_gas_emission_update = 0.0_wp !< previous emission update
523	REAL(wp) :: nf2a = 1.0_wp !< Number fraction allocated to 2a-bins
524	REAL(wp) :: nh3_init = nclim !< Init value for ammonia gas
525	REAL(wp) :: ocnv_init = nclim !< Init value for non-volatile organic gases
526	REAL(wp) :: ocsv_init = nclim !< Init value for semi-volatile organic gases
527	REAL(wp) :: rhlim = 1.20_wp !< RH limit in %/100. Prevents unrealistical RH
528	REAL(wp) :: time_utc_init !< time in seconds-of-day of origin_date_time
529	REAL(wp) :: skip_time_do_salsa = 0.0_wp !< Starting time of SALSA (s)
530	!
531	!-- Initial log-normal size distribution: mode diameter (dpg, metres),
532	!-- standard deviation (sigmag) and concentration (n_lognorm, #/m3)
533	REAL(wp), DIMENSION(nmod) :: dpg = &
534	(/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/)
535	REAL(wp), DIMENSION(nmod) :: sigmag = &
536	(/1.8_wp, 2.16_wp, 2.21_wp, 2.0_wp, 2.0_wp, 2.0_wp, 2.0_wp/)
537	REAL(wp), DIMENSION(nmod) :: n_lognorm = &
538	(/1.04e+11_wp, 3.23E+10_wp, 5.4E+6_wp, 0.0_wp, 0.0_wp, 0.0_wp, 0.0_wp/)
539	!
540	!-- Initial mass fractions / chemical composition of the size distribution
541	REAL(wp), DIMENSION(maxspec) :: mass_fracs_a = & !< mass fractions between
542	(/1.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0/) !< aerosol species for A bins
543	REAL(wp), DIMENSION(maxspec) :: mass_fracs_b = & !< mass fractions between
544	(/0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0/) !< aerosol species for B bins
545	REAL(wp), DIMENSION(nreg+1) :: reglim = & !< Min&max diameters of size subranges
546	(/ 3.0E-9_wp, 5.0E-8_wp, 1.0E-5_wp/)
547	!
548	!-- Initial log-normal size distribution: mode diameter (dpg, metres), standard deviation (sigmag)
549	!-- concentration (n_lognorm, #/m3) and mass fractions of all chemical components (listed in
550	!-- listspec) for both a (soluble) and b (insoluble) bins.
551	REAL(wp), DIMENSION(nmod) :: aerosol_flux_dpg = &
552	(/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/)
553	REAL(wp), DIMENSION(nmod) :: aerosol_flux_sigmag = &
554	(/1.8_wp, 2.16_wp, 2.21_wp, 2.0_wp, 2.0_wp, 2.0_wp, 2.0_wp/)
555	REAL(wp), DIMENSION(maxspec) :: aerosol_flux_mass_fracs_a = &
556	(/1.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0/)
557	REAL(wp), DIMENSION(maxspec) :: aerosol_flux_mass_fracs_b = &
558	(/0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0/)
559	REAL(wp), DIMENSION(nmod) :: surface_aerosol_flux = &
560	(/1.0E+8_wp, 1.0E+9_wp, 1.0E+5_wp, 0.0_wp, 0.0_wp, 0.0_wp, 0.0_wp/)
561
562	REAL(wp), DIMENSION(:), ALLOCATABLE :: bin_low_limits !< to deliver information about
563	!< the lower diameters per bin
564	REAL(wp), DIMENSION(:), ALLOCATABLE :: bc_am_t_val !< vertical gradient of: aerosol mass
565	REAL(wp), DIMENSION(:), ALLOCATABLE :: bc_an_t_val !< of: aerosol number
566	REAL(wp), DIMENSION(:), ALLOCATABLE :: bc_gt_t_val !< salsa gases near domain top
567	REAL(wp), DIMENSION(:), ALLOCATABLE :: gas_emission_time !< Time array in gas emission data (s)
568	REAL(wp), DIMENSION(:), ALLOCATABLE :: nsect !< Background number concentrations
569	REAL(wp), DIMENSION(:), ALLOCATABLE :: massacc !< Mass accomodation coefficients
570	!
571	!-- SALSA derived datatypes:
572	!
573	!-- Component index
574	TYPE component_index
575	CHARACTER(len=3), ALLOCATABLE :: comp(:) !< Component name
576	INTEGER(iwp) :: ncomp !< Number of components
577	INTEGER(iwp), ALLOCATABLE :: ind(:) !< Component index
578	END TYPE component_index
579	!
580	!-- For matching LSM and USM surface types and the deposition module surface types
581	TYPE match_surface
582	INTEGER(iwp), DIMENSION(:), ALLOCATABLE :: match_lupg !< index for pavement / green roofs
583	INTEGER(iwp), DIMENSION(:), ALLOCATABLE :: match_luvw !< index for vegetation / walls
584	INTEGER(iwp), DIMENSION(:), ALLOCATABLE :: match_luww !< index for water / windows
585	END TYPE match_surface
586	!
587	!-- Aerosol emission data attributes
588	TYPE salsa_emission_attribute_type
589
590	CHARACTER(LEN=25) :: units
591
592	CHARACTER(LEN=25), DIMENSION(:), ALLOCATABLE :: cat_name !<
593	CHARACTER(LEN=25), DIMENSION(:), ALLOCATABLE :: cc_name !<
594	CHARACTER(LEN=25), DIMENSION(:), ALLOCATABLE :: unit_time !<
595	CHARACTER(LEN=100), DIMENSION(:), ALLOCATABLE :: var_names !<
596
597	INTEGER(iwp) :: lod = 0 !< level of detail
598	INTEGER(iwp) :: nbins = 10 !< number of aerosol size bins
599	INTEGER(iwp) :: ncat = 0 !< number of emission categories
600	INTEGER(iwp) :: ncc = 7 !< number of aerosol chemical components
601	INTEGER(iwp) :: nhoursyear = 0 !< number of hours: HOURLY mode
602	INTEGER(iwp) :: nmonthdayhour = 0 !< number of month days and hours: MDH mode
603	INTEGER(iwp) :: num_vars !< number of variables
604	INTEGER(iwp) :: nt = 0 !< number of time steps
605	INTEGER(iwp) :: nz = 0 !< number of vertical levels
606	INTEGER(iwp) :: tind !< time index for reference time in salsa emission data
607
608	INTEGER(iwp), DIMENSION(maxspec) :: cc_in2mod = 0 !<
609
610	INTEGER(iwp), DIMENSION(:), ALLOCATABLE :: cat_index !< Index of emission categories
611	INTEGER(iwp), DIMENSION(:), ALLOCATABLE :: cc_index !< Index of chemical components
612
613	REAL(wp) :: conversion_factor !< unit conversion factor for aerosol emissions
614
615	REAL(wp), DIMENSION(:), ALLOCATABLE :: dmid !< mean diameters of size bins (m)
616	REAL(wp), DIMENSION(:), ALLOCATABLE :: rho !< average density (kg/m3)
617	REAL(wp), DIMENSION(:), ALLOCATABLE :: time !< time (s)
618	REAL(wp), DIMENSION(:), ALLOCATABLE :: time_factor !< emission time factor
619	REAL(wp), DIMENSION(:), ALLOCATABLE :: z !< height (m)
620
621	REAL(wp), DIMENSION(:,:), ALLOCATABLE :: etf !< emission time factor
622	REAL(wp), DIMENSION(:,:), ALLOCATABLE :: stack_height
623
624	END TYPE salsa_emission_attribute_type
625	!
626	!-- The default size distribution and mass composition per emission category:
627	!-- 1 = traffic, 2 = road dust, 3 = wood combustion, 4 = other
628	!-- Mass fractions: H2SO4, OC, BC, DU, SS, HNO3, NH3
629	TYPE salsa_emission_mode_type
630
631	INTEGER(iwp) :: ndm = 3 !< number of default modes
632	INTEGER(iwp) :: ndc = 4 !< number of default categories
633
634	CHARACTER(LEN=25), DIMENSION(1:4) :: cat_name_table = (/'traffic exhaust', &
635	'road dust ', &
636	'wood combustion', &
637	'other '/)
638
639	INTEGER(iwp), DIMENSION(1:4) :: cat_input_to_model !<
640
641	REAL(wp), DIMENSION(1:3) :: dpg_table = (/ 13.5E-9_wp, 1.4E-6_wp, 5.4E-8_wp/) !<
642	REAL(wp), DIMENSION(1:3) :: ntot_table !<
643	REAL(wp), DIMENSION(1:3) :: sigmag_table = (/ 1.6_wp, 1.4_wp, 1.7_wp /) !<
644
645	REAL(wp), DIMENSION(1:maxspec,1:4) :: mass_frac_table = & !<
646	RESHAPE( (/ 0.04_wp, 0.48_wp, 0.48_wp, 0.0_wp, 0.0_wp, 0.0_wp, 0.0_wp, &
647	0.0_wp, 0.05_wp, 0.0_wp, 0.95_wp, 0.0_wp, 0.0_wp, 0.0_wp, &
648	0.0_wp, 0.5_wp, 0.5_wp, 0.0_wp, 0.0_wp, 0.0_wp, 0.0_wp, &
649	0.0_wp, 0.5_wp, 0.5_wp, 0.0_wp, 0.0_wp, 0.0_wp, 0.0_wp &
650	/), (/maxspec,4/) )
651
652	REAL(wp), DIMENSION(1:3,1:4) :: pm_frac_table = & !< rel. mass
653	RESHAPE( (/ 0.016_wp, 0.000_wp, 0.984_wp, &
654	0.000_wp, 1.000_wp, 0.000_wp, &
655	0.000_wp, 0.000_wp, 1.000_wp, &
656	1.000_wp, 0.000_wp, 1.000_wp &
657	/), (/3,4/) )
658
659	END TYPE salsa_emission_mode_type
660	!
661	!-- Aerosol emission data values
662	TYPE salsa_emission_value_type
663
664	REAL(wp) :: fill !< fill value
665
666	REAL(wp), DIMENSION(:,:), ALLOCATABLE :: mass_fracs !< mass fractions per emis. category
667	REAL(wp), DIMENSION(:,:), ALLOCATABLE :: num_fracs !< number fractions per emis. category
668
669	REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: def_data !< surface emission in PM
670	REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: preproc_data !< surface emission per category
671
672	END TYPE salsa_emission_value_type
673	!
674	!-- Offline nesting data type
675	TYPE salsa_nest_offl_type
676
677	CHARACTER(LEN=16) :: char_l = 'ls_forcing_left_' !< leading substring at left boundary
678	CHARACTER(LEN=17) :: char_n = 'ls_forcing_north_' !< leading substring at north boundary
679	CHARACTER(LEN=17) :: char_r = 'ls_forcing_right_' !< leading substring at right boundary
680	CHARACTER(LEN=17) :: char_s = 'ls_forcing_south_' !< leading substring at south boundary
681	CHARACTER(LEN=15) :: char_t = 'ls_forcing_top_' !< leading substring at top boundary
682
683	CHARACTER(LEN=5), DIMENSION(1:ngases_salsa) :: gas_name = (/'H2SO4','HNO3 ','NH3 ','OCNV ','OCSV '/)
684
685	CHARACTER(LEN=25), DIMENSION(:), ALLOCATABLE :: cc_name !< chemical component name
686	CHARACTER(LEN=100), DIMENSION(:), ALLOCATABLE :: var_names !< list of variable names
687
688	INTEGER(iwp) :: id_dynamic !< NetCDF id of dynamic input file
689	INTEGER(iwp) :: ncc !< number of aerosol chemical components
690	INTEGER(iwp) :: nt !< number of time levels in dynamic input file
691	INTEGER(iwp) :: nzu !< number of vertical levels on scalar grid in dynamic input file
692	INTEGER(iwp) :: tind !< time index for reference time in mesoscale-offline nesting
693	INTEGER(iwp) :: tind_p !< time index for following time in mesoscale-offline nesting
694
695	INTEGER(iwp), DIMENSION(maxspec) :: cc_in2mod = 0 !< to transfer chemical composition from input to model
696
697	LOGICAL :: init = .FALSE. !< flag indicating the initialisation of offline nesting
698
699	REAL(wp), DIMENSION(:), ALLOCATABLE :: dmid !< vertical profile of aerosol bin diameters
700	REAL(wp), DIMENSION(:), ALLOCATABLE :: time !< time in dynamic input file
701	REAL(wp), DIMENSION(:), ALLOCATABLE :: zu_atmos !< zu in dynamic input file
702
703	REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE :: gconc_left !< gas conc. at left boundary
704	REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE :: gconc_north !< gas conc. at north boundary
705	REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE :: gconc_right !< gas conc. at right boundary
706	REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE :: gconc_south !< gas conc. at south boundary
707	REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE :: gconc_top !< gas conc.at top boundary
708	REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE :: mconc_left !< aerosol mass conc. at left boundary
709	REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE :: mconc_north !< aerosol mass conc. at north boundary
710	REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE :: mconc_right !< aerosol mass conc. at right boundary
711	REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE :: mconc_south !< aerosol mass conc. at south boundary
712	REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE :: mconc_top !< aerosol mass conc. at top boundary
713	REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE :: nconc_left !< aerosol number conc. at left boundary
714	REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE :: nconc_north !< aerosol number conc. at north boundary
715	REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE :: nconc_right !< aerosol number conc. at right boundary
716	REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE :: nconc_south !< aerosol number conc. at south boundary
717	REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE :: nconc_top !< aerosol number conc. at top boundary
718
719	END TYPE salsa_nest_offl_type
720	!
721	!-- Prognostic variable: Aerosol size bin information (number (#/m3) and mass (kg/m3) concentration)
722	!-- and the concentration of gaseous tracers (#/m3). Gas tracers are contained sequentially in
723	!-- dimension 4 as:
724	!-- 1. H2SO4, 2. HNO3, 3. NH3, 4. OCNV (non-volatile organics), 5. OCSV (semi-volatile)
725	TYPE salsa_variable
726
727	REAL(wp), DIMENSION(:), ALLOCATABLE :: init !<
728
729	REAL(wp), DIMENSION(:,:), ALLOCATABLE :: diss_s !<
730	REAL(wp), DIMENSION(:,:), ALLOCATABLE :: flux_s !<
731	REAL(wp), DIMENSION(:,:), ALLOCATABLE :: source !<
732	REAL(wp), DIMENSION(:,:), ALLOCATABLE :: sums_ws_l !<
733
734	REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: diss_l !<
735	REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: flux_l !<
736
737	REAL(wp), DIMENSION(:,:,:), POINTER, CONTIGUOUS :: conc !<
738	REAL(wp), DIMENSION(:,:,:), POINTER, CONTIGUOUS :: conc_p !<
739	REAL(wp), DIMENSION(:,:,:), POINTER, CONTIGUOUS :: tconc_m !<
740
741	END TYPE salsa_variable
742	!
743	!-- Datatype used to store information about the binned size distributions of aerosols
744	TYPE t_section
745
746	REAL(wp) :: dmid !< bin middle diameter (m)
747	REAL(wp) :: vhilim !< bin volume at the high limit
748	REAL(wp) :: vlolim !< bin volume at the low limit
749	REAL(wp) :: vratiohi !< volume ratio between the center and high limit
750	REAL(wp) :: vratiolo !< volume ratio between the center and low limit
751	!******************************************************
752	! ^ Do NOT change the stuff above after initialization !
753	!******************************************************
754	REAL(wp) :: core !< Volume of dry particle
755	REAL(wp) :: dwet !< Wet diameter or mean droplet diameter (m)
756	REAL(wp) :: numc !< Number concentration of particles/droplets (#/m3)
757	REAL(wp) :: veqh2o !< Equilibrium H2O concentration for each particle
758
759	REAL(wp), DIMENSION(maxspec+1) :: volc !< Volume concentrations (m^3/m^3) of aerosols +
760	!< water. Since most of the stuff in SALSA is hard
761	!< coded, these have to be in the order
762	!< 1:SO4, 2:OC, 3:BC, 4:DU, 5:SS, 6:NO, 7:NH, 8:H2O
763	END TYPE t_section
764
765	TYPE(salsa_emission_attribute_type) :: aero_emission_att !< emission attributes
766	TYPE(salsa_emission_value_type) :: aero_emission !< emission values
767	TYPE(salsa_emission_mode_type) :: def_modes !< default emission modes
768
769	TYPE(chem_emis_att_type) :: chem_emission_att !< chemistry emission attributes
770
771	TYPE(chem_emis_val_type), DIMENSION(:), ALLOCATABLE :: chem_emission !< chemistry emissions
772
773	TYPE(t_section), DIMENSION(:), ALLOCATABLE :: aero !< local aerosol properties
774
775	TYPE(match_surface) :: lsm_to_depo_h !< to match the deposition module and horizontal LSM surfaces
776	TYPE(match_surface) :: usm_to_depo_h !< to match the deposition module and horizontal USM surfaces
777
778	TYPE(match_surface), DIMENSION(0:3) :: lsm_to_depo_v !< to match the deposition mod. and vertical LSM surfaces
779	TYPE(match_surface), DIMENSION(0:3) :: usm_to_depo_v !< to match the deposition mod. and vertical USM surfaces
780	!
781	!-- SALSA variables: as x = x(k,j,i,bin).
782	!-- The 4th dimension contains all the size bins sequentially for each aerosol species + water.
783	!
784	!-- Prognostic variables:
785	!
786	!-- Number concentration (#/m3)
787	TYPE(salsa_variable), DIMENSION(:), ALLOCATABLE, TARGET :: aerosol_number !<
788	REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE, TARGET :: nconc_1 !<
789	REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE, TARGET :: nconc_2 !<
790	REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE, TARGET :: nconc_3 !<
791	!
792	!-- Mass concentration (kg/m3)
793	TYPE(salsa_variable), DIMENSION(:), ALLOCATABLE, TARGET :: aerosol_mass !<
794	REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE, TARGET :: mconc_1 !<
795	REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE, TARGET :: mconc_2 !<
796	REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE, TARGET :: mconc_3 !<
797	!
798	!-- Gaseous concentrations (#/m3)
799	TYPE(salsa_variable), DIMENSION(:), ALLOCATABLE, TARGET :: salsa_gas !<
800	REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE, TARGET :: gconc_1 !<
801	REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE, TARGET :: gconc_2 !<
802	REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE, TARGET :: gconc_3 !<
803	!
804	!-- Diagnostic tracers
805	REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE :: sedim_vd !< sedimentation velocity per bin (m/s)
806	REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE :: ra_dry !< aerosol dry radius (m)
807
808	!-- Particle component index tables
809	TYPE(component_index) :: prtcl !< Contains "getIndex" which gives the index for a given aerosol
810	!< component name: 1:SO4, 2:OC, 3:BC, 4:DU, 5:SS, 6:NO, 7:NH, 8:H2O
811	!
812	!-- Offline nesting:
813	TYPE(salsa_nest_offl_type) :: salsa_nest_offl !< data structure for offline nesting
814	!
815	!-- Data output arrays:
816	!
817	!-- Gases:
818	REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET :: g_h2so4_av !< H2SO4
819	REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET :: g_hno3_av !< HNO3
820	REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET :: g_nh3_av !< NH3
821	REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET :: g_ocnv_av !< non-volatile OC
822	REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET :: g_ocsv_av !< semi-volatile OC
823	!
824	!-- Integrated:
825	REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET :: ldsa_av !< lung-deposited surface area
826	REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET :: ntot_av !< total number concentration
827	REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET :: nufp_av !< ultrafine particles (UFP)
828	REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET :: pm01_av !< PM0.1
829	REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET :: pm25_av !< PM2.5
830	REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET :: pm10_av !< PM10
831	!
832	!-- In the particle phase:
833	REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET :: s_bc_av !< black carbon
834	REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET :: s_du_av !< dust
835	REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET :: s_h2o_av !< liquid water
836	REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET :: s_nh_av !< ammonia
837	REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET :: s_no_av !< nitrates
838	REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET :: s_oc_av !< org. carbon
839	REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET :: s_so4_av !< sulphates
840	REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET :: s_ss_av !< sea salt
841	!
842	!-- Bin specific mass and number concentrations:
843	REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE, TARGET :: mbins_av !< bin mas
844	REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE, TARGET :: nbins_av !< bin number
845
846	!
847	!-- PALM interfaces:
848
849	INTERFACE salsa_actions
850	MODULE PROCEDURE salsa_actions
851	MODULE PROCEDURE salsa_actions_ij
852	END INTERFACE salsa_actions
853
854	INTERFACE salsa_3d_data_averaging
855	MODULE PROCEDURE salsa_3d_data_averaging
856	END INTERFACE salsa_3d_data_averaging
857
858	INTERFACE salsa_boundary_conds
859	MODULE PROCEDURE salsa_boundary_conds
860	MODULE PROCEDURE salsa_boundary_conds_decycle
861	END INTERFACE salsa_boundary_conds
862
863	INTERFACE salsa_boundary_conditions
864	MODULE PROCEDURE salsa_boundary_conditions
865	END INTERFACE salsa_boundary_conditions
866
867	INTERFACE salsa_check_data_output
868	MODULE PROCEDURE salsa_check_data_output
869	END INTERFACE salsa_check_data_output
870
871	INTERFACE salsa_check_data_output_pr
872	MODULE PROCEDURE salsa_check_data_output_pr
873	END INTERFACE salsa_check_data_output_pr
874
875	INTERFACE salsa_check_parameters
876	MODULE PROCEDURE salsa_check_parameters
877	END INTERFACE salsa_check_parameters
878
879	INTERFACE salsa_data_output_2d
880	MODULE PROCEDURE salsa_data_output_2d
881	END INTERFACE salsa_data_output_2d
882
883	INTERFACE salsa_data_output_3d
884	MODULE PROCEDURE salsa_data_output_3d
885	END INTERFACE salsa_data_output_3d
886
887	INTERFACE salsa_data_output_mask
888	MODULE PROCEDURE salsa_data_output_mask
889	END INTERFACE salsa_data_output_mask
890
891	INTERFACE salsa_define_netcdf_grid
892	MODULE PROCEDURE salsa_define_netcdf_grid
893	END INTERFACE salsa_define_netcdf_grid
894
895	INTERFACE salsa_emission_update
896	MODULE PROCEDURE salsa_emission_update
897	END INTERFACE salsa_emission_update
898
899	INTERFACE salsa_exchange_horiz_bounds
900	MODULE PROCEDURE salsa_exchange_horiz_bounds
901	END INTERFACE salsa_exchange_horiz_bounds
902
903	INTERFACE salsa_header
904	MODULE PROCEDURE salsa_header
905	END INTERFACE salsa_header
906
907	INTERFACE salsa_init
908	MODULE PROCEDURE salsa_init
909	END INTERFACE salsa_init
910
911	INTERFACE salsa_init_arrays
912	MODULE PROCEDURE salsa_init_arrays
913	END INTERFACE salsa_init_arrays
914
915	INTERFACE salsa_nesting_offl_bc
916	MODULE PROCEDURE salsa_nesting_offl_bc
917	END INTERFACE salsa_nesting_offl_bc
918
919	INTERFACE salsa_nesting_offl_init
920	MODULE PROCEDURE salsa_nesting_offl_init
921	END INTERFACE salsa_nesting_offl_init
922
923	INTERFACE salsa_nesting_offl_input
924	MODULE PROCEDURE salsa_nesting_offl_input
925	END INTERFACE salsa_nesting_offl_input
926
927	INTERFACE salsa_non_advective_processes
928	MODULE PROCEDURE salsa_non_advective_processes
929	MODULE PROCEDURE salsa_non_advective_processes_ij
930	END INTERFACE salsa_non_advective_processes
931
932	INTERFACE salsa_parin
933	MODULE PROCEDURE salsa_parin
934	END INTERFACE salsa_parin
935
936	INTERFACE salsa_prognostic_equations
937	MODULE PROCEDURE salsa_prognostic_equations
938	MODULE PROCEDURE salsa_prognostic_equations_ij
939	END INTERFACE salsa_prognostic_equations
940
941	INTERFACE salsa_rrd_local
942	MODULE PROCEDURE salsa_rrd_local
943	END INTERFACE salsa_rrd_local
944
945	INTERFACE salsa_statistics
946	MODULE PROCEDURE salsa_statistics
947	END INTERFACE salsa_statistics
948
949	INTERFACE salsa_swap_timelevel
950	MODULE PROCEDURE salsa_swap_timelevel
951	END INTERFACE salsa_swap_timelevel
952
953	INTERFACE salsa_tendency
954	MODULE PROCEDURE salsa_tendency
955	MODULE PROCEDURE salsa_tendency_ij
956	END INTERFACE salsa_tendency
957
958	INTERFACE salsa_wrd_local
959	MODULE PROCEDURE salsa_wrd_local
960	END INTERFACE salsa_wrd_local
961
962
963	SAVE
964
965	PRIVATE
966	!
967	!-- Public functions:
968	PUBLIC salsa_3d_data_averaging, &
969	salsa_actions, &
970	salsa_boundary_conds, &
971	salsa_boundary_conditions, &
972	salsa_check_data_output, &
973	salsa_check_data_output_pr, &
974	salsa_check_parameters, &
975	salsa_data_output_2d, &
976	salsa_data_output_3d, &
977	salsa_data_output_mask, &
978	salsa_define_netcdf_grid, &
979	salsa_diagnostics, &
980	salsa_emission_update, &
981	salsa_exchange_horiz_bounds, &
982	salsa_header, &
983	salsa_init, &
984	salsa_init_arrays, &
985	salsa_nesting_offl_bc, &
986	salsa_nesting_offl_init, &
987	salsa_nesting_offl_input, &
988	salsa_non_advective_processes, &
989	salsa_parin, &
990	salsa_prognostic_equations, &
991	salsa_rrd_local, &
992	salsa_statistics, &
993	salsa_swap_timelevel, &
994	salsa_wrd_local
995
996	!
997	!-- Public parameters, constants and initial values
998	PUBLIC bc_am_t_val, &
999	bc_an_t_val, &
1000	bc_gt_t_val, &
1001	ibc_salsa_b, &
1002	init_aerosol_type, &
1003	init_gases_type, &
1004	nesting_salsa, &
1005	nesting_offline_salsa, &
1006	salsa_gases_from_chem, &
1007	skip_time_do_salsa
1008	!
1009	!-- Public variables
1010	PUBLIC aerosol_mass, &
1011	aerosol_number, &
1012	gconc_2, &
1013	mconc_2, &
1014	nbins_aerosol, &
1015	ncomponents_mass, &
1016	nconc_2, &
1017	ngases_salsa, &
1018	salsa_gas, &
1019	salsa_nest_offl
1020
1021
1022	CONTAINS
1023
1024	!------------------------------------------------------------------------------!
1025	! Description:
1026	! ------------
1027	!> Parin for &salsa_par for new modules
1028	!------------------------------------------------------------------------------!
1029	SUBROUTINE salsa_parin
1030
1031	USE control_parameters, &
1032	ONLY: data_output_pr
1033
1034	IMPLICIT NONE
1035
1036	CHARACTER(LEN=80) :: line !< dummy string that contains the current line of parameter file
1037
1038	INTEGER(iwp) :: i !< loop index
1039	INTEGER(iwp) :: max_pr_salsa_tmp !< dummy variable
1040
1041	NAMELIST /salsa_parameters/ aerosol_flux_dpg, &
1042	aerosol_flux_mass_fracs_a, &
1043	aerosol_flux_mass_fracs_b, &
1044	aerosol_flux_sigmag, &
1045	advect_particle_water, &
1046	bc_salsa_b, &
1047	bc_salsa_t, &
1048	decycle_salsa_lr, &
1049	decycle_method_salsa, &
1050	decycle_salsa_ns, &
1051	depo_pcm_par, &
1052	depo_pcm_type, &
1053	depo_surf_par, &
1054	dpg, &
1055	dt_salsa, &
1056	emiss_factor_main, &
1057	emiss_factor_side, &
1058	feedback_to_palm, &
1059	h2so4_init, &
1060	hno3_init, &
1061	listspec, &
1062	main_street_id, &
1063	mass_fracs_a, &
1064	mass_fracs_b, &
1065	max_street_id, &
1066	n_lognorm, &
1067	nbin, &
1068	nesting_salsa, &
1069	nesting_offline_salsa, &
1070	nf2a, &
1071	nh3_init, &
1072	nj3, &
1073	nlcnd, &
1074	nlcndgas, &
1075	nlcndh2oae, &
1076	nlcoag, &
1077	nldepo, &
1078	nldepo_pcm, &
1079	nldepo_surf, &
1080	nldistupdate, &
1081	nsnucl, &
1082	ocnv_init, &
1083	ocsv_init, &
1084	read_restart_data_salsa, &
1085	reglim, &
1086	salsa, &
1087	salsa_emission_mode, &
1088	season_z01, &
1089	sigmag, &
1090	side_street_id, &
1091	skip_time_do_salsa, &
1092	surface_aerosol_flux, &
1093	van_der_waals_coagc, &
1094	write_binary_salsa
1095
1096	line = ' '
1097	!
1098	!-- Try to find salsa package
1099	REWIND ( 11 )
1100	line = ' '
1101	DO WHILE ( INDEX( line, '&salsa_parameters' ) == 0 )
1102	READ ( 11, '(A)', END=10 ) line
1103	ENDDO
1104	BACKSPACE ( 11 )
1105	!
1106	!-- Read user-defined namelist
1107	READ ( 11, salsa_parameters )
1108	!
1109	!-- Enable salsa (salsa switch in modules.f90)
1110	salsa = .TRUE.
1111
1112	10 CONTINUE
1113	!
1114	!-- Update the number of output profiles
1115	max_pr_salsa_tmp = 0
1116	i = 1
1117	DO WHILE ( data_output_pr(i) /= ' ' .AND. i <= 100 )
1118	IF ( TRIM( data_output_pr(i)(1:6) ) == 'salsa_' ) max_pr_salsa_tmp = max_pr_salsa_tmp + 1
1119	i = i + 1
1120	ENDDO
1121	IF ( max_pr_salsa_tmp > 0 ) max_pr_salsa = max_pr_salsa_tmp
1122
1123	END SUBROUTINE salsa_parin
1124
1125	!------------------------------------------------------------------------------!
1126	! Description:
1127	! ------------
1128	!> Check parameters routine for salsa.
1129	!------------------------------------------------------------------------------!
1130	SUBROUTINE salsa_check_parameters
1131
1132	USE control_parameters, &
1133	ONLY: child_domain, humidity, initializing_actions, nesting_offline
1134
1135	IMPLICIT NONE
1136
1137	!
1138	!-- Check that humidity is switched on
1139	IF ( salsa .AND. .NOT. humidity ) THEN
1140	WRITE( message_string, * ) 'salsa = ', salsa, ' is not allowed with humidity = ', humidity
1141	CALL message( 'salsa_check_parameters', 'PA0594', 1, 2, 0, 6, 0 )
1142	ENDIF
1143	!
1144	!-- For nested runs, explicitly set nesting boundary conditions.
1145	IF ( child_domain ) THEN
1146	IF ( nesting_salsa ) THEN
1147	bc_salsa_t = 'nested'
1148	ELSE
1149	bc_salsa_t = 'neumann'
1150	ENDIF
1151	ENDIF
1152	!
1153	!-- Set boundary conditions also in case the model is offline-nested in larger-scale models.
1154	IF ( nesting_offline ) THEN
1155	IF ( nesting_offline_salsa ) THEN
1156	bc_salsa_t = 'nesting_offline'
1157	ELSE
1158	bc_salsa_t = 'neumann'
1159	ENDIF
1160	ENDIF
1161	!
1162	!-- Set bottom boundary condition flag
1163	IF ( bc_salsa_b == 'dirichlet' ) THEN
1164	ibc_salsa_b = 0
1165	ELSEIF ( bc_salsa_b == 'neumann' ) THEN
1166	ibc_salsa_b = 1
1167	ELSE
1168	message_string = 'unknown boundary condition: bc_salsa_b = "' // TRIM( bc_salsa_t ) // '"'
1169	CALL message( 'salsa_check_parameters', 'PA0595', 1, 2, 0, 6, 0 )
1170	ENDIF
1171	!
1172	!-- Set top boundary conditions flag
1173	IF ( bc_salsa_t == 'dirichlet' ) THEN
1174	ibc_salsa_t = 0
1175	ELSEIF ( bc_salsa_t == 'neumann' ) THEN
1176	ibc_salsa_t = 1
1177	ELSEIF ( bc_salsa_t == 'initial_gradient' ) THEN
1178	ibc_salsa_t = 2
1179	ELSEIF ( bc_salsa_t == 'nested' .OR. bc_salsa_t == 'nesting_offline' ) THEN
1180	ibc_salsa_t = 3
1181	ELSE
1182	message_string = 'unknown boundary condition: bc_salsa_t = "' // TRIM( bc_salsa_t ) // '"'
1183	CALL message( 'salsa_check_parameters', 'PA0596', 1, 2, 0, 6, 0 )
1184	ENDIF
1185	!
1186	!-- Check J3 parametrisation
1187	IF ( nj3 < 1 .OR. nj3 > 3 ) THEN
1188	message_string = 'unknown nj3 (must be 1-3)'
1189	CALL message( 'salsa_check_parameters', 'PA0597', 1, 2, 0, 6, 0 )
1190	ENDIF
1191	!
1192	!-- Check bottom boundary condition in case of surface emissions
1193	IF ( salsa_emission_mode /= 'no_emission' .AND. ibc_salsa_b == 0 ) THEN
1194	message_string = 'salsa_emission_mode /= "no_emission" requires bc_salsa_b = "Neumann"'
1195	CALL message( 'salsa_check_parameters','PA0598', 1, 2, 0, 6, 0 )
1196	ENDIF
1197	!
1198	!-- Check whether emissions are applied
1199	IF ( salsa_emission_mode /= 'no_emission' ) include_emission = .TRUE.
1200	!
1201	!-- Set the initialisation type: background concentration are read from PIDS_DYNAMIC if
1202	!-- initializing_actions = 'inifor set_constant_profiles'
1203	IF ( INDEX( initializing_actions, 'inifor' ) /= 0 ) THEN
1204	init_aerosol_type = 1
1205	init_gases_type = 1
1206	ENDIF
1207
1208
1209	END SUBROUTINE salsa_check_parameters
1210
1211	!------------------------------------------------------------------------------!
1212	!
1213	! Description:
1214	! ------------
1215	!> Subroutine defining appropriate grid for netcdf variables.
1216	!> It is called out from subroutine netcdf.
1217	!> Same grid as for other scalars (see netcdf_interface_mod.f90)
1218	!------------------------------------------------------------------------------!
1219	SUBROUTINE salsa_define_netcdf_grid( var, found, grid_x, grid_y, grid_z )
1220
1221	IMPLICIT NONE
1222
1223	CHARACTER(LEN=*), INTENT(OUT) :: grid_x !<
1224	CHARACTER(LEN=*), INTENT(OUT) :: grid_y !<
1225	CHARACTER(LEN=*), INTENT(OUT) :: grid_z !<
1226	CHARACTER(LEN=*), INTENT(IN) :: var !<
1227
1228	LOGICAL, INTENT(OUT) :: found !<
1229
1230	found = .TRUE.
1231	!
1232	!-- Check for the grid
1233
1234	IF ( var(1:6) == 'salsa_' ) THEN ! same grid for all salsa output variables
1235	grid_x = 'x'
1236	grid_y = 'y'
1237	grid_z = 'zu'
1238	ELSE
1239	found = .FALSE.
1240	grid_x = 'none'
1241	grid_y = 'none'
1242	grid_z = 'none'
1243	ENDIF
1244
1245	END SUBROUTINE salsa_define_netcdf_grid
1246
1247	!------------------------------------------------------------------------------!
1248	! Description:
1249	! ------------
1250	!> Header output for new module
1251	!------------------------------------------------------------------------------!
1252	SUBROUTINE salsa_header( io )
1253
1254	USE indices, &
1255	ONLY: nx, ny, nz
1256
1257	IMPLICIT NONE
1258
1259	INTEGER(iwp), INTENT(IN) :: io !< Unit of the output file
1260	!
1261	!-- Write SALSA header
1262	WRITE( io, 1 )
1263	WRITE( io, 2 ) skip_time_do_salsa
1264	WRITE( io, 3 ) dt_salsa
1265	WRITE( io, 4 ) nz, ny, nx, nbins_aerosol
1266	IF ( advect_particle_water ) THEN
1267	WRITE( io, 5 ) nz, ny, nx, ncomponents_mass*nbins_aerosol, advect_particle_water
1268	ELSE
1269	WRITE( io, 5 ) nz, ny, nx, ncc*nbins_aerosol, advect_particle_water
1270	ENDIF
1271	IF ( .NOT. salsa_gases_from_chem ) THEN
1272	WRITE( io, 6 ) nz, ny, nx, ngases_salsa, salsa_gases_from_chem
1273	ENDIF
1274	WRITE( io, 7 )
1275	IF ( nsnucl > 0 ) WRITE( io, 8 ) nsnucl, nj3
1276	IF ( nlcoag ) WRITE( io, 9 )
1277	IF ( nlcnd ) WRITE( io, 10 ) nlcndgas, nlcndh2oae
1278	IF ( lspartition ) WRITE( io, 11 )
1279	IF ( nldepo ) WRITE( io, 12 ) nldepo_pcm, nldepo_surf
1280	WRITE( io, 13 ) reglim, nbin, bin_low_limits
1281	IF ( init_aerosol_type == 0 ) WRITE( io, 14 ) nsect
1282	WRITE( io, 15 ) ncc, listspec, mass_fracs_a, mass_fracs_b
1283	IF ( .NOT. salsa_gases_from_chem ) THEN
1284	WRITE( io, 16 ) ngases_salsa, h2so4_init, hno3_init, nh3_init, ocnv_init, ocsv_init
1285	ENDIF
1286	WRITE( io, 17 ) init_aerosol_type, init_gases_type
1287	IF ( init_aerosol_type == 0 ) THEN
1288	WRITE( io, 18 ) dpg, sigmag, n_lognorm
1289	ELSE
1290	WRITE( io, 19 )
1291	ENDIF
1292	IF ( nesting_salsa ) WRITE( io, 20 ) nesting_salsa
1293	IF ( nesting_offline_salsa ) WRITE( io, 21 ) nesting_offline_salsa
1294	WRITE( io, 22 ) salsa_emission_mode
1295	IF ( salsa_emission_mode == 'uniform' ) THEN
1296	WRITE( io, 23 ) surface_aerosol_flux, aerosol_flux_dpg, aerosol_flux_sigmag, &
1297	aerosol_flux_mass_fracs_a
1298	ENDIF
1299	IF ( SUM( aerosol_flux_mass_fracs_b ) > 0.0_wp .OR. salsa_emission_mode == 'read_from_file' ) &
1300	THEN
1301	WRITE( io, 24 )
1302	ENDIF
1303
1304	1 FORMAT (//' SALSA information:'/ &
1305	' ------------------------------'/)
1306	2 FORMAT (' Starts at: skip_time_do_salsa = ', F10.2, ' s')
1307	3 FORMAT (/' Timestep: dt_salsa = ', F6.2, ' s')
1308	4 FORMAT (/' Array shape (z,y,x,bins):'/ &
1309	' aerosol_number: ', 4(I3))
1310	5 FORMAT (/' aerosol_mass: ', 4(I3),/ &
1311	' (advect_particle_water = ', L1, ')')
1312	6 FORMAT (' salsa_gas: ', 4(I3),/ &
1313	' (salsa_gases_from_chem = ', L1, ')')
1314	7 FORMAT (/' Aerosol dynamic processes included: ')
1315	8 FORMAT (/' nucleation (scheme = ', I1, ' and J3 parametrization = ', I1, ')')
1316	9 FORMAT (/' coagulation')
1317	10 FORMAT (/' condensation (of precursor gases = ', L1, ' and water vapour = ', L1, ')' )
1318	11 FORMAT (/' dissolutional growth by HNO3 and NH3')
1319	12 FORMAT (/' dry deposition (on vegetation = ', L1, ' and on topography = ', L1, ')')
1320	13 FORMAT (/' Aerosol bin subrange limits (in metres): ', 3(ES10.2E3), / &
1321	' Number of size bins for each aerosol subrange: ', 2I3,/ &
1322	' Aerosol bin limits (in metres): ', 9(ES10.2E3))
1323	14 FORMAT (' Initial number concentration in bins at the lowest level (#/m**3):', 9(ES10.2E3))
1324	15 FORMAT (/' Number of chemical components used: ', I1,/ &
1325	' Species: ',7(A6),/ &
1326	' Initial relative contribution of each species to particle volume in:',/ &
1327	' a-bins: ', 7(F6.3),/ &
1328	' b-bins: ', 7(F6.3))
1329	16 FORMAT (/' Number of gaseous tracers used: ', I1,/ &
1330	' Initial gas concentrations:',/ &
1331	' H2SO4: ',ES12.4E3, ' #/m**3',/ &
1332	' HNO3: ',ES12.4E3, ' #/m**3',/ &
1333	' NH3: ',ES12.4E3, ' #/m**3',/ &
1334	' OCNV: ',ES12.4E3, ' #/m**3',/ &
1335	' OCSV: ',ES12.4E3, ' #/m**3')
1336	17 FORMAT (/' Initialising concentrations: ', / &
1337	' Aerosol size distribution: init_aerosol_type = ', I1,/ &
1338	' Gas concentrations: init_gases_type = ', I1 )
1339	18 FORMAT ( ' Mode diametres: dpg(nmod) = ', 7(F7.3), ' (m)', / &
1340	' Standard deviation: sigmag(nmod) = ', 7(F7.2),/ &
1341	' Number concentration: n_lognorm(nmod) = ', 7(ES12.4E3), ' (#/m3)' )
1342	19 FORMAT (/' Size distribution read from a file.')
1343	20 FORMAT (/' Nesting for salsa variables: ', L1 )
1344	21 FORMAT (/' Offline nesting for salsa variables: ', L1 )
1345	22 FORMAT (/' Emissions: salsa_emission_mode = ', A )
1346	23 FORMAT (/' surface_aerosol_flux = ', ES12.4E3, ' #/m**2/s', / &
1347	' aerosol_flux_dpg = ', 7(F7.3), ' (m)', / &
1348	' aerosol_flux_sigmag = ', 7(F7.2), / &
1349	' aerosol_mass_fracs_a = ', 7(ES12.4E3) )
1350	24 FORMAT (/' (currently all emissions are soluble!)')
1351
1352	END SUBROUTINE salsa_header
1353
1354	!------------------------------------------------------------------------------!
1355	! Description:
1356	! ------------
1357	!> Allocate SALSA arrays and define pointers if required
1358	!------------------------------------------------------------------------------!
1359	SUBROUTINE salsa_init_arrays
1360
1361	USE advec_ws, &
1362	ONLY: ws_init_flags_scalar
1363
1364	USE surface_mod, &
1365	ONLY: surf_def_h, surf_def_v, surf_lsm_h, surf_lsm_v, surf_usm_h, surf_usm_v
1366
1367	IMPLICIT NONE
1368
1369	INTEGER(iwp) :: gases_available !< Number of available gas components in the chemistry model
1370	INTEGER(iwp) :: i !< loop index for allocating
1371	INTEGER(iwp) :: ii !< index for indexing chemical components
1372	INTEGER(iwp) :: l !< loop index for allocating: surfaces
1373	INTEGER(iwp) :: lsp !< loop index for chem species in the chemistry model
1374
1375	gases_available = 0
1376	!
1377	!-- Allocate prognostic variables (see salsa_swap_timelevel)
1378	!
1379	!-- Set derived indices:
1380	!-- (This does the same as the subroutine salsa_initialize in SALSA/UCLALES-SALSA)
1381	start_subrange_1a = 1 ! 1st index of subrange 1a
1382	start_subrange_2a = start_subrange_1a + nbin(1) ! 1st index of subrange 2a
1383	end_subrange_1a = start_subrange_2a - 1 ! last index of subrange 1a
1384	end_subrange_2a = end_subrange_1a + nbin(2) ! last index of subrange 2a
1385
1386	!
1387	!-- If the fraction of insoluble aerosols in subrange 2 is zero: do not allocate arrays for them
1388	IF ( nf2a > 0.999999_wp .AND. SUM( mass_fracs_b ) < 0.00001_wp ) THEN
1389	no_insoluble = .TRUE.
1390	start_subrange_2b = end_subrange_2a+1 ! 1st index of subrange 2b
1391	end_subrange_2b = end_subrange_2a ! last index of subrange 2b
1392	ELSE
1393	start_subrange_2b = start_subrange_2a + nbin(2) ! 1st index of subrange 2b
1394	end_subrange_2b = end_subrange_2a + nbin(2) ! last index of subrange 2b
1395	ENDIF
1396
1397	nbins_aerosol = end_subrange_2b ! total number of aerosol size bins
1398	!
1399	!-- Create index tables for different aerosol components
1400	CALL component_index_constructor( prtcl, ncc, maxspec, listspec )
1401
1402	ncomponents_mass = ncc
1403	IF ( advect_particle_water ) ncomponents_mass = ncc + 1 ! Add water
1404	!
1405	!-- Indices for chemical components used (-1 = not used)
1406	ii = 0
1407	IF ( is_used( prtcl, 'SO4' ) ) THEN
1408	index_so4 = get_index( prtcl,'SO4' )
1409	ii = ii + 1
1410	ENDIF
1411	IF ( is_used( prtcl,'OC' ) ) THEN
1412	index_oc = get_index(prtcl, 'OC')
1413	ii = ii + 1
1414	ENDIF
1415	IF ( is_used( prtcl, 'BC' ) ) THEN
1416	index_bc = get_index( prtcl, 'BC' )
1417	ii = ii + 1
1418	ENDIF
1419	IF ( is_used( prtcl, 'DU' ) ) THEN
1420	index_du = get_index( prtcl, 'DU' )
1421	ii = ii + 1
1422	ENDIF
1423	IF ( is_used( prtcl, 'SS' ) ) THEN
1424	index_ss = get_index( prtcl, 'SS' )
1425	ii = ii + 1
1426	ENDIF
1427	IF ( is_used( prtcl, 'NO' ) ) THEN
1428	index_no = get_index( prtcl, 'NO' )
1429	ii = ii + 1
1430	ENDIF
1431	IF ( is_used( prtcl, 'NH' ) ) THEN
1432	index_nh = get_index( prtcl, 'NH' )
1433	ii = ii + 1
1434	ENDIF
1435	!
1436	!-- All species must be known
1437	IF ( ii /= ncc ) THEN
1438	message_string = 'Unknown aerosol species/component(s) given in the initialization'
1439	CALL message( 'salsa_mod: salsa_init', 'PA0600', 1, 2, 0, 6, 0 )
1440	ENDIF
1441	!
1442	!-- Allocate:
1443	ALLOCATE( aero(nbins_aerosol), bc_am_t_val(nbins_aerosol*ncomponents_mass), &
1444	bc_an_t_val(nbins_aerosol), bc_gt_t_val(ngases_salsa), bin_low_limits(nbins_aerosol),&
1445	nsect(nbins_aerosol), massacc(nbins_aerosol) )
1446	ALLOCATE( k_topo_top(nysg:nyng,nxlg:nxrg) )
1447	IF ( nldepo ) ALLOCATE( sedim_vd(nzb:nzt+1,nysg:nyng,nxlg:nxrg,nbins_aerosol) )
1448	ALLOCATE( ra_dry(nzb:nzt+1,nysg:nyng,nxlg:nxrg,nbins_aerosol) )
1449	!
1450	!-- Initialise the sectional particle size distribution
1451	CALL set_sizebins
1452	!
1453	!-- Aerosol number concentration
1454	ALLOCATE( aerosol_number(nbins_aerosol) )
1455	ALLOCATE( nconc_1(nzb:nzt+1,nysg:nyng,nxlg:nxrg,nbins_aerosol), &
1456	nconc_2(nzb:nzt+1,nysg:nyng,nxlg:nxrg,nbins_aerosol), &
1457	nconc_3(nzb:nzt+1,nysg:nyng,nxlg:nxrg,nbins_aerosol) )
1458	nconc_1 = 0.0_wp
1459	nconc_2 = 0.0_wp
1460	nconc_3 = 0.0_wp
1461
1462	DO i = 1, nbins_aerosol
1463	aerosol_number(i)%conc(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => nconc_1(:,:,:,i)
1464	aerosol_number(i)%conc_p(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => nconc_2(:,:,:,i)
1465	aerosol_number(i)%tconc_m(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => nconc_3(:,:,:,i)
1466	ALLOCATE( aerosol_number(i)%flux_s(nzb+1:nzt,0:threads_per_task-1), &
1467	aerosol_number(i)%diss_s(nzb+1:nzt,0:threads_per_task-1), &
1468	aerosol_number(i)%flux_l(nzb+1:nzt,nys:nyn,0:threads_per_task-1), &
1469	aerosol_number(i)%diss_l(nzb+1:nzt,nys:nyn,0:threads_per_task-1), &
1470	aerosol_number(i)%init(nzb:nzt+1), &
1471	aerosol_number(i)%sums_ws_l(nzb:nzt+1,0:threads_per_task-1) )
1472	aerosol_number(i)%init = nclim
1473	IF ( include_emission .OR. ( nldepo .AND. nldepo_surf ) ) THEN
1474	ALLOCATE( aerosol_number(i)%source(nys:nyn,nxl:nxr) )
1475	aerosol_number(i)%source = 0.0_wp
1476	ENDIF
1477	ENDDO
1478
1479	!
1480	!-- Aerosol mass concentration
1481	ALLOCATE( aerosol_mass(ncomponents_mass*nbins_aerosol) )
1482	ALLOCATE( mconc_1(nzb:nzt+1,nysg:nyng,nxlg:nxrg,ncomponents_mass*nbins_aerosol), &
1483	mconc_2(nzb:nzt+1,nysg:nyng,nxlg:nxrg,ncomponents_mass*nbins_aerosol), &
1484	mconc_3(nzb:nzt+1,nysg:nyng,nxlg:nxrg,ncomponents_mass*nbins_aerosol) )
1485	mconc_1 = 0.0_wp
1486	mconc_2 = 0.0_wp
1487	mconc_3 = 0.0_wp
1488
1489	DO i = 1, ncomponents_mass*nbins_aerosol
1490	aerosol_mass(i)%conc(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => mconc_1(:,:,:,i)
1491	aerosol_mass(i)%conc_p(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => mconc_2(:,:,:,i)
1492	aerosol_mass(i)%tconc_m(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => mconc_3(:,:,:,i)
1493	ALLOCATE( aerosol_mass(i)%flux_s(nzb+1:nzt,0:threads_per_task-1), &
1494	aerosol_mass(i)%diss_s(nzb+1:nzt,0:threads_per_task-1), &
1495	aerosol_mass(i)%flux_l(nzb+1:nzt,nys:nyn,0:threads_per_task-1), &
1496	aerosol_mass(i)%diss_l(nzb+1:nzt,nys:nyn,0:threads_per_task-1), &
1497	aerosol_mass(i)%init(nzb:nzt+1), &
1498	aerosol_mass(i)%sums_ws_l(nzb:nzt+1,0:threads_per_task-1) )
1499	aerosol_mass(i)%init = mclim
1500	IF ( include_emission .OR. ( nldepo .AND. nldepo_surf ) ) THEN
1501	ALLOCATE( aerosol_mass(i)%source(nys:nyn,nxl:nxr) )
1502	aerosol_mass(i)%source = 0.0_wp
1503	ENDIF
1504	ENDDO
1505
1506	!
1507	!-- Surface fluxes: answs = aerosol number, amsws = aerosol mass
1508	!
1509	!-- Horizontal surfaces: default type
1510	DO l = 0, 2 ! upward (l=0), downward (l=1) and model top (l=2)
1511	ALLOCATE( surf_def_h(l)%answs( 1:surf_def_h(l)%ns, nbins_aerosol ) )
1512	ALLOCATE( surf_def_h(l)%amsws( 1:surf_def_h(l)%ns, nbins_aerosol*ncomponents_mass ) )
1513	surf_def_h(l)%answs = 0.0_wp
1514	surf_def_h(l)%amsws = 0.0_wp
1515	ENDDO
1516	!
1517	!-- Horizontal surfaces: natural type
1518	ALLOCATE( surf_lsm_h%answs( 1:surf_lsm_h%ns, nbins_aerosol ) )
1519	ALLOCATE( surf_lsm_h%amsws( 1:surf_lsm_h%ns, nbins_aerosol*ncomponents_mass ) )
1520	surf_lsm_h%answs = 0.0_wp
1521	surf_lsm_h%amsws = 0.0_wp
1522	!
1523	!-- Horizontal surfaces: urban type
1524	ALLOCATE( surf_usm_h%answs( 1:surf_usm_h%ns, nbins_aerosol ) )
1525	ALLOCATE( surf_usm_h%amsws( 1:surf_usm_h%ns, nbins_aerosol*ncomponents_mass ) )
1526	surf_usm_h%answs = 0.0_wp
1527	surf_usm_h%amsws = 0.0_wp
1528
1529	!
1530	!-- Vertical surfaces: northward (l=0), southward (l=1), eastward (l=2) and westward (l=3) facing
1531	DO l = 0, 3
1532	ALLOCATE( surf_def_v(l)%answs( 1:surf_def_v(l)%ns, nbins_aerosol ) )
1533	surf_def_v(l)%answs = 0.0_wp
1534	ALLOCATE( surf_def_v(l)%amsws( 1:surf_def_v(l)%ns, nbins_aerosol*ncomponents_mass ) )
1535	surf_def_v(l)%amsws = 0.0_wp
1536
1537	ALLOCATE( surf_lsm_v(l)%answs( 1:surf_lsm_v(l)%ns, nbins_aerosol ) )
1538	surf_lsm_v(l)%answs = 0.0_wp
1539	ALLOCATE( surf_lsm_v(l)%amsws( 1:surf_lsm_v(l)%ns, nbins_aerosol*ncomponents_mass ) )
1540	surf_lsm_v(l)%amsws = 0.0_wp
1541
1542	ALLOCATE( surf_usm_v(l)%answs( 1:surf_usm_v(l)%ns, nbins_aerosol ) )
1543	surf_usm_v(l)%answs = 0.0_wp
1544	ALLOCATE( surf_usm_v(l)%amsws( 1:surf_usm_v(l)%ns, nbins_aerosol*ncomponents_mass ) )
1545	surf_usm_v(l)%amsws = 0.0_wp
1546
1547	ENDDO
1548
1549	!
1550	!-- Concentration of gaseous tracers (1. SO4, 2. HNO3, 3. NH3, 4. OCNV, 5. OCSV)
1551	!-- (number concentration (#/m3) )
1552	!
1553	!-- If chemistry is on, read gas phase concentrations from there. Otherwise,
1554	!-- allocate salsa_gas array.
1555
1556	IF ( air_chemistry ) THEN
1557	DO lsp = 1, nvar
1558	SELECT CASE ( TRIM( chem_species(lsp)%name ) )
1559	CASE ( 'H2SO4', 'h2so4' )
1560	gases_available = gases_available + 1
1561	gas_index_chem(1) = lsp
1562	CASE ( 'HNO3', 'hno3' )
1563	gases_available = gases_available + 1
1564	gas_index_chem(2) = lsp
1565	CASE ( 'NH3', 'nh3' )
1566	gases_available = gases_available + 1
1567	gas_index_chem(3) = lsp
1568	CASE ( 'OCNV', 'ocnv' )
1569	gases_available = gases_available + 1
1570	gas_index_chem(4) = lsp
1571	CASE ( 'OCSV', 'ocsv' )
1572	gases_available = gases_available + 1
1573	gas_index_chem(5) = lsp
1574	END SELECT
1575	ENDDO
1576
1577	IF ( gases_available == ngases_salsa ) THEN
1578	salsa_gases_from_chem = .TRUE.
1579	ELSE
1580	WRITE( message_string, * ) 'SALSA is run together with chemistry but not all gaseous '// &
1581	'components are provided by kpp (H2SO4, HNO3, NH3, OCNV, OCSV)'
1582	CALL message( 'check_parameters', 'PA0599', 1, 2, 0, 6, 0 )
1583	ENDIF
1584
1585	ELSE
1586
1587	ALLOCATE( salsa_gas(ngases_salsa) )
1588	ALLOCATE( gconc_1(nzb:nzt+1,nysg:nyng,nxlg:nxrg,ngases_salsa), &
1589	gconc_2(nzb:nzt+1,nysg:nyng,nxlg:nxrg,ngases_salsa), &
1590	gconc_3(nzb:nzt+1,nysg:nyng,nxlg:nxrg,ngases_salsa) )
1591	gconc_1 = 0.0_wp
1592	gconc_2 = 0.0_wp
1593	gconc_3 = 0.0_wp
1594
1595	DO i = 1, ngases_salsa
1596	salsa_gas(i)%conc(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => gconc_1(:,:,:,i)
1597	salsa_gas(i)%conc_p(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => gconc_2(:,:,:,i)
1598	salsa_gas(i)%tconc_m(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => gconc_3(:,:,:,i)
1599	ALLOCATE( salsa_gas(i)%flux_s(nzb+1:nzt,0:threads_per_task-1), &
1600	salsa_gas(i)%diss_s(nzb+1:nzt,0:threads_per_task-1), &
1601	salsa_gas(i)%flux_l(nzb+1:nzt,nys:nyn,0:threads_per_task-1),&
1602	salsa_gas(i)%diss_l(nzb+1:nzt,nys:nyn,0:threads_per_task-1),&
1603	salsa_gas(i)%init(nzb:nzt+1), &
1604	salsa_gas(i)%sums_ws_l(nzb:nzt+1,0:threads_per_task-1) )
1605	salsa_gas(i)%init = nclim
1606	IF ( include_emission ) THEN
1607	ALLOCATE( salsa_gas(i)%source(nys:nys,nxl:nxr) )
1608	salsa_gas(i)%source = 0.0_wp
1609	ENDIF
1610	ENDDO
1611	!
1612	!-- Surface fluxes: gtsws = gaseous tracer flux
1613	!
1614	!-- Horizontal surfaces: default type
1615	DO l = 0, 2 ! upward (l=0), downward (l=1) and model top (l=2)
1616	ALLOCATE( surf_def_h(l)%gtsws( 1:surf_def_h(l)%ns, ngases_salsa ) )
1617	surf_def_h(l)%gtsws = 0.0_wp
1618	ENDDO
1619	!-- Horizontal surfaces: natural type
1620	ALLOCATE( surf_lsm_h%gtsws( 1:surf_lsm_h%ns, ngases_salsa ) )
1621	surf_lsm_h%gtsws = 0.0_wp
1622	!-- Horizontal surfaces: urban type
1623	ALLOCATE( surf_usm_h%gtsws( 1:surf_usm_h%ns, ngases_salsa ) )
1624	surf_usm_h%gtsws = 0.0_wp
1625	!
1626	!-- Vertical surfaces: northward (l=0), southward (l=1), eastward (l=2) and
1627	!-- westward (l=3) facing
1628	DO l = 0, 3
1629	ALLOCATE( surf_def_v(l)%gtsws( 1:surf_def_v(l)%ns, ngases_salsa ) )
1630	surf_def_v(l)%gtsws = 0.0_wp
1631	ALLOCATE( surf_lsm_v(l)%gtsws( 1:surf_lsm_v(l)%ns, ngases_salsa ) )
1632	surf_lsm_v(l)%gtsws = 0.0_wp
1633	ALLOCATE( surf_usm_v(l)%gtsws( 1:surf_usm_v(l)%ns, ngases_salsa ) )
1634	surf_usm_v(l)%gtsws = 0.0_wp
1635	ENDDO
1636	ENDIF
1637
1638	IF ( ws_scheme_sca ) THEN
1639
1640	IF ( salsa ) THEN
1641	ALLOCATE( sums_salsa_ws_l(nzb:nzt+1,0:threads_per_task-1) )
1642	sums_salsa_ws_l = 0.0_wp
1643	ENDIF
1644
1645	ENDIF
1646	!
1647	!-- Set control flags for decycling only at lateral boundary cores. Within the inner cores the
1648	!-- decycle flag is set to .FALSE.. Even though it does not affect the setting of chemistry boundary
1649	!-- conditions, this flag is used to set advection control flags appropriately.
1650	decycle_salsa_lr = MERGE( decycle_salsa_lr, .FALSE., nxl == 0 .OR. nxr == nx )
1651	decycle_salsa_ns = MERGE( decycle_salsa_ns, .FALSE., nys == 0 .OR. nyn == ny )
1652	!
1653	!-- Decycling can be applied separately for aerosol variables, while wind and other scalars may have
1654	!-- cyclic or nested boundary conditions. However, large gradients near the boundaries may produce
1655	!-- stationary numerical oscillations near the lateral boundaries when a higher-order scheme is
1656	!-- applied near these boundaries. To get rid-off this, set-up additional flags that control the
1657	!-- order of the scalar advection scheme near the lateral boundaries for passive scalars with
1658	!-- decycling.
1659	IF ( scalar_advec == 'ws-scheme' ) THEN
1660	ALLOCATE( salsa_advc_flags_s(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
1661	!
1662	!-- In case of decycling, set Neuman boundary conditions for wall_flags_total_0 bit 31 instead of
1663	!-- cyclic boundary conditions. Bit 31 is used to identify extended degradation zones (please see
1664	!-- the following comment). Note, since several also other modules may access this bit but may
1665	!-- have other boundary conditions, the original value of wall_flags_total_0 bit 31 must not be
1666	!-- modified. Hence, store the boundary conditions directly on salsa_advc_flags_s.
1667	!-- salsa_advc_flags_s will be later overwritten in ws_init_flags_scalar and bit 31 won't be used
1668	!-- to control the numerical order.
1669	!-- Initialize with flag 31 only.
1670	salsa_advc_flags_s = 0
1671	salsa_advc_flags_s = MERGE( IBSET( salsa_advc_flags_s, 31 ), 0, BTEST( wall_flags_total_0, 31 ) )
1672
1673	IF ( decycle_salsa_ns ) THEN
1674	IF ( nys == 0 ) THEN
1675	DO i = 1, nbgp
1676	salsa_advc_flags_s(:,nys-i,:) = MERGE( IBSET( salsa_advc_flags_s(:,nys,:), 31 ), &
1677	IBCLR( salsa_advc_flags_s(:,nys,:), 31 ), &
1678	BTEST( salsa_advc_flags_s(:,nys,:), 31 ) )
1679	ENDDO
1680	ENDIF
1681	IF ( nyn == ny ) THEN
1682	DO i = 1, nbgp
1683	salsa_advc_flags_s(:,nyn+i,:) = MERGE( IBSET( salsa_advc_flags_s(:,nyn,:), 31 ), &
1684	IBCLR( salsa_advc_flags_s(:,nyn,:), 31 ), &
1685	BTEST( salsa_advc_flags_s(:,nyn,:), 31 ) )
1686	ENDDO
1687	ENDIF
1688	ENDIF
1689	IF ( decycle_salsa_lr ) THEN
1690	IF ( nxl == 0 ) THEN
1691	DO i = 1, nbgp
1692	salsa_advc_flags_s(:,:,nxl-i) = MERGE( IBSET( salsa_advc_flags_s(:,:,nxl), 31 ), &
1693	IBCLR( salsa_advc_flags_s(:,:,nxl), 31 ), &
1694	BTEST( salsa_advc_flags_s(:,:,nxl), 31 ) )
1695	ENDDO
1696	ENDIF
1697	IF ( nxr == nx ) THEN
1698	DO i = 1, nbgp
1699	salsa_advc_flags_s(:,:,nxr+i) = MERGE( IBSET( salsa_advc_flags_s(:,:,nxr), 31 ), &
1700	IBCLR( salsa_advc_flags_s(:,:,nxr), 31 ), &
1701	BTEST( salsa_advc_flags_s(:,:,nxr), 31 ) )
1702	ENDDO
1703	ENDIF
1704	ENDIF
1705	!
1706	!-- To initialise the advection flags appropriately, pass the boundary flags to
1707	!-- ws_init_flags_scalar. The last argument in ws_init_flags_scalar indicates that a passive
1708	!-- scalar is being treated and the horizontal advection terms are degraded already 2 grid points
1709	!-- before the lateral boundary. Also, extended degradation zones are applied, where
1710	!-- horizontal advection of scalars is discretised by the first-order scheme at all grid points
1711	!-- in the vicinity of buildings (<= 3 grid points). Even though no building is within the
1712	!-- numerical stencil, the first-order scheme is used. At fourth and fifth grid points, the order
1713	!-- of the horizontal advection scheme is successively upgraded.
1714	!-- These degradations of the advection scheme are done to avoid stationary numerical
1715	!-- oscillations, which are responsible for high concentration maxima that may appear e.g. under
1716	!-- shear-free stable conditions.
1717	CALL ws_init_flags_scalar( bc_dirichlet_l .OR. bc_radiation_l .OR. decycle_salsa_lr, &
1718	bc_dirichlet_n .OR. bc_radiation_n .OR. decycle_salsa_ns, &
1719	bc_dirichlet_r .OR. bc_radiation_r .OR. decycle_salsa_lr, &
1720	bc_dirichlet_s .OR. bc_radiation_s .OR. decycle_salsa_ns, &
1721	salsa_advc_flags_s, .TRUE. )
1722	ENDIF
1723
1724
1725	END SUBROUTINE salsa_init_arrays
1726
1727	!------------------------------------------------------------------------------!
1728	! Description:
1729	! ------------
1730	!> Initialization of SALSA. Based on salsa_initialize in UCLALES-SALSA.
1731	!> Subroutines salsa_initialize, SALSAinit and DiagInitAero in UCLALES-SALSA are
1732	!> also merged here.
1733	!------------------------------------------------------------------------------!
1734	SUBROUTINE salsa_init
1735
1736	IMPLICIT NONE
1737
1738	INTEGER(iwp) :: i !<
1739	INTEGER(iwp) :: ib !< loop index for aerosol number bins
1740	INTEGER(iwp) :: ic !< loop index for aerosol mass bins
1741	INTEGER(iwp) :: ig !< loop index for gases
1742	INTEGER(iwp) :: j !<
1743
1744	IF ( debug_output ) CALL debug_message( 'salsa_init', 'start' )
1745
1746	bin_low_limits = 0.0_wp
1747	k_topo_top = 0
1748	nsect = 0.0_wp
1749	massacc = 1.0_wp
1750	!
1751	!-- Initialise
1752	IF ( nldepo ) sedim_vd = 0.0_wp
1753
1754	IF ( .NOT. salsa_gases_from_chem ) THEN
1755	IF ( .NOT. read_restart_data_salsa ) THEN
1756	salsa_gas(1)%conc = h2so4_init
1757	salsa_gas(2)%conc = hno3_init
1758	salsa_gas(3)%conc = nh3_init
1759	salsa_gas(4)%conc = ocnv_init
1760	salsa_gas(5)%conc = ocsv_init
1761	ENDIF
1762	DO ig = 1, ngases_salsa
1763	salsa_gas(ig)%conc_p = 0.0_wp
1764	salsa_gas(ig)%tconc_m = 0.0_wp
1765	salsa_gas(ig)%flux_s = 0.0_wp
1766	salsa_gas(ig)%diss_s = 0.0_wp
1767	salsa_gas(ig)%flux_l = 0.0_wp
1768	salsa_gas(ig)%diss_l = 0.0_wp
1769	salsa_gas(ig)%sums_ws_l = 0.0_wp
1770	salsa_gas(ig)%conc_p = salsa_gas(ig)%conc
1771	ENDDO
1772	!
1773	!-- Set initial value for gas compound tracer
1774	salsa_gas(1)%init = h2so4_init
1775	salsa_gas(2)%init = hno3_init
1776	salsa_gas(3)%init = nh3_init
1777	salsa_gas(4)%init = ocnv_init
1778	salsa_gas(5)%init = ocsv_init
1779	ENDIF
1780	!
1781	!-- Aerosol radius in each bin: dry and wet (m)
1782	ra_dry = 1.0E-10_wp
1783	!
1784	!-- Initialise location-dependent aerosol size distributions and chemical compositions:
1785	CALL aerosol_init
1786
1787	!-- Initalisation run of SALSA + calculate the vertical top index of the topography
1788	DO i = nxl, nxr
1789	DO j = nys, nyn
1790
1791	k_topo_top(j,i) = MAXLOC( MERGE( 1, 0, BTEST( wall_flags_total_0(:,j,i), 12 ) ), &
1792	DIM = 1 ) - 1
1793
1794	CALL salsa_driver( i, j, 1 )
1795	CALL salsa_diagnostics( i, j )
1796	ENDDO
1797	ENDDO
1798
1799	DO ib = 1, nbins_aerosol
1800	aerosol_number(ib)%conc_p = aerosol_number(ib)%conc
1801	aerosol_number(ib)%tconc_m = 0.0_wp
1802	aerosol_number(ib)%flux_s = 0.0_wp
1803	aerosol_number(ib)%diss_s = 0.0_wp
1804	aerosol_number(ib)%flux_l = 0.0_wp
1805	aerosol_number(ib)%diss_l = 0.0_wp
1806	aerosol_number(ib)%sums_ws_l = 0.0_wp
1807	ENDDO
1808	DO ic = 1, ncomponents_mass*nbins_aerosol
1809	aerosol_mass(ic)%conc_p = aerosol_mass(ic)%conc
1810	aerosol_mass(ic)%tconc_m = 0.0_wp
1811	aerosol_mass(ic)%flux_s = 0.0_wp
1812	aerosol_mass(ic)%diss_s = 0.0_wp
1813	aerosol_mass(ic)%flux_l = 0.0_wp
1814	aerosol_mass(ic)%diss_l = 0.0_wp
1815	aerosol_mass(ic)%sums_ws_l = 0.0_wp
1816	ENDDO
1817	!
1818	!
1819	!-- Initialise the deposition scheme and surface types
1820	IF ( nldepo ) CALL init_deposition
1821
1822	IF ( include_emission ) THEN
1823	!
1824	!-- Read in and initialize emissions
1825	CALL salsa_emission_setup( .TRUE. )
1826	IF ( .NOT. salsa_gases_from_chem .AND. salsa_emission_mode == 'read_from_file' ) THEN
1827	CALL salsa_gas_emission_setup( .TRUE. )
1828	ENDIF
1829	ENDIF
1830	!
1831	!-- Partition and dissolutional growth by gaseous HNO3 and NH3
1832	IF ( index_no > 0 .AND. index_nh > 0 .AND. index_so4 > 0 ) lspartition = .TRUE.
1833
1834	IF ( debug_output ) CALL debug_message( 'salsa_init', 'end' )
1835
1836	END SUBROUTINE salsa_init
1837
1838	!------------------------------------------------------------------------------!
1839	! Description:
1840	! ------------
1841	!> Initializes particle size distribution grid by calculating size bin limits
1842	!> and mid-size for dry particles in each bin. Called from salsa_initialize
1843	!> (only at the beginning of simulation).
1844	!> Size distribution described using:
1845	!> 1) moving center method (subranges 1 and 2)
1846	!> (Jacobson, Atmos. Env., 31, 131-144, 1997)
1847	!> 2) fixed sectional method (subrange 3)
1848	!> Size bins in each subrange are spaced logarithmically
1849	!> based on given subrange size limits and bin number.
1850	!
1851	!> Mona changed 06/2017: Use geometric mean diameter to describe the mean
1852	!> particle diameter in a size bin, not the arithmeric mean which clearly
1853	!> overestimates the total particle volume concentration.
1854	!
1855	!> Coded by:
1856	!> Hannele Korhonen (FMI) 2005
1857	!> Harri Kokkola (FMI) 2006
1858	!
1859	!> Bug fixes for box model + updated for the new aerosol datatype:
1860	!> Juha Tonttila (FMI) 2014
1861	!------------------------------------------------------------------------------!
1862	SUBROUTINE set_sizebins
1863
1864	IMPLICIT NONE
1865
1866	INTEGER(iwp) :: cc !< running index
1867	INTEGER(iwp) :: dd !< running index
1868
1869	REAL(wp) :: ratio_d !< ratio of the upper and lower diameter of subranges
1870
1871	aero(:)%dwet = 1.0E-10_wp
1872	aero(:)%veqh2o = 1.0E-10_wp
1873	aero(:)%numc = nclim
1874	aero(:)%core = 1.0E-10_wp
1875	DO cc = 1, maxspec+1 ! 1:SO4, 2:OC, 3:BC, 4:DU, 5:SS, 6:NO, 7:NH, 8:H2O
1876	aero(:)%volc(cc) = 0.0_wp
1877	ENDDO
1878	!
1879	!-- vlolim&vhilim: min & max dry volumes [fxm]
1880	!-- dmid: bin mid dry diameter (m)
1881	!-- vratiolo&vratiohi: volume ratio between the center and low/high limit
1882	!
1883	!-- 1) Size subrange 1:
1884	ratio_d = reglim(2) / reglim(1) ! section spacing (m)
1885	DO cc = start_subrange_1a, end_subrange_1a
1886	aero(cc)%vlolim = api6 * ( reglim(1) * ratio_d( REAL( cc-1 ) / nbin(1) ) )3
1887	aero(cc)%vhilim = api6 * ( reglim(1) * ratio_d( REAL( cc ) / nbin(1) ) )3
1888	aero(cc)%dmid = SQRT( ( aero(cc)%vhilim / api6 )*0.33333333_wp &
1889	( aero(cc)%vlolim / api6 )**0.33333333_wp )
1890	aero(cc)%vratiohi = aero(cc)%vhilim / ( api6 * aero(cc)%dmid**3 )
1891	aero(cc)%vratiolo = aero(cc)%vlolim / ( api6 * aero(cc)%dmid**3 )
1892	ENDDO
1893	!
1894	!-- 2) Size subrange 2:
1895	!-- 2.1) Sub-subrange 2a: high hygroscopicity
1896	ratio_d = reglim(3) / reglim(2) ! section spacing
1897	DO dd = start_subrange_2a, end_subrange_2a
1898	cc = dd - start_subrange_2a
1899	aero(dd)%vlolim = api6 * ( reglim(2) * ratio_d( REAL( cc ) / nbin(2) ) )3
1900	aero(dd)%vhilim = api6 * ( reglim(2) * ratio_d( REAL( cc+1 ) / nbin(2) ) )3
1901	aero(dd)%dmid = SQRT( ( aero(dd)%vhilim / api6 )*0.33333333_wp &
1902	( aero(dd)%vlolim / api6 )**0.33333333_wp )
1903	aero(dd)%vratiohi = aero(dd)%vhilim / ( api6 * aero(dd)%dmid**3 )
1904	aero(dd)%vratiolo = aero(dd)%vlolim / ( api6 * aero(dd)%dmid**3 )
1905	ENDDO
1906	!
1907	!-- 2.2) Sub-subrange 2b: low hygroscopicity
1908	IF ( .NOT. no_insoluble ) THEN
1909	aero(start_subrange_2b:end_subrange_2b)%vlolim = aero(start_subrange_2a:end_subrange_2a)%vlolim
1910	aero(start_subrange_2b:end_subrange_2b)%vhilim = aero(start_subrange_2a:end_subrange_2a)%vhilim
1911	aero(start_subrange_2b:end_subrange_2b)%dmid = aero(start_subrange_2a:end_subrange_2a)%dmid
1912	aero(start_subrange_2b:end_subrange_2b)%vratiohi = aero(start_subrange_2a:end_subrange_2a)%vratiohi
1913	aero(start_subrange_2b:end_subrange_2b)%vratiolo = aero(start_subrange_2a:end_subrange_2a)%vratiolo
1914	ENDIF
1915	!
1916	!-- Initialize the wet diameter with the bin dry diameter to avoid numerical problems later
1917	aero(:)%dwet = aero(:)%dmid
1918	!
1919	!-- Save bin limits (lower diameter) to be delivered to PALM if needed
1920	DO cc = 1, nbins_aerosol
1921	bin_low_limits(cc) = ( aero(cc)%vlolim / api6 )**0.33333333_wp
1922	ENDDO
1923
1924	END SUBROUTINE set_sizebins
1925
1926	!------------------------------------------------------------------------------!
1927	! Description:
1928	! ------------
1929	!> Initilize altitude-dependent aerosol size distributions and compositions.
1930	!>
1931	!> Mona added 06/2017: Correct the number and mass concentrations by normalizing
1932	!< by the given total number and mass concentration.
1933	!>
1934	!> Tomi Raatikainen, FMI, 29.2.2016
1935	!------------------------------------------------------------------------------!
1936	SUBROUTINE aerosol_init
1937
1938	USE netcdf_data_input_mod, &
1939	ONLY: check_existence, close_input_file, get_dimension_length, &
1940	get_attribute, get_variable, &
1941	inquire_num_variables, inquire_variable_names, &
1942	open_read_file
1943
1944	IMPLICIT NONE
1945
1946	CHARACTER(LEN=25), DIMENSION(:), ALLOCATABLE :: cc_name !< chemical component name
1947	CHARACTER(LEN=100), DIMENSION(:), ALLOCATABLE :: var_names !< variable names
1948
1949	INTEGER(iwp) :: ee !< index: end
1950	INTEGER(iwp) :: i !< loop index: x-direction
1951	INTEGER(iwp) :: ib !< loop index: size bins
1952	INTEGER(iwp) :: ic !< loop index: chemical components
1953	INTEGER(iwp) :: id_dyn !< NetCDF id of PIDS_DYNAMIC_SALSA
1954	INTEGER(iwp) :: ig !< loop index: gases
1955	INTEGER(iwp) :: j !< loop index: y-direction
1956	INTEGER(iwp) :: k !< loop index: z-direction
1957	INTEGER(iwp) :: lod_aero !< level of detail of inital aerosol concentrations
1958	INTEGER(iwp) :: num_vars !< number of variables
1959	INTEGER(iwp) :: pr_nbins !< number of aerosol size bins in file
1960	INTEGER(iwp) :: pr_ncc !< number of aerosol chemical components in file
1961	INTEGER(iwp) :: pr_nz !< number of vertical grid-points in file
1962	INTEGER(iwp) :: prunmode !< running mode of SALSA
1963	INTEGER(iwp) :: ss !< index: start
1964
1965	INTEGER(iwp), DIMENSION(maxspec) :: cc_in2mod
1966
1967	LOGICAL :: netcdf_extend = .FALSE. !< Flag: netcdf file exists
1968
1969	REAL(wp) :: flag !< flag to mask topography grid points
1970
1971	REAL(wp), DIMENSION(nbins_aerosol) :: core !< size of the bin mid aerosol particle
1972
1973	REAL(wp), DIMENSION(0:nz+1) :: pnf2a !< number fraction in 2a
1974	REAL(wp), DIMENSION(0:nz+1) :: pmfoc1a !< mass fraction of OC in 1a
1975
1976	REAL(wp), DIMENSION(0:nz+1,nbins_aerosol) :: pndist !< vertical profile of size dist. (#/m3)
1977	REAL(wp), DIMENSION(0:nz+1,maxspec) :: pmf2a !< mass distributions in subrange 2a
1978	REAL(wp), DIMENSION(0:nz+1,maxspec) :: pmf2b !< mass distributions in subrange 2b
1979
1980	REAL(wp), DIMENSION(:), ALLOCATABLE :: pr_dmid !< vertical profile of aerosol bin diameters
1981	REAL(wp), DIMENSION(:), ALLOCATABLE :: pr_z !< z levels of profiles
1982
1983	REAL(wp), DIMENSION(:,:), ALLOCATABLE :: pr_mass_fracs_a !< mass fraction: a
1984	REAL(wp), DIMENSION(:,:), ALLOCATABLE :: pr_mass_fracs_b !< and b
1985
1986	cc_in2mod = 0
1987	prunmode = 1
1988	!
1989	!-- Bin mean aerosol particle volume (m3)
1990	core(1:nbins_aerosol) = api6 * aero(1:nbins_aerosol)%dmid**3
1991	!
1992	!-- Set concentrations to zero
1993	pndist(:,:) = 0.0_wp
1994	pnf2a(:) = nf2a
1995	pmf2a(:,:) = 0.0_wp
1996	pmf2b(:,:) = 0.0_wp
1997	pmfoc1a(:) = 0.0_wp
1998
1999	IF ( init_aerosol_type == 1 ) THEN
2000	!
2001	!-- Read input profiles from PIDS_DYNAMIC_SALSA
2002	#if defined( __netcdf )
2003	!
2004	!-- Location-dependent size distributions and compositions.
2005	INQUIRE( FILE = TRIM( input_file_dynamic ) // TRIM( coupling_char ), EXIST = netcdf_extend )
2006	IF ( netcdf_extend ) THEN
2007	!
2008	!-- Open file in read-only mode
2009	CALL open_read_file( TRIM( input_file_dynamic ) // TRIM( coupling_char ), id_dyn )
2010	!
2011	!-- At first, inquire all variable names
2012	CALL inquire_num_variables( id_dyn, num_vars )
2013	!
2014	!-- Allocate memory to store variable names
2015	ALLOCATE( var_names(1:num_vars) )
2016	CALL inquire_variable_names( id_dyn, var_names )
2017	!
2018	!-- Inquire vertical dimension and number of aerosol chemical components
2019	CALL get_dimension_length( id_dyn, pr_nz, 'z' )
2020	IF ( pr_nz /= nz ) THEN
2021	WRITE( message_string, * ) 'Number of inifor horizontal grid points does not match '//&
2022	'the number of numeric grid points.'
2023	CALL message( 'aerosol_init', 'PA0601', 1, 2, 0, 6, 0 )
2024	ENDIF
2025	CALL get_dimension_length( id_dyn, pr_ncc, 'composition_index' )
2026	!
2027	!-- Allocate memory
2028	ALLOCATE( pr_z(1:pr_nz), pr_mass_fracs_a(nzb:nzt+1,pr_ncc), &
2029	pr_mass_fracs_b(nzb:nzt+1,pr_ncc) )
2030	pr_mass_fracs_a = 0.0_wp
2031	pr_mass_fracs_b = 0.0_wp
2032	!
2033	!-- Read vertical levels
2034	CALL get_variable( id_dyn, 'z', pr_z )
2035	!
2036	!-- Read the names of chemical components
2037	IF ( check_existence( var_names, 'composition_name' ) ) THEN
2038	CALL get_variable( id_dyn, 'composition_name', cc_name, pr_ncc )
2039	ELSE
2040	WRITE( message_string, * ) 'Missing composition_name in ' // TRIM( input_file_dynamic )
2041	CALL message( 'aerosol_init', 'PA0655', 1, 2, 0, 6, 0 )
2042	ENDIF
2043	!
2044	!-- Define the index of each chemical component in the model
2045	DO ic = 1, pr_ncc
2046	SELECT CASE ( TRIM( cc_name(ic) ) )
2047	CASE ( 'H2SO4', 'SO4', 'h2so4', 'so4' )
2048	cc_in2mod(1) = ic
2049	CASE ( 'OC', 'oc' )
2050	cc_in2mod(2) = ic
2051	CASE ( 'BC', 'bc' )
2052	cc_in2mod(3) = ic
2053	CASE ( 'DU', 'du' )
2054	cc_in2mod(4) = ic
2055	CASE ( 'SS', 'ss' )
2056	cc_in2mod(5) = ic
2057	CASE ( 'HNO3', 'hno3', 'NO3', 'no3', 'NO', 'no' )
2058	cc_in2mod(6) = ic
2059	CASE ( 'NH3', 'nh3', 'NH4', 'nh4', 'NH', 'nh' )
2060	cc_in2mod(7) = ic
2061	END SELECT
2062	ENDDO
2063
2064	IF ( SUM( cc_in2mod ) == 0 ) THEN
2065	message_string = 'None of the aerosol chemical components in ' // TRIM( &
2066	input_file_dynamic ) // ' correspond to ones applied in SALSA.'
2067	CALL message( 'salsa_mod: aerosol_init', 'PA0602', 2, 2, 0, 6, 0 )
2068	ENDIF
2069	!
2070	!-- Vertical profiles of mass fractions of different chemical components:
2071	IF ( check_existence( var_names, 'init_atmosphere_mass_fracs_a' ) ) THEN
2072	CALL get_variable( id_dyn, 'init_atmosphere_mass_fracs_a', pr_mass_fracs_a, &
2073	0, pr_ncc-1, 0, pr_nz-1 )
2074	ELSE
2075	WRITE( message_string, * ) 'Missing init_atmosphere_mass_fracs_a in ' // &
2076	TRIM( input_file_dynamic )
2077	CALL message( 'aerosol_init', 'PA0656', 1, 2, 0, 6, 0 )
2078	ENDIF
2079	CALL get_variable( id_dyn, 'init_atmosphere_mass_fracs_b', pr_mass_fracs_b, &
2080	0, pr_ncc-1, 0, pr_nz-1 )
2081	!
2082	!-- Match the input data with the chemical composition applied in the model
2083	DO ic = 1, maxspec
2084	ss = cc_in2mod(ic)
2085	IF ( ss == 0 ) CYCLE
2086	pmf2a(nzb+1:nzt+1,ic) = pr_mass_fracs_a(nzb:nzt,ss)
2087	pmf2b(nzb+1:nzt+1,ic) = pr_mass_fracs_b(nzb:nzt,ss)
2088	ENDDO
2089	!
2090	!-- Aerosol concentrations: lod=1 (vertical profile of sectional number size distribution)
2091	CALL get_attribute( id_dyn, 'lod', lod_aero, .FALSE., 'init_atmosphere_aerosol' )
2092	IF ( lod_aero /= 1 ) THEN
2093	message_string = 'Currently only lod=1 accepted for init_atmosphere_aerosol'
2094	CALL message( 'salsa_mod: aerosol_init', 'PA0603', 2, 2, 0, 6, 0 )
2095	ELSE
2096	!
2097	!-- Bin mean diameters in the input file
2098	CALL get_dimension_length( id_dyn, pr_nbins, 'Dmid')
2099	IF ( pr_nbins /= nbins_aerosol ) THEN
2100	message_string = 'Number of size bins in init_atmosphere_aerosol does not match ' &
2101	// 'with that applied in the model'
2102	CALL message( 'salsa_mod: aerosol_init', 'PA0604', 2, 2, 0, 6, 0 )
2103	ENDIF
2104
2105	ALLOCATE( pr_dmid(pr_nbins) )
2106	pr_dmid = 0.0_wp
2107
2108	CALL get_variable( id_dyn, 'Dmid', pr_dmid )
2109	!
2110	!-- Check whether the sectional representation conform to the one
2111	!-- applied in the model
2112	IF ( ANY( ABS( ( aero(1:nbins_aerosol)%dmid - pr_dmid ) / &
2113	aero(1:nbins_aerosol)%dmid ) > 0.1_wp ) ) THEN
2114	message_string = 'Mean diameters of the aerosol size bins in ' // TRIM( &
2115	input_file_dynamic ) // ' do not match with the sectional '// &
2116	'representation of the model.'
2117	CALL message( 'salsa_mod: aerosol_init', 'PA0605', 2, 2, 0, 6, 0 )
2118	ENDIF
2119	!
2120	!-- Inital aerosol concentrations
2121	CALL get_variable( id_dyn, 'init_atmosphere_aerosol', pndist(nzb+1:nzt,:), &
2122	0, pr_nbins-1, 0, pr_nz-1 )
2123	ENDIF
2124	!
2125	!-- Set bottom and top boundary condition (Neumann)
2126	pmf2a(nzb,:) = pmf2a(nzb+1,:)
2127	pmf2a(nzt+1,:) = pmf2a(nzt,:)
2128	pmf2b(nzb,:) = pmf2b(nzb+1,:)
2129	pmf2b(nzt+1,:) = pmf2b(nzt,:)
2130	pndist(nzb,:) = pndist(nzb+1,:)
2131	pndist(nzt+1,:) = pndist(nzt,:)
2132
2133	IF ( index_so4 < 0 ) THEN
2134	pmf2a(:,1) = 0.0_wp
2135	pmf2b(:,1) = 0.0_wp
2136	ENDIF
2137	IF ( index_oc < 0 ) THEN
2138	pmf2a(:,2) = 0.0_wp
2139	pmf2b(:,2) = 0.0_wp
2140	ENDIF
2141	IF ( index_bc < 0 ) THEN
2142	pmf2a(:,3) = 0.0_wp
2143	pmf2b(:,3) = 0.0_wp
2144	ENDIF
2145	IF ( index_du < 0 ) THEN
2146	pmf2a(:,4) = 0.0_wp
2147	pmf2b(:,4) = 0.0_wp
2148	ENDIF
2149	IF ( index_ss < 0 ) THEN
2150	pmf2a(:,5) = 0.0_wp
2151	pmf2b(:,5) = 0.0_wp
2152	ENDIF
2153	IF ( index_no < 0 ) THEN
2154	pmf2a(:,6) = 0.0_wp
2155	pmf2b(:,6) = 0.0_wp
2156	ENDIF
2157	IF ( index_nh < 0 ) THEN
2158	pmf2a(:,7) = 0.0_wp
2159	pmf2b(:,7) = 0.0_wp
2160	ENDIF
2161
2162	IF ( SUM( pmf2a ) < 0.00001_wp .AND. SUM( pmf2b ) < 0.00001_wp ) THEN
2163	message_string = 'Error in initialising mass fractions of chemical components. ' // &
2164	'Check that all chemical components are included in parameter file!'
2165	CALL message( 'salsa_mod: aerosol_init', 'PA0606', 2, 2, 0, 6, 0 )
2166	ENDIF
2167	!
2168	!-- Then normalise the mass fraction so that SUM = 1
2169	DO k = nzb, nzt+1
2170	pmf2a(k,:) = pmf2a(k,:) / SUM( pmf2a(k,:) )
2171	IF ( SUM( pmf2b(k,:) ) > 0.0_wp ) pmf2b(k,:) = pmf2b(k,:) / SUM( pmf2b(k,:) )
2172	ENDDO
2173
2174	DEALLOCATE( pr_z, pr_mass_fracs_a, pr_mass_fracs_b )
2175	!
2176	!-- Close input file
2177	CALL close_input_file( id_dyn )
2178
2179	ELSE
2180	message_string = 'Input file '// TRIM( input_file_dynamic ) // TRIM( coupling_char ) // &
2181	' for SALSA missing!'
2182	CALL message( 'salsa_mod: aerosol_init', 'PA0607', 1, 2, 0, 6, 0 )
2183
2184	ENDIF ! netcdf_extend
2185
2186	#else
2187	message_string = 'init_aerosol_type = 1 but preprocessor directive __netcdf is not used '// &
2188	'in compiling!'
2189	CALL message( 'salsa_mod: aerosol_init', 'PA0608', 1, 2, 0, 6, 0 )
2190
2191	#endif
2192
2193	ELSEIF ( init_aerosol_type == 0 ) THEN
2194	!
2195	!-- Mass fractions for species in a and b-bins
2196	IF ( index_so4 > 0 ) THEN
2197	pmf2a(:,1) = mass_fracs_a(index_so4)
2198	pmf2b(:,1) = mass_fracs_b(index_so4)
2199	ENDIF
2200	IF ( index_oc > 0 ) THEN
2201	pmf2a(:,2) = mass_fracs_a(index_oc)
2202	pmf2b(:,2) = mass_fracs_b(index_oc)
2203	ENDIF
2204	IF ( index_bc > 0 ) THEN
2205	pmf2a(:,3) = mass_fracs_a(index_bc)
2206	pmf2b(:,3) = mass_fracs_b(index_bc)
2207	ENDIF
2208	IF ( index_du > 0 ) THEN
2209	pmf2a(:,4) = mass_fracs_a(index_du)
2210	pmf2b(:,4) = mass_fracs_b(index_du)
2211	ENDIF
2212	IF ( index_ss > 0 ) THEN
2213	pmf2a(:,5) = mass_fracs_a(index_ss)
2214	pmf2b(:,5) = mass_fracs_b(index_ss)
2215	ENDIF
2216	IF ( index_no > 0 ) THEN
2217	pmf2a(:,6) = mass_fracs_a(index_no)
2218	pmf2b(:,6) = mass_fracs_b(index_no)
2219	ENDIF
2220	IF ( index_nh > 0 ) THEN
2221	pmf2a(:,7) = mass_fracs_a(index_nh)
2222	pmf2b(:,7) = mass_fracs_b(index_nh)
2223	ENDIF
2224	DO k = nzb, nzt+1
2225	pmf2a(k,:) = pmf2a(k,:) / SUM( pmf2a(k,:) )
2226	IF ( SUM( pmf2b(k,:) ) > 0.0_wp ) pmf2b(k,:) = pmf2b(k,:) / SUM( pmf2b(k,:) )
2227	ENDDO
2228
2229	CALL size_distribution( n_lognorm, dpg, sigmag, nsect )
2230	!
2231	!-- Normalize by the given total number concentration
2232	nsect = nsect * SUM( n_lognorm ) / SUM( nsect )
2233	DO ib = start_subrange_1a, end_subrange_2b
2234	pndist(:,ib) = nsect(ib)
2235	ENDDO
2236	ENDIF
2237
2238	IF ( init_gases_type == 1 ) THEN
2239	!
2240	!-- Read input profiles from PIDS_CHEM
2241	#if defined( __netcdf )
2242	!
2243	!-- Location-dependent size distributions and compositions.
2244	INQUIRE( FILE = TRIM( input_file_dynamic ) // TRIM( coupling_char ), EXIST = netcdf_extend )
2245	IF ( netcdf_extend .AND. .NOT. salsa_gases_from_chem ) THEN
2246	!
2247	!-- Open file in read-only mode
2248	CALL open_read_file( TRIM( input_file_dynamic ) // TRIM( coupling_char ), id_dyn )
2249	!
2250	!-- Inquire dimensions:
2251	CALL get_dimension_length( id_dyn, pr_nz, 'z' )
2252	IF ( pr_nz /= nz ) THEN
2253	WRITE( message_string, * ) 'Number of inifor horizontal grid points does not match '//&
2254	'the number of numeric grid points.'
2255	CALL message( 'aerosol_init', 'PA0609', 1, 2, 0, 6, 0 )
2256	ENDIF
2257	!
2258	!-- Read vertical profiles of gases:
2259	CALL get_variable( id_dyn, 'init_atmosphere_H2SO4', salsa_gas(1)%init(nzb+1:nzt) )
2260	CALL get_variable( id_dyn, 'init_atmosphere_HNO3', salsa_gas(2)%init(nzb+1:nzt) )
2261	CALL get_variable( id_dyn, 'init_atmosphere_NH3', salsa_gas(3)%init(nzb+1:nzt) )
2262	CALL get_variable( id_dyn, 'init_atmosphere_OCNV', salsa_gas(4)%init(nzb+1:nzt) )
2263	CALL get_variable( id_dyn, 'init_atmosphere_OCSV', salsa_gas(5)%init(nzb+1:nzt) )
2264	!
2265	!-- Set Neumann top and surface boundary condition for initial + initialise concentrations
2266	DO ig = 1, ngases_salsa
2267	salsa_gas(ig)%init(nzb) = salsa_gas(ig)%init(nzb+1)
2268	salsa_gas(ig)%init(nzt+1) = salsa_gas(ig)%init(nzt)
2269	IF ( .NOT. read_restart_data_salsa ) THEN
2270	DO k = nzb, nzt+1
2271	salsa_gas(ig)%conc(k,:,:) = salsa_gas(ig)%init(k)
2272	ENDDO
2273	ENDIF
2274	ENDDO
2275	!
2276	!-- Close input file
2277	CALL close_input_file( id_dyn )
2278
2279	ELSEIF ( .NOT. netcdf_extend .AND. .NOT. salsa_gases_from_chem ) THEN
2280	message_string = 'Input file '// TRIM( input_file_dynamic ) // TRIM( coupling_char ) // &
2281	' for SALSA missing!'
2282	CALL message( 'salsa_mod: aerosol_init', 'PA0610', 1, 2, 0, 6, 0 )
2283
2284	ENDIF ! netcdf_extend
2285	#else
2286	message_string = 'init_gases_type = 1 but preprocessor directive __netcdf is not used in '//&
2287	'compiling!'
2288	CALL message( 'salsa_mod: aerosol_init', 'PA0611', 1, 2, 0, 6, 0 )
2289
2290	#endif
2291
2292	ENDIF
2293	!
2294	!-- Both SO4 and OC are included, so use the given mass fractions
2295	IF ( index_oc > 0 .AND. index_so4 > 0 ) THEN
2296	pmfoc1a(:) = pmf2a(:,2) / ( pmf2a(:,2) + pmf2a(:,1) ) ! Normalize
2297	!
2298	!-- Pure organic carbon
2299	ELSEIF ( index_oc > 0 ) THEN
2300	pmfoc1a(:) = 1.0_wp
2301	!
2302	!-- Pure SO4
2303	ELSEIF ( index_so4 > 0 ) THEN
2304	pmfoc1a(:) = 0.0_wp
2305
2306	ELSE
2307	message_string = 'Either OC or SO4 must be active for aerosol region 1a!'
2308	CALL message( 'salsa_mod: aerosol_init', 'PA0612', 1, 2, 0, 6, 0 )
2309	ENDIF
2310
2311	!
2312	!-- Initialize concentrations
2313	DO i = nxlg, nxrg
2314	DO j = nysg, nyng
2315	DO k = nzb, nzt+1
2316	!
2317	!-- Predetermine flag to mask topography
2318	flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) )
2319	!
2320	!-- a) Number concentrations
2321	!-- Region 1:
2322	DO ib = start_subrange_1a, end_subrange_1a
2323	IF ( .NOT. read_restart_data_salsa ) THEN
2324	aerosol_number(ib)%conc(k,j,i) = pndist(k,ib) * flag
2325	ENDIF
2326	IF ( prunmode == 1 ) THEN
2327	aerosol_number(ib)%init = pndist(:,ib)
2328	ENDIF
2329	ENDDO
2330	!
2331	!-- Region 2:
2332	IF ( nreg > 1 ) THEN
2333	DO ib = start_subrange_2a, end_subrange_2a
2334	IF ( .NOT. read_restart_data_salsa ) THEN
2335	aerosol_number(ib)%conc(k,j,i) = MAX( 0.0_wp, pnf2a(k) ) * pndist(k,ib) * flag
2336	ENDIF
2337	IF ( prunmode == 1 ) THEN
2338	aerosol_number(ib)%init = MAX( 0.0_wp, nf2a ) * pndist(:,ib)
2339	ENDIF
2340	ENDDO
2341	IF ( .NOT. no_insoluble ) THEN
2342	DO ib = start_subrange_2b, end_subrange_2b
2343	IF ( pnf2a(k) < 1.0_wp ) THEN
2344	IF ( .NOT. read_restart_data_salsa ) THEN
2345	aerosol_number(ib)%conc(k,j,i) = MAX( 0.0_wp, 1.0_wp - pnf2a(k) ) * &
2346	pndist(k,ib) * flag
2347	ENDIF
2348	IF ( prunmode == 1 ) THEN
2349	aerosol_number(ib)%init = MAX( 0.0_wp, 1.0_wp - nf2a ) * pndist(:,ib)
2350	ENDIF
2351	ENDIF
2352	ENDDO
2353	ENDIF
2354	ENDIF
2355	!
2356	!-- b) Aerosol mass concentrations
2357	!-- bin subrange 1: done here separately due to the SO4/OC convention
2358	!
2359	!-- SO4:
2360	IF ( index_so4 > 0 ) THEN
2361	ss = ( index_so4 - 1 ) * nbins_aerosol + start_subrange_1a !< start
2362	ee = ( index_so4 - 1 ) * nbins_aerosol + end_subrange_1a !< end
2363	ib = start_subrange_1a
2364	DO ic = ss, ee
2365	IF ( .NOT. read_restart_data_salsa ) THEN
2366	aerosol_mass(ic)%conc(k,j,i) = MAX( 0.0_wp, 1.0_wp - pmfoc1a(k) ) * &
2367	pndist(k,ib) * core(ib) * arhoh2so4 * flag
2368	ENDIF
2369	IF ( prunmode == 1 ) THEN
2370	aerosol_mass(ic)%init(k) = MAX( 0.0_wp, 1.0_wp - pmfoc1a(k) ) * pndist(k,ib) &
2371	* core(ib) * arhoh2so4
2372	ENDIF
2373	ib = ib+1
2374	ENDDO
2375	ENDIF
2376	!
2377	!-- OC:
2378	IF ( index_oc > 0 ) THEN
2379	ss = ( index_oc - 1 ) * nbins_aerosol + start_subrange_1a !< start
2380	ee = ( index_oc - 1 ) * nbins_aerosol + end_subrange_1a !< end
2381	ib = start_subrange_1a
2382	DO ic = ss, ee
2383	IF ( .NOT. read_restart_data_salsa ) THEN
2384	aerosol_mass(ic)%conc(k,j,i) = MAX( 0.0_wp, pmfoc1a(k) ) * pndist(k,ib) * &
2385	core(ib) * arhooc * flag
2386	ENDIF
2387	IF ( prunmode == 1 ) THEN
2388	aerosol_mass(ic)%init(k) = MAX( 0.0_wp, pmfoc1a(k) ) * pndist(k,ib) * &
2389	core(ib) * arhooc
2390	ENDIF
2391	ib = ib+1
2392	ENDDO
2393	ENDIF
2394	ENDDO !< k
2395
2396	prunmode = 3 ! Init only once
2397
2398	ENDDO !< j
2399	ENDDO !< i
2400
2401	!
2402	!-- c) Aerosol mass concentrations
2403	!-- bin subrange 2:
2404	IF ( nreg > 1 ) THEN
2405
2406	IF ( index_so4 > 0 ) THEN
2407	CALL set_aero_mass( index_so4, pmf2a(:,1), pmf2b(:,1), pnf2a, pndist, core, arhoh2so4 )
2408	ENDIF
2409	IF ( index_oc > 0 ) THEN
2410	CALL set_aero_mass( index_oc, pmf2a(:,2), pmf2b(:,2), pnf2a, pndist, core, arhooc )
2411	ENDIF
2412	IF ( index_bc > 0 ) THEN
2413	CALL set_aero_mass( index_bc, pmf2a(:,3), pmf2b(:,3), pnf2a, pndist, core, arhobc )
2414	ENDIF
2415	IF ( index_du > 0 ) THEN
2416	CALL set_aero_mass( index_du, pmf2a(:,4), pmf2b(:,4), pnf2a, pndist, core, arhodu )
2417	ENDIF
2418	IF ( index_ss > 0 ) THEN
2419	CALL set_aero_mass( index_ss, pmf2a(:,5), pmf2b(:,5), pnf2a, pndist, core, arhoss )
2420	ENDIF
2421	IF ( index_no > 0 ) THEN
2422	CALL set_aero_mass( index_no, pmf2a(:,6), pmf2b(:,6), pnf2a, pndist, core, arhohno3 )
2423	ENDIF
2424	IF ( index_nh > 0 ) THEN
2425	CALL set_aero_mass( index_nh, pmf2a(:,7), pmf2b(:,7), pnf2a, pndist, core, arhonh3 )
2426	ENDIF
2427
2428	ENDIF
2429
2430	END SUBROUTINE aerosol_init
2431
2432	!------------------------------------------------------------------------------!
2433	! Description:
2434	! ------------
2435	!> Create a lognormal size distribution and discretise to a sectional
2436	!> representation.
2437	!------------------------------------------------------------------------------!
2438	SUBROUTINE size_distribution( in_ntot, in_dpg, in_sigma, psd_sect )
2439
2440	IMPLICIT NONE
2441
2442	INTEGER(iwp) :: ib !< running index: bin
2443	INTEGER(iwp) :: iteration !< running index: iteration
2444
2445	REAL(wp) :: d1 !< particle diameter (m, dummy)
2446	REAL(wp) :: d2 !< particle diameter (m, dummy)
2447	REAL(wp) :: delta_d !< (d2-d1)/10
2448	REAL(wp) :: deltadp !< bin width
2449	REAL(wp) :: dmidi !< ( d1 + d2 ) / 2
2450
2451	REAL(wp), DIMENSION(:), INTENT(in) :: in_dpg !< geometric mean diameter (m)
2452	REAL(wp), DIMENSION(:), INTENT(in) :: in_ntot !< number conc. (#/m3)
2453	REAL(wp), DIMENSION(:), INTENT(in) :: in_sigma !< standard deviation
2454
2455	REAL(wp), DIMENSION(:), INTENT(inout) :: psd_sect !< sectional size distribution
2456
2457	DO ib = start_subrange_1a, end_subrange_2b
2458	psd_sect(ib) = 0.0_wp
2459	!
2460	!-- Particle diameter at the low limit (largest in the bin) (m)
2461	d1 = ( aero(ib)%vlolim / api6 )**0.33333333_wp
2462	!
2463	!-- Particle diameter at the high limit (smallest in the bin) (m)
2464	d2 = ( aero(ib)%vhilim / api6 )**0.33333333_wp
2465	!
2466	!-- Span of particle diameter in a bin (m)
2467	delta_d = 0.1_wp * ( d2 - d1 )
2468	!
2469	!-- Iterate:
2470	DO iteration = 1, 10
2471	d1 = ( aero(ib)%vlolim / api6 )*0.33333333_wp + ( ib - 1) delta_d
2472	d2 = d1 + delta_d
2473	dmidi = 0.5_wp * ( d1 + d2 )
2474	deltadp = LOG10( d2 / d1 )
2475	!
2476	!-- Size distribution
2477	!-- in_ntot = total number, total area, or total volume concentration
2478	!-- in_dpg = geometric-mean number, area, or volume diameter
2479	!-- n(k) = number, area, or volume concentration in a bin
2480	psd_sect(ib) = psd_sect(ib) + SUM( in_ntot * deltadp / ( SQRT( 2.0_wp * pi ) * &
2481	LOG10( in_sigma ) ) * EXP( -LOG10( dmidi / in_dpg )**2.0_wp / &
2482	( 2.0_wp * LOG10( in_sigma ) ** 2.0_wp ) ) )
2483
2484	ENDDO
2485	ENDDO
2486
2487	END SUBROUTINE size_distribution
2488
2489	!------------------------------------------------------------------------------!
2490	! Description:
2491	! ------------
2492	!> Sets the mass concentrations to aerosol arrays in 2a and 2b.
2493	!>
2494	!> Tomi Raatikainen, FMI, 29.2.2016
2495	!------------------------------------------------------------------------------!
2496	SUBROUTINE set_aero_mass( ispec, pmf2a, pmf2b, pnf2a, pndist, pcore, prho )
2497
2498	IMPLICIT NONE
2499
2500	INTEGER(iwp) :: ee !< index: end
2501	INTEGER(iwp) :: i !< loop index
2502	INTEGER(iwp) :: ib !< loop index
2503	INTEGER(iwp) :: ic !< loop index
2504	INTEGER(iwp) :: j !< loop index
2505	INTEGER(iwp) :: k !< loop index
2506	INTEGER(iwp) :: prunmode !< 1 = initialise
2507	INTEGER(iwp) :: ss !< index: start
2508
2509	INTEGER(iwp), INTENT(in) :: ispec !< Aerosol species index
2510
2511	REAL(wp) :: flag !< flag to mask topography grid points
2512
2513	REAL(wp), INTENT(in) :: prho !< Aerosol density
2514
2515	REAL(wp), DIMENSION(nbins_aerosol), INTENT(in) :: pcore !< Aerosol bin mid core volume
2516	REAL(wp), DIMENSION(0:nz+1), INTENT(in) :: pnf2a !< Number fraction for 2a
2517	REAL(wp), DIMENSION(0:nz+1), INTENT(in) :: pmf2a !< Mass distributions for a
2518	REAL(wp), DIMENSION(0:nz+1), INTENT(in) :: pmf2b !< and b bins
2519
2520	REAL(wp), DIMENSION(0:nz+1,nbins_aerosol), INTENT(in) :: pndist !< Aerosol size distribution
2521
2522	prunmode = 1
2523
2524	DO i = nxlg, nxrg
2525	DO j = nysg, nyng
2526	DO k = nzb, nzt+1
2527	!
2528	!-- Predetermine flag to mask topography
2529	flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) )
2530	!
2531	!-- Regime 2a:
2532	ss = ( ispec - 1 ) * nbins_aerosol + start_subrange_2a
2533	ee = ( ispec - 1 ) * nbins_aerosol + end_subrange_2a
2534	ib = start_subrange_2a
2535	DO ic = ss, ee
2536	IF ( .NOT. read_restart_data_salsa ) THEN
2537	aerosol_mass(ic)%conc(k,j,i) = MAX( 0.0_wp, pmf2a(k) ) * pnf2a(k) * pndist(k,ib)&
2538	* pcore(ib) * prho * flag
2539	ENDIF
2540	IF ( prunmode == 1 ) THEN
2541	aerosol_mass(ic)%init(k) = MAX( 0.0_wp, pmf2a(k) ) * pnf2a(k) * pndist(k,ib) * &
2542	pcore(ib) * prho
2543	ENDIF
2544	ib = ib + 1
2545	ENDDO
2546	!
2547	!-- Regime 2b:
2548	IF ( .NOT. no_insoluble ) THEN
2549	ss = ( ispec - 1 ) * nbins_aerosol + start_subrange_2b
2550	ee = ( ispec - 1 ) * nbins_aerosol + end_subrange_2b
2551	ib = start_subrange_2a
2552	DO ic = ss, ee
2553	IF ( .NOT. read_restart_data_salsa ) THEN
2554	aerosol_mass(ic)%conc(k,j,i) = MAX( 0.0_wp, pmf2b(k) ) * ( 1.0_wp - pnf2a(k))&
2555	* pndist(k,ib) * pcore(ib) * prho * flag
2556	ENDIF
2557	IF ( prunmode == 1 ) THEN
2558	aerosol_mass(ic)%init(k) = MAX( 0.0_wp, pmf2b(k) ) * ( 1.0_wp - pnf2a(k) ) * &
2559	pndist(k,ib) * pcore(ib) * prho
2560	ENDIF
2561	ib = ib + 1
2562	ENDDO ! c
2563
2564	ENDIF
2565	ENDDO ! k
2566
2567	prunmode = 3 ! Init only once
2568
2569	ENDDO ! j
2570	ENDDO ! i
2571
2572	END SUBROUTINE set_aero_mass
2573
2574	!------------------------------------------------------------------------------!
2575	! Description:
2576	! ------------
2577	!> Initialise the matching between surface types in LSM and deposition models.
2578	!> Do the matching based on Zhang et al. (2001). Atmos. Environ. 35, 549-560
2579	!> (here referred as Z01).
2580	!------------------------------------------------------------------------------!
2581	SUBROUTINE init_deposition
2582
2583	USE surface_mod, &
2584	ONLY: surf_lsm_h, surf_lsm_v, surf_usm_h, surf_usm_v
2585
2586	IMPLICIT NONE
2587
2588	INTEGER(iwp) :: l !< loop index for vertical surfaces
2589
2590	LOGICAL :: match_lsm !< flag to initilise LSM surfaces (if false, initialise USM surfaces)
2591
2592	IF ( depo_pcm_par == 'zhang2001' ) THEN
2593	depo_pcm_par_num = 1
2594	ELSEIF ( depo_pcm_par == 'petroff2010' ) THEN
2595	depo_pcm_par_num = 2
2596	ENDIF
2597
2598	IF ( depo_surf_par == 'zhang2001' ) THEN
2599	depo_surf_par_num = 1
2600	ELSEIF ( depo_surf_par == 'petroff2010' ) THEN
2601	depo_surf_par_num = 2
2602	ENDIF
2603	!
2604	!-- LSM: Pavement, vegetation and water
2605	IF ( nldepo_surf .AND. land_surface ) THEN
2606	match_lsm = .TRUE.
2607	ALLOCATE( lsm_to_depo_h%match_lupg(1:surf_lsm_h%ns), &
2608	lsm_to_depo_h%match_luvw(1:surf_lsm_h%ns), &
2609	lsm_to_depo_h%match_luww(1:surf_lsm_h%ns) )
2610	lsm_to_depo_h%match_lupg = 0
2611	lsm_to_depo_h%match_luvw = 0
2612	lsm_to_depo_h%match_luww = 0
2613	CALL match_sm_zhang( surf_lsm_h, lsm_to_depo_h%match_lupg, lsm_to_depo_h%match_luvw, &
2614	lsm_to_depo_h%match_luww, match_lsm )
2615	DO l = 0, 3
2616	ALLOCATE( lsm_to_depo_v(l)%match_lupg(1:surf_lsm_v(l)%ns), &
2617	lsm_to_depo_v(l)%match_luvw(1:surf_lsm_v(l)%ns), &
2618	lsm_to_depo_v(l)%match_luww(1:surf_lsm_v(l)%ns) )
2619	lsm_to_depo_v(l)%match_lupg = 0
2620	lsm_to_depo_v(l)%match_luvw = 0
2621	lsm_to_depo_v(l)%match_luww = 0
2622	CALL match_sm_zhang( surf_lsm_v(l), lsm_to_depo_v(l)%match_lupg, &
2623	lsm_to_depo_v(l)%match_luvw, lsm_to_depo_v(l)%match_luww, match_lsm )
2624	ENDDO
2625	ENDIF
2626	!
2627	!-- USM: Green roofs/walls, wall surfaces and windows
2628	IF ( nldepo_surf .AND. urban_surface ) THEN
2629	match_lsm = .FALSE.
2630	ALLOCATE( usm_to_depo_h%match_lupg(1:surf_usm_h%ns), &
2631	usm_to_depo_h%match_luvw(1:surf_usm_h%ns), &
2632	usm_to_depo_h%match_luww(1:surf_usm_h%ns) )
2633	usm_to_depo_h%match_lupg = 0
2634	usm_to_depo_h%match_luvw = 0
2635	usm_to_depo_h%match_luww = 0
2636	CALL match_sm_zhang( surf_usm_h, usm_to_depo_h%match_lupg, usm_to_depo_h%match_luvw, &
2637	usm_to_depo_h%match_luww, match_lsm )
2638	DO l = 0, 3
2639	ALLOCATE( usm_to_depo_v(l)%match_lupg(1:surf_usm_v(l)%ns), &
2640	usm_to_depo_v(l)%match_luvw(1:surf_usm_v(l)%ns), &
2641	usm_to_depo_v(l)%match_luww(1:surf_usm_v(l)%ns) )
2642	usm_to_depo_v(l)%match_lupg = 0
2643	usm_to_depo_v(l)%match_luvw = 0
2644	usm_to_depo_v(l)%match_luww = 0
2645	CALL match_sm_zhang( surf_usm_v(l), usm_to_depo_v(l)%match_lupg, &
2646	usm_to_depo_v(l)%match_luvw, usm_to_depo_v(l)%match_luww, match_lsm )
2647	ENDDO
2648	ENDIF
2649
2650	IF ( nldepo_pcm ) THEN
2651	SELECT CASE ( depo_pcm_type )
2652	CASE ( 'evergreen_needleleaf' )
2653	depo_pcm_type_num = 1
2654	CASE ( 'evergreen_broadleaf' )
2655	depo_pcm_type_num = 2
2656	CASE ( 'deciduous_needleleaf' )
2657	depo_pcm_type_num = 3
2658	CASE ( 'deciduous_broadleaf' )
2659	depo_pcm_type_num = 4
2660	CASE DEFAULT
2661	message_string = 'depo_pcm_type not set correctly.'
2662	CALL message( 'salsa_mod: init_deposition', 'PA0613', 1, 2, 0, 6, 0 )
2663	END SELECT
2664	ENDIF
2665
2666	END SUBROUTINE init_deposition
2667
2668	!------------------------------------------------------------------------------!
2669	! Description:
2670	! ------------
2671	!> Match the surface types in PALM and Zhang et al. 2001 deposition module
2672	!------------------------------------------------------------------------------!
2673	SUBROUTINE match_sm_zhang( surf, match_pav_green, match_veg_wall, match_wat_win, match_lsm )
2674
2675	USE surface_mod, &
2676	ONLY: ind_pav_green, ind_veg_wall, ind_wat_win, surf_type
2677
2678	IMPLICIT NONE
2679
2680	INTEGER(iwp) :: m !< index for surface elements
2681	INTEGER(iwp) :: pav_type_palm !< pavement / green wall type in PALM
2682	INTEGER(iwp) :: veg_type_palm !< vegetation / wall type in PALM
2683	INTEGER(iwp) :: wat_type_palm !< water / window type in PALM
2684
2685	INTEGER(iwp), DIMENSION(:), INTENT(inout) :: match_pav_green !< matching pavement/green walls
2686	INTEGER(iwp), DIMENSION(:), INTENT(inout) :: match_veg_wall !< matching vegetation/walls
2687	INTEGER(iwp), DIMENSION(:), INTENT(inout) :: match_wat_win !< matching water/windows
2688
2689	LOGICAL, INTENT(in) :: match_lsm !< flag to initilise LSM surfaces (if false, initialise USM)
2690
2691	TYPE(surf_type), INTENT(in) :: surf !< respective surface type
2692
2693	DO m = 1, surf%ns
2694	IF ( match_lsm ) THEN
2695	!
2696	!-- Vegetation (LSM):
2697	IF ( surf%frac(ind_veg_wall,m) > 0 ) THEN
2698	veg_type_palm = surf%vegetation_type(m)
2699	SELECT CASE ( veg_type_palm )
2700	CASE ( 0 )
2701	message_string = 'No vegetation type defined.'
2702	CALL message( 'salsa_mod: init_depo_surfaces', 'PA0614', 1, 2, 0, 6, 0 )
2703	CASE ( 1 ) ! bare soil
2704	match_veg_wall(m) = 6 ! grass in Z01
2705	CASE ( 2 ) ! crops, mixed farming
2706	match_veg_wall(m) = 7 ! crops, mixed farming Z01
2707	CASE ( 3 ) ! short grass
2708	match_veg_wall(m) = 6 ! grass in Z01
2709	CASE ( 4 ) ! evergreen needleleaf trees
2710	match_veg_wall(m) = 1 ! evergreen needleleaf trees in Z01
2711	CASE ( 5 ) ! deciduous needleleaf trees
2712	match_veg_wall(m) = 3 ! deciduous needleleaf trees in Z01
2713	CASE ( 6 ) ! evergreen broadleaf trees
2714	match_veg_wall(m) = 2 ! evergreen broadleaf trees in Z01
2715	CASE ( 7 ) ! deciduous broadleaf trees
2716	match_veg_wall(m) = 4 ! deciduous broadleaf trees in Z01
2717	CASE ( 8 ) ! tall grass
2718	match_veg_wall(m) = 6 ! grass in Z01
2719	CASE ( 9 ) ! desert
2720	match_veg_wall(m) = 8 ! desert in Z01
2721	CASE ( 10 ) ! tundra
2722	match_veg_wall(m) = 9 ! tundra in Z01
2723	CASE ( 11 ) ! irrigated crops
2724	match_veg_wall(m) = 7 ! crops, mixed farming Z01
2725	CASE ( 12 ) ! semidesert
2726	match_veg_wall(m) = 8 ! desert in Z01
2727	CASE ( 13 ) ! ice caps and glaciers
2728	match_veg_wall(m) = 12 ! ice cap and glacier in Z01
2729	CASE ( 14 ) ! bogs and marshes
2730	match_veg_wall(m) = 11 ! wetland with plants in Z01
2731	CASE ( 15 ) ! evergreen shrubs
2732	match_veg_wall(m) = 10 ! shrubs and interrupted woodlands in Z01
2733	CASE ( 16 ) ! deciduous shrubs
2734	match_veg_wall(m) = 10 ! shrubs and interrupted woodlands in Z01
2735	CASE ( 17 ) ! mixed forest/woodland
2736	match_veg_wall(m) = 5 ! mixed broadleaf and needleleaf trees in Z01
2737	CASE ( 18 ) ! interrupted forest
2738	match_veg_wall(m) = 10 ! shrubs and interrupted woodlands in Z01
2739	END SELECT
2740	ENDIF
2741	!
2742	!-- Pavement (LSM):
2743	IF ( surf%frac(ind_pav_green,m) > 0 ) THEN
2744	pav_type_palm = surf%pavement_type(m)
2745	IF ( pav_type_palm == 0 ) THEN ! error
2746	message_string = 'No pavement type defined.'
2747	CALL message( 'salsa_mod: match_sm_zhang', 'PA0615', 1, 2, 0, 6, 0 )
2748	ELSE
2749	match_pav_green(m) = 15 ! urban in Z01
2750	ENDIF
2751	ENDIF
2752	!
2753	!-- Water (LSM):
2754	IF ( surf%frac(ind_wat_win,m) > 0 ) THEN
2755	wat_type_palm = surf%water_type(m)
2756	IF ( wat_type_palm == 0 ) THEN ! error
2757	message_string = 'No water type defined.'
2758	CALL message( 'salsa_mod: match_sm_zhang', 'PA0616', 1, 2, 0, 6, 0 )
2759	ELSEIF ( wat_type_palm == 3 ) THEN
2760	match_wat_win(m) = 14 ! ocean in Z01
2761	ELSEIF ( wat_type_palm == 1 .OR. wat_type_palm == 2 .OR. wat_type_palm == 4 &
2762	.OR. wat_type_palm == 5 ) THEN
2763	match_wat_win(m) = 13 ! inland water in Z01
2764	ENDIF
2765	ENDIF
2766	ELSE
2767	!
2768	!-- Wall surfaces (USM):
2769	IF ( surf%frac(ind_veg_wall,m) > 0 ) THEN
2770	match_veg_wall(m) = 15 ! urban in Z01
2771	ENDIF
2772	!
2773	!-- Green walls and roofs (USM):
2774	IF ( surf%frac(ind_pav_green,m) > 0 ) THEN
2775	match_pav_green(m) = 6 ! (short) grass in Z01
2776	ENDIF
2777	!
2778	!-- Windows (USM):
2779	IF ( surf%frac(ind_wat_win,m) > 0 ) THEN
2780	match_wat_win(m) = 15 ! urban in Z01
2781	ENDIF
2782	ENDIF
2783
2784	ENDDO
2785
2786	END SUBROUTINE match_sm_zhang
2787
2788	!------------------------------------------------------------------------------!
2789	! Description:
2790	! ------------
2791	!> Swapping of timelevels
2792	!------------------------------------------------------------------------------!
2793	SUBROUTINE salsa_swap_timelevel( mod_count )
2794
2795	IMPLICIT NONE
2796
2797	INTEGER(iwp) :: ib !<
2798	INTEGER(iwp) :: ic !<
2799	INTEGER(iwp) :: icc !<
2800	INTEGER(iwp) :: ig !<
2801
2802	INTEGER(iwp), INTENT(IN) :: mod_count !<
2803
2804	IF ( time_since_reference_point >= skip_time_do_salsa ) THEN
2805
2806	SELECT CASE ( mod_count )
2807
2808	CASE ( 0 )
2809
2810	DO ib = 1, nbins_aerosol
2811	aerosol_number(ib)%conc(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => nconc_1(:,:,:,ib)
2812	aerosol_number(ib)%conc_p(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => nconc_2(:,:,:,ib)
2813
2814	DO ic = 1, ncomponents_mass
2815	icc = ( ic-1 ) * nbins_aerosol + ib
2816	aerosol_mass(icc)%conc(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => mconc_1(:,:,:,icc)
2817	aerosol_mass(icc)%conc_p(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => mconc_2(:,:,:,icc)
2818	ENDDO
2819	ENDDO
2820
2821	IF ( .NOT. salsa_gases_from_chem ) THEN
2822	DO ig = 1, ngases_salsa
2823	salsa_gas(ig)%conc(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => gconc_1(:,:,:,ig)
2824	salsa_gas(ig)%conc_p(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => gconc_2(:,:,:,ig)
2825	ENDDO
2826	ENDIF
2827
2828	CASE ( 1 )
2829
2830	DO ib = 1, nbins_aerosol
2831	aerosol_number(ib)%conc(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => nconc_2(:,:,:,ib)
2832	aerosol_number(ib)%conc_p(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => nconc_1(:,:,:,ib)
2833	DO ic = 1, ncomponents_mass
2834	icc = ( ic-1 ) * nbins_aerosol + ib
2835	aerosol_mass(icc)%conc(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => mconc_2(:,:,:,icc)
2836	aerosol_mass(icc)%conc_p(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => mconc_1(:,:,:,icc)
2837	ENDDO
2838	ENDDO
2839
2840	IF ( .NOT. salsa_gases_from_chem ) THEN
2841	DO ig = 1, ngases_salsa
2842	salsa_gas(ig)%conc(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => gconc_2(:,:,:,ig)
2843	salsa_gas(ig)%conc_p(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => gconc_1(:,:,:,ig)
2844	ENDDO
2845	ENDIF
2846
2847	END SELECT
2848
2849	ENDIF
2850
2851	END SUBROUTINE salsa_swap_timelevel
2852
2853
2854	!------------------------------------------------------------------------------!
2855	! Description:
2856	! ------------
2857	!> This routine reads the respective restart data.
2858	!------------------------------------------------------------------------------!
2859	SUBROUTINE salsa_rrd_local( k, nxlf, nxlc, nxl_on_file, nxrf, nxrc, nxr_on_file, nynf, nync, &
2860	nyn_on_file, nysf, nysc, nys_on_file, tmp_3d, found )
2861
2862	USE control_parameters, &
2863	ONLY: length, restart_string
2864
2865	IMPLICIT NONE
2866
2867	INTEGER(iwp) :: ib !<
2868	INTEGER(iwp) :: ic !<
2869	INTEGER(iwp) :: ig !<
2870	INTEGER(iwp) :: k !<
2871	INTEGER(iwp) :: nxlc !<
2872	INTEGER(iwp) :: nxlf !<
2873	INTEGER(iwp) :: nxl_on_file !<
2874	INTEGER(iwp) :: nxrc !<
2875	INTEGER(iwp) :: nxrf !<
2876	INTEGER(iwp) :: nxr_on_file !<
2877	INTEGER(iwp) :: nync !<
2878	INTEGER(iwp) :: nynf !<
2879	INTEGER(iwp) :: nyn_on_file !<
2880	INTEGER(iwp) :: nysc !<
2881	INTEGER(iwp) :: nysf !<
2882	INTEGER(iwp) :: nys_on_file !<
2883
2884	LOGICAL, INTENT(OUT) :: found !<
2885
2886	REAL(wp), &
2887	DIMENSION(nzb:nzt+1,nys_on_file-nbgp:nyn_on_file+nbgp,nxl_on_file-nbgp:nxr_on_file+nbgp) :: tmp_3d !<
2888
2889	found = .FALSE.
2890
2891	IF ( read_restart_data_salsa ) THEN
2892
2893	SELECT CASE ( restart_string(1:length) )
2894
2895	CASE ( 'aerosol_number' )
2896	DO ib = 1, nbins_aerosol
2897	IF ( k == 1 ) READ ( 13 ) tmp_3d
2898	aerosol_number(ib)%conc(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) = &
2899	tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
2900	found = .TRUE.
2901	ENDDO
2902
2903	CASE ( 'aerosol_mass' )
2904	DO ic = 1, ncomponents_mass * nbins_aerosol
2905	IF ( k == 1 ) READ ( 13 ) tmp_3d
2906	aerosol_mass(ic)%conc(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) = &
2907	tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
2908	found = .TRUE.
2909	ENDDO
2910
2911	CASE ( 'salsa_gas' )
2912	DO ig = 1, ngases_salsa
2913	IF ( k == 1 ) READ ( 13 ) tmp_3d
2914	salsa_gas(ig)%conc(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) = &
2915	tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
2916	found = .TRUE.
2917	ENDDO
2918
2919	CASE DEFAULT
2920	found = .FALSE.
2921
2922	END SELECT
2923	ENDIF
2924
2925	END SUBROUTINE salsa_rrd_local
2926
2927	!------------------------------------------------------------------------------!
2928	! Description:
2929	! ------------
2930	!> This routine writes the respective restart data.
2931	!> Note that the following input variables in PARIN have to be equal between
2932	!> restart runs:
2933	!> listspec, nbin, nbin2, nf2a, ncc, mass_fracs_a, mass_fracs_b
2934	!------------------------------------------------------------------------------!
2935	SUBROUTINE salsa_wrd_local
2936
2937	USE control_parameters, &
2938	ONLY: write_binary
2939
2940	IMPLICIT NONE
2941
2942	INTEGER(iwp) :: ib !<
2943	INTEGER(iwp) :: ic !<
2944	INTEGER(iwp) :: ig !<
2945
2946	IF ( write_binary .AND. write_binary_salsa ) THEN
2947
2948	CALL wrd_write_string( 'aerosol_number' )
2949	DO ib = 1, nbins_aerosol
2950	WRITE ( 14 ) aerosol_number(ib)%conc
2951	ENDDO
2952
2953	CALL wrd_write_string( 'aerosol_mass' )
2954	DO ic = 1, nbins_aerosol * ncomponents_mass
2955	WRITE ( 14 ) aerosol_mass(ic)%conc
2956	ENDDO
2957
2958	CALL wrd_write_string( 'salsa_gas' )
2959	DO ig = 1, ngases_salsa
2960	WRITE ( 14 ) salsa_gas(ig)%conc
2961	ENDDO
2962
2963	ENDIF
2964
2965	END SUBROUTINE salsa_wrd_local
2966
2967	!------------------------------------------------------------------------------!
2968	! Description:
2969	! ------------
2970	!> Performs necessary unit and dimension conversion between the host model and
2971	!> SALSA module, and calls the main SALSA routine.
2972	!> Partially adobted form the original SALSA boxmodel version.
2973	!> Now takes masses in as kg/kg from LES!! Converted to m3/m3 for SALSA
2974	!> 05/2016 Juha: This routine is still pretty much in its original shape.
2975	!> It's dumb as a mule and twice as ugly, so implementation of
2976	!> an improved solution is necessary sooner or later.
2977	!> Juha Tonttila, FMI, 2014
2978	!> Jaakko Ahola, FMI, 2016
2979	!> Only aerosol processes included, Mona Kurppa, UHel, 2017
2980	!------------------------------------------------------------------------------!
2981	SUBROUTINE salsa_driver( i, j, prunmode )
2982
2983	USE arrays_3d, &
2984	ONLY: pt_p, q_p, u, v, w
2985
2986	USE plant_canopy_model_mod, &
2987	ONLY: lad_s
2988
2989	USE surface_mod, &
2990	ONLY: surf_def_h, surf_def_v, surf_lsm_h, surf_lsm_v, surf_usm_h, surf_usm_v
2991
2992	IMPLICIT NONE
2993
2994	INTEGER(iwp) :: endi !< end index
2995	INTEGER(iwp) :: ib !< loop index
2996	INTEGER(iwp) :: ic !< loop index
2997	INTEGER(iwp) :: ig !< loop index
2998	INTEGER(iwp) :: k_wall !< vertical index of topography top
2999	INTEGER(iwp) :: k !< loop index
3000	INTEGER(iwp) :: l !< loop index
3001	INTEGER(iwp) :: nc_h2o !< index of H2O in the prtcl index table
3002	INTEGER(iwp) :: ss !< loop index
3003	INTEGER(iwp) :: str !< start index
3004	INTEGER(iwp) :: vc !< default index in prtcl
3005
3006	INTEGER(iwp), INTENT(in) :: i !< loop index
3007	INTEGER(iwp), INTENT(in) :: j !< loop index
3008	INTEGER(iwp), INTENT(in) :: prunmode !< 1: Initialization, 2: Spinup, 3: Regular runtime
3009
3010	REAL(wp) :: cw_old !< previous H2O mixing ratio
3011	REAL(wp) :: flag !< flag to mask topography grid points
3012	REAL(wp) :: in_lad !< leaf area density (m2/m3)
3013	REAL(wp) :: in_rh !< relative humidity
3014	REAL(wp) :: zgso4 !< SO4
3015	REAL(wp) :: zghno3 !< HNO3
3016	REAL(wp) :: zgnh3 !< NH3
3017	REAL(wp) :: zgocnv !< non-volatile OC
3018	REAL(wp) :: zgocsv !< semi-volatile OC
3019
3020	REAL(wp), DIMENSION(nzb:nzt+1) :: in_adn !< air density (kg/m3)
3021	REAL(wp), DIMENSION(nzb:nzt+1) :: in_cs !< H2O sat. vapour conc.
3022	REAL(wp), DIMENSION(nzb:nzt+1) :: in_cw !< H2O vapour concentration
3023	REAL(wp), DIMENSION(nzb:nzt+1) :: in_p !< pressure (Pa)
3024	REAL(wp), DIMENSION(nzb:nzt+1) :: in_t !< temperature (K)
3025	REAL(wp), DIMENSION(nzb:nzt+1) :: in_u !< wind magnitude (m/s)
3026	REAL(wp), DIMENSION(nzb:nzt+1) :: kvis !< kinematic viscosity of air(m2/s)
3027	REAL(wp), DIMENSION(nzb:nzt+1) :: ppm_to_nconc !< Conversion factor from ppm to #/m3
3028
3029	REAL(wp), DIMENSION(nzb:nzt+1,nbins_aerosol) :: schmidt_num !< particle Schmidt number
3030	REAL(wp), DIMENSION(nzb:nzt+1,nbins_aerosol) :: vd !< particle fall seed (m/s)
3031
3032	TYPE(t_section), DIMENSION(nbins_aerosol) :: lo_aero !< additional variable for OpenMP
3033	TYPE(t_section), DIMENSION(nbins_aerosol) :: aero_old !< helper array
3034
3035	aero_old(:)%numc = 0.0_wp
3036	in_lad = 0.0_wp
3037	in_u = 0.0_wp
3038	kvis = 0.0_wp
3039	lo_aero = aero
3040	schmidt_num = 0.0_wp
3041	vd = 0.0_wp
3042	zgso4 = nclim
3043	zghno3 = nclim
3044	zgnh3 = nclim
3045	zgocnv = nclim
3046	zgocsv = nclim
3047	!
3048	!-- Aerosol number is always set, but mass can be uninitialized
3049	DO ib = 1, nbins_aerosol
3050	lo_aero(ib)%volc(:) = 0.0_wp
3051	aero_old(ib)%volc(:) = 0.0_wp
3052	ENDDO
3053	!
3054	!-- Set the salsa runtime config (How to make this more efficient?)
3055	CALL set_salsa_runtime( prunmode )
3056	!
3057	!-- Calculate thermodynamic quantities needed in SALSA
3058	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 )
3059	!
3060	!-- Magnitude of wind: needed for deposition
3061	IF ( lsdepo ) THEN
3062	in_u(nzb+1:nzt) = SQRT( ( 0.5_wp * ( u(nzb+1:nzt,j,i) + u(nzb+1:nzt,j,i+1) ) )**2 + &
3063	( 0.5_wp * ( v(nzb+1:nzt,j,i) + v(nzb+1:nzt,j+1,i) ) )**2 + &
3064	( 0.5_wp * ( w(nzb:nzt-1,j,i) + w(nzb+1:nzt,j, i) ) )**2 )
3065	ENDIF
3066	!
3067	!-- Calculate conversion factors for gas concentrations
3068	ppm_to_nconc(:) = for_ppm_to_nconc * in_p(:) / in_t(:)
3069	!
3070	!-- Determine topography-top index on scalar grid
3071	k_wall = k_topo_top(j,i)
3072
3073	DO k = nzb+1, nzt
3074	!
3075	!-- Predetermine flag to mask topography
3076	flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) )
3077	!
3078	!-- Wind velocity for dry depositon on vegetation
3079	IF ( lsdepo_pcm .AND. plant_canopy ) THEN
3080	in_lad = lad_s( MAX( k-k_wall,0 ),j,i)
3081	ENDIF
3082	!
3083	!-- For initialization and spinup, limit the RH with the parameter rhlim
3084	IF ( prunmode < 3 ) THEN
3085	in_cw(k) = MIN( in_cw(k), in_cs(k) * rhlim )
3086	ELSE
3087	in_cw(k) = in_cw(k)
3088	ENDIF
3089	cw_old = in_cw(k) !* in_adn(k)
3090	!
3091	!-- Set volume concentrations:
3092	!-- Sulphate (SO4) or sulphuric acid H2SO4
3093	IF ( index_so4 > 0 ) THEN
3094	vc = 1
3095	str = ( index_so4-1 ) * nbins_aerosol + 1 ! start index
3096	endi = index_so4 * nbins_aerosol ! end index
3097	ic = 1
3098	DO ss = str, endi
3099	lo_aero(ic)%volc(vc) = aerosol_mass(ss)%conc(k,j,i) / arhoh2so4
3100	ic = ic+1
3101	ENDDO
3102	aero_old(1:nbins_aerosol)%volc(vc) = lo_aero(1:nbins_aerosol)%volc(vc)
3103	ENDIF
3104	!
3105	!-- Organic carbon (OC) compounds
3106	IF ( index_oc > 0 ) THEN
3107	vc = 2
3108	str = ( index_oc-1 ) * nbins_aerosol + 1
3109	endi = index_oc * nbins_aerosol
3110	ic = 1
3111	DO ss = str, endi
3112	lo_aero(ic)%volc(vc) = aerosol_mass(ss)%conc(k,j,i) / arhooc
3113	ic = ic+1
3114	ENDDO
3115	aero_old(1:nbins_aerosol)%volc(vc) = lo_aero(1:nbins_aerosol)%volc(vc)
3116	ENDIF
3117	!
3118	!-- Black carbon (BC)
3119	IF ( index_bc > 0 ) THEN
3120	vc = 3
3121	str = ( index_bc-1 ) * nbins_aerosol + 1 + end_subrange_1a
3122	endi = index_bc * nbins_aerosol
3123	ic = 1 + end_subrange_1a
3124	DO ss = str, endi
3125	lo_aero(ic)%volc(vc) = aerosol_mass(ss)%conc(k,j,i) / arhobc
3126	ic = ic+1
3127	ENDDO
3128	aero_old(1:nbins_aerosol)%volc(vc) = lo_aero(1:nbins_aerosol)%volc(vc)
3129	ENDIF
3130	!
3131	!-- Dust (DU)
3132	IF ( index_du > 0 ) THEN
3133	vc = 4
3134	str = ( index_du-1 ) * nbins_aerosol + 1 + end_subrange_1a
3135	endi = index_du * nbins_aerosol
3136	ic = 1 + end_subrange_1a
3137	DO ss = str, endi
3138	lo_aero(ic)%volc(vc) = aerosol_mass(ss)%conc(k,j,i) / arhodu
3139	ic = ic+1
3140	ENDDO
3141	aero_old(1:nbins_aerosol)%volc(vc) = lo_aero(1:nbins_aerosol)%volc(vc)
3142	ENDIF
3143	!
3144	!-- Sea salt (SS)
3145	IF ( index_ss > 0 ) THEN
3146	vc = 5
3147	str = ( index_ss-1 ) * nbins_aerosol + 1 + end_subrange_1a
3148	endi = index_ss * nbins_aerosol
3149	ic = 1 + end_subrange_1a
3150	DO ss = str, endi
3151	lo_aero(ic)%volc(vc) = aerosol_mass(ss)%conc(k,j,i) / arhoss
3152	ic = ic+1
3153	ENDDO
3154	aero_old(1:nbins_aerosol)%volc(vc) = lo_aero(1:nbins_aerosol)%volc(vc)
3155	ENDIF
3156	!
3157	!-- Nitrate (NO(3-)) or nitric acid HNO3
3158	IF ( index_no > 0 ) THEN
3159	vc = 6
3160	str = ( index_no-1 ) * nbins_aerosol + 1
3161	endi = index_no * nbins_aerosol
3162	ic = 1
3163	DO ss = str, endi
3164	lo_aero(ic)%volc(vc) = aerosol_mass(ss)%conc(k,j,i) / arhohno3
3165	ic = ic+1
3166	ENDDO
3167	aero_old(1:nbins_aerosol)%volc(vc) = lo_aero(1:nbins_aerosol)%volc(vc)
3168	ENDIF
3169	!
3170	!-- Ammonium (NH(4+)) or ammonia NH3
3171	IF ( index_nh > 0 ) THEN
3172	vc = 7
3173	str = ( index_nh-1 ) * nbins_aerosol + 1
3174	endi = index_nh * nbins_aerosol
3175	ic = 1
3176	DO ss = str, endi
3177	lo_aero(ic)%volc(vc) = aerosol_mass(ss)%conc(k,j,i) / arhonh3
3178	ic = ic+1
3179	ENDDO
3180	aero_old(1:nbins_aerosol)%volc(vc) = lo_aero(1:nbins_aerosol)%volc(vc)
3181	ENDIF
3182	!
3183	!-- Water (always used)
3184	nc_h2o = get_index( prtcl,'H2O' )
3185	vc = 8
3186	str = ( nc_h2o-1 ) * nbins_aerosol + 1
3187	endi = nc_h2o * nbins_aerosol
3188	ic = 1
3189	IF ( advect_particle_water ) THEN
3190	DO ss = str, endi
3191	lo_aero(ic)%volc(vc) = aerosol_mass(ss)%conc(k,j,i) / arhoh2o
3192	ic = ic+1
3193	ENDDO
3194	ELSE
3195	lo_aero(1:nbins_aerosol)%volc(vc) = mclim
3196	ENDIF
3197	aero_old(1:nbins_aerosol)%volc(vc) = lo_aero(1:nbins_aerosol)%volc(vc)
3198	!
3199	!-- Number concentrations (numc) and particle sizes
3200	!-- (dwet = wet diameter, core = dry volume)
3201	DO ib = 1, nbins_aerosol
3202	lo_aero(ib)%numc = aerosol_number(ib)%conc(k,j,i)
3203	aero_old(ib)%numc = lo_aero(ib)%numc
3204	IF ( lo_aero(ib)%numc > nclim ) THEN
3205	lo_aero(ib)%dwet = ( SUM( lo_aero(ib)%volc(:) ) / lo_aero(ib)%numc / api6 )**0.33333333_wp
3206	lo_aero(ib)%core = SUM( lo_aero(ib)%volc(1:7) ) / lo_aero(ib)%numc
3207	ELSE
3208	lo_aero(ib)%dwet = lo_aero(ib)%dmid
3209	lo_aero(ib)%core = api6 * ( lo_aero(ib)%dwet )**3
3210	ENDIF
3211	ENDDO
3212	!
3213	!-- Calculate the ambient sizes of particles by equilibrating soluble fraction of particles with
3214	!-- water using the ZSR method.
3215	in_rh = in_cw(k) / in_cs(k)
3216	IF ( prunmode==1 .OR. .NOT. advect_particle_water ) THEN
3217	CALL equilibration( in_rh, in_t(k), lo_aero, .TRUE. )
3218	ENDIF
3219	!
3220	!-- Gaseous tracer concentrations in #/m3
3221	IF ( salsa_gases_from_chem ) THEN
3222	!
3223	!-- Convert concentrations in ppm to #/m3
3224	zgso4 = chem_species(gas_index_chem(1))%conc(k,j,i) * ppm_to_nconc(k)
3225	zghno3 = chem_species(gas_index_chem(2))%conc(k,j,i) * ppm_to_nconc(k)
3226	zgnh3 = chem_species(gas_index_chem(3))%conc(k,j,i) * ppm_to_nconc(k)
3227	zgocnv = chem_species(gas_index_chem(4))%conc(k,j,i) * ppm_to_nconc(k)
3228	zgocsv = chem_species(gas_index_chem(5))%conc(k,j,i) * ppm_to_nconc(k)
3229	ELSE
3230	zgso4 = salsa_gas(1)%conc(k,j,i)
3231	zghno3 = salsa_gas(2)%conc(k,j,i)
3232	zgnh3 = salsa_gas(3)%conc(k,j,i)
3233	zgocnv = salsa_gas(4)%conc(k,j,i)
3234	zgocsv = salsa_gas(5)%conc(k,j,i)
3235	ENDIF
3236	!
3237	!-- Calculate aerosol processes:
3238	!-- *********************************************************************************************
3239	!
3240	!-- Coagulation
3241	IF ( lscoag ) THEN
3242	CALL coagulation( lo_aero, dt_salsa, in_t(k), in_p(k) )
3243	ENDIF
3244	!
3245	!-- Condensation
3246	IF ( lscnd ) THEN
3247	CALL condensation( lo_aero, zgso4, zgocnv, zgocsv, zghno3, zgnh3, in_cw(k), in_cs(k), &
3248	in_t(k), in_p(k), dt_salsa, prtcl )
3249	ENDIF
3250	!
3251	!-- Deposition
3252	IF ( lsdepo ) THEN
3253	CALL deposition( lo_aero, in_t(k), in_adn(k), in_u(k), in_lad, kvis(k), schmidt_num(k,:),&
3254	vd(k,:) )
3255	ENDIF
3256	!
3257	!-- Size distribution bin update
3258	IF ( lsdistupdate ) THEN
3259	CALL distr_update( lo_aero )
3260	ENDIF
3261	!-- *********************************************************************************************
3262
3263	IF ( lsdepo ) sedim_vd(k,j,i,:) = vd(k,:)
3264	!
3265	!-- Calculate changes in concentrations
3266	DO ib = 1, nbins_aerosol
3267	aerosol_number(ib)%conc(k,j,i) = aerosol_number(ib)%conc(k,j,i) + ( lo_aero(ib)%numc - &
3268	aero_old(ib)%numc ) * flag
3269	ENDDO
3270
3271	IF ( index_so4 > 0 ) THEN
3272	vc = 1
3273	str = ( index_so4-1 ) * nbins_aerosol + 1
3274	endi = index_so4 * nbins_aerosol
3275	ic = 1
3276	DO ss = str, endi
3277	aerosol_mass(ss)%conc(k,j,i) = aerosol_mass(ss)%conc(k,j,i) + ( lo_aero(ic)%volc(vc) -&
3278	aero_old(ic)%volc(vc) ) * arhoh2so4 * flag
3279	ic = ic+1
3280	ENDDO
3281	ENDIF
3282
3283	IF ( index_oc > 0 ) THEN
3284	vc = 2
3285	str = ( index_oc-1 ) * nbins_aerosol + 1
3286	endi = index_oc * nbins_aerosol
3287	ic = 1
3288	DO ss = str, endi
3289	aerosol_mass(ss)%conc(k,j,i) = aerosol_mass(ss)%conc(k,j,i) + ( lo_aero(ic)%volc(vc) -&
3290	aero_old(ic)%volc(vc) ) * arhooc * flag
3291	ic = ic+1
3292	ENDDO
3293	ENDIF
3294
3295	IF ( index_bc > 0 ) THEN
3296	vc = 3
3297	str = ( index_bc-1 ) * nbins_aerosol + 1 + end_subrange_1a
3298	endi = index_bc * nbins_aerosol
3299	ic = 1 + end_subrange_1a
3300	DO ss = str, endi
3301	aerosol_mass(ss)%conc(k,j,i) = aerosol_mass(ss)%conc(k,j,i) + ( lo_aero(ic)%volc(vc) -&
3302	aero_old(ic)%volc(vc) ) * arhobc * flag
3303	ic = ic+1
3304	ENDDO
3305	ENDIF
3306
3307	IF ( index_du > 0 ) THEN
3308	vc = 4
3309	str = ( index_du-1 ) * nbins_aerosol + 1 + end_subrange_1a
3310	endi = index_du * nbins_aerosol
3311	ic = 1 + end_subrange_1a
3312	DO ss = str, endi
3313	aerosol_mass(ss)%conc(k,j,i) = aerosol_mass(ss)%conc(k,j,i) + ( lo_aero(ic)%volc(vc) -&
3314	aero_old(ic)%volc(vc) ) * arhodu * flag
3315	ic = ic+1
3316	ENDDO
3317	ENDIF
3318
3319	IF ( index_ss > 0 ) THEN
3320	vc = 5
3321	str = ( index_ss-1 ) * nbins_aerosol + 1 + end_subrange_1a
3322	endi = index_ss * nbins_aerosol
3323	ic = 1 + end_subrange_1a
3324	DO ss = str, endi
3325	aerosol_mass(ss)%conc(k,j,i) = aerosol_mass(ss)%conc(k,j,i) + ( lo_aero(ic)%volc(vc) -&
3326	aero_old(ic)%volc(vc) ) * arhoss * flag
3327	ic = ic+1
3328	ENDDO
3329	ENDIF
3330
3331	IF ( index_no > 0 ) THEN
3332	vc = 6
3333	str = ( index_no-1 ) * nbins_aerosol + 1
3334	endi = index_no * nbins_aerosol
3335	ic = 1
3336	DO ss = str, endi
3337	aerosol_mass(ss)%conc(k,j,i) = aerosol_mass(ss)%conc(k,j,i) + ( lo_aero(ic)%volc(vc) -&
3338	aero_old(ic)%volc(vc) ) * arhohno3 * flag
3339	ic = ic+1
3340	ENDDO
3341	ENDIF
3342
3343	IF ( index_nh > 0 ) THEN
3344	vc = 7
3345	str = ( index_nh-1 ) * nbins_aerosol + 1
3346	endi = index_nh * nbins_aerosol
3347	ic = 1
3348	DO ss = str, endi
3349	aerosol_mass(ss)%conc(k,j,i) = aerosol_mass(ss)%conc(k,j,i) + ( lo_aero(ic)%volc(vc) -&
3350	aero_old(ic)%volc(vc) ) * arhonh3 * flag
3351	ic = ic+1
3352	ENDDO
3353	ENDIF
3354
3355	IF ( advect_particle_water ) THEN
3356	nc_h2o = get_index( prtcl,'H2O' )
3357	vc = 8
3358	str = ( nc_h2o-1 ) * nbins_aerosol + 1
3359	endi = nc_h2o * nbins_aerosol
3360	ic = 1
3361	DO ss = str, endi
3362	aerosol_mass(ss)%conc(k,j,i) = aerosol_mass(ss)%conc(k,j,i) + ( lo_aero(ic)%volc(vc) -&
3363	aero_old(ic)%volc(vc) ) * arhoh2o * flag
3364	ic = ic+1
3365	ENDDO
3366	ENDIF
3367	IF ( prunmode == 1 ) THEN
3368	nc_h2o = get_index( prtcl,'H2O' )
3369	vc = 8
3370	str = ( nc_h2o-1 ) * nbins_aerosol + 1
3371	endi = nc_h2o * nbins_aerosol
3372	ic = 1
3373	DO ss = str, endi
3374	aerosol_mass(ss)%init(k) = MAX( aerosol_mass(ss)%init(k), ( lo_aero(ic)%volc(vc) - &
3375	aero_old(ic)%volc(vc) ) * arhoh2o )
3376	IF ( k == nzb+1 ) THEN
3377	aerosol_mass(ss)%init(k-1) = aerosol_mass(ss)%init(k)
3378	ELSEIF ( k == nzt ) THEN
3379	aerosol_mass(ss)%init(k+1) = aerosol_mass(ss)%init(k)
3380	aerosol_mass(ss)%conc(k+1,j,i) = aerosol_mass(ss)%init(k)
3381	ENDIF
3382	ic = ic+1
3383	ENDDO
3384	ENDIF
3385	!
3386	!-- Condensation of precursor gases
3387	IF ( lscndgas ) THEN
3388	IF ( salsa_gases_from_chem ) THEN
3389	!
3390	!-- SO4 (or H2SO4)
3391	ig = gas_index_chem(1)
3392	chem_species(ig)%conc(k,j,i) = chem_species(ig)%conc(k,j,i) + ( zgso4 / &
3393	ppm_to_nconc(k) - chem_species(ig)%conc(k,j,i) ) * flag
3394	!
3395	!-- HNO3
3396	ig = gas_index_chem(2)
3397	chem_species(ig)%conc(k,j,i) = chem_species(ig)%conc(k,j,i) + ( zghno3 / &
3398	ppm_to_nconc(k) - chem_species(ig)%conc(k,j,i) ) * flag
3399	!
3400	!-- NH3
3401	ig = gas_index_chem(3)
3402	chem_species(ig)%conc(k,j,i) = chem_species(ig)%conc(k,j,i) + ( zgnh3 / &
3403	ppm_to_nconc(k) - chem_species(ig)%conc(k,j,i) ) * flag
3404	!
3405	!-- non-volatile OC
3406	ig = gas_index_chem(4)
3407	chem_species(ig)%conc(k,j,i) = chem_species(ig)%conc(k,j,i) + ( zgocnv / &
3408	ppm_to_nconc(k) - chem_species(ig)%conc(k,j,i) ) * flag
3409	!
3410	!-- semi-volatile OC
3411	ig = gas_index_chem(5)
3412	chem_species(ig)%conc(k,j,i) = chem_species(ig)%conc(k,j,i) + ( zgocsv / &
3413	ppm_to_nconc(k) - chem_species(ig)%conc(k,j,i) ) * flag
3414
3415	ELSE
3416	!
3417	!-- SO4 (or H2SO4)
3418	salsa_gas(1)%conc(k,j,i) = salsa_gas(1)%conc(k,j,i) + ( zgso4 - &
3419	salsa_gas(1)%conc(k,j,i) ) * flag
3420	!
3421	!-- HNO3
3422	salsa_gas(2)%conc(k,j,i) = salsa_gas(2)%conc(k,j,i) + ( zghno3 - &
3423	salsa_gas(2)%conc(k,j,i) ) * flag
3424	!
3425	!-- NH3
3426	salsa_gas(3)%conc(k,j,i) = salsa_gas(3)%conc(k,j,i) + ( zgnh3 - &
3427	salsa_gas(3)%conc(k,j,i) ) * flag
3428	!
3429	!-- non-volatile OC
3430	salsa_gas(4)%conc(k,j,i) = salsa_gas(4)%conc(k,j,i) + ( zgocnv - &
3431	salsa_gas(4)%conc(k,j,i) ) * flag
3432	!
3433	!-- semi-volatile OC
3434	salsa_gas(5)%conc(k,j,i) = salsa_gas(5)%conc(k,j,i) + ( zgocsv - &
3435	salsa_gas(5)%conc(k,j,i) ) * flag
3436	ENDIF
3437	ENDIF
3438	!
3439	!-- Tendency of water vapour mixing ratio is obtained from the change in RH during SALSA run.
3440	!-- This releases heat and changes pt. Assumes no temperature change during SALSA run.
3441	!-- q = r / (1+r), Euler method for integration
3442	!
3443	IF ( feedback_to_palm ) THEN
3444	q_p(k,j,i) = q_p(k,j,i) + 1.0_wp / ( in_cw(k) * in_adn(k) + 1.0_wp )*2 &
3445	( in_cw(k) - cw_old ) * in_adn(k) * flag
3446	pt_p(k,j,i) = pt_p(k,j,i) + alv / c_p * ( in_cw(k) - cw_old ) * in_adn(k) / ( in_cw(k) / &
3447	in_adn(k) + 1.0_wp )*2 pt_p(k,j,i) / in_t(k) * flag
3448	ENDIF
3449
3450	ENDDO ! k
3451
3452	!
3453	!-- Set surfaces and wall fluxes due to deposition
3454	IF ( lsdepo .AND. lsdepo_surf .AND. prunmode == 3 ) THEN
3455	IF ( .NOT. land_surface .AND. .NOT. urban_surface ) THEN
3456	CALL depo_surf( i, j, surf_def_h(0), vd, schmidt_num, kvis, in_u, .TRUE. )
3457	DO l = 0, 3
3458	CALL depo_surf( i, j, surf_def_v(l), vd, schmidt_num, kvis, in_u, .FALSE. )
3459	ENDDO
3460	ELSE
3461	CALL depo_surf( i, j, surf_usm_h, vd, schmidt_num, kvis, in_u, .TRUE., usm_to_depo_h )
3462	DO l = 0, 3
3463	CALL depo_surf( i, j, surf_usm_v(l), vd, schmidt_num, kvis, in_u, .FALSE., &
3464	usm_to_depo_v(l) )
3465	ENDDO
3466	CALL depo_surf( i, j, surf_lsm_h, vd, schmidt_num, kvis, in_u, .TRUE., lsm_to_depo_h )
3467	DO l = 0, 3
3468	CALL depo_surf( i, j, surf_lsm_v(l), vd, schmidt_num, kvis, in_u, .FALSE., &
3469	lsm_to_depo_v(l) )
3470	ENDDO
3471	ENDIF
3472	ENDIF
3473
3474	IF ( prunmode < 3 ) THEN
3475	!$OMP MASTER
3476	aero = lo_aero
3477	!$OMP END MASTER
3478	END IF
3479
3480	END SUBROUTINE salsa_driver
3481
3482	!------------------------------------------------------------------------------!
3483	! Description:
3484	! ------------
3485	!> Set logical switches according to the salsa_parameters options.
3486	!> Juha Tonttila, FMI, 2014
3487	!> Only aerosol processes included, Mona Kurppa, UHel, 2017
3488	!------------------------------------------------------------------------------!
3489	SUBROUTINE set_salsa_runtime( prunmode )
3490
3491	IMPLICIT NONE
3492
3493	INTEGER(iwp), INTENT(in) :: prunmode
3494
3495	SELECT CASE(prunmode)
3496
3497	CASE(1) !< Initialization
3498	lscoag = .FALSE.
3499	lscnd = .FALSE.
3500	lscndgas = .FALSE.
3501	lscndh2oae = .FALSE.
3502	lsdepo = .FALSE.
3503	lsdepo_pcm = .FALSE.
3504	lsdepo_surf = .FALSE.
3505	lsdistupdate = .TRUE.
3506	lspartition = .FALSE.
3507
3508	CASE(2) !< Spinup period
3509	lscoag = ( .FALSE. .AND. nlcoag )
3510	lscnd = ( .TRUE. .AND. nlcnd )
3511	lscndgas = ( .TRUE. .AND. nlcndgas )
3512	lscndh2oae = ( .TRUE. .AND. nlcndh2oae )
3513
3514	CASE(3) !< Run
3515	lscoag = nlcoag
3516	lscnd = nlcnd
3517	lscndgas = nlcndgas
3518	lscndh2oae = nlcndh2oae
3519	lsdepo = nldepo
3520	lsdepo_pcm = nldepo_pcm
3521	lsdepo_surf = nldepo_surf
3522	lsdistupdate = nldistupdate
3523	END SELECT
3524
3525
3526	END SUBROUTINE set_salsa_runtime
3527
3528	!------------------------------------------------------------------------------!
3529	! Description:
3530	! ------------
3531	!> Calculates the absolute temperature (using hydrostatic pressure), saturation
3532	!> vapour pressure and mixing ratio over water, relative humidity and air
3533	!> density needed in the SALSA model.
3534	!> NOTE, no saturation adjustment takes place -> the resulting water vapour
3535	!> mixing ratio can be supersaturated, allowing the microphysical calculations
3536	!> in SALSA.
3537	!
3538	!> Juha Tonttila, FMI, 2014 (original SALSAthrm)
3539	!> Mona Kurppa, UHel, 2017 (adjustment for PALM and only aerosol processes)
3540	!------------------------------------------------------------------------------!
3541	SUBROUTINE salsa_thrm_ij( i, j, p_ij, temp_ij, cw_ij, cs_ij, adn_ij )
3542
3543	USE arrays_3d, &
3544	ONLY: pt, q, zu
3545
3546	USE basic_constants_and_equations_mod, &
3547	ONLY: barometric_formula, exner_function, ideal_gas_law_rho, magnus
3548
3549	IMPLICIT NONE
3550
3551	INTEGER(iwp), INTENT(in) :: i !<
3552	INTEGER(iwp), INTENT(in) :: j !<
3553
3554	REAL(wp) :: t_surface !< absolute surface temperature (K)
3555
3556	REAL(wp), DIMENSION(nzb:nzt+1) :: e_s !< saturation vapour pressure over water (Pa)
3557
3558	REAL(wp), DIMENSION(:), INTENT(inout) :: adn_ij !< air density (kg/m3)
3559	REAL(wp), DIMENSION(:), INTENT(inout) :: p_ij !< air pressure (Pa)
3560	REAL(wp), DIMENSION(:), INTENT(inout) :: temp_ij !< air temperature (K)
3561
3562	REAL(wp), DIMENSION(:), INTENT(inout), OPTIONAL :: cw_ij !< water vapour concentration (kg/m3)
3563	REAL(wp), DIMENSION(:), INTENT(inout), OPTIONAL :: cs_ij !< saturation water vap. conc.(kg/m3)
3564	!
3565	!-- Pressure p_ijk (Pa) = hydrostatic pressure
3566	t_surface = pt_surface * exner_function( surface_pressure * 100.0_wp )
3567	p_ij(:) = barometric_formula( zu, t_surface, surface_pressure * 100.0_wp )
3568	!
3569	!-- Absolute ambient temperature (K)
3570	temp_ij(:) = pt(:,j,i) * exner_function( p_ij(:) )
3571	!
3572	!-- Air density
3573	adn_ij(:) = ideal_gas_law_rho( p_ij(:), temp_ij(:) )
3574	!
3575	!-- Water vapour concentration r_v (kg/m3)
3576	IF ( PRESENT( cw_ij ) ) THEN
3577	cw_ij(:) = ( q(:,j,i) / ( 1.0_wp - q(:,j,i) ) ) * adn_ij(:)
3578	ENDIF
3579	!
3580	!-- Saturation mixing ratio r_s (kg/kg) from vapour pressure at temp (Pa)
3581	IF ( PRESENT( cs_ij ) ) THEN
3582	e_s(:) = 611.0_wp * EXP( alv_d_rv * ( 3.6609E-3_wp - 1.0_wp / &
3583	temp_ij(:) ) )! magnus( temp_ij(:) )
3584	cs_ij(:) = ( 0.622_wp * e_s / ( p_ij(:) - e_s(:) ) ) * adn_ij(:)
3585	ENDIF
3586
3587	END SUBROUTINE salsa_thrm_ij
3588
3589	!------------------------------------------------------------------------------!
3590	! Description:
3591	! ------------
3592	!> Calculates ambient sizes of particles by equilibrating soluble fraction of
3593	!> particles with water using the ZSR method (Stokes and Robinson, 1966).
3594	!> Method:
3595	!> Following chemical components are assumed water-soluble
3596	!> - (ammonium) sulphate (100%)
3597	!> - sea salt (100 %)
3598	!> - organic carbon (epsoc * 100%)
3599	!> Exact thermodynamic considerations neglected.
3600	!> - If particles contain no sea salt, calculation according to sulphate
3601	!> properties
3602	!> - If contain sea salt but no sulphate, calculation according to sea salt
3603	!> properties
3604	!> - If contain both sulphate and sea salt -> the molar fraction of these
3605	!> compounds determines which one of them is used as the basis of calculation.
3606	!> If sulphate and sea salt coexist in a particle, it is assumed that the Cl is
3607	!> replaced by sulphate; thus only either sulphate + organics or sea salt +
3608	!> organics is included in the calculation of soluble fraction.
3609	!> Molality parameterizations taken from Table 1 of Tang: Thermodynamic and
3610	!> optical properties of mixed-salt aerosols of atmospheric importance,
3611	!> J. Geophys. Res., 102 (D2), 1883-1893 (1997)
3612	!
3613	!> Coded by:
3614	!> Hannele Korhonen (FMI) 2005
3615	!> Harri Kokkola (FMI) 2006
3616	!> Matti Niskanen(FMI) 2012
3617	!> Anton Laakso (FMI) 2013
3618	!> Modified for the new aerosol datatype, Juha Tonttila (FMI) 2014
3619	!
3620	!> fxm: should sea salt form a solid particle when prh is very low (even though
3621	!> it could be mixed with e.g. sulphate)?
3622	!> fxm: crashes if no sulphate or sea salt
3623	!> fxm: do we really need to consider Kelvin effect for subrange 2
3624	!------------------------------------------------------------------------------!
3625	SUBROUTINE equilibration( prh, ptemp, paero, init )
3626
3627	IMPLICIT NONE
3628
3629	INTEGER(iwp) :: ib !< loop index
3630	INTEGER(iwp) :: counti !< loop index
3631
3632	LOGICAL, INTENT(in) :: init !< TRUE: Initialization, FALSE: Normal runtime: update water
3633	!< content only for 1a
3634
3635	REAL(wp) :: zaw !< water activity [0-1]
3636	REAL(wp) :: zcore !< Volume of dry particle
3637	REAL(wp) :: zdold !< Old diameter
3638	REAL(wp) :: zdwet !< Wet diameter or mean droplet diameter
3639	REAL(wp) :: zke !< Kelvin term in the KÃ¶hler equation
3640	REAL(wp) :: zlwc !< liquid water content [kg/m3-air]
3641	REAL(wp) :: zrh !< Relative humidity
3642
3643	REAL(wp), DIMENSION(maxspec) :: zbinmol !< binary molality of each components (mol/kg)
3644	REAL(wp), DIMENSION(maxspec) :: zvpart !< volume of chem. compounds in one particle
3645
3646	REAL(wp), INTENT(in) :: prh !< relative humidity [0-1]
3647	REAL(wp), INTENT(in) :: ptemp !< temperature (K)
3648
3649	TYPE(t_section), DIMENSION(nbins_aerosol), INTENT(inout) :: paero !< aerosol properties
3650
3651	zaw = 0.0_wp
3652	zlwc = 0.0_wp
3653	!
3654	!-- Relative humidity:
3655	zrh = prh
3656	zrh = MAX( zrh, 0.05_wp )
3657	zrh = MIN( zrh, 0.98_wp)
3658	!
3659	!-- 1) Regime 1: sulphate and partly water-soluble OC. Done for every CALL
3660	DO ib = start_subrange_1a, end_subrange_1a ! size bin
3661
3662	zbinmol = 0.0_wp
3663	zdold = 1.0_wp
3664	zke = 1.02_wp
3665
3666	IF ( paero(ib)%numc > nclim ) THEN
3667	!
3668	!-- Volume in one particle
3669	zvpart = 0.0_wp
3670	zvpart(1:2) = paero(ib)%volc(1:2) / paero(ib)%numc
3671	zvpart(6:7) = paero(ib)%volc(6:7) / paero(ib)%numc
3672	!
3673	!-- Total volume and wet diameter of one dry particle
3674	zcore = SUM( zvpart(1:2) )
3675	zdwet = paero(ib)%dwet
3676
3677	counti = 0
3678	DO WHILE ( ABS( zdwet / zdold - 1.0_wp ) > 1.0E-2_wp )
3679
3680	zdold = MAX( zdwet, 1.0E-20_wp )
3681	zaw = MAX( 1.0E-3_wp, zrh / zke ) ! To avoid underflow
3682	!
3683	!-- Binary molalities (mol/kg):
3684	!-- Sulphate
3685	zbinmol(1) = 1.1065495E+2_wp - 3.6759197E+2_wp * zaw + 5.0462934E+2_wp * zaw**2 - &
3686	3.1543839E+2_wp * zaw*3 + 6.770824E+1_wp zaw**4
3687	!-- Organic carbon
3688	zbinmol(2) = 1.0_wp / ( zaw * amh2o ) - 1.0_wp / amh2o
3689	!-- Nitric acid
3690	zbinmol(6) = 2.306844303E+1_wp - 3.563608869E+1_wp * zaw - 6.210577919E+1_wp * zaw**2 &
3691	+ 5.510176187E+2_wp * zaw*3 - 1.460055286E+3_wp zaw**4 &
3692	+ 1.894467542E+3_wp * zaw*5 - 1.220611402E+3_wp zaw**6 &
3693	+ 3.098597737E+2_wp * zaw**7
3694	!
3695	!-- Calculate the liquid water content (kg/m3-air) using ZSR (see e.g. Eq. 10.98 in
3696	!-- Seinfeld and Pandis (2006))
3697	zlwc = ( paero(ib)%volc(1) * ( arhoh2so4 / amh2so4 ) ) / zbinmol(1) + &
3698	epsoc * paero(ib)%volc(2) * ( arhooc / amoc ) / zbinmol(2) + &
3699	( paero(ib)%volc(6) * ( arhohno3/amhno3 ) ) / zbinmol(6)
3700	!
3701	!-- Particle wet diameter (m)
3702	zdwet = ( zlwc / paero(ib)%numc / arhoh2o / api6 + ( SUM( zvpart(6:7) ) / api6 ) + &
3703	zcore / api6 )**0.33333333_wp
3704	!
3705	!-- Kelvin effect (Eq. 10.85 in in Seinfeld and Pandis (2006)). Avoid
3706	!-- overflow.
3707	zke = EXP( MIN( 50.0_wp, 4.0_wp * surfw0 * amvh2so4 / ( abo * ptemp * zdwet ) ) )
3708
3709	counti = counti + 1
3710	IF ( counti > 1000 ) THEN
3711	message_string = 'Subrange 1: no convergence!'
3712	CALL message( 'salsa_mod: equilibration', 'PA0617', 1, 2, 0, 6, 0 )
3713	ENDIF
3714	ENDDO
3715	!
3716	!-- Instead of lwc, use the volume concentration of water from now on
3717	!-- (easy to convert...)
3718	paero(ib)%volc(8) = zlwc / arhoh2o
3719	!
3720	!-- If this is initialization, update the core and wet diameter
3721	IF ( init ) THEN
3722	paero(ib)%dwet = zdwet
3723	paero(ib)%core = zcore
3724	ENDIF
3725
3726	ELSE
3727	!-- If initialization
3728	!-- 1.2) empty bins given bin average values
3729	IF ( init ) THEN
3730	paero(ib)%dwet = paero(ib)%dmid
3731	paero(ib)%core = api6 * paero(ib)%dmid**3
3732	ENDIF
3733
3734	ENDIF
3735
3736	ENDDO ! ib
3737	!
3738	!-- 2) Regime 2a: sulphate, OC, BC and sea salt
3739	!-- This is done only for initialization call, otherwise the water contents
3740	!-- are computed via condensation
3741	IF ( init ) THEN
3742	DO ib = start_subrange_2a, end_subrange_2b
3743	!
3744	!-- Initialize
3745	zke = 1.02_wp
3746	zbinmol = 0.0_wp
3747	zdold = 1.0_wp
3748	!
3749	!-- 1) Particle properties calculated for non-empty bins
3750	IF ( paero(ib)%numc > nclim ) THEN
3751	!
3752	!-- Volume in one particle [fxm]
3753	zvpart = 0.0_wp
3754	zvpart(1:7) = paero(ib)%volc(1:7) / paero(ib)%numc
3755	!
3756	!-- Total volume and wet diameter of one dry particle [fxm]
3757	zcore = SUM( zvpart(1:5) )
3758	zdwet = paero(ib)%dwet
3759
3760	counti = 0
3761	DO WHILE ( ABS( zdwet / zdold - 1.0_wp ) > 1.0E-12_wp )
3762
3763	zdold = MAX( zdwet, 1.0E-20_wp )
3764	zaw = zrh / zke
3765	!
3766	!-- Binary molalities (mol/kg):
3767	!-- Sulphate
3768	zbinmol(1) = 1.1065495E+2_wp - 3.6759197E+2_wp * zaw + 5.0462934E+2_wp * zaw**2 - &
3769	3.1543839E+2_wp * zaw*3 + 6.770824E+1_wp zaw**4
3770	!-- Organic carbon
3771	zbinmol(2) = 1.0_wp / ( zaw * amh2o ) - 1.0_wp / amh2o
3772	!-- Nitric acid
3773	zbinmol(6) = 2.306844303E+1_wp - 3.563608869E+1_wp * zaw - &
3774	6.210577919E+1_wp * zaw*2 + 5.510176187E+2_wp zaw**3 - &
3775	1.460055286E+3_wp * zaw*4 + 1.894467542E+3_wp zaw**5 - &
3776	1.220611402E+3_wp * zaw*6 + 3.098597737E+2_wp zaw**7
3777	!-- Sea salt (natrium chloride)
3778	zbinmol(5) = 5.875248E+1_wp - 1.8781997E+2_wp * zaw + 2.7211377E+2_wp * zaw**2 - &
3779	1.8458287E+2_wp * zaw*3 + 4.153689E+1_wp zaw**4
3780	!
3781	!-- Calculate the liquid water content (kg/m3-air)
3782	zlwc = ( paero(ib)%volc(1) * ( arhoh2so4 / amh2so4 ) ) / zbinmol(1) + &
3783	epsoc * ( paero(ib)%volc(2) * ( arhooc / amoc ) ) / zbinmol(2) + &
3784	( paero(ib)%volc(6) * ( arhohno3 / amhno3 ) ) / zbinmol(6) + &
3785	( paero(ib)%volc(5) * ( arhoss / amss ) ) / zbinmol(5)
3786
3787	!-- Particle wet radius (m)
3788	zdwet = ( zlwc / paero(ib)%numc / arhoh2o / api6 + ( SUM( zvpart(6:7) ) / api6 ) + &
3789	zcore / api6 )**0.33333333_wp
3790	!
3791	!-- Kelvin effect (Eq. 10.85 in Seinfeld and Pandis (2006))
3792	zke = EXP( MIN( 50.0_wp, 4.0_wp * surfw0 * amvh2so4 / ( abo * zdwet * ptemp ) ) )
3793
3794	counti = counti + 1
3795	IF ( counti > 1000 ) THEN
3796	message_string = 'Subrange 2: no convergence!'
3797	CALL message( 'salsa_mod: equilibration', 'PA0618', 1, 2, 0, 6, 0 )
3798	ENDIF
3799	ENDDO
3800	!
3801	!-- Liquid water content; instead of LWC use the volume concentration
3802	paero(ib)%volc(8) = zlwc / arhoh2o
3803	paero(ib)%dwet = zdwet
3804	paero(ib)%core = zcore
3805
3806	ELSE
3807	!-- 2.2) empty bins given bin average values
3808	paero(ib)%dwet = paero(ib)%dmid
3809	paero(ib)%core = api6 * paero(ib)%dmid**3
3810	ENDIF
3811
3812	ENDDO ! ib
3813	ENDIF
3814
3815	END SUBROUTINE equilibration
3816
3817	!------------------------------------------------------------------------------!
3818	!> Description:
3819	!> ------------
3820	!> Calculation of the settling velocity vc (m/s) per aerosol size bin and
3821	!> deposition on plant canopy (lsdepo_pcm).
3822	!
3823	!> Deposition is based on either the scheme presented in:
3824	!> Zhang et al. (2001), Atmos. Environ. 35, 549-560 (includes collection due to
3825	!> Brownian diffusion, impaction, interception and sedimentation; hereafter ZO1)
3826	!> OR
3827	!> Petroff & Zhang (2010), Geosci. Model Dev. 3, 753-769 (includes also
3828	!> collection due to turbulent impaction, hereafter P10)
3829	!
3830	!> Equation numbers refer to equation in Jacobson (2005): Fundamentals of
3831	!> Atmospheric Modeling, 2nd Edition.
3832	!
3833	!> Subroutine follows closely sedim_SALSA in UCLALES-SALSA written by Juha
3834	!> Tonttila (KIT/FMI) and Zubair Maalick (UEF).
3835	!> Rewritten to PALM by Mona Kurppa (UH), 2017.
3836	!
3837	!> Call for grid point i,j,k
3838	!------------------------------------------------------------------------------!
3839
3840	SUBROUTINE deposition( paero, tk, adn, mag_u, lad, kvis, schmidt_num, vc )
3841
3842	USE plant_canopy_model_mod, &
3843	ONLY: canopy_drag_coeff
3844
3845	IMPLICIT NONE
3846
3847	INTEGER(iwp) :: ib !< loop index
3848	INTEGER(iwp) :: ic !< loop index
3849
3850	REAL(wp) :: alpha !< parameter, Table 3 in Z01
3851	REAL(wp) :: avis !< molecular viscocity of air (kg/(m*s))
3852	REAL(wp) :: beta_im !< parameter for turbulent impaction
3853	REAL(wp) :: c_brownian_diff !< coefficient for Brownian diffusion
3854	REAL(wp) :: c_impaction !< coefficient for inertial impaction
3855	REAL(wp) :: c_interception !< coefficient for interception
3856	REAL(wp) :: c_turb_impaction !< coefficient for turbulent impaction
3857	REAL(wp) :: depo !< deposition velocity (m/s)
3858	REAL(wp) :: gamma !< parameter, Table 3 in Z01
3859	REAL(wp) :: lambda !< molecular mean free path (m)
3860	REAL(wp) :: mdiff !< particle diffusivity coefficient
3861	REAL(wp) :: par_a !< parameter A for the characteristic radius of collectors,
3862	!< Table 3 in Z01
3863	REAL(wp) :: par_l !< obstacle characteristic dimension in P10
3864	REAL(wp) :: pdn !< particle density (kg/m3)
3865	REAL(wp) :: ustar !< friction velocity (m/s)
3866	REAL(wp) :: va !< thermal speed of an air molecule (m/s)
3867
3868	REAL(wp), INTENT(in) :: adn !< air density (kg/m3)
3869	REAL(wp), INTENT(in) :: lad !< leaf area density (m2/m3)
3870	REAL(wp), INTENT(in) :: mag_u !< wind velocity (m/s)
3871	REAL(wp), INTENT(in) :: tk !< abs.temperature (K)
3872
3873	REAL(wp), INTENT(inout) :: kvis !< kinematic viscosity of air (m2/s)
3874
3875	REAL(wp), DIMENSION(nbins_aerosol) :: beta !< Cunningham slip-flow correction factor
3876	REAL(wp), DIMENSION(nbins_aerosol) :: Kn !< Knudsen number
3877	REAL(wp), DIMENSION(nbins_aerosol) :: zdwet !< wet diameter (m)
3878
3879	REAL(wp), DIMENSION(:), INTENT(inout) :: schmidt_num !< particle Schmidt number
3880	REAL(wp), DIMENSION(:), INTENT(inout) :: vc !< critical fall speed i.e. settling velocity of
3881	!< an aerosol particle (m/s)
3882
3883	TYPE(t_section), DIMENSION(nbins_aerosol), INTENT(inout) :: paero !< aerosol properties
3884	!
3885	!-- Initialise
3886	depo = 0.0_wp
3887	pdn = 1500.0_wp ! default value
3888	ustar = 0.0_wp
3889	!
3890	!-- Molecular viscosity of air (Eq. 4.54)
3891	avis = 1.8325E-5_wp * ( 416.16_wp / ( tk + 120.0_wp ) ) * ( tk / 296.16_wp )**1.5_wp
3892	!
3893	!-- Kinematic viscosity (Eq. 4.55)
3894	kvis = avis / adn
3895	!
3896	!-- Thermal velocity of an air molecule (Eq. 15.32)
3897	va = SQRT( 8.0_wp * abo * tk / ( pi * am_airmol ) )
3898	!
3899	!-- Mean free path (m) (Eq. 15.24)
3900	lambda = 2.0_wp * avis / ( adn * va )
3901	!
3902	!-- Particle wet diameter (m)
3903	zdwet = paero(:)%dwet
3904	!
3905	!-- Knudsen number (Eq. 15.23)
3906	Kn = MAX( 1.0E-2_wp, lambda / ( zdwet * 0.5_wp ) ) ! To avoid underflow
3907	!
3908	!-- Cunningham slip-flow correction (Eq. 15.30)
3909	beta = 1.0_wp + Kn * ( 1.249_wp + 0.42_wp * EXP( -0.87_wp / Kn ) )
3910	!
3911	!-- Critical fall speed i.e. settling velocity (Eq. 20.4)
3912	vc = MIN( 1.0_wp, zdwet*2 ( pdn - adn ) * g * beta / ( 18.0_wp * avis ) )
3913	!
3914	!-- Deposition on vegetation
3915	IF ( lsdepo_pcm .AND. plant_canopy .AND. lad > 0.0_wp ) THEN
3916	!
3917	!-- Parameters for the land use category 'deciduous broadleaf trees'(Table 3)
3918	alpha = alpha_z01(depo_pcm_type_num)
3919	gamma = gamma_z01(depo_pcm_type_num)
3920	par_a = A_z01(depo_pcm_type_num, season_z01) * 1.0E-3_wp
3921	!
3922	!-- Deposition efficiencies from Table 1. Constants from Table 2.
3923	par_l = l_p10(depo_pcm_type_num) * 0.01_wp
3924	c_brownian_diff = c_b_p10(depo_pcm_type_num)
3925	c_interception = c_in_p10(depo_pcm_type_num)
3926	c_impaction = c_im_p10(depo_pcm_type_num)
3927	beta_im = beta_im_p10(depo_pcm_type_num)
3928	c_turb_impaction = c_it_p10(depo_pcm_type_num)
3929
3930	DO ib = 1, nbins_aerosol
3931
3932	IF ( paero(ib)%numc < ( 2.0_wp * nclim ) ) CYCLE
3933
3934	!-- Particle diffusivity coefficient (Eq. 15.29)
3935	mdiff = ( abo * tk * beta(ib) ) / ( 3.0_wp * pi * avis * zdwet(ib) )
3936	!
3937	!-- Particle Schmidt number (Eq. 15.36)
3938	schmidt_num(ib) = kvis / mdiff
3939	!
3940	!-- Friction velocity for deposition on vegetation. Calculated following Prandtl (1925):
3941	ustar = SQRT( canopy_drag_coeff ) * mag_u
3942	SELECT CASE ( depo_pcm_par_num )
3943
3944	CASE ( 1 ) ! Zhang et al. (2001)
3945	CALL depo_vel_Z01( vc(ib), ustar, schmidt_num(ib), paero(ib)%dwet, alpha, gamma, &
3946	par_a, depo )
3947	CASE ( 2 ) ! Petroff & Zhang (2010)
3948	CALL depo_vel_P10( vc(ib), mag_u, ustar, kvis, schmidt_num(ib), paero(ib)%dwet, &
3949	par_l, c_brownian_diff, c_interception, c_impaction, beta_im, &
3950	c_turb_impaction, depo )
3951	END SELECT
3952	!
3953	!-- Calculate the change in concentrations
3954	paero(ib)%numc = paero(ib)%numc - depo * lad * paero(ib)%numc * dt_salsa
3955	DO ic = 1, maxspec+1
3956	paero(ib)%volc(ic) = paero(ib)%volc(ic) - depo * lad * paero(ib)%volc(ic) * dt_salsa
3957	ENDDO
3958	ENDDO
3959
3960	ENDIF
3961
3962	END SUBROUTINE deposition
3963
3964	!------------------------------------------------------------------------------!
3965	! Description:
3966	! ------------
3967	!> Calculate deposition velocity (m/s) based on Zhan et al. (2001, case 1).
3968	!------------------------------------------------------------------------------!
3969
3970	SUBROUTINE depo_vel_Z01( vc, ustar, schmidt_num, diameter, alpha, gamma, par_a, depo )
3971
3972	IMPLICIT NONE
3973
3974	REAL(wp) :: rs !< overall quasi-laminar resistance for particles
3975	REAL(wp) :: stokes_num !< Stokes number for smooth or bluff surfaces
3976
3977	REAL(wp), INTENT(in) :: alpha !< parameter, Table 3 in Z01
3978	REAL(wp), INTENT(in) :: gamma !< parameter, Table 3 in Z01
3979	REAL(wp), INTENT(in) :: par_a !< parameter A for the characteristic diameter of
3980	!< collectors, Table 3 in Z01
3981	REAL(wp), INTENT(in) :: diameter !< particle diameter
3982	REAL(wp), INTENT(in) :: schmidt_num !< particle Schmidt number
3983	REAL(wp), INTENT(in) :: ustar !< friction velocity (m/s)
3984	REAL(wp), INTENT(in) :: vc !< terminal velocity (m/s)
3985
3986	REAL(wp), INTENT(inout) :: depo !< deposition efficiency (m/s)
3987
3988	IF ( par_a > 0.0_wp ) THEN
3989	!
3990	!-- Initialise
3991	rs = 0.0_wp
3992	!
3993	!-- Stokes number for vegetated surfaces (Seinfeld & Pandis (2006): Eq.19.24)
3994	stokes_num = vc * ustar / ( g * par_a )
3995	!
3996	!-- The overall quasi-laminar resistance for particles (Zhang et al., Eq. 5)
3997	rs = MAX( EPSILON( 1.0_wp ), ( 3.0_wp * ustar * EXP( -stokes_num*0.5_wp ) &
3998	( schmidt_num( -gamma ) + ( stokes_num / ( alpha + stokes_num ) )2 + &
3999	0.5_wp * ( diameter / par_a )**2 ) ) )
4000
4001	depo = rs + vc
4002
4003	ELSE
4004	depo = 0.0_wp
4005	ENDIF
4006
4007	END SUBROUTINE depo_vel_Z01
4008
4009	!------------------------------------------------------------------------------!
4010	! Description:
4011	! ------------
4012	!> Calculate deposition velocity (m/s) based on Petroff & Zhang (2010, case 2).
4013	!------------------------------------------------------------------------------!
4014
4015	SUBROUTINE depo_vel_P10( vc, mag_u, ustar, kvis_a, schmidt_num, diameter, par_l, c_brownian_diff, &
4016	c_interception, c_impaction, beta_im, c_turb_impaction, depo )
4017
4018	IMPLICIT NONE
4019
4020	REAL(wp) :: stokes_num !< Stokes number for smooth or bluff surfaces
4021	REAL(wp) :: tau_plus !< dimensionless particle relaxation time
4022	REAL(wp) :: v_bd !< deposition velocity due to Brownian diffusion
4023	REAL(wp) :: v_im !< deposition velocity due to impaction
4024	REAL(wp) :: v_in !< deposition velocity due to interception
4025	REAL(wp) :: v_it !< deposition velocity due to turbulent impaction
4026
4027	REAL(wp), INTENT(in) :: beta_im !< parameter for turbulent impaction
4028	REAL(wp), INTENT(in) :: c_brownian_diff !< coefficient for Brownian diffusion
4029	REAL(wp), INTENT(in) :: c_impaction !< coefficient for inertial impaction
4030	REAL(wp), INTENT(in) :: c_interception !< coefficient for interception
4031	REAL(wp), INTENT(in) :: c_turb_impaction !< coefficient for turbulent impaction
4032	REAL(wp), INTENT(in) :: kvis_a !< kinematic viscosity of air (m2/s)
4033	REAL(wp), INTENT(in) :: mag_u !< wind velocity (m/s)
4034	REAL(wp), INTENT(in) :: par_l !< obstacle characteristic dimension in P10
4035	REAL(wp), INTENT(in) :: diameter !< particle diameter
4036	REAL(wp), INTENT(in) :: schmidt_num !< particle Schmidt number
4037	REAL(wp), INTENT(in) :: ustar !< friction velocity (m/s)
4038	REAL(wp), INTENT(in) :: vc !< terminal velocity (m/s)
4039
4040	REAL(wp), INTENT(inout) :: depo !< deposition efficiency (m/s)
4041
4042	IF ( par_l > 0.0_wp ) THEN
4043	!
4044	!-- Initialise
4045	tau_plus = 0.0_wp
4046	v_bd = 0.0_wp
4047	v_im = 0.0_wp
4048	v_in = 0.0_wp
4049	v_it = 0.0_wp
4050	!
4051	!-- Stokes number for vegetated surfaces (Seinfeld & Pandis (2006): Eq.19.24)
4052	stokes_num = vc * ustar / ( g * par_l )
4053	!
4054	!-- Non-dimensional relexation time of the particle on top of canopy
4055	tau_plus = vc * ustar*2 / ( kvis_a g )
4056	!
4057	!-- Brownian diffusion
4058	v_bd = mag_u * c_brownian_diff * schmidt_num*( -0.66666666_wp ) &
4059	( mag_u * par_l / kvis_a )**( -0.5_wp )
4060	!
4061	!-- Interception
4062	v_in = mag_u * c_interception * diameter / par_l * &
4063	( 2.0_wp + LOG( 2.0_wp * par_l / diameter ) )
4064	!
4065	!-- Impaction: Petroff (2009) Eq. 18
4066	v_im = mag_u * c_impaction * ( stokes_num / ( stokes_num + beta_im ) )**2
4067	!
4068	!-- Turbulent impaction
4069	IF ( tau_plus < 20.0_wp ) THEN
4070	v_it = 2.5E-3_wp * c_turb_impaction * tau_plus**2
4071	ELSE
4072	v_it = c_turb_impaction
4073	ENDIF
4074
4075	depo = ( v_bd + v_in + v_im + v_it + vc )
4076
4077	ELSE
4078	depo = 0.0_wp
4079	ENDIF
4080
4081	END SUBROUTINE depo_vel_P10
4082
4083	!------------------------------------------------------------------------------!
4084	! Description:
4085	! ------------
4086	!> Calculate the dry deposition on horizontal and vertical surfaces. Implement
4087	!> as a surface flux.
4088	!> @todo aerodynamic resistance ignored for now (not important for
4089	! high-resolution simulations)
4090	!------------------------------------------------------------------------------!
4091	SUBROUTINE depo_surf( i, j, surf, vc, schmidt_num, kvis, mag_u, norm, match_array )
4092
4093	USE arrays_3d, &
4094	ONLY: rho_air_zw
4095
4096	USE surface_mod, &
4097	ONLY: ind_pav_green, ind_veg_wall, ind_wat_win, surf_type
4098
4099	IMPLICIT NONE
4100
4101	INTEGER(iwp) :: ib !< loop index
4102	INTEGER(iwp) :: ic !< loop index
4103	INTEGER(iwp) :: icc !< additional loop index
4104	INTEGER(iwp) :: k !< loop index
4105	INTEGER(iwp) :: m !< loop index
4106	INTEGER(iwp) :: surf_e !< End index of surface elements at (j,i)-gridpoint
4107	INTEGER(iwp) :: surf_s !< Start index of surface elements at (j,i)-gridpoint
4108
4109	INTEGER(iwp), INTENT(in) :: i !< loop index
4110	INTEGER(iwp), INTENT(in) :: j !< loop index
4111
4112	LOGICAL, INTENT(in) :: norm !< to normalise or not
4113
4114	REAL(wp) :: alpha !< parameter, Table 3 in Z01
4115	REAL(wp) :: beta_im !< parameter for turbulent impaction
4116	REAL(wp) :: c_brownian_diff !< coefficient for Brownian diffusion
4117	REAL(wp) :: c_impaction !< coefficient for inertial impaction
4118	REAL(wp) :: c_interception !< coefficient for interception
4119	REAL(wp) :: c_turb_impaction !< coefficient for turbulent impaction
4120	REAL(wp) :: gamma !< parameter, Table 3 in Z01
4121	REAL(wp) :: norm_fac !< normalisation factor (usually air density)
4122	REAL(wp) :: par_a !< parameter A for the characteristic radius of collectors,
4123	!< Table 3 in Z01
4124	REAL(wp) :: par_l !< obstacle characteristic dimension in P10
4125	REAL(wp) :: rs !< the overall quasi-laminar resistance for particles
4126	REAL(wp) :: tau_plus !< dimensionless particle relaxation time
4127	REAL(wp) :: v_bd !< deposition velocity due to Brownian diffusion
4128	REAL(wp) :: v_im !< deposition velocity due to impaction
4129	REAL(wp) :: v_in !< deposition velocity due to interception
4130	REAL(wp) :: v_it !< deposition velocity due to turbulent impaction
4131
4132	REAL(wp), DIMENSION(nbins_aerosol) :: depo !< deposition efficiency
4133	REAL(wp), DIMENSION(nbins_aerosol) :: depo_sum !< sum of deposition efficiencies
4134
4135	REAL(wp), DIMENSION(:), INTENT(in) :: kvis !< kinematic viscosity of air (m2/s)
4136	REAL(wp), DIMENSION(:), INTENT(in) :: mag_u !< wind velocity (m/s)
4137
4138	REAL(wp), DIMENSION(:,:), INTENT(in) :: schmidt_num !< particle Schmidt number
4139	REAL(wp), DIMENSION(:,:), INTENT(in) :: vc !< terminal velocity (m/s)
4140
4141	TYPE(match_surface), INTENT(in), OPTIONAL :: match_array !< match the deposition module and
4142	!< LSM/USM surfaces
4143	TYPE(surf_type), INTENT(inout) :: surf !< respective surface type
4144	!
4145	!-- Initialise
4146	depo = 0.0_wp
4147	depo_sum = 0.0_wp
4148	rs = 0.0_wp
4149	surf_s = surf%start_index(j,i)
4150	surf_e = surf%end_index(j,i)
4151	tau_plus = 0.0_wp
4152	v_bd = 0.0_wp
4153	v_im = 0.0_wp
4154	v_in = 0.0_wp
4155	v_it = 0.0_wp
4156	!
4157	!-- Model parameters for the land use category. If LSM or USM is applied, import
4158	!-- characteristics. Otherwise, apply surface type "urban".
4159	alpha = alpha_z01(luc_urban)
4160	gamma = gamma_z01(luc_urban)
4161	par_a = A_z01(luc_urban, season_z01) * 1.0E-3_wp
4162
4163	par_l = l_p10(luc_urban) * 0.01_wp
4164	c_brownian_diff = c_b_p10(luc_urban)
4165	c_interception = c_in_p10(luc_urban)
4166	c_impaction = c_im_p10(luc_urban)
4167	beta_im = beta_im_p10(luc_urban)
4168	c_turb_impaction = c_it_p10(luc_urban)
4169
4170
4171	IF ( PRESENT( match_array ) ) THEN ! land or urban surface model
4172
4173	DO m = surf_s, surf_e
4174
4175	k = surf%k(m)
4176	norm_fac = 1.0_wp
4177
4178	IF ( norm ) norm_fac = rho_air_zw(k) ! normalise vertical fluxes by air density
4179
4180	IF ( match_array%match_lupg(m) > 0 ) THEN
4181	alpha = alpha_z01( match_array%match_lupg(m) )
4182	gamma = gamma_z01( match_array%match_lupg(m) )
4183	par_a = A_z01( match_array%match_lupg(m), season_z01 ) * 1.0E-3_wp
4184
4185	beta_im = beta_im_p10( match_array%match_lupg(m) )
4186	c_brownian_diff = c_b_p10( match_array%match_lupg(m) )
4187	c_impaction = c_im_p10( match_array%match_lupg(m) )
4188	c_interception = c_in_p10( match_array%match_lupg(m) )
4189	c_turb_impaction = c_it_p10( match_array%match_lupg(m) )
4190	par_l = l_p10( match_array%match_lupg(m) ) * 0.01_wp
4191
4192	DO ib = 1, nbins_aerosol
4193	IF ( aerosol_number(ib)%conc(k,j,i) < ( 2.0_wp * nclim ) .OR. &
4194	schmidt_num(k+1,ib) < 1.0_wp ) CYCLE
4195
4196	SELECT CASE ( depo_surf_par_num )
4197
4198	CASE ( 1 )
4199	CALL depo_vel_Z01( vc(k+1,ib), surf%us(m), schmidt_num(k+1,ib), &
4200	ra_dry(k,j,i,ib), alpha, gamma, par_a, depo(ib) )
4201	CASE ( 2 )
4202	CALL depo_vel_P10( vc(k+1,ib), mag_u(k+1), surf%us(m), kvis(k+1), &
4203	schmidt_num(k+1,ib), ra_dry(k,j,i,ib), par_l, &
4204	c_brownian_diff, c_interception, c_impaction, beta_im, &
4205	c_turb_impaction, depo(ib) )
4206	END SELECT
4207	ENDDO
4208	depo_sum = depo_sum + surf%frac(ind_pav_green,m) * depo
4209	ENDIF
4210
4211	IF ( match_array%match_luvw(m) > 0 ) THEN
4212	alpha = alpha_z01( match_array%match_luvw(m) )
4213	gamma = gamma_z01( match_array%match_luvw(m) )
4214	par_a = A_z01( match_array%match_luvw(m), season_z01 ) * 1.0E-3_wp
4215
4216	beta_im = beta_im_p10( match_array%match_luvw(m) )
4217	c_brownian_diff = c_b_p10( match_array%match_luvw(m) )
4218	c_impaction = c_im_p10( match_array%match_luvw(m) )
4219	c_interception = c_in_p10( match_array%match_luvw(m) )
4220	c_turb_impaction = c_it_p10( match_array%match_luvw(m) )
4221	par_l = l_p10( match_array%match_luvw(m) ) * 0.01_wp
4222
4223	DO ib = 1, nbins_aerosol
4224	IF ( aerosol_number(ib)%conc(k,j,i) < ( 2.0_wp * nclim ) .OR. &
4225	schmidt_num(k+1,ib) < 1.0_wp ) CYCLE
4226
4227	SELECT CASE ( depo_surf_par_num )
4228
4229	CASE ( 1 )
4230	CALL depo_vel_Z01( vc(k+1,ib), surf%us(m), schmidt_num(k+1,ib), &
4231	ra_dry(k,j,i,ib), alpha, gamma, par_a, depo(ib) )
4232	CASE ( 2 )
4233	CALL depo_vel_P10( vc(k+1,ib), mag_u(k+1), surf%us(m), kvis(k+1), &
4234	schmidt_num(k+1,ib), ra_dry(k,j,i,ib), par_l, &
4235	c_brownian_diff, c_interception, c_impaction, beta_im, &
4236	c_turb_impaction, depo(ib) )
4237	END SELECT
4238	ENDDO
4239	depo_sum = depo_sum + surf%frac(ind_veg_wall,m) * depo
4240	ENDIF
4241
4242	IF ( match_array%match_luww(m) > 0 ) THEN
4243	alpha = alpha_z01( match_array%match_luww(m) )
4244	gamma = gamma_z01( match_array%match_luww(m) )
4245	par_a = A_z01( match_array%match_luww(m), season_z01 ) * 1.0E-3_wp
4246
4247	beta_im = beta_im_p10( match_array%match_luww(m) )
4248	c_brownian_diff = c_b_p10( match_array%match_luww(m) )
4249	c_impaction = c_im_p10( match_array%match_luww(m) )
4250	c_interception = c_in_p10( match_array%match_luww(m) )
4251	c_turb_impaction = c_it_p10( match_array%match_luww(m) )
4252	par_l = l_p10( match_array%match_luww(m) ) * 0.01_wp
4253
4254	DO ib = 1, nbins_aerosol
4255	IF ( aerosol_number(ib)%conc(k,j,i) < ( 2.0_wp * nclim ) .OR. &
4256	schmidt_num(k+1,ib) < 1.0_wp ) CYCLE
4257
4258	SELECT CASE ( depo_surf_par_num )
4259
4260	CASE ( 1 )
4261	CALL depo_vel_Z01( vc(k+1,ib), surf%us(m), schmidt_num(k+1,ib), &
4262	ra_dry(k,j,i,ib), alpha, gamma, par_a, depo(ib) )
4263	CASE ( 2 )
4264	CALL depo_vel_P10( vc(k+1,ib), mag_u(k+1), surf%us(m), kvis(k+1), &
4265	schmidt_num(k+1,ib), ra_dry(k,j,i,ib), par_l, &
4266	c_brownian_diff, c_interception, c_impaction, beta_im, &
4267	c_turb_impaction, depo(ib) )
4268	END SELECT
4269	ENDDO
4270	depo_sum = depo_sum + surf%frac(ind_wat_win,m) * depo
4271	ENDIF
4272
4273	DO ib = 1, nbins_aerosol
4274	IF ( aerosol_number(ib)%conc(k,j,i) < ( 2.0_wp * nclim ) ) CYCLE
4275	!
4276	!-- Calculate changes in surface fluxes due to dry deposition
4277	IF ( include_emission ) THEN
4278	surf%answs(m,ib) = aerosol_number(ib)%source(j,i) - MAX( 0.0_wp, &
4279	depo_sum(ib) * norm_fac * aerosol_number(ib)%conc(k,j,i) )
4280	DO ic = 1, ncomponents_mass
4281	icc = ( ic - 1 ) * nbins_aerosol + ib
4282	surf%amsws(m,icc) = aerosol_mass(icc)%source(j,i) - MAX( 0.0_wp, &
4283	depo_sum(ib) * norm_fac * aerosol_mass(icc)%conc(k,j,i) )
4284	ENDDO ! ic
4285	ELSE
4286	surf%answs(m,ib) = -depo_sum(ib) * norm_fac * aerosol_number(ib)%conc(k,j,i)
4287	DO ic = 1, ncomponents_mass
4288	icc = ( ic - 1 ) * nbins_aerosol + ib
4289	surf%amsws(m,icc) = -depo_sum(ib) * norm_fac * aerosol_mass(icc)%conc(k,j,i)
4290	ENDDO ! ic
4291	ENDIF
4292	ENDDO ! ib
4293
4294	ENDDO
4295
4296	ELSE ! default surfaces
4297
4298	DO m = surf_s, surf_e
4299
4300	k = surf%k(m)
4301	norm_fac = 1.0_wp
4302
4303	IF ( norm ) norm_fac = rho_air_zw(k) ! normalise vertical fluxes by air density
4304
4305	DO ib = 1, nbins_aerosol
4306	IF ( aerosol_number(ib)%conc(k,j,i) < ( 2.0_wp * nclim ) .OR. &
4307	schmidt_num(k+1,ib) < 1.0_wp ) CYCLE
4308
4309	SELECT CASE ( depo_surf_par_num )
4310
4311	CASE ( 1 )
4312	CALL depo_vel_Z01( vc(k+1,ib), surf%us(m), schmidt_num(k+1,ib), &
4313	ra_dry(k,j,i,ib), alpha, gamma, par_a, depo(ib) )
4314	CASE ( 2 )
4315	CALL depo_vel_P10( vc(k+1,ib), mag_u(k+1), surf%us(m), kvis(k+1), &
4316	schmidt_num(k+1,ib), ra_dry(k,j,i,ib), par_l, &
4317	c_brownian_diff, c_interception, c_impaction, beta_im, &
4318	c_turb_impaction, depo(ib) )
4319	END SELECT
4320	!
4321	!-- Calculate changes in surface fluxes due to dry deposition
4322	IF ( include_emission ) THEN
4323	surf%answs(m,ib) = aerosol_number(ib)%source(j,i) - MAX( 0.0_wp, &
4324	depo(ib) * norm_fac * aerosol_number(ib)%conc(k,j,i) )
4325	DO ic = 1, ncomponents_mass
4326	icc = ( ic - 1 ) * nbins_aerosol + ib
4327	surf%amsws(m,icc) = aerosol_mass(icc)%source(j,i) - MAX( 0.0_wp, &
4328	depo(ib) * norm_fac * aerosol_mass(icc)%conc(k,j,i) )
4329	ENDDO ! ic
4330	ELSE
4331	surf%answs(m,ib) = -depo(ib) * norm_fac * aerosol_number(ib)%conc(k,j,i)
4332	DO ic = 1, ncomponents_mass
4333	icc = ( ic - 1 ) * nbins_aerosol + ib
4334	surf%amsws(m,icc) = -depo(ib) * norm_fac * aerosol_mass(icc)%conc(k,j,i)
4335	ENDDO ! ic
4336	ENDIF
4337	ENDDO ! ib
4338	ENDDO
4339
4340	ENDIF
4341
4342	END SUBROUTINE depo_surf
4343
4344	!------------------------------------------------------------------------------!
4345	! Description:
4346	! ------------
4347	!> Calculates particle loss and change in size distribution due to (Brownian)
4348	!> coagulation. Only for particles with dwet < 30 micrometres.
4349	!
4350	!> Method:
4351	!> Semi-implicit, non-iterative method: (Jacobson, 1994)
4352	!> Volume concentrations of the smaller colliding particles added to the bin of
4353	!> the larger colliding particles. Start from first bin and use the updated
4354	!> number and volume for calculation of following bins. NB! Our bin numbering
4355	!> does not follow particle size in subrange 2.
4356	!
4357	!> Schematic for bin numbers in different subranges:
4358	!> 1 2
4359	!> +-------------------------------------------+
4360	!> a \| 1 \| 2 \| 3 \|\| 4 \| 5 \| 6 \| 7 \| 8 \| 9 \| 10\|\|
4361	!> b \| \|\|11 \|12 \|13 \|14 \| 15 \| 16 \| 17\|\|
4362	!> +-------------------------------------------+
4363	!
4364	!> Exact coagulation coefficients for each pressure level are scaled according
4365	!> to current particle wet size (linear scaling).
4366	!> Bins are organized in terms of the dry size of the condensation nucleus,
4367	!> while coagulation kernell is calculated with the actual hydrometeor
4368	!> size.
4369	!
4370	!> Called from salsa_driver
4371	!> fxm: Process selection should be made smarter - now just lots of IFs inside
4372	!> loops
4373	!
4374	!> Coded by:
4375	!> Hannele Korhonen (FMI) 2005
4376	!> Harri Kokkola (FMI) 2006
4377	!> Tommi Bergman (FMI) 2012
4378	!> Matti Niskanen(FMI) 2012
4379	!> Anton Laakso (FMI) 2013
4380	!> Juha Tonttila (FMI) 2014
4381	!------------------------------------------------------------------------------!
4382	SUBROUTINE coagulation( paero, ptstep, ptemp, ppres )
4383
4384	IMPLICIT NONE
4385
4386	INTEGER(iwp) :: index_2a !< corresponding bin in subrange 2a
4387	INTEGER(iwp) :: index_2b !< corresponding bin in subrange 2b
4388	INTEGER(iwp) :: ib !< loop index
4389	INTEGER(iwp) :: ll !< loop index
4390	INTEGER(iwp) :: mm !< loop index
4391	INTEGER(iwp) :: nn !< loop index
4392
4393	REAL(wp) :: pressi !< pressure
4394	REAL(wp) :: temppi !< temperature
4395	REAL(wp) :: zdpart_mm !< diameter of particle (m)
4396	REAL(wp) :: zdpart_nn !< diameter of particle (m)
4397	REAL(wp) :: zminusterm !< coagulation loss in a bin (1/s)
4398
4399	REAL(wp), INTENT(in) :: ppres !< ambient pressure (Pa)
4400	REAL(wp), INTENT(in) :: ptemp !< ambient temperature (K)
4401	REAL(wp), INTENT(in) :: ptstep !< time step (s)
4402
4403	REAL(wp), DIMENSION(nbins_aerosol) :: zmpart !< approximate mass of particles (kg)
4404	REAL(wp), DIMENSION(maxspec+1) :: zplusterm !< coagulation gain in a bin (for each
4405	!< chemical compound)
4406	REAL(wp), DIMENSION(nbins_aerosol,nbins_aerosol) :: zcc !< updated coagulation coeff. (m3/s)
4407
4408	TYPE(t_section), DIMENSION(nbins_aerosol), INTENT(inout) :: paero !< Aerosol properties
4409
4410	zdpart_mm = 0.0_wp
4411	zdpart_nn = 0.0_wp
4412	!
4413	!-- 1) Coagulation to coarse mode calculated in a simplified way:
4414	!-- CoagSink ~ Dp in continuum subrange --> 'effective' number conc. of coarse particles
4415
4416	!-- 2) Updating coagulation coefficients
4417	!
4418	!-- Aerosol mass (kg). Density of 1500 kg/m3 assumed
4419	zmpart(1:end_subrange_2b) = api6 * ( MIN( paero(1:end_subrange_2b)%dwet, 30.0E-6_wp )**3 ) &
4420	* 1500.0_wp
4421	temppi = ptemp
4422	pressi = ppres
4423	zcc = 0.0_wp
4424	!
4425	!-- Aero-aero coagulation
4426	DO mm = 1, end_subrange_2b ! smaller colliding particle
4427	IF ( paero(mm)%numc < ( 2.0_wp * nclim ) ) CYCLE
4428	DO nn = mm, end_subrange_2b ! larger colliding particle
4429	IF ( paero(nn)%numc < ( 2.0_wp * nclim ) ) CYCLE
4430
4431	zdpart_mm = MIN( paero(mm)%dwet, 30.0E-6_wp ) ! Limit to 30 um
4432	zdpart_nn = MIN( paero(nn)%dwet, 30.0E-6_wp ) ! Limit to 30 um
4433	!
4434	!-- Coagulation coefficient of particles (m3/s)
4435	zcc(mm,nn) = coagc( zdpart_mm, zdpart_nn, zmpart(mm), zmpart(nn), temppi, pressi )
4436	zcc(nn,mm) = zcc(mm,nn)
4437	ENDDO
4438	ENDDO
4439
4440	!
4441	!-- 3) New particle and volume concentrations after coagulation:
4442	!-- Calculated according to Jacobson (2005) eq. 15.9
4443	!
4444	!-- Aerosols in subrange 1a:
4445	DO ib = start_subrange_1a, end_subrange_1a
4446	IF ( paero(ib)%numc < ( 2.0_wp * nclim ) ) CYCLE
4447	zminusterm = 0.0_wp
4448	zplusterm(:) = 0.0_wp
4449	!
4450	!-- Particles lost by coagulation with larger aerosols
4451	DO ll = ib+1, end_subrange_2b
4452	zminusterm = zminusterm + zcc(ib,ll) * paero(ll)%numc
4453	ENDDO
4454	!
4455	!-- Coagulation gain in a bin: change in volume conc. (cm3/cm3):
4456	DO ll = start_subrange_1a, ib - 1
4457	zplusterm(1:2) = zplusterm(1:2) + zcc(ll,ib) * paero(ll)%volc(1:2)
4458	zplusterm(6:7) = zplusterm(6:7) + zcc(ll,ib) * paero(ll)%volc(6:7)
4459	zplusterm(8) = zplusterm(8) + zcc(ll,ib) * paero(ll)%volc(8)
4460	ENDDO
4461	!
4462	!-- Volume and number concentrations after coagulation update [fxm]
4463	paero(ib)%volc(1:2) = ( paero(ib)%volc(1:2) + ptstep * zplusterm(1:2) * paero(ib)%numc ) / &
4464	( 1.0_wp + ptstep * zminusterm )
4465	paero(ib)%volc(6:8) = ( paero(ib)%volc(6:8) + ptstep * zplusterm(6:8) * paero(ib)%numc ) / &
4466	( 1.0_wp + ptstep * zminusterm )
4467	paero(ib)%numc = paero(ib)%numc / ( 1.0_wp + ptstep * zminusterm + 0.5_wp * ptstep * &
4468	zcc(ib,ib) * paero(ib)%numc )
4469	ENDDO
4470	!
4471	!-- Aerosols in subrange 2a:
4472	DO ib = start_subrange_2a, end_subrange_2a
4473	IF ( paero(ib)%numc < ( 2.0_wp * nclim ) ) CYCLE
4474	zminusterm = 0.0_wp
4475	zplusterm(:) = 0.0_wp
4476	!
4477	!-- Find corresponding size bin in subrange 2b
4478	index_2b = ib - start_subrange_2a + start_subrange_2b
4479	!
4480	!-- Particles lost by larger particles in 2a
4481	DO ll = ib+1, end_subrange_2a
4482	zminusterm = zminusterm + zcc(ib,ll) * paero(ll)%numc
4483	ENDDO
4484	!
4485	!-- Particles lost by larger particles in 2b
4486	IF ( .NOT. no_insoluble ) THEN
4487	DO ll = index_2b+1, end_subrange_2b
4488	zminusterm = zminusterm + zcc(ib,ll) * paero(ll)%numc
4489	ENDDO
4490	ENDIF
4491	!
4492	!-- Particle volume gained from smaller particles in subranges 1, 2a and 2b
4493	DO ll = start_subrange_1a, ib-1
4494	zplusterm(1:2) = zplusterm(1:2) + zcc(ll,ib) * paero(ll)%volc(1:2)
4495	zplusterm(6:8) = zplusterm(6:8) + zcc(ll,ib) * paero(ll)%volc(6:8)
4496	ENDDO
4497	!
4498	!-- Particle volume gained from smaller particles in 2a
4499	!-- (Note, for components not included in the previous loop!)
4500	DO ll = start_subrange_2a, ib-1
4501	zplusterm(3:5) = zplusterm(3:5) + zcc(ll,ib)*paero(ll)%volc(3:5)
4502	ENDDO
4503	!
4504	!-- Particle volume gained from smaller (and equal) particles in 2b
4505	IF ( .NOT. no_insoluble ) THEN
4506	DO ll = start_subrange_2b, index_2b
4507	zplusterm(1:8) = zplusterm(1:8) + zcc(ll,ib) * paero(ll)%volc(1:8)
4508	ENDDO
4509	ENDIF
4510	!
4511	!-- Volume and number concentrations after coagulation update [fxm]
4512	paero(ib)%volc(1:8) = ( paero(ib)%volc(1:8) + ptstep * zplusterm(1:8) * paero(ib)%numc ) / &
4513	( 1.0_wp + ptstep * zminusterm )
4514	paero(ib)%numc = paero(ib)%numc / ( 1.0_wp + ptstep * zminusterm + 0.5_wp * ptstep * &
4515	zcc(ib,ib) * paero(ib)%numc )
4516	ENDDO
4517	!
4518	!-- Aerosols in subrange 2b:
4519	IF ( .NOT. no_insoluble ) THEN
4520	DO ib = start_subrange_2b, end_subrange_2b
4521	IF ( paero(ib)%numc < ( 2.0_wp * nclim ) ) CYCLE
4522	zminusterm = 0.0_wp
4523	zplusterm(:) = 0.0_wp
4524	!
4525	!-- Find corresponding size bin in subsubrange 2a
4526	index_2a = ib - start_subrange_2b + start_subrange_2a
4527	!
4528	!-- Particles lost to larger particles in subranges 2b
4529	DO ll = ib + 1, end_subrange_2b
4530	zminusterm = zminusterm + zcc(ib,ll) * paero(ll)%numc
4531	ENDDO
4532	!
4533	!-- Particles lost to larger and equal particles in 2a
4534	DO ll = index_2a, end_subrange_2a
4535	zminusterm = zminusterm + zcc(ib,ll) * paero(ll)%numc
4536	ENDDO
4537	!
4538	!-- Particle volume gained from smaller particles in subranges 1 & 2a
4539	DO ll = start_subrange_1a, index_2a - 1
4540	zplusterm(1:8) = zplusterm(1:8) + zcc(ll,ib) * paero(ll)%volc(1:8)
4541	ENDDO
4542	!
4543	!-- Particle volume gained from smaller particles in 2b
4544	DO ll = start_subrange_2b, ib - 1
4545	zplusterm(1:8) = zplusterm(1:8) + zcc(ll,ib) * paero(ll)%volc(1:8)
4546	ENDDO
4547	!
4548	!-- Volume and number concentrations after coagulation update [fxm]
4549	paero(ib)%volc(1:8) = ( paero(ib)%volc(1:8) + ptstep * zplusterm(1:8) * paero(ib)%numc ) &
4550	/ ( 1.0_wp + ptstep * zminusterm )
4551	paero(ib)%numc = paero(ib)%numc / ( 1.0_wp + ptstep * zminusterm + 0.5_wp * ptstep * &
4552	zcc(ib,ib) * paero(ib)%numc )
4553	ENDDO
4554	ENDIF
4555
4556	END SUBROUTINE coagulation
4557
4558	!------------------------------------------------------------------------------!
4559	! Description:
4560	! ------------
4561	!> Calculation of coagulation coefficients. Extended version of the function
4562	!> originally found in mo_salsa_init.
4563	!
4564	!> J. Tonttila, FMI, 05/2014
4565	!------------------------------------------------------------------------------!
4566	REAL(wp) FUNCTION coagc( diam1, diam2, mass1, mass2, temp, pres )
4567
4568	IMPLICIT NONE
4569
4570	REAL(wp) :: fmdist !< distance of flux matching (m)
4571	REAL(wp) :: knud_p !< particle Knudsen number
4572	REAL(wp) :: mdiam !< mean diameter of colliding particles (m)
4573	REAL(wp) :: mfp !< mean free path of air molecules (m)
4574	REAL(wp) :: visc !< viscosity of air (kg/(m s))
4575
4576	REAL(wp), INTENT(in) :: diam1 !< diameter of colliding particle 1 (m)
4577	REAL(wp), INTENT(in) :: diam2 !< diameter of colliding particle 2 (m)
4578	REAL(wp), INTENT(in) :: mass1 !< mass of colliding particle 1 (kg)
4579	REAL(wp), INTENT(in) :: mass2 !< mass of colliding particle 2 (kg)
4580	REAL(wp), INTENT(in) :: pres !< ambient pressure (Pa?) [fxm]
4581	REAL(wp), INTENT(in) :: temp !< ambient temperature (K)
4582
4583	REAL(wp), DIMENSION (2) :: beta !< Cunningham correction factor
4584	REAL(wp), DIMENSION (2) :: dfpart !< particle diffusion coefficient (m2/s)
4585	REAL(wp), DIMENSION (2) :: diam !< diameters of particles (m)
4586	REAL(wp), DIMENSION (2) :: flux !< flux in continuum and free molec. regime (m/s)
4587	REAL(wp), DIMENSION (2) :: knud !< particle Knudsen number
4588	REAL(wp), DIMENSION (2) :: mpart !< masses of particles (kg)
4589	REAL(wp), DIMENSION (2) :: mtvel !< particle mean thermal velocity (m/s)
4590	REAL(wp), DIMENSION (2) :: omega !< particle mean free path
4591	REAL(wp), DIMENSION (2) :: tva !< temporary variable (m)
4592	!
4593	!-- Initialisation
4594	coagc = 0.0_wp
4595	!
4596	!-- 1) Initializing particle and ambient air variables
4597	diam = (/ diam1, diam2 /) !< particle diameters (m)
4598	mpart = (/ mass1, mass2 /) !< particle masses (kg)
4599	!
4600	!-- Viscosity of air (kg/(m s))
4601	visc = ( 7.44523E-3_wp * temp ** 1.5_wp ) / ( 5093.0_wp * ( temp + 110.4_wp ) )
4602	!
4603	!-- Mean free path of air (m)
4604	mfp = ( 1.656E-10_wp * temp + 1.828E-8_wp ) * ( p_0 + 1325.0_wp ) / pres
4605	!
4606	!-- 2) Slip correction factor for small particles
4607	knud = 2.0_wp * EXP( LOG(mfp) - LOG(diam) )! Knudsen number for air (15.23)
4608	!
4609	!-- Cunningham correction factor (Allen and Raabe, Aerosol Sci. Tech. 4, 269)
4610	beta = 1.0_wp + knud * ( 1.142_wp + 0.558_wp * EXP( -0.999_wp / knud ) )
4611	!
4612	!-- 3) Particle properties
4613	!-- Diffusion coefficient (m2/s) (Jacobson (2005) eq. 15.29)
4614	dfpart = beta * abo * temp / ( 3.0_wp * pi * visc * diam )
4615	!
4616	!-- Mean thermal velocity (m/s) (Jacobson (2005) eq. 15.32)
4617	mtvel = SQRT( ( 8.0_wp * abo * temp ) / ( pi * mpart ) )
4618	!
4619	!-- Particle mean free path (m) (Jacobson (2005) eq. 15.34 )
4620	omega = 8.0_wp * dfpart / ( pi * mtvel )
4621	!
4622	!-- Mean diameter (m)
4623	mdiam = 0.5_wp * ( diam(1) + diam(2) )
4624	!
4625	!-- 4) Calculation of fluxes (Brownian collision kernels) and flux matching
4626	!-- following Jacobson (2005):
4627	!
4628	!-- Flux in continuum regime (m3/s) (eq. 15.28)
4629	flux(1) = 4.0_wp * pi * mdiam * ( dfpart(1) + dfpart(2) )
4630	!
4631	!-- Flux in free molec. regime (m3/s) (eq. 15.31)
4632	flux(2) = pi * SQRT( ( mtvel(1)2 ) + ( mtvel(2)2 ) ) * ( mdiam**2 )
4633	!
4634	!-- temporary variables (m) to calculate flux matching distance (m)
4635	tva(1) = ( ( mdiam + omega(1) )3 - ( mdiam2 + omega(1)*2 ) SQRT( ( mdiam**2 + &
4636	omega(1)*2 ) ) ) / ( 3.0_wp mdiam * omega(1) ) - mdiam
4637	tva(2) = ( ( mdiam + omega(2) )3 - ( mdiam2 + omega(2)*2 ) SQRT( ( mdiam**2 + &
4638	omega(2)*2 ) ) ) / ( 3.0_wp mdiam * omega(2) ) - mdiam
4639	!
4640	!-- Flux matching distance (m): the mean distance from the centre of a sphere reached by particles
4641	!-- that leave sphere's surface and travel a distance of particle mean free path (eq. 15.34)
4642	fmdist = SQRT( tva(1)2 + tva(2)2 )
4643	!
4644	!-- 5) Coagulation coefficient = coalescence efficiency * collision kernel (m3/s) (eq. 15.33).
4645	!-- Here assumed coalescence efficiency 1!!
4646	coagc = flux(1) / ( mdiam / ( mdiam + fmdist) + flux(1) / flux(2) )
4647	!
4648	!-- Corrected collision kernel (Karl et al., 2016 (ACP)): Include van der Waals and viscous forces
4649	IF ( van_der_waals_coagc ) THEN
4650	knud_p = SQRT( omega(1)2 + omega(2)2 ) / mdiam
4651	IF ( knud_p >= 0.1_wp .AND. knud_p <= 10.0_wp ) THEN
4652	coagc = coagc * ( 2.0_wp + 0.4_wp * LOG( knud_p ) )
4653	ELSE
4654	coagc = coagc * 3.0_wp
4655	ENDIF
4656	ENDIF
4657
4658	END FUNCTION coagc
4659
4660	!------------------------------------------------------------------------------!
4661	! Description:
4662	! ------------
4663	!> Calculates the change in particle volume and gas phase
4664	!> concentrations due to nucleation, condensation and dissolutional growth.
4665	!
4666	!> Sulphuric acid and organic vapour: only condensation and no evaporation.
4667	!
4668	!> New gas and aerosol phase concentrations calculated according to Jacobson
4669	!> (1997): Numerical techniques to solve condensational and dissolutional growth
4670	!> equations when growth is coupled to reversible reactions, Aerosol Sci. Tech.,
4671	!> 27, pp 491-498.
4672	!
4673	!> Following parameterization has been used:
4674	!> Molecular diffusion coefficient of condensing vapour (m2/s)
4675	!> (Reid et al. (1987): Properties of gases and liquids, McGraw-Hill, New York.)
4676	!> D = {1.d-7sqrt(1/M_air + 1/M_gas)T^1.75} / &
4677	! {p_atm/p_stand * (d_air^(1/3) + d_gas^(1/3))^2 }
4678	!> M_air = 28.965 : molar mass of air (g/mol)
4679	!> d_air = 19.70 : diffusion volume of air
4680	!> M_h2so4 = 98.08 : molar mass of h2so4 (g/mol)
4681	!> d_h2so4 = 51.96 : diffusion volume of h2so4
4682	!
4683	!> Called from main aerosol model
4684	!> For equations, see Jacobson, Fundamentals of Atmospheric Modeling, 2nd Edition (2005)
4685	!
4686	!> Coded by:
4687	!> Hannele Korhonen (FMI) 2005
4688	!> Harri Kokkola (FMI) 2006
4689	!> Juha Tonttila (FMI) 2014
4690	!> Rewritten to PALM by Mona Kurppa (UHel) 2017
4691	!------------------------------------------------------------------------------!
4692	SUBROUTINE condensation( paero, pc_sa, pc_ocnv, pcocsv, pchno3, pc_nh3, pcw, pcs, ptemp, ppres, &
4693	ptstep, prtcl )
4694
4695	IMPLICIT NONE
4696
4697	INTEGER(iwp) :: ss !< start index
4698	INTEGER(iwp) :: ee !< end index
4699
4700	REAL(wp) :: zcs_ocnv !< condensation sink of nonvolatile organics (1/s)
4701	REAL(wp) :: zcs_ocsv !< condensation sink of semivolatile organics (1/s)
4702	REAL(wp) :: zcs_su !< condensation sink of sulfate (1/s)
4703	REAL(wp) :: zcs_tot !< total condensation sink (1/s) (gases)
4704	REAL(wp) :: zcvap_new1 !< vapour concentration after time step (#/m3): sulphuric acid
4705	REAL(wp) :: zcvap_new2 !< nonvolatile organics
4706	REAL(wp) :: zcvap_new3 !< semivolatile organics
4707	REAL(wp) :: zdfvap !< air diffusion coefficient (m2/s)
4708	REAL(wp) :: zdvap1 !< change in vapour concentration (#/m3): sulphuric acid
4709	REAL(wp) :: zdvap2 !< nonvolatile organics
4710	REAL(wp) :: zdvap3 !< semivolatile organics
4711	REAL(wp) :: zmfp !< mean free path of condensing vapour (m)
4712	REAL(wp) :: zrh !< Relative humidity [0-1]
4713	REAL(wp) :: zvisc !< viscosity of air (kg/(m s))
4714	REAL(wp) :: zn_vs_c !< ratio of nucleation of all mass transfer in the smallest bin
4715	REAL(wp) :: zxocnv !< ratio of organic vapour in 3nm particles
4716	REAL(wp) :: zxsa !< Ratio in 3nm particles: sulphuric acid
4717
4718	REAL(wp), INTENT(in) :: ppres !< ambient pressure (Pa)
4719	REAL(wp), INTENT(in) :: pcs !< Water vapour saturation concentration (kg/m3)
4720	REAL(wp), INTENT(in) :: ptemp !< ambient temperature (K)
4721	REAL(wp), INTENT(in) :: ptstep !< timestep (s)
4722
4723	REAL(wp), INTENT(inout) :: pchno3 !< Gas concentrations (#/m3): nitric acid HNO3
4724	REAL(wp), INTENT(inout) :: pc_nh3 !< ammonia NH3
4725	REAL(wp), INTENT(inout) :: pc_ocnv !< non-volatile organics
4726	REAL(wp), INTENT(inout) :: pcocsv !< semi-volatile organics
4727	REAL(wp), INTENT(inout) :: pc_sa !< sulphuric acid H2SO4
4728	REAL(wp), INTENT(inout) :: pcw !< Water vapor concentration (kg/m3)
4729
4730	REAL(wp), DIMENSION(nbins_aerosol) :: zbeta !< transitional correction factor
4731	REAL(wp), DIMENSION(nbins_aerosol) :: zcolrate !< collision rate (1/s)
4732	REAL(wp), DIMENSION(nbins_aerosol) :: zcolrate_ocnv !< collision rate of OCNV (1/s)
4733	REAL(wp), DIMENSION(start_subrange_1a+1) :: zdfpart !< particle diffusion coef. (m2/s)
4734	REAL(wp), DIMENSION(nbins_aerosol) :: zdvoloc !< change of organics volume
4735	REAL(wp), DIMENSION(nbins_aerosol) :: zdvolsa !< change of sulphate volume
4736	REAL(wp), DIMENSION(2) :: zj3n3 !< Formation massrate of molecules
4737	!< in nucleation, (molec/m3s),
4738	!< 1: H2SO4 and 2: organic vapor
4739	REAL(wp), DIMENSION(nbins_aerosol) :: zknud !< particle Knudsen number
4740
4741	TYPE(component_index), INTENT(in) :: prtcl !< Keeps track which substances are used
4742
4743	TYPE(t_section), DIMENSION(nbins_aerosol), INTENT(inout) :: paero !< Aerosol properties
4744
4745	zj3n3 = 0.0_wp
4746	zrh = pcw / pcs
4747	zxocnv = 0.0_wp
4748	zxsa = 0.0_wp
4749	!
4750	!-- Nucleation
4751	IF ( nsnucl > 0 ) THEN
4752	CALL nucleation( paero, ptemp, zrh, ppres, pc_sa, pc_ocnv, pc_nh3, ptstep, zj3n3, zxsa, &
4753	zxocnv )
4754	ENDIF
4755	!
4756	!-- Condensation on pre-existing particles
4757	IF ( lscndgas ) THEN
4758	!
4759	!-- Initialise:
4760	zdvolsa = 0.0_wp
4761	zdvoloc = 0.0_wp
4762	zcolrate = 0.0_wp
4763	!
4764	!-- 1) Properties of air and condensing gases:
4765	!-- Viscosity of air (kg/(m s)) (Eq. 4.54 in Jabonson (2005))
4766	zvisc = ( 7.44523E-3_wp * ptemp ** 1.5_wp ) / ( 5093.0_wp * ( ptemp + 110.4_wp ) )
4767	!
4768	!-- Diffusion coefficient of air (m2/s)
4769	zdfvap = 5.1111E-10_wp * ptemp ** 1.75_wp * ( p_0 + 1325.0_wp ) / ppres
4770	!
4771	!-- Mean free path (m): same for H2SO4 and organic compounds
4772	zmfp = 3.0_wp * zdfvap * SQRT( pi * amh2so4 / ( 8.0_wp * argas * ptemp ) )
4773	!
4774	!-- 2) Transition regime correction factor zbeta for particles (Fuchs and Sutugin (1971)):
4775	!-- Size of condensing molecule considered only for nucleation mode (3 - 20 nm).
4776	!
4777	!-- Particle Knudsen number: condensation of gases on aerosols
4778	ss = start_subrange_1a
4779	ee = start_subrange_1a+1
4780	zknud(ss:ee) = 2.0_wp * zmfp / ( paero(ss:ee)%dwet + d_sa )
4781	ss = start_subrange_1a+2
4782	ee = end_subrange_2b
4783	zknud(ss:ee) = 2.0_wp * zmfp / paero(ss:ee)%dwet
4784	!
4785	!-- Transitional correction factor: aerosol + gas (the semi-empirical Fuchs- Sutugin
4786	!-- interpolation function (Fuchs and Sutugin, 1971))
4787	zbeta = ( zknud + 1.0_wp ) / ( 0.377_wp * zknud + 1.0_wp + 4.0_wp / ( 3.0_wp * massacc ) * &
4788	( zknud + zknud ** 2 ) )
4789	!
4790	!-- 3) Collision rate of molecules to particles
4791	!-- Particle diffusion coefficient considered only for nucleation mode (3 - 20 nm)
4792	!
4793	!-- Particle diffusion coefficient (m2/s) (e.g. Eq. 15.29 in Jacobson (2005))
4794	zdfpart = abo * ptemp * zbeta(start_subrange_1a:start_subrange_1a+1) / ( 3.0_wp * pi * zvisc&
4795	* paero(start_subrange_1a:start_subrange_1a+1)%dwet)
4796	!
4797	!-- Collision rate (mass-transfer coefficient): gases on aerosols (1/s) (Eq. 16.64 in
4798	!-- Jacobson (2005))
4799	ss = start_subrange_1a
4800	ee = start_subrange_1a+1
4801	zcolrate(ss:ee) = MERGE( 2.0_wp * pi * ( paero(ss:ee)%dwet + d_sa ) * ( zdfvap + zdfpart ) *&
4802	zbeta(ss:ee) * paero(ss:ee)%numc, 0.0_wp, paero(ss:ee)%numc > nclim )
4803	ss = start_subrange_1a+2
4804	ee = end_subrange_2b
4805	zcolrate(ss:ee) = MERGE( 2.0_wp * pi * paero(ss:ee)%dwet * zdfvap * zbeta(ss:ee) * &
4806	paero(ss:ee)%numc, 0.0_wp, paero(ss:ee)%numc > nclim )
4807	!
4808	!-- 4) Condensation sink (1/s)
4809	zcs_tot = SUM( zcolrate ) ! total sink
4810	!
4811	!-- 5) Changes in gas-phase concentrations and particle volume
4812	!
4813	!-- 5.1) Organic vapours
4814	!
4815	!-- 5.1.1) Non-volatile organic compound: condenses onto all bins
4816	IF ( pc_ocnv > 1.0E+10_wp .AND. zcs_tot > 1.0E-30_wp .AND. index_oc > 0 ) &
4817	THEN
4818	!-- Ratio of nucleation vs. condensation rates in the smallest bin
4819	zn_vs_c = 0.0_wp
4820	IF ( zj3n3(2) > 1.0_wp ) THEN
4821	zn_vs_c = ( zj3n3(2) ) / ( zj3n3(2) + pc_ocnv * zcolrate(start_subrange_1a) )
4822	ENDIF
4823	!
4824	!-- Collision rate in the smallest bin, including nucleation and condensation (see
4825	!-- Jacobson (2005), eq. (16.73) )
4826	zcolrate_ocnv = zcolrate
4827	zcolrate_ocnv(start_subrange_1a) = zcolrate_ocnv(start_subrange_1a) + zj3n3(2) / pc_ocnv
4828	!
4829	!-- Total sink for organic vapor
4830	zcs_ocnv = zcs_tot + zj3n3(2) / pc_ocnv
4831	!
4832	!-- New gas phase concentration (#/m3)
4833	zcvap_new2 = pc_ocnv / ( 1.0_wp + ptstep * zcs_ocnv )
4834	!
4835	!-- Change in gas concentration (#/m3)
4836	zdvap2 = pc_ocnv - zcvap_new2
4837	!
4838	!-- Updated vapour concentration (#/m3)
4839	pc_ocnv = zcvap_new2
4840	!
4841	!-- Volume change of particles (m3(OC)/m3(air))
4842	zdvoloc = zcolrate_ocnv(start_subrange_1a:end_subrange_2b) / zcs_ocnv * amvoc * zdvap2
4843	!
4844	!-- Change of volume due to condensation in 1a-2b
4845	paero(start_subrange_1a:end_subrange_2b)%volc(2) = &
4846	paero(start_subrange_1a:end_subrange_2b)%volc(2) + zdvoloc
4847	!
4848	!-- Change of number concentration in the smallest bin caused by nucleation (Jacobson (2005),
4849	!-- eq. (16.75)). If zxocnv = 0, then the chosen nucleation mechanism doesn't take into
4850	!-- account the non-volatile organic vapors and thus the paero doesn't have to be updated.
4851	IF ( zxocnv > 0.0_wp ) THEN
4852	paero(start_subrange_1a)%numc = paero(start_subrange_1a)%numc + zn_vs_c * &
4853	zdvoloc(start_subrange_1a) / amvoc / ( n3 * zxocnv )
4854	ENDIF
4855	ENDIF
4856	!
4857	!-- 5.1.2) Semivolatile organic compound: all bins except subrange 1
4858	zcs_ocsv = SUM( zcolrate(start_subrange_2a:end_subrange_2b) ) !< sink for semi-volatile org.
4859	IF ( pcocsv > 1.0E+10_wp .AND. zcs_ocsv > 1.0E-30 .AND. is_used( prtcl,'OC') ) THEN
4860	!
4861	!-- New gas phase concentration (#/m3)
4862	zcvap_new3 = pcocsv / ( 1.0_wp + ptstep * zcs_ocsv )
4863	!
4864	!-- Change in gas concentration (#/m3)
4865	zdvap3 = pcocsv - zcvap_new3
4866	!
4867	!-- Updated gas concentration (#/m3)
4868	pcocsv = zcvap_new3
4869	!
4870	!-- Volume change of particles (m3(OC)/m3(air))
4871	ss = start_subrange_2a
4872	ee = end_subrange_2b
4873	zdvoloc(ss:ee) = zdvoloc(ss:ee) + zcolrate(ss:ee) / zcs_ocsv * amvoc * zdvap3
4874	!
4875	!-- Change of volume due to condensation in 1a-2b
4876	paero(start_subrange_1a:end_subrange_2b)%volc(2) = &
4877	paero(start_subrange_1a:end_subrange_2b)%volc(2) + zdvoloc
4878	ENDIF
4879	!
4880	!-- 5.2) Sulphate: condensed on all bins
4881	IF ( pc_sa > 1.0E+10_wp .AND. zcs_tot > 1.0E-30_wp .AND. index_so4 > 0 ) THEN
4882	!
4883	!-- Ratio of mass transfer between nucleation and condensation
4884	zn_vs_c = 0.0_wp
4885	IF ( zj3n3(1) > 1.0_wp ) THEN
4886	zn_vs_c = ( zj3n3(1) ) / ( zj3n3(1) + pc_sa * zcolrate(start_subrange_1a) )
4887	ENDIF
4888	!
4889	!-- Collision rate in the smallest bin, including nucleation and condensation (see
4890	!-- Jacobson (2005), eq. (16.73))
4891	zcolrate(start_subrange_1a) = zcolrate(start_subrange_1a) + zj3n3(1) / pc_sa
4892	!
4893	!-- Total sink for sulfate (1/s)
4894	zcs_su = zcs_tot + zj3n3(1) / pc_sa
4895	!
4896	!-- Sulphuric acid:
4897	!-- New gas phase concentration (#/m3)
4898	zcvap_new1 = pc_sa / ( 1.0_wp + ptstep * zcs_su )
4899	!
4900	!-- Change in gas concentration (#/m3)
4901	zdvap1 = pc_sa - zcvap_new1
4902	!
4903	!-- Updating vapour concentration (#/m3)
4904	pc_sa = zcvap_new1
4905	!
4906	!-- Volume change of particles (m3(SO4)/m3(air)) by condensation
4907	zdvolsa = zcolrate(start_subrange_1a:end_subrange_2b) / zcs_su * amvh2so4 * zdvap1
4908	!
4909	!-- Change of volume concentration of sulphate in aerosol [fxm]
4910	paero(start_subrange_1a:end_subrange_2b)%volc(1) = &
4911	paero(start_subrange_1a:end_subrange_2b)%volc(1) + zdvolsa
4912	!
4913	!-- Change of number concentration in the smallest bin caused by nucleation
4914	!-- (Jacobson (2005), equation (16.75))
4915	IF ( zxsa > 0.0_wp ) THEN
4916	paero(start_subrange_1a)%numc = paero(start_subrange_1a)%numc + zn_vs_c * &
4917	zdvolsa(start_subrange_1a) / amvh2so4 / ( n3 * zxsa)
4918	ENDIF
4919	ENDIF
4920	!
4921	!-- Partitioning of H2O, HNO3, and NH3: Dissolutional growth
4922	IF ( lspartition .AND. ( pchno3 > 1.0E+10_wp .OR. pc_nh3 > 1.0E+10_wp ) ) THEN
4923	CALL gpparthno3( ppres, ptemp, paero, pchno3, pc_nh3, pcw, pcs, zbeta, ptstep )
4924	ENDIF
4925	ENDIF
4926	!
4927	!-- Condensation of water vapour
4928	IF ( lscndh2oae ) THEN
4929	CALL gpparth2o( paero, ptemp, ppres, pcs, pcw, ptstep )
4930	ENDIF
4931
4932	END SUBROUTINE condensation
4933
4934	!------------------------------------------------------------------------------!
4935	! Description:
4936	! ------------
4937	!> Calculates the particle number and volume increase, and gas-phase
4938	!> concentration decrease due to nucleation subsequent growth to detectable size
4939	!> of 3 nm.
4940	!
4941	!> Method:
4942	!> When the formed clusters grow by condensation (possibly also by self-
4943	!> coagulation), their number is reduced due to scavenging to pre-existing
4944	!> particles. Thus, the apparent nucleation rate at 3 nm is significantly lower
4945	!> than the real nucleation rate (at ~1 nm).
4946	!
4947	!> Calculation of the formation rate of detectable particles at 3 nm (i.e. J3):
4948	!> nj3 = 1: Kerminen, V.-M. and Kulmala, M. (2002), J. Aerosol Sci.,33, 609-622.
4949	!> nj3 = 2: Lehtinen et al. (2007), J. Aerosol Sci., 38(9), 988-994.
4950	!> nj3 = 3: Anttila et al. (2010), J. Aerosol Sci., 41(7), 621-636.
4951	!
4952	!> c = aerosol of critical radius (1 nm)
4953	!> x = aerosol with radius 3 nm
4954	!> 2 = wet or mean droplet
4955	!
4956	!> Called from subroutine condensation (in module salsa_dynamics_mod.f90)
4957	!
4958	!> Calls one of the following subroutines:
4959	!> - binnucl
4960	!> - ternucl
4961	!> - kinnucl
4962	!> - actnucl
4963	!
4964	!> fxm: currently only sulphuric acid grows particles from 1 to 3 nm
4965	!> (if asked from Markku, this is terribly wrong!!!)
4966	!
4967	!> Coded by:
4968	!> Hannele Korhonen (FMI) 2005
4969	!> Harri Kokkola (FMI) 2006
4970	!> Matti Niskanen(FMI) 2012
4971	!> Anton Laakso (FMI) 2013
4972	!------------------------------------------------------------------------------!
4973
4974	SUBROUTINE nucleation( paero, ptemp, prh, ppres, pc_sa, pc_ocnv, pc_nh3, ptstep, pj3n3, pxsa, &
4975	pxocnv )
4976
4977	IMPLICIT NONE
4978
4979	INTEGER(iwp) :: iteration
4980
4981	REAL(wp) :: zc_h2so4 !< H2SO4 conc. (#/cm3) !UNITS!
4982	REAL(wp) :: zc_org !< organic vapour conc. (#/cm3)
4983	REAL(wp) :: zcc_c !< Cunningham correct factor for c = critical (1nm)
4984	REAL(wp) :: zcc_x !< Cunningham correct factor for x = 3nm
4985	REAL(wp) :: zcoags_c !< coagulation sink (1/s) for c = critical (1nm)
4986	REAL(wp) :: zcoags_x !< coagulation sink (1/s) for x = 3nm
4987	REAL(wp) :: zcoagstot !< total particle losses due to coagulation, including condensation
4988	!< and self-coagulation
4989	REAL(wp) :: zcocnv_local !< organic vapour conc. (#/m3)
4990	REAL(wp) :: zcsink !< condensational sink (#/m2)
4991	REAL(wp) :: zcsa_local !< H2SO4 conc. (#/m3)
4992	REAL(wp) :: zcv_c !< mean relative thermal velocity (m/s) for c = critical (1nm)
4993	REAL(wp) :: zcv_x !< mean relative thermal velocity (m/s) for x = 3nm
4994	REAL(wp) :: zdcrit !< diameter of critical cluster (m)
4995	REAL(wp) :: zdelta_vap !< change of H2SO4 and organic vapour concentration (#/m3)
4996	REAL(wp) :: zdfvap !< air diffusion coefficient (m2/s)
4997	REAL(wp) :: zdmean !< mean diameter of existing particles (m)
4998	REAL(wp) :: zeta !< constant: proportional to ratio of CS/GR (m)
4999	!< (condensation sink / growth rate)
5000	REAL(wp) :: zgamma !< proportionality factor ((nm2*m2)/h)
5001	REAL(wp) :: z_gr_clust !< growth rate of formed clusters (nm/h)
5002	REAL(wp) :: z_gr_tot !< total growth rate
5003	REAL(wp) :: zj3 !< number conc. of formed 3nm particles (#/m3)
5004	REAL(wp) :: zjnuc !< nucleation rate at ~1nm (#/m3s)
5005	REAL(wp) :: z_k_eff !< effective cogulation coefficient for freshly nucleated particles
5006	REAL(wp) :: zknud_c !< Knudsen number for c = critical (1nm)
5007	REAL(wp) :: zknud_x !< Knudsen number for x = 3nm
5008	REAL(wp) :: zkocnv !< lever: zkocnv=1 --> organic compounds involved in nucleation
5009	REAL(wp) :: zksa !< lever: zksa=1 --> H2SO4 involved in nucleation
5010	REAL(wp) :: zlambda !< parameter for adjusting the growth rate due to self-coagulation
5011	REAL(wp) :: zm_c !< particle mass (kg) for c = critical (1nm)
5012	REAL(wp) :: zm_para !< Parameter m for calculating the coagulation sink (Eq. 5&6 in
5013	!< Lehtinen et al. 2007)
5014	REAL(wp) :: zm_x !< particle mass (kg) for x = 3nm
5015	REAL(wp) :: zmfp !< mean free path of condesing vapour(m)
5016	REAL(wp) :: zmixnh3 !< ammonia mixing ratio (ppt)
5017	REAL(wp) :: zmyy !< gas dynamic viscosity (N*s/m2)
5018	REAL(wp) :: z_n_nuc !< number of clusters/particles at the size range d1-dx (#/m3)
5019	REAL(wp) :: znoc !< number of organic molecules in critical cluster
5020	REAL(wp) :: znsa !< number of H2SO4 molecules in critical cluster
5021
5022	REAL(wp), INTENT(in) :: pc_nh3 !< ammonia concentration (#/m3)
5023	REAL(wp), INTENT(in) :: pc_ocnv !< conc. of non-volatile OC (#/m3)
5024	REAL(wp), INTENT(in) :: pc_sa !< sulphuric acid conc. (#/m3)
5025	REAL(wp), INTENT(in) :: ppres !< ambient air pressure (Pa)
5026	REAL(wp), INTENT(in) :: prh !< ambient rel. humidity [0-1]
5027	REAL(wp), INTENT(in) :: ptemp !< ambient temperature (K)
5028	REAL(wp), INTENT(in) :: ptstep !< time step (s) of SALSA
5029
5030	REAL(wp), INTENT(inout) :: pj3n3(2) !< formation mass rate of molecules (molec/m3s) for
5031	!< 1: H2SO4 and 2: organic vapour
5032
5033	REAL(wp), INTENT(out) :: pxocnv !< ratio of non-volatile organic vapours in 3 nm particles
5034	REAL(wp), INTENT(out) :: pxsa !< ratio of H2SO4 in 3 nm aerosol particles
5035
5036	REAL(wp), DIMENSION(nbins_aerosol) :: zbeta !< transitional correction factor
5037	REAL(wp), DIMENSION(nbins_aerosol) :: zcc_2 !< Cunningham correct factor:2
5038	REAL(wp), DIMENSION(nbins_aerosol) :: zcv_2 !< mean relative thermal velocity (m/s): 2
5039	REAL(wp), DIMENSION(nbins_aerosol) :: zcv_c2 !< average velocity after coagulation: c & 2
5040	REAL(wp), DIMENSION(nbins_aerosol) :: zcv_x2 !< average velocity after coagulation: x & 2
5041	REAL(wp), DIMENSION(nbins_aerosol) :: zdc_2 !< particle diffusion coefficient (m2/s): 2
5042	REAL(wp), DIMENSION(nbins_aerosol) :: zdc_c !< particle diffusion coefficient (m2/s): c
5043	REAL(wp), DIMENSION(nbins_aerosol) :: zdc_c2 !< sum of diffusion coef. for c and 2
5044	REAL(wp), DIMENSION(nbins_aerosol) :: zdc_x !< particle diffusion coefficient (m2/s): x
5045	REAL(wp), DIMENSION(nbins_aerosol) :: zdc_x2 !< sum of diffusion coef. for: x & 2
5046	REAL(wp), DIMENSION(nbins_aerosol) :: zgamma_f_2 !< zgamma_f for calculating zomega
5047	REAL(wp), DIMENSION(nbins_aerosol) :: zgamma_f_c !< zgamma_f for calculating zomega
5048	REAL(wp), DIMENSION(nbins_aerosol) :: zgamma_f_x !< zgamma_f for calculating zomega
5049	REAL(wp), DIMENSION(nbins_aerosol) :: z_k_c2 !< coagulation coef. in the continuum
5050	!< regime: c & 2
5051	REAL(wp), DIMENSION(nbins_aerosol) :: z_k_x2 !< coagulation coef. in the continuum
5052	!< regime: x & 2
5053	REAL(wp), DIMENSION(nbins_aerosol) :: zknud !< particle Knudsen number
5054	REAL(wp), DIMENSION(nbins_aerosol) :: zknud_2 !< particle Knudsen number: 2
5055	REAL(wp), DIMENSION(nbins_aerosol) :: zm_2 !< particle mass (kg): 2
5056	REAL(wp), DIMENSION(nbins_aerosol) :: zomega_2c !< zomega (m) for calculating zsigma: c & 2
5057	REAL(wp), DIMENSION(nbins_aerosol) :: zomega_2x !< zomega (m) for calculating zsigma: x & 2
5058	REAL(wp), DIMENSION(nbins_aerosol) :: zomega_c !< zomega (m) for calculating zsigma: c
5059	REAL(wp), DIMENSION(nbins_aerosol) :: zomega_x !< zomega (m) for calculating zsigma: x
5060	REAL(wp), DIMENSION(nbins_aerosol) :: z_r_c2 !< sum of the radii: c & 2
5061	REAL(wp), DIMENSION(nbins_aerosol) :: z_r_x2 !< sum of the radii: x & 2
5062	REAL(wp), DIMENSION(nbins_aerosol) :: zsigma_c2 !<
5063	REAL(wp), DIMENSION(nbins_aerosol) :: zsigma_x2 !<
5064
5065	TYPE(t_section), DIMENSION(nbins_aerosol), INTENT(inout) :: paero !< aerosol properties
5066	!
5067	!-- 1) Nucleation rate (zjnuc) and diameter of critical cluster (zdcrit)
5068	zjnuc = 0.0_wp
5069	znsa = 0.0_wp
5070	znoc = 0.0_wp
5071	zdcrit = 0.0_wp
5072	zksa = 0.0_wp
5073	zkocnv = 0.0_wp
5074
5075	zc_h2so4 = pc_sa * 1.0E-6_wp ! sulphuric acid conc. to #/cm3
5076	zc_org = pc_ocnv * 1.0E-6_wp ! conc. of non-volatile OC to #/cm3
5077	zmixnh3 = pc_nh3 * ptemp * argas / ( ppres * avo )
5078
5079	SELECT CASE ( nsnucl )
5080	!
5081	!-- Binary H2SO4-H2O nucleation
5082	CASE(1)
5083
5084	CALL binnucl( zc_h2so4, ptemp, prh, zjnuc, znsa, znoc, zdcrit, zksa, zkocnv )
5085	!
5086	!-- Activation type nucleation (See Riipinen et al. (2007), Atmos. Chem. Phys., 7(8), 1899-1914)
5087	CASE(2)
5088	!
5089	!-- Nucleation rate (#/(m3 s))
5090	zc_h2so4 = MAX( zc_h2so4, 1.0E4_wp )
5091	zc_h2so4 = MIN( zc_h2so4, 1.0E11_wp )
5092	zjnuc = act_coeff * pc_sa ! (#/(m3 s))
5093	!
5094	!-- Organic compounds not involved when kinetic nucleation is assumed.
5095	zdcrit = 7.9375E-10_wp ! (m)
5096	zkocnv = 0.0_wp
5097	zksa = 1.0_wp
5098	znoc = 0.0_wp
5099	znsa = 2.0_wp
5100	!
5101	!-- Kinetically limited nucleation of (NH4)HSO4 clusters
5102	!-- (See Sihto et al. (2006), Atmos. Chem. Phys., 6(12), 4079-4091.)
5103	CASE(3)
5104	!
5105	!-- Nucleation rate = coagcoeffzpcsa*2 (#/(m3 s))
5106	zc_h2so4 = MAX( zc_h2so4, 1.0E4_wp )
5107	zc_h2so4 = MIN( zc_h2so4, 1.0E11_wp )
5108	zjnuc = 5.0E-13_wp * zc_h2so4*2.0_wp 1.0E+6_wp
5109	!
5110	!-- Organic compounds not involved when kinetic nucleation is assumed.
5111	zdcrit = 7.9375E-10_wp ! (m)
5112	zkocnv = 0.0_wp
5113	zksa = 1.0_wp
5114	znoc = 0.0_wp
5115	znsa = 2.0_wp
5116	!
5117	!-- Ternary H2SO4-H2O-NH3 nucleation
5118	CASE(4)
5119
5120	CALL ternucl( zc_h2so4, zmixnh3, ptemp, prh, zjnuc, znsa, znoc, zdcrit, zksa, zkocnv )
5121	!
5122	!-- Organic nucleation, J~[ORG] or J~[ORG]**2
5123	!-- (See Paasonen et al. (2010), Atmos. Chem. Phys., 10, 11223-11242.)
5124	CASE(5)
5125	!
5126	!-- Homomolecular nuleation rate
5127	zjnuc = 1.3E-7_wp * pc_ocnv ! (1/s) (Paasonen et al. Table 4: median a_org)
5128	!
5129	!-- H2SO4 not involved when pure organic nucleation is assumed.
5130	zdcrit = 1.5E-9 ! (m)
5131	zkocnv = 1.0_wp
5132	zksa = 0.0_wp
5133	znoc = 1.0_wp
5134	znsa = 0.0_wp
5135	!
5136	!-- Sum of H2SO4 and organic activation type nucleation, J~[H2SO4]+[ORG]
5137	!-- (See Paasonen et al. (2010), Atmos. Chem. Phys., 10, 11223-11242)
5138	CASE(6)
5139	!
5140	!-- Nucleation rate (#/m3/s)
5141	zjnuc = 6.1E-7_wp * pc_sa + 0.39E-7_wp * pc_ocnv ! (Paasonen et al. Table 3.)
5142	!
5143	!-- Both organic compounds and H2SO4 are involved when sumnucleation is assumed.
5144	zdcrit = 1.5E-9_wp ! (m)
5145	zkocnv = 1.0_wp
5146	zksa = 1.0_wp
5147	znoc = 1.0_wp
5148	znsa = 1.0_wp
5149	!
5150	!-- Heteromolecular nucleation, J~[H2SO4]*[ORG]
5151	!-- (See Paasonen et al. (2010), Atmos. Chem. Phys., 10, 11223-11242.)
5152	CASE(7)
5153	!
5154	!-- Nucleation rate (#/m3/s)
5155	zjnuc = 4.1E-14_wp * pc_sa * pc_ocnv * 1.0E6_wp ! (Paasonen et al. Table 4: median)
5156	!
5157	!-- Both organic compounds and H2SO4 are involved when heteromolecular nucleation is assumed
5158	zdcrit = 1.5E-9_wp ! (m)
5159	zkocnv = 1.0_wp
5160	zksa = 1.0_wp
5161	znoc = 1.0_wp
5162	znsa = 1.0_wp
5163	!
5164	!-- Homomolecular nucleation of H2SO4 and heteromolecular nucleation of H2SO4 and organic vapour,
5165	!-- J~[H2SO4]*2 + [H2SO4][ORG] (EUCAARI project)
5166	!-- (See Paasonen et al. (2010), Atmos. Chem. Phys., 10, 11223-11242)
5167	CASE(8)
5168	!
5169	!-- Nucleation rate (#/m3/s)
5170	zjnuc = ( 1.1E-14_wp * zc_h2so4*2 + 3.2E-14_wp zc_h2so4 * zc_org ) * 1.0E+6_wp
5171	!
5172	!-- Both organic compounds and H2SO4 are involved when SAnucleation is assumed
5173	zdcrit = 1.5E-9_wp ! (m)
5174	zkocnv = 1.0_wp
5175	zksa = 1.0_wp
5176	znoc = 1.0_wp
5177	znsa = 3.0_wp
5178	!
5179	!-- Homomolecular nucleation of H2SO4 and organic vapour and heteromolecular nucleation of H2SO4
5180	!-- and organic vapour, J~[H2SO4]*2 + [H2SO4][ORG]+[ORG]**2 (EUCAARI project)
5181	CASE(9)
5182	!
5183	!-- Nucleation rate (#/m3/s)
5184	zjnuc = ( 1.4E-14_wp * zc_h2so4*2 + 2.6E-14_wp zc_h2so4 * zc_org + 0.037E-14_wp * &
5185	zc_org*2 ) 1.0E+6_wp
5186	!
5187	!-- Both organic compounds and H2SO4 are involved when SAORGnucleation is assumed
5188	zdcrit = 1.5E-9_wp ! (m)
5189	zkocnv = 1.0_wp
5190	zksa = 1.0_wp
5191	znoc = 3.0_wp
5192	znsa = 3.0_wp
5193
5194	END SELECT
5195
5196	zcsa_local = pc_sa
5197	zcocnv_local = pc_ocnv
5198	!
5199	!-- 2) Change of particle and gas concentrations due to nucleation
5200	!
5201	!-- 2.1) Check that there is enough H2SO4 and organic vapour to produce the nucleation
5202	IF ( nsnucl <= 4 ) THEN
5203	!
5204	!-- If the chosen nucleation scheme is 1-4, nucleation occurs only due to H2SO4. All of the total
5205	!-- vapour concentration that is taking part to the nucleation is there for sulphuric acid
5206	!-- (sa = H2SO4) and non-volatile organic vapour is zero.
5207	pxsa = 1.0_wp ! ratio of sulphuric acid in 3nm particles
5208	pxocnv = 0.0_wp ! ratio of non-volatile origanic vapour
5209	! in 3nm particles
5210	ELSEIF ( nsnucl > 4 ) THEN
5211	!
5212	!-- If the chosen nucleation scheme is 5-9, nucleation occurs due to organic vapour or the
5213	!-- combination of organic vapour and H2SO4. The number of needed molecules depends on the chosen
5214	!-- nucleation type and it has an effect also on the minimum ratio of the molecules present.
5215	IF ( pc_sa * znsa + pc_ocnv * znoc < 1.E-14_wp ) THEN
5216	pxsa = 0.0_wp
5217	pxocnv = 0.0_wp
5218	ELSE
5219	pxsa = pc_sa * znsa / ( pc_sa * znsa + pc_ocnv * znoc )
5220	pxocnv = pc_ocnv * znoc / ( pc_sa * znsa + pc_ocnv * znoc )
5221	ENDIF
5222	ENDIF
5223	!
5224	!-- The change in total vapour concentration is the sum of the concentrations of the vapours taking
5225	!-- part to the nucleation (depends on the chosen nucleation scheme)
5226	zdelta_vap = MIN( zjnuc * ( znoc + znsa ), ( pc_ocnv * zkocnv + pc_sa * zksa ) / ptstep )
5227	!
5228	!-- Nucleation rate J at ~1nm (#/m3s)
5229	zjnuc = zdelta_vap / ( znoc + znsa )
5230	!
5231	!-- H2SO4 concentration after nucleation (#/m3)
5232	zcsa_local = MAX( 1.0_wp, pc_sa - zdelta_vap * pxsa )
5233	!
5234	!-- Non-volative organic vapour concentration after nucleation (#/m3)
5235	zcocnv_local = MAX( 1.0_wp, pc_ocnv - zdelta_vap * pxocnv )
5236	!
5237	!-- 2.2) Formation rate of 3 nm particles (Kerminen & Kulmala, 2002)
5238	!
5239	!-- Growth rate by H2SO4 and organic vapour (nm/h, Eq. 21)
5240	z_gr_clust = 2.3623E-15_wp * SQRT( ptemp ) * ( zcsa_local + zcocnv_local )
5241	!
5242	!-- 2.2.2) Condensational sink of pre-existing particle population
5243	!
5244	!-- Diffusion coefficient (m2/s)
5245	zdfvap = 5.1111E-10_wp * ptemp*1.75_wp ( p_0 + 1325.0_wp ) / ppres
5246	!
5247	!-- Mean free path of condensing vapour (m) (Jacobson (2005), Eq. 15.25 and 16.29)
5248	zmfp = 3.0_wp * zdfvap * SQRT( pi * amh2so4 / ( 8.0_wp * argas * ptemp ) )
5249	!
5250	!-- Knudsen number
5251	zknud = 2.0_wp * zmfp / ( paero(:)%dwet + d_sa )
5252	!
5253	!-- Transitional regime correction factor (zbeta) according to Fuchs and Sutugin (1971) (Eq. 4 in
5254	!-- Kerminen and Kulmala, 2002)
5255	zbeta = ( zknud + 1.0_wp) / ( 0.377_wp * zknud + 1.0_wp + 4.0_wp / ( 3.0_wp * massacc ) * &
5256	( zknud + zknud**2 ) )
5257	!
5258	!-- Condensational sink (#/m2, Eq. 3)
5259	zcsink = SUM( paero(:)%dwet * zbeta * paero(:)%numc )
5260	!
5261	!-- 2.2.3) Parameterised formation rate of detectable 3 nm particles (i.e. J3)
5262	IF ( nj3 == 1 ) THEN ! Kerminen and Kulmala (2002)
5263	!
5264	!-- Constants needed for the parameterisation: dapp = 3 nm and dens_nuc = 1830 kg/m3
5265	IF ( zcsink < 1.0E-30_wp ) THEN
5266	zeta = 0._dp
5267	ELSE
5268	!
5269	!-- Mean diameter of backgroud population (nm)
5270	zdmean = 1.0_wp / SUM( paero(:)%numc ) * SUM( paero(:)%numc * paero(:)%dwet ) * 1.0E+9_wp
5271	!
5272	!-- Proportionality factor (nm2*m2/h) (Eq. 22)
5273	zgamma = 0.23_wp * ( zdcrit * 1.0E+9_wp )*0.2_wp ( zdmean / 150.0_wp )*0.048_wp &
5274	( ptemp / 293.0_wp )*( -0.75_wp ) ( arhoh2so4 / 1000.0_wp )**( -0.33_wp )
5275	!
5276	!-- Factor eta (nm, Eq. 11)
5277	zeta = MIN( zgamma * zcsink / z_gr_clust, zdcrit * 1.0E11_wp )
5278	ENDIF
5279	!
5280	!-- Number conc. of clusters surviving to 3 nm in a time step (#/m3, Eq.14)
5281	zj3 = zjnuc * EXP( MIN( 0.0_wp, zeta / 3.0_wp - zeta / ( zdcrit * 1.0E9_wp ) ) )
5282
5283	ELSEIF ( nj3 > 1 ) THEN ! Lehtinen et al. (2007) or Anttila et al. (2010)
5284	!
5285	!-- Defining the parameter m (zm_para) for calculating the coagulation sink onto background
5286	!-- particles (Eq. 5&6 in Lehtinen et al. 2007). The growth is investigated between
5287	!-- [d1,reglim(1)] = [zdcrit,3nm] and m = LOG( CoagS_dx / CoagX_zdcrit ) / LOG( reglim / zdcrit )
5288	!-- (Lehtinen et al. 2007, Eq. 6).
5289	!-- The steps for the coagulation sink for reglim = 3nm and zdcrit ~= 1nm are explained in
5290	!-- Kulmala et al. (2001). The particles of diameter zdcrit ~1.14 nm and reglim = 3nm are both
5291	!-- in turn the "number 1" variables (Kulmala et al. 2001).
5292	!-- c = critical (1nm), x = 3nm, 2 = wet or mean droplet
5293	!
5294	!-- Sum of the radii, R12 = R1 + R2 (m) of two particles 1 and 2
5295	z_r_c2 = zdcrit / 2.0_wp + paero(:)%dwet / 2.0_wp
5296	z_r_x2 = reglim(1) / 2.0_wp + paero(:)%dwet / 2.0_wp
5297	!
5298	!-- Particle mass (kg) (comes only from H2SO4)
5299	zm_c = 4.0_wp / 3.0_wp * pi * ( zdcrit / 2.0_wp )*3 arhoh2so4
5300	zm_x = 4.0_wp / 3.0_wp * pi * ( reglim(1) / 2.0_wp )*3 arhoh2so4
5301	zm_2 = 4.0_wp / 3.0_wp * pi * ( 0.5_wp * paero(:)%dwet )*3 arhoh2so4
5302	!
5303	!-- Mean relative thermal velocity between the particles (m/s)
5304	zcv_c = SQRT( 8.0_wp * abo * ptemp / ( pi * zm_c ) )
5305	zcv_x = SQRT( 8.0_wp * abo * ptemp / ( pi * zm_x ) )
5306	zcv_2 = SQRT( 8.0_wp * abo * ptemp / ( pi * zm_2 ) )
5307	!
5308	!-- Average velocity after coagulation
5309	zcv_c2(:) = SQRT( zcv_c2 + zcv_22 )
5310	zcv_x2(:) = SQRT( zcv_x2 + zcv_22 )
5311	!
5312	!-- Knudsen number (zmfp = mean free path of condensing vapour)
5313	zknud_c = 2.0_wp * zmfp / zdcrit
5314	zknud_x = 2.0_wp * zmfp / reglim(1)
5315	zknud_2(:) = MAX( 0.0_wp, 2.0_wp * zmfp / paero(:)%dwet )
5316	!
5317	!-- Cunningham correction factors (Allen and Raabe, 1985)
5318	zcc_c = 1.0_wp + zknud_c * ( 1.142_wp + 0.558_wp * EXP( -0.999_wp / zknud_c ) )
5319	zcc_x = 1.0_wp + zknud_x * ( 1.142_wp + 0.558_wp * EXP( -0.999_wp / zknud_x ) )
5320	zcc_2(:) = 1.0_wp + zknud_2(:) * ( 1.142_wp + 0.558_wp * EXP( -0.999_wp / zknud_2(:) ) )
5321	!
5322	!-- Gas dynamic viscosity (Ns/m2). Here, viscocity(air @20C) = 1.81e-5_dp N/m2 s (Hinds, p. 25)
5323	zmyy = 1.81E-5_wp * ( ptemp / 293.0_wp )**0.74_wp
5324	!
5325	!-- Particle diffusion coefficient (m2/s) (continuum regime)
5326	zdc_c(:) = abo * ptemp * zcc_c / ( 3.0_wp * pi * zmyy * zdcrit )
5327	zdc_x(:) = abo * ptemp * zcc_x / ( 3.0_wp * pi * zmyy * reglim(1) )
5328	zdc_2(:) = abo * ptemp * zcc_2(:) / ( 3.0_wp * pi * zmyy * paero(:)%dwet )
5329	!
5330	!-- D12 = D1+D2 (Seinfield and Pandis, 2nd ed. Eq. 13.38)
5331	zdc_c2 = zdc_c + zdc_2
5332	zdc_x2 = zdc_x + zdc_2
5333	!
5334	!-- zgamma_f = 8*D/pi/zcv (m) for calculating zomega (Fuchs, 1964)
5335	zgamma_f_c = 8.0_wp * zdc_c / pi / zcv_c
5336	zgamma_f_x = 8.0_wp * zdc_x / pi / zcv_x
5337	zgamma_f_2 = 8.0_wp * zdc_2 / pi / zcv_2
5338	!
5339	!-- zomega (m) for calculating zsigma
5340	zomega_c = ( ( z_r_c2 + zgamma_f_c )3 - ( z_r_c2 2 + zgamma_f_c )**1.5_wp ) / &
5341	( 3.0_wp * z_r_c2 * zgamma_f_c ) - z_r_c2
5342	zomega_x = ( ( z_r_x2 + zgamma_f_x )3 - ( z_r_x22 + zgamma_f_x )** 1.5_wp ) / &
5343	( 3.0_wp * z_r_x2 * zgamma_f_x ) - z_r_x2
5344	zomega_2c = ( ( z_r_c2 + zgamma_f_2 )3 - ( z_r_c22 + zgamma_f_2 )**1.5_wp ) / &
5345	( 3.0_wp * z_r_c2 * zgamma_f_2 ) - z_r_c2
5346	zomega_2x = ( ( z_r_x2 + zgamma_f_2 )3 - ( z_r_x22 + zgamma_f_2 )**1.5_wp ) / &
5347	( 3.0_wp * z_r_x2 * zgamma_f_2 ) - z_r_x2
5348	!
5349	!-- The distance (m) at which the two fluxes are matched (condensation and coagulation sinks)
5350	zsigma_c2 = SQRT( zomega_c2 + zomega_2c2 )
5351	zsigma_x2 = SQRT( zomega_x2 + zomega_2x2 )
5352	!
5353	!-- Coagulation coefficient in the continuum regime (m*m2/s, Eq. 17 in Kulmala et al., 2001)
5354	z_k_c2 = 4.0_wp * pi * z_r_c2 * zdc_c2 / ( z_r_c2 / ( z_r_c2 + zsigma_c2 ) + &
5355	4.0_wp * zdc_c2 / ( zcv_c2 * z_r_c2 ) )
5356	z_k_x2 = 4.0_wp * pi * z_r_x2 * zdc_x2 / ( z_r_x2 / ( z_r_x2 + zsigma_x2 ) + &
5357	4.0_wp * zdc_x2 / ( zcv_x2 * z_r_x2 ) )
5358	!
5359	!-- Coagulation sink (1/s, Eq. 16 in Kulmala et al., 2001)
5360	zcoags_c = MAX( 1.0E-20_wp, SUM( z_k_c2 * paero(:)%numc ) )
5361	zcoags_x = MAX( 1.0E-20_wp, SUM( z_k_x2 * paero(:)%numc ) )
5362	!
5363	!-- Parameter m for calculating the coagulation sink onto background particles (Eq. 5&6 in
5364	!-- Lehtinen et al. 2007)
5365	zm_para = LOG( zcoags_x / zcoags_c ) / LOG( reglim(1) / zdcrit )
5366	!
5367	!-- Parameter gamma for calculating the formation rate J of particles having
5368	!-- a diameter zdcrit < d < reglim(1) (Anttila et al. 2010, eq. 5 or Lehtinen et al.,2007, eq. 7)
5369	zgamma = ( ( ( reglim(1) / zdcrit )**( zm_para + 1.0_wp ) ) - 1.0_wp ) / ( zm_para + 1.0_wp )
5370
5371	IF ( nj3 == 2 ) THEN ! Lehtinen et al. (2007): coagulation sink
5372	!
5373	!-- Formation rate J before iteration (#/m3s)
5374	zj3 = zjnuc * EXP( MIN( 0.0_wp, -zgamma * zdcrit * zcoags_c / ( z_gr_clust * 1.0E-9_wp / &
5375	60.0_wp**2 ) ) )
5376
5377	ELSEIF ( nj3 == 3 ) THEN ! Anttila et al. (2010): coagulation sink and self-coag.
5378	!
5379	!-- If air is polluted, the self-coagulation becomes important. Self-coagulation of small
5380	!-- particles < 3 nm.
5381	!
5382	!-- "Effective" coagulation coefficient between freshly-nucleated particles:
5383	z_k_eff = 5.0E-16_wp ! m3/s
5384	!
5385	!-- zlambda parameter for "adjusting" the growth rate due to the self-coagulation
5386	zlambda = 6.0_wp
5387
5388	IF ( reglim(1) >= 10.0E-9_wp ) THEN ! for particles >10 nm:
5389	z_k_eff = 5.0E-17_wp
5390	zlambda = 3.0_wp
5391	ENDIF
5392	!
5393	!-- Initial values for coagulation sink and growth rate (m/s)
5394	zcoagstot = zcoags_c
5395	z_gr_tot = z_gr_clust * 1.0E-9_wp / 60.0_wp**2
5396	!
5397	!-- Number of clusters/particles at the size range [d1,dx] (#/m3):
5398	z_n_nuc = zjnuc / zcoagstot !< Initial guess
5399	!
5400	!-- Coagulation sink and growth rate due to self-coagulation:
5401	DO iteration = 1, 5
5402	zcoagstot = zcoags_c + z_k_eff * z_n_nuc * 1.0E-6_wp ! (1/s, Anttila et al., eq. 1)
5403	z_gr_tot = z_gr_clust * 2.77777777E-7_wp + 1.5708E-6_wp * zlambda * zdcrit*3 &
5404	( z_n_nuc * 1.0E-6_wp ) * zcv_c * avo * 2.77777777E-7_wp ! (Eq. 3)
5405	zeta = - zcoagstot / ( ( zm_para + 1.0_wp ) * z_gr_tot * ( zdcrit**zm_para ) ) ! (Eq.7b)
5406	!
5407	!-- Calculate Eq. 7a (Taylor series for the number of particles between [d1,dx])
5408	z_n_nuc = z_n_nuc_tayl( zdcrit, reglim(1), zm_para, zjnuc, zeta, z_gr_tot )
5409	ENDDO
5410	!
5411	!-- Calculate the final values with new z_n_nuc:
5412	zcoagstot = zcoags_c + z_k_eff * z_n_nuc * 1.0E-6_wp ! (1/s)
5413	z_gr_tot = z_gr_clust * 1.0E-9_wp / 3600.0_wp + 1.5708E-6_wp * zlambda * zdcrit*3 &
5414	( z_n_nuc * 1.0E-6_wp ) * zcv_c * avo * 1.0E-9_wp / 3600.0_wp !< (m/s)
5415	zj3 = zjnuc * EXP( MIN( 0.0_wp, -zgamma * zdcrit * zcoagstot / z_gr_tot ) ) ! (#/m3s, Eq.5a)
5416
5417	ENDIF
5418	ENDIF
5419	!
5420	!-- If J3 very small (< 1 #/cm3), neglect particle formation. In real atmosphere this would mean
5421	!-- that clusters form but coagulate to pre-existing particles who gain sulphate. Since
5422	!-- CoagS ~ CS (4piDCS'), we do not* update H2SO4 concentration here but let condensation take
5423	!-- care of it. Formation mass rate of molecules (molec/m3s) for 1: H2SO4 and 2: organic vapour
5424	pj3n3(1) = zj3 * n3 * pxsa
5425	pj3n3(2) = zj3 * n3 * pxocnv
5426
5427	END SUBROUTINE nucleation
5428
5429	!------------------------------------------------------------------------------!
5430	! Description:
5431	! ------------
5432	!> Calculate the nucleation rate and the size of critical clusters assuming
5433	!> binary nucleation.
5434	!> Parametrisation according to Vehkamaki et al. (2002), J. Geophys. Res.,
5435	!> 107(D22), 4622. Called from subroutine nucleation.
5436	!------------------------------------------------------------------------------!
5437	SUBROUTINE binnucl( pc_sa, ptemp, prh, pnuc_rate, pn_crit_sa, pn_crit_ocnv, pd_crit, pk_sa, &
5438	pk_ocnv )
5439
5440	IMPLICIT NONE
5441
5442	REAL(wp) :: za !<
5443	REAL(wp) :: zb !<
5444	REAL(wp) :: zc !<
5445	REAL(wp) :: zcoll !<
5446	REAL(wp) :: zlogsa !< LOG( zpcsa )
5447	REAL(wp) :: zlogrh !< LOG( zrh )
5448	REAL(wp) :: zm1 !<
5449	REAL(wp) :: zm2 !<
5450	REAL(wp) :: zma !<
5451	REAL(wp) :: zmw !<
5452	REAL(wp) :: zntot !< number of molecules in critical cluster
5453	REAL(wp) :: zpcsa !< sulfuric acid concentration
5454	REAL(wp) :: zrh !< relative humidity
5455	REAL(wp) :: zroo !<
5456	REAL(wp) :: zt !< temperature
5457	REAL(wp) :: zv1 !<
5458	REAL(wp) :: zv2 !<
5459	REAL(wp) :: zx !< mole fraction of sulphate in critical cluster
5460	REAL(wp) :: zxmass !<
5461
5462	REAL(wp), INTENT(in) :: pc_sa !< H2SO4 conc. (#/cm3)
5463	REAL(wp), INTENT(in) :: prh !< relative humidity [0-1
5464	REAL(wp), INTENT(in) :: ptemp !< ambient temperature (K)
5465
5466	REAL(wp), INTENT(out) :: pnuc_rate !< nucleation rate (#/(m3 s))
5467	REAL(wp), INTENT(out) :: pn_crit_sa !< number of H2SO4 molecules in cluster (#)
5468	REAL(wp), INTENT(out) :: pn_crit_ocnv !< number of organic molecules in cluster (#)
5469	REAL(wp), INTENT(out) :: pd_crit !< diameter of critical cluster (m)
5470	REAL(wp), INTENT(out) :: pk_sa !< Lever: if pk_sa = 1, H2SO4 is involved in nucleation.
5471	REAL(wp), INTENT(out) :: pk_ocnv !< Lever: if pk_ocnv = 1, organic compounds are involved
5472
5473	pnuc_rate = 0.0_wp
5474	pd_crit = 1.0E-9_wp
5475	!
5476	!-- 1) Checking that we are in the validity range of the parameterization
5477	zpcsa = MAX( pc_sa, 1.0E4_wp )
5478	zpcsa = MIN( zpcsa, 1.0E11_wp )
5479	zrh = MAX( prh, 0.0001_wp )
5480	zrh = MIN( zrh, 1.0_wp )
5481	zt = MAX( ptemp, 190.15_wp )
5482	zt = MIN( zt, 300.15_wp )
5483
5484	zlogsa = LOG( zpcsa )
5485	zlogrh = LOG( prh )
5486	!
5487	!-- 2) Mole fraction of sulphate in a critical cluster (Eq. 11)
5488	zx = 0.7409967177282139_wp - 0.002663785665140117_wp * zt + &
5489	0.002010478847383187_wp * zlogrh - 0.0001832894131464668_wp* zt * zlogrh + &
5490	0.001574072538464286_wp * zlogrh*2 - 0.00001790589121766952_wp zt * zlogrh**2 + &
5491	0.0001844027436573778_wp * zlogrh*3 - 1.503452308794887E-6_wp zt * zlogrh**3 - &
5492	0.003499978417957668_wp * zlogsa + 0.0000504021689382576_wp * zt * zlogsa
5493	!
5494	!-- 3) Nucleation rate (Eq. 12)
5495	pnuc_rate = 0.1430901615568665_wp + 2.219563673425199_wp * zt - &
5496	0.02739106114964264_wp * zt*2 + 0.00007228107239317088_wp zt**3 + &
5497	5.91822263375044_wp / zx + 0.1174886643003278_wp * zlogrh + &
5498	0.4625315047693772_wp * zt * zlogrh - 0.01180591129059253_wp * zt*2 zlogrh + &
5499	0.0000404196487152575_wp * zt*3 zlogrh + &
5500	( 15.79628615047088_wp * zlogrh ) / zx - 0.215553951893509_wp * zlogrh**2 - &
5501	0.0810269192332194_wp * zt * zlogrh**2 + &
5502	0.001435808434184642_wp * zt*2 zlogrh**2 - &
5503	4.775796947178588E-6_wp * zt*3 zlogrh**2 - &
5504	( 2.912974063702185_wp * zlogrh*2 ) / zx - 3.588557942822751_wp zlogrh**3 + &
5505	0.04950795302831703_wp * zt * zlogrh**3 - &
5506	0.0002138195118737068_wp * zt*2 zlogrh**3 + &
5507	3.108005107949533E-7_wp * zt*3 zlogrh**3 - &
5508	( 0.02933332747098296_wp * zlogrh*3 ) / zx + 1.145983818561277_wp zlogsa - &
5509	0.6007956227856778_wp * zt * zlogsa + 0.00864244733283759_wp * zt*2 zlogsa - &
5510	0.00002289467254710888_wp * zt*3 zlogsa - &
5511	( 8.44984513869014_wp * zlogsa ) / zx + 2.158548369286559_wp * zlogrh * zlogsa + &
5512	0.0808121412840917_wp * zt * zlogrh * zlogsa - &
5513	0.0004073815255395214_wp * zt*2 zlogrh * zlogsa - &
5514	4.019572560156515E-7_wp * zt*3 zlogrh * zlogsa + &
5515	( 0.7213255852557236_wp * zlogrh * zlogsa ) / zx + &
5516	1.62409850488771_wp * zlogrh*2 zlogsa - &
5517	0.01601062035325362_wp * zt * zlogrh*2 zlogsa + &
5518	0.00003771238979714162_wpzt2 zlogrh*2 zlogsa + &
5519	3.217942606371182E-8_wp * zt*3 zlogrh*2 zlogsa - &
5520	( 0.01132550810022116_wp * zlogrh*2 zlogsa ) / zx + &
5521	9.71681713056504_wp * zlogsa*2 - 0.1150478558347306_wp zt * zlogsa**2 + &
5522	0.0001570982486038294_wp * zt*2 zlogsa**2 + &
5523	4.009144680125015E-7_wp * zt*3 zlogsa**2 + &
5524	( 0.7118597859976135_wp * zlogsa**2 ) / zx - &
5525	1.056105824379897_wp * zlogrh * zlogsa**2 + &
5526	0.00903377584628419_wp * zt * zlogrh * zlogsa**2 - &
5527	0.00001984167387090606_wp * zt*2 zlogrh * zlogsa**2 + &
5528	2.460478196482179E-8_wp * zt*3 zlogrh * zlogsa**2 - &
5529	( 0.05790872906645181_wp * zlogrh * zlogsa**2 ) / zx - &
5530	0.1487119673397459_wp * zlogsa*3 + 0.002835082097822667_wp zt * zlogsa**3 - &
5531	9.24618825471694E-6_wp * zt*2 zlogsa**3 + &
5532	5.004267665960894E-9_wp * zt*3 zlogsa**3 - &
5533	( 0.01270805101481648_wp * zlogsa**3 ) / zx
5534	!
5535	!-- Nucleation rate in #/(cm3 s)
5536	pnuc_rate = EXP( pnuc_rate )
5537	!
5538	!-- Check the validity of parameterization
5539	IF ( pnuc_rate < 1.0E-7_wp ) THEN
5540	pnuc_rate = 0.0_wp
5541	pd_crit = 1.0E-9_wp
5542	ENDIF
5543	!
5544	!-- 4) Total number of molecules in the critical cluster (Eq. 13)
5545	zntot = - 0.002954125078716302_wp - 0.0976834264241286_wp * zt + &
5546	0.001024847927067835_wp * zt*2 - 2.186459697726116E-6_wp zt**3 - &
5547	0.1017165718716887_wp / zx - 0.002050640345231486_wp * zlogrh - &
5548	0.007585041382707174_wp * zt * zlogrh + 0.0001926539658089536_wp * zt*2 zlogrh - &
5549	6.70429719683894E-7_wp * zt*3 zlogrh - ( 0.2557744774673163_wp * zlogrh ) / zx + &
5550	0.003223076552477191_wp * zlogrh*2 + 0.000852636632240633_wp zt * zlogrh**2 - &
5551	0.00001547571354871789_wp * zt*2 zlogrh**2 + &
5552	5.666608424980593E-8_wp * zt*3 zlogrh**2 + &
5553	( 0.03384437400744206_wp * zlogrh**2 ) / zx + &
5554	0.04743226764572505_wp * zlogrh*3 - 0.0006251042204583412_wp zt * zlogrh**3 + &
5555	2.650663328519478E-6_wp * zt*2 zlogrh**3 - &
5556	3.674710848763778E-9_wp * zt*3 zlogrh**3 - &
5557	( 0.0002672510825259393_wp * zlogrh*3 ) / zx - 0.01252108546759328_wp zlogsa + &
5558	0.005806550506277202_wp * zt * zlogsa - 0.0001016735312443444_wp * zt*2 zlogsa + &
5559	2.881946187214505E-7_wp * zt*3 zlogsa + ( 0.0942243379396279_wp * zlogsa ) / zx - &
5560	0.0385459592773097_wp * zlogrh * zlogsa - &
5561	0.0006723156277391984_wp * zt * zlogrh * zlogsa + &
5562	2.602884877659698E-6_wp * zt*2 zlogrh * zlogsa + &
5563	1.194163699688297E-8_wp * zt*3 zlogrh * zlogsa - &
5564	( 0.00851515345806281_wp * zlogrh * zlogsa ) / zx - &
5565	0.01837488495738111_wp * zlogrh*2 zlogsa + &
5566	0.0001720723574407498_wp * zt * zlogrh*2 zlogsa - &
5567	3.717657974086814E-7_wp * zt*2 zlogrh*2 zlogsa - &
5568	5.148746022615196E-10_wp * zt*3 zlogrh*2 zlogsa + &
5569	( 0.0002686602132926594_wp * zlogrh*2 zlogsa ) / zx - &
5570	0.06199739728812199_wp * zlogsa*2 + 0.000906958053583576_wp zt * zlogsa**2 - &
5571	9.11727926129757E-7_wp * zt*2 zlogsa**2 - &
5572	5.367963396508457E-9_wp * zt*3 zlogsa**2 - &
5573	( 0.007742343393937707_wp * zlogsa**2 ) / zx + &
5574	0.0121827103101659_wp * zlogrh * zlogsa**2 - &
5575	0.0001066499571188091_wp * zt * zlogrh * zlogsa**2 + &
5576	2.534598655067518E-7_wp * zt*2 zlogrh * zlogsa**2 - &
5577	3.635186504599571E-10_wp * zt*3 zlogrh * zlogsa**2 + &
5578	( 0.0006100650851863252_wp * zlogrh * zlogsa **2 ) / zx + &
5579	0.0003201836700403512_wp * zlogsa*3 - 0.0000174761713262546_wp zt * zlogsa**3 + &
5580	6.065037668052182E-8_wp * zt*2 zlogsa**3 - &
5581	1.421771723004557E-11_wp * zt*3 zlogsa**3 + &
5582	( 0.0001357509859501723_wp * zlogsa**3 ) / zx
5583	zntot = EXP( zntot ) ! in #
5584	!
5585	!-- 5) Size of the critical cluster pd_crit (m) (diameter) (Eq. 14)
5586	pn_crit_sa = zx * zntot
5587	pd_crit = 2.0E-9_wp * EXP( -1.6524245_wp + 0.42316402_wp * zx + 0.33466487_wp * LOG( zntot ) )
5588	!
5589	!-- 6) Organic compounds not involved when binary nucleation is assumed
5590	pn_crit_ocnv = 0.0_wp ! number of organic molecules
5591	pk_sa = 1.0_wp ! if = 1, H2SO4 involved in nucleation
5592	pk_ocnv = 0.0_wp ! if = 1, organic compounds involved
5593	!
5594	!-- Set nucleation rate to collision rate
5595	IF ( pn_crit_sa < 4.0_wp ) THEN
5596	!
5597	!-- Volumes of the colliding objects
5598	zma = 96.0_wp ! molar mass of SO4 in g/mol
5599	zmw = 18.0_wp ! molar mass of water in g/mol
5600	zxmass = 1.0_wp ! mass fraction of H2SO4
5601	za = 0.7681724_wp + zxmass * ( 2.1847140_wp + zxmass * &
5602	( 7.1630022_wp + zxmass * &
5603	( -44.31447_wp + zxmass * &
5604	( 88.75606 + zxmass * &
5605	( -75.73729_wp + zxmass * 23.43228_wp ) ) ) ) )
5606	zb = 1.808225E-3_wp + zxmass * ( -9.294656E-3_wp + zxmass * &
5607	( -0.03742148_wp + zxmass * &
5608	( 0.2565321_wp + zxmass * &
5609	( -0.5362872_wp + zxmass * &
5610	( 0.4857736 - zxmass * 0.1629592_wp ) ) ) ) )
5611	zc = - 3.478524E-6_wp + zxmass * ( 1.335867E-5_wp + zxmass * &
5612	( 5.195706E-5_wp + zxmass * &
5613	( -3.717636E-4_wp + zxmass * &
5614	( 7.990811E-4_wp + zxmass * &
5615	( -7.458060E-4_wp + zxmass * 2.58139E-4_wp ) ) ) ) )
5616	!
5617	!-- Density for the sulphuric acid solution (Eq. 10 in Vehkamaki)
5618	zroo = ( za + zt * ( zb + zc * zt ) ) * 1.0E+3_wp ! (kg/m^3
5619	zm1 = 0.098_wp ! molar mass of H2SO4 in kg/mol
5620	zm2 = zm1
5621	zv1 = zm1 / avo / zroo ! volume
5622	zv2 = zv1
5623	!
5624	!-- Collision rate
5625	zcoll = zpcsa * zpcsa * ( 3.0_wp * pi / 4.0_wp )*0.16666666_wp &
5626	SQRT( 6.0_wp * argas * zt / zm1 + 6.0_wp * argas * zt / zm2 ) * &
5627	( zv10.33333333_wp + zv20.33333333_wp )*2 1.0E+6_wp ! m3 -> cm3
5628	zcoll = MIN( zcoll, 1.0E+10_wp )
5629	pnuc_rate = zcoll ! (#/(cm3 s))
5630
5631	ELSE
5632	pnuc_rate = MIN( pnuc_rate, 1.0E+10_wp )
5633	ENDIF
5634	pnuc_rate = pnuc_rate * 1.0E+6_wp ! (#/(m3 s))
5635
5636	END SUBROUTINE binnucl
5637
5638	!------------------------------------------------------------------------------!
5639	! Description:
5640	! ------------
5641	!> Calculate the nucleation rate and the size of critical clusters assuming
5642	!> ternary nucleation. Parametrisation according to:
5643	!> Napari et al. (2002), J. Chem. Phys., 116, 4221-4227 and
5644	!> Napari et al. (2002), J. Geophys. Res., 107(D19), AAC 6-1-ACC 6-6.
5645	!------------------------------------------------------------------------------!
5646	SUBROUTINE ternucl( pc_sa, pc_nh3, ptemp, prh, pnuc_rate, pn_crit_sa, pn_crit_ocnv, pd_crit, &
5647	pk_sa, pk_ocnv )
5648
5649	IMPLICIT NONE
5650
5651	REAL(wp) :: zlnj !< logarithm of nucleation rate
5652	REAL(wp) :: zlognh3 !< LOG( pc_nh3 )
5653	REAL(wp) :: zlogrh !< LOG( prh )
5654	REAL(wp) :: zlogsa !< LOG( pc_sa )
5655
5656	REAL(wp), INTENT(in) :: pc_nh3 !< ammonia mixing ratio (ppt)
5657	REAL(wp), INTENT(in) :: pc_sa !< H2SO4 conc. (#/cm3)
5658	REAL(wp), INTENT(in) :: prh !< relative humidity [0-1]
5659	REAL(wp), INTENT(in) :: ptemp !< ambient temperature (K)
5660
5661	REAL(wp), INTENT(out) :: pd_crit !< diameter of critical cluster (m)
5662	REAL(wp), INTENT(out) :: pk_ocnv !< if pk_ocnv = 1, organic compounds participate in nucleation
5663	REAL(wp), INTENT(out) :: pk_sa !< if pk_sa = 1, H2SO4 participate in nucleation
5664	REAL(wp), INTENT(out) :: pn_crit_ocnv !< number of organic molecules in cluster (#)
5665	REAL(wp), INTENT(out) :: pn_crit_sa !< number of H2SO4 molecules in cluster (#)
5666	REAL(wp), INTENT(out) :: pnuc_rate !< nucleation rate (#/(m3 s))
5667	!
5668	!-- 1) Checking that we are in the validity range of the parameterization.
5669	!-- Validity of parameterization : DO NOT REMOVE!
5670	IF ( ptemp < 240.0_wp .OR. ptemp > 300.0_wp ) THEN
5671	message_string = 'Invalid input value: ptemp'
5672	CALL message( 'salsa_mod: ternucl', 'PA0689', 1, 2, 0, 6, 0 )
5673	ENDIF
5674	IF ( prh < 0.05_wp .OR. prh > 0.95_wp ) THEN
5675	message_string = 'Invalid input value: prh'
5676	CALL message( 'salsa_mod: ternucl', 'PA0649', 1, 2, 0, 6, 0 )
5677	ENDIF
5678	IF ( pc_sa < 1.0E+4_wp .OR. pc_sa > 1.0E+9_wp ) THEN
5679	message_string = 'Invalid input value: pc_sa'
5680	CALL message( 'salsa_mod: ternucl', 'PA0650', 1, 2, 0, 6, 0 )
5681	ENDIF
5682	IF ( pc_nh3 < 0.1_wp .OR. pc_nh3 > 100.0_wp ) THEN
5683	message_string = 'Invalid input value: pc_nh3'
5684	CALL message( 'salsa_mod: ternucl', 'PA0651', 1, 2, 0, 6, 0 )
5685	ENDIF
5686
5687	zlognh3 = LOG( pc_nh3 )
5688	zlogrh = LOG( prh )
5689	zlogsa = LOG( pc_sa )
5690	!
5691	!-- 2) Nucleation rate (Eq. 7 in Napari et al., 2002: Parameterization of
5692	!-- ternary nucleation of sulfuric acid - ammonia - water.
5693	zlnj = - 84.7551114741543_wp + 0.3117595133628944_wp * prh + &
5694	1.640089605712946_wp * prh * ptemp - 0.003438516933381083_wp * prh * ptemp**2 - &
5695	0.00001097530402419113_wp * prh * ptemp**3 - 0.3552967070274677_wp / zlogsa - &
5696	( 0.06651397829765026_wp * prh ) / zlogsa - ( 33.84493989762471_wp * ptemp ) / zlogsa - &
5697	( 7.823815852128623_wp * prh * ptemp ) / zlogsa + &
5698	( 0.3453602302090915_wp * ptemp**2 ) / zlogsa + &
5699	( 0.01229375748100015_wp * prh * ptemp**2 ) / zlogsa - &
5700	( 0.000824007160514956_wp ptemp*3 ) / zlogsa + &
5701	( 0.00006185539100670249_wp * prh * ptemp**3 ) / zlogsa + &
5702	3.137345238574998_wp * zlogsa + 3.680240980277051_wp * prh * zlogsa - &
5703	0.7728606202085936_wp * ptemp * zlogsa - 0.204098217156962_wp * prh * ptemp * zlogsa + &
5704	0.005612037586790018_wp * ptemp*2 zlogsa + &
5705	0.001062588391907444_wp * prh * ptemp*2 zlogsa - &
5706	9.74575691760229E-6_wp * ptemp*3 zlogsa - &
5707	1.265595265137352E-6_wp * prh * ptemp*3 zlogsa + 19.03593713032114_wp * zlogsa**2 - &
5708	0.1709570721236754_wp * ptemp * zlogsa**2 + &
5709	0.000479808018162089_wp * ptemp*2 zlogsa**2 - &
5710	4.146989369117246E-7_wp * ptemp*3 zlogsa*2 + 1.076046750412183_wp zlognh3 + &
5711	0.6587399318567337_wp * prh * zlognh3 + 1.48932164750748_wp * ptemp * zlognh3 + &
5712	0.1905424394695381_wp * prh * ptemp * zlognh3 - &
5713	0.007960522921316015_wp * ptemp*2 zlognh3 - &
5714	0.001657184248661241_wp * prh * ptemp*2 zlognh3 + &
5715	7.612287245047392E-6_wp * ptemp*3 zlognh3 + &
5716	3.417436525881869E-6_wp * prh * ptemp*3 zlognh3 + &
5717	( 0.1655358260404061_wp * zlognh3 ) / zlogsa + &
5718	( 0.05301667612522116_wp * prh * zlognh3 ) / zlogsa + &
5719	( 3.26622914116752_wp * ptemp * zlognh3 ) / zlogsa - &
5720	( 1.988145079742164_wp * prh * ptemp * zlognh3 ) / zlogsa - &
5721	( 0.04897027401984064_wp * ptemp*2 zlognh3 ) / zlogsa + &
5722	( 0.01578269253599732_wp * prh * ptemp*2 zlognh3 ) / zlogsa + &
5723	( 0.0001469672236351303_wp * ptemp*3 zlognh3 ) / zlogsa - &
5724	( 0.00002935642836387197_wp * prh * ptemp*3 zlognh3 ) / zlogsa + &
5725	6.526451177887659_wp * zlogsa * zlognh3 - &
5726	0.2580021816722099_wp * ptemp * zlogsa * zlognh3 + &
5727	0.001434563104474292_wp * ptemp*2 zlogsa * zlognh3 - &
5728	2.020361939304473E-6_wp * ptemp*3 zlogsa * zlognh3 - &
5729	0.160335824596627_wp * zlogsa*2 zlognh3 + &
5730	0.00889880721460806_wp * ptemp * zlogsa*2 zlognh3 - &
5731	0.00005395139051155007_wp * ptemp*2 zlogsa*2 zlognh3 + &
5732	8.39521718689596E-8_wp * ptemp*3 zlogsa*2 zlognh3 + &
5733	6.091597586754857_wp * zlognh3*2 + 8.5786763679309_wp prh * zlognh3**2 - &
5734	1.253783854872055_wp * ptemp * zlognh3**2 - &
5735	0.1123577232346848_wp * prh * ptemp * zlognh3**2 + &
5736	0.00939835595219825_wp * ptemp*2 zlognh3**2 + &
5737	0.0004726256283031513_wp * prh * ptemp*2 zlognh3**2 - &
5738	0.00001749269360523252_wp * ptemp*3 zlognh3**2 - &
5739	6.483647863710339E-7_wp * prh * ptemp*3 zlognh3**2 + &
5740	( 0.7284285726576598_wp * zlognh3**2 ) / zlogsa + &
5741	( 3.647355600846383_wp * ptemp * zlognh3**2 ) / zlogsa - &
5742	( 0.02742195276078021_wp * ptemp*2 zlognh3**2 ) / zlogsa + &
5743	( 0.00004934777934047135_wp * ptemp*3 zlognh3**2 ) / zlogsa + &
5744	41.30162491567873_wp * zlogsa * zlognh3**2 - &
5745	0.357520416800604_wp * ptemp * zlogsa * zlognh3**2 + &
5746	0.000904383005178356_wp * ptemp*2 zlogsa * zlognh3**2 - &
5747	5.737876676408978E-7_wp * ptemp*3 zlogsa * zlognh3**2 - &
5748	2.327363918851818_wp * zlogsa*2 zlognh3**2 + &
5749	0.02346464261919324_wp * ptemp * zlogsa*2 zlognh3**2 - &
5750	0.000076518969516405_wp * ptemp*2 zlogsa*2 zlognh3**2 + &
5751	8.04589834836395E-8_wp * ptemp*3 zlogsa*2 zlognh3**2 - &
5752	0.02007379204248076_wp * zlogrh - 0.7521152446208771_wp * ptemp * zlogrh + &
5753	0.005258130151226247_wp * ptemp*2 zlogrh - &
5754	8.98037634284419E-6_wp * ptemp*3 zlogrh + &
5755	( 0.05993213079516759_wp * zlogrh ) / zlogsa + &
5756	( 5.964746463184173_wp * ptemp * zlogrh ) / zlogsa - &
5757	( 0.03624322255690942_wp * ptemp*2 zlogrh ) / zlogsa + &
5758	( 0.00004933369382462509_wp * ptemp*3 zlogrh ) / zlogsa - &
5759	0.7327310805365114_wp * zlognh3 * zlogrh - &
5760	0.01841792282958795_wp * ptemp * zlognh3 * zlogrh + &
5761	0.0001471855981005184_wp * ptemp*2 zlognh3 * zlogrh - &
5762	2.377113195631848E-7_wp * ptemp*3 zlognh3 * zlogrh
5763	pnuc_rate = EXP( zlnj ) ! (#/(cm3 s))
5764	!
5765	!-- Check validity of parametrization
5766	IF ( pnuc_rate < 1.0E-5_wp ) THEN
5767	pnuc_rate = 0.0_wp
5768	pd_crit = 1.0E-9_wp
5769	ELSEIF ( pnuc_rate > 1.0E6_wp ) THEN
5770	message_string = 'Invalid output value: nucleation rate > 10^6 1/cm3s'
5771	CALL message( 'salsa_mod: ternucl', 'PA0623', 1, 2, 0, 6, 0 )
5772	ENDIF
5773	pnuc_rate = pnuc_rate * 1.0E6_wp ! (#/(m3 s))
5774	!
5775	!-- 3) Number of H2SO4 molecules in a critical cluster (Eq. 9)
5776	pn_crit_sa = 38.16448247950508_wp + 0.7741058259731187_wp * zlnj + &
5777	0.002988789927230632_wp * zlnj*2 - 0.3576046920535017_wp ptemp - &
5778	0.003663583011953248_wp * zlnj * ptemp + 0.000855300153372776_wp * ptemp**2
5779	!
5780	!-- Kinetic limit: at least 2 H2SO4 molecules in a cluster
5781	pn_crit_sa = MAX( pn_crit_sa, 2.0E0_wp )
5782	!
5783	!-- 4) Size of the critical cluster in nm (Eq. 12)
5784	pd_crit = 0.1410271086638381_wp - 0.001226253898894878_wp * zlnj - &
5785	7.822111731550752E-6_wp * zlnj*2 - 0.001567273351921166_wp ptemp - &
5786	0.00003075996088273962_wp * zlnj * ptemp + 0.00001083754117202233_wp * ptemp**2
5787	pd_crit = pd_crit * 2.0E-9_wp ! Diameter in m
5788	!
5789	!-- 5) Organic compounds not involved when ternary nucleation assumed
5790	pn_crit_ocnv = 0.0_wp
5791	pk_sa = 1.0_wp
5792	pk_ocnv = 0.0_wp
5793
5794	END SUBROUTINE ternucl
5795
5796	!------------------------------------------------------------------------------!
5797	! Description:
5798	! ------------
5799	!> Function z_n_nuc_tayl is connected to the calculation of self-coagualtion of
5800	!> small particles. It calculates number of the particles in the size range
5801	!> [zdcrit,dx] using Taylor-expansion (please note that the expansion is not
5802	!> valid for certain rational numbers, e.g. -4/3 and -3/2)
5803	!------------------------------------------------------------------------------!
5804	FUNCTION z_n_nuc_tayl( d1, dx, zm_para, zjnuc_t, zeta, z_gr_tot )
5805
5806	IMPLICIT NONE
5807
5808	INTEGER(iwp) :: i !< running index
5809
5810	REAL(wp) :: d1 !< lower diameter limit
5811	REAL(wp) :: dx !< upper diameter limit
5812	REAL(wp) :: zjnuc_t !< initial nucleation rate (1/s)
5813	REAL(wp) :: zeta !< ratio of CS/GR (m) (condensation sink / growth rate)
5814	REAL(wp) :: term1 !<
5815	REAL(wp) :: term2 !<
5816	REAL(wp) :: term3 !<
5817	REAL(wp) :: term4 !<
5818	REAL(wp) :: term5 !<
5819	REAL(wp) :: z_n_nuc_tayl !< final nucleation rate (1/s)
5820	REAL(wp) :: z_gr_tot !< total growth rate (nm/h)
5821	REAL(wp) :: zm_para !< m parameter in Lehtinen et al. (2007), Eq. 6
5822
5823	z_n_nuc_tayl = 0.0_wp
5824
5825	DO i = 0, 29
5826	IF ( i == 0 .OR. i == 1 ) THEN
5827	term1 = 1.0_wp
5828	ELSE
5829	term1 = term1 * REAL( i, SELECTED_REAL_KIND(12,307) )
5830	END IF
5831	term2 = ( REAL( i, SELECTED_REAL_KIND(12,307) ) * ( zm_para + 1.0_wp ) + 1.0_wp ) * term1
5832	term3 = zeta**i
5833	term4 = term3 / term2
5834	term5 = REAL( i, SELECTED_REAL_KIND(12,307) ) * ( zm_para + 1.0_wp ) + 1.0_wp
5835	z_n_nuc_tayl = z_n_nuc_tayl + term4 * ( dxterm5 - d1term5 )
5836	ENDDO
5837	z_n_nuc_tayl = z_n_nuc_tayl * zjnuc_t * EXP( -zeta * ( d1**( zm_para + 1 ) ) ) / z_gr_tot
5838
5839	END FUNCTION z_n_nuc_tayl
5840
5841	!------------------------------------------------------------------------------!
5842	! Description:
5843	! ------------
5844	!> Calculates the condensation of water vapour on aerosol particles. Follows the
5845	!> analytical predictor method by Jacobson (2005).
5846	!> For equations, see Jacobson (2005), Fundamentals of atmospheric modelling
5847	!> (2nd edition).
5848	!------------------------------------------------------------------------------!
5849	SUBROUTINE gpparth2o( paero, ptemp, ppres, pcs, pcw, ptstep )
5850
5851	IMPLICIT NONE
5852
5853	INTEGER(iwp) :: ib !< loop index
5854	INTEGER(iwp) :: nstr !<
5855
5856	REAL(wp) :: adt !< internal timestep in this subroutine
5857	REAL(wp) :: rhoair !< air density (kg/m3)
5858	REAL(wp) :: ttot !< total time (s)
5859	REAL(wp) :: zact !< Water activity
5860	REAL(wp) :: zaelwc1 !< Current aerosol water content (kg/m3)
5861	REAL(wp) :: zaelwc2 !< New aerosol water content after equilibrium calculation (kg/m3)
5862	REAL(wp) :: zbeta !< Transitional correction factor
5863	REAL(wp) :: zcwc !< Current water vapour mole concentration in aerosols (mol/m3)
5864	REAL(wp) :: zcwint !< Current and new water vapour mole concentrations (mol/m3)
5865	REAL(wp) :: zcwn !< New water vapour mole concentration (mol/m3)
5866	REAL(wp) :: zcwtot !< Total water mole concentration (mol/m3)
5867	REAL(wp) :: zdfh2o !< molecular diffusion coefficient (cm2/s) for water
5868	REAL(wp) :: zhlp1 !< intermediate variable to calculate the mass transfer coefficient
5869	REAL(wp) :: zhlp2 !< intermediate variable to calculate the mass transfer coefficient
5870	REAL(wp) :: zhlp3 !< intermediate variable to calculate the mass transfer coefficient
5871	REAL(wp) :: zknud !< Knudsen number
5872	REAL(wp) :: zmfph2o !< mean free path of H2O gas molecule
5873	REAL(wp) :: zrh !< relative humidity [0-1]
5874	REAL(wp) :: zthcond !< thermal conductivity of air (W/m/K)
5875
5876	REAL(wp), DIMENSION(nbins_aerosol) :: zcwcae !< Current water mole concentrations
5877	REAL(wp), DIMENSION(nbins_aerosol) :: zcwintae !< Current and new aerosol water mole concentration
5878	REAL(wp), DIMENSION(nbins_aerosol) :: zcwnae !< New water mole concentration in aerosols
5879	REAL(wp), DIMENSION(nbins_aerosol) :: zcwsurfae !< Surface mole concentration
5880	REAL(wp), DIMENSION(nbins_aerosol) :: zkelvin !< Kelvin effect
5881	REAL(wp), DIMENSION(nbins_aerosol) :: zmtae !< Mass transfer coefficients
5882	REAL(wp), DIMENSION(nbins_aerosol) :: zwsatae !< Water saturation ratio above aerosols
5883
5884	REAL(wp), INTENT(in) :: ppres !< Air pressure (Pa)
5885	REAL(wp), INTENT(in) :: pcs !< Water vapour saturation concentration (kg/m3)
5886	REAL(wp), INTENT(in) :: ptemp !< Ambient temperature (K)
5887	REAL(wp), INTENT(in) :: ptstep !< timestep (s)
5888
5889	REAL(wp), INTENT(inout) :: pcw !< Water vapour concentration (kg/m3)
5890
5891	TYPE(t_section), DIMENSION(nbins_aerosol), INTENT(inout) :: paero !< Aerosol properties
5892	!
5893	!-- Relative humidity [0-1]
5894	zrh = pcw / pcs
5895	!
5896	!-- Calculate the condensation only for 2a/2b aerosol bins
5897	nstr = start_subrange_2a
5898	!
5899	!-- Save the current aerosol water content, 8 in paero is H2O
5900	zaelwc1 = SUM( paero(start_subrange_1a:end_subrange_2b)%volc(8) ) * arhoh2o
5901	!
5902	!-- Equilibration:
5903	IF ( advect_particle_water ) THEN
5904	IF ( zrh < 0.98_wp .OR. .NOT. lscndh2oae ) THEN
5905	CALL equilibration( zrh, ptemp, paero, .TRUE. )
5906	ELSE
5907	CALL equilibration( zrh, ptemp, paero, .FALSE. )
5908	ENDIF
5909	ENDIF
5910	!
5911	!-- The new aerosol water content after equilibrium calculation
5912	zaelwc2 = SUM( paero(start_subrange_1a:end_subrange_2b)%volc(8) ) * arhoh2o
5913	!
5914	!-- New water vapour mixing ratio (kg/m3)
5915	pcw = pcw - ( zaelwc2 - zaelwc1 ) * ppres * amdair / ( argas * ptemp )
5916	!
5917	!-- Initialise variables
5918	zcwsurfae(:) = 0.0_wp
5919	zhlp1 = 0.0_wp
5920	zhlp2 = 0.0_wp
5921	zhlp3 = 0.0_wp
5922	zmtae(:) = 0.0_wp
5923	zwsatae(:) = 0.0_wp
5924	!
5925	!-- Air:
5926	!-- Density (kg/m3)
5927	rhoair = amdair * ppres / ( argas * ptemp )
5928	!
5929	!-- Thermal conductivity of air
5930	zthcond = 0.023807_wp + 7.1128E-5_wp * ( ptemp - 273.16_wp )
5931	!
5932	!-- Water vapour:
5933	!-- Molecular diffusion coefficient (cm2/s) (eq.16.17)
5934	zdfh2o = ( 5.0_wp / ( 16.0_wp * avo * rhoair * 1.0E-3_wp * 3.11E-8_wp*2 ) ) SQRT( argas * &
5935	1.0E+7_wp * ptemp * amdair * 1.0E+3_wp * ( amh2o + amdair ) * 1.0E+3_wp / &
5936	( pi * amh2o * 2.0E+3_wp ) )
5937	zdfh2o = zdfh2o * 1.0E-4 ! Unit change to m^2/s
5938	!
5939	!-- Mean free path (eq. 15.25 & 16.29)
5940	zmfph2o = 3.0_wp * zdfh2o * SQRT( pi * amh2o / ( 8.0_wp * argas * ptemp ) )
5941	!
5942	!-- Kelvin effect (eq. 16.33)
5943	zkelvin(:) = EXP( 4.0_wp * surfw0 * amh2o / ( argas * ptemp * arhoh2o * paero(:)%dwet) )
5944
5945	DO ib = 1, nbins_aerosol
5946	IF ( paero(ib)%numc > nclim .AND. zrh > 0.98_wp ) THEN
5947	!
5948	!-- Water activity
5949	zact = acth2o( paero(ib) )
5950	!
5951	!-- Saturation mole concentration over flat surface. Limit the super-
5952	!-- saturation to max 1.01 for the mass transfer. Experimental!
5953	zcwsurfae(ib) = MAX( pcs, pcw / 1.01_wp ) * rhoair / amh2o
5954	!
5955	!-- Equilibrium saturation ratio
5956	zwsatae(ib) = zact * zkelvin(ib)
5957	!
5958	!-- Knudsen number (eq. 16.20)
5959	zknud = 2.0_wp * zmfph2o / paero(ib)%dwet
5960	!
5961	!-- Transitional correction factor (Fuks & Sutugin, 1971)
5962	zbeta = ( zknud + 1.0_wp ) / ( 0.377_wp * zknud + 1.0_wp + 4.0_wp / &
5963	( 3.0_wp * massacc(ib) ) * ( zknud + zknud**2 ) )
5964	!
5965	!-- Mass transfer of H2O: Eq. 16.64 but here D^eff = zdfh2o * zbeta
5966	zhlp1 = paero(ib)%numc * 2.0_wp * pi * paero(ib)%dwet * zdfh2o * zbeta
5967	!
5968	!-- 1st term on the left side of the denominator in eq. 16.55
5969	zhlp2 = amh2o * zdfh2o * alv * zwsatae(ib) * zcwsurfae(ib) / ( zthcond * ptemp )
5970	!
5971	!-- 2nd term on the left side of the denominator in eq. 16.55
5972	zhlp3 = ( ( alv * amh2o ) / ( argas * ptemp ) ) - 1.0_wp
5973	!
5974	!-- Full eq. 16.64: Mass transfer coefficient (1/s)
5975	zmtae(ib) = zhlp1 / ( zhlp2 * zhlp3 + 1.0_wp )
5976	ENDIF
5977	ENDDO
5978	!
5979	!-- Current mole concentrations of water
5980	zcwc = pcw * rhoair / amh2o ! as vapour
5981	zcwcae(:) = paero(:)%volc(8) * arhoh2o / amh2o ! in aerosols
5982	zcwtot = zcwc + SUM( zcwcae ) ! total water concentration
5983	zcwnae(:) = 0.0_wp
5984	zcwintae(:) = zcwcae(:)
5985	!
5986	!-- Substepping loop
5987	zcwint = 0.0_wp
5988	ttot = 0.0_wp
5989	DO WHILE ( ttot < ptstep )
5990	adt = 2.0E-2_wp ! internal timestep
5991	!
5992	!-- New vapour concentration: (eq. 16.71)
5993	zhlp1 = zcwc + adt * ( SUM( zmtae(nstr:nbins_aerosol) * zwsatae(nstr:nbins_aerosol) * &
5994	zcwsurfae(nstr:nbins_aerosol) ) ) ! numerator
5995	zhlp2 = 1.0_wp + adt * ( SUM( zmtae(nstr:nbins_aerosol) ) ) ! denomin.
5996	zcwint = zhlp1 / zhlp2 ! new vapour concentration
5997	zcwint = MIN( zcwint, zcwtot )
5998	IF ( ANY( paero(:)%numc > nclim ) .AND. zrh > 0.98_wp ) THEN
5999	DO ib = nstr, nbins_aerosol
6000	zcwintae(ib) = zcwcae(ib) + MIN( MAX( adt * zmtae(ib) * ( zcwint - zwsatae(ib) * &
6001	zcwsurfae(ib) ), -0.02_wp * zcwcae(ib) ), &
6002	0.05_wp * zcwcae(ib) )
6003	zwsatae(ib) = acth2o( paero(ib), zcwintae(ib) ) * zkelvin(ib)
6004	ENDDO
6005	ENDIF
6006	zcwintae(nstr:nbins_aerosol) = MAX( zcwintae(nstr:nbins_aerosol), 0.0_wp )
6007	!
6008	!-- Update vapour concentration for consistency
6009	zcwint = zcwtot - SUM( zcwintae(1:nbins_aerosol) )
6010	!
6011	!-- Update "old" values for next cycle
6012	zcwcae = zcwintae
6013
6014	ttot = ttot + adt
6015
6016	ENDDO ! ADT
6017
6018	zcwn = zcwint
6019	zcwnae(:) = zcwintae(:)
6020	pcw = zcwn * amh2o / rhoair
6021	paero(:)%volc(8) = MAX( 0.0_wp, zcwnae(:) * amh2o / arhoh2o )
6022
6023	END SUBROUTINE gpparth2o
6024
6025	!------------------------------------------------------------------------------!
6026	! Description:
6027	! ------------
6028	!> Calculates the activity coefficient of liquid water
6029	!------------------------------------------------------------------------------!
6030	REAL(wp) FUNCTION acth2o( ppart, pcw )
6031
6032	IMPLICIT NONE
6033
6034	REAL(wp) :: zns !< molar concentration of solutes (mol/m3)
6035	REAL(wp) :: znw !< molar concentration of water (mol/m3)
6036
6037	REAL(wp), INTENT(in), OPTIONAL :: pcw !< molar concentration of water (mol/m3)
6038
6039	TYPE(t_section), INTENT(in) :: ppart !< Aerosol properties of a bin
6040
6041	zns = ( 3.0_wp * ( ppart%volc(1) * arhoh2so4 / amh2so4 ) + ( ppart%volc(2) * arhooc / amoc ) + &
6042	2.0_wp * ( ppart%volc(5) * arhoss / amss ) + ( ppart%volc(6) * arhohno3 / amhno3 ) + &
6043	( ppart%volc(7) * arhonh3 / amnh3 ) )
6044
6045	IF ( PRESENT(pcw) ) THEN
6046	znw = pcw
6047	ELSE
6048	znw = ppart%volc(8) * arhoh2o / amh2o
6049	ENDIF
6050	!
6051	!-- Activity = partial pressure of water vapour / sat. vapour pressure of water over a liquid surface
6052	!-- = molality * activity coefficient (Jacobson, 2005: eq. 17.20-21)
6053	!-- Assume activity coefficient of 1 for water
6054	acth2o = MAX( 0.1_wp, znw / MAX( EPSILON( 1.0_wp ),( znw + zns ) ) )
6055
6056	END FUNCTION acth2o
6057
6058	!------------------------------------------------------------------------------!
6059	! Description:
6060	! ------------
6061	!> Calculates the dissolutional growth of particles (i.e. gas transfers to a
6062	!> particle surface and dissolves in liquid water on the surface). Treated here
6063	!> as a non-equilibrium (time-dependent) process. Gases: HNO3 and NH3
6064	!> (Chapter 17.14 in Jacobson, 2005).
6065	!
6066	!> Called from subroutine condensation.
6067	!> Coded by:
6068	!> Harri Kokkola (FMI)
6069	!------------------------------------------------------------------------------!
6070	SUBROUTINE gpparthno3( ppres, ptemp, paero, pghno3, pgnh3, pcw, pcs, pbeta, ptstep )
6071
6072	IMPLICIT NONE
6073
6074	INTEGER(iwp) :: ib !< loop index
6075
6076	REAL(wp) :: adt !< timestep
6077	REAL(wp) :: zc_nh3_c !< Current NH3 gas concentration
6078	REAL(wp) :: zc_nh3_int !< Intermediate NH3 gas concentration
6079	REAL(wp) :: zc_nh3_n !< New NH3 gas concentration
6080	REAL(wp) :: zc_nh3_tot !< Total NH3 concentration
6081	REAL(wp) :: zc_hno3_c !< Current HNO3 gas concentration
6082	REAL(wp) :: zc_hno3_int !< Intermediate HNO3 gas concentration
6083	REAL(wp) :: zc_hno3_n !< New HNO3 gas concentration
6084	REAL(wp) :: zc_hno3_tot !< Total HNO3 concentration
6085	REAL(wp) :: zdfvap !< Diffusion coefficient for vapors
6086	REAL(wp) :: zhlp1 !< intermediate variable
6087	REAL(wp) :: zhlp2 !< intermediate variable
6088	REAL(wp) :: zrh !< relative humidity
6089
6090	REAL(wp), INTENT(in) :: ppres !< ambient pressure (Pa)
6091	REAL(wp), INTENT(in) :: pcs !< water vapour saturation
6092	!< concentration (kg/m3)
6093	REAL(wp), INTENT(in) :: ptemp !< ambient temperature (K)
6094	REAL(wp), INTENT(in) :: ptstep !< time step (s)
6095
6096	REAL(wp), INTENT(inout) :: pghno3 !< nitric acid concentration (#/m3)
6097	REAL(wp), INTENT(inout) :: pgnh3 !< ammonia conc. (#/m3)
6098	REAL(wp), INTENT(inout) :: pcw !< water vapour concentration (kg/m3)
6099
6100	REAL(wp), DIMENSION(nbins_aerosol) :: zac_hno3_ae !< Activity coefficients for HNO3
6101	REAL(wp), DIMENSION(nbins_aerosol) :: zac_hhso4_ae !< Activity coefficients for HHSO4
6102	REAL(wp), DIMENSION(nbins_aerosol) :: zac_nh3_ae !< Activity coefficients for NH3
6103	REAL(wp), DIMENSION(nbins_aerosol) :: zac_nh4hso2_ae !< Activity coefficients for NH4HSO2
6104	REAL(wp), DIMENSION(nbins_aerosol) :: zcg_hno3_eq_ae !< Equilibrium gas concentration: HNO3
6105	REAL(wp), DIMENSION(nbins_aerosol) :: zcg_nh3_eq_ae !< Equilibrium gas concentration: NH3
6106	REAL(wp), DIMENSION(nbins_aerosol) :: zc_hno3_int_ae !< Intermediate HNO3 aerosol concentration
6107	REAL(wp), DIMENSION(nbins_aerosol) :: zc_hno3_c_ae !< Current HNO3 in aerosols
6108	REAL(wp), DIMENSION(nbins_aerosol) :: zc_hno3_n_ae !< New HNO3 in aerosols
6109	REAL(wp), DIMENSION(nbins_aerosol) :: zc_nh3_int_ae !< Intermediate NH3 aerosol concentration
6110	REAL(wp), DIMENSION(nbins_aerosol) :: zc_nh3_c_ae !< Current NH3 in aerosols
6111	REAL(wp), DIMENSION(nbins_aerosol) :: zc_nh3_n_ae !< New NH3 in aerosols
6112	REAL(wp), DIMENSION(nbins_aerosol) :: zkel_hno3_ae !< Kelvin effect for HNO3
6113	REAL(wp), DIMENSION(nbins_aerosol) :: zkel_nh3_ae !< Kelvin effects for NH3
6114	REAL(wp), DIMENSION(nbins_aerosol) :: zmt_hno3_ae !< Mass transfer coefficients for HNO3
6115	REAL(wp), DIMENSION(nbins_aerosol) :: zmt_nh3_ae !< Mass transfer coefficients for NH3
6116	REAL(wp), DIMENSION(nbins_aerosol) :: zsat_hno3_ae !< HNO3 saturation ratio over a surface
6117	REAL(wp), DIMENSION(nbins_aerosol) :: zsat_nh3_ae !< NH3 saturation ratio over a surface
6118
6119	REAL(wp), DIMENSION(nbins_aerosol,maxspec) :: zion_mols !< Ion molalities from pdfite aerosols
6120
6121	REAL(wp), DIMENSION(nbins_aerosol), INTENT(in) :: pbeta !< transitional correction factor for
6122
6123	TYPE(t_section), DIMENSION(nbins_aerosol), INTENT(inout) :: paero !< Aerosol properties
6124	!
6125	!-- Initialise:
6126	adt = ptstep
6127	zac_hhso4_ae = 0.0_wp
6128	zac_nh3_ae = 0.0_wp
6129	zac_nh4hso2_ae = 0.0_wp
6130	zac_hno3_ae = 0.0_wp
6131	zcg_nh3_eq_ae = 0.0_wp
6132	zcg_hno3_eq_ae = 0.0_wp
6133	zion_mols = 0.0_wp
6134	zsat_nh3_ae = 1.0_wp
6135	zsat_hno3_ae = 1.0_wp
6136	!
6137	!-- Diffusion coefficient (m2/s)
6138	zdfvap = 5.1111E-10_wp * ptemp*1.75_wp ( p_0 + 1325.0_wp ) / ppres
6139	!
6140	!-- Kelvin effects (Jacobson (2005), eq. 16.33)
6141	zkel_hno3_ae(1:nbins_aerosol) = EXP( 4.0_wp * surfw0 * amvhno3 / &
6142	( abo * ptemp * paero(1:nbins_aerosol)%dwet ) )
6143	zkel_nh3_ae(1:nbins_aerosol) = EXP( 4.0_wp * surfw0 * amvnh3 / &
6144	( abo * ptemp * paero(1:nbins_aerosol)%dwet ) )
6145	!
6146	!-- Current vapour mole concentrations (mol/m3)
6147	zc_hno3_c = pghno3 / avo ! HNO3
6148	zc_nh3_c = pgnh3 / avo ! NH3
6149	!
6150	!-- Current particle mole concentrations (mol/m3)
6151	zc_hno3_c_ae(1:nbins_aerosol) = paero(1:nbins_aerosol)%volc(6) * arhohno3 / amhno3
6152	zc_nh3_c_ae(1:nbins_aerosol) = paero(1:nbins_aerosol)%volc(7) * arhonh3 / amnh3
6153	!
6154	!-- Total mole concentrations: gas and particle phase
6155	zc_hno3_tot = zc_hno3_c + SUM( zc_hno3_c_ae(1:nbins_aerosol) )
6156	zc_nh3_tot = zc_nh3_c + SUM( zc_nh3_c_ae(1:nbins_aerosol) )
6157	!
6158	!-- Relative humidity [0-1]
6159	zrh = pcw / pcs
6160	!
6161	!-- Mass transfer coefficients (Jacobson, Eq. 16.64)
6162	zmt_hno3_ae(:) = 2.0_wp * pi * paero(:)%dwet * zdfvap * paero(:)%numc * pbeta(:)
6163	zmt_nh3_ae(:) = 2.0_wp * pi * paero(:)%dwet * zdfvap * paero(:)%numc * pbeta(:)
6164
6165	!
6166	!-- Get the equilibrium concentrations above aerosols
6167	CALL nitrate_ammonium_equilibrium( zrh, ptemp, paero, zcg_hno3_eq_ae, zcg_nh3_eq_ae, &
6168	zac_hno3_ae, zac_nh3_ae, zac_nh4hso2_ae, zac_hhso4_ae, &
6169	zion_mols )
6170	!
6171	!-- Calculate NH3 and HNO3 saturation ratios for aerosols
6172	CALL nitrate_ammonium_saturation( ptemp, paero, zac_hno3_ae, zac_nh4hso2_ae, zac_hhso4_ae, &
6173	zcg_hno3_eq_ae, zc_hno3_c_ae, zc_nh3_c_ae, zkel_hno3_ae, &
6174	zkel_nh3_ae, zsat_hno3_ae, zsat_nh3_ae )
6175	!
6176	!-- Intermediate gas concentrations of HNO3 and NH3
6177	zhlp1 = SUM( zc_hno3_c_ae(:) / ( 1.0_wp + adt * zmt_hno3_ae(:) * zsat_hno3_ae(:) ) )
6178	zhlp2 = SUM( zmt_hno3_ae(:) / ( 1.0_wp + adt * zmt_hno3_ae(:) * zsat_hno3_ae(:) ) )
6179	zc_hno3_int = ( zc_hno3_tot - zhlp1 ) / ( 1.0_wp + adt * zhlp2 )
6180
6181	zhlp1 = SUM( zc_nh3_c_ae(:) / ( 1.0_wp + adt * zmt_nh3_ae(:) * zsat_nh3_ae(:) ) )
6182	zhlp2 = SUM( zmt_nh3_ae(:) / ( 1.0_wp + adt * zmt_nh3_ae(:) * zsat_nh3_ae(:) ) )
6183	zc_nh3_int = ( zc_nh3_tot - zhlp1 )/( 1.0_wp + adt * zhlp2 )
6184
6185	zc_hno3_int = MIN( zc_hno3_int, zc_hno3_tot )
6186	zc_nh3_int = MIN( zc_nh3_int, zc_nh3_tot )
6187	!
6188	!-- Calculate the new concentration on aerosol particles
6189	zc_hno3_int_ae = zc_hno3_c_ae
6190	zc_nh3_int_ae = zc_nh3_c_ae
6191	DO ib = 1, nbins_aerosol
6192	zc_hno3_int_ae(ib) = ( zc_hno3_c_ae(ib) + adt * zmt_hno3_ae(ib) * zc_hno3_int ) / &
6193	( 1.0_wp + adt * zmt_hno3_ae(ib) * zsat_hno3_ae(ib) )
6194	zc_nh3_int_ae(ib) = ( zc_nh3_c_ae(ib) + adt * zmt_nh3_ae(ib) * zc_nh3_int ) / &
6195	( 1.0_wp + adt * zmt_nh3_ae(ib) * zsat_nh3_ae(ib) )
6196	ENDDO
6197
6198	zc_hno3_int_ae(:) = MAX( zc_hno3_int_ae(:), 0.0_wp )
6199	zc_nh3_int_ae(:) = MAX( zc_nh3_int_ae(:), 0.0_wp )
6200	!
6201	!-- Final molar gas concentration and molar particle concentration of HNO3
6202	zc_hno3_n = zc_hno3_int
6203	zc_hno3_n_ae = zc_hno3_int_ae
6204	!
6205	!-- Final molar gas concentration and molar particle concentration of NH3
6206	zc_nh3_n = zc_nh3_int
6207	zc_nh3_n_ae = zc_nh3_int_ae
6208	!
6209	!-- Model timestep reached - update the gas concentrations
6210	pghno3 = zc_hno3_n * avo
6211	pgnh3 = zc_nh3_n * avo
6212	!
6213	!-- Update the particle concentrations
6214	DO ib = start_subrange_1a, end_subrange_2b
6215	paero(ib)%volc(6) = zc_hno3_n_ae(ib) * amhno3 / arhohno3
6216	paero(ib)%volc(7) = zc_nh3_n_ae(ib) * amnh3 / arhonh3
6217	ENDDO
6218
6219	END SUBROUTINE gpparthno3
6220	!------------------------------------------------------------------------------!
6221	! Description:
6222	! ------------
6223	!> Calculate the equilibrium concentrations above aerosols (reference?)
6224	!------------------------------------------------------------------------------!
6225	SUBROUTINE nitrate_ammonium_equilibrium( prh, ptemp, ppart, pcg_hno3_eq, pcg_nh3_eq, pgamma_hno3, &
6226	pgamma_nh4, pgamma_nh4hso2, pgamma_hhso4, pmols )
6227
6228	IMPLICIT NONE
6229
6230	INTEGER(iwp) :: ib !< loop index: aerosol bins
6231
6232	REAL(wp) :: zhlp !< intermediate variable
6233	REAL(wp) :: zp_hcl !< Equilibrium vapor pressures (Pa) of HCl
6234	REAL(wp) :: zp_hno3 !< Equilibrium vapor pressures (Pa) of HNO3
6235	REAL(wp) :: zp_nh3 !< Equilibrium vapor pressures (Pa) of NH3
6236	REAL(wp) :: zwatertotal !< Total water in particles (mol/m3)
6237
6238	REAL(wp), INTENT(in) :: prh !< relative humidity
6239	REAL(wp), INTENT(in) :: ptemp !< ambient temperature (K)
6240
6241	REAL(wp), DIMENSION(maxspec) :: zgammas !< Activity coefficients
6242	REAL(wp), DIMENSION(maxspec) :: zions !< molar concentration of ion (mol/m3)
6243
6244	REAL(wp), DIMENSION(nbins_aerosol), INTENT(inout) :: pcg_nh3_eq !< equilibrium molar
6245	!< concentration: of NH3
6246	REAL(wp), DIMENSION(nbins_aerosol), INTENT(inout) :: pcg_hno3_eq !< of HNO3
6247	REAL(wp), DIMENSION(nbins_aerosol), INTENT(inout) :: pgamma_hhso4 !< activity coeff. of HHSO4
6248	REAL(wp), DIMENSION(nbins_aerosol), INTENT(inout) :: pgamma_nh4 !< activity coeff. of NH3
6249	REAL(wp), DIMENSION(nbins_aerosol), INTENT(inout) :: pgamma_nh4hso2 !< activity coeff. of NH4HSO2
6250	REAL(wp), DIMENSION(nbins_aerosol), INTENT(inout) :: pgamma_hno3 !< activity coeff. of HNO3
6251
6252	REAL(wp), DIMENSION(nbins_aerosol,maxspec), INTENT(inout) :: pmols !< Ion molalities
6253
6254	TYPE(t_section), DIMENSION(nbins_aerosol), INTENT(inout) :: ppart !< Aerosol properties
6255
6256	zgammas = 0.0_wp
6257	zhlp = 0.0_wp
6258	zions = 0.0_wp
6259	zp_hcl = 0.0_wp
6260	zp_hno3 = 0.0_wp
6261	zp_nh3 = 0.0_wp
6262	zwatertotal = 0.0_wp
6263
6264	DO ib = 1, nbins_aerosol
6265
6266	IF ( ppart(ib)%numc < nclim ) CYCLE
6267	!
6268	!-- Ion molar concentrations: 2*H2SO4 + CL + NO3 - Na - NH4
6269	zhlp = 2.0_wp * ppart(ib)%volc(1) * arhoh2so4 / amh2so4 + ppart(ib)%volc(5) * arhoss / amss &
6270	+ ppart(ib)%volc(6) * arhohno3 / amhno3 - ppart(ib)%volc(5) * arhoss / amss - &
6271	ppart(ib)%volc(7) * arhonh3 / amnh3
6272
6273	zions(1) = zhlp ! H+
6274	zions(2) = ppart(ib)%volc(7) * arhonh3 / amnh3 ! NH4+
6275	zions(3) = ppart(ib)%volc(5) * arhoss / amss ! Na+
6276	zions(4) = ppart(ib)%volc(1) * arhoh2so4 / amh2so4 ! SO4(2-)
6277	zions(5) = 0.0_wp ! HSO4-
6278	zions(6) = ppart(ib)%volc(6) * arhohno3 / amhno3 ! NO3-
6279	zions(7) = ppart(ib)%volc(5) * arhoss / amss ! Cl-
6280
6281	zwatertotal = ppart(ib)%volc(8) * arhoh2o / amh2o
6282	IF ( zwatertotal > 1.0E-30_wp ) THEN
6283	CALL inorganic_pdfite( prh, ptemp, zions, zwatertotal, zp_hno3, zp_hcl, zp_nh3, zgammas, &
6284	pmols(ib,:) )
6285	ENDIF
6286	!
6287	!-- Activity coefficients
6288	pgamma_hno3(ib) = zgammas(1) ! HNO3
6289	pgamma_nh4(ib) = zgammas(3) ! NH3
6290	pgamma_nh4hso2(ib) = zgammas(6) ! NH4HSO2
6291	pgamma_hhso4(ib) = zgammas(7) ! HHSO4
6292	!
6293	!-- Equilibrium molar concentrations (mol/m3) from equlibrium pressures (Pa)
6294	pcg_hno3_eq(ib) = zp_hno3 / ( argas * ptemp )
6295	pcg_nh3_eq(ib) = zp_nh3 / ( argas * ptemp )
6296
6297	ENDDO
6298
6299	END SUBROUTINE nitrate_ammonium_equilibrium
6300
6301	!------------------------------------------------------------------------------!
6302	! Description:
6303	! ------------
6304	!> Calculate saturation ratios of NH4 and HNO3 for aerosols
6305	!------------------------------------------------------------------------------!
6306	SUBROUTINE nitrate_ammonium_saturation( ptemp, ppart, pachno3, pacnh4hso2, pachhso4, pchno3eq, &
6307	pchno3, pc_nh3, pkelhno3, pkelnh3, psathno3, psatnh3 )
6308
6309	IMPLICIT NONE
6310
6311	INTEGER(iwp) :: ib !< running index for aerosol bins
6312
6313	REAL(wp) :: k_ll_h2o !< equilibrium constants of equilibrium reactions:
6314	!< H2O(aq) <--> H+ + OH- (mol/kg)
6315	REAL(wp) :: k_ll_nh3 !< NH3(aq) + H2O(aq) <--> NH4+ + OH- (mol/kg)
6316	REAL(wp) :: k_gl_nh3 !< NH3(g) <--> NH3(aq) (mol/kg/atm)
6317	REAL(wp) :: k_gl_hno3 !< HNO3(g) <--> H+ + NO3- (mol2/kg2/atm)
6318	REAL(wp) :: zmol_no3 !< molality of NO3- (mol/kg)
6319	REAL(wp) :: zmol_h !< molality of H+ (mol/kg)
6320	REAL(wp) :: zmol_so4 !< molality of SO4(2-) (mol/kg)
6321	REAL(wp) :: zmol_cl !< molality of Cl- (mol/kg)
6322	REAL(wp) :: zmol_nh4 !< molality of NH4+ (mol/kg)
6323	REAL(wp) :: zmol_na !< molality of Na+ (mol/kg)
6324	REAL(wp) :: zhlp1 !< intermediate variable
6325	REAL(wp) :: zhlp2 !< intermediate variable
6326	REAL(wp) :: zhlp3 !< intermediate variable
6327	REAL(wp) :: zxi !< particle mole concentration ratio: (NH3+SS)/H2SO4
6328	REAL(wp) :: zt0 !< reference temp
6329
6330	REAL(wp), PARAMETER :: a1 = -22.52_wp !<
6331	REAL(wp), PARAMETER :: a2 = -1.50_wp !<
6332	REAL(wp), PARAMETER :: a3 = 13.79_wp !<
6333	REAL(wp), PARAMETER :: a4 = 29.17_wp !<
6334	REAL(wp), PARAMETER :: b1 = 26.92_wp !<
6335	REAL(wp), PARAMETER :: b2 = 26.92_wp !<
6336	REAL(wp), PARAMETER :: b3 = -5.39_wp !<
6337	REAL(wp), PARAMETER :: b4 = 16.84_wp !<
6338	REAL(wp), PARAMETER :: K01 = 1.01E-14_wp !<
6339	REAL(wp), PARAMETER :: K02 = 1.81E-5_wp !<
6340	REAL(wp), PARAMETER :: K03 = 57.64_wp !<
6341	REAL(wp), PARAMETER :: K04 = 2.51E+6_wp !<
6342
6343	REAL(wp), INTENT(in) :: ptemp !< ambient temperature (K)
6344
6345	REAL(wp), DIMENSION(nbins_aerosol), INTENT(in) :: pachhso4 !< activity coeff. of HHSO4
6346	REAL(wp), DIMENSION(nbins_aerosol), INTENT(in) :: pacnh4hso2 !< activity coeff. of NH4HSO2
6347	REAL(wp), DIMENSION(nbins_aerosol), INTENT(in) :: pachno3 !< activity coeff. of HNO3
6348	REAL(wp), DIMENSION(nbins_aerosol), INTENT(in) :: pchno3eq !< eq. surface concentration: HNO3
6349	REAL(wp), DIMENSION(nbins_aerosol), INTENT(in) :: pchno3 !< current particle mole
6350	!< concentration of HNO3 (mol/m3)
6351	REAL(wp), DIMENSION(nbins_aerosol), INTENT(in) :: pc_nh3 !< of NH3 (mol/m3)
6352	REAL(wp), DIMENSION(nbins_aerosol), INTENT(in) :: pkelhno3 !< Kelvin effect for HNO3
6353	REAL(wp), DIMENSION(nbins_aerosol), INTENT(in) :: pkelnh3 !< Kelvin effect for NH3
6354
6355	REAL(wp), DIMENSION(nbins_aerosol), INTENT(out) :: psathno3 !< saturation ratio of HNO3
6356	REAL(wp), DIMENSION(nbins_aerosol), INTENT(out) :: psatnh3 !< saturation ratio of NH3
6357
6358	TYPE(t_section), DIMENSION(nbins_aerosol), INTENT(inout) :: ppart !< Aerosol properties
6359
6360	zmol_cl = 0.0_wp
6361	zmol_h = 0.0_wp
6362	zmol_na = 0.0_wp
6363	zmol_nh4 = 0.0_wp
6364	zmol_no3 = 0.0_wp
6365	zmol_so4 = 0.0_wp
6366	zt0 = 298.15_wp
6367	zxi = 0.0_wp
6368	!
6369	!-- Calculates equlibrium rate constants based on Table B.7 in Jacobson (2005):
6370	!-- K^ll_H20, K^ll_NH3, K^gl_NH3, K^gl_HNO3
6371	zhlp1 = zt0 / ptemp
6372	zhlp2 = zhlp1 - 1.0_wp
6373	zhlp3 = 1.0_wp + LOG( zhlp1 ) - zhlp1
6374
6375	k_ll_h2o = K01 * EXP( a1 * zhlp2 + b1 * zhlp3 )
6376	k_ll_nh3 = K02 * EXP( a2 * zhlp2 + b2 * zhlp3 )
6377	k_gl_nh3 = K03 * EXP( a3 * zhlp2 + b3 * zhlp3 )
6378	k_gl_hno3 = K04 * EXP( a4 * zhlp2 + b4 * zhlp3 )
6379
6380	DO ib = 1, nbins_aerosol
6381
6382	IF ( ppart(ib)%numc > nclim .AND. ppart(ib)%volc(8) > 1.0E-30_wp ) THEN
6383	!
6384	!-- Molality of H+ and NO3-
6385	zhlp1 = pc_nh3(ib) * amnh3 + ppart(ib)%volc(1) * arhoh2so4 + ppart(ib)%volc(2) * arhooc &
6386	+ ppart(ib)%volc(5) * arhoss + ppart(ib)%volc(8) * arhoh2o
6387	zmol_no3 = pchno3(ib) / zhlp1 !< mol/kg
6388	!
6389	!-- Particle mole concentration ratio: (NH3+SS)/H2SO4
6390	zxi = ( pc_nh3(ib) + ppart(ib)%volc(5) * arhoss / amss ) / ( ppart(ib)%volc(1) * &
6391	arhoh2so4 / amh2so4 )
6392
6393	IF ( zxi <= 2.0_wp ) THEN
6394	!
6395	!-- Molality of SO4(2-)
6396	zhlp1 = pc_nh3(ib) * amnh3 + pchno3(ib) * amhno3 + ppart(ib)%volc(2) * arhooc + &
6397	ppart(ib)%volc(5) * arhoss + ppart(ib)%volc(8) * arhoh2o
6398	zmol_so4 = ( ppart(ib)%volc(1) * arhoh2so4 / amh2so4 ) / zhlp1
6399	!
6400	!-- Molality of Cl-
6401	zhlp1 = pc_nh3(ib) * amnh3 + pchno3(ib) * amhno3 + ppart(ib)%volc(2) * arhooc + &
6402	ppart(ib)%volc(1) * arhoh2so4 + ppart(ib)%volc(8) * arhoh2o
6403	zmol_cl = ( ppart(ib)%volc(5) * arhoss / amss ) / zhlp1
6404	!
6405	!-- Molality of NH4+
6406	zhlp1 = pchno3(ib) * amhno3 + ppart(ib)%volc(1) * arhoh2so4 + ppart(ib)%volc(2) * &
6407	arhooc + ppart(ib)%volc(5) * arhoss + ppart(ib)%volc(8) * arhoh2o
6408	zmol_nh4 = pc_nh3(ib) / zhlp1
6409	!
6410	!-- Molality of Na+
6411	zmol_na = zmol_cl
6412	!
6413	!-- Molality of H+
6414	zmol_h = 2.0_wp * zmol_so4 + zmol_no3 + zmol_cl - ( zmol_nh4 + zmol_na )
6415
6416	ELSE
6417
6418	zhlp2 = pkelhno3(ib) * zmol_no3 * pachno3(ib)**2
6419
6420	IF ( zhlp2 > 1.0E-30_wp ) THEN
6421	zmol_h = k_gl_hno3 * pchno3eq(ib) / zhlp2 ! Eq. 17.38
6422	ELSE
6423	zmol_h = 0.0_wp
6424	ENDIF
6425
6426	ENDIF
6427
6428	zhlp1 = ppart(ib)%volc(8) * arhoh2o * argas * ptemp * k_gl_hno3
6429	!
6430	!-- Saturation ratio for NH3 and for HNO3
6431	IF ( zmol_h > 0.0_wp ) THEN
6432	zhlp2 = pkelnh3(ib) / ( zhlp1 * zmol_h )
6433	zhlp3 = k_ll_h2o / ( k_ll_nh3 + k_gl_nh3 )
6434	psatnh3(ib) = zhlp2 * ( ( pacnh4hso2(ib) / pachhso4(ib) )*2 ) zhlp3
6435	psathno3(ib) = ( pkelhno3(ib) * zmol_h * pachno3(ib)**2 ) / zhlp1
6436	ELSE
6437	psatnh3(ib) = 1.0_wp
6438	psathno3(ib) = 1.0_wp
6439	ENDIF
6440	ELSE
6441	psatnh3(ib) = 1.0_wp
6442	psathno3(ib) = 1.0_wp
6443	ENDIF
6444
6445	ENDDO
6446
6447	END SUBROUTINE nitrate_ammonium_saturation
6448
6449	!------------------------------------------------------------------------------!
6450	! Description:
6451	! ------------
6452	!> Prototype module for calculating the water content of a mixed inorganic/
6453	!> organic particle + equilibrium water vapour pressure above the solution
6454	!> (HNO3, HCL, NH3 and representative organic compounds. Efficient calculation
6455	!> of the partitioning of species between gas and aerosol. Based in a chamber
6456	!> study.
6457	!
6458	!> Written by Dave Topping. Pure organic component properties predicted by Mark
6459	!> Barley based on VOCs predicted in MCM simulations performed by Mike Jenkin.
6460	!> Delivered by Gordon McFiggans as Deliverable D22 from WP1.4 in the EU FP6
6461	!> EUCAARI Integrated Project.
6462	!
6463	!> REFERENCES
6464	!> Clegg et al. (1998) A Thermodynamic Model of the System H+-NH4+-Na+-SO42- -NO3--Cl--H2O at
6465	!> 298.15 K, J. Phys. Chem., 102A, 2155-2171.
6466	!> Clegg et al. (2001) Thermodynamic modelling of aqueous aerosols containing electrolytes and
6467	!> dissolved organic compounds. Journal of Aerosol Science 2001;32(6):713-738.
6468	!> Topping et al. (2005a) A curved multi-component aerosol hygroscopicity model framework: Part 1 -
6469	!> Inorganic compounds. Atmospheric Chemistry and Physics 2005;5:1205-1222.
6470	!> Topping et al. (2005b) A curved multi-component aerosol hygroscopicity model framework: Part 2 -
6471	!> Including organic compounds. Atmospheric Chemistry and Physics 2005;5:1223-1242.
6472	!> Wagman et al. (1982). The NBS tables of chemical thermodynamic properties: selected values for
6473	!> inorganic and Câ and Câ organic substances in SI units (book)
6474	!> Zaveri et al. (2005). A new method for multicomponent activity coefficients of electrolytes in
6475	!> aqueous atmospheric aerosols, JGR, 110, D02201, 2005.
6476	!
6477	!> Queries concerning the use of this code through Gordon McFiggans,
6478	!> g.mcfiggans@manchester.ac.uk,
6479	!> Ownership: D. Topping, Centre for Atmospheric Sciences, University of
6480	!> Manchester, 2007
6481	!
6482	!> Rewritten to PALM by Mona Kurppa, UHel, 2017
6483	!------------------------------------------------------------------------------!
6484	SUBROUTINE inorganic_pdfite( rh, temp, ions, water_total, press_hno3, press_hcl, press_nh3, &
6485	gamma_out, mols_out )
6486
6487	IMPLICIT NONE
6488
6489	INTEGER(iwp) :: binary_case
6490	INTEGER(iwp) :: full_complexity
6491
6492	REAL(wp) :: a !< auxiliary variable
6493	REAL(wp) :: act_product !< ionic activity coef. product:
6494	!< = (gamma_h2so43d0) / gamma_hhso42d0)
6495	REAL(wp) :: ammonium_chloride !<
6496	REAL(wp) :: ammonium_chloride_eq_frac !<
6497	REAL(wp) :: ammonium_nitrate !<
6498	REAL(wp) :: ammonium_nitrate_eq_frac !<
6499	REAL(wp) :: ammonium_sulphate !<
6500	REAL(wp) :: ammonium_sulphate_eq_frac !<
6501	REAL(wp) :: b !< auxiliary variable
6502	REAL(wp) :: binary_h2so4 !< binary H2SO4 activity coeff.
6503	REAL(wp) :: binary_hcl !< binary HCL activity coeff.
6504	REAL(wp) :: binary_hhso4 !< binary HHSO4 activity coeff.
6505	REAL(wp) :: binary_hno3 !< binary HNO3 activity coeff.
6506	REAL(wp) :: binary_nh4hso4 !< binary NH4HSO4 activity coeff.
6507	REAL(wp) :: c !< auxiliary variable
6508	REAL(wp) :: charge_sum !< sum of ionic charges
6509	REAL(wp) :: gamma_h2so4 !< activity coefficient
6510	REAL(wp) :: gamma_hcl !< activity coefficient
6511	REAL(wp) :: gamma_hhso4 !< activity coeffient
6512	REAL(wp) :: gamma_hno3 !< activity coefficient
6513	REAL(wp) :: gamma_nh3 !< activity coefficient
6514	REAL(wp) :: gamma_nh4hso4 !< activity coefficient
6515	REAL(wp) :: h_out !<
6516	REAL(wp) :: h_real !< new hydrogen ion conc.
6517	REAL(wp) :: h2so4_hcl !< contribution of H2SO4
6518	REAL(wp) :: h2so4_hno3 !< contribution of H2SO4
6519	REAL(wp) :: h2so4_nh3 !< contribution of H2SO4
6520	REAL(wp) :: h2so4_nh4hso4 !< contribution of H2SO4
6521	REAL(wp) :: hcl_h2so4 !< contribution of HCL
6522	REAL(wp) :: hcl_hhso4 !< contribution of HCL
6523	REAL(wp) :: hcl_hno3 !< contribution of HCL
6524	REAL(wp) :: hcl_nh4hso4 !< contribution of HCL
6525	REAL(wp) :: henrys_temp_dep !< temperature dependence of Henry's Law
6526	REAL(wp) :: hno3_h2so4 !< contribution of HNO3
6527	REAL(wp) :: hno3_hcl !< contribution of HNO3
6528	REAL(wp) :: hno3_hhso4 !< contribution of HNO3
6529	REAL(wp) :: hno3_nh3 !< contribution of HNO3
6530	REAL(wp) :: hno3_nh4hso4 !< contribution of HNO3
6531	REAL(wp) :: hso4_out !<
6532	REAL(wp) :: hso4_real !< new bisulphate ion conc.
6533	REAL(wp) :: hydrochloric_acid !<
6534	REAL(wp) :: hydrochloric_acid_eq_frac !<
6535	REAL(wp) :: k_h !< equilibrium constant for H+
6536	REAL(wp) :: k_hcl !< equilibrium constant of HCL
6537	REAL(wp) :: k_hno3 !< equilibrium constant of HNO3
6538	REAL(wp) :: k_nh4 !< equilibrium constant for NH4+
6539	REAL(wp) :: k_h2o !< equil. const. for water_surface
6540	REAL(wp) :: ln_h2so4_act !< gamma_h2so4 = EXP(ln_h2so4_act)
6541	REAL(wp) :: ln_HCL_act !< gamma_hcl = EXP( ln_HCL_act )
6542	REAL(wp) :: ln_hhso4_act !< gamma_hhso4 = EXP(ln_hhso4_act)
6543	REAL(wp) :: ln_hno3_act !< gamma_hno3 = EXP( ln_hno3_act )
6544	REAL(wp) :: ln_nh4hso4_act !< gamma_nh4hso4 = EXP( ln_nh4hso4_act )
6545	REAL(wp) :: molality_ratio_nh3 !< molality ratio of NH3 (NH4+ and H+)
6546	REAL(wp) :: na2so4_h2so4 !< contribution of Na2SO4
6547	REAL(wp) :: na2so4_hcl !< contribution of Na2SO4
6548	REAL(wp) :: na2so4_hhso4 !< contribution of Na2SO4
6549	REAL(wp) :: na2so4_hno3 !< contribution of Na2SO4
6550	REAL(wp) :: na2so4_nh3 !< contribution of Na2SO4
6551	REAL(wp) :: na2so4_nh4hso4 !< contribution of Na2SO4
6552	REAL(wp) :: nacl_h2so4 !< contribution of NaCl
6553	REAL(wp) :: nacl_hcl !< contribution of NaCl
6554	REAL(wp) :: nacl_hhso4 !< contribution of NaCl
6555	REAL(wp) :: nacl_hno3 !< contribution of NaCl
6556	REAL(wp) :: nacl_nh3 !< contribution of NaCl
6557	REAL(wp) :: nacl_nh4hso4 !< contribution of NaCl
6558	REAL(wp) :: nano3_h2so4 !< contribution of NaNO3
6559	REAL(wp) :: nano3_hcl !< contribution of NaNO3
6560	REAL(wp) :: nano3_hhso4 !< contribution of NaNO3
6561	REAL(wp) :: nano3_hno3 !< contribution of NaNO3
6562	REAL(wp) :: nano3_nh3 !< contribution of NaNO3
6563	REAL(wp) :: nano3_nh4hso4 !< contribution of NaNO3
6564	REAL(wp) :: nh42so4_h2so4 !< contribution of NH42SO4
6565	REAL(wp) :: nh42so4_hcl !< contribution of NH42SO4
6566	REAL(wp) :: nh42so4_hhso4 !< contribution of NH42SO4
6567	REAL(wp) :: nh42so4_hno3 !< contribution of NH42SO4
6568	REAL(wp) :: nh42so4_nh3 !< contribution of NH42SO4
6569	REAL(wp) :: nh42so4_nh4hso4 !< contribution of NH42SO4
6570	REAL(wp) :: nh4cl_h2so4 !< contribution of NH4Cl
6571	REAL(wp) :: nh4cl_hcl !< contribution of NH4Cl
6572	REAL(wp) :: nh4cl_hhso4 !< contribution of NH4Cl
6573	REAL(wp) :: nh4cl_hno3 !< contribution of NH4Cl
6574	REAL(wp) :: nh4cl_nh3 !< contribution of NH4Cl
6575	REAL(wp) :: nh4cl_nh4hso4 !< contribution of NH4Cl
6576	REAL(wp) :: nh4no3_h2so4 !< contribution of NH4NO3
6577	REAL(wp) :: nh4no3_hcl !< contribution of NH4NO3
6578	REAL(wp) :: nh4no3_hhso4 !< contribution of NH4NO3
6579	REAL(wp) :: nh4no3_hno3 !< contribution of NH4NO3
6580	REAL(wp) :: nh4no3_nh3 !< contribution of NH4NO3
6581	REAL(wp) :: nh4no3_nh4hso4 !< contribution of NH4NO3
6582	REAL(wp) :: nitric_acid !<
6583	REAL(wp) :: nitric_acid_eq_frac !< Equivalent fractions
6584	REAL(wp) :: press_hcl !< partial pressure of HCL
6585	REAL(wp) :: press_hno3 !< partial pressure of HNO3
6586	REAL(wp) :: press_nh3 !< partial pressure of NH3
6587	REAL(wp) :: rh !< relative humidity [0-1]
6588	REAL(wp) :: root1 !< auxiliary variable
6589	REAL(wp) :: root2 !< auxiliary variable
6590	REAL(wp) :: so4_out !<
6591	REAL(wp) :: so4_real !< new sulpate ion concentration
6592	REAL(wp) :: sodium_chloride !<
6593	REAL(wp) :: sodium_chloride_eq_frac !<
6594	REAL(wp) :: sodium_nitrate !<
6595	REAL(wp) :: sodium_nitrate_eq_frac !<
6596	REAL(wp) :: sodium_sulphate !<
6597	REAL(wp) :: sodium_sulphate_eq_frac !<
6598	REAL(wp) :: solutes !<
6599	REAL(wp) :: sulphuric_acid !<
6600	REAL(wp) :: sulphuric_acid_eq_frac !<
6601	REAL(wp) :: temp !< temperature
6602	REAL(wp) :: water_total !<
6603
6604	REAL(wp), DIMENSION(:) :: gamma_out !< Activity coefficient for calculating the non-ideal
6605	!< dissociation constants
6606	!< 1: HNO3, 2: HCL, 3: NH4+/H+ (NH3), 4: HHSO4**2/H2SO4,
6607	!< 5: H2SO43/HHSO42, 6: NH4HSO2, 7: HHSO4
6608	REAL(wp), DIMENSION(:) :: ions !< ion molarities (mol/m3): 1: H+, 2: NH4+, 3: Na+,
6609	!< 4: SO4(2-), 5: HSO4-, 6: NO3-, 7: Cl-
6610	REAL(wp), DIMENSION(7) :: ions_mol !< ion molalities (mol/kg): 1: H+, 2: NH4+, 3: Na+,
6611	!< 4: SO4(2-), 5: HSO4-, 6: NO3-, 7: Cl-
6612	REAL(wp), DIMENSION(:) :: mols_out !< ion molality output (mol/kg): 1: H+, 2: NH4+, 3: Na+,
6613	!< 4: SO4(2-), 5: HSO4-, 6: NO3-, 7: Cl-
6614	!
6615	!-- Value initialisation
6616	binary_h2so4 = 0.0_wp
6617	binary_hcl = 0.0_wp
6618	binary_hhso4 = 0.0_wp
6619	binary_hno3 = 0.0_wp
6620	binary_nh4hso4 = 0.0_wp
6621	henrys_temp_dep = ( 1.0_wp / temp - 0.0033557_wp ) ! 1/T - 1/298 K
6622	hcl_hno3 = 1.0_wp
6623	h2so4_hno3 = 1.0_wp
6624	nh42so4_hno3 = 1.0_wp
6625	nh4no3_hno3 = 1.0_wp
6626	nh4cl_hno3 = 1.0_wp
6627	na2so4_hno3 = 1.0_wp
6628	nano3_hno3 = 1.0_wp
6629	nacl_hno3 = 1.0_wp
6630	hno3_hcl = 1.0_wp
6631	h2so4_hcl = 1.0_wp
6632	nh42so4_hcl = 1.0_wp
6633	nh4no3_hcl = 1.0_wp
6634	nh4cl_hcl = 1.0_wp
6635	na2so4_hcl = 1.0_wp
6636	nano3_hcl = 1.0_wp
6637	nacl_hcl = 1.0_wp
6638	hno3_nh3 = 1.0_wp
6639	h2so4_nh3 = 1.0_wp
6640	nh42so4_nh3 = 1.0_wp
6641	nh4no3_nh3 = 1.0_wp
6642	nh4cl_nh3 = 1.0_wp
6643	na2so4_nh3 = 1.0_wp
6644	nano3_nh3 = 1.0_wp
6645	nacl_nh3 = 1.0_wp
6646	hno3_hhso4 = 1.0_wp
6647	hcl_hhso4 = 1.0_wp
6648	nh42so4_hhso4 = 1.0_wp
6649	nh4no3_hhso4 = 1.0_wp
6650	nh4cl_hhso4 = 1.0_wp
6651	na2so4_hhso4 = 1.0_wp
6652	nano3_hhso4 = 1.0_wp
6653	nacl_hhso4 = 1.0_wp
6654	hno3_h2so4 = 1.0_wp
6655	hcl_h2so4 = 1.0_wp
6656	nh42so4_h2so4 = 1.0_wp
6657	nh4no3_h2so4 = 1.0_wp
6658	nh4cl_h2so4 = 1.0_wp
6659	na2so4_h2so4 = 1.0_wp
6660	nano3_h2so4 = 1.0_wp
6661	nacl_h2so4 = 1.0_wp
6662	!
6663	!-- New NH3 variables
6664	hno3_nh4hso4 = 1.0_wp
6665	hcl_nh4hso4 = 1.0_wp
6666	h2so4_nh4hso4 = 1.0_wp
6667	nh42so4_nh4hso4 = 1.0_wp
6668	nh4no3_nh4hso4 = 1.0_wp
6669	nh4cl_nh4hso4 = 1.0_wp
6670	na2so4_nh4hso4 = 1.0_wp
6671	nano3_nh4hso4 = 1.0_wp
6672	nacl_nh4hso4 = 1.0_wp
6673	!
6674	!-- Juha Tonttila added
6675	mols_out = 0.0_wp
6676	press_hno3 = 0.0_wp !< Initialising vapour pressures over the
6677	press_hcl = 0.0_wp !< multicomponent particle
6678	press_nh3 = 0.0_wp
6679	gamma_out = 1.0_wp !< i.e. don't alter the ideal mixing ratios if there's nothing there.
6680	!
6681	!-- 1) - COMPOSITION DEFINITIONS
6682	!
6683	!-- a) Inorganic ion pairing:
6684	!-- In order to calculate the water content, which is also used in calculating vapour pressures, one
6685	!-- needs to pair the anions and cations for use in the ZSR mixing rule. The equation provided by
6686	!-- Clegg et al. (2001) is used for ion pairing. The solutes chosen comprise of 9 inorganic salts
6687	!-- and acids which provide a pairing between each anion and cation: (NH4)2SO4, NH4NO3, NH4Cl,
6688	!-- Na2SO4, NaNO3, NaCl, H2SO4, HNO3, HCL. The organic compound is treated as a seperate solute.
6689	!-- Ions: 1: H+, 2: NH4+, 3: Na+, 4: SO4(2-), 5: HSO4-, 6: NO3-, 7: Cl-
6690	!
6691	charge_sum = ions(1) + ions(2) + ions(3) + 2.0_wp * ions(4) + ions(5) + ions(6) + ions(7)
6692	nitric_acid = ( 2.0_wp * ions(1) * ions(6) ) / charge_sum
6693	hydrochloric_acid = ( 2.0_wp * ions(1) * ions(7) ) / charge_sum
6694	sulphuric_acid = ( 2.0_wp * ions(1) * ions(4) ) / charge_sum
6695	ammonium_sulphate = ( 2.0_wp * ions(2) * ions(4) ) / charge_sum
6696	ammonium_nitrate = ( 2.0_wp * ions(2) * ions(6) ) / charge_sum
6697	ammonium_chloride = ( 2.0_wp * ions(2) * ions(7) ) / charge_sum
6698	sodium_sulphate = ( 2.0_wp * ions(3) * ions(4) ) / charge_sum
6699	sodium_nitrate = ( 2.0_wp * ions(3) * ions(6) ) / charge_sum
6700	sodium_chloride = ( 2.0_wp * ions(3) * ions(7) ) / charge_sum
6701	solutes = 0.0_wp
6702	solutes = 3.0_wp * sulphuric_acid + 2.0_wp * hydrochloric_acid + 2.0_wp * nitric_acid + &
6703	3.0_wp * ammonium_sulphate + 2.0_wp * ammonium_nitrate + 2.0_wp * ammonium_chloride +&
6704	3.0_wp * sodium_sulphate + 2.0_wp * sodium_nitrate + 2.0_wp * sodium_chloride
6705	!
6706	!-- b) Inorganic equivalent fractions:
6707	!-- These values are calculated so that activity coefficients can be expressed by a linear additive
6708	!-- rule, thus allowing more efficient calculations and future expansion (see more detailed
6709	!-- description below)
6710	nitric_acid_eq_frac = 2.0_wp * nitric_acid / solutes
6711	hydrochloric_acid_eq_frac = 2.0_wp * hydrochloric_acid / solutes
6712	sulphuric_acid_eq_frac = 3.0_wp * sulphuric_acid / solutes
6713	ammonium_sulphate_eq_frac = 3.0_wp * ammonium_sulphate / solutes
6714	ammonium_nitrate_eq_frac = 2.0_wp * ammonium_nitrate / solutes
6715	ammonium_chloride_eq_frac = 2.0_wp * ammonium_chloride / solutes
6716	sodium_sulphate_eq_frac = 3.0_wp * sodium_sulphate / solutes
6717	sodium_nitrate_eq_frac = 2.0_wp * sodium_nitrate / solutes
6718	sodium_chloride_eq_frac = 2.0_wp * sodium_chloride / solutes
6719	!
6720	!-- Inorganic ion molalities
6721	ions_mol(1) = ions(1) / ( water_total * 18.01528E-3_wp ) ! H+
6722	ions_mol(2) = ions(2) / ( water_total * 18.01528E-3_wp ) ! NH4+
6723	ions_mol(3) = ions(3) / ( water_total * 18.01528E-3_wp ) ! Na+
6724	ions_mol(4) = ions(4) / ( water_total * 18.01528E-3_wp ) ! SO4(2-)
6725	ions_mol(5) = ions(5) / ( water_total * 18.01528E-3_wp ) ! HSO4(2-)
6726	ions_mol(6) = ions(6) / ( water_total * 18.01528E-3_wp ) ! NO3-
6727	ions_mol(7) = ions(7) / ( water_total * 18.01528E-3_wp ) ! Cl-
6728
6729	!-- ***
6730	!-- At this point we may need to introduce a method for prescribing H+ when there is no 'real' value
6731	!-- for H+..i.e. in the sulphate poor domain. This will give a value for solve quadratic proposed by
6732	!-- Zaveri et al. 2005
6733	!
6734	!-- 2) - WATER CALCULATION
6735	!
6736	!-- a) The water content is calculated using the ZSR rule with solute concentrations calculated
6737	!-- using 1a above. Whilst the usual approximation of ZSR relies on binary data consisting of 5th or
6738	!-- higher order polynomials, in this code 4 different RH regimes are used, each housing cubic
6739	!-- equations for the water associated with each solute listed above. Binary water contents for
6740	!-- inorganic components were calculated using AIM online (Clegg et al 1998). The water associated
6741	!-- with the organic compound is calculated assuming ideality and that aw = RH.
6742	!
6743	!-- b) Molality of each inorganic ion and organic solute (initial input) is calculated for use in
6744	!-- vapour pressure calculation.
6745	!
6746	!-- 3) - BISULPHATE ION DISSOCIATION CALCULATION
6747	!
6748	!-- The dissociation of the bisulphate ion is calculated explicitly. A solution to the equilibrium
6749	!-- equation between the bisulphate ion, hydrogen ion and sulphate ion is found using tabulated
6750	!-- equilibrium constants (referenced). It is necessary to calculate the activity coefficients of
6751	!-- HHSO4 and H2SO4 in a non-iterative manner. These are calculated using the same format as
6752	!-- described in 4) below, where both activity coefficients were fit to the output from ADDEM
6753	!-- (Topping et al 2005a,b) covering an extensive composition space, providing the activity
6754	!-- coefficients and bisulphate ion dissociation as a function of equivalent mole fractions and
6755	!-- relative humidity.
6756	!
6757	!-- NOTE: the flags "binary_case" and "full_complexity" are not used in this prototype. They are
6758	!-- used for simplification of the fit expressions when using limited composition regions. This
6759	!-- section of code calculates the bisulphate ion concentration.
6760	!
6761	IF ( ions(1) > 0.0_wp .AND. ions(4) > 0.0_wp ) THEN
6762	!
6763	!-- HHSO4:
6764	binary_case = 1
6765	IF ( rh > 0.1_wp .AND. rh < 0.9_wp ) THEN
6766	binary_hhso4 = -4.9521_wp * rh*3 + 9.2881_wp rh*2 - 10.777_wp rh + 6.0534_wp
6767	ELSEIF ( rh >= 0.9_wp .AND. rh < 0.955_wp ) THEN
6768	binary_hhso4 = -6.3777_wp * rh + 5.962_wp
6769	ELSEIF ( rh >= 0.955_wp .AND. rh < 0.99_wp ) THEN
6770	binary_hhso4 = 2367.2_wp * rh*3 - 6849.7_wp rh*2 + 6600.9_wp rh - 2118.7_wp
6771	ELSEIF ( rh >= 0.99_wp .AND. rh < 0.9999_wp ) THEN
6772	binary_hhso4 = 3E-7_wp * rh*5 - 2E-5_wp rh*4 + 0.0004_wp rh*3 - 0.0035_wp rh**2 &
6773	+ 0.0123_wp * rh - 0.3025_wp
6774	ENDIF
6775
6776	IF ( nitric_acid > 0.0_wp ) THEN
6777	hno3_hhso4 = -4.2204_wp * rh*4 + 12.193_wp rh*3 - 12.481_wp rh*2 + 6.459_wp rh &
6778	- 1.9004_wp
6779	ENDIF
6780
6781	IF ( hydrochloric_acid > 0.0_wp ) THEN
6782	hcl_hhso4 = -54.845_wp * rh*7 + 209.54_wp rh*6 - 336.59_wp rh*5 + 294.21_wp &
6783	rh*4 - 150.07_wp rh*3 + 43.767_wp rh*2 - 6.5495_wp rh + 0.60048_wp
6784	ENDIF
6785
6786	IF ( ammonium_sulphate > 0.0_wp ) THEN
6787	nh42so4_hhso4 = 16.768_wp * rh*3 - 28.75_wp rh*2 + 20.011_wp rh - 8.3206_wp
6788	ENDIF
6789
6790	IF ( ammonium_nitrate > 0.0_wp ) THEN
6791	nh4no3_hhso4 = -17.184_wp * rh*4 + 56.834_wp rh*3 - 65.765_wp rh**2 + &
6792	35.321_wp * rh - 9.252_wp
6793	ENDIF
6794
6795	IF (ammonium_chloride > 0.0_wp ) THEN
6796	IF ( rh < 0.2_wp .AND. rh >= 0.1_wp ) THEN
6797	nh4cl_hhso4 = 3.2809_wp * rh - 2.0637_wp
6798	ELSEIF ( rh >= 0.2_wp .AND. rh < 0.99_wp ) THEN
6799	nh4cl_hhso4 = -1.2981_wp * rh*3 + 4.7461_wp rh*2 - 2.3269_wp rh - 1.1259_wp
6800	ENDIF
6801	ENDIF
6802
6803	IF ( sodium_sulphate > 0.0_wp ) THEN
6804	na2so4_hhso4 = 118.87_wp * rh*6 - 358.63_wp rh*5 + 435.85_wp rh*4 - 272.88_wp &
6805	rh*3 + 94.411_wp rh*2 - 18.21_wp rh + 0.45935_wp
6806	ENDIF
6807
6808	IF ( sodium_nitrate > 0.0_wp ) THEN
6809	IF ( rh < 0.2_wp .AND. rh >= 0.1_wp ) THEN
6810	nano3_hhso4 = 4.8456_wp * rh - 2.5773_wp
6811	ELSEIF ( rh >= 0.2_wp .AND. rh < 0.99_wp ) THEN
6812	nano3_hhso4 = 0.5964_wp * rh*3 - 0.38967_wp rh*2 + 1.7918_wp rh - 1.9691_wp
6813	ENDIF
6814	ENDIF
6815
6816	IF ( sodium_chloride > 0.0_wp ) THEN
6817	IF ( rh < 0.2_wp ) THEN
6818	nacl_hhso4 = 0.51995_wp * rh - 1.3981_wp
6819	ELSEIF ( rh >= 0.2_wp .AND. rh < 0.99_wp ) THEN
6820	nacl_hhso4 = 1.6539_wp * rh - 1.6101_wp
6821	ENDIF
6822	ENDIF
6823
6824	ln_hhso4_act = binary_hhso4 + nitric_acid_eq_frac * hno3_hhso4 + &
6825	hydrochloric_acid_eq_frac * hcl_hhso4 + &
6826	ammonium_sulphate_eq_frac * nh42so4_hhso4 + &
6827	ammonium_nitrate_eq_frac * nh4no3_hhso4 + &
6828	ammonium_chloride_eq_frac * nh4cl_hhso4 + &
6829	sodium_sulphate_eq_frac * na2so4_hhso4 + &
6830	sodium_nitrate_eq_frac * nano3_hhso4 + sodium_chloride_eq_frac * nacl_hhso4
6831
6832	gamma_hhso4 = EXP( ln_hhso4_act ) ! molal activity coefficient of HHSO4
6833
6834	!-- H2SO4 (sulphuric acid):
6835	IF ( rh >= 0.1_wp .AND. rh < 0.9_wp ) THEN
6836	binary_h2so4 = 2.4493_wp * rh*2 - 6.2326_wp rh + 2.1763_wp
6837	ELSEIF ( rh >= 0.9_wp .AND. rh < 0.98 ) THEN
6838	binary_h2so4 = 914.68_wp * rh*3 - 2502.3_wp rh*2 + 2281.9_wp rh - 695.11_wp
6839	ELSEIF ( rh >= 0.98 .AND. rh < 0.9999 ) THEN
6840	binary_h2so4 = 3.0E-8_wp * rh*4 - 5E-6_wp rh*3 + 0.0003_wp rh*2 - 0.0022_wp &
6841	rh - 1.1305_wp
6842	ENDIF
6843
6844	IF ( nitric_acid > 0.0_wp ) THEN
6845	hno3_h2so4 = - 16.382_wp * rh*5 + 46.677_wp rh*4 - 54.149_wp rh*3 + 34.36_wp &
6846	rh*2 - 12.54_wp rh + 2.1368_wp
6847	ENDIF
6848
6849	IF ( hydrochloric_acid > 0.0_wp ) THEN
6850	hcl_h2so4 = - 14.409_wp * rh*5 + 42.804_wp rh*4 - 47.24_wp rh*3 + 24.668_wp &
6851	rh*2 - 5.8015_wp rh + 0.084627_wp
6852	ENDIF
6853
6854	IF ( ammonium_sulphate > 0.0_wp ) THEN
6855	nh42so4_h2so4 = 66.71_wp * rh*5 - 187.5_wp rh*4 + 210.57_wp rh*3 - 121.04_wp &
6856	rh*2 + 39.182_wp rh - 8.0606_wp
6857	ENDIF
6858
6859	IF ( ammonium_nitrate > 0.0_wp ) THEN
6860	nh4no3_h2so4 = - 22.532_wp * rh*4 + 66.615_wp rh*3 - 74.647_wp rh*2 + 37.638_wp &
6861	rh - 6.9711_wp
6862	ENDIF
6863
6864	IF ( ammonium_chloride > 0.0_wp ) THEN
6865	IF ( rh >= 0.1_wp .AND. rh < 0.2_wp ) THEN
6866	nh4cl_h2so4 = - 0.32089_wp * rh + 0.57738_wp
6867	ELSEIF ( rh >= 0.2_wp .AND. rh < 0.9_wp ) THEN
6868	nh4cl_h2so4 = 18.089_wp * rh*5 - 51.083_wp rh*4 + 50.32_wp rh*3 - 17.012_wp &
6869	rh*2 - 0.93435_wp rh + 1.0548_wp
6870	ELSEIF ( rh >= 0.9_wp .AND. rh < 0.99_wp ) THEN
6871	nh4cl_h2so4 = - 1.5749_wp * rh + 1.7002_wp
6872	ENDIF
6873	ENDIF
6874
6875	IF ( sodium_sulphate > 0.0_wp ) THEN
6876	na2so4_h2so4 = 29.843_wp * rh*4 - 69.417_wp rh*3 + 61.507_wp rh*2 - 29.874_wp &
6877	rh + 7.7556_wp
6878	ENDIF
6879
6880	IF ( sodium_nitrate > 0.0_wp ) THEN
6881	nano3_h2so4 = - 122.37_wp * rh*6 + 427.43_wp rh*5 - 604.68_wp rh*4 + 443.08_wp &
6882	rh*3 - 178.61_wp rh*2 + 37.242_wp rh - 1.9564_wp
6883	ENDIF
6884
6885	IF ( sodium_chloride > 0.0_wp ) THEN
6886	nacl_h2so4 = - 40.288_wp * rh*5 + 115.61_wp rh*4 - 129.99_wp rh*3 + 72.652_wp &
6887	rh*2 - 22.124_wp rh + 4.2676_wp
6888	ENDIF
6889
6890	ln_h2so4_act = binary_h2so4 + nitric_acid_eq_frac * hno3_h2so4 + &
6891	hydrochloric_acid_eq_frac * hcl_h2so4 + &
6892	ammonium_sulphate_eq_frac * nh42so4_h2so4 + &
6893	ammonium_nitrate_eq_frac * nh4no3_h2so4 + &
6894	ammonium_chloride_eq_frac * nh4cl_h2so4 + &
6895	sodium_sulphate_eq_frac * na2so4_h2so4 + &
6896	sodium_nitrate_eq_frac * nano3_h2so4 + sodium_chloride_eq_frac * nacl_h2so4
6897
6898	gamma_h2so4 = EXP( ln_h2so4_act ) ! molal activity coefficient
6899	!
6900	!-- Export activity coefficients
6901	IF ( gamma_h2so4 > 1.0E-10_wp ) THEN
6902	gamma_out(4) = gamma_hhso4**2 / gamma_h2so4
6903	ENDIF
6904	IF ( gamma_hhso4 > 1.0E-10_wp ) THEN
6905	gamma_out(5) = gamma_h2so43 / gamma_hhso42
6906	ENDIF
6907	!
6908	!-- Ionic activity coefficient product
6909	act_product = gamma_h2so43 / gamma_hhso42
6910	!
6911	!-- Solve the quadratic equation (i.e. x in ax**2 + bx + c = 0)
6912	a = 1.0_wp
6913	b = -1.0_wp * ( ions(4) + ions(1) + ( ( water_total * 18.0E-3_wp ) / &
6914	( 99.0_wp * act_product ) ) )
6915	c = ions(4) * ions(1)
6916	root1 = ( ( -1.0_wp * b ) + ( ( ( b*2 ) - 4.0_wp a * c )*0.5_wp ) ) / ( 2.0_wp a )
6917	root2 = ( ( -1.0_wp * b ) - ( ( ( b*2 ) - 4.0_wp a * c) *0.5_wp ) ) / ( 2.0_wp a )
6918
6919	IF ( root1 > ions(1) .OR. root1 < 0.0_wp ) THEN
6920	root1 = 0.0_wp
6921	ENDIF
6922
6923	IF ( root2 > ions(1) .OR. root2 < 0.0_wp ) THEN
6924	root2 = 0.0_wp
6925	ENDIF
6926	!
6927	!-- Calculate the new hydrogen ion, bisulphate ion and sulphate ion
6928	!-- concentration
6929	h_real = ions(1)
6930	so4_real = ions(4)
6931	hso4_real = MAX( root1, root2 )
6932	h_real = ions(1) - hso4_real
6933	so4_real = ions(4) - hso4_real
6934	!
6935	!-- Recalculate ion molalities
6936	ions_mol(1) = h_real / ( water_total * 18.01528E-3_wp ) ! H+
6937	ions_mol(4) = so4_real / ( water_total * 18.01528E-3_wp ) ! SO4(2-)
6938	ions_mol(5) = hso4_real / ( water_total * 18.01528E-3_wp ) ! HSO4(2-)
6939
6940	h_out = h_real
6941	hso4_out = hso4_real
6942	so4_out = so4_real
6943
6944	ELSE
6945	h_out = ions(1)
6946	hso4_out = 0.0_wp
6947	so4_out = ions(4)
6948	ENDIF
6949
6950	!
6951	!-- 4) ACTIVITY COEFFICIENTS -for vapour pressures of HNO3,HCL and NH3
6952	!
6953	!-- This section evaluates activity coefficients and vapour pressures using the water content
6954	!-- calculated above) for each inorganic condensing species: a - HNO3, b - NH3, c - HCL.
6955	!-- The following procedure is used: Zaveri et al (2005) found that one could express the variation
6956	!-- of activity coefficients linearly in log-space if equivalent mole fractions were used.
6957	!-- So, by a taylor series expansion LOG( activity coefficient ) =
6958	!-- LOG( binary activity coefficient at a given RH ) +
6959	!-- (equivalent mole fraction compound A) *
6960	!-- ('interaction' parameter between A and condensing species) +
6961	!-- equivalent mole fraction compound B) *
6962	!-- ('interaction' parameter between B and condensing species).
6963	!-- Here, the interaction parameters have been fit to ADDEM by searching the whole compositon space
6964	!-- and fit usign the Levenberg-Marquardt non-linear least squares algorithm.
6965	!
6966	!-- They are given as a function of RH and vary with complexity ranging from linear to 5th order
6967	!-- polynomial expressions, the binary activity coefficients were calculated using AIM online.
6968	!-- NOTE: for NH3, no binary activity coefficient was used and the data were fit to the ratio of the
6969	!-- activity coefficients for the ammonium and hydrogen ions. Once the activity coefficients are
6970	!-- obtained the vapour pressure can be easily calculated using tabulated equilibrium constants
6971	!-- (referenced). This procedure differs from that of Zaveri et al (2005) in that it is not assumed
6972	!-- one can carry behaviour from binary mixtures in multicomponent systems. To this end we have fit
6973	!-- the 'interaction' parameters explicitly to a general inorganic equilibrium model
6974	!-- (ADDEM - Topping et al. 2005a,b). Such parameters take into account bisulphate ion dissociation
6975	!-- and water content. This also allows us to consider one regime for all composition space, rather
6976	!-- than defining sulphate rich and sulphate poor regimes.
6977	!-- NOTE: The flags "binary_case" and "full_complexity" are not used in this prototype. They are
6978	!-- used for simplification of the fit expressions when using limited composition regions.
6979	!
6980	!-- a) - ACTIVITY COEFF/VAPOUR PRESSURE - HNO3
6981	IF ( ions(1) > 0.0_wp .AND. ions(6) > 0.0_wp ) THEN
6982	binary_case = 1
6983	IF ( rh > 0.1_wp .AND. rh < 0.98_wp ) THEN
6984	IF ( binary_case == 1 ) THEN
6985	binary_hno3 = 1.8514_wp * rh*3 - 4.6991_wp rh*2 + 1.5514_wp rh + 0.90236_wp
6986	ELSEIF ( binary_case == 2 ) THEN
6987	binary_hno3 = - 1.1751_wp * ( rh*2 ) - 0.53794_wp rh + 1.2808_wp
6988	ENDIF
6989	ELSEIF ( rh >= 0.98_wp .AND. rh < 0.9999_wp ) THEN
6990	binary_hno3 = 1244.69635941351_wp * rh*3 - 2613.93941099991_wp rh**2 + &
6991	1525.0684974546_wp * rh -155.946764059316_wp
6992	ENDIF
6993	!
6994	!-- Contributions from other solutes
6995	full_complexity = 1
6996	IF ( hydrochloric_acid > 0.0_wp ) THEN ! HCL
6997	IF ( full_complexity == 1 .OR. rh < 0.4_wp ) THEN
6998	hcl_hno3 = 16.051_wp * rh*4 - 44.357_wp rh*3 + 45.141_wp rh*2 - 21.638_wp &
6999	rh + 4.8182_wp
7000	ELSEIF ( full_complexity == 0 .AND. rh > 0.4_wp ) THEN
7001	hcl_hno3 = - 1.5833_wp * rh + 1.5569_wp
7002	ENDIF
7003	ENDIF
7004
7005	IF ( sulphuric_acid > 0.0_wp ) THEN ! H2SO4
7006	IF ( full_complexity == 1 .OR. rh < 0.4_wp ) THEN
7007	h2so4_hno3 = - 3.0849_wp * rh*3 + 5.9609_wp rh*2 - 4.468_wp rh + 1.5658_wp
7008	ELSEIF ( full_complexity == 0 .AND. rh > 0.4_wp ) THEN
7009	h2so4_hno3 = - 0.93473_wp * rh + 0.9363_wp
7010	ENDIF
7011	ENDIF
7012
7013	IF ( ammonium_sulphate > 0.0_wp ) THEN ! NH42SO4
7014	nh42so4_hno3 = 16.821_wp * rh*3 - 28.391_wp rh*2 + 18.133_wp rh - 6.7356_wp
7015	ENDIF
7016
7017	IF ( ammonium_nitrate > 0.0_wp ) THEN ! NH4NO3
7018	nh4no3_hno3 = 11.01_wp * rh*3 - 21.578_wp rh*2 + 14.808_wp rh - 4.2593_wp
7019	ENDIF
7020
7021	IF ( ammonium_chloride > 0.0_wp ) THEN ! NH4Cl
7022	IF ( full_complexity == 1 .OR. rh <= 0.4_wp ) THEN
7023	nh4cl_hno3 = - 1.176_wp * rh*3 + 5.0828_wp rh*2 - 3.8792_wp rh - 0.05518_wp
7024	ELSEIF ( full_complexity == 0 .AND. rh > 0.4_wp ) THEN
7025	nh4cl_hno3 = 2.6219_wp * rh*2 - 2.2609_wp rh - 0.38436_wp
7026	ENDIF
7027	ENDIF
7028
7029	IF ( sodium_sulphate > 0.0_wp ) THEN ! Na2SO4
7030	na2so4_hno3 = 35.504_wp * rh*4 - 80.101_wp rh*3 + 67.326_wp rh*2 - 28.461_wp &
7031	rh + 5.6016_wp
7032	ENDIF
7033
7034	IF ( sodium_nitrate > 0.0_wp ) THEN ! NaNO3
7035	IF ( full_complexity == 1 .OR. rh <= 0.4_wp ) THEN
7036	nano3_hno3 = 23.659_wp * rh*5 - 66.917_wp rh*4 + 74.686_wp rh*3 - 40.795_wp &
7037	rh*2 + 10.831_wp rh - 1.4701_wp
7038	ELSEIF ( full_complexity == 0 .AND. rh > 0.4_wp ) THEN
7039	nano3_hno3 = 14.749_wp * rh*4 - 35.237_wp rh*3 + 31.196_wp rh*2 - 12.076_wp &
7040	rh + 1.3605_wp
7041	ENDIF
7042	ENDIF
7043
7044	IF ( sodium_chloride > 0.0_wp ) THEN ! NaCl
7045	IF ( full_complexity == 1 .OR. rh <= 0.4_wp ) THEN
7046	nacl_hno3 = 13.682_wp * rh*4 - 35.122_wp rh*3 + 33.397_wp rh*2 - 14.586_wp &
7047	rh + 2.6276_wp
7048	ELSEIF ( full_complexity == 0 .AND. rh > 0.4_wp ) THEN
7049	nacl_hno3 = 1.1882_wp * rh*3 - 1.1037_wp rh*2 - 0.7642_wp rh + 0.6671_wp
7050	ENDIF
7051	ENDIF
7052
7053	ln_hno3_act = binary_hno3 + hydrochloric_acid_eq_frac * hcl_hno3 + &
7054	sulphuric_acid_eq_frac * h2so4_hno3 + &
7055	ammonium_sulphate_eq_frac * nh42so4_hno3 + &
7056	ammonium_nitrate_eq_frac * nh4no3_hno3 + &
7057	ammonium_chloride_eq_frac * nh4cl_hno3 + &
7058	sodium_sulphate_eq_frac * na2so4_hno3 + &
7059	sodium_nitrate_eq_frac * nano3_hno3 + sodium_chloride_eq_frac * nacl_hno3
7060
7061	gamma_hno3 = EXP( ln_hno3_act ) ! Molal activity coefficient of HNO3
7062	gamma_out(1) = gamma_hno3
7063	!
7064	!-- Partial pressure calculation
7065	!-- k_hno3 = 2.51 * ( 10**6 )
7066	!-- k_hno3 = 2.628145923d6 !< calculated by AIM online (Clegg et al 1998) after Chameides (1984)
7067	k_hno3 = 2.6E6_wp * EXP( 8700.0_wp * henrys_temp_dep )
7068	press_hno3 = ( ions_mol(1) * ions_mol(6) * ( gamma_hno3**2 ) ) / k_hno3
7069	ENDIF
7070	!
7071	!-- b) - ACTIVITY COEFF/VAPOUR PRESSURE - NH3
7072	!-- Follow the two solute approach of Zaveri et al. (2005)
7073	IF ( ions(2) > 0.0_wp .AND. ions_mol(1) > 0.0_wp ) THEN
7074	!
7075	!-- NH4HSO4:
7076	binary_nh4hso4 = 56.907_wp * rh*6 - 155.32_wp rh*5 + 142.94_wp rh*4 - 32.298_wp &
7077	rh*3 - 27.936_wp rh*2 + 19.502_wp rh - 4.2618_wp
7078	IF ( nitric_acid > 0.0_wp) THEN ! HNO3
7079	hno3_nh4hso4 = 104.8369_wp * rh*8 - 288.8923_wp rh*7 + 129.3445_wp rh**6 + &
7080	373.0471_wp * rh*5 - 571.0385_wp rh*4 + 326.3528_wp rh**3 - &
7081	74.169_wp * rh*2 - 2.4999_wp rh + 3.17_wp
7082	ENDIF
7083
7084	IF ( hydrochloric_acid > 0.0_wp) THEN ! HCL
7085	hcl_nh4hso4 = - 7.9133_wp * rh*8 + 126.6648_wp rh*7 - 460.7425_wp rh**6 + &
7086	731.606_wp * rh*5 - 582.7467_wp rh*4 + 216.7197_wp rh**3 - &
7087	11.3934_wp * rh*2 - 17.7728_wp rh + 5.75_wp
7088	ENDIF
7089
7090	IF ( sulphuric_acid > 0.0_wp) THEN ! H2SO4
7091	h2so4_nh4hso4 = 195.981_wp * rh*8 - 779.2067_wp rh*7 + 1226.3647_wp rh**6 - &
7092	964.0261_wp * rh*5 + 391.7911_wp rh*4 - 84.1409_wp rh**3 + &
7093	20.0602_wp * rh*2 - 10.2663_wp rh + 3.5817_wp
7094	ENDIF
7095
7096	IF ( ammonium_sulphate > 0.0_wp) THEN ! NH42SO4
7097	nh42so4_nh4hso4 = 617.777_wp * rh*8 - 2547.427_wp rh*7 + 4361.6009_wp rh**6 - &
7098	4003.162_wp * rh*5 + 2117.8281_wp rh*4 - 640.0678_wp rh**3 + &
7099	98.0902_wp * rh*2 - 2.2615_wp rh - 2.3811_wp
7100	ENDIF
7101
7102	IF ( ammonium_nitrate > 0.0_wp) THEN ! NH4NO3
7103	nh4no3_nh4hso4 = - 104.4504_wp * rh*8 + 539.5921_wp rh*7 - 1157.0498_wp rh**6 + &
7104	1322.4507_wp * rh*5 - 852.2475_wp rh*4 + 298.3734_wp rh**3 - &
7105	47.0309_wp * rh*2 + 1.297_wp rh - 0.8029_wp
7106	ENDIF
7107
7108	IF ( ammonium_chloride > 0.0_wp) THEN ! NH4Cl
7109	nh4cl_nh4hso4 = 258.1792_wp * rh*8 - 1019.3777_wp rh*7 + 1592.8918_wp rh**6 - &
7110	1221.0726_wp * rh*5 + 442.2548_wp rh*4 - 43.6278_wp rh**3 - &
7111	7.5282_wp * rh*2 - 3.8459_wp rh + 2.2728_wp
7112	ENDIF
7113
7114	IF ( sodium_sulphate > 0.0_wp) THEN ! Na2SO4
7115	na2so4_nh4hso4 = 225.4238_wp * rh*8 - 732.4113_wp rh*7 + 843.7291_wp rh**6 - &
7116	322.7328_wp * rh*5 - 88.6252_wp rh*4 + 72.4434_wp rh**3 + &
7117	22.9252_wp * rh*2 - 25.3954_wp rh + 4.6971_wp
7118	ENDIF
7119
7120	IF ( sodium_nitrate > 0.0_wp) THEN ! NaNO3
7121	nano3_nh4hso4 = 96.1348_wp * rh*8 - 341.6738_wp rh*7 + 406.5314_wp rh**6 - &
7122	98.5777_wp * rh*5 - 172.8286_wp rh*4 + 149.3151_wp rh**3 - &
7123	38.9998_wp * rh*2 - 0.2251_wp rh + 0.4953_wp
7124	ENDIF
7125
7126	IF ( sodium_chloride > 0.0_wp) THEN ! NaCl
7127	nacl_nh4hso4 = 91.7856_wp * rh*8 - 316.6773_wp rh*7 + 358.2703_wp rh**6 - &
7128	68.9142_wp * rh*5 - 156.5031_wp rh*4 + 116.9592_wp rh**3 - &
7129	22.5271_wp * rh*2 - 3.7716_wp rh + 1.56_wp
7130	ENDIF
7131
7132	ln_nh4hso4_act = binary_nh4hso4 + nitric_acid_eq_frac * hno3_nh4hso4 + &
7133	hydrochloric_acid_eq_frac * hcl_nh4hso4 + &
7134	sulphuric_acid_eq_frac * h2so4_nh4hso4 + &
7135	ammonium_sulphate_eq_frac * nh42so4_nh4hso4 + &
7136	ammonium_nitrate_eq_frac * nh4no3_nh4hso4 + &
7137	ammonium_chloride_eq_frac * nh4cl_nh4hso4 + &
7138	sodium_sulphate_eq_frac * na2so4_nh4hso4 + &
7139	sodium_nitrate_eq_frac * nano3_nh4hso4 + &
7140	sodium_chloride_eq_frac * nacl_nh4hso4
7141
7142	gamma_nh4hso4 = EXP( ln_nh4hso4_act ) ! molal act. coefficient of NH4HSO4
7143	!
7144	!-- Molal activity coefficient of NO3-
7145	gamma_out(6) = gamma_nh4hso4
7146	!
7147	!-- Molal activity coefficient of NH4+
7148	gamma_nh3 = gamma_nh4hso42 / gamma_hhso42
7149	gamma_out(3) = gamma_nh3
7150	!
7151	!-- This actually represents the ratio of the ammonium to hydrogen ion activity coefficients
7152	!-- (see Zaveri paper) - multiply this by the ratio of the ammonium to hydrogen ion molality and
7153	!-- the ratio of appropriate equilibrium constants
7154	!
7155	!-- Equilibrium constants
7156	!-- k_h = 57.64d0 ! Zaveri et al. (2005)
7157	k_h = 5.8E1_wp * EXP( 4085.0_wp * henrys_temp_dep ) ! after Chameides (1984)
7158	!-- k_nh4 = 1.81E-5_wp ! Zaveri et al. (2005)
7159	k_nh4 = 1.7E-5_wp * EXP( -4325.0_wp * henrys_temp_dep ) ! Chameides (1984)
7160	!-- k_h2o = 1.01E-14_wp ! Zaveri et al (2005)
7161	k_h2o = 1.E-14_wp * EXP( -6716.0_wp * henrys_temp_dep ) ! Chameides (1984)
7162	!
7163	molality_ratio_nh3 = ions_mol(2) / ions_mol(1)
7164	!
7165	!-- Partial pressure calculation
7166	press_nh3 = molality_ratio_nh3 * gamma_nh3 * ( k_h2o / ( k_h * k_nh4 ) )
7167
7168	ENDIF
7169	!
7170	!-- c) - ACTIVITY COEFF/VAPOUR PRESSURE - HCL
7171	IF ( ions(1) > 0.0_wp .AND. ions(7) > 0.0_wp ) THEN
7172	binary_case = 1
7173	IF ( rh > 0.1_wp .AND. rh < 0.98 ) THEN
7174	IF ( binary_case == 1 ) THEN
7175	binary_hcl = - 5.0179_wp * rh*3 + 9.8816_wp rh*2 - 10.789_wp rh + 5.4737_wp
7176	ELSEIF ( binary_case == 2 ) THEN
7177	binary_hcl = - 4.6221_wp * rh + 4.2633_wp
7178	ENDIF
7179	ELSEIF ( rh >= 0.98_wp .AND. rh < 0.9999_wp ) THEN
7180	binary_hcl = 775.6111008626_wp * rh*3 - 2146.01320888771_wp rh**2 + &
7181	1969.01979670259_wp * rh - 598.878230033926_wp
7182	ENDIF
7183	ENDIF
7184
7185	IF ( nitric_acid > 0.0_wp ) THEN ! HNO3
7186	IF ( full_complexity == 1 .OR. rh <= 0.4_wp ) THEN
7187	hno3_hcl = 9.6256_wp * rh*4 - 26.507_wp rh*3 + 27.622_wp rh*2 - 12.958_wp rh + &
7188	2.2193_wp
7189	ELSEIF ( full_complexity == 0 .AND. rh > 0.4_wp ) THEN
7190	hno3_hcl = 1.3242_wp * rh*2 - 1.8827_wp rh + 0.55706_wp
7191	ENDIF
7192	ENDIF
7193
7194	IF ( sulphuric_acid > 0.0_wp ) THEN ! H2SO4
7195	IF ( full_complexity == 1 .OR. rh <= 0.4 ) THEN
7196	h2so4_hcl = 1.4406_wp * rh*3 - 2.7132_wp rh*2 + 1.014_wp rh + 0.25226_wp
7197	ELSEIF ( full_complexity == 0 .AND. rh > 0.4_wp ) THEN
7198	h2so4_hcl = 0.30993_wp * rh*2 - 0.99171_wp rh + 0.66913_wp
7199	ENDIF
7200	ENDIF
7201
7202	IF ( ammonium_sulphate > 0.0_wp ) THEN ! NH42SO4
7203	nh42so4_hcl = 22.071_wp * rh*3 - 40.678_wp rh*2 + 27.893_wp rh - 9.4338_wp
7204	ENDIF
7205
7206	IF ( ammonium_nitrate > 0.0_wp ) THEN ! NH4NO3
7207	nh4no3_hcl = 19.935_wp * rh*3 - 42.335_wp rh*2 + 31.275_wp rh - 8.8675_wp
7208	ENDIF
7209
7210	IF ( ammonium_chloride > 0.0_wp ) THEN ! NH4Cl
7211	IF ( full_complexity == 1 .OR. rh <= 0.4_wp ) THEN
7212	nh4cl_hcl = 2.8048_wp * rh*3 - 4.3182_wp rh*2 + 3.1971_wp rh - 1.6824_wp
7213	ELSEIF ( full_complexity == 0 .AND. rh > 0.4_wp ) THEN
7214	nh4cl_hcl = 1.2304_wp * rh*2 - 0.18262_wp rh - 1.0643_wp
7215	ENDIF
7216	ENDIF
7217
7218	IF ( sodium_sulphate > 0.0_wp ) THEN ! Na2SO4
7219	na2so4_hcl = 36.104_wp * rh*4 - 78.658_wp rh*3 + 63.441_wp rh*2 - 26.727_wp rh + &
7220	5.7007_wp
7221	ENDIF
7222
7223	IF ( sodium_nitrate > 0.0_wp ) THEN ! NaNO3
7224	IF ( full_complexity == 1 .OR. rh <= 0.4_wp ) THEN
7225	nano3_hcl = 54.471_wp * rh*5 - 159.42_wp rh*4 + 180.25_wp rh*3 - 98.176_wp rh**2&
7226	+ 25.309_wp * rh - 2.4275_wp
7227	ELSEIF ( full_complexity == 0 .AND. rh > 0.4_wp ) THEN
7228	nano3_hcl = 21.632_wp * rh*4 - 53.088_wp rh*3 + 47.285_wp rh*2 - 18.519_wp rh &
7229	+ 2.6846_wp
7230	ENDIF
7231	ENDIF
7232
7233	IF ( sodium_chloride > 0.0_wp ) THEN ! NaCl
7234	IF ( full_complexity == 1 .OR. rh <= 0.4_wp ) THEN
7235	nacl_hcl = 5.4138_wp * rh*4 - 12.079_wp rh*3 + 9.627_wp rh*2 - 3.3164_wp rh + &
7236	0.35224_wp
7237	ELSEIF ( full_complexity == 0 .AND. rh > 0.4_wp ) THEN
7238	nacl_hcl = 2.432_wp * rh*3 - 4.3453_wp rh*2 + 2.3834_wp rh - 0.4762_wp
7239	ENDIF
7240	ENDIF
7241
7242	ln_HCL_act = binary_hcl + nitric_acid_eq_frac * hno3_hcl + sulphuric_acid_eq_frac * h2so4_hcl +&
7243	ammonium_sulphate_eq_frac * nh42so4_hcl + ammonium_nitrate_eq_frac * nh4no3_hcl + &
7244	ammonium_chloride_eq_frac * nh4cl_hcl + sodium_sulphate_eq_frac * na2so4_hcl + &
7245	sodium_nitrate_eq_frac * nano3_hcl + sodium_chloride_eq_frac * nacl_hcl
7246
7247	gamma_hcl = EXP( ln_HCL_act ) ! Molal activity coefficient
7248	gamma_out(2) = gamma_hcl
7249	!
7250	!-- Equilibrium constant after Wagman et al. (1982) (and NIST database)
7251	k_hcl = 2E6_wp * EXP( 9000.0_wp * henrys_temp_dep )
7252
7253	press_hcl = ( ions_mol(1) * ions_mol(7) * gamma_hcl**2 ) / k_hcl
7254	!
7255	!-- 5) Ion molility output
7256	mols_out = ions_mol
7257
7258	END SUBROUTINE inorganic_pdfite
7259
7260	!------------------------------------------------------------------------------!
7261	! Description:
7262	! ------------
7263	!> Update the particle size distribution. Put particles into corrects bins.
7264	!>
7265	!> Moving-centre method assumed, i.e. particles are allowed to grow to their
7266	!> exact size as long as they are not crossing the fixed diameter bin limits.
7267	!> If the particles in a size bin cross the lower or upper diameter limit, they
7268	!> are all moved to the adjacent diameter bin and their volume is averaged with
7269	!> the particles in the new bin, which then get a new diameter.
7270	!
7271	!> Moving-centre method minimises numerical diffusion.
7272	!------------------------------------------------------------------------------!
7273	SUBROUTINE distr_update( paero )
7274
7275	IMPLICIT NONE
7276
7277	INTEGER(iwp) :: ib !< loop index
7278	INTEGER(iwp) :: mm !< loop index
7279	INTEGER(iwp) :: counti !< number of while loops
7280
7281	LOGICAL :: within_bins !< logical (particle belongs to the bin?)
7282
7283	REAL(wp) :: znfrac !< number fraction to be moved to the larger bin
7284	REAL(wp) :: zvfrac !< volume fraction to be moved to the larger bin
7285	REAL(wp) :: zvexc !< Volume in the grown bin which exceeds the bin upper limit
7286	REAL(wp) :: zvihi !< particle volume at the high end of the bin
7287	REAL(wp) :: zvilo !< particle volume at the low end of the bin
7288	REAL(wp) :: zvpart !< particle volume (m3)
7289	REAL(wp) :: zvrat !< volume ratio of a size bin
7290
7291	real(wp), dimension(nbins_aerosol) :: dummy
7292
7293	TYPE(t_section), DIMENSION(nbins_aerosol), INTENT(inout) :: paero !< aerosol properties
7294
7295	zvpart = 0.0_wp
7296	zvfrac = 0.0_wp
7297	within_bins = .FALSE.
7298
7299	dummy = paero(:)%numc
7300	!
7301	!-- Check if the volume of the bin is within bin limits after update
7302	counti = 0
7303	DO WHILE ( .NOT. within_bins )
7304	within_bins = .TRUE.
7305	!
7306	!-- Loop from larger to smaller size bins
7307	DO ib = end_subrange_2b-1, start_subrange_1a, -1
7308	mm = 0
7309	IF ( paero(ib)%numc > nclim ) THEN
7310	zvpart = 0.0_wp
7311	zvfrac = 0.0_wp
7312
7313	IF ( ib == end_subrange_2a ) CYCLE
7314	!
7315	!-- Dry volume
7316	zvpart = SUM( paero(ib)%volc(1:7) ) / paero(ib)%numc
7317	!
7318	!-- Smallest bin cannot decrease
7319	IF ( paero(ib)%vlolim > zvpart .AND. ib == start_subrange_1a ) CYCLE
7320	!
7321	!-- Decreasing bins
7322	IF ( paero(ib)%vlolim > zvpart ) THEN
7323	mm = ib - 1
7324	IF ( ib == start_subrange_2b ) mm = end_subrange_1a ! 2b goes to 1a
7325
7326	paero(mm)%numc = paero(mm)%numc + paero(ib)%numc
7327	paero(ib)%numc = 0.0_wp
7328	paero(mm)%volc(:) = paero(mm)%volc(:) + paero(ib)%volc(:)
7329	paero(ib)%volc(:) = 0.0_wp
7330	CYCLE
7331	ENDIF
7332	!
7333	!-- If size bin has not grown, cycle.
7334	!-- Changed by Mona: compare to the arithmetic mean volume, as done originally. Now
7335	!-- particle volume is derived from the geometric mean diameter, not arithmetic (see
7336	!-- SUBROUTINE set_sizebins).
7337	IF ( zvpart <= api6 * ( ( aero(ib)%vhilim + aero(ib)%vlolim ) / ( 2.0_wp * api6 ) ) ) &
7338	CYCLE
7339	!
7340	!-- Avoid precision problems
7341	IF ( ABS( zvpart - api6 * paero(ib)%dmid**3 ) < 1.0E-35_wp ) CYCLE
7342	!
7343	!-- Volume ratio of the size bin
7344	zvrat = paero(ib)%vhilim / paero(ib)%vlolim
7345	!
7346	!-- Particle volume at the low end of the bin
7347	zvilo = 2.0_wp * zvpart / ( 1.0_wp + zvrat )
7348	!
7349	!-- Particle volume at the high end of the bin
7350	zvihi = zvrat * zvilo
7351	!
7352	!-- Volume in the grown bin which exceeds the bin upper limit
7353	zvexc = 0.5_wp * ( zvihi + paero(ib)%vhilim )
7354	!
7355	!-- Number fraction to be moved to the larger bin
7356	znfrac = MIN( 1.0_wp, ( zvihi - paero(ib)%vhilim) / ( zvihi - zvilo ) )
7357	!
7358	!-- Volume fraction to be moved to the larger bin
7359	zvfrac = MIN( 0.99_wp, znfrac * zvexc / zvpart )
7360	IF ( zvfrac < 0.0_wp ) THEN
7361	message_string = 'Error: zvfrac < 0'
7362	CALL message( 'salsa_mod: distr_update', 'PA0624', 1, 2, 0, 6, 0 )
7363	ENDIF
7364	!
7365	!-- Update bin
7366	mm = ib + 1
7367	!
7368	!-- Volume (cm3/cm3)
7369	paero(mm)%volc(:) = paero(mm)%volc(:) + znfrac * paero(ib)%numc * zvexc * &
7370	paero(ib)%volc(:) / SUM( paero(ib)%volc(1:7) )
7371	paero(ib)%volc(:) = paero(ib)%volc(:) - znfrac * paero(ib)%numc * zvexc * &
7372	paero(ib)%volc(:) / SUM( paero(ib)%volc(1:7) )
7373
7374	!-- Number concentration (#/m3)
7375	paero(mm)%numc = paero(mm)%numc + znfrac * paero(ib)%numc
7376	paero(ib)%numc = paero(ib)%numc * ( 1.0_wp - znfrac )
7377
7378	ENDIF ! nclim
7379
7380	IF ( paero(ib)%numc > nclim ) THEN
7381	zvpart = SUM( paero(ib)%volc(1:7) ) / paero(ib)%numc ! Note: dry volume!
7382	within_bins = ( paero(ib)%vlolim < zvpart .AND. zvpart < paero(ib)%vhilim )
7383	ENDIF
7384
7385	ENDDO ! - ib
7386
7387	counti = counti + 1
7388	IF ( counti > 100 ) THEN
7389	message_string = 'Error: Aerosol bin update not converged'
7390	CALL message( 'salsa_mod: distr_update', 'PA0625', 1, 2, 0, 6, 0 )
7391	ENDIF
7392
7393	ENDDO ! - within bins
7394
7395	END SUBROUTINE distr_update
7396
7397	!------------------------------------------------------------------------------!
7398	! Description:
7399	! ------------
7400	!> salsa_diagnostics: Update properties for the current timestep:
7401	!>
7402	!> Juha Tonttila, FMI, 2014
7403	!> Tomi Raatikainen, FMI, 2016
7404	!------------------------------------------------------------------------------!
7405	SUBROUTINE salsa_diagnostics( i, j )
7406
7407	USE cpulog, &
7408	ONLY: cpu_log, log_point_s
7409
7410	IMPLICIT NONE
7411
7412	INTEGER(iwp) :: ib !<
7413	INTEGER(iwp) :: ic !<
7414	INTEGER(iwp) :: icc !<
7415	INTEGER(iwp) :: ig !<
7416	INTEGER(iwp) :: k !<
7417
7418	INTEGER(iwp), INTENT(in) :: i !<
7419	INTEGER(iwp), INTENT(in) :: j !<
7420
7421	REAL(wp), DIMENSION(nzb:nzt+1) :: flag !< flag to mask topography
7422	REAL(wp), DIMENSION(nzb:nzt+1) :: flag_zddry !< flag to mask zddry
7423	REAL(wp), DIMENSION(nzb:nzt+1) :: in_adn !< air density (kg/m3)
7424	REAL(wp), DIMENSION(nzb:nzt+1) :: in_p !< pressure
7425	REAL(wp), DIMENSION(nzb:nzt+1) :: in_t !< temperature (K)
7426	REAL(wp), DIMENSION(nzb:nzt+1) :: mcsum !< sum of mass concentration
7427	REAL(wp), DIMENSION(nzb:nzt+1) :: ppm_to_nconc !< Conversion factor: ppm to #/m3
7428	REAL(wp), DIMENSION(nzb:nzt+1) :: zddry !< particle dry diameter
7429	REAL(wp), DIMENSION(nzb:nzt+1) :: zvol !< particle volume
7430
7431	flag_zddry = 0.0_wp
7432	in_adn = 0.0_wp
7433	in_p = 0.0_wp
7434	in_t = 0.0_wp
7435	ppm_to_nconc = 1.0_wp
7436	zddry = 0.0_wp
7437	zvol = 0.0_wp
7438
7439	!$OMP MASTER
7440	CALL cpu_log( log_point_s(94), 'salsa diagnostics ', 'start' )
7441	!$OMP END MASTER
7442
7443	!
7444	!-- Calculate thermodynamic quantities needed in SALSA
7445	CALL salsa_thrm_ij( i, j, p_ij=in_p, temp_ij=in_t, adn_ij=in_adn )
7446	!
7447	!-- Calculate conversion factors for gas concentrations
7448	ppm_to_nconc = for_ppm_to_nconc * in_p / in_t
7449	!
7450	!-- Predetermine flag to mask topography
7451	flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(:,j,i), 0 ) )
7452
7453	DO ib = 1, nbins_aerosol ! aerosol size bins
7454	!
7455	!-- Remove negative values
7456	aerosol_number(ib)%conc(:,j,i) = MAX( nclim, aerosol_number(ib)%conc(:,j,i) ) * flag
7457	!
7458	!-- Calculate total mass concentration per bin
7459	mcsum = 0.0_wp
7460	DO ic = 1, ncomponents_mass
7461	icc = ( ic - 1 ) * nbins_aerosol + ib
7462	mcsum = mcsum + aerosol_mass(icc)%conc(:,j,i) * flag
7463	aerosol_mass(icc)%conc(:,j,i) = MAX( mclim, aerosol_mass(icc)%conc(:,j,i) ) * flag
7464	ENDDO
7465	!
7466	!-- Check that number and mass concentration match qualitatively
7467	IF ( ANY( aerosol_number(ib)%conc(:,j,i) > nclim .AND. mcsum <= 0.0_wp ) ) THEN
7468	DO k = nzb+1, nzt
7469	IF ( aerosol_number(ib)%conc(k,j,i) >= nclim .AND. mcsum(k) <= 0.0_wp ) THEN
7470	aerosol_number(ib)%conc(k,j,i) = nclim * flag(k)
7471	DO ic = 1, ncomponents_mass
7472	icc = ( ic - 1 ) * nbins_aerosol + ib
7473	aerosol_mass(icc)%conc(k,j,i) = mclim * flag(k)
7474	ENDDO
7475	ENDIF
7476	ENDDO
7477	ENDIF
7478	!
7479	!-- Update aerosol particle radius
7480	CALL bin_mixrat( 'dry', ib, i, j, zvol )
7481	zvol = zvol / arhoh2so4 ! Why on sulphate?
7482	!
7483	!-- Particles smaller then 0.1 nm diameter are set to zero
7484	zddry = ( zvol / MAX( nclim, aerosol_number(ib)%conc(:,j,i) ) / api6 )**0.33333333_wp
7485	flag_zddry = MERGE( 1.0_wp, 0.0_wp, ( zddry < 1.0E-10_wp .AND. &
7486	aerosol_number(ib)%conc(:,j,i) > nclim ) )
7487	!
7488	!-- Volatile species to the gas phase
7489	IF ( index_so4 > 0 .AND. lscndgas ) THEN
7490	ic = ( index_so4 - 1 ) * nbins_aerosol + ib
7491	IF ( salsa_gases_from_chem ) THEN
7492	ig = gas_index_chem(1)
7493	chem_species(ig)%conc(:,j,i) = chem_species(ig)%conc(:,j,i) + &
7494	aerosol_mass(ic)%conc(:,j,i) * avo * flag_zddry / &
7495	( amh2so4 * ppm_to_nconc ) * flag
7496	ELSE
7497	salsa_gas(1)%conc(:,j,i) = salsa_gas(1)%conc(:,j,i) + aerosol_mass(ic)%conc(:,j,i) / &
7498	amh2so4 * avo * flag_zddry * flag
7499	ENDIF
7500	ENDIF
7501	IF ( index_oc > 0 .AND. lscndgas ) THEN
7502	ic = ( index_oc - 1 ) * nbins_aerosol + ib
7503	IF ( salsa_gases_from_chem ) THEN
7504	ig = gas_index_chem(5)
7505	chem_species(ig)%conc(:,j,i) = chem_species(ig)%conc(:,j,i) + &
7506	aerosol_mass(ic)%conc(:,j,i) * avo * flag_zddry / &
7507	( amoc * ppm_to_nconc ) * flag
7508	ELSE
7509	salsa_gas(5)%conc(:,j,i) = salsa_gas(5)%conc(:,j,i) + aerosol_mass(ic)%conc(:,j,i) / &
7510	amoc * avo * flag_zddry * flag
7511	ENDIF
7512	ENDIF
7513	IF ( index_no > 0 .AND. lscndgas ) THEN
7514	ic = ( index_no - 1 ) * nbins_aerosol + ib
7515	IF ( salsa_gases_from_chem ) THEN
7516	ig = gas_index_chem(2)
7517	chem_species(ig)%conc(:,j,i) = chem_species(ig)%conc(:,j,i) + &
7518	aerosol_mass(ic)%conc(:,j,i) * avo * flag_zddry / &
7519	( amhno3 * ppm_to_nconc ) *flag
7520	ELSE
7521	salsa_gas(2)%conc(:,j,i) = salsa_gas(2)%conc(:,j,i) + aerosol_mass(ic)%conc(:,j,i) / &
7522	amhno3 * avo * flag_zddry * flag
7523	ENDIF
7524	ENDIF
7525	IF ( index_nh > 0 .AND. lscndgas ) THEN
7526	ic = ( index_nh - 1 ) * nbins_aerosol + ib
7527	IF ( salsa_gases_from_chem ) THEN
7528	ig = gas_index_chem(3)
7529	chem_species(ig)%conc(:,j,i) = chem_species(ig)%conc(:,j,i) + &
7530	aerosol_mass(ic)%conc(:,j,i) * avo * flag_zddry / &
7531	( amnh3 * ppm_to_nconc ) *flag
7532	ELSE
7533	salsa_gas(3)%conc(:,j,i) = salsa_gas(3)%conc(:,j,i) + aerosol_mass(ic)%conc(:,j,i) / &
7534	amnh3 * avo * flag_zddry *flag
7535	ENDIF
7536	ENDIF
7537	!
7538	!-- Mass and number to zero (insoluble species and water are lost)
7539	DO ic = 1, ncomponents_mass
7540	icc = ( ic - 1 ) * nbins_aerosol + ib
7541	aerosol_mass(icc)%conc(:,j,i) = MERGE( mclim * flag, aerosol_mass(icc)%conc(:,j,i), &
7542	flag_zddry > 0.0_wp )
7543	ENDDO
7544	aerosol_number(ib)%conc(:,j,i) = MERGE( nclim * flag, aerosol_number(ib)%conc(:,j,i), &
7545	flag_zddry > 0.0_wp )
7546	ra_dry(:,j,i,ib) = MAX( 1.0E-10_wp, 0.5_wp * zddry )
7547
7548	ENDDO
7549	IF ( .NOT. salsa_gases_from_chem ) THEN
7550	DO ig = 1, ngases_salsa
7551	salsa_gas(ig)%conc(:,j,i) = MAX( nclim, salsa_gas(ig)%conc(:,j,i) ) * flag
7552	ENDDO
7553	ENDIF
7554
7555	!$OMP MASTER
7556	CALL cpu_log( log_point_s(94), 'salsa diagnostics ', 'stop' )
7557	!$OMP END MASTER
7558
7559	END SUBROUTINE salsa_diagnostics
7560
7561
7562	!------------------------------------------------------------------------------!
7563	! Description:
7564	! ------------
7565	!> Call for all grid points
7566	!------------------------------------------------------------------------------!
7567	SUBROUTINE salsa_actions( location )
7568
7569
7570	CHARACTER (LEN=*), INTENT(IN) :: location !< call location string
7571
7572	SELECT CASE ( location )
7573
7574	CASE ( 'before_timestep' )
7575
7576	IF ( ws_scheme_sca ) sums_salsa_ws_l = 0.0_wp
7577
7578	CASE DEFAULT
7579	CONTINUE
7580
7581	END SELECT
7582
7583	END SUBROUTINE salsa_actions
7584
7585
7586	!------------------------------------------------------------------------------!
7587	! Description:
7588	! ------------
7589	!> Call for grid points i,j
7590	!------------------------------------------------------------------------------!
7591
7592	SUBROUTINE salsa_actions_ij( i, j, location )
7593
7594
7595	INTEGER(iwp), INTENT(IN) :: i !< grid index in x-direction
7596	INTEGER(iwp), INTENT(IN) :: j !< grid index in y-direction
7597	CHARACTER (LEN=*), INTENT(IN) :: location !< call location string
7598	INTEGER(iwp) :: dummy !< call location string
7599
7600	IF ( salsa ) dummy = i + j
7601
7602	SELECT CASE ( location )
7603
7604	CASE ( 'before_timestep' )
7605
7606	IF ( ws_scheme_sca ) sums_salsa_ws_l = 0.0_wp
7607
7608	CASE DEFAULT
7609	CONTINUE
7610
7611	END SELECT
7612
7613
7614	END SUBROUTINE salsa_actions_ij
7615
7616	!------------------------------------------------------------------------------!
7617	! Description:
7618	! ------------
7619	!> Call for all grid points
7620	!------------------------------------------------------------------------------!
7621	SUBROUTINE salsa_non_advective_processes
7622
7623	USE cpulog, &
7624	ONLY: cpu_log, log_point_s
7625
7626	IMPLICIT NONE
7627
7628	INTEGER(iwp) :: i !<
7629	INTEGER(iwp) :: j !<
7630
7631	IF ( time_since_reference_point >= skip_time_do_salsa ) THEN
7632	IF ( ( time_since_reference_point - last_salsa_time ) >= dt_salsa ) THEN
7633	!
7634	!-- Calculate aerosol dynamic processes. salsa_driver can be run with a longer time step.
7635	CALL cpu_log( log_point_s(90), 'salsa processes ', 'start' )
7636	DO i = nxl, nxr
7637	DO j = nys, nyn
7638	CALL salsa_diagnostics( i, j )
7639	CALL salsa_driver( i, j, 3 )
7640	CALL salsa_diagnostics( i, j )
7641	ENDDO
7642	ENDDO
7643	CALL cpu_log( log_point_s(90), 'salsa processes ', 'stop' )
7644	ENDIF
7645	ENDIF
7646
7647	END SUBROUTINE salsa_non_advective_processes
7648
7649
7650	!------------------------------------------------------------------------------!
7651	! Description:
7652	! ------------
7653	!> Call for grid points i,j
7654	!------------------------------------------------------------------------------!
7655	SUBROUTINE salsa_non_advective_processes_ij( i, j )
7656
7657	USE cpulog, &
7658	ONLY: cpu_log, log_point_s
7659
7660	IMPLICIT NONE
7661
7662	INTEGER(iwp), INTENT(IN) :: i !< grid index in x-direction
7663	INTEGER(iwp), INTENT(IN) :: j !< grid index in y-direction
7664
7665	IF ( time_since_reference_point >= skip_time_do_salsa ) THEN
7666	IF ( ( time_since_reference_point - last_salsa_time ) >= dt_salsa ) THEN
7667	!
7668	!-- Calculate aerosol dynamic processes. salsa_driver can be run with a longer time step.
7669	CALL cpu_log( log_point_s(90), 'salsa processes ', 'start' )
7670	CALL salsa_diagnostics( i, j )
7671	CALL salsa_driver( i, j, 3 )
7672	CALL salsa_diagnostics( i, j )
7673	CALL cpu_log( log_point_s(90), 'salsa processes ', 'stop' )
7674	ENDIF
7675	ENDIF
7676
7677	END SUBROUTINE salsa_non_advective_processes_ij
7678
7679	!------------------------------------------------------------------------------!
7680	! Description:
7681	! ------------
7682	!> Routine for exchange horiz of salsa variables.
7683	!------------------------------------------------------------------------------!
7684	SUBROUTINE salsa_exchange_horiz_bounds
7685
7686	USE cpulog, &
7687	ONLY: cpu_log, log_point_s
7688
7689	IMPLICIT NONE
7690
7691	INTEGER(iwp) :: ib !<
7692	INTEGER(iwp) :: ic !<
7693	INTEGER(iwp) :: icc !<
7694	INTEGER(iwp) :: ig !<
7695
7696	IF ( time_since_reference_point >= skip_time_do_salsa ) THEN
7697	IF ( ( time_since_reference_point - last_salsa_time ) >= dt_salsa ) THEN
7698
7699	CALL cpu_log( log_point_s(91), 'salsa exch-horiz ', 'start' )
7700	!
7701	!-- Exchange ghost points and decycle if needed.
7702	DO ib = 1, nbins_aerosol
7703	CALL exchange_horiz( aerosol_number(ib)%conc, nbgp )
7704	CALL salsa_boundary_conds( aerosol_number(ib)%conc, aerosol_number(ib)%init )
7705	DO ic = 1, ncomponents_mass
7706	icc = ( ic - 1 ) * nbins_aerosol + ib
7707	CALL exchange_horiz( aerosol_mass(icc)%conc, nbgp )
7708	CALL salsa_boundary_conds( aerosol_mass(icc)%conc, aerosol_mass(icc)%init )
7709	ENDDO
7710	ENDDO
7711	IF ( .NOT. salsa_gases_from_chem ) THEN
7712	DO ig = 1, ngases_salsa
7713	CALL exchange_horiz( salsa_gas(ig)%conc, nbgp )
7714	CALL salsa_boundary_conds( salsa_gas(ig)%conc, salsa_gas(ig)%init )
7715	ENDDO
7716	ENDIF
7717	CALL cpu_log( log_point_s(91), 'salsa exch-horiz ', 'stop' )
7718	!
7719	!-- Update last_salsa_time
7720	last_salsa_time = time_since_reference_point
7721	ENDIF
7722	ENDIF
7723
7724	END SUBROUTINE salsa_exchange_horiz_bounds
7725
7726	!------------------------------------------------------------------------------!
7727	! Description:
7728	! ------------
7729	!> Calculate the prognostic equation for aerosol number and mass, and gas
7730	!> concentrations. Cache-optimized.
7731	!------------------------------------------------------------------------------!
7732	SUBROUTINE salsa_prognostic_equations_ij( i, j, i_omp_start, tn )
7733
7734	IMPLICIT NONE
7735
7736	INTEGER(iwp) :: i !<
7737	INTEGER(iwp) :: i_omp_start !<
7738	INTEGER(iwp) :: ib !< loop index for aerosol number bin OR gas index
7739	INTEGER(iwp) :: ic !< loop index for aerosol mass bin
7740	INTEGER(iwp) :: icc !< (c-1)*nbins_aerosol+b
7741	INTEGER(iwp) :: ig !< loop index for salsa gases
7742	INTEGER(iwp) :: j !<
7743	INTEGER(iwp) :: tn !<
7744
7745	IF ( time_since_reference_point >= skip_time_do_salsa ) THEN
7746	!
7747	!-- Aerosol number
7748	DO ib = 1, nbins_aerosol
7749	!kk sums_salsa_ws_l = aerosol_number(ib)%sums_ws_l
7750	CALL salsa_tendency( 'aerosol_number', aerosol_number(ib)%conc_p, aerosol_number(ib)%conc,&
7751	aerosol_number(ib)%tconc_m, i, j, i_omp_start, tn, ib, ib, &
7752	aerosol_number(ib)%flux_s, aerosol_number(ib)%diss_s, &
7753	aerosol_number(ib)%flux_l, aerosol_number(ib)%diss_l, &
7754	aerosol_number(ib)%init, .TRUE. )
7755	!kk aerosol_number(ib)%sums_ws_l = sums_salsa_ws_l
7756	!
7757	!-- Aerosol mass
7758	DO ic = 1, ncomponents_mass
7759	icc = ( ic - 1 ) * nbins_aerosol + ib
7760	!kk sums_salsa_ws_l = aerosol_mass(icc)%sums_ws_l
7761	CALL salsa_tendency( 'aerosol_mass', aerosol_mass(icc)%conc_p, aerosol_mass(icc)%conc,&
7762	aerosol_mass(icc)%tconc_m, i, j, i_omp_start, tn, ib, ic, &
7763	aerosol_mass(icc)%flux_s, aerosol_mass(icc)%diss_s, &
7764	aerosol_mass(icc)%flux_l, aerosol_mass(icc)%diss_l, &
7765	aerosol_mass(icc)%init, .TRUE. )
7766	!kk aerosol_mass(icc)%sums_ws_l = sums_salsa_ws_l
7767
7768	ENDDO ! ic
7769	ENDDO ! ib
7770	!
7771	!-- Gases
7772	IF ( .NOT. salsa_gases_from_chem ) THEN
7773
7774	DO ig = 1, ngases_salsa
7775	!kk sums_salsa_ws_l = salsa_gas(ig)%sums_ws_l
7776	CALL salsa_tendency( 'salsa_gas', salsa_gas(ig)%conc_p, salsa_gas(ig)%conc, &
7777	salsa_gas(ig)%tconc_m, i, j, i_omp_start, tn, ig, ig, &
7778	salsa_gas(ig)%flux_s, salsa_gas(ig)%diss_s, salsa_gas(ig)%flux_l,&
7779	salsa_gas(ig)%diss_l, salsa_gas(ig)%init, .FALSE. )
7780	!kk salsa_gas(ig)%sums_ws_l = sums_salsa_ws_l
7781
7782	ENDDO ! ig
7783
7784	ENDIF
7785
7786	ENDIF
7787
7788	END SUBROUTINE salsa_prognostic_equations_ij
7789	!
7790	!------------------------------------------------------------------------------!
7791	! Description:
7792	! ------------
7793	!> Calculate the prognostic equation for aerosol number and mass, and gas
7794	!> concentrations. For vector machines.
7795	!------------------------------------------------------------------------------!
7796	SUBROUTINE salsa_prognostic_equations()
7797
7798	IMPLICIT NONE
7799
7800	INTEGER(iwp) :: ib !< loop index for aerosol number bin OR gas index
7801	INTEGER(iwp) :: ic !< loop index for aerosol mass bin
7802	INTEGER(iwp) :: icc !< (c-1)*nbins_aerosol+b
7803	INTEGER(iwp) :: ig !< loop index for salsa gases
7804
7805	IF ( time_since_reference_point >= skip_time_do_salsa ) THEN
7806	!
7807	!-- Aerosol number
7808	DO ib = 1, nbins_aerosol
7809	sums_salsa_ws_l = aerosol_number(ib)%sums_ws_l
7810	CALL salsa_tendency( 'aerosol_number', aerosol_number(ib)%conc_p, aerosol_number(ib)%conc,&
7811	aerosol_number(ib)%tconc_m, ib, ib, aerosol_number(ib)%init, .TRUE. )
7812	aerosol_number(ib)%sums_ws_l = sums_salsa_ws_l
7813	!
7814	!-- Aerosol mass
7815	DO ic = 1, ncomponents_mass
7816	icc = ( ic - 1 ) * nbins_aerosol + ib
7817	sums_salsa_ws_l = aerosol_mass(icc)%sums_ws_l
7818	CALL salsa_tendency( 'aerosol_mass', aerosol_mass(icc)%conc_p, aerosol_mass(icc)%conc,&
7819	aerosol_mass(icc)%tconc_m, ib, ic, aerosol_mass(icc)%init, .TRUE. )
7820	aerosol_mass(icc)%sums_ws_l = sums_salsa_ws_l
7821
7822	ENDDO ! ic
7823	ENDDO ! ib
7824	!
7825	!-- Gases
7826	IF ( .NOT. salsa_gases_from_chem ) THEN
7827
7828	DO ig = 1, ngases_salsa
7829	sums_salsa_ws_l = salsa_gas(ig)%sums_ws_l
7830	CALL salsa_tendency( 'salsa_gas', salsa_gas(ig)%conc_p, salsa_gas(ig)%conc, &
7831	salsa_gas(ig)%tconc_m, ig, ig, salsa_gas(ig)%init, .FALSE. )
7832	salsa_gas(ig)%sums_ws_l = sums_salsa_ws_l
7833
7834	ENDDO ! ig
7835
7836	ENDIF
7837
7838	ENDIF
7839
7840	END SUBROUTINE salsa_prognostic_equations
7841	!
7842	!------------------------------------------------------------------------------!
7843	! Description:
7844	! ------------
7845	!> Tendencies for aerosol number and mass and gas concentrations.
7846	!> Cache-optimized.
7847	!------------------------------------------------------------------------------!
7848	SUBROUTINE salsa_tendency_ij( id, rs_p, rs, trs_m, i, j, i_omp_start, tn, ib, ic, flux_s, diss_s, &
7849	flux_l, diss_l, rs_init, do_sedimentation )
7850
7851	USE advec_ws, &
7852	ONLY: advec_s_ws
7853
7854	USE advec_s_pw_mod, &
7855	ONLY: advec_s_pw
7856
7857	USE advec_s_up_mod, &
7858	ONLY: advec_s_up
7859
7860	USE arrays_3d, &
7861	ONLY: ddzu, rdf_sc, tend
7862
7863	USE diffusion_s_mod, &
7864	ONLY: diffusion_s
7865
7866	USE indices, &
7867	ONLY: wall_flags_total_0
7868
7869	USE surface_mod, &
7870	ONLY : surf_def_h, surf_def_v, surf_lsm_h, surf_lsm_v, surf_usm_h, surf_usm_v
7871
7872	IMPLICIT NONE
7873
7874	CHARACTER(LEN = *) :: id !<
7875
7876	INTEGER(iwp) :: i !<
7877	INTEGER(iwp) :: i_omp_start !<
7878	INTEGER(iwp) :: ib !< loop index for aerosol number bin OR gas index
7879	INTEGER(iwp) :: ic !< loop index for aerosol mass bin
7880	INTEGER(iwp) :: icc !< (c-1)*nbins_aerosol+b
7881	INTEGER(iwp) :: j !<
7882	INTEGER(iwp) :: k !<
7883	INTEGER(iwp) :: tn !<
7884
7885	LOGICAL :: do_sedimentation !<
7886
7887	REAL(wp), DIMENSION(nzb:nzt+1) :: rs_init !<
7888
7889	REAL(wp), DIMENSION(nzb+1:nzt,0:threads_per_task-1) :: diss_s !<
7890	REAL(wp), DIMENSION(nzb+1:nzt,0:threads_per_task-1) :: flux_s !<
7891
7892	REAL(wp), DIMENSION(nzb+1:nzt,nys:nyn,0:threads_per_task-1) :: diss_l !<
7893	REAL(wp), DIMENSION(nzb+1:nzt,nys:nyn,0:threads_per_task-1) :: flux_l !<
7894
7895	REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) :: rs_p !<
7896	REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) :: rs !<
7897	REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) :: trs_m !<
7898
7899	icc = ( ic - 1 ) * nbins_aerosol + ib
7900	!
7901	!-- Tendency-terms for reactive scalar
7902	tend(:,j,i) = 0.0_wp
7903	!
7904	!-- Advection terms
7905	IF ( timestep_scheme(1:5) == 'runge' ) THEN
7906	IF ( ws_scheme_sca ) THEN
7907	CALL advec_s_ws( salsa_advc_flags_s, i, j, rs, id, flux_s, diss_s, flux_l, diss_l, &
7908	i_omp_start, tn, bc_dirichlet_l .OR. bc_radiation_l, &
7909	bc_dirichlet_n .OR. bc_radiation_n, &
7910	bc_dirichlet_r .OR. bc_radiation_r, &
7911	bc_dirichlet_s .OR. bc_radiation_s, monotonic_limiter_z )
7912	ELSE
7913	CALL advec_s_pw( i, j, rs )
7914	ENDIF
7915	ELSE
7916	CALL advec_s_up( i, j, rs )
7917	ENDIF
7918	!
7919	!-- Diffusion terms
7920	SELECT CASE ( id )
7921	CASE ( 'aerosol_number' )
7922	CALL diffusion_s( i, j, rs, surf_def_h(0)%answs(:,ib), &
7923	surf_def_h(1)%answs(:,ib), surf_def_h(2)%answs(:,ib), &
7924	surf_lsm_h%answs(:,ib), surf_usm_h%answs(:,ib), &
7925	surf_def_v(0)%answs(:,ib), surf_def_v(1)%answs(:,ib), &
7926	surf_def_v(2)%answs(:,ib), surf_def_v(3)%answs(:,ib), &
7927	surf_lsm_v(0)%answs(:,ib), surf_lsm_v(1)%answs(:,ib), &
7928	surf_lsm_v(2)%answs(:,ib), surf_lsm_v(3)%answs(:,ib), &
7929	surf_usm_v(0)%answs(:,ib), surf_usm_v(1)%answs(:,ib), &
7930	surf_usm_v(2)%answs(:,ib), surf_usm_v(3)%answs(:,ib) )
7931	CASE ( 'aerosol_mass' )
7932	CALL diffusion_s( i, j, rs, surf_def_h(0)%amsws(:,icc), &
7933	surf_def_h(1)%amsws(:,icc), surf_def_h(2)%amsws(:,icc), &
7934	surf_lsm_h%amsws(:,icc), surf_usm_h%amsws(:,icc), &
7935	surf_def_v(0)%amsws(:,icc), surf_def_v(1)%amsws(:,icc), &
7936	surf_def_v(2)%amsws(:,icc), surf_def_v(3)%amsws(:,icc), &
7937	surf_lsm_v(0)%amsws(:,icc), surf_lsm_v(1)%amsws(:,icc), &
7938	surf_lsm_v(2)%amsws(:,icc), surf_lsm_v(3)%amsws(:,icc), &
7939	surf_usm_v(0)%amsws(:,icc), surf_usm_v(1)%amsws(:,icc), &
7940	surf_usm_v(2)%amsws(:,icc), surf_usm_v(3)%amsws(:,icc) )
7941	CASE ( 'salsa_gas' )
7942	CALL diffusion_s( i, j, rs, surf_def_h(0)%gtsws(:,ib), &
7943	surf_def_h(1)%gtsws(:,ib), surf_def_h(2)%gtsws(:,ib), &
7944	surf_lsm_h%gtsws(:,ib), surf_usm_h%gtsws(:,ib), &
7945	surf_def_v(0)%gtsws(:,ib), surf_def_v(1)%gtsws(:,ib), &
7946	surf_def_v(2)%gtsws(:,ib), surf_def_v(3)%gtsws(:,ib), &
7947	surf_lsm_v(0)%gtsws(:,ib), surf_lsm_v(1)%gtsws(:,ib), &
7948	surf_lsm_v(2)%gtsws(:,ib), surf_lsm_v(3)%gtsws(:,ib), &
7949	surf_usm_v(0)%gtsws(:,ib), surf_usm_v(1)%gtsws(:,ib), &
7950	surf_usm_v(2)%gtsws(:,ib), surf_usm_v(3)%gtsws(:,ib) )
7951	END SELECT
7952	!
7953	!-- Sedimentation and prognostic equation for aerosol number and mass
7954	IF ( lsdepo .AND. do_sedimentation ) THEN
7955	!DIR$ IVDEP
7956	DO k = nzb+1, nzt
7957	tend(k,j,i) = tend(k,j,i) - MAX( 0.0_wp, ( rs(k+1,j,i) * sedim_vd(k+1,j,i,ib) - &
7958	rs(k,j,i) * sedim_vd(k,j,i,ib) ) * ddzu(k) ) &
7959	* MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k-1,j,i), 0 ) )
7960	rs_p(k,j,i) = rs(k,j,i) + ( dt_3d * ( tsc(2) * tend(k,j,i) + tsc(3) * trs_m(k,j,i) ) &
7961	- tsc(5) * rdf_sc(k) * ( rs(k,j,i) - rs_init(k) ) ) &
7962	* MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) )
7963	IF ( rs_p(k,j,i) < 0.0_wp ) rs_p(k,j,i) = 0.1_wp * rs(k,j,i)
7964	ENDDO
7965	ELSE
7966	!
7967	!-- Prognostic equation
7968	!DIR$ IVDEP
7969	DO k = nzb+1, nzt
7970	rs_p(k,j,i) = rs(k,j,i) + ( dt_3d * ( tsc(2) * tend(k,j,i) + tsc(3) * trs_m(k,j,i) ) &
7971	- tsc(5) * rdf_sc(k) * ( rs(k,j,i) - rs_init(k) ) )&
7972	* MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) )
7973	IF ( rs_p(k,j,i) < 0.0_wp ) rs_p(k,j,i) = 0.1_wp * rs(k,j,i)
7974	ENDDO
7975	ENDIF
7976	!
7977	!-- Calculate tendencies for the next Runge-Kutta step
7978	IF ( timestep_scheme(1:5) == 'runge' ) THEN
7979	IF ( intermediate_timestep_count == 1 ) THEN
7980	DO k = nzb+1, nzt
7981	trs_m(k,j,i) = tend(k,j,i)
7982	ENDDO
7983	ELSEIF ( intermediate_timestep_count < intermediate_timestep_count_max ) THEN
7984	DO k = nzb+1, nzt
7985	trs_m(k,j,i) = -9.5625_wp * tend(k,j,i) + 5.3125_wp * trs_m(k,j,i)
7986	ENDDO
7987	ENDIF
7988	ENDIF
7989
7990	END SUBROUTINE salsa_tendency_ij
7991	!
7992	!------------------------------------------------------------------------------!
7993	! Description:
7994	! ------------
7995	!> Calculate the tendencies for aerosol number and mass concentrations.
7996	!> For vector machines.
7997	!------------------------------------------------------------------------------!
7998	SUBROUTINE salsa_tendency( id, rs_p, rs, trs_m, ib, ic, rs_init, do_sedimentation )
7999
8000	USE advec_ws, &
8001	ONLY: advec_s_ws
8002	USE advec_s_pw_mod, &
8003	ONLY: advec_s_pw
8004	USE advec_s_up_mod, &
8005	ONLY: advec_s_up
8006	USE arrays_3d, &
8007	ONLY: ddzu, rdf_sc, tend
8008	USE diffusion_s_mod, &
8009	ONLY: diffusion_s
8010	USE indices, &
8011	ONLY: wall_flags_total_0
8012	USE surface_mod, &
8013	ONLY : surf_def_h, surf_def_v, surf_lsm_h, surf_lsm_v, surf_usm_h, surf_usm_v
8014
8015	IMPLICIT NONE
8016
8017	CHARACTER(LEN = *) :: id
8018
8019	INTEGER(iwp) :: ib !< loop index for aerosol number bin OR gas index
8020	INTEGER(iwp) :: ic !< loop index for aerosol mass bin
8021	INTEGER(iwp) :: icc !< (c-1)*nbins_aerosol+b
8022	INTEGER(iwp) :: i !<
8023	INTEGER(iwp) :: j !<
8024	INTEGER(iwp) :: k !<
8025
8026	LOGICAL :: do_sedimentation !<
8027
8028	REAL(wp), DIMENSION(nzb:nzt+1) :: rs_init !<
8029
8030	REAL(wp), DIMENSION(:,:,:), POINTER :: rs_p !<
8031	REAL(wp), DIMENSION(:,:,:), POINTER :: rs !<
8032	REAL(wp), DIMENSION(:,:,:), POINTER :: trs_m !<
8033
8034	icc = ( ic - 1 ) * nbins_aerosol + ib
8035	!
8036	!-- Tendency-terms for reactive scalar
8037	tend = 0.0_wp
8038	!
8039	!-- Advection terms
8040	IF ( timestep_scheme(1:5) == 'runge' ) THEN
8041	IF ( ws_scheme_sca ) THEN
8042	CALL advec_s_ws( salsa_advc_flags_s, rs, id, bc_dirichlet_l .OR. bc_radiation_l, &
8043	bc_dirichlet_n .OR. bc_radiation_n, &
8044	bc_dirichlet_r .OR. bc_radiation_r, &
8045	bc_dirichlet_s .OR. bc_radiation_s )
8046	ELSE
8047	CALL advec_s_pw( rs )
8048	ENDIF
8049	ELSE
8050	CALL advec_s_up( rs )
8051	ENDIF
8052	!
8053	!-- Diffusion terms
8054	SELECT CASE ( id )
8055	CASE ( 'aerosol_number' )
8056	CALL diffusion_s( rs, surf_def_h(0)%answs(:,ib), &
8057	surf_def_h(1)%answs(:,ib), surf_def_h(2)%answs(:,ib), &
8058	surf_lsm_h%answs(:,ib), surf_usm_h%answs(:,ib), &
8059	surf_def_v(0)%answs(:,ib), surf_def_v(1)%answs(:,ib), &
8060	surf_def_v(2)%answs(:,ib), surf_def_v(3)%answs(:,ib), &
8061	surf_lsm_v(0)%answs(:,ib), surf_lsm_v(1)%answs(:,ib), &
8062	surf_lsm_v(2)%answs(:,ib), surf_lsm_v(3)%answs(:,ib), &
8063	surf_usm_v(0)%answs(:,ib), surf_usm_v(1)%answs(:,ib), &
8064	surf_usm_v(2)%answs(:,ib), surf_usm_v(3)%answs(:,ib) )
8065	CASE ( 'aerosol_mass' )
8066	CALL diffusion_s( rs, surf_def_h(0)%amsws(:,icc), &
8067	surf_def_h(1)%amsws(:,icc), surf_def_h(2)%amsws(:,icc), &
8068	surf_lsm_h%amsws(:,icc), surf_usm_h%amsws(:,icc), &
8069	surf_def_v(0)%amsws(:,icc), surf_def_v(1)%amsws(:,icc), &
8070	surf_def_v(2)%amsws(:,icc), surf_def_v(3)%amsws(:,icc), &
8071	surf_lsm_v(0)%amsws(:,icc), surf_lsm_v(1)%amsws(:,icc), &
8072	surf_lsm_v(2)%amsws(:,icc), surf_lsm_v(3)%amsws(:,icc), &
8073	surf_usm_v(0)%amsws(:,icc), surf_usm_v(1)%amsws(:,icc), &
8074	surf_usm_v(2)%amsws(:,icc), surf_usm_v(3)%amsws(:,icc) )
8075	CASE ( 'salsa_gas' )
8076	CALL diffusion_s( rs, surf_def_h(0)%gtsws(:,ib), &
8077	surf_def_h(1)%gtsws(:,ib), surf_def_h(2)%gtsws(:,ib), &
8078	surf_lsm_h%gtsws(:,ib), surf_usm_h%gtsws(:,ib), &
8079	surf_def_v(0)%gtsws(:,ib), surf_def_v(1)%gtsws(:,ib), &
8080	surf_def_v(2)%gtsws(:,ib), surf_def_v(3)%gtsws(:,ib), &
8081	surf_lsm_v(0)%gtsws(:,ib), surf_lsm_v(1)%gtsws(:,ib), &
8082	surf_lsm_v(2)%gtsws(:,ib), surf_lsm_v(3)%gtsws(:,ib), &
8083	surf_usm_v(0)%gtsws(:,ib), surf_usm_v(1)%gtsws(:,ib), &
8084	surf_usm_v(2)%gtsws(:,ib), surf_usm_v(3)%gtsws(:,ib) )
8085	END SELECT
8086	!
8087	!-- Prognostic equation for a scalar
8088	DO i = nxl, nxr
8089	DO j = nys, nyn
8090	!
8091	!-- Sedimentation for aerosol number and mass
8092	IF ( lsdepo .AND. do_sedimentation ) THEN
8093	tend(nzb+1:nzt,j,i) = tend(nzb+1:nzt,j,i) - MAX( 0.0_wp, ( rs(nzb+2:nzt+1,j,i) * &
8094	sedim_vd(nzb+2:nzt+1,j,i,ib) - rs(nzb+1:nzt,j,i) * &
8095	sedim_vd(nzb+1:nzt,j,i,ib) ) * ddzu(nzb+1:nzt) ) * &
8096	MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(nzb:nzt-1,j,i), 0 ) )
8097	ENDIF
8098	DO k = nzb+1, nzt
8099	rs_p(k,j,i) = rs(k,j,i) + ( dt_3d * ( tsc(2) * tend(k,j,i) + tsc(3) * trs_m(k,j,i) )&
8100	- tsc(5) * rdf_sc(k) * ( rs(k,j,i) - rs_init(k) )&
8101	) * MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) )
8102	IF ( rs_p(k,j,i) < 0.0_wp ) rs_p(k,j,i) = 0.1_wp * rs(k,j,i)
8103	ENDDO
8104	ENDDO
8105	ENDDO
8106	!
8107	!-- Calculate tendencies for the next Runge-Kutta step
8108	IF ( timestep_scheme(1:5) == 'runge' ) THEN
8109	IF ( intermediate_timestep_count == 1 ) THEN
8110	DO i = nxl, nxr
8111	DO j = nys, nyn
8112	DO k = nzb+1, nzt
8113	trs_m(k,j,i) = tend(k,j,i)
8114	ENDDO
8115	ENDDO
8116	ENDDO
8117	ELSEIF ( intermediate_timestep_count < intermediate_timestep_count_max ) THEN
8118	DO i = nxl, nxr
8119	DO j = nys, nyn
8120	DO k = nzb+1, nzt
8121	trs_m(k,j,i) = -9.5625_wp * tend(k,j,i) + 5.3125_wp * trs_m(k,j,i)
8122	ENDDO
8123	ENDDO
8124	ENDDO
8125	ENDIF
8126	ENDIF
8127
8128	END SUBROUTINE salsa_tendency
8129
8130
8131	!------------------------------------------------------------------------------!
8132	! Description:
8133	! ------------
8134	!> Boundary conditions for prognostic variables in SALSA from module interface
8135	!------------------------------------------------------------------------------!
8136	SUBROUTINE salsa_boundary_conditions
8137
8138	IMPLICIT NONE
8139
8140	INTEGER(iwp) :: ib !< index for aerosol size bins
8141	INTEGER(iwp) :: ic !< index for aerosol mass bins
8142	INTEGER(iwp) :: icc !< additional index for aerosol mass bins
8143	INTEGER(iwp) :: ig !< index for salsa gases
8144
8145
8146	!
8147	!-- moved from boundary_conds
8148	CALL salsa_boundary_conds
8149	!
8150	!-- Boundary conditions for prognostic quantitites of other modules:
8151	!-- Here, only decycling is carried out
8152	IF ( time_since_reference_point >= skip_time_do_salsa ) THEN
8153
8154	DO ib = 1, nbins_aerosol
8155	CALL salsa_boundary_conds( aerosol_number(ib)%conc_p, aerosol_number(ib)%init )
8156	DO ic = 1, ncomponents_mass
8157	icc = ( ic - 1 ) * nbins_aerosol + ib
8158	CALL salsa_boundary_conds( aerosol_mass(icc)%conc_p, aerosol_mass(icc)%init )
8159	ENDDO
8160	ENDDO
8161	IF ( .NOT. salsa_gases_from_chem ) THEN
8162	DO ig = 1, ngases_salsa
8163	CALL salsa_boundary_conds( salsa_gas(ig)%conc_p, salsa_gas(ig)%init )
8164	ENDDO
8165	ENDIF
8166
8167	ENDIF
8168
8169	END SUBROUTINE salsa_boundary_conditions
8170
8171	!------------------------------------------------------------------------------!
8172	! Description:
8173	! ------------
8174	!> Boundary conditions for prognostic variables in SALSA
8175	!------------------------------------------------------------------------------!
8176	SUBROUTINE salsa_boundary_conds
8177
8178	USE arrays_3d, &
8179	ONLY: dzu
8180
8181	USE surface_mod, &
8182	ONLY : bc_h
8183
8184	IMPLICIT NONE
8185
8186	INTEGER(iwp) :: i !< grid index x direction
8187	INTEGER(iwp) :: ib !< index for aerosol size bins
8188	INTEGER(iwp) :: ic !< index for chemical compounds in aerosols
8189	INTEGER(iwp) :: icc !< additional index for chemical compounds in aerosols
8190	INTEGER(iwp) :: ig !< idex for gaseous compounds
8191	INTEGER(iwp) :: j !< grid index y direction
8192	INTEGER(iwp) :: k !< grid index y direction
8193	INTEGER(iwp) :: l !< running index boundary type, for up- and downward-facing walls
8194	INTEGER(iwp) :: m !< running index surface elements
8195
8196	IF ( time_since_reference_point >= skip_time_do_salsa ) THEN
8197	!
8198	!-- Surface conditions:
8199	IF ( ibc_salsa_b == 0 ) THEN ! Dirichlet
8200	!
8201	!-- Run loop over all non-natural and natural walls. Note, in wall-datatype the k coordinate
8202	!-- belongs to the atmospheric grid point, therefore, set s_p at k-1
8203	DO l = 0, 1
8204	!$OMP PARALLEL PRIVATE( ib, ic, icc, ig, i, j, k )
8205	!$OMP DO
8206	DO m = 1, bc_h(l)%ns
8207
8208	i = bc_h(l)%i(m)
8209	j = bc_h(l)%j(m)
8210	k = bc_h(l)%k(m)
8211
8212	DO ib = 1, nbins_aerosol
8213	aerosol_number(ib)%conc_p(k+bc_h(l)%koff,j,i) = &
8214	aerosol_number(ib)%conc(k+bc_h(l)%koff,j,i)
8215	DO ic = 1, ncomponents_mass
8216	icc = ( ic - 1 ) * nbins_aerosol + ib
8217	aerosol_mass(icc)%conc_p(k+bc_h(l)%koff,j,i) = &
8218	aerosol_mass(icc)%conc(k+bc_h(l)%koff,j,i)
8219	ENDDO
8220	ENDDO
8221	IF ( .NOT. salsa_gases_from_chem ) THEN
8222	DO ig = 1, ngases_salsa
8223	salsa_gas(ig)%conc_p(k+bc_h(l)%koff,j,i) = &
8224	salsa_gas(ig)%conc(k+bc_h(l)%koff,j,i)
8225	ENDDO
8226	ENDIF
8227
8228	ENDDO
8229	!$OMP END PARALLEL
8230
8231	ENDDO
8232
8233	ELSE ! Neumann
8234
8235	DO l = 0, 1
8236	!$OMP PARALLEL PRIVATE( ib, ic, icc, ig, i, j, k )
8237	!$OMP DO
8238	DO m = 1, bc_h(l)%ns
8239
8240	i = bc_h(l)%i(m)
8241	j = bc_h(l)%j(m)
8242	k = bc_h(l)%k(m)
8243
8244	DO ib = 1, nbins_aerosol
8245	aerosol_number(ib)%conc_p(k+bc_h(l)%koff,j,i) = &
8246	aerosol_number(ib)%conc_p(k,j,i)
8247	DO ic = 1, ncomponents_mass
8248	icc = ( ic - 1 ) * nbins_aerosol + ib
8249	aerosol_mass(icc)%conc_p(k+bc_h(l)%koff,j,i) = &
8250	aerosol_mass(icc)%conc_p(k,j,i)
8251	ENDDO
8252	ENDDO
8253	IF ( .NOT. salsa_gases_from_chem ) THEN
8254	DO ig = 1, ngases_salsa
8255	salsa_gas(ig)%conc_p(k+bc_h(l)%koff,j,i) = &
8256	salsa_gas(ig)%conc_p(k,j,i)
8257	ENDDO
8258	ENDIF
8259
8260	ENDDO
8261	!$OMP END PARALLEL
8262	ENDDO
8263
8264	ENDIF
8265	!
8266	!-- Top boundary conditions:
8267	IF ( ibc_salsa_t == 0 ) THEN ! Dirichlet
8268
8269	DO ib = 1, nbins_aerosol
8270	aerosol_number(ib)%conc_p(nzt+1,:,:) = aerosol_number(ib)%conc(nzt+1,:,:)
8271	DO ic = 1, ncomponents_mass
8272	icc = ( ic - 1 ) * nbins_aerosol + ib
8273	aerosol_mass(icc)%conc_p(nzt+1,:,:) = aerosol_mass(icc)%conc(nzt+1,:,:)
8274	ENDDO
8275	ENDDO
8276	IF ( .NOT. salsa_gases_from_chem ) THEN
8277	DO ig = 1, ngases_salsa
8278	salsa_gas(ig)%conc_p(nzt+1,:,:) = salsa_gas(ig)%conc(nzt+1,:,:)
8279	ENDDO
8280	ENDIF
8281
8282	ELSEIF ( ibc_salsa_t == 1 ) THEN ! Neumann
8283
8284	DO ib = 1, nbins_aerosol
8285	aerosol_number(ib)%conc_p(nzt+1,:,:) = aerosol_number(ib)%conc_p(nzt,:,:)
8286	DO ic = 1, ncomponents_mass
8287	icc = ( ic - 1 ) * nbins_aerosol + ib
8288	aerosol_mass(icc)%conc_p(nzt+1,:,:) = aerosol_mass(icc)%conc_p(nzt,:,:)
8289	ENDDO
8290	ENDDO
8291	IF ( .NOT. salsa_gases_from_chem ) THEN
8292	DO ig = 1, ngases_salsa
8293	salsa_gas(ig)%conc_p(nzt+1,:,:) = salsa_gas(ig)%conc_p(nzt,:,:)
8294	ENDDO
8295	ENDIF
8296
8297	ELSEIF ( ibc_salsa_t == 2 ) THEN ! Initial gradient
8298
8299	DO ib = 1, nbins_aerosol
8300	aerosol_number(ib)%conc_p(nzt+1,:,:) = aerosol_number(ib)%conc_p(nzt,:,:) + &
8301	bc_an_t_val(ib) * dzu(nzt+1)
8302	DO ic = 1, ncomponents_mass
8303	icc = ( ic - 1 ) * nbins_aerosol + ib
8304	aerosol_mass(icc)%conc_p(nzt+1,:,:) = aerosol_mass(icc)%conc_p(nzt,:,:) + &
8305	bc_am_t_val(icc) * dzu(nzt+1)
8306	ENDDO
8307	ENDDO
8308	IF ( .NOT. salsa_gases_from_chem ) THEN
8309	DO ig = 1, ngases_salsa
8310	salsa_gas(ig)%conc_p(nzt+1,:,:) = salsa_gas(ig)%conc_p(nzt,:,:) + &
8311	bc_gt_t_val(ig) * dzu(nzt+1)
8312	ENDDO
8313	ENDIF
8314
8315	ENDIF
8316	!
8317	!-- Lateral boundary conditions at the outflow
8318	IF ( bc_radiation_s ) THEN
8319	DO ib = 1, nbins_aerosol
8320	aerosol_number(ib)%conc_p(:,nys-1,:) = aerosol_number(ib)%conc_p(:,nys,:)
8321	DO ic = 1, ncomponents_mass
8322	icc = ( ic - 1 ) * nbins_aerosol + ib
8323	aerosol_mass(icc)%conc_p(:,nys-1,:) = aerosol_mass(icc)%conc_p(:,nys,:)
8324	ENDDO
8325	ENDDO
8326	IF ( .NOT. salsa_gases_from_chem ) THEN
8327	DO ig = 1, ngases_salsa
8328	salsa_gas(ig)%conc_p(:,nys-1,:) = salsa_gas(ig)%conc_p(:,nys,:)
8329	ENDDO
8330	ENDIF
8331
8332	ELSEIF ( bc_radiation_n ) THEN
8333	DO ib = 1, nbins_aerosol
8334	aerosol_number(ib)%conc_p(:,nyn+1,:) = aerosol_number(ib)%conc_p(:,nyn,:)
8335	DO ic = 1, ncomponents_mass
8336	icc = ( ic - 1 ) * nbins_aerosol + ib
8337	aerosol_mass(icc)%conc_p(:,nyn+1,:) = aerosol_mass(icc)%conc_p(:,nyn,:)
8338	ENDDO
8339	ENDDO
8340	IF ( .NOT. salsa_gases_from_chem ) THEN
8341	DO ig = 1, ngases_salsa
8342	salsa_gas(ig)%conc_p(:,nyn+1,:) = salsa_gas(ig)%conc_p(:,nyn,:)
8343	ENDDO
8344	ENDIF
8345
8346	ELSEIF ( bc_radiation_l ) THEN
8347	DO ib = 1, nbins_aerosol
8348	aerosol_number(ib)%conc_p(:,:,nxl-1) = aerosol_number(ib)%conc_p(:,:,nxl)
8349	DO ic = 1, ncomponents_mass
8350	icc = ( ic - 1 ) * nbins_aerosol + ib
8351	aerosol_mass(icc)%conc_p(:,:,nxl-1) = aerosol_mass(icc)%conc_p(:,:,nxl)
8352	ENDDO
8353	ENDDO
8354	IF ( .NOT. salsa_gases_from_chem ) THEN
8355	DO ig = 1, ngases_salsa
8356	salsa_gas(ig)%conc_p(:,:,nxl-1) = salsa_gas(ig)%conc_p(:,:,nxl)
8357	ENDDO
8358	ENDIF
8359
8360	ELSEIF ( bc_radiation_r ) THEN
8361	DO ib = 1, nbins_aerosol
8362	aerosol_number(ib)%conc_p(:,:,nxr+1) = aerosol_number(ib)%conc_p(:,:,nxr)
8363	DO ic = 1, ncomponents_mass
8364	icc = ( ic - 1 ) * nbins_aerosol + ib
8365	aerosol_mass(icc)%conc_p(:,:,nxr+1) = aerosol_mass(icc)%conc_p(:,:,nxr)
8366	ENDDO
8367	ENDDO
8368	IF ( .NOT. salsa_gases_from_chem ) THEN
8369	DO ig = 1, ngases_salsa
8370	salsa_gas(ig)%conc_p(:,:,nxr+1) = salsa_gas(ig)%conc_p(:,:,nxr)
8371	ENDDO
8372	ENDIF
8373
8374	ENDIF
8375
8376	ENDIF
8377
8378	END SUBROUTINE salsa_boundary_conds
8379
8380	!------------------------------------------------------------------------------!
8381	! Description:
8382	! ------------
8383	! Undoing of the previously done cyclic boundary conditions.
8384	!------------------------------------------------------------------------------!
8385	SUBROUTINE salsa_boundary_conds_decycle ( sq, sq_init )
8386
8387	USE control_parameters, &
8388	ONLY: nesting_offline
8389
8390	IMPLICIT NONE
8391
8392	INTEGER(iwp) :: boundary !<
8393	INTEGER(iwp) :: ee !<
8394	INTEGER(iwp) :: copied !<
8395	INTEGER(iwp) :: i !<
8396	INTEGER(iwp) :: j !<
8397	INTEGER(iwp) :: k !<
8398	INTEGER(iwp) :: ss !<
8399
8400	REAL(wp) :: flag !< flag to mask topography grid points
8401
8402	REAL(wp), DIMENSION(nzb:nzt+1) :: sq_init !< initial concentration profile
8403
8404	REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) :: sq !< concentration array
8405
8406	flag = 0.0_wp
8407	!
8408	!-- Skip input if forcing from a larger-scale models is applied.
8409	IF ( nesting_offline .AND. nesting_offline_salsa ) RETURN
8410	!
8411	!-- Left and right boundaries
8412	IF ( decycle_salsa_lr .AND. ( bc_lr_cyc .OR. bc_lr == 'nested' ) ) THEN
8413
8414	DO boundary = 1, 2
8415
8416	IF ( decycle_method_salsa(boundary) == 'dirichlet' ) THEN
8417	!
8418	!-- Initial profile is copied to ghost and first three layers
8419	ss = 1
8420	ee = 0
8421	IF ( boundary == 1 .AND. nxl == 0 ) THEN
8422	ss = nxlg
8423	ee = nxl-1
8424	ELSEIF ( boundary == 2 .AND. nxr == nx ) THEN
8425	ss = nxr+1
8426	ee = nxrg
8427	ENDIF
8428
8429	DO i = ss, ee
8430	DO j = nysg, nyng
8431	DO k = nzb+1, nzt
8432	flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) )
8433	sq(k,j,i) = sq_init(k) * flag
8434	ENDDO
8435	ENDDO
8436	ENDDO
8437
8438	ELSEIF ( decycle_method_salsa(boundary) == 'neumann' ) THEN
8439	!
8440	!-- The value at the boundary is copied to the ghost layers to simulate an outlet with
8441	!-- zero gradient
8442	ss = 1
8443	ee = 0
8444	IF ( boundary == 1 .AND. nxl == 0 ) THEN
8445	ss = nxlg
8446	ee = nxl-1
8447	copied = nxl
8448	ELSEIF ( boundary == 2 .AND. nxr == nx ) THEN
8449	ss = nxr+1
8450	ee = nxrg
8451	copied = nxr
8452	ENDIF
8453
8454	DO i = ss, ee
8455	DO j = nysg, nyng
8456	DO k = nzb+1, nzt
8457	flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) )
8458	sq(k,j,i) = sq(k,j,copied) * flag
8459	ENDDO
8460	ENDDO
8461	ENDDO
8462
8463	ELSE
8464	WRITE(message_string,*) 'unknown decycling method: decycle_method_salsa (', boundary, &
8465	') ="' // TRIM( decycle_method_salsa(boundary) ) // '"'
8466	CALL message( 'salsa_boundary_conds_decycle', 'PA0626', 1, 2, 0, 6, 0 )
8467	ENDIF
8468	ENDDO
8469	ENDIF
8470
8471	!
8472	!-- South and north boundaries
8473	IF ( decycle_salsa_ns .AND. ( bc_ns_cyc .OR. bc_ns == 'nested' ) ) THEN
8474
8475	DO boundary = 3, 4
8476
8477	IF ( decycle_method_salsa(boundary) == 'dirichlet' ) THEN
8478	!
8479	!-- Initial profile is copied to ghost and first three layers
8480	ss = 1
8481	ee = 0
8482	IF ( boundary == 3 .AND. nys == 0 ) THEN
8483	ss = nysg
8484	ee = nys-1
8485	ELSEIF ( boundary == 4 .AND. nyn == ny ) THEN
8486	ss = nyn+1
8487	ee = nyng
8488	ENDIF
8489
8490	DO i = nxlg, nxrg
8491	DO j = ss, ee
8492	DO k = nzb+1, nzt
8493	flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) )
8494	sq(k,j,i) = sq_init(k) * flag
8495	ENDDO
8496	ENDDO
8497	ENDDO
8498
8499	ELSEIF ( decycle_method_salsa(boundary) == 'neumann' ) THEN
8500	!
8501	!-- The value at the boundary is copied to the ghost layers to simulate an outlet with
8502	!-- zero gradient
8503	ss = 1
8504	ee = 0
8505	IF ( boundary == 3 .AND. nys == 0 ) THEN
8506	ss = nysg
8507	ee = nys-1
8508	copied = nys
8509	ELSEIF ( boundary == 4 .AND. nyn == ny ) THEN
8510	ss = nyn+1
8511	ee = nyng
8512	copied = nyn
8513	ENDIF
8514
8515	DO i = nxlg, nxrg
8516	DO j = ss, ee
8517	DO k = nzb+1, nzt
8518	flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) )
8519	sq(k,j,i) = sq(k,copied,i) * flag
8520	ENDDO
8521	ENDDO
8522	ENDDO
8523
8524	ELSE
8525	WRITE(message_string,*) 'unknown decycling method: decycle_method_salsa (', boundary, &
8526	') ="' // TRIM( decycle_method_salsa(boundary) ) // '"'
8527	CALL message( 'salsa_boundary_conds_decycle', 'PA0627', 1, 2, 0, 6, 0 )
8528	ENDIF
8529	ENDDO
8530	ENDIF
8531
8532	END SUBROUTINE salsa_boundary_conds_decycle
8533
8534	!------------------------------------------------------------------------------!
8535	! Description:
8536	! ------------
8537	!> Calculates the total dry or wet mass concentration for individual bins
8538	!> Juha Tonttila (FMI) 2015
8539	!> Tomi Raatikainen (FMI) 2016
8540	!------------------------------------------------------------------------------!
8541	SUBROUTINE bin_mixrat( itype, ibin, i, j, mconc )
8542
8543	IMPLICIT NONE
8544
8545	CHARACTER(len=*), INTENT(in) :: itype !< 'dry' or 'wet'
8546
8547	INTEGER(iwp) :: ic !< loop index for mass bin number
8548	INTEGER(iwp) :: iend !< end index: include water or not
8549
8550	INTEGER(iwp), INTENT(in) :: ibin !< index of the chemical component
8551	INTEGER(iwp), INTENT(in) :: i !< loop index for x-direction
8552	INTEGER(iwp), INTENT(in) :: j !< loop index for y-direction
8553
8554	REAL(wp), DIMENSION(:), INTENT(out) :: mconc !< total dry or wet mass concentration
8555
8556	!-- Number of components
8557	IF ( itype == 'dry' ) THEN
8558	iend = prtcl%ncomp - 1
8559	ELSE IF ( itype == 'wet' ) THEN
8560	iend = prtcl%ncomp
8561	ELSE
8562	message_string = 'Error in itype!'
8563	CALL message( 'bin_mixrat', 'PA0628', 2, 2, 0, 6, 0 )
8564	ENDIF
8565
8566	mconc = 0.0_wp
8567
8568	DO ic = ibin, iend*nbins_aerosol+ibin, nbins_aerosol !< every nbins'th element
8569	mconc = mconc + aerosol_mass(ic)%conc(:,j,i)
8570	ENDDO
8571
8572	END SUBROUTINE bin_mixrat
8573
8574	!------------------------------------------------------------------------------!
8575	! Description:
8576	! ------------
8577	!> Sets surface fluxes
8578	!------------------------------------------------------------------------------!
8579	SUBROUTINE salsa_emission_update
8580
8581	USE palm_date_time_mod, &
8582	ONLY: get_date_time
8583
8584	IMPLICIT NONE
8585
8586	IF ( include_emission ) THEN
8587
8588	IF ( time_since_reference_point >= skip_time_do_salsa ) THEN
8589	!
8590	!-- Get time_utc_init from origin_date_time
8591	CALL get_date_time( 0.0_wp, second_of_day = time_utc_init )
8592
8593	IF ( next_aero_emission_update <= &
8594	MAX( time_since_reference_point, 0.0_wp ) + time_utc_init ) THEN
8595	CALL salsa_emission_setup( .FALSE. )
8596	ENDIF
8597
8598	IF ( next_gas_emission_update <= &
8599	MAX( time_since_reference_point, 0.0_wp ) + time_utc_init ) THEN
8600	IF ( salsa_emission_mode == 'read_from_file' .AND. .NOT. salsa_gases_from_chem ) &
8601	THEN
8602	CALL salsa_gas_emission_setup( .FALSE. )
8603	ENDIF
8604	ENDIF
8605
8606	ENDIF
8607	ENDIF
8608
8609	END SUBROUTINE salsa_emission_update
8610
8611	!------------------------------------------------------------------------------!
8612	!> Description:
8613	!> ------------
8614	!> Define aerosol fluxes: constant or read from a from file
8615	!> @todo - Emission stack height is not used yet. For default mode, emissions
8616	!> are assumed to occur on upward facing horizontal surfaces.
8617	!------------------------------------------------------------------------------!
8618	SUBROUTINE salsa_emission_setup( init )
8619
8620	USE control_parameters, &
8621	ONLY: end_time, spinup_time
8622
8623	USE netcdf_data_input_mod, &
8624	ONLY: check_existence, close_input_file, get_attribute, get_variable, &
8625	inquire_num_variables, inquire_variable_names, &
8626	get_dimension_length, open_read_file, street_type_f
8627
8628	USE palm_date_time_mod, &
8629	ONLY: days_per_week, get_date_time, hours_per_day, months_per_year, seconds_per_hour
8630
8631	USE surface_mod, &
8632	ONLY: surf_def_h, surf_lsm_h, surf_usm_h
8633
8634	IMPLICIT NONE
8635
8636	CHARACTER(LEN=80) :: daytype = 'workday' !< default day type
8637	CHARACTER(LEN=25) :: in_name !< name of a gas in the input file
8638	CHARACTER(LEN=25) :: mod_name !< name in the input file
8639
8640	INTEGER(iwp) :: day_of_month !< day of the month
8641	INTEGER(iwp) :: day_of_week !< day of the week
8642	INTEGER(iwp) :: day_of_year !< day of the year
8643	INTEGER(iwp) :: hour_of_day !< hour of the day
8644	INTEGER(iwp) :: i !< loop index
8645	INTEGER(iwp) :: ib !< loop index: aerosol number bins
8646	INTEGER(iwp) :: ic !< loop index: aerosol chemical components
8647	INTEGER(iwp) :: id_salsa !< NetCDF id of aerosol emission input file
8648	INTEGER(iwp) :: in !< loop index: emission category
8649	INTEGER(iwp) :: index_dd !< index day
8650	INTEGER(iwp) :: index_hh !< index hour
8651	INTEGER(iwp) :: index_mm !< index month
8652	INTEGER(iwp) :: inn !< loop index
8653	INTEGER(iwp) :: j !< loop index
8654	INTEGER(iwp) :: month_of_year !< month of the year
8655	INTEGER(iwp) :: ss !< loop index
8656
8657	INTEGER(iwp), DIMENSION(maxspec) :: cc_i2m !<
8658
8659	LOGICAL :: netcdf_extend = .FALSE. !< NetCDF input file exists
8660
8661	LOGICAL, INTENT(in) :: init !< if .TRUE. --> initialisation call
8662
8663	REAL(wp) :: second_of_day !< second of the day
8664
8665	REAL(wp), DIMENSION(24) :: par_emis_time_factor = & !< time factors for the parameterized mode
8666	(/ 0.009, 0.004, 0.004, 0.009, 0.029, 0.039, &
8667	0.056, 0.053, 0.051, 0.051, 0.052, 0.055, &
8668	0.059, 0.061, 0.064, 0.067, 0.069, 0.069, &
8669	0.049, 0.039, 0.039, 0.029, 0.024, 0.019 /)
8670
8671	REAL(wp), DIMENSION(:), ALLOCATABLE :: nsect_emission !< sectional number emission
8672
8673	REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: source_array !< temporary source array
8674
8675	!
8676	!-- Define emissions:
8677	SELECT CASE ( salsa_emission_mode )
8678
8679	CASE ( 'uniform', 'parameterized' )
8680
8681	IF ( init ) THEN ! Do only once
8682	!
8683	!- Form a sectional size distribution for the emissions
8684	ALLOCATE( nsect_emission(1:nbins_aerosol), &
8685	source_array(nys:nyn,nxl:nxr,1:nbins_aerosol) )
8686	!
8687	!-- Precalculate a size distribution for the emission based on the mean diameter, standard
8688	!-- deviation and number concentration per each log-normal mode
8689	CALL size_distribution( surface_aerosol_flux, aerosol_flux_dpg, aerosol_flux_sigmag, &
8690	nsect_emission )
8691	IF ( salsa_emission_mode == 'uniform' ) THEN
8692	DO ib = 1, nbins_aerosol
8693	source_array(:,:,ib) = nsect_emission(ib)
8694	ENDDO
8695	ELSE
8696	!
8697	!-- Get a time factor for the specific hour
8698	IF ( .NOT. ALLOCATED( aero_emission_att%time_factor ) ) &
8699	ALLOCATE( aero_emission_att%time_factor(1) )
8700	CALL get_date_time( MAX( time_since_reference_point, 0.0_wp ), hour=hour_of_day )
8701	index_hh = hour_of_day
8702	aero_emission_att%time_factor(1) = par_emis_time_factor(index_hh+1)
8703
8704	IF ( street_type_f%from_file ) THEN
8705	DO i = nxl, nxr
8706	DO j = nys, nyn
8707	IF ( street_type_f%var(j,i) >= main_street_id .AND. &
8708	street_type_f%var(j,i) < max_street_id ) THEN
8709	source_array(j,i,:) = nsect_emission(:) * emiss_factor_main * &
8710	aero_emission_att%time_factor(1)
8711	ELSEIF ( street_type_f%var(j,i) >= side_street_id .AND. &
8712	street_type_f%var(j,i) < main_street_id ) THEN
8713	source_array(j,i,:) = nsect_emission(:) * emiss_factor_side * &
8714	aero_emission_att%time_factor(1)
8715	ENDIF
8716	ENDDO
8717	ENDDO
8718	ELSE
8719	WRITE( message_string, * ) 'salsa_emission_mode = "parameterized" but the '// &
8720	'street_type data is missing.'
8721	CALL message( 'salsa_emission_setup', 'PA0695', 1, 2, 0, 6, 0 )
8722	ENDIF
8723	ENDIF
8724	!
8725	!-- Check which chemical components are used
8726	cc_i2m = 0
8727	IF ( index_so4 > 0 ) cc_i2m(1) = index_so4
8728	IF ( index_oc > 0 ) cc_i2m(2) = index_oc
8729	IF ( index_bc > 0 ) cc_i2m(3) = index_bc
8730	IF ( index_du > 0 ) cc_i2m(4) = index_du
8731	IF ( index_ss > 0 ) cc_i2m(5) = index_ss
8732	IF ( index_no > 0 ) cc_i2m(6) = index_no
8733	IF ( index_nh > 0 ) cc_i2m(7) = index_nh
8734	!
8735	!-- Normalise mass fractions so that their sum is 1
8736	aerosol_flux_mass_fracs_a = aerosol_flux_mass_fracs_a / &
8737	SUM( aerosol_flux_mass_fracs_a(1:ncc ) )
8738	IF ( salsa_emission_mode == 'uniform' ) THEN
8739	!
8740	!-- Set uniform fluxes of default horizontal surfaces
8741	CALL set_flux( surf_def_h(0), cc_i2m, aerosol_flux_mass_fracs_a, source_array )
8742	ELSE
8743	!
8744	!-- Set fluxes normalised based on the street type on land surfaces
8745	CALL set_flux( surf_lsm_h, cc_i2m, aerosol_flux_mass_fracs_a, source_array )
8746	ENDIF
8747
8748	DEALLOCATE( nsect_emission, source_array )
8749	ENDIF
8750
8751	CASE ( 'read_from_file' )
8752	!
8753	!-- Reset surface fluxes
8754	surf_def_h(0)%answs = 0.0_wp
8755	surf_def_h(0)%amsws = 0.0_wp
8756	surf_lsm_h%answs = 0.0_wp
8757	surf_lsm_h%amsws = 0.0_wp
8758	surf_usm_h%answs = 0.0_wp
8759	surf_usm_h%amsws = 0.0_wp
8760
8761	!
8762	!-- Reset source arrays:
8763	DO ib = 1, nbins_aerosol
8764	aerosol_number(ib)%source = 0.0_wp
8765	ENDDO
8766
8767	DO ic = 1, ncomponents_mass * nbins_aerosol
8768	aerosol_mass(ic)%source = 0.0_wp
8769	ENDDO
8770
8771	#if defined( __netcdf )
8772	!
8773	!-- Check existence of PIDS_SALSA file
8774	INQUIRE( FILE = TRIM( input_file_salsa ) // TRIM( coupling_char ), EXIST = netcdf_extend )
8775	IF ( .NOT. netcdf_extend ) THEN
8776	message_string = 'Input file '// TRIM( input_file_salsa ) // TRIM( coupling_char )&
8777	// ' missing!'
8778	CALL message( 'salsa_emission_setup', 'PA0629', 1, 2, 0, 6, 0 )
8779	ENDIF
8780	!
8781	!-- Open file in read-only mode
8782	CALL open_read_file( TRIM( input_file_salsa ) // TRIM( coupling_char ), id_salsa )
8783
8784	IF ( init ) THEN
8785	!
8786	!-- Variable names
8787	CALL inquire_num_variables( id_salsa, aero_emission_att%num_vars )
8788	ALLOCATE( aero_emission_att%var_names(1:aero_emission_att%num_vars) )
8789	CALL inquire_variable_names( id_salsa, aero_emission_att%var_names )
8790	!
8791	!-- Read the index and name of chemical components
8792	CALL get_dimension_length( id_salsa, aero_emission_att%ncc, 'composition_index' )
8793	ALLOCATE( aero_emission_att%cc_index(1:aero_emission_att%ncc) )
8794	CALL get_variable( id_salsa, 'composition_index', aero_emission_att%cc_index )
8795
8796	IF ( check_existence( aero_emission_att%var_names, 'composition_name' ) ) THEN
8797	CALL get_variable( id_salsa, 'composition_name', aero_emission_att%cc_name, &
8798	aero_emission_att%ncc )
8799	ELSE
8800	message_string = 'Missing composition_name in ' // TRIM( input_file_salsa )
8801	CALL message( 'salsa_emission_setup', 'PA0657', 1, 2, 0, 6, 0 )
8802	ENDIF
8803	!
8804	!-- Find the corresponding chemical components in the model
8805	aero_emission_att%cc_in2mod = 0
8806	DO ic = 1, aero_emission_att%ncc
8807	in_name = aero_emission_att%cc_name(ic)
8808	SELECT CASE ( TRIM( in_name ) )
8809	CASE ( 'H2SO4', 'h2so4', 'SO4', 'so4' )
8810	aero_emission_att%cc_in2mod(1) = ic
8811	CASE ( 'OC', 'oc', 'organics' )
8812	aero_emission_att%cc_in2mod(2) = ic
8813	CASE ( 'BC', 'bc' )
8814	aero_emission_att%cc_in2mod(3) = ic
8815	CASE ( 'DU', 'du' )
8816	aero_emission_att%cc_in2mod(4) = ic
8817	CASE ( 'SS', 'ss' )
8818	aero_emission_att%cc_in2mod(5) = ic
8819	CASE ( 'HNO3', 'hno3', 'NO', 'no', 'NO3', 'no3' )
8820	aero_emission_att%cc_in2mod(6) = ic
8821	CASE ( 'NH3', 'nh3', 'NH', 'nh', 'NH4', 'nh4' )
8822	aero_emission_att%cc_in2mod(7) = ic
8823	END SELECT
8824
8825	ENDDO
8826
8827	IF ( SUM( aero_emission_att%cc_in2mod ) == 0 ) THEN
8828	message_string = 'None of the aerosol chemical components in ' // TRIM( &
8829	input_file_salsa ) // ' correspond to the ones applied in SALSA.'
8830	CALL message( 'salsa_emission_setup', 'PA0630', 1, 2, 0, 6, 0 )
8831	ENDIF
8832	!
8833	!-- Get number of emission categories
8834	CALL get_dimension_length( id_salsa, aero_emission_att%ncat, 'ncat' )
8835	!
8836	!-- Get the chemical composition (i.e. mass fraction of different species) in aerosols
8837	IF ( check_existence( aero_emission_att%var_names, 'emission_mass_fracs' ) ) THEN
8838	ALLOCATE( aero_emission%mass_fracs(1:aero_emission_att%ncat, &
8839	1:aero_emission_att%ncc) )
8840	CALL get_variable( id_salsa, 'emission_mass_fracs', aero_emission%mass_fracs, &
8841	0, aero_emission_att%ncc-1, 0, aero_emission_att%ncat-1 )
8842	ELSE
8843	message_string = 'Missing emission_mass_fracs in ' // TRIM( input_file_salsa )
8844	CALL message( 'salsa_emission_setup', 'PA0694', 1, 2, 0, 6, 0 )
8845	ENDIF
8846	!
8847	!-- If the chemical component is not activated, set its mass fraction to 0 to avoid
8848	!-- inbalance between number and mass flux
8849	cc_i2m = aero_emission_att%cc_in2mod
8850	IF ( index_so4 < 0 .AND. cc_i2m(1) > 0 ) &
8851	aero_emission%mass_fracs(:,cc_i2m(1)) = 0.0_wp
8852	IF ( index_oc < 0 .AND. cc_i2m(2) > 0 ) &
8853	aero_emission%mass_fracs(:,cc_i2m(2)) = 0.0_wp
8854	IF ( index_bc < 0 .AND. cc_i2m(3) > 0 ) &
8855	aero_emission%mass_fracs(:,cc_i2m(3)) = 0.0_wp
8856	IF ( index_du < 0 .AND. cc_i2m(4) > 0 ) &
8857	aero_emission%mass_fracs(:,cc_i2m(4)) = 0.0_wp
8858	IF ( index_ss < 0 .AND. cc_i2m(5) > 0 ) &
8859	aero_emission%mass_fracs(:,cc_i2m(5)) = 0.0_wp
8860	IF ( index_no < 0 .AND. cc_i2m(6) > 0 ) &
8861	aero_emission%mass_fracs(:,cc_i2m(6)) = 0.0_wp
8862	IF ( index_nh < 0 .AND. cc_i2m(7) > 0 ) &
8863	aero_emission%mass_fracs(:,cc_i2m(7)) = 0.0_wp
8864	!
8865	!-- Then normalise the mass fraction so that SUM = 1
8866	DO in = 1, aero_emission_att%ncat
8867	aero_emission%mass_fracs(in,:) = aero_emission%mass_fracs(in,:) / &
8868	SUM( aero_emission%mass_fracs(in,:) )
8869	ENDDO
8870	!
8871	!-- Inquire the fill value
8872	CALL get_attribute( id_salsa, '_FillValue', aero_emission%fill, .FALSE., &
8873	'aerosol_emission_values' )
8874	!
8875	!-- Inquire units of emissions
8876	CALL get_attribute( id_salsa, 'units', aero_emission_att%units, .FALSE., &
8877	'aerosol_emission_values' )
8878	!
8879	!-- Inquire the level of detail (lod)
8880	CALL get_attribute( id_salsa, 'lod', aero_emission_att%lod, .FALSE., &
8881	'aerosol_emission_values' )
8882
8883	!
8884	!-- Read different emission information depending on the level of detail of emissions:
8885
8886	!
8887	!-- Default mode:
8888	IF ( aero_emission_att%lod == 1 ) THEN
8889	!
8890	!-- Unit conversion factor: convert to SI units (kg/m2/s)
8891	IF ( aero_emission_att%units == 'kg/m2/yr' ) THEN
8892	aero_emission_att%conversion_factor = 1.0_wp / 3600.0_wp
8893	ELSEIF ( aero_emission_att%units == 'g/m2/yr' ) THEN
8894	aero_emission_att%conversion_factor = 0.001_wp / 3600.0_wp
8895	ELSE
8896	message_string = 'unknown unit for aerosol emissions: ' // &
8897	TRIM( aero_emission_att%units ) // ' (lod1)'
8898	CALL message( 'salsa_emission_setup','PA0631', 1, 2, 0, 6, 0 )
8899	ENDIF
8900	!
8901	!-- Allocate emission arrays
8902	ALLOCATE( aero_emission_att%cat_index(1:aero_emission_att%ncat), &
8903	aero_emission_att%rho(1:aero_emission_att%ncat), &
8904	aero_emission_att%time_factor(1:aero_emission_att%ncat) )
8905	!
8906	!-- Get emission category names and indices
8907	IF ( check_existence( aero_emission_att%var_names, 'emission_category_name' ) ) THEN
8908	CALL get_variable( id_salsa, 'emission_category_name', &
8909	aero_emission_att%cat_name, aero_emission_att%ncat )
8910	ELSE
8911	message_string = 'Missing emission_category_name in ' // TRIM( input_file_salsa )
8912	CALL message( 'salsa_emission_setup', 'PA0658', 1, 2, 0, 6, 0 )
8913	ENDIF
8914	CALL get_variable( id_salsa, 'emission_category_index', aero_emission_att%cat_index )
8915	!
8916	!-- Find corresponding emission categories
8917	DO in = 1, aero_emission_att%ncat
8918	in_name = aero_emission_att%cat_name(in)
8919	DO ss = 1, def_modes%ndc
8920	mod_name = def_modes%cat_name_table(ss)
8921	IF ( TRIM( in_name(1:4) ) == TRIM( mod_name(1:4 ) ) ) THEN
8922	def_modes%cat_input_to_model(ss) = in
8923	ENDIF
8924	ENDDO
8925	ENDDO
8926
8927	IF ( SUM( def_modes%cat_input_to_model ) == 0 ) THEN
8928	message_string = 'None of the emission categories in ' // TRIM( &
8929	input_file_salsa ) // ' match with the ones in the model.'
8930	CALL message( 'salsa_emission_setup', 'PA0632', 1, 2, 0, 6, 0 )
8931	ENDIF
8932	!
8933	!-- Emission time factors: Find check whether emission time factors are given for each
8934	!-- hour of year OR based on month, day and hour
8935	!
8936	!-- For each hour of year:
8937	IF ( check_existence( aero_emission_att%var_names, 'nhoursyear' ) ) THEN
8938	CALL get_dimension_length( id_salsa, aero_emission_att%nhoursyear, 'nhoursyear' )
8939	ALLOCATE( aero_emission_att%etf(1:aero_emission_att%ncat, &
8940	1:aero_emission_att%nhoursyear) )
8941	CALL get_variable( id_salsa, 'emission_time_factors', aero_emission_att%etf, &
8942	0, aero_emission_att%nhoursyear-1, 0, aero_emission_att%ncat-1 )
8943	!
8944	!-- Based on the month, day and hour:
8945	ELSEIF ( check_existence( aero_emission_att%var_names, 'nmonthdayhour' ) ) THEN
8946	CALL get_dimension_length( id_salsa, aero_emission_att%nmonthdayhour, &
8947	'nmonthdayhour' )
8948	ALLOCATE( aero_emission_att%etf(1:aero_emission_att%ncat, &
8949	1:aero_emission_att%nmonthdayhour) )
8950	CALL get_variable( id_salsa, 'emission_time_factors', aero_emission_att%etf, &
8951	0, aero_emission_att%nmonthdayhour-1, 0, aero_emission_att%ncat-1 )
8952	ELSE
8953	message_string = 'emission_time_factors should be given for each nhoursyear ' //&
8954	'OR nmonthdayhour'
8955	CALL message( 'salsa_emission_setup','PA0633', 1, 2, 0, 6, 0 )
8956	ENDIF
8957	!
8958	!-- Next emission update
8959	CALL get_date_time( time_since_reference_point, second_of_day=second_of_day )
8960	next_aero_emission_update = MOD( second_of_day, seconds_per_hour ) !- seconds_per_hour
8961	!
8962	!-- Calculate average mass density (kg/m3)
8963	aero_emission_att%rho = 0.0_wp
8964
8965	IF ( cc_i2m(1) /= 0 ) aero_emission_att%rho = aero_emission_att%rho + arhoh2so4 *&
8966	aero_emission%mass_fracs(:,cc_i2m(1))
8967	IF ( cc_i2m(2) /= 0 ) aero_emission_att%rho = aero_emission_att%rho + arhooc * &
8968	aero_emission%mass_fracs(:,cc_i2m(2))
8969	IF ( cc_i2m(3) /= 0 ) aero_emission_att%rho = aero_emission_att%rho + arhobc * &
8970	aero_emission%mass_fracs(:,cc_i2m(3))
8971	IF ( cc_i2m(4) /= 0 ) aero_emission_att%rho = aero_emission_att%rho + arhodu * &
8972	aero_emission%mass_fracs(:,cc_i2m(4))
8973	IF ( cc_i2m(5) /= 0 ) aero_emission_att%rho = aero_emission_att%rho + arhoss * &
8974	aero_emission%mass_fracs(:,cc_i2m(5))
8975	IF ( cc_i2m(6) /= 0 ) aero_emission_att%rho = aero_emission_att%rho + arhohno3 * &
8976	aero_emission%mass_fracs(:,cc_i2m(6))
8977	IF ( cc_i2m(7) /= 0 ) aero_emission_att%rho = aero_emission_att%rho + arhonh3 * &
8978	aero_emission%mass_fracs(:,cc_i2m(7))
8979	!
8980	!-- Allocate and read surface emission data (in total PM, get_variable_3d_real)
8981	ALLOCATE( aero_emission%def_data(nys:nyn,nxl:nxr,1:aero_emission_att%ncat) )
8982	CALL get_variable( id_salsa, 'aerosol_emission_values', aero_emission%def_data, &
8983	0, aero_emission_att%ncat-1, nxl, nxr, nys, nyn )
8984
8985	!
8986	!-- Pre-processed mode
8987	ELSEIF ( aero_emission_att%lod == 2 ) THEN
8988	!
8989	!-- Unit conversion factor: convert to SI units (#/m2/s)
8990	IF ( aero_emission_att%units == '#/m2/s' ) THEN
8991	aero_emission_att%conversion_factor = 1.0_wp
8992	ELSE
8993	message_string = 'unknown unit for aerosol emissions: ' // &
8994	TRIM( aero_emission_att%units )
8995	CALL message( 'salsa_emission_setup','PA0634', 1, 2, 0, 6, 0 )
8996	ENDIF
8997	!
8998	!-- Number of aerosol size bins in the emission data
8999	CALL get_dimension_length( id_salsa, aero_emission_att%nbins, 'Dmid' )
9000	IF ( aero_emission_att%nbins /= nbins_aerosol ) THEN
9001	message_string = 'The number of size bins in aerosol input data does not ' // &
9002	'correspond to the model set-up'
9003	CALL message( 'salsa_emission_setup','PA0635', 1, 2, 0, 6, 0 )
9004	ENDIF
9005	!
9006	!-- Number of time steps in the emission data
9007	CALL get_dimension_length( id_salsa, aero_emission_att%nt, 'time')
9008	!
9009	!-- Allocate bin diameters, time and mass fraction array
9010	ALLOCATE( aero_emission_att%dmid(1:nbins_aerosol), &
9011	aero_emission_att%time(1:aero_emission_att%nt), &
9012	aero_emission%num_fracs(1:aero_emission_att%ncat,1:nbins_aerosol) )
9013	!
9014	!-- Read mean diameters
9015	CALL get_variable( id_salsa, 'Dmid', aero_emission_att%dmid )
9016	!
9017	!-- Check whether the sectional representation of the aerosol size distribution conform
9018	!-- to the one applied in the model
9019	IF ( ANY( ABS( ( aero(1:nbins_aerosol)%dmid - aero_emission_att%dmid ) / &
9020	aero(1:nbins_aerosol)%dmid ) > 0.1_wp ) ) THEN
9021	message_string = 'Mean diameters of size bins in ' // TRIM( input_file_salsa ) &
9022	// ' do not match with the ones in the model.'
9023	CALL message( 'salsa_emission_setup','PA0636', 1, 2, 0, 6, 0 )
9024	ENDIF
9025	!
9026	!-- Read time stamps:
9027	IF ( check_existence( aero_emission_att%var_names, 'time' ) ) THEN
9028	CALL get_variable( id_salsa, 'time', aero_emission_att%time )
9029	ELSE
9030	message_string = 'Missing time in ' // TRIM( input_file_salsa )
9031	CALL message( 'salsa_emission_setup', 'PA0660', 1, 2, 0, 6, 0 )
9032	ENDIF
9033	!
9034	!-- Check if the provided data covers the entire simulation. The spinup time is added
9035	!-- to the end_time, this must be considered here.
9036	IF ( end_time - spinup_time > aero_emission_att%time(aero_emission_att%nt-1) ) THEN
9037	message_string = 'end_time of the simulation exceeds the time dimension in ' // &
9038	'the salsa input file.'
9039	CALL message( 'salsa_emission_setup', 'PA0692', 1, 2, 0, 6, 0 )
9040	ENDIF
9041	!
9042	!-- Read emission number fractions per category
9043	IF ( check_existence( aero_emission_att%var_names, 'emission_number_fracs' ) ) THEN
9044	CALL get_variable( id_salsa, 'emission_number_fracs', aero_emission%num_fracs, &
9045	0, nbins_aerosol-1, 0, aero_emission_att%ncat-1 )
9046	ELSE
9047	message_string = 'Missing emission_number_fracs in ' // TRIM( input_file_salsa )
9048	CALL message( 'salsa_emission_setup', 'PA0694', 1, 2, 0, 6, 0 )
9049	ENDIF
9050
9051	ELSE
9052	message_string = 'Unknown lod for aerosol_emission_values.'
9053	CALL message( 'salsa_emission_setup','PA0637', 1, 2, 0, 6, 0 )
9054
9055	ENDIF ! lod
9056
9057	ENDIF ! init
9058	!
9059	!-- Define and set current emission values:
9060	!
9061	!-- Default type emissions (aerosol emission given as total mass emission per year):
9062	IF ( aero_emission_att%lod == 1 ) THEN
9063	!
9064	!-- Emission time factors for each emission category at current time step
9065	IF ( aero_emission_att%nhoursyear > aero_emission_att%nmonthdayhour ) THEN
9066	!
9067	!-- Get the index of the current hour
9068	CALL get_date_time( MAX( 0.0_wp, time_since_reference_point ), &
9069	day_of_year=day_of_year, hour=hour_of_day )
9070	index_hh = ( day_of_year - 1_iwp ) * hours_per_day + hour_of_day
9071	aero_emission_att%time_factor = aero_emission_att%etf(:,index_hh+1)
9072
9073	ELSEIF ( aero_emission_att%nhoursyear < aero_emission_att%nmonthdayhour ) THEN
9074	!
9075	!-- Get the index of current hour (index_hh) (TODO: Now "workday" is always assumed.
9076	!-- Needs to be calculated.)
9077	CALL get_date_time( MAX( 0.0_wp, time_since_reference_point ), month=month_of_year,&
9078	day=day_of_month, hour=hour_of_day, day_of_week=day_of_week )
9079	index_mm = month_of_year
9080	index_dd = months_per_year + day_of_week
9081	SELECT CASE(TRIM(daytype))
9082
9083	CASE ("workday")
9084	index_hh = months_per_year + days_per_week + hour_of_day
9085
9086	CASE ("weekend")
9087	index_hh = months_per_year + days_per_week + hours_per_day + hour_of_day
9088
9089	CASE ("holiday")
9090	index_hh = months_per_year + days_per_week + 2*hours_per_day + hour_of_day
9091
9092	END SELECT
9093	aero_emission_att%time_factor = aero_emission_att%etf(:,index_mm) * &
9094	aero_emission_att%etf(:,index_dd) * &
9095	aero_emission_att%etf(:,index_hh+1)
9096	ENDIF
9097
9098	!
9099	!-- Create a sectional number size distribution for emissions
9100	ALLOCATE( nsect_emission(1:nbins_aerosol),source_array(nys:nyn,nxl:nxr,1:nbins_aerosol) )
9101	DO in = 1, aero_emission_att%ncat
9102
9103	inn = def_modes%cat_input_to_model(in)
9104	!
9105	!-- Calculate the number concentration (1/m3) of a log-normal size distribution
9106	!-- following Jacobson (2005): Eq 13.25.
9107	def_modes%ntot_table = 6.0_wp * def_modes%pm_frac_table(:,inn) / ( pi * &
9108	( def_modes%dpg_table )*3 EXP( 4.5_wp * &
9109	LOG( def_modes%sigmag_table )**2 ) )
9110	!
9111	!-- Sectional size distibution (1/m3) from a log-normal one
9112	CALL size_distribution( def_modes%ntot_table, def_modes%dpg_table, &
9113	def_modes%sigmag_table, nsect_emission )
9114
9115	source_array = 0.0_wp
9116	DO ib = 1, nbins_aerosol
9117	source_array(:,:,ib) = aero_emission%def_data(:,:,in) * &
9118	aero_emission_att%conversion_factor / &
9119	aero_emission_att%rho(in) * nsect_emission(ib) * &
9120	aero_emission_att%time_factor(in)
9121	ENDDO
9122	!
9123	!-- Set surface fluxes of aerosol number and mass on horizontal surfaces. Set fluxes
9124	!-- only for either default, land or urban surface.
9125	IF ( .NOT. land_surface .AND. .NOT. urban_surface ) THEN
9126	CALL set_flux( surf_def_h(0), aero_emission_att%cc_in2mod, &
9127	aero_emission%mass_fracs(in,:), source_array )
9128	ELSE
9129	CALL set_flux( surf_usm_h, aero_emission_att%cc_in2mod, &
9130	aero_emission%mass_fracs(in,:), source_array )
9131	CALL set_flux( surf_lsm_h, aero_emission_att%cc_in2mod, &
9132	aero_emission%mass_fracs(in,:), source_array )
9133	ENDIF
9134	ENDDO
9135	!
9136	!-- The next emission update is again after one hour
9137	next_aero_emission_update = next_aero_emission_update + 3600.0_wp
9138
9139
9140	DEALLOCATE( nsect_emission, source_array )
9141	!
9142	!-- Pre-processed:
9143	ELSEIF ( aero_emission_att%lod == 2 ) THEN
9144	!
9145	!-- Get time_utc_init from origin_date_time
9146	CALL get_date_time( 0.0_wp, second_of_day = time_utc_init )
9147	!
9148	!-- Obtain time index for current point in time. Note, the time coordinate in the input
9149	!-- file is relative to time_utc_init.
9150	aero_emission_att%tind = MINLOC( ABS( aero_emission_att%time - ( &
9151	time_utc_init + MAX( time_since_reference_point,&
9152	0.0_wp) ) ), DIM = 1 ) - 1
9153	!
9154	!-- Allocate the data input array always before reading in the data and deallocate after
9155	ALLOCATE( aero_emission%preproc_data(nys:nyn,nxl:nxr,1:aero_emission_att%ncat), &
9156	source_array(nys:nyn,nxl:nxr,1:nbins_aerosol) )
9157	!
9158	!-- Read in the next time step (get_variable_4d_to_3d_real)
9159	CALL get_variable( id_salsa, 'aerosol_emission_values', aero_emission%preproc_data, &
9160	aero_emission_att%tind, 0, aero_emission_att%ncat-1, &
9161	nxl, nxr, nys, nyn )
9162	!
9163	!-- Calculate the sources per category and set surface fluxes
9164	source_array = 0.0_wp
9165	DO in = 1, aero_emission_att%ncat
9166	DO ib = 1, nbins_aerosol
9167	source_array(:,:,ib) = aero_emission%preproc_data(:,:,in) * &
9168	aero_emission%num_fracs(in,ib)
9169	ENDDO
9170	!
9171	!-- Set fluxes only for either default, land and urban surface.
9172	IF ( .NOT. land_surface .AND. .NOT. urban_surface ) THEN
9173	CALL set_flux( surf_def_h(0), aero_emission_att%cc_in2mod, &
9174	aero_emission%mass_fracs(in,:), source_array )
9175	ELSE
9176	CALL set_flux( surf_usm_h, aero_emission_att%cc_in2mod, &
9177	aero_emission%mass_fracs(in,:), source_array )
9178	CALL set_flux( surf_lsm_h, aero_emission_att%cc_in2mod, &
9179	aero_emission%mass_fracs(in,:), source_array )
9180	ENDIF
9181	ENDDO
9182	!
9183	!-- Determine the next emission update
9184	next_aero_emission_update = aero_emission_att%time(aero_emission_att%tind+2)
9185
9186	DEALLOCATE( aero_emission%preproc_data, source_array )
9187
9188	ENDIF
9189	!
9190	!-- Close input file
9191	CALL close_input_file( id_salsa )
9192	#else
9193	message_string = 'salsa_emission_mode = "read_from_file", but preprocessor directive ' //&
9194	' __netcdf is not used in compiling!'
9195	CALL message( 'salsa_emission_setup', 'PA0638', 1, 2, 0, 6, 0 )
9196
9197	#endif
9198	CASE DEFAULT
9199	message_string = 'unknown salsa_emission_mode: ' // TRIM( salsa_emission_mode )
9200	CALL message( 'salsa_emission_setup', 'PA0639', 1, 2, 0, 6, 0 )
9201
9202	END SELECT
9203
9204	CONTAINS
9205
9206	!------------------------------------------------------------------------------!
9207	! Description:
9208	! ------------
9209	!> Sets the aerosol flux to aerosol arrays in 2a and 2b.
9210	!------------------------------------------------------------------------------!
9211	SUBROUTINE set_flux( surface, cc_i_mod, mass_fracs, source_array )
9212
9213	USE arrays_3d, &
9214	ONLY: rho_air_zw
9215
9216	USE surface_mod, &
9217	ONLY: surf_type
9218
9219	IMPLICIT NONE
9220
9221	INTEGER(iwp) :: i !< loop index
9222	INTEGER(iwp) :: ib !< loop index
9223	INTEGER(iwp) :: ic !< loop index
9224	INTEGER(iwp) :: j !< loop index
9225	INTEGER(iwp) :: k !< loop index
9226	INTEGER(iwp) :: m !< running index for surface elements
9227
9228	INTEGER(iwp), DIMENSION(:) :: cc_i_mod !< index of chemical component in the input data
9229
9230	REAL(wp) :: so4_oc !< mass fraction between SO4 and OC in 1a
9231
9232	REAL(wp), DIMENSION(:), INTENT(in) :: mass_fracs !< mass fractions of chemical components
9233
9234	REAL(wp), DIMENSION(nys:nyn,nxl:nxr,1:nbins_aerosol), INTENT(inout) :: source_array !<
9235
9236	TYPE(surf_type), INTENT(inout) :: surface !< respective surface type
9237
9238	so4_oc = 0.0_wp
9239
9240	DO m = 1, surface%ns
9241	!
9242	!-- Get indices of respective grid point
9243	i = surface%i(m)
9244	j = surface%j(m)
9245	k = surface%k(m)
9246
9247	DO ib = 1, nbins_aerosol
9248	IF ( source_array(j,i,ib) < nclim ) THEN
9249	source_array(j,i,ib) = 0.0_wp
9250	ENDIF
9251	!
9252	!-- Set mass fluxes. First bins include only SO4 and/or OC.
9253	IF ( ib <= end_subrange_1a ) THEN
9254	!
9255	!-- Both sulphate and organic carbon
9256	IF ( index_so4 > 0 .AND. index_oc > 0 ) THEN
9257
9258	ic = ( index_so4 - 1 ) * nbins_aerosol + ib
9259	so4_oc = mass_fracs(cc_i_mod(1)) / ( mass_fracs(cc_i_mod(1)) + &
9260	mass_fracs(cc_i_mod(2)) )
9261	surface%amsws(m,ic) = surface%amsws(m,ic) + so4_oc * source_array(j,i,ib) &
9262	* api6 * aero(ib)%dmid*3 arhoh2so4 * rho_air_zw(k-1)
9263	aerosol_mass(ic)%source(j,i) = aerosol_mass(ic)%source(j,i) + surface%amsws(m,ic)
9264
9265	ic = ( index_oc - 1 ) * nbins_aerosol + ib
9266	surface%amsws(m,ic) = surface%amsws(m,ic) + ( 1-so4_oc ) * source_array(j,i,ib) &
9267	* api6 * aero(ib)%dmid*3 arhooc * 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 sulphates
9271	ELSEIF ( index_so4 > 0 .AND. index_oc < 0 ) THEN
9272	ic = ( index_so4 - 1 ) * nbins_aerosol + ib
9273	surface%amsws(m,ic) = surface%amsws(m,ic) + source_array(j,i,ib) * api6 * &
9274	aero(ib)%dmid*3 arhoh2so4 * rho_air_zw(k-1)
9275	aerosol_mass(ic)%source(j,i) = aerosol_mass(ic)%source(j,i) + surface%amsws(m,ic)
9276	!
9277	!-- Only organic carbon
9278	ELSEIF ( index_so4 < 0 .AND. index_oc > 0 ) THEN
9279	ic = ( index_oc - 1 ) * nbins_aerosol + ib
9280	surface%amsws(m,ic) = surface%amsws(m,ic) + source_array(j,i,ib) * api6 * &
9281	aero(ib)%dmid*3 arhooc * rho_air_zw(k-1)
9282	aerosol_mass(ic)%source(j,i) = aerosol_mass(ic)%source(j,i) + surface%amsws(m,ic)
9283	ENDIF
9284
9285	ELSE
9286	!
9287	!-- Sulphate
9288	IF ( index_so4 > 0 ) THEN
9289	ic = cc_i_mod(1)
9290	CALL set_mass_flux( surface, m, ib, index_so4, mass_fracs(ic), arhoh2so4, &
9291	source_array(j,i,ib) )
9292	ENDIF
9293	!
9294	!-- Organic carbon
9295	IF ( index_oc > 0 ) THEN
9296	ic = cc_i_mod(2)
9297	CALL set_mass_flux( surface, m, ib, index_oc, mass_fracs(ic),arhooc, &
9298	source_array(j,i,ib) )
9299	ENDIF
9300	!
9301	!-- Black carbon
9302	IF ( index_bc > 0 ) THEN
9303	ic = cc_i_mod(3)
9304	CALL set_mass_flux( surface, m, ib, index_bc, mass_fracs(ic), arhobc, &
9305	source_array(j,i,ib) )
9306	ENDIF
9307	!
9308	!-- Dust
9309	IF ( index_du > 0 ) THEN
9310	ic = cc_i_mod(4)
9311	CALL set_mass_flux( surface, m, ib, index_du, mass_fracs(ic), arhodu, &
9312	source_array(j,i,ib) )
9313	ENDIF
9314	!
9315	!-- Sea salt
9316	IF ( index_ss > 0 ) THEN
9317	ic = cc_i_mod(5)
9318	CALL set_mass_flux( surface, m, ib, index_ss, mass_fracs(ic), arhoss, &
9319	source_array(j,i,ib) )
9320	ENDIF
9321	!
9322	!-- Nitric acid
9323	IF ( index_no > 0 ) THEN
9324	ic = cc_i_mod(6)
9325	CALL set_mass_flux( surface, m, ib, index_no, mass_fracs(ic), arhohno3, &
9326	source_array(j,i,ib) )
9327	ENDIF
9328	!
9329	!-- Ammonia
9330	IF ( index_nh > 0 ) THEN
9331	ic = cc_i_mod(7)
9332	CALL set_mass_flux( surface, m, ib, index_nh, mass_fracs(ic), arhonh3, &
9333	source_array(j,i,ib) )
9334	ENDIF
9335
9336	ENDIF
9337	!
9338	!-- Save number fluxes in the end
9339	surface%answs(m,ib) = surface%answs(m,ib) + source_array(j,i,ib) * rho_air_zw(k-1)
9340	aerosol_number(ib)%source(j,i) = aerosol_number(ib)%source(j,i) + surface%answs(m,ib)
9341
9342	ENDDO ! ib
9343	ENDDO ! m
9344
9345	END SUBROUTINE set_flux
9346
9347	!------------------------------------------------------------------------------!
9348	! Description:
9349	! ------------
9350	!> Sets the mass emissions to aerosol arrays in 2a and 2b.
9351	!------------------------------------------------------------------------------!
9352	SUBROUTINE set_mass_flux( surface, surf_num, ib, ispec, mass_frac, prho, nsource )
9353
9354	USE arrays_3d, &
9355	ONLY: rho_air_zw
9356
9357	USE surface_mod, &
9358	ONLY: surf_type
9359
9360	IMPLICIT NONE
9361
9362	INTEGER(iwp) :: i !< loop index
9363	INTEGER(iwp) :: j !< loop index
9364	INTEGER(iwp) :: k !< loop index
9365	INTEGER(iwp) :: ic !< loop index
9366
9367	INTEGER(iwp), INTENT(in) :: ib !< Aerosol size bin index
9368	INTEGER(iwp), INTENT(in) :: ispec !< Aerosol species index
9369	INTEGER(iwp), INTENT(in) :: surf_num !< index surface elements
9370
9371	REAL(wp), INTENT(in) :: mass_frac !< mass fraction of a chemical compound in all bins
9372	REAL(wp), INTENT(in) :: nsource !< number source (#/m2/s)
9373	REAL(wp), INTENT(in) :: prho !< Aerosol density
9374
9375	TYPE(surf_type), INTENT(inout) :: surface !< respective surface type
9376	!
9377	!-- Get indices of respective grid point
9378	i = surface%i(surf_num)
9379	j = surface%j(surf_num)
9380	k = surface%k(surf_num)
9381	!
9382	!-- Subrange 2a:
9383	ic = ( ispec - 1 ) * nbins_aerosol + ib
9384	surface%amsws(surf_num,ic) = surface%amsws(surf_num,ic) + mass_frac * nsource * &
9385	aero(ib)%core * prho * rho_air_zw(k-1)
9386	aerosol_mass(ic)%source(j,i) = aerosol_mass(ic)%source(j,i) + surface%amsws(surf_num,ic)
9387
9388	END SUBROUTINE set_mass_flux
9389
9390	END SUBROUTINE salsa_emission_setup
9391
9392	!------------------------------------------------------------------------------!
9393	! Description:
9394	! ------------
9395	!> Sets the gaseous fluxes
9396	!------------------------------------------------------------------------------!
9397	SUBROUTINE salsa_gas_emission_setup( init )
9398
9399	USE netcdf_data_input_mod, &
9400	ONLY: check_existence, close_input_file, get_attribute, get_variable, &
9401	inquire_num_variables, inquire_variable_names, &
9402	get_dimension_length, open_read_file
9403
9404	USE palm_date_time_mod, &
9405	ONLY: days_per_week, get_date_time, hours_per_day, months_per_year, seconds_per_hour
9406
9407	USE surface_mod, &
9408	ONLY: surf_def_h, surf_lsm_h, surf_usm_h
9409
9410	IMPLICIT NONE
9411
9412	CHARACTER(LEN=80) :: daytype = 'workday' !< default day type
9413	CHARACTER(LEN=25) :: in_name !< name of a gas in the input file
9414
9415	CHARACTER(LEN=100), DIMENSION(:), ALLOCATABLE :: var_names !< variable names in input data
9416
9417
9418	INTEGER(iwp) :: day_of_month !< day of the month
9419	INTEGER(iwp) :: day_of_week !< day of the week
9420	INTEGER(iwp) :: day_of_year !< day of the year
9421	INTEGER(iwp) :: hour_of_day !< hour of the day
9422	INTEGER(iwp) :: id_chem !< NetCDF id of chemistry emission file
9423	INTEGER(iwp) :: i !< loop index
9424	INTEGER(iwp) :: ig !< loop index
9425	INTEGER(iwp) :: in !< running index for emission categories
9426	INTEGER(iwp) :: index_dd !< index day
9427	INTEGER(iwp) :: index_hh !< index hour
9428	INTEGER(iwp) :: index_mm !< index month
9429	INTEGER(iwp) :: j !< loop index
9430	INTEGER(iwp) :: month_of_year !< month of the year
9431	INTEGER(iwp) :: num_vars !< number of variables
9432
9433	LOGICAL :: netcdf_extend = .FALSE. !< NetCDF input file exists
9434
9435	LOGICAL, INTENT(in) :: init !< if .TRUE. --> initialisation call
9436
9437	REAL(wp) :: second_of_day !< second of the day
9438
9439	REAL(wp), DIMENSION(:), ALLOCATABLE :: time_factor !< emission time factor
9440
9441	REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: dum_var_3d !<
9442
9443	REAL(wp), DIMENSION(:,:,:,:,:), ALLOCATABLE :: dum_var_5d !<
9444
9445	!
9446	!-- Reset surface fluxes
9447	surf_def_h(0)%gtsws = 0.0_wp
9448	surf_lsm_h%gtsws = 0.0_wp
9449	surf_usm_h%gtsws = 0.0_wp
9450
9451	#if defined( __netcdf )
9452	!
9453	!-- Check existence of PIDS_CHEM file
9454	INQUIRE( FILE = 'PIDS_CHEM' // TRIM( coupling_char ), EXIST = netcdf_extend )
9455	IF ( .NOT. netcdf_extend ) THEN
9456	message_string = 'Input file PIDS_CHEM' // TRIM( coupling_char ) // ' missing!'
9457	CALL message( 'salsa_gas_emission_setup', 'PA0640', 1, 2, 0, 6, 0 )
9458	ENDIF
9459	!
9460	!-- Open file in read-only mode
9461	CALL open_read_file( 'PIDS_CHEM' // TRIM( coupling_char ), id_chem )
9462
9463	IF ( init ) THEN
9464	!
9465	!-- Read the index and name of chemical components
9466	CALL get_dimension_length( id_chem, chem_emission_att%n_emiss_species, 'nspecies' )
9467	ALLOCATE( chem_emission_att%species_index(1:chem_emission_att%n_emiss_species) )
9468	CALL get_variable( id_chem, 'emission_index', chem_emission_att%species_index )
9469	CALL get_variable( id_chem, 'emission_name', chem_emission_att%species_name, &
9470	chem_emission_att%n_emiss_species )
9471	!
9472	!-- Allocate emission data
9473	ALLOCATE( chem_emission(1:chem_emission_att%n_emiss_species) )
9474	!
9475	!-- Find the corresponding indices in the model
9476	emission_index_chem = 0
9477	DO ig = 1, chem_emission_att%n_emiss_species
9478	in_name = chem_emission_att%species_name(ig)
9479	SELECT CASE ( TRIM( in_name ) )
9480	CASE ( 'H2SO4', 'h2so4' )
9481	emission_index_chem(1) = ig
9482	CASE ( 'HNO3', 'hno3' )
9483	emission_index_chem(2) = ig
9484	CASE ( 'NH3', 'nh3' )
9485	emission_index_chem(3) = ig
9486	CASE ( 'OCNV', 'ocnv' )
9487	emission_index_chem(4) = ig
9488	CASE ( 'OCSV', 'ocsv' )
9489	emission_index_chem(5) = ig
9490	END SELECT
9491	ENDDO
9492	!
9493	!-- Inquire the fill value
9494	CALL get_attribute( id_chem, '_FillValue', aero_emission%fill, .FALSE., 'emission_values' )
9495	!
9496	!-- Inquire units of emissions
9497	CALL get_attribute( id_chem, 'units', chem_emission_att%units, .FALSE., 'emission_values' )
9498	!
9499	!-- Inquire the level of detail (lod)
9500	CALL get_attribute( id_chem, 'lod', lod_gas_emissions, .FALSE., 'emission_values' )
9501	!
9502	!-- Variable names
9503	CALL inquire_num_variables( id_chem, num_vars )
9504	ALLOCATE( var_names(1:num_vars) )
9505	CALL inquire_variable_names( id_chem, var_names )
9506	!
9507	!-- Default mode: as total emissions per year
9508	IF ( lod_gas_emissions == 1 ) THEN
9509
9510	!
9511	!-- Get number of emission categories and allocate emission arrays
9512	CALL get_dimension_length( id_chem, chem_emission_att%ncat, 'ncat' )
9513	ALLOCATE( chem_emission_att%cat_index(1:chem_emission_att%ncat), &
9514	time_factor(1:chem_emission_att%ncat) )
9515	!
9516	!-- Get emission category names and indices
9517	CALL get_variable( id_chem, 'emission_category_name', chem_emission_att%cat_name, &
9518	chem_emission_att%ncat)
9519	CALL get_variable( id_chem, 'emission_category_index', chem_emission_att%cat_index )
9520	!
9521	!-- Emission time factors: Find check whether emission time factors are given for each hour
9522	!-- of year OR based on month, day and hour
9523	!
9524	!-- For each hour of year:
9525	IF ( check_existence( var_names, 'nhoursyear' ) ) THEN
9526	CALL get_dimension_length( id_chem, chem_emission_att%nhoursyear, 'nhoursyear' )
9527	ALLOCATE( chem_emission_att%hourly_emis_time_factor(1:chem_emission_att%ncat, &
9528	1:chem_emission_att%nhoursyear) )
9529	CALL get_variable( id_chem, 'emission_time_factors', &
9530	chem_emission_att%hourly_emis_time_factor, &
9531	0, chem_emission_att%nhoursyear-1, 0, chem_emission_att%ncat-1 )
9532	!
9533	!-- Based on the month, day and hour:
9534	ELSEIF ( check_existence( var_names, 'nmonthdayhour' ) ) THEN
9535	CALL get_dimension_length( id_chem, chem_emission_att%nmonthdayhour, 'nmonthdayhour' )
9536	ALLOCATE( chem_emission_att%mdh_emis_time_factor(1:chem_emission_att%ncat, &
9537	1:chem_emission_att%nmonthdayhour) )
9538	CALL get_variable( id_chem, 'emission_time_factors', &
9539	chem_emission_att%mdh_emis_time_factor, &
9540	0, chem_emission_att%nmonthdayhour-1, 0, chem_emission_att%ncat-1 )
9541	ELSE
9542	message_string = 'emission_time_factors should be given for each nhoursyear OR ' // &
9543	'nmonthdayhour'
9544	CALL message( 'salsa_gas_emission_setup','PA0641', 1, 2, 0, 6, 0 )
9545	ENDIF
9546	!
9547	!-- Next emission update
9548	CALL get_date_time( time_since_reference_point, second_of_day=second_of_day )
9549	next_gas_emission_update = MOD( second_of_day, seconds_per_hour ) !- seconds_per_hour
9550	!
9551	!-- Allocate and read surface emission data (in total PM) (NOTE that "preprocessed" input data
9552	!-- array is applied now here)
9553	ALLOCATE( dum_var_5d(1,nys:nyn,nxl:nxr,1:chem_emission_att%n_emiss_species, &
9554	1:chem_emission_att%ncat) )
9555	CALL get_variable( id_chem, 'emission_values', dum_var_5d, 0, chem_emission_att%ncat-1, &
9556	0, chem_emission_att%n_emiss_species-1, nxl, nxr, nys, nyn, 0, 0 )
9557	DO ig = 1, chem_emission_att%n_emiss_species
9558	ALLOCATE( chem_emission(ig)%default_emission_data(nys:nyn,nxl:nxr, &
9559	1:chem_emission_att%ncat) )
9560	DO in = 1, chem_emission_att%ncat
9561	DO i = nxl, nxr
9562	DO j = nys, nyn
9563	chem_emission(ig)%default_emission_data(j,i,in) = dum_var_5d(1,j,i,ig,in)
9564	ENDDO
9565	ENDDO
9566	ENDDO
9567	ENDDO
9568	DEALLOCATE( dum_var_5d )
9569	!
9570	!-- Pre-processed mode:
9571	ELSEIF ( lod_gas_emissions == 2 ) THEN
9572	!
9573	!-- Number of time steps in the emission data
9574	CALL get_dimension_length( id_chem, chem_emission_att%dt_emission, 'time' )
9575	!
9576	!-- Allocate and read time
9577	ALLOCATE( gas_emission_time(1:chem_emission_att%dt_emission) )
9578	CALL get_variable( id_chem, 'time', gas_emission_time )
9579	ELSE
9580	message_string = 'Unknown lod for emission_values.'
9581	CALL message( 'salsa_gas_emission_setup','PA0642', 1, 2, 0, 6, 0 )
9582	ENDIF ! lod
9583
9584	ENDIF ! init
9585	!
9586	!-- Define and set current emission values:
9587
9588	IF ( lod_gas_emissions == 1 ) THEN
9589	!
9590	!-- Emission time factors for each emission category at current time step
9591	IF ( chem_emission_att%nhoursyear > chem_emission_att%nmonthdayhour ) THEN
9592	!
9593	!-- Get the index of the current hour
9594	CALL get_date_time( time_since_reference_point, &
9595	day_of_year=day_of_year, hour=hour_of_day )
9596	index_hh = ( day_of_year - 1_iwp ) * hours_per_day + hour_of_day
9597	IF ( .NOT. ALLOCATED( time_factor ) ) ALLOCATE( time_factor(1:chem_emission_att%ncat) )
9598	time_factor = 0.0_wp
9599	time_factor = chem_emission_att%hourly_emis_time_factor(:,index_hh+1)
9600
9601	ELSEIF ( chem_emission_att%nhoursyear < chem_emission_att%nmonthdayhour ) THEN
9602	!
9603	!-- Get the index of current hour (index_hh) (TODO: Now "workday" is always assumed.
9604	!-- Needs to be calculated.)
9605	CALL get_date_time( time_since_reference_point, &
9606	month=month_of_year, &
9607	day=day_of_month, &
9608	hour=hour_of_day, &
9609	day_of_week=day_of_week )
9610	index_mm = month_of_year
9611	index_dd = months_per_year + day_of_week
9612	SELECT CASE( TRIM( daytype ) )
9613
9614	CASE ("workday")
9615	index_hh = months_per_year + days_per_week + hour_of_day
9616
9617	CASE ("weekend")
9618	index_hh = months_per_year + days_per_week + hours_per_day + hour_of_day
9619
9620	CASE ("holiday")
9621	index_hh = months_per_year + days_per_week + 2*hours_per_day + hour_of_day
9622
9623	END SELECT
9624	time_factor = chem_emission_att%mdh_emis_time_factor(:,index_mm) * &
9625	chem_emission_att%mdh_emis_time_factor(:,index_dd) * &
9626	chem_emission_att%mdh_emis_time_factor(:,index_hh+1)
9627	ENDIF
9628	!
9629	!-- Set gas emissions for each emission category
9630	ALLOCATE( dum_var_3d(nys:nyn,nxl:nxr,1:chem_emission_att%n_emiss_species) )
9631
9632	DO in = 1, chem_emission_att%ncat
9633	DO ig = 1, chem_emission_att%n_emiss_species
9634	dum_var_3d(:,:,ig) = chem_emission(ig)%default_emission_data(:,:,in)
9635	ENDDO
9636	!
9637	!-- Set surface fluxes only for either default, land or urban surface
9638	IF ( .NOT. land_surface .AND. .NOT. urban_surface ) THEN
9639	CALL set_gas_flux( surf_def_h(0), emission_index_chem, chem_emission_att%units, &
9640	dum_var_3d, time_factor(in) )
9641	ELSE
9642	CALL set_gas_flux( surf_usm_h, emission_index_chem, chem_emission_att%units, &
9643	dum_var_3d, time_factor(in) )
9644	CALL set_gas_flux( surf_lsm_h, emission_index_chem, chem_emission_att%units, &
9645	dum_var_3d, time_factor(in) )
9646	ENDIF
9647	ENDDO
9648	DEALLOCATE( dum_var_3d )
9649	!
9650	!-- The next emission update is again after one hour
9651	next_gas_emission_update = next_gas_emission_update + 3600.0_wp
9652
9653	ELSEIF ( lod_gas_emissions == 2 ) THEN
9654	!
9655	!-- Get time_utc_init from origin_date_time
9656	CALL get_date_time( 0.0_wp, second_of_day = time_utc_init )
9657	!
9658	!-- Obtain time index for current point in time. Note, the time coordinate in the input file is
9659	!-- relative to time_utc_init.
9660	chem_emission_att%i_hour = MINLOC( ABS( gas_emission_time - ( time_utc_init + &
9661	MAX( time_since_reference_point, 0.0_wp) ) ), DIM = 1 ) - 1
9662	!
9663	!-- Allocate the data input array always before reading in the data and deallocate after (NOTE
9664	!-- that "preprocessed" input data array is applied now here)
9665	ALLOCATE( dum_var_5d(1,1,nys:nyn,nxl:nxr,1:chem_emission_att%n_emiss_species) )
9666	!
9667	!-- Read in the next time step
9668	CALL get_variable( id_chem, 'emission_values', dum_var_5d, &
9669	0, chem_emission_att%n_emiss_species-1, nxl, nxr, nys, nyn, 0, 0, &
9670	chem_emission_att%i_hour, chem_emission_att%i_hour )
9671	!
9672	!-- Set surface fluxes only for either default, land or urban surface
9673	IF ( .NOT. land_surface .AND. .NOT. urban_surface ) THEN
9674	CALL set_gas_flux( surf_def_h(0), emission_index_chem, chem_emission_att%units, &
9675	dum_var_5d(1,1,:,:,:) )
9676	ELSE
9677	CALL set_gas_flux( surf_usm_h, emission_index_chem, chem_emission_att%units, &
9678	dum_var_5d(1,1,:,:,:) )
9679	CALL set_gas_flux( surf_lsm_h, emission_index_chem, chem_emission_att%units, &
9680	dum_var_5d(1,1,:,:,:) )
9681	ENDIF
9682	DEALLOCATE ( dum_var_5d )
9683	!
9684	!-- Determine the next emission update
9685	next_gas_emission_update = gas_emission_time(chem_emission_att%i_hour+2)
9686
9687	ENDIF
9688	!
9689	!-- Close input file
9690	CALL close_input_file( id_chem )
9691
9692	#else
9693	message_string = 'salsa_emission_mode = "read_from_file", but preprocessor directive ' // &
9694	' __netcdf is not used in compiling!'
9695	CALL message( 'salsa_gas_emission_setup', 'PA0643', 1, 2, 0, 6, 0 )
9696
9697	#endif
9698
9699	CONTAINS
9700	!------------------------------------------------------------------------------!
9701	! Description:
9702	! ------------
9703	!> Set gas fluxes for selected type of surfaces
9704	!------------------------------------------------------------------------------!
9705	SUBROUTINE set_gas_flux( surface, cc_i_mod, unit, source_array, time_fac )
9706
9707	USE arrays_3d, &
9708	ONLY: dzw, hyp, pt, rho_air_zw
9709
9710	USE grid_variables, &
9711	ONLY: dx, dy
9712
9713	USE surface_mod, &
9714	ONLY: surf_type
9715
9716	IMPLICIT NONE
9717
9718	CHARACTER(LEN=*), INTENT(in) :: unit !< flux unit in the input file
9719
9720	INTEGER(iwp) :: ig !< running index for gases
9721	INTEGER(iwp) :: i !< loop index
9722	INTEGER(iwp) :: j !< loop index
9723	INTEGER(iwp) :: k !< loop index
9724	INTEGER(iwp) :: m !< running index for surface elements
9725
9726	INTEGER(iwp), DIMENSION(:) :: cc_i_mod !< index of different gases in the input data
9727
9728	LOGICAL :: use_time_fac !< .TRUE. is time_fac present
9729
9730	REAL(wp), OPTIONAL :: time_fac !< emission time factor
9731
9732	REAL(wp), DIMENSION(ngases_salsa) :: conv !< unit conversion factor
9733
9734	REAL(wp), DIMENSION(nys:nyn,nxl:nxr,1:chem_emission_att%n_emiss_species), INTENT(in) :: source_array !<
9735
9736	TYPE(surf_type), INTENT(inout) :: surface !< respective surface type
9737
9738	conv = 1.0_wp
9739	use_time_fac = PRESENT( time_fac )
9740
9741	DO m = 1, surface%ns
9742	!
9743	!-- Get indices of respective grid point
9744	i = surface%i(m)
9745	j = surface%j(m)
9746	k = surface%k(m)
9747	!
9748	!-- Unit conversion factor: convert to SI units (#/m2/s)
9749	SELECT CASE ( TRIM( unit ) )
9750	CASE ( 'kg/m2/yr' )
9751	conv(1) = avo / ( amh2so4 * 3600.0_wp )
9752	conv(2) = avo / ( amhno3 * 3600.0_wp )
9753	conv(3) = avo / ( amnh3 * 3600.0_wp )
9754	conv(4) = avo / ( amoc * 3600.0_wp )
9755	conv(5) = avo / ( amoc * 3600.0_wp )
9756	CASE ( 'g/m2/yr' )
9757	conv(1) = avo / ( amh2so4 * 3.6E+6_wp )
9758	conv(2) = avo / ( amhno3 * 3.6E+6_wp )
9759	conv(3) = avo / ( amnh3 * 3.6E+6_wp )
9760	conv(4) = avo / ( amoc * 3.6E+6_wp )
9761	conv(5) = avo / ( amoc * 3.6E+6_wp )
9762	CASE ( 'g/m2/s' )
9763	conv(1) = avo / ( amh2so4 * 1000.0_wp )
9764	conv(2) = avo / ( amhno3 * 1000.0_wp )
9765	conv(3) = avo / ( amnh3 * 1000.0_wp )
9766	conv(4) = avo / ( amoc * 1000.0_wp )
9767	conv(5) = avo / ( amoc * 1000.0_wp )
9768	CASE ( '#/m2/s' )
9769	conv = 1.0_wp
9770	CASE ( 'ppm/m2/s' )
9771	conv = for_ppm_to_nconc * hyp(k) / pt(k,j,i) * ( 1.0E5_wp / hyp(k) )*0.286_wp &
9772	dx * dy * dzw(k)
9773	CASE ( 'mumol/m2/s' )
9774	conv = 1.0E-6_wp * avo
9775	CASE DEFAULT
9776	message_string = 'unknown unit for gas emissions: ' // TRIM( chem_emission_att%units )
9777	CALL message( 'set_gas_flux','PA0644', 1, 2, 0, 6, 0 )
9778
9779	END SELECT
9780
9781	DO ig = 1, ngases_salsa
9782	IF ( use_time_fac ) THEN
9783	surface%gtsws(m,ig) = surface%gtsws(m,ig) + rho_air_zw(k-1) * conv(ig) * time_fac &
9784	* MAX( 0.0_wp, source_array(j,i,cc_i_mod(ig) ) )
9785	ELSE
9786	surface%gtsws(m,ig) = surface%gtsws(m,ig) + rho_air_zw(k-1) * conv(ig) &
9787	* MAX( 0.0_wp, source_array(j,i,cc_i_mod(ig) ) )
9788	ENDIF
9789	ENDDO ! ig
9790
9791	ENDDO ! m
9792
9793	END SUBROUTINE set_gas_flux
9794
9795	END SUBROUTINE salsa_gas_emission_setup
9796
9797	!------------------------------------------------------------------------------!
9798	! Description:
9799	! ------------
9800	!> Check data output for salsa.
9801	!------------------------------------------------------------------------------!
9802	SUBROUTINE salsa_check_data_output( var, unit )
9803
9804	IMPLICIT NONE
9805
9806	CHARACTER(LEN=*) :: unit !<
9807	CHARACTER(LEN=*) :: var !<
9808
9809	INTEGER(iwp) :: char_to_int !< for converting character to integer
9810
9811	IF ( var(1:6) /= 'salsa_' ) THEN
9812	unit = 'illegal'
9813	RETURN
9814	ENDIF
9815	!
9816	!-- Treat bin-specific outputs separately
9817	IF ( var(7:11) == 'N_bin' ) THEN
9818	READ( var(12:),* ) char_to_int
9819	IF ( char_to_int >= 1 .AND. char_to_int <= SUM( nbin ) ) THEN
9820	unit = '#/m3'
9821	ELSE
9822	unit = 'illegal'
9823	RETURN
9824	ENDIF
9825
9826	ELSEIF ( var(7:11) == 'm_bin' ) THEN
9827	READ( var(12:),* ) char_to_int
9828	IF ( char_to_int >= 1 .AND. char_to_int <= SUM( nbin ) ) THEN
9829	unit = 'kg/m3'
9830	ELSE
9831	unit = 'illegal'
9832	RETURN
9833	ENDIF
9834
9835	ELSE
9836	SELECT CASE ( TRIM( var(7:) ) )
9837
9838	CASE ( 'g_H2SO4', 'g_HNO3', 'g_NH3', 'g_OCNV', 'g_OCSV' )
9839	IF ( air_chemistry ) THEN
9840	message_string = 'gases are imported from the chemistry module and thus output '// &
9841	'of "' // TRIM( var ) // '" is not allowed'
9842	CALL message( 'check_parameters', 'PA0653', 1, 2, 0, 6, 0 )
9843	ENDIF
9844	unit = '#/m3'
9845
9846	CASE ( 'LDSA' )
9847	unit = 'mum2/cm3'
9848
9849	CASE ( 'PM0.1', 'PM2.5', 'PM10', 's_BC', 's_DU', 's_H2O', 's_NH', 's_NO', 's_OC', &
9850	's_SO4', 's_SS' )
9851	unit = 'kg/m3'
9852
9853	CASE ( 'N_UFP', 'Ntot' )
9854	unit = '#/m3'
9855
9856	CASE DEFAULT
9857	unit = 'illegal'
9858
9859	END SELECT
9860	ENDIF
9861
9862	END SUBROUTINE salsa_check_data_output
9863
9864	!------------------------------------------------------------------------------!
9865	! Description:
9866	! ------------
9867	!> Check profile data output for salsa. Currently only for diagnostic variables
9868	!> Ntot, N_UFP, PM0.1, PM2.5, PM10 and LDSA
9869	!------------------------------------------------------------------------------!
9870	SUBROUTINE salsa_check_data_output_pr( var, var_count, unit, dopr_unit )
9871
9872	USE arrays_3d, &
9873	ONLY: zu
9874
9875	USE profil_parameter, &
9876	ONLY: dopr_index
9877
9878	USE statistics, &
9879	ONLY: hom, pr_palm, statistic_regions
9880
9881	IMPLICIT NONE
9882
9883	CHARACTER(LEN=*) :: dopr_unit !<
9884	CHARACTER(LEN=*) :: unit !<
9885	CHARACTER(LEN=*) :: var !<
9886
9887	INTEGER(iwp) :: var_count !<
9888
9889	IF ( var(1:6) /= 'salsa_' ) THEN
9890	unit = 'illegal'
9891	RETURN
9892	ENDIF
9893
9894	SELECT CASE ( TRIM( var(7:) ) )
9895
9896	CASE( 'LDSA' )
9897	salsa_pr_count = salsa_pr_count + 1
9898	salsa_pr_index(salsa_pr_count) = 1
9899	dopr_index(var_count) = pr_palm + salsa_pr_count
9900	dopr_unit = 'mum2/cm3'
9901	unit = dopr_unit
9902	hom(:,2,dopr_index(var_count),:) = SPREAD( zu, 2, statistic_regions+1 )
9903
9904	CASE( 'N_UFP' )
9905	salsa_pr_count = salsa_pr_count + 1
9906	salsa_pr_index(salsa_pr_count) = 2
9907	dopr_index(var_count) = pr_palm + salsa_pr_count
9908	dopr_unit = '#/m3'
9909	unit = dopr_unit
9910	hom(:,2,dopr_index(var_count),:) = SPREAD( zu, 2, statistic_regions+1 )
9911
9912	CASE( 'Ntot' )
9913	salsa_pr_count = salsa_pr_count + 1
9914	salsa_pr_index(salsa_pr_count) = 3
9915	dopr_index(var_count) = pr_palm + salsa_pr_count
9916	dopr_unit = '#/m3'
9917	unit = dopr_unit
9918	hom(:,2,dopr_index(var_count),:) = SPREAD( zu, 2, statistic_regions+1 )
9919
9920	CASE( 'PM0.1' )
9921	salsa_pr_count = salsa_pr_count + 1
9922	salsa_pr_index(salsa_pr_count) = 4
9923	dopr_index(var_count) = pr_palm + salsa_pr_count
9924	dopr_unit = 'kg/m3'
9925	unit = dopr_unit
9926	hom(:,2,dopr_index(var_count),:) = SPREAD( zu, 2, statistic_regions+1 )
9927
9928	CASE( 'PM2.5' )
9929	salsa_pr_count = salsa_pr_count + 1
9930	salsa_pr_index(salsa_pr_count) = 5
9931	dopr_index(var_count) = pr_palm + salsa_pr_count
9932	dopr_unit = 'kg/m3'
9933	unit = dopr_unit
9934	hom(:,2,dopr_index(var_count),:) = SPREAD( zu, 2, statistic_regions+1 )
9935
9936	CASE( 'PM10' )
9937	salsa_pr_count = salsa_pr_count + 1
9938	salsa_pr_index(salsa_pr_count) = 6
9939	dopr_index(var_count) = pr_palm + salsa_pr_count
9940	dopr_unit = 'kg/m3'
9941	unit = dopr_unit
9942	hom(:,2,dopr_index(var_count),:) = SPREAD( zu, 2, statistic_regions+1 )
9943
9944	CASE DEFAULT
9945	unit = 'illegal'
9946
9947	END SELECT
9948
9949
9950	END SUBROUTINE salsa_check_data_output_pr
9951
9952	!-------------------------------------------------------------------------------!
9953	!> Description:
9954	!> Calculation of horizontally averaged profiles for salsa.
9955	!-------------------------------------------------------------------------------!
9956	SUBROUTINE salsa_statistics( mode, sr, tn )
9957
9958	USE control_parameters, &
9959	ONLY: max_pr_user
9960
9961	USE chem_modules, &
9962	ONLY: max_pr_cs
9963
9964	USE statistics, &
9965	ONLY: pr_palm, rmask, sums_l
9966
9967	IMPLICIT NONE
9968
9969	CHARACTER(LEN=*) :: mode !<
9970
9971	INTEGER(iwp) :: i !< loop index
9972	INTEGER(iwp) :: ib !< loop index
9973	INTEGER(iwp) :: ic !< loop index
9974	INTEGER(iwp) :: ii !< loop index
9975	INTEGER(iwp) :: ind !< index in the statistical output
9976	INTEGER(iwp) :: j !< loop index
9977	INTEGER(iwp) :: k !< loop index
9978	INTEGER(iwp) :: sr !< statistical region
9979	INTEGER(iwp) :: tn !< thread number
9980
9981	REAL(wp) :: df !< For calculating LDSA: fraction of particles depositing in the alveolar
9982	!< (or tracheobronchial) region of the lung. Depends on the particle size
9983	REAL(wp) :: mean_d !< Particle diameter in micrometres
9984	REAL(wp) :: temp_bin !< temporary variable
9985
9986	IF ( mode == 'profiles' ) THEN
9987	!$OMP DO
9988	DO ii = 1, salsa_pr_count
9989
9990	ind = pr_palm + max_pr_user + max_pr_cs + ii
9991
9992	SELECT CASE( salsa_pr_index(ii) )
9993
9994	CASE( 1 ) ! LDSA
9995	DO i = nxl, nxr
9996	DO j = nys, nyn
9997	DO k = nzb, nzt+1
9998	temp_bin = 0.0_wp
9999	DO ib = 1, nbins_aerosol
10000	!
10001	!-- Diameter in micrometres
10002	mean_d = 1.0E+6_wp * ra_dry(k,j,i,ib) * 2.0_wp
10003	!
10004	!-- Deposition factor: alveolar
10005	df = ( 0.01555_wp / mean_d ) * ( EXP( -0.416_wp * ( LOG( mean_d ) + &
10006	2.84_wp )*2 ) + 19.11_wp EXP( -0.482_wp * ( LOG( mean_d ) - &
10007	1.362_wp )**2 ) )
10008	!
10009	!-- Lung-deposited surface area LDSA (units mum2/cm3)
10010	temp_bin = temp_bin + pi * mean_d*2 df * 1.0E-6_wp * &
10011	aerosol_number(ib)%conc(k,j,i)
10012	ENDDO
10013	sums_l(k,ind,tn) = sums_l(k,ind,tn) + temp_bin * rmask(j,i,sr) * &
10014	MERGE( 1.0_wp, 0.0_wp, &
10015	BTEST( wall_flags_total_0(k,j,i), 22 ) )
10016	ENDDO
10017	ENDDO
10018	ENDDO
10019
10020	CASE( 2 ) ! N_UFP
10021	DO i = nxl, nxr
10022	DO j = nys, nyn
10023	DO k = nzb, nzt+1
10024	temp_bin = 0.0_wp
10025	DO ib = 1, nbins_aerosol
10026	IF ( 2.0_wp * ra_dry(k,j,i,ib) <= 0.1E-6_wp ) &
10027	temp_bin = temp_bin + aerosol_number(ib)%conc(k,j,i)
10028	ENDDO
10029	sums_l(k,ind,tn) = sums_l(k,ind,tn) + temp_bin * rmask(j,i,sr) * &
10030	MERGE( 1.0_wp, 0.0_wp, &
10031	BTEST( wall_flags_total_0(k,j,i), 22 ) )
10032	ENDDO
10033	ENDDO
10034	ENDDO
10035
10036	CASE( 3 ) ! Ntot
10037	DO i = nxl, nxr
10038	DO j = nys, nyn
10039	DO k = nzb, nzt+1
10040	temp_bin = 0.0_wp
10041	DO ib = 1, nbins_aerosol
10042	temp_bin = temp_bin + aerosol_number(ib)%conc(k,j,i)
10043	ENDDO
10044	sums_l(k,ind,tn) = sums_l(k,ind,tn) + temp_bin * rmask(j,i,sr) * &
10045	MERGE( 1.0_wp, 0.0_wp, &
10046	BTEST( wall_flags_total_0(k,j,i), 22 ) )
10047	ENDDO
10048	ENDDO
10049	ENDDO
10050
10051	CASE( 4 ) ! PM0.1
10052	DO i = nxl, nxr
10053	DO j = nys, nyn
10054	DO k = nzb, nzt+1
10055	temp_bin = 0.0_wp
10056	DO ib = 1, nbins_aerosol
10057	IF ( 2.0_wp * ra_dry(k,j,i,ib) <= 0.1E-6_wp ) THEN
10058	DO ic = ib, nbins_aerosol * ncc, nbins_aerosol
10059	temp_bin = temp_bin + aerosol_mass(ic)%conc(k,j,i)
10060	ENDDO
10061	ENDIF
10062	ENDDO
10063	sums_l(k,ind,tn) = sums_l(k,ind,tn) + temp_bin * rmask(j,i,sr) * &
10064	MERGE( 1.0_wp, 0.0_wp, &
10065	BTEST( wall_flags_total_0(k,j,i), 22 ) )
10066	ENDDO
10067	ENDDO
10068	ENDDO
10069
10070	CASE( 5 ) ! PM2.5
10071	DO i = nxl, nxr
10072	DO j = nys, nyn
10073	DO k = nzb, nzt+1
10074	temp_bin = 0.0_wp
10075	DO ib = 1, nbins_aerosol
10076	IF ( 2.0_wp * ra_dry(k,j,i,ib) <= 2.5E-6_wp ) THEN
10077	DO ic = ib, nbins_aerosol * ncc, nbins_aerosol
10078	temp_bin = temp_bin + aerosol_mass(ic)%conc(k,j,i)
10079	ENDDO
10080	ENDIF
10081	ENDDO
10082	sums_l(k,ind,tn) = sums_l(k,ind,tn) + temp_bin * rmask(j,i,sr) * &
10083	MERGE( 1.0_wp, 0.0_wp, &
10084	BTEST( wall_flags_total_0(k,j,i), 22 ) )
10085	ENDDO
10086	ENDDO
10087	ENDDO
10088
10089	CASE( 6 ) ! PM10
10090	DO i = nxl, nxr
10091	DO j = nys, nyn
10092	DO k = nzb, nzt+1
10093	temp_bin = 0.0_wp
10094	DO ib = 1, nbins_aerosol
10095	IF ( 2.0_wp * ra_dry(k,j,i,ib) <= 10.0E-6_wp ) THEN
10096	DO ic = ib, nbins_aerosol * ncc, nbins_aerosol
10097	temp_bin = temp_bin + aerosol_mass(ic)%conc(k,j,i)
10098	ENDDO
10099	ENDIF
10100	ENDDO
10101	sums_l(k,ind,tn) = sums_l(k,ind,tn) + temp_bin * rmask(j,i,sr) * &
10102	MERGE( 1.0_wp, 0.0_wp, &
10103	BTEST( wall_flags_total_0(k,j,i), 22 ) )
10104	ENDDO
10105	ENDDO
10106	ENDDO
10107
10108	END SELECT
10109	ENDDO
10110
10111	ELSEIF ( mode == 'time_series' ) THEN
10112	!
10113	!-- TODO
10114	ENDIF
10115
10116	END SUBROUTINE salsa_statistics
10117
10118
10119	!------------------------------------------------------------------------------!
10120	!
10121	! Description:
10122	! ------------
10123	!> Subroutine for averaging 3D data
10124	!------------------------------------------------------------------------------!
10125	SUBROUTINE salsa_3d_data_averaging( mode, variable )
10126
10127	USE control_parameters, &
10128	ONLY: average_count_3d
10129
10130	IMPLICIT NONE
10131
10132	CHARACTER(LEN=*) :: mode !<
10133	CHARACTER(LEN=10) :: vari !<
10134	CHARACTER(LEN=*) :: variable !<
10135
10136	INTEGER(iwp) :: char_to_int !< for converting character to integer
10137	INTEGER(iwp) :: found_index !<
10138	INTEGER(iwp) :: i !<
10139	INTEGER(iwp) :: ib !<
10140	INTEGER(iwp) :: ic !<
10141	INTEGER(iwp) :: j !<
10142	INTEGER(iwp) :: k !<
10143
10144	REAL(wp) :: df !< For calculating LDSA: fraction of particles depositing in the alveolar
10145	!< (or tracheobronchial) region of the lung. Depends on the particle size
10146	REAL(wp) :: mean_d !< Particle diameter in micrometres
10147	REAL(wp) :: temp_bin !< temporary variable
10148
10149	REAL(wp), DIMENSION(:,:,:), POINTER :: to_be_resorted !< points to selected output variable
10150
10151	temp_bin = 0.0_wp
10152
10153	IF ( mode == 'allocate' ) THEN
10154
10155	IF ( variable(7:11) == 'N_bin' ) THEN
10156	IF ( .NOT. ALLOCATED( nbins_av ) ) THEN
10157	ALLOCATE( nbins_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg,nbins_aerosol) )
10158	ENDIF
10159	nbins_av = 0.0_wp
10160
10161	ELSEIF ( variable(7:11) == 'm_bin' ) THEN
10162	IF ( .NOT. ALLOCATED( mbins_av ) ) THEN
10163	ALLOCATE( mbins_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg,nbins_aerosol) )
10164	ENDIF
10165	mbins_av = 0.0_wp
10166
10167	ELSE
10168
10169	SELECT CASE ( TRIM( variable(7:) ) )
10170
10171	CASE ( 'g_H2SO4' )
10172	IF ( .NOT. ALLOCATED( g_h2so4_av ) ) THEN
10173	ALLOCATE( g_h2so4_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
10174	ENDIF
10175	g_h2so4_av = 0.0_wp
10176
10177	CASE ( 'g_HNO3' )
10178	IF ( .NOT. ALLOCATED( g_hno3_av ) ) THEN
10179	ALLOCATE( g_hno3_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
10180	ENDIF
10181	g_hno3_av = 0.0_wp
10182
10183	CASE ( 'g_NH3' )
10184	IF ( .NOT. ALLOCATED( g_nh3_av ) ) THEN
10185	ALLOCATE( g_nh3_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
10186	ENDIF
10187	g_nh3_av = 0.0_wp
10188
10189	CASE ( 'g_OCNV' )
10190	IF ( .NOT. ALLOCATED( g_ocnv_av ) ) THEN
10191	ALLOCATE( g_ocnv_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
10192	ENDIF
10193	g_ocnv_av = 0.0_wp
10194
10195	CASE ( 'g_OCSV' )
10196	IF ( .NOT. ALLOCATED( g_ocsv_av ) ) THEN
10197	ALLOCATE( g_ocsv_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
10198	ENDIF
10199	g_ocsv_av = 0.0_wp
10200
10201	CASE ( 'LDSA' )
10202	IF ( .NOT. ALLOCATED( ldsa_av ) ) THEN
10203	ALLOCATE( ldsa_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
10204	ENDIF
10205	ldsa_av = 0.0_wp
10206
10207	CASE ( 'N_UFP' )
10208	IF ( .NOT. ALLOCATED( nufp_av ) ) THEN
10209	ALLOCATE( nufp_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
10210	ENDIF
10211	nufp_av = 0.0_wp
10212
10213	CASE ( 'Ntot' )
10214	IF ( .NOT. ALLOCATED( ntot_av ) ) THEN
10215	ALLOCATE( ntot_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
10216	ENDIF
10217	ntot_av = 0.0_wp
10218
10219	CASE ( 'PM0.1' )
10220	IF ( .NOT. ALLOCATED( pm01_av ) ) THEN
10221	ALLOCATE( pm01_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
10222	ENDIF
10223	pm01_av = 0.0_wp
10224
10225	CASE ( 'PM2.5' )
10226	IF ( .NOT. ALLOCATED( pm25_av ) ) THEN
10227	ALLOCATE( pm25_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
10228	ENDIF
10229	pm25_av = 0.0_wp
10230
10231	CASE ( 'PM10' )
10232	IF ( .NOT. ALLOCATED( pm10_av ) ) THEN
10233	ALLOCATE( pm10_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
10234	ENDIF
10235	pm10_av = 0.0_wp
10236
10237	CASE ( 's_BC' )
10238	IF ( .NOT. ALLOCATED( s_bc_av ) ) THEN
10239	ALLOCATE( s_bc_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
10240	ENDIF
10241	s_bc_av = 0.0_wp
10242
10243	CASE ( 's_DU' )
10244	IF ( .NOT. ALLOCATED( s_du_av ) ) THEN
10245	ALLOCATE( s_du_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
10246	ENDIF
10247	s_du_av = 0.0_wp
10248
10249	CASE ( 's_H2O' )
10250	IF ( .NOT. ALLOCATED( s_h2o_av ) ) THEN
10251	ALLOCATE( s_h2o_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
10252	ENDIF
10253	s_h2o_av = 0.0_wp
10254
10255	CASE ( 's_NH' )
10256	IF ( .NOT. ALLOCATED( s_nh_av ) ) THEN
10257	ALLOCATE( s_nh_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
10258	ENDIF
10259	s_nh_av = 0.0_wp
10260
10261	CASE ( 's_NO' )
10262	IF ( .NOT. ALLOCATED( s_no_av ) ) THEN
10263	ALLOCATE( s_no_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
10264	ENDIF
10265	s_no_av = 0.0_wp
10266
10267	CASE ( 's_OC' )
10268	IF ( .NOT. ALLOCATED( s_oc_av ) ) THEN
10269	ALLOCATE( s_oc_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
10270	ENDIF
10271	s_oc_av = 0.0_wp
10272
10273	CASE ( 's_SO4' )
10274	IF ( .NOT. ALLOCATED( s_so4_av ) ) THEN
10275	ALLOCATE( s_so4_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
10276	ENDIF
10277	s_so4_av = 0.0_wp
10278
10279	CASE ( 's_SS' )
10280	IF ( .NOT. ALLOCATED( s_ss_av ) ) THEN
10281	ALLOCATE( s_ss_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
10282	ENDIF
10283	s_ss_av = 0.0_wp
10284
10285	CASE DEFAULT
10286	CONTINUE
10287
10288	END SELECT
10289
10290	ENDIF
10291
10292	ELSEIF ( mode == 'sum' ) THEN
10293
10294	IF ( variable(7:11) == 'N_bin' ) THEN
10295	READ( variable(12:),* ) char_to_int
10296	IF ( char_to_int >= 1 .AND. char_to_int <= SUM( nbin ) ) THEN
10297	ib = char_to_int
10298	DO i = nxlg, nxrg
10299	DO j = nysg, nyng
10300	DO k = nzb, nzt+1
10301	nbins_av(k,j,i,ib) = nbins_av(k,j,i,ib) + aerosol_number(ib)%conc(k,j,i)
10302	ENDDO
10303	ENDDO
10304	ENDDO
10305	ENDIF
10306
10307	ELSEIF ( variable(7:11) == 'm_bin' ) THEN
10308	READ( variable(12:),* ) char_to_int
10309	IF ( char_to_int >= 1 .AND. char_to_int <= SUM( nbin ) ) THEN
10310	ib = char_to_int
10311	DO i = nxlg, nxrg
10312	DO j = nysg, nyng
10313	DO k = nzb, nzt+1
10314	temp_bin = 0.0_wp
10315	DO ic = ib, nbins_aerosol * ncomponents_mass, nbins_aerosol
10316	temp_bin = temp_bin + aerosol_mass(ic)%conc(k,j,i)
10317	ENDDO
10318	mbins_av(k,j,i,ib) = mbins_av(k,j,i,ib) + temp_bin
10319	ENDDO
10320	ENDDO
10321	ENDDO
10322	ENDIF
10323	ELSE
10324
10325	SELECT CASE ( TRIM( variable(7:) ) )
10326
10327	CASE ( 'g_H2SO4', 'g_HNO3', 'g_NH3', 'g_OCNV', 'g_OCSV' )
10328
10329	vari = TRIM( variable(9:) ) ! remove salsa_g_ from beginning
10330
10331	SELECT CASE( vari )
10332
10333	CASE( 'H2SO4' )
10334	found_index = 1
10335	to_be_resorted => g_h2so4_av
10336
10337	CASE( 'HNO3' )
10338	found_index = 2
10339	to_be_resorted => g_hno3_av
10340
10341	CASE( 'NH3' )
10342	found_index = 3
10343	to_be_resorted => g_nh3_av
10344
10345	CASE( 'OCNV' )
10346	found_index = 4
10347	to_be_resorted => g_ocnv_av
10348
10349	CASE( 'OCSV' )
10350	found_index = 5
10351	to_be_resorted => g_ocsv_av
10352
10353	END SELECT
10354
10355	DO i = nxlg, nxrg
10356	DO j = nysg, nyng
10357	DO k = nzb, nzt+1
10358	to_be_resorted(k,j,i) = to_be_resorted(k,j,i) + &
10359	salsa_gas(found_index)%conc(k,j,i)
10360	ENDDO
10361	ENDDO
10362	ENDDO
10363
10364	CASE ( 'LDSA' )
10365	DO i = nxlg, nxrg
10366	DO j = nysg, nyng
10367	DO k = nzb, nzt+1
10368	temp_bin = 0.0_wp
10369	DO ib = 1, nbins_aerosol
10370	!
10371	!-- Diameter in micrometres
10372	mean_d = 1.0E+6_wp * ra_dry(k,j,i,ib) * 2.0_wp
10373	!
10374	!-- Deposition factor: alveolar (use ra_dry)
10375	df = ( 0.01555_wp / mean_d ) * ( EXP( -0.416_wp * ( LOG( mean_d ) + &
10376	2.84_wp )*2 ) + 19.11_wp EXP( -0.482_wp * ( LOG( mean_d ) - &
10377	1.362_wp )**2 ) )
10378	!
10379	!-- Lung-deposited surface area LDSA (units mum2/cm3)
10380	temp_bin = temp_bin + pi * mean_d*2 df * 1.0E-6_wp * &
10381	aerosol_number(ib)%conc(k,j,i)
10382	ENDDO
10383	ldsa_av(k,j,i) = ldsa_av(k,j,i) + temp_bin
10384	ENDDO
10385	ENDDO
10386	ENDDO
10387
10388	CASE ( 'N_UFP' )
10389	DO i = nxlg, nxrg
10390	DO j = nysg, nyng
10391	DO k = nzb, nzt+1
10392	temp_bin = 0.0_wp
10393	DO ib = 1, nbins_aerosol
10394	IF ( 2.0_wp * ra_dry(k,j,i,ib) <= 0.1E-6_wp ) THEN
10395	temp_bin = temp_bin + aerosol_number(ib)%conc(k,j,i)
10396	ENDIF
10397	ENDDO
10398	nufp_av(k,j,i) = nufp_av(k,j,i) + temp_bin
10399	ENDDO
10400	ENDDO
10401	ENDDO
10402
10403	CASE ( 'Ntot' )
10404	DO i = nxlg, nxrg
10405	DO j = nysg, nyng
10406	DO k = nzb, nzt+1
10407	DO ib = 1, nbins_aerosol
10408	ntot_av(k,j,i) = ntot_av(k,j,i) + aerosol_number(ib)%conc(k,j,i)
10409	ENDDO
10410	ENDDO
10411	ENDDO
10412	ENDDO
10413
10414	CASE ( 'PM0.1' )
10415	DO i = nxlg, nxrg
10416	DO j = nysg, nyng
10417	DO k = nzb, nzt+1
10418	temp_bin = 0.0_wp
10419	DO ib = 1, nbins_aerosol
10420	IF ( 2.0_wp * ra_dry(k,j,i,ib) <= 0.1E-6_wp ) THEN
10421	DO ic = ib, nbins_aerosol * ncc, nbins_aerosol
10422	temp_bin = temp_bin + aerosol_mass(ic)%conc(k,j,i)
10423	ENDDO
10424	ENDIF
10425	ENDDO
10426	pm01_av(k,j,i) = pm01_av(k,j,i) + temp_bin
10427	ENDDO
10428	ENDDO
10429	ENDDO
10430
10431	CASE ( 'PM2.5' )
10432	DO i = nxlg, nxrg
10433	DO j = nysg, nyng
10434	DO k = nzb, nzt+1
10435	temp_bin = 0.0_wp
10436	DO ib = 1, nbins_aerosol
10437	IF ( 2.0_wp * ra_dry(k,j,i,ib) <= 2.5E-6_wp ) THEN
10438	DO ic = ib, nbins_aerosol * ncc, nbins_aerosol
10439	temp_bin = temp_bin + aerosol_mass(ic)%conc(k,j,i)
10440	ENDDO
10441	ENDIF
10442	ENDDO
10443	pm25_av(k,j,i) = pm25_av(k,j,i) + temp_bin
10444	ENDDO
10445	ENDDO
10446	ENDDO
10447
10448	CASE ( 'PM10' )
10449	DO i = nxlg, nxrg
10450	DO j = nysg, nyng
10451	DO k = nzb, nzt+1
10452	temp_bin = 0.0_wp
10453	DO ib = 1, nbins_aerosol
10454	IF ( 2.0_wp * ra_dry(k,j,i,ib) <= 10.0E-6_wp ) THEN
10455	DO ic = ib, nbins_aerosol * ncc, nbins_aerosol
10456	temp_bin = temp_bin + aerosol_mass(ic)%conc(k,j,i)
10457	ENDDO
10458	ENDIF
10459	ENDDO
10460	pm10_av(k,j,i) = pm10_av(k,j,i) + temp_bin
10461	ENDDO
10462	ENDDO
10463	ENDDO
10464
10465	CASE ( 's_BC', 's_DU', 's_NH', 's_NO', 's_OC', 's_SO4', 's_SS' )
10466	IF ( is_used( prtcl, TRIM( variable(9:) ) ) ) THEN ! 9: remove salsa_s_
10467	found_index = get_index( prtcl, TRIM( variable(9:) ) )
10468	IF ( TRIM( variable(9:) ) == 'BC' ) to_be_resorted => s_bc_av
10469	IF ( TRIM( variable(9:) ) == 'DU' ) to_be_resorted => s_du_av
10470	IF ( TRIM( variable(9:) ) == 'NH' ) to_be_resorted => s_nh_av
10471	IF ( TRIM( variable(9:) ) == 'NO' ) to_be_resorted => s_no_av
10472	IF ( TRIM( variable(9:) ) == 'OC' ) to_be_resorted => s_oc_av
10473	IF ( TRIM( variable(9:) ) == 'SO4' ) to_be_resorted => s_so4_av
10474	IF ( TRIM( variable(9:) ) == 'SS' ) to_be_resorted => s_ss_av
10475	DO i = nxlg, nxrg
10476	DO j = nysg, nyng
10477	DO k = nzb, nzt+1
10478	DO ic = ( found_index-1 ) * nbins_aerosol + 1, found_index * nbins_aerosol
10479	to_be_resorted(k,j,i) = to_be_resorted(k,j,i) + &
10480	aerosol_mass(ic)%conc(k,j,i)
10481	ENDDO
10482	ENDDO
10483	ENDDO
10484	ENDDO
10485	ENDIF
10486
10487	CASE ( 's_H2O' )
10488	found_index = get_index( prtcl,'H2O' )
10489	to_be_resorted => s_h2o_av
10490	DO i = nxlg, nxrg
10491	DO j = nysg, nyng
10492	DO k = nzb, nzt+1
10493	DO ic = ( found_index-1 ) * nbins_aerosol + 1, found_index * nbins_aerosol
10494	s_h2o_av(k,j,i) = s_h2o_av(k,j,i) + aerosol_mass(ic)%conc(k,j,i)
10495	ENDDO
10496	ENDDO
10497	ENDDO
10498	ENDDO
10499
10500	CASE DEFAULT
10501	CONTINUE
10502
10503	END SELECT
10504
10505	ENDIF
10506
10507	ELSEIF ( mode == 'average' ) THEN
10508
10509	IF ( variable(7:11) == 'N_bin' ) THEN
10510	READ( variable(12:),* ) char_to_int
10511	IF ( char_to_int >= 1 .AND. char_to_int <= SUM( nbin ) ) THEN
10512	ib = char_to_int
10513	DO i = nxlg, nxrg
10514	DO j = nysg, nyng
10515	DO k = nzb, nzt+1
10516	nbins_av(k,j,i,ib) = nbins_av(k,j,i,ib) / REAL( average_count_3d, KIND=wp )
10517	ENDDO
10518	ENDDO
10519	ENDDO
10520	ENDIF
10521
10522	ELSEIF ( variable(7:11) == 'm_bin' ) THEN
10523	READ( variable(12:),* ) char_to_int
10524	IF ( char_to_int >= 1 .AND. char_to_int <= SUM( nbin ) ) THEN
10525	ib = char_to_int
10526	DO i = nxlg, nxrg
10527	DO j = nysg, nyng
10528	DO k = nzb, nzt+1
10529	mbins_av(k,j,i,ib) = mbins_av(k,j,i,ib) / REAL( average_count_3d, KIND=wp)
10530	ENDDO
10531	ENDDO
10532	ENDDO
10533	ENDIF
10534	ELSE
10535
10536	SELECT CASE ( TRIM( variable(7:) ) )
10537
10538	CASE ( 'g_H2SO4', 'g_HNO3', 'g_NH3', 'g_OCNV', 'g_OCSV' )
10539	IF ( TRIM( variable(9:) ) == 'H2SO4' ) THEN ! 9: remove salsa_g_ from beginning
10540	found_index = 1
10541	to_be_resorted => g_h2so4_av
10542	ELSEIF ( TRIM( variable(9:) ) == 'HNO3' ) THEN
10543	found_index = 2
10544	to_be_resorted => g_hno3_av
10545	ELSEIF ( TRIM( variable(9:) ) == 'NH3' ) THEN
10546	found_index = 3
10547	to_be_resorted => g_nh3_av
10548	ELSEIF ( TRIM( variable(9:) ) == 'OCNV' ) THEN
10549	found_index = 4
10550	to_be_resorted => g_ocnv_av
10551	ELSEIF ( TRIM( variable(9:) ) == 'OCSV' ) THEN
10552	found_index = 5
10553	to_be_resorted => g_ocsv_av
10554	ENDIF
10555	DO i = nxlg, nxrg
10556	DO j = nysg, nyng
10557	DO k = nzb, nzt+1
10558	to_be_resorted(k,j,i) = to_be_resorted(k,j,i) / &
10559	REAL( average_count_3d, KIND=wp )
10560	ENDDO
10561	ENDDO
10562	ENDDO
10563
10564	CASE ( 'LDSA' )
10565	DO i = nxlg, nxrg
10566	DO j = nysg, nyng
10567	DO k = nzb, nzt+1
10568	ldsa_av(k,j,i) = ldsa_av(k,j,i) / REAL( average_count_3d, KIND=wp )
10569	ENDDO
10570	ENDDO
10571	ENDDO
10572
10573	CASE ( 'N_UFP' )
10574	DO i = nxlg, nxrg
10575	DO j = nysg, nyng
10576	DO k = nzb, nzt+1
10577	nufp_av(k,j,i) = nufp_av(k,j,i) / REAL( average_count_3d, KIND=wp )
10578	ENDDO
10579	ENDDO
10580	ENDDO
10581
10582	CASE ( 'Ntot' )
10583	DO i = nxlg, nxrg
10584	DO j = nysg, nyng
10585	DO k = nzb, nzt+1
10586	ntot_av(k,j,i) = ntot_av(k,j,i) / REAL( average_count_3d, KIND=wp )
10587	ENDDO
10588	ENDDO
10589	ENDDO
10590
10591
10592	CASE ( 'PM0.1' )
10593	DO i = nxlg, nxrg
10594	DO j = nysg, nyng
10595	DO k = nzb, nzt+1
10596	pm01_av(k,j,i) = pm01_av(k,j,i) / REAL( average_count_3d, KIND=wp )
10597	ENDDO
10598	ENDDO
10599	ENDDO
10600
10601	CASE ( 'PM2.5' )
10602	DO i = nxlg, nxrg
10603	DO j = nysg, nyng
10604	DO k = nzb, nzt+1
10605	pm25_av(k,j,i) = pm25_av(k,j,i) / REAL( average_count_3d, KIND=wp )
10606	ENDDO
10607	ENDDO
10608	ENDDO
10609
10610	CASE ( 'PM10' )
10611	DO i = nxlg, nxrg
10612	DO j = nysg, nyng
10613	DO k = nzb, nzt+1
10614	pm10_av(k,j,i) = pm10_av(k,j,i) / REAL( average_count_3d, KIND=wp )
10615	ENDDO
10616	ENDDO
10617	ENDDO
10618
10619	CASE ( 's_BC', 's_DU', 's_NH', 's_NO', 's_OC', 's_SO4', 's_SS' )
10620	IF ( is_used( prtcl, TRIM( variable(9:) ) ) ) THEN ! 9: remove salsa_s_
10621	IF ( TRIM( variable(9:) ) == 'BC' ) to_be_resorted => s_bc_av
10622	IF ( TRIM( variable(9:) ) == 'DU' ) to_be_resorted => s_du_av
10623	IF ( TRIM( variable(9:) ) == 'NH' ) to_be_resorted => s_nh_av
10624	IF ( TRIM( variable(9:) ) == 'NO' ) to_be_resorted => s_no_av
10625	IF ( TRIM( variable(9:) ) == 'OC' ) to_be_resorted => s_oc_av
10626	IF ( TRIM( variable(9:) ) == 'SO4' ) to_be_resorted => s_so4_av
10627	IF ( TRIM( variable(9:) ) == 'SS' ) to_be_resorted => s_ss_av
10628	DO i = nxlg, nxrg
10629	DO j = nysg, nyng
10630	DO k = nzb, nzt+1
10631	to_be_resorted(k,j,i) = to_be_resorted(k,j,i) / &
10632	REAL( average_count_3d, KIND=wp )
10633	ENDDO
10634	ENDDO
10635	ENDDO
10636	ENDIF
10637
10638	CASE ( 's_H2O' )
10639	to_be_resorted => s_h2o_av
10640	DO i = nxlg, nxrg
10641	DO j = nysg, nyng
10642	DO k = nzb, nzt+1
10643	to_be_resorted(k,j,i) = to_be_resorted(k,j,i) / &
10644	REAL( average_count_3d, KIND=wp )
10645	ENDDO
10646	ENDDO
10647	ENDDO
10648
10649	END SELECT
10650
10651	ENDIF
10652	ENDIF
10653
10654	END SUBROUTINE salsa_3d_data_averaging
10655
10656
10657	!------------------------------------------------------------------------------!
10658	!
10659	! Description:
10660	! ------------
10661	!> Subroutine defining 2D output variables
10662	!------------------------------------------------------------------------------!
10663	SUBROUTINE salsa_data_output_2d( av, variable, found, grid, mode, local_pf, two_d, nzb_do, nzt_do )
10664
10665	USE indices
10666
10667	USE kinds
10668
10669
10670	IMPLICIT NONE
10671
10672	CHARACTER(LEN=*) :: grid !<
10673	CHARACTER(LEN=*) :: mode !<
10674	CHARACTER(LEN=*) :: variable !<
10675	CHARACTER(LEN=5) :: vari !< trimmed format of variable
10676
10677	INTEGER(iwp) :: av !<
10678	INTEGER(iwp) :: char_to_int !< for converting character to integer
10679	INTEGER(iwp) :: found_index !< index of a chemical compound
10680	INTEGER(iwp) :: i !<
10681	INTEGER(iwp) :: ib !< running index: size bins
10682	INTEGER(iwp) :: ic !< running index: mass bins
10683	INTEGER(iwp) :: j !<
10684	INTEGER(iwp) :: k !<
10685	INTEGER(iwp) :: nzb_do !<
10686	INTEGER(iwp) :: nzt_do !<
10687
10688	LOGICAL :: found !<
10689	LOGICAL :: two_d !< flag parameter to indicate 2D variables (horizontal cross sections)
10690
10691	REAL(wp) :: df !< For calculating LDSA: fraction of particles
10692	!< depositing in the alveolar (or tracheobronchial)
10693	!< region of the lung. Depends on the particle size
10694	REAL(wp) :: mean_d !< Particle diameter in micrometres
10695	REAL(wp) :: temp_bin !< temporary array for calculating output variables
10696
10697	REAL(wp), DIMENSION(nxl:nxr,nys:nyn,nzb_do:nzt_do) :: local_pf !< output
10698
10699	REAL(wp), DIMENSION(:,:,:), POINTER :: to_be_resorted !< pointer
10700	!
10701	!-- Next statement is to avoid compiler warning about unused variable. May be removed in future.
10702	IF ( two_d ) CONTINUE
10703
10704	found = .TRUE.
10705	temp_bin = 0.0_wp
10706
10707	IF ( variable(7:11) == 'N_bin' ) THEN
10708
10709	READ( variable( 12:LEN( TRIM( variable ) ) - 3 ), * ) char_to_int
10710	IF ( char_to_int >= 1 .AND. char_to_int <= SUM( nbin ) ) THEN
10711
10712	ib = char_to_int
10713	IF ( av == 0 ) THEN
10714	DO i = nxl, nxr
10715	DO j = nys, nyn
10716	DO k = nzb_do, nzt_do
10717	local_pf(i,j,k) = MERGE( aerosol_number(ib)%conc(k,j,i), REAL( fill_value, &
10718	KIND = wp ), BTEST( wall_flags_total_0(k,j,i), 0 ) )
10719	ENDDO
10720	ENDDO
10721	ENDDO
10722	ELSE
10723	DO i = nxl, nxr
10724	DO j = nys, nyn
10725	DO k = nzb_do, nzt_do
10726	local_pf(i,j,k) = MERGE( nbins_av(k,j,i,ib), REAL( fill_value, KIND = wp ), &
10727	BTEST( wall_flags_total_0(k,j,i), 0 ) )
10728	ENDDO
10729	ENDDO
10730	ENDDO
10731	ENDIF
10732	IF ( mode == 'xy' ) grid = 'zu'
10733	ENDIF
10734
10735	ELSEIF ( variable(7:11) == 'm_bin' ) THEN
10736
10737	READ( variable( 12:LEN( TRIM( variable ) ) - 3 ), * ) char_to_int
10738	IF ( char_to_int >= 1 .AND. char_to_int <= SUM( nbin ) ) THEN
10739
10740	ib = char_to_int
10741	IF ( av == 0 ) THEN
10742	DO i = nxl, nxr
10743	DO j = nys, nyn
10744	DO k = nzb_do, nzt_do
10745	temp_bin = 0.0_wp
10746	DO ic = ib, ncomponents_mass * nbins_aerosol, nbins_aerosol
10747	temp_bin = temp_bin + aerosol_mass(ic)%conc(k,j,i)
10748	ENDDO
10749	local_pf(i,j,k) = MERGE( temp_bin, REAL( fill_value, KIND = wp ), &
10750	BTEST( wall_flags_total_0(k,j,i), 0 ) )
10751	ENDDO
10752	ENDDO
10753	ENDDO
10754	ELSE
10755	DO i = nxl, nxr
10756	DO j = nys, nyn
10757	DO k = nzb_do, nzt_do
10758	local_pf(i,j,k) = MERGE( mbins_av(k,j,i,ib), REAL( fill_value, KIND = wp ), &
10759	BTEST( wall_flags_total_0(k,j,i), 0 ) )
10760	ENDDO
10761	ENDDO
10762	ENDDO
10763	ENDIF
10764	IF ( mode == 'xy' ) grid = 'zu'
10765	ENDIF
10766
10767	ELSE
10768
10769	SELECT CASE ( TRIM( variable( 7:LEN( TRIM( variable ) ) - 3 ) ) ) ! cut out _xy, _xz or _yz
10770
10771	CASE ( 'g_H2SO4', 'g_HNO3', 'g_NH3', 'g_OCNV', 'g_OCSV' )
10772	vari = TRIM( variable( 9:LEN( TRIM( variable ) ) - 3 ) ) ! 9: remove salsa_g_
10773	IF ( av == 0 ) THEN
10774	IF ( vari == 'H2SO4') found_index = 1
10775	IF ( vari == 'HNO3') found_index = 2
10776	IF ( vari == 'NH3') found_index = 3
10777	IF ( vari == 'OCNV') found_index = 4
10778	IF ( vari == 'OCSV') found_index = 5
10779	DO i = nxl, nxr
10780	DO j = nys, nyn
10781	DO k = nzb_do, nzt_do
10782	local_pf(i,j,k) = MERGE( salsa_gas(found_index)%conc(k,j,i), &
10783	REAL( fill_value, KIND = wp ), &
10784	BTEST( wall_flags_total_0(k,j,i), 0 ) )
10785	ENDDO
10786	ENDDO
10787	ENDDO
10788	ELSE
10789	IF ( vari == 'H2SO4' ) to_be_resorted => g_h2so4_av
10790	IF ( vari == 'HNO3' ) to_be_resorted => g_hno3_av
10791	IF ( vari == 'NH3' ) to_be_resorted => g_nh3_av
10792	IF ( vari == 'OCNV' ) to_be_resorted => g_ocnv_av
10793	IF ( vari == 'OCSV' ) to_be_resorted => g_ocsv_av
10794	DO i = nxl, nxr
10795	DO j = nys, nyn
10796	DO k = nzb_do, nzt_do
10797	local_pf(i,j,k) = MERGE( to_be_resorted(k,j,i), REAL( fill_value, &
10798	KIND = wp ), BTEST( wall_flags_total_0(k,j,i), 0 ) )
10799	ENDDO
10800	ENDDO
10801	ENDDO
10802	ENDIF
10803
10804	IF ( mode == 'xy' ) grid = 'zu'
10805
10806	CASE ( 'LDSA' )
10807	IF ( av == 0 ) THEN
10808	DO i = nxl, nxr
10809	DO j = nys, nyn
10810	DO k = nzb_do, nzt_do
10811	temp_bin = 0.0_wp
10812	DO ib = 1, nbins_aerosol
10813	!
10814	!-- Diameter in micrometres
10815	mean_d = 1.0E+6_wp * ra_dry(k,j,i,ib) * 2.0_wp
10816	!
10817	!-- Deposition factor: alveolar
10818	df = ( 0.01555_wp / mean_d ) * ( EXP( -0.416_wp * ( LOG( mean_d ) + &
10819	2.84_wp )*2 ) + 19.11_wp EXP( -0.482_wp * ( LOG( mean_d ) - &
10820	1.362_wp )**2 ) )
10821	!
10822	!-- Lung-deposited surface area LDSA (units mum2/cm3)
10823	temp_bin = temp_bin + pi * mean_d*2 df * 1.0E-6_wp * &
10824	aerosol_number(ib)%conc(k,j,i)
10825	ENDDO
10826
10827	local_pf(i,j,k) = MERGE( temp_bin, REAL( fill_value, KIND = wp ), &
10828	BTEST( wall_flags_total_0(k,j,i), 0 ) )
10829	ENDDO
10830	ENDDO
10831	ENDDO
10832	ELSE
10833	DO i = nxl, nxr
10834	DO j = nys, nyn
10835	DO k = nzb_do, nzt_do
10836	local_pf(i,j,k) = MERGE( ldsa_av(k,j,i), REAL( fill_value, KIND = wp ), &
10837	BTEST( wall_flags_total_0(k,j,i), 0 ) )
10838	ENDDO
10839	ENDDO
10840	ENDDO
10841	ENDIF
10842
10843	IF ( mode == 'xy' ) grid = 'zu'
10844
10845	CASE ( 'N_UFP' )
10846
10847	IF ( av == 0 ) THEN
10848	DO i = nxl, nxr
10849	DO j = nys, nyn
10850	DO k = nzb_do, nzt_do
10851	temp_bin = 0.0_wp
10852	DO ib = 1, nbins_aerosol
10853	IF ( 2.0_wp * ra_dry(k,j,i,ib) <= 0.1E-6_wp ) THEN
10854	temp_bin = temp_bin + aerosol_number(ib)%conc(k,j,i)
10855	ENDIF
10856	ENDDO
10857	local_pf(i,j,k) = MERGE( temp_bin, REAL( fill_value, KIND = wp ), &
10858	BTEST( wall_flags_total_0(k,j,i), 0 ) )
10859	ENDDO
10860	ENDDO
10861	ENDDO
10862	ELSE
10863	DO i = nxl, nxr
10864	DO j = nys, nyn
10865	DO k = nzb_do, nzt_do
10866	local_pf(i,j,k) = MERGE( nufp_av(k,j,i), REAL( fill_value, KIND = wp ), &
10867	BTEST( wall_flags_total_0(k,j,i), 0 ) )
10868	ENDDO
10869	ENDDO
10870	ENDDO
10871	ENDIF
10872
10873	IF ( mode == 'xy' ) grid = 'zu'
10874
10875	CASE ( 'Ntot' )
10876
10877	IF ( av == 0 ) THEN
10878	DO i = nxl, nxr
10879	DO j = nys, nyn
10880	DO k = nzb_do, nzt_do
10881	temp_bin = 0.0_wp
10882	DO ib = 1, nbins_aerosol
10883	temp_bin = temp_bin + aerosol_number(ib)%conc(k,j,i)
10884	ENDDO
10885	local_pf(i,j,k) = MERGE( temp_bin, REAL( fill_value, KIND = wp ), &
10886	BTEST( wall_flags_total_0(k,j,i), 0 ) )
10887	ENDDO
10888	ENDDO
10889	ENDDO
10890	ELSE
10891	DO i = nxl, nxr
10892	DO j = nys, nyn
10893	DO k = nzb_do, nzt_do
10894	local_pf(i,j,k) = MERGE( ntot_av(k,j,i), REAL( fill_value, KIND = wp ), &
10895	BTEST( wall_flags_total_0(k,j,i), 0 ) )
10896	ENDDO
10897	ENDDO
10898	ENDDO
10899	ENDIF
10900
10901	IF ( mode == 'xy' ) grid = 'zu'
10902
10903	CASE ( 'PM0.1' )
10904	IF ( av == 0 ) THEN
10905	DO i = nxl, nxr
10906	DO j = nys, nyn
10907	DO k = nzb_do, nzt_do
10908	temp_bin = 0.0_wp
10909	DO ib = 1, nbins_aerosol
10910	IF ( 2.0_wp * ra_dry(k,j,i,ib) <= 0.1E-6_wp ) THEN
10911	DO ic = ib, nbins_aerosol * ncc, nbins_aerosol
10912	temp_bin = temp_bin + aerosol_mass(ic)%conc(k,j,i)
10913	ENDDO
10914	ENDIF
10915	ENDDO
10916	local_pf(i,j,k) = MERGE( temp_bin, REAL( fill_value, KIND = wp ), &
10917	BTEST( wall_flags_total_0(k,j,i), 0 ) )
10918	ENDDO
10919	ENDDO
10920	ENDDO
10921	ELSE
10922	DO i = nxl, nxr
10923	DO j = nys, nyn
10924	DO k = nzb_do, nzt_do
10925	local_pf(i,j,k) = MERGE( pm01_av(k,j,i), REAL( fill_value, KIND = wp ), &
10926	BTEST( wall_flags_total_0(k,j,i), 0 ) )
10927	ENDDO
10928	ENDDO
10929	ENDDO
10930	ENDIF
10931
10932	IF ( mode == 'xy' ) grid = 'zu'
10933
10934	CASE ( 'PM2.5' )
10935	IF ( av == 0 ) THEN
10936	DO i = nxl, nxr
10937	DO j = nys, nyn
10938	DO k = nzb_do, nzt_do
10939	temp_bin = 0.0_wp
10940	DO ib = 1, nbins_aerosol
10941	IF ( 2.0_wp * ra_dry(k,j,i,ib) <= 2.5E-6_wp ) THEN
10942	DO ic = ib, nbins_aerosol * ncc, nbins_aerosol
10943	temp_bin = temp_bin + aerosol_mass(ic)%conc(k,j,i)
10944	ENDDO
10945	ENDIF
10946	ENDDO
10947	local_pf(i,j,k) = MERGE( temp_bin, REAL( fill_value, KIND = wp ), &
10948	BTEST( wall_flags_total_0(k,j,i), 0 ) )
10949	ENDDO
10950	ENDDO
10951	ENDDO
10952	ELSE
10953	DO i = nxl, nxr
10954	DO j = nys, nyn
10955	DO k = nzb_do, nzt_do
10956	local_pf(i,j,k) = MERGE( pm25_av(k,j,i), REAL( fill_value, KIND = wp ), &
10957	BTEST( wall_flags_total_0(k,j,i), 0 ) )
10958	ENDDO
10959	ENDDO
10960	ENDDO
10961	ENDIF
10962
10963	IF ( mode == 'xy' ) grid = 'zu'
10964
10965	CASE ( 'PM10' )
10966	IF ( av == 0 ) THEN
10967	DO i = nxl, nxr
10968	DO j = nys, nyn
10969	DO k = nzb_do, nzt_do
10970	temp_bin = 0.0_wp
10971	DO ib = 1, nbins_aerosol
10972	IF ( 2.0_wp * ra_dry(k,j,i,ib) <= 10.0E-6_wp ) THEN
10973	DO ic = ib, nbins_aerosol * ncc, nbins_aerosol
10974	temp_bin = temp_bin + aerosol_mass(ic)%conc(k,j,i)
10975	ENDDO
10976	ENDIF
10977	ENDDO
10978	local_pf(i,j,k) = MERGE( temp_bin, REAL( fill_value, KIND = wp ), &
10979	BTEST( wall_flags_total_0(k,j,i), 0 ) )
10980	ENDDO
10981	ENDDO
10982	ENDDO
10983	ELSE
10984	DO i = nxl, nxr
10985	DO j = nys, nyn
10986	DO k = nzb_do, nzt_do
10987	local_pf(i,j,k) = MERGE( pm10_av(k,j,i), REAL( fill_value, KIND = wp ), &
10988	BTEST( wall_flags_total_0(k,j,i), 0 ) )
10989	ENDDO
10990	ENDDO
10991	ENDDO
10992	ENDIF
10993
10994	IF ( mode == 'xy' ) grid = 'zu'
10995
10996	CASE ( 's_BC', 's_DU', 's_NH', 's_NO', 's_OC', 's_SO4', 's_SS' )
10997	vari = TRIM( variable( 9:LEN( TRIM( variable ) ) - 3 ) ) ! 9: remove salsa_s_
10998	IF ( is_used( prtcl, vari ) ) THEN
10999	found_index = get_index( prtcl, vari )
11000	IF ( av == 0 ) THEN
11001	DO i = nxl, nxr
11002	DO j = nys, nyn
11003	DO k = nzb_do, nzt_do
11004	temp_bin = 0.0_wp
11005	DO ic = ( found_index-1 ) * nbins_aerosol+1, found_index * nbins_aerosol
11006	temp_bin = temp_bin + aerosol_mass(ic)%conc(k,j,i)
11007	ENDDO
11008	local_pf(i,j,k) = MERGE( temp_bin, REAL( fill_value, KIND = wp ), &
11009	BTEST( wall_flags_total_0(k,j,i), 0 ) )
11010	ENDDO
11011	ENDDO
11012	ENDDO
11013	ELSE
11014	IF ( vari == 'BC' ) to_be_resorted => s_bc_av
11015	IF ( vari == 'DU' ) to_be_resorted => s_du_av
11016	IF ( vari == 'NH' ) to_be_resorted => s_nh_av
11017	IF ( vari == 'NO' ) to_be_resorted => s_no_av
11018	IF ( vari == 'OC' ) to_be_resorted => s_oc_av
11019	IF ( vari == 'SO4' ) to_be_resorted => s_so4_av
11020	IF ( vari == 'SS' ) to_be_resorted => s_ss_av
11021	DO i = nxl, nxr
11022	DO j = nys, nyn
11023	DO k = nzb_do, nzt_do
11024	local_pf(i,j,k) = MERGE( to_be_resorted(k,j,i), REAL( fill_value, &
11025	KIND = wp ), BTEST( wall_flags_total_0(k,j,i), 0 ) )
11026	ENDDO
11027	ENDDO
11028	ENDDO
11029	ENDIF
11030	ELSE
11031	local_pf = fill_value
11032	ENDIF
11033
11034	IF ( mode == 'xy' ) grid = 'zu'
11035
11036	CASE ( 's_H2O' )
11037	found_index = get_index( prtcl, 'H2O' )
11038	IF ( av == 0 ) THEN
11039	DO i = nxl, nxr
11040	DO j = nys, nyn
11041	DO k = nzb_do, nzt_do
11042	temp_bin = 0.0_wp
11043	DO ic = ( found_index-1 ) * nbins_aerosol+1, found_index * nbins_aerosol
11044	temp_bin = temp_bin + aerosol_mass(ic)%conc(k,j,i)
11045	ENDDO
11046	local_pf(i,j,k) = MERGE( temp_bin, REAL( fill_value, KIND = wp ), &
11047	BTEST( wall_flags_total_0(k,j,i), 0 ) )
11048	ENDDO
11049	ENDDO
11050	ENDDO
11051	ELSE
11052	to_be_resorted => s_h2o_av
11053	DO i = nxl, nxr
11054	DO j = nys, nyn
11055	DO k = nzb_do, nzt_do
11056	local_pf(i,j,k) = MERGE( to_be_resorted(k,j,i), REAL( fill_value, &
11057	KIND = wp ), BTEST( wall_flags_total_0(k,j,i), 0 ) )
11058	ENDDO
11059	ENDDO
11060	ENDDO
11061	ENDIF
11062
11063	IF ( mode == 'xy' ) grid = 'zu'
11064
11065	CASE DEFAULT
11066	found = .FALSE.
11067	grid = 'none'
11068
11069	END SELECT
11070
11071	ENDIF
11072
11073	END SUBROUTINE salsa_data_output_2d
11074
11075	!------------------------------------------------------------------------------!
11076	!
11077	! Description:
11078	! ------------
11079	!> Subroutine defining 3D output variables
11080	!------------------------------------------------------------------------------!
11081	SUBROUTINE salsa_data_output_3d( av, variable, found, local_pf, nzb_do, nzt_do )
11082
11083	USE indices
11084
11085	USE kinds
11086
11087
11088	IMPLICIT NONE
11089
11090	CHARACTER(LEN=*), INTENT(in) :: variable !<
11091
11092	INTEGER(iwp) :: av !<
11093	INTEGER(iwp) :: char_to_int !< for converting character to integer
11094	INTEGER(iwp) :: found_index !< index of a chemical compound
11095	INTEGER(iwp) :: ib !< running index: size bins
11096	INTEGER(iwp) :: ic !< running index: mass bins
11097	INTEGER(iwp) :: i !<
11098	INTEGER(iwp) :: j !<
11099	INTEGER(iwp) :: k !<
11100	INTEGER(iwp) :: nzb_do !<
11101	INTEGER(iwp) :: nzt_do !<
11102
11103	LOGICAL :: found !<
11104
11105	REAL(wp) :: df !< For calculating LDSA: fraction of particles
11106	!< depositing in the alveolar (or tracheobronchial)
11107	!< region of the lung. Depends on the particle size
11108	REAL(wp) :: mean_d !< Particle diameter in micrometres
11109	REAL(wp) :: temp_bin !< temporary array for calculating output variables
11110
11111	REAL(sp), DIMENSION(nxl:nxr,nys:nyn,nzb_do:nzt_do) :: local_pf !< local
11112
11113	REAL(wp), DIMENSION(:,:,:), POINTER :: to_be_resorted !< pointer
11114
11115	found = .TRUE.
11116	temp_bin = 0.0_wp
11117
11118	IF ( variable(7:11) == 'N_bin' ) THEN
11119	READ( variable(12:),* ) char_to_int
11120	IF ( char_to_int >= 1 .AND. char_to_int <= SUM( nbin ) ) THEN
11121
11122	ib = char_to_int
11123	IF ( av == 0 ) THEN
11124	DO i = nxl, nxr
11125	DO j = nys, nyn
11126	DO k = nzb_do, nzt_do
11127	local_pf(i,j,k) = MERGE( aerosol_number(ib)%conc(k,j,i), REAL( fill_value, &
11128	KIND = wp ), BTEST( wall_flags_total_0(k,j,i), 0 ) )
11129	ENDDO
11130	ENDDO
11131	ENDDO
11132	ELSE
11133	DO i = nxl, nxr
11134	DO j = nys, nyn
11135	DO k = nzb_do, nzt_do
11136	local_pf(i,j,k) = MERGE( nbins_av(k,j,i,ib), REAL( fill_value, KIND = wp ), &
11137	BTEST( wall_flags_total_0(k,j,i), 0 ) )
11138	ENDDO
11139	ENDDO
11140	ENDDO
11141	ENDIF
11142	ENDIF
11143
11144	ELSEIF ( variable(7:11) == 'm_bin' ) THEN
11145	READ( variable(12:),* ) char_to_int
11146	IF ( char_to_int >= 1 .AND. char_to_int <= SUM( nbin ) ) THEN
11147
11148	ib = char_to_int
11149	IF ( av == 0 ) THEN
11150	DO i = nxl, nxr
11151	DO j = nys, nyn
11152	DO k = nzb_do, nzt_do
11153	temp_bin = 0.0_wp
11154	DO ic = ib, ncomponents_mass * nbins_aerosol, nbins_aerosol
11155	temp_bin = temp_bin + aerosol_mass(ic)%conc(k,j,i)
11156	ENDDO
11157	local_pf(i,j,k) = MERGE( temp_bin, REAL( fill_value, KIND = wp ), &
11158	BTEST( wall_flags_total_0(k,j,i), 0 ) )
11159	ENDDO
11160	ENDDO
11161	ENDDO
11162	ELSE
11163	DO i = nxl, nxr
11164	DO j = nys, nyn
11165	DO k = nzb_do, nzt_do
11166	local_pf(i,j,k) = MERGE( mbins_av(k,j,i,ib), REAL( fill_value, KIND = wp ), &
11167	BTEST( wall_flags_total_0(k,j,i), 0 ) )
11168	ENDDO
11169	ENDDO
11170	ENDDO
11171	ENDIF
11172	ENDIF
11173
11174	ELSE
11175	SELECT CASE ( TRIM( variable(7:) ) )
11176
11177	CASE ( 'g_H2SO4', 'g_HNO3', 'g_NH3', 'g_OCNV', 'g_OCSV' )
11178	IF ( av == 0 ) THEN
11179	IF ( TRIM( variable(7:) ) == 'g_H2SO4') found_index = 1
11180	IF ( TRIM( variable(7:) ) == 'g_HNO3') found_index = 2
11181	IF ( TRIM( variable(7:) ) == 'g_NH3') found_index = 3
11182	IF ( TRIM( variable(7:) ) == 'g_OCNV') found_index = 4
11183	IF ( TRIM( variable(7:) ) == 'g_OCSV') found_index = 5
11184
11185	DO i = nxl, nxr
11186	DO j = nys, nyn
11187	DO k = nzb_do, nzt_do
11188	local_pf(i,j,k) = MERGE( salsa_gas(found_index)%conc(k,j,i), &
11189	REAL( fill_value, KIND = wp ), &
11190	BTEST( wall_flags_total_0(k,j,i), 0 ) )
11191	ENDDO
11192	ENDDO
11193	ENDDO
11194	ELSE
11195	!
11196	!-- 9: remove salsa_g_ from the beginning
11197	IF ( TRIM( variable(9:) ) == 'H2SO4' ) to_be_resorted => g_h2so4_av
11198	IF ( TRIM( variable(9:) ) == 'HNO3' ) to_be_resorted => g_hno3_av
11199	IF ( TRIM( variable(9:) ) == 'NH3' ) to_be_resorted => g_nh3_av
11200	IF ( TRIM( variable(9:) ) == 'OCNV' ) to_be_resorted => g_ocnv_av
11201	IF ( TRIM( variable(9:) ) == 'OCSV' ) to_be_resorted => g_ocsv_av
11202	DO i = nxl, nxr
11203	DO j = nys, nyn
11204	DO k = nzb_do, nzt_do
11205	local_pf(i,j,k) = MERGE( to_be_resorted(k,j,i), REAL( fill_value, &
11206	KIND = wp ), BTEST( wall_flags_total_0(k,j,i), 0 ) )
11207	ENDDO
11208	ENDDO
11209	ENDDO
11210	ENDIF
11211
11212	CASE ( 'LDSA' )
11213	IF ( av == 0 ) THEN
11214	DO i = nxl, nxr
11215	DO j = nys, nyn
11216	DO k = nzb_do, nzt_do
11217	temp_bin = 0.0_wp
11218	DO ib = 1, nbins_aerosol
11219	!
11220	!-- Diameter in micrometres
11221	mean_d = 1.0E+6_wp * ra_dry(k,j,i,ib) * 2.0_wp
11222	!
11223	!-- Deposition factor: alveolar
11224	df = ( 0.01555_wp / mean_d ) * ( EXP( -0.416_wp * ( LOG( mean_d ) + &
11225	2.84_wp )*2 ) + 19.11_wp EXP( -0.482_wp * ( LOG( mean_d ) - &
11226	1.362_wp )**2 ) )
11227	!
11228	!-- Lung-deposited surface area LDSA (units mum2/cm3)
11229	temp_bin = temp_bin + pi * mean_d*2 df * 1.0E-6_wp * &
11230	aerosol_number(ib)%conc(k,j,i)
11231	ENDDO
11232	local_pf(i,j,k) = MERGE( temp_bin, REAL( fill_value, KIND = wp ), &
11233	BTEST( wall_flags_total_0(k,j,i), 0 ) )
11234	ENDDO
11235	ENDDO
11236	ENDDO
11237	ELSE
11238	DO i = nxl, nxr
11239	DO j = nys, nyn
11240	DO k = nzb_do, nzt_do
11241	local_pf(i,j,k) = MERGE( ldsa_av(k,j,i), REAL( fill_value, KIND = wp ), &
11242	BTEST( wall_flags_total_0(k,j,i), 0 ) )
11243	ENDDO
11244	ENDDO
11245	ENDDO
11246	ENDIF
11247
11248	CASE ( 'N_UFP' )
11249	IF ( av == 0 ) THEN
11250	DO i = nxl, nxr
11251	DO j = nys, nyn
11252	DO k = nzb_do, nzt_do
11253	temp_bin = 0.0_wp
11254	DO ib = 1, nbins_aerosol
11255	IF ( 2.0_wp * ra_dry(k,j,i,ib) <= 0.1E-6_wp ) THEN
11256	temp_bin = temp_bin + aerosol_number(ib)%conc(k,j,i)
11257	ENDIF
11258	ENDDO
11259	local_pf(i,j,k) = MERGE( temp_bin, REAL( fill_value, KIND = wp ), &
11260	BTEST( wall_flags_total_0(k,j,i), 0 ) )
11261	ENDDO
11262	ENDDO
11263	ENDDO
11264	ELSE
11265	DO i = nxl, nxr
11266	DO j = nys, nyn
11267	DO k = nzb_do, nzt_do
11268	local_pf(i,j,k) = MERGE( nufp_av(k,j,i), REAL( fill_value, KIND = wp ), &
11269	BTEST( wall_flags_total_0(k,j,i), 0 ) )
11270	ENDDO
11271	ENDDO
11272	ENDDO
11273	ENDIF
11274
11275	CASE ( 'Ntot' )
11276	IF ( av == 0 ) THEN
11277	DO i = nxl, nxr
11278	DO j = nys, nyn
11279	DO k = nzb_do, nzt_do
11280	temp_bin = 0.0_wp
11281	DO ib = 1, nbins_aerosol
11282	temp_bin = temp_bin + aerosol_number(ib)%conc(k,j,i)
11283	ENDDO
11284	local_pf(i,j,k) = MERGE( temp_bin, REAL( fill_value, KIND = wp ), &
11285	BTEST( wall_flags_total_0(k,j,i), 0 ) )
11286	ENDDO
11287	ENDDO
11288	ENDDO
11289	ELSE
11290	DO i = nxl, nxr
11291	DO j = nys, nyn
11292	DO k = nzb_do, nzt_do
11293	local_pf(i,j,k) = MERGE( ntot_av(k,j,i), REAL( fill_value, KIND = wp ), &
11294	BTEST( wall_flags_total_0(k,j,i), 0 ) )
11295	ENDDO
11296	ENDDO
11297	ENDDO
11298	ENDIF
11299
11300	CASE ( 'PM0.1' )
11301	IF ( av == 0 ) THEN
11302	DO i = nxl, nxr
11303	DO j = nys, nyn
11304	DO k = nzb_do, nzt_do
11305	temp_bin = 0.0_wp
11306	DO ib = 1, nbins_aerosol
11307	IF ( 2.0_wp * ra_dry(k,j,i,ib) <= 0.1E-6_wp ) THEN
11308	DO ic = ib, nbins_aerosol * ncc, nbins_aerosol
11309	temp_bin = temp_bin + aerosol_mass(ic)%conc(k,j,i)
11310	ENDDO
11311	ENDIF
11312	ENDDO
11313	local_pf(i,j,k) = MERGE( temp_bin, REAL( fill_value, KIND = wp ), &
11314	BTEST( wall_flags_total_0(k,j,i), 0 ) )
11315	ENDDO
11316	ENDDO
11317	ENDDO
11318	ELSE
11319	DO i = nxl, nxr
11320	DO j = nys, nyn
11321	DO k = nzb_do, nzt_do
11322	local_pf(i,j,k) = MERGE( pm01_av(k,j,i), REAL( fill_value, KIND = wp ), &
11323	BTEST( wall_flags_total_0(k,j,i), 0 ) )
11324	ENDDO
11325	ENDDO
11326	ENDDO
11327	ENDIF
11328
11329	CASE ( 'PM2.5' )
11330	IF ( av == 0 ) THEN
11331	DO i = nxl, nxr
11332	DO j = nys, nyn
11333	DO k = nzb_do, nzt_do
11334	temp_bin = 0.0_wp
11335	DO ib = 1, nbins_aerosol
11336	IF ( 2.0_wp * ra_dry(k,j,i,ib) <= 2.5E-6_wp ) THEN
11337	DO ic = ib, nbins_aerosol * ncc, nbins_aerosol
11338	temp_bin = temp_bin + aerosol_mass(ic)%conc(k,j,i)
11339	ENDDO
11340	ENDIF
11341	ENDDO
11342	local_pf(i,j,k) = MERGE( temp_bin, REAL( fill_value, KIND = wp ), &
11343	BTEST( wall_flags_total_0(k,j,i), 0 ) )
11344	ENDDO
11345	ENDDO
11346	ENDDO
11347	ELSE
11348	DO i = nxl, nxr
11349	DO j = nys, nyn
11350	DO k = nzb_do, nzt_do
11351	local_pf(i,j,k) = MERGE( pm25_av(k,j,i), REAL( fill_value, KIND = wp ), &
11352	BTEST( wall_flags_total_0(k,j,i), 0 ) )
11353	ENDDO
11354	ENDDO
11355	ENDDO
11356	ENDIF
11357
11358	CASE ( 'PM10' )
11359	IF ( av == 0 ) THEN
11360	DO i = nxl, nxr
11361	DO j = nys, nyn
11362	DO k = nzb_do, nzt_do
11363	temp_bin = 0.0_wp
11364	DO ib = 1, nbins_aerosol
11365	IF ( 2.0_wp * ra_dry(k,j,i,ib) <= 10.0E-6_wp ) THEN
11366	DO ic = ib, nbins_aerosol * ncc, nbins_aerosol
11367	temp_bin = temp_bin + aerosol_mass(ic)%conc(k,j,i)
11368	ENDDO
11369	ENDIF
11370	ENDDO
11371	local_pf(i,j,k) = MERGE( temp_bin, REAL( fill_value, KIND = wp ), &
11372	BTEST( wall_flags_total_0(k,j,i), 0 ) )
11373	ENDDO
11374	ENDDO
11375	ENDDO
11376	ELSE
11377	DO i = nxl, nxr
11378	DO j = nys, nyn
11379	DO k = nzb_do, nzt_do
11380	local_pf(i,j,k) = MERGE( pm10_av(k,j,i), REAL( fill_value, KIND = wp ), &
11381	BTEST( wall_flags_total_0(k,j,i), 0 ) )
11382	ENDDO
11383	ENDDO
11384	ENDDO
11385	ENDIF
11386
11387	CASE ( 's_BC', 's_DU', 's_NH', 's_NO', 's_OC', 's_SO4', 's_SS' )
11388	IF ( is_used( prtcl, TRIM( variable(9:) ) ) ) THEN ! 9: remove salsa_s_
11389	found_index = get_index( prtcl, TRIM( variable(9:) ) )
11390	IF ( av == 0 ) THEN
11391	DO i = nxl, nxr
11392	DO j = nys, nyn
11393	DO k = nzb_do, nzt_do
11394	temp_bin = 0.0_wp
11395	DO ic = ( found_index-1 ) * nbins_aerosol + 1, found_index * nbins_aerosol
11396	temp_bin = temp_bin + aerosol_mass(ic)%conc(k,j,i)
11397	ENDDO
11398	local_pf(i,j,k) = MERGE( temp_bin, REAL( fill_value, KIND = wp ), &
11399	BTEST( wall_flags_total_0(k,j,i), 0 ) )
11400	ENDDO
11401	ENDDO
11402	ENDDO
11403	ELSE
11404	!
11405	!-- 9: remove salsa_s_ from the beginning
11406	IF ( TRIM( variable(9:) ) == 'BC' ) to_be_resorted => s_bc_av
11407	IF ( TRIM( variable(9:) ) == 'DU' ) to_be_resorted => s_du_av
11408	IF ( TRIM( variable(9:) ) == 'NH' ) to_be_resorted => s_nh_av
11409	IF ( TRIM( variable(9:) ) == 'NO' ) to_be_resorted => s_no_av
11410	IF ( TRIM( variable(9:) ) == 'OC' ) to_be_resorted => s_oc_av
11411	IF ( TRIM( variable(9:) ) == 'SO4' ) to_be_resorted => s_so4_av
11412	IF ( TRIM( variable(9:) ) == 'SS' ) to_be_resorted => s_ss_av
11413	DO i = nxl, nxr
11414	DO j = nys, nyn
11415	DO k = nzb_do, nzt_do
11416	local_pf(i,j,k) = MERGE( to_be_resorted(k,j,i), REAL( fill_value, &
11417	KIND = wp ), BTEST( wall_flags_total_0(k,j,i), 0 ) )
11418	ENDDO
11419	ENDDO
11420	ENDDO
11421	ENDIF
11422	ENDIF
11423
11424	CASE ( 's_H2O' )
11425	found_index = get_index( prtcl, 'H2O' )
11426	IF ( av == 0 ) THEN
11427	DO i = nxl, nxr
11428	DO j = nys, nyn
11429	DO k = nzb_do, nzt_do
11430	temp_bin = 0.0_wp
11431	DO ic = ( found_index-1 ) * nbins_aerosol + 1, found_index * nbins_aerosol
11432	temp_bin = temp_bin + aerosol_mass(ic)%conc(k,j,i)
11433	ENDDO
11434	local_pf(i,j,k) = MERGE( temp_bin, REAL( fill_value, KIND = wp ), &
11435	BTEST( wall_flags_total_0(k,j,i), 0 ) )
11436	ENDDO
11437	ENDDO
11438	ENDDO
11439	ELSE
11440	to_be_resorted => s_h2o_av
11441	DO i = nxl, nxr
11442	DO j = nys, nyn
11443	DO k = nzb_do, nzt_do
11444	local_pf(i,j,k) = MERGE( to_be_resorted(k,j,i), REAL( fill_value, &
11445	KIND = wp ), BTEST( wall_flags_total_0(k,j,i), 0 ) )
11446	ENDDO
11447	ENDDO
11448	ENDDO
11449	ENDIF
11450
11451	CASE DEFAULT
11452	found = .FALSE.
11453
11454	END SELECT
11455	ENDIF
11456
11457	END SUBROUTINE salsa_data_output_3d
11458
11459	!------------------------------------------------------------------------------!
11460	!
11461	! Description:
11462	! ------------
11463	!> Subroutine defining mask output variables
11464	!------------------------------------------------------------------------------!
11465	SUBROUTINE salsa_data_output_mask( av, variable, found, local_pf, mid )
11466
11467	USE arrays_3d, &
11468	ONLY: tend
11469
11470	USE control_parameters, &
11471	ONLY: mask_i, mask_j, mask_k, mask_size_l, mask_surface, nz_do3d
11472
11473	IMPLICIT NONE
11474
11475	CHARACTER(LEN=5) :: grid !< flag to distinquish between staggered grid
11476	CHARACTER(LEN=*) :: variable !<
11477	CHARACTER(LEN=7) :: vari !< trimmed format of variable
11478
11479	INTEGER(iwp) :: av !<
11480	INTEGER(iwp) :: char_to_int !< for converting character to integer
11481	INTEGER(iwp) :: found_index !< index of a chemical compound
11482	INTEGER(iwp) :: ib !< loop index for aerosol size number bins
11483	INTEGER(iwp) :: ic !< loop index for chemical components
11484	INTEGER(iwp) :: i !< loop index in x-direction
11485	INTEGER(iwp) :: j !< loop index in y-direction
11486	INTEGER(iwp) :: k !< loop index in z-direction
11487	INTEGER(iwp) :: im !< loop index for masked variables
11488	INTEGER(iwp) :: jm !< loop index for masked variables
11489	INTEGER(iwp) :: kk !< loop index for masked output in z-direction
11490	INTEGER(iwp) :: mid !< masked output running index
11491	INTEGER(iwp) :: ktt !< k index of highest terrain surface
11492
11493	LOGICAL :: found !<
11494	LOGICAL :: resorted !<
11495
11496	REAL(wp) :: df !< For calculating LDSA: fraction of particles depositing in the alveolar
11497	!< (or tracheobronchial) region of the lung. Depends on the particle size
11498	REAL(wp) :: mean_d !< Particle diameter in micrometres
11499	REAL(wp) :: temp_bin !< temporary array for calculating output variables
11500
11501	REAL(wp), DIMENSION(mask_size_l(mid,1),mask_size_l(mid,2),mask_size_l(mid,3)) :: local_pf !<
11502
11503	REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg), TARGET :: temp_array !< temporary array
11504
11505	REAL(wp), DIMENSION(:,:,:), POINTER :: to_be_resorted !< pointer
11506
11507	found = .TRUE.
11508	resorted = .FALSE.
11509	grid = 's'
11510	tend = 0.0_wp
11511	temp_array = 0.0_wp
11512	temp_bin = 0.0_wp
11513
11514	IF ( variable(7:11) == 'N_bin' ) THEN
11515	READ( variable(12:),* ) char_to_int
11516	IF ( char_to_int >= 1 .AND. char_to_int <= SUM( nbin ) ) THEN
11517	ib = char_to_int
11518	IF ( av == 0 ) THEN
11519	IF ( .NOT. mask_surface(mid) ) THEN
11520	DO i = 1, mask_size_l(mid,1)
11521	DO j = 1, mask_size_l(mid,2)
11522	DO k = 1, mask_size_l(mid,3)
11523	local_pf(i,j,k) = aerosol_number(ib)%conc( mask_k(mid,k), mask_j(mid,j), &
11524	mask_i(mid,i) )
11525	ENDDO
11526	ENDDO
11527	ENDDO
11528	ELSE
11529	DO i = 1, mask_size_l(mid,1)
11530	DO j = 1, mask_size_l(mid,2)
11531	!
11532	!-- Get k index of the highest terraing surface
11533	im = mask_i(mid,i)
11534	jm = mask_j(mid,j)
11535	ktt = MINLOC( MERGE( 1, 0, BTEST( wall_flags_total_0(:,jm,im), 5 )), &
11536	DIM = 1 ) - 1
11537	DO k = 1, mask_size_l(mid,3)
11538	kk = MIN( ktt+mask_k(mid,k), nzt+1 )
11539	!
11540	!-- Set value if not in building
11541	IF ( BTEST( wall_flags_total_0(kk,jm,im), 6 ) ) THEN
11542	local_pf(i,j,k) = fill_value
11543	ELSE
11544	local_pf(i,j,k) = aerosol_number(ib)%conc(kk,jm,im)
11545	ENDIF
11546	ENDDO
11547	ENDDO
11548	ENDDO
11549	ENDIF
11550	resorted = .TRUE.
11551	ELSE
11552	temp_array = nbins_av(:,:,:,ib)
11553	to_be_resorted => temp_array
11554	ENDIF
11555	ENDIF
11556
11557	ELSEIF ( variable(7:11) == 'm_bin' ) THEN
11558
11559	READ( variable(12:),* ) char_to_int
11560	IF ( char_to_int >= 1 .AND. char_to_int <= SUM( nbin ) ) THEN
11561
11562	ib = char_to_int
11563	IF ( av == 0 ) THEN
11564	DO i = nxl, nxr
11565	DO j = nys, nyn
11566	DO k = nzb, nz_do3d
11567	temp_bin = 0.0_wp
11568	DO ic = ib, ncomponents_mass * nbins_aerosol, nbins_aerosol
11569	temp_bin = temp_bin + aerosol_mass(ic)%conc(k,j,i)
11570	ENDDO
11571	tend(k,j,i) = temp_bin
11572	ENDDO
11573	ENDDO
11574	ENDDO
11575	IF ( .NOT. mask_surface(mid) ) THEN
11576	DO i = 1, mask_size_l(mid,1)
11577	DO j = 1, mask_size_l(mid,2)
11578	DO k = 1, mask_size_l(mid,3)
11579	local_pf(i,j,k) = tend( mask_k(mid,k), mask_j(mid,j), mask_i(mid,i) )
11580	ENDDO
11581	ENDDO
11582	ENDDO
11583	ELSE
11584	DO i = 1, mask_size_l(mid,1)
11585	DO j = 1, mask_size_l(mid,2)
11586	!
11587	!-- Get k index of the highest terraing surface
11588	im = mask_i(mid,i)
11589	jm = mask_j(mid,j)
11590	ktt = MINLOC( MERGE( 1, 0, BTEST( wall_flags_total_0(:,jm,im), 5 )), &
11591	DIM = 1 ) - 1
11592	DO k = 1, mask_size_l(mid,3)
11593	kk = MIN( ktt+mask_k(mid,k), nzt+1 )
11594	!
11595	!-- Set value if not in building
11596	IF ( BTEST( wall_flags_total_0(kk,jm,im), 6 ) ) THEN
11597	local_pf(i,j,k) = fill_value
11598	ELSE
11599	local_pf(i,j,k) = tend(kk,jm,im)
11600	ENDIF
11601	ENDDO
11602	ENDDO
11603	ENDDO
11604	ENDIF
11605	resorted = .TRUE.
11606	ELSE
11607	temp_array = mbins_av(:,:,:,ib)
11608	to_be_resorted => temp_array
11609	ENDIF
11610	ENDIF
11611
11612	ELSE
11613	SELECT CASE ( TRIM( variable(7:) ) )
11614
11615	CASE ( 'g_H2SO4', 'g_HNO3', 'g_NH3', 'g_OCNV', 'g_OCSV' )
11616	vari = TRIM( variable(7:) )
11617	IF ( av == 0 ) THEN
11618	IF ( vari == 'g_H2SO4') to_be_resorted => salsa_gas(1)%conc
11619	IF ( vari == 'g_HNO3') to_be_resorted => salsa_gas(2)%conc
11620	IF ( vari == 'g_NH3') to_be_resorted => salsa_gas(3)%conc
11621	IF ( vari == 'g_OCNV') to_be_resorted => salsa_gas(4)%conc
11622	IF ( vari == 'g_OCSV') to_be_resorted => salsa_gas(5)%conc
11623	ELSE
11624	IF ( vari == 'g_H2SO4') to_be_resorted => g_h2so4_av
11625	IF ( vari == 'g_HNO3') to_be_resorted => g_hno3_av
11626	IF ( vari == 'g_NH3') to_be_resorted => g_nh3_av
11627	IF ( vari == 'g_OCNV') to_be_resorted => g_ocnv_av
11628	IF ( vari == 'g_OCSV') to_be_resorted => g_ocsv_av
11629	ENDIF
11630
11631	CASE ( 'LDSA' )
11632	IF ( av == 0 ) THEN
11633	DO i = nxl, nxr
11634	DO j = nys, nyn
11635	DO k = nzb, nz_do3d
11636	temp_bin = 0.0_wp
11637	DO ib = 1, nbins_aerosol
11638	!
11639	!-- Diameter in micrometres
11640	mean_d = 1.0E+6_wp * ra_dry(k,j,i,ib) * 2.0_wp
11641	!
11642	!-- Deposition factor: alveolar
11643	df = ( 0.01555_wp / mean_d ) * ( EXP( -0.416_wp * ( LOG( mean_d ) + &
11644	2.84_wp )*2 ) + 19.11_wp EXP( -0.482_wp * ( LOG( mean_d ) - &
11645	1.362_wp )**2 ) )
11646	!
11647	!-- Lung-deposited surface area LDSA (units mum2/cm3)
11648	temp_bin = temp_bin + pi * mean_d*2 df * 1.0E-6_wp * &
11649	aerosol_number(ib)%conc(k,j,i)
11650	ENDDO
11651	tend(k,j,i) = temp_bin
11652	ENDDO
11653	ENDDO
11654	ENDDO
11655	IF ( .NOT. mask_surface(mid) ) THEN
11656	DO i = 1, mask_size_l(mid,1)
11657	DO j = 1, mask_size_l(mid,2)
11658	DO k = 1, mask_size_l(mid,3)
11659	local_pf(i,j,k) = tend( mask_k(mid,k), mask_j(mid,j), mask_i(mid,i) )
11660	ENDDO
11661	ENDDO
11662	ENDDO
11663	ELSE
11664	DO i = 1, mask_size_l(mid,1)
11665	DO j = 1, mask_size_l(mid,2)
11666	!
11667	!-- Get k index of the highest terraing surface
11668	im = mask_i(mid,i)
11669	jm = mask_j(mid,j)
11670	ktt = MINLOC( MERGE( 1, 0, BTEST( wall_flags_total_0(:,jm,im), 5 )), &
11671	DIM = 1 ) - 1
11672	DO k = 1, mask_size_l(mid,3)
11673	kk = MIN( ktt+mask_k(mid,k), nzt+1 )
11674	!
11675	!-- Set value if not in building
11676	IF ( BTEST( wall_flags_total_0(kk,jm,im), 6 ) ) THEN
11677	local_pf(i,j,k) = fill_value
11678	ELSE
11679	local_pf(i,j,k) = tend(kk,jm,im)
11680	ENDIF
11681	ENDDO
11682	ENDDO
11683	ENDDO
11684	ENDIF
11685	resorted = .TRUE.
11686	ELSE
11687	to_be_resorted => ldsa_av
11688	ENDIF
11689
11690	CASE ( 'N_UFP' )
11691	IF ( av == 0 ) THEN
11692	DO i = nxl, nxr
11693	DO j = nys, nyn
11694	DO k = nzb, nz_do3d
11695	temp_bin = 0.0_wp
11696	DO ib = 1, nbins_aerosol
11697	IF ( 2.0_wp * ra_dry(k,j,i,ib) <= 0.1E-6_wp ) THEN
11698	temp_bin = temp_bin + aerosol_number(ib)%conc(k,j,i)
11699	ENDIF
11700	ENDDO
11701	tend(k,j,i) = temp_bin
11702	ENDDO
11703	ENDDO
11704	ENDDO
11705	IF ( .NOT. mask_surface(mid) ) THEN
11706	DO i = 1, mask_size_l(mid,1)
11707	DO j = 1, mask_size_l(mid,2)
11708	DO k = 1, mask_size_l(mid,3)
11709	local_pf(i,j,k) = tend( mask_k(mid,k), mask_j(mid,j), mask_i(mid,i) )
11710	ENDDO
11711	ENDDO
11712	ENDDO
11713	ELSE
11714	DO i = 1, mask_size_l(mid,1)
11715	DO j = 1, mask_size_l(mid,2)
11716	!
11717	!-- Get k index of the highest terraing surface
11718	im = mask_i(mid,i)
11719	jm = mask_j(mid,j)
11720	ktt = MINLOC( MERGE( 1, 0, BTEST( wall_flags_total_0(:,jm,im), 5 )), &
11721	DIM = 1 ) - 1
11722	DO k = 1, mask_size_l(mid,3)
11723	kk = MIN( ktt+mask_k(mid,k), nzt+1 )
11724	!
11725	!-- Set value if not in building
11726	IF ( BTEST( wall_flags_total_0(kk,jm,im), 6 ) ) THEN
11727	local_pf(i,j,k) = fill_value
11728	ELSE
11729	local_pf(i,j,k) = tend(kk,jm,im)
11730	ENDIF
11731	ENDDO
11732	ENDDO
11733	ENDDO
11734	ENDIF
11735	resorted = .TRUE.
11736	ELSE
11737	to_be_resorted => nufp_av
11738	ENDIF
11739
11740	CASE ( 'Ntot' )
11741	IF ( av == 0 ) THEN
11742	DO i = nxl, nxr
11743	DO j = nys, nyn
11744	DO k = nzb, nz_do3d
11745	temp_bin = 0.0_wp
11746	DO ib = 1, nbins_aerosol
11747	temp_bin = temp_bin + aerosol_number(ib)%conc(k,j,i)
11748	ENDDO
11749	tend(k,j,i) = temp_bin
11750	ENDDO
11751	ENDDO
11752	ENDDO
11753	IF ( .NOT. mask_surface(mid) ) THEN
11754	DO i = 1, mask_size_l(mid,1)
11755	DO j = 1, mask_size_l(mid,2)
11756	DO k = 1, mask_size_l(mid,3)
11757	local_pf(i,j,k) = tend( mask_k(mid,k), mask_j(mid,j), mask_i(mid,i) )
11758	ENDDO
11759	ENDDO
11760	ENDDO
11761	ELSE
11762	DO i = 1, mask_size_l(mid,1)
11763	DO j = 1, mask_size_l(mid,2)
11764	!
11765	!-- Get k index of the highest terraing surface
11766	im = mask_i(mid,i)
11767	jm = mask_j(mid,j)
11768	ktt = MINLOC( MERGE( 1, 0, BTEST( wall_flags_total_0(:,jm,im), 5 )), &
11769	DIM = 1 ) - 1
11770	DO k = 1, mask_size_l(mid,3)
11771	kk = MIN( ktt+mask_k(mid,k), nzt+1 )
11772	!
11773	!-- Set value if not in building
11774	IF ( BTEST( wall_flags_total_0(kk,jm,im), 6 ) ) THEN
11775	local_pf(i,j,k) = fill_value
11776	ELSE
11777	local_pf(i,j,k) = tend(kk,jm,im)
11778	ENDIF
11779	ENDDO
11780	ENDDO
11781	ENDDO
11782	ENDIF
11783	resorted = .TRUE.
11784	ELSE
11785	to_be_resorted => ntot_av
11786	ENDIF
11787
11788	CASE ( 'PM0.1' )
11789	IF ( av == 0 ) THEN
11790	DO i = nxl, nxr
11791	DO j = nys, nyn
11792	DO k = nzb, nz_do3d
11793	temp_bin = 0.0_wp
11794	DO ib = 1, nbins_aerosol
11795	IF ( 2.0_wp * ra_dry(k,j,i,ib) <= 0.1E-6_wp ) THEN
11796	DO ic = ib, nbins_aerosol * ncc, nbins_aerosol
11797	temp_bin = temp_bin + aerosol_mass(ic)%conc(k,j,i)
11798	ENDDO
11799	ENDIF
11800	ENDDO
11801	tend(k,j,i) = temp_bin
11802	ENDDO
11803	ENDDO
11804	ENDDO
11805	IF ( .NOT. mask_surface(mid) ) THEN
11806	DO i = 1, mask_size_l(mid,1)
11807	DO j = 1, mask_size_l(mid,2)
11808	DO k = 1, mask_size_l(mid,3)
11809	local_pf(i,j,k) = tend( mask_k(mid,k), mask_j(mid,j), mask_i(mid,i) )
11810	ENDDO
11811	ENDDO
11812	ENDDO
11813	ELSE
11814	DO i = 1, mask_size_l(mid,1)
11815	DO j = 1, mask_size_l(mid,2)
11816	!
11817	!-- Get k index of the highest terraing surface
11818	im = mask_i(mid,i)
11819	jm = mask_j(mid,j)
11820	ktt = MINLOC( MERGE( 1, 0, BTEST( wall_flags_total_0(:,jm,im), 5 )), &
11821	DIM = 1 ) - 1
11822	DO k = 1, mask_size_l(mid,3)
11823	kk = MIN( ktt+mask_k(mid,k), nzt+1 )
11824	!
11825	!-- Set value if not in building
11826	IF ( BTEST( wall_flags_total_0(kk,jm,im), 6 ) ) THEN
11827	local_pf(i,j,k) = fill_value
11828	ELSE
11829	local_pf(i,j,k) = tend(kk,jm,im)
11830	ENDIF
11831	ENDDO
11832	ENDDO
11833	ENDDO
11834	ENDIF
11835	resorted = .TRUE.
11836	ELSE
11837	to_be_resorted => pm01_av
11838	ENDIF
11839
11840	CASE ( 'PM2.5' )
11841	IF ( av == 0 ) THEN
11842	DO i = nxl, nxr
11843	DO j = nys, nyn
11844	DO k = nzb, nz_do3d
11845	temp_bin = 0.0_wp
11846	DO ib = 1, nbins_aerosol
11847	IF ( 2.0_wp * ra_dry(k,j,i,ib) <= 2.5E-6_wp ) THEN
11848	DO ic = ib, nbins_aerosol * ncc, nbins_aerosol
11849	temp_bin = temp_bin + aerosol_mass(ic)%conc(k,j,i)
11850	ENDDO
11851	ENDIF
11852	ENDDO
11853	tend(k,j,i) = temp_bin
11854	ENDDO
11855	ENDDO
11856	ENDDO
11857	IF ( .NOT. mask_surface(mid) ) THEN
11858	DO i = 1, mask_size_l(mid,1)
11859	DO j = 1, mask_size_l(mid,2)
11860	DO k = 1, mask_size_l(mid,3)
11861	local_pf(i,j,k) = tend( mask_k(mid,k), mask_j(mid,j), mask_i(mid,i) )
11862	ENDDO
11863	ENDDO
11864	ENDDO
11865	ELSE
11866	DO i = 1, mask_size_l(mid,1)
11867	DO j = 1, mask_size_l(mid,2)
11868	!
11869	!-- Get k index of the highest terraing surface
11870	im = mask_i(mid,i)
11871	jm = mask_j(mid,j)
11872	ktt = MINLOC( MERGE( 1, 0, BTEST( wall_flags_total_0(:,jm,im), 5 )), &
11873	DIM = 1 ) - 1
11874	DO k = 1, mask_size_l(mid,3)
11875	kk = MIN( ktt+mask_k(mid,k), nzt+1 )
11876	!
11877	!-- Set value if not in building
11878	IF ( BTEST( wall_flags_total_0(kk,jm,im), 6 ) ) THEN
11879	local_pf(i,j,k) = fill_value
11880	ELSE
11881	local_pf(i,j,k) = tend(kk,jm,im)
11882	ENDIF
11883	ENDDO
11884	ENDDO
11885	ENDDO
11886	ENDIF
11887	resorted = .TRUE.
11888	ELSE
11889	to_be_resorted => pm25_av
11890	ENDIF
11891
11892	CASE ( 'PM10' )
11893	IF ( av == 0 ) THEN
11894	DO i = nxl, nxr
11895	DO j = nys, nyn
11896	DO k = nzb, nz_do3d
11897	temp_bin = 0.0_wp
11898	DO ib = 1, nbins_aerosol
11899	IF ( 2.0_wp * ra_dry(k,j,i,ib) <= 10.0E-6_wp ) THEN
11900	DO ic = ib, nbins_aerosol * ncc, nbins_aerosol
11901	temp_bin = temp_bin + aerosol_mass(ic)%conc(k,j,i)
11902	ENDDO
11903	ENDIF
11904	ENDDO
11905	tend(k,j,i) = temp_bin
11906	ENDDO
11907	ENDDO
11908	ENDDO
11909	IF ( .NOT. mask_surface(mid) ) THEN
11910	DO i = 1, mask_size_l(mid,1)
11911	DO j = 1, mask_size_l(mid,2)
11912	DO k = 1, mask_size_l(mid,3)
11913	local_pf(i,j,k) = tend( mask_k(mid,k), mask_j(mid,j), mask_i(mid,i) )
11914	ENDDO
11915	ENDDO
11916	ENDDO
11917	ELSE
11918	DO i = 1, mask_size_l(mid,1)
11919	DO j = 1, mask_size_l(mid,2)
11920	!
11921	!-- Get k index of the highest terraing surface
11922	im = mask_i(mid,i)
11923	jm = mask_j(mid,j)
11924	ktt = MINLOC( MERGE( 1, 0, BTEST( wall_flags_total_0(:,jm,im), 5 )), &
11925	DIM = 1 ) - 1
11926	DO k = 1, mask_size_l(mid,3)
11927	kk = MIN( ktt+mask_k(mid,k), nzt+1 )
11928	!
11929	!-- Set value if not in building
11930	IF ( BTEST( wall_flags_total_0(kk,jm,im), 6 ) ) THEN
11931	local_pf(i,j,k) = fill_value
11932	ELSE
11933	local_pf(i,j,k) = tend(kk,jm,im)
11934	ENDIF
11935	ENDDO
11936	ENDDO
11937	ENDDO
11938	ENDIF
11939	resorted = .TRUE.
11940	ELSE
11941	to_be_resorted => pm10_av
11942	ENDIF
11943
11944	CASE ( 's_BC', 's_DU', 's_NH', 's_NO', 's_OC', 's_SO4', 's_SS' )
11945	IF ( av == 0 ) THEN
11946	IF ( is_used( prtcl, TRIM( variable(9:) ) ) ) THEN
11947	found_index = get_index( prtcl, TRIM( variable(9:) ) )
11948	DO i = nxl, nxr
11949	DO j = nys, nyn
11950	DO k = nzb, nz_do3d
11951	temp_bin = 0.0_wp
11952	DO ic = ( found_index-1 ) * nbins_aerosol + 1, found_index * nbins_aerosol
11953	temp_bin = temp_bin + aerosol_mass(ic)%conc(k,j,i)
11954	ENDDO
11955	tend(k,j,i) = temp_bin
11956	ENDDO
11957	ENDDO
11958	ENDDO
11959	ELSE
11960	tend = 0.0_wp
11961	ENDIF
11962	IF ( .NOT. mask_surface(mid) ) THEN
11963	DO i = 1, mask_size_l(mid,1)
11964	DO j = 1, mask_size_l(mid,2)
11965	DO k = 1, mask_size_l(mid,3)
11966	local_pf(i,j,k) = tend( mask_k(mid,k), mask_j(mid,j), mask_i(mid,i) )
11967	ENDDO
11968	ENDDO
11969	ENDDO
11970	ELSE
11971	DO i = 1, mask_size_l(mid,1)
11972	DO j = 1, mask_size_l(mid,2)
11973	!
11974	!-- Get k index of the highest terraing surface
11975	im = mask_i(mid,i)
11976	jm = mask_j(mid,j)
11977	ktt = MINLOC( MERGE( 1, 0, BTEST( wall_flags_total_0(:,jm,im), 5 )), &
11978	DIM = 1 ) - 1
11979	DO k = 1, mask_size_l(mid,3)
11980	kk = MIN( ktt+mask_k(mid,k), nzt+1 )
11981	!
11982	!-- Set value if not in building
11983	IF ( BTEST( wall_flags_total_0(kk,jm,im), 6 ) ) THEN
11984	local_pf(i,j,k) = fill_value
11985	ELSE
11986	local_pf(i,j,k) = tend(kk,jm,im)
11987	ENDIF
11988	ENDDO
11989	ENDDO
11990	ENDDO
11991	ENDIF
11992	resorted = .TRUE.
11993	ELSE
11994	!
11995	!-- 9: remove salsa_s_ from the beginning
11996	IF ( TRIM( variable(9:) ) == 'BC' ) to_be_resorted => s_bc_av
11997	IF ( TRIM( variable(9:) ) == 'DU' ) to_be_resorted => s_du_av
11998	IF ( TRIM( variable(9:) ) == 'NH' ) to_be_resorted => s_nh_av
11999	IF ( TRIM( variable(9:) ) == 'NO' ) to_be_resorted => s_no_av
12000	IF ( TRIM( variable(9:) ) == 'OC' ) to_be_resorted => s_oc_av
12001	IF ( TRIM( variable(9:) ) == 'SO4' ) to_be_resorted => s_so4_av
12002	IF ( TRIM( variable(9:) ) == 'SS' ) to_be_resorted => s_ss_av
12003	ENDIF
12004
12005	CASE ( 's_H2O' )
12006	IF ( av == 0 ) THEN
12007	found_index = get_index( prtcl, 'H2O' )
12008	DO i = nxl, nxr
12009	DO j = nys, nyn
12010	DO k = nzb, nz_do3d
12011	temp_bin = 0.0_wp
12012	DO ic = ( found_index-1 ) * nbins_aerosol + 1, found_index * nbins_aerosol
12013	temp_bin = temp_bin + aerosol_mass(ic)%conc(k,j,i)
12014	ENDDO
12015	tend(k,j,i) = temp_bin
12016	ENDDO
12017	ENDDO
12018	ENDDO
12019	IF ( .NOT. mask_surface(mid) ) THEN
12020	DO i = 1, mask_size_l(mid,1)
12021	DO j = 1, mask_size_l(mid,2)
12022	DO k = 1, mask_size_l(mid,3)
12023	local_pf(i,j,k) = tend( mask_k(mid,k), mask_j(mid,j), mask_i(mid,i) )
12024	ENDDO
12025	ENDDO
12026	ENDDO
12027	ELSE
12028	DO i = 1, mask_size_l(mid,1)
12029	DO j = 1, mask_size_l(mid,2)
12030	!
12031	!-- Get k index of the highest terraing surface
12032	im = mask_i(mid,i)
12033	jm = mask_j(mid,j)
12034	ktt = MINLOC( MERGE( 1, 0, BTEST( wall_flags_total_0(:,jm,im), 5 )), &
12035	DIM = 1 ) - 1
12036	DO k = 1, mask_size_l(mid,3)
12037	kk = MIN( ktt+mask_k(mid,k), nzt+1 )
12038	!
12039	!-- Set value if not in building
12040	IF ( BTEST( wall_flags_total_0(kk,jm,im), 6 ) ) THEN
12041	local_pf(i,j,k) = fill_value
12042	ELSE
12043	local_pf(i,j,k) = tend(kk,jm,im)
12044	ENDIF
12045	ENDDO
12046	ENDDO
12047	ENDDO
12048	ENDIF
12049	resorted = .TRUE.
12050	ELSE
12051	to_be_resorted => s_h2o_av
12052	ENDIF
12053
12054	CASE DEFAULT
12055	found = .FALSE.
12056
12057	END SELECT
12058	ENDIF
12059
12060	IF ( found .AND. .NOT. resorted ) THEN
12061	IF ( .NOT. mask_surface(mid) ) THEN
12062	!
12063	!-- Default masked output
12064	DO i = 1, mask_size_l(mid,1)
12065	DO j = 1, mask_size_l(mid,2)
12066	DO k = 1, mask_size_l(mid,3)
12067	local_pf(i,j,k) = to_be_resorted( mask_k(mid,k), mask_j(mid,j), mask_i(mid,i) )
12068	ENDDO
12069	ENDDO
12070	ENDDO
12071	ELSE
12072	!
12073	!-- Terrain-following masked output
12074	DO i = 1, mask_size_l(mid,1)
12075	DO j = 1, mask_size_l(mid,2)
12076	!-- Get k index of the highest terraing surface
12077	im = mask_i(mid,i)
12078	jm = mask_j(mid,j)
12079	ktt = MINLOC( MERGE( 1, 0, BTEST( wall_flags_total_0(:,jm,im), 5 )), &
12080	DIM = 1 ) - 1
12081	DO k = 1, mask_size_l(mid,3)
12082	kk = MIN( ktt+mask_k(mid,k), nzt+1 )
12083	!-- Set value if not in building
12084	IF ( BTEST( wall_flags_total_0(kk,jm,im), 6 ) ) THEN
12085	local_pf(i,j,k) = fill_value
12086	ELSE
12087	local_pf(i,j,k) = to_be_resorted(kk,jm,im)
12088	ENDIF
12089	ENDDO
12090	ENDDO
12091	ENDDO
12092	ENDIF
12093	ENDIF
12094
12095	END SUBROUTINE salsa_data_output_mask
12096
12097	!------------------------------------------------------------------------------!
12098	! Description:
12099	! ------------
12100	!> Creates index tables for different (aerosol) components
12101	!------------------------------------------------------------------------------!
12102	SUBROUTINE component_index_constructor( self, ncomp, nlist, listcomp )
12103
12104	IMPLICIT NONE
12105
12106	INTEGER(iwp) :: ii !<
12107	INTEGER(iwp) :: jj !<
12108
12109	INTEGER(iwp), INTENT(in) :: nlist ! < Maximum number of components
12110
12111	INTEGER(iwp), INTENT(inout) :: ncomp !< Number of components
12112
12113	CHARACTER(LEN=3), INTENT(in) :: listcomp(nlist) !< List cof component names
12114
12115	TYPE(component_index), INTENT(inout) :: self !< Object containing the indices of different
12116	!< aerosol components
12117
12118	ncomp = 0
12119
12120	DO WHILE ( listcomp(ncomp+1) /= ' ' .AND. ncomp < nlist )
12121	ncomp = ncomp + 1
12122	ENDDO
12123
12124	self%ncomp = ncomp
12125	ALLOCATE( self%ind(ncomp), self%comp(ncomp) )
12126
12127	DO ii = 1, ncomp
12128	self%ind(ii) = ii
12129	ENDDO
12130
12131	jj = 1
12132	DO ii = 1, nlist
12133	IF ( listcomp(ii) == '') CYCLE
12134	self%comp(jj) = listcomp(ii)
12135	jj = jj + 1
12136	ENDDO
12137
12138	END SUBROUTINE component_index_constructor
12139
12140	!------------------------------------------------------------------------------!
12141	! Description:
12142	! ------------
12143	!> Gives the index of a component in the component list
12144	!------------------------------------------------------------------------------!
12145	INTEGER FUNCTION get_index( self, incomp )
12146
12147	IMPLICIT NONE
12148
12149	CHARACTER(LEN=*), INTENT(in) :: incomp !< Component name
12150
12151	INTEGER(iwp) :: ii !< index
12152
12153	TYPE(component_index), INTENT(in) :: self !< Object containing the indices of different
12154	!< aerosol components
12155	IF ( ANY( self%comp == incomp ) ) THEN
12156	ii = 1
12157	DO WHILE ( (self%comp(ii) /= incomp) )
12158	ii = ii + 1
12159	ENDDO
12160	get_index = ii
12161	ELSEIF ( incomp == 'H2O' ) THEN
12162	get_index = self%ncomp + 1
12163	ELSE
12164	WRITE( message_string, * ) 'Incorrect component name given!'
12165	CALL message( 'get_index', 'PA0591', 1, 2, 0, 6, 0 )
12166	ENDIF
12167
12168	END FUNCTION get_index
12169
12170	!------------------------------------------------------------------------------!
12171	! Description:
12172	! ------------
12173	!> Tells if the (aerosol) component is being used in the simulation
12174	!------------------------------------------------------------------------------!
12175	LOGICAL FUNCTION is_used( self, icomp )
12176
12177	IMPLICIT NONE
12178
12179	CHARACTER(LEN=*), INTENT(in) :: icomp !< Component name
12180
12181	TYPE(component_index), INTENT(in) :: self !< Object containing the indices of different
12182	!< aerosol components
12183
12184	IF ( ANY(self%comp == icomp) ) THEN
12185	is_used = .TRUE.
12186	ELSE
12187	is_used = .FALSE.
12188	ENDIF
12189
12190	END FUNCTION
12191
12192	!------------------------------------------------------------------------------!
12193	! Description:
12194	! ------------
12195	!> Set the lateral and top boundary conditions in case the PALM domain is
12196	!> nested offline in a mesoscale model. Further, average boundary data and
12197	!> determine mean profiles, further used for correct damping in the sponge
12198	!> layer.
12199	!------------------------------------------------------------------------------!
12200	SUBROUTINE salsa_nesting_offl_bc
12201
12202	USE control_parameters, &
12203	ONLY: bc_dirichlet_l, bc_dirichlet_n, bc_dirichlet_r, bc_dirichlet_s, dt_3d, &
12204	time_since_reference_point
12205
12206	USE indices, &
12207	ONLY: nbgp, nxl, nxr, nyn, nys, nzb, nzt
12208
12209	IMPLICIT NONE
12210
12211	INTEGER(iwp) :: i !< running index x-direction
12212	INTEGER(iwp) :: ib !< running index for aerosol number bins
12213	INTEGER(iwp) :: ic !< running index for aerosol mass bins
12214	INTEGER(iwp) :: icc !< running index for aerosol mass bins
12215	INTEGER(iwp) :: ig !< running index for gaseous species
12216	INTEGER(iwp) :: j !< running index y-direction
12217	INTEGER(iwp) :: k !< running index z-direction
12218
12219	REAL(wp) :: fac_dt !< interpolation factor
12220
12221	REAL(wp), DIMENSION(:,:), ALLOCATABLE :: ref_mconc !< reference profile for aerosol mass
12222	REAL(wp), DIMENSION(:,:), ALLOCATABLE :: ref_mconc_l !< reference profile for aerosol mass: subdomain
12223	REAL(wp), DIMENSION(:,:), ALLOCATABLE :: ref_nconc !< reference profile for aerosol number
12224	REAL(wp), DIMENSION(:,:), ALLOCATABLE :: ref_nconc_l !< reference profile for aerosol_number: subdomain
12225	REAL(wp), DIMENSION(:,:), ALLOCATABLE :: ref_gconc !< reference profile for gases
12226	REAL(wp), DIMENSION(:,:), ALLOCATABLE :: ref_gconc_l !< reference profile for gases: subdomain
12227
12228	!
12229	!-- Skip input if no forcing from larger-scale models is applied.
12230	IF ( .NOT. nesting_offline_salsa ) RETURN
12231	!
12232	!-- Allocate temporary arrays to compute salsa mean profiles
12233	ALLOCATE( ref_gconc(nzb:nzt+1,1:ngases_salsa), ref_gconc_l(nzb:nzt+1,1:ngases_salsa), &
12234	ref_mconc(nzb:nzt+1,1:nbins_aerosol*ncomponents_mass), &
12235	ref_mconc_l(nzb:nzt+1,1:nbins_aerosol*ncomponents_mass), &
12236	ref_nconc(nzb:nzt+1,1:nbins_aerosol), ref_nconc_l(nzb:nzt+1,1:nbins_aerosol) )
12237	ref_gconc = 0.0_wp
12238	ref_gconc_l = 0.0_wp
12239	ref_mconc = 0.0_wp
12240	ref_mconc_l = 0.0_wp
12241	ref_nconc = 0.0_wp
12242	ref_nconc_l = 0.0_wp
12243
12244	!
12245	!-- Determine interpolation factor and limit it to 1. This is because t+dt can slightly exceed
12246	!-- time(tind_p) before boundary data is updated again.
12247	fac_dt = ( time_utc_init + time_since_reference_point - &
12248	salsa_nest_offl%time(salsa_nest_offl%tind) + dt_3d ) / &
12249	( salsa_nest_offl%time(salsa_nest_offl%tind_p) - &
12250	salsa_nest_offl%time(salsa_nest_offl%tind) )
12251	fac_dt = MIN( 1.0_wp, fac_dt )
12252
12253	IF ( bc_dirichlet_l ) THEN
12254	DO ib = 1, nbins_aerosol
12255	DO j = nys, nyn
12256	DO k = nzb+1, nzt
12257	aerosol_number(ib)%conc(k,j,-1) = ( 1.0_wp - fac_dt ) * &
12258	salsa_nest_offl%nconc_left(0,k,j,ib) + fac_dt * &
12259	salsa_nest_offl%nconc_left(1,k,j,ib)
12260	ENDDO
12261	ref_nconc_l(nzb+1:nzt,ib) = ref_nconc_l(nzb+1:nzt,ib) + &
12262	aerosol_number(ib)%conc(nzb+1:nzt,j,-1)
12263	ENDDO
12264	DO ic = 1, ncomponents_mass
12265	icc = ( ic-1 ) * nbins_aerosol + ib
12266	DO j = nys, nyn
12267	DO k = nzb+1, nzt
12268	aerosol_mass(icc)%conc(k,j,-1) = ( 1.0_wp - fac_dt ) * &
12269	salsa_nest_offl%mconc_left(0,k,j,icc) + fac_dt &
12270	* salsa_nest_offl%mconc_left(1,k,j,icc)
12271	ENDDO
12272	ref_mconc_l(nzb+1:nzt,icc) = ref_mconc_l(nzb+1:nzt,icc) + &
12273	aerosol_mass(icc)%conc(nzb+1:nzt,j,-1)
12274	ENDDO
12275	ENDDO
12276	ENDDO
12277	IF ( .NOT. salsa_gases_from_chem ) THEN
12278	DO ig = 1, ngases_salsa
12279	DO j = nys, nyn
12280	DO k = nzb+1, nzt
12281	salsa_gas(ig)%conc(k,j,-1) = ( 1.0_wp - fac_dt ) * &
12282	salsa_nest_offl%gconc_left(0,k,j,ig) + fac_dt * &
12283	salsa_nest_offl%gconc_left(1,k,j,ig)
12284	ENDDO
12285	ref_gconc_l(nzb+1:nzt,ig) = ref_gconc_l(nzb+1:nzt,ig) + &
12286	salsa_gas(ig)%conc(nzb+1:nzt,j,-1)
12287	ENDDO
12288	ENDDO
12289	ENDIF
12290	ENDIF
12291
12292	IF ( bc_dirichlet_r ) THEN
12293	DO ib = 1, nbins_aerosol
12294	DO j = nys, nyn
12295	DO k = nzb+1, nzt
12296	aerosol_number(ib)%conc(k,j,nxr+1) = ( 1.0_wp - fac_dt ) * &
12297	salsa_nest_offl%nconc_right(0,k,j,ib) + fac_dt * &
12298	salsa_nest_offl%nconc_right(1,k,j,ib)
12299	ENDDO
12300	ref_nconc_l(nzb+1:nzt,ib) = ref_nconc_l(nzb+1:nzt,ib) + &
12301	aerosol_number(ib)%conc(nzb+1:nzt,j,nxr+1)
12302	ENDDO
12303	DO ic = 1, ncomponents_mass
12304	icc = ( ic-1 ) * nbins_aerosol + ib
12305	DO j = nys, nyn
12306	DO k = nzb+1, nzt
12307	aerosol_mass(icc)%conc(k,j,nxr+1) = ( 1.0_wp - fac_dt ) * &
12308	salsa_nest_offl%mconc_right(0,k,j,icc) + fac_dt&
12309	* salsa_nest_offl%mconc_right(1,k,j,icc)
12310	ENDDO
12311	ref_mconc_l(nzb+1:nzt,icc) = ref_mconc_l(nzb+1:nzt,icc) + &
12312	aerosol_mass(icc)%conc(nzb+1:nzt,j,nxr+1)
12313	ENDDO
12314	ENDDO
12315	ENDDO
12316	IF ( .NOT. salsa_gases_from_chem ) THEN
12317	DO ig = 1, ngases_salsa
12318	DO j = nys, nyn
12319	DO k = nzb+1, nzt
12320	salsa_gas(ig)%conc(k,j,nxr+1) = ( 1.0_wp - fac_dt ) * &
12321	salsa_nest_offl%gconc_right(0,k,j,ig) + fac_dt *&
12322	salsa_nest_offl%gconc_right(1,k,j,ig)
12323	ENDDO
12324	ref_gconc_l(nzb+1:nzt,ig) = ref_gconc_l(nzb+1:nzt,ig) + &
12325	salsa_gas(ig)%conc(nzb+1:nzt,j,nxr+1)
12326	ENDDO
12327	ENDDO
12328	ENDIF
12329	ENDIF
12330
12331	IF ( bc_dirichlet_n ) THEN
12332	DO ib = 1, nbins_aerosol
12333	DO i = nxl, nxr
12334	DO k = nzb+1, nzt
12335	aerosol_number(ib)%conc(k,nyn+1,i) = ( 1.0_wp - fac_dt ) * &
12336	salsa_nest_offl%nconc_north(0,k,i,ib) + fac_dt * &
12337	salsa_nest_offl%nconc_north(1,k,i,ib)
12338	ENDDO
12339	ref_nconc_l(nzb+1:nzt,ib) = ref_nconc_l(nzb+1:nzt,ib) + &
12340	aerosol_number(ib)%conc(nzb+1:nzt,nyn+1,i)
12341	ENDDO
12342	DO ic = 1, ncomponents_mass
12343	icc = ( ic-1 ) * nbins_aerosol + ib
12344	DO i = nxl, nxr
12345	DO k = nzb+1, nzt
12346	aerosol_mass(icc)%conc(k,nyn+1,i) = ( 1.0_wp - fac_dt ) * &
12347	salsa_nest_offl%mconc_north(0,k,i,icc) + fac_dt&
12348	* salsa_nest_offl%mconc_north(1,k,i,icc)
12349	ENDDO
12350	ref_mconc_l(nzb+1:nzt,icc) = ref_mconc_l(nzb+1:nzt,icc) + &
12351	aerosol_mass(icc)%conc(nzb+1:nzt,nyn+1,i)
12352	ENDDO
12353	ENDDO
12354	ENDDO
12355	IF ( .NOT. salsa_gases_from_chem ) THEN
12356	DO ig = 1, ngases_salsa
12357	DO i = nxl, nxr
12358	DO k = nzb+1, nzt
12359	salsa_gas(ig)%conc(k,nyn+1,i) = ( 1.0_wp - fac_dt ) * &
12360	salsa_nest_offl%gconc_north(0,k,i,ig) + fac_dt *&
12361	salsa_nest_offl%gconc_north(1,k,i,ig)
12362	ENDDO
12363	ref_gconc_l(nzb+1:nzt,ig) = ref_gconc_l(nzb+1:nzt,ig) + &
12364	salsa_gas(ig)%conc(nzb+1:nzt,nyn+1,i)
12365	ENDDO
12366	ENDDO
12367	ENDIF
12368	ENDIF
12369
12370	IF ( bc_dirichlet_s ) THEN
12371	DO ib = 1, nbins_aerosol
12372	DO i = nxl, nxr
12373	DO k = nzb+1, nzt
12374	aerosol_number(ib)%conc(k,-1,i) = ( 1.0_wp - fac_dt ) * &
12375	salsa_nest_offl%nconc_south(0,k,i,ib) + fac_dt * &
12376	salsa_nest_offl%nconc_south(1,k,i,ib)
12377	ENDDO
12378	ref_nconc_l(nzb+1:nzt,ib) = ref_nconc_l(nzb+1:nzt,ib) + &
12379	aerosol_number(ib)%conc(nzb+1:nzt,-1,i)
12380	ENDDO
12381	DO ic = 1, ncomponents_mass
12382	icc = ( ic-1 ) * nbins_aerosol + ib
12383	DO i = nxl, nxr
12384	DO k = nzb+1, nzt
12385	aerosol_mass(icc)%conc(k,-1,i) = ( 1.0_wp - fac_dt ) * &
12386	salsa_nest_offl%mconc_south(0,k,i,icc) + fac_dt&
12387	* salsa_nest_offl%mconc_south(1,k,i,icc)
12388	ENDDO
12389	ref_mconc_l(nzb+1:nzt,icc) = ref_mconc_l(nzb+1:nzt,icc) + &
12390	aerosol_mass(icc)%conc(nzb+1:nzt,-1,i)
12391	ENDDO
12392	ENDDO
12393	ENDDO
12394	IF ( .NOT. salsa_gases_from_chem ) THEN
12395	DO ig = 1, ngases_salsa
12396	DO i = nxl, nxr
12397	DO k = nzb+1, nzt
12398	salsa_gas(ig)%conc(k,-1,i) = ( 1.0_wp - fac_dt ) * &
12399	salsa_nest_offl%gconc_south(0,k,i,ig) + fac_dt * &
12400	salsa_nest_offl%gconc_south(1,k,i,ig)
12401	ENDDO
12402	ref_gconc_l(nzb+1:nzt,ig) = ref_gconc_l(nzb+1:nzt,ig) + &
12403	salsa_gas(ig)%conc(nzb+1:nzt,-1,i)
12404	ENDDO
12405	ENDDO
12406	ENDIF
12407	ENDIF
12408	!
12409	!-- Top boundary
12410	DO ib = 1, nbins_aerosol
12411	DO i = nxl, nxr
12412	DO j = nys, nyn
12413	aerosol_number(ib)%conc(nzt+1,j,i) = ( 1.0_wp - fac_dt ) * &
12414	salsa_nest_offl%nconc_top(0,j,i,ib) + fac_dt * &
12415	salsa_nest_offl%nconc_top(1,j,i,ib)
12416	ref_nconc_l(nzt+1,ib) = ref_nconc_l(nzt+1,ib) + aerosol_number(ib)%conc(nzt+1,j,i)
12417	ENDDO
12418	ENDDO
12419	DO ic = 1, ncomponents_mass
12420	icc = ( ic-1 ) * nbins_aerosol + ib
12421	DO i = nxl, nxr
12422	DO j = nys, nyn
12423	aerosol_mass(icc)%conc(nzt+1,j,i) = ( 1.0_wp - fac_dt ) * &
12424	salsa_nest_offl%mconc_top(0,j,i,icc) + fac_dt *&
12425	salsa_nest_offl%mconc_top(1,j,i,icc)
12426	ref_mconc_l(nzt+1,icc) = ref_mconc_l(nzt+1,icc) + aerosol_mass(icc)%conc(nzt+1,j,i)
12427	ENDDO
12428	ENDDO
12429	ENDDO
12430	ENDDO
12431	IF ( .NOT. salsa_gases_from_chem ) THEN
12432	DO ig = 1, ngases_salsa
12433	DO i = nxl, nxr
12434	DO j = nys, nyn
12435	salsa_gas(ig)%conc(nzt+1,j,i) = ( 1.0_wp - fac_dt ) * &
12436	salsa_nest_offl%gconc_top(0,j,i,ig) + fac_dt * &
12437	salsa_nest_offl%gconc_top(1,j,i,ig)
12438	ref_gconc_l(nzt+1,ig) = ref_gconc_l(nzt+1,ig) + salsa_gas(ig)%conc(nzt+1,j,i)
12439	ENDDO
12440	ENDDO
12441	ENDDO
12442	ENDIF
12443	!
12444	!-- Do local exchange
12445	DO ib = 1, nbins_aerosol
12446	CALL exchange_horiz( aerosol_number(ib)%conc, nbgp )
12447	DO ic = 1, ncomponents_mass
12448	icc = ( ic-1 ) * nbins_aerosol + ib
12449	CALL exchange_horiz( aerosol_mass(icc)%conc, nbgp )
12450	ENDDO
12451	ENDDO
12452	IF ( .NOT. salsa_gases_from_chem ) THEN
12453	DO ig = 1, ngases_salsa
12454	CALL exchange_horiz( salsa_gas(ig)%conc, nbgp )
12455	ENDDO
12456	ENDIF
12457	!
12458	!-- In case of Rayleigh damping, where the initial profiles are still used, update these profiles
12459	!-- from the averaged boundary data. But first, average these data.
12460	#if defined( __parallel )
12461	IF ( .NOT. salsa_gases_from_chem ) &
12462	CALL MPI_ALLREDUCE( ref_gconc_l, ref_gconc, ( nzt+1-nzb+1 ) * SIZE( ref_gconc(nzb,:) ), &
12463	MPI_REAL, MPI_SUM, comm2d, ierr )
12464	CALL MPI_ALLREDUCE( ref_mconc_l, ref_mconc, ( nzt+1-nzb+1 ) * SIZE( ref_mconc(nzb,:) ), &
12465	MPI_REAL, MPI_SUM, comm2d, ierr )
12466	CALL MPI_ALLREDUCE( ref_nconc_l, ref_nconc, ( nzt+1-nzb+1 ) * SIZE( ref_nconc(nzb,:) ), &
12467	MPI_REAL, MPI_SUM, comm2d, ierr )
12468	#else
12469	IF ( .NOT. salsa_gases_from_chem ) ref_gconc = ref_gconc_l
12470	ref_mconc = ref_mconc_l
12471	ref_nconc = ref_nconc_l
12472	#endif
12473	!
12474	!-- Average data. Note, reference profiles up to nzt are derived from lateral boundaries, at the
12475	!-- model top it is derived from the top boundary. Thus, number of input data is different from
12476	!-- nzb:nzt compared to nzt+1.
12477	!-- Derived from lateral boundaries.
12478	IF ( .NOT. salsa_gases_from_chem ) &
12479	ref_gconc(nzb:nzt,:) = ref_gconc(nzb:nzt,:) / REAL( 2.0_wp * ( ny + 1 + nx + 1 ), KIND = wp )
12480	ref_mconc(nzb:nzt,:) = ref_mconc(nzb:nzt,:) / REAL( 2.0_wp * ( ny + 1 + nx + 1 ), KIND = wp )
12481	ref_nconc(nzb:nzt,:) = ref_nconc(nzb:nzt,:) / REAL( 2.0_wp * ( ny + 1 + nx + 1 ), KIND = wp )
12482	!
12483	!-- Derived from top boundary
12484	IF ( .NOT. salsa_gases_from_chem ) &
12485	ref_gconc(nzt+1,:) = ref_gconc(nzt+1,:) / REAL( ( ny + 1 ) * ( nx + 1 ), KIND = wp )
12486	ref_mconc(nzt+1,:) = ref_mconc(nzt+1,:) / REAL( ( ny + 1 ) * ( nx + 1 ), KIND = wp )
12487	ref_nconc(nzt+1,:) = ref_nconc(nzt+1,:) / REAL( ( ny + 1 ) * ( nx + 1 ), KIND = wp )
12488	!
12489	!-- Write onto init profiles, which are used for damping. Also set lower boundary condition.
12490	DO ib = 1, nbins_aerosol
12491	aerosol_number(ib)%init(:) = ref_nconc(:,ib)
12492	aerosol_number(ib)%init(nzb) = aerosol_number(ib)%init(nzb+1)
12493	DO ic = 1, ncomponents_mass
12494	icc = ( ic-1 ) * nbins_aerosol + ib
12495	aerosol_mass(icc)%init(:) = ref_mconc(:,icc)
12496	aerosol_mass(icc)%init(nzb) = aerosol_mass(icc)%init(nzb+1)
12497	ENDDO
12498	ENDDO
12499	IF ( .NOT. salsa_gases_from_chem ) THEN
12500	DO ig = 1, ngases_salsa
12501	salsa_gas(ig)%init(:) = ref_gconc(:,ig)
12502	salsa_gas(ig)%init(nzb) = salsa_gas(ig)%init(nzb+1)
12503	ENDDO
12504	ENDIF
12505
12506	DEALLOCATE( ref_gconc, ref_gconc_l, ref_mconc, ref_mconc_l, ref_nconc, ref_nconc_l )
12507
12508	END SUBROUTINE salsa_nesting_offl_bc
12509
12510	!------------------------------------------------------------------------------!
12511	! Description:
12512	! ------------
12513	!> Allocate arrays used to read boundary data from NetCDF file and initialize
12514	!> boundary data.
12515	!------------------------------------------------------------------------------!
12516	SUBROUTINE salsa_nesting_offl_init
12517
12518	USE control_parameters, &
12519	ONLY: end_time, initializing_actions, spinup_time
12520
12521	USE palm_date_time_mod, &
12522	ONLY: get_date_time
12523
12524	IMPLICIT NONE
12525
12526	INTEGER(iwp) :: ib !< running index for aerosol number bins
12527	INTEGER(iwp) :: ic !< running index for aerosol mass bins
12528	INTEGER(iwp) :: icc !< additional running index for aerosol mass bins
12529	INTEGER(iwp) :: ig !< running index for gaseous species
12530	INTEGER(iwp) :: nmass_bins !< number of aerosol mass bins
12531
12532	nmass_bins = nbins_aerosol * ncomponents_mass
12533	!
12534	!-- Get time_utc_init from origin_date_time
12535	CALL get_date_time( 0.0_wp, second_of_day = time_utc_init )
12536	!
12537	!-- Allocate arrays for reading boundary values. Arrays will incorporate 2 time levels in order to
12538	!-- interpolate in between.
12539	IF ( nesting_offline_salsa ) THEN
12540	IF ( bc_dirichlet_l ) THEN
12541	ALLOCATE( salsa_nest_offl%nconc_left(0:1,nzb+1:nzt,nys:nyn,1:nbins_aerosol) )
12542	ALLOCATE( salsa_nest_offl%mconc_left(0:1,nzb+1:nzt,nys:nyn,1:nmass_bins) )
12543	ENDIF
12544	IF ( bc_dirichlet_r ) THEN
12545	ALLOCATE( salsa_nest_offl%nconc_right(0:1,nzb+1:nzt,nys:nyn,1:nbins_aerosol) )
12546	ALLOCATE( salsa_nest_offl%mconc_right(0:1,nzb+1:nzt,nys:nyn,1:nmass_bins) )
12547	ENDIF
12548	IF ( bc_dirichlet_n ) THEN
12549	ALLOCATE( salsa_nest_offl%nconc_north(0:1,nzb+1:nzt,nxl:nxr,1:nbins_aerosol) )
12550	ALLOCATE( salsa_nest_offl%mconc_north(0:1,nzb+1:nzt,nxl:nxr,1:nmass_bins) )
12551	ENDIF
12552	IF ( bc_dirichlet_s ) THEN
12553	ALLOCATE( salsa_nest_offl%nconc_south(0:1,nzb+1:nzt,nxl:nxr,1:nbins_aerosol) )
12554	ALLOCATE( salsa_nest_offl%mconc_south(0:1,nzb+1:nzt,nxl:nxr,1:nmass_bins) )
12555	ENDIF
12556	ALLOCATE( salsa_nest_offl%nconc_top(0:1,nys:nyn,nxl:nxr,1:nbins_aerosol) )
12557	ALLOCATE( salsa_nest_offl%mconc_top(0:1,nys:nyn,nxl:nxr,1:nmass_bins) )
12558
12559	IF ( .NOT. salsa_gases_from_chem ) THEN
12560	IF ( bc_dirichlet_l ) THEN
12561	ALLOCATE( salsa_nest_offl%gconc_left(0:1,nzb+1:nzt,nys:nyn,1:ngases_salsa) )
12562	ENDIF
12563	IF ( bc_dirichlet_r ) THEN
12564	ALLOCATE( salsa_nest_offl%gconc_right(0:1,nzb+1:nzt,nys:nyn,1:ngases_salsa) )
12565	ENDIF
12566	IF ( bc_dirichlet_n ) THEN
12567	ALLOCATE( salsa_nest_offl%gconc_north(0:1,nzb+1:nzt,nxl:nxr,1:ngases_salsa) )
12568	ENDIF
12569	IF ( bc_dirichlet_s ) THEN
12570	ALLOCATE( salsa_nest_offl%gconc_south(0:1,nzb+1:nzt,nxl:nxr,1:ngases_salsa) )
12571	ENDIF
12572	ALLOCATE( salsa_nest_offl%gconc_top(0:1,nys:nyn,nxl:nxr,1:ngases_salsa) )
12573	ENDIF
12574
12575	!
12576	!-- Read data at lateral and top boundaries from a larger-scale model
12577	CALL salsa_nesting_offl_input
12578	!
12579	!-- Check if sufficient time steps are provided to cover the entire simulation. Note, dynamic
12580	!-- input is only required for the 3D simulation, not for the soil/wall spinup. However, as the
12581	!-- spinup time is added to the end_time, this must be considered here.
12582	IF ( end_time - spinup_time > &
12583	salsa_nest_offl%time(salsa_nest_offl%nt-1) - time_utc_init ) THEN
12584	message_string = 'end_time of the simulation exceeds the time dimension in the dynamic'//&
12585	' input file.'
12586	CALL message( 'salsa_nesting_offl_init', 'PA0690', 1, 2, 0, 6, 0 )
12587	ENDIF
12588
12589	IF ( salsa_nest_offl%time(0) /= time_utc_init ) THEN
12590	message_string = 'Offline nesting: time dimension must start at time_utc_init.'
12591	CALL message( 'salsa_nesting_offl_init', 'PA0691', 1, 2, 0, 6, 0 )
12592	ENDIF
12593	!
12594	!-- Initialize boundary data. Please note, do not initialize boundaries in case of restart runs.
12595	IF ( TRIM( initializing_actions ) /= 'read_restart_data' .AND. read_restart_data_salsa ) &
12596	THEN
12597	IF ( bc_dirichlet_l ) THEN
12598	DO ib = 1, nbins_aerosol
12599	aerosol_number(ib)%conc(nzb+1:nzt,nys:nyn,-1) = &
12600	salsa_nest_offl%nconc_left(0,nzb+1:nzt,nys:nyn,ib)
12601	DO ic = 1, ncomponents_mass
12602	icc = ( ic - 1 ) * nbins_aerosol + ib
12603	aerosol_mass(icc)%conc(nzb+1:nzt,nys:nyn,-1) = &
12604	salsa_nest_offl%mconc_left(0,nzb+1:nzt,nys:nyn,icc)
12605	ENDDO
12606	ENDDO
12607	DO ig = 1, ngases_salsa
12608	salsa_gas(ig)%conc(nzb+1:nzt,nys:nyn,-1) = &
12609	salsa_nest_offl%gconc_left(0,nzb+1:nzt,nys:nyn,ig)
12610	ENDDO
12611	ENDIF
12612	IF ( bc_dirichlet_r ) THEN
12613	DO ib = 1, nbins_aerosol
12614	aerosol_number(ib)%conc(nzb+1:nzt,nys:nyn,nxr+1) = &
12615	salsa_nest_offl%nconc_right(0,nzb+1:nzt,nys:nyn,ib)
12616	DO ic = 1, ncomponents_mass
12617	icc = ( ic - 1 ) * nbins_aerosol + ib
12618	aerosol_mass(icc)%conc(nzb+1:nzt,nys:nyn,nxr+1) = &
12619	salsa_nest_offl%mconc_right(0,nzb+1:nzt,nys:nyn,icc)
12620	ENDDO
12621	ENDDO
12622	DO ig = 1, ngases_salsa
12623	salsa_gas(ig)%conc(nzb+1:nzt,nys:nyn,nxr+1) = &
12624	salsa_nest_offl%gconc_right(0,nzb+1:nzt,nys:nyn,ig)
12625	ENDDO
12626	ENDIF
12627	IF ( bc_dirichlet_n ) THEN
12628	DO ib = 1, nbins_aerosol
12629	aerosol_number(ib)%conc(nzb+1:nzt,nyn+1,nxl:nxr) = &
12630	salsa_nest_offl%nconc_north(0,nzb+1:nzt,nxl:nxr,ib)
12631	DO ic = 1, ncomponents_mass
12632	icc = ( ic - 1 ) * nbins_aerosol + ib
12633	aerosol_mass(icc)%conc(nzb+1:nzt,nyn+1,nxl:nxr) = &
12634	salsa_nest_offl%mconc_north(0,nzb+1:nzt,nxl:nxr,icc)
12635	ENDDO
12636	ENDDO
12637	DO ig = 1, ngases_salsa
12638	salsa_gas(ig)%conc(nzb+1:nzt,nyn+1,nxl:nxr) = &
12639	salsa_nest_offl%gconc_north(0,nzb+1:nzt,nxl:nxr,ig)
12640	ENDDO
12641	ENDIF
12642	IF ( bc_dirichlet_s ) THEN
12643	DO ib = 1, nbins_aerosol
12644	aerosol_number(ib)%conc(nzb+1:nzt,-1,nxl:nxr) = &
12645	salsa_nest_offl%nconc_south(0,nzb+1:nzt,nxl:nxr,ib)
12646	DO ic = 1, ncomponents_mass
12647	icc = ( ic - 1 ) * nbins_aerosol + ib
12648	aerosol_mass(icc)%conc(nzb+1:nzt,-1,nxl:nxr) = &
12649	salsa_nest_offl%mconc_south(0,nzb+1:nzt,nxl:nxr,icc)
12650	ENDDO
12651	ENDDO
12652	DO ig = 1, ngases_salsa
12653	salsa_gas(ig)%conc(nzb+1:nzt,-1,nxl:nxr) = &
12654	salsa_nest_offl%gconc_south(0,nzb+1:nzt,nxl:nxr,ig)
12655	ENDDO
12656	ENDIF
12657	ENDIF
12658	ENDIF
12659
12660	END SUBROUTINE salsa_nesting_offl_init
12661
12662	!------------------------------------------------------------------------------!
12663	! Description:
12664	! ------------
12665	!> Set the lateral and top boundary conditions in case the PALM domain is
12666	!> nested offline in a mesoscale model. Further, average boundary data and
12667	!> determine mean profiles, further used for correct damping in the sponge
12668	!> layer.
12669	!------------------------------------------------------------------------------!
12670	SUBROUTINE salsa_nesting_offl_input
12671
12672	USE netcdf_data_input_mod, &
12673	ONLY: check_existence, close_input_file, get_attribute, get_variable, &
12674	inquire_num_variables, inquire_variable_names, &
12675	get_dimension_length, open_read_file
12676
12677	IMPLICIT NONE
12678
12679	CHARACTER(LEN=25) :: vname !< variable name
12680
12681	INTEGER(iwp) :: ic !< running index for aerosol chemical components
12682	INTEGER(iwp) :: ig !< running index for gases
12683	INTEGER(iwp) :: num_vars !< number of variables in netcdf input file
12684
12685	!
12686	!-- Skip input if no forcing from larger-scale models is applied.
12687	IF ( .NOT. nesting_offline_salsa ) RETURN
12688	!
12689	!-- Initialise
12690	IF ( .NOT. salsa_nest_offl%init ) THEN
12691
12692	#if defined ( __netcdf )
12693	!
12694	!-- Open file in read-only mode
12695	CALL open_read_file( TRIM( input_file_dynamic ) // TRIM( coupling_char ), &
12696	salsa_nest_offl%id_dynamic )
12697	!
12698	!-- At first, inquire all variable names.
12699	CALL inquire_num_variables( salsa_nest_offl%id_dynamic, num_vars )
12700	!
12701	!-- Allocate memory to store variable names.
12702	ALLOCATE( salsa_nest_offl%var_names(1:num_vars) )
12703	CALL inquire_variable_names( salsa_nest_offl%id_dynamic, salsa_nest_offl%var_names )
12704	!
12705	!-- Read time dimension, allocate memory and finally read time array
12706	CALL get_dimension_length( salsa_nest_offl%id_dynamic, salsa_nest_offl%nt,&
12707	'time' )
12708
12709	IF ( check_existence( salsa_nest_offl%var_names, 'time' ) ) THEN
12710	ALLOCATE( salsa_nest_offl%time(0:salsa_nest_offl%nt-1) )
12711	CALL get_variable( salsa_nest_offl%id_dynamic, 'time', salsa_nest_offl%time )
12712	ENDIF
12713	!
12714	!-- Read the vertical dimension
12715	CALL get_dimension_length( salsa_nest_offl%id_dynamic, salsa_nest_offl%nzu, 'z' )
12716	ALLOCATE( salsa_nest_offl%zu_atmos(1:salsa_nest_offl%nzu) )
12717	CALL get_variable( salsa_nest_offl%id_dynamic, 'z', salsa_nest_offl%zu_atmos )
12718	!
12719	!-- Read the number of aerosol chemical components
12720	CALL get_dimension_length( salsa_nest_offl%id_dynamic, salsa_nest_offl%ncc, &
12721	'composition_index' )
12722	!
12723	!-- Read the names of aerosol chemical components
12724	CALL get_variable( salsa_nest_offl%id_dynamic, 'composition_name', salsa_nest_offl%cc_name, &
12725	salsa_nest_offl%ncc )
12726	!
12727	!-- Define the index of each chemical component in the model
12728	DO ic = 1, salsa_nest_offl%ncc
12729	SELECT CASE ( TRIM( salsa_nest_offl%cc_name(ic) ) )
12730	CASE ( 'H2SO4', 'SO4', 'h2so4', 'so4' )
12731	salsa_nest_offl%cc_in2mod(1) = ic
12732	CASE ( 'OC', 'oc' )
12733	salsa_nest_offl%cc_in2mod(2) = ic
12734	CASE ( 'BC', 'bc' )
12735	salsa_nest_offl%cc_in2mod(3) = ic
12736	CASE ( 'DU', 'du' )
12737	salsa_nest_offl%cc_in2mod(4) = ic
12738	CASE ( 'SS', 'ss' )
12739	salsa_nest_offl%cc_in2mod(5) = ic
12740	CASE ( 'HNO3', 'hno3', 'NO3', 'no3', 'NO', 'no' )
12741	salsa_nest_offl%cc_in2mod(6) = ic
12742	CASE ( 'NH3', 'nh3', 'NH4', 'nh4', 'NH', 'nh' )
12743	salsa_nest_offl%cc_in2mod(7) = ic
12744	END SELECT
12745	ENDDO
12746	IF ( SUM( salsa_nest_offl%cc_in2mod ) == 0 ) THEN
12747	message_string = 'None of the aerosol chemical components in ' // &
12748	TRIM( input_file_dynamic ) // ' correspond to ones applied in SALSA.'
12749	CALL message( 'salsa_mod: salsa_nesting_offl_input', 'PA0693', 2, 2, 0, 6, 0 )
12750	ENDIF
12751
12752	CALL close_input_file( salsa_nest_offl%id_dynamic )
12753	#endif
12754	ENDIF
12755	!
12756	!-- Check if dynamic driver data input is required.
12757	IF ( salsa_nest_offl%time(salsa_nest_offl%tind_p) <= MAX( time_since_reference_point, 0.0_wp) &
12758	+ time_utc_init .OR. .NOT. salsa_nest_offl%init ) THEN
12759	CONTINUE
12760	!
12761	!-- Return otherwise
12762	ELSE
12763	RETURN
12764	ENDIF
12765	!
12766	!-- Obtain time index for current point in time.
12767	salsa_nest_offl%tind = MINLOC( ABS( salsa_nest_offl%time - ( time_utc_init + &
12768	MAX( time_since_reference_point, 0.0_wp) ) ), DIM = 1 ) - 1
12769	salsa_nest_offl%tind_p = salsa_nest_offl%tind + 1
12770	!
12771	!-- Open file in read-only mode
12772	#if defined ( __netcdf )
12773
12774	CALL open_read_file( TRIM( input_file_dynamic ) // TRIM( coupling_char ), &
12775	salsa_nest_offl%id_dynamic )
12776	!
12777	!-- Read data at the western boundary
12778	CALL get_variable( salsa_nest_offl%id_dynamic, 'ls_forcing_left_aerosol', &
12779	salsa_nest_offl%nconc_left, &
12780	MERGE( 0, 1, bc_dirichlet_l ), MERGE( nbins_aerosol-1, 0, bc_dirichlet_l ), &
12781	MERGE( nys, 1, bc_dirichlet_l ), MERGE( nyn, 0, bc_dirichlet_l ), &
12782	MERGE( nzb, 1, bc_dirichlet_l ), MERGE( nzt-1, 0, bc_dirichlet_l ), &
12783	MERGE( salsa_nest_offl%tind, 1, bc_dirichlet_l ), &
12784	MERGE( salsa_nest_offl%tind_p, 0, bc_dirichlet_l ) )
12785	IF ( bc_dirichlet_l ) THEN
12786	salsa_nest_offl%nconc_left = MAX( nclim, salsa_nest_offl%nconc_left )
12787	CALL nesting_offl_aero_mass( salsa_nest_offl%tind, salsa_nest_offl%tind_p, nzb+1, nzt, nys, &
12788	nyn, 'ls_forcing_left_mass_fracs_a', 1 )
12789	ENDIF
12790	IF ( .NOT. salsa_gases_from_chem ) THEN
12791	DO ig = 1, ngases_salsa
12792	vname = salsa_nest_offl%char_l // salsa_nest_offl%gas_name(ig)
12793	CALL get_variable( salsa_nest_offl%id_dynamic, TRIM( vname ), &
12794	salsa_nest_offl%gconc_left(:,:,:,ig), &
12795	MERGE( nys, 1, bc_dirichlet_l ), MERGE( nyn, 0, bc_dirichlet_l ), &
12796	MERGE( nzb, 1, bc_dirichlet_l ), MERGE( nzt-1, 0, bc_dirichlet_l ), &
12797	MERGE( salsa_nest_offl%tind, 1, bc_dirichlet_l ), &
12798	MERGE( salsa_nest_offl%tind_p, 0, bc_dirichlet_l ) )
12799	IF ( bc_dirichlet_l ) salsa_nest_offl%gconc_left(:,:,:,ig) = &
12800	MAX( nclim, salsa_nest_offl%gconc_left(:,:,:,ig) )
12801	ENDDO
12802	ENDIF
12803	!
12804	!-- Read data at the eastern boundary
12805	CALL get_variable( salsa_nest_offl%id_dynamic, 'ls_forcing_right_aerosol', &
12806	salsa_nest_offl%nconc_right, &
12807	MERGE( 0, 1, bc_dirichlet_r ), MERGE( nbins_aerosol-1, 0, bc_dirichlet_r ), &
12808	MERGE( nys, 1, bc_dirichlet_r ), MERGE( nyn, 0, bc_dirichlet_r ), &
12809	MERGE( nzb, 1, bc_dirichlet_r ), MERGE( nzt-1, 0, bc_dirichlet_r ), &
12810	MERGE( salsa_nest_offl%tind, 1, bc_dirichlet_r ), &
12811	MERGE( salsa_nest_offl%tind_p, 0, bc_dirichlet_r ) )
12812	IF ( bc_dirichlet_r ) THEN
12813	salsa_nest_offl%nconc_right = MAX( nclim, salsa_nest_offl%nconc_right )
12814	CALL nesting_offl_aero_mass( salsa_nest_offl%tind, salsa_nest_offl%tind_p, nzb+1, nzt, nys, &
12815	nyn, 'ls_forcing_right_mass_fracs_a', 2 )
12816	ENDIF
12817	IF ( .NOT. salsa_gases_from_chem ) THEN
12818	DO ig = 1, ngases_salsa
12819	vname = salsa_nest_offl%char_r // salsa_nest_offl%gas_name(ig)
12820	CALL get_variable( salsa_nest_offl%id_dynamic, TRIM( vname ), &
12821	salsa_nest_offl%gconc_right(:,:,:,ig), &
12822	MERGE( nys, 1, bc_dirichlet_r ), MERGE( nyn, 0, bc_dirichlet_r ), &
12823	MERGE( nzb, 1, bc_dirichlet_r ), MERGE( nzt-1, 0, bc_dirichlet_r ), &
12824	MERGE( salsa_nest_offl%tind, 1, bc_dirichlet_r ), &
12825	MERGE( salsa_nest_offl%tind_p, 0, bc_dirichlet_r ) )
12826	IF ( bc_dirichlet_r ) salsa_nest_offl%gconc_right(:,:,:,ig) = &
12827	MAX( nclim, salsa_nest_offl%gconc_right(:,:,:,ig) )
12828	ENDDO
12829	ENDIF
12830	!
12831	!-- Read data at the northern boundary
12832	CALL get_variable( salsa_nest_offl%id_dynamic, 'ls_forcing_north_aerosol', &
12833	salsa_nest_offl%nconc_north, &
12834	MERGE( 0, 1, bc_dirichlet_n ), MERGE( nbins_aerosol-1, 0, bc_dirichlet_n ), &
12835	MERGE( nxl, 1, bc_dirichlet_n ), MERGE( nxr, 0, bc_dirichlet_n ), &
12836	MERGE( nzb, 1, bc_dirichlet_n ), MERGE( nzt-1, 0, bc_dirichlet_n ), &
12837	MERGE( salsa_nest_offl%tind, 1, bc_dirichlet_n ), &
12838	MERGE( salsa_nest_offl%tind_p, 0, bc_dirichlet_n ) )
12839	IF ( bc_dirichlet_n ) THEN
12840	salsa_nest_offl%nconc_north = MAX( nclim, salsa_nest_offl%nconc_north )
12841	CALL nesting_offl_aero_mass( salsa_nest_offl%tind, salsa_nest_offl%tind_p, nzb+1, nzt, nxl, &
12842	nxr, 'ls_forcing_north_mass_fracs_a', 3 )
12843	ENDIF
12844	IF ( .NOT. salsa_gases_from_chem ) THEN
12845	DO ig = 1, ngases_salsa
12846	vname = salsa_nest_offl%char_n // salsa_nest_offl%gas_name(ig)
12847	CALL get_variable( salsa_nest_offl%id_dynamic, TRIM( vname ), &
12848	salsa_nest_offl%gconc_north(:,:,:,ig), &
12849	MERGE( nxl, 1, bc_dirichlet_n ), MERGE( nxr, 0, bc_dirichlet_n ), &
12850	MERGE( nzb, 1, bc_dirichlet_n ), MERGE( nzt-1, 0, bc_dirichlet_n ), &
12851	MERGE( salsa_nest_offl%tind, 1, bc_dirichlet_n ), &
12852	MERGE( salsa_nest_offl%tind_p, 0, bc_dirichlet_n ) )
12853	IF ( bc_dirichlet_n ) salsa_nest_offl%gconc_north(:,:,:,ig) = &
12854	MAX( nclim, salsa_nest_offl%gconc_north(:,:,:,ig) )
12855	ENDDO
12856	ENDIF
12857	!
12858	!-- Read data at the southern boundary
12859	CALL get_variable( salsa_nest_offl%id_dynamic, 'ls_forcing_south_aerosol', &
12860	salsa_nest_offl%nconc_south, &
12861	MERGE( 0, 1, bc_dirichlet_s ), MERGE( nbins_aerosol-1, 0, bc_dirichlet_s ), &
12862	MERGE( nxl, 1, bc_dirichlet_s ), MERGE( nxr, 0, bc_dirichlet_s ), &
12863	MERGE( nzb, 1, bc_dirichlet_s ), MERGE( nzt-1, 0, bc_dirichlet_s ), &
12864	MERGE( salsa_nest_offl%tind, 1, bc_dirichlet_s ), &
12865	MERGE( salsa_nest_offl%tind_p, 0, bc_dirichlet_s ) )
12866	IF ( bc_dirichlet_s ) THEN
12867	salsa_nest_offl%nconc_south = MAX( nclim, salsa_nest_offl%nconc_south )
12868	CALL nesting_offl_aero_mass( salsa_nest_offl%tind, salsa_nest_offl%tind_p, nzb+1, nzt, nxl, &
12869	nxr, 'ls_forcing_south_mass_fracs_a', 4 )
12870	ENDIF
12871	IF ( .NOT. salsa_gases_from_chem ) THEN
12872	DO ig = 1, ngases_salsa
12873	vname = salsa_nest_offl%char_s // salsa_nest_offl%gas_name(ig)
12874	CALL get_variable( salsa_nest_offl%id_dynamic, TRIM( vname ), &
12875	salsa_nest_offl%gconc_south(:,:,:,ig), &
12876	MERGE( nxl, 1, bc_dirichlet_s ), MERGE( nxr, 0, bc_dirichlet_s ), &
12877	MERGE( nzb, 1, bc_dirichlet_s ), MERGE( nzt-1, 0, bc_dirichlet_s ), &
12878	MERGE( salsa_nest_offl%tind, 1, bc_dirichlet_s ), &
12879	MERGE( salsa_nest_offl%tind_p, 0, bc_dirichlet_s ) )
12880	IF ( bc_dirichlet_s ) salsa_nest_offl%gconc_south(:,:,:,ig) = &
12881	MAX( nclim, salsa_nest_offl%gconc_south(:,:,:,ig) )
12882	ENDDO
12883	ENDIF
12884	!
12885	!-- Read data at the top boundary
12886	CALL get_variable( salsa_nest_offl%id_dynamic, 'ls_forcing_top_aerosol', &
12887	salsa_nest_offl%nconc_top(0:1,nys:nyn,nxl:nxr,1:nbins_aerosol), &
12888	0, nbins_aerosol-1, nxl, nxr, nys, nyn, salsa_nest_offl%tind, &
12889	salsa_nest_offl%tind_p )
12890	salsa_nest_offl%nconc_top = MAX( nclim, salsa_nest_offl%nconc_top )
12891	CALL nesting_offl_aero_mass( salsa_nest_offl%tind, salsa_nest_offl%tind_p, nys, nyn, nxl, nxr, &
12892	'ls_forcing_top_mass_fracs_a', 5 )
12893	IF ( .NOT. salsa_gases_from_chem ) THEN
12894	DO ig = 1, ngases_salsa
12895	vname = salsa_nest_offl%char_t // salsa_nest_offl%gas_name(ig)
12896	CALL get_variable( salsa_nest_offl%id_dynamic, TRIM( vname ), &
12897	salsa_nest_offl%gconc_top(:,:,:,ig), nxl, nxr, nys, nyn, &
12898	salsa_nest_offl%tind, salsa_nest_offl%tind_p )
12899	salsa_nest_offl%gconc_top(:,:,:,ig) = MAX( nclim, salsa_nest_offl%gconc_top(:,:,:,ig) )
12900	ENDDO
12901	ENDIF
12902	!
12903	!-- Close input file
12904	CALL close_input_file( salsa_nest_offl%id_dynamic )
12905
12906	#endif
12907	!
12908	!-- Set control flag to indicate that initialization is already done
12909	salsa_nest_offl%init = .TRUE.
12910
12911	END SUBROUTINE salsa_nesting_offl_input
12912
12913	!------------------------------------------------------------------------------!
12914	! Description:
12915	! ------------
12916	!> Sets the mass concentrations to aerosol arrays in 2a and 2b.
12917	!------------------------------------------------------------------------------!
12918	SUBROUTINE nesting_offl_aero_mass( ts, te, ks, ke, is, ie, varname_a, ibound )
12919
12920	USE netcdf_data_input_mod, &
12921	ONLY: get_variable
12922
12923	IMPLICIT NONE
12924
12925	CHARACTER(LEN=25) :: varname_b !< name for bins b
12926
12927	CHARACTER(LEN=*), INTENT(in) :: varname_a !< name for bins a
12928
12929	INTEGER(iwp) :: ee !< loop index: end
12930	INTEGER(iwp) :: i !< loop index
12931	INTEGER(iwp) :: ib !< loop index
12932	INTEGER(iwp) :: ic !< loop index
12933	INTEGER(iwp) :: k !< loop index
12934	INTEGER(iwp) :: ss !< loop index: start
12935	INTEGER(iwp) :: t !< loop index
12936	INTEGER(iwp) :: type_so4_oc = -1 !<
12937
12938	INTEGER(iwp), INTENT(in) :: ibound !< index: 1=left, 2=right, 3=north, 4=south, 5=top
12939	INTEGER(iwp), INTENT(in) :: ie !< loop index
12940	INTEGER(iwp), INTENT(in) :: is !< loop index
12941	INTEGER(iwp), INTENT(in) :: ks !< loop index
12942	INTEGER(iwp), INTENT(in) :: ke !< loop index
12943	INTEGER(iwp), INTENT(in) :: ts !< loop index
12944	INTEGER(iwp), INTENT(in) :: te !< loop index
12945
12946	INTEGER(iwp), DIMENSION(maxspec) :: cc_i2m !<
12947
12948	REAL(wp) :: pmf1a !< mass fraction in 1a
12949
12950	REAL(wp), DIMENSION(nbins_aerosol) :: core !< size of the bin mid aerosol particle
12951
12952	REAL(wp), DIMENSION(0:1,ks:ke,is:ie,1:nbins_aerosol) :: to_nconc !<
12953	REAL(wp), DIMENSION(0:1,ks:ke,is:ie,1:nbins_aerosol*ncomponents_mass) :: to_mconc !<
12954
12955	REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE :: mf2a !< Mass distributions for a
12956	REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE :: mf2b !< and b bins
12957
12958	!
12959	!-- Variable name for insoluble mass fraction
12960	varname_b = varname_a(1:LEN( TRIM( varname_a ) ) - 1 ) // 'b'
12961	!
12962	!-- Bin mean aerosol particle volume (m3)
12963	core(1:nbins_aerosol) = api6 * aero(1:nbins_aerosol)%dmid**3
12964	!
12965	!-- Allocate and read mass fraction arrays
12966	ALLOCATE( mf2a(0:1,ks:ke,is:ie,1:salsa_nest_offl%ncc), &
12967	mf2b(0:1,ks:ke,is:ie,1:salsa_nest_offl%ncc) )
12968	IF ( ibound == 5 ) THEN
12969	CALL get_variable( salsa_nest_offl%id_dynamic, varname_a, &
12970	mf2a(0:1,ks:ke,is:ie,1:salsa_nest_offl%ncc), 0, salsa_nest_offl%ncc-1, &
12971	is, ie, ks, ke, ts, te )
12972	ELSE
12973	CALL get_variable( salsa_nest_offl%id_dynamic, varname_a, &
12974	mf2a(0:1,ks:ke,is:ie,1:salsa_nest_offl%ncc), 0, salsa_nest_offl%ncc-1, &
12975	is, ie, ks-1, ke-1, ts, te )
12976	ENDIF
12977	!
12978	!-- If the chemical component is not activated, set its mass fraction to 0 to avoid mass inbalance
12979	cc_i2m = salsa_nest_offl%cc_in2mod
12980	IF ( index_so4 < 0 .AND. cc_i2m(1) > 0 ) mf2a(:,:,:,cc_i2m(1)) = 0.0_wp
12981	IF ( index_oc < 0 .AND. cc_i2m(2) > 0 ) mf2a(:,:,:,cc_i2m(2)) = 0.0_wp
12982	IF ( index_bc < 0 .AND. cc_i2m(3) > 0 ) mf2a(:,:,:,cc_i2m(3)) = 0.0_wp
12983	IF ( index_du < 0 .AND. cc_i2m(4) > 0 ) mf2a(:,:,:,cc_i2m(4)) = 0.0_wp
12984	IF ( index_ss < 0 .AND. cc_i2m(5) > 0 ) mf2a(:,:,:,cc_i2m(5)) = 0.0_wp
12985	IF ( index_no < 0 .AND. cc_i2m(6) > 0 ) mf2a(:,:,:,cc_i2m(6)) = 0.0_wp
12986	IF ( index_nh < 0 .AND. cc_i2m(7) > 0 ) mf2a(:,:,:,cc_i2m(7)) = 0.0_wp
12987	mf2b = 0.0_wp
12988	!
12989	!-- Initialise variable type_so4_oc to indicate whether SO4 and/OC is included in mass fraction data
12990	IF ( ( cc_i2m(1) > 0 .AND. index_so4 > 0 ) .AND. ( cc_i2m(2) > 0 .AND. index_oc > 0 ) ) &
12991	THEN
12992	type_so4_oc = 1
12993	ELSEIF ( cc_i2m(1) > 0 .AND. index_so4 > 0 ) THEN
12994	type_so4_oc = 2
12995	ELSEIF ( cc_i2m(2) > 0 .AND. index_oc > 0 ) THEN
12996	type_so4_oc = 3
12997	ENDIF
12998
12999	SELECT CASE ( ibound )
13000	CASE( 1 )
13001	to_nconc = salsa_nest_offl%nconc_left
13002	to_mconc = salsa_nest_offl%mconc_left
13003	CASE( 2 )
13004	to_nconc = salsa_nest_offl%nconc_right
13005	to_mconc = salsa_nest_offl%mconc_right
13006	CASE( 3 )
13007	to_nconc = salsa_nest_offl%nconc_north
13008	to_mconc = salsa_nest_offl%mconc_north
13009	CASE( 4 )
13010	to_nconc = salsa_nest_offl%nconc_south
13011	to_mconc = salsa_nest_offl%mconc_south
13012	CASE( 5 )
13013	to_nconc = salsa_nest_offl%nconc_top
13014	to_mconc = salsa_nest_offl%mconc_top
13015	END SELECT
13016	!
13017	!-- Set mass concentrations:
13018	!
13019	!-- Regime 1:
13020	SELECT CASE ( type_so4_oc )
13021	CASE ( 1 ) ! Both SO4 and OC given
13022
13023	ss = ( index_so4 - 1 ) * nbins_aerosol + start_subrange_1a ! start
13024	ee = ( index_so4 - 1 ) * nbins_aerosol + end_subrange_1a ! end
13025	ib = start_subrange_1a
13026	DO ic = ss, ee
13027	DO i = is, ie
13028	DO k = ks, ke
13029	DO t = 0, 1
13030	pmf1a = mf2a(t,k,i,cc_i2m(1)) / ( mf2a(t,k,i,cc_i2m(1)) + mf2a(t,k,i,cc_i2m(2)) )
13031	to_mconc(t,k,i,ic) = pmf1a * to_nconc(t,k,i,ib) * core(ib) * arhoh2so4
13032	ENDDO
13033	ENDDO
13034	ENDDO
13035	ib = ib + 1
13036	ENDDO
13037	ss = ( index_oc - 1 ) * nbins_aerosol + start_subrange_1a ! start
13038	ee = ( index_oc - 1 ) * nbins_aerosol + end_subrange_1a ! end
13039	ib = start_subrange_1a
13040	DO ic = ss, ee
13041	DO i = is, ie
13042	DO k = ks, ke
13043	DO t = 0, 1
13044	pmf1a = mf2a(t,k,i,cc_i2m(2)) / ( mf2a(t,k,i,cc_i2m(1)) + mf2a(t,k,i,cc_i2m(2)) )
13045	to_mconc(t,k,i,ic) = pmf1a * to_nconc(t,k,i,ib) * core(ib) * arhooc
13046	ENDDO
13047	ENDDO
13048	ENDDO
13049	ib = ib + 1
13050	ENDDO
13051	CASE ( 2 ) ! Only SO4
13052	ss = ( index_so4 - 1 ) * nbins_aerosol + start_subrange_1a ! start
13053	ee = ( index_so4 - 1 ) * nbins_aerosol + end_subrange_1a ! end
13054	ib = start_subrange_1a
13055	DO ic = ss, ee
13056	DO i = is, ie
13057	DO k = ks, ke
13058	DO t = 0, 1
13059	to_mconc(t,k,i,ic) = to_nconc(t,k,i,ib) * core(ib) * arhoh2so4
13060	ENDDO
13061	ENDDO
13062	ENDDO
13063	ib = ib + 1
13064	ENDDO
13065	CASE ( 3 ) ! Only OC
13066	ss = ( index_oc - 1 ) * nbins_aerosol + start_subrange_1a ! start
13067	ee = ( index_oc - 1 ) * nbins_aerosol + end_subrange_1a ! end
13068	ib = start_subrange_1a
13069	DO ic = ss, ee
13070	DO i = is, ie
13071	DO k = ks, ke
13072	DO t = 0, 1
13073	to_mconc(t,k,i,ic) = to_nconc(t,k,i,ib) * core(ib) * arhooc
13074	ENDDO
13075	ENDDO
13076	ENDDO
13077	ib = ib + 1
13078	ENDDO
13079	END SELECT
13080	!
13081	!-- Regimes 2a and 2b:
13082	IF ( index_so4 > 0 ) THEN
13083	CALL set_nest_mass( index_so4, 1, arhoh2so4 )
13084	ENDIF
13085	IF ( index_oc > 0 ) THEN
13086	CALL set_nest_mass( index_oc, 2, arhooc )
13087	ENDIF
13088	IF ( index_bc > 0 ) THEN
13089	CALL set_nest_mass( index_bc, 3, arhobc )
13090	ENDIF
13091	IF ( index_du > 0 ) THEN
13092	CALL set_nest_mass( index_du, 4, arhodu )
13093	ENDIF
13094	IF ( index_ss > 0 ) THEN
13095	CALL set_nest_mass( index_ss, 5, arhoss )
13096	ENDIF
13097	IF ( index_no > 0 ) THEN
13098	CALL set_nest_mass( index_no, 6, arhohno3 )
13099	ENDIF
13100	IF ( index_nh > 0 ) THEN
13101	CALL set_nest_mass( index_nh, 7, arhonh3 )
13102	ENDIF
13103
13104	DEALLOCATE( mf2a, mf2b )
13105
13106	SELECT CASE ( ibound )
13107	CASE( 1 )
13108	salsa_nest_offl%mconc_left = to_mconc
13109	CASE( 2 )
13110	salsa_nest_offl%mconc_right = to_mconc
13111	CASE( 3 )
13112	salsa_nest_offl%mconc_north = to_mconc
13113	CASE( 4 )
13114	salsa_nest_offl%mconc_south = to_mconc
13115	CASE( 5 )
13116	salsa_nest_offl%mconc_top = to_mconc
13117	END SELECT
13118
13119	CONTAINS
13120
13121	!------------------------------------------------------------------------------!
13122	! Description:
13123	! ------------
13124	!> Set nesting boundaries for aerosol mass.
13125	!------------------------------------------------------------------------------!
13126	SUBROUTINE set_nest_mass( ispec, ispec_def, prho )
13127
13128	IMPLICIT NONE
13129
13130	INTEGER(iwp) :: ic !< chemical component index: default
13131	INTEGER(iwp) :: icc !< loop index: mass bin
13132
13133	INTEGER(iwp), INTENT(in) :: ispec !< aerosol species index
13134	INTEGER(iwp), INTENT(in) :: ispec_def !< default aerosol species index
13135
13136	REAL(wp), INTENT(in) :: prho !< aerosol density
13137	!
13138	!-- Define the index of the chemical component in the input data
13139	ic = salsa_nest_offl%cc_in2mod(ispec_def)
13140
13141	DO i = is, ie
13142	DO k = ks, ke
13143	DO t = 0, 1
13144	!
13145	!-- Regime 2a:
13146	ss = ( ispec - 1 ) * nbins_aerosol + start_subrange_2a
13147	ee = ( ispec - 1 ) * nbins_aerosol + end_subrange_2a
13148	ib = start_subrange_2a
13149	DO icc = ss, ee
13150	to_mconc(t,k,i,icc) = MAX( 0.0_wp, mf2a(t,k,i,ic) / SUM( mf2a(t,k,i,:) ) ) * &
13151	to_nconc(t,k,i,ib) * core(ib) * prho
13152	ib = ib + 1
13153	ENDDO
13154	!
13155	!-- Regime 2b:
13156	IF ( .NOT. no_insoluble ) THEN
13157	!
13158	!-- TODO!
13159	mf2b(t,k,i,ic) = mf2b(t,k,i,ic)
13160	ENDIF
13161	ENDDO ! k
13162
13163	ENDDO ! j
13164	ENDDO ! i
13165
13166	END SUBROUTINE set_nest_mass
13167
13168	END SUBROUTINE nesting_offl_aero_mass
13169
13170
13171	END MODULE salsa_mod

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

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |