Home

Context Navigation

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

Last change on this file since 4217 was 4182, checked in by scharf, 6 years ago
corrected "Former revisions" section minor formatting in "Former revisions" section added "Author" section
Property svn:keywords set to `Id`
File size: 532.7 KB

Line
1	!> @file salsa_mod.f90
2	!--------------------------------------------------------------------------------!
3	! This file is part of PALM-4U.
4	!
5	! PALM-4U is free software: you can redistribute it and/or modify it under the
6	! terms of the GNU General Public License as published by the Free Software
7	! Foundation, either version 3 of the License, or (at your option) any later
8	! version.
9	!
10	! PALM-4U is distributed in the hope that it will be useful, but WITHOUT ANY
11	! WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
12	! A PARTICULAR PURPOSE. See the GNU General Public License for more details.
13	!
14	! You should have received a copy of the GNU General Public License along with
15	! PALM. If not, see <http://www.gnu.org/licenses/>.
16	!
17	! Copyright 2018-2019 University of Helsinki
18	! Copyright 1997-2019 Leibniz Universitaet Hannover
19	!--------------------------------------------------------------------------------!
20	!
21	! Current revisions:
22	! -----------------
23	!
24	!
25	! Former revisions:
26	! -----------------
27	! $Id: salsa_mod.f90 4182 2019-08-22 15:20:23Z scharf $
28	! Corrected "Former revisions" section
29	!
30	! 4167 2019-08-16 11:01:48Z suehring
31	! Changed behaviour of masked output over surface to follow terrain and ignore
32	! buildings (J.Resler, T.Gronemeier)
33	!
34	! 4131 2019-08-02 11:06:18Z monakurppa
35	! - Add "salsa_" before each salsa output variable
36	! - Add a possibility to output the number (salsa_N_UFP) and mass concentration
37	! (salsa_PM0.1) of ultrafine particles, i.e. particles with a diameter smaller
38	! than 100 nm
39	! - Implement aerosol emission mode "parameterized" which is based on the street
40	! type (similar to the chemistry module).
41	! - Remove unnecessary nucleation subroutines.
42	! - Add the z-dimension for gaseous emissions to correspond the implementation
43	! in the chemistry module
44	!
45	! 4118 2019-07-25 16:11:45Z suehring
46	! - When Dirichlet condition is applied in decycling, the boundary conditions are
47	! only set at the ghost points and not at the prognostic grid points as done
48	! before
49	! - Rename decycle_ns/lr to decycle_salsa_ns/lr and decycle_method to
50	! decycle_method_salsa
51	! - Allocation and initialization of special advection flags salsa_advc_flags_s
52	! used for salsa. These are exclusively used for salsa variables to
53	! distinguish from the usually-used flags which might be different when
54	! decycling is applied in combination with cyclic boundary conditions.
55	! Moreover, salsa_advc_flags_s considers extended zones around buildings where
56	! the first-order upwind scheme is applied for the horizontal advection terms.
57	! This is done to overcome high concentration peaks due to stationary numerical
58	! oscillations caused by horizontal advection discretization.
59	!
60	! 4117 2019-07-25 08:54:02Z monakurppa
61	! Pass integer flag array as well as boundary flags to WS scalar advection
62	! routine
63	!
64	! 4109 2019-07-22 17:00:34Z suehring
65	! Slightly revise setting of boundary conditions at horizontal walls, use
66	! data-structure offset index instead of pre-calculate it for each facing
67	!
68	! 4079 2019-07-09 18:04:41Z suehring
69	! Application of monotonic flux limiter for the vertical scalar advection
70	! up to the topography top (only for the cache-optimized version at the
71	! moment).
72	!
73	! 4069 2019-07-01 14:05:51Z Giersch
74	! Masked output running index mid has been introduced as a local variable to
75	! avoid runtime error (Loop variable has been modified) in time_integration
76	!
77	! 4058 2019-06-27 15:25:42Z knoop
78	! Bugfix: to_be_resorted was uninitialized in case of s_H2O in 3d_data_averaging
79	!
80	! 4012 2019-05-31 15:19:05Z monakurppa
81	! Merge salsa branch to trunk. List of changes:
82	! - Error corrected in distr_update that resulted in the aerosol number size
83	! distribution not converging if the concentration was nclim.
84	! - Added a separate output for aerosol liquid water (s_H2O)
85	! - aerosol processes for a size bin are now calculated only if the aerosol
86	! number of concentration of that bin is > 2*nclim
87	! - An initialisation error in the subroutine "deposition" corrected and the
88	! subroutine reformatted.
89	! - stuff from salsa_util_mod.f90 moved into salsa_mod.f90
90	! - calls for closing the netcdf input files added
91	!
92	! 3956 2019-05-07 12:32:52Z monakurppa
93	! - Conceptual bug in depo_surf correct for urban and land surface model
94	! - Subroutine salsa_tendency_ij optimized.
95	! - Interfaces salsa_non_advective_processes and salsa_exchange_horiz_bounds
96	! created. These are now called in module_interface.
97	! salsa_exchange_horiz_bounds after calling salsa_driver only when needed
98	! (i.e. every dt_salsa).
99	!
100	! 3924 2019-04-23 09:33:06Z monakurppa
101	! Correct a bug introduced by the previous update.
102	!
103	! 3899 2019-04-16 14:05:27Z monakurppa
104	! - remove unnecessary error / location messages
105	! - corrected some error message numbers
106	! - allocate source arrays only if emissions or dry deposition is applied.
107	!
108	! 3885 2019-04-11 11:29:34Z kanani
109	! Changes related to global restructuring of location messages and introduction
110	! of additional debug messages
111	!
112	! 3876 2019-04-08 18:41:49Z knoop
113	! Introduced salsa_actions module interface
114	!
115	! 3871 2019-04-08 14:38:39Z knoop
116	! Major changes in formatting, performance and data input structure (see branch
117	! the history for details)
118	! - Time-dependent emissions enabled: lod=1 for yearly PM emissions that are
119	! normalised depending on the time, and lod=2 for preprocessed emissions
120	! (similar to the chemistry module).
121	! - Additionally, 'uniform' emissions allowed. This emission is set constant on
122	! all horisontal upward facing surfaces and it is created based on parameters
123	! surface_aerosol_flux, aerosol_flux_dpg/sigmag/mass_fracs_a/mass_fracs_b.
124	! - All emissions are now implemented as surface fluxes! No 3D sources anymore.
125	! - Update the emission information by calling salsa_emission_update if
126	! skip_time_do_salsa >= time_since_reference_point and
127	! next_aero_emission_update <= time_since_reference_point
128	! - Aerosol background concentrations read from PIDS_DYNAMIC. The vertical grid
129	! must match the one applied in the model.
130	! - Gas emissions and background concentrations can be also read in in salsa_mod
131	! if the chemistry module is not applied.
132	! - In deposition, information on the land use type can be now imported from
133	! the land use model
134	! - Use SI units in PARIN, i.e. n_lognorm given in #/m3 and dpg in metres.
135	! - Apply 100 character line limit
136	! - Change all variable names from capital to lowercase letter
137	! - Change real exponents to integer if possible. If not, precalculate the value
138	! value of exponent
139	! - Rename in1a to start_subrange_1a, fn2a to end_subrange_1a etc.
140	! - Rename nbins --> nbins_aerosol, ncc_tot --> ncomponents_mass and ngast -->
141	! ngases_salsa
142	! - Rename ibc to index_bc, idu to index_du etc.
143	! - Renamed loop indices b, c and sg to ib, ic and ig
144	! - run_salsa subroutine removed
145	! - Corrected a bud in salsa_driver: falsely applied ino instead of inh
146	! - Call salsa_tendency within salsa_prognostic_equations which is called in
147	! module_interface_mod instead of prognostic_equations_mod
148	! - Removed tailing white spaces and unused variables
149	! - Change error message to start by PA instead of SA
150	!
151	! 3833 2019-03-28 15:04:04Z forkel
152	! added USE chem_gasphase_mod for nvar, nspec and spc_names
153	!
154	! 3787 2019-03-07 08:43:54Z raasch
155	! unused variables removed
156	!
157	! 3780 2019-03-05 11:19:45Z forkel
158	! unused variable for file index removed from rrd-subroutines parameter list
159	!
160	! 3685 2019-01-21 01:02:11Z knoop
161	! Some interface calls moved to module_interface + cleanup
162	!
163	! 3655 2019-01-07 16:51:22Z knoop
164	! Implementation of the PALM module interface
165	! 3412 2018-10-24 07:25:57Z monakurppa
166	!
167	! Authors:
168	! --------
169	! @author Mona Kurppa (University of Helsinki)
170	!
171	!
172	! Description:
173	! ------------
174	!> Sectional aerosol module for large scale applications SALSA
175	!> (Kokkola et al., 2008, ACP 8, 2469-2483). Solves the aerosol number and mass
176	!> concentration as well as chemical composition. Includes aerosol dynamic
177	!> processes: nucleation, condensation/evaporation of vapours, coagulation and
178	!> deposition on tree leaves, ground and roofs.
179	!> Implementation is based on formulations implemented in UCLALES-SALSA except
180	!> for deposition which is based on parametrisations by Zhang et al. (2001,
181	!> Atmos. Environ. 35, 549-560) or Petroff&Zhang (2010, Geosci. Model Dev. 3,
182	!> 753-769)
183	!>
184	!> @todo Apply information from emission_stack_height to lift emission sources
185	!> @todo emission mode "parameterized", i.e. based on street type
186	!> @todo Allow insoluble emissions
187	!> @todo Apply flux limiter in prognostic equations
188	!------------------------------------------------------------------------------!
189	MODULE salsa_mod
190
191	USE basic_constants_and_equations_mod, &
192	ONLY: c_p, g, p_0, pi, r_d
193
194	USE chem_gasphase_mod, &
195	ONLY: nspec, nvar, spc_names
196
197	USE chem_modules, &
198	ONLY: call_chem_at_all_substeps, chem_gasphase_on, chem_species
199
200	USE control_parameters, &
201	ONLY: air_chemistry, bc_dirichlet_l, bc_dirichlet_n, bc_dirichlet_r, bc_dirichlet_s, &
202	bc_lr, bc_lr_cyc, bc_ns, bc_ns_cyc, bc_radiation_l, bc_radiation_n, bc_radiation_r, &
203	bc_radiation_s, coupling_char, debug_output, dt_3d, intermediate_timestep_count, &
204	intermediate_timestep_count_max, land_surface, max_pr_salsa, message_string, &
205	monotonic_limiter_z, plant_canopy, pt_surface, salsa, scalar_advec, &
206	surface_pressure, time_since_reference_point, timestep_scheme, tsc, urban_surface, &
207	ws_scheme_sca
208
209	USE indices, &
210	ONLY: nbgp, nx, nxl, nxlg, nxr, nxrg, ny, nyn, nyng, nys, nysg, nzb, nz, nzt, wall_flags_0
211
212	USE kinds
213
214	USE netcdf_data_input_mod, &
215	ONLY: chem_emis_att_type, chem_emis_val_type
216
217	USE pegrid
218
219	USE statistics, &
220	ONLY: sums_salsa_ws_l
221
222	IMPLICIT NONE
223	!
224	!-- SALSA constants:
225	!
226	!-- Local constants:
227	INTEGER(iwp), PARAMETER :: luc_urban = 15 !< default landuse type for urban
228	INTEGER(iwp), PARAMETER :: ngases_salsa = 5 !< total number of gaseous tracers:
229	!< 1 = H2SO4, 2 = HNO3, 3 = NH3, 4 = OCNV
230	!< (non-volatile OC), 5 = OCSV (semi-volatile)
231	INTEGER(iwp), PARAMETER :: nmod = 7 !< number of modes for initialising the aerosol size
232	!< distribution
233	INTEGER(iwp), PARAMETER :: nreg = 2 !< Number of main size subranges
234	INTEGER(iwp), PARAMETER :: maxspec = 7 !< Max. number of aerosol species
235	INTEGER(iwp), PARAMETER :: season = 1 !< For dry depostion by Zhang et al.: 1 = summer,
236	!< 2 = autumn (no harvest yet), 3 = late autumn
237	!< (already frost), 4 = winter, 5 = transitional spring
238
239	REAL(wp), PARAMETER :: fill_value = -9999.0_wp !< value for the _FillValue attribute
240	!
241	!-- Universal constants
242	REAL(wp), PARAMETER :: abo = 1.380662E-23_wp !< Boltzmann constant (J/K)
243	REAL(wp), PARAMETER :: alv = 2.260E+6_wp !< latent heat for H2O
244	!< vaporisation (J/kg)
245	REAL(wp), PARAMETER :: alv_d_rv = 4896.96865_wp !< alv / rv
246	REAL(wp), PARAMETER :: am_airmol = 4.8096E-26_wp !< Average mass of one air
247	!< molecule (Jacobson,
248	!< 2005, Eq. 2.3)
249	REAL(wp), PARAMETER :: api6 = 0.5235988_wp !< pi / 6
250	REAL(wp), PARAMETER :: argas = 8.314409_wp !< Gas constant (J/(mol K))
251	REAL(wp), PARAMETER :: argas_d_cpd = 8.281283865E-3_wp !< argas per cpd
252	REAL(wp), PARAMETER :: avo = 6.02214E+23_wp !< Avogadro constant (1/mol)
253	REAL(wp), PARAMETER :: d_sa = 5.539376964394570E-10_wp !< diameter of condensing sulphuric
254	!< acid molecule (m)
255	REAL(wp), PARAMETER :: for_ppm_to_nconc = 7.243016311E+16_wp !< ppm * avo / R (K/(Pa*m3))
256	REAL(wp), PARAMETER :: epsoc = 0.15_wp !< water uptake of organic
257	!< material
258	REAL(wp), PARAMETER :: mclim = 1.0E-23_wp !< mass concentration min limit (kg/m3)
259	REAL(wp), PARAMETER :: n3 = 158.79_wp !< Number of H2SO4 molecules in 3 nm cluster
260	!< if d_sa=5.54e-10m
261	REAL(wp), PARAMETER :: nclim = 1.0_wp !< number concentration min limit (#/m3)
262	REAL(wp), PARAMETER :: surfw0 = 0.073_wp !< surface tension of water at 293 K (J/m2)
263	!
264	!-- Molar masses in kg/mol
265	REAL(wp), PARAMETER :: ambc = 12.0E-3_wp !< black carbon (BC)
266	REAL(wp), PARAMETER :: amdair = 28.970E-3_wp !< dry air
267	REAL(wp), PARAMETER :: amdu = 100.E-3_wp !< mineral dust
268	REAL(wp), PARAMETER :: amh2o = 18.0154E-3_wp !< H2O
269	REAL(wp), PARAMETER :: amh2so4 = 98.06E-3_wp !< H2SO4
270	REAL(wp), PARAMETER :: amhno3 = 63.01E-3_wp !< HNO3
271	REAL(wp), PARAMETER :: amn2o = 44.013E-3_wp !< N2O
272	REAL(wp), PARAMETER :: amnh3 = 17.031E-3_wp !< NH3
273	REAL(wp), PARAMETER :: amo2 = 31.9988E-3_wp !< O2
274	REAL(wp), PARAMETER :: amo3 = 47.998E-3_wp !< O3
275	REAL(wp), PARAMETER :: amoc = 150.E-3_wp !< organic carbon (OC)
276	REAL(wp), PARAMETER :: amss = 58.44E-3_wp !< sea salt (NaCl)
277	!
278	!-- Densities in kg/m3
279	REAL(wp), PARAMETER :: arhobc = 2000.0_wp !< black carbon
280	REAL(wp), PARAMETER :: arhodu = 2650.0_wp !< mineral dust
281	REAL(wp), PARAMETER :: arhoh2o = 1000.0_wp !< H2O
282	REAL(wp), PARAMETER :: arhoh2so4 = 1830.0_wp !< SO4
283	REAL(wp), PARAMETER :: arhohno3 = 1479.0_wp !< HNO3
284	REAL(wp), PARAMETER :: arhonh3 = 1530.0_wp !< NH3
285	REAL(wp), PARAMETER :: arhooc = 2000.0_wp !< organic carbon
286	REAL(wp), PARAMETER :: arhoss = 2165.0_wp !< sea salt (NaCl)
287	!
288	!-- Volume of molecule in m3/#
289	REAL(wp), PARAMETER :: amvh2o = amh2o /avo / arhoh2o !< H2O
290	REAL(wp), PARAMETER :: amvh2so4 = amh2so4 / avo / arhoh2so4 !< SO4
291	REAL(wp), PARAMETER :: amvhno3 = amhno3 / avo / arhohno3 !< HNO3
292	REAL(wp), PARAMETER :: amvnh3 = amnh3 / avo / arhonh3 !< NH3
293	REAL(wp), PARAMETER :: amvoc = amoc / avo / arhooc !< OC
294	REAL(wp), PARAMETER :: amvss = amss / avo / arhoss !< sea salt
295	!
296	!-- Constants for the dry deposition model by Petroff and Zhang (2010):
297	!-- obstacle characteristic dimension "L" (cm) (plane obstacle by default) and empirical constants
298	!-- C_B, C_IN, C_IM, beta_IM and C_IT for each land use category (15, as in Zhang et al. (2001))
299	REAL(wp), DIMENSION(1:15), PARAMETER :: l_p10 = &
300	(/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/)
301	REAL(wp), DIMENSION(1:15), PARAMETER :: c_b_p10 = &
302	(/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/)
303	REAL(wp), DIMENSION(1:15), PARAMETER :: c_in_p10 = &
304	(/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/)
305	REAL(wp), DIMENSION(1:15), PARAMETER :: c_im_p10 = &
306	(/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/)
307	REAL(wp), DIMENSION(1:15), PARAMETER :: beta_im_p10 = &
308	(/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/)
309	REAL(wp), DIMENSION(1:15), PARAMETER :: c_it_p10 = &
310	(/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/)
311	!
312	!-- Constants for the dry deposition model by Zhang et al. (2001):
313	!-- empirical constants "alpha" and "gamma" and characteristic radius "A" for
314	!-- each land use category (15) and season (5)
315	REAL(wp), DIMENSION(1:15), PARAMETER :: alpha_z01 = &
316	(/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/)
317	REAL(wp), DIMENSION(1:15), PARAMETER :: gamma_z01 = &
318	(/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/)
319	REAL(wp), DIMENSION(1:15,1:5), PARAMETER :: A_z01 = RESHAPE( (/&
320	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
321	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
322	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
323	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
324	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
325	/), (/ 15, 5 /) )
326	!-- Land use categories (based on Z01 but the same applies here also for P10):
327	!-- 1 = evergreen needleleaf trees,
328	!-- 2 = evergreen broadleaf trees,
329	!-- 3 = deciduous needleleaf trees,
330	!-- 4 = deciduous broadleaf trees,
331	!-- 5 = mixed broadleaf and needleleaf trees (deciduous broadleaf trees for P10),
332	!-- 6 = grass (short grass for P10),
333	!-- 7 = crops, mixed farming,
334	!-- 8 = desert,
335	!-- 9 = tundra,
336	!-- 10 = shrubs and interrupted woodlands (thorn shrubs for P10),
337	!-- 11 = wetland with plants (long grass for P10)
338	!-- 12 = ice cap and glacier,
339	!-- 13 = inland water (inland lake for P10)
340	!-- 14 = ocean (water for P10),
341	!-- 15 = urban
342	!
343	!-- SALSA variables:
344	CHARACTER(LEN=20) :: bc_salsa_b = 'neumann' !< bottom boundary condition
345	CHARACTER(LEN=20) :: bc_salsa_t = 'neumann' !< top boundary condition
346	CHARACTER(LEN=20) :: depo_pcm_par = 'zhang2001' !< or 'petroff2010'
347	CHARACTER(LEN=20) :: depo_pcm_type = 'deciduous_broadleaf' !< leaf type
348	CHARACTER(LEN=20) :: depo_surf_par = 'zhang2001' !< or 'petroff2010'
349	CHARACTER(LEN=100) :: input_file_dynamic = 'PIDS_DYNAMIC' !< file name for dynamic input
350	CHARACTER(LEN=100) :: input_file_salsa = 'PIDS_SALSA' !< file name for emission data
351	CHARACTER(LEN=20) :: salsa_emission_mode = 'no_emission' !< 'no_emission', 'uniform',
352	!< 'parameterized', 'read_from_file'
353
354	CHARACTER(LEN=20), DIMENSION(4) :: decycle_method_salsa = &
355	(/'dirichlet','dirichlet','dirichlet','dirichlet'/)
356	!< Decycling method at horizontal boundaries
357	!< 1=left, 2=right, 3=south, 4=north
358	!< dirichlet = initial profiles for the ghost and first 3 layers
359	!< neumann = zero gradient
360
361	CHARACTER(LEN=3), DIMENSION(maxspec) :: listspec = & !< Active aerosols
362	(/'SO4',' ',' ',' ',' ',' ',' '/)
363
364	INTEGER(iwp) :: depo_pcm_par_num = 1 !< parametrisation type: 1=zhang2001, 2=petroff2010
365	INTEGER(iwp) :: depo_pcm_type_num = 0 !< index for the dry deposition type on the plant canopy
366	INTEGER(iwp) :: depo_surf_par_num = 1 !< parametrisation type: 1=zhang2001, 2=petroff2010
367	INTEGER(iwp) :: dots_salsa = 0 !< starting index for salsa-timeseries
368	INTEGER(iwp) :: end_subrange_1a = 1 !< last index for bin subrange 1a
369	INTEGER(iwp) :: end_subrange_2a = 1 !< last index for bin subrange 2a
370	INTEGER(iwp) :: end_subrange_2b = 1 !< last index for bin subrange 2b
371	INTEGER(iwp) :: ibc_salsa_b !< index for the bottom boundary condition
372	INTEGER(iwp) :: ibc_salsa_t !< index for the top boundary condition
373	INTEGER(iwp) :: index_bc = -1 !< index for black carbon (BC)
374	INTEGER(iwp) :: index_du = -1 !< index for dust
375	INTEGER(iwp) :: index_nh = -1 !< index for NH3
376	INTEGER(iwp) :: index_no = -1 !< index for HNO3
377	INTEGER(iwp) :: index_oc = -1 !< index for organic carbon (OC)
378	INTEGER(iwp) :: index_so4 = -1 !< index for SO4 or H2SO4
379	INTEGER(iwp) :: index_ss = -1 !< index for sea salt
380	INTEGER(iwp) :: init_aerosol_type = 0 !< Initial size distribution type
381	!< 0 = uniform (read from PARIN)
382	!< 1 = read vertical profile of the mode number
383	!< concentration from an input file
384	INTEGER(iwp) :: init_gases_type = 0 !< Initial gas concentration type
385	!< 0 = uniform (read from PARIN)
386	!< 1 = read vertical profile from an input file
387	INTEGER(iwp) :: lod_gas_emissions = 0 !< level of detail of the gaseous emission data
388	INTEGER(iwp) :: main_street_id = 0 !< lower bound of main street IDs (OpenStreetMaps) for parameterized mode
389	INTEGER(iwp) :: max_street_id = 0 !< upper bound of main street IDs (OpenStreetMaps) for parameterized mode
390	INTEGER(iwp) :: nbins_aerosol = 1 !< total number of size bins
391	INTEGER(iwp) :: ncc = 1 !< number of chemical components used
392	INTEGER(iwp) :: ncomponents_mass = 1 !< total number of chemical compounds (ncc+1)
393	!< if particle water is advected)
394	INTEGER(iwp) :: nj3 = 1 !< J3 parametrization (nucleation)
395	!< 1 = condensational sink (Kerminen&Kulmala, 2002)
396	!< 2 = coagulational sink (Lehtinen et al. 2007)
397	!< 3 = coagS+self-coagulation (Anttila et al. 2010)
398	INTEGER(iwp) :: nsnucl = 0 !< Choice of the nucleation scheme:
399	!< 0 = off
400	!< 1 = binary nucleation
401	!< 2 = activation type nucleation
402	!< 3 = kinetic nucleation
403	!< 4 = ternary nucleation
404	!< 5 = nucleation with ORGANICs
405	!< 6 = activation type of nucleation with H2SO4+ORG
406	!< 7 = heteromolecular nucleation with H2SO4*ORG
407	!< 8 = homomolecular nucleation of H2SO4
408	!< + heteromolecular nucleation with H2SO4*ORG
409	!< 9 = homomolecular nucleation of H2SO4 and ORG
410	!< + heteromolecular nucleation with H2SO4*ORG
411	INTEGER(iwp) :: salsa_pr_count = 0 !< counter for salsa variable profiles
412	INTEGER(iwp) :: side_street_id = 0 !< lower bound of side street IDs (OpenStreetMaps) for parameterized mode
413	INTEGER(iwp) :: start_subrange_1a = 1 !< start index for bin subranges: subrange 1a
414	INTEGER(iwp) :: start_subrange_2a = 1 !< subrange 2a
415	INTEGER(iwp) :: start_subrange_2b = 1 !< subrange 2b
416
417	INTEGER(iwp), DIMENSION(nreg) :: nbin = (/ 3, 7/) !< Number of size bins per subrange: 1 & 2
418
419	INTEGER(iwp), DIMENSION(ngases_salsa) :: gas_index_chem = (/ 1, 1, 1, 1, 1/) !< gas indices in chemistry_model_mod
420	!< 1 = H2SO4, 2 = HNO3,
421	!< 3 = NH3, 4 = OCNV, 5 = OCSV
422	INTEGER(iwp), DIMENSION(ngases_salsa) :: emission_index_chem !< gas indices in the gas emission file
423	INTEGER(iwp), DIMENSION(99) :: salsa_pr_index = 0 !< index for salsa profiles
424
425	INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE :: k_topo_top !< vertical index of the topography top
426
427	INTEGER(iwp), DIMENSION(:,:,:), ALLOCATABLE :: salsa_advc_flags_s !< flags used to degrade order of advection
428	!< scheme for salsa variables near walls and
429	!< lateral boundaries
430	!
431	!-- SALSA switches:
432	LOGICAL :: advect_particle_water = .TRUE. !< Advect water concentration of particles
433	LOGICAL :: decycle_salsa_lr = .FALSE. !< Undo cyclic boundaries: left and right
434	LOGICAL :: decycle_salsa_ns = .FALSE. !< Undo cyclic boundaries: north and south
435	LOGICAL :: include_emission = .FALSE. !< Include or not emissions
436	LOGICAL :: feedback_to_palm = .FALSE. !< Allow feedback due to condensation of H2O
437	LOGICAL :: nest_salsa = .FALSE. !< Apply nesting for salsa
438	LOGICAL :: no_insoluble = .FALSE. !< Exclude insoluble chemical components
439	LOGICAL :: read_restart_data_salsa = .FALSE. !< Read restart data for salsa
440	LOGICAL :: salsa_gases_from_chem = .FALSE. !< Transfer the gaseous components to SALSA from
441	!< the chemistry model
442	LOGICAL :: van_der_waals_coagc = .FALSE. !< Enhancement of coagulation kernel by van der
443	!< Waals and viscous forces
444	LOGICAL :: write_binary_salsa = .FALSE. !< read binary for salsa
445	!
446	!-- Process switches: nl* is read from the NAMELIST and is NOT changed.
447	!-- ls* is the switch used and will get the value of nl*
448	!-- except for special circumstances (spinup period etc.)
449	LOGICAL :: nlcoag = .FALSE. !< Coagulation master switch
450	LOGICAL :: lscoag = .FALSE. !<
451	LOGICAL :: nlcnd = .FALSE. !< Condensation master switch
452	LOGICAL :: lscnd = .FALSE. !<
453	LOGICAL :: nlcndgas = .FALSE. !< Condensation of precursor gases
454	LOGICAL :: lscndgas = .FALSE. !<
455	LOGICAL :: nlcndh2oae = .FALSE. !< Condensation of H2O on aerosol
456	LOGICAL :: lscndh2oae = .FALSE. !< particles (FALSE -> equilibrium calc.)
457	LOGICAL :: nldepo = .FALSE. !< Deposition master switch
458	LOGICAL :: lsdepo = .FALSE. !<
459	LOGICAL :: nldepo_surf = .FALSE. !< Deposition on vegetation master switch
460	LOGICAL :: lsdepo_surf = .FALSE. !<
461	LOGICAL :: nldepo_pcm = .FALSE. !< Deposition on walls master switch
462	LOGICAL :: lsdepo_pcm = .FALSE. !<
463	LOGICAL :: nldistupdate = .TRUE. !< Size distribution update master switch
464	LOGICAL :: lsdistupdate = .FALSE. !<
465	LOGICAL :: lspartition = .FALSE. !< Partition of HNO3 and NH3
466
467	REAL(wp) :: act_coeff = 1.0E-7_wp !< Activation coefficient (1/s)
468	REAL(wp) :: dt_salsa = 0.00001_wp !< Time step of SALSA
469	REAL(wp) :: emiss_factor_main = 0.0_wp !< relative emission factor for main streets
470	REAL(wp) :: emiss_factor_side = 0.0_wp !< relative emission factor for side streets
471	REAL(wp) :: h2so4_init = nclim !< Init value for sulphuric acid gas
472	REAL(wp) :: hno3_init = nclim !< Init value for nitric acid gas
473	REAL(wp) :: last_salsa_time = 0.0_wp !< previous salsa call
474	REAL(wp) :: next_aero_emission_update = 0.0_wp !< previous emission update
475	REAL(wp) :: next_gas_emission_update = 0.0_wp !< previous emission update
476	REAL(wp) :: nf2a = 1.0_wp !< Number fraction allocated to 2a-bins
477	REAL(wp) :: nh3_init = nclim !< Init value for ammonia gas
478	REAL(wp) :: ocnv_init = nclim !< Init value for non-volatile organic gases
479	REAL(wp) :: ocsv_init = nclim !< Init value for semi-volatile organic gases
480	REAL(wp) :: rhlim = 1.20_wp !< RH limit in %/100. Prevents unrealistical RH
481	REAL(wp) :: skip_time_do_salsa = 0.0_wp !< Starting time of SALSA (s)
482	!
483	!-- Initial log-normal size distribution: mode diameter (dpg, metres),
484	!-- standard deviation (sigmag) and concentration (n_lognorm, #/m3)
485	REAL(wp), DIMENSION(nmod) :: dpg = &
486	(/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/)
487	REAL(wp), DIMENSION(nmod) :: sigmag = &
488	(/1.8_wp, 2.16_wp, 2.21_wp, 2.0_wp, 2.0_wp, 2.0_wp, 2.0_wp/)
489	REAL(wp), DIMENSION(nmod) :: n_lognorm = &
490	(/1.04e+11_wp, 3.23E+10_wp, 5.4E+6_wp, 0.0_wp, 0.0_wp, 0.0_wp, 0.0_wp/)
491	!
492	!-- Initial mass fractions / chemical composition of the size distribution
493	REAL(wp), DIMENSION(maxspec) :: mass_fracs_a = & !< mass fractions between
494	(/1.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0/) !< aerosol species for A bins
495	REAL(wp), DIMENSION(maxspec) :: mass_fracs_b = & !< mass fractions between
496	(/0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0/) !< aerosol species for B bins
497	REAL(wp), DIMENSION(nreg+1) :: reglim = & !< Min&max diameters of size subranges
498	(/ 3.0E-9_wp, 5.0E-8_wp, 1.0E-5_wp/)
499	!
500	!-- Initial log-normal size distribution: mode diameter (dpg, metres), standard deviation (sigmag)
501	!-- concentration (n_lognorm, #/m3) and mass fractions of all chemical components (listed in
502	!-- listspec) for both a (soluble) and b (insoluble) bins.
503	REAL(wp), DIMENSION(nmod) :: aerosol_flux_dpg = &
504	(/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/)
505	REAL(wp), DIMENSION(nmod) :: aerosol_flux_sigmag = &
506	(/1.8_wp, 2.16_wp, 2.21_wp, 2.0_wp, 2.0_wp, 2.0_wp, 2.0_wp/)
507	REAL(wp), DIMENSION(maxspec) :: aerosol_flux_mass_fracs_a = &
508	(/1.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0/)
509	REAL(wp), DIMENSION(maxspec) :: aerosol_flux_mass_fracs_b = &
510	(/0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0/)
511	REAL(wp), DIMENSION(nmod) :: surface_aerosol_flux = &
512	(/1.0E+8_wp, 1.0E+9_wp, 1.0E+5_wp, 0.0_wp, 0.0_wp, 0.0_wp, 0.0_wp/)
513
514	REAL(wp), DIMENSION(:), ALLOCATABLE :: bin_low_limits !< to deliver information about
515	!< the lower diameters per bin
516	REAL(wp), DIMENSION(:), ALLOCATABLE :: bc_am_t_val !< vertical gradient of: aerosol mass
517	REAL(wp), DIMENSION(:), ALLOCATABLE :: bc_an_t_val !< of: aerosol number
518	REAL(wp), DIMENSION(:), ALLOCATABLE :: bc_gt_t_val !< salsa gases near domain top
519	REAL(wp), DIMENSION(:), ALLOCATABLE :: gas_emission_time !< Time array in gas emission data (s)
520	REAL(wp), DIMENSION(:), ALLOCATABLE :: nsect !< Background number concentrations
521	REAL(wp), DIMENSION(:), ALLOCATABLE :: massacc !< Mass accomodation coefficients
522	!
523	!-- SALSA derived datatypes:
524	!
525	!-- Component index
526	TYPE component_index
527	CHARACTER(len=3), ALLOCATABLE :: comp(:) !< Component name
528	INTEGER(iwp) :: ncomp !< Number of components
529	INTEGER(iwp), ALLOCATABLE :: ind(:) !< Component index
530	END TYPE component_index
531	!
532	!-- For matching LSM and USM surface types and the deposition module surface types
533	TYPE match_surface
534	INTEGER(iwp), DIMENSION(:), ALLOCATABLE :: match_lupg !< index for pavement / green roofs
535	INTEGER(iwp), DIMENSION(:), ALLOCATABLE :: match_luvw !< index for vegetation / walls
536	INTEGER(iwp), DIMENSION(:), ALLOCATABLE :: match_luww !< index for water / windows
537	END TYPE match_surface
538	!
539	!-- Aerosol emission data attributes
540	TYPE salsa_emission_attribute_type
541
542	CHARACTER(LEN=25) :: units
543
544	CHARACTER(LEN=25), DIMENSION(:), ALLOCATABLE :: cat_name !<
545	CHARACTER(LEN=25), DIMENSION(:), ALLOCATABLE :: cc_name !<
546	CHARACTER(LEN=25), DIMENSION(:), ALLOCATABLE :: unit_time !<
547	CHARACTER(LEN=100), DIMENSION(:), ALLOCATABLE :: var_names !<
548
549	INTEGER(iwp) :: lod = 0 !< level of detail
550	INTEGER(iwp) :: nbins = 10 !< number of aerosol size bins
551	INTEGER(iwp) :: ncat = 0 !< number of emission categories
552	INTEGER(iwp) :: ncc = 7 !< number of aerosol chemical components
553	INTEGER(iwp) :: nhoursyear = 0 !< number of hours: HOURLY mode
554	INTEGER(iwp) :: nmonthdayhour = 0 !< number of month days and hours: MDH mode
555	INTEGER(iwp) :: num_vars !< number of variables
556	INTEGER(iwp) :: nt = 0 !< number of time steps
557	INTEGER(iwp) :: nz = 0 !< number of vertical levels
558	INTEGER(iwp) :: tind !< time index for reference time in salsa emission data
559
560	INTEGER(iwp), DIMENSION(maxspec) :: cc_in2mod = 0 !<
561
562	INTEGER(iwp), DIMENSION(:), ALLOCATABLE :: cat_index !< Index of emission categories
563	INTEGER(iwp), DIMENSION(:), ALLOCATABLE :: cc_index !< Index of chemical components
564
565	REAL(wp) :: conversion_factor !< unit conversion factor for aerosol emissions
566
567	REAL(wp), DIMENSION(:), ALLOCATABLE :: dmid !< mean diameters of size bins (m)
568	REAL(wp), DIMENSION(:), ALLOCATABLE :: rho !< average density (kg/m3)
569	REAL(wp), DIMENSION(:), ALLOCATABLE :: time !< time (s)
570	REAL(wp), DIMENSION(:), ALLOCATABLE :: time_factor !< emission time factor
571	REAL(wp), DIMENSION(:), ALLOCATABLE :: z !< height (m)
572
573	REAL(wp), DIMENSION(:,:), ALLOCATABLE :: etf !< emission time factor
574	REAL(wp), DIMENSION(:,:), ALLOCATABLE :: stack_height
575
576	END TYPE salsa_emission_attribute_type
577	!
578	!-- The default size distribution and mass composition per emission category:
579	!-- 1 = traffic, 2 = road dust, 3 = wood combustion, 4 = other
580	!-- Mass fractions: H2SO4, OC, BC, DU, SS, HNO3, NH3
581	TYPE salsa_emission_mode_type
582
583	INTEGER(iwp) :: ndm = 3 !< number of default modes
584	INTEGER(iwp) :: ndc = 4 !< number of default categories
585
586	CHARACTER(LEN=25), DIMENSION(1:4) :: cat_name_table = (/'traffic exhaust', &
587	'road dust ', &
588	'wood combustion', &
589	'other '/)
590
591	INTEGER(iwp), DIMENSION(1:4) :: cat_input_to_model !<
592
593	REAL(wp), DIMENSION(1:3) :: dpg_table = (/ 13.5E-9_wp, 1.4E-6_wp, 5.4E-8_wp/) !<
594	REAL(wp), DIMENSION(1:3) :: ntot_table !<
595	REAL(wp), DIMENSION(1:3) :: sigmag_table = (/ 1.6_wp, 1.4_wp, 1.7_wp /) !<
596
597	REAL(wp), DIMENSION(1:maxspec,1:4) :: mass_frac_table = & !<
598	RESHAPE( (/ 0.04_wp, 0.48_wp, 0.48_wp, 0.0_wp, 0.0_wp, 0.0_wp, 0.0_wp, &
599	0.0_wp, 0.05_wp, 0.0_wp, 0.95_wp, 0.0_wp, 0.0_wp, 0.0_wp, &
600	0.0_wp, 0.5_wp, 0.5_wp, 0.0_wp, 0.0_wp, 0.0_wp, 0.0_wp, &
601	0.0_wp, 0.5_wp, 0.5_wp, 0.0_wp, 0.0_wp, 0.0_wp, 0.0_wp &
602	/), (/maxspec,4/) )
603
604	REAL(wp), DIMENSION(1:3,1:4) :: pm_frac_table = & !< rel. mass
605	RESHAPE( (/ 0.016_wp, 0.000_wp, 0.984_wp, &
606	0.000_wp, 1.000_wp, 0.000_wp, &
607	0.000_wp, 0.000_wp, 1.000_wp, &
608	1.000_wp, 0.000_wp, 1.000_wp &
609	/), (/3,4/) )
610
611	END TYPE salsa_emission_mode_type
612	!
613	!-- Aerosol emission data values
614	TYPE salsa_emission_value_type
615
616	REAL(wp) :: fill !< fill value
617
618	REAL(wp), DIMENSION(:), ALLOCATABLE :: preproc_mass_fracs !< mass fractions
619
620	REAL(wp), DIMENSION(:,:), ALLOCATABLE :: def_mass_fracs !< mass fractions per emis. category
621
622	REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: def_data !< surface emission values in PM
623	REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: preproc_data !< surface emission values per bin
624
625	END TYPE salsa_emission_value_type
626	!
627	!-- Prognostic variable: Aerosol size bin information (number (#/m3) and mass (kg/m3) concentration)
628	!-- and the concentration of gaseous tracers (#/m3). Gas tracers are contained sequentially in
629	!-- dimension 4 as:
630	!-- 1. H2SO4, 2. HNO3, 3. NH3, 4. OCNV (non-volatile organics), 5. OCSV (semi-volatile)
631	TYPE salsa_variable
632
633	REAL(wp), DIMENSION(:), ALLOCATABLE :: init !<
634
635	REAL(wp), DIMENSION(:,:), ALLOCATABLE :: diss_s !<
636	REAL(wp), DIMENSION(:,:), ALLOCATABLE :: flux_s !<
637	REAL(wp), DIMENSION(:,:), ALLOCATABLE :: source !<
638	REAL(wp), DIMENSION(:,:), ALLOCATABLE :: sums_ws_l !<
639
640	REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: diss_l !<
641	REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: flux_l !<
642
643	REAL(wp), DIMENSION(:,:,:), POINTER, CONTIGUOUS :: conc !<
644	REAL(wp), DIMENSION(:,:,:), POINTER, CONTIGUOUS :: conc_p !<
645	REAL(wp), DIMENSION(:,:,:), POINTER, CONTIGUOUS :: tconc_m !<
646
647	END TYPE salsa_variable
648	!
649	!-- Datatype used to store information about the binned size distributions of aerosols
650	TYPE t_section
651
652	REAL(wp) :: dmid !< bin middle diameter (m)
653	REAL(wp) :: vhilim !< bin volume at the high limit
654	REAL(wp) :: vlolim !< bin volume at the low limit
655	REAL(wp) :: vratiohi !< volume ratio between the center and high limit
656	REAL(wp) :: vratiolo !< volume ratio between the center and low limit
657	!******************************************************
658	! ^ Do NOT change the stuff above after initialization !
659	!******************************************************
660	REAL(wp) :: core !< Volume of dry particle
661	REAL(wp) :: dwet !< Wet diameter or mean droplet diameter (m)
662	REAL(wp) :: numc !< Number concentration of particles/droplets (#/m3)
663	REAL(wp) :: veqh2o !< Equilibrium H2O concentration for each particle
664
665	REAL(wp), DIMENSION(maxspec+1) :: volc !< Volume concentrations (m^3/m^3) of aerosols +
666	!< water. Since most of the stuff in SALSA is hard
667	!< coded, these have to be in the order
668	!< 1:SO4, 2:OC, 3:BC, 4:DU, 5:SS, 6:NO, 7:NH, 8:H2O
669	END TYPE t_section
670
671	TYPE(salsa_emission_attribute_type) :: aero_emission_att !< emission attributes
672	TYPE(salsa_emission_value_type) :: aero_emission !< emission values
673	TYPE(salsa_emission_mode_type) :: def_modes !< default emission modes
674
675	TYPE(chem_emis_att_type) :: chem_emission_att !< chemistry emission attributes
676
677	TYPE(chem_emis_val_type), DIMENSION(:), ALLOCATABLE :: chem_emission !< chemistry emissions
678
679	TYPE(t_section), DIMENSION(:), ALLOCATABLE :: aero !< local aerosol properties
680
681	TYPE(match_surface) :: lsm_to_depo_h !< to match the deposition module and horizontal LSM surfaces
682	TYPE(match_surface) :: usm_to_depo_h !< to match the deposition module and horizontal USM surfaces
683
684	TYPE(match_surface), DIMENSION(0:3) :: lsm_to_depo_v !< to match the deposition mod. and vertical LSM surfaces
685	TYPE(match_surface), DIMENSION(0:3) :: usm_to_depo_v !< to match the deposition mod. and vertical USM surfaces
686	!
687	!-- SALSA variables: as x = x(k,j,i,bin).
688	!-- The 4th dimension contains all the size bins sequentially for each aerosol species + water.
689	!
690	!-- Prognostic variables:
691	!
692	!-- Number concentration (#/m3)
693	TYPE(salsa_variable), DIMENSION(:), ALLOCATABLE, TARGET :: aerosol_number !<
694	REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE, TARGET :: nconc_1 !<
695	REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE, TARGET :: nconc_2 !<
696	REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE, TARGET :: nconc_3 !<
697	!
698	!-- Mass concentration (kg/m3)
699	TYPE(salsa_variable), DIMENSION(:), ALLOCATABLE, TARGET :: aerosol_mass !<
700	REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE, TARGET :: mconc_1 !<
701	REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE, TARGET :: mconc_2 !<
702	REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE, TARGET :: mconc_3 !<
703	!
704	!-- Gaseous concentrations (#/m3)
705	TYPE(salsa_variable), DIMENSION(:), ALLOCATABLE, TARGET :: salsa_gas !<
706	REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE, TARGET :: gconc_1 !<
707	REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE, TARGET :: gconc_2 !<
708	REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE, TARGET :: gconc_3 !<
709	!
710	!-- Diagnostic tracers
711	REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE :: sedim_vd !< sedimentation velocity per bin (m/s)
712	REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE :: ra_dry !< aerosol dry radius (m)
713
714	!-- Particle component index tables
715	TYPE(component_index) :: prtcl !< Contains "getIndex" which gives the index for a given aerosol
716	!< component name: 1:SO4, 2:OC, 3:BC, 4:DU, 5:SS, 6:NO, 7:NH, 8:H2O
717	!
718	!-- Data output arrays:
719	!
720	!-- Gases:
721	REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET :: g_h2so4_av !< H2SO4
722	REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET :: g_hno3_av !< HNO3
723	REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET :: g_nh3_av !< NH3
724	REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET :: g_ocnv_av !< non-volatile OC
725	REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET :: g_ocsv_av !< semi-volatile OC
726	!
727	!-- Integrated:
728	REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET :: ldsa_av !< lung-deposited surface area
729	REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET :: ntot_av !< total number concentration
730	REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET :: nufp_av !< ultrafine particles (UFP)
731	REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET :: pm01_av !< PM0.1
732	REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET :: pm25_av !< PM2.5
733	REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET :: pm10_av !< PM10
734	!
735	!-- In the particle phase:
736	REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET :: s_bc_av !< black carbon
737	REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET :: s_du_av !< dust
738	REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET :: s_h2o_av !< liquid water
739	REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET :: s_nh_av !< ammonia
740	REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET :: s_no_av !< nitrates
741	REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET :: s_oc_av !< org. carbon
742	REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET :: s_so4_av !< sulphates
743	REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET :: s_ss_av !< sea salt
744	!
745	!-- Bin specific mass and number concentrations:
746	REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE, TARGET :: mbins_av !< bin mas
747	REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE, TARGET :: nbins_av !< bin number
748
749	!
750	!-- PALM interfaces:
751
752	INTERFACE salsa_actions
753	MODULE PROCEDURE salsa_actions
754	MODULE PROCEDURE salsa_actions_ij
755	END INTERFACE salsa_actions
756
757	INTERFACE salsa_3d_data_averaging
758	MODULE PROCEDURE salsa_3d_data_averaging
759	END INTERFACE salsa_3d_data_averaging
760
761	INTERFACE salsa_boundary_conds
762	MODULE PROCEDURE salsa_boundary_conds
763	MODULE PROCEDURE salsa_boundary_conds_decycle
764	END INTERFACE salsa_boundary_conds
765
766	INTERFACE salsa_check_data_output
767	MODULE PROCEDURE salsa_check_data_output
768	END INTERFACE salsa_check_data_output
769
770	INTERFACE salsa_check_data_output_pr
771	MODULE PROCEDURE salsa_check_data_output_pr
772	END INTERFACE salsa_check_data_output_pr
773
774	INTERFACE salsa_check_parameters
775	MODULE PROCEDURE salsa_check_parameters
776	END INTERFACE salsa_check_parameters
777
778	INTERFACE salsa_data_output_2d
779	MODULE PROCEDURE salsa_data_output_2d
780	END INTERFACE salsa_data_output_2d
781
782	INTERFACE salsa_data_output_3d
783	MODULE PROCEDURE salsa_data_output_3d
784	END INTERFACE salsa_data_output_3d
785
786	INTERFACE salsa_data_output_mask
787	MODULE PROCEDURE salsa_data_output_mask
788	END INTERFACE salsa_data_output_mask
789
790	INTERFACE salsa_define_netcdf_grid
791	MODULE PROCEDURE salsa_define_netcdf_grid
792	END INTERFACE salsa_define_netcdf_grid
793
794	INTERFACE salsa_driver
795	MODULE PROCEDURE salsa_driver
796	END INTERFACE salsa_driver
797
798	INTERFACE salsa_emission_update
799	MODULE PROCEDURE salsa_emission_update
800	END INTERFACE salsa_emission_update
801
802	INTERFACE salsa_exchange_horiz_bounds
803	MODULE PROCEDURE salsa_exchange_horiz_bounds
804	END INTERFACE salsa_exchange_horiz_bounds
805
806	INTERFACE salsa_header
807	MODULE PROCEDURE salsa_header
808	END INTERFACE salsa_header
809
810	INTERFACE salsa_init
811	MODULE PROCEDURE salsa_init
812	END INTERFACE salsa_init
813
814	INTERFACE salsa_init_arrays
815	MODULE PROCEDURE salsa_init_arrays
816	END INTERFACE salsa_init_arrays
817
818	INTERFACE salsa_non_advective_processes
819	MODULE PROCEDURE salsa_non_advective_processes
820	MODULE PROCEDURE salsa_non_advective_processes_ij
821	END INTERFACE salsa_non_advective_processes
822
823	INTERFACE salsa_parin
824	MODULE PROCEDURE salsa_parin
825	END INTERFACE salsa_parin
826
827	INTERFACE salsa_prognostic_equations
828	MODULE PROCEDURE salsa_prognostic_equations
829	MODULE PROCEDURE salsa_prognostic_equations_ij
830	END INTERFACE salsa_prognostic_equations
831
832	INTERFACE salsa_rrd_local
833	MODULE PROCEDURE salsa_rrd_local
834	END INTERFACE salsa_rrd_local
835
836	INTERFACE salsa_statistics
837	MODULE PROCEDURE salsa_statistics
838	END INTERFACE salsa_statistics
839
840	INTERFACE salsa_swap_timelevel
841	MODULE PROCEDURE salsa_swap_timelevel
842	END INTERFACE salsa_swap_timelevel
843
844	INTERFACE salsa_tendency
845	MODULE PROCEDURE salsa_tendency
846	MODULE PROCEDURE salsa_tendency_ij
847	END INTERFACE salsa_tendency
848
849	INTERFACE salsa_wrd_local
850	MODULE PROCEDURE salsa_wrd_local
851	END INTERFACE salsa_wrd_local
852
853
854	SAVE
855
856	PRIVATE
857	!
858	!-- Public functions:
859	PUBLIC salsa_boundary_conds, salsa_check_data_output, salsa_check_parameters, &
860	salsa_3d_data_averaging, salsa_data_output_2d, salsa_data_output_3d, &
861	salsa_data_output_mask, salsa_define_netcdf_grid, salsa_diagnostics, salsa_driver, &
862	salsa_emission_update, salsa_header, salsa_init, salsa_init_arrays, salsa_parin, &
863	salsa_rrd_local, salsa_swap_timelevel, salsa_prognostic_equations, salsa_wrd_local, &
864	salsa_actions, salsa_non_advective_processes, salsa_exchange_horiz_bounds, &
865	salsa_check_data_output_pr, salsa_statistics
866	!
867	!-- Public parameters, constants and initial values
868	PUBLIC bc_am_t_val, bc_an_t_val, bc_gt_t_val, dots_salsa, dt_salsa, &
869	ibc_salsa_b, last_salsa_time, lsdepo, nest_salsa, salsa, salsa_gases_from_chem, &
870	skip_time_do_salsa
871	!
872	!-- Public prognostic variables
873	PUBLIC aerosol_mass, aerosol_number, gconc_2, mconc_2, nbins_aerosol, ncc, ncomponents_mass, &
874	nclim, nconc_2, ngases_salsa, prtcl, ra_dry, salsa_gas, sedim_vd
875
876
877	CONTAINS
878
879	!------------------------------------------------------------------------------!
880	! Description:
881	! ------------
882	!> Parin for &salsa_par for new modules
883	!------------------------------------------------------------------------------!
884	SUBROUTINE salsa_parin
885
886	USE control_parameters, &
887	ONLY: data_output_pr
888
889	IMPLICIT NONE
890
891	CHARACTER(LEN=80) :: line !< dummy string that contains the current line of parameter file
892
893	INTEGER(iwp) :: i !< loop index
894	INTEGER(iwp) :: max_pr_salsa_tmp !< dummy variable
895
896	NAMELIST /salsa_parameters/ aerosol_flux_dpg, &
897	aerosol_flux_mass_fracs_a, &
898	aerosol_flux_mass_fracs_b, &
899	aerosol_flux_sigmag, &
900	advect_particle_water, &
901	bc_salsa_b, &
902	bc_salsa_t, &
903	decycle_salsa_lr, &
904	decycle_method_salsa, &
905	decycle_salsa_ns, &
906	depo_pcm_par, &
907	depo_pcm_type, &
908	depo_surf_par, &
909	dpg, &
910	dt_salsa, &
911	emiss_factor_main, &
912	emiss_factor_side, &
913	feedback_to_palm, &
914	h2so4_init, &
915	hno3_init, &
916	init_gases_type, &
917	init_aerosol_type, &
918	listspec, &
919	main_street_id, &
920	mass_fracs_a, &
921	mass_fracs_b, &
922	max_street_id, &
923	n_lognorm, &
924	nbin, &
925	nest_salsa, &
926	nf2a, &
927	nh3_init, &
928	nj3, &
929	nlcnd, &
930	nlcndgas, &
931	nlcndh2oae, &
932	nlcoag, &
933	nldepo, &
934	nldepo_pcm, &
935	nldepo_surf, &
936	nldistupdate, &
937	nsnucl, &
938	ocnv_init, &
939	ocsv_init, &
940	read_restart_data_salsa, &
941	reglim, &
942	salsa, &
943	salsa_emission_mode, &
944	sigmag, &
945	side_street_id, &
946	skip_time_do_salsa, &
947	surface_aerosol_flux, &
948	van_der_waals_coagc, &
949	write_binary_salsa
950
951	line = ' '
952	!
953	!-- Try to find salsa package
954	REWIND ( 11 )
955	line = ' '
956	DO WHILE ( INDEX( line, '&salsa_parameters' ) == 0 )
957	READ ( 11, '(A)', END=10 ) line
958	ENDDO
959	BACKSPACE ( 11 )
960	!
961	!-- Read user-defined namelist
962	READ ( 11, salsa_parameters )
963	!
964	!-- Enable salsa (salsa switch in modules.f90)
965	salsa = .TRUE.
966
967	10 CONTINUE
968	!
969	!-- Update the number of output profiles
970	max_pr_salsa_tmp = 0
971	i = 1
972	DO WHILE ( data_output_pr(i) /= ' ' .AND. i <= 100 )
973	IF ( TRIM( data_output_pr(i)(1:6) ) == 'salsa_' ) max_pr_salsa_tmp = max_pr_salsa_tmp + 1
974	i = i + 1
975	ENDDO
976	IF ( max_pr_salsa_tmp > 0 ) max_pr_salsa = max_pr_salsa_tmp
977
978	END SUBROUTINE salsa_parin
979
980	!------------------------------------------------------------------------------!
981	! Description:
982	! ------------
983	!> Check parameters routine for salsa.
984	!------------------------------------------------------------------------------!
985	SUBROUTINE salsa_check_parameters
986
987	USE control_parameters, &
988	ONLY: humidity
989
990	IMPLICIT NONE
991
992	!
993	!-- Checks go here (cf. check_parameters.f90).
994	IF ( salsa .AND. .NOT. humidity ) THEN
995	WRITE( message_string, * ) 'salsa = ', salsa, ' is not allowed with humidity = ', humidity
996	CALL message( 'salsa_check_parameters', 'PA0594', 1, 2, 0, 6, 0 )
997	ENDIF
998
999	IF ( bc_salsa_b == 'dirichlet' ) THEN
1000	ibc_salsa_b = 0
1001	ELSEIF ( bc_salsa_b == 'neumann' ) THEN
1002	ibc_salsa_b = 1
1003	ELSE
1004	message_string = 'unknown boundary condition: bc_salsa_b = "' // TRIM( bc_salsa_t ) // '"'
1005	CALL message( 'salsa_check_parameters', 'PA0595', 1, 2, 0, 6, 0 )
1006	ENDIF
1007
1008	IF ( bc_salsa_t == 'dirichlet' ) THEN
1009	ibc_salsa_t = 0
1010	ELSEIF ( bc_salsa_t == 'neumann' ) THEN
1011	ibc_salsa_t = 1
1012	ELSEIF ( bc_salsa_t == 'nested' ) THEN
1013	ibc_salsa_t = 2
1014	ELSE
1015	message_string = 'unknown boundary condition: bc_salsa_t = "' // TRIM( bc_salsa_t ) // '"'
1016	CALL message( 'salsa_check_parameters', 'PA0596', 1, 2, 0, 6, 0 )
1017	ENDIF
1018
1019	IF ( nj3 < 1 .OR. nj3 > 3 ) THEN
1020	message_string = 'unknown nj3 (must be 1-3)'
1021	CALL message( 'salsa_check_parameters', 'PA0597', 1, 2, 0, 6, 0 )
1022	ENDIF
1023
1024	IF ( salsa_emission_mode /= 'no_emission' .AND. ibc_salsa_b == 0 ) THEN
1025	message_string = 'salsa_emission_mode /= "no_emission" requires bc_salsa_b = "Neumann"'
1026	CALL message( 'salsa_check_parameters','PA0598', 1, 2, 0, 6, 0 )
1027	ENDIF
1028
1029	IF ( salsa_emission_mode /= 'no_emission' ) include_emission = .TRUE.
1030
1031	END SUBROUTINE salsa_check_parameters
1032
1033	!------------------------------------------------------------------------------!
1034	!
1035	! Description:
1036	! ------------
1037	!> Subroutine defining appropriate grid for netcdf variables.
1038	!> It is called out from subroutine netcdf.
1039	!> Same grid as for other scalars (see netcdf_interface_mod.f90)
1040	!------------------------------------------------------------------------------!
1041	SUBROUTINE salsa_define_netcdf_grid( var, found, grid_x, grid_y, grid_z )
1042
1043	IMPLICIT NONE
1044
1045	CHARACTER(LEN=*), INTENT(OUT) :: grid_x !<
1046	CHARACTER(LEN=*), INTENT(OUT) :: grid_y !<
1047	CHARACTER(LEN=*), INTENT(OUT) :: grid_z !<
1048	CHARACTER(LEN=*), INTENT(IN) :: var !<
1049
1050	LOGICAL, INTENT(OUT) :: found !<
1051
1052	found = .TRUE.
1053	!
1054	!-- Check for the grid
1055
1056	IF ( var(1:6) == 'salsa_' ) THEN ! same grid for all salsa output variables
1057	grid_x = 'x'
1058	grid_y = 'y'
1059	grid_z = 'zu'
1060	ELSE
1061	found = .FALSE.
1062	grid_x = 'none'
1063	grid_y = 'none'
1064	grid_z = 'none'
1065	ENDIF
1066
1067	END SUBROUTINE salsa_define_netcdf_grid
1068
1069	!------------------------------------------------------------------------------!
1070	! Description:
1071	! ------------
1072	!> Header output for new module
1073	!------------------------------------------------------------------------------!
1074	SUBROUTINE salsa_header( io )
1075
1076	USE indices, &
1077	ONLY: nx, ny, nz
1078
1079	IMPLICIT NONE
1080
1081	INTEGER(iwp), INTENT(IN) :: io !< Unit of the output file
1082	!
1083	!-- Write SALSA header
1084	WRITE( io, 1 )
1085	WRITE( io, 2 ) skip_time_do_salsa
1086	WRITE( io, 3 ) dt_salsa
1087	WRITE( io, 4 ) nz, ny, nx, nbins_aerosol
1088	IF ( advect_particle_water ) THEN
1089	WRITE( io, 5 ) SHAPE( aerosol_mass(1)%conc ), ncomponents_mass*nbins_aerosol, &
1090	advect_particle_water
1091	ELSE
1092	WRITE( io, 5 ) SHAPE( aerosol_mass(1)%conc ), ncc*nbins_aerosol, advect_particle_water
1093	ENDIF
1094	IF ( .NOT. salsa_gases_from_chem ) THEN
1095	WRITE( io, 6 ) SHAPE( aerosol_mass(1)%conc ), ngases_salsa, salsa_gases_from_chem
1096	ENDIF
1097	WRITE( io, 7 )
1098	IF ( nsnucl > 0 ) WRITE( io, 8 ) nsnucl, nj3
1099	IF ( nlcoag ) WRITE( io, 9 )
1100	IF ( nlcnd ) WRITE( io, 10 ) nlcndgas, nlcndh2oae
1101	IF ( lspartition ) WRITE( io, 11 )
1102	IF ( nldepo ) WRITE( io, 12 ) nldepo_pcm, nldepo_surf
1103	WRITE( io, 13 ) reglim, nbin, bin_low_limits
1104	IF ( init_aerosol_type == 0 ) WRITE( io, 14 ) nsect
1105	WRITE( io, 15 ) ncc, listspec, mass_fracs_a, mass_fracs_b
1106	IF ( .NOT. salsa_gases_from_chem ) THEN
1107	WRITE( io, 16 ) ngases_salsa, h2so4_init, hno3_init, nh3_init, ocnv_init, ocsv_init
1108	ENDIF
1109	WRITE( io, 17 ) init_aerosol_type, init_gases_type
1110	IF ( init_aerosol_type == 0 ) THEN
1111	WRITE( io, 18 ) dpg, sigmag, n_lognorm
1112	ELSE
1113	WRITE( io, 19 )
1114	ENDIF
1115	IF ( nest_salsa ) WRITE( io, 20 ) nest_salsa
1116	WRITE( io, 21 ) salsa_emission_mode
1117	IF ( salsa_emission_mode == 'uniform' ) THEN
1118	WRITE( io, 22 ) surface_aerosol_flux, aerosol_flux_dpg, aerosol_flux_sigmag, &
1119	aerosol_flux_mass_fracs_a
1120	ENDIF
1121	IF ( SUM( aerosol_flux_mass_fracs_b ) > 0.0_wp .OR. salsa_emission_mode == 'read_from_file' ) &
1122	THEN
1123	WRITE( io, 23 )
1124	ENDIF
1125
1126	1 FORMAT (//' SALSA information:'/ &
1127	' ------------------------------'/)
1128	2 FORMAT (' Starts at: skip_time_do_salsa = ', F10.2, ' s')
1129	3 FORMAT (/' Timestep: dt_salsa = ', F6.2, ' s')
1130	4 FORMAT (/' Array shape (z,y,x,bins):'/ &
1131	' aerosol_number: ', 4(I3))
1132	5 FORMAT (/' aerosol_mass: ', 4(I3),/ &
1133	' (advect_particle_water = ', L1, ')')
1134	6 FORMAT (' salsa_gas: ', 4(I3),/ &
1135	' (salsa_gases_from_chem = ', L1, ')')
1136	7 FORMAT (/' Aerosol dynamic processes included: ')
1137	8 FORMAT (/' nucleation (scheme = ', I1, ' and J3 parametrization = ', I1, ')')
1138	9 FORMAT (/' coagulation')
1139	10 FORMAT (/' condensation (of precursor gases = ', L1, ' and water vapour = ', L1, ')' )
1140	11 FORMAT (/' dissolutional growth by HNO3 and NH3')
1141	12 FORMAT (/' dry deposition (on vegetation = ', L1, ' and on topography = ', L1, ')')
1142	13 FORMAT (/' Aerosol bin subrange limits (in metres): ', 3(ES10.2E3), / &
1143	' Number of size bins for each aerosol subrange: ', 2I3,/ &
1144	' Aerosol bin limits (in metres): ', 9(ES10.2E3))
1145	14 FORMAT (' Initial number concentration in bins at the lowest level (#/m**3):', 9(ES10.2E3))
1146	15 FORMAT (/' Number of chemical components used: ', I1,/ &
1147	' Species: ',7(A6),/ &
1148	' Initial relative contribution of each species to particle volume in:',/ &
1149	' a-bins: ', 7(F6.3),/ &
1150	' b-bins: ', 7(F6.3))
1151	16 FORMAT (/' Number of gaseous tracers used: ', I1,/ &
1152	' Initial gas concentrations:',/ &
1153	' H2SO4: ',ES12.4E3, ' #/m**3',/ &
1154	' HNO3: ',ES12.4E3, ' #/m**3',/ &
1155	' NH3: ',ES12.4E3, ' #/m**3',/ &
1156	' OCNV: ',ES12.4E3, ' #/m**3',/ &
1157	' OCSV: ',ES12.4E3, ' #/m**3')
1158	17 FORMAT (/' Initialising concentrations: ', / &
1159	' Aerosol size distribution: init_aerosol_type = ', I1,/ &
1160	' Gas concentrations: init_gases_type = ', I1 )
1161	18 FORMAT ( ' Mode diametres: dpg(nmod) = ', 7(F7.3), ' (m)', / &
1162	' Standard deviation: sigmag(nmod) = ', 7(F7.2),/ &
1163	' Number concentration: n_lognorm(nmod) = ', 7(ES12.4E3), ' (#/m3)' )
1164	19 FORMAT (/' Size distribution read from a file.')
1165	20 FORMAT (/' Nesting for salsa variables: ', L1 )
1166	21 FORMAT (/' Emissions: salsa_emission_mode = ', A )
1167	22 FORMAT (/' surface_aerosol_flux = ', ES12.4E3, ' #/m**2/s', / &
1168	' aerosol_flux_dpg = ', 7(F7.3), ' (m)', / &
1169	' aerosol_flux_sigmag = ', 7(F7.2), / &
1170	' aerosol_mass_fracs_a = ', 7(ES12.4E3) )
1171	23 FORMAT (/' (currently all emissions are soluble!)')
1172
1173	END SUBROUTINE salsa_header
1174
1175	!------------------------------------------------------------------------------!
1176	! Description:
1177	! ------------
1178	!> Allocate SALSA arrays and define pointers if required
1179	!------------------------------------------------------------------------------!
1180	SUBROUTINE salsa_init_arrays
1181
1182	USE advec_ws, &
1183	ONLY: ws_init_flags_scalar
1184
1185	USE surface_mod, &
1186	ONLY: surf_def_h, surf_def_v, surf_lsm_h, surf_lsm_v, surf_usm_h, surf_usm_v
1187
1188	IMPLICIT NONE
1189
1190	INTEGER(iwp) :: gases_available !< Number of available gas components in the chemistry model
1191	INTEGER(iwp) :: i !< loop index for allocating
1192	INTEGER(iwp) :: ii !< index for indexing chemical components
1193	INTEGER(iwp) :: l !< loop index for allocating: surfaces
1194	INTEGER(iwp) :: lsp !< loop index for chem species in the chemistry model
1195
1196	gases_available = 0
1197	!
1198	!-- Allocate prognostic variables (see salsa_swap_timelevel)
1199	!
1200	!-- Set derived indices:
1201	!-- (This does the same as the subroutine salsa_initialize in SALSA/UCLALES-SALSA)
1202	start_subrange_1a = 1 ! 1st index of subrange 1a
1203	start_subrange_2a = start_subrange_1a + nbin(1) ! 1st index of subrange 2a
1204	end_subrange_1a = start_subrange_2a - 1 ! last index of subrange 1a
1205	end_subrange_2a = end_subrange_1a + nbin(2) ! last index of subrange 2a
1206
1207	!
1208	!-- If the fraction of insoluble aerosols in subrange 2 is zero: do not allocate arrays for them
1209	IF ( nf2a > 0.999999_wp .AND. SUM( mass_fracs_b ) < 0.00001_wp ) THEN
1210	no_insoluble = .TRUE.
1211	start_subrange_2b = end_subrange_2a+1 ! 1st index of subrange 2b
1212	end_subrange_2b = end_subrange_2a ! last index of subrange 2b
1213	ELSE
1214	start_subrange_2b = start_subrange_2a + nbin(2) ! 1st index of subrange 2b
1215	end_subrange_2b = end_subrange_2a + nbin(2) ! last index of subrange 2b
1216	ENDIF
1217
1218	nbins_aerosol = end_subrange_2b ! total number of aerosol size bins
1219	!
1220	!-- Create index tables for different aerosol components
1221	CALL component_index_constructor( prtcl, ncc, maxspec, listspec )
1222
1223	ncomponents_mass = ncc
1224	IF ( advect_particle_water ) ncomponents_mass = ncc + 1 ! Add water
1225	!
1226	!-- Indices for chemical components used (-1 = not used)
1227	ii = 0
1228	IF ( is_used( prtcl, 'SO4' ) ) THEN
1229	index_so4 = get_index( prtcl,'SO4' )
1230	ii = ii + 1
1231	ENDIF
1232	IF ( is_used( prtcl,'OC' ) ) THEN
1233	index_oc = get_index(prtcl, 'OC')
1234	ii = ii + 1
1235	ENDIF
1236	IF ( is_used( prtcl, 'BC' ) ) THEN
1237	index_bc = get_index( prtcl, 'BC' )
1238	ii = ii + 1
1239	ENDIF
1240	IF ( is_used( prtcl, 'DU' ) ) THEN
1241	index_du = get_index( prtcl, 'DU' )
1242	ii = ii + 1
1243	ENDIF
1244	IF ( is_used( prtcl, 'SS' ) ) THEN
1245	index_ss = get_index( prtcl, 'SS' )
1246	ii = ii + 1
1247	ENDIF
1248	IF ( is_used( prtcl, 'NO' ) ) THEN
1249	index_no = get_index( prtcl, 'NO' )
1250	ii = ii + 1
1251	ENDIF
1252	IF ( is_used( prtcl, 'NH' ) ) THEN
1253	index_nh = get_index( prtcl, 'NH' )
1254	ii = ii + 1
1255	ENDIF
1256	!
1257	!-- All species must be known
1258	IF ( ii /= ncc ) THEN
1259	message_string = 'Unknown aerosol species/component(s) given in the initialization'
1260	CALL message( 'salsa_mod: salsa_init', 'PA0600', 1, 2, 0, 6, 0 )
1261	ENDIF
1262	!
1263	!-- Allocate:
1264	ALLOCATE( aero(nbins_aerosol), bc_am_t_val(nbins_aerosol*ncomponents_mass), &
1265	bc_an_t_val(nbins_aerosol), bc_gt_t_val(ngases_salsa), bin_low_limits(nbins_aerosol),&
1266	nsect(nbins_aerosol), massacc(nbins_aerosol) )
1267	ALLOCATE( k_topo_top(nysg:nyng,nxlg:nxrg) )
1268	IF ( nldepo ) ALLOCATE( sedim_vd(nzb:nzt+1,nysg:nyng,nxlg:nxrg,nbins_aerosol) )
1269	ALLOCATE( ra_dry(nzb:nzt+1,nysg:nyng,nxlg:nxrg,nbins_aerosol) )
1270	!
1271	!-- Initialise the sectional particle size distribution
1272	CALL set_sizebins
1273	!
1274	!-- Aerosol number concentration
1275	ALLOCATE( aerosol_number(nbins_aerosol) )
1276	ALLOCATE( nconc_1(nzb:nzt+1,nysg:nyng,nxlg:nxrg,nbins_aerosol), &
1277	nconc_2(nzb:nzt+1,nysg:nyng,nxlg:nxrg,nbins_aerosol), &
1278	nconc_3(nzb:nzt+1,nysg:nyng,nxlg:nxrg,nbins_aerosol) )
1279	nconc_1 = 0.0_wp
1280	nconc_2 = 0.0_wp
1281	nconc_3 = 0.0_wp
1282
1283	DO i = 1, nbins_aerosol
1284	aerosol_number(i)%conc(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => nconc_1(:,:,:,i)
1285	aerosol_number(i)%conc_p(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => nconc_2(:,:,:,i)
1286	aerosol_number(i)%tconc_m(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => nconc_3(:,:,:,i)
1287	ALLOCATE( aerosol_number(i)%flux_s(nzb+1:nzt,0:threads_per_task-1), &
1288	aerosol_number(i)%diss_s(nzb+1:nzt,0:threads_per_task-1), &
1289	aerosol_number(i)%flux_l(nzb+1:nzt,nys:nyn,0:threads_per_task-1), &
1290	aerosol_number(i)%diss_l(nzb+1:nzt,nys:nyn,0:threads_per_task-1), &
1291	aerosol_number(i)%init(nzb:nzt+1), &
1292	aerosol_number(i)%sums_ws_l(nzb:nzt+1,0:threads_per_task-1) )
1293	aerosol_number(i)%init = nclim
1294	IF ( include_emission .OR. ( nldepo .AND. nldepo_surf ) ) THEN
1295	ALLOCATE( aerosol_number(i)%source(nys:nyn,nxl:nxr) )
1296	aerosol_number(i)%source = 0.0_wp
1297	ENDIF
1298	ENDDO
1299
1300	!
1301	!-- Aerosol mass concentration
1302	ALLOCATE( aerosol_mass(ncomponents_mass*nbins_aerosol) )
1303	ALLOCATE( mconc_1(nzb:nzt+1,nysg:nyng,nxlg:nxrg,ncomponents_mass*nbins_aerosol), &
1304	mconc_2(nzb:nzt+1,nysg:nyng,nxlg:nxrg,ncomponents_mass*nbins_aerosol), &
1305	mconc_3(nzb:nzt+1,nysg:nyng,nxlg:nxrg,ncomponents_mass*nbins_aerosol) )
1306	mconc_1 = 0.0_wp
1307	mconc_2 = 0.0_wp
1308	mconc_3 = 0.0_wp
1309
1310	DO i = 1, ncomponents_mass*nbins_aerosol
1311	aerosol_mass(i)%conc(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => mconc_1(:,:,:,i)
1312	aerosol_mass(i)%conc_p(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => mconc_2(:,:,:,i)
1313	aerosol_mass(i)%tconc_m(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => mconc_3(:,:,:,i)
1314	ALLOCATE( aerosol_mass(i)%flux_s(nzb+1:nzt,0:threads_per_task-1), &
1315	aerosol_mass(i)%diss_s(nzb+1:nzt,0:threads_per_task-1), &
1316	aerosol_mass(i)%flux_l(nzb+1:nzt,nys:nyn,0:threads_per_task-1), &
1317	aerosol_mass(i)%diss_l(nzb+1:nzt,nys:nyn,0:threads_per_task-1), &
1318	aerosol_mass(i)%init(nzb:nzt+1), &
1319	aerosol_mass(i)%sums_ws_l(nzb:nzt+1,0:threads_per_task-1) )
1320	aerosol_mass(i)%init = mclim
1321	IF ( include_emission .OR. ( nldepo .AND. nldepo_surf ) ) THEN
1322	ALLOCATE( aerosol_mass(i)%source(nys:nyn,nxl:nxr) )
1323	aerosol_mass(i)%source = 0.0_wp
1324	ENDIF
1325	ENDDO
1326
1327	!
1328	!-- Surface fluxes: answs = aerosol number, amsws = aerosol mass
1329	!
1330	!-- Horizontal surfaces: default type
1331	DO l = 0, 2 ! upward (l=0), downward (l=1) and model top (l=2)
1332	ALLOCATE( surf_def_h(l)%answs( 1:surf_def_h(l)%ns, nbins_aerosol ) )
1333	ALLOCATE( surf_def_h(l)%amsws( 1:surf_def_h(l)%ns, nbins_aerosol*ncomponents_mass ) )
1334	surf_def_h(l)%answs = 0.0_wp
1335	surf_def_h(l)%amsws = 0.0_wp
1336	ENDDO
1337	!
1338	!-- Horizontal surfaces: natural type
1339	ALLOCATE( surf_lsm_h%answs( 1:surf_lsm_h%ns, nbins_aerosol ) )
1340	ALLOCATE( surf_lsm_h%amsws( 1:surf_lsm_h%ns, nbins_aerosol*ncomponents_mass ) )
1341	surf_lsm_h%answs = 0.0_wp
1342	surf_lsm_h%amsws = 0.0_wp
1343	!
1344	!-- Horizontal surfaces: urban type
1345	ALLOCATE( surf_usm_h%answs( 1:surf_usm_h%ns, nbins_aerosol ) )
1346	ALLOCATE( surf_usm_h%amsws( 1:surf_usm_h%ns, nbins_aerosol*ncomponents_mass ) )
1347	surf_usm_h%answs = 0.0_wp
1348	surf_usm_h%amsws = 0.0_wp
1349
1350	!
1351	!-- Vertical surfaces: northward (l=0), southward (l=1), eastward (l=2) and westward (l=3) facing
1352	DO l = 0, 3
1353	ALLOCATE( surf_def_v(l)%answs( 1:surf_def_v(l)%ns, nbins_aerosol ) )
1354	surf_def_v(l)%answs = 0.0_wp
1355	ALLOCATE( surf_def_v(l)%amsws( 1:surf_def_v(l)%ns, nbins_aerosol*ncomponents_mass ) )
1356	surf_def_v(l)%amsws = 0.0_wp
1357
1358	ALLOCATE( surf_lsm_v(l)%answs( 1:surf_lsm_v(l)%ns, nbins_aerosol ) )
1359	surf_lsm_v(l)%answs = 0.0_wp
1360	ALLOCATE( surf_lsm_v(l)%amsws( 1:surf_lsm_v(l)%ns, nbins_aerosol*ncomponents_mass ) )
1361	surf_lsm_v(l)%amsws = 0.0_wp
1362
1363	ALLOCATE( surf_usm_v(l)%answs( 1:surf_usm_v(l)%ns, nbins_aerosol ) )
1364	surf_usm_v(l)%answs = 0.0_wp
1365	ALLOCATE( surf_usm_v(l)%amsws( 1:surf_usm_v(l)%ns, nbins_aerosol*ncomponents_mass ) )
1366	surf_usm_v(l)%amsws = 0.0_wp
1367
1368	ENDDO
1369
1370	!
1371	!-- Concentration of gaseous tracers (1. SO4, 2. HNO3, 3. NH3, 4. OCNV, 5. OCSV)
1372	!-- (number concentration (#/m3) )
1373	!
1374	!-- If chemistry is on, read gas phase concentrations from there. Otherwise,
1375	!-- allocate salsa_gas array.
1376
1377	IF ( air_chemistry ) THEN
1378	DO lsp = 1, nvar
1379	SELECT CASE ( TRIM( chem_species(lsp)%name ) )
1380	CASE ( 'H2SO4', 'h2so4' )
1381	gases_available = gases_available + 1
1382	gas_index_chem(1) = lsp
1383	CASE ( 'HNO3', 'hno3' )
1384	gases_available = gases_available + 1
1385	gas_index_chem(2) = lsp
1386	CASE ( 'NH3', 'nh3' )
1387	gases_available = gases_available + 1
1388	gas_index_chem(3) = lsp
1389	CASE ( 'OCNV', 'ocnv' )
1390	gases_available = gases_available + 1
1391	gas_index_chem(4) = lsp
1392	CASE ( 'OCSV', 'ocsv' )
1393	gases_available = gases_available + 1
1394	gas_index_chem(5) = lsp
1395	END SELECT
1396	ENDDO
1397
1398	IF ( gases_available == ngases_salsa ) THEN
1399	salsa_gases_from_chem = .TRUE.
1400	ELSE
1401	WRITE( message_string, * ) 'SALSA is run together with chemistry but not all gaseous '// &
1402	'components are provided by kpp (H2SO4, HNO3, NH3, OCNV, OCSV)'
1403	CALL message( 'check_parameters', 'PA0599', 1, 2, 0, 6, 0 )
1404	ENDIF
1405
1406	ELSE
1407
1408	ALLOCATE( salsa_gas(ngases_salsa) )
1409	ALLOCATE( gconc_1(nzb:nzt+1,nysg:nyng,nxlg:nxrg,ngases_salsa), &
1410	gconc_2(nzb:nzt+1,nysg:nyng,nxlg:nxrg,ngases_salsa), &
1411	gconc_3(nzb:nzt+1,nysg:nyng,nxlg:nxrg,ngases_salsa) )
1412	gconc_1 = 0.0_wp
1413	gconc_2 = 0.0_wp
1414	gconc_3 = 0.0_wp
1415
1416	DO i = 1, ngases_salsa
1417	salsa_gas(i)%conc(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => gconc_1(:,:,:,i)
1418	salsa_gas(i)%conc_p(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => gconc_2(:,:,:,i)
1419	salsa_gas(i)%tconc_m(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => gconc_3(:,:,:,i)
1420	ALLOCATE( salsa_gas(i)%flux_s(nzb+1:nzt,0:threads_per_task-1), &
1421	salsa_gas(i)%diss_s(nzb+1:nzt,0:threads_per_task-1), &
1422	salsa_gas(i)%flux_l(nzb+1:nzt,nys:nyn,0:threads_per_task-1),&
1423	salsa_gas(i)%diss_l(nzb+1:nzt,nys:nyn,0:threads_per_task-1),&
1424	salsa_gas(i)%init(nzb:nzt+1), &
1425	salsa_gas(i)%sums_ws_l(nzb:nzt+1,0:threads_per_task-1) )
1426	salsa_gas(i)%init = nclim
1427	IF ( include_emission ) THEN
1428	ALLOCATE( salsa_gas(i)%source(nys:nys,nxl:nxr) )
1429	salsa_gas(i)%source = 0.0_wp
1430	ENDIF
1431	ENDDO
1432	!
1433	!-- Surface fluxes: gtsws = gaseous tracer flux
1434	!
1435	!-- Horizontal surfaces: default type
1436	DO l = 0, 2 ! upward (l=0), downward (l=1) and model top (l=2)
1437	ALLOCATE( surf_def_h(l)%gtsws( 1:surf_def_h(l)%ns, ngases_salsa ) )
1438	surf_def_h(l)%gtsws = 0.0_wp
1439	ENDDO
1440	!-- Horizontal surfaces: natural type
1441	ALLOCATE( surf_lsm_h%gtsws( 1:surf_lsm_h%ns, ngases_salsa ) )
1442	surf_lsm_h%gtsws = 0.0_wp
1443	!-- Horizontal surfaces: urban type
1444	ALLOCATE( surf_usm_h%gtsws( 1:surf_usm_h%ns, ngases_salsa ) )
1445	surf_usm_h%gtsws = 0.0_wp
1446	!
1447	!-- Vertical surfaces: northward (l=0), southward (l=1), eastward (l=2) and
1448	!-- westward (l=3) facing
1449	DO l = 0, 3
1450	ALLOCATE( surf_def_v(l)%gtsws( 1:surf_def_v(l)%ns, ngases_salsa ) )
1451	surf_def_v(l)%gtsws = 0.0_wp
1452	ALLOCATE( surf_lsm_v(l)%gtsws( 1:surf_lsm_v(l)%ns, ngases_salsa ) )
1453	surf_lsm_v(l)%gtsws = 0.0_wp
1454	ALLOCATE( surf_usm_v(l)%gtsws( 1:surf_usm_v(l)%ns, ngases_salsa ) )
1455	surf_usm_v(l)%gtsws = 0.0_wp
1456	ENDDO
1457	ENDIF
1458
1459	IF ( ws_scheme_sca ) THEN
1460
1461	IF ( salsa ) THEN
1462	ALLOCATE( sums_salsa_ws_l(nzb:nzt+1,0:threads_per_task-1) )
1463	sums_salsa_ws_l = 0.0_wp
1464	ENDIF
1465
1466	ENDIF
1467	!
1468	!-- Set control flags for decycling only at lateral boundary cores. Within the inner cores the
1469	!-- decycle flag is set to .FALSE.. Even though it does not affect the setting of chemistry boundary
1470	!-- conditions, this flag is used to set advection control flags appropriately.
1471	decycle_salsa_lr = MERGE( decycle_salsa_lr, .FALSE., nxl == 0 .OR. nxr == nx )
1472	decycle_salsa_ns = MERGE( decycle_salsa_ns, .FALSE., nys == 0 .OR. nyn == ny )
1473	!
1474	!-- Decycling can be applied separately for aerosol variables, while wind and other scalars may have
1475	!-- cyclic or nested boundary conditions. However, large gradients near the boundaries may produce
1476	!-- stationary numerical oscillations near the lateral boundaries when a higher-order scheme is
1477	!-- applied near these boundaries. To get rid-off this, set-up additional flags that control the
1478	!-- order of the scalar advection scheme near the lateral boundaries for passive scalars with
1479	!-- decycling.
1480	IF ( scalar_advec == 'ws-scheme' ) THEN
1481	ALLOCATE( salsa_advc_flags_s(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
1482	!
1483	!-- In case of decycling, set Neuman boundary conditions for wall_flags_0 bit 31 instead of
1484	!-- cyclic boundary conditions. Bit 31 is used to identify extended degradation zones (please see
1485	!-- the following comment). Note, since several also other modules may access this bit but may
1486	!-- have other boundary conditions, the original value of wall_flags_0 bit 31 must not be
1487	!-- modified. Hence, store the boundary conditions directly on salsa_advc_flags_s.
1488	!-- salsa_advc_flags_s will be later overwritten in ws_init_flags_scalar and bit 31 won't be used
1489	!-- to control the numerical order.
1490	!-- Initialize with flag 31 only.
1491	salsa_advc_flags_s = 0
1492	salsa_advc_flags_s = MERGE( IBSET( salsa_advc_flags_s, 31 ), 0, BTEST( wall_flags_0, 31 ) )
1493
1494	IF ( decycle_salsa_ns ) THEN
1495	IF ( nys == 0 ) THEN
1496	DO i = 1, nbgp
1497	salsa_advc_flags_s(:,nys-i,:) = MERGE( IBSET( salsa_advc_flags_s(:,nys,:), 31 ), &
1498	IBCLR( salsa_advc_flags_s(:,nys,:), 31 ), &
1499	BTEST( salsa_advc_flags_s(:,nys,:), 31 ) )
1500	ENDDO
1501	ENDIF
1502	IF ( nyn == ny ) THEN
1503	DO i = 1, nbgp
1504	salsa_advc_flags_s(:,nyn+i,:) = MERGE( IBSET( salsa_advc_flags_s(:,nyn,:), 31 ), &
1505	IBCLR( salsa_advc_flags_s(:,nyn,:), 31 ), &
1506	BTEST( salsa_advc_flags_s(:,nyn,:), 31 ) )
1507	ENDDO
1508	ENDIF
1509	ENDIF
1510	IF ( decycle_salsa_lr ) THEN
1511	IF ( nxl == 0 ) THEN
1512	DO i = 1, nbgp
1513	salsa_advc_flags_s(:,:,nxl-i) = MERGE( IBSET( salsa_advc_flags_s(:,:,nxl), 31 ), &
1514	IBCLR( salsa_advc_flags_s(:,:,nxl), 31 ), &
1515	BTEST( salsa_advc_flags_s(:,:,nxl), 31 ) )
1516	ENDDO
1517	ENDIF
1518	IF ( nxr == nx ) THEN
1519	DO i = 1, nbgp
1520	salsa_advc_flags_s(:,:,nxr+i) = MERGE( IBSET( salsa_advc_flags_s(:,:,nxr), 31 ), &
1521	IBCLR( salsa_advc_flags_s(:,:,nxr), 31 ), &
1522	BTEST( salsa_advc_flags_s(:,:,nxr), 31 ) )
1523	ENDDO
1524	ENDIF
1525	ENDIF
1526	!
1527	!-- To initialise the advection flags appropriately, pass the boundary flags to
1528	!-- ws_init_flags_scalar. The last argument in ws_init_flags_scalar indicates that a passive
1529	!-- scalar is being treated and the horizontal advection terms are degraded already 2 grid points
1530	!-- before the lateral boundary. Also, extended degradation zones are applied, where
1531	!-- horizontal advection of scalars is discretised by the first-order scheme at all grid points
1532	!-- in the vicinity of buildings (<= 3 grid points). Even though no building is within the
1533	!-- numerical stencil, the first-order scheme is used. At fourth and fifth grid points, the order
1534	!-- of the horizontal advection scheme is successively upgraded.
1535	!-- These degradations of the advection scheme are done to avoid stationary numerical
1536	!-- oscillations, which are responsible for high concentration maxima that may appear e.g. under
1537	!-- shear-free stable conditions.
1538	CALL ws_init_flags_scalar( bc_dirichlet_l .OR. bc_radiation_l .OR. decycle_salsa_lr, &
1539	bc_dirichlet_n .OR. bc_radiation_n .OR. decycle_salsa_ns, &
1540	bc_dirichlet_r .OR. bc_radiation_r .OR. decycle_salsa_lr, &
1541	bc_dirichlet_s .OR. bc_radiation_s .OR. decycle_salsa_ns, &
1542	salsa_advc_flags_s, .TRUE. )
1543	ENDIF
1544
1545
1546	END SUBROUTINE salsa_init_arrays
1547
1548	!------------------------------------------------------------------------------!
1549	! Description:
1550	! ------------
1551	!> Initialization of SALSA. Based on salsa_initialize in UCLALES-SALSA.
1552	!> Subroutines salsa_initialize, SALSAinit and DiagInitAero in UCLALES-SALSA are
1553	!> also merged here.
1554	!------------------------------------------------------------------------------!
1555	SUBROUTINE salsa_init
1556
1557	IMPLICIT NONE
1558
1559	INTEGER(iwp) :: i !<
1560	INTEGER(iwp) :: ib !< loop index for aerosol number bins
1561	INTEGER(iwp) :: ic !< loop index for aerosol mass bins
1562	INTEGER(iwp) :: ig !< loop index for gases
1563	INTEGER(iwp) :: j !<
1564
1565	IF ( debug_output ) CALL debug_message( 'salsa_init', 'start' )
1566
1567	bin_low_limits = 0.0_wp
1568	k_topo_top = 0
1569	nsect = 0.0_wp
1570	massacc = 1.0_wp
1571	!
1572	!-- Initialise
1573	IF ( nldepo ) sedim_vd = 0.0_wp
1574
1575	IF ( .NOT. salsa_gases_from_chem ) THEN
1576	IF ( .NOT. read_restart_data_salsa ) THEN
1577	salsa_gas(1)%conc = h2so4_init
1578	salsa_gas(2)%conc = hno3_init
1579	salsa_gas(3)%conc = nh3_init
1580	salsa_gas(4)%conc = ocnv_init
1581	salsa_gas(5)%conc = ocsv_init
1582	ENDIF
1583	DO ig = 1, ngases_salsa
1584	salsa_gas(ig)%conc_p = 0.0_wp
1585	salsa_gas(ig)%tconc_m = 0.0_wp
1586	salsa_gas(ig)%flux_s = 0.0_wp
1587	salsa_gas(ig)%diss_s = 0.0_wp
1588	salsa_gas(ig)%flux_l = 0.0_wp
1589	salsa_gas(ig)%diss_l = 0.0_wp
1590	salsa_gas(ig)%sums_ws_l = 0.0_wp
1591	salsa_gas(ig)%conc_p = salsa_gas(ig)%conc
1592	ENDDO
1593	!
1594	!-- Set initial value for gas compound tracer
1595	salsa_gas(1)%init = h2so4_init
1596	salsa_gas(2)%init = hno3_init
1597	salsa_gas(3)%init = nh3_init
1598	salsa_gas(4)%init = ocnv_init
1599	salsa_gas(5)%init = ocsv_init
1600	ENDIF
1601	!
1602	!-- Aerosol radius in each bin: dry and wet (m)
1603	ra_dry = 1.0E-10_wp
1604	!
1605	!-- Initialise location-dependent aerosol size distributions and chemical compositions:
1606	CALL aerosol_init
1607
1608	!-- Initalisation run of SALSA + calculate the vertical top index of the topography
1609	DO i = nxl, nxr
1610	DO j = nys, nyn
1611
1612	k_topo_top(j,i) = MAXLOC( MERGE( 1, 0, BTEST( wall_flags_0(:,j,i), 12 ) ), DIM = 1 ) - 1
1613
1614	CALL salsa_driver( i, j, 1 )
1615	CALL salsa_diagnostics( i, j )
1616	ENDDO
1617	ENDDO
1618
1619	DO ib = 1, nbins_aerosol
1620	aerosol_number(ib)%conc_p = aerosol_number(ib)%conc
1621	aerosol_number(ib)%tconc_m = 0.0_wp
1622	aerosol_number(ib)%flux_s = 0.0_wp
1623	aerosol_number(ib)%diss_s = 0.0_wp
1624	aerosol_number(ib)%flux_l = 0.0_wp
1625	aerosol_number(ib)%diss_l = 0.0_wp
1626	aerosol_number(ib)%sums_ws_l = 0.0_wp
1627	ENDDO
1628	DO ic = 1, ncomponents_mass*nbins_aerosol
1629	aerosol_mass(ic)%conc_p = aerosol_mass(ic)%conc
1630	aerosol_mass(ic)%tconc_m = 0.0_wp
1631	aerosol_mass(ic)%flux_s = 0.0_wp
1632	aerosol_mass(ic)%diss_s = 0.0_wp
1633	aerosol_mass(ic)%flux_l = 0.0_wp
1634	aerosol_mass(ic)%diss_l = 0.0_wp
1635	aerosol_mass(ic)%sums_ws_l = 0.0_wp
1636	ENDDO
1637	!
1638	!
1639	!-- Initialise the deposition scheme and surface types
1640	IF ( nldepo ) CALL init_deposition
1641
1642	IF ( include_emission ) THEN
1643	!
1644	!-- Read in and initialize emissions
1645	CALL salsa_emission_setup( .TRUE. )
1646	IF ( .NOT. salsa_gases_from_chem .AND. salsa_emission_mode == 'read_from_file' ) THEN
1647	CALL salsa_gas_emission_setup( .TRUE. )
1648	ENDIF
1649	ENDIF
1650	!
1651	!-- Partition and dissolutional growth by gaseous HNO3 and NH3
1652	IF ( index_no > 0 .AND. index_nh > 0 .AND. index_so4 > 0 ) lspartition = .TRUE.
1653
1654	IF ( debug_output ) CALL debug_message( 'salsa_init', 'end' )
1655
1656	END SUBROUTINE salsa_init
1657
1658	!------------------------------------------------------------------------------!
1659	! Description:
1660	! ------------
1661	!> Initializes particle size distribution grid by calculating size bin limits
1662	!> and mid-size for dry particles in each bin. Called from salsa_initialize
1663	!> (only at the beginning of simulation).
1664	!> Size distribution described using:
1665	!> 1) moving center method (subranges 1 and 2)
1666	!> (Jacobson, Atmos. Env., 31, 131-144, 1997)
1667	!> 2) fixed sectional method (subrange 3)
1668	!> Size bins in each subrange are spaced logarithmically
1669	!> based on given subrange size limits and bin number.
1670	!
1671	!> Mona changed 06/2017: Use geometric mean diameter to describe the mean
1672	!> particle diameter in a size bin, not the arithmeric mean which clearly
1673	!> overestimates the total particle volume concentration.
1674	!
1675	!> Coded by:
1676	!> Hannele Korhonen (FMI) 2005
1677	!> Harri Kokkola (FMI) 2006
1678	!
1679	!> Bug fixes for box model + updated for the new aerosol datatype:
1680	!> Juha Tonttila (FMI) 2014
1681	!------------------------------------------------------------------------------!
1682	SUBROUTINE set_sizebins
1683
1684	IMPLICIT NONE
1685
1686	INTEGER(iwp) :: cc !< running index
1687	INTEGER(iwp) :: dd !< running index
1688
1689	REAL(wp) :: ratio_d !< ratio of the upper and lower diameter of subranges
1690
1691	aero(:)%dwet = 1.0E-10_wp
1692	aero(:)%veqh2o = 1.0E-10_wp
1693	aero(:)%numc = nclim
1694	aero(:)%core = 1.0E-10_wp
1695	DO cc = 1, maxspec+1 ! 1:SO4, 2:OC, 3:BC, 4:DU, 5:SS, 6:NO, 7:NH, 8:H2O
1696	aero(:)%volc(cc) = 0.0_wp
1697	ENDDO
1698	!
1699	!-- vlolim&vhilim: min & max dry volumes [fxm]
1700	!-- dmid: bin mid dry diameter (m)
1701	!-- vratiolo&vratiohi: volume ratio between the center and low/high limit
1702	!
1703	!-- 1) Size subrange 1:
1704	ratio_d = reglim(2) / reglim(1) ! section spacing (m)
1705	DO cc = start_subrange_1a, end_subrange_1a
1706	aero(cc)%vlolim = api6 * ( reglim(1) * ratio_d( REAL( cc-1 ) / nbin(1) ) )3
1707	aero(cc)%vhilim = api6 * ( reglim(1) * ratio_d( REAL( cc ) / nbin(1) ) )3
1708	aero(cc)%dmid = SQRT( ( aero(cc)%vhilim / api6 )*0.33333333_wp &
1709	( aero(cc)%vlolim / api6 )**0.33333333_wp )
1710	aero(cc)%vratiohi = aero(cc)%vhilim / ( api6 * aero(cc)%dmid**3 )
1711	aero(cc)%vratiolo = aero(cc)%vlolim / ( api6 * aero(cc)%dmid**3 )
1712	ENDDO
1713	!
1714	!-- 2) Size subrange 2:
1715	!-- 2.1) Sub-subrange 2a: high hygroscopicity
1716	ratio_d = reglim(3) / reglim(2) ! section spacing
1717	DO dd = start_subrange_2a, end_subrange_2a
1718	cc = dd - start_subrange_2a
1719	aero(dd)%vlolim = api6 * ( reglim(2) * ratio_d( REAL( cc ) / nbin(2) ) )3
1720	aero(dd)%vhilim = api6 * ( reglim(2) * ratio_d( REAL( cc+1 ) / nbin(2) ) )3
1721	aero(dd)%dmid = SQRT( ( aero(dd)%vhilim / api6 )*0.33333333_wp &
1722	( aero(dd)%vlolim / api6 )**0.33333333_wp )
1723	aero(dd)%vratiohi = aero(dd)%vhilim / ( api6 * aero(dd)%dmid**3 )
1724	aero(dd)%vratiolo = aero(dd)%vlolim / ( api6 * aero(dd)%dmid**3 )
1725	ENDDO
1726	!
1727	!-- 2.2) Sub-subrange 2b: low hygroscopicity
1728	IF ( .NOT. no_insoluble ) THEN
1729	aero(start_subrange_2b:end_subrange_2b)%vlolim = aero(start_subrange_2a:end_subrange_2a)%vlolim
1730	aero(start_subrange_2b:end_subrange_2b)%vhilim = aero(start_subrange_2a:end_subrange_2a)%vhilim
1731	aero(start_subrange_2b:end_subrange_2b)%dmid = aero(start_subrange_2a:end_subrange_2a)%dmid
1732	aero(start_subrange_2b:end_subrange_2b)%vratiohi = aero(start_subrange_2a:end_subrange_2a)%vratiohi
1733	aero(start_subrange_2b:end_subrange_2b)%vratiolo = aero(start_subrange_2a:end_subrange_2a)%vratiolo
1734	ENDIF
1735	!
1736	!-- Initialize the wet diameter with the bin dry diameter to avoid numerical problems later
1737	aero(:)%dwet = aero(:)%dmid
1738	!
1739	!-- Save bin limits (lower diameter) to be delivered to PALM if needed
1740	DO cc = 1, nbins_aerosol
1741	bin_low_limits(cc) = ( aero(cc)%vlolim / api6 )**0.33333333_wp
1742	ENDDO
1743
1744	END SUBROUTINE set_sizebins
1745
1746	!------------------------------------------------------------------------------!
1747	! Description:
1748	! ------------
1749	!> Initilize altitude-dependent aerosol size distributions and compositions.
1750	!>
1751	!> Mona added 06/2017: Correct the number and mass concentrations by normalizing
1752	!< by the given total number and mass concentration.
1753	!>
1754	!> Tomi Raatikainen, FMI, 29.2.2016
1755	!------------------------------------------------------------------------------!
1756	SUBROUTINE aerosol_init
1757
1758	USE netcdf_data_input_mod, &
1759	ONLY: check_existence, close_input_file, get_attribute, get_variable, &
1760	inquire_num_variables, inquire_variable_names, &
1761	netcdf_data_input_get_dimension_length, open_read_file
1762
1763	IMPLICIT NONE
1764
1765	CHARACTER(LEN=25), DIMENSION(:), ALLOCATABLE :: cc_name !< chemical component name
1766	CHARACTER(LEN=100), DIMENSION(:), ALLOCATABLE :: var_names !< variable names
1767
1768	INTEGER(iwp) :: ee !< index: end
1769	INTEGER(iwp) :: i !< loop index: x-direction
1770	INTEGER(iwp) :: ib !< loop index: size bins
1771	INTEGER(iwp) :: ic !< loop index: chemical components
1772	INTEGER(iwp) :: id_dyn !< NetCDF id of PIDS_DYNAMIC_SALSA
1773	INTEGER(iwp) :: ig !< loop index: gases
1774	INTEGER(iwp) :: j !< loop index: y-direction
1775	INTEGER(iwp) :: k !< loop index: z-direction
1776	INTEGER(iwp) :: lod_aero !< level of detail of inital aerosol concentrations
1777	INTEGER(iwp) :: num_vars !< number of variables
1778	INTEGER(iwp) :: pr_nbins !< number of aerosol size bins in file
1779	INTEGER(iwp) :: pr_ncc !< number of aerosol chemical components in file
1780	INTEGER(iwp) :: pr_nz !< number of vertical grid-points in file
1781	INTEGER(iwp) :: prunmode !< running mode of SALSA
1782	INTEGER(iwp) :: ss !< index: start
1783
1784	INTEGER(iwp), DIMENSION(maxspec) :: cc_in2mod
1785
1786	LOGICAL :: netcdf_extend = .FALSE. !< Flag: netcdf file exists
1787
1788	REAL(wp) :: flag !< flag to mask topography grid points
1789
1790	REAL(wp), DIMENSION(nbins_aerosol) :: core !< size of the bin mid aerosol particle
1791
1792	REAL(wp), DIMENSION(0:nz+1) :: pnf2a !< number fraction in 2a
1793	REAL(wp), DIMENSION(0:nz+1) :: pmfoc1a !< mass fraction of OC in 1a
1794
1795	REAL(wp), DIMENSION(0:nz+1,nbins_aerosol) :: pndist !< vertical profile of size dist. (#/m3)
1796	REAL(wp), DIMENSION(0:nz+1,maxspec) :: pmf2a !< mass distributions in subrange 2a
1797	REAL(wp), DIMENSION(0:nz+1,maxspec) :: pmf2b !< mass distributions in subrange 2b
1798
1799	REAL(wp), DIMENSION(:), ALLOCATABLE :: pr_dmid !< vertical profile of aerosol bin diameters
1800	REAL(wp), DIMENSION(:), ALLOCATABLE :: pr_z !< z levels of profiles
1801
1802	REAL(wp), DIMENSION(:,:), ALLOCATABLE :: pr_mass_fracs_a !< mass fraction: a
1803	REAL(wp), DIMENSION(:,:), ALLOCATABLE :: pr_mass_fracs_b !< and b
1804
1805	cc_in2mod = 0
1806	prunmode = 1
1807	!
1808	!-- Bin mean aerosol particle volume (m3)
1809	core(1:nbins_aerosol) = api6 * aero(1:nbins_aerosol)%dmid**3
1810	!
1811	!-- Set concentrations to zero
1812	pndist(:,:) = 0.0_wp
1813	pnf2a(:) = nf2a
1814	pmf2a(:,:) = 0.0_wp
1815	pmf2b(:,:) = 0.0_wp
1816	pmfoc1a(:) = 0.0_wp
1817
1818	IF ( init_aerosol_type == 1 ) THEN
1819	!
1820	!-- Read input profiles from PIDS_DYNAMIC_SALSA
1821	#if defined( __netcdf )
1822	!
1823	!-- Location-dependent size distributions and compositions.
1824	INQUIRE( FILE = TRIM( input_file_dynamic ) // TRIM( coupling_char ), EXIST = netcdf_extend )
1825	IF ( netcdf_extend ) THEN
1826	!
1827	!-- Open file in read-only mode
1828	CALL open_read_file( TRIM( input_file_dynamic ) // TRIM( coupling_char ), id_dyn )
1829	!
1830	!-- At first, inquire all variable names
1831	CALL inquire_num_variables( id_dyn, num_vars )
1832	!
1833	!-- Allocate memory to store variable names
1834	ALLOCATE( var_names(1:num_vars) )
1835	CALL inquire_variable_names( id_dyn, var_names )
1836	!
1837	!-- Inquire vertical dimension and number of aerosol chemical components
1838	CALL netcdf_data_input_get_dimension_length( id_dyn, pr_nz, 'z' )
1839	IF ( pr_nz /= nz ) THEN
1840	WRITE( message_string, * ) 'Number of inifor horizontal grid points does not match '//&
1841	'the number of numeric grid points.'
1842	CALL message( 'aerosol_init', 'PA0601', 1, 2, 0, 6, 0 )
1843	ENDIF
1844	CALL netcdf_data_input_get_dimension_length( id_dyn, pr_ncc, 'composition_index' )
1845	!
1846	!-- Allocate memory
1847	ALLOCATE( pr_z(1:pr_nz), pr_mass_fracs_a(nzb:nzt+1,pr_ncc), &
1848	pr_mass_fracs_b(nzb:nzt+1,pr_ncc) )
1849	pr_mass_fracs_a = 0.0_wp
1850	pr_mass_fracs_b = 0.0_wp
1851	!
1852	!-- Read vertical levels
1853	CALL get_variable( id_dyn, 'z', pr_z )
1854	!
1855	!-- Read the names of chemical components
1856	IF ( check_existence( var_names, 'composition_name' ) ) THEN
1857	CALL get_variable( id_dyn, 'composition_name', cc_name, pr_ncc )
1858	ELSE
1859	WRITE( message_string, * ) 'Missing composition_name in ' // TRIM( input_file_dynamic )
1860	CALL message( 'aerosol_init', 'PA0655', 1, 2, 0, 6, 0 )
1861	ENDIF
1862	!
1863	!-- Define the index of each chemical component in the model
1864	DO ic = 1, pr_ncc
1865	SELECT CASE ( TRIM( cc_name(ic) ) )
1866	CASE ( 'H2SO4', 'SO4', 'h2so4', 'so4' )
1867	cc_in2mod(1) = ic
1868	CASE ( 'OC', 'oc' )
1869	cc_in2mod(2) = ic
1870	CASE ( 'BC', 'bc' )
1871	cc_in2mod(3) = ic
1872	CASE ( 'DU', 'du' )
1873	cc_in2mod(4) = ic
1874	CASE ( 'SS', 'ss' )
1875	cc_in2mod(5) = ic
1876	CASE ( 'HNO3', 'hno3', 'NO', 'no' )
1877	cc_in2mod(6) = ic
1878	CASE ( 'NH3', 'nh3', 'NH', 'nh' )
1879	cc_in2mod(7) = ic
1880	END SELECT
1881	ENDDO
1882
1883	IF ( SUM( cc_in2mod ) == 0 ) THEN
1884	message_string = 'None of the aerosol chemical components in ' // TRIM( &
1885	input_file_dynamic ) // ' correspond to ones applied in SALSA.'
1886	CALL message( 'salsa_mod: aerosol_init', 'PA0602', 2, 2, 0, 6, 0 )
1887	ENDIF
1888	!
1889	!-- Vertical profiles of mass fractions of different chemical components:
1890	IF ( check_existence( var_names, 'init_atmosphere_mass_fracs_a' ) ) THEN
1891	CALL get_variable( id_dyn, 'init_atmosphere_mass_fracs_a', pr_mass_fracs_a, &
1892	0, pr_ncc-1, 0, pr_nz-1 )
1893	ELSE
1894	WRITE( message_string, * ) 'Missing init_atmosphere_mass_fracs_a in ' // &
1895	TRIM( input_file_dynamic )
1896	CALL message( 'aerosol_init', 'PA0656', 1, 2, 0, 6, 0 )
1897	ENDIF
1898	CALL get_variable( id_dyn, 'init_atmosphere_mass_fracs_b', pr_mass_fracs_b, &
1899	0, pr_ncc-1, 0, pr_nz-1 )
1900	!
1901	!-- Match the input data with the chemical composition applied in the model
1902	DO ic = 1, maxspec
1903	ss = cc_in2mod(ic)
1904	IF ( ss == 0 ) CYCLE
1905	pmf2a(nzb+1:nzt+1,ic) = pr_mass_fracs_a(nzb:nzt,ss)
1906	pmf2b(nzb+1:nzt+1,ic) = pr_mass_fracs_b(nzb:nzt,ss)
1907	ENDDO
1908	!
1909	!-- Aerosol concentrations: lod=1 (vertical profile of sectional number size distribution)
1910	CALL get_attribute( id_dyn, 'lod', lod_aero, .FALSE., 'init_atmosphere_aerosol' )
1911	IF ( lod_aero /= 1 ) THEN
1912	message_string = 'Currently only lod=1 accepted for init_atmosphere_aerosol'
1913	CALL message( 'salsa_mod: aerosol_init', 'PA0603', 2, 2, 0, 6, 0 )
1914	ELSE
1915	!
1916	!-- Bin mean diameters in the input file
1917	CALL netcdf_data_input_get_dimension_length( id_dyn, pr_nbins, 'Dmid')
1918	IF ( pr_nbins /= nbins_aerosol ) THEN
1919	message_string = 'Number of size bins in init_atmosphere_aerosol does not match ' &
1920	// 'with that applied in the model'
1921	CALL message( 'salsa_mod: aerosol_init', 'PA0604', 2, 2, 0, 6, 0 )
1922	ENDIF
1923
1924	ALLOCATE( pr_dmid(pr_nbins) )
1925	pr_dmid = 0.0_wp
1926
1927	CALL get_variable( id_dyn, 'Dmid', pr_dmid )
1928	!
1929	!-- Check whether the sectional representation conform to the one
1930	!-- applied in the model
1931	IF ( ANY( ABS( ( aero(1:nbins_aerosol)%dmid - pr_dmid ) / &
1932	aero(1:nbins_aerosol)%dmid ) > 0.1_wp ) ) THEN
1933	message_string = 'Mean diameters of the aerosol size bins in ' // TRIM( &
1934	input_file_dynamic ) // ' do not match with the sectional '// &
1935	'representation of the model.'
1936	CALL message( 'salsa_mod: aerosol_init', 'PA0605', 2, 2, 0, 6, 0 )
1937	ENDIF
1938	!
1939	!-- Inital aerosol concentrations
1940	CALL get_variable( id_dyn, 'init_atmosphere_aerosol', pndist(nzb+1:nzt,:), &
1941	0, pr_nbins-1, 0, pr_nz-1 )
1942	ENDIF
1943	!
1944	!-- Set bottom and top boundary condition (Neumann)
1945	pmf2a(nzb,:) = pmf2a(nzb+1,:)
1946	pmf2a(nzt+1,:) = pmf2a(nzt,:)
1947	pmf2b(nzb,:) = pmf2b(nzb+1,:)
1948	pmf2b(nzt+1,:) = pmf2b(nzt,:)
1949	pndist(nzb,:) = pndist(nzb+1,:)
1950	pndist(nzt+1,:) = pndist(nzt,:)
1951
1952	IF ( index_so4 < 0 ) THEN
1953	pmf2a(:,1) = 0.0_wp
1954	pmf2b(:,1) = 0.0_wp
1955	ENDIF
1956	IF ( index_oc < 0 ) THEN
1957	pmf2a(:,2) = 0.0_wp
1958	pmf2b(:,2) = 0.0_wp
1959	ENDIF
1960	IF ( index_bc < 0 ) THEN
1961	pmf2a(:,3) = 0.0_wp
1962	pmf2b(:,3) = 0.0_wp
1963	ENDIF
1964	IF ( index_du < 0 ) THEN
1965	pmf2a(:,4) = 0.0_wp
1966	pmf2b(:,4) = 0.0_wp
1967	ENDIF
1968	IF ( index_ss < 0 ) THEN
1969	pmf2a(:,5) = 0.0_wp
1970	pmf2b(:,5) = 0.0_wp
1971	ENDIF
1972	IF ( index_no < 0 ) THEN
1973	pmf2a(:,6) = 0.0_wp
1974	pmf2b(:,6) = 0.0_wp
1975	ENDIF
1976	IF ( index_nh < 0 ) THEN
1977	pmf2a(:,7) = 0.0_wp
1978	pmf2b(:,7) = 0.0_wp
1979	ENDIF
1980
1981	IF ( SUM( pmf2a ) < 0.00001_wp .AND. SUM( pmf2b ) < 0.00001_wp ) THEN
1982	message_string = 'Error in initialising mass fractions of chemical components. ' // &
1983	'Check that all chemical components are included in parameter file!'
1984	CALL message( 'salsa_mod: aerosol_init', 'PA0606', 2, 2, 0, 6, 0 )
1985	ENDIF
1986	!
1987	!-- Then normalise the mass fraction so that SUM = 1
1988	DO k = nzb, nzt+1
1989	pmf2a(k,:) = pmf2a(k,:) / SUM( pmf2a(k,:) )
1990	IF ( SUM( pmf2b(k,:) ) > 0.0_wp ) pmf2b(k,:) = pmf2b(k,:) / SUM( pmf2b(k,:) )
1991	ENDDO
1992
1993	DEALLOCATE( pr_z, pr_mass_fracs_a, pr_mass_fracs_b )
1994
1995	ELSE
1996	message_string = 'Input file '// TRIM( input_file_dynamic ) // TRIM( coupling_char ) // &
1997	' for SALSA missing!'
1998	CALL message( 'salsa_mod: aerosol_init', 'PA0607', 1, 2, 0, 6, 0 )
1999	!
2000	!-- Close input file
2001	CALL close_input_file( id_dyn )
2002	ENDIF ! netcdf_extend
2003
2004	#else
2005	message_string = 'init_aerosol_type = 1 but preprocessor directive __netcdf is not used '// &
2006	'in compiling!'
2007	CALL message( 'salsa_mod: aerosol_init', 'PA0608', 1, 2, 0, 6, 0 )
2008
2009	#endif
2010
2011	ELSEIF ( init_aerosol_type == 0 ) THEN
2012	!
2013	!-- Mass fractions for species in a and b-bins
2014	IF ( index_so4 > 0 ) THEN
2015	pmf2a(:,1) = mass_fracs_a(index_so4)
2016	pmf2b(:,1) = mass_fracs_b(index_so4)
2017	ENDIF
2018	IF ( index_oc > 0 ) THEN
2019	pmf2a(:,2) = mass_fracs_a(index_oc)
2020	pmf2b(:,2) = mass_fracs_b(index_oc)
2021	ENDIF
2022	IF ( index_bc > 0 ) THEN
2023	pmf2a(:,3) = mass_fracs_a(index_bc)
2024	pmf2b(:,3) = mass_fracs_b(index_bc)
2025	ENDIF
2026	IF ( index_du > 0 ) THEN
2027	pmf2a(:,4) = mass_fracs_a(index_du)
2028	pmf2b(:,4) = mass_fracs_b(index_du)
2029	ENDIF
2030	IF ( index_ss > 0 ) THEN
2031	pmf2a(:,5) = mass_fracs_a(index_ss)
2032	pmf2b(:,5) = mass_fracs_b(index_ss)
2033	ENDIF
2034	IF ( index_no > 0 ) THEN
2035	pmf2a(:,6) = mass_fracs_a(index_no)
2036	pmf2b(:,6) = mass_fracs_b(index_no)
2037	ENDIF
2038	IF ( index_nh > 0 ) THEN
2039	pmf2a(:,7) = mass_fracs_a(index_nh)
2040	pmf2b(:,7) = mass_fracs_b(index_nh)
2041	ENDIF
2042	DO k = nzb, nzt+1
2043	pmf2a(k,:) = pmf2a(k,:) / SUM( pmf2a(k,:) )
2044	IF ( SUM( pmf2b(k,:) ) > 0.0_wp ) pmf2b(k,:) = pmf2b(k,:) / SUM( pmf2b(k,:) )
2045	ENDDO
2046
2047	CALL size_distribution( n_lognorm, dpg, sigmag, nsect )
2048	!
2049	!-- Normalize by the given total number concentration
2050	nsect = nsect * SUM( n_lognorm ) / SUM( nsect )
2051	DO ib = start_subrange_1a, end_subrange_2b
2052	pndist(:,ib) = nsect(ib)
2053	ENDDO
2054	ENDIF
2055
2056	IF ( init_gases_type == 1 ) THEN
2057	!
2058	!-- Read input profiles from PIDS_CHEM
2059	#if defined( __netcdf )
2060	!
2061	!-- Location-dependent size distributions and compositions.
2062	INQUIRE( FILE = TRIM( input_file_dynamic ) // TRIM( coupling_char ), EXIST = netcdf_extend )
2063	IF ( netcdf_extend .AND. .NOT. salsa_gases_from_chem ) THEN
2064	!
2065	!-- Open file in read-only mode
2066	CALL open_read_file( TRIM( input_file_dynamic ) // TRIM( coupling_char ), id_dyn )
2067	!
2068	!-- Inquire dimensions:
2069	CALL netcdf_data_input_get_dimension_length( id_dyn, pr_nz, 'z' )
2070	IF ( pr_nz /= nz ) THEN
2071	WRITE( message_string, * ) 'Number of inifor horizontal grid points does not match '//&
2072	'the number of numeric grid points.'
2073	CALL message( 'aerosol_init', 'PA0609', 1, 2, 0, 6, 0 )
2074	ENDIF
2075	!
2076	!-- Read vertical profiles of gases:
2077	CALL get_variable( id_dyn, 'init_atmosphere_h2so4', salsa_gas(1)%init(nzb+1:nzt) )
2078	CALL get_variable( id_dyn, 'init_atmosphere_hno3', salsa_gas(2)%init(nzb+1:nzt) )
2079	CALL get_variable( id_dyn, 'init_atmosphere_nh3', salsa_gas(3)%init(nzb+1:nzt) )
2080	CALL get_variable( id_dyn, 'init_atmosphere_ocnv', salsa_gas(4)%init(nzb+1:nzt) )
2081	CALL get_variable( id_dyn, 'init_atmosphere_ocsv', salsa_gas(5)%init(nzb+1:nzt) )
2082	!
2083	!-- Set Neumann top and surface boundary condition for initial + initialise concentrations
2084	DO ig = 1, ngases_salsa
2085	salsa_gas(ig)%init(nzb) = salsa_gas(ig)%init(nzb+1)
2086	salsa_gas(ig)%init(nzt+1) = salsa_gas(ig)%init(nzt)
2087	IF ( .NOT. read_restart_data_salsa ) THEN
2088	DO k = nzb, nzt+1
2089	salsa_gas(ig)%conc(k,:,:) = salsa_gas(ig)%init(k)
2090	ENDDO
2091	ENDIF
2092	ENDDO
2093
2094	ELSEIF ( .NOT. netcdf_extend .AND. .NOT. salsa_gases_from_chem ) THEN
2095	message_string = 'Input file '// TRIM( input_file_dynamic ) // TRIM( coupling_char ) // &
2096	' for SALSA missing!'
2097	CALL message( 'salsa_mod: aerosol_init', 'PA0610', 1, 2, 0, 6, 0 )
2098	!
2099	!-- Close input file
2100	CALL close_input_file( id_dyn )
2101	ENDIF ! netcdf_extend
2102	#else
2103	message_string = 'init_gases_type = 1 but preprocessor directive __netcdf is not used in '//&
2104	'compiling!'
2105	CALL message( 'salsa_mod: aerosol_init', 'PA0611', 1, 2, 0, 6, 0 )
2106
2107	#endif
2108
2109	ENDIF
2110	!
2111	!-- Both SO4 and OC are included, so use the given mass fractions
2112	IF ( index_oc > 0 .AND. index_so4 > 0 ) THEN
2113	pmfoc1a(:) = pmf2a(:,2) / ( pmf2a(:,2) + pmf2a(:,1) ) ! Normalize
2114	!
2115	!-- Pure organic carbon
2116	ELSEIF ( index_oc > 0 ) THEN
2117	pmfoc1a(:) = 1.0_wp
2118	!
2119	!-- Pure SO4
2120	ELSEIF ( index_so4 > 0 ) THEN
2121	pmfoc1a(:) = 0.0_wp
2122
2123	ELSE
2124	message_string = 'Either OC or SO4 must be active for aerosol region 1a!'
2125	CALL message( 'salsa_mod: aerosol_init', 'PA0612', 1, 2, 0, 6, 0 )
2126	ENDIF
2127
2128	!
2129	!-- Initialize concentrations
2130	DO i = nxlg, nxrg
2131	DO j = nysg, nyng
2132	DO k = nzb, nzt+1
2133	!
2134	!-- Predetermine flag to mask topography
2135	flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_0(k,j,i), 0 ) )
2136	!
2137	!-- a) Number concentrations
2138	!-- Region 1:
2139	DO ib = start_subrange_1a, end_subrange_1a
2140	IF ( .NOT. read_restart_data_salsa ) THEN
2141	aerosol_number(ib)%conc(k,j,i) = pndist(k,ib) * flag
2142	ENDIF
2143	IF ( prunmode == 1 ) THEN
2144	aerosol_number(ib)%init = pndist(:,ib)
2145	ENDIF
2146	ENDDO
2147	!
2148	!-- Region 2:
2149	IF ( nreg > 1 ) THEN
2150	DO ib = start_subrange_2a, end_subrange_2a
2151	IF ( .NOT. read_restart_data_salsa ) THEN
2152	aerosol_number(ib)%conc(k,j,i) = MAX( 0.0_wp, pnf2a(k) ) * pndist(k,ib) * flag
2153	ENDIF
2154	IF ( prunmode == 1 ) THEN
2155	aerosol_number(ib)%init = MAX( 0.0_wp, nf2a ) * pndist(:,ib)
2156	ENDIF
2157	ENDDO
2158	IF ( .NOT. no_insoluble ) THEN
2159	DO ib = start_subrange_2b, end_subrange_2b
2160	IF ( pnf2a(k) < 1.0_wp ) THEN
2161	IF ( .NOT. read_restart_data_salsa ) THEN
2162	aerosol_number(ib)%conc(k,j,i) = MAX( 0.0_wp, 1.0_wp - pnf2a(k) ) * &
2163	pndist(k,ib) * flag
2164	ENDIF
2165	IF ( prunmode == 1 ) THEN
2166	aerosol_number(ib)%init = MAX( 0.0_wp, 1.0_wp - nf2a ) * pndist(:,ib)
2167	ENDIF
2168	ENDIF
2169	ENDDO
2170	ENDIF
2171	ENDIF
2172	!
2173	!-- b) Aerosol mass concentrations
2174	!-- bin subrange 1: done here separately due to the SO4/OC convention
2175	!
2176	!-- SO4:
2177	IF ( index_so4 > 0 ) THEN
2178	ss = ( index_so4 - 1 ) * nbins_aerosol + start_subrange_1a !< start
2179	ee = ( index_so4 - 1 ) * nbins_aerosol + end_subrange_1a !< end
2180	ib = start_subrange_1a
2181	DO ic = ss, ee
2182	IF ( .NOT. read_restart_data_salsa ) THEN
2183	aerosol_mass(ic)%conc(k,j,i) = MAX( 0.0_wp, 1.0_wp - pmfoc1a(k) ) * &
2184	pndist(k,ib) * core(ib) * arhoh2so4 * flag
2185	ENDIF
2186	IF ( prunmode == 1 ) THEN
2187	aerosol_mass(ic)%init(k) = MAX( 0.0_wp, 1.0_wp - pmfoc1a(k) ) * pndist(k,ib) &
2188	* core(ib) * arhoh2so4
2189	ENDIF
2190	ib = ib+1
2191	ENDDO
2192	ENDIF
2193	!
2194	!-- OC:
2195	IF ( index_oc > 0 ) THEN
2196	ss = ( index_oc - 1 ) * nbins_aerosol + start_subrange_1a !< start
2197	ee = ( index_oc - 1 ) * nbins_aerosol + end_subrange_1a !< end
2198	ib = start_subrange_1a
2199	DO ic = ss, ee
2200	IF ( .NOT. read_restart_data_salsa ) THEN
2201	aerosol_mass(ic)%conc(k,j,i) = MAX( 0.0_wp, pmfoc1a(k) ) * pndist(k,ib) * &
2202	core(ib) * arhooc * flag
2203	ENDIF
2204	IF ( prunmode == 1 ) THEN
2205	aerosol_mass(ic)%init(k) = MAX( 0.0_wp, pmfoc1a(k) ) * pndist(k,ib) * &
2206	core(ib) * arhooc
2207	ENDIF
2208	ib = ib+1
2209	ENDDO
2210	ENDIF
2211	ENDDO !< k
2212
2213	prunmode = 3 ! Init only once
2214
2215	ENDDO !< j
2216	ENDDO !< i
2217
2218	!
2219	!-- c) Aerosol mass concentrations
2220	!-- bin subrange 2:
2221	IF ( nreg > 1 ) THEN
2222
2223	IF ( index_so4 > 0 ) THEN
2224	CALL set_aero_mass( index_so4, pmf2a(:,1), pmf2b(:,1), pnf2a, pndist, core, arhoh2so4 )
2225	ENDIF
2226	IF ( index_oc > 0 ) THEN
2227	CALL set_aero_mass( index_oc, pmf2a(:,2), pmf2b(:,2), pnf2a, pndist, core, arhooc )
2228	ENDIF
2229	IF ( index_bc > 0 ) THEN
2230	CALL set_aero_mass( index_bc, pmf2a(:,3), pmf2b(:,3), pnf2a, pndist, core, arhobc )
2231	ENDIF
2232	IF ( index_du > 0 ) THEN
2233	CALL set_aero_mass( index_du, pmf2a(:,4), pmf2b(:,4), pnf2a, pndist, core, arhodu )
2234	ENDIF
2235	IF ( index_ss > 0 ) THEN
2236	CALL set_aero_mass( index_ss, pmf2a(:,5), pmf2b(:,5), pnf2a, pndist, core, arhoss )
2237	ENDIF
2238	IF ( index_no > 0 ) THEN
2239	CALL set_aero_mass( index_no, pmf2a(:,6), pmf2b(:,6), pnf2a, pndist, core, arhohno3 )
2240	ENDIF
2241	IF ( index_nh > 0 ) THEN
2242	CALL set_aero_mass( index_nh, pmf2a(:,7), pmf2b(:,7), pnf2a, pndist, core, arhonh3 )
2243	ENDIF
2244
2245	ENDIF
2246
2247	END SUBROUTINE aerosol_init
2248
2249	!------------------------------------------------------------------------------!
2250	! Description:
2251	! ------------
2252	!> Create a lognormal size distribution and discretise to a sectional
2253	!> representation.
2254	!------------------------------------------------------------------------------!
2255	SUBROUTINE size_distribution( in_ntot, in_dpg, in_sigma, psd_sect )
2256
2257	IMPLICIT NONE
2258
2259	INTEGER(iwp) :: ib !< running index: bin
2260	INTEGER(iwp) :: iteration !< running index: iteration
2261
2262	REAL(wp) :: d1 !< particle diameter (m, dummy)
2263	REAL(wp) :: d2 !< particle diameter (m, dummy)
2264	REAL(wp) :: delta_d !< (d2-d1)/10
2265	REAL(wp) :: deltadp !< bin width
2266	REAL(wp) :: dmidi !< ( d1 + d2 ) / 2
2267
2268	REAL(wp), DIMENSION(:), INTENT(in) :: in_dpg !< geometric mean diameter (m)
2269	REAL(wp), DIMENSION(:), INTENT(in) :: in_ntot !< number conc. (#/m3)
2270	REAL(wp), DIMENSION(:), INTENT(in) :: in_sigma !< standard deviation
2271
2272	REAL(wp), DIMENSION(:), INTENT(inout) :: psd_sect !< sectional size distribution
2273
2274	DO ib = start_subrange_1a, end_subrange_2b
2275	psd_sect(ib) = 0.0_wp
2276	!
2277	!-- Particle diameter at the low limit (largest in the bin) (m)
2278	d1 = ( aero(ib)%vlolim / api6 )**0.33333333_wp
2279	!
2280	!-- Particle diameter at the high limit (smallest in the bin) (m)
2281	d2 = ( aero(ib)%vhilim / api6 )**0.33333333_wp
2282	!
2283	!-- Span of particle diameter in a bin (m)
2284	delta_d = 0.1_wp * ( d2 - d1 )
2285	!
2286	!-- Iterate:
2287	DO iteration = 1, 10
2288	d1 = ( aero(ib)%vlolim / api6 )*0.33333333_wp + ( ib - 1) delta_d
2289	d2 = d1 + delta_d
2290	dmidi = 0.5_wp * ( d1 + d2 )
2291	deltadp = LOG10( d2 / d1 )
2292	!
2293	!-- Size distribution
2294	!-- in_ntot = total number, total area, or total volume concentration
2295	!-- in_dpg = geometric-mean number, area, or volume diameter
2296	!-- n(k) = number, area, or volume concentration in a bin
2297	psd_sect(ib) = psd_sect(ib) + SUM( in_ntot * deltadp / ( SQRT( 2.0_wp * pi ) * &
2298	LOG10( in_sigma ) ) * EXP( -LOG10( dmidi / in_dpg )**2.0_wp / &
2299	( 2.0_wp * LOG10( in_sigma ) ** 2.0_wp ) ) )
2300
2301	ENDDO
2302	ENDDO
2303
2304	END SUBROUTINE size_distribution
2305
2306	!------------------------------------------------------------------------------!
2307	! Description:
2308	! ------------
2309	!> Sets the mass concentrations to aerosol arrays in 2a and 2b.
2310	!>
2311	!> Tomi Raatikainen, FMI, 29.2.2016
2312	!------------------------------------------------------------------------------!
2313	SUBROUTINE set_aero_mass( ispec, pmf2a, pmf2b, pnf2a, pndist, pcore, prho )
2314
2315	IMPLICIT NONE
2316
2317	INTEGER(iwp) :: ee !< index: end
2318	INTEGER(iwp) :: i !< loop index
2319	INTEGER(iwp) :: ib !< loop index
2320	INTEGER(iwp) :: ic !< loop index
2321	INTEGER(iwp) :: j !< loop index
2322	INTEGER(iwp) :: k !< loop index
2323	INTEGER(iwp) :: prunmode !< 1 = initialise
2324	INTEGER(iwp) :: ss !< index: start
2325
2326	INTEGER(iwp), INTENT(in) :: ispec !< Aerosol species index
2327
2328	REAL(wp) :: flag !< flag to mask topography grid points
2329
2330	REAL(wp), INTENT(in) :: prho !< Aerosol density
2331
2332	REAL(wp), DIMENSION(nbins_aerosol), INTENT(in) :: pcore !< Aerosol bin mid core volume
2333	REAL(wp), DIMENSION(0:nz+1), INTENT(in) :: pnf2a !< Number fraction for 2a
2334	REAL(wp), DIMENSION(0:nz+1), INTENT(in) :: pmf2a !< Mass distributions for a
2335	REAL(wp), DIMENSION(0:nz+1), INTENT(in) :: pmf2b !< and b bins
2336
2337	REAL(wp), DIMENSION(0:nz+1,nbins_aerosol), INTENT(in) :: pndist !< Aerosol size distribution
2338
2339	prunmode = 1
2340
2341	DO i = nxlg, nxrg
2342	DO j = nysg, nyng
2343	DO k = nzb, nzt+1
2344	!
2345	!-- Predetermine flag to mask topography
2346	flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_0(k,j,i), 0 ) )
2347	!
2348	!-- Regime 2a:
2349	ss = ( ispec - 1 ) * nbins_aerosol + start_subrange_2a
2350	ee = ( ispec - 1 ) * nbins_aerosol + end_subrange_2a
2351	ib = start_subrange_2a
2352	DO ic = ss, ee
2353	IF ( .NOT. read_restart_data_salsa ) THEN
2354	aerosol_mass(ic)%conc(k,j,i) = MAX( 0.0_wp, pmf2a(k) ) * pnf2a(k) * pndist(k,ib)&
2355	* pcore(ib) * prho * flag
2356	ENDIF
2357	IF ( prunmode == 1 ) THEN
2358	aerosol_mass(ic)%init(k) = MAX( 0.0_wp, pmf2a(k) ) * pnf2a(k) * pndist(k,ib) * &
2359	pcore(ib) * prho
2360	ENDIF
2361	ib = ib + 1
2362	ENDDO
2363	!
2364	!-- Regime 2b:
2365	IF ( .NOT. no_insoluble ) THEN
2366	ss = ( ispec - 1 ) * nbins_aerosol + start_subrange_2b
2367	ee = ( ispec - 1 ) * nbins_aerosol + end_subrange_2b
2368	ib = start_subrange_2a
2369	DO ic = ss, ee
2370	IF ( .NOT. read_restart_data_salsa ) THEN
2371	aerosol_mass(ic)%conc(k,j,i) = MAX( 0.0_wp, pmf2b(k) ) * ( 1.0_wp - pnf2a(k))&
2372	* pndist(k,ib) * pcore(ib) * prho * flag
2373	ENDIF
2374	IF ( prunmode == 1 ) THEN
2375	aerosol_mass(ic)%init(k) = MAX( 0.0_wp, pmf2b(k) ) * ( 1.0_wp - pnf2a(k) ) * &
2376	pndist(k,ib) * pcore(ib) * prho
2377	ENDIF
2378	ib = ib + 1
2379	ENDDO ! c
2380
2381	ENDIF
2382	ENDDO ! k
2383
2384	prunmode = 3 ! Init only once
2385
2386	ENDDO ! j
2387	ENDDO ! i
2388
2389	END SUBROUTINE set_aero_mass
2390
2391	!------------------------------------------------------------------------------!
2392	! Description:
2393	! ------------
2394	!> Initialise the matching between surface types in LSM and deposition models.
2395	!> Do the matching based on Zhang et al. (2001). Atmos. Environ. 35, 549-560
2396	!> (here referred as Z01).
2397	!------------------------------------------------------------------------------!
2398	SUBROUTINE init_deposition
2399
2400	USE surface_mod, &
2401	ONLY: surf_lsm_h, surf_lsm_v, surf_usm_h, surf_usm_v
2402
2403	IMPLICIT NONE
2404
2405	INTEGER(iwp) :: l !< loop index for vertical surfaces
2406
2407	LOGICAL :: match_lsm !< flag to initilise LSM surfaces (if false, initialise USM surfaces)
2408
2409	IF ( depo_pcm_par == 'zhang2001' ) THEN
2410	depo_pcm_par_num = 1
2411	ELSEIF ( depo_pcm_par == 'petroff2010' ) THEN
2412	depo_pcm_par_num = 2
2413	ENDIF
2414
2415	IF ( depo_surf_par == 'zhang2001' ) THEN
2416	depo_surf_par_num = 1
2417	ELSEIF ( depo_surf_par == 'petroff2010' ) THEN
2418	depo_surf_par_num = 2
2419	ENDIF
2420	!
2421	!-- LSM: Pavement, vegetation and water
2422	IF ( nldepo_surf .AND. land_surface ) THEN
2423	match_lsm = .TRUE.
2424	ALLOCATE( lsm_to_depo_h%match_lupg(1:surf_lsm_h%ns), &
2425	lsm_to_depo_h%match_luvw(1:surf_lsm_h%ns), &
2426	lsm_to_depo_h%match_luww(1:surf_lsm_h%ns) )
2427	lsm_to_depo_h%match_lupg = 0
2428	lsm_to_depo_h%match_luvw = 0
2429	lsm_to_depo_h%match_luww = 0
2430	CALL match_sm_zhang( surf_lsm_h, lsm_to_depo_h%match_lupg, lsm_to_depo_h%match_luvw, &
2431	lsm_to_depo_h%match_luww, match_lsm )
2432	DO l = 0, 3
2433	ALLOCATE( lsm_to_depo_v(l)%match_lupg(1:surf_lsm_v(l)%ns), &
2434	lsm_to_depo_v(l)%match_luvw(1:surf_lsm_v(l)%ns), &
2435	lsm_to_depo_v(l)%match_luww(1:surf_lsm_v(l)%ns) )
2436	lsm_to_depo_v(l)%match_lupg = 0
2437	lsm_to_depo_v(l)%match_luvw = 0
2438	lsm_to_depo_v(l)%match_luww = 0
2439	CALL match_sm_zhang( surf_lsm_v(l), lsm_to_depo_v(l)%match_lupg, &
2440	lsm_to_depo_v(l)%match_luvw, lsm_to_depo_v(l)%match_luww, match_lsm )
2441	ENDDO
2442	ENDIF
2443	!
2444	!-- USM: Green roofs/walls, wall surfaces and windows
2445	IF ( nldepo_surf .AND. urban_surface ) THEN
2446	match_lsm = .FALSE.
2447	ALLOCATE( usm_to_depo_h%match_lupg(1:surf_usm_h%ns), &
2448	usm_to_depo_h%match_luvw(1:surf_usm_h%ns), &
2449	usm_to_depo_h%match_luww(1:surf_usm_h%ns) )
2450	usm_to_depo_h%match_lupg = 0
2451	usm_to_depo_h%match_luvw = 0
2452	usm_to_depo_h%match_luww = 0
2453	CALL match_sm_zhang( surf_usm_h, usm_to_depo_h%match_lupg, usm_to_depo_h%match_luvw, &
2454	usm_to_depo_h%match_luww, match_lsm )
2455	DO l = 0, 3
2456	ALLOCATE( usm_to_depo_v(l)%match_lupg(1:surf_usm_v(l)%ns), &
2457	usm_to_depo_v(l)%match_luvw(1:surf_usm_v(l)%ns), &
2458	usm_to_depo_v(l)%match_luww(1:surf_usm_v(l)%ns) )
2459	usm_to_depo_v(l)%match_lupg = 0
2460	usm_to_depo_v(l)%match_luvw = 0
2461	usm_to_depo_v(l)%match_luww = 0
2462	CALL match_sm_zhang( surf_usm_v(l), usm_to_depo_v(l)%match_lupg, &
2463	usm_to_depo_v(l)%match_luvw, usm_to_depo_v(l)%match_luww, match_lsm )
2464	ENDDO
2465	ENDIF
2466
2467	IF ( nldepo_pcm ) THEN
2468	SELECT CASE ( depo_pcm_type )
2469	CASE ( 'evergreen_needleleaf' )
2470	depo_pcm_type_num = 1
2471	CASE ( 'evergreen_broadleaf' )
2472	depo_pcm_type_num = 2
2473	CASE ( 'deciduous_needleleaf' )
2474	depo_pcm_type_num = 3
2475	CASE ( 'deciduous_broadleaf' )
2476	depo_pcm_type_num = 4
2477	CASE DEFAULT
2478	message_string = 'depo_pcm_type not set correctly.'
2479	CALL message( 'salsa_mod: init_deposition', 'PA0613', 1, 2, 0, 6, 0 )
2480	END SELECT
2481	ENDIF
2482
2483	END SUBROUTINE init_deposition
2484
2485	!------------------------------------------------------------------------------!
2486	! Description:
2487	! ------------
2488	!> Match the surface types in PALM and Zhang et al. 2001 deposition module
2489	!------------------------------------------------------------------------------!
2490	SUBROUTINE match_sm_zhang( surf, match_pav_green, match_veg_wall, match_wat_win, match_lsm )
2491
2492	USE surface_mod, &
2493	ONLY: ind_pav_green, ind_veg_wall, ind_wat_win, surf_type
2494
2495	IMPLICIT NONE
2496
2497	INTEGER(iwp) :: m !< index for surface elements
2498	INTEGER(iwp) :: pav_type_palm !< pavement / green wall type in PALM
2499	INTEGER(iwp) :: veg_type_palm !< vegetation / wall type in PALM
2500	INTEGER(iwp) :: wat_type_palm !< water / window type in PALM
2501
2502	INTEGER(iwp), DIMENSION(:), INTENT(inout) :: match_pav_green !< matching pavement/green walls
2503	INTEGER(iwp), DIMENSION(:), INTENT(inout) :: match_veg_wall !< matching vegetation/walls
2504	INTEGER(iwp), DIMENSION(:), INTENT(inout) :: match_wat_win !< matching water/windows
2505
2506	LOGICAL, INTENT(in) :: match_lsm !< flag to initilise LSM surfaces (if false, initialise USM)
2507
2508	TYPE(surf_type), INTENT(in) :: surf !< respective surface type
2509
2510	DO m = 1, surf%ns
2511	IF ( match_lsm ) THEN
2512	!
2513	!-- Vegetation (LSM):
2514	IF ( surf%frac(ind_veg_wall,m) > 0 ) THEN
2515	veg_type_palm = surf%vegetation_type(m)
2516	SELECT CASE ( veg_type_palm )
2517	CASE ( 0 )
2518	message_string = 'No vegetation type defined.'
2519	CALL message( 'salsa_mod: init_depo_surfaces', 'PA0614', 1, 2, 0, 6, 0 )
2520	CASE ( 1 ) ! bare soil
2521	match_veg_wall(m) = 6 ! grass in Z01
2522	CASE ( 2 ) ! crops, mixed farming
2523	match_veg_wall(m) = 7 ! crops, mixed farming Z01
2524	CASE ( 3 ) ! short grass
2525	match_veg_wall(m) = 6 ! grass in Z01
2526	CASE ( 4 ) ! evergreen needleleaf trees
2527	match_veg_wall(m) = 1 ! evergreen needleleaf trees in Z01
2528	CASE ( 5 ) ! deciduous needleleaf trees
2529	match_veg_wall(m) = 3 ! deciduous needleleaf trees in Z01
2530	CASE ( 6 ) ! evergreen broadleaf trees
2531	match_veg_wall(m) = 2 ! evergreen broadleaf trees in Z01
2532	CASE ( 7 ) ! deciduous broadleaf trees
2533	match_veg_wall(m) = 4 ! deciduous broadleaf trees in Z01
2534	CASE ( 8 ) ! tall grass
2535	match_veg_wall(m) = 6 ! grass in Z01
2536	CASE ( 9 ) ! desert
2537	match_veg_wall(m) = 8 ! desert in Z01
2538	CASE ( 10 ) ! tundra
2539	match_veg_wall(m) = 9 ! tundra in Z01
2540	CASE ( 11 ) ! irrigated crops
2541	match_veg_wall(m) = 7 ! crops, mixed farming Z01
2542	CASE ( 12 ) ! semidesert
2543	match_veg_wall(m) = 8 ! desert in Z01
2544	CASE ( 13 ) ! ice caps and glaciers
2545	match_veg_wall(m) = 12 ! ice cap and glacier in Z01
2546	CASE ( 14 ) ! bogs and marshes
2547	match_veg_wall(m) = 11 ! wetland with plants in Z01
2548	CASE ( 15 ) ! evergreen shrubs
2549	match_veg_wall(m) = 10 ! shrubs and interrupted woodlands in Z01
2550	CASE ( 16 ) ! deciduous shrubs
2551	match_veg_wall(m) = 10 ! shrubs and interrupted woodlands in Z01
2552	CASE ( 17 ) ! mixed forest/woodland
2553	match_veg_wall(m) = 5 ! mixed broadleaf and needleleaf trees in Z01
2554	CASE ( 18 ) ! interrupted forest
2555	match_veg_wall(m) = 10 ! shrubs and interrupted woodlands in Z01
2556	END SELECT
2557	ENDIF
2558	!
2559	!-- Pavement (LSM):
2560	IF ( surf%frac(ind_pav_green,m) > 0 ) THEN
2561	pav_type_palm = surf%pavement_type(m)
2562	IF ( pav_type_palm == 0 ) THEN ! error
2563	message_string = 'No pavement type defined.'
2564	CALL message( 'salsa_mod: match_sm_zhang', 'PA0615', 1, 2, 0, 6, 0 )
2565	ELSE
2566	match_pav_green(m) = 15 ! urban in Z01
2567	ENDIF
2568	ENDIF
2569	!
2570	!-- Water (LSM):
2571	IF ( surf%frac(ind_wat_win,m) > 0 ) THEN
2572	wat_type_palm = surf%water_type(m)
2573	IF ( wat_type_palm == 0 ) THEN ! error
2574	message_string = 'No water type defined.'
2575	CALL message( 'salsa_mod: match_sm_zhang', 'PA0616', 1, 2, 0, 6, 0 )
2576	ELSEIF ( wat_type_palm == 3 ) THEN
2577	match_wat_win(m) = 14 ! ocean in Z01
2578	ELSEIF ( wat_type_palm == 1 .OR. wat_type_palm == 2 .OR. wat_type_palm == 4 &
2579	.OR. wat_type_palm == 5 ) THEN
2580	match_wat_win(m) = 13 ! inland water in Z01
2581	ENDIF
2582	ENDIF
2583	ELSE
2584	!
2585	!-- Wall surfaces (USM):
2586	IF ( surf%frac(ind_veg_wall,m) > 0 ) THEN
2587	match_veg_wall(m) = 15 ! urban in Z01
2588	ENDIF
2589	!
2590	!-- Green walls and roofs (USM):
2591	IF ( surf%frac(ind_pav_green,m) > 0 ) THEN
2592	match_pav_green(m) = 6 ! (short) grass in Z01
2593	ENDIF
2594	!
2595	!-- Windows (USM):
2596	IF ( surf%frac(ind_wat_win,m) > 0 ) THEN
2597	match_wat_win(m) = 15 ! urban in Z01
2598	ENDIF
2599	ENDIF
2600
2601	ENDDO
2602
2603	END SUBROUTINE match_sm_zhang
2604
2605	!------------------------------------------------------------------------------!
2606	! Description:
2607	! ------------
2608	!> Swapping of timelevels
2609	!------------------------------------------------------------------------------!
2610	SUBROUTINE salsa_swap_timelevel( mod_count )
2611
2612	IMPLICIT NONE
2613
2614	INTEGER(iwp) :: ib !<
2615	INTEGER(iwp) :: ic !<
2616	INTEGER(iwp) :: icc !<
2617	INTEGER(iwp) :: ig !<
2618
2619	INTEGER(iwp), INTENT(IN) :: mod_count !<
2620
2621	IF ( time_since_reference_point >= skip_time_do_salsa ) THEN
2622
2623	SELECT CASE ( mod_count )
2624
2625	CASE ( 0 )
2626
2627	DO ib = 1, nbins_aerosol
2628	aerosol_number(ib)%conc(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => nconc_1(:,:,:,ib)
2629	aerosol_number(ib)%conc_p(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => nconc_2(:,:,:,ib)
2630
2631	DO ic = 1, ncomponents_mass
2632	icc = ( ic-1 ) * nbins_aerosol + ib
2633	aerosol_mass(icc)%conc(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => mconc_1(:,:,:,icc)
2634	aerosol_mass(icc)%conc_p(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => mconc_2(:,:,:,icc)
2635	ENDDO
2636	ENDDO
2637
2638	IF ( .NOT. salsa_gases_from_chem ) THEN
2639	DO ig = 1, ngases_salsa
2640	salsa_gas(ig)%conc(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => gconc_1(:,:,:,ig)
2641	salsa_gas(ig)%conc_p(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => gconc_2(:,:,:,ig)
2642	ENDDO
2643	ENDIF
2644
2645	CASE ( 1 )
2646
2647	DO ib = 1, nbins_aerosol
2648	aerosol_number(ib)%conc(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => nconc_2(:,:,:,ib)
2649	aerosol_number(ib)%conc_p(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => nconc_1(:,:,:,ib)
2650	DO ic = 1, ncomponents_mass
2651	icc = ( ic-1 ) * nbins_aerosol + ib
2652	aerosol_mass(icc)%conc(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => mconc_2(:,:,:,icc)
2653	aerosol_mass(icc)%conc_p(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => mconc_1(:,:,:,icc)
2654	ENDDO
2655	ENDDO
2656
2657	IF ( .NOT. salsa_gases_from_chem ) THEN
2658	DO ig = 1, ngases_salsa
2659	salsa_gas(ig)%conc(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => gconc_2(:,:,:,ig)
2660	salsa_gas(ig)%conc_p(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => gconc_1(:,:,:,ig)
2661	ENDDO
2662	ENDIF
2663
2664	END SELECT
2665
2666	ENDIF
2667
2668	END SUBROUTINE salsa_swap_timelevel
2669
2670
2671	!------------------------------------------------------------------------------!
2672	! Description:
2673	! ------------
2674	!> This routine reads the respective restart data.
2675	!------------------------------------------------------------------------------!
2676	SUBROUTINE salsa_rrd_local( k, nxlf, nxlc, nxl_on_file, nxrf, nxrc, nxr_on_file, nynf, nync, &
2677	nyn_on_file, nysf, nysc, nys_on_file, tmp_3d, found )
2678
2679	USE control_parameters, &
2680	ONLY: length, restart_string
2681
2682	IMPLICIT NONE
2683
2684	INTEGER(iwp) :: ib !<
2685	INTEGER(iwp) :: ic !<
2686	INTEGER(iwp) :: ig !<
2687	INTEGER(iwp) :: k !<
2688	INTEGER(iwp) :: nxlc !<
2689	INTEGER(iwp) :: nxlf !<
2690	INTEGER(iwp) :: nxl_on_file !<
2691	INTEGER(iwp) :: nxrc !<
2692	INTEGER(iwp) :: nxrf !<
2693	INTEGER(iwp) :: nxr_on_file !<
2694	INTEGER(iwp) :: nync !<
2695	INTEGER(iwp) :: nynf !<
2696	INTEGER(iwp) :: nyn_on_file !<
2697	INTEGER(iwp) :: nysc !<
2698	INTEGER(iwp) :: nysf !<
2699	INTEGER(iwp) :: nys_on_file !<
2700
2701	LOGICAL, INTENT(OUT) :: found !<
2702
2703	REAL(wp), &
2704	DIMENSION(nzb:nzt+1,nys_on_file-nbgp:nyn_on_file+nbgp,nxl_on_file-nbgp:nxr_on_file+nbgp) :: tmp_3d !<
2705
2706	found = .FALSE.
2707
2708	IF ( read_restart_data_salsa ) THEN
2709
2710	SELECT CASE ( restart_string(1:length) )
2711
2712	CASE ( 'aerosol_number' )
2713	DO ib = 1, nbins_aerosol
2714	IF ( k == 1 ) READ ( 13 ) tmp_3d
2715	aerosol_number(ib)%conc(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) = &
2716	tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
2717	found = .TRUE.
2718	ENDDO
2719
2720	CASE ( 'aerosol_mass' )
2721	DO ic = 1, ncomponents_mass * nbins_aerosol
2722	IF ( k == 1 ) READ ( 13 ) tmp_3d
2723	aerosol_mass(ic)%conc(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) = &
2724	tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
2725	found = .TRUE.
2726	ENDDO
2727
2728	CASE ( 'salsa_gas' )
2729	DO ig = 1, ngases_salsa
2730	IF ( k == 1 ) READ ( 13 ) tmp_3d
2731	salsa_gas(ig)%conc(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) = &
2732	tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
2733	found = .TRUE.
2734	ENDDO
2735
2736	CASE DEFAULT
2737	found = .FALSE.
2738
2739	END SELECT
2740	ENDIF
2741
2742	END SUBROUTINE salsa_rrd_local
2743
2744	!------------------------------------------------------------------------------!
2745	! Description:
2746	! ------------
2747	!> This routine writes the respective restart data.
2748	!> Note that the following input variables in PARIN have to be equal between
2749	!> restart runs:
2750	!> listspec, nbin, nbin2, nf2a, ncc, mass_fracs_a, mass_fracs_b
2751	!------------------------------------------------------------------------------!
2752	SUBROUTINE salsa_wrd_local
2753
2754	USE control_parameters, &
2755	ONLY: write_binary
2756
2757	IMPLICIT NONE
2758
2759	INTEGER(iwp) :: ib !<
2760	INTEGER(iwp) :: ic !<
2761	INTEGER(iwp) :: ig !<
2762
2763	IF ( write_binary .AND. write_binary_salsa ) THEN
2764
2765	CALL wrd_write_string( 'aerosol_number' )
2766	DO ib = 1, nbins_aerosol
2767	WRITE ( 14 ) aerosol_number(ib)%conc
2768	ENDDO
2769
2770	CALL wrd_write_string( 'aerosol_mass' )
2771	DO ic = 1, nbins_aerosol * ncomponents_mass
2772	WRITE ( 14 ) aerosol_mass(ic)%conc
2773	ENDDO
2774
2775	CALL wrd_write_string( 'salsa_gas' )
2776	DO ig = 1, ngases_salsa
2777	WRITE ( 14 ) salsa_gas(ig)%conc
2778	ENDDO
2779
2780	ENDIF
2781
2782	END SUBROUTINE salsa_wrd_local
2783
2784	!------------------------------------------------------------------------------!
2785	! Description:
2786	! ------------
2787	!> Performs necessary unit and dimension conversion between the host model and
2788	!> SALSA module, and calls the main SALSA routine.
2789	!> Partially adobted form the original SALSA boxmodel version.
2790	!> Now takes masses in as kg/kg from LES!! Converted to m3/m3 for SALSA
2791	!> 05/2016 Juha: This routine is still pretty much in its original shape.
2792	!> It's dumb as a mule and twice as ugly, so implementation of
2793	!> an improved solution is necessary sooner or later.
2794	!> Juha Tonttila, FMI, 2014
2795	!> Jaakko Ahola, FMI, 2016
2796	!> Only aerosol processes included, Mona Kurppa, UHel, 2017
2797	!------------------------------------------------------------------------------!
2798	SUBROUTINE salsa_driver( i, j, prunmode )
2799
2800	USE arrays_3d, &
2801	ONLY: pt_p, q_p, u, v, w
2802
2803	USE plant_canopy_model_mod, &
2804	ONLY: lad_s
2805
2806	USE surface_mod, &
2807	ONLY: surf_def_h, surf_def_v, surf_lsm_h, surf_lsm_v, surf_usm_h, surf_usm_v
2808
2809	IMPLICIT NONE
2810
2811	INTEGER(iwp) :: endi !< end index
2812	INTEGER(iwp) :: ib !< loop index
2813	INTEGER(iwp) :: ic !< loop index
2814	INTEGER(iwp) :: ig !< loop index
2815	INTEGER(iwp) :: k_wall !< vertical index of topography top
2816	INTEGER(iwp) :: k !< loop index
2817	INTEGER(iwp) :: l !< loop index
2818	INTEGER(iwp) :: nc_h2o !< index of H2O in the prtcl index table
2819	INTEGER(iwp) :: ss !< loop index
2820	INTEGER(iwp) :: str !< start index
2821	INTEGER(iwp) :: vc !< default index in prtcl
2822
2823	INTEGER(iwp), INTENT(in) :: i !< loop index
2824	INTEGER(iwp), INTENT(in) :: j !< loop index
2825	INTEGER(iwp), INTENT(in) :: prunmode !< 1: Initialization, 2: Spinup, 3: Regular runtime
2826
2827	REAL(wp) :: cw_old !< previous H2O mixing ratio
2828	REAL(wp) :: flag !< flag to mask topography grid points
2829	REAL(wp) :: in_lad !< leaf area density (m2/m3)
2830	REAL(wp) :: in_rh !< relative humidity
2831	REAL(wp) :: zgso4 !< SO4
2832	REAL(wp) :: zghno3 !< HNO3
2833	REAL(wp) :: zgnh3 !< NH3
2834	REAL(wp) :: zgocnv !< non-volatile OC
2835	REAL(wp) :: zgocsv !< semi-volatile OC
2836
2837	REAL(wp), DIMENSION(nzb:nzt+1) :: in_adn !< air density (kg/m3)
2838	REAL(wp), DIMENSION(nzb:nzt+1) :: in_cs !< H2O sat. vapour conc.
2839	REAL(wp), DIMENSION(nzb:nzt+1) :: in_cw !< H2O vapour concentration
2840	REAL(wp), DIMENSION(nzb:nzt+1) :: in_p !< pressure (Pa)
2841	REAL(wp), DIMENSION(nzb:nzt+1) :: in_t !< temperature (K)
2842	REAL(wp), DIMENSION(nzb:nzt+1) :: in_u !< wind magnitude (m/s)
2843	REAL(wp), DIMENSION(nzb:nzt+1) :: kvis !< kinematic viscosity of air(m2/s)
2844	REAL(wp), DIMENSION(nzb:nzt+1) :: ppm_to_nconc !< Conversion factor from ppm to #/m3
2845
2846	REAL(wp), DIMENSION(nzb:nzt+1,nbins_aerosol) :: schmidt_num !< particle Schmidt number
2847	REAL(wp), DIMENSION(nzb:nzt+1,nbins_aerosol) :: vd !< particle fall seed (m/s)
2848
2849	TYPE(t_section), DIMENSION(nbins_aerosol) :: lo_aero !< additional variable for OpenMP
2850	TYPE(t_section), DIMENSION(nbins_aerosol) :: aero_old !< helper array
2851
2852	aero_old(:)%numc = 0.0_wp
2853	in_lad = 0.0_wp
2854	in_u = 0.0_wp
2855	kvis = 0.0_wp
2856	lo_aero = aero
2857	schmidt_num = 0.0_wp
2858	vd = 0.0_wp
2859	zgso4 = nclim
2860	zghno3 = nclim
2861	zgnh3 = nclim
2862	zgocnv = nclim
2863	zgocsv = nclim
2864	!
2865	!-- Aerosol number is always set, but mass can be uninitialized
2866	DO ib = 1, nbins_aerosol
2867	lo_aero(ib)%volc(:) = 0.0_wp
2868	aero_old(ib)%volc(:) = 0.0_wp
2869	ENDDO
2870	!
2871	!-- Set the salsa runtime config (How to make this more efficient?)
2872	CALL set_salsa_runtime( prunmode )
2873	!
2874	!-- Calculate thermodynamic quantities needed in SALSA
2875	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 )
2876	!
2877	!-- Magnitude of wind: needed for deposition
2878	IF ( lsdepo ) THEN
2879	in_u(nzb+1:nzt) = SQRT( ( 0.5_wp * ( u(nzb+1:nzt,j,i) + u(nzb+1:nzt,j,i+1) ) )**2 + &
2880	( 0.5_wp * ( v(nzb+1:nzt,j,i) + v(nzb+1:nzt,j+1,i) ) )**2 + &
2881	( 0.5_wp * ( w(nzb:nzt-1,j,i) + w(nzb+1:nzt,j, i) ) )**2 )
2882	ENDIF
2883	!
2884	!-- Calculate conversion factors for gas concentrations
2885	ppm_to_nconc(:) = for_ppm_to_nconc * in_p(:) / in_t(:)
2886	!
2887	!-- Determine topography-top index on scalar grid
2888	k_wall = k_topo_top(j,i)
2889
2890	DO k = nzb+1, nzt
2891	!
2892	!-- Predetermine flag to mask topography
2893	flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_0(k,j,i), 0 ) )
2894	!
2895	!-- Wind velocity for dry depositon on vegetation
2896	IF ( lsdepo_pcm .AND. plant_canopy ) THEN
2897	in_lad = lad_s( MAX( k-k_wall,0 ),j,i)
2898	ENDIF
2899	!
2900	!-- For initialization and spinup, limit the RH with the parameter rhlim
2901	IF ( prunmode < 3 ) THEN
2902	in_cw(k) = MIN( in_cw(k), in_cs(k) * rhlim )
2903	ELSE
2904	in_cw(k) = in_cw(k)
2905	ENDIF
2906	cw_old = in_cw(k) !* in_adn(k)
2907	!
2908	!-- Set volume concentrations:
2909	!-- Sulphate (SO4) or sulphuric acid H2SO4
2910	IF ( index_so4 > 0 ) THEN
2911	vc = 1
2912	str = ( index_so4-1 ) * nbins_aerosol + 1 ! start index
2913	endi = index_so4 * nbins_aerosol ! end index
2914	ic = 1
2915	DO ss = str, endi
2916	lo_aero(ic)%volc(vc) = aerosol_mass(ss)%conc(k,j,i) / arhoh2so4
2917	ic = ic+1
2918	ENDDO
2919	aero_old(1:nbins_aerosol)%volc(vc) = lo_aero(1:nbins_aerosol)%volc(vc)
2920	ENDIF
2921	!
2922	!-- Organic carbon (OC) compounds
2923	IF ( index_oc > 0 ) THEN
2924	vc = 2
2925	str = ( index_oc-1 ) * nbins_aerosol + 1
2926	endi = index_oc * nbins_aerosol
2927	ic = 1
2928	DO ss = str, endi
2929	lo_aero(ic)%volc(vc) = aerosol_mass(ss)%conc(k,j,i) / arhooc
2930	ic = ic+1
2931	ENDDO
2932	aero_old(1:nbins_aerosol)%volc(vc) = lo_aero(1:nbins_aerosol)%volc(vc)
2933	ENDIF
2934	!
2935	!-- Black carbon (BC)
2936	IF ( index_bc > 0 ) THEN
2937	vc = 3
2938	str = ( index_bc-1 ) * nbins_aerosol + 1 + end_subrange_1a
2939	endi = index_bc * nbins_aerosol
2940	ic = 1 + end_subrange_1a
2941	DO ss = str, endi
2942	lo_aero(ic)%volc(vc) = aerosol_mass(ss)%conc(k,j,i) / arhobc
2943	ic = ic+1
2944	ENDDO
2945	aero_old(1:nbins_aerosol)%volc(vc) = lo_aero(1:nbins_aerosol)%volc(vc)
2946	ENDIF
2947	!
2948	!-- Dust (DU)
2949	IF ( index_du > 0 ) THEN
2950	vc = 4
2951	str = ( index_du-1 ) * nbins_aerosol + 1 + end_subrange_1a
2952	endi = index_du * nbins_aerosol
2953	ic = 1 + end_subrange_1a
2954	DO ss = str, endi
2955	lo_aero(ic)%volc(vc) = aerosol_mass(ss)%conc(k,j,i) / arhodu
2956	ic = ic+1
2957	ENDDO
2958	aero_old(1:nbins_aerosol)%volc(vc) = lo_aero(1:nbins_aerosol)%volc(vc)
2959	ENDIF
2960	!
2961	!-- Sea salt (SS)
2962	IF ( index_ss > 0 ) THEN
2963	vc = 5
2964	str = ( index_ss-1 ) * nbins_aerosol + 1 + end_subrange_1a
2965	endi = index_ss * nbins_aerosol
2966	ic = 1 + end_subrange_1a
2967	DO ss = str, endi
2968	lo_aero(ic)%volc(vc) = aerosol_mass(ss)%conc(k,j,i) / arhoss
2969	ic = ic+1
2970	ENDDO
2971	aero_old(1:nbins_aerosol)%volc(vc) = lo_aero(1:nbins_aerosol)%volc(vc)
2972	ENDIF
2973	!
2974	!-- Nitrate (NO(3-)) or nitric acid HNO3
2975	IF ( index_no > 0 ) THEN
2976	vc = 6
2977	str = ( index_no-1 ) * nbins_aerosol + 1
2978	endi = index_no * nbins_aerosol
2979	ic = 1
2980	DO ss = str, endi
2981	lo_aero(ic)%volc(vc) = aerosol_mass(ss)%conc(k,j,i) / arhohno3
2982	ic = ic+1
2983	ENDDO
2984	aero_old(1:nbins_aerosol)%volc(vc) = lo_aero(1:nbins_aerosol)%volc(vc)
2985	ENDIF
2986	!
2987	!-- Ammonium (NH(4+)) or ammonia NH3
2988	IF ( index_nh > 0 ) THEN
2989	vc = 7
2990	str = ( index_nh-1 ) * nbins_aerosol + 1
2991	endi = index_nh * nbins_aerosol
2992	ic = 1
2993	DO ss = str, endi
2994	lo_aero(ic)%volc(vc) = aerosol_mass(ss)%conc(k,j,i) / arhonh3
2995	ic = ic+1
2996	ENDDO
2997	aero_old(1:nbins_aerosol)%volc(vc) = lo_aero(1:nbins_aerosol)%volc(vc)
2998	ENDIF
2999	!
3000	!-- Water (always used)
3001	nc_h2o = get_index( prtcl,'H2O' )
3002	vc = 8
3003	str = ( nc_h2o-1 ) * nbins_aerosol + 1
3004	endi = nc_h2o * nbins_aerosol
3005	ic = 1
3006	IF ( advect_particle_water ) THEN
3007	DO ss = str, endi
3008	lo_aero(ic)%volc(vc) = aerosol_mass(ss)%conc(k,j,i) / arhoh2o
3009	ic = ic+1
3010	ENDDO
3011	ELSE
3012	lo_aero(1:nbins_aerosol)%volc(vc) = mclim
3013	ENDIF
3014	aero_old(1:nbins_aerosol)%volc(vc) = lo_aero(1:nbins_aerosol)%volc(vc)
3015	!
3016	!-- Number concentrations (numc) and particle sizes
3017	!-- (dwet = wet diameter, core = dry volume)
3018	DO ib = 1, nbins_aerosol
3019	lo_aero(ib)%numc = aerosol_number(ib)%conc(k,j,i)
3020	aero_old(ib)%numc = lo_aero(ib)%numc
3021	IF ( lo_aero(ib)%numc > nclim ) THEN
3022	lo_aero(ib)%dwet = ( SUM( lo_aero(ib)%volc(:) ) / lo_aero(ib)%numc / api6 )**0.33333333_wp
3023	lo_aero(ib)%core = SUM( lo_aero(ib)%volc(1:7) ) / lo_aero(ib)%numc
3024	ELSE
3025	lo_aero(ib)%dwet = lo_aero(ib)%dmid
3026	lo_aero(ib)%core = api6 * ( lo_aero(ib)%dwet )**3
3027	ENDIF
3028	ENDDO
3029	!
3030	!-- Calculate the ambient sizes of particles by equilibrating soluble fraction of particles with
3031	!-- water using the ZSR method.
3032	in_rh = in_cw(k) / in_cs(k)
3033	IF ( prunmode==1 .OR. .NOT. advect_particle_water ) THEN
3034	CALL equilibration( in_rh, in_t(k), lo_aero, .TRUE. )
3035	ENDIF
3036	!
3037	!-- Gaseous tracer concentrations in #/m3
3038	IF ( salsa_gases_from_chem ) THEN
3039	!
3040	!-- Convert concentrations in ppm to #/m3
3041	zgso4 = chem_species(gas_index_chem(1))%conc(k,j,i) * ppm_to_nconc(k)
3042	zghno3 = chem_species(gas_index_chem(2))%conc(k,j,i) * ppm_to_nconc(k)
3043	zgnh3 = chem_species(gas_index_chem(3))%conc(k,j,i) * ppm_to_nconc(k)
3044	zgocnv = chem_species(gas_index_chem(4))%conc(k,j,i) * ppm_to_nconc(k)
3045	zgocsv = chem_species(gas_index_chem(5))%conc(k,j,i) * ppm_to_nconc(k)
3046	ELSE
3047	zgso4 = salsa_gas(1)%conc(k,j,i)
3048	zghno3 = salsa_gas(2)%conc(k,j,i)
3049	zgnh3 = salsa_gas(3)%conc(k,j,i)
3050	zgocnv = salsa_gas(4)%conc(k,j,i)
3051	zgocsv = salsa_gas(5)%conc(k,j,i)
3052	ENDIF
3053	!
3054	!-- Calculate aerosol processes:
3055	!-- *********************************************************************************************
3056	!
3057	!-- Coagulation
3058	IF ( lscoag ) THEN
3059	CALL coagulation( lo_aero, dt_salsa, in_t(k), in_p(k) )
3060	ENDIF
3061	!
3062	!-- Condensation
3063	IF ( lscnd ) THEN
3064	CALL condensation( lo_aero, zgso4, zgocnv, zgocsv, zghno3, zgnh3, in_cw(k), in_cs(k), &
3065	in_t(k), in_p(k), dt_salsa, prtcl )
3066	ENDIF
3067	!
3068	!-- Deposition
3069	IF ( lsdepo ) THEN
3070	CALL deposition( lo_aero, in_t(k), in_adn(k), in_u(k), in_lad, kvis(k), schmidt_num(k,:),&
3071	vd(k,:) )
3072	ENDIF
3073	!
3074	!-- Size distribution bin update
3075	IF ( lsdistupdate ) THEN
3076	CALL distr_update( lo_aero )
3077	ENDIF
3078	!-- *********************************************************************************************
3079
3080	IF ( lsdepo ) sedim_vd(k,j,i,:) = vd(k,:)
3081	!
3082	!-- Calculate changes in concentrations
3083	DO ib = 1, nbins_aerosol
3084	aerosol_number(ib)%conc(k,j,i) = aerosol_number(ib)%conc(k,j,i) + ( lo_aero(ib)%numc - &
3085	aero_old(ib)%numc ) * flag
3086	ENDDO
3087
3088	IF ( index_so4 > 0 ) THEN
3089	vc = 1
3090	str = ( index_so4-1 ) * nbins_aerosol + 1
3091	endi = index_so4 * nbins_aerosol
3092	ic = 1
3093	DO ss = str, endi
3094	aerosol_mass(ss)%conc(k,j,i) = aerosol_mass(ss)%conc(k,j,i) + ( lo_aero(ic)%volc(vc) -&
3095	aero_old(ic)%volc(vc) ) * arhoh2so4 * flag
3096	ic = ic+1
3097	ENDDO
3098	ENDIF
3099
3100	IF ( index_oc > 0 ) THEN
3101	vc = 2
3102	str = ( index_oc-1 ) * nbins_aerosol + 1
3103	endi = index_oc * nbins_aerosol
3104	ic = 1
3105	DO ss = str, endi
3106	aerosol_mass(ss)%conc(k,j,i) = aerosol_mass(ss)%conc(k,j,i) + ( lo_aero(ic)%volc(vc) -&
3107	aero_old(ic)%volc(vc) ) * arhooc * flag
3108	ic = ic+1
3109	ENDDO
3110	ENDIF
3111
3112	IF ( index_bc > 0 ) THEN
3113	vc = 3
3114	str = ( index_bc-1 ) * nbins_aerosol + 1 + end_subrange_1a
3115	endi = index_bc * nbins_aerosol
3116	ic = 1 + end_subrange_1a
3117	DO ss = str, endi
3118	aerosol_mass(ss)%conc(k,j,i) = aerosol_mass(ss)%conc(k,j,i) + ( lo_aero(ic)%volc(vc) -&
3119	aero_old(ic)%volc(vc) ) * arhobc * flag
3120	ic = ic+1
3121	ENDDO
3122	ENDIF
3123
3124	IF ( index_du > 0 ) THEN
3125	vc = 4
3126	str = ( index_du-1 ) * nbins_aerosol + 1 + end_subrange_1a
3127	endi = index_du * nbins_aerosol
3128	ic = 1 + end_subrange_1a
3129	DO ss = str, endi
3130	aerosol_mass(ss)%conc(k,j,i) = aerosol_mass(ss)%conc(k,j,i) + ( lo_aero(ic)%volc(vc) -&
3131	aero_old(ic)%volc(vc) ) * arhodu * flag
3132	ic = ic+1
3133	ENDDO
3134	ENDIF
3135
3136	IF ( index_ss > 0 ) THEN
3137	vc = 5
3138	str = ( index_ss-1 ) * nbins_aerosol + 1 + end_subrange_1a
3139	endi = index_ss * nbins_aerosol
3140	ic = 1 + end_subrange_1a
3141	DO ss = str, endi
3142	aerosol_mass(ss)%conc(k,j,i) = aerosol_mass(ss)%conc(k,j,i) + ( lo_aero(ic)%volc(vc) -&
3143	aero_old(ic)%volc(vc) ) * arhoss * flag
3144	ic = ic+1
3145	ENDDO
3146	ENDIF
3147
3148	IF ( index_no > 0 ) THEN
3149	vc = 6
3150	str = ( index_no-1 ) * nbins_aerosol + 1
3151	endi = index_no * nbins_aerosol
3152	ic = 1
3153	DO ss = str, endi
3154	aerosol_mass(ss)%conc(k,j,i) = aerosol_mass(ss)%conc(k,j,i) + ( lo_aero(ic)%volc(vc) -&
3155	aero_old(ic)%volc(vc) ) * arhohno3 * flag
3156	ic = ic+1
3157	ENDDO
3158	ENDIF
3159
3160	IF ( index_nh > 0 ) THEN
3161	vc = 7
3162	str = ( index_nh-1 ) * nbins_aerosol + 1
3163	endi = index_nh * nbins_aerosol
3164	ic = 1
3165	DO ss = str, endi
3166	aerosol_mass(ss)%conc(k,j,i) = aerosol_mass(ss)%conc(k,j,i) + ( lo_aero(ic)%volc(vc) -&
3167	aero_old(ic)%volc(vc) ) * arhonh3 * flag
3168	ic = ic+1
3169	ENDDO
3170	ENDIF
3171
3172	IF ( advect_particle_water ) THEN
3173	nc_h2o = get_index( prtcl,'H2O' )
3174	vc = 8
3175	str = ( nc_h2o-1 ) * nbins_aerosol + 1
3176	endi = nc_h2o * nbins_aerosol
3177	ic = 1
3178	DO ss = str, endi
3179	aerosol_mass(ss)%conc(k,j,i) = aerosol_mass(ss)%conc(k,j,i) + ( lo_aero(ic)%volc(vc) -&
3180	aero_old(ic)%volc(vc) ) * arhoh2o * flag
3181	ic = ic+1
3182	ENDDO
3183	ENDIF
3184	IF ( prunmode == 1 ) THEN
3185	nc_h2o = get_index( prtcl,'H2O' )
3186	vc = 8
3187	str = ( nc_h2o-1 ) * nbins_aerosol + 1
3188	endi = nc_h2o * nbins_aerosol
3189	ic = 1
3190	DO ss = str, endi
3191	aerosol_mass(ss)%init(k) = MAX( aerosol_mass(ss)%init(k), ( lo_aero(ic)%volc(vc) - &
3192	aero_old(ic)%volc(vc) ) * arhoh2o )
3193	IF ( k == nzb+1 ) THEN
3194	aerosol_mass(ss)%init(k-1) = aerosol_mass(ss)%init(k)
3195	ELSEIF ( k == nzt ) THEN
3196	aerosol_mass(ss)%init(k+1) = aerosol_mass(ss)%init(k)
3197	aerosol_mass(ss)%conc(k+1,j,i) = aerosol_mass(ss)%init(k)
3198	ENDIF
3199	ic = ic+1
3200	ENDDO
3201	ENDIF
3202	!
3203	!-- Condensation of precursor gases
3204	IF ( lscndgas ) THEN
3205	IF ( salsa_gases_from_chem ) THEN
3206	!
3207	!-- SO4 (or H2SO4)
3208	ig = gas_index_chem(1)
3209	chem_species(ig)%conc(k,j,i) = chem_species(ig)%conc(k,j,i) + ( zgso4 / &
3210	ppm_to_nconc(k) - chem_species(ig)%conc(k,j,i) ) * flag
3211	!
3212	!-- HNO3
3213	ig = gas_index_chem(2)
3214	chem_species(ig)%conc(k,j,i) = chem_species(ig)%conc(k,j,i) + ( zghno3 / &
3215	ppm_to_nconc(k) - chem_species(ig)%conc(k,j,i) ) * flag
3216	!
3217	!-- NH3
3218	ig = gas_index_chem(3)
3219	chem_species(ig)%conc(k,j,i) = chem_species(ig)%conc(k,j,i) + ( zgnh3 / &
3220	ppm_to_nconc(k) - chem_species(ig)%conc(k,j,i) ) * flag
3221	!
3222	!-- non-volatile OC
3223	ig = gas_index_chem(4)
3224	chem_species(ig)%conc(k,j,i) = chem_species(ig)%conc(k,j,i) + ( zgocnv / &
3225	ppm_to_nconc(k) - chem_species(ig)%conc(k,j,i) ) * flag
3226	!
3227	!-- semi-volatile OC
3228	ig = gas_index_chem(5)
3229	chem_species(ig)%conc(k,j,i) = chem_species(ig)%conc(k,j,i) + ( zgocsv / &
3230	ppm_to_nconc(k) - chem_species(ig)%conc(k,j,i) ) * flag
3231
3232	ELSE
3233	!
3234	!-- SO4 (or H2SO4)
3235	salsa_gas(1)%conc(k,j,i) = salsa_gas(1)%conc(k,j,i) + ( zgso4 - &
3236	salsa_gas(1)%conc(k,j,i) ) * flag
3237	!
3238	!-- HNO3
3239	salsa_gas(2)%conc(k,j,i) = salsa_gas(2)%conc(k,j,i) + ( zghno3 - &
3240	salsa_gas(2)%conc(k,j,i) ) * flag
3241	!
3242	!-- NH3
3243	salsa_gas(3)%conc(k,j,i) = salsa_gas(3)%conc(k,j,i) + ( zgnh3 - &
3244	salsa_gas(3)%conc(k,j,i) ) * flag
3245	!
3246	!-- non-volatile OC
3247	salsa_gas(4)%conc(k,j,i) = salsa_gas(4)%conc(k,j,i) + ( zgocnv - &
3248	salsa_gas(4)%conc(k,j,i) ) * flag
3249	!
3250	!-- semi-volatile OC
3251	salsa_gas(5)%conc(k,j,i) = salsa_gas(5)%conc(k,j,i) + ( zgocsv - &
3252	salsa_gas(5)%conc(k,j,i) ) * flag
3253	ENDIF
3254	ENDIF
3255	!
3256	!-- Tendency of water vapour mixing ratio is obtained from the change in RH during SALSA run.
3257	!-- This releases heat and changes pt. Assumes no temperature change during SALSA run.
3258	!-- q = r / (1+r), Euler method for integration
3259	!
3260	IF ( feedback_to_palm ) THEN
3261	q_p(k,j,i) = q_p(k,j,i) + 1.0_wp / ( in_cw(k) * in_adn(k) + 1.0_wp )*2 &
3262	( in_cw(k) - cw_old ) * in_adn(k) * flag
3263	pt_p(k,j,i) = pt_p(k,j,i) + alv / c_p * ( in_cw(k) - cw_old ) * in_adn(k) / ( in_cw(k) / &
3264	in_adn(k) + 1.0_wp )*2 pt_p(k,j,i) / in_t(k) * flag
3265	ENDIF
3266
3267	ENDDO ! k
3268
3269	!
3270	!-- Set surfaces and wall fluxes due to deposition
3271	IF ( lsdepo .AND. lsdepo_surf .AND. prunmode == 3 ) THEN
3272	IF ( .NOT. land_surface .AND. .NOT. urban_surface ) THEN
3273	CALL depo_surf( i, j, surf_def_h(0), vd, schmidt_num, kvis, in_u, .TRUE. )
3274	DO l = 0, 3
3275	CALL depo_surf( i, j, surf_def_v(l), vd, schmidt_num, kvis, in_u, .FALSE. )
3276	ENDDO
3277	ELSE
3278	CALL depo_surf( i, j, surf_usm_h, vd, schmidt_num, kvis, in_u, .TRUE., usm_to_depo_h )
3279	DO l = 0, 3
3280	CALL depo_surf( i, j, surf_usm_v(l), vd, schmidt_num, kvis, in_u, .FALSE., &
3281	usm_to_depo_v(l) )
3282	ENDDO
3283	CALL depo_surf( i, j, surf_lsm_h, vd, schmidt_num, kvis, in_u, .TRUE., lsm_to_depo_h )
3284	DO l = 0, 3
3285	CALL depo_surf( i, j, surf_lsm_v(l), vd, schmidt_num, kvis, in_u, .FALSE., &
3286	lsm_to_depo_v(l) )
3287	ENDDO
3288	ENDIF
3289	ENDIF
3290
3291	IF ( prunmode < 3 ) THEN
3292	!$OMP MASTER
3293	aero = lo_aero
3294	!$OMP END MASTER
3295	END IF
3296
3297	END SUBROUTINE salsa_driver
3298
3299	!------------------------------------------------------------------------------!
3300	! Description:
3301	! ------------
3302	!> Set logical switches according to the salsa_parameters options.
3303	!> Juha Tonttila, FMI, 2014
3304	!> Only aerosol processes included, Mona Kurppa, UHel, 2017
3305	!------------------------------------------------------------------------------!
3306	SUBROUTINE set_salsa_runtime( prunmode )
3307
3308	IMPLICIT NONE
3309
3310	INTEGER(iwp), INTENT(in) :: prunmode
3311
3312	SELECT CASE(prunmode)
3313
3314	CASE(1) !< Initialization
3315	lscoag = .FALSE.
3316	lscnd = .FALSE.
3317	lscndgas = .FALSE.
3318	lscndh2oae = .FALSE.
3319	lsdepo = .FALSE.
3320	lsdepo_pcm = .FALSE.
3321	lsdepo_surf = .FALSE.
3322	lsdistupdate = .TRUE.
3323	lspartition = .FALSE.
3324
3325	CASE(2) !< Spinup period
3326	lscoag = ( .FALSE. .AND. nlcoag )
3327	lscnd = ( .TRUE. .AND. nlcnd )
3328	lscndgas = ( .TRUE. .AND. nlcndgas )
3329	lscndh2oae = ( .TRUE. .AND. nlcndh2oae )
3330
3331	CASE(3) !< Run
3332	lscoag = nlcoag
3333	lscnd = nlcnd
3334	lscndgas = nlcndgas
3335	lscndh2oae = nlcndh2oae
3336	lsdepo = nldepo
3337	lsdepo_pcm = nldepo_pcm
3338	lsdepo_surf = nldepo_surf
3339	lsdistupdate = nldistupdate
3340	END SELECT
3341
3342
3343	END SUBROUTINE set_salsa_runtime
3344
3345	!------------------------------------------------------------------------------!
3346	! Description:
3347	! ------------
3348	!> Calculates the absolute temperature (using hydrostatic pressure), saturation
3349	!> vapour pressure and mixing ratio over water, relative humidity and air
3350	!> density needed in the SALSA model.
3351	!> NOTE, no saturation adjustment takes place -> the resulting water vapour
3352	!> mixing ratio can be supersaturated, allowing the microphysical calculations
3353	!> in SALSA.
3354	!
3355	!> Juha Tonttila, FMI, 2014 (original SALSAthrm)
3356	!> Mona Kurppa, UHel, 2017 (adjustment for PALM and only aerosol processes)
3357	!------------------------------------------------------------------------------!
3358	SUBROUTINE salsa_thrm_ij( i, j, p_ij, temp_ij, cw_ij, cs_ij, adn_ij )
3359
3360	USE arrays_3d, &
3361	ONLY: pt, q, zu
3362
3363	USE basic_constants_and_equations_mod, &
3364	ONLY: barometric_formula, exner_function, ideal_gas_law_rho, magnus
3365
3366	IMPLICIT NONE
3367
3368	INTEGER(iwp), INTENT(in) :: i !<
3369	INTEGER(iwp), INTENT(in) :: j !<
3370
3371	REAL(wp) :: t_surface !< absolute surface temperature (K)
3372
3373	REAL(wp), DIMENSION(nzb:nzt+1) :: e_s !< saturation vapour pressure over water (Pa)
3374
3375	REAL(wp), DIMENSION(:), INTENT(inout) :: adn_ij !< air density (kg/m3)
3376	REAL(wp), DIMENSION(:), INTENT(inout) :: p_ij !< air pressure (Pa)
3377	REAL(wp), DIMENSION(:), INTENT(inout) :: temp_ij !< air temperature (K)
3378
3379	REAL(wp), DIMENSION(:), INTENT(inout), OPTIONAL :: cw_ij !< water vapour concentration (kg/m3)
3380	REAL(wp), DIMENSION(:), INTENT(inout), OPTIONAL :: cs_ij !< saturation water vap. conc.(kg/m3)
3381	!
3382	!-- Pressure p_ijk (Pa) = hydrostatic pressure
3383	t_surface = pt_surface * exner_function( surface_pressure * 100.0_wp )
3384	p_ij(:) = barometric_formula( zu, t_surface, surface_pressure * 100.0_wp )
3385	!
3386	!-- Absolute ambient temperature (K)
3387	temp_ij(:) = pt(:,j,i) * exner_function( p_ij(:) )
3388	!
3389	!-- Air density
3390	adn_ij(:) = ideal_gas_law_rho( p_ij(:), temp_ij(:) )
3391	!
3392	!-- Water vapour concentration r_v (kg/m3)
3393	IF ( PRESENT( cw_ij ) ) THEN
3394	cw_ij(:) = ( q(:,j,i) / ( 1.0_wp - q(:,j,i) ) ) * adn_ij(:)
3395	ENDIF
3396	!
3397	!-- Saturation mixing ratio r_s (kg/kg) from vapour pressure at temp (Pa)
3398	IF ( PRESENT( cs_ij ) ) THEN
3399	e_s(:) = 611.0_wp * EXP( alv_d_rv * ( 3.6609E-3_wp - 1.0_wp / &
3400	temp_ij(:) ) )! magnus( temp_ij(:) )
3401	cs_ij(:) = ( 0.622_wp * e_s / ( p_ij(:) - e_s(:) ) ) * adn_ij(:)
3402	ENDIF
3403
3404	END SUBROUTINE salsa_thrm_ij
3405
3406	!------------------------------------------------------------------------------!
3407	! Description:
3408	! ------------
3409	!> Calculates ambient sizes of particles by equilibrating soluble fraction of
3410	!> particles with water using the ZSR method (Stokes and Robinson, 1966).
3411	!> Method:
3412	!> Following chemical components are assumed water-soluble
3413	!> - (ammonium) sulphate (100%)
3414	!> - sea salt (100 %)
3415	!> - organic carbon (epsoc * 100%)
3416	!> Exact thermodynamic considerations neglected.
3417	!> - If particles contain no sea salt, calculation according to sulphate
3418	!> properties
3419	!> - If contain sea salt but no sulphate, calculation according to sea salt
3420	!> properties
3421	!> - If contain both sulphate and sea salt -> the molar fraction of these
3422	!> compounds determines which one of them is used as the basis of calculation.
3423	!> If sulphate and sea salt coexist in a particle, it is assumed that the Cl is
3424	!> replaced by sulphate; thus only either sulphate + organics or sea salt +
3425	!> organics is included in the calculation of soluble fraction.
3426	!> Molality parameterizations taken from Table 1 of Tang: Thermodynamic and
3427	!> optical properties of mixed-salt aerosols of atmospheric importance,
3428	!> J. Geophys. Res., 102 (D2), 1883-1893 (1997)
3429	!
3430	!> Coded by:
3431	!> Hannele Korhonen (FMI) 2005
3432	!> Harri Kokkola (FMI) 2006
3433	!> Matti Niskanen(FMI) 2012
3434	!> Anton Laakso (FMI) 2013
3435	!> Modified for the new aerosol datatype, Juha Tonttila (FMI) 2014
3436	!
3437	!> fxm: should sea salt form a solid particle when prh is very low (even though
3438	!> it could be mixed with e.g. sulphate)?
3439	!> fxm: crashes if no sulphate or sea salt
3440	!> fxm: do we really need to consider Kelvin effect for subrange 2
3441	!------------------------------------------------------------------------------!
3442	SUBROUTINE equilibration( prh, ptemp, paero, init )
3443
3444	IMPLICIT NONE
3445
3446	INTEGER(iwp) :: ib !< loop index
3447	INTEGER(iwp) :: counti !< loop index
3448
3449	LOGICAL, INTENT(in) :: init !< TRUE: Initialization, FALSE: Normal runtime: update water
3450	!< content only for 1a
3451
3452	REAL(wp) :: zaw !< water activity [0-1]
3453	REAL(wp) :: zcore !< Volume of dry particle
3454	REAL(wp) :: zdold !< Old diameter
3455	REAL(wp) :: zdwet !< Wet diameter or mean droplet diameter
3456	REAL(wp) :: zke !< Kelvin term in the KÃ¶hler equation
3457	REAL(wp) :: zlwc !< liquid water content [kg/m3-air]
3458	REAL(wp) :: zrh !< Relative humidity
3459
3460	REAL(wp), DIMENSION(maxspec) :: zbinmol !< binary molality of each components (mol/kg)
3461	REAL(wp), DIMENSION(maxspec) :: zvpart !< volume of chem. compounds in one particle
3462
3463	REAL(wp), INTENT(in) :: prh !< relative humidity [0-1]
3464	REAL(wp), INTENT(in) :: ptemp !< temperature (K)
3465
3466	TYPE(t_section), DIMENSION(nbins_aerosol), INTENT(inout) :: paero !< aerosol properties
3467
3468	zaw = 0.0_wp
3469	zlwc = 0.0_wp
3470	!
3471	!-- Relative humidity:
3472	zrh = prh
3473	zrh = MAX( zrh, 0.05_wp )
3474	zrh = MIN( zrh, 0.98_wp)
3475	!
3476	!-- 1) Regime 1: sulphate and partly water-soluble OC. Done for every CALL
3477	DO ib = start_subrange_1a, end_subrange_1a ! size bin
3478
3479	zbinmol = 0.0_wp
3480	zdold = 1.0_wp
3481	zke = 1.02_wp
3482
3483	IF ( paero(ib)%numc > nclim ) THEN
3484	!
3485	!-- Volume in one particle
3486	zvpart = 0.0_wp
3487	zvpart(1:2) = paero(ib)%volc(1:2) / paero(ib)%numc
3488	zvpart(6:7) = paero(ib)%volc(6:7) / paero(ib)%numc
3489	!
3490	!-- Total volume and wet diameter of one dry particle
3491	zcore = SUM( zvpart(1:2) )
3492	zdwet = paero(ib)%dwet
3493
3494	counti = 0
3495	DO WHILE ( ABS( zdwet / zdold - 1.0_wp ) > 1.0E-2_wp )
3496
3497	zdold = MAX( zdwet, 1.0E-20_wp )
3498	zaw = MAX( 1.0E-3_wp, zrh / zke ) ! To avoid underflow
3499	!
3500	!-- Binary molalities (mol/kg):
3501	!-- Sulphate
3502	zbinmol(1) = 1.1065495E+2_wp - 3.6759197E+2_wp * zaw + 5.0462934E+2_wp * zaw**2 - &
3503	3.1543839E+2_wp * zaw*3 + 6.770824E+1_wp zaw**4
3504	!-- Organic carbon
3505	zbinmol(2) = 1.0_wp / ( zaw * amh2o ) - 1.0_wp / amh2o
3506	!-- Nitric acid
3507	zbinmol(6) = 2.306844303E+1_wp - 3.563608869E+1_wp * zaw - 6.210577919E+1_wp * zaw**2 &
3508	+ 5.510176187E+2_wp * zaw*3 - 1.460055286E+3_wp zaw**4 &
3509	+ 1.894467542E+3_wp * zaw*5 - 1.220611402E+3_wp zaw**6 &
3510	+ 3.098597737E+2_wp * zaw**7
3511	!
3512	!-- Calculate the liquid water content (kg/m3-air) using ZSR (see e.g. Eq. 10.98 in
3513	!-- Seinfeld and Pandis (2006))
3514	zlwc = ( paero(ib)%volc(1) * ( arhoh2so4 / amh2so4 ) ) / zbinmol(1) + &
3515	epsoc * paero(ib)%volc(2) * ( arhooc / amoc ) / zbinmol(2) + &
3516	( paero(ib)%volc(6) * ( arhohno3/amhno3 ) ) / zbinmol(6)
3517	!
3518	!-- Particle wet diameter (m)
3519	zdwet = ( zlwc / paero(ib)%numc / arhoh2o / api6 + ( SUM( zvpart(6:7) ) / api6 ) + &
3520	zcore / api6 )**0.33333333_wp
3521	!
3522	!-- Kelvin effect (Eq. 10.85 in in Seinfeld and Pandis (2006)). Avoid
3523	!-- overflow.
3524	zke = EXP( MIN( 50.0_wp, 4.0_wp * surfw0 * amvh2so4 / ( abo * ptemp * zdwet ) ) )
3525
3526	counti = counti + 1
3527	IF ( counti > 1000 ) THEN
3528	message_string = 'Subrange 1: no convergence!'
3529	CALL message( 'salsa_mod: equilibration', 'PA0617', 1, 2, 0, 6, 0 )
3530	ENDIF
3531	ENDDO
3532	!
3533	!-- Instead of lwc, use the volume concentration of water from now on
3534	!-- (easy to convert...)
3535	paero(ib)%volc(8) = zlwc / arhoh2o
3536	!
3537	!-- If this is initialization, update the core and wet diameter
3538	IF ( init ) THEN
3539	paero(ib)%dwet = zdwet
3540	paero(ib)%core = zcore
3541	ENDIF
3542
3543	ELSE
3544	!-- If initialization
3545	!-- 1.2) empty bins given bin average values
3546	IF ( init ) THEN
3547	paero(ib)%dwet = paero(ib)%dmid
3548	paero(ib)%core = api6 * paero(ib)%dmid**3
3549	ENDIF
3550
3551	ENDIF
3552
3553	ENDDO ! ib
3554	!
3555	!-- 2) Regime 2a: sulphate, OC, BC and sea salt
3556	!-- This is done only for initialization call, otherwise the water contents
3557	!-- are computed via condensation
3558	IF ( init ) THEN
3559	DO ib = start_subrange_2a, end_subrange_2b
3560	!
3561	!-- Initialize
3562	zke = 1.02_wp
3563	zbinmol = 0.0_wp
3564	zdold = 1.0_wp
3565	!
3566	!-- 1) Particle properties calculated for non-empty bins
3567	IF ( paero(ib)%numc > nclim ) THEN
3568	!
3569	!-- Volume in one particle [fxm]
3570	zvpart = 0.0_wp
3571	zvpart(1:7) = paero(ib)%volc(1:7) / paero(ib)%numc
3572	!
3573	!-- Total volume and wet diameter of one dry particle [fxm]
3574	zcore = SUM( zvpart(1:5) )
3575	zdwet = paero(ib)%dwet
3576
3577	counti = 0
3578	DO WHILE ( ABS( zdwet / zdold - 1.0_wp ) > 1.0E-12_wp )
3579
3580	zdold = MAX( zdwet, 1.0E-20_wp )
3581	zaw = zrh / zke
3582	!
3583	!-- Binary molalities (mol/kg):
3584	!-- Sulphate
3585	zbinmol(1) = 1.1065495E+2_wp - 3.6759197E+2_wp * zaw + 5.0462934E+2_wp * zaw**2 - &
3586	3.1543839E+2_wp * zaw*3 + 6.770824E+1_wp zaw**4
3587	!-- Organic carbon
3588	zbinmol(2) = 1.0_wp / ( zaw * amh2o ) - 1.0_wp / amh2o
3589	!-- Nitric acid
3590	zbinmol(6) = 2.306844303E+1_wp - 3.563608869E+1_wp * zaw - &
3591	6.210577919E+1_wp * zaw*2 + 5.510176187E+2_wp zaw**3 - &
3592	1.460055286E+3_wp * zaw*4 + 1.894467542E+3_wp zaw**5 - &
3593	1.220611402E+3_wp * zaw*6 + 3.098597737E+2_wp zaw**7
3594	!-- Sea salt (natrium chloride)
3595	zbinmol(5) = 5.875248E+1_wp - 1.8781997E+2_wp * zaw + 2.7211377E+2_wp * zaw**2 - &
3596	1.8458287E+2_wp * zaw*3 + 4.153689E+1_wp zaw**4
3597	!
3598	!-- Calculate the liquid water content (kg/m3-air)
3599	zlwc = ( paero(ib)%volc(1) * ( arhoh2so4 / amh2so4 ) ) / zbinmol(1) + &
3600	epsoc * ( paero(ib)%volc(2) * ( arhooc / amoc ) ) / zbinmol(2) + &
3601	( paero(ib)%volc(6) * ( arhohno3 / amhno3 ) ) / zbinmol(6) + &
3602	( paero(ib)%volc(5) * ( arhoss / amss ) ) / zbinmol(5)
3603
3604	!-- Particle wet radius (m)
3605	zdwet = ( zlwc / paero(ib)%numc / arhoh2o / api6 + ( SUM( zvpart(6:7) ) / api6 ) + &
3606	zcore / api6 )**0.33333333_wp
3607	!
3608	!-- Kelvin effect (Eq. 10.85 in Seinfeld and Pandis (2006))
3609	zke = EXP( MIN( 50.0_wp, 4.0_wp * surfw0 * amvh2so4 / ( abo * zdwet * ptemp ) ) )
3610
3611	counti = counti + 1
3612	IF ( counti > 1000 ) THEN
3613	message_string = 'Subrange 2: no convergence!'
3614	CALL message( 'salsa_mod: equilibration', 'PA0618', 1, 2, 0, 6, 0 )
3615	ENDIF
3616	ENDDO
3617	!
3618	!-- Liquid water content; instead of LWC use the volume concentration
3619	paero(ib)%volc(8) = zlwc / arhoh2o
3620	paero(ib)%dwet = zdwet
3621	paero(ib)%core = zcore
3622
3623	ELSE
3624	!-- 2.2) empty bins given bin average values
3625	paero(ib)%dwet = paero(ib)%dmid
3626	paero(ib)%core = api6 * paero(ib)%dmid**3
3627	ENDIF
3628
3629	ENDDO ! ib
3630	ENDIF
3631
3632	END SUBROUTINE equilibration
3633
3634	!------------------------------------------------------------------------------!
3635	!> Description:
3636	!> ------------
3637	!> Calculation of the settling velocity vc (m/s) per aerosol size bin and
3638	!> deposition on plant canopy (lsdepo_pcm).
3639	!
3640	!> Deposition is based on either the scheme presented in:
3641	!> Zhang et al. (2001), Atmos. Environ. 35, 549-560 (includes collection due to
3642	!> Brownian diffusion, impaction, interception and sedimentation; hereafter ZO1)
3643	!> OR
3644	!> Petroff & Zhang (2010), Geosci. Model Dev. 3, 753-769 (includes also
3645	!> collection due to turbulent impaction, hereafter P10)
3646	!
3647	!> Equation numbers refer to equation in Jacobson (2005): Fundamentals of
3648	!> Atmospheric Modeling, 2nd Edition.
3649	!
3650	!> Subroutine follows closely sedim_SALSA in UCLALES-SALSA written by Juha
3651	!> Tonttila (KIT/FMI) and Zubair Maalick (UEF).
3652	!> Rewritten to PALM by Mona Kurppa (UH), 2017.
3653	!
3654	!> Call for grid point i,j,k
3655	!------------------------------------------------------------------------------!
3656
3657	SUBROUTINE deposition( paero, tk, adn, mag_u, lad, kvis, schmidt_num, vc )
3658
3659	USE plant_canopy_model_mod, &
3660	ONLY: cdc
3661
3662	IMPLICIT NONE
3663
3664	INTEGER(iwp) :: ib !< loop index
3665	INTEGER(iwp) :: ic !< loop index
3666
3667	REAL(wp) :: alpha !< parameter, Table 3 in Z01
3668	REAL(wp) :: avis !< molecular viscocity of air (kg/(m*s))
3669	REAL(wp) :: beta_im !< parameter for turbulent impaction
3670	REAL(wp) :: c_brownian_diff !< coefficient for Brownian diffusion
3671	REAL(wp) :: c_impaction !< coefficient for inertial impaction
3672	REAL(wp) :: c_interception !< coefficient for interception
3673	REAL(wp) :: c_turb_impaction !< coefficient for turbulent impaction
3674	REAL(wp) :: depo !< deposition velocity (m/s)
3675	REAL(wp) :: gamma !< parameter, Table 3 in Z01
3676	REAL(wp) :: lambda !< molecular mean free path (m)
3677	REAL(wp) :: mdiff !< particle diffusivity coefficient
3678	REAL(wp) :: par_a !< parameter A for the characteristic radius of collectors,
3679	!< Table 3 in Z01
3680	REAL(wp) :: par_l !< obstacle characteristic dimension in P10
3681	REAL(wp) :: pdn !< particle density (kg/m3)
3682	REAL(wp) :: ustar !< friction velocity (m/s)
3683	REAL(wp) :: va !< thermal speed of an air molecule (m/s)
3684
3685	REAL(wp), INTENT(in) :: adn !< air density (kg/m3)
3686	REAL(wp), INTENT(in) :: lad !< leaf area density (m2/m3)
3687	REAL(wp), INTENT(in) :: mag_u !< wind velocity (m/s)
3688	REAL(wp), INTENT(in) :: tk !< abs.temperature (K)
3689
3690	REAL(wp), INTENT(inout) :: kvis !< kinematic viscosity of air (m2/s)
3691
3692	REAL(wp), DIMENSION(nbins_aerosol) :: beta !< Cunningham slip-flow correction factor
3693	REAL(wp), DIMENSION(nbins_aerosol) :: Kn !< Knudsen number
3694	REAL(wp), DIMENSION(nbins_aerosol) :: zdwet !< wet diameter (m)
3695
3696	REAL(wp), DIMENSION(:), INTENT(inout) :: schmidt_num !< particle Schmidt number
3697	REAL(wp), DIMENSION(:), INTENT(inout) :: vc !< critical fall speed i.e. settling velocity of
3698	!< an aerosol particle (m/s)
3699
3700	TYPE(t_section), DIMENSION(nbins_aerosol), INTENT(inout) :: paero !< aerosol properties
3701	!
3702	!-- Initialise
3703	depo = 0.0_wp
3704	pdn = 1500.0_wp ! default value
3705	ustar = 0.0_wp
3706	!
3707	!-- Molecular viscosity of air (Eq. 4.54)
3708	avis = 1.8325E-5_wp * ( 416.16_wp / ( tk + 120.0_wp ) ) * ( tk / 296.16_wp )**1.5_wp
3709	!
3710	!-- Kinematic viscosity (Eq. 4.55)
3711	kvis = avis / adn
3712	!
3713	!-- Thermal velocity of an air molecule (Eq. 15.32)
3714	va = SQRT( 8.0_wp * abo * tk / ( pi * am_airmol ) )
3715	!
3716	!-- Mean free path (m) (Eq. 15.24)
3717	lambda = 2.0_wp * avis / ( adn * va )
3718	!
3719	!-- Particle wet diameter (m)
3720	zdwet = paero(:)%dwet
3721	!
3722	!-- Knudsen number (Eq. 15.23)
3723	Kn = MAX( 1.0E-2_wp, lambda / ( zdwet * 0.5_wp ) ) ! To avoid underflow
3724	!
3725	!-- Cunningham slip-flow correction (Eq. 15.30)
3726	beta = 1.0_wp + Kn * ( 1.249_wp + 0.42_wp * EXP( -0.87_wp / Kn ) )
3727	!
3728	!-- Critical fall speed i.e. settling velocity (Eq. 20.4)
3729	vc = MIN( 1.0_wp, zdwet*2 ( pdn - adn ) * g * beta / ( 18.0_wp * avis ) )
3730	!
3731	!-- Deposition on vegetation
3732	IF ( lsdepo_pcm .AND. plant_canopy .AND. lad > 0.0_wp ) THEN
3733	!
3734	!-- Parameters for the land use category 'deciduous broadleaf trees'(Table 3)
3735	alpha = alpha_z01(depo_pcm_type_num)
3736	gamma = gamma_z01(depo_pcm_type_num)
3737	par_a = A_z01(depo_pcm_type_num, season) * 1.0E-3_wp
3738	!
3739	!-- Deposition efficiencies from Table 1. Constants from Table 2.
3740	par_l = l_p10(depo_pcm_type_num) * 0.01_wp
3741	c_brownian_diff = c_b_p10(depo_pcm_type_num)
3742	c_interception = c_in_p10(depo_pcm_type_num)
3743	c_impaction = c_im_p10(depo_pcm_type_num)
3744	beta_im = beta_im_p10(depo_pcm_type_num)
3745	c_turb_impaction = c_it_p10(depo_pcm_type_num)
3746
3747	DO ib = 1, nbins_aerosol
3748
3749	IF ( paero(ib)%numc < ( 2.0_wp * nclim ) ) CYCLE
3750
3751	!-- Particle diffusivity coefficient (Eq. 15.29)
3752	mdiff = ( abo * tk * beta(ib) ) / ( 3.0_wp * pi * avis * zdwet(ib) )
3753	!
3754	!-- Particle Schmidt number (Eq. 15.36)
3755	schmidt_num(ib) = kvis / mdiff
3756	!
3757	!-- Friction velocity for deposition on vegetation. Calculated following Prandtl (1925):
3758	ustar = SQRT( cdc ) * mag_u
3759	SELECT CASE ( depo_pcm_par_num )
3760
3761	CASE ( 1 ) ! Zhang et al. (2001)
3762	CALL depo_vel_Z01( vc(ib), ustar, schmidt_num(ib), paero(ib)%dwet, alpha, gamma, &
3763	par_a, depo )
3764	CASE ( 2 ) ! Petroff & Zhang (2010)
3765	CALL depo_vel_P10( vc(ib), mag_u, ustar, kvis, schmidt_num(ib), paero(ib)%dwet, &
3766	par_l, c_brownian_diff, c_interception, c_impaction, beta_im, &
3767	c_turb_impaction, depo )
3768	END SELECT
3769	!
3770	!-- Calculate the change in concentrations
3771	paero(ib)%numc = paero(ib)%numc - depo * lad * paero(ib)%numc * dt_salsa
3772	DO ic = 1, maxspec+1
3773	paero(ib)%volc(ic) = paero(ib)%volc(ic) - depo * lad * paero(ib)%volc(ic) * dt_salsa
3774	ENDDO
3775	ENDDO
3776
3777	ENDIF
3778
3779	END SUBROUTINE deposition
3780
3781	!------------------------------------------------------------------------------!
3782	! Description:
3783	! ------------
3784	!> Calculate deposition velocity (m/s) based on Zhan et al. (2001, case 1).
3785	!------------------------------------------------------------------------------!
3786
3787	SUBROUTINE depo_vel_Z01( vc, ustar, schmidt_num, diameter, alpha, gamma, par_a, depo )
3788
3789	IMPLICIT NONE
3790
3791	REAL(wp) :: rs !< overall quasi-laminar resistance for particles
3792	REAL(wp) :: stokes_num !< Stokes number for smooth or bluff surfaces
3793
3794	REAL(wp), INTENT(in) :: alpha !< parameter, Table 3 in Z01
3795	REAL(wp), INTENT(in) :: gamma !< parameter, Table 3 in Z01
3796	REAL(wp), INTENT(in) :: par_a !< parameter A for the characteristic diameter of
3797	!< collectors, Table 3 in Z01
3798	REAL(wp), INTENT(in) :: diameter !< particle diameter
3799	REAL(wp), INTENT(in) :: schmidt_num !< particle Schmidt number
3800	REAL(wp), INTENT(in) :: ustar !< friction velocity (m/s)
3801	REAL(wp), INTENT(in) :: vc !< terminal velocity (m/s)
3802
3803	REAL(wp), INTENT(inout) :: depo !< deposition efficiency (m/s)
3804
3805	IF ( par_a > 0.0_wp ) THEN
3806	!
3807	!-- Initialise
3808	rs = 0.0_wp
3809	!
3810	!-- Stokes number for vegetated surfaces (Seinfeld & Pandis (2006): Eq.19.24)
3811	stokes_num = vc * ustar / ( g * par_a )
3812	!
3813	!-- The overall quasi-laminar resistance for particles (Zhang et al., Eq. 5)
3814	rs = MAX( EPSILON( 1.0_wp ), ( 3.0_wp * ustar * EXP( -stokes_num*0.5_wp ) &
3815	( schmidt_num( -gamma ) + ( stokes_num / ( alpha + stokes_num ) )2 + &
3816	0.5_wp * ( diameter / par_a )**2 ) ) )
3817
3818	depo = rs + vc
3819
3820	ELSE
3821	depo = 0.0_wp
3822	ENDIF
3823
3824	END SUBROUTINE depo_vel_Z01
3825
3826	!------------------------------------------------------------------------------!
3827	! Description:
3828	! ------------
3829	!> Calculate deposition velocity (m/s) based on Petroff & Zhang (2010, case 2).
3830	!------------------------------------------------------------------------------!
3831
3832	SUBROUTINE depo_vel_P10( vc, mag_u, ustar, kvis_a, schmidt_num, diameter, par_l, c_brownian_diff, &
3833	c_interception, c_impaction, beta_im, c_turb_impaction, depo )
3834
3835	IMPLICIT NONE
3836
3837	REAL(wp) :: stokes_num !< Stokes number for smooth or bluff surfaces
3838	REAL(wp) :: tau_plus !< dimensionless particle relaxation time
3839	REAL(wp) :: v_bd !< deposition velocity due to Brownian diffusion
3840	REAL(wp) :: v_im !< deposition velocity due to impaction
3841	REAL(wp) :: v_in !< deposition velocity due to interception
3842	REAL(wp) :: v_it !< deposition velocity due to turbulent impaction
3843
3844	REAL(wp), INTENT(in) :: beta_im !< parameter for turbulent impaction
3845	REAL(wp), INTENT(in) :: c_brownian_diff !< coefficient for Brownian diffusion
3846	REAL(wp), INTENT(in) :: c_impaction !< coefficient for inertial impaction
3847	REAL(wp), INTENT(in) :: c_interception !< coefficient for interception
3848	REAL(wp), INTENT(in) :: c_turb_impaction !< coefficient for turbulent impaction
3849	REAL(wp), INTENT(in) :: kvis_a !< kinematic viscosity of air (m2/s)
3850	REAL(wp), INTENT(in) :: mag_u !< wind velocity (m/s)
3851	REAL(wp), INTENT(in) :: par_l !< obstacle characteristic dimension in P10
3852	REAL(wp), INTENT(in) :: diameter !< particle diameter
3853	REAL(wp), INTENT(in) :: schmidt_num !< particle Schmidt number
3854	REAL(wp), INTENT(in) :: ustar !< friction velocity (m/s)
3855	REAL(wp), INTENT(in) :: vc !< terminal velocity (m/s)
3856
3857	REAL(wp), INTENT(inout) :: depo !< deposition efficiency (m/s)
3858
3859	IF ( par_l > 0.0_wp ) THEN
3860	!
3861	!-- Initialise
3862	tau_plus = 0.0_wp
3863	v_bd = 0.0_wp
3864	v_im = 0.0_wp
3865	v_in = 0.0_wp
3866	v_it = 0.0_wp
3867	!
3868	!-- Stokes number for vegetated surfaces (Seinfeld & Pandis (2006): Eq.19.24)
3869	stokes_num = vc * ustar / ( g * par_l )
3870	!
3871	!-- Non-dimensional relexation time of the particle on top of canopy
3872	tau_plus = vc * ustar*2 / ( kvis_a g )
3873	!
3874	!-- Brownian diffusion
3875	v_bd = mag_u * c_brownian_diff * schmidt_num*( -0.66666666_wp ) &
3876	( mag_u * par_l / kvis_a )**( -0.5_wp )
3877	!
3878	!-- Interception
3879	v_in = mag_u * c_interception * diameter / par_l * &
3880	( 2.0_wp + LOG( 2.0_wp * par_l / diameter ) )
3881	!
3882	!-- Impaction: Petroff (2009) Eq. 18
3883	v_im = mag_u * c_impaction * ( stokes_num / ( stokes_num + beta_im ) )**2
3884	!
3885	!-- Turbulent impaction
3886	IF ( tau_plus < 20.0_wp ) THEN
3887	v_it = 2.5E-3_wp * c_turb_impaction * tau_plus**2
3888	ELSE
3889	v_it = c_turb_impaction
3890	ENDIF
3891
3892	depo = ( v_bd + v_in + v_im + v_it + vc )
3893
3894	ELSE
3895	depo = 0.0_wp
3896	ENDIF
3897
3898	END SUBROUTINE depo_vel_P10
3899
3900	!------------------------------------------------------------------------------!
3901	! Description:
3902	! ------------
3903	!> Calculate the dry deposition on horizontal and vertical surfaces. Implement
3904	!> as a surface flux.
3905	!> @todo aerodynamic resistance ignored for now (not important for
3906	! high-resolution simulations)
3907	!------------------------------------------------------------------------------!
3908	SUBROUTINE depo_surf( i, j, surf, vc, schmidt_num, kvis, mag_u, norm, match_array )
3909
3910	USE arrays_3d, &
3911	ONLY: rho_air_zw
3912
3913	USE surface_mod, &
3914	ONLY: ind_pav_green, ind_veg_wall, ind_wat_win, surf_type
3915
3916	IMPLICIT NONE
3917
3918	INTEGER(iwp) :: ib !< loop index
3919	INTEGER(iwp) :: ic !< loop index
3920	INTEGER(iwp) :: icc !< additional loop index
3921	INTEGER(iwp) :: k !< loop index
3922	INTEGER(iwp) :: m !< loop index
3923	INTEGER(iwp) :: surf_e !< End index of surface elements at (j,i)-gridpoint
3924	INTEGER(iwp) :: surf_s !< Start index of surface elements at (j,i)-gridpoint
3925
3926	INTEGER(iwp), INTENT(in) :: i !< loop index
3927	INTEGER(iwp), INTENT(in) :: j !< loop index
3928
3929	LOGICAL, INTENT(in) :: norm !< to normalise or not
3930
3931	REAL(wp) :: alpha !< parameter, Table 3 in Z01
3932	REAL(wp) :: beta_im !< parameter for turbulent impaction
3933	REAL(wp) :: c_brownian_diff !< coefficient for Brownian diffusion
3934	REAL(wp) :: c_impaction !< coefficient for inertial impaction
3935	REAL(wp) :: c_interception !< coefficient for interception
3936	REAL(wp) :: c_turb_impaction !< coefficient for turbulent impaction
3937	REAL(wp) :: gamma !< parameter, Table 3 in Z01
3938	REAL(wp) :: norm_fac !< normalisation factor (usually air density)
3939	REAL(wp) :: par_a !< parameter A for the characteristic radius of collectors,
3940	!< Table 3 in Z01
3941	REAL(wp) :: par_l !< obstacle characteristic dimension in P10
3942	REAL(wp) :: rs !< the overall quasi-laminar resistance for particles
3943	REAL(wp) :: tau_plus !< dimensionless particle relaxation time
3944	REAL(wp) :: v_bd !< deposition velocity due to Brownian diffusion
3945	REAL(wp) :: v_im !< deposition velocity due to impaction
3946	REAL(wp) :: v_in !< deposition velocity due to interception
3947	REAL(wp) :: v_it !< deposition velocity due to turbulent impaction
3948
3949	REAL(wp), DIMENSION(nbins_aerosol) :: depo !< deposition efficiency
3950	REAL(wp), DIMENSION(nbins_aerosol) :: depo_sum !< sum of deposition efficiencies
3951
3952	REAL(wp), DIMENSION(:), INTENT(in) :: kvis !< kinematic viscosity of air (m2/s)
3953	REAL(wp), DIMENSION(:), INTENT(in) :: mag_u !< wind velocity (m/s)
3954
3955	REAL(wp), DIMENSION(:,:), INTENT(in) :: schmidt_num !< particle Schmidt number
3956	REAL(wp), DIMENSION(:,:), INTENT(in) :: vc !< terminal velocity (m/s)
3957
3958	TYPE(match_surface), INTENT(in), OPTIONAL :: match_array !< match the deposition module and
3959	!< LSM/USM surfaces
3960	TYPE(surf_type), INTENT(inout) :: surf !< respective surface type
3961	!
3962	!-- Initialise
3963	depo = 0.0_wp
3964	depo_sum = 0.0_wp
3965	rs = 0.0_wp
3966	surf_s = surf%start_index(j,i)
3967	surf_e = surf%end_index(j,i)
3968	tau_plus = 0.0_wp
3969	v_bd = 0.0_wp
3970	v_im = 0.0_wp
3971	v_in = 0.0_wp
3972	v_it = 0.0_wp
3973	!
3974	!-- Model parameters for the land use category. If LSM or USM is applied, import
3975	!-- characteristics. Otherwise, apply surface type "urban".
3976	alpha = alpha_z01(luc_urban)
3977	gamma = gamma_z01(luc_urban)
3978	par_a = A_z01(luc_urban, season) * 1.0E-3_wp
3979
3980	par_l = l_p10(luc_urban) * 0.01_wp
3981	c_brownian_diff = c_b_p10(luc_urban)
3982	c_interception = c_in_p10(luc_urban)
3983	c_impaction = c_im_p10(luc_urban)
3984	beta_im = beta_im_p10(luc_urban)
3985	c_turb_impaction = c_it_p10(luc_urban)
3986
3987
3988	IF ( PRESENT( match_array ) ) THEN ! land or urban surface model
3989
3990	DO m = surf_s, surf_e
3991
3992	k = surf%k(m)
3993	norm_fac = 1.0_wp
3994
3995	IF ( norm ) norm_fac = rho_air_zw(k) ! normalise vertical fluxes by air density
3996
3997	IF ( match_array%match_lupg(m) > 0 ) THEN
3998	alpha = alpha_z01( match_array%match_lupg(m) )
3999	gamma = gamma_z01( match_array%match_lupg(m) )
4000	par_a = A_z01( match_array%match_lupg(m), season ) * 1.0E-3_wp
4001
4002	beta_im = beta_im_p10( match_array%match_lupg(m) )
4003	c_brownian_diff = c_b_p10( match_array%match_lupg(m) )
4004	c_impaction = c_im_p10( match_array%match_lupg(m) )
4005	c_interception = c_in_p10( match_array%match_lupg(m) )
4006	c_turb_impaction = c_it_p10( match_array%match_lupg(m) )
4007	par_l = l_p10( match_array%match_lupg(m) ) * 0.01_wp
4008
4009	DO ib = 1, nbins_aerosol
4010	IF ( aerosol_number(ib)%conc(k,j,i) < ( 2.0_wp * nclim ) .OR. &
4011	schmidt_num(k+1,ib) < 1.0_wp ) CYCLE
4012
4013	SELECT CASE ( depo_surf_par_num )
4014
4015	CASE ( 1 )
4016	CALL depo_vel_Z01( vc(k+1,ib), surf%us(m), schmidt_num(k+1,ib), &
4017	ra_dry(k,j,i,ib), alpha, gamma, par_a, depo(ib) )
4018	CASE ( 2 )
4019	CALL depo_vel_P10( vc(k+1,ib), mag_u(k+1), surf%us(m), kvis(k+1), &
4020	schmidt_num(k+1,ib), ra_dry(k,j,i,ib), par_l, &
4021	c_brownian_diff, c_interception, c_impaction, beta_im, &
4022	c_turb_impaction, depo(ib) )
4023	END SELECT
4024	ENDDO
4025	depo_sum = depo_sum + surf%frac(ind_pav_green,m) * depo
4026	ENDIF
4027
4028	IF ( match_array%match_luvw(m) > 0 ) THEN
4029	alpha = alpha_z01( match_array%match_luvw(m) )
4030	gamma = gamma_z01( match_array%match_luvw(m) )
4031	par_a = A_z01( match_array%match_luvw(m), season ) * 1.0E-3_wp
4032
4033	beta_im = beta_im_p10( match_array%match_luvw(m) )
4034	c_brownian_diff = c_b_p10( match_array%match_luvw(m) )
4035	c_impaction = c_im_p10( match_array%match_luvw(m) )
4036	c_interception = c_in_p10( match_array%match_luvw(m) )
4037	c_turb_impaction = c_it_p10( match_array%match_luvw(m) )
4038	par_l = l_p10( match_array%match_luvw(m) ) * 0.01_wp
4039
4040	DO ib = 1, nbins_aerosol
4041	IF ( aerosol_number(ib)%conc(k,j,i) < ( 2.0_wp * nclim ) .OR. &
4042	schmidt_num(k+1,ib) < 1.0_wp ) CYCLE
4043
4044	SELECT CASE ( depo_surf_par_num )
4045
4046	CASE ( 1 )
4047	CALL depo_vel_Z01( vc(k+1,ib), surf%us(m), schmidt_num(k+1,ib), &
4048	ra_dry(k,j,i,ib), alpha, gamma, par_a, depo(ib) )
4049	CASE ( 2 )
4050	CALL depo_vel_P10( vc(k+1,ib), mag_u(k+1), surf%us(m), kvis(k+1), &
4051	schmidt_num(k+1,ib), ra_dry(k,j,i,ib), par_l, &
4052	c_brownian_diff, c_interception, c_impaction, beta_im, &
4053	c_turb_impaction, depo(ib) )
4054	END SELECT
4055	ENDDO
4056	depo_sum = depo_sum + surf%frac(ind_veg_wall,m) * depo
4057	ENDIF
4058
4059	IF ( match_array%match_luww(m) > 0 ) THEN
4060	alpha = alpha_z01( match_array%match_luww(m) )
4061	gamma = gamma_z01( match_array%match_luww(m) )
4062	par_a = A_z01( match_array%match_luww(m), season ) * 1.0E-3_wp
4063
4064	beta_im = beta_im_p10( match_array%match_luww(m) )
4065	c_brownian_diff = c_b_p10( match_array%match_luww(m) )
4066	c_impaction = c_im_p10( match_array%match_luww(m) )
4067	c_interception = c_in_p10( match_array%match_luww(m) )
4068	c_turb_impaction = c_it_p10( match_array%match_luww(m) )
4069	par_l = l_p10( match_array%match_luww(m) ) * 0.01_wp
4070
4071	DO ib = 1, nbins_aerosol
4072	IF ( aerosol_number(ib)%conc(k,j,i) < ( 2.0_wp * nclim ) .OR. &
4073	schmidt_num(k+1,ib) < 1.0_wp ) CYCLE
4074
4075	SELECT CASE ( depo_surf_par_num )
4076
4077	CASE ( 1 )
4078	CALL depo_vel_Z01( vc(k+1,ib), surf%us(m), schmidt_num(k+1,ib), &
4079	ra_dry(k,j,i,ib), alpha, gamma, par_a, depo(ib) )
4080	CASE ( 2 )
4081	CALL depo_vel_P10( vc(k+1,ib), mag_u(k+1), surf%us(m), kvis(k+1), &
4082	schmidt_num(k+1,ib), ra_dry(k,j,i,ib), par_l, &
4083	c_brownian_diff, c_interception, c_impaction, beta_im, &
4084	c_turb_impaction, depo(ib) )
4085	END SELECT
4086	ENDDO
4087	depo_sum = depo_sum + surf%frac(ind_wat_win,m) * depo
4088	ENDIF
4089
4090	DO ib = 1, nbins_aerosol
4091	IF ( aerosol_number(ib)%conc(k,j,i) < ( 2.0_wp * nclim ) ) CYCLE
4092	!
4093	!-- Calculate changes in surface fluxes due to dry deposition
4094	IF ( include_emission ) THEN
4095	surf%answs(m,ib) = aerosol_number(ib)%source(j,i) - MAX( 0.0_wp, &
4096	depo_sum(ib) * norm_fac * aerosol_number(ib)%conc(k,j,i) )
4097	DO ic = 1, ncomponents_mass
4098	icc = ( ic - 1 ) * nbins_aerosol + ib
4099	surf%amsws(m,icc) = aerosol_mass(icc)%source(j,i) - MAX( 0.0_wp, &
4100	depo_sum(ib) * norm_fac * aerosol_mass(icc)%conc(k,j,i) )
4101	ENDDO ! ic
4102	ELSE
4103	surf%answs(m,ib) = -depo_sum(ib) * norm_fac * aerosol_number(ib)%conc(k,j,i)
4104	DO ic = 1, ncomponents_mass
4105	icc = ( ic - 1 ) * nbins_aerosol + ib
4106	surf%amsws(m,icc) = -depo_sum(ib) * norm_fac * aerosol_mass(icc)%conc(k,j,i)
4107	ENDDO ! ic
4108	ENDIF
4109	ENDDO ! ib
4110
4111	ENDDO
4112
4113	ELSE ! default surfaces
4114
4115	DO m = surf_s, surf_e
4116
4117	k = surf%k(m)
4118	norm_fac = 1.0_wp
4119
4120	IF ( norm ) norm_fac = rho_air_zw(k) ! normalise vertical fluxes by air density
4121
4122	DO ib = 1, nbins_aerosol
4123	IF ( aerosol_number(ib)%conc(k,j,i) < ( 2.0_wp * nclim ) .OR. &
4124	schmidt_num(k+1,ib) < 1.0_wp ) CYCLE
4125
4126	SELECT CASE ( depo_surf_par_num )
4127
4128	CASE ( 1 )
4129	CALL depo_vel_Z01( vc(k+1,ib), surf%us(m), schmidt_num(k+1,ib), &
4130	ra_dry(k,j,i,ib), alpha, gamma, par_a, depo(ib) )
4131	CASE ( 2 )
4132	CALL depo_vel_P10( vc(k+1,ib), mag_u(k+1), surf%us(m), kvis(k+1), &
4133	schmidt_num(k+1,ib), ra_dry(k,j,i,ib), par_l, &
4134	c_brownian_diff, c_interception, c_impaction, beta_im, &
4135	c_turb_impaction, depo(ib) )
4136	END SELECT
4137	!
4138	!-- Calculate changes in surface fluxes due to dry deposition
4139	IF ( include_emission ) THEN
4140	surf%answs(m,ib) = aerosol_number(ib)%source(j,i) - MAX( 0.0_wp, &
4141	depo(ib) * norm_fac * aerosol_number(ib)%conc(k,j,i) )
4142	DO ic = 1, ncomponents_mass
4143	icc = ( ic - 1 ) * nbins_aerosol + ib
4144	surf%amsws(m,icc) = aerosol_mass(icc)%source(j,i) - MAX( 0.0_wp, &
4145	depo(ib) * norm_fac * aerosol_mass(icc)%conc(k,j,i) )
4146	ENDDO ! ic
4147	ELSE
4148	surf%answs(m,ib) = -depo(ib) * norm_fac * aerosol_number(ib)%conc(k,j,i)
4149	DO ic = 1, ncomponents_mass
4150	icc = ( ic - 1 ) * nbins_aerosol + ib
4151	surf%amsws(m,icc) = -depo(ib) * norm_fac * aerosol_mass(icc)%conc(k,j,i)
4152	ENDDO ! ic
4153	ENDIF
4154	ENDDO ! ib
4155	ENDDO
4156
4157	ENDIF
4158
4159	END SUBROUTINE depo_surf
4160
4161	!------------------------------------------------------------------------------!
4162	! Description:
4163	! ------------
4164	!> Calculates particle loss and change in size distribution due to (Brownian)
4165	!> coagulation. Only for particles with dwet < 30 micrometres.
4166	!
4167	!> Method:
4168	!> Semi-implicit, non-iterative method: (Jacobson, 1994)
4169	!> Volume concentrations of the smaller colliding particles added to the bin of
4170	!> the larger colliding particles. Start from first bin and use the updated
4171	!> number and volume for calculation of following bins. NB! Our bin numbering
4172	!> does not follow particle size in subrange 2.
4173	!
4174	!> Schematic for bin numbers in different subranges:
4175	!> 1 2
4176	!> +-------------------------------------------+
4177	!> a \| 1 \| 2 \| 3 \|\| 4 \| 5 \| 6 \| 7 \| 8 \| 9 \| 10\|\|
4178	!> b \| \|\|11 \|12 \|13 \|14 \| 15 \| 16 \| 17\|\|
4179	!> +-------------------------------------------+
4180	!
4181	!> Exact coagulation coefficients for each pressure level are scaled according
4182	!> to current particle wet size (linear scaling).
4183	!> Bins are organized in terms of the dry size of the condensation nucleus,
4184	!> while coagulation kernell is calculated with the actual hydrometeor
4185	!> size.
4186	!
4187	!> Called from salsa_driver
4188	!> fxm: Process selection should be made smarter - now just lots of IFs inside
4189	!> loops
4190	!
4191	!> Coded by:
4192	!> Hannele Korhonen (FMI) 2005
4193	!> Harri Kokkola (FMI) 2006
4194	!> Tommi Bergman (FMI) 2012
4195	!> Matti Niskanen(FMI) 2012
4196	!> Anton Laakso (FMI) 2013
4197	!> Juha Tonttila (FMI) 2014
4198	!------------------------------------------------------------------------------!
4199	SUBROUTINE coagulation( paero, ptstep, ptemp, ppres )
4200
4201	IMPLICIT NONE
4202
4203	INTEGER(iwp) :: index_2a !< corresponding bin in subrange 2a
4204	INTEGER(iwp) :: index_2b !< corresponding bin in subrange 2b
4205	INTEGER(iwp) :: ib !< loop index
4206	INTEGER(iwp) :: ll !< loop index
4207	INTEGER(iwp) :: mm !< loop index
4208	INTEGER(iwp) :: nn !< loop index
4209
4210	REAL(wp) :: pressi !< pressure
4211	REAL(wp) :: temppi !< temperature
4212	REAL(wp) :: zdpart_mm !< diameter of particle (m)
4213	REAL(wp) :: zdpart_nn !< diameter of particle (m)
4214	REAL(wp) :: zminusterm !< coagulation loss in a bin (1/s)
4215
4216	REAL(wp), INTENT(in) :: ppres !< ambient pressure (Pa)
4217	REAL(wp), INTENT(in) :: ptemp !< ambient temperature (K)
4218	REAL(wp), INTENT(in) :: ptstep !< time step (s)
4219
4220	REAL(wp), DIMENSION(nbins_aerosol) :: zmpart !< approximate mass of particles (kg)
4221	REAL(wp), DIMENSION(maxspec+1) :: zplusterm !< coagulation gain in a bin (for each
4222	!< chemical compound)
4223	REAL(wp), DIMENSION(nbins_aerosol,nbins_aerosol) :: zcc !< updated coagulation coeff. (m3/s)
4224
4225	TYPE(t_section), DIMENSION(nbins_aerosol), INTENT(inout) :: paero !< Aerosol properties
4226
4227	zdpart_mm = 0.0_wp
4228	zdpart_nn = 0.0_wp
4229	!
4230	!-- 1) Coagulation to coarse mode calculated in a simplified way:
4231	!-- CoagSink ~ Dp in continuum subrange --> 'effective' number conc. of coarse particles
4232
4233	!-- 2) Updating coagulation coefficients
4234	!
4235	!-- Aerosol mass (kg). Density of 1500 kg/m3 assumed
4236	zmpart(1:end_subrange_2b) = api6 * ( MIN( paero(1:end_subrange_2b)%dwet, 30.0E-6_wp )**3 ) &
4237	* 1500.0_wp
4238	temppi = ptemp
4239	pressi = ppres
4240	zcc = 0.0_wp
4241	!
4242	!-- Aero-aero coagulation
4243	DO mm = 1, end_subrange_2b ! smaller colliding particle
4244	IF ( paero(mm)%numc < ( 2.0_wp * nclim ) ) CYCLE
4245	DO nn = mm, end_subrange_2b ! larger colliding particle
4246	IF ( paero(nn)%numc < ( 2.0_wp * nclim ) ) CYCLE
4247
4248	zdpart_mm = MIN( paero(mm)%dwet, 30.0E-6_wp ) ! Limit to 30 um
4249	zdpart_nn = MIN( paero(nn)%dwet, 30.0E-6_wp ) ! Limit to 30 um
4250	!
4251	!-- Coagulation coefficient of particles (m3/s)
4252	zcc(mm,nn) = coagc( zdpart_mm, zdpart_nn, zmpart(mm), zmpart(nn), temppi, pressi )
4253	zcc(nn,mm) = zcc(mm,nn)
4254	ENDDO
4255	ENDDO
4256
4257	!
4258	!-- 3) New particle and volume concentrations after coagulation:
4259	!-- Calculated according to Jacobson (2005) eq. 15.9
4260	!
4261	!-- Aerosols in subrange 1a:
4262	DO ib = start_subrange_1a, end_subrange_1a
4263	IF ( paero(ib)%numc < ( 2.0_wp * nclim ) ) CYCLE
4264	zminusterm = 0.0_wp
4265	zplusterm(:) = 0.0_wp
4266	!
4267	!-- Particles lost by coagulation with larger aerosols
4268	DO ll = ib+1, end_subrange_2b
4269	zminusterm = zminusterm + zcc(ib,ll) * paero(ll)%numc
4270	ENDDO
4271	!
4272	!-- Coagulation gain in a bin: change in volume conc. (cm3/cm3):
4273	DO ll = start_subrange_1a, ib - 1
4274	zplusterm(1:2) = zplusterm(1:2) + zcc(ll,ib) * paero(ll)%volc(1:2)
4275	zplusterm(6:7) = zplusterm(6:7) + zcc(ll,ib) * paero(ll)%volc(6:7)
4276	zplusterm(8) = zplusterm(8) + zcc(ll,ib) * paero(ll)%volc(8)
4277	ENDDO
4278	!
4279	!-- Volume and number concentrations after coagulation update [fxm]
4280	paero(ib)%volc(1:2) = ( paero(ib)%volc(1:2) + ptstep * zplusterm(1:2) * paero(ib)%numc ) / &
4281	( 1.0_wp + ptstep * zminusterm )
4282	paero(ib)%volc(6:8) = ( paero(ib)%volc(6:8) + ptstep * zplusterm(6:8) * paero(ib)%numc ) / &
4283	( 1.0_wp + ptstep * zminusterm )
4284	paero(ib)%numc = paero(ib)%numc / ( 1.0_wp + ptstep * zminusterm + 0.5_wp * ptstep * &
4285	zcc(ib,ib) * paero(ib)%numc )
4286	ENDDO
4287	!
4288	!-- Aerosols in subrange 2a:
4289	DO ib = start_subrange_2a, end_subrange_2a
4290	IF ( paero(ib)%numc < ( 2.0_wp * nclim ) ) CYCLE
4291	zminusterm = 0.0_wp
4292	zplusterm(:) = 0.0_wp
4293	!
4294	!-- Find corresponding size bin in subrange 2b
4295	index_2b = ib - start_subrange_2a + start_subrange_2b
4296	!
4297	!-- Particles lost by larger particles in 2a
4298	DO ll = ib+1, end_subrange_2a
4299	zminusterm = zminusterm + zcc(ib,ll) * paero(ll)%numc
4300	ENDDO
4301	!
4302	!-- Particles lost by larger particles in 2b
4303	IF ( .NOT. no_insoluble ) THEN
4304	DO ll = index_2b+1, end_subrange_2b
4305	zminusterm = zminusterm + zcc(ib,ll) * paero(ll)%numc
4306	ENDDO
4307	ENDIF
4308	!
4309	!-- Particle volume gained from smaller particles in subranges 1, 2a and 2b
4310	DO ll = start_subrange_1a, ib-1
4311	zplusterm(1:2) = zplusterm(1:2) + zcc(ll,ib) * paero(ll)%volc(1:2)
4312	zplusterm(6:8) = zplusterm(6:8) + zcc(ll,ib) * paero(ll)%volc(6:8)
4313	ENDDO
4314	!
4315	!-- Particle volume gained from smaller particles in 2a
4316	!-- (Note, for components not included in the previous loop!)
4317	DO ll = start_subrange_2a, ib-1
4318	zplusterm(3:5) = zplusterm(3:5) + zcc(ll,ib)*paero(ll)%volc(3:5)
4319	ENDDO
4320	!
4321	!-- Particle volume gained from smaller (and equal) particles in 2b
4322	IF ( .NOT. no_insoluble ) THEN
4323	DO ll = start_subrange_2b, index_2b
4324	zplusterm(1:8) = zplusterm(1:8) + zcc(ll,ib) * paero(ll)%volc(1:8)
4325	ENDDO
4326	ENDIF
4327	!
4328	!-- Volume and number concentrations after coagulation update [fxm]
4329	paero(ib)%volc(1:8) = ( paero(ib)%volc(1:8) + ptstep * zplusterm(1:8) * paero(ib)%numc ) / &
4330	( 1.0_wp + ptstep * zminusterm )
4331	paero(ib)%numc = paero(ib)%numc / ( 1.0_wp + ptstep * zminusterm + 0.5_wp * ptstep * &
4332	zcc(ib,ib) * paero(ib)%numc )
4333	ENDDO
4334	!
4335	!-- Aerosols in subrange 2b:
4336	IF ( .NOT. no_insoluble ) THEN
4337	DO ib = start_subrange_2b, end_subrange_2b
4338	IF ( paero(ib)%numc < ( 2.0_wp * nclim ) ) CYCLE
4339	zminusterm = 0.0_wp
4340	zplusterm(:) = 0.0_wp
4341	!
4342	!-- Find corresponding size bin in subsubrange 2a
4343	index_2a = ib - start_subrange_2b + start_subrange_2a
4344	!
4345	!-- Particles lost to larger particles in subranges 2b
4346	DO ll = ib + 1, end_subrange_2b
4347	zminusterm = zminusterm + zcc(ib,ll) * paero(ll)%numc
4348	ENDDO
4349	!
4350	!-- Particles lost to larger and equal particles in 2a
4351	DO ll = index_2a, end_subrange_2a
4352	zminusterm = zminusterm + zcc(ib,ll) * paero(ll)%numc
4353	ENDDO
4354	!
4355	!-- Particle volume gained from smaller particles in subranges 1 & 2a
4356	DO ll = start_subrange_1a, index_2a - 1
4357	zplusterm(1:8) = zplusterm(1:8) + zcc(ll,ib) * paero(ll)%volc(1:8)
4358	ENDDO
4359	!
4360	!-- Particle volume gained from smaller particles in 2b
4361	DO ll = start_subrange_2b, ib - 1
4362	zplusterm(1:8) = zplusterm(1:8) + zcc(ll,ib) * paero(ll)%volc(1:8)
4363	ENDDO
4364	!
4365	!-- Volume and number concentrations after coagulation update [fxm]
4366	paero(ib)%volc(1:8) = ( paero(ib)%volc(1:8) + ptstep * zplusterm(1:8) * paero(ib)%numc ) &
4367	/ ( 1.0_wp + ptstep * zminusterm )
4368	paero(ib)%numc = paero(ib)%numc / ( 1.0_wp + ptstep * zminusterm + 0.5_wp * ptstep * &
4369	zcc(ib,ib) * paero(ib)%numc )
4370	ENDDO
4371	ENDIF
4372
4373	END SUBROUTINE coagulation
4374
4375	!------------------------------------------------------------------------------!
4376	! Description:
4377	! ------------
4378	!> Calculation of coagulation coefficients. Extended version of the function
4379	!> originally found in mo_salsa_init.
4380	!
4381	!> J. Tonttila, FMI, 05/2014
4382	!------------------------------------------------------------------------------!
4383	REAL(wp) FUNCTION coagc( diam1, diam2, mass1, mass2, temp, pres )
4384
4385	IMPLICIT NONE
4386
4387	REAL(wp) :: fmdist !< distance of flux matching (m)
4388	REAL(wp) :: knud_p !< particle Knudsen number
4389	REAL(wp) :: mdiam !< mean diameter of colliding particles (m)
4390	REAL(wp) :: mfp !< mean free path of air molecules (m)
4391	REAL(wp) :: visc !< viscosity of air (kg/(m s))
4392
4393	REAL(wp), INTENT(in) :: diam1 !< diameter of colliding particle 1 (m)
4394	REAL(wp), INTENT(in) :: diam2 !< diameter of colliding particle 2 (m)
4395	REAL(wp), INTENT(in) :: mass1 !< mass of colliding particle 1 (kg)
4396	REAL(wp), INTENT(in) :: mass2 !< mass of colliding particle 2 (kg)
4397	REAL(wp), INTENT(in) :: pres !< ambient pressure (Pa?) [fxm]
4398	REAL(wp), INTENT(in) :: temp !< ambient temperature (K)
4399
4400	REAL(wp), DIMENSION (2) :: beta !< Cunningham correction factor
4401	REAL(wp), DIMENSION (2) :: dfpart !< particle diffusion coefficient (m2/s)
4402	REAL(wp), DIMENSION (2) :: diam !< diameters of particles (m)
4403	REAL(wp), DIMENSION (2) :: flux !< flux in continuum and free molec. regime (m/s)
4404	REAL(wp), DIMENSION (2) :: knud !< particle Knudsen number
4405	REAL(wp), DIMENSION (2) :: mpart !< masses of particles (kg)
4406	REAL(wp), DIMENSION (2) :: mtvel !< particle mean thermal velocity (m/s)
4407	REAL(wp), DIMENSION (2) :: omega !< particle mean free path
4408	REAL(wp), DIMENSION (2) :: tva !< temporary variable (m)
4409	!
4410	!-- Initialisation
4411	coagc = 0.0_wp
4412	!
4413	!-- 1) Initializing particle and ambient air variables
4414	diam = (/ diam1, diam2 /) !< particle diameters (m)
4415	mpart = (/ mass1, mass2 /) !< particle masses (kg)
4416	!
4417	!-- Viscosity of air (kg/(m s))
4418	visc = ( 7.44523E-3_wp * temp ** 1.5_wp ) / ( 5093.0_wp * ( temp + 110.4_wp ) )
4419	!
4420	!-- Mean free path of air (m)
4421	mfp = ( 1.656E-10_wp * temp + 1.828E-8_wp ) * ( p_0 + 1325.0_wp ) / pres
4422	!
4423	!-- 2) Slip correction factor for small particles
4424	knud = 2.0_wp * EXP( LOG(mfp) - LOG(diam) )! Knudsen number for air (15.23)
4425	!
4426	!-- Cunningham correction factor (Allen and Raabe, Aerosol Sci. Tech. 4, 269)
4427	beta = 1.0_wp + knud * ( 1.142_wp + 0.558_wp * EXP( -0.999_wp / knud ) )
4428	!
4429	!-- 3) Particle properties
4430	!-- Diffusion coefficient (m2/s) (Jacobson (2005) eq. 15.29)
4431	dfpart = beta * abo * temp / ( 3.0_wp * pi * visc * diam )
4432	!
4433	!-- Mean thermal velocity (m/s) (Jacobson (2005) eq. 15.32)
4434	mtvel = SQRT( ( 8.0_wp * abo * temp ) / ( pi * mpart ) )
4435	!
4436	!-- Particle mean free path (m) (Jacobson (2005) eq. 15.34 )
4437	omega = 8.0_wp * dfpart / ( pi * mtvel )
4438	!
4439	!-- Mean diameter (m)
4440	mdiam = 0.5_wp * ( diam(1) + diam(2) )
4441	!
4442	!-- 4) Calculation of fluxes (Brownian collision kernels) and flux matching
4443	!-- following Jacobson (2005):
4444	!
4445	!-- Flux in continuum regime (m3/s) (eq. 15.28)
4446	flux(1) = 4.0_wp * pi * mdiam * ( dfpart(1) + dfpart(2) )
4447	!
4448	!-- Flux in free molec. regime (m3/s) (eq. 15.31)
4449	flux(2) = pi * SQRT( ( mtvel(1)2 ) + ( mtvel(2)2 ) ) * ( mdiam**2 )
4450	!
4451	!-- temporary variables (m) to calculate flux matching distance (m)
4452	tva(1) = ( ( mdiam + omega(1) )3 - ( mdiam2 + omega(1)*2 ) SQRT( ( mdiam**2 + &
4453	omega(1)*2 ) ) ) / ( 3.0_wp mdiam * omega(1) ) - mdiam
4454	tva(2) = ( ( mdiam + omega(2) )3 - ( mdiam2 + omega(2)*2 ) SQRT( ( mdiam**2 + &
4455	omega(2)*2 ) ) ) / ( 3.0_wp mdiam * omega(2) ) - mdiam
4456	!
4457	!-- Flux matching distance (m): the mean distance from the centre of a sphere reached by particles
4458	!-- that leave sphere's surface and travel a distance of particle mean free path (eq. 15.34)
4459	fmdist = SQRT( tva(1)2 + tva(2)2 )
4460	!
4461	!-- 5) Coagulation coefficient = coalescence efficiency * collision kernel (m3/s) (eq. 15.33).
4462	!-- Here assumed coalescence efficiency 1!!
4463	coagc = flux(1) / ( mdiam / ( mdiam + fmdist) + flux(1) / flux(2) )
4464	!
4465	!-- Corrected collision kernel (Karl et al., 2016 (ACP)): Include van der Waals and viscous forces
4466	IF ( van_der_waals_coagc ) THEN
4467	knud_p = SQRT( omega(1)2 + omega(2)2 ) / mdiam
4468	IF ( knud_p >= 0.1_wp .AND. knud_p <= 10.0_wp ) THEN
4469	coagc = coagc * ( 2.0_wp + 0.4_wp * LOG( knud_p ) )
4470	ELSE
4471	coagc = coagc * 3.0_wp
4472	ENDIF
4473	ENDIF
4474
4475	END FUNCTION coagc
4476
4477	!------------------------------------------------------------------------------!
4478	! Description:
4479	! ------------
4480	!> Calculates the change in particle volume and gas phase
4481	!> concentrations due to nucleation, condensation and dissolutional growth.
4482	!
4483	!> Sulphuric acid and organic vapour: only condensation and no evaporation.
4484	!
4485	!> New gas and aerosol phase concentrations calculated according to Jacobson
4486	!> (1997): Numerical techniques to solve condensational and dissolutional growth
4487	!> equations when growth is coupled to reversible reactions, Aerosol Sci. Tech.,
4488	!> 27, pp 491-498.
4489	!
4490	!> Following parameterization has been used:
4491	!> Molecular diffusion coefficient of condensing vapour (m2/s)
4492	!> (Reid et al. (1987): Properties of gases and liquids, McGraw-Hill, New York.)
4493	!> D = {1.d-7sqrt(1/M_air + 1/M_gas)T^1.75} / &
4494	! {p_atm/p_stand * (d_air^(1/3) + d_gas^(1/3))^2 }
4495	!> M_air = 28.965 : molar mass of air (g/mol)
4496	!> d_air = 19.70 : diffusion volume of air
4497	!> M_h2so4 = 98.08 : molar mass of h2so4 (g/mol)
4498	!> d_h2so4 = 51.96 : diffusion volume of h2so4
4499	!
4500	!> Called from main aerosol model
4501	!> For equations, see Jacobson, Fundamentals of Atmospheric Modeling, 2nd Edition (2005)
4502	!
4503	!> Coded by:
4504	!> Hannele Korhonen (FMI) 2005
4505	!> Harri Kokkola (FMI) 2006
4506	!> Juha Tonttila (FMI) 2014
4507	!> Rewritten to PALM by Mona Kurppa (UHel) 2017
4508	!------------------------------------------------------------------------------!
4509	SUBROUTINE condensation( paero, pc_sa, pc_ocnv, pcocsv, pchno3, pc_nh3, pcw, pcs, ptemp, ppres, &
4510	ptstep, prtcl )
4511
4512	IMPLICIT NONE
4513
4514	INTEGER(iwp) :: ss !< start index
4515	INTEGER(iwp) :: ee !< end index
4516
4517	REAL(wp) :: zcs_ocnv !< condensation sink of nonvolatile organics (1/s)
4518	REAL(wp) :: zcs_ocsv !< condensation sink of semivolatile organics (1/s)
4519	REAL(wp) :: zcs_su !< condensation sink of sulfate (1/s)
4520	REAL(wp) :: zcs_tot !< total condensation sink (1/s) (gases)
4521	REAL(wp) :: zcvap_new1 !< vapour concentration after time step (#/m3): sulphuric acid
4522	REAL(wp) :: zcvap_new2 !< nonvolatile organics
4523	REAL(wp) :: zcvap_new3 !< semivolatile organics
4524	REAL(wp) :: zdfvap !< air diffusion coefficient (m2/s)
4525	REAL(wp) :: zdvap1 !< change in vapour concentration (#/m3): sulphuric acid
4526	REAL(wp) :: zdvap2 !< nonvolatile organics
4527	REAL(wp) :: zdvap3 !< semivolatile organics
4528	REAL(wp) :: zmfp !< mean free path of condensing vapour (m)
4529	REAL(wp) :: zrh !< Relative humidity [0-1]
4530	REAL(wp) :: zvisc !< viscosity of air (kg/(m s))
4531	REAL(wp) :: zn_vs_c !< ratio of nucleation of all mass transfer in the smallest bin
4532	REAL(wp) :: zxocnv !< ratio of organic vapour in 3nm particles
4533	REAL(wp) :: zxsa !< Ratio in 3nm particles: sulphuric acid
4534
4535	REAL(wp), INTENT(in) :: ppres !< ambient pressure (Pa)
4536	REAL(wp), INTENT(in) :: pcs !< Water vapour saturation concentration (kg/m3)
4537	REAL(wp), INTENT(in) :: ptemp !< ambient temperature (K)
4538	REAL(wp), INTENT(in) :: ptstep !< timestep (s)
4539
4540	REAL(wp), INTENT(inout) :: pchno3 !< Gas concentrations (#/m3): nitric acid HNO3
4541	REAL(wp), INTENT(inout) :: pc_nh3 !< ammonia NH3
4542	REAL(wp), INTENT(inout) :: pc_ocnv !< non-volatile organics
4543	REAL(wp), INTENT(inout) :: pcocsv !< semi-volatile organics
4544	REAL(wp), INTENT(inout) :: pc_sa !< sulphuric acid H2SO4
4545	REAL(wp), INTENT(inout) :: pcw !< Water vapor concentration (kg/m3)
4546
4547	REAL(wp), DIMENSION(nbins_aerosol) :: zbeta !< transitional correction factor
4548	REAL(wp), DIMENSION(nbins_aerosol) :: zcolrate !< collision rate (1/s)
4549	REAL(wp), DIMENSION(nbins_aerosol) :: zcolrate_ocnv !< collision rate of OCNV (1/s)
4550	REAL(wp), DIMENSION(start_subrange_1a+1) :: zdfpart !< particle diffusion coef. (m2/s)
4551	REAL(wp), DIMENSION(nbins_aerosol) :: zdvoloc !< change of organics volume
4552	REAL(wp), DIMENSION(nbins_aerosol) :: zdvolsa !< change of sulphate volume
4553	REAL(wp), DIMENSION(2) :: zj3n3 !< Formation massrate of molecules
4554	!< in nucleation, (molec/m3s),
4555	!< 1: H2SO4 and 2: organic vapor
4556	REAL(wp), DIMENSION(nbins_aerosol) :: zknud !< particle Knudsen number
4557
4558	TYPE(component_index), INTENT(in) :: prtcl !< Keeps track which substances are used
4559
4560	TYPE(t_section), DIMENSION(nbins_aerosol), INTENT(inout) :: paero !< Aerosol properties
4561
4562	zj3n3 = 0.0_wp
4563	zrh = pcw / pcs
4564	zxocnv = 0.0_wp
4565	zxsa = 0.0_wp
4566	!
4567	!-- Nucleation
4568	IF ( nsnucl > 0 ) THEN
4569	CALL nucleation( paero, ptemp, zrh, ppres, pc_sa, pc_ocnv, pc_nh3, ptstep, zj3n3, zxsa, &
4570	zxocnv )
4571	ENDIF
4572	!
4573	!-- Condensation on pre-existing particles
4574	IF ( lscndgas ) THEN
4575	!
4576	!-- Initialise:
4577	zdvolsa = 0.0_wp
4578	zdvoloc = 0.0_wp
4579	zcolrate = 0.0_wp
4580	!
4581	!-- 1) Properties of air and condensing gases:
4582	!-- Viscosity of air (kg/(m s)) (Eq. 4.54 in Jabonson (2005))
4583	zvisc = ( 7.44523E-3_wp * ptemp ** 1.5_wp ) / ( 5093.0_wp * ( ptemp + 110.4_wp ) )
4584	!
4585	!-- Diffusion coefficient of air (m2/s)
4586	zdfvap = 5.1111E-10_wp * ptemp ** 1.75_wp * ( p_0 + 1325.0_wp ) / ppres
4587	!
4588	!-- Mean free path (m): same for H2SO4 and organic compounds
4589	zmfp = 3.0_wp * zdfvap * SQRT( pi * amh2so4 / ( 8.0_wp * argas * ptemp ) )
4590	!
4591	!-- 2) Transition regime correction factor zbeta for particles (Fuchs and Sutugin (1971)):
4592	!-- Size of condensing molecule considered only for nucleation mode (3 - 20 nm).
4593	!
4594	!-- Particle Knudsen number: condensation of gases on aerosols
4595	ss = start_subrange_1a
4596	ee = start_subrange_1a+1
4597	zknud(ss:ee) = 2.0_wp * zmfp / ( paero(ss:ee)%dwet + d_sa )
4598	ss = start_subrange_1a+2
4599	ee = end_subrange_2b
4600	zknud(ss:ee) = 2.0_wp * zmfp / paero(ss:ee)%dwet
4601	!
4602	!-- Transitional correction factor: aerosol + gas (the semi-empirical Fuchs- Sutugin
4603	!-- interpolation function (Fuchs and Sutugin, 1971))
4604	zbeta = ( zknud + 1.0_wp ) / ( 0.377_wp * zknud + 1.0_wp + 4.0_wp / ( 3.0_wp * massacc ) * &
4605	( zknud + zknud ** 2 ) )
4606	!
4607	!-- 3) Collision rate of molecules to particles
4608	!-- Particle diffusion coefficient considered only for nucleation mode (3 - 20 nm)
4609	!
4610	!-- Particle diffusion coefficient (m2/s) (e.g. Eq. 15.29 in Jacobson (2005))
4611	zdfpart = abo * ptemp * zbeta(start_subrange_1a:start_subrange_1a+1) / ( 3.0_wp * pi * zvisc&
4612	* paero(start_subrange_1a:start_subrange_1a+1)%dwet)
4613	!
4614	!-- Collision rate (mass-transfer coefficient): gases on aerosols (1/s) (Eq. 16.64 in
4615	!-- Jacobson (2005))
4616	ss = start_subrange_1a
4617	ee = start_subrange_1a+1
4618	zcolrate(ss:ee) = MERGE( 2.0_wp * pi * ( paero(ss:ee)%dwet + d_sa ) * ( zdfvap + zdfpart ) *&
4619	zbeta(ss:ee) * paero(ss:ee)%numc, 0.0_wp, paero(ss:ee)%numc > nclim )
4620	ss = start_subrange_1a+2
4621	ee = end_subrange_2b
4622	zcolrate(ss:ee) = MERGE( 2.0_wp * pi * paero(ss:ee)%dwet * zdfvap * zbeta(ss:ee) * &
4623	paero(ss:ee)%numc, 0.0_wp, paero(ss:ee)%numc > nclim )
4624	!
4625	!-- 4) Condensation sink (1/s)
4626	zcs_tot = SUM( zcolrate ) ! total sink
4627	!
4628	!-- 5) Changes in gas-phase concentrations and particle volume
4629	!
4630	!-- 5.1) Organic vapours
4631	!
4632	!-- 5.1.1) Non-volatile organic compound: condenses onto all bins
4633	IF ( pc_ocnv > 1.0E+10_wp .AND. zcs_tot > 1.0E-30_wp .AND. index_oc > 0 ) &
4634	THEN
4635	!-- Ratio of nucleation vs. condensation rates in the smallest bin
4636	zn_vs_c = 0.0_wp
4637	IF ( zj3n3(2) > 1.0_wp ) THEN
4638	zn_vs_c = ( zj3n3(2) ) / ( zj3n3(2) + pc_ocnv * zcolrate(start_subrange_1a) )
4639	ENDIF
4640	!
4641	!-- Collision rate in the smallest bin, including nucleation and condensation (see
4642	!-- Jacobson (2005), eq. (16.73) )
4643	zcolrate_ocnv = zcolrate
4644	zcolrate_ocnv(start_subrange_1a) = zcolrate_ocnv(start_subrange_1a) + zj3n3(2) / pc_ocnv
4645	!
4646	!-- Total sink for organic vapor
4647	zcs_ocnv = zcs_tot + zj3n3(2) / pc_ocnv
4648	!
4649	!-- New gas phase concentration (#/m3)
4650	zcvap_new2 = pc_ocnv / ( 1.0_wp + ptstep * zcs_ocnv )
4651	!
4652	!-- Change in gas concentration (#/m3)
4653	zdvap2 = pc_ocnv - zcvap_new2
4654	!
4655	!-- Updated vapour concentration (#/m3)
4656	pc_ocnv = zcvap_new2
4657	!
4658	!-- Volume change of particles (m3(OC)/m3(air))
4659	zdvoloc = zcolrate_ocnv(start_subrange_1a:end_subrange_2b) / zcs_ocnv * amvoc * zdvap2
4660	!
4661	!-- Change of volume due to condensation in 1a-2b
4662	paero(start_subrange_1a:end_subrange_2b)%volc(2) = &
4663	paero(start_subrange_1a:end_subrange_2b)%volc(2) + zdvoloc
4664	!
4665	!-- Change of number concentration in the smallest bin caused by nucleation (Jacobson (2005),
4666	!-- eq. (16.75)). If zxocnv = 0, then the chosen nucleation mechanism doesn't take into
4667	!-- account the non-volatile organic vapors and thus the paero doesn't have to be updated.
4668	IF ( zxocnv > 0.0_wp ) THEN
4669	paero(start_subrange_1a)%numc = paero(start_subrange_1a)%numc + zn_vs_c * &
4670	zdvoloc(start_subrange_1a) / amvoc / ( n3 * zxocnv )
4671	ENDIF
4672	ENDIF
4673	!
4674	!-- 5.1.2) Semivolatile organic compound: all bins except subrange 1
4675	zcs_ocsv = SUM( zcolrate(start_subrange_2a:end_subrange_2b) ) !< sink for semi-volatile org.
4676	IF ( pcocsv > 1.0E+10_wp .AND. zcs_ocsv > 1.0E-30 .AND. is_used( prtcl,'OC') ) THEN
4677	!
4678	!-- New gas phase concentration (#/m3)
4679	zcvap_new3 = pcocsv / ( 1.0_wp + ptstep * zcs_ocsv )
4680	!
4681	!-- Change in gas concentration (#/m3)
4682	zdvap3 = pcocsv - zcvap_new3
4683	!
4684	!-- Updated gas concentration (#/m3)
4685	pcocsv = zcvap_new3
4686	!
4687	!-- Volume change of particles (m3(OC)/m3(air))
4688	ss = start_subrange_2a
4689	ee = end_subrange_2b
4690	zdvoloc(ss:ee) = zdvoloc(ss:ee) + zcolrate(ss:ee) / zcs_ocsv * amvoc * zdvap3
4691	!
4692	!-- Change of volume due to condensation in 1a-2b
4693	paero(start_subrange_1a:end_subrange_2b)%volc(2) = &
4694	paero(start_subrange_1a:end_subrange_2b)%volc(2) + zdvoloc
4695	ENDIF
4696	!
4697	!-- 5.2) Sulphate: condensed on all bins
4698	IF ( pc_sa > 1.0E+10_wp .AND. zcs_tot > 1.0E-30_wp .AND. index_so4 > 0 ) THEN
4699	!
4700	!-- Ratio of mass transfer between nucleation and condensation
4701	zn_vs_c = 0.0_wp
4702	IF ( zj3n3(1) > 1.0_wp ) THEN
4703	zn_vs_c = ( zj3n3(1) ) / ( zj3n3(1) + pc_sa * zcolrate(start_subrange_1a) )
4704	ENDIF
4705	!
4706	!-- Collision rate in the smallest bin, including nucleation and condensation (see
4707	!-- Jacobson (2005), eq. (16.73))
4708	zcolrate(start_subrange_1a) = zcolrate(start_subrange_1a) + zj3n3(1) / pc_sa
4709	!
4710	!-- Total sink for sulfate (1/s)
4711	zcs_su = zcs_tot + zj3n3(1) / pc_sa
4712	!
4713	!-- Sulphuric acid:
4714	!-- New gas phase concentration (#/m3)
4715	zcvap_new1 = pc_sa / ( 1.0_wp + ptstep * zcs_su )
4716	!
4717	!-- Change in gas concentration (#/m3)
4718	zdvap1 = pc_sa - zcvap_new1
4719	!
4720	!-- Updating vapour concentration (#/m3)
4721	pc_sa = zcvap_new1
4722	!
4723	!-- Volume change of particles (m3(SO4)/m3(air)) by condensation
4724	zdvolsa = zcolrate(start_subrange_1a:end_subrange_2b) / zcs_su * amvh2so4 * zdvap1
4725	!
4726	!-- Change of volume concentration of sulphate in aerosol [fxm]
4727	paero(start_subrange_1a:end_subrange_2b)%volc(1) = &
4728	paero(start_subrange_1a:end_subrange_2b)%volc(1) + zdvolsa
4729	!
4730	!-- Change of number concentration in the smallest bin caused by nucleation
4731	!-- (Jacobson (2005), equation (16.75))
4732	IF ( zxsa > 0.0_wp ) THEN
4733	paero(start_subrange_1a)%numc = paero(start_subrange_1a)%numc + zn_vs_c * &
4734	zdvolsa(start_subrange_1a) / amvh2so4 / ( n3 * zxsa)
4735	ENDIF
4736	ENDIF
4737	!
4738	!-- Partitioning of H2O, HNO3, and NH3: Dissolutional growth
4739	IF ( lspartition .AND. ( pchno3 > 1.0E+10_wp .OR. pc_nh3 > 1.0E+10_wp ) ) THEN
4740	CALL gpparthno3( ppres, ptemp, paero, pchno3, pc_nh3, pcw, pcs, zbeta, ptstep )
4741	ENDIF
4742	ENDIF
4743	!
4744	!-- Condensation of water vapour
4745	IF ( lscndh2oae ) THEN
4746	CALL gpparth2o( paero, ptemp, ppres, pcs, pcw, ptstep )
4747	ENDIF
4748
4749	END SUBROUTINE condensation
4750
4751	!------------------------------------------------------------------------------!
4752	! Description:
4753	! ------------
4754	!> Calculates the particle number and volume increase, and gas-phase
4755	!> concentration decrease due to nucleation subsequent growth to detectable size
4756	!> of 3 nm.
4757	!
4758	!> Method:
4759	!> When the formed clusters grow by condensation (possibly also by self-
4760	!> coagulation), their number is reduced due to scavenging to pre-existing
4761	!> particles. Thus, the apparent nucleation rate at 3 nm is significantly lower
4762	!> than the real nucleation rate (at ~1 nm).
4763	!
4764	!> Calculation of the formation rate of detectable particles at 3 nm (i.e. J3):
4765	!> nj3 = 1: Kerminen, V.-M. and Kulmala, M. (2002), J. Aerosol Sci.,33, 609-622.
4766	!> nj3 = 2: Lehtinen et al. (2007), J. Aerosol Sci., 38(9), 988-994.
4767	!> nj3 = 3: Anttila et al. (2010), J. Aerosol Sci., 41(7), 621-636.
4768	!
4769	!> c = aerosol of critical radius (1 nm)
4770	!> x = aerosol with radius 3 nm
4771	!> 2 = wet or mean droplet
4772	!
4773	!> Called from subroutine condensation (in module salsa_dynamics_mod.f90)
4774	!
4775	!> Calls one of the following subroutines:
4776	!> - binnucl
4777	!> - ternucl
4778	!> - kinnucl
4779	!> - actnucl
4780	!
4781	!> fxm: currently only sulphuric acid grows particles from 1 to 3 nm
4782	!> (if asked from Markku, this is terribly wrong!!!)
4783	!
4784	!> Coded by:
4785	!> Hannele Korhonen (FMI) 2005
4786	!> Harri Kokkola (FMI) 2006
4787	!> Matti Niskanen(FMI) 2012
4788	!> Anton Laakso (FMI) 2013
4789	!------------------------------------------------------------------------------!
4790
4791	SUBROUTINE nucleation( paero, ptemp, prh, ppres, pc_sa, pc_ocnv, pc_nh3, ptstep, pj3n3, pxsa, &
4792	pxocnv )
4793
4794	IMPLICIT NONE
4795
4796	INTEGER(iwp) :: iteration
4797
4798	REAL(wp) :: zc_h2so4 !< H2SO4 conc. (#/cm3) !UNITS!
4799	REAL(wp) :: zc_org !< organic vapour conc. (#/cm3)
4800	REAL(wp) :: zcc_c !< Cunningham correct factor for c = critical (1nm)
4801	REAL(wp) :: zcc_x !< Cunningham correct factor for x = 3nm
4802	REAL(wp) :: zcoags_c !< coagulation sink (1/s) for c = critical (1nm)
4803	REAL(wp) :: zcoags_x !< coagulation sink (1/s) for x = 3nm
4804	REAL(wp) :: zcoagstot !< total particle losses due to coagulation, including condensation
4805	!< and self-coagulation
4806	REAL(wp) :: zcocnv_local !< organic vapour conc. (#/m3)
4807	REAL(wp) :: zcsink !< condensational sink (#/m2)
4808	REAL(wp) :: zcsa_local !< H2SO4 conc. (#/m3)
4809	REAL(wp) :: zcv_c !< mean relative thermal velocity (m/s) for c = critical (1nm)
4810	REAL(wp) :: zcv_x !< mean relative thermal velocity (m/s) for x = 3nm
4811	REAL(wp) :: zdcrit !< diameter of critical cluster (m)
4812	REAL(wp) :: zdelta_vap !< change of H2SO4 and organic vapour concentration (#/m3)
4813	REAL(wp) :: zdfvap !< air diffusion coefficient (m2/s)
4814	REAL(wp) :: zdmean !< mean diameter of existing particles (m)
4815	REAL(wp) :: zeta !< constant: proportional to ratio of CS/GR (m)
4816	!< (condensation sink / growth rate)
4817	REAL(wp) :: zgamma !< proportionality factor ((nm2*m2)/h)
4818	REAL(wp) :: z_gr_clust !< growth rate of formed clusters (nm/h)
4819	REAL(wp) :: z_gr_tot !< total growth rate
4820	REAL(wp) :: zj3 !< number conc. of formed 3nm particles (#/m3)
4821	REAL(wp) :: zjnuc !< nucleation rate at ~1nm (#/m3s)
4822	REAL(wp) :: z_k_eff !< effective cogulation coefficient for freshly nucleated particles
4823	REAL(wp) :: zknud_c !< Knudsen number for c = critical (1nm)
4824	REAL(wp) :: zknud_x !< Knudsen number for x = 3nm
4825	REAL(wp) :: zkocnv !< lever: zkocnv=1 --> organic compounds involved in nucleation
4826	REAL(wp) :: zksa !< lever: zksa=1 --> H2SO4 involved in nucleation
4827	REAL(wp) :: zlambda !< parameter for adjusting the growth rate due to self-coagulation
4828	REAL(wp) :: zm_c !< particle mass (kg) for c = critical (1nm)
4829	REAL(wp) :: zm_para !< Parameter m for calculating the coagulation sink (Eq. 5&6 in
4830	!< Lehtinen et al. 2007)
4831	REAL(wp) :: zm_x !< particle mass (kg) for x = 3nm
4832	REAL(wp) :: zmfp !< mean free path of condesing vapour(m)
4833	REAL(wp) :: zmixnh3 !< ammonia mixing ratio (ppt)
4834	REAL(wp) :: zmyy !< gas dynamic viscosity (N*s/m2)
4835	REAL(wp) :: z_n_nuc !< number of clusters/particles at the size range d1-dx (#/m3)
4836	REAL(wp) :: znoc !< number of organic molecules in critical cluster
4837	REAL(wp) :: znsa !< number of H2SO4 molecules in critical cluster
4838
4839	REAL(wp), INTENT(in) :: pc_nh3 !< ammonia concentration (#/m3)
4840	REAL(wp), INTENT(in) :: pc_ocnv !< conc. of non-volatile OC (#/m3)
4841	REAL(wp), INTENT(in) :: pc_sa !< sulphuric acid conc. (#/m3)
4842	REAL(wp), INTENT(in) :: ppres !< ambient air pressure (Pa)
4843	REAL(wp), INTENT(in) :: prh !< ambient rel. humidity [0-1]
4844	REAL(wp), INTENT(in) :: ptemp !< ambient temperature (K)
4845	REAL(wp), INTENT(in) :: ptstep !< time step (s) of SALSA
4846
4847	REAL(wp), INTENT(inout) :: pj3n3(2) !< formation mass rate of molecules (molec/m3s) for
4848	!< 1: H2SO4 and 2: organic vapour
4849
4850	REAL(wp), INTENT(out) :: pxocnv !< ratio of non-volatile organic vapours in 3 nm particles
4851	REAL(wp), INTENT(out) :: pxsa !< ratio of H2SO4 in 3 nm aerosol particles
4852
4853	REAL(wp), DIMENSION(nbins_aerosol) :: zbeta !< transitional correction factor
4854	REAL(wp), DIMENSION(nbins_aerosol) :: zcc_2 !< Cunningham correct factor:2
4855	REAL(wp), DIMENSION(nbins_aerosol) :: zcv_2 !< mean relative thermal velocity (m/s): 2
4856	REAL(wp), DIMENSION(nbins_aerosol) :: zcv_c2 !< average velocity after coagulation: c & 2
4857	REAL(wp), DIMENSION(nbins_aerosol) :: zcv_x2 !< average velocity after coagulation: x & 2
4858	REAL(wp), DIMENSION(nbins_aerosol) :: zdc_2 !< particle diffusion coefficient (m2/s): 2
4859	REAL(wp), DIMENSION(nbins_aerosol) :: zdc_c !< particle diffusion coefficient (m2/s): c
4860	REAL(wp), DIMENSION(nbins_aerosol) :: zdc_c2 !< sum of diffusion coef. for c and 2
4861	REAL(wp), DIMENSION(nbins_aerosol) :: zdc_x !< particle diffusion coefficient (m2/s): x
4862	REAL(wp), DIMENSION(nbins_aerosol) :: zdc_x2 !< sum of diffusion coef. for: x & 2
4863	REAL(wp), DIMENSION(nbins_aerosol) :: zgamma_f_2 !< zgamma_f for calculating zomega
4864	REAL(wp), DIMENSION(nbins_aerosol) :: zgamma_f_c !< zgamma_f for calculating zomega
4865	REAL(wp), DIMENSION(nbins_aerosol) :: zgamma_f_x !< zgamma_f for calculating zomega
4866	REAL(wp), DIMENSION(nbins_aerosol) :: z_k_c2 !< coagulation coef. in the continuum
4867	!< regime: c & 2
4868	REAL(wp), DIMENSION(nbins_aerosol) :: z_k_x2 !< coagulation coef. in the continuum
4869	!< regime: x & 2
4870	REAL(wp), DIMENSION(nbins_aerosol) :: zknud !< particle Knudsen number
4871	REAL(wp), DIMENSION(nbins_aerosol) :: zknud_2 !< particle Knudsen number: 2
4872	REAL(wp), DIMENSION(nbins_aerosol) :: zm_2 !< particle mass (kg): 2
4873	REAL(wp), DIMENSION(nbins_aerosol) :: zomega_2c !< zomega (m) for calculating zsigma: c & 2
4874	REAL(wp), DIMENSION(nbins_aerosol) :: zomega_2x !< zomega (m) for calculating zsigma: x & 2
4875	REAL(wp), DIMENSION(nbins_aerosol) :: zomega_c !< zomega (m) for calculating zsigma: c
4876	REAL(wp), DIMENSION(nbins_aerosol) :: zomega_x !< zomega (m) for calculating zsigma: x
4877	REAL(wp), DIMENSION(nbins_aerosol) :: z_r_c2 !< sum of the radii: c & 2
4878	REAL(wp), DIMENSION(nbins_aerosol) :: z_r_x2 !< sum of the radii: x & 2
4879	REAL(wp), DIMENSION(nbins_aerosol) :: zsigma_c2 !<
4880	REAL(wp), DIMENSION(nbins_aerosol) :: zsigma_x2 !<
4881
4882	TYPE(t_section), DIMENSION(nbins_aerosol), INTENT(inout) :: paero !< aerosol properties
4883	!
4884	!-- 1) Nucleation rate (zjnuc) and diameter of critical cluster (zdcrit)
4885	zjnuc = 0.0_wp
4886	znsa = 0.0_wp
4887	znoc = 0.0_wp
4888	zdcrit = 0.0_wp
4889	zksa = 0.0_wp
4890	zkocnv = 0.0_wp
4891
4892	zc_h2so4 = pc_sa * 1.0E-6_wp ! sulphuric acid conc. to #/cm3
4893	zc_org = pc_ocnv * 1.0E-6_wp ! conc. of non-volatile OC to #/cm3
4894	zmixnh3 = pc_nh3 * ptemp * argas / ( ppres * avo )
4895
4896	SELECT CASE ( nsnucl )
4897	!
4898	!-- Binary H2SO4-H2O nucleation
4899	CASE(1)
4900
4901	CALL binnucl( zc_h2so4, ptemp, prh, zjnuc, znsa, znoc, zdcrit, zksa, zkocnv )
4902	!
4903	!-- Activation type nucleation (See Riipinen et al. (2007), Atmos. Chem. Phys., 7(8), 1899-1914)
4904	CASE(2)
4905	!
4906	!-- Nucleation rate (#/(m3 s))
4907	zc_h2so4 = MAX( zc_h2so4, 1.0E4_wp )
4908	zc_h2so4 = MIN( zc_h2so4, 1.0E11_wp )
4909	zjnuc = act_coeff * pc_sa ! (#/(m3 s))
4910	!
4911	!-- Organic compounds not involved when kinetic nucleation is assumed.
4912	zdcrit = 7.9375E-10_wp ! (m)
4913	zkocnv = 0.0_wp
4914	zksa = 1.0_wp
4915	znoc = 0.0_wp
4916	znsa = 2.0_wp
4917	!
4918	!-- Kinetically limited nucleation of (NH4)HSO4 clusters
4919	!-- (See Sihto et al. (2006), Atmos. Chem. Phys., 6(12), 4079-4091.)
4920	CASE(3)
4921	!
4922	!-- Nucleation rate = coagcoeffzpcsa*2 (#/(m3 s))
4923	zc_h2so4 = MAX( zc_h2so4, 1.0E4_wp )
4924	zc_h2so4 = MIN( zc_h2so4, 1.0E11_wp )
4925	zjnuc = 5.0E-13_wp * zc_h2so4*2.0_wp 1.0E+6_wp
4926	!
4927	!-- Organic compounds not involved when kinetic nucleation is assumed.
4928	zdcrit = 7.9375E-10_wp ! (m)
4929	zkocnv = 0.0_wp
4930	zksa = 1.0_wp
4931	znoc = 0.0_wp
4932	znsa = 2.0_wp
4933	!
4934	!-- Ternary H2SO4-H2O-NH3 nucleation
4935	CASE(4)
4936
4937	CALL ternucl( zc_h2so4, zmixnh3, ptemp, prh, zjnuc, znsa, znoc, zdcrit, zksa, zkocnv )
4938	!
4939	!-- Organic nucleation, J~[ORG] or J~[ORG]**2
4940	!-- (See Paasonen et al. (2010), Atmos. Chem. Phys., 10, 11223-11242.)
4941	CASE(5)
4942	!
4943	!-- Homomolecular nuleation rate
4944	zjnuc = 1.3E-7_wp * pc_ocnv ! (1/s) (Paasonen et al. Table 4: median a_org)
4945	!
4946	!-- H2SO4 not involved when pure organic nucleation is assumed.
4947	zdcrit = 1.5E-9 ! (m)
4948	zkocnv = 1.0_wp
4949	zksa = 0.0_wp
4950	znoc = 1.0_wp
4951	znsa = 0.0_wp
4952	!
4953	!-- Sum of H2SO4 and organic activation type nucleation, J~[H2SO4]+[ORG]
4954	!-- (See Paasonen et al. (2010), Atmos. Chem. Phys., 10, 11223-11242)
4955	CASE(6)
4956	!
4957	!-- Nucleation rate (#/m3/s)
4958	zjnuc = 6.1E-7_wp * pc_sa + 0.39E-7_wp * pc_ocnv ! (Paasonen et al. Table 3.)
4959	!
4960	!-- Both organic compounds and H2SO4 are involved when sumnucleation is assumed.
4961	zdcrit = 1.5E-9_wp ! (m)
4962	zkocnv = 1.0_wp
4963	zksa = 1.0_wp
4964	znoc = 1.0_wp
4965	znsa = 1.0_wp
4966	!
4967	!-- Heteromolecular nucleation, J~[H2SO4]*[ORG]
4968	!-- (See Paasonen et al. (2010), Atmos. Chem. Phys., 10, 11223-11242.)
4969	CASE(7)
4970	!
4971	!-- Nucleation rate (#/m3/s)
4972	zjnuc = 4.1E-14_wp * pc_sa * pc_ocnv * 1.0E6_wp ! (Paasonen et al. Table 4: median)
4973	!
4974	!-- Both organic compounds and H2SO4 are involved when heteromolecular nucleation is assumed
4975	zdcrit = 1.5E-9_wp ! (m)
4976	zkocnv = 1.0_wp
4977	zksa = 1.0_wp
4978	znoc = 1.0_wp
4979	znsa = 1.0_wp
4980	!
4981	!-- Homomolecular nucleation of H2SO4 and heteromolecular nucleation of H2SO4 and organic vapour,
4982	!-- J~[H2SO4]*2 + [H2SO4][ORG] (EUCAARI project)
4983	!-- (See Paasonen et al. (2010), Atmos. Chem. Phys., 10, 11223-11242)
4984	CASE(8)
4985	!
4986	!-- Nucleation rate (#/m3/s)
4987	zjnuc = ( 1.1E-14_wp * zc_h2so4*2 + 3.2E-14_wp zc_h2so4 * zc_org ) * 1.0E+6_wp
4988	!
4989	!-- Both organic compounds and H2SO4 are involved when SAnucleation is assumed
4990	zdcrit = 1.5E-9_wp ! (m)
4991	zkocnv = 1.0_wp
4992	zksa = 1.0_wp
4993	znoc = 1.0_wp
4994	znsa = 3.0_wp
4995	!
4996	!-- Homomolecular nucleation of H2SO4 and organic vapour and heteromolecular nucleation of H2SO4
4997	!-- and organic vapour, J~[H2SO4]*2 + [H2SO4][ORG]+[ORG]**2 (EUCAARI project)
4998	CASE(9)
4999	!
5000	!-- Nucleation rate (#/m3/s)
5001	zjnuc = ( 1.4E-14_wp * zc_h2so4*2 + 2.6E-14_wp zc_h2so4 * zc_org + 0.037E-14_wp * &
5002	zc_org*2 ) 1.0E+6_wp
5003	!
5004	!-- Both organic compounds and H2SO4 are involved when SAORGnucleation is assumed
5005	zdcrit = 1.5E-9_wp ! (m)
5006	zkocnv = 1.0_wp
5007	zksa = 1.0_wp
5008	znoc = 3.0_wp
5009	znsa = 3.0_wp
5010
5011	END SELECT
5012
5013	zcsa_local = pc_sa
5014	zcocnv_local = pc_ocnv
5015	!
5016	!-- 2) Change of particle and gas concentrations due to nucleation
5017	!
5018	!-- 2.1) Check that there is enough H2SO4 and organic vapour to produce the nucleation
5019	IF ( nsnucl <= 4 ) THEN
5020	!
5021	!-- If the chosen nucleation scheme is 1-4, nucleation occurs only due to H2SO4. All of the total
5022	!-- vapour concentration that is taking part to the nucleation is there for sulphuric acid
5023	!-- (sa = H2SO4) and non-volatile organic vapour is zero.
5024	pxsa = 1.0_wp ! ratio of sulphuric acid in 3nm particles
5025	pxocnv = 0.0_wp ! ratio of non-volatile origanic vapour
5026	! in 3nm particles
5027	ELSEIF ( nsnucl > 4 ) THEN
5028	!
5029	!-- If the chosen nucleation scheme is 5-9, nucleation occurs due to organic vapour or the
5030	!-- combination of organic vapour and H2SO4. The number of needed molecules depends on the chosen
5031	!-- nucleation type and it has an effect also on the minimum ratio of the molecules present.
5032	IF ( pc_sa * znsa + pc_ocnv * znoc < 1.E-14_wp ) THEN
5033	pxsa = 0.0_wp
5034	pxocnv = 0.0_wp
5035	ELSE
5036	pxsa = pc_sa * znsa / ( pc_sa * znsa + pc_ocnv * znoc )
5037	pxocnv = pc_ocnv * znoc / ( pc_sa * znsa + pc_ocnv * znoc )
5038	ENDIF
5039	ENDIF
5040	!
5041	!-- The change in total vapour concentration is the sum of the concentrations of the vapours taking
5042	!-- part to the nucleation (depends on the chosen nucleation scheme)
5043	zdelta_vap = MIN( zjnuc * ( znoc + znsa ), ( pc_ocnv * zkocnv + pc_sa * zksa ) / ptstep )
5044	!
5045	!-- Nucleation rate J at ~1nm (#/m3s)
5046	zjnuc = zdelta_vap / ( znoc + znsa )
5047	!
5048	!-- H2SO4 concentration after nucleation (#/m3)
5049	zcsa_local = MAX( 1.0_wp, pc_sa - zdelta_vap * pxsa )
5050	!
5051	!-- Non-volative organic vapour concentration after nucleation (#/m3)
5052	zcocnv_local = MAX( 1.0_wp, pc_ocnv - zdelta_vap * pxocnv )
5053	!
5054	!-- 2.2) Formation rate of 3 nm particles (Kerminen & Kulmala, 2002)
5055	!
5056	!-- Growth rate by H2SO4 and organic vapour (nm/h, Eq. 21)
5057	z_gr_clust = 2.3623E-15_wp * SQRT( ptemp ) * ( zcsa_local + zcocnv_local )
5058	!
5059	!-- 2.2.2) Condensational sink of pre-existing particle population
5060	!
5061	!-- Diffusion coefficient (m2/s)
5062	zdfvap = 5.1111E-10_wp * ptemp*1.75_wp ( p_0 + 1325.0_wp ) / ppres
5063	!
5064	!-- Mean free path of condensing vapour (m) (Jacobson (2005), Eq. 15.25 and 16.29)
5065	zmfp = 3.0_wp * zdfvap * SQRT( pi * amh2so4 / ( 8.0_wp * argas * ptemp ) )
5066	!
5067	!-- Knudsen number
5068	zknud = 2.0_wp * zmfp / ( paero(:)%dwet + d_sa )
5069	!
5070	!-- Transitional regime correction factor (zbeta) according to Fuchs and Sutugin (1971) (Eq. 4 in
5071	!-- Kerminen and Kulmala, 2002)
5072	zbeta = ( zknud + 1.0_wp) / ( 0.377_wp * zknud + 1.0_wp + 4.0_wp / ( 3.0_wp * massacc ) * &
5073	( zknud + zknud**2 ) )
5074	!
5075	!-- Condensational sink (#/m2, Eq. 3)
5076	zcsink = SUM( paero(:)%dwet * zbeta * paero(:)%numc )
5077	!
5078	!-- 2.2.3) Parameterised formation rate of detectable 3 nm particles (i.e. J3)
5079	IF ( nj3 == 1 ) THEN ! Kerminen and Kulmala (2002)
5080	!
5081	!-- Constants needed for the parameterisation: dapp = 3 nm and dens_nuc = 1830 kg/m3
5082	IF ( zcsink < 1.0E-30_wp ) THEN
5083	zeta = 0._dp
5084	ELSE
5085	!
5086	!-- Mean diameter of backgroud population (nm)
5087	zdmean = 1.0_wp / SUM( paero(:)%numc ) * SUM( paero(:)%numc * paero(:)%dwet ) * 1.0E+9_wp
5088	!
5089	!-- Proportionality factor (nm2*m2/h) (Eq. 22)
5090	zgamma = 0.23_wp * ( zdcrit * 1.0E+9_wp )*0.2_wp ( zdmean / 150.0_wp )*0.048_wp &
5091	( ptemp / 293.0_wp )*( -0.75_wp ) ( arhoh2so4 / 1000.0_wp )**( -0.33_wp )
5092	!
5093	!-- Factor eta (nm, Eq. 11)
5094	zeta = MIN( zgamma * zcsink / z_gr_clust, zdcrit * 1.0E11_wp )
5095	ENDIF
5096	!
5097	!-- Number conc. of clusters surviving to 3 nm in a time step (#/m3, Eq.14)
5098	zj3 = zjnuc * EXP( MIN( 0.0_wp, zeta / 3.0_wp - zeta / ( zdcrit * 1.0E9_wp ) ) )
5099
5100	ELSEIF ( nj3 > 1 ) THEN ! Lehtinen et al. (2007) or Anttila et al. (2010)
5101	!
5102	!-- Defining the parameter m (zm_para) for calculating the coagulation sink onto background
5103	!-- particles (Eq. 5&6 in Lehtinen et al. 2007). The growth is investigated between
5104	!-- [d1,reglim(1)] = [zdcrit,3nm] and m = LOG( CoagS_dx / CoagX_zdcrit ) / LOG( reglim / zdcrit )
5105	!-- (Lehtinen et al. 2007, Eq. 6).
5106	!-- The steps for the coagulation sink for reglim = 3nm and zdcrit ~= 1nm are explained in
5107	!-- Kulmala et al. (2001). The particles of diameter zdcrit ~1.14 nm and reglim = 3nm are both
5108	!-- in turn the "number 1" variables (Kulmala et al. 2001).
5109	!-- c = critical (1nm), x = 3nm, 2 = wet or mean droplet
5110	!
5111	!-- Sum of the radii, R12 = R1 + R2 (m) of two particles 1 and 2
5112	z_r_c2 = zdcrit / 2.0_wp + paero(:)%dwet / 2.0_wp
5113	z_r_x2 = reglim(1) / 2.0_wp + paero(:)%dwet / 2.0_wp
5114	!
5115	!-- Particle mass (kg) (comes only from H2SO4)
5116	zm_c = 4.0_wp / 3.0_wp * pi * ( zdcrit / 2.0_wp )*3 arhoh2so4
5117	zm_x = 4.0_wp / 3.0_wp * pi * ( reglim(1) / 2.0_wp )*3 arhoh2so4
5118	zm_2 = 4.0_wp / 3.0_wp * pi * ( 0.5_wp * paero(:)%dwet )*3 arhoh2so4
5119	!
5120	!-- Mean relative thermal velocity between the particles (m/s)
5121	zcv_c = SQRT( 8.0_wp * abo * ptemp / ( pi * zm_c ) )
5122	zcv_x = SQRT( 8.0_wp * abo * ptemp / ( pi * zm_x ) )
5123	zcv_2 = SQRT( 8.0_wp * abo * ptemp / ( pi * zm_2 ) )
5124	!
5125	!-- Average velocity after coagulation
5126	zcv_c2(:) = SQRT( zcv_c2 + zcv_22 )
5127	zcv_x2(:) = SQRT( zcv_x2 + zcv_22 )
5128	!
5129	!-- Knudsen number (zmfp = mean free path of condensing vapour)
5130	zknud_c = 2.0_wp * zmfp / zdcrit
5131	zknud_x = 2.0_wp * zmfp / reglim(1)
5132	zknud_2(:) = MAX( 0.0_wp, 2.0_wp * zmfp / paero(:)%dwet )
5133	!
5134	!-- Cunningham correction factors (Allen and Raabe, 1985)
5135	zcc_c = 1.0_wp + zknud_c * ( 1.142_wp + 0.558_wp * EXP( -0.999_wp / zknud_c ) )
5136	zcc_x = 1.0_wp + zknud_x * ( 1.142_wp + 0.558_wp * EXP( -0.999_wp / zknud_x ) )
5137	zcc_2(:) = 1.0_wp + zknud_2(:) * ( 1.142_wp + 0.558_wp * EXP( -0.999_wp / zknud_2(:) ) )
5138	!
5139	!-- Gas dynamic viscosity (Ns/m2). Here, viscocity(air @20C) = 1.81e-5_dp N/m2 s (Hinds, p. 25)
5140	zmyy = 1.81E-5_wp * ( ptemp / 293.0_wp )**0.74_wp
5141	!
5142	!-- Particle diffusion coefficient (m2/s) (continuum regime)
5143	zdc_c(:) = abo * ptemp * zcc_c / ( 3.0_wp * pi * zmyy * zdcrit )
5144	zdc_x(:) = abo * ptemp * zcc_x / ( 3.0_wp * pi * zmyy * reglim(1) )
5145	zdc_2(:) = abo * ptemp * zcc_2(:) / ( 3.0_wp * pi * zmyy * paero(:)%dwet )
5146	!
5147	!-- D12 = D1+D2 (Seinfield and Pandis, 2nd ed. Eq. 13.38)
5148	zdc_c2 = zdc_c + zdc_2
5149	zdc_x2 = zdc_x + zdc_2
5150	!
5151	!-- zgamma_f = 8*D/pi/zcv (m) for calculating zomega (Fuchs, 1964)
5152	zgamma_f_c = 8.0_wp * zdc_c / pi / zcv_c
5153	zgamma_f_x = 8.0_wp * zdc_x / pi / zcv_x
5154	zgamma_f_2 = 8.0_wp * zdc_2 / pi / zcv_2
5155	!
5156	!-- zomega (m) for calculating zsigma
5157	zomega_c = ( ( z_r_c2 + zgamma_f_c )3 - ( z_r_c2 2 + zgamma_f_c )**1.5_wp ) / &
5158	( 3.0_wp * z_r_c2 * zgamma_f_c ) - z_r_c2
5159	zomega_x = ( ( z_r_x2 + zgamma_f_x )3 - ( z_r_x22 + zgamma_f_x )** 1.5_wp ) / &
5160	( 3.0_wp * z_r_x2 * zgamma_f_x ) - z_r_x2
5161	zomega_2c = ( ( z_r_c2 + zgamma_f_2 )3 - ( z_r_c22 + zgamma_f_2 )**1.5_wp ) / &
5162	( 3.0_wp * z_r_c2 * zgamma_f_2 ) - z_r_c2
5163	zomega_2x = ( ( z_r_x2 + zgamma_f_2 )3 - ( z_r_x22 + zgamma_f_2 )**1.5_wp ) / &
5164	( 3.0_wp * z_r_x2 * zgamma_f_2 ) - z_r_x2
5165	!
5166	!-- The distance (m) at which the two fluxes are matched (condensation and coagulation sinks)
5167	zsigma_c2 = SQRT( zomega_c2 + zomega_2c2 )
5168	zsigma_x2 = SQRT( zomega_x2 + zomega_2x2 )
5169	!
5170	!-- Coagulation coefficient in the continuum regime (m*m2/s, Eq. 17 in Kulmala et al., 2001)
5171	z_k_c2 = 4.0_wp * pi * z_r_c2 * zdc_c2 / ( z_r_c2 / ( z_r_c2 + zsigma_c2 ) + &
5172	4.0_wp * zdc_c2 / ( zcv_c2 * z_r_c2 ) )
5173	z_k_x2 = 4.0_wp * pi * z_r_x2 * zdc_x2 / ( z_r_x2 / ( z_r_x2 + zsigma_x2 ) + &
5174	4.0_wp * zdc_x2 / ( zcv_x2 * z_r_x2 ) )
5175	!
5176	!-- Coagulation sink (1/s, Eq. 16 in Kulmala et al., 2001)
5177	zcoags_c = MAX( 1.0E-20_wp, SUM( z_k_c2 * paero(:)%numc ) )
5178	zcoags_x = MAX( 1.0E-20_wp, SUM( z_k_x2 * paero(:)%numc ) )
5179	!
5180	!-- Parameter m for calculating the coagulation sink onto background particles (Eq. 5&6 in
5181	!-- Lehtinen et al. 2007)
5182	zm_para = LOG( zcoags_x / zcoags_c ) / LOG( reglim(1) / zdcrit )
5183	!
5184	!-- Parameter gamma for calculating the formation rate J of particles having
5185	!-- a diameter zdcrit < d < reglim(1) (Anttila et al. 2010, eq. 5 or Lehtinen et al.,2007, eq. 7)
5186	zgamma = ( ( ( reglim(1) / zdcrit )**( zm_para + 1.0_wp ) ) - 1.0_wp ) / ( zm_para + 1.0_wp )
5187
5188	IF ( nj3 == 2 ) THEN ! Lehtinen et al. (2007): coagulation sink
5189	!
5190	!-- Formation rate J before iteration (#/m3s)
5191	zj3 = zjnuc * EXP( MIN( 0.0_wp, -zgamma * zdcrit * zcoags_c / ( z_gr_clust * 1.0E-9_wp / &
5192	60.0_wp**2 ) ) )
5193
5194	ELSEIF ( nj3 == 3 ) THEN ! Anttila et al. (2010): coagulation sink and self-coag.
5195	!
5196	!-- If air is polluted, the self-coagulation becomes important. Self-coagulation of small
5197	!-- particles < 3 nm.
5198	!
5199	!-- "Effective" coagulation coefficient between freshly-nucleated particles:
5200	z_k_eff = 5.0E-16_wp ! m3/s
5201	!
5202	!-- zlambda parameter for "adjusting" the growth rate due to the self-coagulation
5203	zlambda = 6.0_wp
5204
5205	IF ( reglim(1) >= 10.0E-9_wp ) THEN ! for particles >10 nm:
5206	z_k_eff = 5.0E-17_wp
5207	zlambda = 3.0_wp
5208	ENDIF
5209	!
5210	!-- Initial values for coagulation sink and growth rate (m/s)
5211	zcoagstot = zcoags_c
5212	z_gr_tot = z_gr_clust * 1.0E-9_wp / 60.0_wp**2
5213	!
5214	!-- Number of clusters/particles at the size range [d1,dx] (#/m3):
5215	z_n_nuc = zjnuc / zcoagstot !< Initial guess
5216	!
5217	!-- Coagulation sink and growth rate due to self-coagulation:
5218	DO iteration = 1, 5
5219	zcoagstot = zcoags_c + z_k_eff * z_n_nuc * 1.0E-6_wp ! (1/s, Anttila et al., eq. 1)
5220	z_gr_tot = z_gr_clust * 2.77777777E-7_wp + 1.5708E-6_wp * zlambda * zdcrit*3 &
5221	( z_n_nuc * 1.0E-6_wp ) * zcv_c * avo * 2.77777777E-7_wp ! (Eq. 3)
5222	zeta = - zcoagstot / ( ( zm_para + 1.0_wp ) * z_gr_tot * ( zdcrit**zm_para ) ) ! (Eq.7b)
5223	!
5224	!-- Calculate Eq. 7a (Taylor series for the number of particles between [d1,dx])
5225	z_n_nuc = z_n_nuc_tayl( zdcrit, reglim(1), zm_para, zjnuc, zeta, z_gr_tot )
5226	ENDDO
5227	!
5228	!-- Calculate the final values with new z_n_nuc:
5229	zcoagstot = zcoags_c + z_k_eff * z_n_nuc * 1.0E-6_wp ! (1/s)
5230	z_gr_tot = z_gr_clust * 1.0E-9_wp / 3600.0_wp + 1.5708E-6_wp * zlambda * zdcrit*3 &
5231	( z_n_nuc * 1.0E-6_wp ) * zcv_c * avo * 1.0E-9_wp / 3600.0_wp !< (m/s)
5232	zj3 = zjnuc * EXP( MIN( 0.0_wp, -zgamma * zdcrit * zcoagstot / z_gr_tot ) ) ! (#/m3s, Eq.5a)
5233
5234	ENDIF
5235	ENDIF
5236	!
5237	!-- If J3 very small (< 1 #/cm3), neglect particle formation. In real atmosphere this would mean
5238	!-- that clusters form but coagulate to pre-existing particles who gain sulphate. Since
5239	!-- CoagS ~ CS (4piDCS'), we do not* update H2SO4 concentration here but let condensation take
5240	!-- care of it. Formation mass rate of molecules (molec/m3s) for 1: H2SO4 and 2: organic vapour
5241	pj3n3(1) = zj3 * n3 * pxsa
5242	pj3n3(2) = zj3 * n3 * pxocnv
5243
5244	END SUBROUTINE nucleation
5245
5246	!------------------------------------------------------------------------------!
5247	! Description:
5248	! ------------
5249	!> Calculate the nucleation rate and the size of critical clusters assuming
5250	!> binary nucleation.
5251	!> Parametrisation according to Vehkamaki et al. (2002), J. Geophys. Res.,
5252	!> 107(D22), 4622. Called from subroutine nucleation.
5253	!------------------------------------------------------------------------------!
5254	SUBROUTINE binnucl( pc_sa, ptemp, prh, pnuc_rate, pn_crit_sa, pn_crit_ocnv, pd_crit, pk_sa, &
5255	pk_ocnv )
5256
5257	IMPLICIT NONE
5258
5259	REAL(wp) :: za !<
5260	REAL(wp) :: zb !<
5261	REAL(wp) :: zc !<
5262	REAL(wp) :: zcoll !<
5263	REAL(wp) :: zlogsa !< LOG( zpcsa )
5264	REAL(wp) :: zlogrh !< LOG( zrh )
5265	REAL(wp) :: zm1 !<
5266	REAL(wp) :: zm2 !<
5267	REAL(wp) :: zma !<
5268	REAL(wp) :: zmw !<
5269	REAL(wp) :: zntot !< number of molecules in critical cluster
5270	REAL(wp) :: zpcsa !< sulfuric acid concentration
5271	REAL(wp) :: zrh !< relative humidity
5272	REAL(wp) :: zroo !<
5273	REAL(wp) :: zt !< temperature
5274	REAL(wp) :: zv1 !<
5275	REAL(wp) :: zv2 !<
5276	REAL(wp) :: zx !< mole fraction of sulphate in critical cluster
5277	REAL(wp) :: zxmass !<
5278
5279	REAL(wp), INTENT(in) :: pc_sa !< H2SO4 conc. (#/cm3)
5280	REAL(wp), INTENT(in) :: prh !< relative humidity [0-1
5281	REAL(wp), INTENT(in) :: ptemp !< ambient temperature (K)
5282
5283	REAL(wp), INTENT(out) :: pnuc_rate !< nucleation rate (#/(m3 s))
5284	REAL(wp), INTENT(out) :: pn_crit_sa !< number of H2SO4 molecules in cluster (#)
5285	REAL(wp), INTENT(out) :: pn_crit_ocnv !< number of organic molecules in cluster (#)
5286	REAL(wp), INTENT(out) :: pd_crit !< diameter of critical cluster (m)
5287	REAL(wp), INTENT(out) :: pk_sa !< Lever: if pk_sa = 1, H2SO4 is involved in nucleation.
5288	REAL(wp), INTENT(out) :: pk_ocnv !< Lever: if pk_ocnv = 1, organic compounds are involved
5289
5290	pnuc_rate = 0.0_wp
5291	pd_crit = 1.0E-9_wp
5292	!
5293	!-- 1) Checking that we are in the validity range of the parameterization
5294	zpcsa = MAX( pc_sa, 1.0E4_wp )
5295	zpcsa = MIN( zpcsa, 1.0E11_wp )
5296	zrh = MAX( prh, 0.0001_wp )
5297	zrh = MIN( zrh, 1.0_wp )
5298	zt = MAX( ptemp, 190.15_wp )
5299	zt = MIN( zt, 300.15_wp )
5300
5301	zlogsa = LOG( zpcsa )
5302	zlogrh = LOG( prh )
5303	!
5304	!-- 2) Mole fraction of sulphate in a critical cluster (Eq. 11)
5305	zx = 0.7409967177282139_wp - 0.002663785665140117_wp * zt + &
5306	0.002010478847383187_wp * zlogrh - 0.0001832894131464668_wp* zt * zlogrh + &
5307	0.001574072538464286_wp * zlogrh*2 - 0.00001790589121766952_wp zt * zlogrh**2 + &
5308	0.0001844027436573778_wp * zlogrh*3 - 1.503452308794887E-6_wp zt * zlogrh**3 - &
5309	0.003499978417957668_wp * zlogsa + 0.0000504021689382576_wp * zt * zlogsa
5310	!
5311	!-- 3) Nucleation rate (Eq. 12)
5312	pnuc_rate = 0.1430901615568665_wp + 2.219563673425199_wp * zt - &
5313	0.02739106114964264_wp * zt*2 + 0.00007228107239317088_wp zt**3 + &
5314	5.91822263375044_wp / zx + 0.1174886643003278_wp * zlogrh + &
5315	0.4625315047693772_wp * zt * zlogrh - 0.01180591129059253_wp * zt*2 zlogrh + &
5316	0.0000404196487152575_wp * zt*3 zlogrh + &
5317	( 15.79628615047088_wp * zlogrh ) / zx - 0.215553951893509_wp * zlogrh**2 - &
5318	0.0810269192332194_wp * zt * zlogrh**2 + &
5319	0.001435808434184642_wp * zt*2 zlogrh**2 - &
5320	4.775796947178588E-6_wp * zt*3 zlogrh**2 - &
5321	( 2.912974063702185_wp * zlogrh*2 ) / zx - 3.588557942822751_wp zlogrh**3 + &
5322	0.04950795302831703_wp * zt * zlogrh**3 - &
5323	0.0002138195118737068_wp * zt*2 zlogrh**3 + &
5324	3.108005107949533E-7_wp * zt*3 zlogrh**3 - &
5325	( 0.02933332747098296_wp * zlogrh*3 ) / zx + 1.145983818561277_wp zlogsa - &
5326	0.6007956227856778_wp * zt * zlogsa + 0.00864244733283759_wp * zt*2 zlogsa - &
5327	0.00002289467254710888_wp * zt*3 zlogsa - &
5328	( 8.44984513869014_wp * zlogsa ) / zx + 2.158548369286559_wp * zlogrh * zlogsa + &
5329	0.0808121412840917_wp * zt * zlogrh * zlogsa - &
5330	0.0004073815255395214_wp * zt*2 zlogrh * zlogsa - &
5331	4.019572560156515E-7_wp * zt*3 zlogrh * zlogsa + &
5332	( 0.7213255852557236_wp * zlogrh * zlogsa ) / zx + &
5333	1.62409850488771_wp * zlogrh*2 zlogsa - &
5334	0.01601062035325362_wp * zt * zlogrh*2 zlogsa + &
5335	0.00003771238979714162_wpzt2 zlogrh*2 zlogsa + &
5336	3.217942606371182E-8_wp * zt*3 zlogrh*2 zlogsa - &
5337	( 0.01132550810022116_wp * zlogrh*2 zlogsa ) / zx + &
5338	9.71681713056504_wp * zlogsa*2 - 0.1150478558347306_wp zt * zlogsa**2 + &
5339	0.0001570982486038294_wp * zt*2 zlogsa**2 + &
5340	4.009144680125015E-7_wp * zt*3 zlogsa**2 + &
5341	( 0.7118597859976135_wp * zlogsa**2 ) / zx - &
5342	1.056105824379897_wp * zlogrh * zlogsa**2 + &
5343	0.00903377584628419_wp * zt * zlogrh * zlogsa**2 - &
5344	0.00001984167387090606_wp * zt*2 zlogrh * zlogsa**2 + &
5345	2.460478196482179E-8_wp * zt*3 zlogrh * zlogsa**2 - &
5346	( 0.05790872906645181_wp * zlogrh * zlogsa**2 ) / zx - &
5347	0.1487119673397459_wp * zlogsa*3 + 0.002835082097822667_wp zt * zlogsa**3 - &
5348	9.24618825471694E-6_wp * zt*2 zlogsa**3 + &
5349	5.004267665960894E-9_wp * zt*3 zlogsa**3 - &
5350	( 0.01270805101481648_wp * zlogsa**3 ) / zx
5351	!
5352	!-- Nucleation rate in #/(cm3 s)
5353	pnuc_rate = EXP( pnuc_rate )
5354	!
5355	!-- Check the validity of parameterization
5356	IF ( pnuc_rate < 1.0E-7_wp ) THEN
5357	pnuc_rate = 0.0_wp
5358	pd_crit = 1.0E-9_wp
5359	ENDIF
5360	!
5361	!-- 4) Total number of molecules in the critical cluster (Eq. 13)
5362	zntot = - 0.002954125078716302_wp - 0.0976834264241286_wp * zt + &
5363	0.001024847927067835_wp * zt*2 - 2.186459697726116E-6_wp zt**3 - &
5364	0.1017165718716887_wp / zx - 0.002050640345231486_wp * zlogrh - &
5365	0.007585041382707174_wp * zt * zlogrh + 0.0001926539658089536_wp * zt*2 zlogrh - &
5366	6.70429719683894E-7_wp * zt*3 zlogrh - ( 0.2557744774673163_wp * zlogrh ) / zx + &
5367	0.003223076552477191_wp * zlogrh*2 + 0.000852636632240633_wp zt * zlogrh**2 - &
5368	0.00001547571354871789_wp * zt*2 zlogrh**2 + &
5369	5.666608424980593E-8_wp * zt*3 zlogrh**2 + &
5370	( 0.03384437400744206_wp * zlogrh**2 ) / zx + &
5371	0.04743226764572505_wp * zlogrh*3 - 0.0006251042204583412_wp zt * zlogrh**3 + &
5372	2.650663328519478E-6_wp * zt*2 zlogrh**3 - &
5373	3.674710848763778E-9_wp * zt*3 zlogrh**3 - &
5374	( 0.0002672510825259393_wp * zlogrh*3 ) / zx - 0.01252108546759328_wp zlogsa + &
5375	0.005806550506277202_wp * zt * zlogsa - 0.0001016735312443444_wp * zt*2 zlogsa + &
5376	2.881946187214505E-7_wp * zt*3 zlogsa + ( 0.0942243379396279_wp * zlogsa ) / zx - &
5377	0.0385459592773097_wp * zlogrh * zlogsa - &
5378	0.0006723156277391984_wp * zt * zlogrh * zlogsa + &
5379	2.602884877659698E-6_wp * zt*2 zlogrh * zlogsa + &
5380	1.194163699688297E-8_wp * zt*3 zlogrh * zlogsa - &
5381	( 0.00851515345806281_wp * zlogrh * zlogsa ) / zx - &
5382	0.01837488495738111_wp * zlogrh*2 zlogsa + &
5383	0.0001720723574407498_wp * zt * zlogrh*2 zlogsa - &
5384	3.717657974086814E-7_wp * zt*2 zlogrh*2 zlogsa - &
5385	5.148746022615196E-10_wp * zt*3 zlogrh*2 zlogsa + &
5386	( 0.0002686602132926594_wp * zlogrh*2 zlogsa ) / zx - &
5387	0.06199739728812199_wp * zlogsa*2 + 0.000906958053583576_wp zt * zlogsa**2 - &
5388	9.11727926129757E-7_wp * zt*2 zlogsa**2 - &
5389	5.367963396508457E-9_wp * zt*3 zlogsa**2 - &
5390	( 0.007742343393937707_wp * zlogsa**2 ) / zx + &
5391	0.0121827103101659_wp * zlogrh * zlogsa**2 - &
5392	0.0001066499571188091_wp * zt * zlogrh * zlogsa**2 + &
5393	2.534598655067518E-7_wp * zt*2 zlogrh * zlogsa**2 - &
5394	3.635186504599571E-10_wp * zt*3 zlogrh * zlogsa**2 + &
5395	( 0.0006100650851863252_wp * zlogrh * zlogsa **2 ) / zx + &
5396	0.0003201836700403512_wp * zlogsa*3 - 0.0000174761713262546_wp zt * zlogsa**3 + &
5397	6.065037668052182E-8_wp * zt*2 zlogsa**3 - &
5398	1.421771723004557E-11_wp * zt*3 zlogsa**3 + &
5399	( 0.0001357509859501723_wp * zlogsa**3 ) / zx
5400	zntot = EXP( zntot ) ! in #
5401	!
5402	!-- 5) Size of the critical cluster pd_crit (m) (diameter) (Eq. 14)
5403	pn_crit_sa = zx * zntot
5404	pd_crit = 2.0E-9_wp * EXP( -1.6524245_wp + 0.42316402_wp * zx + 0.33466487_wp * LOG( zntot ) )
5405	!
5406	!-- 6) Organic compounds not involved when binary nucleation is assumed
5407	pn_crit_ocnv = 0.0_wp ! number of organic molecules
5408	pk_sa = 1.0_wp ! if = 1, H2SO4 involved in nucleation
5409	pk_ocnv = 0.0_wp ! if = 1, organic compounds involved
5410	!
5411	!-- Set nucleation rate to collision rate
5412	IF ( pn_crit_sa < 4.0_wp ) THEN
5413	!
5414	!-- Volumes of the colliding objects
5415	zma = 96.0_wp ! molar mass of SO4 in g/mol
5416	zmw = 18.0_wp ! molar mass of water in g/mol
5417	zxmass = 1.0_wp ! mass fraction of H2SO4
5418	za = 0.7681724_wp + zxmass * ( 2.1847140_wp + zxmass * &
5419	( 7.1630022_wp + zxmass * &
5420	( -44.31447_wp + zxmass * &
5421	( 88.75606 + zxmass * &
5422	( -75.73729_wp + zxmass * 23.43228_wp ) ) ) ) )
5423	zb = 1.808225E-3_wp + zxmass * ( -9.294656E-3_wp + zxmass * &
5424	( -0.03742148_wp + zxmass * &
5425	( 0.2565321_wp + zxmass * &
5426	( -0.5362872_wp + zxmass * &
5427	( 0.4857736 - zxmass * 0.1629592_wp ) ) ) ) )
5428	zc = - 3.478524E-6_wp + zxmass * ( 1.335867E-5_wp + zxmass * &
5429	( 5.195706E-5_wp + zxmass * &
5430	( -3.717636E-4_wp + zxmass * &
5431	( 7.990811E-4_wp + zxmass * &
5432	( -7.458060E-4_wp + zxmass * 2.58139E-4_wp ) ) ) ) )
5433	!
5434	!-- Density for the sulphuric acid solution (Eq. 10 in Vehkamaki)
5435	zroo = ( za + zt * ( zb + zc * zt ) ) * 1.0E+3_wp ! (kg/m^3
5436	zm1 = 0.098_wp ! molar mass of H2SO4 in kg/mol
5437	zm2 = zm1
5438	zv1 = zm1 / avo / zroo ! volume
5439	zv2 = zv1
5440	!
5441	!-- Collision rate
5442	zcoll = zpcsa * zpcsa * ( 3.0_wp * pi / 4.0_wp )*0.16666666_wp &
5443	SQRT( 6.0_wp * argas * zt / zm1 + 6.0_wp * argas * zt / zm2 ) * &
5444	( zv10.33333333_wp + zv20.33333333_wp )*2 1.0E+6_wp ! m3 -> cm3
5445	zcoll = MIN( zcoll, 1.0E+10_wp )
5446	pnuc_rate = zcoll ! (#/(cm3 s))
5447
5448	ELSE
5449	pnuc_rate = MIN( pnuc_rate, 1.0E+10_wp )
5450	ENDIF
5451	pnuc_rate = pnuc_rate * 1.0E+6_wp ! (#/(m3 s))
5452
5453	END SUBROUTINE binnucl
5454
5455	!------------------------------------------------------------------------------!
5456	! Description:
5457	! ------------
5458	!> Calculate the nucleation rate and the size of critical clusters assuming
5459	!> ternary nucleation. Parametrisation according to:
5460	!> Napari et al. (2002), J. Chem. Phys., 116, 4221-4227 and
5461	!> Napari et al. (2002), J. Geophys. Res., 107(D19), AAC 6-1-ACC 6-6.
5462	!------------------------------------------------------------------------------!
5463	SUBROUTINE ternucl( pc_sa, pc_nh3, ptemp, prh, pnuc_rate, pn_crit_sa, pn_crit_ocnv, pd_crit, &
5464	pk_sa, pk_ocnv )
5465
5466	IMPLICIT NONE
5467
5468	REAL(wp) :: zlnj !< logarithm of nucleation rate
5469	REAL(wp) :: zlognh3 !< LOG( pc_nh3 )
5470	REAL(wp) :: zlogrh !< LOG( prh )
5471	REAL(wp) :: zlogsa !< LOG( pc_sa )
5472
5473	REAL(wp), INTENT(in) :: pc_nh3 !< ammonia mixing ratio (ppt)
5474	REAL(wp), INTENT(in) :: pc_sa !< H2SO4 conc. (#/cm3)
5475	REAL(wp), INTENT(in) :: prh !< relative humidity [0-1]
5476	REAL(wp), INTENT(in) :: ptemp !< ambient temperature (K)
5477
5478	REAL(wp), INTENT(out) :: pd_crit !< diameter of critical cluster (m)
5479	REAL(wp), INTENT(out) :: pk_ocnv !< if pk_ocnv = 1, organic compounds participate in nucleation
5480	REAL(wp), INTENT(out) :: pk_sa !< if pk_sa = 1, H2SO4 participate in nucleation
5481	REAL(wp), INTENT(out) :: pn_crit_ocnv !< number of organic molecules in cluster (#)
5482	REAL(wp), INTENT(out) :: pn_crit_sa !< number of H2SO4 molecules in cluster (#)
5483	REAL(wp), INTENT(out) :: pnuc_rate !< nucleation rate (#/(m3 s))
5484	!
5485	!-- 1) Checking that we are in the validity range of the parameterization.
5486	!-- Validity of parameterization : DO NOT REMOVE!
5487	IF ( ptemp < 240.0_wp .OR. ptemp > 300.0_wp ) THEN
5488	message_string = 'Invalid input value: ptemp'
5489	CALL message( 'salsa_mod: ternucl', 'PA0648', 1, 2, 0, 6, 0 )
5490	ENDIF
5491	IF ( prh < 0.05_wp .OR. prh > 0.95_wp ) THEN
5492	message_string = 'Invalid input value: prh'
5493	CALL message( 'salsa_mod: ternucl', 'PA0649', 1, 2, 0, 6, 0 )
5494	ENDIF
5495	IF ( pc_sa < 1.0E+4_wp .OR. pc_sa > 1.0E+9_wp ) THEN
5496	message_string = 'Invalid input value: pc_sa'
5497	CALL message( 'salsa_mod: ternucl', 'PA0650', 1, 2, 0, 6, 0 )
5498	ENDIF
5499	IF ( pc_nh3 < 0.1_wp .OR. pc_nh3 > 100.0_wp ) THEN
5500	message_string = 'Invalid input value: pc_nh3'
5501	CALL message( 'salsa_mod: ternucl', 'PA0651', 1, 2, 0, 6, 0 )
5502	ENDIF
5503
5504	zlognh3 = LOG( pc_nh3 )
5505	zlogrh = LOG( prh )
5506	zlogsa = LOG( pc_sa )
5507	!
5508	!-- 2) Nucleation rate (Eq. 7 in Napari et al., 2002: Parameterization of
5509	!-- ternary nucleation of sulfuric acid - ammonia - water.
5510	zlnj = - 84.7551114741543_wp + 0.3117595133628944_wp * prh + &
5511	1.640089605712946_wp * prh * ptemp - 0.003438516933381083_wp * prh * ptemp**2 - &
5512	0.00001097530402419113_wp * prh * ptemp**3 - 0.3552967070274677_wp / zlogsa - &
5513	( 0.06651397829765026_wp * prh ) / zlogsa - ( 33.84493989762471_wp * ptemp ) / zlogsa - &
5514	( 7.823815852128623_wp * prh * ptemp ) / zlogsa + &
5515	( 0.3453602302090915_wp * ptemp**2 ) / zlogsa + &
5516	( 0.01229375748100015_wp * prh * ptemp**2 ) / zlogsa - &
5517	( 0.000824007160514956_wp ptemp*3 ) / zlogsa + &
5518	( 0.00006185539100670249_wp * prh * ptemp**3 ) / zlogsa + &
5519	3.137345238574998_wp * zlogsa + 3.680240980277051_wp * prh * zlogsa - &
5520	0.7728606202085936_wp * ptemp * zlogsa - 0.204098217156962_wp * prh * ptemp * zlogsa + &
5521	0.005612037586790018_wp * ptemp*2 zlogsa + &
5522	0.001062588391907444_wp * prh * ptemp*2 zlogsa - &
5523	9.74575691760229E-6_wp * ptemp*3 zlogsa - &
5524	1.265595265137352E-6_wp * prh * ptemp*3 zlogsa + 19.03593713032114_wp * zlogsa**2 - &
5525	0.1709570721236754_wp * ptemp * zlogsa**2 + &
5526	0.000479808018162089_wp * ptemp*2 zlogsa**2 - &
5527	4.146989369117246E-7_wp * ptemp*3 zlogsa*2 + 1.076046750412183_wp zlognh3 + &
5528	0.6587399318567337_wp * prh * zlognh3 + 1.48932164750748_wp * ptemp * zlognh3 + &
5529	0.1905424394695381_wp * prh * ptemp * zlognh3 - &
5530	0.007960522921316015_wp * ptemp*2 zlognh3 - &
5531	0.001657184248661241_wp * prh * ptemp*2 zlognh3 + &
5532	7.612287245047392E-6_wp * ptemp*3 zlognh3 + &
5533	3.417436525881869E-6_wp * prh * ptemp*3 zlognh3 + &
5534	( 0.1655358260404061_wp * zlognh3 ) / zlogsa + &
5535	( 0.05301667612522116_wp * prh * zlognh3 ) / zlogsa + &
5536	( 3.26622914116752_wp * ptemp * zlognh3 ) / zlogsa - &
5537	( 1.988145079742164_wp * prh * ptemp * zlognh3 ) / zlogsa - &
5538	( 0.04897027401984064_wp * ptemp*2 zlognh3 ) / zlogsa + &
5539	( 0.01578269253599732_wp * prh * ptemp*2 zlognh3 ) / zlogsa + &
5540	( 0.0001469672236351303_wp * ptemp*3 zlognh3 ) / zlogsa - &
5541	( 0.00002935642836387197_wp * prh * ptemp*3 zlognh3 ) / zlogsa + &
5542	6.526451177887659_wp * zlogsa * zlognh3 - &
5543	0.2580021816722099_wp * ptemp * zlogsa * zlognh3 + &
5544	0.001434563104474292_wp * ptemp*2 zlogsa * zlognh3 - &
5545	2.020361939304473E-6_wp * ptemp*3 zlogsa * zlognh3 - &
5546	0.160335824596627_wp * zlogsa*2 zlognh3 + &
5547	0.00889880721460806_wp * ptemp * zlogsa*2 zlognh3 - &
5548	0.00005395139051155007_wp * ptemp*2 zlogsa*2 zlognh3 + &
5549	8.39521718689596E-8_wp * ptemp*3 zlogsa*2 zlognh3 + &
5550	6.091597586754857_wp * zlognh3*2 + 8.5786763679309_wp prh * zlognh3**2 - &
5551	1.253783854872055_wp * ptemp * zlognh3**2 - &
5552	0.1123577232346848_wp * prh * ptemp * zlognh3**2 + &
5553	0.00939835595219825_wp * ptemp*2 zlognh3**2 + &
5554	0.0004726256283031513_wp * prh * ptemp*2 zlognh3**2 - &
5555	0.00001749269360523252_wp * ptemp*3 zlognh3**2 - &
5556	6.483647863710339E-7_wp * prh * ptemp*3 zlognh3**2 + &
5557	( 0.7284285726576598_wp * zlognh3**2 ) / zlogsa + &
5558	( 3.647355600846383_wp * ptemp * zlognh3**2 ) / zlogsa - &
5559	( 0.02742195276078021_wp * ptemp*2 zlognh3**2 ) / zlogsa + &
5560	( 0.00004934777934047135_wp * ptemp*3 zlognh3**2 ) / zlogsa + &
5561	41.30162491567873_wp * zlogsa * zlognh3**2 - &
5562	0.357520416800604_wp * ptemp * zlogsa * zlognh3**2 + &
5563	0.000904383005178356_wp * ptemp*2 zlogsa * zlognh3**2 - &
5564	5.737876676408978E-7_wp * ptemp*3 zlogsa * zlognh3**2 - &
5565	2.327363918851818_wp * zlogsa*2 zlognh3**2 + &
5566	0.02346464261919324_wp * ptemp * zlogsa*2 zlognh3**2 - &
5567	0.000076518969516405_wp * ptemp*2 zlogsa*2 zlognh3**2 + &
5568	8.04589834836395E-8_wp * ptemp*3 zlogsa*2 zlognh3**2 - &
5569	0.02007379204248076_wp * zlogrh - 0.7521152446208771_wp * ptemp * zlogrh + &
5570	0.005258130151226247_wp * ptemp*2 zlogrh - &
5571	8.98037634284419E-6_wp * ptemp*3 zlogrh + &
5572	( 0.05993213079516759_wp * zlogrh ) / zlogsa + &
5573	( 5.964746463184173_wp * ptemp * zlogrh ) / zlogsa - &
5574	( 0.03624322255690942_wp * ptemp*2 zlogrh ) / zlogsa + &
5575	( 0.00004933369382462509_wp * ptemp*3 zlogrh ) / zlogsa - &
5576	0.7327310805365114_wp * zlognh3 * zlogrh - &
5577	0.01841792282958795_wp * ptemp * zlognh3 * zlogrh + &
5578	0.0001471855981005184_wp * ptemp*2 zlognh3 * zlogrh - &
5579	2.377113195631848E-7_wp * ptemp*3 zlognh3 * zlogrh
5580	pnuc_rate = EXP( zlnj ) ! (#/(cm3 s))
5581	!
5582	!-- Check validity of parametrization
5583	IF ( pnuc_rate < 1.0E-5_wp ) THEN
5584	pnuc_rate = 0.0_wp
5585	pd_crit = 1.0E-9_wp
5586	ELSEIF ( pnuc_rate > 1.0E6_wp ) THEN
5587	message_string = 'Invalid output value: nucleation rate > 10^6 1/cm3s'
5588	CALL message( 'salsa_mod: ternucl', 'PA0623', 1, 2, 0, 6, 0 )
5589	ENDIF
5590	pnuc_rate = pnuc_rate * 1.0E6_wp ! (#/(m3 s))
5591	!
5592	!-- 3) Number of H2SO4 molecules in a critical cluster (Eq. 9)
5593	pn_crit_sa = 38.16448247950508_wp + 0.7741058259731187_wp * zlnj + &
5594	0.002988789927230632_wp * zlnj*2 - 0.3576046920535017_wp ptemp - &
5595	0.003663583011953248_wp * zlnj * ptemp + 0.000855300153372776_wp * ptemp**2
5596	!
5597	!-- Kinetic limit: at least 2 H2SO4 molecules in a cluster
5598	pn_crit_sa = MAX( pn_crit_sa, 2.0E0_wp )
5599	!
5600	!-- 4) Size of the critical cluster in nm (Eq. 12)
5601	pd_crit = 0.1410271086638381_wp - 0.001226253898894878_wp * zlnj - &
5602	7.822111731550752E-6_wp * zlnj*2 - 0.001567273351921166_wp ptemp - &
5603	0.00003075996088273962_wp * zlnj * ptemp + 0.00001083754117202233_wp * ptemp**2
5604	pd_crit = pd_crit * 2.0E-9_wp ! Diameter in m
5605	!
5606	!-- 5) Organic compounds not involved when ternary nucleation assumed
5607	pn_crit_ocnv = 0.0_wp
5608	pk_sa = 1.0_wp
5609	pk_ocnv = 0.0_wp
5610
5611	END SUBROUTINE ternucl
5612
5613	!------------------------------------------------------------------------------!
5614	! Description:
5615	! ------------
5616	!> Function z_n_nuc_tayl is connected to the calculation of self-coagualtion of
5617	!> small particles. It calculates number of the particles in the size range
5618	!> [zdcrit,dx] using Taylor-expansion (please note that the expansion is not
5619	!> valid for certain rational numbers, e.g. -4/3 and -3/2)
5620	!------------------------------------------------------------------------------!
5621	FUNCTION z_n_nuc_tayl( d1, dx, zm_para, zjnuc_t, zeta, z_gr_tot )
5622
5623	IMPLICIT NONE
5624
5625	INTEGER(iwp) :: i !< running index
5626
5627	REAL(wp) :: d1 !< lower diameter limit
5628	REAL(wp) :: dx !< upper diameter limit
5629	REAL(wp) :: zjnuc_t !< initial nucleation rate (1/s)
5630	REAL(wp) :: zeta !< ratio of CS/GR (m) (condensation sink / growth rate)
5631	REAL(wp) :: term1 !<
5632	REAL(wp) :: term2 !<
5633	REAL(wp) :: term3 !<
5634	REAL(wp) :: term4 !<
5635	REAL(wp) :: term5 !<
5636	REAL(wp) :: z_n_nuc_tayl !< final nucleation rate (1/s)
5637	REAL(wp) :: z_gr_tot !< total growth rate (nm/h)
5638	REAL(wp) :: zm_para !< m parameter in Lehtinen et al. (2007), Eq. 6
5639
5640	z_n_nuc_tayl = 0.0_wp
5641
5642	DO i = 0, 29
5643	IF ( i == 0 .OR. i == 1 ) THEN
5644	term1 = 1.0_wp
5645	ELSE
5646	term1 = term1 * REAL( i, SELECTED_REAL_KIND(12,307) )
5647	END IF
5648	term2 = ( REAL( i, SELECTED_REAL_KIND(12,307) ) * ( zm_para + 1.0_wp ) + 1.0_wp ) * term1
5649	term3 = zeta**i
5650	term4 = term3 / term2
5651	term5 = REAL( i, SELECTED_REAL_KIND(12,307) ) * ( zm_para + 1.0_wp ) + 1.0_wp
5652	z_n_nuc_tayl = z_n_nuc_tayl + term4 * ( dxterm5 - d1term5 )
5653	ENDDO
5654	z_n_nuc_tayl = z_n_nuc_tayl * zjnuc_t * EXP( -zeta * ( d1**( zm_para + 1 ) ) ) / z_gr_tot
5655
5656	END FUNCTION z_n_nuc_tayl
5657
5658	!------------------------------------------------------------------------------!
5659	! Description:
5660	! ------------
5661	!> Calculates the condensation of water vapour on aerosol particles. Follows the
5662	!> analytical predictor method by Jacobson (2005).
5663	!> For equations, see Jacobson (2005), Fundamentals of atmospheric modelling
5664	!> (2nd edition).
5665	!------------------------------------------------------------------------------!
5666	SUBROUTINE gpparth2o( paero, ptemp, ppres, pcs, pcw, ptstep )
5667
5668	IMPLICIT NONE
5669
5670	INTEGER(iwp) :: ib !< loop index
5671	INTEGER(iwp) :: nstr !<
5672
5673	REAL(wp) :: adt !< internal timestep in this subroutine
5674	REAL(wp) :: rhoair !< air density (kg/m3)
5675	REAL(wp) :: ttot !< total time (s)
5676	REAL(wp) :: zact !< Water activity
5677	REAL(wp) :: zaelwc1 !< Current aerosol water content (kg/m3)
5678	REAL(wp) :: zaelwc2 !< New aerosol water content after equilibrium calculation (kg/m3)
5679	REAL(wp) :: zbeta !< Transitional correction factor
5680	REAL(wp) :: zcwc !< Current water vapour mole concentration in aerosols (mol/m3)
5681	REAL(wp) :: zcwint !< Current and new water vapour mole concentrations (mol/m3)
5682	REAL(wp) :: zcwn !< New water vapour mole concentration (mol/m3)
5683	REAL(wp) :: zcwtot !< Total water mole concentration (mol/m3)
5684	REAL(wp) :: zdfh2o !< molecular diffusion coefficient (cm2/s) for water
5685	REAL(wp) :: zhlp1 !< intermediate variable to calculate the mass transfer coefficient
5686	REAL(wp) :: zhlp2 !< intermediate variable to calculate the mass transfer coefficient
5687	REAL(wp) :: zhlp3 !< intermediate variable to calculate the mass transfer coefficient
5688	REAL(wp) :: zknud !< Knudsen number
5689	REAL(wp) :: zmfph2o !< mean free path of H2O gas molecule
5690	REAL(wp) :: zrh !< relative humidity [0-1]
5691	REAL(wp) :: zthcond !< thermal conductivity of air (W/m/K)
5692
5693	REAL(wp), DIMENSION(nbins_aerosol) :: zcwcae !< Current water mole concentrations
5694	REAL(wp), DIMENSION(nbins_aerosol) :: zcwintae !< Current and new aerosol water mole concentration
5695	REAL(wp), DIMENSION(nbins_aerosol) :: zcwnae !< New water mole concentration in aerosols
5696	REAL(wp), DIMENSION(nbins_aerosol) :: zcwsurfae !< Surface mole concentration
5697	REAL(wp), DIMENSION(nbins_aerosol) :: zkelvin !< Kelvin effect
5698	REAL(wp), DIMENSION(nbins_aerosol) :: zmtae !< Mass transfer coefficients
5699	REAL(wp), DIMENSION(nbins_aerosol) :: zwsatae !< Water saturation ratio above aerosols
5700
5701	REAL(wp), INTENT(in) :: ppres !< Air pressure (Pa)
5702	REAL(wp), INTENT(in) :: pcs !< Water vapour saturation concentration (kg/m3)
5703	REAL(wp), INTENT(in) :: ptemp !< Ambient temperature (K)
5704	REAL(wp), INTENT(in) :: ptstep !< timestep (s)
5705
5706	REAL(wp), INTENT(inout) :: pcw !< Water vapour concentration (kg/m3)
5707
5708	TYPE(t_section), DIMENSION(nbins_aerosol), INTENT(inout) :: paero !< Aerosol properties
5709	!
5710	!-- Relative humidity [0-1]
5711	zrh = pcw / pcs
5712	!
5713	!-- Calculate the condensation only for 2a/2b aerosol bins
5714	nstr = start_subrange_2a
5715	!
5716	!-- Save the current aerosol water content, 8 in paero is H2O
5717	zaelwc1 = SUM( paero(start_subrange_1a:end_subrange_2b)%volc(8) ) * arhoh2o
5718	!
5719	!-- Equilibration:
5720	IF ( advect_particle_water ) THEN
5721	IF ( zrh < 0.98_wp .OR. .NOT. lscndh2oae ) THEN
5722	CALL equilibration( zrh, ptemp, paero, .TRUE. )
5723	ELSE
5724	CALL equilibration( zrh, ptemp, paero, .FALSE. )
5725	ENDIF
5726	ENDIF
5727	!
5728	!-- The new aerosol water content after equilibrium calculation
5729	zaelwc2 = SUM( paero(start_subrange_1a:end_subrange_2b)%volc(8) ) * arhoh2o
5730	!
5731	!-- New water vapour mixing ratio (kg/m3)
5732	pcw = pcw - ( zaelwc2 - zaelwc1 ) * ppres * amdair / ( argas * ptemp )
5733	!
5734	!-- Initialise variables
5735	zcwsurfae(:) = 0.0_wp
5736	zhlp1 = 0.0_wp
5737	zhlp2 = 0.0_wp
5738	zhlp3 = 0.0_wp
5739	zmtae(:) = 0.0_wp
5740	zwsatae(:) = 0.0_wp
5741	!
5742	!-- Air:
5743	!-- Density (kg/m3)
5744	rhoair = amdair * ppres / ( argas * ptemp )
5745	!
5746	!-- Thermal conductivity of air
5747	zthcond = 0.023807_wp + 7.1128E-5_wp * ( ptemp - 273.16_wp )
5748	!
5749	!-- Water vapour:
5750	!-- Molecular diffusion coefficient (cm2/s) (eq.16.17)
5751	zdfh2o = ( 5.0_wp / ( 16.0_wp * avo * rhoair * 1.0E-3_wp * 3.11E-8_wp*2 ) ) SQRT( argas * &
5752	1.0E+7_wp * ptemp * amdair * 1.0E+3_wp * ( amh2o + amdair ) * 1.0E+3_wp / &
5753	( pi * amh2o * 2.0E+3_wp ) )
5754	zdfh2o = zdfh2o * 1.0E-4 ! Unit change to m^2/s
5755	!
5756	!-- Mean free path (eq. 15.25 & 16.29)
5757	zmfph2o = 3.0_wp * zdfh2o * SQRT( pi * amh2o / ( 8.0_wp * argas * ptemp ) )
5758	!
5759	!-- Kelvin effect (eq. 16.33)
5760	zkelvin(:) = EXP( 4.0_wp * surfw0 * amh2o / ( argas * ptemp * arhoh2o * paero(:)%dwet) )
5761
5762	DO ib = 1, nbins_aerosol
5763	IF ( paero(ib)%numc > nclim .AND. zrh > 0.98_wp ) THEN
5764	!
5765	!-- Water activity
5766	zact = acth2o( paero(ib) )
5767	!
5768	!-- Saturation mole concentration over flat surface. Limit the super-
5769	!-- saturation to max 1.01 for the mass transfer. Experimental!
5770	zcwsurfae(ib) = MAX( pcs, pcw / 1.01_wp ) * rhoair / amh2o
5771	!
5772	!-- Equilibrium saturation ratio
5773	zwsatae(ib) = zact * zkelvin(ib)
5774	!
5775	!-- Knudsen number (eq. 16.20)
5776	zknud = 2.0_wp * zmfph2o / paero(ib)%dwet
5777	!
5778	!-- Transitional correction factor (Fuks & Sutugin, 1971)
5779	zbeta = ( zknud + 1.0_wp ) / ( 0.377_wp * zknud + 1.0_wp + 4.0_wp / &
5780	( 3.0_wp * massacc(ib) ) * ( zknud + zknud**2 ) )
5781	!
5782	!-- Mass transfer of H2O: Eq. 16.64 but here D^eff = zdfh2o * zbeta
5783	zhlp1 = paero(ib)%numc * 2.0_wp * pi * paero(ib)%dwet * zdfh2o * zbeta
5784	!
5785	!-- 1st term on the left side of the denominator in eq. 16.55
5786	zhlp2 = amh2o * zdfh2o * alv * zwsatae(ib) * zcwsurfae(ib) / ( zthcond * ptemp )
5787	!
5788	!-- 2nd term on the left side of the denominator in eq. 16.55
5789	zhlp3 = ( ( alv * amh2o ) / ( argas * ptemp ) ) - 1.0_wp
5790	!
5791	!-- Full eq. 16.64: Mass transfer coefficient (1/s)
5792	zmtae(ib) = zhlp1 / ( zhlp2 * zhlp3 + 1.0_wp )
5793	ENDIF
5794	ENDDO
5795	!
5796	!-- Current mole concentrations of water
5797	zcwc = pcw * rhoair / amh2o ! as vapour
5798	zcwcae(:) = paero(:)%volc(8) * arhoh2o / amh2o ! in aerosols
5799	zcwtot = zcwc + SUM( zcwcae ) ! total water concentration
5800	zcwnae(:) = 0.0_wp
5801	zcwintae(:) = zcwcae(:)
5802	!
5803	!-- Substepping loop
5804	zcwint = 0.0_wp
5805	ttot = 0.0_wp
5806	DO WHILE ( ttot < ptstep )
5807	adt = 2.0E-2_wp ! internal timestep
5808	!
5809	!-- New vapour concentration: (eq. 16.71)
5810	zhlp1 = zcwc + adt * ( SUM( zmtae(nstr:nbins_aerosol) * zwsatae(nstr:nbins_aerosol) * &
5811	zcwsurfae(nstr:nbins_aerosol) ) ) ! numerator
5812	zhlp2 = 1.0_wp + adt * ( SUM( zmtae(nstr:nbins_aerosol) ) ) ! denomin.
5813	zcwint = zhlp1 / zhlp2 ! new vapour concentration
5814	zcwint = MIN( zcwint, zcwtot )
5815	IF ( ANY( paero(:)%numc > nclim ) .AND. zrh > 0.98_wp ) THEN
5816	DO ib = nstr, nbins_aerosol
5817	zcwintae(ib) = zcwcae(ib) + MIN( MAX( adt * zmtae(ib) * ( zcwint - zwsatae(ib) * &
5818	zcwsurfae(ib) ), -0.02_wp * zcwcae(ib) ), &
5819	0.05_wp * zcwcae(ib) )
5820	zwsatae(ib) = acth2o( paero(ib), zcwintae(ib) ) * zkelvin(ib)
5821	ENDDO
5822	ENDIF
5823	zcwintae(nstr:nbins_aerosol) = MAX( zcwintae(nstr:nbins_aerosol), 0.0_wp )
5824	!
5825	!-- Update vapour concentration for consistency
5826	zcwint = zcwtot - SUM( zcwintae(1:nbins_aerosol) )
5827	!
5828	!-- Update "old" values for next cycle
5829	zcwcae = zcwintae
5830
5831	ttot = ttot + adt
5832
5833	ENDDO ! ADT
5834
5835	zcwn = zcwint
5836	zcwnae(:) = zcwintae(:)
5837	pcw = zcwn * amh2o / rhoair
5838	paero(:)%volc(8) = MAX( 0.0_wp, zcwnae(:) * amh2o / arhoh2o )
5839
5840	END SUBROUTINE gpparth2o
5841
5842	!------------------------------------------------------------------------------!
5843	! Description:
5844	! ------------
5845	!> Calculates the activity coefficient of liquid water
5846	!------------------------------------------------------------------------------!
5847	REAL(wp) FUNCTION acth2o( ppart, pcw )
5848
5849	IMPLICIT NONE
5850
5851	REAL(wp) :: zns !< molar concentration of solutes (mol/m3)
5852	REAL(wp) :: znw !< molar concentration of water (mol/m3)
5853
5854	REAL(wp), INTENT(in), OPTIONAL :: pcw !< molar concentration of water (mol/m3)
5855
5856	TYPE(t_section), INTENT(in) :: ppart !< Aerosol properties of a bin
5857
5858	zns = ( 3.0_wp * ( ppart%volc(1) * arhoh2so4 / amh2so4 ) + ( ppart%volc(2) * arhooc / amoc ) + &
5859	2.0_wp * ( ppart%volc(5) * arhoss / amss ) + ( ppart%volc(6) * arhohno3 / amhno3 ) + &
5860	( ppart%volc(7) * arhonh3 / amnh3 ) )
5861
5862	IF ( PRESENT(pcw) ) THEN
5863	znw = pcw
5864	ELSE
5865	znw = ppart%volc(8) * arhoh2o / amh2o
5866	ENDIF
5867	!
5868	!-- Activity = partial pressure of water vapour / sat. vapour pressure of water over a liquid surface
5869	!-- = molality * activity coefficient (Jacobson, 2005: eq. 17.20-21)
5870	!-- Assume activity coefficient of 1 for water
5871	acth2o = MAX( 0.1_wp, znw / MAX( EPSILON( 1.0_wp ),( znw + zns ) ) )
5872
5873	END FUNCTION acth2o
5874
5875	!------------------------------------------------------------------------------!
5876	! Description:
5877	! ------------
5878	!> Calculates the dissolutional growth of particles (i.e. gas transfers to a
5879	!> particle surface and dissolves in liquid water on the surface). Treated here
5880	!> as a non-equilibrium (time-dependent) process. Gases: HNO3 and NH3
5881	!> (Chapter 17.14 in Jacobson, 2005).
5882	!
5883	!> Called from subroutine condensation.
5884	!> Coded by:
5885	!> Harri Kokkola (FMI)
5886	!------------------------------------------------------------------------------!
5887	SUBROUTINE gpparthno3( ppres, ptemp, paero, pghno3, pgnh3, pcw, pcs, pbeta, ptstep )
5888
5889	IMPLICIT NONE
5890
5891	INTEGER(iwp) :: ib !< loop index
5892
5893	REAL(wp) :: adt !< timestep
5894	REAL(wp) :: zc_nh3_c !< Current NH3 gas concentration
5895	REAL(wp) :: zc_nh3_int !< Intermediate NH3 gas concentration
5896	REAL(wp) :: zc_nh3_n !< New NH3 gas concentration
5897	REAL(wp) :: zc_nh3_tot !< Total NH3 concentration
5898	REAL(wp) :: zc_hno3_c !< Current HNO3 gas concentration
5899	REAL(wp) :: zc_hno3_int !< Intermediate HNO3 gas concentration
5900	REAL(wp) :: zc_hno3_n !< New HNO3 gas concentration
5901	REAL(wp) :: zc_hno3_tot !< Total HNO3 concentration
5902	REAL(wp) :: zdfvap !< Diffusion coefficient for vapors
5903	REAL(wp) :: zhlp1 !< intermediate variable
5904	REAL(wp) :: zhlp2 !< intermediate variable
5905	REAL(wp) :: zrh !< relative humidity
5906
5907	REAL(wp), INTENT(in) :: ppres !< ambient pressure (Pa)
5908	REAL(wp), INTENT(in) :: pcs !< water vapour saturation
5909	!< concentration (kg/m3)
5910	REAL(wp), INTENT(in) :: ptemp !< ambient temperature (K)
5911	REAL(wp), INTENT(in) :: ptstep !< time step (s)
5912
5913	REAL(wp), INTENT(inout) :: pghno3 !< nitric acid concentration (#/m3)
5914	REAL(wp), INTENT(inout) :: pgnh3 !< ammonia conc. (#/m3)
5915	REAL(wp), INTENT(inout) :: pcw !< water vapour concentration (kg/m3)
5916
5917	REAL(wp), DIMENSION(nbins_aerosol) :: zac_hno3_ae !< Activity coefficients for HNO3
5918	REAL(wp), DIMENSION(nbins_aerosol) :: zac_hhso4_ae !< Activity coefficients for HHSO4
5919	REAL(wp), DIMENSION(nbins_aerosol) :: zac_nh3_ae !< Activity coefficients for NH3
5920	REAL(wp), DIMENSION(nbins_aerosol) :: zac_nh4hso2_ae !< Activity coefficients for NH4HSO2
5921	REAL(wp), DIMENSION(nbins_aerosol) :: zcg_hno3_eq_ae !< Equilibrium gas concentration: HNO3
5922	REAL(wp), DIMENSION(nbins_aerosol) :: zcg_nh3_eq_ae !< Equilibrium gas concentration: NH3
5923	REAL(wp), DIMENSION(nbins_aerosol) :: zc_hno3_int_ae !< Intermediate HNO3 aerosol concentration
5924	REAL(wp), DIMENSION(nbins_aerosol) :: zc_hno3_c_ae !< Current HNO3 in aerosols
5925	REAL(wp), DIMENSION(nbins_aerosol) :: zc_hno3_n_ae !< New HNO3 in aerosols
5926	REAL(wp), DIMENSION(nbins_aerosol) :: zc_nh3_int_ae !< Intermediate NH3 aerosol concentration
5927	REAL(wp), DIMENSION(nbins_aerosol) :: zc_nh3_c_ae !< Current NH3 in aerosols
5928	REAL(wp), DIMENSION(nbins_aerosol) :: zc_nh3_n_ae !< New NH3 in aerosols
5929	REAL(wp), DIMENSION(nbins_aerosol) :: zkel_hno3_ae !< Kelvin effect for HNO3
5930	REAL(wp), DIMENSION(nbins_aerosol) :: zkel_nh3_ae !< Kelvin effects for NH3
5931	REAL(wp), DIMENSION(nbins_aerosol) :: zmt_hno3_ae !< Mass transfer coefficients for HNO3
5932	REAL(wp), DIMENSION(nbins_aerosol) :: zmt_nh3_ae !< Mass transfer coefficients for NH3
5933	REAL(wp), DIMENSION(nbins_aerosol) :: zsat_hno3_ae !< HNO3 saturation ratio over a surface
5934	REAL(wp), DIMENSION(nbins_aerosol) :: zsat_nh3_ae !< NH3 saturation ratio over a surface
5935
5936	REAL(wp), DIMENSION(nbins_aerosol,maxspec) :: zion_mols !< Ion molalities from pdfite aerosols
5937
5938	REAL(wp), DIMENSION(nbins_aerosol), INTENT(in) :: pbeta !< transitional correction factor for
5939
5940	TYPE(t_section), DIMENSION(nbins_aerosol), INTENT(inout) :: paero !< Aerosol properties
5941	!
5942	!-- Initialise:
5943	adt = ptstep
5944	zac_hhso4_ae = 0.0_wp
5945	zac_nh3_ae = 0.0_wp
5946	zac_nh4hso2_ae = 0.0_wp
5947	zac_hno3_ae = 0.0_wp
5948	zcg_nh3_eq_ae = 0.0_wp
5949	zcg_hno3_eq_ae = 0.0_wp
5950	zion_mols = 0.0_wp
5951	zsat_nh3_ae = 1.0_wp
5952	zsat_hno3_ae = 1.0_wp
5953	!
5954	!-- Diffusion coefficient (m2/s)
5955	zdfvap = 5.1111E-10_wp * ptemp*1.75_wp ( p_0 + 1325.0_wp ) / ppres
5956	!
5957	!-- Kelvin effects (Jacobson (2005), eq. 16.33)
5958	zkel_hno3_ae(1:nbins_aerosol) = EXP( 4.0_wp * surfw0 * amvhno3 / &
5959	( abo * ptemp * paero(1:nbins_aerosol)%dwet ) )
5960	zkel_nh3_ae(1:nbins_aerosol) = EXP( 4.0_wp * surfw0 * amvnh3 / &
5961	( abo * ptemp * paero(1:nbins_aerosol)%dwet ) )
5962	!
5963	!-- Current vapour mole concentrations (mol/m3)
5964	zc_hno3_c = pghno3 / avo ! HNO3
5965	zc_nh3_c = pgnh3 / avo ! NH3
5966	!
5967	!-- Current particle mole concentrations (mol/m3)
5968	zc_hno3_c_ae(1:nbins_aerosol) = paero(1:nbins_aerosol)%volc(6) * arhohno3 / amhno3
5969	zc_nh3_c_ae(1:nbins_aerosol) = paero(1:nbins_aerosol)%volc(7) * arhonh3 / amnh3
5970	!
5971	!-- Total mole concentrations: gas and particle phase
5972	zc_hno3_tot = zc_hno3_c + SUM( zc_hno3_c_ae(1:nbins_aerosol) )
5973	zc_nh3_tot = zc_nh3_c + SUM( zc_nh3_c_ae(1:nbins_aerosol) )
5974	!
5975	!-- Relative humidity [0-1]
5976	zrh = pcw / pcs
5977	!
5978	!-- Mass transfer coefficients (Jacobson, Eq. 16.64)
5979	zmt_hno3_ae(:) = 2.0_wp * pi * paero(:)%dwet * zdfvap * paero(:)%numc * pbeta(:)
5980	zmt_nh3_ae(:) = 2.0_wp * pi * paero(:)%dwet * zdfvap * paero(:)%numc * pbeta(:)
5981
5982	!
5983	!-- Get the equilibrium concentrations above aerosols
5984	CALL nitrate_ammonium_equilibrium( zrh, ptemp, paero, zcg_hno3_eq_ae, zcg_nh3_eq_ae, &
5985	zac_hno3_ae, zac_nh3_ae, zac_nh4hso2_ae, zac_hhso4_ae, &
5986	zion_mols )
5987	!
5988	!-- Calculate NH3 and HNO3 saturation ratios for aerosols
5989	CALL nitrate_ammonium_saturation( ptemp, paero, zac_hno3_ae, zac_nh4hso2_ae, zac_hhso4_ae, &
5990	zcg_hno3_eq_ae, zc_hno3_c_ae, zc_nh3_c_ae, zkel_hno3_ae, &
5991	zkel_nh3_ae, zsat_hno3_ae, zsat_nh3_ae )
5992	!
5993	!-- Intermediate gas concentrations of HNO3 and NH3
5994	zhlp1 = SUM( zc_hno3_c_ae(:) / ( 1.0_wp + adt * zmt_hno3_ae(:) * zsat_hno3_ae(:) ) )
5995	zhlp2 = SUM( zmt_hno3_ae(:) / ( 1.0_wp + adt * zmt_hno3_ae(:) * zsat_hno3_ae(:) ) )
5996	zc_hno3_int = ( zc_hno3_tot - zhlp1 ) / ( 1.0_wp + adt * zhlp2 )
5997
5998	zhlp1 = SUM( zc_nh3_c_ae(:) / ( 1.0_wp + adt * zmt_nh3_ae(:) * zsat_nh3_ae(:) ) )
5999	zhlp2 = SUM( zmt_nh3_ae(:) / ( 1.0_wp + adt * zmt_nh3_ae(:) * zsat_nh3_ae(:) ) )
6000	zc_nh3_int = ( zc_nh3_tot - zhlp1 )/( 1.0_wp + adt * zhlp2 )
6001
6002	zc_hno3_int = MIN( zc_hno3_int, zc_hno3_tot )
6003	zc_nh3_int = MIN( zc_nh3_int, zc_nh3_tot )
6004	!
6005	!-- Calculate the new concentration on aerosol particles
6006	zc_hno3_int_ae = zc_hno3_c_ae
6007	zc_nh3_int_ae = zc_nh3_c_ae
6008	DO ib = 1, nbins_aerosol
6009	zc_hno3_int_ae(ib) = ( zc_hno3_c_ae(ib) + adt * zmt_hno3_ae(ib) * zc_hno3_int ) / &
6010	( 1.0_wp + adt * zmt_hno3_ae(ib) * zsat_hno3_ae(ib) )
6011	zc_nh3_int_ae(ib) = ( zc_nh3_c_ae(ib) + adt * zmt_nh3_ae(ib) * zc_nh3_int ) / &
6012	( 1.0_wp + adt * zmt_nh3_ae(ib) * zsat_nh3_ae(ib) )
6013	ENDDO
6014
6015	zc_hno3_int_ae(:) = MAX( zc_hno3_int_ae(:), 0.0_wp )
6016	zc_nh3_int_ae(:) = MAX( zc_nh3_int_ae(:), 0.0_wp )
6017	!
6018	!-- Final molar gas concentration and molar particle concentration of HNO3
6019	zc_hno3_n = zc_hno3_int
6020	zc_hno3_n_ae = zc_hno3_int_ae
6021	!
6022	!-- Final molar gas concentration and molar particle concentration of NH3
6023	zc_nh3_n = zc_nh3_int
6024	zc_nh3_n_ae = zc_nh3_int_ae
6025	!
6026	!-- Model timestep reached - update the gas concentrations
6027	pghno3 = zc_hno3_n * avo
6028	pgnh3 = zc_nh3_n * avo
6029	!
6030	!-- Update the particle concentrations
6031	DO ib = start_subrange_1a, end_subrange_2b
6032	paero(ib)%volc(6) = zc_hno3_n_ae(ib) * amhno3 / arhohno3
6033	paero(ib)%volc(7) = zc_nh3_n_ae(ib) * amnh3 / arhonh3
6034	ENDDO
6035
6036	END SUBROUTINE gpparthno3
6037	!------------------------------------------------------------------------------!
6038	! Description:
6039	! ------------
6040	!> Calculate the equilibrium concentrations above aerosols (reference?)
6041	!------------------------------------------------------------------------------!
6042	SUBROUTINE nitrate_ammonium_equilibrium( prh, ptemp, ppart, pcg_hno3_eq, pcg_nh3_eq, pgamma_hno3, &
6043	pgamma_nh4, pgamma_nh4hso2, pgamma_hhso4, pmols )
6044
6045	IMPLICIT NONE
6046
6047	INTEGER(iwp) :: ib !< loop index: aerosol bins
6048
6049	REAL(wp) :: zhlp !< intermediate variable
6050	REAL(wp) :: zp_hcl !< Equilibrium vapor pressures (Pa) of HCl
6051	REAL(wp) :: zp_hno3 !< Equilibrium vapor pressures (Pa) of HNO3
6052	REAL(wp) :: zp_nh3 !< Equilibrium vapor pressures (Pa) of NH3
6053	REAL(wp) :: zwatertotal !< Total water in particles (mol/m3)
6054
6055	REAL(wp), INTENT(in) :: prh !< relative humidity
6056	REAL(wp), INTENT(in) :: ptemp !< ambient temperature (K)
6057
6058	REAL(wp), DIMENSION(maxspec) :: zgammas !< Activity coefficients
6059	REAL(wp), DIMENSION(maxspec) :: zions !< molar concentration of ion (mol/m3)
6060
6061	REAL(wp), DIMENSION(nbins_aerosol), INTENT(inout) :: pcg_nh3_eq !< equilibrium molar
6062	!< concentration: of NH3
6063	REAL(wp), DIMENSION(nbins_aerosol), INTENT(inout) :: pcg_hno3_eq !< of HNO3
6064	REAL(wp), DIMENSION(nbins_aerosol), INTENT(inout) :: pgamma_hhso4 !< activity coeff. of HHSO4
6065	REAL(wp), DIMENSION(nbins_aerosol), INTENT(inout) :: pgamma_nh4 !< activity coeff. of NH3
6066	REAL(wp), DIMENSION(nbins_aerosol), INTENT(inout) :: pgamma_nh4hso2 !< activity coeff. of NH4HSO2
6067	REAL(wp), DIMENSION(nbins_aerosol), INTENT(inout) :: pgamma_hno3 !< activity coeff. of HNO3
6068
6069	REAL(wp), DIMENSION(nbins_aerosol,maxspec), INTENT(inout) :: pmols !< Ion molalities
6070
6071	TYPE(t_section), DIMENSION(nbins_aerosol), INTENT(inout) :: ppart !< Aerosol properties
6072
6073	zgammas = 0.0_wp
6074	zhlp = 0.0_wp
6075	zions = 0.0_wp
6076	zp_hcl = 0.0_wp
6077	zp_hno3 = 0.0_wp
6078	zp_nh3 = 0.0_wp
6079	zwatertotal = 0.0_wp
6080
6081	DO ib = 1, nbins_aerosol
6082
6083	IF ( ppart(ib)%numc < nclim ) CYCLE
6084	!
6085	!-- Ion molar concentrations: 2*H2SO4 + CL + NO3 - Na - NH4
6086	zhlp = 2.0_wp * ppart(ib)%volc(1) * arhoh2so4 / amh2so4 + ppart(ib)%volc(5) * arhoss / amss &
6087	+ ppart(ib)%volc(6) * arhohno3 / amhno3 - ppart(ib)%volc(5) * arhoss / amss - &
6088	ppart(ib)%volc(7) * arhonh3 / amnh3
6089
6090	zions(1) = zhlp ! H+
6091	zions(2) = ppart(ib)%volc(7) * arhonh3 / amnh3 ! NH4+
6092	zions(3) = ppart(ib)%volc(5) * arhoss / amss ! Na+
6093	zions(4) = ppart(ib)%volc(1) * arhoh2so4 / amh2so4 ! SO4(2-)
6094	zions(5) = 0.0_wp ! HSO4-
6095	zions(6) = ppart(ib)%volc(6) * arhohno3 / amhno3 ! NO3-
6096	zions(7) = ppart(ib)%volc(5) * arhoss / amss ! Cl-
6097
6098	zwatertotal = ppart(ib)%volc(8) * arhoh2o / amh2o
6099	IF ( zwatertotal > 1.0E-30_wp ) THEN
6100	CALL inorganic_pdfite( prh, ptemp, zions, zwatertotal, zp_hno3, zp_hcl, zp_nh3, zgammas, &
6101	pmols(ib,:) )
6102	ENDIF
6103	!
6104	!-- Activity coefficients
6105	pgamma_hno3(ib) = zgammas(1) ! HNO3
6106	pgamma_nh4(ib) = zgammas(3) ! NH3
6107	pgamma_nh4hso2(ib) = zgammas(6) ! NH4HSO2
6108	pgamma_hhso4(ib) = zgammas(7) ! HHSO4
6109	!
6110	!-- Equilibrium molar concentrations (mol/m3) from equlibrium pressures (Pa)
6111	pcg_hno3_eq(ib) = zp_hno3 / ( argas * ptemp )
6112	pcg_nh3_eq(ib) = zp_nh3 / ( argas * ptemp )
6113
6114	ENDDO
6115
6116	END SUBROUTINE nitrate_ammonium_equilibrium
6117
6118	!------------------------------------------------------------------------------!
6119	! Description:
6120	! ------------
6121	!> Calculate saturation ratios of NH4 and HNO3 for aerosols
6122	!------------------------------------------------------------------------------!
6123	SUBROUTINE nitrate_ammonium_saturation( ptemp, ppart, pachno3, pacnh4hso2, pachhso4, pchno3eq, &
6124	pchno3, pc_nh3, pkelhno3, pkelnh3, psathno3, psatnh3 )
6125
6126	IMPLICIT NONE
6127
6128	INTEGER(iwp) :: ib !< running index for aerosol bins
6129
6130	REAL(wp) :: k_ll_h2o !< equilibrium constants of equilibrium reactions:
6131	!< H2O(aq) <--> H+ + OH- (mol/kg)
6132	REAL(wp) :: k_ll_nh3 !< NH3(aq) + H2O(aq) <--> NH4+ + OH- (mol/kg)
6133	REAL(wp) :: k_gl_nh3 !< NH3(g) <--> NH3(aq) (mol/kg/atm)
6134	REAL(wp) :: k_gl_hno3 !< HNO3(g) <--> H+ + NO3- (mol2/kg2/atm)
6135	REAL(wp) :: zmol_no3 !< molality of NO3- (mol/kg)
6136	REAL(wp) :: zmol_h !< molality of H+ (mol/kg)
6137	REAL(wp) :: zmol_so4 !< molality of SO4(2-) (mol/kg)
6138	REAL(wp) :: zmol_cl !< molality of Cl- (mol/kg)
6139	REAL(wp) :: zmol_nh4 !< molality of NH4+ (mol/kg)
6140	REAL(wp) :: zmol_na !< molality of Na+ (mol/kg)
6141	REAL(wp) :: zhlp1 !< intermediate variable
6142	REAL(wp) :: zhlp2 !< intermediate variable
6143	REAL(wp) :: zhlp3 !< intermediate variable
6144	REAL(wp) :: zxi !< particle mole concentration ratio: (NH3+SS)/H2SO4
6145	REAL(wp) :: zt0 !< reference temp
6146
6147	REAL(wp), PARAMETER :: a1 = -22.52_wp !<
6148	REAL(wp), PARAMETER :: a2 = -1.50_wp !<
6149	REAL(wp), PARAMETER :: a3 = 13.79_wp !<
6150	REAL(wp), PARAMETER :: a4 = 29.17_wp !<
6151	REAL(wp), PARAMETER :: b1 = 26.92_wp !<
6152	REAL(wp), PARAMETER :: b2 = 26.92_wp !<
6153	REAL(wp), PARAMETER :: b3 = -5.39_wp !<
6154	REAL(wp), PARAMETER :: b4 = 16.84_wp !<
6155	REAL(wp), PARAMETER :: K01 = 1.01E-14_wp !<
6156	REAL(wp), PARAMETER :: K02 = 1.81E-5_wp !<
6157	REAL(wp), PARAMETER :: K03 = 57.64_wp !<
6158	REAL(wp), PARAMETER :: K04 = 2.51E+6_wp !<
6159
6160	REAL(wp), INTENT(in) :: ptemp !< ambient temperature (K)
6161
6162	REAL(wp), DIMENSION(nbins_aerosol), INTENT(in) :: pachhso4 !< activity coeff. of HHSO4
6163	REAL(wp), DIMENSION(nbins_aerosol), INTENT(in) :: pacnh4hso2 !< activity coeff. of NH4HSO2
6164	REAL(wp), DIMENSION(nbins_aerosol), INTENT(in) :: pachno3 !< activity coeff. of HNO3
6165	REAL(wp), DIMENSION(nbins_aerosol), INTENT(in) :: pchno3eq !< eq. surface concentration: HNO3
6166	REAL(wp), DIMENSION(nbins_aerosol), INTENT(in) :: pchno3 !< current particle mole
6167	!< concentration of HNO3 (mol/m3)
6168	REAL(wp), DIMENSION(nbins_aerosol), INTENT(in) :: pc_nh3 !< of NH3 (mol/m3)
6169	REAL(wp), DIMENSION(nbins_aerosol), INTENT(in) :: pkelhno3 !< Kelvin effect for HNO3
6170	REAL(wp), DIMENSION(nbins_aerosol), INTENT(in) :: pkelnh3 !< Kelvin effect for NH3
6171
6172	REAL(wp), DIMENSION(nbins_aerosol), INTENT(out) :: psathno3 !< saturation ratio of HNO3
6173	REAL(wp), DIMENSION(nbins_aerosol), INTENT(out) :: psatnh3 !< saturation ratio of NH3
6174
6175	TYPE(t_section), DIMENSION(nbins_aerosol), INTENT(inout) :: ppart !< Aerosol properties
6176
6177	zmol_cl = 0.0_wp
6178	zmol_h = 0.0_wp
6179	zmol_na = 0.0_wp
6180	zmol_nh4 = 0.0_wp
6181	zmol_no3 = 0.0_wp
6182	zmol_so4 = 0.0_wp
6183	zt0 = 298.15_wp
6184	zxi = 0.0_wp
6185	!
6186	!-- Calculates equlibrium rate constants based on Table B.7 in Jacobson (2005):
6187	!-- K^ll_H20, K^ll_NH3, K^gl_NH3, K^gl_HNO3
6188	zhlp1 = zt0 / ptemp
6189	zhlp2 = zhlp1 - 1.0_wp
6190	zhlp3 = 1.0_wp + LOG( zhlp1 ) - zhlp1
6191
6192	k_ll_h2o = K01 * EXP( a1 * zhlp2 + b1 * zhlp3 )
6193	k_ll_nh3 = K02 * EXP( a2 * zhlp2 + b2 * zhlp3 )
6194	k_gl_nh3 = K03 * EXP( a3 * zhlp2 + b3 * zhlp3 )
6195	k_gl_hno3 = K04 * EXP( a4 * zhlp2 + b4 * zhlp3 )
6196
6197	DO ib = 1, nbins_aerosol
6198
6199	IF ( ppart(ib)%numc > nclim .AND. ppart(ib)%volc(8) > 1.0E-30_wp ) THEN
6200	!
6201	!-- Molality of H+ and NO3-
6202	zhlp1 = pc_nh3(ib) * amnh3 + ppart(ib)%volc(1) * arhoh2so4 + ppart(ib)%volc(2) * arhooc &
6203	+ ppart(ib)%volc(5) * arhoss + ppart(ib)%volc(8) * arhoh2o
6204	zmol_no3 = pchno3(ib) / zhlp1 !< mol/kg
6205	!
6206	!-- Particle mole concentration ratio: (NH3+SS)/H2SO4
6207	zxi = ( pc_nh3(ib) + ppart(ib)%volc(5) * arhoss / amss ) / ( ppart(ib)%volc(1) * &
6208	arhoh2so4 / amh2so4 )
6209
6210	IF ( zxi <= 2.0_wp ) THEN
6211	!
6212	!-- Molality of SO4(2-)
6213	zhlp1 = pc_nh3(ib) * amnh3 + pchno3(ib) * amhno3 + ppart(ib)%volc(2) * arhooc + &
6214	ppart(ib)%volc(5) * arhoss + ppart(ib)%volc(8) * arhoh2o
6215	zmol_so4 = ( ppart(ib)%volc(1) * arhoh2so4 / amh2so4 ) / zhlp1
6216	!
6217	!-- Molality of Cl-
6218	zhlp1 = pc_nh3(ib) * amnh3 + pchno3(ib) * amhno3 + ppart(ib)%volc(2) * arhooc + &
6219	ppart(ib)%volc(1) * arhoh2so4 + ppart(ib)%volc(8) * arhoh2o
6220	zmol_cl = ( ppart(ib)%volc(5) * arhoss / amss ) / zhlp1
6221	!
6222	!-- Molality of NH4+
6223	zhlp1 = pchno3(ib) * amhno3 + ppart(ib)%volc(1) * arhoh2so4 + ppart(ib)%volc(2) * &
6224	arhooc + ppart(ib)%volc(5) * arhoss + ppart(ib)%volc(8) * arhoh2o
6225	zmol_nh4 = pc_nh3(ib) / zhlp1
6226	!
6227	!-- Molality of Na+
6228	zmol_na = zmol_cl
6229	!
6230	!-- Molality of H+
6231	zmol_h = 2.0_wp * zmol_so4 + zmol_no3 + zmol_cl - ( zmol_nh4 + zmol_na )
6232
6233	ELSE
6234
6235	zhlp2 = pkelhno3(ib) * zmol_no3 * pachno3(ib)**2
6236
6237	IF ( zhlp2 > 1.0E-30_wp ) THEN
6238	zmol_h = k_gl_hno3 * pchno3eq(ib) / zhlp2 ! Eq. 17.38
6239	ELSE
6240	zmol_h = 0.0_wp
6241	ENDIF
6242
6243	ENDIF
6244
6245	zhlp1 = ppart(ib)%volc(8) * arhoh2o * argas * ptemp * k_gl_hno3
6246	!
6247	!-- Saturation ratio for NH3 and for HNO3
6248	IF ( zmol_h > 0.0_wp ) THEN
6249	zhlp2 = pkelnh3(ib) / ( zhlp1 * zmol_h )
6250	zhlp3 = k_ll_h2o / ( k_ll_nh3 + k_gl_nh3 )
6251	psatnh3(ib) = zhlp2 * ( ( pacnh4hso2(ib) / pachhso4(ib) )*2 ) zhlp3
6252	psathno3(ib) = ( pkelhno3(ib) * zmol_h * pachno3(ib)**2 ) / zhlp1
6253	ELSE
6254	psatnh3(ib) = 1.0_wp
6255	psathno3(ib) = 1.0_wp
6256	ENDIF
6257	ELSE
6258	psatnh3(ib) = 1.0_wp
6259	psathno3(ib) = 1.0_wp
6260	ENDIF
6261
6262	ENDDO
6263
6264	END SUBROUTINE nitrate_ammonium_saturation
6265
6266	!------------------------------------------------------------------------------!
6267	! Description:
6268	! ------------
6269	!> Prototype module for calculating the water content of a mixed inorganic/
6270	!> organic particle + equilibrium water vapour pressure above the solution
6271	!> (HNO3, HCL, NH3 and representative organic compounds. Efficient calculation
6272	!> of the partitioning of species between gas and aerosol. Based in a chamber
6273	!> study.
6274	!
6275	!> Written by Dave Topping. Pure organic component properties predicted by Mark
6276	!> Barley based on VOCs predicted in MCM simulations performed by Mike Jenkin.
6277	!> Delivered by Gordon McFiggans as Deliverable D22 from WP1.4 in the EU FP6
6278	!> EUCAARI Integrated Project.
6279	!
6280	!> REFERENCES
6281	!> Clegg et al. (1998) A Thermodynamic Model of the System H+-NH4+-Na+-SO42- -NO3--Cl--H2O at
6282	!> 298.15 K, J. Phys. Chem., 102A, 2155-2171.
6283	!> Clegg et al. (2001) Thermodynamic modelling of aqueous aerosols containing electrolytes and
6284	!> dissolved organic compounds. Journal of Aerosol Science 2001;32(6):713-738.
6285	!> Topping et al. (2005a) A curved multi-component aerosol hygroscopicity model framework: Part 1 -
6286	!> Inorganic compounds. Atmospheric Chemistry and Physics 2005;5:1205-1222.
6287	!> Topping et al. (2005b) A curved multi-component aerosol hygroscopicity model framework: Part 2 -
6288	!> Including organic compounds. Atmospheric Chemistry and Physics 2005;5:1223-1242.
6289	!> Wagman et al. (1982). The NBS tables of chemical thermodynamic properties: selected values for
6290	!> inorganic and Câ and Câ organic substances in SI units (book)
6291	!> Zaveri et al. (2005). A new method for multicomponent activity coefficients of electrolytes in
6292	!> aqueous atmospheric aerosols, JGR, 110, D02201, 2005.
6293	!
6294	!> Queries concerning the use of this code through Gordon McFiggans,
6295	!> g.mcfiggans@manchester.ac.uk,
6296	!> Ownership: D. Topping, Centre for Atmospheric Sciences, University of
6297	!> Manchester, 2007
6298	!
6299	!> Rewritten to PALM by Mona Kurppa, UHel, 2017
6300	!------------------------------------------------------------------------------!
6301	SUBROUTINE inorganic_pdfite( rh, temp, ions, water_total, press_hno3, press_hcl, press_nh3, &
6302	gamma_out, mols_out )
6303
6304	IMPLICIT NONE
6305
6306	INTEGER(iwp) :: binary_case
6307	INTEGER(iwp) :: full_complexity
6308
6309	REAL(wp) :: a !< auxiliary variable
6310	REAL(wp) :: act_product !< ionic activity coef. product:
6311	!< = (gamma_h2so43d0) / gamma_hhso42d0)
6312	REAL(wp) :: ammonium_chloride !<
6313	REAL(wp) :: ammonium_chloride_eq_frac !<
6314	REAL(wp) :: ammonium_nitrate !<
6315	REAL(wp) :: ammonium_nitrate_eq_frac !<
6316	REAL(wp) :: ammonium_sulphate !<
6317	REAL(wp) :: ammonium_sulphate_eq_frac !<
6318	REAL(wp) :: b !< auxiliary variable
6319	REAL(wp) :: binary_h2so4 !< binary H2SO4 activity coeff.
6320	REAL(wp) :: binary_hcl !< binary HCL activity coeff.
6321	REAL(wp) :: binary_hhso4 !< binary HHSO4 activity coeff.
6322	REAL(wp) :: binary_hno3 !< binary HNO3 activity coeff.
6323	REAL(wp) :: binary_nh4hso4 !< binary NH4HSO4 activity coeff.
6324	REAL(wp) :: c !< auxiliary variable
6325	REAL(wp) :: charge_sum !< sum of ionic charges
6326	REAL(wp) :: gamma_h2so4 !< activity coefficient
6327	REAL(wp) :: gamma_hcl !< activity coefficient
6328	REAL(wp) :: gamma_hhso4 !< activity coeffient
6329	REAL(wp) :: gamma_hno3 !< activity coefficient
6330	REAL(wp) :: gamma_nh3 !< activity coefficient
6331	REAL(wp) :: gamma_nh4hso4 !< activity coefficient
6332	REAL(wp) :: h_out !<
6333	REAL(wp) :: h_real !< new hydrogen ion conc.
6334	REAL(wp) :: h2so4_hcl !< contribution of H2SO4
6335	REAL(wp) :: h2so4_hno3 !< contribution of H2SO4
6336	REAL(wp) :: h2so4_nh3 !< contribution of H2SO4
6337	REAL(wp) :: h2so4_nh4hso4 !< contribution of H2SO4
6338	REAL(wp) :: hcl_h2so4 !< contribution of HCL
6339	REAL(wp) :: hcl_hhso4 !< contribution of HCL
6340	REAL(wp) :: hcl_hno3 !< contribution of HCL
6341	REAL(wp) :: hcl_nh4hso4 !< contribution of HCL
6342	REAL(wp) :: henrys_temp_dep !< temperature dependence of Henry's Law
6343	REAL(wp) :: hno3_h2so4 !< contribution of HNO3
6344	REAL(wp) :: hno3_hcl !< contribution of HNO3
6345	REAL(wp) :: hno3_hhso4 !< contribution of HNO3
6346	REAL(wp) :: hno3_nh3 !< contribution of HNO3
6347	REAL(wp) :: hno3_nh4hso4 !< contribution of HNO3
6348	REAL(wp) :: hso4_out !<
6349	REAL(wp) :: hso4_real !< new bisulphate ion conc.
6350	REAL(wp) :: hydrochloric_acid !<
6351	REAL(wp) :: hydrochloric_acid_eq_frac !<
6352	REAL(wp) :: k_h !< equilibrium constant for H+
6353	REAL(wp) :: k_hcl !< equilibrium constant of HCL
6354	REAL(wp) :: k_hno3 !< equilibrium constant of HNO3
6355	REAL(wp) :: k_nh4 !< equilibrium constant for NH4+
6356	REAL(wp) :: k_h2o !< equil. const. for water_surface
6357	REAL(wp) :: ln_h2so4_act !< gamma_h2so4 = EXP(ln_h2so4_act)
6358	REAL(wp) :: ln_HCL_act !< gamma_hcl = EXP( ln_HCL_act )
6359	REAL(wp) :: ln_hhso4_act !< gamma_hhso4 = EXP(ln_hhso4_act)
6360	REAL(wp) :: ln_hno3_act !< gamma_hno3 = EXP( ln_hno3_act )
6361	REAL(wp) :: ln_nh4hso4_act !< gamma_nh4hso4 = EXP( ln_nh4hso4_act )
6362	REAL(wp) :: molality_ratio_nh3 !< molality ratio of NH3 (NH4+ and H+)
6363	REAL(wp) :: na2so4_h2so4 !< contribution of Na2SO4
6364	REAL(wp) :: na2so4_hcl !< contribution of Na2SO4
6365	REAL(wp) :: na2so4_hhso4 !< contribution of Na2SO4
6366	REAL(wp) :: na2so4_hno3 !< contribution of Na2SO4
6367	REAL(wp) :: na2so4_nh3 !< contribution of Na2SO4
6368	REAL(wp) :: na2so4_nh4hso4 !< contribution of Na2SO4
6369	REAL(wp) :: nacl_h2so4 !< contribution of NaCl
6370	REAL(wp) :: nacl_hcl !< contribution of NaCl
6371	REAL(wp) :: nacl_hhso4 !< contribution of NaCl
6372	REAL(wp) :: nacl_hno3 !< contribution of NaCl
6373	REAL(wp) :: nacl_nh3 !< contribution of NaCl
6374	REAL(wp) :: nacl_nh4hso4 !< contribution of NaCl
6375	REAL(wp) :: nano3_h2so4 !< contribution of NaNO3
6376	REAL(wp) :: nano3_hcl !< contribution of NaNO3
6377	REAL(wp) :: nano3_hhso4 !< contribution of NaNO3
6378	REAL(wp) :: nano3_hno3 !< contribution of NaNO3
6379	REAL(wp) :: nano3_nh3 !< contribution of NaNO3
6380	REAL(wp) :: nano3_nh4hso4 !< contribution of NaNO3
6381	REAL(wp) :: nh42so4_h2so4 !< contribution of NH42SO4
6382	REAL(wp) :: nh42so4_hcl !< contribution of NH42SO4
6383	REAL(wp) :: nh42so4_hhso4 !< contribution of NH42SO4
6384	REAL(wp) :: nh42so4_hno3 !< contribution of NH42SO4
6385	REAL(wp) :: nh42so4_nh3 !< contribution of NH42SO4
6386	REAL(wp) :: nh42so4_nh4hso4 !< contribution of NH42SO4
6387	REAL(wp) :: nh4cl_h2so4 !< contribution of NH4Cl
6388	REAL(wp) :: nh4cl_hcl !< contribution of NH4Cl
6389	REAL(wp) :: nh4cl_hhso4 !< contribution of NH4Cl
6390	REAL(wp) :: nh4cl_hno3 !< contribution of NH4Cl
6391	REAL(wp) :: nh4cl_nh3 !< contribution of NH4Cl
6392	REAL(wp) :: nh4cl_nh4hso4 !< contribution of NH4Cl
6393	REAL(wp) :: nh4no3_h2so4 !< contribution of NH4NO3
6394	REAL(wp) :: nh4no3_hcl !< contribution of NH4NO3
6395	REAL(wp) :: nh4no3_hhso4 !< contribution of NH4NO3
6396	REAL(wp) :: nh4no3_hno3 !< contribution of NH4NO3
6397	REAL(wp) :: nh4no3_nh3 !< contribution of NH4NO3
6398	REAL(wp) :: nh4no3_nh4hso4 !< contribution of NH4NO3
6399	REAL(wp) :: nitric_acid !<
6400	REAL(wp) :: nitric_acid_eq_frac !< Equivalent fractions
6401	REAL(wp) :: press_hcl !< partial pressure of HCL
6402	REAL(wp) :: press_hno3 !< partial pressure of HNO3
6403	REAL(wp) :: press_nh3 !< partial pressure of NH3
6404	REAL(wp) :: rh !< relative humidity [0-1]
6405	REAL(wp) :: root1 !< auxiliary variable
6406	REAL(wp) :: root2 !< auxiliary variable
6407	REAL(wp) :: so4_out !<
6408	REAL(wp) :: so4_real !< new sulpate ion concentration
6409	REAL(wp) :: sodium_chloride !<
6410	REAL(wp) :: sodium_chloride_eq_frac !<
6411	REAL(wp) :: sodium_nitrate !<
6412	REAL(wp) :: sodium_nitrate_eq_frac !<
6413	REAL(wp) :: sodium_sulphate !<
6414	REAL(wp) :: sodium_sulphate_eq_frac !<
6415	REAL(wp) :: solutes !<
6416	REAL(wp) :: sulphuric_acid !<
6417	REAL(wp) :: sulphuric_acid_eq_frac !<
6418	REAL(wp) :: temp !< temperature
6419	REAL(wp) :: water_total !<
6420
6421	REAL(wp), DIMENSION(:) :: gamma_out !< Activity coefficient for calculating the non-ideal
6422	!< dissociation constants
6423	!< 1: HNO3, 2: HCL, 3: NH4+/H+ (NH3), 4: HHSO4**2/H2SO4,
6424	!< 5: H2SO43/HHSO42, 6: NH4HSO2, 7: HHSO4
6425	REAL(wp), DIMENSION(:) :: ions !< ion molarities (mol/m3): 1: H+, 2: NH4+, 3: Na+,
6426	!< 4: SO4(2-), 5: HSO4-, 6: NO3-, 7: Cl-
6427	REAL(wp), DIMENSION(7) :: ions_mol !< ion molalities (mol/kg): 1: H+, 2: NH4+, 3: Na+,
6428	!< 4: SO4(2-), 5: HSO4-, 6: NO3-, 7: Cl-
6429	REAL(wp), DIMENSION(:) :: mols_out !< ion molality output (mol/kg): 1: H+, 2: NH4+, 3: Na+,
6430	!< 4: SO4(2-), 5: HSO4-, 6: NO3-, 7: Cl-
6431	!
6432	!-- Value initialisation
6433	binary_h2so4 = 0.0_wp
6434	binary_hcl = 0.0_wp
6435	binary_hhso4 = 0.0_wp
6436	binary_hno3 = 0.0_wp
6437	binary_nh4hso4 = 0.0_wp
6438	henrys_temp_dep = ( 1.0_wp / temp - 0.0033557_wp ) ! 1/T - 1/298 K
6439	hcl_hno3 = 1.0_wp
6440	h2so4_hno3 = 1.0_wp
6441	nh42so4_hno3 = 1.0_wp
6442	nh4no3_hno3 = 1.0_wp
6443	nh4cl_hno3 = 1.0_wp
6444	na2so4_hno3 = 1.0_wp
6445	nano3_hno3 = 1.0_wp
6446	nacl_hno3 = 1.0_wp
6447	hno3_hcl = 1.0_wp
6448	h2so4_hcl = 1.0_wp
6449	nh42so4_hcl = 1.0_wp
6450	nh4no3_hcl = 1.0_wp
6451	nh4cl_hcl = 1.0_wp
6452	na2so4_hcl = 1.0_wp
6453	nano3_hcl = 1.0_wp
6454	nacl_hcl = 1.0_wp
6455	hno3_nh3 = 1.0_wp
6456	h2so4_nh3 = 1.0_wp
6457	nh42so4_nh3 = 1.0_wp
6458	nh4no3_nh3 = 1.0_wp
6459	nh4cl_nh3 = 1.0_wp
6460	na2so4_nh3 = 1.0_wp
6461	nano3_nh3 = 1.0_wp
6462	nacl_nh3 = 1.0_wp
6463	hno3_hhso4 = 1.0_wp
6464	hcl_hhso4 = 1.0_wp
6465	nh42so4_hhso4 = 1.0_wp
6466	nh4no3_hhso4 = 1.0_wp
6467	nh4cl_hhso4 = 1.0_wp
6468	na2so4_hhso4 = 1.0_wp
6469	nano3_hhso4 = 1.0_wp
6470	nacl_hhso4 = 1.0_wp
6471	hno3_h2so4 = 1.0_wp
6472	hcl_h2so4 = 1.0_wp
6473	nh42so4_h2so4 = 1.0_wp
6474	nh4no3_h2so4 = 1.0_wp
6475	nh4cl_h2so4 = 1.0_wp
6476	na2so4_h2so4 = 1.0_wp
6477	nano3_h2so4 = 1.0_wp
6478	nacl_h2so4 = 1.0_wp
6479	!
6480	!-- New NH3 variables
6481	hno3_nh4hso4 = 1.0_wp
6482	hcl_nh4hso4 = 1.0_wp
6483	h2so4_nh4hso4 = 1.0_wp
6484	nh42so4_nh4hso4 = 1.0_wp
6485	nh4no3_nh4hso4 = 1.0_wp
6486	nh4cl_nh4hso4 = 1.0_wp
6487	na2so4_nh4hso4 = 1.0_wp
6488	nano3_nh4hso4 = 1.0_wp
6489	nacl_nh4hso4 = 1.0_wp
6490	!
6491	!-- Juha Tonttila added
6492	mols_out = 0.0_wp
6493	press_hno3 = 0.0_wp !< Initialising vapour pressures over the
6494	press_hcl = 0.0_wp !< multicomponent particle
6495	press_nh3 = 0.0_wp
6496	gamma_out = 1.0_wp !< i.e. don't alter the ideal mixing ratios if there's nothing there.
6497	!
6498	!-- 1) - COMPOSITION DEFINITIONS
6499	!
6500	!-- a) Inorganic ion pairing:
6501	!-- In order to calculate the water content, which is also used in calculating vapour pressures, one
6502	!-- needs to pair the anions and cations for use in the ZSR mixing rule. The equation provided by
6503	!-- Clegg et al. (2001) is used for ion pairing. The solutes chosen comprise of 9 inorganic salts
6504	!-- and acids which provide a pairing between each anion and cation: (NH4)2SO4, NH4NO3, NH4Cl,
6505	!-- Na2SO4, NaNO3, NaCl, H2SO4, HNO3, HCL. The organic compound is treated as a seperate solute.
6506	!-- Ions: 1: H+, 2: NH4+, 3: Na+, 4: SO4(2-), 5: HSO4-, 6: NO3-, 7: Cl-
6507	!
6508	charge_sum = ions(1) + ions(2) + ions(3) + 2.0_wp * ions(4) + ions(5) + ions(6) + ions(7)
6509	nitric_acid = ( 2.0_wp * ions(1) * ions(6) ) / charge_sum
6510	hydrochloric_acid = ( 2.0_wp * ions(1) * ions(7) ) / charge_sum
6511	sulphuric_acid = ( 2.0_wp * ions(1) * ions(4) ) / charge_sum
6512	ammonium_sulphate = ( 2.0_wp * ions(2) * ions(4) ) / charge_sum
6513	ammonium_nitrate = ( 2.0_wp * ions(2) * ions(6) ) / charge_sum
6514	ammonium_chloride = ( 2.0_wp * ions(2) * ions(7) ) / charge_sum
6515	sodium_sulphate = ( 2.0_wp * ions(3) * ions(4) ) / charge_sum
6516	sodium_nitrate = ( 2.0_wp * ions(3) * ions(6) ) / charge_sum
6517	sodium_chloride = ( 2.0_wp * ions(3) * ions(7) ) / charge_sum
6518	solutes = 0.0_wp
6519	solutes = 3.0_wp * sulphuric_acid + 2.0_wp * hydrochloric_acid + 2.0_wp * nitric_acid + &
6520	3.0_wp * ammonium_sulphate + 2.0_wp * ammonium_nitrate + 2.0_wp * ammonium_chloride +&
6521	3.0_wp * sodium_sulphate + 2.0_wp * sodium_nitrate + 2.0_wp * sodium_chloride
6522	!
6523	!-- b) Inorganic equivalent fractions:
6524	!-- These values are calculated so that activity coefficients can be expressed by a linear additive
6525	!-- rule, thus allowing more efficient calculations and future expansion (see more detailed
6526	!-- description below)
6527	nitric_acid_eq_frac = 2.0_wp * nitric_acid / solutes
6528	hydrochloric_acid_eq_frac = 2.0_wp * hydrochloric_acid / solutes
6529	sulphuric_acid_eq_frac = 3.0_wp * sulphuric_acid / solutes
6530	ammonium_sulphate_eq_frac = 3.0_wp * ammonium_sulphate / solutes
6531	ammonium_nitrate_eq_frac = 2.0_wp * ammonium_nitrate / solutes
6532	ammonium_chloride_eq_frac = 2.0_wp * ammonium_chloride / solutes
6533	sodium_sulphate_eq_frac = 3.0_wp * sodium_sulphate / solutes
6534	sodium_nitrate_eq_frac = 2.0_wp * sodium_nitrate / solutes
6535	sodium_chloride_eq_frac = 2.0_wp * sodium_chloride / solutes
6536	!
6537	!-- Inorganic ion molalities
6538	ions_mol(1) = ions(1) / ( water_total * 18.01528E-3_wp ) ! H+
6539	ions_mol(2) = ions(2) / ( water_total * 18.01528E-3_wp ) ! NH4+
6540	ions_mol(3) = ions(3) / ( water_total * 18.01528E-3_wp ) ! Na+
6541	ions_mol(4) = ions(4) / ( water_total * 18.01528E-3_wp ) ! SO4(2-)
6542	ions_mol(5) = ions(5) / ( water_total * 18.01528E-3_wp ) ! HSO4(2-)
6543	ions_mol(6) = ions(6) / ( water_total * 18.01528E-3_wp ) ! NO3-
6544	ions_mol(7) = ions(7) / ( water_total * 18.01528E-3_wp ) ! Cl-
6545
6546	!-- ***
6547	!-- At this point we may need to introduce a method for prescribing H+ when there is no 'real' value
6548	!-- for H+..i.e. in the sulphate poor domain. This will give a value for solve quadratic proposed by
6549	!-- Zaveri et al. 2005
6550	!
6551	!-- 2) - WATER CALCULATION
6552	!
6553	!-- a) The water content is calculated using the ZSR rule with solute concentrations calculated
6554	!-- using 1a above. Whilst the usual approximation of ZSR relies on binary data consisting of 5th or
6555	!-- higher order polynomials, in this code 4 different RH regimes are used, each housing cubic
6556	!-- equations for the water associated with each solute listed above. Binary water contents for
6557	!-- inorganic components were calculated using AIM online (Clegg et al 1998). The water associated
6558	!-- with the organic compound is calculated assuming ideality and that aw = RH.
6559	!
6560	!-- b) Molality of each inorganic ion and organic solute (initial input) is calculated for use in
6561	!-- vapour pressure calculation.
6562	!
6563	!-- 3) - BISULPHATE ION DISSOCIATION CALCULATION
6564	!
6565	!-- The dissociation of the bisulphate ion is calculated explicitly. A solution to the equilibrium
6566	!-- equation between the bisulphate ion, hydrogen ion and sulphate ion is found using tabulated
6567	!-- equilibrium constants (referenced). It is necessary to calculate the activity coefficients of
6568	!-- HHSO4 and H2SO4 in a non-iterative manner. These are calculated using the same format as
6569	!-- described in 4) below, where both activity coefficients were fit to the output from ADDEM
6570	!-- (Topping et al 2005a,b) covering an extensive composition space, providing the activity
6571	!-- coefficients and bisulphate ion dissociation as a function of equivalent mole fractions and
6572	!-- relative humidity.
6573	!
6574	!-- NOTE: the flags "binary_case" and "full_complexity" are not used in this prototype. They are
6575	!-- used for simplification of the fit expressions when using limited composition regions. This
6576	!-- section of code calculates the bisulphate ion concentration.
6577	!
6578	IF ( ions(1) > 0.0_wp .AND. ions(4) > 0.0_wp ) THEN
6579	!
6580	!-- HHSO4:
6581	binary_case = 1
6582	IF ( rh > 0.1_wp .AND. rh < 0.9_wp ) THEN
6583	binary_hhso4 = -4.9521_wp * rh*3 + 9.2881_wp rh*2 - 10.777_wp rh + 6.0534_wp
6584	ELSEIF ( rh >= 0.9_wp .AND. rh < 0.955_wp ) THEN
6585	binary_hhso4 = -6.3777_wp * rh + 5.962_wp
6586	ELSEIF ( rh >= 0.955_wp .AND. rh < 0.99_wp ) THEN
6587	binary_hhso4 = 2367.2_wp * rh*3 - 6849.7_wp rh*2 + 6600.9_wp rh - 2118.7_wp
6588	ELSEIF ( rh >= 0.99_wp .AND. rh < 0.9999_wp ) THEN
6589	binary_hhso4 = 3E-7_wp * rh*5 - 2E-5_wp rh*4 + 0.0004_wp rh*3 - 0.0035_wp rh**2 &
6590	+ 0.0123_wp * rh - 0.3025_wp
6591	ENDIF
6592
6593	IF ( nitric_acid > 0.0_wp ) THEN
6594	hno3_hhso4 = -4.2204_wp * rh*4 + 12.193_wp rh*3 - 12.481_wp rh*2 + 6.459_wp rh &
6595	- 1.9004_wp
6596	ENDIF
6597
6598	IF ( hydrochloric_acid > 0.0_wp ) THEN
6599	hcl_hhso4 = -54.845_wp * rh*7 + 209.54_wp rh*6 - 336.59_wp rh*5 + 294.21_wp &
6600	rh*4 - 150.07_wp rh*3 + 43.767_wp rh*2 - 6.5495_wp rh + 0.60048_wp
6601	ENDIF
6602
6603	IF ( ammonium_sulphate > 0.0_wp ) THEN
6604	nh42so4_hhso4 = 16.768_wp * rh*3 - 28.75_wp rh*2 + 20.011_wp rh - 8.3206_wp
6605	ENDIF
6606
6607	IF ( ammonium_nitrate > 0.0_wp ) THEN
6608	nh4no3_hhso4 = -17.184_wp * rh*4 + 56.834_wp rh*3 - 65.765_wp rh**2 + &
6609	35.321_wp * rh - 9.252_wp
6610	ENDIF
6611
6612	IF (ammonium_chloride > 0.0_wp ) THEN
6613	IF ( rh < 0.2_wp .AND. rh >= 0.1_wp ) THEN
6614	nh4cl_hhso4 = 3.2809_wp * rh - 2.0637_wp
6615	ELSEIF ( rh >= 0.2_wp .AND. rh < 0.99_wp ) THEN
6616	nh4cl_hhso4 = -1.2981_wp * rh*3 + 4.7461_wp rh*2 - 2.3269_wp rh - 1.1259_wp
6617	ENDIF
6618	ENDIF
6619
6620	IF ( sodium_sulphate > 0.0_wp ) THEN
6621	na2so4_hhso4 = 118.87_wp * rh*6 - 358.63_wp rh*5 + 435.85_wp rh*4 - 272.88_wp &
6622	rh*3 + 94.411_wp rh*2 - 18.21_wp rh + 0.45935_wp
6623	ENDIF
6624
6625	IF ( sodium_nitrate > 0.0_wp ) THEN
6626	IF ( rh < 0.2_wp .AND. rh >= 0.1_wp ) THEN
6627	nano3_hhso4 = 4.8456_wp * rh - 2.5773_wp
6628	ELSEIF ( rh >= 0.2_wp .AND. rh < 0.99_wp ) THEN
6629	nano3_hhso4 = 0.5964_wp * rh*3 - 0.38967_wp rh*2 + 1.7918_wp rh - 1.9691_wp
6630	ENDIF
6631	ENDIF
6632
6633	IF ( sodium_chloride > 0.0_wp ) THEN
6634	IF ( rh < 0.2_wp ) THEN
6635	nacl_hhso4 = 0.51995_wp * rh - 1.3981_wp
6636	ELSEIF ( rh >= 0.2_wp .AND. rh < 0.99_wp ) THEN
6637	nacl_hhso4 = 1.6539_wp * rh - 1.6101_wp
6638	ENDIF
6639	ENDIF
6640
6641	ln_hhso4_act = binary_hhso4 + nitric_acid_eq_frac * hno3_hhso4 + &
6642	hydrochloric_acid_eq_frac * hcl_hhso4 + &
6643	ammonium_sulphate_eq_frac * nh42so4_hhso4 + &
6644	ammonium_nitrate_eq_frac * nh4no3_hhso4 + &
6645	ammonium_chloride_eq_frac * nh4cl_hhso4 + &
6646	sodium_sulphate_eq_frac * na2so4_hhso4 + &
6647	sodium_nitrate_eq_frac * nano3_hhso4 + sodium_chloride_eq_frac * nacl_hhso4
6648
6649	gamma_hhso4 = EXP( ln_hhso4_act ) ! molal activity coefficient of HHSO4
6650
6651	!-- H2SO4 (sulphuric acid):
6652	IF ( rh >= 0.1_wp .AND. rh < 0.9_wp ) THEN
6653	binary_h2so4 = 2.4493_wp * rh*2 - 6.2326_wp rh + 2.1763_wp
6654	ELSEIF ( rh >= 0.9_wp .AND. rh < 0.98 ) THEN
6655	binary_h2so4 = 914.68_wp * rh*3 - 2502.3_wp rh*2 + 2281.9_wp rh - 695.11_wp
6656	ELSEIF ( rh >= 0.98 .AND. rh < 0.9999 ) THEN
6657	binary_h2so4 = 3.0E-8_wp * rh*4 - 5E-6_wp rh*3 + 0.0003_wp rh*2 - 0.0022_wp &
6658	rh - 1.1305_wp
6659	ENDIF
6660
6661	IF ( nitric_acid > 0.0_wp ) THEN
6662	hno3_h2so4 = - 16.382_wp * rh*5 + 46.677_wp rh*4 - 54.149_wp rh*3 + 34.36_wp &
6663	rh*2 - 12.54_wp rh + 2.1368_wp
6664	ENDIF
6665
6666	IF ( hydrochloric_acid > 0.0_wp ) THEN
6667	hcl_h2so4 = - 14.409_wp * rh*5 + 42.804_wp rh*4 - 47.24_wp rh*3 + 24.668_wp &
6668	rh*2 - 5.8015_wp rh + 0.084627_wp
6669	ENDIF
6670
6671	IF ( ammonium_sulphate > 0.0_wp ) THEN
6672	nh42so4_h2so4 = 66.71_wp * rh*5 - 187.5_wp rh*4 + 210.57_wp rh*3 - 121.04_wp &
6673	rh*2 + 39.182_wp rh - 8.0606_wp
6674	ENDIF
6675
6676	IF ( ammonium_nitrate > 0.0_wp ) THEN
6677	nh4no3_h2so4 = - 22.532_wp * rh*4 + 66.615_wp rh*3 - 74.647_wp rh*2 + 37.638_wp &
6678	rh - 6.9711_wp
6679	ENDIF
6680
6681	IF ( ammonium_chloride > 0.0_wp ) THEN
6682	IF ( rh >= 0.1_wp .AND. rh < 0.2_wp ) THEN
6683	nh4cl_h2so4 = - 0.32089_wp * rh + 0.57738_wp
6684	ELSEIF ( rh >= 0.2_wp .AND. rh < 0.9_wp ) THEN
6685	nh4cl_h2so4 = 18.089_wp * rh*5 - 51.083_wp rh*4 + 50.32_wp rh*3 - 17.012_wp &
6686	rh*2 - 0.93435_wp rh + 1.0548_wp
6687	ELSEIF ( rh >= 0.9_wp .AND. rh < 0.99_wp ) THEN
6688	nh4cl_h2so4 = - 1.5749_wp * rh + 1.7002_wp
6689	ENDIF
6690	ENDIF
6691
6692	IF ( sodium_sulphate > 0.0_wp ) THEN
6693	na2so4_h2so4 = 29.843_wp * rh*4 - 69.417_wp rh*3 + 61.507_wp rh*2 - 29.874_wp &
6694	rh + 7.7556_wp
6695	ENDIF
6696
6697	IF ( sodium_nitrate > 0.0_wp ) THEN
6698	nano3_h2so4 = - 122.37_wp * rh*6 + 427.43_wp rh*5 - 604.68_wp rh*4 + 443.08_wp &
6699	rh*3 - 178.61_wp rh*2 + 37.242_wp rh - 1.9564_wp
6700	ENDIF
6701
6702	IF ( sodium_chloride > 0.0_wp ) THEN
6703	nacl_h2so4 = - 40.288_wp * rh*5 + 115.61_wp rh*4 - 129.99_wp rh*3 + 72.652_wp &
6704	rh*2 - 22.124_wp rh + 4.2676_wp
6705	ENDIF
6706
6707	ln_h2so4_act = binary_h2so4 + nitric_acid_eq_frac * hno3_h2so4 + &
6708	hydrochloric_acid_eq_frac * hcl_h2so4 + &
6709	ammonium_sulphate_eq_frac * nh42so4_h2so4 + &
6710	ammonium_nitrate_eq_frac * nh4no3_h2so4 + &
6711	ammonium_chloride_eq_frac * nh4cl_h2so4 + &
6712	sodium_sulphate_eq_frac * na2so4_h2so4 + &
6713	sodium_nitrate_eq_frac * nano3_h2so4 + sodium_chloride_eq_frac * nacl_h2so4
6714
6715	gamma_h2so4 = EXP( ln_h2so4_act ) ! molal activity coefficient
6716	!
6717	!-- Export activity coefficients
6718	IF ( gamma_h2so4 > 1.0E-10_wp ) THEN
6719	gamma_out(4) = gamma_hhso4**2 / gamma_h2so4
6720	ENDIF
6721	IF ( gamma_hhso4 > 1.0E-10_wp ) THEN
6722	gamma_out(5) = gamma_h2so43 / gamma_hhso42
6723	ENDIF
6724	!
6725	!-- Ionic activity coefficient product
6726	act_product = gamma_h2so43 / gamma_hhso42
6727	!
6728	!-- Solve the quadratic equation (i.e. x in ax**2 + bx + c = 0)
6729	a = 1.0_wp
6730	b = -1.0_wp * ( ions(4) + ions(1) + ( ( water_total * 18.0E-3_wp ) / &
6731	( 99.0_wp * act_product ) ) )
6732	c = ions(4) * ions(1)
6733	root1 = ( ( -1.0_wp * b ) + ( ( ( b*2 ) - 4.0_wp a * c )*0.5_wp ) ) / ( 2.0_wp a )
6734	root2 = ( ( -1.0_wp * b ) - ( ( ( b*2 ) - 4.0_wp a * c) *0.5_wp ) ) / ( 2.0_wp a )
6735
6736	IF ( root1 > ions(1) .OR. root1 < 0.0_wp ) THEN
6737	root1 = 0.0_wp
6738	ENDIF
6739
6740	IF ( root2 > ions(1) .OR. root2 < 0.0_wp ) THEN
6741	root2 = 0.0_wp
6742	ENDIF
6743	!
6744	!-- Calculate the new hydrogen ion, bisulphate ion and sulphate ion
6745	!-- concentration
6746	h_real = ions(1)
6747	so4_real = ions(4)
6748	hso4_real = MAX( root1, root2 )
6749	h_real = ions(1) - hso4_real
6750	so4_real = ions(4) - hso4_real
6751	!
6752	!-- Recalculate ion molalities
6753	ions_mol(1) = h_real / ( water_total * 18.01528E-3_wp ) ! H+
6754	ions_mol(4) = so4_real / ( water_total * 18.01528E-3_wp ) ! SO4(2-)
6755	ions_mol(5) = hso4_real / ( water_total * 18.01528E-3_wp ) ! HSO4(2-)
6756
6757	h_out = h_real
6758	hso4_out = hso4_real
6759	so4_out = so4_real
6760
6761	ELSE
6762	h_out = ions(1)
6763	hso4_out = 0.0_wp
6764	so4_out = ions(4)
6765	ENDIF
6766
6767	!
6768	!-- 4) ACTIVITY COEFFICIENTS -for vapour pressures of HNO3,HCL and NH3
6769	!
6770	!-- This section evaluates activity coefficients and vapour pressures using the water content
6771	!-- calculated above) for each inorganic condensing species: a - HNO3, b - NH3, c - HCL.
6772	!-- The following procedure is used: Zaveri et al (2005) found that one could express the variation
6773	!-- of activity coefficients linearly in log-space if equivalent mole fractions were used.
6774	!-- So, by a taylor series expansion LOG( activity coefficient ) =
6775	!-- LOG( binary activity coefficient at a given RH ) +
6776	!-- (equivalent mole fraction compound A) *
6777	!-- ('interaction' parameter between A and condensing species) +
6778	!-- equivalent mole fraction compound B) *
6779	!-- ('interaction' parameter between B and condensing species).
6780	!-- Here, the interaction parameters have been fit to ADDEM by searching the whole compositon space
6781	!-- and fit usign the Levenberg-Marquardt non-linear least squares algorithm.
6782	!
6783	!-- They are given as a function of RH and vary with complexity ranging from linear to 5th order
6784	!-- polynomial expressions, the binary activity coefficients were calculated using AIM online.
6785	!-- NOTE: for NH3, no binary activity coefficient was used and the data were fit to the ratio of the
6786	!-- activity coefficients for the ammonium and hydrogen ions. Once the activity coefficients are
6787	!-- obtained the vapour pressure can be easily calculated using tabulated equilibrium constants
6788	!-- (referenced). This procedure differs from that of Zaveri et al (2005) in that it is not assumed
6789	!-- one can carry behaviour from binary mixtures in multicomponent systems. To this end we have fit
6790	!-- the 'interaction' parameters explicitly to a general inorganic equilibrium model
6791	!-- (ADDEM - Topping et al. 2005a,b). Such parameters take into account bisulphate ion dissociation
6792	!-- and water content. This also allows us to consider one regime for all composition space, rather
6793	!-- than defining sulphate rich and sulphate poor regimes.
6794	!-- NOTE: The flags "binary_case" and "full_complexity" are not used in this prototype. They are
6795	!-- used for simplification of the fit expressions when using limited composition regions.
6796	!
6797	!-- a) - ACTIVITY COEFF/VAPOUR PRESSURE - HNO3
6798	IF ( ions(1) > 0.0_wp .AND. ions(6) > 0.0_wp ) THEN
6799	binary_case = 1
6800	IF ( rh > 0.1_wp .AND. rh < 0.98_wp ) THEN
6801	IF ( binary_case == 1 ) THEN
6802	binary_hno3 = 1.8514_wp * rh*3 - 4.6991_wp rh*2 + 1.5514_wp rh + 0.90236_wp
6803	ELSEIF ( binary_case == 2 ) THEN
6804	binary_hno3 = - 1.1751_wp * ( rh*2 ) - 0.53794_wp rh + 1.2808_wp
6805	ENDIF
6806	ELSEIF ( rh >= 0.98_wp .AND. rh < 0.9999_wp ) THEN
6807	binary_hno3 = 1244.69635941351_wp * rh*3 - 2613.93941099991_wp rh**2 + &
6808	1525.0684974546_wp * rh -155.946764059316_wp
6809	ENDIF
6810	!
6811	!-- Contributions from other solutes
6812	full_complexity = 1
6813	IF ( hydrochloric_acid > 0.0_wp ) THEN ! HCL
6814	IF ( full_complexity == 1 .OR. rh < 0.4_wp ) THEN
6815	hcl_hno3 = 16.051_wp * rh*4 - 44.357_wp rh*3 + 45.141_wp rh*2 - 21.638_wp &
6816	rh + 4.8182_wp
6817	ELSEIF ( full_complexity == 0 .AND. rh > 0.4_wp ) THEN
6818	hcl_hno3 = - 1.5833_wp * rh + 1.5569_wp
6819	ENDIF
6820	ENDIF
6821
6822	IF ( sulphuric_acid > 0.0_wp ) THEN ! H2SO4
6823	IF ( full_complexity == 1 .OR. rh < 0.4_wp ) THEN
6824	h2so4_hno3 = - 3.0849_wp * rh*3 + 5.9609_wp rh*2 - 4.468_wp rh + 1.5658_wp
6825	ELSEIF ( full_complexity == 0 .AND. rh > 0.4_wp ) THEN
6826	h2so4_hno3 = - 0.93473_wp * rh + 0.9363_wp
6827	ENDIF
6828	ENDIF
6829
6830	IF ( ammonium_sulphate > 0.0_wp ) THEN ! NH42SO4
6831	nh42so4_hno3 = 16.821_wp * rh*3 - 28.391_wp rh*2 + 18.133_wp rh - 6.7356_wp
6832	ENDIF
6833
6834	IF ( ammonium_nitrate > 0.0_wp ) THEN ! NH4NO3
6835	nh4no3_hno3 = 11.01_wp * rh*3 - 21.578_wp rh*2 + 14.808_wp rh - 4.2593_wp
6836	ENDIF
6837
6838	IF ( ammonium_chloride > 0.0_wp ) THEN ! NH4Cl
6839	IF ( full_complexity == 1 .OR. rh <= 0.4_wp ) THEN
6840	nh4cl_hno3 = - 1.176_wp * rh*3 + 5.0828_wp rh*2 - 3.8792_wp rh - 0.05518_wp
6841	ELSEIF ( full_complexity == 0 .AND. rh > 0.4_wp ) THEN
6842	nh4cl_hno3 = 2.6219_wp * rh*2 - 2.2609_wp rh - 0.38436_wp
6843	ENDIF
6844	ENDIF
6845
6846	IF ( sodium_sulphate > 0.0_wp ) THEN ! Na2SO4
6847	na2so4_hno3 = 35.504_wp * rh*4 - 80.101_wp rh*3 + 67.326_wp rh*2 - 28.461_wp &
6848	rh + 5.6016_wp
6849	ENDIF
6850
6851	IF ( sodium_nitrate > 0.0_wp ) THEN ! NaNO3
6852	IF ( full_complexity == 1 .OR. rh <= 0.4_wp ) THEN
6853	nano3_hno3 = 23.659_wp * rh*5 - 66.917_wp rh*4 + 74.686_wp rh*3 - 40.795_wp &
6854	rh*2 + 10.831_wp rh - 1.4701_wp
6855	ELSEIF ( full_complexity == 0 .AND. rh > 0.4_wp ) THEN
6856	nano3_hno3 = 14.749_wp * rh*4 - 35.237_wp rh*3 + 31.196_wp rh*2 - 12.076_wp &
6857	rh + 1.3605_wp
6858	ENDIF
6859	ENDIF
6860
6861	IF ( sodium_chloride > 0.0_wp ) THEN ! NaCl
6862	IF ( full_complexity == 1 .OR. rh <= 0.4_wp ) THEN
6863	nacl_hno3 = 13.682_wp * rh*4 - 35.122_wp rh*3 + 33.397_wp rh*2 - 14.586_wp &
6864	rh + 2.6276_wp
6865	ELSEIF ( full_complexity == 0 .AND. rh > 0.4_wp ) THEN
6866	nacl_hno3 = 1.1882_wp * rh*3 - 1.1037_wp rh*2 - 0.7642_wp rh + 0.6671_wp
6867	ENDIF
6868	ENDIF
6869
6870	ln_hno3_act = binary_hno3 + hydrochloric_acid_eq_frac * hcl_hno3 + &
6871	sulphuric_acid_eq_frac * h2so4_hno3 + &
6872	ammonium_sulphate_eq_frac * nh42so4_hno3 + &
6873	ammonium_nitrate_eq_frac * nh4no3_hno3 + &
6874	ammonium_chloride_eq_frac * nh4cl_hno3 + &
6875	sodium_sulphate_eq_frac * na2so4_hno3 + &
6876	sodium_nitrate_eq_frac * nano3_hno3 + sodium_chloride_eq_frac * nacl_hno3
6877
6878	gamma_hno3 = EXP( ln_hno3_act ) ! Molal activity coefficient of HNO3
6879	gamma_out(1) = gamma_hno3
6880	!
6881	!-- Partial pressure calculation
6882	!-- k_hno3 = 2.51 * ( 10**6 )
6883	!-- k_hno3 = 2.628145923d6 !< calculated by AIM online (Clegg et al 1998) after Chameides (1984)
6884	k_hno3 = 2.6E6_wp * EXP( 8700.0_wp * henrys_temp_dep )
6885	press_hno3 = ( ions_mol(1) * ions_mol(6) * ( gamma_hno3**2 ) ) / k_hno3
6886	ENDIF
6887	!
6888	!-- b) - ACTIVITY COEFF/VAPOUR PRESSURE - NH3
6889	!-- Follow the two solute approach of Zaveri et al. (2005)
6890	IF ( ions(2) > 0.0_wp .AND. ions_mol(1) > 0.0_wp ) THEN
6891	!
6892	!-- NH4HSO4:
6893	binary_nh4hso4 = 56.907_wp * rh*6 - 155.32_wp rh*5 + 142.94_wp rh*4 - 32.298_wp &
6894	rh*3 - 27.936_wp rh*2 + 19.502_wp rh - 4.2618_wp
6895	IF ( nitric_acid > 0.0_wp) THEN ! HNO3
6896	hno3_nh4hso4 = 104.8369_wp * rh*8 - 288.8923_wp rh*7 + 129.3445_wp rh**6 + &
6897	373.0471_wp * rh*5 - 571.0385_wp rh*4 + 326.3528_wp rh**3 - &
6898	74.169_wp * rh*2 - 2.4999_wp rh + 3.17_wp
6899	ENDIF
6900
6901	IF ( hydrochloric_acid > 0.0_wp) THEN ! HCL
6902	hcl_nh4hso4 = - 7.9133_wp * rh*8 + 126.6648_wp rh*7 - 460.7425_wp rh**6 + &
6903	731.606_wp * rh*5 - 582.7467_wp rh*4 + 216.7197_wp rh**3 - &
6904	11.3934_wp * rh*2 - 17.7728_wp rh + 5.75_wp
6905	ENDIF
6906
6907	IF ( sulphuric_acid > 0.0_wp) THEN ! H2SO4
6908	h2so4_nh4hso4 = 195.981_wp * rh*8 - 779.2067_wp rh*7 + 1226.3647_wp rh**6 - &
6909	964.0261_wp * rh*5 + 391.7911_wp rh*4 - 84.1409_wp rh**3 + &
6910	20.0602_wp * rh*2 - 10.2663_wp rh + 3.5817_wp
6911	ENDIF
6912
6913	IF ( ammonium_sulphate > 0.0_wp) THEN ! NH42SO4
6914	nh42so4_nh4hso4 = 617.777_wp * rh*8 - 2547.427_wp rh*7 + 4361.6009_wp rh**6 - &
6915	4003.162_wp * rh*5 + 2117.8281_wp rh*4 - 640.0678_wp rh**3 + &
6916	98.0902_wp * rh*2 - 2.2615_wp rh - 2.3811_wp
6917	ENDIF
6918
6919	IF ( ammonium_nitrate > 0.0_wp) THEN ! NH4NO3
6920	nh4no3_nh4hso4 = - 104.4504_wp * rh*8 + 539.5921_wp rh*7 - 1157.0498_wp rh**6 + &
6921	1322.4507_wp * rh*5 - 852.2475_wp rh*4 + 298.3734_wp rh**3 - &
6922	47.0309_wp * rh*2 + 1.297_wp rh - 0.8029_wp
6923	ENDIF
6924
6925	IF ( ammonium_chloride > 0.0_wp) THEN ! NH4Cl
6926	nh4cl_nh4hso4 = 258.1792_wp * rh*8 - 1019.3777_wp rh*7 + 1592.8918_wp rh**6 - &
6927	1221.0726_wp * rh*5 + 442.2548_wp rh*4 - 43.6278_wp rh**3 - &
6928	7.5282_wp * rh*2 - 3.8459_wp rh + 2.2728_wp
6929	ENDIF
6930
6931	IF ( sodium_sulphate > 0.0_wp) THEN ! Na2SO4
6932	na2so4_nh4hso4 = 225.4238_wp * rh*8 - 732.4113_wp rh*7 + 843.7291_wp rh**6 - &
6933	322.7328_wp * rh*5 - 88.6252_wp rh*4 + 72.4434_wp rh**3 + &
6934	22.9252_wp * rh*2 - 25.3954_wp rh + 4.6971_wp
6935	ENDIF
6936
6937	IF ( sodium_nitrate > 0.0_wp) THEN ! NaNO3
6938	nano3_nh4hso4 = 96.1348_wp * rh*8 - 341.6738_wp rh*7 + 406.5314_wp rh**6 - &
6939	98.5777_wp * rh*5 - 172.8286_wp rh*4 + 149.3151_wp rh**3 - &
6940	38.9998_wp * rh*2 - 0.2251_wp rh + 0.4953_wp
6941	ENDIF
6942
6943	IF ( sodium_chloride > 0.0_wp) THEN ! NaCl
6944	nacl_nh4hso4 = 91.7856_wp * rh*8 - 316.6773_wp rh*7 + 358.2703_wp rh**6 - &
6945	68.9142_wp * rh*5 - 156.5031_wp rh*4 + 116.9592_wp rh**3 - &
6946	22.5271_wp * rh*2 - 3.7716_wp rh + 1.56_wp
6947	ENDIF
6948
6949	ln_nh4hso4_act = binary_nh4hso4 + nitric_acid_eq_frac * hno3_nh4hso4 + &
6950	hydrochloric_acid_eq_frac * hcl_nh4hso4 + &
6951	sulphuric_acid_eq_frac * h2so4_nh4hso4 + &
6952	ammonium_sulphate_eq_frac * nh42so4_nh4hso4 + &
6953	ammonium_nitrate_eq_frac * nh4no3_nh4hso4 + &
6954	ammonium_chloride_eq_frac * nh4cl_nh4hso4 + &
6955	sodium_sulphate_eq_frac * na2so4_nh4hso4 + &
6956	sodium_nitrate_eq_frac * nano3_nh4hso4 + &
6957	sodium_chloride_eq_frac * nacl_nh4hso4
6958
6959	gamma_nh4hso4 = EXP( ln_nh4hso4_act ) ! molal act. coefficient of NH4HSO4
6960	!
6961	!-- Molal activity coefficient of NO3-
6962	gamma_out(6) = gamma_nh4hso4
6963	!
6964	!-- Molal activity coefficient of NH4+
6965	gamma_nh3 = gamma_nh4hso42 / gamma_hhso42
6966	gamma_out(3) = gamma_nh3
6967	!
6968	!-- This actually represents the ratio of the ammonium to hydrogen ion activity coefficients
6969	!-- (see Zaveri paper) - multiply this by the ratio of the ammonium to hydrogen ion molality and
6970	!-- the ratio of appropriate equilibrium constants
6971	!
6972	!-- Equilibrium constants
6973	!-- k_h = 57.64d0 ! Zaveri et al. (2005)
6974	k_h = 5.8E1_wp * EXP( 4085.0_wp * henrys_temp_dep ) ! after Chameides (1984)
6975	!-- k_nh4 = 1.81E-5_wp ! Zaveri et al. (2005)
6976	k_nh4 = 1.7E-5_wp * EXP( -4325.0_wp * henrys_temp_dep ) ! Chameides (1984)
6977	!-- k_h2o = 1.01E-14_wp ! Zaveri et al (2005)
6978	k_h2o = 1.E-14_wp * EXP( -6716.0_wp * henrys_temp_dep ) ! Chameides (1984)
6979	!
6980	molality_ratio_nh3 = ions_mol(2) / ions_mol(1)
6981	!
6982	!-- Partial pressure calculation
6983	press_nh3 = molality_ratio_nh3 * gamma_nh3 * ( k_h2o / ( k_h * k_nh4 ) )
6984
6985	ENDIF
6986	!
6987	!-- c) - ACTIVITY COEFF/VAPOUR PRESSURE - HCL
6988	IF ( ions(1) > 0.0_wp .AND. ions(7) > 0.0_wp ) THEN
6989	binary_case = 1
6990	IF ( rh > 0.1_wp .AND. rh < 0.98 ) THEN
6991	IF ( binary_case == 1 ) THEN
6992	binary_hcl = - 5.0179_wp * rh*3 + 9.8816_wp rh*2 - 10.789_wp rh + 5.4737_wp
6993	ELSEIF ( binary_case == 2 ) THEN
6994	binary_hcl = - 4.6221_wp * rh + 4.2633_wp
6995	ENDIF
6996	ELSEIF ( rh >= 0.98_wp .AND. rh < 0.9999_wp ) THEN
6997	binary_hcl = 775.6111008626_wp * rh*3 - 2146.01320888771_wp rh**2 + &
6998	1969.01979670259_wp * rh - 598.878230033926_wp
6999	ENDIF
7000	ENDIF
7001
7002	IF ( nitric_acid > 0.0_wp ) THEN ! HNO3
7003	IF ( full_complexity == 1 .OR. rh <= 0.4_wp ) THEN
7004	hno3_hcl = 9.6256_wp * rh*4 - 26.507_wp rh*3 + 27.622_wp rh*2 - 12.958_wp rh + &
7005	2.2193_wp
7006	ELSEIF ( full_complexity == 0 .AND. rh > 0.4_wp ) THEN
7007	hno3_hcl = 1.3242_wp * rh*2 - 1.8827_wp rh + 0.55706_wp
7008	ENDIF
7009	ENDIF
7010
7011	IF ( sulphuric_acid > 0.0_wp ) THEN ! H2SO4
7012	IF ( full_complexity == 1 .OR. rh <= 0.4 ) THEN
7013	h2so4_hcl = 1.4406_wp * rh*3 - 2.7132_wp rh*2 + 1.014_wp rh + 0.25226_wp
7014	ELSEIF ( full_complexity == 0 .AND. rh > 0.4_wp ) THEN
7015	h2so4_hcl = 0.30993_wp * rh*2 - 0.99171_wp rh + 0.66913_wp
7016	ENDIF
7017	ENDIF
7018
7019	IF ( ammonium_sulphate > 0.0_wp ) THEN ! NH42SO4
7020	nh42so4_hcl = 22.071_wp * rh*3 - 40.678_wp rh*2 + 27.893_wp rh - 9.4338_wp
7021	ENDIF
7022
7023	IF ( ammonium_nitrate > 0.0_wp ) THEN ! NH4NO3
7024	nh4no3_hcl = 19.935_wp * rh*3 - 42.335_wp rh*2 + 31.275_wp rh - 8.8675_wp
7025	ENDIF
7026
7027	IF ( ammonium_chloride > 0.0_wp ) THEN ! NH4Cl
7028	IF ( full_complexity == 1 .OR. rh <= 0.4_wp ) THEN
7029	nh4cl_hcl = 2.8048_wp * rh*3 - 4.3182_wp rh*2 + 3.1971_wp rh - 1.6824_wp
7030	ELSEIF ( full_complexity == 0 .AND. rh > 0.4_wp ) THEN
7031	nh4cl_hcl = 1.2304_wp * rh*2 - 0.18262_wp rh - 1.0643_wp
7032	ENDIF
7033	ENDIF
7034
7035	IF ( sodium_sulphate > 0.0_wp ) THEN ! Na2SO4
7036	na2so4_hcl = 36.104_wp * rh*4 - 78.658_wp rh*3 + 63.441_wp rh*2 - 26.727_wp rh + &
7037	5.7007_wp
7038	ENDIF
7039
7040	IF ( sodium_nitrate > 0.0_wp ) THEN ! NaNO3
7041	IF ( full_complexity == 1 .OR. rh <= 0.4_wp ) THEN
7042	nano3_hcl = 54.471_wp * rh*5 - 159.42_wp rh*4 + 180.25_wp rh*3 - 98.176_wp rh**2&
7043	+ 25.309_wp * rh - 2.4275_wp
7044	ELSEIF ( full_complexity == 0 .AND. rh > 0.4_wp ) THEN
7045	nano3_hcl = 21.632_wp * rh*4 - 53.088_wp rh*3 + 47.285_wp rh*2 - 18.519_wp rh &
7046	+ 2.6846_wp
7047	ENDIF
7048	ENDIF
7049
7050	IF ( sodium_chloride > 0.0_wp ) THEN ! NaCl
7051	IF ( full_complexity == 1 .OR. rh <= 0.4_wp ) THEN
7052	nacl_hcl = 5.4138_wp * rh*4 - 12.079_wp rh*3 + 9.627_wp rh*2 - 3.3164_wp rh + &
7053	0.35224_wp
7054	ELSEIF ( full_complexity == 0 .AND. rh > 0.4_wp ) THEN
7055	nacl_hcl = 2.432_wp * rh*3 - 4.3453_wp rh*2 + 2.3834_wp rh - 0.4762_wp
7056	ENDIF
7057	ENDIF
7058
7059	ln_HCL_act = binary_hcl + nitric_acid_eq_frac * hno3_hcl + sulphuric_acid_eq_frac * h2so4_hcl +&
7060	ammonium_sulphate_eq_frac * nh42so4_hcl + ammonium_nitrate_eq_frac * nh4no3_hcl + &
7061	ammonium_chloride_eq_frac * nh4cl_hcl + sodium_sulphate_eq_frac * na2so4_hcl + &
7062	sodium_nitrate_eq_frac * nano3_hcl + sodium_chloride_eq_frac * nacl_hcl
7063
7064	gamma_hcl = EXP( ln_HCL_act ) ! Molal activity coefficient
7065	gamma_out(2) = gamma_hcl
7066	!
7067	!-- Equilibrium constant after Wagman et al. (1982) (and NIST database)
7068	k_hcl = 2E6_wp * EXP( 9000.0_wp * henrys_temp_dep )
7069
7070	press_hcl = ( ions_mol(1) * ions_mol(7) * gamma_hcl**2 ) / k_hcl
7071	!
7072	!-- 5) Ion molility output
7073	mols_out = ions_mol
7074
7075	END SUBROUTINE inorganic_pdfite
7076
7077	!------------------------------------------------------------------------------!
7078	! Description:
7079	! ------------
7080	!> Update the particle size distribution. Put particles into corrects bins.
7081	!>
7082	!> Moving-centre method assumed, i.e. particles are allowed to grow to their
7083	!> exact size as long as they are not crossing the fixed diameter bin limits.
7084	!> If the particles in a size bin cross the lower or upper diameter limit, they
7085	!> are all moved to the adjacent diameter bin and their volume is averaged with
7086	!> the particles in the new bin, which then get a new diameter.
7087	!
7088	!> Moving-centre method minimises numerical diffusion.
7089	!------------------------------------------------------------------------------!
7090	SUBROUTINE distr_update( paero )
7091
7092	IMPLICIT NONE
7093
7094	INTEGER(iwp) :: ib !< loop index
7095	INTEGER(iwp) :: mm !< loop index
7096	INTEGER(iwp) :: counti !< number of while loops
7097
7098	LOGICAL :: within_bins !< logical (particle belongs to the bin?)
7099
7100	REAL(wp) :: znfrac !< number fraction to be moved to the larger bin
7101	REAL(wp) :: zvfrac !< volume fraction to be moved to the larger bin
7102	REAL(wp) :: zvexc !< Volume in the grown bin which exceeds the bin upper limit
7103	REAL(wp) :: zvihi !< particle volume at the high end of the bin
7104	REAL(wp) :: zvilo !< particle volume at the low end of the bin
7105	REAL(wp) :: zvpart !< particle volume (m3)
7106	REAL(wp) :: zvrat !< volume ratio of a size bin
7107
7108	real(wp), dimension(nbins_aerosol) :: dummy
7109
7110	TYPE(t_section), DIMENSION(nbins_aerosol), INTENT(inout) :: paero !< aerosol properties
7111
7112	zvpart = 0.0_wp
7113	zvfrac = 0.0_wp
7114	within_bins = .FALSE.
7115
7116	dummy = paero(:)%numc
7117	!
7118	!-- Check if the volume of the bin is within bin limits after update
7119	counti = 0
7120	DO WHILE ( .NOT. within_bins )
7121	within_bins = .TRUE.
7122	!
7123	!-- Loop from larger to smaller size bins
7124	DO ib = end_subrange_2b-1, start_subrange_1a, -1
7125	mm = 0
7126	IF ( paero(ib)%numc > nclim ) THEN
7127	zvpart = 0.0_wp
7128	zvfrac = 0.0_wp
7129
7130	IF ( ib == end_subrange_2a ) CYCLE
7131	!
7132	!-- Dry volume
7133	zvpart = SUM( paero(ib)%volc(1:7) ) / paero(ib)%numc
7134	!
7135	!-- Smallest bin cannot decrease
7136	IF ( paero(ib)%vlolim > zvpart .AND. ib == start_subrange_1a ) CYCLE
7137	!
7138	!-- Decreasing bins
7139	IF ( paero(ib)%vlolim > zvpart ) THEN
7140	mm = ib - 1
7141	IF ( ib == start_subrange_2b ) mm = end_subrange_1a ! 2b goes to 1a
7142
7143	paero(mm)%numc = paero(mm)%numc + paero(ib)%numc
7144	paero(ib)%numc = 0.0_wp
7145	paero(mm)%volc(:) = paero(mm)%volc(:) + paero(ib)%volc(:)
7146	paero(ib)%volc(:) = 0.0_wp
7147	CYCLE
7148	ENDIF
7149	!
7150	!-- If size bin has not grown, cycle.
7151	!-- Changed by Mona: compare to the arithmetic mean volume, as done originally. Now
7152	!-- particle volume is derived from the geometric mean diameter, not arithmetic (see
7153	!-- SUBROUTINE set_sizebins).
7154	IF ( zvpart <= api6 * ( ( aero(ib)%vhilim + aero(ib)%vlolim ) / ( 2.0_wp * api6 ) ) ) &
7155	CYCLE
7156	!
7157	!-- Avoid precision problems
7158	IF ( ABS( zvpart - api6 * paero(ib)%dmid**3 ) < 1.0E-35_wp ) CYCLE
7159	!
7160	!-- Volume ratio of the size bin
7161	zvrat = paero(ib)%vhilim / paero(ib)%vlolim
7162	!
7163	!-- Particle volume at the low end of the bin
7164	zvilo = 2.0_wp * zvpart / ( 1.0_wp + zvrat )
7165	!
7166	!-- Particle volume at the high end of the bin
7167	zvihi = zvrat * zvilo
7168	!
7169	!-- Volume in the grown bin which exceeds the bin upper limit
7170	zvexc = 0.5_wp * ( zvihi + paero(ib)%vhilim )
7171	!
7172	!-- Number fraction to be moved to the larger bin
7173	znfrac = MIN( 1.0_wp, ( zvihi - paero(ib)%vhilim) / ( zvihi - zvilo ) )
7174	!
7175	!-- Volume fraction to be moved to the larger bin
7176	zvfrac = MIN( 0.99_wp, znfrac * zvexc / zvpart )
7177	IF ( zvfrac < 0.0_wp ) THEN
7178	message_string = 'Error: zvfrac < 0'
7179	CALL message( 'salsa_mod: distr_update', 'PA0624', 1, 2, 0, 6, 0 )
7180	ENDIF
7181	!
7182	!-- Update bin
7183	mm = ib + 1
7184	!
7185	!-- Volume (cm3/cm3)
7186	paero(mm)%volc(:) = paero(mm)%volc(:) + znfrac * paero(ib)%numc * zvexc * &
7187	paero(ib)%volc(:) / SUM( paero(ib)%volc(1:7) )
7188	paero(ib)%volc(:) = paero(ib)%volc(:) - znfrac * paero(ib)%numc * zvexc * &
7189	paero(ib)%volc(:) / SUM( paero(ib)%volc(1:7) )
7190
7191	!-- Number concentration (#/m3)
7192	paero(mm)%numc = paero(mm)%numc + znfrac * paero(ib)%numc
7193	paero(ib)%numc = paero(ib)%numc * ( 1.0_wp - znfrac )
7194
7195	ENDIF ! nclim
7196
7197	IF ( paero(ib)%numc > nclim ) THEN
7198	zvpart = SUM( paero(ib)%volc(1:7) ) / paero(ib)%numc ! Note: dry volume!
7199	within_bins = ( paero(ib)%vlolim < zvpart .AND. zvpart < paero(ib)%vhilim )
7200	ENDIF
7201
7202	ENDDO ! - ib
7203
7204	counti = counti + 1
7205	IF ( counti > 100 ) THEN
7206	message_string = 'Error: Aerosol bin update not converged'
7207	CALL message( 'salsa_mod: distr_update', 'PA0625', 1, 2, 0, 6, 0 )
7208	ENDIF
7209
7210	ENDDO ! - within bins
7211
7212	END SUBROUTINE distr_update
7213
7214	!------------------------------------------------------------------------------!
7215	! Description:
7216	! ------------
7217	!> salsa_diagnostics: Update properties for the current timestep:
7218	!>
7219	!> Juha Tonttila, FMI, 2014
7220	!> Tomi Raatikainen, FMI, 2016
7221	!------------------------------------------------------------------------------!
7222	SUBROUTINE salsa_diagnostics( i, j )
7223
7224	USE cpulog, &
7225	ONLY: cpu_log, log_point_s
7226
7227	IMPLICIT NONE
7228
7229	INTEGER(iwp) :: ib !<
7230	INTEGER(iwp) :: ic !<
7231	INTEGER(iwp) :: icc !<
7232	INTEGER(iwp) :: ig !<
7233	INTEGER(iwp) :: k !<
7234
7235	INTEGER(iwp), INTENT(in) :: i !<
7236	INTEGER(iwp), INTENT(in) :: j !<
7237
7238	REAL(wp), DIMENSION(nzb:nzt+1) :: flag !< flag to mask topography
7239	REAL(wp), DIMENSION(nzb:nzt+1) :: flag_zddry !< flag to mask zddry
7240	REAL(wp), DIMENSION(nzb:nzt+1) :: in_adn !< air density (kg/m3)
7241	REAL(wp), DIMENSION(nzb:nzt+1) :: in_p !< pressure
7242	REAL(wp), DIMENSION(nzb:nzt+1) :: in_t !< temperature (K)
7243	REAL(wp), DIMENSION(nzb:nzt+1) :: mcsum !< sum of mass concentration
7244	REAL(wp), DIMENSION(nzb:nzt+1) :: ppm_to_nconc !< Conversion factor: ppm to #/m3
7245	REAL(wp), DIMENSION(nzb:nzt+1) :: zddry !< particle dry diameter
7246	REAL(wp), DIMENSION(nzb:nzt+1) :: zvol !< particle volume
7247
7248	flag_zddry = 0.0_wp
7249	in_adn = 0.0_wp
7250	in_p = 0.0_wp
7251	in_t = 0.0_wp
7252	ppm_to_nconc = 1.0_wp
7253	zddry = 0.0_wp
7254	zvol = 0.0_wp
7255
7256	!$OMP MASTER
7257	CALL cpu_log( log_point_s(94), 'salsa diagnostics ', 'start' )
7258	!$OMP END MASTER
7259
7260	!
7261	!-- Calculate thermodynamic quantities needed in SALSA
7262	CALL salsa_thrm_ij( i, j, p_ij=in_p, temp_ij=in_t, adn_ij=in_adn )
7263	!
7264	!-- Calculate conversion factors for gas concentrations
7265	ppm_to_nconc = for_ppm_to_nconc * in_p / in_t
7266	!
7267	!-- Predetermine flag to mask topography
7268	flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_0(:,j,i), 0 ) )
7269
7270	DO ib = 1, nbins_aerosol ! aerosol size bins
7271	!
7272	!-- Remove negative values
7273	aerosol_number(ib)%conc(:,j,i) = MAX( nclim, aerosol_number(ib)%conc(:,j,i) ) * flag
7274	!
7275	!-- Calculate total mass concentration per bin
7276	mcsum = 0.0_wp
7277	DO ic = 1, ncomponents_mass
7278	icc = ( ic - 1 ) * nbins_aerosol + ib
7279	mcsum = mcsum + aerosol_mass(icc)%conc(:,j,i) * flag
7280	aerosol_mass(icc)%conc(:,j,i) = MAX( mclim, aerosol_mass(icc)%conc(:,j,i) ) * flag
7281	ENDDO
7282	!
7283	!-- Check that number and mass concentration match qualitatively
7284	IF ( ANY( aerosol_number(ib)%conc(:,j,i) > nclim .AND. mcsum <= 0.0_wp ) ) THEN
7285	DO k = nzb+1, nzt
7286	IF ( aerosol_number(ib)%conc(k,j,i) >= nclim .AND. mcsum(k) <= 0.0_wp ) THEN
7287	aerosol_number(ib)%conc(k,j,i) = nclim * flag(k)
7288	DO ic = 1, ncomponents_mass
7289	icc = ( ic - 1 ) * nbins_aerosol + ib
7290	aerosol_mass(icc)%conc(k,j,i) = mclim * flag(k)
7291	ENDDO
7292	ENDIF
7293	ENDDO
7294	ENDIF
7295	!
7296	!-- Update aerosol particle radius
7297	CALL bin_mixrat( 'dry', ib, i, j, zvol )
7298	zvol = zvol / arhoh2so4 ! Why on sulphate?
7299	!
7300	!-- Particles smaller then 0.1 nm diameter are set to zero
7301	zddry = ( zvol / MAX( nclim, aerosol_number(ib)%conc(:,j,i) ) / api6 )**0.33333333_wp
7302	flag_zddry = MERGE( 1.0_wp, 0.0_wp, ( zddry < 1.0E-10_wp .AND. &
7303	aerosol_number(ib)%conc(:,j,i) > nclim ) )
7304	!
7305	!-- Volatile species to the gas phase
7306	IF ( index_so4 > 0 .AND. lscndgas ) THEN
7307	ic = ( index_so4 - 1 ) * nbins_aerosol + ib
7308	IF ( salsa_gases_from_chem ) THEN
7309	ig = gas_index_chem(1)
7310	chem_species(ig)%conc(:,j,i) = chem_species(ig)%conc(:,j,i) + &
7311	aerosol_mass(ic)%conc(:,j,i) * avo * flag_zddry / &
7312	( amh2so4 * ppm_to_nconc ) * flag
7313	ELSE
7314	salsa_gas(1)%conc(:,j,i) = salsa_gas(1)%conc(:,j,i) + aerosol_mass(ic)%conc(:,j,i) / &
7315	amh2so4 * avo * flag_zddry * flag
7316	ENDIF
7317	ENDIF
7318	IF ( index_oc > 0 .AND. lscndgas ) THEN
7319	ic = ( index_oc - 1 ) * nbins_aerosol + ib
7320	IF ( salsa_gases_from_chem ) THEN
7321	ig = gas_index_chem(5)
7322	chem_species(ig)%conc(:,j,i) = chem_species(ig)%conc(:,j,i) + &
7323	aerosol_mass(ic)%conc(:,j,i) * avo * flag_zddry / &
7324	( amoc * ppm_to_nconc ) * flag
7325	ELSE
7326	salsa_gas(5)%conc(:,j,i) = salsa_gas(5)%conc(:,j,i) + aerosol_mass(ic)%conc(:,j,i) / &
7327	amoc * avo * flag_zddry * flag
7328	ENDIF
7329	ENDIF
7330	IF ( index_no > 0 .AND. lscndgas ) THEN
7331	ic = ( index_no - 1 ) * nbins_aerosol + ib
7332	IF ( salsa_gases_from_chem ) THEN
7333	ig = gas_index_chem(2)
7334	chem_species(ig)%conc(:,j,i) = chem_species(ig)%conc(:,j,i) + &
7335	aerosol_mass(ic)%conc(:,j,i) * avo * flag_zddry / &
7336	( amhno3 * ppm_to_nconc ) *flag
7337	ELSE
7338	salsa_gas(2)%conc(:,j,i) = salsa_gas(2)%conc(:,j,i) + aerosol_mass(ic)%conc(:,j,i) / &
7339	amhno3 * avo * flag_zddry * flag
7340	ENDIF
7341	ENDIF
7342	IF ( index_nh > 0 .AND. lscndgas ) THEN
7343	ic = ( index_nh - 1 ) * nbins_aerosol + ib
7344	IF ( salsa_gases_from_chem ) THEN
7345	ig = gas_index_chem(3)
7346	chem_species(ig)%conc(:,j,i) = chem_species(ig)%conc(:,j,i) + &
7347	aerosol_mass(ic)%conc(:,j,i) * avo * flag_zddry / &
7348	( amnh3 * ppm_to_nconc ) *flag
7349	ELSE
7350	salsa_gas(3)%conc(:,j,i) = salsa_gas(3)%conc(:,j,i) + aerosol_mass(ic)%conc(:,j,i) / &
7351	amnh3 * avo * flag_zddry *flag
7352	ENDIF
7353	ENDIF
7354	!
7355	!-- Mass and number to zero (insoluble species and water are lost)
7356	DO ic = 1, ncomponents_mass
7357	icc = ( ic - 1 ) * nbins_aerosol + ib
7358	aerosol_mass(icc)%conc(:,j,i) = MERGE( mclim * flag, aerosol_mass(icc)%conc(:,j,i), &
7359	flag_zddry > 0.0_wp )
7360	ENDDO
7361	aerosol_number(ib)%conc(:,j,i) = MERGE( nclim * flag, aerosol_number(ib)%conc(:,j,i), &
7362	flag_zddry > 0.0_wp )
7363	ra_dry(:,j,i,ib) = MAX( 1.0E-10_wp, 0.5_wp * zddry )
7364
7365	ENDDO
7366	IF ( .NOT. salsa_gases_from_chem ) THEN
7367	DO ig = 1, ngases_salsa
7368	salsa_gas(ig)%conc(:,j,i) = MAX( nclim, salsa_gas(ig)%conc(:,j,i) ) * flag
7369	ENDDO
7370	ENDIF
7371
7372	!$OMP MASTER
7373	CALL cpu_log( log_point_s(94), 'salsa diagnostics ', 'stop' )
7374	!$OMP END MASTER
7375
7376	END SUBROUTINE salsa_diagnostics
7377
7378
7379	!------------------------------------------------------------------------------!
7380	! Description:
7381	! ------------
7382	!> Call for all grid points
7383	!------------------------------------------------------------------------------!
7384	SUBROUTINE salsa_actions( location )
7385
7386
7387	CHARACTER (LEN=*), INTENT(IN) :: location !< call location string
7388
7389	SELECT CASE ( location )
7390
7391	CASE ( 'before_timestep' )
7392
7393	IF ( ws_scheme_sca ) sums_salsa_ws_l = 0.0_wp
7394
7395	CASE DEFAULT
7396	CONTINUE
7397
7398	END SELECT
7399
7400	END SUBROUTINE salsa_actions
7401
7402
7403	!------------------------------------------------------------------------------!
7404	! Description:
7405	! ------------
7406	!> Call for grid points i,j
7407	!------------------------------------------------------------------------------!
7408
7409	SUBROUTINE salsa_actions_ij( i, j, location )
7410
7411
7412	INTEGER(iwp), INTENT(IN) :: i !< grid index in x-direction
7413	INTEGER(iwp), INTENT(IN) :: j !< grid index in y-direction
7414	CHARACTER (LEN=*), INTENT(IN) :: location !< call location string
7415	INTEGER(iwp) :: dummy !< call location string
7416
7417	IF ( salsa ) dummy = i + j
7418
7419	SELECT CASE ( location )
7420
7421	CASE ( 'before_timestep' )
7422
7423	IF ( ws_scheme_sca ) sums_salsa_ws_l = 0.0_wp
7424
7425	CASE DEFAULT
7426	CONTINUE
7427
7428	END SELECT
7429
7430
7431	END SUBROUTINE salsa_actions_ij
7432
7433	!------------------------------------------------------------------------------!
7434	! Description:
7435	! ------------
7436	!> Call for all grid points
7437	!------------------------------------------------------------------------------!
7438	SUBROUTINE salsa_non_advective_processes
7439
7440	USE cpulog, &
7441	ONLY: cpu_log, log_point_s
7442
7443	IMPLICIT NONE
7444
7445	INTEGER(iwp) :: i !<
7446	INTEGER(iwp) :: j !<
7447
7448	IF ( time_since_reference_point >= skip_time_do_salsa ) THEN
7449	IF ( ( time_since_reference_point - last_salsa_time ) >= dt_salsa ) THEN
7450	!
7451	!-- Calculate aerosol dynamic processes. salsa_driver can be run with a longer time step.
7452	CALL cpu_log( log_point_s(90), 'salsa processes ', 'start' )
7453	DO i = nxl, nxr
7454	DO j = nys, nyn
7455	CALL salsa_diagnostics( i, j )
7456	CALL salsa_driver( i, j, 3 )
7457	CALL salsa_diagnostics( i, j )
7458	ENDDO
7459	ENDDO
7460	CALL cpu_log( log_point_s(90), 'salsa processes ', 'stop' )
7461	ENDIF
7462	ENDIF
7463
7464	END SUBROUTINE salsa_non_advective_processes
7465
7466
7467	!------------------------------------------------------------------------------!
7468	! Description:
7469	! ------------
7470	!> Call for grid points i,j
7471	!------------------------------------------------------------------------------!
7472	SUBROUTINE salsa_non_advective_processes_ij( i, j )
7473
7474	USE cpulog, &
7475	ONLY: cpu_log, log_point_s
7476
7477	IMPLICIT NONE
7478
7479	INTEGER(iwp), INTENT(IN) :: i !< grid index in x-direction
7480	INTEGER(iwp), INTENT(IN) :: j !< grid index in y-direction
7481
7482	IF ( time_since_reference_point >= skip_time_do_salsa ) THEN
7483	IF ( ( time_since_reference_point - last_salsa_time ) >= dt_salsa ) THEN
7484	!
7485	!-- Calculate aerosol dynamic processes. salsa_driver can be run with a longer time step.
7486	CALL cpu_log( log_point_s(90), 'salsa processes ', 'start' )
7487	CALL salsa_diagnostics( i, j )
7488	CALL salsa_driver( i, j, 3 )
7489	CALL salsa_diagnostics( i, j )
7490	CALL cpu_log( log_point_s(90), 'salsa processes ', 'stop' )
7491	ENDIF
7492	ENDIF
7493
7494	END SUBROUTINE salsa_non_advective_processes_ij
7495
7496	!------------------------------------------------------------------------------!
7497	! Description:
7498	! ------------
7499	!> Routine for exchange horiz of salsa variables.
7500	!------------------------------------------------------------------------------!
7501	SUBROUTINE salsa_exchange_horiz_bounds
7502
7503	USE cpulog, &
7504	ONLY: cpu_log, log_point_s
7505
7506	IMPLICIT NONE
7507
7508	INTEGER(iwp) :: ib !<
7509	INTEGER(iwp) :: ic !<
7510	INTEGER(iwp) :: icc !<
7511	INTEGER(iwp) :: ig !<
7512
7513	IF ( time_since_reference_point >= skip_time_do_salsa ) THEN
7514	IF ( ( time_since_reference_point - last_salsa_time ) >= dt_salsa ) THEN
7515
7516	CALL cpu_log( log_point_s(91), 'salsa exch-horiz ', 'start' )
7517	!
7518	!-- Exchange ghost points and decycle if needed.
7519	DO ib = 1, nbins_aerosol
7520	CALL exchange_horiz( aerosol_number(ib)%conc, nbgp )
7521	CALL salsa_boundary_conds( aerosol_number(ib)%conc, aerosol_number(ib)%init )
7522	DO ic = 1, ncomponents_mass
7523	icc = ( ic - 1 ) * nbins_aerosol + ib
7524	CALL exchange_horiz( aerosol_mass(icc)%conc, nbgp )
7525	CALL salsa_boundary_conds( aerosol_mass(icc)%conc, aerosol_mass(icc)%init )
7526	ENDDO
7527	ENDDO
7528	IF ( .NOT. salsa_gases_from_chem ) THEN
7529	DO ig = 1, ngases_salsa
7530	CALL exchange_horiz( salsa_gas(ig)%conc, nbgp )
7531	CALL salsa_boundary_conds( salsa_gas(ig)%conc, salsa_gas(ig)%init )
7532	ENDDO
7533	ENDIF
7534	CALL cpu_log( log_point_s(91), 'salsa exch-horiz ', 'stop' )
7535	!
7536	!-- Update last_salsa_time
7537	last_salsa_time = time_since_reference_point
7538	ENDIF
7539	ENDIF
7540
7541	END SUBROUTINE salsa_exchange_horiz_bounds
7542
7543	!------------------------------------------------------------------------------!
7544	! Description:
7545	! ------------
7546	!> Calculate the prognostic equation for aerosol number and mass, and gas
7547	!> concentrations. Cache-optimized.
7548	!------------------------------------------------------------------------------!
7549	SUBROUTINE salsa_prognostic_equations_ij( i, j, i_omp_start, tn )
7550
7551	IMPLICIT NONE
7552
7553	INTEGER(iwp) :: i !<
7554	INTEGER(iwp) :: i_omp_start !<
7555	INTEGER(iwp) :: ib !< loop index for aerosol number bin OR gas index
7556	INTEGER(iwp) :: ic !< loop index for aerosol mass bin
7557	INTEGER(iwp) :: icc !< (c-1)*nbins_aerosol+b
7558	INTEGER(iwp) :: ig !< loop index for salsa gases
7559	INTEGER(iwp) :: j !<
7560	INTEGER(iwp) :: tn !<
7561
7562	IF ( time_since_reference_point >= skip_time_do_salsa ) THEN
7563	!
7564	!-- Aerosol number
7565	DO ib = 1, nbins_aerosol
7566	!kk sums_salsa_ws_l = aerosol_number(ib)%sums_ws_l
7567	CALL salsa_tendency( 'aerosol_number', aerosol_number(ib)%conc_p, aerosol_number(ib)%conc,&
7568	aerosol_number(ib)%tconc_m, i, j, i_omp_start, tn, ib, ib, &
7569	aerosol_number(ib)%flux_s, aerosol_number(ib)%diss_s, &
7570	aerosol_number(ib)%flux_l, aerosol_number(ib)%diss_l, &
7571	aerosol_number(ib)%init, .TRUE. )
7572	!kk aerosol_number(ib)%sums_ws_l = sums_salsa_ws_l
7573	!
7574	!-- Aerosol mass
7575	DO ic = 1, ncomponents_mass
7576	icc = ( ic - 1 ) * nbins_aerosol + ib
7577	!kk sums_salsa_ws_l = aerosol_mass(icc)%sums_ws_l
7578	CALL salsa_tendency( 'aerosol_mass', aerosol_mass(icc)%conc_p, aerosol_mass(icc)%conc,&
7579	aerosol_mass(icc)%tconc_m, i, j, i_omp_start, tn, ib, ic, &
7580	aerosol_mass(icc)%flux_s, aerosol_mass(icc)%diss_s, &
7581	aerosol_mass(icc)%flux_l, aerosol_mass(icc)%diss_l, &
7582	aerosol_mass(icc)%init, .TRUE. )
7583	!kk aerosol_mass(icc)%sums_ws_l = sums_salsa_ws_l
7584
7585	ENDDO ! ic
7586	ENDDO ! ib
7587	!
7588	!-- Gases
7589	IF ( .NOT. salsa_gases_from_chem ) THEN
7590
7591	DO ig = 1, ngases_salsa
7592	!kk sums_salsa_ws_l = salsa_gas(ig)%sums_ws_l
7593	CALL salsa_tendency( 'salsa_gas', salsa_gas(ig)%conc_p, salsa_gas(ig)%conc, &
7594	salsa_gas(ig)%tconc_m, i, j, i_omp_start, tn, ig, ig, &
7595	salsa_gas(ig)%flux_s, salsa_gas(ig)%diss_s, salsa_gas(ig)%flux_l,&
7596	salsa_gas(ig)%diss_l, salsa_gas(ig)%init, .FALSE. )
7597	!kk salsa_gas(ig)%sums_ws_l = sums_salsa_ws_l
7598
7599	ENDDO ! ig
7600
7601	ENDIF
7602
7603	ENDIF
7604
7605	END SUBROUTINE salsa_prognostic_equations_ij
7606	!
7607	!------------------------------------------------------------------------------!
7608	! Description:
7609	! ------------
7610	!> Calculate the prognostic equation for aerosol number and mass, and gas
7611	!> concentrations. For vector machines.
7612	!------------------------------------------------------------------------------!
7613	SUBROUTINE salsa_prognostic_equations()
7614
7615	IMPLICIT NONE
7616
7617	INTEGER(iwp) :: ib !< loop index for aerosol number bin OR gas index
7618	INTEGER(iwp) :: ic !< loop index for aerosol mass bin
7619	INTEGER(iwp) :: icc !< (c-1)*nbins_aerosol+b
7620	INTEGER(iwp) :: ig !< loop index for salsa gases
7621
7622	IF ( time_since_reference_point >= skip_time_do_salsa ) THEN
7623	!
7624	!-- Aerosol number
7625	DO ib = 1, nbins_aerosol
7626	sums_salsa_ws_l = aerosol_number(ib)%sums_ws_l
7627	CALL salsa_tendency( 'aerosol_number', aerosol_number(ib)%conc_p, aerosol_number(ib)%conc,&
7628	aerosol_number(ib)%tconc_m, ib, ib, aerosol_number(ib)%init, .TRUE. )
7629	aerosol_number(ib)%sums_ws_l = sums_salsa_ws_l
7630	!
7631	!-- Aerosol mass
7632	DO ic = 1, ncomponents_mass
7633	icc = ( ic - 1 ) * nbins_aerosol + ib
7634	sums_salsa_ws_l = aerosol_mass(icc)%sums_ws_l
7635	CALL salsa_tendency( 'aerosol_mass', aerosol_mass(icc)%conc_p, aerosol_mass(icc)%conc,&
7636	aerosol_mass(icc)%tconc_m, ib, ic, aerosol_mass(icc)%init, .TRUE. )
7637	aerosol_mass(icc)%sums_ws_l = sums_salsa_ws_l
7638
7639	ENDDO ! ic
7640	ENDDO ! ib
7641	!
7642	!-- Gases
7643	IF ( .NOT. salsa_gases_from_chem ) THEN
7644
7645	DO ig = 1, ngases_salsa
7646	sums_salsa_ws_l = salsa_gas(ig)%sums_ws_l
7647	CALL salsa_tendency( 'salsa_gas', salsa_gas(ig)%conc_p, salsa_gas(ig)%conc, &
7648	salsa_gas(ig)%tconc_m, ig, ig, salsa_gas(ig)%init, .FALSE. )
7649	salsa_gas(ig)%sums_ws_l = sums_salsa_ws_l
7650
7651	ENDDO ! ig
7652
7653	ENDIF
7654
7655	ENDIF
7656
7657	END SUBROUTINE salsa_prognostic_equations
7658	!
7659	!------------------------------------------------------------------------------!
7660	! Description:
7661	! ------------
7662	!> Tendencies for aerosol number and mass and gas concentrations.
7663	!> Cache-optimized.
7664	!------------------------------------------------------------------------------!
7665	SUBROUTINE salsa_tendency_ij( id, rs_p, rs, trs_m, i, j, i_omp_start, tn, ib, ic, flux_s, diss_s, &
7666	flux_l, diss_l, rs_init, do_sedimentation )
7667
7668	USE advec_ws, &
7669	ONLY: advec_s_ws
7670
7671	USE advec_s_pw_mod, &
7672	ONLY: advec_s_pw
7673
7674	USE advec_s_up_mod, &
7675	ONLY: advec_s_up
7676
7677	USE arrays_3d, &
7678	ONLY: ddzu, rdf_sc, tend
7679
7680	USE diffusion_s_mod, &
7681	ONLY: diffusion_s
7682
7683	USE indices, &
7684	ONLY: wall_flags_0
7685
7686	USE surface_mod, &
7687	ONLY : surf_def_h, surf_def_v, surf_lsm_h, surf_lsm_v, surf_usm_h, surf_usm_v
7688
7689	IMPLICIT NONE
7690
7691	CHARACTER(LEN = *) :: id !<
7692
7693	INTEGER(iwp) :: i !<
7694	INTEGER(iwp) :: i_omp_start !<
7695	INTEGER(iwp) :: ib !< loop index for aerosol number bin OR gas index
7696	INTEGER(iwp) :: ic !< loop index for aerosol mass bin
7697	INTEGER(iwp) :: icc !< (c-1)*nbins_aerosol+b
7698	INTEGER(iwp) :: j !<
7699	INTEGER(iwp) :: k !<
7700	INTEGER(iwp) :: tn !<
7701
7702	LOGICAL :: do_sedimentation !<
7703
7704	REAL(wp), DIMENSION(nzb:nzt+1) :: rs_init !<
7705
7706	REAL(wp), DIMENSION(nzb+1:nzt,0:threads_per_task-1) :: diss_s !<
7707	REAL(wp), DIMENSION(nzb+1:nzt,0:threads_per_task-1) :: flux_s !<
7708
7709	REAL(wp), DIMENSION(nzb+1:nzt,nys:nyn,0:threads_per_task-1) :: diss_l !<
7710	REAL(wp), DIMENSION(nzb+1:nzt,nys:nyn,0:threads_per_task-1) :: flux_l !<
7711
7712	REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) :: rs_p !<
7713	REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) :: rs !<
7714	REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) :: trs_m !<
7715
7716	icc = ( ic - 1 ) * nbins_aerosol + ib
7717	!
7718	!-- Tendency-terms for reactive scalar
7719	tend(:,j,i) = 0.0_wp
7720	!
7721	!-- Advection terms
7722	IF ( timestep_scheme(1:5) == 'runge' ) THEN
7723	IF ( ws_scheme_sca ) THEN
7724	CALL advec_s_ws( salsa_advc_flags_s, i, j, rs, id, flux_s, diss_s, flux_l, diss_l, &
7725	i_omp_start, tn, bc_dirichlet_l .OR. bc_radiation_l, &
7726	bc_dirichlet_n .OR. bc_radiation_n, &
7727	bc_dirichlet_r .OR. bc_radiation_r, &
7728	bc_dirichlet_s .OR. bc_radiation_s, monotonic_limiter_z )
7729	ELSE
7730	CALL advec_s_pw( i, j, rs )
7731	ENDIF
7732	ELSE
7733	CALL advec_s_up( i, j, rs )
7734	ENDIF
7735	!
7736	!-- Diffusion terms
7737	SELECT CASE ( id )
7738	CASE ( 'aerosol_number' )
7739	CALL diffusion_s( i, j, rs, surf_def_h(0)%answs(:,ib), &
7740	surf_def_h(1)%answs(:,ib), surf_def_h(2)%answs(:,ib), &
7741	surf_lsm_h%answs(:,ib), surf_usm_h%answs(:,ib), &
7742	surf_def_v(0)%answs(:,ib), surf_def_v(1)%answs(:,ib), &
7743	surf_def_v(2)%answs(:,ib), surf_def_v(3)%answs(:,ib), &
7744	surf_lsm_v(0)%answs(:,ib), surf_lsm_v(1)%answs(:,ib), &
7745	surf_lsm_v(2)%answs(:,ib), surf_lsm_v(3)%answs(:,ib), &
7746	surf_usm_v(0)%answs(:,ib), surf_usm_v(1)%answs(:,ib), &
7747	surf_usm_v(2)%answs(:,ib), surf_usm_v(3)%answs(:,ib) )
7748	CASE ( 'aerosol_mass' )
7749	CALL diffusion_s( i, j, rs, surf_def_h(0)%amsws(:,icc), &
7750	surf_def_h(1)%amsws(:,icc), surf_def_h(2)%amsws(:,icc), &
7751	surf_lsm_h%amsws(:,icc), surf_usm_h%amsws(:,icc), &
7752	surf_def_v(0)%amsws(:,icc), surf_def_v(1)%amsws(:,icc), &
7753	surf_def_v(2)%amsws(:,icc), surf_def_v(3)%amsws(:,icc), &
7754	surf_lsm_v(0)%amsws(:,icc), surf_lsm_v(1)%amsws(:,icc), &
7755	surf_lsm_v(2)%amsws(:,icc), surf_lsm_v(3)%amsws(:,icc), &
7756	surf_usm_v(0)%amsws(:,icc), surf_usm_v(1)%amsws(:,icc), &
7757	surf_usm_v(2)%amsws(:,icc), surf_usm_v(3)%amsws(:,icc) )
7758	CASE ( 'salsa_gas' )
7759	CALL diffusion_s( i, j, rs, surf_def_h(0)%gtsws(:,ib), &
7760	surf_def_h(1)%gtsws(:,ib), surf_def_h(2)%gtsws(:,ib), &
7761	surf_lsm_h%gtsws(:,ib), surf_usm_h%gtsws(:,ib), &
7762	surf_def_v(0)%gtsws(:,ib), surf_def_v(1)%gtsws(:,ib), &
7763	surf_def_v(2)%gtsws(:,ib), surf_def_v(3)%gtsws(:,ib), &
7764	surf_lsm_v(0)%gtsws(:,ib), surf_lsm_v(1)%gtsws(:,ib), &
7765	surf_lsm_v(2)%gtsws(:,ib), surf_lsm_v(3)%gtsws(:,ib), &
7766	surf_usm_v(0)%gtsws(:,ib), surf_usm_v(1)%gtsws(:,ib), &
7767	surf_usm_v(2)%gtsws(:,ib), surf_usm_v(3)%gtsws(:,ib) )
7768	END SELECT
7769	!
7770	!-- Sedimentation and prognostic equation for aerosol number and mass
7771	IF ( lsdepo .AND. do_sedimentation ) THEN
7772	!DIR$ IVDEP
7773	DO k = nzb+1, nzt
7774	tend(k,j,i) = tend(k,j,i) - MAX( 0.0_wp, ( rs(k+1,j,i) * sedim_vd(k+1,j,i,ib) - &
7775	rs(k,j,i) * sedim_vd(k,j,i,ib) ) * ddzu(k) ) &
7776	* MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_0(k-1,j,i), 0 ) )
7777	rs_p(k,j,i) = rs(k,j,i) + ( dt_3d * ( tsc(2) * tend(k,j,i) + tsc(3) * trs_m(k,j,i) ) &
7778	- tsc(5) * rdf_sc(k) * ( rs(k,j,i) - rs_init(k) ) ) &
7779	* MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_0(k,j,i), 0 ) )
7780	IF ( rs_p(k,j,i) < 0.0_wp ) rs_p(k,j,i) = 0.1_wp * rs(k,j,i)
7781	ENDDO
7782	ELSE
7783	!
7784	!-- Prognostic equation
7785	!DIR$ IVDEP
7786	DO k = nzb+1, nzt
7787	rs_p(k,j,i) = rs(k,j,i) + ( dt_3d * ( tsc(2) * tend(k,j,i) + tsc(3) * trs_m(k,j,i) ) &
7788	- tsc(5) * rdf_sc(k) * ( rs(k,j,i) - rs_init(k) ) )&
7789	* MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_0(k,j,i), 0 ) )
7790	IF ( rs_p(k,j,i) < 0.0_wp ) rs_p(k,j,i) = 0.1_wp * rs(k,j,i)
7791	ENDDO
7792	ENDIF
7793	!
7794	!-- Calculate tendencies for the next Runge-Kutta step
7795	IF ( timestep_scheme(1:5) == 'runge' ) THEN
7796	IF ( intermediate_timestep_count == 1 ) THEN
7797	DO k = nzb+1, nzt
7798	trs_m(k,j,i) = tend(k,j,i)
7799	ENDDO
7800	ELSEIF ( intermediate_timestep_count < intermediate_timestep_count_max ) THEN
7801	DO k = nzb+1, nzt
7802	trs_m(k,j,i) = -9.5625_wp * tend(k,j,i) + 5.3125_wp * trs_m(k,j,i)
7803	ENDDO
7804	ENDIF
7805	ENDIF
7806
7807	END SUBROUTINE salsa_tendency_ij
7808	!
7809	!------------------------------------------------------------------------------!
7810	! Description:
7811	! ------------
7812	!> Calculate the tendencies for aerosol number and mass concentrations.
7813	!> For vector machines.
7814	!------------------------------------------------------------------------------!
7815	SUBROUTINE salsa_tendency( id, rs_p, rs, trs_m, ib, ic, rs_init, do_sedimentation )
7816
7817	USE advec_ws, &
7818	ONLY: advec_s_ws
7819	USE advec_s_pw_mod, &
7820	ONLY: advec_s_pw
7821	USE advec_s_up_mod, &
7822	ONLY: advec_s_up
7823	USE arrays_3d, &
7824	ONLY: ddzu, rdf_sc, tend
7825	USE diffusion_s_mod, &
7826	ONLY: diffusion_s
7827	USE indices, &
7828	ONLY: wall_flags_0
7829	USE surface_mod, &
7830	ONLY : surf_def_h, surf_def_v, surf_lsm_h, surf_lsm_v, surf_usm_h, surf_usm_v
7831
7832	IMPLICIT NONE
7833
7834	CHARACTER(LEN = *) :: id
7835
7836	INTEGER(iwp) :: ib !< loop index for aerosol number bin OR gas index
7837	INTEGER(iwp) :: ic !< loop index for aerosol mass bin
7838	INTEGER(iwp) :: icc !< (c-1)*nbins_aerosol+b
7839	INTEGER(iwp) :: i !<
7840	INTEGER(iwp) :: j !<
7841	INTEGER(iwp) :: k !<
7842
7843	LOGICAL :: do_sedimentation !<
7844
7845	REAL(wp), DIMENSION(nzb:nzt+1) :: rs_init !<
7846
7847	REAL(wp), DIMENSION(:,:,:), POINTER :: rs_p !<
7848	REAL(wp), DIMENSION(:,:,:), POINTER :: rs !<
7849	REAL(wp), DIMENSION(:,:,:), POINTER :: trs_m !<
7850
7851	icc = ( ic - 1 ) * nbins_aerosol + ib
7852	!
7853	!-- Tendency-terms for reactive scalar
7854	tend = 0.0_wp
7855	!
7856	!-- Advection terms
7857	IF ( timestep_scheme(1:5) == 'runge' ) THEN
7858	IF ( ws_scheme_sca ) THEN
7859	CALL advec_s_ws( salsa_advc_flags_s, rs, id, bc_dirichlet_l .OR. bc_radiation_l, &
7860	bc_dirichlet_n .OR. bc_radiation_n, &
7861	bc_dirichlet_r .OR. bc_radiation_r, &
7862	bc_dirichlet_s .OR. bc_radiation_s )
7863	ELSE
7864	CALL advec_s_pw( rs )
7865	ENDIF
7866	ELSE
7867	CALL advec_s_up( rs )
7868	ENDIF
7869	!
7870	!-- Diffusion terms
7871	SELECT CASE ( id )
7872	CASE ( 'aerosol_number' )
7873	CALL diffusion_s( rs, surf_def_h(0)%answs(:,ib), &
7874	surf_def_h(1)%answs(:,ib), surf_def_h(2)%answs(:,ib), &
7875	surf_lsm_h%answs(:,ib), surf_usm_h%answs(:,ib), &
7876	surf_def_v(0)%answs(:,ib), surf_def_v(1)%answs(:,ib), &
7877	surf_def_v(2)%answs(:,ib), surf_def_v(3)%answs(:,ib), &
7878	surf_lsm_v(0)%answs(:,ib), surf_lsm_v(1)%answs(:,ib), &
7879	surf_lsm_v(2)%answs(:,ib), surf_lsm_v(3)%answs(:,ib), &
7880	surf_usm_v(0)%answs(:,ib), surf_usm_v(1)%answs(:,ib), &
7881	surf_usm_v(2)%answs(:,ib), surf_usm_v(3)%answs(:,ib) )
7882	CASE ( 'aerosol_mass' )
7883	CALL diffusion_s( rs, surf_def_h(0)%amsws(:,icc), &
7884	surf_def_h(1)%amsws(:,icc), surf_def_h(2)%amsws(:,icc), &
7885	surf_lsm_h%amsws(:,icc), surf_usm_h%amsws(:,icc), &
7886	surf_def_v(0)%amsws(:,icc), surf_def_v(1)%amsws(:,icc), &
7887	surf_def_v(2)%amsws(:,icc), surf_def_v(3)%amsws(:,icc), &
7888	surf_lsm_v(0)%amsws(:,icc), surf_lsm_v(1)%amsws(:,icc), &
7889	surf_lsm_v(2)%amsws(:,icc), surf_lsm_v(3)%amsws(:,icc), &
7890	surf_usm_v(0)%amsws(:,icc), surf_usm_v(1)%amsws(:,icc), &
7891	surf_usm_v(2)%amsws(:,icc), surf_usm_v(3)%amsws(:,icc) )
7892	CASE ( 'salsa_gas' )
7893	CALL diffusion_s( rs, surf_def_h(0)%gtsws(:,ib), &
7894	surf_def_h(1)%gtsws(:,ib), surf_def_h(2)%gtsws(:,ib), &
7895	surf_lsm_h%gtsws(:,ib), surf_usm_h%gtsws(:,ib), &
7896	surf_def_v(0)%gtsws(:,ib), surf_def_v(1)%gtsws(:,ib), &
7897	surf_def_v(2)%gtsws(:,ib), surf_def_v(3)%gtsws(:,ib), &
7898	surf_lsm_v(0)%gtsws(:,ib), surf_lsm_v(1)%gtsws(:,ib), &
7899	surf_lsm_v(2)%gtsws(:,ib), surf_lsm_v(3)%gtsws(:,ib), &
7900	surf_usm_v(0)%gtsws(:,ib), surf_usm_v(1)%gtsws(:,ib), &
7901	surf_usm_v(2)%gtsws(:,ib), surf_usm_v(3)%gtsws(:,ib) )
7902	END SELECT
7903	!
7904	!-- Prognostic equation for a scalar
7905	DO i = nxl, nxr
7906	DO j = nys, nyn
7907	!
7908	!-- Sedimentation for aerosol number and mass
7909	IF ( lsdepo .AND. do_sedimentation ) THEN
7910	tend(nzb+1:nzt,j,i) = tend(nzb+1:nzt,j,i) - MAX( 0.0_wp, ( rs(nzb+2:nzt+1,j,i) * &
7911	sedim_vd(nzb+2:nzt+1,j,i,ib) - rs(nzb+1:nzt,j,i) * &
7912	sedim_vd(nzb+1:nzt,j,i,ib) ) * ddzu(nzb+1:nzt) ) * &
7913	MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_0(nzb:nzt-1,j,i), 0 ) )
7914	ENDIF
7915	DO k = nzb+1, nzt
7916	rs_p(k,j,i) = rs(k,j,i) + ( dt_3d * ( tsc(2) * tend(k,j,i) + tsc(3) * trs_m(k,j,i) )&
7917	- tsc(5) * rdf_sc(k) * ( rs(k,j,i) - rs_init(k) )&
7918	) * MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_0(k,j,i), 0 ) )
7919	IF ( rs_p(k,j,i) < 0.0_wp ) rs_p(k,j,i) = 0.1_wp * rs(k,j,i)
7920	ENDDO
7921	ENDDO
7922	ENDDO
7923	!
7924	!-- Calculate tendencies for the next Runge-Kutta step
7925	IF ( timestep_scheme(1:5) == 'runge' ) THEN
7926	IF ( intermediate_timestep_count == 1 ) THEN
7927	DO i = nxl, nxr
7928	DO j = nys, nyn
7929	DO k = nzb+1, nzt
7930	trs_m(k,j,i) = tend(k,j,i)
7931	ENDDO
7932	ENDDO
7933	ENDDO
7934	ELSEIF ( intermediate_timestep_count < intermediate_timestep_count_max ) THEN
7935	DO i = nxl, nxr
7936	DO j = nys, nyn
7937	DO k = nzb+1, nzt
7938	trs_m(k,j,i) = -9.5625_wp * tend(k,j,i) + 5.3125_wp * trs_m(k,j,i)
7939	ENDDO
7940	ENDDO
7941	ENDDO
7942	ENDIF
7943	ENDIF
7944
7945	END SUBROUTINE salsa_tendency
7946
7947	!------------------------------------------------------------------------------!
7948	! Description:
7949	! ------------
7950	!> Boundary conditions for prognostic variables in SALSA
7951	!------------------------------------------------------------------------------!
7952	SUBROUTINE salsa_boundary_conds
7953
7954	USE arrays_3d, &
7955	ONLY: dzu
7956
7957	USE surface_mod, &
7958	ONLY : bc_h
7959
7960	IMPLICIT NONE
7961
7962	INTEGER(iwp) :: i !< grid index x direction
7963	INTEGER(iwp) :: ib !< index for aerosol size bins
7964	INTEGER(iwp) :: ic !< index for chemical compounds in aerosols
7965	INTEGER(iwp) :: icc !< additional index for chemical compounds in aerosols
7966	INTEGER(iwp) :: ig !< idex for gaseous compounds
7967	INTEGER(iwp) :: j !< grid index y direction
7968	INTEGER(iwp) :: k !< grid index y direction
7969	INTEGER(iwp) :: l !< running index boundary type, for up- and downward-facing walls
7970	INTEGER(iwp) :: m !< running index surface elements
7971
7972	IF ( time_since_reference_point >= skip_time_do_salsa ) THEN
7973
7974	!
7975	!-- Surface conditions:
7976	IF ( ibc_salsa_b == 0 ) THEN ! Dirichlet
7977	!
7978	!-- Run loop over all non-natural and natural walls. Note, in wall-datatype the k coordinate
7979	!-- belongs to the atmospheric grid point, therefore, set s_p at k-1
7980	DO l = 0, 1
7981	!$OMP PARALLEL PRIVATE( ib, ic, icc, ig, i, j, k )
7982	!$OMP DO
7983	DO m = 1, bc_h(l)%ns
7984
7985	i = bc_h(l)%i(m)
7986	j = bc_h(l)%j(m)
7987	k = bc_h(l)%k(m)
7988
7989	DO ib = 1, nbins_aerosol
7990	aerosol_number(ib)%conc_p(k+bc_h(l)%koff,j,i) = &
7991	aerosol_number(ib)%conc(k+bc_h(l)%koff,j,i)
7992	DO ic = 1, ncomponents_mass
7993	icc = ( ic - 1 ) * nbins_aerosol + ib
7994	aerosol_mass(icc)%conc_p(k+bc_h(l)%koff,j,i) = &
7995	aerosol_mass(icc)%conc(k+bc_h(l)%koff,j,i)
7996	ENDDO
7997	ENDDO
7998	IF ( .NOT. salsa_gases_from_chem ) THEN
7999	DO ig = 1, ngases_salsa
8000	salsa_gas(ig)%conc_p(k+bc_h(l)%koff,j,i) = &
8001	salsa_gas(ig)%conc(k+bc_h(l)%koff,j,i)
8002	ENDDO
8003	ENDIF
8004
8005	ENDDO
8006	!$OMP END PARALLEL
8007
8008	ENDDO
8009
8010	ELSE ! Neumann
8011
8012	DO l = 0, 1
8013	!$OMP PARALLEL PRIVATE( ib, ic, icc, ig, i, j, k )
8014	!$OMP DO
8015	DO m = 1, bc_h(l)%ns
8016
8017	i = bc_h(l)%i(m)
8018	j = bc_h(l)%j(m)
8019	k = bc_h(l)%k(m)
8020
8021	DO ib = 1, nbins_aerosol
8022	aerosol_number(ib)%conc_p(k+bc_h(l)%koff,j,i) = &
8023	aerosol_number(ib)%conc_p(k,j,i)
8024	DO ic = 1, ncomponents_mass
8025	icc = ( ic - 1 ) * nbins_aerosol + ib
8026	aerosol_mass(icc)%conc_p(k+bc_h(l)%koff,j,i) = &
8027	aerosol_mass(icc)%conc_p(k,j,i)
8028	ENDDO
8029	ENDDO
8030	IF ( .NOT. salsa_gases_from_chem ) THEN
8031	DO ig = 1, ngases_salsa
8032	salsa_gas(ig)%conc_p(k+bc_h(l)%koff,j,i) = &
8033	salsa_gas(ig)%conc_p(k,j,i)
8034	ENDDO
8035	ENDIF
8036
8037	ENDDO
8038	!$OMP END PARALLEL
8039	ENDDO
8040
8041	ENDIF
8042	!
8043	!-- Top boundary conditions:
8044	IF ( ibc_salsa_t == 0 ) THEN ! Dirichlet
8045
8046	DO ib = 1, nbins_aerosol
8047	aerosol_number(ib)%conc_p(nzt+1,:,:) = aerosol_number(ib)%conc(nzt+1,:,:)
8048	DO ic = 1, ncomponents_mass
8049	icc = ( ic - 1 ) * nbins_aerosol + ib
8050	aerosol_mass(icc)%conc_p(nzt+1,:,:) = aerosol_mass(icc)%conc(nzt+1,:,:)
8051	ENDDO
8052	ENDDO
8053	IF ( .NOT. salsa_gases_from_chem ) THEN
8054	DO ig = 1, ngases_salsa
8055	salsa_gas(ig)%conc_p(nzt+1,:,:) = salsa_gas(ig)%conc(nzt+1,:,:)
8056	ENDDO
8057	ENDIF
8058
8059	ELSEIF ( ibc_salsa_t == 1 ) THEN ! Neumann
8060
8061	DO ib = 1, nbins_aerosol
8062	aerosol_number(ib)%conc_p(nzt+1,:,:) = aerosol_number(ib)%conc_p(nzt,:,:)
8063	DO ic = 1, ncomponents_mass
8064	icc = ( ic - 1 ) * nbins_aerosol + ib
8065	aerosol_mass(icc)%conc_p(nzt+1,:,:) = aerosol_mass(icc)%conc_p(nzt,:,:)
8066	ENDDO
8067	ENDDO
8068	IF ( .NOT. salsa_gases_from_chem ) THEN
8069	DO ig = 1, ngases_salsa
8070	salsa_gas(ig)%conc_p(nzt+1,:,:) = salsa_gas(ig)%conc_p(nzt,:,:)
8071	ENDDO
8072	ENDIF
8073
8074	ELSEIF ( ibc_salsa_t == 2 ) THEN ! nested
8075
8076	DO ib = 1, nbins_aerosol
8077	aerosol_number(ib)%conc_p(nzt+1,:,:) = aerosol_number(ib)%conc_p(nzt,:,:) + &
8078	bc_an_t_val(ib) * dzu(nzt+1)
8079	DO ic = 1, ncomponents_mass
8080	icc = ( ic - 1 ) * nbins_aerosol + ib
8081	aerosol_mass(icc)%conc_p(nzt+1,:,:) = aerosol_mass(icc)%conc_p(nzt,:,:) + &
8082	bc_am_t_val(icc) * dzu(nzt+1)
8083	ENDDO
8084	ENDDO
8085	IF ( .NOT. salsa_gases_from_chem ) THEN
8086	DO ig = 1, ngases_salsa
8087	salsa_gas(ig)%conc_p(nzt+1,:,:) = salsa_gas(ig)%conc_p(nzt,:,:) + &
8088	bc_gt_t_val(ig) * dzu(nzt+1)
8089	ENDDO
8090	ENDIF
8091
8092	ENDIF
8093	!
8094	!-- Lateral boundary conditions at the outflow
8095	IF ( bc_radiation_s ) THEN
8096	DO ib = 1, nbins_aerosol
8097	aerosol_number(ib)%conc_p(:,nys-1,:) = aerosol_number(ib)%conc_p(:,nys,:)
8098	DO ic = 1, ncomponents_mass
8099	icc = ( ic - 1 ) * nbins_aerosol + ib
8100	aerosol_mass(icc)%conc_p(:,nys-1,:) = aerosol_mass(icc)%conc_p(:,nys,:)
8101	ENDDO
8102	ENDDO
8103	IF ( .NOT. salsa_gases_from_chem ) THEN
8104	DO ig = 1, ngases_salsa
8105	salsa_gas(ig)%conc_p(:,nys-1,:) = salsa_gas(ig)%conc_p(:,nys,:)
8106	ENDDO
8107	ENDIF
8108
8109	ELSEIF ( bc_radiation_n ) THEN
8110	DO ib = 1, nbins_aerosol
8111	aerosol_number(ib)%conc_p(:,nyn+1,:) = aerosol_number(ib)%conc_p(:,nyn,:)
8112	DO ic = 1, ncomponents_mass
8113	icc = ( ic - 1 ) * nbins_aerosol + ib
8114	aerosol_mass(icc)%conc_p(:,nyn+1,:) = aerosol_mass(icc)%conc_p(:,nyn,:)
8115	ENDDO
8116	ENDDO
8117	IF ( .NOT. salsa_gases_from_chem ) THEN
8118	DO ig = 1, ngases_salsa
8119	salsa_gas(ig)%conc_p(:,nyn+1,:) = salsa_gas(ig)%conc_p(:,nyn,:)
8120	ENDDO
8121	ENDIF
8122
8123	ELSEIF ( bc_radiation_l ) THEN
8124	DO ib = 1, nbins_aerosol
8125	aerosol_number(ib)%conc_p(:,:,nxl-1) = aerosol_number(ib)%conc_p(:,:,nxl)
8126	DO ic = 1, ncomponents_mass
8127	icc = ( ic - 1 ) * nbins_aerosol + ib
8128	aerosol_mass(icc)%conc_p(:,:,nxl-1) = aerosol_mass(icc)%conc_p(:,:,nxl)
8129	ENDDO
8130	ENDDO
8131	IF ( .NOT. salsa_gases_from_chem ) THEN
8132	DO ig = 1, ngases_salsa
8133	salsa_gas(ig)%conc_p(:,:,nxl-1) = salsa_gas(ig)%conc_p(:,:,nxl)
8134	ENDDO
8135	ENDIF
8136
8137	ELSEIF ( bc_radiation_r ) THEN
8138	DO ib = 1, nbins_aerosol
8139	aerosol_number(ib)%conc_p(:,:,nxr+1) = aerosol_number(ib)%conc_p(:,:,nxr)
8140	DO ic = 1, ncomponents_mass
8141	icc = ( ic - 1 ) * nbins_aerosol + ib
8142	aerosol_mass(icc)%conc_p(:,:,nxr+1) = aerosol_mass(icc)%conc_p(:,:,nxr)
8143	ENDDO
8144	ENDDO
8145	IF ( .NOT. salsa_gases_from_chem ) THEN
8146	DO ig = 1, ngases_salsa
8147	salsa_gas(ig)%conc_p(:,:,nxr+1) = salsa_gas(ig)%conc_p(:,:,nxr)
8148	ENDDO
8149	ENDIF
8150
8151	ENDIF
8152
8153	ENDIF
8154
8155	END SUBROUTINE salsa_boundary_conds
8156
8157	!------------------------------------------------------------------------------!
8158	! Description:
8159	! ------------
8160	! Undoing of the previously done cyclic boundary conditions.
8161	!------------------------------------------------------------------------------!
8162	SUBROUTINE salsa_boundary_conds_decycle ( sq, sq_init )
8163
8164	IMPLICIT NONE
8165
8166	INTEGER(iwp) :: boundary !<
8167	INTEGER(iwp) :: ee !<
8168	INTEGER(iwp) :: copied !<
8169	INTEGER(iwp) :: i !<
8170	INTEGER(iwp) :: j !<
8171	INTEGER(iwp) :: k !<
8172	INTEGER(iwp) :: ss !<
8173
8174	REAL(wp) :: flag !< flag to mask topography grid points
8175
8176	REAL(wp), DIMENSION(nzb:nzt+1) :: sq_init !< initial concentration profile
8177
8178	REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) :: sq !< concentration array
8179
8180	flag = 0.0_wp
8181	!
8182	!-- Left and right boundaries
8183	IF ( decycle_salsa_lr .AND. ( bc_lr_cyc .OR. bc_lr == 'nested' ) ) THEN
8184
8185	DO boundary = 1, 2
8186
8187	IF ( decycle_method_salsa(boundary) == 'dirichlet' ) THEN
8188	!
8189	!-- Initial profile is copied to ghost and first three layers
8190	ss = 1
8191	ee = 0
8192	IF ( boundary == 1 .AND. nxl == 0 ) THEN
8193	ss = nxlg
8194	ee = nxl-1
8195	ELSEIF ( boundary == 2 .AND. nxr == nx ) THEN
8196	ss = nxr+1
8197	ee = nxrg
8198	ENDIF
8199
8200	DO i = ss, ee
8201	DO j = nysg, nyng
8202	DO k = nzb+1, nzt
8203	flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_0(k,j,i), 0 ) )
8204	sq(k,j,i) = sq_init(k) * flag
8205	ENDDO
8206	ENDDO
8207	ENDDO
8208
8209	ELSEIF ( decycle_method_salsa(boundary) == 'neumann' ) THEN
8210	!
8211	!-- The value at the boundary is copied to the ghost layers to simulate an outlet with
8212	!-- zero gradient
8213	ss = 1
8214	ee = 0
8215	IF ( boundary == 1 .AND. nxl == 0 ) THEN
8216	ss = nxlg
8217	ee = nxl-1
8218	copied = nxl
8219	ELSEIF ( boundary == 2 .AND. nxr == nx ) THEN
8220	ss = nxr+1
8221	ee = nxrg
8222	copied = nxr
8223	ENDIF
8224
8225	DO i = ss, ee
8226	DO j = nysg, nyng
8227	DO k = nzb+1, nzt
8228	flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_0(k,j,i), 0 ) )
8229	sq(k,j,i) = sq(k,j,copied) * flag
8230	ENDDO
8231	ENDDO
8232	ENDDO
8233
8234	ELSE
8235	WRITE(message_string,*) 'unknown decycling method: decycle_method_salsa (', boundary, &
8236	') ="' // TRIM( decycle_method_salsa(boundary) ) // '"'
8237	CALL message( 'salsa_boundary_conds_decycle', 'PA0626', 1, 2, 0, 6, 0 )
8238	ENDIF
8239	ENDDO
8240	ENDIF
8241
8242	!
8243	!-- South and north boundaries
8244	IF ( decycle_salsa_ns .AND. ( bc_ns_cyc .OR. bc_ns == 'nested' ) ) THEN
8245
8246	DO boundary = 3, 4
8247
8248	IF ( decycle_method_salsa(boundary) == 'dirichlet' ) THEN
8249	!
8250	!-- Initial profile is copied to ghost and first three layers
8251	ss = 1
8252	ee = 0
8253	IF ( boundary == 3 .AND. nys == 0 ) THEN
8254	ss = nysg
8255	ee = nys-1
8256	ELSEIF ( boundary == 4 .AND. nyn == ny ) THEN
8257	ss = nyn+1
8258	ee = nyng
8259	ENDIF
8260
8261	DO i = nxlg, nxrg
8262	DO j = ss, ee
8263	DO k = nzb+1, nzt
8264	flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_0(k,j,i), 0 ) )
8265	sq(k,j,i) = sq_init(k) * flag
8266	ENDDO
8267	ENDDO
8268	ENDDO
8269
8270	ELSEIF ( decycle_method_salsa(boundary) == 'neumann' ) THEN
8271	!
8272	!-- The value at the boundary is copied to the ghost layers to simulate an outlet with
8273	!-- zero gradient
8274	ss = 1
8275	ee = 0
8276	IF ( boundary == 3 .AND. nys == 0 ) THEN
8277	ss = nysg
8278	ee = nys-1
8279	copied = nys
8280	ELSEIF ( boundary == 4 .AND. nyn == ny ) THEN
8281	ss = nyn+1
8282	ee = nyng
8283	copied = nyn
8284	ENDIF
8285
8286	DO i = nxlg, nxrg
8287	DO j = ss, ee
8288	DO k = nzb+1, nzt
8289	flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_0(k,j,i), 0 ) )
8290	sq(k,j,i) = sq(k,copied,i) * flag
8291	ENDDO
8292	ENDDO
8293	ENDDO
8294
8295	ELSE
8296	WRITE(message_string,*) 'unknown decycling method: decycle_method_salsa (', boundary, &
8297	') ="' // TRIM( decycle_method_salsa(boundary) ) // '"'
8298	CALL message( 'salsa_boundary_conds_decycle', 'PA0627', 1, 2, 0, 6, 0 )
8299	ENDIF
8300	ENDDO
8301	ENDIF
8302
8303	END SUBROUTINE salsa_boundary_conds_decycle
8304
8305	!------------------------------------------------------------------------------!
8306	! Description:
8307	! ------------
8308	!> Calculates the total dry or wet mass concentration for individual bins
8309	!> Juha Tonttila (FMI) 2015
8310	!> Tomi Raatikainen (FMI) 2016
8311	!------------------------------------------------------------------------------!
8312	SUBROUTINE bin_mixrat( itype, ibin, i, j, mconc )
8313
8314	IMPLICIT NONE
8315
8316	CHARACTER(len=*), INTENT(in) :: itype !< 'dry' or 'wet'
8317
8318	INTEGER(iwp) :: ic !< loop index for mass bin number
8319	INTEGER(iwp) :: iend !< end index: include water or not
8320
8321	INTEGER(iwp), INTENT(in) :: ibin !< index of the chemical component
8322	INTEGER(iwp), INTENT(in) :: i !< loop index for x-direction
8323	INTEGER(iwp), INTENT(in) :: j !< loop index for y-direction
8324
8325	REAL(wp), DIMENSION(:), INTENT(out) :: mconc !< total dry or wet mass concentration
8326
8327	!-- Number of components
8328	IF ( itype == 'dry' ) THEN
8329	iend = prtcl%ncomp - 1
8330	ELSE IF ( itype == 'wet' ) THEN
8331	iend = prtcl%ncomp
8332	ELSE
8333	message_string = 'Error in itype!'
8334	CALL message( 'bin_mixrat', 'PA0628', 2, 2, 0, 6, 0 )
8335	ENDIF
8336
8337	mconc = 0.0_wp
8338
8339	DO ic = ibin, iend*nbins_aerosol+ibin, nbins_aerosol !< every nbins'th element
8340	mconc = mconc + aerosol_mass(ic)%conc(:,j,i)
8341	ENDDO
8342
8343	END SUBROUTINE bin_mixrat
8344
8345	!------------------------------------------------------------------------------!
8346	! Description:
8347	! ------------
8348	!> Sets surface fluxes
8349	!------------------------------------------------------------------------------!
8350	SUBROUTINE salsa_emission_update
8351
8352	IMPLICIT NONE
8353
8354	IF ( include_emission ) THEN
8355
8356	IF ( time_since_reference_point >= skip_time_do_salsa ) THEN
8357
8358	IF ( next_aero_emission_update <= time_since_reference_point ) THEN
8359	CALL salsa_emission_setup( .FALSE. )
8360	ENDIF
8361
8362	IF ( next_gas_emission_update <= time_since_reference_point ) THEN
8363	IF ( salsa_emission_mode == 'read_from_file' .AND. .NOT. salsa_gases_from_chem ) &
8364	THEN
8365	CALL salsa_gas_emission_setup( .FALSE. )
8366	ENDIF
8367	ENDIF
8368
8369	ENDIF
8370	ENDIF
8371
8372	END SUBROUTINE salsa_emission_update
8373
8374	!------------------------------------------------------------------------------!
8375	!> Description:
8376	!> ------------
8377	!> Define aerosol fluxes: constant or read from a from file
8378	!> @todo - Emission stack height is not used yet. For default mode, emissions
8379	!> are assumed to occur on upward facing horizontal surfaces.
8380	!------------------------------------------------------------------------------!
8381	SUBROUTINE salsa_emission_setup( init )
8382
8383	USE date_and_time_mod, &
8384	ONLY: day_of_month, hour_of_day, index_dd, index_hh, index_mm, month_of_year, &
8385	time_default_indices, time_utc_init
8386
8387	USE netcdf_data_input_mod, &
8388	ONLY: check_existence, close_input_file, get_attribute, get_variable, &
8389	inquire_num_variables, inquire_variable_names, &
8390	netcdf_data_input_get_dimension_length, open_read_file, street_type_f
8391
8392	USE surface_mod, &
8393	ONLY: surf_def_h, surf_lsm_h, surf_usm_h
8394
8395	IMPLICIT NONE
8396
8397	CHARACTER(LEN=80) :: daytype = 'workday' !< default day type
8398	CHARACTER(LEN=25) :: in_name !< name of a gas in the input file
8399	CHARACTER(LEN=25) :: mod_name !< name in the input file
8400
8401	INTEGER(iwp) :: i !< loop index
8402	INTEGER(iwp) :: ib !< loop index: aerosol number bins
8403	INTEGER(iwp) :: ic !< loop index: aerosol chemical components
8404	INTEGER(iwp) :: id_salsa !< NetCDF id of aerosol emission input file
8405	INTEGER(iwp) :: in !< loop index: emission category
8406	INTEGER(iwp) :: inn !< loop index
8407	INTEGER(iwp) :: j !< loop index
8408	INTEGER(iwp) :: ss !< loop index
8409
8410	INTEGER(iwp), DIMENSION(maxspec) :: cc_i2m !<
8411
8412	LOGICAL :: netcdf_extend = .FALSE. !< NetCDF input file exists
8413
8414	LOGICAL, INTENT(in) :: init !< if .TRUE. --> initialisation call
8415
8416	REAL(wp), DIMENSION(:), ALLOCATABLE :: nsect_emission !< sectional number emission
8417
8418	REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: source_array !< temporary source array
8419
8420	!
8421	!-- Define emissions:
8422	SELECT CASE ( salsa_emission_mode )
8423
8424	CASE ( 'uniform', 'parameterized' )
8425
8426	IF ( init ) THEN ! Do only once
8427	!
8428	!- Form a sectional size distribution for the emissions
8429	ALLOCATE( nsect_emission(1:nbins_aerosol), &
8430	source_array(nys:nyn,nxl:nxr,1:nbins_aerosol) )
8431	!
8432	!-- Precalculate a size distribution for the emission based on the mean diameter, standard
8433	!-- deviation and number concentration per each log-normal mode
8434	CALL size_distribution( surface_aerosol_flux, aerosol_flux_dpg, aerosol_flux_sigmag, &
8435	nsect_emission )
8436	IF ( salsa_emission_mode == 'uniform' ) THEN
8437	DO ib = 1, nbins_aerosol
8438	source_array(:,:,ib) = nsect_emission(ib)
8439	ENDDO
8440	ELSE
8441	IF ( street_type_f%from_file ) THEN
8442	DO i = nxl, nxr
8443	DO j = nys, nyn
8444	IF ( street_type_f%var(j,i) >= main_street_id .AND. &
8445	street_type_f%var(j,i) < max_street_id ) THEN
8446	source_array(j,i,:) = nsect_emission(:) * emiss_factor_main
8447	ELSEIF ( street_type_f%var(j,i) >= side_street_id .AND. &
8448	street_type_f%var(j,i) < main_street_id ) THEN
8449	source_array(j,i,:) = nsect_emission(:) * emiss_factor_side
8450	ENDIF
8451	ENDDO
8452	ENDDO
8453	ELSE
8454	WRITE( message_string, * ) 'salsa_emission_mode = "parameterized" but the '// &
8455	'street_type data is missing.'
8456	CALL message( 'salsa_emission_setup', 'PA0661', 1, 2, 0, 6, 0 )
8457	ENDIF
8458	ENDIF
8459	!
8460	!-- Check which chemical components are used
8461	cc_i2m = 0
8462	IF ( index_so4 > 0 ) cc_i2m(1) = index_so4
8463	IF ( index_oc > 0 ) cc_i2m(2) = index_oc
8464	IF ( index_bc > 0 ) cc_i2m(3) = index_bc
8465	IF ( index_du > 0 ) cc_i2m(4) = index_du
8466	IF ( index_ss > 0 ) cc_i2m(5) = index_ss
8467	IF ( index_no > 0 ) cc_i2m(6) = index_no
8468	IF ( index_nh > 0 ) cc_i2m(7) = index_nh
8469	!
8470	!-- Normalise mass fractions so that their sum is 1
8471	aerosol_flux_mass_fracs_a = aerosol_flux_mass_fracs_a / &
8472	SUM( aerosol_flux_mass_fracs_a(1:ncc ) )
8473	IF ( salsa_emission_mode == 'uniform' ) THEN
8474	!
8475	!-- Set uniform fluxes of default horizontal surfaces
8476	CALL set_flux( surf_def_h(0), cc_i2m, aerosol_flux_mass_fracs_a, source_array )
8477	ELSE
8478	!
8479	!-- Set fluxes normalised based on the street type on land surfaces
8480	CALL set_flux( surf_lsm_h, cc_i2m, aerosol_flux_mass_fracs_a, source_array )
8481	ENDIF
8482
8483	DEALLOCATE( nsect_emission, source_array )
8484	ENDIF
8485
8486	CASE ( 'read_from_file' )
8487	!
8488	!-- Reset surface fluxes
8489	surf_def_h(0)%answs = 0.0_wp
8490	surf_def_h(0)%amsws = 0.0_wp
8491	surf_lsm_h%answs = 0.0_wp
8492	surf_lsm_h%amsws = 0.0_wp
8493	surf_usm_h%answs = 0.0_wp
8494	surf_usm_h%amsws = 0.0_wp
8495
8496	!
8497	!-- Reset source arrays:
8498	DO ib = 1, nbins_aerosol
8499	aerosol_number(ib)%source = 0.0_wp
8500	ENDDO
8501
8502	DO ic = 1, ncomponents_mass * nbins_aerosol
8503	aerosol_mass(ic)%source = 0.0_wp
8504	ENDDO
8505
8506	#if defined( __netcdf )
8507	!
8508	!-- Check existence of PIDS_SALSA file
8509	INQUIRE( FILE = TRIM( input_file_salsa ) // TRIM( coupling_char ), EXIST = netcdf_extend )
8510	IF ( .NOT. netcdf_extend ) THEN
8511	message_string = 'Input file '// TRIM( input_file_salsa ) // TRIM( coupling_char )&
8512	// ' missing!'
8513	CALL message( 'salsa_emission_setup', 'PA0629', 1, 2, 0, 6, 0 )
8514	ENDIF
8515	!
8516	!-- Open file in read-only mode
8517	CALL open_read_file( TRIM( input_file_salsa ) // TRIM( coupling_char ), id_salsa )
8518
8519	IF ( init ) THEN
8520	!
8521	!-- Variable names
8522	CALL inquire_num_variables( id_salsa, aero_emission_att%num_vars )
8523	ALLOCATE( aero_emission_att%var_names(1:aero_emission_att%num_vars) )
8524	CALL inquire_variable_names( id_salsa, aero_emission_att%var_names )
8525	!
8526	!-- Read the index and name of chemical components
8527	CALL netcdf_data_input_get_dimension_length( id_salsa, aero_emission_att%ncc, &
8528	'composition_index' )
8529	ALLOCATE( aero_emission_att%cc_index(1:aero_emission_att%ncc) )
8530	CALL get_variable( id_salsa, 'composition_index', aero_emission_att%cc_index )
8531
8532	IF ( check_existence( aero_emission_att%var_names, 'composition_name' ) ) THEN
8533	CALL get_variable( id_salsa, 'composition_name', aero_emission_att%cc_name, &
8534	aero_emission_att%ncc )
8535	ELSE
8536	message_string = 'Missing composition_name in ' // TRIM( input_file_salsa )
8537	CALL message( 'salsa_emission_setup', 'PA0657', 1, 2, 0, 6, 0 )
8538	ENDIF
8539	!
8540	!-- Find the corresponding chemical components in the model
8541	aero_emission_att%cc_in2mod = 0
8542	DO ic = 1, aero_emission_att%ncc
8543	in_name = aero_emission_att%cc_name(ic)
8544	SELECT CASE ( TRIM( in_name ) )
8545	CASE ( 'H2SO4', 'h2so4', 'SO4', 'so4' )
8546	aero_emission_att%cc_in2mod(1) = ic
8547	CASE ( 'OC', 'oc', 'organics' )
8548	aero_emission_att%cc_in2mod(2) = ic
8549	CASE ( 'BC', 'bc' )
8550	aero_emission_att%cc_in2mod(3) = ic
8551	CASE ( 'DU', 'du' )
8552	aero_emission_att%cc_in2mod(4) = ic
8553	CASE ( 'SS', 'ss' )
8554	aero_emission_att%cc_in2mod(5) = ic
8555	CASE ( 'HNO3', 'hno3', 'NO', 'no' )
8556	aero_emission_att%cc_in2mod(6) = ic
8557	CASE ( 'NH3', 'nh3', 'NH', 'nh' )
8558	aero_emission_att%cc_in2mod(7) = ic
8559	END SELECT
8560
8561	ENDDO
8562
8563	IF ( SUM( aero_emission_att%cc_in2mod ) == 0 ) THEN
8564	message_string = 'None of the aerosol chemical components in ' // TRIM( &
8565	input_file_salsa ) // ' correspond to the ones applied in SALSA.'
8566	CALL message( 'salsa_emission_setup', 'PA0630', 1, 2, 0, 6, 0 )
8567	ENDIF
8568	!
8569	!-- Inquire the fill value
8570	CALL get_attribute( id_salsa, '_FillValue', aero_emission%fill, .FALSE., &
8571	'aerosol_emission_values' )
8572	!
8573	!-- Inquire units of emissions
8574	CALL get_attribute( id_salsa, 'units', aero_emission_att%units, .FALSE., &
8575	'aerosol_emission_values' )
8576	!
8577	!-- Inquire the level of detail (lod)
8578	CALL get_attribute( id_salsa, 'lod', aero_emission_att%lod, .FALSE., &
8579	'aerosol_emission_values' )
8580
8581	!
8582	!-- Read different emission information depending on the level of detail of emissions:
8583
8584	!
8585	!-- Default mode:
8586	IF ( aero_emission_att%lod == 1 ) THEN
8587	!
8588	!-- Unit conversion factor: convert to SI units (kg/m2/s)
8589	IF ( aero_emission_att%units == 'kg/m2/yr' ) THEN
8590	aero_emission_att%conversion_factor = 1.0_wp / 3600.0_wp
8591	ELSEIF ( aero_emission_att%units == 'g/m2/yr' ) THEN
8592	aero_emission_att%conversion_factor = 0.001_wp / 3600.0_wp
8593	ELSE
8594	message_string = 'unknown unit for aerosol emissions: ' // &
8595	TRIM( aero_emission_att%units ) // ' (lod1)'
8596	CALL message( 'salsa_emission_setup','PA0631', 1, 2, 0, 6, 0 )
8597	ENDIF
8598	!
8599	!-- Get number of emission categories and allocate emission arrays
8600	CALL netcdf_data_input_get_dimension_length( id_salsa, aero_emission_att%ncat, &
8601	'ncat' )
8602	ALLOCATE( aero_emission_att%cat_index(1:aero_emission_att%ncat), &
8603	aero_emission_att%rho(1:aero_emission_att%ncat), &
8604	aero_emission_att%time_factor(1:aero_emission_att%ncat) )
8605	!
8606	!-- Get emission category names and indices
8607	IF ( check_existence( aero_emission_att%var_names, 'emission_category_name' ) ) THEN
8608	CALL get_variable( id_salsa, 'emission_category_name', &
8609	aero_emission_att%cat_name, aero_emission_att%ncat )
8610	ELSE
8611	message_string = 'Missing emission_category_name in ' // TRIM( input_file_salsa )
8612	CALL message( 'salsa_emission_setup', 'PA0658', 1, 2, 0, 6, 0 )
8613	ENDIF
8614	CALL get_variable( id_salsa, 'emission_category_index', aero_emission_att%cat_index )
8615	!
8616	!-- Find corresponding emission categories
8617	DO in = 1, aero_emission_att%ncat
8618	in_name = aero_emission_att%cat_name(in)
8619	DO ss = 1, def_modes%ndc
8620	mod_name = def_modes%cat_name_table(ss)
8621	IF ( TRIM( in_name(1:4) ) == TRIM( mod_name(1:4 ) ) ) THEN
8622	def_modes%cat_input_to_model(ss) = in
8623	ENDIF
8624	ENDDO
8625	ENDDO
8626
8627	IF ( SUM( def_modes%cat_input_to_model ) == 0 ) THEN
8628	message_string = 'None of the emission categories in ' // TRIM( &
8629	input_file_salsa ) // ' match with the ones in the model.'
8630	CALL message( 'salsa_emission_setup', 'PA0632', 1, 2, 0, 6, 0 )
8631	ENDIF
8632	!
8633	!-- Emission time factors: Find check whether emission time factors are given for each
8634	!-- hour of year OR based on month, day and hour
8635	!
8636	!-- For each hour of year:
8637	IF ( check_existence( aero_emission_att%var_names, 'nhoursyear' ) ) THEN
8638	CALL netcdf_data_input_get_dimension_length( id_salsa, &
8639	aero_emission_att%nhoursyear, 'nhoursyear' )
8640	ALLOCATE( aero_emission_att%etf(1:aero_emission_att%ncat, &
8641	1:aero_emission_att%nhoursyear) )
8642	CALL get_variable( id_salsa, 'emission_time_factors', aero_emission_att%etf, &
8643	0, aero_emission_att%nhoursyear-1, 0, aero_emission_att%ncat-1 )
8644	!
8645	!-- Based on the month, day and hour:
8646	ELSEIF ( check_existence( aero_emission_att%var_names, 'nmonthdayhour' ) ) THEN
8647	CALL netcdf_data_input_get_dimension_length( id_salsa, &
8648	aero_emission_att%nmonthdayhour, &
8649	'nmonthdayhour' )
8650	ALLOCATE( aero_emission_att%etf(1:aero_emission_att%ncat, &
8651	1:aero_emission_att%nmonthdayhour) )
8652	CALL get_variable( id_salsa, 'emission_time_factors', aero_emission_att%etf, &
8653	0, aero_emission_att%nmonthdayhour-1, 0, aero_emission_att%ncat-1 )
8654	ELSE
8655	message_string = 'emission_time_factors should be given for each nhoursyear ' //&
8656	'OR nmonthdayhour'
8657	CALL message( 'salsa_emission_setup','PA0633', 1, 2, 0, 6, 0 )
8658	ENDIF
8659	!
8660	!-- Next emission update
8661	next_aero_emission_update = MOD( time_utc_init, 3600.0_wp ) - 3600.0_wp
8662	!
8663	!-- Get chemical composition (i.e. mass fraction of different species) in aerosols
8664	IF ( check_existence( aero_emission_att%var_names, 'emission_mass_fracs' ) ) THEN
8665	ALLOCATE( aero_emission%def_mass_fracs(1:aero_emission_att%ncat, &
8666	1:aero_emission_att%ncc) )
8667	aero_emission%def_mass_fracs = 0.0_wp
8668	CALL get_variable( id_salsa, 'emission_mass_fracs', aero_emission%def_mass_fracs,&
8669	0, aero_emission_att%ncc-1, 0, aero_emission_att%ncat-1 )
8670	ELSE
8671	message_string = 'Missing emission_mass_fracs in ' // TRIM( input_file_salsa )
8672	CALL message( 'salsa_emission_setup', 'PA0659', 1, 2, 0, 6, 0 )
8673	ENDIF
8674	!
8675	!-- If the chemical component is not activated, set its mass fraction to 0 to avoid
8676	!-- inbalance between number and mass flux
8677	cc_i2m = aero_emission_att%cc_in2mod
8678	IF ( index_so4 < 0 .AND. cc_i2m(1) > 0 ) &
8679	aero_emission%def_mass_fracs(:,cc_i2m(1)) = 0.0_wp
8680	IF ( index_oc < 0 .AND. cc_i2m(2) > 0 ) &
8681	aero_emission%def_mass_fracs(:,cc_i2m(2)) = 0.0_wp
8682	IF ( index_bc < 0 .AND. cc_i2m(3) > 0 ) &
8683	aero_emission%def_mass_fracs(:,cc_i2m(3)) = 0.0_wp
8684	IF ( index_du < 0 .AND. cc_i2m(4) > 0 ) &
8685	aero_emission%def_mass_fracs(:,cc_i2m(4)) = 0.0_wp
8686	IF ( index_ss < 0 .AND. cc_i2m(5) > 0 ) &
8687	aero_emission%def_mass_fracs(:,cc_i2m(5)) = 0.0_wp
8688	IF ( index_no < 0 .AND. cc_i2m(6) > 0 ) &
8689	aero_emission%def_mass_fracs(:,cc_i2m(6)) = 0.0_wp
8690	IF ( index_nh < 0 .AND. cc_i2m(7) > 0 ) &
8691	aero_emission%def_mass_fracs(:,cc_i2m(7)) = 0.0_wp
8692	!
8693	!-- Then normalise the mass fraction so that SUM = 1
8694	DO in = 1, aero_emission_att%ncat
8695	aero_emission%def_mass_fracs(in,:) = aero_emission%def_mass_fracs(in,:) / &
8696	SUM( aero_emission%def_mass_fracs(in,:) )
8697	ENDDO
8698	!
8699	!-- Calculate average mass density (kg/m3)
8700	aero_emission_att%rho = 0.0_wp
8701
8702	IF ( cc_i2m(1) /= 0 ) aero_emission_att%rho = aero_emission_att%rho + arhoh2so4 *&
8703	aero_emission%def_mass_fracs(:,cc_i2m(1))
8704	IF ( cc_i2m(2) /= 0 ) aero_emission_att%rho = aero_emission_att%rho + arhooc * &
8705	aero_emission%def_mass_fracs(:,cc_i2m(2))
8706	IF ( cc_i2m(3) /= 0 ) aero_emission_att%rho = aero_emission_att%rho + arhobc * &
8707	aero_emission%def_mass_fracs(:,cc_i2m(3))
8708	IF ( cc_i2m(4) /= 0 ) aero_emission_att%rho = aero_emission_att%rho + arhodu * &
8709	aero_emission%def_mass_fracs(:,cc_i2m(4))
8710	IF ( cc_i2m(5) /= 0 ) aero_emission_att%rho = aero_emission_att%rho + arhoss * &
8711	aero_emission%def_mass_fracs(:,cc_i2m(5))
8712	IF ( cc_i2m(6) /= 0 ) aero_emission_att%rho = aero_emission_att%rho + arhohno3 * &
8713	aero_emission%def_mass_fracs(:,cc_i2m(6))
8714	IF ( cc_i2m(7) /= 0 ) aero_emission_att%rho = aero_emission_att%rho + arhonh3 * &
8715	aero_emission%def_mass_fracs(:,cc_i2m(7))
8716	!
8717	!-- Allocate and read surface emission data (in total PM)
8718	ALLOCATE( aero_emission%def_data(nys:nyn,nxl:nxr,1:aero_emission_att%ncat) )
8719	CALL get_variable( id_salsa, 'aerosol_emission_values', aero_emission%def_data, &
8720	0, aero_emission_att%ncat-1, nxl, nxr, nys, nyn )
8721
8722	!
8723	!-- Pre-processed mode
8724	ELSEIF ( aero_emission_att%lod == 2 ) THEN
8725	!
8726	!-- Unit conversion factor: convert to SI units (#/m2/s)
8727	IF ( aero_emission_att%units == '#/m2/s' ) THEN
8728	aero_emission_att%conversion_factor = 1.0_wp
8729	ELSE
8730	message_string = 'unknown unit for aerosol emissions: ' // &
8731	TRIM( aero_emission_att%units )
8732	CALL message( 'salsa_emission_setup','PA0634', 1, 2, 0, 6, 0 )
8733	ENDIF
8734	!
8735	!-- Number of aerosol size bins in the emission data
8736	CALL netcdf_data_input_get_dimension_length( id_salsa, aero_emission_att%nbins, &
8737	'Dmid' )
8738	IF ( aero_emission_att%nbins /= nbins_aerosol ) THEN
8739	message_string = 'The number of size bins in aerosol input data does not ' // &
8740	'correspond to the model set-up'
8741	CALL message( 'salsa_emission_setup','PA0635', 1, 2, 0, 6, 0 )
8742	ENDIF
8743	!
8744	!-- Number of time steps in the emission data
8745	CALL netcdf_data_input_get_dimension_length( id_salsa, aero_emission_att%nt, 'time')
8746	!
8747	!-- Allocate bin diameters, time and mass fraction array
8748	ALLOCATE( aero_emission_att%dmid(1:nbins_aerosol), &
8749	aero_emission_att%time(1:aero_emission_att%nt), &
8750	aero_emission%preproc_mass_fracs(1:aero_emission_att%ncc) )
8751	!
8752	!-- Read mean diameters
8753	CALL get_variable( id_salsa, 'Dmid', aero_emission_att%dmid )
8754	!
8755	!-- Check whether the sectional representation of the aerosol size distribution conform
8756	!-- to the one applied in the model
8757	IF ( ANY( ABS( ( aero(1:nbins_aerosol)%dmid - aero_emission_att%dmid ) / &
8758	aero(1:nbins_aerosol)%dmid ) > 0.1_wp ) ) THEN
8759	message_string = 'Mean diameters of size bins in ' // TRIM( input_file_salsa ) &
8760	// ' do not match with the ones in the model.'
8761	CALL message( 'salsa_emission_setup','PA0636', 1, 2, 0, 6, 0 )
8762	ENDIF
8763	!
8764	!-- Read time stamps:
8765	IF ( check_existence( aero_emission_att%var_names, 'time' ) ) THEN
8766	CALL get_variable( id_salsa, 'time', aero_emission_att%time )
8767	ELSE
8768	message_string = 'Missing time in ' // TRIM( input_file_salsa )
8769	CALL message( 'salsa_emission_setup', 'PA0660', 1, 2, 0, 6, 0 )
8770	ENDIF
8771	!
8772	!-- Read emission mass fractions
8773	IF ( check_existence( aero_emission_att%var_names, 'emission_mass_fracs' ) ) THEN
8774	CALL get_variable( id_salsa, 'emission_mass_fracs', &
8775	aero_emission%preproc_mass_fracs )
8776	ELSE
8777	message_string = 'Missing emission_mass_fracs in ' // TRIM( input_file_salsa )
8778	CALL message( 'salsa_emission_setup', 'PA0659', 1, 2, 0, 6, 0 )
8779	ENDIF
8780	!
8781	!-- If the chemical component is not activated, set its mass fraction to 0
8782	cc_i2m = aero_emission_att%cc_in2mod
8783	IF ( index_so4 < 0 .AND. cc_i2m(1) /= 0 ) &
8784	aero_emission%preproc_mass_fracs(cc_i2m(1)) = 0.0_wp
8785	IF ( index_oc < 0 .AND. cc_i2m(2) /= 0 ) &
8786	aero_emission%preproc_mass_fracs(cc_i2m(2)) = 0.0_wp
8787	IF ( index_bc < 0 .AND. cc_i2m(3) /= 0 ) &
8788	aero_emission%preproc_mass_fracs(cc_i2m(3)) = 0.0_wp
8789	IF ( index_du < 0 .AND. cc_i2m(4) /= 0 ) &
8790	aero_emission%preproc_mass_fracs(cc_i2m(4)) = 0.0_wp
8791	IF ( index_ss < 0 .AND. cc_i2m(5) /= 0 ) &
8792	aero_emission%preproc_mass_fracs(cc_i2m(5)) = 0.0_wp
8793	IF ( index_no < 0 .AND. cc_i2m(6) /= 0 ) &
8794	aero_emission%preproc_mass_fracs(cc_i2m(6)) = 0.0_wp
8795	IF ( index_nh < 0 .AND. cc_i2m(7) /= 0 ) &
8796	aero_emission%preproc_mass_fracs(cc_i2m(7)) = 0.0_wp
8797	!
8798	!-- Then normalise the mass fraction so that SUM = 1
8799	aero_emission%preproc_mass_fracs = aero_emission%preproc_mass_fracs / &
8800	SUM( aero_emission%preproc_mass_fracs )
8801
8802	ELSE
8803	message_string = 'Unknown lod for aerosol_emission_values.'
8804	CALL message( 'salsa_emission','PA0637', 1, 2, 0, 6, 0 )
8805	ENDIF
8806
8807	ENDIF ! init
8808	!
8809	!-- Define and set current emission values:
8810	!
8811	!-- Default type emissions (aerosol emission given as total mass emission per year):
8812	IF ( aero_emission_att%lod == 1 ) THEN
8813	!
8814	!-- Emission time factors for each emission category at current time step
8815	IF ( aero_emission_att%nhoursyear > aero_emission_att%nmonthdayhour ) THEN
8816	!
8817	!-- Get the index of the current hour
8818	CALL time_default_indices( month_of_year, day_of_month, hour_of_day, index_hh )
8819	aero_emission_att%time_factor = aero_emission_att%etf(:,index_hh)
8820
8821	ELSEIF ( aero_emission_att%nhoursyear < aero_emission_att%nmonthdayhour ) THEN
8822	!
8823	!-- Get the index of current hour (index_hh) (TODO: Now "workday" is always assumed.
8824	!-- Needs to be calculated.)
8825	CALL time_default_indices( daytype, month_of_year, day_of_month, hour_of_day, &
8826	index_mm, index_dd, index_hh )
8827	aero_emission_att%time_factor = aero_emission_att%etf(:,index_mm) * &
8828	aero_emission_att%etf(:,index_dd) * &
8829	aero_emission_att%etf(:,index_hh)
8830	ENDIF
8831
8832	!
8833	!-- Create a sectional number size distribution for emissions
8834	ALLOCATE( nsect_emission(1:nbins_aerosol),source_array(nys:nyn,nxl:nxr,1:nbins_aerosol) )
8835	DO in = 1, aero_emission_att%ncat
8836
8837	inn = def_modes%cat_input_to_model(in)
8838	!
8839	!-- Calculate the number concentration (1/m3) of a log-normal size distribution
8840	!-- following Jacobson (2005): Eq 13.25.
8841	def_modes%ntot_table = 6.0_wp * def_modes%pm_frac_table(:,inn) / ( pi * &
8842	( def_modes%dpg_table )*3 EXP( 4.5_wp * &
8843	LOG( def_modes%sigmag_table )**2 ) )
8844	!
8845	!-- Sectional size distibution (1/m3) from a log-normal one
8846	CALL size_distribution( def_modes%ntot_table, def_modes%dpg_table, &
8847	def_modes%sigmag_table, nsect_emission )
8848
8849	source_array = 0.0_wp
8850	DO ib = 1, nbins_aerosol
8851	source_array(:,:,ib) = aero_emission%def_data(:,:,in) * &
8852	aero_emission_att%conversion_factor / &
8853	aero_emission_att%rho(in) * nsect_emission(ib) * &
8854	aero_emission_att%time_factor(in)
8855	ENDDO
8856	!
8857	!-- Set surface fluxes of aerosol number and mass on horizontal surfaces. Set fluxes
8858	!-- only for either default, land or urban surface.
8859	IF ( .NOT. land_surface .AND. .NOT. urban_surface ) THEN
8860	CALL set_flux( surf_def_h(0), aero_emission_att%cc_in2mod, &
8861	aero_emission%def_mass_fracs(in,:), source_array )
8862	ELSE
8863	CALL set_flux( surf_usm_h, aero_emission_att%cc_in2mod, &
8864	aero_emission%def_mass_fracs(in,:), source_array )
8865	CALL set_flux( surf_lsm_h, aero_emission_att%cc_in2mod, &
8866	aero_emission%def_mass_fracs(in,:), source_array )
8867	ENDIF
8868	ENDDO
8869	!
8870	!-- The next emission update is again after one hour
8871	next_aero_emission_update = next_aero_emission_update + 3600.0_wp
8872
8873
8874	DEALLOCATE( nsect_emission, source_array )
8875	!
8876	!-- Pre-processed:
8877	ELSEIF ( aero_emission_att%lod == 2 ) THEN
8878	!
8879	!-- Obtain time index for current input starting at 0.
8880	!-- @todo: At the moment emission data and simulated time correspond to each other.
8881	aero_emission_att%tind = MINLOC( ABS( aero_emission_att%time - &
8882	time_since_reference_point ), DIM = 1 ) - 1
8883	!
8884	!-- Allocate the data input array always before reading in the data and deallocate after
8885	ALLOCATE( aero_emission%preproc_data(nys:nyn,nxl:nxr,1:nbins_aerosol) )
8886	!
8887	!-- Read in the next time step
8888	CALL get_variable( id_salsa, 'aerosol_emission_values', aero_emission%preproc_data,&
8889	aero_emission_att%tind, 0, nbins_aerosol-1, nxl, nxr, nys, nyn )
8890	!
8891	!-- Set surface fluxes of aerosol number and mass on horizontal surfaces. Set fluxes only
8892	!-- for either default, land and urban surface.
8893	IF ( .NOT. land_surface .AND. .NOT. urban_surface ) THEN
8894	CALL set_flux( surf_def_h(0), aero_emission_att%cc_in2mod, &
8895	aero_emission%preproc_mass_fracs, aero_emission%preproc_data )
8896	ELSE
8897	CALL set_flux( surf_usm_h, aero_emission_att%cc_in2mod, &
8898	aero_emission%preproc_mass_fracs, aero_emission%preproc_data )
8899	CALL set_flux( surf_lsm_h, aero_emission_att%cc_in2mod, &
8900	aero_emission%preproc_mass_fracs, aero_emission%preproc_data )
8901	ENDIF
8902	!
8903	!-- Determine the next emission update
8904	next_aero_emission_update = aero_emission_att%time(aero_emission_att%tind+2)
8905
8906	DEALLOCATE( aero_emission%preproc_data )
8907
8908	ENDIF
8909	!
8910	!-- Close input file
8911	CALL close_input_file( id_salsa )
8912	#else
8913	message_string = 'salsa_emission_mode = "read_from_file", but preprocessor directive ' //&
8914	' __netcdf is not used in compiling!'
8915	CALL message( 'salsa_emission_setup', 'PA0638', 1, 2, 0, 6, 0 )
8916
8917	#endif
8918	CASE DEFAULT
8919	message_string = 'unknown salsa_emission_mode: ' // TRIM( salsa_emission_mode )
8920	CALL message( 'salsa_emission_setup', 'PA0639', 1, 2, 0, 6, 0 )
8921
8922	END SELECT
8923
8924	CONTAINS
8925
8926	!------------------------------------------------------------------------------!
8927	! Description:
8928	! ------------
8929	!> Sets the aerosol flux to aerosol arrays in 2a and 2b.
8930	!------------------------------------------------------------------------------!
8931	SUBROUTINE set_flux( surface, cc_i_mod, mass_fracs, source_array )
8932
8933	USE arrays_3d, &
8934	ONLY: rho_air_zw
8935
8936	USE surface_mod, &
8937	ONLY: surf_type
8938
8939	IMPLICIT NONE
8940
8941	INTEGER(iwp) :: i !< loop index
8942	INTEGER(iwp) :: ib !< loop index
8943	INTEGER(iwp) :: ic !< loop index
8944	INTEGER(iwp) :: j !< loop index
8945	INTEGER(iwp) :: k !< loop index
8946	INTEGER(iwp) :: m !< running index for surface elements
8947
8948	INTEGER(iwp), DIMENSION(:) :: cc_i_mod !< index of chemical component in the input data
8949
8950	REAL(wp) :: so4_oc !< mass fraction between SO4 and OC in 1a
8951
8952	REAL(wp), DIMENSION(:), INTENT(in) :: mass_fracs !< mass fractions of chemical components
8953
8954	REAL(wp), DIMENSION(nys:nyn,nxl:nxr,1:nbins_aerosol), INTENT(inout) :: source_array !<
8955
8956	TYPE(surf_type), INTENT(inout) :: surface !< respective surface type
8957
8958	so4_oc = 0.0_wp
8959
8960	DO m = 1, surface%ns
8961	!
8962	!-- Get indices of respective grid point
8963	i = surface%i(m)
8964	j = surface%j(m)
8965	k = surface%k(m)
8966
8967	DO ib = 1, nbins_aerosol
8968	IF ( source_array(j,i,ib) < nclim ) THEN
8969	source_array(j,i,ib) = 0.0_wp
8970	ENDIF
8971	!
8972	!-- Set mass fluxes. First bins include only SO4 and/or OC.
8973	IF ( ib <= end_subrange_1a ) THEN
8974	!
8975	!-- Both sulphate and organic carbon
8976	IF ( index_so4 > 0 .AND. index_oc > 0 ) THEN
8977
8978	ic = ( index_so4 - 1 ) * nbins_aerosol + ib
8979	so4_oc = mass_fracs(cc_i_mod(1)) / ( mass_fracs(cc_i_mod(1)) + &
8980	mass_fracs(cc_i_mod(2)) )
8981	surface%amsws(m,ic) = surface%amsws(m,ic) + so4_oc * source_array(j,i,ib) &
8982	* api6 * aero(ib)%dmid*3 arhoh2so4 * rho_air_zw(k-1)
8983	aerosol_mass(ic)%source(j,i) = aerosol_mass(ic)%source(j,i) + surface%amsws(m,ic)
8984
8985	ic = ( index_oc - 1 ) * nbins_aerosol + ib
8986	surface%amsws(m,ic) = surface%amsws(m,ic) + ( 1-so4_oc ) * source_array(j,i,ib) &
8987	* api6 * aero(ib)%dmid*3 arhooc * rho_air_zw(k-1)
8988	aerosol_mass(ic)%source(j,i) = aerosol_mass(ic)%source(j,i) + surface%amsws(m,ic)
8989	!
8990	!-- Only sulphates
8991	ELSEIF ( index_so4 > 0 .AND. index_oc < 0 ) THEN
8992	ic = ( index_so4 - 1 ) * nbins_aerosol + ib
8993	surface%amsws(m,ic) = surface%amsws(m,ic) + source_array(j,i,ib) * api6 * &
8994	aero(ib)%dmid*3 arhoh2so4 * rho_air_zw(k-1)
8995	aerosol_mass(ic)%source(j,i) = aerosol_mass(ic)%source(j,i) + surface%amsws(m,ic)
8996	!
8997	!-- Only organic carbon
8998	ELSEIF ( index_so4 < 0 .AND. index_oc > 0 ) THEN
8999	ic = ( index_oc - 1 ) * nbins_aerosol + ib
9000	surface%amsws(m,ic) = surface%amsws(m,ic) + source_array(j,i,ib) * api6 * &
9001	aero(ib)%dmid*3 arhooc * rho_air_zw(k-1)
9002	aerosol_mass(ic)%source(j,i) = aerosol_mass(ic)%source(j,i) + surface%amsws(m,ic)
9003	ENDIF
9004
9005	ELSE
9006	!
9007	!-- Sulphate
9008	IF ( index_so4 > 0 ) THEN
9009	ic = cc_i_mod(1)
9010	CALL set_mass_flux( surface, m, ib, index_so4, mass_fracs(ic), arhoh2so4, &
9011	source_array(j,i,ib) )
9012	ENDIF
9013	!
9014	!-- Organic carbon
9015	IF ( index_oc > 0 ) THEN
9016	ic = cc_i_mod(2)
9017	CALL set_mass_flux( surface, m, ib, index_oc, mass_fracs(ic),arhooc, &
9018	source_array(j,i,ib) )
9019	ENDIF
9020	!
9021	!-- Black carbon
9022	IF ( index_bc > 0 ) THEN
9023	ic = cc_i_mod(3)
9024	CALL set_mass_flux( surface, m, ib, index_bc, mass_fracs(ic), arhobc, &
9025	source_array(j,i,ib) )
9026	ENDIF
9027	!
9028	!-- Dust
9029	IF ( index_du > 0 ) THEN
9030	ic = cc_i_mod(4)
9031	CALL set_mass_flux( surface, m, ib, index_du, mass_fracs(ic), arhodu, &
9032	source_array(j,i,ib) )
9033	ENDIF
9034	!
9035	!-- Sea salt
9036	IF ( index_ss > 0 ) THEN
9037	ic = cc_i_mod(5)
9038	CALL set_mass_flux( surface, m, ib, index_ss, mass_fracs(ic), arhoss, &
9039	source_array(j,i,ib) )
9040	ENDIF
9041	!
9042	!-- Nitric acid
9043	IF ( index_no > 0 ) THEN
9044	ic = cc_i_mod(6)
9045	CALL set_mass_flux( surface, m, ib, index_no, mass_fracs(ic), arhohno3, &
9046	source_array(j,i,ib) )
9047	ENDIF
9048	!
9049	!-- Ammonia
9050	IF ( index_nh > 0 ) THEN
9051	ic = cc_i_mod(7)
9052	CALL set_mass_flux( surface, m, ib, index_nh, mass_fracs(ic), arhonh3, &
9053	source_array(j,i,ib) )
9054	ENDIF
9055
9056	ENDIF
9057	!
9058	!-- Save number fluxes in the end
9059	surface%answs(m,ib) = surface%answs(m,ib) + source_array(j,i,ib) * rho_air_zw(k-1)
9060	aerosol_number(ib)%source(j,i) = aerosol_number(ib)%source(j,i) + surface%answs(m,ib)
9061
9062	ENDDO ! ib
9063	ENDDO ! m
9064
9065	END SUBROUTINE set_flux
9066
9067	!------------------------------------------------------------------------------!
9068	! Description:
9069	! ------------
9070	!> Sets the mass emissions to aerosol arrays in 2a and 2b.
9071	!------------------------------------------------------------------------------!
9072	SUBROUTINE set_mass_flux( surface, surf_num, ib, ispec, mass_frac, prho, nsource )
9073
9074	USE arrays_3d, &
9075	ONLY: rho_air_zw
9076
9077	USE surface_mod, &
9078	ONLY: surf_type
9079
9080	IMPLICIT NONE
9081
9082	INTEGER(iwp) :: i !< loop index
9083	INTEGER(iwp) :: j !< loop index
9084	INTEGER(iwp) :: k !< loop index
9085	INTEGER(iwp) :: ic !< loop index
9086
9087	INTEGER(iwp), INTENT(in) :: ib !< Aerosol size bin index
9088	INTEGER(iwp), INTENT(in) :: ispec !< Aerosol species index
9089	INTEGER(iwp), INTENT(in) :: surf_num !< index surface elements
9090
9091	REAL(wp), INTENT(in) :: mass_frac !< mass fraction of a chemical compound in all bins
9092	REAL(wp), INTENT(in) :: nsource !< number source (#/m2/s)
9093	REAL(wp), INTENT(in) :: prho !< Aerosol density
9094
9095	TYPE(surf_type), INTENT(inout) :: surface !< respective surface type
9096	!
9097	!-- Get indices of respective grid point
9098	i = surface%i(surf_num)
9099	j = surface%j(surf_num)
9100	k = surface%k(surf_num)
9101	!
9102	!-- Subrange 2a:
9103	ic = ( ispec - 1 ) * nbins_aerosol + ib
9104	surface%amsws(surf_num,ic) = surface%amsws(surf_num,ic) + mass_frac * nsource * &
9105	aero(ib)%core * prho * rho_air_zw(k-1)
9106	aerosol_mass(ic)%source(j,i) = aerosol_mass(ic)%source(j,i) + surface%amsws(surf_num,ic)
9107
9108	END SUBROUTINE set_mass_flux
9109
9110	END SUBROUTINE salsa_emission_setup
9111
9112	!------------------------------------------------------------------------------!
9113	! Description:
9114	! ------------
9115	!> Sets the gaseous fluxes
9116	!------------------------------------------------------------------------------!
9117	SUBROUTINE salsa_gas_emission_setup( init )
9118
9119	USE date_and_time_mod, &
9120	ONLY: day_of_month, hour_of_day, index_dd, index_hh, index_mm, month_of_year, &
9121	time_default_indices, time_utc_init
9122
9123	USE netcdf_data_input_mod, &
9124	ONLY: check_existence, close_input_file, get_attribute, get_variable, &
9125	inquire_num_variables, inquire_variable_names, &
9126	netcdf_data_input_get_dimension_length, open_read_file
9127
9128	USE surface_mod, &
9129	ONLY: surf_def_h, surf_lsm_h, surf_usm_h
9130
9131	IMPLICIT NONE
9132
9133	CHARACTER(LEN=80) :: daytype = 'workday' !< default day type
9134	CHARACTER(LEN=25) :: in_name !< name of a gas in the input file
9135
9136	CHARACTER(LEN=100), DIMENSION(:), ALLOCATABLE :: var_names !< variable names in input data
9137
9138	INTEGER(iwp) :: id_chem !< NetCDF id of chemistry emission file
9139	INTEGER(iwp) :: i !< loop index
9140	INTEGER(iwp) :: ig !< loop index
9141	INTEGER(iwp) :: in !< running index for emission categories
9142	INTEGER(iwp) :: j !< loop index
9143	INTEGER(iwp) :: num_vars !< number of variables
9144
9145	LOGICAL :: netcdf_extend = .FALSE. !< NetCDF input file exists
9146
9147	LOGICAL, INTENT(in) :: init !< if .TRUE. --> initialisation call
9148
9149	REAL(wp), DIMENSION(:), ALLOCATABLE :: time_factor !< emission time factor
9150
9151	REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: dum_var_3d !<
9152
9153	REAL(wp), DIMENSION(:,:,:,:,:), ALLOCATABLE :: dum_var_5d !<
9154
9155	!
9156	!-- Reset surface fluxes
9157	surf_def_h(0)%gtsws = 0.0_wp
9158	surf_lsm_h%gtsws = 0.0_wp
9159	surf_usm_h%gtsws = 0.0_wp
9160
9161	#if defined( __netcdf )
9162	!
9163	!-- Check existence of PIDS_CHEM file
9164	INQUIRE( FILE = 'PIDS_CHEM' // TRIM( coupling_char ), EXIST = netcdf_extend )
9165	IF ( .NOT. netcdf_extend ) THEN
9166	message_string = 'Input file PIDS_CHEM' // TRIM( coupling_char ) // ' missing!'
9167	CALL message( 'salsa_gas_emission_setup', 'PA0640', 1, 2, 0, 6, 0 )
9168	ENDIF
9169	!
9170	!-- Open file in read-only mode
9171	CALL open_read_file( 'PIDS_CHEM' // TRIM( coupling_char ), id_chem )
9172
9173	IF ( init ) THEN
9174	!
9175	!-- Read the index and name of chemical components
9176	CALL netcdf_data_input_get_dimension_length( id_chem, chem_emission_att%n_emiss_species, &
9177	'nspecies' )
9178	ALLOCATE( chem_emission_att%species_index(1:chem_emission_att%n_emiss_species) )
9179	CALL get_variable( id_chem, 'emission_index', chem_emission_att%species_index )
9180	CALL get_variable( id_chem, 'emission_name', chem_emission_att%species_name, &
9181	chem_emission_att%n_emiss_species )
9182	!
9183	!-- Allocate emission data
9184	ALLOCATE( chem_emission(1:chem_emission_att%n_emiss_species) )
9185	!
9186	!-- Find the corresponding indices in the model
9187	emission_index_chem = 0
9188	DO ig = 1, chem_emission_att%n_emiss_species
9189	in_name = chem_emission_att%species_name(ig)
9190	SELECT CASE ( TRIM( in_name ) )
9191	CASE ( 'H2SO4', 'h2so4' )
9192	emission_index_chem(1) = ig
9193	CASE ( 'HNO3', 'hno3' )
9194	emission_index_chem(2) = ig
9195	CASE ( 'NH3', 'nh3' )
9196	emission_index_chem(3) = ig
9197	CASE ( 'OCNV', 'ocnv' )
9198	emission_index_chem(4) = ig
9199	CASE ( 'OCSV', 'ocsv' )
9200	emission_index_chem(5) = ig
9201	END SELECT
9202	ENDDO
9203	!
9204	!-- Inquire the fill value
9205	CALL get_attribute( id_chem, '_FillValue', aero_emission%fill, .FALSE., 'emission_values' )
9206	!
9207	!-- Inquire units of emissions
9208	CALL get_attribute( id_chem, 'units', chem_emission_att%units, .FALSE., 'emission_values' )
9209	!
9210	!-- Inquire the level of detail (lod)
9211	CALL get_attribute( id_chem, 'lod', lod_gas_emissions, .FALSE., 'emission_values' )
9212	!
9213	!-- Variable names
9214	CALL inquire_num_variables( id_chem, num_vars )
9215	ALLOCATE( var_names(1:num_vars) )
9216	CALL inquire_variable_names( id_chem, var_names )
9217	!
9218	!-- Default mode: as total emissions per year
9219	IF ( lod_gas_emissions == 1 ) THEN
9220
9221	!
9222	!-- Get number of emission categories and allocate emission arrays
9223	CALL netcdf_data_input_get_dimension_length( id_chem, chem_emission_att%ncat, 'ncat' )
9224	ALLOCATE( chem_emission_att%cat_index(1:chem_emission_att%ncat), &
9225	time_factor(1:chem_emission_att%ncat) )
9226	!
9227	!-- Get emission category names and indices
9228	CALL get_variable( id_chem, 'emission_category_name', chem_emission_att%cat_name, &
9229	chem_emission_att%ncat)
9230	CALL get_variable( id_chem, 'emission_category_index', chem_emission_att%cat_index )
9231	!
9232	!-- Emission time factors: Find check whether emission time factors are given for each hour
9233	!-- of year OR based on month, day and hour
9234	!
9235	!-- For each hour of year:
9236	IF ( check_existence( var_names, 'nhoursyear' ) ) THEN
9237	CALL netcdf_data_input_get_dimension_length( id_chem, chem_emission_att%nhoursyear, &
9238	'nhoursyear' )
9239	ALLOCATE( chem_emission_att%hourly_emis_time_factor(1:chem_emission_att%ncat, &
9240	1:chem_emission_att%nhoursyear) )
9241	CALL get_variable( id_chem, 'emission_time_factors', &
9242	chem_emission_att%hourly_emis_time_factor, &
9243	0, chem_emission_att%nhoursyear-1, 0, chem_emission_att%ncat-1 )
9244	!
9245	!-- Based on the month, day and hour:
9246	ELSEIF ( check_existence( var_names, 'nmonthdayhour' ) ) THEN
9247	CALL netcdf_data_input_get_dimension_length( id_chem, chem_emission_att%nmonthdayhour,&
9248	'nmonthdayhour' )
9249	ALLOCATE( chem_emission_att%mdh_emis_time_factor(1:chem_emission_att%ncat, &
9250	1:chem_emission_att%nmonthdayhour) )
9251	CALL get_variable( id_chem, 'emission_time_factors', &
9252	chem_emission_att%mdh_emis_time_factor, &
9253	0, chem_emission_att%nmonthdayhour-1, 0, chem_emission_att%ncat-1 )
9254	ELSE
9255	message_string = 'emission_time_factors should be given for each nhoursyear OR ' // &
9256	'nmonthdayhour'
9257	CALL message( 'salsa_gas_emission_setup','PA0641', 1, 2, 0, 6, 0 )
9258	ENDIF
9259	!
9260	!-- Next emission update
9261	next_gas_emission_update = MOD( time_utc_init, 3600.0_wp ) - 3600.0_wp
9262	!
9263	!-- Allocate and read surface emission data (in total PM) (NOTE that "preprocessed" input data
9264	!-- array is applied now here)
9265	ALLOCATE( dum_var_5d(1,nys:nyn,nxl:nxr,1:chem_emission_att%n_emiss_species, &
9266	1:chem_emission_att%ncat) )
9267	CALL get_variable( id_chem, 'emission_values', dum_var_5d, 0, chem_emission_att%ncat-1, &
9268	0, chem_emission_att%n_emiss_species-1, nxl, nxr, nys, nyn, 0, 0 )
9269	DO ig = 1, chem_emission_att%n_emiss_species
9270	ALLOCATE( chem_emission(ig)%default_emission_data(nys:nyn,nxl:nxr, &
9271	1:chem_emission_att%ncat) )
9272	DO in = 1, chem_emission_att%ncat
9273	DO i = nxl, nxr
9274	DO j = nys, nyn
9275	chem_emission(ig)%default_emission_data(j,i,in) = dum_var_5d(1,j,i,ig,in)
9276	ENDDO
9277	ENDDO
9278	ENDDO
9279	ENDDO
9280	DEALLOCATE( dum_var_5d )
9281	!
9282	!-- Pre-processed mode:
9283	ELSEIF ( lod_gas_emissions == 2 ) THEN
9284	!
9285	!-- Number of time steps in the emission data
9286	CALL netcdf_data_input_get_dimension_length( id_chem, chem_emission_att%dt_emission, &
9287	'time' )
9288	!
9289	!-- Allocate and read time
9290	ALLOCATE( gas_emission_time(1:chem_emission_att%dt_emission) )
9291	CALL get_variable( id_chem, 'time', gas_emission_time )
9292	ELSE
9293	message_string = 'Unknown lod for emission_values.'
9294	CALL message( 'salsa_gas_emission_setup','PA0642', 1, 2, 0, 6, 0 )
9295	ENDIF ! lod
9296
9297	ENDIF ! init
9298	!
9299	!-- Define and set current emission values:
9300
9301	IF ( lod_gas_emissions == 1 ) THEN
9302	!
9303	!-- Emission time factors for each emission category at current time step
9304	IF ( chem_emission_att%nhoursyear > chem_emission_att%nmonthdayhour ) THEN
9305	!
9306	!-- Get the index of the current hour
9307	CALL time_default_indices( month_of_year, day_of_month, hour_of_day, index_hh )
9308	time_factor = chem_emission_att%hourly_emis_time_factor(:,index_hh)
9309
9310	ELSEIF ( chem_emission_att%nhoursyear < chem_emission_att%nmonthdayhour ) THEN
9311	!
9312	!-- Get the index of current hour (index_hh) (TODO: Now "workday" is always assumed.
9313	!-- Needs to be calculated.)
9314	CALL time_default_indices( daytype, month_of_year, day_of_month, hour_of_day, &
9315	index_mm, index_dd, index_hh )
9316	time_factor = chem_emission_att%mdh_emis_time_factor(:,index_mm) * &
9317	chem_emission_att%mdh_emis_time_factor(:,index_dd) * &
9318	chem_emission_att%mdh_emis_time_factor(:,index_hh)
9319	ENDIF
9320	!
9321	!-- Set gas emissions for each emission category
9322	ALLOCATE( dum_var_3d(nys:nyn,nxl:nxr,1:chem_emission_att%n_emiss_species) )
9323
9324	DO in = 1, chem_emission_att%ncat
9325	DO ig = 1, chem_emission_att%n_emiss_species
9326	dum_var_3d(:,:,ig) = chem_emission(ig)%default_emission_data(:,:,in)
9327	ENDDO
9328	!
9329	!-- Set surface fluxes only for either default, land or urban surface
9330	IF ( .NOT. land_surface .AND. .NOT. urban_surface ) THEN
9331	CALL set_gas_flux( surf_def_h(0), emission_index_chem, chem_emission_att%units, &
9332	dum_var_3d(:,:,in), time_factor(in) )
9333	ELSE
9334	CALL set_gas_flux( surf_usm_h, emission_index_chem, chem_emission_att%units, &
9335	dum_var_3d(:,:,in), time_factor(in) )
9336	CALL set_gas_flux( surf_lsm_h, emission_index_chem, chem_emission_att%units, &
9337	dum_var_3d(:,:,in), time_factor(in) )
9338	ENDIF
9339	ENDDO
9340	DEALLOCATE( dum_var_3d )
9341	!
9342	!-- The next emission update is again after one hour
9343	next_gas_emission_update = next_gas_emission_update + 3600.0_wp
9344
9345	ELSEIF ( lod_gas_emissions == 2 ) THEN
9346	!
9347	!-- Obtain time index for current input starting at 0.
9348	!-- @todo: At the moment emission data and simulated time correspond to each other.
9349	chem_emission_att%i_hour = MINLOC( ABS( gas_emission_time - time_since_reference_point ), &
9350	DIM = 1 ) - 1
9351	!
9352	!-- Allocate the data input array always before reading in the data and deallocate after (NOTE
9353	!-- that "preprocessed" input data array is applied now here)
9354	ALLOCATE( dum_var_5d(1,1,nys:nyn,nxl:nxr,1:chem_emission_att%n_emiss_species) )
9355	!
9356	!-- Read in the next time step
9357	CALL get_variable( id_chem, 'emission_values', dum_var_5d, &
9358	0, chem_emission_att%n_emiss_species-1, nxl, nxr, nys, nyn, 0, 0, &
9359	chem_emission_att%i_hour, chem_emission_att%i_hour )
9360	!
9361	!-- Set surface fluxes only for either default, land or urban surface
9362	IF ( .NOT. land_surface .AND. .NOT. urban_surface ) THEN
9363	CALL set_gas_flux( surf_def_h(0), emission_index_chem, chem_emission_att%units, &
9364	dum_var_5d(1,1,:,:,:) )
9365	ELSE
9366	CALL set_gas_flux( surf_usm_h, emission_index_chem, chem_emission_att%units, &
9367	dum_var_5d(1,1,:,:,:) )
9368	CALL set_gas_flux( surf_lsm_h, emission_index_chem, chem_emission_att%units, &
9369	dum_var_5d(1,1,:,:,:) )
9370	ENDIF
9371	DEALLOCATE ( dum_var_5d )
9372	!
9373	!-- Determine the next emission update
9374	next_gas_emission_update = gas_emission_time(chem_emission_att%i_hour+2)
9375
9376	ENDIF
9377	!
9378	!-- Close input file
9379	CALL close_input_file( id_chem )
9380
9381	#else
9382	message_string = 'salsa_emission_mode = "read_from_file", but preprocessor directive ' // &
9383	' __netcdf is not used in compiling!'
9384	CALL message( 'salsa_gas_emission_setup', 'PA0643', 1, 2, 0, 6, 0 )
9385
9386	#endif
9387
9388	CONTAINS
9389	!------------------------------------------------------------------------------!
9390	! Description:
9391	! ------------
9392	!> Set gas fluxes for selected type of surfaces
9393	!------------------------------------------------------------------------------!
9394	SUBROUTINE set_gas_flux( surface, cc_i_mod, unit, source_array, time_fac )
9395
9396	USE arrays_3d, &
9397	ONLY: dzw, hyp, pt, rho_air_zw
9398
9399	USE grid_variables, &
9400	ONLY: dx, dy
9401
9402	USE surface_mod, &
9403	ONLY: surf_type
9404
9405	IMPLICIT NONE
9406
9407	CHARACTER(LEN=*), INTENT(in) :: unit !< flux unit in the input file
9408
9409	INTEGER(iwp) :: ig !< running index for gases
9410	INTEGER(iwp) :: i !< loop index
9411	INTEGER(iwp) :: j !< loop index
9412	INTEGER(iwp) :: k !< loop index
9413	INTEGER(iwp) :: m !< running index for surface elements
9414
9415	INTEGER(iwp), DIMENSION(:) :: cc_i_mod !< index of different gases in the input data
9416
9417	LOGICAL :: use_time_fac !< .TRUE. is time_fac present
9418
9419	REAL(wp), OPTIONAL :: time_fac !< emission time factor
9420
9421	REAL(wp), DIMENSION(ngases_salsa) :: conv !< unit conversion factor
9422
9423	REAL(wp), DIMENSION(nys:nyn,nxl:nxr,chem_emission_att%n_emiss_species), INTENT(in) :: source_array !<
9424
9425	TYPE(surf_type), INTENT(inout) :: surface !< respective surface type
9426
9427	conv = 1.0_wp
9428	use_time_fac = PRESENT( time_fac )
9429
9430	DO m = 1, surface%ns
9431	!
9432	!-- Get indices of respective grid point
9433	i = surface%i(m)
9434	j = surface%j(m)
9435	k = surface%k(m)
9436	!
9437	!-- Unit conversion factor: convert to SI units (#/m2/s)
9438	SELECT CASE ( TRIM( unit ) )
9439	CASE ( 'kg/m2/yr' )
9440	conv(1) = avo / ( amh2so4 * 3600.0_wp )
9441	conv(2) = avo / ( amhno3 * 3600.0_wp )
9442	conv(3) = avo / ( amnh3 * 3600.0_wp )
9443	conv(4) = avo / ( amoc * 3600.0_wp )
9444	conv(5) = avo / ( amoc * 3600.0_wp )
9445	CASE ( 'g/m2/yr' )
9446	conv(1) = avo / ( amh2so4 * 3.6E+6_wp )
9447	conv(2) = avo / ( amhno3 * 3.6E+6_wp )
9448	conv(3) = avo / ( amnh3 * 3.6E+6_wp )
9449	conv(4) = avo / ( amoc * 3.6E+6_wp )
9450	conv(5) = avo / ( amoc * 3.6E+6_wp )
9451	CASE ( 'g/m2/s' )
9452	conv(1) = avo / ( amh2so4 * 1000.0_wp )
9453	conv(2) = avo / ( amhno3 * 1000.0_wp )
9454	conv(3) = avo / ( amnh3 * 1000.0_wp )
9455	conv(4) = avo / ( amoc * 1000.0_wp )
9456	conv(5) = avo / ( amoc * 1000.0_wp )
9457	CASE ( '#/m2/s' )
9458	conv = 1.0_wp
9459	CASE ( 'ppm/m2/s' )
9460	conv = for_ppm_to_nconc * hyp(k) / pt(k,j,i) * ( 1.0E5_wp / hyp(k) )*0.286_wp &
9461	dx * dy * dzw(k)
9462	CASE ( 'mumol/m2/s' )
9463	conv = 1.0E-6_wp * avo
9464	CASE DEFAULT
9465	message_string = 'unknown unit for gas emissions: ' // TRIM( chem_emission_att%units )
9466	CALL message( 'set_gas_flux','PA0644', 1, 2, 0, 6, 0 )
9467
9468	END SELECT
9469
9470	DO ig = 1, ngases_salsa
9471	IF ( use_time_fac ) THEN
9472	surface%gtsws(m,ig) = surface%gtsws(m,ig) + rho_air_zw(k-1) * conv(ig) * time_fac &
9473	* MAX( 0.0_wp, source_array(j,i,cc_i_mod(ig) ) )
9474	ELSE
9475	surface%gtsws(m,ig) = surface%gtsws(m,ig) + rho_air_zw(k-1) * conv(ig) &
9476	* MAX( 0.0_wp, source_array(j,i,cc_i_mod(ig) ) )
9477	ENDIF
9478	ENDDO ! ig
9479
9480	ENDDO ! m
9481
9482	END SUBROUTINE set_gas_flux
9483
9484	END SUBROUTINE salsa_gas_emission_setup
9485
9486	!------------------------------------------------------------------------------!
9487	! Description:
9488	! ------------
9489	!> Check data output for salsa.
9490	!------------------------------------------------------------------------------!
9491	SUBROUTINE salsa_check_data_output( var, unit )
9492
9493	IMPLICIT NONE
9494
9495	CHARACTER(LEN=*) :: unit !<
9496	CHARACTER(LEN=*) :: var !<
9497
9498	INTEGER(iwp) :: char_to_int !< for converting character to integer
9499
9500	IF ( var(1:6) /= 'salsa_' ) THEN
9501	unit = 'illegal'
9502	RETURN
9503	ENDIF
9504	!
9505	!-- Treat bin-specific outputs separately
9506	IF ( var(7:11) == 'N_bin' ) THEN
9507	READ( var(12:),* ) char_to_int
9508	IF ( char_to_int >= 1 .AND. char_to_int <= SUM( nbin ) ) THEN
9509	unit = '#/m3'
9510	ELSE
9511	unit = 'illegal'
9512	RETURN
9513	ENDIF
9514
9515	ELSEIF ( var(7:11) == 'm_bin' ) THEN
9516	READ( var(12:),* ) char_to_int
9517	IF ( char_to_int >= 1 .AND. char_to_int <= SUM( nbin ) ) THEN
9518	unit = 'kg/m3'
9519	ELSE
9520	unit = 'illegal'
9521	RETURN
9522	ENDIF
9523
9524	ELSE
9525	SELECT CASE ( TRIM( var(7:) ) )
9526
9527	CASE ( 'g_H2SO4', 'g_HNO3', 'g_NH3', 'g_OCNV', 'g_OCSV' )
9528	IF ( salsa_gases_from_chem ) THEN
9529	message_string = 'gases are imported from the chemistry module and thus output '// &
9530	'of "' // TRIM( var ) // '" is not allowed'
9531	CALL message( 'check_parameters', 'PA0653', 1, 2, 0, 6, 0 )
9532	ENDIF
9533	unit = '#/m3'
9534
9535	CASE ( 'LDSA' )
9536	unit = 'mum2/cm3'
9537
9538	CASE ( 'PM0.1', 'PM2.5', 'PM10', 's_BC', 's_DU', 's_H2O', 's_NH', 's_NO', 's_OC', &
9539	's_SO4', 's_SS' )
9540	unit = 'kg/m3'
9541
9542	CASE ( 'N_UFP', 'Ntot' )
9543	unit = '#/m3'
9544
9545	CASE DEFAULT
9546	unit = 'illegal'
9547
9548	END SELECT
9549	ENDIF
9550
9551	END SUBROUTINE salsa_check_data_output
9552
9553	!------------------------------------------------------------------------------!
9554	! Description:
9555	! ------------
9556	!> Check profile data output for salsa. Currently only for diagnostic variables
9557	!> Ntot, N_UFP, PM0.1, PM2.5, PM10 and LDSA
9558	!------------------------------------------------------------------------------!
9559	SUBROUTINE salsa_check_data_output_pr( var, var_count, unit, dopr_unit )
9560
9561	USE arrays_3d, &
9562	ONLY: zu
9563
9564	USE profil_parameter, &
9565	ONLY: dopr_index
9566
9567	USE statistics, &
9568	ONLY: hom, pr_palm, statistic_regions
9569
9570	IMPLICIT NONE
9571
9572	CHARACTER(LEN=*) :: dopr_unit !<
9573	CHARACTER(LEN=*) :: unit !<
9574	CHARACTER(LEN=*) :: var !<
9575
9576	INTEGER(iwp) :: var_count !<
9577
9578	IF ( var(1:6) /= 'salsa_' ) THEN
9579	unit = 'illegal'
9580	RETURN
9581	ENDIF
9582
9583	SELECT CASE ( TRIM( var(7:) ) )
9584
9585	CASE( 'LDSA' )
9586	salsa_pr_count = salsa_pr_count + 1
9587	salsa_pr_index(salsa_pr_count) = 1
9588	dopr_index(var_count) = pr_palm + salsa_pr_count
9589	dopr_unit = 'mum2/cm3'
9590	unit = dopr_unit
9591	hom(:,2,dopr_index(var_count),:) = SPREAD( zu, 2, statistic_regions+1 )
9592
9593	CASE( 'N_UFP' )
9594	salsa_pr_count = salsa_pr_count + 1
9595	salsa_pr_index(salsa_pr_count) = 2
9596	dopr_index(var_count) = pr_palm + salsa_pr_count
9597	dopr_unit = '#/m3'
9598	unit = dopr_unit
9599	hom(:,2,dopr_index(var_count),:) = SPREAD( zu, 2, statistic_regions+1 )
9600
9601	CASE( 'Ntot' )
9602	salsa_pr_count = salsa_pr_count + 1
9603	salsa_pr_index(salsa_pr_count) = 3
9604	dopr_index(var_count) = pr_palm + salsa_pr_count
9605	dopr_unit = '#/m3'
9606	unit = dopr_unit
9607	hom(:,2,dopr_index(var_count),:) = SPREAD( zu, 2, statistic_regions+1 )
9608
9609	CASE( 'PM0.1' )
9610	salsa_pr_count = salsa_pr_count + 1
9611	salsa_pr_index(salsa_pr_count) = 4
9612	dopr_index(var_count) = pr_palm + salsa_pr_count
9613	dopr_unit = 'kg/m3'
9614	unit = dopr_unit
9615	hom(:,2,dopr_index(var_count),:) = SPREAD( zu, 2, statistic_regions+1 )
9616
9617	CASE( 'PM2.5' )
9618	salsa_pr_count = salsa_pr_count + 1
9619	salsa_pr_index(salsa_pr_count) = 5
9620	dopr_index(var_count) = pr_palm + salsa_pr_count
9621	dopr_unit = 'kg/m3'
9622	unit = dopr_unit
9623	hom(:,2,dopr_index(var_count),:) = SPREAD( zu, 2, statistic_regions+1 )
9624
9625	CASE( 'PM10' )
9626	salsa_pr_count = salsa_pr_count + 1
9627	salsa_pr_index(salsa_pr_count) = 6
9628	dopr_index(var_count) = pr_palm + salsa_pr_count
9629	dopr_unit = 'kg/m3'
9630	unit = dopr_unit
9631	hom(:,2,dopr_index(var_count),:) = SPREAD( zu, 2, statistic_regions+1 )
9632
9633	CASE DEFAULT
9634	unit = 'illegal'
9635
9636	END SELECT
9637
9638
9639	END SUBROUTINE salsa_check_data_output_pr
9640
9641	!-------------------------------------------------------------------------------!
9642	!> Description:
9643	!> Calculation of horizontally averaged profiles for salsa.
9644	!-------------------------------------------------------------------------------!
9645	SUBROUTINE salsa_statistics( mode, sr, tn )
9646
9647	USE control_parameters, &
9648	ONLY: max_pr_user
9649
9650	USE chem_modules, &
9651	ONLY: max_pr_cs
9652
9653	USE statistics, &
9654	ONLY: pr_palm, rmask, sums_l
9655
9656	IMPLICIT NONE
9657
9658	CHARACTER(LEN=*) :: mode !<
9659
9660	INTEGER(iwp) :: i !< loop index
9661	INTEGER(iwp) :: ib !< loop index
9662	INTEGER(iwp) :: ic !< loop index
9663	INTEGER(iwp) :: ii !< loop index
9664	INTEGER(iwp) :: ind !< index in the statistical output
9665	INTEGER(iwp) :: j !< loop index
9666	INTEGER(iwp) :: k !< loop index
9667	INTEGER(iwp) :: sr !< statistical region
9668	INTEGER(iwp) :: tn !< thread number
9669
9670	REAL(wp) :: df !< For calculating LDSA: fraction of particles depositing in the alveolar
9671	!< (or tracheobronchial) region of the lung. Depends on the particle size
9672	REAL(wp) :: mean_d !< Particle diameter in micrometres
9673	REAL(wp) :: temp_bin !< temporary variable
9674
9675	IF ( mode == 'profiles' ) THEN
9676	!$OMP DO
9677	DO ii = 1, salsa_pr_count
9678
9679	ind = pr_palm + max_pr_user + max_pr_cs + ii
9680
9681	SELECT CASE( salsa_pr_index(ii) )
9682
9683	CASE( 1 ) ! LDSA
9684	DO i = nxl, nxr
9685	DO j = nys, nyn
9686	DO k = nzb, nzt+1
9687	temp_bin = 0.0_wp
9688	DO ib = 1, nbins_aerosol
9689	!
9690	!-- Diameter in micrometres
9691	mean_d = 1.0E+6_wp * ra_dry(k,j,i,ib) * 2.0_wp
9692	!
9693	!-- Deposition factor: alveolar
9694	df = ( 0.01555_wp / mean_d ) * ( EXP( -0.416_wp * ( LOG( mean_d ) + &
9695	2.84_wp )*2 ) + 19.11_wp EXP( -0.482_wp * ( LOG( mean_d ) - &
9696	1.362_wp )**2 ) )
9697	!
9698	!-- Lung-deposited surface area LDSA (units mum2/cm3)
9699	temp_bin = temp_bin + pi * mean_d*2 df * 1.0E-6_wp * &
9700	aerosol_number(ib)%conc(k,j,i)
9701	ENDDO
9702	sums_l(k,ind,tn) = sums_l(k,ind,tn) + temp_bin * rmask(j,i,sr) * &
9703	MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_0(k,j,i), 22 ) )
9704	ENDDO
9705	ENDDO
9706	ENDDO
9707
9708	CASE( 2 ) ! N_UFP
9709	DO i = nxl, nxr
9710	DO j = nys, nyn
9711	DO k = nzb, nzt+1
9712	temp_bin = 0.0_wp
9713	DO ib = 1, nbins_aerosol
9714	IF ( 2.0_wp * ra_dry(k,j,i,ib) <= 0.1E-6_wp ) &
9715	temp_bin = temp_bin + aerosol_number(ib)%conc(k,j,i)
9716	ENDDO
9717	sums_l(k,ind,tn) = sums_l(k,ind,tn) + temp_bin * rmask(j,i,sr) * &
9718	MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_0(k,j,i), 22 ) )
9719	ENDDO
9720	ENDDO
9721	ENDDO
9722
9723	CASE( 3 ) ! Ntot
9724	DO i = nxl, nxr
9725	DO j = nys, nyn
9726	DO k = nzb, nzt+1
9727	temp_bin = 0.0_wp
9728	DO ib = 1, nbins_aerosol
9729	temp_bin = temp_bin + aerosol_number(ib)%conc(k,j,i)
9730	ENDDO
9731	sums_l(k,ind,tn) = sums_l(k,ind,tn) + temp_bin * rmask(j,i,sr) * &
9732	MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_0(k,j,i), 22 ) )
9733	ENDDO
9734	ENDDO
9735	ENDDO
9736
9737	CASE( 4 ) ! PM0.1
9738	DO i = nxl, nxr
9739	DO j = nys, nyn
9740	DO k = nzb, nzt+1
9741	temp_bin = 0.0_wp
9742	DO ib = 1, nbins_aerosol
9743	IF ( 2.0_wp * ra_dry(k,j,i,ib) <= 0.1E-6_wp ) THEN
9744	DO ic = ib, nbins_aerosol * ncc, nbins_aerosol
9745	temp_bin = temp_bin + aerosol_mass(ic)%conc(k,j,i)
9746	ENDDO
9747	ENDIF
9748	ENDDO
9749	sums_l(k,ind,tn) = sums_l(k,ind,tn) + temp_bin * rmask(j,i,sr) * &
9750	MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_0(k,j,i), 22 ) )
9751	ENDDO
9752	ENDDO
9753	ENDDO
9754
9755	CASE( 5 ) ! PM2.5
9756	DO i = nxl, nxr
9757	DO j = nys, nyn
9758	DO k = nzb, nzt+1
9759	temp_bin = 0.0_wp
9760	DO ib = 1, nbins_aerosol
9761	IF ( 2.0_wp * ra_dry(k,j,i,ib) <= 2.5E-6_wp ) THEN
9762	DO ic = ib, nbins_aerosol * ncc, nbins_aerosol
9763	temp_bin = temp_bin + aerosol_mass(ic)%conc(k,j,i)
9764	ENDDO
9765	ENDIF
9766	ENDDO
9767	sums_l(k,ind,tn) = sums_l(k,ind,tn) + temp_bin * rmask(j,i,sr) * &
9768	MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_0(k,j,i), 22 ) )
9769	ENDDO
9770	ENDDO
9771	ENDDO
9772
9773	CASE( 6 ) ! PM10
9774	DO i = nxl, nxr
9775	DO j = nys, nyn
9776	DO k = nzb, nzt+1
9777	temp_bin = 0.0_wp
9778	DO ib = 1, nbins_aerosol
9779	IF ( 2.0_wp * ra_dry(k,j,i,ib) <= 10.0E-6_wp ) THEN
9780	DO ic = ib, nbins_aerosol * ncc, nbins_aerosol
9781	temp_bin = temp_bin + aerosol_mass(ic)%conc(k,j,i)
9782	ENDDO
9783	ENDIF
9784	ENDDO
9785	sums_l(k,ind,tn) = sums_l(k,ind,tn) + temp_bin * rmask(j,i,sr) * &
9786	MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_0(k,j,i), 22 ) )
9787	ENDDO
9788	ENDDO
9789	ENDDO
9790
9791	END SELECT
9792	ENDDO
9793
9794	ELSEIF ( mode == 'time_series' ) THEN
9795	!
9796	!-- TODO
9797	ENDIF
9798
9799	END SUBROUTINE salsa_statistics
9800
9801
9802	!------------------------------------------------------------------------------!
9803	!
9804	! Description:
9805	! ------------
9806	!> Subroutine for averaging 3D data
9807	!------------------------------------------------------------------------------!
9808	SUBROUTINE salsa_3d_data_averaging( mode, variable )
9809
9810	USE control_parameters, &
9811	ONLY: average_count_3d
9812
9813	IMPLICIT NONE
9814
9815	CHARACTER(LEN=*) :: mode !<
9816	CHARACTER(LEN=10) :: vari !<
9817	CHARACTER(LEN=*) :: variable !<
9818
9819	INTEGER(iwp) :: char_to_int !< for converting character to integer
9820	INTEGER(iwp) :: found_index !<
9821	INTEGER(iwp) :: i !<
9822	INTEGER(iwp) :: ib !<
9823	INTEGER(iwp) :: ic !<
9824	INTEGER(iwp) :: j !<
9825	INTEGER(iwp) :: k !<
9826
9827	REAL(wp) :: df !< For calculating LDSA: fraction of particles depositing in the alveolar
9828	!< (or tracheobronchial) region of the lung. Depends on the particle size
9829	REAL(wp) :: mean_d !< Particle diameter in micrometres
9830	REAL(wp) :: temp_bin !< temporary variable
9831
9832	REAL(wp), DIMENSION(:,:,:), POINTER :: to_be_resorted !< points to selected output variable
9833
9834	temp_bin = 0.0_wp
9835
9836	IF ( mode == 'allocate' ) THEN
9837
9838	IF ( variable(7:11) == 'N_bin' ) THEN
9839	IF ( .NOT. ALLOCATED( nbins_av ) ) THEN
9840	ALLOCATE( nbins_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg,nbins_aerosol) )
9841	ENDIF
9842	nbins_av = 0.0_wp
9843
9844	ELSEIF ( variable(7:11) == 'm_bin' ) THEN
9845	IF ( .NOT. ALLOCATED( mbins_av ) ) THEN
9846	ALLOCATE( mbins_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg,nbins_aerosol) )
9847	ENDIF
9848	mbins_av = 0.0_wp
9849
9850	ELSE
9851
9852	SELECT CASE ( TRIM( variable(7:) ) )
9853
9854	CASE ( 'g_H2SO4' )
9855	IF ( .NOT. ALLOCATED( g_h2so4_av ) ) THEN
9856	ALLOCATE( g_h2so4_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
9857	ENDIF
9858	g_h2so4_av = 0.0_wp
9859
9860	CASE ( 'g_HNO3' )
9861	IF ( .NOT. ALLOCATED( g_hno3_av ) ) THEN
9862	ALLOCATE( g_hno3_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
9863	ENDIF
9864	g_hno3_av = 0.0_wp
9865
9866	CASE ( 'g_NH3' )
9867	IF ( .NOT. ALLOCATED( g_nh3_av ) ) THEN
9868	ALLOCATE( g_nh3_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
9869	ENDIF
9870	g_nh3_av = 0.0_wp
9871
9872	CASE ( 'g_OCNV' )
9873	IF ( .NOT. ALLOCATED( g_ocnv_av ) ) THEN
9874	ALLOCATE( g_ocnv_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
9875	ENDIF
9876	g_ocnv_av = 0.0_wp
9877
9878	CASE ( 'g_OCSV' )
9879	IF ( .NOT. ALLOCATED( g_ocsv_av ) ) THEN
9880	ALLOCATE( g_ocsv_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
9881	ENDIF
9882	g_ocsv_av = 0.0_wp
9883
9884	CASE ( 'LDSA' )
9885	IF ( .NOT. ALLOCATED( ldsa_av ) ) THEN
9886	ALLOCATE( ldsa_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
9887	ENDIF
9888	ldsa_av = 0.0_wp
9889
9890	CASE ( 'N_UFP' )
9891	IF ( .NOT. ALLOCATED( nufp_av ) ) THEN
9892	ALLOCATE( nufp_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
9893	ENDIF
9894	nufp_av = 0.0_wp
9895
9896	CASE ( 'Ntot' )
9897	IF ( .NOT. ALLOCATED( ntot_av ) ) THEN
9898	ALLOCATE( ntot_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
9899	ENDIF
9900	ntot_av = 0.0_wp
9901
9902	CASE ( 'PM0.1' )
9903	IF ( .NOT. ALLOCATED( pm01_av ) ) THEN
9904	ALLOCATE( pm01_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
9905	ENDIF
9906	pm01_av = 0.0_wp
9907
9908	CASE ( 'PM2.5' )
9909	IF ( .NOT. ALLOCATED( pm25_av ) ) THEN
9910	ALLOCATE( pm25_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
9911	ENDIF
9912	pm25_av = 0.0_wp
9913
9914	CASE ( 'PM10' )
9915	IF ( .NOT. ALLOCATED( pm10_av ) ) THEN
9916	ALLOCATE( pm10_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
9917	ENDIF
9918	pm10_av = 0.0_wp
9919
9920	CASE ( 's_BC' )
9921	IF ( .NOT. ALLOCATED( s_bc_av ) ) THEN
9922	ALLOCATE( s_bc_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
9923	ENDIF
9924	s_bc_av = 0.0_wp
9925
9926	CASE ( 's_DU' )
9927	IF ( .NOT. ALLOCATED( s_du_av ) ) THEN
9928	ALLOCATE( s_du_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
9929	ENDIF
9930	s_du_av = 0.0_wp
9931
9932	CASE ( 's_H2O' )
9933	IF ( .NOT. ALLOCATED( s_h2o_av ) ) THEN
9934	ALLOCATE( s_h2o_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
9935	ENDIF
9936	s_h2o_av = 0.0_wp
9937
9938	CASE ( 's_NH' )
9939	IF ( .NOT. ALLOCATED( s_nh_av ) ) THEN
9940	ALLOCATE( s_nh_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
9941	ENDIF
9942	s_nh_av = 0.0_wp
9943
9944	CASE ( 's_NO' )
9945	IF ( .NOT. ALLOCATED( s_no_av ) ) THEN
9946	ALLOCATE( s_no_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
9947	ENDIF
9948	s_no_av = 0.0_wp
9949
9950	CASE ( 's_OC' )
9951	IF ( .NOT. ALLOCATED( s_oc_av ) ) THEN
9952	ALLOCATE( s_oc_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
9953	ENDIF
9954	s_oc_av = 0.0_wp
9955
9956	CASE ( 's_SO4' )
9957	IF ( .NOT. ALLOCATED( s_so4_av ) ) THEN
9958	ALLOCATE( s_so4_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
9959	ENDIF
9960	s_so4_av = 0.0_wp
9961
9962	CASE ( 's_SS' )
9963	IF ( .NOT. ALLOCATED( s_ss_av ) ) THEN
9964	ALLOCATE( s_ss_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
9965	ENDIF
9966	s_ss_av = 0.0_wp
9967
9968	CASE DEFAULT
9969	CONTINUE
9970
9971	END SELECT
9972
9973	ENDIF
9974
9975	ELSEIF ( mode == 'sum' ) THEN
9976
9977	IF ( variable(7:11) == 'N_bin' ) THEN
9978	READ( variable(12:),* ) char_to_int
9979	IF ( char_to_int >= 1 .AND. char_to_int <= SUM( nbin ) ) THEN
9980	ib = char_to_int
9981	DO i = nxlg, nxrg
9982	DO j = nysg, nyng
9983	DO k = nzb, nzt+1
9984	nbins_av(k,j,i,ib) = nbins_av(k,j,i,ib) + aerosol_number(ib)%conc(k,j,i)
9985	ENDDO
9986	ENDDO
9987	ENDDO
9988	ENDIF
9989
9990	ELSEIF ( variable(7:11) == 'm_bin' ) THEN
9991	READ( variable(12:),* ) char_to_int
9992	IF ( char_to_int >= 1 .AND. char_to_int <= SUM( nbin ) ) THEN
9993	ib = char_to_int
9994	DO i = nxlg, nxrg
9995	DO j = nysg, nyng
9996	DO k = nzb, nzt+1
9997	temp_bin = 0.0_wp
9998	DO ic = ib, nbins_aerosol * ncomponents_mass, nbins_aerosol
9999	temp_bin = temp_bin + aerosol_mass(ic)%conc(k,j,i)
10000	ENDDO
10001	mbins_av(k,j,i,ib) = mbins_av(k,j,i,ib) + temp_bin
10002	ENDDO
10003	ENDDO
10004	ENDDO
10005	ENDIF
10006	ELSE
10007
10008	SELECT CASE ( TRIM( variable(7:) ) )
10009
10010	CASE ( 'g_H2SO4', 'g_HNO3', 'g_NH3', 'g_OCNV', 'g_OCSV' )
10011
10012	vari = TRIM( variable(9:) ) ! remove salsa_g_ from beginning
10013
10014	SELECT CASE( vari )
10015
10016	CASE( 'H2SO4' )
10017	found_index = 1
10018	to_be_resorted => g_h2so4_av
10019
10020	CASE( 'HNO3' )
10021	found_index = 2
10022	to_be_resorted => g_hno3_av
10023
10024	CASE( 'NH3' )
10025	found_index = 3
10026	to_be_resorted => g_nh3_av
10027
10028	CASE( 'OCNV' )
10029	found_index = 4
10030	to_be_resorted => g_ocnv_av
10031
10032	CASE( 'OCSV' )
10033	found_index = 5
10034	to_be_resorted => g_ocsv_av
10035
10036	END SELECT
10037
10038	DO i = nxlg, nxrg
10039	DO j = nysg, nyng
10040	DO k = nzb, nzt+1
10041	to_be_resorted(k,j,i) = to_be_resorted(k,j,i) + &
10042	salsa_gas(found_index)%conc(k,j,i)
10043	ENDDO
10044	ENDDO
10045	ENDDO
10046
10047	CASE ( 'LDSA' )
10048	DO i = nxlg, nxrg
10049	DO j = nysg, nyng
10050	DO k = nzb, nzt+1
10051	temp_bin = 0.0_wp
10052	DO ib = 1, nbins_aerosol
10053	!
10054	!-- Diameter in micrometres
10055	mean_d = 1.0E+6_wp * ra_dry(k,j,i,ib) * 2.0_wp
10056	!
10057	!-- Deposition factor: alveolar (use ra_dry)
10058	df = ( 0.01555_wp / mean_d ) * ( EXP( -0.416_wp * ( LOG( mean_d ) + &
10059	2.84_wp )*2 ) + 19.11_wp EXP( -0.482_wp * ( LOG( mean_d ) - &
10060	1.362_wp )**2 ) )
10061	!
10062	!-- Lung-deposited surface area LDSA (units mum2/cm3)
10063	temp_bin = temp_bin + pi * mean_d*2 df * 1.0E-6_wp * &
10064	aerosol_number(ib)%conc(k,j,i)
10065	ENDDO
10066	ldsa_av(k,j,i) = ldsa_av(k,j,i) + temp_bin
10067	ENDDO
10068	ENDDO
10069	ENDDO
10070
10071	CASE ( 'N_UFP' )
10072	DO i = nxlg, nxrg
10073	DO j = nysg, nyng
10074	DO k = nzb, nzt+1
10075	temp_bin = 0.0_wp
10076	DO ib = 1, nbins_aerosol
10077	IF ( 2.0_wp * ra_dry(k,j,i,ib) <= 0.1E-6_wp ) THEN
10078	temp_bin = temp_bin + aerosol_number(ib)%conc(k,j,i)
10079	ENDIF
10080	ENDDO
10081	nufp_av(k,j,i) = nufp_av(k,j,i) + temp_bin
10082	ENDDO
10083	ENDDO
10084	ENDDO
10085
10086	CASE ( 'Ntot' )
10087	DO i = nxlg, nxrg
10088	DO j = nysg, nyng
10089	DO k = nzb, nzt+1
10090	DO ib = 1, nbins_aerosol
10091	ntot_av(k,j,i) = ntot_av(k,j,i) + aerosol_number(ib)%conc(k,j,i)
10092	ENDDO
10093	ENDDO
10094	ENDDO
10095	ENDDO
10096
10097	CASE ( 'PM0.1' )
10098	DO i = nxlg, nxrg
10099	DO j = nysg, nyng
10100	DO k = nzb, nzt+1
10101	temp_bin = 0.0_wp
10102	DO ib = 1, nbins_aerosol
10103	IF ( 2.0_wp * ra_dry(k,j,i,ib) <= 0.1E-6_wp ) THEN
10104	DO ic = ib, nbins_aerosol * ncc, nbins_aerosol
10105	temp_bin = temp_bin + aerosol_mass(ic)%conc(k,j,i)
10106	ENDDO
10107	ENDIF
10108	ENDDO
10109	pm01_av(k,j,i) = pm01_av(k,j,i) + temp_bin
10110	ENDDO
10111	ENDDO
10112	ENDDO
10113
10114	CASE ( 'PM2.5' )
10115	DO i = nxlg, nxrg
10116	DO j = nysg, nyng
10117	DO k = nzb, nzt+1
10118	temp_bin = 0.0_wp
10119	DO ib = 1, nbins_aerosol
10120	IF ( 2.0_wp * ra_dry(k,j,i,ib) <= 2.5E-6_wp ) THEN
10121	DO ic = ib, nbins_aerosol * ncc, nbins_aerosol
10122	temp_bin = temp_bin + aerosol_mass(ic)%conc(k,j,i)
10123	ENDDO
10124	ENDIF
10125	ENDDO
10126	pm25_av(k,j,i) = pm25_av(k,j,i) + temp_bin
10127	ENDDO
10128	ENDDO
10129	ENDDO
10130
10131	CASE ( 'PM10' )
10132	DO i = nxlg, nxrg
10133	DO j = nysg, nyng
10134	DO k = nzb, nzt+1
10135	temp_bin = 0.0_wp
10136	DO ib = 1, nbins_aerosol
10137	IF ( 2.0_wp * ra_dry(k,j,i,ib) <= 10.0E-6_wp ) THEN
10138	DO ic = ib, nbins_aerosol * ncc, nbins_aerosol
10139	temp_bin = temp_bin + aerosol_mass(ic)%conc(k,j,i)
10140	ENDDO
10141	ENDIF
10142	ENDDO
10143	pm10_av(k,j,i) = pm10_av(k,j,i) + temp_bin
10144	ENDDO
10145	ENDDO
10146	ENDDO
10147
10148	CASE ( 's_BC', 's_DU', 's_NH', 's_NO', 's_OC', 's_SO4', 's_SS' )
10149	IF ( is_used( prtcl, TRIM( variable(9:) ) ) ) THEN ! 9: remove salsa_s_
10150	found_index = get_index( prtcl, TRIM( variable(9:) ) )
10151	IF ( TRIM( variable(9:) ) == 'BC' ) to_be_resorted => s_bc_av
10152	IF ( TRIM( variable(9:) ) == 'DU' ) to_be_resorted => s_du_av
10153	IF ( TRIM( variable(9:) ) == 'NH' ) to_be_resorted => s_nh_av
10154	IF ( TRIM( variable(9:) ) == 'NO' ) to_be_resorted => s_no_av
10155	IF ( TRIM( variable(9:) ) == 'OC' ) to_be_resorted => s_oc_av
10156	IF ( TRIM( variable(9:) ) == 'SO4' ) to_be_resorted => s_so4_av
10157	IF ( TRIM( variable(9:) ) == 'SS' ) to_be_resorted => s_ss_av
10158	DO i = nxlg, nxrg
10159	DO j = nysg, nyng
10160	DO k = nzb, nzt+1
10161	DO ic = ( found_index-1 ) * nbins_aerosol + 1, found_index * nbins_aerosol
10162	to_be_resorted(k,j,i) = to_be_resorted(k,j,i) + &
10163	aerosol_mass(ic)%conc(k,j,i)
10164	ENDDO
10165	ENDDO
10166	ENDDO
10167	ENDDO
10168	ENDIF
10169
10170	CASE ( 's_H2O' )
10171	found_index = get_index( prtcl,'H2O' )
10172	to_be_resorted => s_h2o_av
10173	DO i = nxlg, nxrg
10174	DO j = nysg, nyng
10175	DO k = nzb, nzt+1
10176	DO ic = ( found_index-1 ) * nbins_aerosol + 1, found_index * nbins_aerosol
10177	s_h2o_av(k,j,i) = s_h2o_av(k,j,i) + aerosol_mass(ic)%conc(k,j,i)
10178	ENDDO
10179	ENDDO
10180	ENDDO
10181	ENDDO
10182
10183	CASE DEFAULT
10184	CONTINUE
10185
10186	END SELECT
10187
10188	ENDIF
10189
10190	ELSEIF ( mode == 'average' ) THEN
10191
10192	IF ( variable(7:11) == 'N_bin' ) THEN
10193	READ( variable(12:),* ) char_to_int
10194	IF ( char_to_int >= 1 .AND. char_to_int <= SUM( nbin ) ) THEN
10195	ib = char_to_int
10196	DO i = nxlg, nxrg
10197	DO j = nysg, nyng
10198	DO k = nzb, nzt+1
10199	nbins_av(k,j,i,ib) = nbins_av(k,j,i,ib) / REAL( average_count_3d, KIND=wp )
10200	ENDDO
10201	ENDDO
10202	ENDDO
10203	ENDIF
10204
10205	ELSEIF ( variable(7:11) == 'm_bin' ) THEN
10206	READ( variable(12:),* ) char_to_int
10207	IF ( char_to_int >= 1 .AND. char_to_int <= SUM( nbin ) ) THEN
10208	ib = char_to_int
10209	DO i = nxlg, nxrg
10210	DO j = nysg, nyng
10211	DO k = nzb, nzt+1
10212	mbins_av(k,j,i,ib) = mbins_av(k,j,i,ib) / REAL( average_count_3d, KIND=wp)
10213	ENDDO
10214	ENDDO
10215	ENDDO
10216	ENDIF
10217	ELSE
10218
10219	SELECT CASE ( TRIM( variable(7:) ) )
10220
10221	CASE ( 'g_H2SO4', 'g_HNO3', 'g_NH3', 'g_OCNV', 'g_OCSV' )
10222	IF ( TRIM( variable(9:) ) == 'H2SO4' ) THEN ! 9: remove salsa_g_ from beginning
10223	found_index = 1
10224	to_be_resorted => g_h2so4_av
10225	ELSEIF ( TRIM( variable(9:) ) == 'HNO3' ) THEN
10226	found_index = 2
10227	to_be_resorted => g_hno3_av
10228	ELSEIF ( TRIM( variable(9:) ) == 'NH3' ) THEN
10229	found_index = 3
10230	to_be_resorted => g_nh3_av
10231	ELSEIF ( TRIM( variable(9:) ) == 'OCNV' ) THEN
10232	found_index = 4
10233	to_be_resorted => g_ocnv_av
10234	ELSEIF ( TRIM( variable(9:) ) == 'OCSV' ) THEN
10235	found_index = 5
10236	to_be_resorted => g_ocsv_av
10237	ENDIF
10238	DO i = nxlg, nxrg
10239	DO j = nysg, nyng
10240	DO k = nzb, nzt+1
10241	to_be_resorted(k,j,i) = to_be_resorted(k,j,i) / &
10242	REAL( average_count_3d, KIND=wp )
10243	ENDDO
10244	ENDDO
10245	ENDDO
10246
10247	CASE ( 'LDSA' )
10248	DO i = nxlg, nxrg
10249	DO j = nysg, nyng
10250	DO k = nzb, nzt+1
10251	ldsa_av(k,j,i) = ldsa_av(k,j,i) / REAL( average_count_3d, KIND=wp )
10252	ENDDO
10253	ENDDO
10254	ENDDO
10255
10256	CASE ( 'N_UFP' )
10257	DO i = nxlg, nxrg
10258	DO j = nysg, nyng
10259	DO k = nzb, nzt+1
10260	nufp_av(k,j,i) = nufp_av(k,j,i) / REAL( average_count_3d, KIND=wp )
10261	ENDDO
10262	ENDDO
10263	ENDDO
10264
10265	CASE ( 'Ntot' )
10266	DO i = nxlg, nxrg
10267	DO j = nysg, nyng
10268	DO k = nzb, nzt+1
10269	ntot_av(k,j,i) = ntot_av(k,j,i) / REAL( average_count_3d, KIND=wp )
10270	ENDDO
10271	ENDDO
10272	ENDDO
10273
10274
10275	CASE ( 'PM0.1' )
10276	DO i = nxlg, nxrg
10277	DO j = nysg, nyng
10278	DO k = nzb, nzt+1
10279	pm01_av(k,j,i) = pm01_av(k,j,i) / REAL( average_count_3d, KIND=wp )
10280	ENDDO
10281	ENDDO
10282	ENDDO
10283
10284	CASE ( 'PM2.5' )
10285	DO i = nxlg, nxrg
10286	DO j = nysg, nyng
10287	DO k = nzb, nzt+1
10288	pm25_av(k,j,i) = pm25_av(k,j,i) / REAL( average_count_3d, KIND=wp )
10289	ENDDO
10290	ENDDO
10291	ENDDO
10292
10293	CASE ( 'PM10' )
10294	DO i = nxlg, nxrg
10295	DO j = nysg, nyng
10296	DO k = nzb, nzt+1
10297	pm10_av(k,j,i) = pm10_av(k,j,i) / REAL( average_count_3d, KIND=wp )
10298	ENDDO
10299	ENDDO
10300	ENDDO
10301
10302	CASE ( 's_BC', 's_DU', 's_NH', 's_NO', 's_OC', 's_SO4', 's_SS' )
10303	IF ( is_used( prtcl, TRIM( variable(9:) ) ) ) THEN ! 9: remove salsa_s_
10304	IF ( TRIM( variable(9:) ) == 'BC' ) to_be_resorted => s_bc_av
10305	IF ( TRIM( variable(9:) ) == 'DU' ) to_be_resorted => s_du_av
10306	IF ( TRIM( variable(9:) ) == 'NH' ) to_be_resorted => s_nh_av
10307	IF ( TRIM( variable(9:) ) == 'NO' ) to_be_resorted => s_no_av
10308	IF ( TRIM( variable(9:) ) == 'OC' ) to_be_resorted => s_oc_av
10309	IF ( TRIM( variable(9:) ) == 'SO4' ) to_be_resorted => s_so4_av
10310	IF ( TRIM( variable(9:) ) == 'SS' ) to_be_resorted => s_ss_av
10311	DO i = nxlg, nxrg
10312	DO j = nysg, nyng
10313	DO k = nzb, nzt+1
10314	to_be_resorted(k,j,i) = to_be_resorted(k,j,i) / &
10315	REAL( average_count_3d, KIND=wp )
10316	ENDDO
10317	ENDDO
10318	ENDDO
10319	ENDIF
10320
10321	CASE ( 's_H2O' )
10322	to_be_resorted => s_h2o_av
10323	DO i = nxlg, nxrg
10324	DO j = nysg, nyng
10325	DO k = nzb, nzt+1
10326	to_be_resorted(k,j,i) = to_be_resorted(k,j,i) / &
10327	REAL( average_count_3d, KIND=wp )
10328	ENDDO
10329	ENDDO
10330	ENDDO
10331
10332	END SELECT
10333
10334	ENDIF
10335	ENDIF
10336
10337	END SUBROUTINE salsa_3d_data_averaging
10338
10339
10340	!------------------------------------------------------------------------------!
10341	!
10342	! Description:
10343	! ------------
10344	!> Subroutine defining 2D output variables
10345	!------------------------------------------------------------------------------!
10346	SUBROUTINE salsa_data_output_2d( av, variable, found, grid, mode, local_pf, two_d, nzb_do, nzt_do )
10347
10348	USE indices
10349
10350	USE kinds
10351
10352
10353	IMPLICIT NONE
10354
10355	CHARACTER(LEN=*) :: grid !<
10356	CHARACTER(LEN=*) :: mode !<
10357	CHARACTER(LEN=*) :: variable !<
10358	CHARACTER(LEN=5) :: vari !< trimmed format of variable
10359
10360	INTEGER(iwp) :: av !<
10361	INTEGER(iwp) :: char_to_int !< for converting character to integer
10362	INTEGER(iwp) :: found_index !< index of a chemical compound
10363	INTEGER(iwp) :: i !<
10364	INTEGER(iwp) :: ib !< running index: size bins
10365	INTEGER(iwp) :: ic !< running index: mass bins
10366	INTEGER(iwp) :: j !<
10367	INTEGER(iwp) :: k !<
10368	INTEGER(iwp) :: nzb_do !<
10369	INTEGER(iwp) :: nzt_do !<
10370
10371	LOGICAL :: found !<
10372	LOGICAL :: two_d !< flag parameter to indicate 2D variables (horizontal cross sections)
10373
10374	REAL(wp) :: df !< For calculating LDSA: fraction of particles
10375	!< depositing in the alveolar (or tracheobronchial)
10376	!< region of the lung. Depends on the particle size
10377	REAL(wp) :: mean_d !< Particle diameter in micrometres
10378	REAL(wp) :: temp_bin !< temporary array for calculating output variables
10379
10380	REAL(wp), DIMENSION(nxl:nxr,nys:nyn,nzb_do:nzt_do) :: local_pf !< output
10381
10382	REAL(wp), DIMENSION(:,:,:), POINTER :: to_be_resorted !< pointer
10383	!
10384	!-- Next statement is to avoid compiler warning about unused variable. May be removed in future.
10385	IF ( two_d ) CONTINUE
10386
10387	found = .TRUE.
10388	temp_bin = 0.0_wp
10389
10390	IF ( variable(7:11) == 'N_bin' ) THEN
10391
10392	READ( variable( 12:LEN( TRIM( variable ) ) - 3 ), * ) char_to_int
10393	IF ( char_to_int >= 1 .AND. char_to_int <= SUM( nbin ) ) THEN
10394
10395	ib = char_to_int
10396	IF ( av == 0 ) THEN
10397	DO i = nxl, nxr
10398	DO j = nys, nyn
10399	DO k = nzb_do, nzt_do
10400	local_pf(i,j,k) = MERGE( aerosol_number(ib)%conc(k,j,i), REAL( fill_value, &
10401	KIND = wp ), BTEST( wall_flags_0(k,j,i), 0 ) )
10402	ENDDO
10403	ENDDO
10404	ENDDO
10405	ELSE
10406	DO i = nxl, nxr
10407	DO j = nys, nyn
10408	DO k = nzb_do, nzt_do
10409	local_pf(i,j,k) = MERGE( nbins_av(k,j,i,ib), REAL( fill_value, KIND = wp ), &
10410	BTEST( wall_flags_0(k,j,i), 0 ) )
10411	ENDDO
10412	ENDDO
10413	ENDDO
10414	ENDIF
10415	IF ( mode == 'xy' ) grid = 'zu'
10416	ENDIF
10417
10418	ELSEIF ( variable(7:11) == 'm_bin' ) THEN
10419
10420	READ( variable( 12:LEN( TRIM( variable ) ) - 3 ), * ) char_to_int
10421	IF ( char_to_int >= 1 .AND. char_to_int <= SUM( nbin ) ) THEN
10422
10423	ib = char_to_int
10424	IF ( av == 0 ) THEN
10425	DO i = nxl, nxr
10426	DO j = nys, nyn
10427	DO k = nzb_do, nzt_do
10428	temp_bin = 0.0_wp
10429	DO ic = ib, ncomponents_mass * nbins_aerosol, nbins_aerosol
10430	temp_bin = temp_bin + aerosol_mass(ic)%conc(k,j,i)
10431	ENDDO
10432	local_pf(i,j,k) = MERGE( temp_bin, REAL( fill_value, KIND = wp ), &
10433	BTEST( wall_flags_0(k,j,i), 0 ) )
10434	ENDDO
10435	ENDDO
10436	ENDDO
10437	ELSE
10438	DO i = nxl, nxr
10439	DO j = nys, nyn
10440	DO k = nzb_do, nzt_do
10441	local_pf(i,j,k) = MERGE( mbins_av(k,j,i,ib), REAL( fill_value, KIND = wp ), &
10442	BTEST( wall_flags_0(k,j,i), 0 ) )
10443	ENDDO
10444	ENDDO
10445	ENDDO
10446	ENDIF
10447	IF ( mode == 'xy' ) grid = 'zu'
10448	ENDIF
10449
10450	ELSE
10451
10452	SELECT CASE ( TRIM( variable( 7:LEN( TRIM( variable ) ) - 3 ) ) ) ! cut out _xy, _xz or _yz
10453
10454	CASE ( 'g_H2SO4', 'g_HNO3', 'g_NH3', 'g_OCNV', 'g_OCSV' )
10455	vari = TRIM( variable( 9:LEN( TRIM( variable ) ) - 3 ) ) ! 9: remove salsa_g_
10456	IF ( av == 0 ) THEN
10457	IF ( vari == 'H2SO4') found_index = 1
10458	IF ( vari == 'HNO3') found_index = 2
10459	IF ( vari == 'NH3') found_index = 3
10460	IF ( vari == 'OCNV') found_index = 4
10461	IF ( vari == 'OCSV') found_index = 5
10462	DO i = nxl, nxr
10463	DO j = nys, nyn
10464	DO k = nzb_do, nzt_do
10465	local_pf(i,j,k) = MERGE( salsa_gas(found_index)%conc(k,j,i), &
10466	REAL( fill_value, KIND = wp ), &
10467	BTEST( wall_flags_0(k,j,i), 0 ) )
10468	ENDDO
10469	ENDDO
10470	ENDDO
10471	ELSE
10472	IF ( vari == 'H2SO4' ) to_be_resorted => g_h2so4_av
10473	IF ( vari == 'HNO3' ) to_be_resorted => g_hno3_av
10474	IF ( vari == 'NH3' ) to_be_resorted => g_nh3_av
10475	IF ( vari == 'OCNV' ) to_be_resorted => g_ocnv_av
10476	IF ( vari == 'OCSV' ) to_be_resorted => g_ocsv_av
10477	DO i = nxl, nxr
10478	DO j = nys, nyn
10479	DO k = nzb_do, nzt_do
10480	local_pf(i,j,k) = MERGE( to_be_resorted(k,j,i), REAL( fill_value, &
10481	KIND = wp ), BTEST( wall_flags_0(k,j,i), 0 ) )
10482	ENDDO
10483	ENDDO
10484	ENDDO
10485	ENDIF
10486
10487	IF ( mode == 'xy' ) grid = 'zu'
10488
10489	CASE ( 'LDSA' )
10490	IF ( av == 0 ) THEN
10491	DO i = nxl, nxr
10492	DO j = nys, nyn
10493	DO k = nzb_do, nzt_do
10494	temp_bin = 0.0_wp
10495	DO ib = 1, nbins_aerosol
10496	!
10497	!-- Diameter in micrometres
10498	mean_d = 1.0E+6_wp * ra_dry(k,j,i,ib) * 2.0_wp
10499	!
10500	!-- Deposition factor: alveolar
10501	df = ( 0.01555_wp / mean_d ) * ( EXP( -0.416_wp * ( LOG( mean_d ) + &
10502	2.84_wp )*2 ) + 19.11_wp EXP( -0.482_wp * ( LOG( mean_d ) - &
10503	1.362_wp )**2 ) )
10504	!
10505	!-- Lung-deposited surface area LDSA (units mum2/cm3)
10506	temp_bin = temp_bin + pi * mean_d*2 df * 1.0E-6_wp * &
10507	aerosol_number(ib)%conc(k,j,i)
10508	ENDDO
10509
10510	local_pf(i,j,k) = MERGE( temp_bin, REAL( fill_value, KIND = wp ), &
10511	BTEST( wall_flags_0(k,j,i), 0 ) )
10512	ENDDO
10513	ENDDO
10514	ENDDO
10515	ELSE
10516	DO i = nxl, nxr
10517	DO j = nys, nyn
10518	DO k = nzb_do, nzt_do
10519	local_pf(i,j,k) = MERGE( ldsa_av(k,j,i), REAL( fill_value, KIND = wp ), &
10520	BTEST( wall_flags_0(k,j,i), 0 ) )
10521	ENDDO
10522	ENDDO
10523	ENDDO
10524	ENDIF
10525
10526	IF ( mode == 'xy' ) grid = 'zu'
10527
10528	CASE ( 'N_UFP' )
10529
10530	IF ( av == 0 ) THEN
10531	DO i = nxl, nxr
10532	DO j = nys, nyn
10533	DO k = nzb_do, nzt_do
10534	temp_bin = 0.0_wp
10535	DO ib = 1, nbins_aerosol
10536	IF ( 2.0_wp * ra_dry(k,j,i,ib) <= 0.1E-6_wp ) THEN
10537	temp_bin = temp_bin + aerosol_number(ib)%conc(k,j,i)
10538	ENDIF
10539	ENDDO
10540	local_pf(i,j,k) = MERGE( temp_bin, REAL( fill_value, KIND = wp ), &
10541	BTEST( wall_flags_0(k,j,i), 0 ) )
10542	ENDDO
10543	ENDDO
10544	ENDDO
10545	ELSE
10546	DO i = nxl, nxr
10547	DO j = nys, nyn
10548	DO k = nzb_do, nzt_do
10549	local_pf(i,j,k) = MERGE( nufp_av(k,j,i), REAL( fill_value, KIND = wp ), &
10550	BTEST( wall_flags_0(k,j,i), 0 ) )
10551	ENDDO
10552	ENDDO
10553	ENDDO
10554	ENDIF
10555
10556	IF ( mode == 'xy' ) grid = 'zu'
10557
10558	CASE ( 'Ntot' )
10559
10560	IF ( av == 0 ) THEN
10561	DO i = nxl, nxr
10562	DO j = nys, nyn
10563	DO k = nzb_do, nzt_do
10564	temp_bin = 0.0_wp
10565	DO ib = 1, nbins_aerosol
10566	temp_bin = temp_bin + aerosol_number(ib)%conc(k,j,i)
10567	ENDDO
10568	local_pf(i,j,k) = MERGE( temp_bin, REAL( fill_value, KIND = wp ), &
10569	BTEST( wall_flags_0(k,j,i), 0 ) )
10570	ENDDO
10571	ENDDO
10572	ENDDO
10573	ELSE
10574	DO i = nxl, nxr
10575	DO j = nys, nyn
10576	DO k = nzb_do, nzt_do
10577	local_pf(i,j,k) = MERGE( ntot_av(k,j,i), REAL( fill_value, KIND = wp ), &
10578	BTEST( wall_flags_0(k,j,i), 0 ) )
10579	ENDDO
10580	ENDDO
10581	ENDDO
10582	ENDIF
10583
10584	IF ( mode == 'xy' ) grid = 'zu'
10585
10586	CASE ( 'PM0.1' )
10587	IF ( av == 0 ) THEN
10588	DO i = nxl, nxr
10589	DO j = nys, nyn
10590	DO k = nzb_do, nzt_do
10591	temp_bin = 0.0_wp
10592	DO ib = 1, nbins_aerosol
10593	IF ( 2.0_wp * ra_dry(k,j,i,ib) <= 0.1E-6_wp ) THEN
10594	DO ic = ib, nbins_aerosol * ncc, nbins_aerosol
10595	temp_bin = temp_bin + aerosol_mass(ic)%conc(k,j,i)
10596	ENDDO
10597	ENDIF
10598	ENDDO
10599	local_pf(i,j,k) = MERGE( temp_bin, REAL( fill_value, KIND = wp ), &
10600	BTEST( wall_flags_0(k,j,i), 0 ) )
10601	ENDDO
10602	ENDDO
10603	ENDDO
10604	ELSE
10605	DO i = nxl, nxr
10606	DO j = nys, nyn
10607	DO k = nzb_do, nzt_do
10608	local_pf(i,j,k) = MERGE( pm01_av(k,j,i), REAL( fill_value, KIND = wp ), &
10609	BTEST( wall_flags_0(k,j,i), 0 ) )
10610	ENDDO
10611	ENDDO
10612	ENDDO
10613	ENDIF
10614
10615	IF ( mode == 'xy' ) grid = 'zu'
10616
10617	CASE ( 'PM2.5' )
10618	IF ( av == 0 ) THEN
10619	DO i = nxl, nxr
10620	DO j = nys, nyn
10621	DO k = nzb_do, nzt_do
10622	temp_bin = 0.0_wp
10623	DO ib = 1, nbins_aerosol
10624	IF ( 2.0_wp * ra_dry(k,j,i,ib) <= 2.5E-6_wp ) THEN
10625	DO ic = ib, nbins_aerosol * ncc, nbins_aerosol
10626	temp_bin = temp_bin + aerosol_mass(ic)%conc(k,j,i)
10627	ENDDO
10628	ENDIF
10629	ENDDO
10630	local_pf(i,j,k) = MERGE( temp_bin, REAL( fill_value, KIND = wp ), &
10631	BTEST( wall_flags_0(k,j,i), 0 ) )
10632	ENDDO
10633	ENDDO
10634	ENDDO
10635	ELSE
10636	DO i = nxl, nxr
10637	DO j = nys, nyn
10638	DO k = nzb_do, nzt_do
10639	local_pf(i,j,k) = MERGE( pm25_av(k,j,i), REAL( fill_value, KIND = wp ), &
10640	BTEST( wall_flags_0(k,j,i), 0 ) )
10641	ENDDO
10642	ENDDO
10643	ENDDO
10644	ENDIF
10645
10646	IF ( mode == 'xy' ) grid = 'zu'
10647
10648	CASE ( 'PM10' )
10649	IF ( av == 0 ) THEN
10650	DO i = nxl, nxr
10651	DO j = nys, nyn
10652	DO k = nzb_do, nzt_do
10653	temp_bin = 0.0_wp
10654	DO ib = 1, nbins_aerosol
10655	IF ( 2.0_wp * ra_dry(k,j,i,ib) <= 10.0E-6_wp ) THEN
10656	DO ic = ib, nbins_aerosol * ncc, nbins_aerosol
10657	temp_bin = temp_bin + aerosol_mass(ic)%conc(k,j,i)
10658	ENDDO
10659	ENDIF
10660	ENDDO
10661	local_pf(i,j,k) = MERGE( temp_bin, REAL( fill_value, KIND = wp ), &
10662	BTEST( wall_flags_0(k,j,i), 0 ) )
10663	ENDDO
10664	ENDDO
10665	ENDDO
10666	ELSE
10667	DO i = nxl, nxr
10668	DO j = nys, nyn
10669	DO k = nzb_do, nzt_do
10670	local_pf(i,j,k) = MERGE( pm10_av(k,j,i), REAL( fill_value, KIND = wp ), &
10671	BTEST( wall_flags_0(k,j,i), 0 ) )
10672	ENDDO
10673	ENDDO
10674	ENDDO
10675	ENDIF
10676
10677	IF ( mode == 'xy' ) grid = 'zu'
10678
10679	CASE ( 's_BC', 's_DU', 's_NH', 's_NO', 's_OC', 's_SO4', 's_SS' )
10680	vari = TRIM( variable( 9:LEN( TRIM( variable ) ) - 3 ) ) ! 9: remove salsa_s_
10681	IF ( is_used( prtcl, vari ) ) THEN
10682	found_index = get_index( prtcl, vari )
10683	IF ( av == 0 ) THEN
10684	DO i = nxl, nxr
10685	DO j = nys, nyn
10686	DO k = nzb_do, nzt_do
10687	temp_bin = 0.0_wp
10688	DO ic = ( found_index-1 ) * nbins_aerosol+1, found_index * nbins_aerosol
10689	temp_bin = temp_bin + aerosol_mass(ic)%conc(k,j,i)
10690	ENDDO
10691	local_pf(i,j,k) = MERGE( temp_bin, REAL( fill_value, KIND = wp ), &
10692	BTEST( wall_flags_0(k,j,i), 0 ) )
10693	ENDDO
10694	ENDDO
10695	ENDDO
10696	ELSE
10697	IF ( vari == 'BC' ) to_be_resorted => s_bc_av
10698	IF ( vari == 'DU' ) to_be_resorted => s_du_av
10699	IF ( vari == 'NH' ) to_be_resorted => s_nh_av
10700	IF ( vari == 'NO' ) to_be_resorted => s_no_av
10701	IF ( vari == 'OC' ) to_be_resorted => s_oc_av
10702	IF ( vari == 'SO4' ) to_be_resorted => s_so4_av
10703	IF ( vari == 'SS' ) to_be_resorted => s_ss_av
10704	DO i = nxl, nxr
10705	DO j = nys, nyn
10706	DO k = nzb_do, nzt_do
10707	local_pf(i,j,k) = MERGE( to_be_resorted(k,j,i), REAL( fill_value, &
10708	KIND = wp ), BTEST( wall_flags_0(k,j,i), 0 ) )
10709	ENDDO
10710	ENDDO
10711	ENDDO
10712	ENDIF
10713	ELSE
10714	local_pf = fill_value
10715	ENDIF
10716
10717	IF ( mode == 'xy' ) grid = 'zu'
10718
10719	CASE ( 's_H2O' )
10720	found_index = get_index( prtcl, 'H2O' )
10721	IF ( av == 0 ) THEN
10722	DO i = nxl, nxr
10723	DO j = nys, nyn
10724	DO k = nzb_do, nzt_do
10725	temp_bin = 0.0_wp
10726	DO ic = ( found_index-1 ) * nbins_aerosol+1, found_index * nbins_aerosol
10727	temp_bin = temp_bin + aerosol_mass(ic)%conc(k,j,i)
10728	ENDDO
10729	local_pf(i,j,k) = MERGE( temp_bin, REAL( fill_value, KIND = wp ), &
10730	BTEST( wall_flags_0(k,j,i), 0 ) )
10731	ENDDO
10732	ENDDO
10733	ENDDO
10734	ELSE
10735	to_be_resorted => s_h2o_av
10736	DO i = nxl, nxr
10737	DO j = nys, nyn
10738	DO k = nzb_do, nzt_do
10739	local_pf(i,j,k) = MERGE( to_be_resorted(k,j,i), REAL( fill_value, &
10740	KIND = wp ), BTEST( wall_flags_0(k,j,i), 0 ) )
10741	ENDDO
10742	ENDDO
10743	ENDDO
10744	ENDIF
10745
10746	IF ( mode == 'xy' ) grid = 'zu'
10747
10748	CASE DEFAULT
10749	found = .FALSE.
10750	grid = 'none'
10751
10752	END SELECT
10753
10754	ENDIF
10755
10756	END SUBROUTINE salsa_data_output_2d
10757
10758	!------------------------------------------------------------------------------!
10759	!
10760	! Description:
10761	! ------------
10762	!> Subroutine defining 3D output variables
10763	!------------------------------------------------------------------------------!
10764	SUBROUTINE salsa_data_output_3d( av, variable, found, local_pf, nzb_do, nzt_do )
10765
10766	USE indices
10767
10768	USE kinds
10769
10770
10771	IMPLICIT NONE
10772
10773	CHARACTER(LEN=*), INTENT(in) :: variable !<
10774
10775	INTEGER(iwp) :: av !<
10776	INTEGER(iwp) :: char_to_int !< for converting character to integer
10777	INTEGER(iwp) :: found_index !< index of a chemical compound
10778	INTEGER(iwp) :: ib !< running index: size bins
10779	INTEGER(iwp) :: ic !< running index: mass bins
10780	INTEGER(iwp) :: i !<
10781	INTEGER(iwp) :: j !<
10782	INTEGER(iwp) :: k !<
10783	INTEGER(iwp) :: nzb_do !<
10784	INTEGER(iwp) :: nzt_do !<
10785
10786	LOGICAL :: found !<
10787
10788	REAL(wp) :: df !< For calculating LDSA: fraction of particles
10789	!< depositing in the alveolar (or tracheobronchial)
10790	!< region of the lung. Depends on the particle size
10791	REAL(wp) :: mean_d !< Particle diameter in micrometres
10792	REAL(wp) :: temp_bin !< temporary array for calculating output variables
10793
10794	REAL(sp), DIMENSION(nxl:nxr,nys:nyn,nzb_do:nzt_do) :: local_pf !< local
10795
10796	REAL(wp), DIMENSION(:,:,:), POINTER :: to_be_resorted !< pointer
10797
10798	found = .TRUE.
10799	temp_bin = 0.0_wp
10800
10801	IF ( variable(7:11) == 'N_bin' ) THEN
10802	READ( variable(12:),* ) char_to_int
10803	IF ( char_to_int >= 1 .AND. char_to_int <= SUM( nbin ) ) THEN
10804
10805	ib = char_to_int
10806	IF ( av == 0 ) THEN
10807	DO i = nxl, nxr
10808	DO j = nys, nyn
10809	DO k = nzb_do, nzt_do
10810	local_pf(i,j,k) = MERGE( aerosol_number(ib)%conc(k,j,i), REAL( fill_value, &
10811	KIND = wp ), BTEST( wall_flags_0(k,j,i), 0 ) )
10812	ENDDO
10813	ENDDO
10814	ENDDO
10815	ELSE
10816	DO i = nxl, nxr
10817	DO j = nys, nyn
10818	DO k = nzb_do, nzt_do
10819	local_pf(i,j,k) = MERGE( nbins_av(k,j,i,ib), REAL( fill_value, KIND = wp ), &
10820	BTEST( wall_flags_0(k,j,i), 0 ) )
10821	ENDDO
10822	ENDDO
10823	ENDDO
10824	ENDIF
10825	ENDIF
10826
10827	ELSEIF ( variable(7:11) == 'm_bin' ) THEN
10828	READ( variable(12:),* ) char_to_int
10829	IF ( char_to_int >= 1 .AND. char_to_int <= SUM( nbin ) ) THEN
10830
10831	ib = char_to_int
10832	IF ( av == 0 ) THEN
10833	DO i = nxl, nxr
10834	DO j = nys, nyn
10835	DO k = nzb_do, nzt_do
10836	temp_bin = 0.0_wp
10837	DO ic = ib, ncomponents_mass * nbins_aerosol, nbins_aerosol
10838	temp_bin = temp_bin + aerosol_mass(ic)%conc(k,j,i)
10839	ENDDO
10840	local_pf(i,j,k) = MERGE( temp_bin, REAL( fill_value, KIND = wp ), &
10841	BTEST( wall_flags_0(k,j,i), 0 ) )
10842	ENDDO
10843	ENDDO
10844	ENDDO
10845	ELSE
10846	DO i = nxl, nxr
10847	DO j = nys, nyn
10848	DO k = nzb_do, nzt_do
10849	local_pf(i,j,k) = MERGE( mbins_av(k,j,i,ib), REAL( fill_value, KIND = wp ), &
10850	BTEST( wall_flags_0(k,j,i), 0 ) )
10851	ENDDO
10852	ENDDO
10853	ENDDO
10854	ENDIF
10855	ENDIF
10856
10857	ELSE
10858	SELECT CASE ( TRIM( variable(7:) ) )
10859
10860	CASE ( 'g_H2SO4', 'g_HNO3', 'g_NH3', 'g_OCNV', 'g_OCSV' )
10861	IF ( av == 0 ) THEN
10862	IF ( TRIM( variable(7:) ) == 'g_H2SO4') found_index = 1
10863	IF ( TRIM( variable(7:) ) == 'g_HNO3') found_index = 2
10864	IF ( TRIM( variable(7:) ) == 'g_NH3') found_index = 3
10865	IF ( TRIM( variable(7:) ) == 'g_OCNV') found_index = 4
10866	IF ( TRIM( variable(7:) ) == 'g_OCSV') found_index = 5
10867
10868	DO i = nxl, nxr
10869	DO j = nys, nyn
10870	DO k = nzb_do, nzt_do
10871	local_pf(i,j,k) = MERGE( salsa_gas(found_index)%conc(k,j,i), &
10872	REAL( fill_value, KIND = wp ), &
10873	BTEST( wall_flags_0(k,j,i), 0 ) )
10874	ENDDO
10875	ENDDO
10876	ENDDO
10877	ELSE
10878	!
10879	!-- 9: remove salsa_g_ from the beginning
10880	IF ( TRIM( variable(9:) ) == 'H2SO4' ) to_be_resorted => g_h2so4_av
10881	IF ( TRIM( variable(9:) ) == 'HNO3' ) to_be_resorted => g_hno3_av
10882	IF ( TRIM( variable(9:) ) == 'NH3' ) to_be_resorted => g_nh3_av
10883	IF ( TRIM( variable(9:) ) == 'OCNV' ) to_be_resorted => g_ocnv_av
10884	IF ( TRIM( variable(9:) ) == 'OCSV' ) to_be_resorted => g_ocsv_av
10885	DO i = nxl, nxr
10886	DO j = nys, nyn
10887	DO k = nzb_do, nzt_do
10888	local_pf(i,j,k) = MERGE( to_be_resorted(k,j,i), REAL( fill_value, &
10889	KIND = wp ), BTEST( wall_flags_0(k,j,i), 0 ) )
10890	ENDDO
10891	ENDDO
10892	ENDDO
10893	ENDIF
10894
10895	CASE ( 'LDSA' )
10896	IF ( av == 0 ) THEN
10897	DO i = nxl, nxr
10898	DO j = nys, nyn
10899	DO k = nzb_do, nzt_do
10900	temp_bin = 0.0_wp
10901	DO ib = 1, nbins_aerosol
10902	!
10903	!-- Diameter in micrometres
10904	mean_d = 1.0E+6_wp * ra_dry(k,j,i,ib) * 2.0_wp
10905	!
10906	!-- Deposition factor: alveolar
10907	df = ( 0.01555_wp / mean_d ) * ( EXP( -0.416_wp * ( LOG( mean_d ) + &
10908	2.84_wp )*2 ) + 19.11_wp EXP( -0.482_wp * ( LOG( mean_d ) - &
10909	1.362_wp )**2 ) )
10910	!
10911	!-- Lung-deposited surface area LDSA (units mum2/cm3)
10912	temp_bin = temp_bin + pi * mean_d*2 df * 1.0E-6_wp * &
10913	aerosol_number(ib)%conc(k,j,i)
10914	ENDDO
10915	local_pf(i,j,k) = MERGE( temp_bin, REAL( fill_value, KIND = wp ), &
10916	BTEST( wall_flags_0(k,j,i), 0 ) )
10917	ENDDO
10918	ENDDO
10919	ENDDO
10920	ELSE
10921	DO i = nxl, nxr
10922	DO j = nys, nyn
10923	DO k = nzb_do, nzt_do
10924	local_pf(i,j,k) = MERGE( ldsa_av(k,j,i), REAL( fill_value, KIND = wp ), &
10925	BTEST( wall_flags_0(k,j,i), 0 ) )
10926	ENDDO
10927	ENDDO
10928	ENDDO
10929	ENDIF
10930
10931	CASE ( 'N_UFP' )
10932	IF ( av == 0 ) THEN
10933	DO i = nxl, nxr
10934	DO j = nys, nyn
10935	DO k = nzb_do, nzt_do
10936	temp_bin = 0.0_wp
10937	DO ib = 1, nbins_aerosol
10938	IF ( 2.0_wp * ra_dry(k,j,i,ib) <= 0.1E-6_wp ) THEN
10939	temp_bin = temp_bin + aerosol_number(ib)%conc(k,j,i)
10940	ENDIF
10941	ENDDO
10942	local_pf(i,j,k) = MERGE( temp_bin, REAL( fill_value, KIND = wp ), &
10943	BTEST( wall_flags_0(k,j,i), 0 ) )
10944	ENDDO
10945	ENDDO
10946	ENDDO
10947	ELSE
10948	DO i = nxl, nxr
10949	DO j = nys, nyn
10950	DO k = nzb_do, nzt_do
10951	local_pf(i,j,k) = MERGE( nufp_av(k,j,i), REAL( fill_value, KIND = wp ), &
10952	BTEST( wall_flags_0(k,j,i), 0 ) )
10953	ENDDO
10954	ENDDO
10955	ENDDO
10956	ENDIF
10957
10958	CASE ( 'Ntot' )
10959	IF ( av == 0 ) THEN
10960	DO i = nxl, nxr
10961	DO j = nys, nyn
10962	DO k = nzb_do, nzt_do
10963	temp_bin = 0.0_wp
10964	DO ib = 1, nbins_aerosol
10965	temp_bin = temp_bin + aerosol_number(ib)%conc(k,j,i)
10966	ENDDO
10967	local_pf(i,j,k) = MERGE( temp_bin, REAL( fill_value, KIND = wp ), &
10968	BTEST( wall_flags_0(k,j,i), 0 ) )
10969	ENDDO
10970	ENDDO
10971	ENDDO
10972	ELSE
10973	DO i = nxl, nxr
10974	DO j = nys, nyn
10975	DO k = nzb_do, nzt_do
10976	local_pf(i,j,k) = MERGE( ntot_av(k,j,i), REAL( fill_value, KIND = wp ), &
10977	BTEST( wall_flags_0(k,j,i), 0 ) )
10978	ENDDO
10979	ENDDO
10980	ENDDO
10981	ENDIF
10982
10983	CASE ( 'PM0.1' )
10984	IF ( av == 0 ) THEN
10985	DO i = nxl, nxr
10986	DO j = nys, nyn
10987	DO k = nzb_do, nzt_do
10988	temp_bin = 0.0_wp
10989	DO ib = 1, nbins_aerosol
10990	IF ( 2.0_wp * ra_dry(k,j,i,ib) <= 0.1E-6_wp ) THEN
10991	DO ic = ib, nbins_aerosol * ncc, nbins_aerosol
10992	temp_bin = temp_bin + aerosol_mass(ic)%conc(k,j,i)
10993	ENDDO
10994	ENDIF
10995	ENDDO
10996	local_pf(i,j,k) = MERGE( temp_bin, REAL( fill_value, KIND = wp ), &
10997	BTEST( wall_flags_0(k,j,i), 0 ) )
10998	ENDDO
10999	ENDDO
11000	ENDDO
11001	ELSE
11002	DO i = nxl, nxr
11003	DO j = nys, nyn
11004	DO k = nzb_do, nzt_do
11005	local_pf(i,j,k) = MERGE( pm01_av(k,j,i), REAL( fill_value, KIND = wp ), &
11006	BTEST( wall_flags_0(k,j,i), 0 ) )
11007	ENDDO
11008	ENDDO
11009	ENDDO
11010	ENDIF
11011
11012	CASE ( 'PM2.5' )
11013	IF ( av == 0 ) THEN
11014	DO i = nxl, nxr
11015	DO j = nys, nyn
11016	DO k = nzb_do, nzt_do
11017	temp_bin = 0.0_wp
11018	DO ib = 1, nbins_aerosol
11019	IF ( 2.0_wp * ra_dry(k,j,i,ib) <= 2.5E-6_wp ) THEN
11020	DO ic = ib, nbins_aerosol * ncc, nbins_aerosol
11021	temp_bin = temp_bin + aerosol_mass(ic)%conc(k,j,i)
11022	ENDDO
11023	ENDIF
11024	ENDDO
11025	local_pf(i,j,k) = MERGE( temp_bin, REAL( fill_value, KIND = wp ), &
11026	BTEST( wall_flags_0(k,j,i), 0 ) )
11027	ENDDO
11028	ENDDO
11029	ENDDO
11030	ELSE
11031	DO i = nxl, nxr
11032	DO j = nys, nyn
11033	DO k = nzb_do, nzt_do
11034	local_pf(i,j,k) = MERGE( pm25_av(k,j,i), REAL( fill_value, KIND = wp ), &
11035	BTEST( wall_flags_0(k,j,i), 0 ) )
11036	ENDDO
11037	ENDDO
11038	ENDDO
11039	ENDIF
11040
11041	CASE ( 'PM10' )
11042	IF ( av == 0 ) THEN
11043	DO i = nxl, nxr
11044	DO j = nys, nyn
11045	DO k = nzb_do, nzt_do
11046	temp_bin = 0.0_wp
11047	DO ib = 1, nbins_aerosol
11048	IF ( 2.0_wp * ra_dry(k,j,i,ib) <= 10.0E-6_wp ) THEN
11049	DO ic = ib, nbins_aerosol * ncc, nbins_aerosol
11050	temp_bin = temp_bin + aerosol_mass(ic)%conc(k,j,i)
11051	ENDDO
11052	ENDIF
11053	ENDDO
11054	local_pf(i,j,k) = MERGE( temp_bin, REAL( fill_value, KIND = wp ), &
11055	BTEST( wall_flags_0(k,j,i), 0 ) )
11056	ENDDO
11057	ENDDO
11058	ENDDO
11059	ELSE
11060	DO i = nxl, nxr
11061	DO j = nys, nyn
11062	DO k = nzb_do, nzt_do
11063	local_pf(i,j,k) = MERGE( pm10_av(k,j,i), REAL( fill_value, KIND = wp ), &
11064	BTEST( wall_flags_0(k,j,i), 0 ) )
11065	ENDDO
11066	ENDDO
11067	ENDDO
11068	ENDIF
11069
11070	CASE ( 's_BC', 's_DU', 's_NH', 's_NO', 's_OC', 's_SO4', 's_SS' )
11071	IF ( is_used( prtcl, TRIM( variable(9:) ) ) ) THEN ! 9: remove salsa_s_
11072	found_index = get_index( prtcl, TRIM( variable(9:) ) )
11073	IF ( av == 0 ) THEN
11074	DO i = nxl, nxr
11075	DO j = nys, nyn
11076	DO k = nzb_do, nzt_do
11077	temp_bin = 0.0_wp
11078	DO ic = ( found_index-1 ) * nbins_aerosol + 1, found_index * nbins_aerosol
11079	temp_bin = temp_bin + aerosol_mass(ic)%conc(k,j,i)
11080	ENDDO
11081	local_pf(i,j,k) = MERGE( temp_bin, REAL( fill_value, KIND = wp ), &
11082	BTEST( wall_flags_0(k,j,i), 0 ) )
11083	ENDDO
11084	ENDDO
11085	ENDDO
11086	ELSE
11087	!
11088	!-- 9: remove salsa_s_ from the beginning
11089	IF ( TRIM( variable(9:) ) == 'BC' ) to_be_resorted => s_bc_av
11090	IF ( TRIM( variable(9:) ) == 'DU' ) to_be_resorted => s_du_av
11091	IF ( TRIM( variable(9:) ) == 'NH' ) to_be_resorted => s_nh_av
11092	IF ( TRIM( variable(9:) ) == 'NO' ) to_be_resorted => s_no_av
11093	IF ( TRIM( variable(9:) ) == 'OC' ) to_be_resorted => s_oc_av
11094	IF ( TRIM( variable(9:) ) == 'SO4' ) to_be_resorted => s_so4_av
11095	IF ( TRIM( variable(9:) ) == 'SS' ) to_be_resorted => s_ss_av
11096	DO i = nxl, nxr
11097	DO j = nys, nyn
11098	DO k = nzb_do, nzt_do
11099	local_pf(i,j,k) = MERGE( to_be_resorted(k,j,i), REAL( fill_value, &
11100	KIND = wp ), BTEST( wall_flags_0(k,j,i), 0 ) )
11101	ENDDO
11102	ENDDO
11103	ENDDO
11104	ENDIF
11105	ENDIF
11106
11107	CASE ( 's_H2O' )
11108	found_index = get_index( prtcl, 'H2O' )
11109	IF ( av == 0 ) THEN
11110	DO i = nxl, nxr
11111	DO j = nys, nyn
11112	DO k = nzb_do, nzt_do
11113	temp_bin = 0.0_wp
11114	DO ic = ( found_index-1 ) * nbins_aerosol + 1, found_index * nbins_aerosol
11115	temp_bin = temp_bin + aerosol_mass(ic)%conc(k,j,i)
11116	ENDDO
11117	local_pf(i,j,k) = MERGE( temp_bin, REAL( fill_value, KIND = wp ), &
11118	BTEST( wall_flags_0(k,j,i), 0 ) )
11119	ENDDO
11120	ENDDO
11121	ENDDO
11122	ELSE
11123	to_be_resorted => s_h2o_av
11124	DO i = nxl, nxr
11125	DO j = nys, nyn
11126	DO k = nzb_do, nzt_do
11127	local_pf(i,j,k) = MERGE( to_be_resorted(k,j,i), REAL( fill_value, &
11128	KIND = wp ), BTEST( wall_flags_0(k,j,i), 0 ) )
11129	ENDDO
11130	ENDDO
11131	ENDDO
11132	ENDIF
11133
11134	CASE DEFAULT
11135	found = .FALSE.
11136
11137	END SELECT
11138	ENDIF
11139
11140	END SUBROUTINE salsa_data_output_3d
11141
11142	!------------------------------------------------------------------------------!
11143	!
11144	! Description:
11145	! ------------
11146	!> Subroutine defining mask output variables
11147	!------------------------------------------------------------------------------!
11148	SUBROUTINE salsa_data_output_mask( av, variable, found, local_pf, mid )
11149
11150	USE arrays_3d, &
11151	ONLY: tend
11152
11153	USE control_parameters, &
11154	ONLY: mask_i, mask_j, mask_k, mask_size_l, mask_surface, nz_do3d
11155
11156	IMPLICIT NONE
11157
11158	CHARACTER(LEN=5) :: grid !< flag to distinquish between staggered grid
11159	CHARACTER(LEN=*) :: variable !<
11160	CHARACTER(LEN=7) :: vari !< trimmed format of variable
11161
11162	INTEGER(iwp) :: av !<
11163	INTEGER(iwp) :: char_to_int !< for converting character to integer
11164	INTEGER(iwp) :: found_index !< index of a chemical compound
11165	INTEGER(iwp) :: ib !< loop index for aerosol size number bins
11166	INTEGER(iwp) :: ic !< loop index for chemical components
11167	INTEGER(iwp) :: i !< loop index in x-direction
11168	INTEGER(iwp) :: j !< loop index in y-direction
11169	INTEGER(iwp) :: k !< loop index in z-direction
11170	INTEGER(iwp) :: im !< loop index for masked variables
11171	INTEGER(iwp) :: jm !< loop index for masked variables
11172	INTEGER(iwp) :: kk !< loop index for masked output in z-direction
11173	INTEGER(iwp) :: mid !< masked output running index
11174	INTEGER(iwp) :: ktt !< k index of highest terrain surface
11175
11176	LOGICAL :: found !<
11177	LOGICAL :: resorted !<
11178
11179	REAL(wp) :: df !< For calculating LDSA: fraction of particles depositing in the alveolar
11180	!< (or tracheobronchial) region of the lung. Depends on the particle size
11181	REAL(wp) :: mean_d !< Particle diameter in micrometres
11182	REAL(wp) :: temp_bin !< temporary array for calculating output variables
11183
11184	REAL(wp), DIMENSION(mask_size_l(mid,1),mask_size_l(mid,2),mask_size_l(mid,3)) :: local_pf !<
11185
11186	REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg), TARGET :: temp_array !< temporary array
11187
11188	REAL(wp), DIMENSION(:,:,:), POINTER :: to_be_resorted !< pointer
11189
11190	found = .TRUE.
11191	resorted = .FALSE.
11192	grid = 's'
11193	temp_array = 0.0_wp
11194	temp_bin = 0.0_wp
11195
11196	IF ( variable(7:11) == 'N_bin' ) THEN
11197	READ( variable(12:),* ) char_to_int
11198	IF ( char_to_int >= 1 .AND. char_to_int <= SUM( nbin ) ) THEN
11199	ib = char_to_int
11200	IF ( av == 0 ) THEN
11201	IF ( .NOT. mask_surface(mid) ) THEN
11202	DO i = 1, mask_size_l(mid,1)
11203	DO j = 1, mask_size_l(mid,2)
11204	DO k = 1, mask_size_l(mid,3)
11205	local_pf(i,j,k) = aerosol_number(ib)%conc( mask_k(mid,k), mask_j(mid,j), &
11206	mask_i(mid,i) )
11207	ENDDO
11208	ENDDO
11209	ENDDO
11210	ELSE
11211	DO i = 1, mask_size_l(mid,1)
11212	DO j = 1, mask_size_l(mid,2)
11213	!
11214	!-- Get k index of the highest terraing surface
11215	im = mask_i(mid,i)
11216	jm = mask_j(mid,j)
11217	ktt = MINLOC( MERGE( 1, 0, BTEST( wall_flags_0(:,jm,im), 5 )), DIM = 1 ) - 1
11218	DO k = 1, mask_size_l(mid,3)
11219	kk = MIN( ktt+mask_k(mid,k), nzt+1 )
11220	!
11221	!-- Set value if not in building
11222	IF ( BTEST( wall_flags_0(kk,jm,im), 6 ) ) THEN
11223	local_pf(i,j,k) = fill_value
11224	ELSE
11225	local_pf(i,j,k) = aerosol_number(ib)%conc(kk,jm,im)
11226	ENDIF
11227	ENDDO
11228	ENDDO
11229	ENDDO
11230	ENDIF
11231	resorted = .TRUE.
11232	ELSE
11233	temp_array = nbins_av(:,:,:,ib)
11234	to_be_resorted => temp_array
11235	ENDIF
11236	ENDIF
11237
11238	ELSEIF ( variable(7:11) == 'm_bin' ) THEN
11239
11240	READ( variable(12:),* ) char_to_int
11241	IF ( char_to_int >= 1 .AND. char_to_int <= SUM( nbin ) ) THEN
11242
11243	ib = char_to_int
11244	IF ( av == 0 ) THEN
11245	DO i = nxl, nxr
11246	DO j = nys, nyn
11247	DO k = nzb, nz_do3d
11248	temp_bin = 0.0_wp
11249	DO ic = ib, ncomponents_mass * nbins_aerosol, nbins_aerosol
11250	temp_bin = temp_bin + aerosol_mass(ic)%conc(k,j,i)
11251	ENDDO
11252	tend(k,j,i) = temp_bin
11253	ENDDO
11254	ENDDO
11255	ENDDO
11256	IF ( .NOT. mask_surface(mid) ) THEN
11257	DO i = 1, mask_size_l(mid,1)
11258	DO j = 1, mask_size_l(mid,2)
11259	DO k = 1, mask_size_l(mid,3)
11260	local_pf(i,j,k) = tend( mask_k(mid,k), mask_j(mid,j), mask_i(mid,i) )
11261	ENDDO
11262	ENDDO
11263	ENDDO
11264	ELSE
11265	DO i = 1, mask_size_l(mid,1)
11266	DO j = 1, mask_size_l(mid,2)
11267	!
11268	!-- Get k index of the highest terraing surface
11269	im = mask_i(mid,i)
11270	jm = mask_j(mid,j)
11271	ktt = MINLOC( MERGE( 1, 0, BTEST( wall_flags_0(:,jm,im), 5 )), DIM = 1 ) - 1
11272	DO k = 1, mask_size_l(mid,3)
11273	kk = MIN( ktt+mask_k(mid,k), nzt+1 )
11274	!
11275	!-- Set value if not in building
11276	IF ( BTEST( wall_flags_0(kk,jm,im), 6 ) ) THEN
11277	local_pf(i,j,k) = fill_value
11278	ELSE
11279	local_pf(i,j,k) = tend(kk,jm,im)
11280	ENDIF
11281	ENDDO
11282	ENDDO
11283	ENDDO
11284	ENDIF
11285	resorted = .TRUE.
11286	ELSE
11287	temp_array = mbins_av(:,:,:,ib)
11288	to_be_resorted => temp_array
11289	ENDIF
11290	ENDIF
11291
11292	ELSE
11293	SELECT CASE ( TRIM( variable(7:) ) )
11294
11295	CASE ( 'g_H2SO4', 'g_HNO3', 'g_NH3', 'g_OCNV', 'g_OCSV' )
11296	vari = TRIM( variable(7:) )
11297	IF ( av == 0 ) THEN
11298	IF ( vari == 'g_H2SO4') to_be_resorted => salsa_gas(1)%conc
11299	IF ( vari == 'g_HNO3') to_be_resorted => salsa_gas(2)%conc
11300	IF ( vari == 'g_NH3') to_be_resorted => salsa_gas(3)%conc
11301	IF ( vari == 'g_OCNV') to_be_resorted => salsa_gas(4)%conc
11302	IF ( vari == 'g_OCSV') to_be_resorted => salsa_gas(5)%conc
11303	ELSE
11304	IF ( vari == 'g_H2SO4') to_be_resorted => g_h2so4_av
11305	IF ( vari == 'g_HNO3') to_be_resorted => g_hno3_av
11306	IF ( vari == 'g_NH3') to_be_resorted => g_nh3_av
11307	IF ( vari == 'g_OCNV') to_be_resorted => g_ocnv_av
11308	IF ( vari == 'g_OCSV') to_be_resorted => g_ocsv_av
11309	ENDIF
11310
11311	CASE ( 'LDSA' )
11312	IF ( av == 0 ) THEN
11313	DO i = nxl, nxr
11314	DO j = nys, nyn
11315	DO k = nzb, nz_do3d
11316	temp_bin = 0.0_wp
11317	DO ib = 1, nbins_aerosol
11318	!
11319	!-- Diameter in micrometres
11320	mean_d = 1.0E+6_wp * ra_dry(k,j,i,ib) * 2.0_wp
11321	!
11322	!-- Deposition factor: alveolar
11323	df = ( 0.01555_wp / mean_d ) * ( EXP( -0.416_wp * ( LOG( mean_d ) + &
11324	2.84_wp )*2 ) + 19.11_wp EXP( -0.482_wp * ( LOG( mean_d ) - &
11325	1.362_wp )**2 ) )
11326	!
11327	!-- Lung-deposited surface area LDSA (units mum2/cm3)
11328	temp_bin = temp_bin + pi * mean_d*2 df * 1.0E-6_wp * &
11329	aerosol_number(ib)%conc(k,j,i)
11330	ENDDO
11331	tend(k,j,i) = temp_bin
11332	ENDDO
11333	ENDDO
11334	ENDDO
11335	IF ( .NOT. mask_surface(mid) ) THEN
11336	DO i = 1, mask_size_l(mid,1)
11337	DO j = 1, mask_size_l(mid,2)
11338	DO k = 1, mask_size_l(mid,3)
11339	local_pf(i,j,k) = tend( mask_k(mid,k), mask_j(mid,j), mask_i(mid,i) )
11340	ENDDO
11341	ENDDO
11342	ENDDO
11343	ELSE
11344	DO i = 1, mask_size_l(mid,1)
11345	DO j = 1, mask_size_l(mid,2)
11346	!
11347	!-- Get k index of the highest terraing surface
11348	im = mask_i(mid,i)
11349	jm = mask_j(mid,j)
11350	ktt = MINLOC( MERGE( 1, 0, BTEST( wall_flags_0(:,jm,im), 5 )), DIM = 1 ) - 1
11351	DO k = 1, mask_size_l(mid,3)
11352	kk = MIN( ktt+mask_k(mid,k), nzt+1 )
11353	!
11354	!-- Set value if not in building
11355	IF ( BTEST( wall_flags_0(kk,jm,im), 6 ) ) THEN
11356	local_pf(i,j,k) = fill_value
11357	ELSE
11358	local_pf(i,j,k) = tend(kk,jm,im)
11359	ENDIF
11360	ENDDO
11361	ENDDO
11362	ENDDO
11363	ENDIF
11364	resorted = .TRUE.
11365	ELSE
11366	to_be_resorted => ldsa_av
11367	ENDIF
11368
11369	CASE ( 'N_UFP' )
11370	IF ( av == 0 ) THEN
11371	DO i = nxl, nxr
11372	DO j = nys, nyn
11373	DO k = nzb, nz_do3d
11374	temp_bin = 0.0_wp
11375	DO ib = 1, nbins_aerosol
11376	IF ( 2.0_wp * ra_dry(k,j,i,ib) <= 0.1E-6_wp ) THEN
11377	temp_bin = temp_bin + aerosol_number(ib)%conc(k,j,i)
11378	ENDIF
11379	ENDDO
11380	tend(k,j,i) = temp_bin
11381	ENDDO
11382	ENDDO
11383	ENDDO
11384	IF ( .NOT. mask_surface(mid) ) THEN
11385	DO i = 1, mask_size_l(mid,1)
11386	DO j = 1, mask_size_l(mid,2)
11387	DO k = 1, mask_size_l(mid,3)
11388	local_pf(i,j,k) = tend( mask_k(mid,k), mask_j(mid,j), mask_i(mid,i) )
11389	ENDDO
11390	ENDDO
11391	ENDDO
11392	ELSE
11393	DO i = 1, mask_size_l(mid,1)
11394	DO j = 1, mask_size_l(mid,2)
11395	!
11396	!-- Get k index of the highest terraing surface
11397	im = mask_i(mid,i)
11398	jm = mask_j(mid,j)
11399	ktt = MINLOC( MERGE( 1, 0, BTEST( wall_flags_0(:,jm,im), 5 )), DIM = 1 ) - 1
11400	DO k = 1, mask_size_l(mid,3)
11401	kk = MIN( ktt+mask_k(mid,k), nzt+1 )
11402	!
11403	!-- Set value if not in building
11404	IF ( BTEST( wall_flags_0(kk,jm,im), 6 ) ) THEN
11405	local_pf(i,j,k) = fill_value
11406	ELSE
11407	local_pf(i,j,k) = tend(kk,jm,im)
11408	ENDIF
11409	ENDDO
11410	ENDDO
11411	ENDDO
11412	ENDIF
11413	resorted = .TRUE.
11414	ELSE
11415	to_be_resorted => nufp_av
11416	ENDIF
11417
11418	CASE ( 'Ntot' )
11419	IF ( av == 0 ) THEN
11420	DO i = nxl, nxr
11421	DO j = nys, nyn
11422	DO k = nzb, nz_do3d
11423	temp_bin = 0.0_wp
11424	DO ib = 1, nbins_aerosol
11425	temp_bin = temp_bin + aerosol_number(ib)%conc(k,j,i)
11426	ENDDO
11427	tend(k,j,i) = temp_bin
11428	ENDDO
11429	ENDDO
11430	ENDDO
11431	IF ( .NOT. mask_surface(mid) ) THEN
11432	DO i = 1, mask_size_l(mid,1)
11433	DO j = 1, mask_size_l(mid,2)
11434	DO k = 1, mask_size_l(mid,3)
11435	local_pf(i,j,k) = tend( mask_k(mid,k), mask_j(mid,j), mask_i(mid,i) )
11436	ENDDO
11437	ENDDO
11438	ENDDO
11439	ELSE
11440	DO i = 1, mask_size_l(mid,1)
11441	DO j = 1, mask_size_l(mid,2)
11442	!
11443	!-- Get k index of the highest terraing surface
11444	im = mask_i(mid,i)
11445	jm = mask_j(mid,j)
11446	ktt = MINLOC( MERGE( 1, 0, BTEST( wall_flags_0(:,jm,im), 5 )), DIM = 1 ) - 1
11447	DO k = 1, mask_size_l(mid,3)
11448	kk = MIN( ktt+mask_k(mid,k), nzt+1 )
11449	!
11450	!-- Set value if not in building
11451	IF ( BTEST( wall_flags_0(kk,jm,im), 6 ) ) THEN
11452	local_pf(i,j,k) = fill_value
11453	ELSE
11454	local_pf(i,j,k) = tend(kk,jm,im)
11455	ENDIF
11456	ENDDO
11457	ENDDO
11458	ENDDO
11459	ENDIF
11460	resorted = .TRUE.
11461	ELSE
11462	to_be_resorted => ntot_av
11463	ENDIF
11464
11465	CASE ( 'PM0.1' )
11466	IF ( av == 0 ) THEN
11467	DO i = nxl, nxr
11468	DO j = nys, nyn
11469	DO k = nzb, nz_do3d
11470	temp_bin = 0.0_wp
11471	DO ib = 1, nbins_aerosol
11472	IF ( 2.0_wp * ra_dry(k,j,i,ib) <= 0.1E-6_wp ) THEN
11473	DO ic = ib, nbins_aerosol * ncc, nbins_aerosol
11474	temp_bin = temp_bin + aerosol_mass(ic)%conc(k,j,i)
11475	ENDDO
11476	ENDIF
11477	ENDDO
11478	tend(k,j,i) = temp_bin
11479	ENDDO
11480	ENDDO
11481	ENDDO
11482	IF ( .NOT. mask_surface(mid) ) THEN
11483	DO i = 1, mask_size_l(mid,1)
11484	DO j = 1, mask_size_l(mid,2)
11485	DO k = 1, mask_size_l(mid,3)
11486	local_pf(i,j,k) = tend( mask_k(mid,k), mask_j(mid,j), mask_i(mid,i) )
11487	ENDDO
11488	ENDDO
11489	ENDDO
11490	ELSE
11491	DO i = 1, mask_size_l(mid,1)
11492	DO j = 1, mask_size_l(mid,2)
11493	!
11494	!-- Get k index of the highest terraing surface
11495	im = mask_i(mid,i)
11496	jm = mask_j(mid,j)
11497	ktt = MINLOC( MERGE( 1, 0, BTEST( wall_flags_0(:,jm,im), 5 )), DIM = 1 ) - 1
11498	DO k = 1, mask_size_l(mid,3)
11499	kk = MIN( ktt+mask_k(mid,k), nzt+1 )
11500	!
11501	!-- Set value if not in building
11502	IF ( BTEST( wall_flags_0(kk,jm,im), 6 ) ) THEN
11503	local_pf(i,j,k) = fill_value
11504	ELSE
11505	local_pf(i,j,k) = tend(kk,jm,im)
11506	ENDIF
11507	ENDDO
11508	ENDDO
11509	ENDDO
11510	ENDIF
11511	resorted = .TRUE.
11512	ELSE
11513	to_be_resorted => pm01_av
11514	ENDIF
11515
11516	CASE ( 'PM2.5' )
11517	IF ( av == 0 ) THEN
11518	DO i = nxl, nxr
11519	DO j = nys, nyn
11520	DO k = nzb, nz_do3d
11521	temp_bin = 0.0_wp
11522	DO ib = 1, nbins_aerosol
11523	IF ( 2.0_wp * ra_dry(k,j,i,ib) <= 2.5E-6_wp ) THEN
11524	DO ic = ib, nbins_aerosol * ncc, nbins_aerosol
11525	temp_bin = temp_bin + aerosol_mass(ic)%conc(k,j,i)
11526	ENDDO
11527	ENDIF
11528	ENDDO
11529	tend(k,j,i) = temp_bin
11530	ENDDO
11531	ENDDO
11532	ENDDO
11533	IF ( .NOT. mask_surface(mid) ) THEN
11534	DO i = 1, mask_size_l(mid,1)
11535	DO j = 1, mask_size_l(mid,2)
11536	DO k = 1, mask_size_l(mid,3)
11537	local_pf(i,j,k) = tend( mask_k(mid,k), mask_j(mid,j), mask_i(mid,i) )
11538	ENDDO
11539	ENDDO
11540	ENDDO
11541	ELSE
11542	DO i = 1, mask_size_l(mid,1)
11543	DO j = 1, mask_size_l(mid,2)
11544	!
11545	!-- Get k index of the highest terraing surface
11546	im = mask_i(mid,i)
11547	jm = mask_j(mid,j)
11548	ktt = MINLOC( MERGE( 1, 0, BTEST( wall_flags_0(:,jm,im), 5 )), DIM = 1 ) - 1
11549	DO k = 1, mask_size_l(mid,3)
11550	kk = MIN( ktt+mask_k(mid,k), nzt+1 )
11551	!
11552	!-- Set value if not in building
11553	IF ( BTEST( wall_flags_0(kk,jm,im), 6 ) ) THEN
11554	local_pf(i,j,k) = fill_value
11555	ELSE
11556	local_pf(i,j,k) = tend(kk,jm,im)
11557	ENDIF
11558	ENDDO
11559	ENDDO
11560	ENDDO
11561	ENDIF
11562	resorted = .TRUE.
11563	ELSE
11564	to_be_resorted => pm25_av
11565	ENDIF
11566
11567	CASE ( 'PM10' )
11568	IF ( av == 0 ) THEN
11569	DO i = nxl, nxr
11570	DO j = nys, nyn
11571	DO k = nzb, nz_do3d
11572	temp_bin = 0.0_wp
11573	DO ib = 1, nbins_aerosol
11574	IF ( 2.0_wp * ra_dry(k,j,i,ib) <= 10.0E-6_wp ) THEN
11575	DO ic = ib, nbins_aerosol * ncc, nbins_aerosol
11576	temp_bin = temp_bin + aerosol_mass(ic)%conc(k,j,i)
11577	ENDDO
11578	ENDIF
11579	ENDDO
11580	tend(k,j,i) = temp_bin
11581	ENDDO
11582	ENDDO
11583	ENDDO
11584	IF ( .NOT. mask_surface(mid) ) THEN
11585	DO i = 1, mask_size_l(mid,1)
11586	DO j = 1, mask_size_l(mid,2)
11587	DO k = 1, mask_size_l(mid,3)
11588	local_pf(i,j,k) = tend( mask_k(mid,k), mask_j(mid,j), mask_i(mid,i) )
11589	ENDDO
11590	ENDDO
11591	ENDDO
11592	ELSE
11593	DO i = 1, mask_size_l(mid,1)
11594	DO j = 1, mask_size_l(mid,2)
11595	!
11596	!-- Get k index of the highest terraing surface
11597	im = mask_i(mid,i)
11598	jm = mask_j(mid,j)
11599	ktt = MINLOC( MERGE( 1, 0, BTEST( wall_flags_0(:,jm,im), 5 )), DIM = 1 ) - 1
11600	DO k = 1, mask_size_l(mid,3)
11601	kk = MIN( ktt+mask_k(mid,k), nzt+1 )
11602	!
11603	!-- Set value if not in building
11604	IF ( BTEST( wall_flags_0(kk,jm,im), 6 ) ) THEN
11605	local_pf(i,j,k) = fill_value
11606	ELSE
11607	local_pf(i,j,k) = tend(kk,jm,im)
11608	ENDIF
11609	ENDDO
11610	ENDDO
11611	ENDDO
11612	ENDIF
11613	resorted = .TRUE.
11614	ELSE
11615	to_be_resorted => pm10_av
11616	ENDIF
11617
11618	CASE ( 's_BC', 's_DU', 's_NH', 's_NO', 's_OC', 's_SO4', 's_SS' )
11619	IF ( av == 0 ) THEN
11620	IF ( is_used( prtcl, TRIM( variable(3:) ) ) ) THEN
11621	found_index = get_index( prtcl, TRIM( variable(3:) ) )
11622	DO i = nxl, nxr
11623	DO j = nys, nyn
11624	DO k = nzb, nz_do3d
11625	temp_bin = 0.0_wp
11626	DO ic = ( found_index-1 ) * nbins_aerosol + 1, found_index * nbins_aerosol
11627	temp_bin = temp_bin + aerosol_mass(ic)%conc(k,j,i)
11628	ENDDO
11629	tend(k,j,i) = temp_bin
11630	ENDDO
11631	ENDDO
11632	ENDDO
11633	ELSE
11634	tend = 0.0_wp
11635	ENDIF
11636	IF ( .NOT. mask_surface(mid) ) THEN
11637	DO i = 1, mask_size_l(mid,1)
11638	DO j = 1, mask_size_l(mid,2)
11639	DO k = 1, mask_size_l(mid,3)
11640	local_pf(i,j,k) = tend( mask_k(mid,k), mask_j(mid,j), mask_i(mid,i) )
11641	ENDDO
11642	ENDDO
11643	ENDDO
11644	ELSE
11645	DO i = 1, mask_size_l(mid,1)
11646	DO j = 1, mask_size_l(mid,2)
11647	!
11648	!-- Get k index of the highest terraing surface
11649	im = mask_i(mid,i)
11650	jm = mask_j(mid,j)
11651	ktt = MINLOC( MERGE( 1, 0, BTEST( wall_flags_0(:,jm,im), 5 )), DIM = 1 ) - 1
11652	DO k = 1, mask_size_l(mid,3)
11653	kk = MIN( ktt+mask_k(mid,k), nzt+1 )
11654	!
11655	!-- Set value if not in building
11656	IF ( BTEST( wall_flags_0(kk,jm,im), 6 ) ) THEN
11657	local_pf(i,j,k) = fill_value
11658	ELSE
11659	local_pf(i,j,k) = tend(kk,jm,im)
11660	ENDIF
11661	ENDDO
11662	ENDDO
11663	ENDDO
11664	ENDIF
11665	resorted = .TRUE.
11666	ELSE
11667	!
11668	!-- 9: remove salsa_s_ from the beginning
11669	IF ( TRIM( variable(9:) ) == 'BC' ) to_be_resorted => s_bc_av
11670	IF ( TRIM( variable(9:) ) == 'DU' ) to_be_resorted => s_du_av
11671	IF ( TRIM( variable(9:) ) == 'NH' ) to_be_resorted => s_nh_av
11672	IF ( TRIM( variable(9:) ) == 'NO' ) to_be_resorted => s_no_av
11673	IF ( TRIM( variable(9:) ) == 'OC' ) to_be_resorted => s_oc_av
11674	IF ( TRIM( variable(9:) ) == 'SO4' ) to_be_resorted => s_so4_av
11675	IF ( TRIM( variable(9:) ) == 'SS' ) to_be_resorted => s_ss_av
11676	ENDIF
11677
11678	CASE ( 's_H2O' )
11679	IF ( av == 0 ) THEN
11680	found_index = get_index( prtcl, 'H2O' )
11681	DO i = nxl, nxr
11682	DO j = nys, nyn
11683	DO k = nzb, nz_do3d
11684	temp_bin = 0.0_wp
11685	DO ic = ( found_index-1 ) * nbins_aerosol + 1, found_index * nbins_aerosol
11686	temp_bin = temp_bin + aerosol_mass(ic)%conc(k,j,i)
11687	ENDDO
11688	tend(k,j,i) = temp_bin
11689	ENDDO
11690	ENDDO
11691	ENDDO
11692	IF ( .NOT. mask_surface(mid) ) THEN
11693	DO i = 1, mask_size_l(mid,1)
11694	DO j = 1, mask_size_l(mid,2)
11695	DO k = 1, mask_size_l(mid,3)
11696	local_pf(i,j,k) = tend( mask_k(mid,k), mask_j(mid,j), mask_i(mid,i) )
11697	ENDDO
11698	ENDDO
11699	ENDDO
11700	ELSE
11701	DO i = 1, mask_size_l(mid,1)
11702	DO j = 1, mask_size_l(mid,2)
11703	!
11704	!-- Get k index of the highest terraing surface
11705	im = mask_i(mid,i)
11706	jm = mask_j(mid,j)
11707	ktt = MINLOC( MERGE( 1, 0, BTEST( wall_flags_0(:,jm,im), 5 )), DIM = 1 ) - 1
11708	DO k = 1, mask_size_l(mid,3)
11709	kk = MIN( ktt+mask_k(mid,k), nzt+1 )
11710	!
11711	!-- Set value if not in building
11712	IF ( BTEST( wall_flags_0(kk,jm,im), 6 ) ) THEN
11713	local_pf(i,j,k) = fill_value
11714	ELSE
11715	local_pf(i,j,k) = tend(kk,jm,im)
11716	ENDIF
11717	ENDDO
11718	ENDDO
11719	ENDDO
11720	ENDIF
11721	resorted = .TRUE.
11722	ELSE
11723	to_be_resorted => s_h2o_av
11724	ENDIF
11725
11726	CASE DEFAULT
11727	found = .FALSE.
11728
11729	END SELECT
11730	ENDIF
11731
11732	IF ( found .AND. .NOT. resorted ) THEN
11733	IF ( .NOT. mask_surface(mid) ) THEN
11734	!
11735	!-- Default masked output
11736	DO i = 1, mask_size_l(mid,1)
11737	DO j = 1, mask_size_l(mid,2)
11738	DO k = 1, mask_size_l(mid,3)
11739	local_pf(i,j,k) = to_be_resorted( mask_k(mid,k), mask_j(mid,j), mask_i(mid,i) )
11740	ENDDO
11741	ENDDO
11742	ENDDO
11743	ELSE
11744	!
11745	!-- Terrain-following masked output
11746	DO i = 1, mask_size_l(mid,1)
11747	DO j = 1, mask_size_l(mid,2)
11748	!-- Get k index of the highest terraing surface
11749	im = mask_i(mid,i)
11750	jm = mask_j(mid,j)
11751	ktt = MINLOC( MERGE( 1, 0, BTEST( wall_flags_0(:,jm,im), 5 )), DIM = 1 ) - 1
11752	DO k = 1, mask_size_l(mid,3)
11753	kk = MIN( ktt+mask_k(mid,k), nzt+1 )
11754	!-- Set value if not in building
11755	IF ( BTEST( wall_flags_0(kk,jm,im), 6 ) ) THEN
11756	local_pf(i,j,k) = fill_value
11757	ELSE
11758	local_pf(i,j,k) = to_be_resorted(kk,jm,im)
11759	ENDIF
11760	ENDDO
11761	ENDDO
11762	ENDDO
11763	ENDIF
11764	ENDIF
11765
11766	END SUBROUTINE salsa_data_output_mask
11767
11768	!------------------------------------------------------------------------------!
11769	! Description:
11770	! ------------
11771	!> Creates index tables for different (aerosol) components
11772	!------------------------------------------------------------------------------!
11773	SUBROUTINE component_index_constructor( self, ncomp, nlist, listcomp )
11774
11775	IMPLICIT NONE
11776
11777	INTEGER(iwp) :: ii !<
11778	INTEGER(iwp) :: jj !<
11779
11780	INTEGER(iwp), INTENT(in) :: nlist ! < Maximum number of components
11781
11782	INTEGER(iwp), INTENT(inout) :: ncomp !< Number of components
11783
11784	CHARACTER(LEN=3), INTENT(in) :: listcomp(nlist) !< List cof component names
11785
11786	TYPE(component_index), INTENT(inout) :: self !< Object containing the indices of different
11787	!< aerosol components
11788
11789	ncomp = 0
11790
11791	DO WHILE ( listcomp(ncomp+1) /= ' ' .AND. ncomp < nlist )
11792	ncomp = ncomp + 1
11793	ENDDO
11794
11795	self%ncomp = ncomp
11796	ALLOCATE( self%ind(ncomp), self%comp(ncomp) )
11797
11798	DO ii = 1, ncomp
11799	self%ind(ii) = ii
11800	ENDDO
11801
11802	jj = 1
11803	DO ii = 1, nlist
11804	IF ( listcomp(ii) == '') CYCLE
11805	self%comp(jj) = listcomp(ii)
11806	jj = jj + 1
11807	ENDDO
11808
11809	END SUBROUTINE component_index_constructor
11810
11811	!------------------------------------------------------------------------------!
11812	! Description:
11813	! ------------
11814	!> Gives the index of a component in the component list
11815	!------------------------------------------------------------------------------!
11816	INTEGER FUNCTION get_index( self, incomp )
11817
11818	IMPLICIT NONE
11819
11820	CHARACTER(LEN=*), INTENT(in) :: incomp !< Component name
11821
11822	INTEGER(iwp) :: ii !< index
11823
11824	TYPE(component_index), INTENT(in) :: self !< Object containing the indices of different
11825	!< aerosol components
11826	IF ( ANY( self%comp == incomp ) ) THEN
11827	ii = 1
11828	DO WHILE ( (self%comp(ii) /= incomp) )
11829	ii = ii + 1
11830	ENDDO
11831	get_index = ii
11832	ELSEIF ( incomp == 'H2O' ) THEN
11833	get_index = self%ncomp + 1
11834	ELSE
11835	WRITE( message_string, * ) 'Incorrect component name given!'
11836	CALL message( 'get_index', 'PA0591', 1, 2, 0, 6, 0 )
11837	ENDIF
11838
11839	END FUNCTION get_index
11840
11841	!------------------------------------------------------------------------------!
11842	! Description:
11843	! ------------
11844	!> Tells if the (aerosol) component is being used in the simulation
11845	!------------------------------------------------------------------------------!
11846	LOGICAL FUNCTION is_used( self, icomp )
11847
11848	IMPLICIT NONE
11849
11850	CHARACTER(LEN=*), INTENT(in) :: icomp !< Component name
11851
11852	TYPE(component_index), INTENT(in) :: self !< Object containing the indices of different
11853	!< aerosol components
11854
11855	IF ( ANY(self%comp == icomp) ) THEN
11856	is_used = .TRUE.
11857	ELSE
11858	is_used = .FALSE.
11859	ENDIF
11860
11861	END FUNCTION
11862
11863	END MODULE salsa_mod

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

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |