Home

Context Navigation

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

Last change on this file since 3780 was 3780, checked in by forkel, 6 years ago
removed read from unit 10 in chemistry_model_mod.f90, added get_mechanismname
Property svn:keywords set to `Id`
File size: 459.6 KB

Line
1	!> @file salsa_mod.f90
2	!--------------------------------------------------------------------------------!
3	! This file is part of PALM-4U.
4	!
5	! PALM-4U is free software: you can redistribute it and/or modify it under the
6	! terms of the GNU General Public License as published by the Free Software
7	! Foundation, either version 3 of the License, or (at your option) any later
8	! version.
9	!
10	! PALM-4U is distributed in the hope that it will be useful, but WITHOUT ANY
11	! WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
12	! A PARTICULAR PURPOSE. See the GNU General Public License for more details.
13	!
14	! You should have received a copy of the GNU General Public License along with
15	! PALM. If not, see <http://www.gnu.org/licenses/>.
16	!
17	! Copyright 2018-2018 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 3780 2019-03-05 11:19:45Z forkel $
28	! unused variable for file index removed from rrd-subroutines parameter list
29	!
30	! 3685 2019-01-21 01:02:11Z knoop
31	! Some interface calls moved to module_interface + cleanup
32	!
33	! 3655 2019-01-07 16:51:22Z knoop
34	! Implementation of the PALM module interface
35	!
36	! 3636 2018-12-19 13:48:34Z raasch
37	! nopointer option removed
38	!
39	! 3630 2018-12-17 11:04:17Z knoop
40	! - Moved the control parameter "salsa" from salsa_mod.f90 to control_parameters
41	! - Updated salsa_rrd_local and salsa_wrd_local
42	! - Add target attribute
43	! - Revise initialization in case of restarts
44	! - Revise masked data output
45	!
46	! 3582 2018-11-29 19:16:36Z suehring
47	! missing comma separator inserted
48	!
49	! 3483 2018-11-02 14:19:26Z raasch
50	! bugfix: directives added to allow compilation without netCDF
51	!
52	! 3481 2018-11-02 09:14:13Z raasch
53	! temporary variable cc introduced to circumvent a possible Intel18 compiler bug
54	! related to contiguous/non-contguous pointer/target attributes
55	!
56	! 3473 2018-10-30 20:50:15Z suehring
57	! NetCDF input routine renamed
58	!
59	! 3467 2018-10-30 19:05:21Z suehring
60	! Initial revision
61	!
62	! 3412 2018-10-24 07:25:57Z monakurppa
63	!
64	! Authors:
65	! --------
66	! @author Mona Kurppa (University of Helsinki)
67	!
68	!
69	! Description:
70	! ------------
71	!> Sectional aerosol module for large scale applications SALSA
72	!> (Kokkola et al., 2008, ACP 8, 2469-2483). Solves the aerosol number and mass
73	!> concentration as well as chemical composition. Includes aerosol dynamic
74	!> processes: nucleation, condensation/evaporation of vapours, coagulation and
75	!> deposition on tree leaves, ground and roofs.
76	!> Implementation is based on formulations implemented in UCLALES-SALSA except
77	!> for deposition which is based on parametrisations by Zhang et al. (2001,
78	!> Atmos. Environ. 35, 549-560) or Petroff&Zhang (2010, Geosci. Model Dev. 3,
79	!> 753-769)
80	!>
81	!> @todo Implement turbulent inflow of aerosols in inflow_turbulence.
82	!> @todo Deposition on subgrid scale vegetation
83	!> @todo Deposition on vegetation calculated by default for deciduous broadleaf
84	!> trees
85	!> @todo Revise masked data output. There is a potential bug in case of
86	!> terrain-following masked output, according to data_output_mask.
87	!> @todo There are now improved interfaces for NetCDF data input which can be
88	!> used instead of get variable etc.
89	!------------------------------------------------------------------------------!
90	MODULE salsa_mod
91
92	USE basic_constants_and_equations_mod, &
93	ONLY: c_p, g, p_0, pi, r_d
94
95	USE chemistry_model_mod, &
96	ONLY: chem_species, nspec, nvar, spc_names
97
98	USE chem_modules, &
99	ONLY: call_chem_at_all_substeps, chem_gasphase_on
100
101	USE control_parameters
102
103	USE indices, &
104	ONLY: nbgp, nx, nxl, nxlg, nxr, nxrg, ny, nyn, nyng, nys, nysg, nzb, &
105	nzb_s_inner, nz, nzt, wall_flags_0
106
107	USE kinds
108
109	USE pegrid
110
111	USE salsa_util_mod
112
113	IMPLICIT NONE
114	!
115	!-- SALSA constants:
116	!
117	!-- Local constants:
118	INTEGER(iwp), PARAMETER :: ngast = 5 !< total number of gaseous tracers:
119	!< 1 = H2SO4, 2 = HNO3, 3 = NH3,
120	!< 4 = OCNV (non-volatile OC),
121	!< 5 = OCSV (semi-volatile)
122	INTEGER(iwp), PARAMETER :: nmod = 7 !< number of modes for initialising
123	!< the aerosol size distribution
124	INTEGER(iwp), PARAMETER :: nreg = 2 !< Number of main size subranges
125	INTEGER(iwp), PARAMETER :: maxspec = 7 !< Max. number of aerosol species
126	!
127	!-- Universal constants
128	REAL(wp), PARAMETER :: abo = 1.380662E-23_wp !< Boltzmann constant (J/K)
129	REAL(wp), PARAMETER :: alv = 2.260E+6_wp !< latent heat for H2O
130	!< vaporisation (J/kg)
131	REAL(wp), PARAMETER :: alv_d_rv = 4896.96865_wp !< alv / rv
132	REAL(wp), PARAMETER :: am_airmol = 4.8096E-26_wp !< Average mass of one air
133	!< molecule (Jacobson,
134	!< 2005, Eq. 2.3)
135	REAL(wp), PARAMETER :: api6 = 0.5235988_wp !< pi / 6
136	REAL(wp), PARAMETER :: argas = 8.314409_wp !< Gas constant (J/(mol K))
137	REAL(wp), PARAMETER :: argas_d_cpd = 8.281283865E-3_wp !< argas per cpd
138	REAL(wp), PARAMETER :: avo = 6.02214E+23_wp !< Avogadro constant (1/mol)
139	REAL(wp), PARAMETER :: d_sa = 5.539376964394570E-10_wp !< diameter of
140	!< condensing sulphuric
141	!< acid molecule (m)
142	REAL(wp), PARAMETER :: for_ppm_to_nconc = 7.243016311E+16_wp !<
143	!< ppm * avo / R (K/(Pa*m3))
144	REAL(wp), PARAMETER :: epsoc = 0.15_wp !< water uptake of organic
145	!< material
146	REAL(wp), PARAMETER :: mclim = 1.0E-23_wp !< mass concentration min
147	!< limit for aerosols (kg/m3)
148	REAL(wp), PARAMETER :: n3 = 158.79_wp !< Number of H2SO4 molecules in
149	!< 3 nm cluster if d_sa=5.54e-10m
150	REAL(wp), PARAMETER :: nclim = 1.0_wp !< number concentration min limit
151	!< for aerosols and gases (#/m3)
152	REAL(wp), PARAMETER :: surfw0 = 0.073_wp !< surface tension of pure water
153	!< at ~ 293 K (J/m2)
154	REAL(wp), PARAMETER :: vclim = 1.0E-24_wp !< volume concentration min
155	!< limit for aerosols (m3/m3)
156	!-- Molar masses in kg/mol
157	REAL(wp), PARAMETER :: ambc = 12.0E-3_wp !< black carbon (BC)
158	REAL(wp), PARAMETER :: amdair = 28.970E-3_wp !< dry air
159	REAL(wp), PARAMETER :: amdu = 100.E-3_wp !< mineral dust
160	REAL(wp), PARAMETER :: amh2o = 18.0154E-3_wp !< H2O
161	REAL(wp), PARAMETER :: amh2so4 = 98.06E-3_wp !< H2SO4
162	REAL(wp), PARAMETER :: amhno3 = 63.01E-3_wp !< HNO3
163	REAL(wp), PARAMETER :: amn2o = 44.013E-3_wp !< N2O
164	REAL(wp), PARAMETER :: amnh3 = 17.031E-3_wp !< NH3
165	REAL(wp), PARAMETER :: amo2 = 31.9988E-3_wp !< O2
166	REAL(wp), PARAMETER :: amo3 = 47.998E-3_wp !< O3
167	REAL(wp), PARAMETER :: amoc = 150.E-3_wp !< organic carbon (OC)
168	REAL(wp), PARAMETER :: amss = 58.44E-3_wp !< sea salt (NaCl)
169	!-- Densities in kg/m3
170	REAL(wp), PARAMETER :: arhobc = 2000.0_wp !< black carbon
171	REAL(wp), PARAMETER :: arhodu = 2650.0_wp !< mineral dust
172	REAL(wp), PARAMETER :: arhoh2o = 1000.0_wp !< H2O
173	REAL(wp), PARAMETER :: arhoh2so4 = 1830.0_wp !< SO4
174	REAL(wp), PARAMETER :: arhohno3 = 1479.0_wp !< HNO3
175	REAL(wp), PARAMETER :: arhonh3 = 1530.0_wp !< NH3
176	REAL(wp), PARAMETER :: arhooc = 2000.0_wp !< organic carbon
177	REAL(wp), PARAMETER :: arhoss = 2165.0_wp !< sea salt (NaCl)
178	!-- Volume of molecule in m3/#
179	REAL(wp), PARAMETER :: amvh2o = amh2o /avo / arhoh2o !< H2O
180	REAL(wp), PARAMETER :: amvh2so4 = amh2so4 / avo / arhoh2so4 !< SO4
181	REAL(wp), PARAMETER :: amvhno3 = amhno3 / avo / arhohno3 !< HNO3
182	REAL(wp), PARAMETER :: amvnh3 = amnh3 / avo / arhonh3 !< NH3
183	REAL(wp), PARAMETER :: amvoc = amoc / avo / arhooc !< OC
184	REAL(wp), PARAMETER :: amvss = amss / avo / arhoss !< sea salt
185
186	!
187	!-- SALSA switches:
188	INTEGER(iwp) :: nj3 = 1 !< J3 parametrization (nucleation)
189	!< 1 = condensational sink (Kerminen&Kulmala, 2002)
190	!< 2 = coagulational sink (Lehtinen et al. 2007)
191	!< 3 = coagS+self-coagulation (Anttila et al. 2010)
192	INTEGER(iwp) :: nsnucl = 0 !< Choice of the nucleation scheme:
193	!< 0 = off
194	!< 1 = binary nucleation
195	!< 2 = activation type nucleation
196	!< 3 = kinetic nucleation
197	!< 4 = ternary nucleation
198	!< 5 = nucleation with ORGANICs
199	!< 6 = activation type of nucleation with
200	!< H2SO4+ORG
201	!< 7 = heteromolecular nucleation with H2SO4*ORG
202	!< 8 = homomolecular nucleation of H2SO4 +
203	!< heteromolecular nucleation with H2SO4*ORG
204	!< 9 = homomolecular nucleation of H2SO4 and ORG
205	!< +heteromolecular nucleation with H2SO4*ORG
206	LOGICAL :: advect_particle_water = .TRUE. !< advect water concentration of
207	!< particles
208	LOGICAL :: decycle_lr = .FALSE. !< Undo cyclic boundary
209	!< conditions: left and right
210	LOGICAL :: decycle_ns = .FALSE. !< north and south boundaries
211	LOGICAL :: feedback_to_palm = .FALSE. !< allow feedback due to
212	!< hydration and/or condensation
213	!< of H20
214	LOGICAL :: no_insoluble = .FALSE. !< Switch to exclude insoluble
215	!< chemical components
216	LOGICAL :: read_restart_data_salsa = .FALSE. !< read restart data for salsa
217	LOGICAL :: salsa_gases_from_chem = .FALSE. !< Transfer the gaseous
218	!< components to SALSA from
219	!< from chemistry model
220	LOGICAL :: van_der_waals_coagc = .FALSE. !< Enhancement of coagulation
221	!< kernel by van der Waals and
222	!< viscous forces
223	LOGICAL :: write_binary_salsa = .FALSE. !< read binary for salsa
224	!-- Process switches: nl* is read from the NAMELIST and is NOT changed.
225	!-- ls* is the switch used and will get the value of nl*
226	!-- except for special circumstances (spinup period etc.)
227	LOGICAL :: nlcoag = .FALSE. !< Coagulation master switch
228	LOGICAL :: lscoag = .FALSE. !<
229	LOGICAL :: nlcnd = .FALSE. !< Condensation master switch
230	LOGICAL :: lscnd = .FALSE. !<
231	LOGICAL :: nlcndgas = .FALSE. !< Condensation of precursor gases
232	LOGICAL :: lscndgas = .FALSE. !<
233	LOGICAL :: nlcndh2oae = .FALSE. !< Condensation of H2O on aerosol
234	LOGICAL :: lscndh2oae = .FALSE. !< particles (FALSE -> equilibrium calc.)
235	LOGICAL :: nldepo = .FALSE. !< Deposition master switch
236	LOGICAL :: lsdepo = .FALSE. !<
237	LOGICAL :: nldepo_topo = .FALSE. !< Deposition on vegetation master switch
238	LOGICAL :: lsdepo_topo = .FALSE. !<
239	LOGICAL :: nldepo_vege = .FALSE. !< Deposition on walls master switch
240	LOGICAL :: lsdepo_vege = .FALSE. !<
241	LOGICAL :: nldistupdate = .TRUE. !< Size distribution update master switch
242	LOGICAL :: lsdistupdate = .FALSE. !<
243	!
244	!-- SALSA variables:
245	CHARACTER (LEN=20) :: bc_salsa_b = 'neumann' !< bottom boundary condition
246	CHARACTER (LEN=20) :: bc_salsa_t = 'neumann' !< top boundary condition
247	CHARACTER (LEN=20) :: depo_vege_type = 'zhang2001' !< or 'petroff2010'
248	CHARACTER (LEN=20) :: depo_topo_type = 'zhang2001' !< or 'petroff2010'
249	CHARACTER (LEN=20), DIMENSION(4) :: decycle_method = &
250	(/'dirichlet','dirichlet','dirichlet','dirichlet'/)
251	!< Decycling method at horizontal boundaries,
252	!< 1=left, 2=right, 3=south, 4=north
253	!< dirichlet = initial size distribution and
254	!< chemical composition set for the ghost and
255	!< first three layers
256	!< neumann = zero gradient
257	CHARACTER (LEN=3), DIMENSION(maxspec) :: listspec = & !< Active aerosols
258	(/'SO4',' ',' ',' ',' ',' ',' '/)
259	CHARACTER (LEN=20) :: salsa_source_mode = 'no_source'
260	!< 'read_from_file',
261	!< 'constant' or 'no_source'
262	INTEGER(iwp) :: dots_salsa = 0 !< starting index for salsa-timeseries
263	INTEGER(iwp) :: fn1a = 1 !< last index for bin subranges: subrange 1a
264	INTEGER(iwp) :: fn2a = 1 !< subrange 2a
265	INTEGER(iwp) :: fn2b = 1 !< subrange 2b
266	INTEGER(iwp), DIMENSION(ngast) :: gas_index_chem = (/ 1, 1, 1, 1, 1/) !<
267	!< Index of gaseous compounds in the chemistry
268	!< model. In SALSA, 1 = H2SO4, 2 = HNO3,
269	!< 3 = NH3, 4 = OCNV, 5 = OCSV
270	INTEGER(iwp) :: ibc_salsa_b !<
271	INTEGER(iwp) :: ibc_salsa_t !<
272	INTEGER(iwp) :: igctyp = 0 !< Initial gas concentration type
273	!< 0 = uniform (use H2SO4_init, HNO3_init,
274	!< NH3_init, OCNV_init and OCSV_init)
275	!< 1 = read vertical profile from an input file
276	INTEGER(iwp) :: in1a = 1 !< start index for bin subranges: subrange 1a
277	INTEGER(iwp) :: in2a = 1 !< subrange 2a
278	INTEGER(iwp) :: in2b = 1 !< subrange 2b
279	INTEGER(iwp) :: isdtyp = 0 !< Initial size distribution type
280	!< 0 = uniform
281	!< 1 = read vertical profile of the mode number
282	!< concentration from an input file
283	INTEGER(iwp) :: ibc = -1 !< Indice for: black carbon (BC)
284	INTEGER(iwp) :: idu = -1 !< dust
285	INTEGER(iwp) :: inh = -1 !< NH3
286	INTEGER(iwp) :: ino = -1 !< HNO3
287	INTEGER(iwp) :: ioc = -1 !< organic carbon (OC)
288	INTEGER(iwp) :: iso4 = -1 !< SO4 or H2SO4
289	INTEGER(iwp) :: iss = -1 !< sea salt
290	INTEGER(iwp) :: lod_aero = 0 !< level of detail for aerosol emissions
291	INTEGER(iwp) :: lod_gases = 0 !< level of detail for gaseous emissions
292	INTEGER(iwp), DIMENSION(nreg) :: nbin = (/ 3, 7/) !< Number of size bins
293	!< for each aerosol size subrange
294	INTEGER(iwp) :: nbins = 1 !< total number of size bins
295	INTEGER(iwp) :: ncc = 1 !< number of chemical components used
296	INTEGER(iwp) :: ncc_tot = 1!< total number of chemical compounds (ncc+1
297	!< if particle water is advected)
298	REAL(wp) :: act_coeff = 1.0E-7_wp !< Activation coefficient
299	REAL(wp) :: aerosol_source = 0.0_wp !< Constant aerosol flux (#/(m3*s))
300	REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: emission_mass_fracs !< array for
301	!< aerosol composition per emission category
302	!< 1:SO4 2:OC 3:BC 4:DU 5:SS 6:NO 7:NH
303	REAL(wp) :: dt_salsa = 0.00001_wp !< Time step of SALSA
304	REAL(wp) :: H2SO4_init = nclim !< Init value for sulphuric acid gas
305	REAL(wp) :: HNO3_init = nclim !< Init value for nitric acid gas
306	REAL(wp) :: last_salsa_time = 0.0_wp !< time of the previous salsa
307	!< timestep
308	REAL(wp) :: nf2a = 1.0_wp !< Number fraction allocated to a-
309	!< bins in subrange 2
310	!< (b-bins will get 1-nf2a)
311	REAL(wp) :: NH3_init = nclim !< Init value for ammonia gas
312	REAL(wp) :: OCNV_init = nclim !< Init value for non-volatile
313	!< organic gases
314	REAL(wp) :: OCSV_init = nclim !< Init value for semi-volatile
315	!< organic gases
316	REAL(wp), DIMENSION(nreg+1) :: reglim = & !< Min&max diameters of size subranges
317	(/ 3.0E-9_wp, 5.0E-8_wp, 1.0E-5_wp/)
318	REAL(wp) :: rhlim = 1.20_wp !< RH limit in %/100. Prevents
319	!< unrealistically high RH in condensation
320	REAL(wp) :: skip_time_do_salsa = 0.0_wp !< Starting time of SALSA (s)
321	!-- Initial log-normal size distribution: mode diameter (dpg, micrometres),
322	!-- standard deviation (sigmag) and concentration (n_lognorm, #/cm3)
323	REAL(wp), DIMENSION(nmod) :: dpg = (/0.013_wp, 0.054_wp, 0.86_wp, &
324	0.2_wp, 0.2_wp, 0.2_wp, 0.2_wp/)
325	REAL(wp), DIMENSION(nmod) :: sigmag = (/1.8_wp, 2.16_wp, 2.21_wp, &
326	2.0_wp, 2.0_wp, 2.0_wp, 2.0_wp/)
327	REAL(wp), DIMENSION(nmod) :: n_lognorm = (/1.04e+5_wp, 3.23E+4_wp, 5.4_wp,&
328	0.0_wp, 0.0_wp, 0.0_wp, 0.0_wp/)
329	!-- Initial mass fractions / chemical composition of the size distribution
330	REAL(wp), DIMENSION(maxspec) :: mass_fracs_a = & !< mass fractions between
331	(/1.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0/) !< aerosol species for A bins
332	REAL(wp), DIMENSION(maxspec) :: mass_fracs_b = & !< mass fractions between
333	(/0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0/) !< aerosol species for B bins
334
335	REAL(wp), ALLOCATABLE, DIMENSION(:) :: bin_low_limits !< to deliver
336	!< information about
337	!< the lower
338	!< diameters per bin
339	REAL(wp), ALLOCATABLE, DIMENSION(:) :: nsect !< Background number
340	!< concentration per bin
341	REAL(wp), ALLOCATABLE, DIMENSION(:) :: massacc !< Mass accomodation
342	!< coefficients per bin
343	!
344	!-- SALSA derived datatypes:
345	!
346	!-- Prognostic variable: Aerosol size bin information (number (#/m3) and
347	!-- mass (kg/m3) concentration) and the concentration of gaseous tracers (#/m3).
348	!-- Gas tracers are contained sequentially in dimension 4 as:
349	!-- 1. H2SO4, 2. HNO3, 3. NH3, 4. OCNV (non-volatile organics),
350	!-- 5. OCSV (semi-volatile)
351	TYPE salsa_variable
352	REAL(wp), POINTER, DIMENSION(:,:,:), CONTIGUOUS :: conc
353	REAL(wp), POINTER, DIMENSION(:,:,:), CONTIGUOUS :: conc_p
354	REAL(wp), POINTER, DIMENSION(:,:,:), CONTIGUOUS :: tconc_m
355	REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: flux_s, diss_s
356	REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: flux_l, diss_l
357	REAL(wp), ALLOCATABLE, DIMENSION(:) :: init
358	REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: source
359	REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: sums_ws_l
360	END TYPE salsa_variable
361
362	!-- Map bin indices between parallel size distributions
363	TYPE t_parallelbin
364	INTEGER(iwp) :: cur ! Index for current distribution
365	INTEGER(iwp) :: par ! Index for corresponding parallel distribution
366	END TYPE t_parallelbin
367
368	!-- Datatype used to store information about the binned size distributions of
369	!-- aerosols
370	TYPE t_section
371	REAL(wp) :: vhilim !< bin volume at the high limit
372	REAL(wp) :: vlolim !< bin volume at the low limit
373	REAL(wp) :: vratiohi !< volume ratio between the center and high limit
374	REAL(wp) :: vratiolo !< volume ratio between the center and low limit
375	REAL(wp) :: dmid !< bin middle diameter (m)
376	!******************************************************
377	! ^ Do NOT change the stuff above after initialization !
378	!******************************************************
379	REAL(wp) :: dwet !< Wet diameter or mean droplet diameter (m)
380	REAL(wp), DIMENSION(maxspec+1) :: volc !< Volume concentrations
381	!< (m^3/m^3) of aerosols + water. Since most of
382	!< the stuff in SALSA is hard coded, these *have to
383	!< be* in the order
384	!< 1:SO4, 2:OC, 3:BC, 4:DU, 5:SS, 6:NO, 7:NH, 8:H2O
385	REAL(wp) :: veqh2o !< Equilibrium H2O concentration for each particle
386	REAL(wp) :: numc !< Number concentration of particles/droplets (#/m3)
387	REAL(wp) :: core !< Volume of dry particle
388	END TYPE t_section
389	!
390	!-- Local aerosol properties in SALSA
391	TYPE(t_section), ALLOCATABLE :: aero(:)
392	!
393	!-- SALSA tracers:
394	!-- Tracers as x = x(k,j,i,bin). The 4th dimension contains all the size bins
395	!-- sequentially for each aerosol species + water.
396	!
397	!-- Prognostic tracers:
398	!
399	!-- Number concentration (#/m3)
400	TYPE(salsa_variable), ALLOCATABLE, DIMENSION(:), TARGET :: aerosol_number
401	REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:), TARGET :: nconc_1
402	REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:), TARGET :: nconc_2
403	REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:), TARGET :: nconc_3
404	!
405	!-- Mass concentration (kg/m3)
406	TYPE(salsa_variable), ALLOCATABLE, DIMENSION(:), TARGET :: aerosol_mass
407	REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:), TARGET :: mconc_1
408	REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:), TARGET :: mconc_2
409	REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:), TARGET :: mconc_3
410	!
411	!-- Gaseous tracers (#/m3)
412	TYPE(salsa_variable), ALLOCATABLE, DIMENSION(:), TARGET :: salsa_gas
413	REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:), TARGET :: gconc_1
414	REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:), TARGET :: gconc_2
415	REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:), TARGET :: gconc_3
416	!
417	!-- Diagnostic tracers
418	REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:) :: sedim_vd !< sedimentation
419	!< velocity per size
420	!< bin (m/s)
421	REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:) :: Ra_dry !< dry radius (m)
422
423	!-- Particle component index tables
424	TYPE(component_index) :: prtcl !< Contains "getIndex" which gives the index
425	!< for a given aerosol component name, i.e.
426	!< 1:SO4, 2:OC, 3:BC, 4:DU,
427	!< 5:SS, 6:NO, 7:NH, 8:H2O
428	!
429	!-- Data output arrays:
430	!-- Gases:
431	REAL(wp), ALLOCATABLE, DIMENSION(:,:,:), TARGET :: g_H2SO4_av !< H2SO4
432	REAL(wp), ALLOCATABLE, DIMENSION(:,:,:), TARGET :: g_HNO3_av !< HNO3
433	REAL(wp), ALLOCATABLE, DIMENSION(:,:,:), TARGET :: g_NH3_av !< NH3
434	REAL(wp), ALLOCATABLE, DIMENSION(:,:,:), TARGET :: g_OCNV_av !< non-vola-
435	!< tile OC
436	REAL(wp), ALLOCATABLE, DIMENSION(:,:,:), TARGET :: g_OCSV_av !< semi-vol.
437	!< OC
438	!-- Integrated:
439	REAL(wp), ALLOCATABLE, DIMENSION(:,:,:), TARGET :: LDSA_av !< lung-
440	!< deposited
441	!< surface area
442	REAL(wp), ALLOCATABLE, DIMENSION(:,:,:), TARGET :: Ntot_av !< total number
443	!< conc.
444	REAL(wp), ALLOCATABLE, DIMENSION(:,:,:), TARGET :: PM25_av !< PM2.5
445	REAL(wp), ALLOCATABLE, DIMENSION(:,:,:), TARGET :: PM10_av !< PM10
446	!-- In the particle phase:
447	REAL(wp), ALLOCATABLE, DIMENSION(:,:,:), TARGET :: s_BC_av !< black carbon
448	REAL(wp), ALLOCATABLE, DIMENSION(:,:,:), TARGET :: s_DU_av !< dust
449	REAL(wp), ALLOCATABLE, DIMENSION(:,:,:), TARGET :: s_H2O_av !< liquid water
450	REAL(wp), ALLOCATABLE, DIMENSION(:,:,:), TARGET :: s_NH_av !< ammonia
451	REAL(wp), ALLOCATABLE, DIMENSION(:,:,:), TARGET :: s_NO_av !< nitrates
452	REAL(wp), ALLOCATABLE, DIMENSION(:,:,:), TARGET :: s_OC_av !< org. carbon
453	REAL(wp), ALLOCATABLE, DIMENSION(:,:,:), TARGET :: s_SO4_av !< sulphates
454	REAL(wp), ALLOCATABLE, DIMENSION(:,:,:), TARGET :: s_SS_av !< sea salt
455	!-- Bins:
456	REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:), TARGET :: mbins_av !< bin mass
457	REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:), TARGET :: Nbins_av !< bin number
458
459
460	!
461	!-- PALM interfaces:
462	!
463	!-- Boundary conditions:
464	INTERFACE salsa_boundary_conds
465	MODULE PROCEDURE salsa_boundary_conds
466	MODULE PROCEDURE salsa_boundary_conds_decycle
467	END INTERFACE salsa_boundary_conds
468	!
469	!-- Data output checks for 2D/3D data to be done in check_parameters
470	INTERFACE salsa_check_data_output
471	MODULE PROCEDURE salsa_check_data_output
472	END INTERFACE salsa_check_data_output
473
474	!
475	!-- Input parameter checks to be done in check_parameters
476	INTERFACE salsa_check_parameters
477	MODULE PROCEDURE salsa_check_parameters
478	END INTERFACE salsa_check_parameters
479
480	!
481	!-- Averaging of 3D data for output
482	INTERFACE salsa_3d_data_averaging
483	MODULE PROCEDURE salsa_3d_data_averaging
484	END INTERFACE salsa_3d_data_averaging
485
486	!
487	!-- Data output of 2D quantities
488	INTERFACE salsa_data_output_2d
489	MODULE PROCEDURE salsa_data_output_2d
490	END INTERFACE salsa_data_output_2d
491
492	!
493	!-- Data output of 3D data
494	INTERFACE salsa_data_output_3d
495	MODULE PROCEDURE salsa_data_output_3d
496	END INTERFACE salsa_data_output_3d
497
498	!
499	!-- Data output of 3D data
500	INTERFACE salsa_data_output_mask
501	MODULE PROCEDURE salsa_data_output_mask
502	END INTERFACE salsa_data_output_mask
503
504	!
505	!-- Definition of data output quantities
506	INTERFACE salsa_define_netcdf_grid
507	MODULE PROCEDURE salsa_define_netcdf_grid
508	END INTERFACE salsa_define_netcdf_grid
509
510	!
511	!-- Output of information to the header file
512	INTERFACE salsa_header
513	MODULE PROCEDURE salsa_header
514	END INTERFACE salsa_header
515
516	!
517	!-- Initialization actions
518	INTERFACE salsa_init
519	MODULE PROCEDURE salsa_init
520	END INTERFACE salsa_init
521
522	!
523	!-- Initialization of arrays
524	INTERFACE salsa_init_arrays
525	MODULE PROCEDURE salsa_init_arrays
526	END INTERFACE salsa_init_arrays
527
528	!
529	!-- Writing of binary output for restart runs !!! renaming?!
530	INTERFACE salsa_wrd_local
531	MODULE PROCEDURE salsa_wrd_local
532	END INTERFACE salsa_wrd_local
533
534	!
535	!-- Reading of NAMELIST parameters
536	INTERFACE salsa_parin
537	MODULE PROCEDURE salsa_parin
538	END INTERFACE salsa_parin
539
540	!
541	!-- Reading of parameters for restart runs
542	INTERFACE salsa_rrd_local
543	MODULE PROCEDURE salsa_rrd_local
544	END INTERFACE salsa_rrd_local
545
546	!
547	!-- Swapping of time levels (required for prognostic variables)
548	INTERFACE salsa_swap_timelevel
549	MODULE PROCEDURE salsa_swap_timelevel
550	END INTERFACE salsa_swap_timelevel
551
552	INTERFACE salsa_driver
553	MODULE PROCEDURE salsa_driver
554	END INTERFACE salsa_driver
555
556	INTERFACE salsa_tendency
557	MODULE PROCEDURE salsa_tendency
558	MODULE PROCEDURE salsa_tendency_ij
559	END INTERFACE salsa_tendency
560
561
562
563	SAVE
564
565	PRIVATE
566	!
567	!-- Public functions:
568	PUBLIC salsa_boundary_conds, salsa_check_data_output, &
569	salsa_check_parameters, salsa_3d_data_averaging, &
570	salsa_data_output_2d, salsa_data_output_3d, salsa_data_output_mask, &
571	salsa_define_netcdf_grid, salsa_diagnostics, salsa_driver, &
572	salsa_header, salsa_init, salsa_init_arrays, salsa_parin, &
573	salsa_rrd_local, salsa_swap_timelevel, salsa_tendency, &
574	salsa_wrd_local
575	!
576	!-- Public parameters, constants and initial values
577	PUBLIC dots_salsa, dt_salsa, last_salsa_time, lsdepo, salsa, &
578	salsa_gases_from_chem, skip_time_do_salsa
579	!
580	!-- Public prognostic variables
581	PUBLIC aerosol_mass, aerosol_number, fn2a, fn2b, gconc_2, in1a, in2b, &
582	mconc_2, nbins, ncc, ncc_tot, nclim, nconc_2, ngast, prtcl, Ra_dry, &
583	salsa_gas, sedim_vd
584
585
586	CONTAINS
587
588	!------------------------------------------------------------------------------!
589	! Description:
590	! ------------
591	!> Parin for &salsa_par for new modules
592	!------------------------------------------------------------------------------!
593	SUBROUTINE salsa_parin
594
595	IMPLICIT NONE
596
597	CHARACTER (LEN=80) :: line !< dummy string that contains the current line
598	!< of the parameter file
599
600	NAMELIST /salsa_parameters/ &
601	advect_particle_water, & ! Switch for advecting
602	! particle water. If .FALSE.,
603	! equilibration is called at
604	! each time step.
605	bc_salsa_b, & ! bottom boundary condition
606	bc_salsa_t, & ! top boundary condition
607	decycle_lr, & ! decycle SALSA components
608	decycle_method, & ! decycle method applied:
609	! 1=left 2=right 3=south 4=north
610	decycle_ns, & ! decycle SALSA components
611	depo_vege_type, & ! Parametrisation type
612	depo_topo_type, & ! Parametrisation type
613	dpg, & ! Mean diameter for the initial
614	! log-normal modes
615	dt_salsa, & ! SALSA timestep in seconds
616	feedback_to_palm, & ! allow feedback due to
617	! hydration / condensation
618	H2SO4_init, & ! Init value for sulphuric acid
619	HNO3_init, & ! Init value for nitric acid
620	igctyp, & ! Initial gas concentration type
621	isdtyp, & ! Initial size distribution type
622	listspec, & ! List of actived aerosols
623	! (string list)
624	mass_fracs_a, & ! Initial relative contribution
625	! of each species to particle
626	! volume in a-bins, 0 for unused
627	mass_fracs_b, & ! Initial relative contribution
628	! of each species to particle
629	! volume in b-bins, 0 for unused
630	n_lognorm, & ! Number concentration for the
631	! log-normal modes
632	nbin, & ! Number of size bins for
633	! aerosol size subranges 1 & 2
634	nf2a, & ! Number fraction of particles
635	! allocated to a-bins in
636	! subrange 2 b-bins will get
637	! 1-nf2a
638	NH3_init, & ! Init value for ammonia
639	nj3, & ! J3 parametrization
640	! 1 = condensational sink
641	! (Kerminen&Kulmala, 2002)
642	! 2 = coagulational sink
643	! (Lehtinen et al. 2007)
644	! 3 = coagS+self-coagulation
645	! (Anttila et al. 2010)
646	nlcnd, & ! Condensation master switch
647	nlcndgas, & ! Condensation of gases
648	nlcndh2oae, & ! Condensation of H2O
649	nlcoag, & ! Coagulation master switch
650	nldepo, & ! Deposition master switch
651	nldepo_vege, & ! Deposition on vegetation
652	! master switch
653	nldepo_topo, & ! Deposition on topo master
654	! switch
655	nldistupdate, & ! Size distribution update
656	! master switch
657	nsnucl, & ! Nucleation scheme:
658	! 0 = off,
659	! 1 = binary nucleation
660	! 2 = activation type nucleation
661	! 3 = kinetic nucleation
662	! 4 = ternary nucleation
663	! 5 = nucleation with organics
664	! 6 = activation type of
665	! nucleation with H2SO4+ORG
666	! 7 = heteromolecular nucleation
667	! with H2SO4*ORG
668	! 8 = homomolecular nucleation
669	! of H2SO4 + heteromolecular
670	! nucleation with H2SO4*ORG
671	! 9 = homomolecular nucleation
672	! of H2SO4 and ORG + hetero-
673	! molecular nucleation with
674	! H2SO4*ORG
675	OCNV_init, & ! Init value for non-volatile
676	! organic gases
677	OCSV_init, & ! Init value for semi-volatile
678	! organic gases
679	read_restart_data_salsa, & ! read restart data for
680	! salsa
681	reglim, & ! Min&max diameter limits of
682	! size subranges
683	salsa, & ! Master switch for SALSA
684	salsa_source_mode,& ! 'read_from_file' or 'constant'
685	! or 'no_source'
686	sigmag, & ! stdev for the initial log-
687	! normal modes
688	skip_time_do_salsa, & ! Starting time of SALSA (s)
689	van_der_waals_coagc,& ! include van der Waals forces
690	write_binary_salsa ! Write binary for salsa
691
692
693	line = ' '
694
695	!
696	!-- Try to find salsa package
697	REWIND ( 11 )
698	line = ' '
699	DO WHILE ( INDEX( line, '&salsa_parameters' ) == 0 )
700	READ ( 11, '(A)', END=10 ) line
701	ENDDO
702	BACKSPACE ( 11 )
703
704	!
705	!-- Read user-defined namelist
706	READ ( 11, salsa_parameters )
707
708	!
709	!-- Enable salsa (salsa switch in modules.f90)
710	salsa = .TRUE.
711
712	10 CONTINUE
713
714	END SUBROUTINE salsa_parin
715
716
717	!------------------------------------------------------------------------------!
718	! Description:
719	! ------------
720	!> Check parameters routine for salsa.
721	!------------------------------------------------------------------------------!
722	SUBROUTINE salsa_check_parameters
723
724	USE control_parameters, &
725	ONLY: message_string
726
727	IMPLICIT NONE
728
729	!
730	!-- Checks go here (cf. check_parameters.f90).
731	IF ( salsa .AND. .NOT. humidity ) THEN
732	WRITE( message_string, * ) 'salsa = ', salsa, ' is ', &
733	'not allowed with humidity = ', humidity
734	CALL message( 'check_parameters', 'SA0009', 1, 2, 0, 6, 0 )
735	ENDIF
736
737	IF ( bc_salsa_b == 'dirichlet' ) THEN
738	ibc_salsa_b = 0
739	ELSEIF ( bc_salsa_b == 'neumann' ) THEN
740	ibc_salsa_b = 1
741	ELSE
742	message_string = 'unknown boundary condition: bc_salsa_b = "' &
743	// TRIM( bc_salsa_t ) // '"'
744	CALL message( 'check_parameters', 'SA0011', 1, 2, 0, 6, 0 )
745	ENDIF
746
747	IF ( bc_salsa_t == 'dirichlet' ) THEN
748	ibc_salsa_t = 0
749	ELSEIF ( bc_salsa_t == 'neumann' ) THEN
750	ibc_salsa_t = 1
751	ELSE
752	message_string = 'unknown boundary condition: bc_salsa_t = "' &
753	// TRIM( bc_salsa_t ) // '"'
754	CALL message( 'check_parameters', 'SA0012', 1, 2, 0, 6, 0 )
755	ENDIF
756
757	IF ( nj3 < 1 .OR. nj3 > 3 ) THEN
758	message_string = 'unknown nj3 (must be 1-3)'
759	CALL message( 'check_parameters', 'SA0044', 1, 2, 0, 6, 0 )
760	ENDIF
761
762	END SUBROUTINE salsa_check_parameters
763
764	!------------------------------------------------------------------------------!
765	!
766	! Description:
767	! ------------
768	!> Subroutine defining appropriate grid for netcdf variables.
769	!> It is called out from subroutine netcdf.
770	!> Same grid as for other scalars (see netcdf_interface_mod.f90)
771	!------------------------------------------------------------------------------!
772	SUBROUTINE salsa_define_netcdf_grid( var, found, grid_x, grid_y, grid_z )
773
774	IMPLICIT NONE
775
776	CHARACTER (LEN=*), INTENT(OUT) :: grid_x !<
777	CHARACTER (LEN=*), INTENT(OUT) :: grid_y !<
778	CHARACTER (LEN=*), INTENT(OUT) :: grid_z !<
779	CHARACTER (LEN=*), INTENT(IN) :: var !<
780
781	LOGICAL, INTENT(OUT) :: found !<
782
783	found = .TRUE.
784	!
785	!-- Check for the grid
786
787	IF ( var(1:2) == 'g_' ) THEN
788	grid_x = 'x'
789	grid_y = 'y'
790	grid_z = 'zu'
791	ELSEIF ( var(1:4) == 'LDSA' ) THEN
792	grid_x = 'x'
793	grid_y = 'y'
794	grid_z = 'zu'
795	ELSEIF ( var(1:5) == 'm_bin' ) THEN
796	grid_x = 'x'
797	grid_y = 'y'
798	grid_z = 'zu'
799	ELSEIF ( var(1:5) == 'N_bin' ) THEN
800	grid_x = 'x'
801	grid_y = 'y'
802	grid_z = 'zu'
803	ELSEIF ( var(1:4) == 'Ntot' ) THEN
804	grid_x = 'x'
805	grid_y = 'y'
806	grid_z = 'zu'
807	ELSEIF ( var(1:2) == 'PM' ) THEN
808	grid_x = 'x'
809	grid_y = 'y'
810	grid_z = 'zu'
811	ELSEIF ( var(1:2) == 's_' ) THEN
812	grid_x = 'x'
813	grid_y = 'y'
814	grid_z = 'zu'
815	ELSE
816	found = .FALSE.
817	grid_x = 'none'
818	grid_y = 'none'
819	grid_z = 'none'
820	ENDIF
821
822	END SUBROUTINE salsa_define_netcdf_grid
823
824
825	!------------------------------------------------------------------------------!
826	! Description:
827	! ------------
828	!> Header output for new module
829	!------------------------------------------------------------------------------!
830	SUBROUTINE salsa_header( io )
831
832	IMPLICIT NONE
833
834	INTEGER(iwp), INTENT(IN) :: io !< Unit of the output file
835	!
836	!-- Write SALSA header
837	WRITE( io, 1 )
838	WRITE( io, 2 ) skip_time_do_salsa
839	WRITE( io, 3 ) dt_salsa
840	WRITE( io, 12 ) SHAPE( aerosol_number(1)%conc ), nbins
841	IF ( advect_particle_water ) THEN
842	WRITE( io, 16 ) SHAPE( aerosol_mass(1)%conc ), ncc_tot*nbins, &
843	advect_particle_water
844	ELSE
845	WRITE( io, 16 ) SHAPE( aerosol_mass(1)%conc ), ncc*nbins, &
846	advect_particle_water
847	ENDIF
848	IF ( .NOT. salsa_gases_from_chem ) THEN
849	WRITE( io, 17 ) SHAPE( aerosol_mass(1)%conc ), ngast, &
850	salsa_gases_from_chem
851	ENDIF
852	WRITE( io, 4 )
853	IF ( nsnucl > 0 ) THEN
854	WRITE( io, 5 ) nsnucl, nj3
855	ENDIF
856	IF ( nlcoag ) THEN
857	WRITE( io, 6 )
858	ENDIF
859	IF ( nlcnd ) THEN
860	WRITE( io, 7 ) nlcndgas, nlcndh2oae
861	ENDIF
862	IF ( nldepo ) THEN
863	WRITE( io, 14 ) nldepo_vege, nldepo_topo
864	ENDIF
865	WRITE( io, 8 ) reglim, nbin, bin_low_limits
866	WRITE( io, 15 ) nsect
867	WRITE( io, 13 ) ncc, listspec, mass_fracs_a, mass_fracs_b
868	IF ( .NOT. salsa_gases_from_chem ) THEN
869	WRITE( io, 18 ) ngast, H2SO4_init, HNO3_init, NH3_init, OCNV_init, &
870	OCSV_init
871	ENDIF
872	WRITE( io, 9 ) isdtyp, igctyp
873	IF ( isdtyp == 0 ) THEN
874	WRITE( io, 10 ) dpg, sigmag, n_lognorm
875	ELSE
876	WRITE( io, 11 )
877	ENDIF
878
879
880	1 FORMAT (//' SALSA information:'/ &
881	' ------------------------------'/)
882	2 FORMAT (' Starts at: skip_time_do_salsa = ', F10.2, ' s')
883	3 FORMAT (/' Timestep: dt_salsa = ', F6.2, ' s')
884	12 FORMAT (/' Array shape (z,y,x,bins):'/ &
885	' aerosol_number: ', 4(I3))
886	16 FORMAT (/' aerosol_mass: ', 4(I3),/ &
887	' (advect_particle_water = ', L1, ')')
888	17 FORMAT (' salsa_gas: ', 4(I3),/ &
889	' (salsa_gases_from_chem = ', L1, ')')
890	4 FORMAT (/' Aerosol dynamic processes included: ')
891	5 FORMAT (/' nucleation (scheme = ', I1, ' and J3 parametrization = ',&
892	I1, ')')
893	6 FORMAT (/' coagulation')
894	7 FORMAT (/' condensation (of precursor gases = ', L1, &
895	' and water vapour = ', L1, ')' )
896	14 FORMAT (/' dry deposition (on vegetation = ', L1, &
897	' and on topography = ', L1, ')')
898	8 FORMAT (/' Aerosol bin subrange limits (in metres): ', 3(ES10.2E3), / &
899	' Number of size bins for each aerosol subrange: ', 2I3,/ &
900	' Aerosol bin limits (in metres): ', 9(ES10.2E3))
901	15 FORMAT (' Initial number concentration in bins at the lowest level', &
902	' (#/m**3):', 9(ES10.2E3))
903	13 FORMAT (/' Number of chemical components used: ', I1,/ &
904	' Species: ',7(A6),/ &
905	' Initial relative contribution of each species to particle', &
906	' volume in:',/ &
907	' a-bins: ', 7(F6.3),/ &
908	' b-bins: ', 7(F6.3))
909	18 FORMAT (/' Number of gaseous tracers used: ', I1,/ &
910	' Initial gas concentrations:',/ &
911	' H2SO4: ',ES12.4E3, ' #/m**3',/ &
912	' HNO3: ',ES12.4E3, ' #/m**3',/ &
913	' NH3: ',ES12.4E3, ' #/m**3',/ &
914	' OCNV: ',ES12.4E3, ' #/m**3',/ &
915	' OCSV: ',ES12.4E3, ' #/m**3')
916	9 FORMAT (/' Initialising concentrations: ', / &
917	' Aerosol size distribution: isdtyp = ', I1,/ &
918	' Gas concentrations: igctyp = ', I1 )
919	10 FORMAT ( ' Mode diametres: dpg(nmod) = ', 7(F7.3),/ &
920	' Standard deviation: sigmag(nmod) = ', 7(F7.2),/ &
921	' Number concentration: n_lognorm(nmod) = ', 7(ES12.4E3) )
922	11 FORMAT (/' Size distribution read from a file.')
923
924	END SUBROUTINE salsa_header
925
926	!------------------------------------------------------------------------------!
927	! Description:
928	! ------------
929	!> Allocate SALSA arrays and define pointers if required
930	!------------------------------------------------------------------------------!
931	SUBROUTINE salsa_init_arrays
932
933	USE surface_mod, &
934	ONLY: surf_def_h, surf_def_v, surf_lsm_h, surf_lsm_v, surf_usm_h, &
935	surf_usm_v
936
937	IMPLICIT NONE
938
939	INTEGER(iwp) :: gases_available !< Number of available gas components in
940	!< the chemistry model
941	INTEGER(iwp) :: i !< loop index for allocating
942	INTEGER(iwp) :: l !< loop index for allocating: surfaces
943	INTEGER(iwp) :: lsp !< loop index for chem species in the chemistry model
944
945	gases_available = 0
946
947	!
948	!-- Allocate prognostic variables (see salsa_swap_timelevel)
949
950	!
951	!-- Set derived indices:
952	!-- (This does the same as the subroutine salsa_initialize in SALSA/
953	!-- UCLALES-SALSA)
954	in1a = 1 ! 1st index of subrange 1a
955	in2a = in1a + nbin(1) ! 1st index of subrange 2a
956	fn1a = in2a - 1 ! last index of subrange 1a
957	fn2a = fn1a + nbin(2) ! last index of subrange 2a
958
959	!
960	!-- If the fraction of insoluble aerosols in subrange 2 is zero: do not allocate
961	!-- arrays for them
962	IF ( nf2a > 0.999999_wp .AND. SUM( mass_fracs_b ) < 0.00001_wp ) THEN
963	no_insoluble = .TRUE.
964	in2b = fn2a+1 ! 1st index of subrange 2b
965	fn2b = fn2a ! last index of subrange 2b
966	ELSE
967	in2b = in2a + nbin(2) ! 1st index of subrange 2b
968	fn2b = fn2a + nbin(2) ! last index of subrange 2b
969	ENDIF
970
971
972	nbins = fn2b ! total number of aerosol size bins
973	!
974	!-- Create index tables for different aerosol components
975	CALL component_index_constructor( prtcl, ncc, maxspec, listspec )
976
977	ncc_tot = ncc
978	IF ( advect_particle_water ) ncc_tot = ncc + 1 ! Add water
979
980	!
981	!-- Allocate:
982	ALLOCATE( aero(nbins), bin_low_limits(nbins), nsect(nbins), massacc(nbins) )
983	IF ( nldepo ) ALLOCATE( sedim_vd(nzb:nzt+1,nysg:nyng,nxlg:nxrg,nbins) )
984	ALLOCATE( Ra_dry(nzb:nzt+1,nysg:nyng,nxlg:nxrg,nbins) )
985
986	!
987	!-- Aerosol number concentration
988	ALLOCATE( aerosol_number(nbins) )
989	ALLOCATE( nconc_1(nzb:nzt+1,nysg:nyng,nxlg:nxrg,nbins), &
990	nconc_2(nzb:nzt+1,nysg:nyng,nxlg:nxrg,nbins), &
991	nconc_3(nzb:nzt+1,nysg:nyng,nxlg:nxrg,nbins) )
992	nconc_1 = 0.0_wp
993	nconc_2 = 0.0_wp
994	nconc_3 = 0.0_wp
995
996	DO i = 1, nbins
997	aerosol_number(i)%conc(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => nconc_1(:,:,:,i)
998	aerosol_number(i)%conc_p(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => nconc_2(:,:,:,i)
999	aerosol_number(i)%tconc_m(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => nconc_3(:,:,:,i)
1000	ALLOCATE( aerosol_number(i)%flux_s(nzb+1:nzt,0:threads_per_task-1), &
1001	aerosol_number(i)%diss_s(nzb+1:nzt,0:threads_per_task-1), &
1002	aerosol_number(i)%flux_l(nzb+1:nzt,nys:nyn,0:threads_per_task-1),&
1003	aerosol_number(i)%diss_l(nzb+1:nzt,nys:nyn,0:threads_per_task-1),&
1004	aerosol_number(i)%init(nzb:nzt+1), &
1005	aerosol_number(i)%sums_ws_l(nzb:nzt+1,0:threads_per_task-1) )
1006	ENDDO
1007
1008	!
1009	!-- Aerosol mass concentration
1010	ALLOCATE( aerosol_mass(ncc_tot*nbins) )
1011	ALLOCATE( mconc_1(nzb:nzt+1,nysg:nyng,nxlg:nxrg,ncc_tot*nbins), &
1012	mconc_2(nzb:nzt+1,nysg:nyng,nxlg:nxrg,ncc_tot*nbins), &
1013	mconc_3(nzb:nzt+1,nysg:nyng,nxlg:nxrg,ncc_tot*nbins) )
1014	mconc_1 = 0.0_wp
1015	mconc_2 = 0.0_wp
1016	mconc_3 = 0.0_wp
1017
1018	DO i = 1, ncc_tot*nbins
1019	aerosol_mass(i)%conc(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => mconc_1(:,:,:,i)
1020	aerosol_mass(i)%conc_p(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => mconc_2(:,:,:,i)
1021	aerosol_mass(i)%tconc_m(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => mconc_3(:,:,:,i)
1022	ALLOCATE( aerosol_mass(i)%flux_s(nzb+1:nzt,0:threads_per_task-1), &
1023	aerosol_mass(i)%diss_s(nzb+1:nzt,0:threads_per_task-1), &
1024	aerosol_mass(i)%flux_l(nzb+1:nzt,nys:nyn,0:threads_per_task-1),&
1025	aerosol_mass(i)%diss_l(nzb+1:nzt,nys:nyn,0:threads_per_task-1),&
1026	aerosol_mass(i)%init(nzb:nzt+1), &
1027	aerosol_mass(i)%sums_ws_l(nzb:nzt+1,0:threads_per_task-1) )
1028	ENDDO
1029
1030	!
1031	!-- Surface fluxes: answs = aerosol number, amsws = aerosol mass
1032	!
1033	!-- Horizontal surfaces: default type
1034	DO l = 0, 2 ! upward (l=0), downward (l=1) and model top (l=2)
1035	ALLOCATE( surf_def_h(l)%answs( 1:surf_def_h(l)%ns, nbins ) )
1036	ALLOCATE( surf_def_h(l)%amsws( 1:surf_def_h(l)%ns, nbins*ncc_tot ) )
1037	surf_def_h(l)%answs = 0.0_wp
1038	surf_def_h(l)%amsws = 0.0_wp
1039	ENDDO
1040	!-- Horizontal surfaces: natural type
1041	IF ( land_surface ) THEN
1042	ALLOCATE( surf_lsm_h%answs( 1:surf_lsm_h%ns, nbins ) )
1043	ALLOCATE( surf_lsm_h%amsws( 1:surf_lsm_h%ns, nbins*ncc_tot ) )
1044	surf_lsm_h%answs = 0.0_wp
1045	surf_lsm_h%amsws = 0.0_wp
1046	ENDIF
1047	!-- Horizontal surfaces: urban type
1048	IF ( urban_surface ) THEN
1049	ALLOCATE( surf_usm_h%answs( 1:surf_usm_h%ns, nbins ) )
1050	ALLOCATE( surf_usm_h%amsws( 1:surf_usm_h%ns, nbins*ncc_tot ) )
1051	surf_usm_h%answs = 0.0_wp
1052	surf_usm_h%amsws = 0.0_wp
1053	ENDIF
1054	!
1055	!-- Vertical surfaces: northward (l=0), southward (l=1), eastward (l=2) and
1056	!-- westward (l=3) facing
1057	DO l = 0, 3
1058	ALLOCATE( surf_def_v(l)%answs( 1:surf_def_v(l)%ns, nbins ) )
1059	surf_def_v(l)%answs = 0.0_wp
1060	ALLOCATE( surf_def_v(l)%amsws( 1:surf_def_v(l)%ns, nbins*ncc_tot ) )
1061	surf_def_v(l)%amsws = 0.0_wp
1062
1063	IF ( land_surface) THEN
1064	ALLOCATE( surf_lsm_v(l)%answs( 1:surf_lsm_v(l)%ns, nbins ) )
1065	surf_lsm_v(l)%answs = 0.0_wp
1066	ALLOCATE( surf_lsm_v(l)%amsws( 1:surf_lsm_v(l)%ns, nbins*ncc_tot ) )
1067	surf_lsm_v(l)%amsws = 0.0_wp
1068	ENDIF
1069
1070	IF ( urban_surface ) THEN
1071	ALLOCATE( surf_usm_v(l)%answs( 1:surf_usm_v(l)%ns, nbins ) )
1072	surf_usm_v(l)%answs = 0.0_wp
1073	ALLOCATE( surf_usm_v(l)%amsws( 1:surf_usm_v(l)%ns, nbins*ncc_tot ) )
1074	surf_usm_v(l)%amsws = 0.0_wp
1075	ENDIF
1076	ENDDO
1077
1078	!
1079	!-- Concentration of gaseous tracers (1. SO4, 2. HNO3, 3. NH3, 4. OCNV, 5. OCSV)
1080	!-- (number concentration (#/m3) )
1081	!
1082	!-- If chemistry is on, read gas phase concentrations from there. Otherwise,
1083	!-- allocate salsa_gas array.
1084
1085	IF ( air_chemistry ) THEN
1086	DO lsp = 1, nvar
1087	IF ( TRIM( chem_species(lsp)%name ) == 'H2SO4' ) THEN
1088	gases_available = gases_available + 1
1089	gas_index_chem(1) = lsp
1090	ELSEIF ( TRIM( chem_species(lsp)%name ) == 'HNO3' ) THEN
1091	gases_available = gases_available + 1
1092	gas_index_chem(2) = lsp
1093	ELSEIF ( TRIM( chem_species(lsp)%name ) == 'NH3' ) THEN
1094	gases_available = gases_available + 1
1095	gas_index_chem(3) = lsp
1096	ELSEIF ( TRIM( chem_species(lsp)%name ) == 'OCNV' ) THEN
1097	gases_available = gases_available + 1
1098	gas_index_chem(4) = lsp
1099	ELSEIF ( TRIM( chem_species(lsp)%name ) == 'OCSV' ) THEN
1100	gases_available = gases_available + 1
1101	gas_index_chem(5) = lsp
1102	ENDIF
1103	ENDDO
1104
1105	IF ( gases_available == ngast ) THEN
1106	salsa_gases_from_chem = .TRUE.
1107	ELSE
1108	WRITE( message_string, * ) 'SALSA is run together with chemistry '// &
1109	'but not all gaseous components are '// &
1110	'provided by kpp (H2SO4, HNO3, NH3, '// &
1111	'OCNV, OCSC)'
1112	CALL message( 'check_parameters', 'SA0024', 1, 2, 0, 6, 0 )
1113	ENDIF
1114
1115	ELSE
1116
1117	ALLOCATE( salsa_gas(ngast) )
1118	ALLOCATE( gconc_1(nzb:nzt+1,nysg:nyng,nxlg:nxrg,ngast), &
1119	gconc_2(nzb:nzt+1,nysg:nyng,nxlg:nxrg,ngast), &
1120	gconc_3(nzb:nzt+1,nysg:nyng,nxlg:nxrg,ngast) )
1121	gconc_1 = 0.0_wp
1122	gconc_2 = 0.0_wp
1123	gconc_3 = 0.0_wp
1124
1125	DO i = 1, ngast
1126	salsa_gas(i)%conc(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => gconc_1(:,:,:,i)
1127	salsa_gas(i)%conc_p(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => gconc_2(:,:,:,i)
1128	salsa_gas(i)%tconc_m(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => gconc_3(:,:,:,i)
1129	ALLOCATE( salsa_gas(i)%flux_s(nzb+1:nzt,0:threads_per_task-1), &
1130	salsa_gas(i)%diss_s(nzb+1:nzt,0:threads_per_task-1), &
1131	salsa_gas(i)%flux_l(nzb+1:nzt,nys:nyn,0:threads_per_task-1),&
1132	salsa_gas(i)%diss_l(nzb+1:nzt,nys:nyn,0:threads_per_task-1),&
1133	salsa_gas(i)%init(nzb:nzt+1), &
1134	salsa_gas(i)%sums_ws_l(nzb:nzt+1,0:threads_per_task-1) )
1135	ENDDO
1136	!
1137	!-- Surface fluxes: gtsws = gaseous tracer flux
1138	!
1139	!-- Horizontal surfaces: default type
1140	DO l = 0, 2 ! upward (l=0), downward (l=1) and model top (l=2)
1141	ALLOCATE( surf_def_h(l)%gtsws( 1:surf_def_h(l)%ns, ngast ) )
1142	surf_def_h(l)%gtsws = 0.0_wp
1143	ENDDO
1144	!-- Horizontal surfaces: natural type
1145	IF ( land_surface ) THEN
1146	ALLOCATE( surf_lsm_h%gtsws( 1:surf_lsm_h%ns, ngast ) )
1147	surf_lsm_h%gtsws = 0.0_wp
1148	ENDIF
1149	!-- Horizontal surfaces: urban type
1150	IF ( urban_surface ) THEN
1151	ALLOCATE( surf_usm_h%gtsws( 1:surf_usm_h%ns, ngast ) )
1152	surf_usm_h%gtsws = 0.0_wp
1153	ENDIF
1154	!
1155	!-- Vertical surfaces: northward (l=0), southward (l=1), eastward (l=2) and
1156	!-- westward (l=3) facing
1157	DO l = 0, 3
1158	ALLOCATE( surf_def_v(l)%gtsws( 1:surf_def_v(l)%ns, ngast ) )
1159	surf_def_v(l)%gtsws = 0.0_wp
1160	IF ( land_surface ) THEN
1161	ALLOCATE( surf_lsm_v(l)%gtsws( 1:surf_lsm_v(l)%ns, ngast ) )
1162	surf_lsm_v(l)%gtsws = 0.0_wp
1163	ENDIF
1164	IF ( urban_surface ) THEN
1165	ALLOCATE( surf_usm_v(l)%gtsws( 1:surf_usm_v(l)%ns, ngast ) )
1166	surf_usm_v(l)%gtsws = 0.0_wp
1167	ENDIF
1168	ENDDO
1169	ENDIF
1170
1171	END SUBROUTINE salsa_init_arrays
1172
1173	!------------------------------------------------------------------------------!
1174	! Description:
1175	! ------------
1176	!> Initialization of SALSA. Based on salsa_initialize in UCLALES-SALSA.
1177	!> Subroutines salsa_initialize, SALSAinit and DiagInitAero in UCLALES-SALSA are
1178	!> also merged here.
1179	!------------------------------------------------------------------------------!
1180	SUBROUTINE salsa_init
1181
1182	IMPLICIT NONE
1183
1184	INTEGER(iwp) :: b
1185	INTEGER(iwp) :: c
1186	INTEGER(iwp) :: g
1187	INTEGER(iwp) :: i
1188	INTEGER(iwp) :: j
1189
1190	CALL location_message( 'initializing SALSA model', .TRUE. )
1191
1192	bin_low_limits = 0.0_wp
1193	nsect = 0.0_wp
1194	massacc = 1.0_wp
1195
1196	!
1197	!-- Indices for chemical components used (-1 = not used)
1198	i = 0
1199	IF ( is_used( prtcl, 'SO4' ) ) THEN
1200	iso4 = get_index( prtcl,'SO4' )
1201	i = i + 1
1202	ENDIF
1203	IF ( is_used( prtcl,'OC' ) ) THEN
1204	ioc = get_index(prtcl, 'OC')
1205	i = i + 1
1206	ENDIF
1207	IF ( is_used( prtcl, 'BC' ) ) THEN
1208	ibc = get_index( prtcl, 'BC' )
1209	i = i + 1
1210	ENDIF
1211	IF ( is_used( prtcl, 'DU' ) ) THEN
1212	idu = get_index( prtcl, 'DU' )
1213	i = i + 1
1214	ENDIF
1215	IF ( is_used( prtcl, 'SS' ) ) THEN
1216	iss = get_index( prtcl, 'SS' )
1217	i = i + 1
1218	ENDIF
1219	IF ( is_used( prtcl, 'NO' ) ) THEN
1220	ino = get_index( prtcl, 'NO' )
1221	i = i + 1
1222	ENDIF
1223	IF ( is_used( prtcl, 'NH' ) ) THEN
1224	inh = get_index( prtcl, 'NH' )
1225	i = i + 1
1226	ENDIF
1227	!
1228	!-- All species must be known
1229	IF ( i /= ncc ) THEN
1230	message_string = 'Unknown aerosol species/component(s) given in the' // &
1231	' initialization'
1232	CALL message( 'salsa_mod: salsa_init', 'SA0020', 1, 2, 0, 6, 0 )
1233	ENDIF
1234
1235	!
1236	!-- Initialise
1237	!
1238	!-- Aerosol size distribution (TYPE t_section)
1239	aero(:)%dwet = 1.0E-10_wp
1240	aero(:)%veqh2o = 1.0E-10_wp
1241	aero(:)%numc = nclim
1242	aero(:)%core = 1.0E-10_wp
1243	DO c = 1, maxspec+1 ! 1:SO4, 2:OC, 3:BC, 4:DU, 5:SS, 6:NO, 7:NH, 8:H2O
1244	aero(:)%volc(c) = 0.0_wp
1245	ENDDO
1246
1247	IF ( nldepo ) sedim_vd = 0.0_wp
1248
1249	DO b = 1, nbins
1250	IF ( .NOT. read_restart_data_salsa ) aerosol_number(b)%conc = nclim
1251	aerosol_number(b)%conc_p = 0.0_wp
1252	aerosol_number(b)%tconc_m = 0.0_wp
1253	aerosol_number(b)%flux_s = 0.0_wp
1254	aerosol_number(b)%diss_s = 0.0_wp
1255	aerosol_number(b)%flux_l = 0.0_wp
1256	aerosol_number(b)%diss_l = 0.0_wp
1257	aerosol_number(b)%init = nclim
1258	aerosol_number(b)%sums_ws_l = 0.0_wp
1259	ENDDO
1260	DO c = 1, ncc_tot*nbins
1261	IF ( .NOT. read_restart_data_salsa ) aerosol_mass(c)%conc = mclim
1262	aerosol_mass(c)%conc_p = 0.0_wp
1263	aerosol_mass(c)%tconc_m = 0.0_wp
1264	aerosol_mass(c)%flux_s = 0.0_wp
1265	aerosol_mass(c)%diss_s = 0.0_wp
1266	aerosol_mass(c)%flux_l = 0.0_wp
1267	aerosol_mass(c)%diss_l = 0.0_wp
1268	aerosol_mass(c)%init = mclim
1269	aerosol_mass(c)%sums_ws_l = 0.0_wp
1270	ENDDO
1271
1272	IF ( .NOT. salsa_gases_from_chem ) THEN
1273	DO g = 1, ngast
1274	salsa_gas(g)%conc_p = 0.0_wp
1275	salsa_gas(g)%tconc_m = 0.0_wp
1276	salsa_gas(g)%flux_s = 0.0_wp
1277	salsa_gas(g)%diss_s = 0.0_wp
1278	salsa_gas(g)%flux_l = 0.0_wp
1279	salsa_gas(g)%diss_l = 0.0_wp
1280	salsa_gas(g)%sums_ws_l = 0.0_wp
1281	ENDDO
1282	IF ( .NOT. read_restart_data_salsa ) THEN
1283	salsa_gas(1)%conc = H2SO4_init
1284	salsa_gas(2)%conc = HNO3_init
1285	salsa_gas(3)%conc = NH3_init
1286	salsa_gas(4)%conc = OCNV_init
1287	salsa_gas(5)%conc = OCSV_init
1288	ENDIF
1289	!
1290	!-- Set initial value for gas compound tracers and initial values
1291	salsa_gas(1)%init = H2SO4_init
1292	salsa_gas(2)%init = HNO3_init
1293	salsa_gas(3)%init = NH3_init
1294	salsa_gas(4)%init = OCNV_init
1295	salsa_gas(5)%init = OCSV_init
1296	ENDIF
1297	!
1298	!-- Aerosol radius in each bin: dry and wet (m)
1299	Ra_dry = 1.0E-10_wp
1300	!
1301	!-- Initialise aerosol tracers
1302	aero(:)%vhilim = 0.0_wp
1303	aero(:)%vlolim = 0.0_wp
1304	aero(:)%vratiohi = 0.0_wp
1305	aero(:)%vratiolo = 0.0_wp
1306	aero(:)%dmid = 0.0_wp
1307	!
1308	!-- Initialise the sectional particle size distribution
1309	CALL set_sizebins()
1310	!
1311	!-- Initialise location-dependent aerosol size distributions and
1312	!-- chemical compositions:
1313	CALL aerosol_init
1314	!
1315	!-- Initalisation run of SALSA
1316	DO i = nxl, nxr
1317	DO j = nys, nyn
1318	CALL salsa_driver( i, j, 1 )
1319	CALL salsa_diagnostics( i, j )
1320	ENDDO
1321	ENDDO
1322	!
1323	!-- Set the aerosol and gas sources
1324	IF ( salsa_source_mode == 'read_from_file' ) THEN
1325	CALL salsa_set_source
1326	ENDIF
1327
1328	CALL location_message( 'finished', .TRUE. )
1329
1330	END SUBROUTINE salsa_init
1331
1332	!------------------------------------------------------------------------------!
1333	! Description:
1334	! ------------
1335	!> Initializes particle size distribution grid by calculating size bin limits
1336	!> and mid-size for dry particles in each bin. Called from salsa_initialize
1337	!> (only at the beginning of simulation).
1338	!> Size distribution described using:
1339	!> 1) moving center method (subranges 1 and 2)
1340	!> (Jacobson, Atmos. Env., 31, 131-144, 1997)
1341	!> 2) fixed sectional method (subrange 3)
1342	!> Size bins in each subrange are spaced logarithmically
1343	!> based on given subrange size limits and bin number.
1344	!
1345	!> Mona changed 06/2017: Use geometric mean diameter to describe the mean
1346	!> particle diameter in a size bin, not the arithmeric mean which clearly
1347	!> overestimates the total particle volume concentration.
1348	!
1349	!> Coded by:
1350	!> Hannele Korhonen (FMI) 2005
1351	!> Harri Kokkola (FMI) 2006
1352	!
1353	!> Bug fixes for box model + updated for the new aerosol datatype:
1354	!> Juha Tonttila (FMI) 2014
1355	!------------------------------------------------------------------------------!
1356	SUBROUTINE set_sizebins
1357
1358	IMPLICIT NONE
1359	!
1360	!-- Local variables
1361	INTEGER(iwp) :: cc
1362	INTEGER(iwp) :: dd
1363	REAL(wp) :: ratio_d !< ratio of the upper and lower diameter of subranges
1364	!
1365	!-- vlolim&vhilim: min & max dry volumes [fxm]
1366	!-- dmid: bin mid dry diameter (m)
1367	!-- vratiolo&vratiohi: volume ratio between the center and low/high limit
1368	!
1369	!-- 1) Size subrange 1:
1370	ratio_d = reglim(2) / reglim(1) ! section spacing (m)
1371	DO cc = in1a,fn1a
1372	aero(cc)%vlolim = api6 * ( reglim(1) * ratio_d ** &
1373	( REAL( cc-1 ) / nbin(1) ) ) ** 3.0_wp
1374	aero(cc)%vhilim = api6 * ( reglim(1) * ratio_d ** &
1375	( REAL( cc ) / nbin(1) ) ) ** 3.0_wp
1376	aero(cc)%dmid = SQRT( ( aero(cc)%vhilim / api6 ) ** ( 1.0_wp / 3.0_wp ) &
1377	* ( aero(cc)%vlolim / api6 ) ** ( 1.0_wp / 3.0_wp ) )
1378	aero(cc)%vratiohi = aero(cc)%vhilim / ( api6 * aero(cc)%dmid ** 3.0_wp )
1379	aero(cc)%vratiolo = aero(cc)%vlolim / ( api6 * aero(cc)%dmid ** 3.0_wp )
1380	ENDDO
1381	!
1382	!-- 2) Size subrange 2:
1383	!-- 2.1) Sub-subrange 2a: high hygroscopicity
1384	ratio_d = reglim(3) / reglim(2) ! section spacing
1385	DO dd = in2a, fn2a
1386	cc = dd - in2a
1387	aero(dd)%vlolim = api6 * ( reglim(2) * ratio_d ** &
1388	( REAL( cc ) / nbin(2) ) ) ** 3.0_wp
1389	aero(dd)%vhilim = api6 * ( reglim(2) * ratio_d ** &
1390	( REAL( cc+1 ) / nbin(2) ) ) ** 3.0_wp
1391	aero(dd)%dmid = SQRT( ( aero(dd)%vhilim / api6 ) ** ( 1.0_wp / 3.0_wp ) &
1392	* ( aero(dd)%vlolim / api6 ) ** ( 1.0_wp / 3.0_wp ) )
1393	aero(dd)%vratiohi = aero(dd)%vhilim / ( api6 * aero(dd)%dmid ** 3.0_wp )
1394	aero(dd)%vratiolo = aero(dd)%vlolim / ( api6 * aero(dd)%dmid ** 3.0_wp )
1395	ENDDO
1396	!
1397	!-- 2.2) Sub-subrange 2b: low hygroscopicity
1398	IF ( .NOT. no_insoluble ) THEN
1399	aero(in2b:fn2b)%vlolim = aero(in2a:fn2a)%vlolim
1400	aero(in2b:fn2b)%vhilim = aero(in2a:fn2a)%vhilim
1401	aero(in2b:fn2b)%dmid = aero(in2a:fn2a)%dmid
1402	aero(in2b:fn2b)%vratiohi = aero(in2a:fn2a)%vratiohi
1403	aero(in2b:fn2b)%vratiolo = aero(in2a:fn2a)%vratiolo
1404	ENDIF
1405	!
1406	!-- Initialize the wet diameter with the bin dry diameter to avoid numerical
1407	!-- problems later
1408	aero(:)%dwet = aero(:)%dmid
1409	!
1410	!-- Save bin limits (lower diameter) to be delivered to the host model if needed
1411	DO cc = 1, nbins
1412	bin_low_limits(cc) = ( aero(cc)%vlolim / api6 )**( 1.0_wp / 3.0_wp )
1413	ENDDO
1414
1415	END SUBROUTINE set_sizebins
1416
1417	!------------------------------------------------------------------------------!
1418	! Description:
1419	! ------------
1420	!> Initilize altitude-dependent aerosol size distributions and compositions.
1421	!>
1422	!> Mona added 06/2017: Correct the number and mass concentrations by normalizing
1423	!< by the given total number and mass concentration.
1424	!>
1425	!> Tomi Raatikainen, FMI, 29.2.2016
1426	!------------------------------------------------------------------------------!
1427	SUBROUTINE aerosol_init
1428
1429	USE arrays_3d, &
1430	ONLY: zu
1431
1432	! USE NETCDF
1433
1434	USE netcdf_data_input_mod, &
1435	ONLY: get_attribute, get_variable, &
1436	netcdf_data_input_get_dimension_length, open_read_file
1437
1438	IMPLICIT NONE
1439
1440	INTEGER(iwp) :: b !< loop index: size bins
1441	INTEGER(iwp) :: c !< loop index: chemical components
1442	INTEGER(iwp) :: ee !< index: end
1443	INTEGER(iwp) :: g !< loop index: gases
1444	INTEGER(iwp) :: i !< loop index: x-direction
1445	INTEGER(iwp) :: id_faero !< NetCDF id of PIDS_SALSA
1446	INTEGER(iwp) :: id_fchem !< NetCDF id of PIDS_CHEM
1447	INTEGER(iwp) :: j !< loop index: y-direction
1448	INTEGER(iwp) :: k !< loop index: z-direction
1449	INTEGER(iwp) :: kk !< loop index: z-direction
1450	INTEGER(iwp) :: nz_file !< Number of grid-points in file (heights)
1451	INTEGER(iwp) :: prunmode
1452	INTEGER(iwp) :: ss !< index: start
1453	LOGICAL :: netcdf_extend = .FALSE. !< Flag indicating wether netcdf
1454	!< topography input file or not
1455	REAL(wp), DIMENSION(nbins) :: core !< size of the bin mid aerosol particle,
1456	REAL(wp) :: flag !< flag to mask topography grid points
1457	REAL(wp), DIMENSION(:,:), ALLOCATABLE :: pr_gas !< gas profiles
1458	REAL(wp), DIMENSION(:,:), ALLOCATABLE :: pr_mass_fracs_a !< mass fraction
1459	!< profiles: a
1460	REAL(wp), DIMENSION(:,:), ALLOCATABLE :: pr_mass_fracs_b !< and b
1461	REAL(wp), DIMENSION(:,:), ALLOCATABLE :: pr_nsect !< sectional size
1462	!< distribution profile
1463	REAL(wp), DIMENSION(nbins) :: nsect !< size distribution (#/m3)
1464	REAL(wp), DIMENSION(0:nz+1,nbins) :: pndist !< size dist as a function
1465	!< of height (#/m3)
1466	REAL(wp), DIMENSION(0:nz+1) :: pnf2a !< number fraction: bins 2a
1467	REAL(wp), DIMENSION(0:nz+1,maxspec) :: pvf2a !< mass distributions of
1468	!< aerosol species for a
1469	REAL(wp), DIMENSION(0:nz+1,maxspec) :: pvf2b !< and b-bins
1470	REAL(wp), DIMENSION(0:nz+1) :: pvfOC1a !< mass fraction between
1471	!< SO4 and OC in 1a
1472	REAL(wp), DIMENSION(:), ALLOCATABLE :: pr_z
1473
1474	prunmode = 1
1475	!
1476	!-- Bin mean aerosol particle volume (m3)
1477	core(:) = 0.0_wp
1478	core(1:nbins) = api6 * aero(1:nbins)%dmid ** 3.0_wp
1479	!
1480	!-- Set concentrations to zero
1481	nsect(:) = 0.0_wp
1482	pndist(:,:) = 0.0_wp
1483	pnf2a(:) = nf2a
1484	pvf2a(:,:) = 0.0_wp
1485	pvf2b(:,:) = 0.0_wp
1486	pvfOC1a(:) = 0.0_wp
1487
1488	IF ( isdtyp == 1 ) THEN
1489	!
1490	!-- Read input profiles from PIDS_SALSA
1491	#if defined( __netcdf )
1492	!
1493	!-- Location-dependent size distributions and compositions.
1494	INQUIRE( FILE='PIDS_SALSA'// TRIM( coupling_char ), EXIST=netcdf_extend )
1495	IF ( netcdf_extend ) THEN
1496	!
1497	!-- Open file in read-only mode
1498	CALL open_read_file( 'PIDS_SALSA' // TRIM( coupling_char ), id_faero )
1499	!
1500	!-- Input heights
1501	CALL netcdf_data_input_get_dimension_length( id_faero, nz_file, &
1502	"profile_z" )
1503
1504	ALLOCATE( pr_z(nz_file), pr_mass_fracs_a(maxspec,nz_file), &
1505	pr_mass_fracs_b(maxspec,nz_file), pr_nsect(nbins,nz_file) )
1506	CALL get_variable( id_faero, 'profile_z', pr_z )
1507	!
1508	!-- Mass fracs profile: 1: H2SO4 (sulphuric acid), 2: OC (organic carbon),
1509	!-- 3: BC (black carbon), 4: DU (dust),
1510	!-- 5: SS (sea salt), 6: HNO3 (nitric acid),
1511	!-- 7: NH3 (ammonia)
1512	CALL get_variable( id_faero, "profile_mass_fracs_a", pr_mass_fracs_a,&
1513	0, nz_file-1, 0, maxspec-1 )
1514	CALL get_variable( id_faero, "profile_mass_fracs_b", pr_mass_fracs_b,&
1515	0, nz_file-1, 0, maxspec-1 )
1516	CALL get_variable( id_faero, "profile_nsect", pr_nsect, 0, nz_file-1,&
1517	0, nbins-1 )
1518
1519	kk = 1
1520	DO k = nzb, nz+1
1521	IF ( kk < nz_file ) THEN
1522	DO WHILE ( pr_z(kk+1) <= zu(k) )
1523	kk = kk + 1
1524	IF ( kk == nz_file ) EXIT
1525	ENDDO
1526	ENDIF
1527	IF ( kk < nz_file ) THEN
1528	!
1529	!-- Set initial value for gas compound tracers and initial values
1530	pvf2a(k,:) = pr_mass_fracs_a(:,kk) + ( zu(k) - pr_z(kk) ) / ( &
1531	pr_z(kk+1) - pr_z(kk) ) * ( pr_mass_fracs_a(:,kk+1)&
1532	- pr_mass_fracs_a(:,kk) )
1533	pvf2b(k,:) = pr_mass_fracs_b(:,kk) + ( zu(k) - pr_z(kk) ) / ( &
1534	pr_z(kk+1) - pr_z(kk) ) * ( pr_mass_fracs_b(:,kk+1)&
1535	- pr_mass_fracs_b(:,kk) )
1536	pndist(k,:) = pr_nsect(:,kk) + ( zu(k) - pr_z(kk) ) / ( &
1537	pr_z(kk+1) - pr_z(kk) ) * ( pr_nsect(:,kk+1) - &
1538	pr_nsect(:,kk) )
1539	ELSE
1540	pvf2a(k,:) = pr_mass_fracs_a(:,kk)
1541	pvf2b(k,:) = pr_mass_fracs_b(:,kk)
1542	pndist(k,:) = pr_nsect(:,kk)
1543	ENDIF
1544	IF ( iso4 < 0 ) THEN
1545	pvf2a(k,1) = 0.0_wp
1546	pvf2b(k,1) = 0.0_wp
1547	ENDIF
1548	IF ( ioc < 0 ) THEN
1549	pvf2a(k,2) = 0.0_wp
1550	pvf2b(k,2) = 0.0_wp
1551	ENDIF
1552	IF ( ibc < 0 ) THEN
1553	pvf2a(k,3) = 0.0_wp
1554	pvf2b(k,3) = 0.0_wp
1555	ENDIF
1556	IF ( idu < 0 ) THEN
1557	pvf2a(k,4) = 0.0_wp
1558	pvf2b(k,4) = 0.0_wp
1559	ENDIF
1560	IF ( iss < 0 ) THEN
1561	pvf2a(k,5) = 0.0_wp
1562	pvf2b(k,5) = 0.0_wp
1563	ENDIF
1564	IF ( ino < 0 ) THEN
1565	pvf2a(k,6) = 0.0_wp
1566	pvf2b(k,6) = 0.0_wp
1567	ENDIF
1568	IF ( inh < 0 ) THEN
1569	pvf2a(k,7) = 0.0_wp
1570	pvf2b(k,7) = 0.0_wp
1571	ENDIF
1572	!
1573	!-- Then normalise the mass fraction so that SUM = 1
1574	pvf2a(k,:) = pvf2a(k,:) / SUM( pvf2a(k,:) )
1575	IF ( SUM( pvf2b(k,:) ) > 0.0_wp ) pvf2b(k,:) = pvf2b(k,:) / &
1576	SUM( pvf2b(k,:) )
1577	ENDDO
1578	DEALLOCATE( pr_z, pr_mass_fracs_a, pr_mass_fracs_b, pr_nsect )
1579	ELSE
1580	message_string = 'Input file '// TRIM( 'PIDS_SALSA' ) // &
1581	TRIM( coupling_char ) // ' for SALSA missing!'
1582	CALL message( 'salsa_mod: aerosol_init', 'SA0032', 1, 2, 0, 6, 0 )
1583	ENDIF ! netcdf_extend
1584	#endif
1585
1586	ELSEIF ( isdtyp == 0 ) THEN
1587	!
1588	!-- Mass fractions for species in a and b-bins
1589	IF ( iso4 > 0 ) THEN
1590	pvf2a(:,1) = mass_fracs_a(iso4)
1591	pvf2b(:,1) = mass_fracs_b(iso4)
1592	ENDIF
1593	IF ( ioc > 0 ) THEN
1594	pvf2a(:,2) = mass_fracs_a(ioc)
1595	pvf2b(:,2) = mass_fracs_b(ioc)
1596	ENDIF
1597	IF ( ibc > 0 ) THEN
1598	pvf2a(:,3) = mass_fracs_a(ibc)
1599	pvf2b(:,3) = mass_fracs_b(ibc)
1600	ENDIF
1601	IF ( idu > 0 ) THEN
1602	pvf2a(:,4) = mass_fracs_a(idu)
1603	pvf2b(:,4) = mass_fracs_b(idu)
1604	ENDIF
1605	IF ( iss > 0 ) THEN
1606	pvf2a(:,5) = mass_fracs_a(iss)
1607	pvf2b(:,5) = mass_fracs_b(iss)
1608	ENDIF
1609	IF ( ino > 0 ) THEN
1610	pvf2a(:,6) = mass_fracs_a(ino)
1611	pvf2b(:,6) = mass_fracs_b(ino)
1612	ENDIF
1613	IF ( inh > 0 ) THEN
1614	pvf2a(:,7) = mass_fracs_a(inh)
1615	pvf2b(:,7) = mass_fracs_b(inh)
1616	ENDIF
1617	DO k = nzb, nz+1
1618	pvf2a(k,:) = pvf2a(k,:) / SUM( pvf2a(k,:) )
1619	IF ( SUM( pvf2b(k,:) ) > 0.0_wp ) pvf2b(k,:) = pvf2b(k,:) / &
1620	SUM( pvf2b(k,:) )
1621	ENDDO
1622
1623	CALL size_distribution( n_lognorm, dpg, sigmag, nsect )
1624	!
1625	!-- Normalize by the given total number concentration
1626	nsect = nsect * SUM( n_lognorm ) * 1.0E+6_wp / SUM( nsect )
1627	DO b = in1a, fn2b
1628	pndist(:,b) = nsect(b)
1629	ENDDO
1630	ENDIF
1631
1632	IF ( igctyp == 1 ) THEN
1633	!
1634	!-- Read input profiles from PIDS_CHEM
1635	#if defined( __netcdf )
1636	!
1637	!-- Location-dependent size distributions and compositions.
1638	INQUIRE( FILE='PIDS_CHEM' // TRIM( coupling_char ), EXIST=netcdf_extend )
1639	IF ( netcdf_extend .AND. .NOT. salsa_gases_from_chem ) THEN
1640	!
1641	!-- Open file in read-only mode
1642	CALL open_read_file( 'PIDS_CHEM' // TRIM( coupling_char ), id_fchem )
1643	!
1644	!-- Input heights
1645	CALL netcdf_data_input_get_dimension_length( id_fchem, nz_file, &
1646	"profile_z" )
1647	ALLOCATE( pr_z(nz_file), pr_gas(ngast,nz_file) )
1648	CALL get_variable( id_fchem, 'profile_z', pr_z )
1649	!
1650	!-- Gases:
1651	CALL get_variable( id_fchem, "profile_H2SO4", pr_gas(1,:) )
1652	CALL get_variable( id_fchem, "profile_HNO3", pr_gas(2,:) )
1653	CALL get_variable( id_fchem, "profile_NH3", pr_gas(3,:) )
1654	CALL get_variable( id_fchem, "profile_OCNV", pr_gas(4,:) )
1655	CALL get_variable( id_fchem, "profile_OCSV", pr_gas(5,:) )
1656
1657	kk = 1
1658	DO k = nzb, nz+1
1659	IF ( kk < nz_file ) THEN
1660	DO WHILE ( pr_z(kk+1) <= zu(k) )
1661	kk = kk + 1
1662	IF ( kk == nz_file ) EXIT
1663	ENDDO
1664	ENDIF
1665	IF ( kk < nz_file ) THEN
1666	!
1667	!-- Set initial value for gas compound tracers and initial values
1668	DO g = 1, ngast
1669	salsa_gas(g)%init(k) = pr_gas(g,kk) + ( zu(k) - pr_z(kk) ) &
1670	/ ( pr_z(kk+1) - pr_z(kk) ) * &
1671	( pr_gas(g,kk+1) - pr_gas(g,kk) )
1672	salsa_gas(g)%conc(k,:,:) = salsa_gas(g)%init(k)
1673	ENDDO
1674	ELSE
1675	DO g = 1, ngast
1676	salsa_gas(g)%init(k) = pr_gas(g,kk)
1677	salsa_gas(g)%conc(k,:,:) = salsa_gas(g)%init(k)
1678	ENDDO
1679	ENDIF
1680	ENDDO
1681
1682	DEALLOCATE( pr_z, pr_gas )
1683	ELSEIF ( .NOT. netcdf_extend .AND. .NOT. salsa_gases_from_chem ) THEN
1684	message_string = 'Input file '// TRIM( 'PIDS_CHEM' ) // &
1685	TRIM( coupling_char ) // ' for SALSA missing!'
1686	CALL message( 'salsa_mod: aerosol_init', 'SA0033', 1, 2, 0, 6, 0 )
1687	ENDIF ! netcdf_extend
1688	#endif
1689
1690	ENDIF
1691
1692	IF ( ioc > 0 .AND. iso4 > 0 ) THEN
1693	!-- Both are there, so use the given "massDistrA"
1694	pvfOC1a(:) = pvf2a(:,2) / ( pvf2a(:,2) + pvf2a(:,1) ) ! Normalize
1695	ELSEIF ( ioc > 0 ) THEN
1696	!-- Pure organic carbon
1697	pvfOC1a(:) = 1.0_wp
1698	ELSEIF ( iso4 > 0 ) THEN
1699	!-- Pure SO4
1700	pvfOC1a(:) = 0.0_wp
1701	ELSE
1702	message_string = 'Either OC or SO4 must be active for aerosol region 1a!'
1703	CALL message( 'salsa_mod: aerosol_init', 'SA0021', 1, 2, 0, 6, 0 )
1704	ENDIF
1705
1706	!
1707	!-- Initialize concentrations
1708	DO i = nxlg, nxrg
1709	DO j = nysg, nyng
1710	DO k = nzb, nzt+1
1711	!
1712	!-- Predetermine flag to mask topography
1713	flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_0(k,j,i), 0 ) )
1714	!
1715	!-- a) Number concentrations
1716	!-- Region 1:
1717	DO b = in1a, fn1a
1718	aerosol_number(b)%conc(k,j,i) = pndist(k,b) * flag
1719	IF ( prunmode == 1 ) THEN
1720	aerosol_number(b)%init = pndist(:,b)
1721	ENDIF
1722	ENDDO
1723	!
1724	!-- Region 2:
1725	IF ( nreg > 1 ) THEN
1726	DO b = in2a, fn2a
1727	aerosol_number(b)%conc(k,j,i) = MAX( 0.0_wp, pnf2a(k) ) * &
1728	pndist(k,b) * flag
1729	IF ( prunmode == 1 ) THEN
1730	aerosol_number(b)%init = MAX( 0.0_wp, nf2a ) * pndist(:,b)
1731	ENDIF
1732	ENDDO
1733	IF ( .NOT. no_insoluble ) THEN
1734	DO b = in2b, fn2b
1735	IF ( pnf2a(k) < 1.0_wp ) THEN
1736	aerosol_number(b)%conc(k,j,i) = MAX( 0.0_wp, 1.0_wp &
1737	- pnf2a(k) ) * pndist(k,b) * flag
1738	IF ( prunmode == 1 ) THEN
1739	aerosol_number(b)%init = MAX( 0.0_wp, 1.0_wp - &
1740	nf2a ) * pndist(:,b)
1741	ENDIF
1742	ENDIF
1743	ENDDO
1744	ENDIF
1745	ENDIF
1746	!
1747	!-- b) Aerosol mass concentrations
1748	!-- bin subrange 1: done here separately due to the SO4/OC convention
1749	!-- SO4:
1750	IF ( iso4 > 0 ) THEN
1751	ss = ( iso4 - 1 ) * nbins + in1a !< start
1752	ee = ( iso4 - 1 ) * nbins + fn1a !< end
1753	b = in1a
1754	DO c = ss, ee
1755	aerosol_mass(c)%conc(k,j,i) = MAX( 0.0_wp, 1.0_wp - &
1756	pvfOC1a(k) ) * pndist(k,b) * &
1757	core(b) * arhoh2so4 * flag
1758	IF ( prunmode == 1 ) THEN
1759	aerosol_mass(c)%init = MAX( 0.0_wp, 1.0_wp - MAXVAL( &
1760	pvfOC1a ) ) * pndist(:,b) * &
1761	core(b) * arhoh2so4
1762	ENDIF
1763	b = b+1
1764	ENDDO
1765	ENDIF
1766	!-- OC:
1767	IF ( ioc > 0 ) THEN
1768	ss = ( ioc - 1 ) * nbins + in1a !< start
1769	ee = ( ioc - 1 ) * nbins + fn1a !< end
1770	b = in1a
1771	DO c = ss, ee
1772	aerosol_mass(c)%conc(k,j,i) = MAX( 0.0_wp, pvfOC1a(k) ) * &
1773	pndist(k,b) * core(b) * arhooc * flag
1774	IF ( prunmode == 1 ) THEN
1775	aerosol_mass(c)%init = MAX( 0.0_wp, MAXVAL( pvfOC1a ) ) &
1776	* pndist(:,b) * core(b) * arhooc
1777	ENDIF
1778	b = b+1
1779	ENDDO
1780	ENDIF
1781
1782	prunmode = 3 ! Init only once
1783
1784	ENDDO !< k
1785	ENDDO !< j
1786	ENDDO !< i
1787
1788	!
1789	!-- c) Aerosol mass concentrations
1790	!-- bin subrange 2:
1791	IF ( nreg > 1 ) THEN
1792
1793	IF ( iso4 > 0 ) THEN
1794	CALL set_aero_mass( iso4, pvf2a(:,1), pvf2b(:,1), pnf2a, pndist, &
1795	core, arhoh2so4 )
1796	ENDIF
1797	IF ( ioc > 0 ) THEN
1798	CALL set_aero_mass( ioc, pvf2a(:,2), pvf2b(:,2), pnf2a, pndist, core,&
1799	arhooc )
1800	ENDIF
1801	IF ( ibc > 0 ) THEN
1802	CALL set_aero_mass( ibc, pvf2a(:,3), pvf2b(:,3), pnf2a, pndist, core,&
1803	arhobc )
1804	ENDIF
1805	IF ( idu > 0 ) THEN
1806	CALL set_aero_mass( idu, pvf2a(:,4), pvf2b(:,4), pnf2a, pndist, core,&
1807	arhodu )
1808	ENDIF
1809	IF ( iss > 0 ) THEN
1810	CALL set_aero_mass( iss, pvf2a(:,5), pvf2b(:,5), pnf2a, pndist, core,&
1811	arhoss )
1812	ENDIF
1813	IF ( ino > 0 ) THEN
1814	CALL set_aero_mass( ino, pvf2a(:,6), pvf2b(:,6), pnf2a, pndist, core,&
1815	arhohno3 )
1816	ENDIF
1817	IF ( inh > 0 ) THEN
1818	CALL set_aero_mass( inh, pvf2a(:,7), pvf2b(:,7), pnf2a, pndist, core,&
1819	arhonh3 )
1820	ENDIF
1821
1822	ENDIF
1823
1824	END SUBROUTINE aerosol_init
1825
1826	!------------------------------------------------------------------------------!
1827	! Description:
1828	! ------------
1829	!> Create a lognormal size distribution and discretise to a sectional
1830	!> representation.
1831	!------------------------------------------------------------------------------!
1832	SUBROUTINE size_distribution( in_ntot, in_dpg, in_sigma, psd_sect )
1833
1834	IMPLICIT NONE
1835
1836	!-- Log-normal size distribution: modes
1837	REAL(wp), DIMENSION(:), INTENT(in) :: in_dpg !< geometric mean diameter
1838	!< (micrometres)
1839	REAL(wp), DIMENSION(:), INTENT(in) :: in_ntot !< number conc. (#/cm3)
1840	REAL(wp), DIMENSION(:), INTENT(in) :: in_sigma !< standard deviation
1841	REAL(wp), DIMENSION(:), INTENT(inout) :: psd_sect !< sectional size
1842	!< distribution
1843	INTEGER(iwp) :: b !< running index: bin
1844	INTEGER(iwp) :: ib !< running index: iteration
1845	REAL(wp) :: d1 !< particle diameter (m, dummy)
1846	REAL(wp) :: d2 !< particle diameter (m, dummy)
1847	REAL(wp) :: delta_d !< (d2-d1)/10
1848	REAL(wp) :: deltadp !< bin width
1849	REAL(wp) :: dmidi !< ( d1 + d2 ) / 2
1850
1851	DO b = in1a, fn2b !< aerosol size bins
1852	psd_sect(b) = 0.0_wp
1853	!-- Particle diameter at the low limit (largest in the bin) (m)
1854	d1 = ( aero(b)%vlolim / api6 ) ** ( 1.0_wp / 3.0_wp )
1855	!-- Particle diameter at the high limit (smallest in the bin) (m)
1856	d2 = ( aero(b)%vhilim / api6 ) ** ( 1.0_wp / 3.0_wp )
1857	!-- Span of particle diameter in a bin (m)
1858	delta_d = ( d2 - d1 ) / 10.0_wp
1859	!-- Iterate:
1860	DO ib = 1, 10
1861	d1 = ( aero(b)%vlolim / api6 ) ** ( 1.0_wp / 3.0_wp ) + ( ib - 1) &
1862	* delta_d
1863	d2 = d1 + delta_d
1864	dmidi = ( d1 + d2 ) / 2.0_wp
1865	deltadp = LOG10( d2 / d1 )
1866
1867	!-- Size distribution
1868	!-- in_ntot = total number, total area, or total volume concentration
1869	!-- in_dpg = geometric-mean number, area, or volume diameter
1870	!-- n(k) = number, area, or volume concentration in a bin
1871	!-- n_lognorm and dpg converted to units of #/m3 and m
1872	psd_sect(b) = psd_sect(b) + SUM( in_ntot * 1.0E+6_wp * deltadp / &
1873	( SQRT( 2.0_wp * pi ) * LOG10( in_sigma ) ) * &
1874	EXP( -LOG10( dmidi / ( 1.0E-6_wp * in_dpg ) )**2.0_wp / &
1875	( 2.0_wp * LOG10( in_sigma ) ** 2.0_wp ) ) )
1876
1877	ENDDO
1878	ENDDO
1879
1880	END SUBROUTINE size_distribution
1881
1882	!------------------------------------------------------------------------------!
1883	! Description:
1884	! ------------
1885	!> Sets the mass concentrations to aerosol arrays in 2a and 2b.
1886	!>
1887	!> Tomi Raatikainen, FMI, 29.2.2016
1888	!------------------------------------------------------------------------------!
1889	SUBROUTINE set_aero_mass( ispec, ppvf2a, ppvf2b, ppnf2a, ppndist, pcore, prho )
1890
1891	IMPLICIT NONE
1892
1893	INTEGER(iwp), INTENT(in) :: ispec !< Aerosol species index
1894	REAL(wp), INTENT(in) :: pcore(nbins) !< Aerosol bin mid core volume
1895	REAL(wp), INTENT(in) :: ppndist(0:nz+1,nbins) !< Aerosol size distribution
1896	REAL(wp), INTENT(in) :: ppnf2a(0:nz+1) !< Number fraction for 2a
1897	REAL(wp), INTENT(in) :: ppvf2a(0:nz+1) !< Mass distributions for a
1898	REAL(wp), INTENT(in) :: ppvf2b(0:nz+1) !< and b bins
1899	REAL(wp), INTENT(in) :: prho !< Aerosol density
1900	INTEGER(iwp) :: b !< loop index
1901	INTEGER(iwp) :: c !< loop index
1902	INTEGER(iwp) :: ee !< index: end
1903	INTEGER(iwp) :: i !< loop index
1904	INTEGER(iwp) :: j !< loop index
1905	INTEGER(iwp) :: k !< loop index
1906	INTEGER(iwp) :: prunmode !< 1 = initialise
1907	INTEGER(iwp) :: ss !< index: start
1908	REAL(wp) :: flag !< flag to mask topography grid points
1909
1910	prunmode = 1
1911
1912	DO i = nxlg, nxrg
1913	DO j = nysg, nyng
1914	DO k = nzb, nzt+1
1915	!
1916	!-- Predetermine flag to mask topography
1917	flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_0(k,j,i), 0 ) )
1918	!
1919	!-- Regime 2a:
1920	ss = ( ispec - 1 ) * nbins + in2a
1921	ee = ( ispec - 1 ) * nbins + fn2a
1922	b = in2a
1923	DO c = ss, ee
1924	aerosol_mass(c)%conc(k,j,i) = MAX( 0.0_wp, ppvf2a(k) ) * &
1925	ppnf2a(k) * ppndist(k,b) * pcore(b) * prho * flag
1926	IF ( prunmode == 1 ) THEN
1927	aerosol_mass(c)%init = MAX( 0.0_wp, MAXVAL( ppvf2a(:) ) ) * &
1928	MAXVAL( ppnf2a ) * pcore(b) * prho * &
1929	MAXVAL( ppndist(:,b) )
1930	ENDIF
1931	b = b+1
1932	ENDDO
1933	!-- Regime 2b:
1934	IF ( .NOT. no_insoluble ) THEN
1935	ss = ( ispec - 1 ) * nbins + in2b
1936	ee = ( ispec - 1 ) * nbins + fn2b
1937	b = in2a
1938	DO c = ss, ee
1939	aerosol_mass(c)%conc(k,j,i) = MAX( 0.0_wp, ppvf2b(k) ) * ( &
1940	1.0_wp - ppnf2a(k) ) * ppndist(k,b) * &
1941	pcore(b) * prho * flag
1942	IF ( prunmode == 1 ) THEN
1943	aerosol_mass(c)%init = MAX( 0.0_wp, MAXVAL( ppvf2b(:) ) )&
1944	* ( 1.0_wp - MAXVAL( ppnf2a ) ) * &
1945	MAXVAL( ppndist(:,b) ) * pcore(b) * prho
1946	ENDIF
1947	b = b+1
1948	ENDDO
1949	ENDIF
1950	prunmode = 3 ! Init only once
1951	ENDDO
1952	ENDDO
1953	ENDDO
1954	END SUBROUTINE set_aero_mass
1955
1956	!------------------------------------------------------------------------------!
1957	! Description:
1958	! ------------
1959	!> Swapping of timelevels
1960	!------------------------------------------------------------------------------!
1961	SUBROUTINE salsa_swap_timelevel( mod_count )
1962
1963	IMPLICIT NONE
1964
1965	INTEGER(iwp), INTENT(IN) :: mod_count !<
1966	INTEGER(iwp) :: b !<
1967	INTEGER(iwp) :: c !<
1968	INTEGER(iwp) :: cc !<
1969	INTEGER(iwp) :: g !<
1970
1971	IF ( simulated_time >= time_since_reference_point ) THEN
1972
1973	SELECT CASE ( mod_count )
1974
1975	CASE ( 0 )
1976
1977	DO b = 1, nbins
1978	aerosol_number(b)%conc(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => &
1979	nconc_1(:,:,:,b)
1980	aerosol_number(b)%conc_p(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => &
1981	nconc_2(:,:,:,b)
1982	DO c = 1, ncc_tot
1983	cc = ( c-1 ) * nbins + b ! required due to possible Intel18 bug
1984	aerosol_mass(cc)%conc(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => &
1985	mconc_1(:,:,:,cc)
1986	aerosol_mass(cc)%conc_p(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => &
1987	mconc_2(:,:,:,cc)
1988	ENDDO
1989	ENDDO
1990
1991	IF ( .NOT. salsa_gases_from_chem ) THEN
1992	DO g = 1, ngast
1993	salsa_gas(g)%conc(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => &
1994	gconc_1(:,:,:,g)
1995	salsa_gas(g)%conc_p(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => &
1996	gconc_2(:,:,:,g)
1997	ENDDO
1998	ENDIF
1999
2000	CASE ( 1 )
2001
2002	DO b = 1, nbins
2003	aerosol_number(b)%conc(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => &
2004	nconc_2(:,:,:,b)
2005	aerosol_number(b)%conc_p(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => &
2006	nconc_1(:,:,:,b)
2007	DO c = 1, ncc_tot
2008	cc = ( c-1 ) * nbins + b ! required due to possible Intel18 bug
2009	aerosol_mass(cc)%conc(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => &
2010	mconc_2(:,:,:,cc)
2011	aerosol_mass(cc)%conc_p(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => &
2012	mconc_1(:,:,:,cc)
2013	ENDDO
2014	ENDDO
2015
2016	IF ( .NOT. salsa_gases_from_chem ) THEN
2017	DO g = 1, ngast
2018	salsa_gas(g)%conc(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => &
2019	gconc_2(:,:,:,g)
2020	salsa_gas(g)%conc_p(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => &
2021	gconc_1(:,:,:,g)
2022	ENDDO
2023	ENDIF
2024
2025	END SELECT
2026
2027	ENDIF
2028
2029	END SUBROUTINE salsa_swap_timelevel
2030
2031
2032	!------------------------------------------------------------------------------!
2033	! Description:
2034	! ------------
2035	!> This routine reads the respective restart data.
2036	!------------------------------------------------------------------------------!
2037	SUBROUTINE salsa_rrd_local( k, nxlf, nxlc, nxl_on_file, nxrf, nxrc, &
2038	nxr_on_file, nynf, nync, nyn_on_file, nysf, &
2039	nysc, nys_on_file, tmp_3d, found )
2040
2041
2042	IMPLICIT NONE
2043
2044	CHARACTER (LEN=20) :: field_char !<
2045	INTEGER(iwp) :: b !<
2046	INTEGER(iwp) :: c !<
2047	INTEGER(iwp) :: g !<
2048	INTEGER(iwp) :: k !<
2049	INTEGER(iwp) :: nxlc !<
2050	INTEGER(iwp) :: nxlf !<
2051	INTEGER(iwp) :: nxl_on_file !<
2052	INTEGER(iwp) :: nxrc !<
2053	INTEGER(iwp) :: nxrf !<
2054	INTEGER(iwp) :: nxr_on_file !<
2055	INTEGER(iwp) :: nync !<
2056	INTEGER(iwp) :: nynf !<
2057	INTEGER(iwp) :: nyn_on_file !<
2058	INTEGER(iwp) :: nysc !<
2059	INTEGER(iwp) :: nysf !<
2060	INTEGER(iwp) :: nys_on_file !<
2061
2062	LOGICAL, INTENT(OUT) :: found
2063
2064	REAL(wp), &
2065	DIMENSION(nzb:nzt+1,nys_on_file-nbgp:nyn_on_file+nbgp,nxl_on_file-nbgp:nxr_on_file+nbgp) :: tmp_3d !<
2066
2067	found = .FALSE.
2068
2069	IF ( read_restart_data_salsa ) THEN
2070
2071	SELECT CASE ( restart_string(1:length) )
2072
2073	CASE ( 'aerosol_number' )
2074	DO b = 1, nbins
2075	IF ( k == 1 ) READ ( 13 ) tmp_3d
2076	aerosol_number(b)%conc(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) = &
2077	tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
2078	found = .TRUE.
2079	ENDDO
2080
2081	CASE ( 'aerosol_mass' )
2082	DO c = 1, ncc_tot * nbins
2083	IF ( k == 1 ) READ ( 13 ) tmp_3d
2084	aerosol_mass(c)%conc(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) = &
2085	tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
2086	found = .TRUE.
2087	ENDDO
2088
2089	CASE ( 'salsa_gas' )
2090	DO g = 1, ngast
2091	IF ( k == 1 ) READ ( 13 ) tmp_3d
2092	salsa_gas(g)%conc(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) = &
2093	tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
2094	found = .TRUE.
2095	ENDDO
2096
2097	CASE DEFAULT
2098	found = .FALSE.
2099
2100	END SELECT
2101	ENDIF
2102
2103	END SUBROUTINE salsa_rrd_local
2104
2105
2106	!------------------------------------------------------------------------------!
2107	! Description:
2108	! ------------
2109	!> This routine writes the respective restart data.
2110	!> Note that the following input variables in PARIN have to be equal between
2111	!> restart runs:
2112	!> listspec, nbin, nbin2, nf2a, ncc, mass_fracs_a, mass_fracs_b
2113	!------------------------------------------------------------------------------!
2114	SUBROUTINE salsa_wrd_local
2115
2116	IMPLICIT NONE
2117
2118	INTEGER(iwp) :: b !<
2119	INTEGER(iwp) :: c !<
2120	INTEGER(iwp) :: g !<
2121
2122	IF ( write_binary .AND. write_binary_salsa ) THEN
2123
2124	CALL wrd_write_string( 'aerosol_number' )
2125	DO b = 1, nbins
2126	WRITE ( 14 ) aerosol_number(b)%conc
2127	ENDDO
2128
2129	CALL wrd_write_string( 'aerosol_mass' )
2130	DO c = 1, nbins*ncc_tot
2131	WRITE ( 14 ) aerosol_mass(c)%conc
2132	ENDDO
2133
2134	CALL wrd_write_string( 'salsa_gas' )
2135	DO g = 1, ngast
2136	WRITE ( 14 ) salsa_gas(g)%conc
2137	ENDDO
2138
2139	ENDIF
2140
2141	END SUBROUTINE salsa_wrd_local
2142
2143
2144	!------------------------------------------------------------------------------!
2145	! Description:
2146	! ------------
2147	!> Performs necessary unit and dimension conversion between the host model and
2148	!> SALSA module, and calls the main SALSA routine.
2149	!> Partially adobted form the original SALSA boxmodel version.
2150	!> Now takes masses in as kg/kg from LES!! Converted to m3/m3 for SALSA
2151	!> 05/2016 Juha: This routine is still pretty much in its original shape.
2152	!> It's dumb as a mule and twice as ugly, so implementation of
2153	!> an improved solution is necessary sooner or later.
2154	!> Juha Tonttila, FMI, 2014
2155	!> Jaakko Ahola, FMI, 2016
2156	!> Only aerosol processes included, Mona Kurppa, UHel, 2017
2157	!------------------------------------------------------------------------------!
2158	SUBROUTINE salsa_driver( i, j, prunmode )
2159
2160	USE arrays_3d, &
2161	ONLY: pt_p, q_p, rho_air_zw, u, v, w
2162
2163	USE plant_canopy_model_mod, &
2164	ONLY: lad_s
2165
2166	USE surface_mod, &
2167	ONLY: surf_def_h, surf_def_v, surf_lsm_h, surf_lsm_v, surf_usm_h, &
2168	surf_usm_v
2169
2170	IMPLICIT NONE
2171
2172	INTEGER(iwp), INTENT(in) :: i !< loop index
2173	INTEGER(iwp), INTENT(in) :: j !< loop index
2174	INTEGER(iwp), INTENT(in) :: prunmode !< 1: Initialization call
2175	!< 2: Spinup period call
2176	!< 3: Regular runtime call
2177	!-- Local variables
2178	TYPE(t_section), DIMENSION(fn2b) :: aero_old !< helper array
2179	INTEGER(iwp) :: bb !< loop index
2180	INTEGER(iwp) :: cc !< loop index
2181	INTEGER(iwp) :: endi !< end index
2182	INTEGER(iwp) :: k_wall !< vertical index of topography top
2183	INTEGER(iwp) :: k !< loop index
2184	INTEGER(iwp) :: l !< loop index
2185	INTEGER(iwp) :: nc_h2o !< index of H2O in the prtcl index table
2186	INTEGER(iwp) :: ss !< loop index
2187	INTEGER(iwp) :: str !< start index
2188	INTEGER(iwp) :: vc !< default index in prtcl
2189	REAL(wp) :: cw_old !< previous H2O mixing ratio
2190	REAL(wp) :: flag !< flag to mask topography grid points
2191	REAL(wp), DIMENSION(nzb:nzt+1) :: in_adn !< air density (kg/m3)
2192	REAL(wp), DIMENSION(nzb:nzt+1) :: in_cs !< H2O sat. vapour conc.
2193	REAL(wp), DIMENSION(nzb:nzt+1) :: in_cw !< H2O vapour concentration
2194	REAL(wp) :: in_lad !< leaf area density (m2/m3)
2195	REAL(wp), DIMENSION(nzb:nzt+1) :: in_p !< pressure (Pa)
2196	REAL(wp) :: in_rh !< relative humidity
2197	REAL(wp), DIMENSION(nzb:nzt+1) :: in_t !< temperature (K)
2198	REAL(wp), DIMENSION(nzb:nzt+1) :: in_u !< wind magnitude (m/s)
2199	REAL(wp), DIMENSION(nzb:nzt+1) :: kvis !< kinematic viscosity of air(m2/s)
2200	REAL(wp), DIMENSION(nzb:nzt+1,fn2b) :: Sc !< particle Schmidt number
2201	REAL(wp), DIMENSION(nzb:nzt+1,fn2b) :: vd !< particle fall seed (m/s,
2202	!< sedimentation velocity)
2203	REAL(wp), DIMENSION(nzb:nzt+1) :: ppm_to_nconc !< Conversion factor
2204	!< from ppm to #/m3
2205	REAL(wp) :: zgso4 !< SO4
2206	REAL(wp) :: zghno3 !< HNO3
2207	REAL(wp) :: zgnh3 !< NH3
2208	REAL(wp) :: zgocnv !< non-volatile OC
2209	REAL(wp) :: zgocsv !< semi-volatile OC
2210
2211	aero_old(:)%numc = 0.0_wp
2212	in_adn = 0.0_wp
2213	in_cs = 0.0_wp
2214	in_cw = 0.0_wp
2215	in_lad = 0.0_wp
2216	in_rh = 0.0_wp
2217	in_p = 0.0_wp
2218	in_t = 0.0_wp
2219	in_u = 0.0_wp
2220	kvis = 0.0_wp
2221	Sc = 0.0_wp
2222	vd = 0.0_wp
2223	ppm_to_nconc = 1.0_wp
2224	zgso4 = nclim
2225	zghno3 = nclim
2226	zgnh3 = nclim
2227	zgocnv = nclim
2228	zgocsv = nclim
2229
2230	!
2231	!-- Aerosol number is always set, but mass can be uninitialized
2232	DO cc = 1, nbins
2233	aero(cc)%volc = 0.0_wp
2234	aero_old(cc)%volc = 0.0_wp
2235	ENDDO
2236	!
2237	!-- Set the salsa runtime config (How to make this more efficient?)
2238	CALL set_salsa_runtime( prunmode )
2239	!
2240	!-- Calculate thermodynamic quantities needed in SALSA
2241	CALL salsa_thrm_ij( i, j, p_ij=in_p, temp_ij=in_t, cw_ij=in_cw, &
2242	cs_ij=in_cs, adn_ij=in_adn )
2243	!
2244	!-- Magnitude of wind: needed for deposition
2245	IF ( lsdepo ) THEN
2246	in_u(nzb+1:nzt) = SQRT( &
2247	( 0.5_wp * ( u(nzb+1:nzt,j,i) + u(nzb+1:nzt,j,i+1) ) )**2 + &
2248	( 0.5_wp * ( v(nzb+1:nzt,j,i) + v(nzb+1:nzt,j+1,i) ) )**2 + &
2249	( 0.5_wp * ( w(nzb:nzt-1,j,i) + w(nzb+1:nzt,j, i) ) )**2 )
2250	ENDIF
2251	!
2252	!-- Calculate conversion factors for gas concentrations
2253	ppm_to_nconc = for_ppm_to_nconc * in_p / in_t
2254	!
2255	!-- Determine topography-top index on scalar grid
2256	k_wall = MAXLOC( MERGE( 1, 0, BTEST( wall_flags_0(:,j,i), 12 ) ), &
2257	DIM = 1 ) - 1
2258
2259	DO k = nzb+1, nzt
2260	!
2261	!-- Predetermine flag to mask topography
2262	flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_0(k,j,i), 0 ) )
2263	!
2264	!-- Do not run inside buildings
2265	IF ( flag == 0.0_wp ) CYCLE
2266	!
2267	!-- Wind velocity for dry depositon on vegetation
2268	IF ( lsdepo_vege .AND. plant_canopy ) THEN
2269	in_lad = lad_s(k-k_wall,j,i)
2270	ENDIF
2271	!
2272	!-- For initialization and spinup, limit the RH with the parameter rhlim
2273	IF ( prunmode < 3 ) THEN
2274	in_cw(k) = MIN( in_cw(k), in_cs(k) * rhlim )
2275	ELSE
2276	in_cw(k) = in_cw(k)
2277	ENDIF
2278	cw_old = in_cw(k) !* in_adn(k)
2279	!
2280	!-- Set volume concentrations:
2281	!-- Sulphate (SO4) or sulphuric acid H2SO4
2282	IF ( iso4 > 0 ) THEN
2283	vc = 1
2284	str = ( iso4-1 ) * nbins + 1 ! start index
2285	endi = iso4 * nbins ! end index
2286	cc = 1
2287	DO ss = str, endi
2288	aero(cc)%volc(vc) = aerosol_mass(ss)%conc(k,j,i) / arhoh2so4
2289	cc = cc+1
2290	ENDDO
2291	aero_old(1:nbins)%volc(vc) = aero(1:nbins)%volc(vc)
2292	ENDIF
2293
2294	!-- Organic carbon (OC) compounds
2295	IF ( ioc > 0 ) THEN
2296	vc = 2
2297	str = ( ioc-1 ) * nbins + 1
2298	endi = ioc * nbins
2299	cc = 1
2300	DO ss = str, endi
2301	aero(cc)%volc(vc) = aerosol_mass(ss)%conc(k,j,i) / arhooc
2302	cc = cc+1
2303	ENDDO
2304	aero_old(1:nbins)%volc(vc) = aero(1:nbins)%volc(vc)
2305	ENDIF
2306
2307	!-- Black carbon (BC)
2308	IF ( ibc > 0 ) THEN
2309	vc = 3
2310	str = ( ibc-1 ) * nbins + 1 + fn1a
2311	endi = ibc * nbins
2312	cc = 1 + fn1a
2313	DO ss = str, endi
2314	aero(cc)%volc(vc) = aerosol_mass(ss)%conc(k,j,i) / arhobc
2315	cc = cc+1
2316	ENDDO
2317	aero_old(1:nbins)%volc(vc) = aero(1:nbins)%volc(vc)
2318	ENDIF
2319
2320	!-- Dust (DU)
2321	IF ( idu > 0 ) THEN
2322	vc = 4
2323	str = ( idu-1 ) * nbins + 1 + fn1a
2324	endi = idu * nbins
2325	cc = 1 + fn1a
2326	DO ss = str, endi
2327	aero(cc)%volc(vc) = aerosol_mass(ss)%conc(k,j,i) / arhodu
2328	cc = cc+1
2329	ENDDO
2330	aero_old(1:nbins)%volc(vc) = aero(1:nbins)%volc(vc)
2331	ENDIF
2332
2333	!-- Sea salt (SS)
2334	IF ( iss > 0 ) THEN
2335	vc = 5
2336	str = ( iss-1 ) * nbins + 1 + fn1a
2337	endi = iss * nbins
2338	cc = 1 + fn1a
2339	DO ss = str, endi
2340	aero(cc)%volc(vc) = aerosol_mass(ss)%conc(k,j,i) / arhoss
2341	cc = cc+1
2342	ENDDO
2343	aero_old(1:nbins)%volc(vc) = aero(1:nbins)%volc(vc)
2344	ENDIF
2345
2346	!-- Nitrate (NO(3-)) or nitric acid HNO3
2347	IF ( ino > 0 ) THEN
2348	vc = 6
2349	str = ( ino-1 ) * nbins + 1
2350	endi = ino * nbins
2351	cc = 1
2352	DO ss = str, endi
2353	aero(cc)%volc(vc) = aerosol_mass(ss)%conc(k,j,i) / arhohno3
2354	cc = cc+1
2355	ENDDO
2356	aero_old(1:nbins)%volc(vc) = aero(1:nbins)%volc(vc)
2357	ENDIF
2358
2359	!-- Ammonium (NH(4+)) or ammonia NH3
2360	IF ( inh > 0 ) THEN
2361	vc = 7
2362	str = ( inh-1 ) * nbins + 1
2363	endi = inh * nbins
2364	cc = 1
2365	DO ss = str, endi
2366	aero(cc)%volc(vc) = aerosol_mass(ss)%conc(k,j,i) / arhonh3
2367	cc = cc+1
2368	ENDDO
2369	aero_old(1:nbins)%volc(vc) = aero(1:nbins)%volc(vc)
2370	ENDIF
2371
2372	!-- Water (always used)
2373	nc_h2o = get_index( prtcl,'H2O' )
2374	vc = 8
2375	str = ( nc_h2o-1 ) * nbins + 1
2376	endi = nc_h2o * nbins
2377	cc = 1
2378	IF ( advect_particle_water ) THEN
2379	DO ss = str, endi
2380	aero(cc)%volc(vc) = aerosol_mass(ss)%conc(k,j,i) / arhoh2o
2381	cc = cc+1
2382	ENDDO
2383	ELSE
2384	aero(1:nbins)%volc(vc) = mclim
2385	ENDIF
2386	aero_old(1:nbins)%volc(vc) = aero(1:nbins)%volc(vc)
2387	!
2388	!-- Number concentrations (numc) and particle sizes
2389	!-- (dwet = wet diameter, core = dry volume)
2390	DO bb = 1, nbins
2391	aero(bb)%numc = aerosol_number(bb)%conc(k,j,i)
2392	aero_old(bb)%numc = aero(bb)%numc
2393	IF ( aero(bb)%numc > nclim ) THEN
2394	aero(bb)%dwet = ( SUM( aero(bb)%volc(:) ) / aero(bb)%numc / api6 )&
2395	**( 1.0_wp / 3.0_wp )
2396	aero(bb)%core = SUM( aero(bb)%volc(1:7) ) / aero(bb)%numc
2397	ELSE
2398	aero(bb)%dwet = aero(bb)%dmid
2399	aero(bb)%core = api6 * ( aero(bb)%dwet ) ** 3.0_wp
2400	ENDIF
2401	ENDDO
2402	!
2403	!-- On EACH call of salsa_driver, calculate the ambient sizes of
2404	!-- particles by equilibrating soluble fraction of particles with water
2405	!-- using the ZSR method.
2406	in_rh = in_cw(k) / in_cs(k)
2407	IF ( prunmode==1 .OR. .NOT. advect_particle_water ) THEN
2408	CALL equilibration( in_rh, in_t(k), aero, .TRUE. )
2409	ENDIF
2410	!
2411	!-- Gaseous tracer concentrations in #/m3
2412	IF ( salsa_gases_from_chem ) THEN
2413	!
2414	!-- Convert concentrations in ppm to #/m3
2415	zgso4 = chem_species(gas_index_chem(1))%conc(k,j,i) * ppm_to_nconc(k)
2416	zghno3 = chem_species(gas_index_chem(2))%conc(k,j,i) * ppm_to_nconc(k)
2417	zgnh3 = chem_species(gas_index_chem(3))%conc(k,j,i) * ppm_to_nconc(k)
2418	zgocnv = chem_species(gas_index_chem(4))%conc(k,j,i) * ppm_to_nconc(k)
2419	zgocsv = chem_species(gas_index_chem(5))%conc(k,j,i) * ppm_to_nconc(k)
2420	ELSE
2421	zgso4 = salsa_gas(1)%conc(k,j,i)
2422	zghno3 = salsa_gas(2)%conc(k,j,i)
2423	zgnh3 = salsa_gas(3)%conc(k,j,i)
2424	zgocnv = salsa_gas(4)%conc(k,j,i)
2425	zgocsv = salsa_gas(5)%conc(k,j,i)
2426	ENDIF
2427	!
2428	!-- ***************************************!
2429	!-- Run SALSA !
2430	!-- ***************************************!
2431	CALL run_salsa( in_p(k), in_cw(k), in_cs(k), in_t(k), in_u(k), &
2432	in_adn(k), in_lad, zgso4, zgocnv, zgocsv, zghno3, zgnh3,&
2433	aero, prtcl, kvis(k), Sc(k,:), vd(k,:), dt_salsa )
2434	!-- ***************************************!
2435	IF ( lsdepo ) sedim_vd(k,j,i,:) = vd(k,:)
2436	!
2437	!-- Calculate changes in concentrations
2438	DO bb = 1, nbins
2439	aerosol_number(bb)%conc(k,j,i) = aerosol_number(bb)%conc(k,j,i) &
2440	+ ( aero(bb)%numc - aero_old(bb)%numc ) * flag
2441	ENDDO
2442
2443	IF ( iso4 > 0 ) THEN
2444	vc = 1
2445	str = ( iso4-1 ) * nbins + 1
2446	endi = iso4 * nbins
2447	cc = 1
2448	DO ss = str, endi
2449	aerosol_mass(ss)%conc(k,j,i) = aerosol_mass(ss)%conc(k,j,i) &
2450	+ ( aero(cc)%volc(vc) - aero_old(cc)%volc(vc) ) &
2451	* arhoh2so4 * flag
2452	cc = cc+1
2453	ENDDO
2454	ENDIF
2455
2456	IF ( ioc > 0 ) THEN
2457	vc = 2
2458	str = ( ioc-1 ) * nbins + 1
2459	endi = ioc * nbins
2460	cc = 1
2461	DO ss = str, endi
2462	aerosol_mass(ss)%conc(k,j,i) = aerosol_mass(ss)%conc(k,j,i) &
2463	+ ( aero(cc)%volc(vc) - aero_old(cc)%volc(vc) ) &
2464	* arhooc * flag
2465	cc = cc+1
2466	ENDDO
2467	ENDIF
2468
2469	IF ( ibc > 0 ) THEN
2470	vc = 3
2471	str = ( ibc-1 ) * nbins + 1 + fn1a
2472	endi = ibc * nbins
2473	cc = 1 + fn1a
2474	DO ss = str, endi
2475	aerosol_mass(ss)%conc(k,j,i) = aerosol_mass(ss)%conc(k,j,i) &
2476	+ ( aero(cc)%volc(vc) - aero_old(cc)%volc(vc) ) &
2477	* arhobc * flag
2478	cc = cc+1
2479	ENDDO
2480	ENDIF
2481
2482	IF ( idu > 0 ) THEN
2483	vc = 4
2484	str = ( idu-1 ) * nbins + 1 + fn1a
2485	endi = idu * nbins
2486	cc = 1 + fn1a
2487	DO ss = str, endi
2488	aerosol_mass(ss)%conc(k,j,i) = aerosol_mass(ss)%conc(k,j,i) &
2489	+ ( aero(cc)%volc(vc) - aero_old(cc)%volc(vc) ) &
2490	* arhodu * flag
2491	cc = cc+1
2492	ENDDO
2493	ENDIF
2494
2495	IF ( iss > 0 ) THEN
2496	vc = 5
2497	str = ( iss-1 ) * nbins + 1 + fn1a
2498	endi = iss * nbins
2499	cc = 1 + fn1a
2500	DO ss = str, endi
2501	aerosol_mass(ss)%conc(k,j,i) = aerosol_mass(ss)%conc(k,j,i) &
2502	+ ( aero(cc)%volc(vc) - aero_old(cc)%volc(vc) ) &
2503	* arhoss * flag
2504	cc = cc+1
2505	ENDDO
2506	ENDIF
2507
2508	IF ( ino > 0 ) THEN
2509	vc = 6
2510	str = ( ino-1 ) * nbins + 1
2511	endi = ino * nbins
2512	cc = 1
2513	DO ss = str, endi
2514	aerosol_mass(ss)%conc(k,j,i) = aerosol_mass(ss)%conc(k,j,i) &
2515	+ ( aero(cc)%volc(vc) - aero_old(cc)%volc(vc) ) &
2516	* arhohno3 * flag
2517	cc = cc+1
2518	ENDDO
2519	ENDIF
2520
2521	IF ( inh > 0 ) THEN
2522	vc = 7
2523	str = ( ino-1 ) * nbins + 1
2524	endi = ino * nbins
2525	cc = 1
2526	DO ss = str, endi
2527	aerosol_mass(ss)%conc(k,j,i) = aerosol_mass(ss)%conc(k,j,i) &
2528	+ ( aero(cc)%volc(vc) - aero_old(cc)%volc(vc) ) &
2529	* arhonh3 * flag
2530	cc = cc+1
2531	ENDDO
2532	ENDIF
2533
2534	IF ( advect_particle_water ) THEN
2535	nc_h2o = get_index( prtcl,'H2O' )
2536	vc = 8
2537	str = ( nc_h2o-1 ) * nbins + 1
2538	endi = nc_h2o * nbins
2539	cc = 1
2540	DO ss = str, endi
2541	aerosol_mass(ss)%conc(k,j,i) = aerosol_mass(ss)%conc(k,j,i) &
2542	+ ( aero(cc)%volc(vc) - aero_old(cc)%volc(vc) ) &
2543	* arhoh2o * flag
2544	IF ( prunmode == 1 ) THEN
2545	aerosol_mass(ss)%init(k) = MAX( aerosol_mass(ss)%init(k), &
2546	aerosol_mass(ss)%conc(k,j,i) )
2547	ENDIF
2548	cc = cc+1
2549	ENDDO
2550	ENDIF
2551
2552	!-- Condensation of precursor gases
2553	IF ( lscndgas ) THEN
2554	IF ( salsa_gases_from_chem ) THEN
2555	!
2556	!-- SO4 (or H2SO4)
2557	chem_species( gas_index_chem(1) )%conc(k,j,i) = &
2558	chem_species( gas_index_chem(1) )%conc(k,j,i) + &
2559	( zgso4 / ppm_to_nconc(k) - &
2560	chem_species( gas_index_chem(1) )%conc(k,j,i) ) * flag
2561	!
2562	!-- HNO3
2563	chem_species( gas_index_chem(2) )%conc(k,j,i) = &
2564	chem_species( gas_index_chem(2) )%conc(k,j,i) + &
2565	( zghno3 / ppm_to_nconc(k) - &
2566	chem_species( gas_index_chem(2) )%conc(k,j,i) ) * flag
2567	!
2568	!-- NH3
2569	chem_species( gas_index_chem(3) )%conc(k,j,i) = &
2570	chem_species( gas_index_chem(3) )%conc(k,j,i) + &
2571	( zgnh3 / ppm_to_nconc(k) - &
2572	chem_species( gas_index_chem(3) )%conc(k,j,i) ) * flag
2573	!
2574	!-- non-volatile OC
2575	chem_species( gas_index_chem(4) )%conc(k,j,i) = &
2576	chem_species( gas_index_chem(4) )%conc(k,j,i) + &
2577	( zgocnv / ppm_to_nconc(k) - &
2578	chem_species( gas_index_chem(4) )%conc(k,j,i) ) * flag
2579	!
2580	!-- semi-volatile OC
2581	chem_species( gas_index_chem(5) )%conc(k,j,i) = &
2582	chem_species( gas_index_chem(5) )%conc(k,j,i) + &
2583	( zgocsv / ppm_to_nconc(k) - &
2584	chem_species( gas_index_chem(5) )%conc(k,j,i) ) * flag
2585
2586	ELSE
2587	!
2588	!-- SO4 (or H2SO4)
2589	salsa_gas(1)%conc(k,j,i) = salsa_gas(1)%conc(k,j,i) + ( zgso4 - &
2590	salsa_gas(1)%conc(k,j,i) ) * flag
2591	!
2592	!-- HNO3
2593	salsa_gas(2)%conc(k,j,i) = salsa_gas(2)%conc(k,j,i) + ( zghno3 - &
2594	salsa_gas(2)%conc(k,j,i) ) * flag
2595	!
2596	!-- NH3
2597	salsa_gas(3)%conc(k,j,i) = salsa_gas(3)%conc(k,j,i) + ( zgnh3 - &
2598	salsa_gas(3)%conc(k,j,i) ) * flag
2599	!
2600	!-- non-volatile OC
2601	salsa_gas(4)%conc(k,j,i) = salsa_gas(4)%conc(k,j,i) + ( zgocnv - &
2602	salsa_gas(4)%conc(k,j,i) ) * flag
2603	!
2604	!-- semi-volatile OC
2605	salsa_gas(5)%conc(k,j,i) = salsa_gas(5)%conc(k,j,i) + ( zgocsv - &
2606	salsa_gas(5)%conc(k,j,i) ) * flag
2607	ENDIF
2608	ENDIF
2609	!
2610	!-- Tendency of water vapour mixing ratio is obtained from the
2611	!-- change in RH during SALSA run. This releases heat and changes pt.
2612	!-- Assumes no temperature change during SALSA run.
2613	!-- q = r / (1+r), Euler method for integration
2614	!
2615	IF ( feedback_to_palm ) THEN
2616	q_p(k,j,i) = q_p(k,j,i) + 1.0_wp / ( in_cw(k) * in_adn(k) + 1.0_wp ) &
2617	** 2.0_wp * ( in_cw(k) - cw_old ) * in_adn(k)
2618	pt_p(k,j,i) = pt_p(k,j,i) + alv / c_p * ( in_cw(k) - cw_old ) * &
2619	in_adn(k) / ( in_cw(k) / in_adn(k) + 1.0_wp ) ** 2.0_wp&
2620	* pt_p(k,j,i) / in_t(k)
2621	ENDIF
2622
2623	ENDDO ! k
2624	!
2625	!-- Set surfaces and wall fluxes due to deposition
2626	IF ( lsdepo_topo .AND. prunmode == 3 ) THEN
2627	IF ( .NOT. land_surface .AND. .NOT. urban_surface ) THEN
2628	CALL depo_topo( i, j, surf_def_h(0), vd, Sc, kvis, in_u, rho_air_zw )
2629	DO l = 0, 3
2630	CALL depo_topo( i, j, surf_def_v(l), vd, Sc, kvis, in_u, &
2631	rho_air_zw**0.0_wp )
2632	ENDDO
2633	ELSE
2634	CALL depo_topo( i, j, surf_usm_h, vd, Sc, kvis, in_u, rho_air_zw )
2635	DO l = 0, 3
2636	CALL depo_topo( i, j, surf_usm_v(l), vd, Sc, kvis, in_u, &
2637	rho_air_zw**0.0_wp )
2638	ENDDO
2639	CALL depo_topo( i, j, surf_lsm_h, vd, Sc, kvis, in_u, rho_air_zw )
2640	DO l = 0, 3
2641	CALL depo_topo( i, j, surf_lsm_v(l), vd, Sc, kvis, in_u, &
2642	rho_air_zw**0.0_wp )
2643	ENDDO
2644	ENDIF
2645	ENDIF
2646
2647	END SUBROUTINE salsa_driver
2648
2649	!------------------------------------------------------------------------------!
2650	! Description:
2651	! ------------
2652	!> The SALSA subroutine
2653	!> Modified for the new aerosol datatype,
2654	!> Juha Tonttila, FMI, 2014.
2655	!> Only aerosol processes included, Mona Kurppa, UHel, 2017
2656	!------------------------------------------------------------------------------!
2657	SUBROUTINE run_salsa( ppres, pcw, pcs, ptemp, mag_u, adn, lad, pc_h2so4, &
2658	pc_ocnv, pc_ocsv, pc_hno3, pc_nh3, paero, prtcl, kvis, &
2659	Sc, vc, ptstep )
2660
2661	IMPLICIT NONE
2662	!
2663	!-- Input parameters and variables
2664	REAL(wp), INTENT(in) :: adn !< air density (kg/m3)
2665	REAL(wp), INTENT(in) :: lad !< leaf area density (m2/m3)
2666	REAL(wp), INTENT(in) :: mag_u !< magnitude of wind (m/s)
2667	REAL(wp), INTENT(in) :: ppres !< atmospheric pressure at each grid
2668	!< point (Pa)
2669	REAL(wp), INTENT(in) :: ptemp !< temperature at each grid point (K)
2670	REAL(wp), INTENT(in) :: ptstep !< time step of salsa processes (s)
2671	TYPE(component_index), INTENT(in) :: prtcl !< part. component index table
2672	!
2673	!-- Input variables that are changed within:
2674	REAL(wp), INTENT(inout) :: kvis !< kinematic viscosity of air (m2/s)
2675	REAL(wp), INTENT(inout) :: Sc(:) !< particle Schmidt number
2676	REAL(wp), INTENT(inout) :: vc(:) !< particle fall speed (m/s,
2677	!< sedimentation velocity)
2678	!-- Gas phase concentrations at each grid point (#/m3)
2679	REAL(wp), INTENT(inout) :: pc_h2so4 !< sulphuric acid
2680	REAL(wp), INTENT(inout) :: pc_hno3 !< nitric acid
2681	REAL(wp), INTENT(inout) :: pc_nh3 !< ammonia
2682	REAL(wp), INTENT(inout) :: pc_ocnv !< nonvolatile OC
2683	REAL(wp), INTENT(inout) :: pc_ocsv !< semivolatile OC
2684	REAL(wp), INTENT(inout) :: pcs !< Saturation concentration of water
2685	!< vapour (kg/m3)
2686	REAL(wp), INTENT(inout) :: pcw !< Water vapour concentration (kg/m3)
2687	TYPE(t_section), INTENT(inout) :: paero(fn2b)
2688	!
2689	!-- Coagulation
2690	IF ( lscoag ) THEN
2691	CALL coagulation( paero, ptstep, ptemp, ppres )
2692	ENDIF
2693	!
2694	!-- Condensation
2695	IF ( lscnd ) THEN
2696	CALL condensation( paero, pc_h2so4, pc_ocnv, pc_ocsv, pc_hno3, pc_nh3, &
2697	pcw, pcs, ptemp, ppres, ptstep, prtcl )
2698	ENDIF
2699	!
2700	!-- Deposition
2701	IF ( lsdepo ) THEN
2702	CALL deposition( paero, ptemp, adn, mag_u, lad, kvis, Sc, vc )
2703	ENDIF
2704	!
2705	!-- Size distribution bin update
2706	!-- Mona: why done 3 times in SALSA-standalone?
2707	IF ( lsdistupdate ) THEN
2708	CALL distr_update( paero )
2709	ENDIF
2710
2711	END SUBROUTINE run_salsa
2712
2713	!------------------------------------------------------------------------------!
2714	! Description:
2715	! ------------
2716	!> Set logical switches according to the host model state and user-specified
2717	!> NAMELIST options.
2718	!> Juha Tonttila, FMI, 2014
2719	!> Only aerosol processes included, Mona Kurppa, UHel, 2017
2720	!------------------------------------------------------------------------------!
2721	SUBROUTINE set_salsa_runtime( prunmode )
2722
2723	IMPLICIT NONE
2724
2725	INTEGER(iwp), INTENT(in) :: prunmode
2726
2727	SELECT CASE(prunmode)
2728
2729	CASE(1) !< Initialization
2730	lscoag = .FALSE.
2731	lscnd = .FALSE.
2732	lscndgas = .FALSE.
2733	lscndh2oae = .FALSE.
2734	lsdepo = .FALSE.
2735	lsdepo_vege = .FALSE.
2736	lsdepo_topo = .FALSE.
2737	lsdistupdate = .TRUE.
2738
2739	CASE(2) !< Spinup period
2740	lscoag = ( .FALSE. .AND. nlcoag )
2741	lscnd = ( .TRUE. .AND. nlcnd )
2742	lscndgas = ( .TRUE. .AND. nlcndgas )
2743	lscndh2oae = ( .TRUE. .AND. nlcndh2oae )
2744
2745	CASE(3) !< Run
2746	lscoag = nlcoag
2747	lscnd = nlcnd
2748	lscndgas = nlcndgas
2749	lscndh2oae = nlcndh2oae
2750	lsdepo = nldepo
2751	lsdepo_vege = nldepo_vege
2752	lsdepo_topo = nldepo_topo
2753	lsdistupdate = nldistupdate
2754
2755	END SELECT
2756
2757
2758	END SUBROUTINE set_salsa_runtime
2759
2760	!------------------------------------------------------------------------------!
2761	! Description:
2762	! ------------
2763	!> Calculates the absolute temperature (using hydrostatic pressure), saturation
2764	!> vapour pressure and mixing ratio over water, relative humidity and air
2765	!> density needed in the SALSA model.
2766	!> NOTE, no saturation adjustment takes place -> the resulting water vapour
2767	!> mixing ratio can be supersaturated, allowing the microphysical calculations
2768	!> in SALSA.
2769	!
2770	!> Juha Tonttila, FMI, 2014 (original SALSAthrm)
2771	!> Mona Kurppa, UHel, 2017 (adjustment for PALM and only aerosol processes)
2772	!------------------------------------------------------------------------------!
2773	SUBROUTINE salsa_thrm_ij( i, j, p_ij, temp_ij, cw_ij, cs_ij, adn_ij )
2774
2775	USE arrays_3d, &
2776	ONLY: p, pt, q, zu
2777
2778	USE basic_constants_and_equations_mod, &
2779	ONLY: barometric_formula, exner_function, ideal_gas_law_rho, magnus
2780
2781	USE control_parameters, &
2782	ONLY: pt_surface, surface_pressure
2783
2784	IMPLICIT NONE
2785
2786	INTEGER(iwp), INTENT(in) :: i
2787	INTEGER(iwp), INTENT(in) :: j
2788	REAL(wp), DIMENSION(:), INTENT(inout) :: adn_ij
2789	REAL(wp), DIMENSION(:), INTENT(inout) :: p_ij
2790	REAL(wp), DIMENSION(:), INTENT(inout) :: temp_ij
2791	REAL(wp), DIMENSION(:), INTENT(inout), OPTIONAL :: cw_ij
2792	REAL(wp), DIMENSION(:), INTENT(inout), OPTIONAL :: cs_ij
2793	REAL(wp), DIMENSION(nzb:nzt+1) :: e_s !< saturation vapour pressure
2794	!< over water (Pa)
2795	REAL(wp) :: t_surface !< absolute surface temperature (K)
2796	!
2797	!-- Pressure p_ijk (Pa) = hydrostatic pressure + perturbation pressure (p)
2798	t_surface = pt_surface * exner_function( surface_pressure * 100.0_wp )
2799	p_ij(:) = barometric_formula( zu, t_surface, surface_pressure * 100.0_wp ) &
2800	+ p(:,j,i)
2801	!
2802	!-- Absolute ambient temperature (K)
2803	temp_ij(:) = pt(:,j,i) * exner_function( p_ij(:) )
2804	!
2805	!-- Air density
2806	adn_ij(:) = ideal_gas_law_rho( p_ij(:), temp_ij(:) )
2807	!
2808	!-- Water vapour concentration r_v (kg/m3)
2809	IF ( PRESENT( cw_ij ) ) THEN
2810	cw_ij(:) = ( q(:,j,i) / ( 1.0_wp - q(:,j,i) ) ) * adn_ij(:)
2811	ENDIF
2812	!
2813	!-- Saturation mixing ratio r_s (kg/kg) from vapour pressure at temp (Pa)
2814	IF ( PRESENT( cs_ij ) ) THEN
2815	e_s(:) = 611.0_wp * EXP( alv_d_rv * ( 3.6609E-3_wp - 1.0_wp / &
2816	temp_ij(:) ) )! magnus( temp_ij(:) )
2817	cs_ij(:) = ( 0.622_wp * e_s / ( p_ij(:) - e_s(:) ) ) * adn_ij(:)
2818	ENDIF
2819
2820	END SUBROUTINE salsa_thrm_ij
2821
2822	!------------------------------------------------------------------------------!
2823	! Description:
2824	! ------------
2825	!> Calculates ambient sizes of particles by equilibrating soluble fraction of
2826	!> particles with water using the ZSR method (Stokes and Robinson, 1966).
2827	!> Method:
2828	!> Following chemical components are assumed water-soluble
2829	!> - (ammonium) sulphate (100%)
2830	!> - sea salt (100 %)
2831	!> - organic carbon (epsoc * 100%)
2832	!> Exact thermodynamic considerations neglected.
2833	!> - If particles contain no sea salt, calculation according to sulphate
2834	!> properties
2835	!> - If contain sea salt but no sulphate, calculation according to sea salt
2836	!> properties
2837	!> - If contain both sulphate and sea salt -> the molar fraction of these
2838	!> compounds determines which one of them is used as the basis of calculation.
2839	!> If sulphate and sea salt coexist in a particle, it is assumed that the Cl is
2840	!> replaced by sulphate; thus only either sulphate + organics or sea salt +
2841	!> organics is included in the calculation of soluble fraction.
2842	!> Molality parameterizations taken from Table 1 of Tang: Thermodynamic and
2843	!> optical properties of mixed-salt aerosols of atmospheric importance,
2844	!> J. Geophys. Res., 102 (D2), 1883-1893 (1997)
2845	!
2846	!> Coded by:
2847	!> Hannele Korhonen (FMI) 2005
2848	!> Harri Kokkola (FMI) 2006
2849	!> Matti Niskanen(FMI) 2012
2850	!> Anton Laakso (FMI) 2013
2851	!> Modified for the new aerosol datatype, Juha Tonttila (FMI) 2014
2852	!
2853	!> fxm: should sea salt form a solid particle when prh is very low (even though
2854	!> it could be mixed with e.g. sulphate)?
2855	!> fxm: crashes if no sulphate or sea salt
2856	!> fxm: do we really need to consider Kelvin effect for subrange 2
2857	!------------------------------------------------------------------------------!
2858	SUBROUTINE equilibration( prh, ptemp, paero, init )
2859
2860	IMPLICIT NONE
2861	!
2862	!-- Input variables
2863	LOGICAL, INTENT(in) :: init !< TRUE: Initialization call
2864	!< FALSE: Normal runtime: update water
2865	!< content only for 1a
2866	REAL(wp), INTENT(in) :: prh !< relative humidity [0-1]
2867	REAL(wp), INTENT(in) :: ptemp !< temperature (K)
2868	!
2869	!-- Output variables
2870	TYPE(t_section), INTENT(inout) :: paero(fn2b)
2871	!
2872	!-- Local
2873	INTEGER(iwp) :: b !< loop index
2874	INTEGER(iwp) :: counti !< loop index
2875	REAL(wp) :: zaw !< water activity [0-1]
2876	REAL(wp) :: zbinmol(7) !< binary molality of each components (mol/kg)
2877	REAL(wp) :: zcore !< Volume of dry particle
2878	REAL(wp) :: zdold !< Old diameter
2879	REAL(wp) :: zdwet !< Wet diameter or mean droplet diameter
2880	REAL(wp) :: zke !< Kelvin term in the KÃ¶hler equation
2881	REAL(wp) :: zlwc !< liquid water content [kg/m3-air]
2882	REAL(wp) :: zrh !< Relative humidity
2883	REAL(wp) :: zvpart(7) !< volume of chem. compounds in one particle
2884
2885	zaw = 0.0_wp
2886	zbinmol = 0.0_wp
2887	zcore = 0.0_wp
2888	zdold = 0.0_wp
2889	zdwet = 0.0_wp
2890	zlwc = 0.0_wp
2891	zrh = 0.0_wp
2892
2893	!
2894	!-- Relative humidity:
2895	zrh = prh
2896	zrh = MAX( zrh, 0.05_wp )
2897	zrh = MIN( zrh, 0.98_wp)
2898	!
2899	!-- 1) Regime 1: sulphate and partly water-soluble OC. Done for every CALL
2900	DO b = in1a, fn1a ! size bin
2901
2902	zbinmol = 0.0_wp
2903	zdold = 1.0_wp
2904	zke = 1.02_wp
2905
2906	IF ( paero(b)%numc > nclim ) THEN
2907	!
2908	!-- Volume in one particle
2909	zvpart = 0.0_wp
2910	zvpart(1:2) = paero(b)%volc(1:2) / paero(b)%numc
2911	zvpart(6:7) = paero(b)%volc(6:7) / paero(b)%numc
2912	!
2913	!-- Total volume and wet diameter of one dry particle
2914	zcore = SUM( zvpart(1:2) )
2915	zdwet = paero(b)%dwet
2916
2917	counti = 0
2918	DO WHILE ( ABS( zdwet / zdold - 1.0_wp ) > 1.0E-2_wp )
2919
2920	zdold = MAX( zdwet, 1.0E-20_wp )
2921	zaw = MAX( 1.0E-3_wp, zrh / zke ) ! To avoid underflow
2922	!
2923	!-- Binary molalities (mol/kg):
2924	!-- Sulphate
2925	zbinmol(1) = 1.1065495E+2_wp - 3.6759197E+2_wp * zaw &
2926	+ 5.0462934E+2_wp * zaw**2.0_wp &
2927	- 3.1543839E+2_wp * zaw**3.0_wp &
2928	+ 6.770824E+1_wp * zaw**4.0_wp
2929	!-- Organic carbon
2930	zbinmol(2) = 1.0_wp / ( zaw * amh2o ) - 1.0_wp / amh2o
2931	!-- Nitric acid
2932	zbinmol(6) = 2.306844303E+1_wp - 3.563608869E+1_wp * zaw &
2933	- 6.210577919E+1_wp * zaw**2.0_wp &
2934	+ 5.510176187E+2_wp * zaw**3.0_wp &
2935	- 1.460055286E+3_wp * zaw**4.0_wp &
2936	+ 1.894467542E+3_wp * zaw**5.0_wp &
2937	- 1.220611402E+3_wp * zaw**6.0_wp &
2938	+ 3.098597737E+2_wp * zaw**7.0_wp
2939	!
2940	!-- Calculate the liquid water content (kg/m3-air) using ZSR (see e.g.
2941	!-- Eq. 10.98 in Seinfeld and Pandis (2006))
2942	zlwc = ( paero(b)%volc(1) * ( arhoh2so4 / amh2so4 ) ) / &
2943	zbinmol(1) + epsoc * paero(b)%volc(2) * ( arhooc / amoc ) &
2944	/ zbinmol(2) + ( paero(b)%volc(6) * ( arhohno3/amhno3 ) ) &
2945	/ zbinmol(6)
2946	!
2947	!-- Particle wet diameter (m)
2948	zdwet = ( zlwc / paero(b)%numc / arhoh2o / api6 + &
2949	( SUM( zvpart(6:7) ) / api6 ) + &
2950	zcore / api6 )**( 1.0_wp / 3.0_wp )
2951	!
2952	!-- Kelvin effect (Eq. 10.85 in in Seinfeld and Pandis (2006)). Avoid
2953	!-- overflow.
2954	zke = EXP( MIN( 50.0_wp, &
2955	4.0_wp * surfw0 * amvh2so4 / ( abo * ptemp * zdwet ) ) )
2956
2957	counti = counti + 1
2958	IF ( counti > 1000 ) THEN
2959	message_string = 'Subrange 1: no convergence!'
2960	CALL message( 'salsa_mod: equilibration', 'SA0042', &
2961	1, 2, 0, 6, 0 )
2962	ENDIF
2963	ENDDO
2964	!
2965	!-- Instead of lwc, use the volume concentration of water from now on
2966	!-- (easy to convert...)
2967	paero(b)%volc(8) = zlwc / arhoh2o
2968	!
2969	!-- If this is initialization, update the core and wet diameter
2970	IF ( init ) THEN
2971	paero(b)%dwet = zdwet
2972	paero(b)%core = zcore
2973	ENDIF
2974
2975	ELSE
2976	!-- If initialization
2977	!-- 1.2) empty bins given bin average values
2978	IF ( init ) THEN
2979	paero(b)%dwet = paero(b)%dmid
2980	paero(b)%core = api6 * paero(b)%dmid ** 3.0_wp
2981	ENDIF
2982
2983	ENDIF
2984
2985	ENDDO !< b
2986	!
2987	!-- 2) Regime 2a: sulphate, OC, BC and sea salt
2988	!-- This is done only for initialization call, otherwise the water contents
2989	!-- are computed via condensation
2990	IF ( init ) THEN
2991	DO b = in2a, fn2b
2992
2993	!-- Initialize
2994	zke = 1.02_wp
2995	zbinmol = 0.0_wp
2996	zdold = 1.0_wp
2997	!
2998	!-- 1) Particle properties calculated for non-empty bins
2999	IF ( paero(b)%numc > nclim ) THEN
3000	!
3001	!-- Volume in one particle [fxm]
3002	zvpart = 0.0_wp
3003	zvpart(1:7) = paero(b)%volc(1:7) / paero(b)%numc
3004	!
3005	!-- Total volume and wet diameter of one dry particle [fxm]
3006	zcore = SUM( zvpart(1:5) )
3007	zdwet = paero(b)%dwet
3008
3009	counti = 0
3010	DO WHILE ( ABS( zdwet / zdold - 1.0_wp ) > 1.0E-12_wp )
3011
3012	zdold = MAX( zdwet, 1.0E-20_wp )
3013	zaw = zrh / zke
3014	!
3015	!-- Binary molalities (mol/kg):
3016	!-- Sulphate
3017	zbinmol(1) = 1.1065495E+2_wp - 3.6759197E+2_wp * zaw &
3018	+ 5.0462934E+2_wp * zaw*2 - 3.1543839E+2_wp zaw**3 &
3019	+ 6.770824E+1_wp * zaw**4
3020	!-- Organic carbon
3021	zbinmol(2) = 1.0_wp / ( zaw * amh2o ) - 1.0_wp / amh2o
3022	!-- Nitric acid
3023	zbinmol(6) = 2.306844303E+1_wp - 3.563608869E+1_wp * zaw &
3024	- 6.210577919E+1_wp * zaw*2 + 5.510176187E+2_wp zaw**3 &
3025	- 1.460055286E+3_wp * zaw*4 + 1.894467542E+3_wp zaw**5 &
3026	- 1.220611402E+3_wp * zaw*6 + 3.098597737E+2_wp zaw**7
3027	!-- Sea salt (natrium chloride)
3028	zbinmol(5) = 5.875248E+1_wp - 1.8781997E+2_wp * zaw &
3029	+ 2.7211377E+2_wp * zaw*2 - 1.8458287E+2_wp zaw**3 &
3030	+ 4.153689E+1_wp * zaw**4
3031	!
3032	!-- Calculate the liquid water content (kg/m3-air)
3033	zlwc = ( paero(b)%volc(1) * ( arhoh2so4 / amh2so4 ) ) / &
3034	zbinmol(1) + epsoc * ( paero(b)%volc(2) * ( arhooc / &
3035	amoc ) ) / zbinmol(2) + ( paero(b)%volc(6) * ( arhohno3 &
3036	/ amhno3 ) ) / zbinmol(6) + ( paero(b)%volc(5) * &
3037	( arhoss / amss ) ) / zbinmol(5)
3038
3039	!-- Particle wet radius (m)
3040	zdwet = ( zlwc / paero(b)%numc / arhoh2o / api6 + &
3041	( SUM( zvpart(6:7) ) / api6 ) + &
3042	zcore / api6 ) ** ( 1.0_wp / 3.0_wp )
3043	!
3044	!-- Kelvin effect (Eq. 10.85 in Seinfeld and Pandis (2006))
3045	zke = EXP( MIN( 50.0_wp, &
3046	4.0_wp * surfw0 * amvh2so4 / ( abo * zdwet * ptemp ) ) )
3047
3048	counti = counti + 1
3049	IF ( counti > 1000 ) THEN
3050	message_string = 'Subrange 2: no convergence!'
3051	CALL message( 'salsa_mod: equilibration', 'SA0043', &
3052	1, 2, 0, 6, 0 )
3053	ENDIF
3054	ENDDO
3055	!
3056	!-- Liquid water content; instead of LWC use the volume concentration
3057	paero(b)%volc(8) = zlwc / arhoh2o
3058	paero(b)%dwet = zdwet
3059	paero(b)%core = zcore
3060
3061	ELSE
3062	!-- 2.2) empty bins given bin average values
3063	paero(b)%dwet = paero(b)%dmid
3064	paero(b)%core = api6 * paero(b)%dmid ** 3.0_wp
3065	ENDIF
3066
3067	ENDDO ! b
3068	ENDIF
3069
3070	END SUBROUTINE equilibration
3071
3072	!------------------------------------------------------------------------------!
3073	!> Description:
3074	!> ------------
3075	!> Calculation of the settling velocity vc (m/s) per aerosol size bin and
3076	!> deposition on plant canopy (lsdepo_vege).
3077	!
3078	!> Deposition is based on either the scheme presented in:
3079	!> Zhang et al. (2001), Atmos. Environ. 35, 549-560 (includes collection due to
3080	!> Brownian diffusion, impaction, interception and sedimentation)
3081	!> OR
3082	!> Petroff & Zhang (2010), Geosci. Model Dev. 3, 753-769 (includes also
3083	!> collection due to turbulent impaction)
3084	!
3085	!> Equation numbers refer to equation in Jacobson (2005): Fundamentals of
3086	!> Atmospheric Modeling, 2nd Edition.
3087	!
3088	!> Subroutine follows closely sedim_SALSA in UCLALES-SALSA written by Juha
3089	!> Tonttila (KIT/FMI) and Zubair Maalick (UEF).
3090	!> Rewritten to PALM by Mona Kurppa (UH), 2017.
3091	!
3092	!> Call for grid point i,j,k
3093	!------------------------------------------------------------------------------!
3094
3095	SUBROUTINE deposition( paero, tk, adn, mag_u, lad, kvis, Sc, vc )
3096
3097	USE plant_canopy_model_mod, &
3098	ONLY: cdc
3099
3100	IMPLICIT NONE
3101
3102	REAL(wp), INTENT(in) :: adn !< air density (kg/m3)
3103	REAL(wp), INTENT(out) :: kvis !< kinematic viscosity of air (m2/s)
3104	REAL(wp), INTENT(in) :: lad !< leaf area density (m2/m3)
3105	REAL(wp), INTENT(in) :: mag_u !< wind velocity (m/s)
3106	REAL(wp), INTENT(out) :: Sc(:) !< particle Schmidt number
3107	REAL(wp), INTENT(in) :: tk !< abs.temperature (K)
3108	REAL(wp), INTENT(out) :: vc(:) !< critical fall speed i.e. settling
3109	!< velocity of an aerosol particle (m/s)
3110	TYPE(t_section), INTENT(inout) :: paero(fn2b)
3111
3112	INTEGER(iwp) :: b !< loop index
3113	INTEGER(iwp) :: c !< loop index
3114	REAL(wp) :: avis !< molecular viscocity of air (kg/(m*s))
3115	REAL(wp), PARAMETER :: c_A = 1.249_wp !< Constants A, B and C for
3116	REAL(wp), PARAMETER :: c_B = 0.42_wp !< calculating the Cunningham
3117	REAL(wp), PARAMETER :: c_C = 0.87_wp !< slip-flow correction (Cc)
3118	!< according to Jacobson (2005),
3119	!< Eq. 15.30
3120	REAL(wp) :: Cc !< Cunningham slip-flow correction factor
3121	REAL(wp) :: Kn !< Knudsen number
3122	REAL(wp) :: lambda !< molecular mean free path (m)
3123	REAL(wp) :: mdiff !< particle diffusivity coefficient
3124	REAL(wp) :: pdn !< particle density (kg/m3)
3125	REAL(wp) :: ustar !< friction velocity (m/s)
3126	REAL(wp) :: va !< thermal speed of an air molecule (m/s)
3127	REAL(wp) :: zdwet !< wet diameter (m)
3128	!
3129	!-- Initialise
3130	Cc = 0.0_wp
3131	Kn = 0.0_wp
3132	mdiff = 0.0_wp
3133	pdn = 1500.0_wp ! default value
3134	ustar = 0.0_wp
3135	!
3136	!-- Molecular viscosity of air (Eq. 4.54)
3137	avis = 1.8325E-5_wp * ( 416.16_wp / ( tk + 120.0_wp ) ) * ( tk / &
3138	296.16_wp )**1.5_wp
3139	!
3140	!-- Kinematic viscosity (Eq. 4.55)
3141	kvis = avis / adn
3142	!
3143	!-- Thermal velocity of an air molecule (Eq. 15.32)
3144	va = SQRT( 8.0_wp * abo * tk / ( pi * am_airmol ) )
3145	!
3146	!-- Mean free path (m) (Eq. 15.24)
3147	lambda = 2.0_wp * avis / ( adn * va )
3148
3149	DO b = 1, nbins
3150
3151	IF ( paero(b)%numc < nclim ) CYCLE
3152	zdwet = paero(b)%dwet
3153	!
3154	!-- Knudsen number (Eq. 15.23)
3155	Kn = MAX( 1.0E-2_wp, lambda / ( zdwet * 0.5_wp ) ) ! To avoid underflow
3156	!
3157	!-- Cunningham slip-flow correction (Eq. 15.30)
3158	Cc = 1.0_wp + Kn * ( c_A + c_B * EXP( -c_C / Kn ) )
3159
3160	!-- Particle diffusivity coefficient (Eq. 15.29)
3161	mdiff = ( abo * tk * Cc ) / ( 3.0_wp * pi * avis * zdwet )
3162	!
3163	!-- Particle Schmidt number (Eq. 15.36)
3164	Sc(b) = kvis / mdiff
3165	!
3166	!-- Critical fall speed i.e. settling velocity (Eq. 20.4)
3167	vc(b) = MIN( 1.0_wp, terminal_vel( 0.5_wp * zdwet, pdn, adn, avis, Cc) )
3168
3169	IF ( lsdepo_vege .AND. plant_canopy .AND. lad > 0.0_wp ) THEN
3170	!
3171	!-- Friction velocity calculated following Prandtl (1925):
3172	ustar = SQRT( cdc ) * mag_u
3173	CALL depo_vege( paero, b, vc(b), mag_u, ustar, kvis, Sc(b), lad )
3174	ENDIF
3175	ENDDO
3176
3177	END SUBROUTINE deposition
3178
3179	!------------------------------------------------------------------------------!
3180	! Description:
3181	! ------------
3182	!> Calculate change in number and volume concentrations due to deposition on
3183	!> plant canopy.
3184	!------------------------------------------------------------------------------!
3185	SUBROUTINE depo_vege( paero, b, vc, mag_u, ustar, kvis_a, Sc, lad )
3186
3187	IMPLICIT NONE
3188
3189	INTEGER(iwp), INTENT(in) :: b !< loop index
3190	REAL(wp), INTENT(in) :: kvis_a !< kinematic viscosity of air (m2/s)
3191	REAL(wp), INTENT(in) :: lad !< leaf area density (m2/m3)
3192	REAL(wp), INTENT(in) :: mag_u !< wind velocity (m/s)
3193	REAL(wp), INTENT(in) :: Sc !< particle Schmidt number
3194	REAL(wp), INTENT(in) :: ustar !< friction velocity (m/s)
3195	REAL(wp), INTENT(in) :: vc !< terminal velocity (m/s)
3196	TYPE(t_section), INTENT(inout) :: paero(fn2b)
3197
3198	INTEGER(iwp) :: c !< loop index
3199	REAL(wp), PARAMETER :: c_A = 1.249_wp !< Constants A, B and C for
3200	REAL(wp), PARAMETER :: c_B = 0.42_wp !< calculating the Cunningham
3201	REAL(wp), PARAMETER :: c_C = 0.87_wp !< slip-flow correction (Cc)
3202	!< according to Jacobson (2005),
3203	!< Eq. 15.30
3204	REAL(wp) :: alpha !< parameter, Table 3 in Zhang et al. (2001)
3205	REAL(wp) :: depo !< deposition efficiency
3206	REAL(wp) :: C_Br !< coefficient for Brownian diffusion
3207	REAL(wp) :: C_IM !< coefficient for inertial impaction
3208	REAL(wp) :: C_IN !< coefficient for interception
3209	REAL(wp) :: C_IT !< coefficient for turbulent impaction
3210	REAL(wp) :: gamma !< parameter, Table 3 in Zhang et al. (2001)
3211	REAL(wp) :: par_A !< parameter A for the characteristic radius of
3212	!< collectors, Table 3 in Zhang et al. (2001)
3213	REAL(wp) :: rt !< the overall quasi-laminar resistance for
3214	!< particles
3215	REAL(wp) :: St !< Stokes number for smooth surfaces or bluff
3216	!< surface elements
3217	REAL(wp) :: tau_plus !< dimensionless particle relaxation time
3218	REAL(wp) :: v_bd !< deposition velocity due to Brownian diffusion
3219	REAL(wp) :: v_im !< deposition velocity due to impaction
3220	REAL(wp) :: v_in !< deposition velocity due to interception
3221	REAL(wp) :: v_it !< deposition velocity due to turbulent impaction
3222	!
3223	!-- Initialise
3224	depo = 0.0_wp
3225	rt = 0.0_wp
3226	St = 0.0_wp
3227	tau_plus = 0.0_wp
3228	v_bd = 0.0_wp
3229	v_im = 0.0_wp
3230	v_in = 0.0_wp
3231	v_it = 0.0_wp
3232
3233	IF ( depo_vege_type == 'zhang2001' ) THEN
3234	!
3235	!-- Parameters for the land use category 'deciduous broadleaf trees'(Table 3)
3236	par_A = 5.0E-3_wp
3237	alpha = 0.8_wp
3238	gamma = 0.56_wp
3239	!
3240	!-- Stokes number for vegetated surfaces (Seinfeld & Pandis (2006): Eq.19.24)
3241	St = vc * ustar / ( g * par_A )
3242	!
3243	!-- The overall quasi-laminar resistance for particles (Zhang et al., Eq. 5)
3244	rt = MAX( EPSILON( 1.0_wp ), ( 3.0_wp * ustar * EXP( -St*0.5_wp ) &
3245	( Sc( -gamma ) + ( St / ( alpha + St ) )2.0_wp + &
3246	0.5_wp * ( paero(b)%dwet / par_A )**2.0_wp ) ) )
3247	depo = ( rt + vc ) * lad
3248	paero(b)%numc = paero(b)%numc - depo * paero(b)%numc * dt_salsa
3249	DO c = 1, maxspec+1
3250	paero(b)%volc(c) = paero(b)%volc(c) - depo * paero(b)%volc(c) * &
3251	dt_salsa
3252	ENDDO
3253
3254	ELSEIF ( depo_vege_type == 'petroff2010' ) THEN
3255	!
3256	!-- vd = v_BD + v_IN + v_IM + v_IT + vc
3257	!-- Deposition efficiencies from Table 1. Constants from Table 2.
3258	C_Br = 1.262_wp
3259	C_IM = 0.130_wp
3260	C_IN = 0.216_wp
3261	C_IT = 0.056_wp
3262	par_A = 0.03_wp ! Here: leaf width (m)
3263	!
3264	!-- Stokes number for vegetated surfaces (Seinfeld & Pandis (2006): Eq.19.24)
3265	St = vc * ustar / ( g * par_A )
3266	!
3267	!-- Non-dimensional relexation time of the particle on top of canopy
3268	tau_plus = vc * ustar*2.0_wp / ( kvis_a g )
3269	!
3270	!-- Brownian diffusion
3271	v_bd = mag_u * C_Br * Sc*( -2.0_wp / 3.0_wp ) &
3272	( mag_u * par_A / kvis_a )**( -0.5_wp )
3273	!
3274	!-- Interception
3275	v_in = mag_u * C_IN * paero(b)%dwet / par_A * ( 2.0_wp + LOG( 2.0_wp * &
3276	par_A / paero(b)%dwet ) )
3277	!
3278	!-- Impaction: Petroff (2009) Eq. 18
3279	v_im = mag_u * C_IM * ( St / ( St + 0.47_wp ) )**2.0_wp
3280
3281	IF ( tau_plus < 20.0_wp ) THEN
3282	v_it = 2.5E-3_wp * C_IT * tau_plus**2.0_wp
3283	ELSE
3284	v_it = C_IT
3285	ENDIF
3286	depo = ( v_bd + v_in + v_im + v_it + vc ) * lad
3287	paero(b)%numc = paero(b)%numc - depo * paero(b)%numc * dt_salsa
3288	DO c = 1, maxspec+1
3289	paero(b)%volc(c) = paero(b)%volc(c) - depo * paero(b)%volc(c) * &
3290	dt_salsa
3291	ENDDO
3292	ENDIF
3293
3294	END SUBROUTINE depo_vege
3295
3296	!------------------------------------------------------------------------------!
3297	! Description:
3298	! ------------
3299	!> Calculate deposition on horizontal and vertical surfaces. Implement as
3300	!> surface flux.
3301	!------------------------------------------------------------------------------!
3302
3303	SUBROUTINE depo_topo( i, j, surf, vc, Sc, kvis, mag_u, norm )
3304
3305	USE surface_mod, &
3306	ONLY: surf_type
3307
3308	IMPLICIT NONE
3309
3310	INTEGER(iwp), INTENT(in) :: i !< loop index
3311	INTEGER(iwp), INTENT(in) :: j !< loop index
3312	REAL(wp), INTENT(in) :: kvis(:) !< kinematic viscosity of air (m2/s)
3313	REAL(wp), INTENT(in) :: mag_u(:) !< wind velocity (m/s)
3314	REAL(wp), INTENT(in) :: norm(:) !< normalisation (usually air density)
3315	REAL(wp), INTENT(in) :: Sc(:,:) !< particle Schmidt number
3316	REAL(wp), INTENT(in) :: vc(:,:) !< terminal velocity (m/s)
3317	TYPE(surf_type), INTENT(inout) :: surf !< respective surface type
3318	INTEGER(iwp) :: b !< loop index
3319	INTEGER(iwp) :: c !< loop index
3320	INTEGER(iwp) :: k !< loop index
3321	INTEGER(iwp) :: m !< loop index
3322	INTEGER(iwp) :: surf_e !< End index of surface elements at (j,i)-gridpoint
3323	INTEGER(iwp) :: surf_s !< Start index of surface elements at (j,i)-gridpoint
3324	REAL(wp) :: alpha !< parameter, Table 3 in Zhang et al. (2001)
3325	REAL(wp) :: C_Br !< coefficient for Brownian diffusion
3326	REAL(wp) :: C_IM !< coefficient for inertial impaction
3327	REAL(wp) :: C_IN !< coefficient for interception
3328	REAL(wp) :: C_IT !< coefficient for turbulent impaction
3329	REAL(wp) :: depo !< deposition efficiency
3330	REAL(wp) :: gamma !< parameter, Table 3 in Zhang et al. (2001)
3331	REAL(wp) :: par_A !< parameter A for the characteristic radius of
3332	!< collectors, Table 3 in Zhang et al. (2001)
3333	REAL(wp) :: rt !< the overall quasi-laminar resistance for
3334	!< particles
3335	REAL(wp) :: St !< Stokes number for bluff surface elements
3336	REAL(wp) :: tau_plus !< dimensionless particle relaxation time
3337	REAL(wp) :: v_bd !< deposition velocity due to Brownian diffusion
3338	REAL(wp) :: v_im !< deposition velocity due to impaction
3339	REAL(wp) :: v_in !< deposition velocity due to interception
3340	REAL(wp) :: v_it !< deposition velocity due to turbulent impaction
3341	!
3342	!-- Initialise
3343	rt = 0.0_wp
3344	St = 0.0_wp
3345	tau_plus = 0.0_wp
3346	v_bd = 0.0_wp
3347	v_im = 0.0_wp
3348	v_in = 0.0_wp
3349	v_it = 0.0_wp
3350	surf_s = surf%start_index(j,i)
3351	surf_e = surf%end_index(j,i)
3352
3353	DO m = surf_s, surf_e
3354	k = surf%k(m)
3355	DO b = 1, nbins
3356	IF ( aerosol_number(b)%conc(k,j,i) <= nclim .OR. &
3357	Sc(k+1,b) < 1.0_wp ) CYCLE
3358
3359	IF ( depo_topo_type == 'zhang2001' ) THEN
3360	!
3361	!-- Parameters for the land use category 'urban' in Table 3
3362	alpha = 1.5_wp
3363	gamma = 0.56_wp
3364	par_A = 10.0E-3_wp
3365	!
3366	!-- Stokes number for smooth surfaces or surfaces with bluff roughness
3367	!-- elements (Seinfeld and Pandis, 2nd edition (2006): Eq. 19.23)
3368	St = MAX( 0.01_wp, vc(k+1,b) * surf%us(m) ** 2.0_wp / &
3369	( g * kvis(k+1) ) )
3370	!
3371	!-- The overall quasi-laminar resistance for particles (Eq. 5)
3372	rt = MAX( EPSILON( 1.0_wp ), ( 3.0_wp * surf%us(m) * ( &
3373	Sc(k+1,b)( -gamma ) + ( St / ( alpha + St ) )2.0_wp &
3374	+ 0.5_wp * ( Ra_dry(k,j,i,b) / par_A )*2.0_wp ) &
3375	EXP( -St**0.5_wp ) ) )
3376	depo = vc(k+1,b) + rt
3377
3378	ELSEIF ( depo_topo_type == 'petroff2010' ) THEN
3379	!
3380	!-- vd = v_BD + v_IN + v_IM + v_IT + vc
3381	!-- Deposition efficiencies from Table 1. Constants from Table 2.
3382	C_Br = 1.262_wp
3383	C_IM = 0.130_wp
3384	C_IN = 0.216_wp
3385	C_IT = 0.056_wp
3386	par_A = 0.03_wp ! Here: leaf width (m)
3387	!
3388	!-- Stokes number for smooth surfaces or surfaces with bluff roughness
3389	!-- elements (Seinfeld and Pandis, 2nd edition (2006): Eq. 19.23)
3390	St = MAX( 0.01_wp, vc(k+1,b) * surf%us(m) ** 2.0_wp / &
3391	( g * kvis(k+1) ) )
3392	!
3393	!-- Non-dimensional relexation time of the particle on top of canopy
3394	tau_plus = vc(k+1,b) * surf%us(m)*2.0_wp / ( kvis(k+1) g )
3395	!
3396	!-- Brownian diffusion
3397	v_bd = mag_u(k+1) * C_Br * Sc(k+1,b)*( -2.0_wp / 3.0_wp ) &
3398	( mag_u(k+1) * par_A / kvis(k+1) )**( -0.5_wp )
3399	!
3400	!-- Interception
3401	v_in = mag_u(k+1) * C_IN * Ra_dry(k,j,i,b)/ par_A * ( 2.0_wp + &
3402	LOG( 2.0_wp * par_A / Ra_dry(k,j,i,b) ) )
3403	!
3404	!-- Impaction: Petroff (2009) Eq. 18
3405	v_im = mag_u(k+1) * C_IM * ( St / ( St + 0.47_wp ) )**2.0_wp
3406
3407	IF ( tau_plus < 20.0_wp ) THEN
3408	v_it = 2.5E-3_wp * C_IT * tau_plus**2.0_wp
3409	ELSE
3410	v_it = C_IT
3411	ENDIF
3412	depo = v_bd + v_in + v_im + v_it + vc(k+1,b)
3413
3414	ENDIF
3415	IF ( lod_aero == 3 .OR. salsa_source_mode == 'no_source' ) THEN
3416	surf%answs(m,b) = -depo * norm(k) * aerosol_number(b)%conc(k,j,i)
3417	DO c = 1, ncc_tot
3418	surf%amsws(m,(c-1)nbins+b) = -depo norm(k) * &
3419	aerosol_mass((c-1)*nbins+b)%conc(k,j,i)
3420	ENDDO ! c
3421	ELSE
3422	surf%answs(m,b) = SUM( aerosol_number(b)%source(:,j,i) ) - &
3423	MAX( 0.0_wp, depo * norm(k) * &
3424	aerosol_number(b)%conc(k,j,i) )
3425	DO c = 1, ncc_tot
3426	surf%amsws(m,(c-1)*nbins+b) = SUM( &
3427	aerosol_mass((c-1)*nbins+b)%source(:,j,i) ) - &
3428	MAX( 0.0_wp, depo * norm(k) * &
3429	aerosol_mass((c-1)*nbins+b)%conc(k,j,i) )
3430	ENDDO
3431	ENDIF
3432	ENDDO ! b
3433	ENDDO ! m
3434
3435	END SUBROUTINE depo_topo
3436
3437	!------------------------------------------------------------------------------!
3438	! Description:
3439	! ------------
3440	! Function for calculating terminal velocities for different particles sizes.
3441	!------------------------------------------------------------------------------!
3442	REAL(wp) FUNCTION terminal_vel( radius, rhop, rhoa, visc, beta )
3443
3444	IMPLICIT NONE
3445
3446	REAL(wp), INTENT(in) :: beta !< Cunningham correction factor
3447	REAL(wp), INTENT(in) :: radius !< particle radius (m)
3448	REAL(wp), INTENT(in) :: rhop !< particle density (kg/m3)
3449	REAL(wp), INTENT(in) :: rhoa !< air density (kg/m3)
3450	REAL(wp), INTENT(in) :: visc !< molecular viscosity of air (kg/(m*s))
3451
3452	REAL(wp), PARAMETER :: rhoa_ref = 1.225_wp ! reference air density (kg/m3)
3453	!
3454	!-- Stokes law with Cunningham slip correction factor
3455	terminal_vel = ( 4.0_wp * radius*2.0_wp ) ( rhop - rhoa ) * g * beta / &
3456	( 18.0_wp * visc ) ! (m/s)
3457
3458	END FUNCTION terminal_vel
3459
3460	!------------------------------------------------------------------------------!
3461	! Description:
3462	! ------------
3463	!> Calculates particle loss and change in size distribution due to (Brownian)
3464	!> coagulation. Only for particles with dwet < 30 micrometres.
3465	!
3466	!> Method:
3467	!> Semi-implicit, non-iterative method: (Jacobson, 1994)
3468	!> Volume concentrations of the smaller colliding particles added to the bin of
3469	!> the larger colliding particles. Start from first bin and use the updated
3470	!> number and volume for calculation of following bins. NB! Our bin numbering
3471	!> does not follow particle size in subrange 2.
3472	!
3473	!> Schematic for bin numbers in different subranges:
3474	!> 1 2
3475	!> +-------------------------------------------+
3476	!> a \| 1 \| 2 \| 3 \|\| 4 \| 5 \| 6 \| 7 \| 8 \| 9 \| 10\|\|
3477	!> b \| \|\|11 \|12 \|13 \|14 \| 15 \| 16 \| 17\|\|
3478	!> +-------------------------------------------+
3479	!
3480	!> Exact coagulation coefficients for each pressure level are scaled according
3481	!> to current particle wet size (linear scaling).
3482	!> Bins are organized in terms of the dry size of the condensation nucleus,
3483	!> while coagulation kernell is calculated with the actual hydrometeor
3484	!> size.
3485	!
3486	!> Called from salsa_driver
3487	!> fxm: Process selection should be made smarter - now just lots of IFs inside
3488	!> loops
3489	!
3490	!> Coded by:
3491	!> Hannele Korhonen (FMI) 2005
3492	!> Harri Kokkola (FMI) 2006
3493	!> Tommi Bergman (FMI) 2012
3494	!> Matti Niskanen(FMI) 2012
3495	!> Anton Laakso (FMI) 2013
3496	!> Juha Tonttila (FMI) 2014
3497	!------------------------------------------------------------------------------!
3498	SUBROUTINE coagulation( paero, ptstep, ptemp, ppres )
3499
3500	IMPLICIT NONE
3501
3502	!-- Input and output variables
3503	TYPE(t_section), INTENT(inout) :: paero(fn2b) !< Aerosol properties
3504	REAL(wp), INTENT(in) :: ppres !< ambient pressure (Pa)
3505	REAL(wp), INTENT(in) :: ptemp !< ambient temperature (K)
3506	REAL(wp), INTENT(in) :: ptstep !< time step (s)
3507	!-- Local variables
3508	INTEGER(iwp) :: index_2a !< corresponding bin in subrange 2a
3509	INTEGER(iwp) :: index_2b !< corresponding bin in subrange 2b
3510	INTEGER(iwp) :: b !< loop index
3511	INTEGER(iwp) :: ll !< loop index
3512	INTEGER(iwp) :: mm !< loop index
3513	INTEGER(iwp) :: nn !< loop index
3514	REAL(wp) :: pressi !< pressure
3515	REAL(wp) :: temppi !< temperature
3516	REAL(wp) :: zcc(fn2b,fn2b) !< updated coagulation coefficients (m3/s)
3517	REAL(wp) :: zdpart_mm !< diameter of particle (m)
3518	REAL(wp) :: zdpart_nn !< diameter of particle (m)
3519	REAL(wp) :: zminusterm !< coagulation loss in a bin (1/s)
3520	REAL(wp) :: zplusterm(8) !< coagulation gain in a bin (fxm/s)
3521	!< (for each chemical compound)
3522	REAL(wp) :: zmpart(fn2b) !< approximate mass of particles (kg)
3523
3524	zcc = 0.0_wp
3525	zmpart = 0.0_wp
3526	zdpart_mm = 0.0_wp
3527	zdpart_nn = 0.0_wp
3528	!
3529	!-- 1) Coagulation to coarse mode calculated in a simplified way:
3530	!-- CoagSink ~ Dp in continuum subrange, thus we calculate 'effective'
3531	!-- number concentration of coarse particles
3532
3533	!-- 2) Updating coagulation coefficients
3534	!
3535	!-- Aerosol mass (kg). Density of 1500 kg/m3 assumed
3536	zmpart(1:fn2b) = api6 * ( MIN( paero(1:fn2b)%dwet, 30.0E-6_wp )**3.0_wp ) &
3537	* 1500.0_wp
3538	temppi = ptemp
3539	pressi = ppres
3540	zcc = 0.0_wp
3541	!
3542	!-- Aero-aero coagulation
3543	DO mm = 1, fn2b ! smaller colliding particle
3544	IF ( paero(mm)%numc < nclim ) CYCLE
3545	DO nn = mm, fn2b ! larger colliding particle
3546	IF ( paero(nn)%numc < nclim ) CYCLE
3547
3548	zdpart_mm = MIN( paero(mm)%dwet, 30.0E-6_wp ) ! Limit to 30 um
3549	zdpart_nn = MIN( paero(nn)%dwet, 30.0E-6_wp ) ! Limit to 30 um
3550	!
3551	!-- Coagulation coefficient of particles (m3/s)
3552	zcc(mm,nn) = coagc( zdpart_mm, zdpart_nn, zmpart(mm), zmpart(nn), &
3553	temppi, pressi )
3554	zcc(nn,mm) = zcc(mm,nn)
3555	ENDDO
3556	ENDDO
3557
3558	!
3559	!-- 3) New particle and volume concentrations after coagulation:
3560	!-- Calculated according to Jacobson (2005) eq. 15.9
3561	!
3562	!-- Aerosols in subrange 1a:
3563	DO b = in1a, fn1a
3564	IF ( paero(b)%numc < nclim ) CYCLE
3565	zminusterm = 0.0_wp
3566	zplusterm(:) = 0.0_wp
3567	!
3568	!-- Particles lost by coagulation with larger aerosols
3569	DO ll = b+1, fn2b
3570	zminusterm = zminusterm + zcc(b,ll) * paero(ll)%numc
3571	ENDDO
3572	!
3573	!-- Coagulation gain in a bin: change in volume conc. (cm3/cm3):
3574	DO ll = in1a, b-1
3575	zplusterm(1:2) = zplusterm(1:2) + zcc(ll,b) * paero(ll)%volc(1:2)
3576	zplusterm(6:7) = zplusterm(6:7) + zcc(ll,b) * paero(ll)%volc(6:7)
3577	zplusterm(8) = zplusterm(8) + zcc(ll,b) * paero(ll)%volc(8)
3578	ENDDO
3579	!
3580	!-- Volume and number concentrations after coagulation update [fxm]
3581	paero(b)%volc(1:2) = ( paero(b)%volc(1:2) + ptstep * zplusterm(1:2) * &
3582	paero(b)%numc ) / ( 1.0_wp + ptstep * zminusterm )
3583	paero(b)%volc(6:7) = ( paero(b)%volc(6:7) + ptstep * zplusterm(6:7) * &
3584	paero(b)%numc ) / ( 1.0_wp + ptstep * zminusterm )
3585	paero(b)%volc(8) = ( paero(b)%volc(8) + ptstep * zplusterm(8) * &
3586	paero(b)%numc ) / ( 1.0_wp + ptstep * zminusterm )
3587	paero(b)%numc = paero(b)%numc / ( 1.0_wp + ptstep * zminusterm + &
3588	0.5_wp * ptstep * zcc(b,b) * paero(b)%numc )
3589	ENDDO
3590	!
3591	!-- Aerosols in subrange 2a:
3592	DO b = in2a, fn2a
3593	IF ( paero(b)%numc < nclim ) CYCLE
3594	zminusterm = 0.0_wp
3595	zplusterm(:) = 0.0_wp
3596	!
3597	!-- Find corresponding size bin in subrange 2b
3598	index_2b = b - in2a + in2b
3599	!
3600	!-- Particles lost by larger particles in 2a
3601	DO ll = b+1, fn2a
3602	zminusterm = zminusterm + zcc(b,ll) * paero(ll)%numc
3603	ENDDO
3604	!
3605	!-- Particles lost by larger particles in 2b
3606	IF ( .NOT. no_insoluble ) THEN
3607	DO ll = index_2b+1, fn2b
3608	zminusterm = zminusterm + zcc(b,ll) * paero(ll)%numc
3609	ENDDO
3610	ENDIF
3611	!
3612	!-- Particle volume gained from smaller particles in subranges 1, 2a and 2b
3613	DO ll = in1a, b-1
3614	zplusterm(1:2) = zplusterm(1:2) + zcc(ll,b) * paero(ll)%volc(1:2)
3615	zplusterm(6:7) = zplusterm(6:7) + zcc(ll,b) * paero(ll)%volc(6:7)
3616	zplusterm(8) = zplusterm(8) + zcc(ll,b) * paero(ll)%volc(8)
3617	ENDDO
3618	!
3619	!-- Particle volume gained from smaller particles in 2a
3620	!-- (Note, for components not included in the previous loop!)
3621	DO ll = in2a, b-1
3622	zplusterm(3:5) = zplusterm(3:5) + zcc(ll,b)*paero(ll)%volc(3:5)
3623	ENDDO
3624
3625	!
3626	!-- Particle volume gained from smaller (and equal) particles in 2b
3627	IF ( .NOT. no_insoluble ) THEN
3628	DO ll = in2b, index_2b
3629	zplusterm(1:8) = zplusterm(1:8) + zcc(ll,b) * paero(ll)%volc(1:8)
3630	ENDDO
3631	ENDIF
3632	!
3633	!-- Volume and number concentrations after coagulation update [fxm]
3634	paero(b)%volc(1:8) = ( paero(b)%volc(1:8) + ptstep * zplusterm(1:8) * &
3635	paero(b)%numc ) / ( 1.0_wp + ptstep * zminusterm )
3636	paero(b)%numc = paero(b)%numc / ( 1.0_wp + ptstep * zminusterm + &
3637	0.5_wp * ptstep * zcc(b,b) * paero(b)%numc )
3638	ENDDO
3639	!
3640	!-- Aerosols in subrange 2b:
3641	IF ( .NOT. no_insoluble ) THEN
3642	DO b = in2b, fn2b
3643	IF ( paero(b)%numc < nclim ) CYCLE
3644	zminusterm = 0.0_wp
3645	zplusterm(:) = 0.0_wp
3646	!
3647	!-- Find corresponding size bin in subsubrange 2a
3648	index_2a = b - in2b + in2a
3649	!
3650	!-- Particles lost to larger particles in subranges 2b
3651	DO ll = b+1, fn2b
3652	zminusterm = zminusterm + zcc(b,ll) * paero(ll)%numc
3653	ENDDO
3654	!
3655	!-- Particles lost to larger and equal particles in 2a
3656	DO ll = index_2a, fn2a
3657	zminusterm = zminusterm + zcc(b,ll) * paero(ll)%numc
3658	ENDDO
3659	!
3660	!-- Particle volume gained from smaller particles in subranges 1 & 2a
3661	DO ll = in1a, index_2a-1
3662	zplusterm(1:8) = zplusterm(1:8) + zcc(ll,b) * paero(ll)%volc(1:8)
3663	ENDDO
3664	!
3665	!-- Particle volume gained from smaller particles in 2b
3666	DO ll = in2b, b-1
3667	zplusterm(1:8) = zplusterm(1:8) + zcc(ll,b) * paero(ll)%volc(1:8)
3668	ENDDO
3669	!
3670	!-- Volume and number concentrations after coagulation update [fxm]
3671	paero(b)%volc(1:8) = ( paero(b)%volc(1:8) + ptstep * zplusterm(1:8)&
3672	* paero(b)%numc ) / ( 1.0_wp + ptstep * zminusterm )
3673	paero(b)%numc = paero(b)%numc / ( 1.0_wp + ptstep * zminusterm + &
3674	0.5_wp * ptstep * zcc(b,b) * paero(b)%numc )
3675	ENDDO
3676	ENDIF
3677
3678	END SUBROUTINE coagulation
3679
3680	!------------------------------------------------------------------------------!
3681	! Description:
3682	! ------------
3683	!> Calculation of coagulation coefficients. Extended version of the function
3684	!> originally found in mo_salsa_init.
3685	!
3686	!> J. Tonttila, FMI, 05/2014
3687	!------------------------------------------------------------------------------!
3688	REAL(wp) FUNCTION coagc( diam1, diam2, mass1, mass2, temp, pres )
3689
3690	IMPLICIT NONE
3691	!
3692	!-- Input and output variables
3693	REAL(wp), INTENT(in) :: diam1 !< diameter of colliding particle 1 (m)
3694	REAL(wp), INTENT(in) :: diam2 !< diameter of colliding particle 2 (m)
3695	REAL(wp), INTENT(in) :: mass1 !< mass of colliding particle 1 (kg)
3696	REAL(wp), INTENT(in) :: mass2 !< mass of colliding particle 2 (kg)
3697	REAL(wp), INTENT(in) :: pres !< ambient pressure (Pa?) [fxm]
3698	REAL(wp), INTENT(in) :: temp !< ambient temperature (K)
3699	!
3700	!-- Local variables
3701	REAL(wp) :: fmdist !< distance of flux matching (m)
3702	REAL(wp) :: knud_p !< particle Knudsen number
3703	REAL(wp) :: mdiam !< mean diameter of colliding particles (m)
3704	REAL(wp) :: mfp !< mean free path of air molecules (m)
3705	REAL(wp) :: visc !< viscosity of air (kg/(m s))
3706	REAL(wp), DIMENSION (2) :: beta !< Cunningham correction factor
3707	REAL(wp), DIMENSION (2) :: dfpart !< particle diffusion coefficient
3708	!< (m2/s)
3709	REAL(wp), DIMENSION (2) :: diam !< diameters of particles (m)
3710	REAL(wp), DIMENSION (2) :: flux !< flux in continuum and free molec.
3711	!< regime (m/s)
3712	REAL(wp), DIMENSION (2) :: knud !< particle Knudsen number
3713	REAL(wp), DIMENSION (2) :: mpart !< masses of particles (kg)
3714	REAL(wp), DIMENSION (2) :: mtvel !< particle mean thermal velocity (m/s)
3715	REAL(wp), DIMENSION (2) :: omega !< particle mean free path
3716	REAL(wp), DIMENSION (2) :: tva !< temporary variable (m)
3717	!
3718	!-- Initialisation
3719	coagc = 0.0_wp
3720	!
3721	!-- 1) Initializing particle and ambient air variables
3722	diam = (/ diam1, diam2 /) !< particle diameters (m)
3723	mpart = (/ mass1, mass2 /) !< particle masses (kg)
3724	!-- Viscosity of air (kg/(m s))
3725	visc = ( 7.44523E-3_wp * temp ** 1.5_wp ) / &
3726	( 5093.0_wp * ( temp + 110.4_wp ) )
3727	!-- Mean free path of air (m)
3728	mfp = ( 1.656E-10_wp * temp + 1.828E-8_wp ) * ( p_0 + 1325.0_wp ) / pres
3729	!
3730	!-- 2) Slip correction factor for small particles
3731	knud = 2.0_wp * EXP( LOG(mfp) - LOG(diam) )! Knudsen number for air (15.23)
3732	!-- Cunningham correction factor (Allen and Raabe, Aerosol Sci. Tech. 4, 269)
3733	beta = 1.0_wp + knud * ( 1.142_wp + 0.558_wp * EXP( -0.999_wp / knud ) )
3734	!
3735	!-- 3) Particle properties
3736	!-- Diffusion coefficient (m2/s) (Jacobson (2005) eq. 15.29)
3737	dfpart = beta * abo * temp / ( 3.0_wp * pi * visc * diam )
3738	!-- Mean thermal velocity (m/s) (Jacobson (2005) eq. 15.32)
3739	mtvel = SQRT( ( 8.0_wp * abo * temp ) / ( pi * mpart ) )
3740	!-- Particle mean free path (m) (Jacobson (2005) eq. 15.34 )
3741	omega = 8.0_wp * dfpart / ( pi * mtvel )
3742	!-- Mean diameter (m)
3743	mdiam = 0.5_wp * ( diam(1) + diam(2) )
3744	!
3745	!-- 4) Calculation of fluxes (Brownian collision kernels) and flux matching
3746	!-- following Jacobson (2005):
3747	!-- Flux in continuum regime (m3/s) (eq. 15.28)
3748	flux(1) = 4.0_wp * pi * mdiam * ( dfpart(1) + dfpart(2) )
3749	!-- Flux in free molec. regime (m3/s) (eq. 15.31)
3750	flux(2) = pi * SQRT( ( mtvel(1)2.0_wp ) + ( mtvel(2)2.0_wp ) ) * &
3751	( mdiam**2.0_wp )
3752	!-- temporary variables (m) to calculate flux matching distance (m)
3753	tva(1) = ( ( mdiam + omega(1) )3.0_wp - ( mdiam2.0_wp + &
3754	omega(1)*2.0_wp ) SQRT( ( mdiam2.0_wp + omega(1)2.0_wp ) &
3755	) ) / ( 3.0_wp * mdiam * omega(1) ) - mdiam
3756	tva(2) = ( ( mdiam + omega(2) )3.0_wp - ( mdiam2.0_wp + &
3757	omega(2)*2.0_wp ) SQRT( ( mdiam2 + omega(2)2 ) ) ) / &
3758	( 3.0_wp * mdiam * omega(2) ) - mdiam
3759	!-- Flux matching distance (m) i.e. the mean distance from the centre of a
3760	!-- sphere reached by particles leaving sphere's surface and travelling a
3761	!-- distance of particle mean free path mfp (eq. 15 34)
3762	fmdist = SQRT( tva(1)2 + tva(2)2.0_wp)
3763	!
3764	!-- 5) Coagulation coefficient (m3/s) (eq. 15.33). Here assumed
3765	!-- coalescence efficiency 1!!
3766	coagc = flux(1) / ( mdiam / ( mdiam + fmdist) + flux(1) / flux(2) )
3767	!-- coagulation coefficient = coalescence efficiency * collision kernel
3768	!
3769	!-- Corrected collision kernel following Karl et al., 2016 (ACP):
3770	!-- Inclusion of van der Waals and viscous forces
3771	IF ( van_der_waals_coagc ) THEN
3772	knud_p = SQRT( omega(1)2 + omega(2)2 ) / mdiam
3773	IF ( knud_p >= 0.1_wp .AND. knud_p <= 10.0_wp ) THEN
3774	coagc = coagc * ( 2.0_wp + 0.4_wp * LOG( knud_p ) )
3775	ELSE
3776	coagc = coagc * 3.0_wp
3777	ENDIF
3778	ENDIF
3779
3780	END FUNCTION coagc
3781
3782	!------------------------------------------------------------------------------!
3783	! Description:
3784	! ------------
3785	!> Calculates the change in particle volume and gas phase
3786	!> concentrations due to nucleation, condensation and dissolutional growth.
3787	!
3788	!> Sulphuric acid and organic vapour: only condensation and no evaporation.
3789	!
3790	!> New gas and aerosol phase concentrations calculated according to Jacobson
3791	!> (1997): Numerical techniques to solve condensational and dissolutional growth
3792	!> equations when growth is coupled to reversible reactions, Aerosol Sci. Tech.,
3793	!> 27, pp 491-498.
3794	!
3795	!> Following parameterization has been used:
3796	!> Molecular diffusion coefficient of condensing vapour (m2/s)
3797	!> (Reid et al. (1987): Properties of gases and liquids, McGraw-Hill, New York.)
3798	!> D = {1.d-7sqrt(1/M_air + 1/M_gas)T^1.75} / &
3799	! {p_atm/p_stand * (d_air^(1/3) + d_gas^(1/3))^2 }
3800	! M_air = 28.965 : molar mass of air (g/mol)
3801	! d_air = 19.70 : diffusion volume of air
3802	! M_h2so4 = 98.08 : molar mass of h2so4 (g/mol)
3803	! d_h2so4 = 51.96 : diffusion volume of h2so4
3804	!
3805	!> Called from main aerosol model
3806	!
3807	!> fxm: calculated for empty bins too
3808	!> fxm: same diffusion coefficients and mean free paths used for sulphuric acid
3809	!> and organic vapours (average values? 'real' values for each?)
3810	!> fxm: one should really couple with vapour production and loss terms as well
3811	!> should nucleation be coupled here as well????
3812	!
3813	! Coded by:
3814	! Hannele Korhonen (FMI) 2005
3815	! Harri Kokkola (FMI) 2006
3816	! Juha Tonttila (FMI) 2014
3817	! Rewritten to PALM by Mona Kurppa (UHel) 2017
3818	!------------------------------------------------------------------------------!
3819	SUBROUTINE condensation( paero, pcsa, pcocnv, pcocsv, pchno3, pcnh3, pcw, pcs,&
3820	ptemp, ppres, ptstep, prtcl )
3821
3822	IMPLICIT NONE
3823
3824	!-- Input and output variables
3825	REAL(wp), INTENT(IN) :: ppres !< ambient pressure (Pa)
3826	REAL(wp), INTENT(IN) :: pcs !< Water vapour saturation concentration
3827	!< (kg/m3)
3828	REAL(wp), INTENT(IN) :: ptemp !< ambient temperature (K)
3829	REAL(wp), INTENT(IN) :: ptstep !< timestep (s)
3830	TYPE(component_index), INTENT(in) :: prtcl !< Keeps track which substances
3831	!< are used
3832	REAL(wp), INTENT(INOUT) :: pchno3 !< Gas concentrations (#/m3):
3833	!< nitric acid HNO3
3834	REAL(wp), INTENT(INOUT) :: pcnh3 !< ammonia NH3
3835	REAL(wp), INTENT(INOUT) :: pcocnv !< non-volatile organics
3836	REAL(wp), INTENT(INOUT) :: pcocsv !< semi-volatile organics
3837	REAL(wp), INTENT(INOUT) :: pcsa !< sulphuric acid H2SO4
3838	REAL(wp), INTENT(INOUT) :: pcw !< Water vapor concentration (kg/m3)
3839	TYPE(t_section), INTENT(inout) :: paero(fn2b) !< Aerosol properties
3840	!-- Local variables
3841	REAL(wp) :: zbeta(fn2b) !< transitional correction factor for aerosols
3842	REAL(wp) :: zcolrate(fn2b) !< collision rate of molecules to particles
3843	!< (1/s)
3844	REAL(wp) :: zcolrate_ocnv(fn2b) !< collision rate of organic molecules
3845	!< to particles (1/s)
3846	REAL(wp) :: zcs_ocnv !< condensation sink of nonvolatile organics (1/s)
3847	REAL(wp) :: zcs_ocsv !< condensation sink of semivolatile organics (1/s)
3848	REAL(wp) :: zcs_su !< condensation sink of sulfate (1/s)
3849	REAL(wp) :: zcs_tot!< total condensation sink (1/s) (gases)
3850	!-- vapour concentration after time step (#/m3)
3851	REAL(wp) :: zcvap_new1 !< sulphuric acid
3852	REAL(wp) :: zcvap_new2 !< nonvolatile organics
3853	REAL(wp) :: zcvap_new3 !< semivolatile organics
3854	REAL(wp) :: zdfpart(in1a+1) !< particle diffusion coefficient (m2/s)
3855	REAL(wp) :: zdfvap !< air diffusion coefficient (m2/s)
3856	!-- change in vapour concentration (#/m3)
3857	REAL(wp) :: zdvap1 !< sulphuric acid
3858	REAL(wp) :: zdvap2 !< nonvolatile organics
3859	REAL(wp) :: zdvap3 !< semivolatile organics
3860	REAL(wp) :: zdvoloc(fn2b) !< change of organics volume in each bin [fxm]
3861	REAL(wp) :: zdvolsa(fn2b) !< change of sulphate volume in each bin [fxm]
3862	REAL(wp) :: zj3n3(2) !< Formation massrate of molecules in
3863	!< nucleation, (molec/m3s). 1: H2SO4
3864	!< and 2: organic vapor
3865	REAL(wp) :: zknud(fn2b) !< particle Knudsen number
3866	REAL(wp) :: zmfp !< mean free path of condensing vapour (m)
3867	REAL(wp) :: zrh !< Relative humidity [0-1]
3868	REAL(wp) :: zvisc !< viscosity of air (kg/(m s))
3869	REAL(wp) :: zn_vs_c !< ratio of nucleation of all mass transfer in the
3870	!< smallest bin
3871	REAL(wp) :: zxocnv !< ratio of organic vapour in 3nm particles
3872	REAL(wp) :: zxsa !< Ratio in 3nm particles: sulphuric acid
3873
3874	zj3n3 = 0.0_wp
3875	zrh = pcw / pcs
3876	zxocnv = 0.0_wp
3877	zxsa = 0.0_wp
3878	!
3879	!-- Nucleation
3880	IF ( nsnucl > 0 ) THEN
3881	CALL nucleation( paero, ptemp, zrh, ppres, pcsa, pcocnv, pcnh3, ptstep, &
3882	zj3n3, zxsa, zxocnv )
3883	ENDIF
3884	!
3885	!-- Condensation on pre-existing particles
3886	IF ( lscndgas ) THEN
3887	!
3888	!-- Initialise:
3889	zdvolsa = 0.0_wp
3890	zdvoloc = 0.0_wp
3891	zcolrate = 0.0_wp
3892	!
3893	!-- 1) Properties of air and condensing gases:
3894	!-- Viscosity of air (kg/(m s)) (Eq. 4.54 in Jabonson (2005))
3895	zvisc = ( 7.44523E-3_wp * ptemp ** 1.5_wp ) / ( 5093.0_wp * &
3896	( ptemp + 110.4_wp ) )
3897	!-- Diffusion coefficient of air (m2/s)
3898	zdfvap = 5.1111E-10_wp * ptemp ** 1.75_wp * ( p_0 + 1325.0_wp ) / ppres
3899	!-- Mean free path (m): same for H2SO4 and organic compounds
3900	zmfp = 3.0_wp * zdfvap * SQRT( pi * amh2so4 / ( 8.0_wp * argas * ptemp ) )
3901	!
3902	!-- 2) Transition regime correction factor zbeta for particles:
3903	!-- Fuchs and Sutugin (1971), In: Hidy et al. (ed.) Topics in current
3904	!-- aerosol research, Pergamon. Size of condensing molecule considered
3905	!-- only for nucleation mode (3 - 20 nm)
3906	!
3907	!-- Particle Knudsen number: condensation of gases on aerosols
3908	zknud(in1a:in1a+1) = 2.0_wp * zmfp / ( paero(in1a:in1a+1)%dwet + d_sa )
3909	zknud(in1a+2:fn2b) = 2.0_wp * zmfp / paero(in1a+2:fn2b)%dwet
3910	!
3911	!-- Transitional correction factor: aerosol + gas (the semi-empirical Fuchs-
3912	!-- Sutugin interpolation function (Fuchs and Sutugin, 1971))
3913	zbeta = ( zknud + 1.0_wp ) / ( 0.377_wp * zknud + 1.0_wp + 4.0_wp / &
3914	( 3.0_wp * massacc ) * ( zknud + zknud ** 2.0_wp ) )
3915	!
3916	!-- 3) Collision rate of molecules to particles
3917	!-- Particle diffusion coefficient considered only for nucleation mode
3918	!-- (3 - 20 nm)
3919	!
3920	!-- Particle diffusion coefficient (m2/s) (e.g. Eq. 15.29 in Jacobson (2005))
3921	zdfpart = abo * ptemp * zbeta(in1a:in1a+1) / ( 3.0_wp * pi * zvisc * &
3922	paero(in1a:in1a+1)%dwet )
3923	!
3924	!-- Collision rate (mass-transfer coefficient): gases on aerosols (1/s)
3925	!-- (Eq. 16.64 in Jacobson (2005))
3926	zcolrate(in1a:in1a+1) = MERGE( 2.0_wp * pi * &
3927	( paero(in1a:in1a+1)%dwet + d_sa ) * &
3928	( zdfvap + zdfpart ) * zbeta(in1a:in1a+1)&
3929	* paero(in1a:in1a+1)%numc, 0.0_wp, &
3930	paero(in1a:in1a+1)%numc > nclim )
3931	zcolrate(in1a+2:fn2b) = MERGE( 2.0_wp * pi * paero(in1a+2:fn2b)%dwet * &
3932	zdfvap * zbeta(in1a+2:fn2b) * &
3933	paero(in1a+2:fn2b)%numc, 0.0_wp, &
3934	paero(in1a+2:fn2b)%numc > nclim )
3935	!
3936	!-- 4) Condensation sink (1/s)
3937	zcs_tot = SUM( zcolrate ) ! total sink
3938	!
3939	!-- 5) Changes in gas-phase concentrations and particle volume
3940	!
3941	!-- 5.1) Organic vapours
3942	!
3943	!-- 5.1.1) Non-volatile organic compound: condenses onto all bins
3944	IF ( pcocnv > 1.0E+10_wp .AND. zcs_tot > 1.0E-30_wp .AND. &
3945	is_used( prtcl,'OC' ) ) &
3946	THEN
3947	!-- Ratio of nucleation vs. condensation rates in the smallest bin
3948	zn_vs_c = 0.0_wp
3949	IF ( zj3n3(2) > 1.0_wp ) THEN
3950	zn_vs_c = ( zj3n3(2) ) / ( zj3n3(2) + pcocnv * zcolrate(in1a) )
3951	ENDIF
3952	!
3953	!-- Collision rate in the smallest bin, including nucleation and
3954	!-- condensation(see Jacobson, Fundamentals of Atmospheric Modeling, 2nd
3955	!-- Edition (2005), equation (16.73) )
3956	zcolrate_ocnv = zcolrate
3957	zcolrate_ocnv(in1a) = zcolrate_ocnv(in1a) + zj3n3(2) / pcocnv
3958	!
3959	!-- Total sink for organic vapor
3960	zcs_ocnv = zcs_tot + zj3n3(2) / pcocnv
3961	!
3962	!-- New gas phase concentration (#/m3)
3963	zcvap_new2 = pcocnv / ( 1.0_wp + ptstep * zcs_ocnv )
3964	!
3965	!-- Change in gas concentration (#/m3)
3966	zdvap2 = pcocnv - zcvap_new2
3967	!
3968	!-- Updated vapour concentration (#/m3)
3969	pcocnv = zcvap_new2
3970	!
3971	!-- Volume change of particles (m3(OC)/m3(air))
3972	zdvoloc = zcolrate_ocnv(in1a:fn2b) / zcs_ocnv * amvoc * zdvap2
3973	!
3974	!-- Change of volume due to condensation in 1a-2b
3975	paero(in1a:fn2b)%volc(2) = paero(in1a:fn2b)%volc(2) + zdvoloc
3976	!
3977	!-- Change of number concentration in the smallest bin caused by
3978	!-- nucleation (Jacobson (2005), equation (16.75)). If zxocnv = 0, then
3979	!-- the chosen nucleation mechanism doesn't take into account the non-
3980	!-- volatile organic vapors and thus the paero doesn't have to be updated.
3981	IF ( zxocnv > 0.0_wp ) THEN
3982	paero(in1a)%numc = paero(in1a)%numc + zn_vs_c * zdvoloc(in1a) / &
3983	amvoc / ( n3 * zxocnv )
3984	ENDIF
3985	ENDIF
3986	!
3987	!-- 5.1.2) Semivolatile organic compound: all bins except subrange 1
3988	zcs_ocsv = SUM( zcolrate(in2a:fn2b) ) !< sink for semi-volatile organics
3989	IF ( pcocsv > 1.0E+10_wp .AND. zcs_ocsv > 1.0E-30 .AND. &
3990	is_used( prtcl,'OC') ) &
3991	THEN
3992	!
3993	!-- New gas phase concentration (#/m3)
3994	zcvap_new3 = pcocsv / ( 1.0_wp + ptstep * zcs_ocsv )
3995	!
3996	!-- Change in gas concentration (#/m3)
3997	zdvap3 = pcocsv - zcvap_new3
3998	!
3999	!-- Updated gas concentration (#/m3)
4000	pcocsv = zcvap_new3
4001	!
4002	!-- Volume change of particles (m3(OC)/m3(air))
4003	zdvoloc(in2a:fn2b) = zdvoloc(in2a:fn2b) + zcolrate(in2a:fn2b) / &
4004	zcs_ocsv * amvoc * zdvap3
4005	!
4006	!-- Change of volume due to condensation in 1a-2b
4007	paero(in1a:fn2b)%volc(2) = paero(in1a:fn2b)%volc(2) + zdvoloc
4008	ENDIF
4009	!
4010	!-- 5.2) Sulphate: condensed on all bins
4011	IF ( pcsa > 1.0E+10_wp .AND. zcs_tot > 1.0E-30_wp .AND. &
4012	is_used( prtcl,'SO4' ) ) &
4013	THEN
4014	!
4015	!-- Ratio of mass transfer between nucleation and condensation
4016	zn_vs_c = 0.0_wp
4017	IF ( zj3n3(1) > 1.0_wp ) THEN
4018	zn_vs_c = ( zj3n3(1) ) / ( zj3n3(1) + pcsa * zcolrate(in1a) )
4019	ENDIF
4020	!
4021	!-- Collision rate in the smallest bin, including nucleation and
4022	!-- condensation (see Jacobson, Fundamentals of Atmospheric Modeling, 2nd
4023	!-- Edition (2005), equation (16.73))
4024	zcolrate(in1a) = zcolrate(in1a) + zj3n3(1) / pcsa
4025	!
4026	!-- Total sink for sulfate (1/s)
4027	zcs_su = zcs_tot + zj3n3(1) / pcsa
4028	!
4029	!-- Sulphuric acid:
4030	!-- New gas phase concentration (#/m3)
4031	zcvap_new1 = pcsa / ( 1.0_wp + ptstep * zcs_su )
4032	!
4033	!-- Change in gas concentration (#/m3)
4034	zdvap1 = pcsa - zcvap_new1
4035	!
4036	!-- Updating vapour concentration (#/m3)
4037	pcsa = zcvap_new1
4038	!
4039	!-- Volume change of particles (m3(SO4)/m3(air)) by condensation
4040	zdvolsa = zcolrate(in1a:fn2b) / zcs_su * amvh2so4 * zdvap1
4041	!-- For validation: zdvolsa = 5.5 mum3/cm3 per 12 h
4042	! zdvolsa = zdvolsa / SUM( zdvolsa ) * 5.5E-12_wp * dt_salsa / 43200.0_wp
4043	!0.3E-12_wp, 0.6E-12_wp, 11.0E-12_wp, 4.6E-12_wp, 9.2E-12_wp
4044	!
4045	!-- Change of volume concentration of sulphate in aerosol [fxm]
4046	paero(in1a:fn2b)%volc(1) = paero(in1a:fn2b)%volc(1) + zdvolsa
4047	!
4048	!-- Change of number concentration in the smallest bin caused by nucleation
4049	!-- (Jacobson (2005), equation (16.75))
4050	IF ( zxsa > 0.0_wp ) THEN
4051	paero(in1a)%numc = paero(in1a)%numc + zn_vs_c * zdvolsa(in1a) / &
4052	amvh2so4 / ( n3 * zxsa )
4053	ENDIF
4054	ENDIF
4055	ENDIF
4056	!
4057	!
4058	!-- Condensation of water vapour
4059	IF ( lscndh2oae ) THEN
4060	CALL gpparth2o( paero, ptemp, ppres, pcs, pcw, ptstep )
4061	ENDIF
4062	!
4063	!
4064	!-- Partitioning of H2O, HNO3, and NH3: Dissolutional growth
4065	IF ( lscndgas .AND. ino > 0 .AND. inh > 0 .AND. &
4066	( pchno3 > 1.0E+10_wp .OR. pcnh3 > 1.0E+10_wp ) ) &
4067	THEN
4068	CALL gpparthno3( ppres, ptemp, paero, pchno3, pcnh3, pcw, pcs, zbeta, &
4069	ptstep )
4070	ENDIF
4071
4072	END SUBROUTINE condensation
4073
4074	!------------------------------------------------------------------------------!
4075	! Description:
4076	! ------------
4077	!> Calculates the particle number and volume increase, and gas-phase
4078	!> concentration decrease due to nucleation subsequent growth to detectable size
4079	!> of 3 nm.
4080	!
4081	!> Method:
4082	!> When the formed clusters grow by condensation (possibly also by self-
4083	!> coagulation), their number is reduced due to scavenging to pre-existing
4084	!> particles. Thus, the apparent nucleation rate at 3 nm is significantly lower
4085	!> than the real nucleation rate (at ~1 nm).
4086	!
4087	!> Calculation of the formation rate of detectable particles at 3 nm (i.e. J3):
4088	!> nj3 = 1: Kerminen, V.-M. and Kulmala, M. (2002), J. Aerosol Sci.,33, 609-622.
4089	!> nj3 = 2: Lehtinen et al. (2007), J. Aerosol Sci., 38(9), 988-994.
4090	!> nj3 = 3: Anttila et al. (2010), J. Aerosol Sci., 41(7), 621-636.
4091	!
4092	!> Called from subroutine condensation (in module salsa_dynamics_mod.f90)
4093	!
4094	!> Calls one of the following subroutines:
4095	!> - binnucl
4096	!> - ternucl
4097	!> - kinnucl
4098	!> - actnucl
4099	!
4100	!> fxm: currently only sulphuric acid grows particles from 1 to 3 nm
4101	!> (if asked from Markku, this is terribly wrong!!!)
4102	!
4103	!> Coded by:
4104	!> Hannele Korhonen (FMI) 2005
4105	!> Harri Kokkola (FMI) 2006
4106	!> Matti Niskanen(FMI) 2012
4107	!> Anton Laakso (FMI) 2013
4108	!------------------------------------------------------------------------------!
4109
4110	SUBROUTINE nucleation( paero, ptemp, prh, ppres, pcsa, pcocnv, pcnh3, ptstep, &
4111	pj3n3, pxsa, pxocnv )
4112	IMPLICIT NONE
4113	!
4114	!-- Input and output variables
4115	REAL(wp), INTENT(in) :: pcnh3 !< ammonia concentration (#/m3)
4116	REAL(wp), INTENT(in) :: pcocnv !< conc. of non-volatile OC (#/m3)
4117	REAL(wp), INTENT(in) :: pcsa !< sulphuric acid conc. (#/m3)
4118	REAL(wp), INTENT(in) :: ppres !< ambient air pressure (Pa)
4119	REAL(wp), INTENT(in) :: prh !< ambient rel. humidity [0-1]
4120	REAL(wp), INTENT(in) :: ptemp !< ambient temperature (K)
4121	REAL(wp), INTENT(in) :: ptstep !< time step (s) of SALSA
4122	TYPE(t_section), INTENT(inout) :: paero(fn2b) !< aerosol properties
4123	REAL(wp), INTENT(inout) :: pj3n3(2) !< formation mass rate of molecules
4124	!< (molec/m3s) for 1: H2SO4 and
4125	!< 2: organic vapour
4126	REAL(wp), INTENT(out) :: pxocnv !< ratio of non-volatile organic vapours in
4127	!< 3nm aerosol particles
4128	REAL(wp), INTENT(out) :: pxsa !< ratio of H2SO4 in 3nm aerosol particles
4129	!-- Local variables
4130	INTEGER(iwp) :: iteration
4131	REAL(wp) :: zbeta(fn2b) !< transitional correction factor
4132	REAL(wp) :: zc_h2so4 !< H2SO4 conc. (#/cm3) !UNITS!
4133	REAL(wp) :: zc_org !< organic vapour conc. (#/cm3)
4134	REAL(wp) :: zCoagStot !< total losses due to coagulation, including
4135	!< condensation and self-coagulation
4136	REAL(wp) :: zcocnv_local !< organic vapour conc. (#/m3)
4137	REAL(wp) :: zcsink !< condensational sink (#/m2)
4138	REAL(wp) :: zcsa_local !< H2SO4 conc. (#/m3)
4139	REAL(wp) :: zdcrit !< diameter of critical cluster (m)
4140	REAL(wp) :: zdelta_vap !< change of H2SO4 and organic vapour
4141	!< concentration (#/m3)
4142	REAL(wp) :: zdfvap !< air diffusion coefficient (m2/s)
4143	REAL(wp) :: zdmean !< mean diameter of existing particles (m)
4144	REAL(wp) :: zeta !< constant: proportional to ratio of CS/GR (m)
4145	!< (condensation sink / growth rate)
4146	REAL(wp) :: zgamma !< proportionality factor ((nm2*m2)/h)
4147	REAL(wp) :: zGRclust !< growth rate of formed clusters (nm/h)
4148	REAL(wp) :: zGRtot !< total growth rate
4149	REAL(wp) :: zj3 !< number conc. of formed 3nm particles (#/m3)
4150	REAL(wp) :: zjnuc !< nucleation rate at ~1nm (#/m3s)
4151	REAL(wp) :: zKeff !< effective cogulation coefficient between
4152	!< freshly nucleated particles
4153	REAL(wp) :: zknud(fn2b) !< particle Knudsen number
4154	REAL(wp) :: zkocnv !< lever: zkocnv=1 --> organic compounds involved
4155	!< in nucleation
4156	REAL(wp) :: zksa !< lever: zksa=1 --> H2SO4 involved in nucleation
4157	REAL(wp) :: zlambda !< parameter for adjusting the growth rate due to
4158	!< self-coagulation
4159	REAL(wp) :: zmfp !< mean free path of condesing vapour(m)
4160	REAL(wp) :: zmixnh3 !< ammonia mixing ratio (ppt)
4161	REAL(wp) :: zNnuc !< number of clusters/particles at the size range
4162	!< d1-dx (#/m3)
4163	REAL(wp) :: znoc !< number of organic molecules in critical cluster
4164	REAL(wp) :: znsa !< number of H2SO4 molecules in critical cluster
4165	!
4166	!-- Variable determined for the m-parameter
4167	REAL(wp) :: zCc_2(fn2b) !<
4168	REAL(wp) :: zCc_c !<
4169	REAL(wp) :: zCc_x !<
4170	REAL(wp) :: zCoagS_c !<
4171	REAL(wp) :: zCoagS_x !<
4172	REAL(wp) :: zcv_2(fn2b) !<
4173	REAL(wp) :: zcv_c !<
4174	REAL(wp) :: zcv_c2(fn2b) !<
4175	REAL(wp) :: zcv_x !<
4176	REAL(wp) :: zcv_x2(fn2b) !<
4177	REAL(wp) :: zDc_2(fn2b) !<
4178	REAL(wp) :: zDc_c(fn2b) !<
4179	REAL(wp) :: zDc_c2(fn2b) !<
4180	REAL(wp) :: zDc_x(fn2b) !<
4181	REAL(wp) :: zDc_x2(fn2b) !<
4182	REAL(wp) :: zgammaF_2(fn2b) !<
4183	REAL(wp) :: zgammaF_c(fn2b) !<
4184	REAL(wp) :: zgammaF_x(fn2b) !<
4185	REAL(wp) :: zK_c2(fn2b) !<
4186	REAL(wp) :: zK_x2(fn2b) !<
4187	REAL(wp) :: zknud_2(fn2b) !<
4188	REAL(wp) :: zknud_c !<
4189	REAL(wp) :: zknud_x !<
4190	REAL(wp) :: zm_2(fn2b) !<
4191	REAL(wp) :: zm_c !<
4192	REAL(wp) :: zm_para !<
4193	REAL(wp) :: zm_x !<
4194	REAL(wp) :: zmyy !<
4195	REAL(wp) :: zomega_2c(fn2b) !<
4196	REAL(wp) :: zomega_2x(fn2b) !<
4197	REAL(wp) :: zomega_c(fn2b) !<
4198	REAL(wp) :: zomega_x(fn2b) !<
4199	REAL(wp) :: zRc2(fn2b) !<
4200	REAL(wp) :: zRx2(fn2b) !<
4201	REAL(wp) :: zsigma_c2(fn2b) !<
4202	REAL(wp) :: zsigma_x2(fn2b) !<
4203	!
4204	!-- 1) Nucleation rate (zjnuc) and diameter of critical cluster (zdcrit)
4205	zjnuc = 0.0_wp
4206	znsa = 0.0_wp
4207	znoc = 0.0_wp
4208	zdcrit = 0.0_wp
4209	zksa = 0.0_wp
4210	zkocnv = 0.0_wp
4211
4212	SELECT CASE ( nsnucl )
4213
4214	CASE(1) ! Binary H2SO4-H2O nucleation
4215
4216	zc_h2so4 = pcsa * 1.0E-6_wp ! sulphuric acid conc. to #/cm3
4217	CALL binnucl( zc_h2so4, ptemp, prh, zjnuc, znsa, znoc, zdcrit, zksa, &
4218	zkocnv )
4219
4220	CASE(2) ! Activation type nucleation
4221
4222	zc_h2so4 = pcsa * 1.0E-6_wp ! sulphuric acid conc. to #/cm3
4223	CALL binnucl( zc_h2so4, ptemp, prh, zjnuc, znsa, znoc, zdcrit, zksa, &
4224	zkocnv )
4225	CALL actnucl( pcsa, zjnuc, zdcrit, znsa, znoc, zksa, zkocnv, act_coeff )
4226
4227	CASE(3) ! Kinetically limited nucleation of (NH4)HSO4 clusters
4228
4229	zc_h2so4 = pcsa * 1.0E-6_wp ! sulphuric acid conc. to #/cm3
4230	CALL binnucl( zc_h2so4, ptemp, prh, zjnuc, znsa, znoc, zdcrit, zksa, &
4231	zkocnv )
4232
4233	CALL kinnucl( zc_h2so4, zjnuc, zdcrit, znsa, znoc, zksa, zkocnv )
4234
4235	CASE(4) ! Ternary H2SO4-H2O-NH3 nucleation
4236
4237	zmixnh3 = pcnh3 * ptemp * argas / ( ppres * avo )
4238	zc_h2so4 = pcsa * 1.0E-6_wp ! sulphuric acid conc. to #/cm3
4239	CALL ternucl( zc_h2so4, zmixnh3, ptemp, prh, zjnuc, znsa, znoc, zdcrit, &
4240	zksa, zkocnv )
4241
4242	CASE(5) ! Organic nucleation, J~[ORG] or J~[ORG]**2
4243
4244	zc_org = pcocnv * 1.0E-6_wp ! conc. of non-volatile OC to #/cm3
4245	zc_h2so4 = pcsa * 1.0E-6_wp ! sulphuric acid conc. to #/cm3
4246	CALL binnucl( zc_h2so4, ptemp, prh, zjnuc, znsa, znoc, zdcrit, zksa, &
4247	zkocnv )
4248	CALL orgnucl( pcocnv, zjnuc, zdcrit, znsa, znoc, zksa, zkocnv )
4249
4250	CASE(6) ! Sum of H2SO4 and organic activation type nucleation,
4251	! J~[H2SO4]+[ORG]
4252
4253	zc_h2so4 = pcsa * 1.0E-6_wp ! sulphuric acid conc. to #/cm3
4254	CALL binnucl( zc_h2so4, ptemp, prh, zjnuc, znsa, znoc, zdcrit, zksa, &
4255	zkocnv )
4256	CALL sumnucl( pcsa, pcocnv, zjnuc, zdcrit, znsa, znoc, zksa, zkocnv )
4257
4258
4259	CASE(7) ! Heteromolecular nucleation, J~[H2SO4]*[ORG]
4260
4261	zc_h2so4 = pcsa * 1.0E-6_wp ! sulphuric acid conc. to #/cm3
4262	zc_org = pcocnv * 1.0E-6_wp ! conc. of non-volatile OC to #/cm3
4263	CALL binnucl( zc_h2so4, ptemp, prh, zjnuc, znsa, znoc, zdcrit, zksa, &
4264	zkocnv )
4265	CALL hetnucl( zc_h2so4, zc_org, zjnuc, zdcrit, znsa, znoc, zksa, zkocnv )
4266
4267	CASE(8) ! Homomolecular nucleation of H2SO4 and heteromolecular
4268	! nucleation of H2SO4 and organic vapour,
4269	! J~[H2SO4]*2 + [H2SO4][ORG] (EUCAARI project)
4270	zc_h2so4 = pcsa * 1.0E-6_wp ! sulphuric acid conc. to #/cm3
4271	zc_org = pcocnv * 1.0E-6_wp ! conc. of non-volatile OC to #/cm3
4272	CALL binnucl( zc_h2so4, ptemp, prh, zjnuc, znsa, znoc, zdcrit, zksa, &
4273	zkocnv )
4274	CALL SAnucl( zc_h2so4, zc_org, zjnuc, zdcrit, znsa, znoc, zksa, zkocnv )
4275
4276	CASE(9) ! Homomolecular nucleation of H2SO4 and organic vapour and
4277	! heteromolecular nucleation of H2SO4 and organic vapour,
4278	! J~[H2SO4]*2 + [H2SO4][ORG]+[ORG]**2 (EUCAARI project)
4279
4280	zc_h2so4 = pcsa * 1.0E-6_wp ! sulphuric acid conc. to #/cm3
4281	zc_org = pcocnv * 1.0E-6_wp ! conc. of non-volatile OC to #/cm3
4282	CALL binnucl( zc_h2so4, ptemp, prh, zjnuc, znsa, znoc, zdcrit, zksa, &
4283	zkocnv )
4284
4285	CALL SAORGnucl( zc_h2so4, zc_org, zjnuc, zdcrit, znsa, znoc, zksa, &
4286	zkocnv )
4287	END SELECT
4288
4289	zcsa_local = pcsa
4290	zcocnv_local = pcocnv
4291	!
4292	!-- 2) Change of particle and gas concentrations due to nucleation
4293	!
4294	!-- 2.1) Check that there is enough H2SO4 and organic vapour to produce the
4295	!-- nucleation
4296	IF ( nsnucl <= 4 ) THEN
4297	!-- If the chosen nucleation scheme is 1-4, nucleation occurs only due to
4298	!-- H2SO4. All of the total vapour concentration that is taking part to the
4299	!-- nucleation is there for sulphuric acid (sa = H2SO4) and non-volatile
4300	!-- organic vapour is zero.
4301	pxsa = 1.0_wp ! ratio of sulphuric acid in 3nm particles
4302	pxocnv = 0.0_wp ! ratio of non-volatile origanic vapour
4303	! in 3nm particles
4304	ELSEIF ( nsnucl > 4 ) THEN
4305	!-- If the chosen nucleation scheme is 5-9, nucleation occurs due to organic
4306	!-- vapour or the combination of organic vapour and H2SO4. The number of
4307	!-- needed molecules depends on the chosen nucleation type and it has an
4308	!-- effect also on the minimum ratio of the molecules present.
4309	IF ( pcsa * znsa + pcocnv * znoc < 1.E-14_wp ) THEN
4310	pxsa = 0.0_wp
4311	pxocnv = 0.0_wp
4312	ELSE
4313	pxsa = pcsa * znsa / ( pcsa * znsa + pcocnv * znoc )
4314	pxocnv = pcocnv * znoc / ( pcsa * znsa + pcocnv * znoc )
4315	ENDIF
4316	ENDIF
4317	!
4318	!-- The change in total vapour concentration is the sum of the concentrations
4319	!-- of the vapours taking part to the nucleation (depends on the chosen
4320	!-- nucleation scheme)
4321	zdelta_vap = MIN( zjnuc * ( znoc + znsa ), ( pcocnv * zkocnv + pcsa * &
4322	zksa ) / ptstep )
4323	!
4324	!-- Nucleation rate J at ~1nm (#/m3s)
4325	zjnuc = zdelta_vap / ( znoc + znsa )
4326	!
4327	!-- H2SO4 concentration after nucleation in #/m3
4328	zcsa_local = MAX( 1.0_wp, pcsa - zdelta_vap * pxsa )
4329	!
4330	!-- Non-volative organic vapour concentration after nucleation (#/m3)
4331	zcocnv_local = MAX( 1.0_wp, pcocnv - zdelta_vap * pxocnv )
4332	!
4333	!-- 2.2) Formation rate of 3 nm particles (Kerminen & Kulmala, 2002)
4334	!
4335	!-- 2.2.1) Growth rate of clusters formed by H2SO4
4336	!
4337	!-- GR = 3.0e-15 / dens_clus * sum( molecspeed * molarmass * conc )
4338	!
4339	!-- dens_clus = density of the clusters (here 1830 kg/m3)
4340	!-- molarmass = molar mass of condensing species (here 98.08 g/mol)
4341	!-- conc = concentration of condensing species [#/m3]
4342	!-- molecspeed = molecular speed of condensing species [m/s]
4343	!-- = sqrt( 8.0 * R * ptemp / ( pi * molarmass ) )
4344	!-- (Seinfeld & Pandis, 1998)
4345	!
4346	!-- Growth rate by H2SO4 and organic vapour in nm/h (Eq. 21)
4347	zGRclust = 2.3623E-15_wp * SQRT( ptemp ) * ( zcsa_local + zcocnv_local )
4348	!
4349	!-- 2.2.2) Condensational sink of pre-existing particle population
4350	!
4351	!-- Diffusion coefficient (m2/s)
4352	zdfvap = 5.1111E-10_wp * ptemp ** 1.75_wp * ( p_0 + 1325.0_wp ) / ppres
4353	!-- Mean free path of condensing vapour (m) (Jacobson (2005), Eq. 15.25 and
4354	!-- 16.29)
4355	zmfp = 3.0_wp * zdfvap * SQRT( pi * amh2so4 / ( 8.0_wp * argas * ptemp ) )
4356	!-- Knudsen number
4357	zknud = 2.0_wp * zmfp / ( paero(:)%dwet + d_sa )
4358	!-- Transitional regime correction factor (zbeta) according to Fuchs and
4359	!-- Sutugin (1971), In: Hidy et al. (ed.), Topics in current aerosol research,
4360	!-- Pergamon. (Eq. 4 in Kerminen and Kulmala, 2002)
4361	zbeta = ( zknud + 1.0_wp) / ( 0.377_wp * zknud + 1.0_wp + 4.0_wp / &
4362	( 3.0_wp * massacc ) * ( zknud + zknud ** 2 ) )
4363	!-- Condensational sink (#/m2) (Eq. 3)
4364	zcsink = SUM( paero(:)%dwet * zbeta * paero(:)%numc )
4365	!
4366	!-- Parameterised formation rate of detectable 3 nm particles (i.e. J3)
4367	IF ( nj3 == 1 ) THEN ! Kerminen and Kulmala (2002)
4368	!-- 2.2.3) Parameterised formation rate of detectable 3 nm particles
4369	!-- Constants needed for the parameterisation:
4370	!-- dapp = 3 nm and dens_nuc = 1830 kg/m3
4371	IF ( zcsink < 1.0E-30_wp ) THEN
4372	zeta = 0._dp
4373	ELSE
4374	!-- Mean diameter of backgroud population (nm)
4375	zdmean = 1.0_wp / SUM( paero(:)%numc ) * SUM( paero(:)%numc * &
4376	paero(:)%dwet ) * 1.0E+9_wp
4377	!-- Proportionality factor (nm2*m2/h) (Eq. 22)
4378	zgamma = 0.23_wp * ( zdcrit * 1.0E+9_wp ) ** 0.2_wp * ( zdmean / &
4379	150.0_wp ) ** 0.048_wp * ( ptemp / 293.0_wp ) ** ( -0.75_wp ) &
4380	* ( arhoh2so4 / 1000.0_wp ) ** ( -0.33_wp )
4381	!-- Factor eta (nm) (Eq. 11)
4382	zeta = MIN( zgamma * zcsink / zGRclust, zdcrit * 1.0E11_wp )
4383	ENDIF
4384	!
4385	!-- Number conc. of clusters surviving to 3 nm in a time step (#/m3) (Eq.14)
4386	zj3 = zjnuc * EXP( MIN( 0.0_wp, zeta / 3.0_wp - zeta / &
4387	( zdcrit * 1.0E9_wp ) ) )
4388
4389	ELSEIF ( nj3 > 1 ) THEN
4390	!-- Defining the value for zm_para. The growth is investigated between
4391	!-- [d1,reglim(1)] = [zdcrit,3nm]
4392	!-- m = LOG( CoagS_dx / CoagX_zdcrit ) / LOG( reglim / zdcrit )
4393	!-- (Lehtinen et al. 2007, Eq. 5)
4394	!-- The steps for the coagulation sink for reglim = 3nm and zdcrit ~= 1nm are
4395	!-- explained in article of Kulmala et al. (2001). The particles of diameter
4396	!-- zdcrit ~1.14 nm and reglim = 3nm are both in turn the "number 1"
4397	!-- variables (Kulmala et al. 2001).
4398	!-- c = critical (1nm), x = 3nm, 2 = wet or mean droplet
4399	!-- Sum of the radii, R12 = R1 + zR2 (m) of two particles 1 and 2
4400	zRc2 = zdcrit / 2.0_wp + paero(:)%dwet / 2.0_wp
4401	zRx2 = reglim(1) / 2.0_wp + paero(:)%dwet / 2.0_wp
4402	!
4403	!-- The mass of particle (kg) (comes only from H2SO4)
4404	zm_c = 4.0_wp / 3.0_wp * pi * ( zdcrit / 2.0_wp ) ** 3.0_wp * arhoh2so4
4405	zm_x = 4.0_wp / 3.0_wp * pi * ( reglim(1) / 2.0_wp ) ** 3.0_wp * &
4406	arhoh2so4
4407	zm_2 = 4.0_wp / 3.0_wp * pi * ( paero(:)%dwet / 2.0_wp )** 3.0_wp * &
4408	arhoh2so4
4409	!
4410	!-- Mean relative thermal velocity between the particles (m/s)
4411	zcv_c = SQRT( 8.0_wp * abo * ptemp / ( pi * zm_c ) )
4412	zcv_x = SQRT( 8.0_wp * abo * ptemp / ( pi * zm_x ) )
4413	zcv_2 = SQRT( 8.0_wp * abo * ptemp / ( pi * zm_2 ) )
4414	!
4415	!-- Average velocity after coagulation
4416	zcv_c2 = SQRT( zcv_c 2.0_wp + zcv_2 2.0_wp )
4417	zcv_x2 = SQRT( zcv_x 2.0_wp + zcv_2 2.0_wp )
4418	!
4419	!-- Knudsen number (zmfp = mean free path of condensing vapour)
4420	zknud_c = 2.0_wp * zmfp / zdcrit
4421	zknud_x = 2.0_wp * zmfp / reglim(1)
4422	zknud_2 = MAX( 0.0_wp, 2.0_wp * zmfp / paero(:)%dwet )
4423	!
4424	!-- Cunningham correction factor
4425	zCc_c = 1.0_wp + zknud_c * ( 1.142_wp + 0.558_wp * &
4426	EXP( -0.999_wp / zknud_c ) )
4427	zCc_x = 1.0_wp + zknud_x * ( 1.142_wp + 0.558_wp * &
4428	EXP( -0.999_wp / zknud_x ) )
4429	zCc_2 = 1.0_wp + zknud_2 * ( 1.142_wp + 0.558_wp * &
4430	EXP( -0.999_wp / zknud_2 ) )
4431	!
4432	!-- Gas dynamic viscosity (N*s/m2).
4433	!-- Viscocity(air @20C) = 1.81e-5_dp N/m2 *s (Hinds, p. 25)
4434	zmyy = 1.81E-5_wp * ( ptemp / 293.0_wp) ** ( 0.74_wp )
4435	!
4436	!-- Particle diffusion coefficient (m2/s)
4437	zDc_c = abo * ptemp * zCc_c / ( 3.0_wp * pi * zmyy * zdcrit )
4438	zDc_x = abo * ptemp * zCc_x / ( 3.0_wp * pi * zmyy * reglim(1) )
4439	zDc_2 = abo * ptemp * zCc_2 / ( 3.0_wp * pi * zmyy * paero(:)%dwet )
4440	!
4441	!-- D12 = D1+D2 (Seinfield and Pandis, 2nd ed. Eq. 13.38)
4442	zDc_c2 = zDc_c + zDc_2
4443	zDc_x2 = zDc_x + zDc_2
4444	!
4445	!-- zgammaF = 8*D/pi/zcv (m) for calculating zomega
4446	zgammaF_c = 8.0_wp * zDc_c / pi / zcv_c
4447	zgammaF_x = 8.0_wp * zDc_x / pi / zcv_x
4448	zgammaF_2 = 8.0_wp * zDc_2 / pi / zcv_2
4449	!
4450	!-- zomega (m) for calculating zsigma
4451	zomega_c = ( ( zRc2 + zgammaF_c ) 3 - ( zRc2 2 + &
4452	zgammaF_c ) ** ( 3.0_wp / 2.0_wp ) ) / ( 3.0_wp * &
4453	zRc2 * zgammaF_c ) - zRc2
4454	zomega_x = ( ( zRx2 + zgammaF_x ) 3.0_wp - ( zRx2 2.0_wp + &
4455	zgammaF_x ) ** ( 3.0_wp / 2.0_wp ) ) / ( 3.0_wp * &
4456	zRx2 * zgammaF_x ) - zRx2
4457	zomega_2c = ( ( zRc2 + zgammaF_2 ) 3.0_wp - ( zRc2 2.0_wp + &
4458	zgammaF_2 ) ** ( 3.0_wp / 2.0_wp ) ) / ( 3.0_wp * &
4459	zRc2 * zgammaF_2 ) - zRc2
4460	zomega_2x = ( ( zRx2 + zgammaF_2 ) 3.0_wp - ( zRx2 2.0_wp + &
4461	zgammaF_2 ) ** ( 3.0_wp / 2.0_wp ) ) / ( 3.0_wp * &
4462	zRx2 * zgammaF_2 ) - zRx2
4463	!
4464	!-- The distance (m) at which the two fluxes are matched (condensation and
4465	!-- coagulation sinks?)
4466	zsigma_c2 = SQRT( zomega_c 2.0_wp + zomega_2c 2.0_wp )
4467	zsigma_x2 = SQRT( zomega_x 2.0_wp + zomega_2x 2.0_wp )
4468	!
4469	!-- Coagulation coefficient in the continuum regime (m*m2/s)
4470	zK_c2 = 4.0_wp * pi * zRc2 * zDc_c2 / ( zRc2 / ( zRc2 + zsigma_c2 ) + &
4471	4.0_wp * zDc_c2 / ( zcv_c2 * zRc2 ) )
4472	zK_x2 = 4.0_wp * pi * zRx2 * zDc_x2 / ( zRx2 / ( zRx2 + zsigma_x2 ) + &
4473	4.0_wp * zDc_x2 / ( zcv_x2 * zRx2 ) )
4474	!
4475	!-- Coagulation sink (1/s)
4476	zCoagS_c = MAX( 1.0E-20_wp, SUM( zK_c2 * paero(:)%numc ) )
4477	zCoagS_x = MAX( 1.0E-20_wp, SUM( zK_x2 * paero(:)%numc ) )
4478	!
4479	!-- Parameter m for calculating the coagulation sink onto background
4480	!-- particles (Eq. 5&6 in Lehtinen et al. 2007)
4481	zm_para = LOG( zCoagS_x / zCoagS_c ) / LOG( reglim(1) / zdcrit )
4482	!
4483	!-- Parameter gamma for calculating the formation rate J of particles having
4484	!-- a diameter zdcrit < d < reglim(1) (Anttila et al. 2010, eq. 5)
4485	zgamma = ( ( ( reglim(1) / zdcrit ) ** ( zm_para + 1.0_wp ) ) - 1.0_wp )&
4486	/ ( zm_para + 1.0_wp )
4487
4488	IF ( nj3 == 2 ) THEN ! Coagulation sink
4489	!
4490	!-- Formation rate J before iteration (#/m3s)
4491	zj3 = zjnuc * EXP( MIN( 0.0_wp, -zgamma * zdcrit * zCoagS_c / &
4492	( zGRclust * 1.0E-9_wp / ( 60.0_wp ** 2.0_wp ) ) ) )
4493
4494	ELSEIF ( nj3 == 3 ) THEN ! Coagulation sink and self-coag.
4495	!-- IF polluted air... then the self-coagulation becomes important.
4496	!-- Self-coagulation of small particles < 3 nm.
4497	!
4498	!-- "Effective" coagulation coefficient between freshly-nucleated
4499	!-- particles:
4500	zKeff = 5.0E-16_wp ! cm3/s
4501	!
4502	!-- zlambda parameter for "adjusting" the growth rate due to the
4503	!-- self-coagulation
4504	zlambda = 6.0_wp
4505	IF ( reglim(1) >= 10.0E-9_wp ) THEN ! for particles >10 nm:
4506	zKeff = 5.0E-17_wp
4507	zlambda = 3.0_wp
4508	ENDIF
4509	!
4510	!-- Initial values for coagulation sink and growth rate (m/s)
4511	zCoagStot = zCoagS_c
4512	zGRtot = zGRclust * 1.0E-9_wp / 60.0_wp ** 2.0_wp
4513	!
4514	!-- Number of clusters/particles at the size range [d1,dx] (#/m3):
4515	zNnuc = zjnuc / zCoagStot !< Initial guess
4516	!
4517	!-- Coagulation sink and growth rate due to self-coagulation:
4518	DO iteration = 1, 5
4519	zCoagStot = zCoagS_c + zKeff * zNnuc * 1.0E-6_wp ! (1/s)
4520	zGRtot = zGRclust * 1.0E-9_wp / ( 3600.0_wp ) + 1.5708E-6_wp * &
4521	zlambda * zdcrit ** 3.0_wp * ( zNnuc * 1.0E-6_wp ) * &
4522	zcv_c * avo * 1.0E-9_wp / 3600.0_wp
4523	zeta = - zCoagStot / ( ( zm_para + 1.0_wp ) * zGRtot * ( zdcrit **&
4524	zm_para ) ) ! Eq. 7b (Anttila)
4525	zNnuc = zNnuc_tayl( zdcrit, reglim(1), zm_para, zjnuc, zeta, &
4526	zGRtot )
4527	ENDDO
4528	!
4529	!-- Calculate the final values with new zNnuc:
4530	zCoagStot = zCoagS_c + zKeff * zNnuc * 1.0E-6_wp ! (1/s)
4531	zGRtot = zGRclust * 1.0E-9_wp / 3600.0_wp + 1.5708E-6_wp * zlambda &
4532	* zdcrit ** 3.0_wp * ( zNnuc * 1.0E-6_wp ) * zcv_c * avo * &
4533	1.0E-9_wp / 3600.0_wp !< (m/s)
4534	zj3 = zjnuc * EXP( MIN( 0.0_wp, -zgamma * zdcrit * zCoagStot / &
4535	zGRtot ) ) ! (Eq. 5a) (#/m3s)
4536
4537	ENDIF
4538
4539	ENDIF
4540	!-- If J3 very small (< 1 #/cm3), neglect particle formation. In real atmosphere
4541	!-- this would mean that clusters form but coagulate to pre-existing particles
4542	!-- who gain sulphate. Since CoagS ~ CS (4piDCS'), we do not* update H2SO4
4543	!-- concentration here but let condensation take care of it.
4544	!-- Formation mass rate of molecules (molec/m3s) for 1: H2SO4 and 2: organic
4545	!-- vapour
4546	pj3n3(1) = zj3 * n3 * pxsa
4547	pj3n3(2) = zj3 * n3 * pxocnv
4548
4549
4550	END SUBROUTINE nucleation
4551
4552	!------------------------------------------------------------------------------!
4553	! Description:
4554	! ------------
4555	!> Calculate the nucleation rate and the size of critical clusters assuming
4556	!> binary nucleation.
4557	!> Parametrisation according to Vehkamaki et al. (2002), J. Geophys. Res.,
4558	!> 107(D22), 4622. Called from subroutine nucleation.
4559	!------------------------------------------------------------------------------!
4560	SUBROUTINE binnucl( pc_sa, ptemp, prh, pnuc_rate, pn_crit_sa, pn_crit_ocnv, &
4561	pd_crit, pk_sa, pk_ocnv )
4562
4563	IMPLICIT NONE
4564	!
4565	!-- Input and output variables
4566	REAL(wp), INTENT(in) :: pc_sa !< H2SO4 conc. (#/cm3)
4567	REAL(wp), INTENT(in) :: prh !< relative humidity [0-1]
4568	REAL(wp), INTENT(in) :: ptemp !< ambient temperature (K)
4569	REAL(wp), INTENT(out) :: pnuc_rate !< nucleation rate (#/(m3 s))
4570	REAL(wp), INTENT(out) :: pn_crit_sa !< number of H2SO4 molecules in
4571	!< cluster (#)
4572	REAL(wp), INTENT(out) :: pn_crit_ocnv !< number of organic molecules in
4573	!< cluster (#)
4574	REAL(wp), INTENT(out) :: pd_crit !< diameter of critical cluster (m)
4575	REAL(wp), INTENT(out) :: pk_sa !< Lever: if pk_sa = 1, H2SO4 is
4576	!< involved in nucleation.
4577	REAL(wp), INTENT(out) :: pk_ocnv !< Lever: if pk_ocnv = 1, organic
4578	!< compounds are involved in
4579	!< nucleation.
4580	!-- Local variables
4581	REAL(wp) :: zx !< mole fraction of sulphate in critical cluster
4582	REAL(wp) :: zntot !< number of molecules in critical cluster
4583	REAL(wp) :: zt !< temperature
4584	REAL(wp) :: zpcsa !< sulfuric acid concentration
4585	REAL(wp) :: zrh !< relative humidity
4586	REAL(wp) :: zma !<
4587	REAL(wp) :: zmw !<
4588	REAL(wp) :: zxmass!<
4589	REAL(wp) :: za !<
4590	REAL(wp) :: zb !<
4591	REAL(wp) :: zc !<
4592	REAL(wp) :: zroo !<
4593	REAL(wp) :: zm1 !<
4594	REAL(wp) :: zm2 !<
4595	REAL(wp) :: zv1 !<
4596	REAL(wp) :: zv2 !<
4597	REAL(wp) :: zcoll !<
4598
4599	pnuc_rate = 0.0_wp
4600	pd_crit = 1.0E-9_wp
4601
4602	!
4603	!-- 1) Checking that we are in the validity range of the parameterization
4604	zt = MAX( ptemp, 190.15_wp )
4605	zt = MIN( zt, 300.15_wp )
4606	zpcsa = MAX( pc_sa, 1.0E4_wp )
4607	zpcsa = MIN( zpcsa, 1.0E11_wp )
4608	zrh = MAX( prh, 0.0001_wp )
4609	zrh = MIN( zrh, 1.0_wp )
4610	!
4611	!-- 2) Mole fraction of sulphate in a critical cluster (Eq. 11)
4612	zx = 0.7409967177282139_wp &
4613	- 0.002663785665140117_wp * zt &
4614	+ 0.002010478847383187_wp * LOG( zrh ) &
4615	- 0.0001832894131464668_wp* zt * LOG( zrh ) &
4616	+ 0.001574072538464286_wp * LOG( zrh ) ** 2 &
4617	- 0.00001790589121766952_wp * zt * LOG( zrh ) ** 2 &
4618	+ 0.0001844027436573778_wp * LOG( zrh ) ** 3 &
4619	- 1.503452308794887E-6_wp * zt * LOG( zrh ) ** 3 &
4620	- 0.003499978417957668_wp * LOG( zpcsa ) &
4621	+ 0.0000504021689382576_wp * zt * LOG( zpcsa )
4622	!
4623	!-- 3) Nucleation rate (Eq. 12)
4624	pnuc_rate = 0.1430901615568665_wp &
4625	+ 2.219563673425199_wp * zt &
4626	- 0.02739106114964264_wp * zt ** 2 &
4627	+ 0.00007228107239317088_wp * zt ** 3 &
4628	+ 5.91822263375044_wp / zx &
4629	+ 0.1174886643003278_wp * LOG( zrh ) &
4630	+ 0.4625315047693772_wp * zt * LOG( zrh ) &
4631	- 0.01180591129059253_wp * zt ** 2 * LOG( zrh ) &
4632	+ 0.0000404196487152575_wp * zt ** 3 * LOG( zrh ) &
4633	+ ( 15.79628615047088_wp * LOG( zrh ) ) / zx &
4634	- 0.215553951893509_wp * LOG( zrh ) ** 2 &
4635	- 0.0810269192332194_wp * zt * LOG( zrh ) ** 2 &
4636	+ 0.001435808434184642_wp * zt ** 2 * LOG( zrh ) ** 2 &
4637	- 4.775796947178588E-6_wp * zt ** 3 * LOG( zrh ) ** 2 &
4638	- (2.912974063702185_wp * LOG( zrh ) ** 2 ) / zx &
4639	- 3.588557942822751_wp * LOG( zrh ) ** 3 &
4640	+ 0.04950795302831703_wp * zt * LOG( zrh ) ** 3 &
4641	- 0.0002138195118737068_wp * zt ** 2 * LOG( zrh ) ** 3 &
4642	+ 3.108005107949533E-7_wp * zt ** 3 * LOG( zrh ) ** 3 &
4643	- ( 0.02933332747098296_wp * LOG( zrh ) ** 3 ) / zx &
4644	+ 1.145983818561277_wp * LOG( zpcsa ) &
4645	- 0.6007956227856778_wp * zt * LOG( zpcsa ) &
4646	+ 0.00864244733283759_wp * zt ** 2 * LOG( zpcsa ) &
4647	- 0.00002289467254710888_wp * zt ** 3 * LOG( zpcsa ) &
4648	- ( 8.44984513869014_wp * LOG( zpcsa ) ) / zx &
4649	+ 2.158548369286559_wp * LOG( zrh ) * LOG( zpcsa ) &
4650	+ 0.0808121412840917_wp * zt * LOG( zrh ) * LOG( zpcsa ) &
4651	- 0.0004073815255395214_wp * zt ** 2 * LOG( zrh ) * LOG( zpcsa ) &
4652	- 4.019572560156515E-7_wp * zt ** 3 * LOG( zrh ) * LOG( zpcsa ) &
4653	+ ( 0.7213255852557236_wp * LOG( zrh ) * LOG( zpcsa ) ) / zx &
4654	+ 1.62409850488771_wp * LOG( zrh ) ** 2 * LOG( zpcsa ) &
4655	- 0.01601062035325362_wp * zt * LOG( zrh ) ** 2 * LOG( zpcsa ) &
4656	+ 0.00003771238979714162_wpzt2 LOG( zrh )*2 LOG( zpcsa ) &
4657	+ 3.217942606371182E-8_wp * zt*3 LOG( zrh )*2 LOG( zpcsa ) &
4658	- (0.01132550810022116_wp * LOG( zrh )*2 LOG( zpcsa ) ) / zx &
4659	+ 9.71681713056504_wp * LOG( zpcsa ) ** 2 &
4660	- 0.1150478558347306_wp * zt * LOG( zpcsa ) ** 2 &
4661	+ 0.0001570982486038294_wp * zt ** 2 * LOG( zpcsa ) ** 2 &
4662	+ 4.009144680125015E-7_wp * zt ** 3 * LOG( zpcsa ) ** 2 &
4663	+ ( 0.7118597859976135_wp * LOG( zpcsa ) ** 2 ) / zx &
4664	- 1.056105824379897_wp * LOG( zrh ) * LOG( zpcsa ) ** 2 &
4665	+ 0.00903377584628419_wp * zt * LOG( zrh ) * LOG( zpcsa )**2 &
4666	- 0.00001984167387090606_wpzt2LOG( zrh )LOG( zpcsa )*2 &
4667	+ 2.460478196482179E-8_wp * zt*3 LOG( zrh ) * LOG( zpcsa )**2 &
4668	- ( 0.05790872906645181_wp * LOG( zrh ) * LOG( zpcsa )**2 ) / zx &
4669	- 0.1487119673397459_wp * LOG( zpcsa ) ** 3 &
4670	+ 0.002835082097822667_wp * zt * LOG( zpcsa ) ** 3 &
4671	- 9.24618825471694E-6_wp * zt ** 2 * LOG( zpcsa ) ** 3 &
4672	+ 5.004267665960894E-9_wp * zt ** 3 * LOG( zpcsa ) ** 3 &
4673	- ( 0.01270805101481648_wp * LOG( zpcsa ) ** 3 ) / zx
4674	!
4675	!-- Nucleation rate in #/(cm3 s)
4676	pnuc_rate = EXP( pnuc_rate )
4677	!
4678	!-- Check the validity of parameterization
4679	IF ( pnuc_rate < 1.0E-7_wp ) THEN
4680	pnuc_rate = 0.0_wp
4681	pd_crit = 1.0E-9_wp
4682	ENDIF
4683	!
4684	!-- 4) Total number of molecules in the critical cluster (Eq. 13)
4685	zntot = - 0.002954125078716302_wp &
4686	- 0.0976834264241286_wp * zt &
4687	+ 0.001024847927067835_wp * zt ** 2 &
4688	- 2.186459697726116E-6_wp * zt ** 3 &
4689	- 0.1017165718716887_wp / zx &
4690	- 0.002050640345231486_wp * LOG( zrh ) &
4691	- 0.007585041382707174_wp * zt * LOG( zrh ) &
4692	+ 0.0001926539658089536_wp * zt ** 2 * LOG( zrh ) &
4693	- 6.70429719683894E-7_wp * zt ** 3 * LOG( zrh ) &
4694	- ( 0.2557744774673163_wp * LOG( zrh ) ) / zx &
4695	+ 0.003223076552477191_wp * LOG( zrh ) ** 2 &
4696	+ 0.000852636632240633_wp * zt * LOG( zrh ) ** 2 &
4697	- 0.00001547571354871789_wp * zt ** 2 * LOG( zrh ) ** 2 &
4698	+ 5.666608424980593E-8_wp * zt ** 3 * LOG( zrh ) ** 2 &
4699	+ ( 0.03384437400744206_wp * LOG( zrh ) ** 2 ) / zx &
4700	+ 0.04743226764572505_wp * LOG( zrh ) ** 3 &
4701	- 0.0006251042204583412_wp * zt * LOG( zrh ) ** 3 &
4702	+ 2.650663328519478E-6_wp * zt ** 2 * LOG( zrh ) ** 3 &
4703	- 3.674710848763778E-9_wp * zt ** 3 * LOG( zrh ) ** 3 &
4704	- ( 0.0002672510825259393_wp * LOG( zrh ) ** 3 ) / zx &
4705	- 0.01252108546759328_wp * LOG( zpcsa ) &
4706	+ 0.005806550506277202_wp * zt * LOG( zpcsa ) &
4707	- 0.0001016735312443444_wp * zt ** 2 * LOG( zpcsa ) &
4708	+ 2.881946187214505E-7_wp * zt ** 3 * LOG( zpcsa ) &
4709	+ ( 0.0942243379396279_wp * LOG( zpcsa ) ) / zx &
4710	- 0.0385459592773097_wp * LOG( zrh ) * LOG( zpcsa ) &
4711	- 0.0006723156277391984_wp * zt * LOG( zrh ) * LOG( zpcsa ) &
4712	+ 2.602884877659698E-6_wp * zt ** 2 * LOG( zrh ) * LOG( zpcsa ) &
4713	+ 1.194163699688297E-8_wp * zt ** 3 * LOG( zrh ) * LOG( zpcsa ) &
4714	- ( 0.00851515345806281_wp * LOG( zrh ) * LOG( zpcsa ) ) / zx &
4715	- 0.01837488495738111_wp * LOG( zrh ) ** 2 * LOG( zpcsa ) &
4716	+ 0.0001720723574407498_wp * zt * LOG( zrh ) ** 2 * LOG( zpcsa ) &
4717	- 3.717657974086814E-7_wp * zt*2 LOG( zrh )*2 LOG( zpcsa ) &
4718	- 5.148746022615196E-10_wp * zt*3 LOG( zrh )*2 LOG( zpcsa ) &
4719	+ ( 0.0002686602132926594_wp * LOG(zrh)*2 LOG(zpcsa) ) / zx &
4720	- 0.06199739728812199_wp * LOG( zpcsa ) ** 2 &
4721	+ 0.000906958053583576_wp * zt * LOG( zpcsa ) ** 2 &
4722	- 9.11727926129757E-7_wp * zt ** 2 * LOG( zpcsa ) ** 2 &
4723	- 5.367963396508457E-9_wp * zt ** 3 * LOG( zpcsa ) ** 2 &
4724	- ( 0.007742343393937707_wp * LOG( zpcsa ) ** 2 ) / zx &
4725	+ 0.0121827103101659_wp * LOG( zrh ) * LOG( zpcsa ) ** 2 &
4726	- 0.0001066499571188091_wp * zt * LOG( zrh ) * LOG( zpcsa ) ** 2 &
4727	+ 2.534598655067518E-7_wp * zt*2 LOG( zrh ) * LOG( zpcsa )**2 &
4728	- 3.635186504599571E-10_wp * zt*3 LOG( zrh ) * LOG( zpcsa )**2 &
4729	+ ( 0.0006100650851863252_wp * LOG( zrh ) * LOG( zpcsa ) **2 )/ zx &
4730	+ 0.0003201836700403512_wp * LOG( zpcsa ) ** 3 &
4731	- 0.0000174761713262546_wp * zt * LOG( zpcsa ) ** 3 &
4732	+ 6.065037668052182E-8_wp * zt ** 2 * LOG( zpcsa ) ** 3 &
4733	- 1.421771723004557E-11_wp * zt ** 3 * LOG( zpcsa ) ** 3 &
4734	+ ( 0.0001357509859501723_wp * LOG( zpcsa ) ** 3 ) / zx
4735	zntot = EXP( zntot ) ! in #
4736	!
4737	!-- 5) Size of the critical cluster pd_crit (m) (diameter) (Eq. 14)
4738	pn_crit_sa = zx * zntot
4739	pd_crit = 2.0E-9_wp * EXP( -1.6524245_wp + 0.42316402_wp * zx + &
4740	0.33466487_wp * LOG( zntot ) )
4741	!
4742	!-- 6) Organic compounds not involved when binary nucleation is assumed
4743	pn_crit_ocnv = 0.0_wp ! number of organic molecules
4744	pk_sa = 1.0_wp ! if = 1, H2SO4 involved in nucleation
4745	pk_ocnv = 0.0_wp ! if = 1, organic compounds involved
4746	!
4747	!-- Set nucleation rate to collision rate
4748	IF ( pn_crit_sa < 4.0_wp ) THEN
4749	!
4750	!-- Volumes of the colliding objects
4751	zma = 96.0_wp ! molar mass of SO4 in g/mol
4752	zmw = 18.0_wp ! molar mass of water in g/mol
4753	zxmass = 1.0_wp ! mass fraction of H2SO4
4754	za = 0.7681724_wp + zxmass * ( 2.1847140_wp + zxmass * ( &
4755	7.1630022_wp + zxmass * ( -44.31447_wp + zxmass * ( &
4756	88.75606 + zxmass * ( -75.73729_wp + zxmass * &
4757	23.43228_wp ) ) ) ) )
4758	zb = 1.808225E-3_wp + zxmass * ( -9.294656E-3_wp + zxmass * &
4759	( -0.03742148_wp + zxmass * ( 0.2565321_wp + zxmass * &
4760	( -0.5362872_wp + zxmass * ( 0.4857736 - zxmass * &
4761	0.1629592_wp ) ) ) ) )
4762	zc = - 3.478524E-6_wp + zxmass * ( 1.335867E-5_wp + zxmass * &
4763	( 5.195706E-5_wp + zxmass * ( -3.717636E-4_wp + zxmass * &
4764	( 7.990811E-4_wp + zxmass * ( -7.458060E-4_wp + zxmass * &
4765	2.58139E-4_wp ) ) ) ) )
4766	!
4767	!-- Density for the sulphuric acid solution (Eq. 10 in Vehkamaki)
4768	zroo = za + zt * ( zb + zc * zt ) ! g/cm^3
4769	zroo = zroo * 1.0E+3_wp ! kg/m^3
4770	zm1 = 0.098_wp ! molar mass of H2SO4 in kg/mol
4771	zm2 = zm1
4772	zv1 = zm1 / avo / zroo ! volume
4773	zv2 = zv1
4774	!
4775	!-- Collision rate
4776	zcoll = zpcsa * zpcsa * ( 3.0_wp * pi / 4.0_wp ) ** ( 1.0_wp / 6.0_wp )&
4777	* SQRT( 6.0_wp * argas * zt / zm1 + 6.0_wp * argas * zt / zm2 )&
4778	* ( zv1 ( 1.0_wp / 3.0_wp ) + zv2 ( 1.0_wp /3.0_wp ) ) **&
4779	2.0_wp * 1.0E+6_wp ! m3 -> cm3
4780
4781	zcoll = MIN( zcoll, 1.0E+10_wp )
4782	pnuc_rate = zcoll ! (#/(cm3 s))
4783
4784	ELSE
4785	pnuc_rate = MIN( pnuc_rate, 1.0E+10_wp )
4786	ENDIF
4787	pnuc_rate = pnuc_rate * 1.0E+6_wp ! (#/(m3 s))
4788
4789	END SUBROUTINE binnucl
4790
4791	!------------------------------------------------------------------------------!
4792	! Description:
4793	! ------------
4794	!> Calculate the nucleation rate and the size of critical clusters assuming
4795	!> ternary nucleation. Parametrisation according to:
4796	!> Napari et al. (2002), J. Chem. Phys., 116, 4221-4227 and
4797	!> Napari et al. (2002), J. Geophys. Res., 107(D19), AAC 6-1-ACC 6-6.
4798	!> Called from subroutine nucleation.
4799	!------------------------------------------------------------------------------!
4800	SUBROUTINE ternucl( pc_sa, pc_nh3, ptemp, prh, pnuc_rate, pn_crit_sa, &
4801	pn_crit_ocnv, pd_crit, pk_sa, pk_ocnv )
4802
4803	IMPLICIT NONE
4804
4805	!-- Input and output variables
4806	REAL(wp), INTENT(in) :: pc_nh3 !< ammonia mixing ratio (ppt)
4807	REAL(wp), INTENT(in) :: pc_sa !< H2SO4 conc. (#/cm3)
4808	REAL(wp), INTENT(in) :: prh !< relative humidity [0-1]
4809	REAL(wp), INTENT(in) :: ptemp !< ambient temperature (K)
4810	REAL(wp), INTENT(out) :: pd_crit !< diameter of critical
4811	!< cluster (m)
4812	REAL(wp), INTENT(out) :: pk_ocnv !< Lever: if pk_ocnv = 1,organic compounds
4813	!< are involved in nucleation
4814	REAL(wp), INTENT(out) :: pk_sa !< Lever: if pk_sa = 1, H2SO4 is involved
4815	!< in nucleation
4816	REAL(wp), INTENT(out) :: pn_crit_ocnv !< number of organic molecules in
4817	!< cluster (#)
4818	REAL(wp), INTENT(out) :: pn_crit_sa !< number of H2SO4 molecules in
4819	!< cluster (#)
4820	REAL(wp), INTENT(out) :: pnuc_rate !< nucleation rate (#/(m3 s))
4821	!-- Local variables
4822	REAL(wp) :: zlnj !< logarithm of nucleation rate
4823
4824	!-- 1) Checking that we are in the validity range of the parameterization.
4825	!-- Validity of parameterization : DO NOT REMOVE!
4826	IF ( ptemp < 240.0_wp .OR. ptemp > 300.0_wp ) THEN
4827	message_string = 'Invalid input value: ptemp'
4828	CALL message( 'salsa_mod: ternucl', 'SA0045', 1, 2, 0, 6, 0 )
4829	ENDIF
4830	IF ( prh < 0.05_wp .OR. prh > 0.95_wp ) THEN
4831	message_string = 'Invalid input value: prh'
4832	CALL message( 'salsa_mod: ternucl', 'SA0046', 1, 2, 0, 6, 0 )
4833	ENDIF
4834	IF ( pc_sa < 1.0E+4_wp .OR. pc_sa > 1.0E+9_wp ) THEN
4835	message_string = 'Invalid input value: pc_sa'
4836	CALL message( 'salsa_mod: ternucl', 'SA0047', 1, 2, 0, 6, 0 )
4837	ENDIF
4838	IF ( pc_nh3 < 0.1_wp .OR. pc_nh3 > 100.0_wp ) THEN
4839	message_string = 'Invalid input value: pc_nh3'
4840	CALL message( 'salsa_mod: ternucl', 'SA0048', 1, 2, 0, 6, 0 )
4841	ENDIF
4842	!
4843	!-- 2) Nucleation rate (Eq. 7 in Napari et al., 2002: Parameterization of
4844	!-- ternary nucleation of sulfuric acid - ammonia - water.
4845	zlnj = - 84.7551114741543_wp &
4846	+ 0.3117595133628944_wp * prh &
4847	+ 1.640089605712946_wp * prh * ptemp &
4848	- 0.003438516933381083_wp * prh * ptemp ** 2.0_wp &
4849	- 0.00001097530402419113_wp * prh * ptemp ** 3.0_wp &
4850	- 0.3552967070274677_wp / LOG( pc_sa ) &
4851	- ( 0.06651397829765026_wp * prh ) / LOG( pc_sa ) &
4852	- ( 33.84493989762471_wp * ptemp ) / LOG( pc_sa ) &
4853	- ( 7.823815852128623_wp * prh * ptemp ) / LOG( pc_sa) &
4854	+ ( 0.3453602302090915_wp * ptemp ** 2.0_wp ) / LOG( pc_sa ) &
4855	+ ( 0.01229375748100015_wp * prh * ptemp ** 2.0_wp ) / LOG( pc_sa ) &
4856	- ( 0.000824007160514956_wp ptemp * 3.0_wp ) / LOG( pc_sa ) &
4857	+ ( 0.00006185539100670249_wp * prh * ptemp ** 3.0_wp ) &
4858	/ LOG( pc_sa ) &
4859	+ 3.137345238574998_wp * LOG( pc_sa ) &
4860	+ 3.680240980277051_wp * prh * LOG( pc_sa ) &
4861	- 0.7728606202085936_wp * ptemp * LOG( pc_sa ) &
4862	- 0.204098217156962_wp * prh * ptemp * LOG( pc_sa ) &
4863	+ 0.005612037586790018_wp * ptemp ** 2.0_wp * LOG( pc_sa ) &
4864	+ 0.001062588391907444_wp * prh * ptemp ** 2.0_wp * LOG( pc_sa ) &
4865	- 9.74575691760229E-6_wp * ptemp ** 3.0_wp * LOG( pc_sa ) &
4866	- 1.265595265137352E-6_wp * prh * ptemp ** 3.0_wp * LOG( pc_sa ) &
4867	+ 19.03593713032114_wp * LOG( pc_sa ) ** 2.0_wp &
4868	- 0.1709570721236754_wp * ptemp * LOG( pc_sa ) ** 2.0_wp &
4869	+ 0.000479808018162089_wp * ptemp ** 2.0_wp * LOG( pc_sa ) ** 2.0_wp&
4870	- 4.146989369117246E-7_wp * ptemp ** 3.0_wp * LOG( pc_sa ) ** 2.0_wp&
4871	+ 1.076046750412183_wp * LOG( pc_nh3 ) &
4872	+ 0.6587399318567337_wp * prh * LOG( pc_nh3 ) &
4873	+ 1.48932164750748_wp * ptemp * LOG( pc_nh3 ) &
4874	+ 0.1905424394695381_wp * prh * ptemp * LOG( pc_nh3 ) &
4875	- 0.007960522921316015_wp * ptemp ** 2.0_wp * LOG( pc_nh3 ) &
4876	- 0.001657184248661241_wp * prh * ptemp ** 2.0_wp * LOG( pc_nh3 ) &
4877	+ 7.612287245047392E-6_wp * ptemp ** 3.0_wp * LOG( pc_nh3 ) &
4878	+ 3.417436525881869E-6_wp * prh * ptemp ** 3.0_wp * LOG( pc_nh3 ) &
4879	+ ( 0.1655358260404061_wp * LOG( pc_nh3 ) ) / LOG( pc_sa) &
4880	+ ( 0.05301667612522116_wp * prh * LOG( pc_nh3 ) ) / LOG( pc_sa ) &
4881	+ ( 3.26622914116752_wp * ptemp * LOG( pc_nh3 ) ) / LOG( pc_sa ) &
4882	- ( 1.988145079742164_wp * prh * ptemp * LOG( pc_nh3 ) ) &
4883	/ LOG( pc_sa ) &
4884	- ( 0.04897027401984064_wp * ptemp ** 2.0_wp * LOG( pc_nh3) ) &
4885	/ LOG( pc_sa ) &
4886	+ ( 0.01578269253599732_wp * prh * ptemp ** 2.0_wp * LOG( pc_nh3 ) &
4887	) / LOG( pc_sa ) &
4888	+ ( 0.0001469672236351303_wp * ptemp ** 3.0_wp * LOG( pc_nh3 ) ) &
4889	/ LOG( pc_sa ) &
4890	- ( 0.00002935642836387197_wp * prh * ptemp ** 3.0_wp *LOG( pc_nh3 )&
4891	) / LOG( pc_sa ) &
4892	+ 6.526451177887659_wp * LOG( pc_sa ) * LOG( pc_nh3 ) &
4893	- 0.2580021816722099_wp * ptemp * LOG( pc_sa ) * LOG( pc_nh3 ) &
4894	+ 0.001434563104474292_wp * ptemp ** 2.0_wp * LOG( pc_sa ) &
4895	* LOG( pc_nh3 ) &
4896	- 2.020361939304473E-6_wp * ptemp ** 3.0_wp * LOG( pc_sa ) &
4897	* LOG( pc_nh3 ) &
4898	- 0.160335824596627_wp * LOG( pc_sa ) ** 2.0_wp * LOG( pc_nh3 ) &
4899	+ 0.00889880721460806_wp * ptemp * LOG( pc_sa ) ** 2.0_wp &
4900	* LOG( pc_nh3 ) &
4901	- 0.00005395139051155007_wp * ptemp ** 2.0_wp &
4902	* LOG( pc_sa) ** 2.0_wp * LOG( pc_nh3 ) &
4903	+ 8.39521718689596E-8_wp * ptemp ** 3.0_wp * LOG( pc_sa ) ** 2.0_wp&
4904	* LOG( pc_nh3 ) &
4905	+ 6.091597586754857_wp * LOG( pc_nh3 ) ** 2.0_wp &
4906	+ 8.5786763679309_wp * prh * LOG( pc_nh3 ) ** 2.0_wp &
4907	- 1.253783854872055_wp * ptemp * LOG( pc_nh3 ) ** 2.0_wp &
4908	- 0.1123577232346848_wp * prh * ptemp * LOG( pc_nh3 ) ** 2.0_wp &
4909	+ 0.00939835595219825_wp * ptemp ** 2.0_wp * LOG( pc_nh3 ) ** 2.0_wp&
4910	+ 0.0004726256283031513_wp * prh * ptemp ** 2.0_wp &
4911	* LOG( pc_nh3) ** 2.0_wp &
4912	- 0.00001749269360523252_wp * ptemp ** 3.0_wp &
4913	* LOG( pc_nh3 ) ** 2.0_wp &
4914	- 6.483647863710339E-7_wp * prh * ptemp ** 3.0_wp &
4915	* LOG( pc_nh3 ) ** 2.0_wp &
4916	+ ( 0.7284285726576598_wp * LOG( pc_nh3 ) ** 2.0_wp ) / LOG( pc_sa )&
4917	+ ( 3.647355600846383_wp * ptemp * LOG( pc_nh3 ) ** 2.0_wp ) &
4918	/ LOG( pc_sa ) &
4919	- ( 0.02742195276078021_wp * ptemp ** 2.0_wp &
4920	* LOG( pc_nh3) ** 2.0_wp ) / LOG( pc_sa ) &
4921	+ ( 0.00004934777934047135_wp * ptemp ** 3.0_wp &
4922	* LOG( pc_nh3 ) ** 2.0_wp ) / LOG( pc_sa ) &
4923	+ 41.30162491567873_wp * LOG( pc_sa ) * LOG( pc_nh3 ) ** 2.0_wp &
4924	- 0.357520416800604_wp * ptemp * LOG( pc_sa ) &
4925	* LOG( pc_nh3 ) ** 2.0_wp &
4926	+ 0.000904383005178356_wp * ptemp ** 2.0_wp * LOG( pc_sa ) &
4927	* LOG( pc_nh3 ) ** 2.0_wp &
4928	- 5.737876676408978E-7_wp * ptemp ** 3.0_wp * LOG( pc_sa ) &
4929	* LOG( pc_nh3 ) ** 2.0_wp &
4930	- 2.327363918851818_wp * LOG( pc_sa ) ** 2.0_wp &
4931	* LOG( pc_nh3 ) ** 2.0_wp &
4932	+ 0.02346464261919324_wp * ptemp * LOG( pc_sa ) ** 2.0_wp &
4933	* LOG( pc_nh3 ) ** 2.0_wp &
4934	- 0.000076518969516405_wp * ptemp ** 2.0_wp &
4935	* LOG( pc_sa ) ** 2.0_wp * LOG( pc_nh3 ) ** 2.0_wp &
4936	+ 8.04589834836395E-8_wp * ptemp ** 3.0_wp * LOG( pc_sa ) ** 2.0_wp &
4937	* LOG( pc_nh3 ) ** 2.0_wp &
4938	- 0.02007379204248076_wp * LOG( prh ) &
4939	- 0.7521152446208771_wp * ptemp * LOG( prh ) &
4940	+ 0.005258130151226247_wp * ptemp ** 2.0_wp * LOG( prh ) &
4941	- 8.98037634284419E-6_wp * ptemp ** 3.0_wp * LOG( prh ) &
4942	+ ( 0.05993213079516759_wp * LOG( prh ) ) / LOG( pc_sa ) &
4943	+ ( 5.964746463184173_wp * ptemp * LOG( prh ) ) / LOG( pc_sa ) &
4944	- ( 0.03624322255690942_wp * ptemp ** 2.0_wp * LOG( prh ) ) &
4945	/ LOG( pc_sa ) &
4946	+ ( 0.00004933369382462509_wp * ptemp ** 3.0_wp * LOG( prh ) ) &
4947	/ LOG( pc_sa ) &
4948	- 0.7327310805365114_wp * LOG( pc_nh3 ) * LOG( prh ) &
4949	- 0.01841792282958795_wp * ptemp * LOG( pc_nh3 ) * LOG( prh ) &
4950	+ 0.0001471855981005184_wp * ptemp ** 2.0_wp * LOG( pc_nh3 ) &
4951	* LOG( prh ) &
4952	- 2.377113195631848E-7_wp * ptemp ** 3.0_wp * LOG( pc_nh3 ) &
4953	* LOG( prh )
4954	pnuc_rate = EXP( zlnj ) ! (#/(cm3 s))
4955	!
4956	!-- Check validity of parametrization
4957	IF ( pnuc_rate < 1.0E-5_wp ) THEN
4958	pnuc_rate = 0.0_wp
4959	pd_crit = 1.0E-9_wp
4960	ELSEIF ( pnuc_rate > 1.0E6_wp ) THEN
4961	message_string = 'Invalid output value: nucleation rate > 10^6 1/cm3s'
4962	CALL message( 'salsa_mod: ternucl', 'SA0049', 1, 2, 0, 6, 0 )
4963	ENDIF
4964	pnuc_rate = pnuc_rate * 1.0E6_wp ! (#/(m3 s))
4965	!
4966	!-- 3) Number of H2SO4 molecules in a critical cluster (Eq. 9)
4967	pn_crit_sa = 38.16448247950508_wp + 0.7741058259731187_wp * zlnj + &
4968	0.002988789927230632_wp * zlnj ** 2.0_wp - &
4969	0.3576046920535017_wp * ptemp - &
4970	0.003663583011953248_wp * zlnj * ptemp + &
4971	0.000855300153372776_wp * ptemp ** 2.0_wp
4972	!-- Kinetic limit: at least 2 H2SO4 molecules in a cluster
4973	pn_crit_sa = MAX( pn_crit_sa, 2.0E0_wp )
4974	!
4975	!-- 4) Size of the critical cluster in nm (Eq. 12)
4976	pd_crit = 0.1410271086638381_wp - 0.001226253898894878_wp * zlnj - &
4977	7.822111731550752E-6_wp * zlnj ** 2.0_wp - &
4978	0.001567273351921166_wp * ptemp - &
4979	0.00003075996088273962_wp * zlnj * ptemp + &
4980	0.00001083754117202233_wp * ptemp ** 2.0_wp
4981	pd_crit = pd_crit * 2.0E-9_wp ! Diameter in m
4982	!
4983	!-- 5) Organic compounds not involved when ternary nucleation assumed
4984	pn_crit_ocnv = 0.0_wp
4985	pk_sa = 1.0_wp
4986	pk_ocnv = 0.0_wp
4987
4988	END SUBROUTINE ternucl
4989
4990	!------------------------------------------------------------------------------!
4991	! Description:
4992	! ------------
4993	!> Calculate the nucleation rate and the size of critical clusters assuming
4994	!> kinetic nucleation. Each sulphuric acid molecule forms an (NH4)HSO4 molecule
4995	!> in the atmosphere and two colliding (NH4)HSO4 molecules form a stable
4996	!> cluster. See Sihto et al. (2006), Atmos. Chem. Phys., 6(12), 4079-4091.
4997	!>
4998	!> Below the following assumption have been made:
4999	!> nucrate = coagcoeffzpcsa*2
5000	!> coagcoeff = 8sqrt(3boltzptempr_abs/dens_abs)
5001	!> r_abs = 0.315d-9 radius of bisulphate molecule [m]
5002	!> dens_abs = 1465 density of - " - [kg/m3]
5003	!------------------------------------------------------------------------------!
5004	SUBROUTINE kinnucl( pc_sa, pnuc_rate, pd_crit, pn_crit_sa, pn_crit_ocnv, &
5005	pk_sa, pk_ocnv )
5006
5007	IMPLICIT NONE
5008
5009	!-- Input and output variables
5010	REAL(wp), INTENT(in) :: pc_sa !< H2SO4 conc. (#/m3)
5011	REAL(wp), INTENT(out) :: pd_crit !< critical diameter of clusters (m)
5012	REAL(wp), INTENT(out) :: pk_ocnv !< Lever: if pk_ocnv = 1, organic
5013	!< compounds are involved in nucleation
5014	REAL(wp), INTENT(out) :: pk_sa !< Lever: if pk_sa = 1, H2SO4 is involved
5015	!< in nucleation
5016	REAL(wp), INTENT(out) :: pn_crit_ocnv !< number of organic molecules in
5017	!< cluster (#)
5018	REAL(wp), INTENT(out) :: pn_crit_sa !< number of H2SO4 molecules in
5019	!< cluster (#)
5020	REAL(wp), INTENT(out) :: pnuc_rate !< nucl. rate (#/(m3 s))
5021
5022	!-- Nucleation rate (#/(m3 s))
5023	pnuc_rate = 5.0E-13_wp * pc_sa ** 2.0_wp * 1.0E+6_wp
5024	!-- Organic compounds not involved when kinetic nucleation is assumed.
5025	pn_crit_sa = 2.0_wp
5026	pn_crit_ocnv = 0.0_wp
5027	pk_sa = 1.0_wp
5028	pk_ocnv = 0.0_wp
5029	pd_crit = 7.9375E-10_wp ! (m)
5030
5031	END SUBROUTINE kinnucl
5032	!------------------------------------------------------------------------------!
5033	! Description:
5034	! ------------
5035	!> Calculate the nucleation rate and the size of critical clusters assuming
5036	!> activation type nucleation.
5037	!> See Riipinen et al. (2007), Atmos. Chem. Phys., 7(8), 1899-1914.
5038	!------------------------------------------------------------------------------!
5039	SUBROUTINE actnucl( psa_conc, pnuc_rate, pd_crit, pn_crit_sa, pn_crit_ocnv, &
5040	pk_sa, pk_ocnv, activ )
5041
5042	IMPLICIT NONE
5043
5044	!-- Input and output variables
5045	REAL(wp), INTENT(in) :: psa_conc !< H2SO4 conc. (#/m3)
5046	REAL(wp), INTENT(in) :: activ !<
5047	REAL(wp), INTENT(out) :: pd_crit !< critical diameter of clusters (m)
5048	REAL(wp), INTENT(out) :: pk_ocnv !< Lever: if pk_ocnv = 1, organic
5049	!< compounds are involved in nucleation
5050	REAL(wp), INTENT(out) :: pk_sa !< Lever: if pk_sa = 1, H2SO4 is involved
5051	!< in nucleation
5052	REAL(wp), INTENT(out) :: pn_crit_ocnv !< number of organic molecules in
5053	!< cluster (#)
5054	REAL(wp), INTENT(out) :: pn_crit_sa !< number of H2SO4 molecules in
5055	!< cluster (#)
5056	REAL(wp), INTENT(out) :: pnuc_rate !< nucl. rate (#/(m3 s))
5057
5058	!-- act_coeff 1e-7 by default
5059	pnuc_rate = activ * psa_conc ! (#/(m3 s))
5060	!-- Organic compounds not involved when kinetic nucleation is assumed.
5061	pn_crit_sa = 2.0_wp
5062	pn_crit_ocnv = 0.0_wp
5063	pk_sa = 1.0_wp
5064	pk_ocnv = 0.0_wp
5065	pd_crit = 7.9375E-10_wp ! (m)
5066	END SUBROUTINE actnucl
5067	!------------------------------------------------------------------------------!
5068	! Description:
5069	! ------------
5070	!> Conciders only the organic matter in nucleation. Paasonen et al. (2010)
5071	!> determined particle formation rates for 2 nm particles, J2, from different
5072	!> kind of combinations of sulphuric acid and organic matter concentration.
5073	!> See Paasonen et al. (2010), Atmos. Chem. Phys., 10, 11223-11242.
5074	!------------------------------------------------------------------------------!
5075	SUBROUTINE orgnucl( pc_org, pnuc_rate, pd_crit, pn_crit_sa, pn_crit_ocnv, &
5076	pk_sa, pk_ocnv )
5077
5078	IMPLICIT NONE
5079
5080	!-- Input and output variables
5081	REAL(wp), INTENT(in) :: pc_org !< organic vapour concentration (#/m3)
5082	REAL(wp), INTENT(out) :: pd_crit !< critical diameter of clusters (m)
5083	REAL(wp), INTENT(out) :: pk_ocnv !< Lever: if pk_ocnv = 1, organic
5084	!< compounds are involved in nucleation
5085	REAL(wp), INTENT(out) :: pk_sa !< Lever: if pk_sa = 1, H2SO4 is involved
5086	!< in nucleation
5087	REAL(wp), INTENT(out) :: pn_crit_ocnv !< number of organic molecules in
5088	!< cluster (#)
5089	REAL(wp), INTENT(out) :: pn_crit_sa !< number of H2SO4 molecules in
5090	!< cluster (#)
5091	REAL(wp), INTENT(out) :: pnuc_rate !< nucl. rate (#/(m3 s))
5092	!-- Local variables
5093	REAL(wp) :: Aorg = 1.3E-7_wp !< (1/s) (Paasonen et al. Table 4: median)
5094
5095	!-- Homomolecular nuleation - which one?
5096	pnuc_rate = Aorg * pc_org
5097	!-- H2SO4 not involved when pure organic nucleation is assumed.
5098	pn_crit_sa = 0.0_wp
5099	pn_crit_ocnv = 1.0_wp
5100	pk_sa = 0.0_wp
5101	pk_ocnv = 1.0_wp
5102	pd_crit = 1.5E-9_wp ! (m)
5103
5104	END SUBROUTINE orgnucl
5105	!------------------------------------------------------------------------------!
5106	! Description:
5107	! ------------
5108	!> Conciders both the organic vapor and H2SO4 in nucleation - activation type
5109	!> of nucleation.
5110	!> See Paasonen et al. (2010), Atmos. Chem. Phys., 10, 11223-11242.
5111	!------------------------------------------------------------------------------!
5112	SUBROUTINE sumnucl( pc_sa, pc_org, pnuc_rate, pd_crit, pn_crit_sa, &
5113	pn_crit_ocnv, pk_sa, pk_ocnv )
5114
5115	IMPLICIT NONE
5116
5117	!-- Input and output variables
5118	REAL(wp), INTENT(in) :: pc_org !< organic vapour concentration (#/m3)
5119	REAL(wp), INTENT(in) :: pc_sa !< H2SO4 conc. (#/m3)
5120	REAL(wp), INTENT(out) :: pd_crit !< critical diameter of clusters (m)
5121	REAL(wp), INTENT(out) :: pk_ocnv !< Lever: if pk_ocnv = 1, organic
5122	!< compounds are involved in nucleation
5123	REAL(wp), INTENT(out) :: pk_sa !< Lever: if pk_sa = 1, H2SO4 is involved
5124	!< in nucleation
5125	REAL(wp), INTENT(out) :: pn_crit_ocnv !< number of organic molecules in
5126	!< cluster (#)
5127	REAL(wp), INTENT(out) :: pn_crit_sa !< number of H2SO4 molecules in
5128	!< cluster (#)
5129	REAL(wp), INTENT(out) :: pnuc_rate !< nucl. rate (#/(m3 s))
5130	!-- Local variables
5131	REAL(wp) :: As1 = 6.1E-7_wp !< (1/s)
5132	REAL(wp) :: As2 = 0.39E-7_wp !< (1/s) (Paasonen et al. Table 3.)
5133
5134	!-- Nucleation rate (#/m3/s)
5135	pnuc_rate = As1 * pc_sa + As2 * pc_org
5136	!-- Both Organic compounds and H2SO4 are involved when SUMnucleation is assumed.
5137	pn_crit_sa = 1.0_wp
5138	pn_crit_ocnv = 1.0_wp
5139	pk_sa = 1.0_wp
5140	pk_ocnv = 1.0_wp
5141	pd_crit = 1.5E-9_wp ! (m)
5142
5143	END SUBROUTINE sumnucl
5144	!------------------------------------------------------------------------------!
5145	! Description:
5146	! ------------
5147	!> Conciders both the organic vapor and H2SO4 in nucleation - heteromolecular
5148	!> nucleation.
5149	!> See Paasonen et al. (2010), Atmos. Chem. Phys., 10, 11223-11242.
5150	!------------------------------------------------------------------------------!
5151	SUBROUTINE hetnucl( pc_sa, pc_org, pnuc_rate, pd_crit, pn_crit_sa, &
5152	pn_crit_ocnv, pk_sa, pk_ocnv )
5153
5154	IMPLICIT NONE
5155
5156	!-- Input and output variables
5157	REAL(wp), INTENT(in) :: pc_org !< organic vapour concentration (#/m3)
5158	REAL(wp), INTENT(in) :: pc_sa !< H2SO4 conc. (#/m3)
5159	REAL(wp), INTENT(out) :: pd_crit !< critical diameter of clusters (m)
5160	REAL(wp), INTENT(out) :: pk_ocnv !< Lever: if pk_ocnv = 1, organic
5161	!< compounds are involved in nucleation
5162	REAL(wp), INTENT(out) :: pk_sa !< Lever: if pk_sa = 1, H2SO4 is involved
5163	!< in nucleation
5164	REAL(wp), INTENT(out) :: pn_crit_ocnv !< number of organic molecules in
5165	!< cluster (#)
5166	REAL(wp), INTENT(out) :: pn_crit_sa !< number of H2SO4 molecules in
5167	!< cluster (#)
5168	REAL(wp), INTENT(out) :: pnuc_rate !< nucl. rate (#/(m3 s))
5169	!-- Local variables
5170	REAL(wp) :: zKhet = 4.1E-14_wp !< (cm3/s) (Paasonen et al. Table 4: median)
5171
5172	!-- Nucleation rate (#/m3/s)
5173	pnuc_rate = zKhet * pc_sa * pc_org * 1.0E6_wp
5174	!-- Both Organic compounds and H2SO4 are involved when heteromolecular
5175	!-- nucleation is assumed.
5176	pn_crit_sa = 1.0_wp
5177	pn_crit_ocnv = 1.0_wp
5178	pk_sa = 1.0_wp
5179	pk_ocnv = 1.0_wp
5180	pd_crit = 1.5E-9_wp ! (m)
5181
5182	END SUBROUTINE hetnucl
5183	!------------------------------------------------------------------------------!
5184	! Description:
5185	! ------------
5186	!> Takes into account the homomolecular nucleation of sulphuric acid H2SO4 with
5187	!> both of the available vapours.
5188	!> See Paasonen et al. (2010), Atmos. Chem. Phys., 10, 11223-11242.
5189	!------------------------------------------------------------------------------!
5190	SUBROUTINE SAnucl( pc_sa, pc_org, pnuc_rate, pd_crit, pn_crit_sa, &
5191	pn_crit_ocnv, pk_sa, pk_ocnv )
5192
5193	IMPLICIT NONE
5194
5195	!-- Input and output variables
5196	REAL(wp), INTENT(in) :: pc_org !< organic vapour concentration (#/m3)
5197	REAL(wp), INTENT(in) :: pc_sa !< H2SO4 conc. (#/m3)
5198	REAL(wp), INTENT(out) :: pd_crit !< critical diameter of clusters (m)
5199	REAL(wp), INTENT(out) :: pk_ocnv !< Lever: if pk_ocnv = 1, organic
5200	!< compounds are involved in nucleation
5201	REAL(wp), INTENT(out) :: pk_sa !< Lever: if pk_sa = 1, H2SO4 is involved
5202	!< in nucleation
5203	REAL(wp), INTENT(out) :: pn_crit_ocnv !< number of organic molecules in
5204	!< cluster (#)
5205	REAL(wp), INTENT(out) :: pn_crit_sa !< number of H2SO4 molecules in
5206	!< cluster (#)
5207	REAL(wp), INTENT(out) :: pnuc_rate !< nucleation rate (#/(m3 s))
5208	!-- Local variables
5209	REAL(wp) :: zKsa1 = 1.1E-14_wp !< (cm3/s)
5210	REAL(wp) :: zKsa2 = 3.2E-14_wp !< (cm3/s) (Paasonen et al. Table 3.)
5211
5212	!-- Nucleation rate (#/m3/s)
5213	pnuc_rate = ( zKsa1 * pc_sa ** 2.0_wp + zKsa2 * pc_sa * pc_org ) * 1.0E+6_wp
5214	!-- Both Organic compounds and H2SO4 are involved when SAnucleation is assumed.
5215	pn_crit_sa = 3.0_wp
5216	pn_crit_ocnv = 1.0_wp
5217	pk_sa = 1.0_wp
5218	pk_ocnv = 1.0_wp
5219	pd_crit = 1.5E-9_wp ! (m)
5220
5221	END SUBROUTINE SAnucl
5222	!------------------------------------------------------------------------------!
5223	! Description:
5224	! ------------
5225	!> Takes into account the homomolecular nucleation of both sulphuric acid and
5226	!> Lorganic with heteromolecular nucleation.
5227	!> See Paasonen et al. (2010), Atmos. Chem. Phys., 10, 11223-11242.
5228	!------------------------------------------------------------------------------!
5229	SUBROUTINE SAORGnucl( pc_sa, pc_org, pnuc_rate, pd_crit, pn_crit_sa, &
5230	pn_crit_ocnv, pk_sa, pk_ocnv )
5231
5232	IMPLICIT NONE
5233
5234	!-- Input and output variables
5235	REAL(wp), INTENT(in) :: pc_org !< organic vapour concentration (#/m3)
5236	REAL(wp), INTENT(in) :: pc_sa !< H2SO4 conc. (#/m3)
5237	REAL(wp), INTENT(out) :: pd_crit !< critical diameter of clusters (m)
5238	REAL(wp), INTENT(out) :: pk_ocnv !< Lever: if pk_ocnv = 1, organic
5239	!< compounds are involved in nucleation
5240	REAL(wp), INTENT(out) :: pk_sa !< Lever: if pk_sa = 1, H2SO4 is involved
5241	!< in nucleation
5242	REAL(wp), INTENT(out) :: pn_crit_ocnv !< number of organic molecules in
5243	!< cluster (#)
5244	REAL(wp), INTENT(out) :: pn_crit_sa !< number of H2SO4 molecules in
5245	!< cluster (#)
5246	REAL(wp), INTENT(out) :: pnuc_rate !< nucl. rate (#/(m3 s))
5247	!-- Local variables
5248	REAL(wp) :: zKs1 = 1.4E-14_wp !< (cm3/s])
5249	REAL(wp) :: zKs2 = 2.6E-14_wp !< (cm3/s])
5250	REAL(wp) :: zKs3 = 0.037E-14_wp !< (cm3/s]) (Paasonen et al. Table 3.)
5251
5252	!-- Nucleation rate (#/m3/s)
5253	pnuc_rate = ( zKs1 * pc_sa *2 + zKs2 pc_sa * pc_org + zKs3 * &
5254	pc_org ** 2.0_wp ) * 1.0E+6_wp
5255	!-- Organic compounds not involved when kinetic nucleation is assumed.
5256	pn_crit_sa = 3.0_wp
5257	pn_crit_ocnv = 3.0_wp
5258	pk_sa = 1.0_wp
5259	pk_ocnv = 1.0_wp
5260	pd_crit = 1.5E-9_wp ! (m)
5261
5262	END SUBROUTINE SAORGnucl
5263
5264	!------------------------------------------------------------------------------!
5265	! Description:
5266	! ------------
5267	!> Function zNnuc_tayl is connected to the calculation of self-coagualtion of
5268	!> small particles. It calculates number of the particles in the size range
5269	!> [zdcrit,dx] using Taylor-expansion (please note that the expansion is not
5270	!> valid for certain rational numbers, e.g. -4/3 and -3/2)
5271	!------------------------------------------------------------------------------!
5272	FUNCTION zNnuc_tayl( d1, dx, zm_para, zjnuc_t, zeta, zGRtot )
5273	IMPLICIT NONE
5274
5275	INTEGER(iwp) :: i
5276	REAL(wp) :: d1
5277	REAL(wp) :: dx
5278	REAL(wp) :: zjnuc_t
5279	REAL(wp) :: zeta
5280	REAL(wp) :: term1
5281	REAL(wp) :: term2
5282	REAL(wp) :: term3
5283	REAL(wp) :: term4
5284	REAL(wp) :: term5
5285	REAL(wp) :: zNnuc_tayl
5286	REAL(wp) :: zGRtot
5287	REAL(wp) :: zm_para
5288
5289	zNnuc_tayl = 0.0_wp
5290
5291	DO i = 0, 29
5292	IF ( i == 0 .OR. i == 1 ) THEN
5293	term1 = 1.0_wp
5294	ELSE
5295	term1 = term1 * REAL( i, SELECTED_REAL_KIND(12,307) )
5296	END IF
5297	term2 = ( REAL( i, SELECTED_REAL_KIND(12,307) ) * ( zm_para + 1.0_wp &
5298	) + 1.0_wp ) * term1
5299	term3 = zeta ** i
5300	term4 = term3 / term2
5301	term5 = REAL( i, SELECTED_REAL_KIND(12,307) ) * ( zm_para + 1.0_wp ) &
5302	+ 1.0_wp
5303	zNnuc_tayl = zNnuc_tayl + term4 * ( dx term5 - d1 term5 )
5304	ENDDO
5305	zNnuc_tayl = zNnuc_tayl * zjnuc_t * EXP( -zeta * &
5306	( d1 ** ( zm_para + 1 ) ) ) / zGRtot
5307
5308	END FUNCTION zNnuc_tayl
5309
5310	!------------------------------------------------------------------------------!
5311	! Description:
5312	! ------------
5313	!> Calculates the condensation of water vapour on aerosol particles. Follows the
5314	!> analytical predictor method by Jacobson (2005).
5315	!> For equations, see Jacobson (2005), Fundamentals of atmospheric modelling
5316	!> (2nd edition).
5317	!------------------------------------------------------------------------------!
5318	SUBROUTINE gpparth2o( paero, ptemp, ppres, pcs, pcw, ptstep )
5319
5320	IMPLICIT NONE
5321	!
5322	!-- Input and output variables
5323	REAL(wp), INTENT(in) :: ppres !< Air pressure (Pa)
5324	REAL(wp), INTENT(in) :: pcs !< Water vapour saturation
5325	!< concentration (kg/m3)
5326	REAL(wp), INTENT(in) :: ptemp !< Ambient temperature (K)
5327	REAL(wp), INTENT(in) :: ptstep !< timestep (s)
5328	REAL(wp), INTENT(inout) :: pcw !< Water vapour concentration
5329	!< (kg/m3)
5330	TYPE(t_section), INTENT(inout) :: paero(nbins) !< Aerosol properties
5331	!-- Local variables
5332	INTEGER(iwp) :: b !< loop index
5333	INTEGER(iwp) :: nstr
5334	REAL(wp) :: adt !< internal timestep in this subroutine
5335	REAL(wp) :: adtc(nbins)
5336	REAL(wp) :: rhoair
5337	REAL(wp) :: ttot
5338	REAL(wp) :: zact !< Water activity
5339	REAL(wp) :: zaelwc1 !< Current aerosol water content
5340	REAL(wp) :: zaelwc2 !< New aerosol water content after
5341	!< equilibrium calculation
5342	REAL(wp) :: zbeta !< Transitional correction factor
5343	REAL(wp) :: zcwc !< Current water vapour mole concentration
5344	REAL(wp) :: zcwcae(nbins) !< Current water mole concentrations
5345	!< in aerosols
5346	REAL(wp) :: zcwint !< Current and new water vapour mole concentrations
5347	REAL(wp) :: zcwintae(nbins) !< Current and new water mole concentrations
5348	!< in aerosols
5349	REAL(wp) :: zcwn !< New water vapour mole concentration
5350	REAL(wp) :: zcwnae(nbins) !< New water mole concentration in aerosols
5351	REAL(wp) :: zcwsurfae(nbins) !< Surface mole concentration
5352	REAL(wp) :: zcwtot !< Total water mole concentration
5353	REAL(wp) :: zdfh2o
5354	REAL(wp) :: zhlp1
5355	REAL(wp) :: zhlp2
5356	REAL(wp) :: zhlp3
5357	REAL(wp) :: zka(nbins) !< Activity coefficient
5358	REAL(wp) :: zkelvin(nbins) !< Kelvin effect
5359	REAL(wp) :: zknud
5360	REAL(wp) :: zmfph2o !< mean free path of H2O gas molecule
5361	REAL(wp) :: zmtae(nbins) !< Mass transfer coefficients
5362	REAL(wp) :: zrh !< Relative humidity [0-1]
5363	REAL(wp) :: zthcond
5364	REAL(wp) :: zwsatae(nbins) !< Water saturation ratio above aerosols
5365	!
5366	!-- Relative humidity [0-1]
5367	zrh = pcw / pcs
5368	!-- Calculate the condensation only for 2a/2b aerosol bins
5369	nstr = in2a
5370	!-- Save the current aerosol water content, 8 in paero is H2O
5371	zaelwc1 = SUM( paero(in1a:fn2b)%volc(8) ) * arhoh2o
5372	!
5373	!-- Equilibration:
5374	IF ( advect_particle_water ) THEN
5375	IF ( zrh < 0.98_wp .OR. .NOT. lscndh2oae ) THEN
5376	CALL equilibration( zrh, ptemp, paero, .TRUE. )
5377	ELSE
5378	CALL equilibration( zrh, ptemp, paero, .FALSE. )
5379	ENDIF
5380	ENDIF
5381	!
5382	!-- The new aerosol water content after equilibrium calculation
5383	zaelwc2 = SUM( paero(in1a:fn2b)%volc(8) ) * arhoh2o
5384	!-- New water vapour mixing ratio (kg/m3)
5385	pcw = pcw - ( zaelwc2 - zaelwc1 ) * ppres * amdair / ( argas * ptemp )
5386	!
5387	!-- Initialise variables
5388	adtc(:) = 0.0_wp
5389	zcwc = 0.0_wp
5390	zcwcae = 0.0_wp
5391	zcwint = 0.0_wp
5392	zcwintae = 0.0_wp
5393	zcwn = 0.0_wp
5394	zcwnae = 0.0_wp
5395	zhlp1 = 0.0_wp
5396	zwsatae = 0.0_wp
5397	!
5398	!-- Air:
5399	!-- Density (kg/m3)
5400	rhoair = amdair * ppres / ( argas * ptemp )
5401	!-- Thermal conductivity of air
5402	zthcond = 0.023807_wp + 7.1128E-5_wp * ( ptemp - 273.16_wp )
5403	!
5404	!-- Water vapour:
5405	!
5406	!-- Molecular diffusion coefficient (cm2/s) (eq.16.17)
5407	zdfh2o = ( 5.0_wp / ( 16.0_wp * avo * rhoair * 1.0E-3_wp * &
5408	( 3.11E-8_wp ) ** 2.0_wp ) ) * SQRT( argas * 1.0E+7_wp * ptemp * &
5409	amdair * 1.0E+3_wp * ( amh2o + amdair ) * 1.0E+3_wp / ( 2.0_wp * &
5410	pi * amh2o * 1.0E+3_wp ) )
5411	zdfh2o = zdfh2o * 1.0E-4 ! Unit change to m^2/s
5412	!
5413	!-- Mean free path (eq. 15.25 & 16.29)
5414	zmfph2o = 3.0_wp * zdfh2o * SQRT( pi * amh2o / ( 8.0_wp * argas * ptemp ) )
5415	zka = 1.0_wp ! Assume activity coefficients as 1 for now.
5416	!
5417	!-- Kelvin effect (eq. 16.33)
5418	zkelvin = 1.0_wp
5419	zkelvin(1:nbins) = EXP( 4.0_wp * surfw0 * amh2o / ( argas * ptemp * &
5420	arhoh2o * paero(1:nbins)%dwet) )
5421	!
5422	! --Aerosols:
5423	zmtae(:) = 0.0_wp ! mass transfer coefficient
5424	zcwsurfae(:) = 0.0_wp ! surface mole concentrations
5425	DO b = 1, nbins
5426	IF ( paero(b)%numc > nclim .AND. zrh > 0.98_wp ) THEN
5427	!
5428	!-- Water activity
5429	zact = acth2o( paero(b) )
5430	!
5431	!-- Saturation mole concentration over flat surface. Limit the super-
5432	!-- saturation to max 1.01 for the mass transfer. Experimental!
5433	zcwsurfae(b) = MAX( pcs, pcw / 1.01_wp ) * rhoair / amh2o
5434	!
5435	!-- Equilibrium saturation ratio
5436	zwsatae(b) = zact * zkelvin(b)
5437	!
5438	!-- Knudsen number (eq. 16.20)
5439	zknud = 2.0_wp * zmfph2o / paero(b)%dwet
5440	!
5441	!-- Transitional correction factor (Fuks & Sutugin, 1971)
5442	zbeta = ( zknud + 1.0_wp ) / ( 0.377_wp * zknud + 1.0_wp + 4.0_wp / &
5443	( 3.0_wp * massacc(b) ) * ( zknud + zknud ** 2.0_wp ) )
5444	!
5445	!-- Mass transfer of H2O: Eq. 16.64 but here D^eff = zdfh2o * zbeta
5446	zhlp1 = paero(b)%numc * 2.0_wp * pi * paero(b)%dwet * zdfh2o * &
5447	zbeta
5448	!-- 1st term on the left side of the denominator in eq. 16.55
5449	zhlp2 = amh2o * zdfh2o * alv * zwsatae(b) * zcwsurfae(b) / &
5450	( zthcond * ptemp )
5451	!-- 2nd term on the left side of the denominator in eq. 16.55
5452	zhlp3 = ( (alv * amh2o ) / ( argas * ptemp ) ) - 1.0_wp
5453	!-- Full eq. 16.64: Mass transfer coefficient (1/s)
5454	zmtae(b) = zhlp1 / ( zhlp2 * zhlp3 + 1.0_wp )
5455	ENDIF
5456	ENDDO
5457	!
5458	!-- Current mole concentrations of water
5459	zcwc = pcw * rhoair / amh2o ! as vapour
5460	zcwcae(1:nbins) = paero(1:nbins)%volc(8) * arhoh2o / amh2o ! in aerosols
5461	zcwtot = zcwc + SUM( zcwcae ) ! total water concentration
5462	ttot = 0.0_wp
5463	adtc = 0.0_wp
5464	zcwintae = zcwcae
5465	!
5466	!-- Substepping loop
5467	zcwint = 0.0_wp
5468	DO WHILE ( ttot < ptstep )
5469	adt = 2.0E-2_wp ! internal timestep
5470	!
5471	!-- New vapour concentration: (eq. 16.71)
5472	zhlp1 = zcwc + adt * ( SUM( zmtae(nstr:nbins) * zwsatae(nstr:nbins) * &
5473	zcwsurfae(nstr:nbins) ) ) ! numerator
5474	zhlp2 = 1.0_wp + adt * ( SUM( zmtae(nstr:nbins) ) ) ! denomin.
5475	zcwint = zhlp1 / zhlp2 ! new vapour concentration
5476	zcwint = MIN( zcwint, zcwtot )
5477	IF ( ANY( paero(:)%numc > nclim ) .AND. zrh > 0.98_wp ) THEN
5478	DO b = nstr, nbins
5479	zcwintae(b) = zcwcae(b) + MIN( MAX( adt * zmtae(b) * &
5480	( zcwint - zwsatae(b) * zcwsurfae(b) ), &
5481	-0.02_wp * zcwcae(b) ), 0.05_wp * zcwcae(b) )
5482	zwsatae(b) = acth2o( paero(b), zcwintae(b) ) * zkelvin(b)
5483	ENDDO
5484	ENDIF
5485	zcwintae(nstr:nbins) = MAX( zcwintae(nstr:nbins), 0.0_wp )
5486	!
5487	!-- Update vapour concentration for consistency
5488	zcwint = zcwtot - SUM( zcwintae(1:nbins) )
5489	!-- Update "old" values for next cycle
5490	zcwcae = zcwintae
5491
5492	ttot = ttot + adt
5493	ENDDO ! ADT
5494	zcwn = zcwint
5495	zcwnae = zcwintae
5496	pcw = zcwn * amh2o / rhoair
5497	paero(1:nbins)%volc(8) = MAX( 0.0_wp, zcwnae(1:nbins) * amh2o / arhoh2o )
5498
5499	END SUBROUTINE gpparth2o
5500
5501	!------------------------------------------------------------------------------!
5502	! Description:
5503	! ------------
5504	!> Calculates the activity coefficient of liquid water
5505	!------------------------------------------------------------------------------!
5506	REAL(wp) FUNCTION acth2o( ppart, pcw )
5507
5508	IMPLICIT NONE
5509
5510	TYPE(t_section), INTENT(in) :: ppart !< Aerosol properties of a bin
5511	REAL(wp), INTENT(in), OPTIONAL :: pcw !< molar concentration of water
5512	!< (mol/m3)
5513
5514	REAL(wp) :: zns !< molar concentration of solutes (mol/m3)
5515	REAL(wp) :: znw !< molar concentration of water (mol/m3)
5516
5517	zns = ( 3.0_wp * ( ppart%volc(1) * arhoh2so4 / amh2so4 ) + &
5518	( ppart%volc(2) * arhooc / amoc ) + &
5519	2.0_wp * ( ppart%volc(5) * arhoss / amss ) + &
5520	( ppart%volc(6) * arhohno3 / amhno3 ) + &
5521	( ppart%volc(7) * arhonh3 / amnh3 ) )
5522	IF ( PRESENT(pcw) ) THEN
5523	znw = pcw
5524	ELSE
5525	znw = ppart%volc(8) * arhoh2o / amh2o
5526	ENDIF
5527	!-- Activity = partial pressure of water vapour /
5528	!-- sat. vapour pressure of water over a bulk liquid surface
5529	!-- = molality * activity coefficient (Jacobson, 2005: eq. 17.20-21)
5530	!-- Assume activity coefficient of 1 for water
5531	acth2o = MAX( 0.1_wp, znw / MAX( EPSILON( 1.0_wp ),( znw + zns ) ) )
5532	END FUNCTION acth2o
5533
5534	!------------------------------------------------------------------------------!
5535	! Description:
5536	! ------------
5537	!> Calculates the dissolutional growth of particles (i.e. gas transfers to a
5538	!> particle surface and dissolves in liquid water on the surface). Treated here
5539	!> as a non-equilibrium (time-dependent) process. Gases: HNO3 and NH3
5540	!> (Chapter 17.14 in Jacobson, 2005).
5541	!
5542	!> Called from subroutine condensation.
5543	!> Coded by:
5544	!> Harri Kokkola (FMI)
5545	!------------------------------------------------------------------------------!
5546	SUBROUTINE gpparthno3( ppres, ptemp, paero, pghno3, pgnh3, pcw, pcs, pbeta, &
5547	ptstep )
5548
5549	IMPLICIT NONE
5550	!
5551	!-- Input and output variables
5552	REAL(wp), INTENT(in) :: pbeta(nbins) !< transitional correction factor for
5553	!< aerosols
5554	REAL(wp), INTENT(in) :: ppres !< ambient pressure (Pa)
5555	REAL(wp), INTENT(in) :: pcs !< water vapour saturation
5556	!< concentration (kg/m3)
5557	REAL(wp), INTENT(in) :: ptemp !< ambient temperature (K)
5558	REAL(wp), INTENT(in) :: ptstep !< time step (s)
5559	REAL(wp), INTENT(inout) :: pghno3 !< nitric acid concentration (#/m3)
5560	REAL(wp), INTENT(inout) :: pgnh3 !< ammonia conc. (#/m3)
5561	REAL(wp), INTENT(inout) :: pcw !< water vapour concentration (kg/m3)
5562	TYPE(t_section), INTENT(inout) :: paero(nbins) !< Aerosol properties
5563	!
5564	!-- Local variables
5565	INTEGER(iwp) :: b !< loop index
5566	REAL(wp) :: adt !< timestep
5567	REAL(wp) :: zachhso4ae(nbins) !< Activity coefficients for HHSO4
5568	REAL(wp) :: zacnh3ae(nbins) !< Activity coefficients for NH3
5569	REAL(wp) :: zacnh4hso2ae(nbins)!< Activity coefficients for NH4HSO2
5570	REAL(wp) :: zacno3ae(nbins) !< Activity coefficients for HNO3
5571	REAL(wp) :: zcgnh3eqae(nbins) !< Equilibrium gas concentration: NH3
5572	REAL(wp) :: zcgno3eqae(nbins) !< Equilibrium gas concentration: HNO3
5573	REAL(wp) :: zcgwaeqae(nbins) !< Equilibrium gas concentration: H2O
5574	REAL(wp) :: zcnh3c !< Current NH3 gas concentration
5575	REAL(wp) :: zcnh3int !< Intermediate NH3 gas concentration
5576	REAL(wp) :: zcnh3intae(nbins) !< Intermediate NH3 aerosol concentration
5577	REAL(wp) :: zcnh3n !< New NH3 gas concentration
5578	REAL(wp) :: zcnh3cae(nbins) !< Current NH3 in aerosols
5579	REAL(wp) :: zcnh3nae(nbins) !< New NH3 in aerosols
5580	REAL(wp) :: zcnh3tot !< Total NH3 concentration
5581	REAL(wp) :: zcno3c !< Current HNO3 gas concentration
5582	REAL(wp) :: zcno3int !< Intermediate HNO3 gas concentration
5583	REAL(wp) :: zcno3intae(nbins) !< Intermediate HNO3 aerosol concentration
5584	REAL(wp) :: zcno3n !< New HNO3 gas concentration
5585	REAL(wp) :: zcno3cae(nbins) !< Current HNO3 in aerosols
5586	REAL(wp) :: zcno3nae(nbins) !< New HNO3 in aerosols
5587	REAL(wp) :: zcno3tot !< Total HNO3 concentration
5588	REAL(wp) :: zdfvap !< Diffusion coefficient for vapors
5589	REAL(wp) :: zhlp1 !< helping variable
5590	REAL(wp) :: zhlp2 !< helping variable
5591	REAL(wp) :: zkelnh3ae(nbins) !< Kelvin effects for NH3
5592	REAL(wp) :: zkelno3ae(nbins) !< Kelvin effect for HNO3
5593	REAL(wp) :: zmolsae(nbins,7) !< Ion molalities from pdfite
5594	REAL(wp) :: zmtnh3ae(nbins) !< Mass transfer coefficients for NH3
5595	REAL(wp) :: zmtno3ae(nbins) !< Mass transfer coefficients for HNO3
5596	REAL(wp) :: zrh !< relative humidity
5597	REAL(wp) :: zsathno3ae(nbins) !< HNO3 saturation ratio
5598	REAL(wp) :: zsatnh3ae(nbins) !< NH3 saturation ratio = the partial
5599	!< pressure of a gas divided by its
5600	!< saturation vapor pressure over a surface
5601	!
5602	!-- Initialise:
5603	adt = ptstep
5604	zachhso4ae = 0.0_wp
5605	zacnh3ae = 0.0_wp
5606	zacnh4hso2ae = 0.0_wp
5607	zacno3ae = 0.0_wp
5608	zcgnh3eqae = 0.0_wp
5609	zcgno3eqae = 0.0_wp
5610	zcnh3c = 0.0_wp
5611	zcnh3cae = 0.0_wp
5612	zcnh3int = 0.0_wp
5613	zcnh3intae = 0.0_wp
5614	zcnh3n = 0.0_wp
5615	zcnh3nae = 0.0_wp
5616	zcnh3tot = 0.0_wp
5617	zcno3c = 0.0_wp
5618	zcno3cae = 0.0_wp
5619	zcno3int = 0.0_wp
5620	zcno3intae = 0.0_wp
5621	zcno3n = 0.0_wp
5622	zcno3nae = 0.0_wp
5623	zcno3tot = 0.0_wp
5624	zhlp1 = 0.0_wp
5625	zhlp2 = 0.0_wp
5626	zkelno3ae = 1.0_wp
5627	zkelnh3ae = 1.0_wp
5628	zmolsae = 0.0_wp
5629	zmtno3ae = 0.0_wp
5630	zmtnh3ae = 0.0_wp
5631	zrh = 0.0_wp
5632	zsatnh3ae = 1.0_wp
5633	zsathno3ae = 1.0_wp
5634	!
5635	!-- Diffusion coefficient (m2/s)
5636	zdfvap = 5.1111E-10_wp * ptemp ** 1.75_wp * ( p_0 + 1325.0_wp ) / ppres
5637	!
5638	!-- Kelvin effects (Jacobson (2005), eq. 16.33)
5639	zkelno3ae(1:nbins) = EXP( 4.0_wp * surfw0 * amvhno3 / ( abo * ptemp * &
5640	paero(1:nbins)%dwet ) )
5641	zkelnh3ae(1:nbins) = EXP( 4.0_wp * surfw0 * amvnh3 / ( abo * ptemp * &
5642	paero(1:nbins)%dwet ) )
5643	!
5644	!-- Current vapour mole concentrations (mol/m3)
5645	zcno3c = pghno3 / avo ! HNO3
5646	zcnh3c = pgnh3 / avo ! NH3
5647	!
5648	!-- Current particle mole concentrations (mol/m3)
5649	zcno3cae(1:nbins) = paero(1:nbins)%volc(6) * arhohno3 / amhno3
5650	zcnh3cae(1:nbins) = paero(1:nbins)%volc(7) * arhonh3 / amnh3
5651	!
5652	!-- Total mole concentrations: gas and particle phase
5653	zcno3tot = zcno3c + SUM( zcno3cae(1:nbins) )
5654	zcnh3tot = zcnh3c + SUM( zcnh3cae(1:nbins) )
5655	!
5656	!-- Relative humidity [0-1]
5657	zrh = pcw / pcs
5658	!
5659	!-- Mass transfer coefficients (Jacobson, Eq. 16.64)
5660	zmtno3ae(1:nbins) = 2.0_wp * pi * paero(1:nbins)%dwet * zdfvap * &
5661	paero(1:nbins)%numc * pbeta(1:nbins)
5662	zmtnh3ae(1:nbins) = 2.0_wp * pi * paero(1:nbins)%dwet * zdfvap * &
5663	paero(1:nbins)%numc * pbeta(1:nbins)
5664
5665	!
5666	!-- Get the equilibrium concentrations above aerosols
5667	CALL NONHEquil( zrh, ptemp, paero, zcgno3eqae, zcgnh3eqae, zacno3ae, &
5668	zacnh3ae, zacnh4hso2ae, zachhso4ae, zmolsae )
5669
5670	!
5671	!-- NH4/HNO3 saturation ratios for aerosols
5672	CALL SVsat( ptemp, paero, zacno3ae, zacnh3ae, zacnh4hso2ae, zachhso4ae, &
5673	zcgno3eqae, zcno3cae, zcnh3cae, zkelno3ae, zkelnh3ae, &
5674	zsathno3ae, zsatnh3ae, zmolsae )
5675	!
5676	!-- Intermediate concentrations
5677	zhlp1 = SUM( zcno3cae(1:nbins) / ( 1.0_wp + adt * zmtno3ae(1:nbins) * &
5678	zsathno3ae(1:nbins) ) )
5679	zhlp2 = SUM( zmtno3ae(1:nbins) / ( 1.0_wp + adt * zmtno3ae(1:nbins) * &
5680	zsathno3ae(1:nbins) ) )
5681	zcno3int = ( zcno3tot - zhlp1 ) / ( 1.0_wp + adt * zhlp2 )
5682
5683	zhlp1 = SUM( zcnh3cae(1:nbins) / ( 1.0_wp + adt * zmtnh3ae(1:nbins) * &
5684	zsatnh3ae(1:nbins) ) )
5685	zhlp2 = SUM( zmtnh3ae(1:nbins) / ( 1.0_wp + adt * zmtnh3ae(1:nbins) * &
5686	zsatnh3ae(1:nbins) ) )
5687	zcnh3int = ( zcnh3tot - zhlp1 )/( 1.0_wp + adt * zhlp2 )
5688
5689	zcno3int = MIN(zcno3int, zcno3tot)
5690	zcnh3int = MIN(zcnh3int, zcnh3tot)
5691	!
5692	!-- Calculate the new particle concentrations
5693	zcno3intae = zcno3cae
5694	zcnh3intae = zcnh3cae
5695	DO b = 1, nbins
5696	zcno3intae(b) = ( zcno3cae(b) + adt * zmtno3ae(b) * zcno3int ) / &
5697	( 1.0_wp + adt * zmtno3ae(b) * zsathno3ae(b) )
5698	zcnh3intae(b) = ( zcnh3cae(b) + adt * zmtnh3ae(b) * zcnh3int ) / &
5699	( 1.0_wp + adt * zmtnh3ae(b) * zsatnh3ae(b) )
5700	ENDDO
5701
5702	zcno3intae(1:nbins) = MAX( zcno3intae(1:nbins), 0.0_wp )
5703	zcnh3intae(1:nbins) = MAX( zcnh3intae(1:nbins), 0.0_wp )
5704
5705	zcno3n = zcno3int ! Final molar gas concentration of HNO3
5706	zcno3nae = zcno3intae ! Final molar particle concentration of HNO3
5707
5708	zcnh3n = zcnh3int ! Final molar gas concentration of NH3
5709	zcnh3nae = zcnh3intae ! Final molar particle concentration of NH3
5710	!
5711	!-- Model timestep reached - update the new arrays
5712	pghno3 = zcno3n * avo
5713	pgnh3 = zcnh3n * avo
5714
5715	DO b = in1a, fn2b
5716	paero(b)%volc(6) = zcno3nae(b) * amhno3 / arhohno3
5717	paero(b)%volc(7) = zcnh3nae(b) * amnh3 / arhonh3
5718	ENDDO
5719
5720
5721	END SUBROUTINE gpparthno3
5722	!------------------------------------------------------------------------------!
5723	! Description:
5724	! ------------
5725	!> Calculate the equilibrium concentrations above aerosols (reference?)
5726	!------------------------------------------------------------------------------!
5727	SUBROUTINE NONHEquil( prh, ptemp, ppart, pcgno3eq, pcgnh3eq, pgammano, &
5728	pgammanh, pgammanh4hso2, pgammahhso4, pmols )
5729
5730	IMPLICIT NONE
5731
5732	REAL(wp), INTENT(in) :: prh !< relative humidity
5733	REAL(wp), INTENT(in) :: ptemp !< ambient temperature (K)
5734
5735	TYPE(t_section), INTENT(inout) :: ppart(nbins) !< Aerosol properties
5736	!-- Equilibrium molar concentration above aerosols:
5737	REAL(wp), INTENT(inout) :: pcgnh3eq(nbins) !< of NH3
5738	REAL(wp), INTENT(inout) :: pcgno3eq(nbins) !< of HNO3
5739	!< Activity coefficients:
5740	REAL(wp), INTENT(inout) :: pgammahhso4(nbins) !< HHSO4
5741	REAL(wp), INTENT(inout) :: pgammanh(nbins) !< NH3
5742	REAL(wp), INTENT(inout) :: pgammanh4hso2(nbins) !< NH4HSO2
5743	REAL(wp), INTENT(inout) :: pgammano(nbins) !< HNO3
5744	REAL(wp), INTENT(inout) :: pmols(nbins,7) !< Ion molalities
5745
5746	INTEGER(iwp) :: b
5747
5748	REAL(wp) :: zgammas(7) !< Activity coefficients
5749	REAL(wp) :: zhlp !< Dummy variable
5750	REAL(wp) :: zions(7) !< molar concentration of ion (mol/m3)
5751	REAL(wp) :: zphcl !< Equilibrium vapor pressures (Pa??)
5752	REAL(wp) :: zphno3 !< Equilibrium vapor pressures (Pa??)
5753	REAL(wp) :: zpnh3 !< Equilibrium vapor pressures (Pa??)
5754	REAL(wp) :: zwatertotal !< Total water in particles (mol/m3) ???
5755
5756	zgammas = 0.0_wp
5757	zhlp = 0.0_wp
5758	zions = 0.0_wp
5759	zphcl = 0.0_wp
5760	zphno3 = 0.0_wp
5761	zpnh3 = 0.0_wp
5762	zwatertotal = 0.0_wp
5763
5764	DO b = 1, nbins
5765
5766	IF ( ppart(b)%numc < nclim ) CYCLE
5767	!
5768	!-- 2*H2SO4 + CL + NO3 - Na - NH4
5769	zhlp = 2.0_wp * ppart(b)%volc(1) * arhoh2so4 / amh2so4 + &
5770	ppart(b)%volc(5) * arhoss / amss + &
5771	ppart(b)%volc(6) * arhohno3 / amhno3 - &
5772	ppart(b)%volc(5) * arhoss / amss - &
5773	ppart(b)%volc(7) * arhonh3 / amnh3
5774
5775	zhlp = MAX( zhlp, 1.0E-30_wp )
5776
5777	zions(1) = zhlp ! H+
5778	zions(2) = ppart(b)%volc(7) * arhonh3 / amnh3 ! NH4+
5779	zions(3) = ppart(b)%volc(5) * arhoss / amss ! Na+
5780	zions(4) = ppart(b)%volc(1) * arhoh2so4 / amh2so4 ! SO4(2-)
5781	zions(5) = 0.0_wp ! HSO4-
5782	zions(6) = ppart(b)%volc(6) * arhohno3 / amhno3 ! NO3-
5783	zions(7) = ppart(b)%volc(5) * arhoss / amss ! Cl-
5784
5785	zwatertotal = ppart(b)%volc(8) * arhoh2o / amh2o
5786	IF ( zwatertotal > 1.0E-30_wp ) THEN
5787	CALL inorganic_pdfite( prh, ptemp, zions, zwatertotal, zphno3, zphcl,&
5788	zpnh3, zgammas, pmols(b,:) )
5789	ENDIF
5790	!
5791	!-- Activity coefficients
5792	pgammano(b) = zgammas(1) ! HNO3
5793	pgammanh(b) = zgammas(3) ! NH3
5794	pgammanh4hso2(b) = zgammas(6) ! NH4HSO2
5795	pgammahhso4(b) = zgammas(7) ! HHSO4
5796	!
5797	!-- Equilibrium molar concentrations (mol/m3) from equlibrium pressures (Pa)
5798	pcgno3eq(b) = zphno3 / ( argas * ptemp )
5799	pcgnh3eq(b) = zpnh3 / ( argas * ptemp )
5800
5801	ENDDO
5802
5803	END SUBROUTINE NONHEquil
5804
5805	!------------------------------------------------------------------------------!
5806	! Description:
5807	! ------------
5808	!> Calculate saturation ratios of NH4 and HNO3 for aerosols
5809	!------------------------------------------------------------------------------!
5810	SUBROUTINE SVsat( ptemp, ppart, pachno3, pacnh3, pacnh4hso2, pachhso4, &
5811	pchno3eq, pchno3, pcnh3, pkelhno3, pkelnh3, psathno3, &
5812	psatnh3, pmols )
5813
5814	IMPLICIT NONE
5815
5816	REAL(wp), INTENT(in) :: ptemp !< ambient temperature (K)
5817
5818	TYPE(t_section), INTENT(inout) :: ppart(nbins) !< Aerosol properties
5819	!-- Activity coefficients
5820	REAL(wp), INTENT(in) :: pachhso4(nbins) !<
5821	REAL(wp), INTENT(in) :: pacnh3(nbins) !<
5822	REAL(wp), INTENT(in) :: pacnh4hso2(nbins) !<
5823	REAL(wp), INTENT(in) :: pachno3(nbins) !<
5824	REAL(wp), INTENT(in) :: pchno3eq(nbins) !< Equilibrium surface concentration
5825	!< of HNO3
5826	REAL(wp), INTENT(in) :: pchno3(nbins) !< Current particle mole
5827	!< concentration of HNO3 (mol/m3)
5828	REAL(wp), INTENT(in) :: pcnh3(nbins) !< Current particle mole
5829	!< concentration of NH3 (mol/m3)
5830	REAL(wp), INTENT(in) :: pkelhno3(nbins) !< Kelvin effect for HNO3
5831	REAL(wp), INTENT(in) :: pkelnh3(nbins) !< Kelvin effect for NH3
5832	REAL(wp), INTENT(in) :: pmols(nbins,7)
5833	!-- Saturation ratios
5834	REAL(wp), INTENT(out) :: psathno3(nbins) !<
5835	REAL(wp), INTENT(out) :: psatnh3(nbins) !<
5836
5837	INTEGER :: b !< running index for aerosol bins
5838	!-- Constants for calculating equilibrium constants:
5839	REAL(wp), PARAMETER :: a1 = -22.52_wp !<
5840	REAL(wp), PARAMETER :: a2 = -1.50_wp !<
5841	REAL(wp), PARAMETER :: a3 = 13.79_wp !<
5842	REAL(wp), PARAMETER :: a4 = 29.17_wp !<
5843	REAL(wp), PARAMETER :: b1 = 26.92_wp !<
5844	REAL(wp), PARAMETER :: b2 = 26.92_wp !<
5845	REAL(wp), PARAMETER :: b3 = -5.39_wp !<
5846	REAL(wp), PARAMETER :: b4 = 16.84_wp !<
5847	REAL(wp), PARAMETER :: K01 = 1.01E-14_wp !<
5848	REAL(wp), PARAMETER :: K02 = 1.81E-5_wp !<
5849	REAL(wp), PARAMETER :: K03 = 57.64_wp !<
5850	REAL(wp), PARAMETER :: K04 = 2.51E+6_wp !<
5851	!-- Equilibrium constants of equilibrium reactions
5852	REAL(wp) :: KllH2O !< H2O(aq) <--> H+ + OH- (mol/kg)
5853	REAL(wp) :: KllNH3 !< NH3(aq) + H2O(aq) <--> NH4+ + OH- (mol/kg)
5854	REAL(wp) :: KglNH3 !< NH3(g) <--> NH3(aq) (mol/kg/atm)
5855	REAL(wp) :: KglHNO3 !< HNO3(g) <--> H+ + NO3- (mol2/kg2/atm)
5856	REAL(wp) :: zmolno3 !< molality of NO3- (mol/kg)
5857	REAL(wp) :: zmolhp !< molality of H+ (mol/kg)
5858	REAL(wp) :: zmolso4 !< molality of SO4(2-) (mol/kg)
5859	REAL(wp) :: zmolcl !< molality of Cl (mol/kg)
5860	REAL(wp) :: zmolnh4 !< Molality of NH4 (mol/kg)
5861	REAL(wp) :: zmolna !< Molality of Na (mol/kg)
5862	REAL(wp) :: zhlp1 !<
5863	REAL(wp) :: zhlp2 !<
5864	REAL(wp) :: zhlp3 !<
5865	REAL(wp) :: zxi !<
5866	REAL(wp) :: zt0 !< Reference temp
5867
5868	zhlp1 = 0.0_wp
5869	zhlp2 = 0.0_wp
5870	zhlp3 = 0.0_wp
5871	zmolcl = 0.0_wp
5872	zmolhp = 0.0_wp
5873	zmolna = 0.0_wp
5874	zmolnh4 = 0.0_wp
5875	zmolno3 = 0.0_wp
5876	zmolso4 = 0.0_wp
5877	zt0 = 298.15_wp
5878	zxi = 0.0_wp
5879	!
5880	!-- Calculates equlibrium rate constants based on Table B.7 in Jacobson (2005)
5881	!-- K^ll_H20, K^ll_NH3, K^gl_NH3, K^gl_HNO3
5882	zhlp1 = zt0 / ptemp
5883	zhlp2 = zhlp1 - 1.0_wp
5884	zhlp3 = 1.0_wp + LOG( zhlp1 ) - zhlp1
5885
5886	KllH2O = K01 * EXP( a1 * zhlp2 + b1 * zhlp3 )
5887	KllNH3 = K02 * EXP( a2 * zhlp2 + b2 * zhlp3 )
5888	KglNH3 = K03 * EXP( a3 * zhlp2 + b3 * zhlp3 )
5889	KglHNO3 = K04 * EXP( a4 * zhlp2 + b4 * zhlp3 )
5890
5891	DO b = 1, nbins
5892
5893	IF ( ppart(b)%numc > nclim .AND. ppart(b)%volc(8) > 1.0E-30_wp ) THEN
5894	!
5895	!-- Molality of H+ and NO3-
5896	zhlp1 = pcnh3(b) * amnh3 + ppart(b)%volc(1) * arhoh2so4 + &
5897	ppart(b)%volc(2) * arhooc + ppart(b)%volc(5) * arhoss + &
5898	ppart(b)%volc(8) * arhoh2o
5899	zmolno3 = pchno3(b) / zhlp1 !< mol/kg
5900	!
5901	!-- Particle mole concentration ratio: (NH3+SS)/H2SO4
5902	zxi = ( pcnh3(b) + ppart(b)%volc(5) * arhoss / amss ) / &
5903	( ppart(b)%volc(1) * arhoh2so4 / amh2so4 )
5904
5905	IF ( zxi <= 2.0_wp ) THEN
5906	!
5907	!-- Molality of SO4(2-)
5908	zhlp1 = pcnh3(b) * amnh3 + pchno3(b) * amhno3 + &
5909	ppart(b)%volc(2) * arhooc + ppart(b)%volc(5) * arhoss + &
5910	ppart(b)%volc(8) * arhoh2o
5911	zmolso4 = ( ppart(b)%volc(1) * arhoh2so4 / amh2so4 ) / zhlp1
5912	!
5913	!-- Molality of Cl-
5914	zhlp1 = pcnh3(b) * amnh3 + pchno3(b) * amhno3 + &
5915	ppart(b)%volc(2) * arhooc + ppart(b)%volc(1) * arhoh2so4 &
5916	+ ppart(b)%volc(8) * arhoh2o
5917	zmolcl = ( ppart(b)%volc(5) * arhoss / amss ) / zhlp1
5918	!
5919	!-- Molality of NH4+
5920	zhlp1 = pchno3(b) * amhno3 + ppart(b)%volc(1) * arhoh2so4 + &
5921	ppart(b)%volc(2) * arhooc + ppart(b)%volc(5) * arhoss + &
5922	ppart(b)%volc(8) * arhoh2o
5923	zmolnh4 = pcnh3(b) / zhlp1
5924	!
5925	!-- Molality of Na+
5926	zmolna = zmolcl
5927	!
5928	!-- Molality of H+
5929	zmolhp = 2.0_wp * zmolso4 + zmolno3 + zmolcl - ( zmolnh4 + zmolna )
5930
5931	ELSE
5932
5933	zhlp2 = pkelhno3(b) * zmolno3 * pachno3(b) ** 2.0_wp
5934	!
5935	!-- Mona debugging
5936	IF ( zhlp2 > 1.0E-30_wp ) THEN
5937	zmolhp = KglHNO3 * pchno3eq(b) / zhlp2 ! Eq. 17.38
5938	ELSE
5939	zmolhp = 0.0_wp
5940	ENDIF
5941
5942	ENDIF
5943
5944	zhlp1 = ppart(b)%volc(8) * arhoh2o * argas * ptemp * KglHNO3
5945	!
5946	!-- Saturation ratio for NH3 and for HNO3
5947	IF ( zmolhp > 0.0_wp ) THEN
5948	zhlp2 = pkelnh3(b) / ( zhlp1 * zmolhp )
5949	zhlp3 = KllH2O / ( KllNH3 + KglNH3 )
5950	psatnh3(b) = zhlp2 * ( ( pacnh4hso2(b) / pachhso4(b) ) **2.0_wp ) &
5951	* zhlp3
5952	psathno3(b) = ( pkelhno3(b) * zmolhp * pachno3(b)**2.0_wp ) / zhlp1
5953	ELSE
5954	psatnh3(b) = 1.0_wp
5955	psathno3(b) = 1.0_wp
5956	ENDIF
5957	ELSE
5958	psatnh3(b) = 1.0_wp
5959	psathno3(b) = 1.0_wp
5960	ENDIF
5961
5962	ENDDO
5963
5964	END SUBROUTINE SVsat
5965
5966	!------------------------------------------------------------------------------!
5967	! Description:
5968	! ------------
5969	!> Prototype module for calculating the water content of a mixed inorganic/
5970	!> organic particle + equilibrium water vapour pressure above the solution
5971	!> (HNO3, HCL, NH3 and representative organic compounds. Efficient calculation
5972	!> of the partitioning of species between gas and aerosol. Based in a chamber
5973	!> study.
5974	!
5975	!> Written by Dave Topping. Pure organic component properties predicted by Mark
5976	!> Barley based on VOCs predicted in MCM simulations performed by Mike Jenkin.
5977	!> Delivered by Gordon McFiggans as Deliverable D22 from WP1.4 in the EU FP6
5978	!> EUCAARI Integrated Project.
5979	!
5980	!> Queries concerning the use of this code through Gordon McFiggans,
5981	!> g.mcfiggans@manchester.ac.uk,
5982	!> Ownership: D. Topping, Centre for Atmospheric Sciences, University of
5983	!> Manchester, 2007
5984	!
5985	!> Rewritten to PALM by Mona Kurppa, UHel, 2017
5986	!------------------------------------------------------------------------------!
5987	SUBROUTINE inorganic_pdfite( RH, temp, ions, water_total, Press_HNO3, &
5988	Press_HCL, Press_NH3, gamma_out, mols_out )
5989
5990	IMPLICIT NONE
5991
5992	REAL(wp), DIMENSION(:) :: gamma_out !< Activity coefficient for calculating
5993	!< the non-ideal dissociation constants
5994	!< 1: HNO3, 2: HCL, 3: NH4+/H+ (NH3)
5995	!< 4: HHSO4**2/H2SO4,
5996	!< 5: H2SO43/HHSO42
5997	!< 6: NH4HSO2, 7: HHSO4
5998	REAL(wp), DIMENSION(:) :: ions !< ion molarities (mol/m3)
5999	!< 1: H+, 2: NH4+, 3: Na+, 4: SO4(2-),
6000	!< 5: HSO4-, 6: NO3-, 7: Cl-
6001	REAL(wp), DIMENSION(7) :: ions_mol !< ion molalities (mol/kg)
6002	!< 1: H+, 2: NH4+, 3: Na+, 4: SO4(2-),
6003	!< 5: HSO4-, 6: NO3-, 7: Cl-
6004	REAL(wp), DIMENSION(:) :: mols_out !< ion molality output (mol/kg)
6005	!< 1: H+, 2: NH4+, 3: Na+, 4: SO4(2-),
6006	!< 5: HSO4-, 6: NO3-, 7: Cl-
6007	REAL(wp) :: act_product !< ionic activity coef. product:
6008	!< = (gamma_h2so4**3d0) /
6009	!< (gamma_hhso4**2d0)
6010	REAL(wp) :: ammonium_chloride !<
6011	REAL(wp) :: ammonium_chloride_eq_frac !<
6012	REAL(wp) :: ammonium_nitrate !<
6013	REAL(wp) :: ammonium_nitrate_eq_frac !<
6014	REAL(wp) :: ammonium_sulphate !<
6015	REAL(wp) :: ammonium_sulphate_eq_frac !<
6016	REAL(wp) :: binary_h2so4 !< binary H2SO4 activity coeff.
6017	REAL(wp) :: binary_hcl !< binary HCL activity coeff.
6018	REAL(wp) :: binary_hhso4 !< binary HHSO4 activity coeff.
6019	REAL(wp) :: binary_hno3 !< binary HNO3 activity coeff.
6020	REAL(wp) :: binary_nh4hso4 !< binary NH4HSO4 activity coeff.
6021	REAL(wp) :: charge_sum !< sum of ionic charges
6022	REAL(wp) :: gamma_h2so4 !< activity coefficient
6023	REAL(wp) :: gamma_hcl !< activity coefficient
6024	REAL(wp) :: gamma_hhso4 !< activity coeffient
6025	REAL(wp) :: gamma_hno3 !< activity coefficient
6026	REAL(wp) :: gamma_nh3 !< activity coefficient
6027	REAL(wp) :: gamma_nh4hso4 !< activity coefficient
6028	REAL(wp) :: h_out !<
6029	REAL(wp) :: h_real !< new hydrogen ion conc.
6030	REAL(wp) :: H2SO4_hcl !< contribution of H2SO4
6031	REAL(wp) :: H2SO4_hno3 !< contribution of H2SO4
6032	REAL(wp) :: H2SO4_nh3 !< contribution of H2SO4
6033	REAL(wp) :: H2SO4_nh4hso4 !< contribution of H2SO4
6034	REAL(wp) :: HCL_h2so4 !< contribution of HCL
6035	REAL(wp) :: HCL_hhso4 !< contribution of HCL
6036	REAL(wp) :: HCL_hno3 !< contribution of HCL
6037	REAL(wp) :: HCL_nh3 !< contribution of HCL
6038	REAL(wp) :: HCL_nh4hso4 !< contribution of HCL
6039	REAL(wp) :: henrys_temp_dep !< temperature dependence of
6040	!< Henry's Law
6041	REAL(wp) :: HNO3_h2so4 !< contribution of HNO3
6042	REAL(wp) :: HNO3_hcl !< contribution of HNO3
6043	REAL(wp) :: HNO3_hhso4 !< contribution of HNO3
6044	REAL(wp) :: HNO3_nh3 !< contribution of HNO3
6045	REAL(wp) :: HNO3_nh4hso4 !< contribution of HNO3
6046	REAL(wp) :: hso4_out !<
6047	REAL(wp) :: hso4_real !< new bisulphate ion conc.
6048	REAL(wp) :: hydrochloric_acid !<
6049	REAL(wp) :: hydrochloric_acid_eq_frac !<
6050	REAL(wp) :: Kh !< equilibrium constant for H+
6051	REAL(wp) :: K_hcl !< equilibrium constant of HCL
6052	REAL(wp) :: K_hno3 !< equilibrium constant of HNO3
6053	REAL(wp) :: Knh4 !< equilibrium constant for NH4+
6054	REAL(wp) :: Kw !< equil. const. for water_surface
6055	REAL(wp) :: Ln_h2so4_act !< gamma_h2so4 = EXP(Ln_h2so4_act)
6056	REAL(wp) :: Ln_HCL_act !< gamma_hcl = EXP( Ln_HCL_act )
6057	REAL(wp) :: Ln_hhso4_act !< gamma_hhso4 = EXP(Ln_hhso4_act)
6058	REAL(wp) :: Ln_HNO3_act !< gamma_hno3 = EXP( Ln_HNO3_act )
6059	REAL(wp) :: Ln_NH4HSO4_act !< gamma_nh4hso4 =
6060	!< EXP( Ln_NH4HSO4_act )
6061	REAL(wp) :: molality_ratio_nh3 !< molality ratio of NH3
6062	!< (NH4+ and H+)
6063	REAL(wp) :: Na2SO4_h2so4 !< contribution of Na2SO4
6064	REAL(wp) :: Na2SO4_hcl !< contribution of Na2SO4
6065	REAL(wp) :: Na2SO4_hhso4 !< contribution of Na2SO4
6066	REAL(wp) :: Na2SO4_hno3 !< contribution of Na2SO4
6067	REAL(wp) :: Na2SO4_nh3 !< contribution of Na2SO4
6068	REAL(wp) :: Na2SO4_nh4hso4 !< contribution of Na2SO4
6069	REAL(wp) :: NaCl_h2so4 !< contribution of NaCl
6070	REAL(wp) :: NaCl_hcl !< contribution of NaCl
6071	REAL(wp) :: NaCl_hhso4 !< contribution of NaCl
6072	REAL(wp) :: NaCl_hno3 !< contribution of NaCl
6073	REAL(wp) :: NaCl_nh3 !< contribution of NaCl
6074	REAL(wp) :: NaCl_nh4hso4 !< contribution of NaCl
6075	REAL(wp) :: NaNO3_h2so4 !< contribution of NaNO3
6076	REAL(wp) :: NaNO3_hcl !< contribution of NaNO3
6077	REAL(wp) :: NaNO3_hhso4 !< contribution of NaNO3
6078	REAL(wp) :: NaNO3_hno3 !< contribution of NaNO3
6079	REAL(wp) :: NaNO3_nh3 !< contribution of NaNO3
6080	REAL(wp) :: NaNO3_nh4hso4 !< contribution of NaNO3
6081	REAL(wp) :: NH42SO4_h2so4 !< contribution of NH42SO4
6082	REAL(wp) :: NH42SO4_hcl !< contribution of NH42SO4
6083	REAL(wp) :: NH42SO4_hhso4 !< contribution of NH42SO4
6084	REAL(wp) :: NH42SO4_hno3 !< contribution of NH42SO4
6085	REAL(wp) :: NH42SO4_nh3 !< contribution of NH42SO4
6086	REAL(wp) :: NH42SO4_nh4hso4 !< contribution of NH42SO4
6087	REAL(wp) :: NH4Cl_h2so4 !< contribution of NH4Cl
6088	REAL(wp) :: NH4Cl_hcl !< contribution of NH4Cl
6089	REAL(wp) :: NH4Cl_hhso4 !< contribution of NH4Cl
6090	REAL(wp) :: NH4Cl_hno3 !< contribution of NH4Cl
6091	REAL(wp) :: NH4Cl_nh3 !< contribution of NH4Cl
6092	REAL(wp) :: NH4Cl_nh4hso4 !< contribution of NH4Cl
6093	REAL(wp) :: NH4NO3_h2so4 !< contribution of NH4NO3
6094	REAL(wp) :: NH4NO3_hcl !< contribution of NH4NO3
6095	REAL(wp) :: NH4NO3_hhso4 !< contribution of NH4NO3
6096	REAL(wp) :: NH4NO3_hno3 !< contribution of NH4NO3
6097	REAL(wp) :: NH4NO3_nh3 !< contribution of NH4NO3
6098	REAL(wp) :: NH4NO3_nh4hso4 !< contribution of NH4NO3
6099	REAL(wp) :: nitric_acid !<
6100	REAL(wp) :: nitric_acid_eq_frac !< Equivalent fractions
6101	REAL(wp) :: Press_HCL !< partial pressure of HCL
6102	REAL(wp) :: Press_HNO3 !< partial pressure of HNO3
6103	REAL(wp) :: Press_NH3 !< partial pressure of NH3
6104	REAL(wp) :: RH !< relative humidity [0-1]
6105	REAL(wp) :: temp !< temperature
6106	REAL(wp) :: so4_out !<
6107	REAL(wp) :: so4_real !< new sulpate ion concentration
6108	REAL(wp) :: sodium_chloride !<
6109	REAL(wp) :: sodium_chloride_eq_frac !<
6110	REAL(wp) :: sodium_nitrate !<
6111	REAL(wp) :: sodium_nitrate_eq_frac !<
6112	REAL(wp) :: sodium_sulphate !<
6113	REAL(wp) :: sodium_sulphate_eq_frac !<
6114	REAL(wp) :: solutes !<
6115	REAL(wp) :: sulphuric_acid !<
6116	REAL(wp) :: sulphuric_acid_eq_frac !<
6117	REAL(wp) :: water_total !<
6118
6119	REAL(wp) :: a !< auxiliary variable
6120	REAL(wp) :: b !< auxiliary variable
6121	REAL(wp) :: c !< auxiliary variable
6122	REAL(wp) :: root1 !< auxiliary variable
6123	REAL(wp) :: root2 !< auxiliary variable
6124
6125	INTEGER(iwp) :: binary_case
6126	INTEGER(iwp) :: full_complexity
6127	!
6128	!-- Value initialisation
6129	binary_h2so4 = 0.0_wp
6130	binary_hcl = 0.0_wp
6131	binary_hhso4 = 0.0_wp
6132	binary_hno3 = 0.0_wp
6133	binary_nh4hso4 = 0.0_wp
6134	henrys_temp_dep = ( 1.0_wp / temp - 1.0_wp / 298.0_wp )
6135	HCL_hno3 = 1.0_wp
6136	H2SO4_hno3 = 1.0_wp
6137	NH42SO4_hno3 = 1.0_wp
6138	NH4NO3_hno3 = 1.0_wp
6139	NH4Cl_hno3 = 1.0_wp
6140	Na2SO4_hno3 = 1.0_wp
6141	NaNO3_hno3 = 1.0_wp
6142	NaCl_hno3 = 1.0_wp
6143	HNO3_hcl = 1.0_wp
6144	H2SO4_hcl = 1.0_wp
6145	NH42SO4_hcl = 1.0_wp
6146	NH4NO3_hcl = 1.0_wp
6147	NH4Cl_hcl = 1.0_wp
6148	Na2SO4_hcl = 1.0_wp
6149	NaNO3_hcl = 1.0_wp
6150	NaCl_hcl = 1.0_wp
6151	HNO3_nh3 = 1.0_wp
6152	HCL_nh3 = 1.0_wp
6153	H2SO4_nh3 = 1.0_wp
6154	NH42SO4_nh3 = 1.0_wp
6155	NH4NO3_nh3 = 1.0_wp
6156	NH4Cl_nh3 = 1.0_wp
6157	Na2SO4_nh3 = 1.0_wp
6158	NaNO3_nh3 = 1.0_wp
6159	NaCl_nh3 = 1.0_wp
6160	HNO3_hhso4 = 1.0_wp
6161	HCL_hhso4 = 1.0_wp
6162	NH42SO4_hhso4 = 1.0_wp
6163	NH4NO3_hhso4 = 1.0_wp
6164	NH4Cl_hhso4 = 1.0_wp
6165	Na2SO4_hhso4 = 1.0_wp
6166	NaNO3_hhso4 = 1.0_wp
6167	NaCl_hhso4 = 1.0_wp
6168	HNO3_h2so4 = 1.0_wp
6169	HCL_h2so4 = 1.0_wp
6170	NH42SO4_h2so4 = 1.0_wp
6171	NH4NO3_h2so4 = 1.0_wp
6172	NH4Cl_h2so4 = 1.0_wp
6173	Na2SO4_h2so4 = 1.0_wp
6174	NaNO3_h2so4 = 1.0_wp
6175	NaCl_h2so4 = 1.0_wp
6176	!-- New NH3 variables
6177	HNO3_nh4hso4 = 1.0_wp
6178	HCL_nh4hso4 = 1.0_wp
6179	H2SO4_nh4hso4 = 1.0_wp
6180	NH42SO4_nh4hso4 = 1.0_wp
6181	NH4NO3_nh4hso4 = 1.0_wp
6182	NH4Cl_nh4hso4 = 1.0_wp
6183	Na2SO4_nh4hso4 = 1.0_wp
6184	NaNO3_nh4hso4 = 1.0_wp
6185	NaCl_nh4hso4 = 1.0_wp
6186	!
6187	!-- Juha Tonttila added
6188	mols_out = 0.0_wp
6189	Press_HNO3 = 0.0_wp
6190	Press_HCL = 0.0_wp
6191	Press_NH3 = 0.0_wp !< Initialising vapour pressure over the
6192	!< multicomponent particle
6193	gamma_out = 1.0_wp !< i.e. don't alter the ideal mixing ratios if
6194	!< there's nothing there.
6195	!
6196	!-- 1) - COMPOSITION DEFINITIONS
6197	!
6198	!-- a) Inorganic ion pairing:
6199	!-- In order to calculate the water content, which is also used in
6200	!-- calculating vapour pressures, one needs to pair the anions and cations
6201	!-- for use in the ZSR mixing rule. The equation provided by Clegg et al.
6202	!-- (2001) is used for ion pairing. The solutes chosen comprise of 9
6203	!-- inorganic salts and acids which provide a pairing between each anion and
6204	!-- cation: (NH4)2SO4, NH4NO3, NH4Cl, Na2SO4, NaNO3, NaCl, H2SO4, HNO3, HCL.
6205	!-- The organic compound is treated as a seperate solute.
6206	!-- Ions: 1: H+, 2: NH4+, 3: Na+, 4: SO4(2-), 5: HSO4-, 6: NO3-, 7: Cl-
6207	!
6208	charge_sum = ions(1) + ions(2) + ions(3) + 2.0_wp * ions(4) + ions(5) + &
6209	ions(6) + ions(7)
6210	nitric_acid = 0.0_wp ! HNO3
6211	nitric_acid = ( 2.0_wp * ions(1) * ions(6) * &
6212	( ( 1.0_wp / 1.0_wp ) ** 0.5_wp ) ) / ( charge_sum )
6213	hydrochloric_acid = 0.0_wp ! HCL
6214	hydrochloric_acid = ( 2.0_wp * ions(1) * ions(7) * &
6215	( ( 1.0_wp / 1.0_wp ) ** 0.5_wp ) ) / ( charge_sum )
6216	sulphuric_acid = 0.0_wp ! H2SO4
6217	sulphuric_acid = ( 2.0_wp * ions(1) * ions(4) * &
6218	( ( 2.0_wp / 2.0_wp ) ** 0.5_wp ) ) / ( charge_sum )
6219	ammonium_sulphate = 0.0_wp ! (NH4)2SO4
6220	ammonium_sulphate = ( 2.0_wp * ions(2) * ions(4) * &
6221	( ( 2.0_wp / 2.0_wp ) ** 0.5_wp ) ) / ( charge_sum )
6222	ammonium_nitrate = 0.0_wp ! NH4NO3
6223	ammonium_nitrate = ( 2.0_wp * ions(2) * ions(6) * &
6224	( ( 1.0_wp / 1.0_wp ) ** 0.5_wp ) ) / ( charge_sum )
6225	ammonium_chloride = 0.0_wp ! NH4Cl
6226	ammonium_chloride = ( 2.0_wp * ions(2) * ions(7) * &
6227	( ( 1.0_wp / 1.0_wp ) ** 0.5_wp ) ) / ( charge_sum )
6228	sodium_sulphate = 0.0_wp ! Na2SO4
6229	sodium_sulphate = ( 2.0_wp * ions(3) * ions(4) * &
6230	( ( 2.0_wp / 2.0_wp ) ** 0.5_wp ) ) / ( charge_sum )
6231	sodium_nitrate = 0.0_wp ! NaNO3
6232	sodium_nitrate = ( 2.0_wp * ions(3) ions(6) &
6233	( ( 1.0_wp / 1.0_wp ) ** 0.5_wp ) ) / ( charge_sum )
6234	sodium_chloride = 0.0_wp ! NaCl
6235	sodium_chloride = ( 2.0_wp * ions(3) * ions(7) * &
6236	( ( 1.0_wp / 1.0_wp ) ** 0.5_wp ) ) / ( charge_sum )
6237	solutes = 0.0_wp
6238	solutes = 3.0_wp * sulphuric_acid + 2.0_wp * hydrochloric_acid + &
6239	2.0_wp * nitric_acid + 3.0_wp * ammonium_sulphate + &
6240	2.0_wp * ammonium_nitrate + 2.0_wp * ammonium_chloride + &
6241	3.0_wp * sodium_sulphate + 2.0_wp * sodium_nitrate + &
6242	2.0_wp * sodium_chloride
6243
6244	!
6245	!-- b) Inorganic equivalent fractions:
6246	!-- These values are calculated so that activity coefficients can be
6247	!-- expressed by a linear additive rule, thus allowing more efficient
6248	!-- calculations and future expansion (see more detailed description below)
6249	nitric_acid_eq_frac = 2.0_wp * nitric_acid / ( solutes )
6250	hydrochloric_acid_eq_frac = 2.0_wp * hydrochloric_acid / ( solutes )
6251	sulphuric_acid_eq_frac = 3.0_wp * sulphuric_acid / ( solutes )
6252	ammonium_sulphate_eq_frac = 3.0_wp * ammonium_sulphate / ( solutes )
6253	ammonium_nitrate_eq_frac = 2.0_wp * ammonium_nitrate / ( solutes )
6254	ammonium_chloride_eq_frac = 2.0_wp * ammonium_chloride / ( solutes )
6255	sodium_sulphate_eq_frac = 3.0_wp * sodium_sulphate / ( solutes )
6256	sodium_nitrate_eq_frac = 2.0_wp * sodium_nitrate / ( solutes )
6257	sodium_chloride_eq_frac = 2.0_wp * sodium_chloride / ( solutes )
6258	!
6259	!-- Inorganic ion molalities
6260	ions_mol(:) = 0.0_wp
6261	ions_mol(1) = ions(1) / ( water_total * 18.01528E-3_wp ) ! H+
6262	ions_mol(2) = ions(2) / ( water_total * 18.01528E-3_wp ) ! NH4+
6263	ions_mol(3) = ions(3) / ( water_total * 18.01528E-3_wp ) ! Na+
6264	ions_mol(4) = ions(4) / ( water_total * 18.01528E-3_wp ) ! SO4(2-)
6265	ions_mol(5) = ions(5) / ( water_total * 18.01528E-3_wp ) ! HSO4(2-)
6266	ions_mol(6) = ions(6) / ( water_total * 18.01528E-3_wp ) ! NO3-
6267	ions_mol(7) = ions(7) / ( water_total * 18.01528E-3_wp ) ! Cl-
6268
6269	!-- ***
6270	!-- At this point we may need to introduce a method for prescribing H+ when
6271	!-- there is no 'real' value for H+..i.e. in the sulphate poor domain
6272	!-- This will give a value for solve quadratic proposed by Zaveri et al. 2005
6273	!
6274	!-- 2) - WATER CALCULATION
6275	!
6276	!-- a) The water content is calculated using the ZSR rule with solute
6277	!-- concentrations calculated using 1a above. Whilst the usual approximation of
6278	!-- ZSR relies on binary data consisting of 5th or higher order polynomials, in
6279	!-- this code 4 different RH regimes are used, each housing cubic equations for
6280	!-- the water associated with each solute listed above. Binary water contents
6281	!-- for inorganic components were calculated using AIM online (Clegg et al
6282	!-- 1998). The water associated with the organic compound is calculated assuming
6283	!-- ideality and that aw = RH.
6284	!
6285	!-- b) Molality of each inorganic ion and organic solute (initial input) is
6286	!-- calculated for use in vapour pressure calculation.
6287	!
6288	!-- 3) - BISULPHATE ION DISSOCIATION CALCULATION
6289	!
6290	!-- The dissociation of the bisulphate ion is calculated explicitly. A solution
6291	!-- to the equilibrium equation between the bisulphate ion, hydrogen ion and
6292	!-- sulphate ion is found using tabulated equilibrium constants (referenced). It
6293	!-- is necessary to calculate the activity coefficients of HHSO4 and H2SO4 in a
6294	!-- non-iterative manner. These are calculated using the same format as
6295	!-- described in 4) below, where both activity coefficients were fit to the
6296	!-- output from ADDEM (Topping et al 2005a,b) covering an extensive composition
6297	!-- space, providing the activity coefficients and bisulphate ion dissociation
6298	!-- as a function of equivalent mole fractions and relative humidity.
6299	!
6300	!-- NOTE: the flags "binary_case" and "full_complexity" are not used in this
6301	!-- prototype. They are used for simplification of the fit expressions when
6302	!-- using limited composition regions. This section of code calculates the
6303	!-- bisulphate ion concentration
6304	!
6305	IF ( ions(1) > 0.0_wp .AND. ions(4) > 0.0_wp ) THEN
6306	!
6307	!-- HHSO4:
6308	binary_case = 1
6309	IF ( RH > 0.1_wp .AND. RH < 0.9_wp ) THEN
6310	binary_hhso4 = - 4.9521_wp * ( RH*3 ) + 9.2881_wp ( RH**2 ) - &
6311	10.777_wp * RH + 6.0534_wp
6312	ELSEIF ( RH >= 0.9_wp .AND. RH < 0.955_wp ) THEN
6313	binary_hhso4 = - 6.3777_wp * RH + 5.962_wp
6314	ELSEIF ( RH >= 0.955_wp .AND. RH < 0.99_wp ) THEN
6315	binary_hhso4 = 2367.2_wp * ( RH*3 ) - 6849.7_wp ( RH**2 ) + &
6316	6600.9_wp * RH - 2118.7_wp
6317	ELSEIF ( RH >= 0.99_wp .AND. RH < 0.9999_wp ) THEN
6318	binary_hhso4 = 3E-7_wp * ( RH*5 ) - 2E-5_wp ( RH**4 ) + &
6319	0.0004_wp * ( RH*3 ) - 0.0035_wp ( RH**2 ) + &
6320	0.0123_wp * RH - 0.3025_wp
6321	ENDIF
6322
6323	IF ( nitric_acid > 0.0_wp ) THEN
6324	HNO3_hhso4 = - 4.2204_wp * ( RH*4 ) + 12.193_wp ( RH**3 ) - &
6325	12.481_wp * ( RH*2 ) + 6.459_wp RH - 1.9004_wp
6326	ENDIF
6327
6328	IF ( hydrochloric_acid > 0.0_wp ) THEN
6329	HCL_hhso4 = - 54.845_wp * ( RH*7 ) + 209.54_wp ( RH**6 ) - &
6330	336.59_wp * ( RH*5 ) + 294.21_wp ( RH**4 ) - &
6331	150.07_wp * ( RH*3 ) + 43.767_wp ( RH**2 ) - &
6332	6.5495_wp * RH + 0.60048_wp
6333	ENDIF
6334
6335	IF ( ammonium_sulphate > 0.0_wp ) THEN
6336	NH42SO4_hhso4 = 16.768_wp * ( RH*3 ) - 28.75_wp ( RH**2 ) + &
6337	20.011_wp * RH - 8.3206_wp
6338	ENDIF
6339
6340	IF ( ammonium_nitrate > 0.0_wp ) THEN
6341	NH4NO3_hhso4 = - 17.184_wp * ( RH*4 ) + 56.834_wp ( RH**3 ) - &
6342	65.765_wp * ( RH*2 ) + 35.321_wp RH - 9.252_wp
6343	ENDIF
6344
6345	IF (ammonium_chloride > 0.0_wp ) THEN
6346	IF ( RH < 0.2_wp .AND. RH >= 0.1_wp ) THEN
6347	NH4Cl_hhso4 = 3.2809_wp * RH - 2.0637_wp
6348	ELSEIF ( RH >= 0.2_wp .AND. RH < 0.99_wp ) THEN
6349	NH4Cl_hhso4 = - 1.2981_wp * ( RH*3 ) + 4.7461_wp ( RH**2 ) - &
6350	2.3269_wp * RH - 1.1259_wp
6351	ENDIF
6352	ENDIF
6353
6354	IF ( sodium_sulphate > 0.0_wp ) THEN
6355	Na2SO4_hhso4 = 118.87_wp * ( RH*6 ) - 358.63_wp ( RH**5 ) + &
6356	435.85_wp * ( RH*4 ) - 272.88_wp ( RH**3 ) + &
6357	94.411_wp * ( RH*2 ) - 18.21_wp RH + 0.45935_wp
6358	ENDIF
6359
6360	IF ( sodium_nitrate > 0.0_wp ) THEN
6361	IF ( RH < 0.2_wp .AND. RH >= 0.1_wp ) THEN
6362	NaNO3_hhso4 = 4.8456_wp * RH - 2.5773_wp
6363	ELSEIF ( RH >= 0.2_wp .AND. RH < 0.99_wp ) THEN
6364	NaNO3_hhso4 = 0.5964_wp * ( RH*3 ) - 0.38967_wp ( RH**2 ) + &
6365	1.7918_wp * RH - 1.9691_wp
6366	ENDIF
6367	ENDIF
6368
6369	IF ( sodium_chloride > 0.0_wp ) THEN
6370	IF ( RH < 0.2_wp ) THEN
6371	NaCl_hhso4 = 0.51995_wp * RH - 1.3981_wp
6372	ELSEIF ( RH >= 0.2_wp .AND. RH < 0.99_wp ) THEN
6373	NaCl_hhso4 = 1.6539_wp * RH - 1.6101_wp
6374	ENDIF
6375	ENDIF
6376
6377	Ln_hhso4_act = binary_hhso4 + &
6378	nitric_acid_eq_frac * HNO3_hhso4 + &
6379	hydrochloric_acid_eq_frac * HCL_hhso4 + &
6380	ammonium_sulphate_eq_frac * NH42SO4_hhso4 + &
6381	ammonium_nitrate_eq_frac * NH4NO3_hhso4 + &
6382	ammonium_chloride_eq_frac * NH4Cl_hhso4 + &
6383	sodium_sulphate_eq_frac * Na2SO4_hhso4 + &
6384	sodium_nitrate_eq_frac * NaNO3_hhso4 + &
6385	sodium_chloride_eq_frac * NaCl_hhso4
6386	gamma_hhso4 = EXP( Ln_hhso4_act ) ! molal activity coefficient of HHSO4
6387
6388	!-- H2SO4 (sulphuric acid):
6389	IF ( RH >= 0.1_wp .AND. RH < 0.9_wp ) THEN
6390	binary_h2so4 = 2.4493_wp * ( RH*2 ) - 6.2326_wp RH + 2.1763_wp
6391	ELSEIF ( RH >= 0.9_wp .AND. RH < 0.98 ) THEN
6392	binary_h2so4 = 914.68_wp * ( RH*3 ) - 2502.3_wp ( RH**2 ) + &
6393	2281.9_wp * RH - 695.11_wp
6394	ELSEIF ( RH >= 0.98 .AND. RH < 0.9999 ) THEN
6395	binary_h2so4 = 3E-8_wp * ( RH*4 ) - 5E-6_wp ( RH**3 ) + &
6396	0.0003_wp * ( RH*2 ) - 0.0022_wp RH - 1.1305_wp
6397	ENDIF
6398
6399	IF ( nitric_acid > 0.0_wp ) THEN
6400	HNO3_h2so4 = - 16.382_wp * ( RH*5 ) + 46.677_wp ( RH**4 ) - &
6401	54.149_wp * ( RH*3 ) + 34.36_wp ( RH**2 ) - &
6402	12.54_wp * RH + 2.1368_wp
6403	ENDIF
6404
6405	IF ( hydrochloric_acid > 0.0_wp ) THEN
6406	HCL_h2so4 = - 14.409_wp * ( RH*5 ) + 42.804_wp ( RH**4 ) - &
6407	47.24_wp * ( RH*3 ) + 24.668_wp ( RH**2 ) - &
6408	5.8015_wp * RH + 0.084627_wp
6409	ENDIF
6410
6411	IF ( ammonium_sulphate > 0.0_wp ) THEN
6412	NH42SO4_h2so4 = 66.71_wp * ( RH*5 ) - 187.5_wp ( RH**4 ) + &
6413	210.57_wp * ( RH*3 ) - 121.04_wp ( RH**2 ) + &
6414	39.182_wp * RH - 8.0606_wp
6415	ENDIF
6416
6417	IF ( ammonium_nitrate > 0.0_wp ) THEN
6418	NH4NO3_h2so4 = - 22.532_wp * ( RH*4 ) + 66.615_wp ( RH**3 ) - &
6419	74.647_wp * ( RH*2 ) + 37.638_wp RH - 6.9711_wp
6420	ENDIF
6421
6422	IF ( ammonium_chloride > 0.0_wp ) THEN
6423	IF ( RH >= 0.1_wp .AND. RH < 0.2_wp ) THEN
6424	NH4Cl_h2so4 = - 0.32089_wp * RH + 0.57738_wp
6425	ELSEIF ( RH >= 0.2_wp .AND. RH < 0.9_wp ) THEN
6426	NH4Cl_h2so4 = 18.089_wp * ( RH*5 ) - 51.083_wp ( RH**4 ) + &
6427	50.32_wp * ( RH*3 ) - 17.012_wp ( RH**2 ) - &
6428	0.93435_wp * RH + 1.0548_wp
6429	ELSEIF ( RH >= 0.9_wp .AND. RH < 0.99_wp ) THEN
6430	NH4Cl_h2so4 = - 1.5749_wp * RH + 1.7002_wp
6431	ENDIF
6432	ENDIF
6433
6434	IF ( sodium_sulphate > 0.0_wp ) THEN
6435	Na2SO4_h2so4 = 29.843_wp * ( RH*4 ) - 69.417_wp ( RH**3 ) + &
6436	61.507_wp * ( RH*2 ) - 29.874_wp RH + 7.7556_wp
6437	ENDIF
6438
6439	IF ( sodium_nitrate > 0.0_wp ) THEN
6440	NaNO3_h2so4 = - 122.37_wp * ( RH*6 ) + 427.43_wp ( RH**5 ) - &
6441	604.68_wp * ( RH*4 ) + 443.08_wp ( RH**3 ) - &
6442	178.61_wp * ( RH*2 ) + 37.242_wp RH - 1.9564_wp
6443	ENDIF
6444
6445	IF ( sodium_chloride > 0.0_wp ) THEN
6446	NaCl_h2so4 = - 40.288_wp * ( RH*5 ) + 115.61_wp ( RH**4 ) - &
6447	129.99_wp * ( RH*3 ) + 72.652_wp ( RH**2 ) - &
6448	22.124_wp * RH + 4.2676_wp
6449	ENDIF
6450
6451	Ln_h2so4_act = binary_h2so4 + &
6452	nitric_acid_eq_frac * HNO3_h2so4 + &
6453	hydrochloric_acid_eq_frac * HCL_h2so4 + &
6454	ammonium_sulphate_eq_frac * NH42SO4_h2so4 + &
6455	ammonium_nitrate_eq_frac * NH4NO3_h2so4 + &
6456	ammonium_chloride_eq_frac * NH4Cl_h2so4 + &
6457	sodium_sulphate_eq_frac * Na2SO4_h2so4 + &
6458	sodium_nitrate_eq_frac * NaNO3_h2so4 + &
6459	sodium_chloride_eq_frac * NaCl_h2so4
6460
6461	gamma_h2so4 = EXP( Ln_h2so4_act ) ! molal activity coefficient
6462	!
6463	!-- Export activity coefficients
6464	IF ( gamma_h2so4 > 1.0E-10_wp ) THEN
6465	gamma_out(4) = ( gamma_hhso4**2.0_wp ) / gamma_h2so4
6466	ENDIF
6467	IF ( gamma_hhso4 > 1.0E-10_wp ) THEN
6468	gamma_out(5) = ( gamma_h2so43.0_wp ) / ( gamma_hhso42.0_wp )
6469	ENDIF
6470	!
6471	!-- Ionic activity coefficient product
6472	act_product = ( gamma_h2so43.0_wp ) / ( gamma_hhso42.0_wp )
6473	!
6474	!-- Solve the quadratic equation (i.e. x in ax**2 + bx + c = 0)
6475	a = 1.0_wp
6476	b = - 1.0_wp * ( ions(4) + ions(1) + ( ( water_total * 18.0E-3_wp ) / &
6477	( 99.0_wp * act_product ) ) )
6478	c = ions(4) * ions(1)
6479	root1 = ( ( -1.0_wp * b ) + ( ( ( b*2 ) - 4.0_wp a * c )**0.5_wp &
6480	) ) / ( 2 * a )
6481	root2 = ( ( -1.0_wp * b ) - ( ( ( b*2 ) - 4.0_wp a * c) **0.5_wp &
6482	) ) / ( 2 * a )
6483
6484	IF ( root1 > ions(1) .OR. root1 < 0.0_wp ) THEN
6485	root1 = 0.0_wp
6486	ENDIF
6487
6488	IF ( root2 > ions(1) .OR. root2 < 0.0_wp ) THEN
6489	root2 = 0.0_wp
6490	ENDIF
6491	!
6492	!-- Calculate the new hydrogen ion, bisulphate ion and sulphate ion
6493	!-- concentration
6494	hso4_real = 0.0_wp
6495	h_real = ions(1)
6496	so4_real = ions(4)
6497	IF ( root1 == 0.0_wp ) THEN
6498	hso4_real = root2
6499	ELSEIF ( root2 == 0.0_wp ) THEN
6500	hso4_real = root1
6501	ENDIF
6502	h_real = ions(1) - hso4_real
6503	so4_real = ions(4) - hso4_real
6504	!
6505	!-- Recalculate ion molalities
6506	ions_mol(1) = h_real / ( water_total * 18.01528E-3_wp ) ! H+
6507	ions_mol(4) = so4_real / ( water_total * 18.01528E-3_wp ) ! SO4(2-)
6508	ions_mol(5) = hso4_real / ( water_total * 18.01528E-3_wp ) ! HSO4(2-)
6509
6510	h_out = h_real
6511	hso4_out = hso4_real
6512	so4_out = so4_real
6513
6514	ELSEIF ( ions(1) == 0.0_wp .OR. ions(4) == 0.0_wp ) THEN
6515	h_out = ions(1)
6516	hso4_out = 0.0_wp
6517	so4_out = ions(4)
6518	ENDIF
6519
6520	!
6521	!-- 4) ACTIVITY COEFFICIENTS -for vapour pressures of HNO3,HCL and NH3
6522	!
6523	!-- This section evaluates activity coefficients and vapour pressures using the
6524	!-- water content calculated above) for each inorganic condensing species:
6525	!-- a - HNO3, b - NH3, c - HCL.
6526	!-- The following procedure is used:
6527	!-- Zaveri et al (2005) found that one could express the variation of activity
6528	!-- coefficients linearly in log-space if equivalent mole fractions were used.
6529	!-- So, by a taylor series expansion LOG( activity coefficient ) =
6530	!-- LOG( binary activity coefficient at a given RH ) +
6531	!-- (equivalent mole fraction compound A) *
6532	!-- ('interaction' parameter between A and condensing species) +
6533	!-- equivalent mole fraction compound B) *
6534	!-- ('interaction' parameter between B and condensing species).
6535	!-- Here, the interaction parameters have been fit to ADDEM by searching the
6536	!-- whole compositon space and fit usign the Levenberg-Marquardt non-linear
6537	!-- least squares algorithm.
6538	!
6539	!-- They are given as a function of RH and vary with complexity ranging from
6540	!-- linear to 5th order polynomial expressions, the binary activity coefficients
6541	!-- were calculated using AIM online.
6542	!-- NOTE: for NH3, no binary activity coefficient was used and the data were fit
6543	!-- to the ratio of the activity coefficients for the ammonium and hydrogen
6544	!-- ions. Once the activity coefficients are obtained the vapour pressure can be
6545	!-- easily calculated using tabulated equilibrium constants (referenced). This
6546	!-- procedure differs from that of Zaveri et al (2005) in that it is not assumed
6547	!-- one can carry behaviour from binary mixtures in multicomponent systems. To
6548	!-- this end we have fit the 'interaction' parameters explicitly to a general
6549	!-- inorganic equilibrium model (ADDEM - Topping et al. 2005a,b). Such
6550	!-- parameters take into account bisulphate ion dissociation and water content.
6551	!-- This also allows us to consider one regime for all composition space, rather
6552	!-- than defining sulphate rich and sulphate poor regimes
6553	!-- NOTE: The flags "binary_case" and "full_complexity" are not used in this
6554	!-- prototype. They are used for simplification of the fit expressions when
6555	!-- using limited composition regions.
6556	!
6557	!-- a) - ACTIVITY COEFF/VAPOUR PRESSURE - HNO3
6558	IF ( ions(1) > 0.0_wp .AND. ions(6) > 0.0_wp ) THEN
6559	binary_case = 1
6560	IF ( RH > 0.1_wp .AND. RH < 0.98_wp ) THEN
6561	IF ( binary_case == 1 ) THEN
6562	binary_hno3 = 1.8514_wp * ( RH*3 ) - 4.6991_wp ( RH**2 ) + &
6563	1.5514_wp * RH + 0.90236_wp
6564	ELSEIF ( binary_case == 2 ) THEN
6565	binary_hno3 = - 1.1751_wp * ( RH*2 ) - 0.53794_wp RH + &
6566	1.2808_wp
6567	ENDIF
6568	ELSEIF ( RH >= 0.98_wp .AND. RH < 0.9999_wp ) THEN
6569	binary_hno3 = 1244.69635941351_wp * ( RH**3 ) - &
6570	2613.93941099991_wp * ( RH**2 ) + &
6571	1525.0684974546_wp * RH -155.946764059316_wp
6572	ENDIF
6573	!
6574	!-- Contributions from other solutes
6575	full_complexity = 1
6576	IF ( hydrochloric_acid > 0.0_wp ) THEN ! HCL
6577	IF ( full_complexity == 1 .OR. RH < 0.4_wp ) THEN
6578	HCL_hno3 = 16.051_wp * ( RH*4 ) - 44.357_wp ( RH**3 ) + &
6579	45.141_wp * ( RH*2 ) - 21.638_wp RH + 4.8182_wp
6580	ELSEIF ( full_complexity == 0 .AND. RH > 0.4_wp ) THEN
6581	HCL_hno3 = - 1.5833_wp * RH + 1.5569_wp
6582	ENDIF
6583	ENDIF
6584
6585	IF ( sulphuric_acid > 0.0_wp ) THEN ! H2SO4
6586	IF ( full_complexity == 1 .OR. RH < 0.4_wp ) THEN
6587	H2SO4_hno3 = - 3.0849_wp * ( RH*3 ) + 5.9609_wp ( RH**2 ) - &
6588	4.468_wp * RH + 1.5658_wp
6589	ELSEIF ( full_complexity == 0 .AND. RH > 0.4_wp ) THEN
6590	H2SO4_hno3 = - 0.93473_wp * RH + 0.9363_wp
6591	ENDIF
6592	ENDIF
6593
6594	IF ( ammonium_sulphate > 0.0_wp ) THEN ! NH42SO4
6595	NH42SO4_hno3 = 16.821_wp * ( RH*3 ) - 28.391_wp ( RH**2 ) + &
6596	18.133_wp * RH - 6.7356_wp
6597	ENDIF
6598
6599	IF ( ammonium_nitrate > 0.0_wp ) THEN ! NH4NO3
6600	NH4NO3_hno3 = 11.01_wp * ( RH*3 ) - 21.578_wp ( RH**2 ) + &
6601	14.808_wp * RH - 4.2593_wp
6602	ENDIF
6603
6604	IF ( ammonium_chloride > 0.0_wp ) THEN ! NH4Cl
6605	IF ( full_complexity == 1 .OR. RH <= 0.4_wp ) THEN
6606	NH4Cl_hno3 = - 1.176_wp * ( RH*3 ) + 5.0828_wp ( RH**2 ) - &
6607	3.8792_wp * RH - 0.05518_wp
6608	ELSEIF ( full_complexity == 0 .AND. RH > 0.4_wp ) THEN
6609	NH4Cl_hno3 = 2.6219_wp * ( RH*2 ) - 2.2609_wp RH - 0.38436_wp
6610	ENDIF
6611	ENDIF
6612
6613	IF ( sodium_sulphate > 0.0_wp ) THEN ! Na2SO4
6614	Na2SO4_hno3 = 35.504_wp * ( RH*4 ) - 80.101_wp ( RH**3 ) + &
6615	67.326_wp * ( RH*2 ) - 28.461_wp RH + 5.6016_wp
6616	ENDIF
6617
6618	IF ( sodium_nitrate > 0.0_wp ) THEN ! NaNO3
6619	IF ( full_complexity == 1 .OR. RH <= 0.4_wp ) THEN
6620	NaNO3_hno3 = 23.659_wp * ( RH*5 ) - 66.917_wp ( RH**4 ) + &
6621	74.686_wp * ( RH*3 ) - 40.795_wp ( RH**2 ) + &
6622	10.831_wp * RH - 1.4701_wp
6623	ELSEIF ( full_complexity == 0 .AND. RH > 0.4_wp ) THEN
6624	NaNO3_hno3 = 14.749_wp * ( RH*4 ) - 35.237_wp ( RH**3 ) + &
6625	31.196_wp * ( RH*2 ) - 12.076_wp RH + 1.3605_wp
6626	ENDIF
6627	ENDIF
6628
6629	IF ( sodium_chloride > 0.0_wp ) THEN ! NaCl
6630	IF ( full_complexity == 1 .OR. RH <= 0.4_wp ) THEN
6631	NaCl_hno3 = 13.682_wp * ( RH*4 ) - 35.122_wp ( RH**3 ) + &
6632	33.397_wp * ( RH*2 ) - 14.586_wp RH + 2.6276_wp
6633	ELSEIF ( full_complexity == 0 .AND. RH > 0.4_wp ) THEN
6634	NaCl_hno3 = 1.1882_wp * ( RH*3 ) - 1.1037_wp ( RH**2 ) - &
6635	0.7642_wp * RH + 0.6671_wp
6636	ENDIF
6637	ENDIF
6638
6639	Ln_HNO3_act = binary_hno3 + &
6640	hydrochloric_acid_eq_frac * HCL_hno3 + &
6641	sulphuric_acid_eq_frac * H2SO4_hno3 + &
6642	ammonium_sulphate_eq_frac * NH42SO4_hno3 + &
6643	ammonium_nitrate_eq_frac * NH4NO3_hno3 + &
6644	ammonium_chloride_eq_frac * NH4Cl_hno3 + &
6645	sodium_sulphate_eq_frac * Na2SO4_hno3 + &
6646	sodium_nitrate_eq_frac * NaNO3_hno3 + &
6647	sodium_chloride_eq_frac * NaCl_hno3
6648
6649	gamma_hno3 = EXP( Ln_HNO3_act ) ! Molal activity coefficient of HNO3
6650	gamma_out(1) = gamma_hno3
6651	!
6652	!-- Partial pressure calculation
6653	!-- K_hno3 = 2.51 * ( 10**6 )
6654	!-- K_hno3 = 2.628145923d6 !< calculated by AIM online (Clegg et al 1998)
6655	!-- after Chameides (1984) (and NIST database)
6656	K_hno3 = 2.6E6_wp * EXP( 8700.0_wp * henrys_temp_dep)
6657	Press_HNO3 = ( ions_mol(1) * ions_mol(6) * ( gamma_hno3**2 ) ) / &
6658	K_hno3
6659	ENDIF
6660	!
6661	!-- b) - ACTIVITY COEFF/VAPOUR PRESSURE - NH3
6662	!-- Follow the two solute approach of Zaveri et al. (2005)
6663	IF ( ions(2) > 0.0_wp .AND. ions_mol(1) > 0.0_wp ) THEN
6664	!-- NH4HSO4:
6665	binary_nh4hso4 = 56.907_wp * ( RH*6 ) - 155.32_wp ( RH**5 ) + &
6666	142.94_wp * ( RH*4 ) - 32.298_wp ( RH**3 ) - &
6667	27.936_wp * ( RH*2 ) + 19.502_wp RH - 4.2618_wp
6668	IF ( nitric_acid > 0.0_wp) THEN ! HNO3
6669	HNO3_nh4hso4 = 104.8369_wp * ( RH*8 ) - 288.8923_wp ( RH**7 ) + &
6670	129.3445_wp * ( RH*6 ) + 373.0471_wp ( RH**5 ) - &
6671	571.0385_wp * ( RH*4 ) + 326.3528_wp ( RH**3 ) - &
6672	74.169_wp * ( RH*2 ) - 2.4999_wp RH + 3.17_wp
6673	ENDIF
6674
6675	IF ( hydrochloric_acid > 0.0_wp) THEN ! HCL
6676	HCL_nh4hso4 = - 7.9133_wp * ( RH*8 ) + 126.6648_wp ( RH**7 ) - &
6677	460.7425_wp * ( RH*6 ) + 731.606_wp ( RH**5 ) - &
6678	582.7467_wp * ( RH*4 ) + 216.7197_wp ( RH**3 ) - &
6679	11.3934_wp * ( RH*2 ) - 17.7728_wp RH + 5.75_wp
6680	ENDIF
6681
6682	IF ( sulphuric_acid > 0.0_wp) THEN ! H2SO4
6683	H2SO4_nh4hso4 = 195.981_wp * ( RH*8 ) - 779.2067_wp ( RH**7 ) + &
6684	1226.3647_wp * ( RH*6 ) - 964.0261_wp ( RH**5 ) + &
6685	391.7911_wp * ( RH*4 ) - 84.1409_wp ( RH**3 ) + &
6686	20.0602_wp * ( RH*2 ) - 10.2663_wp RH + 3.5817_wp
6687	ENDIF
6688
6689	IF ( ammonium_sulphate > 0.0_wp) THEN ! NH42SO4
6690	NH42SO4_nh4hso4 = 617.777_wp * ( RH*8 ) - 2547.427_wp ( RH**7 ) &
6691	+ 4361.6009_wp * ( RH*6 ) - 4003.162_wp ( RH**5 ) &
6692	+ 2117.8281_wp * ( RH*4 ) - 640.0678_wp ( RH**3 ) &
6693	+ 98.0902_wp * ( RH*2 ) - 2.2615_wp RH - 2.3811_wp
6694	ENDIF
6695
6696	IF ( ammonium_nitrate > 0.0_wp) THEN ! NH4NO3
6697	NH4NO3_nh4hso4 = - 104.4504_wp * ( RH*8 ) + 539.5921_wp &
6698	( RH*7 ) - 1157.0498_wp ( RH*6 ) + 1322.4507_wp &
6699	( RH*5 ) - 852.2475_wp ( RH*4 ) + 298.3734_wp &
6700	( RH*3 ) - 47.0309_wp ( RH*2 ) + 1.297_wp RH - &
6701	0.8029_wp
6702	ENDIF
6703
6704	IF ( ammonium_chloride > 0.0_wp) THEN ! NH4Cl
6705	NH4Cl_nh4hso4 = 258.1792_wp * ( RH*8 ) - 1019.3777_wp &
6706	( RH*7 ) + 1592.8918_wp ( RH*6 ) - 1221.0726_wp &
6707	( RH*5 ) + 442.2548_wp ( RH*4 ) - 43.6278_wp &
6708	( RH*3 ) - 7.5282_wp ( RH*2 ) - 3.8459_wp RH + 2.2728_wp
6709	ENDIF
6710
6711	IF ( sodium_sulphate > 0.0_wp) THEN ! Na2SO4
6712	Na2SO4_nh4hso4 = 225.4238_wp * ( RH*8 ) - 732.4113_wp &
6713	( RH*7 ) + 843.7291_wp ( RH*6 ) - 322.7328_wp &
6714	( RH*5 ) - 88.6252_wp ( RH*4 ) + 72.4434_wp &
6715	( RH*3 ) + 22.9252_wp ( RH*2 ) - 25.3954_wp RH + &
6716	4.6971_wp
6717	ENDIF
6718
6719	IF ( sodium_nitrate > 0.0_wp) THEN ! NaNO3
6720	NaNO3_nh4hso4 = 96.1348_wp * ( RH*8 ) - 341.6738_wp ( RH**7 ) + &
6721	406.5314_wp * ( RH*6 ) - 98.5777_wp ( RH**5 ) - &
6722	172.8286_wp * ( RH*4 ) + 149.3151_wp ( RH**3 ) - &
6723	38.9998_wp * ( RH*2 ) - 0.2251 RH + 0.4953_wp
6724	ENDIF
6725
6726	IF ( sodium_chloride > 0.0_wp) THEN ! NaCl
6727	NaCl_nh4hso4 = 91.7856_wp * ( RH*8 ) - 316.6773_wp ( RH**7 ) + &
6728	358.2703_wp * ( RH*6 ) - 68.9142 ( RH**5 ) - &
6729	156.5031_wp * ( RH*4 ) + 116.9592_wp ( RH**3 ) - &
6730	22.5271_wp * ( RH*2 ) - 3.7716_wp RH + 1.56_wp
6731	ENDIF
6732
6733	Ln_NH4HSO4_act = binary_nh4hso4 + &
6734	nitric_acid_eq_frac * HNO3_nh4hso4 + &
6735	hydrochloric_acid_eq_frac * HCL_nh4hso4 + &
6736	sulphuric_acid_eq_frac * H2SO4_nh4hso4 + &
6737	ammonium_sulphate_eq_frac * NH42SO4_nh4hso4 + &
6738	ammonium_nitrate_eq_frac * NH4NO3_nh4hso4 + &
6739	ammonium_chloride_eq_frac * NH4Cl_nh4hso4 + &
6740	sodium_sulphate_eq_frac * Na2SO4_nh4hso4 + &
6741	sodium_nitrate_eq_frac * NaNO3_nh4hso4 + &
6742	sodium_chloride_eq_frac * NaCl_nh4hso4
6743
6744	gamma_nh4hso4 = EXP( Ln_NH4HSO4_act ) ! molal act. coefficient of NH4HSO4
6745	!-- Molal activity coefficient of NO3-
6746	gamma_out(6) = gamma_nh4hso4
6747	!-- Molal activity coefficient of NH4+
6748	gamma_nh3 = ( gamma_nh4hso42 ) / ( gamma_hhso42 )
6749	gamma_out(3) = gamma_nh3
6750	!
6751	!-- This actually represents the ratio of the ammonium to hydrogen ion
6752	!-- activity coefficients (see Zaveri paper) - multiply this by the ratio
6753	!-- of the ammonium to hydrogen ion molality and the ratio of appropriate
6754	!-- equilibrium constants
6755	!
6756	!-- Equilibrium constants
6757	!-- Kh = 57.64d0 ! Zaveri et al. (2005)
6758	Kh = 5.8E1_wp * EXP( 4085.0_wp * henrys_temp_dep ) ! after Chameides
6759	! ! (1984) (and NIST database)
6760	!-- Knh4 = 1.81E-5_wp ! Zaveri et al. (2005)
6761	Knh4 = 1.7E-5_wp * EXP( -4325.0_wp * henrys_temp_dep ) ! Chameides
6762	! (1984)
6763	!-- Kw = 1.01E-14_wp ! Zaveri et al (2005)
6764	Kw = 1.E-14_wp * EXP( -6716.0_wp * henrys_temp_dep ) ! Chameides
6765	! (1984)
6766	!
6767	molality_ratio_nh3 = ions_mol(2) / ions_mol(1)
6768	!-- Partial pressure calculation
6769	Press_NH3 = molality_ratio_nh3 * gamma_nh3 * ( Kw / ( Kh * Knh4 ) )
6770
6771	ENDIF
6772	!
6773	!-- c) - ACTIVITY COEFF/VAPOUR PRESSURE - HCL
6774	IF ( ions(1) > 0.0_wp .AND. ions(7) > 0.0_wp ) THEN
6775	binary_case = 1
6776	IF ( RH > 0.1_wp .AND. RH < 0.98 ) THEN
6777	IF ( binary_case == 1 ) THEN
6778	binary_hcl = - 5.0179_wp * ( RH*3 ) + 9.8816_wp ( RH**2 ) - &
6779	10.789_wp * RH + 5.4737_wp
6780	ELSEIF ( binary_case == 2 ) THEN
6781	binary_hcl = - 4.6221_wp * RH + 4.2633_wp
6782	ENDIF
6783	ELSEIF ( RH >= 0.98_wp .AND. RH < 0.9999_wp ) THEN
6784	binary_hcl = 775.6111008626_wp * ( RH*3 ) - 2146.01320888771_wp &
6785	( RH*2 ) + 1969.01979670259_wp RH - 598.878230033926_wp
6786	ENDIF
6787	ENDIF
6788
6789	IF ( nitric_acid > 0.0_wp ) THEN ! HNO3
6790	IF ( full_complexity == 1 .OR. RH <= 0.4_wp ) THEN
6791	HNO3_hcl = 9.6256_wp * ( RH*4 ) - 26.507_wp ( RH**3 ) + &
6792	27.622_wp * ( RH*2 ) - 12.958_wp RH + 2.2193_wp
6793	ELSEIF ( full_complexity == 0 .AND. RH > 0.4_wp ) THEN
6794	HNO3_hcl = 1.3242_wp * ( RH*2 ) - 1.8827_wp RH + 0.55706_wp
6795	ENDIF
6796	ENDIF
6797
6798	IF ( sulphuric_acid > 0.0_wp ) THEN ! H2SO4
6799	IF ( full_complexity == 1 .OR. RH <= 0.4 ) THEN
6800	H2SO4_hcl = 1.4406_wp * ( RH*3 ) - 2.7132_wp ( RH**2 ) + &
6801	1.014_wp * RH + 0.25226_wp
6802	ELSEIF ( full_complexity == 0 .AND. RH > 0.4_wp ) THEN
6803	H2SO4_hcl = 0.30993_wp * ( RH*2 ) - 0.99171_wp RH + 0.66913_wp
6804	ENDIF
6805	ENDIF
6806
6807	IF ( ammonium_sulphate > 0.0_wp ) THEN ! NH42SO4
6808	NH42SO4_hcl = 22.071_wp * ( RH*3 ) - 40.678_wp ( RH**2 ) + &
6809	27.893_wp * RH - 9.4338_wp
6810	ENDIF
6811
6812	IF ( ammonium_nitrate > 0.0_wp ) THEN ! NH4NO3
6813	NH4NO3_hcl = 19.935_wp * ( RH*3 ) - 42.335_wp ( RH**2 ) + &
6814	31.275_wp * RH - 8.8675_wp
6815	ENDIF
6816
6817	IF ( ammonium_chloride > 0.0_wp ) THEN ! NH4Cl
6818	IF ( full_complexity == 1 .OR. RH <= 0.4_wp ) THEN
6819	NH4Cl_hcl = 2.8048_wp * ( RH*3 ) - 4.3182_wp ( RH**2 ) + &
6820	3.1971_wp * RH - 1.6824_wp
6821	ELSEIF ( full_complexity == 0 .AND. RH > 0.4_wp ) THEN
6822	NH4Cl_hcl = 1.2304_wp * ( RH*2 ) - 0.18262_wp RH - 1.0643_wp
6823	ENDIF
6824	ENDIF
6825
6826	IF ( sodium_sulphate > 0.0_wp ) THEN ! Na2SO4
6827	Na2SO4_hcl = 36.104_wp * ( RH*4 ) - 78.658_wp ( RH**3 ) + &
6828	63.441_wp * ( RH*2 ) - 26.727_wp RH + 5.7007_wp
6829	ENDIF
6830
6831	IF ( sodium_nitrate > 0.0_wp ) THEN ! NaNO3
6832	IF ( full_complexity == 1 .OR. RH <= 0.4_wp ) THEN
6833	NaNO3_hcl = 54.471_wp * ( RH*5 ) - 159.42_wp ( RH**4 ) + &
6834	180.25_wp * ( RH*3 ) - 98.176_wp ( RH**2 ) + &
6835	25.309_wp * RH - 2.4275_wp
6836	ELSEIF ( full_complexity == 0 .AND. RH > 0.4_wp ) THEN
6837	NaNO3_hcl = 21.632_wp * ( RH*4 ) - 53.088_wp ( RH**3 ) + &
6838	47.285_wp * ( RH*2 ) - 18.519_wp RH + 2.6846_wp
6839	ENDIF
6840	ENDIF
6841
6842	IF ( sodium_chloride > 0.0_wp ) THEN ! NaCl
6843	IF ( full_complexity == 1 .OR. RH <= 0.4_wp ) THEN
6844	NaCl_hcl = 5.4138_wp * ( RH*4 ) - 12.079_wp ( RH**3 ) + &
6845	9.627_wp * ( RH*2 ) - 3.3164_wp RH + 0.35224_wp
6846	ELSEIF ( full_complexity == 0 .AND. RH > 0.4_wp ) THEN
6847	NaCl_hcl = 2.432_wp * ( RH*3 ) - 4.3453_wp ( RH**2 ) + &
6848	2.3834_wp * RH - 0.4762_wp
6849	ENDIF
6850	ENDIF
6851
6852	Ln_HCL_act = binary_hcl + &
6853	nitric_acid_eq_frac * HNO3_hcl + &
6854	sulphuric_acid_eq_frac * H2SO4_hcl + &
6855	ammonium_sulphate_eq_frac * NH42SO4_hcl + &
6856	ammonium_nitrate_eq_frac * NH4NO3_hcl + &
6857	ammonium_chloride_eq_frac * NH4Cl_hcl + &
6858	sodium_sulphate_eq_frac * Na2SO4_hcl + &
6859	sodium_nitrate_eq_frac * NaNO3_hcl + &
6860	sodium_chloride_eq_frac * NaCl_hcl
6861
6862	gamma_hcl = EXP( Ln_HCL_act ) ! Molal activity coefficient
6863	gamma_out(2) = gamma_hcl
6864	!
6865	!-- Equilibrium constant after Wagman et al. (1982) (and NIST database)
6866	K_hcl = 2E6_wp * EXP( 9000.0_wp * henrys_temp_dep )
6867
6868	Press_HCL = ( ions_mol(1) * ions_mol(7) * ( gamma_hcl**2 ) ) / K_hcl
6869	!
6870	!-- 5) Ion molility output
6871	mols_out = ions_mol
6872	!
6873	!-- REFERENCES
6874	!-- Clegg et al. (1998) A Thermodynamic Model of the System
6875	!-- H+-NH4+-Na+-SO42- -NO3--Cl--H2O at 298.15 K, J. Phys. Chem., 102A,
6876	!-- 2155-2171.
6877	!-- Clegg et al. (2001) Thermodynamic modelling of aqueous aerosols containing
6878	!-- electrolytes and dissolved organic compounds. Journal of Aerosol Science
6879	!-- 2001;32(6):713-738.
6880	!-- Topping et al. (2005a) A curved multi-component aerosol hygroscopicity model
6881	!-- framework: Part 1 - Inorganic compounds. Atmospheric Chemistry and
6882	!-- Physics 2005;5:1205-1222.
6883	!-- Topping et al. (2005b) A curved multi-component aerosol hygroscopicity model
6884	!-- framework: Part 2 - Including organic compounds. Atmospheric Chemistry
6885	!-- and Physics 2005;5:1223-1242.
6886	!-- Wagman et al. (1982). The NBS tables of chemical thermodynamic properties:
6887	!-- selected values for inorganic and Câ and Câ organic substances in SI
6888	!-- units (book)
6889	!-- Zaveri et al. (2005). A new method for multicomponent activity coefficients
6890	!-- of electrolytes in aqueous atmospheric aerosols, JGR, 110, D02201, 2005.
6891	END SUBROUTINE inorganic_pdfite
6892
6893	!------------------------------------------------------------------------------!
6894	! Description:
6895	! ------------
6896	!> Update the particle size distribution. Put particles into corrects bins.
6897	!>
6898	!> Moving-centre method assumed, i.e. particles are allowed to grow to their
6899	!> exact size as long as they are not crossing the fixed diameter bin limits.
6900	!> If the particles in a size bin cross the lower or upper diameter limit, they
6901	!> are all moved to the adjacent diameter bin and their volume is averaged with
6902	!> the particles in the new bin, which then get a new diameter.
6903	!
6904	!> Moving-centre method minimises numerical diffusion.
6905	!------------------------------------------------------------------------------!
6906	SUBROUTINE distr_update( paero )
6907
6908	IMPLICIT NONE
6909
6910	!-- Input and output variables
6911	TYPE(t_section), INTENT(inout) :: paero(fn2b) !< Aerosols particle
6912	!< size distribution and properties
6913	!-- Local variables
6914	INTEGER(iwp) :: b !< loop index
6915	INTEGER(iwp) :: mm !< loop index
6916	INTEGER(iwp) :: counti
6917	LOGICAL :: within_bins !< logical (particle belongs to the bin?)
6918	REAL(wp) :: znfrac !< number fraction to be moved to the larger bin
6919	REAL(wp) :: zvfrac !< volume fraction to be moved to the larger bin
6920	REAL(wp) :: zVexc !< Volume in the grown bin which exceeds the bin
6921	!< upper limit
6922	REAL(wp) :: zVihi !< particle volume at the high end of the bin
6923	REAL(wp) :: zVilo !< particle volume at the low end of the bin
6924	REAL(wp) :: zvpart !< particle volume (m3)
6925	REAL(wp) :: zVrat !< volume ratio of a size bin
6926
6927	zvpart = 0.0_wp
6928	zvfrac = 0.0_wp
6929
6930	within_bins = .FALSE.
6931
6932	!
6933	!-- Check if the volume of the bin is within bin limits after update
6934	counti = 0
6935	DO WHILE ( .NOT. within_bins )
6936	within_bins = .TRUE.
6937
6938	DO b = fn2b-1, in1a, -1
6939	mm = 0
6940	IF ( paero(b)%numc > nclim ) THEN
6941
6942	zvpart = 0.0_wp
6943	zvfrac = 0.0_wp
6944
6945	IF ( b == fn2a ) CYCLE
6946	!
6947	!-- Dry volume
6948	zvpart = SUM( paero(b)%volc(1:7) ) / paero(b)%numc
6949	!
6950	!-- Smallest bin cannot decrease
6951	IF ( paero(b)%vlolim > zvpart .AND. b == in1a ) CYCLE
6952	!
6953	!-- Decreasing bins
6954	IF ( paero(b)%vlolim > zvpart ) THEN
6955	mm = b - 1
6956	IF ( b == in2b ) mm = fn1a ! 2b goes to 1a
6957
6958	paero(mm)%numc = paero(mm)%numc + paero(b)%numc
6959	paero(b)%numc = 0.0_wp
6960	paero(mm)%volc(:) = paero(mm)%volc(:) + paero(b)%volc(:)
6961	paero(b)%volc(:) = 0.0_wp
6962	CYCLE
6963	ENDIF
6964	!
6965	!-- If size bin has not grown, cycle
6966	!-- Changed by Mona: compare to the arithmetic mean volume, as done
6967	!-- originally. Now particle volume is derived from the geometric mean
6968	!-- diameter, not arithmetic (see SUBROUTINE set_sizebins).
6969	IF ( zvpart <= api6 * ( ( aero(b)%vhilim + aero(b)%vlolim ) / &
6970	( 2.0_wp * api6 ) ) ) CYCLE
6971	IF ( ABS( zvpart - api6 * paero(b)%dmid ** 3.0_wp ) < &
6972	1.0E-35_wp ) CYCLE ! Mona: to avoid precision problems
6973	!
6974	!-- Volume ratio of the size bin
6975	zVrat = paero(b)%vhilim / paero(b)%vlolim
6976	!-- Particle volume at the low end of the bin
6977	zVilo = 2.0_wp * zvpart / ( 1.0_wp + zVrat )
6978	!-- Particle volume at the high end of the bin
6979	zVihi = zVrat * zVilo
6980	!-- Volume in the grown bin which exceeds the bin upper limit
6981	zVexc = 0.5_wp * ( zVihi + paero(b)%vhilim )
6982	!-- Number fraction to be moved to the larger bin
6983	znfrac = MIN( 1.0_wp, ( zVihi - paero(b)%vhilim) / &
6984	( zVihi - zVilo ) )
6985	!-- Volume fraction to be moved to the larger bin
6986	zvfrac = MIN( 0.99_wp, znfrac * zVexc / zvpart )
6987	IF ( zvfrac < 0.0_wp ) THEN
6988	message_string = 'Error: zvfrac < 0'
6989	CALL message( 'salsa_mod: distr_update', 'SA0050', &
6990	1, 2, 0, 6, 0 )
6991	ENDIF
6992	!
6993	!-- Update bin
6994	mm = b + 1
6995	!-- Volume (cm3/cm3)
6996	paero(mm)%volc(:) = paero(mm)%volc(:) + znfrac * paero(b)%numc * &
6997	zVexc * paero(b)%volc(:) / &
6998	SUM( paero(b)%volc(1:7) )
6999	paero(b)%volc(:) = paero(b)%volc(:) - znfrac * paero(b)%numc * &
7000	zVexc * paero(b)%volc(:) / &
7001	SUM( paero(b)%volc(1:7) )
7002
7003	!-- Number concentration (#/m3)
7004	paero(mm)%numc = paero(mm)%numc + znfrac * paero(b)%numc
7005	paero(b)%numc = paero(b)%numc * ( 1.0_wp - znfrac )
7006
7007	ENDIF ! nclim
7008
7009	IF ( paero(b)%numc > nclim ) THEN
7010	zvpart = SUM( paero(b)%volc(1:7) ) / paero(b)%numc
7011	within_bins = ( paero(b)%vlolim < zvpart .AND. &
7012	zvpart < paero(b)%vhilim )
7013	ENDIF
7014
7015	ENDDO ! - b
7016
7017	counti = counti + 1
7018	IF ( counti > 100 ) THEN
7019	message_string = 'Error: Aerosol bin update not converged'
7020	CALL message( 'salsa_mod: distr_update', 'SA0051', 1, 2, 0, 6, 0 )
7021	ENDIF
7022
7023	ENDDO ! - within bins
7024
7025	END SUBROUTINE distr_update
7026
7027	!------------------------------------------------------------------------------!
7028	! Description:
7029	! ------------
7030	!> salsa_diagnostics: Update properties for the current timestep:
7031	!>
7032	!> Juha Tonttila, FMI, 2014
7033	!> Tomi Raatikainen, FMI, 2016
7034	!------------------------------------------------------------------------------!
7035	SUBROUTINE salsa_diagnostics( i, j )
7036
7037	USE arrays_3d, &
7038	ONLY: p, pt, zu
7039
7040	USE basic_constants_and_equations_mod, &
7041	ONLY: g
7042
7043	USE control_parameters, &
7044	ONLY: pt_surface, surface_pressure
7045
7046	USE cpulog, &
7047	ONLY: cpu_log, log_point_s
7048
7049	IMPLICIT NONE
7050
7051	INTEGER(iwp), INTENT(in) :: i !<
7052	INTEGER(iwp), INTENT(in) :: j !<
7053
7054	INTEGER(iwp) :: b !<
7055	INTEGER(iwp) :: c !<
7056	INTEGER(iwp) :: gt !<
7057	INTEGER(iwp) :: k !<
7058	INTEGER(iwp) :: nc !<
7059	REAL(wp), DIMENSION(nzb:nzt+1) :: flag !< flag to mask topography
7060	REAL(wp), DIMENSION(nzb:nzt+1) :: flag_zddry !< flag to mask zddry
7061	REAL(wp), DIMENSION(nzb:nzt+1) :: in_adn !< air density (kg/m3)
7062	REAL(wp), DIMENSION(nzb:nzt+1) :: in_p !< pressure
7063	REAL(wp), DIMENSION(nzb:nzt+1) :: in_t !< temperature (K)
7064	REAL(wp), DIMENSION(nzb:nzt+1) :: mcsum !< sum of mass concentration
7065	REAL(wp), DIMENSION(nzb:nzt+1) :: ppm_to_nconc !< Conversion factor
7066	!< from ppm to #/m3
7067	REAL(wp), DIMENSION(nzb:nzt+1) :: zddry !<
7068	REAL(wp), DIMENSION(nzb:nzt+1) :: zvol !<
7069
7070	flag_zddry = 0.0_wp
7071	in_adn = 0.0_wp
7072	in_p = 0.0_wp
7073	in_t = 0.0_wp
7074	ppm_to_nconc = 1.0_wp
7075	zddry = 0.0_wp
7076	zvol = 0.0_wp
7077
7078	CALL cpu_log( log_point_s(94), 'salsa diagnostics ', 'start' )
7079
7080	!
7081	!-- Calculate thermodynamic quantities needed in SALSA
7082	CALL salsa_thrm_ij( i, j, p_ij=in_p, temp_ij=in_t, adn_ij=in_adn )
7083	!
7084	!-- Calculate conversion factors for gas concentrations
7085	ppm_to_nconc = for_ppm_to_nconc * in_p / in_t
7086	!
7087	!-- Predetermine flag to mask topography
7088	flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_0(:,j,i), 0 ) )
7089
7090	DO b = 1, nbins ! aerosol size bins
7091	!
7092	!-- Remove negative values
7093	aerosol_number(b)%conc(:,j,i) = MAX( nclim, &
7094	aerosol_number(b)%conc(:,j,i) ) * flag
7095	mcsum = 0.0_wp ! total mass concentration
7096	DO c = 1, ncc_tot
7097	!
7098	!-- Remove negative concentrations
7099	aerosol_mass((c-1)*nbins+b)%conc(:,j,i) = MAX( mclim, &
7100	aerosol_mass((c-1)*nbins+b)%conc(:,j,i) ) &
7101	* flag
7102	mcsum = mcsum + aerosol_mass((c-1)nbins+b)%conc(:,j,i) flag
7103	ENDDO
7104	!
7105	!-- Check that number and mass concentration match qualitatively
7106	IF ( ANY ( aerosol_number(b)%conc(:,j,i) > nclim .AND. &
7107	mcsum <= 0.0_wp ) ) &
7108	THEN
7109	DO k = nzb+1, nzt
7110	IF ( aerosol_number(b)%conc(k,j,i) > nclim .AND. &
7111	mcsum(k) <= 0.0_wp ) &
7112	THEN
7113	aerosol_number(b)%conc(k,j,i) = nclim * flag(k)
7114	DO c = 1, ncc_tot
7115	aerosol_mass((c-1)nbins+b)%conc(k,j,i) = mclim flag(k)
7116	ENDDO
7117	ENDIF
7118	ENDDO
7119	ENDIF
7120	!
7121	!-- Update aerosol particle radius
7122	CALL bin_mixrat( 'dry', b, i, j, zvol )
7123	zvol = zvol / arhoh2so4 ! Why on sulphate?
7124	!
7125	!-- Particles smaller then 0.1 nm diameter are set to zero
7126	zddry = ( zvol / MAX( nclim, aerosol_number(b)%conc(:,j,i) ) / api6 )** &
7127	( 1.0_wp / 3.0_wp )
7128	flag_zddry = MERGE( 1.0_wp, 0.0_wp, ( zddry < 1.0E-10_wp .AND. &
7129	aerosol_number(b)%conc(:,j,i) > nclim ) )
7130	!
7131	!-- Volatile species to the gas phase
7132	IF ( is_used( prtcl, 'SO4' ) .AND. lscndgas ) THEN
7133	nc = get_index( prtcl, 'SO4' )
7134	c = ( nc - 1 ) * nbins + b
7135	IF ( salsa_gases_from_chem ) THEN
7136	chem_species( gas_index_chem(1) )%conc(:,j,i) = &
7137	chem_species( gas_index_chem(1) )%conc(:,j,i) + &
7138	aerosol_mass(c)%conc(:,j,i) * avo * flag * &
7139	flag_zddry / ( amh2so4 * ppm_to_nconc )
7140	ELSE
7141	salsa_gas(1)%conc(:,j,i) = salsa_gas(1)%conc(:,j,i) + &
7142	aerosol_mass(c)%conc(:,j,i) / amh2so4 *&
7143	avo * flag * flag_zddry
7144	ENDIF
7145	ENDIF
7146	IF ( is_used( prtcl, 'OC' ) .AND. lscndgas ) THEN
7147	nc = get_index( prtcl, 'OC' )
7148	c = ( nc - 1 ) * nbins + b
7149	IF ( salsa_gases_from_chem ) THEN
7150	chem_species( gas_index_chem(5) )%conc(:,j,i) = &
7151	chem_species( gas_index_chem(5) )%conc(:,j,i) + &
7152	aerosol_mass(c)%conc(:,j,i) * avo * flag * &
7153	flag_zddry / ( amoc * ppm_to_nconc )
7154	ELSE
7155	salsa_gas(5)%conc(:,j,i) = salsa_gas(5)%conc(:,j,i) + &
7156	aerosol_mass(c)%conc(:,j,i) / amoc * &
7157	avo * flag * flag_zddry
7158	ENDIF
7159	ENDIF
7160	IF ( is_used( prtcl, 'NO' ) .AND. lscndgas ) THEN
7161	nc = get_index( prtcl, 'NO' )
7162	c = ( nc - 1 ) * nbins + b
7163	IF ( salsa_gases_from_chem ) THEN
7164	chem_species( gas_index_chem(2) )%conc(:,j,i) = &
7165	chem_species( gas_index_chem(2) )%conc(:,j,i) + &
7166	aerosol_mass(c)%conc(:,j,i) * avo * flag * &
7167	flag_zddry / ( amhno3 * ppm_to_nconc )
7168	ELSE
7169	salsa_gas(2)%conc(:,j,i) = salsa_gas(2)%conc(:,j,i) + &
7170	aerosol_mass(c)%conc(:,j,i) / amhno3 * &
7171	avo * flag * flag_zddry
7172	ENDIF
7173	ENDIF
7174	IF ( is_used( prtcl, 'NH' ) .AND. lscndgas ) THEN
7175	nc = get_index( prtcl, 'NH' )
7176	c = ( nc - 1 ) * nbins + b
7177	IF ( salsa_gases_from_chem ) THEN
7178	chem_species( gas_index_chem(3) )%conc(:,j,i) = &
7179	chem_species( gas_index_chem(3) )%conc(:,j,i) + &
7180	aerosol_mass(c)%conc(:,j,i) * avo * flag * &
7181	flag_zddry / ( amnh3 * ppm_to_nconc )
7182	ELSE
7183	salsa_gas(3)%conc(:,j,i) = salsa_gas(3)%conc(:,j,i) + &
7184	aerosol_mass(c)%conc(:,j,i) / amnh3 * &
7185	avo * flag * flag_zddry
7186	ENDIF
7187	ENDIF
7188	!
7189	!-- Mass and number to zero (insoluble species and water are lost)
7190	DO c = 1, ncc_tot
7191	aerosol_mass((c-1)nbins+b)%conc(:,j,i) = MERGE( mclim flag, &
7192	aerosol_mass((c-1)*nbins+b)%conc(:,j,i), &
7193	flag_zddry > 0.0_wp )
7194	ENDDO
7195	aerosol_number(b)%conc(:,j,i) = MERGE( nclim * flag, &
7196	aerosol_number(b)%conc(:,j,i), &
7197	flag_zddry > 0.0_wp )
7198	Ra_dry(:,j,i,b) = MAX( 1.0E-10_wp, 0.5_wp * zddry )
7199
7200	ENDDO
7201	IF ( .NOT. salsa_gases_from_chem ) THEN
7202	DO gt = 1, ngast
7203	salsa_gas(gt)%conc(:,j,i) = MAX( nclim, salsa_gas(gt)%conc(:,j,i) ) &
7204	* flag
7205	ENDDO
7206	ENDIF
7207
7208	CALL cpu_log( log_point_s(94), 'salsa diagnostics ', 'stop' )
7209
7210	END SUBROUTINE salsa_diagnostics
7211
7212
7213	!
7214	!------------------------------------------------------------------------------!
7215	! Description:
7216	! ------------
7217	!> Calculate the tendencies for aerosol number and mass concentrations.
7218	!> Cache-optimized.
7219	!------------------------------------------------------------------------------!
7220	SUBROUTINE salsa_tendency_ij( id, rs_p, rs, trs_m, i, j, i_omp_start, tn, b, &
7221	c, flux_s, diss_s, flux_l, diss_l, rs_init )
7222
7223	USE advec_ws, &
7224	ONLY: advec_s_ws
7225	USE advec_s_pw_mod, &
7226	ONLY: advec_s_pw
7227	USE advec_s_up_mod, &
7228	ONLY: advec_s_up
7229	USE arrays_3d, &
7230	ONLY: ddzu, hyp, pt, rdf_sc, tend
7231	USE diffusion_s_mod, &
7232	ONLY: diffusion_s
7233	USE indices, &
7234	ONLY: wall_flags_0
7235	USE pegrid, &
7236	ONLY: threads_per_task, myid
7237	USE surface_mod, &
7238	ONLY : surf_def_h, surf_def_v, surf_lsm_h, surf_lsm_v, surf_usm_h, &
7239	surf_usm_v
7240
7241	IMPLICIT NONE
7242
7243	CHARACTER (LEN = *) :: id
7244	INTEGER(iwp) :: b !< bin index in derived type aerosol_size_bin
7245	INTEGER(iwp) :: c !< bin index in derived type aerosol_size_bin
7246	INTEGER(iwp) :: i !<
7247	INTEGER(iwp) :: i_omp_start !<
7248	INTEGER(iwp) :: j !<
7249	INTEGER(iwp) :: k !<
7250	INTEGER(iwp) :: nc !< (c-1)*nbins+b
7251	INTEGER(iwp) :: tn !<
7252	REAL(wp), DIMENSION(nzb+1:nzt,nys:nyn,0:threads_per_task-1) :: diss_l !<
7253	REAL(wp), DIMENSION(nzb+1:nzt,0:threads_per_task-1) :: diss_s !<
7254	REAL(wp), DIMENSION(nzb+1:nzt,nys:nyn,0:threads_per_task-1) :: flux_l !<
7255	REAL(wp), DIMENSION(nzb+1:nzt,0:threads_per_task-1) :: flux_s !<
7256	REAL(wp), DIMENSION(nzb:nzt+1) :: rs_init !<
7257	REAL(wp), DIMENSION(:,:,:), POINTER :: rs_p !<
7258	REAL(wp), DIMENSION(:,:,:), POINTER :: rs !<
7259	REAL(wp), DIMENSION(:,:,:), POINTER :: trs_m !<
7260
7261	nc = (c-1)*nbins+b
7262	!
7263	!-- Tendency-terms for reactive scalar
7264	tend(:,j,i) = 0.0_wp
7265
7266	IF ( id == 'aerosol_number' .AND. lod_aero == 3 ) THEN
7267	tend(:,j,i) = tend(:,j,i) + aerosol_number(b)%source(:,j,i)
7268	ELSEIF ( id == 'aerosol_mass' .AND. lod_aero == 3 ) THEN
7269	tend(:,j,i) = tend(:,j,i) + aerosol_mass(nc)%source(:,j,i)
7270	ENDIF
7271	!
7272	!-- Advection terms
7273	IF ( timestep_scheme(1:5) == 'runge' ) THEN
7274	IF ( ws_scheme_sca ) THEN
7275	CALL advec_s_ws( i, j, rs, id, flux_s, diss_s, flux_l, diss_l, &
7276	i_omp_start, tn )
7277	ELSE
7278	CALL advec_s_pw( i, j, rs )
7279	ENDIF
7280	ELSE
7281	CALL advec_s_up( i, j, rs )
7282	ENDIF
7283	!
7284	!-- Diffusion terms
7285	IF ( id == 'aerosol_number' ) THEN
7286	CALL diffusion_s( i, j, rs, surf_def_h(0)%answs(:,b), &
7287	surf_def_h(1)%answs(:,b), surf_def_h(2)%answs(:,b), &
7288	surf_lsm_h%answs(:,b), surf_usm_h%answs(:,b), &
7289	surf_def_v(0)%answs(:,b), surf_def_v(1)%answs(:,b), &
7290	surf_def_v(2)%answs(:,b), surf_def_v(3)%answs(:,b), &
7291	surf_lsm_v(0)%answs(:,b), surf_lsm_v(1)%answs(:,b), &
7292	surf_lsm_v(2)%answs(:,b), surf_lsm_v(3)%answs(:,b), &
7293	surf_usm_v(0)%answs(:,b), surf_usm_v(1)%answs(:,b), &
7294	surf_usm_v(2)%answs(:,b), surf_usm_v(3)%answs(:,b) )
7295	!
7296	!-- Sedimentation for aerosol number and mass
7297	IF ( lsdepo ) THEN
7298	tend(nzb+1:nzt,j,i) = tend(nzb+1:nzt,j,i) - MAX( 0.0_wp, &
7299	( rs(nzb+2:nzt+1,j,i) * sedim_vd(nzb+2:nzt+1,j,i,b) - &
7300	rs(nzb+1:nzt,j,i) * sedim_vd(nzb+1:nzt,j,i,b) ) * &
7301	ddzu(nzb+1:nzt) ) * MERGE( 1.0_wp, 0.0_wp, &
7302	BTEST( wall_flags_0(nzb:nzt-1,j,i), 0 ) )
7303	ENDIF
7304
7305	ELSEIF ( id == 'aerosol_mass' ) THEN
7306	CALL diffusion_s( i, j, rs, surf_def_h(0)%amsws(:,nc), &
7307	surf_def_h(1)%amsws(:,nc), surf_def_h(2)%amsws(:,nc), &
7308	surf_lsm_h%amsws(:,nc), surf_usm_h%amsws(:,nc), &
7309	surf_def_v(0)%amsws(:,nc), surf_def_v(1)%amsws(:,nc), &
7310	surf_def_v(2)%amsws(:,nc), surf_def_v(3)%amsws(:,nc), &
7311	surf_lsm_v(0)%amsws(:,nc), surf_lsm_v(1)%amsws(:,nc), &
7312	surf_lsm_v(2)%amsws(:,nc), surf_lsm_v(3)%amsws(:,nc), &
7313	surf_usm_v(0)%amsws(:,nc), surf_usm_v(1)%amsws(:,nc), &
7314	surf_usm_v(2)%amsws(:,nc), surf_usm_v(3)%amsws(:,nc) )
7315	!
7316	!-- Sedimentation for aerosol number and mass
7317	IF ( lsdepo ) THEN
7318	tend(nzb+1:nzt,j,i) = tend(nzb+1:nzt,j,i) - MAX( 0.0_wp, &
7319	( rs(nzb+2:nzt+1,j,i) * sedim_vd(nzb+2:nzt+1,j,i,b) - &
7320	rs(nzb+1:nzt,j,i) * sedim_vd(nzb+1:nzt,j,i,b) ) * &
7321	ddzu(nzb+1:nzt) ) * MERGE( 1.0_wp, 0.0_wp, &
7322	BTEST( wall_flags_0(nzb:nzt-1,j,i), 0 ) )
7323	ENDIF
7324	ELSEIF ( id == 'salsa_gas' ) THEN
7325	CALL diffusion_s( i, j, rs, surf_def_h(0)%gtsws(:,b), &
7326	surf_def_h(1)%gtsws(:,b), surf_def_h(2)%gtsws(:,b), &
7327	surf_lsm_h%gtsws(:,b), surf_usm_h%gtsws(:,b), &
7328	surf_def_v(0)%gtsws(:,b), surf_def_v(1)%gtsws(:,b), &
7329	surf_def_v(2)%gtsws(:,b), surf_def_v(3)%gtsws(:,b), &
7330	surf_lsm_v(0)%gtsws(:,b), surf_lsm_v(1)%gtsws(:,b), &
7331	surf_lsm_v(2)%gtsws(:,b), surf_lsm_v(3)%gtsws(:,b), &
7332	surf_usm_v(0)%gtsws(:,b), surf_usm_v(1)%gtsws(:,b), &
7333	surf_usm_v(2)%gtsws(:,b), surf_usm_v(3)%gtsws(:,b) )
7334	ENDIF
7335	!
7336	!-- Prognostic equation for a scalar
7337	DO k = nzb+1, nzt
7338	rs_p(k,j,i) = rs(k,j,i) + ( dt_3d * ( tsc(2) * tend(k,j,i) + &
7339	tsc(3) * trs_m(k,j,i) ) &
7340	- tsc(5) * rdf_sc(k) &
7341	* ( rs(k,j,i) - rs_init(k) ) ) &
7342	* MERGE( 1.0_wp, 0.0_wp, &
7343	BTEST( wall_flags_0(k,j,i), 0 ) )
7344	IF ( rs_p(k,j,i) < 0.0_wp ) rs_p(k,j,i) = 0.1_wp * rs(k,j,i)
7345	ENDDO
7346
7347	!
7348	!-- Calculate tendencies for the next Runge-Kutta step
7349	IF ( timestep_scheme(1:5) == 'runge' ) THEN
7350	IF ( intermediate_timestep_count == 1 ) THEN
7351	DO k = nzb+1, nzt
7352	trs_m(k,j,i) = tend(k,j,i)
7353	ENDDO
7354	ELSEIF ( intermediate_timestep_count < &
7355	intermediate_timestep_count_max ) THEN
7356	DO k = nzb+1, nzt
7357	trs_m(k,j,i) = -9.5625_wp * tend(k,j,i) + 5.3125_wp * trs_m(k,j,i)
7358	ENDDO
7359	ENDIF
7360	ENDIF
7361
7362	END SUBROUTINE salsa_tendency_ij
7363
7364	!
7365	!------------------------------------------------------------------------------!
7366	! Description:
7367	! ------------
7368	!> Calculate the tendencies for aerosol number and mass concentrations.
7369	!> Vector-optimized.
7370	!------------------------------------------------------------------------------!
7371	SUBROUTINE salsa_tendency( id, rs_p, rs, trs_m, b, c, rs_init )
7372
7373	USE advec_ws, &
7374	ONLY: advec_s_ws
7375	USE advec_s_pw_mod, &
7376	ONLY: advec_s_pw
7377	USE advec_s_up_mod, &
7378	ONLY: advec_s_up
7379	USE arrays_3d, &
7380	ONLY: ddzu, hyp, pt, rdf_sc, tend
7381	USE diffusion_s_mod, &
7382	ONLY: diffusion_s
7383	USE indices, &
7384	ONLY: wall_flags_0
7385	USE surface_mod, &
7386	ONLY : surf_def_h, surf_def_v, surf_lsm_h, surf_lsm_v, surf_usm_h, &
7387	surf_usm_v
7388
7389	IMPLICIT NONE
7390
7391	CHARACTER (LEN = *) :: id
7392	INTEGER(iwp) :: b !< bin index in derived type aerosol_size_bin
7393	INTEGER(iwp) :: c !< bin index in derived type aerosol_size_bin
7394	INTEGER(iwp) :: i !<
7395	INTEGER(iwp) :: j !<
7396	INTEGER(iwp) :: k !<
7397	INTEGER(iwp) :: nc !< (c-1)*nbins+b
7398	REAL(wp), DIMENSION(nzb:nzt+1) :: rs_init !<
7399	REAL(wp), DIMENSION(:,:,:), POINTER :: rs_p !<
7400	REAL(wp), DIMENSION(:,:,:), POINTER :: rs !<
7401	REAL(wp), DIMENSION(:,:,:), POINTER :: trs_m !<
7402
7403	nc = (c-1)*nbins+b
7404	!
7405	!-- Tendency-terms for reactive scalar
7406	tend = 0.0_wp
7407
7408	IF ( id == 'aerosol_number' .AND. lod_aero == 3 ) THEN
7409	tend = tend + aerosol_number(b)%source
7410	ELSEIF ( id == 'aerosol_mass' .AND. lod_aero == 3 ) THEN
7411	tend = tend + aerosol_mass(nc)%source
7412	ENDIF
7413	!
7414	!-- Advection terms
7415	IF ( timestep_scheme(1:5) == 'runge' ) THEN
7416	IF ( ws_scheme_sca ) THEN
7417	CALL advec_s_ws( rs, id )
7418	ELSE
7419	CALL advec_s_pw( rs )
7420	ENDIF
7421	ELSE
7422	CALL advec_s_up( rs )
7423	ENDIF
7424	!
7425	!-- Diffusion terms
7426	IF ( id == 'aerosol_number' ) THEN
7427	CALL diffusion_s( rs, surf_def_h(0)%answs(:,b), &
7428	surf_def_h(1)%answs(:,b), surf_def_h(2)%answs(:,b), &
7429	surf_lsm_h%answs(:,b), surf_usm_h%answs(:,b), &
7430	surf_def_v(0)%answs(:,b), surf_def_v(1)%answs(:,b), &
7431	surf_def_v(2)%answs(:,b), surf_def_v(3)%answs(:,b), &
7432	surf_lsm_v(0)%answs(:,b), surf_lsm_v(1)%answs(:,b), &
7433	surf_lsm_v(2)%answs(:,b), surf_lsm_v(3)%answs(:,b), &
7434	surf_usm_v(0)%answs(:,b), surf_usm_v(1)%answs(:,b), &
7435	surf_usm_v(2)%answs(:,b), surf_usm_v(3)%answs(:,b) )
7436	ELSEIF ( id == 'aerosol_mass' ) THEN
7437	CALL diffusion_s( rs, surf_def_h(0)%amsws(:,nc), &
7438	surf_def_h(1)%amsws(:,nc), surf_def_h(2)%amsws(:,nc), &
7439	surf_lsm_h%amsws(:,nc), surf_usm_h%amsws(:,nc), &
7440	surf_def_v(0)%amsws(:,nc), surf_def_v(1)%amsws(:,nc), &
7441	surf_def_v(2)%amsws(:,nc), surf_def_v(3)%amsws(:,nc), &
7442	surf_lsm_v(0)%amsws(:,nc), surf_lsm_v(1)%amsws(:,nc), &
7443	surf_lsm_v(2)%amsws(:,nc), surf_lsm_v(3)%amsws(:,nc), &
7444	surf_usm_v(0)%amsws(:,nc), surf_usm_v(1)%amsws(:,nc), &
7445	surf_usm_v(2)%amsws(:,nc), surf_usm_v(3)%amsws(:,nc) )
7446	ELSEIF ( id == 'salsa_gas' ) THEN
7447	CALL diffusion_s( rs, surf_def_h(0)%gtsws(:,b), &
7448	surf_def_h(1)%gtsws(:,b), surf_def_h(2)%gtsws(:,b), &
7449	surf_lsm_h%gtsws(:,b), surf_usm_h%gtsws(:,b), &
7450	surf_def_v(0)%gtsws(:,b), surf_def_v(1)%gtsws(:,b), &
7451	surf_def_v(2)%gtsws(:,b), surf_def_v(3)%gtsws(:,b), &
7452	surf_lsm_v(0)%gtsws(:,b), surf_lsm_v(1)%gtsws(:,b), &
7453	surf_lsm_v(2)%gtsws(:,b), surf_lsm_v(3)%gtsws(:,b), &
7454	surf_usm_v(0)%gtsws(:,b), surf_usm_v(1)%gtsws(:,b), &
7455	surf_usm_v(2)%gtsws(:,b), surf_usm_v(3)%gtsws(:,b) )
7456	ENDIF
7457	!
7458	!-- Prognostic equation for a scalar
7459	DO i = nxl, nxr
7460	DO j = nys, nyn
7461	IF ( id == 'salsa_gas' .AND. lod_gases == 3 ) THEN
7462	tend(:,j,i) = tend(:,j,i) + salsa_gas(b)%source(:,j,i) * &
7463	for_ppm_to_nconc * hyp(:) / pt(:,j,i) * ( hyp(:) / &
7464	100000.0_wp )**0.286_wp ! ppm to #/m3
7465	ELSEIF ( id == 'aerosol_mass' .OR. id == 'aerosol_number') THEN
7466	!
7467	!-- Sedimentation for aerosol number and mass
7468	IF ( lsdepo ) THEN
7469	tend(nzb+1:nzt,j,i) = tend(nzb+1:nzt,j,i) - MAX( 0.0_wp, &
7470	( rs(nzb+2:nzt+1,j,i) * sedim_vd(nzb+2:nzt+1,j,i,b) - &
7471	rs(nzb+1:nzt,j,i) * sedim_vd(nzb+1:nzt,j,i,b) ) * &
7472	ddzu(nzb+1:nzt) ) * MERGE( 1.0_wp, 0.0_wp, &
7473	BTEST( wall_flags_0(nzb:nzt-1,j,i), 0 ) )
7474	ENDIF
7475	ENDIF
7476	DO k = nzb+1, nzt
7477	rs_p(k,j,i) = rs(k,j,i) + ( dt_3d * ( tsc(2) * tend(k,j,i) + &
7478	tsc(3) * trs_m(k,j,i) ) &
7479	- tsc(5) * rdf_sc(k) &
7480	* ( rs(k,j,i) - rs_init(k) ) )&
7481	* MERGE( 1.0_wp, 0.0_wp, &
7482	BTEST( wall_flags_0(k,j,i), 0 ) )
7483	IF ( rs_p(k,j,i) < 0.0_wp ) rs_p(k,j,i) = 0.1_wp * rs(k,j,i)
7484	ENDDO
7485	ENDDO
7486	ENDDO
7487
7488	!
7489	!-- Calculate tendencies for the next Runge-Kutta step
7490	IF ( timestep_scheme(1:5) == 'runge' ) THEN
7491	IF ( intermediate_timestep_count == 1 ) THEN
7492	DO i = nxl, nxr
7493	DO j = nys, nyn
7494	DO k = nzb+1, nzt
7495	trs_m(k,j,i) = tend(k,j,i)
7496	ENDDO
7497	ENDDO
7498	ENDDO
7499	ELSEIF ( intermediate_timestep_count < &
7500	intermediate_timestep_count_max ) THEN
7501	DO i = nxl, nxr
7502	DO j = nys, nyn
7503	DO k = nzb+1, nzt
7504	trs_m(k,j,i) = -9.5625_wp * tend(k,j,i) &
7505	+ 5.3125_wp * trs_m(k,j,i)
7506	ENDDO
7507	ENDDO
7508	ENDDO
7509	ENDIF
7510	ENDIF
7511
7512	END SUBROUTINE salsa_tendency
7513
7514	!------------------------------------------------------------------------------!
7515	! Description:
7516	! ------------
7517	!> Boundary conditions for prognostic variables in SALSA
7518	!------------------------------------------------------------------------------!
7519	SUBROUTINE salsa_boundary_conds
7520
7521	USE surface_mod, &
7522	ONLY : bc_h
7523
7524	IMPLICIT NONE
7525
7526	INTEGER(iwp) :: b !< index for aerosol size bins
7527	INTEGER(iwp) :: c !< index for chemical compounds in aerosols
7528	INTEGER(iwp) :: g !< idex for gaseous compounds
7529	INTEGER(iwp) :: i !< grid index x direction
7530	INTEGER(iwp) :: j !< grid index y direction
7531	INTEGER(iwp) :: k !< grid index y direction
7532	INTEGER(iwp) :: kb !< variable to set respective boundary value, depends on
7533	!< facing.
7534	INTEGER(iwp) :: l !< running index boundary type, for up- and downward-
7535	!< facing walls
7536	INTEGER(iwp) :: m !< running index surface elements
7537
7538	!
7539	!-- Surface conditions:
7540	IF ( ibc_salsa_b == 0 ) THEN ! Dirichlet
7541	!
7542	!-- Run loop over all non-natural and natural walls. Note, in wall-datatype
7543	!-- the k coordinate belongs to the atmospheric grid point, therefore, set
7544	!-- s_p at k-1
7545
7546	DO l = 0, 1
7547	!
7548	!-- Set kb, for upward-facing surfaces value at topography top (k-1) is
7549	!-- set, for downward-facing surfaces at topography bottom (k+1)
7550	kb = MERGE ( -1, 1, l == 0 )
7551	!$OMP PARALLEL PRIVATE( b, c, g, i, j, k )
7552	!$OMP DO
7553	DO m = 1, bc_h(l)%ns
7554
7555	i = bc_h(l)%i(m)
7556	j = bc_h(l)%j(m)
7557	k = bc_h(l)%k(m)
7558
7559	DO b = 1, nbins
7560	aerosol_number(b)%conc_p(k+kb,j,i) = &
7561	aerosol_number(b)%conc(k+kb,j,i)
7562	DO c = 1, ncc_tot
7563	aerosol_mass((c-1)*nbins+b)%conc_p(k+kb,j,i) = &
7564	aerosol_mass((c-1)*nbins+b)%conc(k+kb,j,i)
7565	ENDDO
7566	ENDDO
7567	IF ( .NOT. salsa_gases_from_chem ) THEN
7568	DO g = 1, ngast
7569	salsa_gas(g)%conc_p(k+kb,j,i) = salsa_gas(g)%conc(k+kb,j,i)
7570	ENDDO
7571	ENDIF
7572
7573	ENDDO
7574	!$OMP END PARALLEL
7575
7576	ENDDO
7577
7578	ELSE ! Neumann
7579
7580	DO l = 0, 1
7581	!
7582	!-- Set kb, for upward-facing surfaces value at topography top (k-1) is
7583	!-- set, for downward-facing surfaces at topography bottom (k+1)
7584	kb = MERGE( -1, 1, l == 0 )
7585	!$OMP PARALLEL PRIVATE( b, c, g, i, j, k )
7586	!$OMP DO
7587	DO m = 1, bc_h(l)%ns
7588
7589	i = bc_h(l)%i(m)
7590	j = bc_h(l)%j(m)
7591	k = bc_h(l)%k(m)
7592
7593	DO b = 1, nbins
7594	aerosol_number(b)%conc_p(k+kb,j,i) = &
7595	aerosol_number(b)%conc_p(k,j,i)
7596	DO c = 1, ncc_tot
7597	aerosol_mass((c-1)*nbins+b)%conc_p(k+kb,j,i) = &
7598	aerosol_mass((c-1)*nbins+b)%conc_p(k,j,i)
7599	ENDDO
7600	ENDDO
7601	IF ( .NOT. salsa_gases_from_chem ) THEN
7602	DO g = 1, ngast
7603	salsa_gas(g)%conc_p(k+kb,j,i) = salsa_gas(g)%conc_p(k,j,i)
7604	ENDDO
7605	ENDIF
7606
7607	ENDDO
7608	!$OMP END PARALLEL
7609	ENDDO
7610
7611	ENDIF
7612
7613	!
7614	!--Top boundary conditions:
7615	IF ( ibc_salsa_t == 0 ) THEN ! Dirichlet
7616
7617	DO b = 1, nbins
7618	aerosol_number(b)%conc_p(nzt+1,:,:) = &
7619	aerosol_number(b)%conc(nzt+1,:,:)
7620	DO c = 1, ncc_tot
7621	aerosol_mass((c-1)*nbins+b)%conc_p(nzt+1,:,:) = &
7622	aerosol_mass((c-1)*nbins+b)%conc(nzt+1,:,:)
7623	ENDDO
7624	ENDDO
7625	IF ( .NOT. salsa_gases_from_chem ) THEN
7626	DO g = 1, ngast
7627	salsa_gas(g)%conc_p(nzt+1,:,:) = salsa_gas(g)%conc(nzt+1,:,:)
7628	ENDDO
7629	ENDIF
7630
7631	ELSEIF ( ibc_salsa_t == 1 ) THEN ! Neumann
7632
7633	DO b = 1, nbins
7634	aerosol_number(b)%conc_p(nzt+1,:,:) = &
7635	aerosol_number(b)%conc_p(nzt,:,:)
7636	DO c = 1, ncc_tot
7637	aerosol_mass((c-1)*nbins+b)%conc_p(nzt+1,:,:) = &
7638	aerosol_mass((c-1)*nbins+b)%conc_p(nzt,:,:)
7639	ENDDO
7640	ENDDO
7641	IF ( .NOT. salsa_gases_from_chem ) THEN
7642	DO g = 1, ngast
7643	salsa_gas(g)%conc_p(nzt+1,:,:) = salsa_gas(g)%conc_p(nzt,:,:)
7644	ENDDO
7645	ENDIF
7646
7647	ENDIF
7648	!
7649	!-- Lateral boundary conditions at the outflow
7650	IF ( bc_radiation_s ) THEN
7651	DO b = 1, nbins
7652	aerosol_number(b)%conc_p(:,nys-1,:) = aerosol_number(b)%conc_p(:,nys,:)
7653	DO c = 1, ncc_tot
7654	aerosol_mass((c-1)*nbins+b)%conc_p(:,nys-1,:) = &
7655	aerosol_mass((c-1)*nbins+b)%conc_p(:,nys,:)
7656	ENDDO
7657	ENDDO
7658	ELSEIF ( bc_radiation_n ) THEN
7659	DO b = 1, nbins
7660	aerosol_number(b)%conc_p(:,nyn+1,:) = aerosol_number(b)%conc_p(:,nyn,:)
7661	DO c = 1, ncc_tot
7662	aerosol_mass((c-1)*nbins+b)%conc_p(:,nyn+1,:) = &
7663	aerosol_mass((c-1)*nbins+b)%conc_p(:,nyn,:)
7664	ENDDO
7665	ENDDO
7666	ELSEIF ( bc_radiation_l ) THEN
7667	DO b = 1, nbins
7668	aerosol_number(b)%conc_p(:,nxl-1,:) = aerosol_number(b)%conc_p(:,nxl,:)
7669	DO c = 1, ncc_tot
7670	aerosol_mass((c-1)*nbins+b)%conc_p(:,nxl-1,:) = &
7671	aerosol_mass((c-1)*nbins+b)%conc_p(:,nxl,:)
7672	ENDDO
7673	ENDDO
7674	ELSEIF ( bc_radiation_r ) THEN
7675	DO b = 1, nbins
7676	aerosol_number(b)%conc_p(:,nxr+1,:) = aerosol_number(b)%conc_p(:,nxr,:)
7677	DO c = 1, ncc_tot
7678	aerosol_mass((c-1)*nbins+b)%conc_p(:,nxr+1,:) = &
7679	aerosol_mass((c-1)*nbins+b)%conc_p(:,nxr,:)
7680	ENDDO
7681	ENDDO
7682	ENDIF
7683
7684	END SUBROUTINE salsa_boundary_conds
7685
7686	!------------------------------------------------------------------------------!
7687	! Description:
7688	! ------------
7689	! Undoing of the previously done cyclic boundary conditions.
7690	!------------------------------------------------------------------------------!
7691	SUBROUTINE salsa_boundary_conds_decycle ( sq, sq_init )
7692
7693	IMPLICIT NONE
7694
7695	INTEGER(iwp) :: boundary !<
7696	INTEGER(iwp) :: ee !<
7697	INTEGER(iwp) :: copied !<
7698	INTEGER(iwp) :: i !<
7699	INTEGER(iwp) :: j !<
7700	INTEGER(iwp) :: k !<
7701	INTEGER(iwp) :: ss !<
7702	REAL(wp), DIMENSION(nzb:nzt+1) :: sq_init
7703	REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) :: sq
7704	REAL(wp) :: flag !< flag to mask topography grid points
7705
7706	flag = 0.0_wp
7707	!
7708	!-- Left and right boundaries
7709	IF ( decycle_lr .AND. ( bc_lr_cyc .OR. bc_lr == 'nested' ) ) THEN
7710
7711	DO boundary = 1, 2
7712
7713	IF ( decycle_method(boundary) == 'dirichlet' ) THEN
7714	!
7715	!-- Initial profile is copied to ghost and first three layers
7716	ss = 1
7717	ee = 0
7718	IF ( boundary == 1 .AND. nxl == 0 ) THEN
7719	ss = nxlg
7720	ee = nxl+2
7721	ELSEIF ( boundary == 2 .AND. nxr == nx ) THEN
7722	ss = nxr-2
7723	ee = nxrg
7724	ENDIF
7725
7726	DO i = ss, ee
7727	DO j = nysg, nyng
7728	DO k = nzb+1, nzt
7729	flag = MERGE( 1.0_wp, 0.0_wp, &
7730	BTEST( wall_flags_0(k,j,i), 0 ) )
7731	sq(k,j,i) = sq_init(k) * flag
7732	ENDDO
7733	ENDDO
7734	ENDDO
7735
7736	ELSEIF ( decycle_method(boundary) == 'neumann' ) THEN
7737	!
7738	!-- The value at the boundary is copied to the ghost layers to simulate
7739	!-- an outlet with zero gradient
7740	ss = 1
7741	ee = 0
7742	IF ( boundary == 1 .AND. nxl == 0 ) THEN
7743	ss = nxlg
7744	ee = nxl-1
7745	copied = nxl
7746	ELSEIF ( boundary == 2 .AND. nxr == nx ) THEN
7747	ss = nxr+1
7748	ee = nxrg
7749	copied = nxr
7750	ENDIF
7751
7752	DO i = ss, ee
7753	DO j = nysg, nyng
7754	DO k = nzb+1, nzt
7755	flag = MERGE( 1.0_wp, 0.0_wp, &
7756	BTEST( wall_flags_0(k,j,i), 0 ) )
7757	sq(k,j,i) = sq(k,j,copied) * flag
7758	ENDDO
7759	ENDDO
7760	ENDDO
7761
7762	ELSE
7763	WRITE(message_string,*) &
7764	'unknown decycling method: decycle_method (', &
7765	boundary, ') ="' // TRIM( decycle_method(boundary) ) // '"'
7766	CALL message( 'salsa_boundary_conds_decycle', 'SA0029', &
7767	1, 2, 0, 6, 0 )
7768	ENDIF
7769	ENDDO
7770	ENDIF
7771
7772	!
7773	!-- South and north boundaries
7774	IF ( decycle_ns .AND. ( bc_ns_cyc .OR. bc_ns == 'nested' ) ) THEN
7775
7776	DO boundary = 3, 4
7777
7778	IF ( decycle_method(boundary) == 'dirichlet' ) THEN
7779	!
7780	!-- Initial profile is copied to ghost and first three layers
7781	ss = 1
7782	ee = 0
7783	IF ( boundary == 3 .AND. nys == 0 ) THEN
7784	ss = nysg
7785	ee = nys+2
7786	ELSEIF ( boundary == 4 .AND. nyn == ny ) THEN
7787	ss = nyn-2
7788	ee = nyng
7789	ENDIF
7790
7791	DO i = nxlg, nxrg
7792	DO j = ss, ee
7793	DO k = nzb+1, nzt
7794	flag = MERGE( 1.0_wp, 0.0_wp, &
7795	BTEST( wall_flags_0(k,j,i), 0 ) )
7796	sq(k,j,i) = sq_init(k) * flag
7797	ENDDO
7798	ENDDO
7799	ENDDO
7800
7801	ELSEIF ( decycle_method(boundary) == 'neumann' ) THEN
7802	!
7803	!-- The value at the boundary is copied to the ghost layers to simulate
7804	!-- an outlet with zero gradient
7805	ss = 1
7806	ee = 0
7807	IF ( boundary == 3 .AND. nys == 0 ) THEN
7808	ss = nysg
7809	ee = nys-1
7810	copied = nys
7811	ELSEIF ( boundary == 4 .AND. nyn == ny ) THEN
7812	ss = nyn+1
7813	ee = nyng
7814	copied = nyn
7815	ENDIF
7816
7817	DO i = nxlg, nxrg
7818	DO j = ss, ee
7819	DO k = nzb+1, nzt
7820	flag = MERGE( 1.0_wp, 0.0_wp, &
7821	BTEST( wall_flags_0(k,j,i), 0 ) )
7822	sq(k,j,i) = sq(k,copied,i) * flag
7823	ENDDO
7824	ENDDO
7825	ENDDO
7826
7827	ELSE
7828	WRITE(message_string,*) &
7829	'unknown decycling method: decycle_method (', &
7830	boundary, ') ="' // TRIM( decycle_method(boundary) ) // '"'
7831	CALL message( 'salsa_boundary_conds_decycle', 'SA0030', &
7832	1, 2, 0, 6, 0 )
7833	ENDIF
7834	ENDDO
7835	ENDIF
7836
7837	END SUBROUTINE salsa_boundary_conds_decycle
7838
7839	!------------------------------------------------------------------------------!
7840	! Description:
7841	! ------------
7842	!> Calculates the total dry or wet mass concentration for individual bins
7843	!> Juha Tonttila (FMI) 2015
7844	!> Tomi Raatikainen (FMI) 2016
7845	!------------------------------------------------------------------------------!
7846	SUBROUTINE bin_mixrat( itype, ibin, i, j, mconc )
7847
7848	IMPLICIT NONE
7849
7850	CHARACTER(len=*), INTENT(in) :: itype !< 'dry' or 'wet'
7851	INTEGER(iwp), INTENT(in) :: ibin !< index of the chemical component
7852	INTEGER(iwp), INTENT(in) :: i !< loop index for x-direction
7853	INTEGER(iwp), INTENT(in) :: j !< loop index for y-direction
7854	REAL(wp), DIMENSION(:), INTENT(out) :: mconc !< total dry or wet mass
7855	!< concentration
7856
7857	INTEGER(iwp) :: c !< loop index for mass bin number
7858	INTEGER(iwp) :: iend !< end index: include water or not
7859
7860	!-- Number of components
7861	IF ( itype == 'dry' ) THEN
7862	iend = get_n_comp( prtcl ) - 1
7863	ELSE IF ( itype == 'wet' ) THEN
7864	iend = get_n_comp( prtcl )
7865	ELSE
7866	STOP 1 ! "INFO for Developer: please use the message routine to pass the output string" bin_mixrat: Error in itype
7867	ENDIF
7868
7869	mconc = 0.0_wp
7870
7871	DO c = ibin, iend*nbins+ibin, nbins !< every nbins'th element
7872	mconc = mconc + aerosol_mass(c)%conc(:,j,i)
7873	ENDDO
7874
7875	END SUBROUTINE bin_mixrat
7876
7877	!------------------------------------------------------------------------------!
7878	!> Description:
7879	!> ------------
7880	!> Define aerosol fluxes: constant or read from a from file
7881	!------------------------------------------------------------------------------!
7882	SUBROUTINE salsa_set_source
7883
7884	! USE date_and_time_mod, &
7885	! ONLY: index_dd, index_hh, index_mm
7886	#if defined( __netcdf )
7887	USE NETCDF
7888
7889	USE netcdf_data_input_mod, &
7890	ONLY: get_attribute, get_variable, &
7891	netcdf_data_input_get_dimension_length, open_read_file
7892
7893	USE surface_mod, &
7894	ONLY: surf_def_h, surf_lsm_h, surf_usm_h
7895
7896	IMPLICIT NONE
7897
7898	INTEGER(iwp), PARAMETER :: ndm = 3 !< number of default modes
7899	INTEGER(iwp), PARAMETER :: ndc = 4 !< number of default categories
7900
7901	CHARACTER (LEN=10) :: unita !< Unit of aerosol fluxes
7902	CHARACTER (LEN=10) :: unitg !< Unit of gaseous fluxes
7903	INTEGER(iwp) :: b !< loop index: aerosol number bins
7904	INTEGER(iwp) :: c !< loop index: aerosol chemical components
7905	INTEGER(iwp) :: ee !< loop index: end
7906	INTEGER(iwp), ALLOCATABLE, DIMENSION(:) :: eci !< emission category index
7907	INTEGER(iwp) :: g !< loop index: gaseous tracers
7908	INTEGER(iwp) :: i !< loop index: x-direction
7909	INTEGER(iwp) :: id_faero !< NetCDF id of aerosol source input file
7910	INTEGER(iwp) :: id_fchem !< NetCDF id of aerosol source input file
7911	INTEGER(iwp) :: id_sa !< NetCDF id of variable: source
7912	INTEGER(iwp) :: j !< loop index: y-direction
7913	INTEGER(iwp) :: k !< loop index: z-direction
7914	INTEGER(iwp) :: kg !< loop index: z-direction (gases)
7915	INTEGER(iwp) :: n_dt !< number of time steps in the emission file
7916	INTEGER(iwp) :: nc_stat !< local variable for storing the result of
7917	!< netCDF calls for error message handling
7918	INTEGER(iwp) :: nb_file !< Number of grid-points in file (bins)
7919	INTEGER(iwp) :: ncat !< Number of emission categories
7920	INTEGER(iwp) :: ng_file !< Number of grid-points in file (gases)
7921	INTEGER(iwp) :: num_vars !< number of variables in input file
7922	INTEGER(iwp) :: nz_file !< number of grid-points in file
7923	INTEGER(iwp) :: n !< loop index
7924	INTEGER(iwp) :: ni !< loop index
7925	INTEGER(iwp) :: ss !< loop index
7926	LOGICAL :: netcdf_extend = .FALSE. !< Flag indicating wether netcdf
7927	!< topography input file or not
7928	REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:) :: dum_var_4d !< variable for
7929	!< temporary data
7930	REAL(wp) :: fillval !< fill value
7931	REAL(wp) :: flag !< flag to mask topography grid points
7932	REAL(wp), DIMENSION(nbins) :: nsect_emission !< sectional emission (lod1)
7933	REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: pm_emission !< aerosol mass
7934	!< emission (lod1)
7935	REAL(wp), DIMENSION(nbins) :: source_ijka !< aerosol source at (k,j,i)
7936	!
7937	!-- The default size distribution and mass composition per emission category:
7938	!-- 1 = traffic, 2 = road dust, 3 = wood combustion, 4 = other
7939	!-- Mass fractions: H2SO4, OC, BC, DU, SS, HNO3, NH3
7940	CHARACTER(LEN=15), DIMENSION(ndc) :: cat_name_table = &!< emission category
7941	(/'road traffic ','road dust ',&
7942	'wood combustion','other '/)
7943	REAL(wp), DIMENSION(ndc) :: avg_density !< average density
7944	REAL(wp), DIMENSION(ndc) :: conversion_factor !< unit conversion factor
7945	!< for aerosol emissions
7946	REAL(wp), DIMENSION(ndm), PARAMETER :: dpg_table = & !< mean diameter (mum)
7947	(/ 13.5E-3_wp, 1.4_wp, 5.4E-2_wp/)
7948	REAL(wp), DIMENSION(ndm) :: ntot_table
7949	REAL(wp), DIMENSION(maxspec,ndc), PARAMETER :: mass_fraction_table = &
7950	RESHAPE( (/ 0.04_wp, 0.48_wp, 0.48_wp, 0.0_wp, 0.0_wp, 0.0_wp, 0.0_wp, &
7951	0.0_wp, 0.05_wp, 0.0_wp, 0.95_wp, 0.0_wp, 0.0_wp, 0.0_wp, &
7952	0.0_wp, 0.5_wp, 0.5_wp, 0.0_wp, 0.0_wp, 0.0_wp, 0.0_wp, &
7953	0.0_wp, 0.5_wp, 0.5_wp, 0.0_wp, 0.0_wp, 0.0_wp, 0.0_wp &
7954	/), (/maxspec,ndc/) )
7955	REAL(wp), DIMENSION(ndm,ndc), PARAMETER :: PMfrac_table = & !< rel. mass
7956	RESHAPE( (/ 0.016_wp, 0.000_wp, 0.984_wp, &
7957	0.000_wp, 1.000_wp, 0.000_wp, &
7958	0.000_wp, 0.000_wp, 1.000_wp, &
7959	1.000_wp, 0.000_wp, 1.000_wp &
7960	/), (/ndm,ndc/) )
7961	REAL(wp), DIMENSION(ndm), PARAMETER :: sigmag_table = & !< mode std
7962	(/1.6_wp, 1.4_wp, 1.7_wp/)
7963	avg_density = 1.0_wp
7964	nb_file = 0
7965	ng_file = 0
7966	nsect_emission = 0.0_wp
7967	nz_file = 0
7968	source_ijka = 0.0_wp
7969	!
7970	!-- First gases, if needed:
7971	IF ( .NOT. salsa_gases_from_chem ) THEN
7972	!
7973	!-- Read sources from PIDS_CHEM
7974	INQUIRE( FILE='PIDS_CHEM' // TRIM( coupling_char ), EXIST=netcdf_extend )
7975	IF ( .NOT. netcdf_extend ) THEN
7976	message_string = 'Input file '// TRIM( 'PIDS_CHEM' ) // &
7977	TRIM( coupling_char ) // ' for SALSA missing!'
7978	CALL message( 'salsa_mod: salsa_set_source', 'SA0027', 1, 2, 0, 6, 0 )
7979	ENDIF ! netcdf_extend
7980
7981	CALL location_message( ' salsa_set_source: NOTE! Gaseous emissions'//&
7982	' should be provided with following emission indices:'// &
7983	' 1=H2SO4, 2=HNO3, 3=NH3, 4=OCNV, 5=OCSV', .TRUE. )
7984	CALL location_message( ' salsa_set_source: No time dependency for '//&
7985	'gaseous emissions. Use emission_values '// &
7986	'directly.', .TRUE. )
7987	!
7988	!-- Open PIDS_CHEM in read-only mode
7989	CALL open_read_file( 'PIDS_CHEM' // TRIM( coupling_char ), id_fchem )
7990	!
7991	!-- Inquire the level of detail (lod)
7992	CALL get_attribute( id_fchem, 'lod', lod_gases, .FALSE., &
7993	"emission_values" )
7994
7995	IF ( lod_gases == 2 ) THEN
7996	!
7997	!-- Index of gaseous compounds
7998	CALL netcdf_data_input_get_dimension_length( id_fchem, ng_file, &
7999	"nspecies" )
8000	IF ( ng_file < 5 ) THEN
8001	message_string = 'Some gaseous emissions missing.'
8002	CALL message( 'salsa_mod: salsa_set_source', 'SA0041', &
8003	1, 2, 0, 6, 0 )
8004	ENDIF
8005	!
8006	!-- Get number of emission categories
8007	CALL netcdf_data_input_get_dimension_length( id_fchem, ncat, "ncat" )
8008	!
8009	!-- Inquire the unit of gaseous fluxes
8010	CALL get_attribute( id_fchem, 'units', unitg, .FALSE., &
8011	"emission_values")
8012	!
8013	!-- Inquire the fill value
8014	CALL get_attribute( id_fchem, '_FillValue', fillval, .FALSE., &
8015	"emission_values" )
8016	!
8017	!-- Read surface emission data (x,y) PE-wise
8018	ALLOCATE( dum_var_4d(ng_file,ncat,nys:nyn,nxl:nxr) )
8019	CALL get_variable( id_fchem, 'emission_values', dum_var_4d, nxl, nxr,&
8020	nys, nyn, 0, ncat-1, 0, ng_file-1 )
8021	DO g = 1, ngast
8022	ALLOCATE( salsa_gas(g)%source(ncat,nys:nyn,nxl:nxr) )
8023	salsa_gas(g)%source = 0.0_wp
8024	salsa_gas(g)%source = salsa_gas(g)%source + dum_var_4d(g,:,:,:)
8025	ENDDO
8026	!
8027	!-- Set surface fluxes of gaseous compounds on horizontal surfaces.
8028	!-- Set fluxes only for either default, land or urban surface.
8029	IF ( .NOT. land_surface .AND. .NOT. urban_surface ) THEN
8030	CALL set_gas_flux( surf_def_h(0), ncat, unitg )
8031	ELSE
8032	CALL set_gas_flux( surf_lsm_h, ncat, unitg )
8033	CALL set_gas_flux( surf_usm_h, ncat, unitg )
8034	ENDIF
8035
8036	DEALLOCATE( dum_var_4d )
8037	DO g = 1, ngast
8038	DEALLOCATE( salsa_gas(g)%source )
8039	ENDDO
8040	ELSE
8041	message_string = 'Input file PIDS_CHEM needs to have lod = 2 when '//&
8042	'SALSA is applied but not the chemistry module!'
8043	CALL message( 'salsa_mod: salsa_set_source', 'SA0039', 1, 2, 0, 6, 0 )
8044	ENDIF
8045	ENDIF
8046	!
8047	!-- Read sources from PIDS_SALSA
8048	INQUIRE( FILE='PIDS_SALSA' // TRIM( coupling_char ), EXIST=netcdf_extend )
8049	IF ( .NOT. netcdf_extend ) THEN
8050	message_string = 'Input file '// TRIM( 'PIDS_SALSA' ) // &
8051	TRIM( coupling_char ) // ' for SALSA missing!'
8052	CALL message( 'salsa_mod: salsa_set_source', 'SA0034', 1, 2, 0, 6, 0 )
8053	ENDIF ! netcdf_extend
8054	!
8055	!-- Open file in read-only mode
8056	CALL open_read_file( 'PIDS_SALSA' // TRIM( coupling_char ), id_faero )
8057	!
8058	!-- Get number of emission categories and their indices
8059	CALL netcdf_data_input_get_dimension_length( id_faero, ncat, "ncat" )
8060	!
8061	!-- Get emission category indices
8062	ALLOCATE( eci(1:ncat) )
8063	CALL get_variable( id_faero, 'emission_category_index', eci )
8064	!
8065	!-- Inquire the level of detail (lod)
8066	CALL get_attribute( id_faero, 'lod', lod_aero, .FALSE., &
8067	"aerosol_emission_values" )
8068
8069	IF ( lod_aero < 3 .AND. ibc_salsa_b == 0 ) THEN
8070	message_string = 'lod1/2 for aerosol emissions requires '// &
8071	'bc_salsa_b = "Neumann"'
8072	CALL message( 'salsa_mod: salsa_set_source','SA0025', 1, 2, 0, 6, 0 )
8073	ENDIF
8074	!
8075	!-- Inquire the fill value
8076	CALL get_attribute( id_faero, '_FillValue', fillval, .FALSE., &
8077	"aerosol_emission_values" )
8078	!
8079	!-- Aerosol chemical composition:
8080	ALLOCATE( emission_mass_fracs(1:ncat,1:maxspec) )
8081	emission_mass_fracs = 0.0_wp
8082	!-- Chemical composition: 1: H2SO4 (sulphuric acid), 2: OC (organic carbon),
8083	!-- 3: BC (black carbon), 4: DU (dust),
8084	!-- 5: SS (sea salt), 6: HNO3 (nitric acid),
8085	!-- 7: NH3 (ammonia)
8086	DO n = 1, ncat
8087	IF ( lod_aero < 2 ) THEN
8088	emission_mass_fracs(n,:) = mass_fraction_table(:,n)
8089	ELSE
8090	CALL get_variable( id_faero, "emission_mass_fracs", &
8091	emission_mass_fracs(n,:) )
8092	ENDIF
8093	!
8094	!-- If the chemical component is not activated, set its mass fraction to 0
8095	!-- to avoid inbalance between number and mass flux
8096	IF ( iso4 < 0 ) emission_mass_fracs(n,1) = 0.0_wp
8097	IF ( ioc < 0 ) emission_mass_fracs(n,2) = 0.0_wp
8098	IF ( ibc < 0 ) emission_mass_fracs(n,3) = 0.0_wp
8099	IF ( idu < 0 ) emission_mass_fracs(n,4) = 0.0_wp
8100	IF ( iss < 0 ) emission_mass_fracs(n,5) = 0.0_wp
8101	IF ( ino < 0 ) emission_mass_fracs(n,6) = 0.0_wp
8102	IF ( inh < 0 ) emission_mass_fracs(n,7) = 0.0_wp
8103	!-- Then normalise the mass fraction so that SUM = 1
8104	emission_mass_fracs(n,:) = emission_mass_fracs(n,:) / &
8105	SUM( emission_mass_fracs(n,:) )
8106	ENDDO
8107
8108	IF ( lod_aero > 1 ) THEN
8109	!
8110	!-- Aerosol geometric mean diameter
8111	CALL netcdf_data_input_get_dimension_length( id_faero, nb_file, 'Dmid' )
8112	IF ( nb_file /= nbins ) THEN
8113	message_string = 'The number of size bins in aerosol input data '// &
8114	'does not correspond to the model set-up'
8115	CALL message( 'salsa_mod: salsa_set_source','SA0040', 1, 2, 0, 6, 0 )
8116	ENDIF
8117	ENDIF
8118
8119	IF ( lod_aero < 3 ) THEN
8120	CALL location_message( ' salsa_set_source: No time dependency for '//&
8121	'aerosol emissions. Use aerosol_emission_values'//&
8122	' directly.', .TRUE. )
8123	!
8124	!-- Allocate source arrays
8125	DO b = 1, nbins
8126	ALLOCATE( aerosol_number(b)%source(1:ncat,nys:nyn,nxl:nxr) )
8127	aerosol_number(b)%source = 0.0_wp
8128	ENDDO
8129	DO c = 1, ncc_tot*nbins
8130	ALLOCATE( aerosol_mass(c)%source(1:ncat,nys:nyn,nxl:nxr) )
8131	aerosol_mass(c)%source = 0.0_wp
8132	ENDDO
8133
8134	IF ( lod_aero == 1 ) THEN
8135	DO n = 1, ncat
8136	avg_density(n) = emission_mass_fracs(n,1) * arhoh2so4 + &
8137	emission_mass_fracs(n,2) * arhooc + &
8138	emission_mass_fracs(n,3) * arhobc + &
8139	emission_mass_fracs(n,4) * arhodu + &
8140	emission_mass_fracs(n,5) * arhoss + &
8141	emission_mass_fracs(n,6) * arhohno3 + &
8142	emission_mass_fracs(n,7) * arhonh3
8143	ENDDO
8144	!
8145	!-- Emission unit
8146	CALL get_attribute( id_faero, 'units', unita, .FALSE., &
8147	"aerosol_emission_values")
8148	conversion_factor = 1.0_wp
8149	IF ( unita == 'kg/m2/yr' ) THEN
8150	conversion_factor = 3.170979e-8_wp / avg_density
8151	ELSEIF ( unita == 'g/m2/yr' ) THEN
8152	conversion_factor = 3.170979e-8_wp * 1.0E-3_wp / avg_density
8153	ELSEIF ( unita == 'kg/m2/s' ) THEN
8154	conversion_factor = 1.0_wp / avg_density
8155	ELSEIF ( unita == 'g/m2/s' ) THEN
8156	conversion_factor = 1.0E-3_wp / avg_density
8157	ELSE
8158	message_string = 'unknown unit for aerosol emissions: ' &
8159	// TRIM( unita ) // ' (lod1)'
8160	CALL message( 'salsa_mod: salsa_set_source','SA0035', &
8161	1, 2, 0, 6, 0 )
8162	ENDIF
8163	!
8164	!-- Read surface emission data (x,y) PE-wise
8165	ALLOCATE( pm_emission(ncat,nys:nyn,nxl:nxr) )
8166	CALL get_variable( id_faero, 'aerosol_emission_values', pm_emission, &
8167	nxl, nxr, nys, nyn, 0, ncat-1 )
8168	DO ni = 1, SIZE( eci )
8169	n = eci(ni)
8170	!
8171	!-- Calculate the number concentration of a log-normal size
8172	!-- distribution following Jacobson (2005): Eq 13.25.
8173	ntot_table = 6.0_wp * PMfrac_table(:,n) / ( pi * dpg_table*3 &
8174	EXP( 4.5_wp * LOG( sigmag_table )*2 ) ) 1.0E+12_wp
8175	!
8176	!-- Sectional size distibution from a log-normal one
8177	CALL size_distribution( ntot_table, dpg_table, sigmag_table, &
8178	nsect_emission )
8179	DO b = 1, nbins
8180	aerosol_number(b)%source(ni,:,:) = &
8181	aerosol_number(b)%source(ni,:,:) + &
8182	pm_emission(ni,:,:) * conversion_factor(n) &
8183	* nsect_emission(b)
8184	ENDDO
8185	ENDDO
8186	ELSEIF ( lod_aero == 2 ) THEN
8187	!
8188	!-- Read surface emission data (x,y) PE-wise
8189	ALLOCATE( dum_var_4d(nb_file,ncat,nys:nyn,nxl:nxr) )
8190	CALL get_variable( id_faero, 'aerosol_emission_values', dum_var_4d, &
8191	nxl, nxr, nys, nyn, 0, ncat-1, 0, nb_file-1 )
8192	DO b = 1, nbins
8193	aerosol_number(b)%source = dum_var_4d(b,:,:,:)
8194	ENDDO
8195	DEALLOCATE( dum_var_4d )
8196	ENDIF
8197	!
8198	!-- Set surface fluxes of aerosol number and mass on horizontal surfaces.
8199	!-- Set fluxes only for either default, land or urban surface.
8200	IF ( .NOT. land_surface .AND. .NOT. urban_surface ) THEN
8201	CALL set_flux( surf_def_h(0), ncat )
8202	ELSE
8203	CALL set_flux( surf_usm_h, ncat )
8204	CALL set_flux( surf_lsm_h, ncat )
8205	ENDIF
8206
8207	ELSEIF ( lod_aero == 3 ) THEN
8208	!
8209	!-- Inquire aerosol emission rate per bin (#/(m3s))
8210	nc_stat = NF90_INQ_VARID( id_faero, "aerosol_emission_values", id_sa )
8211
8212	!
8213	!-- Emission time step
8214	CALL netcdf_data_input_get_dimension_length( id_faero, n_dt, &
8215	'dt_emission' )
8216	IF ( n_dt > 1 ) THEN
8217	CALL location_message( ' salsa_set_source: hourly emission data'//&
8218	' provided but currently the value of the '// &
8219	' first hour is applied.', .TRUE. )
8220	ENDIF
8221	!
8222	!-- Allocate source arrays
8223	DO b = 1, nbins
8224	ALLOCATE( aerosol_number(b)%source(nzb:nzt+1,nys:nyn,nxl:nxr) )
8225	aerosol_number(b)%source = 0.0_wp
8226	ENDDO
8227	DO c = 1, ncc_tot*nbins
8228	ALLOCATE( aerosol_mass(c)%source(nzb:nzt+1,nys:nyn,nxl:nxr) )
8229	aerosol_mass(c)%source = 0.0_wp
8230	ENDDO
8231	!
8232	!-- Get dimension of z-axis:
8233	CALL netcdf_data_input_get_dimension_length( id_faero, nz_file, 'z' )
8234	!
8235	!-- Read surface emission data (x,y) PE-wise
8236	DO i = nxl, nxr
8237	DO j = nys, nyn
8238	DO k = 0, nz_file-1
8239	!
8240	!-- Predetermine flag to mask topography
8241	flag = MERGE( 1.0_wp, 0.0_wp, BTEST(wall_flags_0(k,j,i), 0 ))
8242	!
8243	!-- No sources inside buildings !
8244	IF ( flag == 0.0_wp ) CYCLE
8245	!
8246	!-- Read volume source:
8247	nc_stat = NF90_GET_VAR( id_faero, id_sa, source_ijka, &
8248	start = (/ i+1, j+1, k+1, 1, 1 /), &
8249	count = (/ 1, 1, 1, 1, nb_file /) )
8250	IF ( nc_stat /= NF90_NOERR ) THEN
8251	message_string = 'error in aerosol emissions: lod3'
8252	CALL message( 'salsa_mod: salsa_set_source','SA0038', 1, 2, &
8253	0, 6, 0 )
8254	ENDIF
8255	!
8256	!-- Set mass fluxes. First bins include only SO4 and/or OC. Call
8257	!-- subroutine set_mass_source for larger bins.
8258	!
8259	!-- Sulphate and organic carbon
8260	IF ( iso4 > 0 .AND. ioc > 0 ) THEN
8261	!-- First sulphate:
8262	ss = ( iso4 - 1 ) * nbins + in1a ! start
8263	ee = ( iso4 - 1 ) * nbins + fn1a ! end
8264	b = in1a
8265	DO c = ss, ee
8266	IF ( source_ijka(b) /= fillval ) &
8267	aerosol_mass(c)%source(k,j,i) = &
8268	aerosol_mass(c)%source(k,j,i) + &
8269	emission_mass_fracs(1,1) / ( emission_mass_fracs(1,1) &
8270	+ emission_mass_fracs(1,2) ) * source_ijka(b) * &
8271	aero(b)%core * arhoh2so4
8272	b = b+1
8273	ENDDO
8274	!-- Then organic carbon:
8275	ss = ( ioc - 1 ) * nbins + in1a ! start
8276	ee = ( ioc - 1 ) * nbins + fn1a ! end
8277	b = in1a
8278	DO c = ss, ee
8279	IF ( source_ijka(b) /= fillval ) &
8280	aerosol_mass(c)%source(k,j,i) = &
8281	aerosol_mass(c)%source(k,j,i) + &
8282	emission_mass_fracs(1,2) / ( emission_mass_fracs(1,1) &
8283	+ emission_mass_fracs(1,2) ) * source_ijka(b) * &
8284	aero(b)%core * arhooc
8285	b = b+1
8286	ENDDO
8287
8288	CALL set_mass_source( k, j, i, iso4, &
8289	emission_mass_fracs(1,1), arhoh2so4, &
8290	source_ijka, fillval )
8291	CALL set_mass_source( k, j, i, ioc, emission_mass_fracs(1,2),&
8292	arhooc, source_ijka, fillval )
8293	!-- Only sulphate:
8294	ELSEIF ( iso4 > 0 .AND. ioc < 0 ) THEN
8295	ss = ( iso4 - 1 ) * nbins + in1a ! start
8296	ee = ( iso4 - 1 ) * nbins + fn1a ! end
8297	b = in1a
8298	DO c = ss, ee
8299	IF ( source_ijka(b) /= fillval ) &
8300	aerosol_mass(c)%source(k,j,i) = &
8301	aerosol_mass(c)%source(k,j,i) + source_ijka(b) * &
8302	aero(b)%core * arhoh2so4
8303	b = b+1
8304	ENDDO
8305	CALL set_mass_source( k, j, i, iso4, &
8306	emission_mass_fracs(1,1), arhoh2so4, &
8307	source_ijka, fillval )
8308	!-- Only organic carbon:
8309	ELSEIF ( iso4 < 0 .AND. ioc > 0 ) THEN
8310	ss = ( ioc - 1 ) * nbins + in1a ! start
8311	ee = ( ioc - 1 ) * nbins + fn1a ! end
8312	b = in1a
8313	DO c = ss, ee
8314	IF ( source_ijka(b) /= fillval ) &
8315	aerosol_mass(c)%source(k,j,i) = &
8316	aerosol_mass(c)%source(k,j,i) + source_ijka(b) * &
8317	aero(b)%core * arhooc
8318	b = b+1
8319	ENDDO
8320	CALL set_mass_source( k, j, i, ioc, emission_mass_fracs(1,2),&
8321	arhooc, source_ijka, fillval )
8322	ENDIF
8323	!-- Black carbon
8324	IF ( ibc > 0 ) THEN
8325	CALL set_mass_source( k, j, i, ibc, emission_mass_fracs(1,3),&
8326	arhobc, source_ijka, fillval )
8327	ENDIF
8328	!-- Dust
8329	IF ( idu > 0 ) THEN
8330	CALL set_mass_source( k, j, i, idu, emission_mass_fracs(1,4),&
8331	arhodu, source_ijka, fillval )
8332	ENDIF
8333	!-- Sea salt
8334	IF ( iss > 0 ) THEN
8335	CALL set_mass_source( k, j, i, iss, emission_mass_fracs(1,5),&
8336	arhoss, source_ijka, fillval )
8337	ENDIF
8338	!-- Nitric acid
8339	IF ( ino > 0 ) THEN
8340	CALL set_mass_source( k, j, i, ino, emission_mass_fracs(1,6),&
8341	arhohno3, source_ijka, fillval )
8342	ENDIF
8343	!-- Ammonia
8344	IF ( inh > 0 ) THEN
8345	CALL set_mass_source( k, j, i, inh, emission_mass_fracs(1,7),&
8346	arhonh3, source_ijka, fillval )
8347	ENDIF
8348	!
8349	!-- Save aerosol number sources in the end
8350	DO b = 1, nbins
8351	IF ( source_ijka(b) /= fillval ) &
8352	aerosol_number(b)%source(k,j,i) = &
8353	aerosol_number(b)%source(k,j,i) + source_ijka(b)
8354	ENDDO
8355	ENDDO ! k
8356	ENDDO ! j
8357	ENDDO ! i
8358
8359	ELSE
8360	message_string = 'NetCDF attribute lod is not set properly.'
8361	CALL message( 'salsa_mod: salsa_set_source','SA0026', 1, 2, 0, 6, 0 )
8362	ENDIF
8363
8364	#endif
8365	END SUBROUTINE salsa_set_source
8366
8367	!------------------------------------------------------------------------------!
8368	! Description:
8369	! ------------
8370	!> Sets the gaseous fluxes
8371	!------------------------------------------------------------------------------!
8372	SUBROUTINE set_gas_flux( surface, ncat_emission, unit )
8373
8374	USE arrays_3d, &
8375	ONLY: dzw, hyp, pt, rho_air_zw
8376
8377	USE grid_variables, &
8378	ONLY: dx, dy
8379
8380	USE surface_mod, &
8381	ONLY: surf_type
8382
8383	IMPLICIT NONE
8384
8385	CHARACTER(LEN=*) :: unit !< flux unit in the input file
8386	INTEGER(iwp) :: ncat_emission !< number of emission categories
8387	TYPE(surf_type), INTENT(inout) :: surface !< respective surface type
8388	INTEGER(iwp) :: g !< loop index
8389	INTEGER(iwp) :: i !< loop index
8390	INTEGER(iwp) :: j !< loop index
8391	INTEGER(iwp) :: k !< loop index
8392	INTEGER(iwp) :: m !< running index for surface elements
8393	INTEGER(iwp) :: n !< running index for emission categories
8394	REAL(wp), DIMENSION(ngast) :: conversion_factor
8395
8396	conversion_factor = 1.0_wp
8397
8398	DO m = 1, surface%ns
8399	!
8400	!-- Get indices of respective grid point
8401	i = surface%i(m)
8402	j = surface%j(m)
8403	k = surface%k(m)
8404
8405	IF ( unit == '#/m2/s' ) THEN
8406	conversion_factor = 1.0_wp
8407	ELSEIF ( unit == 'g/m2/s' ) THEN
8408	conversion_factor(1) = avo / ( amh2so4 * 1000.0_wp )
8409	conversion_factor(2) = avo / ( amhno3 * 1000.0_wp )
8410	conversion_factor(3) = avo / ( amnh3 * 1000.0_wp )
8411	conversion_factor(4) = avo / ( amoc * 1000.0_wp )
8412	conversion_factor(5) = avo / ( amoc * 1000.0_wp )
8413	ELSEIF ( unit == 'ppm/m2/s' ) THEN
8414	conversion_factor = for_ppm_to_nconc * hyp(k) / pt(k,j,i) * ( hyp(k) &
8415	/ 100000.0_wp )*0.286_wp dx * dy * dzw(k)
8416	ELSEIF ( unit == 'mumol/m2/s' ) THEN
8417	conversion_factor = 1.0E-6_wp * avo
8418	ELSE
8419	message_string = 'Unknown unit for gaseous emissions!'
8420	CALL message( 'salsa_mod: set_gas_flux', 'SA0031', 1, 2, 0, 6, 0 )
8421	ENDIF
8422
8423	DO n = 1, ncat_emission
8424	DO g = 1, ngast
8425	IF ( salsa_gas(g)%source(n,j,i) < 0.0_wp ) THEN
8426	salsa_gas(g)%source(n,j,i) = 0.0_wp
8427	CYCLE
8428	ENDIF
8429	surface%gtsws(m,g) = surface%gtsws(m,g) + &
8430	salsa_gas(g)%source(n,j,i) * rho_air_zw(k-1) &
8431	* conversion_factor(g)
8432	ENDDO
8433	ENDDO
8434	ENDDO
8435
8436	END SUBROUTINE set_gas_flux
8437
8438
8439	!------------------------------------------------------------------------------!
8440	! Description:
8441	! ------------
8442	!> Sets the aerosol flux to aerosol arrays in 2a and 2b.
8443	!------------------------------------------------------------------------------!
8444	SUBROUTINE set_flux( surface, ncat_emission )
8445
8446	USE arrays_3d, &
8447	ONLY: hyp, pt, rho_air_zw
8448
8449	USE surface_mod, &
8450	ONLY: surf_type
8451
8452	IMPLICIT NONE
8453
8454	INTEGER(iwp) :: ncat_emission !< number of emission categories
8455	TYPE(surf_type), INTENT(inout) :: surface !< respective surface type
8456	INTEGER(iwp) :: b !< loop index
8457	INTEGER(iwp) :: ee !< loop index
8458	INTEGER(iwp) :: g !< loop index
8459	INTEGER(iwp) :: i !< loop index
8460	INTEGER(iwp) :: j !< loop index
8461	INTEGER(iwp) :: k !< loop index
8462	INTEGER(iwp) :: m !< running index for surface elements
8463	INTEGER(iwp) :: n !< loop index for emission categories
8464	INTEGER(iwp) :: c !< loop index
8465	INTEGER(iwp) :: ss !< loop index
8466
8467	DO m = 1, surface%ns
8468	!
8469	!-- Get indices of respective grid point
8470	i = surface%i(m)
8471	j = surface%j(m)
8472	k = surface%k(m)
8473
8474	DO n = 1, ncat_emission
8475	DO b = 1, nbins
8476	IF ( aerosol_number(b)%source(n,j,i) < 0.0_wp ) THEN
8477	aerosol_number(b)%source(n,j,i) = 0.0_wp
8478	CYCLE
8479	ENDIF
8480	!
8481	!-- Set mass fluxes. First bins include only SO4 and/or OC.
8482
8483	IF ( b <= fn1a ) THEN
8484	!
8485	!-- Both sulphate and organic carbon
8486	IF ( iso4 > 0 .AND. ioc > 0 ) THEN
8487
8488	c = ( iso4 - 1 ) * nbins + b
8489	surface%amsws(m,c) = surface%amsws(m,c) + &
8490	emission_mass_fracs(n,1) / &
8491	( emission_mass_fracs(n,1) + &
8492	emission_mass_fracs(n,2) ) * &
8493	aerosol_number(b)%source(n,j,i) * &
8494	api6 * aero(b)%dmid*3.0_wp &
8495	arhoh2so4 * rho_air_zw(k-1)
8496	aerosol_mass(c)%source(n,j,i) = &
8497	aerosol_mass(c)%source(n,j,i) + surface%amsws(m,c)
8498	c = ( ioc - 1 ) * nbins + b
8499	surface%amsws(m,c) = surface%amsws(m,c) + &
8500	emission_mass_fracs(n,2) / &
8501	( emission_mass_fracs(n,1) + &
8502	emission_mass_fracs(n,2) ) * &
8503	aerosol_number(b)%source(n,j,i) * &
8504	api6 * aero(b)%dmid*3.0_wp arhooc &
8505	* rho_air_zw(k-1)
8506	aerosol_mass(c)%source(n,j,i) = &
8507	aerosol_mass(c)%source(n,j,i) + surface%amsws(m,c)
8508	!
8509	!-- Only sulphates
8510	ELSEIF ( iso4 > 0 .AND. ioc < 0 ) THEN
8511	c = ( iso4 - 1 ) * nbins + b
8512	surface%amsws(m,c) = surface%amsws(m,c) + &
8513	aerosol_number(b)%source(n,j,i) * api6 &
8514	* aero(b)%dmid*3.0_wp arhoh2so4 &
8515	* rho_air_zw(k-1)
8516	aerosol_mass(c)%source(n,j,i) = &
8517	aerosol_mass(c)%source(n,j,i) + surface%amsws(m,c)
8518	!
8519	!-- Only organic carbon
8520	ELSEIF ( iso4 < 0 .AND. ioc > 0 ) THEN
8521	c = ( ioc - 1 ) * nbins + b
8522	surface%amsws(m,c) = surface%amsws(m,c) + &
8523	aerosol_number(b)%source(n,j,i) * api6 &
8524	* aero(b)%dmid*3.0_wp arhooc &
8525	* rho_air_zw(k-1)
8526	aerosol_mass(c)%source(n,j,i) = &
8527	aerosol_mass(c)%source(n,j,i) + surface%amsws(m,c)
8528	ENDIF
8529
8530	ELSEIF ( b > fn1a ) THEN
8531	!
8532	!-- Sulphate
8533	IF ( iso4 > 0 ) THEN
8534	CALL set_mass_flux( surface, m, b, iso4, n, &
8535	emission_mass_fracs(n,1), arhoh2so4, &
8536	aerosol_number(b)%source(n,j,i) )
8537	ENDIF
8538	!
8539	!-- Organic carbon
8540	IF ( ioc > 0 ) THEN
8541	CALL set_mass_flux( surface, m, b, ioc, n, &
8542	emission_mass_fracs(n,2), arhooc, &
8543	aerosol_number(b)%source(n,j,i) )
8544	ENDIF
8545	!
8546	!-- Black carbon
8547	IF ( ibc > 0 ) THEN
8548	CALL set_mass_flux( surface, m, b, ibc, n, &
8549	emission_mass_fracs(n,3), arhobc, &
8550	aerosol_number(b)%source(n,j,i) )
8551	ENDIF
8552	!
8553	!-- Dust
8554	IF ( idu > 0 ) THEN
8555	CALL set_mass_flux( surface, m, b, idu, n, &
8556	emission_mass_fracs(n,4), arhodu, &
8557	aerosol_number(b)%source(n,j,i) )
8558	ENDIF
8559	!
8560	!-- Sea salt
8561	IF ( iss > 0 ) THEN
8562	CALL set_mass_flux( surface, m, b, iss, n, &
8563	emission_mass_fracs(n,5), arhoss, &
8564	aerosol_number(b)%source(n,j,i) )
8565	ENDIF
8566	!
8567	!-- Nitric acid
8568	IF ( ino > 0 ) THEN
8569	CALL set_mass_flux( surface, m, b, ino, n, &
8570	emission_mass_fracs(n,6), arhohno3, &
8571	aerosol_number(b)%source(n,j,i) )
8572	ENDIF
8573	!
8574	!-- Ammonia
8575	IF ( inh > 0 ) THEN
8576	CALL set_mass_flux( surface, m, b, inh, n, &
8577	emission_mass_fracs(n,7), arhonh3, &
8578	aerosol_number(b)%source(n,j,i) )
8579	ENDIF
8580
8581	ENDIF
8582	!
8583	!-- Save number fluxes in the end
8584	surface%answs(m,b) = surface%answs(m,b) + &
8585	aerosol_number(b)%source(n,j,i) * rho_air_zw(k-1)
8586	aerosol_number(b)%source(n,j,i) = surface%answs(m,b)
8587	ENDDO
8588
8589	ENDDO
8590
8591	ENDDO
8592
8593	END SUBROUTINE set_flux
8594
8595	!------------------------------------------------------------------------------!
8596	! Description:
8597	! ------------
8598	!> Sets the mass emissions to aerosol arrays in 2a and 2b.
8599	!------------------------------------------------------------------------------!
8600	SUBROUTINE set_mass_flux( surface, surf_num, b, ispec, n, mass_frac, prho, &
8601	nsource )
8602
8603	USE arrays_3d, &
8604	ONLY: rho_air_zw
8605
8606	USE surface_mod, &
8607	ONLY: surf_type
8608
8609	IMPLICIT NONE
8610
8611	INTEGER(iwp), INTENT(in) :: b !< Aerosol size bin index
8612	INTEGER(iwp), INTENT(in) :: ispec !< Aerosol species index
8613	INTEGER(iwp), INTENT(in) :: n !< emission category number
8614	INTEGER(iwp), INTENT(in) :: surf_num !< index surface elements
8615	REAL(wp), INTENT(in) :: mass_frac !< mass fraction of a chemical
8616	!< compound in all bins
8617	REAL(wp), INTENT(in) :: nsource !< number source (#/m2/s)
8618	REAL(wp), INTENT(in) :: prho !< Aerosol density
8619	TYPE(surf_type), INTENT(inout) :: surface !< respective surface type
8620
8621	INTEGER(iwp) :: ee !< index: end
8622	INTEGER(iwp) :: i !< loop index
8623	INTEGER(iwp) :: j !< loop index
8624	INTEGER(iwp) :: k !< loop index
8625	INTEGER(iwp) :: c !< loop index
8626	INTEGER(iwp) :: ss !<index: start
8627
8628	!
8629	!-- Get indices of respective grid point
8630	i = surface%i(surf_num)
8631	j = surface%j(surf_num)
8632	k = surface%k(surf_num)
8633	!
8634	!-- Subrange 2a:
8635	c = ( ispec - 1 ) * nbins + b
8636	surface%amsws(surf_num,c) = surface%amsws(surf_num,c) + mass_frac * nsource&
8637	* aero(b)%core * prho * rho_air_zw(k-1)
8638	aerosol_mass(c)%source(n,j,i) = aerosol_mass(c)%source(n,j,i) + &
8639	surface%amsws(surf_num,c)
8640	!
8641	!-- Subrange 2b:
8642	IF ( .NOT. no_insoluble ) THEN
8643	WRITE(,) 'All emissions are soluble!'
8644	ENDIF
8645
8646	END SUBROUTINE set_mass_flux
8647
8648	!------------------------------------------------------------------------------!
8649	! Description:
8650	! ------------
8651	!> Sets the mass sources to aerosol arrays in 2a and 2b.
8652	!------------------------------------------------------------------------------!
8653	SUBROUTINE set_mass_source( k, j, i, ispec, mass_frac, prho, nsource, fillval )
8654
8655	USE surface_mod, &
8656	ONLY: surf_type
8657
8658	IMPLICIT NONE
8659
8660	INTEGER(iwp), INTENT(in) :: ispec !< Aerosol species index
8661	REAL(wp), INTENT(in) :: fillval !< _FillValue in the NetCDF file
8662	REAL(wp), INTENT(in) :: mass_frac !< mass fraction of a chemical
8663	!< compound in all bins
8664	REAL(wp), INTENT(in), DIMENSION(:) :: nsource !< number source
8665	REAL(wp), INTENT(in) :: prho !< Aerosol density
8666
8667	INTEGER(iwp) :: b !< loop index
8668	INTEGER(iwp) :: ee !< index: end
8669	INTEGER(iwp) :: i !< loop index
8670	INTEGER(iwp) :: j !< loop index
8671	INTEGER(iwp) :: k !< loop index
8672	INTEGER(iwp) :: c !< loop index
8673	INTEGER(iwp) :: ss !<index: start
8674	!
8675	!-- Subrange 2a:
8676	ss = ( ispec - 1 ) * nbins + in2a
8677	ee = ( ispec - 1 ) * nbins + fn2a
8678	b = in2a
8679	DO c = ss, ee
8680	IF ( nsource(b) /= fillval ) THEN
8681	aerosol_mass(c)%source(k,j,i) = aerosol_mass(c)%source(k,j,i) + &
8682	mass_frac * nsource(b) * aero(b)%core * &
8683	prho
8684	ENDIF
8685	b = b+1
8686	ENDDO
8687	!
8688	!-- Subrange 2b:
8689	IF ( .NOT. no_insoluble ) THEN
8690	WRITE(,) 'All sources are soluble!'
8691	ENDIF
8692
8693	END SUBROUTINE set_mass_source
8694
8695	!------------------------------------------------------------------------------!
8696	! Description:
8697	! ------------
8698	!> Check data output for salsa.
8699	!------------------------------------------------------------------------------!
8700	SUBROUTINE salsa_check_data_output( var, unit )
8701
8702	USE control_parameters, &
8703	ONLY: message_string
8704
8705	IMPLICIT NONE
8706
8707	CHARACTER (LEN=*) :: unit !<
8708	CHARACTER (LEN=*) :: var !<
8709
8710	SELECT CASE ( TRIM( var ) )
8711
8712	CASE ( 'g_H2SO4', 'g_HNO3', 'g_NH3', 'g_OCNV', 'g_OCSV', &
8713	'N_bin1', 'N_bin2', 'N_bin3', 'N_bin4', 'N_bin5', 'N_bin6', &
8714	'N_bin7', 'N_bin8', 'N_bin9', 'N_bin10', 'N_bin11', 'N_bin12', &
8715	'Ntot' )
8716	IF ( .NOT. salsa ) THEN
8717	message_string = 'output of "' // TRIM( var ) // '" requi' // &
8718	'res salsa = .TRUE.'
8719	CALL message( 'check_parameters', 'SA0006', 1, 2, 0, 6, 0 )
8720	ENDIF
8721	unit = '#/m3'
8722
8723	CASE ( 'LDSA' )
8724	IF ( .NOT. salsa ) THEN
8725	message_string = 'output of "' // TRIM( var ) // '" requi' // &
8726	'res salsa = .TRUE.'
8727	CALL message( 'check_parameters', 'SA0003', 1, 2, 0, 6, 0 )
8728	ENDIF
8729	unit = 'mum2/cm3'
8730
8731	CASE ( 'm_bin1', 'm_bin2', 'm_bin3', 'm_bin4', 'm_bin5', 'm_bin6', &
8732	'm_bin7', 'm_bin8', 'm_bin9', 'm_bin10', 'm_bin11', 'm_bin12', &
8733	'PM2.5', 'PM10', 's_BC', 's_DU', 's_H2O', 's_NH', &
8734	's_NO', 's_OC', 's_SO4', 's_SS' )
8735	IF ( .NOT. salsa ) THEN
8736	message_string = 'output of "' // TRIM( var ) // '" requi' // &
8737	'res salsa = .TRUE.'
8738	CALL message( 'check_parameters', 'SA0001', 1, 2, 0, 6, 0 )
8739	ENDIF
8740	unit = 'kg/m3'
8741
8742	CASE DEFAULT
8743	unit = 'illegal'
8744
8745	END SELECT
8746
8747	END SUBROUTINE salsa_check_data_output
8748
8749	!------------------------------------------------------------------------------!
8750	!
8751	! Description:
8752	! ------------
8753	!> Subroutine for averaging 3D data
8754	!------------------------------------------------------------------------------!
8755	SUBROUTINE salsa_3d_data_averaging( mode, variable )
8756
8757
8758	USE control_parameters
8759
8760	USE indices
8761
8762	USE kinds
8763
8764	IMPLICIT NONE
8765
8766	CHARACTER (LEN=*) :: mode !<
8767	CHARACTER (LEN=*) :: variable !<
8768
8769	INTEGER(iwp) :: b !<
8770	INTEGER(iwp) :: c !<
8771	INTEGER(iwp) :: i !<
8772	INTEGER(iwp) :: icc !<
8773	INTEGER(iwp) :: j !<
8774	INTEGER(iwp) :: k !<
8775
8776	REAL(wp) :: df !< For calculating LDSA: fraction of particles
8777	!< depositing in the alveolar (or tracheobronchial)
8778	!< region of the lung. Depends on the particle size
8779	REAL(wp) :: mean_d !< Particle diameter in micrometres
8780	REAL(wp) :: nc !< Particle number concentration in units 1/cm**3
8781	REAL(wp) :: temp_bin !<
8782	REAL(wp), DIMENSION(:,:,:), POINTER :: to_be_resorted !< points to
8783	!< selected output variable
8784
8785	temp_bin = 0.0_wp
8786
8787	IF ( mode == 'allocate' ) THEN
8788
8789	SELECT CASE ( TRIM( variable ) )
8790
8791	CASE ( 'g_H2SO4' )
8792	IF ( .NOT. ALLOCATED( g_H2SO4_av ) ) THEN
8793	ALLOCATE( g_H2SO4_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
8794	ENDIF
8795	g_H2SO4_av = 0.0_wp
8796
8797	CASE ( 'g_HNO3' )
8798	IF ( .NOT. ALLOCATED( g_HNO3_av ) ) THEN
8799	ALLOCATE( g_HNO3_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
8800	ENDIF
8801	g_HNO3_av = 0.0_wp
8802
8803	CASE ( 'g_NH3' )
8804	IF ( .NOT. ALLOCATED( g_NH3_av ) ) THEN
8805	ALLOCATE( g_NH3_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
8806	ENDIF
8807	g_NH3_av = 0.0_wp
8808
8809	CASE ( 'g_OCNV' )
8810	IF ( .NOT. ALLOCATED( g_OCNV_av ) ) THEN
8811	ALLOCATE( g_OCNV_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
8812	ENDIF
8813	g_OCNV_av = 0.0_wp
8814
8815	CASE ( 'g_OCSV' )
8816	IF ( .NOT. ALLOCATED( g_OCSV_av ) ) THEN
8817	ALLOCATE( g_OCSV_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
8818	ENDIF
8819	g_OCSV_av = 0.0_wp
8820
8821	CASE ( 'LDSA' )
8822	IF ( .NOT. ALLOCATED( LDSA_av ) ) THEN
8823	ALLOCATE( LDSA_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
8824	ENDIF
8825	LDSA_av = 0.0_wp
8826
8827	CASE ( 'N_bin1', 'N_bin2', 'N_bin3', 'N_bin4', 'N_bin5', 'N_bin6', &
8828	'N_bin7', 'N_bin8', 'N_bin9', 'N_bin10', 'N_bin11', 'N_bin12' )
8829	IF ( .NOT. ALLOCATED( Nbins_av ) ) THEN
8830	ALLOCATE( Nbins_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg,nbins) )
8831	ENDIF
8832	Nbins_av = 0.0_wp
8833
8834	CASE ( 'Ntot' )
8835	IF ( .NOT. ALLOCATED( Ntot_av ) ) THEN
8836	ALLOCATE( Ntot_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
8837	ENDIF
8838	Ntot_av = 0.0_wp
8839
8840	CASE ( 'm_bin1', 'm_bin2', 'm_bin3', 'm_bin4', 'm_bin5', 'm_bin6', &
8841	'm_bin7', 'm_bin8', 'm_bin9', 'm_bin10', 'm_bin11', 'm_bin12' )
8842	IF ( .NOT. ALLOCATED( mbins_av ) ) THEN
8843	ALLOCATE( mbins_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg,nbins) )
8844	ENDIF
8845	mbins_av = 0.0_wp
8846
8847	CASE ( 'PM2.5' )
8848	IF ( .NOT. ALLOCATED( PM25_av ) ) THEN
8849	ALLOCATE( PM25_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
8850	ENDIF
8851	PM25_av = 0.0_wp
8852
8853	CASE ( 'PM10' )
8854	IF ( .NOT. ALLOCATED( PM10_av ) ) THEN
8855	ALLOCATE( PM10_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
8856	ENDIF
8857	PM10_av = 0.0_wp
8858
8859	CASE ( 's_BC' )
8860	IF ( .NOT. ALLOCATED( s_BC_av ) ) THEN
8861	ALLOCATE( s_BC_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
8862	ENDIF
8863	s_BC_av = 0.0_wp
8864
8865	CASE ( 's_DU' )
8866	IF ( .NOT. ALLOCATED( s_DU_av ) ) THEN
8867	ALLOCATE( s_DU_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
8868	ENDIF
8869	s_DU_av = 0.0_wp
8870
8871	CASE ( 's_H2O' )
8872	IF ( .NOT. ALLOCATED( s_H2O_av ) ) THEN
8873	ALLOCATE( s_H2O_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
8874	ENDIF
8875	s_H2O_av = 0.0_wp
8876
8877	CASE ( 's_NH' )
8878	IF ( .NOT. ALLOCATED( s_NH_av ) ) THEN
8879	ALLOCATE( s_NH_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
8880	ENDIF
8881	s_NH_av = 0.0_wp
8882
8883	CASE ( 's_NO' )
8884	IF ( .NOT. ALLOCATED( s_NO_av ) ) THEN
8885	ALLOCATE( s_NO_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
8886	ENDIF
8887	s_NO_av = 0.0_wp
8888
8889	CASE ( 's_OC' )
8890	IF ( .NOT. ALLOCATED( s_OC_av ) ) THEN
8891	ALLOCATE( s_OC_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
8892	ENDIF
8893	s_OC_av = 0.0_wp
8894
8895	CASE ( 's_SO4' )
8896	IF ( .NOT. ALLOCATED( s_SO4_av ) ) THEN
8897	ALLOCATE( s_SO4_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
8898	ENDIF
8899	s_SO4_av = 0.0_wp
8900
8901	CASE ( 's_SS' )
8902	IF ( .NOT. ALLOCATED( s_SS_av ) ) THEN
8903	ALLOCATE( s_SS_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
8904	ENDIF
8905	s_SS_av = 0.0_wp
8906
8907	CASE DEFAULT
8908	CONTINUE
8909
8910	END SELECT
8911
8912	ELSEIF ( mode == 'sum' ) THEN
8913
8914	SELECT CASE ( TRIM( variable ) )
8915
8916	CASE ( 'g_H2SO4', 'g_HNO3', 'g_NH3', 'g_OCNV', 'g_OCSV' )
8917	IF ( TRIM( variable(3:) ) == 'H2SO4' ) THEN
8918	icc = 1
8919	to_be_resorted => g_H2SO4_av
8920	ELSEIF ( TRIM( variable(3:) ) == 'HNO3' ) THEN
8921	icc = 2
8922	to_be_resorted => g_HNO3_av
8923	ELSEIF ( TRIM( variable(3:) ) == 'NH3' ) THEN
8924	icc = 3
8925	to_be_resorted => g_NH3_av
8926	ELSEIF ( TRIM( variable(3:) ) == 'OCNV' ) THEN
8927	icc = 4
8928	to_be_resorted => g_OCNV_av
8929	ELSEIF ( TRIM( variable(3:) ) == 'OCSV' ) THEN
8930	icc = 5
8931	to_be_resorted => g_OCSV_av
8932	ENDIF
8933	DO i = nxlg, nxrg
8934	DO j = nysg, nyng
8935	DO k = nzb, nzt+1
8936	to_be_resorted(k,j,i) = to_be_resorted(k,j,i) + &
8937	salsa_gas(icc)%conc(k,j,i)
8938	ENDDO
8939	ENDDO
8940	ENDDO
8941
8942	CASE ( 'LDSA' )
8943	DO i = nxlg, nxrg
8944	DO j = nysg, nyng
8945	DO k = nzb, nzt+1
8946	temp_bin = 0.0_wp
8947	DO b = 1, nbins
8948	!
8949	!-- Diameter in micrometres
8950	mean_d = 1.0E+6_wp * Ra_dry(k,j,i,b) * 2.0_wp
8951	!
8952	!-- Deposition factor: alveolar (use Ra_dry)
8953	df = ( 0.01555_wp / mean_d ) * ( EXP( -0.416_wp * &
8954	( LOG( mean_d ) + 2.84_wp )**2.0_wp ) &
8955	+ 19.11_wp * EXP( -0.482_wp * &
8956	( LOG( mean_d ) - 1.362_wp )**2.0_wp ) )
8957	!
8958	!-- Number concentration in 1/cm3
8959	nc = 1.0E-6_wp * aerosol_number(b)%conc(k,j,i)
8960	!
8961	!-- Lung-deposited surface area LDSA (units mum2/cm3)
8962	temp_bin = temp_bin + pi * mean_d*2.0_wp df * nc
8963	ENDDO
8964	LDSA_av(k,j,i) = LDSA_av(k,j,i) + temp_bin
8965	ENDDO
8966	ENDDO
8967	ENDDO
8968
8969	CASE ( 'N_bin1', 'N_bin2', 'N_bin3', 'N_bin4', 'N_bin5', 'N_bin6', &
8970	'N_bin7', 'N_bin8', 'N_bin9', 'N_bin10', 'N_bin11', 'N_bin12' )
8971	DO i = nxlg, nxrg
8972	DO j = nysg, nyng
8973	DO k = nzb, nzt+1
8974	DO b = 1, nbins
8975	Nbins_av(k,j,i,b) = Nbins_av(k,j,i,b) + &
8976	aerosol_number(b)%conc(k,j,i)
8977	ENDDO
8978	ENDDO
8979	ENDDO
8980	ENDDO
8981
8982	CASE ( 'Ntot' )
8983	DO i = nxlg, nxrg
8984	DO j = nysg, nyng
8985	DO k = nzb, nzt+1
8986	DO b = 1, nbins
8987	Ntot_av(k,j,i) = Ntot_av(k,j,i) + &
8988	aerosol_number(b)%conc(k,j,i)
8989	ENDDO
8990	ENDDO
8991	ENDDO
8992	ENDDO
8993
8994	CASE ( 'm_bin1', 'm_bin2', 'm_bin3', 'm_bin4', 'm_bin5', 'm_bin6', &
8995	'm_bin7', 'm_bin8', 'm_bin9', 'm_bin10', 'm_bin11', 'm_bin12' )
8996	DO i = nxlg, nxrg
8997	DO j = nysg, nyng
8998	DO k = nzb, nzt+1
8999	DO b = 1, nbins
9000	DO c = b, nbins*ncc_tot, nbins
9001	mbins_av(k,j,i,b) = mbins_av(k,j,i,b) + &
9002	aerosol_mass(c)%conc(k,j,i)
9003	ENDDO
9004	ENDDO
9005	ENDDO
9006	ENDDO
9007	ENDDO
9008
9009	CASE ( 'PM2.5' )
9010	DO i = nxlg, nxrg
9011	DO j = nysg, nyng
9012	DO k = nzb, nzt+1
9013	temp_bin = 0.0_wp
9014	DO b = 1, nbins
9015	IF ( 2.0_wp * Ra_dry(k,j,i,b) <= 2.5E-6_wp ) THEN
9016	DO c = b, nbins*ncc, nbins
9017	temp_bin = temp_bin + aerosol_mass(c)%conc(k,j,i)
9018	ENDDO
9019	ENDIF
9020	ENDDO
9021	PM25_av(k,j,i) = PM25_av(k,j,i) + temp_bin
9022	ENDDO
9023	ENDDO
9024	ENDDO
9025
9026	CASE ( 'PM10' )
9027	DO i = nxlg, nxrg
9028	DO j = nysg, nyng
9029	DO k = nzb, nzt+1
9030	temp_bin = 0.0_wp
9031	DO b = 1, nbins
9032	IF ( 2.0_wp * Ra_dry(k,j,i,b) <= 10.0E-6_wp ) THEN
9033	DO c = b, nbins*ncc, nbins
9034	temp_bin = temp_bin + aerosol_mass(c)%conc(k,j,i)
9035	ENDDO
9036	ENDIF
9037	ENDDO
9038	PM10_av(k,j,i) = PM10_av(k,j,i) + temp_bin
9039	ENDDO
9040	ENDDO
9041	ENDDO
9042
9043	CASE ( 's_BC', 's_DU', 's_H2O', 's_NH', 's_NO', 's_OC', 's_SO4', &
9044	's_SS' )
9045	IF ( is_used( prtcl, TRIM( variable(3:) ) ) ) THEN
9046	icc = get_index( prtcl, TRIM( variable(3:) ) )
9047	IF ( TRIM( variable(3:) ) == 'BC' ) to_be_resorted => s_BC_av
9048	IF ( TRIM( variable(3:) ) == 'DU' ) to_be_resorted => s_DU_av
9049	IF ( TRIM( variable(3:) ) == 'NH' ) to_be_resorted => s_NH_av
9050	IF ( TRIM( variable(3:) ) == 'NO' ) to_be_resorted => s_NO_av
9051	IF ( TRIM( variable(3:) ) == 'OC' ) to_be_resorted => s_OC_av
9052	IF ( TRIM( variable(3:) ) == 'SO4' ) to_be_resorted => s_SO4_av
9053	IF ( TRIM( variable(3:) ) == 'SS' ) to_be_resorted => s_SS_av
9054	DO i = nxlg, nxrg
9055	DO j = nysg, nyng
9056	DO k = nzb, nzt+1
9057	DO c = ( icc-1 )nbins+1, iccnbins
9058	to_be_resorted(k,j,i) = to_be_resorted(k,j,i) + &
9059	aerosol_mass(c)%conc(k,j,i)
9060	ENDDO
9061	ENDDO
9062	ENDDO
9063	ENDDO
9064	ENDIF
9065
9066	CASE DEFAULT
9067	CONTINUE
9068
9069	END SELECT
9070
9071	ELSEIF ( mode == 'average' ) THEN
9072
9073	SELECT CASE ( TRIM( variable ) )
9074
9075	CASE ( 'g_H2SO4', 'g_HNO3', 'g_NH3', 'g_OCNV', 'g_OCSV' )
9076	IF ( TRIM( variable(3:) ) == 'H2SO4' ) THEN
9077	icc = 1
9078	to_be_resorted => g_H2SO4_av
9079	ELSEIF ( TRIM( variable(3:) ) == 'HNO3' ) THEN
9080	icc = 2
9081	to_be_resorted => g_HNO3_av
9082	ELSEIF ( TRIM( variable(3:) ) == 'NH3' ) THEN
9083	icc = 3
9084	to_be_resorted => g_NH3_av
9085	ELSEIF ( TRIM( variable(3:) ) == 'OCNV' ) THEN
9086	icc = 4
9087	to_be_resorted => g_OCNV_av
9088	ELSEIF ( TRIM( variable(3:) ) == 'OCSV' ) THEN
9089	icc = 5
9090	to_be_resorted => g_OCSV_av
9091	ENDIF
9092	DO i = nxlg, nxrg
9093	DO j = nysg, nyng
9094	DO k = nzb, nzt+1
9095	to_be_resorted(k,j,i) = to_be_resorted(k,j,i) &
9096	/ REAL( average_count_3d, KIND=wp )
9097	ENDDO
9098	ENDDO
9099	ENDDO
9100
9101	CASE ( 'LDSA' )
9102	DO i = nxlg, nxrg
9103	DO j = nysg, nyng
9104	DO k = nzb, nzt+1
9105	LDSA_av(k,j,i) = LDSA_av(k,j,i) &
9106	/ REAL( average_count_3d, KIND=wp )
9107	ENDDO
9108	ENDDO
9109	ENDDO
9110
9111	CASE ( 'N_bin1', 'N_bin2', 'N_bin3', 'N_bin4', 'N_bin5', 'N_bin6', &
9112	'N_bin7', 'N_bin8', 'N_bin9', 'N_bin10', 'N_bin11', 'N_bin12' )
9113	DO i = nxlg, nxrg
9114	DO j = nysg, nyng
9115	DO k = nzb, nzt+1
9116	DO b = 1, nbins
9117	Nbins_av(k,j,i,b) = Nbins_av(k,j,i,b) &
9118	/ REAL( average_count_3d, KIND=wp )
9119	ENDDO
9120	ENDDO
9121	ENDDO
9122	ENDDO
9123
9124	CASE ( 'Ntot' )
9125	DO i = nxlg, nxrg
9126	DO j = nysg, nyng
9127	DO k = nzb, nzt+1
9128	Ntot_av(k,j,i) = Ntot_av(k,j,i) &
9129	/ REAL( average_count_3d, KIND=wp )
9130	ENDDO
9131	ENDDO
9132	ENDDO
9133
9134	CASE ( 'm_bin1', 'm_bin2', 'm_bin3', 'm_bin4', 'm_bin5', 'm_bin6', &
9135	'm_bin7', 'm_bin8', 'm_bin9', 'm_bin10', 'm_bin11', 'm_bin12' )
9136	DO i = nxlg, nxrg
9137	DO j = nysg, nyng
9138	DO k = nzb, nzt+1
9139	DO b = 1, nbins
9140	DO c = b, nbins*ncc, nbins
9141	mbins_av(k,j,i,b) = mbins_av(k,j,i,b) &
9142	/ REAL( average_count_3d, KIND=wp )
9143	ENDDO
9144	ENDDO
9145	ENDDO
9146	ENDDO
9147	ENDDO
9148
9149	CASE ( 'PM2.5' )
9150	DO i = nxlg, nxrg
9151	DO j = nysg, nyng
9152	DO k = nzb, nzt+1
9153	PM25_av(k,j,i) = PM25_av(k,j,i) / &
9154	REAL( average_count_3d, KIND=wp )
9155	ENDDO
9156	ENDDO
9157	ENDDO
9158
9159	CASE ( 'PM10' )
9160	DO i = nxlg, nxrg
9161	DO j = nysg, nyng
9162	DO k = nzb, nzt+1
9163	PM10_av(k,j,i) = PM10_av(k,j,i) / &
9164	REAL( average_count_3d, KIND=wp )
9165	ENDDO
9166	ENDDO
9167	ENDDO
9168
9169	CASE ( 's_BC', 's_DU', 's_H2O', 's_NH', 's_NO', 's_OC', 's_SO4', &
9170	's_SS' )
9171	IF ( is_used( prtcl, TRIM( variable(3:) ) ) ) THEN
9172	icc = get_index( prtcl, TRIM( variable(3:) ) )
9173	IF ( TRIM( variable(3:) ) == 'BC' ) to_be_resorted => s_BC_av
9174	IF ( TRIM( variable(3:) ) == 'DU' ) to_be_resorted => s_DU_av
9175	IF ( TRIM( variable(3:) ) == 'NH' ) to_be_resorted => s_NH_av
9176	IF ( TRIM( variable(3:) ) == 'NO' ) to_be_resorted => s_NO_av
9177	IF ( TRIM( variable(3:) ) == 'OC' ) to_be_resorted => s_OC_av
9178	IF ( TRIM( variable(3:) ) == 'SO4' ) to_be_resorted => s_SO4_av
9179	IF ( TRIM( variable(3:) ) == 'SS' ) to_be_resorted => s_SS_av
9180	DO i = nxlg, nxrg
9181	DO j = nysg, nyng
9182	DO k = nzb, nzt+1
9183	to_be_resorted(k,j,i) = to_be_resorted(k,j,i) / &
9184	REAL( average_count_3d, KIND=wp )
9185	ENDDO
9186	ENDDO
9187	ENDDO
9188	ENDIF
9189
9190	END SELECT
9191
9192	ENDIF
9193
9194	END SUBROUTINE salsa_3d_data_averaging
9195
9196
9197	!------------------------------------------------------------------------------!
9198	!
9199	! Description:
9200	! ------------
9201	!> Subroutine defining 2D output variables
9202	!------------------------------------------------------------------------------!
9203	SUBROUTINE salsa_data_output_2d( av, variable, found, grid, mode, local_pf, &
9204	two_d, nzb_do, nzt_do )
9205
9206	USE indices
9207
9208	USE kinds
9209
9210
9211	IMPLICIT NONE
9212
9213	CHARACTER (LEN=*) :: grid !<
9214	CHARACTER (LEN=*) :: mode !<
9215	CHARACTER (LEN=*) :: variable !<
9216	CHARACTER (LEN=5) :: vari !< trimmed format of variable
9217
9218	INTEGER(iwp) :: av !<
9219	INTEGER(iwp) :: b !< running index: size bins
9220	INTEGER(iwp) :: c !< running index: mass bins
9221	INTEGER(iwp) :: i !<
9222	INTEGER(iwp) :: icc !< index of a chemical compound
9223	INTEGER(iwp) :: j !<
9224	INTEGER(iwp) :: k !<
9225	INTEGER(iwp) :: nzb_do !<
9226	INTEGER(iwp) :: nzt_do !<
9227
9228	LOGICAL :: found !<
9229	LOGICAL :: two_d !< flag parameter that indicates 2D variables
9230	!< (horizontal cross sections)
9231
9232	REAL(wp) :: df !< For calculating LDSA: fraction of particles
9233	!< depositing in the alveolar (or tracheobronchial)
9234	!< region of the lung. Depends on the particle size
9235	REAL(wp) :: fill_value = -9999.0_wp !< value for the _FillValue attribute
9236	REAL(wp) :: mean_d !< Particle diameter in micrometres
9237	REAL(wp) :: nc !< Particle number concentration in units 1/cm**3
9238	REAL(wp) :: temp_bin !< temporary array for calculating output variables
9239
9240	REAL(wp), DIMENSION(nxl:nxr,nys:nyn,nzb_do:nzt_do) :: local_pf !< output
9241
9242	REAL(wp), DIMENSION(:,:,:), POINTER :: to_be_resorted !< pointer
9243
9244
9245	found = .TRUE.
9246	temp_bin = 0.0_wp
9247
9248	IF ( TRIM( variable(1:2) ) == 'g_' ) THEN
9249	vari = TRIM( variable( 3:LEN( TRIM( variable ) ) - 3 ) )
9250	IF ( av == 0 ) THEN
9251	IF ( vari == 'H2SO4') icc = 1
9252	IF ( vari == 'HNO3') icc = 2
9253	IF ( vari == 'NH3') icc = 3
9254	IF ( vari == 'OCNV') icc = 4
9255	IF ( vari == 'OCSV') icc = 5
9256	DO i = nxl, nxr
9257	DO j = nys, nyn
9258	DO k = nzb_do, nzt_do
9259	local_pf(i,j,k) = MERGE( salsa_gas(icc)%conc(k,j,i), &
9260	REAL( fill_value, KIND = wp ), &
9261	BTEST( wall_flags_0(k,j,i), 0 ) )
9262	ENDDO
9263	ENDDO
9264	ENDDO
9265	ELSE
9266	IF ( vari == 'H2SO4' ) to_be_resorted => g_H2SO4_av
9267	IF ( vari == 'HNO3' ) to_be_resorted => g_HNO3_av
9268	IF ( vari == 'NH3' ) to_be_resorted => g_NH3_av
9269	IF ( vari == 'OCNV' ) to_be_resorted => g_OCNV_av
9270	IF ( vari == 'OCSV' ) to_be_resorted => g_OCSV_av
9271	DO i = nxl, nxr
9272	DO j = nys, nyn
9273	DO k = nzb_do, nzt_do
9274	local_pf(i,j,k) = MERGE( to_be_resorted(k,j,i), &
9275	REAL( fill_value, KIND = wp ), &
9276	BTEST( wall_flags_0(k,j,i), 0 ) )
9277	ENDDO
9278	ENDDO
9279	ENDDO
9280	ENDIF
9281
9282	IF ( mode == 'xy' ) grid = 'zu'
9283
9284	ELSEIF ( TRIM( variable(1:4) ) == 'LDSA' ) THEN
9285	IF ( av == 0 ) THEN
9286	DO i = nxl, nxr
9287	DO j = nys, nyn
9288	DO k = nzb_do, nzt_do
9289	temp_bin = 0.0_wp
9290	DO b = 1, nbins
9291	!
9292	!-- Diameter in micrometres
9293	mean_d = 1.0E+6_wp * Ra_dry(k,j,i,b) * 2.0_wp
9294	!
9295	!-- Deposition factor: alveolar
9296	df = ( 0.01555_wp / mean_d ) * ( EXP( -0.416_wp * ( LOG( &
9297	mean_d ) + 2.84_wp )*2.0_wp ) + 19.11_wp EXP( &
9298	-0.482_wp * ( LOG( mean_d ) - 1.362_wp )**2.0_wp ) )
9299	!
9300	!-- Number concentration in 1/cm3
9301	nc = 1.0E-6_wp * aerosol_number(b)%conc(k,j,i)
9302	!
9303	!-- Lung-deposited surface area LDSA (units mum2/cm3)
9304	temp_bin = temp_bin + pi * mean_d*2.0_wp df * nc
9305	ENDDO
9306	local_pf(i,j,k) = MERGE( temp_bin, REAL( fill_value, KIND = &
9307	wp ), BTEST( wall_flags_0(k,j,i), 0 ) )
9308	ENDDO
9309	ENDDO
9310	ENDDO
9311	ELSE
9312	DO i = nxl, nxr
9313	DO j = nys, nyn
9314	DO k = nzb_do, nzt_do
9315	local_pf(i,j,k) = MERGE( LDSA_av(k,j,i), REAL( fill_value, &
9316	KIND = wp ), BTEST( &
9317	wall_flags_0(k,j,i), 0 ) )
9318	ENDDO
9319	ENDDO
9320	ENDDO
9321	ENDIF
9322
9323	IF ( mode == 'xy' ) grid = 'zu'
9324
9325	ELSEIF ( TRIM( variable(1:5) ) == 'N_bin' ) THEN
9326
9327	vari = TRIM( variable( 6:LEN( TRIM( variable ) ) - 3 ) )
9328
9329	IF ( TRIM( vari ) == '1' ) b = 1
9330	IF ( TRIM( vari ) == '2' ) b = 2
9331	IF ( TRIM( vari ) == '3' ) b = 3
9332	IF ( TRIM( vari ) == '4' ) b = 4
9333	IF ( TRIM( vari ) == '5' ) b = 5
9334	IF ( TRIM( vari ) == '6' ) b = 6
9335	IF ( TRIM( vari ) == '7' ) b = 7
9336	IF ( TRIM( vari ) == '8' ) b = 8
9337	IF ( TRIM( vari ) == '9' ) b = 9
9338	IF ( TRIM( vari ) == '10' ) b = 10
9339	IF ( TRIM( vari ) == '11' ) b = 11
9340	IF ( TRIM( vari ) == '12' ) b = 12
9341
9342	IF ( av == 0 ) THEN
9343	DO i = nxl, nxr
9344	DO j = nys, nyn
9345	DO k = nzb_do, nzt_do
9346	local_pf(i,j,k) = MERGE( aerosol_number(b)%conc(k,j,i), &
9347	REAL( fill_value, KIND = wp ), &
9348	BTEST( wall_flags_0(k,j,i), 0 ) )
9349	ENDDO
9350	ENDDO
9351	ENDDO
9352	ELSE
9353	DO i = nxl, nxr
9354	DO j = nys, nyn
9355	DO k = nzb_do, nzt_do
9356	local_pf(i,j,k) = MERGE( Nbins_av(k,j,i,b), &
9357	REAL( fill_value, KIND = wp ), &
9358	BTEST( wall_flags_0(k,j,i), 0 ) )
9359	ENDDO
9360	ENDDO
9361	ENDDO
9362	ENDIF
9363
9364	IF ( mode == 'xy' ) grid = 'zu'
9365
9366	ELSEIF ( TRIM( variable(1:4) ) == 'Ntot' ) THEN
9367	IF ( av == 0 ) THEN
9368	DO i = nxl, nxr
9369	DO j = nys, nyn
9370	DO k = nzb_do, nzt_do
9371	temp_bin = 0.0_wp
9372	DO b = 1, nbins
9373	temp_bin = temp_bin + aerosol_number(b)%conc(k,j,i)
9374	ENDDO
9375	local_pf(i,j,k) = MERGE( temp_bin, REAL( fill_value, KIND = &
9376	wp ), BTEST( wall_flags_0(k,j,i), 0 ) )
9377	ENDDO
9378	ENDDO
9379	ENDDO
9380	ELSE
9381	DO i = nxl, nxr
9382	DO j = nys, nyn
9383	DO k = nzb_do, nzt_do
9384	local_pf(i,j,k) = MERGE( Ntot_av(k,j,i), REAL( fill_value, &
9385	KIND = wp ), BTEST( &
9386	wall_flags_0(k,j,i), 0 ) )
9387	ENDDO
9388	ENDDO
9389	ENDDO
9390	ENDIF
9391
9392	IF ( mode == 'xy' ) grid = 'zu'
9393
9394
9395	ELSEIF ( TRIM( variable(1:5) ) == 'm_bin' ) THEN
9396
9397	vari = TRIM( variable( 6:LEN( TRIM( variable ) ) - 3 ) )
9398
9399	IF ( TRIM( vari ) == '1' ) b = 1
9400	IF ( TRIM( vari ) == '2' ) b = 2
9401	IF ( TRIM( vari ) == '3' ) b = 3
9402	IF ( TRIM( vari ) == '4' ) b = 4
9403	IF ( TRIM( vari ) == '5' ) b = 5
9404	IF ( TRIM( vari ) == '6' ) b = 6
9405	IF ( TRIM( vari ) == '7' ) b = 7
9406	IF ( TRIM( vari ) == '8' ) b = 8
9407	IF ( TRIM( vari ) == '9' ) b = 9
9408	IF ( TRIM( vari ) == '10' ) b = 10
9409	IF ( TRIM( vari ) == '11' ) b = 11
9410	IF ( TRIM( vari ) == '12' ) b = 12
9411
9412	IF ( av == 0 ) THEN
9413	DO i = nxl, nxr
9414	DO j = nys, nyn
9415	DO k = nzb_do, nzt_do
9416	temp_bin = 0.0_wp
9417	DO c = b, ncc_tot * nbins, nbins
9418	temp_bin = temp_bin + aerosol_mass(c)%conc(k,j,i)
9419	ENDDO
9420	local_pf(i,j,k) = MERGE( temp_bin, REAL( fill_value, &
9421	KIND = wp ), BTEST( &
9422	wall_flags_0(k,j,i), 0 ) )
9423	ENDDO
9424	ENDDO
9425	ENDDO
9426	ELSE
9427	DO i = nxl, nxr
9428	DO j = nys, nyn
9429	DO k = nzb_do, nzt_do
9430	local_pf(i,j,k) = MERGE( mbins_av(k,j,i,b), REAL( fill_value,&
9431	KIND = wp ), BTEST( &
9432	wall_flags_0(k,j,i), 0 ) )
9433	ENDDO
9434	ENDDO
9435	ENDDO
9436	ENDIF
9437
9438	IF ( mode == 'xy' ) grid = 'zu'
9439
9440	ELSEIF ( TRIM( variable(1:5) ) == 'PM2.5' ) THEN
9441	IF ( av == 0 ) THEN
9442	DO i = nxl, nxr
9443	DO j = nys, nyn
9444	DO k = nzb_do, nzt_do
9445	temp_bin = 0.0_wp
9446	DO b = 1, nbins
9447	IF ( 2.0_wp * Ra_dry(k,j,i,b) <= 2.5E-6_wp ) THEN
9448	DO c = b, nbins*ncc, nbins
9449	temp_bin = temp_bin + aerosol_mass(c)%conc(k,j,i)
9450	ENDDO
9451	ENDIF
9452	ENDDO
9453	local_pf(i,j,k) = MERGE( temp_bin, REAL( fill_value, &
9454	KIND = wp ), BTEST( &
9455	wall_flags_0(k,j,i), 0 ) )
9456	ENDDO
9457	ENDDO
9458	ENDDO
9459	ELSE
9460	DO i = nxl, nxr
9461	DO j = nys, nyn
9462	DO k = nzb_do, nzt_do
9463	local_pf(i,j,k) = MERGE( PM25_av(k,j,i), REAL( fill_value, &
9464	KIND = wp ), BTEST( &
9465	wall_flags_0(k,j,i), 0 ) )
9466	ENDDO
9467	ENDDO
9468	ENDDO
9469	ENDIF
9470
9471	IF ( mode == 'xy' ) grid = 'zu'
9472
9473
9474	ELSEIF ( TRIM( variable(1:4) ) == 'PM10' ) THEN
9475	IF ( av == 0 ) THEN
9476	DO i = nxl, nxr
9477	DO j = nys, nyn
9478	DO k = nzb_do, nzt_do
9479	temp_bin = 0.0_wp
9480	DO b = 1, nbins
9481	IF ( 2.0_wp * Ra_dry(k,j,i,b) <= 10.0E-6_wp ) THEN
9482	DO c = b, nbins*ncc, nbins
9483	temp_bin = temp_bin + aerosol_mass(c)%conc(k,j,i)
9484	ENDDO
9485	ENDIF
9486	ENDDO
9487	local_pf(i,j,k) = MERGE( temp_bin, REAL( fill_value, &
9488	KIND = wp ), BTEST( &
9489	wall_flags_0(k,j,i), 0 ) )
9490	ENDDO
9491	ENDDO
9492	ENDDO
9493	ELSE
9494	DO i = nxl, nxr
9495	DO j = nys, nyn
9496	DO k = nzb_do, nzt_do
9497	local_pf(i,j,k) = MERGE( PM10_av(k,j,i), REAL( fill_value, &
9498	KIND = wp ), BTEST( &
9499	wall_flags_0(k,j,i), 0 ) )
9500	ENDDO
9501	ENDDO
9502	ENDDO
9503	ENDIF
9504
9505	IF ( mode == 'xy' ) grid = 'zu'
9506
9507	ELSEIF ( TRIM( variable(1:2) ) == 's_' ) THEN
9508	vari = TRIM( variable( 3:LEN( TRIM( variable ) ) - 3 ) )
9509	IF ( is_used( prtcl, vari ) ) THEN
9510	icc = get_index( prtcl, vari )
9511	IF ( av == 0 ) THEN
9512	DO i = nxl, nxr
9513	DO j = nys, nyn
9514	DO k = nzb_do, nzt_do
9515	temp_bin = 0.0_wp
9516	DO c = ( icc-1 )nbins+1, iccnbins, 1
9517	temp_bin = temp_bin + aerosol_mass(c)%conc(k,j,i)
9518	ENDDO
9519	local_pf(i,j,k) = MERGE( temp_bin, REAL( fill_value, &
9520	KIND = wp ), BTEST( &
9521	wall_flags_0(k,j,i), 0 ) )
9522	ENDDO
9523	ENDDO
9524	ENDDO
9525	ELSE
9526	IF ( vari == 'BC' ) to_be_resorted => s_BC_av
9527	IF ( vari == 'DU' ) to_be_resorted => s_DU_av
9528	IF ( vari == 'NH' ) to_be_resorted => s_NH_av
9529	IF ( vari == 'NO' ) to_be_resorted => s_NO_av
9530	IF ( vari == 'OC' ) to_be_resorted => s_OC_av
9531	IF ( vari == 'SO4' ) to_be_resorted => s_SO4_av
9532	IF ( vari == 'SS' ) to_be_resorted => s_SS_av
9533	DO i = nxl, nxr
9534	DO j = nys, nyn
9535	DO k = nzb_do, nzt_do
9536	local_pf(i,j,k) = MERGE( to_be_resorted(k,j,i), &
9537	REAL( fill_value, KIND = wp ), &
9538	BTEST( wall_flags_0(k,j,i), 0 ) )
9539	ENDDO
9540	ENDDO
9541	ENDDO
9542	ENDIF
9543	ELSE
9544	local_pf = fill_value
9545	ENDIF
9546
9547	IF ( mode == 'xy' ) grid = 'zu'
9548
9549	ELSE
9550	found = .FALSE.
9551	grid = 'none'
9552
9553	ENDIF
9554
9555	END SUBROUTINE salsa_data_output_2d
9556
9557
9558	!------------------------------------------------------------------------------!
9559	!
9560	! Description:
9561	! ------------
9562	!> Subroutine defining 3D output variables
9563	!------------------------------------------------------------------------------!
9564	SUBROUTINE salsa_data_output_3d( av, variable, found, local_pf, nzb_do, &
9565	nzt_do )
9566
9567	USE indices
9568
9569	USE kinds
9570
9571
9572	IMPLICIT NONE
9573
9574	CHARACTER (LEN=*), INTENT(in) :: variable !<
9575
9576	INTEGER(iwp) :: av !<
9577	INTEGER(iwp) :: b !< running index: size bins
9578	INTEGER(iwp) :: c !< running index: mass bins
9579	INTEGER(iwp) :: i !<
9580	INTEGER(iwp) :: icc !< index of a chemical compound
9581	INTEGER(iwp) :: j !<
9582	INTEGER(iwp) :: k !<
9583	INTEGER(iwp) :: nzb_do !<
9584	INTEGER(iwp) :: nzt_do !<
9585
9586	LOGICAL :: found !<
9587
9588	REAL(wp) :: df !< For calculating LDSA: fraction of particles
9589	!< depositing in the alveolar (or tracheobronchial)
9590	!< region of the lung. Depends on the particle size
9591	REAL(wp) :: fill_value = -9999.0_wp !< value for the _FillValue attribute
9592	REAL(wp) :: mean_d !< Particle diameter in micrometres
9593	REAL(wp) :: nc !< Particle number concentration in units 1/cm**3
9594	REAL(wp) :: temp_bin !< temporary array for calculating output variables
9595
9596	REAL(sp), DIMENSION(nxl:nxr,nys:nyn,nzb_do:nzt_do) :: local_pf !< local
9597
9598	REAL(wp), DIMENSION(:,:,:), POINTER :: to_be_resorted !< pointer
9599
9600
9601	found = .TRUE.
9602	temp_bin = 0.0_wp
9603
9604	SELECT CASE ( TRIM( variable ) )
9605
9606	CASE ( 'g_H2SO4', 'g_HNO3', 'g_NH3', 'g_OCNV', 'g_OCSV' )
9607	IF ( av == 0 ) THEN
9608	IF ( TRIM( variable ) == 'g_H2SO4') icc = 1
9609	IF ( TRIM( variable ) == 'g_HNO3') icc = 2
9610	IF ( TRIM( variable ) == 'g_NH3') icc = 3
9611	IF ( TRIM( variable ) == 'g_OCNV') icc = 4
9612	IF ( TRIM( variable ) == 'g_OCSV') icc = 5
9613
9614	DO i = nxl, nxr
9615	DO j = nys, nyn
9616	DO k = nzb_do, nzt_do
9617	local_pf(i,j,k) = MERGE( salsa_gas(icc)%conc(k,j,i), &
9618	REAL( fill_value, KIND = wp ), &
9619	BTEST( wall_flags_0(k,j,i), 0 ) )
9620	ENDDO
9621	ENDDO
9622	ENDDO
9623	ELSE
9624	IF ( TRIM( variable(3:) ) == 'H2SO4' ) to_be_resorted => g_H2SO4_av
9625	IF ( TRIM( variable(3:) ) == 'HNO3' ) to_be_resorted => g_HNO3_av
9626	IF ( TRIM( variable(3:) ) == 'NH3' ) to_be_resorted => g_NH3_av
9627	IF ( TRIM( variable(3:) ) == 'OCNV' ) to_be_resorted => g_OCNV_av
9628	IF ( TRIM( variable(3:) ) == 'OCSV' ) to_be_resorted => g_OCSV_av
9629	DO i = nxl, nxr
9630	DO j = nys, nyn
9631	DO k = nzb_do, nzt_do
9632	local_pf(i,j,k) = MERGE( to_be_resorted(k,j,i), &
9633	REAL( fill_value, KIND = wp ), &
9634	BTEST( wall_flags_0(k,j,i), 0 ) )
9635	ENDDO
9636	ENDDO
9637	ENDDO
9638	ENDIF
9639
9640	CASE ( 'LDSA' )
9641	IF ( av == 0 ) THEN
9642	DO i = nxl, nxr
9643	DO j = nys, nyn
9644	DO k = nzb_do, nzt_do
9645	temp_bin = 0.0_wp
9646	DO b = 1, nbins
9647	!
9648	!-- Diameter in micrometres
9649	mean_d = 1.0E+6_wp * Ra_dry(k,j,i,b) * 2.0_wp
9650	!
9651	!-- Deposition factor: alveolar
9652	df = ( 0.01555_wp / mean_d ) * ( EXP( -0.416_wp * &
9653	( LOG( mean_d ) + 2.84_wp )**2.0_wp ) + 19.11_wp &
9654	* EXP( -0.482_wp * ( LOG( mean_d ) - 1.362_wp &
9655	)**2.0_wp ) )
9656	!
9657	!-- Number concentration in 1/cm3
9658	nc = 1.0E-6_wp * aerosol_number(b)%conc(k,j,i)
9659	!
9660	!-- Lung-deposited surface area LDSA (units mum2/cm3)
9661	temp_bin = temp_bin + pi * mean_d*2.0_wp df * nc
9662	ENDDO
9663	local_pf(i,j,k) = MERGE( temp_bin, &
9664	REAL( fill_value, KIND = wp ), &
9665	BTEST( wall_flags_0(k,j,i), 0 ) )
9666	ENDDO
9667	ENDDO
9668	ENDDO
9669	ELSE
9670	DO i = nxl, nxr
9671	DO j = nys, nyn
9672	DO k = nzb_do, nzt_do
9673	local_pf(i,j,k) = MERGE( LDSA_av(k,j,i), &
9674	REAL( fill_value, KIND = wp ), &
9675	BTEST( wall_flags_0(k,j,i), 0 ) )
9676	ENDDO
9677	ENDDO
9678	ENDDO
9679	ENDIF
9680
9681	CASE ( 'N_bin1', 'N_bin2', 'N_bin3', 'N_bin4', 'N_bin5', 'N_bin6', &
9682	'N_bin7', 'N_bin8', 'N_bin9', 'N_bin10' , 'N_bin11', 'N_bin12' )
9683	IF ( TRIM( variable(6:) ) == '1' ) b = 1
9684	IF ( TRIM( variable(6:) ) == '2' ) b = 2
9685	IF ( TRIM( variable(6:) ) == '3' ) b = 3
9686	IF ( TRIM( variable(6:) ) == '4' ) b = 4
9687	IF ( TRIM( variable(6:) ) == '5' ) b = 5
9688	IF ( TRIM( variable(6:) ) == '6' ) b = 6
9689	IF ( TRIM( variable(6:) ) == '7' ) b = 7
9690	IF ( TRIM( variable(6:) ) == '8' ) b = 8
9691	IF ( TRIM( variable(6:) ) == '9' ) b = 9
9692	IF ( TRIM( variable(6:) ) == '10' ) b = 10
9693	IF ( TRIM( variable(6:) ) == '11' ) b = 11
9694	IF ( TRIM( variable(6:) ) == '12' ) b = 12
9695
9696	IF ( av == 0 ) THEN
9697	DO i = nxl, nxr
9698	DO j = nys, nyn
9699	DO k = nzb_do, nzt_do
9700	local_pf(i,j,k) = MERGE( aerosol_number(b)%conc(k,j,i), &
9701	REAL( fill_value, KIND = wp ), &
9702	BTEST( wall_flags_0(k,j,i), 0 ) )
9703	ENDDO
9704	ENDDO
9705	ENDDO
9706	ELSE
9707	DO i = nxl, nxr
9708	DO j = nys, nyn
9709	DO k = nzb_do, nzt_do
9710	local_pf(i,j,k) = MERGE( Nbins_av(k,j,i,b), &
9711	REAL( fill_value, KIND = wp ), &
9712	BTEST( wall_flags_0(k,j,i), 0 ) )
9713	ENDDO
9714	ENDDO
9715	ENDDO
9716	ENDIF
9717
9718	CASE ( 'Ntot' )
9719	IF ( av == 0 ) THEN
9720	DO i = nxl, nxr
9721	DO j = nys, nyn
9722	DO k = nzb_do, nzt_do
9723	temp_bin = 0.0_wp
9724	DO b = 1, nbins
9725	temp_bin = temp_bin + aerosol_number(b)%conc(k,j,i)
9726	ENDDO
9727	local_pf(i,j,k) = MERGE( temp_bin, &
9728	REAL( fill_value, KIND = wp ), &
9729	BTEST( wall_flags_0(k,j,i), 0 ) )
9730	ENDDO
9731	ENDDO
9732	ENDDO
9733	ELSE
9734	DO i = nxl, nxr
9735	DO j = nys, nyn
9736	DO k = nzb_do, nzt_do
9737	local_pf(i,j,k) = MERGE( Ntot_av(k,j,i), &
9738	REAL( fill_value, KIND = wp ), &
9739	BTEST( wall_flags_0(k,j,i), 0 ) )
9740	ENDDO
9741	ENDDO
9742	ENDDO
9743	ENDIF
9744
9745	CASE ( 'm_bin1', 'm_bin2', 'm_bin3', 'm_bin4', 'm_bin5', 'm_bin6', &
9746	'm_bin7', 'm_bin8', 'm_bin9', 'm_bin10' , 'm_bin11', 'm_bin12' )
9747	IF ( TRIM( variable(6:) ) == '1' ) b = 1
9748	IF ( TRIM( variable(6:) ) == '2' ) b = 2
9749	IF ( TRIM( variable(6:) ) == '3' ) b = 3
9750	IF ( TRIM( variable(6:) ) == '4' ) b = 4
9751	IF ( TRIM( variable(6:) ) == '5' ) b = 5
9752	IF ( TRIM( variable(6:) ) == '6' ) b = 6
9753	IF ( TRIM( variable(6:) ) == '7' ) b = 7
9754	IF ( TRIM( variable(6:) ) == '8' ) b = 8
9755	IF ( TRIM( variable(6:) ) == '9' ) b = 9
9756	IF ( TRIM( variable(6:) ) == '10' ) b = 10
9757	IF ( TRIM( variable(6:) ) == '11' ) b = 11
9758	IF ( TRIM( variable(6:) ) == '12' ) b = 12
9759
9760	IF ( av == 0 ) THEN
9761	DO i = nxl, nxr
9762	DO j = nys, nyn
9763	DO k = nzb_do, nzt_do
9764	temp_bin = 0.0_wp
9765	DO c = b, ncc_tot * nbins, nbins
9766	temp_bin = temp_bin + aerosol_mass(c)%conc(k,j,i)
9767	ENDDO
9768	local_pf(i,j,k) = MERGE( temp_bin, &
9769	REAL( fill_value, KIND = wp ), &
9770	BTEST( wall_flags_0(k,j,i), 0 ) )
9771	ENDDO
9772	ENDDO
9773	ENDDO
9774	ELSE
9775	DO i = nxl, nxr
9776	DO j = nys, nyn
9777	DO k = nzb_do, nzt_do
9778	local_pf(i,j,k) = MERGE( mbins_av(k,j,i,b), &
9779	REAL( fill_value, KIND = wp ), &
9780	BTEST( wall_flags_0(k,j,i), 0 ) )
9781	ENDDO
9782	ENDDO
9783	ENDDO
9784	ENDIF
9785
9786	CASE ( 'PM2.5' )
9787	IF ( av == 0 ) THEN
9788	DO i = nxl, nxr
9789	DO j = nys, nyn
9790	DO k = nzb_do, nzt_do
9791	temp_bin = 0.0_wp
9792	DO b = 1, nbins
9793	IF ( 2.0_wp * Ra_dry(k,j,i,b) <= 2.5E-6_wp ) THEN
9794	DO c = b, nbins * ncc, nbins
9795	temp_bin = temp_bin + aerosol_mass(c)%conc(k,j,i)
9796	ENDDO
9797	ENDIF
9798	ENDDO
9799	local_pf(i,j,k) = MERGE( temp_bin, &
9800	REAL( fill_value, KIND = wp ), &
9801	BTEST( wall_flags_0(k,j,i), 0 ) )
9802	ENDDO
9803	ENDDO
9804	ENDDO
9805	ELSE
9806	DO i = nxl, nxr
9807	DO j = nys, nyn
9808	DO k = nzb_do, nzt_do
9809	local_pf(i,j,k) = MERGE( PM25_av(k,j,i), &
9810	REAL( fill_value, KIND = wp ), &
9811	BTEST( wall_flags_0(k,j,i), 0 ) )
9812	ENDDO
9813	ENDDO
9814	ENDDO
9815	ENDIF
9816
9817	CASE ( 'PM10' )
9818	IF ( av == 0 ) THEN
9819	DO i = nxl, nxr
9820	DO j = nys, nyn
9821	DO k = nzb_do, nzt_do
9822	temp_bin = 0.0_wp
9823	DO b = 1, nbins
9824	IF ( 2.0_wp * Ra_dry(k,j,i,b) <= 10.0E-6_wp ) THEN
9825	DO c = b, nbins * ncc, nbins
9826	temp_bin = temp_bin + aerosol_mass(c)%conc(k,j,i)
9827	ENDDO
9828	ENDIF
9829	ENDDO
9830	local_pf(i,j,k) = MERGE( temp_bin, &
9831	REAL( fill_value, KIND = wp ), &
9832	BTEST( wall_flags_0(k,j,i), 0 ) )
9833	ENDDO
9834	ENDDO
9835	ENDDO
9836	ELSE
9837	DO i = nxl, nxr
9838	DO j = nys, nyn
9839	DO k = nzb_do, nzt_do
9840	local_pf(i,j,k) = MERGE( PM10_av(k,j,i), &
9841	REAL( fill_value, KIND = wp ), &
9842	BTEST( wall_flags_0(k,j,i), 0 ) )
9843	ENDDO
9844	ENDDO
9845	ENDDO
9846	ENDIF
9847
9848	CASE ( 's_BC', 's_DU', 's_H2O', 's_NH', 's_NO', 's_OC', 's_SO4', 's_SS' )
9849	IF ( is_used( prtcl, TRIM( variable(3:) ) ) ) THEN
9850	icc = get_index( prtcl, TRIM( variable(3:) ) )
9851	IF ( av == 0 ) THEN
9852	DO i = nxl, nxr
9853	DO j = nys, nyn
9854	DO k = nzb_do, nzt_do
9855	temp_bin = 0.0_wp
9856	DO c = ( icc-1 )nbins+1, iccnbins
9857	temp_bin = temp_bin + aerosol_mass(c)%conc(k,j,i)
9858	ENDDO
9859	local_pf(i,j,k) = MERGE( temp_bin, &
9860	REAL( fill_value, KIND = wp ), &
9861	BTEST( wall_flags_0(k,j,i), 0 ) )
9862	ENDDO
9863	ENDDO
9864	ENDDO
9865	ELSE
9866	IF ( TRIM( variable(3:) ) == 'BC' ) to_be_resorted => s_BC_av
9867	IF ( TRIM( variable(3:) ) == 'DU' ) to_be_resorted => s_DU_av
9868	IF ( TRIM( variable(3:) ) == 'NH' ) to_be_resorted => s_NH_av
9869	IF ( TRIM( variable(3:) ) == 'NO' ) to_be_resorted => s_NO_av
9870	IF ( TRIM( variable(3:) ) == 'OC' ) to_be_resorted => s_OC_av
9871	IF ( TRIM( variable(3:) ) == 'SO4' ) to_be_resorted => s_SO4_av
9872	IF ( TRIM( variable(3:) ) == 'SS' ) to_be_resorted => s_SS_av
9873	DO i = nxl, nxr
9874	DO j = nys, nyn
9875	DO k = nzb_do, nzt_do
9876	local_pf(i,j,k) = MERGE( to_be_resorted(k,j,i), &
9877	REAL( fill_value, KIND = wp ), &
9878	BTEST( wall_flags_0(k,j,i), 0 ) )
9879	ENDDO
9880	ENDDO
9881	ENDDO
9882	ENDIF
9883	ENDIF
9884	CASE DEFAULT
9885	found = .FALSE.
9886
9887	END SELECT
9888
9889	END SUBROUTINE salsa_data_output_3d
9890
9891	!------------------------------------------------------------------------------!
9892	!
9893	! Description:
9894	! ------------
9895	!> Subroutine defining mask output variables
9896	!------------------------------------------------------------------------------!
9897	SUBROUTINE salsa_data_output_mask( av, variable, found, local_pf )
9898
9899	USE arrays_3d, &
9900	ONLY: tend
9901
9902	USE control_parameters, &
9903	ONLY: mask_size_l, mask_surface, mid
9904
9905	USE surface_mod, &
9906	ONLY: get_topography_top_index_ji
9907
9908	IMPLICIT NONE
9909
9910	CHARACTER(LEN=5) :: grid !< flag to distinquish between staggered grid
9911	CHARACTER(LEN=*) :: variable !<
9912	CHARACTER(LEN=7) :: vari !< trimmed format of variable
9913
9914	INTEGER(iwp) :: av !<
9915	INTEGER(iwp) :: b !< loop index for aerosol size number bins
9916	INTEGER(iwp) :: c !< loop index for chemical components
9917	INTEGER(iwp) :: i !< loop index in x-direction
9918	INTEGER(iwp) :: icc !< index of a chemical compound
9919	INTEGER(iwp) :: j !< loop index in y-direction
9920	INTEGER(iwp) :: k !< loop index in z-direction
9921	INTEGER(iwp) :: topo_top_ind !< k index of highest horizontal surface
9922
9923	LOGICAL :: found !<
9924	LOGICAL :: resorted !<
9925
9926	REAL(wp) :: df !< For calculating LDSA: fraction of particles
9927	!< depositing in the alveolar (or tracheobronchial)
9928	!< region of the lung. Depends on the particle size
9929	REAL(wp) :: mean_d !< Particle diameter in micrometres
9930	REAL(wp) :: nc !< Particle number concentration in units 1/cm**3
9931	REAL(wp) :: temp_bin !< temporary array for calculating output variables
9932
9933	REAL(wp), DIMENSION(mask_size_l(mid,1),mask_size_l(mid,2),mask_size_l(mid,3)) :: local_pf !<
9934
9935	REAL(wp), DIMENSION(:,:,:), POINTER :: to_be_resorted !< pointer
9936
9937	found = .TRUE.
9938	resorted = .FALSE.
9939	grid = 's'
9940	temp_bin = 0.0_wp
9941
9942	SELECT CASE ( TRIM( variable ) )
9943
9944	CASE ( 'g_H2SO4', 'g_HNO3', 'g_NH3', 'g_OCNV', 'g_OCSV' )
9945	vari = TRIM( variable )
9946	IF ( av == 0 ) THEN
9947	IF ( vari == 'g_H2SO4') to_be_resorted => salsa_gas(1)%conc
9948	IF ( vari == 'g_HNO3') to_be_resorted => salsa_gas(2)%conc
9949	IF ( vari == 'g_NH3') to_be_resorted => salsa_gas(3)%conc
9950	IF ( vari == 'g_OCNV') to_be_resorted => salsa_gas(4)%conc
9951	IF ( vari == 'g_OCSV') to_be_resorted => salsa_gas(5)%conc
9952	ELSE
9953	IF ( vari == 'g_H2SO4') to_be_resorted => g_H2SO4_av
9954	IF ( vari == 'g_HNO3') to_be_resorted => g_HNO3_av
9955	IF ( vari == 'g_NH3') to_be_resorted => g_NH3_av
9956	IF ( vari == 'g_OCNV') to_be_resorted => g_OCNV_av
9957	IF ( vari == 'g_OCSV') to_be_resorted => g_OCSV_av
9958	ENDIF
9959
9960	CASE ( 'LDSA' )
9961	IF ( av == 0 ) THEN
9962	DO i = nxl, nxr
9963	DO j = nys, nyn
9964	DO k = nzb, nz_do3d
9965	temp_bin = 0.0_wp
9966	DO b = 1, nbins
9967	!
9968	!-- Diameter in micrometres
9969	mean_d = 1.0E+6_wp * Ra_dry(k,j,i,b) * 2.0_wp
9970	!
9971	!-- Deposition factor: alveolar
9972	df = ( 0.01555_wp / mean_d ) * ( EXP( -0.416_wp * &
9973	( LOG( mean_d ) + 2.84_wp )**2.0_wp ) + 19.11_wp &
9974	* EXP( -0.482_wp * ( LOG( mean_d ) - 1.362_wp &
9975	)**2.0_wp ) )
9976	!
9977	!-- Number concentration in 1/cm3
9978	nc = 1.0E-6_wp * aerosol_number(b)%conc(k,j,i)
9979	!
9980	!-- Lung-deposited surface area LDSA (units mum2/cm3)
9981	temp_bin = temp_bin + pi * mean_d*2.0_wp df * nc
9982	ENDDO
9983	tend(k,j,i) = temp_bin
9984	ENDDO
9985	ENDDO
9986	ENDDO
9987	IF ( .NOT. mask_surface(mid) ) THEN
9988	DO i = 1, mask_size_l(mid,1)
9989	DO j = 1, mask_size_l(mid,2)
9990	DO k = 1, mask_size_l(mid,3)
9991	local_pf(i,j,k) = tend( mask_k(mid,k), mask_j(mid,j),&
9992	mask_i(mid,i) )
9993	ENDDO
9994	ENDDO
9995	ENDDO
9996	ELSE
9997	DO i = 1, mask_size_l(mid,1)
9998	DO j = 1, mask_size_l(mid,2)
9999	topo_top_ind = get_topography_top_index_ji( mask_j(mid,j),&
10000	mask_i(mid,i),&
10001	grid )
10002	DO k = 1, mask_size_l(mid,3)
10003	local_pf(i,j,k) = tend( MIN( topo_top_ind+mask_k(mid,k),&
10004	nzt+1 ), &
10005	mask_j(mid,j), mask_i(mid,i) )
10006	ENDDO
10007	ENDDO
10008	ENDDO
10009	ENDIF
10010	resorted = .TRUE.
10011	ELSE
10012	to_be_resorted => LDSA_av
10013	ENDIF
10014
10015	CASE ( 'N_bin1', 'N_bin2', 'N_bin3', 'N_bin4', 'N_bin5', 'N_bin6', &
10016	'N_bin7', 'N_bin8', 'N_bin9', 'N_bin10' , 'N_bin11', 'N_bin12' )
10017	IF ( TRIM( variable(6:) ) == '1' ) b = 1
10018	IF ( TRIM( variable(6:) ) == '2' ) b = 2
10019	IF ( TRIM( variable(6:) ) == '3' ) b = 3
10020	IF ( TRIM( variable(6:) ) == '4' ) b = 4
10021	IF ( TRIM( variable(6:) ) == '5' ) b = 5
10022	IF ( TRIM( variable(6:) ) == '6' ) b = 6
10023	IF ( TRIM( variable(6:) ) == '7' ) b = 7
10024	IF ( TRIM( variable(6:) ) == '8' ) b = 8
10025	IF ( TRIM( variable(6:) ) == '9' ) b = 9
10026	IF ( TRIM( variable(6:) ) == '10' ) b = 10
10027	IF ( TRIM( variable(6:) ) == '11' ) b = 11
10028	IF ( TRIM( variable(6:) ) == '12' ) b = 12
10029
10030	IF ( av == 0 ) THEN
10031	IF ( .NOT. mask_surface(mid) ) THEN
10032	DO i = 1, mask_size_l(mid,1)
10033	DO j = 1, mask_size_l(mid,2)
10034	DO k = 1, mask_size_l(mid,3)
10035	local_pf(i,j,k) = aerosol_number(b)%conc( mask_k(mid,k),&
10036	mask_j(mid,j),&
10037	mask_i(mid,i) )
10038	ENDDO
10039	ENDDO
10040	ENDDO
10041	ELSE
10042	DO i = 1, mask_size_l(mid,1)
10043	DO j = 1, mask_size_l(mid,2)
10044	topo_top_ind = get_topography_top_index_ji( mask_j(mid,j),&
10045	mask_i(mid,i),&
10046	grid )
10047	DO k = 1, mask_size_l(mid,3)
10048	local_pf(i,j,k) = aerosol_number(b)%conc( &
10049	MIN( topo_top_ind+mask_k(mid,k), &
10050	nzt+1 ), &
10051	mask_j(mid,j), mask_i(mid,i) )
10052	ENDDO
10053	ENDDO
10054	ENDDO
10055	ENDIF
10056	resorted = .TRUE.
10057	ELSE
10058	to_be_resorted => Nbins_av(:,:,:,b)
10059	ENDIF
10060
10061	CASE ( 'Ntot' )
10062	IF ( av == 0 ) THEN
10063	DO i = nxl, nxr
10064	DO j = nys, nyn
10065	DO k = nzb, nz_do3d
10066	temp_bin = 0.0_wp
10067	DO b = 1, nbins
10068	temp_bin = temp_bin + aerosol_number(b)%conc(k,j,i)
10069	ENDDO
10070	tend(k,j,i) = temp_bin
10071	ENDDO
10072	ENDDO
10073	ENDDO
10074	IF ( .NOT. mask_surface(mid) ) THEN
10075	DO i = 1, mask_size_l(mid,1)
10076	DO j = 1, mask_size_l(mid,2)
10077	DO k = 1, mask_size_l(mid,3)
10078	local_pf(i,j,k) = tend( mask_k(mid,k), mask_j(mid,j),&
10079	mask_i(mid,i) )
10080	ENDDO
10081	ENDDO
10082	ENDDO
10083	ELSE
10084	DO i = 1, mask_size_l(mid,1)
10085	DO j = 1, mask_size_l(mid,2)
10086	topo_top_ind = get_topography_top_index_ji( mask_j(mid,j),&
10087	mask_i(mid,i),&
10088	grid )
10089	DO k = 1, mask_size_l(mid,3)
10090	local_pf(i,j,k) = tend( MIN( topo_top_ind+mask_k(mid,k),&
10091	nzt+1 ), &
10092	mask_j(mid,j), mask_i(mid,i) )
10093	ENDDO
10094	ENDDO
10095	ENDDO
10096	ENDIF
10097	resorted = .TRUE.
10098	ELSE
10099	to_be_resorted => Ntot_av
10100	ENDIF
10101
10102	CASE ( 'm_bin1', 'm_bin2', 'm_bin3', 'm_bin4', 'm_bin5', 'm_bin6', &
10103	'm_bin7', 'm_bin8', 'm_bin9', 'm_bin10' , 'm_bin11', 'm_bin12' )
10104	IF ( TRIM( variable(6:) ) == '1' ) b = 1
10105	IF ( TRIM( variable(6:) ) == '2' ) b = 2
10106	IF ( TRIM( variable(6:) ) == '3' ) b = 3
10107	IF ( TRIM( variable(6:) ) == '4' ) b = 4
10108	IF ( TRIM( variable(6:) ) == '5' ) b = 5
10109	IF ( TRIM( variable(6:) ) == '6' ) b = 6
10110	IF ( TRIM( variable(6:) ) == '7' ) b = 7
10111	IF ( TRIM( variable(6:) ) == '8' ) b = 8
10112	IF ( TRIM( variable(6:) ) == '9' ) b = 9
10113	IF ( TRIM( variable(6:) ) == '10' ) b = 10
10114	IF ( TRIM( variable(6:) ) == '11' ) b = 11
10115	IF ( TRIM( variable(6:) ) == '12' ) b = 12
10116
10117	IF ( av == 0 ) THEN
10118	DO i = nxl, nxr
10119	DO j = nys, nyn
10120	DO k = nzb, nz_do3d
10121	temp_bin = 0.0_wp
10122	DO c = b, ncc_tot*nbins, nbins
10123	temp_bin = temp_bin + aerosol_mass(c)%conc(k,j,i)
10124	ENDDO
10125	tend(k,j,i) = temp_bin
10126	ENDDO
10127	ENDDO
10128	ENDDO
10129	IF ( .NOT. mask_surface(mid) ) THEN
10130	DO i = 1, mask_size_l(mid,1)
10131	DO j = 1, mask_size_l(mid,2)
10132	DO k = 1, mask_size_l(mid,3)
10133	local_pf(i,j,k) = tend( mask_k(mid,k), mask_j(mid,j),&
10134	mask_i(mid,i) )
10135	ENDDO
10136	ENDDO
10137	ENDDO
10138	ELSE
10139	DO i = 1, mask_size_l(mid,1)
10140	DO j = 1, mask_size_l(mid,2)
10141	topo_top_ind = get_topography_top_index_ji( mask_j(mid,j),&
10142	mask_i(mid,i),&
10143	grid )
10144	DO k = 1, mask_size_l(mid,3)
10145	local_pf(i,j,k) = tend( MIN( topo_top_ind+mask_k(mid,k),&
10146	nzt+1 ), &
10147	mask_j(mid,j), mask_i(mid,i) )
10148	ENDDO
10149	ENDDO
10150	ENDDO
10151	ENDIF
10152	resorted = .TRUE.
10153	ELSE
10154	to_be_resorted => mbins_av(:,:,:,b)
10155	ENDIF
10156
10157	CASE ( 'PM2.5' )
10158	IF ( av == 0 ) THEN
10159	DO i = nxl, nxr
10160	DO j = nys, nyn
10161	DO k = nzb, nz_do3d
10162	temp_bin = 0.0_wp
10163	DO b = 1, nbins
10164	IF ( 2.0_wp * Ra_dry(k,j,i,b) <= 2.5E-6_wp ) THEN
10165	DO c = b, nbins * ncc, nbins
10166	temp_bin = temp_bin + aerosol_mass(c)%conc(k,j,i)
10167	ENDDO
10168	ENDIF
10169	ENDDO
10170	tend(k,j,i) = temp_bin
10171	ENDDO
10172	ENDDO
10173	ENDDO
10174	IF ( .NOT. mask_surface(mid) ) THEN
10175	DO i = 1, mask_size_l(mid,1)
10176	DO j = 1, mask_size_l(mid,2)
10177	DO k = 1, mask_size_l(mid,3)
10178	local_pf(i,j,k) = tend( mask_k(mid,k), mask_j(mid,j),&
10179	mask_i(mid,i) )
10180	ENDDO
10181	ENDDO
10182	ENDDO
10183	ELSE
10184	DO i = 1, mask_size_l(mid,1)
10185	DO j = 1, mask_size_l(mid,2)
10186	topo_top_ind = get_topography_top_index_ji( mask_j(mid,j),&
10187	mask_i(mid,i),&
10188	grid )
10189	DO k = 1, mask_size_l(mid,3)
10190	local_pf(i,j,k) = tend( MIN( topo_top_ind+mask_k(mid,k),&
10191	nzt+1 ), &
10192	mask_j(mid,j), mask_i(mid,i) )
10193	ENDDO
10194	ENDDO
10195	ENDDO
10196	ENDIF
10197	resorted = .TRUE.
10198	ELSE
10199	to_be_resorted => PM25_av
10200	ENDIF
10201
10202	CASE ( 'PM10' )
10203	IF ( av == 0 ) THEN
10204	DO i = nxl, nxr
10205	DO j = nys, nyn
10206	DO k = nzb, nz_do3d
10207	temp_bin = 0.0_wp
10208	DO b = 1, nbins
10209	IF ( 2.0_wp * Ra_dry(k,j,i,b) <= 10.0E-6_wp ) THEN
10210	DO c = b, nbins * ncc, nbins
10211	temp_bin = temp_bin + aerosol_mass(c)%conc(k,j,i)
10212	ENDDO
10213	ENDIF
10214	ENDDO
10215	tend(k,j,i) = temp_bin
10216	ENDDO
10217	ENDDO
10218	ENDDO
10219	IF ( .NOT. mask_surface(mid) ) THEN
10220	DO i = 1, mask_size_l(mid,1)
10221	DO j = 1, mask_size_l(mid,2)
10222	DO k = 1, mask_size_l(mid,3)
10223	local_pf(i,j,k) = tend( mask_k(mid,k), mask_j(mid,j),&
10224	mask_i(mid,i) )
10225	ENDDO
10226	ENDDO
10227	ENDDO
10228	ELSE
10229	DO i = 1, mask_size_l(mid,1)
10230	DO j = 1, mask_size_l(mid,2)
10231	topo_top_ind = get_topography_top_index_ji( mask_j(mid,j),&
10232	mask_i(mid,i),&
10233	grid )
10234	DO k = 1, mask_size_l(mid,3)
10235	local_pf(i,j,k) = tend( MIN( topo_top_ind+mask_k(mid,k),&
10236	nzt+1 ), &
10237	mask_j(mid,j), mask_i(mid,i) )
10238	ENDDO
10239	ENDDO
10240	ENDDO
10241	ENDIF
10242	resorted = .TRUE.
10243	ELSE
10244	to_be_resorted => PM10_av
10245	ENDIF
10246
10247	CASE ( 's_BC', 's_DU', 's_NH', 's_NO', 's_OC', 's_SO4', 's_SS' )
10248	IF ( av == 0 ) THEN
10249	IF ( is_used( prtcl, TRIM( variable(3:) ) ) ) THEN
10250	icc = get_index( prtcl, TRIM( variable(3:) ) )
10251	DO i = nxl, nxr
10252	DO j = nys, nyn
10253	DO k = nzb, nz_do3d
10254	temp_bin = 0.0_wp
10255	DO c = ( icc-1 )nbins+1, iccnbins
10256	temp_bin = temp_bin + aerosol_mass(c)%conc(k,j,i)
10257	ENDDO
10258	tend(k,j,i) = temp_bin
10259	ENDDO
10260	ENDDO
10261	ENDDO
10262	ELSE
10263	tend = 0.0_wp
10264	ENDIF
10265	IF ( .NOT. mask_surface(mid) ) THEN
10266	DO i = 1, mask_size_l(mid,1)
10267	DO j = 1, mask_size_l(mid,2)
10268	DO k = 1, mask_size_l(mid,3)
10269	local_pf(i,j,k) = tend( mask_k(mid,k), mask_j(mid,j), &
10270	mask_i(mid,i) )
10271	ENDDO
10272	ENDDO
10273	ENDDO
10274	ELSE
10275	DO i = 1, mask_size_l(mid,1)
10276	DO j = 1, mask_size_l(mid,2)
10277	topo_top_ind = get_topography_top_index_ji( mask_j(mid,j),&
10278	mask_i(mid,i),&
10279	grid )
10280	DO k = 1, mask_size_l(mid,3)
10281	local_pf(i,j,k) = tend( MIN( topo_top_ind+mask_k(mid,k),&
10282	nzt+1 ),&
10283	mask_j(mid,j), mask_i(mid,i) )
10284	ENDDO
10285	ENDDO
10286	ENDDO
10287	ENDIF
10288	resorted = .TRUE.
10289	ELSE
10290	IF ( TRIM( variable(3:) ) == 'BC' ) to_be_resorted => s_BC_av
10291	IF ( TRIM( variable(3:) ) == 'DU' ) to_be_resorted => s_DU_av
10292	IF ( TRIM( variable(3:) ) == 'NH' ) to_be_resorted => s_NH_av
10293	IF ( TRIM( variable(3:) ) == 'NO' ) to_be_resorted => s_NO_av
10294	IF ( TRIM( variable(3:) ) == 'OC' ) to_be_resorted => s_OC_av
10295	IF ( TRIM( variable(3:) ) == 'SO4' ) to_be_resorted => s_SO4_av
10296	IF ( TRIM( variable(3:) ) == 'SS' ) to_be_resorted => s_SS_av
10297	ENDIF
10298
10299	CASE DEFAULT
10300	found = .FALSE.
10301
10302	END SELECT
10303
10304
10305	IF ( .NOT. resorted ) THEN
10306	IF ( .NOT. mask_surface(mid) ) THEN
10307	!
10308	!-- Default masked output
10309	DO i = 1, mask_size_l(mid,1)
10310	DO j = 1, mask_size_l(mid,2)
10311	DO k = 1, mask_size_l(mid,3)
10312	local_pf(i,j,k) = to_be_resorted( mask_k(mid,k), &
10313	mask_j(mid,j),mask_i(mid,i) )
10314	ENDDO
10315	ENDDO
10316	ENDDO
10317	ELSE
10318	!
10319	!-- Terrain-following masked output
10320	DO i = 1, mask_size_l(mid,1)
10321	DO j = 1, mask_size_l(mid,2)
10322	!
10323	!-- Get k index of highest horizontal surface
10324	topo_top_ind = get_topography_top_index_ji( mask_j(mid,j), &
10325	mask_i(mid,i), grid )
10326	!
10327	!-- Save output array
10328	DO k = 1, mask_size_l(mid,3)
10329	local_pf(i,j,k) = to_be_resorted( MIN( topo_top_ind+mask_k(mid,k),&
10330	nzt+1 ), &
10331	mask_j(mid,j), mask_i(mid,i) )
10332	ENDDO
10333	ENDDO
10334	ENDDO
10335	ENDIF
10336	ENDIF
10337
10338	END SUBROUTINE salsa_data_output_mask
10339
10340
10341	END MODULE salsa_mod

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

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |