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

Last change on this file since 4256 was 4256, checked in by monakurppa, 6 years ago

update test case urban_environment_salsa

  • Property svn:keywords set to Id
File size: 546.5 KB
Line 
1!> @file salsa_mod.f90
2!--------------------------------------------------------------------------------!
3! This file is part of PALM-4U.
4!
5! PALM-4U is free software: you can redistribute it and/or modify it under the
6! terms of the GNU General Public License as published by the Free Software
7! Foundation, either version 3 of the License, or (at your option) any later
8! version.
9!
10! PALM-4U is distributed in the hope that it will be useful, but WITHOUT ANY
11! WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
12! A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
13!
14! You should have received a copy of the GNU General Public License along with
15! PALM. If not, see <http://www.gnu.org/licenses/>.
16!
17! Copyright 2018-2019 University of Helsinki
18! Copyright 1997-2019 Leibniz Universitaet Hannover
19!--------------------------------------------------------------------------------!
20!
21! Current revisions:
22! -----------------
23!
24!
25! Former revisions:
26! -----------------
27! $Id: salsa_mod.f90 4256 2019-10-07 10:08:52Z monakurppa $
28! Document previous changes: use global variables nx, ny and nz in salsa_header
29!
30! 4255 2019-10-04 11:50:55Z monakurppa
31! implement new palm_date_time_mod
32!
33! 4226 2019-09-10 17:03:24Z suehring
34! Netcdf input routine for dimension length renamed
35!
36! 4182 2019-08-22 15:20:23Z scharf
37! Corrected "Former revisions" section
38!
39! 4167 2019-08-16 11:01:48Z suehring
40! Changed behaviour of masked output over surface to follow terrain and ignore
41! buildings (J.Resler, T.Gronemeier)
42!
43! 4131 2019-08-02 11:06:18Z monakurppa
44! - Add "salsa_" before each salsa output variable
45! - Add a possibility to output the number (salsa_N_UFP) and mass concentration
46!   (salsa_PM0.1) of ultrafine particles, i.e. particles with a diameter smaller
47!   than 100 nm
48! - Implement aerosol emission mode "parameterized" which is based on the street
49!   type (similar to the chemistry module).
50! - Remove unnecessary nucleation subroutines.
51! - Add the z-dimension for gaseous emissions to correspond the implementation
52!   in the chemistry module
53!
54! 4118 2019-07-25 16:11:45Z suehring
55! - When Dirichlet condition is applied in decycling, the boundary conditions are
56!   only set at the ghost points and not at the prognostic grid points as done
57!   before
58! - Rename decycle_ns/lr to decycle_salsa_ns/lr and decycle_method to
59!   decycle_method_salsa
60! - Allocation and initialization of special advection flags salsa_advc_flags_s
61!   used for salsa. These are exclusively used for salsa variables to
62!   distinguish from the usually-used flags which might be different when
63!   decycling is applied in combination with cyclic boundary conditions.
64!   Moreover, salsa_advc_flags_s considers extended zones around buildings where
65!   the first-order upwind scheme is applied for the horizontal advection terms.
66!   This is done to overcome high concentration peaks due to stationary numerical
67!   oscillations caused by horizontal advection discretization.
68!
69! 4117 2019-07-25 08:54:02Z monakurppa
70! Pass integer flag array as well as boundary flags to WS scalar advection
71! routine
72!
73! 4109 2019-07-22 17:00:34Z suehring
74! Slightly revise setting of boundary conditions at horizontal walls, use
75! data-structure offset index instead of pre-calculate it for each facing
76!
77! 4079 2019-07-09 18:04:41Z suehring
78! Application of monotonic flux limiter for the vertical scalar advection
79! up to the topography top (only for the cache-optimized version at the
80! moment).
81!
82! 4069 2019-07-01 14:05:51Z Giersch
83! Masked output running index mid has been introduced as a local variable to
84! avoid runtime error (Loop variable has been modified) in time_integration
85!
86! 4058 2019-06-27 15:25:42Z knoop
87! Bugfix: to_be_resorted was uninitialized in case of s_H2O in 3d_data_averaging
88!
89! 4012 2019-05-31 15:19:05Z monakurppa
90! Merge salsa branch to trunk. List of changes:
91! - Error corrected in distr_update that resulted in the aerosol number size
92!   distribution not converging if the concentration was nclim.
93! - Added a separate output for aerosol liquid water (s_H2O)
94! - aerosol processes for a size bin are now calculated only if the aerosol
95!   number of concentration of that bin is > 2*nclim
96! - An initialisation error in the subroutine "deposition" corrected and the
97!   subroutine reformatted.
98! - stuff from salsa_util_mod.f90 moved into salsa_mod.f90
99! - calls for closing the netcdf input files added
100!
101! 3956 2019-05-07 12:32:52Z monakurppa
102! - Conceptual bug in depo_surf correct for urban and land surface model
103! - Subroutine salsa_tendency_ij optimized.
104! - Interfaces salsa_non_advective_processes and salsa_exchange_horiz_bounds
105!   created. These are now called in module_interface.
106!   salsa_exchange_horiz_bounds after calling salsa_driver only when needed
107!   (i.e. every dt_salsa).
108!
109! 3924 2019-04-23 09:33:06Z monakurppa
110! Correct a bug introduced by the previous update.
111!
112! 3899 2019-04-16 14:05:27Z monakurppa
113! - remove unnecessary error / location messages
114! - corrected some error message numbers
115! - allocate source arrays only if emissions or dry deposition is applied.
116!
117! 3885 2019-04-11 11:29:34Z kanani
118! Changes related to global restructuring of location messages and introduction
119! of additional debug messages
120!
121! 3876 2019-04-08 18:41:49Z knoop
122! Introduced salsa_actions module interface
123!
124! 3871 2019-04-08 14:38:39Z knoop
125! Major changes in formatting, performance and data input structure (see branch
126! the history for details)
127! - Time-dependent emissions enabled: lod=1 for yearly PM emissions that are
128!   normalised depending on the time, and lod=2 for preprocessed emissions
129!   (similar to the chemistry module).
130! - Additionally, 'uniform' emissions allowed. This emission is set constant on
131!   all horisontal upward facing surfaces and it is created based on parameters
132!   surface_aerosol_flux, aerosol_flux_dpg/sigmag/mass_fracs_a/mass_fracs_b.
133! - All emissions are now implemented as surface fluxes! No 3D sources anymore.
134! - Update the emission information by calling salsa_emission_update if
135!   skip_time_do_salsa >= time_since_reference_point and
136!   next_aero_emission_update <= time_since_reference_point
137! - Aerosol background concentrations read from PIDS_DYNAMIC. The vertical grid
138!   must match the one applied in the model.
139! - Gas emissions and background concentrations can be also read in in salsa_mod
140!   if the chemistry module is not applied.
141! - In deposition, information on the land use type can be now imported from
142!   the land use model
143! - Use SI units in PARIN, i.e. n_lognorm given in #/m3 and dpg in metres.
144! - Apply 100 character line limit
145! - Change all variable names from capital to lowercase letter
146! - Change real exponents to integer if possible. If not, precalculate the value
147!   value of exponent
148! - Rename in1a to start_subrange_1a, fn2a to end_subrange_1a etc.
149! - Rename nbins --> nbins_aerosol, ncc_tot --> ncomponents_mass and ngast -->
150!   ngases_salsa
151! - Rename ibc to index_bc, idu to index_du etc.
152! - Renamed loop indices b, c and sg to ib, ic and ig
153! - run_salsa subroutine removed
154! - Corrected a bud in salsa_driver: falsely applied ino instead of inh
155! - Call salsa_tendency within salsa_prognostic_equations which is called in
156!   module_interface_mod instead of prognostic_equations_mod
157! - Removed tailing white spaces and unused variables
158! - Change error message to start by PA instead of SA
159!
160! 3833 2019-03-28 15:04:04Z forkel
161! added USE chem_gasphase_mod for nvar, nspec and spc_names
162!
163! 3787 2019-03-07 08:43:54Z raasch
164! unused variables removed
165!
166! 3780 2019-03-05 11:19:45Z forkel
167! unused variable for file index removed from rrd-subroutines parameter list
168!
169! 3685 2019-01-21 01:02:11Z knoop
170! Some interface calls moved to module_interface + cleanup
171!
172! 3655 2019-01-07 16:51:22Z knoop
173! Implementation of the PALM module interface
174! 3412 2018-10-24 07:25:57Z monakurppa
175!
176! Authors:
177! --------
178! @author Mona Kurppa (University of Helsinki)
179!
180!
181! Description:
182! ------------
183!> Sectional aerosol module for large scale applications SALSA
184!> (Kokkola et al., 2008, ACP 8, 2469-2483). Solves the aerosol number and mass
185!> concentration as well as chemical composition. Includes aerosol dynamic
186!> processes: nucleation, condensation/evaporation of vapours, coagulation and
187!> deposition on tree leaves, ground and roofs.
188!> Implementation is based on formulations implemented in UCLALES-SALSA except
189!> for deposition which is based on parametrisations by Zhang et al. (2001,
190!> Atmos. Environ. 35, 549-560) or Petroff&Zhang (2010, Geosci. Model Dev. 3,
191!> 753-769)
192!>
193!> @todo Apply information from emission_stack_height to lift emission sources
194!> @todo emission mode "parameterized", i.e. based on street type
195!> @todo Allow insoluble emissions
196!> @todo Apply flux limiter in prognostic equations
197!------------------------------------------------------------------------------!
198 MODULE salsa_mod
199
200    USE basic_constants_and_equations_mod,                                                         &
201        ONLY:  c_p, g, p_0, pi, r_d
202
203    USE chem_gasphase_mod,                                                                         &
204        ONLY:  nspec, nvar, spc_names
205
206    USE chem_modules,                                                                              &
207        ONLY:  call_chem_at_all_substeps, chem_gasphase_on, chem_species
208
209    USE control_parameters,                                                                        &
210        ONLY:  air_chemistry, bc_dirichlet_l, bc_dirichlet_n, bc_dirichlet_r, bc_dirichlet_s,      &
211               bc_lr, bc_lr_cyc, bc_ns, bc_ns_cyc, bc_radiation_l, bc_radiation_n, bc_radiation_r, &
212               bc_radiation_s, coupling_char, debug_output, dt_3d, intermediate_timestep_count,    &
213               intermediate_timestep_count_max, land_surface, max_pr_salsa, message_string,        &
214               monotonic_limiter_z, plant_canopy, pt_surface, salsa, scalar_advec,                 &
215               surface_pressure, time_since_reference_point, timestep_scheme, tsc, urban_surface,  &
216               ws_scheme_sca
217
218    USE indices,                                                                                   &
219        ONLY:  nbgp, nx, nxl, nxlg, nxr, nxrg, ny, nyn, nyng, nys, nysg, nzb, nz, nzt, wall_flags_0
220
221    USE kinds
222
223    USE netcdf_data_input_mod,                                                                     &
224        ONLY:  chem_emis_att_type, chem_emis_val_type
225
226    USE pegrid
227
228    USE statistics,                                                                                &
229        ONLY:  sums_salsa_ws_l
230
231    IMPLICIT NONE
232!
233!-- SALSA constants:
234!
235!-- Local constants:
236    INTEGER(iwp), PARAMETER ::  luc_urban = 15     !< default landuse type for urban
237    INTEGER(iwp), PARAMETER ::  ngases_salsa  = 5  !< total number of gaseous tracers:
238                                                   !< 1 = H2SO4, 2 = HNO3, 3 = NH3, 4 = OCNV
239                                                   !< (non-volatile OC), 5 = OCSV (semi-volatile)
240    INTEGER(iwp), PARAMETER ::  nmod = 7     !< number of modes for initialising the aerosol size
241                                             !< distribution
242    INTEGER(iwp), PARAMETER ::  nreg = 2     !< Number of main size subranges
243    INTEGER(iwp), PARAMETER ::  maxspec = 7  !< Max. number of aerosol species
244    INTEGER(iwp), PARAMETER ::  season = 1   !< For dry depostion by Zhang et al.: 1 = summer,
245                                             !< 2 = autumn (no harvest yet), 3 = late autumn
246                                             !< (already frost), 4 = winter, 5 = transitional spring
247
248    REAL(wp), PARAMETER ::  fill_value = -9999.0_wp    !< value for the _FillValue attribute
249!
250!-- Universal constants
251    REAL(wp), PARAMETER ::  abo    = 1.380662E-23_wp   !< Boltzmann constant (J/K)
252    REAL(wp), PARAMETER ::  alv    = 2.260E+6_wp       !< latent heat for H2O
253                                                       !< vaporisation (J/kg)
254    REAL(wp), PARAMETER ::  alv_d_rv  = 4896.96865_wp  !< alv / rv
255    REAL(wp), PARAMETER ::  am_airmol = 4.8096E-26_wp  !< Average mass of one air
256                                                       !< molecule (Jacobson,
257                                                       !< 2005, Eq. 2.3)
258    REAL(wp), PARAMETER ::  api6   = 0.5235988_wp      !< pi / 6
259    REAL(wp), PARAMETER ::  argas  = 8.314409_wp       !< Gas constant (J/(mol K))
260    REAL(wp), PARAMETER ::  argas_d_cpd = 8.281283865E-3_wp  !< argas per cpd
261    REAL(wp), PARAMETER ::  avo    = 6.02214E+23_wp    !< Avogadro constant (1/mol)
262    REAL(wp), PARAMETER ::  d_sa   = 5.539376964394570E-10_wp  !< diameter of condensing sulphuric
263                                                               !< acid molecule (m)
264    REAL(wp), PARAMETER ::  for_ppm_to_nconc =  7.243016311E+16_wp !< ppm * avo / R (K/(Pa*m3))
265    REAL(wp), PARAMETER ::  epsoc  = 0.15_wp          !< water uptake of organic
266                                                      !< material
267    REAL(wp), PARAMETER ::  mclim  = 1.0E-23_wp       !< mass concentration min limit (kg/m3)
268    REAL(wp), PARAMETER ::  n3     = 158.79_wp        !< Number of H2SO4 molecules in 3 nm cluster
269                                                      !< if d_sa=5.54e-10m
270    REAL(wp), PARAMETER ::  nclim  = 1.0_wp           !< number concentration min limit (#/m3)
271    REAL(wp), PARAMETER ::  surfw0 = 0.073_wp         !< surface tension of water at 293 K (J/m2)
272!
273!-- Molar masses in kg/mol
274    REAL(wp), PARAMETER ::  ambc     = 12.0E-3_wp     !< black carbon (BC)
275    REAL(wp), PARAMETER ::  amdair   = 28.970E-3_wp   !< dry air
276    REAL(wp), PARAMETER ::  amdu     = 100.E-3_wp     !< mineral dust
277    REAL(wp), PARAMETER ::  amh2o    = 18.0154E-3_wp  !< H2O
278    REAL(wp), PARAMETER ::  amh2so4  = 98.06E-3_wp    !< H2SO4
279    REAL(wp), PARAMETER ::  amhno3   = 63.01E-3_wp    !< HNO3
280    REAL(wp), PARAMETER ::  amn2o    = 44.013E-3_wp   !< N2O
281    REAL(wp), PARAMETER ::  amnh3    = 17.031E-3_wp   !< NH3
282    REAL(wp), PARAMETER ::  amo2     = 31.9988E-3_wp  !< O2
283    REAL(wp), PARAMETER ::  amo3     = 47.998E-3_wp   !< O3
284    REAL(wp), PARAMETER ::  amoc     = 150.E-3_wp     !< organic carbon (OC)
285    REAL(wp), PARAMETER ::  amss     = 58.44E-3_wp    !< sea salt (NaCl)
286!
287!-- Densities in kg/m3
288    REAL(wp), PARAMETER ::  arhobc     = 2000.0_wp  !< black carbon
289    REAL(wp), PARAMETER ::  arhodu     = 2650.0_wp  !< mineral dust
290    REAL(wp), PARAMETER ::  arhoh2o    = 1000.0_wp  !< H2O
291    REAL(wp), PARAMETER ::  arhoh2so4  = 1830.0_wp  !< SO4
292    REAL(wp), PARAMETER ::  arhohno3   = 1479.0_wp  !< HNO3
293    REAL(wp), PARAMETER ::  arhonh3    = 1530.0_wp  !< NH3
294    REAL(wp), PARAMETER ::  arhooc     = 2000.0_wp  !< organic carbon
295    REAL(wp), PARAMETER ::  arhoss     = 2165.0_wp  !< sea salt (NaCl)
296!
297!-- Volume of molecule in m3/#
298    REAL(wp), PARAMETER ::  amvh2o   = amh2o /avo / arhoh2o      !< H2O
299    REAL(wp), PARAMETER ::  amvh2so4 = amh2so4 / avo / arhoh2so4 !< SO4
300    REAL(wp), PARAMETER ::  amvhno3  = amhno3 / avo / arhohno3   !< HNO3
301    REAL(wp), PARAMETER ::  amvnh3   = amnh3 / avo / arhonh3     !< NH3
302    REAL(wp), PARAMETER ::  amvoc    = amoc / avo / arhooc       !< OC
303    REAL(wp), PARAMETER ::  amvss    = amss / avo / arhoss       !< sea salt
304!
305!-- Constants for the dry deposition model by Petroff and Zhang (2010):
306!-- obstacle characteristic dimension "L" (cm) (plane obstacle by default) and empirical constants
307!-- C_B, C_IN, C_IM, beta_IM and C_IT for each land use category (15, as in Zhang et al. (2001))
308    REAL(wp), DIMENSION(1:15), PARAMETER :: l_p10 = &
309        (/0.15,  4.0,   0.15,  3.0,   3.0,   0.5,   3.0,   -99., 0.5,  2.0,  1.0,   -99., -99., -99., 3.0/)
310    REAL(wp), DIMENSION(1:15), PARAMETER :: c_b_p10 = &
311        (/0.887, 1.262, 0.887, 1.262, 1.262, 0.996, 0.996, -99., 0.7,  0.93, 0.996, -99., -99., -99., 1.262/)
312    REAL(wp), DIMENSION(1:15), PARAMETER :: c_in_p10 = &
313        (/0.81,  0.216, 0.81,  0.216, 0.216, 0.191, 0.162, -99., 0.7,  0.14, 0.162, -99., -99., -99., 0.216/)
314    REAL(wp), DIMENSION(1:15), PARAMETER :: c_im_p10 = &
315        (/0.162, 0.13,  0.162, 0.13,  0.13,  0.191, 0.081, -99., 0.191,0.086,0.081, -99., -99., -99., 0.13/)
316    REAL(wp), DIMENSION(1:15), PARAMETER :: beta_im_p10 = &
317        (/0.6,   0.47,  0.6,   0.47,  0.47,  0.47,  0.47,  -99., 0.6,  0.47, 0.47,  -99., -99., -99., 0.47/)
318    REAL(wp), DIMENSION(1:15), PARAMETER :: c_it_p10 = &
319        (/0.0,   0.056, 0.0,   0.056, 0.056, 0.042, 0.056, -99., 0.042,0.014,0.056, -99., -99., -99., 0.056/)
320!
321!-- Constants for the dry deposition model by Zhang et al. (2001):
322!-- empirical constants "alpha" and "gamma" and characteristic radius "A" for
323!-- each land use category (15) and season (5)
324    REAL(wp), DIMENSION(1:15), PARAMETER :: alpha_z01 = &
325        (/1.0, 0.6, 1.1, 0.8, 0.8, 1.2, 1.2, 50.0, 50.0, 1.3, 2.0, 50.0, 100.0, 100.0, 1.5/)
326    REAL(wp), DIMENSION(1:15), PARAMETER :: gamma_z01 = &
327        (/0.56, 0.58, 0.56, 0.56, 0.56, 0.54, 0.54, 0.54, 0.54, 0.54, 0.54, 0.54, 0.50, 0.50, 0.56/)
328    REAL(wp), DIMENSION(1:15,1:5), PARAMETER :: A_z01 =  RESHAPE( (/& 
329         2.0, 5.0, 2.0,  5.0, 5.0, 2.0, 2.0, -99., -99., 10.0, 10.0, -99., -99., -99., 10.0,&  ! SC1
330         2.0, 5.0, 2.0,  5.0, 5.0, 2.0, 2.0, -99., -99., 10.0, 10.0, -99., -99., -99., 10.0,&  ! SC2
331         2.0, 5.0, 5.0, 10.0, 5.0, 5.0, 5.0, -99., -99., 10.0, 10.0, -99., -99., -99., 10.0,&  ! SC3
332         2.0, 5.0, 5.0, 10.0, 5.0, 5.0, 5.0, -99., -99., 10.0, 10.0, -99., -99., -99., 10.0,&  ! SC4
333         2.0, 5.0, 2.0,  5.0, 5.0, 2.0, 2.0, -99., -99., 10.0, 10.0, -99., -99., -99., 10.0 &  ! SC5
334                                                           /), (/ 15, 5 /) )
335!-- Land use categories (based on Z01 but the same applies here also for P10):
336!-- 1 = evergreen needleleaf trees,
337!-- 2 = evergreen broadleaf trees,
338!-- 3 = deciduous needleleaf trees,
339!-- 4 = deciduous broadleaf trees,
340!-- 5 = mixed broadleaf and needleleaf trees (deciduous broadleaf trees for P10),
341!-- 6 = grass (short grass for P10),
342!-- 7 = crops, mixed farming,
343!-- 8 = desert,
344!-- 9 = tundra,
345!-- 10 = shrubs and interrupted woodlands (thorn shrubs for P10),
346!-- 11 = wetland with plants (long grass for P10)
347!-- 12 = ice cap and glacier,
348!-- 13 = inland water (inland lake for P10)
349!-- 14 = ocean (water for P10),
350!-- 15 = urban
351!
352!-- SALSA variables:
353    CHARACTER(LEN=20)  ::  bc_salsa_b = 'neumann'                 !< bottom boundary condition
354    CHARACTER(LEN=20)  ::  bc_salsa_t = 'neumann'                 !< top boundary condition
355    CHARACTER(LEN=20)  ::  depo_pcm_par = 'zhang2001'             !< or 'petroff2010'
356    CHARACTER(LEN=20)  ::  depo_pcm_type = 'deciduous_broadleaf'  !< leaf type
357    CHARACTER(LEN=20)  ::  depo_surf_par = 'zhang2001'            !< or 'petroff2010'
358    CHARACTER(LEN=100) ::  input_file_dynamic = 'PIDS_DYNAMIC'    !< file name for dynamic input
359    CHARACTER(LEN=100) ::  input_file_salsa   = 'PIDS_SALSA'      !< file name for emission data
360    CHARACTER(LEN=20)  ::  salsa_emission_mode = 'no_emission'    !< 'no_emission', 'uniform',
361                                                                  !< 'parameterized', 'read_from_file'
362
363    CHARACTER(LEN=20), DIMENSION(4) ::  decycle_method_salsa =                                     &
364                                                 (/'dirichlet','dirichlet','dirichlet','dirichlet'/)
365                                     !< Decycling method at horizontal boundaries
366                                     !< 1=left, 2=right, 3=south, 4=north
367                                     !< dirichlet = initial profiles for the ghost and first 3 layers
368                                     !< neumann = zero gradient
369
370    CHARACTER(LEN=3), DIMENSION(maxspec) ::  listspec = &  !< Active aerosols
371                                   (/'SO4','   ','   ','   ','   ','   ','   '/)
372
373    INTEGER(iwp) ::  depo_pcm_par_num = 1   !< parametrisation type: 1=zhang2001, 2=petroff2010
374    INTEGER(iwp) ::  depo_pcm_type_num = 0  !< index for the dry deposition type on the plant canopy
375    INTEGER(iwp) ::  depo_surf_par_num = 1  !< parametrisation type: 1=zhang2001, 2=petroff2010
376    INTEGER(iwp) ::  dots_salsa = 0         !< starting index for salsa-timeseries
377    INTEGER(iwp) ::  end_subrange_1a = 1    !< last index for bin subrange 1a
378    INTEGER(iwp) ::  end_subrange_2a = 1    !< last index for bin subrange 2a
379    INTEGER(iwp) ::  end_subrange_2b = 1    !< last index for bin subrange 2b
380    INTEGER(iwp) ::  ibc_salsa_b            !< index for the bottom boundary condition
381    INTEGER(iwp) ::  ibc_salsa_t            !< index for the top boundary condition
382    INTEGER(iwp) ::  index_bc  = -1         !< index for black carbon (BC)
383    INTEGER(iwp) ::  index_du  = -1         !< index for dust
384    INTEGER(iwp) ::  index_nh  = -1         !< index for NH3
385    INTEGER(iwp) ::  index_no  = -1         !< index for HNO3
386    INTEGER(iwp) ::  index_oc  = -1         !< index for organic carbon (OC)
387    INTEGER(iwp) ::  index_so4 = -1         !< index for SO4 or H2SO4
388    INTEGER(iwp) ::  index_ss  = -1         !< index for sea salt
389    INTEGER(iwp) ::  init_aerosol_type = 0  !< Initial size distribution type
390                                            !< 0 = uniform (read from PARIN)
391                                            !< 1 = read vertical profile of the mode number
392                                            !<     concentration from an input file
393    INTEGER(iwp) ::  init_gases_type = 0    !< Initial gas concentration type
394                                            !< 0 = uniform (read from PARIN)
395                                            !< 1 = read vertical profile from an input file
396    INTEGER(iwp) ::  lod_gas_emissions = 0  !< level of detail of the gaseous emission data
397    INTEGER(iwp) ::  main_street_id = 0     !< lower bound of main street IDs (OpenStreetMaps) for parameterized mode
398    INTEGER(iwp) ::  max_street_id = 0      !< upper bound of main street IDs (OpenStreetMaps) for parameterized mode
399    INTEGER(iwp) ::  nbins_aerosol = 1      !< total number of size bins
400    INTEGER(iwp) ::  ncc   = 1              !< number of chemical components used
401    INTEGER(iwp) ::  ncomponents_mass = 1   !< total number of chemical compounds (ncc+1)
402                                            !< if particle water is advected)
403    INTEGER(iwp) ::  nj3 = 1                !< J3 parametrization (nucleation)
404                                            !< 1 = condensational sink (Kerminen&Kulmala, 2002)
405                                            !< 2 = coagulational sink (Lehtinen et al. 2007)
406                                            !< 3 = coagS+self-coagulation (Anttila et al. 2010)
407    INTEGER(iwp) ::  nsnucl = 0             !< Choice of the nucleation scheme:
408                                            !< 0 = off
409                                            !< 1 = binary nucleation
410                                            !< 2 = activation type nucleation
411                                            !< 3 = kinetic nucleation
412                                            !< 4 = ternary nucleation
413                                            !< 5 = nucleation with ORGANICs
414                                            !< 6 = activation type of nucleation with H2SO4+ORG
415                                            !< 7 = heteromolecular nucleation with H2SO4*ORG
416                                            !< 8 = homomolecular nucleation of H2SO4
417                                            !<     + heteromolecular nucleation with H2SO4*ORG
418                                            !< 9 = homomolecular nucleation of H2SO4 and ORG
419                                            !<     + heteromolecular nucleation with H2SO4*ORG
420    INTEGER(iwp) ::  salsa_pr_count = 0     !< counter for salsa variable profiles
421    INTEGER(iwp) ::  side_street_id = 0     !< lower bound of side street IDs (OpenStreetMaps) for parameterized mode
422    INTEGER(iwp) ::  start_subrange_1a = 1  !< start index for bin subranges: subrange 1a
423    INTEGER(iwp) ::  start_subrange_2a = 1  !<                                subrange 2a
424    INTEGER(iwp) ::  start_subrange_2b = 1  !<                                subrange 2b
425
426    INTEGER(iwp), DIMENSION(nreg) ::  nbin = (/ 3, 7/)  !< Number of size bins per subrange: 1 & 2
427
428    INTEGER(iwp), DIMENSION(ngases_salsa) ::  gas_index_chem = (/ 1, 1, 1, 1, 1/)  !< gas indices in chemistry_model_mod
429                                                                                   !< 1 = H2SO4, 2 = HNO3,
430                                                                                   !< 3 = NH3,   4 = OCNV, 5 = OCSV
431    INTEGER(iwp), DIMENSION(ngases_salsa) ::  emission_index_chem  !< gas indices in the gas emission file
432    INTEGER(iwp), DIMENSION(99) ::  salsa_pr_index  = 0            !< index for salsa profiles
433
434    INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE ::  k_topo_top  !< vertical index of the topography top
435
436    INTEGER(iwp), DIMENSION(:,:,:), ALLOCATABLE  ::  salsa_advc_flags_s !< flags used to degrade order of advection
437                                                                        !< scheme for salsa variables near walls and
438                                                                        !< lateral boundaries
439!
440!-- SALSA switches:
441    LOGICAL ::  advect_particle_water   = .TRUE.   !< Advect water concentration of particles
442    LOGICAL ::  decycle_salsa_lr        = .FALSE.  !< Undo cyclic boundaries: left and right
443    LOGICAL ::  decycle_salsa_ns        = .FALSE.  !< Undo cyclic boundaries: north and south
444    LOGICAL ::  include_emission        = .FALSE.  !< Include or not emissions
445    LOGICAL ::  feedback_to_palm        = .FALSE.  !< Allow feedback due to condensation of H2O
446    LOGICAL ::  nest_salsa              = .FALSE.  !< Apply nesting for salsa
447    LOGICAL ::  no_insoluble            = .FALSE.  !< Exclude insoluble chemical components
448    LOGICAL ::  read_restart_data_salsa = .FALSE.  !< Read restart data for salsa
449    LOGICAL ::  salsa_gases_from_chem   = .FALSE.  !< Transfer the gaseous components to SALSA from
450                                                   !< the chemistry model
451    LOGICAL ::  van_der_waals_coagc     = .FALSE.  !< Enhancement of coagulation kernel by van der
452                                                   !< Waals and viscous forces
453    LOGICAL ::  write_binary_salsa      = .FALSE.  !< read binary for salsa
454!
455!-- Process switches: nl* is read from the NAMELIST and is NOT changed.
456!--                   ls* is the switch used and will get the value of nl*
457!--                       except for special circumstances (spinup period etc.)
458    LOGICAL ::  nlcoag       = .FALSE.  !< Coagulation master switch
459    LOGICAL ::  lscoag       = .FALSE.  !<
460    LOGICAL ::  nlcnd        = .FALSE.  !< Condensation master switch
461    LOGICAL ::  lscnd        = .FALSE.  !<
462    LOGICAL ::  nlcndgas     = .FALSE.  !< Condensation of precursor gases
463    LOGICAL ::  lscndgas     = .FALSE.  !<
464    LOGICAL ::  nlcndh2oae   = .FALSE.  !< Condensation of H2O on aerosol
465    LOGICAL ::  lscndh2oae   = .FALSE.  !< particles (FALSE -> equilibrium calc.)
466    LOGICAL ::  nldepo       = .FALSE.  !< Deposition master switch
467    LOGICAL ::  lsdepo       = .FALSE.  !<
468    LOGICAL ::  nldepo_surf  = .FALSE.  !< Deposition on vegetation master switch
469    LOGICAL ::  lsdepo_surf  = .FALSE.  !<
470    LOGICAL ::  nldepo_pcm   = .FALSE.  !< Deposition on walls master switch
471    LOGICAL ::  lsdepo_pcm   = .FALSE.  !<
472    LOGICAL ::  nldistupdate = .TRUE.   !< Size distribution update master switch
473    LOGICAL ::  lsdistupdate = .FALSE.  !<
474    LOGICAL ::  lspartition  = .FALSE.  !< Partition of HNO3 and NH3
475
476    REAL(wp) ::  act_coeff = 1.0E-7_wp               !< Activation coefficient (1/s)
477    REAL(wp) ::  dt_salsa  = 0.00001_wp              !< Time step of SALSA
478    REAL(wp) ::  emiss_factor_main = 0.0_wp          !< relative emission factor for main streets
479    REAL(wp) ::  emiss_factor_side = 0.0_wp          !< relative emission factor for side streets
480    REAL(wp) ::  h2so4_init = nclim                  !< Init value for sulphuric acid gas
481    REAL(wp) ::  hno3_init  = nclim                  !< Init value for nitric acid gas
482    REAL(wp) ::  last_salsa_time = 0.0_wp            !< previous salsa call
483    REAL(wp) ::  next_aero_emission_update = 0.0_wp  !< previous emission update
484    REAL(wp) ::  next_gas_emission_update = 0.0_wp   !< previous emission update
485    REAL(wp) ::  nf2a = 1.0_wp                       !< Number fraction allocated to 2a-bins
486    REAL(wp) ::  nh3_init  = nclim                   !< Init value for ammonia gas
487    REAL(wp) ::  ocnv_init = nclim                   !< Init value for non-volatile organic gases
488    REAL(wp) ::  ocsv_init = nclim                   !< Init value for semi-volatile organic gases
489    REAL(wp) ::  rhlim = 1.20_wp                     !< RH limit in %/100. Prevents unrealistical RH
490    REAL(wp) ::  skip_time_do_salsa = 0.0_wp         !< Starting time of SALSA (s)
491!
492!-- Initial log-normal size distribution: mode diameter (dpg, metres),
493!-- standard deviation (sigmag) and concentration (n_lognorm, #/m3)
494    REAL(wp), DIMENSION(nmod) ::  dpg   = &
495                     (/1.3E-8_wp, 5.4E-8_wp, 8.6E-7_wp, 2.0E-7_wp, 2.0E-7_wp, 2.0E-7_wp, 2.0E-7_wp/)
496    REAL(wp), DIMENSION(nmod) ::  sigmag  = &
497                                        (/1.8_wp, 2.16_wp, 2.21_wp, 2.0_wp, 2.0_wp, 2.0_wp, 2.0_wp/)
498    REAL(wp), DIMENSION(nmod) ::  n_lognorm = &
499                             (/1.04e+11_wp, 3.23E+10_wp, 5.4E+6_wp, 0.0_wp, 0.0_wp, 0.0_wp, 0.0_wp/)
500!
501!-- Initial mass fractions / chemical composition of the size distribution
502    REAL(wp), DIMENSION(maxspec) ::  mass_fracs_a = & !< mass fractions between
503             (/1.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0/) !< aerosol species for A bins
504    REAL(wp), DIMENSION(maxspec) ::  mass_fracs_b = & !< mass fractions between
505             (/0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0/) !< aerosol species for B bins
506    REAL(wp), DIMENSION(nreg+1) ::  reglim = & !< Min&max diameters of size subranges
507                                 (/ 3.0E-9_wp, 5.0E-8_wp, 1.0E-5_wp/)
508!
509!-- Initial log-normal size distribution: mode diameter (dpg, metres), standard deviation (sigmag)
510!-- concentration (n_lognorm, #/m3) and mass fractions of all chemical components (listed in
511!-- listspec) for both a (soluble) and b (insoluble) bins.
512    REAL(wp), DIMENSION(nmod) ::  aerosol_flux_dpg   = &
513                     (/1.3E-8_wp, 5.4E-8_wp, 8.6E-7_wp, 2.0E-7_wp, 2.0E-7_wp, 2.0E-7_wp, 2.0E-7_wp/)
514    REAL(wp), DIMENSION(nmod) ::  aerosol_flux_sigmag  = &
515                                        (/1.8_wp, 2.16_wp, 2.21_wp, 2.0_wp, 2.0_wp, 2.0_wp, 2.0_wp/)
516    REAL(wp), DIMENSION(maxspec) ::  aerosol_flux_mass_fracs_a = &
517                                                               (/1.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0/)
518    REAL(wp), DIMENSION(maxspec) ::  aerosol_flux_mass_fracs_b = &
519                                                               (/0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0/)
520    REAL(wp), DIMENSION(nmod) ::  surface_aerosol_flux = &
521                                 (/1.0E+8_wp, 1.0E+9_wp, 1.0E+5_wp, 0.0_wp, 0.0_wp, 0.0_wp, 0.0_wp/)
522
523    REAL(wp), DIMENSION(:), ALLOCATABLE ::  bin_low_limits     !< to deliver information about
524                                                               !< the lower diameters per bin
525    REAL(wp), DIMENSION(:), ALLOCATABLE ::  bc_am_t_val        !< vertical gradient of: aerosol mass
526    REAL(wp), DIMENSION(:), ALLOCATABLE ::  bc_an_t_val        !< of: aerosol number
527    REAL(wp), DIMENSION(:), ALLOCATABLE ::  bc_gt_t_val        !< salsa gases near domain top
528    REAL(wp), DIMENSION(:), ALLOCATABLE ::  gas_emission_time  !< Time array in gas emission data (s)
529    REAL(wp), DIMENSION(:), ALLOCATABLE ::  nsect              !< Background number concentrations
530    REAL(wp), DIMENSION(:), ALLOCATABLE ::  massacc            !< Mass accomodation coefficients
531!
532!-- SALSA derived datatypes:
533!
534!-- Component index
535    TYPE component_index
536       CHARACTER(len=3), ALLOCATABLE ::  comp(:)  !< Component name
537       INTEGER(iwp) ::  ncomp  !< Number of components
538       INTEGER(iwp), ALLOCATABLE ::  ind(:)  !< Component index
539    END TYPE component_index
540!
541!-- For matching LSM and USM surface types and the deposition module surface types
542    TYPE match_surface
543       INTEGER(iwp), DIMENSION(:), ALLOCATABLE ::  match_lupg  !< index for pavement / green roofs
544       INTEGER(iwp), DIMENSION(:), ALLOCATABLE ::  match_luvw  !< index for vegetation / walls
545       INTEGER(iwp), DIMENSION(:), ALLOCATABLE ::  match_luww  !< index for water / windows
546    END TYPE match_surface
547!
548!-- Aerosol emission data attributes
549    TYPE salsa_emission_attribute_type
550
551       CHARACTER(LEN=25) ::   units
552
553       CHARACTER(LEN=25), DIMENSION(:), ALLOCATABLE ::   cat_name    !<
554       CHARACTER(LEN=25), DIMENSION(:), ALLOCATABLE ::   cc_name     !<
555       CHARACTER(LEN=25), DIMENSION(:), ALLOCATABLE ::   unit_time   !<
556       CHARACTER(LEN=100), DIMENSION(:), ALLOCATABLE ::  var_names   !<
557
558       INTEGER(iwp) ::  lod = 0            !< level of detail
559       INTEGER(iwp) ::  nbins = 10         !< number of aerosol size bins
560       INTEGER(iwp) ::  ncat  = 0          !< number of emission categories
561       INTEGER(iwp) ::  ncc   = 7          !< number of aerosol chemical components
562       INTEGER(iwp) ::  nhoursyear = 0     !< number of hours: HOURLY mode
563       INTEGER(iwp) ::  nmonthdayhour = 0  !< number of month days and hours: MDH mode
564       INTEGER(iwp) ::  num_vars           !< number of variables
565       INTEGER(iwp) ::  nt  = 0            !< number of time steps
566       INTEGER(iwp) ::  nz  = 0            !< number of vertical levels
567       INTEGER(iwp) ::  tind               !< time index for reference time in salsa emission data
568
569       INTEGER(iwp), DIMENSION(maxspec) ::  cc_in2mod = 0   !<
570
571       INTEGER(iwp), DIMENSION(:), ALLOCATABLE ::  cat_index  !< Index of emission categories
572       INTEGER(iwp), DIMENSION(:), ALLOCATABLE ::  cc_index   !< Index of chemical components
573
574       REAL(wp) ::  conversion_factor  !< unit conversion factor for aerosol emissions
575
576       REAL(wp), DIMENSION(:), ALLOCATABLE ::  dmid         !< mean diameters of size bins (m)
577       REAL(wp), DIMENSION(:), ALLOCATABLE ::  rho          !< average density (kg/m3)
578       REAL(wp), DIMENSION(:), ALLOCATABLE ::  time         !< time (s)
579       REAL(wp), DIMENSION(:), ALLOCATABLE ::  time_factor  !< emission time factor
580       REAL(wp), DIMENSION(:), ALLOCATABLE ::  z            !< height (m)
581
582       REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  etf  !< emission time factor
583       REAL(wp), DIMENSION(:,:), ALLOCATABLE :: stack_height
584
585    END TYPE salsa_emission_attribute_type
586!
587!-- The default size distribution and mass composition per emission category:
588!-- 1 = traffic, 2 = road dust, 3 = wood combustion, 4 = other
589!-- Mass fractions: H2SO4, OC, BC, DU, SS, HNO3, NH3
590    TYPE salsa_emission_mode_type
591
592       INTEGER(iwp) ::  ndm = 3  !< number of default modes
593       INTEGER(iwp) ::  ndc = 4  !< number of default categories
594
595       CHARACTER(LEN=25), DIMENSION(1:4) ::  cat_name_table = (/'traffic exhaust', &
596                                                                'road dust      ', &
597                                                                'wood combustion', &
598                                                                'other          '/)
599
600       INTEGER(iwp), DIMENSION(1:4) ::  cat_input_to_model   !<
601
602       REAL(wp), DIMENSION(1:3) ::  dpg_table = (/ 13.5E-9_wp, 1.4E-6_wp, 5.4E-8_wp/)  !<
603       REAL(wp), DIMENSION(1:3) ::  ntot_table  !<
604       REAL(wp), DIMENSION(1:3) ::  sigmag_table = (/ 1.6_wp, 1.4_wp, 1.7_wp /)  !<
605
606       REAL(wp), DIMENSION(1:maxspec,1:4) ::  mass_frac_table = &  !<
607          RESHAPE( (/ 0.04_wp, 0.48_wp, 0.48_wp, 0.0_wp,  0.0_wp, 0.0_wp, 0.0_wp, &
608                      0.0_wp,  0.05_wp, 0.0_wp,  0.95_wp, 0.0_wp, 0.0_wp, 0.0_wp, &
609                      0.0_wp,  0.5_wp,  0.5_wp,  0.0_wp,  0.0_wp, 0.0_wp, 0.0_wp, &
610                      0.0_wp,  0.5_wp,  0.5_wp,  0.0_wp,  0.0_wp, 0.0_wp, 0.0_wp  &
611                   /), (/maxspec,4/) )
612
613       REAL(wp), DIMENSION(1:3,1:4) ::  pm_frac_table = & !< rel. mass
614                                     RESHAPE( (/ 0.016_wp, 0.000_wp, 0.984_wp, &
615                                                 0.000_wp, 1.000_wp, 0.000_wp, &
616                                                 0.000_wp, 0.000_wp, 1.000_wp, &
617                                                 1.000_wp, 0.000_wp, 1.000_wp  &
618                                              /), (/3,4/) )
619
620    END TYPE salsa_emission_mode_type
621!
622!-- Aerosol emission data values
623    TYPE salsa_emission_value_type
624
625       REAL(wp) ::  fill  !< fill value
626
627       REAL(wp), DIMENSION(:), ALLOCATABLE :: preproc_mass_fracs  !< mass fractions
628
629       REAL(wp), DIMENSION(:,:), ALLOCATABLE :: def_mass_fracs  !< mass fractions per emis. category
630
631       REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: def_data      !< surface emission values in PM
632       REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: preproc_data  !< surface emission values per bin
633
634    END TYPE salsa_emission_value_type
635!
636!-- Prognostic variable: Aerosol size bin information (number (#/m3) and mass (kg/m3) concentration)
637!-- and the concentration of gaseous tracers (#/m3). Gas tracers are contained sequentially in
638!-- dimension 4 as:
639!-- 1. H2SO4, 2. HNO3, 3. NH3, 4. OCNV (non-volatile organics), 5. OCSV (semi-volatile)
640    TYPE salsa_variable
641
642       REAL(wp), DIMENSION(:), ALLOCATABLE     ::  init  !<
643
644       REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  diss_s     !<
645       REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  flux_s     !<
646       REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  source     !<
647       REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  sums_ws_l  !<
648
649       REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  diss_l  !<
650       REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  flux_l  !<
651
652       REAL(wp), DIMENSION(:,:,:), POINTER, CONTIGUOUS ::  conc     !<
653       REAL(wp), DIMENSION(:,:,:), POINTER, CONTIGUOUS ::  conc_p   !<
654       REAL(wp), DIMENSION(:,:,:), POINTER, CONTIGUOUS ::  tconc_m  !<
655
656    END TYPE salsa_variable
657!
658!-- Datatype used to store information about the binned size distributions of aerosols
659    TYPE t_section
660
661       REAL(wp) ::  dmid     !< bin middle diameter (m)
662       REAL(wp) ::  vhilim   !< bin volume at the high limit
663       REAL(wp) ::  vlolim   !< bin volume at the low limit
664       REAL(wp) ::  vratiohi !< volume ratio between the center and high limit
665       REAL(wp) ::  vratiolo !< volume ratio between the center and low limit
666       !******************************************************
667       ! ^ Do NOT change the stuff above after initialization !
668       !******************************************************
669       REAL(wp) ::  core    !< Volume of dry particle
670       REAL(wp) ::  dwet    !< Wet diameter or mean droplet diameter (m)
671       REAL(wp) ::  numc    !< Number concentration of particles/droplets (#/m3)
672       REAL(wp) ::  veqh2o  !< Equilibrium H2O concentration for each particle
673
674       REAL(wp), DIMENSION(maxspec+1) ::  volc !< Volume concentrations (m^3/m^3) of aerosols +
675                                               !< water. Since most of the stuff in SALSA is hard
676                                               !< coded, these *have to be* in the order
677                                               !< 1:SO4, 2:OC, 3:BC, 4:DU, 5:SS, 6:NO, 7:NH, 8:H2O
678    END TYPE t_section
679
680    TYPE(salsa_emission_attribute_type) ::  aero_emission_att  !< emission attributes
681    TYPE(salsa_emission_value_type)     ::  aero_emission      !< emission values
682    TYPE(salsa_emission_mode_type)      ::  def_modes          !< default emission modes
683
684    TYPE(chem_emis_att_type) ::  chem_emission_att  !< chemistry emission attributes
685
686    TYPE(chem_emis_val_type), DIMENSION(:), ALLOCATABLE ::  chem_emission  !< chemistry emissions
687
688    TYPE(t_section), DIMENSION(:), ALLOCATABLE ::  aero  !< local aerosol properties
689
690    TYPE(match_surface) ::  lsm_to_depo_h  !< to match the deposition module and horizontal LSM surfaces
691    TYPE(match_surface) ::  usm_to_depo_h  !< to match the deposition module and horizontal USM surfaces
692
693    TYPE(match_surface), DIMENSION(0:3) ::  lsm_to_depo_v  !< to match the deposition mod. and vertical LSM surfaces
694    TYPE(match_surface), DIMENSION(0:3) ::  usm_to_depo_v  !< to match the deposition mod. and vertical USM surfaces
695!
696!-- SALSA variables: as x = x(k,j,i,bin).
697!-- The 4th dimension contains all the size bins sequentially for each aerosol species  + water.
698!
699!-- Prognostic variables:
700!
701!-- Number concentration (#/m3)
702    TYPE(salsa_variable), DIMENSION(:), ALLOCATABLE, TARGET ::  aerosol_number  !<
703    REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE, TARGET ::  nconc_1  !<
704    REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE, TARGET ::  nconc_2  !<
705    REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE, TARGET ::  nconc_3  !<
706!
707!-- Mass concentration (kg/m3)
708    TYPE(salsa_variable), DIMENSION(:), ALLOCATABLE, TARGET ::  aerosol_mass  !<
709    REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE, TARGET ::  mconc_1  !<
710    REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE, TARGET ::  mconc_2  !<
711    REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE, TARGET ::  mconc_3  !<
712!
713!-- Gaseous concentrations (#/m3)
714    TYPE(salsa_variable), DIMENSION(:), ALLOCATABLE, TARGET ::  salsa_gas  !<
715    REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE, TARGET ::  gconc_1  !<
716    REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE, TARGET ::  gconc_2  !<
717    REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE, TARGET ::  gconc_3  !<
718!
719!-- Diagnostic tracers
720    REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE ::  sedim_vd  !< sedimentation velocity per bin (m/s)
721    REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE ::  ra_dry    !< aerosol dry radius (m)
722
723!-- Particle component index tables
724    TYPE(component_index) :: prtcl  !< Contains "getIndex" which gives the index for a given aerosol
725                                    !< component name: 1:SO4, 2:OC, 3:BC, 4:DU, 5:SS, 6:NO, 7:NH, 8:H2O
726!
727!-- Data output arrays:
728!
729!-- Gases:
730    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  g_h2so4_av  !< H2SO4
731    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  g_hno3_av   !< HNO3
732    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  g_nh3_av    !< NH3
733    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  g_ocnv_av   !< non-volatile OC
734    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  g_ocsv_av   !< semi-volatile OC
735!
736!-- Integrated:
737    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  ldsa_av  !< lung-deposited surface area
738    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  ntot_av  !< total number concentration
739    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  nufp_av  !< ultrafine particles (UFP)
740    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  pm01_av  !< PM0.1
741    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  pm25_av  !< PM2.5
742    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  pm10_av  !< PM10
743!
744!-- In the particle phase:
745    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  s_bc_av   !< black carbon
746    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  s_du_av   !< dust
747    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  s_h2o_av  !< liquid water
748    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  s_nh_av   !< ammonia
749    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  s_no_av   !< nitrates
750    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  s_oc_av   !< org. carbon
751    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  s_so4_av  !< sulphates
752    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  s_ss_av   !< sea salt
753!
754!-- Bin specific mass and number concentrations:
755    REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE, TARGET ::  mbins_av  !< bin mas
756    REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE, TARGET ::  nbins_av  !< bin number
757
758!
759!-- PALM interfaces:
760
761    INTERFACE salsa_actions
762       MODULE PROCEDURE salsa_actions
763       MODULE PROCEDURE salsa_actions_ij
764    END INTERFACE salsa_actions
765
766    INTERFACE salsa_3d_data_averaging
767       MODULE PROCEDURE salsa_3d_data_averaging
768    END INTERFACE salsa_3d_data_averaging
769
770    INTERFACE salsa_boundary_conds
771       MODULE PROCEDURE salsa_boundary_conds
772       MODULE PROCEDURE salsa_boundary_conds_decycle
773    END INTERFACE salsa_boundary_conds
774
775    INTERFACE salsa_check_data_output
776       MODULE PROCEDURE salsa_check_data_output
777    END INTERFACE salsa_check_data_output
778
779    INTERFACE salsa_check_data_output_pr
780       MODULE PROCEDURE salsa_check_data_output_pr
781    END INTERFACE salsa_check_data_output_pr
782
783    INTERFACE salsa_check_parameters
784       MODULE PROCEDURE salsa_check_parameters
785    END INTERFACE salsa_check_parameters
786
787    INTERFACE salsa_data_output_2d
788       MODULE PROCEDURE salsa_data_output_2d
789    END INTERFACE salsa_data_output_2d
790
791    INTERFACE salsa_data_output_3d
792       MODULE PROCEDURE salsa_data_output_3d
793    END INTERFACE salsa_data_output_3d
794
795    INTERFACE salsa_data_output_mask
796       MODULE PROCEDURE salsa_data_output_mask
797    END INTERFACE salsa_data_output_mask
798
799    INTERFACE salsa_define_netcdf_grid
800       MODULE PROCEDURE salsa_define_netcdf_grid
801    END INTERFACE salsa_define_netcdf_grid
802
803    INTERFACE salsa_driver
804       MODULE PROCEDURE salsa_driver
805    END INTERFACE salsa_driver
806
807    INTERFACE salsa_emission_update
808       MODULE PROCEDURE salsa_emission_update
809    END INTERFACE salsa_emission_update
810
811    INTERFACE salsa_exchange_horiz_bounds
812       MODULE PROCEDURE salsa_exchange_horiz_bounds
813    END INTERFACE salsa_exchange_horiz_bounds
814
815    INTERFACE salsa_header
816       MODULE PROCEDURE salsa_header
817    END INTERFACE salsa_header
818
819    INTERFACE salsa_init
820       MODULE PROCEDURE salsa_init
821    END INTERFACE salsa_init
822
823    INTERFACE salsa_init_arrays
824       MODULE PROCEDURE salsa_init_arrays
825    END INTERFACE salsa_init_arrays
826
827    INTERFACE salsa_non_advective_processes
828       MODULE PROCEDURE salsa_non_advective_processes
829       MODULE PROCEDURE salsa_non_advective_processes_ij
830    END INTERFACE salsa_non_advective_processes
831
832    INTERFACE salsa_parin
833       MODULE PROCEDURE salsa_parin
834    END INTERFACE salsa_parin
835
836    INTERFACE salsa_prognostic_equations
837       MODULE PROCEDURE salsa_prognostic_equations
838       MODULE PROCEDURE salsa_prognostic_equations_ij
839    END INTERFACE salsa_prognostic_equations
840
841    INTERFACE salsa_rrd_local
842       MODULE PROCEDURE salsa_rrd_local
843    END INTERFACE salsa_rrd_local
844
845    INTERFACE salsa_statistics
846       MODULE PROCEDURE salsa_statistics
847    END INTERFACE salsa_statistics
848
849    INTERFACE salsa_swap_timelevel
850       MODULE PROCEDURE salsa_swap_timelevel
851    END INTERFACE salsa_swap_timelevel
852
853    INTERFACE salsa_tendency
854       MODULE PROCEDURE salsa_tendency
855       MODULE PROCEDURE salsa_tendency_ij
856    END INTERFACE salsa_tendency
857
858    INTERFACE salsa_wrd_local
859       MODULE PROCEDURE salsa_wrd_local
860    END INTERFACE salsa_wrd_local
861
862
863    SAVE
864
865    PRIVATE
866!
867!-- Public functions:
868    PUBLIC salsa_boundary_conds, salsa_check_data_output, salsa_check_parameters,                  &
869           salsa_3d_data_averaging, salsa_data_output_2d, salsa_data_output_3d,                    &
870           salsa_data_output_mask, salsa_define_netcdf_grid, salsa_diagnostics, salsa_driver,      &
871           salsa_emission_update, salsa_header, salsa_init, salsa_init_arrays, salsa_parin,        &
872           salsa_rrd_local, salsa_swap_timelevel, salsa_prognostic_equations, salsa_wrd_local,     &
873           salsa_actions, salsa_non_advective_processes, salsa_exchange_horiz_bounds,              &
874           salsa_check_data_output_pr, salsa_statistics
875!
876!-- Public parameters, constants and initial values
877    PUBLIC bc_am_t_val, bc_an_t_val, bc_gt_t_val, dots_salsa, dt_salsa,                            &
878           ibc_salsa_b, last_salsa_time, lsdepo, nest_salsa, salsa, salsa_gases_from_chem,         &
879           skip_time_do_salsa
880!
881!-- Public prognostic variables
882    PUBLIC aerosol_mass, aerosol_number, gconc_2, mconc_2, nbins_aerosol, ncc, ncomponents_mass,   &
883           nclim, nconc_2, ngases_salsa, prtcl, ra_dry, salsa_gas, sedim_vd
884
885
886 CONTAINS
887
888!------------------------------------------------------------------------------!
889! Description:
890! ------------
891!> Parin for &salsa_par for new modules
892!------------------------------------------------------------------------------!
893 SUBROUTINE salsa_parin
894
895    USE control_parameters,                                                                        &
896        ONLY:  data_output_pr
897
898    IMPLICIT NONE
899
900    CHARACTER(LEN=80) ::  line   !< dummy string that contains the current line of parameter file
901
902    INTEGER(iwp) ::  i                 !< loop index
903    INTEGER(iwp) ::  max_pr_salsa_tmp  !< dummy variable
904
905    NAMELIST /salsa_parameters/      aerosol_flux_dpg,                         &
906                                     aerosol_flux_mass_fracs_a,                &
907                                     aerosol_flux_mass_fracs_b,                &
908                                     aerosol_flux_sigmag,                      &
909                                     advect_particle_water,                    &
910                                     bc_salsa_b,                               &
911                                     bc_salsa_t,                               &
912                                     decycle_salsa_lr,                         &
913                                     decycle_method_salsa,                     &
914                                     decycle_salsa_ns,                         &
915                                     depo_pcm_par,                             &
916                                     depo_pcm_type,                            &
917                                     depo_surf_par,                            &
918                                     dpg,                                      &
919                                     dt_salsa,                                 &
920                                     emiss_factor_main,                        &
921                                     emiss_factor_side,                        &
922                                     feedback_to_palm,                         &
923                                     h2so4_init,                               &
924                                     hno3_init,                                &
925                                     init_gases_type,                          &
926                                     init_aerosol_type,                        &
927                                     listspec,                                 &
928                                     main_street_id,                           &
929                                     mass_fracs_a,                             &
930                                     mass_fracs_b,                             &
931                                     max_street_id,                            &
932                                     n_lognorm,                                &
933                                     nbin,                                     &
934                                     nest_salsa,                               &
935                                     nf2a,                                     &
936                                     nh3_init,                                 &
937                                     nj3,                                      &
938                                     nlcnd,                                    &
939                                     nlcndgas,                                 &
940                                     nlcndh2oae,                               &
941                                     nlcoag,                                   &
942                                     nldepo,                                   &
943                                     nldepo_pcm,                               &
944                                     nldepo_surf,                              &
945                                     nldistupdate,                             &
946                                     nsnucl,                                   &
947                                     ocnv_init,                                &
948                                     ocsv_init,                                &
949                                     read_restart_data_salsa,                  &
950                                     reglim,                                   &
951                                     salsa,                                    &
952                                     salsa_emission_mode,                      &
953                                     sigmag,                                   &
954                                     side_street_id,                           &
955                                     skip_time_do_salsa,                       &
956                                     surface_aerosol_flux,                     &
957                                     van_der_waals_coagc,                      &
958                                     write_binary_salsa
959
960    line = ' '
961!
962!-- Try to find salsa package
963    REWIND ( 11 )
964    line = ' '
965    DO WHILE ( INDEX( line, '&salsa_parameters' ) == 0 )
966       READ ( 11, '(A)', END=10 )  line
967    ENDDO
968    BACKSPACE ( 11 )
969!
970!-- Read user-defined namelist
971    READ ( 11, salsa_parameters )
972!
973!-- Enable salsa (salsa switch in modules.f90)
974    salsa = .TRUE.
975
976 10 CONTINUE
977!
978!-- Update the number of output profiles
979    max_pr_salsa_tmp = 0
980    i = 1
981    DO WHILE ( data_output_pr(i) /= ' '  .AND.  i <= 100 )
982       IF ( TRIM( data_output_pr(i)(1:6) ) == 'salsa_' )  max_pr_salsa_tmp = max_pr_salsa_tmp + 1
983       i = i + 1
984    ENDDO
985    IF ( max_pr_salsa_tmp > 0 )  max_pr_salsa = max_pr_salsa_tmp
986
987 END SUBROUTINE salsa_parin
988
989!------------------------------------------------------------------------------!
990! Description:
991! ------------
992!> Check parameters routine for salsa.
993!------------------------------------------------------------------------------!
994 SUBROUTINE salsa_check_parameters
995
996    USE control_parameters,                                                                        &
997        ONLY:  humidity
998
999    IMPLICIT NONE
1000
1001!
1002!-- Checks go here (cf. check_parameters.f90).
1003    IF ( salsa  .AND.  .NOT.  humidity )  THEN
1004       WRITE( message_string, * ) 'salsa = ', salsa, ' is not allowed with humidity = ', humidity
1005       CALL message( 'salsa_check_parameters', 'PA0594', 1, 2, 0, 6, 0 )
1006    ENDIF
1007
1008    IF ( bc_salsa_b == 'dirichlet' )  THEN
1009       ibc_salsa_b = 0
1010    ELSEIF ( bc_salsa_b == 'neumann' )  THEN
1011       ibc_salsa_b = 1
1012    ELSE
1013       message_string = 'unknown boundary condition: bc_salsa_b = "' // TRIM( bc_salsa_t ) // '"'
1014       CALL message( 'salsa_check_parameters', 'PA0595', 1, 2, 0, 6, 0 )
1015    ENDIF
1016
1017    IF ( bc_salsa_t == 'dirichlet' )  THEN
1018       ibc_salsa_t = 0
1019    ELSEIF ( bc_salsa_t == 'neumann' )  THEN
1020       ibc_salsa_t = 1
1021    ELSEIF ( bc_salsa_t == 'nested' )  THEN
1022       ibc_salsa_t = 2
1023    ELSE
1024       message_string = 'unknown boundary condition: bc_salsa_t = "' // TRIM( bc_salsa_t ) // '"'
1025       CALL message( 'salsa_check_parameters', 'PA0596', 1, 2, 0, 6, 0 )
1026    ENDIF
1027
1028    IF ( nj3 < 1  .OR.  nj3 > 3 )  THEN
1029       message_string = 'unknown nj3 (must be 1-3)'
1030       CALL message( 'salsa_check_parameters', 'PA0597', 1, 2, 0, 6, 0 )
1031    ENDIF
1032
1033    IF ( salsa_emission_mode /= 'no_emission'  .AND.  ibc_salsa_b  == 0 ) THEN
1034       message_string = 'salsa_emission_mode /= "no_emission" requires bc_salsa_b = "Neumann"'
1035       CALL message( 'salsa_check_parameters','PA0598', 1, 2, 0, 6, 0 )
1036    ENDIF
1037
1038    IF ( salsa_emission_mode /= 'no_emission' )  include_emission = .TRUE.
1039
1040 END SUBROUTINE salsa_check_parameters
1041
1042!------------------------------------------------------------------------------!
1043!
1044! Description:
1045! ------------
1046!> Subroutine defining appropriate grid for netcdf variables.
1047!> It is called out from subroutine netcdf.
1048!> Same grid as for other scalars (see netcdf_interface_mod.f90)
1049!------------------------------------------------------------------------------!
1050 SUBROUTINE salsa_define_netcdf_grid( var, found, grid_x, grid_y, grid_z )
1051
1052    IMPLICIT NONE
1053
1054    CHARACTER(LEN=*), INTENT(OUT) ::  grid_x   !<
1055    CHARACTER(LEN=*), INTENT(OUT) ::  grid_y   !<
1056    CHARACTER(LEN=*), INTENT(OUT) ::  grid_z   !<
1057    CHARACTER(LEN=*), INTENT(IN)  ::  var      !<
1058
1059    LOGICAL, INTENT(OUT) ::  found   !<
1060
1061    found  = .TRUE.
1062!
1063!-- Check for the grid
1064
1065    IF ( var(1:6) == 'salsa_' )  THEN  ! same grid for all salsa output variables
1066       grid_x = 'x'
1067       grid_y = 'y'
1068       grid_z = 'zu'
1069    ELSE
1070       found  = .FALSE.
1071       grid_x = 'none'
1072       grid_y = 'none'
1073       grid_z = 'none'
1074    ENDIF
1075
1076 END SUBROUTINE salsa_define_netcdf_grid
1077
1078!------------------------------------------------------------------------------!
1079! Description:
1080! ------------
1081!> Header output for new module
1082!------------------------------------------------------------------------------!
1083 SUBROUTINE salsa_header( io )
1084
1085    USE indices,                                                                                   &
1086        ONLY:  nx, ny, nz
1087
1088    IMPLICIT NONE
1089 
1090    INTEGER(iwp), INTENT(IN) ::  io   !< Unit of the output file
1091!
1092!-- Write SALSA header
1093    WRITE( io, 1 )
1094    WRITE( io, 2 ) skip_time_do_salsa
1095    WRITE( io, 3 ) dt_salsa
1096    WRITE( io, 4 )  nz, ny, nx, nbins_aerosol
1097    IF ( advect_particle_water )  THEN
1098       WRITE( io, 5 )  nz, ny, nx, ncomponents_mass*nbins_aerosol, advect_particle_water
1099    ELSE
1100       WRITE( io, 5 )  nz, ny, nx, ncc*nbins_aerosol, advect_particle_water
1101    ENDIF
1102    IF ( .NOT. salsa_gases_from_chem )  THEN
1103       WRITE( io, 6 )  nz, ny, nx, ngases_salsa, salsa_gases_from_chem
1104    ENDIF
1105    WRITE( io, 7 )
1106    IF ( nsnucl > 0 )   WRITE( io, 8 ) nsnucl, nj3
1107    IF ( nlcoag )       WRITE( io, 9 )
1108    IF ( nlcnd )        WRITE( io, 10 ) nlcndgas, nlcndh2oae
1109    IF ( lspartition )  WRITE( io, 11 )
1110    IF ( nldepo )       WRITE( io, 12 ) nldepo_pcm, nldepo_surf
1111    WRITE( io, 13 )  reglim, nbin, bin_low_limits
1112    IF ( init_aerosol_type == 0 )  WRITE( io, 14 ) nsect
1113    WRITE( io, 15 ) ncc, listspec, mass_fracs_a, mass_fracs_b
1114    IF ( .NOT. salsa_gases_from_chem )  THEN
1115       WRITE( io, 16 ) ngases_salsa, h2so4_init, hno3_init, nh3_init, ocnv_init, ocsv_init
1116    ENDIF
1117    WRITE( io, 17 )  init_aerosol_type, init_gases_type
1118    IF ( init_aerosol_type == 0 )  THEN
1119       WRITE( io, 18 )  dpg, sigmag, n_lognorm
1120    ELSE
1121       WRITE( io, 19 )
1122    ENDIF
1123    IF ( nest_salsa )  WRITE( io, 20 )  nest_salsa
1124    WRITE( io, 21 ) salsa_emission_mode
1125    IF ( salsa_emission_mode == 'uniform' )  THEN
1126       WRITE( io, 22 ) surface_aerosol_flux, aerosol_flux_dpg, aerosol_flux_sigmag,                &
1127                       aerosol_flux_mass_fracs_a
1128    ENDIF
1129    IF ( SUM( aerosol_flux_mass_fracs_b ) > 0.0_wp  .OR. salsa_emission_mode == 'read_from_file' ) &
1130    THEN
1131       WRITE( io, 23 )
1132    ENDIF
1133
11341   FORMAT (//' SALSA information:'/                                                               &
1135              ' ------------------------------'/)
11362   FORMAT   ('    Starts at: skip_time_do_salsa = ', F10.2, '  s')
11373   FORMAT  (/'    Timestep: dt_salsa = ', F6.2, '  s')
11384   FORMAT  (/'    Array shape (z,y,x,bins):'/                                                     &
1139              '       aerosol_number:  ', 4(I3)) 
11405   FORMAT  (/'       aerosol_mass:    ', 4(I3),/                                                  &
1141              '       (advect_particle_water = ', L1, ')')
11426   FORMAT   ('       salsa_gas: ', 4(I3),/                                                        &
1143              '       (salsa_gases_from_chem = ', L1, ')')
11447   FORMAT  (/'    Aerosol dynamic processes included: ')
11458   FORMAT  (/'       nucleation (scheme = ', I1, ' and J3 parametrization = ', I1, ')')
11469   FORMAT  (/'       coagulation')
114710  FORMAT  (/'       condensation (of precursor gases = ', L1, ' and water vapour = ', L1, ')' )
114811  FORMAT  (/'       dissolutional growth by HNO3 and NH3')
114912  FORMAT  (/'       dry deposition (on vegetation = ', L1, ' and on topography = ', L1, ')')
115013  FORMAT  (/'    Aerosol bin subrange limits (in metres): ',  3(ES10.2E3), /                     &
1151              '    Number of size bins for each aerosol subrange: ', 2I3,/                         &
1152              '    Aerosol bin limits (in metres): ', 9(ES10.2E3))
115314  FORMAT   ('    Initial number concentration in bins at the lowest level (#/m**3):', 9(ES10.2E3))
115415  FORMAT  (/'    Number of chemical components used: ', I1,/                                     &
1155              '       Species: ',7(A6),/                                                           &
1156              '    Initial relative contribution of each species to particle volume in:',/         &
1157              '       a-bins: ', 7(F6.3),/                                                         &
1158              '       b-bins: ', 7(F6.3))
115916  FORMAT  (/'    Number of gaseous tracers used: ', I1,/                                         &
1160              '    Initial gas concentrations:',/                                                  &
1161              '       H2SO4: ',ES12.4E3, ' #/m**3',/                                               &
1162              '       HNO3:  ',ES12.4E3, ' #/m**3',/                                               &
1163              '       NH3:   ',ES12.4E3, ' #/m**3',/                                               &
1164              '       OCNV:  ',ES12.4E3, ' #/m**3',/                                               &
1165              '       OCSV:  ',ES12.4E3, ' #/m**3')
116617   FORMAT (/'   Initialising concentrations: ', /                                                &
1167              '      Aerosol size distribution: init_aerosol_type = ', I1,/                        &
1168              '      Gas concentrations: init_gases_type = ', I1 )
116918   FORMAT ( '      Mode diametres: dpg(nmod) = ', 7(F7.3), ' (m)', /                             &
1170              '      Standard deviation: sigmag(nmod) = ', 7(F7.2),/                               &
1171              '      Number concentration: n_lognorm(nmod) = ', 7(ES12.4E3), ' (#/m3)' )
117219   FORMAT (/'      Size distribution read from a file.')
117320   FORMAT (/'   Nesting for salsa variables: ', L1 )
117421   FORMAT (/'   Emissions: salsa_emission_mode = ', A )
117522   FORMAT (/'      surface_aerosol_flux = ', ES12.4E3, ' #/m**2/s', /                            &
1176              '      aerosol_flux_dpg     =  ', 7(F7.3), ' (m)', /                                 &
1177              '      aerosol_flux_sigmag  =  ', 7(F7.2), /                                         &
1178              '      aerosol_mass_fracs_a =  ', 7(ES12.4E3) )
117923   FORMAT (/'      (currently all emissions are soluble!)')
1180
1181 END SUBROUTINE salsa_header
1182
1183!------------------------------------------------------------------------------!
1184! Description:
1185! ------------
1186!> Allocate SALSA arrays and define pointers if required
1187!------------------------------------------------------------------------------!
1188 SUBROUTINE salsa_init_arrays
1189
1190    USE advec_ws,                                                                                  &
1191        ONLY: ws_init_flags_scalar
1192
1193    USE surface_mod,                                                                               &
1194        ONLY:  surf_def_h, surf_def_v, surf_lsm_h, surf_lsm_v, surf_usm_h, surf_usm_v
1195
1196    IMPLICIT NONE
1197
1198    INTEGER(iwp) ::  gases_available !< Number of available gas components in the chemistry model
1199    INTEGER(iwp) ::  i               !< loop index for allocating
1200    INTEGER(iwp) ::  ii              !< index for indexing chemical components
1201    INTEGER(iwp) ::  l               !< loop index for allocating: surfaces
1202    INTEGER(iwp) ::  lsp             !< loop index for chem species in the chemistry model
1203
1204    gases_available = 0
1205!
1206!-- Allocate prognostic variables (see salsa_swap_timelevel)
1207!
1208!-- Set derived indices:
1209!-- (This does the same as the subroutine salsa_initialize in SALSA/UCLALES-SALSA)
1210    start_subrange_1a = 1  ! 1st index of subrange 1a
1211    start_subrange_2a = start_subrange_1a + nbin(1)  ! 1st index of subrange 2a
1212    end_subrange_1a   = start_subrange_2a - 1        ! last index of subrange 1a
1213    end_subrange_2a   = end_subrange_1a + nbin(2)    ! last index of subrange 2a
1214
1215!
1216!-- If the fraction of insoluble aerosols in subrange 2 is zero: do not allocate arrays for them
1217    IF ( nf2a > 0.999999_wp  .AND.  SUM( mass_fracs_b ) < 0.00001_wp )  THEN
1218       no_insoluble = .TRUE.
1219       start_subrange_2b = end_subrange_2a+1  ! 1st index of subrange 2b
1220       end_subrange_2b   = end_subrange_2a    ! last index of subrange 2b
1221    ELSE
1222       start_subrange_2b = start_subrange_2a + nbin(2)  ! 1st index of subrange 2b
1223       end_subrange_2b   = end_subrange_2a + nbin(2)    ! last index of subrange 2b
1224    ENDIF
1225
1226    nbins_aerosol = end_subrange_2b   ! total number of aerosol size bins
1227!
1228!-- Create index tables for different aerosol components
1229    CALL component_index_constructor( prtcl, ncc, maxspec, listspec )
1230
1231    ncomponents_mass = ncc
1232    IF ( advect_particle_water )  ncomponents_mass = ncc + 1  ! Add water
1233!
1234!-- Indices for chemical components used (-1 = not used)
1235    ii = 0
1236    IF ( is_used( prtcl, 'SO4' ) )  THEN
1237       index_so4 = get_index( prtcl,'SO4' )
1238       ii = ii + 1
1239    ENDIF
1240    IF ( is_used( prtcl,'OC' ) )  THEN
1241       index_oc = get_index(prtcl, 'OC')
1242       ii = ii + 1
1243    ENDIF
1244    IF ( is_used( prtcl, 'BC' ) )  THEN
1245       index_bc = get_index( prtcl, 'BC' )
1246       ii = ii + 1
1247    ENDIF
1248    IF ( is_used( prtcl, 'DU' ) )  THEN
1249       index_du = get_index( prtcl, 'DU' )
1250       ii = ii + 1
1251    ENDIF
1252    IF ( is_used( prtcl, 'SS' ) )  THEN
1253       index_ss = get_index( prtcl, 'SS' )
1254       ii = ii + 1
1255    ENDIF
1256    IF ( is_used( prtcl, 'NO' ) )  THEN
1257       index_no = get_index( prtcl, 'NO' )
1258       ii = ii + 1
1259    ENDIF
1260    IF ( is_used( prtcl, 'NH' ) )  THEN
1261       index_nh = get_index( prtcl, 'NH' )
1262       ii = ii + 1
1263    ENDIF
1264!
1265!-- All species must be known
1266    IF ( ii /= ncc )  THEN
1267       message_string = 'Unknown aerosol species/component(s) given in the initialization'
1268       CALL message( 'salsa_mod: salsa_init', 'PA0600', 1, 2, 0, 6, 0 )
1269    ENDIF
1270!
1271!-- Allocate:
1272    ALLOCATE( aero(nbins_aerosol), bc_am_t_val(nbins_aerosol*ncomponents_mass),                    &
1273              bc_an_t_val(nbins_aerosol), bc_gt_t_val(ngases_salsa), bin_low_limits(nbins_aerosol),&
1274              nsect(nbins_aerosol), massacc(nbins_aerosol) )
1275    ALLOCATE( k_topo_top(nysg:nyng,nxlg:nxrg) )
1276    IF ( nldepo ) ALLOCATE( sedim_vd(nzb:nzt+1,nysg:nyng,nxlg:nxrg,nbins_aerosol) )
1277    ALLOCATE( ra_dry(nzb:nzt+1,nysg:nyng,nxlg:nxrg,nbins_aerosol) )
1278!
1279!-- Initialise the sectional particle size distribution
1280    CALL set_sizebins
1281!
1282!-- Aerosol number concentration
1283    ALLOCATE( aerosol_number(nbins_aerosol) )
1284    ALLOCATE( nconc_1(nzb:nzt+1,nysg:nyng,nxlg:nxrg,nbins_aerosol),                                &
1285              nconc_2(nzb:nzt+1,nysg:nyng,nxlg:nxrg,nbins_aerosol),                                &
1286              nconc_3(nzb:nzt+1,nysg:nyng,nxlg:nxrg,nbins_aerosol) )
1287    nconc_1 = 0.0_wp
1288    nconc_2 = 0.0_wp
1289    nconc_3 = 0.0_wp
1290
1291    DO i = 1, nbins_aerosol
1292       aerosol_number(i)%conc(nzb:nzt+1,nysg:nyng,nxlg:nxrg)    => nconc_1(:,:,:,i)
1293       aerosol_number(i)%conc_p(nzb:nzt+1,nysg:nyng,nxlg:nxrg)  => nconc_2(:,:,:,i)
1294       aerosol_number(i)%tconc_m(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => nconc_3(:,:,:,i)
1295       ALLOCATE( aerosol_number(i)%flux_s(nzb+1:nzt,0:threads_per_task-1),                         &
1296                 aerosol_number(i)%diss_s(nzb+1:nzt,0:threads_per_task-1),                         &
1297                 aerosol_number(i)%flux_l(nzb+1:nzt,nys:nyn,0:threads_per_task-1),                 &
1298                 aerosol_number(i)%diss_l(nzb+1:nzt,nys:nyn,0:threads_per_task-1),                 &
1299                 aerosol_number(i)%init(nzb:nzt+1),                                                &
1300                 aerosol_number(i)%sums_ws_l(nzb:nzt+1,0:threads_per_task-1) )
1301       aerosol_number(i)%init = nclim
1302       IF ( include_emission  .OR.  ( nldepo  .AND.  nldepo_surf ) )  THEN
1303          ALLOCATE( aerosol_number(i)%source(nys:nyn,nxl:nxr) )
1304          aerosol_number(i)%source = 0.0_wp
1305       ENDIF
1306    ENDDO
1307
1308!
1309!-- Aerosol mass concentration
1310    ALLOCATE( aerosol_mass(ncomponents_mass*nbins_aerosol) )
1311    ALLOCATE( mconc_1(nzb:nzt+1,nysg:nyng,nxlg:nxrg,ncomponents_mass*nbins_aerosol),               &
1312              mconc_2(nzb:nzt+1,nysg:nyng,nxlg:nxrg,ncomponents_mass*nbins_aerosol),               &
1313              mconc_3(nzb:nzt+1,nysg:nyng,nxlg:nxrg,ncomponents_mass*nbins_aerosol) )
1314    mconc_1 = 0.0_wp
1315    mconc_2 = 0.0_wp
1316    mconc_3 = 0.0_wp
1317
1318    DO i = 1, ncomponents_mass*nbins_aerosol
1319       aerosol_mass(i)%conc(nzb:nzt+1,nysg:nyng,nxlg:nxrg)    => mconc_1(:,:,:,i)
1320       aerosol_mass(i)%conc_p(nzb:nzt+1,nysg:nyng,nxlg:nxrg)  => mconc_2(:,:,:,i)
1321       aerosol_mass(i)%tconc_m(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => mconc_3(:,:,:,i)
1322       ALLOCATE( aerosol_mass(i)%flux_s(nzb+1:nzt,0:threads_per_task-1),                           &
1323                 aerosol_mass(i)%diss_s(nzb+1:nzt,0:threads_per_task-1),                           &
1324                 aerosol_mass(i)%flux_l(nzb+1:nzt,nys:nyn,0:threads_per_task-1),                   &
1325                 aerosol_mass(i)%diss_l(nzb+1:nzt,nys:nyn,0:threads_per_task-1),                   &
1326                 aerosol_mass(i)%init(nzb:nzt+1),                                                  &
1327                 aerosol_mass(i)%sums_ws_l(nzb:nzt+1,0:threads_per_task-1)  )
1328       aerosol_mass(i)%init = mclim
1329       IF ( include_emission  .OR.  ( nldepo  .AND.  nldepo_surf ) )  THEN
1330          ALLOCATE( aerosol_mass(i)%source(nys:nyn,nxl:nxr) )
1331          aerosol_mass(i)%source = 0.0_wp
1332       ENDIF
1333    ENDDO
1334
1335!
1336!-- Surface fluxes: answs = aerosol number, amsws = aerosol mass
1337!
1338!-- Horizontal surfaces: default type
1339    DO  l = 0, 2   ! upward (l=0), downward (l=1) and model top (l=2)
1340       ALLOCATE( surf_def_h(l)%answs( 1:surf_def_h(l)%ns, nbins_aerosol ) )
1341       ALLOCATE( surf_def_h(l)%amsws( 1:surf_def_h(l)%ns, nbins_aerosol*ncomponents_mass ) )
1342       surf_def_h(l)%answs = 0.0_wp
1343       surf_def_h(l)%amsws = 0.0_wp
1344    ENDDO
1345!
1346!-- Horizontal surfaces: natural type
1347    ALLOCATE( surf_lsm_h%answs( 1:surf_lsm_h%ns, nbins_aerosol ) )
1348    ALLOCATE( surf_lsm_h%amsws( 1:surf_lsm_h%ns, nbins_aerosol*ncomponents_mass ) )
1349    surf_lsm_h%answs = 0.0_wp
1350    surf_lsm_h%amsws = 0.0_wp
1351!
1352!-- Horizontal surfaces: urban type
1353    ALLOCATE( surf_usm_h%answs( 1:surf_usm_h%ns, nbins_aerosol ) )
1354    ALLOCATE( surf_usm_h%amsws( 1:surf_usm_h%ns, nbins_aerosol*ncomponents_mass ) )
1355    surf_usm_h%answs = 0.0_wp
1356    surf_usm_h%amsws = 0.0_wp
1357
1358!
1359!-- Vertical surfaces: northward (l=0), southward (l=1), eastward (l=2) and westward (l=3) facing
1360    DO  l = 0, 3
1361       ALLOCATE( surf_def_v(l)%answs( 1:surf_def_v(l)%ns, nbins_aerosol ) )
1362       surf_def_v(l)%answs = 0.0_wp
1363       ALLOCATE( surf_def_v(l)%amsws( 1:surf_def_v(l)%ns, nbins_aerosol*ncomponents_mass ) )
1364       surf_def_v(l)%amsws = 0.0_wp
1365
1366       ALLOCATE( surf_lsm_v(l)%answs( 1:surf_lsm_v(l)%ns, nbins_aerosol ) )
1367       surf_lsm_v(l)%answs = 0.0_wp
1368       ALLOCATE( surf_lsm_v(l)%amsws( 1:surf_lsm_v(l)%ns, nbins_aerosol*ncomponents_mass ) )
1369       surf_lsm_v(l)%amsws = 0.0_wp
1370
1371       ALLOCATE( surf_usm_v(l)%answs( 1:surf_usm_v(l)%ns, nbins_aerosol ) )
1372       surf_usm_v(l)%answs = 0.0_wp
1373       ALLOCATE( surf_usm_v(l)%amsws( 1:surf_usm_v(l)%ns, nbins_aerosol*ncomponents_mass ) )
1374       surf_usm_v(l)%amsws = 0.0_wp
1375
1376    ENDDO
1377
1378!
1379!-- Concentration of gaseous tracers (1. SO4, 2. HNO3, 3. NH3, 4. OCNV, 5. OCSV)
1380!-- (number concentration (#/m3) )
1381!
1382!-- If chemistry is on, read gas phase concentrations from there. Otherwise,
1383!-- allocate salsa_gas array.
1384
1385    IF ( air_chemistry )  THEN
1386       DO  lsp = 1, nvar
1387          SELECT CASE ( TRIM( chem_species(lsp)%name ) )
1388             CASE ( 'H2SO4', 'h2so4' )
1389                gases_available = gases_available + 1
1390                gas_index_chem(1) = lsp
1391             CASE ( 'HNO3', 'hno3' )
1392                gases_available = gases_available + 1
1393                gas_index_chem(2) = lsp
1394             CASE ( 'NH3', 'nh3' )
1395                gases_available = gases_available + 1
1396                gas_index_chem(3) = lsp
1397             CASE ( 'OCNV', 'ocnv' )
1398                gases_available = gases_available + 1
1399                gas_index_chem(4) = lsp
1400             CASE ( 'OCSV', 'ocsv' )
1401                gases_available = gases_available + 1
1402                gas_index_chem(5) = lsp
1403          END SELECT
1404       ENDDO
1405
1406       IF ( gases_available == ngases_salsa )  THEN
1407          salsa_gases_from_chem = .TRUE.
1408       ELSE
1409          WRITE( message_string, * ) 'SALSA is run together with chemistry but not all gaseous '// &
1410                                     'components are provided by kpp (H2SO4, HNO3, NH3, OCNV, OCSV)'
1411       CALL message( 'check_parameters', 'PA0599', 1, 2, 0, 6, 0 )
1412       ENDIF
1413
1414    ELSE
1415
1416       ALLOCATE( salsa_gas(ngases_salsa) )
1417       ALLOCATE( gconc_1(nzb:nzt+1,nysg:nyng,nxlg:nxrg,ngases_salsa),                 &
1418                 gconc_2(nzb:nzt+1,nysg:nyng,nxlg:nxrg,ngases_salsa),                 &
1419                 gconc_3(nzb:nzt+1,nysg:nyng,nxlg:nxrg,ngases_salsa) )
1420       gconc_1 = 0.0_wp
1421       gconc_2 = 0.0_wp
1422       gconc_3 = 0.0_wp
1423
1424       DO i = 1, ngases_salsa
1425          salsa_gas(i)%conc(nzb:nzt+1,nysg:nyng,nxlg:nxrg)    => gconc_1(:,:,:,i)
1426          salsa_gas(i)%conc_p(nzb:nzt+1,nysg:nyng,nxlg:nxrg)  => gconc_2(:,:,:,i)
1427          salsa_gas(i)%tconc_m(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => gconc_3(:,:,:,i)
1428          ALLOCATE( salsa_gas(i)%flux_s(nzb+1:nzt,0:threads_per_task-1),       &
1429                    salsa_gas(i)%diss_s(nzb+1:nzt,0:threads_per_task-1),       &
1430                    salsa_gas(i)%flux_l(nzb+1:nzt,nys:nyn,0:threads_per_task-1),&
1431                    salsa_gas(i)%diss_l(nzb+1:nzt,nys:nyn,0:threads_per_task-1),&
1432                    salsa_gas(i)%init(nzb:nzt+1),                              &
1433                    salsa_gas(i)%sums_ws_l(nzb:nzt+1,0:threads_per_task-1) )
1434          salsa_gas(i)%init = nclim
1435          IF ( include_emission )  THEN
1436             ALLOCATE( salsa_gas(i)%source(nys:nys,nxl:nxr) )
1437             salsa_gas(i)%source = 0.0_wp
1438          ENDIF
1439       ENDDO
1440!
1441!--    Surface fluxes: gtsws = gaseous tracer flux
1442!
1443!--    Horizontal surfaces: default type
1444       DO  l = 0, 2   ! upward (l=0), downward (l=1) and model top (l=2)
1445          ALLOCATE( surf_def_h(l)%gtsws( 1:surf_def_h(l)%ns, ngases_salsa ) )
1446          surf_def_h(l)%gtsws = 0.0_wp
1447       ENDDO
1448!--    Horizontal surfaces: natural type
1449       ALLOCATE( surf_lsm_h%gtsws( 1:surf_lsm_h%ns, ngases_salsa ) )
1450       surf_lsm_h%gtsws = 0.0_wp
1451!--    Horizontal surfaces: urban type
1452       ALLOCATE( surf_usm_h%gtsws( 1:surf_usm_h%ns, ngases_salsa ) )
1453       surf_usm_h%gtsws = 0.0_wp
1454!
1455!--    Vertical surfaces: northward (l=0), southward (l=1), eastward (l=2) and
1456!--    westward (l=3) facing
1457       DO  l = 0, 3
1458          ALLOCATE( surf_def_v(l)%gtsws( 1:surf_def_v(l)%ns, ngases_salsa ) )
1459          surf_def_v(l)%gtsws = 0.0_wp
1460          ALLOCATE( surf_lsm_v(l)%gtsws( 1:surf_lsm_v(l)%ns, ngases_salsa ) )
1461          surf_lsm_v(l)%gtsws = 0.0_wp
1462          ALLOCATE( surf_usm_v(l)%gtsws( 1:surf_usm_v(l)%ns, ngases_salsa ) )
1463          surf_usm_v(l)%gtsws = 0.0_wp
1464       ENDDO
1465    ENDIF
1466
1467    IF ( ws_scheme_sca )  THEN
1468
1469       IF ( salsa )  THEN
1470          ALLOCATE( sums_salsa_ws_l(nzb:nzt+1,0:threads_per_task-1) )
1471          sums_salsa_ws_l = 0.0_wp
1472       ENDIF
1473
1474    ENDIF
1475!
1476!-- Set control flags for decycling only at lateral boundary cores. Within the inner cores the
1477!-- decycle flag is set to .FALSE.. Even though it does not affect the setting of chemistry boundary
1478!-- conditions, this flag is used to set advection control flags appropriately.
1479    decycle_salsa_lr = MERGE( decycle_salsa_lr, .FALSE., nxl == 0  .OR.  nxr == nx )
1480    decycle_salsa_ns = MERGE( decycle_salsa_ns, .FALSE., nys == 0  .OR.  nyn == ny )
1481!
1482!-- Decycling can be applied separately for aerosol variables, while wind and other scalars may have
1483!-- cyclic or nested boundary conditions. However, large gradients near the boundaries may produce
1484!-- stationary numerical oscillations near the lateral boundaries when a higher-order scheme is
1485!-- applied near these boundaries. To get rid-off this, set-up additional flags that control the
1486!-- order of the scalar advection scheme near the lateral boundaries for passive scalars with
1487!-- decycling.
1488    IF ( scalar_advec == 'ws-scheme' )  THEN
1489       ALLOCATE( salsa_advc_flags_s(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
1490!
1491!--    In case of decycling, set Neuman boundary conditions for wall_flags_0 bit 31 instead of
1492!--    cyclic boundary conditions. Bit 31 is used to identify extended degradation zones (please see
1493!--    the following comment). Note, since several also other modules may access this bit but may
1494!--    have other boundary conditions, the original value of wall_flags_0 bit 31 must not be
1495!--    modified. Hence, store the boundary conditions directly on salsa_advc_flags_s.
1496!--    salsa_advc_flags_s will be later overwritten in ws_init_flags_scalar and bit 31 won't be used
1497!--    to control the numerical order.
1498!--    Initialize with flag 31 only.
1499       salsa_advc_flags_s = 0
1500       salsa_advc_flags_s = MERGE( IBSET( salsa_advc_flags_s, 31 ), 0, BTEST( wall_flags_0, 31 ) )
1501
1502       IF ( decycle_salsa_ns )  THEN
1503          IF ( nys == 0 )  THEN
1504             DO  i = 1, nbgp
1505                salsa_advc_flags_s(:,nys-i,:) = MERGE( IBSET( salsa_advc_flags_s(:,nys,:), 31 ),   &
1506                                                       IBCLR( salsa_advc_flags_s(:,nys,:), 31 ),   &
1507                                                       BTEST( salsa_advc_flags_s(:,nys,:), 31 ) )
1508             ENDDO
1509          ENDIF
1510          IF ( nyn == ny )  THEN
1511             DO  i = 1, nbgp
1512                salsa_advc_flags_s(:,nyn+i,:) = MERGE( IBSET( salsa_advc_flags_s(:,nyn,:), 31 ),   &
1513                                                       IBCLR( salsa_advc_flags_s(:,nyn,:), 31 ),   &
1514                                                       BTEST( salsa_advc_flags_s(:,nyn,:), 31 ) )
1515             ENDDO
1516          ENDIF
1517       ENDIF
1518       IF ( decycle_salsa_lr )  THEN
1519          IF ( nxl == 0 )  THEN
1520             DO  i = 1, nbgp
1521                salsa_advc_flags_s(:,:,nxl-i) = MERGE( IBSET( salsa_advc_flags_s(:,:,nxl), 31 ),   &
1522                                                       IBCLR( salsa_advc_flags_s(:,:,nxl), 31 ),   &
1523                                                       BTEST( salsa_advc_flags_s(:,:,nxl), 31 ) )
1524             ENDDO
1525          ENDIF
1526          IF ( nxr == nx )  THEN
1527             DO  i = 1, nbgp
1528                salsa_advc_flags_s(:,:,nxr+i) = MERGE( IBSET( salsa_advc_flags_s(:,:,nxr), 31 ),   &
1529                                                       IBCLR( salsa_advc_flags_s(:,:,nxr), 31 ),   &
1530                                                       BTEST( salsa_advc_flags_s(:,:,nxr), 31 ) )
1531             ENDDO
1532          ENDIF
1533       ENDIF
1534!
1535!--    To initialise the advection flags appropriately, pass the boundary flags to
1536!--    ws_init_flags_scalar. The last argument in ws_init_flags_scalar indicates that a passive
1537!--    scalar is being treated and the horizontal advection terms are degraded already 2 grid points
1538!--    before the lateral boundary. Also, extended degradation zones are applied, where
1539!--    horizontal advection of scalars is discretised by the first-order scheme at all grid points
1540!--    in the vicinity of buildings (<= 3 grid points). Even though no building is within the
1541!--    numerical stencil, the first-order scheme is used. At fourth and fifth grid points, the order
1542!--    of the horizontal advection scheme is successively upgraded.
1543!--    These degradations of the advection scheme are done to avoid stationary numerical
1544!--    oscillations, which are responsible for high concentration maxima that may appear e.g. under
1545!--    shear-free stable conditions.
1546       CALL ws_init_flags_scalar( bc_dirichlet_l  .OR.  bc_radiation_l  .OR.  decycle_salsa_lr,    &
1547                                  bc_dirichlet_n  .OR.  bc_radiation_n  .OR.  decycle_salsa_ns,    &
1548                                  bc_dirichlet_r  .OR.  bc_radiation_r  .OR.  decycle_salsa_lr,    &
1549                                  bc_dirichlet_s  .OR.  bc_radiation_s  .OR.  decycle_salsa_ns,    &
1550                                  salsa_advc_flags_s, .TRUE. )
1551    ENDIF
1552
1553
1554 END SUBROUTINE salsa_init_arrays
1555
1556!------------------------------------------------------------------------------!
1557! Description:
1558! ------------
1559!> Initialization of SALSA. Based on salsa_initialize in UCLALES-SALSA.
1560!> Subroutines salsa_initialize, SALSAinit and DiagInitAero in UCLALES-SALSA are
1561!> also merged here.
1562!------------------------------------------------------------------------------!
1563 SUBROUTINE salsa_init
1564
1565    IMPLICIT NONE
1566
1567    INTEGER(iwp) :: i   !<
1568    INTEGER(iwp) :: ib  !< loop index for aerosol number bins
1569    INTEGER(iwp) :: ic  !< loop index for aerosol mass bins
1570    INTEGER(iwp) :: ig  !< loop index for gases
1571    INTEGER(iwp) :: j   !<
1572
1573    IF ( debug_output )  CALL debug_message( 'salsa_init', 'start' )
1574
1575    bin_low_limits = 0.0_wp
1576    k_topo_top     = 0
1577    nsect          = 0.0_wp
1578    massacc        = 1.0_wp
1579!
1580!-- Initialise
1581    IF ( nldepo )  sedim_vd = 0.0_wp
1582
1583    IF ( .NOT. salsa_gases_from_chem )  THEN
1584       IF ( .NOT. read_restart_data_salsa )  THEN
1585          salsa_gas(1)%conc = h2so4_init
1586          salsa_gas(2)%conc = hno3_init
1587          salsa_gas(3)%conc = nh3_init
1588          salsa_gas(4)%conc = ocnv_init
1589          salsa_gas(5)%conc = ocsv_init
1590       ENDIF
1591       DO  ig = 1, ngases_salsa
1592          salsa_gas(ig)%conc_p    = 0.0_wp
1593          salsa_gas(ig)%tconc_m   = 0.0_wp
1594          salsa_gas(ig)%flux_s    = 0.0_wp
1595          salsa_gas(ig)%diss_s    = 0.0_wp
1596          salsa_gas(ig)%flux_l    = 0.0_wp
1597          salsa_gas(ig)%diss_l    = 0.0_wp
1598          salsa_gas(ig)%sums_ws_l = 0.0_wp
1599          salsa_gas(ig)%conc_p    = salsa_gas(ig)%conc
1600       ENDDO
1601!
1602!--    Set initial value for gas compound tracer
1603       salsa_gas(1)%init = h2so4_init
1604       salsa_gas(2)%init = hno3_init
1605       salsa_gas(3)%init = nh3_init
1606       salsa_gas(4)%init = ocnv_init
1607       salsa_gas(5)%init = ocsv_init
1608    ENDIF
1609!
1610!-- Aerosol radius in each bin: dry and wet (m)
1611    ra_dry = 1.0E-10_wp
1612!
1613!-- Initialise location-dependent aerosol size distributions and chemical compositions:
1614    CALL aerosol_init
1615
1616!-- Initalisation run of SALSA + calculate the vertical top index of the topography
1617    DO  i = nxl, nxr
1618       DO  j = nys, nyn
1619
1620          k_topo_top(j,i) = MAXLOC( MERGE( 1, 0, BTEST( wall_flags_0(:,j,i), 12 ) ), DIM = 1 ) - 1
1621
1622          CALL salsa_driver( i, j, 1 )
1623          CALL salsa_diagnostics( i, j )
1624       ENDDO
1625    ENDDO
1626
1627    DO  ib = 1, nbins_aerosol
1628       aerosol_number(ib)%conc_p    = aerosol_number(ib)%conc
1629       aerosol_number(ib)%tconc_m   = 0.0_wp
1630       aerosol_number(ib)%flux_s    = 0.0_wp
1631       aerosol_number(ib)%diss_s    = 0.0_wp
1632       aerosol_number(ib)%flux_l    = 0.0_wp
1633       aerosol_number(ib)%diss_l    = 0.0_wp
1634       aerosol_number(ib)%sums_ws_l = 0.0_wp
1635    ENDDO
1636    DO  ic = 1, ncomponents_mass*nbins_aerosol
1637       aerosol_mass(ic)%conc_p    = aerosol_mass(ic)%conc
1638       aerosol_mass(ic)%tconc_m   = 0.0_wp
1639       aerosol_mass(ic)%flux_s    = 0.0_wp
1640       aerosol_mass(ic)%diss_s    = 0.0_wp
1641       aerosol_mass(ic)%flux_l    = 0.0_wp
1642       aerosol_mass(ic)%diss_l    = 0.0_wp
1643       aerosol_mass(ic)%sums_ws_l = 0.0_wp
1644    ENDDO
1645!
1646!
1647!-- Initialise the deposition scheme and surface types
1648    IF ( nldepo )  CALL init_deposition
1649
1650    IF ( include_emission )  THEN
1651!
1652!--    Read in and initialize emissions
1653       CALL salsa_emission_setup( .TRUE. )
1654       IF ( .NOT. salsa_gases_from_chem  .AND.  salsa_emission_mode == 'read_from_file' )  THEN
1655          CALL salsa_gas_emission_setup( .TRUE. )
1656       ENDIF
1657    ENDIF
1658!
1659!-- Partition and dissolutional growth by gaseous HNO3 and NH3
1660    IF ( index_no > 0  .AND.  index_nh > 0  .AND.  index_so4 > 0 )  lspartition = .TRUE.
1661
1662    IF ( debug_output )  CALL debug_message( 'salsa_init', 'end' )
1663
1664 END SUBROUTINE salsa_init
1665
1666!------------------------------------------------------------------------------!
1667! Description:
1668! ------------
1669!> Initializes particle size distribution grid by calculating size bin limits
1670!> and mid-size for *dry* particles in each bin. Called from salsa_initialize
1671!> (only at the beginning of simulation).
1672!> Size distribution described using:
1673!>   1) moving center method (subranges 1 and 2)
1674!>      (Jacobson, Atmos. Env., 31, 131-144, 1997)
1675!>   2) fixed sectional method (subrange 3)
1676!> Size bins in each subrange are spaced logarithmically
1677!> based on given subrange size limits and bin number.
1678!
1679!> Mona changed 06/2017: Use geometric mean diameter to describe the mean
1680!> particle diameter in a size bin, not the arithmeric mean which clearly
1681!> overestimates the total particle volume concentration.
1682!
1683!> Coded by:
1684!> Hannele Korhonen (FMI) 2005
1685!> Harri Kokkola (FMI) 2006
1686!
1687!> Bug fixes for box model + updated for the new aerosol datatype:
1688!> Juha Tonttila (FMI) 2014
1689!------------------------------------------------------------------------------!
1690 SUBROUTINE set_sizebins
1691
1692    IMPLICIT NONE
1693
1694    INTEGER(iwp) ::  cc  !< running index
1695    INTEGER(iwp) ::  dd  !< running index
1696
1697    REAL(wp) ::  ratio_d  !< ratio of the upper and lower diameter of subranges
1698
1699    aero(:)%dwet     = 1.0E-10_wp
1700    aero(:)%veqh2o   = 1.0E-10_wp
1701    aero(:)%numc     = nclim
1702    aero(:)%core     = 1.0E-10_wp
1703    DO  cc = 1, maxspec+1    ! 1:SO4, 2:OC, 3:BC, 4:DU, 5:SS, 6:NO, 7:NH, 8:H2O
1704       aero(:)%volc(cc) = 0.0_wp
1705    ENDDO
1706!
1707!-- vlolim&vhilim: min & max *dry* volumes [fxm]
1708!-- dmid: bin mid *dry* diameter (m)
1709!-- vratiolo&vratiohi: volume ratio between the center and low/high limit
1710!
1711!-- 1) Size subrange 1:
1712    ratio_d = reglim(2) / reglim(1)   ! section spacing (m)
1713    DO  cc = start_subrange_1a, end_subrange_1a
1714       aero(cc)%vlolim = api6 * ( reglim(1) * ratio_d**( REAL( cc-1 ) / nbin(1) ) )**3
1715       aero(cc)%vhilim = api6 * ( reglim(1) * ratio_d**( REAL( cc ) / nbin(1) ) )**3
1716       aero(cc)%dmid = SQRT( ( aero(cc)%vhilim / api6 )**0.33333333_wp *                           &
1717                             ( aero(cc)%vlolim / api6 )**0.33333333_wp )
1718       aero(cc)%vratiohi = aero(cc)%vhilim / ( api6 * aero(cc)%dmid**3 )
1719       aero(cc)%vratiolo = aero(cc)%vlolim / ( api6 * aero(cc)%dmid**3 )
1720    ENDDO
1721!
1722!-- 2) Size subrange 2:
1723!-- 2.1) Sub-subrange 2a: high hygroscopicity
1724    ratio_d = reglim(3) / reglim(2)   ! section spacing
1725    DO  dd = start_subrange_2a, end_subrange_2a
1726       cc = dd - start_subrange_2a
1727       aero(dd)%vlolim = api6 * ( reglim(2) * ratio_d**( REAL( cc ) / nbin(2) ) )**3
1728       aero(dd)%vhilim = api6 * ( reglim(2) * ratio_d**( REAL( cc+1 ) / nbin(2) ) )**3
1729       aero(dd)%dmid = SQRT( ( aero(dd)%vhilim / api6 )**0.33333333_wp *                           &
1730                             ( aero(dd)%vlolim / api6 )**0.33333333_wp )
1731       aero(dd)%vratiohi = aero(dd)%vhilim / ( api6 * aero(dd)%dmid**3 )
1732       aero(dd)%vratiolo = aero(dd)%vlolim / ( api6 * aero(dd)%dmid**3 )
1733    ENDDO
1734!
1735!-- 2.2) Sub-subrange 2b: low hygroscopicity
1736    IF ( .NOT. no_insoluble )  THEN
1737       aero(start_subrange_2b:end_subrange_2b)%vlolim   = aero(start_subrange_2a:end_subrange_2a)%vlolim
1738       aero(start_subrange_2b:end_subrange_2b)%vhilim   = aero(start_subrange_2a:end_subrange_2a)%vhilim
1739       aero(start_subrange_2b:end_subrange_2b)%dmid     = aero(start_subrange_2a:end_subrange_2a)%dmid
1740       aero(start_subrange_2b:end_subrange_2b)%vratiohi = aero(start_subrange_2a:end_subrange_2a)%vratiohi
1741       aero(start_subrange_2b:end_subrange_2b)%vratiolo = aero(start_subrange_2a:end_subrange_2a)%vratiolo
1742    ENDIF
1743!
1744!-- Initialize the wet diameter with the bin dry diameter to avoid numerical problems later
1745    aero(:)%dwet = aero(:)%dmid
1746!
1747!-- Save bin limits (lower diameter) to be delivered to PALM if needed
1748    DO cc = 1, nbins_aerosol
1749       bin_low_limits(cc) = ( aero(cc)%vlolim / api6 )**0.33333333_wp
1750    ENDDO
1751
1752 END SUBROUTINE set_sizebins
1753
1754!------------------------------------------------------------------------------!
1755! Description:
1756! ------------
1757!> Initilize altitude-dependent aerosol size distributions and compositions.
1758!>
1759!> Mona added 06/2017: Correct the number and mass concentrations by normalizing
1760!< by the given total number and mass concentration.
1761!>
1762!> Tomi Raatikainen, FMI, 29.2.2016
1763!------------------------------------------------------------------------------!
1764 SUBROUTINE aerosol_init
1765
1766    USE netcdf_data_input_mod,                                                                     &
1767        ONLY:  check_existence, close_input_file, get_dimension_length,                            &
1768               get_attribute, get_variable,                                                        &
1769               inquire_num_variables, inquire_variable_names,                                      &
1770               open_read_file
1771
1772    IMPLICIT NONE
1773
1774    CHARACTER(LEN=25),  DIMENSION(:), ALLOCATABLE ::  cc_name    !< chemical component name
1775    CHARACTER(LEN=100), DIMENSION(:), ALLOCATABLE ::  var_names  !< variable names
1776
1777    INTEGER(iwp) ::  ee        !< index: end
1778    INTEGER(iwp) ::  i         !< loop index: x-direction
1779    INTEGER(iwp) ::  ib        !< loop index: size bins
1780    INTEGER(iwp) ::  ic        !< loop index: chemical components
1781    INTEGER(iwp) ::  id_dyn    !< NetCDF id of PIDS_DYNAMIC_SALSA
1782    INTEGER(iwp) ::  ig        !< loop index: gases
1783    INTEGER(iwp) ::  j         !< loop index: y-direction
1784    INTEGER(iwp) ::  k         !< loop index: z-direction
1785    INTEGER(iwp) ::  lod_aero  !< level of detail of inital aerosol concentrations
1786    INTEGER(iwp) ::  num_vars  !< number of variables
1787    INTEGER(iwp) ::  pr_nbins  !< number of aerosol size bins in file
1788    INTEGER(iwp) ::  pr_ncc    !< number of aerosol chemical components in file
1789    INTEGER(iwp) ::  pr_nz     !< number of vertical grid-points in file
1790    INTEGER(iwp) ::  prunmode  !< running mode of SALSA
1791    INTEGER(iwp) ::  ss        !< index: start
1792
1793    INTEGER(iwp), DIMENSION(maxspec) ::  cc_in2mod
1794
1795    LOGICAL  ::  netcdf_extend = .FALSE. !< Flag: netcdf file exists
1796
1797    REAL(wp) ::  flag  !< flag to mask topography grid points
1798
1799    REAL(wp), DIMENSION(nbins_aerosol) ::  core   !< size of the bin mid aerosol particle
1800
1801    REAL(wp), DIMENSION(0:nz+1) ::  pnf2a   !< number fraction in 2a
1802    REAL(wp), DIMENSION(0:nz+1) ::  pmfoc1a !< mass fraction of OC in 1a
1803
1804    REAL(wp), DIMENSION(0:nz+1,nbins_aerosol)   ::  pndist  !< vertical profile of size dist. (#/m3)
1805    REAL(wp), DIMENSION(0:nz+1,maxspec)         ::  pmf2a   !< mass distributions in subrange 2a
1806    REAL(wp), DIMENSION(0:nz+1,maxspec)         ::  pmf2b   !< mass distributions in subrange 2b
1807
1808    REAL(wp), DIMENSION(:), ALLOCATABLE ::  pr_dmid  !< vertical profile of aerosol bin diameters
1809    REAL(wp), DIMENSION(:), ALLOCATABLE ::  pr_z     !< z levels of profiles
1810
1811    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  pr_mass_fracs_a  !< mass fraction: a
1812    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  pr_mass_fracs_b  !< and b
1813
1814    cc_in2mod = 0
1815    prunmode = 1
1816!
1817!-- Bin mean aerosol particle volume (m3)
1818    core(1:nbins_aerosol) = api6 * aero(1:nbins_aerosol)%dmid**3
1819!
1820!-- Set concentrations to zero
1821    pndist(:,:)  = 0.0_wp
1822    pnf2a(:)     = nf2a
1823    pmf2a(:,:)   = 0.0_wp
1824    pmf2b(:,:)   = 0.0_wp
1825    pmfoc1a(:)   = 0.0_wp
1826
1827    IF ( init_aerosol_type == 1 )  THEN
1828!
1829!--    Read input profiles from PIDS_DYNAMIC_SALSA
1830#if defined( __netcdf )
1831!
1832!--    Location-dependent size distributions and compositions.
1833       INQUIRE( FILE = TRIM( input_file_dynamic ) //  TRIM( coupling_char ), EXIST = netcdf_extend )
1834       IF ( netcdf_extend )  THEN
1835!
1836!--       Open file in read-only mode
1837          CALL open_read_file( TRIM( input_file_dynamic ) // TRIM( coupling_char ), id_dyn )
1838!
1839!--       At first, inquire all variable names
1840          CALL inquire_num_variables( id_dyn, num_vars )
1841!
1842!--       Allocate memory to store variable names
1843          ALLOCATE( var_names(1:num_vars) )
1844          CALL inquire_variable_names( id_dyn, var_names )
1845!
1846!--       Inquire vertical dimension and number of aerosol chemical components
1847          CALL get_dimension_length( id_dyn, pr_nz, 'z' )
1848          IF ( pr_nz /= nz )  THEN
1849             WRITE( message_string, * ) 'Number of inifor horizontal grid points does not match '//&
1850                                        'the number of numeric grid points.'
1851             CALL message( 'aerosol_init', 'PA0601', 1, 2, 0, 6, 0 )
1852          ENDIF
1853          CALL get_dimension_length( id_dyn, pr_ncc, 'composition_index' )
1854!
1855!--       Allocate memory
1856          ALLOCATE( pr_z(1:pr_nz), pr_mass_fracs_a(nzb:nzt+1,pr_ncc),                              &
1857                    pr_mass_fracs_b(nzb:nzt+1,pr_ncc) )
1858          pr_mass_fracs_a = 0.0_wp
1859          pr_mass_fracs_b = 0.0_wp
1860!
1861!--       Read vertical levels
1862          CALL get_variable( id_dyn, 'z', pr_z )
1863!
1864!--       Read the names of chemical components
1865          IF ( check_existence( var_names, 'composition_name' ) )  THEN
1866             CALL get_variable( id_dyn, 'composition_name', cc_name, pr_ncc )
1867          ELSE
1868             WRITE( message_string, * ) 'Missing composition_name in ' // TRIM( input_file_dynamic )
1869             CALL message( 'aerosol_init', 'PA0655', 1, 2, 0, 6, 0 )
1870          ENDIF
1871!
1872!--       Define the index of each chemical component in the model
1873          DO  ic = 1, pr_ncc
1874             SELECT CASE ( TRIM( cc_name(ic) ) )
1875                CASE ( 'H2SO4', 'SO4', 'h2so4', 'so4' )
1876                   cc_in2mod(1) = ic
1877                CASE ( 'OC', 'oc' )
1878                   cc_in2mod(2) = ic
1879                CASE ( 'BC', 'bc' )
1880                   cc_in2mod(3) = ic
1881                CASE ( 'DU', 'du' )
1882                   cc_in2mod(4) = ic
1883                CASE ( 'SS', 'ss' )
1884                   cc_in2mod(5) = ic
1885                CASE ( 'HNO3', 'hno3', 'NO3', 'no3', 'NO', 'no' )
1886                   cc_in2mod(6) = ic
1887                CASE ( 'NH3', 'nh3', 'NH4', 'nh4', 'NH', 'nh' )
1888                   cc_in2mod(7) = ic
1889             END SELECT
1890          ENDDO
1891
1892          IF ( SUM( cc_in2mod ) == 0 )  THEN
1893             message_string = 'None of the aerosol chemical components in ' // TRIM(               &
1894                              input_file_dynamic ) // ' correspond to ones applied in SALSA.'
1895             CALL message( 'salsa_mod: aerosol_init', 'PA0602', 2, 2, 0, 6, 0 )
1896          ENDIF
1897!
1898!--       Vertical profiles of mass fractions of different chemical components:
1899          IF ( check_existence( var_names, 'init_atmosphere_mass_fracs_a' ) )  THEN
1900             CALL get_variable( id_dyn, 'init_atmosphere_mass_fracs_a', pr_mass_fracs_a,           &
1901                                0, pr_ncc-1, 0, pr_nz-1 )
1902          ELSE
1903             WRITE( message_string, * ) 'Missing init_atmosphere_mass_fracs_a in ' //              &
1904                                        TRIM( input_file_dynamic )
1905             CALL message( 'aerosol_init', 'PA0656', 1, 2, 0, 6, 0 )
1906          ENDIF
1907          CALL get_variable( id_dyn, 'init_atmosphere_mass_fracs_b', pr_mass_fracs_b,              &
1908                             0, pr_ncc-1, 0, pr_nz-1  )
1909!
1910!--       Match the input data with the chemical composition applied in the model
1911          DO  ic = 1, maxspec
1912             ss = cc_in2mod(ic)
1913             IF ( ss == 0 )  CYCLE
1914             pmf2a(nzb+1:nzt+1,ic) = pr_mass_fracs_a(nzb:nzt,ss)
1915             pmf2b(nzb+1:nzt+1,ic) = pr_mass_fracs_b(nzb:nzt,ss)
1916          ENDDO
1917!
1918!--       Aerosol concentrations: lod=1 (vertical profile of sectional number size distribution)
1919          CALL get_attribute( id_dyn, 'lod', lod_aero, .FALSE., 'init_atmosphere_aerosol' )
1920          IF ( lod_aero /= 1 )  THEN
1921             message_string = 'Currently only lod=1 accepted for init_atmosphere_aerosol'
1922             CALL message( 'salsa_mod: aerosol_init', 'PA0603', 2, 2, 0, 6, 0 )
1923          ELSE
1924!
1925!--          Bin mean diameters in the input file
1926             CALL get_dimension_length( id_dyn, pr_nbins, 'Dmid')
1927             IF ( pr_nbins /= nbins_aerosol )  THEN
1928                message_string = 'Number of size bins in init_atmosphere_aerosol does not match '  &
1929                                 // 'with that applied in the model'
1930                CALL message( 'salsa_mod: aerosol_init', 'PA0604', 2, 2, 0, 6, 0 )
1931             ENDIF
1932
1933             ALLOCATE( pr_dmid(pr_nbins) )
1934             pr_dmid    = 0.0_wp
1935
1936             CALL get_variable( id_dyn, 'Dmid', pr_dmid )
1937!
1938!--          Check whether the sectional representation conform to the one
1939!--          applied in the model
1940             IF ( ANY( ABS( ( aero(1:nbins_aerosol)%dmid - pr_dmid ) /                             &
1941                              aero(1:nbins_aerosol)%dmid )  > 0.1_wp )  ) THEN
1942                message_string = 'Mean diameters of the aerosol size bins in ' // TRIM(            &
1943                                 input_file_dynamic ) // ' do not match with the sectional '//     &
1944                                 'representation of the model.'
1945                CALL message( 'salsa_mod: aerosol_init', 'PA0605', 2, 2, 0, 6, 0 )
1946             ENDIF
1947!
1948!--          Inital aerosol concentrations
1949             CALL get_variable( id_dyn, 'init_atmosphere_aerosol', pndist(nzb+1:nzt,:),            &
1950                                0, pr_nbins-1, 0, pr_nz-1 )
1951          ENDIF
1952!
1953!--       Set bottom and top boundary condition (Neumann)
1954          pmf2a(nzb,:)    = pmf2a(nzb+1,:)
1955          pmf2a(nzt+1,:)  = pmf2a(nzt,:)
1956          pmf2b(nzb,:)    = pmf2b(nzb+1,:)
1957          pmf2b(nzt+1,:)  = pmf2b(nzt,:)
1958          pndist(nzb,:)   = pndist(nzb+1,:)
1959          pndist(nzt+1,:) = pndist(nzt,:)
1960
1961          IF ( index_so4 < 0 )  THEN
1962             pmf2a(:,1) = 0.0_wp
1963             pmf2b(:,1) = 0.0_wp
1964          ENDIF
1965          IF ( index_oc < 0 )  THEN
1966             pmf2a(:,2) = 0.0_wp
1967             pmf2b(:,2) = 0.0_wp
1968          ENDIF
1969          IF ( index_bc < 0 )  THEN
1970             pmf2a(:,3) = 0.0_wp
1971             pmf2b(:,3) = 0.0_wp
1972          ENDIF
1973          IF ( index_du < 0 )  THEN
1974             pmf2a(:,4) = 0.0_wp
1975             pmf2b(:,4) = 0.0_wp
1976          ENDIF
1977          IF ( index_ss < 0 )  THEN
1978             pmf2a(:,5) = 0.0_wp
1979             pmf2b(:,5) = 0.0_wp
1980          ENDIF
1981          IF ( index_no < 0 )  THEN
1982             pmf2a(:,6) = 0.0_wp
1983             pmf2b(:,6) = 0.0_wp
1984          ENDIF
1985          IF ( index_nh < 0 )  THEN
1986             pmf2a(:,7) = 0.0_wp
1987             pmf2b(:,7) = 0.0_wp
1988          ENDIF
1989
1990          IF ( SUM( pmf2a ) < 0.00001_wp  .AND.  SUM( pmf2b ) < 0.00001_wp )  THEN
1991             message_string = 'Error in initialising mass fractions of chemical components. ' //   &
1992                              'Check that all chemical components are included in parameter file!'
1993             CALL message( 'salsa_mod: aerosol_init', 'PA0606', 2, 2, 0, 6, 0 ) 
1994          ENDIF
1995!
1996!--       Then normalise the mass fraction so that SUM = 1
1997          DO  k = nzb, nzt+1
1998             pmf2a(k,:) = pmf2a(k,:) / SUM( pmf2a(k,:) )
1999             IF ( SUM( pmf2b(k,:) ) > 0.0_wp )  pmf2b(k,:) = pmf2b(k,:) / SUM( pmf2b(k,:) )
2000          ENDDO
2001
2002          DEALLOCATE( pr_z, pr_mass_fracs_a, pr_mass_fracs_b )
2003
2004       ELSE
2005          message_string = 'Input file '// TRIM( input_file_dynamic ) // TRIM( coupling_char ) //  &
2006                           ' for SALSA missing!'
2007          CALL message( 'salsa_mod: aerosol_init', 'PA0607', 1, 2, 0, 6, 0 )
2008!
2009!--       Close input file
2010          CALL close_input_file( id_dyn )
2011       ENDIF   ! netcdf_extend
2012
2013#else
2014       message_string = 'init_aerosol_type = 1 but preprocessor directive __netcdf is not used '// &
2015                        'in compiling!'
2016       CALL message( 'salsa_mod: aerosol_init', 'PA0608', 1, 2, 0, 6, 0 )
2017
2018#endif
2019
2020    ELSEIF ( init_aerosol_type == 0 )  THEN
2021!
2022!--    Mass fractions for species in a and b-bins
2023       IF ( index_so4 > 0 )  THEN
2024          pmf2a(:,1) = mass_fracs_a(index_so4)
2025          pmf2b(:,1) = mass_fracs_b(index_so4)
2026       ENDIF
2027       IF ( index_oc > 0 )  THEN
2028          pmf2a(:,2) = mass_fracs_a(index_oc)
2029          pmf2b(:,2) = mass_fracs_b(index_oc)
2030       ENDIF
2031       IF ( index_bc > 0 )  THEN
2032          pmf2a(:,3) = mass_fracs_a(index_bc)
2033          pmf2b(:,3) = mass_fracs_b(index_bc)
2034       ENDIF
2035       IF ( index_du > 0 )  THEN
2036          pmf2a(:,4) = mass_fracs_a(index_du)
2037          pmf2b(:,4) = mass_fracs_b(index_du)
2038       ENDIF
2039       IF ( index_ss > 0 )  THEN
2040          pmf2a(:,5) = mass_fracs_a(index_ss)
2041          pmf2b(:,5) = mass_fracs_b(index_ss)
2042       ENDIF
2043       IF ( index_no > 0 )  THEN
2044          pmf2a(:,6) = mass_fracs_a(index_no)
2045          pmf2b(:,6) = mass_fracs_b(index_no)
2046       ENDIF
2047       IF ( index_nh > 0 )  THEN
2048          pmf2a(:,7) = mass_fracs_a(index_nh)
2049          pmf2b(:,7) = mass_fracs_b(index_nh)
2050       ENDIF
2051       DO  k = nzb, nzt+1
2052          pmf2a(k,:) = pmf2a(k,:) / SUM( pmf2a(k,:) )
2053          IF ( SUM( pmf2b(k,:) ) > 0.0_wp ) pmf2b(k,:) = pmf2b(k,:) / SUM( pmf2b(k,:) )
2054       ENDDO
2055
2056       CALL size_distribution( n_lognorm, dpg, sigmag, nsect )
2057!
2058!--    Normalize by the given total number concentration
2059       nsect = nsect * SUM( n_lognorm ) / SUM( nsect )
2060       DO  ib = start_subrange_1a, end_subrange_2b
2061          pndist(:,ib) = nsect(ib)
2062       ENDDO
2063    ENDIF
2064
2065    IF ( init_gases_type == 1 )  THEN
2066!
2067!--    Read input profiles from PIDS_CHEM
2068#if defined( __netcdf )
2069!
2070!--    Location-dependent size distributions and compositions.
2071       INQUIRE( FILE = TRIM( input_file_dynamic ) //  TRIM( coupling_char ), EXIST = netcdf_extend )
2072       IF ( netcdf_extend  .AND.  .NOT. salsa_gases_from_chem )  THEN
2073!
2074!--       Open file in read-only mode
2075          CALL open_read_file( TRIM( input_file_dynamic ) // TRIM( coupling_char ), id_dyn )
2076!
2077!--       Inquire dimensions:
2078          CALL get_dimension_length( id_dyn, pr_nz, 'z' )
2079          IF ( pr_nz /= nz )  THEN
2080             WRITE( message_string, * ) 'Number of inifor horizontal grid points does not match '//&
2081                                        'the number of numeric grid points.'
2082             CALL message( 'aerosol_init', 'PA0609', 1, 2, 0, 6, 0 )
2083          ENDIF
2084!
2085!--       Read vertical profiles of gases:
2086          CALL get_variable( id_dyn, 'init_atmosphere_h2so4', salsa_gas(1)%init(nzb+1:nzt) )
2087          CALL get_variable( id_dyn, 'init_atmosphere_hno3',  salsa_gas(2)%init(nzb+1:nzt) )
2088          CALL get_variable( id_dyn, 'init_atmosphere_nh3',   salsa_gas(3)%init(nzb+1:nzt) )
2089          CALL get_variable( id_dyn, 'init_atmosphere_ocnv',  salsa_gas(4)%init(nzb+1:nzt) )
2090          CALL get_variable( id_dyn, 'init_atmosphere_ocsv',  salsa_gas(5)%init(nzb+1:nzt) )
2091!
2092!--       Set Neumann top and surface boundary condition for initial + initialise concentrations
2093          DO  ig = 1, ngases_salsa
2094             salsa_gas(ig)%init(nzb)   =  salsa_gas(ig)%init(nzb+1)
2095             salsa_gas(ig)%init(nzt+1) =  salsa_gas(ig)%init(nzt)
2096             IF ( .NOT. read_restart_data_salsa )  THEN
2097                DO  k = nzb, nzt+1
2098                   salsa_gas(ig)%conc(k,:,:) = salsa_gas(ig)%init(k)
2099                ENDDO
2100             ENDIF
2101          ENDDO
2102
2103       ELSEIF ( .NOT. netcdf_extend  .AND.  .NOT.  salsa_gases_from_chem )  THEN
2104          message_string = 'Input file '// TRIM( input_file_dynamic ) // TRIM( coupling_char ) //  &
2105                           ' for SALSA missing!'
2106          CALL message( 'salsa_mod: aerosol_init', 'PA0610', 1, 2, 0, 6, 0 )
2107!
2108!--       Close input file
2109          CALL close_input_file( id_dyn )
2110       ENDIF   ! netcdf_extend
2111#else
2112       message_string = 'init_gases_type = 1 but preprocessor directive __netcdf is not used in '//&
2113                        'compiling!'
2114       CALL message( 'salsa_mod: aerosol_init', 'PA0611', 1, 2, 0, 6, 0 )
2115
2116#endif
2117
2118    ENDIF
2119!
2120!-- Both SO4 and OC are included, so use the given mass fractions
2121    IF ( index_oc > 0  .AND.  index_so4 > 0 )  THEN
2122       pmfoc1a(:) = pmf2a(:,2) / ( pmf2a(:,2) + pmf2a(:,1) )  ! Normalize
2123!
2124!-- Pure organic carbon
2125    ELSEIF ( index_oc > 0 )  THEN
2126       pmfoc1a(:) = 1.0_wp
2127!
2128!-- Pure SO4
2129    ELSEIF ( index_so4 > 0 )  THEN
2130       pmfoc1a(:) = 0.0_wp
2131
2132    ELSE
2133       message_string = 'Either OC or SO4 must be active for aerosol region 1a!'
2134       CALL message( 'salsa_mod: aerosol_init', 'PA0612', 1, 2, 0, 6, 0 )
2135    ENDIF
2136
2137!
2138!-- Initialize concentrations
2139    DO  i = nxlg, nxrg
2140       DO  j = nysg, nyng
2141          DO  k = nzb, nzt+1
2142!
2143!--          Predetermine flag to mask topography
2144             flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_0(k,j,i), 0 ) )
2145!
2146!--          a) Number concentrations
2147!--          Region 1:
2148             DO  ib = start_subrange_1a, end_subrange_1a
2149                IF ( .NOT. read_restart_data_salsa )  THEN
2150                   aerosol_number(ib)%conc(k,j,i) = pndist(k,ib) * flag
2151                ENDIF
2152                IF ( prunmode == 1 )  THEN
2153                   aerosol_number(ib)%init = pndist(:,ib)
2154                ENDIF
2155             ENDDO
2156!
2157!--          Region 2:
2158             IF ( nreg > 1 )  THEN
2159                DO  ib = start_subrange_2a, end_subrange_2a
2160                   IF ( .NOT. read_restart_data_salsa )  THEN
2161                      aerosol_number(ib)%conc(k,j,i) = MAX( 0.0_wp, pnf2a(k) ) * pndist(k,ib) * flag
2162                   ENDIF
2163                   IF ( prunmode == 1 )  THEN
2164                      aerosol_number(ib)%init = MAX( 0.0_wp, nf2a ) * pndist(:,ib)
2165                   ENDIF
2166                ENDDO
2167                IF ( .NOT. no_insoluble )  THEN
2168                   DO  ib = start_subrange_2b, end_subrange_2b
2169                      IF ( pnf2a(k) < 1.0_wp )  THEN
2170                         IF ( .NOT. read_restart_data_salsa )  THEN
2171                            aerosol_number(ib)%conc(k,j,i) = MAX( 0.0_wp, 1.0_wp - pnf2a(k) ) *    &
2172                                                             pndist(k,ib) * flag
2173                         ENDIF
2174                         IF ( prunmode == 1 )  THEN
2175                            aerosol_number(ib)%init = MAX( 0.0_wp, 1.0_wp - nf2a ) * pndist(:,ib)
2176                         ENDIF
2177                      ENDIF
2178                   ENDDO
2179                ENDIF
2180             ENDIF
2181!
2182!--          b) Aerosol mass concentrations
2183!--             bin subrange 1: done here separately due to the SO4/OC convention
2184!
2185!--          SO4:
2186             IF ( index_so4 > 0 )  THEN
2187                ss = ( index_so4 - 1 ) * nbins_aerosol + start_subrange_1a !< start
2188                ee = ( index_so4 - 1 ) * nbins_aerosol + end_subrange_1a !< end
2189                ib = start_subrange_1a
2190                DO  ic = ss, ee
2191                   IF ( .NOT. read_restart_data_salsa )  THEN
2192                      aerosol_mass(ic)%conc(k,j,i) = MAX( 0.0_wp, 1.0_wp - pmfoc1a(k) ) *          &
2193                                                     pndist(k,ib) * core(ib) * arhoh2so4 * flag
2194                   ENDIF
2195                   IF ( prunmode == 1 )  THEN
2196                      aerosol_mass(ic)%init(k) = MAX( 0.0_wp, 1.0_wp - pmfoc1a(k) ) * pndist(k,ib) &
2197                                                 * core(ib) * arhoh2so4
2198                   ENDIF
2199                   ib = ib+1
2200                ENDDO
2201             ENDIF
2202!
2203!--          OC:
2204             IF ( index_oc > 0 ) THEN
2205                ss = ( index_oc - 1 ) * nbins_aerosol + start_subrange_1a !< start
2206                ee = ( index_oc - 1 ) * nbins_aerosol + end_subrange_1a !< end
2207                ib = start_subrange_1a
2208                DO  ic = ss, ee
2209                   IF ( .NOT. read_restart_data_salsa )  THEN
2210                      aerosol_mass(ic)%conc(k,j,i) = MAX( 0.0_wp, pmfoc1a(k) ) * pndist(k,ib) *    &
2211                                                     core(ib) * arhooc * flag
2212                   ENDIF
2213                   IF ( prunmode == 1 )  THEN
2214                      aerosol_mass(ic)%init(k) = MAX( 0.0_wp, pmfoc1a(k) ) * pndist(k,ib) *        &
2215                                                 core(ib) * arhooc
2216                   ENDIF
2217                   ib = ib+1
2218                ENDDO 
2219             ENDIF
2220          ENDDO !< k
2221
2222          prunmode = 3  ! Init only once
2223
2224       ENDDO !< j
2225    ENDDO !< i
2226
2227!
2228!-- c) Aerosol mass concentrations
2229!--    bin subrange 2:
2230    IF ( nreg > 1 ) THEN
2231
2232       IF ( index_so4 > 0 ) THEN
2233          CALL set_aero_mass( index_so4, pmf2a(:,1), pmf2b(:,1), pnf2a, pndist, core, arhoh2so4 )
2234       ENDIF
2235       IF ( index_oc > 0 ) THEN
2236          CALL set_aero_mass( index_oc, pmf2a(:,2), pmf2b(:,2), pnf2a, pndist, core, arhooc )
2237       ENDIF
2238       IF ( index_bc > 0 ) THEN
2239          CALL set_aero_mass( index_bc, pmf2a(:,3), pmf2b(:,3), pnf2a, pndist, core, arhobc )
2240       ENDIF
2241       IF ( index_du > 0 ) THEN
2242          CALL set_aero_mass( index_du, pmf2a(:,4), pmf2b(:,4), pnf2a, pndist, core, arhodu )
2243       ENDIF
2244       IF ( index_ss > 0 ) THEN
2245          CALL set_aero_mass( index_ss, pmf2a(:,5), pmf2b(:,5), pnf2a, pndist, core, arhoss )
2246       ENDIF
2247       IF ( index_no > 0 ) THEN
2248          CALL set_aero_mass( index_no, pmf2a(:,6), pmf2b(:,6), pnf2a, pndist, core, arhohno3 )
2249       ENDIF
2250       IF ( index_nh > 0 ) THEN
2251          CALL set_aero_mass( index_nh, pmf2a(:,7), pmf2b(:,7), pnf2a, pndist, core, arhonh3 )
2252       ENDIF
2253
2254    ENDIF
2255
2256 END SUBROUTINE aerosol_init
2257
2258!------------------------------------------------------------------------------!
2259! Description:
2260! ------------
2261!> Create a lognormal size distribution and discretise to a sectional
2262!> representation.
2263!------------------------------------------------------------------------------!
2264 SUBROUTINE size_distribution( in_ntot, in_dpg, in_sigma, psd_sect )
2265
2266    IMPLICIT NONE
2267
2268    INTEGER(iwp) ::  ib         !< running index: bin
2269    INTEGER(iwp) ::  iteration  !< running index: iteration
2270
2271    REAL(wp) ::  d1         !< particle diameter (m, dummy)
2272    REAL(wp) ::  d2         !< particle diameter (m, dummy)
2273    REAL(wp) ::  delta_d    !< (d2-d1)/10
2274    REAL(wp) ::  deltadp    !< bin width
2275    REAL(wp) ::  dmidi      !< ( d1 + d2 ) / 2
2276
2277    REAL(wp), DIMENSION(:), INTENT(in) ::  in_dpg    !< geometric mean diameter (m)
2278    REAL(wp), DIMENSION(:), INTENT(in) ::  in_ntot   !< number conc. (#/m3)
2279    REAL(wp), DIMENSION(:), INTENT(in) ::  in_sigma  !< standard deviation
2280
2281    REAL(wp), DIMENSION(:), INTENT(inout) ::  psd_sect  !< sectional size distribution
2282
2283    DO  ib = start_subrange_1a, end_subrange_2b
2284       psd_sect(ib) = 0.0_wp
2285!
2286!--    Particle diameter at the low limit (largest in the bin) (m)
2287       d1 = ( aero(ib)%vlolim / api6 )**0.33333333_wp
2288!
2289!--    Particle diameter at the high limit (smallest in the bin) (m)
2290       d2 = ( aero(ib)%vhilim / api6 )**0.33333333_wp
2291!
2292!--    Span of particle diameter in a bin (m)
2293       delta_d = 0.1_wp * ( d2 - d1 )
2294!
2295!--    Iterate:
2296       DO  iteration = 1, 10
2297          d1 = ( aero(ib)%vlolim / api6 )**0.33333333_wp + ( ib - 1) * delta_d
2298          d2 = d1 + delta_d
2299          dmidi = 0.5_wp * ( d1 + d2 )
2300          deltadp = LOG10( d2 / d1 )
2301!
2302!--       Size distribution
2303!--       in_ntot = total number, total area, or total volume concentration
2304!--       in_dpg = geometric-mean number, area, or volume diameter
2305!--       n(k) = number, area, or volume concentration in a bin
2306          psd_sect(ib) = psd_sect(ib) + SUM( in_ntot * deltadp / ( SQRT( 2.0_wp * pi ) *           &
2307                        LOG10( in_sigma ) ) * EXP( -LOG10( dmidi / in_dpg )**2.0_wp /              &
2308                        ( 2.0_wp * LOG10( in_sigma ) ** 2.0_wp ) ) )
2309
2310       ENDDO
2311    ENDDO
2312
2313 END SUBROUTINE size_distribution
2314
2315!------------------------------------------------------------------------------!
2316! Description:
2317! ------------
2318!> Sets the mass concentrations to aerosol arrays in 2a and 2b.
2319!>
2320!> Tomi Raatikainen, FMI, 29.2.2016
2321!------------------------------------------------------------------------------!
2322 SUBROUTINE set_aero_mass( ispec, pmf2a, pmf2b, pnf2a, pndist, pcore, prho )
2323
2324    IMPLICIT NONE
2325
2326    INTEGER(iwp) ::  ee        !< index: end
2327    INTEGER(iwp) ::  i         !< loop index
2328    INTEGER(iwp) ::  ib        !< loop index
2329    INTEGER(iwp) ::  ic        !< loop index
2330    INTEGER(iwp) ::  j         !< loop index
2331    INTEGER(iwp) ::  k         !< loop index
2332    INTEGER(iwp) ::  prunmode  !< 1 = initialise
2333    INTEGER(iwp) ::  ss        !< index: start
2334
2335    INTEGER(iwp), INTENT(in) :: ispec  !< Aerosol species index
2336
2337    REAL(wp) ::  flag   !< flag to mask topography grid points
2338
2339    REAL(wp), INTENT(in) ::  prho !< Aerosol density
2340
2341    REAL(wp), DIMENSION(nbins_aerosol), INTENT(in) ::  pcore !< Aerosol bin mid core volume
2342    REAL(wp), DIMENSION(0:nz+1), INTENT(in)        ::  pnf2a !< Number fraction for 2a
2343    REAL(wp), DIMENSION(0:nz+1), INTENT(in)        ::  pmf2a !< Mass distributions for a
2344    REAL(wp), DIMENSION(0:nz+1), INTENT(in)        ::  pmf2b !< and b bins
2345
2346    REAL(wp), DIMENSION(0:nz+1,nbins_aerosol), INTENT(in) ::  pndist !< Aerosol size distribution
2347
2348    prunmode = 1
2349
2350    DO i = nxlg, nxrg
2351       DO j = nysg, nyng
2352          DO k = nzb, nzt+1
2353!
2354!--          Predetermine flag to mask topography
2355             flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_0(k,j,i), 0 ) ) 
2356!
2357!--          Regime 2a:
2358             ss = ( ispec - 1 ) * nbins_aerosol + start_subrange_2a
2359             ee = ( ispec - 1 ) * nbins_aerosol + end_subrange_2a
2360             ib = start_subrange_2a
2361             DO ic = ss, ee
2362                IF ( .NOT. read_restart_data_salsa )  THEN
2363                   aerosol_mass(ic)%conc(k,j,i) = MAX( 0.0_wp, pmf2a(k) ) * pnf2a(k) * pndist(k,ib)&
2364                                                  * pcore(ib) * prho * flag
2365                ENDIF
2366                IF ( prunmode == 1 )  THEN
2367                   aerosol_mass(ic)%init(k) = MAX( 0.0_wp, pmf2a(k) ) * pnf2a(k) * pndist(k,ib) *  &
2368                                              pcore(ib) * prho
2369                ENDIF
2370                ib = ib + 1
2371             ENDDO
2372!
2373!--          Regime 2b:
2374             IF ( .NOT. no_insoluble )  THEN
2375                ss = ( ispec - 1 ) * nbins_aerosol + start_subrange_2b
2376                ee = ( ispec - 1 ) * nbins_aerosol + end_subrange_2b
2377                ib = start_subrange_2a
2378                DO ic = ss, ee
2379                   IF ( .NOT. read_restart_data_salsa )  THEN
2380                      aerosol_mass(ic)%conc(k,j,i) = MAX( 0.0_wp, pmf2b(k) ) * ( 1.0_wp - pnf2a(k))&
2381                                                     * pndist(k,ib) * pcore(ib) * prho * flag
2382                   ENDIF
2383                   IF ( prunmode == 1 )  THEN
2384                      aerosol_mass(ic)%init(k) = MAX( 0.0_wp, pmf2b(k) ) * ( 1.0_wp - pnf2a(k) ) * &
2385                                                 pndist(k,ib) * pcore(ib) * prho 
2386                   ENDIF
2387                   ib = ib + 1
2388                ENDDO  ! c
2389
2390             ENDIF
2391          ENDDO   ! k
2392
2393          prunmode = 3  ! Init only once
2394
2395       ENDDO   ! j
2396    ENDDO   ! i
2397
2398 END SUBROUTINE set_aero_mass
2399
2400!------------------------------------------------------------------------------!
2401! Description:
2402! ------------
2403!> Initialise the matching between surface types in LSM and deposition models.
2404!> Do the matching based on Zhang et al. (2001). Atmos. Environ. 35, 549-560
2405!> (here referred as Z01).
2406!------------------------------------------------------------------------------!
2407 SUBROUTINE init_deposition
2408
2409    USE surface_mod,                                                                               &
2410        ONLY:  surf_lsm_h, surf_lsm_v, surf_usm_h, surf_usm_v
2411
2412    IMPLICIT NONE
2413
2414    INTEGER(iwp) ::  l  !< loop index for vertical surfaces
2415
2416    LOGICAL :: match_lsm  !< flag to initilise LSM surfaces (if false, initialise USM surfaces)
2417
2418    IF ( depo_pcm_par == 'zhang2001' )  THEN
2419       depo_pcm_par_num = 1
2420    ELSEIF ( depo_pcm_par == 'petroff2010' )  THEN
2421       depo_pcm_par_num = 2
2422    ENDIF
2423
2424    IF ( depo_surf_par == 'zhang2001' )  THEN
2425       depo_surf_par_num = 1
2426    ELSEIF ( depo_surf_par == 'petroff2010' )  THEN
2427       depo_surf_par_num = 2
2428    ENDIF
2429!
2430!-- LSM: Pavement, vegetation and water
2431    IF ( nldepo_surf  .AND.  land_surface )  THEN
2432       match_lsm = .TRUE.
2433       ALLOCATE( lsm_to_depo_h%match_lupg(1:surf_lsm_h%ns),                                         &
2434                 lsm_to_depo_h%match_luvw(1:surf_lsm_h%ns),                                         &
2435                 lsm_to_depo_h%match_luww(1:surf_lsm_h%ns) )
2436       lsm_to_depo_h%match_lupg = 0
2437       lsm_to_depo_h%match_luvw = 0
2438       lsm_to_depo_h%match_luww = 0
2439       CALL match_sm_zhang( surf_lsm_h, lsm_to_depo_h%match_lupg, lsm_to_depo_h%match_luvw,        &
2440                            lsm_to_depo_h%match_luww, match_lsm )
2441       DO  l = 0, 3
2442          ALLOCATE( lsm_to_depo_v(l)%match_lupg(1:surf_lsm_v(l)%ns),                               &
2443                    lsm_to_depo_v(l)%match_luvw(1:surf_lsm_v(l)%ns),                               &
2444                    lsm_to_depo_v(l)%match_luww(1:surf_lsm_v(l)%ns) )
2445          lsm_to_depo_v(l)%match_lupg = 0
2446          lsm_to_depo_v(l)%match_luvw = 0
2447          lsm_to_depo_v(l)%match_luww = 0
2448          CALL match_sm_zhang( surf_lsm_v(l), lsm_to_depo_v(l)%match_lupg,                         &
2449                               lsm_to_depo_v(l)%match_luvw, lsm_to_depo_v(l)%match_luww, match_lsm )
2450       ENDDO
2451    ENDIF
2452!
2453!-- USM: Green roofs/walls, wall surfaces and windows
2454    IF ( nldepo_surf  .AND.  urban_surface )  THEN
2455       match_lsm = .FALSE.
2456       ALLOCATE( usm_to_depo_h%match_lupg(1:surf_usm_h%ns),                                        &
2457                 usm_to_depo_h%match_luvw(1:surf_usm_h%ns),                                        &
2458                 usm_to_depo_h%match_luww(1:surf_usm_h%ns) )
2459       usm_to_depo_h%match_lupg = 0
2460       usm_to_depo_h%match_luvw = 0
2461       usm_to_depo_h%match_luww = 0
2462       CALL match_sm_zhang( surf_usm_h, usm_to_depo_h%match_lupg, usm_to_depo_h%match_luvw,        &
2463                            usm_to_depo_h%match_luww, match_lsm )
2464       DO  l = 0, 3
2465          ALLOCATE( usm_to_depo_v(l)%match_lupg(1:surf_usm_v(l)%ns),                               &
2466                    usm_to_depo_v(l)%match_luvw(1:surf_usm_v(l)%ns),                               &
2467                    usm_to_depo_v(l)%match_luww(1:surf_usm_v(l)%ns) )
2468          usm_to_depo_v(l)%match_lupg = 0
2469          usm_to_depo_v(l)%match_luvw = 0
2470          usm_to_depo_v(l)%match_luww = 0
2471          CALL match_sm_zhang( surf_usm_v(l), usm_to_depo_v(l)%match_lupg,                         &
2472                               usm_to_depo_v(l)%match_luvw, usm_to_depo_v(l)%match_luww, match_lsm )
2473       ENDDO
2474    ENDIF
2475
2476    IF ( nldepo_pcm )  THEN
2477       SELECT CASE ( depo_pcm_type )
2478          CASE ( 'evergreen_needleleaf' )
2479             depo_pcm_type_num = 1
2480          CASE ( 'evergreen_broadleaf' )
2481             depo_pcm_type_num = 2
2482          CASE ( 'deciduous_needleleaf' )
2483             depo_pcm_type_num = 3
2484          CASE ( 'deciduous_broadleaf' )
2485             depo_pcm_type_num = 4
2486          CASE DEFAULT
2487             message_string = 'depo_pcm_type not set correctly.'
2488             CALL message( 'salsa_mod: init_deposition', 'PA0613', 1, 2, 0, 6, 0 )
2489       END SELECT
2490    ENDIF
2491
2492 END SUBROUTINE init_deposition
2493
2494!------------------------------------------------------------------------------!
2495! Description:
2496! ------------
2497!> Match the surface types in PALM and Zhang et al. 2001 deposition module
2498!------------------------------------------------------------------------------!
2499 SUBROUTINE match_sm_zhang( surf, match_pav_green, match_veg_wall, match_wat_win, match_lsm )
2500
2501    USE surface_mod,                                                           &
2502        ONLY:  ind_pav_green, ind_veg_wall, ind_wat_win, surf_type
2503
2504    IMPLICIT NONE
2505
2506    INTEGER(iwp) ::  m              !< index for surface elements
2507    INTEGER(iwp) ::  pav_type_palm  !< pavement / green wall type in PALM
2508    INTEGER(iwp) ::  veg_type_palm  !< vegetation / wall type in PALM
2509    INTEGER(iwp) ::  wat_type_palm  !< water / window type in PALM
2510
2511    INTEGER(iwp), DIMENSION(:), INTENT(inout) ::  match_pav_green  !<  matching pavement/green walls
2512    INTEGER(iwp), DIMENSION(:), INTENT(inout) ::  match_veg_wall   !<  matching vegetation/walls
2513    INTEGER(iwp), DIMENSION(:), INTENT(inout) ::  match_wat_win    !<  matching water/windows
2514
2515    LOGICAL, INTENT(in) :: match_lsm  !< flag to initilise LSM surfaces (if false, initialise USM)
2516
2517    TYPE(surf_type), INTENT(in) :: surf  !< respective surface type
2518
2519    DO  m = 1, surf%ns
2520       IF ( match_lsm )  THEN
2521!
2522!--       Vegetation (LSM):
2523          IF ( surf%frac(ind_veg_wall,m) > 0 )  THEN
2524             veg_type_palm = surf%vegetation_type(m)
2525             SELECT CASE ( veg_type_palm )
2526                CASE ( 0 )
2527                   message_string = 'No vegetation type defined.'
2528                   CALL message( 'salsa_mod: init_depo_surfaces', 'PA0614', 1, 2, 0, 6, 0 )
2529                CASE ( 1 )  ! bare soil
2530                   match_veg_wall(m) = 6  ! grass in Z01
2531                CASE ( 2 )  ! crops, mixed farming
2532                   match_veg_wall(m) = 7  !  crops, mixed farming Z01
2533                CASE ( 3 )  ! short grass
2534                   match_veg_wall(m) = 6  ! grass in Z01
2535                CASE ( 4 )  ! evergreen needleleaf trees
2536                    match_veg_wall(m) = 1  ! evergreen needleleaf trees in Z01
2537                CASE ( 5 )  ! deciduous needleleaf trees
2538                   match_veg_wall(m) = 3  ! deciduous needleleaf trees in Z01
2539                CASE ( 6 )  ! evergreen broadleaf trees
2540                   match_veg_wall(m) = 2  ! evergreen broadleaf trees in Z01
2541                CASE ( 7 )  ! deciduous broadleaf trees
2542                   match_veg_wall(m) = 4  ! deciduous broadleaf trees in Z01
2543                CASE ( 8 )  ! tall grass
2544                   match_veg_wall(m) = 6  ! grass in Z01
2545                CASE ( 9 )  ! desert
2546                   match_veg_wall(m) = 8  ! desert in Z01
2547                CASE ( 10 )  ! tundra
2548                   match_veg_wall(m) = 9  ! tundra in Z01
2549                CASE ( 11 )  ! irrigated crops
2550                   match_veg_wall(m) = 7  !  crops, mixed farming Z01
2551                CASE ( 12 )  ! semidesert
2552                   match_veg_wall(m) = 8  ! desert in Z01
2553                CASE ( 13 )  ! ice caps and glaciers
2554                   match_veg_wall(m) = 12  ! ice cap and glacier in Z01
2555                CASE ( 14 )  ! bogs and marshes
2556                   match_veg_wall(m) = 11  ! wetland with plants in Z01
2557                CASE ( 15 )  ! evergreen shrubs
2558                   match_veg_wall(m) = 10  ! shrubs and interrupted woodlands in Z01
2559                CASE ( 16 )  ! deciduous shrubs
2560                   match_veg_wall(m) = 10  ! shrubs and interrupted woodlands in Z01
2561                CASE ( 17 )  ! mixed forest/woodland
2562                   match_veg_wall(m) = 5  ! mixed broadleaf and needleleaf trees in Z01
2563                CASE ( 18 )  ! interrupted forest
2564                   match_veg_wall(m) = 10  ! shrubs and interrupted woodlands in Z01
2565             END SELECT
2566          ENDIF
2567!
2568!--       Pavement (LSM):
2569          IF ( surf%frac(ind_pav_green,m) > 0 )  THEN
2570             pav_type_palm = surf%pavement_type(m)
2571             IF ( pav_type_palm == 0 )  THEN  ! error
2572                message_string = 'No pavement type defined.'
2573                CALL message( 'salsa_mod: match_sm_zhang', 'PA0615', 1, 2, 0, 6, 0 )
2574             ELSE
2575                match_pav_green(m) = 15  ! urban in Z01
2576             ENDIF
2577          ENDIF
2578!
2579!--       Water (LSM):
2580          IF ( surf%frac(ind_wat_win,m) > 0 )  THEN
2581             wat_type_palm = surf%water_type(m)
2582             IF ( wat_type_palm == 0 )  THEN  ! error
2583                message_string = 'No water type defined.'
2584                CALL message( 'salsa_mod: match_sm_zhang', 'PA0616', 1, 2, 0, 6, 0 )
2585             ELSEIF ( wat_type_palm == 3 )  THEN
2586                match_wat_win(m) = 14  ! ocean in Z01
2587             ELSEIF ( wat_type_palm == 1  .OR.  wat_type_palm == 2 .OR.  wat_type_palm == 4        &
2588                      .OR.  wat_type_palm == 5  )  THEN
2589                match_wat_win(m) = 13  ! inland water in Z01
2590             ENDIF
2591          ENDIF
2592       ELSE
2593!
2594!--       Wall surfaces (USM):
2595          IF ( surf%frac(ind_veg_wall,m) > 0 )  THEN
2596             match_veg_wall(m) = 15  ! urban in Z01
2597          ENDIF
2598!
2599!--       Green walls and roofs (USM):
2600          IF ( surf%frac(ind_pav_green,m) > 0 )  THEN
2601             match_pav_green(m) =  6 ! (short) grass in Z01
2602          ENDIF
2603!
2604!--       Windows (USM):
2605          IF ( surf%frac(ind_wat_win,m) > 0 )  THEN
2606             match_wat_win(m) = 15  ! urban in Z01
2607          ENDIF
2608       ENDIF
2609
2610    ENDDO
2611
2612 END SUBROUTINE match_sm_zhang
2613
2614!------------------------------------------------------------------------------!
2615! Description:
2616! ------------
2617!> Swapping of timelevels
2618!------------------------------------------------------------------------------!
2619 SUBROUTINE salsa_swap_timelevel( mod_count )
2620
2621    IMPLICIT NONE
2622
2623    INTEGER(iwp) ::  ib   !<
2624    INTEGER(iwp) ::  ic   !<
2625    INTEGER(iwp) ::  icc  !<
2626    INTEGER(iwp) ::  ig   !<
2627
2628    INTEGER(iwp), INTENT(IN) ::  mod_count  !<
2629
2630    IF ( time_since_reference_point >= skip_time_do_salsa )  THEN
2631
2632       SELECT CASE ( mod_count )
2633
2634          CASE ( 0 )
2635
2636             DO  ib = 1, nbins_aerosol
2637                aerosol_number(ib)%conc(nzb:nzt+1,nysg:nyng,nxlg:nxrg)   => nconc_1(:,:,:,ib)
2638                aerosol_number(ib)%conc_p(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => nconc_2(:,:,:,ib)
2639
2640                DO  ic = 1, ncomponents_mass
2641                   icc = ( ic-1 ) * nbins_aerosol + ib
2642                   aerosol_mass(icc)%conc(nzb:nzt+1,nysg:nyng,nxlg:nxrg)   => mconc_1(:,:,:,icc)
2643                   aerosol_mass(icc)%conc_p(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => mconc_2(:,:,:,icc)
2644                ENDDO
2645             ENDDO
2646
2647             IF ( .NOT. salsa_gases_from_chem )  THEN
2648                DO  ig = 1, ngases_salsa
2649                   salsa_gas(ig)%conc(nzb:nzt+1,nysg:nyng,nxlg:nxrg)   => gconc_1(:,:,:,ig)
2650                   salsa_gas(ig)%conc_p(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => gconc_2(:,:,:,ig)
2651                ENDDO
2652             ENDIF
2653
2654          CASE ( 1 )
2655
2656             DO  ib = 1, nbins_aerosol
2657                aerosol_number(ib)%conc(nzb:nzt+1,nysg:nyng,nxlg:nxrg)   => nconc_2(:,:,:,ib)
2658                aerosol_number(ib)%conc_p(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => nconc_1(:,:,:,ib)
2659                DO  ic = 1, ncomponents_mass
2660                   icc = ( ic-1 ) * nbins_aerosol + ib
2661                   aerosol_mass(icc)%conc(nzb:nzt+1,nysg:nyng,nxlg:nxrg)   => mconc_2(:,:,:,icc)
2662                   aerosol_mass(icc)%conc_p(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => mconc_1(:,:,:,icc)
2663                ENDDO
2664             ENDDO
2665
2666             IF ( .NOT. salsa_gases_from_chem )  THEN
2667                DO  ig = 1, ngases_salsa
2668                   salsa_gas(ig)%conc(nzb:nzt+1,nysg:nyng,nxlg:nxrg)   => gconc_2(:,:,:,ig)
2669                   salsa_gas(ig)%conc_p(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => gconc_1(:,:,:,ig)
2670                ENDDO
2671             ENDIF
2672
2673       END SELECT
2674
2675    ENDIF
2676
2677 END SUBROUTINE salsa_swap_timelevel
2678
2679
2680!------------------------------------------------------------------------------!
2681! Description:
2682! ------------
2683!> This routine reads the respective restart data.
2684!------------------------------------------------------------------------------!
2685 SUBROUTINE salsa_rrd_local( k, nxlf, nxlc, nxl_on_file, nxrf, nxrc, nxr_on_file, nynf, nync,      &
2686                             nyn_on_file, nysf, nysc, nys_on_file, tmp_3d, found )
2687
2688    USE control_parameters,                                                                        &
2689        ONLY:  length, restart_string
2690
2691    IMPLICIT NONE
2692
2693    INTEGER(iwp) ::  ib              !<
2694    INTEGER(iwp) ::  ic              !<
2695    INTEGER(iwp) ::  ig              !<
2696    INTEGER(iwp) ::  k               !<
2697    INTEGER(iwp) ::  nxlc            !<
2698    INTEGER(iwp) ::  nxlf            !<
2699    INTEGER(iwp) ::  nxl_on_file     !<
2700    INTEGER(iwp) ::  nxrc            !<
2701    INTEGER(iwp) ::  nxrf            !<
2702    INTEGER(iwp) ::  nxr_on_file     !<
2703    INTEGER(iwp) ::  nync            !<
2704    INTEGER(iwp) ::  nynf            !<
2705    INTEGER(iwp) ::  nyn_on_file     !<
2706    INTEGER(iwp) ::  nysc            !<
2707    INTEGER(iwp) ::  nysf            !<
2708    INTEGER(iwp) ::  nys_on_file     !<
2709
2710    LOGICAL, INTENT(OUT)  ::  found  !<
2711
2712    REAL(wp), &
2713       DIMENSION(nzb:nzt+1,nys_on_file-nbgp:nyn_on_file+nbgp,nxl_on_file-nbgp:nxr_on_file+nbgp) :: tmp_3d   !<
2714
2715    found = .FALSE.
2716
2717    IF ( read_restart_data_salsa )  THEN
2718
2719       SELECT CASE ( restart_string(1:length) )
2720
2721          CASE ( 'aerosol_number' )
2722             DO  ib = 1, nbins_aerosol
2723                IF ( k == 1 )  READ ( 13 ) tmp_3d
2724                aerosol_number(ib)%conc(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) =               &
2725                                                   tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
2726                found = .TRUE.
2727             ENDDO
2728
2729          CASE ( 'aerosol_mass' )
2730             DO  ic = 1, ncomponents_mass * nbins_aerosol
2731                IF ( k == 1 )  READ ( 13 ) tmp_3d
2732                aerosol_mass(ic)%conc(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) =                 &
2733                                                   tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
2734                found = .TRUE.
2735             ENDDO
2736
2737          CASE ( 'salsa_gas' )
2738             DO  ig = 1, ngases_salsa
2739                IF ( k == 1 )  READ ( 13 ) tmp_3d
2740                salsa_gas(ig)%conc(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) =                    &
2741                                                   tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
2742                found = .TRUE.
2743             ENDDO
2744
2745          CASE DEFAULT
2746             found = .FALSE.
2747
2748       END SELECT
2749    ENDIF
2750
2751 END SUBROUTINE salsa_rrd_local
2752
2753!------------------------------------------------------------------------------!
2754! Description:
2755! ------------
2756!> This routine writes the respective restart data.
2757!> Note that the following input variables in PARIN have to be equal between
2758!> restart runs:
2759!>    listspec, nbin, nbin2, nf2a, ncc, mass_fracs_a, mass_fracs_b
2760!------------------------------------------------------------------------------!
2761 SUBROUTINE salsa_wrd_local
2762
2763    USE control_parameters,                                                                        &
2764        ONLY:  write_binary
2765
2766    IMPLICIT NONE
2767
2768    INTEGER(iwp) ::  ib   !<
2769    INTEGER(iwp) ::  ic   !<
2770    INTEGER(iwp) ::  ig  !<
2771
2772    IF ( write_binary  .AND.  write_binary_salsa )  THEN
2773
2774       CALL wrd_write_string( 'aerosol_number' )
2775       DO  ib = 1, nbins_aerosol
2776          WRITE ( 14 )  aerosol_number(ib)%conc
2777       ENDDO
2778
2779       CALL wrd_write_string( 'aerosol_mass' )
2780       DO  ic = 1, nbins_aerosol * ncomponents_mass
2781          WRITE ( 14 )  aerosol_mass(ic)%conc
2782       ENDDO
2783
2784       CALL wrd_write_string( 'salsa_gas' )
2785       DO  ig = 1, ngases_salsa
2786          WRITE ( 14 )  salsa_gas(ig)%conc
2787       ENDDO
2788
2789    ENDIF
2790
2791 END SUBROUTINE salsa_wrd_local
2792
2793!------------------------------------------------------------------------------!
2794! Description:
2795! ------------
2796!> Performs necessary unit and dimension conversion between the host model and
2797!> SALSA module, and calls the main SALSA routine.
2798!> Partially adobted form the original SALSA boxmodel version.
2799!> Now takes masses in as kg/kg from LES!! Converted to m3/m3 for SALSA
2800!> 05/2016 Juha: This routine is still pretty much in its original shape.
2801!>               It's dumb as a mule and twice as ugly, so implementation of
2802!>               an improved solution is necessary sooner or later.
2803!> Juha Tonttila, FMI, 2014
2804!> Jaakko Ahola, FMI, 2016
2805!> Only aerosol processes included, Mona Kurppa, UHel, 2017
2806!------------------------------------------------------------------------------!
2807 SUBROUTINE salsa_driver( i, j, prunmode )
2808
2809    USE arrays_3d,                                                                                 &
2810        ONLY: pt_p, q_p, u, v, w
2811
2812    USE plant_canopy_model_mod,                                                                    &
2813        ONLY: lad_s
2814
2815    USE surface_mod,                                                                               &
2816        ONLY:  surf_def_h, surf_def_v, surf_lsm_h, surf_lsm_v, surf_usm_h, surf_usm_v
2817
2818    IMPLICIT NONE
2819
2820    INTEGER(iwp) ::  endi    !< end index
2821    INTEGER(iwp) ::  ib      !< loop index
2822    INTEGER(iwp) ::  ic      !< loop index
2823    INTEGER(iwp) ::  ig      !< loop index
2824    INTEGER(iwp) ::  k_wall  !< vertical index of topography top
2825    INTEGER(iwp) ::  k       !< loop index
2826    INTEGER(iwp) ::  l       !< loop index
2827    INTEGER(iwp) ::  nc_h2o  !< index of H2O in the prtcl index table
2828    INTEGER(iwp) ::  ss      !< loop index
2829    INTEGER(iwp) ::  str     !< start index
2830    INTEGER(iwp) ::  vc      !< default index in prtcl
2831
2832    INTEGER(iwp), INTENT(in) ::  i         !< loop index
2833    INTEGER(iwp), INTENT(in) ::  j         !< loop index
2834    INTEGER(iwp), INTENT(in) ::  prunmode  !< 1: Initialization, 2: Spinup, 3: Regular runtime
2835
2836    REAL(wp) ::  cw_old  !< previous H2O mixing ratio
2837    REAL(wp) ::  flag    !< flag to mask topography grid points
2838    REAL(wp) ::  in_lad  !< leaf area density (m2/m3)
2839    REAL(wp) ::  in_rh   !< relative humidity
2840    REAL(wp) ::  zgso4   !< SO4
2841    REAL(wp) ::  zghno3  !< HNO3
2842    REAL(wp) ::  zgnh3   !< NH3
2843    REAL(wp) ::  zgocnv  !< non-volatile OC
2844    REAL(wp) ::  zgocsv  !< semi-volatile OC
2845
2846    REAL(wp), DIMENSION(nzb:nzt+1) ::  in_adn  !< air density (kg/m3)
2847    REAL(wp), DIMENSION(nzb:nzt+1) ::  in_cs   !< H2O sat. vapour conc.
2848    REAL(wp), DIMENSION(nzb:nzt+1) ::  in_cw   !< H2O vapour concentration
2849    REAL(wp), DIMENSION(nzb:nzt+1) ::  in_p    !< pressure (Pa)
2850    REAL(wp), DIMENSION(nzb:nzt+1) ::  in_t    !< temperature (K)
2851    REAL(wp), DIMENSION(nzb:nzt+1) ::  in_u    !< wind magnitude (m/s)
2852    REAL(wp), DIMENSION(nzb:nzt+1) ::  kvis    !< kinematic viscosity of air(m2/s)
2853    REAL(wp), DIMENSION(nzb:nzt+1) ::  ppm_to_nconc  !< Conversion factor from ppm to #/m3
2854
2855    REAL(wp), DIMENSION(nzb:nzt+1,nbins_aerosol) ::  schmidt_num  !< particle Schmidt number
2856    REAL(wp), DIMENSION(nzb:nzt+1,nbins_aerosol) ::  vd           !< particle fall seed (m/s)
2857
2858    TYPE(t_section), DIMENSION(nbins_aerosol) ::  lo_aero   !< additional variable for OpenMP
2859    TYPE(t_section), DIMENSION(nbins_aerosol) ::  aero_old  !< helper array
2860
2861    aero_old(:)%numc = 0.0_wp
2862    in_lad           = 0.0_wp
2863    in_u             = 0.0_wp
2864    kvis             = 0.0_wp
2865    lo_aero          = aero
2866    schmidt_num      = 0.0_wp
2867    vd               = 0.0_wp
2868    zgso4            = nclim
2869    zghno3           = nclim
2870    zgnh3            = nclim
2871    zgocnv           = nclim
2872    zgocsv           = nclim
2873!
2874!-- Aerosol number is always set, but mass can be uninitialized
2875    DO ib = 1, nbins_aerosol
2876       lo_aero(ib)%volc(:)  = 0.0_wp
2877       aero_old(ib)%volc(:) = 0.0_wp
2878    ENDDO
2879!
2880!-- Set the salsa runtime config (How to make this more efficient?)
2881    CALL set_salsa_runtime( prunmode )
2882!
2883!-- Calculate thermodynamic quantities needed in SALSA
2884    CALL salsa_thrm_ij( i, j, p_ij=in_p, temp_ij=in_t, cw_ij=in_cw, cs_ij=in_cs, adn_ij=in_adn )
2885!
2886!-- Magnitude of wind: needed for deposition
2887    IF ( lsdepo )  THEN
2888       in_u(nzb+1:nzt) = SQRT( ( 0.5_wp * ( u(nzb+1:nzt,j,i) + u(nzb+1:nzt,j,i+1) ) )**2 +         &
2889                               ( 0.5_wp * ( v(nzb+1:nzt,j,i) + v(nzb+1:nzt,j+1,i) ) )**2 +         &
2890                               ( 0.5_wp * ( w(nzb:nzt-1,j,i) + w(nzb+1:nzt,j,  i) ) )**2 )
2891    ENDIF
2892!
2893!-- Calculate conversion factors for gas concentrations
2894    ppm_to_nconc(:) = for_ppm_to_nconc * in_p(:) / in_t(:)
2895!
2896!-- Determine topography-top index on scalar grid
2897    k_wall = k_topo_top(j,i)
2898
2899    DO k = nzb+1, nzt
2900!
2901!--    Predetermine flag to mask topography
2902       flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_0(k,j,i), 0 ) )
2903!
2904!--    Wind velocity for dry depositon on vegetation
2905       IF ( lsdepo_pcm  .AND.  plant_canopy )  THEN
2906          in_lad = lad_s( MAX( k-k_wall,0 ),j,i)
2907       ENDIF
2908!
2909!--    For initialization and spinup, limit the RH with the parameter rhlim
2910       IF ( prunmode < 3 ) THEN
2911          in_cw(k) = MIN( in_cw(k), in_cs(k) * rhlim )
2912       ELSE
2913          in_cw(k) = in_cw(k)
2914       ENDIF
2915       cw_old = in_cw(k) !* in_adn(k)
2916!
2917!--    Set volume concentrations:
2918!--    Sulphate (SO4) or sulphuric acid H2SO4
2919       IF ( index_so4 > 0 )  THEN
2920          vc = 1
2921          str = ( index_so4-1 ) * nbins_aerosol + 1    ! start index
2922          endi = index_so4 * nbins_aerosol             ! end index
2923          ic = 1
2924          DO ss = str, endi
2925             lo_aero(ic)%volc(vc) = aerosol_mass(ss)%conc(k,j,i) / arhoh2so4
2926             ic = ic+1
2927          ENDDO
2928          aero_old(1:nbins_aerosol)%volc(vc) = lo_aero(1:nbins_aerosol)%volc(vc)
2929       ENDIF
2930!
2931!--    Organic carbon (OC) compounds
2932       IF ( index_oc > 0 )  THEN
2933          vc = 2
2934          str = ( index_oc-1 ) * nbins_aerosol + 1
2935          endi = index_oc * nbins_aerosol
2936          ic = 1
2937          DO ss = str, endi
2938             lo_aero(ic)%volc(vc) = aerosol_mass(ss)%conc(k,j,i) / arhooc
2939             ic = ic+1
2940          ENDDO
2941          aero_old(1:nbins_aerosol)%volc(vc) = lo_aero(1:nbins_aerosol)%volc(vc)
2942       ENDIF
2943!
2944!--    Black carbon (BC)
2945       IF ( index_bc > 0 )  THEN
2946          vc = 3
2947          str = ( index_bc-1 ) * nbins_aerosol + 1 + end_subrange_1a
2948          endi = index_bc * nbins_aerosol
2949          ic = 1 + end_subrange_1a
2950          DO ss = str, endi
2951             lo_aero(ic)%volc(vc) = aerosol_mass(ss)%conc(k,j,i) / arhobc
2952             ic = ic+1
2953          ENDDO
2954          aero_old(1:nbins_aerosol)%volc(vc) = lo_aero(1:nbins_aerosol)%volc(vc)
2955       ENDIF
2956!
2957!--    Dust (DU)
2958       IF ( index_du > 0 )  THEN
2959          vc = 4
2960          str = ( index_du-1 ) * nbins_aerosol + 1 + end_subrange_1a
2961          endi = index_du * nbins_aerosol
2962          ic = 1 + end_subrange_1a
2963          DO ss = str, endi
2964             lo_aero(ic)%volc(vc) = aerosol_mass(ss)%conc(k,j,i) / arhodu
2965             ic = ic+1
2966          ENDDO
2967          aero_old(1:nbins_aerosol)%volc(vc) = lo_aero(1:nbins_aerosol)%volc(vc)
2968       ENDIF
2969!
2970!--    Sea salt (SS)
2971       IF ( index_ss > 0 )  THEN
2972          vc = 5
2973          str = ( index_ss-1 ) * nbins_aerosol + 1 + end_subrange_1a
2974          endi = index_ss * nbins_aerosol
2975          ic = 1 + end_subrange_1a
2976          DO ss = str, endi
2977             lo_aero(ic)%volc(vc) = aerosol_mass(ss)%conc(k,j,i) / arhoss
2978             ic = ic+1
2979          ENDDO
2980          aero_old(1:nbins_aerosol)%volc(vc) = lo_aero(1:nbins_aerosol)%volc(vc)
2981       ENDIF
2982!
2983!--    Nitrate (NO(3-)) or nitric acid HNO3
2984       IF ( index_no > 0 )  THEN
2985          vc = 6
2986          str = ( index_no-1 ) * nbins_aerosol + 1 
2987          endi = index_no * nbins_aerosol
2988          ic = 1
2989          DO ss = str, endi
2990             lo_aero(ic)%volc(vc) = aerosol_mass(ss)%conc(k,j,i) / arhohno3
2991             ic = ic+1
2992          ENDDO
2993          aero_old(1:nbins_aerosol)%volc(vc) = lo_aero(1:nbins_aerosol)%volc(vc)
2994       ENDIF
2995!
2996!--    Ammonium (NH(4+)) or ammonia NH3
2997       IF ( index_nh > 0 )  THEN
2998          vc = 7
2999          str = ( index_nh-1 ) * nbins_aerosol + 1
3000          endi = index_nh * nbins_aerosol
3001          ic = 1
3002          DO ss = str, endi
3003             lo_aero(ic)%volc(vc) = aerosol_mass(ss)%conc(k,j,i) / arhonh3
3004             ic = ic+1
3005          ENDDO
3006          aero_old(1:nbins_aerosol)%volc(vc) = lo_aero(1:nbins_aerosol)%volc(vc)
3007       ENDIF
3008!
3009!--    Water (always used)
3010       nc_h2o = get_index( prtcl,'H2O' )
3011       vc = 8
3012       str = ( nc_h2o-1 ) * nbins_aerosol + 1
3013       endi = nc_h2o * nbins_aerosol
3014       ic = 1
3015       IF ( advect_particle_water )  THEN
3016          DO ss = str, endi
3017             lo_aero(ic)%volc(vc) = aerosol_mass(ss)%conc(k,j,i) / arhoh2o
3018             ic = ic+1
3019          ENDDO
3020       ELSE
3021         lo_aero(1:nbins_aerosol)%volc(vc) = mclim
3022       ENDIF
3023       aero_old(1:nbins_aerosol)%volc(vc) = lo_aero(1:nbins_aerosol)%volc(vc)
3024!
3025!--    Number concentrations (numc) and particle sizes
3026!--    (dwet = wet diameter, core = dry volume)
3027       DO  ib = 1, nbins_aerosol
3028          lo_aero(ib)%numc = aerosol_number(ib)%conc(k,j,i)
3029          aero_old(ib)%numc = lo_aero(ib)%numc
3030          IF ( lo_aero(ib)%numc > nclim )  THEN
3031             lo_aero(ib)%dwet = ( SUM( lo_aero(ib)%volc(:) ) / lo_aero(ib)%numc / api6 )**0.33333333_wp
3032             lo_aero(ib)%core = SUM( lo_aero(ib)%volc(1:7) ) / lo_aero(ib)%numc
3033          ELSE
3034             lo_aero(ib)%dwet = lo_aero(ib)%dmid
3035             lo_aero(ib)%core = api6 * ( lo_aero(ib)%dwet )**3
3036          ENDIF
3037       ENDDO
3038!
3039!--    Calculate the ambient sizes of particles by equilibrating soluble fraction of particles with
3040!--    water using the ZSR method.
3041       in_rh = in_cw(k) / in_cs(k)
3042       IF ( prunmode==1  .OR.  .NOT. advect_particle_water )  THEN
3043          CALL equilibration( in_rh, in_t(k), lo_aero, .TRUE. )
3044       ENDIF
3045!
3046!--    Gaseous tracer concentrations in #/m3
3047       IF ( salsa_gases_from_chem )  THEN
3048!
3049!--       Convert concentrations in ppm to #/m3
3050          zgso4  = chem_species(gas_index_chem(1))%conc(k,j,i) * ppm_to_nconc(k)
3051          zghno3 = chem_species(gas_index_chem(2))%conc(k,j,i) * ppm_to_nconc(k)
3052          zgnh3  = chem_species(gas_index_chem(3))%conc(k,j,i) * ppm_to_nconc(k)
3053          zgocnv = chem_species(gas_index_chem(4))%conc(k,j,i) * ppm_to_nconc(k)
3054          zgocsv = chem_species(gas_index_chem(5))%conc(k,j,i) * ppm_to_nconc(k)
3055       ELSE
3056          zgso4  = salsa_gas(1)%conc(k,j,i)
3057          zghno3 = salsa_gas(2)%conc(k,j,i)
3058          zgnh3  = salsa_gas(3)%conc(k,j,i)
3059          zgocnv = salsa_gas(4)%conc(k,j,i)
3060          zgocsv = salsa_gas(5)%conc(k,j,i)
3061       ENDIF
3062!
3063!--    Calculate aerosol processes:
3064!--    *********************************************************************************************
3065!
3066!--    Coagulation
3067       IF ( lscoag )   THEN
3068          CALL coagulation( lo_aero, dt_salsa, in_t(k), in_p(k) )
3069       ENDIF
3070!
3071!--    Condensation
3072       IF ( lscnd )   THEN
3073          CALL condensation( lo_aero, zgso4, zgocnv, zgocsv,  zghno3, zgnh3, in_cw(k), in_cs(k),   &
3074                             in_t(k), in_p(k), dt_salsa, prtcl )
3075       ENDIF
3076!
3077!--    Deposition
3078       IF ( lsdepo )  THEN
3079          CALL deposition( lo_aero, in_t(k), in_adn(k), in_u(k), in_lad, kvis(k), schmidt_num(k,:),&
3080                           vd(k,:) )
3081       ENDIF
3082!
3083!--    Size distribution bin update
3084       IF ( lsdistupdate )   THEN
3085          CALL distr_update( lo_aero )
3086       ENDIF
3087!--    *********************************************************************************************
3088
3089       IF ( lsdepo ) sedim_vd(k,j,i,:) = vd(k,:)
3090!
3091!--    Calculate changes in concentrations
3092       DO ib = 1, nbins_aerosol
3093          aerosol_number(ib)%conc(k,j,i) = aerosol_number(ib)%conc(k,j,i) + ( lo_aero(ib)%numc -   &
3094                                           aero_old(ib)%numc ) * flag
3095       ENDDO
3096
3097       IF ( index_so4 > 0 )  THEN
3098          vc = 1
3099          str = ( index_so4-1 ) * nbins_aerosol + 1
3100          endi = index_so4 * nbins_aerosol
3101          ic = 1
3102          DO ss = str, endi
3103             aerosol_mass(ss)%conc(k,j,i) = aerosol_mass(ss)%conc(k,j,i) + ( lo_aero(ic)%volc(vc) -&
3104                                            aero_old(ic)%volc(vc) ) * arhoh2so4 * flag
3105             ic = ic+1
3106          ENDDO
3107       ENDIF
3108
3109       IF ( index_oc > 0 )  THEN
3110          vc = 2
3111          str = ( index_oc-1 ) * nbins_aerosol + 1
3112          endi = index_oc * nbins_aerosol
3113          ic = 1
3114          DO ss = str, endi
3115             aerosol_mass(ss)%conc(k,j,i) = aerosol_mass(ss)%conc(k,j,i) + ( lo_aero(ic)%volc(vc) -&
3116                                            aero_old(ic)%volc(vc) ) * arhooc * flag
3117             ic = ic+1
3118          ENDDO
3119       ENDIF
3120
3121       IF ( index_bc > 0 )  THEN
3122          vc = 3
3123          str = ( index_bc-1 ) * nbins_aerosol + 1 + end_subrange_1a
3124          endi = index_bc * nbins_aerosol
3125          ic = 1 + end_subrange_1a
3126          DO ss = str, endi
3127             aerosol_mass(ss)%conc(k,j,i) = aerosol_mass(ss)%conc(k,j,i) + ( lo_aero(ic)%volc(vc) -&
3128                                            aero_old(ic)%volc(vc) ) * arhobc * flag
3129             ic = ic+1
3130          ENDDO
3131       ENDIF
3132
3133       IF ( index_du > 0 )  THEN
3134          vc = 4
3135          str = ( index_du-1 ) * nbins_aerosol + 1 + end_subrange_1a
3136          endi = index_du * nbins_aerosol
3137          ic = 1 + end_subrange_1a
3138          DO ss = str, endi
3139             aerosol_mass(ss)%conc(k,j,i) = aerosol_mass(ss)%conc(k,j,i) + ( lo_aero(ic)%volc(vc) -&
3140                                            aero_old(ic)%volc(vc) ) * arhodu * flag
3141             ic = ic+1
3142          ENDDO
3143       ENDIF
3144
3145       IF ( index_ss > 0 )  THEN
3146          vc = 5
3147          str = ( index_ss-1 ) * nbins_aerosol + 1 + end_subrange_1a
3148          endi = index_ss * nbins_aerosol
3149          ic = 1 + end_subrange_1a
3150          DO ss = str, endi
3151             aerosol_mass(ss)%conc(k,j,i) = aerosol_mass(ss)%conc(k,j,i) + ( lo_aero(ic)%volc(vc) -&
3152                                            aero_old(ic)%volc(vc) ) * arhoss * flag
3153             ic = ic+1
3154          ENDDO
3155       ENDIF
3156
3157       IF ( index_no > 0 )  THEN
3158          vc = 6
3159          str = ( index_no-1 ) * nbins_aerosol + 1
3160          endi = index_no * nbins_aerosol
3161          ic = 1
3162          DO ss = str, endi
3163             aerosol_mass(ss)%conc(k,j,i) = aerosol_mass(ss)%conc(k,j,i) + ( lo_aero(ic)%volc(vc) -&
3164                                            aero_old(ic)%volc(vc) ) * arhohno3 * flag
3165             ic = ic+1
3166          ENDDO
3167       ENDIF
3168
3169       IF ( index_nh > 0 )  THEN
3170          vc = 7
3171          str = ( index_nh-1 ) * nbins_aerosol + 1
3172          endi = index_nh * nbins_aerosol
3173          ic = 1
3174          DO ss = str, endi
3175             aerosol_mass(ss)%conc(k,j,i) = aerosol_mass(ss)%conc(k,j,i) + ( lo_aero(ic)%volc(vc) -&
3176                                            aero_old(ic)%volc(vc) ) * arhonh3 * flag
3177             ic = ic+1
3178          ENDDO
3179       ENDIF
3180
3181       IF ( advect_particle_water )  THEN
3182          nc_h2o = get_index( prtcl,'H2O' )
3183          vc = 8
3184          str = ( nc_h2o-1 ) * nbins_aerosol + 1
3185          endi = nc_h2o * nbins_aerosol
3186          ic = 1
3187          DO ss = str, endi
3188             aerosol_mass(ss)%conc(k,j,i) = aerosol_mass(ss)%conc(k,j,i) + ( lo_aero(ic)%volc(vc) -&
3189                                            aero_old(ic)%volc(vc) ) * arhoh2o * flag
3190             ic = ic+1
3191          ENDDO
3192       ENDIF
3193       IF ( prunmode == 1 )  THEN
3194          nc_h2o = get_index( prtcl,'H2O' )
3195          vc = 8
3196          str = ( nc_h2o-1 ) * nbins_aerosol + 1
3197          endi = nc_h2o * nbins_aerosol
3198          ic = 1
3199          DO ss = str, endi
3200             aerosol_mass(ss)%init(k) = MAX( aerosol_mass(ss)%init(k), ( lo_aero(ic)%volc(vc) - &
3201                                             aero_old(ic)%volc(vc) ) * arhoh2o )
3202             IF ( k == nzb+1 )  THEN
3203                aerosol_mass(ss)%init(k-1) = aerosol_mass(ss)%init(k)
3204             ELSEIF ( k == nzt  )  THEN
3205                aerosol_mass(ss)%init(k+1) = aerosol_mass(ss)%init(k)
3206                aerosol_mass(ss)%conc(k+1,j,i) = aerosol_mass(ss)%init(k)
3207             ENDIF
3208             ic = ic+1
3209          ENDDO
3210       ENDIF
3211!
3212!--    Condensation of precursor gases
3213       IF ( lscndgas )  THEN
3214          IF ( salsa_gases_from_chem )  THEN
3215!
3216!--          SO4 (or H2SO4)
3217             ig = gas_index_chem(1)
3218             chem_species(ig)%conc(k,j,i) = chem_species(ig)%conc(k,j,i) + ( zgso4 /               &
3219                                            ppm_to_nconc(k) - chem_species(ig)%conc(k,j,i) ) * flag
3220!
3221!--          HNO3
3222             ig = gas_index_chem(2)
3223             chem_species(ig)%conc(k,j,i) = chem_species(ig)%conc(k,j,i) + ( zghno3 /              &
3224                                            ppm_to_nconc(k) - chem_species(ig)%conc(k,j,i) ) * flag
3225!
3226!--          NH3
3227             ig = gas_index_chem(3)
3228             chem_species(ig)%conc(k,j,i) = chem_species(ig)%conc(k,j,i) + ( zgnh3 /               &
3229                                            ppm_to_nconc(k) - chem_species(ig)%conc(k,j,i) ) * flag
3230!
3231!--          non-volatile OC
3232             ig = gas_index_chem(4)
3233             chem_species(ig)%conc(k,j,i) = chem_species(ig)%conc(k,j,i) + ( zgocnv /              &
3234                                            ppm_to_nconc(k) - chem_species(ig)%conc(k,j,i) ) * flag
3235!
3236!--          semi-volatile OC
3237             ig = gas_index_chem(5)
3238             chem_species(ig)%conc(k,j,i) = chem_species(ig)%conc(k,j,i) + ( zgocsv /              &
3239                                            ppm_to_nconc(k) - chem_species(ig)%conc(k,j,i) ) * flag
3240
3241          ELSE
3242!
3243!--          SO4 (or H2SO4)
3244             salsa_gas(1)%conc(k,j,i) = salsa_gas(1)%conc(k,j,i) + ( zgso4 -                       &
3245                                        salsa_gas(1)%conc(k,j,i) ) * flag
3246!
3247!--          HNO3
3248             salsa_gas(2)%conc(k,j,i) = salsa_gas(2)%conc(k,j,i) + ( zghno3 -                      &
3249                                        salsa_gas(2)%conc(k,j,i) ) * flag
3250!
3251!--          NH3
3252             salsa_gas(3)%conc(k,j,i) = salsa_gas(3)%conc(k,j,i) + ( zgnh3 -                       &
3253                                        salsa_gas(3)%conc(k,j,i) ) * flag
3254!
3255!--          non-volatile OC
3256             salsa_gas(4)%conc(k,j,i) = salsa_gas(4)%conc(k,j,i) + ( zgocnv -                      &
3257                                        salsa_gas(4)%conc(k,j,i) ) * flag
3258!
3259!--          semi-volatile OC
3260             salsa_gas(5)%conc(k,j,i) = salsa_gas(5)%conc(k,j,i) + ( zgocsv -                      &
3261                                        salsa_gas(5)%conc(k,j,i) ) * flag
3262          ENDIF
3263       ENDIF
3264!
3265!--    Tendency of water vapour mixing ratio is obtained from the change in RH during SALSA run.
3266!--    This releases heat and changes pt. Assumes no temperature change during SALSA run.
3267!--    q = r / (1+r), Euler method for integration
3268!
3269       IF ( feedback_to_palm )  THEN
3270          q_p(k,j,i) = q_p(k,j,i) + 1.0_wp / ( in_cw(k) * in_adn(k) + 1.0_wp )**2 *                &
3271                       ( in_cw(k) - cw_old ) * in_adn(k) * flag
3272          pt_p(k,j,i) = pt_p(k,j,i) + alv / c_p * ( in_cw(k) - cw_old ) * in_adn(k) / ( in_cw(k) / &
3273                        in_adn(k) + 1.0_wp )**2 * pt_p(k,j,i) / in_t(k) * flag
3274       ENDIF
3275
3276    ENDDO   ! k
3277
3278!
3279!-- Set surfaces and wall fluxes due to deposition
3280    IF ( lsdepo  .AND.  lsdepo_surf  .AND.  prunmode == 3 )  THEN
3281       IF ( .NOT. land_surface  .AND.  .NOT. urban_surface )  THEN
3282          CALL depo_surf( i, j, surf_def_h(0), vd, schmidt_num, kvis, in_u, .TRUE. )
3283          DO  l = 0, 3
3284             CALL depo_surf( i, j, surf_def_v(l), vd, schmidt_num, kvis, in_u, .FALSE. )
3285          ENDDO
3286       ELSE
3287          CALL depo_surf( i, j, surf_usm_h, vd, schmidt_num, kvis, in_u, .TRUE., usm_to_depo_h )
3288          DO  l = 0, 3
3289             CALL depo_surf( i, j, surf_usm_v(l), vd, schmidt_num, kvis, in_u, .FALSE.,            &
3290                             usm_to_depo_v(l) )
3291          ENDDO
3292          CALL depo_surf( i, j, surf_lsm_h, vd, schmidt_num, kvis, in_u, .TRUE., lsm_to_depo_h )
3293          DO  l = 0, 3
3294             CALL depo_surf( i, j, surf_lsm_v(l), vd, schmidt_num, kvis, in_u, .FALSE.,            &
3295                             lsm_to_depo_v(l) )
3296          ENDDO
3297       ENDIF
3298    ENDIF
3299
3300    IF ( prunmode < 3 )  THEN
3301       !$OMP MASTER
3302       aero = lo_aero
3303       !$OMP END MASTER
3304    END IF
3305
3306 END SUBROUTINE salsa_driver
3307
3308!------------------------------------------------------------------------------!
3309! Description:
3310! ------------
3311!> Set logical switches according to the salsa_parameters options.
3312!> Juha Tonttila, FMI, 2014
3313!> Only aerosol processes included, Mona Kurppa, UHel, 2017
3314!------------------------------------------------------------------------------!
3315 SUBROUTINE set_salsa_runtime( prunmode )
3316
3317    IMPLICIT NONE
3318
3319    INTEGER(iwp), INTENT(in) ::  prunmode
3320
3321    SELECT CASE(prunmode)
3322
3323       CASE(1) !< Initialization
3324          lscoag       = .FALSE.
3325          lscnd        = .FALSE.
3326          lscndgas     = .FALSE.
3327          lscndh2oae   = .FALSE.
3328          lsdepo       = .FALSE.
3329          lsdepo_pcm   = .FALSE.
3330          lsdepo_surf  = .FALSE.
3331          lsdistupdate = .TRUE.
3332          lspartition  = .FALSE.
3333
3334       CASE(2)  !< Spinup period
3335          lscoag      = ( .FALSE. .AND. nlcoag   )
3336          lscnd       = ( .TRUE.  .AND. nlcnd    )
3337          lscndgas    = ( .TRUE.  .AND. nlcndgas )
3338          lscndh2oae  = ( .TRUE.  .AND. nlcndh2oae )
3339
3340       CASE(3)  !< Run
3341          lscoag       = nlcoag
3342          lscnd        = nlcnd
3343          lscndgas     = nlcndgas
3344          lscndh2oae   = nlcndh2oae
3345          lsdepo       = nldepo
3346          lsdepo_pcm   = nldepo_pcm
3347          lsdepo_surf  = nldepo_surf
3348          lsdistupdate = nldistupdate
3349    END SELECT
3350
3351
3352 END SUBROUTINE set_salsa_runtime
3353 
3354!------------------------------------------------------------------------------!
3355! Description:
3356! ------------
3357!> Calculates the absolute temperature (using hydrostatic pressure), saturation
3358!> vapour pressure and mixing ratio over water, relative humidity and air
3359!> density needed in the SALSA model.
3360!> NOTE, no saturation adjustment takes place -> the resulting water vapour
3361!> mixing ratio can be supersaturated, allowing the microphysical calculations
3362!> in SALSA.
3363!
3364!> Juha Tonttila, FMI, 2014 (original SALSAthrm)
3365!> Mona Kurppa, UHel, 2017 (adjustment for PALM and only aerosol processes)
3366!------------------------------------------------------------------------------!
3367 SUBROUTINE salsa_thrm_ij( i, j, p_ij, temp_ij, cw_ij, cs_ij, adn_ij )
3368
3369    USE arrays_3d,                                                                                 &
3370        ONLY: pt, q, zu
3371
3372    USE basic_constants_and_equations_mod,                                                         &
3373        ONLY:  barometric_formula, exner_function, ideal_gas_law_rho, magnus
3374
3375    IMPLICIT NONE
3376
3377    INTEGER(iwp), INTENT(in) ::  i  !<
3378    INTEGER(iwp), INTENT(in) ::  j  !<
3379
3380    REAL(wp) ::  t_surface  !< absolute surface temperature (K)
3381
3382    REAL(wp), DIMENSION(nzb:nzt+1) ::  e_s  !< saturation vapour pressure over water (Pa)
3383
3384    REAL(wp), DIMENSION(:), INTENT(inout) ::  adn_ij   !< air density (kg/m3)
3385    REAL(wp), DIMENSION(:), INTENT(inout) ::  p_ij     !< air pressure (Pa)
3386    REAL(wp), DIMENSION(:), INTENT(inout) ::  temp_ij  !< air temperature (K)
3387
3388    REAL(wp), DIMENSION(:), INTENT(inout), OPTIONAL ::  cw_ij  !< water vapour concentration (kg/m3)
3389    REAL(wp), DIMENSION(:), INTENT(inout), OPTIONAL ::  cs_ij  !< saturation water vap. conc.(kg/m3)
3390!
3391!-- Pressure p_ijk (Pa) = hydrostatic pressure
3392    t_surface = pt_surface * exner_function( surface_pressure * 100.0_wp )
3393    p_ij(:) = barometric_formula( zu, t_surface, surface_pressure * 100.0_wp )
3394!
3395!-- Absolute ambient temperature (K)
3396    temp_ij(:) = pt(:,j,i) * exner_function( p_ij(:) )
3397!
3398!-- Air density
3399    adn_ij(:) = ideal_gas_law_rho( p_ij(:), temp_ij(:) )
3400!
3401!-- Water vapour concentration r_v (kg/m3)
3402    IF ( PRESENT( cw_ij ) )  THEN
3403       cw_ij(:) = ( q(:,j,i) / ( 1.0_wp - q(:,j,i) ) ) * adn_ij(:)
3404    ENDIF
3405!
3406!-- Saturation mixing ratio r_s (kg/kg) from vapour pressure at temp (Pa)
3407    IF ( PRESENT( cs_ij ) )  THEN
3408       e_s(:) = 611.0_wp * EXP( alv_d_rv * ( 3.6609E-3_wp - 1.0_wp /           &
3409                temp_ij(:) ) )! magnus( temp_ij(:) )
3410       cs_ij(:) = ( 0.622_wp * e_s / ( p_ij(:) - e_s(:) ) ) * adn_ij(:)
3411    ENDIF
3412
3413 END SUBROUTINE salsa_thrm_ij
3414
3415!------------------------------------------------------------------------------!
3416! Description:
3417! ------------
3418!> Calculates ambient sizes of particles by equilibrating soluble fraction of
3419!> particles with water using the ZSR method (Stokes and Robinson, 1966).
3420!> Method:
3421!> Following chemical components are assumed water-soluble
3422!> - (ammonium) sulphate (100%)
3423!> - sea salt (100 %)
3424!> - organic carbon (epsoc * 100%)
3425!> Exact thermodynamic considerations neglected.
3426!> - If particles contain no sea salt, calculation according to sulphate
3427!>   properties
3428!> - If contain sea salt but no sulphate, calculation according to sea salt
3429!>   properties
3430!> - If contain both sulphate and sea salt -> the molar fraction of these
3431!>   compounds determines which one of them is used as the basis of calculation.
3432!> If sulphate and sea salt coexist in a particle, it is assumed that the Cl is
3433!> replaced by sulphate; thus only either sulphate + organics or sea salt +
3434!> organics is included in the calculation of soluble fraction.
3435!> Molality parameterizations taken from Table 1 of Tang: Thermodynamic and
3436!> optical properties of mixed-salt aerosols of atmospheric importance,
3437!> J. Geophys. Res., 102 (D2), 1883-1893 (1997)
3438!
3439!> Coded by:
3440!> Hannele Korhonen (FMI) 2005
3441!> Harri Kokkola (FMI) 2006
3442!> Matti Niskanen(FMI) 2012
3443!> Anton Laakso  (FMI) 2013
3444!> Modified for the new aerosol datatype, Juha Tonttila (FMI) 2014
3445!
3446!> fxm: should sea salt form a solid particle when prh is very low (even though
3447!> it could be mixed with e.g. sulphate)?
3448!> fxm: crashes if no sulphate or sea salt
3449!> fxm: do we really need to consider Kelvin effect for subrange 2
3450!------------------------------------------------------------------------------!
3451 SUBROUTINE equilibration( prh, ptemp, paero, init )
3452
3453    IMPLICIT NONE
3454
3455    INTEGER(iwp) :: ib      !< loop index
3456    INTEGER(iwp) :: counti  !< loop index
3457
3458    LOGICAL, INTENT(in) ::  init   !< TRUE: Initialization, FALSE: Normal runtime: update water
3459                                   !< content only for 1a
3460
3461    REAL(wp) ::  zaw      !< water activity [0-1]
3462    REAL(wp) ::  zcore    !< Volume of dry particle
3463    REAL(wp) ::  zdold    !< Old diameter
3464    REAL(wp) ::  zdwet    !< Wet diameter or mean droplet diameter
3465    REAL(wp) ::  zke      !< Kelvin term in the Köhler equation
3466    REAL(wp) ::  zlwc     !< liquid water content [kg/m3-air]
3467    REAL(wp) ::  zrh      !< Relative humidity
3468
3469    REAL(wp), DIMENSION(maxspec) ::  zbinmol  !< binary molality of each components (mol/kg)
3470    REAL(wp), DIMENSION(maxspec) ::  zvpart   !< volume of chem. compounds in one particle
3471
3472    REAL(wp), INTENT(in) ::  prh    !< relative humidity [0-1]
3473    REAL(wp), INTENT(in) ::  ptemp  !< temperature (K)
3474
3475    TYPE(t_section), DIMENSION(nbins_aerosol), INTENT(inout) ::  paero  !< aerosol properties
3476
3477    zaw       = 0.0_wp
3478    zlwc      = 0.0_wp
3479!
3480!-- Relative humidity:
3481    zrh = prh
3482    zrh = MAX( zrh, 0.05_wp )
3483    zrh = MIN( zrh, 0.98_wp)
3484!
3485!-- 1) Regime 1: sulphate and partly water-soluble OC. Done for every CALL
3486    DO  ib = start_subrange_1a, end_subrange_1a   ! size bin
3487
3488       zbinmol = 0.0_wp
3489       zdold   = 1.0_wp
3490       zke     = 1.02_wp
3491
3492       IF ( paero(ib)%numc > nclim )  THEN
3493!
3494!--       Volume in one particle
3495          zvpart = 0.0_wp
3496          zvpart(1:2) = paero(ib)%volc(1:2) / paero(ib)%numc
3497          zvpart(6:7) = paero(ib)%volc(6:7) / paero(ib)%numc
3498!
3499!--       Total volume and wet diameter of one dry particle
3500          zcore = SUM( zvpart(1:2) )
3501          zdwet = paero(ib)%dwet
3502
3503          counti = 0
3504          DO  WHILE ( ABS( zdwet / zdold - 1.0_wp ) > 1.0E-2_wp )
3505
3506             zdold = MAX( zdwet, 1.0E-20_wp )
3507             zaw = MAX( 1.0E-3_wp, zrh / zke ) ! To avoid underflow
3508!
3509!--          Binary molalities (mol/kg):
3510!--          Sulphate
3511             zbinmol(1) = 1.1065495E+2_wp - 3.6759197E+2_wp * zaw + 5.0462934E+2_wp * zaw**2 -     &
3512                          3.1543839E+2_wp * zaw**3 + 6.770824E+1_wp  * zaw**4
3513!--          Organic carbon
3514             zbinmol(2) = 1.0_wp / ( zaw * amh2o ) - 1.0_wp / amh2o
3515!--          Nitric acid
3516             zbinmol(6) = 2.306844303E+1_wp - 3.563608869E+1_wp * zaw - 6.210577919E+1_wp * zaw**2 &
3517                          + 5.510176187E+2_wp * zaw**3 - 1.460055286E+3_wp * zaw**4                &
3518                          + 1.894467542E+3_wp * zaw**5 - 1.220611402E+3_wp * zaw**6                &
3519                          + 3.098597737E+2_wp * zaw**7
3520!
3521!--          Calculate the liquid water content (kg/m3-air) using ZSR (see e.g. Eq. 10.98 in
3522!--          Seinfeld and Pandis (2006))
3523             zlwc = ( paero(ib)%volc(1) * ( arhoh2so4 / amh2so4 ) ) / zbinmol(1) +                 &
3524                    epsoc * paero(ib)%volc(2) * ( arhooc / amoc ) / zbinmol(2) +                   &
3525                    ( paero(ib)%volc(6) * ( arhohno3/amhno3 ) ) / zbinmol(6)
3526!
3527!--          Particle wet diameter (m)
3528             zdwet = ( zlwc / paero(ib)%numc / arhoh2o / api6 + ( SUM( zvpart(6:7) ) / api6 ) +    &
3529                       zcore / api6 )**0.33333333_wp
3530!
3531!--          Kelvin effect (Eq. 10.85 in in Seinfeld and Pandis (2006)). Avoid
3532!--          overflow.
3533             zke = EXP( MIN( 50.0_wp, 4.0_wp * surfw0 * amvh2so4 / ( abo * ptemp *  zdwet ) ) )
3534
3535             counti = counti + 1
3536             IF ( counti > 1000 )  THEN
3537                message_string = 'Subrange 1: no convergence!'
3538                CALL message( 'salsa_mod: equilibration', 'PA0617', 1, 2, 0, 6, 0 )
3539             ENDIF
3540          ENDDO
3541!
3542!--       Instead of lwc, use the volume concentration of water from now on
3543!--       (easy to convert...)
3544          paero(ib)%volc(8) = zlwc / arhoh2o
3545!
3546!--       If this is initialization, update the core and wet diameter
3547          IF ( init )  THEN
3548             paero(ib)%dwet = zdwet
3549             paero(ib)%core = zcore
3550          ENDIF
3551
3552       ELSE
3553!--       If initialization
3554!--       1.2) empty bins given bin average values
3555          IF ( init )  THEN
3556             paero(ib)%dwet = paero(ib)%dmid
3557             paero(ib)%core = api6 * paero(ib)%dmid**3
3558          ENDIF
3559
3560       ENDIF
3561
3562    ENDDO  ! ib
3563!
3564!-- 2) Regime 2a: sulphate, OC, BC and sea salt
3565!--    This is done only for initialization call, otherwise the water contents
3566!--    are computed via condensation
3567    IF ( init )  THEN
3568       DO  ib = start_subrange_2a, end_subrange_2b
3569!
3570!--       Initialize
3571          zke     = 1.02_wp
3572          zbinmol = 0.0_wp
3573          zdold   = 1.0_wp
3574!
3575!--       1) Particle properties calculated for non-empty bins
3576          IF ( paero(ib)%numc > nclim )  THEN
3577!
3578!--          Volume in one particle [fxm]
3579             zvpart = 0.0_wp
3580             zvpart(1:7) = paero(ib)%volc(1:7) / paero(ib)%numc
3581!
3582!--          Total volume and wet diameter of one dry particle [fxm]
3583             zcore = SUM( zvpart(1:5) )
3584             zdwet = paero(ib)%dwet
3585
3586             counti = 0
3587             DO  WHILE ( ABS( zdwet / zdold - 1.0_wp ) > 1.0E-12_wp )
3588
3589                zdold = MAX( zdwet, 1.0E-20_wp )
3590                zaw = zrh / zke
3591!
3592!--             Binary molalities (mol/kg):
3593!--             Sulphate
3594                zbinmol(1) = 1.1065495E+2_wp - 3.6759197E+2_wp * zaw + 5.0462934E+2_wp * zaw**2 -  &
3595                             3.1543839E+2_wp * zaw**3 + 6.770824E+1_wp  * zaw**4
3596!--             Organic carbon
3597                zbinmol(2) = 1.0_wp / ( zaw * amh2o ) - 1.0_wp / amh2o
3598!--             Nitric acid
3599                zbinmol(6) = 2.306844303E+1_wp          - 3.563608869E+1_wp * zaw -                &
3600                             6.210577919E+1_wp * zaw**2 + 5.510176187E+2_wp * zaw**3 -             &
3601                             1.460055286E+3_wp * zaw**4 + 1.894467542E+3_wp * zaw**5 -             &
3602                             1.220611402E+3_wp * zaw**6 + 3.098597737E+2_wp * zaw**7 
3603!--             Sea salt (natrium chloride)
3604                zbinmol(5) = 5.875248E+1_wp - 1.8781997E+2_wp * zaw + 2.7211377E+2_wp * zaw**2 -   &
3605                             1.8458287E+2_wp * zaw**3 + 4.153689E+1_wp  * zaw**4
3606!
3607!--             Calculate the liquid water content (kg/m3-air)
3608                zlwc = ( paero(ib)%volc(1) * ( arhoh2so4 / amh2so4 ) ) / zbinmol(1) +              &
3609                       epsoc * ( paero(ib)%volc(2) * ( arhooc / amoc ) ) / zbinmol(2) +            &
3610                       ( paero(ib)%volc(6) * ( arhohno3 / amhno3 ) ) / zbinmol(6) +                &
3611                       ( paero(ib)%volc(5) * ( arhoss / amss ) ) / zbinmol(5)
3612
3613!--             Particle wet radius (m)
3614                zdwet = ( zlwc / paero(ib)%numc / arhoh2o / api6 + ( SUM( zvpart(6:7) ) / api6 )  + &
3615                           zcore / api6 )**0.33333333_wp
3616!
3617!--             Kelvin effect (Eq. 10.85 in Seinfeld and Pandis (2006))
3618                zke = EXP( MIN( 50.0_wp, 4.0_wp * surfw0 * amvh2so4 / ( abo * zdwet * ptemp ) ) )
3619
3620                counti = counti + 1
3621                IF ( counti > 1000 )  THEN
3622                   message_string = 'Subrange 2: no convergence!'
3623                CALL message( 'salsa_mod: equilibration', 'PA0618', 1, 2, 0, 6, 0 )
3624                ENDIF
3625             ENDDO
3626!
3627!--          Liquid water content; instead of LWC use the volume concentration
3628             paero(ib)%volc(8) = zlwc / arhoh2o
3629             paero(ib)%dwet    = zdwet
3630             paero(ib)%core    = zcore
3631
3632          ELSE
3633!--          2.2) empty bins given bin average values
3634             paero(ib)%dwet = paero(ib)%dmid
3635             paero(ib)%core = api6 * paero(ib)%dmid**3
3636          ENDIF
3637
3638       ENDDO   ! ib
3639    ENDIF
3640
3641 END SUBROUTINE equilibration
3642
3643!------------------------------------------------------------------------------!
3644!> Description:
3645!> ------------
3646!> Calculation of the settling velocity vc (m/s) per aerosol size bin and
3647!> deposition on plant canopy (lsdepo_pcm).
3648!
3649!> Deposition is based on either the scheme presented in:
3650!> Zhang et al. (2001), Atmos. Environ. 35, 549-560 (includes collection due to
3651!> Brownian diffusion, impaction, interception and sedimentation; hereafter ZO1)
3652!> OR
3653!> Petroff & Zhang (2010), Geosci. Model Dev. 3, 753-769 (includes also
3654!> collection due to turbulent impaction, hereafter P10)
3655!
3656!> Equation numbers refer to equation in Jacobson (2005): Fundamentals of
3657!> Atmospheric Modeling, 2nd Edition.
3658!
3659!> Subroutine follows closely sedim_SALSA in UCLALES-SALSA written by Juha
3660!> Tonttila (KIT/FMI) and Zubair Maalick (UEF).
3661!> Rewritten to PALM by Mona Kurppa (UH), 2017.
3662!
3663!> Call for grid point i,j,k
3664!------------------------------------------------------------------------------!
3665
3666 SUBROUTINE deposition( paero, tk, adn, mag_u, lad, kvis, schmidt_num, vc )
3667
3668    USE plant_canopy_model_mod,                                                                    &
3669        ONLY:  cdc
3670
3671    IMPLICIT NONE
3672
3673    INTEGER(iwp) ::  ib   !< loop index
3674    INTEGER(iwp) ::  ic   !< loop index
3675
3676    REAL(wp) ::  alpha             !< parameter, Table 3 in Z01
3677    REAL(wp) ::  avis              !< molecular viscocity of air (kg/(m*s))
3678    REAL(wp) ::  beta_im           !< parameter for turbulent impaction
3679    REAL(wp) ::  c_brownian_diff   !< coefficient for Brownian diffusion
3680    REAL(wp) ::  c_impaction       !< coefficient for inertial impaction
3681    REAL(wp) ::  c_interception    !< coefficient for interception
3682    REAL(wp) ::  c_turb_impaction  !< coefficient for turbulent impaction
3683    REAL(wp) ::  depo              !< deposition velocity (m/s)
3684    REAL(wp) ::  gamma             !< parameter, Table 3 in Z01
3685    REAL(wp) ::  lambda            !< molecular mean free path (m)
3686    REAL(wp) ::  mdiff             !< particle diffusivity coefficient
3687    REAL(wp) ::  par_a             !< parameter A for the characteristic radius of collectors,
3688                                   !< Table 3 in Z01
3689    REAL(wp) ::  par_l             !< obstacle characteristic dimension in P10
3690    REAL(wp) ::  pdn               !< particle density (kg/m3)
3691    REAL(wp) ::  ustar             !< friction velocity (m/s)
3692    REAL(wp) ::  va                !< thermal speed of an air molecule (m/s)
3693
3694    REAL(wp), INTENT(in) ::  adn    !< air density (kg/m3)
3695    REAL(wp), INTENT(in) ::  lad    !< leaf area density (m2/m3)
3696    REAL(wp), INTENT(in) ::  mag_u  !< wind velocity (m/s)
3697    REAL(wp), INTENT(in) ::  tk     !< abs.temperature (K)
3698
3699    REAL(wp), INTENT(inout) ::  kvis   !< kinematic viscosity of air (m2/s)
3700
3701    REAL(wp), DIMENSION(nbins_aerosol) ::  beta   !< Cunningham slip-flow correction factor
3702    REAL(wp), DIMENSION(nbins_aerosol) ::  Kn     !< Knudsen number
3703    REAL(wp), DIMENSION(nbins_aerosol) ::  zdwet  !< wet diameter (m)
3704
3705    REAL(wp), DIMENSION(:), INTENT(inout) ::  schmidt_num  !< particle Schmidt number
3706    REAL(wp), DIMENSION(:), INTENT(inout) ::  vc  !< critical fall speed i.e. settling velocity of
3707                                                  !< an aerosol particle (m/s)
3708
3709    TYPE(t_section), DIMENSION(nbins_aerosol), INTENT(inout) ::  paero  !< aerosol properties
3710!
3711!-- Initialise
3712    depo  = 0.0_wp
3713    pdn   = 1500.0_wp    ! default value
3714    ustar = 0.0_wp
3715!
3716!-- Molecular viscosity of air (Eq. 4.54)
3717    avis = 1.8325E-5_wp * ( 416.16_wp / ( tk + 120.0_wp ) ) * ( tk / 296.16_wp )**1.5_wp
3718!
3719!-- Kinematic viscosity (Eq. 4.55)
3720    kvis =  avis / adn
3721!
3722!-- Thermal velocity of an air molecule (Eq. 15.32)
3723    va = SQRT( 8.0_wp * abo * tk / ( pi * am_airmol ) )
3724!
3725!-- Mean free path (m) (Eq. 15.24)
3726    lambda = 2.0_wp * avis / ( adn * va )
3727!
3728!-- Particle wet diameter (m)
3729    zdwet = paero(:)%dwet
3730!
3731!-- Knudsen number (Eq. 15.23)
3732    Kn = MAX( 1.0E-2_wp, lambda / ( zdwet * 0.5_wp ) ) ! To avoid underflow
3733!
3734!-- Cunningham slip-flow correction (Eq. 15.30)
3735    beta = 1.0_wp + Kn * ( 1.249_wp + 0.42_wp * EXP( -0.87_wp / Kn ) )
3736!
3737!-- Critical fall speed i.e. settling velocity  (Eq. 20.4)
3738    vc = MIN( 1.0_wp, zdwet**2 * ( pdn - adn ) * g * beta / ( 18.0_wp * avis ) )
3739!
3740!-- Deposition on vegetation
3741    IF ( lsdepo_pcm  .AND.  plant_canopy  .AND.  lad > 0.0_wp )  THEN
3742!
3743!--    Parameters for the land use category 'deciduous broadleaf trees'(Table 3)
3744       alpha   = alpha_z01(depo_pcm_type_num)
3745       gamma   = gamma_z01(depo_pcm_type_num)
3746       par_a   = A_z01(depo_pcm_type_num, season) * 1.0E-3_wp
3747!
3748!--    Deposition efficiencies from Table 1. Constants from Table 2.
3749       par_l            = l_p10(depo_pcm_type_num) * 0.01_wp
3750       c_brownian_diff  = c_b_p10(depo_pcm_type_num)
3751       c_interception   = c_in_p10(depo_pcm_type_num)
3752       c_impaction      = c_im_p10(depo_pcm_type_num)
3753       beta_im          = beta_im_p10(depo_pcm_type_num)
3754       c_turb_impaction = c_it_p10(depo_pcm_type_num)
3755
3756       DO  ib = 1, nbins_aerosol
3757
3758          IF ( paero(ib)%numc < ( 2.0_wp * nclim ) )  CYCLE
3759
3760!--       Particle diffusivity coefficient (Eq. 15.29)
3761          mdiff = ( abo * tk * beta(ib) ) / ( 3.0_wp * pi * avis * zdwet(ib) )
3762!
3763!--       Particle Schmidt number (Eq. 15.36)
3764          schmidt_num(ib) = kvis / mdiff
3765!
3766!--       Friction velocity for deposition on vegetation. Calculated following Prandtl (1925):
3767          ustar = SQRT( cdc ) * mag_u
3768          SELECT CASE ( depo_pcm_par_num )
3769
3770             CASE ( 1 )   ! Zhang et al. (2001)
3771                CALL depo_vel_Z01( vc(ib), ustar, schmidt_num(ib), paero(ib)%dwet, alpha,  gamma,  &
3772                                   par_a, depo )
3773             CASE ( 2 )   ! Petroff & Zhang (2010)
3774                CALL depo_vel_P10( vc(ib), mag_u, ustar, kvis, schmidt_num(ib), paero(ib)%dwet,    &
3775                                   par_l, c_brownian_diff, c_interception, c_impaction, beta_im,   &
3776                                   c_turb_impaction, depo )
3777          END SELECT
3778!
3779!--       Calculate the change in concentrations
3780          paero(ib)%numc = paero(ib)%numc - depo * lad * paero(ib)%numc * dt_salsa
3781          DO  ic = 1, maxspec+1
3782             paero(ib)%volc(ic) = paero(ib)%volc(ic) - depo * lad * paero(ib)%volc(ic) * dt_salsa
3783          ENDDO
3784       ENDDO
3785
3786    ENDIF
3787
3788 END SUBROUTINE deposition
3789
3790!------------------------------------------------------------------------------!
3791! Description:
3792! ------------
3793!> Calculate deposition velocity (m/s) based on Zhan et al. (2001, case 1).
3794!------------------------------------------------------------------------------!
3795
3796 SUBROUTINE depo_vel_Z01( vc, ustar, schmidt_num, diameter, alpha, gamma, par_a, depo )
3797
3798    IMPLICIT NONE
3799
3800    REAL(wp) ::  rs                !< overall quasi-laminar resistance for particles
3801    REAL(wp) ::  stokes_num        !< Stokes number for smooth or bluff surfaces
3802
3803    REAL(wp), INTENT(in) ::  alpha        !< parameter, Table 3 in Z01
3804    REAL(wp), INTENT(in) ::  gamma        !< parameter, Table 3 in Z01
3805    REAL(wp), INTENT(in) ::  par_a        !< parameter A for the characteristic diameter of
3806                                          !< collectors, Table 3 in Z01
3807    REAL(wp), INTENT(in) ::  diameter     !< particle diameter
3808    REAL(wp), INTENT(in) ::  schmidt_num  !< particle Schmidt number
3809    REAL(wp), INTENT(in) ::  ustar        !< friction velocity (m/s)
3810    REAL(wp), INTENT(in) ::  vc           !< terminal velocity (m/s)
3811
3812    REAL(wp), INTENT(inout)  ::  depo     !< deposition efficiency (m/s)
3813
3814    IF ( par_a > 0.0_wp )  THEN
3815!
3816!--    Initialise
3817       rs = 0.0_wp
3818!
3819!--    Stokes number for vegetated surfaces (Seinfeld & Pandis (2006): Eq.19.24)
3820       stokes_num = vc * ustar / ( g * par_a )
3821!
3822!--    The overall quasi-laminar resistance for particles (Zhang et al., Eq. 5)
3823       rs = MAX( EPSILON( 1.0_wp ), ( 3.0_wp * ustar * EXP( -stokes_num**0.5_wp ) *                &
3824                 ( schmidt_num**( -gamma ) + ( stokes_num / ( alpha + stokes_num ) )**2 +          &
3825                 0.5_wp * ( diameter / par_a )**2 ) ) )
3826
3827       depo = rs + vc
3828
3829    ELSE
3830       depo = 0.0_wp
3831    ENDIF
3832
3833 END SUBROUTINE depo_vel_Z01
3834
3835!------------------------------------------------------------------------------!
3836! Description:
3837! ------------
3838!> Calculate deposition velocity (m/s) based on Petroff & Zhang (2010, case 2).
3839!------------------------------------------------------------------------------!
3840
3841 SUBROUTINE depo_vel_P10( vc, mag_u, ustar, kvis_a, schmidt_num, diameter, par_l, c_brownian_diff, &
3842                          c_interception, c_impaction, beta_im, c_turb_impaction, depo )
3843
3844    IMPLICIT NONE
3845
3846    REAL(wp) ::  stokes_num        !< Stokes number for smooth or bluff surfaces
3847    REAL(wp) ::  tau_plus          !< dimensionless particle relaxation time
3848    REAL(wp) ::  v_bd              !< deposition velocity due to Brownian diffusion
3849    REAL(wp) ::  v_im              !< deposition velocity due to impaction
3850    REAL(wp) ::  v_in              !< deposition velocity due to interception
3851    REAL(wp) ::  v_it              !< deposition velocity due to turbulent impaction
3852
3853    REAL(wp), INTENT(in) ::  beta_im           !< parameter for turbulent impaction
3854    REAL(wp), INTENT(in) ::  c_brownian_diff   !< coefficient for Brownian diffusion
3855    REAL(wp), INTENT(in) ::  c_impaction       !< coefficient for inertial impaction
3856    REAL(wp), INTENT(in) ::  c_interception    !< coefficient for interception
3857    REAL(wp), INTENT(in) ::  c_turb_impaction  !< coefficient for turbulent impaction
3858    REAL(wp), INTENT(in) ::  kvis_a       !< kinematic viscosity of air (m2/s)
3859    REAL(wp), INTENT(in) ::  mag_u        !< wind velocity (m/s)
3860    REAL(wp), INTENT(in) ::  par_l        !< obstacle characteristic dimension in P10
3861    REAL(wp), INTENT(in) ::  diameter       !< particle diameter
3862    REAL(wp), INTENT(in) ::  schmidt_num  !< particle Schmidt number
3863    REAL(wp), INTENT(in) ::  ustar        !< friction velocity (m/s)
3864    REAL(wp), INTENT(in) ::  vc           !< terminal velocity (m/s)
3865
3866    REAL(wp), INTENT(inout)  ::  depo     !< deposition efficiency (m/s)
3867
3868    IF ( par_l > 0.0_wp )  THEN
3869!
3870!--    Initialise
3871       tau_plus = 0.0_wp
3872       v_bd     = 0.0_wp
3873       v_im     = 0.0_wp
3874       v_in     = 0.0_wp
3875       v_it     = 0.0_wp
3876!
3877!--    Stokes number for vegetated surfaces (Seinfeld & Pandis (2006): Eq.19.24)
3878       stokes_num = vc * ustar / ( g * par_l )
3879!
3880!--    Non-dimensional relexation time of the particle on top of canopy
3881       tau_plus = vc * ustar**2 / ( kvis_a * g )
3882!
3883!--    Brownian diffusion
3884       v_bd = mag_u * c_brownian_diff * schmidt_num**( -0.66666666_wp ) *                          &
3885              ( mag_u * par_l / kvis_a )**( -0.5_wp )
3886!
3887!--    Interception
3888       v_in = mag_u * c_interception * diameter / par_l *                                          &
3889              ( 2.0_wp + LOG( 2.0_wp * par_l / diameter ) )
3890!
3891!--    Impaction: Petroff (2009) Eq. 18
3892       v_im = mag_u * c_impaction * ( stokes_num / ( stokes_num + beta_im ) )**2
3893!
3894!--    Turbulent impaction
3895       IF ( tau_plus < 20.0_wp )  THEN
3896          v_it = 2.5E-3_wp * c_turb_impaction * tau_plus**2
3897       ELSE
3898          v_it = c_turb_impaction
3899       ENDIF
3900
3901       depo = ( v_bd + v_in + v_im + v_it + vc )
3902
3903    ELSE
3904       depo = 0.0_wp
3905    ENDIF
3906
3907 END SUBROUTINE depo_vel_P10
3908
3909!------------------------------------------------------------------------------!
3910! Description:
3911! ------------
3912!> Calculate the dry deposition on horizontal and vertical surfaces. Implement
3913!> as a surface flux.
3914!> @todo aerodynamic resistance ignored for now (not important for
3915!        high-resolution simulations)
3916!------------------------------------------------------------------------------!
3917 SUBROUTINE depo_surf( i, j, surf, vc, schmidt_num, kvis, mag_u, norm, match_array )
3918
3919    USE arrays_3d,                                                                                 &
3920        ONLY: rho_air_zw
3921
3922    USE surface_mod,                                                                               &
3923        ONLY:  ind_pav_green, ind_veg_wall, ind_wat_win, surf_type
3924
3925    IMPLICIT NONE
3926
3927    INTEGER(iwp) ::  ib      !< loop index
3928    INTEGER(iwp) ::  ic      !< loop index
3929    INTEGER(iwp) ::  icc     !< additional loop index
3930    INTEGER(iwp) ::  k       !< loop index
3931    INTEGER(iwp) ::  m       !< loop index
3932    INTEGER(iwp) ::  surf_e  !< End index of surface elements at (j,i)-gridpoint
3933    INTEGER(iwp) ::  surf_s  !< Start index of surface elements at (j,i)-gridpoint
3934
3935    INTEGER(iwp), INTENT(in) ::  i  !< loop index
3936    INTEGER(iwp), INTENT(in) ::  j  !< loop index
3937
3938    LOGICAL, INTENT(in) ::  norm   !< to normalise or not
3939
3940    REAL(wp) ::  alpha             !< parameter, Table 3 in Z01
3941    REAL(wp) ::  beta_im           !< parameter for turbulent impaction
3942    REAL(wp) ::  c_brownian_diff   !< coefficient for Brownian diffusion
3943    REAL(wp) ::  c_impaction       !< coefficient for inertial impaction
3944    REAL(wp) ::  c_interception    !< coefficient for interception
3945    REAL(wp) ::  c_turb_impaction  !< coefficient for turbulent impaction
3946    REAL(wp) ::  gamma             !< parameter, Table 3 in Z01
3947    REAL(wp) ::  norm_fac          !< normalisation factor (usually air density)
3948    REAL(wp) ::  par_a             !< parameter A for the characteristic radius of collectors,
3949                                   !< Table 3 in Z01
3950    REAL(wp) ::  par_l             !< obstacle characteristic dimension in P10
3951    REAL(wp) ::  rs                !< the overall quasi-laminar resistance for particles
3952    REAL(wp) ::  tau_plus          !< dimensionless particle relaxation time
3953    REAL(wp) ::  v_bd              !< deposition velocity due to Brownian diffusion
3954    REAL(wp) ::  v_im              !< deposition velocity due to impaction
3955    REAL(wp) ::  v_in              !< deposition velocity due to interception
3956    REAL(wp) ::  v_it              !< deposition velocity due to turbulent impaction
3957
3958    REAL(wp), DIMENSION(nbins_aerosol) ::  depo      !< deposition efficiency
3959    REAL(wp), DIMENSION(nbins_aerosol) ::  depo_sum  !< sum of deposition efficiencies
3960
3961    REAL(wp), DIMENSION(:), INTENT(in) ::  kvis   !< kinematic viscosity of air (m2/s)
3962    REAL(wp), DIMENSION(:), INTENT(in) ::  mag_u  !< wind velocity (m/s)
3963
3964    REAL(wp), DIMENSION(:,:), INTENT(in) ::  schmidt_num   !< particle Schmidt number
3965    REAL(wp), DIMENSION(:,:), INTENT(in) ::  vc            !< terminal velocity (m/s)
3966
3967    TYPE(match_surface), INTENT(in), OPTIONAL ::  match_array  !< match the deposition module and
3968                                                               !< LSM/USM surfaces
3969    TYPE(surf_type), INTENT(inout) :: surf                     !< respective surface type
3970!
3971!-- Initialise
3972    depo     = 0.0_wp
3973    depo_sum = 0.0_wp
3974    rs       = 0.0_wp
3975    surf_s   = surf%start_index(j,i)
3976    surf_e   = surf%end_index(j,i)
3977    tau_plus = 0.0_wp
3978    v_bd     = 0.0_wp
3979    v_im     = 0.0_wp
3980    v_in     = 0.0_wp
3981    v_it     = 0.0_wp
3982!
3983!-- Model parameters for the land use category. If LSM or USM is applied, import
3984!-- characteristics. Otherwise, apply surface type "urban".
3985    alpha   = alpha_z01(luc_urban)
3986    gamma   = gamma_z01(luc_urban)
3987    par_a   = A_z01(luc_urban, season) * 1.0E-3_wp
3988
3989    par_l            = l_p10(luc_urban) * 0.01_wp
3990    c_brownian_diff  = c_b_p10(luc_urban)
3991    c_interception   = c_in_p10(luc_urban)
3992    c_impaction      = c_im_p10(luc_urban)
3993    beta_im          = beta_im_p10(luc_urban)
3994    c_turb_impaction = c_it_p10(luc_urban)
3995
3996
3997    IF ( PRESENT( match_array ) )  THEN  ! land or urban surface model
3998
3999       DO  m = surf_s, surf_e
4000
4001          k = surf%k(m)
4002          norm_fac = 1.0_wp
4003
4004          IF ( norm )  norm_fac = rho_air_zw(k)  ! normalise vertical fluxes by air density
4005
4006          IF ( match_array%match_lupg(m) > 0 )  THEN
4007             alpha = alpha_z01( match_array%match_lupg(m) )
4008             gamma = gamma_z01( match_array%match_lupg(m) )
4009             par_a = A_z01( match_array%match_lupg(m), season ) * 1.0E-3_wp
4010
4011             beta_im          = beta_im_p10( match_array%match_lupg(m) )
4012             c_brownian_diff  = c_b_p10( match_array%match_lupg(m) )
4013             c_impaction      = c_im_p10( match_array%match_lupg(m) )
4014             c_interception   = c_in_p10( match_array%match_lupg(m) )
4015             c_turb_impaction = c_it_p10( match_array%match_lupg(m) )
4016             par_l            = l_p10( match_array%match_lupg(m) ) * 0.01_wp
4017
4018             DO  ib = 1, nbins_aerosol
4019                IF ( aerosol_number(ib)%conc(k,j,i) < ( 2.0_wp * nclim )  .OR.                     &
4020                     schmidt_num(k+1,ib) < 1.0_wp )  CYCLE
4021
4022                SELECT CASE ( depo_surf_par_num )
4023
4024                   CASE ( 1 )
4025                      CALL depo_vel_Z01( vc(k+1,ib), surf%us(m), schmidt_num(k+1,ib),              &
4026                                         ra_dry(k,j,i,ib), alpha, gamma, par_a, depo(ib) )
4027                   CASE ( 2 )
4028                      CALL depo_vel_P10( vc(k+1,ib), mag_u(k+1), surf%us(m), kvis(k+1),            &
4029                                         schmidt_num(k+1,ib), ra_dry(k,j,i,ib), par_l,             &
4030                                         c_brownian_diff, c_interception, c_impaction, beta_im,    &
4031                                         c_turb_impaction, depo(ib) )
4032                END SELECT
4033             ENDDO
4034             depo_sum = depo_sum + surf%frac(ind_pav_green,m) * depo
4035          ENDIF
4036
4037          IF ( match_array%match_luvw(m) > 0 )  THEN
4038             alpha = alpha_z01( match_array%match_luvw(m) )
4039             gamma = gamma_z01( match_array%match_luvw(m) )
4040             par_a = A_z01( match_array%match_luvw(m), season ) * 1.0E-3_wp
4041
4042             beta_im          = beta_im_p10( match_array%match_luvw(m) )
4043             c_brownian_diff  = c_b_p10( match_array%match_luvw(m) )
4044             c_impaction      = c_im_p10( match_array%match_luvw(m) )
4045             c_interception   = c_in_p10( match_array%match_luvw(m) )
4046             c_turb_impaction = c_it_p10( match_array%match_luvw(m) )
4047             par_l            = l_p10( match_array%match_luvw(m) ) * 0.01_wp
4048
4049             DO  ib = 1, nbins_aerosol
4050                IF ( aerosol_number(ib)%conc(k,j,i) < ( 2.0_wp * nclim )  .OR.                     &
4051                     schmidt_num(k+1,ib) < 1.0_wp )  CYCLE
4052
4053                SELECT CASE ( depo_surf_par_num )
4054
4055                   CASE ( 1 )
4056                      CALL depo_vel_Z01( vc(k+1,ib), surf%us(m), schmidt_num(k+1,ib),              &
4057                                         ra_dry(k,j,i,ib), alpha, gamma, par_a, depo(ib) )
4058                   CASE ( 2 )
4059                      CALL depo_vel_P10( vc(k+1,ib), mag_u(k+1), surf%us(m), kvis(k+1),            &
4060                                         schmidt_num(k+1,ib), ra_dry(k,j,i,ib), par_l,             &
4061                                         c_brownian_diff, c_interception, c_impaction, beta_im,    &
4062                                         c_turb_impaction, depo(ib) )
4063                END SELECT
4064             ENDDO
4065             depo_sum = depo_sum + surf%frac(ind_veg_wall,m) * depo
4066          ENDIF
4067
4068          IF ( match_array%match_luww(m) > 0 )  THEN
4069             alpha = alpha_z01( match_array%match_luww(m) )
4070             gamma = gamma_z01( match_array%match_luww(m) )
4071             par_a = A_z01( match_array%match_luww(m), season ) * 1.0E-3_wp
4072
4073             beta_im          = beta_im_p10( match_array%match_luww(m) )
4074             c_brownian_diff  = c_b_p10( match_array%match_luww(m) )
4075             c_impaction      = c_im_p10( match_array%match_luww(m) )
4076             c_interception   = c_in_p10( match_array%match_luww(m) )
4077             c_turb_impaction = c_it_p10( match_array%match_luww(m) )
4078             par_l            = l_p10( match_array%match_luww(m) ) * 0.01_wp
4079
4080             DO  ib = 1, nbins_aerosol
4081                IF ( aerosol_number(ib)%conc(k,j,i) < ( 2.0_wp * nclim )  .OR.                     &
4082                     schmidt_num(k+1,ib) < 1.0_wp )  CYCLE
4083
4084                SELECT CASE ( depo_surf_par_num )
4085
4086                   CASE ( 1 )
4087                      CALL depo_vel_Z01( vc(k+1,ib), surf%us(m), schmidt_num(k+1,ib),              &
4088                                         ra_dry(k,j,i,ib), alpha, gamma, par_a, depo(ib) )
4089                   CASE ( 2 )
4090                      CALL depo_vel_P10( vc(k+1,ib), mag_u(k+1), surf%us(m), kvis(k+1),            &
4091                                         schmidt_num(k+1,ib), ra_dry(k,j,i,ib), par_l,             &
4092                                         c_brownian_diff, c_interception, c_impaction, beta_im,    &
4093                                         c_turb_impaction, depo(ib) )
4094                END SELECT
4095             ENDDO
4096             depo_sum = depo_sum + surf%frac(ind_wat_win,m) * depo
4097          ENDIF
4098
4099          DO  ib = 1, nbins_aerosol
4100             IF ( aerosol_number(ib)%conc(k,j,i) < ( 2.0_wp * nclim ) )  CYCLE
4101!
4102!--          Calculate changes in surface fluxes due to dry deposition
4103             IF ( include_emission )  THEN
4104                surf%answs(m,ib) = aerosol_number(ib)%source(j,i) - MAX( 0.0_wp,                   &
4105                                   depo_sum(ib) * norm_fac * aerosol_number(ib)%conc(k,j,i) )
4106                DO  ic = 1, ncomponents_mass
4107                   icc = ( ic - 1 ) * nbins_aerosol + ib
4108                   surf%amsws(m,icc) = aerosol_mass(icc)%source(j,i) - MAX( 0.0_wp,                &
4109                                       depo_sum(ib) *  norm_fac * aerosol_mass(icc)%conc(k,j,i) )
4110                ENDDO  ! ic
4111             ELSE
4112                surf%answs(m,ib) = -depo_sum(ib) * norm_fac * aerosol_number(ib)%conc(k,j,i)
4113                DO  ic = 1, ncomponents_mass
4114                   icc = ( ic - 1 ) * nbins_aerosol + ib
4115                   surf%amsws(m,icc) = -depo_sum(ib) *  norm_fac * aerosol_mass(icc)%conc(k,j,i)
4116                ENDDO  ! ic
4117             ENDIF
4118          ENDDO  ! ib
4119
4120       ENDDO
4121
4122    ELSE  ! default surfaces
4123
4124       DO  m = surf_s, surf_e
4125
4126          k = surf%k(m)
4127          norm_fac = 1.0_wp
4128
4129          IF ( norm )  norm_fac = rho_air_zw(k)  ! normalise vertical fluxes by air density
4130
4131          DO  ib = 1, nbins_aerosol
4132             IF ( aerosol_number(ib)%conc(k,j,i) < ( 2.0_wp * nclim )  .OR.                        &
4133                  schmidt_num(k+1,ib) < 1.0_wp )  CYCLE
4134
4135             SELECT CASE ( depo_surf_par_num )
4136
4137                CASE ( 1 )
4138                   CALL depo_vel_Z01( vc(k+1,ib), surf%us(m), schmidt_num(k+1,ib),                 &
4139                                      ra_dry(k,j,i,ib), alpha, gamma, par_a, depo(ib) )
4140                CASE ( 2 )
4141                   CALL depo_vel_P10( vc(k+1,ib), mag_u(k+1), surf%us(m), kvis(k+1),               &
4142                                      schmidt_num(k+1,ib), ra_dry(k,j,i,ib), par_l,                &
4143                                      c_brownian_diff, c_interception, c_impaction, beta_im,       &
4144                                      c_turb_impaction, depo(ib) )
4145             END SELECT
4146!
4147!--          Calculate changes in surface fluxes due to dry deposition
4148             IF ( include_emission )  THEN
4149                surf%answs(m,ib) = aerosol_number(ib)%source(j,i) - MAX( 0.0_wp,                   &
4150                                   depo(ib) * norm_fac * aerosol_number(ib)%conc(k,j,i) )
4151                DO  ic = 1, ncomponents_mass
4152                   icc = ( ic - 1 ) * nbins_aerosol + ib
4153                   surf%amsws(m,icc) = aerosol_mass(icc)%source(j,i) - MAX( 0.0_wp,                &
4154                                       depo(ib) *  norm_fac * aerosol_mass(icc)%conc(k,j,i) )
4155                ENDDO  ! ic
4156             ELSE
4157                surf%answs(m,ib) = -depo(ib) * norm_fac * aerosol_number(ib)%conc(k,j,i)
4158                DO  ic = 1, ncomponents_mass
4159                   icc = ( ic - 1 ) * nbins_aerosol + ib
4160                   surf%amsws(m,icc) = -depo(ib) *  norm_fac * aerosol_mass(icc)%conc(k,j,i)
4161                ENDDO  ! ic
4162             ENDIF
4163          ENDDO  ! ib
4164       ENDDO
4165
4166    ENDIF
4167
4168 END SUBROUTINE depo_surf
4169
4170!------------------------------------------------------------------------------!
4171! Description:
4172! ------------
4173!> Calculates particle loss and change in size distribution due to (Brownian)
4174!> coagulation. Only for particles with dwet < 30 micrometres.
4175!
4176!> Method:
4177!> Semi-implicit, non-iterative method: (Jacobson, 1994)
4178!> Volume concentrations of the smaller colliding particles added to the bin of
4179!> the larger colliding particles. Start from first bin and use the updated
4180!> number and volume for calculation of following bins. NB! Our bin numbering
4181!> does not follow particle size in subrange 2.
4182!
4183!> Schematic for bin numbers in different subranges:
4184!>             1                            2
4185!>    +-------------------------------------------+
4186!>  a | 1 | 2 | 3 || 4 | 5 | 6 | 7 |  8 |  9 | 10||
4187!>  b |           ||11 |12 |13 |14 | 15 | 16 | 17||
4188!>    +-------------------------------------------+
4189!
4190!> Exact coagulation coefficients for each pressure level are scaled according
4191!> to current particle wet size (linear scaling).
4192!> Bins are organized in terms of the dry size of the condensation nucleus,
4193!> while coagulation kernell is calculated with the actual hydrometeor
4194!> size.
4195!
4196!> Called from salsa_driver
4197!> fxm: Process selection should be made smarter - now just lots of IFs inside
4198!>      loops
4199!
4200!> Coded by:
4201!> Hannele Korhonen (FMI) 2005
4202!> Harri Kokkola (FMI) 2006
4203!> Tommi Bergman (FMI) 2012
4204!> Matti Niskanen(FMI) 2012
4205!> Anton Laakso  (FMI) 2013
4206!> Juha Tonttila (FMI) 2014
4207!------------------------------------------------------------------------------!
4208 SUBROUTINE coagulation( paero, ptstep, ptemp, ppres )
4209
4210    IMPLICIT NONE
4211
4212    INTEGER(iwp) ::  index_2a !< corresponding bin in subrange 2a
4213    INTEGER(iwp) ::  index_2b !< corresponding bin in subrange 2b
4214    INTEGER(iwp) ::  ib       !< loop index
4215    INTEGER(iwp) ::  ll       !< loop index
4216    INTEGER(iwp) ::  mm       !< loop index
4217    INTEGER(iwp) ::  nn       !< loop index
4218
4219    REAL(wp) ::  pressi          !< pressure
4220    REAL(wp) ::  temppi          !< temperature
4221    REAL(wp) ::  zdpart_mm       !< diameter of particle (m)
4222    REAL(wp) ::  zdpart_nn       !< diameter of particle (m)
4223    REAL(wp) ::  zminusterm      !< coagulation loss in a bin (1/s)
4224
4225    REAL(wp), INTENT(in) ::  ppres  !< ambient pressure (Pa)
4226    REAL(wp), INTENT(in) ::  ptemp  !< ambient temperature (K)
4227    REAL(wp), INTENT(in) ::  ptstep !< time step (s)
4228
4229    REAL(wp), DIMENSION(nbins_aerosol) ::  zmpart     !< approximate mass of particles (kg)
4230    REAL(wp), DIMENSION(maxspec+1)     ::  zplusterm  !< coagulation gain in a bin (for each
4231                                                      !< chemical compound)
4232    REAL(wp), DIMENSION(nbins_aerosol,nbins_aerosol) ::  zcc  !< updated coagulation coeff. (m3/s)
4233
4234    TYPE(t_section), DIMENSION(nbins_aerosol), INTENT(inout) ::  paero  !< Aerosol properties
4235
4236    zdpart_mm = 0.0_wp
4237    zdpart_nn = 0.0_wp
4238!
4239!-- 1) Coagulation to coarse mode calculated in a simplified way:
4240!--    CoagSink ~ Dp in continuum subrange --> 'effective' number conc. of coarse particles
4241
4242!-- 2) Updating coagulation coefficients
4243!
4244!-- Aerosol mass (kg). Density of 1500 kg/m3 assumed
4245    zmpart(1:end_subrange_2b) = api6 * ( MIN( paero(1:end_subrange_2b)%dwet, 30.0E-6_wp )**3 )     &
4246                                * 1500.0_wp
4247    temppi = ptemp
4248    pressi = ppres
4249    zcc    = 0.0_wp
4250!
4251!-- Aero-aero coagulation
4252    DO  mm = 1, end_subrange_2b   ! smaller colliding particle
4253       IF ( paero(mm)%numc < ( 2.0_wp * nclim ) )  CYCLE
4254       DO  nn = mm, end_subrange_2b   ! larger colliding particle
4255          IF ( paero(nn)%numc < ( 2.0_wp * nclim ) )  CYCLE
4256
4257          zdpart_mm = MIN( paero(mm)%dwet, 30.0E-6_wp )     ! Limit to 30 um
4258          zdpart_nn = MIN( paero(nn)%dwet, 30.0E-6_wp )     ! Limit to 30 um
4259!
4260!--       Coagulation coefficient of particles (m3/s)
4261          zcc(mm,nn) = coagc( zdpart_mm, zdpart_nn, zmpart(mm), zmpart(nn), temppi, pressi )
4262          zcc(nn,mm) = zcc(mm,nn)
4263       ENDDO
4264    ENDDO
4265
4266!
4267!-- 3) New particle and volume concentrations after coagulation:
4268!--    Calculated according to Jacobson (2005) eq. 15.9
4269!
4270!-- Aerosols in subrange 1a:
4271    DO  ib = start_subrange_1a, end_subrange_1a
4272       IF ( paero(ib)%numc < ( 2.0_wp * nclim ) )  CYCLE
4273       zminusterm   = 0.0_wp
4274       zplusterm(:) = 0.0_wp
4275!
4276!--    Particles lost by coagulation with larger aerosols
4277       DO  ll = ib+1, end_subrange_2b
4278          zminusterm = zminusterm + zcc(ib,ll) * paero(ll)%numc
4279       ENDDO
4280!
4281!--    Coagulation gain in a bin: change in volume conc. (cm3/cm3):
4282       DO ll = start_subrange_1a, ib - 1
4283          zplusterm(1:2) = zplusterm(1:2) + zcc(ll,ib) * paero(ll)%volc(1:2)
4284          zplusterm(6:7) = zplusterm(6:7) + zcc(ll,ib) * paero(ll)%volc(6:7)
4285          zplusterm(8)   = zplusterm(8)   + zcc(ll,ib) * paero(ll)%volc(8)
4286       ENDDO
4287!
4288!--    Volume and number concentrations after coagulation update [fxm]
4289       paero(ib)%volc(1:2) = ( paero(ib)%volc(1:2) + ptstep * zplusterm(1:2) * paero(ib)%numc ) /  &
4290                            ( 1.0_wp + ptstep * zminusterm )
4291       paero(ib)%volc(6:8) = ( paero(ib)%volc(6:8) + ptstep * zplusterm(6:8) * paero(ib)%numc ) /  &
4292                            ( 1.0_wp + ptstep * zminusterm )
4293       paero(ib)%numc = paero(ib)%numc / ( 1.0_wp + ptstep * zminusterm + 0.5_wp * ptstep *        &
4294                        zcc(ib,ib) * paero(ib)%numc )
4295    ENDDO
4296!
4297!-- Aerosols in subrange 2a:
4298    DO  ib = start_subrange_2a, end_subrange_2a
4299       IF ( paero(ib)%numc < ( 2.0_wp * nclim ) )  CYCLE
4300       zminusterm   = 0.0_wp
4301       zplusterm(:) = 0.0_wp
4302!
4303!--    Find corresponding size bin in subrange 2b
4304       index_2b = ib - start_subrange_2a + start_subrange_2b
4305!
4306!--    Particles lost by larger particles in 2a
4307       DO  ll = ib+1, end_subrange_2a
4308          zminusterm = zminusterm + zcc(ib,ll) * paero(ll)%numc
4309       ENDDO
4310!
4311!--    Particles lost by larger particles in 2b
4312       IF ( .NOT. no_insoluble )  THEN
4313          DO  ll = index_2b+1, end_subrange_2b
4314             zminusterm = zminusterm + zcc(ib,ll) * paero(ll)%numc
4315          ENDDO
4316       ENDIF
4317!
4318!--    Particle volume gained from smaller particles in subranges 1, 2a and 2b
4319       DO  ll = start_subrange_1a, ib-1
4320          zplusterm(1:2) = zplusterm(1:2) + zcc(ll,ib) * paero(ll)%volc(1:2)
4321          zplusterm(6:8) = zplusterm(6:8) + zcc(ll,ib) * paero(ll)%volc(6:8)
4322       ENDDO
4323!
4324!--    Particle volume gained from smaller particles in 2a
4325!--    (Note, for components not included in the previous loop!)
4326       DO  ll = start_subrange_2a, ib-1
4327          zplusterm(3:5) = zplusterm(3:5) + zcc(ll,ib)*paero(ll)%volc(3:5)
4328       ENDDO
4329!
4330!--    Particle volume gained from smaller (and equal) particles in 2b
4331       IF ( .NOT. no_insoluble )  THEN
4332          DO  ll = start_subrange_2b, index_2b
4333             zplusterm(1:8) = zplusterm(1:8) + zcc(ll,ib) * paero(ll)%volc(1:8)
4334          ENDDO
4335       ENDIF
4336!
4337!--    Volume and number concentrations after coagulation update [fxm]
4338       paero(ib)%volc(1:8) = ( paero(ib)%volc(1:8) + ptstep * zplusterm(1:8) * paero(ib)%numc ) /  &
4339                            ( 1.0_wp + ptstep * zminusterm )
4340       paero(ib)%numc = paero(ib)%numc / ( 1.0_wp + ptstep * zminusterm + 0.5_wp * ptstep *        &
4341                        zcc(ib,ib) * paero(ib)%numc )
4342    ENDDO
4343!
4344!-- Aerosols in subrange 2b:
4345    IF ( .NOT. no_insoluble )  THEN
4346       DO  ib = start_subrange_2b, end_subrange_2b
4347          IF ( paero(ib)%numc < ( 2.0_wp * nclim ) )  CYCLE
4348          zminusterm   = 0.0_wp
4349          zplusterm(:) = 0.0_wp
4350!
4351!--       Find corresponding size bin in subsubrange 2a
4352          index_2a = ib - start_subrange_2b + start_subrange_2a
4353!
4354!--       Particles lost to larger particles in subranges 2b
4355          DO  ll = ib + 1, end_subrange_2b
4356             zminusterm = zminusterm + zcc(ib,ll) * paero(ll)%numc
4357          ENDDO
4358!
4359!--       Particles lost to larger and equal particles in 2a
4360          DO  ll = index_2a, end_subrange_2a
4361             zminusterm = zminusterm + zcc(ib,ll) * paero(ll)%numc
4362          ENDDO
4363!
4364!--       Particle volume gained from smaller particles in subranges 1 & 2a
4365          DO  ll = start_subrange_1a, index_2a - 1
4366             zplusterm(1:8) = zplusterm(1:8) + zcc(ll,ib) * paero(ll)%volc(1:8)
4367          ENDDO
4368!
4369!--       Particle volume gained from smaller particles in 2b
4370          DO  ll = start_subrange_2b, ib - 1
4371             zplusterm(1:8) = zplusterm(1:8) + zcc(ll,ib) * paero(ll)%volc(1:8)
4372          ENDDO
4373!
4374!--       Volume and number concentrations after coagulation update [fxm]
4375          paero(ib)%volc(1:8) = ( paero(ib)%volc(1:8) + ptstep * zplusterm(1:8) * paero(ib)%numc ) &
4376                                / ( 1.0_wp + ptstep * zminusterm )
4377          paero(ib)%numc = paero(ib)%numc / ( 1.0_wp + ptstep * zminusterm + 0.5_wp * ptstep *     &
4378                           zcc(ib,ib) * paero(ib)%numc )
4379       ENDDO
4380    ENDIF
4381
4382 END SUBROUTINE coagulation
4383
4384!------------------------------------------------------------------------------!
4385! Description:
4386! ------------
4387!> Calculation of coagulation coefficients. Extended version of the function
4388!> originally found in mo_salsa_init.
4389!
4390!> J. Tonttila, FMI, 05/2014
4391!------------------------------------------------------------------------------!
4392 REAL(wp) FUNCTION coagc( diam1, diam2, mass1, mass2, temp, pres )
4393
4394    IMPLICIT NONE
4395
4396    REAL(wp) ::  fmdist  !< distance of flux matching (m)
4397    REAL(wp) ::  knud_p  !< particle Knudsen number
4398    REAL(wp) ::  mdiam   !< mean diameter of colliding particles (m)
4399    REAL(wp) ::  mfp     !< mean free path of air molecules (m)
4400    REAL(wp) ::  visc    !< viscosity of air (kg/(m s))
4401
4402    REAL(wp), INTENT(in) ::  diam1  !< diameter of colliding particle 1 (m)
4403    REAL(wp), INTENT(in) ::  diam2  !< diameter of colliding particle 2 (m)
4404    REAL(wp), INTENT(in) ::  mass1  !< mass of colliding particle 1 (kg)
4405    REAL(wp), INTENT(in) ::  mass2  !< mass of colliding particle 2 (kg)
4406    REAL(wp), INTENT(in) ::  pres   !< ambient pressure (Pa?) [fxm]
4407    REAL(wp), INTENT(in) ::  temp   !< ambient temperature (K)
4408
4409    REAL(wp), DIMENSION (2) ::  beta    !< Cunningham correction factor
4410    REAL(wp), DIMENSION (2) ::  dfpart  !< particle diffusion coefficient (m2/s)
4411    REAL(wp), DIMENSION (2) ::  diam    !< diameters of particles (m)
4412    REAL(wp), DIMENSION (2) ::  flux    !< flux in continuum and free molec. regime (m/s)
4413    REAL(wp), DIMENSION (2) ::  knud    !< particle Knudsen number
4414    REAL(wp), DIMENSION (2) ::  mpart   !< masses of particles (kg)
4415    REAL(wp), DIMENSION (2) ::  mtvel   !< particle mean thermal velocity (m/s)
4416    REAL(wp), DIMENSION (2) ::  omega   !< particle mean free path
4417    REAL(wp), DIMENSION (2) ::  tva     !< temporary variable (m)
4418!
4419!-- Initialisation
4420    coagc   = 0.0_wp
4421!
4422!-- 1) Initializing particle and ambient air variables
4423    diam  = (/ diam1, diam2 /) !< particle diameters (m)
4424    mpart = (/ mass1, mass2 /) !< particle masses (kg)
4425!
4426!-- Viscosity of air (kg/(m s))
4427    visc = ( 7.44523E-3_wp * temp ** 1.5_wp ) / ( 5093.0_wp * ( temp + 110.4_wp ) )
4428!
4429!-- Mean free path of air (m)
4430    mfp = ( 1.656E-10_wp * temp + 1.828E-8_wp ) * ( p_0 + 1325.0_wp ) / pres
4431!
4432!-- 2) Slip correction factor for small particles
4433    knud = 2.0_wp * EXP( LOG(mfp) - LOG(diam) )! Knudsen number for air (15.23)
4434!
4435!-- Cunningham correction factor (Allen and Raabe, Aerosol Sci. Tech. 4, 269)
4436    beta = 1.0_wp + knud * ( 1.142_wp + 0.558_wp * EXP( -0.999_wp / knud ) )
4437!
4438!-- 3) Particle properties
4439!-- Diffusion coefficient (m2/s) (Jacobson (2005) eq. 15.29)
4440    dfpart = beta * abo * temp / ( 3.0_wp * pi * visc * diam )
4441!
4442!-- Mean thermal velocity (m/s) (Jacobson (2005) eq. 15.32)
4443    mtvel = SQRT( ( 8.0_wp * abo * temp ) / ( pi * mpart ) )
4444!
4445!-- Particle mean free path (m) (Jacobson (2005) eq. 15.34 )
4446    omega = 8.0_wp * dfpart / ( pi * mtvel )
4447!
4448!-- Mean diameter (m)
4449    mdiam = 0.5_wp * ( diam(1) + diam(2) )
4450!
4451!-- 4) Calculation of fluxes (Brownian collision kernels) and flux matching
4452!-- following Jacobson (2005):
4453!
4454!-- Flux in continuum regime (m3/s) (eq. 15.28)
4455    flux(1) = 4.0_wp * pi * mdiam * ( dfpart(1) + dfpart(2) )
4456!
4457!-- Flux in free molec. regime (m3/s) (eq. 15.31)
4458    flux(2) = pi * SQRT( ( mtvel(1)**2 ) + ( mtvel(2)**2 ) ) * ( mdiam**2 )
4459!
4460!-- temporary variables (m) to calculate flux matching distance (m)
4461    tva(1) = ( ( mdiam + omega(1) )**3 - ( mdiam**2 + omega(1)**2 ) * SQRT( ( mdiam**2 +           &
4462               omega(1)**2 ) ) ) / ( 3.0_wp * mdiam * omega(1) ) - mdiam
4463    tva(2) = ( ( mdiam + omega(2) )**3 - ( mdiam**2 + omega(2)**2 ) * SQRT( ( mdiam**2 +           &
4464               omega(2)**2 ) ) ) / ( 3.0_wp * mdiam * omega(2) ) - mdiam
4465!
4466!-- Flux matching distance (m): the mean distance from the centre of a sphere reached by particles
4467!-- that leave sphere's surface and travel a distance of particle mean free path (eq. 15.34)
4468    fmdist = SQRT( tva(1)**2 + tva(2)**2 )
4469!
4470!-- 5) Coagulation coefficient = coalescence efficiency * collision kernel (m3/s) (eq. 15.33).
4471!--    Here assumed coalescence efficiency 1!!
4472    coagc = flux(1) / ( mdiam / ( mdiam + fmdist) + flux(1) / flux(2) )
4473!
4474!-- Corrected collision kernel (Karl et al., 2016 (ACP)): Include van der Waals and viscous forces
4475    IF ( van_der_waals_coagc )  THEN
4476       knud_p = SQRT( omega(1)**2 + omega(2)**2 ) / mdiam
4477       IF ( knud_p >= 0.1_wp  .AND.  knud_p <= 10.0_wp )  THEN
4478          coagc = coagc * ( 2.0_wp + 0.4_wp * LOG( knud_p ) )
4479       ELSE
4480          coagc = coagc * 3.0_wp
4481       ENDIF
4482    ENDIF
4483
4484 END FUNCTION coagc
4485
4486!------------------------------------------------------------------------------!
4487! Description:
4488! ------------
4489!> Calculates the change in particle volume and gas phase
4490!> concentrations due to nucleation, condensation and dissolutional growth.
4491!
4492!> Sulphuric acid and organic vapour: only condensation and no evaporation.
4493!
4494!> New gas and aerosol phase concentrations calculated according to Jacobson
4495!> (1997): Numerical techniques to solve condensational and dissolutional growth
4496!> equations when growth is coupled to reversible reactions, Aerosol Sci. Tech.,
4497!> 27, pp 491-498.
4498!
4499!> Following parameterization has been used:
4500!> Molecular diffusion coefficient of condensing vapour (m2/s)
4501!> (Reid et al. (1987): Properties of gases and liquids, McGraw-Hill, New York.)
4502!> D = {1.d-7*sqrt(1/M_air + 1/M_gas)*T^1.75} / &
4503!      {p_atm/p_stand * (d_air^(1/3) + d_gas^(1/3))^2 }
4504!> M_air = 28.965 : molar mass of air (g/mol)
4505!> d_air = 19.70  : diffusion volume of air
4506!> M_h2so4 = 98.08 : molar mass of h2so4 (g/mol)
4507!> d_h2so4 = 51.96  : diffusion volume of h2so4
4508!
4509!> Called from main aerosol model
4510!> For equations, see Jacobson, Fundamentals of Atmospheric Modeling, 2nd Edition (2005)
4511!
4512!> Coded by:
4513!> Hannele Korhonen (FMI) 2005
4514!> Harri Kokkola (FMI) 2006
4515!> Juha Tonttila (FMI) 2014
4516!> Rewritten to PALM by Mona Kurppa (UHel) 2017
4517!------------------------------------------------------------------------------!
4518 SUBROUTINE condensation( paero, pc_sa, pc_ocnv, pcocsv, pchno3, pc_nh3, pcw, pcs, ptemp, ppres,   &
4519                          ptstep, prtcl )
4520
4521    IMPLICIT NONE
4522
4523    INTEGER(iwp) ::  ss      !< start index
4524    INTEGER(iwp) ::  ee      !< end index
4525
4526    REAL(wp) ::  zcs_ocnv    !< condensation sink of nonvolatile organics (1/s)
4527    REAL(wp) ::  zcs_ocsv    !< condensation sink of semivolatile organics (1/s)
4528    REAL(wp) ::  zcs_su      !< condensation sink of sulfate (1/s)
4529    REAL(wp) ::  zcs_tot     !< total condensation sink (1/s) (gases)
4530    REAL(wp) ::  zcvap_new1  !< vapour concentration after time step (#/m3): sulphuric acid
4531    REAL(wp) ::  zcvap_new2  !< nonvolatile organics
4532    REAL(wp) ::  zcvap_new3  !< semivolatile organics
4533    REAL(wp) ::  zdfvap      !< air diffusion coefficient (m2/s)
4534    REAL(wp) ::  zdvap1      !< change in vapour concentration (#/m3): sulphuric acid
4535    REAL(wp) ::  zdvap2      !< nonvolatile organics
4536    REAL(wp) ::  zdvap3      !< semivolatile organics
4537    REAL(wp) ::  zmfp        !< mean free path of condensing vapour (m)
4538    REAL(wp) ::  zrh         !< Relative humidity [0-1]
4539    REAL(wp) ::  zvisc       !< viscosity of air (kg/(m s))
4540    REAL(wp) ::  zn_vs_c     !< ratio of nucleation of all mass transfer in the smallest bin
4541    REAL(wp) ::  zxocnv      !< ratio of organic vapour in 3nm particles
4542    REAL(wp) ::  zxsa        !< Ratio in 3nm particles: sulphuric acid
4543
4544    REAL(wp), INTENT(in) ::  ppres   !< ambient pressure (Pa)
4545    REAL(wp), INTENT(in) ::  pcs     !< Water vapour saturation concentration (kg/m3)
4546    REAL(wp), INTENT(in) ::  ptemp   !< ambient temperature (K)
4547    REAL(wp), INTENT(in) ::  ptstep  !< timestep (s)
4548
4549    REAL(wp), INTENT(inout) ::  pchno3   !< Gas concentrations (#/m3): nitric acid HNO3
4550    REAL(wp), INTENT(inout) ::  pc_nh3   !< ammonia NH3
4551    REAL(wp), INTENT(inout) ::  pc_ocnv  !< non-volatile organics
4552    REAL(wp), INTENT(inout) ::  pcocsv   !< semi-volatile organics
4553    REAL(wp), INTENT(inout) ::  pc_sa    !< sulphuric acid H2SO4
4554    REAL(wp), INTENT(inout) ::  pcw      !< Water vapor concentration (kg/m3)
4555
4556    REAL(wp), DIMENSION(nbins_aerosol)       ::  zbeta          !< transitional correction factor
4557    REAL(wp), DIMENSION(nbins_aerosol)       ::  zcolrate       !< collision rate (1/s)
4558    REAL(wp), DIMENSION(nbins_aerosol)       ::  zcolrate_ocnv  !< collision rate of OCNV (1/s)
4559    REAL(wp), DIMENSION(start_subrange_1a+1) ::  zdfpart        !< particle diffusion coef. (m2/s)
4560    REAL(wp), DIMENSION(nbins_aerosol)       ::  zdvoloc        !< change of organics volume
4561    REAL(wp), DIMENSION(nbins_aerosol)       ::  zdvolsa        !< change of sulphate volume
4562    REAL(wp), DIMENSION(2)                   ::  zj3n3          !< Formation massrate of molecules
4563                                                                !< in nucleation, (molec/m3s),
4564                                                                !< 1: H2SO4 and 2: organic vapor
4565    REAL(wp), DIMENSION(nbins_aerosol)       ::  zknud          !< particle Knudsen number
4566
4567    TYPE(component_index), INTENT(in) :: prtcl  !< Keeps track which substances are used
4568
4569    TYPE(t_section), DIMENSION(nbins_aerosol), INTENT(inout) ::  paero  !< Aerosol properties
4570
4571    zj3n3  = 0.0_wp
4572    zrh    = pcw / pcs
4573    zxocnv = 0.0_wp
4574    zxsa   = 0.0_wp
4575!
4576!-- Nucleation
4577    IF ( nsnucl > 0 )  THEN
4578       CALL nucleation( paero, ptemp, zrh, ppres, pc_sa, pc_ocnv, pc_nh3, ptstep, zj3n3, zxsa,     &
4579                        zxocnv )
4580    ENDIF
4581!
4582!-- Condensation on pre-existing particles
4583    IF ( lscndgas )  THEN
4584!
4585!--    Initialise:
4586       zdvolsa = 0.0_wp
4587       zdvoloc = 0.0_wp
4588       zcolrate = 0.0_wp
4589!
4590!--    1) Properties of air and condensing gases:
4591!--    Viscosity of air (kg/(m s)) (Eq. 4.54 in Jabonson (2005))
4592       zvisc = ( 7.44523E-3_wp * ptemp ** 1.5_wp ) / ( 5093.0_wp * ( ptemp + 110.4_wp ) )
4593!
4594!--    Diffusion coefficient of air (m2/s)
4595       zdfvap = 5.1111E-10_wp * ptemp ** 1.75_wp * ( p_0 + 1325.0_wp ) / ppres
4596!
4597!--    Mean free path (m): same for H2SO4 and organic compounds
4598       zmfp = 3.0_wp * zdfvap * SQRT( pi * amh2so4 / ( 8.0_wp * argas * ptemp ) )
4599!
4600!--    2) Transition regime correction factor zbeta for particles (Fuchs and Sutugin (1971)):
4601!--       Size of condensing molecule considered only for nucleation mode (3 - 20 nm).
4602!
4603!--    Particle Knudsen number: condensation of gases on aerosols
4604       ss = start_subrange_1a
4605       ee = start_subrange_1a+1
4606       zknud(ss:ee) = 2.0_wp * zmfp / ( paero(ss:ee)%dwet + d_sa )
4607       ss = start_subrange_1a+2
4608       ee = end_subrange_2b
4609       zknud(ss:ee) = 2.0_wp * zmfp / paero(ss:ee)%dwet
4610!
4611!--    Transitional correction factor: aerosol + gas (the semi-empirical Fuchs- Sutugin
4612!--    interpolation function (Fuchs and Sutugin, 1971))
4613       zbeta = ( zknud + 1.0_wp ) / ( 0.377_wp * zknud + 1.0_wp + 4.0_wp / ( 3.0_wp * massacc ) *  &
4614               ( zknud + zknud ** 2 ) )
4615!
4616!--    3) Collision rate of molecules to particles
4617!--       Particle diffusion coefficient considered only for nucleation mode (3 - 20 nm)
4618!
4619!--    Particle diffusion coefficient (m2/s) (e.g. Eq. 15.29 in Jacobson (2005))
4620       zdfpart = abo * ptemp * zbeta(start_subrange_1a:start_subrange_1a+1) / ( 3.0_wp * pi * zvisc&
4621                 * paero(start_subrange_1a:start_subrange_1a+1)%dwet)
4622!
4623!--    Collision rate (mass-transfer coefficient): gases on aerosols (1/s) (Eq. 16.64 in
4624!--    Jacobson (2005))
4625       ss = start_subrange_1a
4626       ee = start_subrange_1a+1
4627       zcolrate(ss:ee) = MERGE( 2.0_wp * pi * ( paero(ss:ee)%dwet + d_sa ) * ( zdfvap + zdfpart ) *&
4628                               zbeta(ss:ee) * paero(ss:ee)%numc, 0.0_wp, paero(ss:ee)%numc > nclim )
4629       ss = start_subrange_1a+2
4630       ee = end_subrange_2b
4631       zcolrate(ss:ee) = MERGE( 2.0_wp * pi * paero(ss:ee)%dwet * zdfvap * zbeta(ss:ee) *          &
4632                                paero(ss:ee)%numc, 0.0_wp, paero(ss:ee)%numc > nclim )
4633!
4634!-- 4) Condensation sink (1/s)
4635       zcs_tot = SUM( zcolrate )   ! total sink
4636!
4637!--    5) Changes in gas-phase concentrations and particle volume
4638!
4639!--    5.1) Organic vapours
4640!
4641!--    5.1.1) Non-volatile organic compound: condenses onto all bins
4642       IF ( pc_ocnv > 1.0E+10_wp  .AND.  zcs_tot > 1.0E-30_wp  .AND. index_oc > 0 )  &
4643       THEN
4644!--       Ratio of nucleation vs. condensation rates in the smallest bin
4645          zn_vs_c = 0.0_wp
4646          IF ( zj3n3(2) > 1.0_wp )  THEN
4647             zn_vs_c = ( zj3n3(2) ) / ( zj3n3(2) + pc_ocnv * zcolrate(start_subrange_1a) )
4648          ENDIF
4649!
4650!--       Collision rate in the smallest bin, including nucleation and condensation (see
4651!--       Jacobson (2005), eq. (16.73) )
4652          zcolrate_ocnv = zcolrate
4653          zcolrate_ocnv(start_subrange_1a) = zcolrate_ocnv(start_subrange_1a) + zj3n3(2) / pc_ocnv
4654!
4655!--       Total sink for organic vapor
4656          zcs_ocnv = zcs_tot + zj3n3(2) / pc_ocnv
4657!
4658!--       New gas phase concentration (#/m3)
4659          zcvap_new2 = pc_ocnv / ( 1.0_wp + ptstep * zcs_ocnv )
4660!
4661!--       Change in gas concentration (#/m3)
4662          zdvap2 = pc_ocnv - zcvap_new2
4663!
4664!--       Updated vapour concentration (#/m3)
4665          pc_ocnv = zcvap_new2
4666!
4667!--       Volume change of particles (m3(OC)/m3(air))
4668          zdvoloc = zcolrate_ocnv(start_subrange_1a:end_subrange_2b) / zcs_ocnv * amvoc * zdvap2
4669!
4670!--       Change of volume due to condensation in 1a-2b
4671          paero(start_subrange_1a:end_subrange_2b)%volc(2) =                                       &
4672                                          paero(start_subrange_1a:end_subrange_2b)%volc(2) + zdvoloc
4673!
4674!--       Change of number concentration in the smallest bin caused by nucleation (Jacobson (2005),
4675!--       eq. (16.75)). If zxocnv = 0, then the chosen nucleation mechanism doesn't take into
4676!--       account the non-volatile organic vapors and thus the paero doesn't have to be updated.
4677          IF ( zxocnv > 0.0_wp )  THEN
4678             paero(start_subrange_1a)%numc = paero(start_subrange_1a)%numc + zn_vs_c *             &
4679                                             zdvoloc(start_subrange_1a) / amvoc / ( n3 * zxocnv )
4680          ENDIF
4681       ENDIF
4682!
4683!--    5.1.2) Semivolatile organic compound: all bins except subrange 1
4684       zcs_ocsv = SUM( zcolrate(start_subrange_2a:end_subrange_2b) ) !< sink for semi-volatile org.
4685       IF ( pcocsv > 1.0E+10_wp  .AND.  zcs_ocsv > 1.0E-30  .AND. is_used( prtcl,'OC') )  THEN
4686!
4687!--       New gas phase concentration (#/m3)
4688          zcvap_new3 = pcocsv / ( 1.0_wp + ptstep * zcs_ocsv )
4689!
4690!--       Change in gas concentration (#/m3)
4691          zdvap3 = pcocsv - zcvap_new3 
4692!
4693!--       Updated gas concentration (#/m3)
4694          pcocsv = zcvap_new3
4695!
4696!--       Volume change of particles (m3(OC)/m3(air))
4697          ss = start_subrange_2a
4698          ee = end_subrange_2b
4699          zdvoloc(ss:ee) = zdvoloc(ss:ee) + zcolrate(ss:ee) / zcs_ocsv * amvoc * zdvap3
4700!
4701!--       Change of volume due to condensation in 1a-2b
4702          paero(start_subrange_1a:end_subrange_2b)%volc(2) =                                       &
4703                                          paero(start_subrange_1a:end_subrange_2b)%volc(2) + zdvoloc
4704       ENDIF
4705!
4706!--    5.2) Sulphate: condensed on all bins
4707       IF ( pc_sa > 1.0E+10_wp  .AND.  zcs_tot > 1.0E-30_wp  .AND.  index_so4 > 0 )  THEN
4708!
4709!--    Ratio of mass transfer between nucleation and condensation
4710          zn_vs_c = 0.0_wp
4711          IF ( zj3n3(1) > 1.0_wp )  THEN
4712             zn_vs_c = ( zj3n3(1) ) / ( zj3n3(1) + pc_sa * zcolrate(start_subrange_1a) )
4713          ENDIF
4714!
4715!--       Collision rate in the smallest bin, including nucleation and condensation (see
4716!--       Jacobson (2005), eq. (16.73))
4717          zcolrate(start_subrange_1a) = zcolrate(start_subrange_1a) + zj3n3(1) / pc_sa
4718!
4719!--       Total sink for sulfate (1/s)
4720          zcs_su = zcs_tot + zj3n3(1) / pc_sa
4721!
4722!--       Sulphuric acid:
4723!--       New gas phase concentration (#/m3)
4724          zcvap_new1 = pc_sa / ( 1.0_wp + ptstep * zcs_su )
4725!
4726!--       Change in gas concentration (#/m3)
4727          zdvap1 = pc_sa - zcvap_new1
4728!
4729!--       Updating vapour concentration (#/m3)
4730          pc_sa = zcvap_new1
4731!
4732!--       Volume change of particles (m3(SO4)/m3(air)) by condensation
4733          zdvolsa = zcolrate(start_subrange_1a:end_subrange_2b) / zcs_su * amvh2so4 * zdvap1
4734!
4735!--       Change of volume concentration of sulphate in aerosol [fxm]
4736          paero(start_subrange_1a:end_subrange_2b)%volc(1) =                                       &
4737                                          paero(start_subrange_1a:end_subrange_2b)%volc(1) + zdvolsa
4738!
4739!--       Change of number concentration in the smallest bin caused by nucleation
4740!--       (Jacobson (2005), equation (16.75))
4741          IF ( zxsa > 0.0_wp )  THEN
4742             paero(start_subrange_1a)%numc = paero(start_subrange_1a)%numc + zn_vs_c *             &
4743                                             zdvolsa(start_subrange_1a) / amvh2so4 / ( n3 * zxsa)
4744          ENDIF
4745       ENDIF
4746!
4747!--    Partitioning of H2O, HNO3, and NH3: Dissolutional growth
4748       IF ( lspartition  .AND.  ( pchno3 > 1.0E+10_wp  .OR.  pc_nh3 > 1.0E+10_wp ) )  THEN
4749          CALL gpparthno3( ppres, ptemp, paero, pchno3, pc_nh3, pcw, pcs, zbeta, ptstep )
4750       ENDIF
4751    ENDIF
4752!
4753!-- Condensation of water vapour
4754    IF ( lscndh2oae )  THEN
4755       CALL gpparth2o( paero, ptemp, ppres, pcs, pcw, ptstep )
4756    ENDIF
4757
4758 END SUBROUTINE condensation
4759
4760!------------------------------------------------------------------------------!
4761! Description:
4762! ------------
4763!> Calculates the particle number and volume increase, and gas-phase
4764!> concentration decrease due to nucleation subsequent growth to detectable size
4765!> of 3 nm.
4766!
4767!> Method:
4768!> When the formed clusters grow by condensation (possibly also by self-
4769!> coagulation), their number is reduced due to scavenging to pre-existing
4770!> particles. Thus, the apparent nucleation rate at 3 nm is significantly lower
4771!> than the real nucleation rate (at ~1 nm).
4772!
4773!> Calculation of the formation rate of detectable particles at 3 nm (i.e. J3):
4774!> nj3 = 1: Kerminen, V.-M. and Kulmala, M. (2002), J. Aerosol Sci.,33, 609-622.
4775!> nj3 = 2: Lehtinen et al. (2007), J. Aerosol Sci., 38(9), 988-994.
4776!> nj3 = 3: Anttila et al. (2010), J. Aerosol Sci., 41(7), 621-636.
4777!
4778!> c = aerosol of critical radius (1 nm)
4779!> x = aerosol with radius 3 nm
4780!> 2 = wet or mean droplet
4781!
4782!> Called from subroutine condensation (in module salsa_dynamics_mod.f90)
4783!
4784!> Calls one of the following subroutines:
4785!>  - binnucl
4786!>  - ternucl
4787!>  - kinnucl
4788!>  - actnucl
4789!
4790!> fxm: currently only sulphuric acid grows particles from 1 to 3 nm
4791!>  (if asked from Markku, this is terribly wrong!!!)
4792!
4793!> Coded by:
4794!> Hannele Korhonen (FMI) 2005
4795!> Harri Kokkola (FMI) 2006
4796!> Matti Niskanen(FMI) 2012
4797!> Anton Laakso  (FMI) 2013
4798!------------------------------------------------------------------------------!
4799
4800 SUBROUTINE nucleation( paero, ptemp, prh, ppres, pc_sa, pc_ocnv, pc_nh3, ptstep, pj3n3, pxsa,     &
4801                        pxocnv )
4802
4803    IMPLICIT NONE
4804
4805    INTEGER(iwp) ::  iteration
4806
4807    REAL(wp) ::  zc_h2so4     !< H2SO4 conc. (#/cm3) !UNITS!
4808    REAL(wp) ::  zc_org       !< organic vapour conc. (#/cm3)
4809    REAL(wp) ::  zcc_c        !< Cunningham correct factor for c = critical (1nm)
4810    REAL(wp) ::  zcc_x        !< Cunningham correct factor for x = 3nm
4811    REAL(wp) ::  zcoags_c     !< coagulation sink (1/s) for c = critical (1nm)
4812    REAL(wp) ::  zcoags_x     !< coagulation sink (1/s) for x = 3nm
4813    REAL(wp) ::  zcoagstot    !< total particle losses due to coagulation, including condensation
4814                              !< and self-coagulation
4815    REAL(wp) ::  zcocnv_local !< organic vapour conc. (#/m3)
4816    REAL(wp) ::  zcsink       !< condensational sink (#/m2)
4817    REAL(wp) ::  zcsa_local   !< H2SO4 conc. (#/m3)
4818    REAL(wp) ::  zcv_c        !< mean relative thermal velocity (m/s) for c = critical (1nm)
4819    REAL(wp) ::  zcv_x        !< mean relative thermal velocity (m/s) for x = 3nm
4820    REAL(wp) ::  zdcrit       !< diameter of critical cluster (m)
4821    REAL(wp) ::  zdelta_vap   !< change of H2SO4 and organic vapour concentration (#/m3)
4822    REAL(wp) ::  zdfvap       !< air diffusion coefficient (m2/s)
4823    REAL(wp) ::  zdmean       !< mean diameter of existing particles (m)
4824    REAL(wp) ::  zeta         !< constant: proportional to ratio of CS/GR (m)
4825                              !< (condensation sink / growth rate)
4826    REAL(wp) ::  zgamma       !< proportionality factor ((nm2*m2)/h)
4827    REAL(wp) ::  z_gr_clust   !< growth rate of formed clusters (nm/h)
4828    REAL(wp) ::  z_gr_tot     !< total growth rate
4829    REAL(wp) ::  zj3          !< number conc. of formed 3nm particles (#/m3)
4830    REAL(wp) ::  zjnuc        !< nucleation rate at ~1nm (#/m3s)
4831    REAL(wp) ::  z_k_eff      !< effective cogulation coefficient for freshly nucleated particles
4832    REAL(wp) ::  zknud_c      !< Knudsen number for c = critical (1nm)
4833    REAL(wp) ::  zknud_x      !< Knudsen number for x = 3nm
4834    REAL(wp) ::  zkocnv       !< lever: zkocnv=1 --> organic compounds involved in nucleation
4835    REAL(wp) ::  zksa         !< lever: zksa=1 --> H2SO4 involved in nucleation
4836    REAL(wp) ::  zlambda      !< parameter for adjusting the growth rate due to self-coagulation
4837    REAL(wp) ::  zm_c         !< particle mass (kg) for c = critical (1nm)
4838    REAL(wp) ::  zm_para      !< Parameter m for calculating the coagulation sink (Eq. 5&6 in
4839                              !< Lehtinen et al. 2007)
4840    REAL(wp) ::  zm_x         !< particle mass (kg) for x = 3nm
4841    REAL(wp) ::  zmfp         !< mean free path of condesing vapour(m)
4842    REAL(wp) ::  zmixnh3      !< ammonia mixing ratio (ppt)
4843    REAL(wp) ::  zmyy         !< gas dynamic viscosity (N*s/m2)
4844    REAL(wp) ::  z_n_nuc      !< number of clusters/particles at the size range d1-dx (#/m3)
4845    REAL(wp) ::  znoc         !< number of organic molecules in critical cluster
4846    REAL(wp) ::  znsa         !< number of H2SO4 molecules in critical cluster
4847
4848    REAL(wp), INTENT(in) ::  pc_nh3   !< ammonia concentration (#/m3)
4849    REAL(wp), INTENT(in) ::  pc_ocnv  !< conc. of non-volatile OC (#/m3)
4850    REAL(wp), INTENT(in) ::  pc_sa    !< sulphuric acid conc. (#/m3)
4851    REAL(wp), INTENT(in) ::  ppres    !< ambient air pressure (Pa)
4852    REAL(wp), INTENT(in) ::  prh      !< ambient rel. humidity [0-1]
4853    REAL(wp), INTENT(in) ::  ptemp    !< ambient temperature (K)
4854    REAL(wp), INTENT(in) ::  ptstep   !< time step (s) of SALSA
4855
4856    REAL(wp), INTENT(inout) ::  pj3n3(2) !< formation mass rate of molecules (molec/m3s) for
4857                                         !< 1: H2SO4 and 2: organic vapour
4858
4859    REAL(wp), INTENT(out) ::  pxocnv  !< ratio of non-volatile organic vapours in 3 nm particles
4860    REAL(wp), INTENT(out) ::  pxsa    !< ratio of H2SO4 in 3 nm aerosol particles
4861
4862    REAL(wp), DIMENSION(nbins_aerosol) ::  zbeta       !< transitional correction factor
4863    REAL(wp), DIMENSION(nbins_aerosol) ::  zcc_2       !< Cunningham correct factor:2
4864    REAL(wp), DIMENSION(nbins_aerosol) ::  zcv_2       !< mean relative thermal velocity (m/s): 2
4865    REAL(wp), DIMENSION(nbins_aerosol) ::  zcv_c2      !< average velocity after coagulation: c & 2
4866    REAL(wp), DIMENSION(nbins_aerosol) ::  zcv_x2      !< average velocity after coagulation: x & 2
4867    REAL(wp), DIMENSION(nbins_aerosol) ::  zdc_2       !< particle diffusion coefficient (m2/s): 2
4868    REAL(wp), DIMENSION(nbins_aerosol) ::  zdc_c       !< particle diffusion coefficient (m2/s): c
4869    REAL(wp), DIMENSION(nbins_aerosol) ::  zdc_c2      !< sum of diffusion coef. for c and 2
4870    REAL(wp), DIMENSION(nbins_aerosol) ::  zdc_x       !< particle diffusion coefficient (m2/s): x
4871    REAL(wp), DIMENSION(nbins_aerosol) ::  zdc_x2      !< sum of diffusion coef. for: x & 2
4872    REAL(wp), DIMENSION(nbins_aerosol) ::  zgamma_f_2  !< zgamma_f for calculating zomega
4873    REAL(wp), DIMENSION(nbins_aerosol) ::  zgamma_f_c  !< zgamma_f for calculating zomega
4874    REAL(wp), DIMENSION(nbins_aerosol) ::  zgamma_f_x  !< zgamma_f for calculating zomega
4875    REAL(wp), DIMENSION(nbins_aerosol) ::  z_k_c2      !< coagulation coef. in the continuum
4876                                                       !< regime: c & 2
4877    REAL(wp), DIMENSION(nbins_aerosol) ::  z_k_x2      !< coagulation coef. in the continuum
4878                                                       !< regime: x & 2
4879    REAL(wp), DIMENSION(nbins_aerosol) ::  zknud       !< particle Knudsen number
4880    REAL(wp), DIMENSION(nbins_aerosol) ::  zknud_2     !< particle Knudsen number: 2
4881    REAL(wp), DIMENSION(nbins_aerosol) ::  zm_2        !< particle mass (kg): 2
4882    REAL(wp), DIMENSION(nbins_aerosol) ::  zomega_2c   !< zomega (m) for calculating zsigma: c & 2
4883    REAL(wp), DIMENSION(nbins_aerosol) ::  zomega_2x   !< zomega (m) for calculating zsigma: x & 2
4884    REAL(wp), DIMENSION(nbins_aerosol) ::  zomega_c    !< zomega (m) for calculating zsigma: c
4885    REAL(wp), DIMENSION(nbins_aerosol) ::  zomega_x    !< zomega (m) for calculating zsigma: x
4886    REAL(wp), DIMENSION(nbins_aerosol) ::  z_r_c2      !< sum of the radii: c & 2
4887    REAL(wp), DIMENSION(nbins_aerosol) ::  z_r_x2      !< sum of the radii: x & 2
4888    REAL(wp), DIMENSION(nbins_aerosol) ::  zsigma_c2   !<
4889    REAL(wp), DIMENSION(nbins_aerosol) ::  zsigma_x2   !<
4890
4891    TYPE(t_section), DIMENSION(nbins_aerosol), INTENT(inout) ::  paero  !< aerosol properties
4892!
4893!-- 1) Nucleation rate (zjnuc) and diameter of critical cluster (zdcrit)
4894    zjnuc  = 0.0_wp
4895    znsa   = 0.0_wp
4896    znoc   = 0.0_wp
4897    zdcrit = 0.0_wp
4898    zksa   = 0.0_wp
4899    zkocnv = 0.0_wp
4900
4901    zc_h2so4 = pc_sa * 1.0E-6_wp   ! sulphuric acid conc. to #/cm3
4902    zc_org   = pc_ocnv * 1.0E-6_wp   ! conc. of non-volatile OC to #/cm3
4903    zmixnh3  = pc_nh3 * ptemp * argas / ( ppres * avo )
4904
4905    SELECT CASE ( nsnucl )
4906!
4907!--    Binary H2SO4-H2O nucleation
4908       CASE(1)
4909
4910          CALL binnucl( zc_h2so4, ptemp, prh, zjnuc, znsa, znoc, zdcrit,  zksa, zkocnv )
4911!
4912!--    Activation type nucleation (See Riipinen et al. (2007), Atmos. Chem. Phys., 7(8), 1899-1914)
4913       CASE(2)
4914!
4915!--       Nucleation rate (#/(m3 s))
4916          zc_h2so4  = MAX( zc_h2so4, 1.0E4_wp  )
4917          zc_h2so4  = MIN( zc_h2so4, 1.0E11_wp )
4918          zjnuc = act_coeff * pc_sa  ! (#/(m3 s))
4919!
4920!--       Organic compounds not involved when kinetic nucleation is assumed.
4921          zdcrit  = 7.9375E-10_wp   ! (m)
4922          zkocnv  = 0.0_wp
4923          zksa    = 1.0_wp
4924          znoc    = 0.0_wp
4925          znsa    = 2.0_wp
4926!
4927!--    Kinetically limited nucleation of (NH4)HSO4 clusters
4928!--    (See Sihto et al. (2006), Atmos. Chem. Phys., 6(12), 4079-4091.)
4929       CASE(3)
4930!
4931!--       Nucleation rate = coagcoeff*zpcsa**2 (#/(m3 s))
4932          zc_h2so4  = MAX( zc_h2so4, 1.0E4_wp  )
4933          zc_h2so4  = MIN( zc_h2so4, 1.0E11_wp )
4934          zjnuc = 5.0E-13_wp * zc_h2so4**2.0_wp * 1.0E+6_wp
4935!
4936!--       Organic compounds not involved when kinetic nucleation is assumed.
4937          zdcrit  = 7.9375E-10_wp   ! (m)
4938          zkocnv  = 0.0_wp
4939          zksa    = 1.0_wp
4940          znoc    = 0.0_wp
4941          znsa    = 2.0_wp
4942!
4943!--    Ternary H2SO4-H2O-NH3 nucleation
4944       CASE(4)
4945
4946          CALL ternucl( zc_h2so4, zmixnh3, ptemp, prh, zjnuc, znsa, znoc, zdcrit, zksa, zkocnv )
4947!
4948!--    Organic nucleation, J~[ORG] or J~[ORG]**2
4949!--    (See Paasonen et al. (2010), Atmos. Chem. Phys., 10, 11223-11242.)
4950       CASE(5)
4951!
4952!--       Homomolecular nuleation rate
4953          zjnuc = 1.3E-7_wp * pc_ocnv   ! (1/s) (Paasonen et al. Table 4: median a_org)
4954!
4955!--       H2SO4 not involved when pure organic nucleation is assumed.
4956          zdcrit  = 1.5E-9  ! (m)
4957          zkocnv  = 1.0_wp
4958          zksa    = 0.0_wp
4959          znoc    = 1.0_wp
4960          znsa    = 0.0_wp
4961!
4962!--    Sum of H2SO4 and organic activation type nucleation, J~[H2SO4]+[ORG]
4963!--    (See Paasonen et al. (2010), Atmos. Chem. Phys., 10, 11223-11242)
4964       CASE(6)
4965!
4966!--       Nucleation rate  (#/m3/s)
4967          zjnuc = 6.1E-7_wp * pc_sa + 0.39E-7_wp * pc_ocnv   ! (Paasonen et al. Table 3.)
4968!
4969!--       Both organic compounds and H2SO4 are involved when sumnucleation is assumed.
4970          zdcrit  = 1.5E-9_wp   ! (m)
4971          zkocnv  = 1.0_wp
4972          zksa    = 1.0_wp
4973          znoc    = 1.0_wp
4974          znsa    = 1.0_wp
4975!
4976!--    Heteromolecular nucleation, J~[H2SO4]*[ORG]
4977!--    (See Paasonen et al. (2010), Atmos. Chem. Phys., 10, 11223-11242.)
4978       CASE(7)
4979!
4980!--       Nucleation rate (#/m3/s)
4981          zjnuc = 4.1E-14_wp * pc_sa * pc_ocnv * 1.0E6_wp   ! (Paasonen et al. Table 4: median)
4982!
4983!--       Both organic compounds and H2SO4 are involved when heteromolecular nucleation is assumed
4984          zdcrit  = 1.5E-9_wp   ! (m)
4985          zkocnv  = 1.0_wp
4986          zksa    = 1.0_wp
4987          znoc    = 1.0_wp
4988          znsa    = 1.0_wp
4989!
4990!--    Homomolecular nucleation of H2SO4 and heteromolecular nucleation of H2SO4 and organic vapour,
4991!--    J~[H2SO4]**2 + [H2SO4]*[ORG] (EUCAARI project)
4992!--    (See Paasonen et al. (2010), Atmos. Chem. Phys., 10, 11223-11242)
4993       CASE(8)
4994!
4995!--       Nucleation rate (#/m3/s)
4996          zjnuc = ( 1.1E-14_wp * zc_h2so4**2 + 3.2E-14_wp * zc_h2so4 * zc_org ) * 1.0E+6_wp
4997!
4998!--       Both organic compounds and H2SO4 are involved when SAnucleation is assumed
4999          zdcrit  = 1.5E-9_wp   ! (m)
5000          zkocnv  = 1.0_wp
5001          zksa    = 1.0_wp
5002          znoc    = 1.0_wp
5003          znsa    = 3.0_wp
5004!
5005!--    Homomolecular nucleation of H2SO4 and organic vapour and heteromolecular nucleation of H2SO4
5006!--    and organic vapour, J~[H2SO4]**2 + [H2SO4]*[ORG]+[ORG]**2 (EUCAARI project)
5007       CASE(9)
5008!
5009!--       Nucleation rate (#/m3/s)
5010          zjnuc = ( 1.4E-14_wp * zc_h2so4**2 + 2.6E-14_wp * zc_h2so4 * zc_org + 0.037E-14_wp *     &
5011                    zc_org**2 ) * 1.0E+6_wp
5012!
5013!--       Both organic compounds and H2SO4 are involved when SAORGnucleation is assumed
5014          zdcrit  = 1.5E-9_wp   ! (m)
5015          zkocnv  = 1.0_wp
5016          zksa    = 1.0_wp
5017          znoc    = 3.0_wp
5018          znsa    = 3.0_wp
5019
5020    END SELECT
5021
5022    zcsa_local = pc_sa
5023    zcocnv_local = pc_ocnv
5024!
5025!-- 2) Change of particle and gas concentrations due to nucleation
5026!
5027!-- 2.1) Check that there is enough H2SO4 and organic vapour to produce the nucleation
5028    IF ( nsnucl <= 4 )  THEN 
5029!
5030!--    If the chosen nucleation scheme is 1-4, nucleation occurs only due to H2SO4. All of the total
5031!--    vapour concentration that is taking part to the nucleation is there for sulphuric acid
5032!--    (sa = H2SO4) and non-volatile organic vapour is zero.
5033       pxsa   = 1.0_wp   ! ratio of sulphuric acid in 3nm particles
5034       pxocnv = 0.0_wp   ! ratio of non-volatile origanic vapour
5035                                ! in 3nm particles
5036    ELSEIF ( nsnucl > 4 )  THEN
5037!
5038!--    If the chosen nucleation scheme is 5-9, nucleation occurs due to organic vapour or the
5039!--    combination of organic vapour and H2SO4. The number of needed molecules depends on the chosen
5040!--    nucleation type and it has an effect also on the minimum ratio of the molecules present.
5041       IF ( pc_sa * znsa + pc_ocnv * znoc < 1.E-14_wp )  THEN
5042          pxsa   = 0.0_wp
5043          pxocnv = 0.0_wp
5044       ELSE
5045          pxsa   = pc_sa * znsa / ( pc_sa * znsa + pc_ocnv * znoc ) 
5046          pxocnv = pc_ocnv * znoc / ( pc_sa * znsa + pc_ocnv * znoc )
5047       ENDIF
5048    ENDIF
5049!
5050!-- The change in total vapour concentration is the sum of the concentrations of the vapours taking
5051!-- part to the nucleation (depends on the chosen nucleation scheme)
5052    zdelta_vap = MIN( zjnuc * ( znoc + znsa ), ( pc_ocnv * zkocnv + pc_sa * zksa ) / ptstep )
5053!
5054!-- Nucleation rate J at ~1nm (#/m3s)
5055    zjnuc = zdelta_vap / ( znoc + znsa )
5056!
5057!-- H2SO4 concentration after nucleation (#/m3)
5058    zcsa_local = MAX( 1.0_wp, pc_sa - zdelta_vap * pxsa )
5059!
5060!-- Non-volative organic vapour concentration after nucleation (#/m3)
5061    zcocnv_local = MAX( 1.0_wp, pc_ocnv - zdelta_vap * pxocnv )
5062!
5063!-- 2.2) Formation rate of 3 nm particles (Kerminen & Kulmala, 2002)
5064!
5065!-- Growth rate by H2SO4 and organic vapour (nm/h, Eq. 21)
5066    z_gr_clust = 2.3623E-15_wp * SQRT( ptemp ) * ( zcsa_local + zcocnv_local )
5067!
5068!-- 2.2.2) Condensational sink of pre-existing particle population
5069!
5070!-- Diffusion coefficient (m2/s)
5071    zdfvap = 5.1111E-10_wp * ptemp**1.75_wp * ( p_0 + 1325.0_wp ) / ppres
5072!
5073!-- Mean free path of condensing vapour (m) (Jacobson (2005), Eq. 15.25 and 16.29)
5074    zmfp = 3.0_wp * zdfvap * SQRT( pi * amh2so4 / ( 8.0_wp * argas * ptemp ) )
5075!
5076!-- Knudsen number
5077    zknud = 2.0_wp * zmfp / ( paero(:)%dwet + d_sa )
5078!
5079!-- Transitional regime correction factor (zbeta) according to Fuchs and Sutugin (1971) (Eq. 4 in
5080!-- Kerminen and Kulmala, 2002)
5081    zbeta = ( zknud + 1.0_wp) / ( 0.377_wp * zknud + 1.0_wp + 4.0_wp / ( 3.0_wp * massacc ) *      &
5082            ( zknud + zknud**2 ) )
5083!
5084!-- Condensational sink (#/m2, Eq. 3)
5085    zcsink = SUM( paero(:)%dwet * zbeta * paero(:)%numc )
5086!
5087!-- 2.2.3) Parameterised formation rate of detectable 3 nm particles (i.e. J3)
5088    IF ( nj3 == 1 )  THEN   ! Kerminen and Kulmala (2002)
5089!
5090!--    Constants needed for the parameterisation: dapp = 3 nm and dens_nuc = 1830 kg/m3
5091       IF ( zcsink < 1.0E-30_wp )  THEN
5092          zeta = 0._dp
5093       ELSE
5094!
5095!--       Mean diameter of backgroud population (nm)
5096          zdmean = 1.0_wp / SUM( paero(:)%numc ) * SUM( paero(:)%numc * paero(:)%dwet ) * 1.0E+9_wp
5097!
5098!--       Proportionality factor (nm2*m2/h) (Eq. 22)
5099          zgamma = 0.23_wp * ( zdcrit * 1.0E+9_wp )**0.2_wp * ( zdmean / 150.0_wp )**0.048_wp *    &
5100                   ( ptemp / 293.0_wp )**( -0.75_wp ) * ( arhoh2so4 / 1000.0_wp )**( -0.33_wp )
5101!
5102!--       Factor eta (nm, Eq. 11)
5103          zeta = MIN( zgamma * zcsink / z_gr_clust, zdcrit * 1.0E11_wp )
5104       ENDIF
5105!
5106!--    Number conc. of clusters surviving to 3 nm in a time step (#/m3, Eq.14)
5107       zj3 = zjnuc * EXP( MIN( 0.0_wp, zeta / 3.0_wp - zeta / ( zdcrit * 1.0E9_wp ) ) )
5108
5109    ELSEIF ( nj3 > 1 )  THEN   ! Lehtinen et al. (2007) or Anttila et al. (2010)
5110!
5111!--    Defining the parameter m (zm_para) for calculating the coagulation sink onto background
5112!--    particles (Eq. 5&6 in Lehtinen et al. 2007). The growth is investigated between
5113!--    [d1,reglim(1)] = [zdcrit,3nm] and m = LOG( CoagS_dx / CoagX_zdcrit ) / LOG( reglim / zdcrit )
5114!--    (Lehtinen et al. 2007, Eq. 6).
5115!--    The steps for the coagulation sink for reglim = 3nm and zdcrit ~= 1nm are explained in
5116!--    Kulmala et al. (2001). The particles of diameter zdcrit ~1.14 nm  and reglim = 3nm are both
5117!--    in turn the "number 1" variables (Kulmala et al. 2001).
5118!--    c = critical (1nm), x = 3nm, 2 = wet or mean droplet
5119!
5120!--    Sum of the radii, R12 = R1 + R2 (m) of two particles 1 and 2
5121       z_r_c2 = zdcrit / 2.0_wp + paero(:)%dwet / 2.0_wp
5122       z_r_x2 = reglim(1) / 2.0_wp + paero(:)%dwet / 2.0_wp
5123!
5124!--    Particle mass (kg) (comes only from H2SO4)
5125       zm_c = 4.0_wp / 3.0_wp * pi * ( zdcrit / 2.0_wp )**3 * arhoh2so4
5126       zm_x = 4.0_wp / 3.0_wp * pi * ( reglim(1) / 2.0_wp )**3 * arhoh2so4
5127       zm_2 = 4.0_wp / 3.0_wp * pi * ( 0.5_wp * paero(:)%dwet )**3 * arhoh2so4
5128!
5129!--    Mean relative thermal velocity between the particles (m/s)
5130       zcv_c = SQRT( 8.0_wp * abo * ptemp / ( pi * zm_c ) )
5131       zcv_x = SQRT( 8.0_wp * abo * ptemp / ( pi * zm_x ) )
5132       zcv_2 = SQRT( 8.0_wp * abo * ptemp / ( pi * zm_2 ) )
5133!
5134!--    Average velocity after coagulation
5135       zcv_c2(:) = SQRT( zcv_c**2 + zcv_2**2 )
5136       zcv_x2(:) = SQRT( zcv_x**2 + zcv_2**2 )
5137!
5138!--    Knudsen number (zmfp = mean free path of condensing vapour)
5139       zknud_c = 2.0_wp * zmfp / zdcrit
5140       zknud_x = 2.0_wp * zmfp / reglim(1)
5141       zknud_2(:) = MAX( 0.0_wp, 2.0_wp * zmfp / paero(:)%dwet )
5142!
5143!--    Cunningham correction factors (Allen and Raabe, 1985)
5144       zcc_c    = 1.0_wp + zknud_c    * ( 1.142_wp + 0.558_wp * EXP( -0.999_wp / zknud_c ) )
5145       zcc_x    = 1.0_wp + zknud_x    * ( 1.142_wp + 0.558_wp * EXP( -0.999_wp / zknud_x ) )
5146       zcc_2(:) = 1.0_wp + zknud_2(:) * ( 1.142_wp + 0.558_wp * EXP( -0.999_wp / zknud_2(:) ) )
5147!
5148!--    Gas dynamic viscosity (N*s/m2). Here, viscocity(air @20C) = 1.81e-5_dp N/m2 *s (Hinds, p. 25)
5149       zmyy = 1.81E-5_wp * ( ptemp / 293.0_wp )**0.74_wp
5150!
5151!--    Particle diffusion coefficient (m2/s) (continuum regime)
5152       zdc_c(:) = abo * ptemp * zcc_c    / ( 3.0_wp * pi * zmyy * zdcrit )
5153       zdc_x(:) = abo * ptemp * zcc_x    / ( 3.0_wp * pi * zmyy * reglim(1) )
5154       zdc_2(:) = abo * ptemp * zcc_2(:) / ( 3.0_wp * pi * zmyy * paero(:)%dwet )
5155!
5156!--    D12 = D1+D2 (Seinfield and Pandis, 2nd ed. Eq. 13.38)
5157       zdc_c2 = zdc_c + zdc_2
5158       zdc_x2 = zdc_x + zdc_2
5159!
5160!--    zgamma_f = 8*D/pi/zcv (m) for calculating zomega (Fuchs, 1964)
5161       zgamma_f_c = 8.0_wp * zdc_c / pi / zcv_c
5162       zgamma_f_x = 8.0_wp * zdc_x / pi / zcv_x
5163       zgamma_f_2 = 8.0_wp * zdc_2 / pi / zcv_2
5164!
5165!--    zomega (m) for calculating zsigma
5166       zomega_c = ( ( z_r_c2 + zgamma_f_c )**3 - ( z_r_c2 ** 2 + zgamma_f_c )**1.5_wp ) /          &
5167                  ( 3.0_wp * z_r_c2 * zgamma_f_c ) - z_r_c2
5168       zomega_x = ( ( z_r_x2 + zgamma_f_x )**3 - ( z_r_x2**2 + zgamma_f_x )** 1.5_wp ) /           &
5169                  ( 3.0_wp * z_r_x2 * zgamma_f_x ) - z_r_x2
5170       zomega_2c = ( ( z_r_c2 + zgamma_f_2 )**3 - ( z_r_c2**2 + zgamma_f_2 )**1.5_wp ) /           &
5171                   ( 3.0_wp * z_r_c2 * zgamma_f_2 ) - z_r_c2
5172       zomega_2x = ( ( z_r_x2 + zgamma_f_2 )**3 - ( z_r_x2**2 + zgamma_f_2 )**1.5_wp ) /           &
5173                   ( 3.0_wp * z_r_x2 * zgamma_f_2 ) - z_r_x2 
5174!
5175!--    The distance (m) at which the two fluxes are matched (condensation and coagulation sinks)
5176       zsigma_c2 = SQRT( zomega_c**2 + zomega_2c**2 )
5177       zsigma_x2 = SQRT( zomega_x**2 + zomega_2x**2 )
5178!
5179!--    Coagulation coefficient in the continuum regime (m*m2/s, Eq. 17 in Kulmala et al., 2001)
5180       z_k_c2 = 4.0_wp * pi * z_r_c2 * zdc_c2 / ( z_r_c2 / ( z_r_c2 + zsigma_c2 ) +                &
5181               4.0_wp * zdc_c2 / ( zcv_c2 * z_r_c2 ) )
5182       z_k_x2 = 4.0_wp * pi * z_r_x2 * zdc_x2 / ( z_r_x2 / ( z_r_x2 + zsigma_x2 ) +                &
5183               4.0_wp * zdc_x2 / ( zcv_x2 * z_r_x2 ) )
5184!
5185!--    Coagulation sink (1/s, Eq. 16 in Kulmala et al., 2001)
5186       zcoags_c = MAX( 1.0E-20_wp, SUM( z_k_c2 * paero(:)%numc ) )
5187       zcoags_x = MAX( 1.0E-20_wp, SUM( z_k_x2 * paero(:)%numc ) )
5188!
5189!--    Parameter m for calculating the coagulation sink onto background particles (Eq. 5&6 in
5190!--    Lehtinen et al. 2007)
5191       zm_para = LOG( zcoags_x / zcoags_c ) / LOG( reglim(1) / zdcrit )
5192!
5193!--    Parameter gamma for calculating the formation rate J of particles having
5194!--    a diameter zdcrit < d < reglim(1) (Anttila et al. 2010, eq. 5 or Lehtinen et al.,2007, eq. 7)
5195       zgamma = ( ( ( reglim(1) / zdcrit )**( zm_para + 1.0_wp ) ) - 1.0_wp ) / ( zm_para + 1.0_wp )
5196
5197       IF ( nj3 == 2 )  THEN   ! Lehtinen et al. (2007): coagulation sink
5198!
5199!--       Formation rate J before iteration (#/m3s)
5200          zj3 = zjnuc * EXP( MIN( 0.0_wp, -zgamma * zdcrit * zcoags_c / ( z_gr_clust * 1.0E-9_wp / &
5201                60.0_wp**2 ) ) )
5202
5203       ELSEIF ( nj3 == 3 )  THEN  ! Anttila et al. (2010): coagulation sink and self-coag.
5204!
5205!--       If air is polluted, the self-coagulation becomes important. Self-coagulation of small
5206!--       particles < 3 nm.
5207!
5208!--       "Effective" coagulation coefficient between freshly-nucleated particles:
5209          z_k_eff = 5.0E-16_wp   ! m3/s
5210!
5211!--       zlambda parameter for "adjusting" the growth rate due to the self-coagulation
5212          zlambda = 6.0_wp
5213
5214          IF ( reglim(1) >= 10.0E-9_wp )  THEN   ! for particles >10 nm:
5215             z_k_eff   = 5.0E-17_wp
5216             zlambda = 3.0_wp
5217          ENDIF
5218!
5219!--       Initial values for coagulation sink and growth rate  (m/s)
5220          zcoagstot = zcoags_c
5221          z_gr_tot = z_gr_clust * 1.0E-9_wp / 60.0_wp**2
5222!
5223!--       Number of clusters/particles at the size range [d1,dx] (#/m3):
5224          z_n_nuc = zjnuc / zcoagstot !< Initial guess
5225!
5226!--       Coagulation sink and growth rate due to self-coagulation:
5227          DO  iteration = 1, 5
5228             zcoagstot = zcoags_c + z_k_eff * z_n_nuc * 1.0E-6_wp   ! (1/s, Anttila et al., eq. 1)
5229             z_gr_tot = z_gr_clust * 2.77777777E-7_wp +  1.5708E-6_wp * zlambda * zdcrit**3 *      &
5230                      ( z_n_nuc * 1.0E-6_wp ) * zcv_c * avo * 2.77777777E-7_wp ! (Eq. 3)
5231             zeta = - zcoagstot / ( ( zm_para + 1.0_wp ) * z_gr_tot * ( zdcrit**zm_para ) ) ! (Eq.7b)
5232!
5233!--          Calculate Eq. 7a (Taylor series for the number of particles between [d1,dx])
5234             z_n_nuc =  z_n_nuc_tayl( zdcrit, reglim(1), zm_para, zjnuc, zeta, z_gr_tot )
5235          ENDDO
5236!
5237!--       Calculate the final values with new z_n_nuc:
5238          zcoagstot = zcoags_c + z_k_eff * z_n_nuc * 1.0E-6_wp   ! (1/s)
5239          z_gr_tot = z_gr_clust * 1.0E-9_wp / 3600.0_wp + 1.5708E-6_wp *  zlambda * zdcrit**3 *    &
5240                   ( z_n_nuc * 1.0E-6_wp ) * zcv_c * avo * 1.0E-9_wp / 3600.0_wp !< (m/s)
5241          zj3 = zjnuc * EXP( MIN( 0.0_wp, -zgamma * zdcrit * zcoagstot / z_gr_tot ) ) ! (#/m3s, Eq.5a)
5242
5243       ENDIF
5244    ENDIF
5245!
5246!-- If J3 very small (< 1 #/cm3), neglect particle formation. In real atmosphere this would mean
5247!-- that clusters form but coagulate to pre-existing particles who gain sulphate. Since
5248!-- CoagS ~ CS (4piD*CS'), we do *not* update H2SO4 concentration here but let condensation take
5249!-- care of it. Formation mass rate of molecules (molec/m3s) for 1: H2SO4 and 2: organic vapour
5250    pj3n3(1) = zj3 * n3 * pxsa
5251    pj3n3(2) = zj3 * n3 * pxocnv
5252
5253 END SUBROUTINE nucleation
5254
5255!------------------------------------------------------------------------------!
5256! Description:
5257! ------------
5258!> Calculate the nucleation rate and the size of critical clusters assuming
5259!> binary nucleation.
5260!> Parametrisation according to Vehkamaki et al. (2002), J. Geophys. Res.,
5261!> 107(D22), 4622. Called from subroutine nucleation.
5262!------------------------------------------------------------------------------!
5263 SUBROUTINE binnucl( pc_sa, ptemp, prh, pnuc_rate, pn_crit_sa, pn_crit_ocnv, pd_crit, pk_sa,       &
5264                     pk_ocnv )
5265
5266    IMPLICIT NONE
5267
5268    REAL(wp) ::  za      !<
5269    REAL(wp) ::  zb      !<
5270    REAL(wp) ::  zc      !<
5271    REAL(wp) ::  zcoll   !<
5272    REAL(wp) ::  zlogsa  !<  LOG( zpcsa )
5273    REAL(wp) ::  zlogrh  !<  LOG( zrh )
5274    REAL(wp) ::  zm1     !<
5275    REAL(wp) ::  zm2     !<
5276    REAL(wp) ::  zma     !<
5277    REAL(wp) ::  zmw     !<
5278    REAL(wp) ::  zntot   !< number of molecules in critical cluster
5279    REAL(wp) ::  zpcsa   !< sulfuric acid concentration
5280    REAL(wp) ::  zrh     !< relative humidity
5281    REAL(wp) ::  zroo    !<
5282    REAL(wp) ::  zt      !< temperature
5283    REAL(wp) ::  zv1     !<
5284    REAL(wp) ::  zv2     !<
5285    REAL(wp) ::  zx      !< mole fraction of sulphate in critical cluster
5286    REAL(wp) ::  zxmass  !<
5287
5288    REAL(wp), INTENT(in) ::   pc_sa   !< H2SO4 conc. (#/cm3)
5289    REAL(wp), INTENT(in) ::   prh     !< relative humidity [0-1
5290    REAL(wp), INTENT(in) ::   ptemp   !< ambient temperature (K)
5291
5292    REAL(wp), INTENT(out) ::  pnuc_rate     !< nucleation rate (#/(m3 s))
5293    REAL(wp), INTENT(out) ::  pn_crit_sa    !< number of H2SO4 molecules in cluster (#)
5294    REAL(wp), INTENT(out) ::  pn_crit_ocnv  !< number of organic molecules in cluster (#)
5295    REAL(wp), INTENT(out) ::  pd_crit       !< diameter of critical cluster (m)
5296    REAL(wp), INTENT(out) ::  pk_sa         !< Lever: if pk_sa = 1, H2SO4 is involved in nucleation.
5297    REAL(wp), INTENT(out) ::  pk_ocnv       !< Lever: if pk_ocnv = 1, organic compounds are involved
5298
5299    pnuc_rate = 0.0_wp
5300    pd_crit   = 1.0E-9_wp
5301!
5302!-- 1) Checking that we are in the validity range of the parameterization
5303    zpcsa  = MAX( pc_sa, 1.0E4_wp  )
5304    zpcsa  = MIN( zpcsa, 1.0E11_wp )
5305    zrh    = MAX( prh,   0.0001_wp )
5306    zrh    = MIN( zrh,   1.0_wp    )
5307    zt     = MAX( ptemp, 190.15_wp )
5308    zt     = MIN( zt,    300.15_wp )
5309
5310    zlogsa = LOG( zpcsa )
5311    zlogrh   = LOG( prh )
5312!
5313!-- 2) Mole fraction of sulphate in a critical cluster (Eq. 11)
5314    zx = 0.7409967177282139_wp                  - 0.002663785665140117_wp * zt +                   &
5315         0.002010478847383187_wp * zlogrh       - 0.0001832894131464668_wp* zt * zlogrh +          &
5316         0.001574072538464286_wp * zlogrh**2    - 0.00001790589121766952_wp * zt * zlogrh**2 +     &
5317         0.0001844027436573778_wp * zlogrh**3   - 1.503452308794887E-6_wp * zt * zlogrh**3 -       &
5318         0.003499978417957668_wp * zlogsa     + 0.0000504021689382576_wp * zt * zlogsa
5319!
5320!-- 3) Nucleation rate (Eq. 12)
5321    pnuc_rate = 0.1430901615568665_wp + 2.219563673425199_wp * zt -                                &
5322                0.02739106114964264_wp * zt**2 + 0.00007228107239317088_wp * zt**3 +               &
5323                5.91822263375044_wp / zx + 0.1174886643003278_wp * zlogrh +                        &
5324                0.4625315047693772_wp * zt * zlogrh - 0.01180591129059253_wp * zt**2 * zlogrh +    &
5325                0.0000404196487152575_wp * zt**3 * zlogrh +                                        &
5326                ( 15.79628615047088_wp * zlogrh ) / zx - 0.215553951893509_wp * zlogrh**2 -        &
5327                0.0810269192332194_wp * zt * zlogrh**2 +                                           &
5328                0.001435808434184642_wp * zt**2 * zlogrh**2 -                                      &
5329                4.775796947178588E-6_wp * zt**3 * zlogrh**2 -                                      &
5330                ( 2.912974063702185_wp * zlogrh**2 ) / zx - 3.588557942822751_wp * zlogrh**3 +     &
5331                0.04950795302831703_wp * zt * zlogrh**3 -                                          &
5332                0.0002138195118737068_wp * zt**2 * zlogrh**3 +                                     &
5333                3.108005107949533E-7_wp * zt**3 * zlogrh**3 -                                      &
5334                ( 0.02933332747098296_wp * zlogrh**3 ) / zx + 1.145983818561277_wp * zlogsa -      &
5335                0.6007956227856778_wp * zt * zlogsa + 0.00864244733283759_wp * zt**2 * zlogsa -    &
5336                0.00002289467254710888_wp * zt**3 * zlogsa -                                       &
5337                ( 8.44984513869014_wp * zlogsa ) / zx + 2.158548369286559_wp * zlogrh * zlogsa +   &
5338                0.0808121412840917_wp * zt * zlogrh * zlogsa -                                     &
5339                0.0004073815255395214_wp * zt**2 * zlogrh * zlogsa -                               &
5340                4.019572560156515E-7_wp * zt**3 * zlogrh * zlogsa +                                &
5341                ( 0.7213255852557236_wp * zlogrh * zlogsa ) / zx +                                 &
5342                1.62409850488771_wp * zlogrh**2 * zlogsa -                                         &
5343                0.01601062035325362_wp * zt * zlogrh**2 * zlogsa +                                 &
5344                0.00003771238979714162_wp*zt**2* zlogrh**2 * zlogsa +                              &
5345                3.217942606371182E-8_wp * zt**3 * zlogrh**2 * zlogsa -                             &
5346                ( 0.01132550810022116_wp * zlogrh**2 * zlogsa ) / zx +                             &
5347                9.71681713056504_wp * zlogsa**2 - 0.1150478558347306_wp * zt * zlogsa**2 +         &
5348                0.0001570982486038294_wp * zt**2 * zlogsa**2 +                                     &
5349                4.009144680125015E-7_wp * zt**3 * zlogsa**2 +                                      &
5350                ( 0.7118597859976135_wp * zlogsa**2 ) / zx -                                       &
5351                1.056105824379897_wp * zlogrh * zlogsa**2 +                                        &
5352                0.00903377584628419_wp * zt * zlogrh * zlogsa**2 -                                 &
5353                0.00001984167387090606_wp * zt**2 * zlogrh * zlogsa**2 +                           &
5354                2.460478196482179E-8_wp * zt**3 * zlogrh * zlogsa**2 -                             &
5355                ( 0.05790872906645181_wp * zlogrh * zlogsa**2 ) / zx -                             &
5356                0.1487119673397459_wp * zlogsa**3 + 0.002835082097822667_wp * zt * zlogsa**3 -     &
5357                9.24618825471694E-6_wp * zt**2 * zlogsa**3 +                                       &
5358                5.004267665960894E-9_wp * zt**3 * zlogsa**3 -                                      &
5359                ( 0.01270805101481648_wp * zlogsa**3 ) / zx
5360!
5361!-- Nucleation rate in #/(cm3 s)
5362    pnuc_rate = EXP( pnuc_rate ) 
5363!
5364!-- Check the validity of parameterization
5365    IF ( pnuc_rate < 1.0E-7_wp )  THEN
5366       pnuc_rate = 0.0_wp
5367       pd_crit   = 1.0E-9_wp
5368    ENDIF
5369!
5370!-- 4) Total number of molecules in the critical cluster (Eq. 13)
5371    zntot = - 0.002954125078716302_wp - 0.0976834264241286_wp * zt +                               &
5372              0.001024847927067835_wp * zt**2 - 2.186459697726116E-6_wp * zt**3 -                  &
5373              0.1017165718716887_wp / zx - 0.002050640345231486_wp * zlogrh -                      &
5374              0.007585041382707174_wp * zt * zlogrh + 0.0001926539658089536_wp * zt**2 * zlogrh -  &
5375              6.70429719683894E-7_wp * zt**3 * zlogrh - ( 0.2557744774673163_wp * zlogrh ) / zx +  &
5376              0.003223076552477191_wp * zlogrh**2 + 0.000852636632240633_wp * zt * zlogrh**2 -     &
5377              0.00001547571354871789_wp * zt**2 * zlogrh**2 +                                      &
5378              5.666608424980593E-8_wp * zt**3 * zlogrh**2 +                                        &
5379              ( 0.03384437400744206_wp * zlogrh**2 ) / zx +                                        &
5380              0.04743226764572505_wp * zlogrh**3 - 0.0006251042204583412_wp * zt * zlogrh**3 +     &
5381              2.650663328519478E-6_wp * zt**2 * zlogrh**3 -                                        &
5382              3.674710848763778E-9_wp * zt**3 * zlogrh**3 -                                        &
5383              ( 0.0002672510825259393_wp * zlogrh**3 ) / zx - 0.01252108546759328_wp * zlogsa +    &
5384              0.005806550506277202_wp * zt * zlogsa - 0.0001016735312443444_wp * zt**2 * zlogsa +  &
5385              2.881946187214505E-7_wp * zt**3 * zlogsa + ( 0.0942243379396279_wp * zlogsa ) / zx - &
5386              0.0385459592773097_wp * zlogrh * zlogsa -                                            &
5387              0.0006723156277391984_wp * zt * zlogrh * zlogsa  +                                   &
5388              2.602884877659698E-6_wp * zt**2 * zlogrh * zlogsa +                                  &
5389              1.194163699688297E-8_wp * zt**3 * zlogrh * zlogsa -                                  &
5390              ( 0.00851515345806281_wp * zlogrh * zlogsa ) / zx -                                  &
5391              0.01837488495738111_wp * zlogrh**2 * zlogsa +                                        &
5392              0.0001720723574407498_wp * zt * zlogrh**2 * zlogsa -                                 &
5393              3.717657974086814E-7_wp * zt**2 * zlogrh**2 * zlogsa -                               &
5394              5.148746022615196E-10_wp * zt**3 * zlogrh**2 * zlogsa +                              &
5395              ( 0.0002686602132926594_wp * zlogrh**2 * zlogsa ) / zx -                             &
5396              0.06199739728812199_wp * zlogsa**2 + 0.000906958053583576_wp * zt * zlogsa**2 -      &
5397              9.11727926129757E-7_wp * zt**2 * zlogsa**2 -                                         &
5398              5.367963396508457E-9_wp * zt**3 * zlogsa**2 -                                        &
5399              ( 0.007742343393937707_wp * zlogsa**2 ) / zx +                                       &
5400              0.0121827103101659_wp * zlogrh * zlogsa**2 -                                         &
5401              0.0001066499571188091_wp * zt * zlogrh * zlogsa**2 +                                 &
5402              2.534598655067518E-7_wp * zt**2 * zlogrh * zlogsa**2 -                               &
5403              3.635186504599571E-10_wp * zt**3 * zlogrh * zlogsa**2 +                              &
5404              ( 0.0006100650851863252_wp * zlogrh * zlogsa **2 ) / zx +                            &
5405              0.0003201836700403512_wp * zlogsa**3 - 0.0000174761713262546_wp * zt * zlogsa**3 +   &
5406              6.065037668052182E-8_wp * zt**2 * zlogsa**3 -                                        &
5407              1.421771723004557E-11_wp * zt**3 * zlogsa**3 +                                       &
5408              ( 0.0001357509859501723_wp * zlogsa**3 ) / zx
5409    zntot = EXP( zntot )  ! in #
5410!
5411!-- 5) Size of the critical cluster pd_crit (m) (diameter) (Eq. 14)
5412    pn_crit_sa = zx * zntot
5413    pd_crit = 2.0E-9_wp * EXP( -1.6524245_wp + 0.42316402_wp * zx + 0.33466487_wp * LOG( zntot ) )
5414!
5415!-- 6) Organic compounds not involved when binary nucleation is assumed
5416    pn_crit_ocnv = 0.0_wp   ! number of organic molecules
5417    pk_sa        = 1.0_wp   ! if = 1, H2SO4 involved in nucleation
5418    pk_ocnv      = 0.0_wp   ! if = 1, organic compounds involved
5419!
5420!-- Set nucleation rate to collision rate
5421    IF ( pn_crit_sa < 4.0_wp ) THEN
5422!
5423!--    Volumes of the colliding objects
5424       zma    = 96.0_wp   ! molar mass of SO4 in g/mol
5425       zmw    = 18.0_wp   ! molar mass of water in g/mol
5426       zxmass = 1.0_wp    ! mass fraction of H2SO4
5427       za = 0.7681724_wp + zxmass * ( 2.1847140_wp + zxmass *                                      &
5428                                      ( 7.1630022_wp + zxmass *                                    &
5429                                        ( -44.31447_wp + zxmass *                                  &
5430                                          ( 88.75606 + zxmass *                                    &
5431                                            ( -75.73729_wp + zxmass * 23.43228_wp ) ) ) ) )
5432       zb = 1.808225E-3_wp + zxmass * ( -9.294656E-3_wp + zxmass *                                 &
5433                                        ( -0.03742148_wp + zxmass *                                &
5434                                          ( 0.2565321_wp + zxmass *                                &
5435                                            ( -0.5362872_wp + zxmass *                             &
5436                                              ( 0.4857736 - zxmass * 0.1629592_wp ) ) ) ) )
5437       zc = - 3.478524E-6_wp + zxmass * ( 1.335867E-5_wp + zxmass *                                &
5438                                          ( 5.195706E-5_wp + zxmass *                              &
5439                                            ( -3.717636E-4_wp + zxmass *                           &
5440                                              ( 7.990811E-4_wp + zxmass *                          &
5441                                                ( -7.458060E-4_wp + zxmass * 2.58139E-4_wp ) ) ) ) )
5442!
5443!--    Density for the sulphuric acid solution (Eq. 10 in Vehkamaki)
5444       zroo = ( za + zt * ( zb + zc * zt ) ) * 1.0E+3_wp   ! (kg/m^3
5445       zm1  = 0.098_wp   ! molar mass of H2SO4 in kg/mol
5446       zm2  = zm1
5447       zv1  = zm1 / avo / zroo   ! volume
5448       zv2  = zv1
5449!
5450!--    Collision rate
5451       zcoll =  zpcsa * zpcsa * ( 3.0_wp * pi / 4.0_wp )**0.16666666_wp *                          &
5452                SQRT( 6.0_wp * argas * zt / zm1 + 6.0_wp * argas * zt / zm2 ) *                    &
5453                ( zv1**0.33333333_wp + zv2**0.33333333_wp )**2 * 1.0E+6_wp    ! m3 -> cm3
5454       zcoll = MIN( zcoll, 1.0E+10_wp )
5455       pnuc_rate  = zcoll   ! (#/(cm3 s))
5456
5457    ELSE
5458       pnuc_rate  = MIN( pnuc_rate, 1.0E+10_wp )
5459    ENDIF
5460    pnuc_rate = pnuc_rate * 1.0E+6_wp   ! (#/(m3 s))
5461
5462 END SUBROUTINE binnucl
5463 
5464!------------------------------------------------------------------------------!
5465! Description:
5466! ------------
5467!> Calculate the nucleation rate and the size of critical clusters assuming
5468!> ternary nucleation. Parametrisation according to:
5469!> Napari et al. (2002), J. Chem. Phys., 116, 4221-4227 and
5470!> Napari et al. (2002), J. Geophys. Res., 107(D19), AAC 6-1-ACC 6-6.
5471!------------------------------------------------------------------------------!
5472 SUBROUTINE ternucl( pc_sa, pc_nh3, ptemp, prh, pnuc_rate, pn_crit_sa, pn_crit_ocnv, pd_crit,      &
5473                     pk_sa, pk_ocnv )
5474
5475    IMPLICIT NONE
5476
5477    REAL(wp) ::  zlnj     !< logarithm of nucleation rate
5478    REAL(wp) ::  zlognh3  !< LOG( pc_nh3 )
5479    REAL(wp) ::  zlogrh   !< LOG( prh )
5480    REAL(wp) ::  zlogsa   !< LOG( pc_sa )
5481
5482    REAL(wp), INTENT(in) ::   pc_nh3  !< ammonia mixing ratio (ppt)
5483    REAL(wp), INTENT(in) ::   pc_sa   !< H2SO4 conc. (#/cm3)
5484    REAL(wp), INTENT(in) ::   prh     !< relative humidity [0-1]
5485    REAL(wp), INTENT(in) ::   ptemp   !< ambient temperature (K)
5486
5487    REAL(wp), INTENT(out) ::  pd_crit  !< diameter of critical cluster (m)
5488    REAL(wp), INTENT(out) ::  pk_ocnv  !< if pk_ocnv = 1, organic compounds participate in nucleation
5489    REAL(wp), INTENT(out) ::  pk_sa    !< if pk_sa = 1, H2SO4 participate in nucleation
5490    REAL(wp), INTENT(out) ::  pn_crit_ocnv  !< number of organic molecules in cluster (#)
5491    REAL(wp), INTENT(out) ::  pn_crit_sa    !< number of H2SO4 molecules in cluster (#)
5492    REAL(wp), INTENT(out) ::  pnuc_rate     !< nucleation rate (#/(m3 s))
5493!
5494!-- 1) Checking that we are in the validity range of the parameterization.
5495!--    Validity of parameterization : DO NOT REMOVE!
5496    IF ( ptemp < 240.0_wp  .OR.  ptemp > 300.0_wp )  THEN
5497       message_string = 'Invalid input value: ptemp'
5498       CALL message( 'salsa_mod: ternucl', 'PA0648', 1, 2, 0, 6, 0 )
5499    ENDIF
5500    IF ( prh < 0.05_wp  .OR.  prh > 0.95_wp )  THEN
5501       message_string = 'Invalid input value: prh'
5502       CALL message( 'salsa_mod: ternucl', 'PA0649', 1, 2, 0, 6, 0 )
5503    ENDIF
5504    IF ( pc_sa < 1.0E+4_wp  .OR.  pc_sa > 1.0E+9_wp )  THEN
5505       message_string = 'Invalid input value: pc_sa'
5506       CALL message( 'salsa_mod: ternucl', 'PA0650', 1, 2, 0, 6, 0 )
5507    ENDIF
5508    IF ( pc_nh3 < 0.1_wp  .OR.  pc_nh3 > 100.0_wp )  THEN
5509       message_string = 'Invalid input value: pc_nh3'
5510       CALL message( 'salsa_mod: ternucl', 'PA0651', 1, 2, 0, 6, 0 )
5511    ENDIF
5512
5513    zlognh3 = LOG( pc_nh3 )
5514    zlogrh  = LOG( prh )
5515    zlogsa  = LOG( pc_sa )
5516!
5517!-- 2) Nucleation rate (Eq. 7 in Napari et al., 2002: Parameterization of
5518!--    ternary nucleation of sulfuric acid - ammonia - water.
5519    zlnj = - 84.7551114741543_wp + 0.3117595133628944_wp * prh +                                   &
5520           1.640089605712946_wp * prh * ptemp - 0.003438516933381083_wp * prh * ptemp**2 -         &
5521           0.00001097530402419113_wp * prh * ptemp**3 - 0.3552967070274677_wp / zlogsa -           &
5522           ( 0.06651397829765026_wp * prh ) / zlogsa - ( 33.84493989762471_wp * ptemp ) / zlogsa - &
5523           ( 7.823815852128623_wp * prh * ptemp ) / zlogsa +                                       &
5524           ( 0.3453602302090915_wp * ptemp**2 ) / zlogsa +                                         &
5525           ( 0.01229375748100015_wp * prh * ptemp**2 ) / zlogsa -                                  &
5526           ( 0.000824007160514956_wp *ptemp**3 ) / zlogsa +                                        &
5527           ( 0.00006185539100670249_wp * prh * ptemp**3 ) / zlogsa +                               &
5528           3.137345238574998_wp * zlogsa + 3.680240980277051_wp * prh * zlogsa -                   &
5529           0.7728606202085936_wp * ptemp * zlogsa - 0.204098217156962_wp * prh * ptemp * zlogsa +  &
5530           0.005612037586790018_wp * ptemp**2 * zlogsa +                                           &
5531           0.001062588391907444_wp * prh * ptemp**2 * zlogsa -                                     &
5532           9.74575691760229E-6_wp * ptemp**3 * zlogsa -                                            &
5533           1.265595265137352E-6_wp * prh * ptemp**3 * zlogsa + 19.03593713032114_wp * zlogsa**2 -  &
5534           0.1709570721236754_wp * ptemp * zlogsa**2 +                                             &
5535           0.000479808018162089_wp * ptemp**2 * zlogsa**2 -                                        &
5536           4.146989369117246E-7_wp * ptemp**3 * zlogsa**2 + 1.076046750412183_wp * zlognh3 +       &
5537           0.6587399318567337_wp * prh * zlognh3 + 1.48932164750748_wp * ptemp * zlognh3 +         &
5538           0.1905424394695381_wp * prh * ptemp * zlognh3 -                                         &
5539           0.007960522921316015_wp * ptemp**2 * zlognh3 -                                          &
5540           0.001657184248661241_wp * prh * ptemp**2 * zlognh3 +                                    &
5541           7.612287245047392E-6_wp * ptemp**3 * zlognh3 +                                          &
5542           3.417436525881869E-6_wp * prh * ptemp**3 * zlognh3 +                                    &
5543           ( 0.1655358260404061_wp * zlognh3 ) / zlogsa +                                          &
5544           ( 0.05301667612522116_wp * prh * zlognh3 ) / zlogsa +                                   &
5545           ( 3.26622914116752_wp * ptemp * zlognh3 ) / zlogsa -                                    &
5546           ( 1.988145079742164_wp * prh * ptemp * zlognh3 ) / zlogsa -                             &
5547           ( 0.04897027401984064_wp * ptemp**2 * zlognh3 ) / zlogsa +                              &
5548           ( 0.01578269253599732_wp * prh * ptemp**2 * zlognh3 ) / zlogsa +                        &
5549           ( 0.0001469672236351303_wp * ptemp**3 * zlognh3 ) / zlogsa -                            &
5550           ( 0.00002935642836387197_wp * prh * ptemp**3 *zlognh3 ) / zlogsa +                      &
5551           6.526451177887659_wp * zlogsa * zlognh3 -                                               &
5552           0.2580021816722099_wp * ptemp * zlogsa * zlognh3 +                                      &
5553           0.001434563104474292_wp * ptemp**2 * zlogsa * zlognh3 -                                 &
5554           2.020361939304473E-6_wp * ptemp**3 * zlogsa * zlognh3 -                                 &
5555           0.160335824596627_wp * zlogsa**2 * zlognh3 +                                            &
5556           0.00889880721460806_wp * ptemp * zlogsa**2 * zlognh3 -                                  &
5557           0.00005395139051155007_wp * ptemp**2 * zlogsa**2 * zlognh3 +                            &
5558           8.39521718689596E-8_wp * ptemp**3 * zlogsa**2 * zlognh3 +                               &
5559           6.091597586754857_wp * zlognh3**2 + 8.5786763679309_wp * prh * zlognh3**2 -             &
5560           1.253783854872055_wp * ptemp * zlognh3**2 -                                             &
5561           0.1123577232346848_wp * prh * ptemp * zlognh3**2 +                                      &
5562           0.00939835595219825_wp * ptemp**2 * zlognh3**2 +                                        &
5563           0.0004726256283031513_wp * prh * ptemp**2 * zlognh3**2 -                                &
5564           0.00001749269360523252_wp * ptemp**3 * zlognh3**2 -                                     &
5565           6.483647863710339E-7_wp * prh * ptemp**3 * zlognh3**2 +                                 &
5566           ( 0.7284285726576598_wp * zlognh3**2 ) / zlogsa +                                       &
5567           ( 3.647355600846383_wp * ptemp * zlognh3**2 ) / zlogsa -                                &
5568           ( 0.02742195276078021_wp * ptemp**2 * zlognh3**2 ) / zlogsa +                           &
5569           ( 0.00004934777934047135_wp * ptemp**3 * zlognh3**2 ) / zlogsa +                        &
5570           41.30162491567873_wp * zlogsa * zlognh3**2 -                                            &
5571           0.357520416800604_wp * ptemp * zlogsa * zlognh3**2 +                                    &
5572           0.000904383005178356_wp * ptemp**2 * zlogsa * zlognh3**2 -                              &
5573           5.737876676408978E-7_wp * ptemp**3 * zlogsa * zlognh3**2 -                              &
5574           2.327363918851818_wp * zlogsa**2 * zlognh3**2 +                                         &
5575           0.02346464261919324_wp * ptemp * zlogsa**2 * zlognh3**2 -                               &
5576           0.000076518969516405_wp * ptemp**2 * zlogsa**2 * zlognh3**2 +                           &
5577           8.04589834836395E-8_wp * ptemp**3 * zlogsa**2 * zlognh3**2 -                            &
5578           0.02007379204248076_wp * zlogrh - 0.7521152446208771_wp * ptemp * zlogrh +              &
5579           0.005258130151226247_wp * ptemp**2 * zlogrh -                                           &
5580           8.98037634284419E-6_wp * ptemp**3 * zlogrh +                                            &
5581           ( 0.05993213079516759_wp * zlogrh ) / zlogsa +                                          &
5582           ( 5.964746463184173_wp * ptemp * zlogrh ) / zlogsa -                                    &
5583           ( 0.03624322255690942_wp * ptemp**2 * zlogrh ) / zlogsa +                               &
5584           ( 0.00004933369382462509_wp * ptemp**3 * zlogrh ) / zlogsa -                            &
5585           0.7327310805365114_wp * zlognh3 * zlogrh -                                              &
5586           0.01841792282958795_wp * ptemp * zlognh3 * zlogrh +                                     &
5587           0.0001471855981005184_wp * ptemp**2 * zlognh3 * zlogrh -                                &
5588           2.377113195631848E-7_wp * ptemp**3 * zlognh3 * zlogrh
5589    pnuc_rate = EXP( zlnj )   ! (#/(cm3 s))
5590!
5591!-- Check validity of parametrization
5592    IF ( pnuc_rate < 1.0E-5_wp )  THEN
5593       pnuc_rate = 0.0_wp
5594       pd_crit   = 1.0E-9_wp
5595    ELSEIF ( pnuc_rate > 1.0E6_wp )  THEN
5596       message_string = 'Invalid output value: nucleation rate > 10^6 1/cm3s'
5597       CALL message( 'salsa_mod: ternucl', 'PA0623', 1, 2, 0, 6, 0 )
5598    ENDIF
5599    pnuc_rate = pnuc_rate * 1.0E6_wp   ! (#/(m3 s))
5600!
5601!-- 3) Number of H2SO4 molecules in a critical cluster (Eq. 9)
5602    pn_crit_sa = 38.16448247950508_wp + 0.7741058259731187_wp * zlnj +                             &
5603                 0.002988789927230632_wp * zlnj**2 - 0.3576046920535017_wp * ptemp -               &
5604                 0.003663583011953248_wp * zlnj * ptemp + 0.000855300153372776_wp * ptemp**2
5605!
5606!-- Kinetic limit: at least 2 H2SO4 molecules in a cluster
5607    pn_crit_sa = MAX( pn_crit_sa, 2.0E0_wp )
5608!
5609!-- 4) Size of the critical cluster in nm (Eq. 12)
5610    pd_crit = 0.1410271086638381_wp - 0.001226253898894878_wp * zlnj -                             &
5611              7.822111731550752E-6_wp * zlnj**2 - 0.001567273351921166_wp * ptemp -                &
5612              0.00003075996088273962_wp * zlnj * ptemp + 0.00001083754117202233_wp * ptemp**2
5613    pd_crit = pd_crit * 2.0E-9_wp   ! Diameter in m
5614!
5615!-- 5) Organic compounds not involved when ternary nucleation assumed
5616    pn_crit_ocnv = 0.0_wp
5617    pk_sa   = 1.0_wp
5618    pk_ocnv = 0.0_wp
5619
5620 END SUBROUTINE ternucl
5621
5622!------------------------------------------------------------------------------!
5623! Description:
5624! ------------
5625!> Function z_n_nuc_tayl is connected to the calculation of self-coagualtion of
5626!> small particles. It calculates number of the particles in the size range
5627!> [zdcrit,dx] using Taylor-expansion (please note that the expansion is not
5628!> valid for certain rational numbers, e.g. -4/3 and -3/2)
5629!------------------------------------------------------------------------------!
5630 FUNCTION z_n_nuc_tayl( d1, dx, zm_para, zjnuc_t, zeta, z_gr_tot )
5631
5632    IMPLICIT NONE
5633
5634    INTEGER(iwp) ::  i !< running index
5635
5636    REAL(wp) ::  d1            !< lower diameter limit
5637    REAL(wp) ::  dx            !< upper diameter limit
5638    REAL(wp) ::  zjnuc_t       !< initial nucleation rate (1/s)
5639    REAL(wp) ::  zeta          !< ratio of CS/GR (m) (condensation sink / growth rate)
5640    REAL(wp) ::  term1         !<
5641    REAL(wp) ::  term2         !<
5642    REAL(wp) ::  term3         !<
5643    REAL(wp) ::  term4         !<
5644    REAL(wp) ::  term5         !<
5645    REAL(wp) ::  z_n_nuc_tayl  !< final nucleation rate (1/s)
5646    REAL(wp) ::  z_gr_tot      !< total growth rate (nm/h)
5647    REAL(wp) ::  zm_para       !< m parameter in Lehtinen et al. (2007), Eq. 6
5648
5649    z_n_nuc_tayl = 0.0_wp
5650
5651    DO  i = 0, 29
5652       IF ( i == 0  .OR.  i == 1 )  THEN
5653          term1 = 1.0_wp
5654       ELSE
5655          term1 = term1 * REAL( i, SELECTED_REAL_KIND(12,307) )
5656       END IF
5657       term2 = ( REAL( i, SELECTED_REAL_KIND(12,307) ) * ( zm_para + 1.0_wp ) + 1.0_wp ) * term1
5658       term3 = zeta**i
5659       term4 = term3 / term2
5660       term5 = REAL( i, SELECTED_REAL_KIND(12,307) ) * ( zm_para + 1.0_wp ) + 1.0_wp
5661       z_n_nuc_tayl = z_n_nuc_tayl + term4 * ( dx**term5 - d1**term5 )
5662    ENDDO
5663    z_n_nuc_tayl = z_n_nuc_tayl * zjnuc_t * EXP( -zeta * ( d1**( zm_para + 1 ) ) ) / z_gr_tot
5664
5665 END FUNCTION z_n_nuc_tayl
5666
5667!------------------------------------------------------------------------------!
5668! Description:
5669! ------------
5670!> Calculates the condensation of water vapour on aerosol particles. Follows the
5671!> analytical predictor method by Jacobson (2005).
5672!> For equations, see Jacobson (2005), Fundamentals of atmospheric modelling
5673!> (2nd edition).
5674!------------------------------------------------------------------------------!
5675 SUBROUTINE gpparth2o( paero, ptemp, ppres, pcs, pcw, ptstep )
5676
5677    IMPLICIT NONE
5678
5679    INTEGER(iwp) ::  ib   !< loop index
5680    INTEGER(iwp) ::  nstr !<
5681
5682    REAL(wp) ::  adt        !< internal timestep in this subroutine
5683    REAL(wp) ::  rhoair     !< air density (kg/m3)
5684    REAL(wp) ::  ttot       !< total time (s)
5685    REAL(wp) ::  zact       !< Water activity
5686    REAL(wp) ::  zaelwc1    !< Current aerosol water content (kg/m3)
5687    REAL(wp) ::  zaelwc2    !< New aerosol water content after equilibrium calculation (kg/m3)
5688    REAL(wp) ::  zbeta      !< Transitional correction factor
5689    REAL(wp) ::  zcwc       !< Current water vapour mole concentration in aerosols (mol/m3)
5690    REAL(wp) ::  zcwint     !< Current and new water vapour mole concentrations (mol/m3)
5691    REAL(wp) ::  zcwn       !< New water vapour mole concentration (mol/m3)
5692    REAL(wp) ::  zcwtot     !< Total water mole concentration (mol/m3)
5693    REAL(wp) ::  zdfh2o     !< molecular diffusion coefficient (cm2/s) for water
5694    REAL(wp) ::  zhlp1      !< intermediate variable to calculate the mass transfer coefficient
5695    REAL(wp) ::  zhlp2      !< intermediate variable to calculate the mass transfer coefficient
5696    REAL(wp) ::  zhlp3      !< intermediate variable to calculate the mass transfer coefficient
5697    REAL(wp) ::  zknud      !< Knudsen number
5698    REAL(wp) ::  zmfph2o    !< mean free path of H2O gas molecule
5699    REAL(wp) ::  zrh        !< relative humidity [0-1]
5700    REAL(wp) ::  zthcond    !< thermal conductivity of air (W/m/K)
5701
5702    REAL(wp), DIMENSION(nbins_aerosol) ::  zcwcae     !< Current water mole concentrations
5703    REAL(wp), DIMENSION(nbins_aerosol) ::  zcwintae   !< Current and new aerosol water mole concentration
5704    REAL(wp), DIMENSION(nbins_aerosol) ::  zcwnae     !< New water mole concentration in aerosols
5705    REAL(wp), DIMENSION(nbins_aerosol) ::  zcwsurfae  !< Surface mole concentration
5706    REAL(wp), DIMENSION(nbins_aerosol) ::  zkelvin    !< Kelvin effect
5707    REAL(wp), DIMENSION(nbins_aerosol) ::  zmtae      !< Mass transfer coefficients
5708    REAL(wp), DIMENSION(nbins_aerosol) ::  zwsatae    !< Water saturation ratio above aerosols
5709
5710    REAL(wp), INTENT(in) ::  ppres   !< Air pressure (Pa)
5711    REAL(wp), INTENT(in) ::  pcs     !< Water vapour saturation concentration (kg/m3)
5712    REAL(wp), INTENT(in) ::  ptemp   !< Ambient temperature (K)
5713    REAL(wp), INTENT(in) ::  ptstep  !< timestep (s)
5714
5715    REAL(wp), INTENT(inout) ::  pcw  !< Water vapour concentration (kg/m3)
5716
5717    TYPE(t_section), DIMENSION(nbins_aerosol), INTENT(inout) ::  paero  !< Aerosol properties
5718!
5719!-- Relative humidity [0-1]
5720    zrh = pcw / pcs
5721!
5722!-- Calculate the condensation only for 2a/2b aerosol bins
5723    nstr = start_subrange_2a
5724!
5725!-- Save the current aerosol water content, 8 in paero is H2O
5726    zaelwc1 = SUM( paero(start_subrange_1a:end_subrange_2b)%volc(8) ) * arhoh2o
5727!
5728!-- Equilibration:
5729    IF ( advect_particle_water )  THEN
5730       IF ( zrh < 0.98_wp  .OR.  .NOT. lscndh2oae )  THEN
5731          CALL equilibration( zrh, ptemp, paero, .TRUE. )
5732       ELSE
5733          CALL equilibration( zrh, ptemp, paero, .FALSE. )
5734       ENDIF
5735    ENDIF
5736!
5737!-- The new aerosol water content after equilibrium calculation
5738    zaelwc2 = SUM( paero(start_subrange_1a:end_subrange_2b)%volc(8) ) * arhoh2o
5739!
5740!-- New water vapour mixing ratio (kg/m3)
5741    pcw = pcw - ( zaelwc2 - zaelwc1 ) * ppres * amdair / ( argas * ptemp )
5742!
5743!-- Initialise variables
5744    zcwsurfae(:) = 0.0_wp
5745    zhlp1        = 0.0_wp
5746    zhlp2        = 0.0_wp
5747    zhlp3        = 0.0_wp
5748    zmtae(:)     = 0.0_wp
5749    zwsatae(:)   = 0.0_wp
5750!
5751!-- Air:
5752!-- Density (kg/m3)
5753    rhoair = amdair * ppres / ( argas * ptemp )
5754!
5755!-- Thermal conductivity of air
5756    zthcond = 0.023807_wp + 7.1128E-5_wp * ( ptemp - 273.16_wp )
5757!
5758!-- Water vapour:
5759!-- Molecular diffusion coefficient (cm2/s) (eq.16.17)
5760    zdfh2o = ( 5.0_wp / ( 16.0_wp * avo * rhoair * 1.0E-3_wp * 3.11E-8_wp**2 ) ) * SQRT( argas *   &
5761               1.0E+7_wp * ptemp * amdair * 1.0E+3_wp * ( amh2o + amdair ) * 1.0E+3_wp /           &
5762               ( pi * amh2o * 2.0E+3_wp ) )
5763    zdfh2o = zdfh2o * 1.0E-4   ! Unit change to m^2/s
5764!
5765!-- Mean free path (eq. 15.25 & 16.29)
5766    zmfph2o = 3.0_wp * zdfh2o * SQRT( pi * amh2o / ( 8.0_wp * argas * ptemp ) )
5767!
5768!-- Kelvin effect (eq. 16.33)
5769    zkelvin(:) = EXP( 4.0_wp * surfw0 * amh2o / ( argas * ptemp * arhoh2o * paero(:)%dwet) )
5770
5771    DO  ib = 1, nbins_aerosol
5772       IF ( paero(ib)%numc > nclim  .AND.  zrh > 0.98_wp )  THEN
5773!
5774!--       Water activity
5775          zact = acth2o( paero(ib) )
5776!
5777!--       Saturation mole concentration over flat surface. Limit the super-
5778!--       saturation to max 1.01 for the mass transfer. Experimental!
5779          zcwsurfae(ib) = MAX( pcs, pcw / 1.01_wp ) * rhoair / amh2o
5780!
5781!--       Equilibrium saturation ratio
5782          zwsatae(ib) = zact * zkelvin(ib)
5783!
5784!--       Knudsen number (eq. 16.20)
5785          zknud = 2.0_wp * zmfph2o / paero(ib)%dwet
5786!
5787!--       Transitional correction factor (Fuks & Sutugin, 1971)
5788          zbeta = ( zknud + 1.0_wp ) / ( 0.377_wp * zknud + 1.0_wp + 4.0_wp /                      &
5789                  ( 3.0_wp * massacc(ib) ) * ( zknud + zknud**2 ) )
5790!
5791!--       Mass transfer of H2O: Eq. 16.64 but here D^eff =  zdfh2o * zbeta
5792          zhlp1 = paero(ib)%numc * 2.0_wp * pi * paero(ib)%dwet * zdfh2o * zbeta
5793!
5794!--       1st term on the left side of the denominator in eq. 16.55
5795          zhlp2 = amh2o * zdfh2o * alv * zwsatae(ib) * zcwsurfae(ib) / ( zthcond * ptemp )
5796!
5797!--       2nd term on the left side of the denominator in eq. 16.55
5798          zhlp3 = ( ( alv * amh2o ) / ( argas * ptemp ) ) - 1.0_wp
5799!
5800!--       Full eq. 16.64: Mass transfer coefficient (1/s)
5801          zmtae(ib) = zhlp1 / ( zhlp2 * zhlp3 + 1.0_wp )
5802       ENDIF
5803    ENDDO
5804!
5805!-- Current mole concentrations of water
5806    zcwc        = pcw * rhoair / amh2o   ! as vapour
5807    zcwcae(:)   = paero(:)%volc(8) * arhoh2o / amh2o   ! in aerosols
5808    zcwtot      = zcwc + SUM( zcwcae )   ! total water concentration
5809    zcwnae(:)   = 0.0_wp
5810    zcwintae(:) = zcwcae(:)
5811!
5812!-- Substepping loop
5813    zcwint = 0.0_wp
5814    ttot   = 0.0_wp
5815    DO  WHILE ( ttot < ptstep )
5816       adt = 2.0E-2_wp   ! internal timestep
5817!
5818!--    New vapour concentration: (eq. 16.71)
5819       zhlp1 = zcwc + adt * ( SUM( zmtae(nstr:nbins_aerosol) * zwsatae(nstr:nbins_aerosol) *       &
5820                                   zcwsurfae(nstr:nbins_aerosol) ) )   ! numerator
5821       zhlp2 = 1.0_wp + adt * ( SUM( zmtae(nstr:nbins_aerosol) ) )   ! denomin.
5822       zcwint = zhlp1 / zhlp2   ! new vapour concentration
5823       zcwint = MIN( zcwint, zcwtot )
5824       IF ( ANY( paero(:)%numc > nclim )  .AND. zrh > 0.98_wp )  THEN
5825          DO  ib = nstr, nbins_aerosol
5826             zcwintae(ib) = zcwcae(ib) + MIN( MAX( adt * zmtae(ib) * ( zcwint - zwsatae(ib) *      &
5827                                                   zcwsurfae(ib) ), -0.02_wp * zcwcae(ib) ),       &
5828                                            0.05_wp * zcwcae(ib) )
5829             zwsatae(ib) = acth2o( paero(ib), zcwintae(ib) ) * zkelvin(ib)
5830          ENDDO
5831       ENDIF
5832       zcwintae(nstr:nbins_aerosol) = MAX( zcwintae(nstr:nbins_aerosol), 0.0_wp )
5833!
5834!--    Update vapour concentration for consistency
5835       zcwint = zcwtot - SUM( zcwintae(1:nbins_aerosol) )
5836!
5837!--    Update "old" values for next cycle
5838       zcwcae = zcwintae
5839
5840       ttot = ttot + adt
5841
5842    ENDDO   ! ADT
5843
5844    zcwn      = zcwint
5845    zcwnae(:) = zcwintae(:)
5846    pcw       = zcwn * amh2o / rhoair
5847    paero(:)%volc(8) = MAX( 0.0_wp, zcwnae(:) * amh2o / arhoh2o )
5848
5849 END SUBROUTINE gpparth2o
5850
5851!------------------------------------------------------------------------------!
5852! Description:
5853! ------------
5854!> Calculates the activity coefficient of liquid water
5855!------------------------------------------------------------------------------!
5856 REAL(wp) FUNCTION acth2o( ppart, pcw )
5857
5858    IMPLICIT NONE
5859
5860    REAL(wp) ::  zns  !< molar concentration of solutes (mol/m3)
5861    REAL(wp) ::  znw  !< molar concentration of water (mol/m3)
5862
5863    REAL(wp), INTENT(in), OPTIONAL ::  pcw !< molar concentration of water (mol/m3)
5864
5865    TYPE(t_section), INTENT(in) ::  ppart !< Aerosol properties of a bin
5866
5867    zns = ( 3.0_wp * ( ppart%volc(1) * arhoh2so4 / amh2so4 ) + ( ppart%volc(2) * arhooc / amoc ) + &
5868            2.0_wp * ( ppart%volc(5) * arhoss / amss ) + ( ppart%volc(6) * arhohno3 / amhno3 ) +   &
5869            ( ppart%volc(7) * arhonh3 / amnh3 ) )
5870
5871    IF ( PRESENT(pcw) ) THEN
5872       znw = pcw
5873    ELSE
5874       znw = ppart%volc(8) * arhoh2o / amh2o
5875    ENDIF
5876!
5877!-- Activity = partial pressure of water vapour / sat. vapour pressure of water over a liquid surface
5878!--          = molality * activity coefficient (Jacobson, 2005: eq. 17.20-21)
5879!-- Assume activity coefficient of 1 for water
5880    acth2o = MAX( 0.1_wp, znw / MAX( EPSILON( 1.0_wp ),( znw + zns ) ) )
5881
5882 END FUNCTION acth2o
5883
5884!------------------------------------------------------------------------------!
5885! Description:
5886! ------------
5887!> Calculates the dissolutional growth of particles (i.e. gas transfers to a
5888!> particle surface and dissolves in liquid water on the surface). Treated here
5889!> as a non-equilibrium (time-dependent) process. Gases: HNO3 and NH3
5890!> (Chapter 17.14 in Jacobson, 2005).
5891!
5892!> Called from subroutine condensation.
5893!> Coded by:
5894!> Harri Kokkola (FMI)
5895!------------------------------------------------------------------------------!
5896 SUBROUTINE gpparthno3( ppres, ptemp, paero, pghno3, pgnh3, pcw, pcs, pbeta, ptstep )
5897
5898    IMPLICIT NONE
5899
5900    INTEGER(iwp) ::  ib  !< loop index
5901
5902    REAL(wp) ::  adt          !< timestep
5903    REAL(wp) ::  zc_nh3_c     !< Current NH3 gas concentration
5904    REAL(wp) ::  zc_nh3_int   !< Intermediate NH3 gas concentration
5905    REAL(wp) ::  zc_nh3_n     !< New NH3 gas concentration
5906    REAL(wp) ::  zc_nh3_tot   !< Total NH3 concentration
5907    REAL(wp) ::  zc_hno3_c    !< Current HNO3 gas concentration
5908    REAL(wp) ::  zc_hno3_int  !< Intermediate HNO3 gas concentration
5909    REAL(wp) ::  zc_hno3_n    !< New HNO3 gas concentration
5910    REAL(wp) ::  zc_hno3_tot  !< Total HNO3 concentration
5911    REAL(wp) ::  zdfvap       !< Diffusion coefficient for vapors
5912    REAL(wp) ::  zhlp1        !< intermediate variable
5913    REAL(wp) ::  zhlp2        !< intermediate variable
5914    REAL(wp) ::  zrh          !< relative humidity
5915
5916    REAL(wp), INTENT(in) ::  ppres      !< ambient pressure (Pa)
5917    REAL(wp), INTENT(in) ::  pcs        !< water vapour saturation
5918                                        !< concentration (kg/m3)
5919    REAL(wp), INTENT(in) ::  ptemp      !< ambient temperature (K)
5920    REAL(wp), INTENT(in) ::  ptstep     !< time step (s)
5921
5922    REAL(wp), INTENT(inout) ::  pghno3  !< nitric acid concentration (#/m3)
5923    REAL(wp), INTENT(inout) ::  pgnh3   !< ammonia conc. (#/m3)
5924    REAL(wp), INTENT(inout) ::  pcw     !< water vapour concentration (kg/m3)
5925
5926    REAL(wp), DIMENSION(nbins_aerosol) ::  zac_hno3_ae     !< Activity coefficients for HNO3
5927    REAL(wp), DIMENSION(nbins_aerosol) ::  zac_hhso4_ae    !< Activity coefficients for HHSO4
5928    REAL(wp), DIMENSION(nbins_aerosol) ::  zac_nh3_ae      !< Activity coefficients for NH3
5929    REAL(wp), DIMENSION(nbins_aerosol) ::  zac_nh4hso2_ae  !< Activity coefficients for NH4HSO2
5930    REAL(wp), DIMENSION(nbins_aerosol) ::  zcg_hno3_eq_ae  !< Equilibrium gas concentration: HNO3
5931    REAL(wp), DIMENSION(nbins_aerosol) ::  zcg_nh3_eq_ae   !< Equilibrium gas concentration: NH3
5932    REAL(wp), DIMENSION(nbins_aerosol) ::  zc_hno3_int_ae  !< Intermediate HNO3 aerosol concentration
5933    REAL(wp), DIMENSION(nbins_aerosol) ::  zc_hno3_c_ae    !< Current HNO3 in aerosols
5934    REAL(wp), DIMENSION(nbins_aerosol) ::  zc_hno3_n_ae    !< New HNO3 in aerosols
5935    REAL(wp), DIMENSION(nbins_aerosol) ::  zc_nh3_int_ae   !< Intermediate NH3 aerosol concentration
5936    REAL(wp), DIMENSION(nbins_aerosol) ::  zc_nh3_c_ae     !< Current NH3 in aerosols
5937    REAL(wp), DIMENSION(nbins_aerosol) ::  zc_nh3_n_ae     !< New NH3 in aerosols
5938    REAL(wp), DIMENSION(nbins_aerosol) ::  zkel_hno3_ae    !< Kelvin effect for HNO3
5939    REAL(wp), DIMENSION(nbins_aerosol) ::  zkel_nh3_ae     !< Kelvin effects for NH3
5940    REAL(wp), DIMENSION(nbins_aerosol) ::  zmt_hno3_ae     !< Mass transfer coefficients for HNO3
5941    REAL(wp), DIMENSION(nbins_aerosol) ::  zmt_nh3_ae      !< Mass transfer coefficients for NH3
5942    REAL(wp), DIMENSION(nbins_aerosol) ::  zsat_hno3_ae    !< HNO3 saturation ratio over a surface
5943    REAL(wp), DIMENSION(nbins_aerosol) ::  zsat_nh3_ae     !< NH3 saturation ratio over a surface
5944
5945    REAL(wp), DIMENSION(nbins_aerosol,maxspec) ::  zion_mols   !< Ion molalities from pdfite aerosols
5946
5947    REAL(wp), DIMENSION(nbins_aerosol), INTENT(in) ::  pbeta !< transitional correction factor for
5948
5949    TYPE(t_section), DIMENSION(nbins_aerosol), INTENT(inout) ::  paero !< Aerosol properties
5950!
5951!-- Initialise:
5952    adt            = ptstep
5953    zac_hhso4_ae   = 0.0_wp
5954    zac_nh3_ae     = 0.0_wp
5955    zac_nh4hso2_ae = 0.0_wp
5956    zac_hno3_ae    = 0.0_wp
5957    zcg_nh3_eq_ae  = 0.0_wp
5958    zcg_hno3_eq_ae = 0.0_wp
5959    zion_mols      = 0.0_wp
5960    zsat_nh3_ae    = 1.0_wp
5961    zsat_hno3_ae   = 1.0_wp
5962!
5963!-- Diffusion coefficient (m2/s)
5964    zdfvap = 5.1111E-10_wp * ptemp**1.75_wp * ( p_0 + 1325.0_wp ) / ppres
5965!
5966!-- Kelvin effects (Jacobson (2005), eq. 16.33)
5967    zkel_hno3_ae(1:nbins_aerosol) = EXP( 4.0_wp * surfw0 * amvhno3 /                               &
5968                                    ( abo * ptemp * paero(1:nbins_aerosol)%dwet ) )
5969    zkel_nh3_ae(1:nbins_aerosol) = EXP( 4.0_wp * surfw0 * amvnh3 /                                 &
5970                                   ( abo * ptemp * paero(1:nbins_aerosol)%dwet ) )
5971!
5972!-- Current vapour mole concentrations (mol/m3)
5973    zc_hno3_c = pghno3 / avo  ! HNO3
5974    zc_nh3_c = pgnh3 / avo   ! NH3
5975!
5976!-- Current particle mole concentrations (mol/m3)
5977    zc_hno3_c_ae(1:nbins_aerosol) = paero(1:nbins_aerosol)%volc(6) * arhohno3 / amhno3
5978    zc_nh3_c_ae(1:nbins_aerosol) = paero(1:nbins_aerosol)%volc(7) * arhonh3 / amnh3
5979!
5980!-- Total mole concentrations: gas and particle phase
5981    zc_hno3_tot = zc_hno3_c + SUM( zc_hno3_c_ae(1:nbins_aerosol) )
5982    zc_nh3_tot = zc_nh3_c + SUM( zc_nh3_c_ae(1:nbins_aerosol) )
5983!
5984!-- Relative humidity [0-1]
5985    zrh = pcw / pcs
5986!
5987!-- Mass transfer coefficients (Jacobson, Eq. 16.64)
5988    zmt_hno3_ae(:) = 2.0_wp * pi * paero(:)%dwet * zdfvap * paero(:)%numc * pbeta(:)
5989    zmt_nh3_ae(:)  = 2.0_wp * pi * paero(:)%dwet * zdfvap * paero(:)%numc * pbeta(:)
5990
5991!
5992!-- Get the equilibrium concentrations above aerosols
5993    CALL nitrate_ammonium_equilibrium( zrh, ptemp, paero, zcg_hno3_eq_ae, zcg_nh3_eq_ae,           &
5994                                       zac_hno3_ae, zac_nh3_ae, zac_nh4hso2_ae, zac_hhso4_ae,      &
5995                                       zion_mols )
5996!
5997!-- Calculate NH3 and HNO3 saturation ratios for aerosols
5998    CALL nitrate_ammonium_saturation( ptemp, paero, zac_hno3_ae, zac_nh4hso2_ae, zac_hhso4_ae,     &
5999                                      zcg_hno3_eq_ae, zc_hno3_c_ae, zc_nh3_c_ae, zkel_hno3_ae,     &
6000                                      zkel_nh3_ae, zsat_hno3_ae, zsat_nh3_ae )
6001!
6002!-- Intermediate gas concentrations of HNO3 and NH3
6003    zhlp1 = SUM( zc_hno3_c_ae(:) / ( 1.0_wp + adt * zmt_hno3_ae(:) * zsat_hno3_ae(:) ) )
6004    zhlp2 = SUM( zmt_hno3_ae(:) / ( 1.0_wp + adt * zmt_hno3_ae(:) * zsat_hno3_ae(:) ) )
6005    zc_hno3_int = ( zc_hno3_tot - zhlp1 ) / ( 1.0_wp + adt * zhlp2 )
6006
6007    zhlp1 = SUM( zc_nh3_c_ae(:) / ( 1.0_wp + adt * zmt_nh3_ae(:) * zsat_nh3_ae(:) ) )
6008    zhlp2 = SUM( zmt_nh3_ae(:) / ( 1.0_wp + adt * zmt_nh3_ae(:) * zsat_nh3_ae(:) ) )
6009    zc_nh3_int = ( zc_nh3_tot - zhlp1 )/( 1.0_wp + adt * zhlp2 )
6010
6011    zc_hno3_int = MIN( zc_hno3_int, zc_hno3_tot )
6012    zc_nh3_int = MIN( zc_nh3_int, zc_nh3_tot )
6013!
6014!-- Calculate the new concentration on aerosol particles
6015    zc_hno3_int_ae = zc_hno3_c_ae
6016    zc_nh3_int_ae = zc_nh3_c_ae
6017    DO  ib = 1, nbins_aerosol
6018       zc_hno3_int_ae(ib) = ( zc_hno3_c_ae(ib) + adt * zmt_hno3_ae(ib) * zc_hno3_int ) /           &
6019                            ( 1.0_wp + adt * zmt_hno3_ae(ib) * zsat_hno3_ae(ib) )
6020       zc_nh3_int_ae(ib) = ( zc_nh3_c_ae(ib) + adt * zmt_nh3_ae(ib) * zc_nh3_int ) /               &
6021                           ( 1.0_wp + adt * zmt_nh3_ae(ib) * zsat_nh3_ae(ib) )
6022    ENDDO
6023
6024    zc_hno3_int_ae(:) = MAX( zc_hno3_int_ae(:), 0.0_wp )
6025    zc_nh3_int_ae(:) = MAX( zc_nh3_int_ae(:), 0.0_wp )
6026!
6027!-- Final molar gas concentration and molar particle concentration of HNO3
6028    zc_hno3_n   = zc_hno3_int
6029    zc_hno3_n_ae = zc_hno3_int_ae
6030!
6031!-- Final molar gas concentration and molar particle concentration of NH3
6032    zc_nh3_n   = zc_nh3_int
6033    zc_nh3_n_ae = zc_nh3_int_ae
6034!
6035!-- Model timestep reached - update the gas concentrations
6036    pghno3 = zc_hno3_n * avo
6037    pgnh3  = zc_nh3_n * avo
6038!
6039!-- Update the particle concentrations
6040    DO  ib = start_subrange_1a, end_subrange_2b
6041       paero(ib)%volc(6) = zc_hno3_n_ae(ib) * amhno3 / arhohno3
6042       paero(ib)%volc(7) = zc_nh3_n_ae(ib) * amnh3 / arhonh3
6043    ENDDO
6044
6045 END SUBROUTINE gpparthno3
6046!------------------------------------------------------------------------------!
6047! Description:
6048! ------------
6049!> Calculate the equilibrium concentrations above aerosols (reference?)
6050!------------------------------------------------------------------------------!
6051 SUBROUTINE nitrate_ammonium_equilibrium( prh, ptemp, ppart, pcg_hno3_eq, pcg_nh3_eq, pgamma_hno3, &
6052                                          pgamma_nh4, pgamma_nh4hso2, pgamma_hhso4, pmols )
6053
6054    IMPLICIT NONE
6055
6056    INTEGER(iwp) ::  ib  !< loop index: aerosol bins
6057
6058    REAL(wp) ::  zhlp         !< intermediate variable
6059    REAL(wp) ::  zp_hcl       !< Equilibrium vapor pressures (Pa) of HCl
6060    REAL(wp) ::  zp_hno3      !< Equilibrium vapor pressures (Pa) of HNO3
6061    REAL(wp) ::  zp_nh3       !< Equilibrium vapor pressures (Pa) of NH3
6062    REAL(wp) ::  zwatertotal  !< Total water in particles (mol/m3)
6063
6064    REAL(wp), INTENT(in) ::  prh    !< relative humidity
6065    REAL(wp), INTENT(in) ::  ptemp  !< ambient temperature (K)
6066
6067    REAL(wp), DIMENSION(maxspec) ::  zgammas  !< Activity coefficients
6068    REAL(wp), DIMENSION(maxspec) ::  zions    !< molar concentration of ion (mol/m3)
6069
6070    REAL(wp), DIMENSION(nbins_aerosol), INTENT(inout) ::  pcg_nh3_eq      !< equilibrium molar
6071                                                                          !< concentration: of NH3
6072    REAL(wp), DIMENSION(nbins_aerosol), INTENT(inout) ::  pcg_hno3_eq     !< of HNO3
6073    REAL(wp), DIMENSION(nbins_aerosol), INTENT(inout) ::  pgamma_hhso4    !< activity coeff. of HHSO4
6074    REAL(wp), DIMENSION(nbins_aerosol), INTENT(inout) ::  pgamma_nh4      !< activity coeff. of NH3
6075    REAL(wp), DIMENSION(nbins_aerosol), INTENT(inout) ::  pgamma_nh4hso2  !< activity coeff. of NH4HSO2
6076    REAL(wp), DIMENSION(nbins_aerosol), INTENT(inout) ::  pgamma_hno3     !< activity coeff. of HNO3
6077
6078    REAL(wp), DIMENSION(nbins_aerosol,maxspec), INTENT(inout) ::  pmols  !< Ion molalities
6079
6080    TYPE(t_section), DIMENSION(nbins_aerosol), INTENT(inout) ::  ppart  !< Aerosol properties
6081
6082    zgammas     = 0.0_wp
6083    zhlp        = 0.0_wp
6084    zions       = 0.0_wp
6085    zp_hcl      = 0.0_wp
6086    zp_hno3     = 0.0_wp
6087    zp_nh3      = 0.0_wp
6088    zwatertotal = 0.0_wp
6089
6090    DO  ib = 1, nbins_aerosol
6091
6092       IF ( ppart(ib)%numc < nclim )  CYCLE
6093!
6094!--    Ion molar concentrations: 2*H2SO4 + CL + NO3 - Na - NH4
6095       zhlp = 2.0_wp * ppart(ib)%volc(1) * arhoh2so4 / amh2so4 + ppart(ib)%volc(5) * arhoss / amss &
6096              + ppart(ib)%volc(6) * arhohno3 / amhno3 - ppart(ib)%volc(5) * arhoss / amss -        &
6097              ppart(ib)%volc(7) * arhonh3 / amnh3
6098
6099       zions(1) = zhlp                                   ! H+
6100       zions(2) = ppart(ib)%volc(7) * arhonh3 / amnh3     ! NH4+
6101       zions(3) = ppart(ib)%volc(5) * arhoss / amss       ! Na+
6102       zions(4) = ppart(ib)%volc(1) * arhoh2so4 / amh2so4 ! SO4(2-)
6103       zions(5) = 0.0_wp                                 ! HSO4-
6104       zions(6) = ppart(ib)%volc(6) * arhohno3 / amhno3   ! NO3-
6105       zions(7) = ppart(ib)%volc(5) * arhoss / amss       ! Cl-
6106
6107       zwatertotal = ppart(ib)%volc(8) * arhoh2o / amh2o
6108       IF ( zwatertotal > 1.0E-30_wp )  THEN
6109          CALL inorganic_pdfite( prh, ptemp, zions, zwatertotal, zp_hno3, zp_hcl, zp_nh3, zgammas, &
6110                                 pmols(ib,:) )
6111       ENDIF
6112!
6113!--    Activity coefficients
6114       pgamma_hno3(ib)    = zgammas(1)  ! HNO3
6115       pgamma_nh4(ib)     = zgammas(3)  ! NH3
6116       pgamma_nh4hso2(ib) = zgammas(6)  ! NH4HSO2
6117       pgamma_hhso4(ib)   = zgammas(7)  ! HHSO4
6118!
6119!--    Equilibrium molar concentrations (mol/m3) from equlibrium pressures (Pa)
6120       pcg_hno3_eq(ib) = zp_hno3 / ( argas * ptemp )
6121       pcg_nh3_eq(ib) = zp_nh3 / ( argas * ptemp )
6122
6123    ENDDO
6124
6125  END SUBROUTINE nitrate_ammonium_equilibrium
6126
6127!------------------------------------------------------------------------------!
6128! Description:
6129! ------------
6130!> Calculate saturation ratios of NH4 and HNO3 for aerosols
6131!------------------------------------------------------------------------------!
6132 SUBROUTINE nitrate_ammonium_saturation( ptemp, ppart, pachno3, pacnh4hso2, pachhso4, pchno3eq,    &
6133                                         pchno3, pc_nh3, pkelhno3, pkelnh3, psathno3, psatnh3 )
6134
6135    IMPLICIT NONE
6136
6137    INTEGER(iwp) :: ib   !< running index for aerosol bins
6138
6139    REAL(wp) ::  k_ll_h2o   !< equilibrium constants of equilibrium reactions:
6140                            !< H2O(aq) <--> H+ + OH- (mol/kg)
6141    REAL(wp) ::  k_ll_nh3   !< NH3(aq) + H2O(aq) <--> NH4+ + OH- (mol/kg)
6142    REAL(wp) ::  k_gl_nh3   !< NH3(g) <--> NH3(aq) (mol/kg/atm)
6143    REAL(wp) ::  k_gl_hno3  !< HNO3(g) <--> H+ + NO3- (mol2/kg2/atm)
6144    REAL(wp) ::  zmol_no3   !< molality of NO3- (mol/kg)
6145    REAL(wp) ::  zmol_h     !< molality of H+ (mol/kg)
6146    REAL(wp) ::  zmol_so4   !< molality of SO4(2-) (mol/kg)
6147    REAL(wp) ::  zmol_cl    !< molality of Cl- (mol/kg)
6148    REAL(wp) ::  zmol_nh4   !< molality of NH4+ (mol/kg)
6149    REAL(wp) ::  zmol_na    !< molality of Na+ (mol/kg)
6150    REAL(wp) ::  zhlp1      !< intermediate variable
6151    REAL(wp) ::  zhlp2      !< intermediate variable
6152    REAL(wp) ::  zhlp3      !< intermediate variable
6153    REAL(wp) ::  zxi        !< particle mole concentration ratio: (NH3+SS)/H2SO4
6154    REAL(wp) ::  zt0        !< reference temp
6155
6156    REAL(wp), PARAMETER ::  a1 = -22.52_wp     !<
6157    REAL(wp), PARAMETER ::  a2 = -1.50_wp      !<
6158    REAL(wp), PARAMETER ::  a3 = 13.79_wp      !<
6159    REAL(wp), PARAMETER ::  a4 = 29.17_wp      !<
6160    REAL(wp), PARAMETER ::  b1 = 26.92_wp      !<
6161    REAL(wp), PARAMETER ::  b2 = 26.92_wp      !<
6162    REAL(wp), PARAMETER ::  b3 = -5.39_wp      !<
6163    REAL(wp), PARAMETER ::  b4 = 16.84_wp      !<
6164    REAL(wp), PARAMETER ::  K01 = 1.01E-14_wp  !<
6165    REAL(wp), PARAMETER ::  K02 = 1.81E-5_wp   !<
6166    REAL(wp), PARAMETER ::  K03 = 57.64_wp     !<
6167    REAL(wp), PARAMETER ::  K04 = 2.51E+6_wp   !<
6168
6169    REAL(wp), INTENT(in) ::  ptemp  !< ambient temperature (K)
6170
6171    REAL(wp), DIMENSION(nbins_aerosol), INTENT(in) ::  pachhso4    !< activity coeff. of HHSO4
6172    REAL(wp), DIMENSION(nbins_aerosol), INTENT(in) ::  pacnh4hso2  !< activity coeff. of NH4HSO2
6173    REAL(wp), DIMENSION(nbins_aerosol), INTENT(in) ::  pachno3     !< activity coeff. of HNO3
6174    REAL(wp), DIMENSION(nbins_aerosol), INTENT(in) ::  pchno3eq    !< eq. surface concentration: HNO3
6175    REAL(wp), DIMENSION(nbins_aerosol), INTENT(in) ::  pchno3      !< current particle mole
6176                                                                   !< concentration of HNO3 (mol/m3)
6177    REAL(wp), DIMENSION(nbins_aerosol), INTENT(in) ::  pc_nh3      !< of NH3 (mol/m3)
6178    REAL(wp), DIMENSION(nbins_aerosol), INTENT(in) ::  pkelhno3    !< Kelvin effect for HNO3
6179    REAL(wp), DIMENSION(nbins_aerosol), INTENT(in) ::  pkelnh3     !< Kelvin effect for NH3
6180
6181    REAL(wp), DIMENSION(nbins_aerosol), INTENT(out) ::  psathno3 !< saturation ratio of HNO3
6182    REAL(wp), DIMENSION(nbins_aerosol), INTENT(out) ::  psatnh3  !< saturation ratio of NH3
6183
6184    TYPE(t_section), DIMENSION(nbins_aerosol), INTENT(inout) ::  ppart  !< Aerosol properties
6185
6186    zmol_cl  = 0.0_wp
6187    zmol_h   = 0.0_wp
6188    zmol_na  = 0.0_wp
6189    zmol_nh4 = 0.0_wp
6190    zmol_no3 = 0.0_wp
6191    zmol_so4 = 0.0_wp
6192    zt0      = 298.15_wp
6193    zxi      = 0.0_wp
6194!
6195!-- Calculates equlibrium rate constants based on Table B.7 in Jacobson (2005):
6196!-- K^ll_H20, K^ll_NH3, K^gl_NH3, K^gl_HNO3
6197    zhlp1 = zt0 / ptemp
6198    zhlp2 = zhlp1 - 1.0_wp
6199    zhlp3 = 1.0_wp + LOG( zhlp1 ) - zhlp1
6200
6201    k_ll_h2o  = K01 * EXP( a1 * zhlp2 + b1 * zhlp3 )
6202    k_ll_nh3  = K02 * EXP( a2 * zhlp2 + b2 * zhlp3 )
6203    k_gl_nh3  = K03 * EXP( a3 * zhlp2 + b3 * zhlp3 )
6204    k_gl_hno3 = K04 * EXP( a4 * zhlp2 + b4 * zhlp3 )
6205
6206    DO  ib = 1, nbins_aerosol
6207
6208       IF ( ppart(ib)%numc > nclim  .AND.  ppart(ib)%volc(8) > 1.0E-30_wp  )  THEN
6209!
6210!--       Molality of H+ and NO3-
6211          zhlp1 = pc_nh3(ib) * amnh3 + ppart(ib)%volc(1) * arhoh2so4 + ppart(ib)%volc(2) * arhooc  &
6212                  + ppart(ib)%volc(5) * arhoss + ppart(ib)%volc(8) * arhoh2o
6213          zmol_no3 = pchno3(ib) / zhlp1  !< mol/kg
6214!
6215!--       Particle mole concentration ratio: (NH3+SS)/H2SO4
6216          zxi = ( pc_nh3(ib) + ppart(ib)%volc(5) * arhoss / amss ) / ( ppart(ib)%volc(1) *         &
6217                  arhoh2so4 / amh2so4 )
6218
6219          IF ( zxi <= 2.0_wp )  THEN
6220!
6221!--          Molality of SO4(2-)
6222             zhlp1 = pc_nh3(ib) * amnh3 + pchno3(ib) * amhno3 + ppart(ib)%volc(2) * arhooc +       &
6223                     ppart(ib)%volc(5) * arhoss + ppart(ib)%volc(8) * arhoh2o
6224             zmol_so4 = ( ppart(ib)%volc(1) * arhoh2so4 / amh2so4 ) / zhlp1
6225!
6226!--          Molality of Cl-
6227             zhlp1 = pc_nh3(ib) * amnh3 + pchno3(ib) * amhno3 + ppart(ib)%volc(2) * arhooc +       &
6228                     ppart(ib)%volc(1) * arhoh2so4 + ppart(ib)%volc(8) * arhoh2o
6229             zmol_cl = ( ppart(ib)%volc(5) * arhoss / amss ) / zhlp1
6230!
6231!--          Molality of NH4+
6232             zhlp1 =  pchno3(ib) * amhno3 + ppart(ib)%volc(1) * arhoh2so4 + ppart(ib)%volc(2) *    &
6233                      arhooc + ppart(ib)%volc(5) * arhoss + ppart(ib)%volc(8) * arhoh2o
6234             zmol_nh4 = pc_nh3(ib) / zhlp1
6235!
6236!--          Molality of Na+
6237             zmol_na = zmol_cl
6238!
6239!--          Molality of H+
6240             zmol_h = 2.0_wp * zmol_so4 + zmol_no3 + zmol_cl - ( zmol_nh4 + zmol_na )
6241
6242          ELSE
6243
6244             zhlp2 = pkelhno3(ib) * zmol_no3 * pachno3(ib)**2
6245
6246             IF ( zhlp2 > 1.0E-30_wp )  THEN
6247                zmol_h = k_gl_hno3 * pchno3eq(ib) / zhlp2 ! Eq. 17.38
6248             ELSE
6249                zmol_h = 0.0_wp
6250             ENDIF
6251
6252          ENDIF
6253
6254          zhlp1 = ppart(ib)%volc(8) * arhoh2o * argas * ptemp * k_gl_hno3
6255!
6256!--       Saturation ratio for NH3 and for HNO3
6257          IF ( zmol_h > 0.0_wp )  THEN
6258             zhlp2 = pkelnh3(ib) / ( zhlp1 * zmol_h )
6259             zhlp3 = k_ll_h2o / ( k_ll_nh3 + k_gl_nh3 )
6260             psatnh3(ib) = zhlp2 * ( ( pacnh4hso2(ib) / pachhso4(ib) )**2 ) * zhlp3
6261             psathno3(ib) = ( pkelhno3(ib) * zmol_h * pachno3(ib)**2 ) / zhlp1
6262          ELSE
6263             psatnh3(ib) = 1.0_wp
6264             psathno3(ib) = 1.0_wp
6265          ENDIF
6266       ELSE
6267          psatnh3(ib) = 1.0_wp
6268          psathno3(ib) = 1.0_wp
6269       ENDIF
6270
6271    ENDDO
6272
6273  END SUBROUTINE nitrate_ammonium_saturation
6274
6275!------------------------------------------------------------------------------!
6276! Description:
6277! ------------
6278!> Prototype module for calculating the water content of a mixed inorganic/
6279!> organic particle + equilibrium water vapour pressure above the solution
6280!> (HNO3, HCL, NH3 and representative organic compounds. Efficient calculation
6281!> of the partitioning of species between gas and aerosol. Based in a chamber
6282!> study.
6283!
6284!> Written by Dave Topping. Pure organic component properties predicted by Mark
6285!> Barley based on VOCs predicted in MCM simulations performed by Mike Jenkin.
6286!> Delivered by Gordon McFiggans as Deliverable D22 from WP1.4 in the EU FP6
6287!> EUCAARI Integrated Project.
6288!
6289!> REFERENCES
6290!> Clegg et al. (1998) A Thermodynamic Model of the System H+-NH4+-Na+-SO42- -NO3--Cl--H2O at
6291!>    298.15 K, J. Phys. Chem., 102A, 2155-2171.
6292!> Clegg et al. (2001) Thermodynamic modelling of aqueous aerosols containing electrolytes and
6293!>    dissolved organic compounds. Journal of Aerosol Science 2001;32(6):713-738.
6294!> Topping et al. (2005a) A curved multi-component aerosol hygroscopicity model framework: Part 1 -
6295!>    Inorganic compounds. Atmospheric Chemistry and Physics 2005;5:1205-1222.
6296!> Topping et al. (2005b) A curved multi-component aerosol hygroscopicity model framework: Part 2 -
6297!>    Including organic compounds. Atmospheric Chemistry and Physics 2005;5:1223-1242.
6298!> Wagman et al. (1982). The NBS tables of chemical thermodynamic properties: selected values for
6299!>    inorganic and C₁ and C₂ organic substances in SI units (book)
6300!> Zaveri et al. (2005). A new method for multicomponent activity coefficients of electrolytes in
6301!>    aqueous atmospheric aerosols, JGR, 110, D02201, 2005.
6302!
6303!> Queries concerning the use of this code through Gordon McFiggans,
6304!> g.mcfiggans@manchester.ac.uk,
6305!> Ownership: D. Topping, Centre for Atmospheric Sciences, University of
6306!> Manchester, 2007
6307!
6308!> Rewritten to PALM by Mona Kurppa, UHel, 2017
6309!------------------------------------------------------------------------------!
6310 SUBROUTINE inorganic_pdfite( rh, temp, ions, water_total, press_hno3, press_hcl, press_nh3,       &
6311                              gamma_out, mols_out )
6312
6313    IMPLICIT NONE
6314
6315    INTEGER(iwp) ::  binary_case
6316    INTEGER(iwp) ::  full_complexity
6317
6318    REAL(wp) ::  a                         !< auxiliary variable
6319    REAL(wp) ::  act_product               !< ionic activity coef. product:
6320                                           !< = (gamma_h2so4**3d0) / gamma_hhso4**2d0)
6321    REAL(wp) ::  ammonium_chloride         !<
6322    REAL(wp) ::  ammonium_chloride_eq_frac !<
6323    REAL(wp) ::  ammonium_nitrate          !<
6324    REAL(wp) ::  ammonium_nitrate_eq_frac  !<
6325    REAL(wp) ::  ammonium_sulphate         !<
6326    REAL(wp) ::  ammonium_sulphate_eq_frac !<
6327    REAL(wp) ::  b                         !< auxiliary variable
6328    REAL(wp) ::  binary_h2so4              !< binary H2SO4 activity coeff.
6329    REAL(wp) ::  binary_hcl                !< binary HCL activity coeff.
6330    REAL(wp) ::  binary_hhso4              !< binary HHSO4 activity coeff.
6331    REAL(wp) ::  binary_hno3               !< binary HNO3 activity coeff.
6332    REAL(wp) ::  binary_nh4hso4            !< binary NH4HSO4 activity coeff.
6333    REAL(wp) ::  c                         !< auxiliary variable
6334    REAL(wp) ::  charge_sum                !< sum of ionic charges
6335    REAL(wp) ::  gamma_h2so4               !< activity coefficient
6336    REAL(wp) ::  gamma_hcl                 !< activity coefficient
6337    REAL(wp) ::  gamma_hhso4               !< activity coeffient
6338    REAL(wp) ::  gamma_hno3                !< activity coefficient
6339    REAL(wp) ::  gamma_nh3                 !< activity coefficient
6340    REAL(wp) ::  gamma_nh4hso4             !< activity coefficient
6341    REAL(wp) ::  h_out                     !<
6342    REAL(wp) ::  h_real                    !< new hydrogen ion conc.
6343    REAL(wp) ::  h2so4_hcl                 !< contribution of H2SO4
6344    REAL(wp) ::  h2so4_hno3                !< contribution of H2SO4
6345    REAL(wp) ::  h2so4_nh3                 !< contribution of H2SO4
6346    REAL(wp) ::  h2so4_nh4hso4             !< contribution of H2SO4
6347    REAL(wp) ::  hcl_h2so4                 !< contribution of HCL
6348    REAL(wp) ::  hcl_hhso4                 !< contribution of HCL
6349    REAL(wp) ::  hcl_hno3                  !< contribution of HCL
6350    REAL(wp) ::  hcl_nh4hso4               !< contribution of HCL
6351    REAL(wp) ::  henrys_temp_dep           !< temperature dependence of Henry's Law
6352    REAL(wp) ::  hno3_h2so4                !< contribution of HNO3
6353    REAL(wp) ::  hno3_hcl                  !< contribution of HNO3
6354    REAL(wp) ::  hno3_hhso4                !< contribution of HNO3
6355    REAL(wp) ::  hno3_nh3                  !< contribution of HNO3
6356    REAL(wp) ::  hno3_nh4hso4              !< contribution of HNO3
6357    REAL(wp) ::  hso4_out                  !<
6358    REAL(wp) ::  hso4_real                 !< new bisulphate ion conc.
6359    REAL(wp) ::  hydrochloric_acid         !<
6360    REAL(wp) ::  hydrochloric_acid_eq_frac !<
6361    REAL(wp) ::  k_h                       !< equilibrium constant for H+
6362    REAL(wp) ::  k_hcl                     !< equilibrium constant of HCL
6363    REAL(wp) ::  k_hno3                    !< equilibrium constant of HNO3
6364    REAL(wp) ::  k_nh4                     !< equilibrium constant for NH4+
6365    REAL(wp) ::  k_h2o                     !< equil. const. for water_surface
6366    REAL(wp) ::  ln_h2so4_act              !< gamma_h2so4 = EXP(ln_h2so4_act)
6367    REAL(wp) ::  ln_HCL_act                !< gamma_hcl = EXP( ln_HCL_act )
6368    REAL(wp) ::  ln_hhso4_act              !< gamma_hhso4 = EXP(ln_hhso4_act)
6369    REAL(wp) ::  ln_hno3_act               !< gamma_hno3 = EXP( ln_hno3_act )
6370    REAL(wp) ::  ln_nh4hso4_act            !< gamma_nh4hso4 = EXP( ln_nh4hso4_act )
6371    REAL(wp) ::  molality_ratio_nh3        !< molality ratio of NH3 (NH4+ and H+)
6372    REAL(wp) ::  na2so4_h2so4              !< contribution of Na2SO4
6373    REAL(wp) ::  na2so4_hcl                !< contribution of Na2SO4
6374    REAL(wp) ::  na2so4_hhso4              !< contribution of Na2SO4
6375    REAL(wp) ::  na2so4_hno3               !< contribution of Na2SO4
6376    REAL(wp) ::  na2so4_nh3                !< contribution of Na2SO4
6377    REAL(wp) ::  na2so4_nh4hso4            !< contribution of Na2SO4
6378    REAL(wp) ::  nacl_h2so4                !< contribution of NaCl
6379    REAL(wp) ::  nacl_hcl                  !< contribution of NaCl
6380    REAL(wp) ::  nacl_hhso4                !< contribution of NaCl
6381    REAL(wp) ::  nacl_hno3                 !< contribution of NaCl
6382    REAL(wp) ::  nacl_nh3                  !< contribution of NaCl
6383    REAL(wp) ::  nacl_nh4hso4              !< contribution of NaCl
6384    REAL(wp) ::  nano3_h2so4               !< contribution of NaNO3
6385    REAL(wp) ::  nano3_hcl                 !< contribution of NaNO3
6386    REAL(wp) ::  nano3_hhso4               !< contribution of NaNO3
6387    REAL(wp) ::  nano3_hno3                !< contribution of NaNO3
6388    REAL(wp) ::  nano3_nh3                 !< contribution of NaNO3
6389    REAL(wp) ::  nano3_nh4hso4             !< contribution of NaNO3
6390    REAL(wp) ::  nh42so4_h2so4             !< contribution of NH42SO4
6391    REAL(wp) ::  nh42so4_hcl               !< contribution of NH42SO4
6392    REAL(wp) ::  nh42so4_hhso4             !< contribution of NH42SO4
6393    REAL(wp) ::  nh42so4_hno3              !< contribution of NH42SO4
6394    REAL(wp) ::  nh42so4_nh3               !< contribution of NH42SO4
6395    REAL(wp) ::  nh42so4_nh4hso4           !< contribution of NH42SO4
6396    REAL(wp) ::  nh4cl_h2so4               !< contribution of NH4Cl
6397    REAL(wp) ::  nh4cl_hcl                 !< contribution of NH4Cl
6398    REAL(wp) ::  nh4cl_hhso4               !< contribution of NH4Cl
6399    REAL(wp) ::  nh4cl_hno3                !< contribution of NH4Cl
6400    REAL(wp) ::  nh4cl_nh3                 !< contribution of NH4Cl
6401    REAL(wp) ::  nh4cl_nh4hso4             !< contribution of NH4Cl
6402    REAL(wp) ::  nh4no3_h2so4              !< contribution of NH4NO3
6403    REAL(wp) ::  nh4no3_hcl                !< contribution of NH4NO3
6404    REAL(wp) ::  nh4no3_hhso4              !< contribution of NH4NO3
6405    REAL(wp) ::  nh4no3_hno3               !< contribution of NH4NO3
6406    REAL(wp) ::  nh4no3_nh3                !< contribution of NH4NO3
6407    REAL(wp) ::  nh4no3_nh4hso4            !< contribution of NH4NO3
6408    REAL(wp) ::  nitric_acid               !<
6409    REAL(wp) ::  nitric_acid_eq_frac       !< Equivalent fractions
6410    REAL(wp) ::  press_hcl                 !< partial pressure of HCL
6411    REAL(wp) ::  press_hno3                !< partial pressure of HNO3
6412    REAL(wp) ::  press_nh3                 !< partial pressure of NH3
6413    REAL(wp) ::  rh                        !< relative humidity [0-1]
6414    REAL(wp) ::  root1                     !< auxiliary variable
6415    REAL(wp) ::  root2                     !< auxiliary variable
6416    REAL(wp) ::  so4_out                   !<
6417    REAL(wp) ::  so4_real                  !< new sulpate ion concentration
6418    REAL(wp) ::  sodium_chloride           !<
6419    REAL(wp) ::  sodium_chloride_eq_frac   !<
6420    REAL(wp) ::  sodium_nitrate            !<
6421    REAL(wp) ::  sodium_nitrate_eq_frac    !<
6422    REAL(wp) ::  sodium_sulphate           !<
6423    REAL(wp) ::  sodium_sulphate_eq_frac   !<
6424    REAL(wp) ::  solutes                   !<
6425    REAL(wp) ::  sulphuric_acid            !<
6426    REAL(wp) ::  sulphuric_acid_eq_frac    !<
6427    REAL(wp) ::  temp                      !< temperature
6428    REAL(wp) ::  water_total               !<
6429
6430    REAL(wp), DIMENSION(:) ::  gamma_out !< Activity coefficient for calculating the non-ideal
6431                                         !< dissociation constants
6432                                         !< 1: HNO3, 2: HCL, 3: NH4+/H+ (NH3), 4: HHSO4**2/H2SO4,
6433                                         !< 5: H2SO4**3/HHSO4**2, 6: NH4HSO2, 7: HHSO4
6434    REAL(wp), DIMENSION(:) ::  ions      !< ion molarities (mol/m3): 1: H+, 2: NH4+, 3: Na+,
6435                                         !< 4: SO4(2-), 5: HSO4-, 6: NO3-, 7: Cl-
6436    REAL(wp), DIMENSION(7) ::  ions_mol  !< ion molalities (mol/kg): 1: H+, 2: NH4+, 3: Na+,
6437                                         !< 4: SO4(2-), 5: HSO4-, 6: NO3-, 7: Cl-
6438    REAL(wp), DIMENSION(:) ::  mols_out  !< ion molality output (mol/kg): 1: H+, 2: NH4+, 3: Na+,
6439                                         !< 4: SO4(2-), 5: HSO4-, 6: NO3-, 7: Cl-
6440!
6441!-- Value initialisation
6442    binary_h2so4    = 0.0_wp
6443    binary_hcl      = 0.0_wp
6444    binary_hhso4    = 0.0_wp
6445    binary_hno3     = 0.0_wp
6446    binary_nh4hso4  = 0.0_wp
6447    henrys_temp_dep = ( 1.0_wp / temp - 0.0033557_wp ) ! 1/T - 1/298 K
6448    hcl_hno3        = 1.0_wp
6449    h2so4_hno3      = 1.0_wp
6450    nh42so4_hno3    = 1.0_wp
6451    nh4no3_hno3     = 1.0_wp
6452    nh4cl_hno3      = 1.0_wp
6453    na2so4_hno3     = 1.0_wp
6454    nano3_hno3      = 1.0_wp
6455    nacl_hno3       = 1.0_wp
6456    hno3_hcl        = 1.0_wp
6457    h2so4_hcl       = 1.0_wp
6458    nh42so4_hcl     = 1.0_wp
6459    nh4no3_hcl      = 1.0_wp
6460    nh4cl_hcl       = 1.0_wp
6461    na2so4_hcl      = 1.0_wp
6462    nano3_hcl       = 1.0_wp
6463    nacl_hcl        = 1.0_wp
6464    hno3_nh3        = 1.0_wp
6465    h2so4_nh3       = 1.0_wp
6466    nh42so4_nh3     = 1.0_wp
6467    nh4no3_nh3      = 1.0_wp
6468    nh4cl_nh3       = 1.0_wp
6469    na2so4_nh3      = 1.0_wp
6470    nano3_nh3       = 1.0_wp
6471    nacl_nh3        = 1.0_wp
6472    hno3_hhso4      = 1.0_wp
6473    hcl_hhso4       = 1.0_wp
6474    nh42so4_hhso4   = 1.0_wp
6475    nh4no3_hhso4    = 1.0_wp
6476    nh4cl_hhso4     = 1.0_wp
6477    na2so4_hhso4    = 1.0_wp
6478    nano3_hhso4     = 1.0_wp
6479    nacl_hhso4      = 1.0_wp
6480    hno3_h2so4      = 1.0_wp
6481    hcl_h2so4       = 1.0_wp
6482    nh42so4_h2so4   = 1.0_wp
6483    nh4no3_h2so4    = 1.0_wp
6484    nh4cl_h2so4     = 1.0_wp
6485    na2so4_h2so4    = 1.0_wp
6486    nano3_h2so4     = 1.0_wp
6487    nacl_h2so4      = 1.0_wp
6488!
6489!-- New NH3 variables
6490    hno3_nh4hso4    = 1.0_wp
6491    hcl_nh4hso4     = 1.0_wp
6492    h2so4_nh4hso4   = 1.0_wp
6493    nh42so4_nh4hso4 = 1.0_wp
6494    nh4no3_nh4hso4  = 1.0_wp
6495    nh4cl_nh4hso4   = 1.0_wp
6496    na2so4_nh4hso4  = 1.0_wp
6497    nano3_nh4hso4   = 1.0_wp
6498    nacl_nh4hso4    = 1.0_wp
6499!
6500!-- Juha Tonttila added
6501    mols_out   = 0.0_wp
6502    press_hno3 = 0.0_wp  !< Initialising vapour pressures over the
6503    press_hcl  = 0.0_wp  !< multicomponent particle
6504    press_nh3  = 0.0_wp
6505    gamma_out  = 1.0_wp  !< i.e. don't alter the ideal mixing ratios if there's nothing there.
6506!
6507!-- 1) - COMPOSITION DEFINITIONS
6508!
6509!-- a) Inorganic ion pairing:
6510!-- In order to calculate the water content, which is also used in calculating vapour pressures, one
6511!-- needs to pair the anions and cations for use in the ZSR mixing rule. The equation provided by
6512!-- Clegg et al. (2001) is used for ion pairing. The solutes chosen comprise of 9 inorganic salts
6513!-- and acids which provide a pairing between each anion and cation: (NH4)2SO4, NH4NO3, NH4Cl,
6514!-- Na2SO4, NaNO3, NaCl, H2SO4, HNO3, HCL. The organic compound is treated as a seperate solute.
6515!-- Ions: 1: H+, 2: NH4+, 3: Na+, 4: SO4(2-), 5: HSO4-, 6: NO3-, 7: Cl-
6516!
6517    charge_sum = ions(1) + ions(2) + ions(3) + 2.0_wp * ions(4) + ions(5) + ions(6) + ions(7)
6518    nitric_acid       = ( 2.0_wp * ions(1) * ions(6) ) / charge_sum
6519    hydrochloric_acid = ( 2.0_wp * ions(1) * ions(7) ) / charge_sum
6520    sulphuric_acid    = ( 2.0_wp * ions(1) * ions(4) ) / charge_sum
6521    ammonium_sulphate = ( 2.0_wp * ions(2) * ions(4) ) / charge_sum
6522    ammonium_nitrate  = ( 2.0_wp * ions(2) * ions(6) ) / charge_sum
6523    ammonium_chloride = ( 2.0_wp * ions(2) * ions(7) ) / charge_sum
6524    sodium_sulphate   = ( 2.0_wp * ions(3) * ions(4) ) / charge_sum
6525    sodium_nitrate    = ( 2.0_wp * ions(3) * ions(6) ) / charge_sum
6526    sodium_chloride   = ( 2.0_wp * ions(3) * ions(7) ) / charge_sum
6527    solutes = 0.0_wp
6528    solutes = 3.0_wp * sulphuric_acid    + 2.0_wp * hydrochloric_acid + 2.0_wp * nitric_acid +     &
6529              3.0_wp * ammonium_sulphate + 2.0_wp * ammonium_nitrate + 2.0_wp * ammonium_chloride +&
6530              3.0_wp * sodium_sulphate   + 2.0_wp * sodium_nitrate   + 2.0_wp * sodium_chloride
6531!
6532!-- b) Inorganic equivalent fractions:
6533!-- These values are calculated so that activity coefficients can be expressed by a linear additive
6534!-- rule, thus allowing more efficient calculations and future expansion (see more detailed
6535!-- description below)
6536    nitric_acid_eq_frac       = 2.0_wp * nitric_acid / solutes
6537    hydrochloric_acid_eq_frac = 2.0_wp * hydrochloric_acid / solutes
6538    sulphuric_acid_eq_frac    = 3.0_wp * sulphuric_acid / solutes
6539    ammonium_sulphate_eq_frac = 3.0_wp * ammonium_sulphate / solutes
6540    ammonium_nitrate_eq_frac  = 2.0_wp * ammonium_nitrate / solutes
6541    ammonium_chloride_eq_frac = 2.0_wp * ammonium_chloride / solutes
6542    sodium_sulphate_eq_frac   = 3.0_wp * sodium_sulphate / solutes
6543    sodium_nitrate_eq_frac    = 2.0_wp * sodium_nitrate / solutes
6544    sodium_chloride_eq_frac   = 2.0_wp * sodium_chloride / solutes
6545!
6546!-- Inorganic ion molalities
6547    ions_mol(1) = ions(1) / ( water_total * 18.01528E-3_wp )   ! H+
6548    ions_mol(2) = ions(2) / ( water_total * 18.01528E-3_wp )   ! NH4+
6549    ions_mol(3) = ions(3) / ( water_total * 18.01528E-3_wp )   ! Na+
6550    ions_mol(4) = ions(4) / ( water_total * 18.01528E-3_wp )   ! SO4(2-)
6551    ions_mol(5) = ions(5) / ( water_total * 18.01528E-3_wp )   ! HSO4(2-)
6552    ions_mol(6) = ions(6) / ( water_total * 18.01528E-3_wp )   !  NO3-
6553    ions_mol(7) = ions(7) / ( water_total * 18.01528E-3_wp )   ! Cl-
6554
6555!-- ***
6556!-- At this point we may need to introduce a method for prescribing H+ when there is no 'real' value
6557!-- for H+..i.e. in the sulphate poor domain. This will give a value for solve quadratic proposed by
6558!-- Zaveri et al. 2005
6559!
6560!-- 2) - WATER CALCULATION
6561!
6562!-- a) The water content is calculated using the ZSR rule with solute concentrations calculated
6563!-- using 1a above. Whilst the usual approximation of ZSR relies on binary data consisting of 5th or
6564!-- higher order polynomials, in this code 4 different RH regimes are used, each housing cubic
6565!-- equations for the water associated with each solute listed above. Binary water contents for
6566!-- inorganic components were calculated using AIM online (Clegg et al 1998). The water associated
6567!-- with the organic compound is calculated assuming ideality and that aw = RH.
6568!
6569!-- b) Molality of each inorganic ion and organic solute (initial input) is calculated for use in
6570!-- vapour pressure calculation.
6571!
6572!-- 3) - BISULPHATE ION DISSOCIATION CALCULATION
6573!
6574!-- The dissociation of the bisulphate ion is calculated explicitly. A solution to the equilibrium
6575!-- equation between the bisulphate ion, hydrogen ion and sulphate ion is found using tabulated
6576!-- equilibrium constants (referenced). It is necessary to calculate the activity coefficients of
6577!-- HHSO4 and H2SO4 in a non-iterative manner. These are calculated using the same format as
6578!-- described in 4) below, where both activity coefficients were fit to the output from ADDEM
6579!-- (Topping et al 2005a,b) covering an extensive composition space, providing the activity
6580!-- coefficients and bisulphate ion dissociation as a function of equivalent mole fractions and
6581!-- relative humidity.
6582!
6583!-- NOTE: the flags "binary_case" and "full_complexity" are not used in this prototype. They are
6584!-- used for simplification of the fit expressions when using limited composition regions. This
6585!-- section of code calculates the bisulphate ion concentration.
6586!
6587    IF ( ions(1) > 0.0_wp .AND. ions(4) > 0.0_wp ) THEN
6588!
6589!--    HHSO4:
6590       binary_case = 1
6591       IF ( rh > 0.1_wp  .AND.  rh < 0.9_wp )  THEN
6592          binary_hhso4 = -4.9521_wp * rh**3 + 9.2881_wp * rh**2 - 10.777_wp * rh + 6.0534_wp
6593       ELSEIF ( rh >= 0.9_wp  .AND.  rh < 0.955_wp )  THEN
6594          binary_hhso4 = -6.3777_wp * rh + 5.962_wp
6595       ELSEIF ( rh >= 0.955_wp  .AND.  rh < 0.99_wp )  THEN
6596          binary_hhso4 = 2367.2_wp * rh**3 - 6849.7_wp * rh**2 + 6600.9_wp * rh - 2118.7_wp
6597       ELSEIF ( rh >= 0.99_wp  .AND.  rh < 0.9999_wp )  THEN
6598          binary_hhso4 = 3E-7_wp * rh**5 - 2E-5_wp * rh**4 + 0.0004_wp * rh**3 - 0.0035_wp * rh**2 &
6599                         + 0.0123_wp * rh - 0.3025_wp
6600       ENDIF
6601
6602       IF ( nitric_acid > 0.0_wp )  THEN
6603          hno3_hhso4 = -4.2204_wp * rh**4 + 12.193_wp * rh**3 - 12.481_wp * rh**2 + 6.459_wp * rh  &
6604                       - 1.9004_wp
6605       ENDIF
6606
6607       IF ( hydrochloric_acid > 0.0_wp )  THEN
6608          hcl_hhso4 = -54.845_wp * rh**7 + 209.54_wp * rh**6 - 336.59_wp * rh**5 + 294.21_wp *     &
6609                      rh**4 - 150.07_wp * rh**3 + 43.767_wp * rh**2 - 6.5495_wp * rh + 0.60048_wp
6610       ENDIF
6611
6612       IF ( ammonium_sulphate > 0.0_wp )  THEN
6613          nh42so4_hhso4 = 16.768_wp * rh**3 - 28.75_wp * rh**2 + 20.011_wp * rh - 8.3206_wp
6614       ENDIF
6615
6616       IF ( ammonium_nitrate > 0.0_wp )  THEN
6617          nh4no3_hhso4 = -17.184_wp * rh**4 + 56.834_wp * rh**3 - 65.765_wp * rh**2 +              &
6618                         35.321_wp * rh - 9.252_wp
6619       ENDIF
6620
6621       IF (ammonium_chloride > 0.0_wp )  THEN
6622          IF ( rh < 0.2_wp .AND. rh >= 0.1_wp )  THEN
6623             nh4cl_hhso4 = 3.2809_wp * rh - 2.0637_wp
6624          ELSEIF ( rh >= 0.2_wp .AND. rh < 0.99_wp )  THEN
6625             nh4cl_hhso4 = -1.2981_wp * rh**3 + 4.7461_wp * rh**2 - 2.3269_wp * rh - 1.1259_wp
6626          ENDIF
6627       ENDIF
6628
6629       IF ( sodium_sulphate > 0.0_wp )  THEN
6630          na2so4_hhso4 = 118.87_wp * rh**6 - 358.63_wp * rh**5 + 435.85_wp * rh**4 - 272.88_wp *   &
6631                         rh**3 + 94.411_wp * rh**2 - 18.21_wp * rh + 0.45935_wp
6632       ENDIF
6633
6634       IF ( sodium_nitrate > 0.0_wp )  THEN
6635          IF ( rh < 0.2_wp  .AND.  rh >= 0.1_wp )  THEN
6636             nano3_hhso4 = 4.8456_wp * rh - 2.5773_wp
6637          ELSEIF ( rh >= 0.2_wp  .AND.  rh < 0.99_wp )  THEN
6638             nano3_hhso4 = 0.5964_wp * rh**3 - 0.38967_wp * rh**2 + 1.7918_wp * rh - 1.9691_wp
6639          ENDIF
6640       ENDIF
6641
6642       IF ( sodium_chloride > 0.0_wp )  THEN
6643          IF ( rh < 0.2_wp )  THEN
6644             nacl_hhso4 = 0.51995_wp * rh - 1.3981_wp
6645          ELSEIF ( rh >= 0.2_wp  .AND.  rh < 0.99_wp )  THEN
6646             nacl_hhso4 = 1.6539_wp * rh - 1.6101_wp
6647          ENDIF
6648       ENDIF
6649
6650       ln_hhso4_act = binary_hhso4 + nitric_acid_eq_frac * hno3_hhso4 +                            &
6651                      hydrochloric_acid_eq_frac * hcl_hhso4 +                                      &
6652                      ammonium_sulphate_eq_frac * nh42so4_hhso4 +                                  &
6653                      ammonium_nitrate_eq_frac  * nh4no3_hhso4 +                                   &
6654                      ammonium_chloride_eq_frac * nh4cl_hhso4 +                                    &
6655                      sodium_sulphate_eq_frac   * na2so4_hhso4 +                                   &
6656                      sodium_nitrate_eq_frac * nano3_hhso4 + sodium_chloride_eq_frac   * nacl_hhso4
6657
6658       gamma_hhso4 = EXP( ln_hhso4_act )   ! molal activity coefficient of HHSO4
6659
6660!--    H2SO4 (sulphuric acid):
6661       IF ( rh >= 0.1_wp  .AND.  rh < 0.9_wp )  THEN
6662          binary_h2so4 = 2.4493_wp * rh**2 - 6.2326_wp * rh + 2.1763_wp
6663       ELSEIF ( rh >= 0.9_wp  .AND.  rh < 0.98 )  THEN
6664          binary_h2so4 = 914.68_wp * rh**3 - 2502.3_wp * rh**2 + 2281.9_wp * rh - 695.11_wp
6665       ELSEIF ( rh >= 0.98  .AND.  rh < 0.9999 )  THEN
6666          binary_h2so4 = 3.0E-8_wp * rh**4 - 5E-6_wp * rh**3 + 0.0003_wp * rh**2 - 0.0022_wp *     &
6667                         rh - 1.1305_wp
6668       ENDIF
6669
6670       IF ( nitric_acid > 0.0_wp )  THEN
6671          hno3_h2so4 = - 16.382_wp * rh**5 + 46.677_wp * rh**4 - 54.149_wp * rh**3 + 34.36_wp *    &
6672                         rh**2 - 12.54_wp * rh + 2.1368_wp
6673       ENDIF
6674
6675       IF ( hydrochloric_acid > 0.0_wp )  THEN
6676          hcl_h2so4 = - 14.409_wp * rh**5 + 42.804_wp * rh**4 - 47.24_wp * rh**3 + 24.668_wp *     &
6677                        rh**2 - 5.8015_wp * rh + 0.084627_wp
6678       ENDIF
6679
6680       IF ( ammonium_sulphate > 0.0_wp )  THEN
6681          nh42so4_h2so4 = 66.71_wp * rh**5 - 187.5_wp * rh**4 + 210.57_wp * rh**3 - 121.04_wp *    &
6682                          rh**2 + 39.182_wp * rh - 8.0606_wp
6683       ENDIF
6684
6685       IF ( ammonium_nitrate > 0.0_wp )  THEN
6686          nh4no3_h2so4 = - 22.532_wp * rh**4 + 66.615_wp * rh**3 - 74.647_wp * rh**2 + 37.638_wp * &
6687                         rh - 6.9711_wp
6688       ENDIF
6689
6690       IF ( ammonium_chloride > 0.0_wp )  THEN
6691          IF ( rh >= 0.1_wp  .AND.  rh < 0.2_wp )  THEN
6692             nh4cl_h2so4 = - 0.32089_wp * rh + 0.57738_wp
6693          ELSEIF ( rh >= 0.2_wp  .AND.  rh < 0.9_wp )  THEN
6694             nh4cl_h2so4 = 18.089_wp * rh**5 - 51.083_wp * rh**4 + 50.32_wp * rh**3 - 17.012_wp *  &
6695                           rh**2 - 0.93435_wp * rh + 1.0548_wp
6696          ELSEIF ( rh >= 0.9_wp  .AND.  rh < 0.99_wp )  THEN
6697             nh4cl_h2so4 = - 1.5749_wp * rh + 1.7002_wp
6698          ENDIF
6699       ENDIF
6700
6701       IF ( sodium_sulphate > 0.0_wp )  THEN
6702          na2so4_h2so4 = 29.843_wp * rh**4 - 69.417_wp * rh**3 + 61.507_wp * rh**2 - 29.874_wp *   &
6703                         rh + 7.7556_wp
6704       ENDIF
6705
6706       IF ( sodium_nitrate > 0.0_wp )  THEN
6707          nano3_h2so4 = - 122.37_wp * rh**6 + 427.43_wp * rh**5 - 604.68_wp * rh**4 + 443.08_wp *  &
6708                        rh**3 - 178.61_wp * rh**2 + 37.242_wp * rh - 1.9564_wp
6709       ENDIF
6710
6711       IF ( sodium_chloride > 0.0_wp )  THEN
6712          nacl_h2so4 = - 40.288_wp * rh**5 + 115.61_wp * rh**4 - 129.99_wp * rh**3 + 72.652_wp *   &
6713                       rh**2 - 22.124_wp * rh + 4.2676_wp
6714       ENDIF
6715
6716       ln_h2so4_act = binary_h2so4 + nitric_acid_eq_frac * hno3_h2so4 +                            &
6717                      hydrochloric_acid_eq_frac * hcl_h2so4 +                                      &
6718                      ammonium_sulphate_eq_frac * nh42so4_h2so4 +                                  &
6719                      ammonium_nitrate_eq_frac  * nh4no3_h2so4 +                                   &
6720                      ammonium_chloride_eq_frac * nh4cl_h2so4 +                                    &
6721                      sodium_sulphate_eq_frac * na2so4_h2so4 +                                     &
6722                      sodium_nitrate_eq_frac * nano3_h2so4 + sodium_chloride_eq_frac * nacl_h2so4
6723
6724       gamma_h2so4 = EXP( ln_h2so4_act )    ! molal activity coefficient
6725!
6726!--    Export activity coefficients
6727       IF ( gamma_h2so4 > 1.0E-10_wp )  THEN
6728          gamma_out(4) = gamma_hhso4**2 / gamma_h2so4
6729       ENDIF
6730       IF ( gamma_hhso4 > 1.0E-10_wp )  THEN
6731          gamma_out(5) = gamma_h2so4**3 / gamma_hhso4**2
6732       ENDIF
6733!
6734!--    Ionic activity coefficient product
6735       act_product = gamma_h2so4**3 / gamma_hhso4**2
6736!
6737!--    Solve the quadratic equation (i.e. x in ax**2 + bx + c = 0)
6738       a = 1.0_wp
6739       b = -1.0_wp * ( ions(4) + ions(1) + ( ( water_total * 18.0E-3_wp ) /                        &
6740           ( 99.0_wp * act_product ) ) )
6741       c = ions(4) * ions(1)
6742       root1 = ( ( -1.0_wp * b ) + ( ( ( b**2 ) - 4.0_wp * a * c )**0.5_wp ) ) / ( 2.0_wp * a )
6743       root2 = ( ( -1.0_wp * b ) - ( ( ( b**2 ) - 4.0_wp * a * c) **0.5_wp ) ) / ( 2.0_wp * a )
6744
6745       IF ( root1 > ions(1)  .OR.  root1 < 0.0_wp )  THEN
6746          root1 = 0.0_wp
6747       ENDIF
6748
6749       IF ( root2 > ions(1)  .OR.  root2 < 0.0_wp )  THEN
6750          root2 = 0.0_wp
6751       ENDIF
6752!
6753!--    Calculate the new hydrogen ion, bisulphate ion and sulphate ion
6754!--    concentration
6755       h_real    = ions(1)
6756       so4_real  = ions(4)
6757       hso4_real = MAX( root1, root2 )
6758       h_real   = ions(1) - hso4_real
6759       so4_real = ions(4) - hso4_real
6760!
6761!--    Recalculate ion molalities
6762       ions_mol(1) = h_real    / ( water_total * 18.01528E-3_wp )   ! H+
6763       ions_mol(4) = so4_real  / ( water_total * 18.01528E-3_wp )   ! SO4(2-)
6764       ions_mol(5) = hso4_real / ( water_total * 18.01528E-3_wp )   ! HSO4(2-)
6765
6766       h_out    = h_real
6767       hso4_out = hso4_real
6768       so4_out  = so4_real
6769
6770    ELSE
6771       h_out    = ions(1)
6772       hso4_out = 0.0_wp
6773       so4_out  = ions(4)
6774    ENDIF
6775
6776!
6777!-- 4) ACTIVITY COEFFICIENTS -for vapour pressures of HNO3,HCL and NH3
6778!
6779!-- This section evaluates activity coefficients and vapour pressures using the water content
6780!-- calculated above) for each inorganic condensing species: a - HNO3, b - NH3, c - HCL.
6781!-- The following procedure is used: Zaveri et al (2005) found that one could express the variation
6782!-- of activity coefficients linearly in log-space if equivalent mole fractions were used.
6783!-- So, by a taylor series expansion LOG( activity coefficient ) =
6784!--    LOG( binary activity coefficient at a given RH ) +
6785!--    (equivalent mole fraction compound A) *
6786!--    ('interaction' parameter between A and condensing species) +
6787!--    equivalent mole fraction compound B) *
6788!--    ('interaction' parameter between B and condensing species).
6789!-- Here, the interaction parameters have been fit to ADDEM by searching the whole compositon space
6790!-- and fit usign the Levenberg-Marquardt non-linear least squares algorithm.
6791!
6792!-- They are given as a function of RH and vary with complexity ranging from linear to 5th order
6793!-- polynomial expressions, the binary activity coefficients were calculated using AIM online.
6794!-- NOTE: for NH3, no binary activity coefficient was used and the data were fit to the ratio of the
6795!-- activity coefficients for the ammonium and hydrogen ions. Once the activity coefficients are
6796!-- obtained the vapour pressure can be easily calculated using tabulated equilibrium constants
6797!-- (referenced). This procedure differs from that of Zaveri et al (2005) in that it is not assumed
6798!-- one can carry behaviour from binary mixtures in multicomponent systems. To this end we have fit
6799!-- the 'interaction' parameters explicitly to a general inorganic equilibrium model
6800!-- (ADDEM - Topping et al. 2005a,b). Such parameters take into account bisulphate ion dissociation
6801!-- and water content. This also allows us to consider one regime for all composition space, rather
6802!-- than defining sulphate rich and sulphate poor regimes.
6803!-- NOTE: The flags "binary_case" and "full_complexity" are not used in this prototype. They are
6804!-- used for simplification of the fit expressions when using limited composition regions.
6805!
6806!-- a) - ACTIVITY COEFF/VAPOUR PRESSURE - HNO3
6807    IF ( ions(1) > 0.0_wp  .AND.  ions(6) > 0.0_wp )  THEN
6808       binary_case = 1
6809       IF ( rh > 0.1_wp  .AND.  rh < 0.98_wp )  THEN
6810          IF ( binary_case == 1 )  THEN
6811             binary_hno3 = 1.8514_wp * rh**3 - 4.6991_wp * rh**2 + 1.5514_wp * rh + 0.90236_wp
6812          ELSEIF ( binary_case == 2 )  THEN
6813             binary_hno3 = - 1.1751_wp * ( rh**2 ) - 0.53794_wp * rh + 1.2808_wp
6814          ENDIF
6815       ELSEIF ( rh >= 0.98_wp  .AND.  rh < 0.9999_wp )  THEN
6816          binary_hno3 = 1244.69635941351_wp * rh**3 - 2613.93941099991_wp * rh**2 +                &
6817                        1525.0684974546_wp * rh -155.946764059316_wp
6818       ENDIF
6819!
6820!--    Contributions from other solutes
6821       full_complexity = 1
6822       IF ( hydrochloric_acid > 0.0_wp )  THEN   ! HCL
6823          IF ( full_complexity == 1  .OR.  rh < 0.4_wp )  THEN
6824             hcl_hno3 = 16.051_wp * rh**4 - 44.357_wp * rh**3 + 45.141_wp * rh**2 - 21.638_wp *    &
6825                        rh + 4.8182_wp
6826          ELSEIF ( full_complexity == 0  .AND.  rh > 0.4_wp )  THEN
6827             hcl_hno3 = - 1.5833_wp * rh + 1.5569_wp
6828          ENDIF
6829       ENDIF
6830
6831       IF ( sulphuric_acid > 0.0_wp )  THEN   ! H2SO4
6832          IF ( full_complexity == 1  .OR.  rh < 0.4_wp )  THEN
6833             h2so4_hno3 = - 3.0849_wp * rh**3 + 5.9609_wp * rh**2 - 4.468_wp * rh + 1.5658_wp
6834          ELSEIF ( full_complexity == 0  .AND.  rh > 0.4_wp )  THEN
6835             h2so4_hno3 = - 0.93473_wp * rh + 0.9363_wp
6836          ENDIF
6837       ENDIF
6838
6839       IF ( ammonium_sulphate > 0.0_wp )  THEN   ! NH42SO4
6840          nh42so4_hno3 = 16.821_wp * rh**3 - 28.391_wp * rh**2 + 18.133_wp * rh - 6.7356_wp
6841       ENDIF
6842
6843       IF ( ammonium_nitrate > 0.0_wp )  THEN   ! NH4NO3
6844          nh4no3_hno3 = 11.01_wp * rh**3 - 21.578_wp * rh**2 + 14.808_wp * rh - 4.2593_wp
6845       ENDIF
6846
6847       IF ( ammonium_chloride > 0.0_wp )  THEN   ! NH4Cl
6848          IF ( full_complexity == 1  .OR.  rh <= 0.4_wp )  THEN
6849             nh4cl_hno3 = - 1.176_wp * rh**3 + 5.0828_wp * rh**2 - 3.8792_wp * rh - 0.05518_wp
6850          ELSEIF ( full_complexity == 0  .AND.  rh > 0.4_wp )  THEN
6851             nh4cl_hno3 = 2.6219_wp * rh**2 - 2.2609_wp * rh - 0.38436_wp
6852          ENDIF
6853       ENDIF
6854
6855       IF ( sodium_sulphate > 0.0_wp )  THEN   ! Na2SO4
6856          na2so4_hno3 = 35.504_wp * rh**4 - 80.101_wp * rh**3 + 67.326_wp * rh**2 - 28.461_wp *    &
6857                        rh + 5.6016_wp
6858       ENDIF
6859
6860       IF ( sodium_nitrate > 0.0_wp )  THEN   ! NaNO3
6861          IF ( full_complexity == 1 .OR. rh <= 0.4_wp ) THEN
6862             nano3_hno3 = 23.659_wp * rh**5 - 66.917_wp * rh**4 + 74.686_wp * rh**3 - 40.795_wp *  &
6863                          rh**2 + 10.831_wp * rh - 1.4701_wp
6864          ELSEIF ( full_complexity == 0  .AND.  rh > 0.4_wp )  THEN
6865             nano3_hno3 = 14.749_wp * rh**4 - 35.237_wp * rh**3 + 31.196_wp * rh**2 - 12.076_wp *  &
6866                          rh + 1.3605_wp
6867          ENDIF
6868       ENDIF
6869
6870       IF ( sodium_chloride > 0.0_wp )  THEN   ! NaCl
6871          IF ( full_complexity == 1  .OR.  rh <= 0.4_wp )  THEN
6872             nacl_hno3 = 13.682_wp * rh**4 - 35.122_wp * rh**3 + 33.397_wp * rh**2 - 14.586_wp *   &
6873                         rh + 2.6276_wp
6874          ELSEIF ( full_complexity == 0  .AND.  rh > 0.4_wp )  THEN
6875             nacl_hno3 = 1.1882_wp * rh**3 - 1.1037_wp * rh**2 - 0.7642_wp * rh + 0.6671_wp
6876          ENDIF
6877       ENDIF
6878
6879       ln_hno3_act = binary_hno3 + hydrochloric_acid_eq_frac * hcl_hno3 +                          &
6880                     sulphuric_acid_eq_frac    * h2so4_hno3 +                                      &
6881                     ammonium_sulphate_eq_frac * nh42so4_hno3 +                                    &
6882                     ammonium_nitrate_eq_frac  * nh4no3_hno3 +                                     &
6883                     ammonium_chloride_eq_frac * nh4cl_hno3 +                                      &
6884                     sodium_sulphate_eq_frac * na2so4_hno3 +                                       &
6885                     sodium_nitrate_eq_frac * nano3_hno3 + sodium_chloride_eq_frac   * nacl_hno3
6886
6887       gamma_hno3   = EXP( ln_hno3_act )   ! Molal activity coefficient of HNO3
6888       gamma_out(1) = gamma_hno3
6889!
6890!--    Partial pressure calculation
6891!--    k_hno3 = 2.51 * ( 10**6 )
6892!--    k_hno3 = 2.628145923d6 !< calculated by AIM online (Clegg et al 1998) after Chameides (1984)
6893       k_hno3     = 2.6E6_wp * EXP( 8700.0_wp * henrys_temp_dep )
6894       press_hno3 = ( ions_mol(1) * ions_mol(6) * ( gamma_hno3**2 ) ) / k_hno3
6895    ENDIF
6896!
6897!-- b) - ACTIVITY COEFF/VAPOUR PRESSURE - NH3
6898!-- Follow the two solute approach of Zaveri et al. (2005)
6899    IF ( ions(2) > 0.0_wp  .AND.  ions_mol(1) > 0.0_wp )  THEN
6900!
6901!--    NH4HSO4:
6902       binary_nh4hso4 = 56.907_wp * rh**6 - 155.32_wp * rh**5 + 142.94_wp * rh**4 - 32.298_wp *    &
6903                        rh**3 - 27.936_wp * rh**2 + 19.502_wp * rh - 4.2618_wp
6904       IF ( nitric_acid > 0.0_wp)  THEN   ! HNO3
6905          hno3_nh4hso4 = 104.8369_wp * rh**8 - 288.8923_wp * rh**7 + 129.3445_wp * rh**6 +         &
6906                         373.0471_wp * rh**5 - 571.0385_wp * rh**4 + 326.3528_wp * rh**3 -         &
6907                         74.169_wp * rh**2 - 2.4999_wp * rh + 3.17_wp
6908       ENDIF
6909
6910       IF ( hydrochloric_acid > 0.0_wp)  THEN   ! HCL
6911          hcl_nh4hso4 = - 7.9133_wp * rh**8 + 126.6648_wp * rh**7 - 460.7425_wp * rh**6 +          &
6912                         731.606_wp * rh**5 - 582.7467_wp * rh**4 + 216.7197_wp * rh**3 -          &
6913                         11.3934_wp * rh**2 - 17.7728_wp  * rh + 5.75_wp
6914       ENDIF
6915
6916       IF ( sulphuric_acid > 0.0_wp)  THEN   ! H2SO4
6917          h2so4_nh4hso4 = 195.981_wp * rh**8 - 779.2067_wp * rh**7 + 1226.3647_wp * rh**6 -        &
6918                         964.0261_wp * rh**5 + 391.7911_wp * rh**4 - 84.1409_wp  * rh**3 +         &
6919                          20.0602_wp * rh**2 - 10.2663_wp  * rh + 3.5817_wp
6920       ENDIF
6921
6922       IF ( ammonium_sulphate > 0.0_wp)  THEN   ! NH42SO4
6923          nh42so4_nh4hso4 = 617.777_wp * rh**8 -  2547.427_wp * rh**7 + 4361.6009_wp * rh**6 -     &
6924                           4003.162_wp * rh**5 + 2117.8281_wp * rh**4 - 640.0678_wp * rh**3 +      &
6925                            98.0902_wp * rh**2 -    2.2615_wp * rh - 2.3811_wp
6926       ENDIF
6927
6928       IF ( ammonium_nitrate > 0.0_wp)  THEN   ! NH4NO3
6929          nh4no3_nh4hso4 = - 104.4504_wp * rh**8 + 539.5921_wp * rh**7 - 1157.0498_wp * rh**6 +    &
6930                            1322.4507_wp * rh**5 - 852.2475_wp * rh**4 + 298.3734_wp * rh**3 -     &
6931                              47.0309_wp * rh**2 +    1.297_wp * rh - 0.8029_wp
6932       ENDIF
6933
6934       IF ( ammonium_chloride > 0.0_wp)  THEN   ! NH4Cl
6935          nh4cl_nh4hso4 = 258.1792_wp * rh**8 - 1019.3777_wp * rh**7 + 1592.8918_wp * rh**6 -      &
6936                         1221.0726_wp * rh**5 +  442.2548_wp * rh**4 -   43.6278_wp * rh**3 -      &
6937                            7.5282_wp * rh**2 -    3.8459_wp * rh + 2.2728_wp
6938       ENDIF
6939
6940       IF ( sodium_sulphate > 0.0_wp)  THEN   ! Na2SO4
6941          na2so4_nh4hso4 = 225.4238_wp * rh**8 - 732.4113_wp * rh**7 + 843.7291_wp * rh**6 -       &
6942                           322.7328_wp * rh**5 -  88.6252_wp * rh**4 +  72.4434_wp * rh**3 +       &
6943                            22.9252_wp * rh**2 -  25.3954_wp * rh + 4.6971_wp
6944       ENDIF
6945
6946       IF ( sodium_nitrate > 0.0_wp)  THEN   ! NaNO3
6947          nano3_nh4hso4 = 96.1348_wp * rh**8 - 341.6738_wp * rh**7 + 406.5314_wp * rh**6 -         &
6948                          98.5777_wp * rh**5 - 172.8286_wp * rh**4 + 149.3151_wp * rh**3 -         &
6949                          38.9998_wp * rh**2 -   0.2251_wp * rh + 0.4953_wp
6950       ENDIF
6951
6952       IF ( sodium_chloride > 0.0_wp)  THEN   ! NaCl
6953          nacl_nh4hso4 = 91.7856_wp * rh**8 - 316.6773_wp * rh**7 + 358.2703_wp * rh**6 -          &
6954                         68.9142_wp * rh**5 - 156.5031_wp * rh**4 + 116.9592_wp * rh**3 -          &
6955                         22.5271_wp * rh**2 - 3.7716_wp * rh + 1.56_wp
6956       ENDIF
6957
6958       ln_nh4hso4_act = binary_nh4hso4 + nitric_acid_eq_frac * hno3_nh4hso4 +                      &
6959                        hydrochloric_acid_eq_frac * hcl_nh4hso4 +                                  &
6960                        sulphuric_acid_eq_frac * h2so4_nh4hso4 +                                   &
6961                        ammonium_sulphate_eq_frac * nh42so4_nh4hso4 +                              &
6962                        ammonium_nitrate_eq_frac * nh4no3_nh4hso4 +                                &
6963                        ammonium_chloride_eq_frac * nh4cl_nh4hso4 +                                &
6964                        sodium_sulphate_eq_frac * na2so4_nh4hso4 +                                 &
6965                        sodium_nitrate_eq_frac * nano3_nh4hso4 +                                   &
6966                        sodium_chloride_eq_frac * nacl_nh4hso4
6967
6968       gamma_nh4hso4 = EXP( ln_nh4hso4_act ) ! molal act. coefficient of NH4HSO4
6969!
6970!--    Molal activity coefficient of NO3-
6971       gamma_out(6)  = gamma_nh4hso4
6972!
6973!--    Molal activity coefficient of NH4+
6974       gamma_nh3     = gamma_nh4hso4**2 / gamma_hhso4**2
6975       gamma_out(3)  = gamma_nh3
6976!
6977!--    This actually represents the ratio of the ammonium to hydrogen ion activity coefficients
6978!--    (see Zaveri paper) - multiply this by the ratio of the ammonium to hydrogen ion molality and
6979!--    the ratio of appropriate equilibrium constants
6980!
6981!--    Equilibrium constants
6982!--    k_h = 57.64d0    ! Zaveri et al. (2005)
6983       k_h = 5.8E1_wp * EXP( 4085.0_wp * henrys_temp_dep )   ! after Chameides (1984)
6984!--    k_nh4 = 1.81E-5_wp    ! Zaveri et al. (2005)
6985       k_nh4 = 1.7E-5_wp * EXP( -4325.0_wp * henrys_temp_dep )   ! Chameides (1984)
6986!--    k_h2o = 1.01E-14_wp    ! Zaveri et al (2005)
6987       k_h2o = 1.E-14_wp * EXP( -6716.0_wp * henrys_temp_dep )   ! Chameides (1984)
6988!
6989       molality_ratio_nh3 = ions_mol(2) / ions_mol(1)
6990!
6991!--    Partial pressure calculation
6992       press_nh3 = molality_ratio_nh3 * gamma_nh3 * ( k_h2o / ( k_h * k_nh4 ) )
6993
6994    ENDIF
6995!
6996!-- c) - ACTIVITY COEFF/VAPOUR PRESSURE - HCL
6997    IF ( ions(1) > 0.0_wp  .AND.  ions(7) > 0.0_wp )  THEN
6998       binary_case = 1
6999       IF ( rh > 0.1_wp  .AND.  rh < 0.98 )  THEN
7000          IF ( binary_case == 1 )  THEN
7001             binary_hcl = - 5.0179_wp * rh**3 + 9.8816_wp * rh**2 - 10.789_wp * rh + 5.4737_wp
7002          ELSEIF ( binary_case == 2 )  THEN
7003             binary_hcl = - 4.6221_wp * rh + 4.2633_wp
7004          ENDIF
7005       ELSEIF ( rh >= 0.98_wp  .AND.  rh < 0.9999_wp )  THEN
7006          binary_hcl = 775.6111008626_wp * rh**3 - 2146.01320888771_wp * rh**2 +                   &
7007                       1969.01979670259_wp *  rh - 598.878230033926_wp
7008       ENDIF
7009    ENDIF
7010
7011    IF ( nitric_acid > 0.0_wp )  THEN   ! HNO3
7012       IF ( full_complexity == 1  .OR.  rh <= 0.4_wp )  THEN
7013          hno3_hcl = 9.6256_wp * rh**4 - 26.507_wp * rh**3 + 27.622_wp * rh**2 - 12.958_wp * rh +  &
7014                     2.2193_wp
7015       ELSEIF ( full_complexity == 0  .AND.  rh > 0.4_wp )  THEN
7016          hno3_hcl = 1.3242_wp * rh**2 - 1.8827_wp * rh + 0.55706_wp
7017       ENDIF
7018    ENDIF
7019
7020    IF ( sulphuric_acid > 0.0_wp )  THEN   ! H2SO4
7021       IF ( full_complexity == 1  .OR.  rh <= 0.4 )  THEN
7022          h2so4_hcl = 1.4406_wp * rh**3 - 2.7132_wp * rh**2 + 1.014_wp * rh + 0.25226_wp
7023       ELSEIF ( full_complexity == 0 .AND. rh > 0.4_wp ) THEN
7024          h2so4_hcl = 0.30993_wp * rh**2 - 0.99171_wp * rh + 0.66913_wp
7025       ENDIF
7026    ENDIF
7027
7028    IF ( ammonium_sulphate > 0.0_wp )  THEN   ! NH42SO4
7029       nh42so4_hcl = 22.071_wp * rh**3 - 40.678_wp * rh**2 + 27.893_wp * rh - 9.4338_wp
7030    ENDIF
7031
7032    IF ( ammonium_nitrate > 0.0_wp )  THEN   ! NH4NO3
7033       nh4no3_hcl = 19.935_wp * rh**3 - 42.335_wp * rh**2 + 31.275_wp * rh - 8.8675_wp
7034    ENDIF
7035
7036    IF ( ammonium_chloride > 0.0_wp )  THEN   ! NH4Cl
7037       IF ( full_complexity == 1  .OR.  rh <= 0.4_wp )  THEN
7038          nh4cl_hcl = 2.8048_wp * rh**3 - 4.3182_wp * rh**2 + 3.1971_wp * rh - 1.6824_wp
7039       ELSEIF ( full_complexity == 0  .AND.  rh > 0.4_wp )  THEN
7040          nh4cl_hcl = 1.2304_wp * rh**2 - 0.18262_wp * rh - 1.0643_wp
7041       ENDIF
7042    ENDIF
7043
7044    IF ( sodium_sulphate > 0.0_wp )  THEN   ! Na2SO4
7045       na2so4_hcl = 36.104_wp * rh**4 - 78.658_wp * rh**3 + 63.441_wp * rh**2 - 26.727_wp * rh +   &
7046                    5.7007_wp
7047    ENDIF
7048
7049    IF ( sodium_nitrate > 0.0_wp )  THEN   ! NaNO3
7050       IF ( full_complexity == 1  .OR.  rh <= 0.4_wp )  THEN
7051          nano3_hcl = 54.471_wp * rh**5 - 159.42_wp * rh**4 + 180.25_wp * rh**3 - 98.176_wp * rh**2&
7052                      + 25.309_wp * rh - 2.4275_wp
7053       ELSEIF ( full_complexity == 0  .AND.  rh > 0.4_wp )  THEN
7054          nano3_hcl = 21.632_wp * rh**4 - 53.088_wp * rh**3 + 47.285_wp * rh**2 - 18.519_wp * rh   &
7055                      + 2.6846_wp
7056       ENDIF
7057    ENDIF
7058
7059    IF ( sodium_chloride > 0.0_wp )  THEN   ! NaCl
7060       IF ( full_complexity == 1  .OR.  rh <= 0.4_wp )  THEN
7061          nacl_hcl = 5.4138_wp * rh**4 - 12.079_wp * rh**3 + 9.627_wp * rh**2 - 3.3164_wp * rh +   &
7062                     0.35224_wp
7063       ELSEIF ( full_complexity == 0  .AND.  rh > 0.4_wp )  THEN
7064          nacl_hcl = 2.432_wp * rh**3 - 4.3453_wp * rh**2 + 2.3834_wp * rh - 0.4762_wp
7065       ENDIF
7066    ENDIF
7067
7068    ln_HCL_act = binary_hcl + nitric_acid_eq_frac * hno3_hcl + sulphuric_acid_eq_frac * h2so4_hcl +&
7069                 ammonium_sulphate_eq_frac * nh42so4_hcl + ammonium_nitrate_eq_frac * nh4no3_hcl + &
7070                 ammonium_chloride_eq_frac * nh4cl_hcl + sodium_sulphate_eq_frac * na2so4_hcl +    &
7071                 sodium_nitrate_eq_frac    * nano3_hcl + sodium_chloride_eq_frac   * nacl_hcl
7072
7073     gamma_hcl    = EXP( ln_HCL_act )   ! Molal activity coefficient
7074     gamma_out(2) = gamma_hcl
7075!
7076!--  Equilibrium constant after Wagman et al. (1982) (and NIST database)
7077     k_hcl = 2E6_wp * EXP( 9000.0_wp * henrys_temp_dep )
7078
7079     press_hcl = ( ions_mol(1) * ions_mol(7) * gamma_hcl**2 ) / k_hcl
7080!
7081!-- 5) Ion molility output
7082    mols_out = ions_mol
7083
7084 END SUBROUTINE inorganic_pdfite
7085
7086!------------------------------------------------------------------------------!
7087! Description:
7088! ------------
7089!> Update the particle size distribution. Put particles into corrects bins.
7090!>
7091!> Moving-centre method assumed, i.e. particles are allowed to grow to their
7092!> exact size as long as they are not crossing the fixed diameter bin limits.
7093!> If the particles in a size bin cross the lower or upper diameter limit, they
7094!> are all moved to the adjacent diameter bin and their volume is averaged with
7095!> the particles in the new bin, which then get a new diameter.
7096!
7097!> Moving-centre method minimises numerical diffusion.
7098!------------------------------------------------------------------------------!
7099 SUBROUTINE distr_update( paero )
7100
7101    IMPLICIT NONE
7102
7103    INTEGER(iwp) ::  ib      !< loop index
7104    INTEGER(iwp) ::  mm      !< loop index
7105    INTEGER(iwp) ::  counti  !< number of while loops
7106
7107    LOGICAL  ::  within_bins !< logical (particle belongs to the bin?)
7108
7109    REAL(wp) ::  znfrac  !< number fraction to be moved to the larger bin
7110    REAL(wp) ::  zvfrac  !< volume fraction to be moved to the larger bin
7111    REAL(wp) ::  zvexc   !< Volume in the grown bin which exceeds the bin upper limit
7112    REAL(wp) ::  zvihi   !< particle volume at the high end of the bin
7113    REAL(wp) ::  zvilo   !< particle volume at the low end of the bin
7114    REAL(wp) ::  zvpart  !< particle volume (m3)
7115    REAL(wp) ::  zvrat   !< volume ratio of a size bin
7116
7117    real(wp), dimension(nbins_aerosol) ::  dummy
7118
7119    TYPE(t_section), DIMENSION(nbins_aerosol), INTENT(inout) ::  paero !< aerosol properties
7120
7121    zvpart      = 0.0_wp
7122    zvfrac      = 0.0_wp
7123    within_bins = .FALSE.
7124
7125    dummy = paero(:)%numc
7126!
7127!-- Check if the volume of the bin is within bin limits after update
7128    counti = 0
7129    DO  WHILE ( .NOT. within_bins )
7130       within_bins = .TRUE.
7131!
7132!--    Loop from larger to smaller size bins
7133       DO  ib = end_subrange_2b-1, start_subrange_1a, -1
7134          mm = 0
7135          IF ( paero(ib)%numc > nclim )  THEN
7136             zvpart = 0.0_wp
7137             zvfrac = 0.0_wp
7138
7139             IF ( ib == end_subrange_2a )  CYCLE
7140!
7141!--          Dry volume
7142             zvpart = SUM( paero(ib)%volc(1:7) ) / paero(ib)%numc
7143!
7144!--          Smallest bin cannot decrease
7145             IF ( paero(ib)%vlolim > zvpart  .AND.  ib == start_subrange_1a ) CYCLE
7146!
7147!--          Decreasing bins
7148             IF ( paero(ib)%vlolim > zvpart )  THEN
7149                mm = ib - 1
7150                IF ( ib == start_subrange_2b )  mm = end_subrange_1a    ! 2b goes to 1a
7151
7152                paero(mm)%numc = paero(mm)%numc + paero(ib)%numc
7153                paero(ib)%numc = 0.0_wp
7154                paero(mm)%volc(:) = paero(mm)%volc(:) + paero(ib)%volc(:)
7155                paero(ib)%volc(:) = 0.0_wp
7156                CYCLE
7157             ENDIF
7158!
7159!--          If size bin has not grown, cycle.
7160!--          Changed by Mona: compare to the arithmetic mean volume, as done originally. Now
7161!--          particle volume is derived from the geometric mean diameter, not arithmetic (see
7162!--          SUBROUTINE set_sizebins).
7163             IF ( zvpart <= api6 * ( ( aero(ib)%vhilim + aero(ib)%vlolim ) / ( 2.0_wp * api6 ) ) ) &
7164             CYCLE
7165!
7166!--          Avoid precision problems
7167             IF ( ABS( zvpart - api6 * paero(ib)%dmid**3 ) < 1.0E-35_wp )  CYCLE
7168!
7169!--          Volume ratio of the size bin
7170             zvrat = paero(ib)%vhilim / paero(ib)%vlolim
7171!
7172!--          Particle volume at the low end of the bin
7173             zvilo = 2.0_wp * zvpart / ( 1.0_wp + zvrat )
7174!
7175!--          Particle volume at the high end of the bin
7176             zvihi = zvrat * zvilo
7177!
7178!--          Volume in the grown bin which exceeds the bin upper limit
7179             zvexc = 0.5_wp * ( zvihi + paero(ib)%vhilim )
7180!
7181!--          Number fraction to be moved to the larger bin
7182             znfrac = MIN( 1.0_wp, ( zvihi - paero(ib)%vhilim) / ( zvihi - zvilo ) )
7183!
7184!--          Volume fraction to be moved to the larger bin
7185             zvfrac = MIN( 0.99_wp, znfrac * zvexc / zvpart )
7186             IF ( zvfrac < 0.0_wp )  THEN
7187                message_string = 'Error: zvfrac < 0'
7188                CALL message( 'salsa_mod: distr_update', 'PA0624', 1, 2, 0, 6, 0 )
7189             ENDIF
7190!
7191!--          Update bin
7192             mm = ib + 1
7193!
7194!--          Volume (cm3/cm3)
7195             paero(mm)%volc(:) = paero(mm)%volc(:) + znfrac * paero(ib)%numc * zvexc *             &
7196                                 paero(ib)%volc(:) / SUM( paero(ib)%volc(1:7) )
7197             paero(ib)%volc(:) = paero(ib)%volc(:) - znfrac * paero(ib)%numc * zvexc *             &
7198                                 paero(ib)%volc(:) / SUM( paero(ib)%volc(1:7) )
7199
7200!--          Number concentration (#/m3)
7201             paero(mm)%numc = paero(mm)%numc + znfrac * paero(ib)%numc
7202             paero(ib)%numc = paero(ib)%numc * ( 1.0_wp - znfrac )
7203
7204          ENDIF     ! nclim
7205
7206          IF ( paero(ib)%numc > nclim )   THEN
7207             zvpart = SUM( paero(ib)%volc(1:7) ) / paero(ib)%numc  ! Note: dry volume!
7208             within_bins = ( paero(ib)%vlolim < zvpart  .AND. zvpart < paero(ib)%vhilim )
7209          ENDIF
7210
7211       ENDDO ! - ib
7212
7213       counti = counti + 1
7214       IF ( counti > 100 )  THEN
7215          message_string = 'Error: Aerosol bin update not converged'
7216          CALL message( 'salsa_mod: distr_update', 'PA0625', 1, 2, 0, 6, 0 )
7217       ENDIF
7218
7219    ENDDO ! - within bins
7220
7221 END SUBROUTINE distr_update
7222
7223!------------------------------------------------------------------------------!
7224! Description:
7225! ------------
7226!> salsa_diagnostics: Update properties for the current timestep:
7227!>
7228!> Juha Tonttila, FMI, 2014
7229!> Tomi Raatikainen, FMI, 2016
7230!------------------------------------------------------------------------------!
7231 SUBROUTINE salsa_diagnostics( i, j )
7232
7233    USE cpulog,                                                                &
7234        ONLY:  cpu_log, log_point_s
7235
7236    IMPLICIT NONE
7237
7238    INTEGER(iwp) ::  ib   !<
7239    INTEGER(iwp) ::  ic   !<
7240    INTEGER(iwp) ::  icc  !<
7241    INTEGER(iwp) ::  ig   !<
7242    INTEGER(iwp) ::  k    !<
7243
7244    INTEGER(iwp), INTENT(in) ::  i  !<
7245    INTEGER(iwp), INTENT(in) ::  j  !<
7246
7247    REAL(wp), DIMENSION(nzb:nzt+1) ::  flag          !< flag to mask topography
7248    REAL(wp), DIMENSION(nzb:nzt+1) ::  flag_zddry    !< flag to mask zddry
7249    REAL(wp), DIMENSION(nzb:nzt+1) ::  in_adn        !< air density (kg/m3)
7250    REAL(wp), DIMENSION(nzb:nzt+1) ::  in_p          !< pressure
7251    REAL(wp), DIMENSION(nzb:nzt+1) ::  in_t          !< temperature (K)
7252    REAL(wp), DIMENSION(nzb:nzt+1) ::  mcsum         !< sum of mass concentration
7253    REAL(wp), DIMENSION(nzb:nzt+1) ::  ppm_to_nconc  !< Conversion factor: ppm to #/m3
7254    REAL(wp), DIMENSION(nzb:nzt+1) ::  zddry         !< particle dry diameter
7255    REAL(wp), DIMENSION(nzb:nzt+1) ::  zvol          !< particle volume
7256
7257    flag_zddry   = 0.0_wp
7258    in_adn       = 0.0_wp
7259    in_p         = 0.0_wp
7260    in_t         = 0.0_wp
7261    ppm_to_nconc = 1.0_wp
7262    zddry        = 0.0_wp
7263    zvol         = 0.0_wp
7264
7265    !$OMP MASTER
7266    CALL cpu_log( log_point_s(94), 'salsa diagnostics ', 'start' )
7267    !$OMP END MASTER
7268
7269!
7270!-- Calculate thermodynamic quantities needed in SALSA
7271    CALL salsa_thrm_ij( i, j, p_ij=in_p, temp_ij=in_t, adn_ij=in_adn )
7272!
7273!-- Calculate conversion factors for gas concentrations
7274    ppm_to_nconc = for_ppm_to_nconc * in_p / in_t
7275!
7276!-- Predetermine flag to mask topography
7277    flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_0(:,j,i), 0 ) )
7278
7279    DO  ib = 1, nbins_aerosol   ! aerosol size bins
7280!
7281!--    Remove negative values
7282       aerosol_number(ib)%conc(:,j,i) = MAX( nclim, aerosol_number(ib)%conc(:,j,i) ) * flag
7283!
7284!--    Calculate total mass concentration per bin
7285       mcsum = 0.0_wp
7286       DO  ic = 1, ncomponents_mass
7287          icc = ( ic - 1 ) * nbins_aerosol + ib
7288          mcsum = mcsum + aerosol_mass(icc)%conc(:,j,i) * flag
7289          aerosol_mass(icc)%conc(:,j,i) = MAX( mclim, aerosol_mass(icc)%conc(:,j,i) ) * flag
7290       ENDDO
7291!
7292!--    Check that number and mass concentration match qualitatively
7293       IF ( ANY( aerosol_number(ib)%conc(:,j,i) > nclim  .AND. mcsum <= 0.0_wp ) )  THEN
7294          DO  k = nzb+1, nzt
7295             IF ( aerosol_number(ib)%conc(k,j,i) >= nclim  .AND. mcsum(k) <= 0.0_wp )  THEN
7296                aerosol_number(ib)%conc(k,j,i) = nclim * flag(k)
7297                DO  ic = 1, ncomponents_mass
7298                   icc = ( ic - 1 ) * nbins_aerosol + ib
7299                   aerosol_mass(icc)%conc(k,j,i) = mclim * flag(k)
7300                ENDDO
7301             ENDIF
7302          ENDDO
7303       ENDIF
7304!
7305!--    Update aerosol particle radius
7306       CALL bin_mixrat( 'dry', ib, i, j, zvol )
7307       zvol = zvol / arhoh2so4    ! Why on sulphate?
7308!
7309!--    Particles smaller then 0.1 nm diameter are set to zero
7310       zddry = ( zvol / MAX( nclim, aerosol_number(ib)%conc(:,j,i) ) / api6 )**0.33333333_wp
7311       flag_zddry = MERGE( 1.0_wp, 0.0_wp, ( zddry < 1.0E-10_wp  .AND.                             &
7312                           aerosol_number(ib)%conc(:,j,i) > nclim ) )
7313!
7314!--    Volatile species to the gas phase
7315       IF ( index_so4 > 0 .AND. lscndgas )  THEN
7316          ic = ( index_so4 - 1 ) * nbins_aerosol + ib
7317          IF ( salsa_gases_from_chem )  THEN
7318             ig = gas_index_chem(1)
7319             chem_species(ig)%conc(:,j,i) = chem_species(ig)%conc(:,j,i) +                         &
7320                                            aerosol_mass(ic)%conc(:,j,i) * avo * flag_zddry /      &
7321                                            ( amh2so4 * ppm_to_nconc ) * flag
7322          ELSE
7323             salsa_gas(1)%conc(:,j,i) = salsa_gas(1)%conc(:,j,i) + aerosol_mass(ic)%conc(:,j,i) /  &
7324                                        amh2so4 * avo * flag_zddry * flag
7325          ENDIF
7326       ENDIF
7327       IF ( index_oc > 0  .AND.  lscndgas )  THEN
7328          ic = ( index_oc - 1 ) * nbins_aerosol + ib
7329          IF ( salsa_gases_from_chem )  THEN
7330             ig = gas_index_chem(5)
7331             chem_species(ig)%conc(:,j,i) = chem_species(ig)%conc(:,j,i) +                         &
7332                                            aerosol_mass(ic)%conc(:,j,i) * avo * flag_zddry /      &
7333                                            ( amoc * ppm_to_nconc ) * flag
7334          ELSE
7335             salsa_gas(5)%conc(:,j,i) = salsa_gas(5)%conc(:,j,i) + aerosol_mass(ic)%conc(:,j,i) /  &
7336                                        amoc * avo * flag_zddry * flag
7337          ENDIF
7338       ENDIF
7339       IF ( index_no > 0  .AND.  lscndgas )  THEN
7340          ic = ( index_no - 1 ) * nbins_aerosol + ib
7341          IF ( salsa_gases_from_chem )  THEN
7342             ig = gas_index_chem(2)
7343             chem_species(ig)%conc(:,j,i) = chem_species(ig)%conc(:,j,i) +                         &
7344                                            aerosol_mass(ic)%conc(:,j,i) * avo * flag_zddry /      &
7345                                            ( amhno3 * ppm_to_nconc ) *flag
7346          ELSE
7347             salsa_gas(2)%conc(:,j,i) = salsa_gas(2)%conc(:,j,i) + aerosol_mass(ic)%conc(:,j,i) /  &
7348                                        amhno3 * avo * flag_zddry * flag
7349          ENDIF
7350       ENDIF
7351       IF ( index_nh > 0  .AND.  lscndgas )  THEN
7352          ic = ( index_nh - 1 ) * nbins_aerosol + ib
7353          IF ( salsa_gases_from_chem )  THEN
7354             ig = gas_index_chem(3)
7355             chem_species(ig)%conc(:,j,i) = chem_species(ig)%conc(:,j,i) +                         &
7356                                            aerosol_mass(ic)%conc(:,j,i) * avo * flag_zddry /      &
7357                                            ( amnh3 * ppm_to_nconc ) *flag
7358          ELSE
7359             salsa_gas(3)%conc(:,j,i) = salsa_gas(3)%conc(:,j,i) + aerosol_mass(ic)%conc(:,j,i) /  &
7360                                        amnh3 * avo * flag_zddry *flag
7361          ENDIF
7362       ENDIF
7363!
7364!--    Mass and number to zero (insoluble species and water are lost)
7365       DO  ic = 1, ncomponents_mass
7366          icc = ( ic - 1 ) * nbins_aerosol + ib
7367          aerosol_mass(icc)%conc(:,j,i) = MERGE( mclim * flag, aerosol_mass(icc)%conc(:,j,i),      &
7368                                                 flag_zddry > 0.0_wp )
7369       ENDDO
7370       aerosol_number(ib)%conc(:,j,i) = MERGE( nclim * flag, aerosol_number(ib)%conc(:,j,i),       &
7371                                               flag_zddry > 0.0_wp )
7372       ra_dry(:,j,i,ib) = MAX( 1.0E-10_wp, 0.5_wp * zddry )
7373
7374    ENDDO
7375    IF ( .NOT. salsa_gases_from_chem )  THEN
7376       DO  ig = 1, ngases_salsa
7377          salsa_gas(ig)%conc(:,j,i) = MAX( nclim, salsa_gas(ig)%conc(:,j,i) ) * flag
7378       ENDDO
7379    ENDIF
7380
7381   !$OMP MASTER
7382    CALL cpu_log( log_point_s(94), 'salsa diagnostics ', 'stop' )
7383   !$OMP END MASTER
7384
7385 END SUBROUTINE salsa_diagnostics
7386
7387
7388!------------------------------------------------------------------------------!
7389! Description:
7390! ------------
7391!> Call for all grid points
7392!------------------------------------------------------------------------------!
7393 SUBROUTINE salsa_actions( location )
7394
7395
7396    CHARACTER (LEN=*), INTENT(IN) ::  location !< call location string
7397
7398    SELECT CASE ( location )
7399
7400       CASE ( 'before_timestep' )
7401
7402          IF ( ws_scheme_sca )  sums_salsa_ws_l = 0.0_wp
7403
7404       CASE DEFAULT
7405          CONTINUE
7406
7407    END SELECT
7408
7409 END SUBROUTINE salsa_actions
7410
7411
7412!------------------------------------------------------------------------------!
7413! Description:
7414! ------------
7415!> Call for grid points i,j
7416!------------------------------------------------------------------------------!
7417
7418 SUBROUTINE salsa_actions_ij( i, j, location )
7419
7420
7421    INTEGER(iwp),      INTENT(IN) ::  i         !< grid index in x-direction
7422    INTEGER(iwp),      INTENT(IN) ::  j         !< grid index in y-direction
7423    CHARACTER (LEN=*), INTENT(IN) ::  location  !< call location string
7424    INTEGER(iwp)  ::  dummy  !< call location string
7425
7426    IF ( salsa    )   dummy = i + j
7427
7428    SELECT CASE ( location )
7429
7430       CASE ( 'before_timestep' )
7431
7432          IF ( ws_scheme_sca )  sums_salsa_ws_l = 0.0_wp
7433
7434       CASE DEFAULT
7435          CONTINUE
7436
7437    END SELECT
7438
7439
7440 END SUBROUTINE salsa_actions_ij
7441
7442!------------------------------------------------------------------------------!
7443! Description:
7444! ------------
7445!> Call for all grid points
7446!------------------------------------------------------------------------------!
7447 SUBROUTINE salsa_non_advective_processes
7448
7449    USE cpulog,                                                                                    &
7450        ONLY:  cpu_log, log_point_s
7451
7452    IMPLICIT NONE
7453
7454    INTEGER(iwp) ::  i  !<
7455    INTEGER(iwp) ::  j  !<
7456
7457    IF ( time_since_reference_point >= skip_time_do_salsa )  THEN
7458       IF ( ( time_since_reference_point - last_salsa_time ) >= dt_salsa )  THEN
7459!
7460!--       Calculate aerosol dynamic processes. salsa_driver can be run with a longer time step.
7461          CALL cpu_log( log_point_s(90), 'salsa processes ', 'start' )
7462          DO  i = nxl, nxr
7463             DO  j = nys, nyn
7464                CALL salsa_diagnostics( i, j )
7465                CALL salsa_driver( i, j, 3 )
7466                CALL salsa_diagnostics( i, j )
7467             ENDDO
7468          ENDDO
7469          CALL cpu_log( log_point_s(90), 'salsa processes ', 'stop' )
7470       ENDIF
7471    ENDIF
7472
7473 END SUBROUTINE salsa_non_advective_processes
7474
7475
7476!------------------------------------------------------------------------------!
7477! Description:
7478! ------------
7479!> Call for grid points i,j
7480!------------------------------------------------------------------------------!
7481 SUBROUTINE salsa_non_advective_processes_ij( i, j )
7482
7483    USE cpulog,                                                                &
7484        ONLY:  cpu_log, log_point_s
7485
7486    IMPLICIT NONE
7487
7488    INTEGER(iwp), INTENT(IN) ::  i  !< grid index in x-direction
7489    INTEGER(iwp), INTENT(IN) ::  j  !< grid index in y-direction
7490
7491    IF ( time_since_reference_point >= skip_time_do_salsa )  THEN
7492       IF ( ( time_since_reference_point - last_salsa_time ) >= dt_salsa )  THEN
7493!
7494!--       Calculate aerosol dynamic processes. salsa_driver can be run with a longer time step.
7495          CALL cpu_log( log_point_s(90), 'salsa processes ', 'start' )
7496          CALL salsa_diagnostics( i, j )
7497          CALL salsa_driver( i, j, 3 )
7498          CALL salsa_diagnostics( i, j )
7499          CALL cpu_log( log_point_s(90), 'salsa processes ', 'stop' )
7500       ENDIF
7501    ENDIF
7502
7503 END SUBROUTINE salsa_non_advective_processes_ij
7504
7505!------------------------------------------------------------------------------!
7506! Description:
7507! ------------
7508!> Routine for exchange horiz of salsa variables.
7509!------------------------------------------------------------------------------!
7510 SUBROUTINE salsa_exchange_horiz_bounds
7511
7512    USE cpulog,                                                                &
7513        ONLY:  cpu_log, log_point_s
7514
7515    IMPLICIT NONE
7516
7517    INTEGER(iwp) ::  ib   !<
7518    INTEGER(iwp) ::  ic   !<
7519    INTEGER(iwp) ::  icc  !<
7520    INTEGER(iwp) ::  ig   !<
7521
7522    IF ( time_since_reference_point >= skip_time_do_salsa )  THEN
7523       IF ( ( time_since_reference_point - last_salsa_time ) >= dt_salsa )  THEN
7524
7525          CALL cpu_log( log_point_s(91), 'salsa exch-horiz ', 'start' )
7526!
7527!--       Exchange ghost points and decycle if needed.
7528          DO  ib = 1, nbins_aerosol
7529             CALL exchange_horiz( aerosol_number(ib)%conc, nbgp )
7530             CALL salsa_boundary_conds( aerosol_number(ib)%conc, aerosol_number(ib)%init )
7531             DO  ic = 1, ncomponents_mass
7532                icc = ( ic - 1 ) * nbins_aerosol + ib
7533                CALL exchange_horiz( aerosol_mass(icc)%conc, nbgp )
7534                CALL salsa_boundary_conds( aerosol_mass(icc)%conc, aerosol_mass(icc)%init )
7535             ENDDO
7536          ENDDO
7537          IF ( .NOT. salsa_gases_from_chem )  THEN
7538             DO  ig = 1, ngases_salsa
7539                CALL exchange_horiz( salsa_gas(ig)%conc, nbgp )
7540                CALL salsa_boundary_conds( salsa_gas(ig)%conc, salsa_gas(ig)%init )
7541             ENDDO
7542          ENDIF
7543          CALL cpu_log( log_point_s(91), 'salsa exch-horiz ', 'stop' )
7544!
7545!--       Update last_salsa_time
7546          last_salsa_time = time_since_reference_point
7547       ENDIF
7548    ENDIF
7549
7550 END SUBROUTINE salsa_exchange_horiz_bounds
7551
7552!------------------------------------------------------------------------------!
7553! Description:
7554! ------------
7555!> Calculate the prognostic equation for aerosol number and mass, and gas
7556!> concentrations. Cache-optimized.
7557!------------------------------------------------------------------------------!
7558 SUBROUTINE salsa_prognostic_equations_ij( i, j, i_omp_start, tn )
7559
7560    IMPLICIT NONE
7561
7562    INTEGER(iwp) ::  i            !<
7563    INTEGER(iwp) ::  i_omp_start  !<
7564    INTEGER(iwp) ::  ib           !< loop index for aerosol number bin OR gas index
7565    INTEGER(iwp) ::  ic           !< loop index for aerosol mass bin
7566    INTEGER(iwp) ::  icc          !< (c-1)*nbins_aerosol+b
7567    INTEGER(iwp) ::  ig           !< loop index for salsa gases
7568    INTEGER(iwp) ::  j            !<
7569    INTEGER(iwp) ::  tn           !<
7570
7571    IF ( time_since_reference_point >= skip_time_do_salsa )  THEN
7572!
7573!--    Aerosol number
7574       DO  ib = 1, nbins_aerosol
7575!kk          sums_salsa_ws_l = aerosol_number(ib)%sums_ws_l
7576          CALL salsa_tendency( 'aerosol_number', aerosol_number(ib)%conc_p, aerosol_number(ib)%conc,&
7577                               aerosol_number(ib)%tconc_m, i, j, i_omp_start, tn, ib, ib,          &
7578                               aerosol_number(ib)%flux_s, aerosol_number(ib)%diss_s,               &
7579                               aerosol_number(ib)%flux_l, aerosol_number(ib)%diss_l,               &
7580                               aerosol_number(ib)%init, .TRUE. )
7581!kk          aerosol_number(ib)%sums_ws_l = sums_salsa_ws_l
7582!
7583!--       Aerosol mass
7584          DO  ic = 1, ncomponents_mass
7585             icc = ( ic - 1 ) * nbins_aerosol + ib
7586!kk             sums_salsa_ws_l = aerosol_mass(icc)%sums_ws_l
7587             CALL salsa_tendency( 'aerosol_mass', aerosol_mass(icc)%conc_p, aerosol_mass(icc)%conc,&
7588                                  aerosol_mass(icc)%tconc_m, i, j, i_omp_start, tn, ib, ic,        &
7589                                  aerosol_mass(icc)%flux_s, aerosol_mass(icc)%diss_s,              &
7590                                  aerosol_mass(icc)%flux_l, aerosol_mass(icc)%diss_l,              &
7591                                  aerosol_mass(icc)%init, .TRUE. )
7592!kk             aerosol_mass(icc)%sums_ws_l = sums_salsa_ws_l
7593
7594          ENDDO  ! ic
7595       ENDDO  ! ib
7596!
7597!--    Gases
7598       IF ( .NOT. salsa_gases_from_chem )  THEN
7599
7600          DO  ig = 1, ngases_salsa
7601!kk             sums_salsa_ws_l = salsa_gas(ig)%sums_ws_l
7602             CALL salsa_tendency( 'salsa_gas', salsa_gas(ig)%conc_p, salsa_gas(ig)%conc,           &
7603                                  salsa_gas(ig)%tconc_m, i, j, i_omp_start, tn, ig, ig,            &
7604                                  salsa_gas(ig)%flux_s, salsa_gas(ig)%diss_s, salsa_gas(ig)%flux_l,&
7605                                  salsa_gas(ig)%diss_l, salsa_gas(ig)%init, .FALSE. )
7606!kk             salsa_gas(ig)%sums_ws_l = sums_salsa_ws_l
7607
7608          ENDDO  ! ig
7609
7610       ENDIF
7611
7612    ENDIF
7613
7614 END SUBROUTINE salsa_prognostic_equations_ij
7615!
7616!------------------------------------------------------------------------------!
7617! Description:
7618! ------------
7619!> Calculate the prognostic equation for aerosol number and mass, and gas
7620!> concentrations. For vector machines.
7621!------------------------------------------------------------------------------!
7622 SUBROUTINE salsa_prognostic_equations()
7623
7624    IMPLICIT NONE
7625
7626    INTEGER(iwp) ::  ib           !< loop index for aerosol number bin OR gas index
7627    INTEGER(iwp) ::  ic           !< loop index for aerosol mass bin
7628    INTEGER(iwp) ::  icc          !< (c-1)*nbins_aerosol+b
7629    INTEGER(iwp) ::  ig           !< loop index for salsa gases
7630
7631    IF ( time_since_reference_point >= skip_time_do_salsa )  THEN
7632!
7633!--    Aerosol number
7634       DO  ib = 1, nbins_aerosol
7635          sums_salsa_ws_l = aerosol_number(ib)%sums_ws_l
7636          CALL salsa_tendency( 'aerosol_number', aerosol_number(ib)%conc_p, aerosol_number(ib)%conc,&
7637                               aerosol_number(ib)%tconc_m, ib, ib, aerosol_number(ib)%init, .TRUE. )
7638          aerosol_number(ib)%sums_ws_l = sums_salsa_ws_l
7639!
7640!--       Aerosol mass
7641          DO  ic = 1, ncomponents_mass
7642             icc = ( ic - 1 ) * nbins_aerosol + ib
7643             sums_salsa_ws_l = aerosol_mass(icc)%sums_ws_l
7644             CALL salsa_tendency( 'aerosol_mass', aerosol_mass(icc)%conc_p, aerosol_mass(icc)%conc,&
7645                                  aerosol_mass(icc)%tconc_m, ib, ic, aerosol_mass(icc)%init, .TRUE. )
7646             aerosol_mass(icc)%sums_ws_l = sums_salsa_ws_l
7647
7648          ENDDO  ! ic
7649       ENDDO  ! ib
7650!
7651!--    Gases
7652       IF ( .NOT. salsa_gases_from_chem )  THEN
7653
7654          DO  ig = 1, ngases_salsa
7655             sums_salsa_ws_l = salsa_gas(ig)%sums_ws_l
7656             CALL salsa_tendency( 'salsa_gas', salsa_gas(ig)%conc_p, salsa_gas(ig)%conc,           &
7657                                  salsa_gas(ig)%tconc_m, ig, ig, salsa_gas(ig)%init, .FALSE. )
7658             salsa_gas(ig)%sums_ws_l = sums_salsa_ws_l
7659
7660          ENDDO  ! ig
7661
7662       ENDIF
7663
7664    ENDIF
7665
7666 END SUBROUTINE salsa_prognostic_equations
7667!
7668!------------------------------------------------------------------------------!
7669! Description:
7670! ------------
7671!> Tendencies for aerosol number and mass and gas concentrations.
7672!> Cache-optimized.
7673!------------------------------------------------------------------------------!
7674 SUBROUTINE salsa_tendency_ij( id, rs_p, rs, trs_m, i, j, i_omp_start, tn, ib, ic, flux_s, diss_s, &
7675                               flux_l, diss_l, rs_init, do_sedimentation )
7676
7677    USE advec_ws,                                                                                  &
7678        ONLY:  advec_s_ws
7679
7680    USE advec_s_pw_mod,                                                                            &
7681        ONLY:  advec_s_pw
7682
7683    USE advec_s_up_mod,                                                                            &
7684        ONLY:  advec_s_up
7685
7686    USE arrays_3d,                                                                                 &
7687        ONLY:  ddzu, rdf_sc, tend
7688
7689    USE diffusion_s_mod,                                                                           &
7690        ONLY:  diffusion_s
7691
7692    USE indices,                                                                                   &
7693        ONLY:  wall_flags_0
7694
7695    USE surface_mod,                                                                               &
7696        ONLY :  surf_def_h, surf_def_v, surf_lsm_h, surf_lsm_v, surf_usm_h, surf_usm_v
7697
7698    IMPLICIT NONE
7699
7700    CHARACTER(LEN = *) ::  id  !<
7701
7702    INTEGER(iwp) ::  i            !<
7703    INTEGER(iwp) ::  i_omp_start  !<
7704    INTEGER(iwp) ::  ib           !< loop index for aerosol number bin OR gas index
7705    INTEGER(iwp) ::  ic           !< loop index for aerosol mass bin
7706    INTEGER(iwp) ::  icc          !< (c-1)*nbins_aerosol+b
7707    INTEGER(iwp) ::  j            !<
7708    INTEGER(iwp) ::  k            !<
7709    INTEGER(iwp) ::  tn           !<
7710
7711    LOGICAL ::  do_sedimentation  !<
7712
7713    REAL(wp), DIMENSION(nzb:nzt+1) ::  rs_init  !<
7714
7715    REAL(wp), DIMENSION(nzb+1:nzt,0:threads_per_task-1) ::  diss_s  !<
7716    REAL(wp), DIMENSION(nzb+1:nzt,0:threads_per_task-1) ::  flux_s  !<
7717
7718    REAL(wp), DIMENSION(nzb+1:nzt,nys:nyn,0:threads_per_task-1) ::  diss_l  !<
7719    REAL(wp), DIMENSION(nzb+1:nzt,nys:nyn,0:threads_per_task-1) ::  flux_l  !<
7720
7721    REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ::  rs_p    !<
7722    REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ::  rs      !<
7723    REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ::  trs_m   !<
7724
7725    icc = ( ic - 1 ) * nbins_aerosol + ib
7726!
7727!-- Tendency-terms for reactive scalar
7728    tend(:,j,i) = 0.0_wp
7729!
7730!-- Advection terms
7731    IF ( timestep_scheme(1:5) == 'runge' )  THEN
7732       IF ( ws_scheme_sca )  THEN
7733          CALL advec_s_ws( salsa_advc_flags_s, i, j, rs, id, flux_s, diss_s, flux_l, diss_l,       &
7734                           i_omp_start, tn, bc_dirichlet_l  .OR.  bc_radiation_l,                  &
7735                           bc_dirichlet_n  .OR.  bc_radiation_n,                                   &
7736                           bc_dirichlet_r  .OR.  bc_radiation_r,                                   &
7737                           bc_dirichlet_s  .OR.  bc_radiation_s, monotonic_limiter_z )
7738       ELSE
7739          CALL advec_s_pw( i, j, rs )
7740       ENDIF
7741    ELSE
7742       CALL advec_s_up( i, j, rs )
7743    ENDIF
7744!
7745!-- Diffusion terms
7746    SELECT CASE ( id )
7747       CASE ( 'aerosol_number' )
7748          CALL diffusion_s( i, j, rs, surf_def_h(0)%answs(:,ib),                                   &
7749                                      surf_def_h(1)%answs(:,ib), surf_def_h(2)%answs(:,ib),        &
7750                                      surf_lsm_h%answs(:,ib),    surf_usm_h%answs(:,ib),           &
7751                                      surf_def_v(0)%answs(:,ib), surf_def_v(1)%answs(:,ib),        &
7752                                      surf_def_v(2)%answs(:,ib), surf_def_v(3)%answs(:,ib),        &
7753                                      surf_lsm_v(0)%answs(:,ib), surf_lsm_v(1)%answs(:,ib),        &
7754                                      surf_lsm_v(2)%answs(:,ib), surf_lsm_v(3)%answs(:,ib),        &
7755                                      surf_usm_v(0)%answs(:,ib), surf_usm_v(1)%answs(:,ib),        &
7756                                      surf_usm_v(2)%answs(:,ib), surf_usm_v(3)%answs(:,ib) )
7757       CASE ( 'aerosol_mass' )
7758          CALL diffusion_s( i, j, rs, surf_def_h(0)%amsws(:,icc),                                  &
7759                                      surf_def_h(1)%amsws(:,icc), surf_def_h(2)%amsws(:,icc),      &
7760                                      surf_lsm_h%amsws(:,icc),    surf_usm_h%amsws(:,icc),         &
7761                                      surf_def_v(0)%amsws(:,icc), surf_def_v(1)%amsws(:,icc),      &
7762                                      surf_def_v(2)%amsws(:,icc), surf_def_v(3)%amsws(:,icc),      &
7763                                      surf_lsm_v(0)%amsws(:,icc), surf_lsm_v(1)%amsws(:,icc),      &
7764                                      surf_lsm_v(2)%amsws(:,icc), surf_lsm_v(3)%amsws(:,icc),      &
7765                                      surf_usm_v(0)%amsws(:,icc), surf_usm_v(1)%amsws(:,icc),      &
7766                                      surf_usm_v(2)%amsws(:,icc), surf_usm_v(3)%amsws(:,icc) )
7767       CASE ( 'salsa_gas' )
7768          CALL diffusion_s( i, j, rs, surf_def_h(0)%gtsws(:,ib),                                   &
7769                                      surf_def_h(1)%gtsws(:,ib), surf_def_h(2)%gtsws(:,ib),        &
7770                                      surf_lsm_h%gtsws(:,ib), surf_usm_h%gtsws(:,ib),              &
7771                                      surf_def_v(0)%gtsws(:,ib), surf_def_v(1)%gtsws(:,ib),        &
7772                                      surf_def_v(2)%gtsws(:,ib), surf_def_v(3)%gtsws(:,ib),        &
7773                                      surf_lsm_v(0)%gtsws(:,ib), surf_lsm_v(1)%gtsws(:,ib),        &
7774                                      surf_lsm_v(2)%gtsws(:,ib), surf_lsm_v(3)%gtsws(:,ib),        &
7775                                      surf_usm_v(0)%gtsws(:,ib), surf_usm_v(1)%gtsws(:,ib),        &
7776                                      surf_usm_v(2)%gtsws(:,ib), surf_usm_v(3)%gtsws(:,ib) )
7777    END SELECT
7778!
7779!-- Sedimentation and prognostic equation for aerosol number and mass
7780    IF ( lsdepo  .AND.  do_sedimentation )  THEN
7781!DIR$ IVDEP
7782       DO  k = nzb+1, nzt
7783          tend(k,j,i) = tend(k,j,i) - MAX( 0.0_wp, ( rs(k+1,j,i) * sedim_vd(k+1,j,i,ib) -          &
7784                                                     rs(k,j,i) * sedim_vd(k,j,i,ib) ) * ddzu(k) )  &
7785                                    * MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_0(k-1,j,i), 0 ) )
7786          rs_p(k,j,i) = rs(k,j,i) + ( dt_3d * ( tsc(2) * tend(k,j,i) + tsc(3) * trs_m(k,j,i) )     &
7787                                      - tsc(5) * rdf_sc(k) * ( rs(k,j,i) - rs_init(k) ) )          &
7788                                  * MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_0(k,j,i), 0 ) )
7789          IF ( rs_p(k,j,i) < 0.0_wp )  rs_p(k,j,i) = 0.1_wp * rs(k,j,i)
7790       ENDDO
7791    ELSE
7792!
7793!--    Prognostic equation
7794!DIR$ IVDEP
7795       DO  k = nzb+1, nzt
7796          rs_p(k,j,i) = rs(k,j,i) + ( dt_3d * ( tsc(2) * tend(k,j,i) + tsc(3) * trs_m(k,j,i) )     &
7797                                                - tsc(5) * rdf_sc(k) * ( rs(k,j,i) - rs_init(k) ) )&
7798                                  * MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_0(k,j,i), 0 ) )
7799          IF ( rs_p(k,j,i) < 0.0_wp )  rs_p(k,j,i) = 0.1_wp * rs(k,j,i)
7800       ENDDO
7801    ENDIF
7802!
7803!-- Calculate tendencies for the next Runge-Kutta step
7804    IF ( timestep_scheme(1:5) == 'runge' )  THEN
7805       IF ( intermediate_timestep_count == 1 )  THEN
7806          DO  k = nzb+1, nzt
7807             trs_m(k,j,i) = tend(k,j,i)
7808          ENDDO
7809       ELSEIF ( intermediate_timestep_count < intermediate_timestep_count_max )  THEN
7810          DO  k = nzb+1, nzt
7811             trs_m(k,j,i) = -9.5625_wp * tend(k,j,i) + 5.3125_wp * trs_m(k,j,i)
7812          ENDDO
7813       ENDIF
7814    ENDIF
7815
7816 END SUBROUTINE salsa_tendency_ij
7817!
7818!------------------------------------------------------------------------------!
7819! Description:
7820! ------------
7821!> Calculate the tendencies for aerosol number and mass concentrations.
7822!> For vector machines.
7823!------------------------------------------------------------------------------!
7824 SUBROUTINE salsa_tendency( id, rs_p, rs, trs_m, ib, ic, rs_init, do_sedimentation )
7825
7826    USE advec_ws,                                                                                  &
7827        ONLY:  advec_s_ws
7828    USE advec_s_pw_mod,                                                                            &
7829        ONLY:  advec_s_pw
7830    USE advec_s_up_mod,                                                                            &
7831        ONLY:  advec_s_up
7832    USE arrays_3d,                                                                                 &
7833        ONLY:  ddzu, rdf_sc, tend
7834    USE diffusion_s_mod,                                                                           &
7835        ONLY:  diffusion_s
7836    USE indices,                                                                                   &
7837        ONLY:  wall_flags_0
7838    USE surface_mod,                                                                               &
7839        ONLY :  surf_def_h, surf_def_v, surf_lsm_h, surf_lsm_v, surf_usm_h, surf_usm_v
7840
7841    IMPLICIT NONE
7842
7843    CHARACTER(LEN = *) ::  id
7844
7845    INTEGER(iwp) ::  ib           !< loop index for aerosol number bin OR gas index
7846    INTEGER(iwp) ::  ic           !< loop index for aerosol mass bin
7847    INTEGER(iwp) ::  icc  !< (c-1)*nbins_aerosol+b
7848    INTEGER(iwp) ::  i    !<
7849    INTEGER(iwp) ::  j    !<
7850    INTEGER(iwp) ::  k    !<
7851
7852    LOGICAL ::  do_sedimentation  !<
7853
7854    REAL(wp), DIMENSION(nzb:nzt+1) ::  rs_init !<
7855
7856    REAL(wp), DIMENSION(:,:,:), POINTER ::  rs_p    !<
7857    REAL(wp), DIMENSION(:,:,:), POINTER ::  rs      !<
7858    REAL(wp), DIMENSION(:,:,:), POINTER ::  trs_m   !<
7859
7860    icc = ( ic - 1 ) * nbins_aerosol + ib
7861!
7862!-- Tendency-terms for reactive scalar
7863    tend = 0.0_wp
7864!
7865!-- Advection terms
7866    IF ( timestep_scheme(1:5) == 'runge' )  THEN
7867       IF ( ws_scheme_sca )  THEN
7868          CALL advec_s_ws( salsa_advc_flags_s, rs, id, bc_dirichlet_l  .OR.  bc_radiation_l,       &
7869                           bc_dirichlet_n  .OR.  bc_radiation_n,                                   &
7870                           bc_dirichlet_r  .OR.  bc_radiation_r,                                   &
7871                           bc_dirichlet_s  .OR.  bc_radiation_s )
7872       ELSE
7873          CALL advec_s_pw( rs )
7874       ENDIF
7875    ELSE
7876       CALL advec_s_up( rs )
7877    ENDIF
7878!
7879!-- Diffusion terms
7880    SELECT CASE ( id )
7881       CASE ( 'aerosol_number' )
7882          CALL diffusion_s( rs, surf_def_h(0)%answs(:,ib),                                         &
7883                                surf_def_h(1)%answs(:,ib), surf_def_h(2)%answs(:,ib),              &
7884                                surf_lsm_h%answs(:,ib),    surf_usm_h%answs(:,ib),                 &
7885                                surf_def_v(0)%answs(:,ib), surf_def_v(1)%answs(:,ib),              &
7886                                surf_def_v(2)%answs(:,ib), surf_def_v(3)%answs(:,ib),              &
7887                                surf_lsm_v(0)%answs(:,ib), surf_lsm_v(1)%answs(:,ib),              &
7888                                surf_lsm_v(2)%answs(:,ib), surf_lsm_v(3)%answs(:,ib),              &
7889                                surf_usm_v(0)%answs(:,ib), surf_usm_v(1)%answs(:,ib),              &
7890                                surf_usm_v(2)%answs(:,ib), surf_usm_v(3)%answs(:,ib) )
7891       CASE ( 'aerosol_mass' )
7892          CALL diffusion_s( rs, surf_def_h(0)%amsws(:,icc),                                        &
7893                                surf_def_h(1)%amsws(:,icc), surf_def_h(2)%amsws(:,icc),            &
7894                                surf_lsm_h%amsws(:,icc),    surf_usm_h%amsws(:,icc),               &
7895                                surf_def_v(0)%amsws(:,icc), surf_def_v(1)%amsws(:,icc),            &
7896                                surf_def_v(2)%amsws(:,icc), surf_def_v(3)%amsws(:,icc),            &
7897                                surf_lsm_v(0)%amsws(:,icc), surf_lsm_v(1)%amsws(:,icc),            &
7898                                surf_lsm_v(2)%amsws(:,icc), surf_lsm_v(3)%amsws(:,icc),            &
7899                                surf_usm_v(0)%amsws(:,icc), surf_usm_v(1)%amsws(:,icc),            &
7900                                surf_usm_v(2)%amsws(:,icc), surf_usm_v(3)%amsws(:,icc) )
7901       CASE ( 'salsa_gas' )
7902          CALL diffusion_s( rs, surf_def_h(0)%gtsws(:,ib),                                         &
7903                                surf_def_h(1)%gtsws(:,ib), surf_def_h(2)%gtsws(:,ib),              &
7904                                surf_lsm_h%gtsws(:,ib),    surf_usm_h%gtsws(:,ib),                 &
7905                                surf_def_v(0)%gtsws(:,ib), surf_def_v(1)%gtsws(:,ib),              &
7906                                surf_def_v(2)%gtsws(:,ib), surf_def_v(3)%gtsws(:,ib),              &
7907                                surf_lsm_v(0)%gtsws(:,ib), surf_lsm_v(1)%gtsws(:,ib),              &
7908                                surf_lsm_v(2)%gtsws(:,ib), surf_lsm_v(3)%gtsws(:,ib),              &
7909                                surf_usm_v(0)%gtsws(:,ib), surf_usm_v(1)%gtsws(:,ib),              &
7910                                surf_usm_v(2)%gtsws(:,ib), surf_usm_v(3)%gtsws(:,ib) )
7911    END SELECT
7912!
7913!-- Prognostic equation for a scalar
7914    DO  i = nxl, nxr
7915       DO  j = nys, nyn
7916!
7917!--       Sedimentation for aerosol number and mass
7918          IF ( lsdepo  .AND.  do_sedimentation )  THEN
7919             tend(nzb+1:nzt,j,i) = tend(nzb+1:nzt,j,i) - MAX( 0.0_wp, ( rs(nzb+2:nzt+1,j,i) *      &
7920                                   sedim_vd(nzb+2:nzt+1,j,i,ib) - rs(nzb+1:nzt,j,i) *              &
7921                                   sedim_vd(nzb+1:nzt,j,i,ib) ) * ddzu(nzb+1:nzt) ) *              &
7922                                   MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_0(nzb:nzt-1,j,i), 0 ) )
7923          ENDIF
7924          DO  k = nzb+1, nzt
7925             rs_p(k,j,i) = rs(k,j,i) +  ( dt_3d  * ( tsc(2) * tend(k,j,i) + tsc(3) * trs_m(k,j,i) )&
7926                                                  - tsc(5) * rdf_sc(k) * ( rs(k,j,i) - rs_init(k) )&
7927                                        ) * MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_0(k,j,i), 0 ) )
7928             IF ( rs_p(k,j,i) < 0.0_wp )  rs_p(k,j,i) = 0.1_wp * rs(k,j,i)
7929          ENDDO
7930       ENDDO
7931    ENDDO
7932!
7933!-- Calculate tendencies for the next Runge-Kutta step
7934    IF ( timestep_scheme(1:5) == 'runge' )  THEN
7935       IF ( intermediate_timestep_count == 1 )  THEN
7936          DO  i = nxl, nxr
7937             DO  j = nys, nyn
7938                DO  k = nzb+1, nzt
7939                   trs_m(k,j,i) = tend(k,j,i)
7940                ENDDO
7941             ENDDO
7942          ENDDO
7943       ELSEIF ( intermediate_timestep_count < intermediate_timestep_count_max )  THEN
7944          DO  i = nxl, nxr
7945             DO  j = nys, nyn
7946                DO  k = nzb+1, nzt
7947                   trs_m(k,j,i) =  -9.5625_wp * tend(k,j,i) + 5.3125_wp * trs_m(k,j,i)
7948                ENDDO
7949             ENDDO
7950          ENDDO
7951       ENDIF
7952    ENDIF
7953
7954 END SUBROUTINE salsa_tendency
7955
7956!------------------------------------------------------------------------------!
7957! Description:
7958! ------------
7959!> Boundary conditions for prognostic variables in SALSA
7960!------------------------------------------------------------------------------!
7961 SUBROUTINE salsa_boundary_conds
7962
7963    USE arrays_3d,                                                                                 &
7964        ONLY:  dzu
7965
7966    USE surface_mod,                                                                               &
7967        ONLY :  bc_h
7968
7969    IMPLICIT NONE
7970
7971    INTEGER(iwp) ::  i    !< grid index x direction
7972    INTEGER(iwp) ::  ib   !< index for aerosol size bins
7973    INTEGER(iwp) ::  ic   !< index for chemical compounds in aerosols
7974    INTEGER(iwp) ::  icc  !< additional index for chemical compounds in aerosols
7975    INTEGER(iwp) ::  ig   !< idex for gaseous compounds
7976    INTEGER(iwp) ::  j    !< grid index y direction
7977    INTEGER(iwp) ::  k    !< grid index y direction
7978    INTEGER(iwp) ::  l    !< running index boundary type, for up- and downward-facing walls
7979    INTEGER(iwp) ::  m    !< running index surface elements
7980
7981    IF ( time_since_reference_point >= skip_time_do_salsa )  THEN
7982
7983!
7984!--    Surface conditions:
7985       IF ( ibc_salsa_b == 0 )  THEN   ! Dirichlet
7986!
7987!--       Run loop over all non-natural and natural walls. Note, in wall-datatype the k coordinate
7988!--       belongs to the atmospheric grid point, therefore, set s_p at k-1
7989          DO  l = 0, 1
7990             !$OMP PARALLEL PRIVATE( ib, ic, icc, ig, i, j, k )
7991             !$OMP DO
7992             DO  m = 1, bc_h(l)%ns
7993
7994                i = bc_h(l)%i(m)
7995                j = bc_h(l)%j(m)
7996                k = bc_h(l)%k(m)
7997
7998                DO  ib = 1, nbins_aerosol
7999                   aerosol_number(ib)%conc_p(k+bc_h(l)%koff,j,i) =             &
8000                                    aerosol_number(ib)%conc(k+bc_h(l)%koff,j,i)
8001                   DO  ic = 1, ncomponents_mass
8002                      icc = ( ic - 1 ) * nbins_aerosol + ib
8003                      aerosol_mass(icc)%conc_p(k+bc_h(l)%koff,j,i) =           &
8004                                    aerosol_mass(icc)%conc(k+bc_h(l)%koff,j,i)
8005                   ENDDO
8006                ENDDO
8007                IF ( .NOT. salsa_gases_from_chem )  THEN
8008                   DO  ig = 1, ngases_salsa
8009                      salsa_gas(ig)%conc_p(k+bc_h(l)%koff,j,i) =               &
8010                                    salsa_gas(ig)%conc(k+bc_h(l)%koff,j,i)
8011                   ENDDO
8012                ENDIF
8013
8014             ENDDO
8015             !$OMP END PARALLEL
8016
8017          ENDDO
8018
8019       ELSE   ! Neumann
8020
8021          DO l = 0, 1
8022             !$OMP PARALLEL PRIVATE( ib, ic, icc, ig, i, j, k )
8023             !$OMP DO
8024             DO  m = 1, bc_h(l)%ns
8025
8026                i = bc_h(l)%i(m)
8027                j = bc_h(l)%j(m)
8028                k = bc_h(l)%k(m)
8029
8030                DO  ib = 1, nbins_aerosol
8031                   aerosol_number(ib)%conc_p(k+bc_h(l)%koff,j,i) =             &
8032                                               aerosol_number(ib)%conc_p(k,j,i)
8033                   DO  ic = 1, ncomponents_mass
8034                      icc = ( ic - 1 ) * nbins_aerosol + ib
8035                      aerosol_mass(icc)%conc_p(k+bc_h(l)%koff,j,i) =           &
8036                                               aerosol_mass(icc)%conc_p(k,j,i)
8037                   ENDDO
8038                ENDDO
8039                IF ( .NOT. salsa_gases_from_chem ) THEN
8040                   DO  ig = 1, ngases_salsa
8041                      salsa_gas(ig)%conc_p(k+bc_h(l)%koff,j,i) =               &
8042                                               salsa_gas(ig)%conc_p(k,j,i)
8043                   ENDDO
8044                ENDIF
8045
8046             ENDDO
8047             !$OMP END PARALLEL
8048          ENDDO
8049
8050       ENDIF
8051!
8052!--   Top boundary conditions:
8053       IF ( ibc_salsa_t == 0 )  THEN   ! Dirichlet
8054
8055          DO  ib = 1, nbins_aerosol
8056             aerosol_number(ib)%conc_p(nzt+1,:,:) = aerosol_number(ib)%conc(nzt+1,:,:)
8057             DO  ic = 1, ncomponents_mass
8058                icc = ( ic - 1 ) * nbins_aerosol + ib
8059                aerosol_mass(icc)%conc_p(nzt+1,:,:) = aerosol_mass(icc)%conc(nzt+1,:,:)
8060             ENDDO
8061          ENDDO
8062          IF ( .NOT. salsa_gases_from_chem )  THEN
8063             DO  ig = 1, ngases_salsa
8064                salsa_gas(ig)%conc_p(nzt+1,:,:) = salsa_gas(ig)%conc(nzt+1,:,:)
8065             ENDDO
8066          ENDIF
8067
8068       ELSEIF ( ibc_salsa_t == 1 )  THEN   ! Neumann
8069
8070          DO  ib = 1, nbins_aerosol
8071             aerosol_number(ib)%conc_p(nzt+1,:,:) = aerosol_number(ib)%conc_p(nzt,:,:)
8072             DO  ic = 1, ncomponents_mass
8073                icc = ( ic - 1 ) * nbins_aerosol + ib
8074                aerosol_mass(icc)%conc_p(nzt+1,:,:) = aerosol_mass(icc)%conc_p(nzt,:,:)
8075             ENDDO
8076          ENDDO
8077          IF ( .NOT. salsa_gases_from_chem )  THEN
8078             DO  ig = 1, ngases_salsa
8079                salsa_gas(ig)%conc_p(nzt+1,:,:) = salsa_gas(ig)%conc_p(nzt,:,:)
8080             ENDDO
8081          ENDIF
8082
8083       ELSEIF ( ibc_salsa_t == 2 )  THEN   ! nested
8084
8085          DO  ib = 1, nbins_aerosol
8086             aerosol_number(ib)%conc_p(nzt+1,:,:) = aerosol_number(ib)%conc_p(nzt,:,:) +           &
8087                                                    bc_an_t_val(ib) * dzu(nzt+1)
8088             DO  ic = 1, ncomponents_mass
8089                icc = ( ic - 1 ) * nbins_aerosol + ib
8090                aerosol_mass(icc)%conc_p(nzt+1,:,:) = aerosol_mass(icc)%conc_p(nzt,:,:) +          &
8091                                                      bc_am_t_val(icc) * dzu(nzt+1)
8092             ENDDO
8093          ENDDO
8094          IF ( .NOT. salsa_gases_from_chem )  THEN
8095             DO  ig = 1, ngases_salsa
8096                salsa_gas(ig)%conc_p(nzt+1,:,:) = salsa_gas(ig)%conc_p(nzt,:,:) +                  &
8097                                                  bc_gt_t_val(ig) * dzu(nzt+1)
8098             ENDDO
8099          ENDIF
8100
8101       ENDIF
8102!
8103!--    Lateral boundary conditions at the outflow
8104       IF ( bc_radiation_s )  THEN
8105          DO  ib = 1, nbins_aerosol
8106             aerosol_number(ib)%conc_p(:,nys-1,:) = aerosol_number(ib)%conc_p(:,nys,:)
8107             DO  ic = 1, ncomponents_mass
8108                icc = ( ic - 1 ) * nbins_aerosol + ib
8109                aerosol_mass(icc)%conc_p(:,nys-1,:) = aerosol_mass(icc)%conc_p(:,nys,:)
8110             ENDDO
8111          ENDDO
8112          IF ( .NOT. salsa_gases_from_chem )  THEN
8113             DO  ig = 1, ngases_salsa
8114                salsa_gas(ig)%conc_p(:,nys-1,:) = salsa_gas(ig)%conc_p(:,nys,:)
8115             ENDDO
8116          ENDIF
8117
8118       ELSEIF ( bc_radiation_n )  THEN
8119          DO  ib = 1, nbins_aerosol
8120             aerosol_number(ib)%conc_p(:,nyn+1,:) = aerosol_number(ib)%conc_p(:,nyn,:)
8121             DO  ic = 1, ncomponents_mass
8122                icc = ( ic - 1 ) * nbins_aerosol + ib
8123                aerosol_mass(icc)%conc_p(:,nyn+1,:) = aerosol_mass(icc)%conc_p(:,nyn,:)
8124             ENDDO
8125          ENDDO
8126          IF ( .NOT. salsa_gases_from_chem )  THEN
8127             DO  ig = 1, ngases_salsa
8128                salsa_gas(ig)%conc_p(:,nyn+1,:) = salsa_gas(ig)%conc_p(:,nyn,:)
8129             ENDDO
8130          ENDIF
8131
8132       ELSEIF ( bc_radiation_l )  THEN
8133          DO  ib = 1, nbins_aerosol
8134             aerosol_number(ib)%conc_p(:,:,nxl-1) = aerosol_number(ib)%conc_p(:,:,nxl)
8135             DO  ic = 1, ncomponents_mass
8136                icc = ( ic - 1 ) * nbins_aerosol + ib
8137                aerosol_mass(icc)%conc_p(:,:,nxl-1) = aerosol_mass(icc)%conc_p(:,:,nxl)
8138             ENDDO
8139          ENDDO
8140          IF ( .NOT. salsa_gases_from_chem )  THEN
8141             DO  ig = 1, ngases_salsa
8142                salsa_gas(ig)%conc_p(:,:,nxl-1) = salsa_gas(ig)%conc_p(:,:,nxl)
8143             ENDDO
8144          ENDIF
8145
8146       ELSEIF ( bc_radiation_r )  THEN
8147          DO  ib = 1, nbins_aerosol
8148             aerosol_number(ib)%conc_p(:,:,nxr+1) = aerosol_number(ib)%conc_p(:,:,nxr)
8149             DO  ic = 1, ncomponents_mass
8150                icc = ( ic - 1 ) * nbins_aerosol + ib
8151                aerosol_mass(icc)%conc_p(:,:,nxr+1) = aerosol_mass(icc)%conc_p(:,:,nxr)
8152             ENDDO
8153          ENDDO
8154          IF ( .NOT. salsa_gases_from_chem )  THEN
8155             DO  ig = 1, ngases_salsa
8156                salsa_gas(ig)%conc_p(:,:,nxr+1) = salsa_gas(ig)%conc_p(:,:,nxr)
8157             ENDDO
8158          ENDIF
8159
8160       ENDIF
8161
8162    ENDIF
8163
8164 END SUBROUTINE salsa_boundary_conds
8165
8166!------------------------------------------------------------------------------!
8167! Description:
8168! ------------
8169! Undoing of the previously done cyclic boundary conditions.
8170!------------------------------------------------------------------------------!
8171 SUBROUTINE salsa_boundary_conds_decycle ( sq, sq_init )
8172
8173    IMPLICIT NONE
8174
8175    INTEGER(iwp) ::  boundary  !<
8176    INTEGER(iwp) ::  ee        !<
8177    INTEGER(iwp) ::  copied    !<
8178    INTEGER(iwp) ::  i         !<
8179    INTEGER(iwp) ::  j         !<
8180    INTEGER(iwp) ::  k         !<
8181    INTEGER(iwp) ::  ss        !<
8182
8183    REAL(wp) ::  flag  !< flag to mask topography grid points
8184
8185    REAL(wp), DIMENSION(nzb:nzt+1) ::  sq_init  !< initial concentration profile
8186
8187    REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ::  sq  !< concentration array
8188
8189    flag = 0.0_wp
8190!
8191!-- Left and right boundaries
8192    IF ( decycle_salsa_lr  .AND.  ( bc_lr_cyc  .OR. bc_lr == 'nested' ) )  THEN
8193
8194       DO  boundary = 1, 2
8195
8196          IF ( decycle_method_salsa(boundary) == 'dirichlet' )  THEN
8197!
8198!--          Initial profile is copied to ghost and first three layers
8199             ss = 1
8200             ee = 0
8201             IF ( boundary == 1  .AND.  nxl == 0 )  THEN
8202                ss = nxlg
8203                ee = nxl-1
8204             ELSEIF ( boundary == 2  .AND.  nxr == nx )  THEN
8205                ss = nxr+1
8206                ee = nxrg
8207             ENDIF
8208
8209             DO  i = ss, ee
8210                DO  j = nysg, nyng
8211                   DO  k = nzb+1, nzt
8212                      flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_0(k,j,i), 0 ) )
8213                      sq(k,j,i) = sq_init(k) * flag
8214                   ENDDO
8215                ENDDO
8216             ENDDO
8217
8218          ELSEIF ( decycle_method_salsa(boundary) == 'neumann' )  THEN
8219!
8220!--          The value at the boundary is copied to the ghost layers to simulate an outlet with
8221!--          zero gradient
8222             ss = 1
8223             ee = 0
8224             IF ( boundary == 1  .AND.  nxl == 0 )  THEN
8225                ss = nxlg
8226                ee = nxl-1
8227                copied = nxl
8228             ELSEIF ( boundary == 2  .AND.  nxr == nx )  THEN
8229                ss = nxr+1
8230                ee = nxrg
8231                copied = nxr
8232             ENDIF
8233
8234              DO  i = ss, ee
8235                DO  j = nysg, nyng
8236                   DO  k = nzb+1, nzt
8237                      flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_0(k,j,i), 0 ) )
8238                      sq(k,j,i) = sq(k,j,copied) * flag
8239                   ENDDO
8240                ENDDO
8241             ENDDO
8242
8243          ELSE
8244             WRITE(message_string,*) 'unknown decycling method: decycle_method_salsa (', boundary, &
8245                                     ') ="' // TRIM( decycle_method_salsa(boundary) ) // '"'
8246             CALL message( 'salsa_boundary_conds_decycle', 'PA0626', 1, 2, 0, 6, 0 )
8247          ENDIF
8248       ENDDO
8249    ENDIF
8250
8251!
8252!-- South and north boundaries
8253     IF ( decycle_salsa_ns  .AND.  ( bc_ns_cyc  .OR. bc_ns == 'nested' ) )  THEN
8254
8255       DO  boundary = 3, 4
8256
8257          IF ( decycle_method_salsa(boundary) == 'dirichlet' )  THEN
8258!
8259!--          Initial profile is copied to ghost and first three layers
8260             ss = 1
8261             ee = 0
8262             IF ( boundary == 3  .AND.  nys == 0 )  THEN
8263                ss = nysg
8264                ee = nys-1
8265             ELSEIF ( boundary == 4  .AND.  nyn == ny )  THEN
8266                ss = nyn+1
8267                ee = nyng
8268             ENDIF
8269
8270             DO  i = nxlg, nxrg
8271                DO  j = ss, ee
8272                   DO  k = nzb+1, nzt
8273                      flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_0(k,j,i), 0 ) )
8274                      sq(k,j,i) = sq_init(k) * flag
8275                   ENDDO
8276                ENDDO
8277             ENDDO
8278
8279          ELSEIF ( decycle_method_salsa(boundary) == 'neumann' )  THEN
8280!
8281!--          The value at the boundary is copied to the ghost layers to simulate an outlet with
8282!--          zero gradient
8283             ss = 1
8284             ee = 0
8285             IF ( boundary == 3  .AND.  nys == 0 )  THEN
8286                ss = nysg
8287                ee = nys-1
8288                copied = nys
8289             ELSEIF ( boundary == 4  .AND.  nyn == ny )  THEN
8290                ss = nyn+1
8291                ee = nyng
8292                copied = nyn
8293             ENDIF
8294
8295              DO  i = nxlg, nxrg
8296                DO  j = ss, ee
8297                   DO  k = nzb+1, nzt
8298                      flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_0(k,j,i), 0 ) )
8299                      sq(k,j,i) = sq(k,copied,i) * flag
8300                   ENDDO
8301                ENDDO
8302             ENDDO
8303
8304          ELSE
8305             WRITE(message_string,*) 'unknown decycling method: decycle_method_salsa (', boundary, &
8306                                     ') ="' // TRIM( decycle_method_salsa(boundary) ) // '"'
8307             CALL message( 'salsa_boundary_conds_decycle', 'PA0627', 1, 2, 0, 6, 0 )
8308          ENDIF
8309       ENDDO
8310    ENDIF
8311
8312 END SUBROUTINE salsa_boundary_conds_decycle
8313
8314!------------------------------------------------------------------------------!
8315! Description:
8316! ------------
8317!> Calculates the total dry or wet mass concentration for individual bins
8318!> Juha Tonttila (FMI) 2015
8319!> Tomi Raatikainen (FMI) 2016
8320!------------------------------------------------------------------------------!
8321 SUBROUTINE bin_mixrat( itype, ibin, i, j, mconc )
8322
8323    IMPLICIT NONE
8324
8325    CHARACTER(len=*), INTENT(in) ::  itype  !< 'dry' or 'wet'
8326
8327    INTEGER(iwp) ::  ic                 !< loop index for mass bin number
8328    INTEGER(iwp) ::  iend               !< end index: include water or not
8329
8330    INTEGER(iwp), INTENT(in) ::  ibin   !< index of the chemical component
8331    INTEGER(iwp), INTENT(in) ::  i      !< loop index for x-direction
8332    INTEGER(iwp), INTENT(in) ::  j      !< loop index for y-direction
8333
8334    REAL(wp), DIMENSION(:), INTENT(out) ::  mconc  !< total dry or wet mass concentration
8335
8336!-- Number of components
8337    IF ( itype == 'dry' )  THEN
8338       iend = prtcl%ncomp - 1 
8339    ELSE IF ( itype == 'wet' )  THEN
8340       iend = prtcl%ncomp
8341    ELSE
8342       message_string = 'Error in itype!'
8343       CALL message( 'bin_mixrat', 'PA0628', 2, 2, 0, 6, 0 )
8344    ENDIF
8345
8346    mconc = 0.0_wp
8347
8348    DO  ic = ibin, iend*nbins_aerosol+ibin, nbins_aerosol !< every nbins'th element
8349       mconc = mconc + aerosol_mass(ic)%conc(:,j,i)
8350    ENDDO
8351
8352 END SUBROUTINE bin_mixrat
8353
8354!------------------------------------------------------------------------------!
8355! Description:
8356! ------------
8357!> Sets surface fluxes
8358!------------------------------------------------------------------------------!
8359 SUBROUTINE salsa_emission_update
8360
8361    IMPLICIT NONE
8362
8363    IF ( include_emission )  THEN
8364
8365       IF ( time_since_reference_point >= skip_time_do_salsa  )  THEN
8366
8367          IF ( next_aero_emission_update <= time_since_reference_point )  THEN
8368             CALL salsa_emission_setup( .FALSE. )
8369          ENDIF
8370
8371          IF ( next_gas_emission_update <= time_since_reference_point )  THEN
8372             IF ( salsa_emission_mode == 'read_from_file'  .AND.  .NOT. salsa_gases_from_chem )    &
8373             THEN
8374                CALL salsa_gas_emission_setup( .FALSE. )
8375             ENDIF
8376          ENDIF
8377
8378       ENDIF
8379    ENDIF
8380
8381 END SUBROUTINE salsa_emission_update
8382
8383!------------------------------------------------------------------------------!
8384!> Description:
8385!> ------------
8386!> Define aerosol fluxes: constant or read from a from file
8387!> @todo - Emission stack height is not used yet. For default mode, emissions
8388!>         are assumed to occur on upward facing horizontal surfaces.
8389!------------------------------------------------------------------------------!
8390 SUBROUTINE salsa_emission_setup( init )
8391
8392    USE netcdf_data_input_mod,                                                                     &
8393        ONLY:  check_existence, close_input_file, get_attribute, get_variable,                     &
8394               inquire_num_variables, inquire_variable_names,                                      &
8395               get_dimension_length, open_read_file, street_type_f
8396
8397    USE palm_date_time_mod,                                                                        &
8398        ONLY:  days_per_week, get_date_time, hours_per_day, months_per_year, seconds_per_hour
8399
8400    USE surface_mod,                                                                               &
8401        ONLY:  surf_def_h, surf_lsm_h, surf_usm_h
8402
8403    IMPLICIT NONE
8404
8405    CHARACTER(LEN=80) ::  daytype = 'workday'  !< default day type
8406    CHARACTER(LEN=25) ::  in_name              !< name of a gas in the input file
8407    CHARACTER(LEN=25) ::  mod_name             !< name in the input file
8408
8409    INTEGER(iwp) ::  day_of_month   !< day of the month
8410    INTEGER(iwp) ::  day_of_week    !< day of the week
8411    INTEGER(iwp) ::  day_of_year    !< day of the year
8412    INTEGER(iwp) ::  hour_of_day    !< hour of the day
8413    INTEGER(iwp) ::  i              !< loop index
8414    INTEGER(iwp) ::  ib             !< loop index: aerosol number bins
8415    INTEGER(iwp) ::  ic             !< loop index: aerosol chemical components
8416    INTEGER(iwp) ::  id_salsa       !< NetCDF id of aerosol emission input file
8417    INTEGER(iwp) ::  in             !< loop index: emission category
8418    INTEGER(iwp) ::  index_dd       !< index day
8419    INTEGER(iwp) ::  index_hh       !< index hour
8420    INTEGER(iwp) ::  index_mm       !< index month
8421    INTEGER(iwp) ::  inn            !< loop index
8422    INTEGER(iwp) ::  j              !< loop index
8423    INTEGER(iwp) ::  month_of_year  !< month of the year
8424    INTEGER(iwp) ::  ss             !< loop index
8425
8426    INTEGER(iwp), DIMENSION(maxspec) ::  cc_i2m   !<
8427
8428    LOGICAL  ::  netcdf_extend = .FALSE.  !< NetCDF input file exists
8429
8430    LOGICAL, INTENT(in) ::  init  !< if .TRUE. --> initialisation call
8431
8432    REAL(wp) ::  second_of_day    !< second of the day
8433
8434    REAL(wp), DIMENSION(:), ALLOCATABLE ::  nsect_emission  !< sectional number emission
8435
8436    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  source_array  !< temporary source array
8437
8438!
8439!-- Define emissions:
8440    SELECT CASE ( salsa_emission_mode )
8441
8442       CASE ( 'uniform', 'parameterized' )
8443
8444          IF ( init )  THEN  ! Do only once
8445!
8446!-           Form a sectional size distribution for the emissions
8447             ALLOCATE( nsect_emission(1:nbins_aerosol),                                            &
8448                       source_array(nys:nyn,nxl:nxr,1:nbins_aerosol) )
8449!
8450!--          Precalculate a size distribution for the emission based on the mean diameter, standard
8451!--          deviation and number concentration per each log-normal mode
8452             CALL size_distribution( surface_aerosol_flux, aerosol_flux_dpg, aerosol_flux_sigmag,  &
8453                                     nsect_emission )
8454             IF ( salsa_emission_mode == 'uniform' )  THEN
8455                DO  ib = 1, nbins_aerosol
8456                   source_array(:,:,ib) = nsect_emission(ib)
8457                ENDDO
8458             ELSE
8459                IF ( street_type_f%from_file )  THEN
8460                   DO  i = nxl, nxr
8461                      DO  j = nys, nyn
8462                         IF ( street_type_f%var(j,i) >= main_street_id  .AND.                      &
8463                              street_type_f%var(j,i) < max_street_id )  THEN
8464                            source_array(j,i,:) = nsect_emission(:) * emiss_factor_main
8465                         ELSEIF ( street_type_f%var(j,i) >= side_street_id  .AND.                  &
8466                                  street_type_f%var(j,i) < main_street_id )  THEN
8467                            source_array(j,i,:) = nsect_emission(:) * emiss_factor_side
8468                         ENDIF
8469                      ENDDO
8470                   ENDDO
8471                ELSE
8472                   WRITE( message_string, * ) 'salsa_emission_mode = "parameterized" but the '//  &
8473                                              'street_type data is missing.'
8474                   CALL message( 'salsa_emission_setup', 'PA0661', 1, 2, 0, 6, 0 )
8475                ENDIF
8476             ENDIF
8477!
8478!--          Check which chemical components are used
8479             cc_i2m = 0
8480             IF ( index_so4 > 0 ) cc_i2m(1) = index_so4
8481             IF ( index_oc > 0 )  cc_i2m(2) = index_oc
8482             IF ( index_bc > 0 )  cc_i2m(3) = index_bc
8483             IF ( index_du > 0 )  cc_i2m(4) = index_du
8484             IF ( index_ss > 0 )  cc_i2m(5) = index_ss
8485             IF ( index_no > 0 )  cc_i2m(6) = index_no
8486             IF ( index_nh > 0 )  cc_i2m(7) = index_nh
8487!
8488!--          Normalise mass fractions so that their sum is 1
8489             aerosol_flux_mass_fracs_a = aerosol_flux_mass_fracs_a /                               &
8490                                         SUM( aerosol_flux_mass_fracs_a(1:ncc ) )
8491             IF ( salsa_emission_mode ==  'uniform' )  THEN
8492!
8493!--             Set uniform fluxes of default horizontal surfaces
8494                CALL set_flux( surf_def_h(0), cc_i2m, aerosol_flux_mass_fracs_a, source_array )
8495             ELSE
8496!
8497!--             Set fluxes normalised based on the street type on land surfaces
8498                CALL set_flux( surf_lsm_h, cc_i2m, aerosol_flux_mass_fracs_a, source_array )
8499             ENDIF
8500
8501             DEALLOCATE( nsect_emission, source_array )
8502          ENDIF
8503
8504       CASE ( 'read_from_file' )
8505!
8506!--       Reset surface fluxes
8507          surf_def_h(0)%answs = 0.0_wp
8508          surf_def_h(0)%amsws = 0.0_wp
8509          surf_lsm_h%answs = 0.0_wp
8510          surf_lsm_h%amsws = 0.0_wp
8511          surf_usm_h%answs = 0.0_wp
8512          surf_usm_h%amsws = 0.0_wp
8513
8514!
8515!--       Reset source arrays:
8516          DO  ib = 1, nbins_aerosol
8517             aerosol_number(ib)%source = 0.0_wp
8518          ENDDO
8519
8520          DO  ic = 1, ncomponents_mass * nbins_aerosol
8521             aerosol_mass(ic)%source = 0.0_wp
8522          ENDDO
8523
8524#if defined( __netcdf )
8525!
8526!--       Check existence of PIDS_SALSA file
8527          INQUIRE( FILE = TRIM( input_file_salsa ) // TRIM( coupling_char ), EXIST = netcdf_extend )
8528          IF ( .NOT. netcdf_extend )  THEN
8529             message_string = 'Input file '// TRIM( input_file_salsa ) //  TRIM( coupling_char )&
8530                              // ' missing!'
8531             CALL message( 'salsa_emission_setup', 'PA0629', 1, 2, 0, 6, 0 )
8532          ENDIF
8533!
8534!--       Open file in read-only mode
8535          CALL open_read_file( TRIM( input_file_salsa ) // TRIM( coupling_char ), id_salsa )
8536
8537          IF ( init )  THEN
8538!
8539!--          Variable names
8540             CALL inquire_num_variables( id_salsa, aero_emission_att%num_vars )
8541             ALLOCATE( aero_emission_att%var_names(1:aero_emission_att%num_vars) )
8542             CALL inquire_variable_names( id_salsa, aero_emission_att%var_names )
8543!
8544!--          Read the index and name of chemical components
8545             CALL get_dimension_length( id_salsa, aero_emission_att%ncc,         &
8546                                                          'composition_index' )
8547             ALLOCATE( aero_emission_att%cc_index(1:aero_emission_att%ncc) )
8548             CALL get_variable( id_salsa, 'composition_index', aero_emission_att%cc_index )
8549
8550             IF ( check_existence( aero_emission_att%var_names, 'composition_name' ) )  THEN
8551                CALL get_variable( id_salsa, 'composition_name', aero_emission_att%cc_name,        &
8552                                   aero_emission_att%ncc )
8553             ELSE
8554                message_string = 'Missing composition_name in ' // TRIM( input_file_salsa )
8555                CALL message( 'salsa_emission_setup', 'PA0657', 1, 2, 0, 6, 0 )
8556             ENDIF
8557!
8558!--          Find the corresponding chemical components in the model
8559             aero_emission_att%cc_in2mod = 0
8560             DO  ic = 1, aero_emission_att%ncc
8561                in_name = aero_emission_att%cc_name(ic)
8562                SELECT CASE ( TRIM( in_name ) )
8563                   CASE ( 'H2SO4', 'h2so4', 'SO4', 'so4' )
8564                      aero_emission_att%cc_in2mod(1) = ic
8565                   CASE ( 'OC', 'oc', 'organics' )
8566                      aero_emission_att%cc_in2mod(2) = ic
8567                   CASE ( 'BC', 'bc' )
8568                      aero_emission_att%cc_in2mod(3) = ic
8569                   CASE ( 'DU', 'du' )
8570                      aero_emission_att%cc_in2mod(4) = ic
8571                   CASE ( 'SS', 'ss' )
8572                      aero_emission_att%cc_in2mod(5) = ic
8573                   CASE ( 'HNO3', 'hno3', 'NO', 'no', 'NO3', 'no3' )
8574                      aero_emission_att%cc_in2mod(6) = ic
8575                   CASE ( 'NH3', 'nh3', 'NH', 'nh', 'NH4', 'nh4' )
8576                      aero_emission_att%cc_in2mod(7) = ic
8577                END SELECT
8578
8579             ENDDO
8580
8581             IF ( SUM( aero_emission_att%cc_in2mod ) == 0 )  THEN
8582                message_string = 'None of the aerosol chemical components in ' // TRIM(            &
8583                                 input_file_salsa ) // ' correspond to the ones applied in SALSA.'
8584                CALL message( 'salsa_emission_setup', 'PA0630', 1, 2, 0, 6, 0 )
8585             ENDIF
8586!
8587!--          Inquire the fill value
8588             CALL get_attribute( id_salsa, '_FillValue', aero_emission%fill, .FALSE.,              &
8589                                 'aerosol_emission_values' )
8590!
8591!--          Inquire units of emissions
8592             CALL get_attribute( id_salsa, 'units', aero_emission_att%units, .FALSE.,              &
8593                                 'aerosol_emission_values' )
8594!
8595!--          Inquire the level of detail (lod)
8596             CALL get_attribute( id_salsa, 'lod', aero_emission_att%lod, .FALSE.,                  &
8597                                 'aerosol_emission_values' )
8598
8599!
8600!--          Read different emission information depending on the level of detail of emissions:
8601
8602!
8603!--          Default mode:
8604             IF ( aero_emission_att%lod == 1 )  THEN
8605!
8606!--             Unit conversion factor: convert to SI units (kg/m2/s)
8607                IF ( aero_emission_att%units == 'kg/m2/yr' )  THEN
8608                   aero_emission_att%conversion_factor = 1.0_wp / 3600.0_wp
8609                ELSEIF ( aero_emission_att%units == 'g/m2/yr' )  THEN
8610                   aero_emission_att%conversion_factor = 0.001_wp / 3600.0_wp
8611                ELSE
8612                   message_string = 'unknown unit for aerosol emissions: ' //                      &
8613                                    TRIM( aero_emission_att%units ) // ' (lod1)'
8614                   CALL message( 'salsa_emission_setup','PA0631', 1, 2, 0, 6, 0 )
8615                ENDIF
8616!
8617!--             Get number of emission categories and allocate emission arrays
8618                CALL get_dimension_length( id_salsa, aero_emission_att%ncat, 'ncat' )
8619                ALLOCATE( aero_emission_att%cat_index(1:aero_emission_att%ncat),                   &
8620                          aero_emission_att%rho(1:aero_emission_att%ncat),                         &
8621                          aero_emission_att%time_factor(1:aero_emission_att%ncat) )
8622!
8623!--             Get emission category names and indices
8624                IF ( check_existence( aero_emission_att%var_names, 'emission_category_name' ) )  THEN
8625                   CALL get_variable( id_salsa, 'emission_category_name',                          &
8626                                      aero_emission_att%cat_name,  aero_emission_att%ncat )
8627                ELSE
8628                   message_string = 'Missing emission_category_name in ' // TRIM( input_file_salsa )
8629                   CALL message( 'salsa_emission_setup', 'PA0658', 1, 2, 0, 6, 0 )
8630                ENDIF
8631                CALL get_variable( id_salsa, 'emission_category_index', aero_emission_att%cat_index )
8632!
8633!--             Find corresponding emission categories
8634                DO  in = 1, aero_emission_att%ncat
8635                   in_name = aero_emission_att%cat_name(in)
8636                   DO  ss = 1, def_modes%ndc
8637                      mod_name = def_modes%cat_name_table(ss)
8638                      IF ( TRIM( in_name(1:4) ) == TRIM( mod_name(1:4 ) ) )  THEN
8639                         def_modes%cat_input_to_model(ss) = in
8640                      ENDIF
8641                   ENDDO
8642                ENDDO
8643
8644                IF ( SUM( def_modes%cat_input_to_model ) == 0 )  THEN
8645                   message_string = 'None of the emission categories in ' //  TRIM(                &
8646                                    input_file_salsa ) // ' match with the ones in the model.'
8647                   CALL message( 'salsa_emission_setup', 'PA0632', 1, 2, 0, 6, 0 )
8648                ENDIF
8649!
8650!--             Emission time factors: Find check whether emission time factors are given for each
8651!--             hour of year OR based on month, day and hour
8652!
8653!--             For each hour of year:
8654                IF ( check_existence( aero_emission_att%var_names, 'nhoursyear' ) )  THEN
8655                   CALL get_dimension_length( id_salsa,                                            &
8656                                              aero_emission_att%nhoursyear, 'nhoursyear' )
8657                   ALLOCATE( aero_emission_att%etf(1:aero_emission_att%ncat,                       &
8658                                                   1:aero_emission_att%nhoursyear) )
8659                   CALL get_variable( id_salsa, 'emission_time_factors', aero_emission_att%etf,    &
8660                                    0, aero_emission_att%nhoursyear-1, 0, aero_emission_att%ncat-1 )
8661!
8662!--             Based on the month, day and hour:
8663                ELSEIF ( check_existence( aero_emission_att%var_names, 'nmonthdayhour' ) )  THEN
8664                   CALL get_dimension_length( id_salsa,                                            &
8665                                              aero_emission_att%nmonthdayhour,                     &
8666                                              'nmonthdayhour' )
8667                   ALLOCATE( aero_emission_att%etf(1:aero_emission_att%ncat,                       &
8668                                                   1:aero_emission_att%nmonthdayhour) )
8669                   CALL get_variable( id_salsa, 'emission_time_factors', aero_emission_att%etf,    &
8670                                 0, aero_emission_att%nmonthdayhour-1, 0, aero_emission_att%ncat-1 )
8671                ELSE
8672                   message_string = 'emission_time_factors should be given for each nhoursyear ' //&
8673                                    'OR nmonthdayhour'
8674                   CALL message( 'salsa_emission_setup','PA0633', 1, 2, 0, 6, 0 )
8675                ENDIF
8676!
8677!--             Next emission update
8678                CALL get_date_time( 0.0_wp, second_of_day=second_of_day )
8679                next_aero_emission_update = MOD( second_of_day, seconds_per_hour ) - seconds_per_hour
8680!
8681!--             Get chemical composition (i.e. mass fraction of different species) in aerosols
8682                IF ( check_existence( aero_emission_att%var_names, 'emission_mass_fracs' ) )  THEN
8683                   ALLOCATE( aero_emission%def_mass_fracs(1:aero_emission_att%ncat,                &
8684                                                          1:aero_emission_att%ncc) )
8685                   aero_emission%def_mass_fracs = 0.0_wp
8686                   CALL get_variable( id_salsa, 'emission_mass_fracs', aero_emission%def_mass_fracs,&
8687                                      0, aero_emission_att%ncc-1, 0, aero_emission_att%ncat-1 )
8688                ELSE
8689                   message_string = 'Missing emission_mass_fracs in ' //  TRIM( input_file_salsa )
8690                   CALL message( 'salsa_emission_setup', 'PA0659', 1, 2, 0, 6, 0 )
8691                ENDIF
8692!
8693!--             If the chemical component is not activated, set its mass fraction to 0 to avoid
8694!--             inbalance between number and mass flux
8695                cc_i2m = aero_emission_att%cc_in2mod
8696                IF ( index_so4 < 0  .AND.  cc_i2m(1) > 0 )                                         &
8697                                                  aero_emission%def_mass_fracs(:,cc_i2m(1)) = 0.0_wp
8698                IF ( index_oc  < 0  .AND.  cc_i2m(2) > 0 )                                         &
8699                                                  aero_emission%def_mass_fracs(:,cc_i2m(2)) = 0.0_wp
8700                IF ( index_bc  < 0  .AND.  cc_i2m(3) > 0 )                                         &
8701                                                  aero_emission%def_mass_fracs(:,cc_i2m(3)) = 0.0_wp
8702                IF ( index_du  < 0  .AND.  cc_i2m(4) > 0 )                                         &
8703                                                  aero_emission%def_mass_fracs(:,cc_i2m(4)) = 0.0_wp
8704                IF ( index_ss  < 0  .AND.  cc_i2m(5) > 0 )                                         &
8705                                                  aero_emission%def_mass_fracs(:,cc_i2m(5)) = 0.0_wp
8706                IF ( index_no  < 0  .AND.  cc_i2m(6) > 0 )                                         &
8707                                                  aero_emission%def_mass_fracs(:,cc_i2m(6)) = 0.0_wp
8708                IF ( index_nh  < 0  .AND.  cc_i2m(7) > 0 )                                         &
8709                                                  aero_emission%def_mass_fracs(:,cc_i2m(7)) = 0.0_wp
8710!
8711!--             Then normalise the mass fraction so that SUM = 1
8712                DO  in = 1, aero_emission_att%ncat
8713                   aero_emission%def_mass_fracs(in,:) = aero_emission%def_mass_fracs(in,:) /       &
8714                                                       SUM( aero_emission%def_mass_fracs(in,:) )
8715                ENDDO
8716!
8717!--             Calculate average mass density (kg/m3)
8718                aero_emission_att%rho = 0.0_wp
8719
8720                IF ( cc_i2m(1) /= 0 )  aero_emission_att%rho = aero_emission_att%rho +  arhoh2so4 *&
8721                                                           aero_emission%def_mass_fracs(:,cc_i2m(1))
8722                IF ( cc_i2m(2) /= 0 )  aero_emission_att%rho = aero_emission_att%rho + arhooc *    &
8723                                                           aero_emission%def_mass_fracs(:,cc_i2m(2))
8724                IF ( cc_i2m(3) /= 0 )  aero_emission_att%rho = aero_emission_att%rho + arhobc *    &
8725                                                           aero_emission%def_mass_fracs(:,cc_i2m(3))
8726                IF ( cc_i2m(4) /= 0 )  aero_emission_att%rho = aero_emission_att%rho + arhodu *    &
8727                                                           aero_emission%def_mass_fracs(:,cc_i2m(4))
8728                IF ( cc_i2m(5) /= 0 )  aero_emission_att%rho = aero_emission_att%rho + arhoss *    &
8729                                                           aero_emission%def_mass_fracs(:,cc_i2m(5))
8730                IF ( cc_i2m(6) /= 0 )  aero_emission_att%rho = aero_emission_att%rho + arhohno3 *  &
8731                                                           aero_emission%def_mass_fracs(:,cc_i2m(6))
8732                IF ( cc_i2m(7) /= 0 )  aero_emission_att%rho = aero_emission_att%rho + arhonh3 *   &
8733                                                           aero_emission%def_mass_fracs(:,cc_i2m(7))
8734!
8735!--             Allocate and read surface emission data (in total PM)
8736                ALLOCATE( aero_emission%def_data(nys:nyn,nxl:nxr,1:aero_emission_att%ncat) )
8737                CALL get_variable( id_salsa, 'aerosol_emission_values', aero_emission%def_data,    &
8738                                   0, aero_emission_att%ncat-1, nxl, nxr, nys, nyn )
8739
8740!
8741!--          Pre-processed mode
8742             ELSEIF ( aero_emission_att%lod == 2 )  THEN
8743!
8744!--             Unit conversion factor: convert to SI units (#/m2/s)
8745                IF ( aero_emission_att%units == '#/m2/s' )  THEN
8746                   aero_emission_att%conversion_factor = 1.0_wp
8747                ELSE
8748                   message_string = 'unknown unit for aerosol emissions: ' //                      &
8749                                    TRIM( aero_emission_att%units )
8750                   CALL message( 'salsa_emission_setup','PA0634', 1, 2, 0, 6, 0 )
8751                ENDIF
8752!
8753!--             Number of aerosol size bins in the emission data
8754                CALL get_dimension_length( id_salsa, aero_emission_att%nbins, 'Dmid' )
8755                IF ( aero_emission_att%nbins /= nbins_aerosol )  THEN
8756                   message_string = 'The number of size bins in aerosol input data does not ' //   &
8757                                    'correspond to the model set-up'
8758                   CALL message( 'salsa_emission_setup','PA0635', 1, 2, 0, 6, 0 )
8759                ENDIF
8760!
8761!--             Number of time steps in the emission data
8762                CALL get_dimension_length( id_salsa, aero_emission_att%nt, 'time')
8763!
8764!--             Allocate bin diameters, time and mass fraction array
8765                ALLOCATE( aero_emission_att%dmid(1:nbins_aerosol),                                 &
8766                          aero_emission_att%time(1:aero_emission_att%nt),                          &
8767                          aero_emission%preproc_mass_fracs(1:aero_emission_att%ncc) )
8768!
8769!--             Read mean diameters
8770                CALL get_variable( id_salsa, 'Dmid', aero_emission_att%dmid )
8771!
8772!--             Check whether the sectional representation of the aerosol size distribution conform
8773!--             to the one applied in the model
8774                IF ( ANY( ABS( ( aero(1:nbins_aerosol)%dmid - aero_emission_att%dmid ) /           &
8775                               aero(1:nbins_aerosol)%dmid ) > 0.1_wp )  )  THEN
8776                   message_string = 'Mean diameters of size bins in ' // TRIM( input_file_salsa )  &
8777                                    // ' do not match with the ones in the model.'
8778                   CALL message( 'salsa_emission_setup','PA0636', 1, 2, 0, 6, 0 )
8779                ENDIF
8780!
8781!--             Read time stamps:
8782                IF ( check_existence( aero_emission_att%var_names, 'time' ) )  THEN
8783                   CALL get_variable( id_salsa, 'time', aero_emission_att%time )
8784                ELSE
8785                   message_string = 'Missing time in ' //  TRIM( input_file_salsa )
8786                   CALL message( 'salsa_emission_setup', 'PA0660', 1, 2, 0, 6, 0 )
8787                ENDIF
8788!
8789!--             Read emission mass fractions
8790                IF ( check_existence( aero_emission_att%var_names, 'emission_mass_fracs' ) )  THEN
8791                   CALL get_variable( id_salsa, 'emission_mass_fracs',                             &
8792                                      aero_emission%preproc_mass_fracs )
8793                ELSE
8794                   message_string = 'Missing emission_mass_fracs in ' //  TRIM( input_file_salsa )
8795                   CALL message( 'salsa_emission_setup', 'PA0659', 1, 2, 0, 6, 0 )
8796                ENDIF
8797!
8798!--             If the chemical component is not activated, set its mass fraction to 0
8799                cc_i2m = aero_emission_att%cc_in2mod
8800                IF ( index_so4 < 0  .AND.  cc_i2m(1) /= 0 )                                        &
8801                   aero_emission%preproc_mass_fracs(cc_i2m(1)) = 0.0_wp
8802                IF ( index_oc  < 0  .AND.  cc_i2m(2) /= 0 )                                        &
8803                   aero_emission%preproc_mass_fracs(cc_i2m(2)) = 0.0_wp
8804                IF ( index_bc  < 0  .AND.  cc_i2m(3) /= 0 )                                        &
8805                   aero_emission%preproc_mass_fracs(cc_i2m(3)) = 0.0_wp
8806                IF ( index_du  < 0  .AND.  cc_i2m(4) /= 0 )                                        &
8807                   aero_emission%preproc_mass_fracs(cc_i2m(4)) = 0.0_wp
8808                IF ( index_ss  < 0  .AND.  cc_i2m(5) /= 0 )                                        &
8809                   aero_emission%preproc_mass_fracs(cc_i2m(5)) = 0.0_wp
8810                IF ( index_no  < 0  .AND.  cc_i2m(6) /= 0 )                                        &
8811                   aero_emission%preproc_mass_fracs(cc_i2m(6)) = 0.0_wp
8812                IF ( index_nh  < 0  .AND.  cc_i2m(7) /= 0 )                                        &
8813                   aero_emission%preproc_mass_fracs(cc_i2m(7)) = 0.0_wp
8814!
8815!--             Then normalise the mass fraction so that SUM = 1
8816                aero_emission%preproc_mass_fracs = aero_emission%preproc_mass_fracs /              &
8817                                                   SUM( aero_emission%preproc_mass_fracs )
8818
8819             ELSE
8820                message_string = 'Unknown lod for aerosol_emission_values.'
8821                CALL message( 'salsa_emission','PA0637', 1, 2, 0, 6, 0 )
8822             ENDIF
8823
8824          ENDIF  ! init
8825!
8826!--       Define and set current emission values:
8827!
8828!--       Default type emissions (aerosol emission given as total mass emission per year):
8829          IF ( aero_emission_att%lod == 1 )  THEN
8830!
8831!--          Emission time factors for each emission category at current time step
8832             IF ( aero_emission_att%nhoursyear > aero_emission_att%nmonthdayhour )  THEN
8833!
8834!--             Get the index of the current hour
8835                CALL get_date_time( time_since_reference_point, &
8836                                    day_of_year=day_of_year, hour=hour_of_day )
8837                index_hh = ( day_of_year - 1_iwp ) * hours_per_day + hour_of_day
8838                aero_emission_att%time_factor = aero_emission_att%etf(:,index_hh)
8839
8840             ELSEIF ( aero_emission_att%nhoursyear < aero_emission_att%nmonthdayhour )  THEN
8841!
8842!--             Get the index of current hour (index_hh) (TODO: Now "workday" is always assumed.
8843!--             Needs to be calculated.)
8844                CALL get_date_time( time_since_reference_point, &
8845                                    month=month_of_year,        &
8846                                    day=day_of_month,           &
8847                                    hour=hour_of_day,           &
8848                                    day_of_week=day_of_week     )
8849                index_mm = month_of_year
8850                index_dd = months_per_year + day_of_week
8851                SELECT CASE(TRIM(daytype))
8852
8853                   CASE ("workday")
8854                      index_hh = months_per_year + days_per_week + hour_of_day
8855
8856                   CASE ("weekend")
8857                      index_hh = months_per_year + days_per_week + hours_per_day + hour_of_day
8858
8859                   CASE ("holiday")
8860                      index_hh = months_per_year + days_per_week + 2*hours_per_day + hour_of_day
8861
8862                END SELECT
8863                aero_emission_att%time_factor = aero_emission_att%etf(:,index_mm) *                &
8864                                                aero_emission_att%etf(:,index_dd) *                &
8865                                                aero_emission_att%etf(:,index_hh)
8866             ENDIF
8867
8868!
8869!--          Create a sectional number size distribution for emissions
8870             ALLOCATE( nsect_emission(1:nbins_aerosol),source_array(nys:nyn,nxl:nxr,1:nbins_aerosol) )
8871             DO  in = 1, aero_emission_att%ncat
8872
8873                inn = def_modes%cat_input_to_model(in)
8874!
8875!--             Calculate the number concentration (1/m3) of a log-normal size distribution
8876!--             following Jacobson (2005): Eq 13.25.
8877                def_modes%ntot_table = 6.0_wp * def_modes%pm_frac_table(:,inn) / ( pi *            &
8878                                       ( def_modes%dpg_table )**3 *  EXP( 4.5_wp *                 &
8879                                       LOG( def_modes%sigmag_table )**2 ) )
8880!
8881!--             Sectional size distibution (1/m3) from a log-normal one
8882                CALL size_distribution( def_modes%ntot_table, def_modes%dpg_table,                 &
8883                                        def_modes%sigmag_table, nsect_emission )
8884
8885                source_array = 0.0_wp
8886                DO  ib = 1, nbins_aerosol
8887                   source_array(:,:,ib) = aero_emission%def_data(:,:,in) *                         &
8888                                          aero_emission_att%conversion_factor /                    &
8889                                          aero_emission_att%rho(in) * nsect_emission(ib) *         &
8890                                          aero_emission_att%time_factor(in)
8891                ENDDO
8892!
8893!--             Set surface fluxes of aerosol number and mass on horizontal surfaces. Set fluxes
8894!--             only for either default, land or urban surface.
8895                IF ( .NOT. land_surface  .AND.  .NOT. urban_surface )  THEN
8896                   CALL set_flux( surf_def_h(0), aero_emission_att%cc_in2mod,                      &
8897                                  aero_emission%def_mass_fracs(in,:), source_array )
8898                ELSE
8899                   CALL set_flux( surf_usm_h, aero_emission_att%cc_in2mod,                         &
8900                                  aero_emission%def_mass_fracs(in,:), source_array )
8901                   CALL set_flux( surf_lsm_h, aero_emission_att%cc_in2mod,                         &
8902                                  aero_emission%def_mass_fracs(in,:), source_array )
8903                ENDIF
8904             ENDDO
8905!
8906!--          The next emission update is again after one hour
8907             next_aero_emission_update = next_aero_emission_update + 3600.0_wp
8908
8909
8910             DEALLOCATE( nsect_emission, source_array )
8911!
8912!--       Pre-processed:
8913          ELSEIF ( aero_emission_att%lod == 2 )  THEN
8914!
8915!--          Obtain time index for current input starting at 0.
8916!--          @todo: At the moment emission data and simulated time correspond to each other.
8917             aero_emission_att%tind = MINLOC( ABS( aero_emission_att%time -                        &
8918                                                   time_since_reference_point ), DIM = 1 ) - 1
8919!
8920!--          Allocate the data input array always before reading in the data and deallocate after
8921             ALLOCATE( aero_emission%preproc_data(nys:nyn,nxl:nxr,1:nbins_aerosol) )
8922!
8923!--          Read in the next time step
8924             CALL get_variable( id_salsa, 'aerosol_emission_values', aero_emission%preproc_data,&
8925                                aero_emission_att%tind, 0, nbins_aerosol-1, nxl, nxr, nys, nyn )
8926!
8927!--          Set surface fluxes of aerosol number and mass on horizontal surfaces. Set fluxes only
8928!--          for either default, land and urban surface.
8929             IF ( .NOT. land_surface  .AND.  .NOT. urban_surface )  THEN
8930                CALL set_flux( surf_def_h(0), aero_emission_att%cc_in2mod,                         &
8931                               aero_emission%preproc_mass_fracs, aero_emission%preproc_data )
8932             ELSE
8933                CALL set_flux( surf_usm_h, aero_emission_att%cc_in2mod,                            &
8934                               aero_emission%preproc_mass_fracs, aero_emission%preproc_data )
8935                CALL set_flux( surf_lsm_h, aero_emission_att%cc_in2mod,                            &
8936                               aero_emission%preproc_mass_fracs, aero_emission%preproc_data )
8937             ENDIF
8938!
8939!--          Determine the next emission update
8940             next_aero_emission_update = aero_emission_att%time(aero_emission_att%tind+2)
8941
8942             DEALLOCATE( aero_emission%preproc_data )
8943
8944          ENDIF
8945!
8946!--       Close input file
8947          CALL close_input_file( id_salsa )
8948#else
8949          message_string = 'salsa_emission_mode = "read_from_file", but preprocessor directive ' //&
8950                           ' __netcdf is not used in compiling!'
8951          CALL message( 'salsa_emission_setup', 'PA0638', 1, 2, 0, 6, 0 )
8952
8953#endif
8954       CASE DEFAULT
8955          message_string = 'unknown salsa_emission_mode: ' // TRIM( salsa_emission_mode )
8956          CALL message( 'salsa_emission_setup', 'PA0639', 1, 2, 0, 6, 0 )
8957
8958    END SELECT
8959
8960    CONTAINS
8961
8962!------------------------------------------------------------------------------!
8963! Description:
8964! ------------
8965!> Sets the aerosol flux to aerosol arrays in 2a and 2b.
8966!------------------------------------------------------------------------------!
8967    SUBROUTINE set_flux( surface, cc_i_mod, mass_fracs, source_array )
8968
8969       USE arrays_3d,                                                                              &
8970           ONLY:  rho_air_zw
8971
8972       USE surface_mod,                                                                            &
8973           ONLY:  surf_type
8974
8975       IMPLICIT NONE
8976
8977       INTEGER(iwp) ::  i   !< loop index
8978       INTEGER(iwp) ::  ib  !< loop index
8979       INTEGER(iwp) ::  ic  !< loop index
8980       INTEGER(iwp) ::  j   !< loop index
8981       INTEGER(iwp) ::  k   !< loop index
8982       INTEGER(iwp) ::  m   !< running index for surface elements
8983
8984       INTEGER(iwp), DIMENSION(:) ::  cc_i_mod   !< index of chemical component in the input data
8985
8986       REAL(wp) ::  so4_oc  !< mass fraction between SO4 and OC in 1a
8987
8988       REAL(wp), DIMENSION(:), INTENT(in) ::  mass_fracs  !< mass fractions of chemical components
8989
8990       REAL(wp), DIMENSION(nys:nyn,nxl:nxr,1:nbins_aerosol), INTENT(inout) ::  source_array  !<
8991
8992       TYPE(surf_type), INTENT(inout) :: surface  !< respective surface type
8993
8994       so4_oc = 0.0_wp
8995
8996       DO  m = 1, surface%ns
8997!
8998!--       Get indices of respective grid point
8999          i = surface%i(m)
9000          j = surface%j(m)
9001          k = surface%k(m)
9002
9003          DO  ib = 1, nbins_aerosol
9004             IF ( source_array(j,i,ib) < nclim )  THEN
9005                source_array(j,i,ib) = 0.0_wp
9006             ENDIF
9007!
9008!--          Set mass fluxes.  First bins include only SO4 and/or OC.
9009             IF ( ib <= end_subrange_1a )  THEN
9010!
9011!--             Both sulphate and organic carbon
9012                IF ( index_so4 > 0  .AND.  index_oc > 0 )  THEN
9013
9014                   ic = ( index_so4 - 1 ) * nbins_aerosol + ib
9015                   so4_oc = mass_fracs(cc_i_mod(1)) / ( mass_fracs(cc_i_mod(1)) +                  &
9016                                                        mass_fracs(cc_i_mod(2)) )
9017                   surface%amsws(m,ic) = surface%amsws(m,ic) + so4_oc * source_array(j,i,ib)       &
9018                                         * api6 * aero(ib)%dmid**3 * arhoh2so4 * rho_air_zw(k-1)
9019                   aerosol_mass(ic)%source(j,i) = aerosol_mass(ic)%source(j,i) + surface%amsws(m,ic)
9020
9021                   ic = ( index_oc - 1 ) * nbins_aerosol + ib
9022                   surface%amsws(m,ic) = surface%amsws(m,ic) + ( 1-so4_oc ) * source_array(j,i,ib) &
9023                                         * api6 * aero(ib)%dmid**3 * arhooc * rho_air_zw(k-1)
9024                   aerosol_mass(ic)%source(j,i) = aerosol_mass(ic)%source(j,i) + surface%amsws(m,ic)
9025!
9026!--             Only sulphates
9027                ELSEIF ( index_so4 > 0  .AND.  index_oc < 0 )  THEN
9028                   ic = ( index_so4 - 1 ) * nbins_aerosol + ib
9029                   surface%amsws(m,ic) = surface%amsws(m,ic) + source_array(j,i,ib) * api6 *       &
9030                                         aero(ib)%dmid**3 * arhoh2so4 * rho_air_zw(k-1)
9031                   aerosol_mass(ic)%source(j,i) = aerosol_mass(ic)%source(j,i) + surface%amsws(m,ic)
9032!
9033!--             Only organic carbon
9034                ELSEIF ( index_so4 < 0  .AND.  index_oc > 0 )  THEN
9035                   ic = ( index_oc - 1 ) * nbins_aerosol + ib
9036                   surface%amsws(m,ic) = surface%amsws(m,ic) + source_array(j,i,ib) * api6 *       &
9037                                         aero(ib)%dmid**3 * arhooc * rho_air_zw(k-1)
9038                   aerosol_mass(ic)%source(j,i) = aerosol_mass(ic)%source(j,i) + surface%amsws(m,ic)
9039                ENDIF
9040
9041             ELSE
9042!
9043!--             Sulphate
9044                IF ( index_so4 > 0 )  THEN
9045                   ic = cc_i_mod(1)
9046                   CALL set_mass_flux( surface, m, ib, index_so4, mass_fracs(ic), arhoh2so4,       &
9047                                       source_array(j,i,ib) )
9048                ENDIF
9049!
9050!--             Organic carbon
9051                IF ( index_oc > 0 )  THEN
9052                   ic = cc_i_mod(2)
9053                   CALL set_mass_flux( surface, m, ib, index_oc, mass_fracs(ic),arhooc,            &
9054                                       source_array(j,i,ib) )
9055                ENDIF
9056!
9057!--             Black carbon
9058                IF ( index_bc > 0 )  THEN
9059                   ic = cc_i_mod(3)
9060                   CALL set_mass_flux( surface, m, ib, index_bc, mass_fracs(ic), arhobc,           &
9061                                       source_array(j,i,ib) )
9062                ENDIF
9063!
9064!--             Dust
9065                IF ( index_du > 0 )  THEN
9066                   ic = cc_i_mod(4)
9067                   CALL set_mass_flux( surface, m, ib, index_du, mass_fracs(ic), arhodu,           &
9068                                       source_array(j,i,ib) )
9069                ENDIF
9070!
9071!--             Sea salt
9072                IF ( index_ss > 0 )  THEN
9073                   ic = cc_i_mod(5)
9074                   CALL set_mass_flux( surface, m, ib, index_ss, mass_fracs(ic), arhoss,           &
9075                                       source_array(j,i,ib) )
9076                ENDIF
9077!
9078!--             Nitric acid
9079                IF ( index_no > 0 )  THEN
9080                    ic = cc_i_mod(6)
9081                   CALL set_mass_flux( surface, m, ib, index_no, mass_fracs(ic), arhohno3,         &
9082                                       source_array(j,i,ib) )
9083                ENDIF
9084!
9085!--             Ammonia
9086                IF ( index_nh > 0 )  THEN
9087                    ic = cc_i_mod(7)
9088                   CALL set_mass_flux( surface, m, ib, index_nh, mass_fracs(ic), arhonh3,          &
9089                                       source_array(j,i,ib) )
9090                ENDIF
9091
9092             ENDIF
9093!
9094!--          Save number fluxes in the end
9095             surface%answs(m,ib) = surface%answs(m,ib) + source_array(j,i,ib) * rho_air_zw(k-1)
9096             aerosol_number(ib)%source(j,i) = aerosol_number(ib)%source(j,i) + surface%answs(m,ib)
9097
9098          ENDDO  ! ib
9099       ENDDO  ! m
9100
9101    END SUBROUTINE set_flux
9102
9103!------------------------------------------------------------------------------!
9104! Description:
9105! ------------
9106!> Sets the mass emissions to aerosol arrays in 2a and 2b.
9107!------------------------------------------------------------------------------!
9108    SUBROUTINE set_mass_flux( surface, surf_num, ib, ispec, mass_frac, prho, nsource )
9109
9110       USE arrays_3d,                                                                              &
9111           ONLY:  rho_air_zw
9112
9113       USE surface_mod,                                                                            &
9114           ONLY:  surf_type
9115
9116       IMPLICIT NONE
9117
9118       INTEGER(iwp) ::  i   !< loop index
9119       INTEGER(iwp) ::  j   !< loop index
9120       INTEGER(iwp) ::  k   !< loop index
9121       INTEGER(iwp) ::  ic  !< loop index
9122
9123       INTEGER(iwp), INTENT(in) :: ib        !< Aerosol size bin index
9124       INTEGER(iwp), INTENT(in) :: ispec     !< Aerosol species index
9125       INTEGER(iwp), INTENT(in) :: surf_num  !< index surface elements
9126
9127       REAL(wp), INTENT(in) ::  mass_frac    !< mass fraction of a chemical compound in all bins
9128       REAL(wp), INTENT(in) ::  nsource      !< number source (#/m2/s)
9129       REAL(wp), INTENT(in) ::  prho         !< Aerosol density
9130
9131       TYPE(surf_type), INTENT(inout) ::  surface  !< respective surface type
9132!
9133!--    Get indices of respective grid point
9134       i = surface%i(surf_num)
9135       j = surface%j(surf_num)
9136       k = surface%k(surf_num)
9137!
9138!--    Subrange 2a:
9139       ic = ( ispec - 1 ) * nbins_aerosol + ib
9140       surface%amsws(surf_num,ic) = surface%amsws(surf_num,ic) + mass_frac * nsource *             &
9141                                    aero(ib)%core * prho * rho_air_zw(k-1)
9142       aerosol_mass(ic)%source(j,i) = aerosol_mass(ic)%source(j,i) + surface%amsws(surf_num,ic)
9143
9144    END SUBROUTINE set_mass_flux
9145
9146 END SUBROUTINE salsa_emission_setup
9147
9148!------------------------------------------------------------------------------!
9149! Description:
9150! ------------
9151!> Sets the gaseous fluxes
9152!------------------------------------------------------------------------------!
9153 SUBROUTINE salsa_gas_emission_setup( init )
9154
9155    USE netcdf_data_input_mod,                                                                     &
9156        ONLY:  check_existence, close_input_file, get_attribute, get_variable,                     &
9157               inquire_num_variables, inquire_variable_names,                                      &
9158               get_dimension_length, open_read_file
9159
9160    USE palm_date_time_mod,                                                                        &
9161        ONLY:  days_per_week, get_date_time, hours_per_day, months_per_year, seconds_per_hour
9162
9163    USE surface_mod,                                                                               &
9164        ONLY:  surf_def_h, surf_lsm_h, surf_usm_h
9165
9166    IMPLICIT NONE
9167
9168    CHARACTER(LEN=80) ::  daytype = 'workday'  !< default day type
9169    CHARACTER(LEN=25) ::  in_name              !< name of a gas in the input file
9170
9171    CHARACTER(LEN=100), DIMENSION(:), ALLOCATABLE ::  var_names   !<  variable names in input data
9172
9173
9174    INTEGER(iwp) ::  day_of_month   !< day of the month
9175    INTEGER(iwp) ::  day_of_week    !< day of the week
9176    INTEGER(iwp) ::  day_of_year    !< day of the year
9177    INTEGER(iwp) ::  hour_of_day    !< hour of the day
9178    INTEGER(iwp) ::  id_chem        !< NetCDF id of chemistry emission file
9179    INTEGER(iwp) ::  i              !< loop index
9180    INTEGER(iwp) ::  ig             !< loop index
9181    INTEGER(iwp) ::  in             !< running index for emission categories
9182    INTEGER(iwp) ::  index_dd       !< index day
9183    INTEGER(iwp) ::  index_hh       !< index hour
9184    INTEGER(iwp) ::  index_mm       !< index month
9185    INTEGER(iwp) ::  j              !< loop index
9186    INTEGER(iwp) ::  month_of_year  !< month of the year
9187    INTEGER(iwp) ::  num_vars       !< number of variables
9188
9189    LOGICAL  ::  netcdf_extend = .FALSE.  !< NetCDF input file exists
9190
9191    LOGICAL, INTENT(in) ::  init          !< if .TRUE. --> initialisation call
9192
9193    REAL(wp) ::  second_of_day    !< second of the day
9194
9195    REAL(wp), DIMENSION(:), ALLOCATABLE ::  time_factor  !< emission time factor
9196
9197    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  dum_var_3d  !<
9198
9199    REAL(wp), DIMENSION(:,:,:,:,:), ALLOCATABLE ::  dum_var_5d  !<
9200
9201!
9202!-- Reset surface fluxes
9203    surf_def_h(0)%gtsws = 0.0_wp
9204    surf_lsm_h%gtsws = 0.0_wp
9205    surf_usm_h%gtsws = 0.0_wp
9206
9207#if defined( __netcdf )
9208!
9209!-- Check existence of PIDS_CHEM file
9210    INQUIRE( FILE = 'PIDS_CHEM' // TRIM( coupling_char ), EXIST = netcdf_extend )
9211    IF ( .NOT. netcdf_extend )  THEN
9212       message_string = 'Input file PIDS_CHEM' //  TRIM( coupling_char ) // ' missing!'
9213       CALL message( 'salsa_gas_emission_setup', 'PA0640', 1, 2, 0, 6, 0 )
9214    ENDIF
9215!
9216!-- Open file in read-only mode
9217    CALL open_read_file( 'PIDS_CHEM' // TRIM( coupling_char ), id_chem )
9218
9219    IF ( init )  THEN
9220!
9221!--    Read the index and name of chemical components
9222       CALL get_dimension_length( id_chem, chem_emission_att%n_emiss_species, 'nspecies' )
9223       ALLOCATE( chem_emission_att%species_index(1:chem_emission_att%n_emiss_species) )
9224       CALL get_variable( id_chem, 'emission_index', chem_emission_att%species_index )
9225       CALL get_variable( id_chem, 'emission_name', chem_emission_att%species_name,                &
9226                          chem_emission_att%n_emiss_species )
9227!
9228!--    Allocate emission data
9229       ALLOCATE( chem_emission(1:chem_emission_att%n_emiss_species) )
9230!
9231!--    Find the corresponding indices in the model
9232       emission_index_chem = 0
9233       DO  ig = 1, chem_emission_att%n_emiss_species
9234          in_name = chem_emission_att%species_name(ig)
9235          SELECT CASE ( TRIM( in_name ) )
9236             CASE ( 'H2SO4', 'h2so4' )
9237                emission_index_chem(1) = ig
9238             CASE ( 'HNO3', 'hno3' )
9239                emission_index_chem(2) = ig
9240             CASE ( 'NH3', 'nh3' )
9241                emission_index_chem(3) = ig
9242             CASE ( 'OCNV', 'ocnv' )
9243                emission_index_chem(4) = ig
9244             CASE ( 'OCSV', 'ocsv' )
9245                emission_index_chem(5) = ig
9246          END SELECT
9247       ENDDO
9248!
9249!--    Inquire the fill value
9250       CALL get_attribute( id_chem, '_FillValue', aero_emission%fill, .FALSE., 'emission_values' )
9251!
9252!--    Inquire units of emissions
9253       CALL get_attribute( id_chem, 'units', chem_emission_att%units, .FALSE., 'emission_values' )
9254!
9255!--    Inquire the level of detail (lod)
9256       CALL get_attribute( id_chem, 'lod', lod_gas_emissions, .FALSE., 'emission_values' )
9257!
9258!--    Variable names
9259       CALL inquire_num_variables( id_chem, num_vars )
9260       ALLOCATE( var_names(1:num_vars) )
9261       CALL inquire_variable_names( id_chem, var_names )
9262!
9263!--    Default mode: as total emissions per year
9264       IF ( lod_gas_emissions == 1 )  THEN
9265
9266!
9267!--       Get number of emission categories and allocate emission arrays
9268          CALL get_dimension_length( id_chem, chem_emission_att%ncat, 'ncat' )
9269          ALLOCATE( chem_emission_att%cat_index(1:chem_emission_att%ncat),                         &
9270                    time_factor(1:chem_emission_att%ncat) )
9271!
9272!--       Get emission category names and indices
9273          CALL get_variable( id_chem, 'emission_category_name', chem_emission_att%cat_name,        &
9274                             chem_emission_att%ncat)
9275          CALL get_variable( id_chem, 'emission_category_index', chem_emission_att%cat_index )
9276!
9277!--       Emission time factors: Find check whether emission time factors are given for each hour
9278!--       of year OR based on month, day and hour
9279!
9280!--       For each hour of year:
9281          IF ( check_existence( var_names, 'nhoursyear' ) )  THEN
9282             CALL get_dimension_length( id_chem, chem_emission_att%nhoursyear, 'nhoursyear' )
9283             ALLOCATE( chem_emission_att%hourly_emis_time_factor(1:chem_emission_att%ncat,         &
9284                                                                 1:chem_emission_att%nhoursyear) )
9285             CALL get_variable( id_chem, 'emission_time_factors',                                  &
9286                                chem_emission_att%hourly_emis_time_factor,                         &
9287                                0, chem_emission_att%nhoursyear-1, 0, chem_emission_att%ncat-1 )
9288!
9289!--       Based on the month, day and hour:
9290          ELSEIF ( check_existence( var_names, 'nmonthdayhour' ) )  THEN
9291             CALL get_dimension_length( id_chem, chem_emission_att%nmonthdayhour, 'nmonthdayhour' )
9292             ALLOCATE( chem_emission_att%mdh_emis_time_factor(1:chem_emission_att%ncat,            &
9293                                                              1:chem_emission_att%nmonthdayhour) )
9294             CALL get_variable( id_chem, 'emission_time_factors',                                  &
9295                                chem_emission_att%mdh_emis_time_factor,                            &
9296                                0, chem_emission_att%nmonthdayhour-1, 0, chem_emission_att%ncat-1 )
9297          ELSE
9298             message_string = 'emission_time_factors should be given for each nhoursyear OR ' //   &
9299                              'nmonthdayhour'
9300             CALL message( 'salsa_gas_emission_setup','PA0641', 1, 2, 0, 6, 0 )
9301          ENDIF
9302!
9303!--       Next emission update
9304          CALL get_date_time( time_since_reference_point, second_of_day=second_of_day )
9305          next_gas_emission_update = MOD( second_of_day, seconds_per_hour ) - seconds_per_hour
9306!
9307!--       Allocate and read surface emission data (in total PM) (NOTE that "preprocessed" input data
9308!--       array is applied now here)
9309          ALLOCATE( dum_var_5d(1,nys:nyn,nxl:nxr,1:chem_emission_att%n_emiss_species,              &
9310                               1:chem_emission_att%ncat) )
9311          CALL get_variable( id_chem, 'emission_values', dum_var_5d, 0, chem_emission_att%ncat-1,  &
9312                             0, chem_emission_att%n_emiss_species-1, nxl, nxr, nys, nyn, 0, 0 )
9313          DO  ig = 1, chem_emission_att%n_emiss_species
9314             ALLOCATE( chem_emission(ig)%default_emission_data(nys:nyn,nxl:nxr,                    &
9315                                                               1:chem_emission_att%ncat) )
9316             DO  in = 1, chem_emission_att%ncat
9317                DO  i = nxl, nxr
9318                   DO  j = nys, nyn
9319                      chem_emission(ig)%default_emission_data(j,i,in) = dum_var_5d(1,j,i,ig,in)
9320                   ENDDO
9321                ENDDO
9322             ENDDO
9323          ENDDO
9324          DEALLOCATE( dum_var_5d )
9325!
9326!--    Pre-processed mode:
9327       ELSEIF ( lod_gas_emissions == 2 )  THEN
9328!
9329!--       Number of time steps in the emission data
9330          CALL get_dimension_length( id_chem, chem_emission_att%dt_emission, 'time' )
9331!
9332!--       Allocate and read time
9333          ALLOCATE( gas_emission_time(1:chem_emission_att%dt_emission) )
9334          CALL get_variable( id_chem, 'time', gas_emission_time )
9335       ELSE
9336          message_string = 'Unknown lod for emission_values.'
9337          CALL message( 'salsa_gas_emission_setup','PA0642', 1, 2, 0, 6, 0 )
9338       ENDIF  ! lod
9339
9340    ENDIF  ! init
9341!
9342!-- Define and set current emission values:
9343
9344    IF ( lod_gas_emissions == 1 )  THEN
9345!
9346!--    Emission time factors for each emission category at current time step
9347       IF ( chem_emission_att%nhoursyear > chem_emission_att%nmonthdayhour )  THEN
9348!
9349!--       Get the index of the current hour
9350          CALL get_date_time( time_since_reference_point, &
9351                              day_of_year=day_of_year, hour=hour_of_day )
9352          index_hh = ( day_of_year - 1_iwp ) * hours_per_day + hour_of_day
9353          time_factor = chem_emission_att%hourly_emis_time_factor(:,index_hh)
9354
9355       ELSEIF ( chem_emission_att%nhoursyear < chem_emission_att%nmonthdayhour )  THEN
9356!
9357!--       Get the index of current hour (index_hh) (TODO: Now "workday" is always assumed.
9358!--       Needs to be calculated.)
9359          CALL get_date_time( time_since_reference_point, &
9360                              month=month_of_year,        &
9361                              day=day_of_month,           &
9362                              hour=hour_of_day,           &
9363                              day_of_week=day_of_week     )
9364          index_mm = month_of_year
9365          index_dd = months_per_year + day_of_week
9366          SELECT CASE(TRIM(daytype))
9367
9368             CASE ("workday")
9369                index_hh = months_per_year + days_per_week + hour_of_day
9370
9371             CASE ("weekend")
9372                index_hh = months_per_year + days_per_week + hours_per_day + hour_of_day
9373
9374             CASE ("holiday")
9375                index_hh = months_per_year + days_per_week + 2*hours_per_day + hour_of_day
9376
9377          END SELECT
9378          time_factor = chem_emission_att%mdh_emis_time_factor(:,index_mm) *                       &
9379                        chem_emission_att%mdh_emis_time_factor(:,index_dd) *                       &
9380                        chem_emission_att%mdh_emis_time_factor(:,index_hh)
9381       ENDIF
9382!
9383!--    Set gas emissions for each emission category
9384       ALLOCATE( dum_var_3d(nys:nyn,nxl:nxr,1:chem_emission_att%n_emiss_species) )
9385
9386       DO  in = 1, chem_emission_att%ncat
9387          DO  ig = 1, chem_emission_att%n_emiss_species
9388             dum_var_3d(:,:,ig) = chem_emission(ig)%default_emission_data(:,:,in)
9389          ENDDO
9390!
9391!--       Set surface fluxes only for either default, land or urban surface
9392          IF ( .NOT. land_surface  .AND.  .NOT. urban_surface )  THEN
9393             CALL set_gas_flux( surf_def_h(0), emission_index_chem, chem_emission_att%units,       &
9394                                dum_var_3d(:,:,in), time_factor(in) )
9395          ELSE
9396             CALL set_gas_flux( surf_usm_h, emission_index_chem, chem_emission_att%units,          &
9397                                dum_var_3d(:,:,in), time_factor(in) )
9398             CALL set_gas_flux( surf_lsm_h, emission_index_chem, chem_emission_att%units,          &
9399                                dum_var_3d(:,:,in), time_factor(in) )
9400          ENDIF
9401       ENDDO
9402       DEALLOCATE( dum_var_3d )
9403!
9404!--    The next emission update is again after one hour
9405       next_gas_emission_update = next_gas_emission_update + 3600.0_wp
9406
9407    ELSEIF ( lod_gas_emissions == 2 )  THEN
9408!
9409!--    Obtain time index for current input starting at 0.
9410!--    @todo: At the moment emission data and simulated time correspond to each other.
9411       chem_emission_att%i_hour = MINLOC( ABS( gas_emission_time - time_since_reference_point ),   &
9412                                          DIM = 1 ) - 1
9413!
9414!--    Allocate the data input array always before reading in the data and deallocate after (NOTE
9415!--    that "preprocessed" input data array is applied now here)
9416       ALLOCATE( dum_var_5d(1,1,nys:nyn,nxl:nxr,1:chem_emission_att%n_emiss_species) )
9417!
9418!--    Read in the next time step
9419       CALL get_variable( id_chem, 'emission_values', dum_var_5d,                                  &
9420                          0, chem_emission_att%n_emiss_species-1, nxl, nxr, nys, nyn, 0, 0,        &
9421                          chem_emission_att%i_hour, chem_emission_att%i_hour )
9422!
9423!--    Set surface fluxes only for either default, land or urban surface
9424       IF ( .NOT. land_surface  .AND.  .NOT. urban_surface )  THEN
9425          CALL set_gas_flux( surf_def_h(0), emission_index_chem, chem_emission_att%units,          &
9426                             dum_var_5d(1,1,:,:,:) )
9427       ELSE
9428          CALL set_gas_flux( surf_usm_h, emission_index_chem, chem_emission_att%units,             &
9429                             dum_var_5d(1,1,:,:,:) )
9430          CALL set_gas_flux( surf_lsm_h, emission_index_chem, chem_emission_att%units,             &
9431                             dum_var_5d(1,1,:,:,:) )
9432       ENDIF
9433       DEALLOCATE ( dum_var_5d )
9434!
9435!--    Determine the next emission update
9436       next_gas_emission_update = gas_emission_time(chem_emission_att%i_hour+2)
9437
9438    ENDIF
9439!
9440!-- Close input file
9441    CALL close_input_file( id_chem )
9442
9443#else
9444    message_string = 'salsa_emission_mode = "read_from_file", but preprocessor directive ' //   &
9445                     ' __netcdf is not used in compiling!'
9446    CALL message( 'salsa_gas_emission_setup', 'PA0643', 1, 2, 0, 6, 0 )
9447
9448#endif
9449
9450    CONTAINS
9451!------------------------------------------------------------------------------!
9452! Description:
9453! ------------
9454!> Set gas fluxes for selected type of surfaces
9455!------------------------------------------------------------------------------!
9456    SUBROUTINE set_gas_flux( surface, cc_i_mod, unit, source_array, time_fac )
9457
9458       USE arrays_3d,                                                                              &
9459           ONLY: dzw, hyp, pt, rho_air_zw
9460
9461       USE grid_variables,                                                                         &
9462           ONLY:  dx, dy
9463
9464       USE surface_mod,                                                                            &
9465           ONLY:  surf_type
9466
9467       IMPLICIT NONE
9468
9469       CHARACTER(LEN=*), INTENT(in) ::  unit  !< flux unit in the input file
9470
9471       INTEGER(iwp) ::  ig  !< running index for gases
9472       INTEGER(iwp) ::  i   !< loop index
9473       INTEGER(iwp) ::  j   !< loop index
9474       INTEGER(iwp) ::  k   !< loop index
9475       INTEGER(iwp) ::  m   !< running index for surface elements
9476
9477       INTEGER(iwp), DIMENSION(:) ::  cc_i_mod   !< index of different gases in the input data
9478
9479       LOGICAL ::  use_time_fac  !< .TRUE. is time_fac present
9480
9481       REAL(wp), OPTIONAL ::  time_fac  !< emission time factor
9482
9483       REAL(wp), DIMENSION(ngases_salsa) ::  conv     !< unit conversion factor
9484
9485       REAL(wp), DIMENSION(nys:nyn,nxl:nxr,chem_emission_att%n_emiss_species), INTENT(in) ::  source_array  !<
9486
9487       TYPE(surf_type), INTENT(inout) :: surface  !< respective surface type
9488
9489       conv = 1.0_wp
9490       use_time_fac = PRESENT( time_fac )
9491
9492       DO  m = 1, surface%ns
9493!
9494!--       Get indices of respective grid point
9495          i = surface%i(m)
9496          j = surface%j(m)
9497          k = surface%k(m)
9498!
9499!--       Unit conversion factor: convert to SI units (#/m2/s)
9500          SELECT CASE ( TRIM( unit ) )
9501             CASE ( 'kg/m2/yr' )
9502                conv(1) = avo / ( amh2so4 * 3600.0_wp )
9503                conv(2) = avo / ( amhno3 * 3600.0_wp )
9504                conv(3) = avo / ( amnh3 * 3600.0_wp )
9505                conv(4) = avo / ( amoc * 3600.0_wp )
9506                conv(5) = avo / ( amoc * 3600.0_wp )
9507             CASE ( 'g/m2/yr' )
9508                conv(1) = avo / ( amh2so4 * 3.6E+6_wp )
9509                conv(2) = avo / ( amhno3 * 3.6E+6_wp )
9510                conv(3) = avo / ( amnh3 * 3.6E+6_wp )
9511                conv(4) = avo / ( amoc * 3.6E+6_wp )
9512                conv(5) = avo / ( amoc * 3.6E+6_wp )
9513             CASE ( 'g/m2/s' )
9514                conv(1) = avo / ( amh2so4 * 1000.0_wp )
9515                conv(2) = avo / ( amhno3 * 1000.0_wp )
9516                conv(3) = avo / ( amnh3 * 1000.0_wp )
9517                conv(4) = avo / ( amoc * 1000.0_wp )
9518                conv(5) = avo / ( amoc * 1000.0_wp )
9519             CASE ( '#/m2/s' )
9520                conv = 1.0_wp
9521             CASE ( 'ppm/m2/s' )
9522                conv = for_ppm_to_nconc * hyp(k) / pt(k,j,i) * ( 1.0E5_wp / hyp(k) )**0.286_wp *   &
9523                       dx * dy * dzw(k)
9524             CASE ( 'mumol/m2/s' )
9525                conv = 1.0E-6_wp * avo
9526             CASE DEFAULT
9527                message_string = 'unknown unit for gas emissions: ' // TRIM( chem_emission_att%units )
9528                CALL message( 'set_gas_flux','PA0644', 1, 2, 0, 6, 0 )
9529
9530          END SELECT
9531
9532          DO  ig = 1, ngases_salsa
9533             IF ( use_time_fac )  THEN
9534                surface%gtsws(m,ig) = surface%gtsws(m,ig) + rho_air_zw(k-1) * conv(ig) * time_fac  &
9535                                      * MAX( 0.0_wp, source_array(j,i,cc_i_mod(ig) ) )
9536             ELSE
9537                surface%gtsws(m,ig) = surface%gtsws(m,ig) + rho_air_zw(k-1) * conv(ig)             &
9538                                      * MAX( 0.0_wp, source_array(j,i,cc_i_mod(ig) ) )
9539             ENDIF
9540          ENDDO  ! ig
9541
9542       ENDDO  ! m
9543
9544    END SUBROUTINE set_gas_flux
9545
9546 END SUBROUTINE salsa_gas_emission_setup
9547
9548!------------------------------------------------------------------------------!
9549! Description:
9550! ------------
9551!> Check data output for salsa.
9552!------------------------------------------------------------------------------!
9553 SUBROUTINE salsa_check_data_output( var, unit )
9554
9555    IMPLICIT NONE
9556
9557    CHARACTER(LEN=*) ::  unit     !<
9558    CHARACTER(LEN=*) ::  var      !<
9559
9560    INTEGER(iwp) ::  char_to_int   !< for converting character to integer
9561
9562    IF ( var(1:6) /= 'salsa_' )  THEN
9563       unit = 'illegal'
9564       RETURN
9565    ENDIF
9566!
9567!-- Treat bin-specific outputs separately
9568    IF ( var(7:11) ==  'N_bin' )  THEN
9569       READ( var(12:),* ) char_to_int
9570       IF ( char_to_int >= 1  .AND. char_to_int <= SUM( nbin ) )  THEN
9571          unit = '#/m3'
9572       ELSE
9573          unit = 'illegal'
9574          RETURN
9575       ENDIF
9576
9577    ELSEIF ( var(7:11) ==  'm_bin' )  THEN
9578       READ( var(12:),* ) char_to_int
9579       IF ( char_to_int >= 1  .AND. char_to_int <= SUM( nbin ) )  THEN
9580          unit = 'kg/m3'
9581       ELSE
9582          unit = 'illegal'
9583          RETURN
9584       ENDIF
9585
9586    ELSE
9587       SELECT CASE ( TRIM( var(7:) ) )
9588
9589          CASE ( 'g_H2SO4', 'g_HNO3', 'g_NH3', 'g_OCNV',  'g_OCSV' )
9590             IF (  salsa_gases_from_chem )  THEN
9591                message_string = 'gases are imported from the chemistry module and thus output '// &
9592                                 'of "' // TRIM( var ) // '" is not allowed'
9593                CALL message( 'check_parameters', 'PA0653', 1, 2, 0, 6, 0 )
9594             ENDIF
9595             unit = '#/m3'
9596
9597          CASE ( 'LDSA' )
9598             unit = 'mum2/cm3'
9599
9600          CASE ( 'PM0.1', 'PM2.5', 'PM10', 's_BC', 's_DU', 's_H2O', 's_NH', 's_NO', 's_OC',        &
9601                 's_SO4', 's_SS' )
9602             unit = 'kg/m3'
9603
9604          CASE ( 'N_UFP', 'Ntot' )
9605             unit = '#/m3'
9606
9607          CASE DEFAULT
9608             unit = 'illegal'
9609
9610       END SELECT
9611    ENDIF
9612
9613 END SUBROUTINE salsa_check_data_output
9614
9615!------------------------------------------------------------------------------!
9616! Description:
9617! ------------
9618!> Check profile data output for salsa. Currently only for diagnostic variables
9619!> Ntot, N_UFP, PM0.1, PM2.5, PM10 and LDSA
9620!------------------------------------------------------------------------------!
9621 SUBROUTINE salsa_check_data_output_pr( var, var_count, unit, dopr_unit )
9622
9623    USE arrays_3d,                                                                                 &
9624        ONLY: zu
9625
9626    USE profil_parameter,                                                                          &
9627        ONLY:  dopr_index
9628
9629    USE statistics,                                                                                &
9630        ONLY:  hom, pr_palm, statistic_regions
9631
9632    IMPLICIT NONE
9633
9634    CHARACTER(LEN=*) ::  dopr_unit  !<
9635    CHARACTER(LEN=*) ::  unit       !<
9636    CHARACTER(LEN=*) ::  var        !<
9637
9638    INTEGER(iwp) ::  var_count     !<
9639
9640    IF ( var(1:6) /= 'salsa_' )  THEN
9641       unit = 'illegal'
9642       RETURN
9643    ENDIF
9644
9645    SELECT CASE ( TRIM( var(7:) ) )
9646
9647       CASE( 'LDSA' )
9648          salsa_pr_count = salsa_pr_count + 1
9649          salsa_pr_index(salsa_pr_count) = 1
9650          dopr_index(var_count) = pr_palm + salsa_pr_count
9651          dopr_unit = 'mum2/cm3'
9652          unit = dopr_unit
9653          hom(:,2,dopr_index(var_count),:) = SPREAD( zu, 2, statistic_regions+1 )
9654
9655       CASE( 'N_UFP' )
9656          salsa_pr_count = salsa_pr_count + 1
9657          salsa_pr_index(salsa_pr_count) = 2
9658          dopr_index(var_count) = pr_palm + salsa_pr_count
9659          dopr_unit = '#/m3'
9660          unit = dopr_unit
9661          hom(:,2,dopr_index(var_count),:) = SPREAD( zu, 2, statistic_regions+1 )
9662
9663       CASE( 'Ntot' )
9664          salsa_pr_count = salsa_pr_count + 1
9665          salsa_pr_index(salsa_pr_count) = 3
9666          dopr_index(var_count) = pr_palm + salsa_pr_count
9667          dopr_unit = '#/m3'
9668          unit = dopr_unit
9669          hom(:,2,dopr_index(var_count),:) = SPREAD( zu, 2, statistic_regions+1 )
9670
9671       CASE( 'PM0.1' )
9672          salsa_pr_count = salsa_pr_count + 1
9673          salsa_pr_index(salsa_pr_count) = 4
9674          dopr_index(var_count) = pr_palm + salsa_pr_count
9675          dopr_unit = 'kg/m3'
9676          unit = dopr_unit
9677          hom(:,2,dopr_index(var_count),:) = SPREAD( zu, 2, statistic_regions+1 )
9678
9679       CASE( 'PM2.5' )
9680          salsa_pr_count = salsa_pr_count + 1
9681          salsa_pr_index(salsa_pr_count) = 5
9682          dopr_index(var_count) = pr_palm + salsa_pr_count
9683          dopr_unit = 'kg/m3'
9684          unit = dopr_unit
9685          hom(:,2,dopr_index(var_count),:) = SPREAD( zu, 2, statistic_regions+1 )
9686
9687       CASE( 'PM10' )
9688          salsa_pr_count = salsa_pr_count + 1
9689          salsa_pr_index(salsa_pr_count) = 6
9690          dopr_index(var_count) = pr_palm + salsa_pr_count
9691          dopr_unit = 'kg/m3'
9692          unit = dopr_unit
9693          hom(:,2,dopr_index(var_count),:) = SPREAD( zu, 2, statistic_regions+1 )
9694
9695       CASE DEFAULT
9696          unit = 'illegal'
9697
9698    END SELECT
9699
9700
9701 END SUBROUTINE salsa_check_data_output_pr
9702
9703!-------------------------------------------------------------------------------!
9704!> Description:
9705!> Calculation of horizontally averaged profiles for salsa.
9706!-------------------------------------------------------------------------------!
9707 SUBROUTINE salsa_statistics( mode, sr, tn )
9708
9709    USE control_parameters,                                                                        &
9710        ONLY:  max_pr_user
9711
9712    USE chem_modules,                                                                              &
9713        ONLY:  max_pr_cs
9714
9715    USE statistics,                                                                                &
9716        ONLY:  pr_palm, rmask, sums_l
9717
9718    IMPLICIT NONE
9719
9720    CHARACTER(LEN=*) ::  mode  !<
9721
9722    INTEGER(iwp) ::  i    !< loop index
9723    INTEGER(iwp) ::  ib   !< loop index
9724    INTEGER(iwp) ::  ic   !< loop index
9725    INTEGER(iwp) ::  ii   !< loop index
9726    INTEGER(iwp) ::  ind  !< index in the statistical output
9727    INTEGER(iwp) ::  j    !< loop index
9728    INTEGER(iwp) ::  k    !< loop index
9729    INTEGER(iwp) ::  sr   !< statistical region
9730    INTEGER(iwp) ::  tn   !< thread number
9731
9732    REAL(wp) ::  df        !< For calculating LDSA: fraction of particles depositing in the alveolar
9733                           !< (or tracheobronchial) region of the lung. Depends on the particle size
9734    REAL(wp) ::  mean_d    !< Particle diameter in micrometres
9735    REAL(wp) ::  temp_bin  !< temporary variable
9736
9737    IF ( mode == 'profiles' )  THEN
9738       !$OMP DO
9739       DO  ii = 1, salsa_pr_count
9740
9741          ind = pr_palm + max_pr_user + max_pr_cs + ii
9742
9743          SELECT CASE( salsa_pr_index(ii) )
9744
9745             CASE( 1 )  ! LDSA
9746                DO  i = nxl, nxr
9747                   DO  j = nys, nyn
9748                      DO  k = nzb, nzt+1
9749                         temp_bin = 0.0_wp
9750                         DO  ib = 1, nbins_aerosol
9751   !
9752   !--                      Diameter in micrometres
9753                            mean_d = 1.0E+6_wp * ra_dry(k,j,i,ib) * 2.0_wp
9754   !
9755   !--                      Deposition factor: alveolar
9756                            df = ( 0.01555_wp / mean_d ) * ( EXP( -0.416_wp * ( LOG( mean_d ) +    &
9757                                   2.84_wp )**2 ) + 19.11_wp * EXP( -0.482_wp * ( LOG( mean_d ) -  &
9758                                   1.362_wp )**2 ) )
9759   !
9760   !--                      Lung-deposited surface area LDSA (units mum2/cm3)
9761                            temp_bin = temp_bin + pi * mean_d**2 * df * 1.0E-6_wp *                &
9762                                       aerosol_number(ib)%conc(k,j,i)
9763                         ENDDO
9764                         sums_l(k,ind,tn) = sums_l(k,ind,tn) + temp_bin * rmask(j,i,sr)  *         &
9765                                           MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_0(k,j,i), 22 ) )
9766                      ENDDO
9767                   ENDDO
9768                ENDDO
9769
9770             CASE( 2 )  ! N_UFP
9771                DO  i = nxl, nxr
9772                   DO  j = nys, nyn
9773                      DO  k = nzb, nzt+1
9774                         temp_bin = 0.0_wp
9775                         DO  ib = 1, nbins_aerosol
9776                            IF ( 2.0_wp * ra_dry(k,j,i,ib) <= 0.1E-6_wp )                          &
9777                               temp_bin = temp_bin + aerosol_number(ib)%conc(k,j,i)
9778                         ENDDO
9779                         sums_l(k,ind,tn) = sums_l(k,ind,tn) + temp_bin * rmask(j,i,sr)  *         &
9780                                           MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_0(k,j,i), 22 ) )
9781                      ENDDO
9782                   ENDDO
9783                ENDDO
9784
9785             CASE( 3 )  ! Ntot
9786                DO  i = nxl, nxr
9787                   DO  j = nys, nyn
9788                      DO  k = nzb, nzt+1
9789                         temp_bin = 0.0_wp
9790                         DO  ib = 1, nbins_aerosol
9791                            temp_bin = temp_bin + aerosol_number(ib)%conc(k,j,i)
9792                         ENDDO
9793                         sums_l(k,ind,tn) = sums_l(k,ind,tn) + temp_bin * rmask(j,i,sr)  *         &
9794                                           MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_0(k,j,i), 22 ) )
9795                      ENDDO
9796                   ENDDO
9797                ENDDO
9798
9799             CASE( 4 )  ! PM0.1
9800                DO  i = nxl, nxr
9801                   DO  j = nys, nyn
9802                      DO  k = nzb, nzt+1
9803                         temp_bin = 0.0_wp
9804                         DO  ib = 1, nbins_aerosol
9805                            IF ( 2.0_wp * ra_dry(k,j,i,ib) <= 0.1E-6_wp )  THEN
9806                               DO  ic = ib, nbins_aerosol * ncc, nbins_aerosol
9807                                  temp_bin = temp_bin + aerosol_mass(ic)%conc(k,j,i)
9808                               ENDDO
9809                            ENDIF
9810                         ENDDO
9811                         sums_l(k,ind,tn) = sums_l(k,ind,tn) + temp_bin * rmask(j,i,sr)  *         &
9812                                           MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_0(k,j,i), 22 ) )
9813                      ENDDO
9814                   ENDDO
9815                ENDDO
9816
9817             CASE( 5 )  ! PM2.5
9818                DO  i = nxl, nxr
9819                   DO  j = nys, nyn
9820                      DO  k = nzb, nzt+1
9821                         temp_bin = 0.0_wp
9822                         DO  ib = 1, nbins_aerosol
9823                            IF ( 2.0_wp * ra_dry(k,j,i,ib) <= 2.5E-6_wp )  THEN
9824                               DO  ic = ib, nbins_aerosol * ncc, nbins_aerosol
9825                                  temp_bin = temp_bin + aerosol_mass(ic)%conc(k,j,i)
9826                               ENDDO
9827                            ENDIF
9828                         ENDDO
9829                         sums_l(k,ind,tn) = sums_l(k,ind,tn) + temp_bin * rmask(j,i,sr)  *         &
9830                                           MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_0(k,j,i), 22 ) )
9831                      ENDDO
9832                   ENDDO
9833                ENDDO
9834
9835             CASE( 6 )  ! PM10
9836                DO  i = nxl, nxr
9837                   DO  j = nys, nyn
9838                      DO  k = nzb, nzt+1
9839                         temp_bin = 0.0_wp
9840                         DO  ib = 1, nbins_aerosol
9841                            IF ( 2.0_wp * ra_dry(k,j,i,ib) <= 10.0E-6_wp )  THEN
9842                               DO  ic = ib, nbins_aerosol * ncc, nbins_aerosol
9843                                  temp_bin = temp_bin + aerosol_mass(ic)%conc(k,j,i)
9844                               ENDDO
9845                            ENDIF
9846                         ENDDO
9847                         sums_l(k,ind,tn) = sums_l(k,ind,tn) + temp_bin * rmask(j,i,sr)  *         &
9848                                           MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_0(k,j,i), 22 ) )
9849                      ENDDO
9850                   ENDDO
9851                ENDDO
9852
9853          END SELECT
9854       ENDDO
9855
9856    ELSEIF ( mode == 'time_series' )  THEN
9857!
9858!--    TODO
9859    ENDIF
9860
9861 END SUBROUTINE salsa_statistics
9862
9863
9864!------------------------------------------------------------------------------!
9865!
9866! Description:
9867! ------------
9868!> Subroutine for averaging 3D data
9869!------------------------------------------------------------------------------!
9870 SUBROUTINE salsa_3d_data_averaging( mode, variable )
9871
9872    USE control_parameters,                                                                        &
9873        ONLY:  average_count_3d
9874
9875    IMPLICIT NONE
9876
9877    CHARACTER(LEN=*)  ::  mode       !<
9878    CHARACTER(LEN=10) ::  vari       !<
9879    CHARACTER(LEN=*)  ::  variable   !<
9880
9881    INTEGER(iwp) ::  char_to_int  !< for converting character to integer
9882    INTEGER(iwp) ::  found_index  !<
9883    INTEGER(iwp) ::  i            !<
9884    INTEGER(iwp) ::  ib           !<
9885    INTEGER(iwp) ::  ic           !<
9886    INTEGER(iwp) ::  j            !<
9887    INTEGER(iwp) ::  k            !<
9888
9889    REAL(wp) ::  df       !< For calculating LDSA: fraction of particles depositing in the alveolar
9890                          !< (or tracheobronchial) region of the lung. Depends on the particle size
9891    REAL(wp) ::  mean_d   !< Particle diameter in micrometres
9892    REAL(wp) ::  temp_bin !< temporary variable
9893
9894    REAL(wp), DIMENSION(:,:,:), POINTER ::  to_be_resorted  !< points to selected output variable
9895
9896    temp_bin = 0.0_wp
9897
9898    IF ( mode == 'allocate' )  THEN
9899
9900       IF ( variable(7:11) ==  'N_bin' )  THEN
9901          IF ( .NOT. ALLOCATED( nbins_av ) )  THEN
9902             ALLOCATE( nbins_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg,nbins_aerosol) )
9903          ENDIF
9904          nbins_av = 0.0_wp
9905
9906       ELSEIF ( variable(7:11) ==  'm_bin' )  THEN
9907          IF ( .NOT. ALLOCATED( mbins_av ) )  THEN
9908             ALLOCATE( mbins_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg,nbins_aerosol) )
9909          ENDIF
9910          mbins_av = 0.0_wp
9911
9912       ELSE
9913
9914          SELECT CASE ( TRIM( variable(7:) ) )
9915
9916             CASE ( 'g_H2SO4' )
9917                IF ( .NOT. ALLOCATED( g_h2so4_av ) )  THEN
9918                   ALLOCATE( g_h2so4_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
9919                ENDIF
9920                g_h2so4_av = 0.0_wp
9921
9922             CASE ( 'g_HNO3' )
9923                IF ( .NOT. ALLOCATED( g_hno3_av ) )  THEN
9924                   ALLOCATE( g_hno3_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
9925                ENDIF
9926                g_hno3_av = 0.0_wp
9927
9928             CASE ( 'g_NH3' )
9929                IF ( .NOT. ALLOCATED( g_nh3_av ) )  THEN
9930                   ALLOCATE( g_nh3_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
9931                ENDIF
9932                g_nh3_av = 0.0_wp
9933
9934             CASE ( 'g_OCNV' )
9935                IF ( .NOT. ALLOCATED( g_ocnv_av ) )  THEN
9936                   ALLOCATE( g_ocnv_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
9937                ENDIF
9938                g_ocnv_av = 0.0_wp
9939
9940             CASE ( 'g_OCSV' )
9941                IF ( .NOT. ALLOCATED( g_ocsv_av ) )  THEN
9942                   ALLOCATE( g_ocsv_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
9943                ENDIF
9944                g_ocsv_av = 0.0_wp
9945
9946             CASE ( 'LDSA' )
9947                IF ( .NOT. ALLOCATED( ldsa_av ) )  THEN
9948                   ALLOCATE( ldsa_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
9949                ENDIF
9950                ldsa_av = 0.0_wp
9951
9952             CASE ( 'N_UFP' )
9953                IF ( .NOT. ALLOCATED( nufp_av ) )  THEN
9954                   ALLOCATE( nufp_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
9955                ENDIF
9956                nufp_av = 0.0_wp
9957
9958             CASE ( 'Ntot' )
9959                IF ( .NOT. ALLOCATED( ntot_av ) )  THEN
9960                   ALLOCATE( ntot_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
9961                ENDIF
9962                ntot_av = 0.0_wp
9963
9964             CASE ( 'PM0.1' )
9965                IF ( .NOT. ALLOCATED( pm01_av ) )  THEN
9966                   ALLOCATE( pm01_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
9967                ENDIF
9968                pm01_av = 0.0_wp
9969
9970             CASE ( 'PM2.5' )
9971                IF ( .NOT. ALLOCATED( pm25_av ) )  THEN
9972                   ALLOCATE( pm25_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
9973                ENDIF
9974                pm25_av = 0.0_wp
9975
9976             CASE ( 'PM10' )
9977                IF ( .NOT. ALLOCATED( pm10_av ) )  THEN
9978                   ALLOCATE( pm10_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
9979                ENDIF
9980                pm10_av = 0.0_wp
9981
9982             CASE ( 's_BC' )
9983                IF ( .NOT. ALLOCATED( s_bc_av ) )  THEN
9984                   ALLOCATE( s_bc_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
9985                ENDIF
9986                s_bc_av = 0.0_wp
9987
9988             CASE ( 's_DU' )
9989                IF ( .NOT. ALLOCATED( s_du_av ) )  THEN
9990                   ALLOCATE( s_du_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
9991                ENDIF
9992                s_du_av = 0.0_wp
9993
9994             CASE ( 's_H2O' )
9995                IF ( .NOT. ALLOCATED( s_h2o_av ) )  THEN
9996                   ALLOCATE( s_h2o_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
9997                ENDIF
9998                s_h2o_av = 0.0_wp
9999
10000             CASE ( 's_NH' )
10001                IF ( .NOT. ALLOCATED( s_nh_av ) )  THEN
10002                   ALLOCATE( s_nh_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
10003                ENDIF
10004                s_nh_av = 0.0_wp
10005
10006             CASE ( 's_NO' )
10007                IF ( .NOT. ALLOCATED( s_no_av ) )  THEN
10008                   ALLOCATE( s_no_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
10009                ENDIF
10010                s_no_av = 0.0_wp
10011
10012             CASE ( 's_OC' )
10013                IF ( .NOT. ALLOCATED( s_oc_av ) )  THEN
10014                   ALLOCATE( s_oc_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
10015                ENDIF
10016                s_oc_av = 0.0_wp
10017
10018             CASE ( 's_SO4' )
10019                IF ( .NOT. ALLOCATED( s_so4_av ) )  THEN
10020                   ALLOCATE( s_so4_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
10021                ENDIF
10022                s_so4_av = 0.0_wp
10023
10024             CASE ( 's_SS' )
10025                IF ( .NOT. ALLOCATED( s_ss_av ) )  THEN
10026                   ALLOCATE( s_ss_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
10027                ENDIF
10028                s_ss_av = 0.0_wp
10029
10030             CASE DEFAULT
10031                CONTINUE
10032
10033          END SELECT
10034
10035       ENDIF
10036
10037    ELSEIF ( mode == 'sum' )  THEN
10038
10039       IF ( variable(7:11) ==  'N_bin' )  THEN
10040          READ( variable(12:),* ) char_to_int
10041          IF ( char_to_int >= 1  .AND. char_to_int <= SUM( nbin ) )  THEN
10042             ib = char_to_int
10043             DO  i = nxlg, nxrg
10044                DO  j = nysg, nyng
10045                   DO  k = nzb, nzt+1
10046                      nbins_av(k,j,i,ib) = nbins_av(k,j,i,ib) + aerosol_number(ib)%conc(k,j,i)
10047                   ENDDO
10048                ENDDO
10049             ENDDO
10050          ENDIF
10051
10052       ELSEIF ( variable(7:11) ==  'm_bin' )  THEN
10053          READ( variable(12:),* ) char_to_int
10054          IF ( char_to_int >= 1  .AND. char_to_int <= SUM( nbin ) )  THEN
10055             ib = char_to_int
10056             DO  i = nxlg, nxrg
10057                DO  j = nysg, nyng
10058                   DO  k = nzb, nzt+1
10059                      temp_bin = 0.0_wp
10060                      DO  ic = ib, nbins_aerosol * ncomponents_mass, nbins_aerosol
10061                         temp_bin = temp_bin + aerosol_mass(ic)%conc(k,j,i)
10062                      ENDDO
10063                      mbins_av(k,j,i,ib) = mbins_av(k,j,i,ib) + temp_bin
10064                   ENDDO
10065                ENDDO
10066             ENDDO
10067          ENDIF
10068       ELSE
10069
10070          SELECT CASE ( TRIM( variable(7:) ) )
10071
10072             CASE ( 'g_H2SO4', 'g_HNO3', 'g_NH3', 'g_OCNV', 'g_OCSV' )
10073
10074                vari = TRIM( variable(9:) )  ! remove salsa_g_ from beginning
10075
10076                SELECT CASE( vari )
10077
10078                   CASE( 'H2SO4' )
10079                      found_index = 1
10080                      to_be_resorted => g_h2so4_av
10081
10082                   CASE( 'HNO3' )
10083                      found_index = 2
10084                      to_be_resorted => g_hno3_av
10085
10086                   CASE( 'NH3' )
10087                      found_index = 3
10088                      to_be_resorted => g_nh3_av
10089
10090                   CASE( 'OCNV' )
10091                      found_index = 4
10092                      to_be_resorted => g_ocnv_av
10093
10094                   CASE( 'OCSV' )
10095                      found_index = 5
10096                      to_be_resorted => g_ocsv_av
10097
10098                END SELECT
10099
10100                DO  i = nxlg, nxrg
10101                   DO  j = nysg, nyng
10102                      DO  k = nzb, nzt+1
10103                         to_be_resorted(k,j,i) = to_be_resorted(k,j,i) +                           &
10104                                                 salsa_gas(found_index)%conc(k,j,i)
10105                      ENDDO
10106                   ENDDO
10107                ENDDO
10108
10109             CASE ( 'LDSA' )
10110                DO  i = nxlg, nxrg
10111                   DO  j = nysg, nyng
10112                      DO  k = nzb, nzt+1
10113                         temp_bin = 0.0_wp
10114                         DO  ib = 1, nbins_aerosol
10115   !
10116   !--                      Diameter in micrometres
10117                            mean_d = 1.0E+6_wp * ra_dry(k,j,i,ib) * 2.0_wp
10118   !
10119   !--                      Deposition factor: alveolar (use ra_dry)
10120                            df = ( 0.01555_wp / mean_d ) * ( EXP( -0.416_wp * ( LOG( mean_d ) +    &
10121                                   2.84_wp )**2 ) + 19.11_wp * EXP( -0.482_wp * ( LOG( mean_d ) -  &
10122                                   1.362_wp )**2 ) )
10123   !
10124   !--                      Lung-deposited surface area LDSA (units mum2/cm3)
10125                            temp_bin = temp_bin + pi * mean_d**2 * df * 1.0E-6_wp *                &
10126                                       aerosol_number(ib)%conc(k,j,i)
10127                         ENDDO
10128                         ldsa_av(k,j,i) = ldsa_av(k,j,i) + temp_bin
10129                      ENDDO
10130                   ENDDO
10131                ENDDO
10132
10133             CASE ( 'N_UFP' )
10134                DO  i = nxlg, nxrg
10135                   DO  j = nysg, nyng
10136                      DO  k = nzb, nzt+1
10137                         temp_bin = 0.0_wp
10138                         DO  ib = 1, nbins_aerosol
10139                            IF ( 2.0_wp * ra_dry(k,j,i,ib) <= 0.1E-6_wp )  THEN
10140                               temp_bin = temp_bin + aerosol_number(ib)%conc(k,j,i)
10141                            ENDIF
10142                         ENDDO
10143                         nufp_av(k,j,i) = nufp_av(k,j,i) + temp_bin
10144                      ENDDO
10145                   ENDDO
10146                ENDDO
10147
10148             CASE ( 'Ntot' )
10149                DO  i = nxlg, nxrg
10150                   DO  j = nysg, nyng
10151                      DO  k = nzb, nzt+1
10152                         DO  ib = 1, nbins_aerosol
10153                            ntot_av(k,j,i) = ntot_av(k,j,i) + aerosol_number(ib)%conc(k,j,i)
10154                         ENDDO
10155                      ENDDO
10156                   ENDDO
10157                ENDDO
10158
10159             CASE ( 'PM0.1' )
10160                DO  i = nxlg, nxrg
10161                   DO  j = nysg, nyng
10162                      DO  k = nzb, nzt+1
10163                         temp_bin = 0.0_wp
10164                         DO  ib = 1, nbins_aerosol
10165                            IF ( 2.0_wp * ra_dry(k,j,i,ib) <= 0.1E-6_wp )  THEN
10166                               DO  ic = ib, nbins_aerosol * ncc, nbins_aerosol
10167                                  temp_bin = temp_bin + aerosol_mass(ic)%conc(k,j,i)
10168                               ENDDO
10169                            ENDIF
10170                         ENDDO
10171                         pm01_av(k,j,i) = pm01_av(k,j,i) + temp_bin
10172                      ENDDO
10173                   ENDDO
10174                ENDDO
10175
10176             CASE ( 'PM2.5' )
10177                DO  i = nxlg, nxrg
10178                   DO  j = nysg, nyng
10179                      DO  k = nzb, nzt+1
10180                         temp_bin = 0.0_wp
10181                         DO  ib = 1, nbins_aerosol
10182                            IF ( 2.0_wp * ra_dry(k,j,i,ib) <= 2.5E-6_wp )  THEN
10183                               DO  ic = ib, nbins_aerosol * ncc, nbins_aerosol
10184                                  temp_bin = temp_bin + aerosol_mass(ic)%conc(k,j,i)
10185                               ENDDO
10186                            ENDIF
10187                         ENDDO
10188                         pm25_av(k,j,i) = pm25_av(k,j,i) + temp_bin
10189                      ENDDO
10190                   ENDDO
10191                ENDDO
10192
10193             CASE ( 'PM10' )
10194                DO  i = nxlg, nxrg
10195                   DO  j = nysg, nyng
10196                      DO  k = nzb, nzt+1
10197                         temp_bin = 0.0_wp
10198                         DO  ib = 1, nbins_aerosol
10199                            IF ( 2.0_wp * ra_dry(k,j,i,ib) <= 10.0E-6_wp )  THEN
10200                               DO  ic = ib, nbins_aerosol * ncc, nbins_aerosol
10201                                  temp_bin = temp_bin + aerosol_mass(ic)%conc(k,j,i)
10202                               ENDDO
10203                            ENDIF
10204                         ENDDO
10205                         pm10_av(k,j,i) = pm10_av(k,j,i) + temp_bin
10206                      ENDDO
10207                   ENDDO
10208                ENDDO
10209
10210             CASE ( 's_BC', 's_DU', 's_NH', 's_NO', 's_OC', 's_SO4', 's_SS' )
10211                IF ( is_used( prtcl, TRIM( variable(9:) ) ) )  THEN  ! 9: remove salsa_s_
10212                   found_index = get_index( prtcl, TRIM( variable(9:) ) )
10213                   IF ( TRIM( variable(9:) ) == 'BC' )   to_be_resorted => s_bc_av
10214                   IF ( TRIM( variable(9:) ) == 'DU' )   to_be_resorted => s_du_av
10215                   IF ( TRIM( variable(9:) ) == 'NH' )   to_be_resorted => s_nh_av
10216                   IF ( TRIM( variable(9:) ) == 'NO' )   to_be_resorted => s_no_av
10217                   IF ( TRIM( variable(9:) ) == 'OC' )   to_be_resorted => s_oc_av
10218                   IF ( TRIM( variable(9:) ) == 'SO4' )  to_be_resorted => s_so4_av
10219                   IF ( TRIM( variable(9:) ) == 'SS' )   to_be_resorted => s_ss_av
10220                   DO  i = nxlg, nxrg
10221                      DO  j = nysg, nyng
10222                         DO  k = nzb, nzt+1
10223                            DO  ic = ( found_index-1 ) * nbins_aerosol + 1, found_index * nbins_aerosol
10224                               to_be_resorted(k,j,i) = to_be_resorted(k,j,i) +                     &
10225                                                       aerosol_mass(ic)%conc(k,j,i)
10226                            ENDDO
10227                         ENDDO
10228                      ENDDO
10229                   ENDDO
10230                ENDIF
10231
10232             CASE ( 's_H2O' )
10233                found_index = get_index( prtcl,'H2O' )
10234                to_be_resorted => s_h2o_av
10235                DO  i = nxlg, nxrg
10236                   DO  j = nysg, nyng
10237                      DO  k = nzb, nzt+1
10238                         DO  ic = ( found_index-1 ) * nbins_aerosol + 1, found_index * nbins_aerosol
10239                            s_h2o_av(k,j,i) = s_h2o_av(k,j,i) + aerosol_mass(ic)%conc(k,j,i)
10240                         ENDDO
10241                      ENDDO
10242                   ENDDO
10243                ENDDO
10244
10245             CASE DEFAULT
10246                CONTINUE
10247
10248          END SELECT
10249
10250       ENDIF
10251
10252    ELSEIF ( mode == 'average' )  THEN
10253
10254       IF ( variable(7:11) ==  'N_bin' )  THEN
10255          READ( variable(12:),* ) char_to_int
10256          IF ( char_to_int >= 1  .AND. char_to_int <= SUM( nbin ) )  THEN
10257             ib = char_to_int
10258             DO  i = nxlg, nxrg
10259                DO  j = nysg, nyng
10260                   DO  k = nzb, nzt+1
10261                      nbins_av(k,j,i,ib) = nbins_av(k,j,i,ib) / REAL( average_count_3d, KIND=wp )
10262                   ENDDO
10263                ENDDO
10264             ENDDO
10265          ENDIF
10266
10267       ELSEIF ( variable(7:11) ==  'm_bin' )  THEN
10268          READ( variable(12:),* ) char_to_int
10269          IF ( char_to_int >= 1  .AND. char_to_int <= SUM( nbin ) )  THEN
10270             ib = char_to_int
10271             DO  i = nxlg, nxrg
10272                DO  j = nysg, nyng
10273                   DO  k = nzb, nzt+1
10274                      mbins_av(k,j,i,ib) = mbins_av(k,j,i,ib) / REAL( average_count_3d, KIND=wp)
10275                   ENDDO
10276                ENDDO
10277             ENDDO
10278          ENDIF
10279       ELSE
10280
10281          SELECT CASE ( TRIM( variable(7:) ) )
10282
10283             CASE ( 'g_H2SO4', 'g_HNO3', 'g_NH3', 'g_OCNV', 'g_OCSV' )
10284                IF ( TRIM( variable(9:) ) == 'H2SO4' )  THEN  ! 9: remove salsa_g_ from beginning
10285                   found_index = 1
10286                   to_be_resorted => g_h2so4_av
10287                ELSEIF ( TRIM( variable(9:) ) == 'HNO3' )  THEN
10288                   found_index = 2
10289                   to_be_resorted => g_hno3_av
10290                ELSEIF ( TRIM( variable(9:) ) == 'NH3' )  THEN
10291                   found_index = 3
10292                   to_be_resorted => g_nh3_av
10293                ELSEIF ( TRIM( variable(9:) ) == 'OCNV' )  THEN
10294                   found_index = 4
10295                   to_be_resorted => g_ocnv_av
10296                ELSEIF ( TRIM( variable(9:) ) == 'OCSV' )  THEN
10297                   found_index = 5
10298                   to_be_resorted => g_ocsv_av
10299                ENDIF
10300                DO  i = nxlg, nxrg
10301                   DO  j = nysg, nyng
10302                      DO  k = nzb, nzt+1
10303                         to_be_resorted(k,j,i) = to_be_resorted(k,j,i) /                           &
10304                                                 REAL( average_count_3d, KIND=wp )
10305                      ENDDO
10306                   ENDDO
10307                ENDDO
10308
10309             CASE ( 'LDSA' )
10310                DO  i = nxlg, nxrg
10311                   DO  j = nysg, nyng
10312                      DO  k = nzb, nzt+1
10313                         ldsa_av(k,j,i) = ldsa_av(k,j,i) / REAL( average_count_3d, KIND=wp )
10314                      ENDDO
10315                   ENDDO
10316                ENDDO
10317
10318             CASE ( 'N_UFP' )
10319                DO  i = nxlg, nxrg
10320                   DO  j = nysg, nyng
10321                      DO  k = nzb, nzt+1
10322                         nufp_av(k,j,i) = nufp_av(k,j,i) / REAL( average_count_3d, KIND=wp )
10323                      ENDDO
10324                   ENDDO
10325                ENDDO
10326
10327             CASE ( 'Ntot' )
10328                DO  i = nxlg, nxrg
10329                   DO  j = nysg, nyng
10330                      DO  k = nzb, nzt+1
10331                         ntot_av(k,j,i) = ntot_av(k,j,i) / REAL( average_count_3d, KIND=wp )
10332                      ENDDO
10333                   ENDDO
10334                ENDDO
10335
10336
10337             CASE ( 'PM0.1' )
10338                DO  i = nxlg, nxrg
10339                   DO  j = nysg, nyng
10340                      DO  k = nzb, nzt+1
10341                         pm01_av(k,j,i) = pm01_av(k,j,i) / REAL( average_count_3d, KIND=wp )
10342                      ENDDO
10343                   ENDDO
10344                ENDDO
10345
10346             CASE ( 'PM2.5' )
10347                DO  i = nxlg, nxrg
10348                   DO  j = nysg, nyng
10349                      DO  k = nzb, nzt+1
10350                         pm25_av(k,j,i) = pm25_av(k,j,i) / REAL( average_count_3d, KIND=wp )
10351                      ENDDO
10352                   ENDDO
10353                ENDDO
10354
10355             CASE ( 'PM10' )
10356                DO  i = nxlg, nxrg
10357                   DO  j = nysg, nyng
10358                      DO  k = nzb, nzt+1
10359                         pm10_av(k,j,i) = pm10_av(k,j,i) / REAL( average_count_3d, KIND=wp )
10360                      ENDDO
10361                   ENDDO
10362                ENDDO
10363
10364             CASE ( 's_BC', 's_DU', 's_NH', 's_NO', 's_OC', 's_SO4', 's_SS' )
10365                IF ( is_used( prtcl, TRIM( variable(9:) ) ) )  THEN  ! 9: remove salsa_s_
10366                   IF ( TRIM( variable(9:) ) == 'BC' )   to_be_resorted => s_bc_av
10367                   IF ( TRIM( variable(9:) ) == 'DU' )   to_be_resorted => s_du_av
10368                   IF ( TRIM( variable(9:) ) == 'NH' )   to_be_resorted => s_nh_av
10369                   IF ( TRIM( variable(9:) ) == 'NO' )   to_be_resorted => s_no_av
10370                   IF ( TRIM( variable(9:) ) == 'OC' )   to_be_resorted => s_oc_av
10371                   IF ( TRIM( variable(9:) ) == 'SO4' )  to_be_resorted => s_so4_av
10372                   IF ( TRIM( variable(9:) ) == 'SS' )   to_be_resorted => s_ss_av 
10373                   DO  i = nxlg, nxrg
10374                      DO  j = nysg, nyng
10375                         DO  k = nzb, nzt+1
10376                            to_be_resorted(k,j,i) = to_be_resorted(k,j,i) /                        &
10377                                                    REAL( average_count_3d, KIND=wp )
10378                         ENDDO
10379                      ENDDO
10380                   ENDDO
10381                ENDIF
10382
10383             CASE ( 's_H2O' )
10384                to_be_resorted => s_h2o_av
10385                DO  i = nxlg, nxrg
10386                   DO  j = nysg, nyng
10387                      DO  k = nzb, nzt+1
10388                         to_be_resorted(k,j,i) = to_be_resorted(k,j,i) /                           &
10389                                                 REAL( average_count_3d, KIND=wp )
10390                      ENDDO
10391                   ENDDO
10392                ENDDO
10393
10394          END SELECT
10395
10396       ENDIF
10397    ENDIF
10398
10399 END SUBROUTINE salsa_3d_data_averaging
10400
10401
10402!------------------------------------------------------------------------------!
10403!
10404! Description:
10405! ------------
10406!> Subroutine defining 2D output variables
10407!------------------------------------------------------------------------------!
10408 SUBROUTINE salsa_data_output_2d( av, variable, found, grid, mode, local_pf, two_d, nzb_do, nzt_do )
10409
10410    USE indices
10411
10412    USE kinds
10413
10414
10415    IMPLICIT NONE
10416
10417    CHARACTER(LEN=*) ::  grid       !<
10418    CHARACTER(LEN=*) ::  mode       !<
10419    CHARACTER(LEN=*) ::  variable   !<
10420    CHARACTER(LEN=5) ::  vari       !<  trimmed format of variable
10421
10422    INTEGER(iwp) ::  av           !<
10423    INTEGER(iwp) ::  char_to_int  !< for converting character to integer
10424    INTEGER(iwp) ::  found_index  !< index of a chemical compound
10425    INTEGER(iwp) ::  i            !<
10426    INTEGER(iwp) ::  ib           !< running index: size bins
10427    INTEGER(iwp) ::  ic           !< running index: mass bins
10428    INTEGER(iwp) ::  j            !<
10429    INTEGER(iwp) ::  k            !<
10430    INTEGER(iwp) ::  nzb_do       !<
10431    INTEGER(iwp) ::  nzt_do       !<
10432
10433    LOGICAL ::  found  !<
10434    LOGICAL ::  two_d  !< flag parameter to indicate 2D variables (horizontal cross sections)
10435
10436    REAL(wp) ::  df                       !< For calculating LDSA: fraction of particles
10437                                          !< depositing in the alveolar (or tracheobronchial)
10438                                          !< region of the lung. Depends on the particle size
10439    REAL(wp) ::  mean_d                   !< Particle diameter in micrometres
10440    REAL(wp) ::  temp_bin                 !< temporary array for calculating output variables
10441
10442    REAL(wp), DIMENSION(nxl:nxr,nys:nyn,nzb_do:nzt_do) ::  local_pf  !< output
10443
10444    REAL(wp), DIMENSION(:,:,:), POINTER ::  to_be_resorted           !< pointer
10445!
10446!-- Next statement is to avoid compiler warning about unused variable. May be removed in future.
10447    IF ( two_d )  CONTINUE
10448
10449    found = .TRUE.
10450    temp_bin  = 0.0_wp
10451
10452    IF ( variable(7:11)  == 'N_bin' )  THEN
10453
10454       READ( variable( 12:LEN( TRIM( variable ) ) - 3 ), * ) char_to_int
10455       IF ( char_to_int >= 1  .AND. char_to_int <= SUM( nbin ) )  THEN
10456
10457          ib = char_to_int
10458          IF ( av == 0 )  THEN
10459             DO  i = nxl, nxr
10460                DO  j = nys, nyn
10461                   DO  k = nzb_do, nzt_do
10462                      local_pf(i,j,k) = MERGE( aerosol_number(ib)%conc(k,j,i), REAL( fill_value,   &
10463                                               KIND = wp ), BTEST( wall_flags_0(k,j,i), 0 ) )
10464                   ENDDO
10465                ENDDO
10466             ENDDO
10467          ELSE
10468             DO  i = nxl, nxr
10469                DO  j = nys, nyn
10470                   DO  k = nzb_do, nzt_do
10471                      local_pf(i,j,k) = MERGE( nbins_av(k,j,i,ib), REAL( fill_value, KIND = wp ),  &
10472                                               BTEST( wall_flags_0(k,j,i), 0 ) )
10473                   ENDDO
10474                ENDDO
10475             ENDDO
10476          ENDIF
10477          IF ( mode == 'xy' )  grid = 'zu'
10478       ENDIF
10479
10480    ELSEIF ( variable(7:11)  == 'm_bin' )  THEN
10481
10482       READ( variable( 12:LEN( TRIM( variable ) ) - 3 ), * ) char_to_int
10483       IF ( char_to_int >= 1  .AND. char_to_int <= SUM( nbin ) )  THEN
10484
10485          ib = char_to_int
10486          IF ( av == 0 )  THEN
10487             DO  i = nxl, nxr
10488                DO  j = nys, nyn
10489                   DO  k = nzb_do, nzt_do
10490                      temp_bin = 0.0_wp
10491                      DO  ic = ib, ncomponents_mass * nbins_aerosol, nbins_aerosol
10492                         temp_bin = temp_bin + aerosol_mass(ic)%conc(k,j,i)
10493                      ENDDO
10494                      local_pf(i,j,k) = MERGE( temp_bin, REAL( fill_value, KIND = wp ),            &
10495                                               BTEST( wall_flags_0(k,j,i), 0 ) )
10496                   ENDDO
10497                ENDDO
10498             ENDDO
10499          ELSE
10500             DO  i = nxl, nxr
10501                DO  j = nys, nyn
10502                   DO  k = nzb_do, nzt_do
10503                      local_pf(i,j,k) = MERGE( mbins_av(k,j,i,ib), REAL( fill_value, KIND = wp ),  &
10504                                               BTEST( wall_flags_0(k,j,i), 0 ) )
10505                   ENDDO
10506                ENDDO
10507             ENDDO
10508          ENDIF
10509          IF ( mode == 'xy' )  grid = 'zu'
10510       ENDIF
10511
10512    ELSE
10513
10514       SELECT CASE ( TRIM( variable( 7:LEN( TRIM( variable ) ) - 3 ) ) )  ! cut out _xy, _xz or _yz
10515
10516          CASE ( 'g_H2SO4', 'g_HNO3', 'g_NH3', 'g_OCNV', 'g_OCSV' )
10517             vari = TRIM( variable( 9:LEN( TRIM( variable ) ) - 3 ) )  ! 9: remove salsa_g_
10518             IF ( av == 0 )  THEN
10519                IF ( vari == 'H2SO4')  found_index = 1
10520                IF ( vari == 'HNO3')   found_index = 2
10521                IF ( vari == 'NH3')    found_index = 3
10522                IF ( vari == 'OCNV')   found_index = 4
10523                IF ( vari == 'OCSV')   found_index = 5
10524                DO  i = nxl, nxr
10525                   DO  j = nys, nyn
10526                      DO  k = nzb_do, nzt_do
10527                         local_pf(i,j,k) = MERGE( salsa_gas(found_index)%conc(k,j,i),              &
10528                                                  REAL( fill_value,  KIND = wp ),                  &
10529                                                  BTEST( wall_flags_0(k,j,i), 0 ) )
10530                      ENDDO
10531                   ENDDO
10532                ENDDO
10533             ELSE
10534                IF ( vari == 'H2SO4' )  to_be_resorted => g_h2so4_av
10535                IF ( vari == 'HNO3' )   to_be_resorted => g_hno3_av
10536                IF ( vari == 'NH3' )    to_be_resorted => g_nh3_av
10537                IF ( vari == 'OCNV' )   to_be_resorted => g_ocnv_av
10538                IF ( vari == 'OCSV' )   to_be_resorted => g_ocsv_av
10539                DO  i = nxl, nxr
10540                   DO  j = nys, nyn
10541                      DO  k = nzb_do, nzt_do
10542                         local_pf(i,j,k) = MERGE( to_be_resorted(k,j,i), REAL( fill_value,         &
10543                                                  KIND = wp ), BTEST( wall_flags_0(k,j,i), 0 ) )
10544                      ENDDO
10545                   ENDDO
10546                ENDDO
10547             ENDIF
10548
10549             IF ( mode == 'xy' )  grid = 'zu'
10550
10551          CASE ( 'LDSA' )
10552             IF ( av == 0 )  THEN
10553                DO  i = nxl, nxr
10554                   DO  j = nys, nyn
10555                      DO  k = nzb_do, nzt_do
10556                         temp_bin = 0.0_wp
10557                         DO  ib = 1, nbins_aerosol
10558   !
10559   !--                      Diameter in micrometres
10560                            mean_d = 1.0E+6_wp * ra_dry(k,j,i,ib) * 2.0_wp 
10561   !
10562   !--                      Deposition factor: alveolar
10563                            df = ( 0.01555_wp / mean_d ) * ( EXP( -0.416_wp * ( LOG( mean_d ) +    &
10564                                   2.84_wp )**2 ) + 19.11_wp * EXP( -0.482_wp * ( LOG( mean_d ) -  &
10565                                   1.362_wp )**2 ) )
10566   !
10567   !--                      Lung-deposited surface area LDSA (units mum2/cm3)
10568                            temp_bin = temp_bin + pi * mean_d**2 * df * 1.0E-6_wp *                &
10569                                       aerosol_number(ib)%conc(k,j,i)
10570                         ENDDO
10571
10572                         local_pf(i,j,k) = MERGE( temp_bin, REAL( fill_value, KIND = wp ),         &
10573                                                  BTEST( wall_flags_0(k,j,i), 0 ) )
10574                      ENDDO
10575                   ENDDO
10576                ENDDO
10577             ELSE
10578                DO  i = nxl, nxr
10579                   DO  j = nys, nyn
10580                      DO  k = nzb_do, nzt_do
10581                         local_pf(i,j,k) = MERGE( ldsa_av(k,j,i), REAL( fill_value, KIND = wp ),   &
10582                                                  BTEST( wall_flags_0(k,j,i), 0 ) )
10583                      ENDDO
10584                   ENDDO
10585                ENDDO
10586             ENDIF
10587
10588             IF ( mode == 'xy' )  grid = 'zu'
10589
10590          CASE ( 'N_UFP' )
10591
10592             IF ( av == 0 )  THEN
10593                DO  i = nxl, nxr
10594                   DO  j = nys, nyn
10595                      DO  k = nzb_do, nzt_do
10596                         temp_bin = 0.0_wp
10597                         DO  ib = 1, nbins_aerosol
10598                            IF ( 2.0_wp * ra_dry(k,j,i,ib) <= 0.1E-6_wp )  THEN
10599                               temp_bin = temp_bin + aerosol_number(ib)%conc(k,j,i)
10600                            ENDIF
10601                         ENDDO
10602                         local_pf(i,j,k) = MERGE( temp_bin, REAL( fill_value, KIND = wp ),         &
10603                                                  BTEST( wall_flags_0(k,j,i), 0 ) )
10604                      ENDDO
10605                   ENDDO
10606                ENDDO
10607             ELSE
10608                DO  i = nxl, nxr
10609                   DO  j = nys, nyn
10610                      DO  k = nzb_do, nzt_do
10611                         local_pf(i,j,k) = MERGE( nufp_av(k,j,i), REAL( fill_value, KIND = wp ),   &
10612                                                  BTEST( wall_flags_0(k,j,i), 0 ) )
10613                      ENDDO
10614                   ENDDO
10615                ENDDO
10616             ENDIF
10617
10618             IF ( mode == 'xy' )  grid = 'zu'
10619
10620          CASE ( 'Ntot' )
10621
10622             IF ( av == 0 )  THEN
10623                DO  i = nxl, nxr
10624                   DO  j = nys, nyn
10625                      DO  k = nzb_do, nzt_do
10626                         temp_bin = 0.0_wp
10627                         DO  ib = 1, nbins_aerosol
10628                            temp_bin = temp_bin + aerosol_number(ib)%conc(k,j,i)
10629                         ENDDO
10630                         local_pf(i,j,k) = MERGE( temp_bin, REAL( fill_value, KIND = wp ),         &
10631                                                  BTEST( wall_flags_0(k,j,i), 0 ) )
10632                      ENDDO
10633                   ENDDO
10634                ENDDO
10635             ELSE
10636                DO  i = nxl, nxr
10637                   DO  j = nys, nyn
10638                      DO  k = nzb_do, nzt_do
10639                         local_pf(i,j,k) = MERGE( ntot_av(k,j,i), REAL( fill_value, KIND = wp ),   &
10640                                                  BTEST( wall_flags_0(k,j,i), 0 ) )
10641                      ENDDO
10642                   ENDDO
10643                ENDDO
10644             ENDIF
10645
10646             IF ( mode == 'xy' )  grid = 'zu'
10647
10648          CASE ( 'PM0.1' )
10649             IF ( av == 0 )  THEN
10650                DO  i = nxl, nxr
10651                   DO  j = nys, nyn
10652                      DO  k = nzb_do, nzt_do
10653                         temp_bin = 0.0_wp
10654                         DO  ib = 1, nbins_aerosol
10655                            IF ( 2.0_wp * ra_dry(k,j,i,ib) <= 0.1E-6_wp )  THEN
10656                               DO  ic = ib, nbins_aerosol * ncc, nbins_aerosol
10657                                  temp_bin = temp_bin + aerosol_mass(ic)%conc(k,j,i)
10658                               ENDDO
10659                            ENDIF
10660                         ENDDO
10661                         local_pf(i,j,k) = MERGE( temp_bin, REAL( fill_value, KIND = wp ),         &
10662                                                  BTEST( wall_flags_0(k,j,i), 0 ) )
10663                      ENDDO
10664                   ENDDO
10665                ENDDO
10666             ELSE
10667                DO  i = nxl, nxr
10668                   DO  j = nys, nyn
10669                      DO  k = nzb_do, nzt_do
10670                         local_pf(i,j,k) = MERGE( pm01_av(k,j,i), REAL( fill_value, KIND = wp ),   &
10671                                                  BTEST( wall_flags_0(k,j,i), 0 ) )
10672                      ENDDO
10673                   ENDDO
10674                ENDDO
10675             ENDIF
10676
10677             IF ( mode == 'xy' )  grid = 'zu'
10678
10679          CASE ( 'PM2.5' )
10680             IF ( av == 0 )  THEN
10681                DO  i = nxl, nxr
10682                   DO  j = nys, nyn
10683                      DO  k = nzb_do, nzt_do
10684                         temp_bin = 0.0_wp
10685                         DO  ib = 1, nbins_aerosol
10686                            IF ( 2.0_wp * ra_dry(k,j,i,ib) <= 2.5E-6_wp )  THEN
10687                               DO  ic = ib, nbins_aerosol * ncc, nbins_aerosol
10688                                  temp_bin = temp_bin + aerosol_mass(ic)%conc(k,j,i)
10689                               ENDDO
10690                            ENDIF
10691                         ENDDO
10692                         local_pf(i,j,k) = MERGE( temp_bin, REAL( fill_value, KIND = wp ),         &
10693                                                  BTEST( wall_flags_0(k,j,i), 0 ) )
10694                      ENDDO
10695                   ENDDO
10696                ENDDO
10697             ELSE
10698                DO  i = nxl, nxr
10699                   DO  j = nys, nyn
10700                      DO  k = nzb_do, nzt_do
10701                         local_pf(i,j,k) = MERGE( pm25_av(k,j,i), REAL( fill_value, KIND = wp ),   &
10702                                                  BTEST( wall_flags_0(k,j,i), 0 ) )
10703                      ENDDO
10704                   ENDDO
10705                ENDDO
10706             ENDIF
10707
10708             IF ( mode == 'xy' )  grid = 'zu'
10709
10710          CASE ( 'PM10' )
10711             IF ( av == 0 )  THEN
10712                DO  i = nxl, nxr
10713                   DO  j = nys, nyn
10714                      DO  k = nzb_do, nzt_do
10715                         temp_bin = 0.0_wp
10716                         DO  ib = 1, nbins_aerosol
10717                            IF ( 2.0_wp * ra_dry(k,j,i,ib) <= 10.0E-6_wp )  THEN
10718                               DO  ic = ib, nbins_aerosol * ncc, nbins_aerosol
10719                                  temp_bin = temp_bin + aerosol_mass(ic)%conc(k,j,i)
10720                               ENDDO
10721                            ENDIF
10722                         ENDDO
10723                         local_pf(i,j,k) = MERGE( temp_bin,  REAL( fill_value, KIND = wp ),        &
10724                                                  BTEST( wall_flags_0(k,j,i), 0 ) )
10725                      ENDDO
10726                   ENDDO
10727                ENDDO
10728             ELSE
10729                DO  i = nxl, nxr
10730                   DO  j = nys, nyn
10731                      DO  k = nzb_do, nzt_do
10732                         local_pf(i,j,k) = MERGE( pm10_av(k,j,i), REAL( fill_value, KIND = wp ),   &
10733                                                  BTEST( wall_flags_0(k,j,i), 0 ) )
10734                      ENDDO
10735                   ENDDO
10736                ENDDO
10737             ENDIF
10738
10739             IF ( mode == 'xy' )  grid = 'zu'
10740
10741          CASE ( 's_BC', 's_DU', 's_NH', 's_NO', 's_OC', 's_SO4', 's_SS' )
10742             vari = TRIM( variable( 9:LEN( TRIM( variable ) ) - 3 ) )  ! 9: remove salsa_s_
10743             IF ( is_used( prtcl, vari ) )  THEN
10744                found_index = get_index( prtcl, vari )
10745                IF ( av == 0 )  THEN
10746                   DO  i = nxl, nxr
10747                      DO  j = nys, nyn
10748                         DO  k = nzb_do, nzt_do
10749                            temp_bin = 0.0_wp
10750                            DO  ic = ( found_index-1 ) * nbins_aerosol+1, found_index * nbins_aerosol
10751                               temp_bin = temp_bin + aerosol_mass(ic)%conc(k,j,i)
10752                            ENDDO
10753                            local_pf(i,j,k) = MERGE( temp_bin, REAL( fill_value, KIND = wp ),      &
10754                                                     BTEST( wall_flags_0(k,j,i), 0 ) )
10755                         ENDDO
10756                      ENDDO
10757                   ENDDO
10758                ELSE
10759                   IF ( vari == 'BC' )   to_be_resorted => s_bc_av
10760                   IF ( vari == 'DU' )   to_be_resorted => s_du_av
10761                   IF ( vari == 'NH' )   to_be_resorted => s_nh_av
10762                   IF ( vari == 'NO' )   to_be_resorted => s_no_av
10763                   IF ( vari == 'OC' )   to_be_resorted => s_oc_av
10764                   IF ( vari == 'SO4' )  to_be_resorted => s_so4_av
10765                   IF ( vari == 'SS' )   to_be_resorted => s_ss_av
10766                   DO  i = nxl, nxr
10767                      DO  j = nys, nyn
10768                         DO  k = nzb_do, nzt_do
10769                            local_pf(i,j,k) = MERGE( to_be_resorted(k,j,i), REAL( fill_value,      &
10770                                                     KIND = wp ), BTEST( wall_flags_0(k,j,i), 0 ) )
10771                         ENDDO
10772                      ENDDO
10773                   ENDDO
10774                ENDIF
10775             ELSE
10776                local_pf = fill_value
10777             ENDIF
10778
10779             IF ( mode == 'xy' )  grid = 'zu'
10780
10781          CASE ( 's_H2O' )
10782             found_index = get_index( prtcl, 'H2O' )
10783             IF ( av == 0 )  THEN
10784                DO  i = nxl, nxr
10785                   DO  j = nys, nyn
10786                      DO  k = nzb_do, nzt_do
10787                         temp_bin = 0.0_wp
10788                         DO  ic = ( found_index-1 ) * nbins_aerosol+1, found_index * nbins_aerosol
10789                            temp_bin = temp_bin + aerosol_mass(ic)%conc(k,j,i)
10790                         ENDDO
10791                         local_pf(i,j,k) = MERGE( temp_bin, REAL( fill_value, KIND = wp ),         &
10792                                                  BTEST( wall_flags_0(k,j,i), 0 ) )
10793                      ENDDO
10794                   ENDDO
10795                ENDDO
10796             ELSE
10797                to_be_resorted => s_h2o_av
10798                DO  i = nxl, nxr
10799                   DO  j = nys, nyn
10800                      DO  k = nzb_do, nzt_do
10801                         local_pf(i,j,k) = MERGE( to_be_resorted(k,j,i), REAL( fill_value,         &
10802                                                  KIND = wp ), BTEST( wall_flags_0(k,j,i), 0 ) )
10803                      ENDDO
10804                   ENDDO
10805                ENDDO
10806             ENDIF
10807
10808             IF ( mode == 'xy' )  grid = 'zu'
10809
10810          CASE DEFAULT
10811             found = .FALSE.
10812             grid  = 'none'
10813
10814       END SELECT
10815
10816    ENDIF
10817
10818 END SUBROUTINE salsa_data_output_2d
10819
10820!------------------------------------------------------------------------------!
10821!
10822! Description:
10823! ------------
10824!> Subroutine defining 3D output variables
10825!------------------------------------------------------------------------------!
10826 SUBROUTINE salsa_data_output_3d( av, variable, found, local_pf, nzb_do, nzt_do )
10827
10828    USE indices
10829
10830    USE kinds
10831
10832
10833    IMPLICIT NONE
10834
10835    CHARACTER(LEN=*), INTENT(in) ::  variable   !<
10836
10837    INTEGER(iwp) ::  av           !<
10838    INTEGER(iwp) ::  char_to_int  !< for converting character to integer
10839    INTEGER(iwp) ::  found_index  !< index of a chemical compound
10840    INTEGER(iwp) ::  ib           !< running index: size bins
10841    INTEGER(iwp) ::  ic           !< running index: mass bins
10842    INTEGER(iwp) ::  i            !<
10843    INTEGER(iwp) ::  j            !<
10844    INTEGER(iwp) ::  k            !<
10845    INTEGER(iwp) ::  nzb_do       !<
10846    INTEGER(iwp) ::  nzt_do       !<
10847
10848    LOGICAL ::  found      !<
10849
10850    REAL(wp) ::  df                       !< For calculating LDSA: fraction of particles
10851                                          !< depositing in the alveolar (or tracheobronchial)
10852                                          !< region of the lung. Depends on the particle size
10853    REAL(wp) ::  mean_d                   !< Particle diameter in micrometres
10854    REAL(wp) ::  temp_bin                 !< temporary array for calculating output variables
10855
10856    REAL(sp), DIMENSION(nxl:nxr,nys:nyn,nzb_do:nzt_do) ::  local_pf  !< local
10857
10858    REAL(wp), DIMENSION(:,:,:), POINTER ::  to_be_resorted  !< pointer
10859
10860    found     = .TRUE.
10861    temp_bin  = 0.0_wp
10862
10863    IF ( variable(7:11) == 'N_bin' )  THEN
10864       READ( variable(12:),* ) char_to_int
10865       IF ( char_to_int >= 1  .AND. char_to_int <= SUM( nbin ) )  THEN
10866
10867          ib = char_to_int
10868          IF ( av == 0 )  THEN
10869             DO  i = nxl, nxr
10870                DO  j = nys, nyn
10871                   DO  k = nzb_do, nzt_do
10872                      local_pf(i,j,k) = MERGE( aerosol_number(ib)%conc(k,j,i), REAL( fill_value,   &
10873                                               KIND = wp ), BTEST( wall_flags_0(k,j,i), 0 ) )
10874                   ENDDO
10875                ENDDO
10876             ENDDO
10877          ELSE
10878             DO  i = nxl, nxr
10879                DO  j = nys, nyn
10880                   DO  k = nzb_do, nzt_do
10881                      local_pf(i,j,k) = MERGE( nbins_av(k,j,i,ib), REAL( fill_value, KIND = wp ),  &
10882                                               BTEST( wall_flags_0(k,j,i), 0 ) ) 
10883                   ENDDO
10884                ENDDO
10885             ENDDO
10886          ENDIF
10887       ENDIF
10888
10889    ELSEIF ( variable(7:11) == 'm_bin' )  THEN
10890       READ( variable(12:),* ) char_to_int
10891       IF ( char_to_int >= 1  .AND. char_to_int <= SUM( nbin ) )  THEN
10892
10893          ib = char_to_int
10894          IF ( av == 0 )  THEN
10895             DO  i = nxl, nxr
10896                DO  j = nys, nyn
10897                   DO  k = nzb_do, nzt_do
10898                      temp_bin = 0.0_wp
10899                      DO  ic = ib, ncomponents_mass * nbins_aerosol, nbins_aerosol
10900                         temp_bin = temp_bin + aerosol_mass(ic)%conc(k,j,i)
10901                      ENDDO
10902                      local_pf(i,j,k) = MERGE( temp_bin, REAL( fill_value, KIND = wp ),            &
10903                                               BTEST( wall_flags_0(k,j,i), 0 ) )
10904                   ENDDO
10905                ENDDO
10906             ENDDO
10907          ELSE
10908             DO  i = nxl, nxr
10909                DO  j = nys, nyn
10910                   DO  k = nzb_do, nzt_do
10911                      local_pf(i,j,k) = MERGE( mbins_av(k,j,i,ib), REAL( fill_value, KIND = wp ),  &
10912                                               BTEST( wall_flags_0(k,j,i), 0 ) ) 
10913                   ENDDO
10914                ENDDO
10915             ENDDO
10916          ENDIF
10917       ENDIF
10918
10919    ELSE
10920       SELECT CASE ( TRIM( variable(7:) ) )
10921
10922          CASE ( 'g_H2SO4', 'g_HNO3', 'g_NH3', 'g_OCNV',  'g_OCSV' )
10923             IF ( av == 0 )  THEN
10924                IF ( TRIM( variable(7:) ) == 'g_H2SO4')  found_index = 1
10925                IF ( TRIM( variable(7:) ) == 'g_HNO3')   found_index = 2
10926                IF ( TRIM( variable(7:) ) == 'g_NH3')    found_index = 3
10927                IF ( TRIM( variable(7:) ) == 'g_OCNV')   found_index = 4
10928                IF ( TRIM( variable(7:) ) == 'g_OCSV')   found_index = 5
10929
10930                DO  i = nxl, nxr
10931                   DO  j = nys, nyn
10932                      DO  k = nzb_do, nzt_do
10933                         local_pf(i,j,k) = MERGE( salsa_gas(found_index)%conc(k,j,i),              &
10934                                                  REAL( fill_value, KIND = wp ),                   &
10935                                                  BTEST( wall_flags_0(k,j,i), 0 ) )
10936                      ENDDO
10937                   ENDDO
10938                ENDDO
10939             ELSE
10940!
10941!--             9: remove salsa_g_ from the beginning
10942                IF ( TRIM( variable(9:) ) == 'H2SO4' ) to_be_resorted => g_h2so4_av
10943                IF ( TRIM( variable(9:) ) == 'HNO3' )  to_be_resorted => g_hno3_av
10944                IF ( TRIM( variable(9:) ) == 'NH3' )   to_be_resorted => g_nh3_av
10945                IF ( TRIM( variable(9:) ) == 'OCNV' )  to_be_resorted => g_ocnv_av
10946                IF ( TRIM( variable(9:) ) == 'OCSV' )  to_be_resorted => g_ocsv_av
10947                DO  i = nxl, nxr
10948                   DO  j = nys, nyn
10949                      DO  k = nzb_do, nzt_do
10950                         local_pf(i,j,k) = MERGE( to_be_resorted(k,j,i), REAL( fill_value,         &
10951                                                  KIND = wp ), BTEST( wall_flags_0(k,j,i), 0 ) )
10952                      ENDDO
10953                   ENDDO
10954                ENDDO
10955             ENDIF
10956
10957          CASE ( 'LDSA' )
10958             IF ( av == 0 )  THEN
10959                DO  i = nxl, nxr
10960                   DO  j = nys, nyn
10961                      DO  k = nzb_do, nzt_do
10962                         temp_bin = 0.0_wp
10963                         DO  ib = 1, nbins_aerosol
10964   !
10965   !--                      Diameter in micrometres
10966                            mean_d = 1.0E+6_wp * ra_dry(k,j,i,ib) * 2.0_wp
10967   !
10968   !--                      Deposition factor: alveolar
10969                            df = ( 0.01555_wp / mean_d ) * ( EXP( -0.416_wp * ( LOG( mean_d ) +    &
10970                                   2.84_wp )**2 ) + 19.11_wp * EXP( -0.482_wp * ( LOG( mean_d ) -  &
10971                                   1.362_wp )**2 ) )
10972   !
10973   !--                      Lung-deposited surface area LDSA (units mum2/cm3)
10974                            temp_bin = temp_bin + pi * mean_d**2 * df * 1.0E-6_wp *                &
10975                                       aerosol_number(ib)%conc(k,j,i)
10976                         ENDDO
10977                         local_pf(i,j,k) = MERGE( temp_bin, REAL( fill_value, KIND = wp ),         &
10978                                                  BTEST( wall_flags_0(k,j,i), 0 ) )
10979                      ENDDO
10980                   ENDDO
10981                ENDDO
10982             ELSE
10983                DO  i = nxl, nxr
10984                   DO  j = nys, nyn
10985                      DO  k = nzb_do, nzt_do
10986                         local_pf(i,j,k) = MERGE( ldsa_av(k,j,i), REAL( fill_value, KIND = wp ),   &
10987                                                  BTEST( wall_flags_0(k,j,i), 0 ) ) 
10988                      ENDDO
10989                   ENDDO
10990                ENDDO
10991             ENDIF
10992
10993          CASE ( 'N_UFP' )
10994             IF ( av == 0 )  THEN
10995                DO  i = nxl, nxr
10996                   DO  j = nys, nyn
10997                      DO  k = nzb_do, nzt_do
10998                         temp_bin = 0.0_wp
10999                         DO  ib = 1, nbins_aerosol
11000                            IF ( 2.0_wp * ra_dry(k,j,i,ib) <= 0.1E-6_wp )  THEN
11001                               temp_bin = temp_bin + aerosol_number(ib)%conc(k,j,i)
11002                            ENDIF
11003                         ENDDO
11004                         local_pf(i,j,k) = MERGE( temp_bin, REAL( fill_value, KIND = wp ),         &
11005                                                  BTEST( wall_flags_0(k,j,i), 0 ) )
11006                      ENDDO
11007                   ENDDO
11008                ENDDO
11009             ELSE
11010                DO  i = nxl, nxr
11011                   DO  j = nys, nyn
11012                      DO  k = nzb_do, nzt_do
11013                         local_pf(i,j,k) = MERGE( nufp_av(k,j,i), REAL( fill_value, KIND = wp ),   &
11014                                                  BTEST( wall_flags_0(k,j,i), 0 ) ) 
11015                      ENDDO
11016                   ENDDO
11017                ENDDO
11018             ENDIF
11019
11020          CASE ( 'Ntot' )
11021             IF ( av == 0 )  THEN
11022                DO  i = nxl, nxr
11023                   DO  j = nys, nyn
11024                      DO  k = nzb_do, nzt_do
11025                         temp_bin = 0.0_wp
11026                         DO  ib = 1, nbins_aerosol
11027                            temp_bin = temp_bin + aerosol_number(ib)%conc(k,j,i)
11028                         ENDDO
11029                         local_pf(i,j,k) = MERGE( temp_bin, REAL( fill_value, KIND = wp ),         &
11030                                                  BTEST( wall_flags_0(k,j,i), 0 ) )
11031                      ENDDO
11032                   ENDDO
11033                ENDDO
11034             ELSE
11035                DO  i = nxl, nxr
11036                   DO  j = nys, nyn
11037                      DO  k = nzb_do, nzt_do
11038                         local_pf(i,j,k) = MERGE( ntot_av(k,j,i), REAL( fill_value, KIND = wp ),   &
11039                                                  BTEST( wall_flags_0(k,j,i), 0 ) ) 
11040                      ENDDO
11041                   ENDDO
11042                ENDDO
11043             ENDIF
11044
11045          CASE ( 'PM0.1' )
11046             IF ( av == 0 )  THEN
11047                DO  i = nxl, nxr
11048                   DO  j = nys, nyn
11049                      DO  k = nzb_do, nzt_do
11050                         temp_bin = 0.0_wp
11051                         DO  ib = 1, nbins_aerosol
11052                            IF ( 2.0_wp * ra_dry(k,j,i,ib) <= 0.1E-6_wp )  THEN
11053                               DO  ic = ib, nbins_aerosol * ncc, nbins_aerosol
11054                                  temp_bin = temp_bin + aerosol_mass(ic)%conc(k,j,i)
11055                               ENDDO
11056                            ENDIF
11057                         ENDDO
11058                         local_pf(i,j,k) = MERGE( temp_bin, REAL( fill_value, KIND = wp ),         &
11059                                                  BTEST( wall_flags_0(k,j,i), 0 ) ) 
11060                      ENDDO
11061                   ENDDO
11062                ENDDO
11063             ELSE
11064                DO  i = nxl, nxr
11065                   DO  j = nys, nyn
11066                      DO  k = nzb_do, nzt_do
11067                         local_pf(i,j,k) = MERGE( pm01_av(k,j,i), REAL( fill_value, KIND = wp ),   &
11068                                                  BTEST( wall_flags_0(k,j,i), 0 ) ) 
11069                      ENDDO
11070                   ENDDO
11071                ENDDO
11072             ENDIF
11073
11074          CASE ( 'PM2.5' )
11075             IF ( av == 0 )  THEN
11076                DO  i = nxl, nxr
11077                   DO  j = nys, nyn
11078                      DO  k = nzb_do, nzt_do
11079                         temp_bin = 0.0_wp
11080                         DO  ib = 1, nbins_aerosol
11081                            IF ( 2.0_wp * ra_dry(k,j,i,ib) <= 2.5E-6_wp )  THEN
11082                               DO  ic = ib, nbins_aerosol * ncc, nbins_aerosol
11083                                  temp_bin = temp_bin + aerosol_mass(ic)%conc(k,j,i)
11084                               ENDDO
11085                            ENDIF
11086                         ENDDO
11087                         local_pf(i,j,k) = MERGE( temp_bin, REAL( fill_value, KIND = wp ),         &
11088                                                  BTEST( wall_flags_0(k,j,i), 0 ) ) 
11089                      ENDDO
11090                   ENDDO
11091                ENDDO
11092             ELSE
11093                DO  i = nxl, nxr
11094                   DO  j = nys, nyn
11095                      DO  k = nzb_do, nzt_do
11096                         local_pf(i,j,k) = MERGE( pm25_av(k,j,i), REAL( fill_value, KIND = wp ),   &
11097                                                  BTEST( wall_flags_0(k,j,i), 0 ) ) 
11098                      ENDDO
11099                   ENDDO
11100                ENDDO
11101             ENDIF
11102
11103          CASE ( 'PM10' )
11104             IF ( av == 0 )  THEN
11105                DO  i = nxl, nxr
11106                   DO  j = nys, nyn
11107                      DO  k = nzb_do, nzt_do
11108                         temp_bin = 0.0_wp
11109                         DO  ib = 1, nbins_aerosol
11110                            IF ( 2.0_wp * ra_dry(k,j,i,ib) <= 10.0E-6_wp )  THEN
11111                               DO  ic = ib, nbins_aerosol * ncc, nbins_aerosol
11112                                  temp_bin = temp_bin + aerosol_mass(ic)%conc(k,j,i)
11113                               ENDDO
11114                            ENDIF
11115                         ENDDO
11116                         local_pf(i,j,k) = MERGE( temp_bin, REAL( fill_value, KIND = wp ),         &
11117                                                  BTEST( wall_flags_0(k,j,i), 0 ) ) 
11118                      ENDDO
11119                   ENDDO
11120                ENDDO
11121             ELSE
11122                DO  i = nxl, nxr
11123                   DO  j = nys, nyn
11124                      DO  k = nzb_do, nzt_do
11125                         local_pf(i,j,k) = MERGE( pm10_av(k,j,i), REAL( fill_value, KIND = wp ),   &
11126                                                  BTEST( wall_flags_0(k,j,i), 0 ) )
11127                      ENDDO
11128                   ENDDO
11129                ENDDO
11130             ENDIF
11131
11132          CASE ( 's_BC', 's_DU', 's_NH', 's_NO', 's_OC', 's_SO4', 's_SS' )
11133             IF ( is_used( prtcl, TRIM( variable(9:) ) ) )  THEN  ! 9: remove salsa_s_
11134                found_index = get_index( prtcl, TRIM( variable(9:) ) )
11135                IF ( av == 0 )  THEN
11136                   DO  i = nxl, nxr
11137                      DO  j = nys, nyn
11138                         DO  k = nzb_do, nzt_do
11139                            temp_bin = 0.0_wp
11140                            DO  ic = ( found_index-1 ) * nbins_aerosol + 1, found_index * nbins_aerosol
11141                               temp_bin = temp_bin + aerosol_mass(ic)%conc(k,j,i)
11142                            ENDDO
11143                            local_pf(i,j,k) = MERGE( temp_bin, REAL( fill_value, KIND = wp ),      &
11144                                                     BTEST( wall_flags_0(k,j,i), 0 ) ) 
11145                         ENDDO
11146                      ENDDO
11147                   ENDDO
11148                ELSE
11149!
11150!--                9: remove salsa_s_ from the beginning
11151                   IF ( TRIM( variable(9:) ) == 'BC' )   to_be_resorted => s_bc_av
11152                   IF ( TRIM( variable(9:) ) == 'DU' )   to_be_resorted => s_du_av
11153                   IF ( TRIM( variable(9:) ) == 'NH' )   to_be_resorted => s_nh_av
11154                   IF ( TRIM( variable(9:) ) == 'NO' )   to_be_resorted => s_no_av
11155                   IF ( TRIM( variable(9:) ) == 'OC' )   to_be_resorted => s_oc_av
11156                   IF ( TRIM( variable(9:) ) == 'SO4' )  to_be_resorted => s_so4_av
11157                   IF ( TRIM( variable(9:) ) == 'SS' )   to_be_resorted => s_ss_av
11158                   DO  i = nxl, nxr
11159                      DO  j = nys, nyn
11160                         DO  k = nzb_do, nzt_do
11161                            local_pf(i,j,k) = MERGE( to_be_resorted(k,j,i), REAL( fill_value,      &
11162                                                     KIND = wp ), BTEST( wall_flags_0(k,j,i), 0 ) )
11163                         ENDDO
11164                      ENDDO
11165                   ENDDO
11166                ENDIF
11167             ENDIF
11168
11169          CASE ( 's_H2O' )
11170             found_index = get_index( prtcl, 'H2O' )
11171             IF ( av == 0 )  THEN
11172                DO  i = nxl, nxr
11173                   DO  j = nys, nyn
11174                      DO  k = nzb_do, nzt_do
11175                         temp_bin = 0.0_wp
11176                         DO  ic = ( found_index-1 ) * nbins_aerosol + 1, found_index * nbins_aerosol
11177                            temp_bin = temp_bin + aerosol_mass(ic)%conc(k,j,i)
11178                         ENDDO
11179                         local_pf(i,j,k) = MERGE( temp_bin, REAL( fill_value, KIND = wp ),         &
11180                                                  BTEST( wall_flags_0(k,j,i), 0 ) ) 
11181                      ENDDO
11182                   ENDDO
11183                ENDDO
11184             ELSE
11185                to_be_resorted => s_h2o_av
11186                DO  i = nxl, nxr
11187                   DO  j = nys, nyn
11188                      DO  k = nzb_do, nzt_do
11189                         local_pf(i,j,k) = MERGE( to_be_resorted(k,j,i), REAL( fill_value,         &
11190                                                  KIND = wp ), BTEST( wall_flags_0(k,j,i), 0 ) )
11191                      ENDDO
11192                   ENDDO
11193                ENDDO
11194             ENDIF
11195
11196          CASE DEFAULT
11197             found = .FALSE.
11198
11199       END SELECT
11200    ENDIF
11201
11202 END SUBROUTINE salsa_data_output_3d
11203
11204!------------------------------------------------------------------------------!
11205!
11206! Description:
11207! ------------
11208!> Subroutine defining mask output variables
11209!------------------------------------------------------------------------------!
11210 SUBROUTINE salsa_data_output_mask( av, variable, found, local_pf, mid )
11211
11212    USE arrays_3d,                                                                                 &
11213        ONLY:  tend
11214
11215    USE control_parameters,                                                                        &
11216        ONLY:  mask_i, mask_j, mask_k, mask_size_l, mask_surface, nz_do3d
11217
11218    IMPLICIT NONE
11219
11220    CHARACTER(LEN=5) ::  grid      !< flag to distinquish between staggered grid
11221    CHARACTER(LEN=*) ::  variable  !<
11222    CHARACTER(LEN=7) ::  vari      !< trimmed format of variable
11223
11224    INTEGER(iwp) ::  av             !<
11225    INTEGER(iwp) ::  char_to_int    !< for converting character to integer
11226    INTEGER(iwp) ::  found_index    !< index of a chemical compound
11227    INTEGER(iwp) ::  ib             !< loop index for aerosol size number bins
11228    INTEGER(iwp) ::  ic             !< loop index for chemical components
11229    INTEGER(iwp) ::  i              !< loop index in x-direction
11230    INTEGER(iwp) ::  j              !< loop index in y-direction
11231    INTEGER(iwp) ::  k              !< loop index in z-direction
11232    INTEGER(iwp) ::  im             !< loop index for masked variables
11233    INTEGER(iwp) ::  jm             !< loop index for masked variables
11234    INTEGER(iwp) ::  kk             !< loop index for masked output in z-direction
11235    INTEGER(iwp) ::  mid            !< masked output running index
11236    INTEGER(iwp) ::  ktt            !< k index of highest terrain surface
11237
11238    LOGICAL ::  found      !<
11239    LOGICAL ::  resorted   !<
11240
11241    REAL(wp) ::  df        !< For calculating LDSA: fraction of particles depositing in the alveolar
11242                           !< (or tracheobronchial) region of the lung. Depends on the particle size
11243    REAL(wp) ::  mean_d    !< Particle diameter in micrometres
11244    REAL(wp) ::  temp_bin  !< temporary array for calculating output variables
11245
11246    REAL(wp), DIMENSION(mask_size_l(mid,1),mask_size_l(mid,2),mask_size_l(mid,3)) ::  local_pf   !<
11247
11248    REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg), TARGET ::  temp_array  !< temporary array
11249
11250    REAL(wp), DIMENSION(:,:,:), POINTER ::  to_be_resorted  !< pointer
11251
11252    found      = .TRUE.
11253    resorted   = .FALSE.
11254    grid       = 's'
11255    temp_array = 0.0_wp
11256    temp_bin   = 0.0_wp
11257
11258    IF ( variable(7:11) == 'N_bin' )  THEN
11259       READ( variable(12:),* ) char_to_int
11260       IF ( char_to_int >= 1  .AND. char_to_int <= SUM( nbin ) )  THEN
11261          ib = char_to_int
11262          IF ( av == 0 )  THEN
11263             IF ( .NOT. mask_surface(mid) )  THEN
11264                DO  i = 1, mask_size_l(mid,1)
11265                   DO  j = 1, mask_size_l(mid,2)
11266                      DO  k = 1, mask_size_l(mid,3)
11267                         local_pf(i,j,k) = aerosol_number(ib)%conc( mask_k(mid,k), mask_j(mid,j),  &
11268                                                                    mask_i(mid,i) )
11269                      ENDDO
11270                   ENDDO
11271                ENDDO
11272             ELSE
11273                DO  i = 1, mask_size_l(mid,1)
11274                   DO  j = 1, mask_size_l(mid,2)
11275!
11276!--                   Get k index of the highest terraing surface
11277                      im = mask_i(mid,i)
11278                      jm = mask_j(mid,j)
11279                      ktt = MINLOC( MERGE( 1, 0, BTEST( wall_flags_0(:,jm,im), 5 )), DIM = 1 ) - 1
11280                      DO  k = 1, mask_size_l(mid,3)
11281                         kk = MIN( ktt+mask_k(mid,k), nzt+1 )
11282!
11283!--                      Set value if not in building
11284                         IF ( BTEST( wall_flags_0(kk,jm,im), 6 ) )  THEN
11285                            local_pf(i,j,k) = fill_value
11286                         ELSE
11287                            local_pf(i,j,k) = aerosol_number(ib)%conc(kk,jm,im)
11288                         ENDIF
11289                      ENDDO
11290                   ENDDO
11291                ENDDO
11292             ENDIF
11293             resorted = .TRUE.
11294          ELSE
11295             temp_array = nbins_av(:,:,:,ib)
11296             to_be_resorted => temp_array
11297          ENDIF
11298       ENDIF
11299
11300    ELSEIF ( variable(7:11) == 'm_bin' )  THEN
11301
11302       READ( variable(12:),* ) char_to_int
11303       IF ( char_to_int >= 1  .AND. char_to_int <= SUM( nbin ) )  THEN
11304
11305          ib = char_to_int
11306          IF ( av == 0 )  THEN
11307             DO  i = nxl, nxr
11308                DO  j = nys, nyn
11309                   DO  k = nzb, nz_do3d
11310                      temp_bin = 0.0_wp
11311                      DO  ic = ib, ncomponents_mass * nbins_aerosol, nbins_aerosol
11312                         temp_bin = temp_bin + aerosol_mass(ic)%conc(k,j,i)
11313                      ENDDO
11314                      tend(k,j,i) = temp_bin
11315                   ENDDO
11316                ENDDO
11317             ENDDO
11318             IF ( .NOT. mask_surface(mid) )  THEN
11319                DO  i = 1, mask_size_l(mid,1)
11320                   DO  j = 1, mask_size_l(mid,2)
11321                      DO  k = 1, mask_size_l(mid,3)
11322                         local_pf(i,j,k) = tend( mask_k(mid,k),  mask_j(mid,j), mask_i(mid,i) )
11323                      ENDDO
11324                   ENDDO
11325                ENDDO
11326             ELSE
11327                DO  i = 1, mask_size_l(mid,1)
11328                   DO  j = 1, mask_size_l(mid,2)
11329!
11330!--                   Get k index of the highest terraing surface
11331                      im = mask_i(mid,i)
11332                      jm = mask_j(mid,j)
11333                      ktt = MINLOC( MERGE( 1, 0, BTEST( wall_flags_0(:,jm,im), 5 )), DIM = 1 ) - 1
11334                      DO  k = 1, mask_size_l(mid,3)
11335                         kk = MIN( ktt+mask_k(mid,k), nzt+1 )
11336!
11337!--                      Set value if not in building
11338                         IF ( BTEST( wall_flags_0(kk,jm,im), 6 ) )  THEN
11339                            local_pf(i,j,k) = fill_value
11340                         ELSE
11341                            local_pf(i,j,k) = tend(kk,jm,im)
11342                         ENDIF
11343                      ENDDO
11344                   ENDDO
11345                ENDDO
11346             ENDIF
11347             resorted = .TRUE.
11348          ELSE
11349             temp_array = mbins_av(:,:,:,ib)
11350             to_be_resorted => temp_array
11351          ENDIF
11352       ENDIF
11353
11354    ELSE
11355       SELECT CASE ( TRIM( variable(7:) ) )
11356
11357          CASE ( 'g_H2SO4', 'g_HNO3', 'g_NH3', 'g_OCNV',  'g_OCSV' )
11358             vari = TRIM( variable(7:) )
11359             IF ( av == 0 )  THEN
11360                IF ( vari == 'g_H2SO4')  to_be_resorted => salsa_gas(1)%conc
11361                IF ( vari == 'g_HNO3')   to_be_resorted => salsa_gas(2)%conc
11362                IF ( vari == 'g_NH3')    to_be_resorted => salsa_gas(3)%conc
11363                IF ( vari == 'g_OCNV')   to_be_resorted => salsa_gas(4)%conc
11364                IF ( vari == 'g_OCSV')   to_be_resorted => salsa_gas(5)%conc
11365             ELSE
11366                IF ( vari == 'g_H2SO4') to_be_resorted => g_h2so4_av
11367                IF ( vari == 'g_HNO3')  to_be_resorted => g_hno3_av
11368                IF ( vari == 'g_NH3')   to_be_resorted => g_nh3_av
11369                IF ( vari == 'g_OCNV')  to_be_resorted => g_ocnv_av
11370                IF ( vari == 'g_OCSV')  to_be_resorted => g_ocsv_av
11371             ENDIF
11372
11373          CASE ( 'LDSA' )
11374             IF ( av == 0 )  THEN
11375                DO  i = nxl, nxr
11376                   DO  j = nys, nyn
11377                      DO  k = nzb, nz_do3d
11378                         temp_bin = 0.0_wp
11379                         DO  ib = 1, nbins_aerosol
11380   !
11381   !--                      Diameter in micrometres
11382                            mean_d = 1.0E+6_wp * ra_dry(k,j,i,ib) * 2.0_wp
11383   !
11384   !--                      Deposition factor: alveolar
11385                            df = ( 0.01555_wp / mean_d ) * ( EXP( -0.416_wp * ( LOG( mean_d ) +    &
11386                                   2.84_wp )**2 ) + 19.11_wp * EXP( -0.482_wp * ( LOG( mean_d ) -  &
11387                                   1.362_wp )**2 ) )
11388   !
11389   !--                      Lung-deposited surface area LDSA (units mum2/cm3)
11390                            temp_bin = temp_bin + pi * mean_d**2 * df * 1.0E-6_wp *                &
11391                                       aerosol_number(ib)%conc(k,j,i)
11392                         ENDDO
11393                         tend(k,j,i) = temp_bin
11394                      ENDDO
11395                   ENDDO
11396                ENDDO
11397                IF ( .NOT. mask_surface(mid) )  THEN
11398                   DO  i = 1, mask_size_l(mid,1)
11399                      DO  j = 1, mask_size_l(mid,2)
11400                         DO  k = 1, mask_size_l(mid,3)
11401                            local_pf(i,j,k) = tend( mask_k(mid,k),  mask_j(mid,j), mask_i(mid,i) )
11402                         ENDDO
11403                      ENDDO
11404                   ENDDO
11405                ELSE
11406                   DO  i = 1, mask_size_l(mid,1)
11407                      DO  j = 1, mask_size_l(mid,2)
11408!
11409!--                      Get k index of the highest terraing surface
11410                         im = mask_i(mid,i)
11411                         jm = mask_j(mid,j)
11412                         ktt = MINLOC( MERGE( 1, 0, BTEST( wall_flags_0(:,jm,im), 5 )), DIM = 1 ) - 1
11413                         DO  k = 1, mask_size_l(mid,3)
11414                            kk = MIN( ktt+mask_k(mid,k), nzt+1 )
11415!
11416!--                         Set value if not in building
11417                            IF ( BTEST( wall_flags_0(kk,jm,im), 6 ) )  THEN
11418                               local_pf(i,j,k) = fill_value
11419                            ELSE
11420                               local_pf(i,j,k) = tend(kk,jm,im)
11421                            ENDIF
11422                         ENDDO
11423                      ENDDO
11424                   ENDDO
11425                ENDIF
11426                resorted = .TRUE.
11427             ELSE
11428                to_be_resorted => ldsa_av
11429             ENDIF
11430
11431          CASE ( 'N_UFP' )
11432             IF ( av == 0 )  THEN
11433                DO  i = nxl, nxr
11434                   DO  j = nys, nyn
11435                      DO  k = nzb, nz_do3d
11436                         temp_bin = 0.0_wp
11437                         DO  ib = 1, nbins_aerosol
11438                            IF ( 2.0_wp * ra_dry(k,j,i,ib) <= 0.1E-6_wp )  THEN
11439                               temp_bin = temp_bin + aerosol_number(ib)%conc(k,j,i)
11440                            ENDIF
11441                         ENDDO
11442                         tend(k,j,i) = temp_bin
11443                      ENDDO
11444                   ENDDO
11445                ENDDO 
11446                IF ( .NOT. mask_surface(mid) )  THEN
11447                   DO  i = 1, mask_size_l(mid,1)
11448                      DO  j = 1, mask_size_l(mid,2)
11449                         DO  k = 1, mask_size_l(mid,3)
11450                            local_pf(i,j,k) = tend( mask_k(mid,k),  mask_j(mid,j), mask_i(mid,i) )
11451                         ENDDO
11452                      ENDDO
11453                   ENDDO
11454                ELSE
11455                   DO  i = 1, mask_size_l(mid,1)
11456                      DO  j = 1, mask_size_l(mid,2)
11457!
11458!--                      Get k index of the highest terraing surface
11459                         im = mask_i(mid,i)
11460                         jm = mask_j(mid,j)
11461                         ktt = MINLOC( MERGE( 1, 0, BTEST( wall_flags_0(:,jm,im), 5 )), DIM = 1 ) - 1
11462                         DO  k = 1, mask_size_l(mid,3)
11463                            kk = MIN( ktt+mask_k(mid,k), nzt+1 )
11464!
11465!--                         Set value if not in building
11466                            IF ( BTEST( wall_flags_0(kk,jm,im), 6 ) )  THEN
11467                               local_pf(i,j,k) = fill_value
11468                            ELSE
11469                               local_pf(i,j,k) = tend(kk,jm,im)
11470                            ENDIF
11471                         ENDDO
11472                      ENDDO
11473                   ENDDO
11474                ENDIF
11475                resorted = .TRUE.
11476             ELSE
11477                to_be_resorted => nufp_av
11478             ENDIF
11479
11480          CASE ( 'Ntot' )
11481             IF ( av == 0 )  THEN
11482                DO  i = nxl, nxr
11483                   DO  j = nys, nyn
11484                      DO  k = nzb, nz_do3d
11485                         temp_bin = 0.0_wp
11486                         DO  ib = 1, nbins_aerosol
11487                            temp_bin = temp_bin + aerosol_number(ib)%conc(k,j,i)
11488                         ENDDO
11489                         tend(k,j,i) = temp_bin
11490                      ENDDO
11491                   ENDDO
11492                ENDDO 
11493                IF ( .NOT. mask_surface(mid) )  THEN
11494                   DO  i = 1, mask_size_l(mid,1)
11495                      DO  j = 1, mask_size_l(mid,2)
11496                         DO  k = 1, mask_size_l(mid,3)
11497                            local_pf(i,j,k) = tend( mask_k(mid,k),  mask_j(mid,j), mask_i(mid,i) )
11498                         ENDDO
11499                      ENDDO
11500                   ENDDO
11501                ELSE
11502                   DO  i = 1, mask_size_l(mid,1)
11503                      DO  j = 1, mask_size_l(mid,2)
11504!
11505!--                      Get k index of the highest terraing surface
11506                         im = mask_i(mid,i)
11507                         jm = mask_j(mid,j)
11508                         ktt = MINLOC( MERGE( 1, 0, BTEST( wall_flags_0(:,jm,im), 5 )), DIM = 1 ) - 1
11509                         DO  k = 1, mask_size_l(mid,3)
11510                            kk = MIN( ktt+mask_k(mid,k), nzt+1 )
11511!
11512!--                         Set value if not in building
11513                            IF ( BTEST( wall_flags_0(kk,jm,im), 6 ) )  THEN
11514                               local_pf(i,j,k) = fill_value
11515                            ELSE
11516                               local_pf(i,j,k) = tend(kk,jm,im)
11517                            ENDIF
11518                         ENDDO
11519                      ENDDO
11520                   ENDDO
11521                ENDIF
11522                resorted = .TRUE.
11523             ELSE
11524                to_be_resorted => ntot_av
11525             ENDIF
11526
11527          CASE ( 'PM0.1' )
11528             IF ( av == 0 )  THEN
11529                DO  i = nxl, nxr
11530                   DO  j = nys, nyn
11531                      DO  k = nzb, nz_do3d
11532                         temp_bin = 0.0_wp
11533                         DO  ib = 1, nbins_aerosol
11534                            IF ( 2.0_wp * ra_dry(k,j,i,ib) <= 0.1E-6_wp )  THEN
11535                               DO  ic = ib, nbins_aerosol * ncc, nbins_aerosol
11536                                  temp_bin = temp_bin + aerosol_mass(ic)%conc(k,j,i)
11537                               ENDDO
11538                            ENDIF
11539                         ENDDO
11540                         tend(k,j,i) = temp_bin
11541                      ENDDO
11542                   ENDDO
11543                ENDDO 
11544                IF ( .NOT. mask_surface(mid) )  THEN
11545                   DO  i = 1, mask_size_l(mid,1)
11546                      DO  j = 1, mask_size_l(mid,2)
11547                         DO  k = 1, mask_size_l(mid,3)
11548                            local_pf(i,j,k) = tend( mask_k(mid,k),  mask_j(mid,j), mask_i(mid,i) )
11549                         ENDDO
11550                      ENDDO
11551                   ENDDO
11552                ELSE
11553                   DO  i = 1, mask_size_l(mid,1)
11554                      DO  j = 1, mask_size_l(mid,2)
11555!
11556!--                      Get k index of the highest terraing surface
11557                         im = mask_i(mid,i)
11558                         jm = mask_j(mid,j)
11559                         ktt = MINLOC( MERGE( 1, 0, BTEST( wall_flags_0(:,jm,im), 5 )), DIM = 1 ) - 1
11560                         DO  k = 1, mask_size_l(mid,3)
11561                            kk = MIN( ktt+mask_k(mid,k), nzt+1 )
11562!
11563!--                         Set value if not in building
11564                            IF ( BTEST( wall_flags_0(kk,jm,im), 6 ) )  THEN
11565                               local_pf(i,j,k) = fill_value
11566                            ELSE
11567                               local_pf(i,j,k) = tend(kk,jm,im)
11568                            ENDIF
11569                         ENDDO
11570                      ENDDO
11571                   ENDDO
11572                ENDIF
11573                resorted = .TRUE.
11574             ELSE
11575                to_be_resorted => pm01_av
11576             ENDIF
11577
11578          CASE ( 'PM2.5' )
11579             IF ( av == 0 )  THEN
11580                DO  i = nxl, nxr
11581                   DO  j = nys, nyn
11582                      DO  k = nzb, nz_do3d
11583                         temp_bin = 0.0_wp
11584                         DO  ib = 1, nbins_aerosol
11585                            IF ( 2.0_wp * ra_dry(k,j,i,ib) <= 2.5E-6_wp )  THEN
11586                               DO  ic = ib, nbins_aerosol * ncc, nbins_aerosol
11587                                  temp_bin = temp_bin + aerosol_mass(ic)%conc(k,j,i)
11588                               ENDDO
11589                            ENDIF
11590                         ENDDO
11591                         tend(k,j,i) = temp_bin
11592                      ENDDO
11593                   ENDDO
11594                ENDDO 
11595                IF ( .NOT. mask_surface(mid) )  THEN
11596                   DO  i = 1, mask_size_l(mid,1)
11597                      DO  j = 1, mask_size_l(mid,2)
11598                         DO  k = 1, mask_size_l(mid,3)
11599                            local_pf(i,j,k) = tend( mask_k(mid,k),  mask_j(mid,j), mask_i(mid,i) )
11600                         ENDDO
11601                      ENDDO
11602                   ENDDO
11603                ELSE
11604                   DO  i = 1, mask_size_l(mid,1)
11605                      DO  j = 1, mask_size_l(mid,2)
11606!
11607!--                      Get k index of the highest terraing surface
11608                         im = mask_i(mid,i)
11609                         jm = mask_j(mid,j)
11610                         ktt = MINLOC( MERGE( 1, 0, BTEST( wall_flags_0(:,jm,im), 5 )), DIM = 1 ) - 1
11611                         DO  k = 1, mask_size_l(mid,3)
11612                            kk = MIN( ktt+mask_k(mid,k), nzt+1 )
11613!
11614!--                         Set value if not in building
11615                            IF ( BTEST( wall_flags_0(kk,jm,im), 6 ) )  THEN
11616                               local_pf(i,j,k) = fill_value
11617                            ELSE
11618                               local_pf(i,j,k) = tend(kk,jm,im)
11619                            ENDIF
11620                         ENDDO
11621                      ENDDO
11622                   ENDDO
11623                ENDIF
11624                resorted = .TRUE.
11625             ELSE
11626                to_be_resorted => pm25_av
11627             ENDIF
11628
11629          CASE ( 'PM10' )
11630             IF ( av == 0 )  THEN
11631                DO  i = nxl, nxr
11632                   DO  j = nys, nyn
11633                      DO  k = nzb, nz_do3d
11634                         temp_bin = 0.0_wp
11635                         DO  ib = 1, nbins_aerosol
11636                            IF ( 2.0_wp * ra_dry(k,j,i,ib) <= 10.0E-6_wp )  THEN
11637                               DO  ic = ib, nbins_aerosol * ncc, nbins_aerosol
11638                                  temp_bin = temp_bin + aerosol_mass(ic)%conc(k,j,i)
11639                               ENDDO
11640                            ENDIF
11641                         ENDDO
11642                         tend(k,j,i) = temp_bin
11643                      ENDDO
11644                   ENDDO
11645                ENDDO 
11646                IF ( .NOT. mask_surface(mid) )  THEN
11647                   DO  i = 1, mask_size_l(mid,1)
11648                      DO  j = 1, mask_size_l(mid,2)
11649                         DO  k = 1, mask_size_l(mid,3)
11650                            local_pf(i,j,k) = tend( mask_k(mid,k),  mask_j(mid,j), mask_i(mid,i) )
11651                         ENDDO
11652                      ENDDO
11653                   ENDDO
11654                ELSE
11655                   DO  i = 1, mask_size_l(mid,1)
11656                      DO  j = 1, mask_size_l(mid,2)
11657!
11658!--                      Get k index of the highest terraing surface
11659                         im = mask_i(mid,i)
11660                         jm = mask_j(mid,j)
11661                         ktt = MINLOC( MERGE( 1, 0, BTEST( wall_flags_0(:,jm,im), 5 )), DIM = 1 ) - 1
11662                         DO  k = 1, mask_size_l(mid,3)
11663                            kk = MIN( ktt+mask_k(mid,k), nzt+1 )
11664!
11665!--                         Set value if not in building
11666                            IF ( BTEST( wall_flags_0(kk,jm,im), 6 ) )  THEN
11667                               local_pf(i,j,k) = fill_value
11668                            ELSE
11669                               local_pf(i,j,k) = tend(kk,jm,im)
11670                            ENDIF
11671                         ENDDO
11672                      ENDDO
11673                   ENDDO
11674                ENDIF
11675                resorted = .TRUE.
11676             ELSE
11677                to_be_resorted => pm10_av
11678             ENDIF
11679
11680          CASE ( 's_BC', 's_DU', 's_NH', 's_NO', 's_OC', 's_SO4', 's_SS' )
11681             IF ( av == 0 )  THEN
11682                IF ( is_used( prtcl, TRIM( variable(3:) ) ) )  THEN
11683                   found_index = get_index( prtcl, TRIM( variable(3:) ) )
11684                   DO  i = nxl, nxr
11685                      DO  j = nys, nyn
11686                         DO  k = nzb, nz_do3d
11687                            temp_bin = 0.0_wp
11688                            DO  ic = ( found_index-1 ) * nbins_aerosol + 1, found_index * nbins_aerosol
11689                               temp_bin = temp_bin + aerosol_mass(ic)%conc(k,j,i)
11690                            ENDDO
11691                            tend(k,j,i) = temp_bin
11692                         ENDDO
11693                      ENDDO
11694                   ENDDO
11695                ELSE
11696                   tend = 0.0_wp
11697                ENDIF
11698                IF ( .NOT. mask_surface(mid) )  THEN
11699                   DO  i = 1, mask_size_l(mid,1)
11700                      DO  j = 1, mask_size_l(mid,2)
11701                         DO  k = 1, mask_size_l(mid,3)
11702                            local_pf(i,j,k) = tend( mask_k(mid,k), mask_j(mid,j), mask_i(mid,i) )
11703                         ENDDO
11704                      ENDDO
11705                   ENDDO
11706                ELSE
11707                   DO  i = 1, mask_size_l(mid,1)
11708                      DO  j = 1, mask_size_l(mid,2)
11709!
11710!--                      Get k index of the highest terraing surface
11711                         im = mask_i(mid,i)
11712                         jm = mask_j(mid,j)
11713                         ktt = MINLOC( MERGE( 1, 0, BTEST( wall_flags_0(:,jm,im), 5 )), DIM = 1 ) - 1
11714                         DO  k = 1, mask_size_l(mid,3)
11715                            kk = MIN( ktt+mask_k(mid,k), nzt+1 )
11716!
11717!--                         Set value if not in building
11718                            IF ( BTEST( wall_flags_0(kk,jm,im), 6 ) )  THEN
11719                               local_pf(i,j,k) = fill_value
11720                            ELSE
11721                               local_pf(i,j,k) = tend(kk,jm,im)
11722                            ENDIF
11723                         ENDDO
11724                      ENDDO
11725                   ENDDO
11726                ENDIF
11727                resorted = .TRUE.
11728             ELSE
11729!
11730!--             9: remove salsa_s_ from the beginning
11731                IF ( TRIM( variable(9:) ) == 'BC' )   to_be_resorted => s_bc_av
11732                IF ( TRIM( variable(9:) ) == 'DU' )   to_be_resorted => s_du_av
11733                IF ( TRIM( variable(9:) ) == 'NH' )   to_be_resorted => s_nh_av
11734                IF ( TRIM( variable(9:) ) == 'NO' )   to_be_resorted => s_no_av
11735                IF ( TRIM( variable(9:) ) == 'OC' )   to_be_resorted => s_oc_av
11736                IF ( TRIM( variable(9:) ) == 'SO4' )  to_be_resorted => s_so4_av
11737                IF ( TRIM( variable(9:) ) == 'SS' )   to_be_resorted => s_ss_av
11738             ENDIF
11739
11740          CASE ( 's_H2O' )
11741             IF ( av == 0 )  THEN
11742                found_index = get_index( prtcl, 'H2O' )
11743                DO  i = nxl, nxr
11744                   DO  j = nys, nyn
11745                      DO  k = nzb, nz_do3d
11746                         temp_bin = 0.0_wp
11747                         DO  ic = ( found_index-1 ) * nbins_aerosol + 1, found_index * nbins_aerosol
11748                            temp_bin = temp_bin + aerosol_mass(ic)%conc(k,j,i)
11749                         ENDDO
11750                         tend(k,j,i) = temp_bin
11751                      ENDDO
11752                   ENDDO
11753                ENDDO
11754                IF ( .NOT. mask_surface(mid) )  THEN
11755                   DO  i = 1, mask_size_l(mid,1)
11756                      DO  j = 1, mask_size_l(mid,2)
11757                         DO  k = 1, mask_size_l(mid,3)
11758                            local_pf(i,j,k) = tend( mask_k(mid,k), mask_j(mid,j), mask_i(mid,i) )
11759                         ENDDO
11760                      ENDDO
11761                   ENDDO
11762                ELSE
11763                   DO  i = 1, mask_size_l(mid,1)
11764                      DO  j = 1, mask_size_l(mid,2)
11765!
11766!--                      Get k index of the highest terraing surface
11767                         im = mask_i(mid,i)
11768                         jm = mask_j(mid,j)
11769                         ktt = MINLOC( MERGE( 1, 0, BTEST( wall_flags_0(:,jm,im), 5 )), DIM = 1 ) - 1
11770                         DO  k = 1, mask_size_l(mid,3)
11771                            kk = MIN( ktt+mask_k(mid,k), nzt+1 )
11772!
11773!--                         Set value if not in building
11774                            IF ( BTEST( wall_flags_0(kk,jm,im), 6 ) )  THEN
11775                               local_pf(i,j,k) = fill_value
11776                            ELSE
11777                               local_pf(i,j,k) =  tend(kk,jm,im)
11778                            ENDIF
11779                         ENDDO
11780                      ENDDO
11781                   ENDDO
11782                ENDIF
11783                resorted = .TRUE.
11784             ELSE
11785                to_be_resorted => s_h2o_av
11786             ENDIF
11787
11788          CASE DEFAULT
11789             found = .FALSE.
11790
11791       END SELECT
11792    ENDIF
11793
11794    IF ( found  .AND.  .NOT. resorted )  THEN
11795       IF ( .NOT. mask_surface(mid) )  THEN
11796!
11797!--       Default masked output
11798          DO  i = 1, mask_size_l(mid,1)
11799             DO  j = 1, mask_size_l(mid,2)
11800                DO  k = 1, mask_size_l(mid,3)
11801                   local_pf(i,j,k) = to_be_resorted( mask_k(mid,k), mask_j(mid,j), mask_i(mid,i) )
11802                ENDDO
11803             ENDDO
11804          ENDDO
11805       ELSE
11806!
11807!--       Terrain-following masked output
11808          DO  i = 1, mask_size_l(mid,1)
11809             DO  j = 1, mask_size_l(mid,2)
11810!--             Get k index of the highest terraing surface
11811                im = mask_i(mid,i)
11812                jm = mask_j(mid,j)
11813                ktt = MINLOC( MERGE( 1, 0, BTEST( wall_flags_0(:,jm,im), 5 )), DIM = 1 ) - 1
11814                DO  k = 1, mask_size_l(mid,3)
11815                   kk = MIN( ktt+mask_k(mid,k), nzt+1 )
11816!--                Set value if not in building
11817                   IF ( BTEST( wall_flags_0(kk,jm,im), 6 ) )  THEN
11818                      local_pf(i,j,k) = fill_value
11819                   ELSE
11820                      local_pf(i,j,k) = to_be_resorted(kk,jm,im)
11821                   ENDIF
11822                ENDDO
11823             ENDDO
11824          ENDDO
11825       ENDIF
11826    ENDIF
11827
11828 END SUBROUTINE salsa_data_output_mask
11829
11830!------------------------------------------------------------------------------!
11831! Description:
11832! ------------
11833!> Creates index tables for different (aerosol) components
11834!------------------------------------------------------------------------------!
11835 SUBROUTINE component_index_constructor( self, ncomp, nlist, listcomp )
11836
11837    IMPLICIT NONE
11838
11839    INTEGER(iwp) ::  ii  !<
11840    INTEGER(iwp) ::  jj  !<
11841
11842    INTEGER(iwp), INTENT(in) ::  nlist ! < Maximum number of components
11843
11844    INTEGER(iwp), INTENT(inout) ::  ncomp  !< Number of components
11845
11846    CHARACTER(LEN=3), INTENT(in) ::  listcomp(nlist)  !< List cof component names
11847
11848    TYPE(component_index), INTENT(inout) ::  self  !< Object containing the indices of different
11849                                                   !< aerosol components
11850
11851    ncomp = 0
11852
11853    DO WHILE ( listcomp(ncomp+1) /= '  ' .AND. ncomp < nlist )
11854       ncomp = ncomp + 1
11855    ENDDO
11856
11857    self%ncomp = ncomp
11858    ALLOCATE( self%ind(ncomp), self%comp(ncomp) )
11859
11860    DO  ii = 1, ncomp
11861       self%ind(ii) = ii
11862    ENDDO
11863
11864    jj = 1
11865    DO  ii = 1, nlist
11866       IF ( listcomp(ii) == '') CYCLE
11867       self%comp(jj) = listcomp(ii)
11868       jj = jj + 1
11869    ENDDO
11870
11871 END SUBROUTINE component_index_constructor
11872
11873!------------------------------------------------------------------------------!
11874! Description:
11875! ------------
11876!> Gives the index of a component in the component list
11877!------------------------------------------------------------------------------!
11878 INTEGER FUNCTION get_index( self, incomp )
11879
11880    IMPLICIT NONE
11881
11882    CHARACTER(LEN=*), INTENT(in) ::  incomp !< Component name
11883
11884    INTEGER(iwp) ::  ii  !< index
11885
11886    TYPE(component_index), INTENT(in) ::  self  !< Object containing the indices of different
11887                                                !< aerosol components
11888    IF ( ANY( self%comp == incomp ) )  THEN
11889       ii = 1
11890       DO WHILE ( (self%comp(ii) /= incomp) )
11891          ii = ii + 1
11892       ENDDO
11893       get_index = ii
11894    ELSEIF ( incomp == 'H2O' )  THEN
11895       get_index = self%ncomp + 1
11896    ELSE
11897       WRITE( message_string, * ) 'Incorrect component name given!'
11898       CALL message( 'get_index', 'PA0591', 1, 2, 0, 6, 0 )
11899    ENDIF
11900
11901 END FUNCTION get_index
11902
11903!------------------------------------------------------------------------------!
11904! Description:
11905! ------------
11906!> Tells if the (aerosol) component is being used in the simulation
11907!------------------------------------------------------------------------------!
11908 LOGICAL FUNCTION is_used( self, icomp )
11909
11910    IMPLICIT NONE
11911
11912    CHARACTER(LEN=*), INTENT(in) ::  icomp !< Component name
11913
11914    TYPE(component_index), INTENT(in) ::  self  !< Object containing the indices of different
11915                                                !< aerosol components
11916
11917    IF ( ANY(self%comp == icomp) ) THEN
11918       is_used = .TRUE.
11919    ELSE
11920       is_used = .FALSE.
11921    ENDIF
11922
11923 END FUNCTION
11924
11925 END MODULE salsa_mod
Note: See TracBrowser for help on using the repository browser.