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

Last change on this file since 4417 was 4417, checked in by monakurppa, 5 years ago

document previous changes

  • Property svn:keywords set to Id
File size: 601.4 KB
Line 
1!> @file salsa_mod.f90
2!--------------------------------------------------------------------------------!
3! This file is part of PALM-4U.
4!
5! PALM-4U is free software: you can redistribute it and/or modify it under the
6! terms of the GNU General Public License as published by the Free Software
7! Foundation, either version 3 of the License, or (at your option) any later
8! version.
9!
10! PALM-4U is distributed in the hope that it will be useful, but WITHOUT ANY
11! WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
12! A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
13!
14! You should have received a copy of the GNU General Public License along with
15! PALM. If not, see <http://www.gnu.org/licenses/>.
16!
17! Copyright 2018-2019 University of Helsinki
18! Copyright 1997-2020 Leibniz Universitaet Hannover
19!--------------------------------------------------------------------------------!
20!
21! Current revisions:
22! -----------------
23!
24!
25! Former revisions:
26! -----------------
27! $Id: salsa_mod.f90 4417 2020-02-20 19:19:33Z monakurppa $
28! Bug fixes and reformatting for the restart data and averaged data output
29! - add missing arrays (averaged data output) in salsa_wrd_local and
30!   salsa_rrd_local
31! - set write_binary_salsa and read_restart_data_salsa to .T. by default
32! - restructure the average arrays for gases and total mass concentrations of
33!   chemical components: set to 4d arrays instead of separate arrays
34! - add allocation checks for averaged data output arrays
35!
36! 4416 2020-02-20 17:53:57Z monakurppa
37! Time index error in salsa_emission_setup
38!
39! 4380 2020-01-17 23:39:51Z monakurppa
40! - Error in saving the surface fluxes in an array that is applied in the
41!   deposition scheme
42! - Corrections in the header: aerosol bin diameters and lower bin limits not
43!   printed correctly
44!
45! 4364 2020-01-08 02:12:31Z monakurppa
46! Set time coordinate in the input data relative to origin_time rather than to
47! 00:00:00 UTC
48!
49! 4360 2020-01-07 11:25:50Z suehring
50! Introduction of wall_flags_total_0, which currently sets bits based on static
51! topography information used in wall_flags_static_0
52!
53! 4342 2019-12-16 13:49:14Z Giersch
54! cdc replaced by canopy_drag_coeff
55!
56! 4329 2019-12-10 15:46:36Z motisi
57! Renamed wall_flags_0 to wall_flags_static_0
58!
59! 4315 2019-12-02 09:20:07Z monakurppa
60! Add an additional check for the time dimension PIDS_SALSA in
61! salsa_emission_setup and correct some error message identifiers.
62!
63! 4298 2019-11-21 15:59:16Z suehring
64! Bugfix, close netcdf input files after reading
65!
66! 4295 2019-11-14 06:15:31Z monakurppa
67!
68!
69! 4280 2019-10-29 14:34:15Z monakurppa
70! Corrected a bug in boundary conditions and fac_dt in offline nesting
71!
72! 4273 2019-10-24 13:40:54Z monakurppa
73! - Rename nest_salsa to nesting_salsa
74! - Correct some errors in boundary condition flags
75! - Add a check for not trying to output gas concentrations in salsa if the
76!   chemistry module is applied
77! - Set the default value of nesting_salsa and nesting_offline_salsa to .TRUE.
78!
79! 4272 2019-10-23 15:18:57Z schwenkel
80! Further modularization of boundary conditions: moved boundary conditions to
81! respective modules
82!
83! 4270 2019-10-23 10:46:20Z monakurppa
84! - Implement offline nesting for salsa
85! - Alphabetic ordering for module interfaces
86! - Remove init_aerosol_type and init_gases_type from salsa_parin and define them
87!   based on the initializing_actions
88! - parameter definition removed from "season" and "season_z01" is added to parin
89! - bugfix in application of index_hh after implementing the new
90!   palm_date_time_mod
91! - Reformat salsa emission data with LOD=2: size distribution given for each
92!   emission category
93!
94! 4268 2019-10-17 11:29:38Z schwenkel
95! Moving module specific boundary conditions from time_integration to module
96!
97! 4256 2019-10-07 10:08:52Z monakurppa
98! Document previous changes: use global variables nx, ny and nz in salsa_header
99!
100! 4227 2019-09-10 18:04:34Z gronemeier
101! implement new palm_date_time_mod
102!
103! 4226 2019-09-10 17:03:24Z suehring
104! Netcdf input routine for dimension length renamed
105!
106! 4182 2019-08-22 15:20:23Z scharf
107! Corrected "Former revisions" section
108!
109! 4167 2019-08-16 11:01:48Z suehring
110! Changed behaviour of masked output over surface to follow terrain and ignore
111! buildings (J.Resler, T.Gronemeier)
112!
113! 4131 2019-08-02 11:06:18Z monakurppa
114! - Add "salsa_" before each salsa output variable
115! - Add a possibility to output the number (salsa_N_UFP) and mass concentration
116!   (salsa_PM0.1) of ultrafine particles, i.e. particles with a diameter smaller
117!   than 100 nm
118! - Implement aerosol emission mode "parameterized" which is based on the street
119!   type (similar to the chemistry module).
120! - Remove unnecessary nucleation subroutines.
121! - Add the z-dimension for gaseous emissions to correspond the implementation
122!   in the chemistry module
123!
124! 4118 2019-07-25 16:11:45Z suehring
125! - When Dirichlet condition is applied in decycling, the boundary conditions are
126!   only set at the ghost points and not at the prognostic grid points as done
127!   before
128! - Rename decycle_ns/lr to decycle_salsa_ns/lr and decycle_method to
129!   decycle_method_salsa
130! - Allocation and initialization of special advection flags salsa_advc_flags_s
131!   used for salsa. These are exclusively used for salsa variables to
132!   distinguish from the usually-used flags which might be different when
133!   decycling is applied in combination with cyclic boundary conditions.
134!   Moreover, salsa_advc_flags_s considers extended zones around buildings where
135!   the first-order upwind scheme is applied for the horizontal advection terms.
136!   This is done to overcome high concentration peaks due to stationary numerical
137!   oscillations caused by horizontal advection discretization.
138!
139! 4117 2019-07-25 08:54:02Z monakurppa
140! Pass integer flag array as well as boundary flags to WS scalar advection
141! routine
142!
143! 4109 2019-07-22 17:00:34Z suehring
144! Slightly revise setting of boundary conditions at horizontal walls, use
145! data-structure offset index instead of pre-calculate it for each facing
146!
147! 4079 2019-07-09 18:04:41Z suehring
148! Application of monotonic flux limiter for the vertical scalar advection
149! up to the topography top (only for the cache-optimized version at the
150! moment).
151!
152! 4069 2019-07-01 14:05:51Z Giersch
153! Masked output running index mid has been introduced as a local variable to
154! avoid runtime error (Loop variable has been modified) in time_integration
155!
156! 4058 2019-06-27 15:25:42Z knoop
157! Bugfix: to_be_resorted was uninitialized in case of s_H2O in 3d_data_averaging
158!
159! 4012 2019-05-31 15:19:05Z monakurppa
160! Merge salsa branch to trunk. List of changes:
161! - Error corrected in distr_update that resulted in the aerosol number size
162!   distribution not converging if the concentration was nclim.
163! - Added a separate output for aerosol liquid water (s_H2O)
164! - aerosol processes for a size bin are now calculated only if the aerosol
165!   number of concentration of that bin is > 2*nclim
166! - An initialisation error in the subroutine "deposition" corrected and the
167!   subroutine reformatted.
168! - stuff from salsa_util_mod.f90 moved into salsa_mod.f90
169! - calls for closing the netcdf input files added
170!
171! 3956 2019-05-07 12:32:52Z monakurppa
172! - Conceptual bug in depo_surf correct for urban and land surface model
173! - Subroutine salsa_tendency_ij optimized.
174! - Interfaces salsa_non_advective_processes and salsa_exchange_horiz_bounds
175!   created. These are now called in module_interface.
176!   salsa_exchange_horiz_bounds after calling salsa_driver only when needed
177!   (i.e. every dt_salsa).
178!
179! 3924 2019-04-23 09:33:06Z monakurppa
180! Correct a bug introduced by the previous update.
181!
182! 3899 2019-04-16 14:05:27Z monakurppa
183! - remove unnecessary error / location messages
184! - corrected some error message numbers
185! - allocate source arrays only if emissions or dry deposition is applied.
186!
187! 3885 2019-04-11 11:29:34Z kanani
188! Changes related to global restructuring of location messages and introduction
189! of additional debug messages
190!
191! 3876 2019-04-08 18:41:49Z knoop
192! Introduced salsa_actions module interface
193!
194! 3871 2019-04-08 14:38:39Z knoop
195! Major changes in formatting, performance and data input structure (see branch
196! the history for details)
197! - Time-dependent emissions enabled: lod=1 for yearly PM emissions that are
198!   normalised depending on the time, and lod=2 for preprocessed emissions
199!   (similar to the chemistry module).
200! - Additionally, 'uniform' emissions allowed. This emission is set constant on
201!   all horisontal upward facing surfaces and it is created based on parameters
202!   surface_aerosol_flux, aerosol_flux_dpg/sigmag/mass_fracs_a/mass_fracs_b.
203! - All emissions are now implemented as surface fluxes! No 3D sources anymore.
204! - Update the emission information by calling salsa_emission_update if
205!   skip_time_do_salsa >= time_since_reference_point and
206!   next_aero_emission_update <= time_since_reference_point
207! - Aerosol background concentrations read from PIDS_DYNAMIC. The vertical grid
208!   must match the one applied in the model.
209! - Gas emissions and background concentrations can be also read in in salsa_mod
210!   if the chemistry module is not applied.
211! - In deposition, information on the land use type can be now imported from
212!   the land use model
213! - Use SI units in PARIN, i.e. n_lognorm given in #/m3 and dpg in metres.
214! - Apply 100 character line limit
215! - Change all variable names from capital to lowercase letter
216! - Change real exponents to integer if possible. If not, precalculate the value
217!   value of exponent
218! - Rename in1a to start_subrange_1a, fn2a to end_subrange_1a etc.
219! - Rename nbins --> nbins_aerosol, ncc_tot --> ncomponents_mass and ngast -->
220!   ngases_salsa
221! - Rename ibc to index_bc, idu to index_du etc.
222! - Renamed loop indices b, c and sg to ib, ic and ig
223! - run_salsa subroutine removed
224! - Corrected a bud in salsa_driver: falsely applied ino instead of inh
225! - Call salsa_tendency within salsa_prognostic_equations which is called in
226!   module_interface_mod instead of prognostic_equations_mod
227! - Removed tailing white spaces and unused variables
228! - Change error message to start by PA instead of SA
229!
230! 3833 2019-03-28 15:04:04Z forkel
231! added USE chem_gasphase_mod for nvar, nspec and spc_names
232!
233! 3787 2019-03-07 08:43:54Z raasch
234! unused variables removed
235!
236! 3780 2019-03-05 11:19:45Z forkel
237! unused variable for file index removed from rrd-subroutines parameter list
238!
239! 3685 2019-01-21 01:02:11Z knoop
240! Some interface calls moved to module_interface + cleanup
241!
242! 3655 2019-01-07 16:51:22Z knoop
243! Implementation of the PALM module interface
244! 3412 2018-10-24 07:25:57Z monakurppa
245!
246! Authors:
247! --------
248! @author Mona Kurppa (University of Helsinki)
249!
250!
251! Description:
252! ------------
253!> Sectional aerosol module for large scale applications SALSA
254!> (Kokkola et al., 2008, ACP 8, 2469-2483). Solves the aerosol number and mass
255!> concentration as well as chemical composition. Includes aerosol dynamic
256!> processes: nucleation, condensation/evaporation of vapours, coagulation and
257!> deposition on tree leaves, ground and roofs.
258!> Implementation is based on formulations implemented in UCLALES-SALSA except
259!> for deposition which is based on parametrisations by Zhang et al. (2001,
260!> Atmos. Environ. 35, 549-560) or Petroff&Zhang (2010, Geosci. Model Dev. 3,
261!> 753-769)
262!>
263!> @todo Apply information from emission_stack_height to lift emission sources
264!> @todo Allow insoluble emissions
265!------------------------------------------------------------------------------!
266 MODULE salsa_mod
267
268    USE basic_constants_and_equations_mod,                                                         &
269        ONLY:  c_p, g, p_0, pi, r_d
270
271    USE chem_gasphase_mod,                                                                         &
272        ONLY:  nspec, nvar, spc_names
273
274    USE chem_modules,                                                                              &
275        ONLY:  call_chem_at_all_substeps, chem_gasphase_on, chem_species
276
277    USE control_parameters,                                                                        &
278        ONLY:  air_chemistry, bc_dirichlet_l, bc_dirichlet_n, bc_dirichlet_r, bc_dirichlet_s,      &
279               bc_lr, bc_lr_cyc, bc_ns, bc_ns_cyc, bc_radiation_l, bc_radiation_n, bc_radiation_r, &
280               bc_radiation_s, coupling_char, debug_output, dt_3d, intermediate_timestep_count,    &
281               intermediate_timestep_count_max, land_surface, max_pr_salsa, message_string,        &
282               monotonic_limiter_z, plant_canopy, pt_surface, salsa, scalar_advec,                 &
283               surface_pressure, time_since_reference_point, timestep_scheme, tsc, urban_surface,  &
284               ws_scheme_sca
285
286    USE indices,                                                                                   &
287        ONLY:  nbgp, nx, nxl, nxlg, nxr, nxrg, ny, nyn, nyng, nys, nysg, nzb, nz, nzt,             &
288               wall_flags_total_0
289
290    USE kinds
291
292    USE netcdf_data_input_mod,                                                                     &
293        ONLY:  chem_emis_att_type, chem_emis_val_type
294
295    USE pegrid
296
297    USE statistics,                                                                                &
298        ONLY:  sums_salsa_ws_l
299
300    IMPLICIT NONE
301!
302!-- SALSA constants:
303!
304!-- Local constants:
305    INTEGER(iwp), PARAMETER ::  luc_urban = 15     !< default landuse type for urban
306    INTEGER(iwp), PARAMETER ::  ngases_salsa  = 5  !< total number of gaseous tracers:
307                                                   !< 1 = H2SO4, 2 = HNO3, 3 = NH3, 4 = OCNV
308                                                   !< (non-volatile OC), 5 = OCSV (semi-volatile)
309    INTEGER(iwp), PARAMETER ::  nmod = 7     !< number of modes for initialising the aerosol size distribution
310    INTEGER(iwp), PARAMETER ::  nreg = 2     !< Number of main size subranges
311    INTEGER(iwp), PARAMETER ::  maxspec = 7  !< Max. number of aerosol species
312
313
314    REAL(wp), PARAMETER ::  fill_value = -9999.0_wp    !< value for the _FillValue attribute
315!
316!-- Universal constants
317    REAL(wp), PARAMETER ::  abo    = 1.380662E-23_wp   !< Boltzmann constant (J/K)
318    REAL(wp), PARAMETER ::  alv    = 2.260E+6_wp       !< latent heat for H2O vaporisation (J/kg)
319    REAL(wp), PARAMETER ::  alv_d_rv  = 4896.96865_wp  !< alv / rv
320    REAL(wp), PARAMETER ::  am_airmol = 4.8096E-26_wp  !< Average mass of an air molecule (Jacobson 2005, Eq.2.3)
321    REAL(wp), PARAMETER ::  api6   = 0.5235988_wp      !< pi / 6
322    REAL(wp), PARAMETER ::  argas  = 8.314409_wp       !< Gas constant (J/(mol K))
323    REAL(wp), PARAMETER ::  argas_d_cpd = 8.281283865E-3_wp  !< argas per cpd
324    REAL(wp), PARAMETER ::  avo    = 6.02214E+23_wp    !< Avogadro constant (1/mol)
325    REAL(wp), PARAMETER ::  d_sa   = 5.539376964394570E-10_wp  !< diameter of condensing H2SO4 molecule (m)
326    REAL(wp), PARAMETER ::  for_ppm_to_nconc =  7.243016311E+16_wp !< ppm * avo / R (K/(Pa*m3))
327    REAL(wp), PARAMETER ::  epsoc  = 0.15_wp          !< water uptake of organic material
328    REAL(wp), PARAMETER ::  mclim  = 1.0E-23_wp       !< mass concentration min limit (kg/m3)
329    REAL(wp), PARAMETER ::  n3     = 158.79_wp        !< Number of H2SO4 molecules in 3 nm cluster if d_sa=5.54e-10m
330    REAL(wp), PARAMETER ::  nclim  = 1.0_wp           !< number concentration min limit (#/m3)
331    REAL(wp), PARAMETER ::  surfw0 = 0.073_wp         !< surface tension of water at 293 K (J/m2)
332!
333!-- Molar masses in kg/mol
334    REAL(wp), PARAMETER ::  ambc     = 12.0E-3_wp     !< black carbon (BC)
335    REAL(wp), PARAMETER ::  amdair   = 28.970E-3_wp   !< dry air
336    REAL(wp), PARAMETER ::  amdu     = 100.0E-3_wp    !< mineral dust
337    REAL(wp), PARAMETER ::  amh2o    = 18.0154E-3_wp  !< H2O
338    REAL(wp), PARAMETER ::  amh2so4  = 98.06E-3_wp    !< H2SO4
339    REAL(wp), PARAMETER ::  amhno3   = 63.01E-3_wp    !< HNO3
340    REAL(wp), PARAMETER ::  amn2o    = 44.013E-3_wp   !< N2O
341    REAL(wp), PARAMETER ::  amnh3    = 17.031E-3_wp   !< NH3
342    REAL(wp), PARAMETER ::  amo2     = 31.9988E-3_wp  !< O2
343    REAL(wp), PARAMETER ::  amo3     = 47.998E-3_wp   !< O3
344    REAL(wp), PARAMETER ::  amoc     = 150.0E-3_wp    !< organic carbon (OC)
345    REAL(wp), PARAMETER ::  amss     = 58.44E-3_wp    !< sea salt (NaCl)
346!
347!-- Densities in kg/m3
348    REAL(wp), PARAMETER ::  arhobc     = 2000.0_wp  !< black carbon
349    REAL(wp), PARAMETER ::  arhodu     = 2650.0_wp  !< mineral dust
350    REAL(wp), PARAMETER ::  arhoh2o    = 1000.0_wp  !< H2O
351    REAL(wp), PARAMETER ::  arhoh2so4  = 1830.0_wp  !< SO4
352    REAL(wp), PARAMETER ::  arhohno3   = 1479.0_wp  !< HNO3
353    REAL(wp), PARAMETER ::  arhonh3    = 1530.0_wp  !< NH3
354    REAL(wp), PARAMETER ::  arhooc     = 2000.0_wp  !< organic carbon
355    REAL(wp), PARAMETER ::  arhoss     = 2165.0_wp  !< sea salt (NaCl)
356!
357!-- Volume of molecule in m3/#
358    REAL(wp), PARAMETER ::  amvh2o   = amh2o /avo / arhoh2o      !< H2O
359    REAL(wp), PARAMETER ::  amvh2so4 = amh2so4 / avo / arhoh2so4 !< SO4
360    REAL(wp), PARAMETER ::  amvhno3  = amhno3 / avo / arhohno3   !< HNO3
361    REAL(wp), PARAMETER ::  amvnh3   = amnh3 / avo / arhonh3     !< NH3
362    REAL(wp), PARAMETER ::  amvoc    = amoc / avo / arhooc       !< OC
363    REAL(wp), PARAMETER ::  amvss    = amss / avo / arhoss       !< sea salt
364!
365!-- Constants for the dry deposition model by Petroff and Zhang (2010):
366!-- obstacle characteristic dimension "L" (cm) (plane obstacle by default) and empirical constants
367!-- C_B, C_IN, C_IM, beta_IM and C_IT for each land use category (15, as in Zhang et al. (2001))
368    REAL(wp), DIMENSION(1:15), PARAMETER :: l_p10 = &
369        (/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/)
370    REAL(wp), DIMENSION(1:15), PARAMETER :: c_b_p10 = &
371        (/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/)
372    REAL(wp), DIMENSION(1:15), PARAMETER :: c_in_p10 = &
373        (/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/)
374    REAL(wp), DIMENSION(1:15), PARAMETER :: c_im_p10 = &
375        (/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/)
376    REAL(wp), DIMENSION(1:15), PARAMETER :: beta_im_p10 = &
377        (/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/)
378    REAL(wp), DIMENSION(1:15), PARAMETER :: c_it_p10 = &
379        (/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/)
380!
381!-- Constants for the dry deposition model by Zhang et al. (2001):
382!-- empirical constants "alpha" and "gamma" and characteristic radius "A" for
383!-- each land use category (15) and season (5)
384    REAL(wp), DIMENSION(1:15), PARAMETER :: alpha_z01 = &
385        (/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/)
386    REAL(wp), DIMENSION(1:15), PARAMETER :: gamma_z01 = &
387        (/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/)
388    REAL(wp), DIMENSION(1:15,1:5), PARAMETER :: A_z01 =  RESHAPE( (/& 
389         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
390         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
391         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
392         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
393         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
394                                                           /), (/ 15, 5 /) )
395!-- Land use categories (based on Z01 but the same applies here also for P10):
396!-- 1 = evergreen needleleaf trees,
397!-- 2 = evergreen broadleaf trees,
398!-- 3 = deciduous needleleaf trees,
399!-- 4 = deciduous broadleaf trees,
400!-- 5 = mixed broadleaf and needleleaf trees (deciduous broadleaf trees for P10),
401!-- 6 = grass (short grass for P10),
402!-- 7 = crops, mixed farming,
403!-- 8 = desert,
404!-- 9 = tundra,
405!-- 10 = shrubs and interrupted woodlands (thorn shrubs for P10),
406!-- 11 = wetland with plants (long grass for P10)
407!-- 12 = ice cap and glacier,
408!-- 13 = inland water (inland lake for P10)
409!-- 14 = ocean (water for P10),
410!-- 15 = urban
411!
412!-- SALSA variables:
413    CHARACTER(LEN=20)  ::  bc_salsa_b = 'neumann'                 !< bottom boundary condition
414    CHARACTER(LEN=20)  ::  bc_salsa_t = 'neumann'                 !< top boundary condition
415    CHARACTER(LEN=20)  ::  depo_pcm_par = 'zhang2001'             !< or 'petroff2010'
416    CHARACTER(LEN=20)  ::  depo_pcm_type = 'deciduous_broadleaf'  !< leaf type
417    CHARACTER(LEN=20)  ::  depo_surf_par = 'zhang2001'            !< or 'petroff2010'
418    CHARACTER(LEN=100) ::  input_file_dynamic = 'PIDS_DYNAMIC'    !< file name for dynamic input
419    CHARACTER(LEN=100) ::  input_file_salsa   = 'PIDS_SALSA'      !< file name for emission data
420    CHARACTER(LEN=20)  ::  salsa_emission_mode = 'no_emission'    !< 'no_emission', 'uniform',
421                                                                  !< 'parameterized', 'read_from_file'
422
423    CHARACTER(LEN=20), DIMENSION(4) ::  decycle_method_salsa =                                     &
424                                                 (/'dirichlet','dirichlet','dirichlet','dirichlet'/)
425                                     !< Decycling method at horizontal boundaries
426                                     !< 1=left, 2=right, 3=south, 4=north
427                                     !< dirichlet = initial profiles for the ghost and first 3 layers
428                                     !< neumann = zero gradient
429
430    CHARACTER(LEN=3), DIMENSION(maxspec) ::  listspec = &  !< Active aerosols
431                                   (/'SO4','   ','   ','   ','   ','   ','   '/)
432
433    INTEGER(iwp) ::  depo_pcm_par_num = 1   !< parametrisation type: 1=zhang2001, 2=petroff2010
434    INTEGER(iwp) ::  depo_pcm_type_num = 0  !< index for the dry deposition type on the plant canopy
435    INTEGER(iwp) ::  depo_surf_par_num = 1  !< parametrisation type: 1=zhang2001, 2=petroff2010
436    INTEGER(iwp) ::  end_subrange_1a = 1    !< last index for bin subrange 1a
437    INTEGER(iwp) ::  end_subrange_2a = 1    !< last index for bin subrange 2a
438    INTEGER(iwp) ::  end_subrange_2b = 1    !< last index for bin subrange 2b
439    INTEGER(iwp) ::  ibc_salsa_b            !< index for the bottom boundary condition
440    INTEGER(iwp) ::  ibc_salsa_t            !< index for the top boundary condition
441    INTEGER(iwp) ::  index_bc  = -1         !< index for black carbon (BC)
442    INTEGER(iwp) ::  index_du  = -1         !< index for dust
443    INTEGER(iwp) ::  index_nh  = -1         !< index for NH3
444    INTEGER(iwp) ::  index_no  = -1         !< index for HNO3
445    INTEGER(iwp) ::  index_oc  = -1         !< index for organic carbon (OC)
446    INTEGER(iwp) ::  index_so4 = -1         !< index for SO4 or H2SO4
447    INTEGER(iwp) ::  index_ss  = -1         !< index for sea salt
448    INTEGER(iwp) ::  init_aerosol_type = 0  !< Initial size distribution type
449                                            !< 0 = uniform (read from PARIN)
450                                            !< 1 = read vertical profiles from an input file
451    INTEGER(iwp) ::  init_gases_type = 0    !< Initial gas concentration type
452                                            !< 0 = uniform (read from PARIN)
453                                            !< 1 = read vertical profiles from an input file
454    INTEGER(iwp) ::  lod_gas_emissions = 0  !< level of detail of the gaseous emission data
455    INTEGER(iwp) ::  main_street_id = 0     !< lower bound of main street IDs for parameterized emission mode
456    INTEGER(iwp) ::  max_street_id = 0      !< upper bound of main street IDs for parameterized emission mode
457    INTEGER(iwp) ::  nbins_aerosol = 1      !< total number of size bins
458    INTEGER(iwp) ::  ncc   = 1              !< number of chemical components used
459    INTEGER(iwp) ::  ncomponents_mass = 1   !< total number of chemical compounds (ncc+1)
460                                            !< if particle water is advected)
461    INTEGER(iwp) ::  nj3 = 1                !< J3 parametrization (nucleation)
462                                            !< 1 = condensational sink (Kerminen&Kulmala, 2002)
463                                            !< 2 = coagulational sink (Lehtinen et al. 2007)
464                                            !< 3 = coagS+self-coagulation (Anttila et al. 2010)
465    INTEGER(iwp) ::  nsnucl = 0             !< Choice of the nucleation scheme:
466                                            !< 0 = off
467                                            !< 1 = binary nucleation
468                                            !< 2 = activation type nucleation
469                                            !< 3 = kinetic nucleation
470                                            !< 4 = ternary nucleation
471                                            !< 5 = nucleation with ORGANICs
472                                            !< 6 = activation type of nucleation with H2SO4+ORG
473                                            !< 7 = heteromolecular nucleation with H2SO4*ORG
474                                            !< 8 = homomolecular nucleation of H2SO4
475                                            !<     + heteromolecular nucleation with H2SO4*ORG
476                                            !< 9 = homomolecular nucleation of H2SO4 and ORG
477                                            !<     + heteromolecular nucleation with H2SO4*ORG
478    INTEGER(iwp) ::  salsa_pr_count = 0     !< counter for salsa variable profiles
479    INTEGER(iwp) ::  season_z01 = 1         !< For dry deposition by Zhang et al.: 1 = summer,
480                                            !< 2 = autumn (no harvest yet), 3 = late autumn
481                                            !< (already frost), 4 = winter, 5 = transitional spring
482    INTEGER(iwp) ::  side_street_id = 0     !< lower bound of side street IDs for parameterized emission mode
483    INTEGER(iwp) ::  start_subrange_1a = 1  !< start index for bin subranges: subrange 1a
484    INTEGER(iwp) ::  start_subrange_2a = 1  !<                                subrange 2a
485    INTEGER(iwp) ::  start_subrange_2b = 1  !<                                subrange 2b
486
487    INTEGER(iwp), DIMENSION(nreg) ::  nbin = (/ 3, 7/)  !< Number of size bins per subrange: 1 & 2
488
489    INTEGER(iwp), DIMENSION(ngases_salsa) ::  gas_index_chem = (/ 1, 1, 1, 1, 1/)  !< gas indices in chemistry_model_mod
490                                                                                   !< 1 = H2SO4, 2 = HNO3,
491                                                                                   !< 3 = NH3,   4 = OCNV, 5 = OCSV
492    INTEGER(iwp), DIMENSION(ngases_salsa) ::  emission_index_chem  !< gas indices in the gas emission file
493    INTEGER(iwp), DIMENSION(99) ::  salsa_pr_index  = 0            !< index for salsa profiles
494
495    INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE ::  k_topo_top  !< vertical index of the topography top
496
497    INTEGER(iwp), DIMENSION(:,:,:), ALLOCATABLE  ::  salsa_advc_flags_s !< flags used to degrade order of advection
498                                                                        !< scheme for salsa variables near walls and
499                                                                        !< lateral boundaries
500!
501!-- SALSA switches:
502    LOGICAL ::  advect_particle_water   = .TRUE.   !< Advect water concentration of particles
503    LOGICAL ::  decycle_salsa_lr        = .FALSE.  !< Undo cyclic boundaries: left and right
504    LOGICAL ::  decycle_salsa_ns        = .FALSE.  !< Undo cyclic boundaries: north and south
505    LOGICAL ::  include_emission        = .FALSE.  !< Include or not emissions
506    LOGICAL ::  feedback_to_palm        = .FALSE.  !< Allow feedback due to condensation of H2O
507    LOGICAL ::  nesting_salsa           = .TRUE.   !< Apply nesting for salsa
508    LOGICAL ::  nesting_offline_salsa   = .TRUE.   !< Apply offline nesting for salsa
509    LOGICAL ::  no_insoluble            = .FALSE.  !< Exclude insoluble chemical components
510    LOGICAL ::  read_restart_data_salsa = .TRUE.   !< Read restart data for salsa
511    LOGICAL ::  salsa_gases_from_chem   = .FALSE.  !< Transfer the gaseous components to SALSA
512    LOGICAL ::  van_der_waals_coagc     = .FALSE.  !< Include van der Waals and viscous forces in coagulation
513    LOGICAL ::  write_binary_salsa      = .TRUE.   !< read binary for salsa
514!
515!-- Process switches: nl* is read from the NAMELIST and is NOT changed.
516!--                   ls* is the switch used and will get the value of nl*
517!--                       except for special circumstances (spinup period etc.)
518    LOGICAL ::  nlcoag       = .FALSE.  !< Coagulation master switch
519    LOGICAL ::  lscoag       = .FALSE.  !<
520    LOGICAL ::  nlcnd        = .FALSE.  !< Condensation master switch
521    LOGICAL ::  lscnd        = .FALSE.  !<
522    LOGICAL ::  nlcndgas     = .FALSE.  !< Condensation of precursor gases
523    LOGICAL ::  lscndgas     = .FALSE.  !<
524    LOGICAL ::  nlcndh2oae   = .FALSE.  !< Condensation of H2O on aerosol
525    LOGICAL ::  lscndh2oae   = .FALSE.  !< particles (FALSE -> equilibrium calc.)
526    LOGICAL ::  nldepo       = .FALSE.  !< Deposition master switch
527    LOGICAL ::  lsdepo       = .FALSE.  !<
528    LOGICAL ::  nldepo_surf  = .FALSE.  !< Deposition on vegetation master switch
529    LOGICAL ::  lsdepo_surf  = .FALSE.  !<
530    LOGICAL ::  nldepo_pcm   = .FALSE.  !< Deposition on walls master switch
531    LOGICAL ::  lsdepo_pcm   = .FALSE.  !<
532    LOGICAL ::  nldistupdate = .TRUE.   !< Size distribution update master switch
533    LOGICAL ::  lsdistupdate = .FALSE.  !<
534    LOGICAL ::  lspartition  = .FALSE.  !< Partition of HNO3 and NH3
535
536    REAL(wp) ::  act_coeff = 1.0E-7_wp               !< Activation coefficient (1/s)
537    REAL(wp) ::  dt_salsa  = 0.00001_wp              !< Time step of SALSA
538    REAL(wp) ::  emiss_factor_main = 0.0_wp          !< relative emission factor for main streets
539    REAL(wp) ::  emiss_factor_side = 0.0_wp          !< relative emission factor for side streets
540    REAL(wp) ::  h2so4_init = nclim                  !< Init value for sulphuric acid gas
541    REAL(wp) ::  hno3_init  = nclim                  !< Init value for nitric acid gas
542    REAL(wp) ::  last_salsa_time = 0.0_wp            !< previous salsa call
543    REAL(wp) ::  next_aero_emission_update = 0.0_wp  !< previous emission update
544    REAL(wp) ::  next_gas_emission_update = 0.0_wp   !< previous emission update
545    REAL(wp) ::  nf2a = 1.0_wp                       !< Number fraction allocated to 2a-bins
546    REAL(wp) ::  nh3_init  = nclim                   !< Init value for ammonia gas
547    REAL(wp) ::  ocnv_init = nclim                   !< Init value for non-volatile organic gases
548    REAL(wp) ::  ocsv_init = nclim                   !< Init value for semi-volatile organic gases
549    REAL(wp) ::  rhlim = 1.20_wp                     !< RH limit in %/100. Prevents unrealistical RH
550    REAL(wp) ::  skip_time_do_salsa = 0.0_wp         !< Starting time of SALSA (s)
551!
552!-- Initial log-normal size distribution: mode diameter (dpg, metres),
553!-- standard deviation (sigmag) and concentration (n_lognorm, #/m3)
554    REAL(wp), DIMENSION(nmod) ::  dpg   = &
555                     (/1.3E-8_wp, 5.4E-8_wp, 8.6E-7_wp, 2.0E-7_wp, 2.0E-7_wp, 2.0E-7_wp, 2.0E-7_wp/)
556    REAL(wp), DIMENSION(nmod) ::  sigmag  = &
557                                        (/1.8_wp, 2.16_wp, 2.21_wp, 2.0_wp, 2.0_wp, 2.0_wp, 2.0_wp/)
558    REAL(wp), DIMENSION(nmod) ::  n_lognorm = &
559                             (/1.04e+11_wp, 3.23E+10_wp, 5.4E+6_wp, 0.0_wp, 0.0_wp, 0.0_wp, 0.0_wp/)
560!
561!-- Initial mass fractions / chemical composition of the size distribution
562    REAL(wp), DIMENSION(maxspec) ::  mass_fracs_a = &  !< mass fractions between
563             (/1.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0/)     !< aerosol species for A bins
564    REAL(wp), DIMENSION(maxspec) ::  mass_fracs_b = &  !< mass fractions between
565             (/0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0/)     !< aerosol species for B bins
566    REAL(wp), DIMENSION(nreg+1) ::  reglim = &         !< Min&max diameters of size subranges
567                                 (/ 3.0E-9_wp, 5.0E-8_wp, 1.0E-5_wp/)
568!
569!-- Initial log-normal size distribution: mode diameter (dpg, metres), standard deviation (sigmag)
570!-- concentration (n_lognorm, #/m3) and mass fractions of all chemical components (listed in
571!-- listspec) for both a (soluble) and b (insoluble) bins.
572    REAL(wp), DIMENSION(nmod) ::  aerosol_flux_dpg   = &
573                     (/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/)
574    REAL(wp), DIMENSION(nmod) ::  aerosol_flux_sigmag  = &
575                                        (/1.8_wp, 2.16_wp, 2.21_wp, 2.0_wp, 2.0_wp, 2.0_wp, 2.0_wp/)
576    REAL(wp), DIMENSION(maxspec) ::  aerosol_flux_mass_fracs_a = &
577                                                               (/1.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0/)
578    REAL(wp), DIMENSION(maxspec) ::  aerosol_flux_mass_fracs_b = &
579                                                               (/0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0/)
580    REAL(wp), DIMENSION(nmod) ::  surface_aerosol_flux = &
581                                 (/1.0E+8_wp, 1.0E+9_wp, 1.0E+5_wp, 0.0_wp, 0.0_wp, 0.0_wp, 0.0_wp/)
582
583    REAL(wp), DIMENSION(:), ALLOCATABLE ::  bin_low_limits     !< to deliver information about
584                                                               !< the lower diameters per bin
585    REAL(wp), DIMENSION(:), ALLOCATABLE ::  bc_am_t_val        !< vertical gradient of: aerosol mass
586    REAL(wp), DIMENSION(:), ALLOCATABLE ::  bc_an_t_val        !< of: aerosol number
587    REAL(wp), DIMENSION(:), ALLOCATABLE ::  bc_gt_t_val        !< salsa gases near domain top
588    REAL(wp), DIMENSION(:), ALLOCATABLE ::  gas_emission_time  !< Time array in gas emission data (s)
589    REAL(wp), DIMENSION(:), ALLOCATABLE ::  nsect              !< Background number concentrations
590    REAL(wp), DIMENSION(:), ALLOCATABLE ::  massacc            !< Mass accomodation coefficients
591!
592!-- SALSA derived datatypes:
593!
594!-- Component index
595    TYPE component_index
596       CHARACTER(len=3), ALLOCATABLE ::  comp(:)  !< Component name
597       INTEGER(iwp) ::  ncomp  !< Number of components
598       INTEGER(iwp), ALLOCATABLE ::  ind(:)  !< Component index
599    END TYPE component_index
600!
601!-- For matching LSM and USM surface types and the deposition module surface types
602    TYPE match_surface
603       INTEGER(iwp), DIMENSION(:), ALLOCATABLE ::  match_lupg  !< index for pavement / green roofs
604       INTEGER(iwp), DIMENSION(:), ALLOCATABLE ::  match_luvw  !< index for vegetation / walls
605       INTEGER(iwp), DIMENSION(:), ALLOCATABLE ::  match_luww  !< index for water / windows
606    END TYPE match_surface
607!
608!-- Aerosol emission data attributes
609    TYPE salsa_emission_attribute_type
610
611       CHARACTER(LEN=25) ::   units
612
613       CHARACTER(LEN=25), DIMENSION(:), ALLOCATABLE ::   cat_name    !<
614       CHARACTER(LEN=25), DIMENSION(:), ALLOCATABLE ::   cc_name     !<
615       CHARACTER(LEN=25), DIMENSION(:), ALLOCATABLE ::   unit_time   !<
616       CHARACTER(LEN=100), DIMENSION(:), ALLOCATABLE ::  var_names   !<
617
618       INTEGER(iwp) ::  lod = 0            !< level of detail
619       INTEGER(iwp) ::  nbins = 10         !< number of aerosol size bins
620       INTEGER(iwp) ::  ncat  = 0          !< number of emission categories
621       INTEGER(iwp) ::  ncc   = 7          !< number of aerosol chemical components
622       INTEGER(iwp) ::  nhoursyear = 0     !< number of hours: HOURLY mode
623       INTEGER(iwp) ::  nmonthdayhour = 0  !< number of month days and hours: MDH mode
624       INTEGER(iwp) ::  num_vars           !< number of variables
625       INTEGER(iwp) ::  nt  = 0            !< number of time steps
626       INTEGER(iwp) ::  nz  = 0            !< number of vertical levels
627       INTEGER(iwp) ::  tind               !< time index for reference time in salsa emission data
628
629       INTEGER(iwp), DIMENSION(maxspec) ::  cc_in2mod = 0   !<
630
631       INTEGER(iwp), DIMENSION(:), ALLOCATABLE ::  cat_index  !< Index of emission categories
632       INTEGER(iwp), DIMENSION(:), ALLOCATABLE ::  cc_index   !< Index of chemical components
633
634       REAL(wp) ::  conversion_factor  !< unit conversion factor for aerosol emissions
635
636       REAL(wp), DIMENSION(:), ALLOCATABLE ::  dmid         !< mean diameters of size bins (m)
637       REAL(wp), DIMENSION(:), ALLOCATABLE ::  rho          !< average density (kg/m3)
638       REAL(wp), DIMENSION(:), ALLOCATABLE ::  time         !< time (s)
639       REAL(wp), DIMENSION(:), ALLOCATABLE ::  time_factor  !< emission time factor
640       REAL(wp), DIMENSION(:), ALLOCATABLE ::  z            !< height (m)
641
642       REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  etf  !< emission time factor
643       REAL(wp), DIMENSION(:,:), ALLOCATABLE :: stack_height
644
645    END TYPE salsa_emission_attribute_type
646!
647!-- The default size distribution and mass composition per emission category:
648!-- 1 = traffic, 2 = road dust, 3 = wood combustion, 4 = other
649!-- Mass fractions: H2SO4, OC, BC, DU, SS, HNO3, NH3
650    TYPE salsa_emission_mode_type
651
652       INTEGER(iwp) ::  ndm = 3  !< number of default modes
653       INTEGER(iwp) ::  ndc = 4  !< number of default categories
654
655       CHARACTER(LEN=25), DIMENSION(1:4) ::  cat_name_table = (/'traffic exhaust', &
656                                                                'road dust      ', &
657                                                                'wood combustion', &
658                                                                'other          '/)
659
660       INTEGER(iwp), DIMENSION(1:4) ::  cat_input_to_model   !<
661
662       REAL(wp), DIMENSION(1:3) ::  dpg_table = (/ 13.5E-9_wp, 1.4E-6_wp, 5.4E-8_wp/)  !<
663       REAL(wp), DIMENSION(1:3) ::  ntot_table  !<
664       REAL(wp), DIMENSION(1:3) ::  sigmag_table = (/ 1.6_wp, 1.4_wp, 1.7_wp /)  !<
665
666       REAL(wp), DIMENSION(1:maxspec,1:4) ::  mass_frac_table = &  !<
667          RESHAPE( (/ 0.04_wp, 0.48_wp, 0.48_wp, 0.0_wp,  0.0_wp, 0.0_wp, 0.0_wp, &
668                      0.0_wp,  0.05_wp, 0.0_wp,  0.95_wp, 0.0_wp, 0.0_wp, 0.0_wp, &
669                      0.0_wp,  0.5_wp,  0.5_wp,  0.0_wp,  0.0_wp, 0.0_wp, 0.0_wp, &
670                      0.0_wp,  0.5_wp,  0.5_wp,  0.0_wp,  0.0_wp, 0.0_wp, 0.0_wp  &
671                   /), (/maxspec,4/) )
672
673       REAL(wp), DIMENSION(1:3,1:4) ::  pm_frac_table = & !< rel. mass
674                                     RESHAPE( (/ 0.016_wp, 0.000_wp, 0.984_wp, &
675                                                 0.000_wp, 1.000_wp, 0.000_wp, &
676                                                 0.000_wp, 0.000_wp, 1.000_wp, &
677                                                 1.000_wp, 0.000_wp, 1.000_wp  &
678                                              /), (/3,4/) )
679
680    END TYPE salsa_emission_mode_type
681!
682!-- Aerosol emission data values
683    TYPE salsa_emission_value_type
684
685       REAL(wp) ::  fill  !< fill value
686
687       REAL(wp), DIMENSION(:,:), ALLOCATABLE :: mass_fracs  !< mass fractions per emis. category
688       REAL(wp), DIMENSION(:,:), ALLOCATABLE :: num_fracs   !< number fractions per emis. category
689
690       REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: def_data      !< surface emission in PM
691       REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: preproc_data  !< surface emission per category
692
693    END TYPE salsa_emission_value_type
694!
695!-- Offline nesting data type
696    TYPE salsa_nest_offl_type
697
698       CHARACTER(LEN=16) ::  char_l = 'ls_forcing_left_'  !< leading substring at left boundary
699       CHARACTER(LEN=17) ::  char_n = 'ls_forcing_north_' !< leading substring at north boundary
700       CHARACTER(LEN=17) ::  char_r = 'ls_forcing_right_' !< leading substring at right boundary
701       CHARACTER(LEN=17) ::  char_s = 'ls_forcing_south_' !< leading substring at south boundary
702       CHARACTER(LEN=15) ::  char_t = 'ls_forcing_top_'   !< leading substring at top boundary
703
704       CHARACTER(LEN=5), DIMENSION(1:ngases_salsa) ::  gas_name = (/'H2SO4','HNO3 ','NH3  ','OCNV ','OCSV '/)
705
706       CHARACTER(LEN=25),  DIMENSION(:), ALLOCATABLE ::  cc_name    !< chemical component name
707       CHARACTER(LEN=100), DIMENSION(:), ALLOCATABLE ::  var_names  !< list of variable names
708
709       INTEGER(iwp) ::  id_dynamic  !< NetCDF id of dynamic input file
710       INTEGER(iwp) ::  ncc         !< number of aerosol chemical components
711       INTEGER(iwp) ::  nt          !< number of time levels in dynamic input file
712       INTEGER(iwp) ::  nzu         !< number of vertical levels on scalar grid in dynamic input file
713       INTEGER(iwp) ::  tind        !< time index for reference time in mesoscale-offline nesting
714       INTEGER(iwp) ::  tind_p      !< time index for following time in mesoscale-offline nesting
715
716       INTEGER(iwp), DIMENSION(maxspec) ::  cc_in2mod = 0  !< to transfer chemical composition from input to model
717
718       LOGICAL ::  init  = .FALSE. !< flag indicating the initialisation of offline nesting
719
720       REAL(wp), DIMENSION(:), ALLOCATABLE ::  dmid      !< vertical profile of aerosol bin diameters
721       REAL(wp), DIMENSION(:), ALLOCATABLE ::  time      !< time in dynamic input file
722       REAL(wp), DIMENSION(:), ALLOCATABLE ::  zu_atmos  !< zu in dynamic input file
723
724       REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE ::  gconc_left   !< gas conc. at left boundary
725       REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE ::  gconc_north  !< gas conc. at north boundary
726       REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE ::  gconc_right  !< gas conc. at right boundary
727       REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE ::  gconc_south  !< gas conc. at south boundary
728       REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE ::  gconc_top    !< gas conc.at top boundary
729       REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE ::  mconc_left   !< aerosol mass conc. at left boundary
730       REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE ::  mconc_north  !< aerosol mass conc. at north boundary
731       REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE ::  mconc_right  !< aerosol mass conc. at right boundary
732       REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE ::  mconc_south  !< aerosol mass conc. at south boundary
733       REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE ::  mconc_top    !< aerosol mass conc. at top boundary
734       REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE ::  nconc_left   !< aerosol number conc. at left boundary
735       REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE ::  nconc_north  !< aerosol number conc. at north boundary
736       REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE ::  nconc_right  !< aerosol number conc. at right boundary
737       REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE ::  nconc_south  !< aerosol number conc. at south boundary
738       REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE ::  nconc_top    !< aerosol number conc. at top boundary
739
740    END TYPE salsa_nest_offl_type
741!
742!-- Prognostic variable: Aerosol size bin information (number (#/m3) and mass (kg/m3) concentration)
743!-- and the concentration of gaseous tracers (#/m3). Gas tracers are contained sequentially in
744!-- dimension 4 as:
745!-- 1. H2SO4, 2. HNO3, 3. NH3, 4. OCNV (non-volatile organics), 5. OCSV (semi-volatile)
746    TYPE salsa_variable
747
748       REAL(wp), DIMENSION(:), ALLOCATABLE     ::  init  !<
749
750       REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  diss_s     !<
751       REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  flux_s     !<
752       REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  source     !<
753       REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  sums_ws_l  !<
754
755       REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  diss_l  !<
756       REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  flux_l  !<
757
758       REAL(wp), DIMENSION(:,:,:), POINTER, CONTIGUOUS ::  conc     !<
759       REAL(wp), DIMENSION(:,:,:), POINTER, CONTIGUOUS ::  conc_p   !<
760       REAL(wp), DIMENSION(:,:,:), POINTER, CONTIGUOUS ::  tconc_m  !<
761
762    END TYPE salsa_variable
763!
764!-- Datatype used to store information about the binned size distributions of aerosols
765    TYPE t_section
766
767       REAL(wp) ::  dmid     !< bin middle diameter (m)
768       REAL(wp) ::  vhilim   !< bin volume at the high limit
769       REAL(wp) ::  vlolim   !< bin volume at the low limit
770       REAL(wp) ::  vratiohi !< volume ratio between the center and high limit
771       REAL(wp) ::  vratiolo !< volume ratio between the center and low limit
772       !******************************************************
773       ! ^ Do NOT change the stuff above after initialization !
774       !******************************************************
775       REAL(wp) ::  core    !< Volume of dry particle
776       REAL(wp) ::  dwet    !< Wet diameter or mean droplet diameter (m)
777       REAL(wp) ::  numc    !< Number concentration of particles/droplets (#/m3)
778       REAL(wp) ::  veqh2o  !< Equilibrium H2O concentration for each particle
779
780       REAL(wp), DIMENSION(maxspec+1) ::  volc !< Volume concentrations (m^3/m^3) of aerosols +
781                                               !< water. Since most of the stuff in SALSA is hard
782                                               !< coded, these *have to be* in the order
783                                               !< 1:SO4, 2:OC, 3:BC, 4:DU, 5:SS, 6:NO, 7:NH, 8:H2O
784    END TYPE t_section
785
786    TYPE(salsa_emission_attribute_type) ::  aero_emission_att  !< emission attributes
787    TYPE(salsa_emission_value_type)     ::  aero_emission      !< emission values
788    TYPE(salsa_emission_mode_type)      ::  def_modes          !< default emission modes
789
790    TYPE(chem_emis_att_type) ::  chem_emission_att  !< chemistry emission attributes
791
792    TYPE(chem_emis_val_type), DIMENSION(:), ALLOCATABLE ::  chem_emission  !< chemistry emissions
793
794    TYPE(t_section), DIMENSION(:), ALLOCATABLE ::  aero  !< local aerosol properties
795
796    TYPE(match_surface) ::  lsm_to_depo_h  !< to match the deposition module and horizontal LSM surfaces
797    TYPE(match_surface) ::  usm_to_depo_h  !< to match the deposition module and horizontal USM surfaces
798
799    TYPE(match_surface), DIMENSION(0:3) ::  lsm_to_depo_v  !< to match the deposition mod. and vertical LSM surfaces
800    TYPE(match_surface), DIMENSION(0:3) ::  usm_to_depo_v  !< to match the deposition mod. and vertical USM surfaces
801!
802!-- SALSA variables: as x = x(k,j,i,bin).
803!-- The 4th dimension contains all the size bins sequentially for each aerosol species  + water.
804!
805!-- Prognostic variables:
806!
807!-- Number concentration (#/m3)
808    TYPE(salsa_variable), DIMENSION(:), ALLOCATABLE, TARGET ::  aerosol_number  !<
809    REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE, TARGET ::  nconc_1  !<
810    REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE, TARGET ::  nconc_2  !<
811    REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE, TARGET ::  nconc_3  !<
812!
813!-- Mass concentration (kg/m3)
814    TYPE(salsa_variable), DIMENSION(:), ALLOCATABLE, TARGET ::  aerosol_mass  !<
815    REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE, TARGET ::  mconc_1  !<
816    REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE, TARGET ::  mconc_2  !<
817    REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE, TARGET ::  mconc_3  !<
818!
819!-- Gaseous concentrations (#/m3)
820    TYPE(salsa_variable), DIMENSION(:), ALLOCATABLE, TARGET ::  salsa_gas  !<
821    REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE, TARGET ::  gconc_1  !<
822    REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE, TARGET ::  gconc_2  !<
823    REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE, TARGET ::  gconc_3  !<
824!
825!-- Diagnostic tracers
826    REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE ::  sedim_vd  !< sedimentation velocity per bin (m/s)
827    REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE ::  ra_dry    !< aerosol dry radius (m)
828
829!-- Particle component index tables
830    TYPE(component_index) :: prtcl  !< Contains "getIndex" which gives the index for a given aerosol
831                                    !< component name: 1:SO4, 2:OC, 3:BC, 4:DU, 5:SS, 6:NO, 7:NH, 8:H2O
832!
833!-- Offline nesting:
834    TYPE(salsa_nest_offl_type) ::  salsa_nest_offl  !< data structure for offline nesting
835!
836!-- Data output arrays:
837!
838!-- Integrated:
839    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  ldsa_av  !< lung-deposited surface area
840    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  ntot_av  !< total number concentration
841    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  nufp_av  !< ultrafine particles (UFP)
842    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  pm01_av  !< PM0.1
843    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  pm25_av  !< PM2.5
844    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  pm10_av  !< PM10
845!
846!-- Bin specific mass and number concentrations:
847    REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE, TARGET ::  mbins_av  !< bin mas
848    REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE, TARGET ::  nbins_av  !< bin number
849!
850!-- Gases:
851    REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE, TARGET ::  salsa_gases_av  !< gases
852!
853!-- In the particle phase:
854    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  s_h2o_av  !< liquid water
855    REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE, TARGET ::  s_mass_av  !< mass components
856
857!
858!-- PALM interfaces:
859
860    INTERFACE salsa_actions
861       MODULE PROCEDURE salsa_actions
862       MODULE PROCEDURE salsa_actions_ij
863    END INTERFACE salsa_actions
864
865    INTERFACE salsa_3d_data_averaging
866       MODULE PROCEDURE salsa_3d_data_averaging
867    END INTERFACE salsa_3d_data_averaging
868
869    INTERFACE salsa_boundary_conds
870       MODULE PROCEDURE salsa_boundary_conds
871       MODULE PROCEDURE salsa_boundary_conds_decycle
872    END INTERFACE salsa_boundary_conds
873
874    INTERFACE salsa_boundary_conditions
875       MODULE PROCEDURE salsa_boundary_conditions
876    END INTERFACE salsa_boundary_conditions
877
878    INTERFACE salsa_check_data_output
879       MODULE PROCEDURE salsa_check_data_output
880    END INTERFACE salsa_check_data_output
881
882    INTERFACE salsa_check_data_output_pr
883       MODULE PROCEDURE salsa_check_data_output_pr
884    END INTERFACE salsa_check_data_output_pr
885
886    INTERFACE salsa_check_parameters
887       MODULE PROCEDURE salsa_check_parameters
888    END INTERFACE salsa_check_parameters
889
890    INTERFACE salsa_data_output_2d
891       MODULE PROCEDURE salsa_data_output_2d
892    END INTERFACE salsa_data_output_2d
893
894    INTERFACE salsa_data_output_3d
895       MODULE PROCEDURE salsa_data_output_3d
896    END INTERFACE salsa_data_output_3d
897
898    INTERFACE salsa_data_output_mask
899       MODULE PROCEDURE salsa_data_output_mask
900    END INTERFACE salsa_data_output_mask
901
902    INTERFACE salsa_define_netcdf_grid
903       MODULE PROCEDURE salsa_define_netcdf_grid
904    END INTERFACE salsa_define_netcdf_grid
905
906    INTERFACE salsa_emission_update
907       MODULE PROCEDURE salsa_emission_update
908    END INTERFACE salsa_emission_update
909
910    INTERFACE salsa_exchange_horiz_bounds
911       MODULE PROCEDURE salsa_exchange_horiz_bounds
912    END INTERFACE salsa_exchange_horiz_bounds
913
914    INTERFACE salsa_header
915       MODULE PROCEDURE salsa_header
916    END INTERFACE salsa_header
917
918    INTERFACE salsa_init
919       MODULE PROCEDURE salsa_init
920    END INTERFACE salsa_init
921
922    INTERFACE salsa_init_arrays
923       MODULE PROCEDURE salsa_init_arrays
924    END INTERFACE salsa_init_arrays
925
926    INTERFACE salsa_nesting_offl_bc
927       MODULE PROCEDURE salsa_nesting_offl_bc
928    END INTERFACE salsa_nesting_offl_bc
929
930    INTERFACE salsa_nesting_offl_init
931       MODULE PROCEDURE salsa_nesting_offl_init
932    END INTERFACE salsa_nesting_offl_init
933
934    INTERFACE salsa_nesting_offl_input
935       MODULE PROCEDURE salsa_nesting_offl_input
936    END INTERFACE salsa_nesting_offl_input
937
938    INTERFACE salsa_non_advective_processes
939       MODULE PROCEDURE salsa_non_advective_processes
940       MODULE PROCEDURE salsa_non_advective_processes_ij
941    END INTERFACE salsa_non_advective_processes
942
943    INTERFACE salsa_parin
944       MODULE PROCEDURE salsa_parin
945    END INTERFACE salsa_parin
946
947    INTERFACE salsa_prognostic_equations
948       MODULE PROCEDURE salsa_prognostic_equations
949       MODULE PROCEDURE salsa_prognostic_equations_ij
950    END INTERFACE salsa_prognostic_equations
951
952    INTERFACE salsa_rrd_local
953       MODULE PROCEDURE salsa_rrd_local
954    END INTERFACE salsa_rrd_local
955
956    INTERFACE salsa_statistics
957       MODULE PROCEDURE salsa_statistics
958    END INTERFACE salsa_statistics
959
960    INTERFACE salsa_swap_timelevel
961       MODULE PROCEDURE salsa_swap_timelevel
962    END INTERFACE salsa_swap_timelevel
963
964    INTERFACE salsa_tendency
965       MODULE PROCEDURE salsa_tendency
966       MODULE PROCEDURE salsa_tendency_ij
967    END INTERFACE salsa_tendency
968
969    INTERFACE salsa_wrd_local
970       MODULE PROCEDURE salsa_wrd_local
971    END INTERFACE salsa_wrd_local
972
973
974    SAVE
975
976    PRIVATE
977!
978!-- Public functions:
979    PUBLIC salsa_3d_data_averaging,       &
980           salsa_actions,                 &
981           salsa_boundary_conds,          &
982           salsa_boundary_conditions,     &
983           salsa_check_data_output,       &
984           salsa_check_data_output_pr,    &
985           salsa_check_parameters,        &
986           salsa_data_output_2d,          &
987           salsa_data_output_3d,          &
988           salsa_data_output_mask,        &
989           salsa_define_netcdf_grid,      &
990           salsa_diagnostics,             &
991           salsa_emission_update,         &
992           salsa_exchange_horiz_bounds,   &
993           salsa_header,                  &
994           salsa_init,                    &
995           salsa_init_arrays,             &
996           salsa_nesting_offl_bc,         &
997           salsa_nesting_offl_init,       &
998           salsa_nesting_offl_input,      &
999           salsa_non_advective_processes, &
1000           salsa_parin,                   &
1001           salsa_prognostic_equations,    &
1002           salsa_rrd_local,               &
1003           salsa_statistics,              &
1004           salsa_swap_timelevel,          &
1005           salsa_wrd_local
1006
1007!
1008!-- Public parameters, constants and initial values
1009    PUBLIC bc_am_t_val,           &
1010           bc_an_t_val,           &
1011           bc_gt_t_val,           &
1012           ibc_salsa_b,           &
1013           init_aerosol_type,     &
1014           init_gases_type,       &
1015           nesting_salsa,         &
1016           nesting_offline_salsa, &
1017           salsa_gases_from_chem, &
1018           skip_time_do_salsa
1019!
1020!-- Public variables
1021    PUBLIC aerosol_mass,     &
1022           aerosol_number,   &
1023           gconc_2,          &
1024           mconc_2,          &
1025           nbins_aerosol,    &
1026           ncomponents_mass, &
1027           nconc_2,          &
1028           ngases_salsa,     &
1029           salsa_gas,        &
1030           salsa_nest_offl
1031
1032
1033 CONTAINS
1034
1035!------------------------------------------------------------------------------!
1036! Description:
1037! ------------
1038!> Parin for &salsa_par for new modules
1039!------------------------------------------------------------------------------!
1040 SUBROUTINE salsa_parin
1041
1042    USE control_parameters,                                                                        &
1043        ONLY:  data_output_pr
1044
1045    IMPLICIT NONE
1046
1047    CHARACTER(LEN=80) ::  line   !< dummy string that contains the current line of parameter file
1048
1049    INTEGER(iwp) ::  i                 !< loop index
1050    INTEGER(iwp) ::  max_pr_salsa_tmp  !< dummy variable
1051
1052    NAMELIST /salsa_parameters/      aerosol_flux_dpg,                         &
1053                                     aerosol_flux_mass_fracs_a,                &
1054                                     aerosol_flux_mass_fracs_b,                &
1055                                     aerosol_flux_sigmag,                      &
1056                                     advect_particle_water,                    &
1057                                     bc_salsa_b,                               &
1058                                     bc_salsa_t,                               &
1059                                     decycle_salsa_lr,                         &
1060                                     decycle_method_salsa,                     &
1061                                     decycle_salsa_ns,                         &
1062                                     depo_pcm_par,                             &
1063                                     depo_pcm_type,                            &
1064                                     depo_surf_par,                            &
1065                                     dpg,                                      &
1066                                     dt_salsa,                                 &
1067                                     emiss_factor_main,                        &
1068                                     emiss_factor_side,                        &
1069                                     feedback_to_palm,                         &
1070                                     h2so4_init,                               &
1071                                     hno3_init,                                &
1072                                     listspec,                                 &
1073                                     main_street_id,                           &
1074                                     mass_fracs_a,                             &
1075                                     mass_fracs_b,                             &
1076                                     max_street_id,                            &
1077                                     n_lognorm,                                &
1078                                     nbin,                                     &
1079                                     nesting_salsa,                            &
1080                                     nesting_offline_salsa,                    &
1081                                     nf2a,                                     &
1082                                     nh3_init,                                 &
1083                                     nj3,                                      &
1084                                     nlcnd,                                    &
1085                                     nlcndgas,                                 &
1086                                     nlcndh2oae,                               &
1087                                     nlcoag,                                   &
1088                                     nldepo,                                   &
1089                                     nldepo_pcm,                               &
1090                                     nldepo_surf,                              &
1091                                     nldistupdate,                             &
1092                                     nsnucl,                                   &
1093                                     ocnv_init,                                &
1094                                     ocsv_init,                                &
1095                                     read_restart_data_salsa,                  &
1096                                     reglim,                                   &
1097                                     salsa,                                    &
1098                                     salsa_emission_mode,                      &
1099                                     season_z01,                               &
1100                                     sigmag,                                   &
1101                                     side_street_id,                           &
1102                                     skip_time_do_salsa,                       &
1103                                     surface_aerosol_flux,                     &
1104                                     van_der_waals_coagc,                      &
1105                                     write_binary_salsa
1106
1107    line = ' '
1108!
1109!-- Try to find salsa package
1110    REWIND ( 11 )
1111    line = ' '
1112    DO WHILE ( INDEX( line, '&salsa_parameters' ) == 0 )
1113       READ ( 11, '(A)', END=10 )  line
1114    ENDDO
1115    BACKSPACE ( 11 )
1116!
1117!-- Read user-defined namelist
1118    READ ( 11, salsa_parameters )
1119!
1120!-- Enable salsa (salsa switch in modules.f90)
1121    salsa = .TRUE.
1122
1123 10 CONTINUE
1124!
1125!-- Update the number of output profiles
1126    max_pr_salsa_tmp = 0
1127    i = 1
1128    DO WHILE ( data_output_pr(i) /= ' '  .AND.  i <= 100 )
1129       IF ( TRIM( data_output_pr(i)(1:6) ) == 'salsa_' )  max_pr_salsa_tmp = max_pr_salsa_tmp + 1
1130       i = i + 1
1131    ENDDO
1132    IF ( max_pr_salsa_tmp > 0 )  max_pr_salsa = max_pr_salsa_tmp
1133
1134 END SUBROUTINE salsa_parin
1135
1136!------------------------------------------------------------------------------!
1137! Description:
1138! ------------
1139!> Check parameters routine for salsa.
1140!------------------------------------------------------------------------------!
1141 SUBROUTINE salsa_check_parameters
1142
1143    USE control_parameters,                                                                        &
1144        ONLY:  child_domain, humidity, initializing_actions, nesting_offline
1145
1146    IMPLICIT NONE
1147
1148!
1149!-- Check that humidity is switched on
1150    IF ( salsa  .AND.  .NOT.  humidity )  THEN
1151       WRITE( message_string, * ) 'salsa = ', salsa, ' is not allowed with humidity = ', humidity
1152       CALL message( 'salsa_check_parameters', 'PA0594', 1, 2, 0, 6, 0 )
1153    ENDIF
1154!
1155!-- For nested runs, explicitly set nesting boundary conditions.
1156    IF ( child_domain )  THEN
1157       IF ( nesting_salsa )  THEN
1158          bc_salsa_t = 'nested'
1159       ELSE
1160          bc_salsa_t = 'neumann'
1161       ENDIF
1162    ENDIF
1163!
1164!-- Set boundary conditions also in case the model is offline-nested in larger-scale models.
1165    IF ( nesting_offline )  THEN
1166       IF ( nesting_offline_salsa )  THEN
1167          bc_salsa_t = 'nesting_offline'
1168       ELSE
1169          bc_salsa_t = 'neumann'
1170       ENDIF
1171    ENDIF
1172!
1173!-- Set bottom boundary condition flag
1174    IF ( bc_salsa_b == 'dirichlet' )  THEN
1175       ibc_salsa_b = 0
1176    ELSEIF ( bc_salsa_b == 'neumann' )  THEN
1177       ibc_salsa_b = 1
1178    ELSE
1179       message_string = 'unknown boundary condition: bc_salsa_b = "' // TRIM( bc_salsa_t ) // '"'
1180       CALL message( 'salsa_check_parameters', 'PA0595', 1, 2, 0, 6, 0 )
1181    ENDIF
1182!
1183!-- Set top boundary conditions flag
1184    IF ( bc_salsa_t == 'dirichlet' )  THEN
1185       ibc_salsa_t = 0
1186    ELSEIF ( bc_salsa_t == 'neumann' )  THEN
1187       ibc_salsa_t = 1
1188    ELSEIF ( bc_salsa_t == 'initial_gradient' )  THEN
1189       ibc_salsa_t = 2
1190    ELSEIF ( bc_salsa_t == 'nested'  .OR.  bc_salsa_t == 'nesting_offline' )  THEN
1191       ibc_salsa_t = 3
1192    ELSE
1193       message_string = 'unknown boundary condition: bc_salsa_t = "' // TRIM( bc_salsa_t ) // '"'
1194       CALL message( 'salsa_check_parameters', 'PA0596', 1, 2, 0, 6, 0 )
1195    ENDIF
1196!
1197!-- Check J3 parametrisation
1198    IF ( nj3 < 1  .OR.  nj3 > 3 )  THEN
1199       message_string = 'unknown nj3 (must be 1-3)'
1200       CALL message( 'salsa_check_parameters', 'PA0597', 1, 2, 0, 6, 0 )
1201    ENDIF
1202!
1203!-- Check bottom boundary condition in case of surface emissions
1204    IF ( salsa_emission_mode /= 'no_emission'  .AND.  ibc_salsa_b  == 0 ) THEN
1205       message_string = 'salsa_emission_mode /= "no_emission" requires bc_salsa_b = "Neumann"'
1206       CALL message( 'salsa_check_parameters','PA0598', 1, 2, 0, 6, 0 )
1207    ENDIF
1208!
1209!-- Check whether emissions are applied
1210    IF ( salsa_emission_mode /= 'no_emission' )  include_emission = .TRUE.
1211!
1212!-- Set the initialisation type: background concentration are read from PIDS_DYNAMIC if
1213!-- initializing_actions = 'inifor set_constant_profiles'
1214    IF ( INDEX( initializing_actions, 'inifor' ) /= 0 )  THEN
1215       init_aerosol_type = 1
1216       init_gases_type = 1
1217    ENDIF
1218!
1219!-- If the run is not a restart run, set read_restart_data to .FALSE.
1220    IF ( TRIM( initializing_actions ) /= 'read_restart_data' )  THEN
1221       read_restart_data_salsa = .FALSE.
1222    ENDIF
1223
1224 END SUBROUTINE salsa_check_parameters
1225
1226!------------------------------------------------------------------------------!
1227!
1228! Description:
1229! ------------
1230!> Subroutine defining appropriate grid for netcdf variables.
1231!> It is called out from subroutine netcdf.
1232!> Same grid as for other scalars (see netcdf_interface_mod.f90)
1233!------------------------------------------------------------------------------!
1234 SUBROUTINE salsa_define_netcdf_grid( var, found, grid_x, grid_y, grid_z )
1235
1236    IMPLICIT NONE
1237
1238    CHARACTER(LEN=*), INTENT(OUT) ::  grid_x   !<
1239    CHARACTER(LEN=*), INTENT(OUT) ::  grid_y   !<
1240    CHARACTER(LEN=*), INTENT(OUT) ::  grid_z   !<
1241    CHARACTER(LEN=*), INTENT(IN)  ::  var      !<
1242
1243    LOGICAL, INTENT(OUT) ::  found   !<
1244
1245    found  = .TRUE.
1246!
1247!-- Check for the grid
1248
1249    IF ( var(1:6) == 'salsa_' )  THEN  ! same grid for all salsa output variables
1250       grid_x = 'x'
1251       grid_y = 'y'
1252       grid_z = 'zu'
1253    ELSE
1254       found  = .FALSE.
1255       grid_x = 'none'
1256       grid_y = 'none'
1257       grid_z = 'none'
1258    ENDIF
1259
1260 END SUBROUTINE salsa_define_netcdf_grid
1261
1262!------------------------------------------------------------------------------!
1263! Description:
1264! ------------
1265!> Header output for new module
1266!------------------------------------------------------------------------------!
1267 SUBROUTINE salsa_header( io )
1268
1269    USE indices,                                                                                   &
1270        ONLY:  nx, ny, nz
1271
1272    IMPLICIT NONE
1273 
1274    INTEGER(iwp), INTENT(IN) ::  io   !< Unit of the output file
1275!
1276!-- Write SALSA header
1277    WRITE( io, 1 )
1278    WRITE( io, 2 ) skip_time_do_salsa
1279    WRITE( io, 3 ) dt_salsa
1280    WRITE( io, 4 )  nz, ny, nx, nbins_aerosol
1281    IF ( advect_particle_water )  THEN
1282       WRITE( io, 5 )  nz, ny, nx, ncomponents_mass*nbins_aerosol, advect_particle_water
1283    ELSE
1284       WRITE( io, 5 )  nz, ny, nx, ncc*nbins_aerosol, advect_particle_water
1285    ENDIF
1286    IF ( .NOT. salsa_gases_from_chem )  THEN
1287       WRITE( io, 6 )  nz, ny, nx, ngases_salsa, salsa_gases_from_chem
1288    ENDIF
1289    WRITE( io, 7 )
1290    IF ( nsnucl > 0 )   WRITE( io, 8 ) nsnucl, nj3
1291    IF ( nlcoag )       WRITE( io, 9 )
1292    IF ( nlcnd )        WRITE( io, 10 ) nlcndgas, nlcndh2oae
1293    IF ( lspartition )  WRITE( io, 11 )
1294    IF ( nldepo )       WRITE( io, 12 ) nldepo_pcm, nldepo_surf
1295    WRITE( io, 13 )  reglim, nbin, ( aero(:)%vlolim / api6 )**0.33333333_wp
1296    WRITE( io, 25 )  aero(:)%dmid
1297    IF ( init_aerosol_type == 0 )  WRITE( io, 14 ) nsect
1298    WRITE( io, 15 ) ncc, listspec, mass_fracs_a, mass_fracs_b
1299    IF ( .NOT. salsa_gases_from_chem )  THEN
1300       WRITE( io, 16 ) ngases_salsa, h2so4_init, hno3_init, nh3_init, ocnv_init, ocsv_init
1301    ENDIF
1302    WRITE( io, 17 )  init_aerosol_type, init_gases_type
1303    IF ( init_aerosol_type == 0 )  THEN
1304       WRITE( io, 18 )  dpg, sigmag, n_lognorm
1305    ELSE
1306       WRITE( io, 19 )
1307    ENDIF
1308    IF ( nesting_salsa )  WRITE( io, 20 )  nesting_salsa
1309    IF ( nesting_offline_salsa )  WRITE( io, 21 )  nesting_offline_salsa
1310    WRITE( io, 22 ) salsa_emission_mode
1311    IF ( salsa_emission_mode == 'uniform' )  THEN
1312       WRITE( io, 23 ) surface_aerosol_flux, aerosol_flux_dpg, aerosol_flux_sigmag,                &
1313                       aerosol_flux_mass_fracs_a
1314    ENDIF
1315    IF ( SUM( aerosol_flux_mass_fracs_b ) > 0.0_wp  .OR. salsa_emission_mode == 'read_from_file' ) &
1316    THEN
1317       WRITE( io, 24 )
1318    ENDIF
1319
13201   FORMAT (//' SALSA information:'/                                                               &
1321              ' ------------------------------'/)
13222   FORMAT   ('    Starts at: skip_time_do_salsa = ', F10.2, '  s')
13233   FORMAT  (/'    Timestep: dt_salsa = ', F6.2, '  s')
13244   FORMAT  (/'    Array shape (z,y,x,bins):'/                                                     &
1325              '       aerosol_number:  ', 4(I5)) 
13265   FORMAT  (/'       aerosol_mass:    ', 4(I5),/                                                  &
1327              '       (advect_particle_water = ', L1, ')')
13286   FORMAT   ('       salsa_gas: ', 4(I5),/                                                        &
1329              '       (salsa_gases_from_chem = ', L1, ')')
13307   FORMAT  (/'    Aerosol dynamic processes included: ')
13318   FORMAT  (/'       nucleation (scheme = ', I1, ' and J3 parametrization = ', I1, ')')
13329   FORMAT  (/'       coagulation')
133310  FORMAT  (/'       condensation (of precursor gases = ', L1, ' and water vapour = ', L1, ')' )
133411  FORMAT  (/'       dissolutional growth by HNO3 and NH3')
133512  FORMAT  (/'       dry deposition (on vegetation = ', L1, ' and on topography = ', L1, ')')
133613  FORMAT  (/'    Aerosol bin subrange limits (in metres): ',  3(ES10.2E3), /                     &
1337              '    Number of size bins for each aerosol subrange: ', 2I3,/                         &
1338              '    Aerosol bin lower limits (in metres): ', 12(ES10.2E3))
133925  FORMAT  (/'    Bin geometric mean diameters (in metres): ', 12(ES10.2E3))
134014  FORMAT   ('    Initial number concentration in bins at the lowest level (#/m**3):', 9(ES10.2E3))
134115  FORMAT  (/'    Number of chemical components used: ', I1,/                                     &
1342              '       Species: ',7(A6),/                                                           &
1343              '    Initial relative contribution of each species to particle volume in:',/         &
1344              '       a-bins: ', 7(F6.3),/                                                         &
1345              '       b-bins: ', 7(F6.3))
134616  FORMAT  (/'    Number of gaseous tracers used: ', I1,/                                         &
1347              '    Initial gas concentrations:',/                                                  &
1348              '       H2SO4: ',ES12.4E3, ' #/m**3',/                                               &
1349              '       HNO3:  ',ES12.4E3, ' #/m**3',/                                               &
1350              '       NH3:   ',ES12.4E3, ' #/m**3',/                                               &
1351              '       OCNV:  ',ES12.4E3, ' #/m**3',/                                               &
1352              '       OCSV:  ',ES12.4E3, ' #/m**3')
135317   FORMAT (/'   Initialising concentrations: ', /                                                &
1354              '      Aerosol size distribution: init_aerosol_type = ', I1,/                        &
1355              '      Gas concentrations: init_gases_type = ', I1 )
135618   FORMAT ( '      Mode diametres: dpg(nmod) = ', 7(F7.3), ' (m)', /                             &
1357              '      Standard deviation: sigmag(nmod) = ', 7(F7.2),/                               &
1358              '      Number concentration: n_lognorm(nmod) = ', 7(ES12.4E3), ' (#/m3)' )
135919   FORMAT (/'      Size distribution read from a file.')
136020   FORMAT (/'   Nesting for salsa variables: ', L1 )
136121   FORMAT (/'   Offline nesting for salsa variables: ', L1 )
136222   FORMAT (/'   Emissions: salsa_emission_mode = ', A )
136323   FORMAT (/'      surface_aerosol_flux = ', ES12.4E3, ' #/m**2/s', /                            &
1364              '      aerosol_flux_dpg     =  ', 7(F7.3), ' (m)', /                                 &
1365              '      aerosol_flux_sigmag  =  ', 7(F7.2), /                                         &
1366              '      aerosol_mass_fracs_a =  ', 7(ES12.4E3) )
136724   FORMAT (/'      (currently all emissions are soluble!)')
1368
1369 END SUBROUTINE salsa_header
1370
1371!------------------------------------------------------------------------------!
1372! Description:
1373! ------------
1374!> Allocate SALSA arrays and define pointers if required
1375!------------------------------------------------------------------------------!
1376 SUBROUTINE salsa_init_arrays
1377
1378    USE advec_ws,                                                                                  &
1379        ONLY: ws_init_flags_scalar
1380
1381    USE surface_mod,                                                                               &
1382        ONLY:  surf_def_h, surf_def_v, surf_lsm_h, surf_lsm_v, surf_usm_h, surf_usm_v
1383
1384    IMPLICIT NONE
1385
1386    INTEGER(iwp) ::  gases_available !< Number of available gas components in the chemistry model
1387    INTEGER(iwp) ::  i               !< loop index for allocating
1388    INTEGER(iwp) ::  ii              !< index for indexing chemical components
1389    INTEGER(iwp) ::  l               !< loop index for allocating: surfaces
1390    INTEGER(iwp) ::  lsp             !< loop index for chem species in the chemistry model
1391
1392    gases_available = 0
1393!
1394!-- Allocate prognostic variables (see salsa_swap_timelevel)
1395!
1396!-- Set derived indices:
1397!-- (This does the same as the subroutine salsa_initialize in SALSA/UCLALES-SALSA)
1398    start_subrange_1a = 1  ! 1st index of subrange 1a
1399    start_subrange_2a = start_subrange_1a + nbin(1)  ! 1st index of subrange 2a
1400    end_subrange_1a   = start_subrange_2a - 1        ! last index of subrange 1a
1401    end_subrange_2a   = end_subrange_1a + nbin(2)    ! last index of subrange 2a
1402
1403!
1404!-- If the fraction of insoluble aerosols in subrange 2 is zero: do not allocate arrays for them
1405    IF ( nf2a > 0.999999_wp  .AND.  SUM( mass_fracs_b ) < 0.00001_wp )  THEN
1406       no_insoluble = .TRUE.
1407       start_subrange_2b = end_subrange_2a+1  ! 1st index of subrange 2b
1408       end_subrange_2b   = end_subrange_2a    ! last index of subrange 2b
1409    ELSE
1410       start_subrange_2b = start_subrange_2a + nbin(2)  ! 1st index of subrange 2b
1411       end_subrange_2b   = end_subrange_2a + nbin(2)    ! last index of subrange 2b
1412    ENDIF
1413
1414    nbins_aerosol = end_subrange_2b   ! total number of aerosol size bins
1415!
1416!-- Create index tables for different aerosol components
1417    CALL component_index_constructor( prtcl, ncc, maxspec, listspec )
1418
1419    ncomponents_mass = ncc
1420    IF ( advect_particle_water )  ncomponents_mass = ncc + 1  ! Add water
1421!
1422!-- Indices for chemical components used (-1 = not used)
1423    ii = 0
1424    IF ( is_used( prtcl, 'SO4' ) )  THEN
1425       index_so4 = get_index( prtcl,'SO4' )
1426       ii = ii + 1
1427    ENDIF
1428    IF ( is_used( prtcl,'OC' ) )  THEN
1429       index_oc = get_index(prtcl, 'OC')
1430       ii = ii + 1
1431    ENDIF
1432    IF ( is_used( prtcl, 'BC' ) )  THEN
1433       index_bc = get_index( prtcl, 'BC' )
1434       ii = ii + 1
1435    ENDIF
1436    IF ( is_used( prtcl, 'DU' ) )  THEN
1437       index_du = get_index( prtcl, 'DU' )
1438       ii = ii + 1
1439    ENDIF
1440    IF ( is_used( prtcl, 'SS' ) )  THEN
1441       index_ss = get_index( prtcl, 'SS' )
1442       ii = ii + 1
1443    ENDIF
1444    IF ( is_used( prtcl, 'NO' ) )  THEN
1445       index_no = get_index( prtcl, 'NO' )
1446       ii = ii + 1
1447    ENDIF
1448    IF ( is_used( prtcl, 'NH' ) )  THEN
1449       index_nh = get_index( prtcl, 'NH' )
1450       ii = ii + 1
1451    ENDIF
1452!
1453!-- All species must be known
1454    IF ( ii /= ncc )  THEN
1455       message_string = 'Unknown aerosol species/component(s) given in the initialization'
1456       CALL message( 'salsa_mod: salsa_init', 'PA0600', 1, 2, 0, 6, 0 )
1457    ENDIF
1458!
1459!-- Allocate:
1460    ALLOCATE( aero(nbins_aerosol), bc_am_t_val(nbins_aerosol*ncomponents_mass),                    &
1461              bc_an_t_val(nbins_aerosol), bc_gt_t_val(ngases_salsa), bin_low_limits(nbins_aerosol),&
1462              nsect(nbins_aerosol), massacc(nbins_aerosol) )
1463    ALLOCATE( k_topo_top(nysg:nyng,nxlg:nxrg) )
1464    IF ( nldepo ) ALLOCATE( sedim_vd(nzb:nzt+1,nysg:nyng,nxlg:nxrg,nbins_aerosol) )
1465    ALLOCATE( ra_dry(nzb:nzt+1,nysg:nyng,nxlg:nxrg,nbins_aerosol) )
1466!
1467!-- Initialise the sectional particle size distribution
1468    CALL set_sizebins
1469!
1470!-- Aerosol number concentration
1471    ALLOCATE( aerosol_number(nbins_aerosol) )
1472    ALLOCATE( nconc_1(nzb:nzt+1,nysg:nyng,nxlg:nxrg,nbins_aerosol),                                &
1473              nconc_2(nzb:nzt+1,nysg:nyng,nxlg:nxrg,nbins_aerosol),                                &
1474              nconc_3(nzb:nzt+1,nysg:nyng,nxlg:nxrg,nbins_aerosol) )
1475    nconc_1 = 0.0_wp
1476    nconc_2 = 0.0_wp
1477    nconc_3 = 0.0_wp
1478
1479    DO i = 1, nbins_aerosol
1480       aerosol_number(i)%conc(nzb:nzt+1,nysg:nyng,nxlg:nxrg)    => nconc_1(:,:,:,i)
1481       aerosol_number(i)%conc_p(nzb:nzt+1,nysg:nyng,nxlg:nxrg)  => nconc_2(:,:,:,i)
1482       aerosol_number(i)%tconc_m(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => nconc_3(:,:,:,i)
1483       ALLOCATE( aerosol_number(i)%flux_s(nzb+1:nzt,0:threads_per_task-1),                         &
1484                 aerosol_number(i)%diss_s(nzb+1:nzt,0:threads_per_task-1),                         &
1485                 aerosol_number(i)%flux_l(nzb+1:nzt,nys:nyn,0:threads_per_task-1),                 &
1486                 aerosol_number(i)%diss_l(nzb+1:nzt,nys:nyn,0:threads_per_task-1),                 &
1487                 aerosol_number(i)%init(nzb:nzt+1),                                                &
1488                 aerosol_number(i)%sums_ws_l(nzb:nzt+1,0:threads_per_task-1) )
1489       aerosol_number(i)%init = nclim
1490       IF ( include_emission  .OR.  ( nldepo  .AND.  nldepo_surf ) )  THEN
1491          ALLOCATE( aerosol_number(i)%source(nys:nyn,nxl:nxr) )
1492          aerosol_number(i)%source = 0.0_wp
1493       ENDIF
1494    ENDDO
1495
1496!
1497!-- Aerosol mass concentration
1498    ALLOCATE( aerosol_mass(ncomponents_mass*nbins_aerosol) )
1499    ALLOCATE( mconc_1(nzb:nzt+1,nysg:nyng,nxlg:nxrg,ncomponents_mass*nbins_aerosol),               &
1500              mconc_2(nzb:nzt+1,nysg:nyng,nxlg:nxrg,ncomponents_mass*nbins_aerosol),               &
1501              mconc_3(nzb:nzt+1,nysg:nyng,nxlg:nxrg,ncomponents_mass*nbins_aerosol) )
1502    mconc_1 = 0.0_wp
1503    mconc_2 = 0.0_wp
1504    mconc_3 = 0.0_wp
1505
1506    DO i = 1, ncomponents_mass*nbins_aerosol
1507       aerosol_mass(i)%conc(nzb:nzt+1,nysg:nyng,nxlg:nxrg)    => mconc_1(:,:,:,i)
1508       aerosol_mass(i)%conc_p(nzb:nzt+1,nysg:nyng,nxlg:nxrg)  => mconc_2(:,:,:,i)
1509       aerosol_mass(i)%tconc_m(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => mconc_3(:,:,:,i)
1510       ALLOCATE( aerosol_mass(i)%flux_s(nzb+1:nzt,0:threads_per_task-1),                           &
1511                 aerosol_mass(i)%diss_s(nzb+1:nzt,0:threads_per_task-1),                           &
1512                 aerosol_mass(i)%flux_l(nzb+1:nzt,nys:nyn,0:threads_per_task-1),                   &
1513                 aerosol_mass(i)%diss_l(nzb+1:nzt,nys:nyn,0:threads_per_task-1),                   &
1514                 aerosol_mass(i)%init(nzb:nzt+1),                                                  &
1515                 aerosol_mass(i)%sums_ws_l(nzb:nzt+1,0:threads_per_task-1)  )
1516       aerosol_mass(i)%init = mclim
1517       IF ( include_emission  .OR.  ( nldepo  .AND.  nldepo_surf ) )  THEN
1518          ALLOCATE( aerosol_mass(i)%source(nys:nyn,nxl:nxr) )
1519          aerosol_mass(i)%source = 0.0_wp
1520       ENDIF
1521    ENDDO
1522
1523!
1524!-- Surface fluxes: answs = aerosol number, amsws = aerosol mass
1525!
1526!-- Horizontal surfaces: default type
1527    DO  l = 0, 2   ! upward (l=0), downward (l=1) and model top (l=2)
1528       ALLOCATE( surf_def_h(l)%answs( 1:surf_def_h(l)%ns, nbins_aerosol ) )
1529       ALLOCATE( surf_def_h(l)%amsws( 1:surf_def_h(l)%ns, nbins_aerosol*ncomponents_mass ) )
1530       surf_def_h(l)%answs = 0.0_wp
1531       surf_def_h(l)%amsws = 0.0_wp
1532    ENDDO
1533!
1534!-- Horizontal surfaces: natural type
1535    ALLOCATE( surf_lsm_h%answs( 1:surf_lsm_h%ns, nbins_aerosol ) )
1536    ALLOCATE( surf_lsm_h%amsws( 1:surf_lsm_h%ns, nbins_aerosol*ncomponents_mass ) )
1537    surf_lsm_h%answs = 0.0_wp
1538    surf_lsm_h%amsws = 0.0_wp
1539!
1540!-- Horizontal surfaces: urban type
1541    ALLOCATE( surf_usm_h%answs( 1:surf_usm_h%ns, nbins_aerosol ) )
1542    ALLOCATE( surf_usm_h%amsws( 1:surf_usm_h%ns, nbins_aerosol*ncomponents_mass ) )
1543    surf_usm_h%answs = 0.0_wp
1544    surf_usm_h%amsws = 0.0_wp
1545
1546!
1547!-- Vertical surfaces: northward (l=0), southward (l=1), eastward (l=2) and westward (l=3) facing
1548    DO  l = 0, 3
1549       ALLOCATE( surf_def_v(l)%answs( 1:surf_def_v(l)%ns, nbins_aerosol ) )
1550       surf_def_v(l)%answs = 0.0_wp
1551       ALLOCATE( surf_def_v(l)%amsws( 1:surf_def_v(l)%ns, nbins_aerosol*ncomponents_mass ) )
1552       surf_def_v(l)%amsws = 0.0_wp
1553
1554       ALLOCATE( surf_lsm_v(l)%answs( 1:surf_lsm_v(l)%ns, nbins_aerosol ) )
1555       surf_lsm_v(l)%answs = 0.0_wp
1556       ALLOCATE( surf_lsm_v(l)%amsws( 1:surf_lsm_v(l)%ns, nbins_aerosol*ncomponents_mass ) )
1557       surf_lsm_v(l)%amsws = 0.0_wp
1558
1559       ALLOCATE( surf_usm_v(l)%answs( 1:surf_usm_v(l)%ns, nbins_aerosol ) )
1560       surf_usm_v(l)%answs = 0.0_wp
1561       ALLOCATE( surf_usm_v(l)%amsws( 1:surf_usm_v(l)%ns, nbins_aerosol*ncomponents_mass ) )
1562       surf_usm_v(l)%amsws = 0.0_wp
1563
1564    ENDDO
1565
1566!
1567!-- Concentration of gaseous tracers (1. SO4, 2. HNO3, 3. NH3, 4. OCNV, 5. OCSV)
1568!-- (number concentration (#/m3) )
1569!
1570!-- If chemistry is on, read gas phase concentrations from there. Otherwise,
1571!-- allocate salsa_gas array.
1572
1573    IF ( air_chemistry )  THEN
1574       DO  lsp = 1, nvar
1575          SELECT CASE ( TRIM( chem_species(lsp)%name ) )
1576             CASE ( 'H2SO4', 'h2so4' )
1577                gases_available = gases_available + 1
1578                gas_index_chem(1) = lsp
1579             CASE ( 'HNO3', 'hno3' )
1580                gases_available = gases_available + 1
1581                gas_index_chem(2) = lsp
1582             CASE ( 'NH3', 'nh3' )
1583                gases_available = gases_available + 1
1584                gas_index_chem(3) = lsp
1585             CASE ( 'OCNV', 'ocnv' )
1586                gases_available = gases_available + 1
1587                gas_index_chem(4) = lsp
1588             CASE ( 'OCSV', 'ocsv' )
1589                gases_available = gases_available + 1
1590                gas_index_chem(5) = lsp
1591          END SELECT
1592       ENDDO
1593
1594       IF ( gases_available == ngases_salsa )  THEN
1595          salsa_gases_from_chem = .TRUE.
1596       ELSE
1597          WRITE( message_string, * ) 'SALSA is run together with chemistry but not all gaseous '// &
1598                                     'components are provided by kpp (H2SO4, HNO3, NH3, OCNV, OCSV)'
1599       CALL message( 'check_parameters', 'PA0599', 1, 2, 0, 6, 0 )
1600       ENDIF
1601
1602    ELSE
1603
1604       ALLOCATE( salsa_gas(ngases_salsa) )
1605       ALLOCATE( gconc_1(nzb:nzt+1,nysg:nyng,nxlg:nxrg,ngases_salsa),                 &
1606                 gconc_2(nzb:nzt+1,nysg:nyng,nxlg:nxrg,ngases_salsa),                 &
1607                 gconc_3(nzb:nzt+1,nysg:nyng,nxlg:nxrg,ngases_salsa) )
1608       gconc_1 = 0.0_wp
1609       gconc_2 = 0.0_wp
1610       gconc_3 = 0.0_wp
1611
1612       DO i = 1, ngases_salsa
1613          salsa_gas(i)%conc(nzb:nzt+1,nysg:nyng,nxlg:nxrg)    => gconc_1(:,:,:,i)
1614          salsa_gas(i)%conc_p(nzb:nzt+1,nysg:nyng,nxlg:nxrg)  => gconc_2(:,:,:,i)
1615          salsa_gas(i)%tconc_m(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => gconc_3(:,:,:,i)
1616          ALLOCATE( salsa_gas(i)%flux_s(nzb+1:nzt,0:threads_per_task-1),       &
1617                    salsa_gas(i)%diss_s(nzb+1:nzt,0:threads_per_task-1),       &
1618                    salsa_gas(i)%flux_l(nzb+1:nzt,nys:nyn,0:threads_per_task-1),&
1619                    salsa_gas(i)%diss_l(nzb+1:nzt,nys:nyn,0:threads_per_task-1),&
1620                    salsa_gas(i)%init(nzb:nzt+1),                              &
1621                    salsa_gas(i)%sums_ws_l(nzb:nzt+1,0:threads_per_task-1) )
1622          salsa_gas(i)%init = nclim
1623          IF ( include_emission )  THEN
1624             ALLOCATE( salsa_gas(i)%source(nys:nys,nxl:nxr) )
1625             salsa_gas(i)%source = 0.0_wp
1626          ENDIF
1627       ENDDO
1628!
1629!--    Surface fluxes: gtsws = gaseous tracer flux
1630!
1631!--    Horizontal surfaces: default type
1632       DO  l = 0, 2   ! upward (l=0), downward (l=1) and model top (l=2)
1633          ALLOCATE( surf_def_h(l)%gtsws( 1:surf_def_h(l)%ns, ngases_salsa ) )
1634          surf_def_h(l)%gtsws = 0.0_wp
1635       ENDDO
1636!--    Horizontal surfaces: natural type
1637       ALLOCATE( surf_lsm_h%gtsws( 1:surf_lsm_h%ns, ngases_salsa ) )
1638       surf_lsm_h%gtsws = 0.0_wp
1639!--    Horizontal surfaces: urban type
1640       ALLOCATE( surf_usm_h%gtsws( 1:surf_usm_h%ns, ngases_salsa ) )
1641       surf_usm_h%gtsws = 0.0_wp
1642!
1643!--    Vertical surfaces: northward (l=0), southward (l=1), eastward (l=2) and
1644!--    westward (l=3) facing
1645       DO  l = 0, 3
1646          ALLOCATE( surf_def_v(l)%gtsws( 1:surf_def_v(l)%ns, ngases_salsa ) )
1647          surf_def_v(l)%gtsws = 0.0_wp
1648          ALLOCATE( surf_lsm_v(l)%gtsws( 1:surf_lsm_v(l)%ns, ngases_salsa ) )
1649          surf_lsm_v(l)%gtsws = 0.0_wp
1650          ALLOCATE( surf_usm_v(l)%gtsws( 1:surf_usm_v(l)%ns, ngases_salsa ) )
1651          surf_usm_v(l)%gtsws = 0.0_wp
1652       ENDDO
1653    ENDIF
1654
1655    IF ( ws_scheme_sca )  THEN
1656
1657       IF ( salsa )  THEN
1658          ALLOCATE( sums_salsa_ws_l(nzb:nzt+1,0:threads_per_task-1) )
1659          sums_salsa_ws_l = 0.0_wp
1660       ENDIF
1661
1662    ENDIF
1663!
1664!-- Set control flags for decycling only at lateral boundary cores. Within the inner cores the
1665!-- decycle flag is set to .FALSE.. Even though it does not affect the setting of chemistry boundary
1666!-- conditions, this flag is used to set advection control flags appropriately.
1667    decycle_salsa_lr = MERGE( decycle_salsa_lr, .FALSE., nxl == 0  .OR.  nxr == nx )
1668    decycle_salsa_ns = MERGE( decycle_salsa_ns, .FALSE., nys == 0  .OR.  nyn == ny )
1669!
1670!-- Decycling can be applied separately for aerosol variables, while wind and other scalars may have
1671!-- cyclic or nested boundary conditions. However, large gradients near the boundaries may produce
1672!-- stationary numerical oscillations near the lateral boundaries when a higher-order scheme is
1673!-- applied near these boundaries. To get rid-off this, set-up additional flags that control the
1674!-- order of the scalar advection scheme near the lateral boundaries for passive scalars with
1675!-- decycling.
1676    IF ( scalar_advec == 'ws-scheme' )  THEN
1677       ALLOCATE( salsa_advc_flags_s(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
1678!
1679!--    In case of decycling, set Neuman boundary conditions for wall_flags_total_0 bit 31 instead of
1680!--    cyclic boundary conditions. Bit 31 is used to identify extended degradation zones (please see
1681!--    the following comment). Note, since several also other modules may access this bit but may
1682!--    have other boundary conditions, the original value of wall_flags_total_0 bit 31 must not be
1683!--    modified. Hence, store the boundary conditions directly on salsa_advc_flags_s.
1684!--    salsa_advc_flags_s will be later overwritten in ws_init_flags_scalar and bit 31 won't be used
1685!--    to control the numerical order.
1686!--    Initialize with flag 31 only.
1687       salsa_advc_flags_s = 0
1688       salsa_advc_flags_s = MERGE( IBSET( salsa_advc_flags_s, 31 ), 0, BTEST( wall_flags_total_0, 31 ) )
1689
1690       IF ( decycle_salsa_ns )  THEN
1691          IF ( nys == 0 )  THEN
1692             DO  i = 1, nbgp
1693                salsa_advc_flags_s(:,nys-i,:) = MERGE( IBSET( salsa_advc_flags_s(:,nys,:), 31 ),   &
1694                                                       IBCLR( salsa_advc_flags_s(:,nys,:), 31 ),   &
1695                                                       BTEST( salsa_advc_flags_s(:,nys,:), 31 ) )
1696             ENDDO
1697          ENDIF
1698          IF ( nyn == ny )  THEN
1699             DO  i = 1, nbgp
1700                salsa_advc_flags_s(:,nyn+i,:) = MERGE( IBSET( salsa_advc_flags_s(:,nyn,:), 31 ),   &
1701                                                       IBCLR( salsa_advc_flags_s(:,nyn,:), 31 ),   &
1702                                                       BTEST( salsa_advc_flags_s(:,nyn,:), 31 ) )
1703             ENDDO
1704          ENDIF
1705       ENDIF
1706       IF ( decycle_salsa_lr )  THEN
1707          IF ( nxl == 0 )  THEN
1708             DO  i = 1, nbgp
1709                salsa_advc_flags_s(:,:,nxl-i) = MERGE( IBSET( salsa_advc_flags_s(:,:,nxl), 31 ),   &
1710                                                       IBCLR( salsa_advc_flags_s(:,:,nxl), 31 ),   &
1711                                                       BTEST( salsa_advc_flags_s(:,:,nxl), 31 ) )
1712             ENDDO
1713          ENDIF
1714          IF ( nxr == nx )  THEN
1715             DO  i = 1, nbgp
1716                salsa_advc_flags_s(:,:,nxr+i) = MERGE( IBSET( salsa_advc_flags_s(:,:,nxr), 31 ),   &
1717                                                       IBCLR( salsa_advc_flags_s(:,:,nxr), 31 ),   &
1718                                                       BTEST( salsa_advc_flags_s(:,:,nxr), 31 ) )
1719             ENDDO
1720          ENDIF
1721       ENDIF
1722!
1723!--    To initialise the advection flags appropriately, pass the boundary flags to
1724!--    ws_init_flags_scalar. The last argument in ws_init_flags_scalar indicates that a passive
1725!--    scalar is being treated and the horizontal advection terms are degraded already 2 grid points
1726!--    before the lateral boundary. Also, extended degradation zones are applied, where
1727!--    horizontal advection of scalars is discretised by the first-order scheme at all grid points
1728!--    in the vicinity of buildings (<= 3 grid points). Even though no building is within the
1729!--    numerical stencil, the first-order scheme is used. At fourth and fifth grid points, the order
1730!--    of the horizontal advection scheme is successively upgraded.
1731!--    These degradations of the advection scheme are done to avoid stationary numerical
1732!--    oscillations, which are responsible for high concentration maxima that may appear e.g. under
1733!--    shear-free stable conditions.
1734       CALL ws_init_flags_scalar( bc_dirichlet_l  .OR.  bc_radiation_l  .OR.  decycle_salsa_lr,    &
1735                                  bc_dirichlet_n  .OR.  bc_radiation_n  .OR.  decycle_salsa_ns,    &
1736                                  bc_dirichlet_r  .OR.  bc_radiation_r  .OR.  decycle_salsa_lr,    &
1737                                  bc_dirichlet_s  .OR.  bc_radiation_s  .OR.  decycle_salsa_ns,    &
1738                                  salsa_advc_flags_s, .TRUE. )
1739    ENDIF
1740
1741
1742 END SUBROUTINE salsa_init_arrays
1743
1744!------------------------------------------------------------------------------!
1745! Description:
1746! ------------
1747!> Initialization of SALSA. Based on salsa_initialize in UCLALES-SALSA.
1748!> Subroutines salsa_initialize, SALSAinit and DiagInitAero in UCLALES-SALSA are
1749!> also merged here.
1750!------------------------------------------------------------------------------!
1751 SUBROUTINE salsa_init
1752
1753    IMPLICIT NONE
1754
1755    INTEGER(iwp) :: i   !<
1756    INTEGER(iwp) :: ib  !< loop index for aerosol number bins
1757    INTEGER(iwp) :: ic  !< loop index for aerosol mass bins
1758    INTEGER(iwp) :: ig  !< loop index for gases
1759    INTEGER(iwp) :: j   !<
1760
1761    IF ( debug_output )  CALL debug_message( 'salsa_init', 'start' )
1762
1763    bin_low_limits = 0.0_wp
1764    k_topo_top     = 0
1765    nsect          = 0.0_wp
1766    massacc        = 1.0_wp
1767!
1768!-- Initialise
1769    IF ( nldepo )  sedim_vd = 0.0_wp
1770
1771    IF ( .NOT. salsa_gases_from_chem )  THEN
1772       IF ( .NOT. read_restart_data_salsa )  THEN
1773          salsa_gas(1)%conc = h2so4_init
1774          salsa_gas(2)%conc = hno3_init
1775          salsa_gas(3)%conc = nh3_init
1776          salsa_gas(4)%conc = ocnv_init
1777          salsa_gas(5)%conc = ocsv_init
1778       ENDIF
1779       DO  ig = 1, ngases_salsa
1780          salsa_gas(ig)%conc_p    = 0.0_wp
1781          salsa_gas(ig)%tconc_m   = 0.0_wp
1782          salsa_gas(ig)%flux_s    = 0.0_wp
1783          salsa_gas(ig)%diss_s    = 0.0_wp
1784          salsa_gas(ig)%flux_l    = 0.0_wp
1785          salsa_gas(ig)%diss_l    = 0.0_wp
1786          salsa_gas(ig)%sums_ws_l = 0.0_wp
1787          salsa_gas(ig)%conc_p    = salsa_gas(ig)%conc
1788       ENDDO
1789!
1790!--    Set initial value for gas compound tracer
1791       salsa_gas(1)%init = h2so4_init
1792       salsa_gas(2)%init = hno3_init
1793       salsa_gas(3)%init = nh3_init
1794       salsa_gas(4)%init = ocnv_init
1795       salsa_gas(5)%init = ocsv_init
1796    ENDIF
1797!
1798!-- Aerosol radius in each bin: dry and wet (m)
1799    ra_dry = 1.0E-10_wp
1800!
1801!-- Initialise location-dependent aerosol size distributions and chemical compositions:
1802    CALL aerosol_init
1803
1804!-- Initalisation run of SALSA + calculate the vertical top index of the topography
1805    DO  i = nxl, nxr
1806       DO  j = nys, nyn
1807
1808          k_topo_top(j,i) = MAXLOC( MERGE( 1, 0, BTEST( wall_flags_total_0(:,j,i), 12 ) ), &
1809                                       DIM = 1 ) - 1
1810
1811          CALL salsa_driver( i, j, 1 )
1812          CALL salsa_diagnostics( i, j )
1813       ENDDO
1814    ENDDO
1815
1816    DO  ib = 1, nbins_aerosol
1817       aerosol_number(ib)%conc_p    = aerosol_number(ib)%conc
1818       aerosol_number(ib)%tconc_m   = 0.0_wp
1819       aerosol_number(ib)%flux_s    = 0.0_wp
1820       aerosol_number(ib)%diss_s    = 0.0_wp
1821       aerosol_number(ib)%flux_l    = 0.0_wp
1822       aerosol_number(ib)%diss_l    = 0.0_wp
1823       aerosol_number(ib)%sums_ws_l = 0.0_wp
1824    ENDDO
1825    DO  ic = 1, ncomponents_mass*nbins_aerosol
1826       aerosol_mass(ic)%conc_p    = aerosol_mass(ic)%conc
1827       aerosol_mass(ic)%tconc_m   = 0.0_wp
1828       aerosol_mass(ic)%flux_s    = 0.0_wp
1829       aerosol_mass(ic)%diss_s    = 0.0_wp
1830       aerosol_mass(ic)%flux_l    = 0.0_wp
1831       aerosol_mass(ic)%diss_l    = 0.0_wp
1832       aerosol_mass(ic)%sums_ws_l = 0.0_wp
1833    ENDDO
1834!
1835!
1836!-- Initialise the deposition scheme and surface types
1837    IF ( nldepo )  CALL init_deposition
1838
1839    IF ( include_emission )  THEN
1840!
1841!--    Read in and initialize emissions
1842       CALL salsa_emission_setup( .TRUE. )
1843       IF ( .NOT. salsa_gases_from_chem  .AND.  salsa_emission_mode == 'read_from_file' )  THEN
1844          CALL salsa_gas_emission_setup( .TRUE. )
1845       ENDIF
1846    ENDIF
1847!
1848!-- Partition and dissolutional growth by gaseous HNO3 and NH3
1849    IF ( index_no > 0  .AND.  index_nh > 0  .AND.  index_so4 > 0 )  lspartition = .TRUE.
1850
1851    IF ( debug_output )  CALL debug_message( 'salsa_init', 'end' )
1852
1853 END SUBROUTINE salsa_init
1854
1855!------------------------------------------------------------------------------!
1856! Description:
1857! ------------
1858!> Initializes particle size distribution grid by calculating size bin limits
1859!> and mid-size for *dry* particles in each bin. Called from salsa_initialize
1860!> (only at the beginning of simulation).
1861!> Size distribution described using:
1862!>   1) moving center method (subranges 1 and 2)
1863!>      (Jacobson, Atmos. Env., 31, 131-144, 1997)
1864!>   2) fixed sectional method (subrange 3)
1865!> Size bins in each subrange are spaced logarithmically
1866!> based on given subrange size limits and bin number.
1867!
1868!> Mona changed 06/2017: Use geometric mean diameter to describe the mean
1869!> particle diameter in a size bin, not the arithmeric mean which clearly
1870!> overestimates the total particle volume concentration.
1871!
1872!> Coded by:
1873!> Hannele Korhonen (FMI) 2005
1874!> Harri Kokkola (FMI) 2006
1875!
1876!> Bug fixes for box model + updated for the new aerosol datatype:
1877!> Juha Tonttila (FMI) 2014
1878!------------------------------------------------------------------------------!
1879 SUBROUTINE set_sizebins
1880
1881    IMPLICIT NONE
1882
1883    INTEGER(iwp) ::  cc  !< running index
1884    INTEGER(iwp) ::  dd  !< running index
1885
1886    REAL(wp) ::  ratio_d  !< ratio of the upper and lower diameter of subranges
1887
1888    aero(:)%dwet     = 1.0E-10_wp
1889    aero(:)%veqh2o   = 1.0E-10_wp
1890    aero(:)%numc     = nclim
1891    aero(:)%core     = 1.0E-10_wp
1892    DO  cc = 1, maxspec+1    ! 1:SO4, 2:OC, 3:BC, 4:DU, 5:SS, 6:NO, 7:NH, 8:H2O
1893       aero(:)%volc(cc) = 0.0_wp
1894    ENDDO
1895!
1896!-- vlolim&vhilim: min & max *dry* volumes [fxm]
1897!-- dmid: bin mid *dry* diameter (m)
1898!-- vratiolo&vratiohi: volume ratio between the center and low/high limit
1899!
1900!-- 1) Size subrange 1:
1901    ratio_d = reglim(2) / reglim(1)   ! section spacing (m)
1902    DO  cc = start_subrange_1a, end_subrange_1a
1903       aero(cc)%vlolim = api6 * ( reglim(1) * ratio_d**( REAL( cc-1 ) / nbin(1) ) )**3
1904       aero(cc)%vhilim = api6 * ( reglim(1) * ratio_d**( REAL( cc ) / nbin(1) ) )**3
1905       aero(cc)%dmid = SQRT( ( aero(cc)%vhilim / api6 )**0.33333333_wp *                           &
1906                             ( aero(cc)%vlolim / api6 )**0.33333333_wp )
1907       aero(cc)%vratiohi = aero(cc)%vhilim / ( api6 * aero(cc)%dmid**3 )
1908       aero(cc)%vratiolo = aero(cc)%vlolim / ( api6 * aero(cc)%dmid**3 )
1909    ENDDO
1910!
1911!-- 2) Size subrange 2:
1912!-- 2.1) Sub-subrange 2a: high hygroscopicity
1913    ratio_d = reglim(3) / reglim(2)   ! section spacing
1914    DO  dd = start_subrange_2a, end_subrange_2a
1915       cc = dd - start_subrange_2a
1916       aero(dd)%vlolim = api6 * ( reglim(2) * ratio_d**( REAL( cc ) / nbin(2) ) )**3
1917       aero(dd)%vhilim = api6 * ( reglim(2) * ratio_d**( REAL( cc+1 ) / nbin(2) ) )**3
1918       aero(dd)%dmid = SQRT( ( aero(dd)%vhilim / api6 )**0.33333333_wp *                           &
1919                             ( aero(dd)%vlolim / api6 )**0.33333333_wp )
1920       aero(dd)%vratiohi = aero(dd)%vhilim / ( api6 * aero(dd)%dmid**3 )
1921       aero(dd)%vratiolo = aero(dd)%vlolim / ( api6 * aero(dd)%dmid**3 )
1922    ENDDO
1923!
1924!-- 2.2) Sub-subrange 2b: low hygroscopicity
1925    IF ( .NOT. no_insoluble )  THEN
1926       aero(start_subrange_2b:end_subrange_2b)%vlolim   = aero(start_subrange_2a:end_subrange_2a)%vlolim
1927       aero(start_subrange_2b:end_subrange_2b)%vhilim   = aero(start_subrange_2a:end_subrange_2a)%vhilim
1928       aero(start_subrange_2b:end_subrange_2b)%dmid     = aero(start_subrange_2a:end_subrange_2a)%dmid
1929       aero(start_subrange_2b:end_subrange_2b)%vratiohi = aero(start_subrange_2a:end_subrange_2a)%vratiohi
1930       aero(start_subrange_2b:end_subrange_2b)%vratiolo = aero(start_subrange_2a:end_subrange_2a)%vratiolo
1931    ENDIF
1932!
1933!-- Initialize the wet diameter with the bin dry diameter to avoid numerical problems later
1934    aero(:)%dwet = aero(:)%dmid
1935!
1936!-- Save bin limits (lower diameter) to be delivered to PALM if needed
1937    DO cc = 1, nbins_aerosol
1938       bin_low_limits(cc) = ( aero(cc)%vlolim / api6 )**0.33333333_wp
1939    ENDDO
1940
1941 END SUBROUTINE set_sizebins
1942
1943!------------------------------------------------------------------------------!
1944! Description:
1945! ------------
1946!> Initilize altitude-dependent aerosol size distributions and compositions.
1947!>
1948!> Mona added 06/2017: Correct the number and mass concentrations by normalizing
1949!< by the given total number and mass concentration.
1950!>
1951!> Tomi Raatikainen, FMI, 29.2.2016
1952!------------------------------------------------------------------------------!
1953 SUBROUTINE aerosol_init
1954
1955    USE netcdf_data_input_mod,                                                                     &
1956        ONLY:  check_existence, close_input_file, get_dimension_length,                            &
1957               get_attribute, get_variable,                                                        &
1958               inquire_num_variables, inquire_variable_names,                                      &
1959               open_read_file
1960
1961    IMPLICIT NONE
1962
1963    CHARACTER(LEN=25),  DIMENSION(:), ALLOCATABLE ::  cc_name    !< chemical component name
1964    CHARACTER(LEN=100), DIMENSION(:), ALLOCATABLE ::  var_names  !< variable names
1965
1966    INTEGER(iwp) ::  ee        !< index: end
1967    INTEGER(iwp) ::  i         !< loop index: x-direction
1968    INTEGER(iwp) ::  ib        !< loop index: size bins
1969    INTEGER(iwp) ::  ic        !< loop index: chemical components
1970    INTEGER(iwp) ::  id_dyn    !< NetCDF id of PIDS_DYNAMIC_SALSA
1971    INTEGER(iwp) ::  ig        !< loop index: gases
1972    INTEGER(iwp) ::  j         !< loop index: y-direction
1973    INTEGER(iwp) ::  k         !< loop index: z-direction
1974    INTEGER(iwp) ::  lod_aero  !< level of detail of inital aerosol concentrations
1975    INTEGER(iwp) ::  num_vars  !< number of variables
1976    INTEGER(iwp) ::  pr_nbins  !< number of aerosol size bins in file
1977    INTEGER(iwp) ::  pr_ncc    !< number of aerosol chemical components in file
1978    INTEGER(iwp) ::  pr_nz     !< number of vertical grid-points in file
1979    INTEGER(iwp) ::  prunmode  !< running mode of SALSA
1980    INTEGER(iwp) ::  ss        !< index: start
1981
1982    INTEGER(iwp), DIMENSION(maxspec) ::  cc_in2mod
1983
1984    LOGICAL  ::  netcdf_extend = .FALSE. !< Flag: netcdf file exists
1985
1986    REAL(wp) ::  flag  !< flag to mask topography grid points
1987
1988    REAL(wp), DIMENSION(nbins_aerosol) ::  core   !< size of the bin mid aerosol particle
1989
1990    REAL(wp), DIMENSION(0:nz+1) ::  pnf2a   !< number fraction in 2a
1991    REAL(wp), DIMENSION(0:nz+1) ::  pmfoc1a !< mass fraction of OC in 1a
1992
1993    REAL(wp), DIMENSION(0:nz+1,nbins_aerosol)   ::  pndist  !< vertical profile of size dist. (#/m3)
1994    REAL(wp), DIMENSION(0:nz+1,maxspec)         ::  pmf2a   !< mass distributions in subrange 2a
1995    REAL(wp), DIMENSION(0:nz+1,maxspec)         ::  pmf2b   !< mass distributions in subrange 2b
1996
1997    REAL(wp), DIMENSION(:), ALLOCATABLE ::  pr_dmid  !< vertical profile of aerosol bin diameters
1998    REAL(wp), DIMENSION(:), ALLOCATABLE ::  pr_z     !< z levels of profiles
1999
2000    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  pr_mass_fracs_a  !< mass fraction: a
2001    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  pr_mass_fracs_b  !< and b
2002
2003    cc_in2mod = 0
2004    prunmode = 1
2005!
2006!-- Bin mean aerosol particle volume (m3)
2007    core(1:nbins_aerosol) = api6 * aero(1:nbins_aerosol)%dmid**3
2008!
2009!-- Set concentrations to zero
2010    pndist(:,:)  = 0.0_wp
2011    pnf2a(:)     = nf2a
2012    pmf2a(:,:)   = 0.0_wp
2013    pmf2b(:,:)   = 0.0_wp
2014    pmfoc1a(:)   = 0.0_wp
2015
2016    IF ( init_aerosol_type == 1 )  THEN
2017!
2018!--    Read input profiles from PIDS_DYNAMIC_SALSA
2019#if defined( __netcdf )
2020!
2021!--    Location-dependent size distributions and compositions.
2022       INQUIRE( FILE = TRIM( input_file_dynamic ) //  TRIM( coupling_char ), EXIST = netcdf_extend )
2023       IF ( netcdf_extend )  THEN
2024!
2025!--       Open file in read-only mode
2026          CALL open_read_file( TRIM( input_file_dynamic ) // TRIM( coupling_char ), id_dyn )
2027!
2028!--       At first, inquire all variable names
2029          CALL inquire_num_variables( id_dyn, num_vars )
2030!
2031!--       Allocate memory to store variable names
2032          ALLOCATE( var_names(1:num_vars) )
2033          CALL inquire_variable_names( id_dyn, var_names )
2034!
2035!--       Inquire vertical dimension and number of aerosol chemical components
2036          CALL get_dimension_length( id_dyn, pr_nz, 'z' )
2037          IF ( pr_nz /= nz )  THEN
2038             WRITE( message_string, * ) 'Number of inifor horizontal grid points does not match '//&
2039                                        'the number of numeric grid points.'
2040             CALL message( 'aerosol_init', 'PA0601', 1, 2, 0, 6, 0 )
2041          ENDIF
2042          CALL get_dimension_length( id_dyn, pr_ncc, 'composition_index' )
2043!
2044!--       Allocate memory
2045          ALLOCATE( pr_z(1:pr_nz), pr_mass_fracs_a(nzb:nzt+1,pr_ncc),                              &
2046                    pr_mass_fracs_b(nzb:nzt+1,pr_ncc) )
2047          pr_mass_fracs_a = 0.0_wp
2048          pr_mass_fracs_b = 0.0_wp
2049!
2050!--       Read vertical levels
2051          CALL get_variable( id_dyn, 'z', pr_z )
2052!
2053!--       Read the names of chemical components
2054          IF ( check_existence( var_names, 'composition_name' ) )  THEN
2055             CALL get_variable( id_dyn, 'composition_name', cc_name, pr_ncc )
2056          ELSE
2057             WRITE( message_string, * ) 'Missing composition_name in ' // TRIM( input_file_dynamic )
2058             CALL message( 'aerosol_init', 'PA0655', 1, 2, 0, 6, 0 )
2059          ENDIF
2060!
2061!--       Define the index of each chemical component in the model
2062          DO  ic = 1, pr_ncc
2063             SELECT CASE ( TRIM( cc_name(ic) ) )
2064                CASE ( 'H2SO4', 'SO4', 'h2so4', 'so4' )
2065                   cc_in2mod(1) = ic
2066                CASE ( 'OC', 'oc' )
2067                   cc_in2mod(2) = ic
2068                CASE ( 'BC', 'bc' )
2069                   cc_in2mod(3) = ic
2070                CASE ( 'DU', 'du' )
2071                   cc_in2mod(4) = ic
2072                CASE ( 'SS', 'ss' )
2073                   cc_in2mod(5) = ic
2074                CASE ( 'HNO3', 'hno3', 'NO3', 'no3', 'NO', 'no' )
2075                   cc_in2mod(6) = ic
2076                CASE ( 'NH3', 'nh3', 'NH4', 'nh4', 'NH', 'nh' )
2077                   cc_in2mod(7) = ic
2078             END SELECT
2079          ENDDO
2080
2081          IF ( SUM( cc_in2mod ) == 0 )  THEN
2082             message_string = 'None of the aerosol chemical components in ' // TRIM(               &
2083                              input_file_dynamic ) // ' correspond to ones applied in SALSA.'
2084             CALL message( 'salsa_mod: aerosol_init', 'PA0602', 2, 2, 0, 6, 0 )
2085          ENDIF
2086!
2087!--       Vertical profiles of mass fractions of different chemical components:
2088          IF ( check_existence( var_names, 'init_atmosphere_mass_fracs_a' ) )  THEN
2089             CALL get_variable( id_dyn, 'init_atmosphere_mass_fracs_a', pr_mass_fracs_a,           &
2090                                0, pr_ncc-1, 0, pr_nz-1 )
2091          ELSE
2092             WRITE( message_string, * ) 'Missing init_atmosphere_mass_fracs_a in ' //              &
2093                                        TRIM( input_file_dynamic )
2094             CALL message( 'aerosol_init', 'PA0656', 1, 2, 0, 6, 0 )
2095          ENDIF
2096          CALL get_variable( id_dyn, 'init_atmosphere_mass_fracs_b', pr_mass_fracs_b,              &
2097                             0, pr_ncc-1, 0, pr_nz-1  )
2098!
2099!--       Match the input data with the chemical composition applied in the model
2100          DO  ic = 1, maxspec
2101             ss = cc_in2mod(ic)
2102             IF ( ss == 0 )  CYCLE
2103             pmf2a(nzb+1:nzt+1,ic) = pr_mass_fracs_a(nzb:nzt,ss)
2104             pmf2b(nzb+1:nzt+1,ic) = pr_mass_fracs_b(nzb:nzt,ss)
2105          ENDDO
2106!
2107!--       Aerosol concentrations: lod=1 (vertical profile of sectional number size distribution)
2108          CALL get_attribute( id_dyn, 'lod', lod_aero, .FALSE., 'init_atmosphere_aerosol' )
2109          IF ( lod_aero /= 1 )  THEN
2110             message_string = 'Currently only lod=1 accepted for init_atmosphere_aerosol'
2111             CALL message( 'salsa_mod: aerosol_init', 'PA0603', 2, 2, 0, 6, 0 )
2112          ELSE
2113!
2114!--          Bin mean diameters in the input file
2115             CALL get_dimension_length( id_dyn, pr_nbins, 'Dmid')
2116             IF ( pr_nbins /= nbins_aerosol )  THEN
2117                message_string = 'Number of size bins in init_atmosphere_aerosol does not match '  &
2118                                 // 'with that applied in the model'
2119                CALL message( 'salsa_mod: aerosol_init', 'PA0604', 2, 2, 0, 6, 0 )
2120             ENDIF
2121
2122             ALLOCATE( pr_dmid(pr_nbins) )
2123             pr_dmid    = 0.0_wp
2124
2125             CALL get_variable( id_dyn, 'Dmid', pr_dmid )
2126!
2127!--          Check whether the sectional representation conform to the one
2128!--          applied in the model
2129             IF ( ANY( ABS( ( aero(1:nbins_aerosol)%dmid - pr_dmid ) /                             &
2130                              aero(1:nbins_aerosol)%dmid )  > 0.1_wp )  ) THEN
2131                message_string = 'Mean diameters of the aerosol size bins in ' // TRIM(            &
2132                                 input_file_dynamic ) // ' do not match with the sectional '//     &
2133                                 'representation of the model.'
2134                CALL message( 'salsa_mod: aerosol_init', 'PA0605', 2, 2, 0, 6, 0 )
2135             ENDIF
2136!
2137!--          Inital aerosol concentrations
2138             CALL get_variable( id_dyn, 'init_atmosphere_aerosol', pndist(nzb+1:nzt,:),            &
2139                                0, pr_nbins-1, 0, pr_nz-1 )
2140          ENDIF
2141!
2142!--       Set bottom and top boundary condition (Neumann)
2143          pmf2a(nzb,:)    = pmf2a(nzb+1,:)
2144          pmf2a(nzt+1,:)  = pmf2a(nzt,:)
2145          pmf2b(nzb,:)    = pmf2b(nzb+1,:)
2146          pmf2b(nzt+1,:)  = pmf2b(nzt,:)
2147          pndist(nzb,:)   = pndist(nzb+1,:)
2148          pndist(nzt+1,:) = pndist(nzt,:)
2149
2150          IF ( index_so4 < 0 )  THEN
2151             pmf2a(:,1) = 0.0_wp
2152             pmf2b(:,1) = 0.0_wp
2153          ENDIF
2154          IF ( index_oc < 0 )  THEN
2155             pmf2a(:,2) = 0.0_wp
2156             pmf2b(:,2) = 0.0_wp
2157          ENDIF
2158          IF ( index_bc < 0 )  THEN
2159             pmf2a(:,3) = 0.0_wp
2160             pmf2b(:,3) = 0.0_wp
2161          ENDIF
2162          IF ( index_du < 0 )  THEN
2163             pmf2a(:,4) = 0.0_wp
2164             pmf2b(:,4) = 0.0_wp
2165          ENDIF
2166          IF ( index_ss < 0 )  THEN
2167             pmf2a(:,5) = 0.0_wp
2168             pmf2b(:,5) = 0.0_wp
2169          ENDIF
2170          IF ( index_no < 0 )  THEN
2171             pmf2a(:,6) = 0.0_wp
2172             pmf2b(:,6) = 0.0_wp
2173          ENDIF
2174          IF ( index_nh < 0 )  THEN
2175             pmf2a(:,7) = 0.0_wp
2176             pmf2b(:,7) = 0.0_wp
2177          ENDIF
2178
2179          IF ( SUM( pmf2a ) < 0.00001_wp  .AND.  SUM( pmf2b ) < 0.00001_wp )  THEN
2180             message_string = 'Error in initialising mass fractions of chemical components. ' //   &
2181                              'Check that all chemical components are included in parameter file!'
2182             CALL message( 'salsa_mod: aerosol_init', 'PA0606', 2, 2, 0, 6, 0 ) 
2183          ENDIF
2184!
2185!--       Then normalise the mass fraction so that SUM = 1
2186          DO  k = nzb, nzt+1
2187             pmf2a(k,:) = pmf2a(k,:) / SUM( pmf2a(k,:) )
2188             IF ( SUM( pmf2b(k,:) ) > 0.0_wp )  pmf2b(k,:) = pmf2b(k,:) / SUM( pmf2b(k,:) )
2189          ENDDO
2190
2191          DEALLOCATE( pr_z, pr_mass_fracs_a, pr_mass_fracs_b )
2192!
2193!--       Close input file
2194          CALL close_input_file( id_dyn )
2195
2196       ELSE
2197          message_string = 'Input file '// TRIM( input_file_dynamic ) // TRIM( coupling_char ) //  &
2198                           ' for SALSA missing!'
2199          CALL message( 'salsa_mod: aerosol_init', 'PA0607', 1, 2, 0, 6, 0 )
2200
2201       ENDIF   ! netcdf_extend
2202
2203#else
2204       message_string = 'init_aerosol_type = 1 but preprocessor directive __netcdf is not used '// &
2205                        'in compiling!'
2206       CALL message( 'salsa_mod: aerosol_init', 'PA0608', 1, 2, 0, 6, 0 )
2207
2208#endif
2209
2210    ELSEIF ( init_aerosol_type == 0 )  THEN
2211!
2212!--    Mass fractions for species in a and b-bins
2213       IF ( index_so4 > 0 )  THEN
2214          pmf2a(:,1) = mass_fracs_a(index_so4)
2215          pmf2b(:,1) = mass_fracs_b(index_so4)
2216       ENDIF
2217       IF ( index_oc > 0 )  THEN
2218          pmf2a(:,2) = mass_fracs_a(index_oc)
2219          pmf2b(:,2) = mass_fracs_b(index_oc)
2220       ENDIF
2221       IF ( index_bc > 0 )  THEN
2222          pmf2a(:,3) = mass_fracs_a(index_bc)
2223          pmf2b(:,3) = mass_fracs_b(index_bc)
2224       ENDIF
2225       IF ( index_du > 0 )  THEN
2226          pmf2a(:,4) = mass_fracs_a(index_du)
2227          pmf2b(:,4) = mass_fracs_b(index_du)
2228       ENDIF
2229       IF ( index_ss > 0 )  THEN
2230          pmf2a(:,5) = mass_fracs_a(index_ss)
2231          pmf2b(:,5) = mass_fracs_b(index_ss)
2232       ENDIF
2233       IF ( index_no > 0 )  THEN
2234          pmf2a(:,6) = mass_fracs_a(index_no)
2235          pmf2b(:,6) = mass_fracs_b(index_no)
2236       ENDIF
2237       IF ( index_nh > 0 )  THEN
2238          pmf2a(:,7) = mass_fracs_a(index_nh)
2239          pmf2b(:,7) = mass_fracs_b(index_nh)
2240       ENDIF
2241       DO  k = nzb, nzt+1
2242          pmf2a(k,:) = pmf2a(k,:) / SUM( pmf2a(k,:) )
2243          IF ( SUM( pmf2b(k,:) ) > 0.0_wp ) pmf2b(k,:) = pmf2b(k,:) / SUM( pmf2b(k,:) )
2244       ENDDO
2245
2246       CALL size_distribution( n_lognorm, dpg, sigmag, nsect )
2247!
2248!--    Normalize by the given total number concentration
2249       nsect = nsect * SUM( n_lognorm ) / SUM( nsect )
2250       DO  ib = start_subrange_1a, end_subrange_2b
2251          pndist(:,ib) = nsect(ib)
2252       ENDDO
2253    ENDIF
2254
2255    IF ( init_gases_type == 1 )  THEN
2256!
2257!--    Read input profiles from PIDS_CHEM
2258#if defined( __netcdf )
2259!
2260!--    Location-dependent size distributions and compositions.
2261       INQUIRE( FILE = TRIM( input_file_dynamic ) //  TRIM( coupling_char ), EXIST = netcdf_extend )
2262       IF ( netcdf_extend  .AND.  .NOT. salsa_gases_from_chem )  THEN
2263!
2264!--       Open file in read-only mode
2265          CALL open_read_file( TRIM( input_file_dynamic ) // TRIM( coupling_char ), id_dyn )
2266!
2267!--       Inquire dimensions:
2268          CALL get_dimension_length( id_dyn, pr_nz, 'z' )
2269          IF ( pr_nz /= nz )  THEN
2270             WRITE( message_string, * ) 'Number of inifor horizontal grid points does not match '//&
2271                                        'the number of numeric grid points.'
2272             CALL message( 'aerosol_init', 'PA0609', 1, 2, 0, 6, 0 )
2273          ENDIF
2274!
2275!--       Read vertical profiles of gases:
2276          CALL get_variable( id_dyn, 'init_atmosphere_H2SO4', salsa_gas(1)%init(nzb+1:nzt) )
2277          CALL get_variable( id_dyn, 'init_atmosphere_HNO3',  salsa_gas(2)%init(nzb+1:nzt) )
2278          CALL get_variable( id_dyn, 'init_atmosphere_NH3',   salsa_gas(3)%init(nzb+1:nzt) )
2279          CALL get_variable( id_dyn, 'init_atmosphere_OCNV',  salsa_gas(4)%init(nzb+1:nzt) )
2280          CALL get_variable( id_dyn, 'init_atmosphere_OCSV',  salsa_gas(5)%init(nzb+1:nzt) )
2281!
2282!--       Set Neumann top and surface boundary condition for initial + initialise concentrations
2283          DO  ig = 1, ngases_salsa
2284             salsa_gas(ig)%init(nzb)   =  salsa_gas(ig)%init(nzb+1)
2285             salsa_gas(ig)%init(nzt+1) =  salsa_gas(ig)%init(nzt)
2286             IF ( .NOT. read_restart_data_salsa )  THEN
2287                DO  k = nzb, nzt+1
2288                   salsa_gas(ig)%conc(k,:,:) = salsa_gas(ig)%init(k)
2289                ENDDO
2290             ENDIF
2291          ENDDO
2292!
2293!--       Close input file
2294          CALL close_input_file( id_dyn )
2295
2296       ELSEIF ( .NOT. netcdf_extend  .AND.  .NOT.  salsa_gases_from_chem )  THEN
2297          message_string = 'Input file '// TRIM( input_file_dynamic ) // TRIM( coupling_char ) //  &
2298                           ' for SALSA missing!'
2299          CALL message( 'salsa_mod: aerosol_init', 'PA0610', 1, 2, 0, 6, 0 )
2300
2301       ENDIF   ! netcdf_extend
2302#else
2303       message_string = 'init_gases_type = 1 but preprocessor directive __netcdf is not used in '//&
2304                        'compiling!'
2305       CALL message( 'salsa_mod: aerosol_init', 'PA0611', 1, 2, 0, 6, 0 )
2306
2307#endif
2308
2309    ENDIF
2310!
2311!-- Both SO4 and OC are included, so use the given mass fractions
2312    IF ( index_oc > 0  .AND.  index_so4 > 0 )  THEN
2313       pmfoc1a(:) = pmf2a(:,2) / ( pmf2a(:,2) + pmf2a(:,1) )  ! Normalize
2314!
2315!-- Pure organic carbon
2316    ELSEIF ( index_oc > 0 )  THEN
2317       pmfoc1a(:) = 1.0_wp
2318!
2319!-- Pure SO4
2320    ELSEIF ( index_so4 > 0 )  THEN
2321       pmfoc1a(:) = 0.0_wp
2322
2323    ELSE
2324       message_string = 'Either OC or SO4 must be active for aerosol region 1a!'
2325       CALL message( 'salsa_mod: aerosol_init', 'PA0612', 1, 2, 0, 6, 0 )
2326    ENDIF
2327
2328!
2329!-- Initialize concentrations
2330    DO  i = nxlg, nxrg
2331       DO  j = nysg, nyng
2332          DO  k = nzb, nzt+1
2333!
2334!--          Predetermine flag to mask topography
2335             flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) )
2336!
2337!--          a) Number concentrations
2338!--          Region 1:
2339             DO  ib = start_subrange_1a, end_subrange_1a
2340                IF ( .NOT. read_restart_data_salsa )  THEN
2341                   aerosol_number(ib)%conc(k,j,i) = pndist(k,ib) * flag
2342                ENDIF
2343                IF ( prunmode == 1 )  THEN
2344                   aerosol_number(ib)%init = pndist(:,ib)
2345                ENDIF
2346             ENDDO
2347!
2348!--          Region 2:
2349             IF ( nreg > 1 )  THEN
2350                DO  ib = start_subrange_2a, end_subrange_2a
2351                   IF ( .NOT. read_restart_data_salsa )  THEN
2352                      aerosol_number(ib)%conc(k,j,i) = MAX( 0.0_wp, pnf2a(k) ) * pndist(k,ib) * flag
2353                   ENDIF
2354                   IF ( prunmode == 1 )  THEN
2355                      aerosol_number(ib)%init = MAX( 0.0_wp, nf2a ) * pndist(:,ib)
2356                   ENDIF
2357                ENDDO
2358                IF ( .NOT. no_insoluble )  THEN
2359                   DO  ib = start_subrange_2b, end_subrange_2b
2360                      IF ( pnf2a(k) < 1.0_wp )  THEN
2361                         IF ( .NOT. read_restart_data_salsa )  THEN
2362                            aerosol_number(ib)%conc(k,j,i) = MAX( 0.0_wp, 1.0_wp - pnf2a(k) ) *    &
2363                                                             pndist(k,ib) * flag
2364                         ENDIF
2365                         IF ( prunmode == 1 )  THEN
2366                            aerosol_number(ib)%init = MAX( 0.0_wp, 1.0_wp - nf2a ) * pndist(:,ib)
2367                         ENDIF
2368                      ENDIF
2369                   ENDDO
2370                ENDIF
2371             ENDIF
2372!
2373!--          b) Aerosol mass concentrations
2374!--             bin subrange 1: done here separately due to the SO4/OC convention
2375!
2376!--          SO4:
2377             IF ( index_so4 > 0 )  THEN
2378                ss = ( index_so4 - 1 ) * nbins_aerosol + start_subrange_1a !< start
2379                ee = ( index_so4 - 1 ) * nbins_aerosol + end_subrange_1a !< end
2380                ib = start_subrange_1a
2381                DO  ic = ss, ee
2382                   IF ( .NOT. read_restart_data_salsa )  THEN
2383                      aerosol_mass(ic)%conc(k,j,i) = MAX( 0.0_wp, 1.0_wp - pmfoc1a(k) ) *          &
2384                                                     pndist(k,ib) * core(ib) * arhoh2so4 * flag
2385                   ENDIF
2386                   IF ( prunmode == 1 )  THEN
2387                      aerosol_mass(ic)%init(k) = MAX( 0.0_wp, 1.0_wp - pmfoc1a(k) ) * pndist(k,ib) &
2388                                                 * core(ib) * arhoh2so4
2389                   ENDIF
2390                   ib = ib+1
2391                ENDDO
2392             ENDIF
2393!
2394!--          OC:
2395             IF ( index_oc > 0 ) THEN
2396                ss = ( index_oc - 1 ) * nbins_aerosol + start_subrange_1a !< start
2397                ee = ( index_oc - 1 ) * nbins_aerosol + end_subrange_1a !< end
2398                ib = start_subrange_1a
2399                DO  ic = ss, ee
2400                   IF ( .NOT. read_restart_data_salsa )  THEN
2401                      aerosol_mass(ic)%conc(k,j,i) = MAX( 0.0_wp, pmfoc1a(k) ) * pndist(k,ib) *    &
2402                                                     core(ib) * arhooc * flag
2403                   ENDIF
2404                   IF ( prunmode == 1 )  THEN
2405                      aerosol_mass(ic)%init(k) = MAX( 0.0_wp, pmfoc1a(k) ) * pndist(k,ib) *        &
2406                                                 core(ib) * arhooc
2407                   ENDIF
2408                   ib = ib+1
2409                ENDDO 
2410             ENDIF
2411          ENDDO !< k
2412
2413          prunmode = 3  ! Init only once
2414
2415       ENDDO !< j
2416    ENDDO !< i
2417
2418!
2419!-- c) Aerosol mass concentrations
2420!--    bin subrange 2:
2421    IF ( nreg > 1 ) THEN
2422
2423       IF ( index_so4 > 0 ) THEN
2424          CALL set_aero_mass( index_so4, pmf2a(:,1), pmf2b(:,1), pnf2a, pndist, core, arhoh2so4 )
2425       ENDIF
2426       IF ( index_oc > 0 ) THEN
2427          CALL set_aero_mass( index_oc, pmf2a(:,2), pmf2b(:,2), pnf2a, pndist, core, arhooc )
2428       ENDIF
2429       IF ( index_bc > 0 ) THEN
2430          CALL set_aero_mass( index_bc, pmf2a(:,3), pmf2b(:,3), pnf2a, pndist, core, arhobc )
2431       ENDIF
2432       IF ( index_du > 0 ) THEN
2433          CALL set_aero_mass( index_du, pmf2a(:,4), pmf2b(:,4), pnf2a, pndist, core, arhodu )
2434       ENDIF
2435       IF ( index_ss > 0 ) THEN
2436          CALL set_aero_mass( index_ss, pmf2a(:,5), pmf2b(:,5), pnf2a, pndist, core, arhoss )
2437       ENDIF
2438       IF ( index_no > 0 ) THEN
2439          CALL set_aero_mass( index_no, pmf2a(:,6), pmf2b(:,6), pnf2a, pndist, core, arhohno3 )
2440       ENDIF
2441       IF ( index_nh > 0 ) THEN
2442          CALL set_aero_mass( index_nh, pmf2a(:,7), pmf2b(:,7), pnf2a, pndist, core, arhonh3 )
2443       ENDIF
2444
2445    ENDIF
2446
2447 END SUBROUTINE aerosol_init
2448
2449!------------------------------------------------------------------------------!
2450! Description:
2451! ------------
2452!> Create a lognormal size distribution and discretise to a sectional
2453!> representation.
2454!------------------------------------------------------------------------------!
2455 SUBROUTINE size_distribution( in_ntot, in_dpg, in_sigma, psd_sect )
2456
2457    IMPLICIT NONE
2458
2459    INTEGER(iwp) ::  ib         !< running index: bin
2460    INTEGER(iwp) ::  iteration  !< running index: iteration
2461
2462    REAL(wp) ::  d1         !< particle diameter (m, dummy)
2463    REAL(wp) ::  d2         !< particle diameter (m, dummy)
2464    REAL(wp) ::  delta_d    !< (d2-d1)/10
2465    REAL(wp) ::  deltadp    !< bin width
2466    REAL(wp) ::  dmidi      !< ( d1 + d2 ) / 2
2467
2468    REAL(wp), DIMENSION(:), INTENT(in) ::  in_dpg    !< geometric mean diameter (m)
2469    REAL(wp), DIMENSION(:), INTENT(in) ::  in_ntot   !< number conc. (#/m3)
2470    REAL(wp), DIMENSION(:), INTENT(in) ::  in_sigma  !< standard deviation
2471
2472    REAL(wp), DIMENSION(:), INTENT(inout) ::  psd_sect  !< sectional size distribution
2473
2474    DO  ib = start_subrange_1a, end_subrange_2b
2475       psd_sect(ib) = 0.0_wp
2476!
2477!--    Particle diameter at the low limit (largest in the bin) (m)
2478       d1 = ( aero(ib)%vlolim / api6 )**0.33333333_wp
2479!
2480!--    Particle diameter at the high limit (smallest in the bin) (m)
2481       d2 = ( aero(ib)%vhilim / api6 )**0.33333333_wp
2482!
2483!--    Span of particle diameter in a bin (m)
2484       delta_d = 0.1_wp * ( d2 - d1 )
2485!
2486!--    Iterate:
2487       DO  iteration = 1, 10
2488          d1 = ( aero(ib)%vlolim / api6 )**0.33333333_wp + ( ib - 1) * delta_d
2489          d2 = d1 + delta_d
2490          dmidi = 0.5_wp * ( d1 + d2 )
2491          deltadp = LOG10( d2 / d1 )
2492!
2493!--       Size distribution
2494!--       in_ntot = total number, total area, or total volume concentration
2495!--       in_dpg = geometric-mean number, area, or volume diameter
2496!--       n(k) = number, area, or volume concentration in a bin
2497          psd_sect(ib) = psd_sect(ib) + SUM( in_ntot * deltadp / ( SQRT( 2.0_wp * pi ) *           &
2498                        LOG10( in_sigma ) ) * EXP( -LOG10( dmidi / in_dpg )**2.0_wp /              &
2499                        ( 2.0_wp * LOG10( in_sigma ) ** 2.0_wp ) ) )
2500
2501       ENDDO
2502    ENDDO
2503
2504 END SUBROUTINE size_distribution
2505
2506!------------------------------------------------------------------------------!
2507! Description:
2508! ------------
2509!> Sets the mass concentrations to aerosol arrays in 2a and 2b.
2510!>
2511!> Tomi Raatikainen, FMI, 29.2.2016
2512!------------------------------------------------------------------------------!
2513 SUBROUTINE set_aero_mass( ispec, pmf2a, pmf2b, pnf2a, pndist, pcore, prho )
2514
2515    IMPLICIT NONE
2516
2517    INTEGER(iwp) ::  ee        !< index: end
2518    INTEGER(iwp) ::  i         !< loop index
2519    INTEGER(iwp) ::  ib        !< loop index
2520    INTEGER(iwp) ::  ic        !< loop index
2521    INTEGER(iwp) ::  j         !< loop index
2522    INTEGER(iwp) ::  k         !< loop index
2523    INTEGER(iwp) ::  prunmode  !< 1 = initialise
2524    INTEGER(iwp) ::  ss        !< index: start
2525
2526    INTEGER(iwp), INTENT(in) :: ispec  !< Aerosol species index
2527
2528    REAL(wp) ::  flag   !< flag to mask topography grid points
2529
2530    REAL(wp), INTENT(in) ::  prho !< Aerosol density
2531
2532    REAL(wp), DIMENSION(nbins_aerosol), INTENT(in) ::  pcore !< Aerosol bin mid core volume
2533    REAL(wp), DIMENSION(0:nz+1), INTENT(in)        ::  pnf2a !< Number fraction for 2a
2534    REAL(wp), DIMENSION(0:nz+1), INTENT(in)        ::  pmf2a !< Mass distributions for a
2535    REAL(wp), DIMENSION(0:nz+1), INTENT(in)        ::  pmf2b !< and b bins
2536
2537    REAL(wp), DIMENSION(0:nz+1,nbins_aerosol), INTENT(in) ::  pndist !< Aerosol size distribution
2538
2539    prunmode = 1
2540
2541    DO i = nxlg, nxrg
2542       DO j = nysg, nyng
2543          DO k = nzb, nzt+1
2544!
2545!--          Predetermine flag to mask topography
2546             flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) ) 
2547!
2548!--          Regime 2a:
2549             ss = ( ispec - 1 ) * nbins_aerosol + start_subrange_2a
2550             ee = ( ispec - 1 ) * nbins_aerosol + end_subrange_2a
2551             ib = start_subrange_2a
2552             DO ic = ss, ee
2553                IF ( .NOT. read_restart_data_salsa )  THEN
2554                   aerosol_mass(ic)%conc(k,j,i) = MAX( 0.0_wp, pmf2a(k) ) * pnf2a(k) * pndist(k,ib)&
2555                                                  * pcore(ib) * prho * flag
2556                ENDIF
2557                IF ( prunmode == 1 )  THEN
2558                   aerosol_mass(ic)%init(k) = MAX( 0.0_wp, pmf2a(k) ) * pnf2a(k) * pndist(k,ib) *  &
2559                                              pcore(ib) * prho
2560                ENDIF
2561                ib = ib + 1
2562             ENDDO
2563!
2564!--          Regime 2b:
2565             IF ( .NOT. no_insoluble )  THEN
2566                ss = ( ispec - 1 ) * nbins_aerosol + start_subrange_2b
2567                ee = ( ispec - 1 ) * nbins_aerosol + end_subrange_2b
2568                ib = start_subrange_2a
2569                DO ic = ss, ee
2570                   IF ( .NOT. read_restart_data_salsa )  THEN
2571                      aerosol_mass(ic)%conc(k,j,i) = MAX( 0.0_wp, pmf2b(k) ) * ( 1.0_wp - pnf2a(k))&
2572                                                     * pndist(k,ib) * pcore(ib) * prho * flag
2573                   ENDIF
2574                   IF ( prunmode == 1 )  THEN
2575                      aerosol_mass(ic)%init(k) = MAX( 0.0_wp, pmf2b(k) ) * ( 1.0_wp - pnf2a(k) ) * &
2576                                                 pndist(k,ib) * pcore(ib) * prho 
2577                   ENDIF
2578                   ib = ib + 1
2579                ENDDO  ! c
2580
2581             ENDIF
2582          ENDDO   ! k
2583
2584          prunmode = 3  ! Init only once
2585
2586       ENDDO   ! j
2587    ENDDO   ! i
2588
2589 END SUBROUTINE set_aero_mass
2590
2591!------------------------------------------------------------------------------!
2592! Description:
2593! ------------
2594!> Initialise the matching between surface types in LSM and deposition models.
2595!> Do the matching based on Zhang et al. (2001). Atmos. Environ. 35, 549-560
2596!> (here referred as Z01).
2597!------------------------------------------------------------------------------!
2598 SUBROUTINE init_deposition
2599
2600    USE surface_mod,                                                                               &
2601        ONLY:  surf_lsm_h, surf_lsm_v, surf_usm_h, surf_usm_v
2602
2603    IMPLICIT NONE
2604
2605    INTEGER(iwp) ::  l  !< loop index for vertical surfaces
2606
2607    LOGICAL :: match_lsm  !< flag to initilise LSM surfaces (if false, initialise USM surfaces)
2608
2609    IF ( depo_pcm_par == 'zhang2001' )  THEN
2610       depo_pcm_par_num = 1
2611    ELSEIF ( depo_pcm_par == 'petroff2010' )  THEN
2612       depo_pcm_par_num = 2
2613    ENDIF
2614
2615    IF ( depo_surf_par == 'zhang2001' )  THEN
2616       depo_surf_par_num = 1
2617    ELSEIF ( depo_surf_par == 'petroff2010' )  THEN
2618       depo_surf_par_num = 2
2619    ENDIF
2620!
2621!-- LSM: Pavement, vegetation and water
2622    IF ( nldepo_surf  .AND.  land_surface )  THEN
2623       match_lsm = .TRUE.
2624       ALLOCATE( lsm_to_depo_h%match_lupg(1:surf_lsm_h%ns),                                         &
2625                 lsm_to_depo_h%match_luvw(1:surf_lsm_h%ns),                                         &
2626                 lsm_to_depo_h%match_luww(1:surf_lsm_h%ns) )
2627       lsm_to_depo_h%match_lupg = 0
2628       lsm_to_depo_h%match_luvw = 0
2629       lsm_to_depo_h%match_luww = 0
2630       CALL match_sm_zhang( surf_lsm_h, lsm_to_depo_h%match_lupg, lsm_to_depo_h%match_luvw,        &
2631                            lsm_to_depo_h%match_luww, match_lsm )
2632       DO  l = 0, 3
2633          ALLOCATE( lsm_to_depo_v(l)%match_lupg(1:surf_lsm_v(l)%ns),                               &
2634                    lsm_to_depo_v(l)%match_luvw(1:surf_lsm_v(l)%ns),                               &
2635                    lsm_to_depo_v(l)%match_luww(1:surf_lsm_v(l)%ns) )
2636          lsm_to_depo_v(l)%match_lupg = 0
2637          lsm_to_depo_v(l)%match_luvw = 0
2638          lsm_to_depo_v(l)%match_luww = 0
2639          CALL match_sm_zhang( surf_lsm_v(l), lsm_to_depo_v(l)%match_lupg,                         &
2640                               lsm_to_depo_v(l)%match_luvw, lsm_to_depo_v(l)%match_luww, match_lsm )
2641       ENDDO
2642    ENDIF
2643!
2644!-- USM: Green roofs/walls, wall surfaces and windows
2645    IF ( nldepo_surf  .AND.  urban_surface )  THEN
2646       match_lsm = .FALSE.
2647       ALLOCATE( usm_to_depo_h%match_lupg(1:surf_usm_h%ns),                                        &
2648                 usm_to_depo_h%match_luvw(1:surf_usm_h%ns),                                        &
2649                 usm_to_depo_h%match_luww(1:surf_usm_h%ns) )
2650       usm_to_depo_h%match_lupg = 0
2651       usm_to_depo_h%match_luvw = 0
2652       usm_to_depo_h%match_luww = 0
2653       CALL match_sm_zhang( surf_usm_h, usm_to_depo_h%match_lupg, usm_to_depo_h%match_luvw,        &
2654                            usm_to_depo_h%match_luww, match_lsm )
2655       DO  l = 0, 3
2656          ALLOCATE( usm_to_depo_v(l)%match_lupg(1:surf_usm_v(l)%ns),                               &
2657                    usm_to_depo_v(l)%match_luvw(1:surf_usm_v(l)%ns),                               &
2658                    usm_to_depo_v(l)%match_luww(1:surf_usm_v(l)%ns) )
2659          usm_to_depo_v(l)%match_lupg = 0
2660          usm_to_depo_v(l)%match_luvw = 0
2661          usm_to_depo_v(l)%match_luww = 0
2662          CALL match_sm_zhang( surf_usm_v(l), usm_to_depo_v(l)%match_lupg,                         &
2663                               usm_to_depo_v(l)%match_luvw, usm_to_depo_v(l)%match_luww, match_lsm )
2664       ENDDO
2665    ENDIF
2666
2667    IF ( nldepo_pcm )  THEN
2668       SELECT CASE ( depo_pcm_type )
2669          CASE ( 'evergreen_needleleaf' )
2670             depo_pcm_type_num = 1
2671          CASE ( 'evergreen_broadleaf' )
2672             depo_pcm_type_num = 2
2673          CASE ( 'deciduous_needleleaf' )
2674             depo_pcm_type_num = 3
2675          CASE ( 'deciduous_broadleaf' )
2676             depo_pcm_type_num = 4
2677          CASE DEFAULT
2678             message_string = 'depo_pcm_type not set correctly.'
2679             CALL message( 'salsa_mod: init_deposition', 'PA0613', 1, 2, 0, 6, 0 )
2680       END SELECT
2681    ENDIF
2682
2683 END SUBROUTINE init_deposition
2684
2685!------------------------------------------------------------------------------!
2686! Description:
2687! ------------
2688!> Match the surface types in PALM and Zhang et al. 2001 deposition module
2689!------------------------------------------------------------------------------!
2690 SUBROUTINE match_sm_zhang( surf, match_pav_green, match_veg_wall, match_wat_win, match_lsm )
2691
2692    USE surface_mod,                                                           &
2693        ONLY:  ind_pav_green, ind_veg_wall, ind_wat_win, surf_type
2694
2695    IMPLICIT NONE
2696
2697    INTEGER(iwp) ::  m              !< index for surface elements
2698    INTEGER(iwp) ::  pav_type_palm  !< pavement / green wall type in PALM
2699    INTEGER(iwp) ::  veg_type_palm  !< vegetation / wall type in PALM
2700    INTEGER(iwp) ::  wat_type_palm  !< water / window type in PALM
2701
2702    INTEGER(iwp), DIMENSION(:), INTENT(inout) ::  match_pav_green  !<  matching pavement/green walls
2703    INTEGER(iwp), DIMENSION(:), INTENT(inout) ::  match_veg_wall   !<  matching vegetation/walls
2704    INTEGER(iwp), DIMENSION(:), INTENT(inout) ::  match_wat_win    !<  matching water/windows
2705
2706    LOGICAL, INTENT(in) :: match_lsm  !< flag to initilise LSM surfaces (if false, initialise USM)
2707
2708    TYPE(surf_type), INTENT(in) :: surf  !< respective surface type
2709
2710    DO  m = 1, surf%ns
2711       IF ( match_lsm )  THEN
2712!
2713!--       Vegetation (LSM):
2714          IF ( surf%frac(ind_veg_wall,m) > 0 )  THEN
2715             veg_type_palm = surf%vegetation_type(m)
2716             SELECT CASE ( veg_type_palm )
2717                CASE ( 0 )
2718                   message_string = 'No vegetation type defined.'
2719                   CALL message( 'salsa_mod: init_depo_surfaces', 'PA0614', 1, 2, 0, 6, 0 )
2720                CASE ( 1 )  ! bare soil
2721                   match_veg_wall(m) = 6  ! grass in Z01
2722                CASE ( 2 )  ! crops, mixed farming
2723                   match_veg_wall(m) = 7  !  crops, mixed farming Z01
2724                CASE ( 3 )  ! short grass
2725                   match_veg_wall(m) = 6  ! grass in Z01
2726                CASE ( 4 )  ! evergreen needleleaf trees
2727                    match_veg_wall(m) = 1  ! evergreen needleleaf trees in Z01
2728                CASE ( 5 )  ! deciduous needleleaf trees
2729                   match_veg_wall(m) = 3  ! deciduous needleleaf trees in Z01
2730                CASE ( 6 )  ! evergreen broadleaf trees
2731                   match_veg_wall(m) = 2  ! evergreen broadleaf trees in Z01
2732                CASE ( 7 )  ! deciduous broadleaf trees
2733                   match_veg_wall(m) = 4  ! deciduous broadleaf trees in Z01
2734                CASE ( 8 )  ! tall grass
2735                   match_veg_wall(m) = 6  ! grass in Z01
2736                CASE ( 9 )  ! desert
2737                   match_veg_wall(m) = 8  ! desert in Z01
2738                CASE ( 10 )  ! tundra
2739                   match_veg_wall(m) = 9  ! tundra in Z01
2740                CASE ( 11 )  ! irrigated crops
2741                   match_veg_wall(m) = 7  !  crops, mixed farming Z01
2742                CASE ( 12 )  ! semidesert
2743                   match_veg_wall(m) = 8  ! desert in Z01
2744                CASE ( 13 )  ! ice caps and glaciers
2745                   match_veg_wall(m) = 12  ! ice cap and glacier in Z01
2746                CASE ( 14 )  ! bogs and marshes
2747                   match_veg_wall(m) = 11  ! wetland with plants in Z01
2748                CASE ( 15 )  ! evergreen shrubs
2749                   match_veg_wall(m) = 10  ! shrubs and interrupted woodlands in Z01
2750                CASE ( 16 )  ! deciduous shrubs
2751                   match_veg_wall(m) = 10  ! shrubs and interrupted woodlands in Z01
2752                CASE ( 17 )  ! mixed forest/woodland
2753                   match_veg_wall(m) = 5  ! mixed broadleaf and needleleaf trees in Z01
2754                CASE ( 18 )  ! interrupted forest
2755                   match_veg_wall(m) = 10  ! shrubs and interrupted woodlands in Z01
2756             END SELECT
2757          ENDIF
2758!
2759!--       Pavement (LSM):
2760          IF ( surf%frac(ind_pav_green,m) > 0 )  THEN
2761             pav_type_palm = surf%pavement_type(m)
2762             IF ( pav_type_palm == 0 )  THEN  ! error
2763                message_string = 'No pavement type defined.'
2764                CALL message( 'salsa_mod: match_sm_zhang', 'PA0615', 1, 2, 0, 6, 0 )
2765             ELSE
2766                match_pav_green(m) = 15  ! urban in Z01
2767             ENDIF
2768          ENDIF
2769!
2770!--       Water (LSM):
2771          IF ( surf%frac(ind_wat_win,m) > 0 )  THEN
2772             wat_type_palm = surf%water_type(m)
2773             IF ( wat_type_palm == 0 )  THEN  ! error
2774                message_string = 'No water type defined.'
2775                CALL message( 'salsa_mod: match_sm_zhang', 'PA0616', 1, 2, 0, 6, 0 )
2776             ELSEIF ( wat_type_palm == 3 )  THEN
2777                match_wat_win(m) = 14  ! ocean in Z01
2778             ELSEIF ( wat_type_palm == 1  .OR.  wat_type_palm == 2 .OR.  wat_type_palm == 4        &
2779                      .OR.  wat_type_palm == 5  )  THEN
2780                match_wat_win(m) = 13  ! inland water in Z01
2781             ENDIF
2782          ENDIF
2783       ELSE
2784!
2785!--       Wall surfaces (USM):
2786          IF ( surf%frac(ind_veg_wall,m) > 0 )  THEN
2787             match_veg_wall(m) = 15  ! urban in Z01
2788          ENDIF
2789!
2790!--       Green walls and roofs (USM):
2791          IF ( surf%frac(ind_pav_green,m) > 0 )  THEN
2792             match_pav_green(m) =  6 ! (short) grass in Z01
2793          ENDIF
2794!
2795!--       Windows (USM):
2796          IF ( surf%frac(ind_wat_win,m) > 0 )  THEN
2797             match_wat_win(m) = 15  ! urban in Z01
2798          ENDIF
2799       ENDIF
2800
2801    ENDDO
2802
2803 END SUBROUTINE match_sm_zhang
2804
2805!------------------------------------------------------------------------------!
2806! Description:
2807! ------------
2808!> Swapping of timelevels
2809!------------------------------------------------------------------------------!
2810 SUBROUTINE salsa_swap_timelevel( mod_count )
2811
2812    IMPLICIT NONE
2813
2814    INTEGER(iwp) ::  ib   !<
2815    INTEGER(iwp) ::  ic   !<
2816    INTEGER(iwp) ::  icc  !<
2817    INTEGER(iwp) ::  ig   !<
2818
2819    INTEGER(iwp), INTENT(IN) ::  mod_count  !<
2820
2821    IF ( time_since_reference_point >= skip_time_do_salsa )  THEN
2822
2823       SELECT CASE ( mod_count )
2824
2825          CASE ( 0 )
2826
2827             DO  ib = 1, nbins_aerosol
2828                aerosol_number(ib)%conc(nzb:nzt+1,nysg:nyng,nxlg:nxrg)   => nconc_1(:,:,:,ib)
2829                aerosol_number(ib)%conc_p(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => nconc_2(:,:,:,ib)
2830
2831                DO  ic = 1, ncomponents_mass
2832                   icc = ( ic-1 ) * nbins_aerosol + ib
2833                   aerosol_mass(icc)%conc(nzb:nzt+1,nysg:nyng,nxlg:nxrg)   => mconc_1(:,:,:,icc)
2834                   aerosol_mass(icc)%conc_p(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => mconc_2(:,:,:,icc)
2835                ENDDO
2836             ENDDO
2837
2838             IF ( .NOT. salsa_gases_from_chem )  THEN
2839                DO  ig = 1, ngases_salsa
2840                   salsa_gas(ig)%conc(nzb:nzt+1,nysg:nyng,nxlg:nxrg)   => gconc_1(:,:,:,ig)
2841                   salsa_gas(ig)%conc_p(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => gconc_2(:,:,:,ig)
2842                ENDDO
2843             ENDIF
2844
2845          CASE ( 1 )
2846
2847             DO  ib = 1, nbins_aerosol
2848                aerosol_number(ib)%conc(nzb:nzt+1,nysg:nyng,nxlg:nxrg)   => nconc_2(:,:,:,ib)
2849                aerosol_number(ib)%conc_p(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => nconc_1(:,:,:,ib)
2850                DO  ic = 1, ncomponents_mass
2851                   icc = ( ic-1 ) * nbins_aerosol + ib
2852                   aerosol_mass(icc)%conc(nzb:nzt+1,nysg:nyng,nxlg:nxrg)   => mconc_2(:,:,:,icc)
2853                   aerosol_mass(icc)%conc_p(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => mconc_1(:,:,:,icc)
2854                ENDDO
2855             ENDDO
2856
2857             IF ( .NOT. salsa_gases_from_chem )  THEN
2858                DO  ig = 1, ngases_salsa
2859                   salsa_gas(ig)%conc(nzb:nzt+1,nysg:nyng,nxlg:nxrg)   => gconc_2(:,:,:,ig)
2860                   salsa_gas(ig)%conc_p(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => gconc_1(:,:,:,ig)
2861                ENDDO
2862             ENDIF
2863
2864       END SELECT
2865
2866    ENDIF
2867
2868 END SUBROUTINE salsa_swap_timelevel
2869
2870
2871!------------------------------------------------------------------------------!
2872! Description:
2873! ------------
2874!> This routine reads the respective restart data.
2875!------------------------------------------------------------------------------!
2876 SUBROUTINE salsa_rrd_local( k, nxlf, nxlc, nxl_on_file, nxrf, nxrc, nxr_on_file, nynf, nync,      &
2877                             nyn_on_file, nysf, nysc, nys_on_file, tmp_3d, found )
2878
2879    USE control_parameters,                                                                        &
2880        ONLY:  length, restart_string
2881
2882    IMPLICIT NONE
2883
2884    INTEGER(iwp) ::  ib              !<
2885    INTEGER(iwp) ::  ic              !<
2886    INTEGER(iwp) ::  ig              !<
2887    INTEGER(iwp) ::  k               !<
2888    INTEGER(iwp) ::  nxlc            !<
2889    INTEGER(iwp) ::  nxlf            !<
2890    INTEGER(iwp) ::  nxl_on_file     !<
2891    INTEGER(iwp) ::  nxrc            !<
2892    INTEGER(iwp) ::  nxrf            !<
2893    INTEGER(iwp) ::  nxr_on_file     !<
2894    INTEGER(iwp) ::  nync            !<
2895    INTEGER(iwp) ::  nynf            !<
2896    INTEGER(iwp) ::  nyn_on_file     !<
2897    INTEGER(iwp) ::  nysc            !<
2898    INTEGER(iwp) ::  nysf            !<
2899    INTEGER(iwp) ::  nys_on_file     !<
2900
2901    LOGICAL, INTENT(OUT)  ::  found  !<
2902
2903    REAL(wp), &
2904       DIMENSION(nzb:nzt+1,nys_on_file-nbgp:nyn_on_file+nbgp,nxl_on_file-nbgp:nxr_on_file+nbgp) :: tmp_3d   !<
2905
2906    found = .FALSE.
2907
2908    IF ( read_restart_data_salsa )  THEN
2909
2910       SELECT CASE ( restart_string(1:length) )
2911
2912          CASE ( 'aerosol_mass' )
2913             DO  ic = 1, ncomponents_mass * nbins_aerosol
2914                IF ( k == 1 )  READ ( 13 ) tmp_3d
2915                aerosol_mass(ic)%conc(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) =                 &
2916                                                   tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
2917             ENDDO
2918             found = .TRUE.
2919
2920          CASE ( 'aerosol_number' )
2921             DO  ib = 1, nbins_aerosol
2922                IF ( k == 1 )  READ ( 13 ) tmp_3d
2923                aerosol_number(ib)%conc(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) =               &
2924                                                   tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
2925             ENDDO
2926             found = .TRUE.
2927
2928          CASE( 'salsa_gases_av' )
2929             IF ( .NOT. ALLOCATED( salsa_gases_av ) )  THEN
2930                ALLOCATE( salsa_gases_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg,ngases_salsa) )
2931             ENDIF
2932             DO  ig = 1, ngases_salsa
2933                IF ( k == 1 )  READ ( 13 ) tmp_3d
2934                salsa_gases_av(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp,ig) =                     &
2935                                                   tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
2936             ENDDO
2937             found = .TRUE.
2938
2939          CASE ( 'ldsa_av' )
2940             IF ( .NOT. ALLOCATED( ldsa_av ) )  ALLOCATE( ldsa_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
2941             IF ( k == 1 )  READ ( 13 ) tmp_3d
2942             ldsa_av(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) =                                  &
2943                                                   tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
2944             found = .TRUE.
2945
2946          CASE ( 'mbins_av' )
2947             IF ( .NOT. ALLOCATED( mbins_av ) )  THEN
2948                ALLOCATE( mbins_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg,nbins_aerosol) )
2949             ENDIF
2950             DO  ib = 1, nbins_aerosol
2951                IF ( k == 1 )  READ ( 13 ) tmp_3d
2952                mbins_av(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp,ib) =                           &
2953                                                   tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
2954                found = .TRUE.
2955             ENDDO
2956
2957          CASE ( 'nbins_av' )
2958             IF ( .NOT. ALLOCATED( nbins_av ) )  THEN
2959                ALLOCATE( nbins_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg,nbins_aerosol) )
2960             ENDIF
2961             DO  ib = 1, nbins_aerosol
2962                IF ( k == 1 )  READ ( 13 ) tmp_3d
2963                nbins_av(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp,ib) =                           &
2964                                                   tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
2965                found = .TRUE.
2966             ENDDO
2967
2968          CASE ( 'ntot_av' )
2969             IF ( .NOT. ALLOCATED( ntot_av ) )  ALLOCATE( ntot_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
2970             IF ( k == 1 )  READ ( 13 ) tmp_3d
2971             ntot_av(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) =                                  &
2972                                                   tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
2973             found = .TRUE.
2974
2975          CASE ( 'nufp_av' )
2976             IF ( .NOT. ALLOCATED( nufp_av ) )  ALLOCATE( nufp_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
2977             IF ( k == 1 )  READ ( 13 ) tmp_3d
2978             nufp_av(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) =                                  &
2979                                                   tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
2980             found = .TRUE.
2981
2982          CASE ( 'pm01_av' )
2983             IF ( .NOT. ALLOCATED( pm01_av ) )  ALLOCATE( pm01_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
2984             IF ( k == 1 )  READ ( 13 ) tmp_3d
2985             pm01_av(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) =                                  &
2986                                                   tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
2987             found = .TRUE.
2988
2989          CASE ( 'pm25_av' )
2990             IF ( .NOT. ALLOCATED( pm25_av ) )  ALLOCATE( pm25_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
2991             IF ( k == 1 )  READ ( 13 ) tmp_3d
2992             pm25_av(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) =                                  &
2993                                                   tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
2994             found = .TRUE.
2995
2996          CASE ( 'pm10_av' )
2997             IF ( .NOT. ALLOCATED( pm10_av ) )  ALLOCATE( pm10_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
2998             IF ( k == 1 )  READ ( 13 ) tmp_3d
2999             pm10_av(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) =                                  &
3000                                                   tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
3001             found = .TRUE.
3002
3003          CASE ( 's_mass_av' )
3004             IF ( .NOT. ALLOCATED( s_mass_av ) )  THEN
3005                ALLOCATE( s_mass_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg,ncomponents_mass) )
3006             ENDIF
3007             DO  ic = 1, ncomponents_mass
3008                IF ( k == 1 )  READ ( 13 ) tmp_3d
3009                s_mass_av(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp,ic) =                          &
3010                                                   tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
3011             ENDDO
3012             found = .TRUE.
3013
3014          CASE ( 's_h2o_av' )
3015             IF ( .NOT. ALLOCATED( s_h2o_av ) )  ALLOCATE( s_h2o_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
3016             IF ( k == 1 )  READ ( 13 ) tmp_3d
3017             s_h2o_av(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) =                                 &
3018                                                   tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
3019             found = .TRUE.
3020
3021          CASE ( 'salsa_gas' )
3022             IF ( .NOT. salsa_gases_from_chem )  THEN
3023                DO  ig = 1, ngases_salsa
3024                   IF ( k == 1 )  READ ( 13 ) tmp_3d
3025                   salsa_gas(ig)%conc(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) =                 &
3026                                                   tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
3027                ENDDO
3028                found = .TRUE.
3029             ENDIF
3030
3031          CASE DEFAULT
3032             found = .FALSE.
3033
3034       END SELECT
3035    ENDIF
3036
3037 END SUBROUTINE salsa_rrd_local
3038
3039!------------------------------------------------------------------------------!
3040! Description:
3041! ------------
3042!> This routine writes the respective restart data.
3043!> Note that the following input variables in PARIN have to be equal between
3044!> restart runs:
3045!>    listspec, nbin, nbin2, nf2a, ncc, mass_fracs_a, mass_fracs_b
3046!------------------------------------------------------------------------------!
3047 SUBROUTINE salsa_wrd_local
3048
3049    USE control_parameters,                                                                        &
3050        ONLY:  write_binary
3051
3052    IMPLICIT NONE
3053
3054    INTEGER(iwp) ::  ib   !<
3055    INTEGER(iwp) ::  ic   !<
3056    INTEGER(iwp) ::  ig  !<
3057
3058    IF ( write_binary  .AND.  write_binary_salsa )  THEN
3059
3060       CALL wrd_write_string( 'aerosol_mass' )
3061       DO  ic = 1, nbins_aerosol * ncomponents_mass
3062          WRITE ( 14 )  aerosol_mass(ic)%conc
3063       ENDDO
3064
3065       CALL wrd_write_string( 'aerosol_number' )
3066       DO  ib = 1, nbins_aerosol
3067          WRITE ( 14 )  aerosol_number(ib)%conc
3068       ENDDO
3069
3070       IF (  .NOT. salsa_gases_from_chem )  THEN
3071
3072          IF ( ALLOCATED( salsa_gases_av ) )  THEN
3073             CALL wrd_write_string( 'salsa_gases_av' )
3074             DO  ig = 1, ngases_salsa
3075                WRITE ( 14 )  salsa_gases_av(:,:,:,ig)
3076             ENDDO
3077          ENDIF
3078       ENDIF
3079
3080       IF ( ALLOCATED( ldsa_av ) )  THEN
3081       CALL wrd_write_string( 'ldsa_av' )
3082       WRITE ( 14 )  ldsa_av
3083       ENDIF
3084
3085       IF ( ALLOCATED( mbins_av ) )  THEN
3086          CALL wrd_write_string( 'mbins_av' )
3087          DO  ib = 1, nbins_aerosol
3088             WRITE ( 14 )  mbins_av(:,:,:,ib)
3089          ENDDO
3090       ENDIF
3091
3092       IF ( ALLOCATED( nbins_av ) )  THEN
3093          CALL wrd_write_string( 'nbins_av' )
3094          DO  ib = 1, nbins_aerosol
3095             WRITE ( 14 )  nbins_av(:,:,:,ib)
3096          ENDDO
3097       ENDIF
3098
3099       IF ( ALLOCATED( ldsa_av ) )  THEN
3100          CALL wrd_write_string( 'ntot_av' )
3101          WRITE ( 14 )  ntot_av
3102       ENDIF
3103
3104       IF ( ALLOCATED( nufp_av ) )  THEN
3105          CALL wrd_write_string( 'nufp_av' )
3106          WRITE ( 14 )  nufp_av
3107       ENDIF
3108
3109       IF ( ALLOCATED( pm01_av ) )  THEN
3110          CALL wrd_write_string( 'pm01_av' )
3111          WRITE ( 14 )  pm01_av
3112       ENDIF
3113
3114       IF ( ALLOCATED( pm25_av ) )  THEN
3115          CALL wrd_write_string( 'pm25_av' )
3116          WRITE ( 14 )  pm25_av
3117       ENDIF
3118
3119       IF ( ALLOCATED( pm10_av ) )  THEN
3120          CALL wrd_write_string( 'pm10_av' )
3121          WRITE ( 14 )  pm10_av
3122       ENDIF
3123
3124       IF ( ALLOCATED( s_mass_av ) )  THEN
3125          CALL wrd_write_string( 's_mass_av' )
3126          DO  ic = 1, ncomponents_mass
3127             WRITE ( 14 )  s_mass_av(:,:,:,ic)
3128          ENDDO
3129       ENDIF
3130
3131       IF ( ALLOCATED( s_h2o_av ) )  THEN
3132          CALL wrd_write_string( 's_h2o_av' )
3133          WRITE ( 14 )  s_h2o_av
3134       ENDIF
3135
3136       IF ( .NOT. salsa_gases_from_chem )  THEN
3137          CALL wrd_write_string( 'salsa_gas' )
3138          DO  ig = 1, ngases_salsa
3139             WRITE ( 14 )  salsa_gas(ig)%conc
3140          ENDDO
3141       ENDIF
3142
3143    ENDIF
3144
3145 END SUBROUTINE salsa_wrd_local
3146
3147!------------------------------------------------------------------------------!
3148! Description:
3149! ------------
3150!> Performs necessary unit and dimension conversion between the host model and
3151!> SALSA module, and calls the main SALSA routine.
3152!> Partially adobted form the original SALSA boxmodel version.
3153!> Now takes masses in as kg/kg from LES!! Converted to m3/m3 for SALSA
3154!> 05/2016 Juha: This routine is still pretty much in its original shape.
3155!>               It's dumb as a mule and twice as ugly, so implementation of
3156!>               an improved solution is necessary sooner or later.
3157!> Juha Tonttila, FMI, 2014
3158!> Jaakko Ahola, FMI, 2016
3159!> Only aerosol processes included, Mona Kurppa, UHel, 2017
3160!------------------------------------------------------------------------------!
3161 SUBROUTINE salsa_driver( i, j, prunmode )
3162
3163    USE arrays_3d,                                                                                 &
3164        ONLY: pt_p, q_p, u, v, w
3165
3166    USE plant_canopy_model_mod,                                                                    &
3167        ONLY: lad_s
3168
3169    USE surface_mod,                                                                               &
3170        ONLY:  surf_def_h, surf_def_v, surf_lsm_h, surf_lsm_v, surf_usm_h, surf_usm_v
3171
3172    IMPLICIT NONE
3173
3174    INTEGER(iwp) ::  endi    !< end index
3175    INTEGER(iwp) ::  ib      !< loop index
3176    INTEGER(iwp) ::  ic      !< loop index
3177    INTEGER(iwp) ::  ig      !< loop index
3178    INTEGER(iwp) ::  k_wall  !< vertical index of topography top
3179    INTEGER(iwp) ::  k       !< loop index
3180    INTEGER(iwp) ::  l       !< loop index
3181    INTEGER(iwp) ::  nc_h2o  !< index of H2O in the prtcl index table
3182    INTEGER(iwp) ::  ss      !< loop index
3183    INTEGER(iwp) ::  str     !< start index
3184    INTEGER(iwp) ::  vc      !< default index in prtcl
3185
3186    INTEGER(iwp), INTENT(in) ::  i         !< loop index
3187    INTEGER(iwp), INTENT(in) ::  j         !< loop index
3188    INTEGER(iwp), INTENT(in) ::  prunmode  !< 1: Initialization, 2: Spinup, 3: Regular runtime
3189
3190    REAL(wp) ::  cw_old  !< previous H2O mixing ratio
3191    REAL(wp) ::  flag    !< flag to mask topography grid points
3192    REAL(wp) ::  in_lad  !< leaf area density (m2/m3)
3193    REAL(wp) ::  in_rh   !< relative humidity
3194    REAL(wp) ::  zgso4   !< SO4
3195    REAL(wp) ::  zghno3  !< HNO3
3196    REAL(wp) ::  zgnh3   !< NH3
3197    REAL(wp) ::  zgocnv  !< non-volatile OC
3198    REAL(wp) ::  zgocsv  !< semi-volatile OC
3199
3200    REAL(wp), DIMENSION(nzb:nzt+1) ::  in_adn  !< air density (kg/m3)
3201    REAL(wp), DIMENSION(nzb:nzt+1) ::  in_cs   !< H2O sat. vapour conc.
3202    REAL(wp), DIMENSION(nzb:nzt+1) ::  in_cw   !< H2O vapour concentration
3203    REAL(wp), DIMENSION(nzb:nzt+1) ::  in_p    !< pressure (Pa)
3204    REAL(wp), DIMENSION(nzb:nzt+1) ::  in_t    !< temperature (K)
3205    REAL(wp), DIMENSION(nzb:nzt+1) ::  in_u    !< wind magnitude (m/s)
3206    REAL(wp), DIMENSION(nzb:nzt+1) ::  kvis    !< kinematic viscosity of air(m2/s)
3207    REAL(wp), DIMENSION(nzb:nzt+1) ::  ppm_to_nconc  !< Conversion factor from ppm to #/m3
3208
3209    REAL(wp), DIMENSION(nzb:nzt+1,nbins_aerosol) ::  schmidt_num  !< particle Schmidt number
3210    REAL(wp), DIMENSION(nzb:nzt+1,nbins_aerosol) ::  vd           !< particle fall seed (m/s)
3211
3212    TYPE(t_section), DIMENSION(nbins_aerosol) ::  lo_aero   !< additional variable for OpenMP
3213    TYPE(t_section), DIMENSION(nbins_aerosol) ::  aero_old  !< helper array
3214
3215    aero_old(:)%numc = 0.0_wp
3216    in_lad           = 0.0_wp
3217    in_u             = 0.0_wp
3218    kvis             = 0.0_wp
3219    lo_aero          = aero
3220    schmidt_num      = 0.0_wp
3221    vd               = 0.0_wp
3222    zgso4            = nclim
3223    zghno3           = nclim
3224    zgnh3            = nclim
3225    zgocnv           = nclim
3226    zgocsv           = nclim
3227!
3228!-- Aerosol number is always set, but mass can be uninitialized
3229    DO ib = 1, nbins_aerosol
3230       lo_aero(ib)%volc(:)  = 0.0_wp
3231       aero_old(ib)%volc(:) = 0.0_wp
3232    ENDDO
3233!
3234!-- Set the salsa runtime config (How to make this more efficient?)
3235    CALL set_salsa_runtime( prunmode )
3236!
3237!-- Calculate thermodynamic quantities needed in SALSA
3238    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 )
3239!
3240!-- Magnitude of wind: needed for deposition
3241    IF ( lsdepo )  THEN
3242       in_u(nzb+1:nzt) = SQRT( ( 0.5_wp * ( u(nzb+1:nzt,j,i) + u(nzb+1:nzt,j,i+1) ) )**2 +         &
3243                               ( 0.5_wp * ( v(nzb+1:nzt,j,i) + v(nzb+1:nzt,j+1,i) ) )**2 +         &
3244                               ( 0.5_wp * ( w(nzb:nzt-1,j,i) + w(nzb+1:nzt,j,  i) ) )**2 )
3245    ENDIF
3246!
3247!-- Calculate conversion factors for gas concentrations
3248    ppm_to_nconc(:) = for_ppm_to_nconc * in_p(:) / in_t(:)
3249!
3250!-- Determine topography-top index on scalar grid
3251    k_wall = k_topo_top(j,i)
3252
3253    DO k = nzb+1, nzt
3254!
3255!--    Predetermine flag to mask topography
3256       flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) )
3257!
3258!--    Wind velocity for dry depositon on vegetation
3259       IF ( lsdepo_pcm  .AND.  plant_canopy )  THEN
3260          in_lad = lad_s( MAX( k-k_wall,0 ),j,i)
3261       ENDIF
3262!
3263!--    For initialization and spinup, limit the RH with the parameter rhlim
3264       IF ( prunmode < 3 ) THEN
3265          in_cw(k) = MIN( in_cw(k), in_cs(k) * rhlim )
3266       ELSE
3267          in_cw(k) = in_cw(k)
3268       ENDIF
3269       cw_old = in_cw(k) !* in_adn(k)
3270!
3271!--    Set volume concentrations:
3272!--    Sulphate (SO4) or sulphuric acid H2SO4
3273       IF ( index_so4 > 0 )  THEN
3274          vc = 1
3275          str = ( index_so4-1 ) * nbins_aerosol + 1    ! start index
3276          endi = index_so4 * nbins_aerosol             ! end index
3277          ic = 1
3278          DO ss = str, endi
3279             lo_aero(ic)%volc(vc) = aerosol_mass(ss)%conc(k,j,i) / arhoh2so4
3280             ic = ic+1
3281          ENDDO
3282          aero_old(1:nbins_aerosol)%volc(vc) = lo_aero(1:nbins_aerosol)%volc(vc)
3283       ENDIF
3284!
3285!--    Organic carbon (OC) compounds
3286       IF ( index_oc > 0 )  THEN
3287          vc = 2
3288          str = ( index_oc-1 ) * nbins_aerosol + 1
3289          endi = index_oc * nbins_aerosol
3290          ic = 1
3291          DO ss = str, endi
3292             lo_aero(ic)%volc(vc) = aerosol_mass(ss)%conc(k,j,i) / arhooc
3293             ic = ic+1
3294          ENDDO
3295          aero_old(1:nbins_aerosol)%volc(vc) = lo_aero(1:nbins_aerosol)%volc(vc)
3296       ENDIF
3297!
3298!--    Black carbon (BC)
3299       IF ( index_bc > 0 )  THEN
3300          vc = 3
3301          str = ( index_bc-1 ) * nbins_aerosol + 1 + end_subrange_1a
3302          endi = index_bc * nbins_aerosol
3303          ic = 1 + end_subrange_1a
3304          DO ss = str, endi
3305             lo_aero(ic)%volc(vc) = aerosol_mass(ss)%conc(k,j,i) / arhobc
3306             ic = ic+1
3307          ENDDO
3308          aero_old(1:nbins_aerosol)%volc(vc) = lo_aero(1:nbins_aerosol)%volc(vc)
3309       ENDIF
3310!
3311!--    Dust (DU)
3312       IF ( index_du > 0 )  THEN
3313          vc = 4
3314          str = ( index_du-1 ) * nbins_aerosol + 1 + end_subrange_1a
3315          endi = index_du * nbins_aerosol
3316          ic = 1 + end_subrange_1a
3317          DO ss = str, endi
3318             lo_aero(ic)%volc(vc) = aerosol_mass(ss)%conc(k,j,i) / arhodu
3319             ic = ic+1
3320          ENDDO
3321          aero_old(1:nbins_aerosol)%volc(vc) = lo_aero(1:nbins_aerosol)%volc(vc)
3322       ENDIF
3323!
3324!--    Sea salt (SS)
3325       IF ( index_ss > 0 )  THEN
3326          vc = 5
3327          str = ( index_ss-1 ) * nbins_aerosol + 1 + end_subrange_1a
3328          endi = index_ss * nbins_aerosol
3329          ic = 1 + end_subrange_1a
3330          DO ss = str, endi
3331             lo_aero(ic)%volc(vc) = aerosol_mass(ss)%conc(k,j,i) / arhoss
3332             ic = ic+1
3333          ENDDO
3334          aero_old(1:nbins_aerosol)%volc(vc) = lo_aero(1:nbins_aerosol)%volc(vc)
3335       ENDIF
3336!
3337!--    Nitrate (NO(3-)) or nitric acid HNO3
3338       IF ( index_no > 0 )  THEN
3339          vc = 6
3340          str = ( index_no-1 ) * nbins_aerosol + 1 
3341          endi = index_no * nbins_aerosol
3342          ic = 1
3343          DO ss = str, endi
3344             lo_aero(ic)%volc(vc) = aerosol_mass(ss)%conc(k,j,i) / arhohno3
3345             ic = ic+1
3346          ENDDO
3347          aero_old(1:nbins_aerosol)%volc(vc) = lo_aero(1:nbins_aerosol)%volc(vc)
3348       ENDIF
3349!
3350!--    Ammonium (NH(4+)) or ammonia NH3
3351       IF ( index_nh > 0 )  THEN
3352          vc = 7
3353          str = ( index_nh-1 ) * nbins_aerosol + 1
3354          endi = index_nh * nbins_aerosol
3355          ic = 1
3356          DO ss = str, endi
3357             lo_aero(ic)%volc(vc) = aerosol_mass(ss)%conc(k,j,i) / arhonh3
3358             ic = ic+1
3359          ENDDO
3360          aero_old(1:nbins_aerosol)%volc(vc) = lo_aero(1:nbins_aerosol)%volc(vc)
3361       ENDIF
3362!
3363!--    Water (always used)
3364       nc_h2o = get_index( prtcl,'H2O' )
3365       vc = 8
3366       str = ( nc_h2o-1 ) * nbins_aerosol + 1
3367       endi = nc_h2o * nbins_aerosol
3368       ic = 1
3369       IF ( advect_particle_water )  THEN
3370          DO ss = str, endi
3371             lo_aero(ic)%volc(vc) = aerosol_mass(ss)%conc(k,j,i) / arhoh2o
3372             ic = ic+1
3373          ENDDO
3374       ELSE
3375         lo_aero(1:nbins_aerosol)%volc(vc) = mclim
3376       ENDIF
3377       aero_old(1:nbins_aerosol)%volc(vc) = lo_aero(1:nbins_aerosol)%volc(vc)
3378!
3379!--    Number concentrations (numc) and particle sizes
3380!--    (dwet = wet diameter, core = dry volume)
3381       DO  ib = 1, nbins_aerosol
3382          lo_aero(ib)%numc = aerosol_number(ib)%conc(k,j,i)
3383          aero_old(ib)%numc = lo_aero(ib)%numc
3384          IF ( lo_aero(ib)%numc > nclim )  THEN
3385             lo_aero(ib)%dwet = ( SUM( lo_aero(ib)%volc(:) ) / lo_aero(ib)%numc / api6 )**0.33333333_wp
3386             lo_aero(ib)%core = SUM( lo_aero(ib)%volc(1:7) ) / lo_aero(ib)%numc
3387          ELSE
3388             lo_aero(ib)%dwet = lo_aero(ib)%dmid
3389             lo_aero(ib)%core = api6 * ( lo_aero(ib)%dwet )**3
3390          ENDIF
3391       ENDDO
3392!
3393!--    Calculate the ambient sizes of particles by equilibrating soluble fraction of particles with
3394!--    water using the ZSR method.
3395       in_rh = in_cw(k) / in_cs(k)
3396       IF ( prunmode==1  .OR.  .NOT. advect_particle_water )  THEN
3397          CALL equilibration( in_rh, in_t(k), lo_aero, .TRUE. )
3398       ENDIF
3399!
3400!--    Gaseous tracer concentrations in #/m3
3401       IF ( salsa_gases_from_chem )  THEN
3402!
3403!--       Convert concentrations in ppm to #/m3
3404          zgso4  = chem_species(gas_index_chem(1))%conc(k,j,i) * ppm_to_nconc(k)
3405          zghno3 = chem_species(gas_index_chem(2))%conc(k,j,i) * ppm_to_nconc(k)
3406          zgnh3  = chem_species(gas_index_chem(3))%conc(k,j,i) * ppm_to_nconc(k)
3407          zgocnv = chem_species(gas_index_chem(4))%conc(k,j,i) * ppm_to_nconc(k)
3408          zgocsv = chem_species(gas_index_chem(5))%conc(k,j,i) * ppm_to_nconc(k)
3409       ELSE
3410          zgso4  = salsa_gas(1)%conc(k,j,i)
3411          zghno3 = salsa_gas(2)%conc(k,j,i)
3412          zgnh3  = salsa_gas(3)%conc(k,j,i)
3413          zgocnv = salsa_gas(4)%conc(k,j,i)
3414          zgocsv = salsa_gas(5)%conc(k,j,i)
3415       ENDIF
3416!
3417!--    Calculate aerosol processes:
3418!--    *********************************************************************************************
3419!
3420!--    Coagulation
3421       IF ( lscoag )   THEN
3422          CALL coagulation( lo_aero, dt_salsa, in_t(k), in_p(k) )
3423       ENDIF
3424!
3425!--    Condensation
3426       IF ( lscnd )   THEN
3427          CALL condensation( lo_aero, zgso4, zgocnv, zgocsv,  zghno3, zgnh3, in_cw(k), in_cs(k),   &
3428                             in_t(k), in_p(k), dt_salsa, prtcl )
3429       ENDIF
3430!
3431!--    Deposition
3432       IF ( lsdepo )  THEN
3433          CALL deposition( lo_aero, in_t(k), in_adn(k), in_u(k), in_lad, kvis(k), schmidt_num(k,:),&
3434                           vd(k,:) )
3435       ENDIF
3436!
3437!--    Size distribution bin update
3438       IF ( lsdistupdate )   THEN
3439          CALL distr_update( lo_aero )
3440       ENDIF
3441!--    *********************************************************************************************
3442
3443       IF ( lsdepo ) sedim_vd(k,j,i,:) = vd(k,:)
3444!
3445!--    Calculate changes in concentrations
3446       DO ib = 1, nbins_aerosol
3447          aerosol_number(ib)%conc(k,j,i) = aerosol_number(ib)%conc(k,j,i) + ( lo_aero(ib)%numc -   &
3448                                           aero_old(ib)%numc ) * flag
3449       ENDDO
3450
3451       IF ( index_so4 > 0 )  THEN
3452          vc = 1
3453          str = ( index_so4-1 ) * nbins_aerosol + 1
3454          endi = index_so4 * nbins_aerosol
3455          ic = 1
3456          DO ss = str, endi
3457             aerosol_mass(ss)%conc(k,j,i) = aerosol_mass(ss)%conc(k,j,i) + ( lo_aero(ic)%volc(vc) -&
3458                                            aero_old(ic)%volc(vc) ) * arhoh2so4 * flag
3459             ic = ic+1
3460          ENDDO
3461       ENDIF
3462
3463       IF ( index_oc > 0 )  THEN
3464          vc = 2
3465          str = ( index_oc-1 ) * nbins_aerosol + 1
3466          endi = index_oc * nbins_aerosol
3467          ic = 1
3468          DO ss = str, endi
3469             aerosol_mass(ss)%conc(k,j,i) = aerosol_mass(ss)%conc(k,j,i) + ( lo_aero(ic)%volc(vc) -&
3470                                            aero_old(ic)%volc(vc) ) * arhooc * flag
3471             ic = ic+1
3472          ENDDO
3473       ENDIF
3474
3475       IF ( index_bc > 0 )  THEN
3476          vc = 3
3477          str = ( index_bc-1 ) * nbins_aerosol + 1 + end_subrange_1a
3478          endi = index_bc * nbins_aerosol
3479          ic = 1 + end_subrange_1a
3480          DO ss = str, endi
3481             aerosol_mass(ss)%conc(k,j,i) = aerosol_mass(ss)%conc(k,j,i) + ( lo_aero(ic)%volc(vc) -&
3482                                            aero_old(ic)%volc(vc) ) * arhobc * flag
3483             ic = ic+1
3484          ENDDO
3485       ENDIF
3486
3487       IF ( index_du > 0 )  THEN
3488          vc = 4
3489          str = ( index_du-1 ) * nbins_aerosol + 1 + end_subrange_1a
3490          endi = index_du * nbins_aerosol
3491          ic = 1 + end_subrange_1a
3492          DO ss = str, endi
3493             aerosol_mass(ss)%conc(k,j,i) = aerosol_mass(ss)%conc(k,j,i) + ( lo_aero(ic)%volc(vc) -&
3494                                            aero_old(ic)%volc(vc) ) * arhodu * flag
3495             ic = ic+1
3496          ENDDO
3497       ENDIF
3498
3499       IF ( index_ss > 0 )  THEN
3500          vc = 5
3501          str = ( index_ss-1 ) * nbins_aerosol + 1 + end_subrange_1a
3502          endi = index_ss * nbins_aerosol
3503          ic = 1 + end_subrange_1a
3504          DO ss = str, endi
3505             aerosol_mass(ss)%conc(k,j,i) = aerosol_mass(ss)%conc(k,j,i) + ( lo_aero(ic)%volc(vc) -&
3506                                            aero_old(ic)%volc(vc) ) * arhoss * flag
3507             ic = ic+1
3508          ENDDO
3509       ENDIF
3510
3511       IF ( index_no > 0 )  THEN
3512          vc = 6
3513          str = ( index_no-1 ) * nbins_aerosol + 1
3514          endi = index_no * nbins_aerosol
3515          ic = 1
3516          DO ss = str, endi
3517             aerosol_mass(ss)%conc(k,j,i) = aerosol_mass(ss)%conc(k,j,i) + ( lo_aero(ic)%volc(vc) -&
3518                                            aero_old(ic)%volc(vc) ) * arhohno3 * flag
3519             ic = ic+1
3520          ENDDO
3521       ENDIF
3522
3523       IF ( index_nh > 0 )  THEN
3524          vc = 7
3525          str = ( index_nh-1 ) * nbins_aerosol + 1
3526          endi = index_nh * nbins_aerosol
3527          ic = 1
3528          DO ss = str, endi
3529             aerosol_mass(ss)%conc(k,j,i) = aerosol_mass(ss)%conc(k,j,i) + ( lo_aero(ic)%volc(vc) -&
3530                                            aero_old(ic)%volc(vc) ) * arhonh3 * flag
3531             ic = ic+1
3532          ENDDO
3533       ENDIF
3534
3535       IF ( advect_particle_water )  THEN
3536          nc_h2o = get_index( prtcl,'H2O' )
3537          vc = 8
3538          str = ( nc_h2o-1 ) * nbins_aerosol + 1
3539          endi = nc_h2o * nbins_aerosol
3540          ic = 1
3541          DO ss = str, endi
3542             aerosol_mass(ss)%conc(k,j,i) = aerosol_mass(ss)%conc(k,j,i) + ( lo_aero(ic)%volc(vc) -&
3543                                            aero_old(ic)%volc(vc) ) * arhoh2o * flag
3544             ic = ic+1
3545          ENDDO
3546          IF ( prunmode == 1 )  THEN
3547             nc_h2o = get_index( prtcl,'H2O' )
3548             vc = 8
3549             str = ( nc_h2o-1 ) * nbins_aerosol + 1
3550             endi = nc_h2o * nbins_aerosol
3551             ic = 1
3552             DO ss = str, endi
3553                aerosol_mass(ss)%init(k) = MAX( aerosol_mass(ss)%init(k), ( lo_aero(ic)%volc(vc) - &
3554                                                aero_old(ic)%volc(vc) ) * arhoh2o )
3555                IF ( k == nzb+1 )  THEN
3556                   aerosol_mass(ss)%init(k-1) = aerosol_mass(ss)%init(k)
3557                ELSEIF ( k == nzt  )  THEN
3558                   aerosol_mass(ss)%init(k+1) = aerosol_mass(ss)%init(k)
3559                   aerosol_mass(ss)%conc(k+1,j,i) = aerosol_mass(ss)%init(k)
3560                ENDIF
3561                ic = ic+1
3562             ENDDO
3563          ENDIF
3564       ENDIF
3565!
3566!--    Condensation of precursor gases
3567       IF ( lscndgas )  THEN
3568          IF ( salsa_gases_from_chem )  THEN
3569!
3570!--          SO4 (or H2SO4)
3571             ig = gas_index_chem(1)
3572             chem_species(ig)%conc(k,j,i) = chem_species(ig)%conc(k,j,i) + ( zgso4 /               &
3573                                            ppm_to_nconc(k) - chem_species(ig)%conc(k,j,i) ) * flag
3574!
3575!--          HNO3
3576             ig = gas_index_chem(2)
3577             chem_species(ig)%conc(k,j,i) = chem_species(ig)%conc(k,j,i) + ( zghno3 /              &
3578                                            ppm_to_nconc(k) - chem_species(ig)%conc(k,j,i) ) * flag
3579!
3580!--          NH3
3581             ig = gas_index_chem(3)
3582             chem_species(ig)%conc(k,j,i) = chem_species(ig)%conc(k,j,i) + ( zgnh3 /               &
3583                                            ppm_to_nconc(k) - chem_species(ig)%conc(k,j,i) ) * flag
3584!
3585!--          non-volatile OC
3586             ig = gas_index_chem(4)
3587             chem_species(ig)%conc(k,j,i) = chem_species(ig)%conc(k,j,i) + ( zgocnv /              &
3588                                            ppm_to_nconc(k) - chem_species(ig)%conc(k,j,i) ) * flag
3589!
3590!--          semi-volatile OC
3591             ig = gas_index_chem(5)
3592             chem_species(ig)%conc(k,j,i) = chem_species(ig)%conc(k,j,i) + ( zgocsv /              &
3593                                            ppm_to_nconc(k) - chem_species(ig)%conc(k,j,i) ) * flag
3594
3595          ELSE
3596!
3597!--          SO4 (or H2SO4)
3598             salsa_gas(1)%conc(k,j,i) = salsa_gas(1)%conc(k,j,i) + ( zgso4 -                       &
3599                                        salsa_gas(1)%conc(k,j,i) ) * flag
3600!
3601!--          HNO3
3602             salsa_gas(2)%conc(k,j,i) = salsa_gas(2)%conc(k,j,i) + ( zghno3 -                      &
3603                                        salsa_gas(2)%conc(k,j,i) ) * flag
3604!
3605!--          NH3
3606             salsa_gas(3)%conc(k,j,i) = salsa_gas(3)%conc(k,j,i) + ( zgnh3 -                       &
3607                                        salsa_gas(3)%conc(k,j,i) ) * flag
3608!
3609!--          non-volatile OC
3610             salsa_gas(4)%conc(k,j,i) = salsa_gas(4)%conc(k,j,i) + ( zgocnv -                      &
3611                                        salsa_gas(4)%conc(k,j,i) ) * flag
3612!
3613!--          semi-volatile OC
3614             salsa_gas(5)%conc(k,j,i) = salsa_gas(5)%conc(k,j,i) + ( zgocsv -                      &
3615                                        salsa_gas(5)%conc(k,j,i) ) * flag
3616          ENDIF
3617       ENDIF
3618!
3619!--    Tendency of water vapour mixing ratio is obtained from the change in RH during SALSA run.
3620!--    This releases heat and changes pt. Assumes no temperature change during SALSA run.
3621!--    q = r / (1+r), Euler method for integration
3622!
3623       IF ( feedback_to_palm )  THEN
3624          q_p(k,j,i) = q_p(k,j,i) + 1.0_wp / ( in_cw(k) * in_adn(k) + 1.0_wp )**2 *                &
3625                       ( in_cw(k) - cw_old ) * in_adn(k) * flag
3626          pt_p(k,j,i) = pt_p(k,j,i) + alv / c_p * ( in_cw(k) - cw_old ) * in_adn(k) / ( in_cw(k) / &
3627                        in_adn(k) + 1.0_wp )**2 * pt_p(k,j,i) / in_t(k) * flag
3628       ENDIF
3629
3630    ENDDO   ! k
3631
3632!
3633!-- Set surfaces and wall fluxes due to deposition
3634    IF ( lsdepo  .AND.  lsdepo_surf  .AND.  prunmode == 3 )  THEN
3635       IF ( .NOT. land_surface  .AND.  .NOT. urban_surface )  THEN
3636          CALL depo_surf( i, j, surf_def_h(0), vd, schmidt_num, kvis, in_u, .TRUE. )
3637          DO  l = 0, 3
3638             CALL depo_surf( i, j, surf_def_v(l), vd, schmidt_num, kvis, in_u, .FALSE. )
3639          ENDDO
3640       ELSE
3641          CALL depo_surf( i, j, surf_usm_h, vd, schmidt_num, kvis, in_u, .TRUE., usm_to_depo_h )
3642          DO  l = 0, 3
3643             CALL depo_surf( i, j, surf_usm_v(l), vd, schmidt_num, kvis, in_u, .FALSE.,            &
3644                             usm_to_depo_v(l) )
3645          ENDDO
3646          CALL depo_surf( i, j, surf_lsm_h, vd, schmidt_num, kvis, in_u, .TRUE., lsm_to_depo_h )
3647          DO  l = 0, 3
3648             CALL depo_surf( i, j, surf_lsm_v(l), vd, schmidt_num, kvis, in_u, .FALSE.,            &
3649                             lsm_to_depo_v(l) )
3650          ENDDO
3651       ENDIF
3652    ENDIF
3653
3654    IF ( prunmode < 3 )  THEN
3655       !$OMP MASTER
3656       aero = lo_aero
3657       !$OMP END MASTER
3658    END IF
3659
3660 END SUBROUTINE salsa_driver
3661
3662!------------------------------------------------------------------------------!
3663! Description:
3664! ------------
3665!> Set logical switches according to the salsa_parameters options.
3666!> Juha Tonttila, FMI, 2014
3667!> Only aerosol processes included, Mona Kurppa, UHel, 2017
3668!------------------------------------------------------------------------------!
3669 SUBROUTINE set_salsa_runtime( prunmode )
3670
3671    IMPLICIT NONE
3672
3673    INTEGER(iwp), INTENT(in) ::  prunmode
3674
3675    SELECT CASE(prunmode)
3676
3677       CASE(1) !< Initialization
3678          lscoag       = .FALSE.
3679          lscnd        = .FALSE.
3680          lscndgas     = .FALSE.
3681          lscndh2oae   = .FALSE.
3682          lsdepo       = .FALSE.
3683          lsdepo_pcm   = .FALSE.
3684          lsdepo_surf  = .FALSE.
3685          lsdistupdate = .TRUE.
3686          lspartition  = .FALSE.
3687
3688       CASE(2)  !< Spinup period
3689          lscoag      = ( .FALSE. .AND. nlcoag   )
3690          lscnd       = ( .TRUE.  .AND. nlcnd    )
3691          lscndgas    = ( .TRUE.  .AND. nlcndgas )
3692          lscndh2oae  = ( .TRUE.  .AND. nlcndh2oae )
3693
3694       CASE(3)  !< Run
3695          lscoag       = nlcoag
3696          lscnd        = nlcnd
3697          lscndgas     = nlcndgas
3698          lscndh2oae   = nlcndh2oae
3699          lsdepo       = nldepo
3700          lsdepo_pcm   = nldepo_pcm
3701          lsdepo_surf  = nldepo_surf
3702          lsdistupdate = nldistupdate
3703    END SELECT
3704
3705
3706 END SUBROUTINE set_salsa_runtime
3707 
3708!------------------------------------------------------------------------------!
3709! Description:
3710! ------------
3711!> Calculates the absolute temperature (using hydrostatic pressure), saturation
3712!> vapour pressure and mixing ratio over water, relative humidity and air
3713!> density needed in the SALSA model.
3714!> NOTE, no saturation adjustment takes place -> the resulting water vapour
3715!> mixing ratio can be supersaturated, allowing the microphysical calculations
3716!> in SALSA.
3717!
3718!> Juha Tonttila, FMI, 2014 (original SALSAthrm)
3719!> Mona Kurppa, UHel, 2017 (adjustment for PALM and only aerosol processes)
3720!------------------------------------------------------------------------------!
3721 SUBROUTINE salsa_thrm_ij( i, j, p_ij, temp_ij, cw_ij, cs_ij, adn_ij )
3722
3723    USE arrays_3d,                                                                                 &
3724        ONLY: pt, q, zu
3725
3726    USE basic_constants_and_equations_mod,                                                         &
3727        ONLY:  barometric_formula, exner_function, ideal_gas_law_rho, magnus
3728
3729    IMPLICIT NONE
3730
3731    INTEGER(iwp), INTENT(in) ::  i  !<
3732    INTEGER(iwp), INTENT(in) ::  j  !<
3733
3734    REAL(wp) ::  t_surface  !< absolute surface temperature (K)
3735
3736    REAL(wp), DIMENSION(nzb:nzt+1) ::  e_s  !< saturation vapour pressure over water (Pa)
3737
3738    REAL(wp), DIMENSION(:), INTENT(inout) ::  adn_ij   !< air density (kg/m3)
3739    REAL(wp), DIMENSION(:), INTENT(inout) ::  p_ij     !< air pressure (Pa)
3740    REAL(wp), DIMENSION(:), INTENT(inout) ::  temp_ij  !< air temperature (K)
3741
3742    REAL(wp), DIMENSION(:), INTENT(inout), OPTIONAL ::  cw_ij  !< water vapour concentration (kg/m3)
3743    REAL(wp), DIMENSION(:), INTENT(inout), OPTIONAL ::  cs_ij  !< saturation water vap. conc.(kg/m3)
3744!
3745!-- Pressure p_ijk (Pa) = hydrostatic pressure
3746    t_surface = pt_surface * exner_function( surface_pressure * 100.0_wp )
3747    p_ij(:) = barometric_formula( zu, t_surface, surface_pressure * 100.0_wp )
3748!
3749!-- Absolute ambient temperature (K)
3750    temp_ij(:) = pt(:,j,i) * exner_function( p_ij(:) )
3751!
3752!-- Air density
3753    adn_ij(:) = ideal_gas_law_rho( p_ij(:), temp_ij(:) )
3754!
3755!-- Water vapour concentration r_v (kg/m3)
3756    IF ( PRESENT( cw_ij ) )  THEN
3757       cw_ij(:) = ( q(:,j,i) / ( 1.0_wp - q(:,j,i) ) ) * adn_ij(:)
3758    ENDIF
3759!
3760!-- Saturation mixing ratio r_s (kg/kg) from vapour pressure at temp (Pa)
3761    IF ( PRESENT( cs_ij ) )  THEN
3762       e_s(:) = 611.0_wp * EXP( alv_d_rv * ( 3.6609E-3_wp - 1.0_wp /           &
3763                temp_ij(:) ) )! magnus( temp_ij(:) )
3764       cs_ij(:) = ( 0.622_wp * e_s / ( p_ij(:) - e_s(:) ) ) * adn_ij(:)
3765    ENDIF
3766
3767 END SUBROUTINE salsa_thrm_ij
3768
3769!------------------------------------------------------------------------------!
3770! Description:
3771! ------------
3772!> Calculates ambient sizes of particles by equilibrating soluble fraction of
3773!> particles with water using the ZSR method (Stokes and Robinson, 1966).
3774!> Method:
3775!> Following chemical components are assumed water-soluble
3776!> - (ammonium) sulphate (100%)
3777!> - sea salt (100 %)
3778!> - organic carbon (epsoc * 100%)
3779!> Exact thermodynamic considerations neglected.
3780!> - If particles contain no sea salt, calculation according to sulphate
3781!>   properties
3782!> - If contain sea salt but no sulphate, calculation according to sea salt
3783!>   properties
3784!> - If contain both sulphate and sea salt -> the molar fraction of these
3785!>   compounds determines which one of them is used as the basis of calculation.
3786!> If sulphate and sea salt coexist in a particle, it is assumed that the Cl is
3787!> replaced by sulphate; thus only either sulphate + organics or sea salt +
3788!> organics is included in the calculation of soluble fraction.
3789!> Molality parameterizations taken from Table 1 of Tang: Thermodynamic and
3790!> optical properties of mixed-salt aerosols of atmospheric importance,
3791!> J. Geophys. Res., 102 (D2), 1883-1893 (1997)
3792!
3793!> Coded by:
3794!> Hannele Korhonen (FMI) 2005
3795!> Harri Kokkola (FMI) 2006
3796!> Matti Niskanen(FMI) 2012
3797!> Anton Laakso  (FMI) 2013
3798!> Modified for the new aerosol datatype, Juha Tonttila (FMI) 2014
3799!
3800!> fxm: should sea salt form a solid particle when prh is very low (even though
3801!> it could be mixed with e.g. sulphate)?
3802!> fxm: crashes if no sulphate or sea salt
3803!> fxm: do we really need to consider Kelvin effect for subrange 2
3804!------------------------------------------------------------------------------!
3805 SUBROUTINE equilibration( prh, ptemp, paero, init )
3806
3807    IMPLICIT NONE
3808
3809    INTEGER(iwp) :: ib      !< loop index
3810    INTEGER(iwp) :: counti  !< loop index
3811
3812    LOGICAL, INTENT(in) ::  init   !< TRUE: Initialization, FALSE: Normal runtime: update water
3813                                   !< content only for 1a
3814
3815    REAL(wp) ::  zaw      !< water activity [0-1]
3816    REAL(wp) ::  zcore    !< Volume of dry particle
3817    REAL(wp) ::  zdold    !< Old diameter
3818    REAL(wp) ::  zdwet    !< Wet diameter or mean droplet diameter
3819    REAL(wp) ::  zke      !< Kelvin term in the Köhler equation
3820    REAL(wp) ::  zlwc     !< liquid water content [kg/m3-air]
3821    REAL(wp) ::  zrh      !< Relative humidity
3822
3823    REAL(wp), DIMENSION(maxspec) ::  zbinmol  !< binary molality of each components (mol/kg)
3824    REAL(wp), DIMENSION(maxspec) ::  zvpart   !< volume of chem. compounds in one particle
3825
3826    REAL(wp), INTENT(in) ::  prh    !< relative humidity [0-1]
3827    REAL(wp), INTENT(in) ::  ptemp  !< temperature (K)
3828
3829    TYPE(t_section), DIMENSION(nbins_aerosol), INTENT(inout) ::  paero  !< aerosol properties
3830
3831    zaw       = 0.0_wp
3832    zlwc      = 0.0_wp
3833!
3834!-- Relative humidity:
3835    zrh = prh
3836    zrh = MAX( zrh, 0.05_wp )
3837    zrh = MIN( zrh, 0.98_wp)
3838!
3839!-- 1) Regime 1: sulphate and partly water-soluble OC. Done for every CALL
3840    DO  ib = start_subrange_1a, end_subrange_1a   ! size bin
3841
3842       zbinmol = 0.0_wp
3843       zdold   = 1.0_wp
3844       zke     = 1.02_wp
3845
3846       IF ( paero(ib)%numc > nclim )  THEN
3847!
3848!--       Volume in one particle
3849          zvpart = 0.0_wp
3850          zvpart(1:2) = paero(ib)%volc(1:2) / paero(ib)%numc
3851          zvpart(6:7) = paero(ib)%volc(6:7) / paero(ib)%numc
3852!
3853!--       Total volume and wet diameter of one dry particle
3854          zcore = SUM( zvpart(1:2) )
3855          zdwet = paero(ib)%dwet
3856
3857          counti = 0
3858          DO  WHILE ( ABS( zdwet / zdold - 1.0_wp ) > 1.0E-2_wp )
3859
3860             zdold = MAX( zdwet, 1.0E-20_wp )
3861             zaw = MAX( 1.0E-3_wp, zrh / zke ) ! To avoid underflow
3862!
3863!--          Binary molalities (mol/kg):
3864!--          Sulphate
3865             zbinmol(1) = 1.1065495E+2_wp - 3.6759197E+2_wp * zaw + 5.0462934E+2_wp * zaw**2 -     &
3866                          3.1543839E+2_wp * zaw**3 + 6.770824E+1_wp  * zaw**4
3867!--          Organic carbon
3868             zbinmol(2) = 1.0_wp / ( zaw * amh2o ) - 1.0_wp / amh2o
3869!--          Nitric acid
3870             zbinmol(6) = 2.306844303E+1_wp - 3.563608869E+1_wp * zaw - 6.210577919E+1_wp * zaw**2 &
3871                          + 5.510176187E+2_wp * zaw**3 - 1.460055286E+3_wp * zaw**4                &
3872                          + 1.894467542E+3_wp * zaw**5 - 1.220611402E+3_wp * zaw**6                &
3873                          + 3.098597737E+2_wp * zaw**7
3874!
3875!--          Calculate the liquid water content (kg/m3-air) using ZSR (see e.g. Eq. 10.98 in
3876!--          Seinfeld and Pandis (2006))
3877             zlwc = ( paero(ib)%volc(1) * ( arhoh2so4 / amh2so4 ) ) / zbinmol(1) +                 &
3878                    epsoc * paero(ib)%volc(2) * ( arhooc / amoc ) / zbinmol(2) +                   &
3879                    ( paero(ib)%volc(6) * ( arhohno3/amhno3 ) ) / zbinmol(6)
3880!
3881!--          Particle wet diameter (m)
3882             zdwet = ( zlwc / paero(ib)%numc / arhoh2o / api6 + ( SUM( zvpart(6:7) ) / api6 ) +    &
3883                       zcore / api6 )**0.33333333_wp
3884!
3885!--          Kelvin effect (Eq. 10.85 in in Seinfeld and Pandis (2006)). Avoid
3886!--          overflow.
3887             zke = EXP( MIN( 50.0_wp, 4.0_wp * surfw0 * amvh2so4 / ( abo * ptemp *  zdwet ) ) )
3888
3889             counti = counti + 1
3890             IF ( counti > 1000 )  THEN
3891                message_string = 'Subrange 1: no convergence!'
3892                CALL message( 'salsa_mod: equilibration', 'PA0617', 1, 2, 0, 6, 0 )
3893             ENDIF
3894          ENDDO
3895!
3896!--       Instead of lwc, use the volume concentration of water from now on
3897!--       (easy to convert...)
3898          paero(ib)%volc(8) = zlwc / arhoh2o
3899!
3900!--       If this is initialization, update the core and wet diameter
3901          IF ( init )  THEN
3902             paero(ib)%dwet = zdwet
3903             paero(ib)%core = zcore
3904          ENDIF
3905
3906       ELSE
3907!--       If initialization
3908!--       1.2) empty bins given bin average values
3909          IF ( init )  THEN
3910             paero(ib)%dwet = paero(ib)%dmid
3911             paero(ib)%core = api6 * paero(ib)%dmid**3
3912          ENDIF
3913
3914       ENDIF
3915
3916    ENDDO  ! ib
3917!
3918!-- 2) Regime 2a: sulphate, OC, BC and sea salt
3919!--    This is done only for initialization call, otherwise the water contents
3920!--    are computed via condensation
3921    IF ( init )  THEN
3922       DO  ib = start_subrange_2a, end_subrange_2b
3923!
3924!--       Initialize
3925          zke     = 1.02_wp
3926          zbinmol = 0.0_wp
3927          zdold   = 1.0_wp
3928!
3929!--       1) Particle properties calculated for non-empty bins
3930          IF ( paero(ib)%numc > nclim )  THEN
3931!
3932!--          Volume in one particle [fxm]
3933             zvpart = 0.0_wp
3934             zvpart(1:7) = paero(ib)%volc(1:7) / paero(ib)%numc
3935!
3936!--          Total volume and wet diameter of one dry particle [fxm]
3937             zcore = SUM( zvpart(1:5) )
3938             zdwet = paero(ib)%dwet
3939
3940             counti = 0
3941             DO  WHILE ( ABS( zdwet / zdold - 1.0_wp ) > 1.0E-12_wp )
3942
3943                zdold = MAX( zdwet, 1.0E-20_wp )
3944                zaw = zrh / zke
3945!
3946!--             Binary molalities (mol/kg):
3947!--             Sulphate
3948                zbinmol(1) = 1.1065495E+2_wp - 3.6759197E+2_wp * zaw + 5.0462934E+2_wp * zaw**2 -  &
3949                             3.1543839E+2_wp * zaw**3 + 6.770824E+1_wp  * zaw**4
3950!--             Organic carbon
3951                zbinmol(2) = 1.0_wp / ( zaw * amh2o ) - 1.0_wp / amh2o
3952!--             Nitric acid
3953                zbinmol(6) = 2.306844303E+1_wp          - 3.563608869E+1_wp * zaw -                &
3954                             6.210577919E+1_wp * zaw**2 + 5.510176187E+2_wp * zaw**3 -             &
3955                             1.460055286E+3_wp * zaw**4 + 1.894467542E+3_wp * zaw**5 -             &
3956                             1.220611402E+3_wp * zaw**6 + 3.098597737E+2_wp * zaw**7 
3957!--             Sea salt (natrium chloride)
3958                zbinmol(5) = 5.875248E+1_wp - 1.8781997E+2_wp * zaw + 2.7211377E+2_wp * zaw**2 -   &
3959                             1.8458287E+2_wp * zaw**3 + 4.153689E+1_wp  * zaw**4
3960!
3961!--             Calculate the liquid water content (kg/m3-air)
3962                zlwc = ( paero(ib)%volc(1) * ( arhoh2so4 / amh2so4 ) ) / zbinmol(1) +              &
3963                       epsoc * ( paero(ib)%volc(2) * ( arhooc / amoc ) ) / zbinmol(2) +            &
3964                       ( paero(ib)%volc(6) * ( arhohno3 / amhno3 ) ) / zbinmol(6) +                &
3965                       ( paero(ib)%volc(5) * ( arhoss / amss ) ) / zbinmol(5)
3966
3967!--             Particle wet radius (m)
3968                zdwet = ( zlwc / paero(ib)%numc / arhoh2o / api6 + ( SUM( zvpart(6:7) ) / api6 )  + &
3969                           zcore / api6 )**0.33333333_wp
3970!
3971!--             Kelvin effect (Eq. 10.85 in Seinfeld and Pandis (2006))
3972                zke = EXP( MIN( 50.0_wp, 4.0_wp * surfw0 * amvh2so4 / ( abo * zdwet * ptemp ) ) )
3973
3974                counti = counti + 1
3975                IF ( counti > 1000 )  THEN
3976                   message_string = 'Subrange 2: no convergence!'
3977                CALL message( 'salsa_mod: equilibration', 'PA0618', 1, 2, 0, 6, 0 )
3978                ENDIF
3979             ENDDO
3980!
3981!--          Liquid water content; instead of LWC use the volume concentration
3982             paero(ib)%volc(8) = zlwc / arhoh2o
3983             paero(ib)%dwet    = zdwet
3984             paero(ib)%core    = zcore
3985
3986          ELSE
3987!--          2.2) empty bins given bin average values
3988             paero(ib)%dwet = paero(ib)%dmid
3989             paero(ib)%core = api6 * paero(ib)%dmid**3
3990          ENDIF
3991
3992       ENDDO   ! ib
3993    ENDIF
3994
3995 END SUBROUTINE equilibration
3996
3997!------------------------------------------------------------------------------!
3998!> Description:
3999!> ------------
4000!> Calculation of the settling velocity vc (m/s) per aerosol size bin and
4001!> deposition on plant canopy (lsdepo_pcm).
4002!
4003!> Deposition is based on either the scheme presented in:
4004!> Zhang et al. (2001), Atmos. Environ. 35, 549-560 (includes collection due to
4005!> Brownian diffusion, impaction, interception and sedimentation; hereafter ZO1)
4006!> OR
4007!> Petroff & Zhang (2010), Geosci. Model Dev. 3, 753-769 (includes also
4008!> collection due to turbulent impaction, hereafter P10)
4009!
4010!> Equation numbers refer to equation in Jacobson (2005): Fundamentals of
4011!> Atmospheric Modeling, 2nd Edition.
4012!
4013!> Subroutine follows closely sedim_SALSA in UCLALES-SALSA written by Juha
4014!> Tonttila (KIT/FMI) and Zubair Maalick (UEF).
4015!> Rewritten to PALM by Mona Kurppa (UH), 2017.
4016!
4017!> Call for grid point i,j,k
4018!------------------------------------------------------------------------------!
4019
4020 SUBROUTINE deposition( paero, tk, adn, mag_u, lad, kvis, schmidt_num, vc )
4021
4022    USE plant_canopy_model_mod,                                                &
4023        ONLY:  canopy_drag_coeff
4024
4025    IMPLICIT NONE
4026
4027    INTEGER(iwp) ::  ib   !< loop index
4028    INTEGER(iwp) ::  ic   !< loop index
4029
4030    REAL(wp) ::  alpha             !< parameter, Table 3 in Z01
4031    REAL(wp) ::  avis              !< molecular viscocity of air (kg/(m*s))
4032    REAL(wp) ::  beta_im           !< parameter for turbulent impaction
4033    REAL(wp) ::  c_brownian_diff   !< coefficient for Brownian diffusion
4034    REAL(wp) ::  c_impaction       !< coefficient for inertial impaction
4035    REAL(wp) ::  c_interception    !< coefficient for interception
4036    REAL(wp) ::  c_turb_impaction  !< coefficient for turbulent impaction
4037    REAL(wp) ::  depo              !< deposition velocity (m/s)
4038    REAL(wp) ::  gamma             !< parameter, Table 3 in Z01
4039    REAL(wp) ::  lambda            !< molecular mean free path (m)
4040    REAL(wp) ::  mdiff             !< particle diffusivity coefficient
4041    REAL(wp) ::  par_a             !< parameter A for the characteristic radius of collectors,
4042                                   !< Table 3 in Z01
4043    REAL(wp) ::  par_l             !< obstacle characteristic dimension in P10
4044    REAL(wp) ::  pdn               !< particle density (kg/m3)
4045    REAL(wp) ::  ustar             !< friction velocity (m/s)
4046    REAL(wp) ::  va                !< thermal speed of an air molecule (m/s)
4047
4048    REAL(wp), INTENT(in) ::  adn    !< air density (kg/m3)
4049    REAL(wp), INTENT(in) ::  lad    !< leaf area density (m2/m3)
4050    REAL(wp), INTENT(in) ::  mag_u  !< wind velocity (m/s)
4051    REAL(wp), INTENT(in) ::  tk     !< abs.temperature (K)
4052
4053    REAL(wp), INTENT(inout) ::  kvis   !< kinematic viscosity of air (m2/s)
4054
4055    REAL(wp), DIMENSION(nbins_aerosol) ::  beta   !< Cunningham slip-flow correction factor
4056    REAL(wp), DIMENSION(nbins_aerosol) ::  Kn     !< Knudsen number
4057    REAL(wp), DIMENSION(nbins_aerosol) ::  zdwet  !< wet diameter (m)
4058
4059    REAL(wp), DIMENSION(:), INTENT(inout) ::  schmidt_num  !< particle Schmidt number
4060    REAL(wp), DIMENSION(:), INTENT(inout) ::  vc  !< critical fall speed i.e. settling velocity of
4061                                                  !< an aerosol particle (m/s)
4062
4063    TYPE(t_section), DIMENSION(nbins_aerosol), INTENT(inout) ::  paero  !< aerosol properties
4064!
4065!-- Initialise
4066    depo  = 0.0_wp
4067    pdn   = 1500.0_wp    ! default value
4068    ustar = 0.0_wp
4069!
4070!-- Molecular viscosity of air (Eq. 4.54)
4071    avis = 1.8325E-5_wp * ( 416.16_wp / ( tk + 120.0_wp ) ) * ( tk / 296.16_wp )**1.5_wp
4072!
4073!-- Kinematic viscosity (Eq. 4.55)
4074    kvis =  avis / adn
4075!
4076!-- Thermal velocity of an air molecule (Eq. 15.32)
4077    va = SQRT( 8.0_wp * abo * tk / ( pi * am_airmol ) )
4078!
4079!-- Mean free path (m) (Eq. 15.24)
4080    lambda = 2.0_wp * avis / ( adn * va )
4081!
4082!-- Particle wet diameter (m)
4083    zdwet = paero(:)%dwet
4084!
4085!-- Knudsen number (Eq. 15.23)
4086    Kn = MAX( 1.0E-2_wp, lambda / ( zdwet * 0.5_wp ) ) ! To avoid underflow
4087!
4088!-- Cunningham slip-flow correction (Eq. 15.30)
4089    beta = 1.0_wp + Kn * ( 1.249_wp + 0.42_wp * EXP( -0.87_wp / Kn ) )
4090!
4091!-- Critical fall speed i.e. settling velocity  (Eq. 20.4)
4092    vc = MIN( 1.0_wp, zdwet**2 * ( pdn - adn ) * g * beta / ( 18.0_wp * avis ) )
4093!
4094!-- Deposition on vegetation
4095    IF ( lsdepo_pcm  .AND.  plant_canopy  .AND.  lad > 0.0_wp )  THEN
4096!
4097!--    Parameters for the land use category 'deciduous broadleaf trees'(Table 3)
4098       alpha   = alpha_z01(depo_pcm_type_num)
4099       gamma   = gamma_z01(depo_pcm_type_num)
4100       par_a   = A_z01(depo_pcm_type_num, season_z01) * 1.0E-3_wp
4101!
4102!--    Deposition efficiencies from Table 1. Constants from Table 2.
4103       par_l            = l_p10(depo_pcm_type_num) * 0.01_wp
4104       c_brownian_diff  = c_b_p10(depo_pcm_type_num)
4105       c_interception   = c_in_p10(depo_pcm_type_num)
4106       c_impaction      = c_im_p10(depo_pcm_type_num)
4107       beta_im          = beta_im_p10(depo_pcm_type_num)
4108       c_turb_impaction = c_it_p10(depo_pcm_type_num)
4109
4110       DO  ib = 1, nbins_aerosol
4111
4112          IF ( paero(ib)%numc < ( 2.0_wp * nclim ) )  CYCLE
4113
4114!--       Particle diffusivity coefficient (Eq. 15.29)
4115          mdiff = ( abo * tk * beta(ib) ) / ( 3.0_wp * pi * avis * zdwet(ib) )
4116!
4117!--       Particle Schmidt number (Eq. 15.36)
4118          schmidt_num(ib) = kvis / mdiff
4119!
4120!--       Friction velocity for deposition on vegetation. Calculated following Prandtl (1925):
4121          ustar = SQRT( canopy_drag_coeff ) * mag_u
4122          SELECT CASE ( depo_pcm_par_num )
4123
4124             CASE ( 1 )   ! Zhang et al. (2001)
4125                CALL depo_vel_Z01( vc(ib), ustar, schmidt_num(ib), paero(ib)%dwet, alpha,  gamma,  &
4126                                   par_a, depo )
4127             CASE ( 2 )   ! Petroff & Zhang (2010)
4128                CALL depo_vel_P10( vc(ib), mag_u, ustar, kvis, schmidt_num(ib), paero(ib)%dwet,    &
4129                                   par_l, c_brownian_diff, c_interception, c_impaction, beta_im,   &
4130                                   c_turb_impaction, depo )
4131          END SELECT
4132!
4133!--       Calculate the change in concentrations
4134          paero(ib)%numc = paero(ib)%numc - depo * lad * paero(ib)%numc * dt_salsa
4135          DO  ic = 1, maxspec+1
4136             paero(ib)%volc(ic) = paero(ib)%volc(ic) - depo * lad * paero(ib)%volc(ic) * dt_salsa
4137          ENDDO
4138       ENDDO
4139
4140    ENDIF
4141
4142 END SUBROUTINE deposition
4143
4144!------------------------------------------------------------------------------!
4145! Description:
4146! ------------
4147!> Calculate deposition velocity (m/s) based on Zhan et al. (2001, case 1).
4148!------------------------------------------------------------------------------!
4149
4150 SUBROUTINE depo_vel_Z01( vc, ustar, schmidt_num, diameter, alpha, gamma, par_a, depo )
4151
4152    IMPLICIT NONE
4153
4154    REAL(wp) ::  rs                !< overall quasi-laminar resistance for particles
4155    REAL(wp) ::  stokes_num        !< Stokes number for smooth or bluff surfaces
4156
4157    REAL(wp), INTENT(in) ::  alpha        !< parameter, Table 3 in Z01
4158    REAL(wp), INTENT(in) ::  gamma        !< parameter, Table 3 in Z01
4159    REAL(wp), INTENT(in) ::  par_a        !< parameter A for the characteristic diameter of
4160                                          !< collectors, Table 3 in Z01
4161    REAL(wp), INTENT(in) ::  diameter     !< particle diameter
4162    REAL(wp), INTENT(in) ::  schmidt_num  !< particle Schmidt number
4163    REAL(wp), INTENT(in) ::  ustar        !< friction velocity (m/s)
4164    REAL(wp), INTENT(in) ::  vc           !< terminal velocity (m/s)
4165
4166    REAL(wp), INTENT(inout)  ::  depo     !< deposition efficiency (m/s)
4167
4168    IF ( par_a > 0.0_wp )  THEN
4169!
4170!--    Initialise
4171       rs = 0.0_wp
4172!
4173!--    Stokes number for vegetated surfaces (Seinfeld & Pandis (2006): Eq.19.24)
4174       stokes_num = vc * ustar / ( g * par_a )
4175!
4176!--    The overall quasi-laminar resistance for particles (Zhang et al., Eq. 5)
4177       rs = MAX( EPSILON( 1.0_wp ), ( 3.0_wp * ustar * EXP( -stokes_num**0.5_wp ) *                &
4178                 ( schmidt_num**( -gamma ) + ( stokes_num / ( alpha + stokes_num ) )**2 +          &
4179                 0.5_wp * ( diameter / par_a )**2 ) ) )
4180
4181       depo = rs + vc
4182
4183    ELSE
4184       depo = 0.0_wp
4185    ENDIF
4186
4187 END SUBROUTINE depo_vel_Z01
4188
4189!------------------------------------------------------------------------------!
4190! Description:
4191! ------------
4192!> Calculate deposition velocity (m/s) based on Petroff & Zhang (2010, case 2).
4193!------------------------------------------------------------------------------!
4194
4195 SUBROUTINE depo_vel_P10( vc, mag_u, ustar, kvis_a, schmidt_num, diameter, par_l, c_brownian_diff, &
4196                          c_interception, c_impaction, beta_im, c_turb_impaction, depo )
4197
4198    IMPLICIT NONE
4199
4200    REAL(wp) ::  stokes_num        !< Stokes number for smooth or bluff surfaces
4201    REAL(wp) ::  tau_plus          !< dimensionless particle relaxation time
4202    REAL(wp) ::  v_bd              !< deposition velocity due to Brownian diffusion
4203    REAL(wp) ::  v_im              !< deposition velocity due to impaction
4204    REAL(wp) ::  v_in              !< deposition velocity due to interception
4205    REAL(wp) ::  v_it              !< deposition velocity due to turbulent impaction
4206
4207    REAL(wp), INTENT(in) ::  beta_im           !< parameter for turbulent impaction
4208    REAL(wp), INTENT(in) ::  c_brownian_diff   !< coefficient for Brownian diffusion
4209    REAL(wp), INTENT(in) ::  c_impaction       !< coefficient for inertial impaction
4210    REAL(wp), INTENT(in) ::  c_interception    !< coefficient for interception
4211    REAL(wp), INTENT(in) ::  c_turb_impaction  !< coefficient for turbulent impaction
4212    REAL(wp), INTENT(in) ::  kvis_a       !< kinematic viscosity of air (m2/s)
4213    REAL(wp), INTENT(in) ::  mag_u        !< wind velocity (m/s)
4214    REAL(wp), INTENT(in) ::  par_l        !< obstacle characteristic dimension in P10
4215    REAL(wp), INTENT(in) ::  diameter       !< particle diameter
4216    REAL(wp), INTENT(in) ::  schmidt_num  !< particle Schmidt number
4217    REAL(wp), INTENT(in) ::  ustar        !< friction velocity (m/s)
4218    REAL(wp), INTENT(in) ::  vc           !< terminal velocity (m/s)
4219
4220    REAL(wp), INTENT(inout)  ::  depo     !< deposition efficiency (m/s)
4221
4222    IF ( par_l > 0.0_wp )  THEN
4223!
4224!--    Initialise
4225       tau_plus = 0.0_wp
4226       v_bd     = 0.0_wp
4227       v_im     = 0.0_wp
4228       v_in     = 0.0_wp
4229       v_it     = 0.0_wp
4230!
4231!--    Stokes number for vegetated surfaces (Seinfeld & Pandis (2006): Eq.19.24)
4232       stokes_num = vc * ustar / ( g * par_l )
4233!
4234!--    Non-dimensional relexation time of the particle on top of canopy
4235       tau_plus = vc * ustar**2 / ( kvis_a * g )
4236!
4237!--    Brownian diffusion
4238       v_bd = mag_u * c_brownian_diff * schmidt_num**( -0.66666666_wp ) *                          &
4239              ( mag_u * par_l / kvis_a )**( -0.5_wp )
4240!
4241!--    Interception
4242       v_in = mag_u * c_interception * diameter / par_l *                                          &
4243              ( 2.0_wp + LOG( 2.0_wp * par_l / diameter ) )
4244!
4245!--    Impaction: Petroff (2009) Eq. 18
4246       v_im = mag_u * c_impaction * ( stokes_num / ( stokes_num + beta_im ) )**2
4247!
4248!--    Turbulent impaction
4249       IF ( tau_plus < 20.0_wp )  THEN
4250          v_it = 2.5E-3_wp * c_turb_impaction * tau_plus**2
4251       ELSE
4252          v_it = c_turb_impaction
4253       ENDIF
4254
4255       depo = ( v_bd + v_in + v_im + v_it + vc )
4256
4257    ELSE
4258       depo = 0.0_wp
4259    ENDIF
4260
4261 END SUBROUTINE depo_vel_P10
4262
4263!------------------------------------------------------------------------------!
4264! Description:
4265! ------------
4266!> Calculate the dry deposition on horizontal and vertical surfaces. Implement
4267!> as a surface flux.
4268!> @todo aerodynamic resistance ignored for now (not important for
4269!        high-resolution simulations)
4270!------------------------------------------------------------------------------!
4271 SUBROUTINE depo_surf( i, j, surf, vc, schmidt_num, kvis, mag_u, norm, match_array )
4272
4273    USE arrays_3d,                                                                                 &
4274        ONLY: rho_air_zw
4275
4276    USE surface_mod,                                                                               &
4277        ONLY:  ind_pav_green, ind_veg_wall, ind_wat_win, surf_type
4278
4279    IMPLICIT NONE
4280
4281    INTEGER(iwp) ::  ib      !< loop index
4282    INTEGER(iwp) ::  ic      !< loop index
4283    INTEGER(iwp) ::  icc     !< additional loop index
4284    INTEGER(iwp) ::  k       !< loop index
4285    INTEGER(iwp) ::  m       !< loop index
4286    INTEGER(iwp) ::  surf_e  !< End index of surface elements at (j,i)-gridpoint
4287    INTEGER(iwp) ::  surf_s  !< Start index of surface elements at (j,i)-gridpoint
4288
4289    INTEGER(iwp), INTENT(in) ::  i  !< loop index
4290    INTEGER(iwp), INTENT(in) ::  j  !< loop index
4291
4292    LOGICAL, INTENT(in) ::  norm   !< to normalise or not
4293
4294    REAL(wp) ::  alpha             !< parameter, Table 3 in Z01
4295    REAL(wp) ::  beta_im           !< parameter for turbulent impaction
4296    REAL(wp) ::  c_brownian_diff   !< coefficient for Brownian diffusion
4297    REAL(wp) ::  c_impaction       !< coefficient for inertial impaction
4298    REAL(wp) ::  c_interception    !< coefficient for interception
4299    REAL(wp) ::  c_turb_impaction  !< coefficient for turbulent impaction
4300    REAL(wp) ::  gamma             !< parameter, Table 3 in Z01
4301    REAL(wp) ::  norm_fac          !< normalisation factor (usually air density)
4302    REAL(wp) ::  par_a             !< parameter A for the characteristic radius of collectors,
4303                                   !< Table 3 in Z01
4304    REAL(wp) ::  par_l             !< obstacle characteristic dimension in P10
4305    REAL(wp) ::  rs                !< the overall quasi-laminar resistance for particles
4306    REAL(wp) ::  tau_plus          !< dimensionless particle relaxation time
4307    REAL(wp) ::  v_bd              !< deposition velocity due to Brownian diffusion
4308    REAL(wp) ::  v_im              !< deposition velocity due to impaction
4309    REAL(wp) ::  v_in              !< deposition velocity due to interception
4310    REAL(wp) ::  v_it              !< deposition velocity due to turbulent impaction
4311
4312    REAL(wp), DIMENSION(nbins_aerosol) ::  depo      !< deposition efficiency
4313    REAL(wp), DIMENSION(nbins_aerosol) ::  depo_sum  !< sum of deposition efficiencies
4314
4315    REAL(wp), DIMENSION(:), INTENT(in) ::  kvis   !< kinematic viscosity of air (m2/s)
4316    REAL(wp), DIMENSION(:), INTENT(in) ::  mag_u  !< wind velocity (m/s)
4317
4318    REAL(wp), DIMENSION(:,:), INTENT(in) ::  schmidt_num   !< particle Schmidt number
4319    REAL(wp), DIMENSION(:,:), INTENT(in) ::  vc            !< terminal velocity (m/s)
4320
4321    TYPE(match_surface), INTENT(in), OPTIONAL ::  match_array  !< match the deposition module and
4322                                                               !< LSM/USM surfaces
4323    TYPE(surf_type), INTENT(inout) :: surf                     !< respective surface type
4324!
4325!-- Initialise
4326    depo     = 0.0_wp
4327    depo_sum = 0.0_wp
4328    rs       = 0.0_wp
4329    surf_s   = surf%start_index(j,i)
4330    surf_e   = surf%end_index(j,i)
4331    tau_plus = 0.0_wp
4332    v_bd     = 0.0_wp
4333    v_im     = 0.0_wp
4334    v_in     = 0.0_wp
4335    v_it     = 0.0_wp
4336!
4337!-- Model parameters for the land use category. If LSM or USM is applied, import
4338!-- characteristics. Otherwise, apply surface type "urban".
4339    alpha   = alpha_z01(luc_urban)
4340    gamma   = gamma_z01(luc_urban)
4341    par_a   = A_z01(luc_urban, season_z01) * 1.0E-3_wp
4342
4343    par_l            = l_p10(luc_urban) * 0.01_wp
4344    c_brownian_diff  = c_b_p10(luc_urban)
4345    c_interception   = c_in_p10(luc_urban)
4346    c_impaction      = c_im_p10(luc_urban)
4347    beta_im          = beta_im_p10(luc_urban)
4348    c_turb_impaction = c_it_p10(luc_urban)
4349
4350
4351    IF ( PRESENT( match_array ) )  THEN  ! land or urban surface model
4352
4353       DO  m = surf_s, surf_e
4354
4355          k = surf%k(m)
4356          norm_fac = 1.0_wp
4357
4358          IF ( norm )  norm_fac = rho_air_zw(k)  ! normalise vertical fluxes by air density
4359
4360          IF ( match_array%match_lupg(m) > 0 )  THEN
4361             alpha = alpha_z01( match_array%match_lupg(m) )
4362             gamma = gamma_z01( match_array%match_lupg(m) )
4363             par_a = A_z01( match_array%match_lupg(m), season_z01 ) * 1.0E-3_wp
4364
4365             beta_im          = beta_im_p10( match_array%match_lupg(m) )
4366             c_brownian_diff  = c_b_p10( match_array%match_lupg(m) )
4367             c_impaction      = c_im_p10( match_array%match_lupg(m) )
4368             c_interception   = c_in_p10( match_array%match_lupg(m) )
4369             c_turb_impaction = c_it_p10( match_array%match_lupg(m) )
4370             par_l            = l_p10( match_array%match_lupg(m) ) * 0.01_wp
4371
4372             DO  ib = 1, nbins_aerosol
4373                IF ( aerosol_number(ib)%conc(k,j,i) < ( 2.0_wp * nclim )  .OR.                     &
4374                     schmidt_num(k+1,ib) < 1.0_wp )  CYCLE
4375
4376                SELECT CASE ( depo_surf_par_num )
4377
4378                   CASE ( 1 )
4379                      CALL depo_vel_Z01( vc(k+1,ib), surf%us(m), schmidt_num(k+1,ib),              &
4380                                         ra_dry(k,j,i,ib), alpha, gamma, par_a, depo(ib) )
4381                   CASE ( 2 )
4382                      CALL depo_vel_P10( vc(k+1,ib), mag_u(k+1), surf%us(m), kvis(k+1),            &
4383                                         schmidt_num(k+1,ib), ra_dry(k,j,i,ib), par_l,             &
4384                                         c_brownian_diff, c_interception, c_impaction, beta_im,    &
4385                                         c_turb_impaction, depo(ib) )
4386                END SELECT
4387             ENDDO
4388             depo_sum = depo_sum + surf%frac(ind_pav_green,m) * depo
4389          ENDIF
4390
4391          IF ( match_array%match_luvw(m) > 0 )  THEN
4392             alpha = alpha_z01( match_array%match_luvw(m) )
4393             gamma = gamma_z01( match_array%match_luvw(m) )
4394             par_a = A_z01( match_array%match_luvw(m), season_z01 ) * 1.0E-3_wp
4395
4396             beta_im          = beta_im_p10( match_array%match_luvw(m) )
4397             c_brownian_diff  = c_b_p10( match_array%match_luvw(m) )
4398             c_impaction      = c_im_p10( match_array%match_luvw(m) )
4399             c_interception   = c_in_p10( match_array%match_luvw(m) )
4400             c_turb_impaction = c_it_p10( match_array%match_luvw(m) )
4401             par_l            = l_p10( match_array%match_luvw(m) ) * 0.01_wp
4402
4403             DO  ib = 1, nbins_aerosol
4404                IF ( aerosol_number(ib)%conc(k,j,i) < ( 2.0_wp * nclim )  .OR.                     &
4405                     schmidt_num(k+1,ib) < 1.0_wp )  CYCLE
4406
4407                SELECT CASE ( depo_surf_par_num )
4408
4409                   CASE ( 1 )
4410                      CALL depo_vel_Z01( vc(k+1,ib), surf%us(m), schmidt_num(k+1,ib),              &
4411                                         ra_dry(k,j,i,ib), alpha, gamma, par_a, depo(ib) )
4412                   CASE ( 2 )
4413                      CALL depo_vel_P10( vc(k+1,ib), mag_u(k+1), surf%us(m), kvis(k+1),            &
4414                                         schmidt_num(k+1,ib), ra_dry(k,j,i,ib), par_l,             &
4415                                         c_brownian_diff, c_interception, c_impaction, beta_im,    &
4416                                         c_turb_impaction, depo(ib) )
4417                END SELECT
4418             ENDDO
4419             depo_sum = depo_sum + surf%frac(ind_veg_wall,m) * depo
4420          ENDIF
4421
4422          IF ( match_array%match_luww(m) > 0 )  THEN
4423             alpha = alpha_z01( match_array%match_luww(m) )
4424             gamma = gamma_z01( match_array%match_luww(m) )
4425             par_a = A_z01( match_array%match_luww(m), season_z01 ) * 1.0E-3_wp
4426
4427             beta_im          = beta_im_p10( match_array%match_luww(m) )
4428             c_brownian_diff  = c_b_p10( match_array%match_luww(m) )
4429             c_impaction      = c_im_p10( match_array%match_luww(m) )
4430             c_interception   = c_in_p10( match_array%match_luww(m) )
4431             c_turb_impaction = c_it_p10( match_array%match_luww(m) )
4432             par_l            = l_p10( match_array%match_luww(m) ) * 0.01_wp
4433
4434             DO  ib = 1, nbins_aerosol
4435                IF ( aerosol_number(ib)%conc(k,j,i) < ( 2.0_wp * nclim )  .OR.                     &
4436                     schmidt_num(k+1,ib) < 1.0_wp )  CYCLE
4437
4438                SELECT CASE ( depo_surf_par_num )
4439
4440                   CASE ( 1 )
4441                      CALL depo_vel_Z01( vc(k+1,ib), surf%us(m), schmidt_num(k+1,ib),              &
4442                                         ra_dry(k,j,i,ib), alpha, gamma, par_a, depo(ib) )
4443                   CASE ( 2 )
4444                      CALL depo_vel_P10( vc(k+1,ib), mag_u(k+1), surf%us(m), kvis(k+1),            &
4445                                         schmidt_num(k+1,ib), ra_dry(k,j,i,ib), par_l,             &
4446                                         c_brownian_diff, c_interception, c_impaction, beta_im,    &
4447                                         c_turb_impaction, depo(ib) )
4448                END SELECT
4449             ENDDO
4450             depo_sum = depo_sum + surf%frac(ind_wat_win,m) * depo
4451          ENDIF
4452
4453          DO  ib = 1, nbins_aerosol
4454             IF ( aerosol_number(ib)%conc(k,j,i) < ( 2.0_wp * nclim ) )  CYCLE
4455!
4456!--          Calculate changes in surface fluxes due to dry deposition
4457             IF ( include_emission )  THEN
4458                surf%answs(m,ib) = aerosol_number(ib)%source(j,i) - MAX( 0.0_wp,                   &
4459                                   depo_sum(ib) * norm_fac * aerosol_number(ib)%conc(k,j,i) )
4460                DO  ic = 1, ncomponents_mass
4461                   icc = ( ic - 1 ) * nbins_aerosol + ib
4462                   surf%amsws(m,icc) = aerosol_mass(icc)%source(j,i) - MAX( 0.0_wp,                &
4463                                       depo_sum(ib) *  norm_fac * aerosol_mass(icc)%conc(k,j,i) )
4464                ENDDO  ! ic
4465             ELSE
4466                surf%answs(m,ib) = -depo_sum(ib) * norm_fac * aerosol_number(ib)%conc(k,j,i)
4467                DO  ic = 1, ncomponents_mass
4468                   icc = ( ic - 1 ) * nbins_aerosol + ib
4469                   surf%amsws(m,icc) = -depo_sum(ib) *  norm_fac * aerosol_mass(icc)%conc(k,j,i)
4470                ENDDO  ! ic
4471             ENDIF
4472          ENDDO  ! ib
4473
4474       ENDDO
4475
4476    ELSE  ! default surfaces
4477
4478       DO  m = surf_s, surf_e
4479
4480          k = surf%k(m)
4481          norm_fac = 1.0_wp
4482
4483          IF ( norm )  norm_fac = rho_air_zw(k)  ! normalise vertical fluxes by air density
4484
4485          DO  ib = 1, nbins_aerosol
4486             IF ( aerosol_number(ib)%conc(k,j,i) < ( 2.0_wp * nclim )  .OR.                        &
4487                  schmidt_num(k+1,ib) < 1.0_wp )  CYCLE
4488
4489             SELECT CASE ( depo_surf_par_num )
4490
4491                CASE ( 1 )
4492                   CALL depo_vel_Z01( vc(k+1,ib), surf%us(m), schmidt_num(k+1,ib),                 &
4493                                      ra_dry(k,j,i,ib), alpha, gamma, par_a, depo(ib) )
4494                CASE ( 2 )
4495                   CALL depo_vel_P10( vc(k+1,ib), mag_u(k+1), surf%us(m), kvis(k+1),               &
4496                                      schmidt_num(k+1,ib), ra_dry(k,j,i,ib), par_l,                &
4497                                      c_brownian_diff, c_interception, c_impaction, beta_im,       &
4498                                      c_turb_impaction, depo(ib) )
4499             END SELECT
4500!
4501!--          Calculate changes in surface fluxes due to dry deposition
4502             IF ( include_emission )  THEN
4503                surf%answs(m,ib) = aerosol_number(ib)%source(j,i) - MAX( 0.0_wp,                   &
4504                                   depo(ib) * norm_fac * aerosol_number(ib)%conc(k,j,i) )
4505                DO  ic = 1, ncomponents_mass
4506                   icc = ( ic - 1 ) * nbins_aerosol + ib
4507                   surf%amsws(m,icc) = aerosol_mass(icc)%source(j,i) - MAX( 0.0_wp,                &
4508                                       depo(ib) *  norm_fac * aerosol_mass(icc)%conc(k,j,i) )
4509                ENDDO  ! ic
4510             ELSE
4511                surf%answs(m,ib) = -depo(ib) * norm_fac * aerosol_number(ib)%conc(k,j,i)
4512                DO  ic = 1, ncomponents_mass
4513                   icc = ( ic - 1 ) * nbins_aerosol + ib
4514                   surf%amsws(m,icc) = -depo(ib) *  norm_fac * aerosol_mass(icc)%conc(k,j,i)
4515                ENDDO  ! ic
4516             ENDIF
4517          ENDDO  ! ib
4518       ENDDO
4519
4520    ENDIF
4521
4522 END SUBROUTINE depo_surf
4523
4524!------------------------------------------------------------------------------!
4525! Description:
4526! ------------
4527!> Calculates particle loss and change in size distribution due to (Brownian)
4528!> coagulation. Only for particles with dwet < 30 micrometres.
4529!
4530!> Method:
4531!> Semi-implicit, non-iterative method: (Jacobson, 1994)
4532!> Volume concentrations of the smaller colliding particles added to the bin of
4533!> the larger colliding particles. Start from first bin and use the updated
4534!> number and volume for calculation of following bins. NB! Our bin numbering
4535!> does not follow particle size in subrange 2.
4536!
4537!> Schematic for bin numbers in different subranges:
4538!>             1                            2
4539!>    +-------------------------------------------+
4540!>  a | 1 | 2 | 3 || 4 | 5 | 6 | 7 |  8 |  9 | 10||
4541!>  b |           ||11 |12 |13 |14 | 15 | 16 | 17||
4542!>    +-------------------------------------------+
4543!
4544!> Exact coagulation coefficients for each pressure level are scaled according
4545!> to current particle wet size (linear scaling).
4546!> Bins are organized in terms of the dry size of the condensation nucleus,
4547!> while coagulation kernell is calculated with the actual hydrometeor
4548!> size.
4549!
4550!> Called from salsa_driver
4551!> fxm: Process selection should be made smarter - now just lots of IFs inside
4552!>      loops
4553!
4554!> Coded by:
4555!> Hannele Korhonen (FMI) 2005
4556!> Harri Kokkola (FMI) 2006
4557!> Tommi Bergman (FMI) 2012
4558!> Matti Niskanen(FMI) 2012
4559!> Anton Laakso  (FMI) 2013
4560!> Juha Tonttila (FMI) 2014
4561!------------------------------------------------------------------------------!
4562 SUBROUTINE coagulation( paero, ptstep, ptemp, ppres )
4563
4564    IMPLICIT NONE
4565
4566    INTEGER(iwp) ::  index_2a !< corresponding bin in subrange 2a
4567    INTEGER(iwp) ::  index_2b !< corresponding bin in subrange 2b
4568    INTEGER(iwp) ::  ib       !< loop index
4569    INTEGER(iwp) ::  ll       !< loop index
4570    INTEGER(iwp) ::  mm       !< loop index
4571    INTEGER(iwp) ::  nn       !< loop index
4572
4573    REAL(wp) ::  pressi          !< pressure
4574    REAL(wp) ::  temppi          !< temperature
4575    REAL(wp) ::  zdpart_mm       !< diameter of particle (m)
4576    REAL(wp) ::  zdpart_nn       !< diameter of particle (m)
4577    REAL(wp) ::  zminusterm      !< coagulation loss in a bin (1/s)
4578
4579    REAL(wp), INTENT(in) ::  ppres  !< ambient pressure (Pa)
4580    REAL(wp), INTENT(in) ::  ptemp  !< ambient temperature (K)
4581    REAL(wp), INTENT(in) ::  ptstep !< time step (s)
4582
4583    REAL(wp), DIMENSION(nbins_aerosol) ::  zmpart     !< approximate mass of particles (kg)
4584    REAL(wp), DIMENSION(maxspec+1)     ::  zplusterm  !< coagulation gain in a bin (for each
4585                                                      !< chemical compound)
4586    REAL(wp), DIMENSION(nbins_aerosol,nbins_aerosol) ::  zcc  !< updated coagulation coeff. (m3/s)
4587
4588    TYPE(t_section), DIMENSION(nbins_aerosol), INTENT(inout) ::  paero  !< Aerosol properties
4589
4590    zdpart_mm = 0.0_wp
4591    zdpart_nn = 0.0_wp
4592!
4593!-- 1) Coagulation to coarse mode calculated in a simplified way:
4594!--    CoagSink ~ Dp in continuum subrange --> 'effective' number conc. of coarse particles
4595
4596!-- 2) Updating coagulation coefficients
4597!
4598!-- Aerosol mass (kg). Density of 1500 kg/m3 assumed
4599    zmpart(1:end_subrange_2b) = api6 * ( MIN( paero(1:end_subrange_2b)%dwet, 30.0E-6_wp )**3 )     &
4600                                * 1500.0_wp
4601    temppi = ptemp
4602    pressi = ppres
4603    zcc    = 0.0_wp
4604!
4605!-- Aero-aero coagulation
4606    DO  mm = 1, end_subrange_2b   ! smaller colliding particle
4607       IF ( paero(mm)%numc < ( 2.0_wp * nclim ) )  CYCLE
4608       DO  nn = mm, end_subrange_2b   ! larger colliding particle
4609          IF ( paero(nn)%numc < ( 2.0_wp * nclim ) )  CYCLE
4610
4611          zdpart_mm = MIN( paero(mm)%dwet, 30.0E-6_wp )     ! Limit to 30 um
4612          zdpart_nn = MIN( paero(nn)%dwet, 30.0E-6_wp )     ! Limit to 30 um
4613!
4614!--       Coagulation coefficient of particles (m3/s)
4615          zcc(mm,nn) = coagc( zdpart_mm, zdpart_nn, zmpart(mm), zmpart(nn), temppi, pressi )
4616          zcc(nn,mm) = zcc(mm,nn)
4617       ENDDO
4618    ENDDO
4619
4620!
4621!-- 3) New particle and volume concentrations after coagulation:
4622!--    Calculated according to Jacobson (2005) eq. 15.9
4623!
4624!-- Aerosols in subrange 1a:
4625    DO  ib = start_subrange_1a, end_subrange_1a
4626       IF ( paero(ib)%numc < ( 2.0_wp * nclim ) )  CYCLE
4627       zminusterm   = 0.0_wp
4628       zplusterm(:) = 0.0_wp
4629!
4630!--    Particles lost by coagulation with larger aerosols
4631       DO  ll = ib+1, end_subrange_2b
4632          zminusterm = zminusterm + zcc(ib,ll) * paero(ll)%numc
4633       ENDDO
4634!
4635!--    Coagulation gain in a bin: change in volume conc. (cm3/cm3):
4636       DO ll = start_subrange_1a, ib - 1
4637          zplusterm(1:2) = zplusterm(1:2) + zcc(ll,ib) * paero(ll)%volc(1:2)
4638          zplusterm(6:7) = zplusterm(6:7) + zcc(ll,ib) * paero(ll)%volc(6:7)
4639          zplusterm(8)   = zplusterm(8)   + zcc(ll,ib) * paero(ll)%volc(8)
4640       ENDDO
4641!
4642!--    Volume and number concentrations after coagulation update [fxm]
4643       paero(ib)%volc(1:2) = ( paero(ib)%volc(1:2) + ptstep * zplusterm(1:2) * paero(ib)%numc ) /  &
4644                            ( 1.0_wp + ptstep * zminusterm )
4645       paero(ib)%volc(6:8) = ( paero(ib)%volc(6:8) + ptstep * zplusterm(6:8) * paero(ib)%numc ) /  &
4646                            ( 1.0_wp + ptstep * zminusterm )
4647       paero(ib)%numc = paero(ib)%numc / ( 1.0_wp + ptstep * zminusterm + 0.5_wp * ptstep *        &
4648                        zcc(ib,ib) * paero(ib)%numc )
4649    ENDDO
4650!
4651!-- Aerosols in subrange 2a:
4652    DO  ib = start_subrange_2a, end_subrange_2a
4653       IF ( paero(ib)%numc < ( 2.0_wp * nclim ) )  CYCLE
4654       zminusterm   = 0.0_wp
4655       zplusterm(:) = 0.0_wp
4656!
4657!--    Find corresponding size bin in subrange 2b
4658       index_2b = ib - start_subrange_2a + start_subrange_2b
4659!
4660!--    Particles lost by larger particles in 2a
4661       DO  ll = ib+1, end_subrange_2a
4662          zminusterm = zminusterm + zcc(ib,ll) * paero(ll)%numc
4663       ENDDO
4664!
4665!--    Particles lost by larger particles in 2b
4666       IF ( .NOT. no_insoluble )  THEN
4667          DO  ll = index_2b+1, end_subrange_2b
4668             zminusterm = zminusterm + zcc(ib,ll) * paero(ll)%numc
4669          ENDDO
4670       ENDIF
4671!
4672!--    Particle volume gained from smaller particles in subranges 1, 2a and 2b
4673       DO  ll = start_subrange_1a, ib-1
4674          zplusterm(1:2) = zplusterm(1:2) + zcc(ll,ib) * paero(ll)%volc(1:2)
4675          zplusterm(6:8) = zplusterm(6:8) + zcc(ll,ib) * paero(ll)%volc(6:8)
4676       ENDDO
4677!
4678!--    Particle volume gained from smaller particles in 2a
4679!--    (Note, for components not included in the previous loop!)
4680       DO  ll = start_subrange_2a, ib-1
4681          zplusterm(3:5) = zplusterm(3:5) + zcc(ll,ib)*paero(ll)%volc(3:5)
4682       ENDDO
4683!
4684!--    Particle volume gained from smaller (and equal) particles in 2b
4685       IF ( .NOT. no_insoluble )  THEN
4686          DO  ll = start_subrange_2b, index_2b
4687             zplusterm(1:8) = zplusterm(1:8) + zcc(ll,ib) * paero(ll)%volc(1:8)
4688          ENDDO
4689       ENDIF
4690!
4691!--    Volume and number concentrations after coagulation update [fxm]
4692       paero(ib)%volc(1:8) = ( paero(ib)%volc(1:8) + ptstep * zplusterm(1:8) * paero(ib)%numc ) /  &
4693                            ( 1.0_wp + ptstep * zminusterm )
4694       paero(ib)%numc = paero(ib)%numc / ( 1.0_wp + ptstep * zminusterm + 0.5_wp * ptstep *        &
4695                        zcc(ib,ib) * paero(ib)%numc )
4696    ENDDO
4697!
4698!-- Aerosols in subrange 2b:
4699    IF ( .NOT. no_insoluble )  THEN
4700       DO  ib = start_subrange_2b, end_subrange_2b
4701          IF ( paero(ib)%numc < ( 2.0_wp * nclim ) )  CYCLE
4702          zminusterm   = 0.0_wp
4703          zplusterm(:) = 0.0_wp
4704!
4705!--       Find corresponding size bin in subsubrange 2a
4706          index_2a = ib - start_subrange_2b + start_subrange_2a
4707!
4708!--       Particles lost to larger particles in subranges 2b
4709          DO  ll = ib + 1, end_subrange_2b
4710             zminusterm = zminusterm + zcc(ib,ll) * paero(ll)%numc
4711          ENDDO
4712!
4713!--       Particles lost to larger and equal particles in 2a
4714          DO  ll = index_2a, end_subrange_2a
4715             zminusterm = zminusterm + zcc(ib,ll) * paero(ll)%numc
4716          ENDDO
4717!
4718!--       Particle volume gained from smaller particles in subranges 1 & 2a
4719          DO  ll = start_subrange_1a, index_2a - 1
4720             zplusterm(1:8) = zplusterm(1:8) + zcc(ll,ib) * paero(ll)%volc(1:8)
4721          ENDDO
4722!
4723!--       Particle volume gained from smaller particles in 2b
4724          DO  ll = start_subrange_2b, ib - 1
4725             zplusterm(1:8) = zplusterm(1:8) + zcc(ll,ib) * paero(ll)%volc(1:8)
4726          ENDDO
4727!
4728!--       Volume and number concentrations after coagulation update [fxm]
4729          paero(ib)%volc(1:8) = ( paero(ib)%volc(1:8) + ptstep * zplusterm(1:8) * paero(ib)%numc ) &
4730                                / ( 1.0_wp + ptstep * zminusterm )
4731          paero(ib)%numc = paero(ib)%numc / ( 1.0_wp + ptstep * zminusterm + 0.5_wp * ptstep *     &
4732                           zcc(ib,ib) * paero(ib)%numc )
4733       ENDDO
4734    ENDIF
4735
4736 END SUBROUTINE coagulation
4737
4738!------------------------------------------------------------------------------!
4739! Description:
4740! ------------
4741!> Calculation of coagulation coefficients. Extended version of the function
4742!> originally found in mo_salsa_init.
4743!
4744!> J. Tonttila, FMI, 05/2014
4745!------------------------------------------------------------------------------!
4746 REAL(wp) FUNCTION coagc( diam1, diam2, mass1, mass2, temp, pres )
4747
4748    IMPLICIT NONE
4749
4750    REAL(wp) ::  fmdist  !< distance of flux matching (m)
4751    REAL(wp) ::  knud_p  !< particle Knudsen number
4752    REAL(wp) ::  mdiam   !< mean diameter of colliding particles (m)
4753    REAL(wp) ::  mfp     !< mean free path of air molecules (m)
4754    REAL(wp) ::  visc    !< viscosity of air (kg/(m s))
4755
4756    REAL(wp), INTENT(in) ::  diam1  !< diameter of colliding particle 1 (m)
4757    REAL(wp), INTENT(in) ::  diam2  !< diameter of colliding particle 2 (m)
4758    REAL(wp), INTENT(in) ::  mass1  !< mass of colliding particle 1 (kg)
4759    REAL(wp), INTENT(in) ::  mass2  !< mass of colliding particle 2 (kg)
4760    REAL(wp), INTENT(in) ::  pres   !< ambient pressure (Pa?) [fxm]
4761    REAL(wp), INTENT(in) ::  temp   !< ambient temperature (K)
4762
4763    REAL(wp), DIMENSION (2) ::  beta    !< Cunningham correction factor
4764    REAL(wp), DIMENSION (2) ::  dfpart  !< particle diffusion coefficient (m2/s)
4765    REAL(wp), DIMENSION (2) ::  diam    !< diameters of particles (m)
4766    REAL(wp), DIMENSION (2) ::  flux    !< flux in continuum and free molec. regime (m/s)
4767    REAL(wp), DIMENSION (2) ::  knud    !< particle Knudsen number
4768    REAL(wp), DIMENSION (2) ::  mpart   !< masses of particles (kg)
4769    REAL(wp), DIMENSION (2) ::  mtvel   !< particle mean thermal velocity (m/s)
4770    REAL(wp), DIMENSION (2) ::  omega   !< particle mean free path
4771    REAL(wp), DIMENSION (2) ::  tva     !< temporary variable (m)
4772!
4773!-- Initialisation
4774    coagc   = 0.0_wp
4775!
4776!-- 1) Initializing particle and ambient air variables
4777    diam  = (/ diam1, diam2 /) !< particle diameters (m)
4778    mpart = (/ mass1, mass2 /) !< particle masses (kg)
4779!
4780!-- Viscosity of air (kg/(m s))
4781    visc = ( 7.44523E-3_wp * temp ** 1.5_wp ) / ( 5093.0_wp * ( temp + 110.4_wp ) )
4782!
4783!-- Mean free path of air (m)
4784    mfp = ( 1.656E-10_wp * temp + 1.828E-8_wp ) * ( p_0 + 1325.0_wp ) / pres
4785!
4786!-- 2) Slip correction factor for small particles
4787    knud = 2.0_wp * EXP( LOG(mfp) - LOG(diam) )! Knudsen number for air (15.23)
4788!
4789!-- Cunningham correction factor (Allen and Raabe, Aerosol Sci. Tech. 4, 269)
4790    beta = 1.0_wp + knud * ( 1.142_wp + 0.558_wp * EXP( -0.999_wp / knud ) )
4791!
4792!-- 3) Particle properties
4793!-- Diffusion coefficient (m2/s) (Jacobson (2005) eq. 15.29)
4794    dfpart = beta * abo * temp / ( 3.0_wp * pi * visc * diam )
4795!
4796!-- Mean thermal velocity (m/s) (Jacobson (2005) eq. 15.32)
4797    mtvel = SQRT( ( 8.0_wp * abo * temp ) / ( pi * mpart ) )
4798!
4799!-- Particle mean free path (m) (Jacobson (2005) eq. 15.34 )
4800    omega = 8.0_wp * dfpart / ( pi * mtvel )
4801!
4802!-- Mean diameter (m)
4803    mdiam = 0.5_wp * ( diam(1) + diam(2) )
4804!
4805!-- 4) Calculation of fluxes (Brownian collision kernels) and flux matching
4806!-- following Jacobson (2005):
4807!
4808!-- Flux in continuum regime (m3/s) (eq. 15.28)
4809    flux(1) = 4.0_wp * pi * mdiam * ( dfpart(1) + dfpart(2) )
4810!
4811!-- Flux in free molec. regime (m3/s) (eq. 15.31)
4812    flux(2) = pi * SQRT( ( mtvel(1)**2 ) + ( mtvel(2)**2 ) ) * ( mdiam**2 )
4813!
4814!-- temporary variables (m) to calculate flux matching distance (m)
4815    tva(1) = ( ( mdiam + omega(1) )**3 - ( mdiam**2 + omega(1)**2 ) * SQRT( ( mdiam**2 +           &
4816               omega(1)**2 ) ) ) / ( 3.0_wp * mdiam * omega(1) ) - mdiam
4817    tva(2) = ( ( mdiam + omega(2) )**3 - ( mdiam**2 + omega(2)**2 ) * SQRT( ( mdiam**2 +           &
4818               omega(2)**2 ) ) ) / ( 3.0_wp * mdiam * omega(2) ) - mdiam
4819!
4820!-- Flux matching distance (m): the mean distance from the centre of a sphere reached by particles
4821!-- that leave sphere's surface and travel a distance of particle mean free path (eq. 15.34)
4822    fmdist = SQRT( tva(1)**2 + tva(2)**2 )
4823!
4824!-- 5) Coagulation coefficient = coalescence efficiency * collision kernel (m3/s) (eq. 15.33).
4825!--    Here assumed coalescence efficiency 1!!
4826    coagc = flux(1) / ( mdiam / ( mdiam + fmdist) + flux(1) / flux(2) )
4827!
4828!-- Corrected collision kernel (Karl et al., 2016 (ACP)): Include van der Waals and viscous forces
4829    IF ( van_der_waals_coagc )  THEN
4830       knud_p = SQRT( omega(1)**2 + omega(2)**2 ) / mdiam
4831       IF ( knud_p >= 0.1_wp  .AND.  knud_p <= 10.0_wp )  THEN
4832          coagc = coagc * ( 2.0_wp + 0.4_wp * LOG( knud_p ) )
4833       ELSE
4834          coagc = coagc * 3.0_wp
4835       ENDIF
4836    ENDIF
4837
4838 END FUNCTION coagc
4839
4840!------------------------------------------------------------------------------!
4841! Description:
4842! ------------
4843!> Calculates the change in particle volume and gas phase
4844!> concentrations due to nucleation, condensation and dissolutional growth.
4845!
4846!> Sulphuric acid and organic vapour: only condensation and no evaporation.
4847!
4848!> New gas and aerosol phase concentrations calculated according to Jacobson
4849!> (1997): Numerical techniques to solve condensational and dissolutional growth
4850!> equations when growth is coupled to reversible reactions, Aerosol Sci. Tech.,
4851!> 27, pp 491-498.
4852!
4853!> Following parameterization has been used:
4854!> Molecular diffusion coefficient of condensing vapour (m2/s)
4855!> (Reid et al. (1987): Properties of gases and liquids, McGraw-Hill, New York.)
4856!> D = {1.d-7*sqrt(1/M_air + 1/M_gas)*T^1.75} / &
4857!      {p_atm/p_stand * (d_air^(1/3) + d_gas^(1/3))^2 }
4858!> M_air = 28.965 : molar mass of air (g/mol)
4859!> d_air = 19.70  : diffusion volume of air
4860!> M_h2so4 = 98.08 : molar mass of h2so4 (g/mol)
4861!> d_h2so4 = 51.96  : diffusion volume of h2so4
4862!
4863!> Called from main aerosol model
4864!> For equations, see Jacobson, Fundamentals of Atmospheric Modeling, 2nd Edition (2005)
4865!
4866!> Coded by:
4867!> Hannele Korhonen (FMI) 2005
4868!> Harri Kokkola (FMI) 2006
4869!> Juha Tonttila (FMI) 2014
4870!> Rewritten to PALM by Mona Kurppa (UHel) 2017
4871!------------------------------------------------------------------------------!
4872 SUBROUTINE condensation( paero, pc_sa, pc_ocnv, pcocsv, pchno3, pc_nh3, pcw, pcs, ptemp, ppres,   &
4873                          ptstep, prtcl )
4874
4875    IMPLICIT NONE
4876
4877    INTEGER(iwp) ::  ss      !< start index
4878    INTEGER(iwp) ::  ee      !< end index
4879
4880    REAL(wp) ::  zcs_ocnv    !< condensation sink of nonvolatile organics (1/s)
4881    REAL(wp) ::  zcs_ocsv    !< condensation sink of semivolatile organics (1/s)
4882    REAL(wp) ::  zcs_su      !< condensation sink of sulfate (1/s)
4883    REAL(wp) ::  zcs_tot     !< total condensation sink (1/s) (gases)
4884    REAL(wp) ::  zcvap_new1  !< vapour concentration after time step (#/m3): sulphuric acid
4885    REAL(wp) ::  zcvap_new2  !< nonvolatile organics
4886    REAL(wp) ::  zcvap_new3  !< semivolatile organics
4887    REAL(wp) ::  zdfvap      !< air diffusion coefficient (m2/s)
4888    REAL(wp) ::  zdvap1      !< change in vapour concentration (#/m3): sulphuric acid
4889    REAL(wp) ::  zdvap2      !< nonvolatile organics
4890    REAL(wp) ::  zdvap3      !< semivolatile organics
4891    REAL(wp) ::  zmfp        !< mean free path of condensing vapour (m)
4892    REAL(wp) ::  zrh         !< Relative humidity [0-1]
4893    REAL(wp) ::  zvisc       !< viscosity of air (kg/(m s))
4894    REAL(wp) ::  zn_vs_c     !< ratio of nucleation of all mass transfer in the smallest bin
4895    REAL(wp) ::  zxocnv      !< ratio of organic vapour in 3nm particles
4896    REAL(wp) ::  zxsa        !< Ratio in 3nm particles: sulphuric acid
4897
4898    REAL(wp), INTENT(in) ::  ppres   !< ambient pressure (Pa)
4899    REAL(wp), INTENT(in) ::  pcs     !< Water vapour saturation concentration (kg/m3)
4900    REAL(wp), INTENT(in) ::  ptemp   !< ambient temperature (K)
4901    REAL(wp), INTENT(in) ::  ptstep  !< timestep (s)
4902
4903    REAL(wp), INTENT(inout) ::  pchno3   !< Gas concentrations (#/m3): nitric acid HNO3
4904    REAL(wp), INTENT(inout) ::  pc_nh3   !< ammonia NH3
4905    REAL(wp), INTENT(inout) ::  pc_ocnv  !< non-volatile organics
4906    REAL(wp), INTENT(inout) ::  pcocsv   !< semi-volatile organics
4907    REAL(wp), INTENT(inout) ::  pc_sa    !< sulphuric acid H2SO4
4908    REAL(wp), INTENT(inout) ::  pcw      !< Water vapor concentration (kg/m3)
4909
4910    REAL(wp), DIMENSION(nbins_aerosol)       ::  zbeta          !< transitional correction factor
4911    REAL(wp), DIMENSION(nbins_aerosol)       ::  zcolrate       !< collision rate (1/s)
4912    REAL(wp), DIMENSION(nbins_aerosol)       ::  zcolrate_ocnv  !< collision rate of OCNV (1/s)
4913    REAL(wp), DIMENSION(start_subrange_1a+1) ::  zdfpart        !< particle diffusion coef. (m2/s)
4914    REAL(wp), DIMENSION(nbins_aerosol)       ::  zdvoloc        !< change of organics volume
4915    REAL(wp), DIMENSION(nbins_aerosol)       ::  zdvolsa        !< change of sulphate volume
4916    REAL(wp), DIMENSION(2)                   ::  zj3n3          !< Formation massrate of molecules
4917                                                                !< in nucleation, (molec/m3s),
4918                                                                !< 1: H2SO4 and 2: organic vapor
4919    REAL(wp), DIMENSION(nbins_aerosol)       ::  zknud          !< particle Knudsen number
4920
4921    TYPE(component_index), INTENT(in) :: prtcl  !< Keeps track which substances are used
4922
4923    TYPE(t_section), DIMENSION(nbins_aerosol), INTENT(inout) ::  paero  !< Aerosol properties
4924
4925    zj3n3  = 0.0_wp
4926    zrh    = pcw / pcs
4927    zxocnv = 0.0_wp
4928    zxsa   = 0.0_wp
4929!
4930!-- Nucleation
4931    IF ( nsnucl > 0 )  THEN
4932       CALL nucleation( paero, ptemp, zrh, ppres, pc_sa, pc_ocnv, pc_nh3, ptstep, zj3n3, zxsa,     &
4933                        zxocnv )
4934    ENDIF
4935!
4936!-- Condensation on pre-existing particles
4937    IF ( lscndgas )  THEN
4938!
4939!--    Initialise:
4940       zdvolsa = 0.0_wp
4941       zdvoloc = 0.0_wp
4942       zcolrate = 0.0_wp
4943!
4944!--    1) Properties of air and condensing gases:
4945!--    Viscosity of air (kg/(m s)) (Eq. 4.54 in Jabonson (2005))
4946       zvisc = ( 7.44523E-3_wp * ptemp ** 1.5_wp ) / ( 5093.0_wp * ( ptemp + 110.4_wp ) )
4947!
4948!--    Diffusion coefficient of air (m2/s)
4949       zdfvap = 5.1111E-10_wp * ptemp ** 1.75_wp * ( p_0 + 1325.0_wp ) / ppres
4950!
4951!--    Mean free path (m): same for H2SO4 and organic compounds
4952       zmfp = 3.0_wp * zdfvap * SQRT( pi * amh2so4 / ( 8.0_wp * argas * ptemp ) )
4953!
4954!--    2) Transition regime correction factor zbeta for particles (Fuchs and Sutugin (1971)):
4955!--       Size of condensing molecule considered only for nucleation mode (3 - 20 nm).
4956!
4957!--    Particle Knudsen number: condensation of gases on aerosols
4958       ss = start_subrange_1a
4959       ee = start_subrange_1a+1
4960       zknud(ss:ee) = 2.0_wp * zmfp / ( paero(ss:ee)%dwet + d_sa )
4961       ss = start_subrange_1a+2
4962       ee = end_subrange_2b
4963       zknud(ss:ee) = 2.0_wp * zmfp / paero(ss:ee)%dwet
4964!
4965!--    Transitional correction factor: aerosol + gas (the semi-empirical Fuchs- Sutugin
4966!--    interpolation function (Fuchs and Sutugin, 1971))
4967       zbeta = ( zknud + 1.0_wp ) / ( 0.377_wp * zknud + 1.0_wp + 4.0_wp / ( 3.0_wp * massacc ) *  &
4968               ( zknud + zknud ** 2 ) )
4969!
4970!--    3) Collision rate of molecules to particles
4971!--       Particle diffusion coefficient considered only for nucleation mode (3 - 20 nm)
4972!
4973!--    Particle diffusion coefficient (m2/s) (e.g. Eq. 15.29 in Jacobson (2005))
4974       zdfpart = abo * ptemp * zbeta(start_subrange_1a:start_subrange_1a+1) / ( 3.0_wp * pi * zvisc&
4975                 * paero(start_subrange_1a:start_subrange_1a+1)%dwet)
4976!
4977!--    Collision rate (mass-transfer coefficient): gases on aerosols (1/s) (Eq. 16.64 in
4978!--    Jacobson (2005))
4979       ss = start_subrange_1a
4980       ee = start_subrange_1a+1
4981       zcolrate(ss:ee) = MERGE( 2.0_wp * pi * ( paero(ss:ee)%dwet + d_sa ) * ( zdfvap + zdfpart ) *&
4982                               zbeta(ss:ee) * paero(ss:ee)%numc, 0.0_wp, paero(ss:ee)%numc > nclim )
4983       ss = start_subrange_1a+2
4984       ee = end_subrange_2b
4985       zcolrate(ss:ee) = MERGE( 2.0_wp * pi * paero(ss:ee)%dwet * zdfvap * zbeta(ss:ee) *          &
4986                                paero(ss:ee)%numc, 0.0_wp, paero(ss:ee)%numc > nclim )
4987!
4988!-- 4) Condensation sink (1/s)
4989       zcs_tot = SUM( zcolrate )   ! total sink
4990!
4991!--    5) Changes in gas-phase concentrations and particle volume
4992!
4993!--    5.1) Organic vapours
4994!
4995!--    5.1.1) Non-volatile organic compound: condenses onto all bins
4996       IF ( pc_ocnv > 1.0E+10_wp  .AND.  zcs_tot > 1.0E-30_wp  .AND. index_oc > 0 )  &
4997       THEN
4998!--       Ratio of nucleation vs. condensation rates in the smallest bin
4999          zn_vs_c = 0.0_wp
5000          IF ( zj3n3(2) > 1.0_wp )  THEN
5001             zn_vs_c = ( zj3n3(2) ) / ( zj3n3(2) + pc_ocnv * zcolrate(start_subrange_1a) )
5002          ENDIF
5003!
5004!--       Collision rate in the smallest bin, including nucleation and condensation (see
5005!--       Jacobson (2005), eq. (16.73) )
5006          zcolrate_ocnv = zcolrate
5007          zcolrate_ocnv(start_subrange_1a) = zcolrate_ocnv(start_subrange_1a) + zj3n3(2) / pc_ocnv
5008!
5009!--       Total sink for organic vapor
5010          zcs_ocnv = zcs_tot + zj3n3(2) / pc_ocnv
5011!
5012!--       New gas phase concentration (#/m3)
5013          zcvap_new2 = pc_ocnv / ( 1.0_wp + ptstep * zcs_ocnv )
5014!
5015!--       Change in gas concentration (#/m3)
5016          zdvap2 = pc_ocnv - zcvap_new2
5017!
5018!--       Updated vapour concentration (#/m3)
5019          pc_ocnv = zcvap_new2
5020!
5021!--       Volume change of particles (m3(OC)/m3(air))
5022          zdvoloc = zcolrate_ocnv(start_subrange_1a:end_subrange_2b) / zcs_ocnv * amvoc * zdvap2
5023!
5024!--       Change of volume due to condensation in 1a-2b
5025          paero(start_subrange_1a:end_subrange_2b)%volc(2) =                                       &
5026                                          paero(start_subrange_1a:end_subrange_2b)%volc(2) + zdvoloc
5027!
5028!--       Change of number concentration in the smallest bin caused by nucleation (Jacobson (2005),
5029!--       eq. (16.75)). If zxocnv = 0, then the chosen nucleation mechanism doesn't take into
5030!--       account the non-volatile organic vapors and thus the paero doesn't have to be updated.
5031          IF ( zxocnv > 0.0_wp )  THEN
5032             paero(start_subrange_1a)%numc = paero(start_subrange_1a)%numc + zn_vs_c *             &
5033                                             zdvoloc(start_subrange_1a) / amvoc / ( n3 * zxocnv )
5034          ENDIF
5035       ENDIF
5036!
5037!--    5.1.2) Semivolatile organic compound: all bins except subrange 1
5038       zcs_ocsv = SUM( zcolrate(start_subrange_2a:end_subrange_2b) ) !< sink for semi-volatile org.
5039       IF ( pcocsv > 1.0E+10_wp  .AND.  zcs_ocsv > 1.0E-30  .AND. is_used( prtcl,'OC') )  THEN
5040!
5041!--       New gas phase concentration (#/m3)
5042          zcvap_new3 = pcocsv / ( 1.0_wp + ptstep * zcs_ocsv )
5043!
5044!--       Change in gas concentration (#/m3)
5045          zdvap3 = pcocsv - zcvap_new3 
5046!
5047!--       Updated gas concentration (#/m3)
5048          pcocsv = zcvap_new3
5049!
5050!--       Volume change of particles (m3(OC)/m3(air))
5051          ss = start_subrange_2a
5052          ee = end_subrange_2b
5053          zdvoloc(ss:ee) = zdvoloc(ss:ee) + zcolrate(ss:ee) / zcs_ocsv * amvoc * zdvap3
5054!
5055!--       Change of volume due to condensation in 1a-2b
5056          paero(start_subrange_1a:end_subrange_2b)%volc(2) =                                       &
5057                                          paero(start_subrange_1a:end_subrange_2b)%volc(2) + zdvoloc
5058       ENDIF
5059!
5060!--    5.2) Sulphate: condensed on all bins
5061       IF ( pc_sa > 1.0E+10_wp  .AND.  zcs_tot > 1.0E-30_wp  .AND.  index_so4 > 0 )  THEN
5062!
5063!--    Ratio of mass transfer between nucleation and condensation
5064          zn_vs_c = 0.0_wp
5065          IF ( zj3n3(1) > 1.0_wp )  THEN
5066             zn_vs_c = ( zj3n3(1) ) / ( zj3n3(1) + pc_sa * zcolrate(start_subrange_1a) )
5067          ENDIF
5068!
5069!--       Collision rate in the smallest bin, including nucleation and condensation (see
5070!--       Jacobson (2005), eq. (16.73))
5071          zcolrate(start_subrange_1a) = zcolrate(start_subrange_1a) + zj3n3(1) / pc_sa
5072!
5073!--       Total sink for sulfate (1/s)
5074          zcs_su = zcs_tot + zj3n3(1) / pc_sa
5075!
5076!--       Sulphuric acid:
5077!--       New gas phase concentration (#/m3)
5078          zcvap_new1 = pc_sa / ( 1.0_wp + ptstep * zcs_su )
5079!
5080!--       Change in gas concentration (#/m3)
5081          zdvap1 = pc_sa - zcvap_new1
5082!
5083!--       Updating vapour concentration (#/m3)
5084          pc_sa = zcvap_new1
5085!
5086!--       Volume change of particles (m3(SO4)/m3(air)) by condensation
5087          zdvolsa = zcolrate(start_subrange_1a:end_subrange_2b) / zcs_su * amvh2so4 * zdvap1
5088!
5089!--       Change of volume concentration of sulphate in aerosol [fxm]
5090          paero(start_subrange_1a:end_subrange_2b)%volc(1) =                                       &
5091                                          paero(start_subrange_1a:end_subrange_2b)%volc(1) + zdvolsa
5092!
5093!--       Change of number concentration in the smallest bin caused by nucleation
5094!--       (Jacobson (2005), equation (16.75))
5095          IF ( zxsa > 0.0_wp )  THEN
5096             paero(start_subrange_1a)%numc = paero(start_subrange_1a)%numc + zn_vs_c *             &
5097                                             zdvolsa(start_subrange_1a) / amvh2so4 / ( n3 * zxsa)
5098          ENDIF
5099       ENDIF
5100!
5101!--    Partitioning of H2O, HNO3, and NH3: Dissolutional growth
5102       IF ( lspartition  .AND.  ( pchno3 > 1.0E+10_wp  .OR.  pc_nh3 > 1.0E+10_wp ) )  THEN
5103          CALL gpparthno3( ppres, ptemp, paero, pchno3, pc_nh3, pcw, pcs, zbeta, ptstep )
5104       ENDIF
5105    ENDIF
5106!
5107!-- Condensation of water vapour
5108    IF ( lscndh2oae )  THEN
5109       CALL gpparth2o( paero, ptemp, ppres, pcs, pcw, ptstep )
5110    ENDIF
5111
5112 END SUBROUTINE condensation
5113
5114!------------------------------------------------------------------------------!
5115! Description:
5116! ------------
5117!> Calculates the particle number and volume increase, and gas-phase
5118!> concentration decrease due to nucleation subsequent growth to detectable size
5119!> of 3 nm.
5120!
5121!> Method:
5122!> When the formed clusters grow by condensation (possibly also by self-
5123!> coagulation), their number is reduced due to scavenging to pre-existing
5124!> particles. Thus, the apparent nucleation rate at 3 nm is significantly lower
5125!> than the real nucleation rate (at ~1 nm).
5126!
5127!> Calculation of the formation rate of detectable particles at 3 nm (i.e. J3):
5128!> nj3 = 1: Kerminen, V.-M. and Kulmala, M. (2002), J. Aerosol Sci.,33, 609-622.
5129!> nj3 = 2: Lehtinen et al. (2007), J. Aerosol Sci., 38(9), 988-994.
5130!> nj3 = 3: Anttila et al. (2010), J. Aerosol Sci., 41(7), 621-636.
5131!
5132!> c = aerosol of critical radius (1 nm)
5133!> x = aerosol with radius 3 nm
5134!> 2 = wet or mean droplet
5135!
5136!> Called from subroutine condensation (in module salsa_dynamics_mod.f90)
5137!
5138!> Calls one of the following subroutines:
5139!>  - binnucl
5140!>  - ternucl
5141!>  - kinnucl
5142!>  - actnucl
5143!
5144!> fxm: currently only sulphuric acid grows particles from 1 to 3 nm
5145!>  (if asked from Markku, this is terribly wrong!!!)
5146!
5147!> Coded by:
5148!> Hannele Korhonen (FMI) 2005
5149!> Harri Kokkola (FMI) 2006
5150!> Matti Niskanen(FMI) 2012
5151!> Anton Laakso  (FMI) 2013
5152!------------------------------------------------------------------------------!
5153
5154 SUBROUTINE nucleation( paero, ptemp, prh, ppres, pc_sa, pc_ocnv, pc_nh3, ptstep, pj3n3, pxsa,     &
5155                        pxocnv )
5156
5157    IMPLICIT NONE
5158
5159    INTEGER(iwp) ::  iteration
5160
5161    REAL(wp) ::  zc_h2so4     !< H2SO4 conc. (#/cm3) !UNITS!
5162    REAL(wp) ::  zc_org       !< organic vapour conc. (#/cm3)
5163    REAL(wp) ::  zcc_c        !< Cunningham correct factor for c = critical (1nm)
5164    REAL(wp) ::  zcc_x        !< Cunningham correct factor for x = 3nm
5165    REAL(wp) ::  zcoags_c     !< coagulation sink (1/s) for c = critical (1nm)
5166    REAL(wp) ::  zcoags_x     !< coagulation sink (1/s) for x = 3nm
5167    REAL(wp) ::  zcoagstot    !< total particle losses due to coagulation, including condensation
5168                              !< and self-coagulation
5169    REAL(wp) ::  zcocnv_local !< organic vapour conc. (#/m3)
5170    REAL(wp) ::  zcsink       !< condensational sink (#/m2)
5171    REAL(wp) ::  zcsa_local   !< H2SO4 conc. (#/m3)
5172    REAL(wp) ::  zcv_c        !< mean relative thermal velocity (m/s) for c = critical (1nm)
5173    REAL(wp) ::  zcv_x        !< mean relative thermal velocity (m/s) for x = 3nm
5174    REAL(wp) ::  zdcrit       !< diameter of critical cluster (m)
5175    REAL(wp) ::  zdelta_vap   !< change of H2SO4 and organic vapour concentration (#/m3)
5176    REAL(wp) ::  zdfvap       !< air diffusion coefficient (m2/s)
5177    REAL(wp) ::  zdmean       !< mean diameter of existing particles (m)
5178    REAL(wp) ::  zeta         !< constant: proportional to ratio of CS/GR (m)
5179                              !< (condensation sink / growth rate)
5180    REAL(wp) ::  zgamma       !< proportionality factor ((nm2*m2)/h)
5181    REAL(wp) ::  z_gr_clust   !< growth rate of formed clusters (nm/h)
5182    REAL(wp) ::  z_gr_tot     !< total growth rate
5183    REAL(wp) ::  zj3          !< number conc. of formed 3nm particles (#/m3)
5184    REAL(wp) ::  zjnuc        !< nucleation rate at ~1nm (#/m3s)
5185    REAL(wp) ::  z_k_eff      !< effective cogulation coefficient for freshly nucleated particles
5186    REAL(wp) ::  zknud_c      !< Knudsen number for c = critical (1nm)
5187    REAL(wp) ::  zknud_x      !< Knudsen number for x = 3nm
5188    REAL(wp) ::  zkocnv       !< lever: zkocnv=1 --> organic compounds involved in nucleation
5189    REAL(wp) ::  zksa         !< lever: zksa=1 --> H2SO4 involved in nucleation
5190    REAL(wp) ::  zlambda      !< parameter for adjusting the growth rate due to self-coagulation
5191    REAL(wp) ::  zm_c         !< particle mass (kg) for c = critical (1nm)
5192    REAL(wp) ::  zm_para      !< Parameter m for calculating the coagulation sink (Eq. 5&6 in
5193                              !< Lehtinen et al. 2007)
5194    REAL(wp) ::  zm_x         !< particle mass (kg) for x = 3nm
5195    REAL(wp) ::  zmfp         !< mean free path of condesing vapour(m)
5196    REAL(wp) ::  zmixnh3      !< ammonia mixing ratio (ppt)
5197    REAL(wp) ::  zmyy         !< gas dynamic viscosity (N*s/m2)
5198    REAL(wp) ::  z_n_nuc      !< number of clusters/particles at the size range d1-dx (#/m3)
5199    REAL(wp) ::  znoc         !< number of organic molecules in critical cluster
5200    REAL(wp) ::  znsa         !< number of H2SO4 molecules in critical cluster
5201
5202    REAL(wp), INTENT(in) ::  pc_nh3   !< ammonia concentration (#/m3)
5203    REAL(wp), INTENT(in) ::  pc_ocnv  !< conc. of non-volatile OC (#/m3)
5204    REAL(wp), INTENT(in) ::  pc_sa    !< sulphuric acid conc. (#/m3)
5205    REAL(wp), INTENT(in) ::  ppres    !< ambient air pressure (Pa)
5206    REAL(wp), INTENT(in) ::  prh      !< ambient rel. humidity [0-1]
5207    REAL(wp), INTENT(in) ::  ptemp    !< ambient temperature (K)
5208    REAL(wp), INTENT(in) ::  ptstep   !< time step (s) of SALSA
5209
5210    REAL(wp), INTENT(inout) ::  pj3n3(2) !< formation mass rate of molecules (molec/m3s) for
5211                                         !< 1: H2SO4 and 2: organic vapour
5212
5213    REAL(wp), INTENT(out) ::  pxocnv  !< ratio of non-volatile organic vapours in 3 nm particles
5214    REAL(wp), INTENT(out) ::  pxsa    !< ratio of H2SO4 in 3 nm aerosol particles
5215
5216    REAL(wp), DIMENSION(nbins_aerosol) ::  zbeta       !< transitional correction factor
5217    REAL(wp), DIMENSION(nbins_aerosol) ::  zcc_2       !< Cunningham correct factor:2
5218    REAL(wp), DIMENSION(nbins_aerosol) ::  zcv_2       !< mean relative thermal velocity (m/s): 2
5219    REAL(wp), DIMENSION(nbins_aerosol) ::  zcv_c2      !< average velocity after coagulation: c & 2
5220    REAL(wp), DIMENSION(nbins_aerosol) ::  zcv_x2      !< average velocity after coagulation: x & 2
5221    REAL(wp), DIMENSION(nbins_aerosol) ::  zdc_2       !< particle diffusion coefficient (m2/s): 2
5222    REAL(wp), DIMENSION(nbins_aerosol) ::  zdc_c       !< particle diffusion coefficient (m2/s): c
5223    REAL(wp), DIMENSION(nbins_aerosol) ::  zdc_c2      !< sum of diffusion coef. for c and 2
5224    REAL(wp), DIMENSION(nbins_aerosol) ::  zdc_x       !< particle diffusion coefficient (m2/s): x
5225    REAL(wp), DIMENSION(nbins_aerosol) ::  zdc_x2      !< sum of diffusion coef. for: x & 2
5226    REAL(wp), DIMENSION(nbins_aerosol) ::  zgamma_f_2  !< zgamma_f for calculating zomega
5227    REAL(wp), DIMENSION(nbins_aerosol) ::  zgamma_f_c  !< zgamma_f for calculating zomega
5228    REAL(wp), DIMENSION(nbins_aerosol) ::  zgamma_f_x  !< zgamma_f for calculating zomega
5229    REAL(wp), DIMENSION(nbins_aerosol) ::  z_k_c2      !< coagulation coef. in the continuum
5230                                                       !< regime: c & 2
5231    REAL(wp), DIMENSION(nbins_aerosol) ::  z_k_x2      !< coagulation coef. in the continuum
5232                                                       !< regime: x & 2
5233    REAL(wp), DIMENSION(nbins_aerosol) ::  zknud       !< particle Knudsen number
5234    REAL(wp), DIMENSION(nbins_aerosol) ::  zknud_2     !< particle Knudsen number: 2
5235    REAL(wp), DIMENSION(nbins_aerosol) ::  zm_2        !< particle mass (kg): 2
5236    REAL(wp), DIMENSION(nbins_aerosol) ::  zomega_2c   !< zomega (m) for calculating zsigma: c & 2
5237    REAL(wp), DIMENSION(nbins_aerosol) ::  zomega_2x   !< zomega (m) for calculating zsigma: x & 2
5238    REAL(wp), DIMENSION(nbins_aerosol) ::  zomega_c    !< zomega (m) for calculating zsigma: c
5239    REAL(wp), DIMENSION(nbins_aerosol) ::  zomega_x    !< zomega (m) for calculating zsigma: x
5240    REAL(wp), DIMENSION(nbins_aerosol) ::  z_r_c2      !< sum of the radii: c & 2
5241    REAL(wp), DIMENSION(nbins_aerosol) ::  z_r_x2      !< sum of the radii: x & 2
5242    REAL(wp), DIMENSION(nbins_aerosol) ::  zsigma_c2   !<
5243    REAL(wp), DIMENSION(nbins_aerosol) ::  zsigma_x2   !<
5244
5245    TYPE(t_section), DIMENSION(nbins_aerosol), INTENT(inout) ::  paero  !< aerosol properties
5246!
5247!-- 1) Nucleation rate (zjnuc) and diameter of critical cluster (zdcrit)
5248    zjnuc  = 0.0_wp
5249    znsa   = 0.0_wp
5250    znoc   = 0.0_wp
5251    zdcrit = 0.0_wp
5252    zksa   = 0.0_wp
5253    zkocnv = 0.0_wp
5254
5255    zc_h2so4 = pc_sa * 1.0E-6_wp   ! sulphuric acid conc. to #/cm3
5256    zc_org   = pc_ocnv * 1.0E-6_wp   ! conc. of non-volatile OC to #/cm3
5257    zmixnh3  = pc_nh3 * ptemp * argas / ( ppres * avo )
5258
5259    SELECT CASE ( nsnucl )
5260!
5261!--    Binary H2SO4-H2O nucleation
5262       CASE(1)
5263
5264          CALL binnucl( zc_h2so4, ptemp, prh, zjnuc, znsa, znoc, zdcrit,  zksa, zkocnv )
5265!
5266!--    Activation type nucleation (See Riipinen et al. (2007), Atmos. Chem. Phys., 7(8), 1899-1914)
5267       CASE(2)
5268!
5269!--       Nucleation rate (#/(m3 s))
5270          zc_h2so4  = MAX( zc_h2so4, 1.0E4_wp  )
5271          zc_h2so4  = MIN( zc_h2so4, 1.0E11_wp )
5272          zjnuc = act_coeff * pc_sa  ! (#/(m3 s))
5273!
5274!--       Organic compounds not involved when kinetic nucleation is assumed.
5275          zdcrit  = 7.9375E-10_wp   ! (m)
5276          zkocnv  = 0.0_wp
5277          zksa    = 1.0_wp
5278          znoc    = 0.0_wp
5279          znsa    = 2.0_wp
5280!
5281!--    Kinetically limited nucleation of (NH4)HSO4 clusters
5282!--    (See Sihto et al. (2006), Atmos. Chem. Phys., 6(12), 4079-4091.)
5283       CASE(3)
5284!
5285!--       Nucleation rate = coagcoeff*zpcsa**2 (#/(m3 s))
5286          zc_h2so4  = MAX( zc_h2so4, 1.0E4_wp  )
5287          zc_h2so4  = MIN( zc_h2so4, 1.0E11_wp )
5288          zjnuc = 5.0E-13_wp * zc_h2so4**2.0_wp * 1.0E+6_wp
5289!
5290!--       Organic compounds not involved when kinetic nucleation is assumed.
5291          zdcrit  = 7.9375E-10_wp   ! (m)
5292          zkocnv  = 0.0_wp
5293          zksa    = 1.0_wp
5294          znoc    = 0.0_wp
5295          znsa    = 2.0_wp
5296!
5297!--    Ternary H2SO4-H2O-NH3 nucleation
5298       CASE(4)
5299
5300          CALL ternucl( zc_h2so4, zmixnh3, ptemp, prh, zjnuc, znsa, znoc, zdcrit, zksa, zkocnv )
5301!
5302!--    Organic nucleation, J~[ORG] or J~[ORG]**2
5303!--    (See Paasonen et al. (2010), Atmos. Chem. Phys., 10, 11223-11242.)
5304       CASE(5)
5305!
5306!--       Homomolecular nuleation rate
5307          zjnuc = 1.3E-7_wp * pc_ocnv   ! (1/s) (Paasonen et al. Table 4: median a_org)
5308!
5309!--       H2SO4 not involved when pure organic nucleation is assumed.
5310          zdcrit  = 1.5E-9  ! (m)
5311          zkocnv  = 1.0_wp
5312          zksa    = 0.0_wp
5313          znoc    = 1.0_wp
5314          znsa    = 0.0_wp
5315!
5316!--    Sum of H2SO4 and organic activation type nucleation, J~[H2SO4]+[ORG]
5317!--    (See Paasonen et al. (2010), Atmos. Chem. Phys., 10, 11223-11242)
5318       CASE(6)
5319!
5320!--       Nucleation rate  (#/m3/s)
5321          zjnuc = 6.1E-7_wp * pc_sa + 0.39E-7_wp * pc_ocnv   ! (Paasonen et al. Table 3.)
5322!
5323!--       Both organic compounds and H2SO4 are involved when sumnucleation is assumed.
5324          zdcrit  = 1.5E-9_wp   ! (m)
5325          zkocnv  = 1.0_wp
5326          zksa    = 1.0_wp
5327          znoc    = 1.0_wp
5328          znsa    = 1.0_wp
5329!
5330!--    Heteromolecular nucleation, J~[H2SO4]*[ORG]
5331!--    (See Paasonen et al. (2010), Atmos. Chem. Phys., 10, 11223-11242.)
5332       CASE(7)
5333!
5334!--       Nucleation rate (#/m3/s)
5335          zjnuc = 4.1E-14_wp * pc_sa * pc_ocnv * 1.0E6_wp   ! (Paasonen et al. Table 4: median)
5336!
5337!--       Both organic compounds and H2SO4 are involved when heteromolecular nucleation is assumed
5338          zdcrit  = 1.5E-9_wp   ! (m)
5339          zkocnv  = 1.0_wp
5340          zksa    = 1.0_wp
5341          znoc    = 1.0_wp
5342          znsa    = 1.0_wp
5343!
5344!--    Homomolecular nucleation of H2SO4 and heteromolecular nucleation of H2SO4 and organic vapour,
5345!--    J~[H2SO4]**2 + [H2SO4]*[ORG] (EUCAARI project)
5346!--    (See Paasonen et al. (2010), Atmos. Chem. Phys., 10, 11223-11242)
5347       CASE(8)
5348!
5349!--       Nucleation rate (#/m3/s)
5350          zjnuc = ( 1.1E-14_wp * zc_h2so4**2 + 3.2E-14_wp * zc_h2so4 * zc_org ) * 1.0E+6_wp
5351!
5352!--       Both organic compounds and H2SO4 are involved when SAnucleation is assumed
5353          zdcrit  = 1.5E-9_wp   ! (m)
5354          zkocnv  = 1.0_wp
5355          zksa    = 1.0_wp
5356          znoc    = 1.0_wp
5357          znsa    = 3.0_wp
5358!
5359!--    Homomolecular nucleation of H2SO4 and organic vapour and heteromolecular nucleation of H2SO4
5360!--    and organic vapour, J~[H2SO4]**2 + [H2SO4]*[ORG]+[ORG]**2 (EUCAARI project)
5361       CASE(9)
5362!
5363!--       Nucleation rate (#/m3/s)
5364          zjnuc = ( 1.4E-14_wp * zc_h2so4**2 + 2.6E-14_wp * zc_h2so4 * zc_org + 0.037E-14_wp *     &
5365                    zc_org**2 ) * 1.0E+6_wp
5366!
5367!--       Both organic compounds and H2SO4 are involved when SAORGnucleation is assumed
5368          zdcrit  = 1.5E-9_wp   ! (m)
5369          zkocnv  = 1.0_wp
5370          zksa    = 1.0_wp
5371          znoc    = 3.0_wp
5372          znsa    = 3.0_wp
5373
5374    END SELECT
5375
5376    zcsa_local = pc_sa
5377    zcocnv_local = pc_ocnv
5378!
5379!-- 2) Change of particle and gas concentrations due to nucleation
5380!
5381!-- 2.1) Check that there is enough H2SO4 and organic vapour to produce the nucleation
5382    IF ( nsnucl <= 4 )  THEN 
5383!
5384!--    If the chosen nucleation scheme is 1-4, nucleation occurs only due to H2SO4. All of the total
5385!--    vapour concentration that is taking part to the nucleation is there for sulphuric acid
5386!--    (sa = H2SO4) and non-volatile organic vapour is zero.
5387       pxsa   = 1.0_wp   ! ratio of sulphuric acid in 3nm particles
5388       pxocnv = 0.0_wp   ! ratio of non-volatile origanic vapour
5389                                ! in 3nm particles
5390    ELSEIF ( nsnucl > 4 )  THEN
5391!
5392!--    If the chosen nucleation scheme is 5-9, nucleation occurs due to organic vapour or the
5393!--    combination of organic vapour and H2SO4. The number of needed molecules depends on the chosen
5394!--    nucleation type and it has an effect also on the minimum ratio of the molecules present.
5395       IF ( pc_sa * znsa + pc_ocnv * znoc < 1.E-14_wp )  THEN
5396          pxsa   = 0.0_wp
5397          pxocnv = 0.0_wp
5398       ELSE
5399          pxsa   = pc_sa * znsa / ( pc_sa * znsa + pc_ocnv * znoc ) 
5400          pxocnv = pc_ocnv * znoc / ( pc_sa * znsa + pc_ocnv * znoc )
5401       ENDIF
5402    ENDIF
5403!
5404!-- The change in total vapour concentration is the sum of the concentrations of the vapours taking
5405!-- part to the nucleation (depends on the chosen nucleation scheme)
5406    zdelta_vap = MIN( zjnuc * ( znoc + znsa ), ( pc_ocnv * zkocnv + pc_sa * zksa ) / ptstep )
5407!
5408!-- Nucleation rate J at ~1nm (#/m3s)
5409    zjnuc = zdelta_vap / ( znoc + znsa )
5410!
5411!-- H2SO4 concentration after nucleation (#/m3)
5412    zcsa_local = MAX( 1.0_wp, pc_sa - zdelta_vap * pxsa )
5413!
5414!-- Non-volative organic vapour concentration after nucleation (#/m3)
5415    zcocnv_local = MAX( 1.0_wp, pc_ocnv - zdelta_vap * pxocnv )
5416!
5417!-- 2.2) Formation rate of 3 nm particles (Kerminen & Kulmala, 2002)
5418!
5419!-- Growth rate by H2SO4 and organic vapour (nm/h, Eq. 21)
5420    z_gr_clust = 2.3623E-15_wp * SQRT( ptemp ) * ( zcsa_local + zcocnv_local )
5421!
5422!-- 2.2.2) Condensational sink of pre-existing particle population
5423!
5424!-- Diffusion coefficient (m2/s)
5425    zdfvap = 5.1111E-10_wp * ptemp**1.75_wp * ( p_0 + 1325.0_wp ) / ppres
5426!
5427!-- Mean free path of condensing vapour (m) (Jacobson (2005), Eq. 15.25 and 16.29)
5428    zmfp = 3.0_wp * zdfvap * SQRT( pi * amh2so4 / ( 8.0_wp * argas * ptemp ) )
5429!
5430!-- Knudsen number
5431    zknud = 2.0_wp * zmfp / ( paero(:)%dwet + d_sa )
5432!
5433!-- Transitional regime correction factor (zbeta) according to Fuchs and Sutugin (1971) (Eq. 4 in
5434!-- Kerminen and Kulmala, 2002)
5435    zbeta = ( zknud + 1.0_wp) / ( 0.377_wp * zknud + 1.0_wp + 4.0_wp / ( 3.0_wp * massacc ) *      &
5436            ( zknud + zknud**2 ) )
5437!
5438!-- Condensational sink (#/m2, Eq. 3)
5439    zcsink = SUM( paero(:)%dwet * zbeta * paero(:)%numc )
5440!
5441!-- 2.2.3) Parameterised formation rate of detectable 3 nm particles (i.e. J3)
5442    IF ( nj3 == 1 )  THEN   ! Kerminen and Kulmala (2002)
5443!
5444!--    Constants needed for the parameterisation: dapp = 3 nm and dens_nuc = 1830 kg/m3
5445       IF ( zcsink < 1.0E-30_wp )  THEN
5446          zeta = 0._dp
5447       ELSE
5448!
5449!--       Mean diameter of backgroud population (nm)
5450          zdmean = 1.0_wp / SUM( paero(:)%numc ) * SUM( paero(:)%numc * paero(:)%dwet ) * 1.0E+9_wp
5451!
5452!--       Proportionality factor (nm2*m2/h) (Eq. 22)
5453          zgamma = 0.23_wp * ( zdcrit * 1.0E+9_wp )**0.2_wp * ( zdmean / 150.0_wp )**0.048_wp *    &
5454                   ( ptemp / 293.0_wp )**( -0.75_wp ) * ( arhoh2so4 / 1000.0_wp )**( -0.33_wp )
5455!
5456!--       Factor eta (nm, Eq. 11)
5457          zeta = MIN( zgamma * zcsink / z_gr_clust, zdcrit * 1.0E11_wp )
5458       ENDIF
5459!
5460!--    Number conc. of clusters surviving to 3 nm in a time step (#/m3, Eq.14)
5461       zj3 = zjnuc * EXP( MIN( 0.0_wp, zeta / 3.0_wp - zeta / ( zdcrit * 1.0E9_wp ) ) )
5462
5463    ELSEIF ( nj3 > 1 )  THEN   ! Lehtinen et al. (2007) or Anttila et al. (2010)
5464!
5465!--    Defining the parameter m (zm_para) for calculating the coagulation sink onto background
5466!--    particles (Eq. 5&6 in Lehtinen et al. 2007). The growth is investigated between
5467!--    [d1,reglim(1)] = [zdcrit,3nm] and m = LOG( CoagS_dx / CoagX_zdcrit ) / LOG( reglim / zdcrit )
5468!--    (Lehtinen et al. 2007, Eq. 6).
5469!--    The steps for the coagulation sink for reglim = 3nm and zdcrit ~= 1nm are explained in
5470!--    Kulmala et al. (2001). The particles of diameter zdcrit ~1.14 nm  and reglim = 3nm are both
5471!--    in turn the "number 1" variables (Kulmala et al. 2001).
5472!--    c = critical (1nm), x = 3nm, 2 = wet or mean droplet
5473!
5474!--    Sum of the radii, R12 = R1 + R2 (m) of two particles 1 and 2
5475       z_r_c2 = zdcrit / 2.0_wp + paero(:)%dwet / 2.0_wp
5476       z_r_x2 = reglim(1) / 2.0_wp + paero(:)%dwet / 2.0_wp
5477!
5478!--    Particle mass (kg) (comes only from H2SO4)
5479       zm_c = 4.0_wp / 3.0_wp * pi * ( zdcrit / 2.0_wp )**3 * arhoh2so4
5480       zm_x = 4.0_wp / 3.0_wp * pi * ( reglim(1) / 2.0_wp )**3 * arhoh2so4
5481       zm_2 = 4.0_wp / 3.0_wp * pi * ( 0.5_wp * paero(:)%dwet )**3 * arhoh2so4
5482!
5483!--    Mean relative thermal velocity between the particles (m/s)
5484       zcv_c = SQRT( 8.0_wp * abo * ptemp / ( pi * zm_c ) )
5485       zcv_x = SQRT( 8.0_wp * abo * ptemp / ( pi * zm_x ) )
5486       zcv_2 = SQRT( 8.0_wp * abo * ptemp / ( pi * zm_2 ) )
5487!
5488!--    Average velocity after coagulation
5489       zcv_c2(:) = SQRT( zcv_c**2 + zcv_2**2 )
5490       zcv_x2(:) = SQRT( zcv_x**2 + zcv_2**2 )
5491!
5492!--    Knudsen number (zmfp = mean free path of condensing vapour)
5493       zknud_c = 2.0_wp * zmfp / zdcrit
5494       zknud_x = 2.0_wp * zmfp / reglim(1)
5495       zknud_2(:) = MAX( 0.0_wp, 2.0_wp * zmfp / paero(:)%dwet )
5496!
5497!--    Cunningham correction factors (Allen and Raabe, 1985)
5498       zcc_c    = 1.0_wp + zknud_c    * ( 1.142_wp + 0.558_wp * EXP( -0.999_wp / zknud_c ) )
5499       zcc_x    = 1.0_wp + zknud_x    * ( 1.142_wp + 0.558_wp * EXP( -0.999_wp / zknud_x ) )
5500       zcc_2(:) = 1.0_wp + zknud_2(:) * ( 1.142_wp + 0.558_wp * EXP( -0.999_wp / zknud_2(:) ) )
5501!
5502!--    Gas dynamic viscosity (N*s/m2). Here, viscocity(air @20C) = 1.81e-5_dp N/m2 *s (Hinds, p. 25)
5503       zmyy = 1.81E-5_wp * ( ptemp / 293.0_wp )**0.74_wp
5504!
5505!--    Particle diffusion coefficient (m2/s) (continuum regime)
5506       zdc_c(:) = abo * ptemp * zcc_c    / ( 3.0_wp * pi * zmyy * zdcrit )
5507       zdc_x(:) = abo * ptemp * zcc_x    / ( 3.0_wp * pi * zmyy * reglim(1) )
5508       zdc_2(:) = abo * ptemp * zcc_2(:) / ( 3.0_wp * pi * zmyy * paero(:)%dwet )
5509!
5510!--    D12 = D1+D2 (Seinfield and Pandis, 2nd ed. Eq. 13.38)
5511       zdc_c2 = zdc_c + zdc_2
5512       zdc_x2 = zdc_x + zdc_2
5513!
5514!--    zgamma_f = 8*D/pi/zcv (m) for calculating zomega (Fuchs, 1964)
5515       zgamma_f_c = 8.0_wp * zdc_c / pi / zcv_c
5516       zgamma_f_x = 8.0_wp * zdc_x / pi / zcv_x
5517       zgamma_f_2 = 8.0_wp * zdc_2 / pi / zcv_2
5518!
5519!--    zomega (m) for calculating zsigma
5520       zomega_c = ( ( z_r_c2 + zgamma_f_c )**3 - ( z_r_c2 ** 2 + zgamma_f_c )**1.5_wp ) /          &
5521                  ( 3.0_wp * z_r_c2 * zgamma_f_c ) - z_r_c2
5522       zomega_x = ( ( z_r_x2 + zgamma_f_x )**3 - ( z_r_x2**2 + zgamma_f_x )** 1.5_wp ) /           &
5523                  ( 3.0_wp * z_r_x2 * zgamma_f_x ) - z_r_x2
5524       zomega_2c = ( ( z_r_c2 + zgamma_f_2 )**3 - ( z_r_c2**2 + zgamma_f_2 )**1.5_wp ) /           &
5525                   ( 3.0_wp * z_r_c2 * zgamma_f_2 ) - z_r_c2
5526       zomega_2x = ( ( z_r_x2 + zgamma_f_2 )**3 - ( z_r_x2**2 + zgamma_f_2 )**1.5_wp ) /           &
5527                   ( 3.0_wp * z_r_x2 * zgamma_f_2 ) - z_r_x2 
5528!
5529!--    The distance (m) at which the two fluxes are matched (condensation and coagulation sinks)
5530       zsigma_c2 = SQRT( zomega_c**2 + zomega_2c**2 )
5531       zsigma_x2 = SQRT( zomega_x**2 + zomega_2x**2 )
5532!
5533!--    Coagulation coefficient in the continuum regime (m*m2/s, Eq. 17 in Kulmala et al., 2001)
5534       z_k_c2 = 4.0_wp * pi * z_r_c2 * zdc_c2 / ( z_r_c2 / ( z_r_c2 + zsigma_c2 ) +                &
5535               4.0_wp * zdc_c2 / ( zcv_c2 * z_r_c2 ) )
5536       z_k_x2 = 4.0_wp * pi * z_r_x2 * zdc_x2 / ( z_r_x2 / ( z_r_x2 + zsigma_x2 ) +                &
5537               4.0_wp * zdc_x2 / ( zcv_x2 * z_r_x2 ) )
5538!
5539!--    Coagulation sink (1/s, Eq. 16 in Kulmala et al., 2001)
5540       zcoags_c = MAX( 1.0E-20_wp, SUM( z_k_c2 * paero(:)%numc ) )
5541       zcoags_x = MAX( 1.0E-20_wp, SUM( z_k_x2 * paero(:)%numc ) )
5542!
5543!--    Parameter m for calculating the coagulation sink onto background particles (Eq. 5&6 in
5544!--    Lehtinen et al. 2007)
5545       zm_para = LOG( zcoags_x / zcoags_c ) / LOG( reglim(1) / zdcrit )
5546!
5547!--    Parameter gamma for calculating the formation rate J of particles having
5548!--    a diameter zdcrit < d < reglim(1) (Anttila et al. 2010, eq. 5 or Lehtinen et al.,2007, eq. 7)
5549       zgamma = ( ( ( reglim(1) / zdcrit )**( zm_para + 1.0_wp ) ) - 1.0_wp ) / ( zm_para + 1.0_wp )
5550
5551       IF ( nj3 == 2 )  THEN   ! Lehtinen et al. (2007): coagulation sink
5552!
5553!--       Formation rate J before iteration (#/m3s)
5554          zj3 = zjnuc * EXP( MIN( 0.0_wp, -zgamma * zdcrit * zcoags_c / ( z_gr_clust * 1.0E-9_wp / &
5555                60.0_wp**2 ) ) )
5556
5557       ELSEIF ( nj3 == 3 )  THEN  ! Anttila et al. (2010): coagulation sink and self-coag.
5558!
5559!--       If air is polluted, the self-coagulation becomes important. Self-coagulation of small
5560!--       particles < 3 nm.
5561!
5562!--       "Effective" coagulation coefficient between freshly-nucleated particles:
5563          z_k_eff = 5.0E-16_wp   ! m3/s
5564!
5565!--       zlambda parameter for "adjusting" the growth rate due to the self-coagulation
5566          zlambda = 6.0_wp
5567
5568          IF ( reglim(1) >= 10.0E-9_wp )  THEN   ! for particles >10 nm:
5569             z_k_eff   = 5.0E-17_wp
5570             zlambda = 3.0_wp
5571          ENDIF
5572!
5573!--       Initial values for coagulation sink and growth rate  (m/s)
5574          zcoagstot = zcoags_c
5575          z_gr_tot = z_gr_clust * 1.0E-9_wp / 60.0_wp**2
5576!
5577!--       Number of clusters/particles at the size range [d1,dx] (#/m3):
5578          z_n_nuc = zjnuc / zcoagstot !< Initial guess
5579!
5580!--       Coagulation sink and growth rate due to self-coagulation:
5581          DO  iteration = 1, 5
5582             zcoagstot = zcoags_c + z_k_eff * z_n_nuc * 1.0E-6_wp   ! (1/s, Anttila et al., eq. 1)
5583             z_gr_tot = z_gr_clust * 2.77777777E-7_wp +  1.5708E-6_wp * zlambda * zdcrit**3 *      &
5584                      ( z_n_nuc * 1.0E-6_wp ) * zcv_c * avo * 2.77777777E-7_wp ! (Eq. 3)
5585             zeta = - zcoagstot / ( ( zm_para + 1.0_wp ) * z_gr_tot * ( zdcrit**zm_para ) ) ! (Eq.7b)
5586!
5587!--          Calculate Eq. 7a (Taylor series for the number of particles between [d1,dx])
5588             z_n_nuc =  z_n_nuc_tayl( zdcrit, reglim(1), zm_para, zjnuc, zeta, z_gr_tot )
5589          ENDDO
5590!
5591!--       Calculate the final values with new z_n_nuc:
5592          zcoagstot = zcoags_c + z_k_eff * z_n_nuc * 1.0E-6_wp   ! (1/s)
5593          z_gr_tot = z_gr_clust * 1.0E-9_wp / 3600.0_wp + 1.5708E-6_wp *  zlambda * zdcrit**3 *    &
5594                   ( z_n_nuc * 1.0E-6_wp ) * zcv_c * avo * 1.0E-9_wp / 3600.0_wp !< (m/s)
5595          zj3 = zjnuc * EXP( MIN( 0.0_wp, -zgamma * zdcrit * zcoagstot / z_gr_tot ) ) ! (#/m3s, Eq.5a)
5596
5597       ENDIF
5598    ENDIF
5599!
5600!-- If J3 very small (< 1 #/cm3), neglect particle formation. In real atmosphere this would mean
5601!-- that clusters form but coagulate to pre-existing particles who gain sulphate. Since
5602!-- CoagS ~ CS (4piD*CS'), we do *not* update H2SO4 concentration here but let condensation take
5603!-- care of it. Formation mass rate of molecules (molec/m3s) for 1: H2SO4 and 2: organic vapour
5604    pj3n3(1) = zj3 * n3 * pxsa
5605    pj3n3(2) = zj3 * n3 * pxocnv
5606
5607 END SUBROUTINE nucleation
5608
5609!------------------------------------------------------------------------------!
5610! Description:
5611! ------------
5612!> Calculate the nucleation rate and the size of critical clusters assuming
5613!> binary nucleation.
5614!> Parametrisation according to Vehkamaki et al. (2002), J. Geophys. Res.,
5615!> 107(D22), 4622. Called from subroutine nucleation.
5616!------------------------------------------------------------------------------!
5617 SUBROUTINE binnucl( pc_sa, ptemp, prh, pnuc_rate, pn_crit_sa, pn_crit_ocnv, pd_crit, pk_sa,       &
5618                     pk_ocnv )
5619
5620    IMPLICIT NONE
5621
5622    REAL(wp) ::  za      !<
5623    REAL(wp) ::  zb      !<
5624    REAL(wp) ::  zc      !<
5625    REAL(wp) ::  zcoll   !<
5626    REAL(wp) ::  zlogsa  !<  LOG( zpcsa )
5627    REAL(wp) ::  zlogrh  !<  LOG( zrh )
5628    REAL(wp) ::  zm1     !<
5629    REAL(wp) ::  zm2     !<
5630    REAL(wp) ::  zma     !<
5631    REAL(wp) ::  zmw     !<
5632    REAL(wp) ::  zntot   !< number of molecules in critical cluster
5633    REAL(wp) ::  zpcsa   !< sulfuric acid concentration
5634    REAL(wp) ::  zrh     !< relative humidity
5635    REAL(wp) ::  zroo    !<
5636    REAL(wp) ::  zt      !< temperature
5637    REAL(wp) ::  zv1     !<
5638    REAL(wp) ::  zv2     !<
5639    REAL(wp) ::  zx      !< mole fraction of sulphate in critical cluster
5640    REAL(wp) ::  zxmass  !<
5641
5642    REAL(wp), INTENT(in) ::   pc_sa   !< H2SO4 conc. (#/cm3)
5643    REAL(wp), INTENT(in) ::   prh     !< relative humidity [0-1
5644    REAL(wp), INTENT(in) ::   ptemp   !< ambient temperature (K)
5645
5646    REAL(wp), INTENT(out) ::  pnuc_rate     !< nucleation rate (#/(m3 s))
5647    REAL(wp), INTENT(out) ::  pn_crit_sa    !< number of H2SO4 molecules in cluster (#)
5648    REAL(wp), INTENT(out) ::  pn_crit_ocnv  !< number of organic molecules in cluster (#)
5649    REAL(wp), INTENT(out) ::  pd_crit       !< diameter of critical cluster (m)
5650    REAL(wp), INTENT(out) ::  pk_sa         !< Lever: if pk_sa = 1, H2SO4 is involved in nucleation.
5651    REAL(wp), INTENT(out) ::  pk_ocnv       !< Lever: if pk_ocnv = 1, organic compounds are involved
5652
5653    pnuc_rate = 0.0_wp
5654    pd_crit   = 1.0E-9_wp
5655!
5656!-- 1) Checking that we are in the validity range of the parameterization
5657    zpcsa  = MAX( pc_sa, 1.0E4_wp  )
5658    zpcsa  = MIN( zpcsa, 1.0E11_wp )
5659    zrh    = MAX( prh,   0.0001_wp )
5660    zrh    = MIN( zrh,   1.0_wp    )
5661    zt     = MAX( ptemp, 190.15_wp )
5662    zt     = MIN( zt,    300.15_wp )
5663
5664    zlogsa = LOG( zpcsa )
5665    zlogrh   = LOG( prh )
5666!
5667!-- 2) Mole fraction of sulphate in a critical cluster (Eq. 11)
5668    zx = 0.7409967177282139_wp                  - 0.002663785665140117_wp * zt +                   &
5669         0.002010478847383187_wp * zlogrh       - 0.0001832894131464668_wp* zt * zlogrh +          &
5670         0.001574072538464286_wp * zlogrh**2    - 0.00001790589121766952_wp * zt * zlogrh**2 +     &
5671         0.0001844027436573778_wp * zlogrh**3   - 1.503452308794887E-6_wp * zt * zlogrh**3 -       &
5672         0.003499978417957668_wp * zlogsa     + 0.0000504021689382576_wp * zt * zlogsa
5673!
5674!-- 3) Nucleation rate (Eq. 12)
5675    pnuc_rate = 0.1430901615568665_wp + 2.219563673425199_wp * zt -                                &
5676                0.02739106114964264_wp * zt**2 + 0.00007228107239317088_wp * zt**3 +               &
5677                5.91822263375044_wp / zx + 0.1174886643003278_wp * zlogrh +                        &
5678                0.4625315047693772_wp * zt * zlogrh - 0.01180591129059253_wp * zt**2 * zlogrh +    &
5679                0.0000404196487152575_wp * zt**3 * zlogrh +                                        &
5680                ( 15.79628615047088_wp * zlogrh ) / zx - 0.215553951893509_wp * zlogrh**2 -        &
5681                0.0810269192332194_wp * zt * zlogrh**2 +                                           &
5682                0.001435808434184642_wp * zt**2 * zlogrh**2 -                                      &
5683                4.775796947178588E-6_wp * zt**3 * zlogrh**2 -                                      &
5684                ( 2.912974063702185_wp * zlogrh**2 ) / zx - 3.588557942822751_wp * zlogrh**3 +     &
5685                0.04950795302831703_wp * zt * zlogrh**3 -                                          &
5686                0.0002138195118737068_wp * zt**2 * zlogrh**3 +                                     &
5687                3.108005107949533E-7_wp * zt**3 * zlogrh**3 -                                      &
5688                ( 0.02933332747098296_wp * zlogrh**3 ) / zx + 1.145983818561277_wp * zlogsa -      &
5689                0.6007956227856778_wp * zt * zlogsa + 0.00864244733283759_wp * zt**2 * zlogsa -    &
5690                0.00002289467254710888_wp * zt**3 * zlogsa -                                       &
5691                ( 8.44984513869014_wp * zlogsa ) / zx + 2.158548369286559_wp * zlogrh * zlogsa +   &
5692                0.0808121412840917_wp * zt * zlogrh * zlogsa -                                     &
5693                0.0004073815255395214_wp * zt**2 * zlogrh * zlogsa -                               &
5694                4.019572560156515E-7_wp * zt**3 * zlogrh * zlogsa +                                &
5695                ( 0.7213255852557236_wp * zlogrh * zlogsa ) / zx +                                 &
5696                1.62409850488771_wp * zlogrh**2 * zlogsa -                                         &
5697                0.01601062035325362_wp * zt * zlogrh**2 * zlogsa +                                 &
5698                0.00003771238979714162_wp*zt**2* zlogrh**2 * zlogsa +                              &
5699                3.217942606371182E-8_wp * zt**3 * zlogrh**2 * zlogsa -                             &
5700                ( 0.01132550810022116_wp * zlogrh**2 * zlogsa ) / zx +                             &
5701                9.71681713056504_wp * zlogsa**2 - 0.1150478558347306_wp * zt * zlogsa**2 +         &
5702                0.0001570982486038294_wp * zt**2 * zlogsa**2 +                                     &
5703                4.009144680125015E-7_wp * zt**3 * zlogsa**2 +                                      &
5704                ( 0.7118597859976135_wp * zlogsa**2 ) / zx -                                       &
5705                1.056105824379897_wp * zlogrh * zlogsa**2 +                                        &
5706                0.00903377584628419_wp * zt * zlogrh * zlogsa**2 -                                 &
5707                0.00001984167387090606_wp * zt**2 * zlogrh * zlogsa**2 +                           &
5708                2.460478196482179E-8_wp * zt**3 * zlogrh * zlogsa**2 -                             &
5709                ( 0.05790872906645181_wp * zlogrh * zlogsa**2 ) / zx -                             &
5710                0.1487119673397459_wp * zlogsa**3 + 0.002835082097822667_wp * zt * zlogsa**3 -     &
5711                9.24618825471694E-6_wp * zt**2 * zlogsa**3 +                                       &
5712                5.004267665960894E-9_wp * zt**3 * zlogsa**3 -                                      &
5713                ( 0.01270805101481648_wp * zlogsa**3 ) / zx
5714!
5715!-- Nucleation rate in #/(cm3 s)
5716    pnuc_rate = EXP( pnuc_rate ) 
5717!
5718!-- Check the validity of parameterization
5719    IF ( pnuc_rate < 1.0E-7_wp )  THEN
5720       pnuc_rate = 0.0_wp
5721       pd_crit   = 1.0E-9_wp
5722    ENDIF
5723!
5724!-- 4) Total number of molecules in the critical cluster (Eq. 13)
5725    zntot = - 0.002954125078716302_wp - 0.0976834264241286_wp * zt +                               &
5726              0.001024847927067835_wp * zt**2 - 2.186459697726116E-6_wp * zt**3 -                  &
5727              0.1017165718716887_wp / zx - 0.002050640345231486_wp * zlogrh -                      &
5728              0.007585041382707174_wp * zt * zlogrh + 0.0001926539658089536_wp * zt**2 * zlogrh -  &
5729              6.70429719683894E-7_wp * zt**3 * zlogrh - ( 0.2557744774673163_wp * zlogrh ) / zx +  &
5730              0.003223076552477191_wp * zlogrh**2 + 0.000852636632240633_wp * zt * zlogrh**2 -     &
5731              0.00001547571354871789_wp * zt**2 * zlogrh**2 +                                      &
5732              5.666608424980593E-8_wp * zt**3 * zlogrh**2 +                                        &
5733              ( 0.03384437400744206_wp * zlogrh**2 ) / zx +                                        &
5734              0.04743226764572505_wp * zlogrh**3 - 0.0006251042204583412_wp * zt * zlogrh**3 +     &
5735              2.650663328519478E-6_wp * zt**2 * zlogrh**3 -                                        &
5736              3.674710848763778E-9_wp * zt**3 * zlogrh**3 -                                        &
5737              ( 0.0002672510825259393_wp * zlogrh**3 ) / zx - 0.01252108546759328_wp * zlogsa +    &
5738              0.005806550506277202_wp * zt * zlogsa - 0.0001016735312443444_wp * zt**2 * zlogsa +  &
5739              2.881946187214505E-7_wp * zt**3 * zlogsa + ( 0.0942243379396279_wp * zlogsa ) / zx - &
5740              0.0385459592773097_wp * zlogrh * zlogsa -                                            &
5741              0.0006723156277391984_wp * zt * zlogrh * zlogsa  +                                   &
5742              2.602884877659698E-6_wp * zt**2 * zlogrh * zlogsa +                                  &
5743              1.194163699688297E-8_wp * zt**3 * zlogrh * zlogsa -                                  &
5744              ( 0.00851515345806281_wp * zlogrh * zlogsa ) / zx -                                  &
5745              0.01837488495738111_wp * zlogrh**2 * zlogsa +                                        &
5746              0.0001720723574407498_wp * zt * zlogrh**2 * zlogsa -                                 &
5747              3.717657974086814E-7_wp * zt**2 * zlogrh**2 * zlogsa -                               &
5748              5.148746022615196E-10_wp * zt**3 * zlogrh**2 * zlogsa +                              &
5749              ( 0.0002686602132926594_wp * zlogrh**2 * zlogsa ) / zx -                             &
5750              0.06199739728812199_wp * zlogsa**2 + 0.000906958053583576_wp * zt * zlogsa**2 -      &
5751              9.11727926129757E-7_wp * zt**2 * zlogsa**2 -                                         &
5752              5.367963396508457E-9_wp * zt**3 * zlogsa**2 -                                        &
5753              ( 0.007742343393937707_wp * zlogsa**2 ) / zx +                                       &
5754              0.0121827103101659_wp * zlogrh * zlogsa**2 -                                         &
5755              0.0001066499571188091_wp * zt * zlogrh * zlogsa**2 +                                 &
5756              2.534598655067518E-7_wp * zt**2 * zlogrh * zlogsa**2 -                               &
5757              3.635186504599571E-10_wp * zt**3 * zlogrh * zlogsa**2 +                              &
5758              ( 0.0006100650851863252_wp * zlogrh * zlogsa **2 ) / zx +                            &
5759              0.0003201836700403512_wp * zlogsa**3 - 0.0000174761713262546_wp * zt * zlogsa**3 +   &
5760              6.065037668052182E-8_wp * zt**2 * zlogsa**3 -                                        &
5761              1.421771723004557E-11_wp * zt**3 * zlogsa**3 +                                       &
5762              ( 0.0001357509859501723_wp * zlogsa**3 ) / zx
5763    zntot = EXP( zntot )  ! in #
5764!
5765!-- 5) Size of the critical cluster pd_crit (m) (diameter) (Eq. 14)
5766    pn_crit_sa = zx * zntot
5767    pd_crit = 2.0E-9_wp * EXP( -1.6524245_wp + 0.42316402_wp * zx + 0.33466487_wp * LOG( zntot ) )
5768!
5769!-- 6) Organic compounds not involved when binary nucleation is assumed
5770    pn_crit_ocnv = 0.0_wp   ! number of organic molecules
5771    pk_sa        = 1.0_wp   ! if = 1, H2SO4 involved in nucleation
5772    pk_ocnv      = 0.0_wp   ! if = 1, organic compounds involved
5773!
5774!-- Set nucleation rate to collision rate
5775    IF ( pn_crit_sa < 4.0_wp ) THEN
5776!
5777!--    Volumes of the colliding objects
5778       zma    = 96.0_wp   ! molar mass of SO4 in g/mol
5779       zmw    = 18.0_wp   ! molar mass of water in g/mol
5780       zxmass = 1.0_wp    ! mass fraction of H2SO4
5781       za = 0.7681724_wp + zxmass * ( 2.1847140_wp + zxmass *                                      &
5782                                      ( 7.1630022_wp + zxmass *                                    &
5783                                        ( -44.31447_wp + zxmass *                                  &
5784                                          ( 88.75606 + zxmass *                                    &
5785                                            ( -75.73729_wp + zxmass * 23.43228_wp ) ) ) ) )
5786       zb = 1.808225E-3_wp + zxmass * ( -9.294656E-3_wp + zxmass *                                 &
5787                                        ( -0.03742148_wp + zxmass *                                &
5788                                          ( 0.2565321_wp + zxmass *                                &
5789                                            ( -0.5362872_wp + zxmass *                             &
5790                                              ( 0.4857736 - zxmass * 0.1629592_wp ) ) ) ) )
5791       zc = - 3.478524E-6_wp + zxmass * ( 1.335867E-5_wp + zxmass *                                &
5792                                          ( 5.195706E-5_wp + zxmass *                              &
5793                                            ( -3.717636E-4_wp + zxmass *                           &
5794                                              ( 7.990811E-4_wp + zxmass *                          &
5795                                                ( -7.458060E-4_wp + zxmass * 2.58139E-4_wp ) ) ) ) )
5796!
5797!--    Density for the sulphuric acid solution (Eq. 10 in Vehkamaki)
5798       zroo = ( za + zt * ( zb + zc * zt ) ) * 1.0E+3_wp   ! (kg/m^3
5799       zm1  = 0.098_wp   ! molar mass of H2SO4 in kg/mol
5800       zm2  = zm1
5801       zv1  = zm1 / avo / zroo   ! volume
5802       zv2  = zv1
5803!
5804!--    Collision rate
5805       zcoll =  zpcsa * zpcsa * ( 3.0_wp * pi / 4.0_wp )**0.16666666_wp *                          &
5806                SQRT( 6.0_wp * argas * zt / zm1 + 6.0_wp * argas * zt / zm2 ) *                    &
5807                ( zv1**0.33333333_wp + zv2**0.33333333_wp )**2 * 1.0E+6_wp    ! m3 -> cm3
5808       zcoll = MIN( zcoll, 1.0E+10_wp )
5809       pnuc_rate  = zcoll   ! (#/(cm3 s))
5810
5811    ELSE
5812       pnuc_rate  = MIN( pnuc_rate, 1.0E+10_wp )
5813    ENDIF
5814    pnuc_rate = pnuc_rate * 1.0E+6_wp   ! (#/(m3 s))
5815
5816 END SUBROUTINE binnucl
5817 
5818!------------------------------------------------------------------------------!
5819! Description:
5820! ------------
5821!> Calculate the nucleation rate and the size of critical clusters assuming
5822!> ternary nucleation. Parametrisation according to:
5823!> Napari et al. (2002), J. Chem. Phys., 116, 4221-4227 and
5824!> Napari et al. (2002), J. Geophys. Res., 107(D19), AAC 6-1-ACC 6-6.
5825!------------------------------------------------------------------------------!
5826 SUBROUTINE ternucl( pc_sa, pc_nh3, ptemp, prh, pnuc_rate, pn_crit_sa, pn_crit_ocnv, pd_crit,      &
5827                     pk_sa, pk_ocnv )
5828
5829    IMPLICIT NONE
5830
5831    REAL(wp) ::  zlnj     !< logarithm of nucleation rate
5832    REAL(wp) ::  zlognh3  !< LOG( pc_nh3 )
5833    REAL(wp) ::  zlogrh   !< LOG( prh )
5834    REAL(wp) ::  zlogsa   !< LOG( pc_sa )
5835
5836    REAL(wp), INTENT(in) ::   pc_nh3  !< ammonia mixing ratio (ppt)
5837    REAL(wp), INTENT(in) ::   pc_sa   !< H2SO4 conc. (#/cm3)
5838    REAL(wp), INTENT(in) ::   prh     !< relative humidity [0-1]
5839    REAL(wp), INTENT(in) ::   ptemp   !< ambient temperature (K)
5840
5841    REAL(wp), INTENT(out) ::  pd_crit  !< diameter of critical cluster (m)
5842    REAL(wp), INTENT(out) ::  pk_ocnv  !< if pk_ocnv = 1, organic compounds participate in nucleation
5843    REAL(wp), INTENT(out) ::  pk_sa    !< if pk_sa = 1, H2SO4 participate in nucleation
5844    REAL(wp), INTENT(out) ::  pn_crit_ocnv  !< number of organic molecules in cluster (#)
5845    REAL(wp), INTENT(out) ::  pn_crit_sa    !< number of H2SO4 molecules in cluster (#)
5846    REAL(wp), INTENT(out) ::  pnuc_rate     !< nucleation rate (#/(m3 s))
5847!
5848!-- 1) Checking that we are in the validity range of the parameterization.
5849!--    Validity of parameterization : DO NOT REMOVE!
5850    IF ( ptemp < 240.0_wp  .OR.  ptemp > 300.0_wp )  THEN
5851       message_string = 'Invalid input value: ptemp'
5852       CALL message( 'salsa_mod: ternucl', 'PA0689', 1, 2, 0, 6, 0 )
5853    ENDIF
5854    IF ( prh < 0.05_wp  .OR.  prh > 0.95_wp )  THEN
5855       message_string = 'Invalid input value: prh'
5856       CALL message( 'salsa_mod: ternucl', 'PA0649', 1, 2, 0, 6, 0 )
5857    ENDIF
5858    IF ( pc_sa < 1.0E+4_wp  .OR.  pc_sa > 1.0E+9_wp )  THEN
5859       message_string = 'Invalid input value: pc_sa'
5860       CALL message( 'salsa_mod: ternucl', 'PA0650', 1, 2, 0, 6, 0 )
5861    ENDIF
5862    IF ( pc_nh3 < 0.1_wp  .OR.  pc_nh3 > 100.0_wp )  THEN
5863       message_string = 'Invalid input value: pc_nh3'
5864       CALL message( 'salsa_mod: ternucl', 'PA0651', 1, 2, 0, 6, 0 )
5865    ENDIF
5866
5867    zlognh3 = LOG( pc_nh3 )
5868    zlogrh  = LOG( prh )
5869    zlogsa  = LOG( pc_sa )
5870!
5871!-- 2) Nucleation rate (Eq. 7 in Napari et al., 2002: Parameterization of
5872!--    ternary nucleation of sulfuric acid - ammonia - water.
5873    zlnj = - 84.7551114741543_wp + 0.3117595133628944_wp * prh +                                   &
5874           1.640089605712946_wp * prh * ptemp - 0.003438516933381083_wp * prh * ptemp**2 -         &
5875           0.00001097530402419113_wp * prh * ptemp**3 - 0.3552967070274677_wp / zlogsa -           &
5876           ( 0.06651397829765026_wp * prh ) / zlogsa - ( 33.84493989762471_wp * ptemp ) / zlogsa - &
5877           ( 7.823815852128623_wp * prh * ptemp ) / zlogsa +                                       &
5878           ( 0.3453602302090915_wp * ptemp**2 ) / zlogsa +                                         &
5879           ( 0.01229375748100015_wp * prh * ptemp**2 ) / zlogsa -                                  &
5880           ( 0.000824007160514956_wp *ptemp**3 ) / zlogsa +                                        &
5881           ( 0.00006185539100670249_wp * prh * ptemp**3 ) / zlogsa +                               &
5882           3.137345238574998_wp * zlogsa + 3.680240980277051_wp * prh * zlogsa -                   &
5883           0.7728606202085936_wp * ptemp * zlogsa - 0.204098217156962_wp * prh * ptemp * zlogsa +  &
5884           0.005612037586790018_wp * ptemp**2 * zlogsa +                                           &
5885           0.001062588391907444_wp * prh * ptemp**2 * zlogsa -                                     &
5886           9.74575691760229E-6_wp * ptemp**3 * zlogsa -                                            &
5887           1.265595265137352E-6_wp * prh * ptemp**3 * zlogsa + 19.03593713032114_wp * zlogsa**2 -  &
5888           0.1709570721236754_wp * ptemp * zlogsa**2 +                                             &
5889           0.000479808018162089_wp * ptemp**2 * zlogsa**2 -                                        &
5890           4.146989369117246E-7_wp * ptemp**3 * zlogsa**2 + 1.076046750412183_wp * zlognh3 +       &
5891           0.6587399318567337_wp * prh * zlognh3 + 1.48932164750748_wp * ptemp * zlognh3 +         &
5892           0.1905424394695381_wp * prh * ptemp * zlognh3 -                                         &
5893           0.007960522921316015_wp * ptemp**2 * zlognh3 -                                          &
5894           0.001657184248661241_wp * prh * ptemp**2 * zlognh3 +                                    &
5895           7.612287245047392E-6_wp * ptemp**3 * zlognh3 +                                          &
5896           3.417436525881869E-6_wp * prh * ptemp**3 * zlognh3 +                                    &
5897           ( 0.1655358260404061_wp * zlognh3 ) / zlogsa +                                          &
5898           ( 0.05301667612522116_wp * prh * zlognh3 ) / zlogsa +                                   &
5899           ( 3.26622914116752_wp * ptemp * zlognh3 ) / zlogsa -                                    &
5900           ( 1.988145079742164_wp * prh * ptemp * zlognh3 ) / zlogsa -                             &
5901           ( 0.04897027401984064_wp * ptemp**2 * zlognh3 ) / zlogsa +                              &
5902           ( 0.01578269253599732_wp * prh * ptemp**2 * zlognh3 ) / zlogsa +                        &
5903           ( 0.0001469672236351303_wp * ptemp**3 * zlognh3 ) / zlogsa -                            &
5904           ( 0.00002935642836387197_wp * prh * ptemp**3 *zlognh3 ) / zlogsa +                      &
5905           6.526451177887659_wp * zlogsa * zlognh3 -                                               &
5906           0.2580021816722099_wp * ptemp * zlogsa * zlognh3 +                                      &
5907           0.001434563104474292_wp * ptemp**2 * zlogsa * zlognh3 -                                 &
5908           2.020361939304473E-6_wp * ptemp**3 * zlogsa * zlognh3 -                                 &
5909           0.160335824596627_wp * zlogsa**2 * zlognh3 +                                            &
5910           0.00889880721460806_wp * ptemp * zlogsa**2 * zlognh3 -                                  &
5911           0.00005395139051155007_wp * ptemp**2 * zlogsa**2 * zlognh3 +                            &
5912           8.39521718689596E-8_wp * ptemp**3 * zlogsa**2 * zlognh3 +                               &
5913           6.091597586754857_wp * zlognh3**2 + 8.5786763679309_wp * prh * zlognh3**2 -             &
5914           1.253783854872055_wp * ptemp * zlognh3**2 -                                             &
5915           0.1123577232346848_wp * prh * ptemp * zlognh3**2 +                                      &
5916           0.00939835595219825_wp * ptemp**2 * zlognh3**2 +                                        &
5917           0.0004726256283031513_wp * prh * ptemp**2 * zlognh3**2 -                                &
5918           0.00001749269360523252_wp * ptemp**3 * zlognh3**2 -                                     &
5919           6.483647863710339E-7_wp * prh * ptemp**3 * zlognh3**2 +                                 &
5920           ( 0.7284285726576598_wp * zlognh3**2 ) / zlogsa +                                       &
5921           ( 3.647355600846383_wp * ptemp * zlognh3**2 ) / zlogsa -                                &
5922           ( 0.02742195276078021_wp * ptemp**2 * zlognh3**2 ) / zlogsa +                           &
5923           ( 0.00004934777934047135_wp * ptemp**3 * zlognh3**2 ) / zlogsa +                        &
5924           41.30162491567873_wp * zlogsa * zlognh3**2 -                                            &
5925           0.357520416800604_wp * ptemp * zlogsa * zlognh3**2 +                                    &
5926           0.000904383005178356_wp * ptemp**2 * zlogsa * zlognh3**2 -                              &
5927           5.737876676408978E-7_wp * ptemp**3 * zlogsa * zlognh3**2 -                              &
5928           2.327363918851818_wp * zlogsa**2 * zlognh3**2 +                                         &
5929           0.02346464261919324_wp * ptemp * zlogsa**2 * zlognh3**2 -                               &
5930           0.000076518969516405_wp * ptemp**2 * zlogsa**2 * zlognh3**2 +                           &
5931           8.04589834836395E-8_wp * ptemp**3 * zlogsa**2 * zlognh3**2 -                            &
5932           0.02007379204248076_wp * zlogrh - 0.7521152446208771_wp * ptemp * zlogrh +              &
5933           0.005258130151226247_wp * ptemp**2 * zlogrh -                                           &
5934           8.98037634284419E-6_wp * ptemp**3 * zlogrh +                                            &
5935           ( 0.05993213079516759_wp * zlogrh ) / zlogsa +                                          &
5936           ( 5.964746463184173_wp * ptemp * zlogrh ) / zlogsa -                                    &
5937           ( 0.03624322255690942_wp * ptemp**2 * zlogrh ) / zlogsa +                               &
5938           ( 0.00004933369382462509_wp * ptemp**3 * zlogrh ) / zlogsa -                            &
5939           0.7327310805365114_wp * zlognh3 * zlogrh -                                              &
5940           0.01841792282958795_wp * ptemp * zlognh3 * zlogrh +                                     &
5941           0.0001471855981005184_wp * ptemp**2 * zlognh3 * zlogrh -                                &
5942           2.377113195631848E-7_wp * ptemp**3 * zlognh3 * zlogrh
5943    pnuc_rate = EXP( zlnj )   ! (#/(cm3 s))
5944!
5945!-- Check validity of parametrization
5946    IF ( pnuc_rate < 1.0E-5_wp )  THEN
5947       pnuc_rate = 0.0_wp
5948       pd_crit   = 1.0E-9_wp
5949    ELSEIF ( pnuc_rate > 1.0E6_wp )  THEN
5950       message_string = 'Invalid output value: nucleation rate > 10^6 1/cm3s'
5951       CALL message( 'salsa_mod: ternucl', 'PA0623', 1, 2, 0, 6, 0 )
5952    ENDIF
5953    pnuc_rate = pnuc_rate * 1.0E6_wp   ! (#/(m3 s))
5954!
5955!-- 3) Number of H2SO4 molecules in a critical cluster (Eq. 9)
5956    pn_crit_sa = 38.16448247950508_wp + 0.7741058259731187_wp * zlnj +                             &
5957                 0.002988789927230632_wp * zlnj**2 - 0.3576046920535017_wp * ptemp -               &
5958                 0.003663583011953248_wp * zlnj * ptemp + 0.000855300153372776_wp * ptemp**2
5959!
5960!-- Kinetic limit: at least 2 H2SO4 molecules in a cluster
5961    pn_crit_sa = MAX( pn_crit_sa, 2.0E0_wp )
5962!
5963!-- 4) Size of the critical cluster in nm (Eq. 12)
5964    pd_crit = 0.1410271086638381_wp - 0.001226253898894878_wp * zlnj -                             &
5965              7.822111731550752E-6_wp * zlnj**2 - 0.001567273351921166_wp * ptemp -                &
5966              0.00003075996088273962_wp * zlnj * ptemp + 0.00001083754117202233_wp * ptemp**2
5967    pd_crit = pd_crit * 2.0E-9_wp   ! Diameter in m
5968!
5969!-- 5) Organic compounds not involved when ternary nucleation assumed
5970    pn_crit_ocnv = 0.0_wp
5971    pk_sa   = 1.0_wp
5972    pk_ocnv = 0.0_wp
5973
5974 END SUBROUTINE ternucl
5975
5976!------------------------------------------------------------------------------!
5977! Description:
5978! ------------
5979!> Function z_n_nuc_tayl is connected to the calculation of self-coagualtion of
5980!> small particles. It calculates number of the particles in the size range
5981!> [zdcrit,dx] using Taylor-expansion (please note that the expansion is not
5982!> valid for certain rational numbers, e.g. -4/3 and -3/2)
5983!------------------------------------------------------------------------------!
5984 FUNCTION z_n_nuc_tayl( d1, dx, zm_para, zjnuc_t, zeta, z_gr_tot )
5985
5986    IMPLICIT NONE
5987
5988    INTEGER(iwp) ::  i !< running index
5989
5990    REAL(wp) ::  d1            !< lower diameter limit
5991    REAL(wp) ::  dx            !< upper diameter limit
5992    REAL(wp) ::  zjnuc_t       !< initial nucleation rate (1/s)
5993    REAL(wp) ::  zeta          !< ratio of CS/GR (m) (condensation sink / growth rate)
5994    REAL(wp) ::  term1         !<
5995    REAL(wp) ::  term2         !<
5996    REAL(wp) ::  term3         !<
5997    REAL(wp) ::  term4         !<
5998    REAL(wp) ::  term5         !<
5999    REAL(wp) ::  z_n_nuc_tayl  !< final nucleation rate (1/s)
6000    REAL(wp) ::  z_gr_tot      !< total growth rate (nm/h)
6001    REAL(wp) ::  zm_para       !< m parameter in Lehtinen et al. (2007), Eq. 6
6002
6003    z_n_nuc_tayl = 0.0_wp
6004
6005    DO  i = 0, 29
6006       IF ( i == 0  .OR.  i == 1 )  THEN
6007          term1 = 1.0_wp
6008       ELSE
6009          term1 = term1 * REAL( i, SELECTED_REAL_KIND(12,307) )
6010       END IF
6011       term2 = ( REAL( i, SELECTED_REAL_KIND(12,307) ) * ( zm_para + 1.0_wp ) + 1.0_wp ) * term1
6012       term3 = zeta**i
6013       term4 = term3 / term2
6014       term5 = REAL( i, SELECTED_REAL_KIND(12,307) ) * ( zm_para + 1.0_wp ) + 1.0_wp
6015       z_n_nuc_tayl = z_n_nuc_tayl + term4 * ( dx**term5 - d1**term5 )
6016    ENDDO
6017    z_n_nuc_tayl = z_n_nuc_tayl * zjnuc_t * EXP( -zeta * ( d1**( zm_para + 1 ) ) ) / z_gr_tot
6018
6019 END FUNCTION z_n_nuc_tayl
6020
6021!------------------------------------------------------------------------------!
6022! Description:
6023! ------------
6024!> Calculates the condensation of water vapour on aerosol particles. Follows the
6025!> analytical predictor method by Jacobson (2005).
6026!> For equations, see Jacobson (2005), Fundamentals of atmospheric modelling
6027!> (2nd edition).
6028!------------------------------------------------------------------------------!
6029 SUBROUTINE gpparth2o( paero, ptemp, ppres, pcs, pcw, ptstep )
6030
6031    IMPLICIT NONE
6032
6033    INTEGER(iwp) ::  ib   !< loop index
6034    INTEGER(iwp) ::  nstr !<
6035
6036    REAL(wp) ::  adt        !< internal timestep in this subroutine
6037    REAL(wp) ::  rhoair     !< air density (kg/m3)
6038    REAL(wp) ::  ttot       !< total time (s)
6039    REAL(wp) ::  zact       !< Water activity
6040    REAL(wp) ::  zaelwc1    !< Current aerosol water content (kg/m3)
6041    REAL(wp) ::  zaelwc2    !< New aerosol water content after equilibrium calculation (kg/m3)
6042    REAL(wp) ::  zbeta      !< Transitional correction factor
6043    REAL(wp) ::  zcwc       !< Current water vapour mole concentration in aerosols (mol/m3)
6044    REAL(wp) ::  zcwint     !< Current and new water vapour mole concentrations (mol/m3)
6045    REAL(wp) ::  zcwn       !< New water vapour mole concentration (mol/m3)
6046    REAL(wp) ::  zcwtot     !< Total water mole concentration (mol/m3)
6047    REAL(wp) ::  zdfh2o     !< molecular diffusion coefficient (cm2/s) for water
6048    REAL(wp) ::  zhlp1      !< intermediate variable to calculate the mass transfer coefficient
6049    REAL(wp) ::  zhlp2      !< intermediate variable to calculate the mass transfer coefficient
6050    REAL(wp) ::  zhlp3      !< intermediate variable to calculate the mass transfer coefficient
6051    REAL(wp) ::  zknud      !< Knudsen number
6052    REAL(wp) ::  zmfph2o    !< mean free path of H2O gas molecule
6053    REAL(wp) ::  zrh        !< relative humidity [0-1]
6054    REAL(wp) ::  zthcond    !< thermal conductivity of air (W/m/K)
6055
6056    REAL(wp), DIMENSION(nbins_aerosol) ::  zcwcae     !< Current water mole concentrations
6057    REAL(wp), DIMENSION(nbins_aerosol) ::  zcwintae   !< Current and new aerosol water mole concentration
6058    REAL(wp), DIMENSION(nbins_aerosol) ::  zcwnae     !< New water mole concentration in aerosols
6059    REAL(wp), DIMENSION(nbins_aerosol) ::  zcwsurfae  !< Surface mole concentration
6060    REAL(wp), DIMENSION(nbins_aerosol) ::  zkelvin    !< Kelvin effect
6061    REAL(wp), DIMENSION(nbins_aerosol) ::  zmtae      !< Mass transfer coefficients
6062    REAL(wp), DIMENSION(nbins_aerosol) ::  zwsatae    !< Water saturation ratio above aerosols
6063
6064    REAL(wp), INTENT(in) ::  ppres   !< Air pressure (Pa)
6065    REAL(wp), INTENT(in) ::  pcs     !< Water vapour saturation concentration (kg/m3)
6066    REAL(wp), INTENT(in) ::  ptemp   !< Ambient temperature (K)
6067    REAL(wp), INTENT(in) ::  ptstep  !< timestep (s)
6068
6069    REAL(wp), INTENT(inout) ::  pcw  !< Water vapour concentration (kg/m3)
6070
6071    TYPE(t_section), DIMENSION(nbins_aerosol), INTENT(inout) ::  paero  !< Aerosol properties
6072!
6073!-- Relative humidity [0-1]
6074    zrh = pcw / pcs
6075!
6076!-- Calculate the condensation only for 2a/2b aerosol bins
6077    nstr = start_subrange_2a
6078!
6079!-- Save the current aerosol water content, 8 in paero is H2O
6080    zaelwc1 = SUM( paero(start_subrange_1a:end_subrange_2b)%volc(8) ) * arhoh2o
6081!
6082!-- Equilibration:
6083    IF ( advect_particle_water )  THEN
6084       IF ( zrh < 0.98_wp  .OR.  .NOT. lscndh2oae )  THEN
6085          CALL equilibration( zrh, ptemp, paero, .TRUE. )
6086       ELSE
6087          CALL equilibration( zrh, ptemp, paero, .FALSE. )
6088       ENDIF
6089    ENDIF
6090!
6091!-- The new aerosol water content after equilibrium calculation
6092    zaelwc2 = SUM( paero(start_subrange_1a:end_subrange_2b)%volc(8) ) * arhoh2o
6093!
6094!-- New water vapour mixing ratio (kg/m3)
6095    pcw = pcw - ( zaelwc2 - zaelwc1 ) * ppres * amdair / ( argas * ptemp )
6096!
6097!-- Initialise variables
6098    zcwsurfae(:) = 0.0_wp
6099    zhlp1        = 0.0_wp
6100    zhlp2        = 0.0_wp
6101    zhlp3        = 0.0_wp
6102    zmtae(:)     = 0.0_wp
6103    zwsatae(:)   = 0.0_wp
6104!
6105!-- Air:
6106!-- Density (kg/m3)
6107    rhoair = amdair * ppres / ( argas * ptemp )
6108!
6109!-- Thermal conductivity of air
6110    zthcond = 0.023807_wp + 7.1128E-5_wp * ( ptemp - 273.16_wp )
6111!
6112!-- Water vapour:
6113!-- Molecular diffusion coefficient (cm2/s) (eq.16.17)
6114    zdfh2o = ( 5.0_wp / ( 16.0_wp * avo * rhoair * 1.0E-3_wp * 3.11E-8_wp**2 ) ) * SQRT( argas *   &
6115               1.0E+7_wp * ptemp * amdair * 1.0E+3_wp * ( amh2o + amdair ) * 1.0E+3_wp /           &
6116               ( pi * amh2o * 2.0E+3_wp ) )
6117    zdfh2o = zdfh2o * 1.0E-4   ! Unit change to m^2/s
6118!
6119!-- Mean free path (eq. 15.25 & 16.29)
6120    zmfph2o = 3.0_wp * zdfh2o * SQRT( pi * amh2o / ( 8.0_wp * argas * ptemp ) )
6121!
6122!-- Kelvin effect (eq. 16.33)
6123    zkelvin(:) = EXP( 4.0_wp * surfw0 * amh2o / ( argas * ptemp * arhoh2o * paero(:)%dwet) )
6124
6125    DO  ib = 1, nbins_aerosol
6126       IF ( paero(ib)%numc > nclim  .AND.  zrh > 0.98_wp )  THEN
6127!
6128!--       Water activity
6129          zact = acth2o( paero(ib) )
6130!
6131!--       Saturation mole concentration over flat surface. Limit the super-
6132!--       saturation to max 1.01 for the mass transfer. Experimental!
6133          zcwsurfae(ib) = MAX( pcs, pcw / 1.01_wp ) * rhoair / amh2o
6134!
6135!--       Equilibrium saturation ratio
6136          zwsatae(ib) = zact * zkelvin(ib)
6137!
6138!--       Knudsen number (eq. 16.20)
6139          zknud = 2.0_wp * zmfph2o / paero(ib)%dwet
6140!
6141!--       Transitional correction factor (Fuks & Sutugin, 1971)
6142          zbeta = ( zknud + 1.0_wp ) / ( 0.377_wp * zknud + 1.0_wp + 4.0_wp /                      &
6143                  ( 3.0_wp * massacc(ib) ) * ( zknud + zknud**2 ) )
6144!
6145!--       Mass transfer of H2O: Eq. 16.64 but here D^eff =  zdfh2o * zbeta
6146          zhlp1 = paero(ib)%numc * 2.0_wp * pi * paero(ib)%dwet * zdfh2o * zbeta
6147!
6148!--       1st term on the left side of the denominator in eq. 16.55
6149          zhlp2 = amh2o * zdfh2o * alv * zwsatae(ib) * zcwsurfae(ib) / ( zthcond * ptemp )
6150!
6151!--       2nd term on the left side of the denominator in eq. 16.55
6152          zhlp3 = ( ( alv * amh2o ) / ( argas * ptemp ) ) - 1.0_wp
6153!
6154!--       Full eq. 16.64: Mass transfer coefficient (1/s)
6155          zmtae(ib) = zhlp1 / ( zhlp2 * zhlp3 + 1.0_wp )
6156       ENDIF
6157    ENDDO
6158!
6159!-- Current mole concentrations of water
6160    zcwc        = pcw * rhoair / amh2o   ! as vapour
6161    zcwcae(:)   = paero(:)%volc(8) * arhoh2o / amh2o   ! in aerosols
6162    zcwtot      = zcwc + SUM( zcwcae )   ! total water concentration
6163    zcwnae(:)   = 0.0_wp
6164    zcwintae(:) = zcwcae(:)
6165!
6166!-- Substepping loop
6167    zcwint = 0.0_wp
6168    ttot   = 0.0_wp
6169    DO  WHILE ( ttot < ptstep )
6170       adt = 2.0E-2_wp   ! internal timestep
6171!
6172!--    New vapour concentration: (eq. 16.71)
6173       zhlp1 = zcwc + adt * ( SUM( zmtae(nstr:nbins_aerosol) * zwsatae(nstr:nbins_aerosol) *       &
6174                                   zcwsurfae(nstr:nbins_aerosol) ) )   ! numerator
6175       zhlp2 = 1.0_wp + adt * ( SUM( zmtae(nstr:nbins_aerosol) ) )   ! denomin.
6176       zcwint = zhlp1 / zhlp2   ! new vapour concentration
6177       zcwint = MIN( zcwint, zcwtot )
6178       IF ( ANY( paero(:)%numc > nclim )  .AND. zrh > 0.98_wp )  THEN
6179          DO  ib = nstr, nbins_aerosol
6180             zcwintae(ib) = zcwcae(ib) + MIN( MAX( adt * zmtae(ib) * ( zcwint - zwsatae(ib) *      &
6181                                                   zcwsurfae(ib) ), -0.02_wp * zcwcae(ib) ),       &
6182                                            0.05_wp * zcwcae(ib) )
6183             zwsatae(ib) = acth2o( paero(ib), zcwintae(ib) ) * zkelvin(ib)
6184          ENDDO
6185       ENDIF
6186       zcwintae(nstr:nbins_aerosol) = MAX( zcwintae(nstr:nbins_aerosol), 0.0_wp )
6187!
6188!--    Update vapour concentration for consistency
6189       zcwint = zcwtot - SUM( zcwintae(1:nbins_aerosol) )
6190!
6191!--    Update "old" values for next cycle
6192       zcwcae = zcwintae
6193
6194       ttot = ttot + adt
6195
6196    ENDDO   ! ADT
6197
6198    zcwn      = zcwint
6199    zcwnae(:) = zcwintae(:)
6200    pcw       = zcwn * amh2o / rhoair
6201    paero(:)%volc(8) = MAX( 0.0_wp, zcwnae(:) * amh2o / arhoh2o )
6202
6203 END SUBROUTINE gpparth2o
6204
6205!------------------------------------------------------------------------------!
6206! Description:
6207! ------------
6208!> Calculates the activity coefficient of liquid water
6209!------------------------------------------------------------------------------!
6210 REAL(wp) FUNCTION acth2o( ppart, pcw )
6211
6212    IMPLICIT NONE
6213
6214    REAL(wp) ::  zns  !< molar concentration of solutes (mol/m3)
6215    REAL(wp) ::  znw  !< molar concentration of water (mol/m3)
6216
6217    REAL(wp), INTENT(in), OPTIONAL ::  pcw !< molar concentration of water (mol/m3)
6218
6219    TYPE(t_section), INTENT(in) ::  ppart !< Aerosol properties of a bin
6220
6221    zns = ( 3.0_wp * ( ppart%volc(1) * arhoh2so4 / amh2so4 ) + ( ppart%volc(2) * arhooc / amoc ) + &
6222            2.0_wp * ( ppart%volc(5) * arhoss / amss ) + ( ppart%volc(6) * arhohno3 / amhno3 ) +   &
6223            ( ppart%volc(7) * arhonh3 / amnh3 ) )
6224
6225    IF ( PRESENT(pcw) ) THEN
6226       znw = pcw
6227    ELSE
6228       znw = ppart%volc(8) * arhoh2o / amh2o
6229    ENDIF
6230!
6231!-- Activity = partial pressure of water vapour / sat. vapour pressure of water over a liquid surface
6232!--          = molality * activity coefficient (Jacobson, 2005: eq. 17.20-21)
6233!-- Assume activity coefficient of 1 for water
6234    acth2o = MAX( 0.1_wp, znw / MAX( EPSILON( 1.0_wp ),( znw + zns ) ) )
6235
6236 END FUNCTION acth2o
6237
6238!------------------------------------------------------------------------------!
6239! Description:
6240! ------------
6241!> Calculates the dissolutional growth of particles (i.e. gas transfers to a
6242!> particle surface and dissolves in liquid water on the surface). Treated here
6243!> as a non-equilibrium (time-dependent) process. Gases: HNO3 and NH3
6244!> (Chapter 17.14 in Jacobson, 2005).
6245!
6246!> Called from subroutine condensation.
6247!> Coded by:
6248!> Harri Kokkola (FMI)
6249!------------------------------------------------------------------------------!
6250 SUBROUTINE gpparthno3( ppres, ptemp, paero, pghno3, pgnh3, pcw, pcs, pbeta, ptstep )
6251
6252    IMPLICIT NONE
6253
6254    INTEGER(iwp) ::  ib  !< loop index
6255
6256    REAL(wp) ::  adt          !< timestep
6257    REAL(wp) ::  zc_nh3_c     !< Current NH3 gas concentration
6258    REAL(wp) ::  zc_nh3_int   !< Intermediate NH3 gas concentration
6259    REAL(wp) ::  zc_nh3_n     !< New NH3 gas concentration
6260    REAL(wp) ::  zc_nh3_tot   !< Total NH3 concentration
6261    REAL(wp) ::  zc_hno3_c    !< Current HNO3 gas concentration
6262    REAL(wp) ::  zc_hno3_int  !< Intermediate HNO3 gas concentration
6263    REAL(wp) ::  zc_hno3_n    !< New HNO3 gas concentration
6264    REAL(wp) ::  zc_hno3_tot  !< Total HNO3 concentration
6265    REAL(wp) ::  zdfvap       !< Diffusion coefficient for vapors
6266    REAL(wp) ::  zhlp1        !< intermediate variable
6267    REAL(wp) ::  zhlp2        !< intermediate variable
6268    REAL(wp) ::  zrh          !< relative humidity
6269
6270    REAL(wp), INTENT(in) ::  ppres      !< ambient pressure (Pa)
6271    REAL(wp), INTENT(in) ::  pcs        !< water vapour saturation
6272                                        !< concentration (kg/m3)
6273    REAL(wp), INTENT(in) ::  ptemp      !< ambient temperature (K)
6274    REAL(wp), INTENT(in) ::  ptstep     !< time step (s)
6275
6276    REAL(wp), INTENT(inout) ::  pghno3  !< nitric acid concentration (#/m3)
6277    REAL(wp), INTENT(inout) ::  pgnh3   !< ammonia conc. (#/m3)
6278    REAL(wp), INTENT(inout) ::  pcw     !< water vapour concentration (kg/m3)
6279
6280    REAL(wp), DIMENSION(nbins_aerosol) ::  zac_hno3_ae     !< Activity coefficients for HNO3
6281    REAL(wp), DIMENSION(nbins_aerosol) ::  zac_hhso4_ae    !< Activity coefficients for HHSO4
6282    REAL(wp), DIMENSION(nbins_aerosol) ::  zac_nh3_ae      !< Activity coefficients for NH3
6283    REAL(wp), DIMENSION(nbins_aerosol) ::  zac_nh4hso2_ae  !< Activity coefficients for NH4HSO2
6284    REAL(wp), DIMENSION(nbins_aerosol) ::  zcg_hno3_eq_ae  !< Equilibrium gas concentration: HNO3
6285    REAL(wp), DIMENSION(nbins_aerosol) ::  zcg_nh3_eq_ae   !< Equilibrium gas concentration: NH3
6286    REAL(wp), DIMENSION(nbins_aerosol) ::  zc_hno3_int_ae  !< Intermediate HNO3 aerosol concentration
6287    REAL(wp), DIMENSION(nbins_aerosol) ::  zc_hno3_c_ae    !< Current HNO3 in aerosols
6288    REAL(wp), DIMENSION(nbins_aerosol) ::  zc_hno3_n_ae    !< New HNO3 in aerosols
6289    REAL(wp), DIMENSION(nbins_aerosol) ::  zc_nh3_int_ae   !< Intermediate NH3 aerosol concentration
6290    REAL(wp), DIMENSION(nbins_aerosol) ::  zc_nh3_c_ae     !< Current NH3 in aerosols
6291    REAL(wp), DIMENSION(nbins_aerosol) ::  zc_nh3_n_ae     !< New NH3 in aerosols
6292    REAL(wp), DIMENSION(nbins_aerosol) ::  zkel_hno3_ae    !< Kelvin effect for HNO3
6293    REAL(wp), DIMENSION(nbins_aerosol) ::  zkel_nh3_ae     !< Kelvin effects for NH3
6294    REAL(wp), DIMENSION(nbins_aerosol) ::  zmt_hno3_ae     !< Mass transfer coefficients for HNO3
6295    REAL(wp), DIMENSION(nbins_aerosol) ::  zmt_nh3_ae      !< Mass transfer coefficients for NH3
6296    REAL(wp), DIMENSION(nbins_aerosol) ::  zsat_hno3_ae    !< HNO3 saturation ratio over a surface
6297    REAL(wp), DIMENSION(nbins_aerosol) ::  zsat_nh3_ae     !< NH3 saturation ratio over a surface
6298
6299    REAL(wp), DIMENSION(nbins_aerosol,maxspec) ::  zion_mols   !< Ion molalities from pdfite aerosols
6300
6301    REAL(wp), DIMENSION(nbins_aerosol), INTENT(in) ::  pbeta !< transitional correction factor for
6302
6303    TYPE(t_section), DIMENSION(nbins_aerosol), INTENT(inout) ::  paero !< Aerosol properties
6304!
6305!-- Initialise:
6306    adt            = ptstep
6307    zac_hhso4_ae   = 0.0_wp
6308    zac_nh3_ae     = 0.0_wp
6309    zac_nh4hso2_ae = 0.0_wp
6310    zac_hno3_ae    = 0.0_wp
6311    zcg_nh3_eq_ae  = 0.0_wp
6312    zcg_hno3_eq_ae = 0.0_wp
6313    zion_mols      = 0.0_wp
6314    zsat_nh3_ae    = 1.0_wp
6315    zsat_hno3_ae   = 1.0_wp
6316!
6317!-- Diffusion coefficient (m2/s)
6318    zdfvap = 5.1111E-10_wp * ptemp**1.75_wp * ( p_0 + 1325.0_wp ) / ppres
6319!
6320!-- Kelvin effects (Jacobson (2005), eq. 16.33)
6321    zkel_hno3_ae(1:nbins_aerosol) = EXP( 4.0_wp * surfw0 * amvhno3 /                               &
6322                                    ( abo * ptemp * paero(1:nbins_aerosol)%dwet ) )
6323    zkel_nh3_ae(1:nbins_aerosol) = EXP( 4.0_wp * surfw0 * amvnh3 /                                 &
6324                                   ( abo * ptemp * paero(1:nbins_aerosol)%dwet ) )
6325!
6326!-- Current vapour mole concentrations (mol/m3)
6327    zc_hno3_c = pghno3 / avo  ! HNO3
6328    zc_nh3_c = pgnh3 / avo   ! NH3
6329!
6330!-- Current particle mole concentrations (mol/m3)
6331    zc_hno3_c_ae(1:nbins_aerosol) = paero(1:nbins_aerosol)%volc(6) * arhohno3 / amhno3
6332    zc_nh3_c_ae(1:nbins_aerosol) = paero(1:nbins_aerosol)%volc(7) * arhonh3 / amnh3
6333!
6334!-- Total mole concentrations: gas and particle phase
6335    zc_hno3_tot = zc_hno3_c + SUM( zc_hno3_c_ae(1:nbins_aerosol) )
6336    zc_nh3_tot = zc_nh3_c + SUM( zc_nh3_c_ae(1:nbins_aerosol) )
6337!
6338!-- Relative humidity [0-1]
6339    zrh = pcw / pcs
6340!
6341!-- Mass transfer coefficients (Jacobson, Eq. 16.64)
6342    zmt_hno3_ae(:) = 2.0_wp * pi * paero(:)%dwet * zdfvap * paero(:)%numc * pbeta(:)
6343    zmt_nh3_ae(:)  = 2.0_wp * pi * paero(:)%dwet * zdfvap * paero(:)%numc * pbeta(:)
6344
6345!
6346!-- Get the equilibrium concentrations above aerosols
6347    CALL nitrate_ammonium_equilibrium( zrh, ptemp, paero, zcg_hno3_eq_ae, zcg_nh3_eq_ae,           &
6348                                       zac_hno3_ae, zac_nh3_ae, zac_nh4hso2_ae, zac_hhso4_ae,      &
6349                                       zion_mols )
6350!
6351!-- Calculate NH3 and HNO3 saturation ratios for aerosols
6352    CALL nitrate_ammonium_saturation( ptemp, paero, zac_hno3_ae, zac_nh4hso2_ae, zac_hhso4_ae,     &
6353                                      zcg_hno3_eq_ae, zc_hno3_c_ae, zc_nh3_c_ae, zkel_hno3_ae,     &
6354                                      zkel_nh3_ae, zsat_hno3_ae, zsat_nh3_ae )
6355!
6356!-- Intermediate gas concentrations of HNO3 and NH3
6357    zhlp1 = SUM( zc_hno3_c_ae(:) / ( 1.0_wp + adt * zmt_hno3_ae(:) * zsat_hno3_ae(:) ) )
6358    zhlp2 = SUM( zmt_hno3_ae(:) / ( 1.0_wp + adt * zmt_hno3_ae(:) * zsat_hno3_ae(:) ) )
6359    zc_hno3_int = ( zc_hno3_tot - zhlp1 ) / ( 1.0_wp + adt * zhlp2 )
6360
6361    zhlp1 = SUM( zc_nh3_c_ae(:) / ( 1.0_wp + adt * zmt_nh3_ae(:) * zsat_nh3_ae(:) ) )
6362    zhlp2 = SUM( zmt_nh3_ae(:) / ( 1.0_wp + adt * zmt_nh3_ae(:) * zsat_nh3_ae(:) ) )
6363    zc_nh3_int = ( zc_nh3_tot - zhlp1 )/( 1.0_wp + adt * zhlp2 )
6364
6365    zc_hno3_int = MIN( zc_hno3_int, zc_hno3_tot )
6366    zc_nh3_int = MIN( zc_nh3_int, zc_nh3_tot )
6367!
6368!-- Calculate the new concentration on aerosol particles
6369    zc_hno3_int_ae = zc_hno3_c_ae
6370    zc_nh3_int_ae = zc_nh3_c_ae
6371    DO  ib = 1, nbins_aerosol
6372       zc_hno3_int_ae(ib) = ( zc_hno3_c_ae(ib) + adt * zmt_hno3_ae(ib) * zc_hno3_int ) /           &
6373                            ( 1.0_wp + adt * zmt_hno3_ae(ib) * zsat_hno3_ae(ib) )
6374       zc_nh3_int_ae(ib) = ( zc_nh3_c_ae(ib) + adt * zmt_nh3_ae(ib) * zc_nh3_int ) /               &
6375                           ( 1.0_wp + adt * zmt_nh3_ae(ib) * zsat_nh3_ae(ib) )
6376    ENDDO
6377
6378    zc_hno3_int_ae(:) = MAX( zc_hno3_int_ae(:), 0.0_wp )
6379    zc_nh3_int_ae(:) = MAX( zc_nh3_int_ae(:), 0.0_wp )
6380!
6381!-- Final molar gas concentration and molar particle concentration of HNO3
6382    zc_hno3_n   = zc_hno3_int
6383    zc_hno3_n_ae = zc_hno3_int_ae
6384!
6385!-- Final molar gas concentration and molar particle concentration of NH3
6386    zc_nh3_n   = zc_nh3_int
6387    zc_nh3_n_ae = zc_nh3_int_ae
6388!
6389!-- Model timestep reached - update the gas concentrations
6390    pghno3 = zc_hno3_n * avo
6391    pgnh3  = zc_nh3_n * avo
6392!
6393!-- Update the particle concentrations
6394    DO  ib = start_subrange_1a, end_subrange_2b
6395       paero(ib)%volc(6) = zc_hno3_n_ae(ib) * amhno3 / arhohno3
6396       paero(ib)%volc(7) = zc_nh3_n_ae(ib) * amnh3 / arhonh3
6397    ENDDO
6398
6399 END SUBROUTINE gpparthno3
6400!------------------------------------------------------------------------------!
6401! Description:
6402! ------------
6403!> Calculate the equilibrium concentrations above aerosols (reference?)
6404!------------------------------------------------------------------------------!
6405 SUBROUTINE nitrate_ammonium_equilibrium( prh, ptemp, ppart, pcg_hno3_eq, pcg_nh3_eq, pgamma_hno3, &
6406                                          pgamma_nh4, pgamma_nh4hso2, pgamma_hhso4, pmols )
6407
6408    IMPLICIT NONE
6409
6410    INTEGER(iwp) ::  ib  !< loop index: aerosol bins
6411
6412    REAL(wp) ::  zhlp         !< intermediate variable
6413    REAL(wp) ::  zp_hcl       !< Equilibrium vapor pressures (Pa) of HCl
6414    REAL(wp) ::  zp_hno3      !< Equilibrium vapor pressures (Pa) of HNO3
6415    REAL(wp) ::  zp_nh3       !< Equilibrium vapor pressures (Pa) of NH3
6416    REAL(wp) ::  zwatertotal  !< Total water in particles (mol/m3)
6417
6418    REAL(wp), INTENT(in) ::  prh    !< relative humidity
6419    REAL(wp), INTENT(in) ::  ptemp  !< ambient temperature (K)
6420
6421    REAL(wp), DIMENSION(maxspec) ::  zgammas  !< Activity coefficients
6422    REAL(wp), DIMENSION(maxspec) ::  zions    !< molar concentration of ion (mol/m3)
6423
6424    REAL(wp), DIMENSION(nbins_aerosol), INTENT(inout) ::  pcg_nh3_eq      !< equilibrium molar
6425                                                                          !< concentration: of NH3
6426    REAL(wp), DIMENSION(nbins_aerosol), INTENT(inout) ::  pcg_hno3_eq     !< of HNO3
6427    REAL(wp), DIMENSION(nbins_aerosol), INTENT(inout) ::  pgamma_hhso4    !< activity coeff. of HHSO4
6428    REAL(wp), DIMENSION(nbins_aerosol), INTENT(inout) ::  pgamma_nh4      !< activity coeff. of NH3
6429    REAL(wp), DIMENSION(nbins_aerosol), INTENT(inout) ::  pgamma_nh4hso2  !< activity coeff. of NH4HSO2
6430    REAL(wp), DIMENSION(nbins_aerosol), INTENT(inout) ::  pgamma_hno3     !< activity coeff. of HNO3
6431
6432    REAL(wp), DIMENSION(nbins_aerosol,maxspec), INTENT(inout) ::  pmols  !< Ion molalities
6433
6434    TYPE(t_section), DIMENSION(nbins_aerosol), INTENT(inout) ::  ppart  !< Aerosol properties
6435
6436    zgammas     = 0.0_wp
6437    zhlp        = 0.0_wp
6438    zions       = 0.0_wp
6439    zp_hcl      = 0.0_wp
6440    zp_hno3     = 0.0_wp
6441    zp_nh3      = 0.0_wp
6442    zwatertotal = 0.0_wp
6443
6444    DO  ib = 1, nbins_aerosol
6445
6446       IF ( ppart(ib)%numc < nclim )  CYCLE
6447!
6448!--    Ion molar concentrations: 2*H2SO4 + CL + NO3 - Na - NH4
6449       zhlp = 2.0_wp * ppart(ib)%volc(1) * arhoh2so4 / amh2so4 + ppart(ib)%volc(5) * arhoss / amss &
6450              + ppart(ib)%volc(6) * arhohno3 / amhno3 - ppart(ib)%volc(5) * arhoss / amss -        &
6451              ppart(ib)%volc(7) * arhonh3 / amnh3
6452
6453       zions(1) = zhlp                                   ! H+
6454       zions(2) = ppart(ib)%volc(7) * arhonh3 / amnh3     ! NH4+
6455       zions(3) = ppart(ib)%volc(5) * arhoss / amss       ! Na+
6456       zions(4) = ppart(ib)%volc(1) * arhoh2so4 / amh2so4 ! SO4(2-)
6457       zions(5) = 0.0_wp                                 ! HSO4-
6458       zions(6) = ppart(ib)%volc(6) * arhohno3 / amhno3   ! NO3-
6459       zions(7) = ppart(ib)%volc(5) * arhoss / amss       ! Cl-
6460
6461       zwatertotal = ppart(ib)%volc(8) * arhoh2o / amh2o
6462       IF ( zwatertotal > 1.0E-30_wp )  THEN
6463          CALL inorganic_pdfite( prh, ptemp, zions, zwatertotal, zp_hno3, zp_hcl, zp_nh3, zgammas, &
6464                                 pmols(ib,:) )
6465       ENDIF
6466!
6467!--    Activity coefficients
6468       pgamma_hno3(ib)    = zgammas(1)  ! HNO3
6469       pgamma_nh4(ib)     = zgammas(3)  ! NH3
6470       pgamma_nh4hso2(ib) = zgammas(6)  ! NH4HSO2
6471       pgamma_hhso4(ib)   = zgammas(7)  ! HHSO4
6472!
6473!--    Equilibrium molar concentrations (mol/m3) from equlibrium pressures (Pa)
6474       pcg_hno3_eq(ib) = zp_hno3 / ( argas * ptemp )
6475       pcg_nh3_eq(ib) = zp_nh3 / ( argas * ptemp )
6476
6477    ENDDO
6478
6479  END SUBROUTINE nitrate_ammonium_equilibrium
6480
6481!------------------------------------------------------------------------------!
6482! Description:
6483! ------------
6484!> Calculate saturation ratios of NH4 and HNO3 for aerosols
6485!------------------------------------------------------------------------------!
6486 SUBROUTINE nitrate_ammonium_saturation( ptemp, ppart, pachno3, pacnh4hso2, pachhso4, pchno3eq,    &
6487                                         pchno3, pc_nh3, pkelhno3, pkelnh3, psathno3, psatnh3 )
6488
6489    IMPLICIT NONE
6490
6491    INTEGER(iwp) :: ib   !< running index for aerosol bins
6492
6493    REAL(wp) ::  k_ll_h2o   !< equilibrium constants of equilibrium reactions:
6494                            !< H2O(aq) <--> H+ + OH- (mol/kg)
6495    REAL(wp) ::  k_ll_nh3   !< NH3(aq) + H2O(aq) <--> NH4+ + OH- (mol/kg)
6496    REAL(wp) ::  k_gl_nh3   !< NH3(g) <--> NH3(aq) (mol/kg/atm)
6497    REAL(wp) ::  k_gl_hno3  !< HNO3(g) <--> H+ + NO3- (mol2/kg2/atm)
6498    REAL(wp) ::  zmol_no3   !< molality of NO3- (mol/kg)
6499    REAL(wp) ::  zmol_h     !< molality of H+ (mol/kg)
6500    REAL(wp) ::  zmol_so4   !< molality of SO4(2-) (mol/kg)
6501    REAL(wp) ::  zmol_cl    !< molality of Cl- (mol/kg)
6502    REAL(wp) ::  zmol_nh4   !< molality of NH4+ (mol/kg)
6503    REAL(wp) ::  zmol_na    !< molality of Na+ (mol/kg)
6504    REAL(wp) ::  zhlp1      !< intermediate variable
6505    REAL(wp) ::  zhlp2      !< intermediate variable
6506    REAL(wp) ::  zhlp3      !< intermediate variable
6507    REAL(wp) ::  zxi        !< particle mole concentration ratio: (NH3+SS)/H2SO4
6508    REAL(wp) ::  zt0        !< reference temp
6509
6510    REAL(wp), PARAMETER ::  a1 = -22.52_wp     !<
6511    REAL(wp), PARAMETER ::  a2 = -1.50_wp      !<
6512    REAL(wp), PARAMETER ::  a3 = 13.79_wp      !<
6513    REAL(wp), PARAMETER ::  a4 = 29.17_wp      !<
6514    REAL(wp), PARAMETER ::  b1 = 26.92_wp      !<
6515    REAL(wp), PARAMETER ::  b2 = 26.92_wp      !<
6516    REAL(wp), PARAMETER ::  b3 = -5.39_wp      !<
6517    REAL(wp), PARAMETER ::  b4 = 16.84_wp      !<
6518    REAL(wp), PARAMETER ::  K01 = 1.01E-14_wp  !<
6519    REAL(wp), PARAMETER ::  K02 = 1.81E-5_wp   !<
6520    REAL(wp), PARAMETER ::  K03 = 57.64_wp     !<
6521    REAL(wp), PARAMETER ::  K04 = 2.51E+6_wp   !<
6522
6523    REAL(wp), INTENT(in) ::  ptemp  !< ambient temperature (K)
6524
6525    REAL(wp), DIMENSION(nbins_aerosol), INTENT(in) ::  pachhso4    !< activity coeff. of HHSO4
6526    REAL(wp), DIMENSION(nbins_aerosol), INTENT(in) ::  pacnh4hso2  !< activity coeff. of NH4HSO2
6527    REAL(wp), DIMENSION(nbins_aerosol), INTENT(in) ::  pachno3     !< activity coeff. of HNO3
6528    REAL(wp), DIMENSION(nbins_aerosol), INTENT(in) ::  pchno3eq    !< eq. surface concentration: HNO3
6529    REAL(wp), DIMENSION(nbins_aerosol), INTENT(in) ::  pchno3      !< current particle mole
6530                                                                   !< concentration of HNO3 (mol/m3)
6531    REAL(wp), DIMENSION(nbins_aerosol), INTENT(in) ::  pc_nh3      !< of NH3 (mol/m3)
6532    REAL(wp), DIMENSION(nbins_aerosol), INTENT(in) ::  pkelhno3    !< Kelvin effect for HNO3
6533    REAL(wp), DIMENSION(nbins_aerosol), INTENT(in) ::  pkelnh3     !< Kelvin effect for NH3
6534
6535    REAL(wp), DIMENSION(nbins_aerosol), INTENT(out) ::  psathno3 !< saturation ratio of HNO3
6536    REAL(wp), DIMENSION(nbins_aerosol), INTENT(out) ::  psatnh3  !< saturation ratio of NH3
6537
6538    TYPE(t_section), DIMENSION(nbins_aerosol), INTENT(inout) ::  ppart  !< Aerosol properties
6539
6540    zmol_cl  = 0.0_wp
6541    zmol_h   = 0.0_wp
6542    zmol_na  = 0.0_wp
6543    zmol_nh4 = 0.0_wp
6544    zmol_no3 = 0.0_wp
6545    zmol_so4 = 0.0_wp
6546    zt0      = 298.15_wp
6547    zxi      = 0.0_wp
6548!
6549!-- Calculates equlibrium rate constants based on Table B.7 in Jacobson (2005):
6550!-- K^ll_H20, K^ll_NH3, K^gl_NH3, K^gl_HNO3
6551    zhlp1 = zt0 / ptemp
6552    zhlp2 = zhlp1 - 1.0_wp
6553    zhlp3 = 1.0_wp + LOG( zhlp1 ) - zhlp1
6554
6555    k_ll_h2o  = K01 * EXP( a1 * zhlp2 + b1 * zhlp3 )
6556    k_ll_nh3  = K02 * EXP( a2 * zhlp2 + b2 * zhlp3 )
6557    k_gl_nh3  = K03 * EXP( a3 * zhlp2 + b3 * zhlp3 )
6558    k_gl_hno3 = K04 * EXP( a4 * zhlp2 + b4 * zhlp3 )
6559
6560    DO  ib = 1, nbins_aerosol
6561
6562       IF ( ppart(ib)%numc > nclim  .AND.  ppart(ib)%volc(8) > 1.0E-30_wp  )  THEN
6563!
6564!--       Molality of H+ and NO3-
6565          zhlp1 = pc_nh3(ib) * amnh3 + ppart(ib)%volc(1) * arhoh2so4 + ppart(ib)%volc(2) * arhooc  &
6566                  + ppart(ib)%volc(5) * arhoss + ppart(ib)%volc(8) * arhoh2o
6567          zmol_no3 = pchno3(ib) / zhlp1  !< mol/kg
6568!
6569!--       Particle mole concentration ratio: (NH3+SS)/H2SO4
6570          zxi = ( pc_nh3(ib) + ppart(ib)%volc(5) * arhoss / amss ) / ( ppart(ib)%volc(1) *         &
6571                  arhoh2so4 / amh2so4 )
6572
6573          IF ( zxi <= 2.0_wp )  THEN
6574!
6575!--          Molality of SO4(2-)
6576             zhlp1 = pc_nh3(ib) * amnh3 + pchno3(ib) * amhno3 + ppart(ib)%volc(2) * arhooc +       &
6577                     ppart(ib)%volc(5) * arhoss + ppart(ib)%volc(8) * arhoh2o
6578             zmol_so4 = ( ppart(ib)%volc(1) * arhoh2so4 / amh2so4 ) / zhlp1
6579!
6580!--          Molality of Cl-
6581             zhlp1 = pc_nh3(ib) * amnh3 + pchno3(ib) * amhno3 + ppart(ib)%volc(2) * arhooc +       &
6582                     ppart(ib)%volc(1) * arhoh2so4 + ppart(ib)%volc(8) * arhoh2o
6583             zmol_cl = ( ppart(ib)%volc(5) * arhoss / amss ) / zhlp1
6584!
6585!--          Molality of NH4+
6586             zhlp1 =  pchno3(ib) * amhno3 + ppart(ib)%volc(1) * arhoh2so4 + ppart(ib)%volc(2) *    &
6587                      arhooc + ppart(ib)%volc(5) * arhoss + ppart(ib)%volc(8) * arhoh2o
6588             zmol_nh4 = pc_nh3(ib) / zhlp1
6589!
6590!--          Molality of Na+
6591             zmol_na = zmol_cl
6592!
6593!--          Molality of H+
6594             zmol_h = 2.0_wp * zmol_so4 + zmol_no3 + zmol_cl - ( zmol_nh4 + zmol_na )
6595
6596          ELSE
6597
6598             zhlp2 = pkelhno3(ib) * zmol_no3 * pachno3(ib)**2
6599
6600             IF ( zhlp2 > 1.0E-30_wp )  THEN
6601                zmol_h = k_gl_hno3 * pchno3eq(ib) / zhlp2 ! Eq. 17.38
6602             ELSE
6603                zmol_h = 0.0_wp
6604             ENDIF
6605
6606          ENDIF
6607
6608          zhlp1 = ppart(ib)%volc(8) * arhoh2o * argas * ptemp * k_gl_hno3
6609!
6610!--       Saturation ratio for NH3 and for HNO3
6611          IF ( zmol_h > 0.0_wp )  THEN
6612             zhlp2 = pkelnh3(ib) / ( zhlp1 * zmol_h )
6613             zhlp3 = k_ll_h2o / ( k_ll_nh3 + k_gl_nh3 )
6614             psatnh3(ib) = zhlp2 * ( ( pacnh4hso2(ib) / pachhso4(ib) )**2 ) * zhlp3
6615             psathno3(ib) = ( pkelhno3(ib) * zmol_h * pachno3(ib)**2 ) / zhlp1
6616          ELSE
6617             psatnh3(ib) = 1.0_wp
6618             psathno3(ib) = 1.0_wp
6619          ENDIF
6620       ELSE
6621          psatnh3(ib) = 1.0_wp
6622          psathno3(ib) = 1.0_wp
6623       ENDIF
6624
6625    ENDDO
6626
6627  END SUBROUTINE nitrate_ammonium_saturation
6628
6629!------------------------------------------------------------------------------!
6630! Description:
6631! ------------
6632!> Prototype module for calculating the water content of a mixed inorganic/
6633!> organic particle + equilibrium water vapour pressure above the solution
6634!> (HNO3, HCL, NH3 and representative organic compounds. Efficient calculation
6635!> of the partitioning of species between gas and aerosol. Based in a chamber
6636!> study.
6637!
6638!> Written by Dave Topping. Pure organic component properties predicted by Mark
6639!> Barley based on VOCs predicted in MCM simulations performed by Mike Jenkin.
6640!> Delivered by Gordon McFiggans as Deliverable D22 from WP1.4 in the EU FP6
6641!> EUCAARI Integrated Project.
6642!
6643!> REFERENCES
6644!> Clegg et al. (1998) A Thermodynamic Model of the System H+-NH4+-Na+-SO42- -NO3--Cl--H2O at
6645!>    298.15 K, J. Phys. Chem., 102A, 2155-2171.
6646!> Clegg et al. (2001) Thermodynamic modelling of aqueous aerosols containing electrolytes and
6647!>    dissolved organic compounds. Journal of Aerosol Science 2001;32(6):713-738.
6648!> Topping et al. (2005a) A curved multi-component aerosol hygroscopicity model framework: Part 1 -
6649!>    Inorganic compounds. Atmospheric Chemistry and Physics 2005;5:1205-1222.
6650!> Topping et al. (2005b) A curved multi-component aerosol hygroscopicity model framework: Part 2 -
6651!>    Including organic compounds. Atmospheric Chemistry and Physics 2005;5:1223-1242.
6652!> Wagman et al. (1982). The NBS tables of chemical thermodynamic properties: selected values for
6653!>    inorganic and C₁ and C₂ organic substances in SI units (book)
6654!> Zaveri et al. (2005). A new method for multicomponent activity coefficients of electrolytes in
6655!>    aqueous atmospheric aerosols, JGR, 110, D02201, 2005.
6656!
6657!> Queries concerning the use of this code through Gordon McFiggans,
6658!> g.mcfiggans@manchester.ac.uk,
6659!> Ownership: D. Topping, Centre for Atmospheric Sciences, University of
6660!> Manchester, 2007
6661!
6662!> Rewritten to PALM by Mona Kurppa, UHel, 2017
6663!------------------------------------------------------------------------------!
6664 SUBROUTINE inorganic_pdfite( rh, temp, ions, water_total, press_hno3, press_hcl, press_nh3,       &
6665                              gamma_out, mols_out )
6666
6667    IMPLICIT NONE
6668
6669    INTEGER(iwp) ::  binary_case
6670    INTEGER(iwp) ::  full_complexity
6671
6672    REAL(wp) ::  a                         !< auxiliary variable
6673    REAL(wp) ::  act_product               !< ionic activity coef. product:
6674                                           !< = (gamma_h2so4**3d0) / gamma_hhso4**2d0)
6675    REAL(wp) ::  ammonium_chloride         !<
6676    REAL(wp) ::  ammonium_chloride_eq_frac !<
6677    REAL(wp) ::  ammonium_nitrate          !<
6678    REAL(wp) ::  ammonium_nitrate_eq_frac  !<
6679    REAL(wp) ::  ammonium_sulphate         !<
6680    REAL(wp) ::  ammonium_sulphate_eq_frac !<
6681    REAL(wp) ::  b                         !< auxiliary variable
6682    REAL(wp) ::  binary_h2so4              !< binary H2SO4 activity coeff.
6683    REAL(wp) ::  binary_hcl                !< binary HCL activity coeff.
6684    REAL(wp) ::  binary_hhso4              !< binary HHSO4 activity coeff.
6685    REAL(wp) ::  binary_hno3               !< binary HNO3 activity coeff.
6686    REAL(wp) ::  binary_nh4hso4            !< binary NH4HSO4 activity coeff.
6687    REAL(wp) ::  c                         !< auxiliary variable
6688    REAL(wp) ::  charge_sum                !< sum of ionic charges
6689    REAL(wp) ::  gamma_h2so4               !< activity coefficient
6690    REAL(wp) ::  gamma_hcl                 !< activity coefficient
6691    REAL(wp) ::  gamma_hhso4               !< activity coeffient
6692    REAL(wp) ::  gamma_hno3                !< activity coefficient
6693    REAL(wp) ::  gamma_nh3                 !< activity coefficient
6694    REAL(wp) ::  gamma_nh4hso4             !< activity coefficient
6695    REAL(wp) ::  h_out                     !<
6696    REAL(wp) ::  h_real                    !< new hydrogen ion conc.
6697    REAL(wp) ::  h2so4_hcl                 !< contribution of H2SO4
6698    REAL(wp) ::  h2so4_hno3                !< contribution of H2SO4
6699    REAL(wp) ::  h2so4_nh3                 !< contribution of H2SO4
6700    REAL(wp) ::  h2so4_nh4hso4             !< contribution of H2SO4
6701    REAL(wp) ::  hcl_h2so4                 !< contribution of HCL
6702    REAL(wp) ::  hcl_hhso4                 !< contribution of HCL
6703    REAL(wp) ::  hcl_hno3                  !< contribution of HCL
6704    REAL(wp) ::  hcl_nh4hso4               !< contribution of HCL
6705    REAL(wp) ::  henrys_temp_dep           !< temperature dependence of Henry's Law
6706    REAL(wp) ::  hno3_h2so4                !< contribution of HNO3
6707    REAL(wp) ::  hno3_hcl                  !< contribution of HNO3
6708    REAL(wp) ::  hno3_hhso4                !< contribution of HNO3
6709    REAL(wp) ::  hno3_nh3                  !< contribution of HNO3
6710    REAL(wp) ::  hno3_nh4hso4              !< contribution of HNO3
6711    REAL(wp) ::  hso4_out                  !<
6712    REAL(wp) ::  hso4_real                 !< new bisulphate ion conc.
6713    REAL(wp) ::  hydrochloric_acid         !<
6714    REAL(wp) ::  hydrochloric_acid_eq_frac !<
6715    REAL(wp) ::  k_h                       !< equilibrium constant for H+
6716    REAL(wp) ::  k_hcl                     !< equilibrium constant of HCL
6717    REAL(wp) ::  k_hno3                    !< equilibrium constant of HNO3
6718    REAL(wp) ::  k_nh4                     !< equilibrium constant for NH4+
6719    REAL(wp) ::  k_h2o                     !< equil. const. for water_surface
6720    REAL(wp) ::  ln_h2so4_act              !< gamma_h2so4 = EXP(ln_h2so4_act)
6721    REAL(wp) ::  ln_HCL_act                !< gamma_hcl = EXP( ln_HCL_act )
6722    REAL(wp) ::  ln_hhso4_act              !< gamma_hhso4 = EXP(ln_hhso4_act)
6723    REAL(wp) ::  ln_hno3_act               !< gamma_hno3 = EXP( ln_hno3_act )
6724    REAL(wp) ::  ln_nh4hso4_act            !< gamma_nh4hso4 = EXP( ln_nh4hso4_act )
6725    REAL(wp) ::  molality_ratio_nh3        !< molality ratio of NH3 (NH4+ and H+)
6726    REAL(wp) ::  na2so4_h2so4              !< contribution of Na2SO4
6727    REAL(wp) ::  na2so4_hcl                !< contribution of Na2SO4
6728    REAL(wp) ::  na2so4_hhso4              !< contribution of Na2SO4
6729    REAL(wp) ::  na2so4_hno3               !< contribution of Na2SO4
6730    REAL(wp) ::  na2so4_nh3                !< contribution of Na2SO4
6731    REAL(wp) ::  na2so4_nh4hso4            !< contribution of Na2SO4
6732    REAL(wp) ::  nacl_h2so4                !< contribution of NaCl
6733    REAL(wp) ::  nacl_hcl                  !< contribution of NaCl
6734    REAL(wp) ::  nacl_hhso4                !< contribution of NaCl
6735    REAL(wp) ::  nacl_hno3                 !< contribution of NaCl
6736    REAL(wp) ::  nacl_nh3                  !< contribution of NaCl
6737    REAL(wp) ::  nacl_nh4hso4              !< contribution of NaCl
6738    REAL(wp) ::  nano3_h2so4               !< contribution of NaNO3
6739    REAL(wp) ::  nano3_hcl                 !< contribution of NaNO3
6740    REAL(wp) ::  nano3_hhso4               !< contribution of NaNO3
6741    REAL(wp) ::  nano3_hno3                !< contribution of NaNO3
6742    REAL(wp) ::  nano3_nh3                 !< contribution of NaNO3
6743    REAL(wp) ::  nano3_nh4hso4             !< contribution of NaNO3
6744    REAL(wp) ::  nh42so4_h2so4             !< contribution of NH42SO4
6745    REAL(wp) ::  nh42so4_hcl               !< contribution of NH42SO4
6746    REAL(wp) ::  nh42so4_hhso4             !< contribution of NH42SO4
6747    REAL(wp) ::  nh42so4_hno3              !< contribution of NH42SO4
6748    REAL(wp) ::  nh42so4_nh3               !< contribution of NH42SO4
6749    REAL(wp) ::  nh42so4_nh4hso4           !< contribution of NH42SO4
6750    REAL(wp) ::  nh4cl_h2so4               !< contribution of NH4Cl
6751    REAL(wp) ::  nh4cl_hcl                 !< contribution of NH4Cl
6752    REAL(wp) ::  nh4cl_hhso4               !< contribution of NH4Cl
6753    REAL(wp) ::  nh4cl_hno3                !< contribution of NH4Cl
6754    REAL(wp) ::  nh4cl_nh3                 !< contribution of NH4Cl
6755    REAL(wp) ::  nh4cl_nh4hso4             !< contribution of NH4Cl
6756    REAL(wp) ::  nh4no3_h2so4              !< contribution of NH4NO3
6757    REAL(wp) ::  nh4no3_hcl                !< contribution of NH4NO3
6758    REAL(wp) ::  nh4no3_hhso4              !< contribution of NH4NO3
6759    REAL(wp) ::  nh4no3_hno3               !< contribution of NH4NO3
6760    REAL(wp) ::  nh4no3_nh3                !< contribution of NH4NO3
6761    REAL(wp) ::  nh4no3_nh4hso4            !< contribution of NH4NO3
6762    REAL(wp) ::  nitric_acid               !<
6763    REAL(wp) ::  nitric_acid_eq_frac       !< Equivalent fractions
6764    REAL(wp) ::  press_hcl                 !< partial pressure of HCL
6765    REAL(wp) ::  press_hno3                !< partial pressure of HNO3
6766    REAL(wp) ::  press_nh3                 !< partial pressure of NH3
6767    REAL(wp) ::  rh                        !< relative humidity [0-1]
6768    REAL(wp) ::  root1                     !< auxiliary variable
6769    REAL(wp) ::  root2                     !< auxiliary variable
6770    REAL(wp) ::  so4_out                   !<
6771    REAL(wp) ::  so4_real                  !< new sulpate ion concentration
6772    REAL(wp) ::  sodium_chloride           !<
6773    REAL(wp) ::  sodium_chloride_eq_frac   !<
6774    REAL(wp) ::  sodium_nitrate            !<
6775    REAL(wp) ::  sodium_nitrate_eq_frac    !<
6776    REAL(wp) ::  sodium_sulphate           !<
6777    REAL(wp) ::  sodium_sulphate_eq_frac   !<
6778    REAL(wp) ::  solutes                   !<
6779    REAL(wp) ::  sulphuric_acid            !<
6780    REAL(wp) ::  sulphuric_acid_eq_frac    !<
6781    REAL(wp) ::  temp                      !< temperature
6782    REAL(wp) ::  water_total               !<
6783
6784    REAL(wp), DIMENSION(:) ::  gamma_out !< Activity coefficient for calculating the non-ideal
6785                                         !< dissociation constants
6786                                         !< 1: HNO3, 2: HCL, 3: NH4+/H+ (NH3), 4: HHSO4**2/H2SO4,
6787                                         !< 5: H2SO4**3/HHSO4**2, 6: NH4HSO2, 7: HHSO4
6788    REAL(wp), DIMENSION(:) ::  ions      !< ion molarities (mol/m3): 1: H+, 2: NH4+, 3: Na+,
6789                                         !< 4: SO4(2-), 5: HSO4-, 6: NO3-, 7: Cl-
6790    REAL(wp), DIMENSION(7) ::  ions_mol  !< ion molalities (mol/kg): 1: H+, 2: NH4+, 3: Na+,
6791                                         !< 4: SO4(2-), 5: HSO4-, 6: NO3-, 7: Cl-
6792    REAL(wp), DIMENSION(:) ::  mols_out  !< ion molality output (mol/kg): 1: H+, 2: NH4+, 3: Na+,
6793                                         !< 4: SO4(2-), 5: HSO4-, 6: NO3-, 7: Cl-
6794!
6795!-- Value initialisation
6796    binary_h2so4    = 0.0_wp
6797    binary_hcl      = 0.0_wp
6798    binary_hhso4    = 0.0_wp
6799    binary_hno3     = 0.0_wp
6800    binary_nh4hso4  = 0.0_wp
6801    henrys_temp_dep = ( 1.0_wp / temp - 0.0033557_wp ) ! 1/T - 1/298 K
6802    hcl_hno3        = 1.0_wp
6803    h2so4_hno3      = 1.0_wp
6804    nh42so4_hno3    = 1.0_wp
6805    nh4no3_hno3     = 1.0_wp
6806    nh4cl_hno3      = 1.0_wp
6807    na2so4_hno3     = 1.0_wp
6808    nano3_hno3      = 1.0_wp
6809    nacl_hno3       = 1.0_wp
6810    hno3_hcl        = 1.0_wp
6811    h2so4_hcl       = 1.0_wp
6812    nh42so4_hcl     = 1.0_wp
6813    nh4no3_hcl      = 1.0_wp
6814    nh4cl_hcl       = 1.0_wp
6815    na2so4_hcl      = 1.0_wp
6816    nano3_hcl       = 1.0_wp
6817    nacl_hcl        = 1.0_wp
6818    hno3_nh3        = 1.0_wp
6819    h2so4_nh3       = 1.0_wp
6820    nh42so4_nh3     = 1.0_wp
6821    nh4no3_nh3      = 1.0_wp
6822    nh4cl_nh3       = 1.0_wp
6823    na2so4_nh3      = 1.0_wp
6824    nano3_nh3       = 1.0_wp
6825    nacl_nh3        = 1.0_wp
6826    hno3_hhso4      = 1.0_wp
6827    hcl_hhso4       = 1.0_wp
6828    nh42so4_hhso4   = 1.0_wp
6829    nh4no3_hhso4    = 1.0_wp
6830    nh4cl_hhso4     = 1.0_wp
6831    na2so4_hhso4    = 1.0_wp
6832    nano3_hhso4     = 1.0_wp
6833    nacl_hhso4      = 1.0_wp
6834    hno3_h2so4      = 1.0_wp
6835    hcl_h2so4       = 1.0_wp
6836    nh42so4_h2so4   = 1.0_wp
6837    nh4no3_h2so4    = 1.0_wp
6838    nh4cl_h2so4     = 1.0_wp
6839    na2so4_h2so4    = 1.0_wp
6840    nano3_h2so4     = 1.0_wp
6841    nacl_h2so4      = 1.0_wp
6842!
6843!-- New NH3 variables
6844    hno3_nh4hso4    = 1.0_wp
6845    hcl_nh4hso4     = 1.0_wp
6846    h2so4_nh4hso4   = 1.0_wp
6847    nh42so4_nh4hso4 = 1.0_wp
6848    nh4no3_nh4hso4  = 1.0_wp
6849    nh4cl_nh4hso4   = 1.0_wp
6850    na2so4_nh4hso4  = 1.0_wp
6851    nano3_nh4hso4   = 1.0_wp
6852    nacl_nh4hso4    = 1.0_wp
6853!
6854!-- Juha Tonttila added
6855    mols_out   = 0.0_wp
6856    press_hno3 = 0.0_wp  !< Initialising vapour pressures over the
6857    press_hcl  = 0.0_wp  !< multicomponent particle
6858    press_nh3  = 0.0_wp
6859    gamma_out  = 1.0_wp  !< i.e. don't alter the ideal mixing ratios if there's nothing there.
6860!
6861!-- 1) - COMPOSITION DEFINITIONS
6862!
6863!-- a) Inorganic ion pairing:
6864!-- In order to calculate the water content, which is also used in calculating vapour pressures, one
6865!-- needs to pair the anions and cations for use in the ZSR mixing rule. The equation provided by
6866!-- Clegg et al. (2001) is used for ion pairing. The solutes chosen comprise of 9 inorganic salts
6867!-- and acids which provide a pairing between each anion and cation: (NH4)2SO4, NH4NO3, NH4Cl,
6868!-- Na2SO4, NaNO3, NaCl, H2SO4, HNO3, HCL. The organic compound is treated as a seperate solute.
6869!-- Ions: 1: H+, 2: NH4+, 3: Na+, 4: SO4(2-), 5: HSO4-, 6: NO3-, 7: Cl-
6870!
6871    charge_sum = ions(1) + ions(2) + ions(3) + 2.0_wp * ions(4) + ions(5) + ions(6) + ions(7)
6872    nitric_acid       = ( 2.0_wp * ions(1) * ions(6) ) / charge_sum
6873    hydrochloric_acid = ( 2.0_wp * ions(1) * ions(7) ) / charge_sum
6874    sulphuric_acid    = ( 2.0_wp * ions(1) * ions(4) ) / charge_sum
6875    ammonium_sulphate = ( 2.0_wp * ions(2) * ions(4) ) / charge_sum
6876    ammonium_nitrate  = ( 2.0_wp * ions(2) * ions(6) ) / charge_sum
6877    ammonium_chloride = ( 2.0_wp * ions(2) * ions(7) ) / charge_sum
6878    sodium_sulphate   = ( 2.0_wp * ions(3) * ions(4) ) / charge_sum
6879    sodium_nitrate    = ( 2.0_wp * ions(3) * ions(6) ) / charge_sum
6880    sodium_chloride   = ( 2.0_wp * ions(3) * ions(7) ) / charge_sum
6881    solutes = 0.0_wp
6882    solutes = 3.0_wp * sulphuric_acid    + 2.0_wp * hydrochloric_acid + 2.0_wp * nitric_acid +     &
6883              3.0_wp * ammonium_sulphate + 2.0_wp * ammonium_nitrate + 2.0_wp * ammonium_chloride +&
6884              3.0_wp * sodium_sulphate   + 2.0_wp * sodium_nitrate   + 2.0_wp * sodium_chloride
6885!
6886!-- b) Inorganic equivalent fractions:
6887!-- These values are calculated so that activity coefficients can be expressed by a linear additive
6888!-- rule, thus allowing more efficient calculations and future expansion (see more detailed
6889!-- description below)
6890    nitric_acid_eq_frac       = 2.0_wp * nitric_acid / solutes
6891    hydrochloric_acid_eq_frac = 2.0_wp * hydrochloric_acid / solutes
6892    sulphuric_acid_eq_frac    = 3.0_wp * sulphuric_acid / solutes
6893    ammonium_sulphate_eq_frac = 3.0_wp * ammonium_sulphate / solutes
6894    ammonium_nitrate_eq_frac  = 2.0_wp * ammonium_nitrate / solutes
6895    ammonium_chloride_eq_frac = 2.0_wp * ammonium_chloride / solutes
6896    sodium_sulphate_eq_frac   = 3.0_wp * sodium_sulphate / solutes
6897    sodium_nitrate_eq_frac    = 2.0_wp * sodium_nitrate / solutes
6898    sodium_chloride_eq_frac   = 2.0_wp * sodium_chloride / solutes
6899!
6900!-- Inorganic ion molalities
6901    ions_mol(1) = ions(1) / ( water_total * 18.01528E-3_wp )   ! H+
6902    ions_mol(2) = ions(2) / ( water_total * 18.01528E-3_wp )   ! NH4+
6903    ions_mol(3) = ions(3) / ( water_total * 18.01528E-3_wp )   ! Na+
6904    ions_mol(4) = ions(4) / ( water_total * 18.01528E-3_wp )   ! SO4(2-)
6905    ions_mol(5) = ions(5) / ( water_total * 18.01528E-3_wp )   ! HSO4(2-)
6906    ions_mol(6) = ions(6) / ( water_total * 18.01528E-3_wp )   !  NO3-
6907    ions_mol(7) = ions(7) / ( water_total * 18.01528E-3_wp )   ! Cl-
6908
6909!-- ***
6910!-- At this point we may need to introduce a method for prescribing H+ when there is no 'real' value
6911!-- for H+..i.e. in the sulphate poor domain. This will give a value for solve quadratic proposed by
6912!-- Zaveri et al. 2005
6913!
6914!-- 2) - WATER CALCULATION
6915!
6916!-- a) The water content is calculated using the ZSR rule with solute concentrations calculated
6917!-- using 1a above. Whilst the usual approximation of ZSR relies on binary data consisting of 5th or
6918!-- higher order polynomials, in this code 4 different RH regimes are used, each housing cubic
6919!-- equations for the water associated with each solute listed above. Binary water contents for
6920!-- inorganic components were calculated using AIM online (Clegg et al 1998). The water associated
6921!-- with the organic compound is calculated assuming ideality and that aw = RH.
6922!
6923!-- b) Molality of each inorganic ion and organic solute (initial input) is calculated for use in
6924!-- vapour pressure calculation.
6925!
6926!-- 3) - BISULPHATE ION DISSOCIATION CALCULATION
6927!
6928!-- The dissociation of the bisulphate ion is calculated explicitly. A solution to the equilibrium
6929!-- equation between the bisulphate ion, hydrogen ion and sulphate ion is found using tabulated
6930!-- equilibrium constants (referenced). It is necessary to calculate the activity coefficients of
6931!-- HHSO4 and H2SO4 in a non-iterative manner. These are calculated using the same format as
6932!-- described in 4) below, where both activity coefficients were fit to the output from ADDEM
6933!-- (Topping et al 2005a,b) covering an extensive composition space, providing the activity
6934!-- coefficients and bisulphate ion dissociation as a function of equivalent mole fractions and
6935!-- relative humidity.
6936!
6937!-- NOTE: the flags "binary_case" and "full_complexity" are not used in this prototype. They are
6938!-- used for simplification of the fit expressions when using limited composition regions. This
6939!-- section of code calculates the bisulphate ion concentration.
6940!
6941    IF ( ions(1) > 0.0_wp .AND. ions(4) > 0.0_wp ) THEN
6942!
6943!--    HHSO4:
6944       binary_case = 1
6945       IF ( rh > 0.1_wp  .AND.  rh < 0.9_wp )  THEN
6946          binary_hhso4 = -4.9521_wp * rh**3 + 9.2881_wp * rh**2 - 10.777_wp * rh + 6.0534_wp
6947       ELSEIF ( rh >= 0.9_wp  .AND.  rh < 0.955_wp )  THEN
6948          binary_hhso4 = -6.3777_wp * rh + 5.962_wp
6949       ELSEIF ( rh >= 0.955_wp  .AND.  rh < 0.99_wp )  THEN
6950          binary_hhso4 = 2367.2_wp * rh**3 - 6849.7_wp * rh**2 + 6600.9_wp * rh - 2118.7_wp
6951       ELSEIF ( rh >= 0.99_wp  .AND.  rh < 0.9999_wp )  THEN
6952          binary_hhso4 = 3E-7_wp * rh**5 - 2E-5_wp * rh**4 + 0.0004_wp * rh**3 - 0.0035_wp * rh**2 &
6953                         + 0.0123_wp * rh - 0.3025_wp
6954       ENDIF
6955
6956       IF ( nitric_acid > 0.0_wp )  THEN
6957          hno3_hhso4 = -4.2204_wp * rh**4 + 12.193_wp * rh**3 - 12.481_wp * rh**2 + 6.459_wp * rh  &
6958                       - 1.9004_wp
6959       ENDIF
6960
6961       IF ( hydrochloric_acid > 0.0_wp )  THEN
6962          hcl_hhso4 = -54.845_wp * rh**7 + 209.54_wp * rh**6 - 336.59_wp * rh**5 + 294.21_wp *     &
6963                      rh**4 - 150.07_wp * rh**3 + 43.767_wp * rh**2 - 6.5495_wp * rh + 0.60048_wp
6964       ENDIF
6965
6966       IF ( ammonium_sulphate > 0.0_wp )  THEN
6967          nh42so4_hhso4 = 16.768_wp * rh**3 - 28.75_wp * rh**2 + 20.011_wp * rh - 8.3206_wp
6968       ENDIF
6969
6970       IF ( ammonium_nitrate > 0.0_wp )  THEN
6971          nh4no3_hhso4 = -17.184_wp * rh**4 + 56.834_wp * rh**3 - 65.765_wp * rh**2 +              &
6972                         35.321_wp * rh - 9.252_wp
6973       ENDIF
6974
6975       IF (ammonium_chloride > 0.0_wp )  THEN
6976          IF ( rh < 0.2_wp .AND. rh >= 0.1_wp )  THEN
6977             nh4cl_hhso4 = 3.2809_wp * rh - 2.0637_wp
6978          ELSEIF ( rh >= 0.2_wp .AND. rh < 0.99_wp )  THEN
6979             nh4cl_hhso4 = -1.2981_wp * rh**3 + 4.7461_wp * rh**2 - 2.3269_wp * rh - 1.1259_wp
6980          ENDIF
6981       ENDIF
6982
6983       IF ( sodium_sulphate > 0.0_wp )  THEN
6984          na2so4_hhso4 = 118.87_wp * rh**6 - 358.63_wp * rh**5 + 435.85_wp * rh**4 - 272.88_wp *   &
6985                         rh**3 + 94.411_wp * rh**2 - 18.21_wp * rh + 0.45935_wp
6986       ENDIF
6987
6988       IF ( sodium_nitrate > 0.0_wp )  THEN
6989          IF ( rh < 0.2_wp  .AND.  rh >= 0.1_wp )  THEN
6990             nano3_hhso4 = 4.8456_wp * rh - 2.5773_wp
6991          ELSEIF ( rh >= 0.2_wp  .AND.  rh < 0.99_wp )  THEN
6992             nano3_hhso4 = 0.5964_wp * rh**3 - 0.38967_wp * rh**2 + 1.7918_wp * rh - 1.9691_wp
6993          ENDIF
6994       ENDIF
6995
6996       IF ( sodium_chloride > 0.0_wp )  THEN
6997          IF ( rh < 0.2_wp )  THEN
6998             nacl_hhso4 = 0.51995_wp * rh - 1.3981_wp
6999          ELSEIF ( rh >= 0.2_wp  .AND.  rh < 0.99_wp )  THEN
7000             nacl_hhso4 = 1.6539_wp * rh - 1.6101_wp
7001          ENDIF
7002       ENDIF
7003
7004       ln_hhso4_act = binary_hhso4 + nitric_acid_eq_frac * hno3_hhso4 +                            &
7005                      hydrochloric_acid_eq_frac * hcl_hhso4 +                                      &
7006                      ammonium_sulphate_eq_frac * nh42so4_hhso4 +                                  &
7007                      ammonium_nitrate_eq_frac  * nh4no3_hhso4 +                                   &
7008                      ammonium_chloride_eq_frac * nh4cl_hhso4 +                                    &
7009                      sodium_sulphate_eq_frac   * na2so4_hhso4 +                                   &
7010                      sodium_nitrate_eq_frac * nano3_hhso4 + sodium_chloride_eq_frac   * nacl_hhso4
7011
7012       gamma_hhso4 = EXP( ln_hhso4_act )   ! molal activity coefficient of HHSO4
7013
7014!--    H2SO4 (sulphuric acid):
7015       IF ( rh >= 0.1_wp  .AND.  rh < 0.9_wp )  THEN
7016          binary_h2so4 = 2.4493_wp * rh**2 - 6.2326_wp * rh + 2.1763_wp
7017       ELSEIF ( rh >= 0.9_wp  .AND.  rh < 0.98 )  THEN
7018          binary_h2so4 = 914.68_wp * rh**3 - 2502.3_wp * rh**2 + 2281.9_wp * rh - 695.11_wp
7019       ELSEIF ( rh >= 0.98  .AND.  rh < 0.9999 )  THEN
7020          binary_h2so4 = 3.0E-8_wp * rh**4 - 5E-6_wp * rh**3 + 0.0003_wp * rh**2 - 0.0022_wp *     &
7021                         rh - 1.1305_wp
7022       ENDIF
7023
7024       IF ( nitric_acid > 0.0_wp )  THEN
7025          hno3_h2so4 = - 16.382_wp * rh**5 + 46.677_wp * rh**4 - 54.149_wp * rh**3 + 34.36_wp *    &
7026                         rh**2 - 12.54_wp * rh + 2.1368_wp
7027       ENDIF
7028
7029       IF ( hydrochloric_acid > 0.0_wp )  THEN
7030          hcl_h2so4 = - 14.409_wp * rh**5 + 42.804_wp * rh**4 - 47.24_wp * rh**3 + 24.668_wp *     &
7031                        rh**2 - 5.8015_wp * rh + 0.084627_wp
7032       ENDIF
7033
7034       IF ( ammonium_sulphate > 0.0_wp )  THEN
7035          nh42so4_h2so4 = 66.71_wp * rh**5 - 187.5_wp * rh**4 + 210.57_wp * rh**3 - 121.04_wp *    &
7036                          rh**2 + 39.182_wp * rh - 8.0606_wp
7037       ENDIF
7038
7039       IF ( ammonium_nitrate > 0.0_wp )  THEN
7040          nh4no3_h2so4 = - 22.532_wp * rh**4 + 66.615_wp * rh**3 - 74.647_wp * rh**2 + 37.638_wp * &
7041                         rh - 6.9711_wp
7042       ENDIF
7043
7044       IF ( ammonium_chloride > 0.0_wp )  THEN
7045          IF ( rh >= 0.1_wp  .AND.  rh < 0.2_wp )  THEN
7046             nh4cl_h2so4 = - 0.32089_wp * rh + 0.57738_wp
7047          ELSEIF ( rh >= 0.2_wp  .AND.  rh < 0.9_wp )  THEN
7048             nh4cl_h2so4 = 18.089_wp * rh**5 - 51.083_wp * rh**4 + 50.32_wp * rh**3 - 17.012_wp *  &
7049                           rh**2 - 0.93435_wp * rh + 1.0548_wp
7050          ELSEIF ( rh >= 0.9_wp  .AND.  rh < 0.99_wp )  THEN
7051             nh4cl_h2so4 = - 1.5749_wp * rh + 1.7002_wp
7052          ENDIF
7053       ENDIF
7054
7055       IF ( sodium_sulphate > 0.0_wp )  THEN
7056          na2so4_h2so4 = 29.843_wp * rh**4 - 69.417_wp * rh**3 + 61.507_wp * rh**2 - 29.874_wp *   &
7057                         rh + 7.7556_wp
7058       ENDIF
7059
7060       IF ( sodium_nitrate > 0.0_wp )  THEN
7061          nano3_h2so4 = - 122.37_wp * rh**6 + 427.43_wp * rh**5 - 604.68_wp * rh**4 + 443.08_wp *  &
7062                        rh**3 - 178.61_wp * rh**2 + 37.242_wp * rh - 1.9564_wp
7063       ENDIF
7064
7065       IF ( sodium_chloride > 0.0_wp )  THEN
7066          nacl_h2so4 = - 40.288_wp * rh**5 + 115.61_wp * rh**4 - 129.99_wp * rh**3 + 72.652_wp *   &
7067                       rh**2 - 22.124_wp * rh + 4.2676_wp
7068       ENDIF
7069
7070       ln_h2so4_act = binary_h2so4 + nitric_acid_eq_frac * hno3_h2so4 +                            &
7071                      hydrochloric_acid_eq_frac * hcl_h2so4 +                                      &
7072                      ammonium_sulphate_eq_frac * nh42so4_h2so4 +                                  &
7073                      ammonium_nitrate_eq_frac  * nh4no3_h2so4 +                                   &
7074                      ammonium_chloride_eq_frac * nh4cl_h2so4 +                                    &
7075                      sodium_sulphate_eq_frac * na2so4_h2so4 +                                     &
7076                      sodium_nitrate_eq_frac * nano3_h2so4 + sodium_chloride_eq_frac * nacl_h2so4
7077
7078       gamma_h2so4 = EXP( ln_h2so4_act )    ! molal activity coefficient
7079!
7080!--    Export activity coefficients
7081       IF ( gamma_h2so4 > 1.0E-10_wp )  THEN
7082          gamma_out(4) = gamma_hhso4**2 / gamma_h2so4
7083       ENDIF
7084       IF ( gamma_hhso4 > 1.0E-10_wp )  THEN
7085          gamma_out(5) = gamma_h2so4**3 / gamma_hhso4**2
7086       ENDIF
7087!
7088!--    Ionic activity coefficient product
7089       act_product = gamma_h2so4**3 / gamma_hhso4**2
7090!
7091!--    Solve the quadratic equation (i.e. x in ax**2 + bx + c = 0)
7092       a = 1.0_wp
7093       b = -1.0_wp * ( ions(4) + ions(1) + ( ( water_total * 18.0E-3_wp ) /                        &
7094           ( 99.0_wp * act_product ) ) )
7095       c = ions(4) * ions(1)
7096       root1 = ( ( -1.0_wp * b ) + ( ( ( b**2 ) - 4.0_wp * a * c )**0.5_wp ) ) / ( 2.0_wp * a )
7097       root2 = ( ( -1.0_wp * b ) - ( ( ( b**2 ) - 4.0_wp * a * c) **0.5_wp ) ) / ( 2.0_wp * a )
7098
7099       IF ( root1 > ions(1)  .OR.  root1 < 0.0_wp )  THEN
7100          root1 = 0.0_wp
7101       ENDIF
7102
7103       IF ( root2 > ions(1)  .OR.  root2 < 0.0_wp )  THEN
7104          root2 = 0.0_wp
7105       ENDIF
7106!
7107!--    Calculate the new hydrogen ion, bisulphate ion and sulphate ion
7108!--    concentration
7109       h_real    = ions(1)
7110       so4_real  = ions(4)
7111       hso4_real = MAX( root1, root2 )
7112       h_real   = ions(1) - hso4_real
7113       so4_real = ions(4) - hso4_real
7114!
7115!--    Recalculate ion molalities
7116       ions_mol(1) = h_real    / ( water_total * 18.01528E-3_wp )   ! H+
7117       ions_mol(4) = so4_real  / ( water_total * 18.01528E-3_wp )   ! SO4(2-)
7118       ions_mol(5) = hso4_real / ( water_total * 18.01528E-3_wp )   ! HSO4(2-)
7119
7120       h_out    = h_real
7121       hso4_out = hso4_real
7122       so4_out  = so4_real
7123
7124    ELSE
7125       h_out    = ions(1)
7126       hso4_out = 0.0_wp
7127       so4_out  = ions(4)
7128    ENDIF
7129
7130!
7131!-- 4) ACTIVITY COEFFICIENTS -for vapour pressures of HNO3,HCL and NH3
7132!
7133!-- This section evaluates activity coefficients and vapour pressures using the water content
7134!-- calculated above) for each inorganic condensing species: a - HNO3, b - NH3, c - HCL.
7135!-- The following procedure is used: Zaveri et al (2005) found that one could express the variation
7136!-- of activity coefficients linearly in log-space if equivalent mole fractions were used.
7137!-- So, by a taylor series expansion LOG( activity coefficient ) =
7138!--    LOG( binary activity coefficient at a given RH ) +
7139!--    (equivalent mole fraction compound A) *
7140!--    ('interaction' parameter between A and condensing species) +
7141!--    equivalent mole fraction compound B) *
7142!--    ('interaction' parameter between B and condensing species).
7143!-- Here, the interaction parameters have been fit to ADDEM by searching the whole compositon space
7144!-- and fit usign the Levenberg-Marquardt non-linear least squares algorithm.
7145!
7146!-- They are given as a function of RH and vary with complexity ranging from linear to 5th order
7147!-- polynomial expressions, the binary activity coefficients were calculated using AIM online.
7148!-- NOTE: for NH3, no binary activity coefficient was used and the data were fit to the ratio of the
7149!-- activity coefficients for the ammonium and hydrogen ions. Once the activity coefficients are
7150!-- obtained the vapour pressure can be easily calculated using tabulated equilibrium constants
7151!-- (referenced). This procedure differs from that of Zaveri et al (2005) in that it is not assumed
7152!-- one can carry behaviour from binary mixtures in multicomponent systems. To this end we have fit
7153!-- the 'interaction' parameters explicitly to a general inorganic equilibrium model
7154!-- (ADDEM - Topping et al. 2005a,b). Such parameters take into account bisulphate ion dissociation
7155!-- and water content. This also allows us to consider one regime for all composition space, rather
7156!-- than defining sulphate rich and sulphate poor regimes.
7157!-- NOTE: The flags "binary_case" and "full_complexity" are not used in this prototype. They are
7158!-- used for simplification of the fit expressions when using limited composition regions.
7159!
7160!-- a) - ACTIVITY COEFF/VAPOUR PRESSURE - HNO3
7161    IF ( ions(1) > 0.0_wp  .AND.  ions(6) > 0.0_wp )  THEN
7162       binary_case = 1
7163       IF ( rh > 0.1_wp  .AND.  rh < 0.98_wp )  THEN
7164          IF ( binary_case == 1 )  THEN
7165             binary_hno3 = 1.8514_wp * rh**3 - 4.6991_wp * rh**2 + 1.5514_wp * rh + 0.90236_wp
7166          ELSEIF ( binary_case == 2 )  THEN
7167             binary_hno3 = - 1.1751_wp * ( rh**2 ) - 0.53794_wp * rh + 1.2808_wp
7168          ENDIF
7169       ELSEIF ( rh >= 0.98_wp  .AND.  rh < 0.9999_wp )  THEN
7170          binary_hno3 = 1244.69635941351_wp * rh**3 - 2613.93941099991_wp * rh**2 +                &
7171                        1525.0684974546_wp * rh -155.946764059316_wp
7172       ENDIF
7173!
7174!--    Contributions from other solutes
7175       full_complexity = 1
7176       IF ( hydrochloric_acid > 0.0_wp )  THEN   ! HCL
7177          IF ( full_complexity == 1  .OR.  rh < 0.4_wp )  THEN
7178             hcl_hno3 = 16.051_wp * rh**4 - 44.357_wp * rh**3 + 45.141_wp * rh**2 - 21.638_wp *    &
7179                        rh + 4.8182_wp
7180          ELSEIF ( full_complexity == 0  .AND.  rh > 0.4_wp )  THEN
7181             hcl_hno3 = - 1.5833_wp * rh + 1.5569_wp
7182          ENDIF
7183       ENDIF
7184
7185       IF ( sulphuric_acid > 0.0_wp )  THEN   ! H2SO4
7186          IF ( full_complexity == 1  .OR.  rh < 0.4_wp )  THEN
7187             h2so4_hno3 = - 3.0849_wp * rh**3 + 5.9609_wp * rh**2 - 4.468_wp * rh + 1.5658_wp
7188          ELSEIF ( full_complexity == 0  .AND.  rh > 0.4_wp )  THEN
7189             h2so4_hno3 = - 0.93473_wp * rh + 0.9363_wp
7190          ENDIF
7191       ENDIF
7192
7193       IF ( ammonium_sulphate > 0.0_wp )  THEN   ! NH42SO4
7194          nh42so4_hno3 = 16.821_wp * rh**3 - 28.391_wp * rh**2 + 18.133_wp * rh - 6.7356_wp
7195       ENDIF
7196
7197       IF ( ammonium_nitrate > 0.0_wp )  THEN   ! NH4NO3
7198          nh4no3_hno3 = 11.01_wp * rh**3 - 21.578_wp * rh**2 + 14.808_wp * rh - 4.2593_wp
7199       ENDIF
7200
7201       IF ( ammonium_chloride > 0.0_wp )  THEN   ! NH4Cl
7202          IF ( full_complexity == 1  .OR.  rh <= 0.4_wp )  THEN
7203             nh4cl_hno3 = - 1.176_wp * rh**3 + 5.0828_wp * rh**2 - 3.8792_wp * rh - 0.05518_wp
7204          ELSEIF ( full_complexity == 0  .AND.  rh > 0.4_wp )  THEN
7205             nh4cl_hno3 = 2.6219_wp * rh**2 - 2.2609_wp * rh - 0.38436_wp
7206          ENDIF
7207       ENDIF
7208
7209       IF ( sodium_sulphate > 0.0_wp )  THEN   ! Na2SO4
7210          na2so4_hno3 = 35.504_wp * rh**4 - 80.101_wp * rh**3 + 67.326_wp * rh**2 - 28.461_wp *    &
7211                        rh + 5.6016_wp
7212       ENDIF
7213
7214       IF ( sodium_nitrate > 0.0_wp )  THEN   ! NaNO3
7215          IF ( full_complexity == 1 .OR. rh <= 0.4_wp ) THEN
7216             nano3_hno3 = 23.659_wp * rh**5 - 66.917_wp * rh**4 + 74.686_wp * rh**3 - 40.795_wp *  &
7217                          rh**2 + 10.831_wp * rh - 1.4701_wp
7218          ELSEIF ( full_complexity == 0  .AND.  rh > 0.4_wp )  THEN
7219             nano3_hno3 = 14.749_wp * rh**4 - 35.237_wp * rh**3 + 31.196_wp * rh**2 - 12.076_wp *  &
7220                          rh + 1.3605_wp
7221          ENDIF
7222       ENDIF
7223
7224       IF ( sodium_chloride > 0.0_wp )  THEN   ! NaCl
7225          IF ( full_complexity == 1  .OR.  rh <= 0.4_wp )  THEN
7226             nacl_hno3 = 13.682_wp * rh**4 - 35.122_wp * rh**3 + 33.397_wp * rh**2 - 14.586_wp *   &
7227                         rh + 2.6276_wp
7228          ELSEIF ( full_complexity == 0  .AND.  rh > 0.4_wp )  THEN
7229             nacl_hno3 = 1.1882_wp * rh**3 - 1.1037_wp * rh**2 - 0.7642_wp * rh + 0.6671_wp
7230          ENDIF
7231       ENDIF
7232
7233       ln_hno3_act = binary_hno3 + hydrochloric_acid_eq_frac * hcl_hno3 +                          &
7234                     sulphuric_acid_eq_frac    * h2so4_hno3 +                                      &
7235                     ammonium_sulphate_eq_frac * nh42so4_hno3 +                                    &
7236                     ammonium_nitrate_eq_frac  * nh4no3_hno3 +                                     &
7237                     ammonium_chloride_eq_frac * nh4cl_hno3 +                                      &
7238                     sodium_sulphate_eq_frac * na2so4_hno3 +                                       &
7239                     sodium_nitrate_eq_frac * nano3_hno3 + sodium_chloride_eq_frac   * nacl_hno3
7240
7241       gamma_hno3   = EXP( ln_hno3_act )   ! Molal activity coefficient of HNO3
7242       gamma_out(1) = gamma_hno3
7243!
7244!--    Partial pressure calculation
7245!--    k_hno3 = 2.51 * ( 10**6 )
7246!--    k_hno3 = 2.628145923d6 !< calculated by AIM online (Clegg et al 1998) after Chameides (1984)
7247       k_hno3     = 2.6E6_wp * EXP( 8700.0_wp * henrys_temp_dep )
7248       press_hno3 = ( ions_mol(1) * ions_mol(6) * ( gamma_hno3**2 ) ) / k_hno3
7249    ENDIF
7250!
7251!-- b) - ACTIVITY COEFF/VAPOUR PRESSURE - NH3
7252!-- Follow the two solute approach of Zaveri et al. (2005)
7253    IF ( ions(2) > 0.0_wp  .AND.  ions_mol(1) > 0.0_wp )  THEN
7254!
7255!--    NH4HSO4:
7256       binary_nh4hso4 = 56.907_wp * rh**6 - 155.32_wp * rh**5 + 142.94_wp * rh**4 - 32.298_wp *    &
7257                        rh**3 - 27.936_wp * rh**2 + 19.502_wp * rh - 4.2618_wp
7258       IF ( nitric_acid > 0.0_wp)  THEN   ! HNO3
7259          hno3_nh4hso4 = 104.8369_wp * rh**8 - 288.8923_wp * rh**7 + 129.3445_wp * rh**6 +         &
7260                         373.0471_wp * rh**5 - 571.0385_wp * rh**4 + 326.3528_wp * rh**3 -         &
7261                         74.169_wp * rh**2 - 2.4999_wp * rh + 3.17_wp
7262       ENDIF
7263
7264       IF ( hydrochloric_acid > 0.0_wp)  THEN   ! HCL
7265          hcl_nh4hso4 = - 7.9133_wp * rh**8 + 126.6648_wp * rh**7 - 460.7425_wp * rh**6 +          &
7266                         731.606_wp * rh**5 - 582.7467_wp * rh**4 + 216.7197_wp * rh**3 -          &
7267                         11.3934_wp * rh**2 - 17.7728_wp  * rh + 5.75_wp
7268       ENDIF
7269
7270       IF ( sulphuric_acid > 0.0_wp)  THEN   ! H2SO4
7271          h2so4_nh4hso4 = 195.981_wp * rh**8 - 779.2067_wp * rh**7 + 1226.3647_wp * rh**6 -        &
7272                         964.0261_wp * rh**5 + 391.7911_wp * rh**4 - 84.1409_wp  * rh**3 +         &
7273                          20.0602_wp * rh**2 - 10.2663_wp  * rh + 3.5817_wp
7274       ENDIF
7275
7276       IF ( ammonium_sulphate > 0.0_wp)  THEN   ! NH42SO4
7277          nh42so4_nh4hso4 = 617.777_wp * rh**8 -  2547.427_wp * rh**7 + 4361.6009_wp * rh**6 -     &
7278                           4003.162_wp * rh**5 + 2117.8281_wp * rh**4 - 640.0678_wp * rh**3 +      &
7279                            98.0902_wp * rh**2 -    2.2615_wp * rh - 2.3811_wp
7280       ENDIF
7281
7282       IF ( ammonium_nitrate > 0.0_wp)  THEN   ! NH4NO3
7283          nh4no3_nh4hso4 = - 104.4504_wp * rh**8 + 539.5921_wp * rh**7 - 1157.0498_wp * rh**6 +    &
7284                            1322.4507_wp * rh**5 - 852.2475_wp * rh**4 + 298.3734_wp * rh**3 -     &
7285                              47.0309_wp * rh**2 +    1.297_wp * rh - 0.8029_wp
7286       ENDIF
7287
7288       IF ( ammonium_chloride > 0.0_wp)  THEN   ! NH4Cl
7289          nh4cl_nh4hso4 = 258.1792_wp * rh**8 - 1019.3777_wp * rh**7 + 1592.8918_wp * rh**6 -      &
7290                         1221.0726_wp * rh**5 +  442.2548_wp * rh**4 -   43.6278_wp * rh**3 -      &
7291                            7.5282_wp * rh**2 -    3.8459_wp * rh + 2.2728_wp
7292       ENDIF
7293
7294       IF ( sodium_sulphate > 0.0_wp)  THEN   ! Na2SO4
7295          na2so4_nh4hso4 = 225.4238_wp * rh**8 - 732.4113_wp * rh**7 + 843.7291_wp * rh**6 -       &
7296                           322.7328_wp * rh**5 -  88.6252_wp * rh**4 +  72.4434_wp * rh**3 +       &
7297                            22.9252_wp * rh**2 -  25.3954_wp * rh + 4.6971_wp
7298       ENDIF
7299
7300       IF ( sodium_nitrate > 0.0_wp)  THEN   ! NaNO3
7301          nano3_nh4hso4 = 96.1348_wp * rh**8 - 341.6738_wp * rh**7 + 406.5314_wp * rh**6 -         &
7302                          98.5777_wp * rh**5 - 172.8286_wp * rh**4 + 149.3151_wp * rh**3 -         &
7303                          38.9998_wp * rh**2 -   0.2251_wp * rh + 0.4953_wp
7304       ENDIF
7305
7306       IF ( sodium_chloride > 0.0_wp)  THEN   ! NaCl
7307          nacl_nh4hso4 = 91.7856_wp * rh**8 - 316.6773_wp * rh**7 + 358.2703_wp * rh**6 -          &
7308                         68.9142_wp * rh**5 - 156.5031_wp * rh**4 + 116.9592_wp * rh**3 -          &
7309                         22.5271_wp * rh**2 - 3.7716_wp * rh + 1.56_wp
7310       ENDIF
7311
7312       ln_nh4hso4_act = binary_nh4hso4 + nitric_acid_eq_frac * hno3_nh4hso4 +                      &
7313                        hydrochloric_acid_eq_frac * hcl_nh4hso4 +                                  &
7314                        sulphuric_acid_eq_frac * h2so4_nh4hso4 +                                   &
7315                        ammonium_sulphate_eq_frac * nh42so4_nh4hso4 +                              &
7316                        ammonium_nitrate_eq_frac * nh4no3_nh4hso4 +                                &
7317                        ammonium_chloride_eq_frac * nh4cl_nh4hso4 +                                &
7318                        sodium_sulphate_eq_frac * na2so4_nh4hso4 +                                 &
7319                        sodium_nitrate_eq_frac * nano3_nh4hso4 +                                   &
7320                        sodium_chloride_eq_frac * nacl_nh4hso4
7321
7322       gamma_nh4hso4 = EXP( ln_nh4hso4_act ) ! molal act. coefficient of NH4HSO4
7323!
7324!--    Molal activity coefficient of NO3-
7325       gamma_out(6)  = gamma_nh4hso4
7326!
7327!--    Molal activity coefficient of NH4+
7328       gamma_nh3     = gamma_nh4hso4**2 / gamma_hhso4**2
7329       gamma_out(3)  = gamma_nh3
7330!
7331!--    This actually represents the ratio of the ammonium to hydrogen ion activity coefficients
7332!--    (see Zaveri paper) - multiply this by the ratio of the ammonium to hydrogen ion molality and
7333!--    the ratio of appropriate equilibrium constants
7334!
7335!--    Equilibrium constants
7336!--    k_h = 57.64d0    ! Zaveri et al. (2005)
7337       k_h = 5.8E1_wp * EXP( 4085.0_wp * henrys_temp_dep )   ! after Chameides (1984)
7338!--    k_nh4 = 1.81E-5_wp    ! Zaveri et al. (2005)
7339       k_nh4 = 1.7E-5_wp * EXP( -4325.0_wp * henrys_temp_dep )   ! Chameides (1984)
7340!--    k_h2o = 1.01E-14_wp    ! Zaveri et al (2005)
7341       k_h2o = 1.E-14_wp * EXP( -6716.0_wp * henrys_temp_dep )   ! Chameides (1984)
7342!
7343       molality_ratio_nh3 = ions_mol(2) / ions_mol(1)
7344!
7345!--    Partial pressure calculation
7346       press_nh3 = molality_ratio_nh3 * gamma_nh3 * ( k_h2o / ( k_h * k_nh4 ) )
7347
7348    ENDIF
7349!
7350!-- c) - ACTIVITY COEFF/VAPOUR PRESSURE - HCL
7351    IF ( ions(1) > 0.0_wp  .AND.  ions(7) > 0.0_wp )  THEN
7352       binary_case = 1
7353       IF ( rh > 0.1_wp  .AND.  rh < 0.98 )  THEN
7354          IF ( binary_case == 1 )  THEN
7355             binary_hcl = - 5.0179_wp * rh**3 + 9.8816_wp * rh**2 - 10.789_wp * rh + 5.4737_wp
7356          ELSEIF ( binary_case == 2 )  THEN
7357             binary_hcl = - 4.6221_wp * rh + 4.2633_wp
7358          ENDIF
7359       ELSEIF ( rh >= 0.98_wp  .AND.  rh < 0.9999_wp )  THEN
7360          binary_hcl = 775.6111008626_wp * rh**3 - 2146.01320888771_wp * rh**2 +                   &
7361                       1969.01979670259_wp *  rh - 598.878230033926_wp
7362       ENDIF
7363    ENDIF
7364
7365    IF ( nitric_acid > 0.0_wp )  THEN   ! HNO3
7366       IF ( full_complexity == 1  .OR.  rh <= 0.4_wp )  THEN
7367          hno3_hcl = 9.6256_wp * rh**4 - 26.507_wp * rh**3 + 27.622_wp * rh**2 - 12.958_wp * rh +  &
7368                     2.2193_wp
7369       ELSEIF ( full_complexity == 0  .AND.  rh > 0.4_wp )  THEN
7370          hno3_hcl = 1.3242_wp * rh**2 - 1.8827_wp * rh + 0.55706_wp
7371       ENDIF
7372    ENDIF
7373
7374    IF ( sulphuric_acid > 0.0_wp )  THEN   ! H2SO4
7375       IF ( full_complexity == 1  .OR.  rh <= 0.4 )  THEN
7376          h2so4_hcl = 1.4406_wp * rh**3 - 2.7132_wp * rh**2 + 1.014_wp * rh + 0.25226_wp
7377       ELSEIF ( full_complexity == 0 .AND. rh > 0.4_wp ) THEN
7378          h2so4_hcl = 0.30993_wp * rh**2 - 0.99171_wp * rh + 0.66913_wp
7379       ENDIF
7380    ENDIF
7381
7382    IF ( ammonium_sulphate > 0.0_wp )  THEN   ! NH42SO4
7383       nh42so4_hcl = 22.071_wp * rh**3 - 40.678_wp * rh**2 + 27.893_wp * rh - 9.4338_wp
7384    ENDIF
7385
7386    IF ( ammonium_nitrate > 0.0_wp )  THEN   ! NH4NO3
7387       nh4no3_hcl = 19.935_wp * rh**3 - 42.335_wp * rh**2 + 31.275_wp * rh - 8.8675_wp
7388    ENDIF
7389
7390    IF ( ammonium_chloride > 0.0_wp )  THEN   ! NH4Cl
7391       IF ( full_complexity == 1  .OR.  rh <= 0.4_wp )  THEN
7392          nh4cl_hcl = 2.8048_wp * rh**3 - 4.3182_wp * rh**2 + 3.1971_wp * rh - 1.6824_wp
7393       ELSEIF ( full_complexity == 0  .AND.  rh > 0.4_wp )  THEN
7394          nh4cl_hcl = 1.2304_wp * rh**2 - 0.18262_wp * rh - 1.0643_wp
7395       ENDIF
7396    ENDIF
7397
7398    IF ( sodium_sulphate > 0.0_wp )  THEN   ! Na2SO4
7399       na2so4_hcl = 36.104_wp * rh**4 - 78.658_wp * rh**3 + 63.441_wp * rh**2 - 26.727_wp * rh +   &
7400                    5.7007_wp
7401    ENDIF
7402
7403    IF ( sodium_nitrate > 0.0_wp )  THEN   ! NaNO3
7404       IF ( full_complexity == 1  .OR.  rh <= 0.4_wp )  THEN
7405          nano3_hcl = 54.471_wp * rh**5 - 159.42_wp * rh**4 + 180.25_wp * rh**3 - 98.176_wp * rh**2&
7406                      + 25.309_wp * rh - 2.4275_wp
7407       ELSEIF ( full_complexity == 0  .AND.  rh > 0.4_wp )  THEN
7408          nano3_hcl = 21.632_wp * rh**4 - 53.088_wp * rh**3 + 47.285_wp * rh**2 - 18.519_wp * rh   &
7409                      + 2.6846_wp
7410       ENDIF
7411    ENDIF
7412
7413    IF ( sodium_chloride > 0.0_wp )  THEN   ! NaCl
7414       IF ( full_complexity == 1  .OR.  rh <= 0.4_wp )  THEN
7415          nacl_hcl = 5.4138_wp * rh**4 - 12.079_wp * rh**3 + 9.627_wp * rh**2 - 3.3164_wp * rh +   &
7416                     0.35224_wp
7417       ELSEIF ( full_complexity == 0  .AND.  rh > 0.4_wp )  THEN
7418          nacl_hcl = 2.432_wp * rh**3 - 4.3453_wp * rh**2 + 2.3834_wp * rh - 0.4762_wp
7419       ENDIF
7420    ENDIF
7421
7422    ln_HCL_act = binary_hcl + nitric_acid_eq_frac * hno3_hcl + sulphuric_acid_eq_frac * h2so4_hcl +&
7423                 ammonium_sulphate_eq_frac * nh42so4_hcl + ammonium_nitrate_eq_frac * nh4no3_hcl + &
7424                 ammonium_chloride_eq_frac * nh4cl_hcl + sodium_sulphate_eq_frac * na2so4_hcl +    &
7425                 sodium_nitrate_eq_frac    * nano3_hcl + sodium_chloride_eq_frac   * nacl_hcl
7426
7427     gamma_hcl    = EXP( ln_HCL_act )   ! Molal activity coefficient
7428     gamma_out(2) = gamma_hcl
7429!
7430!--  Equilibrium constant after Wagman et al. (1982) (and NIST database)
7431     k_hcl = 2E6_wp * EXP( 9000.0_wp * henrys_temp_dep )
7432
7433     press_hcl = ( ions_mol(1) * ions_mol(7) * gamma_hcl**2 ) / k_hcl
7434!
7435!-- 5) Ion molility output
7436    mols_out = ions_mol
7437
7438 END SUBROUTINE inorganic_pdfite
7439
7440!------------------------------------------------------------------------------!
7441! Description:
7442! ------------
7443!> Update the particle size distribution. Put particles into corrects bins.
7444!>
7445!> Moving-centre method assumed, i.e. particles are allowed to grow to their
7446!> exact size as long as they are not crossing the fixed diameter bin limits.
7447!> If the particles in a size bin cross the lower or upper diameter limit, they
7448!> are all moved to the adjacent diameter bin and their volume is averaged with
7449!> the particles in the new bin, which then get a new diameter.
7450!
7451!> Moving-centre method minimises numerical diffusion.
7452!------------------------------------------------------------------------------!
7453 SUBROUTINE distr_update( paero )
7454
7455    IMPLICIT NONE
7456
7457    INTEGER(iwp) ::  ib      !< loop index
7458    INTEGER(iwp) ::  mm      !< loop index
7459    INTEGER(iwp) ::  counti  !< number of while loops
7460
7461    LOGICAL  ::  within_bins !< logical (particle belongs to the bin?)
7462
7463    REAL(wp) ::  znfrac  !< number fraction to be moved to the larger bin
7464    REAL(wp) ::  zvfrac  !< volume fraction to be moved to the larger bin
7465    REAL(wp) ::  zvexc   !< Volume in the grown bin which exceeds the bin upper limit
7466    REAL(wp) ::  zvihi   !< particle volume at the high end of the bin
7467    REAL(wp) ::  zvilo   !< particle volume at the low end of the bin
7468    REAL(wp) ::  zvpart  !< particle volume (m3)
7469    REAL(wp) ::  zvrat   !< volume ratio of a size bin
7470
7471    real(wp), dimension(nbins_aerosol) ::  dummy
7472
7473    TYPE(t_section), DIMENSION(nbins_aerosol), INTENT(inout) ::  paero !< aerosol properties
7474
7475    zvpart      = 0.0_wp
7476    zvfrac      = 0.0_wp
7477    within_bins = .FALSE.
7478
7479    dummy = paero(:)%numc
7480!
7481!-- Check if the volume of the bin is within bin limits after update
7482    counti = 0
7483    DO  WHILE ( .NOT. within_bins )
7484       within_bins = .TRUE.
7485!
7486!--    Loop from larger to smaller size bins
7487       DO  ib = end_subrange_2b-1, start_subrange_1a, -1
7488          mm = 0
7489          IF ( paero(ib)%numc > nclim )  THEN
7490             zvpart = 0.0_wp
7491             zvfrac = 0.0_wp
7492
7493             IF ( ib == end_subrange_2a )  CYCLE
7494!
7495!--          Dry volume
7496             zvpart = SUM( paero(ib)%volc(1:7) ) / paero(ib)%numc
7497!
7498!--          Smallest bin cannot decrease
7499             IF ( paero(ib)%vlolim > zvpart  .AND.  ib == start_subrange_1a ) CYCLE
7500!
7501!--          Decreasing bins
7502             IF ( paero(ib)%vlolim > zvpart )  THEN
7503                mm = ib - 1
7504                IF ( ib == start_subrange_2b )  mm = end_subrange_1a    ! 2b goes to 1a
7505
7506                paero(mm)%numc = paero(mm)%numc + paero(ib)%numc
7507                paero(ib)%numc = 0.0_wp
7508                paero(mm)%volc(:) = paero(mm)%volc(:) + paero(ib)%volc(:)
7509                paero(ib)%volc(:) = 0.0_wp
7510                CYCLE
7511             ENDIF
7512!
7513!--          If size bin has not grown, cycle.
7514!--          Changed by Mona: compare to the arithmetic mean volume, as done originally. Now
7515!--          particle volume is derived from the geometric mean diameter, not arithmetic (see
7516!--          SUBROUTINE set_sizebins).
7517             IF ( zvpart <= api6 * ( ( aero(ib)%vhilim + aero(ib)%vlolim ) / ( 2.0_wp * api6 ) ) ) &
7518             CYCLE
7519!
7520!--          Avoid precision problems
7521             IF ( ABS( zvpart - api6 * paero(ib)%dmid**3 ) < 1.0E-35_wp )  CYCLE
7522!
7523!--          Volume ratio of the size bin
7524             zvrat = paero(ib)%vhilim / paero(ib)%vlolim
7525!
7526!--          Particle volume at the low end of the bin
7527             zvilo = 2.0_wp * zvpart / ( 1.0_wp + zvrat )
7528!
7529!--          Particle volume at the high end of the bin
7530             zvihi = zvrat * zvilo
7531!
7532!--          Volume in the grown bin which exceeds the bin upper limit
7533             zvexc = 0.5_wp * ( zvihi + paero(ib)%vhilim )
7534!
7535!--          Number fraction to be moved to the larger bin
7536             znfrac = MIN( 1.0_wp, ( zvihi - paero(ib)%vhilim) / ( zvihi - zvilo ) )
7537!
7538!--          Volume fraction to be moved to the larger bin
7539             zvfrac = MIN( 0.99_wp, znfrac * zvexc / zvpart )
7540             IF ( zvfrac < 0.0_wp )  THEN
7541                message_string = 'Error: zvfrac < 0'
7542                CALL message( 'salsa_mod: distr_update', 'PA0624', 1, 2, 0, 6, 0 )
7543             ENDIF
7544!
7545!--          Update bin
7546             mm = ib + 1
7547!
7548!--          Volume (cm3/cm3)
7549             paero(mm)%volc(:) = paero(mm)%volc(:) + znfrac * paero(ib)%numc * zvexc *             &
7550                                 paero(ib)%volc(:) / SUM( paero(ib)%volc(1:7) )
7551             paero(ib)%volc(:) = paero(ib)%volc(:) - znfrac * paero(ib)%numc * zvexc *             &
7552                                 paero(ib)%volc(:) / SUM( paero(ib)%volc(1:7) )
7553
7554!--          Number concentration (#/m3)
7555             paero(mm)%numc = paero(mm)%numc + znfrac * paero(ib)%numc
7556             paero(ib)%numc = paero(ib)%numc * ( 1.0_wp - znfrac )
7557
7558          ENDIF     ! nclim
7559
7560          IF ( paero(ib)%numc > nclim )   THEN
7561             zvpart = SUM( paero(ib)%volc(1:7) ) / paero(ib)%numc  ! Note: dry volume!
7562             within_bins = ( paero(ib)%vlolim < zvpart  .AND. zvpart < paero(ib)%vhilim )
7563          ENDIF
7564
7565       ENDDO ! - ib
7566
7567       counti = counti + 1
7568       IF ( counti > 100 )  THEN
7569          message_string = 'Error: Aerosol bin update not converged'
7570          CALL message( 'salsa_mod: distr_update', 'PA0625', 1, 2, 0, 6, 0 )
7571       ENDIF
7572
7573    ENDDO ! - within bins
7574
7575 END SUBROUTINE distr_update
7576
7577!------------------------------------------------------------------------------!
7578! Description:
7579! ------------
7580!> salsa_diagnostics: Update properties for the current timestep:
7581!>
7582!> Juha Tonttila, FMI, 2014
7583!> Tomi Raatikainen, FMI, 2016
7584!------------------------------------------------------------------------------!
7585 SUBROUTINE salsa_diagnostics( i, j )
7586
7587    USE cpulog,                                                                &
7588        ONLY:  cpu_log, log_point_s
7589
7590    IMPLICIT NONE
7591
7592    INTEGER(iwp) ::  ib   !<
7593    INTEGER(iwp) ::  ic   !<
7594    INTEGER(iwp) ::  icc  !<
7595    INTEGER(iwp) ::  ig   !<
7596    INTEGER(iwp) ::  k    !<
7597
7598    INTEGER(iwp), INTENT(in) ::  i  !<
7599    INTEGER(iwp), INTENT(in) ::  j  !<
7600
7601    REAL(wp), DIMENSION(nzb:nzt+1) ::  flag          !< flag to mask topography
7602    REAL(wp), DIMENSION(nzb:nzt+1) ::  flag_zddry    !< flag to mask zddry
7603    REAL(wp), DIMENSION(nzb:nzt+1) ::  in_adn        !< air density (kg/m3)
7604    REAL(wp), DIMENSION(nzb:nzt+1) ::  in_p          !< pressure
7605    REAL(wp), DIMENSION(nzb:nzt+1) ::  in_t          !< temperature (K)
7606    REAL(wp), DIMENSION(nzb:nzt+1) ::  mcsum         !< sum of mass concentration
7607    REAL(wp), DIMENSION(nzb:nzt+1) ::  ppm_to_nconc  !< Conversion factor: ppm to #/m3
7608    REAL(wp), DIMENSION(nzb:nzt+1) ::  zddry         !< particle dry diameter
7609    REAL(wp), DIMENSION(nzb:nzt+1) ::  zvol          !< particle volume
7610
7611    flag_zddry   = 0.0_wp
7612    in_adn       = 0.0_wp
7613    in_p         = 0.0_wp
7614    in_t         = 0.0_wp
7615    ppm_to_nconc = 1.0_wp
7616    zddry        = 0.0_wp
7617    zvol         = 0.0_wp
7618
7619    !$OMP MASTER
7620    CALL cpu_log( log_point_s(94), 'salsa diagnostics ', 'start' )
7621    !$OMP END MASTER
7622
7623!
7624!-- Calculate thermodynamic quantities needed in SALSA
7625    CALL salsa_thrm_ij( i, j, p_ij=in_p, temp_ij=in_t, adn_ij=in_adn )
7626!
7627!-- Calculate conversion factors for gas concentrations
7628    ppm_to_nconc = for_ppm_to_nconc * in_p / in_t
7629!
7630!-- Predetermine flag to mask topography
7631    flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(:,j,i), 0 ) )
7632
7633    DO  ib = 1, nbins_aerosol   ! aerosol size bins
7634!
7635!--    Remove negative values
7636       aerosol_number(ib)%conc(:,j,i) = MAX( nclim, aerosol_number(ib)%conc(:,j,i) ) * flag
7637!
7638!--    Calculate total mass concentration per bin
7639       mcsum = 0.0_wp
7640       DO  ic = 1, ncomponents_mass
7641          icc = ( ic - 1 ) * nbins_aerosol + ib
7642          mcsum = mcsum + aerosol_mass(icc)%conc(:,j,i) * flag
7643          aerosol_mass(icc)%conc(:,j,i) = MAX( mclim, aerosol_mass(icc)%conc(:,j,i) ) * flag
7644       ENDDO
7645!
7646!--    Check that number and mass concentration match qualitatively
7647       IF ( ANY( aerosol_number(ib)%conc(:,j,i) > nclim  .AND. mcsum <= 0.0_wp ) )  THEN
7648          DO  k = nzb+1, nzt
7649             IF ( aerosol_number(ib)%conc(k,j,i) >= nclim  .AND. mcsum(k) <= 0.0_wp )  THEN
7650                aerosol_number(ib)%conc(k,j,i) = nclim * flag(k)
7651                DO  ic = 1, ncomponents_mass
7652                   icc = ( ic - 1 ) * nbins_aerosol + ib
7653                   aerosol_mass(icc)%conc(k,j,i) = mclim * flag(k)
7654                ENDDO
7655             ENDIF
7656          ENDDO
7657       ENDIF
7658!
7659!--    Update aerosol particle radius
7660       CALL bin_mixrat( 'dry', ib, i, j, zvol )
7661       zvol = zvol / arhoh2so4    ! Why on sulphate?
7662!
7663!--    Particles smaller then 0.1 nm diameter are set to zero
7664       zddry = ( zvol / MAX( nclim, aerosol_number(ib)%conc(:,j,i) ) / api6 )**0.33333333_wp
7665       flag_zddry = MERGE( 1.0_wp, 0.0_wp, ( zddry < 1.0E-10_wp  .AND.                             &
7666                           aerosol_number(ib)%conc(:,j,i) > nclim ) )
7667!
7668!--    Volatile species to the gas phase
7669       IF ( index_so4 > 0 .AND. lscndgas )  THEN
7670          ic = ( index_so4 - 1 ) * nbins_aerosol + ib
7671          IF ( salsa_gases_from_chem )  THEN
7672             ig = gas_index_chem(1)
7673             chem_species(ig)%conc(:,j,i) = chem_species(ig)%conc(:,j,i) +                         &
7674                                            aerosol_mass(ic)%conc(:,j,i) * avo * flag_zddry /      &
7675                                            ( amh2so4 * ppm_to_nconc ) * flag
7676          ELSE
7677             salsa_gas(1)%conc(:,j,i) = salsa_gas(1)%conc(:,j,i) + aerosol_mass(ic)%conc(:,j,i) /  &
7678                                        amh2so4 * avo * flag_zddry * flag
7679          ENDIF
7680       ENDIF
7681       IF ( index_oc > 0  .AND.  lscndgas )  THEN
7682          ic = ( index_oc - 1 ) * nbins_aerosol + ib
7683          IF ( salsa_gases_from_chem )  THEN
7684             ig = gas_index_chem(5)
7685             chem_species(ig)%conc(:,j,i) = chem_species(ig)%conc(:,j,i) +                         &
7686                                            aerosol_mass(ic)%conc(:,j,i) * avo * flag_zddry /      &
7687                                            ( amoc * ppm_to_nconc ) * flag
7688          ELSE
7689             salsa_gas(5)%conc(:,j,i) = salsa_gas(5)%conc(:,j,i) + aerosol_mass(ic)%conc(:,j,i) /  &
7690                                        amoc * avo * flag_zddry * flag
7691          ENDIF
7692       ENDIF
7693       IF ( index_no > 0  .AND.  lscndgas )  THEN
7694          ic = ( index_no - 1 ) * nbins_aerosol + ib
7695          IF ( salsa_gases_from_chem )  THEN
7696             ig = gas_index_chem(2)
7697             chem_species(ig)%conc(:,j,i) = chem_species(ig)%conc(:,j,i) +                         &
7698                                            aerosol_mass(ic)%conc(:,j,i) * avo * flag_zddry /      &
7699                                            ( amhno3 * ppm_to_nconc ) *flag
7700          ELSE
7701             salsa_gas(2)%conc(:,j,i) = salsa_gas(2)%conc(:,j,i) + aerosol_mass(ic)%conc(:,j,i) /  &
7702                                        amhno3 * avo * flag_zddry * flag
7703          ENDIF
7704       ENDIF
7705       IF ( index_nh > 0  .AND.  lscndgas )  THEN
7706          ic = ( index_nh - 1 ) * nbins_aerosol + ib
7707          IF ( salsa_gases_from_chem )  THEN
7708             ig = gas_index_chem(3)
7709             chem_species(ig)%conc(:,j,i) = chem_species(ig)%conc(:,j,i) +                         &
7710                                            aerosol_mass(ic)%conc(:,j,i) * avo * flag_zddry /      &
7711                                            ( amnh3 * ppm_to_nconc ) *flag
7712          ELSE
7713             salsa_gas(3)%conc(:,j,i) = salsa_gas(3)%conc(:,j,i) + aerosol_mass(ic)%conc(:,j,i) /  &
7714                                        amnh3 * avo * flag_zddry *flag
7715          ENDIF
7716       ENDIF
7717!
7718!--    Mass and number to zero (insoluble species and water are lost)
7719       DO  ic = 1, ncomponents_mass
7720          icc = ( ic - 1 ) * nbins_aerosol + ib
7721          aerosol_mass(icc)%conc(:,j,i) = MERGE( mclim * flag, aerosol_mass(icc)%conc(:,j,i),      &
7722                                                 flag_zddry > 0.0_wp )
7723       ENDDO
7724       aerosol_number(ib)%conc(:,j,i) = MERGE( nclim * flag, aerosol_number(ib)%conc(:,j,i),       &
7725                                               flag_zddry > 0.0_wp )
7726       ra_dry(:,j,i,ib) = MAX( 1.0E-10_wp, 0.5_wp * zddry )
7727
7728    ENDDO
7729    IF ( .NOT. salsa_gases_from_chem )  THEN
7730       DO  ig = 1, ngases_salsa
7731          salsa_gas(ig)%conc(:,j,i) = MAX( nclim, salsa_gas(ig)%conc(:,j,i) ) * flag
7732       ENDDO
7733    ENDIF
7734
7735   !$OMP MASTER
7736    CALL cpu_log( log_point_s(94), 'salsa diagnostics ', 'stop' )
7737   !$OMP END MASTER
7738
7739 END SUBROUTINE salsa_diagnostics
7740
7741
7742!------------------------------------------------------------------------------!
7743! Description:
7744! ------------
7745!> Call for all grid points
7746!------------------------------------------------------------------------------!
7747 SUBROUTINE salsa_actions( location )
7748
7749
7750    CHARACTER (LEN=*), INTENT(IN) ::  location !< call location string
7751
7752    SELECT CASE ( location )
7753
7754       CASE ( 'before_timestep' )
7755
7756          IF ( ws_scheme_sca )  sums_salsa_ws_l = 0.0_wp
7757
7758       CASE DEFAULT
7759          CONTINUE
7760
7761    END SELECT
7762
7763 END SUBROUTINE salsa_actions
7764
7765
7766!------------------------------------------------------------------------------!
7767! Description:
7768! ------------
7769!> Call for grid points i,j
7770!------------------------------------------------------------------------------!
7771
7772 SUBROUTINE salsa_actions_ij( i, j, location )
7773
7774
7775    INTEGER(iwp),      INTENT(IN) ::  i         !< grid index in x-direction
7776    INTEGER(iwp),      INTENT(IN) ::  j         !< grid index in y-direction
7777    CHARACTER (LEN=*), INTENT(IN) ::  location  !< call location string
7778    INTEGER(iwp)  ::  dummy  !< call location string
7779
7780    IF ( salsa    )   dummy = i + j
7781
7782    SELECT CASE ( location )
7783
7784       CASE ( 'before_timestep' )
7785
7786          IF ( ws_scheme_sca )  sums_salsa_ws_l = 0.0_wp
7787
7788       CASE DEFAULT
7789          CONTINUE
7790
7791    END SELECT
7792
7793
7794 END SUBROUTINE salsa_actions_ij
7795
7796!------------------------------------------------------------------------------!
7797! Description:
7798! ------------
7799!> Call for all grid points
7800!------------------------------------------------------------------------------!
7801 SUBROUTINE salsa_non_advective_processes
7802
7803    USE cpulog,                                                                                    &
7804        ONLY:  cpu_log, log_point_s
7805
7806    IMPLICIT NONE
7807
7808    INTEGER(iwp) ::  i  !<
7809    INTEGER(iwp) ::  j  !<
7810
7811    IF ( time_since_reference_point >= skip_time_do_salsa )  THEN
7812       IF ( ( time_since_reference_point - last_salsa_time ) >= dt_salsa )  THEN
7813!
7814!--       Calculate aerosol dynamic processes. salsa_driver can be run with a longer time step.
7815          CALL cpu_log( log_point_s(90), 'salsa processes ', 'start' )
7816          DO  i = nxl, nxr
7817             DO  j = nys, nyn
7818                CALL salsa_diagnostics( i, j )
7819                CALL salsa_driver( i, j, 3 )
7820                CALL salsa_diagnostics( i, j )
7821             ENDDO
7822          ENDDO
7823          CALL cpu_log( log_point_s(90), 'salsa processes ', 'stop' )
7824       ENDIF
7825    ENDIF
7826
7827 END SUBROUTINE salsa_non_advective_processes
7828
7829
7830!------------------------------------------------------------------------------!
7831! Description:
7832! ------------
7833!> Call for grid points i,j
7834!------------------------------------------------------------------------------!
7835 SUBROUTINE salsa_non_advective_processes_ij( i, j )
7836
7837    USE cpulog,                                                                &
7838        ONLY:  cpu_log, log_point_s
7839
7840    IMPLICIT NONE
7841
7842    INTEGER(iwp), INTENT(IN) ::  i  !< grid index in x-direction
7843    INTEGER(iwp), INTENT(IN) ::  j  !< grid index in y-direction
7844
7845    IF ( time_since_reference_point >= skip_time_do_salsa )  THEN
7846       IF ( ( time_since_reference_point - last_salsa_time ) >= dt_salsa )  THEN
7847!
7848!--       Calculate aerosol dynamic processes. salsa_driver can be run with a longer time step.
7849          CALL cpu_log( log_point_s(90), 'salsa processes ', 'start' )
7850          CALL salsa_diagnostics( i, j )
7851          CALL salsa_driver( i, j, 3 )
7852          CALL salsa_diagnostics( i, j )
7853          CALL cpu_log( log_point_s(90), 'salsa processes ', 'stop' )
7854       ENDIF
7855    ENDIF
7856
7857 END SUBROUTINE salsa_non_advective_processes_ij
7858
7859!------------------------------------------------------------------------------!
7860! Description:
7861! ------------
7862!> Routine for exchange horiz of salsa variables.
7863!------------------------------------------------------------------------------!
7864 SUBROUTINE salsa_exchange_horiz_bounds
7865
7866    USE cpulog,                                                                &
7867        ONLY:  cpu_log, log_point_s
7868
7869    IMPLICIT NONE
7870
7871    INTEGER(iwp) ::  ib   !<
7872    INTEGER(iwp) ::  ic   !<
7873    INTEGER(iwp) ::  icc  !<
7874    INTEGER(iwp) ::  ig   !<
7875
7876    IF ( time_since_reference_point >= skip_time_do_salsa )  THEN
7877       IF ( ( time_since_reference_point - last_salsa_time ) >= dt_salsa )  THEN
7878
7879          CALL cpu_log( log_point_s(91), 'salsa exch-horiz ', 'start' )
7880!
7881!--       Exchange ghost points and decycle if needed.
7882          DO  ib = 1, nbins_aerosol
7883             CALL exchange_horiz( aerosol_number(ib)%conc, nbgp )
7884             CALL salsa_boundary_conds( aerosol_number(ib)%conc, aerosol_number(ib)%init )
7885             DO  ic = 1, ncomponents_mass
7886                icc = ( ic - 1 ) * nbins_aerosol + ib
7887                CALL exchange_horiz( aerosol_mass(icc)%conc, nbgp )
7888                CALL salsa_boundary_conds( aerosol_mass(icc)%conc, aerosol_mass(icc)%init )
7889             ENDDO
7890          ENDDO
7891          IF ( .NOT. salsa_gases_from_chem )  THEN
7892             DO  ig = 1, ngases_salsa
7893                CALL exchange_horiz( salsa_gas(ig)%conc, nbgp )
7894                CALL salsa_boundary_conds( salsa_gas(ig)%conc, salsa_gas(ig)%init )
7895             ENDDO
7896          ENDIF
7897          CALL cpu_log( log_point_s(91), 'salsa exch-horiz ', 'stop' )
7898!
7899!--       Update last_salsa_time
7900          last_salsa_time = time_since_reference_point
7901       ENDIF
7902    ENDIF
7903
7904 END SUBROUTINE salsa_exchange_horiz_bounds
7905
7906!------------------------------------------------------------------------------!
7907! Description:
7908! ------------
7909!> Calculate the prognostic equation for aerosol number and mass, and gas
7910!> concentrations. Cache-optimized.
7911!------------------------------------------------------------------------------!
7912 SUBROUTINE salsa_prognostic_equations_ij( i, j, i_omp_start, tn )
7913
7914    IMPLICIT NONE
7915
7916    INTEGER(iwp) ::  i            !<
7917    INTEGER(iwp) ::  i_omp_start  !<
7918    INTEGER(iwp) ::  ib           !< loop index for aerosol number bin OR gas index
7919    INTEGER(iwp) ::  ic           !< loop index for aerosol mass bin
7920    INTEGER(iwp) ::  icc          !< (c-1)*nbins_aerosol+b
7921    INTEGER(iwp) ::  ig           !< loop index for salsa gases
7922    INTEGER(iwp) ::  j            !<
7923    INTEGER(iwp) ::  tn           !<
7924
7925    IF ( time_since_reference_point >= skip_time_do_salsa )  THEN
7926!
7927!--    Aerosol number
7928       DO  ib = 1, nbins_aerosol
7929!kk          sums_salsa_ws_l = aerosol_number(ib)%sums_ws_l
7930          CALL salsa_tendency( 'aerosol_number', aerosol_number(ib)%conc_p, aerosol_number(ib)%conc,&
7931                               aerosol_number(ib)%tconc_m, i, j, i_omp_start, tn, ib, ib,          &
7932                               aerosol_number(ib)%flux_s, aerosol_number(ib)%diss_s,               &
7933                               aerosol_number(ib)%flux_l, aerosol_number(ib)%diss_l,               &
7934                               aerosol_number(ib)%init, .TRUE. )
7935!kk          aerosol_number(ib)%sums_ws_l = sums_salsa_ws_l
7936!
7937!--       Aerosol mass
7938          DO  ic = 1, ncomponents_mass
7939             icc = ( ic - 1 ) * nbins_aerosol + ib
7940!kk             sums_salsa_ws_l = aerosol_mass(icc)%sums_ws_l
7941             CALL salsa_tendency( 'aerosol_mass', aerosol_mass(icc)%conc_p, aerosol_mass(icc)%conc,&
7942                                  aerosol_mass(icc)%tconc_m, i, j, i_omp_start, tn, ib, ic,        &
7943                                  aerosol_mass(icc)%flux_s, aerosol_mass(icc)%diss_s,              &
7944                                  aerosol_mass(icc)%flux_l, aerosol_mass(icc)%diss_l,              &
7945                                  aerosol_mass(icc)%init, .TRUE. )
7946!kk             aerosol_mass(icc)%sums_ws_l = sums_salsa_ws_l
7947
7948          ENDDO  ! ic
7949       ENDDO  ! ib
7950!
7951!--    Gases
7952       IF ( .NOT. salsa_gases_from_chem )  THEN
7953
7954          DO  ig = 1, ngases_salsa
7955!kk             sums_salsa_ws_l = salsa_gas(ig)%sums_ws_l
7956             CALL salsa_tendency( 'salsa_gas', salsa_gas(ig)%conc_p, salsa_gas(ig)%conc,           &
7957                                  salsa_gas(ig)%tconc_m, i, j, i_omp_start, tn, ig, ig,            &
7958                                  salsa_gas(ig)%flux_s, salsa_gas(ig)%diss_s, salsa_gas(ig)%flux_l,&
7959                                  salsa_gas(ig)%diss_l, salsa_gas(ig)%init, .FALSE. )
7960!kk             salsa_gas(ig)%sums_ws_l = sums_salsa_ws_l
7961
7962          ENDDO  ! ig
7963
7964       ENDIF
7965
7966    ENDIF
7967
7968 END SUBROUTINE salsa_prognostic_equations_ij
7969!
7970!------------------------------------------------------------------------------!
7971! Description:
7972! ------------
7973!> Calculate the prognostic equation for aerosol number and mass, and gas
7974!> concentrations. For vector machines.
7975!------------------------------------------------------------------------------!
7976 SUBROUTINE salsa_prognostic_equations()
7977
7978    IMPLICIT NONE
7979
7980    INTEGER(iwp) ::  ib           !< loop index for aerosol number bin OR gas index
7981    INTEGER(iwp) ::  ic           !< loop index for aerosol mass bin
7982    INTEGER(iwp) ::  icc          !< (c-1)*nbins_aerosol+b
7983    INTEGER(iwp) ::  ig           !< loop index for salsa gases
7984
7985    IF ( time_since_reference_point >= skip_time_do_salsa )  THEN
7986!
7987!--    Aerosol number
7988       DO  ib = 1, nbins_aerosol
7989          sums_salsa_ws_l = aerosol_number(ib)%sums_ws_l
7990          CALL salsa_tendency( 'aerosol_number', aerosol_number(ib)%conc_p, aerosol_number(ib)%conc,&
7991                               aerosol_number(ib)%tconc_m, ib, ib, aerosol_number(ib)%init, .TRUE. )
7992          aerosol_number(ib)%sums_ws_l = sums_salsa_ws_l
7993!
7994!--       Aerosol mass
7995          DO  ic = 1, ncomponents_mass
7996             icc = ( ic - 1 ) * nbins_aerosol + ib
7997             sums_salsa_ws_l = aerosol_mass(icc)%sums_ws_l
7998             CALL salsa_tendency( 'aerosol_mass', aerosol_mass(icc)%conc_p, aerosol_mass(icc)%conc,&
7999                                  aerosol_mass(icc)%tconc_m, ib, ic, aerosol_mass(icc)%init, .TRUE. )
8000             aerosol_mass(icc)%sums_ws_l = sums_salsa_ws_l
8001
8002          ENDDO  ! ic
8003       ENDDO  ! ib
8004!
8005!--    Gases
8006       IF ( .NOT. salsa_gases_from_chem )  THEN
8007
8008          DO  ig = 1, ngases_salsa
8009             sums_salsa_ws_l = salsa_gas(ig)%sums_ws_l
8010             CALL salsa_tendency( 'salsa_gas', salsa_gas(ig)%conc_p, salsa_gas(ig)%conc,           &
8011                                  salsa_gas(ig)%tconc_m, ig, ig, salsa_gas(ig)%init, .FALSE. )
8012             salsa_gas(ig)%sums_ws_l = sums_salsa_ws_l
8013
8014          ENDDO  ! ig
8015
8016       ENDIF
8017
8018    ENDIF
8019
8020 END SUBROUTINE salsa_prognostic_equations
8021!
8022!------------------------------------------------------------------------------!
8023! Description:
8024! ------------
8025!> Tendencies for aerosol number and mass and gas concentrations.
8026!> Cache-optimized.
8027!------------------------------------------------------------------------------!
8028 SUBROUTINE salsa_tendency_ij( id, rs_p, rs, trs_m, i, j, i_omp_start, tn, ib, ic, flux_s, diss_s, &
8029                               flux_l, diss_l, rs_init, do_sedimentation )
8030
8031    USE advec_ws,                                                                                  &
8032        ONLY:  advec_s_ws
8033
8034    USE advec_s_pw_mod,                                                                            &
8035        ONLY:  advec_s_pw
8036
8037    USE advec_s_up_mod,                                                                            &
8038        ONLY:  advec_s_up
8039
8040    USE arrays_3d,                                                                                 &
8041        ONLY:  ddzu, rdf_sc, tend
8042
8043    USE diffusion_s_mod,                                                                           &
8044        ONLY:  diffusion_s
8045
8046    USE indices,                                                                                   &
8047        ONLY:  wall_flags_total_0
8048
8049    USE surface_mod,                                                                               &
8050        ONLY :  surf_def_h, surf_def_v, surf_lsm_h, surf_lsm_v, surf_usm_h, surf_usm_v
8051
8052    IMPLICIT NONE
8053
8054    CHARACTER(LEN = *) ::  id  !<
8055
8056    INTEGER(iwp) ::  i            !<
8057    INTEGER(iwp) ::  i_omp_start  !<
8058    INTEGER(iwp) ::  ib           !< loop index for aerosol number bin OR gas index
8059    INTEGER(iwp) ::  ic           !< loop index for aerosol mass bin
8060    INTEGER(iwp) ::  icc          !< (c-1)*nbins_aerosol+b
8061    INTEGER(iwp) ::  j            !<
8062    INTEGER(iwp) ::  k            !<
8063    INTEGER(iwp) ::  tn           !<
8064
8065    LOGICAL ::  do_sedimentation  !<
8066
8067    REAL(wp), DIMENSION(nzb:nzt+1) ::  rs_init  !<
8068
8069    REAL(wp), DIMENSION(nzb+1:nzt,0:threads_per_task-1) ::  diss_s  !<
8070    REAL(wp), DIMENSION(nzb+1:nzt,0:threads_per_task-1) ::  flux_s  !<
8071
8072    REAL(wp), DIMENSION(nzb+1:nzt,nys:nyn,0:threads_per_task-1) ::  diss_l  !<
8073    REAL(wp), DIMENSION(nzb+1:nzt,nys:nyn,0:threads_per_task-1) ::  flux_l  !<
8074
8075    REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ::  rs_p    !<
8076    REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ::  rs      !<
8077    REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ::  trs_m   !<
8078
8079    icc = ( ic - 1 ) * nbins_aerosol + ib
8080!
8081!-- Tendency-terms for reactive scalar
8082    tend(:,j,i) = 0.0_wp
8083!
8084!-- Advection terms
8085    IF ( timestep_scheme(1:5) == 'runge' )  THEN
8086       IF ( ws_scheme_sca )  THEN
8087          CALL advec_s_ws( salsa_advc_flags_s, i, j, rs, id, flux_s, diss_s, flux_l, diss_l,       &
8088                           i_omp_start, tn, bc_dirichlet_l  .OR.  bc_radiation_l,                  &
8089                           bc_dirichlet_n  .OR.  bc_radiation_n,                                   &
8090                           bc_dirichlet_r  .OR.  bc_radiation_r,                                   &
8091                           bc_dirichlet_s  .OR.  bc_radiation_s, monotonic_limiter_z )
8092       ELSE
8093          CALL advec_s_pw( i, j, rs )
8094       ENDIF
8095    ELSE
8096       CALL advec_s_up( i, j, rs )
8097    ENDIF
8098!
8099!-- Diffusion terms
8100    SELECT CASE ( id )
8101       CASE ( 'aerosol_number' )
8102          CALL diffusion_s( i, j, rs, surf_def_h(0)%answs(:,ib),                                   &
8103                                      surf_def_h(1)%answs(:,ib), surf_def_h(2)%answs(:,ib),        &
8104                                      surf_lsm_h%answs(:,ib),    surf_usm_h%answs(:,ib),           &
8105                                      surf_def_v(0)%answs(:,ib), surf_def_v(1)%answs(:,ib),        &
8106                                      surf_def_v(2)%answs(:,ib), surf_def_v(3)%answs(:,ib),        &
8107                                      surf_lsm_v(0)%answs(:,ib), surf_lsm_v(1)%answs(:,ib),        &
8108                                      surf_lsm_v(2)%answs(:,ib), surf_lsm_v(3)%answs(:,ib),        &
8109                                      surf_usm_v(0)%answs(:,ib), surf_usm_v(1)%answs(:,ib),        &
8110                                      surf_usm_v(2)%answs(:,ib), surf_usm_v(3)%answs(:,ib) )
8111       CASE ( 'aerosol_mass' )
8112          CALL diffusion_s( i, j, rs, surf_def_h(0)%amsws(:,icc),                                  &
8113                                      surf_def_h(1)%amsws(:,icc), surf_def_h(2)%amsws(:,icc),      &
8114                                      surf_lsm_h%amsws(:,icc),    surf_usm_h%amsws(:,icc),         &
8115                                      surf_def_v(0)%amsws(:,icc), surf_def_v(1)%amsws(:,icc),      &
8116                                      surf_def_v(2)%amsws(:,icc), surf_def_v(3)%amsws(:,icc),      &
8117                                      surf_lsm_v(0)%amsws(:,icc), surf_lsm_v(1)%amsws(:,icc),      &
8118                                      surf_lsm_v(2)%amsws(:,icc), surf_lsm_v(3)%amsws(:,icc),      &
8119                                      surf_usm_v(0)%amsws(:,icc), surf_usm_v(1)%amsws(:,icc),      &
8120                                      surf_usm_v(2)%amsws(:,icc), surf_usm_v(3)%amsws(:,icc) )
8121       CASE ( 'salsa_gas' )
8122          CALL diffusion_s( i, j, rs, surf_def_h(0)%gtsws(:,ib),                                   &
8123                                      surf_def_h(1)%gtsws(:,ib), surf_def_h(2)%gtsws(:,ib),        &
8124                                      surf_lsm_h%gtsws(:,ib), surf_usm_h%gtsws(:,ib),              &
8125                                      surf_def_v(0)%gtsws(:,ib), surf_def_v(1)%gtsws(:,ib),        &
8126                                      surf_def_v(2)%gtsws(:,ib), surf_def_v(3)%gtsws(:,ib),        &
8127                                      surf_lsm_v(0)%gtsws(:,ib), surf_lsm_v(1)%gtsws(:,ib),        &
8128                                      surf_lsm_v(2)%gtsws(:,ib), surf_lsm_v(3)%gtsws(:,ib),        &
8129                                      surf_usm_v(0)%gtsws(:,ib), surf_usm_v(1)%gtsws(:,ib),        &
8130                                      surf_usm_v(2)%gtsws(:,ib), surf_usm_v(3)%gtsws(:,ib) )
8131    END SELECT
8132!
8133!-- Sedimentation and prognostic equation for aerosol number and mass
8134    IF ( lsdepo  .AND.  do_sedimentation )  THEN
8135!DIR$ IVDEP
8136       DO  k = nzb+1, nzt
8137          tend(k,j,i) = tend(k,j,i) - MAX( 0.0_wp, ( rs(k+1,j,i) * sedim_vd(k+1,j,i,ib) -          &
8138                                                     rs(k,j,i) * sedim_vd(k,j,i,ib) ) * ddzu(k) )  &
8139                                    * MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k-1,j,i), 0 ) )
8140          rs_p(k,j,i) = rs(k,j,i) + ( dt_3d * ( tsc(2) * tend(k,j,i) + tsc(3) * trs_m(k,j,i) )     &
8141                                      - tsc(5) * rdf_sc(k) * ( rs(k,j,i) - rs_init(k) ) )          &
8142                                  * MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) )
8143          IF ( rs_p(k,j,i) < 0.0_wp )  rs_p(k,j,i) = 0.1_wp * rs(k,j,i)
8144       ENDDO
8145    ELSE
8146!
8147!--    Prognostic equation
8148!DIR$ IVDEP
8149       DO  k = nzb+1, nzt
8150          rs_p(k,j,i) = rs(k,j,i) + ( dt_3d * ( tsc(2) * tend(k,j,i) + tsc(3) * trs_m(k,j,i) )     &
8151                                                - tsc(5) * rdf_sc(k) * ( rs(k,j,i) - rs_init(k) ) )&
8152                                  * MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) )
8153          IF ( rs_p(k,j,i) < 0.0_wp )  rs_p(k,j,i) = 0.1_wp * rs(k,j,i)
8154       ENDDO
8155    ENDIF
8156!
8157!-- Calculate tendencies for the next Runge-Kutta step
8158    IF ( timestep_scheme(1:5) == 'runge' )  THEN
8159       IF ( intermediate_timestep_count == 1 )  THEN
8160          DO  k = nzb+1, nzt
8161             trs_m(k,j,i) = tend(k,j,i)
8162          ENDDO
8163       ELSEIF ( intermediate_timestep_count < intermediate_timestep_count_max )  THEN
8164          DO  k = nzb+1, nzt
8165             trs_m(k,j,i) = -9.5625_wp * tend(k,j,i) + 5.3125_wp * trs_m(k,j,i)
8166          ENDDO
8167       ENDIF
8168    ENDIF
8169
8170 END SUBROUTINE salsa_tendency_ij
8171!
8172!------------------------------------------------------------------------------!
8173! Description:
8174! ------------
8175!> Calculate the tendencies for aerosol number and mass concentrations.
8176!> For vector machines.
8177!------------------------------------------------------------------------------!
8178 SUBROUTINE salsa_tendency( id, rs_p, rs, trs_m, ib, ic, rs_init, do_sedimentation )
8179
8180    USE advec_ws,                                                                                  &
8181        ONLY:  advec_s_ws
8182    USE advec_s_pw_mod,                                                                            &
8183        ONLY:  advec_s_pw
8184    USE advec_s_up_mod,                                                                            &
8185        ONLY:  advec_s_up
8186    USE arrays_3d,                                                                                 &
8187        ONLY:  ddzu, rdf_sc, tend
8188    USE diffusion_s_mod,                                                                           &
8189        ONLY:  diffusion_s
8190    USE indices,                                                                                   &
8191        ONLY:  wall_flags_total_0
8192    USE surface_mod,                                                                               &
8193        ONLY :  surf_def_h, surf_def_v, surf_lsm_h, surf_lsm_v, surf_usm_h, surf_usm_v
8194
8195    IMPLICIT NONE
8196
8197    CHARACTER(LEN = *) ::  id
8198
8199    INTEGER(iwp) ::  ib           !< loop index for aerosol number bin OR gas index
8200    INTEGER(iwp) ::  ic           !< loop index for aerosol mass bin
8201    INTEGER(iwp) ::  icc  !< (c-1)*nbins_aerosol+b
8202    INTEGER(iwp) ::  i    !<
8203    INTEGER(iwp) ::  j    !<
8204    INTEGER(iwp) ::  k    !<
8205
8206    LOGICAL ::  do_sedimentation  !<
8207
8208    REAL(wp), DIMENSION(nzb:nzt+1) ::  rs_init !<
8209
8210    REAL(wp), DIMENSION(:,:,:), POINTER ::  rs_p    !<
8211    REAL(wp), DIMENSION(:,:,:), POINTER ::  rs      !<
8212    REAL(wp), DIMENSION(:,:,:), POINTER ::  trs_m   !<
8213
8214    icc = ( ic - 1 ) * nbins_aerosol + ib
8215!
8216!-- Tendency-terms for reactive scalar
8217    tend = 0.0_wp
8218!
8219!-- Advection terms
8220    IF ( timestep_scheme(1:5) == 'runge' )  THEN
8221       IF ( ws_scheme_sca )  THEN
8222          CALL advec_s_ws( salsa_advc_flags_s, rs, id, bc_dirichlet_l  .OR.  bc_radiation_l,       &
8223                           bc_dirichlet_n  .OR.  bc_radiation_n,                                   &
8224                           bc_dirichlet_r  .OR.  bc_radiation_r,                                   &
8225                           bc_dirichlet_s  .OR.  bc_radiation_s )
8226       ELSE
8227          CALL advec_s_pw( rs )
8228       ENDIF
8229    ELSE
8230       CALL advec_s_up( rs )
8231    ENDIF
8232!
8233!-- Diffusion terms
8234    SELECT CASE ( id )
8235       CASE ( 'aerosol_number' )
8236          CALL diffusion_s( rs, surf_def_h(0)%answs(:,ib),                                         &
8237                                surf_def_h(1)%answs(:,ib), surf_def_h(2)%answs(:,ib),              &
8238                                surf_lsm_h%answs(:,ib),    surf_usm_h%answs(:,ib),                 &
8239                                surf_def_v(0)%answs(:,ib), surf_def_v(1)%answs(:,ib),              &
8240                                surf_def_v(2)%answs(:,ib), surf_def_v(3)%answs(:,ib),              &
8241                                surf_lsm_v(0)%answs(:,ib), surf_lsm_v(1)%answs(:,ib),              &
8242                                surf_lsm_v(2)%answs(:,ib), surf_lsm_v(3)%answs(:,ib),              &
8243                                surf_usm_v(0)%answs(:,ib), surf_usm_v(1)%answs(:,ib),              &
8244                                surf_usm_v(2)%answs(:,ib), surf_usm_v(3)%answs(:,ib) )
8245       CASE ( 'aerosol_mass' )
8246          CALL diffusion_s( rs, surf_def_h(0)%amsws(:,icc),                                        &
8247                                surf_def_h(1)%amsws(:,icc), surf_def_h(2)%amsws(:,icc),            &
8248                                surf_lsm_h%amsws(:,icc),    surf_usm_h%amsws(:,icc),               &
8249                                surf_def_v(0)%amsws(:,icc), surf_def_v(1)%amsws(:,icc),            &
8250                                surf_def_v(2)%amsws(:,icc), surf_def_v(3)%amsws(:,icc),            &
8251                                surf_lsm_v(0)%amsws(:,icc), surf_lsm_v(1)%amsws(:,icc),            &
8252                                surf_lsm_v(2)%amsws(:,icc), surf_lsm_v(3)%amsws(:,icc),            &
8253                                surf_usm_v(0)%amsws(:,icc), surf_usm_v(1)%amsws(:,icc),            &
8254                                surf_usm_v(2)%amsws(:,icc), surf_usm_v(3)%amsws(:,icc) )
8255       CASE ( 'salsa_gas' )
8256          CALL diffusion_s( rs, surf_def_h(0)%gtsws(:,ib),                                         &
8257                                surf_def_h(1)%gtsws(:,ib), surf_def_h(2)%gtsws(:,ib),              &
8258                                surf_lsm_h%gtsws(:,ib),    surf_usm_h%gtsws(:,ib),                 &
8259                                surf_def_v(0)%gtsws(:,ib), surf_def_v(1)%gtsws(:,ib),              &
8260                                surf_def_v(2)%gtsws(:,ib), surf_def_v(3)%gtsws(:,ib),              &
8261                                surf_lsm_v(0)%gtsws(:,ib), surf_lsm_v(1)%gtsws(:,ib),              &
8262                                surf_lsm_v(2)%gtsws(:,ib), surf_lsm_v(3)%gtsws(:,ib),              &
8263                                surf_usm_v(0)%gtsws(:,ib), surf_usm_v(1)%gtsws(:,ib),              &
8264                                surf_usm_v(2)%gtsws(:,ib), surf_usm_v(3)%gtsws(:,ib) )
8265    END SELECT
8266!
8267!-- Prognostic equation for a scalar
8268    DO  i = nxl, nxr
8269       DO  j = nys, nyn
8270!
8271!--       Sedimentation for aerosol number and mass
8272          IF ( lsdepo  .AND.  do_sedimentation )  THEN
8273             tend(nzb+1:nzt,j,i) = tend(nzb+1:nzt,j,i) - MAX( 0.0_wp, ( rs(nzb+2:nzt+1,j,i) *      &
8274                                   sedim_vd(nzb+2:nzt+1,j,i,ib) - rs(nzb+1:nzt,j,i) *              &
8275                                   sedim_vd(nzb+1:nzt,j,i,ib) ) * ddzu(nzb+1:nzt) ) *              &
8276                                   MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(nzb:nzt-1,j,i), 0 ) )
8277          ENDIF
8278          DO  k = nzb+1, nzt
8279             rs_p(k,j,i) = rs(k,j,i) +  ( dt_3d  * ( tsc(2) * tend(k,j,i) + tsc(3) * trs_m(k,j,i) )&
8280                                                  - tsc(5) * rdf_sc(k) * ( rs(k,j,i) - rs_init(k) )&
8281                                        ) * MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) )
8282             IF ( rs_p(k,j,i) < 0.0_wp )  rs_p(k,j,i) = 0.1_wp * rs(k,j,i)
8283          ENDDO
8284       ENDDO
8285    ENDDO
8286!
8287!-- Calculate tendencies for the next Runge-Kutta step
8288    IF ( timestep_scheme(1:5) == 'runge' )  THEN
8289       IF ( intermediate_timestep_count == 1 )  THEN
8290          DO  i = nxl, nxr
8291             DO  j = nys, nyn
8292                DO  k = nzb+1, nzt
8293                   trs_m(k,j,i) = tend(k,j,i)
8294                ENDDO
8295             ENDDO
8296          ENDDO
8297       ELSEIF ( intermediate_timestep_count < intermediate_timestep_count_max )  THEN
8298          DO  i = nxl, nxr
8299             DO  j = nys, nyn
8300                DO  k = nzb+1, nzt
8301                   trs_m(k,j,i) =  -9.5625_wp * tend(k,j,i) + 5.3125_wp * trs_m(k,j,i)
8302                ENDDO
8303             ENDDO
8304          ENDDO
8305       ENDIF
8306    ENDIF
8307
8308 END SUBROUTINE salsa_tendency
8309
8310
8311!------------------------------------------------------------------------------!
8312! Description:
8313! ------------
8314!> Boundary conditions for prognostic variables in SALSA from module interface
8315!------------------------------------------------------------------------------!
8316 SUBROUTINE salsa_boundary_conditions
8317
8318    IMPLICIT NONE
8319
8320    INTEGER(iwp) ::  ib              !< index for aerosol size bins
8321    INTEGER(iwp) ::  ic              !< index for aerosol mass bins
8322    INTEGER(iwp) ::  icc             !< additional index for aerosol mass bins
8323    INTEGER(iwp) ::  ig              !< index for salsa gases
8324
8325
8326!
8327!-- moved from boundary_conds
8328    CALL salsa_boundary_conds
8329!
8330!-- Boundary conditions for prognostic quantitites of other modules:
8331!-- Here, only decycling is carried out
8332    IF ( time_since_reference_point >= skip_time_do_salsa )  THEN
8333
8334       DO  ib = 1, nbins_aerosol
8335          CALL salsa_boundary_conds( aerosol_number(ib)%conc_p, aerosol_number(ib)%init )
8336          DO  ic = 1, ncomponents_mass
8337             icc = ( ic - 1 ) * nbins_aerosol + ib
8338             CALL salsa_boundary_conds( aerosol_mass(icc)%conc_p, aerosol_mass(icc)%init )
8339          ENDDO
8340       ENDDO
8341       IF ( .NOT. salsa_gases_from_chem )  THEN
8342          DO  ig = 1, ngases_salsa
8343             CALL salsa_boundary_conds( salsa_gas(ig)%conc_p, salsa_gas(ig)%init )
8344          ENDDO
8345       ENDIF
8346
8347    ENDIF
8348
8349 END SUBROUTINE salsa_boundary_conditions
8350
8351!------------------------------------------------------------------------------!
8352! Description:
8353! ------------
8354!> Boundary conditions for prognostic variables in SALSA
8355!------------------------------------------------------------------------------!
8356 SUBROUTINE salsa_boundary_conds
8357
8358    USE arrays_3d,                                                                                 &
8359        ONLY:  dzu
8360
8361    USE surface_mod,                                                                               &
8362        ONLY :  bc_h
8363
8364    IMPLICIT NONE
8365
8366    INTEGER(iwp) ::  i    !< grid index x direction
8367    INTEGER(iwp) ::  ib   !< index for aerosol size bins
8368    INTEGER(iwp) ::  ic   !< index for chemical compounds in aerosols
8369    INTEGER(iwp) ::  icc  !< additional index for chemical compounds in aerosols
8370    INTEGER(iwp) ::  ig   !< idex for gaseous compounds
8371    INTEGER(iwp) ::  j    !< grid index y direction
8372    INTEGER(iwp) ::  k    !< grid index y direction
8373    INTEGER(iwp) ::  l    !< running index boundary type, for up- and downward-facing walls
8374    INTEGER(iwp) ::  m    !< running index surface elements
8375
8376    IF ( time_since_reference_point >= skip_time_do_salsa )  THEN
8377!
8378!--    Surface conditions:
8379       IF ( ibc_salsa_b == 0 )  THEN   ! Dirichlet
8380!
8381!--       Run loop over all non-natural and natural walls. Note, in wall-datatype the k coordinate
8382!--       belongs to the atmospheric grid point, therefore, set s_p at k-1
8383          DO  l = 0, 1
8384             !$OMP PARALLEL PRIVATE( ib, ic, icc, ig, i, j, k )
8385             !$OMP DO
8386             DO  m = 1, bc_h(l)%ns
8387
8388                i = bc_h(l)%i(m)
8389                j = bc_h(l)%j(m)
8390                k = bc_h(l)%k(m)
8391
8392                DO  ib = 1, nbins_aerosol
8393                   aerosol_number(ib)%conc_p(k+bc_h(l)%koff,j,i) =             &
8394                                    aerosol_number(ib)%conc(k+bc_h(l)%koff,j,i)
8395                   DO  ic = 1, ncomponents_mass
8396                      icc = ( ic - 1 ) * nbins_aerosol + ib
8397                      aerosol_mass(icc)%conc_p(k+bc_h(l)%koff,j,i) =           &
8398                                    aerosol_mass(icc)%conc(k+bc_h(l)%koff,j,i)
8399                   ENDDO
8400                ENDDO
8401                IF ( .NOT. salsa_gases_from_chem )  THEN
8402                   DO  ig = 1, ngases_salsa
8403                      salsa_gas(ig)%conc_p(k+bc_h(l)%koff,j,i) =               &
8404                                    salsa_gas(ig)%conc(k+bc_h(l)%koff,j,i)
8405                   ENDDO
8406                ENDIF
8407
8408             ENDDO
8409             !$OMP END PARALLEL
8410
8411          ENDDO
8412
8413       ELSE   ! Neumann
8414
8415          DO l = 0, 1
8416             !$OMP PARALLEL PRIVATE( ib, ic, icc, ig, i, j, k )
8417             !$OMP DO
8418             DO  m = 1, bc_h(l)%ns
8419
8420                i = bc_h(l)%i(m)
8421                j = bc_h(l)%j(m)
8422                k = bc_h(l)%k(m)
8423
8424                DO  ib = 1, nbins_aerosol
8425                   aerosol_number(ib)%conc_p(k+bc_h(l)%koff,j,i) =             &
8426                                               aerosol_number(ib)%conc_p(k,j,i)
8427                   DO  ic = 1, ncomponents_mass
8428                      icc = ( ic - 1 ) * nbins_aerosol + ib
8429                      aerosol_mass(icc)%conc_p(k+bc_h(l)%koff,j,i) =           &
8430                                               aerosol_mass(icc)%conc_p(k,j,i)
8431                   ENDDO
8432                ENDDO
8433                IF ( .NOT. salsa_gases_from_chem ) THEN
8434                   DO  ig = 1, ngases_salsa
8435                      salsa_gas(ig)%conc_p(k+bc_h(l)%koff,j,i) =               &
8436                                               salsa_gas(ig)%conc_p(k,j,i)
8437                   ENDDO
8438                ENDIF
8439
8440             ENDDO
8441             !$OMP END PARALLEL
8442          ENDDO
8443
8444       ENDIF
8445!
8446!--   Top boundary conditions:
8447       IF ( ibc_salsa_t == 0 )  THEN   ! Dirichlet
8448
8449          DO  ib = 1, nbins_aerosol
8450             aerosol_number(ib)%conc_p(nzt+1,:,:) = aerosol_number(ib)%conc(nzt+1,:,:)
8451             DO  ic = 1, ncomponents_mass
8452                icc = ( ic - 1 ) * nbins_aerosol + ib
8453                aerosol_mass(icc)%conc_p(nzt+1,:,:) = aerosol_mass(icc)%conc(nzt+1,:,:)
8454             ENDDO
8455          ENDDO
8456          IF ( .NOT. salsa_gases_from_chem )  THEN
8457             DO  ig = 1, ngases_salsa
8458                salsa_gas(ig)%conc_p(nzt+1,:,:) = salsa_gas(ig)%conc(nzt+1,:,:)
8459             ENDDO
8460          ENDIF
8461
8462       ELSEIF ( ibc_salsa_t == 1 )  THEN   ! Neumann
8463
8464          DO  ib = 1, nbins_aerosol
8465             aerosol_number(ib)%conc_p(nzt+1,:,:) = aerosol_number(ib)%conc_p(nzt,:,:)
8466             DO  ic = 1, ncomponents_mass
8467                icc = ( ic - 1 ) * nbins_aerosol + ib
8468                aerosol_mass(icc)%conc_p(nzt+1,:,:) = aerosol_mass(icc)%conc_p(nzt,:,:)
8469             ENDDO
8470          ENDDO
8471          IF ( .NOT. salsa_gases_from_chem )  THEN
8472             DO  ig = 1, ngases_salsa
8473                salsa_gas(ig)%conc_p(nzt+1,:,:) = salsa_gas(ig)%conc_p(nzt,:,:)
8474             ENDDO
8475          ENDIF
8476
8477       ELSEIF ( ibc_salsa_t == 2 )  THEN   ! Initial gradient
8478
8479          DO  ib = 1, nbins_aerosol
8480             aerosol_number(ib)%conc_p(nzt+1,:,:) = aerosol_number(ib)%conc_p(nzt,:,:) +           &
8481                                                    bc_an_t_val(ib) * dzu(nzt+1)
8482             DO  ic = 1, ncomponents_mass
8483                icc = ( ic - 1 ) * nbins_aerosol + ib
8484                aerosol_mass(icc)%conc_p(nzt+1,:,:) = aerosol_mass(icc)%conc_p(nzt,:,:) +          &
8485                                                      bc_am_t_val(icc) * dzu(nzt+1)
8486             ENDDO
8487          ENDDO
8488          IF ( .NOT. salsa_gases_from_chem )  THEN
8489             DO  ig = 1, ngases_salsa
8490                salsa_gas(ig)%conc_p(nzt+1,:,:) = salsa_gas(ig)%conc_p(nzt,:,:) +                  &
8491                                                  bc_gt_t_val(ig) * dzu(nzt+1)
8492             ENDDO
8493          ENDIF
8494
8495       ENDIF
8496!
8497!--    Lateral boundary conditions at the outflow
8498       IF ( bc_radiation_s )  THEN
8499          DO  ib = 1, nbins_aerosol
8500             aerosol_number(ib)%conc_p(:,nys-1,:) = aerosol_number(ib)%conc_p(:,nys,:)
8501             DO  ic = 1, ncomponents_mass
8502                icc = ( ic - 1 ) * nbins_aerosol + ib
8503                aerosol_mass(icc)%conc_p(:,nys-1,:) = aerosol_mass(icc)%conc_p(:,nys,:)
8504             ENDDO
8505          ENDDO
8506          IF ( .NOT. salsa_gases_from_chem )  THEN
8507             DO  ig = 1, ngases_salsa
8508                salsa_gas(ig)%conc_p(:,nys-1,:) = salsa_gas(ig)%conc_p(:,nys,:)
8509             ENDDO
8510          ENDIF
8511
8512       ELSEIF ( bc_radiation_n )  THEN
8513          DO  ib = 1, nbins_aerosol
8514             aerosol_number(ib)%conc_p(:,nyn+1,:) = aerosol_number(ib)%conc_p(:,nyn,:)
8515             DO  ic = 1, ncomponents_mass
8516                icc = ( ic - 1 ) * nbins_aerosol + ib
8517                aerosol_mass(icc)%conc_p(:,nyn+1,:) = aerosol_mass(icc)%conc_p(:,nyn,:)
8518             ENDDO
8519          ENDDO
8520          IF ( .NOT. salsa_gases_from_chem )  THEN
8521             DO  ig = 1, ngases_salsa
8522                salsa_gas(ig)%conc_p(:,nyn+1,:) = salsa_gas(ig)%conc_p(:,nyn,:)
8523             ENDDO
8524          ENDIF
8525
8526       ELSEIF ( bc_radiation_l )  THEN
8527          DO  ib = 1, nbins_aerosol
8528             aerosol_number(ib)%conc_p(:,:,nxl-1) = aerosol_number(ib)%conc_p(:,:,nxl)
8529             DO  ic = 1, ncomponents_mass
8530                icc = ( ic - 1 ) * nbins_aerosol + ib
8531                aerosol_mass(icc)%conc_p(:,:,nxl-1) = aerosol_mass(icc)%conc_p(:,:,nxl)
8532             ENDDO
8533          ENDDO
8534          IF ( .NOT. salsa_gases_from_chem )  THEN
8535             DO  ig = 1, ngases_salsa
8536                salsa_gas(ig)%conc_p(:,:,nxl-1) = salsa_gas(ig)%conc_p(:,:,nxl)
8537             ENDDO
8538          ENDIF
8539
8540       ELSEIF ( bc_radiation_r )  THEN
8541          DO  ib = 1, nbins_aerosol
8542             aerosol_number(ib)%conc_p(:,:,nxr+1) = aerosol_number(ib)%conc_p(:,:,nxr)
8543             DO  ic = 1, ncomponents_mass
8544                icc = ( ic - 1 ) * nbins_aerosol + ib
8545                aerosol_mass(icc)%conc_p(:,:,nxr+1) = aerosol_mass(icc)%conc_p(:,:,nxr)
8546             ENDDO
8547          ENDDO
8548          IF ( .NOT. salsa_gases_from_chem )  THEN
8549             DO  ig = 1, ngases_salsa
8550                salsa_gas(ig)%conc_p(:,:,nxr+1) = salsa_gas(ig)%conc_p(:,:,nxr)
8551             ENDDO
8552          ENDIF
8553
8554       ENDIF
8555
8556    ENDIF
8557
8558 END SUBROUTINE salsa_boundary_conds
8559
8560!------------------------------------------------------------------------------!
8561! Description:
8562! ------------
8563! Undoing of the previously done cyclic boundary conditions.
8564!------------------------------------------------------------------------------!
8565 SUBROUTINE salsa_boundary_conds_decycle ( sq, sq_init )
8566
8567    USE control_parameters,                                                                        &
8568        ONLY:  nesting_offline
8569
8570    IMPLICIT NONE
8571
8572    INTEGER(iwp) ::  boundary  !<
8573    INTEGER(iwp) ::  ee        !<
8574    INTEGER(iwp) ::  copied    !<
8575    INTEGER(iwp) ::  i         !<
8576    INTEGER(iwp) ::  j         !<
8577    INTEGER(iwp) ::  k         !<
8578    INTEGER(iwp) ::  ss        !<
8579
8580    REAL(wp) ::  flag  !< flag to mask topography grid points
8581
8582    REAL(wp), DIMENSION(nzb:nzt+1) ::  sq_init  !< initial concentration profile
8583
8584    REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ::  sq  !< concentration array
8585
8586    flag = 0.0_wp
8587!
8588!-- Skip input if forcing from a larger-scale models is applied.
8589    IF ( nesting_offline  .AND.  nesting_offline_salsa )  RETURN
8590!
8591!-- Left and right boundaries
8592    IF ( decycle_salsa_lr  .AND.  ( bc_lr_cyc  .OR. bc_lr == 'nested' ) )  THEN
8593
8594       DO  boundary = 1, 2
8595
8596          IF ( decycle_method_salsa(boundary) == 'dirichlet' )  THEN
8597!
8598!--          Initial profile is copied to ghost and first three layers
8599             ss = 1
8600             ee = 0
8601             IF ( boundary == 1  .AND.  nxl == 0 )  THEN
8602                ss = nxlg
8603                ee = nxl-1
8604             ELSEIF ( boundary == 2  .AND.  nxr == nx )  THEN
8605                ss = nxr+1
8606                ee = nxrg
8607             ENDIF
8608
8609             DO  i = ss, ee
8610                DO  j = nysg, nyng
8611                   DO  k = nzb+1, nzt
8612                      flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) )
8613                      sq(k,j,i) = sq_init(k) * flag
8614                   ENDDO
8615                ENDDO
8616             ENDDO
8617
8618          ELSEIF ( decycle_method_salsa(boundary) == 'neumann' )  THEN
8619!
8620!--          The value at the boundary is copied to the ghost layers to simulate an outlet with
8621!--          zero gradient
8622             ss = 1
8623             ee = 0
8624             IF ( boundary == 1  .AND.  nxl == 0 )  THEN
8625                ss = nxlg
8626                ee = nxl-1
8627                copied = nxl
8628             ELSEIF ( boundary == 2  .AND.  nxr == nx )  THEN
8629                ss = nxr+1
8630                ee = nxrg
8631                copied = nxr
8632             ENDIF
8633
8634              DO  i = ss, ee
8635                DO  j = nysg, nyng
8636                   DO  k = nzb+1, nzt
8637                      flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) )
8638                      sq(k,j,i) = sq(k,j,copied) * flag
8639                   ENDDO
8640                ENDDO
8641             ENDDO
8642
8643          ELSE
8644             WRITE(message_string,*) 'unknown decycling method: decycle_method_salsa (', boundary, &
8645                                     ') ="' // TRIM( decycle_method_salsa(boundary) ) // '"'
8646             CALL message( 'salsa_boundary_conds_decycle', 'PA0626', 1, 2, 0, 6, 0 )
8647          ENDIF
8648       ENDDO
8649    ENDIF
8650
8651!
8652!-- South and north boundaries
8653     IF ( decycle_salsa_ns  .AND.  ( bc_ns_cyc  .OR. bc_ns == 'nested' ) )  THEN
8654
8655       DO  boundary = 3, 4
8656
8657          IF ( decycle_method_salsa(boundary) == 'dirichlet' )  THEN
8658!
8659!--          Initial profile is copied to ghost and first three layers
8660             ss = 1
8661             ee = 0
8662             IF ( boundary == 3  .AND.  nys == 0 )  THEN
8663                ss = nysg
8664                ee = nys-1
8665             ELSEIF ( boundary == 4  .AND.  nyn == ny )  THEN
8666                ss = nyn+1
8667                ee = nyng
8668             ENDIF
8669
8670             DO  i = nxlg, nxrg
8671                DO  j = ss, ee
8672                   DO  k = nzb+1, nzt
8673                      flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) )
8674                      sq(k,j,i) = sq_init(k) * flag
8675                   ENDDO
8676                ENDDO
8677             ENDDO
8678
8679          ELSEIF ( decycle_method_salsa(boundary) == 'neumann' )  THEN
8680!
8681!--          The value at the boundary is copied to the ghost layers to simulate an outlet with
8682!--          zero gradient
8683             ss = 1
8684             ee = 0
8685             IF ( boundary == 3  .AND.  nys == 0 )  THEN
8686                ss = nysg
8687                ee = nys-1
8688                copied = nys
8689             ELSEIF ( boundary == 4  .AND.  nyn == ny )  THEN
8690                ss = nyn+1
8691                ee = nyng
8692                copied = nyn
8693             ENDIF
8694
8695              DO  i = nxlg, nxrg
8696                DO  j = ss, ee
8697                   DO  k = nzb+1, nzt
8698                      flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) )
8699                      sq(k,j,i) = sq(k,copied,i) * flag
8700                   ENDDO
8701                ENDDO
8702             ENDDO
8703
8704          ELSE
8705             WRITE(message_string,*) 'unknown decycling method: decycle_method_salsa (', boundary, &
8706                                     ') ="' // TRIM( decycle_method_salsa(boundary) ) // '"'
8707             CALL message( 'salsa_boundary_conds_decycle', 'PA0627', 1, 2, 0, 6, 0 )
8708          ENDIF
8709       ENDDO
8710    ENDIF
8711
8712 END SUBROUTINE salsa_boundary_conds_decycle
8713
8714!------------------------------------------------------------------------------!
8715! Description:
8716! ------------
8717!> Calculates the total dry or wet mass concentration for individual bins
8718!> Juha Tonttila (FMI) 2015
8719!> Tomi Raatikainen (FMI) 2016
8720!------------------------------------------------------------------------------!
8721 SUBROUTINE bin_mixrat( itype, ibin, i, j, mconc )
8722
8723    IMPLICIT NONE
8724
8725    CHARACTER(len=*), INTENT(in) ::  itype  !< 'dry' or 'wet'
8726
8727    INTEGER(iwp) ::  ic                 !< loop index for mass bin number
8728    INTEGER(iwp) ::  iend               !< end index: include water or not
8729
8730    INTEGER(iwp), INTENT(in) ::  ibin   !< index of the chemical component
8731    INTEGER(iwp), INTENT(in) ::  i      !< loop index for x-direction
8732    INTEGER(iwp), INTENT(in) ::  j      !< loop index for y-direction
8733
8734    REAL(wp), DIMENSION(:), INTENT(out) ::  mconc  !< total dry or wet mass concentration
8735
8736!-- Number of components
8737    IF ( itype == 'dry' )  THEN
8738       iend = prtcl%ncomp - 1 
8739    ELSE IF ( itype == 'wet' )  THEN
8740       iend = prtcl%ncomp
8741    ELSE
8742       message_string = 'Error in itype!'
8743       CALL message( 'bin_mixrat', 'PA0628', 2, 2, 0, 6, 0 )
8744    ENDIF
8745
8746    mconc = 0.0_wp
8747
8748    DO  ic = ibin, iend*nbins_aerosol+ibin, nbins_aerosol !< every nbins'th element
8749       mconc = mconc + aerosol_mass(ic)%conc(:,j,i)
8750    ENDDO
8751
8752 END SUBROUTINE bin_mixrat
8753
8754!------------------------------------------------------------------------------!
8755! Description:
8756! ------------
8757!> Sets surface fluxes
8758!------------------------------------------------------------------------------!
8759 SUBROUTINE salsa_emission_update
8760
8761    IMPLICIT NONE
8762
8763    IF ( include_emission )  THEN
8764
8765       IF ( time_since_reference_point >= skip_time_do_salsa  )  THEN
8766
8767          IF ( next_aero_emission_update <=                                                        &
8768               MAX( time_since_reference_point, 0.0_wp ) )  THEN
8769             CALL salsa_emission_setup( .FALSE. )
8770          ENDIF
8771
8772          IF ( next_gas_emission_update <=                                                         &
8773               MAX( time_since_reference_point, 0.0_wp ) )  THEN
8774             IF ( salsa_emission_mode == 'read_from_file'  .AND.  .NOT. salsa_gases_from_chem )    &
8775             THEN
8776                CALL salsa_gas_emission_setup( .FALSE. )
8777             ENDIF
8778          ENDIF
8779
8780       ENDIF
8781    ENDIF
8782
8783 END SUBROUTINE salsa_emission_update
8784
8785!------------------------------------------------------------------------------!
8786!> Description:
8787!> ------------
8788!> Define aerosol fluxes: constant or read from a from file
8789!> @todo - Emission stack height is not used yet. For default mode, emissions
8790!>         are assumed to occur on upward facing horizontal surfaces.
8791!------------------------------------------------------------------------------!
8792 SUBROUTINE salsa_emission_setup( init )
8793
8794    USE control_parameters,                                                                        &
8795        ONLY:  end_time, spinup_time
8796
8797    USE netcdf_data_input_mod,                                                                     &
8798        ONLY:  check_existence, close_input_file, get_attribute, get_variable,                     &
8799               inquire_num_variables, inquire_variable_names,                                      &
8800               get_dimension_length, open_read_file, street_type_f
8801
8802    USE palm_date_time_mod,                                                                        &
8803        ONLY:  days_per_week, get_date_time, hours_per_day, months_per_year, seconds_per_hour
8804
8805    USE surface_mod,                                                                               &
8806        ONLY:  surf_def_h, surf_lsm_h, surf_usm_h
8807
8808    IMPLICIT NONE
8809
8810    CHARACTER(LEN=80) ::  daytype = 'workday'  !< default day type
8811    CHARACTER(LEN=25) ::  in_name              !< name of a gas in the input file
8812    CHARACTER(LEN=25) ::  mod_name             !< name in the input file
8813
8814    INTEGER(iwp) ::  day_of_month   !< day of the month
8815    INTEGER(iwp) ::  day_of_week    !< day of the week
8816    INTEGER(iwp) ::  day_of_year    !< day of the year
8817    INTEGER(iwp) ::  hour_of_day    !< hour of the day
8818    INTEGER(iwp) ::  i              !< loop index
8819    INTEGER(iwp) ::  ib             !< loop index: aerosol number bins
8820    INTEGER(iwp) ::  ic             !< loop index: aerosol chemical components
8821    INTEGER(iwp) ::  id_salsa       !< NetCDF id of aerosol emission input file
8822    INTEGER(iwp) ::  in             !< loop index: emission category
8823    INTEGER(iwp) ::  index_dd       !< index day
8824    INTEGER(iwp) ::  index_hh       !< index hour
8825    INTEGER(iwp) ::  index_mm       !< index month
8826    INTEGER(iwp) ::  inn            !< loop index
8827    INTEGER(iwp) ::  j              !< loop index
8828    INTEGER(iwp) ::  month_of_year  !< month of the year
8829    INTEGER(iwp) ::  ss             !< loop index
8830
8831    INTEGER(iwp), DIMENSION(maxspec) ::  cc_i2m   !<
8832
8833    LOGICAL  ::  netcdf_extend = .FALSE.  !< NetCDF input file exists
8834
8835    LOGICAL, INTENT(in) ::  init  !< if .TRUE. --> initialisation call
8836
8837    REAL(wp) ::  second_of_day  !< second of the day
8838
8839    REAL(wp), DIMENSION(24) ::  par_emis_time_factor =  & !< time factors for the parameterized mode
8840                                                      (/ 0.009, 0.004, 0.004, 0.009, 0.029, 0.039, &
8841                                                         0.056, 0.053, 0.051, 0.051, 0.052, 0.055, &
8842                                                         0.059, 0.061, 0.064, 0.067, 0.069, 0.069, &
8843                                                         0.049, 0.039, 0.039, 0.029, 0.024, 0.019 /)
8844
8845    REAL(wp), DIMENSION(:), ALLOCATABLE ::  nsect_emission  !< sectional number emission
8846
8847    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  source_array  !< temporary source array
8848
8849!
8850!-- Define emissions:
8851    SELECT CASE ( salsa_emission_mode )
8852
8853       CASE ( 'uniform', 'parameterized' )
8854
8855          IF ( init )  THEN  ! Do only once
8856!
8857!-           Form a sectional size distribution for the emissions
8858             ALLOCATE( nsect_emission(1:nbins_aerosol),                                            &
8859                       source_array(nys:nyn,nxl:nxr,1:nbins_aerosol) )
8860!
8861!--          Precalculate a size distribution for the emission based on the mean diameter, standard
8862!--          deviation and number concentration per each log-normal mode
8863             CALL size_distribution( surface_aerosol_flux, aerosol_flux_dpg, aerosol_flux_sigmag,  &
8864                                     nsect_emission )
8865             IF ( salsa_emission_mode == 'uniform' )  THEN
8866                DO  ib = 1, nbins_aerosol
8867                   source_array(:,:,ib) = nsect_emission(ib)
8868                ENDDO
8869             ELSE
8870!
8871!--             Get a time factor for the specific hour
8872                IF ( .NOT.  ALLOCATED( aero_emission_att%time_factor ) )                           &
8873                   ALLOCATE( aero_emission_att%time_factor(1) )
8874                CALL get_date_time( MAX( time_since_reference_point, 0.0_wp ), hour=hour_of_day )
8875                index_hh = hour_of_day
8876                aero_emission_att%time_factor(1) = par_emis_time_factor(index_hh+1)
8877
8878                IF ( street_type_f%from_file )  THEN
8879                   DO  i = nxl, nxr
8880                      DO  j = nys, nyn
8881                         IF ( street_type_f%var(j,i) >= main_street_id  .AND.                      &
8882                              street_type_f%var(j,i) < max_street_id )  THEN
8883                            source_array(j,i,:) = nsect_emission(:) * emiss_factor_main *          &
8884                                                  aero_emission_att%time_factor(1)
8885                         ELSEIF ( street_type_f%var(j,i) >= side_street_id  .AND.                  &
8886                                  street_type_f%var(j,i) < main_street_id )  THEN
8887                            source_array(j,i,:) = nsect_emission(:) * emiss_factor_side *          &
8888                                                  aero_emission_att%time_factor(1)
8889                         ENDIF
8890                      ENDDO
8891                   ENDDO
8892                ELSE
8893                   WRITE( message_string, * ) 'salsa_emission_mode = "parameterized" but the '//  &
8894                                              'street_type data is missing.'
8895                   CALL message( 'salsa_emission_setup', 'PA0695', 1, 2, 0, 6, 0 )
8896                ENDIF
8897             ENDIF
8898!
8899!--          Check which chemical components are used
8900             cc_i2m = 0
8901             IF ( index_so4 > 0 ) cc_i2m(1) = index_so4
8902             IF ( index_oc > 0 )  cc_i2m(2) = index_oc
8903             IF ( index_bc > 0 )  cc_i2m(3) = index_bc
8904             IF ( index_du > 0 )  cc_i2m(4) = index_du
8905             IF ( index_ss > 0 )  cc_i2m(5) = index_ss
8906             IF ( index_no > 0 )  cc_i2m(6) = index_no
8907             IF ( index_nh > 0 )  cc_i2m(7) = index_nh
8908!
8909!--          Normalise mass fractions so that their sum is 1
8910             aerosol_flux_mass_fracs_a = aerosol_flux_mass_fracs_a /                               &
8911                                         SUM( aerosol_flux_mass_fracs_a(1:ncc ) )
8912             IF ( salsa_emission_mode ==  'uniform' )  THEN
8913!
8914!--             Set uniform fluxes of default horizontal surfaces
8915                CALL set_flux( surf_def_h(0), cc_i2m, aerosol_flux_mass_fracs_a, source_array )
8916             ELSE
8917!
8918!--             Set fluxes normalised based on the street type on land surfaces
8919                CALL set_flux( surf_lsm_h, cc_i2m, aerosol_flux_mass_fracs_a, source_array )
8920             ENDIF
8921
8922             DEALLOCATE( nsect_emission, source_array )
8923          ENDIF
8924
8925       CASE ( 'read_from_file' )
8926!
8927!--       Reset surface fluxes
8928          surf_def_h(0)%answs = 0.0_wp
8929          surf_def_h(0)%amsws = 0.0_wp
8930          surf_lsm_h%answs = 0.0_wp
8931          surf_lsm_h%amsws = 0.0_wp
8932          surf_usm_h%answs = 0.0_wp
8933          surf_usm_h%amsws = 0.0_wp
8934
8935!
8936!--       Reset source arrays:
8937          DO  ib = 1, nbins_aerosol
8938             aerosol_number(ib)%source = 0.0_wp
8939          ENDDO
8940
8941          DO  ic = 1, ncomponents_mass * nbins_aerosol
8942             aerosol_mass(ic)%source = 0.0_wp
8943          ENDDO
8944
8945#if defined( __netcdf )
8946!
8947!--       Check existence of PIDS_SALSA file
8948          INQUIRE( FILE = TRIM( input_file_salsa ) // TRIM( coupling_char ), EXIST = netcdf_extend )
8949          IF ( .NOT. netcdf_extend )  THEN
8950             message_string = 'Input file '// TRIM( input_file_salsa ) //  TRIM( coupling_char )&
8951                              // ' missing!'
8952             CALL message( 'salsa_emission_setup', 'PA0629', 1, 2, 0, 6, 0 )
8953          ENDIF
8954!
8955!--       Open file in read-only mode
8956          CALL open_read_file( TRIM( input_file_salsa ) // TRIM( coupling_char ), id_salsa )
8957
8958          IF ( init )  THEN
8959!
8960!--          Variable names
8961             CALL inquire_num_variables( id_salsa, aero_emission_att%num_vars )
8962             ALLOCATE( aero_emission_att%var_names(1:aero_emission_att%num_vars) )
8963             CALL inquire_variable_names( id_salsa, aero_emission_att%var_names )
8964!
8965!--          Read the index and name of chemical components
8966             CALL get_dimension_length( id_salsa, aero_emission_att%ncc, 'composition_index' )
8967             ALLOCATE( aero_emission_att%cc_index(1:aero_emission_att%ncc) )
8968             CALL get_variable( id_salsa, 'composition_index', aero_emission_att%cc_index )
8969
8970             IF ( check_existence( aero_emission_att%var_names, 'composition_name' ) )  THEN
8971                CALL get_variable( id_salsa, 'composition_name', aero_emission_att%cc_name,        &
8972                                   aero_emission_att%ncc )
8973             ELSE
8974                message_string = 'Missing composition_name in ' // TRIM( input_file_salsa )
8975                CALL message( 'salsa_emission_setup', 'PA0657', 1, 2, 0, 6, 0 )
8976             ENDIF
8977!
8978!--          Find the corresponding chemical components in the model
8979             aero_emission_att%cc_in2mod = 0
8980             DO  ic = 1, aero_emission_att%ncc
8981                in_name = aero_emission_att%cc_name(ic)
8982                SELECT CASE ( TRIM( in_name ) )
8983                   CASE ( 'H2SO4', 'h2so4', 'SO4', 'so4' )
8984                      aero_emission_att%cc_in2mod(1) = ic
8985                   CASE ( 'OC', 'oc', 'organics' )
8986                      aero_emission_att%cc_in2mod(2) = ic
8987                   CASE ( 'BC', 'bc' )
8988                      aero_emission_att%cc_in2mod(3) = ic
8989                   CASE ( 'DU', 'du' )
8990                      aero_emission_att%cc_in2mod(4) = ic
8991                   CASE ( 'SS', 'ss' )
8992                      aero_emission_att%cc_in2mod(5) = ic
8993                   CASE ( 'HNO3', 'hno3', 'NO', 'no', 'NO3', 'no3' )
8994                      aero_emission_att%cc_in2mod(6) = ic
8995                   CASE ( 'NH3', 'nh3', 'NH', 'nh', 'NH4', 'nh4' )
8996                      aero_emission_att%cc_in2mod(7) = ic
8997                END SELECT
8998
8999             ENDDO
9000
9001             IF ( SUM( aero_emission_att%cc_in2mod ) == 0 )  THEN
9002                message_string = 'None of the aerosol chemical components in ' // TRIM(            &
9003                                 input_file_salsa ) // ' correspond to the ones applied in SALSA.'
9004                CALL message( 'salsa_emission_setup', 'PA0630', 1, 2, 0, 6, 0 )
9005             ENDIF
9006!
9007!--          Get number of emission categories
9008             CALL get_dimension_length( id_salsa, aero_emission_att%ncat, 'ncat' )
9009!
9010!--          Get the chemical composition (i.e. mass fraction of different species) in aerosols
9011             IF ( check_existence( aero_emission_att%var_names, 'emission_mass_fracs' ) )  THEN
9012                ALLOCATE( aero_emission%mass_fracs(1:aero_emission_att%ncat,                       &
9013                                                   1:aero_emission_att%ncc) )
9014                CALL get_variable( id_salsa, 'emission_mass_fracs', aero_emission%mass_fracs,      &
9015                                   0, aero_emission_att%ncc-1, 0, aero_emission_att%ncat-1 )
9016             ELSE
9017                message_string = 'Missing emission_mass_fracs in ' //  TRIM( input_file_salsa )
9018                CALL message( 'salsa_emission_setup', 'PA0694', 1, 2, 0, 6, 0 )
9019             ENDIF
9020!
9021!--          If the chemical component is not activated, set its mass fraction to 0 to avoid
9022!--          inbalance between number and mass flux
9023             cc_i2m = aero_emission_att%cc_in2mod
9024             IF ( index_so4 < 0  .AND.  cc_i2m(1) > 0 )                                            &
9025                aero_emission%mass_fracs(:,cc_i2m(1)) = 0.0_wp
9026             IF ( index_oc  < 0  .AND.  cc_i2m(2) > 0 )                                            &
9027                aero_emission%mass_fracs(:,cc_i2m(2)) = 0.0_wp
9028             IF ( index_bc  < 0  .AND.  cc_i2m(3) > 0 )                                            &
9029                aero_emission%mass_fracs(:,cc_i2m(3)) = 0.0_wp
9030             IF ( index_du  < 0  .AND.  cc_i2m(4) > 0 )                                            &
9031                aero_emission%mass_fracs(:,cc_i2m(4)) = 0.0_wp
9032             IF ( index_ss  < 0  .AND.  cc_i2m(5) > 0 )                                            &
9033                aero_emission%mass_fracs(:,cc_i2m(5)) = 0.0_wp
9034             IF ( index_no  < 0  .AND.  cc_i2m(6) > 0 )                                            &
9035                aero_emission%mass_fracs(:,cc_i2m(6)) = 0.0_wp
9036             IF ( index_nh  < 0  .AND.  cc_i2m(7) > 0 )                                            &
9037                aero_emission%mass_fracs(:,cc_i2m(7)) = 0.0_wp
9038!
9039!--          Then normalise the mass fraction so that SUM = 1
9040             DO  in = 1, aero_emission_att%ncat
9041                aero_emission%mass_fracs(in,:) = aero_emission%mass_fracs(in,:) /                  &
9042                                                 SUM( aero_emission%mass_fracs(in,:) )
9043             ENDDO
9044!
9045!--          Inquire the fill value
9046             CALL get_attribute( id_salsa, '_FillValue', aero_emission%fill, .FALSE.,              &
9047                                 'aerosol_emission_values' )
9048!
9049!--          Inquire units of emissions
9050             CALL get_attribute( id_salsa, 'units', aero_emission_att%units, .FALSE.,              &
9051                                 'aerosol_emission_values' )
9052!
9053!--          Inquire the level of detail (lod)
9054             CALL get_attribute( id_salsa, 'lod', aero_emission_att%lod, .FALSE.,                  &
9055                                 'aerosol_emission_values' )
9056
9057!
9058!--          Read different emission information depending on the level of detail of emissions:
9059
9060!
9061!--          Default mode:
9062             IF ( aero_emission_att%lod == 1 )  THEN
9063!
9064!--             Unit conversion factor: convert to SI units (kg/m2/s)
9065                IF ( aero_emission_att%units == 'kg/m2/yr' )  THEN
9066                   aero_emission_att%conversion_factor = 1.0_wp / 3600.0_wp
9067                ELSEIF ( aero_emission_att%units == 'g/m2/yr' )  THEN
9068                   aero_emission_att%conversion_factor = 0.001_wp / 3600.0_wp
9069                ELSE
9070                   message_string = 'unknown unit for aerosol emissions: ' //                      &
9071                                    TRIM( aero_emission_att%units ) // ' (lod1)'
9072                   CALL message( 'salsa_emission_setup','PA0631', 1, 2, 0, 6, 0 )
9073                ENDIF
9074!
9075!--             Allocate emission arrays
9076                ALLOCATE( aero_emission_att%cat_index(1:aero_emission_att%ncat),                   &
9077                          aero_emission_att%rho(1:aero_emission_att%ncat),                         &
9078                          aero_emission_att%time_factor(1:aero_emission_att%ncat) )
9079!
9080!--             Get emission category names and indices
9081                IF ( check_existence( aero_emission_att%var_names, 'emission_category_name' ) )  THEN
9082                   CALL get_variable( id_salsa, 'emission_category_name',                          &
9083                                      aero_emission_att%cat_name,  aero_emission_att%ncat )
9084                ELSE
9085                   message_string = 'Missing emission_category_name in ' // TRIM( input_file_salsa )
9086                   CALL message( 'salsa_emission_setup', 'PA0658', 1, 2, 0, 6, 0 )
9087                ENDIF
9088                CALL get_variable( id_salsa, 'emission_category_index', aero_emission_att%cat_index )
9089!
9090!--             Find corresponding emission categories
9091                DO  in = 1, aero_emission_att%ncat
9092                   in_name = aero_emission_att%cat_name(in)
9093                   DO  ss = 1, def_modes%ndc
9094                      mod_name = def_modes%cat_name_table(ss)
9095                      IF ( TRIM( in_name(1:4) ) == TRIM( mod_name(1:4 ) ) )  THEN
9096                         def_modes%cat_input_to_model(ss) = in
9097                      ENDIF
9098                   ENDDO
9099                ENDDO
9100
9101                IF ( SUM( def_modes%cat_input_to_model ) == 0 )  THEN
9102                   message_string = 'None of the emission categories in ' //  TRIM(                &
9103                                    input_file_salsa ) // ' match with the ones in the model.'
9104                   CALL message( 'salsa_emission_setup', 'PA0632', 1, 2, 0, 6, 0 )
9105                ENDIF
9106!
9107!--             Emission time factors: Find check whether emission time factors are given for each
9108!--             hour of year OR based on month, day and hour
9109!
9110!--             For each hour of year:
9111                IF ( check_existence( aero_emission_att%var_names, 'nhoursyear' ) )  THEN
9112                   CALL get_dimension_length( id_salsa, aero_emission_att%nhoursyear, 'nhoursyear' )
9113                   ALLOCATE( aero_emission_att%etf(1:aero_emission_att%ncat,                       &
9114                                                   1:aero_emission_att%nhoursyear) )
9115                   CALL get_variable( id_salsa, 'emission_time_factors', aero_emission_att%etf,    &
9116                                    0, aero_emission_att%nhoursyear-1, 0, aero_emission_att%ncat-1 )
9117!
9118!--             Based on the month, day and hour:
9119                ELSEIF ( check_existence( aero_emission_att%var_names, 'nmonthdayhour' ) )  THEN
9120                   CALL get_dimension_length( id_salsa, aero_emission_att%nmonthdayhour,           &
9121                                              'nmonthdayhour' )
9122                   ALLOCATE( aero_emission_att%etf(1:aero_emission_att%ncat,                       &
9123                                                   1:aero_emission_att%nmonthdayhour) )
9124                   CALL get_variable( id_salsa, 'emission_time_factors', aero_emission_att%etf,    &
9125                                 0, aero_emission_att%nmonthdayhour-1, 0, aero_emission_att%ncat-1 )
9126                ELSE
9127                   message_string = 'emission_time_factors should be given for each nhoursyear ' //&
9128                                    'OR nmonthdayhour'
9129                   CALL message( 'salsa_emission_setup','PA0633', 1, 2, 0, 6, 0 )
9130                ENDIF
9131!
9132!--             Next emission update
9133                CALL get_date_time( time_since_reference_point, second_of_day=second_of_day )
9134                next_aero_emission_update = MOD( second_of_day, seconds_per_hour ) !- seconds_per_hour
9135!
9136!--             Calculate average mass density (kg/m3)
9137                aero_emission_att%rho = 0.0_wp
9138
9139                IF ( cc_i2m(1) /= 0 )  aero_emission_att%rho = aero_emission_att%rho +  arhoh2so4 *&
9140                                                               aero_emission%mass_fracs(:,cc_i2m(1))
9141                IF ( cc_i2m(2) /= 0 )  aero_emission_att%rho = aero_emission_att%rho + arhooc *    &
9142                                                               aero_emission%mass_fracs(:,cc_i2m(2))
9143                IF ( cc_i2m(3) /= 0 )  aero_emission_att%rho = aero_emission_att%rho + arhobc *    &
9144                                                               aero_emission%mass_fracs(:,cc_i2m(3))
9145                IF ( cc_i2m(4) /= 0 )  aero_emission_att%rho = aero_emission_att%rho + arhodu *    &
9146                                                               aero_emission%mass_fracs(:,cc_i2m(4))
9147                IF ( cc_i2m(5) /= 0 )  aero_emission_att%rho = aero_emission_att%rho + arhoss *    &
9148                                                               aero_emission%mass_fracs(:,cc_i2m(5))
9149                IF ( cc_i2m(6) /= 0 )  aero_emission_att%rho = aero_emission_att%rho + arhohno3 *  &
9150                                                               aero_emission%mass_fracs(:,cc_i2m(6))
9151                IF ( cc_i2m(7) /= 0 )  aero_emission_att%rho = aero_emission_att%rho + arhonh3 *   &
9152                                                               aero_emission%mass_fracs(:,cc_i2m(7))
9153!
9154!--             Allocate and read surface emission data (in total PM, get_variable_3d_real)
9155                ALLOCATE( aero_emission%def_data(nys:nyn,nxl:nxr,1:aero_emission_att%ncat) )
9156                CALL get_variable( id_salsa, 'aerosol_emission_values', aero_emission%def_data,    &
9157                                   0, aero_emission_att%ncat-1, nxl, nxr, nys, nyn )
9158
9159!
9160!--          Pre-processed mode
9161             ELSEIF ( aero_emission_att%lod == 2 )  THEN
9162!
9163!--             Unit conversion factor: convert to SI units (#/m2/s)
9164                IF ( aero_emission_att%units == '#/m2/s' )  THEN
9165                   aero_emission_att%conversion_factor = 1.0_wp
9166                ELSE
9167                   message_string = 'unknown unit for aerosol emissions: ' //                      &
9168                                    TRIM( aero_emission_att%units )
9169                   CALL message( 'salsa_emission_setup','PA0634', 1, 2, 0, 6, 0 )
9170                ENDIF
9171!
9172!--             Number of aerosol size bins in the emission data
9173                CALL get_dimension_length( id_salsa, aero_emission_att%nbins, 'Dmid' )
9174                IF ( aero_emission_att%nbins /= nbins_aerosol )  THEN
9175                   message_string = 'The number of size bins in aerosol input data does not ' //   &
9176                                    'correspond to the model set-up'
9177                   CALL message( 'salsa_emission_setup','PA0635', 1, 2, 0, 6, 0 )
9178                ENDIF
9179!
9180!--             Number of time steps in the emission data
9181                CALL get_dimension_length( id_salsa, aero_emission_att%nt, 'time')
9182!
9183!--             Allocate bin diameters, time and mass fraction array
9184                ALLOCATE( aero_emission_att%dmid(1:nbins_aerosol),                                 &
9185                          aero_emission_att%time(0:aero_emission_att%nt-1),                        &
9186                          aero_emission%num_fracs(1:aero_emission_att%ncat,1:nbins_aerosol) )
9187!
9188!--             Read mean diameters
9189                CALL get_variable( id_salsa, 'Dmid', aero_emission_att%dmid )
9190!
9191!--             Check whether the sectional representation of the aerosol size distribution conform
9192!--             to the one applied in the model
9193                IF ( ANY( ABS( ( aero(1:nbins_aerosol)%dmid - aero_emission_att%dmid ) /           &
9194                               aero(1:nbins_aerosol)%dmid ) > 0.1_wp )  )  THEN
9195                   message_string = 'Mean diameters of size bins in ' // TRIM( input_file_salsa )  &
9196                                    // ' do not match with the ones in the model.'
9197                   CALL message( 'salsa_emission_setup','PA0636', 1, 2, 0, 6, 0 )
9198                ENDIF
9199!
9200!--             Read time stamps:
9201                IF ( check_existence( aero_emission_att%var_names, 'time' ) )  THEN
9202                   CALL get_variable( id_salsa, 'time', aero_emission_att%time )
9203                ELSE
9204                   message_string = 'Missing time in ' //  TRIM( input_file_salsa )
9205                   CALL message( 'salsa_emission_setup', 'PA0660', 1, 2, 0, 6, 0 )
9206                ENDIF
9207!
9208!--             Check if the provided data covers the entire simulation. The spinup time is added
9209!--             to the end_time, this must be considered here.
9210                IF ( end_time - spinup_time > aero_emission_att%time(aero_emission_att%nt-1) )  THEN
9211                   message_string = 'end_time of the simulation exceeds the time dimension in ' // &
9212                                    'the salsa input file.'
9213                   CALL message( 'salsa_emission_setup', 'PA0692', 1, 2, 0, 6, 0 ) 
9214                ENDIF
9215!
9216!--             Read emission number fractions per category
9217                IF ( check_existence( aero_emission_att%var_names, 'emission_number_fracs' ) )  THEN
9218                   CALL get_variable( id_salsa, 'emission_number_fracs', aero_emission%num_fracs,  &
9219                                      0, nbins_aerosol-1, 0, aero_emission_att%ncat-1 )
9220                ELSE
9221                   message_string = 'Missing emission_number_fracs in ' //  TRIM( input_file_salsa )
9222                   CALL message( 'salsa_emission_setup', 'PA0694', 1, 2, 0, 6, 0 )
9223                ENDIF
9224
9225             ELSE
9226                message_string = 'Unknown lod for aerosol_emission_values.'
9227                CALL message( 'salsa_emission_setup','PA0637', 1, 2, 0, 6, 0 )
9228
9229             ENDIF  ! lod
9230
9231          ENDIF  ! init
9232!
9233!--       Define and set current emission values:
9234!
9235!--       Default type emissions (aerosol emission given as total mass emission per year):
9236          IF ( aero_emission_att%lod == 1 )  THEN
9237!
9238!--          Emission time factors for each emission category at current time step
9239             IF ( aero_emission_att%nhoursyear > aero_emission_att%nmonthdayhour )  THEN
9240!
9241!--             Get the index of the current hour
9242                CALL get_date_time( MAX( 0.0_wp, time_since_reference_point ),                     &
9243                                    day_of_year=day_of_year, hour=hour_of_day )
9244                index_hh = ( day_of_year - 1_iwp ) * hours_per_day + hour_of_day
9245                aero_emission_att%time_factor = aero_emission_att%etf(:,index_hh+1)
9246
9247             ELSEIF ( aero_emission_att%nhoursyear < aero_emission_att%nmonthdayhour )  THEN
9248!
9249!--             Get the index of current hour (index_hh) (TODO: Now "workday" is always assumed.
9250!--             Needs to be calculated.)
9251                CALL get_date_time( MAX( 0.0_wp, time_since_reference_point ), month=month_of_year,&
9252                                    day=day_of_month, hour=hour_of_day, day_of_week=day_of_week )
9253                index_mm = month_of_year
9254                index_dd = months_per_year + day_of_week
9255                SELECT CASE(TRIM(daytype))
9256
9257                   CASE ("workday")
9258                      index_hh = months_per_year + days_per_week + hour_of_day
9259
9260                   CASE ("weekend")
9261                      index_hh = months_per_year + days_per_week + hours_per_day + hour_of_day
9262
9263                   CASE ("holiday")
9264                      index_hh = months_per_year + days_per_week + 2*hours_per_day + hour_of_day
9265
9266                END SELECT
9267                aero_emission_att%time_factor = aero_emission_att%etf(:,index_mm) *                &
9268                                                aero_emission_att%etf(:,index_dd) *                &
9269                                                aero_emission_att%etf(:,index_hh+1)
9270             ENDIF
9271
9272!
9273!--          Create a sectional number size distribution for emissions
9274             ALLOCATE( nsect_emission(1:nbins_aerosol),source_array(nys:nyn,nxl:nxr,1:nbins_aerosol) )
9275             DO  in = 1, aero_emission_att%ncat
9276
9277                inn = def_modes%cat_input_to_model(in)
9278!
9279!--             Calculate the number concentration (1/m3) of a log-normal size distribution
9280!--             following Jacobson (2005): Eq 13.25.
9281                def_modes%ntot_table = 6.0_wp * def_modes%pm_frac_table(:,inn) / ( pi *            &
9282                                       ( def_modes%dpg_table )**3 *  EXP( 4.5_wp *                 &
9283                                       LOG( def_modes%sigmag_table )**2 ) )
9284!
9285!--             Sectional size distibution (1/m3) from a log-normal one
9286                CALL size_distribution( def_modes%ntot_table, def_modes%dpg_table,                 &
9287                                        def_modes%sigmag_table, nsect_emission )
9288
9289                source_array = 0.0_wp
9290                DO  ib = 1, nbins_aerosol
9291                   source_array(:,:,ib) = aero_emission%def_data(:,:,in) *                         &
9292                                          aero_emission_att%conversion_factor /                    &
9293                                          aero_emission_att%rho(in) * nsect_emission(ib) *         &
9294                                          aero_emission_att%time_factor(in)
9295                ENDDO
9296!
9297!--             Set surface fluxes of aerosol number and mass on horizontal surfaces. Set fluxes
9298!--             only for either default, land or urban surface.
9299                IF ( .NOT. land_surface  .AND.  .NOT. urban_surface )  THEN
9300                   CALL set_flux( surf_def_h(0), aero_emission_att%cc_in2mod,                      &
9301                                  aero_emission%mass_fracs(in,:), source_array )
9302                ELSE
9303                   CALL set_flux( surf_usm_h, aero_emission_att%cc_in2mod,                         &
9304                                  aero_emission%mass_fracs(in,:), source_array )
9305                   CALL set_flux( surf_lsm_h, aero_emission_att%cc_in2mod,                         &
9306                                  aero_emission%mass_fracs(in,:), source_array )
9307                ENDIF
9308             ENDDO
9309!
9310!--          The next emission update is again after one hour
9311             next_aero_emission_update = next_aero_emission_update + 3600.0_wp
9312
9313
9314             DEALLOCATE( nsect_emission, source_array )
9315!
9316!--       Pre-processed:
9317          ELSEIF ( aero_emission_att%lod == 2 )  THEN
9318!
9319!--          Obtain time index for current point in time.
9320             aero_emission_att%tind = MINLOC( ABS( aero_emission_att%time -                        &
9321                                                   MAX( time_since_reference_point, 0.0_wp ) ),    &
9322                                              DIM = 1 ) - 1
9323!
9324!--          Allocate the data input array always before reading in the data and deallocate after
9325             ALLOCATE( aero_emission%preproc_data(nys:nyn,nxl:nxr,1:aero_emission_att%ncat),       &
9326                       source_array(nys:nyn,nxl:nxr,1:nbins_aerosol) )
9327!
9328!--          Read in the next time step (get_variable_4d_to_3d_real)
9329             CALL get_variable( id_salsa, 'aerosol_emission_values', aero_emission%preproc_data,   &
9330                                aero_emission_att%tind, 0, aero_emission_att%ncat-1,               &
9331                                nxl, nxr, nys, nyn )
9332!
9333!--          Calculate the sources per category and set surface fluxes
9334             source_array = 0.0_wp
9335             DO  in = 1, aero_emission_att%ncat
9336                DO  ib = 1, nbins_aerosol
9337                   source_array(:,:,ib) = aero_emission%preproc_data(:,:,in) *                     &
9338                                          aero_emission%num_fracs(in,ib)
9339                ENDDO
9340!
9341!--             Set fluxes only for either default, land and urban surface.
9342                IF ( .NOT. land_surface  .AND.  .NOT. urban_surface )  THEN
9343                   CALL set_flux( surf_def_h(0), aero_emission_att%cc_in2mod,                      &
9344                                  aero_emission%mass_fracs(in,:), source_array )
9345                ELSE
9346                   CALL set_flux( surf_usm_h, aero_emission_att%cc_in2mod,                         &
9347                                  aero_emission%mass_fracs(in,:), source_array )
9348                   CALL set_flux( surf_lsm_h, aero_emission_att%cc_in2mod,                         &
9349                                  aero_emission%mass_fracs(in,:), source_array )
9350                ENDIF
9351             ENDDO
9352!
9353!--          Determine the next emission update
9354             next_aero_emission_update = aero_emission_att%time(aero_emission_att%tind+2)
9355
9356             DEALLOCATE( aero_emission%preproc_data, source_array )
9357
9358          ENDIF
9359!
9360!--       Close input file
9361          CALL close_input_file( id_salsa )
9362#else
9363          message_string = 'salsa_emission_mode = "read_from_file", but preprocessor directive ' //&
9364                           ' __netcdf is not used in compiling!'
9365          CALL message( 'salsa_emission_setup', 'PA0638', 1, 2, 0, 6, 0 )
9366
9367#endif
9368       CASE DEFAULT
9369          message_string = 'unknown salsa_emission_mode: ' // TRIM( salsa_emission_mode )
9370          CALL message( 'salsa_emission_setup', 'PA0639', 1, 2, 0, 6, 0 )
9371
9372    END SELECT
9373
9374    CONTAINS
9375
9376!------------------------------------------------------------------------------!
9377! Description:
9378! ------------
9379!> Sets the aerosol flux to aerosol arrays in 2a and 2b.
9380!------------------------------------------------------------------------------!
9381    SUBROUTINE set_flux( surface, cc_i_mod, mass_fracs, source_array )
9382
9383       USE arrays_3d,                                                                              &
9384           ONLY:  rho_air_zw
9385
9386       USE surface_mod,                                                                            &
9387           ONLY:  surf_type
9388
9389       IMPLICIT NONE
9390
9391       INTEGER(iwp) ::  i   !< loop index
9392       INTEGER(iwp) ::  ib  !< loop index
9393       INTEGER(iwp) ::  ic  !< loop index
9394       INTEGER(iwp) ::  j   !< loop index
9395       INTEGER(iwp) ::  k   !< loop index
9396       INTEGER(iwp) ::  m   !< running index for surface elements
9397
9398       INTEGER(iwp), DIMENSION(:) ::  cc_i_mod   !< index of chemical component in the input data
9399
9400       REAL(wp) ::  so4_oc  !< mass fraction between SO4 and OC in 1a
9401
9402       REAL(wp), DIMENSION(:), INTENT(in) ::  mass_fracs  !< mass fractions of chemical components
9403
9404       REAL(wp), DIMENSION(nys:nyn,nxl:nxr,1:nbins_aerosol), INTENT(inout) ::  source_array  !<
9405
9406       TYPE(surf_type), INTENT(inout) :: surface  !< respective surface type
9407
9408       so4_oc = 0.0_wp
9409
9410       DO  m = 1, surface%ns
9411!
9412!--       Get indices of respective grid point
9413          i = surface%i(m)
9414          j = surface%j(m)
9415          k = surface%k(m)
9416
9417          DO  ib = 1, nbins_aerosol
9418             IF ( source_array(j,i,ib) < nclim )  THEN
9419                source_array(j,i,ib) = 0.0_wp
9420             ENDIF
9421!
9422!--          Set mass fluxes.  First bins include only SO4 and/or OC.
9423             IF ( ib <= end_subrange_1a )  THEN
9424!
9425!--             Both sulphate and organic carbon
9426                IF ( index_so4 > 0  .AND.  index_oc > 0 )  THEN
9427
9428                   ic = ( index_so4 - 1 ) * nbins_aerosol + ib
9429                   so4_oc = mass_fracs(cc_i_mod(1)) / ( mass_fracs(cc_i_mod(1)) +                  &
9430                                                        mass_fracs(cc_i_mod(2)) )
9431                   surface%amsws(m,ic) = surface%amsws(m,ic) + so4_oc * source_array(j,i,ib)       &
9432                                         * api6 * aero(ib)%dmid**3 * arhoh2so4 * rho_air_zw(k-1)
9433                   aerosol_mass(ic)%source(j,i) = aerosol_mass(ic)%source(j,i) + surface%amsws(m,ic)
9434
9435                   ic = ( index_oc - 1 ) * nbins_aerosol + ib
9436                   surface%amsws(m,ic) = surface%amsws(m,ic) + ( 1-so4_oc ) * source_array(j,i,ib) &
9437                                         * api6 * aero(ib)%dmid**3 * arhooc * rho_air_zw(k-1)
9438                   aerosol_mass(ic)%source(j,i) = aerosol_mass(ic)%source(j,i) + surface%amsws(m,ic)
9439!
9440!--             Only sulphates
9441                ELSEIF ( index_so4 > 0  .AND.  index_oc < 0 )  THEN
9442                   ic = ( index_so4 - 1 ) * nbins_aerosol + ib
9443                   surface%amsws(m,ic) = surface%amsws(m,ic) + source_array(j,i,ib) * api6 *       &
9444                                         aero(ib)%dmid**3 * arhoh2so4 * rho_air_zw(k-1)
9445                   aerosol_mass(ic)%source(j,i) = aerosol_mass(ic)%source(j,i) + surface%amsws(m,ic)
9446!
9447!--             Only organic carbon
9448                ELSEIF ( index_so4 < 0  .AND.  index_oc > 0 )  THEN
9449                   ic = ( index_oc - 1 ) * nbins_aerosol + ib
9450                   surface%amsws(m,ic) = surface%amsws(m,ic) + source_array(j,i,ib) * api6 *       &
9451                                         aero(ib)%dmid**3 * arhooc * rho_air_zw(k-1)
9452                   aerosol_mass(ic)%source(j,i) = aerosol_mass(ic)%source(j,i) + surface%amsws(m,ic)
9453                ENDIF
9454
9455             ELSE
9456!
9457!--             Sulphate
9458                IF ( index_so4 > 0 )  THEN
9459                   ic = cc_i_mod(1)
9460                   CALL set_mass_flux( surface, m, ib, index_so4, mass_fracs(ic), arhoh2so4,       &
9461                                       source_array(j,i,ib) )
9462                ENDIF
9463!
9464!--             Organic carbon
9465                IF ( index_oc > 0 )  THEN
9466                   ic = cc_i_mod(2)
9467                   CALL set_mass_flux( surface, m, ib, index_oc, mass_fracs(ic),arhooc,            &
9468                                       source_array(j,i,ib) )
9469                ENDIF
9470!
9471!--             Black carbon
9472                IF ( index_bc > 0 )  THEN
9473                   ic = cc_i_mod(3)
9474                   CALL set_mass_flux( surface, m, ib, index_bc, mass_fracs(ic), arhobc,           &
9475                                       source_array(j,i,ib) )
9476                ENDIF
9477!
9478!--             Dust
9479                IF ( index_du > 0 )  THEN
9480                   ic = cc_i_mod(4)
9481                   CALL set_mass_flux( surface, m, ib, index_du, mass_fracs(ic), arhodu,           &
9482                                       source_array(j,i,ib) )
9483                ENDIF
9484!
9485!--             Sea salt
9486                IF ( index_ss > 0 )  THEN
9487                   ic = cc_i_mod(5)
9488                   CALL set_mass_flux( surface, m, ib, index_ss, mass_fracs(ic), arhoss,           &
9489                                       source_array(j,i,ib) )
9490                ENDIF
9491!
9492!--             Nitric acid
9493                IF ( index_no > 0 )  THEN
9494                    ic = cc_i_mod(6)
9495                   CALL set_mass_flux( surface, m, ib, index_no, mass_fracs(ic), arhohno3,         &
9496                                       source_array(j,i,ib) )
9497                ENDIF
9498!
9499!--             Ammonia
9500                IF ( index_nh > 0 )  THEN
9501                    ic = cc_i_mod(7)
9502                   CALL set_mass_flux( surface, m, ib, index_nh, mass_fracs(ic), arhonh3,          &
9503                                       source_array(j,i,ib) )
9504                ENDIF
9505
9506             ENDIF
9507!
9508!--          Save number fluxes in the end
9509             surface%answs(m,ib) = surface%answs(m,ib) + source_array(j,i,ib) * rho_air_zw(k-1)
9510             aerosol_number(ib)%source(j,i) = surface%answs(m,ib)
9511
9512          ENDDO  ! ib
9513       ENDDO  ! m
9514
9515    END SUBROUTINE set_flux
9516
9517!------------------------------------------------------------------------------!
9518! Description:
9519! ------------
9520!> Sets the mass emissions to aerosol arrays in 2a and 2b.
9521!------------------------------------------------------------------------------!
9522    SUBROUTINE set_mass_flux( surface, surf_num, ib, ispec, mass_frac, prho, nsource )
9523
9524       USE arrays_3d,                                                                              &
9525           ONLY:  rho_air_zw
9526
9527       USE surface_mod,                                                                            &
9528           ONLY:  surf_type
9529
9530       IMPLICIT NONE
9531
9532       INTEGER(iwp) ::  i   !< loop index
9533       INTEGER(iwp) ::  j   !< loop index
9534       INTEGER(iwp) ::  k   !< loop index
9535       INTEGER(iwp) ::  ic  !< loop index
9536
9537       INTEGER(iwp), INTENT(in) :: ib        !< Aerosol size bin index
9538       INTEGER(iwp), INTENT(in) :: ispec     !< Aerosol species index
9539       INTEGER(iwp), INTENT(in) :: surf_num  !< index surface elements
9540
9541       REAL(wp), INTENT(in) ::  mass_frac    !< mass fraction of a chemical compound in all bins
9542       REAL(wp), INTENT(in) ::  nsource      !< number source (#/m2/s)
9543       REAL(wp), INTENT(in) ::  prho         !< Aerosol density
9544
9545       TYPE(surf_type), INTENT(inout) ::  surface  !< respective surface type
9546!
9547!--    Get indices of respective grid point
9548       i = surface%i(surf_num)
9549       j = surface%j(surf_num)
9550       k = surface%k(surf_num)
9551!
9552!--    Subrange 2a:
9553       ic = ( ispec - 1 ) * nbins_aerosol + ib
9554       surface%amsws(surf_num,ic) = surface%amsws(surf_num,ic) + mass_frac * nsource *             &
9555                                    aero(ib)%core * prho * rho_air_zw(k-1)
9556       aerosol_mass(ic)%source(j,i) = surface%amsws(surf_num,ic)
9557
9558    END SUBROUTINE set_mass_flux
9559
9560 END SUBROUTINE salsa_emission_setup
9561
9562!------------------------------------------------------------------------------!
9563! Description:
9564! ------------
9565!> Sets the gaseous fluxes
9566!------------------------------------------------------------------------------!
9567 SUBROUTINE salsa_gas_emission_setup( init )
9568
9569    USE netcdf_data_input_mod,                                                                     &
9570        ONLY:  check_existence, close_input_file, get_attribute, get_variable,                     &
9571               inquire_num_variables, inquire_variable_names,                                      &
9572               get_dimension_length, open_read_file
9573
9574    USE palm_date_time_mod,                                                                        &
9575        ONLY:  days_per_week, get_date_time, hours_per_day, months_per_year, seconds_per_hour
9576
9577    USE surface_mod,                                                                               &
9578        ONLY:  surf_def_h, surf_lsm_h, surf_usm_h
9579
9580    IMPLICIT NONE
9581
9582    CHARACTER(LEN=80) ::  daytype = 'workday'  !< default day type
9583    CHARACTER(LEN=25) ::  in_name              !< name of a gas in the input file
9584
9585    CHARACTER(LEN=100), DIMENSION(:), ALLOCATABLE ::  var_names   !<  variable names in input data
9586
9587
9588    INTEGER(iwp) ::  day_of_month   !< day of the month
9589    INTEGER(iwp) ::  day_of_week    !< day of the week
9590    INTEGER(iwp) ::  day_of_year    !< day of the year
9591    INTEGER(iwp) ::  hour_of_day    !< hour of the day
9592    INTEGER(iwp) ::  id_chem        !< NetCDF id of chemistry emission file
9593    INTEGER(iwp) ::  i              !< loop index
9594    INTEGER(iwp) ::  ig             !< loop index
9595    INTEGER(iwp) ::  in             !< running index for emission categories
9596    INTEGER(iwp) ::  index_dd       !< index day
9597    INTEGER(iwp) ::  index_hh       !< index hour
9598    INTEGER(iwp) ::  index_mm       !< index month
9599    INTEGER(iwp) ::  j              !< loop index
9600    INTEGER(iwp) ::  month_of_year  !< month of the year
9601    INTEGER(iwp) ::  num_vars       !< number of variables
9602
9603    LOGICAL  ::  netcdf_extend = .FALSE.  !< NetCDF input file exists
9604
9605    LOGICAL, INTENT(in) ::  init          !< if .TRUE. --> initialisation call
9606
9607    REAL(wp) ::  second_of_day    !< second of the day
9608
9609    REAL(wp), DIMENSION(:), ALLOCATABLE ::  time_factor  !< emission time factor
9610
9611    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  dum_var_3d  !<
9612
9613    REAL(wp), DIMENSION(:,:,:,:,:), ALLOCATABLE ::  dum_var_5d  !<
9614
9615!
9616!-- Reset surface fluxes
9617    surf_def_h(0)%gtsws = 0.0_wp
9618    surf_lsm_h%gtsws = 0.0_wp
9619    surf_usm_h%gtsws = 0.0_wp
9620
9621#if defined( __netcdf )
9622!
9623!-- Check existence of PIDS_CHEM file
9624    INQUIRE( FILE = 'PIDS_CHEM' // TRIM( coupling_char ), EXIST = netcdf_extend )
9625    IF ( .NOT. netcdf_extend )  THEN
9626       message_string = 'Input file PIDS_CHEM' //  TRIM( coupling_char ) // ' missing!'
9627       CALL message( 'salsa_gas_emission_setup', 'PA0640', 1, 2, 0, 6, 0 )
9628    ENDIF
9629!
9630!-- Open file in read-only mode
9631    CALL open_read_file( 'PIDS_CHEM' // TRIM( coupling_char ), id_chem )
9632
9633    IF ( init )  THEN
9634!
9635!--    Read the index and name of chemical components
9636       CALL get_dimension_length( id_chem, chem_emission_att%n_emiss_species, 'nspecies' )
9637       ALLOCATE( chem_emission_att%species_index(1:chem_emission_att%n_emiss_species) )
9638       CALL get_variable( id_chem, 'emission_index', chem_emission_att%species_index )
9639       CALL get_variable( id_chem, 'emission_name', chem_emission_att%species_name,                &
9640                          chem_emission_att%n_emiss_species )
9641!
9642!--    Allocate emission data
9643       ALLOCATE( chem_emission(1:chem_emission_att%n_emiss_species) )
9644!
9645!--    Find the corresponding indices in the model
9646       emission_index_chem = 0
9647       DO  ig = 1, chem_emission_att%n_emiss_species
9648          in_name = chem_emission_att%species_name(ig)
9649          SELECT CASE ( TRIM( in_name ) )
9650             CASE ( 'H2SO4', 'h2so4' )
9651                emission_index_chem(1) = ig
9652             CASE ( 'HNO3', 'hno3' )
9653                emission_index_chem(2) = ig
9654             CASE ( 'NH3', 'nh3' )
9655                emission_index_chem(3) = ig
9656             CASE ( 'OCNV', 'ocnv' )
9657                emission_index_chem(4) = ig
9658             CASE ( 'OCSV', 'ocsv' )
9659                emission_index_chem(5) = ig
9660          END SELECT
9661       ENDDO
9662!
9663!--    Inquire the fill value
9664       CALL get_attribute( id_chem, '_FillValue', aero_emission%fill, .FALSE., 'emission_values' )
9665!
9666!--    Inquire units of emissions
9667       CALL get_attribute( id_chem, 'units', chem_emission_att%units, .FALSE., 'emission_values' )
9668!
9669!--    Inquire the level of detail (lod)
9670       CALL get_attribute( id_chem, 'lod', lod_gas_emissions, .FALSE., 'emission_values' )
9671!
9672!--    Variable names
9673       CALL inquire_num_variables( id_chem, num_vars )
9674       ALLOCATE( var_names(1:num_vars) )
9675       CALL inquire_variable_names( id_chem, var_names )
9676!
9677!--    Default mode: as total emissions per year
9678       IF ( lod_gas_emissions == 1 )  THEN
9679
9680!
9681!--       Get number of emission categories and allocate emission arrays
9682          CALL get_dimension_length( id_chem, chem_emission_att%ncat, 'ncat' )
9683          ALLOCATE( chem_emission_att%cat_index(1:chem_emission_att%ncat),                         &
9684                    time_factor(1:chem_emission_att%ncat) )
9685!
9686!--       Get emission category names and indices
9687          CALL get_variable( id_chem, 'emission_category_name', chem_emission_att%cat_name,        &
9688                             chem_emission_att%ncat)
9689          CALL get_variable( id_chem, 'emission_category_index', chem_emission_att%cat_index )
9690!
9691!--       Emission time factors: Find check whether emission time factors are given for each hour
9692!--       of year OR based on month, day and hour
9693!
9694!--       For each hour of year:
9695          IF ( check_existence( var_names, 'nhoursyear' ) )  THEN
9696             CALL get_dimension_length( id_chem, chem_emission_att%nhoursyear, 'nhoursyear' )
9697             ALLOCATE( chem_emission_att%hourly_emis_time_factor(1:chem_emission_att%ncat,         &
9698                                                                 1:chem_emission_att%nhoursyear) )
9699             CALL get_variable( id_chem, 'emission_time_factors',                                  &
9700                                chem_emission_att%hourly_emis_time_factor,                         &
9701                                0, chem_emission_att%nhoursyear-1, 0, chem_emission_att%ncat-1 )
9702!
9703!--       Based on the month, day and hour:
9704          ELSEIF ( check_existence( var_names, 'nmonthdayhour' ) )  THEN
9705             CALL get_dimension_length( id_chem, chem_emission_att%nmonthdayhour, 'nmonthdayhour' )
9706             ALLOCATE( chem_emission_att%mdh_emis_time_factor(1:chem_emission_att%ncat,            &
9707                                                              1:chem_emission_att%nmonthdayhour) )
9708             CALL get_variable( id_chem, 'emission_time_factors',                                  &
9709                                chem_emission_att%mdh_emis_time_factor,                            &
9710                                0, chem_emission_att%nmonthdayhour-1, 0, chem_emission_att%ncat-1 )
9711          ELSE
9712             message_string = 'emission_time_factors should be given for each nhoursyear OR ' //   &
9713                              'nmonthdayhour'
9714             CALL message( 'salsa_gas_emission_setup','PA0641', 1, 2, 0, 6, 0 )
9715          ENDIF
9716!
9717!--       Next emission update
9718          CALL get_date_time( time_since_reference_point, second_of_day=second_of_day )
9719          next_gas_emission_update = MOD( second_of_day, seconds_per_hour ) !- seconds_per_hour
9720!
9721!--       Allocate and read surface emission data (in total PM) (NOTE that "preprocessed" input data
9722!--       array is applied now here)
9723          ALLOCATE( dum_var_5d(1,nys:nyn,nxl:nxr,1:chem_emission_att%n_emiss_species,              &
9724                               1:chem_emission_att%ncat) )
9725          CALL get_variable( id_chem, 'emission_values', dum_var_5d, 0, chem_emission_att%ncat-1,  &
9726                             0, chem_emission_att%n_emiss_species-1, nxl, nxr, nys, nyn, 0, 0 )
9727          DO  ig = 1, chem_emission_att%n_emiss_species
9728             ALLOCATE( chem_emission(ig)%default_emission_data(nys:nyn,nxl:nxr,                    &
9729                                                               1:chem_emission_att%ncat) )
9730             DO  in = 1, chem_emission_att%ncat
9731                DO  i = nxl, nxr
9732                   DO  j = nys, nyn
9733                      chem_emission(ig)%default_emission_data(j,i,in) = dum_var_5d(1,j,i,ig,in)
9734                   ENDDO
9735                ENDDO
9736             ENDDO
9737          ENDDO
9738          DEALLOCATE( dum_var_5d )
9739!
9740!--    Pre-processed mode:
9741       ELSEIF ( lod_gas_emissions == 2 )  THEN
9742!
9743!--       Number of time steps in the emission data
9744          CALL get_dimension_length( id_chem, chem_emission_att%dt_emission, 'time' )
9745!
9746!--       Allocate and read time
9747          ALLOCATE( gas_emission_time(1:chem_emission_att%dt_emission) )
9748          CALL get_variable( id_chem, 'time', gas_emission_time )
9749       ELSE
9750          message_string = 'Unknown lod for emission_values.'
9751          CALL message( 'salsa_gas_emission_setup','PA0642', 1, 2, 0, 6, 0 )
9752       ENDIF  ! lod
9753
9754    ENDIF  ! init
9755!
9756!-- Define and set current emission values:
9757
9758    IF ( lod_gas_emissions == 1 )  THEN
9759!
9760!--    Emission time factors for each emission category at current time step
9761       IF ( chem_emission_att%nhoursyear > chem_emission_att%nmonthdayhour )  THEN
9762!
9763!--       Get the index of the current hour
9764          CALL get_date_time( time_since_reference_point, &
9765                              day_of_year=day_of_year, hour=hour_of_day )
9766          index_hh = ( day_of_year - 1_iwp ) * hours_per_day + hour_of_day
9767          IF ( .NOT. ALLOCATED( time_factor ) )  ALLOCATE( time_factor(1:chem_emission_att%ncat) )
9768          time_factor = 0.0_wp
9769          time_factor = chem_emission_att%hourly_emis_time_factor(:,index_hh+1)
9770
9771       ELSEIF ( chem_emission_att%nhoursyear < chem_emission_att%nmonthdayhour )  THEN
9772!
9773!--       Get the index of current hour (index_hh) (TODO: Now "workday" is always assumed.
9774!--       Needs to be calculated.)
9775          CALL get_date_time( time_since_reference_point, &
9776                              month=month_of_year,        &
9777                              day=day_of_month,           &
9778                              hour=hour_of_day,           &
9779                              day_of_week=day_of_week     )
9780          index_mm = month_of_year
9781          index_dd = months_per_year + day_of_week
9782          SELECT CASE( TRIM( daytype ) )
9783
9784             CASE ("workday")
9785                index_hh = months_per_year + days_per_week + hour_of_day
9786
9787             CASE ("weekend")
9788                index_hh = months_per_year + days_per_week + hours_per_day + hour_of_day
9789
9790             CASE ("holiday")
9791                index_hh = months_per_year + days_per_week + 2*hours_per_day + hour_of_day
9792
9793          END SELECT
9794          time_factor = chem_emission_att%mdh_emis_time_factor(:,index_mm) *                       &
9795                        chem_emission_att%mdh_emis_time_factor(:,index_dd) *                       &
9796                        chem_emission_att%mdh_emis_time_factor(:,index_hh+1)
9797       ENDIF
9798!
9799!--    Set gas emissions for each emission category
9800       ALLOCATE( dum_var_3d(nys:nyn,nxl:nxr,1:chem_emission_att%n_emiss_species) )
9801
9802       DO  in = 1, chem_emission_att%ncat
9803          DO  ig = 1, chem_emission_att%n_emiss_species
9804             dum_var_3d(:,:,ig) = chem_emission(ig)%default_emission_data(:,:,in)
9805          ENDDO
9806!
9807!--       Set surface fluxes only for either default, land or urban surface
9808          IF ( .NOT. land_surface  .AND.  .NOT. urban_surface )  THEN
9809             CALL set_gas_flux( surf_def_h(0), emission_index_chem, chem_emission_att%units,    &
9810                                dum_var_3d, time_factor(in) )
9811          ELSE
9812             CALL set_gas_flux( surf_usm_h, emission_index_chem, chem_emission_att%units,       &
9813                                dum_var_3d, time_factor(in) )
9814             CALL set_gas_flux( surf_lsm_h, emission_index_chem, chem_emission_att%units,       &
9815                                dum_var_3d, time_factor(in) )
9816          ENDIF
9817       ENDDO
9818       DEALLOCATE( dum_var_3d )
9819!
9820!--    The next emission update is again after one hour
9821       next_gas_emission_update = next_gas_emission_update + 3600.0_wp
9822
9823    ELSEIF ( lod_gas_emissions == 2 )  THEN
9824!
9825!--    Obtain time index for current point in time.
9826       chem_emission_att%i_hour = MINLOC( ABS( gas_emission_time -                                 &
9827                                          MAX( time_since_reference_point, 0.0_wp ) ), DIM = 1 ) - 1
9828!
9829!--    Allocate the data input array always before reading in the data and deallocate after (NOTE
9830!--    that "preprocessed" input data array is applied now here)
9831       ALLOCATE( dum_var_5d(1,1,nys:nyn,nxl:nxr,1:chem_emission_att%n_emiss_species) )
9832!
9833!--    Read in the next time step
9834       CALL get_variable( id_chem, 'emission_values', dum_var_5d,                                  &
9835                          0, chem_emission_att%n_emiss_species-1, nxl, nxr, nys, nyn, 0, 0,        &
9836                          chem_emission_att%i_hour, chem_emission_att%i_hour )
9837!
9838!--    Set surface fluxes only for either default, land or urban surface
9839       IF ( .NOT. land_surface  .AND.  .NOT. urban_surface )  THEN
9840          CALL set_gas_flux( surf_def_h(0), emission_index_chem, chem_emission_att%units,          &
9841                             dum_var_5d(1,1,:,:,:) )
9842       ELSE
9843          CALL set_gas_flux( surf_usm_h, emission_index_chem, chem_emission_att%units,             &
9844                             dum_var_5d(1,1,:,:,:) )
9845          CALL set_gas_flux( surf_lsm_h, emission_index_chem, chem_emission_att%units,             &
9846                             dum_var_5d(1,1,:,:,:) )
9847       ENDIF
9848       DEALLOCATE ( dum_var_5d )
9849!
9850!--    Determine the next emission update
9851       next_gas_emission_update = gas_emission_time(chem_emission_att%i_hour+2)
9852
9853    ENDIF
9854!
9855!-- Close input file
9856    CALL close_input_file( id_chem )
9857
9858#else
9859    message_string = 'salsa_emission_mode = "read_from_file", but preprocessor directive ' //   &
9860                     ' __netcdf is not used in compiling!'
9861    CALL message( 'salsa_gas_emission_setup', 'PA0643', 1, 2, 0, 6, 0 )
9862
9863#endif
9864
9865    CONTAINS
9866!------------------------------------------------------------------------------!
9867! Description:
9868! ------------
9869!> Set gas fluxes for selected type of surfaces
9870!------------------------------------------------------------------------------!
9871    SUBROUTINE set_gas_flux( surface, cc_i_mod, unit, source_array, time_fac )
9872
9873       USE arrays_3d,                                                                              &
9874           ONLY: dzw, hyp, pt, rho_air_zw
9875
9876       USE grid_variables,                                                                         &
9877           ONLY:  dx, dy
9878
9879       USE surface_mod,                                                                            &
9880           ONLY:  surf_type
9881
9882       IMPLICIT NONE
9883
9884       CHARACTER(LEN=*), INTENT(in) ::  unit  !< flux unit in the input file
9885
9886       INTEGER(iwp) ::  ig  !< running index for gases
9887       INTEGER(iwp) ::  i   !< loop index
9888       INTEGER(iwp) ::  j   !< loop index
9889       INTEGER(iwp) ::  k   !< loop index
9890       INTEGER(iwp) ::  m   !< running index for surface elements
9891
9892       INTEGER(iwp), DIMENSION(:) ::  cc_i_mod   !< index of different gases in the input data
9893
9894       LOGICAL ::  use_time_fac  !< .TRUE. is time_fac present
9895
9896       REAL(wp), OPTIONAL ::  time_fac  !< emission time factor
9897
9898       REAL(wp), DIMENSION(ngases_salsa) ::  conv     !< unit conversion factor
9899
9900       REAL(wp), DIMENSION(nys:nyn,nxl:nxr,1:chem_emission_att%n_emiss_species), INTENT(in) ::  source_array  !<
9901
9902       TYPE(surf_type), INTENT(inout) :: surface  !< respective surface type
9903
9904       conv = 1.0_wp
9905       use_time_fac = PRESENT( time_fac )
9906
9907       DO  m = 1, surface%ns
9908!
9909!--       Get indices of respective grid point
9910          i = surface%i(m)
9911          j = surface%j(m)
9912          k = surface%k(m)
9913!
9914!--       Unit conversion factor: convert to SI units (#/m2/s)
9915          SELECT CASE ( TRIM( unit ) )
9916             CASE ( 'kg/m2/yr' )
9917                conv(1) = avo / ( amh2so4 * 3600.0_wp )
9918                conv(2) = avo / ( amhno3 * 3600.0_wp )
9919                conv(3) = avo / ( amnh3 * 3600.0_wp )
9920                conv(4) = avo / ( amoc * 3600.0_wp )
9921                conv(5) = avo / ( amoc * 3600.0_wp )
9922             CASE ( 'g/m2/yr' )
9923                conv(1) = avo / ( amh2so4 * 3.6E+6_wp )
9924                conv(2) = avo / ( amhno3 * 3.6E+6_wp )
9925                conv(3) = avo / ( amnh3 * 3.6E+6_wp )
9926                conv(4) = avo / ( amoc * 3.6E+6_wp )
9927                conv(5) = avo / ( amoc * 3.6E+6_wp )
9928             CASE ( 'g/m2/s' )
9929                conv(1) = avo / ( amh2so4 * 1000.0_wp )
9930                conv(2) = avo / ( amhno3 * 1000.0_wp )
9931                conv(3) = avo / ( amnh3 * 1000.0_wp )
9932                conv(4) = avo / ( amoc * 1000.0_wp )
9933                conv(5) = avo / ( amoc * 1000.0_wp )
9934             CASE ( '#/m2/s' )
9935                conv = 1.0_wp
9936             CASE ( 'ppm/m2/s' )
9937                conv = for_ppm_to_nconc * hyp(k) / pt(k,j,i) * ( 1.0E5_wp / hyp(k) )**0.286_wp *   &
9938                       dx * dy * dzw(k)
9939             CASE ( 'mumol/m2/s' )
9940                conv = 1.0E-6_wp * avo
9941             CASE DEFAULT
9942                message_string = 'unknown unit for gas emissions: ' // TRIM( chem_emission_att%units )
9943                CALL message( 'set_gas_flux','PA0644', 1, 2, 0, 6, 0 )
9944
9945          END SELECT
9946
9947          DO  ig = 1, ngases_salsa
9948             IF ( use_time_fac )  THEN
9949                surface%gtsws(m,ig) = surface%gtsws(m,ig) + rho_air_zw(k-1) * conv(ig) * time_fac  &
9950                                      * MAX( 0.0_wp, source_array(j,i,cc_i_mod(ig) ) )
9951             ELSE
9952                surface%gtsws(m,ig) = surface%gtsws(m,ig) + rho_air_zw(k-1) * conv(ig)             &
9953                                      * MAX( 0.0_wp, source_array(j,i,cc_i_mod(ig) ) )
9954             ENDIF
9955          ENDDO  ! ig
9956
9957       ENDDO  ! m
9958
9959    END SUBROUTINE set_gas_flux
9960
9961 END SUBROUTINE salsa_gas_emission_setup
9962
9963!------------------------------------------------------------------------------!
9964! Description:
9965! ------------
9966!> Check data output for salsa.
9967!------------------------------------------------------------------------------!
9968 SUBROUTINE salsa_check_data_output( var, unit )
9969
9970    IMPLICIT NONE
9971
9972    CHARACTER(LEN=*) ::  unit     !<
9973    CHARACTER(LEN=*) ::  var      !<
9974
9975    INTEGER(iwp) ::  char_to_int   !< for converting character to integer
9976
9977    IF ( var(1:6) /= 'salsa_' )  THEN
9978       unit = 'illegal'
9979       RETURN
9980    ENDIF
9981!
9982!-- Treat bin-specific outputs separately
9983    IF ( var(7:11) ==  'N_bin' )  THEN
9984       READ( var(12:),* ) char_to_int
9985       IF ( char_to_int >= 1  .AND. char_to_int <= SUM( nbin ) )  THEN
9986          unit = '#/m3'
9987       ELSE
9988          unit = 'illegal'
9989          RETURN
9990       ENDIF
9991
9992    ELSEIF ( var(7:11) ==  'm_bin' )  THEN
9993       READ( var(12:),* ) char_to_int
9994       IF ( char_to_int >= 1  .AND. char_to_int <= SUM( nbin ) )  THEN
9995          unit = 'kg/m3'
9996       ELSE
9997          unit = 'illegal'
9998          RETURN
9999       ENDIF
10000
10001    ELSEIF ( var(7:11) == 's_H2O' )  THEN
10002       IF ( .NOT. advect_particle_water )  THEN
10003          message_string = 'to output s_H2O/s_H2O_av requires that advect_particle_water = .T.'
10004          CALL message( 'check_parameters', 'PA0707', 1, 2, 0, 6, 0 )
10005       ENDIF
10006
10007    ELSE
10008       SELECT CASE ( TRIM( var(7:) ) )
10009
10010          CASE ( 'g_H2SO4', 'g_HNO3', 'g_NH3', 'g_OCNV',  'g_OCSV' )
10011             IF (  air_chemistry )  THEN
10012                message_string = 'gases are imported from the chemistry module and thus output '// &
10013                                 'of "' // TRIM( var ) // '" is not allowed'
10014                CALL message( 'check_parameters', 'PA0653', 1, 2, 0, 6, 0 )
10015             ENDIF
10016             unit = '#/m3'
10017
10018          CASE ( 'LDSA' )
10019             unit = 'mum2/cm3'
10020
10021          CASE ( 'PM0.1', 'PM2.5', 'PM10', 's_BC', 's_DU', 's_H2O', 's_NH', 's_NO', 's_OC',        &
10022                 's_SO4', 's_SS' )
10023             unit = 'kg/m3'
10024
10025          CASE ( 'N_UFP', 'Ntot' )
10026             unit = '#/m3'
10027
10028          CASE DEFAULT
10029             unit = 'illegal'
10030
10031       END SELECT
10032    ENDIF
10033
10034 END SUBROUTINE salsa_check_data_output
10035
10036!------------------------------------------------------------------------------!
10037! Description:
10038! ------------
10039!> Check profile data output for salsa. Currently only for diagnostic variables
10040!> Ntot, N_UFP, PM0.1, PM2.5, PM10 and LDSA
10041!------------------------------------------------------------------------------!
10042 SUBROUTINE salsa_check_data_output_pr( var, var_count, unit, dopr_unit )
10043
10044    USE arrays_3d,                                                                                 &
10045        ONLY: zu
10046
10047    USE profil_parameter,                                                                          &
10048        ONLY:  dopr_index
10049
10050    USE statistics,                                                                                &
10051        ONLY:  hom, pr_palm, statistic_regions
10052
10053    IMPLICIT NONE
10054
10055    CHARACTER(LEN=*) ::  dopr_unit  !<
10056    CHARACTER(LEN=*) ::  unit       !<
10057    CHARACTER(LEN=*) ::  var        !<
10058
10059    INTEGER(iwp) ::  var_count     !<
10060
10061    IF ( var(1:6) /= 'salsa_' )  THEN
10062       unit = 'illegal'
10063       RETURN
10064    ENDIF
10065
10066    SELECT CASE ( TRIM( var(7:) ) )
10067
10068       CASE( 'LDSA' )
10069          salsa_pr_count = salsa_pr_count + 1
10070          salsa_pr_index(salsa_pr_count) = 1
10071          dopr_index(var_count) = pr_palm + salsa_pr_count
10072          dopr_unit = 'mum2/cm3'
10073          unit = dopr_unit
10074          hom(:,2,dopr_index(var_count),:) = SPREAD( zu, 2, statistic_regions+1 )
10075
10076       CASE( 'N_UFP' )
10077          salsa_pr_count = salsa_pr_count + 1
10078          salsa_pr_index(salsa_pr_count) = 2
10079          dopr_index(var_count) = pr_palm + salsa_pr_count
10080          dopr_unit = '#/m3'
10081          unit = dopr_unit
10082          hom(:,2,dopr_index(var_count),:) = SPREAD( zu, 2, statistic_regions+1 )
10083
10084       CASE( 'Ntot' )
10085          salsa_pr_count = salsa_pr_count + 1
10086          salsa_pr_index(salsa_pr_count) = 3
10087          dopr_index(var_count) = pr_palm + salsa_pr_count
10088          dopr_unit = '#/m3'
10089          unit = dopr_unit
10090          hom(:,2,dopr_index(var_count),:) = SPREAD( zu, 2, statistic_regions+1 )
10091
10092       CASE( 'PM0.1' )
10093          salsa_pr_count = salsa_pr_count + 1
10094          salsa_pr_index(salsa_pr_count) = 4
10095          dopr_index(var_count) = pr_palm + salsa_pr_count
10096          dopr_unit = 'kg/m3'
10097          unit = dopr_unit
10098          hom(:,2,dopr_index(var_count),:) = SPREAD( zu, 2, statistic_regions+1 )
10099
10100       CASE( 'PM2.5' )
10101          salsa_pr_count = salsa_pr_count + 1
10102          salsa_pr_index(salsa_pr_count) = 5
10103          dopr_index(var_count) = pr_palm + salsa_pr_count
10104          dopr_unit = 'kg/m3'
10105          unit = dopr_unit
10106          hom(:,2,dopr_index(var_count),:) = SPREAD( zu, 2, statistic_regions+1 )
10107
10108       CASE( 'PM10' )
10109          salsa_pr_count = salsa_pr_count + 1
10110          salsa_pr_index(salsa_pr_count) = 6
10111          dopr_index(var_count) = pr_palm + salsa_pr_count
10112          dopr_unit = 'kg/m3'
10113          unit = dopr_unit
10114          hom(:,2,dopr_index(var_count),:) = SPREAD( zu, 2, statistic_regions+1 )
10115
10116       CASE DEFAULT
10117          unit = 'illegal'
10118
10119    END SELECT
10120
10121
10122 END SUBROUTINE salsa_check_data_output_pr
10123
10124!-------------------------------------------------------------------------------!
10125!> Description:
10126!> Calculation of horizontally averaged profiles for salsa.
10127!-------------------------------------------------------------------------------!
10128 SUBROUTINE salsa_statistics( mode, sr, tn )
10129
10130    USE control_parameters,                                                                        &
10131        ONLY:  max_pr_user
10132
10133    USE chem_modules,                                                                              &
10134        ONLY:  max_pr_cs
10135
10136    USE statistics,                                                                                &
10137        ONLY:  pr_palm, rmask, sums_l
10138
10139    IMPLICIT NONE
10140
10141    CHARACTER(LEN=*) ::  mode  !<
10142
10143    INTEGER(iwp) ::  i    !< loop index
10144    INTEGER(iwp) ::  ib   !< loop index
10145    INTEGER(iwp) ::  ic   !< loop index
10146    INTEGER(iwp) ::  ii   !< loop index
10147    INTEGER(iwp) ::  ind  !< index in the statistical output
10148    INTEGER(iwp) ::  j    !< loop index
10149    INTEGER(iwp) ::  k    !< loop index
10150    INTEGER(iwp) ::  sr   !< statistical region
10151    INTEGER(iwp) ::  tn   !< thread number
10152
10153    REAL(wp) ::  df        !< For calculating LDSA: fraction of particles depositing in the alveolar
10154                           !< (or tracheobronchial) region of the lung. Depends on the particle size
10155    REAL(wp) ::  mean_d    !< Particle diameter in micrometres
10156    REAL(wp) ::  temp_bin  !< temporary variable
10157
10158    IF ( mode == 'profiles' )  THEN
10159       !$OMP DO
10160       DO  ii = 1, salsa_pr_count
10161
10162          ind = pr_palm + max_pr_user + max_pr_cs + ii
10163
10164          SELECT CASE( salsa_pr_index(ii) )
10165
10166             CASE( 1 )  ! LDSA
10167                DO  i = nxl, nxr
10168                   DO  j = nys, nyn
10169                      DO  k = nzb, nzt+1
10170                         temp_bin = 0.0_wp
10171                         DO  ib = 1, nbins_aerosol
10172   !
10173   !--                      Diameter in micrometres
10174                            mean_d = 1.0E+6_wp * ra_dry(k,j,i,ib) * 2.0_wp
10175   !
10176   !--                      Deposition factor: alveolar
10177                            df = ( 0.01555_wp / mean_d ) * ( EXP( -0.416_wp * ( LOG( mean_d ) +    &
10178                                   2.84_wp )**2 ) + 19.11_wp * EXP( -0.482_wp * ( LOG( mean_d ) -  &
10179                                   1.362_wp )**2 ) )
10180   !
10181   !--                      Lung-deposited surface area LDSA (units mum2/cm3)
10182                            temp_bin = temp_bin + pi * mean_d**2 * df * 1.0E-6_wp *                &
10183                                       aerosol_number(ib)%conc(k,j,i)
10184                         ENDDO
10185                         sums_l(k,ind,tn) = sums_l(k,ind,tn) + temp_bin * rmask(j,i,sr)  *         &
10186                                           MERGE( 1.0_wp, 0.0_wp,                                  &
10187                                           BTEST( wall_flags_total_0(k,j,i), 22 ) )
10188                      ENDDO
10189                   ENDDO
10190                ENDDO
10191
10192             CASE( 2 )  ! N_UFP
10193                DO  i = nxl, nxr
10194                   DO  j = nys, nyn
10195                      DO  k = nzb, nzt+1
10196                         temp_bin = 0.0_wp
10197                         DO  ib = 1, nbins_aerosol
10198                            IF ( 2.0_wp * ra_dry(k,j,i,ib) <= 0.1E-6_wp )                          &
10199                               temp_bin = temp_bin + aerosol_number(ib)%conc(k,j,i)
10200                         ENDDO
10201                         sums_l(k,ind,tn) = sums_l(k,ind,tn) + temp_bin * rmask(j,i,sr)  *         &
10202                                           MERGE( 1.0_wp, 0.0_wp,                                  &
10203                                           BTEST( wall_flags_total_0(k,j,i), 22 ) )
10204                      ENDDO
10205                   ENDDO
10206                ENDDO
10207
10208             CASE( 3 )  ! Ntot
10209                DO  i = nxl, nxr
10210                   DO  j = nys, nyn
10211                      DO  k = nzb, nzt+1
10212                         temp_bin = 0.0_wp
10213                         DO  ib = 1, nbins_aerosol
10214                            temp_bin = temp_bin + aerosol_number(ib)%conc(k,j,i)
10215                         ENDDO
10216                         sums_l(k,ind,tn) = sums_l(k,ind,tn) + temp_bin * rmask(j,i,sr)  *         &
10217                                           MERGE( 1.0_wp, 0.0_wp,                                  &
10218                                           BTEST( wall_flags_total_0(k,j,i), 22 ) )
10219                      ENDDO
10220                   ENDDO
10221                ENDDO
10222
10223             CASE( 4 )  ! PM0.1
10224                DO  i = nxl, nxr
10225                   DO  j = nys, nyn
10226                      DO  k = nzb, nzt+1
10227                         temp_bin = 0.0_wp
10228                         DO  ib = 1, nbins_aerosol
10229                            IF ( 2.0_wp * ra_dry(k,j,i,ib) <= 0.1E-6_wp )  THEN
10230                               DO  ic = ib, nbins_aerosol * ncc, nbins_aerosol
10231                                  temp_bin = temp_bin + aerosol_mass(ic)%conc(k,j,i)
10232                               ENDDO
10233                            ENDIF
10234                         ENDDO
10235                         sums_l(k,ind,tn) = sums_l(k,ind,tn) + temp_bin * rmask(j,i,sr)  *         &
10236                                           MERGE( 1.0_wp, 0.0_wp,                                  &
10237                                           BTEST( wall_flags_total_0(k,j,i), 22 ) )
10238                      ENDDO
10239                   ENDDO
10240                ENDDO
10241
10242             CASE( 5 )  ! PM2.5
10243                DO  i = nxl, nxr
10244                   DO  j = nys, nyn
10245                      DO  k = nzb, nzt+1
10246                         temp_bin = 0.0_wp
10247                         DO  ib = 1, nbins_aerosol
10248                            IF ( 2.0_wp * ra_dry(k,j,i,ib) <= 2.5E-6_wp )  THEN
10249                               DO  ic = ib, nbins_aerosol * ncc, nbins_aerosol
10250                                  temp_bin = temp_bin + aerosol_mass(ic)%conc(k,j,i)
10251                               ENDDO
10252                            ENDIF
10253                         ENDDO
10254                         sums_l(k,ind,tn) = sums_l(k,ind,tn) + temp_bin * rmask(j,i,sr)  *         &
10255                                           MERGE( 1.0_wp, 0.0_wp,                                  &
10256                                           BTEST( wall_flags_total_0(k,j,i), 22 ) )
10257                      ENDDO
10258                   ENDDO
10259                ENDDO
10260
10261             CASE( 6 )  ! PM10
10262                DO  i = nxl, nxr
10263                   DO  j = nys, nyn
10264                      DO  k = nzb, nzt+1
10265                         temp_bin = 0.0_wp
10266                         DO  ib = 1, nbins_aerosol
10267                            IF ( 2.0_wp * ra_dry(k,j,i,ib) <= 10.0E-6_wp )  THEN
10268                               DO  ic = ib, nbins_aerosol * ncc, nbins_aerosol
10269                                  temp_bin = temp_bin + aerosol_mass(ic)%conc(k,j,i)
10270                               ENDDO
10271                            ENDIF
10272                         ENDDO
10273                         sums_l(k,ind,tn) = sums_l(k,ind,tn) + temp_bin * rmask(j,i,sr)  *         &
10274                                           MERGE( 1.0_wp, 0.0_wp,                                  &
10275                                           BTEST( wall_flags_total_0(k,j,i), 22 ) )
10276                      ENDDO
10277                   ENDDO
10278                ENDDO
10279
10280          END SELECT
10281       ENDDO
10282
10283    ELSEIF ( mode == 'time_series' )  THEN
10284!
10285!--    TODO
10286    ENDIF
10287
10288 END SUBROUTINE salsa_statistics
10289
10290
10291!------------------------------------------------------------------------------!
10292!
10293! Description:
10294! ------------
10295!> Subroutine for averaging 3D data
10296!------------------------------------------------------------------------------!
10297 SUBROUTINE salsa_3d_data_averaging( mode, variable )
10298
10299    USE control_parameters,                                                                        &
10300        ONLY:  average_count_3d
10301
10302    IMPLICIT NONE
10303
10304    CHARACTER(LEN=*)  ::  mode       !<
10305    CHARACTER(LEN=10) ::  vari       !<
10306    CHARACTER(LEN=*)  ::  variable   !<
10307
10308    INTEGER(iwp) ::  char_to_int  !< for converting character to integer
10309    INTEGER(iwp) ::  found_index  !<
10310    INTEGER(iwp) ::  i            !<
10311    INTEGER(iwp) ::  ib           !<
10312    INTEGER(iwp) ::  ic           !<
10313    INTEGER(iwp) ::  j            !<
10314    INTEGER(iwp) ::  k            !<
10315
10316    REAL(wp) ::  df       !< For calculating LDSA: fraction of particles depositing in the alveolar
10317                          !< (or tracheobronchial) region of the lung. Depends on the particle size
10318    REAL(wp) ::  mean_d   !< Particle diameter in micrometres
10319    REAL(wp) ::  temp_bin !< temporary variable
10320
10321    REAL(wp), DIMENSION(:,:,:), POINTER ::  to_be_resorted  !< points to selected output variable
10322
10323    temp_bin = 0.0_wp
10324
10325    IF ( mode == 'allocate' )  THEN
10326
10327       IF ( variable(7:11) ==  'N_bin' )  THEN
10328          IF ( .NOT. ALLOCATED( nbins_av ) )  THEN
10329             ALLOCATE( nbins_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg,nbins_aerosol) )
10330          ENDIF
10331          nbins_av = 0.0_wp
10332
10333       ELSEIF ( variable(7:11) ==  'm_bin' )  THEN
10334          IF ( .NOT. ALLOCATED( mbins_av ) )  THEN
10335             ALLOCATE( mbins_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg,nbins_aerosol) )
10336          ENDIF
10337          mbins_av = 0.0_wp
10338
10339       ELSE
10340
10341          SELECT CASE ( TRIM( variable(7:) ) )
10342
10343             CASE ( 'g_H2SO4', 'g_HNO3', 'g_NH3', 'g_OCNV', 'g_OCSV' )
10344                IF ( .NOT. ALLOCATED( salsa_gases_av ) )  THEN
10345                   ALLOCATE( salsa_gases_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg,ngases_salsa) )
10346                ENDIF
10347                salsa_gases_av = 0.0_wp
10348
10349             CASE ( 'LDSA' )
10350                IF ( .NOT. ALLOCATED( ldsa_av ) )  THEN
10351                   ALLOCATE( ldsa_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
10352                ENDIF
10353                ldsa_av = 0.0_wp
10354
10355             CASE ( 'N_UFP' )
10356                IF ( .NOT. ALLOCATED( nufp_av ) )  THEN
10357                   ALLOCATE( nufp_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
10358                ENDIF
10359                nufp_av = 0.0_wp
10360
10361             CASE ( 'Ntot' )
10362                IF ( .NOT. ALLOCATED( ntot_av ) )  THEN
10363                   ALLOCATE( ntot_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
10364                ENDIF
10365                ntot_av = 0.0_wp
10366
10367             CASE ( 'PM0.1' )
10368                IF ( .NOT. ALLOCATED( pm01_av ) )  THEN
10369                   ALLOCATE( pm01_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
10370                ENDIF
10371                pm01_av = 0.0_wp
10372
10373             CASE ( 'PM2.5' )
10374                IF ( .NOT. ALLOCATED( pm25_av ) )  THEN
10375                   ALLOCATE( pm25_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
10376                ENDIF
10377                pm25_av = 0.0_wp
10378
10379             CASE ( 'PM10' )
10380                IF ( .NOT. ALLOCATED( pm10_av ) )  THEN
10381                   ALLOCATE( pm10_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
10382                ENDIF
10383                pm10_av = 0.0_wp
10384
10385             CASE ( 's_BC', 's_DU', 's_NH', 's_NO', 's_OC', 's_SO4', 's_SS' )
10386                IF ( .NOT. ALLOCATED( s_mass_av ) )  THEN
10387                   ALLOCATE( s_mass_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg,ncomponents_mass+1) )
10388                ENDIF
10389                s_mass_av = 0.0_wp
10390
10391             CASE ( 's_H2O' )
10392                IF ( .NOT. ALLOCATED( s_h2o_av ) )  THEN
10393                   ALLOCATE( s_h2o_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
10394                ENDIF
10395                s_h2o_av = 0.0_wp
10396
10397             CASE DEFAULT
10398                CONTINUE
10399
10400          END SELECT
10401
10402       ENDIF
10403
10404    ELSEIF ( mode == 'sum' )  THEN
10405
10406       IF ( variable(7:11) ==  'N_bin' )  THEN
10407          IF ( ALLOCATED( nbins_av ) )  THEN
10408             READ( variable(12:),* ) char_to_int
10409             IF ( char_to_int >= 1  .AND. char_to_int <= SUM( nbin ) )  THEN
10410                ib = char_to_int
10411                DO  i = nxlg, nxrg
10412                   DO  j = nysg, nyng
10413                      DO  k = nzb, nzt+1
10414                         nbins_av(k,j,i,ib) = nbins_av(k,j,i,ib) + aerosol_number(ib)%conc(k,j,i)
10415                      ENDDO
10416                   ENDDO
10417                ENDDO
10418             ENDIF
10419          ENDIF
10420
10421       ELSEIF ( variable(7:11) ==  'm_bin' )  THEN
10422          IF ( ALLOCATED( mbins_av ) )  THEN
10423             READ( variable(12:),* ) char_to_int
10424             IF ( char_to_int >= 1  .AND. char_to_int <= SUM( nbin ) )  THEN
10425                ib = char_to_int
10426                DO  i = nxlg, nxrg
10427                   DO  j = nysg, nyng
10428                      DO  k = nzb, nzt+1
10429                         temp_bin = 0.0_wp
10430                         DO  ic = ib, nbins_aerosol * ncomponents_mass, nbins_aerosol
10431                            temp_bin = temp_bin + aerosol_mass(ic)%conc(k,j,i)
10432                         ENDDO
10433                         mbins_av(k,j,i,ib) = mbins_av(k,j,i,ib) + temp_bin
10434                      ENDDO
10435                   ENDDO
10436                ENDDO
10437             ENDIF
10438          ENDIF
10439       ELSE
10440
10441          SELECT CASE ( TRIM( variable(7:) ) )
10442
10443             CASE ( 'g_H2SO4', 'g_HNO3', 'g_NH3', 'g_OCNV', 'g_OCSV' )
10444                IF ( ALLOCATED( salsa_gases_av ) )  THEN
10445
10446                   vari = TRIM( variable(9:) )  ! remove salsa_g_ from beginning
10447
10448                   SELECT CASE( vari )
10449
10450                      CASE( 'H2SO4' )
10451                         found_index = 1
10452                      CASE( 'HNO3' )
10453                         found_index = 2
10454                      CASE( 'NH3' )
10455                         found_index = 3
10456                      CASE( 'OCNV' )
10457                         found_index = 4
10458                      CASE( 'OCSV' )
10459                         found_index = 5
10460
10461                   END SELECT
10462
10463                   DO  i = nxlg, nxrg
10464                      DO  j = nysg, nyng
10465                         DO  k = nzb, nzt+1
10466                            salsa_gases_av(k,j,i,found_index) = salsa_gases_av(k,j,i,found_index)  &
10467                                                                + salsa_gas(found_index)%conc(k,j,i)
10468                         ENDDO
10469                      ENDDO
10470                   ENDDO
10471                ENDIF
10472
10473             CASE ( 'LDSA' )
10474                IF ( ALLOCATED( ldsa_av ) )  THEN
10475                   DO  i = nxlg, nxrg
10476                      DO  j = nysg, nyng
10477                         DO  k = nzb, nzt+1
10478                            temp_bin = 0.0_wp
10479                            DO  ib = 1, nbins_aerosol
10480!
10481!--                            Diameter in micrometres
10482                               mean_d = 1.0E+6_wp * ra_dry(k,j,i,ib) * 2.0_wp
10483!
10484!--                            Deposition factor: alveolar (use ra_dry)
10485                               df = ( 0.01555_wp / mean_d ) * ( EXP( -0.416_wp * ( LOG( mean_d ) + &
10486                                      2.84_wp )**2 ) + 19.11_wp * EXP( -0.482_wp * ( LOG( mean_d ) &
10487                                      - 1.362_wp )**2 ) )
10488!
10489!--                            Lung-deposited surface area LDSA (units mum2/cm3)
10490                               temp_bin = temp_bin + pi * mean_d**2 * df * 1.0E-6_wp *             &
10491                                          aerosol_number(ib)%conc(k,j,i)
10492                            ENDDO
10493                            ldsa_av(k,j,i) = ldsa_av(k,j,i) + temp_bin
10494                         ENDDO
10495                      ENDDO
10496                   ENDDO
10497                ENDIF
10498
10499             CASE ( 'N_UFP' )
10500                IF ( ALLOCATED( nufp_av ) )  THEN
10501                   DO  i = nxlg, nxrg
10502                      DO  j = nysg, nyng
10503                         DO  k = nzb, nzt+1
10504                            temp_bin = 0.0_wp
10505                            DO  ib = 1, nbins_aerosol
10506                               IF ( 2.0_wp * ra_dry(k,j,i,ib) <= 0.1E-6_wp )  THEN
10507                                  temp_bin = temp_bin + aerosol_number(ib)%conc(k,j,i)
10508                               ENDIF
10509                            ENDDO
10510                            nufp_av(k,j,i) = nufp_av(k,j,i) + temp_bin
10511                         ENDDO
10512                      ENDDO
10513                   ENDDO
10514                ENDIF
10515
10516             CASE ( 'Ntot' )
10517               IF ( ALLOCATED( ntot_av ) )  THEN
10518                   DO  i = nxlg, nxrg
10519                      DO  j = nysg, nyng
10520                         DO  k = nzb, nzt+1
10521                            DO  ib = 1, nbins_aerosol
10522                               ntot_av(k,j,i) = ntot_av(k,j,i) + aerosol_number(ib)%conc(k,j,i)
10523                            ENDDO
10524                         ENDDO
10525                      ENDDO
10526                   ENDDO
10527                ENDIF
10528
10529             CASE ( 'PM0.1' )
10530                IF ( ALLOCATED( pm01_av ) )  THEN
10531                   DO  i = nxlg, nxrg
10532                      DO  j = nysg, nyng
10533                         DO  k = nzb, nzt+1
10534                            temp_bin = 0.0_wp
10535                            DO  ib = 1, nbins_aerosol
10536                               IF ( 2.0_wp * ra_dry(k,j,i,ib) <= 0.1E-6_wp )  THEN
10537                                  DO  ic = ib, nbins_aerosol * ncc, nbins_aerosol
10538                                     temp_bin = temp_bin + aerosol_mass(ic)%conc(k,j,i)
10539                                  ENDDO
10540                               ENDIF
10541                            ENDDO
10542                            pm01_av(k,j,i) = pm01_av(k,j,i) + temp_bin
10543                         ENDDO
10544                      ENDDO
10545                   ENDDO
10546                ENDIF
10547
10548             CASE ( 'PM2.5' )
10549                IF ( ALLOCATED( pm25_av ) )  THEN
10550                   DO  i = nxlg, nxrg
10551                      DO  j = nysg, nyng
10552                         DO  k = nzb, nzt+1
10553                            temp_bin = 0.0_wp
10554                            DO  ib = 1, nbins_aerosol
10555                               IF ( 2.0_wp * ra_dry(k,j,i,ib) <= 2.5E-6_wp )  THEN
10556                                  DO  ic = ib, nbins_aerosol * ncc, nbins_aerosol
10557                                     temp_bin = temp_bin + aerosol_mass(ic)%conc(k,j,i)
10558                                  ENDDO
10559                               ENDIF
10560                            ENDDO
10561                            pm25_av(k,j,i) = pm25_av(k,j,i) + temp_bin
10562                         ENDDO
10563                      ENDDO
10564                   ENDDO
10565                ENDIF
10566
10567             CASE ( 'PM10' )
10568                IF ( ALLOCATED( pm10_av ) )  THEN
10569                   DO  i = nxlg, nxrg
10570                      DO  j = nysg, nyng
10571                         DO  k = nzb, nzt+1
10572                            temp_bin = 0.0_wp
10573                            DO  ib = 1, nbins_aerosol
10574                               IF ( 2.0_wp * ra_dry(k,j,i,ib) <= 10.0E-6_wp )  THEN
10575                                  DO  ic = ib, nbins_aerosol * ncc, nbins_aerosol
10576                                     temp_bin = temp_bin + aerosol_mass(ic)%conc(k,j,i)
10577                                  ENDDO
10578                               ENDIF
10579                            ENDDO
10580                            pm10_av(k,j,i) = pm10_av(k,j,i) + temp_bin
10581                         ENDDO
10582                      ENDDO
10583                   ENDDO
10584                ENDIF
10585
10586             CASE ( 's_BC', 's_DU', 's_NH', 's_NO', 's_OC', 's_SO4', 's_SS' )
10587                IF ( ALLOCATED( s_mass_av ) )  THEN
10588                   IF ( is_used( prtcl, TRIM( variable(9:) ) ) )  THEN  ! 9: remove salsa_s_
10589                      found_index = get_index( prtcl, TRIM( variable(9:) ) )
10590                      DO  i = nxlg, nxrg
10591                         DO  j = nysg, nyng
10592                            DO  k = nzb, nzt+1
10593                               DO  ic = ( found_index-1 ) * nbins_aerosol + 1, found_index * nbins_aerosol
10594                                  s_mass_av(k,j,i,found_index) = s_mass_av(k,j,i,found_index) +    &
10595                                                                 aerosol_mass(ic)%conc(k,j,i)
10596                               ENDDO
10597                            ENDDO
10598                         ENDDO
10599                      ENDDO
10600                   ENDIF
10601                ENDIF
10602
10603             CASE ( 's_H2O' )
10604                IF ( ALLOCATED( s_H2O_av ) )  THEN
10605                   found_index = get_index( prtcl,'H2O' )
10606                   to_be_resorted => s_h2o_av
10607                   DO  i = nxlg, nxrg
10608                      DO  j = nysg, nyng
10609                         DO  k = nzb, nzt+1
10610                            DO  ic = ( found_index-1 ) * nbins_aerosol + 1, found_index * nbins_aerosol
10611                               s_h2o_av(k,j,i) = s_h2o_av(k,j,i) + aerosol_mass(ic)%conc(k,j,i)
10612                            ENDDO
10613                         ENDDO
10614                      ENDDO
10615                   ENDDO
10616                ENDIF
10617
10618             CASE DEFAULT
10619                CONTINUE
10620
10621          END SELECT
10622
10623       ENDIF
10624
10625    ELSEIF ( mode == 'average' )  THEN
10626
10627       IF ( variable(7:11) ==  'N_bin' )  THEN
10628          IF ( ALLOCATED( nbins_av ) )  THEN
10629             READ( variable(12:),* ) char_to_int
10630             IF ( char_to_int >= 1  .AND. char_to_int <= SUM( nbin ) )  THEN
10631                ib = char_to_int
10632                DO  i = nxlg, nxrg
10633                   DO  j = nysg, nyng
10634                      DO  k = nzb, nzt+1
10635                         nbins_av(k,j,i,ib) = nbins_av(k,j,i,ib) / REAL( average_count_3d, KIND=wp )
10636                      ENDDO
10637                   ENDDO
10638                ENDDO
10639             ENDIF
10640          ENDIF
10641
10642       ELSEIF ( variable(7:11) ==  'm_bin' )  THEN
10643          IF ( ALLOCATED( mbins_av ) )  THEN
10644             READ( variable(12:),* ) char_to_int
10645             IF ( char_to_int >= 1  .AND. char_to_int <= SUM( nbin ) )  THEN
10646                ib = char_to_int
10647                DO  i = nxlg, nxrg
10648                   DO  j = nysg, nyng
10649                      DO  k = nzb, nzt+1
10650                         mbins_av(k,j,i,ib) = mbins_av(k,j,i,ib) / REAL( average_count_3d, KIND=wp)
10651                      ENDDO
10652                   ENDDO
10653                ENDDO
10654             ENDIF
10655          ENDIF
10656       ELSE
10657
10658          SELECT CASE ( TRIM( variable(7:) ) )
10659
10660             CASE ( 'g_H2SO4', 'g_HNO3', 'g_NH3', 'g_OCNV', 'g_OCSV' )
10661                IF ( ALLOCATED( salsa_gases_av ) )  THEN
10662                   IF ( TRIM( variable(9:) ) == 'H2SO4' )  THEN  ! 9: remove salsa_g_ from beginning
10663                      found_index = 1
10664                   ELSEIF ( TRIM( variable(9:) ) == 'HNO3' )  THEN
10665                      found_index = 2
10666                   ELSEIF ( TRIM( variable(9:) ) == 'NH3' )  THEN
10667                      found_index = 3
10668                   ELSEIF ( TRIM( variable(9:) ) == 'OCNV' )  THEN
10669                      found_index = 4
10670                   ELSEIF ( TRIM( variable(9:) ) == 'OCSV' )  THEN
10671                      found_index = 5
10672                   ENDIF
10673                   DO  i = nxlg, nxrg
10674                      DO  j = nysg, nyng
10675                         DO  k = nzb, nzt+1
10676                            salsa_gases_av(k,j,i,found_index) = salsa_gases_av(k,j,i,found_index)  &
10677                                                                / REAL( average_count_3d, KIND=wp )
10678                         ENDDO
10679                      ENDDO
10680                   ENDDO
10681                ENDIF
10682
10683             CASE ( 'LDSA' )
10684                IF ( ALLOCATED( ldsa_av ) )  THEN
10685                   DO  i = nxlg, nxrg
10686                      DO  j = nysg, nyng
10687                         DO  k = nzb, nzt+1
10688                            ldsa_av(k,j,i) = ldsa_av(k,j,i) / REAL( average_count_3d, KIND=wp )
10689                         ENDDO
10690                      ENDDO
10691                   ENDDO
10692                ENDIF
10693
10694             CASE ( 'N_UFP' )
10695                IF ( ALLOCATED( nufp_av ) )  THEN
10696                   DO  i = nxlg, nxrg
10697                      DO  j = nysg, nyng
10698                         DO  k = nzb, nzt+1
10699                            nufp_av(k,j,i) = nufp_av(k,j,i) / REAL( average_count_3d, KIND=wp )
10700                         ENDDO
10701                      ENDDO
10702                   ENDDO
10703                ENDIF
10704
10705             CASE ( 'Ntot' )
10706                IF ( ALLOCATED( ntot_av ) )  THEN
10707                   DO  i = nxlg, nxrg
10708                      DO  j = nysg, nyng
10709                         DO  k = nzb, nzt+1
10710                            ntot_av(k,j,i) = ntot_av(k,j,i) / REAL( average_count_3d, KIND=wp )
10711                         ENDDO
10712                      ENDDO
10713                   ENDDO
10714                ENDIF
10715
10716             CASE ( 'PM0.1' )
10717                IF ( ALLOCATED( pm01_av ) )  THEN
10718                   DO  i = nxlg, nxrg
10719                      DO  j = nysg, nyng
10720                         DO  k = nzb, nzt+1
10721                            pm01_av(k,j,i) = pm01_av(k,j,i) / REAL( average_count_3d, KIND=wp )
10722                         ENDDO
10723                      ENDDO
10724                   ENDDO
10725                ENDIF
10726
10727             CASE ( 'PM2.5' )
10728                IF ( ALLOCATED( pm25_av ) )  THEN
10729                   DO  i = nxlg, nxrg
10730                      DO  j = nysg, nyng
10731                         DO  k = nzb, nzt+1
10732                            pm25_av(k,j,i) = pm25_av(k,j,i) / REAL( average_count_3d, KIND=wp )
10733                         ENDDO
10734                      ENDDO
10735                   ENDDO
10736                ENDIF
10737
10738             CASE ( 'PM10' )
10739                IF ( ALLOCATED( pm10_av ) )  THEN
10740                   DO  i = nxlg, nxrg
10741                      DO  j = nysg, nyng
10742                         DO  k = nzb, nzt+1
10743                            pm10_av(k,j,i) = pm10_av(k,j,i) / REAL( average_count_3d, KIND=wp )
10744                         ENDDO
10745                      ENDDO
10746                   ENDDO
10747                ENDIF
10748
10749             CASE ( 's_BC', 's_DU', 's_NH', 's_NO', 's_OC', 's_SO4', 's_SS' )
10750                IF ( ALLOCATED( s_mass_av ) )  THEN
10751                   IF ( is_used( prtcl, TRIM( variable(9:) ) ) )  THEN  ! 9: remove salsa_s_
10752                      found_index = get_index( prtcl, TRIM( variable(9:) ) )
10753                      DO  i = nxlg, nxrg
10754                         DO  j = nysg, nyng
10755                            DO  k = nzb, nzt+1
10756                               s_mass_av(k,j,i,found_index) = s_mass_av(k,j,i,found_index) /       &
10757                                                              REAL( average_count_3d, KIND=wp )
10758                            ENDDO
10759                         ENDDO
10760                      ENDDO
10761                   ENDIF
10762                ENDIF
10763
10764             CASE ( 's_H2O' )
10765                to_be_resorted => s_h2o_av
10766                DO  i = nxlg, nxrg
10767                   DO  j = nysg, nyng
10768                      DO  k = nzb, nzt+1
10769                         to_be_resorted(k,j,i) = to_be_resorted(k,j,i) /                           &
10770                                                 REAL( average_count_3d, KIND=wp )
10771                      ENDDO
10772                   ENDDO
10773                ENDDO
10774
10775          END SELECT
10776
10777       ENDIF
10778    ENDIF
10779
10780 END SUBROUTINE salsa_3d_data_averaging
10781
10782
10783!------------------------------------------------------------------------------!
10784!
10785! Description:
10786! ------------
10787!> Subroutine defining 2D output variables
10788!------------------------------------------------------------------------------!
10789 SUBROUTINE salsa_data_output_2d( av, variable, found, grid, mode, local_pf, two_d, nzb_do, nzt_do )
10790
10791    USE indices
10792
10793    USE kinds
10794
10795
10796    IMPLICIT NONE
10797
10798    CHARACTER(LEN=*) ::  grid       !<
10799    CHARACTER(LEN=*) ::  mode       !<
10800    CHARACTER(LEN=*) ::  variable   !<
10801    CHARACTER(LEN=5) ::  vari       !<  trimmed format of variable
10802
10803    INTEGER(iwp) ::  av           !<
10804    INTEGER(iwp) ::  char_to_int  !< for converting character to integer
10805    INTEGER(iwp) ::  found_index  !< index of a chemical compound
10806    INTEGER(iwp) ::  i            !<
10807    INTEGER(iwp) ::  ib           !< running index: size bins
10808    INTEGER(iwp) ::  ic           !< running index: mass bins
10809    INTEGER(iwp) ::  j            !<
10810    INTEGER(iwp) ::  k            !<
10811    INTEGER(iwp) ::  nzb_do       !<
10812    INTEGER(iwp) ::  nzt_do       !<
10813
10814    LOGICAL ::  found  !<
10815    LOGICAL ::  two_d  !< flag parameter to indicate 2D variables (horizontal cross sections)
10816
10817    REAL(wp) ::  df                       !< For calculating LDSA: fraction of particles
10818                                          !< depositing in the alveolar (or tracheobronchial)
10819                                          !< region of the lung. Depends on the particle size
10820    REAL(wp) ::  mean_d                   !< Particle diameter in micrometres
10821    REAL(wp) ::  temp_bin                 !< temporary array for calculating output variables
10822
10823    REAL(wp), DIMENSION(nxl:nxr,nys:nyn,nzb_do:nzt_do) ::  local_pf  !< output
10824!
10825!-- Next statement is to avoid compiler warning about unused variable. May be removed in future.
10826    IF ( two_d )  CONTINUE
10827
10828    found = .TRUE.
10829    temp_bin  = 0.0_wp
10830
10831    IF ( variable(7:11)  == 'N_bin' )  THEN
10832
10833       READ( variable( 12:LEN( TRIM( variable ) ) - 3 ), * ) char_to_int
10834       IF ( char_to_int >= 1  .AND. char_to_int <= SUM( nbin ) )  THEN
10835
10836          ib = char_to_int
10837          IF ( av == 0 )  THEN
10838             DO  i = nxl, nxr
10839                DO  j = nys, nyn
10840                   DO  k = nzb_do, nzt_do
10841                      local_pf(i,j,k) = MERGE( aerosol_number(ib)%conc(k,j,i), REAL( fill_value,   &
10842                                               KIND = wp ), BTEST( wall_flags_total_0(k,j,i), 0 ) )
10843                   ENDDO
10844                ENDDO
10845             ENDDO
10846          ELSE
10847             IF ( .NOT. ALLOCATED( nbins_av ) )  THEN
10848                ALLOCATE( nbins_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg,nbins_aerosol) )
10849                nbins_av = REAL( fill_value, KIND = wp )
10850             ENDIF
10851             DO  i = nxl, nxr
10852                DO  j = nys, nyn
10853                   DO  k = nzb_do, nzt_do
10854                      local_pf(i,j,k) = MERGE( nbins_av(k,j,i,ib), REAL( fill_value, KIND = wp ),  &
10855                                               BTEST( wall_flags_total_0(k,j,i), 0 ) )
10856                   ENDDO
10857                ENDDO
10858             ENDDO
10859          ENDIF
10860          IF ( mode == 'xy' )  grid = 'zu'
10861       ENDIF
10862
10863    ELSEIF ( variable(7:11)  == 'm_bin' )  THEN
10864
10865       READ( variable( 12:LEN( TRIM( variable ) ) - 3 ), * ) char_to_int
10866       IF ( char_to_int >= 1  .AND. char_to_int <= SUM( nbin ) )  THEN
10867
10868          ib = char_to_int
10869          IF ( av == 0 )  THEN
10870             DO  i = nxl, nxr
10871                DO  j = nys, nyn
10872                   DO  k = nzb_do, nzt_do
10873                      temp_bin = 0.0_wp
10874                      DO  ic = ib, ncomponents_mass * nbins_aerosol, nbins_aerosol
10875                         temp_bin = temp_bin + aerosol_mass(ic)%conc(k,j,i)
10876                      ENDDO
10877                      local_pf(i,j,k) = MERGE( temp_bin, REAL( fill_value, KIND = wp ),            &
10878                                               BTEST( wall_flags_total_0(k,j,i), 0 ) )
10879                   ENDDO
10880                ENDDO
10881             ENDDO
10882          ELSE
10883             IF ( .NOT. ALLOCATED( mbins_av ) )  THEN
10884                ALLOCATE( mbins_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg,nbins_aerosol) )
10885                mbins_av = REAL( fill_value, KIND = wp )
10886             ENDIF
10887             DO  i = nxl, nxr
10888                DO  j = nys, nyn
10889                   DO  k = nzb_do, nzt_do
10890                      local_pf(i,j,k) = MERGE( mbins_av(k,j,i,ib), REAL( fill_value, KIND = wp ),  &
10891                                               BTEST( wall_flags_total_0(k,j,i), 0 ) )
10892                   ENDDO
10893                ENDDO
10894             ENDDO
10895          ENDIF
10896          IF ( mode == 'xy' )  grid = 'zu'
10897       ENDIF
10898
10899    ELSE
10900
10901       SELECT CASE ( TRIM( variable( 7:LEN( TRIM( variable ) ) - 3 ) ) )  ! cut out _xy, _xz or _yz
10902
10903          CASE ( 'g_H2SO4', 'g_HNO3', 'g_NH3', 'g_OCNV', 'g_OCSV' )
10904             vari = TRIM( variable( 9:LEN( TRIM( variable ) ) - 3 ) )  ! 9: remove salsa_g_
10905             IF ( vari == 'H2SO4')  found_index = 1
10906             IF ( vari == 'HNO3')   found_index = 2
10907             IF ( vari == 'NH3')    found_index = 3
10908             IF ( vari == 'OCNV')   found_index = 4
10909             IF ( vari == 'OCSV')   found_index = 5
10910             IF ( av == 0 )  THEN
10911                DO  i = nxl, nxr
10912                   DO  j = nys, nyn
10913                      DO  k = nzb_do, nzt_do
10914                         local_pf(i,j,k) = MERGE( salsa_gas(found_index)%conc(k,j,i),              &
10915                                                  REAL( fill_value,  KIND = wp ),                  &
10916                                                  BTEST( wall_flags_total_0(k,j,i), 0 ) )
10917                      ENDDO
10918                   ENDDO
10919                ENDDO
10920             ELSE
10921                IF ( .NOT. ALLOCATED( salsa_gases_av ) )  THEN
10922                   ALLOCATE( salsa_gases_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg,ngases_salsa) )
10923                   salsa_gases_av = REAL( fill_value, KIND = wp )
10924                ENDIF
10925                DO  i = nxl, nxr
10926                   DO  j = nys, nyn
10927                      DO  k = nzb_do, nzt_do
10928                         local_pf(i,j,k) = MERGE( salsa_gases_av(k,j,i,found_index),               &
10929                                                  REAL( fill_value, KIND = wp ),                   &
10930                                                  BTEST( wall_flags_total_0(k,j,i), 0 ) )
10931                      ENDDO
10932                   ENDDO
10933                ENDDO
10934             ENDIF
10935
10936             IF ( mode == 'xy' )  grid = 'zu'
10937
10938          CASE ( 'LDSA' )
10939             IF ( av == 0 )  THEN
10940                DO  i = nxl, nxr
10941                   DO  j = nys, nyn
10942                      DO  k = nzb_do, nzt_do
10943                         temp_bin = 0.0_wp
10944                         DO  ib = 1, nbins_aerosol
10945!
10946!--                         Diameter in micrometres
10947                            mean_d = 1.0E+6_wp * ra_dry(k,j,i,ib) * 2.0_wp 
10948!
10949!--                         Deposition factor: alveolar
10950                            df = ( 0.01555_wp / mean_d ) * ( EXP( -0.416_wp * ( LOG( mean_d ) +    &
10951                                   2.84_wp )**2 ) + 19.11_wp * EXP( -0.482_wp * ( LOG( mean_d ) -  &
10952                                   1.362_wp )**2 ) )
10953!
10954!--                         Lung-deposited surface area LDSA (units mum2/cm3)
10955                            temp_bin = temp_bin + pi * mean_d**2 * df * 1.0E-6_wp *                &
10956                                       aerosol_number(ib)%conc(k,j,i)
10957                         ENDDO
10958
10959                         local_pf(i,j,k) = MERGE( temp_bin, REAL( fill_value, KIND = wp ),         &
10960                                                  BTEST( wall_flags_total_0(k,j,i), 0 ) )
10961                      ENDDO
10962                   ENDDO
10963                ENDDO
10964             ELSE
10965                IF ( .NOT. ALLOCATED( ldsa_av ) )  THEN
10966                   ALLOCATE( ldsa_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
10967                   ldsa_av = REAL( fill_value, KIND = wp )
10968                ENDIF
10969                DO  i = nxl, nxr
10970                   DO  j = nys, nyn
10971                      DO  k = nzb_do, nzt_do
10972                         local_pf(i,j,k) = MERGE( ldsa_av(k,j,i), REAL( fill_value, KIND = wp ),   &
10973                                                  BTEST( wall_flags_total_0(k,j,i), 0 ) )
10974                      ENDDO
10975                   ENDDO
10976                ENDDO
10977             ENDIF
10978
10979             IF ( mode == 'xy' )  grid = 'zu'
10980
10981          CASE ( 'N_UFP' )
10982
10983             IF ( av == 0 )  THEN
10984                DO  i = nxl, nxr
10985                   DO  j = nys, nyn
10986                      DO  k = nzb_do, nzt_do
10987                         temp_bin = 0.0_wp
10988                         DO  ib = 1, nbins_aerosol
10989                            IF ( 2.0_wp * ra_dry(k,j,i,ib) <= 0.1E-6_wp )  THEN
10990                               temp_bin = temp_bin + aerosol_number(ib)%conc(k,j,i)
10991                            ENDIF
10992                         ENDDO
10993                         local_pf(i,j,k) = MERGE( temp_bin, REAL( fill_value, KIND = wp ),         &
10994                                                  BTEST( wall_flags_total_0(k,j,i), 0 ) )
10995                      ENDDO
10996                   ENDDO
10997                ENDDO
10998             ELSE
10999                IF ( .NOT. ALLOCATED( nufp_av ) )  THEN
11000                   ALLOCATE( nufp_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
11001                   nufp_av = REAL( fill_value, KIND = wp )
11002                ENDIF
11003                DO  i = nxl, nxr
11004                   DO  j = nys, nyn
11005                      DO  k = nzb_do, nzt_do
11006                         local_pf(i,j,k) = MERGE( nufp_av(k,j,i), REAL( fill_value, KIND = wp ),   &
11007                                                  BTEST( wall_flags_total_0(k,j,i), 0 ) )
11008                      ENDDO
11009                   ENDDO
11010                ENDDO
11011             ENDIF
11012
11013             IF ( mode == 'xy' )  grid = 'zu'
11014
11015          CASE ( 'Ntot' )
11016
11017             IF ( av == 0 )  THEN
11018                DO  i = nxl, nxr
11019                   DO  j = nys, nyn
11020                      DO  k = nzb_do, nzt_do
11021                         temp_bin = 0.0_wp
11022                         DO  ib = 1, nbins_aerosol
11023                            temp_bin = temp_bin + aerosol_number(ib)%conc(k,j,i)
11024                         ENDDO
11025                         local_pf(i,j,k) = MERGE( temp_bin, REAL( fill_value, KIND = wp ),         &
11026                                                  BTEST( wall_flags_total_0(k,j,i), 0 ) )
11027                      ENDDO
11028                   ENDDO
11029                ENDDO
11030             ELSE
11031                IF ( .NOT. ALLOCATED( ntot_av ) )  THEN
11032                   ALLOCATE( ntot_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
11033                   ntot_av = REAL( fill_value, KIND = wp )
11034                ENDIF
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_total_0(k,j,i), 0 ) )
11040                      ENDDO
11041                   ENDDO
11042                ENDDO
11043             ENDIF
11044
11045             IF ( mode == 'xy' )  grid = 'zu'
11046
11047          CASE ( 'PM0.1' )
11048             IF ( av == 0 )  THEN
11049                DO  i = nxl, nxr
11050                   DO  j = nys, nyn
11051                      DO  k = nzb_do, nzt_do
11052                         temp_bin = 0.0_wp
11053                         DO  ib = 1, nbins_aerosol
11054                            IF ( 2.0_wp * ra_dry(k,j,i,ib) <= 0.1E-6_wp )  THEN
11055                               DO  ic = ib, nbins_aerosol * ncc, nbins_aerosol
11056                                  temp_bin = temp_bin + aerosol_mass(ic)%conc(k,j,i)
11057                               ENDDO
11058                            ENDIF
11059                         ENDDO
11060                         local_pf(i,j,k) = MERGE( temp_bin, REAL( fill_value, KIND = wp ),         &
11061                                                  BTEST( wall_flags_total_0(k,j,i), 0 ) )
11062                      ENDDO
11063                   ENDDO
11064                ENDDO
11065             ELSE
11066                IF ( .NOT. ALLOCATED( pm01_av ) )  THEN
11067                   ALLOCATE( pm01_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
11068                   pm01_av = REAL( fill_value, KIND = wp )
11069                ENDIF
11070                DO  i = nxl, nxr
11071                   DO  j = nys, nyn
11072                      DO  k = nzb_do, nzt_do
11073                         local_pf(i,j,k) = MERGE( pm01_av(k,j,i), REAL( fill_value, KIND = wp ),   &
11074                                                  BTEST( wall_flags_total_0(k,j,i), 0 ) )
11075                      ENDDO
11076                   ENDDO
11077                ENDDO
11078             ENDIF
11079
11080             IF ( mode == 'xy' )  grid = 'zu'
11081
11082          CASE ( 'PM2.5' )
11083             IF ( av == 0 )  THEN
11084                DO  i = nxl, nxr
11085                   DO  j = nys, nyn
11086                      DO  k = nzb_do, nzt_do
11087                         temp_bin = 0.0_wp
11088                         DO  ib = 1, nbins_aerosol
11089                            IF ( 2.0_wp * ra_dry(k,j,i,ib) <= 2.5E-6_wp )  THEN
11090                               DO  ic = ib, nbins_aerosol * ncc, nbins_aerosol
11091                                  temp_bin = temp_bin + aerosol_mass(ic)%conc(k,j,i)
11092                               ENDDO
11093                            ENDIF
11094                         ENDDO
11095                         local_pf(i,j,k) = MERGE( temp_bin, REAL( fill_value, KIND = wp ),         &
11096                                                  BTEST( wall_flags_total_0(k,j,i), 0 ) )
11097                      ENDDO
11098                   ENDDO
11099                ENDDO
11100             ELSE
11101                IF ( .NOT. ALLOCATED( pm25_av ) )  THEN
11102                   ALLOCATE( pm25_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
11103                   pm25_av = REAL( fill_value, KIND = wp )
11104                ENDIF
11105                DO  i = nxl, nxr
11106                   DO  j = nys, nyn
11107                      DO  k = nzb_do, nzt_do
11108                         local_pf(i,j,k) = MERGE( pm25_av(k,j,i), REAL( fill_value, KIND = wp ),   &
11109                                                  BTEST( wall_flags_total_0(k,j,i), 0 ) )
11110                      ENDDO
11111                   ENDDO
11112                ENDDO
11113             ENDIF
11114
11115             IF ( mode == 'xy' )  grid = 'zu'
11116
11117          CASE ( 'PM10' )
11118             IF ( av == 0 )  THEN
11119                DO  i = nxl, nxr
11120                   DO  j = nys, nyn
11121                      DO  k = nzb_do, nzt_do
11122                         temp_bin = 0.0_wp
11123                         DO  ib = 1, nbins_aerosol
11124                            IF ( 2.0_wp * ra_dry(k,j,i,ib) <= 10.0E-6_wp )  THEN
11125                               DO  ic = ib, nbins_aerosol * ncc, nbins_aerosol
11126                                  temp_bin = temp_bin + aerosol_mass(ic)%conc(k,j,i)
11127                               ENDDO
11128                            ENDIF
11129                         ENDDO
11130                         local_pf(i,j,k) = MERGE( temp_bin,  REAL( fill_value, KIND = wp ),        &
11131                                                  BTEST( wall_flags_total_0(k,j,i), 0 ) )
11132                      ENDDO
11133                   ENDDO
11134                ENDDO
11135             ELSE
11136                IF ( .NOT. ALLOCATED( pm10_av ) )  THEN
11137                   ALLOCATE( pm10_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
11138                   pm10_av = REAL( fill_value, KIND = wp )
11139                ENDIF
11140                DO  i = nxl, nxr
11141                   DO  j = nys, nyn
11142                      DO  k = nzb_do, nzt_do
11143                         local_pf(i,j,k) = MERGE( pm10_av(k,j,i), REAL( fill_value, KIND = wp ),   &
11144                                                  BTEST( wall_flags_total_0(k,j,i), 0 ) )
11145                      ENDDO
11146                   ENDDO
11147                ENDDO
11148             ENDIF
11149
11150             IF ( mode == 'xy' )  grid = 'zu'
11151
11152          CASE ( 's_BC', 's_DU', 's_NH', 's_NO', 's_OC', 's_SO4', 's_SS' )
11153             vari = TRIM( variable( 9:LEN( TRIM( variable ) ) - 3 ) )  ! 9: remove salsa_s_
11154             IF ( is_used( prtcl, vari ) )  THEN
11155                found_index = get_index( prtcl, vari )
11156                IF ( av == 0 )  THEN
11157                   DO  i = nxl, nxr
11158                      DO  j = nys, nyn
11159                         DO  k = nzb_do, nzt_do
11160                            temp_bin = 0.0_wp
11161                            DO  ic = ( found_index-1 ) * nbins_aerosol+1, found_index * nbins_aerosol
11162                               temp_bin = temp_bin + aerosol_mass(ic)%conc(k,j,i)
11163                            ENDDO
11164                            local_pf(i,j,k) = MERGE( temp_bin, REAL( fill_value, KIND = wp ),      &
11165                                                     BTEST( wall_flags_total_0(k,j,i), 0 ) )
11166                         ENDDO
11167                      ENDDO
11168                   ENDDO
11169                ELSE
11170                   IF ( .NOT. ALLOCATED( s_mass_av ) )  THEN
11171                      ALLOCATE( s_mass_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg,ncomponents_mass) )
11172                      s_mass_av = REAL( fill_value, KIND = wp )
11173                   ENDIF
11174                   DO  i = nxl, nxr
11175                      DO  j = nys, nyn
11176                         DO  k = nzb_do, nzt_do
11177                            local_pf(i,j,k) = MERGE( s_mass_av(k,j,i,found_index),                 &
11178                                                     REAL( fill_value, KIND = wp ),                &
11179                                                     BTEST( wall_flags_total_0(k,j,i), 0 ) )
11180                         ENDDO
11181                      ENDDO
11182                   ENDDO
11183                ENDIF
11184             ELSE
11185                local_pf = fill_value
11186             ENDIF
11187
11188             IF ( mode == 'xy' )  grid = 'zu'
11189
11190          CASE ( 's_H2O' )
11191             found_index = get_index( prtcl, 'H2O' )
11192             IF ( av == 0 )  THEN
11193                DO  i = nxl, nxr
11194                   DO  j = nys, nyn
11195                      DO  k = nzb_do, nzt_do
11196                         temp_bin = 0.0_wp
11197                         DO  ic = ( found_index-1 ) * nbins_aerosol+1, found_index * nbins_aerosol
11198                            temp_bin = temp_bin + aerosol_mass(ic)%conc(k,j,i)
11199                         ENDDO
11200                         local_pf(i,j,k) = MERGE( temp_bin, REAL( fill_value, KIND = wp ),         &
11201                                                  BTEST( wall_flags_total_0(k,j,i), 0 ) )
11202                      ENDDO
11203                   ENDDO
11204                ENDDO
11205             ELSE
11206     !           to_be_resorted => s_h2o_av
11207                IF ( .NOT. ALLOCATED( s_h2o_av ) )  THEN
11208                   ALLOCATE( s_h2o_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
11209                   s_h2o_av = REAL( fill_value, KIND = wp )
11210                ENDIF
11211                DO  i = nxl, nxr
11212                   DO  j = nys, nyn
11213                      DO  k = nzb_do, nzt_do
11214                         local_pf(i,j,k) = MERGE( s_h2o_av(k,j,i), REAL( fill_value, KIND = wp ),  &
11215                                                  BTEST( wall_flags_total_0(k,j,i), 0 ) )
11216                      ENDDO
11217                   ENDDO
11218                ENDDO
11219             ENDIF
11220
11221             IF ( mode == 'xy' )  grid = 'zu'
11222
11223          CASE DEFAULT
11224             found = .FALSE.
11225             grid  = 'none'
11226
11227       END SELECT
11228
11229    ENDIF
11230
11231 END SUBROUTINE salsa_data_output_2d
11232
11233!------------------------------------------------------------------------------!
11234!
11235! Description:
11236! ------------
11237!> Subroutine defining 3D output variables
11238!------------------------------------------------------------------------------!
11239 SUBROUTINE salsa_data_output_3d( av, variable, found, local_pf, nzb_do, nzt_do )
11240
11241    USE indices
11242
11243    USE kinds
11244
11245
11246    IMPLICIT NONE
11247
11248    CHARACTER(LEN=*), INTENT(in) ::  variable   !<
11249
11250    INTEGER(iwp) ::  av           !<
11251    INTEGER(iwp) ::  char_to_int  !< for converting character to integer
11252    INTEGER(iwp) ::  found_index  !< index of a chemical compound
11253    INTEGER(iwp) ::  ib           !< running index: size bins
11254    INTEGER(iwp) ::  ic           !< running index: mass bins
11255    INTEGER(iwp) ::  i            !<
11256    INTEGER(iwp) ::  j            !<
11257    INTEGER(iwp) ::  k            !<
11258    INTEGER(iwp) ::  nzb_do       !<
11259    INTEGER(iwp) ::  nzt_do       !<
11260
11261    LOGICAL ::  found      !<
11262
11263    REAL(wp) ::  df                       !< For calculating LDSA: fraction of particles
11264                                          !< depositing in the alveolar (or tracheobronchial)
11265                                          !< region of the lung. Depends on the particle size
11266    REAL(wp) ::  mean_d                   !< Particle diameter in micrometres
11267    REAL(wp) ::  temp_bin                 !< temporary array for calculating output variables
11268
11269    REAL(sp), DIMENSION(nxl:nxr,nys:nyn,nzb_do:nzt_do) ::  local_pf  !< local
11270
11271    found     = .TRUE.
11272    temp_bin  = 0.0_wp
11273
11274    IF ( variable(7:11) == 'N_bin' )  THEN
11275       READ( variable(12:),* ) char_to_int
11276       IF ( char_to_int >= 1  .AND. char_to_int <= SUM( nbin ) )  THEN
11277
11278          ib = char_to_int
11279          IF ( av == 0 )  THEN
11280             DO  i = nxl, nxr
11281                DO  j = nys, nyn
11282                   DO  k = nzb_do, nzt_do
11283                      local_pf(i,j,k) = MERGE( aerosol_number(ib)%conc(k,j,i), REAL( fill_value,   &
11284                                               KIND = wp ), BTEST( wall_flags_total_0(k,j,i), 0 ) )
11285                   ENDDO
11286                ENDDO
11287             ENDDO
11288          ELSE
11289             IF ( .NOT. ALLOCATED( nbins_av ) )  THEN
11290                ALLOCATE( nbins_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg,nbins_aerosol) )
11291                nbins_av = REAL( fill_value, KIND = wp )
11292             ENDIF
11293             DO  i = nxl, nxr
11294                DO  j = nys, nyn
11295                   DO  k = nzb_do, nzt_do
11296                      local_pf(i,j,k) = MERGE( nbins_av(k,j,i,ib), REAL( fill_value, KIND = wp ),  &
11297                                               BTEST( wall_flags_total_0(k,j,i), 0 ) ) 
11298                   ENDDO
11299                ENDDO
11300             ENDDO
11301          ENDIF
11302       ENDIF
11303
11304    ELSEIF ( variable(7:11) == 'm_bin' )  THEN
11305       READ( variable(12:),* ) char_to_int
11306       IF ( char_to_int >= 1  .AND. char_to_int <= SUM( nbin ) )  THEN
11307
11308          ib = char_to_int
11309          IF ( av == 0 )  THEN
11310             DO  i = nxl, nxr
11311                DO  j = nys, nyn
11312                   DO  k = nzb_do, nzt_do
11313                      temp_bin = 0.0_wp
11314                      DO  ic = ib, ncomponents_mass * nbins_aerosol, nbins_aerosol
11315                         temp_bin = temp_bin + aerosol_mass(ic)%conc(k,j,i)
11316                      ENDDO
11317                      local_pf(i,j,k) = MERGE( temp_bin, REAL( fill_value, KIND = wp ),            &
11318                                               BTEST( wall_flags_total_0(k,j,i), 0 ) )
11319                   ENDDO
11320                ENDDO
11321             ENDDO
11322          ELSE
11323             IF ( .NOT. ALLOCATED( mbins_av ) )  THEN
11324                ALLOCATE( mbins_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg,nbins_aerosol) )
11325                mbins_av = REAL( fill_value, KIND = wp )
11326             ENDIF
11327             DO  i = nxl, nxr
11328                DO  j = nys, nyn
11329                   DO  k = nzb_do, nzt_do
11330                      local_pf(i,j,k) = MERGE( mbins_av(k,j,i,ib), REAL( fill_value, KIND = wp ),  &
11331                                               BTEST( wall_flags_total_0(k,j,i), 0 ) ) 
11332                   ENDDO
11333                ENDDO
11334             ENDDO
11335          ENDIF
11336       ENDIF
11337
11338    ELSE
11339       SELECT CASE ( TRIM( variable(7:) ) )
11340
11341          CASE ( 'g_H2SO4', 'g_HNO3', 'g_NH3', 'g_OCNV',  'g_OCSV' )
11342             IF ( TRIM( variable(7:) ) == 'g_H2SO4')  found_index = 1
11343             IF ( TRIM( variable(7:) ) == 'g_HNO3')   found_index = 2
11344             IF ( TRIM( variable(7:) ) == 'g_NH3')    found_index = 3
11345             IF ( TRIM( variable(7:) ) == 'g_OCNV')   found_index = 4
11346             IF ( TRIM( variable(7:) ) == 'g_OCSV')   found_index = 5
11347
11348             IF ( av == 0 )  THEN
11349                DO  i = nxl, nxr
11350                   DO  j = nys, nyn
11351                      DO  k = nzb_do, nzt_do
11352                         local_pf(i,j,k) = MERGE( salsa_gas(found_index)%conc(k,j,i),              &
11353                                                  REAL( fill_value, KIND = wp ),                   &
11354                                                  BTEST( wall_flags_total_0(k,j,i), 0 ) )
11355                      ENDDO
11356                   ENDDO
11357                ENDDO
11358             ELSE
11359                IF ( .NOT. ALLOCATED( salsa_gases_av ) )  THEN
11360                   ALLOCATE( salsa_gases_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg,ngases_salsa) )
11361                   salsa_gases_av = REAL( fill_value, KIND = wp )
11362                ENDIF
11363                DO  i = nxl, nxr
11364                   DO  j = nys, nyn
11365                      DO  k = nzb_do, nzt_do
11366!                          local_pf(i,j,k) = MERGE( to_be_resorted(k,j,i), REAL( fill_value,         &
11367!                                                KIND = wp ), BTEST( wall_flags_total_0(k,j,i), 0 ) )
11368                         local_pf(i,j,k) = MERGE( salsa_gases_av(k,j,i,found_index),               &
11369                                                  REAL( fill_value, KIND = wp ),                   &
11370                                                  BTEST( wall_flags_total_0(k,j,i), 0 ) )
11371                      ENDDO
11372                   ENDDO
11373                ENDDO
11374             ENDIF
11375
11376          CASE ( 'LDSA' )
11377             IF ( av == 0 )  THEN
11378                DO  i = nxl, nxr
11379                   DO  j = nys, nyn
11380                      DO  k = nzb_do, nzt_do
11381                         temp_bin = 0.0_wp
11382                         DO  ib = 1, nbins_aerosol
11383!
11384!--                         Diameter in micrometres
11385                            mean_d = 1.0E+6_wp * ra_dry(k,j,i,ib) * 2.0_wp
11386!
11387!--                         Deposition factor: alveolar
11388                            df = ( 0.01555_wp / mean_d ) * ( EXP( -0.416_wp * ( LOG( mean_d ) +    &
11389                                   2.84_wp )**2 ) + 19.11_wp * EXP( -0.482_wp * ( LOG( mean_d ) -  &
11390                                   1.362_wp )**2 ) )
11391!
11392!--                         Lung-deposited surface area LDSA (units mum2/cm3)
11393                            temp_bin = temp_bin + pi * mean_d**2 * df * 1.0E-6_wp *                &
11394                                       aerosol_number(ib)%conc(k,j,i)
11395                         ENDDO
11396                         local_pf(i,j,k) = MERGE( temp_bin, REAL( fill_value, KIND = wp ),         &
11397                                                  BTEST( wall_flags_total_0(k,j,i), 0 ) )
11398                      ENDDO
11399                   ENDDO
11400                ENDDO
11401             ELSE
11402                IF ( .NOT. ALLOCATED( ldsa_av ) )  THEN
11403                   ALLOCATE( ldsa_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
11404                   ldsa_av = REAL( fill_value, KIND = wp )
11405                ENDIF
11406                DO  i = nxl, nxr
11407                   DO  j = nys, nyn
11408                      DO  k = nzb_do, nzt_do
11409                         local_pf(i,j,k) = MERGE( ldsa_av(k,j,i), REAL( fill_value, KIND = wp ),   &
11410                                                  BTEST( wall_flags_total_0(k,j,i), 0 ) ) 
11411                      ENDDO
11412                   ENDDO
11413                ENDDO
11414             ENDIF
11415
11416          CASE ( 'N_UFP' )
11417             IF ( av == 0 )  THEN
11418                DO  i = nxl, nxr
11419                   DO  j = nys, nyn
11420                      DO  k = nzb_do, nzt_do
11421                         temp_bin = 0.0_wp
11422                         DO  ib = 1, nbins_aerosol
11423                            IF ( 2.0_wp * ra_dry(k,j,i,ib) <= 0.1E-6_wp )  THEN
11424                               temp_bin = temp_bin + aerosol_number(ib)%conc(k,j,i)
11425                            ENDIF
11426                         ENDDO
11427                         local_pf(i,j,k) = MERGE( temp_bin, REAL( fill_value, KIND = wp ),         &
11428                                                  BTEST( wall_flags_total_0(k,j,i), 0 ) )
11429                      ENDDO
11430                   ENDDO
11431                ENDDO
11432             ELSE
11433                IF ( .NOT. ALLOCATED( nufp_av ) )  THEN
11434                   ALLOCATE( nufp_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
11435                   nufp_av = REAL( fill_value, KIND = wp )
11436                ENDIF
11437                DO  i = nxl, nxr
11438                   DO  j = nys, nyn
11439                      DO  k = nzb_do, nzt_do
11440                         local_pf(i,j,k) = MERGE( nufp_av(k,j,i), REAL( fill_value, KIND = wp ),   &
11441                                                  BTEST( wall_flags_total_0(k,j,i), 0 ) ) 
11442                      ENDDO
11443                   ENDDO
11444                ENDDO
11445             ENDIF
11446
11447          CASE ( 'Ntot' )
11448             IF ( av == 0 )  THEN
11449                DO  i = nxl, nxr
11450                   DO  j = nys, nyn
11451                      DO  k = nzb_do, nzt_do
11452                         temp_bin = 0.0_wp
11453                         DO  ib = 1, nbins_aerosol
11454                            temp_bin = temp_bin + aerosol_number(ib)%conc(k,j,i)
11455                         ENDDO
11456                         local_pf(i,j,k) = MERGE( temp_bin, REAL( fill_value, KIND = wp ),         &
11457                                                  BTEST( wall_flags_total_0(k,j,i), 0 ) )
11458                      ENDDO
11459                   ENDDO
11460                ENDDO
11461             ELSE
11462                IF ( .NOT. ALLOCATED( ntot_av ) )  THEN
11463                   ALLOCATE( ntot_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
11464                   ntot_av = REAL( fill_value, KIND = wp )
11465                ENDIF
11466                DO  i = nxl, nxr
11467                   DO  j = nys, nyn
11468                      DO  k = nzb_do, nzt_do
11469                         local_pf(i,j,k) = MERGE( ntot_av(k,j,i), REAL( fill_value, KIND = wp ),   &
11470                                                  BTEST( wall_flags_total_0(k,j,i), 0 ) ) 
11471                      ENDDO
11472                   ENDDO
11473                ENDDO
11474             ENDIF
11475
11476          CASE ( 'PM0.1' )
11477             IF ( av == 0 )  THEN
11478                DO  i = nxl, nxr
11479                   DO  j = nys, nyn
11480                      DO  k = nzb_do, nzt_do
11481                         temp_bin = 0.0_wp
11482                         DO  ib = 1, nbins_aerosol
11483                            IF ( 2.0_wp * ra_dry(k,j,i,ib) <= 0.1E-6_wp )  THEN
11484                               DO  ic = ib, nbins_aerosol * ncc, nbins_aerosol
11485                                  temp_bin = temp_bin + aerosol_mass(ic)%conc(k,j,i)
11486                               ENDDO
11487                            ENDIF
11488                         ENDDO
11489                         local_pf(i,j,k) = MERGE( temp_bin, REAL( fill_value, KIND = wp ),         &
11490                                                  BTEST( wall_flags_total_0(k,j,i), 0 ) ) 
11491                      ENDDO
11492                   ENDDO
11493                ENDDO
11494             ELSE
11495                IF ( .NOT. ALLOCATED( pm01_av ) )  THEN
11496                   ALLOCATE( pm01_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
11497                   pm01_av = REAL( fill_value, KIND = wp )
11498                ENDIF
11499                DO  i = nxl, nxr
11500                   DO  j = nys, nyn
11501                      DO  k = nzb_do, nzt_do
11502                         local_pf(i,j,k) = MERGE( pm01_av(k,j,i), REAL( fill_value, KIND = wp ),   &
11503                                                  BTEST( wall_flags_total_0(k,j,i), 0 ) ) 
11504                      ENDDO
11505                   ENDDO
11506                ENDDO
11507             ENDIF
11508
11509          CASE ( 'PM2.5' )
11510             IF ( av == 0 )  THEN
11511                DO  i = nxl, nxr
11512                   DO  j = nys, nyn
11513                      DO  k = nzb_do, nzt_do
11514                         temp_bin = 0.0_wp
11515                         DO  ib = 1, nbins_aerosol
11516                            IF ( 2.0_wp * ra_dry(k,j,i,ib) <= 2.5E-6_wp )  THEN
11517                               DO  ic = ib, nbins_aerosol * ncc, nbins_aerosol
11518                                  temp_bin = temp_bin + aerosol_mass(ic)%conc(k,j,i)
11519                               ENDDO
11520                            ENDIF
11521                         ENDDO
11522                         local_pf(i,j,k) = MERGE( temp_bin, REAL( fill_value, KIND = wp ),         &
11523                                                  BTEST( wall_flags_total_0(k,j,i), 0 ) ) 
11524                      ENDDO
11525                   ENDDO
11526                ENDDO
11527             ELSE
11528                IF ( .NOT. ALLOCATED( pm25_av ) )  THEN
11529                   ALLOCATE( pm25_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
11530                   pm25_av = REAL( fill_value, KIND = wp )
11531                ENDIF
11532                DO  i = nxl, nxr
11533                   DO  j = nys, nyn
11534                      DO  k = nzb_do, nzt_do
11535                         local_pf(i,j,k) = MERGE( pm25_av(k,j,i), REAL( fill_value, KIND = wp ),   &
11536                                                  BTEST( wall_flags_total_0(k,j,i), 0 ) ) 
11537                      ENDDO
11538                   ENDDO
11539                ENDDO
11540             ENDIF
11541
11542          CASE ( 'PM10' )
11543             IF ( av == 0 )  THEN
11544                DO  i = nxl, nxr
11545                   DO  j = nys, nyn
11546                      DO  k = nzb_do, nzt_do
11547                         temp_bin = 0.0_wp
11548                         DO  ib = 1, nbins_aerosol
11549                            IF ( 2.0_wp * ra_dry(k,j,i,ib) <= 10.0E-6_wp )  THEN
11550                               DO  ic = ib, nbins_aerosol * ncc, nbins_aerosol
11551                                  temp_bin = temp_bin + aerosol_mass(ic)%conc(k,j,i)
11552                               ENDDO
11553                            ENDIF
11554                         ENDDO
11555                         local_pf(i,j,k) = MERGE( temp_bin, REAL( fill_value, KIND = wp ),         &
11556                                                  BTEST( wall_flags_total_0(k,j,i), 0 ) ) 
11557                      ENDDO
11558                   ENDDO
11559                ENDDO
11560             ELSE
11561                IF ( .NOT. ALLOCATED( pm10_av ) )  THEN
11562                   ALLOCATE( pm10_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
11563                   pm10_av = REAL( fill_value, KIND = wp )
11564                ENDIF
11565                DO  i = nxl, nxr
11566                   DO  j = nys, nyn
11567                      DO  k = nzb_do, nzt_do
11568                         local_pf(i,j,k) = MERGE( pm10_av(k,j,i), REAL( fill_value, KIND = wp ),   &
11569                                                  BTEST( wall_flags_total_0(k,j,i), 0 ) )
11570                      ENDDO
11571                   ENDDO
11572                ENDDO
11573             ENDIF
11574
11575          CASE ( 's_BC', 's_DU', 's_NH', 's_NO', 's_OC', 's_SO4', 's_SS' )
11576             IF ( is_used( prtcl, TRIM( variable(9:) ) ) )  THEN  ! 9: remove salsa_s_
11577                found_index = get_index( prtcl, TRIM( variable(9:) ) )
11578                IF ( av == 0 )  THEN
11579                   DO  i = nxl, nxr
11580                      DO  j = nys, nyn
11581                         DO  k = nzb_do, nzt_do
11582                            temp_bin = 0.0_wp
11583                            DO  ic = ( found_index-1 ) * nbins_aerosol + 1, found_index * nbins_aerosol
11584                               temp_bin = temp_bin + aerosol_mass(ic)%conc(k,j,i)
11585                            ENDDO
11586                            local_pf(i,j,k) = MERGE( temp_bin, REAL( fill_value, KIND = wp ),      &
11587                                                     BTEST( wall_flags_total_0(k,j,i), 0 ) ) 
11588                         ENDDO
11589                      ENDDO
11590                   ENDDO
11591                ELSE
11592                   IF ( .NOT. ALLOCATED( s_mass_av ) )  THEN
11593                      ALLOCATE( s_mass_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg,ncomponents_mass) )
11594                      s_mass_av = REAL( fill_value, KIND = wp )
11595                   ENDIF
11596                   DO  i = nxl, nxr
11597                      DO  j = nys, nyn
11598                         DO  k = nzb_do, nzt_do
11599                            local_pf(i,j,k) = MERGE( s_mass_av(k,j,i,found_index),                 &
11600                                                     REAL( fill_value, KIND = wp ),                &
11601                                                     BTEST( wall_flags_total_0(k,j,i), 0 ) )
11602                         ENDDO
11603                      ENDDO
11604                   ENDDO
11605                ENDIF
11606             ENDIF
11607
11608          CASE ( 's_H2O' )
11609             found_index = get_index( prtcl, 'H2O' )
11610             IF ( av == 0 )  THEN
11611                DO  i = nxl, nxr
11612                   DO  j = nys, nyn
11613                      DO  k = nzb_do, nzt_do
11614                         temp_bin = 0.0_wp
11615                         DO  ic = ( found_index-1 ) * nbins_aerosol + 1, found_index * nbins_aerosol
11616                            temp_bin = temp_bin + aerosol_mass(ic)%conc(k,j,i)
11617                         ENDDO
11618                         local_pf(i,j,k) = MERGE( temp_bin, REAL( fill_value, KIND = wp ),         &
11619                                                  BTEST( wall_flags_total_0(k,j,i), 0 ) ) 
11620                      ENDDO
11621                   ENDDO
11622                ENDDO
11623             ELSE
11624                IF ( .NOT. ALLOCATED( s_h2o_av ) )  THEN
11625                   ALLOCATE( s_h2o_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
11626                   s_h2o_av = REAL( fill_value, KIND = wp )
11627                ENDIF
11628                DO  i = nxl, nxr
11629                   DO  j = nys, nyn
11630                      DO  k = nzb_do, nzt_do
11631                         local_pf(i,j,k) = MERGE( s_h2o_av(k,j,i), REAL( fill_value, KIND = wp ),  &
11632                                                  BTEST( wall_flags_total_0(k,j,i), 0 ) )
11633                      ENDDO
11634                   ENDDO
11635                ENDDO
11636             ENDIF
11637
11638          CASE DEFAULT
11639             found = .FALSE.
11640
11641       END SELECT
11642    ENDIF
11643
11644 END SUBROUTINE salsa_data_output_3d
11645
11646!------------------------------------------------------------------------------!
11647!
11648! Description:
11649! ------------
11650!> Subroutine defining mask output variables
11651!------------------------------------------------------------------------------!
11652 SUBROUTINE salsa_data_output_mask( av, variable, found, local_pf, mid )
11653
11654    USE arrays_3d,                                                                                 &
11655        ONLY:  tend
11656
11657    USE control_parameters,                                                                        &
11658        ONLY:  mask_i, mask_j, mask_k, mask_size_l, mask_surface, nz_do3d
11659
11660    IMPLICIT NONE
11661
11662    CHARACTER(LEN=5) ::  grid      !< flag to distinquish between staggered grid
11663    CHARACTER(LEN=*) ::  variable  !<
11664    CHARACTER(LEN=7) ::  vari      !< trimmed format of variable
11665
11666    INTEGER(iwp) ::  av             !<
11667    INTEGER(iwp) ::  char_to_int    !< for converting character to integer
11668    INTEGER(iwp) ::  found_index    !< index of a chemical compound
11669    INTEGER(iwp) ::  ib             !< loop index for aerosol size number bins
11670    INTEGER(iwp) ::  ic             !< loop index for chemical components
11671    INTEGER(iwp) ::  i              !< loop index in x-direction
11672    INTEGER(iwp) ::  j              !< loop index in y-direction
11673    INTEGER(iwp) ::  k              !< loop index in z-direction
11674    INTEGER(iwp) ::  im             !< loop index for masked variables
11675    INTEGER(iwp) ::  jm             !< loop index for masked variables
11676    INTEGER(iwp) ::  kk             !< loop index for masked output in z-direction
11677    INTEGER(iwp) ::  mid            !< masked output running index
11678    INTEGER(iwp) ::  ktt            !< k index of highest terrain surface
11679
11680    LOGICAL ::  found      !<
11681    LOGICAL ::  resorted   !<
11682
11683    REAL(wp) ::  df        !< For calculating LDSA: fraction of particles depositing in the alveolar
11684                           !< (or tracheobronchial) region of the lung. Depends on the particle size
11685    REAL(wp) ::  mean_d    !< Particle diameter in micrometres
11686    REAL(wp) ::  temp_bin  !< temporary array for calculating output variables
11687
11688    REAL(wp), DIMENSION(mask_size_l(mid,1),mask_size_l(mid,2),mask_size_l(mid,3)) ::  local_pf   !<
11689
11690    REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg), TARGET ::  temp_array  !< temporary array
11691
11692    REAL(wp), DIMENSION(:,:,:), POINTER ::  to_be_resorted  !< pointer
11693
11694    found      = .TRUE.
11695    resorted   = .FALSE.
11696    grid       = 's'
11697    tend       = 0.0_wp
11698    temp_array = 0.0_wp
11699    temp_bin   = 0.0_wp
11700
11701    IF ( variable(7:11) == 'N_bin' )  THEN
11702       READ( variable(12:),* ) char_to_int
11703       IF ( char_to_int >= 1  .AND. char_to_int <= SUM( nbin ) )  THEN
11704          ib = char_to_int
11705          IF ( av == 0 )  THEN
11706             IF ( .NOT. mask_surface(mid) )  THEN
11707                DO  i = 1, mask_size_l(mid,1)
11708                   DO  j = 1, mask_size_l(mid,2)
11709                      DO  k = 1, mask_size_l(mid,3)
11710                         local_pf(i,j,k) = aerosol_number(ib)%conc( mask_k(mid,k), mask_j(mid,j),  &
11711                                                                    mask_i(mid,i) )
11712                      ENDDO
11713                   ENDDO
11714                ENDDO
11715             ELSE
11716                DO  i = 1, mask_size_l(mid,1)
11717                   DO  j = 1, mask_size_l(mid,2)
11718!
11719!--                   Get k index of the highest terraing surface
11720                      im = mask_i(mid,i)
11721                      jm = mask_j(mid,j)
11722                      ktt = MINLOC( MERGE( 1, 0, BTEST( wall_flags_total_0(:,jm,im), 5 )), &
11723                                                    DIM = 1 ) - 1
11724                      DO  k = 1, mask_size_l(mid,3)
11725                         kk = MIN( ktt+mask_k(mid,k), nzt+1 )
11726!
11727!--                      Set value if not in building
11728                         IF ( BTEST( wall_flags_total_0(kk,jm,im), 6 ) )  THEN
11729                            local_pf(i,j,k) = fill_value
11730                         ELSE
11731                            local_pf(i,j,k) = aerosol_number(ib)%conc(kk,jm,im)
11732                         ENDIF
11733                      ENDDO
11734                   ENDDO
11735                ENDDO
11736             ENDIF
11737             resorted = .TRUE.
11738          ELSE
11739             temp_array = nbins_av(:,:,:,ib)
11740             to_be_resorted => temp_array
11741          ENDIF
11742       ENDIF
11743
11744    ELSEIF ( variable(7:11) == 'm_bin' )  THEN
11745
11746       READ( variable(12:),* ) char_to_int
11747       IF ( char_to_int >= 1  .AND. char_to_int <= SUM( nbin ) )  THEN
11748
11749          ib = char_to_int
11750          IF ( av == 0 )  THEN
11751             DO  i = nxl, nxr
11752                DO  j = nys, nyn
11753                   DO  k = nzb, nz_do3d
11754                      temp_bin = 0.0_wp
11755                      DO  ic = ib, ncomponents_mass * nbins_aerosol, nbins_aerosol
11756                         temp_bin = temp_bin + aerosol_mass(ic)%conc(k,j,i)
11757                      ENDDO
11758                      tend(k,j,i) = temp_bin
11759                   ENDDO
11760                ENDDO
11761             ENDDO
11762             IF ( .NOT. mask_surface(mid) )  THEN
11763                DO  i = 1, mask_size_l(mid,1)
11764                   DO  j = 1, mask_size_l(mid,2)
11765                      DO  k = 1, mask_size_l(mid,3)
11766                         local_pf(i,j,k) = tend( mask_k(mid,k),  mask_j(mid,j), mask_i(mid,i) )
11767                      ENDDO
11768                   ENDDO
11769                ENDDO
11770             ELSE
11771                DO  i = 1, mask_size_l(mid,1)
11772                   DO  j = 1, mask_size_l(mid,2)
11773!
11774!--                   Get k index of the highest terraing surface
11775                      im = mask_i(mid,i)
11776                      jm = mask_j(mid,j)
11777                      ktt = MINLOC( MERGE( 1, 0, BTEST( wall_flags_total_0(:,jm,im), 5 )), &
11778                                                    DIM = 1 ) - 1
11779                      DO  k = 1, mask_size_l(mid,3)
11780                         kk = MIN( ktt+mask_k(mid,k), nzt+1 )
11781!
11782!--                      Set value if not in building
11783                         IF ( BTEST( wall_flags_total_0(kk,jm,im), 6 ) )  THEN
11784                            local_pf(i,j,k) = fill_value
11785                         ELSE
11786                            local_pf(i,j,k) = tend(kk,jm,im)
11787                         ENDIF
11788                      ENDDO
11789                   ENDDO
11790                ENDDO
11791             ENDIF
11792             resorted = .TRUE.
11793          ELSE
11794             temp_array = mbins_av(:,:,:,ib)
11795             to_be_resorted => temp_array
11796          ENDIF
11797       ENDIF
11798
11799    ELSE
11800       SELECT CASE ( TRIM( variable(7:) ) )
11801
11802          CASE ( 'g_H2SO4', 'g_HNO3', 'g_NH3', 'g_OCNV',  'g_OCSV' )
11803             vari = TRIM( variable(7:) )
11804             IF ( av == 0 )  THEN
11805                IF ( vari == 'g_H2SO4')  to_be_resorted => salsa_gas(1)%conc
11806                IF ( vari == 'g_HNO3')   to_be_resorted => salsa_gas(2)%conc
11807                IF ( vari == 'g_NH3')    to_be_resorted => salsa_gas(3)%conc
11808                IF ( vari == 'g_OCNV')   to_be_resorted => salsa_gas(4)%conc
11809                IF ( vari == 'g_OCSV')   to_be_resorted => salsa_gas(5)%conc
11810             ELSE
11811                IF ( vari == 'g_H2SO4') temp_array = salsa_gases_av(:,:,:,1)
11812                IF ( vari == 'g_HNO3')  temp_array = salsa_gases_av(:,:,:,2)
11813                IF ( vari == 'g_NH3')   temp_array = salsa_gases_av(:,:,:,3)
11814                IF ( vari == 'g_OCNV')  temp_array = salsa_gases_av(:,:,:,4)
11815                IF ( vari == 'g_OCSV')  temp_array = salsa_gases_av(:,:,:,5)
11816                to_be_resorted => temp_array
11817             ENDIF
11818
11819          CASE ( 'LDSA' )
11820             IF ( av == 0 )  THEN
11821                DO  i = nxl, nxr
11822                   DO  j = nys, nyn
11823                      DO  k = nzb, nz_do3d
11824                         temp_bin = 0.0_wp
11825                         DO  ib = 1, nbins_aerosol
11826!
11827!--                         Diameter in micrometres
11828                            mean_d = 1.0E+6_wp * ra_dry(k,j,i,ib) * 2.0_wp
11829!
11830!--                         Deposition factor: alveolar
11831                            df = ( 0.01555_wp / mean_d ) * ( EXP( -0.416_wp * ( LOG( mean_d ) +    &
11832                                   2.84_wp )**2 ) + 19.11_wp * EXP( -0.482_wp * ( LOG( mean_d ) -  &
11833                                   1.362_wp )**2 ) )
11834!
11835!--                         Lung-deposited surface area LDSA (units mum2/cm3)
11836                            temp_bin = temp_bin + pi * mean_d**2 * df * 1.0E-6_wp *                &
11837                                       aerosol_number(ib)%conc(k,j,i)
11838                         ENDDO
11839                         tend(k,j,i) = temp_bin
11840                      ENDDO
11841                   ENDDO
11842                ENDDO
11843                IF ( .NOT. mask_surface(mid) )  THEN
11844                   DO  i = 1, mask_size_l(mid,1)
11845                      DO  j = 1, mask_size_l(mid,2)
11846                         DO  k = 1, mask_size_l(mid,3)
11847                            local_pf(i,j,k) = tend( mask_k(mid,k),  mask_j(mid,j), mask_i(mid,i) )
11848                         ENDDO
11849                      ENDDO
11850                   ENDDO
11851                ELSE
11852                   DO  i = 1, mask_size_l(mid,1)
11853                      DO  j = 1, mask_size_l(mid,2)
11854!
11855!--                      Get k index of the highest terraing surface
11856                         im = mask_i(mid,i)
11857                         jm = mask_j(mid,j)
11858                         ktt = MINLOC( MERGE( 1, 0, BTEST( wall_flags_total_0(:,jm,im), 5 )), &
11859                                                       DIM = 1 ) - 1
11860                         DO  k = 1, mask_size_l(mid,3)
11861                            kk = MIN( ktt+mask_k(mid,k), nzt+1 )
11862!
11863!--                         Set value if not in building
11864                            IF ( BTEST( wall_flags_total_0(kk,jm,im), 6 ) )  THEN
11865                               local_pf(i,j,k) = fill_value
11866                            ELSE
11867                               local_pf(i,j,k) = tend(kk,jm,im)
11868                            ENDIF
11869                         ENDDO
11870                      ENDDO
11871                   ENDDO
11872                ENDIF
11873                resorted = .TRUE.
11874             ELSE
11875                to_be_resorted => ldsa_av
11876             ENDIF
11877
11878          CASE ( 'N_UFP' )
11879             IF ( av == 0 )  THEN
11880                DO  i = nxl, nxr
11881                   DO  j = nys, nyn
11882                      DO  k = nzb, nz_do3d
11883                         temp_bin = 0.0_wp
11884                         DO  ib = 1, nbins_aerosol
11885                            IF ( 2.0_wp * ra_dry(k,j,i,ib) <= 0.1E-6_wp )  THEN
11886                               temp_bin = temp_bin + aerosol_number(ib)%conc(k,j,i)
11887                            ENDIF
11888                         ENDDO
11889                         tend(k,j,i) = temp_bin
11890                      ENDDO
11891                   ENDDO
11892                ENDDO
11893                IF ( .NOT. mask_surface(mid) )  THEN
11894                   DO  i = 1, mask_size_l(mid,1)
11895                      DO  j = 1, mask_size_l(mid,2)
11896                         DO  k = 1, mask_size_l(mid,3)
11897                            local_pf(i,j,k) = tend( mask_k(mid,k),  mask_j(mid,j), mask_i(mid,i) )
11898                         ENDDO
11899                      ENDDO
11900                   ENDDO
11901                ELSE
11902                   DO  i = 1, mask_size_l(mid,1)
11903                      DO  j = 1, mask_size_l(mid,2)
11904!
11905!--                      Get k index of the highest terraing surface
11906                         im = mask_i(mid,i)
11907                         jm = mask_j(mid,j)
11908                         ktt = MINLOC( MERGE( 1, 0, BTEST( wall_flags_total_0(:,jm,im), 5 )), &
11909                                                       DIM = 1 ) - 1
11910                         DO  k = 1, mask_size_l(mid,3)
11911                            kk = MIN( ktt+mask_k(mid,k), nzt+1 )
11912!
11913!--                         Set value if not in building
11914                            IF ( BTEST( wall_flags_total_0(kk,jm,im), 6 ) )  THEN
11915                               local_pf(i,j,k) = fill_value
11916                            ELSE
11917                               local_pf(i,j,k) = tend(kk,jm,im)
11918                            ENDIF
11919                         ENDDO
11920                      ENDDO
11921                   ENDDO
11922                ENDIF
11923                resorted = .TRUE.
11924             ELSE
11925                to_be_resorted => nufp_av
11926             ENDIF
11927
11928          CASE ( 'Ntot' )
11929             IF ( av == 0 )  THEN
11930                DO  i = nxl, nxr
11931                   DO  j = nys, nyn
11932                      DO  k = nzb, nz_do3d
11933                         temp_bin = 0.0_wp
11934                         DO  ib = 1, nbins_aerosol
11935                            temp_bin = temp_bin + aerosol_number(ib)%conc(k,j,i)
11936                         ENDDO
11937                         tend(k,j,i) = temp_bin
11938                      ENDDO
11939                   ENDDO
11940                ENDDO 
11941                IF ( .NOT. mask_surface(mid) )  THEN
11942                   DO  i = 1, mask_size_l(mid,1)
11943                      DO  j = 1, mask_size_l(mid,2)
11944                         DO  k = 1, mask_size_l(mid,3)
11945                            local_pf(i,j,k) = tend( mask_k(mid,k),  mask_j(mid,j), mask_i(mid,i) )
11946                         ENDDO
11947                      ENDDO
11948                   ENDDO
11949                ELSE
11950                   DO  i = 1, mask_size_l(mid,1)
11951                      DO  j = 1, mask_size_l(mid,2)
11952!
11953!--                      Get k index of the highest terraing surface
11954                         im = mask_i(mid,i)
11955                         jm = mask_j(mid,j)
11956                         ktt = MINLOC( MERGE( 1, 0, BTEST( wall_flags_total_0(:,jm,im), 5 )), &
11957                                                       DIM = 1 ) - 1
11958                         DO  k = 1, mask_size_l(mid,3)
11959                            kk = MIN( ktt+mask_k(mid,k), nzt+1 )
11960!
11961!--                         Set value if not in building
11962                            IF ( BTEST( wall_flags_total_0(kk,jm,im), 6 ) )  THEN
11963                               local_pf(i,j,k) = fill_value
11964                            ELSE
11965                               local_pf(i,j,k) = tend(kk,jm,im)
11966                            ENDIF
11967                         ENDDO
11968                      ENDDO
11969                   ENDDO
11970                ENDIF
11971                resorted = .TRUE.
11972             ELSE
11973                to_be_resorted => ntot_av
11974             ENDIF
11975
11976          CASE ( 'PM0.1' )
11977             IF ( av == 0 )  THEN
11978                DO  i = nxl, nxr
11979                   DO  j = nys, nyn
11980                      DO  k = nzb, nz_do3d
11981                         temp_bin = 0.0_wp
11982                         DO  ib = 1, nbins_aerosol
11983                            IF ( 2.0_wp * ra_dry(k,j,i,ib) <= 0.1E-6_wp )  THEN
11984                               DO  ic = ib, nbins_aerosol * ncc, nbins_aerosol
11985                                  temp_bin = temp_bin + aerosol_mass(ic)%conc(k,j,i)
11986                               ENDDO
11987                            ENDIF
11988                         ENDDO
11989                         tend(k,j,i) = temp_bin
11990                      ENDDO
11991                   ENDDO
11992                ENDDO 
11993                IF ( .NOT. mask_surface(mid) )  THEN
11994                   DO  i = 1, mask_size_l(mid,1)
11995                      DO  j = 1, mask_size_l(mid,2)
11996                         DO  k = 1, mask_size_l(mid,3)
11997                            local_pf(i,j,k) = tend( mask_k(mid,k),  mask_j(mid,j), mask_i(mid,i) )
11998                         ENDDO
11999                      ENDDO
12000                   ENDDO
12001                ELSE
12002                   DO  i = 1, mask_size_l(mid,1)
12003                      DO  j = 1, mask_size_l(mid,2)
12004!
12005!--                      Get k index of the highest terraing surface
12006                         im = mask_i(mid,i)
12007                         jm = mask_j(mid,j)
12008                         ktt = MINLOC( MERGE( 1, 0, BTEST( wall_flags_total_0(:,jm,im), 5 )), &
12009                                                       DIM = 1 ) - 1
12010                         DO  k = 1, mask_size_l(mid,3)
12011                            kk = MIN( ktt+mask_k(mid,k), nzt+1 )
12012!
12013!--                         Set value if not in building
12014                            IF ( BTEST( wall_flags_total_0(kk,jm,im), 6 ) )  THEN
12015                               local_pf(i,j,k) = fill_value
12016                            ELSE
12017                               local_pf(i,j,k) = tend(kk,jm,im)
12018                            ENDIF
12019                         ENDDO
12020                      ENDDO
12021                   ENDDO
12022                ENDIF
12023                resorted = .TRUE.
12024             ELSE
12025                to_be_resorted => pm01_av
12026             ENDIF
12027
12028          CASE ( 'PM2.5' )
12029             IF ( av == 0 )  THEN
12030                DO  i = nxl, nxr
12031                   DO  j = nys, nyn
12032                      DO  k = nzb, nz_do3d
12033                         temp_bin = 0.0_wp
12034                         DO  ib = 1, nbins_aerosol
12035                            IF ( 2.0_wp * ra_dry(k,j,i,ib) <= 2.5E-6_wp )  THEN
12036                               DO  ic = ib, nbins_aerosol * ncc, nbins_aerosol
12037                                  temp_bin = temp_bin + aerosol_mass(ic)%conc(k,j,i)
12038                               ENDDO
12039                            ENDIF
12040                         ENDDO
12041                         tend(k,j,i) = temp_bin
12042                      ENDDO
12043                   ENDDO
12044                ENDDO
12045                IF ( .NOT. mask_surface(mid) )  THEN
12046                   DO  i = 1, mask_size_l(mid,1)
12047                      DO  j = 1, mask_size_l(mid,2)
12048                         DO  k = 1, mask_size_l(mid,3)
12049                            local_pf(i,j,k) = tend( mask_k(mid,k),  mask_j(mid,j), mask_i(mid,i) )
12050                         ENDDO
12051                      ENDDO
12052                   ENDDO
12053                ELSE
12054                   DO  i = 1, mask_size_l(mid,1)
12055                      DO  j = 1, mask_size_l(mid,2)
12056!
12057!--                      Get k index of the highest terraing surface
12058                         im = mask_i(mid,i)
12059                         jm = mask_j(mid,j)
12060                         ktt = MINLOC( MERGE( 1, 0, BTEST( wall_flags_total_0(:,jm,im), 5 )), &
12061                                                       DIM = 1 ) - 1
12062                         DO  k = 1, mask_size_l(mid,3)
12063                            kk = MIN( ktt+mask_k(mid,k), nzt+1 )
12064!
12065!--                         Set value if not in building
12066                            IF ( BTEST( wall_flags_total_0(kk,jm,im), 6 ) )  THEN
12067                               local_pf(i,j,k) = fill_value
12068                            ELSE
12069                               local_pf(i,j,k) = tend(kk,jm,im)
12070                            ENDIF
12071                         ENDDO
12072                      ENDDO
12073                   ENDDO
12074                ENDIF
12075                resorted = .TRUE.
12076             ELSE
12077                to_be_resorted => pm25_av
12078             ENDIF
12079
12080          CASE ( 'PM10' )
12081             IF ( av == 0 )  THEN
12082                DO  i = nxl, nxr
12083                   DO  j = nys, nyn
12084                      DO  k = nzb, nz_do3d
12085                         temp_bin = 0.0_wp
12086                         DO  ib = 1, nbins_aerosol
12087                            IF ( 2.0_wp * ra_dry(k,j,i,ib) <= 10.0E-6_wp )  THEN
12088                               DO  ic = ib, nbins_aerosol * ncc, nbins_aerosol
12089                                  temp_bin = temp_bin + aerosol_mass(ic)%conc(k,j,i)
12090                               ENDDO
12091                            ENDIF
12092                         ENDDO
12093                         tend(k,j,i) = temp_bin
12094                      ENDDO
12095                   ENDDO
12096                ENDDO 
12097                IF ( .NOT. mask_surface(mid) )  THEN
12098                   DO  i = 1, mask_size_l(mid,1)
12099                      DO  j = 1, mask_size_l(mid,2)
12100                         DO  k = 1, mask_size_l(mid,3)
12101                            local_pf(i,j,k) = tend( mask_k(mid,k),  mask_j(mid,j), mask_i(mid,i) )
12102                         ENDDO
12103                      ENDDO
12104                   ENDDO
12105                ELSE
12106                   DO  i = 1, mask_size_l(mid,1)
12107                      DO  j = 1, mask_size_l(mid,2)
12108!
12109!--                      Get k index of the highest terraing surface
12110                         im = mask_i(mid,i)
12111                         jm = mask_j(mid,j)
12112                         ktt = MINLOC( MERGE( 1, 0, BTEST( wall_flags_total_0(:,jm,im), 5 )), &
12113                                                       DIM = 1 ) - 1
12114                         DO  k = 1, mask_size_l(mid,3)
12115                            kk = MIN( ktt+mask_k(mid,k), nzt+1 )
12116!
12117!--                         Set value if not in building
12118                            IF ( BTEST( wall_flags_total_0(kk,jm,im), 6 ) )  THEN
12119                               local_pf(i,j,k) = fill_value
12120                            ELSE
12121                               local_pf(i,j,k) = tend(kk,jm,im)
12122                            ENDIF
12123                         ENDDO
12124                      ENDDO
12125                   ENDDO
12126                ENDIF
12127                resorted = .TRUE.
12128             ELSE
12129                to_be_resorted => pm10_av
12130             ENDIF
12131
12132          CASE ( 's_BC', 's_DU', 's_NH', 's_NO', 's_OC', 's_SO4', 's_SS' )
12133             IF ( is_used( prtcl, TRIM( variable(9:) ) ) )  THEN
12134                found_index = get_index( prtcl, TRIM( variable(9:) ) )
12135                IF ( av == 0 )  THEN
12136                   DO  i = nxl, nxr
12137                      DO  j = nys, nyn
12138                         DO  k = nzb, nz_do3d
12139                            temp_bin = 0.0_wp
12140                            DO  ic = ( found_index-1 ) * nbins_aerosol + 1, found_index * nbins_aerosol
12141                               temp_bin = temp_bin + aerosol_mass(ic)%conc(k,j,i)
12142                            ENDDO
12143                            tend(k,j,i) = temp_bin
12144                         ENDDO
12145                      ENDDO
12146                   ENDDO
12147                   IF ( .NOT. mask_surface(mid) )  THEN
12148                      DO  i = 1, mask_size_l(mid,1)
12149                         DO  j = 1, mask_size_l(mid,2)
12150                            DO  k = 1, mask_size_l(mid,3)
12151                               local_pf(i,j,k) = tend( mask_k(mid,k), mask_j(mid,j), mask_i(mid,i) )
12152                            ENDDO
12153                         ENDDO
12154                      ENDDO
12155                   ELSE
12156                      DO  i = 1, mask_size_l(mid,1)
12157                         DO  j = 1, mask_size_l(mid,2)
12158   !
12159   !--                      Get k index of the highest terraing surface
12160                            im = mask_i(mid,i)
12161                            jm = mask_j(mid,j)
12162                            ktt = MINLOC( MERGE( 1, 0, BTEST( wall_flags_total_0(:,jm,im), 5 )), &
12163                                                          DIM = 1 ) - 1
12164                            DO  k = 1, mask_size_l(mid,3)
12165                               kk = MIN( ktt+mask_k(mid,k), nzt+1 )
12166   !
12167   !--                         Set value if not in building
12168                               IF ( BTEST( wall_flags_total_0(kk,jm,im), 6 ) )  THEN
12169                                  local_pf(i,j,k) = fill_value
12170                               ELSE
12171                                  local_pf(i,j,k) = tend(kk,jm,im)
12172                               ENDIF
12173                            ENDDO
12174                         ENDDO
12175                      ENDDO
12176                   ENDIF
12177                   resorted = .TRUE.
12178                ELSE
12179                   temp_array = s_mass_av(:,:,:,found_index)
12180                   to_be_resorted => temp_array
12181                ENDIF
12182             ELSE
12183                local_pf = fill_value
12184             ENDIF
12185
12186          CASE ( 's_H2O' )
12187             IF ( av == 0 )  THEN
12188                found_index = get_index( prtcl, 'H2O' )
12189                DO  i = nxl, nxr
12190                   DO  j = nys, nyn
12191                      DO  k = nzb, nz_do3d
12192                         temp_bin = 0.0_wp
12193                         DO  ic = ( found_index-1 ) * nbins_aerosol + 1, found_index * nbins_aerosol
12194                            temp_bin = temp_bin + aerosol_mass(ic)%conc(k,j,i)
12195                         ENDDO
12196                         tend(k,j,i) = temp_bin
12197                      ENDDO
12198                   ENDDO
12199                ENDDO
12200                IF ( .NOT. mask_surface(mid) )  THEN
12201                   DO  i = 1, mask_size_l(mid,1)
12202                      DO  j = 1, mask_size_l(mid,2)
12203                         DO  k = 1, mask_size_l(mid,3)
12204                            local_pf(i,j,k) = tend( mask_k(mid,k), mask_j(mid,j), mask_i(mid,i) )
12205                         ENDDO
12206                      ENDDO
12207                   ENDDO
12208                ELSE
12209                   DO  i = 1, mask_size_l(mid,1)
12210                      DO  j = 1, mask_size_l(mid,2)
12211!
12212!--                      Get k index of the highest terraing surface
12213                         im = mask_i(mid,i)
12214                         jm = mask_j(mid,j)
12215                         ktt = MINLOC( MERGE( 1, 0, BTEST( wall_flags_total_0(:,jm,im), 5 )), &
12216                                          DIM = 1 ) - 1
12217                         DO  k = 1, mask_size_l(mid,3)
12218                            kk = MIN( ktt+mask_k(mid,k), nzt+1 )
12219!
12220!--                         Set value if not in building
12221                            IF ( BTEST( wall_flags_total_0(kk,jm,im), 6 ) )  THEN
12222                               local_pf(i,j,k) = fill_value
12223                            ELSE
12224                               local_pf(i,j,k) =  tend(kk,jm,im)
12225                            ENDIF
12226                         ENDDO
12227                      ENDDO
12228                   ENDDO
12229                ENDIF
12230                resorted = .TRUE.
12231             ELSE
12232                to_be_resorted => s_h2o_av
12233             ENDIF
12234
12235          CASE DEFAULT
12236             found = .FALSE.
12237
12238       END SELECT
12239    ENDIF
12240
12241    IF ( found  .AND.  .NOT. resorted )  THEN
12242       IF ( .NOT. mask_surface(mid) )  THEN
12243!
12244!--       Default masked output
12245          DO  i = 1, mask_size_l(mid,1)
12246             DO  j = 1, mask_size_l(mid,2)
12247                DO  k = 1, mask_size_l(mid,3)
12248                   local_pf(i,j,k) = to_be_resorted( mask_k(mid,k), mask_j(mid,j), mask_i(mid,i) )
12249                ENDDO
12250             ENDDO
12251          ENDDO
12252       ELSE
12253!
12254!--       Terrain-following masked output
12255          DO  i = 1, mask_size_l(mid,1)
12256             DO  j = 1, mask_size_l(mid,2)
12257!
12258!--             Get k index of the highest terraing surface
12259                im = mask_i(mid,i)
12260                jm = mask_j(mid,j)
12261                ktt = MINLOC( MERGE( 1, 0, BTEST( wall_flags_total_0(:,jm,im), 5 )), &
12262                                 DIM = 1 ) - 1
12263                DO  k = 1, mask_size_l(mid,3)
12264                   kk = MIN( ktt+mask_k(mid,k), nzt+1 )
12265!
12266!--                Set value if not in building
12267                   IF ( BTEST( wall_flags_total_0(kk,jm,im), 6 ) )  THEN
12268                      local_pf(i,j,k) = fill_value
12269                   ELSE
12270                      local_pf(i,j,k) = to_be_resorted(kk,jm,im)
12271                   ENDIF
12272                ENDDO
12273             ENDDO
12274          ENDDO
12275       ENDIF
12276    ENDIF
12277
12278 END SUBROUTINE salsa_data_output_mask
12279
12280!------------------------------------------------------------------------------!
12281! Description:
12282! ------------
12283!> Creates index tables for different (aerosol) components
12284!------------------------------------------------------------------------------!
12285 SUBROUTINE component_index_constructor( self, ncomp, nlist, listcomp )
12286
12287    IMPLICIT NONE
12288
12289    INTEGER(iwp) ::  ii  !<
12290    INTEGER(iwp) ::  jj  !<
12291
12292    INTEGER(iwp), INTENT(in) ::  nlist ! < Maximum number of components
12293
12294    INTEGER(iwp), INTENT(inout) ::  ncomp  !< Number of components
12295
12296    CHARACTER(LEN=3), INTENT(in) ::  listcomp(nlist)  !< List cof component names
12297
12298    TYPE(component_index), INTENT(inout) ::  self  !< Object containing the indices of different
12299                                                   !< aerosol components
12300
12301    ncomp = 0
12302
12303    DO WHILE ( listcomp(ncomp+1) /= '  ' .AND. ncomp < nlist )
12304       ncomp = ncomp + 1
12305    ENDDO
12306
12307    self%ncomp = ncomp
12308    ALLOCATE( self%ind(ncomp), self%comp(ncomp) )
12309
12310    DO  ii = 1, ncomp
12311       self%ind(ii) = ii
12312    ENDDO
12313
12314    jj = 1
12315    DO  ii = 1, nlist
12316       IF ( listcomp(ii) == '') CYCLE
12317       self%comp(jj) = listcomp(ii)
12318       jj = jj + 1
12319    ENDDO
12320
12321 END SUBROUTINE component_index_constructor
12322
12323!------------------------------------------------------------------------------!
12324! Description:
12325! ------------
12326!> Gives the index of a component in the component list
12327!------------------------------------------------------------------------------!
12328 INTEGER FUNCTION get_index( self, incomp )
12329
12330    IMPLICIT NONE
12331
12332    CHARACTER(LEN=*), INTENT(in) ::  incomp !< Component name
12333
12334    INTEGER(iwp) ::  ii  !< index
12335
12336    TYPE(component_index), INTENT(in) ::  self  !< Object containing the indices of different
12337                                                !< aerosol components
12338    IF ( ANY( self%comp == incomp ) )  THEN
12339       ii = 1
12340       DO WHILE ( (self%comp(ii) /= incomp) )
12341          ii = ii + 1
12342       ENDDO
12343       get_index = ii
12344    ELSEIF ( incomp == 'H2O' )  THEN
12345       get_index = self%ncomp + 1
12346    ELSE
12347       WRITE( message_string, * ) 'Incorrect component name given!'
12348       CALL message( 'get_index', 'PA0591', 1, 2, 0, 6, 0 )
12349    ENDIF
12350
12351 END FUNCTION get_index
12352
12353!------------------------------------------------------------------------------!
12354! Description:
12355! ------------
12356!> Tells if the (aerosol) component is being used in the simulation
12357!------------------------------------------------------------------------------!
12358 LOGICAL FUNCTION is_used( self, icomp )
12359
12360    IMPLICIT NONE
12361
12362    CHARACTER(LEN=*), INTENT(in) ::  icomp !< Component name
12363
12364    TYPE(component_index), INTENT(in) ::  self  !< Object containing the indices of different
12365                                                !< aerosol components
12366
12367    IF ( ANY(self%comp == icomp) ) THEN
12368       is_used = .TRUE.
12369    ELSE
12370       is_used = .FALSE.
12371    ENDIF
12372
12373 END FUNCTION
12374
12375!------------------------------------------------------------------------------!
12376! Description:
12377! ------------
12378!> Set the lateral and top boundary conditions in case the PALM domain is
12379!> nested offline in a mesoscale model. Further, average boundary data and
12380!> determine mean profiles, further used for correct damping in the sponge
12381!> layer.
12382!------------------------------------------------------------------------------!
12383 SUBROUTINE salsa_nesting_offl_bc
12384
12385    USE control_parameters,                                                                        &
12386        ONLY:  bc_dirichlet_l, bc_dirichlet_n, bc_dirichlet_r, bc_dirichlet_s, dt_3d,              &
12387               time_since_reference_point
12388
12389    USE indices,                                                                                   &
12390        ONLY:  nbgp, nxl, nxr, nyn, nys, nzb, nzt
12391
12392    IMPLICIT NONE
12393
12394    INTEGER(iwp) ::  i    !< running index x-direction
12395    INTEGER(iwp) ::  ib   !< running index for aerosol number bins
12396    INTEGER(iwp) ::  ic   !< running index for aerosol mass bins
12397    INTEGER(iwp) ::  icc  !< running index for aerosol mass bins
12398    INTEGER(iwp) ::  ig   !< running index for gaseous species
12399    INTEGER(iwp) ::  j    !< running index y-direction
12400    INTEGER(iwp) ::  k    !< running index z-direction
12401
12402    REAL(wp) ::  fac_dt  !< interpolation factor
12403
12404    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  ref_mconc    !< reference profile for aerosol mass
12405    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  ref_mconc_l  !< reference profile for aerosol mass: subdomain
12406    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  ref_nconc    !< reference profile for aerosol number
12407    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  ref_nconc_l  !< reference profile for aerosol_number: subdomain
12408    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  ref_gconc    !< reference profile for gases
12409    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  ref_gconc_l  !< reference profile for gases: subdomain
12410
12411!
12412!-- Skip input if no forcing from larger-scale models is applied.
12413    IF ( .NOT. nesting_offline_salsa )  RETURN
12414!
12415!-- Allocate temporary arrays to compute salsa mean profiles
12416    ALLOCATE( ref_gconc(nzb:nzt+1,1:ngases_salsa), ref_gconc_l(nzb:nzt+1,1:ngases_salsa),          &
12417              ref_mconc(nzb:nzt+1,1:nbins_aerosol*ncomponents_mass),                               &
12418              ref_mconc_l(nzb:nzt+1,1:nbins_aerosol*ncomponents_mass),                             &
12419              ref_nconc(nzb:nzt+1,1:nbins_aerosol), ref_nconc_l(nzb:nzt+1,1:nbins_aerosol) )
12420    ref_gconc   = 0.0_wp
12421    ref_gconc_l = 0.0_wp
12422    ref_mconc   = 0.0_wp
12423    ref_mconc_l = 0.0_wp
12424    ref_nconc   = 0.0_wp
12425    ref_nconc_l = 0.0_wp
12426
12427!
12428!-- Determine interpolation factor and limit it to 1. This is because t+dt can slightly exceed
12429!-- time(tind_p) before boundary data is updated again.
12430    fac_dt = ( time_since_reference_point - salsa_nest_offl%time(salsa_nest_offl%tind) + dt_3d ) / &
12431             ( salsa_nest_offl%time(salsa_nest_offl%tind_p) -                                      &
12432               salsa_nest_offl%time(salsa_nest_offl%tind) )
12433    fac_dt = MIN( 1.0_wp, fac_dt )
12434
12435    IF ( bc_dirichlet_l )  THEN
12436       DO  ib = 1, nbins_aerosol
12437          DO  j = nys, nyn
12438             DO  k = nzb+1, nzt
12439                aerosol_number(ib)%conc(k,j,-1) = ( 1.0_wp - fac_dt ) *                            &
12440                                                  salsa_nest_offl%nconc_left(0,k,j,ib) + fac_dt *  &
12441                                                  salsa_nest_offl%nconc_left(1,k,j,ib)
12442             ENDDO
12443             ref_nconc_l(nzb+1:nzt,ib) = ref_nconc_l(nzb+1:nzt,ib) +                               &
12444                                         aerosol_number(ib)%conc(nzb+1:nzt,j,-1)
12445          ENDDO
12446          DO  ic = 1, ncomponents_mass
12447             icc = ( ic-1 ) * nbins_aerosol + ib
12448             DO  j = nys, nyn
12449                DO  k = nzb+1, nzt
12450                   aerosol_mass(icc)%conc(k,j,-1) = ( 1.0_wp - fac_dt ) *                          &
12451                                                    salsa_nest_offl%mconc_left(0,k,j,icc) + fac_dt &
12452                                                    * salsa_nest_offl%mconc_left(1,k,j,icc)
12453                ENDDO
12454                ref_mconc_l(nzb+1:nzt,icc) = ref_mconc_l(nzb+1:nzt,icc) +                          &
12455                                             aerosol_mass(icc)%conc(nzb+1:nzt,j,-1)
12456             ENDDO
12457          ENDDO
12458       ENDDO
12459       IF ( .NOT. salsa_gases_from_chem )  THEN
12460          DO  ig = 1, ngases_salsa
12461             DO  j = nys, nyn
12462                DO  k = nzb+1, nzt
12463                   salsa_gas(ig)%conc(k,j,-1) = ( 1.0_wp - fac_dt ) *                              &
12464                                                salsa_nest_offl%gconc_left(0,k,j,ig) + fac_dt *    &
12465                                                salsa_nest_offl%gconc_left(1,k,j,ig)
12466                ENDDO
12467                ref_gconc_l(nzb+1:nzt,ig) = ref_gconc_l(nzb+1:nzt,ig) +                            &
12468                                            salsa_gas(ig)%conc(nzb+1:nzt,j,-1)
12469             ENDDO
12470          ENDDO
12471       ENDIF
12472    ENDIF
12473
12474    IF ( bc_dirichlet_r )  THEN
12475       DO  ib = 1, nbins_aerosol
12476          DO  j = nys, nyn
12477             DO  k = nzb+1, nzt
12478                aerosol_number(ib)%conc(k,j,nxr+1) = ( 1.0_wp - fac_dt ) *                         &
12479                                                  salsa_nest_offl%nconc_right(0,k,j,ib) + fac_dt * &
12480                                                  salsa_nest_offl%nconc_right(1,k,j,ib)
12481             ENDDO
12482             ref_nconc_l(nzb+1:nzt,ib) = ref_nconc_l(nzb+1:nzt,ib) +                               &
12483                                         aerosol_number(ib)%conc(nzb+1:nzt,j,nxr+1)
12484          ENDDO
12485          DO  ic = 1, ncomponents_mass
12486             icc = ( ic-1 ) * nbins_aerosol + ib
12487             DO  j = nys, nyn
12488                DO  k = nzb+1, nzt
12489                   aerosol_mass(icc)%conc(k,j,nxr+1) = ( 1.0_wp - fac_dt ) *                       &
12490                                                    salsa_nest_offl%mconc_right(0,k,j,icc) + fac_dt&
12491                                                    * salsa_nest_offl%mconc_right(1,k,j,icc)
12492                ENDDO
12493                ref_mconc_l(nzb+1:nzt,icc) = ref_mconc_l(nzb+1:nzt,icc) +                          &
12494                                             aerosol_mass(icc)%conc(nzb+1:nzt,j,nxr+1)
12495             ENDDO
12496          ENDDO
12497       ENDDO
12498       IF ( .NOT. salsa_gases_from_chem )  THEN
12499          DO  ig = 1, ngases_salsa
12500             DO  j = nys, nyn
12501                DO  k = nzb+1, nzt
12502                   salsa_gas(ig)%conc(k,j,nxr+1) = ( 1.0_wp - fac_dt ) *                           &
12503                                                   salsa_nest_offl%gconc_right(0,k,j,ig) + fac_dt *&
12504                                                   salsa_nest_offl%gconc_right(1,k,j,ig)
12505                ENDDO
12506                ref_gconc_l(nzb+1:nzt,ig) = ref_gconc_l(nzb+1:nzt,ig) +                            &
12507                                            salsa_gas(ig)%conc(nzb+1:nzt,j,nxr+1)
12508             ENDDO
12509          ENDDO
12510       ENDIF
12511    ENDIF
12512
12513    IF ( bc_dirichlet_n )  THEN
12514       DO  ib = 1, nbins_aerosol
12515          DO  i = nxl, nxr
12516             DO  k = nzb+1, nzt
12517                aerosol_number(ib)%conc(k,nyn+1,i) = ( 1.0_wp - fac_dt ) *                         &
12518                                                  salsa_nest_offl%nconc_north(0,k,i,ib) + fac_dt * &
12519                                                  salsa_nest_offl%nconc_north(1,k,i,ib)
12520             ENDDO
12521             ref_nconc_l(nzb+1:nzt,ib) = ref_nconc_l(nzb+1:nzt,ib) +                               &
12522                                         aerosol_number(ib)%conc(nzb+1:nzt,nyn+1,i)
12523          ENDDO
12524          DO  ic = 1, ncomponents_mass
12525             icc = ( ic-1 ) * nbins_aerosol + ib
12526             DO  i = nxl, nxr
12527                DO  k = nzb+1, nzt
12528                   aerosol_mass(icc)%conc(k,nyn+1,i) = ( 1.0_wp - fac_dt ) *                       &
12529                                                    salsa_nest_offl%mconc_north(0,k,i,icc) + fac_dt&
12530                                                    * salsa_nest_offl%mconc_north(1,k,i,icc)
12531                ENDDO
12532                ref_mconc_l(nzb+1:nzt,icc) = ref_mconc_l(nzb+1:nzt,icc) +                          &
12533                                             aerosol_mass(icc)%conc(nzb+1:nzt,nyn+1,i)
12534             ENDDO
12535          ENDDO
12536       ENDDO
12537       IF ( .NOT. salsa_gases_from_chem )  THEN
12538          DO  ig = 1, ngases_salsa
12539             DO  i = nxl, nxr
12540                DO  k = nzb+1, nzt
12541                   salsa_gas(ig)%conc(k,nyn+1,i) = ( 1.0_wp - fac_dt ) *                           &
12542                                                   salsa_nest_offl%gconc_north(0,k,i,ig) + fac_dt *&
12543                                                   salsa_nest_offl%gconc_north(1,k,i,ig)
12544                ENDDO
12545                ref_gconc_l(nzb+1:nzt,ig) = ref_gconc_l(nzb+1:nzt,ig) +                            &
12546                                            salsa_gas(ig)%conc(nzb+1:nzt,nyn+1,i)
12547             ENDDO
12548          ENDDO
12549       ENDIF
12550    ENDIF
12551
12552    IF ( bc_dirichlet_s )  THEN
12553       DO  ib = 1, nbins_aerosol
12554          DO  i = nxl, nxr
12555             DO  k = nzb+1, nzt
12556                aerosol_number(ib)%conc(k,-1,i) = ( 1.0_wp - fac_dt ) *                            &
12557                                                  salsa_nest_offl%nconc_south(0,k,i,ib) + fac_dt * &
12558                                                  salsa_nest_offl%nconc_south(1,k,i,ib)
12559             ENDDO
12560             ref_nconc_l(nzb+1:nzt,ib) = ref_nconc_l(nzb+1:nzt,ib) +                               &
12561                                         aerosol_number(ib)%conc(nzb+1:nzt,-1,i)
12562          ENDDO
12563          DO  ic = 1, ncomponents_mass
12564             icc = ( ic-1 ) * nbins_aerosol + ib
12565             DO  i = nxl, nxr
12566                DO  k = nzb+1, nzt
12567                   aerosol_mass(icc)%conc(k,-1,i) = ( 1.0_wp - fac_dt ) *                          &
12568                                                    salsa_nest_offl%mconc_south(0,k,i,icc) + fac_dt&
12569                                                    * salsa_nest_offl%mconc_south(1,k,i,icc)
12570                ENDDO
12571                ref_mconc_l(nzb+1:nzt,icc) = ref_mconc_l(nzb+1:nzt,icc) +                          &
12572                                             aerosol_mass(icc)%conc(nzb+1:nzt,-1,i)
12573             ENDDO
12574          ENDDO
12575       ENDDO
12576       IF ( .NOT. salsa_gases_from_chem )  THEN
12577          DO  ig = 1, ngases_salsa
12578             DO  i = nxl, nxr
12579                DO  k = nzb+1, nzt
12580                   salsa_gas(ig)%conc(k,-1,i) = ( 1.0_wp - fac_dt ) *                              &
12581                                                salsa_nest_offl%gconc_south(0,k,i,ig) + fac_dt *   &
12582                                                salsa_nest_offl%gconc_south(1,k,i,ig)
12583                ENDDO
12584                ref_gconc_l(nzb+1:nzt,ig) = ref_gconc_l(nzb+1:nzt,ig) +                            &
12585                                            salsa_gas(ig)%conc(nzb+1:nzt,-1,i)
12586             ENDDO
12587          ENDDO
12588       ENDIF
12589    ENDIF
12590!
12591!-- Top boundary
12592    DO  ib = 1, nbins_aerosol
12593       DO  i = nxl, nxr
12594          DO  j = nys, nyn
12595             aerosol_number(ib)%conc(nzt+1,j,i) = ( 1.0_wp - fac_dt ) *                            &
12596                                                  salsa_nest_offl%nconc_top(0,j,i,ib) + fac_dt *   &
12597                                                  salsa_nest_offl%nconc_top(1,j,i,ib)
12598             ref_nconc_l(nzt+1,ib) = ref_nconc_l(nzt+1,ib) + aerosol_number(ib)%conc(nzt+1,j,i)
12599          ENDDO
12600       ENDDO
12601       DO  ic = 1, ncomponents_mass
12602          icc = ( ic-1 ) * nbins_aerosol + ib
12603          DO  i = nxl, nxr
12604             DO  j = nys, nyn
12605                aerosol_mass(icc)%conc(nzt+1,j,i) = ( 1.0_wp - fac_dt ) *                          &
12606                                                    salsa_nest_offl%mconc_top(0,j,i,icc) + fac_dt *&
12607                                                    salsa_nest_offl%mconc_top(1,j,i,icc)
12608                ref_mconc_l(nzt+1,icc) = ref_mconc_l(nzt+1,icc) + aerosol_mass(icc)%conc(nzt+1,j,i)
12609             ENDDO
12610          ENDDO
12611       ENDDO
12612    ENDDO
12613    IF ( .NOT. salsa_gases_from_chem )  THEN
12614       DO  ig = 1, ngases_salsa
12615          DO  i = nxl, nxr
12616             DO  j = nys, nyn
12617                salsa_gas(ig)%conc(nzt+1,j,i) = ( 1.0_wp - fac_dt ) *                              &
12618                                                salsa_nest_offl%gconc_top(0,j,i,ig) + fac_dt *     &
12619                                                salsa_nest_offl%gconc_top(1,j,i,ig)
12620                ref_gconc_l(nzt+1,ig) = ref_gconc_l(nzt+1,ig) + salsa_gas(ig)%conc(nzt+1,j,i)
12621             ENDDO
12622          ENDDO
12623       ENDDO
12624    ENDIF
12625!
12626!-- Do local exchange
12627    DO  ib = 1, nbins_aerosol
12628       CALL exchange_horiz( aerosol_number(ib)%conc, nbgp )
12629       DO  ic = 1, ncomponents_mass
12630          icc = ( ic-1 ) * nbins_aerosol + ib
12631          CALL exchange_horiz( aerosol_mass(icc)%conc, nbgp )
12632       ENDDO
12633    ENDDO
12634    IF ( .NOT. salsa_gases_from_chem )  THEN
12635       DO  ig = 1, ngases_salsa
12636          CALL exchange_horiz( salsa_gas(ig)%conc, nbgp )
12637       ENDDO
12638    ENDIF
12639!
12640!-- In case of Rayleigh damping, where the initial profiles are still used, update these profiles
12641!-- from the averaged boundary data. But first, average these data.
12642#if defined( __parallel )
12643    IF ( .NOT. salsa_gases_from_chem )                                                             &
12644       CALL MPI_ALLREDUCE( ref_gconc_l, ref_gconc, ( nzt+1-nzb+1 ) * SIZE( ref_gconc(nzb,:) ),     &
12645                           MPI_REAL, MPI_SUM, comm2d, ierr )
12646    CALL MPI_ALLREDUCE( ref_mconc_l, ref_mconc, ( nzt+1-nzb+1 ) * SIZE( ref_mconc(nzb,:) ),        &
12647                        MPI_REAL, MPI_SUM, comm2d, ierr )
12648    CALL MPI_ALLREDUCE( ref_nconc_l, ref_nconc, ( nzt+1-nzb+1 ) * SIZE( ref_nconc(nzb,:) ),        &
12649                        MPI_REAL, MPI_SUM, comm2d, ierr )
12650#else
12651    IF ( .NOT. salsa_gases_from_chem )  ref_gconc = ref_gconc_l
12652    ref_mconc = ref_mconc_l
12653    ref_nconc = ref_nconc_l
12654#endif
12655!
12656!-- Average data. Note, reference profiles up to nzt are derived from lateral boundaries, at the
12657!-- model top it is derived from the top boundary. Thus, number of input data is different from
12658!-- nzb:nzt compared to nzt+1.
12659!-- Derived from lateral boundaries.
12660    IF ( .NOT. salsa_gases_from_chem )                                                             &
12661       ref_gconc(nzb:nzt,:) = ref_gconc(nzb:nzt,:) / REAL( 2.0_wp * ( ny + 1 + nx + 1 ), KIND = wp )
12662    ref_mconc(nzb:nzt,:) = ref_mconc(nzb:nzt,:) / REAL( 2.0_wp * ( ny + 1 + nx + 1 ), KIND = wp )
12663    ref_nconc(nzb:nzt,:) = ref_nconc(nzb:nzt,:) / REAL( 2.0_wp * ( ny + 1 + nx + 1 ), KIND = wp )
12664!
12665!-- Derived from top boundary
12666    IF ( .NOT. salsa_gases_from_chem )                                                             &
12667       ref_gconc(nzt+1,:) = ref_gconc(nzt+1,:) / REAL( ( ny + 1 ) * ( nx + 1 ), KIND = wp )
12668    ref_mconc(nzt+1,:) = ref_mconc(nzt+1,:) / REAL( ( ny + 1 ) * ( nx + 1 ), KIND = wp )
12669    ref_nconc(nzt+1,:) = ref_nconc(nzt+1,:) / REAL( ( ny + 1 ) * ( nx + 1 ), KIND = wp )
12670!
12671!-- Write onto init profiles, which are used for damping. Also set lower boundary condition.
12672    DO  ib = 1, nbins_aerosol
12673       aerosol_number(ib)%init(:)   = ref_nconc(:,ib)
12674       aerosol_number(ib)%init(nzb) = aerosol_number(ib)%init(nzb+1)
12675       DO  ic = 1, ncomponents_mass
12676          icc = ( ic-1 ) * nbins_aerosol + ib
12677          aerosol_mass(icc)%init(:)   = ref_mconc(:,icc)
12678          aerosol_mass(icc)%init(nzb) = aerosol_mass(icc)%init(nzb+1)
12679       ENDDO
12680    ENDDO
12681    IF ( .NOT. salsa_gases_from_chem )  THEN
12682       DO  ig = 1, ngases_salsa
12683          salsa_gas(ig)%init(:)   = ref_gconc(:,ig)
12684          salsa_gas(ig)%init(nzb) = salsa_gas(ig)%init(nzb+1)
12685       ENDDO
12686    ENDIF
12687
12688    DEALLOCATE( ref_gconc, ref_gconc_l, ref_mconc, ref_mconc_l, ref_nconc, ref_nconc_l )
12689
12690 END SUBROUTINE salsa_nesting_offl_bc
12691
12692!------------------------------------------------------------------------------!
12693! Description:
12694! ------------
12695!> Allocate arrays used to read boundary data from NetCDF file and initialize
12696!> boundary data.
12697!------------------------------------------------------------------------------!
12698 SUBROUTINE salsa_nesting_offl_init
12699
12700    USE control_parameters,                                                                        &
12701        ONLY:  end_time, initializing_actions, spinup_time
12702
12703    USE palm_date_time_mod,                                                                        &
12704        ONLY:  get_date_time
12705
12706    IMPLICIT NONE
12707
12708    INTEGER(iwp) ::  ib          !< running index for aerosol number bins
12709    INTEGER(iwp) ::  ic          !< running index for aerosol mass bins
12710    INTEGER(iwp) ::  icc         !< additional running index for aerosol mass bins
12711    INTEGER(iwp) ::  ig          !< running index for gaseous species
12712    INTEGER(iwp) ::  nmass_bins  !< number of aerosol mass bins
12713
12714    nmass_bins = nbins_aerosol * ncomponents_mass
12715!
12716!-- Allocate arrays for reading boundary values. Arrays will incorporate 2 time levels in order to
12717!-- interpolate in between.
12718    IF ( nesting_offline_salsa )  THEN
12719       IF ( bc_dirichlet_l )  THEN
12720          ALLOCATE( salsa_nest_offl%nconc_left(0:1,nzb+1:nzt,nys:nyn,1:nbins_aerosol) )
12721          ALLOCATE( salsa_nest_offl%mconc_left(0:1,nzb+1:nzt,nys:nyn,1:nmass_bins) )
12722       ENDIF
12723       IF ( bc_dirichlet_r )  THEN
12724          ALLOCATE( salsa_nest_offl%nconc_right(0:1,nzb+1:nzt,nys:nyn,1:nbins_aerosol) )
12725          ALLOCATE( salsa_nest_offl%mconc_right(0:1,nzb+1:nzt,nys:nyn,1:nmass_bins) )
12726       ENDIF
12727       IF ( bc_dirichlet_n )  THEN
12728          ALLOCATE( salsa_nest_offl%nconc_north(0:1,nzb+1:nzt,nxl:nxr,1:nbins_aerosol) )
12729          ALLOCATE( salsa_nest_offl%mconc_north(0:1,nzb+1:nzt,nxl:nxr,1:nmass_bins) )
12730       ENDIF
12731       IF ( bc_dirichlet_s )  THEN
12732          ALLOCATE( salsa_nest_offl%nconc_south(0:1,nzb+1:nzt,nxl:nxr,1:nbins_aerosol) )
12733          ALLOCATE( salsa_nest_offl%mconc_south(0:1,nzb+1:nzt,nxl:nxr,1:nmass_bins) )
12734       ENDIF
12735       ALLOCATE( salsa_nest_offl%nconc_top(0:1,nys:nyn,nxl:nxr,1:nbins_aerosol) )
12736       ALLOCATE( salsa_nest_offl%mconc_top(0:1,nys:nyn,nxl:nxr,1:nmass_bins) )
12737
12738       IF ( .NOT. salsa_gases_from_chem )  THEN
12739          IF ( bc_dirichlet_l )  THEN
12740             ALLOCATE( salsa_nest_offl%gconc_left(0:1,nzb+1:nzt,nys:nyn,1:ngases_salsa) )
12741          ENDIF
12742          IF ( bc_dirichlet_r )  THEN
12743             ALLOCATE( salsa_nest_offl%gconc_right(0:1,nzb+1:nzt,nys:nyn,1:ngases_salsa) )
12744          ENDIF
12745          IF ( bc_dirichlet_n )  THEN
12746             ALLOCATE( salsa_nest_offl%gconc_north(0:1,nzb+1:nzt,nxl:nxr,1:ngases_salsa) )
12747          ENDIF
12748          IF ( bc_dirichlet_s )  THEN
12749             ALLOCATE( salsa_nest_offl%gconc_south(0:1,nzb+1:nzt,nxl:nxr,1:ngases_salsa) )
12750          ENDIF
12751          ALLOCATE( salsa_nest_offl%gconc_top(0:1,nys:nyn,nxl:nxr,1:ngases_salsa) )
12752       ENDIF
12753
12754!
12755!--    Read data at lateral and top boundaries from a larger-scale model
12756       CALL salsa_nesting_offl_input
12757!
12758!--    Check if sufficient time steps are provided to cover the entire simulation. Note, dynamic
12759!--    input is only required for the 3D simulation, not for the soil/wall spinup. However, as the
12760!--    spinup time is added to the end_time, this must be considered here.
12761       IF ( end_time - spinup_time > salsa_nest_offl%time(salsa_nest_offl%nt-1) )  THEN
12762          message_string = 'end_time of the simulation exceeds the time dimension in the dynamic'//&
12763                           ' input file.'
12764          CALL message( 'salsa_nesting_offl_init', 'PA0690', 1, 2, 0, 6, 0 ) 
12765       ENDIF
12766
12767       IF ( salsa_nest_offl%time(0) /= 0.0_wp )  THEN
12768          message_string = 'Offline nesting: time dimension must start at 0.0.'
12769          CALL message( 'salsa_nesting_offl_init', 'PA0691', 1, 2, 0, 6, 0 )
12770       ENDIF
12771!
12772!--    Initialize boundary data. Please note, do not initialize boundaries in case of restart runs.
12773       IF ( TRIM( initializing_actions ) /= 'read_restart_data'  .AND.  read_restart_data_salsa )  &
12774       THEN
12775          IF ( bc_dirichlet_l )  THEN
12776             DO  ib = 1, nbins_aerosol
12777                aerosol_number(ib)%conc(nzb+1:nzt,nys:nyn,-1) =                                    &
12778                                                 salsa_nest_offl%nconc_left(0,nzb+1:nzt,nys:nyn,ib)
12779                DO  ic = 1, ncomponents_mass
12780                   icc = ( ic - 1 ) * nbins_aerosol + ib
12781                   aerosol_mass(icc)%conc(nzb+1:nzt,nys:nyn,-1) =                                  &
12782                                                 salsa_nest_offl%mconc_left(0,nzb+1:nzt,nys:nyn,icc)
12783                ENDDO
12784             ENDDO
12785             DO  ig = 1, ngases_salsa
12786                salsa_gas(ig)%conc(nzb+1:nzt,nys:nyn,-1) =                                         &
12787                                                 salsa_nest_offl%gconc_left(0,nzb+1:nzt,nys:nyn,ig)
12788             ENDDO
12789          ENDIF
12790          IF ( bc_dirichlet_r )  THEN
12791             DO  ib = 1, nbins_aerosol
12792                aerosol_number(ib)%conc(nzb+1:nzt,nys:nyn,nxr+1) =                                 &
12793                                                salsa_nest_offl%nconc_right(0,nzb+1:nzt,nys:nyn,ib)
12794                DO  ic = 1, ncomponents_mass
12795                   icc = ( ic - 1 ) * nbins_aerosol + ib
12796                   aerosol_mass(icc)%conc(nzb+1:nzt,nys:nyn,nxr+1) =                               &
12797                                                salsa_nest_offl%mconc_right(0,nzb+1:nzt,nys:nyn,icc)
12798                ENDDO
12799             ENDDO
12800             DO  ig = 1, ngases_salsa
12801                salsa_gas(ig)%conc(nzb+1:nzt,nys:nyn,nxr+1) =                                      &
12802                                                 salsa_nest_offl%gconc_right(0,nzb+1:nzt,nys:nyn,ig)
12803             ENDDO
12804          ENDIF
12805          IF ( bc_dirichlet_n )  THEN
12806             DO  ib = 1, nbins_aerosol
12807                aerosol_number(ib)%conc(nzb+1:nzt,nyn+1,nxl:nxr) =                                 &
12808                                                salsa_nest_offl%nconc_north(0,nzb+1:nzt,nxl:nxr,ib)
12809                DO  ic = 1, ncomponents_mass
12810                   icc = ( ic - 1 ) * nbins_aerosol + ib
12811                   aerosol_mass(icc)%conc(nzb+1:nzt,nyn+1,nxl:nxr) =                               &
12812                                                salsa_nest_offl%mconc_north(0,nzb+1:nzt,nxl:nxr,icc)
12813                ENDDO
12814             ENDDO
12815             DO  ig = 1, ngases_salsa
12816                salsa_gas(ig)%conc(nzb+1:nzt,nyn+1,nxl:nxr) =                                      &
12817                                                 salsa_nest_offl%gconc_north(0,nzb+1:nzt,nxl:nxr,ig)
12818             ENDDO
12819          ENDIF
12820          IF ( bc_dirichlet_s )  THEN
12821             DO  ib = 1, nbins_aerosol
12822                aerosol_number(ib)%conc(nzb+1:nzt,-1,nxl:nxr) =                                    &
12823                                                salsa_nest_offl%nconc_south(0,nzb+1:nzt,nxl:nxr,ib)
12824                DO  ic = 1, ncomponents_mass
12825                   icc = ( ic - 1 ) * nbins_aerosol + ib
12826                   aerosol_mass(icc)%conc(nzb+1:nzt,-1,nxl:nxr) =                                  &
12827                                                salsa_nest_offl%mconc_south(0,nzb+1:nzt,nxl:nxr,icc)
12828                ENDDO
12829             ENDDO
12830             DO  ig = 1, ngases_salsa
12831                salsa_gas(ig)%conc(nzb+1:nzt,-1,nxl:nxr) =                                         &
12832                                                 salsa_nest_offl%gconc_south(0,nzb+1:nzt,nxl:nxr,ig)
12833             ENDDO
12834          ENDIF
12835       ENDIF
12836    ENDIF
12837
12838 END SUBROUTINE salsa_nesting_offl_init
12839
12840!------------------------------------------------------------------------------!
12841! Description:
12842! ------------
12843!> Set the lateral and top boundary conditions in case the PALM domain is
12844!> nested offline in a mesoscale model. Further, average boundary data and
12845!> determine mean profiles, further used for correct damping in the sponge
12846!> layer.
12847!------------------------------------------------------------------------------!
12848 SUBROUTINE salsa_nesting_offl_input
12849
12850    USE netcdf_data_input_mod,                                                                     &
12851        ONLY:  check_existence, close_input_file, get_attribute, get_variable,                     &
12852               inquire_num_variables, inquire_variable_names,                                      &
12853               get_dimension_length, open_read_file
12854
12855    IMPLICIT NONE
12856
12857    CHARACTER(LEN=25) ::  vname  !< variable name
12858
12859    INTEGER(iwp) ::  ic        !< running index for aerosol chemical components
12860    INTEGER(iwp) ::  ig        !< running index for gases
12861    INTEGER(iwp) ::  num_vars  !< number of variables in netcdf input file
12862
12863!
12864!-- Skip input if no forcing from larger-scale models is applied.
12865    IF ( .NOT. nesting_offline_salsa )  RETURN
12866!
12867!-- Initialise
12868    IF ( .NOT. salsa_nest_offl%init )  THEN
12869
12870#if defined ( __netcdf )
12871!
12872!--    Open file in read-only mode
12873       CALL open_read_file( TRIM( input_file_dynamic ) // TRIM( coupling_char ),                   &
12874                            salsa_nest_offl%id_dynamic )
12875!
12876!--    At first, inquire all variable names.
12877       CALL inquire_num_variables( salsa_nest_offl%id_dynamic, num_vars )
12878!
12879!--    Allocate memory to store variable names.
12880       ALLOCATE( salsa_nest_offl%var_names(1:num_vars) )
12881       CALL inquire_variable_names( salsa_nest_offl%id_dynamic, salsa_nest_offl%var_names )
12882!
12883!--    Read time dimension, allocate memory and finally read time array
12884       CALL get_dimension_length( salsa_nest_offl%id_dynamic, salsa_nest_offl%nt,&
12885                                                    'time' )
12886
12887       IF ( check_existence( salsa_nest_offl%var_names, 'time' ) )  THEN
12888          ALLOCATE( salsa_nest_offl%time(0:salsa_nest_offl%nt-1) )
12889          CALL get_variable( salsa_nest_offl%id_dynamic, 'time', salsa_nest_offl%time )
12890       ENDIF
12891!
12892!--    Read the vertical dimension
12893       CALL get_dimension_length( salsa_nest_offl%id_dynamic, salsa_nest_offl%nzu, 'z' )
12894       ALLOCATE( salsa_nest_offl%zu_atmos(1:salsa_nest_offl%nzu) )
12895       CALL get_variable( salsa_nest_offl%id_dynamic, 'z', salsa_nest_offl%zu_atmos )
12896!
12897!--    Read the number of aerosol chemical components
12898       CALL get_dimension_length( salsa_nest_offl%id_dynamic, salsa_nest_offl%ncc,                 &
12899                                  'composition_index' )
12900!
12901!--    Read the names of aerosol chemical components
12902       CALL get_variable( salsa_nest_offl%id_dynamic, 'composition_name', salsa_nest_offl%cc_name, &
12903                          salsa_nest_offl%ncc )
12904!
12905!--    Define the index of each chemical component in the model
12906       DO  ic = 1, salsa_nest_offl%ncc
12907          SELECT CASE ( TRIM( salsa_nest_offl%cc_name(ic) ) )
12908             CASE ( 'H2SO4', 'SO4', 'h2so4', 'so4' )
12909                salsa_nest_offl%cc_in2mod(1) = ic
12910             CASE ( 'OC', 'oc' )
12911                salsa_nest_offl%cc_in2mod(2) = ic
12912             CASE ( 'BC', 'bc' )
12913                salsa_nest_offl%cc_in2mod(3) = ic
12914             CASE ( 'DU', 'du' )
12915                salsa_nest_offl%cc_in2mod(4) = ic
12916             CASE ( 'SS', 'ss' )
12917                salsa_nest_offl%cc_in2mod(5) = ic
12918             CASE ( 'HNO3', 'hno3', 'NO3', 'no3', 'NO', 'no' )
12919                salsa_nest_offl%cc_in2mod(6) = ic
12920             CASE ( 'NH3', 'nh3', 'NH4', 'nh4', 'NH', 'nh' )
12921                salsa_nest_offl%cc_in2mod(7) = ic
12922          END SELECT
12923       ENDDO
12924       IF ( SUM( salsa_nest_offl%cc_in2mod ) == 0 )  THEN
12925          message_string = 'None of the aerosol chemical components in ' //                        &
12926                           TRIM( input_file_dynamic ) // ' correspond to ones applied in SALSA.'
12927          CALL message( 'salsa_mod: salsa_nesting_offl_input', 'PA0693', 2, 2, 0, 6, 0 )
12928       ENDIF
12929       
12930       CALL close_input_file( salsa_nest_offl%id_dynamic )
12931#endif
12932    ENDIF
12933!
12934!-- Check if dynamic driver data input is required.
12935    IF ( salsa_nest_offl%time(salsa_nest_offl%tind_p) <= MAX( time_since_reference_point, 0.0_wp)  &
12936         .OR.  .NOT.  salsa_nest_offl%init )  THEN
12937       CONTINUE
12938!
12939!-- Return otherwise
12940    ELSE
12941       RETURN
12942    ENDIF
12943!
12944!-- Obtain time index for current point in time.
12945    salsa_nest_offl%tind = MINLOC( ABS( salsa_nest_offl%time -                                     &
12946                                   MAX( time_since_reference_point, 0.0_wp ) ), DIM = 1 ) - 1
12947    salsa_nest_offl%tind_p = salsa_nest_offl%tind + 1
12948!
12949!-- Open file in read-only mode
12950#if defined ( __netcdf )
12951
12952    CALL open_read_file( TRIM( input_file_dynamic ) // TRIM( coupling_char ),                      &
12953                         salsa_nest_offl%id_dynamic )
12954!
12955!-- Read data at the western boundary
12956    CALL get_variable( salsa_nest_offl%id_dynamic, 'ls_forcing_left_aerosol',                      &
12957                       salsa_nest_offl%nconc_left,                                                 &
12958                       MERGE( 0, 1, bc_dirichlet_l ), MERGE( nbins_aerosol-1, 0, bc_dirichlet_l ), &
12959                       MERGE( nys, 1, bc_dirichlet_l ), MERGE( nyn, 0, bc_dirichlet_l ),           &
12960                       MERGE( nzb, 1, bc_dirichlet_l ), MERGE( nzt-1, 0, bc_dirichlet_l ),         &
12961                       MERGE( salsa_nest_offl%tind,   1, bc_dirichlet_l ),                         &
12962                       MERGE( salsa_nest_offl%tind_p, 0, bc_dirichlet_l  ) )
12963    IF ( bc_dirichlet_l )  THEN
12964       salsa_nest_offl%nconc_left = MAX( nclim, salsa_nest_offl%nconc_left )
12965       CALL nesting_offl_aero_mass( salsa_nest_offl%tind, salsa_nest_offl%tind_p, nzb+1, nzt, nys, &
12966                                    nyn, 'ls_forcing_left_mass_fracs_a', 1 )
12967    ENDIF
12968    IF ( .NOT. salsa_gases_from_chem )  THEN
12969       DO  ig = 1, ngases_salsa
12970          vname = salsa_nest_offl%char_l // salsa_nest_offl%gas_name(ig)
12971          CALL get_variable( salsa_nest_offl%id_dynamic, TRIM( vname ),                            &
12972                             salsa_nest_offl%gconc_left(:,:,:,ig),                                 &
12973                             MERGE( nys, 1, bc_dirichlet_l ), MERGE( nyn, 0, bc_dirichlet_l ),     &
12974                             MERGE( nzb, 1, bc_dirichlet_l ), MERGE( nzt-1, 0, bc_dirichlet_l ),   &
12975                             MERGE( salsa_nest_offl%tind,   1, bc_dirichlet_l ),                   &
12976                             MERGE( salsa_nest_offl%tind_p, 0, bc_dirichlet_l ) )
12977          IF ( bc_dirichlet_l )  salsa_nest_offl%gconc_left(:,:,:,ig) =                            &
12978                                                  MAX( nclim, salsa_nest_offl%gconc_left(:,:,:,ig) )
12979       ENDDO
12980    ENDIF
12981!
12982!-- Read data at the eastern boundary
12983    CALL get_variable( salsa_nest_offl%id_dynamic, 'ls_forcing_right_aerosol',                     &
12984                       salsa_nest_offl%nconc_right,                                                &
12985                       MERGE( 0, 1, bc_dirichlet_r ), MERGE( nbins_aerosol-1, 0, bc_dirichlet_r ), &
12986                       MERGE( nys, 1, bc_dirichlet_r ), MERGE( nyn, 0, bc_dirichlet_r ),           &
12987                       MERGE( nzb, 1, bc_dirichlet_r ), MERGE( nzt-1, 0, bc_dirichlet_r ),         &
12988                       MERGE( salsa_nest_offl%tind,   1, bc_dirichlet_r ),                         &
12989                       MERGE( salsa_nest_offl%tind_p, 0, bc_dirichlet_r ) )
12990    IF ( bc_dirichlet_r )  THEN
12991       salsa_nest_offl%nconc_right = MAX( nclim, salsa_nest_offl%nconc_right )
12992       CALL nesting_offl_aero_mass( salsa_nest_offl%tind, salsa_nest_offl%tind_p, nzb+1, nzt, nys, &
12993                                    nyn, 'ls_forcing_right_mass_fracs_a', 2 )
12994    ENDIF
12995    IF ( .NOT. salsa_gases_from_chem )  THEN
12996       DO  ig = 1, ngases_salsa
12997          vname = salsa_nest_offl%char_r // salsa_nest_offl%gas_name(ig)
12998          CALL get_variable( salsa_nest_offl%id_dynamic, TRIM( vname ),                            &
12999                             salsa_nest_offl%gconc_right(:,:,:,ig),                                &
13000                             MERGE( nys, 1, bc_dirichlet_r ), MERGE( nyn, 0, bc_dirichlet_r ),     &
13001                             MERGE( nzb, 1, bc_dirichlet_r ), MERGE( nzt-1, 0, bc_dirichlet_r ),   &
13002                             MERGE( salsa_nest_offl%tind,   1, bc_dirichlet_r ),                   &
13003                             MERGE( salsa_nest_offl%tind_p, 0, bc_dirichlet_r ) )
13004          IF ( bc_dirichlet_r )  salsa_nest_offl%gconc_right(:,:,:,ig) =                           &
13005                                                 MAX( nclim, salsa_nest_offl%gconc_right(:,:,:,ig) )
13006       ENDDO
13007    ENDIF
13008!
13009!-- Read data at the northern boundary
13010    CALL get_variable( salsa_nest_offl%id_dynamic, 'ls_forcing_north_aerosol',                     &
13011                       salsa_nest_offl%nconc_north,                                                &
13012                       MERGE( 0, 1, bc_dirichlet_n ), MERGE( nbins_aerosol-1, 0, bc_dirichlet_n ), &
13013                       MERGE( nxl, 1, bc_dirichlet_n ), MERGE( nxr, 0, bc_dirichlet_n ),           &
13014                       MERGE( nzb, 1, bc_dirichlet_n ), MERGE( nzt-1, 0, bc_dirichlet_n ),         &
13015                       MERGE( salsa_nest_offl%tind,   1, bc_dirichlet_n ),                         &
13016                       MERGE( salsa_nest_offl%tind_p, 0, bc_dirichlet_n ) )
13017    IF ( bc_dirichlet_n )  THEN
13018       salsa_nest_offl%nconc_north = MAX( nclim, salsa_nest_offl%nconc_north )
13019       CALL nesting_offl_aero_mass( salsa_nest_offl%tind, salsa_nest_offl%tind_p, nzb+1, nzt, nxl, &
13020                                    nxr, 'ls_forcing_north_mass_fracs_a', 3 )
13021    ENDIF
13022    IF ( .NOT. salsa_gases_from_chem )  THEN
13023       DO  ig = 1, ngases_salsa
13024          vname = salsa_nest_offl%char_n // salsa_nest_offl%gas_name(ig)
13025          CALL get_variable( salsa_nest_offl%id_dynamic, TRIM( vname ),                            &
13026                             salsa_nest_offl%gconc_north(:,:,:,ig),                                &
13027                             MERGE( nxl, 1, bc_dirichlet_n ), MERGE( nxr, 0, bc_dirichlet_n ),     &
13028                             MERGE( nzb, 1, bc_dirichlet_n ), MERGE( nzt-1, 0, bc_dirichlet_n ),   &
13029                             MERGE( salsa_nest_offl%tind,   1, bc_dirichlet_n ),                   &
13030                             MERGE( salsa_nest_offl%tind_p, 0, bc_dirichlet_n ) )
13031          IF ( bc_dirichlet_n )  salsa_nest_offl%gconc_north(:,:,:,ig) =                           &
13032                                                 MAX( nclim, salsa_nest_offl%gconc_north(:,:,:,ig) )
13033       ENDDO
13034    ENDIF
13035!
13036!-- Read data at the southern boundary
13037    CALL get_variable( salsa_nest_offl%id_dynamic, 'ls_forcing_south_aerosol',                     &
13038                       salsa_nest_offl%nconc_south,                                                &
13039                       MERGE( 0, 1, bc_dirichlet_s ), MERGE( nbins_aerosol-1, 0, bc_dirichlet_s ), &
13040                       MERGE( nxl, 1, bc_dirichlet_s ), MERGE( nxr, 0, bc_dirichlet_s ),           &
13041                       MERGE( nzb, 1, bc_dirichlet_s ), MERGE( nzt-1, 0, bc_dirichlet_s ),         &
13042                       MERGE( salsa_nest_offl%tind,   1, bc_dirichlet_s ),                         &
13043                       MERGE( salsa_nest_offl%tind_p, 0, bc_dirichlet_s ) )
13044    IF ( bc_dirichlet_s )  THEN
13045       salsa_nest_offl%nconc_south = MAX( nclim, salsa_nest_offl%nconc_south )
13046       CALL nesting_offl_aero_mass( salsa_nest_offl%tind, salsa_nest_offl%tind_p, nzb+1, nzt, nxl, &
13047                                    nxr, 'ls_forcing_south_mass_fracs_a', 4 )
13048    ENDIF
13049    IF ( .NOT. salsa_gases_from_chem )  THEN
13050       DO  ig = 1, ngases_salsa
13051          vname = salsa_nest_offl%char_s // salsa_nest_offl%gas_name(ig)
13052          CALL get_variable( salsa_nest_offl%id_dynamic, TRIM( vname ),                            &
13053                             salsa_nest_offl%gconc_south(:,:,:,ig),                                &
13054                             MERGE( nxl, 1, bc_dirichlet_s ), MERGE( nxr, 0, bc_dirichlet_s ),     &
13055                             MERGE( nzb, 1, bc_dirichlet_s ), MERGE( nzt-1, 0, bc_dirichlet_s ),   &
13056                             MERGE( salsa_nest_offl%tind,   1, bc_dirichlet_s ),                   &
13057                             MERGE( salsa_nest_offl%tind_p, 0, bc_dirichlet_s ) )
13058          IF ( bc_dirichlet_s )  salsa_nest_offl%gconc_south(:,:,:,ig) =                           &
13059                                                 MAX( nclim, salsa_nest_offl%gconc_south(:,:,:,ig) )
13060       ENDDO
13061    ENDIF
13062!
13063!-- Read data at the top boundary
13064    CALL get_variable( salsa_nest_offl%id_dynamic, 'ls_forcing_top_aerosol',                       &
13065                       salsa_nest_offl%nconc_top(0:1,nys:nyn,nxl:nxr,1:nbins_aerosol),             &
13066                       0, nbins_aerosol-1, nxl, nxr, nys, nyn, salsa_nest_offl%tind,               &
13067                       salsa_nest_offl%tind_p )
13068    salsa_nest_offl%nconc_top = MAX( nclim, salsa_nest_offl%nconc_top )
13069    CALL nesting_offl_aero_mass( salsa_nest_offl%tind, salsa_nest_offl%tind_p, nys, nyn, nxl, nxr, &
13070                                 'ls_forcing_top_mass_fracs_a', 5 )
13071    IF ( .NOT. salsa_gases_from_chem )  THEN
13072       DO  ig = 1, ngases_salsa
13073          vname = salsa_nest_offl%char_t // salsa_nest_offl%gas_name(ig)
13074          CALL get_variable( salsa_nest_offl%id_dynamic, TRIM( vname ),                            &
13075                             salsa_nest_offl%gconc_top(:,:,:,ig), nxl, nxr, nys, nyn,              &
13076                             salsa_nest_offl%tind, salsa_nest_offl%tind_p )
13077          salsa_nest_offl%gconc_top(:,:,:,ig) = MAX( nclim, salsa_nest_offl%gconc_top(:,:,:,ig) )
13078       ENDDO
13079    ENDIF
13080!
13081!-- Close input file
13082    CALL close_input_file( salsa_nest_offl%id_dynamic )
13083
13084#endif
13085!
13086!-- Set control flag to indicate that initialization is already done
13087    salsa_nest_offl%init = .TRUE.
13088
13089 END SUBROUTINE salsa_nesting_offl_input
13090
13091!------------------------------------------------------------------------------!
13092! Description:
13093! ------------
13094!> Sets the mass concentrations to aerosol arrays in 2a and 2b.
13095!------------------------------------------------------------------------------!
13096 SUBROUTINE nesting_offl_aero_mass( ts, te, ks, ke, is, ie, varname_a, ibound )
13097
13098    USE netcdf_data_input_mod,                                                                     &
13099        ONLY:  get_variable
13100
13101    IMPLICIT NONE
13102
13103    CHARACTER(LEN=25) ::  varname_b  !< name for bins b
13104
13105    CHARACTER(LEN=*), INTENT(in) ::  varname_a  !< name for bins a
13106
13107    INTEGER(iwp) ::  ee                !< loop index: end
13108    INTEGER(iwp) ::  i                 !< loop index
13109    INTEGER(iwp) ::  ib                !< loop index
13110    INTEGER(iwp) ::  ic                !< loop index
13111    INTEGER(iwp) ::  k                 !< loop index
13112    INTEGER(iwp) ::  ss                !< loop index: start
13113    INTEGER(iwp) ::  t                 !< loop index
13114    INTEGER(iwp) ::  type_so4_oc = -1  !<
13115
13116    INTEGER(iwp), INTENT(in) ::  ibound  !< index: 1=left, 2=right, 3=north, 4=south, 5=top
13117    INTEGER(iwp), INTENT(in) ::  ie      !< loop index
13118    INTEGER(iwp), INTENT(in) ::  is      !< loop index
13119    INTEGER(iwp), INTENT(in) ::  ks      !< loop index
13120    INTEGER(iwp), INTENT(in) ::  ke      !< loop index
13121    INTEGER(iwp), INTENT(in) ::  ts      !< loop index
13122    INTEGER(iwp), INTENT(in) ::  te      !< loop index
13123
13124    INTEGER(iwp), DIMENSION(maxspec) ::  cc_i2m   !<
13125
13126    REAL(wp) ::  pmf1a !< mass fraction in 1a
13127
13128    REAL(wp), DIMENSION(nbins_aerosol) ::  core   !< size of the bin mid aerosol particle
13129
13130    REAL(wp), DIMENSION(0:1,ks:ke,is:ie,1:nbins_aerosol) ::  to_nconc                   !<
13131    REAL(wp), DIMENSION(0:1,ks:ke,is:ie,1:nbins_aerosol*ncomponents_mass) ::  to_mconc  !<
13132
13133    REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE ::  mf2a !< Mass distributions for a
13134    REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE ::  mf2b !< and b bins
13135
13136!
13137!-- Variable name for insoluble mass fraction
13138    varname_b = varname_a(1:LEN( TRIM( varname_a ) ) - 1 ) // 'b'
13139!
13140!-- Bin mean aerosol particle volume (m3)
13141    core(1:nbins_aerosol) = api6 * aero(1:nbins_aerosol)%dmid**3
13142!
13143!-- Allocate and read mass fraction arrays
13144    ALLOCATE( mf2a(0:1,ks:ke,is:ie,1:salsa_nest_offl%ncc),                                         &
13145              mf2b(0:1,ks:ke,is:ie,1:salsa_nest_offl%ncc) )
13146    IF ( ibound == 5 )  THEN
13147       CALL get_variable( salsa_nest_offl%id_dynamic, varname_a,                                   &
13148                          mf2a(0:1,ks:ke,is:ie,1:salsa_nest_offl%ncc), 0, salsa_nest_offl%ncc-1,   &
13149                          is, ie, ks, ke, ts, te )
13150    ELSE
13151       CALL get_variable( salsa_nest_offl%id_dynamic, varname_a,                                   &
13152                          mf2a(0:1,ks:ke,is:ie,1:salsa_nest_offl%ncc), 0, salsa_nest_offl%ncc-1,   &
13153                          is, ie, ks-1, ke-1, ts, te )
13154    ENDIF
13155!
13156!-- If the chemical component is not activated, set its mass fraction to 0 to avoid mass inbalance
13157    cc_i2m = salsa_nest_offl%cc_in2mod
13158    IF ( index_so4 < 0  .AND. cc_i2m(1) > 0 )  mf2a(:,:,:,cc_i2m(1)) = 0.0_wp
13159    IF ( index_oc < 0   .AND. cc_i2m(2) > 0 )  mf2a(:,:,:,cc_i2m(2)) = 0.0_wp
13160    IF ( index_bc < 0   .AND. cc_i2m(3) > 0 )  mf2a(:,:,:,cc_i2m(3)) = 0.0_wp
13161    IF ( index_du < 0   .AND. cc_i2m(4) > 0 )  mf2a(:,:,:,cc_i2m(4)) = 0.0_wp
13162    IF ( index_ss < 0   .AND. cc_i2m(5) > 0 )  mf2a(:,:,:,cc_i2m(5)) = 0.0_wp
13163    IF ( index_no < 0   .AND. cc_i2m(6) > 0 )  mf2a(:,:,:,cc_i2m(6)) = 0.0_wp
13164    IF ( index_nh < 0   .AND. cc_i2m(7) > 0 )  mf2a(:,:,:,cc_i2m(7)) = 0.0_wp
13165    mf2b = 0.0_wp
13166!
13167!-- Initialise variable type_so4_oc to indicate whether SO4 and/OC is included in mass fraction data
13168    IF ( ( cc_i2m(1) > 0  .AND.  index_so4 > 0 )  .AND. ( cc_i2m(2) > 0  .AND.  index_oc > 0 ) )   &
13169    THEN
13170       type_so4_oc = 1
13171    ELSEIF ( cc_i2m(1) > 0  .AND.  index_so4 > 0 )  THEN
13172       type_so4_oc = 2
13173    ELSEIF ( cc_i2m(2) > 0  .AND.  index_oc > 0 )  THEN
13174       type_so4_oc = 3
13175    ENDIF
13176
13177    SELECT CASE ( ibound )
13178       CASE( 1 )
13179          to_nconc = salsa_nest_offl%nconc_left
13180          to_mconc = salsa_nest_offl%mconc_left
13181       CASE( 2 )
13182          to_nconc = salsa_nest_offl%nconc_right
13183          to_mconc = salsa_nest_offl%mconc_right
13184       CASE( 3 )
13185          to_nconc = salsa_nest_offl%nconc_north
13186          to_mconc = salsa_nest_offl%mconc_north
13187       CASE( 4 )
13188          to_nconc = salsa_nest_offl%nconc_south
13189          to_mconc = salsa_nest_offl%mconc_south
13190       CASE( 5 )
13191          to_nconc = salsa_nest_offl%nconc_top
13192          to_mconc = salsa_nest_offl%mconc_top
13193    END SELECT
13194!
13195!-- Set mass concentrations:
13196!
13197!-- Regime 1:
13198    SELECT CASE ( type_so4_oc )
13199       CASE ( 1 )  ! Both SO4 and OC given
13200
13201          ss = ( index_so4 - 1 ) * nbins_aerosol + start_subrange_1a  ! start
13202          ee = ( index_so4 - 1 ) * nbins_aerosol + end_subrange_1a    ! end
13203          ib = start_subrange_1a
13204          DO  ic = ss, ee
13205             DO i = is, ie
13206                DO k = ks, ke
13207                   DO t = 0, 1
13208                      pmf1a = mf2a(t,k,i,cc_i2m(1)) / ( mf2a(t,k,i,cc_i2m(1)) + mf2a(t,k,i,cc_i2m(2)) )
13209                      to_mconc(t,k,i,ic) = pmf1a * to_nconc(t,k,i,ib) * core(ib) * arhoh2so4
13210                   ENDDO
13211                ENDDO
13212             ENDDO
13213             ib = ib + 1
13214          ENDDO
13215          ss = ( index_oc - 1 ) * nbins_aerosol + start_subrange_1a ! start
13216          ee = ( index_oc - 1 ) * nbins_aerosol + end_subrange_1a   ! end
13217          ib = start_subrange_1a
13218          DO  ic = ss, ee
13219             DO i = is, ie
13220                DO k = ks, ke
13221                   DO t = 0, 1
13222                      pmf1a = mf2a(t,k,i,cc_i2m(2)) / ( mf2a(t,k,i,cc_i2m(1)) + mf2a(t,k,i,cc_i2m(2)) )
13223                      to_mconc(t,k,i,ic) = pmf1a * to_nconc(t,k,i,ib) * core(ib) * arhooc
13224                   ENDDO
13225                ENDDO
13226             ENDDO
13227             ib = ib + 1
13228          ENDDO
13229       CASE ( 2 )  ! Only SO4
13230          ss = ( index_so4 - 1 ) * nbins_aerosol + start_subrange_1a  ! start
13231          ee = ( index_so4 - 1 ) * nbins_aerosol + end_subrange_1a    ! end
13232          ib = start_subrange_1a
13233          DO  ic = ss, ee
13234             DO i = is, ie
13235                DO k = ks, ke
13236                   DO t = 0, 1
13237                      to_mconc(t,k,i,ic) = to_nconc(t,k,i,ib) * core(ib) * arhoh2so4
13238                   ENDDO
13239                ENDDO
13240             ENDDO
13241             ib = ib + 1
13242          ENDDO
13243       CASE ( 3 )  ! Only OC
13244          ss = ( index_oc - 1 ) * nbins_aerosol + start_subrange_1a ! start
13245          ee = ( index_oc - 1 ) * nbins_aerosol + end_subrange_1a   ! end
13246          ib = start_subrange_1a
13247          DO  ic = ss, ee
13248             DO i = is, ie
13249                DO k = ks, ke
13250                   DO t = 0, 1
13251                      to_mconc(t,k,i,ic) = to_nconc(t,k,i,ib) * core(ib) * arhooc
13252                   ENDDO
13253                ENDDO
13254             ENDDO
13255             ib = ib + 1
13256          ENDDO
13257    END SELECT
13258!
13259!-- Regimes 2a and 2b:
13260    IF ( index_so4 > 0 ) THEN
13261       CALL set_nest_mass( index_so4, 1, arhoh2so4 )
13262    ENDIF
13263    IF ( index_oc > 0 ) THEN
13264       CALL set_nest_mass( index_oc, 2, arhooc )
13265    ENDIF
13266    IF ( index_bc > 0 ) THEN
13267       CALL set_nest_mass( index_bc, 3, arhobc )
13268    ENDIF
13269    IF ( index_du > 0 ) THEN
13270       CALL set_nest_mass( index_du, 4, arhodu )
13271    ENDIF
13272    IF ( index_ss > 0 ) THEN
13273       CALL set_nest_mass( index_ss, 5, arhoss )
13274    ENDIF
13275    IF ( index_no > 0 ) THEN
13276       CALL set_nest_mass( index_no, 6, arhohno3 )
13277    ENDIF
13278    IF ( index_nh > 0 ) THEN
13279       CALL set_nest_mass( index_nh, 7, arhonh3 )
13280    ENDIF
13281
13282    DEALLOCATE( mf2a, mf2b )
13283
13284    SELECT CASE ( ibound )
13285       CASE( 1 )
13286          salsa_nest_offl%mconc_left = to_mconc
13287       CASE( 2 )
13288          salsa_nest_offl%mconc_right = to_mconc
13289       CASE( 3 )
13290          salsa_nest_offl%mconc_north = to_mconc
13291       CASE( 4 )
13292          salsa_nest_offl%mconc_south = to_mconc
13293       CASE( 5 )
13294          salsa_nest_offl%mconc_top = to_mconc
13295    END SELECT
13296
13297    CONTAINS
13298
13299!------------------------------------------------------------------------------!
13300! Description:
13301! ------------
13302!> Set nesting boundaries for aerosol mass.
13303!------------------------------------------------------------------------------!
13304    SUBROUTINE set_nest_mass( ispec, ispec_def, prho )
13305
13306       IMPLICIT NONE
13307
13308       INTEGER(iwp) ::  ic   !< chemical component index: default
13309       INTEGER(iwp) ::  icc  !< loop index: mass bin
13310
13311       INTEGER(iwp), INTENT(in) ::  ispec      !< aerosol species index
13312       INTEGER(iwp), INTENT(in) ::  ispec_def  !< default aerosol species index
13313
13314       REAL(wp), INTENT(in) ::  prho !< aerosol density
13315!
13316!--    Define the index of the chemical component in the input data
13317       ic = salsa_nest_offl%cc_in2mod(ispec_def)
13318
13319       DO i = is, ie
13320          DO k = ks, ke
13321             DO t = 0, 1
13322!
13323!--             Regime 2a:
13324                ss = ( ispec - 1 ) * nbins_aerosol + start_subrange_2a
13325                ee = ( ispec - 1 ) * nbins_aerosol + end_subrange_2a
13326                ib = start_subrange_2a
13327                DO icc = ss, ee
13328                   to_mconc(t,k,i,icc) = MAX( 0.0_wp, mf2a(t,k,i,ic) / SUM( mf2a(t,k,i,:) ) ) *    &
13329                                         to_nconc(t,k,i,ib) * core(ib) * prho
13330                   ib = ib + 1
13331                ENDDO
13332!
13333!--             Regime 2b:
13334                IF ( .NOT. no_insoluble )  THEN
13335!
13336!--                 TODO!
13337                    mf2b(t,k,i,ic) = mf2b(t,k,i,ic)
13338                ENDIF
13339             ENDDO   ! k
13340
13341          ENDDO   ! j
13342       ENDDO   ! i
13343
13344    END SUBROUTINE set_nest_mass
13345
13346 END SUBROUTINE nesting_offl_aero_mass
13347
13348
13349 END MODULE salsa_mod
Note: See TracBrowser for help on using the repository browser.