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

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

Add logical switched nesting_chem and nesting_offline_chem

  • Property svn:keywords set to Id
File size: 603.3 KB
Line 
1!> @file salsa_mod.f90
2!--------------------------------------------------------------------------------!
3! This file is part of PALM-4U.
4!
5! PALM-4U is free software: you can redistribute it and/or modify it under the
6! terms of the GNU General Public License as published by the Free Software
7! Foundation, either version 3 of the License, or (at your option) any later
8! version.
9!
10! PALM-4U is distributed in the hope that it will be useful, but WITHOUT ANY
11! WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
12! A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
13!
14! You should have received a copy of the GNU General Public License along with
15! PALM. If not, see <http://www.gnu.org/licenses/>.
16!
17! Copyright 2018-2019 University of Helsinki
18! Copyright 1997-2019 Leibniz Universitaet Hannover
19!--------------------------------------------------------------------------------!
20!
21! Current revisions:
22! -----------------
23!
24!
25! Former revisions:
26! -----------------
27! $Id: salsa_mod.f90 4273 2019-10-24 13:40:54Z monakurppa $
28! - Rename nest_salsa to nesting_salsa
29! - Correct some errors in boundary condition flags
30! - Add a check for not trying to output gas concentrations in salsa if the
31!   chemistry module is applied
32! - Set the default value of nesting_salsa and nesting_offline_salsa to .TRUE.
33!
34! 4272 2019-10-23 15:18:57Z schwenkel
35! Further modularization of boundary conditions: moved boundary conditions to
36! respective modules
37!
38! 4270 2019-10-23 10:46:20Z monakurppa
39! - Implement offline nesting for salsa
40! - Alphabetic ordering for module interfaces
41! - Remove init_aerosol_type and init_gases_type from salsa_parin and define them
42!   based on the initializing_actions
43! - parameter definition removed from "season" and "season_z01" is added to parin
44! - bugfix in application of index_hh after implementing the new
45!   palm_date_time_mod
46! - Reformat salsa emission data with LOD=2: size distribution given for each
47!   emission category
48!
49! 4268 2019-10-17 11:29:38Z schwenkel
50! Moving module specific boundary conditions from time_integration to module
51!
52! 4256 2019-10-07 10:08:52Z monakurppa
53! Document previous changes: use global variables nx, ny and nz in salsa_header
54!
55! 4227 2019-09-10 18:04:34Z gronemeier
56! implement new palm_date_time_mod
57!
58! 4226 2019-09-10 17:03:24Z suehring
59! Netcdf input routine for dimension length renamed
60!
61! 4182 2019-08-22 15:20:23Z scharf
62! Corrected "Former revisions" section
63!
64! 4167 2019-08-16 11:01:48Z suehring
65! Changed behaviour of masked output over surface to follow terrain and ignore
66! buildings (J.Resler, T.Gronemeier)
67!
68! 4131 2019-08-02 11:06:18Z monakurppa
69! - Add "salsa_" before each salsa output variable
70! - Add a possibility to output the number (salsa_N_UFP) and mass concentration
71!   (salsa_PM0.1) of ultrafine particles, i.e. particles with a diameter smaller
72!   than 100 nm
73! - Implement aerosol emission mode "parameterized" which is based on the street
74!   type (similar to the chemistry module).
75! - Remove unnecessary nucleation subroutines.
76! - Add the z-dimension for gaseous emissions to correspond the implementation
77!   in the chemistry module
78!
79! 4118 2019-07-25 16:11:45Z suehring
80! - When Dirichlet condition is applied in decycling, the boundary conditions are
81!   only set at the ghost points and not at the prognostic grid points as done
82!   before
83! - Rename decycle_ns/lr to decycle_salsa_ns/lr and decycle_method to
84!   decycle_method_salsa
85! - Allocation and initialization of special advection flags salsa_advc_flags_s
86!   used for salsa. These are exclusively used for salsa variables to
87!   distinguish from the usually-used flags which might be different when
88!   decycling is applied in combination with cyclic boundary conditions.
89!   Moreover, salsa_advc_flags_s considers extended zones around buildings where
90!   the first-order upwind scheme is applied for the horizontal advection terms.
91!   This is done to overcome high concentration peaks due to stationary numerical
92!   oscillations caused by horizontal advection discretization.
93!
94! 4117 2019-07-25 08:54:02Z monakurppa
95! Pass integer flag array as well as boundary flags to WS scalar advection
96! routine
97!
98! 4109 2019-07-22 17:00:34Z suehring
99! Slightly revise setting of boundary conditions at horizontal walls, use
100! data-structure offset index instead of pre-calculate it for each facing
101!
102! 4079 2019-07-09 18:04:41Z suehring
103! Application of monotonic flux limiter for the vertical scalar advection
104! up to the topography top (only for the cache-optimized version at the
105! moment).
106!
107! 4069 2019-07-01 14:05:51Z Giersch
108! Masked output running index mid has been introduced as a local variable to
109! avoid runtime error (Loop variable has been modified) in time_integration
110!
111! 4058 2019-06-27 15:25:42Z knoop
112! Bugfix: to_be_resorted was uninitialized in case of s_H2O in 3d_data_averaging
113!
114! 4012 2019-05-31 15:19:05Z monakurppa
115! Merge salsa branch to trunk. List of changes:
116! - Error corrected in distr_update that resulted in the aerosol number size
117!   distribution not converging if the concentration was nclim.
118! - Added a separate output for aerosol liquid water (s_H2O)
119! - aerosol processes for a size bin are now calculated only if the aerosol
120!   number of concentration of that bin is > 2*nclim
121! - An initialisation error in the subroutine "deposition" corrected and the
122!   subroutine reformatted.
123! - stuff from salsa_util_mod.f90 moved into salsa_mod.f90
124! - calls for closing the netcdf input files added
125!
126! 3956 2019-05-07 12:32:52Z monakurppa
127! - Conceptual bug in depo_surf correct for urban and land surface model
128! - Subroutine salsa_tendency_ij optimized.
129! - Interfaces salsa_non_advective_processes and salsa_exchange_horiz_bounds
130!   created. These are now called in module_interface.
131!   salsa_exchange_horiz_bounds after calling salsa_driver only when needed
132!   (i.e. every dt_salsa).
133!
134! 3924 2019-04-23 09:33:06Z monakurppa
135! Correct a bug introduced by the previous update.
136!
137! 3899 2019-04-16 14:05:27Z monakurppa
138! - remove unnecessary error / location messages
139! - corrected some error message numbers
140! - allocate source arrays only if emissions or dry deposition is applied.
141!
142! 3885 2019-04-11 11:29:34Z kanani
143! Changes related to global restructuring of location messages and introduction
144! of additional debug messages
145!
146! 3876 2019-04-08 18:41:49Z knoop
147! Introduced salsa_actions module interface
148!
149! 3871 2019-04-08 14:38:39Z knoop
150! Major changes in formatting, performance and data input structure (see branch
151! the history for details)
152! - Time-dependent emissions enabled: lod=1 for yearly PM emissions that are
153!   normalised depending on the time, and lod=2 for preprocessed emissions
154!   (similar to the chemistry module).
155! - Additionally, 'uniform' emissions allowed. This emission is set constant on
156!   all horisontal upward facing surfaces and it is created based on parameters
157!   surface_aerosol_flux, aerosol_flux_dpg/sigmag/mass_fracs_a/mass_fracs_b.
158! - All emissions are now implemented as surface fluxes! No 3D sources anymore.
159! - Update the emission information by calling salsa_emission_update if
160!   skip_time_do_salsa >= time_since_reference_point and
161!   next_aero_emission_update <= time_since_reference_point
162! - Aerosol background concentrations read from PIDS_DYNAMIC. The vertical grid
163!   must match the one applied in the model.
164! - Gas emissions and background concentrations can be also read in in salsa_mod
165!   if the chemistry module is not applied.
166! - In deposition, information on the land use type can be now imported from
167!   the land use model
168! - Use SI units in PARIN, i.e. n_lognorm given in #/m3 and dpg in metres.
169! - Apply 100 character line limit
170! - Change all variable names from capital to lowercase letter
171! - Change real exponents to integer if possible. If not, precalculate the value
172!   value of exponent
173! - Rename in1a to start_subrange_1a, fn2a to end_subrange_1a etc.
174! - Rename nbins --> nbins_aerosol, ncc_tot --> ncomponents_mass and ngast -->
175!   ngases_salsa
176! - Rename ibc to index_bc, idu to index_du etc.
177! - Renamed loop indices b, c and sg to ib, ic and ig
178! - run_salsa subroutine removed
179! - Corrected a bud in salsa_driver: falsely applied ino instead of inh
180! - Call salsa_tendency within salsa_prognostic_equations which is called in
181!   module_interface_mod instead of prognostic_equations_mod
182! - Removed tailing white spaces and unused variables
183! - Change error message to start by PA instead of SA
184!
185! 3833 2019-03-28 15:04:04Z forkel
186! added USE chem_gasphase_mod for nvar, nspec and spc_names
187!
188! 3787 2019-03-07 08:43:54Z raasch
189! unused variables removed
190!
191! 3780 2019-03-05 11:19:45Z forkel
192! unused variable for file index removed from rrd-subroutines parameter list
193!
194! 3685 2019-01-21 01:02:11Z knoop
195! Some interface calls moved to module_interface + cleanup
196!
197! 3655 2019-01-07 16:51:22Z knoop
198! Implementation of the PALM module interface
199! 3412 2018-10-24 07:25:57Z monakurppa
200!
201! Authors:
202! --------
203! @author Mona Kurppa (University of Helsinki)
204!
205!
206! Description:
207! ------------
208!> Sectional aerosol module for large scale applications SALSA
209!> (Kokkola et al., 2008, ACP 8, 2469-2483). Solves the aerosol number and mass
210!> concentration as well as chemical composition. Includes aerosol dynamic
211!> processes: nucleation, condensation/evaporation of vapours, coagulation and
212!> deposition on tree leaves, ground and roofs.
213!> Implementation is based on formulations implemented in UCLALES-SALSA except
214!> for deposition which is based on parametrisations by Zhang et al. (2001,
215!> Atmos. Environ. 35, 549-560) or Petroff&Zhang (2010, Geosci. Model Dev. 3,
216!> 753-769)
217!>
218!> @todo Apply information from emission_stack_height to lift emission sources
219!> @todo emission mode "parameterized", i.e. based on street type
220!> @todo Allow insoluble emissions
221!> @todo Apply flux limiter in prognostic equations
222!------------------------------------------------------------------------------!
223 MODULE salsa_mod
224
225    USE basic_constants_and_equations_mod,                                                         &
226        ONLY:  c_p, g, p_0, pi, r_d
227
228    USE chem_gasphase_mod,                                                                         &
229        ONLY:  nspec, nvar, spc_names
230
231    USE chem_modules,                                                                              &
232        ONLY:  call_chem_at_all_substeps, chem_gasphase_on, chem_species
233
234    USE control_parameters,                                                                        &
235        ONLY:  air_chemistry, bc_dirichlet_l, bc_dirichlet_n, bc_dirichlet_r, bc_dirichlet_s,      &
236               bc_lr, bc_lr_cyc, bc_ns, bc_ns_cyc, bc_radiation_l, bc_radiation_n, bc_radiation_r, &
237               bc_radiation_s, coupling_char, debug_output, dt_3d, intermediate_timestep_count,    &
238               intermediate_timestep_count_max, land_surface, max_pr_salsa, message_string,        &
239               monotonic_limiter_z, plant_canopy, pt_surface, salsa, scalar_advec,                 &
240               surface_pressure, time_since_reference_point, timestep_scheme, tsc, urban_surface,  &
241               ws_scheme_sca
242
243    USE indices,                                                                                   &
244        ONLY:  nbgp, nx, nxl, nxlg, nxr, nxrg, ny, nyn, nyng, nys, nysg, nzb, nz, nzt, wall_flags_0
245
246    USE kinds
247
248    USE netcdf_data_input_mod,                                                                     &
249        ONLY:  chem_emis_att_type, chem_emis_val_type
250
251    USE pegrid
252
253    USE statistics,                                                                                &
254        ONLY:  sums_salsa_ws_l
255
256    IMPLICIT NONE
257!
258!-- SALSA constants:
259!
260!-- Local constants:
261    INTEGER(iwp), PARAMETER ::  luc_urban = 15     !< default landuse type for urban
262    INTEGER(iwp), PARAMETER ::  ngases_salsa  = 5  !< total number of gaseous tracers:
263                                                   !< 1 = H2SO4, 2 = HNO3, 3 = NH3, 4 = OCNV
264                                                   !< (non-volatile OC), 5 = OCSV (semi-volatile)
265    INTEGER(iwp), PARAMETER ::  nmod = 7     !< number of modes for initialising the aerosol size distribution
266    INTEGER(iwp), PARAMETER ::  nreg = 2     !< Number of main size subranges
267    INTEGER(iwp), PARAMETER ::  maxspec = 7  !< Max. number of aerosol species
268
269
270    REAL(wp), PARAMETER ::  fill_value = -9999.0_wp    !< value for the _FillValue attribute
271!
272!-- Universal constants
273    REAL(wp), PARAMETER ::  abo    = 1.380662E-23_wp   !< Boltzmann constant (J/K)
274    REAL(wp), PARAMETER ::  alv    = 2.260E+6_wp       !< latent heat for H2O vaporisation (J/kg)
275    REAL(wp), PARAMETER ::  alv_d_rv  = 4896.96865_wp  !< alv / rv
276    REAL(wp), PARAMETER ::  am_airmol = 4.8096E-26_wp  !< Average mass of an air molecule (Jacobson 2005, Eq.2.3)
277    REAL(wp), PARAMETER ::  api6   = 0.5235988_wp      !< pi / 6
278    REAL(wp), PARAMETER ::  argas  = 8.314409_wp       !< Gas constant (J/(mol K))
279    REAL(wp), PARAMETER ::  argas_d_cpd = 8.281283865E-3_wp  !< argas per cpd
280    REAL(wp), PARAMETER ::  avo    = 6.02214E+23_wp    !< Avogadro constant (1/mol)
281    REAL(wp), PARAMETER ::  d_sa   = 5.539376964394570E-10_wp  !< diameter of condensing H2SO4 molecule (m)
282    REAL(wp), PARAMETER ::  for_ppm_to_nconc =  7.243016311E+16_wp !< ppm * avo / R (K/(Pa*m3))
283    REAL(wp), PARAMETER ::  epsoc  = 0.15_wp          !< water uptake of organic material
284    REAL(wp), PARAMETER ::  mclim  = 1.0E-23_wp       !< mass concentration min limit (kg/m3)
285    REAL(wp), PARAMETER ::  n3     = 158.79_wp        !< Number of H2SO4 molecules in 3 nm cluster if d_sa=5.54e-10m
286    REAL(wp), PARAMETER ::  nclim  = 1.0_wp           !< number concentration min limit (#/m3)
287    REAL(wp), PARAMETER ::  surfw0 = 0.073_wp         !< surface tension of water at 293 K (J/m2)
288!
289!-- Molar masses in kg/mol
290    REAL(wp), PARAMETER ::  ambc     = 12.0E-3_wp     !< black carbon (BC)
291    REAL(wp), PARAMETER ::  amdair   = 28.970E-3_wp   !< dry air
292    REAL(wp), PARAMETER ::  amdu     = 100.E-3_wp     !< mineral dust
293    REAL(wp), PARAMETER ::  amh2o    = 18.0154E-3_wp  !< H2O
294    REAL(wp), PARAMETER ::  amh2so4  = 98.06E-3_wp    !< H2SO4
295    REAL(wp), PARAMETER ::  amhno3   = 63.01E-3_wp    !< HNO3
296    REAL(wp), PARAMETER ::  amn2o    = 44.013E-3_wp   !< N2O
297    REAL(wp), PARAMETER ::  amnh3    = 17.031E-3_wp   !< NH3
298    REAL(wp), PARAMETER ::  amo2     = 31.9988E-3_wp  !< O2
299    REAL(wp), PARAMETER ::  amo3     = 47.998E-3_wp   !< O3
300    REAL(wp), PARAMETER ::  amoc     = 150.E-3_wp     !< organic carbon (OC)
301    REAL(wp), PARAMETER ::  amss     = 58.44E-3_wp    !< sea salt (NaCl)
302!
303!-- Densities in kg/m3
304    REAL(wp), PARAMETER ::  arhobc     = 2000.0_wp  !< black carbon
305    REAL(wp), PARAMETER ::  arhodu     = 2650.0_wp  !< mineral dust
306    REAL(wp), PARAMETER ::  arhoh2o    = 1000.0_wp  !< H2O
307    REAL(wp), PARAMETER ::  arhoh2so4  = 1830.0_wp  !< SO4
308    REAL(wp), PARAMETER ::  arhohno3   = 1479.0_wp  !< HNO3
309    REAL(wp), PARAMETER ::  arhonh3    = 1530.0_wp  !< NH3
310    REAL(wp), PARAMETER ::  arhooc     = 2000.0_wp  !< organic carbon
311    REAL(wp), PARAMETER ::  arhoss     = 2165.0_wp  !< sea salt (NaCl)
312!
313!-- Volume of molecule in m3/#
314    REAL(wp), PARAMETER ::  amvh2o   = amh2o /avo / arhoh2o      !< H2O
315    REAL(wp), PARAMETER ::  amvh2so4 = amh2so4 / avo / arhoh2so4 !< SO4
316    REAL(wp), PARAMETER ::  amvhno3  = amhno3 / avo / arhohno3   !< HNO3
317    REAL(wp), PARAMETER ::  amvnh3   = amnh3 / avo / arhonh3     !< NH3
318    REAL(wp), PARAMETER ::  amvoc    = amoc / avo / arhooc       !< OC
319    REAL(wp), PARAMETER ::  amvss    = amss / avo / arhoss       !< sea salt
320!
321!-- Constants for the dry deposition model by Petroff and Zhang (2010):
322!-- obstacle characteristic dimension "L" (cm) (plane obstacle by default) and empirical constants
323!-- C_B, C_IN, C_IM, beta_IM and C_IT for each land use category (15, as in Zhang et al. (2001))
324    REAL(wp), DIMENSION(1:15), PARAMETER :: l_p10 = &
325        (/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/)
326    REAL(wp), DIMENSION(1:15), PARAMETER :: c_b_p10 = &
327        (/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/)
328    REAL(wp), DIMENSION(1:15), PARAMETER :: c_in_p10 = &
329        (/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/)
330    REAL(wp), DIMENSION(1:15), PARAMETER :: c_im_p10 = &
331        (/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/)
332    REAL(wp), DIMENSION(1:15), PARAMETER :: beta_im_p10 = &
333        (/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/)
334    REAL(wp), DIMENSION(1:15), PARAMETER :: c_it_p10 = &
335        (/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/)
336!
337!-- Constants for the dry deposition model by Zhang et al. (2001):
338!-- empirical constants "alpha" and "gamma" and characteristic radius "A" for
339!-- each land use category (15) and season (5)
340    REAL(wp), DIMENSION(1:15), PARAMETER :: alpha_z01 = &
341        (/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/)
342    REAL(wp), DIMENSION(1:15), PARAMETER :: gamma_z01 = &
343        (/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/)
344    REAL(wp), DIMENSION(1:15,1:5), PARAMETER :: A_z01 =  RESHAPE( (/& 
345         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
346         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
347         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
348         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
349         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
350                                                           /), (/ 15, 5 /) )
351!-- Land use categories (based on Z01 but the same applies here also for P10):
352!-- 1 = evergreen needleleaf trees,
353!-- 2 = evergreen broadleaf trees,
354!-- 3 = deciduous needleleaf trees,
355!-- 4 = deciduous broadleaf trees,
356!-- 5 = mixed broadleaf and needleleaf trees (deciduous broadleaf trees for P10),
357!-- 6 = grass (short grass for P10),
358!-- 7 = crops, mixed farming,
359!-- 8 = desert,
360!-- 9 = tundra,
361!-- 10 = shrubs and interrupted woodlands (thorn shrubs for P10),
362!-- 11 = wetland with plants (long grass for P10)
363!-- 12 = ice cap and glacier,
364!-- 13 = inland water (inland lake for P10)
365!-- 14 = ocean (water for P10),
366!-- 15 = urban
367!
368!-- SALSA variables:
369    CHARACTER(LEN=20)  ::  bc_salsa_b = 'neumann'                 !< bottom boundary condition
370    CHARACTER(LEN=20)  ::  bc_salsa_t = 'neumann'                 !< top boundary condition
371    CHARACTER(LEN=20)  ::  depo_pcm_par = 'zhang2001'             !< or 'petroff2010'
372    CHARACTER(LEN=20)  ::  depo_pcm_type = 'deciduous_broadleaf'  !< leaf type
373    CHARACTER(LEN=20)  ::  depo_surf_par = 'zhang2001'            !< or 'petroff2010'
374    CHARACTER(LEN=100) ::  input_file_dynamic = 'PIDS_DYNAMIC'    !< file name for dynamic input
375    CHARACTER(LEN=100) ::  input_file_salsa   = 'PIDS_SALSA'      !< file name for emission data
376    CHARACTER(LEN=20)  ::  salsa_emission_mode = 'no_emission'    !< 'no_emission', 'uniform',
377                                                                  !< 'parameterized', 'read_from_file'
378
379    CHARACTER(LEN=20), DIMENSION(4) ::  decycle_method_salsa =                                     &
380                                                 (/'dirichlet','dirichlet','dirichlet','dirichlet'/)
381                                     !< Decycling method at horizontal boundaries
382                                     !< 1=left, 2=right, 3=south, 4=north
383                                     !< dirichlet = initial profiles for the ghost and first 3 layers
384                                     !< neumann = zero gradient
385
386    CHARACTER(LEN=3), DIMENSION(maxspec) ::  listspec = &  !< Active aerosols
387                                   (/'SO4','   ','   ','   ','   ','   ','   '/)
388
389    INTEGER(iwp) ::  depo_pcm_par_num = 1   !< parametrisation type: 1=zhang2001, 2=petroff2010
390    INTEGER(iwp) ::  depo_pcm_type_num = 0  !< index for the dry deposition type on the plant canopy
391    INTEGER(iwp) ::  depo_surf_par_num = 1  !< parametrisation type: 1=zhang2001, 2=petroff2010
392    INTEGER(iwp) ::  end_subrange_1a = 1    !< last index for bin subrange 1a
393    INTEGER(iwp) ::  end_subrange_2a = 1    !< last index for bin subrange 2a
394    INTEGER(iwp) ::  end_subrange_2b = 1    !< last index for bin subrange 2b
395    INTEGER(iwp) ::  ibc_salsa_b            !< index for the bottom boundary condition
396    INTEGER(iwp) ::  ibc_salsa_t            !< index for the top boundary condition
397    INTEGER(iwp) ::  index_bc  = -1         !< index for black carbon (BC)
398    INTEGER(iwp) ::  index_du  = -1         !< index for dust
399    INTEGER(iwp) ::  index_nh  = -1         !< index for NH3
400    INTEGER(iwp) ::  index_no  = -1         !< index for HNO3
401    INTEGER(iwp) ::  index_oc  = -1         !< index for organic carbon (OC)
402    INTEGER(iwp) ::  index_so4 = -1         !< index for SO4 or H2SO4
403    INTEGER(iwp) ::  index_ss  = -1         !< index for sea salt
404    INTEGER(iwp) ::  init_aerosol_type = 0  !< Initial size distribution type
405                                            !< 0 = uniform (read from PARIN)
406                                            !< 1 = read vertical profiles from an input file
407    INTEGER(iwp) ::  init_gases_type = 0    !< Initial gas concentration type
408                                            !< 0 = uniform (read from PARIN)
409                                            !< 1 = read vertical profiles from an input file
410    INTEGER(iwp) ::  lod_gas_emissions = 0  !< level of detail of the gaseous emission data
411    INTEGER(iwp) ::  main_street_id = 0     !< lower bound of main street IDs for parameterized emission mode
412    INTEGER(iwp) ::  max_street_id = 0      !< upper bound of main street IDs for parameterized emission mode
413    INTEGER(iwp) ::  nbins_aerosol = 1      !< total number of size bins
414    INTEGER(iwp) ::  ncc   = 1              !< number of chemical components used
415    INTEGER(iwp) ::  ncomponents_mass = 1   !< total number of chemical compounds (ncc+1)
416                                            !< if particle water is advected)
417    INTEGER(iwp) ::  nj3 = 1                !< J3 parametrization (nucleation)
418                                            !< 1 = condensational sink (Kerminen&Kulmala, 2002)
419                                            !< 2 = coagulational sink (Lehtinen et al. 2007)
420                                            !< 3 = coagS+self-coagulation (Anttila et al. 2010)
421    INTEGER(iwp) ::  nsnucl = 0             !< Choice of the nucleation scheme:
422                                            !< 0 = off
423                                            !< 1 = binary nucleation
424                                            !< 2 = activation type nucleation
425                                            !< 3 = kinetic nucleation
426                                            !< 4 = ternary nucleation
427                                            !< 5 = nucleation with ORGANICs
428                                            !< 6 = activation type of nucleation with H2SO4+ORG
429                                            !< 7 = heteromolecular nucleation with H2SO4*ORG
430                                            !< 8 = homomolecular nucleation of H2SO4
431                                            !<     + heteromolecular nucleation with H2SO4*ORG
432                                            !< 9 = homomolecular nucleation of H2SO4 and ORG
433                                            !<     + heteromolecular nucleation with H2SO4*ORG
434    INTEGER(iwp) ::  salsa_pr_count = 0     !< counter for salsa variable profiles
435    INTEGER(iwp) ::  season_z01 = 1         !< For dry deposition by Zhang et al.: 1 = summer,
436                                            !< 2 = autumn (no harvest yet), 3 = late autumn
437                                            !< (already frost), 4 = winter, 5 = transitional spring
438    INTEGER(iwp) ::  side_street_id = 0     !< lower bound of side street IDs for parameterized emission mode
439    INTEGER(iwp) ::  start_subrange_1a = 1  !< start index for bin subranges: subrange 1a
440    INTEGER(iwp) ::  start_subrange_2a = 1  !<                                subrange 2a
441    INTEGER(iwp) ::  start_subrange_2b = 1  !<                                subrange 2b
442
443    INTEGER(iwp), DIMENSION(nreg) ::  nbin = (/ 3, 7/)  !< Number of size bins per subrange: 1 & 2
444
445    INTEGER(iwp), DIMENSION(ngases_salsa) ::  gas_index_chem = (/ 1, 1, 1, 1, 1/)  !< gas indices in chemistry_model_mod
446                                                                                   !< 1 = H2SO4, 2 = HNO3,
447                                                                                   !< 3 = NH3,   4 = OCNV, 5 = OCSV
448    INTEGER(iwp), DIMENSION(ngases_salsa) ::  emission_index_chem  !< gas indices in the gas emission file
449    INTEGER(iwp), DIMENSION(99) ::  salsa_pr_index  = 0            !< index for salsa profiles
450
451    INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE ::  k_topo_top  !< vertical index of the topography top
452
453    INTEGER(iwp), DIMENSION(:,:,:), ALLOCATABLE  ::  salsa_advc_flags_s !< flags used to degrade order of advection
454                                                                        !< scheme for salsa variables near walls and
455                                                                        !< lateral boundaries
456!
457!-- SALSA switches:
458    LOGICAL ::  advect_particle_water   = .TRUE.   !< Advect water concentration of particles
459    LOGICAL ::  decycle_salsa_lr        = .FALSE.  !< Undo cyclic boundaries: left and right
460    LOGICAL ::  decycle_salsa_ns        = .FALSE.  !< Undo cyclic boundaries: north and south
461    LOGICAL ::  include_emission        = .FALSE.  !< Include or not emissions
462    LOGICAL ::  feedback_to_palm        = .FALSE.  !< Allow feedback due to condensation of H2O
463    LOGICAL ::  nesting_salsa           = .TRUE.   !< Apply nesting for salsa
464    LOGICAL ::  nesting_offline_salsa   = .TRUE.   !< Apply offline nesting for salsa
465    LOGICAL ::  no_insoluble            = .FALSE.  !< Exclude insoluble chemical components
466    LOGICAL ::  read_restart_data_salsa = .FALSE.  !< Read restart data for salsa
467    LOGICAL ::  salsa_gases_from_chem   = .FALSE.  !< Transfer the gaseous components to SALSA
468    LOGICAL ::  van_der_waals_coagc     = .FALSE.  !< Include van der Waals and viscous forces in coagulation
469    LOGICAL ::  write_binary_salsa      = .FALSE.  !< read binary for salsa
470!
471!-- Process switches: nl* is read from the NAMELIST and is NOT changed.
472!--                   ls* is the switch used and will get the value of nl*
473!--                       except for special circumstances (spinup period etc.)
474    LOGICAL ::  nlcoag       = .FALSE.  !< Coagulation master switch
475    LOGICAL ::  lscoag       = .FALSE.  !<
476    LOGICAL ::  nlcnd        = .FALSE.  !< Condensation master switch
477    LOGICAL ::  lscnd        = .FALSE.  !<
478    LOGICAL ::  nlcndgas     = .FALSE.  !< Condensation of precursor gases
479    LOGICAL ::  lscndgas     = .FALSE.  !<
480    LOGICAL ::  nlcndh2oae   = .FALSE.  !< Condensation of H2O on aerosol
481    LOGICAL ::  lscndh2oae   = .FALSE.  !< particles (FALSE -> equilibrium calc.)
482    LOGICAL ::  nldepo       = .FALSE.  !< Deposition master switch
483    LOGICAL ::  lsdepo       = .FALSE.  !<
484    LOGICAL ::  nldepo_surf  = .FALSE.  !< Deposition on vegetation master switch
485    LOGICAL ::  lsdepo_surf  = .FALSE.  !<
486    LOGICAL ::  nldepo_pcm   = .FALSE.  !< Deposition on walls master switch
487    LOGICAL ::  lsdepo_pcm   = .FALSE.  !<
488    LOGICAL ::  nldistupdate = .TRUE.   !< Size distribution update master switch
489    LOGICAL ::  lsdistupdate = .FALSE.  !<
490    LOGICAL ::  lspartition  = .FALSE.  !< Partition of HNO3 and NH3
491
492    REAL(wp) ::  act_coeff = 1.0E-7_wp               !< Activation coefficient (1/s)
493    REAL(wp) ::  dt_salsa  = 0.00001_wp              !< Time step of SALSA
494    REAL(wp) ::  emiss_factor_main = 0.0_wp          !< relative emission factor for main streets
495    REAL(wp) ::  emiss_factor_side = 0.0_wp          !< relative emission factor for side streets
496    REAL(wp) ::  h2so4_init = nclim                  !< Init value for sulphuric acid gas
497    REAL(wp) ::  hno3_init  = nclim                  !< Init value for nitric acid gas
498    REAL(wp) ::  last_salsa_time = 0.0_wp            !< previous salsa call
499    REAL(wp) ::  next_aero_emission_update = 0.0_wp  !< previous emission update
500    REAL(wp) ::  next_gas_emission_update = 0.0_wp   !< previous emission update
501    REAL(wp) ::  nf2a = 1.0_wp                       !< Number fraction allocated to 2a-bins
502    REAL(wp) ::  nh3_init  = nclim                   !< Init value for ammonia gas
503    REAL(wp) ::  ocnv_init = nclim                   !< Init value for non-volatile organic gases
504    REAL(wp) ::  ocsv_init = nclim                   !< Init value for semi-volatile organic gases
505    REAL(wp) ::  rhlim = 1.20_wp                     !< RH limit in %/100. Prevents unrealistical RH
506    REAL(wp) ::  time_utc_init                       !< time in seconds-of-day of origin_date_time
507    REAL(wp) ::  skip_time_do_salsa = 0.0_wp         !< Starting time of SALSA (s)
508!
509!-- Initial log-normal size distribution: mode diameter (dpg, metres),
510!-- standard deviation (sigmag) and concentration (n_lognorm, #/m3)
511    REAL(wp), DIMENSION(nmod) ::  dpg   = &
512                     (/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/)
513    REAL(wp), DIMENSION(nmod) ::  sigmag  = &
514                                        (/1.8_wp, 2.16_wp, 2.21_wp, 2.0_wp, 2.0_wp, 2.0_wp, 2.0_wp/)
515    REAL(wp), DIMENSION(nmod) ::  n_lognorm = &
516                             (/1.04e+11_wp, 3.23E+10_wp, 5.4E+6_wp, 0.0_wp, 0.0_wp, 0.0_wp, 0.0_wp/)
517!
518!-- Initial mass fractions / chemical composition of the size distribution
519    REAL(wp), DIMENSION(maxspec) ::  mass_fracs_a = &  !< mass fractions between
520             (/1.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0/)     !< aerosol species for A bins
521    REAL(wp), DIMENSION(maxspec) ::  mass_fracs_b = &  !< mass fractions between
522             (/0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0/)     !< aerosol species for B bins
523    REAL(wp), DIMENSION(nreg+1) ::  reglim = &         !< Min&max diameters of size subranges
524                                 (/ 3.0E-9_wp, 5.0E-8_wp, 1.0E-5_wp/)
525!
526!-- Initial log-normal size distribution: mode diameter (dpg, metres), standard deviation (sigmag)
527!-- concentration (n_lognorm, #/m3) and mass fractions of all chemical components (listed in
528!-- listspec) for both a (soluble) and b (insoluble) bins.
529    REAL(wp), DIMENSION(nmod) ::  aerosol_flux_dpg   = &
530                     (/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/)
531    REAL(wp), DIMENSION(nmod) ::  aerosol_flux_sigmag  = &
532                                        (/1.8_wp, 2.16_wp, 2.21_wp, 2.0_wp, 2.0_wp, 2.0_wp, 2.0_wp/)
533    REAL(wp), DIMENSION(maxspec) ::  aerosol_flux_mass_fracs_a = &
534                                                               (/1.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0/)
535    REAL(wp), DIMENSION(maxspec) ::  aerosol_flux_mass_fracs_b = &
536                                                               (/0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0/)
537    REAL(wp), DIMENSION(nmod) ::  surface_aerosol_flux = &
538                                 (/1.0E+8_wp, 1.0E+9_wp, 1.0E+5_wp, 0.0_wp, 0.0_wp, 0.0_wp, 0.0_wp/)
539
540    REAL(wp), DIMENSION(:), ALLOCATABLE ::  bin_low_limits     !< to deliver information about
541                                                               !< the lower diameters per bin
542    REAL(wp), DIMENSION(:), ALLOCATABLE ::  bc_am_t_val        !< vertical gradient of: aerosol mass
543    REAL(wp), DIMENSION(:), ALLOCATABLE ::  bc_an_t_val        !< of: aerosol number
544    REAL(wp), DIMENSION(:), ALLOCATABLE ::  bc_gt_t_val        !< salsa gases near domain top
545    REAL(wp), DIMENSION(:), ALLOCATABLE ::  gas_emission_time  !< Time array in gas emission data (s)
546    REAL(wp), DIMENSION(:), ALLOCATABLE ::  nsect              !< Background number concentrations
547    REAL(wp), DIMENSION(:), ALLOCATABLE ::  massacc            !< Mass accomodation coefficients
548!
549!-- SALSA derived datatypes:
550!
551!-- Component index
552    TYPE component_index
553       CHARACTER(len=3), ALLOCATABLE ::  comp(:)  !< Component name
554       INTEGER(iwp) ::  ncomp  !< Number of components
555       INTEGER(iwp), ALLOCATABLE ::  ind(:)  !< Component index
556    END TYPE component_index
557!
558!-- For matching LSM and USM surface types and the deposition module surface types
559    TYPE match_surface
560       INTEGER(iwp), DIMENSION(:), ALLOCATABLE ::  match_lupg  !< index for pavement / green roofs
561       INTEGER(iwp), DIMENSION(:), ALLOCATABLE ::  match_luvw  !< index for vegetation / walls
562       INTEGER(iwp), DIMENSION(:), ALLOCATABLE ::  match_luww  !< index for water / windows
563    END TYPE match_surface
564!
565!-- Aerosol emission data attributes
566    TYPE salsa_emission_attribute_type
567
568       CHARACTER(LEN=25) ::   units
569
570       CHARACTER(LEN=25), DIMENSION(:), ALLOCATABLE ::   cat_name    !<
571       CHARACTER(LEN=25), DIMENSION(:), ALLOCATABLE ::   cc_name     !<
572       CHARACTER(LEN=25), DIMENSION(:), ALLOCATABLE ::   unit_time   !<
573       CHARACTER(LEN=100), DIMENSION(:), ALLOCATABLE ::  var_names   !<
574
575       INTEGER(iwp) ::  lod = 0            !< level of detail
576       INTEGER(iwp) ::  nbins = 10         !< number of aerosol size bins
577       INTEGER(iwp) ::  ncat  = 0          !< number of emission categories
578       INTEGER(iwp) ::  ncc   = 7          !< number of aerosol chemical components
579       INTEGER(iwp) ::  nhoursyear = 0     !< number of hours: HOURLY mode
580       INTEGER(iwp) ::  nmonthdayhour = 0  !< number of month days and hours: MDH mode
581       INTEGER(iwp) ::  num_vars           !< number of variables
582       INTEGER(iwp) ::  nt  = 0            !< number of time steps
583       INTEGER(iwp) ::  nz  = 0            !< number of vertical levels
584       INTEGER(iwp) ::  tind               !< time index for reference time in salsa emission data
585
586       INTEGER(iwp), DIMENSION(maxspec) ::  cc_in2mod = 0   !<
587
588       INTEGER(iwp), DIMENSION(:), ALLOCATABLE ::  cat_index  !< Index of emission categories
589       INTEGER(iwp), DIMENSION(:), ALLOCATABLE ::  cc_index   !< Index of chemical components
590
591       REAL(wp) ::  conversion_factor  !< unit conversion factor for aerosol emissions
592
593       REAL(wp), DIMENSION(:), ALLOCATABLE ::  dmid         !< mean diameters of size bins (m)
594       REAL(wp), DIMENSION(:), ALLOCATABLE ::  rho          !< average density (kg/m3)
595       REAL(wp), DIMENSION(:), ALLOCATABLE ::  time         !< time (s)
596       REAL(wp), DIMENSION(:), ALLOCATABLE ::  time_factor  !< emission time factor
597       REAL(wp), DIMENSION(:), ALLOCATABLE ::  z            !< height (m)
598
599       REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  etf  !< emission time factor
600       REAL(wp), DIMENSION(:,:), ALLOCATABLE :: stack_height
601
602    END TYPE salsa_emission_attribute_type
603!
604!-- The default size distribution and mass composition per emission category:
605!-- 1 = traffic, 2 = road dust, 3 = wood combustion, 4 = other
606!-- Mass fractions: H2SO4, OC, BC, DU, SS, HNO3, NH3
607    TYPE salsa_emission_mode_type
608
609       INTEGER(iwp) ::  ndm = 3  !< number of default modes
610       INTEGER(iwp) ::  ndc = 4  !< number of default categories
611
612       CHARACTER(LEN=25), DIMENSION(1:4) ::  cat_name_table = (/'traffic exhaust', &
613                                                                'road dust      ', &
614                                                                'wood combustion', &
615                                                                'other          '/)
616
617       INTEGER(iwp), DIMENSION(1:4) ::  cat_input_to_model   !<
618
619       REAL(wp), DIMENSION(1:3) ::  dpg_table = (/ 13.5E-9_wp, 1.4E-6_wp, 5.4E-8_wp/)  !<
620       REAL(wp), DIMENSION(1:3) ::  ntot_table  !<
621       REAL(wp), DIMENSION(1:3) ::  sigmag_table = (/ 1.6_wp, 1.4_wp, 1.7_wp /)  !<
622
623       REAL(wp), DIMENSION(1:maxspec,1:4) ::  mass_frac_table = &  !<
624          RESHAPE( (/ 0.04_wp, 0.48_wp, 0.48_wp, 0.0_wp,  0.0_wp, 0.0_wp, 0.0_wp, &
625                      0.0_wp,  0.05_wp, 0.0_wp,  0.95_wp, 0.0_wp, 0.0_wp, 0.0_wp, &
626                      0.0_wp,  0.5_wp,  0.5_wp,  0.0_wp,  0.0_wp, 0.0_wp, 0.0_wp, &
627                      0.0_wp,  0.5_wp,  0.5_wp,  0.0_wp,  0.0_wp, 0.0_wp, 0.0_wp  &
628                   /), (/maxspec,4/) )
629
630       REAL(wp), DIMENSION(1:3,1:4) ::  pm_frac_table = & !< rel. mass
631                                     RESHAPE( (/ 0.016_wp, 0.000_wp, 0.984_wp, &
632                                                 0.000_wp, 1.000_wp, 0.000_wp, &
633                                                 0.000_wp, 0.000_wp, 1.000_wp, &
634                                                 1.000_wp, 0.000_wp, 1.000_wp  &
635                                              /), (/3,4/) )
636
637    END TYPE salsa_emission_mode_type
638!
639!-- Aerosol emission data values
640    TYPE salsa_emission_value_type
641
642       REAL(wp) ::  fill  !< fill value
643
644       REAL(wp), DIMENSION(:,:), ALLOCATABLE :: mass_fracs  !< mass fractions per emis. category
645       REAL(wp), DIMENSION(:,:), ALLOCATABLE :: num_fracs   !< number fractions per emis. category
646
647       REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: def_data      !< surface emission in PM
648       REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: preproc_data  !< surface emission per category
649
650    END TYPE salsa_emission_value_type
651!
652!-- Offline nesting data type
653    TYPE salsa_nest_offl_type
654
655       CHARACTER(LEN=16) ::  char_l = 'ls_forcing_left_'  !< leading substring at left boundary
656       CHARACTER(LEN=17) ::  char_n = 'ls_forcing_north_' !< leading substring at north boundary
657       CHARACTER(LEN=17) ::  char_r = 'ls_forcing_right_' !< leading substring at right boundary
658       CHARACTER(LEN=17) ::  char_s = 'ls_forcing_south_' !< leading substring at south boundary
659       CHARACTER(LEN=15) ::  char_t = 'ls_forcing_top_'   !< leading substring at top boundary
660
661       CHARACTER(LEN=5), DIMENSION(1:ngases_salsa) ::  gas_name = (/'H2SO4','HNO3 ','NH3  ','OCNV ','OCSV '/)
662
663       CHARACTER(LEN=25),  DIMENSION(:), ALLOCATABLE ::  cc_name    !< chemical component name
664       CHARACTER(LEN=100), DIMENSION(:), ALLOCATABLE ::  var_names  !< list of variable names
665
666       INTEGER(iwp) ::  id_dynamic  !< NetCDF id of dynamic input file
667       INTEGER(iwp) ::  ncc         !< number of aerosol chemical components
668       INTEGER(iwp) ::  nt          !< number of time levels in dynamic input file
669       INTEGER(iwp) ::  nzu         !< number of vertical levels on scalar grid in dynamic input file
670       INTEGER(iwp) ::  tind        !< time index for reference time in mesoscale-offline nesting
671       INTEGER(iwp) ::  tind_p      !< time index for following time in mesoscale-offline nesting
672
673       INTEGER(iwp), DIMENSION(maxspec) ::  cc_in2mod = 0  !< to transfer chemical composition from input to model
674
675       LOGICAL ::  init  = .FALSE. !< flag indicating the initialisation of offline nesting
676
677       REAL(wp), DIMENSION(:), ALLOCATABLE ::  dmid      !< vertical profile of aerosol bin diameters
678       REAL(wp), DIMENSION(:), ALLOCATABLE ::  time      !< time in dynamic input file
679       REAL(wp), DIMENSION(:), ALLOCATABLE ::  zu_atmos  !< zu in dynamic input file
680
681       REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE ::  gconc_left   !< gas conc. at left boundary
682       REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE ::  gconc_north  !< gas conc. at north boundary
683       REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE ::  gconc_right  !< gas conc. at right boundary
684       REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE ::  gconc_south  !< gas conc. at south boundary
685       REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE ::  gconc_top    !< gas conc.at top boundary
686       REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE ::  mconc_left   !< aerosol mass conc. at left boundary
687       REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE ::  mconc_north  !< aerosol mass conc. at north boundary
688       REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE ::  mconc_right  !< aerosol mass conc. at right boundary
689       REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE ::  mconc_south  !< aerosol mass conc. at south boundary
690       REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE ::  mconc_top    !< aerosol mass conc. at top boundary
691       REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE ::  nconc_left   !< aerosol number conc. at left boundary
692       REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE ::  nconc_north  !< aerosol number conc. at north boundary
693       REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE ::  nconc_right  !< aerosol number conc. at right boundary
694       REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE ::  nconc_south  !< aerosol number conc. at south boundary
695       REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE ::  nconc_top    !< aerosol number conc. at top boundary
696
697    END TYPE salsa_nest_offl_type
698!
699!-- Prognostic variable: Aerosol size bin information (number (#/m3) and mass (kg/m3) concentration)
700!-- and the concentration of gaseous tracers (#/m3). Gas tracers are contained sequentially in
701!-- dimension 4 as:
702!-- 1. H2SO4, 2. HNO3, 3. NH3, 4. OCNV (non-volatile organics), 5. OCSV (semi-volatile)
703    TYPE salsa_variable
704
705       REAL(wp), DIMENSION(:), ALLOCATABLE     ::  init  !<
706
707       REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  diss_s     !<
708       REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  flux_s     !<
709       REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  source     !<
710       REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  sums_ws_l  !<
711
712       REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  diss_l  !<
713       REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  flux_l  !<
714
715       REAL(wp), DIMENSION(:,:,:), POINTER, CONTIGUOUS ::  conc     !<
716       REAL(wp), DIMENSION(:,:,:), POINTER, CONTIGUOUS ::  conc_p   !<
717       REAL(wp), DIMENSION(:,:,:), POINTER, CONTIGUOUS ::  tconc_m  !<
718
719    END TYPE salsa_variable
720!
721!-- Datatype used to store information about the binned size distributions of aerosols
722    TYPE t_section
723
724       REAL(wp) ::  dmid     !< bin middle diameter (m)
725       REAL(wp) ::  vhilim   !< bin volume at the high limit
726       REAL(wp) ::  vlolim   !< bin volume at the low limit
727       REAL(wp) ::  vratiohi !< volume ratio between the center and high limit
728       REAL(wp) ::  vratiolo !< volume ratio between the center and low limit
729       !******************************************************
730       ! ^ Do NOT change the stuff above after initialization !
731       !******************************************************
732       REAL(wp) ::  core    !< Volume of dry particle
733       REAL(wp) ::  dwet    !< Wet diameter or mean droplet diameter (m)
734       REAL(wp) ::  numc    !< Number concentration of particles/droplets (#/m3)
735       REAL(wp) ::  veqh2o  !< Equilibrium H2O concentration for each particle
736
737       REAL(wp), DIMENSION(maxspec+1) ::  volc !< Volume concentrations (m^3/m^3) of aerosols +
738                                               !< water. Since most of the stuff in SALSA is hard
739                                               !< coded, these *have to be* in the order
740                                               !< 1:SO4, 2:OC, 3:BC, 4:DU, 5:SS, 6:NO, 7:NH, 8:H2O
741    END TYPE t_section
742
743    TYPE(salsa_emission_attribute_type) ::  aero_emission_att  !< emission attributes
744    TYPE(salsa_emission_value_type)     ::  aero_emission      !< emission values
745    TYPE(salsa_emission_mode_type)      ::  def_modes          !< default emission modes
746
747    TYPE(chem_emis_att_type) ::  chem_emission_att  !< chemistry emission attributes
748
749    TYPE(chem_emis_val_type), DIMENSION(:), ALLOCATABLE ::  chem_emission  !< chemistry emissions
750
751    TYPE(t_section), DIMENSION(:), ALLOCATABLE ::  aero  !< local aerosol properties
752
753    TYPE(match_surface) ::  lsm_to_depo_h  !< to match the deposition module and horizontal LSM surfaces
754    TYPE(match_surface) ::  usm_to_depo_h  !< to match the deposition module and horizontal USM surfaces
755
756    TYPE(match_surface), DIMENSION(0:3) ::  lsm_to_depo_v  !< to match the deposition mod. and vertical LSM surfaces
757    TYPE(match_surface), DIMENSION(0:3) ::  usm_to_depo_v  !< to match the deposition mod. and vertical USM surfaces
758!
759!-- SALSA variables: as x = x(k,j,i,bin).
760!-- The 4th dimension contains all the size bins sequentially for each aerosol species  + water.
761!
762!-- Prognostic variables:
763!
764!-- Number concentration (#/m3)
765    TYPE(salsa_variable), DIMENSION(:), ALLOCATABLE, TARGET ::  aerosol_number  !<
766    REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE, TARGET ::  nconc_1  !<
767    REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE, TARGET ::  nconc_2  !<
768    REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE, TARGET ::  nconc_3  !<
769!
770!-- Mass concentration (kg/m3)
771    TYPE(salsa_variable), DIMENSION(:), ALLOCATABLE, TARGET ::  aerosol_mass  !<
772    REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE, TARGET ::  mconc_1  !<
773    REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE, TARGET ::  mconc_2  !<
774    REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE, TARGET ::  mconc_3  !<
775!
776!-- Gaseous concentrations (#/m3)
777    TYPE(salsa_variable), DIMENSION(:), ALLOCATABLE, TARGET ::  salsa_gas  !<
778    REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE, TARGET ::  gconc_1  !<
779    REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE, TARGET ::  gconc_2  !<
780    REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE, TARGET ::  gconc_3  !<
781!
782!-- Diagnostic tracers
783    REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE ::  sedim_vd  !< sedimentation velocity per bin (m/s)
784    REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE ::  ra_dry    !< aerosol dry radius (m)
785
786!-- Particle component index tables
787    TYPE(component_index) :: prtcl  !< Contains "getIndex" which gives the index for a given aerosol
788                                    !< component name: 1:SO4, 2:OC, 3:BC, 4:DU, 5:SS, 6:NO, 7:NH, 8:H2O
789!
790!-- Offline nesting:
791    TYPE(salsa_nest_offl_type) ::  salsa_nest_offl  !< data structure for offline nesting
792!
793!-- Data output arrays:
794!
795!-- Gases:
796    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  g_h2so4_av  !< H2SO4
797    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  g_hno3_av   !< HNO3
798    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  g_nh3_av    !< NH3
799    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  g_ocnv_av   !< non-volatile OC
800    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  g_ocsv_av   !< semi-volatile OC
801!
802!-- Integrated:
803    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  ldsa_av  !< lung-deposited surface area
804    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  ntot_av  !< total number concentration
805    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  nufp_av  !< ultrafine particles (UFP)
806    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  pm01_av  !< PM0.1
807    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  pm25_av  !< PM2.5
808    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  pm10_av  !< PM10
809!
810!-- In the particle phase:
811    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  s_bc_av   !< black carbon
812    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  s_du_av   !< dust
813    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  s_h2o_av  !< liquid water
814    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  s_nh_av   !< ammonia
815    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  s_no_av   !< nitrates
816    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  s_oc_av   !< org. carbon
817    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  s_so4_av  !< sulphates
818    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  s_ss_av   !< sea salt
819!
820!-- Bin specific mass and number concentrations:
821    REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE, TARGET ::  mbins_av  !< bin mas
822    REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE, TARGET ::  nbins_av  !< bin number
823
824!
825!-- PALM interfaces:
826
827    INTERFACE salsa_actions
828       MODULE PROCEDURE salsa_actions
829       MODULE PROCEDURE salsa_actions_ij
830    END INTERFACE salsa_actions
831
832    INTERFACE salsa_3d_data_averaging
833       MODULE PROCEDURE salsa_3d_data_averaging
834    END INTERFACE salsa_3d_data_averaging
835
836    INTERFACE salsa_boundary_conds
837       MODULE PROCEDURE salsa_boundary_conds
838       MODULE PROCEDURE salsa_boundary_conds_decycle
839    END INTERFACE salsa_boundary_conds
840
841    INTERFACE salsa_boundary_conditions
842       MODULE PROCEDURE salsa_boundary_conditions
843    END INTERFACE salsa_boundary_conditions
844
845    INTERFACE salsa_check_data_output
846       MODULE PROCEDURE salsa_check_data_output
847    END INTERFACE salsa_check_data_output
848
849    INTERFACE salsa_check_data_output_pr
850       MODULE PROCEDURE salsa_check_data_output_pr
851    END INTERFACE salsa_check_data_output_pr
852
853    INTERFACE salsa_check_parameters
854       MODULE PROCEDURE salsa_check_parameters
855    END INTERFACE salsa_check_parameters
856
857    INTERFACE salsa_data_output_2d
858       MODULE PROCEDURE salsa_data_output_2d
859    END INTERFACE salsa_data_output_2d
860
861    INTERFACE salsa_data_output_3d
862       MODULE PROCEDURE salsa_data_output_3d
863    END INTERFACE salsa_data_output_3d
864
865    INTERFACE salsa_data_output_mask
866       MODULE PROCEDURE salsa_data_output_mask
867    END INTERFACE salsa_data_output_mask
868
869    INTERFACE salsa_define_netcdf_grid
870       MODULE PROCEDURE salsa_define_netcdf_grid
871    END INTERFACE salsa_define_netcdf_grid
872
873    INTERFACE salsa_emission_update
874       MODULE PROCEDURE salsa_emission_update
875    END INTERFACE salsa_emission_update
876
877    INTERFACE salsa_exchange_horiz_bounds
878       MODULE PROCEDURE salsa_exchange_horiz_bounds
879    END INTERFACE salsa_exchange_horiz_bounds
880
881    INTERFACE salsa_header
882       MODULE PROCEDURE salsa_header
883    END INTERFACE salsa_header
884
885    INTERFACE salsa_init
886       MODULE PROCEDURE salsa_init
887    END INTERFACE salsa_init
888
889    INTERFACE salsa_init_arrays
890       MODULE PROCEDURE salsa_init_arrays
891    END INTERFACE salsa_init_arrays
892
893    INTERFACE salsa_nesting_offl_bc
894       MODULE PROCEDURE salsa_nesting_offl_bc
895    END INTERFACE salsa_nesting_offl_bc
896
897    INTERFACE salsa_nesting_offl_init
898       MODULE PROCEDURE salsa_nesting_offl_init
899    END INTERFACE salsa_nesting_offl_init
900
901    INTERFACE salsa_nesting_offl_input
902       MODULE PROCEDURE salsa_nesting_offl_input
903    END INTERFACE salsa_nesting_offl_input
904
905    INTERFACE salsa_non_advective_processes
906       MODULE PROCEDURE salsa_non_advective_processes
907       MODULE PROCEDURE salsa_non_advective_processes_ij
908    END INTERFACE salsa_non_advective_processes
909
910    INTERFACE salsa_parin
911       MODULE PROCEDURE salsa_parin
912    END INTERFACE salsa_parin
913
914    INTERFACE salsa_prognostic_equations
915       MODULE PROCEDURE salsa_prognostic_equations
916       MODULE PROCEDURE salsa_prognostic_equations_ij
917    END INTERFACE salsa_prognostic_equations
918
919    INTERFACE salsa_rrd_local
920       MODULE PROCEDURE salsa_rrd_local
921    END INTERFACE salsa_rrd_local
922
923    INTERFACE salsa_statistics
924       MODULE PROCEDURE salsa_statistics
925    END INTERFACE salsa_statistics
926
927    INTERFACE salsa_swap_timelevel
928       MODULE PROCEDURE salsa_swap_timelevel
929    END INTERFACE salsa_swap_timelevel
930
931    INTERFACE salsa_tendency
932       MODULE PROCEDURE salsa_tendency
933       MODULE PROCEDURE salsa_tendency_ij
934    END INTERFACE salsa_tendency
935
936    INTERFACE salsa_wrd_local
937       MODULE PROCEDURE salsa_wrd_local
938    END INTERFACE salsa_wrd_local
939
940
941    SAVE
942
943    PRIVATE
944!
945!-- Public functions:
946    PUBLIC salsa_3d_data_averaging,       &
947           salsa_actions,                 &
948           salsa_boundary_conds,          &
949           salsa_boundary_conditions,     &
950           salsa_check_data_output,       &
951           salsa_check_data_output_pr,    &
952           salsa_check_parameters,        &
953           salsa_data_output_2d,          &
954           salsa_data_output_3d,          &
955           salsa_data_output_mask,        &
956           salsa_define_netcdf_grid,      &
957           salsa_diagnostics,             &
958           salsa_emission_update,         &
959           salsa_exchange_horiz_bounds,   &
960           salsa_header,                  &
961           salsa_init,                    &
962           salsa_init_arrays,             &
963           salsa_nesting_offl_bc,         &
964           salsa_nesting_offl_init,       &
965           salsa_nesting_offl_input,      &
966           salsa_non_advective_processes, &
967           salsa_parin,                   &
968           salsa_prognostic_equations,    &
969           salsa_rrd_local,               &
970           salsa_statistics,              &
971           salsa_swap_timelevel,          &
972           salsa_wrd_local
973
974!
975!-- Public parameters, constants and initial values
976    PUBLIC bc_am_t_val,           &
977           bc_an_t_val,           &
978           bc_gt_t_val,           &
979           ibc_salsa_b,           &
980           init_aerosol_type,     &
981           init_gases_type,       &
982           nesting_salsa,         &
983           nesting_offline_salsa, &
984           salsa_gases_from_chem, &
985           skip_time_do_salsa
986!
987!-- Public variables
988    PUBLIC aerosol_mass,     &
989           aerosol_number,   &
990           gconc_2,          &
991           mconc_2,          &
992           nbins_aerosol,    &
993           ncomponents_mass, &
994           nconc_2,          &
995           ngases_salsa,     &
996           salsa_gas,        &
997           salsa_nest_offl
998
999
1000 CONTAINS
1001
1002!------------------------------------------------------------------------------!
1003! Description:
1004! ------------
1005!> Parin for &salsa_par for new modules
1006!------------------------------------------------------------------------------!
1007 SUBROUTINE salsa_parin
1008
1009    USE control_parameters,                                                                        &
1010        ONLY:  data_output_pr
1011
1012    IMPLICIT NONE
1013
1014    CHARACTER(LEN=80) ::  line   !< dummy string that contains the current line of parameter file
1015
1016    INTEGER(iwp) ::  i                 !< loop index
1017    INTEGER(iwp) ::  max_pr_salsa_tmp  !< dummy variable
1018
1019    NAMELIST /salsa_parameters/      aerosol_flux_dpg,                         &
1020                                     aerosol_flux_mass_fracs_a,                &
1021                                     aerosol_flux_mass_fracs_b,                &
1022                                     aerosol_flux_sigmag,                      &
1023                                     advect_particle_water,                    &
1024                                     bc_salsa_b,                               &
1025                                     bc_salsa_t,                               &
1026                                     decycle_salsa_lr,                         &
1027                                     decycle_method_salsa,                     &
1028                                     decycle_salsa_ns,                         &
1029                                     depo_pcm_par,                             &
1030                                     depo_pcm_type,                            &
1031                                     depo_surf_par,                            &
1032                                     dpg,                                      &
1033                                     dt_salsa,                                 &
1034                                     emiss_factor_main,                        &
1035                                     emiss_factor_side,                        &
1036                                     feedback_to_palm,                         &
1037                                     h2so4_init,                               &
1038                                     hno3_init,                                &
1039                                     listspec,                                 &
1040                                     main_street_id,                           &
1041                                     mass_fracs_a,                             &
1042                                     mass_fracs_b,                             &
1043                                     max_street_id,                            &
1044                                     n_lognorm,                                &
1045                                     nbin,                                     &
1046                                     nesting_salsa,                            &
1047                                     nesting_offline_salsa,                    &
1048                                     nf2a,                                     &
1049                                     nh3_init,                                 &
1050                                     nj3,                                      &
1051                                     nlcnd,                                    &
1052                                     nlcndgas,                                 &
1053                                     nlcndh2oae,                               &
1054                                     nlcoag,                                   &
1055                                     nldepo,                                   &
1056                                     nldepo_pcm,                               &
1057                                     nldepo_surf,                              &
1058                                     nldistupdate,                             &
1059                                     nsnucl,                                   &
1060                                     ocnv_init,                                &
1061                                     ocsv_init,                                &
1062                                     read_restart_data_salsa,                  &
1063                                     reglim,                                   &
1064                                     salsa,                                    &
1065                                     salsa_emission_mode,                      &
1066                                     season_z01,                               &
1067                                     sigmag,                                   &
1068                                     side_street_id,                           &
1069                                     skip_time_do_salsa,                       &
1070                                     surface_aerosol_flux,                     &
1071                                     van_der_waals_coagc,                      &
1072                                     write_binary_salsa
1073
1074    line = ' '
1075!
1076!-- Try to find salsa package
1077    REWIND ( 11 )
1078    line = ' '
1079    DO WHILE ( INDEX( line, '&salsa_parameters' ) == 0 )
1080       READ ( 11, '(A)', END=10 )  line
1081    ENDDO
1082    BACKSPACE ( 11 )
1083!
1084!-- Read user-defined namelist
1085    READ ( 11, salsa_parameters )
1086!
1087!-- Enable salsa (salsa switch in modules.f90)
1088    salsa = .TRUE.
1089
1090 10 CONTINUE
1091!
1092!-- Update the number of output profiles
1093    max_pr_salsa_tmp = 0
1094    i = 1
1095    DO WHILE ( data_output_pr(i) /= ' '  .AND.  i <= 100 )
1096       IF ( TRIM( data_output_pr(i)(1:6) ) == 'salsa_' )  max_pr_salsa_tmp = max_pr_salsa_tmp + 1
1097       i = i + 1
1098    ENDDO
1099    IF ( max_pr_salsa_tmp > 0 )  max_pr_salsa = max_pr_salsa_tmp
1100
1101 END SUBROUTINE salsa_parin
1102
1103!------------------------------------------------------------------------------!
1104! Description:
1105! ------------
1106!> Check parameters routine for salsa.
1107!------------------------------------------------------------------------------!
1108 SUBROUTINE salsa_check_parameters
1109
1110    USE control_parameters,                                                                        &
1111        ONLY:  child_domain, humidity, initializing_actions, nesting_offline
1112
1113    IMPLICIT NONE
1114
1115!
1116!-- Check that humidity is switched on
1117    IF ( salsa  .AND.  .NOT.  humidity )  THEN
1118       WRITE( message_string, * ) 'salsa = ', salsa, ' is not allowed with humidity = ', humidity
1119       CALL message( 'salsa_check_parameters', 'PA0594', 1, 2, 0, 6, 0 )
1120    ENDIF
1121!
1122!-- For nested runs, explicitly set nesting boundary conditions.
1123    IF ( nesting_salsa  .AND. child_domain )  bc_salsa_t = 'nested'
1124!
1125!-- Set boundary conditions also in case the model is offline-nested in larger-scale models.
1126    IF ( nesting_offline )  THEN
1127       IF ( nesting_offline_salsa )  THEN
1128          bc_salsa_t = 'nesting_offline'
1129       ELSE
1130          bc_salsa_t = 'neumann'
1131       ENDIF
1132    ENDIF
1133!
1134!-- Set bottom boundary condition flag
1135    IF ( bc_salsa_b == 'dirichlet' )  THEN
1136       ibc_salsa_b = 0
1137    ELSEIF ( bc_salsa_b == 'neumann' )  THEN
1138       ibc_salsa_b = 1
1139    ELSE
1140       message_string = 'unknown boundary condition: bc_salsa_b = "' // TRIM( bc_salsa_t ) // '"'
1141       CALL message( 'salsa_check_parameters', 'PA0595', 1, 2, 0, 6, 0 )
1142    ENDIF
1143!
1144!-- Set top boundary conditions flag
1145    IF ( bc_salsa_t == 'dirichlet' )  THEN
1146       ibc_salsa_t = 0
1147    ELSEIF ( bc_salsa_t == 'neumann' )  THEN
1148       ibc_salsa_t = 1
1149    ELSEIF ( bc_salsa_t == 'initial_gradient' )  THEN
1150       ibc_salsa_t = 2
1151    ELSEIF ( bc_salsa_t == 'nested'  .OR.  bc_salsa_t == 'nesting_offline' )  THEN
1152       ibc_salsa_t = 3
1153    ELSE
1154       message_string = 'unknown boundary condition: bc_salsa_t = "' // TRIM( bc_salsa_t ) // '"'
1155       CALL message( 'salsa_check_parameters', 'PA0596', 1, 2, 0, 6, 0 )
1156    ENDIF
1157!
1158!-- Check J3 parametrisation
1159    IF ( nj3 < 1  .OR.  nj3 > 3 )  THEN
1160       message_string = 'unknown nj3 (must be 1-3)'
1161       CALL message( 'salsa_check_parameters', 'PA0597', 1, 2, 0, 6, 0 )
1162    ENDIF
1163!
1164!-- Check bottom boundary condition in case of surface emissions
1165    IF ( salsa_emission_mode /= 'no_emission'  .AND.  ibc_salsa_b  == 0 ) THEN
1166       message_string = 'salsa_emission_mode /= "no_emission" requires bc_salsa_b = "Neumann"'
1167       CALL message( 'salsa_check_parameters','PA0598', 1, 2, 0, 6, 0 )
1168    ENDIF
1169!
1170!-- Check whether emissions are applied
1171    IF ( salsa_emission_mode /= 'no_emission' )  include_emission = .TRUE.
1172!
1173!-- Set the initialisation type: background concentration are read from PIDS_DYNAMIC if
1174!-- initializing_actions = 'inifor set_constant_profiles'
1175    IF ( INDEX( initializing_actions, 'inifor' ) /= 0 )  THEN
1176       init_aerosol_type = 1
1177       init_gases_type = 1
1178    ENDIF
1179
1180 END SUBROUTINE salsa_check_parameters
1181
1182!------------------------------------------------------------------------------!
1183!
1184! Description:
1185! ------------
1186!> Subroutine defining appropriate grid for netcdf variables.
1187!> It is called out from subroutine netcdf.
1188!> Same grid as for other scalars (see netcdf_interface_mod.f90)
1189!------------------------------------------------------------------------------!
1190 SUBROUTINE salsa_define_netcdf_grid( var, found, grid_x, grid_y, grid_z )
1191
1192    IMPLICIT NONE
1193
1194    CHARACTER(LEN=*), INTENT(OUT) ::  grid_x   !<
1195    CHARACTER(LEN=*), INTENT(OUT) ::  grid_y   !<
1196    CHARACTER(LEN=*), INTENT(OUT) ::  grid_z   !<
1197    CHARACTER(LEN=*), INTENT(IN)  ::  var      !<
1198
1199    LOGICAL, INTENT(OUT) ::  found   !<
1200
1201    found  = .TRUE.
1202!
1203!-- Check for the grid
1204
1205    IF ( var(1:6) == 'salsa_' )  THEN  ! same grid for all salsa output variables
1206       grid_x = 'x'
1207       grid_y = 'y'
1208       grid_z = 'zu'
1209    ELSE
1210       found  = .FALSE.
1211       grid_x = 'none'
1212       grid_y = 'none'
1213       grid_z = 'none'
1214    ENDIF
1215
1216 END SUBROUTINE salsa_define_netcdf_grid
1217
1218!------------------------------------------------------------------------------!
1219! Description:
1220! ------------
1221!> Header output for new module
1222!------------------------------------------------------------------------------!
1223 SUBROUTINE salsa_header( io )
1224
1225    USE indices,                                                                                   &
1226        ONLY:  nx, ny, nz
1227
1228    IMPLICIT NONE
1229 
1230    INTEGER(iwp), INTENT(IN) ::  io   !< Unit of the output file
1231!
1232!-- Write SALSA header
1233    WRITE( io, 1 )
1234    WRITE( io, 2 ) skip_time_do_salsa
1235    WRITE( io, 3 ) dt_salsa
1236    WRITE( io, 4 )  nz, ny, nx, nbins_aerosol
1237    IF ( advect_particle_water )  THEN
1238       WRITE( io, 5 )  nz, ny, nx, ncomponents_mass*nbins_aerosol, advect_particle_water
1239    ELSE
1240       WRITE( io, 5 )  nz, ny, nx, ncc*nbins_aerosol, advect_particle_water
1241    ENDIF
1242    IF ( .NOT. salsa_gases_from_chem )  THEN
1243       WRITE( io, 6 )  nz, ny, nx, ngases_salsa, salsa_gases_from_chem
1244    ENDIF
1245    WRITE( io, 7 )
1246    IF ( nsnucl > 0 )   WRITE( io, 8 ) nsnucl, nj3
1247    IF ( nlcoag )       WRITE( io, 9 )
1248    IF ( nlcnd )        WRITE( io, 10 ) nlcndgas, nlcndh2oae
1249    IF ( lspartition )  WRITE( io, 11 )
1250    IF ( nldepo )       WRITE( io, 12 ) nldepo_pcm, nldepo_surf
1251    WRITE( io, 13 )  reglim, nbin, bin_low_limits
1252    IF ( init_aerosol_type == 0 )  WRITE( io, 14 ) nsect
1253    WRITE( io, 15 ) ncc, listspec, mass_fracs_a, mass_fracs_b
1254    IF ( .NOT. salsa_gases_from_chem )  THEN
1255       WRITE( io, 16 ) ngases_salsa, h2so4_init, hno3_init, nh3_init, ocnv_init, ocsv_init
1256    ENDIF
1257    WRITE( io, 17 )  init_aerosol_type, init_gases_type
1258    IF ( init_aerosol_type == 0 )  THEN
1259       WRITE( io, 18 )  dpg, sigmag, n_lognorm
1260    ELSE
1261       WRITE( io, 19 )
1262    ENDIF
1263    IF ( nesting_salsa )  WRITE( io, 20 )  nesting_salsa
1264    IF ( nesting_offline_salsa )  WRITE( io, 21 )  nesting_offline_salsa
1265    WRITE( io, 22 ) salsa_emission_mode
1266    IF ( salsa_emission_mode == 'uniform' )  THEN
1267       WRITE( io, 23 ) surface_aerosol_flux, aerosol_flux_dpg, aerosol_flux_sigmag,                &
1268                       aerosol_flux_mass_fracs_a
1269    ENDIF
1270    IF ( SUM( aerosol_flux_mass_fracs_b ) > 0.0_wp  .OR. salsa_emission_mode == 'read_from_file' ) &
1271    THEN
1272       WRITE( io, 24 )
1273    ENDIF
1274
12751   FORMAT (//' SALSA information:'/                                                               &
1276              ' ------------------------------'/)
12772   FORMAT   ('    Starts at: skip_time_do_salsa = ', F10.2, '  s')
12783   FORMAT  (/'    Timestep: dt_salsa = ', F6.2, '  s')
12794   FORMAT  (/'    Array shape (z,y,x,bins):'/                                                     &
1280              '       aerosol_number:  ', 4(I3)) 
12815   FORMAT  (/'       aerosol_mass:    ', 4(I3),/                                                  &
1282              '       (advect_particle_water = ', L1, ')')
12836   FORMAT   ('       salsa_gas: ', 4(I3),/                                                        &
1284              '       (salsa_gases_from_chem = ', L1, ')')
12857   FORMAT  (/'    Aerosol dynamic processes included: ')
12868   FORMAT  (/'       nucleation (scheme = ', I1, ' and J3 parametrization = ', I1, ')')
12879   FORMAT  (/'       coagulation')
128810  FORMAT  (/'       condensation (of precursor gases = ', L1, ' and water vapour = ', L1, ')' )
128911  FORMAT  (/'       dissolutional growth by HNO3 and NH3')
129012  FORMAT  (/'       dry deposition (on vegetation = ', L1, ' and on topography = ', L1, ')')
129113  FORMAT  (/'    Aerosol bin subrange limits (in metres): ',  3(ES10.2E3), /                     &
1292              '    Number of size bins for each aerosol subrange: ', 2I3,/                         &
1293              '    Aerosol bin limits (in metres): ', 9(ES10.2E3))
129414  FORMAT   ('    Initial number concentration in bins at the lowest level (#/m**3):', 9(ES10.2E3))
129515  FORMAT  (/'    Number of chemical components used: ', I1,/                                     &
1296              '       Species: ',7(A6),/                                                           &
1297              '    Initial relative contribution of each species to particle volume in:',/         &
1298              '       a-bins: ', 7(F6.3),/                                                         &
1299              '       b-bins: ', 7(F6.3))
130016  FORMAT  (/'    Number of gaseous tracers used: ', I1,/                                         &
1301              '    Initial gas concentrations:',/                                                  &
1302              '       H2SO4: ',ES12.4E3, ' #/m**3',/                                               &
1303              '       HNO3:  ',ES12.4E3, ' #/m**3',/                                               &
1304              '       NH3:   ',ES12.4E3, ' #/m**3',/                                               &
1305              '       OCNV:  ',ES12.4E3, ' #/m**3',/                                               &
1306              '       OCSV:  ',ES12.4E3, ' #/m**3')
130717   FORMAT (/'   Initialising concentrations: ', /                                                &
1308              '      Aerosol size distribution: init_aerosol_type = ', I1,/                        &
1309              '      Gas concentrations: init_gases_type = ', I1 )
131018   FORMAT ( '      Mode diametres: dpg(nmod) = ', 7(F7.3), ' (m)', /                             &
1311              '      Standard deviation: sigmag(nmod) = ', 7(F7.2),/                               &
1312              '      Number concentration: n_lognorm(nmod) = ', 7(ES12.4E3), ' (#/m3)' )
131319   FORMAT (/'      Size distribution read from a file.')
131420   FORMAT (/'   Nesting for salsa variables: ', L1 )
131521   FORMAT (/'   Offline nesting for salsa variables: ', L1 )
131622   FORMAT (/'   Emissions: salsa_emission_mode = ', A )
131723   FORMAT (/'      surface_aerosol_flux = ', ES12.4E3, ' #/m**2/s', /                            &
1318              '      aerosol_flux_dpg     =  ', 7(F7.3), ' (m)', /                                 &
1319              '      aerosol_flux_sigmag  =  ', 7(F7.2), /                                         &
1320              '      aerosol_mass_fracs_a =  ', 7(ES12.4E3) )
132124   FORMAT (/'      (currently all emissions are soluble!)')
1322
1323 END SUBROUTINE salsa_header
1324
1325!------------------------------------------------------------------------------!
1326! Description:
1327! ------------
1328!> Allocate SALSA arrays and define pointers if required
1329!------------------------------------------------------------------------------!
1330 SUBROUTINE salsa_init_arrays
1331
1332    USE advec_ws,                                                                                  &
1333        ONLY: ws_init_flags_scalar
1334
1335    USE surface_mod,                                                                               &
1336        ONLY:  surf_def_h, surf_def_v, surf_lsm_h, surf_lsm_v, surf_usm_h, surf_usm_v
1337
1338    IMPLICIT NONE
1339
1340    INTEGER(iwp) ::  gases_available !< Number of available gas components in the chemistry model
1341    INTEGER(iwp) ::  i               !< loop index for allocating
1342    INTEGER(iwp) ::  ii              !< index for indexing chemical components
1343    INTEGER(iwp) ::  l               !< loop index for allocating: surfaces
1344    INTEGER(iwp) ::  lsp             !< loop index for chem species in the chemistry model
1345
1346    gases_available = 0
1347!
1348!-- Allocate prognostic variables (see salsa_swap_timelevel)
1349!
1350!-- Set derived indices:
1351!-- (This does the same as the subroutine salsa_initialize in SALSA/UCLALES-SALSA)
1352    start_subrange_1a = 1  ! 1st index of subrange 1a
1353    start_subrange_2a = start_subrange_1a + nbin(1)  ! 1st index of subrange 2a
1354    end_subrange_1a   = start_subrange_2a - 1        ! last index of subrange 1a
1355    end_subrange_2a   = end_subrange_1a + nbin(2)    ! last index of subrange 2a
1356
1357!
1358!-- If the fraction of insoluble aerosols in subrange 2 is zero: do not allocate arrays for them
1359    IF ( nf2a > 0.999999_wp  .AND.  SUM( mass_fracs_b ) < 0.00001_wp )  THEN
1360       no_insoluble = .TRUE.
1361       start_subrange_2b = end_subrange_2a+1  ! 1st index of subrange 2b
1362       end_subrange_2b   = end_subrange_2a    ! last index of subrange 2b
1363    ELSE
1364       start_subrange_2b = start_subrange_2a + nbin(2)  ! 1st index of subrange 2b
1365       end_subrange_2b   = end_subrange_2a + nbin(2)    ! last index of subrange 2b
1366    ENDIF
1367
1368    nbins_aerosol = end_subrange_2b   ! total number of aerosol size bins
1369!
1370!-- Create index tables for different aerosol components
1371    CALL component_index_constructor( prtcl, ncc, maxspec, listspec )
1372
1373    ncomponents_mass = ncc
1374    IF ( advect_particle_water )  ncomponents_mass = ncc + 1  ! Add water
1375!
1376!-- Indices for chemical components used (-1 = not used)
1377    ii = 0
1378    IF ( is_used( prtcl, 'SO4' ) )  THEN
1379       index_so4 = get_index( prtcl,'SO4' )
1380       ii = ii + 1
1381    ENDIF
1382    IF ( is_used( prtcl,'OC' ) )  THEN
1383       index_oc = get_index(prtcl, 'OC')
1384       ii = ii + 1
1385    ENDIF
1386    IF ( is_used( prtcl, 'BC' ) )  THEN
1387       index_bc = get_index( prtcl, 'BC' )
1388       ii = ii + 1
1389    ENDIF
1390    IF ( is_used( prtcl, 'DU' ) )  THEN
1391       index_du = get_index( prtcl, 'DU' )
1392       ii = ii + 1
1393    ENDIF
1394    IF ( is_used( prtcl, 'SS' ) )  THEN
1395       index_ss = get_index( prtcl, 'SS' )
1396       ii = ii + 1
1397    ENDIF
1398    IF ( is_used( prtcl, 'NO' ) )  THEN
1399       index_no = get_index( prtcl, 'NO' )
1400       ii = ii + 1
1401    ENDIF
1402    IF ( is_used( prtcl, 'NH' ) )  THEN
1403       index_nh = get_index( prtcl, 'NH' )
1404       ii = ii + 1
1405    ENDIF
1406!
1407!-- All species must be known
1408    IF ( ii /= ncc )  THEN
1409       message_string = 'Unknown aerosol species/component(s) given in the initialization'
1410       CALL message( 'salsa_mod: salsa_init', 'PA0600', 1, 2, 0, 6, 0 )
1411    ENDIF
1412!
1413!-- Allocate:
1414    ALLOCATE( aero(nbins_aerosol), bc_am_t_val(nbins_aerosol*ncomponents_mass),                    &
1415              bc_an_t_val(nbins_aerosol), bc_gt_t_val(ngases_salsa), bin_low_limits(nbins_aerosol),&
1416              nsect(nbins_aerosol), massacc(nbins_aerosol) )
1417    ALLOCATE( k_topo_top(nysg:nyng,nxlg:nxrg) )
1418    IF ( nldepo ) ALLOCATE( sedim_vd(nzb:nzt+1,nysg:nyng,nxlg:nxrg,nbins_aerosol) )
1419    ALLOCATE( ra_dry(nzb:nzt+1,nysg:nyng,nxlg:nxrg,nbins_aerosol) )
1420!
1421!-- Initialise the sectional particle size distribution
1422    CALL set_sizebins
1423!
1424!-- Aerosol number concentration
1425    ALLOCATE( aerosol_number(nbins_aerosol) )
1426    ALLOCATE( nconc_1(nzb:nzt+1,nysg:nyng,nxlg:nxrg,nbins_aerosol),                                &
1427              nconc_2(nzb:nzt+1,nysg:nyng,nxlg:nxrg,nbins_aerosol),                                &
1428              nconc_3(nzb:nzt+1,nysg:nyng,nxlg:nxrg,nbins_aerosol) )
1429    nconc_1 = 0.0_wp
1430    nconc_2 = 0.0_wp
1431    nconc_3 = 0.0_wp
1432
1433    DO i = 1, nbins_aerosol
1434       aerosol_number(i)%conc(nzb:nzt+1,nysg:nyng,nxlg:nxrg)    => nconc_1(:,:,:,i)
1435       aerosol_number(i)%conc_p(nzb:nzt+1,nysg:nyng,nxlg:nxrg)  => nconc_2(:,:,:,i)
1436       aerosol_number(i)%tconc_m(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => nconc_3(:,:,:,i)
1437       ALLOCATE( aerosol_number(i)%flux_s(nzb+1:nzt,0:threads_per_task-1),                         &
1438                 aerosol_number(i)%diss_s(nzb+1:nzt,0:threads_per_task-1),                         &
1439                 aerosol_number(i)%flux_l(nzb+1:nzt,nys:nyn,0:threads_per_task-1),                 &
1440                 aerosol_number(i)%diss_l(nzb+1:nzt,nys:nyn,0:threads_per_task-1),                 &
1441                 aerosol_number(i)%init(nzb:nzt+1),                                                &
1442                 aerosol_number(i)%sums_ws_l(nzb:nzt+1,0:threads_per_task-1) )
1443       aerosol_number(i)%init = nclim
1444       IF ( include_emission  .OR.  ( nldepo  .AND.  nldepo_surf ) )  THEN
1445          ALLOCATE( aerosol_number(i)%source(nys:nyn,nxl:nxr) )
1446          aerosol_number(i)%source = 0.0_wp
1447       ENDIF
1448    ENDDO
1449
1450!
1451!-- Aerosol mass concentration
1452    ALLOCATE( aerosol_mass(ncomponents_mass*nbins_aerosol) )
1453    ALLOCATE( mconc_1(nzb:nzt+1,nysg:nyng,nxlg:nxrg,ncomponents_mass*nbins_aerosol),               &
1454              mconc_2(nzb:nzt+1,nysg:nyng,nxlg:nxrg,ncomponents_mass*nbins_aerosol),               &
1455              mconc_3(nzb:nzt+1,nysg:nyng,nxlg:nxrg,ncomponents_mass*nbins_aerosol) )
1456    mconc_1 = 0.0_wp
1457    mconc_2 = 0.0_wp
1458    mconc_3 = 0.0_wp
1459
1460    DO i = 1, ncomponents_mass*nbins_aerosol
1461       aerosol_mass(i)%conc(nzb:nzt+1,nysg:nyng,nxlg:nxrg)    => mconc_1(:,:,:,i)
1462       aerosol_mass(i)%conc_p(nzb:nzt+1,nysg:nyng,nxlg:nxrg)  => mconc_2(:,:,:,i)
1463       aerosol_mass(i)%tconc_m(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => mconc_3(:,:,:,i)
1464       ALLOCATE( aerosol_mass(i)%flux_s(nzb+1:nzt,0:threads_per_task-1),                           &
1465                 aerosol_mass(i)%diss_s(nzb+1:nzt,0:threads_per_task-1),                           &
1466                 aerosol_mass(i)%flux_l(nzb+1:nzt,nys:nyn,0:threads_per_task-1),                   &
1467                 aerosol_mass(i)%diss_l(nzb+1:nzt,nys:nyn,0:threads_per_task-1),                   &
1468                 aerosol_mass(i)%init(nzb:nzt+1),                                                  &
1469                 aerosol_mass(i)%sums_ws_l(nzb:nzt+1,0:threads_per_task-1)  )
1470       aerosol_mass(i)%init = mclim
1471       IF ( include_emission  .OR.  ( nldepo  .AND.  nldepo_surf ) )  THEN
1472          ALLOCATE( aerosol_mass(i)%source(nys:nyn,nxl:nxr) )
1473          aerosol_mass(i)%source = 0.0_wp
1474       ENDIF
1475    ENDDO
1476
1477!
1478!-- Surface fluxes: answs = aerosol number, amsws = aerosol mass
1479!
1480!-- Horizontal surfaces: default type
1481    DO  l = 0, 2   ! upward (l=0), downward (l=1) and model top (l=2)
1482       ALLOCATE( surf_def_h(l)%answs( 1:surf_def_h(l)%ns, nbins_aerosol ) )
1483       ALLOCATE( surf_def_h(l)%amsws( 1:surf_def_h(l)%ns, nbins_aerosol*ncomponents_mass ) )
1484       surf_def_h(l)%answs = 0.0_wp
1485       surf_def_h(l)%amsws = 0.0_wp
1486    ENDDO
1487!
1488!-- Horizontal surfaces: natural type
1489    ALLOCATE( surf_lsm_h%answs( 1:surf_lsm_h%ns, nbins_aerosol ) )
1490    ALLOCATE( surf_lsm_h%amsws( 1:surf_lsm_h%ns, nbins_aerosol*ncomponents_mass ) )
1491    surf_lsm_h%answs = 0.0_wp
1492    surf_lsm_h%amsws = 0.0_wp
1493!
1494!-- Horizontal surfaces: urban type
1495    ALLOCATE( surf_usm_h%answs( 1:surf_usm_h%ns, nbins_aerosol ) )
1496    ALLOCATE( surf_usm_h%amsws( 1:surf_usm_h%ns, nbins_aerosol*ncomponents_mass ) )
1497    surf_usm_h%answs = 0.0_wp
1498    surf_usm_h%amsws = 0.0_wp
1499
1500!
1501!-- Vertical surfaces: northward (l=0), southward (l=1), eastward (l=2) and westward (l=3) facing
1502    DO  l = 0, 3
1503       ALLOCATE( surf_def_v(l)%answs( 1:surf_def_v(l)%ns, nbins_aerosol ) )
1504       surf_def_v(l)%answs = 0.0_wp
1505       ALLOCATE( surf_def_v(l)%amsws( 1:surf_def_v(l)%ns, nbins_aerosol*ncomponents_mass ) )
1506       surf_def_v(l)%amsws = 0.0_wp
1507
1508       ALLOCATE( surf_lsm_v(l)%answs( 1:surf_lsm_v(l)%ns, nbins_aerosol ) )
1509       surf_lsm_v(l)%answs = 0.0_wp
1510       ALLOCATE( surf_lsm_v(l)%amsws( 1:surf_lsm_v(l)%ns, nbins_aerosol*ncomponents_mass ) )
1511       surf_lsm_v(l)%amsws = 0.0_wp
1512
1513       ALLOCATE( surf_usm_v(l)%answs( 1:surf_usm_v(l)%ns, nbins_aerosol ) )
1514       surf_usm_v(l)%answs = 0.0_wp
1515       ALLOCATE( surf_usm_v(l)%amsws( 1:surf_usm_v(l)%ns, nbins_aerosol*ncomponents_mass ) )
1516       surf_usm_v(l)%amsws = 0.0_wp
1517
1518    ENDDO
1519
1520!
1521!-- Concentration of gaseous tracers (1. SO4, 2. HNO3, 3. NH3, 4. OCNV, 5. OCSV)
1522!-- (number concentration (#/m3) )
1523!
1524!-- If chemistry is on, read gas phase concentrations from there. Otherwise,
1525!-- allocate salsa_gas array.
1526
1527    IF ( air_chemistry )  THEN
1528       DO  lsp = 1, nvar
1529          SELECT CASE ( TRIM( chem_species(lsp)%name ) )
1530             CASE ( 'H2SO4', 'h2so4' )
1531                gases_available = gases_available + 1
1532                gas_index_chem(1) = lsp
1533             CASE ( 'HNO3', 'hno3' )
1534                gases_available = gases_available + 1
1535                gas_index_chem(2) = lsp
1536             CASE ( 'NH3', 'nh3' )
1537                gases_available = gases_available + 1
1538                gas_index_chem(3) = lsp
1539             CASE ( 'OCNV', 'ocnv' )
1540                gases_available = gases_available + 1
1541                gas_index_chem(4) = lsp
1542             CASE ( 'OCSV', 'ocsv' )
1543                gases_available = gases_available + 1
1544                gas_index_chem(5) = lsp
1545          END SELECT
1546       ENDDO
1547
1548       IF ( gases_available == ngases_salsa )  THEN
1549          salsa_gases_from_chem = .TRUE.
1550       ELSE
1551          WRITE( message_string, * ) 'SALSA is run together with chemistry but not all gaseous '// &
1552                                     'components are provided by kpp (H2SO4, HNO3, NH3, OCNV, OCSV)'
1553       CALL message( 'check_parameters', 'PA0599', 1, 2, 0, 6, 0 )
1554       ENDIF
1555
1556    ELSE
1557
1558       ALLOCATE( salsa_gas(ngases_salsa) )
1559       ALLOCATE( gconc_1(nzb:nzt+1,nysg:nyng,nxlg:nxrg,ngases_salsa),                 &
1560                 gconc_2(nzb:nzt+1,nysg:nyng,nxlg:nxrg,ngases_salsa),                 &
1561                 gconc_3(nzb:nzt+1,nysg:nyng,nxlg:nxrg,ngases_salsa) )
1562       gconc_1 = 0.0_wp
1563       gconc_2 = 0.0_wp
1564       gconc_3 = 0.0_wp
1565
1566       DO i = 1, ngases_salsa
1567          salsa_gas(i)%conc(nzb:nzt+1,nysg:nyng,nxlg:nxrg)    => gconc_1(:,:,:,i)
1568          salsa_gas(i)%conc_p(nzb:nzt+1,nysg:nyng,nxlg:nxrg)  => gconc_2(:,:,:,i)
1569          salsa_gas(i)%tconc_m(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => gconc_3(:,:,:,i)
1570          ALLOCATE( salsa_gas(i)%flux_s(nzb+1:nzt,0:threads_per_task-1),       &
1571                    salsa_gas(i)%diss_s(nzb+1:nzt,0:threads_per_task-1),       &
1572                    salsa_gas(i)%flux_l(nzb+1:nzt,nys:nyn,0:threads_per_task-1),&
1573                    salsa_gas(i)%diss_l(nzb+1:nzt,nys:nyn,0:threads_per_task-1),&
1574                    salsa_gas(i)%init(nzb:nzt+1),                              &
1575                    salsa_gas(i)%sums_ws_l(nzb:nzt+1,0:threads_per_task-1) )
1576          salsa_gas(i)%init = nclim
1577          IF ( include_emission )  THEN
1578             ALLOCATE( salsa_gas(i)%source(nys:nys,nxl:nxr) )
1579             salsa_gas(i)%source = 0.0_wp
1580          ENDIF
1581       ENDDO
1582!
1583!--    Surface fluxes: gtsws = gaseous tracer flux
1584!
1585!--    Horizontal surfaces: default type
1586       DO  l = 0, 2   ! upward (l=0), downward (l=1) and model top (l=2)
1587          ALLOCATE( surf_def_h(l)%gtsws( 1:surf_def_h(l)%ns, ngases_salsa ) )
1588          surf_def_h(l)%gtsws = 0.0_wp
1589       ENDDO
1590!--    Horizontal surfaces: natural type
1591       ALLOCATE( surf_lsm_h%gtsws( 1:surf_lsm_h%ns, ngases_salsa ) )
1592       surf_lsm_h%gtsws = 0.0_wp
1593!--    Horizontal surfaces: urban type
1594       ALLOCATE( surf_usm_h%gtsws( 1:surf_usm_h%ns, ngases_salsa ) )
1595       surf_usm_h%gtsws = 0.0_wp
1596!
1597!--    Vertical surfaces: northward (l=0), southward (l=1), eastward (l=2) and
1598!--    westward (l=3) facing
1599       DO  l = 0, 3
1600          ALLOCATE( surf_def_v(l)%gtsws( 1:surf_def_v(l)%ns, ngases_salsa ) )
1601          surf_def_v(l)%gtsws = 0.0_wp
1602          ALLOCATE( surf_lsm_v(l)%gtsws( 1:surf_lsm_v(l)%ns, ngases_salsa ) )
1603          surf_lsm_v(l)%gtsws = 0.0_wp
1604          ALLOCATE( surf_usm_v(l)%gtsws( 1:surf_usm_v(l)%ns, ngases_salsa ) )
1605          surf_usm_v(l)%gtsws = 0.0_wp
1606       ENDDO
1607    ENDIF
1608
1609    IF ( ws_scheme_sca )  THEN
1610
1611       IF ( salsa )  THEN
1612          ALLOCATE( sums_salsa_ws_l(nzb:nzt+1,0:threads_per_task-1) )
1613          sums_salsa_ws_l = 0.0_wp
1614       ENDIF
1615
1616    ENDIF
1617!
1618!-- Set control flags for decycling only at lateral boundary cores. Within the inner cores the
1619!-- decycle flag is set to .FALSE.. Even though it does not affect the setting of chemistry boundary
1620!-- conditions, this flag is used to set advection control flags appropriately.
1621    decycle_salsa_lr = MERGE( decycle_salsa_lr, .FALSE., nxl == 0  .OR.  nxr == nx )
1622    decycle_salsa_ns = MERGE( decycle_salsa_ns, .FALSE., nys == 0  .OR.  nyn == ny )
1623!
1624!-- Decycling can be applied separately for aerosol variables, while wind and other scalars may have
1625!-- cyclic or nested boundary conditions. However, large gradients near the boundaries may produce
1626!-- stationary numerical oscillations near the lateral boundaries when a higher-order scheme is
1627!-- applied near these boundaries. To get rid-off this, set-up additional flags that control the
1628!-- order of the scalar advection scheme near the lateral boundaries for passive scalars with
1629!-- decycling.
1630    IF ( scalar_advec == 'ws-scheme' )  THEN
1631       ALLOCATE( salsa_advc_flags_s(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
1632!
1633!--    In case of decycling, set Neuman boundary conditions for wall_flags_0 bit 31 instead of
1634!--    cyclic boundary conditions. Bit 31 is used to identify extended degradation zones (please see
1635!--    the following comment). Note, since several also other modules may access this bit but may
1636!--    have other boundary conditions, the original value of wall_flags_0 bit 31 must not be
1637!--    modified. Hence, store the boundary conditions directly on salsa_advc_flags_s.
1638!--    salsa_advc_flags_s will be later overwritten in ws_init_flags_scalar and bit 31 won't be used
1639!--    to control the numerical order.
1640!--    Initialize with flag 31 only.
1641       salsa_advc_flags_s = 0
1642       salsa_advc_flags_s = MERGE( IBSET( salsa_advc_flags_s, 31 ), 0, BTEST( wall_flags_0, 31 ) )
1643
1644       IF ( decycle_salsa_ns )  THEN
1645          IF ( nys == 0 )  THEN
1646             DO  i = 1, nbgp
1647                salsa_advc_flags_s(:,nys-i,:) = MERGE( IBSET( salsa_advc_flags_s(:,nys,:), 31 ),   &
1648                                                       IBCLR( salsa_advc_flags_s(:,nys,:), 31 ),   &
1649                                                       BTEST( salsa_advc_flags_s(:,nys,:), 31 ) )
1650             ENDDO
1651          ENDIF
1652          IF ( nyn == ny )  THEN
1653             DO  i = 1, nbgp
1654                salsa_advc_flags_s(:,nyn+i,:) = MERGE( IBSET( salsa_advc_flags_s(:,nyn,:), 31 ),   &
1655                                                       IBCLR( salsa_advc_flags_s(:,nyn,:), 31 ),   &
1656                                                       BTEST( salsa_advc_flags_s(:,nyn,:), 31 ) )
1657             ENDDO
1658          ENDIF
1659       ENDIF
1660       IF ( decycle_salsa_lr )  THEN
1661          IF ( nxl == 0 )  THEN
1662             DO  i = 1, nbgp
1663                salsa_advc_flags_s(:,:,nxl-i) = MERGE( IBSET( salsa_advc_flags_s(:,:,nxl), 31 ),   &
1664                                                       IBCLR( salsa_advc_flags_s(:,:,nxl), 31 ),   &
1665                                                       BTEST( salsa_advc_flags_s(:,:,nxl), 31 ) )
1666             ENDDO
1667          ENDIF
1668          IF ( nxr == nx )  THEN
1669             DO  i = 1, nbgp
1670                salsa_advc_flags_s(:,:,nxr+i) = MERGE( IBSET( salsa_advc_flags_s(:,:,nxr), 31 ),   &
1671                                                       IBCLR( salsa_advc_flags_s(:,:,nxr), 31 ),   &
1672                                                       BTEST( salsa_advc_flags_s(:,:,nxr), 31 ) )
1673             ENDDO
1674          ENDIF
1675       ENDIF
1676!
1677!--    To initialise the advection flags appropriately, pass the boundary flags to
1678!--    ws_init_flags_scalar. The last argument in ws_init_flags_scalar indicates that a passive
1679!--    scalar is being treated and the horizontal advection terms are degraded already 2 grid points
1680!--    before the lateral boundary. Also, extended degradation zones are applied, where
1681!--    horizontal advection of scalars is discretised by the first-order scheme at all grid points
1682!--    in the vicinity of buildings (<= 3 grid points). Even though no building is within the
1683!--    numerical stencil, the first-order scheme is used. At fourth and fifth grid points, the order
1684!--    of the horizontal advection scheme is successively upgraded.
1685!--    These degradations of the advection scheme are done to avoid stationary numerical
1686!--    oscillations, which are responsible for high concentration maxima that may appear e.g. under
1687!--    shear-free stable conditions.
1688       CALL ws_init_flags_scalar( bc_dirichlet_l  .OR.  bc_radiation_l  .OR.  decycle_salsa_lr,    &
1689                                  bc_dirichlet_n  .OR.  bc_radiation_n  .OR.  decycle_salsa_ns,    &
1690                                  bc_dirichlet_r  .OR.  bc_radiation_r  .OR.  decycle_salsa_lr,    &
1691                                  bc_dirichlet_s  .OR.  bc_radiation_s  .OR.  decycle_salsa_ns,    &
1692                                  salsa_advc_flags_s, .TRUE. )
1693    ENDIF
1694
1695
1696 END SUBROUTINE salsa_init_arrays
1697
1698!------------------------------------------------------------------------------!
1699! Description:
1700! ------------
1701!> Initialization of SALSA. Based on salsa_initialize in UCLALES-SALSA.
1702!> Subroutines salsa_initialize, SALSAinit and DiagInitAero in UCLALES-SALSA are
1703!> also merged here.
1704!------------------------------------------------------------------------------!
1705 SUBROUTINE salsa_init
1706
1707    IMPLICIT NONE
1708
1709    INTEGER(iwp) :: i   !<
1710    INTEGER(iwp) :: ib  !< loop index for aerosol number bins
1711    INTEGER(iwp) :: ic  !< loop index for aerosol mass bins
1712    INTEGER(iwp) :: ig  !< loop index for gases
1713    INTEGER(iwp) :: j   !<
1714
1715    IF ( debug_output )  CALL debug_message( 'salsa_init', 'start' )
1716
1717    bin_low_limits = 0.0_wp
1718    k_topo_top     = 0
1719    nsect          = 0.0_wp
1720    massacc        = 1.0_wp
1721!
1722!-- Initialise
1723    IF ( nldepo )  sedim_vd = 0.0_wp
1724
1725    IF ( .NOT. salsa_gases_from_chem )  THEN
1726       IF ( .NOT. read_restart_data_salsa )  THEN
1727          salsa_gas(1)%conc = h2so4_init
1728          salsa_gas(2)%conc = hno3_init
1729          salsa_gas(3)%conc = nh3_init
1730          salsa_gas(4)%conc = ocnv_init
1731          salsa_gas(5)%conc = ocsv_init
1732       ENDIF
1733       DO  ig = 1, ngases_salsa
1734          salsa_gas(ig)%conc_p    = 0.0_wp
1735          salsa_gas(ig)%tconc_m   = 0.0_wp
1736          salsa_gas(ig)%flux_s    = 0.0_wp
1737          salsa_gas(ig)%diss_s    = 0.0_wp
1738          salsa_gas(ig)%flux_l    = 0.0_wp
1739          salsa_gas(ig)%diss_l    = 0.0_wp
1740          salsa_gas(ig)%sums_ws_l = 0.0_wp
1741          salsa_gas(ig)%conc_p    = salsa_gas(ig)%conc
1742       ENDDO
1743!
1744!--    Set initial value for gas compound tracer
1745       salsa_gas(1)%init = h2so4_init
1746       salsa_gas(2)%init = hno3_init
1747       salsa_gas(3)%init = nh3_init
1748       salsa_gas(4)%init = ocnv_init
1749       salsa_gas(5)%init = ocsv_init
1750    ENDIF
1751!
1752!-- Aerosol radius in each bin: dry and wet (m)
1753    ra_dry = 1.0E-10_wp
1754!
1755!-- Initialise location-dependent aerosol size distributions and chemical compositions:
1756    CALL aerosol_init
1757
1758!-- Initalisation run of SALSA + calculate the vertical top index of the topography
1759    DO  i = nxl, nxr
1760       DO  j = nys, nyn
1761
1762          k_topo_top(j,i) = MAXLOC( MERGE( 1, 0, BTEST( wall_flags_0(:,j,i), 12 ) ), DIM = 1 ) - 1
1763
1764          CALL salsa_driver( i, j, 1 )
1765          CALL salsa_diagnostics( i, j )
1766       ENDDO
1767    ENDDO
1768
1769    DO  ib = 1, nbins_aerosol
1770       aerosol_number(ib)%conc_p    = aerosol_number(ib)%conc
1771       aerosol_number(ib)%tconc_m   = 0.0_wp
1772       aerosol_number(ib)%flux_s    = 0.0_wp
1773       aerosol_number(ib)%diss_s    = 0.0_wp
1774       aerosol_number(ib)%flux_l    = 0.0_wp
1775       aerosol_number(ib)%diss_l    = 0.0_wp
1776       aerosol_number(ib)%sums_ws_l = 0.0_wp
1777    ENDDO
1778    DO  ic = 1, ncomponents_mass*nbins_aerosol
1779       aerosol_mass(ic)%conc_p    = aerosol_mass(ic)%conc
1780       aerosol_mass(ic)%tconc_m   = 0.0_wp
1781       aerosol_mass(ic)%flux_s    = 0.0_wp
1782       aerosol_mass(ic)%diss_s    = 0.0_wp
1783       aerosol_mass(ic)%flux_l    = 0.0_wp
1784       aerosol_mass(ic)%diss_l    = 0.0_wp
1785       aerosol_mass(ic)%sums_ws_l = 0.0_wp
1786    ENDDO
1787!
1788!
1789!-- Initialise the deposition scheme and surface types
1790    IF ( nldepo )  CALL init_deposition
1791
1792    IF ( include_emission )  THEN
1793!
1794!--    Read in and initialize emissions
1795       CALL salsa_emission_setup( .TRUE. )
1796       IF ( .NOT. salsa_gases_from_chem  .AND.  salsa_emission_mode == 'read_from_file' )  THEN
1797          CALL salsa_gas_emission_setup( .TRUE. )
1798       ENDIF
1799    ENDIF
1800!
1801!-- Partition and dissolutional growth by gaseous HNO3 and NH3
1802    IF ( index_no > 0  .AND.  index_nh > 0  .AND.  index_so4 > 0 )  lspartition = .TRUE.
1803
1804    IF ( debug_output )  CALL debug_message( 'salsa_init', 'end' )
1805
1806 END SUBROUTINE salsa_init
1807
1808!------------------------------------------------------------------------------!
1809! Description:
1810! ------------
1811!> Initializes particle size distribution grid by calculating size bin limits
1812!> and mid-size for *dry* particles in each bin. Called from salsa_initialize
1813!> (only at the beginning of simulation).
1814!> Size distribution described using:
1815!>   1) moving center method (subranges 1 and 2)
1816!>      (Jacobson, Atmos. Env., 31, 131-144, 1997)
1817!>   2) fixed sectional method (subrange 3)
1818!> Size bins in each subrange are spaced logarithmically
1819!> based on given subrange size limits and bin number.
1820!
1821!> Mona changed 06/2017: Use geometric mean diameter to describe the mean
1822!> particle diameter in a size bin, not the arithmeric mean which clearly
1823!> overestimates the total particle volume concentration.
1824!
1825!> Coded by:
1826!> Hannele Korhonen (FMI) 2005
1827!> Harri Kokkola (FMI) 2006
1828!
1829!> Bug fixes for box model + updated for the new aerosol datatype:
1830!> Juha Tonttila (FMI) 2014
1831!------------------------------------------------------------------------------!
1832 SUBROUTINE set_sizebins
1833
1834    IMPLICIT NONE
1835
1836    INTEGER(iwp) ::  cc  !< running index
1837    INTEGER(iwp) ::  dd  !< running index
1838
1839    REAL(wp) ::  ratio_d  !< ratio of the upper and lower diameter of subranges
1840
1841    aero(:)%dwet     = 1.0E-10_wp
1842    aero(:)%veqh2o   = 1.0E-10_wp
1843    aero(:)%numc     = nclim
1844    aero(:)%core     = 1.0E-10_wp
1845    DO  cc = 1, maxspec+1    ! 1:SO4, 2:OC, 3:BC, 4:DU, 5:SS, 6:NO, 7:NH, 8:H2O
1846       aero(:)%volc(cc) = 0.0_wp
1847    ENDDO
1848!
1849!-- vlolim&vhilim: min & max *dry* volumes [fxm]
1850!-- dmid: bin mid *dry* diameter (m)
1851!-- vratiolo&vratiohi: volume ratio between the center and low/high limit
1852!
1853!-- 1) Size subrange 1:
1854    ratio_d = reglim(2) / reglim(1)   ! section spacing (m)
1855    DO  cc = start_subrange_1a, end_subrange_1a
1856       aero(cc)%vlolim = api6 * ( reglim(1) * ratio_d**( REAL( cc-1 ) / nbin(1) ) )**3
1857       aero(cc)%vhilim = api6 * ( reglim(1) * ratio_d**( REAL( cc ) / nbin(1) ) )**3
1858       aero(cc)%dmid = SQRT( ( aero(cc)%vhilim / api6 )**0.33333333_wp *                           &
1859                             ( aero(cc)%vlolim / api6 )**0.33333333_wp )
1860       aero(cc)%vratiohi = aero(cc)%vhilim / ( api6 * aero(cc)%dmid**3 )
1861       aero(cc)%vratiolo = aero(cc)%vlolim / ( api6 * aero(cc)%dmid**3 )
1862    ENDDO
1863!
1864!-- 2) Size subrange 2:
1865!-- 2.1) Sub-subrange 2a: high hygroscopicity
1866    ratio_d = reglim(3) / reglim(2)   ! section spacing
1867    DO  dd = start_subrange_2a, end_subrange_2a
1868       cc = dd - start_subrange_2a
1869       aero(dd)%vlolim = api6 * ( reglim(2) * ratio_d**( REAL( cc ) / nbin(2) ) )**3
1870       aero(dd)%vhilim = api6 * ( reglim(2) * ratio_d**( REAL( cc+1 ) / nbin(2) ) )**3
1871       aero(dd)%dmid = SQRT( ( aero(dd)%vhilim / api6 )**0.33333333_wp *                           &
1872                             ( aero(dd)%vlolim / api6 )**0.33333333_wp )
1873       aero(dd)%vratiohi = aero(dd)%vhilim / ( api6 * aero(dd)%dmid**3 )
1874       aero(dd)%vratiolo = aero(dd)%vlolim / ( api6 * aero(dd)%dmid**3 )
1875    ENDDO
1876!
1877!-- 2.2) Sub-subrange 2b: low hygroscopicity
1878    IF ( .NOT. no_insoluble )  THEN
1879       aero(start_subrange_2b:end_subrange_2b)%vlolim   = aero(start_subrange_2a:end_subrange_2a)%vlolim
1880       aero(start_subrange_2b:end_subrange_2b)%vhilim   = aero(start_subrange_2a:end_subrange_2a)%vhilim
1881       aero(start_subrange_2b:end_subrange_2b)%dmid     = aero(start_subrange_2a:end_subrange_2a)%dmid
1882       aero(start_subrange_2b:end_subrange_2b)%vratiohi = aero(start_subrange_2a:end_subrange_2a)%vratiohi
1883       aero(start_subrange_2b:end_subrange_2b)%vratiolo = aero(start_subrange_2a:end_subrange_2a)%vratiolo
1884    ENDIF
1885!
1886!-- Initialize the wet diameter with the bin dry diameter to avoid numerical problems later
1887    aero(:)%dwet = aero(:)%dmid
1888!
1889!-- Save bin limits (lower diameter) to be delivered to PALM if needed
1890    DO cc = 1, nbins_aerosol
1891       bin_low_limits(cc) = ( aero(cc)%vlolim / api6 )**0.33333333_wp
1892    ENDDO
1893
1894 END SUBROUTINE set_sizebins
1895
1896!------------------------------------------------------------------------------!
1897! Description:
1898! ------------
1899!> Initilize altitude-dependent aerosol size distributions and compositions.
1900!>
1901!> Mona added 06/2017: Correct the number and mass concentrations by normalizing
1902!< by the given total number and mass concentration.
1903!>
1904!> Tomi Raatikainen, FMI, 29.2.2016
1905!------------------------------------------------------------------------------!
1906 SUBROUTINE aerosol_init
1907
1908    USE netcdf_data_input_mod,                                                                     &
1909        ONLY:  check_existence, close_input_file, get_dimension_length,                            &
1910               get_attribute, get_variable,                                                        &
1911               inquire_num_variables, inquire_variable_names,                                      &
1912               open_read_file
1913
1914    IMPLICIT NONE
1915
1916    CHARACTER(LEN=25),  DIMENSION(:), ALLOCATABLE ::  cc_name    !< chemical component name
1917    CHARACTER(LEN=100), DIMENSION(:), ALLOCATABLE ::  var_names  !< variable names
1918
1919    INTEGER(iwp) ::  ee        !< index: end
1920    INTEGER(iwp) ::  i         !< loop index: x-direction
1921    INTEGER(iwp) ::  ib        !< loop index: size bins
1922    INTEGER(iwp) ::  ic        !< loop index: chemical components
1923    INTEGER(iwp) ::  id_dyn    !< NetCDF id of PIDS_DYNAMIC_SALSA
1924    INTEGER(iwp) ::  ig        !< loop index: gases
1925    INTEGER(iwp) ::  j         !< loop index: y-direction
1926    INTEGER(iwp) ::  k         !< loop index: z-direction
1927    INTEGER(iwp) ::  lod_aero  !< level of detail of inital aerosol concentrations
1928    INTEGER(iwp) ::  num_vars  !< number of variables
1929    INTEGER(iwp) ::  pr_nbins  !< number of aerosol size bins in file
1930    INTEGER(iwp) ::  pr_ncc    !< number of aerosol chemical components in file
1931    INTEGER(iwp) ::  pr_nz     !< number of vertical grid-points in file
1932    INTEGER(iwp) ::  prunmode  !< running mode of SALSA
1933    INTEGER(iwp) ::  ss        !< index: start
1934
1935    INTEGER(iwp), DIMENSION(maxspec) ::  cc_in2mod
1936
1937    LOGICAL  ::  netcdf_extend = .FALSE. !< Flag: netcdf file exists
1938
1939    REAL(wp) ::  flag  !< flag to mask topography grid points
1940
1941    REAL(wp), DIMENSION(nbins_aerosol) ::  core   !< size of the bin mid aerosol particle
1942
1943    REAL(wp), DIMENSION(0:nz+1) ::  pnf2a   !< number fraction in 2a
1944    REAL(wp), DIMENSION(0:nz+1) ::  pmfoc1a !< mass fraction of OC in 1a
1945
1946    REAL(wp), DIMENSION(0:nz+1,nbins_aerosol)   ::  pndist  !< vertical profile of size dist. (#/m3)
1947    REAL(wp), DIMENSION(0:nz+1,maxspec)         ::  pmf2a   !< mass distributions in subrange 2a
1948    REAL(wp), DIMENSION(0:nz+1,maxspec)         ::  pmf2b   !< mass distributions in subrange 2b
1949
1950    REAL(wp), DIMENSION(:), ALLOCATABLE ::  pr_dmid  !< vertical profile of aerosol bin diameters
1951    REAL(wp), DIMENSION(:), ALLOCATABLE ::  pr_z     !< z levels of profiles
1952
1953    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  pr_mass_fracs_a  !< mass fraction: a
1954    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  pr_mass_fracs_b  !< and b
1955
1956    cc_in2mod = 0
1957    prunmode = 1
1958!
1959!-- Bin mean aerosol particle volume (m3)
1960    core(1:nbins_aerosol) = api6 * aero(1:nbins_aerosol)%dmid**3
1961!
1962!-- Set concentrations to zero
1963    pndist(:,:)  = 0.0_wp
1964    pnf2a(:)     = nf2a
1965    pmf2a(:,:)   = 0.0_wp
1966    pmf2b(:,:)   = 0.0_wp
1967    pmfoc1a(:)   = 0.0_wp
1968
1969    IF ( init_aerosol_type == 1 )  THEN
1970!
1971!--    Read input profiles from PIDS_DYNAMIC_SALSA
1972#if defined( __netcdf )
1973!
1974!--    Location-dependent size distributions and compositions.
1975       INQUIRE( FILE = TRIM( input_file_dynamic ) //  TRIM( coupling_char ), EXIST = netcdf_extend )
1976       IF ( netcdf_extend )  THEN
1977!
1978!--       Open file in read-only mode
1979          CALL open_read_file( TRIM( input_file_dynamic ) // TRIM( coupling_char ), id_dyn )
1980!
1981!--       At first, inquire all variable names
1982          CALL inquire_num_variables( id_dyn, num_vars )
1983!
1984!--       Allocate memory to store variable names
1985          ALLOCATE( var_names(1:num_vars) )
1986          CALL inquire_variable_names( id_dyn, var_names )
1987!
1988!--       Inquire vertical dimension and number of aerosol chemical components
1989          CALL get_dimension_length( id_dyn, pr_nz, 'z' )
1990          IF ( pr_nz /= nz )  THEN
1991             WRITE( message_string, * ) 'Number of inifor horizontal grid points does not match '//&
1992                                        'the number of numeric grid points.'
1993             CALL message( 'aerosol_init', 'PA0601', 1, 2, 0, 6, 0 )
1994          ENDIF
1995          CALL get_dimension_length( id_dyn, pr_ncc, 'composition_index' )
1996!
1997!--       Allocate memory
1998          ALLOCATE( pr_z(1:pr_nz), pr_mass_fracs_a(nzb:nzt+1,pr_ncc),                              &
1999                    pr_mass_fracs_b(nzb:nzt+1,pr_ncc) )
2000          pr_mass_fracs_a = 0.0_wp
2001          pr_mass_fracs_b = 0.0_wp
2002!
2003!--       Read vertical levels
2004          CALL get_variable( id_dyn, 'z', pr_z )
2005!
2006!--       Read the names of chemical components
2007          IF ( check_existence( var_names, 'composition_name' ) )  THEN
2008             CALL get_variable( id_dyn, 'composition_name', cc_name, pr_ncc )
2009          ELSE
2010             WRITE( message_string, * ) 'Missing composition_name in ' // TRIM( input_file_dynamic )
2011             CALL message( 'aerosol_init', 'PA0655', 1, 2, 0, 6, 0 )
2012          ENDIF
2013!
2014!--       Define the index of each chemical component in the model
2015          DO  ic = 1, pr_ncc
2016             SELECT CASE ( TRIM( cc_name(ic) ) )
2017                CASE ( 'H2SO4', 'SO4', 'h2so4', 'so4' )
2018                   cc_in2mod(1) = ic
2019                CASE ( 'OC', 'oc' )
2020                   cc_in2mod(2) = ic
2021                CASE ( 'BC', 'bc' )
2022                   cc_in2mod(3) = ic
2023                CASE ( 'DU', 'du' )
2024                   cc_in2mod(4) = ic
2025                CASE ( 'SS', 'ss' )
2026                   cc_in2mod(5) = ic
2027                CASE ( 'HNO3', 'hno3', 'NO3', 'no3', 'NO', 'no' )
2028                   cc_in2mod(6) = ic
2029                CASE ( 'NH3', 'nh3', 'NH4', 'nh4', 'NH', 'nh' )
2030                   cc_in2mod(7) = ic
2031             END SELECT
2032          ENDDO
2033
2034          IF ( SUM( cc_in2mod ) == 0 )  THEN
2035             message_string = 'None of the aerosol chemical components in ' // TRIM(               &
2036                              input_file_dynamic ) // ' correspond to ones applied in SALSA.'
2037             CALL message( 'salsa_mod: aerosol_init', 'PA0602', 2, 2, 0, 6, 0 )
2038          ENDIF
2039!
2040!--       Vertical profiles of mass fractions of different chemical components:
2041          IF ( check_existence( var_names, 'init_atmosphere_mass_fracs_a' ) )  THEN
2042             CALL get_variable( id_dyn, 'init_atmosphere_mass_fracs_a', pr_mass_fracs_a,           &
2043                                0, pr_ncc-1, 0, pr_nz-1 )
2044          ELSE
2045             WRITE( message_string, * ) 'Missing init_atmosphere_mass_fracs_a in ' //              &
2046                                        TRIM( input_file_dynamic )
2047             CALL message( 'aerosol_init', 'PA0656', 1, 2, 0, 6, 0 )
2048          ENDIF
2049          CALL get_variable( id_dyn, 'init_atmosphere_mass_fracs_b', pr_mass_fracs_b,              &
2050                             0, pr_ncc-1, 0, pr_nz-1  )
2051!
2052!--       Match the input data with the chemical composition applied in the model
2053          DO  ic = 1, maxspec
2054             ss = cc_in2mod(ic)
2055             IF ( ss == 0 )  CYCLE
2056             pmf2a(nzb+1:nzt+1,ic) = pr_mass_fracs_a(nzb:nzt,ss)
2057             pmf2b(nzb+1:nzt+1,ic) = pr_mass_fracs_b(nzb:nzt,ss)
2058          ENDDO
2059!
2060!--       Aerosol concentrations: lod=1 (vertical profile of sectional number size distribution)
2061          CALL get_attribute( id_dyn, 'lod', lod_aero, .FALSE., 'init_atmosphere_aerosol' )
2062          IF ( lod_aero /= 1 )  THEN
2063             message_string = 'Currently only lod=1 accepted for init_atmosphere_aerosol'
2064             CALL message( 'salsa_mod: aerosol_init', 'PA0603', 2, 2, 0, 6, 0 )
2065          ELSE
2066!
2067!--          Bin mean diameters in the input file
2068             CALL get_dimension_length( id_dyn, pr_nbins, 'Dmid')
2069             IF ( pr_nbins /= nbins_aerosol )  THEN
2070                message_string = 'Number of size bins in init_atmosphere_aerosol does not match '  &
2071                                 // 'with that applied in the model'
2072                CALL message( 'salsa_mod: aerosol_init', 'PA0604', 2, 2, 0, 6, 0 )
2073             ENDIF
2074
2075             ALLOCATE( pr_dmid(pr_nbins) )
2076             pr_dmid    = 0.0_wp
2077
2078             CALL get_variable( id_dyn, 'Dmid', pr_dmid )
2079!
2080!--          Check whether the sectional representation conform to the one
2081!--          applied in the model
2082             IF ( ANY( ABS( ( aero(1:nbins_aerosol)%dmid - pr_dmid ) /                             &
2083                              aero(1:nbins_aerosol)%dmid )  > 0.1_wp )  ) THEN
2084                message_string = 'Mean diameters of the aerosol size bins in ' // TRIM(            &
2085                                 input_file_dynamic ) // ' do not match with the sectional '//     &
2086                                 'representation of the model.'
2087                CALL message( 'salsa_mod: aerosol_init', 'PA0605', 2, 2, 0, 6, 0 )
2088             ENDIF
2089!
2090!--          Inital aerosol concentrations
2091             CALL get_variable( id_dyn, 'init_atmosphere_aerosol', pndist(nzb+1:nzt,:),            &
2092                                0, pr_nbins-1, 0, pr_nz-1 )
2093          ENDIF
2094!
2095!--       Set bottom and top boundary condition (Neumann)
2096          pmf2a(nzb,:)    = pmf2a(nzb+1,:)
2097          pmf2a(nzt+1,:)  = pmf2a(nzt,:)
2098          pmf2b(nzb,:)    = pmf2b(nzb+1,:)
2099          pmf2b(nzt+1,:)  = pmf2b(nzt,:)
2100          pndist(nzb,:)   = pndist(nzb+1,:)
2101          pndist(nzt+1,:) = pndist(nzt,:)
2102
2103          IF ( index_so4 < 0 )  THEN
2104             pmf2a(:,1) = 0.0_wp
2105             pmf2b(:,1) = 0.0_wp
2106          ENDIF
2107          IF ( index_oc < 0 )  THEN
2108             pmf2a(:,2) = 0.0_wp
2109             pmf2b(:,2) = 0.0_wp
2110          ENDIF
2111          IF ( index_bc < 0 )  THEN
2112             pmf2a(:,3) = 0.0_wp
2113             pmf2b(:,3) = 0.0_wp
2114          ENDIF
2115          IF ( index_du < 0 )  THEN
2116             pmf2a(:,4) = 0.0_wp
2117             pmf2b(:,4) = 0.0_wp
2118          ENDIF
2119          IF ( index_ss < 0 )  THEN
2120             pmf2a(:,5) = 0.0_wp
2121             pmf2b(:,5) = 0.0_wp
2122          ENDIF
2123          IF ( index_no < 0 )  THEN
2124             pmf2a(:,6) = 0.0_wp
2125             pmf2b(:,6) = 0.0_wp
2126          ENDIF
2127          IF ( index_nh < 0 )  THEN
2128             pmf2a(:,7) = 0.0_wp
2129             pmf2b(:,7) = 0.0_wp
2130          ENDIF
2131
2132          IF ( SUM( pmf2a ) < 0.00001_wp  .AND.  SUM( pmf2b ) < 0.00001_wp )  THEN
2133             message_string = 'Error in initialising mass fractions of chemical components. ' //   &
2134                              'Check that all chemical components are included in parameter file!'
2135             CALL message( 'salsa_mod: aerosol_init', 'PA0606', 2, 2, 0, 6, 0 ) 
2136          ENDIF
2137!
2138!--       Then normalise the mass fraction so that SUM = 1
2139          DO  k = nzb, nzt+1
2140             pmf2a(k,:) = pmf2a(k,:) / SUM( pmf2a(k,:) )
2141             IF ( SUM( pmf2b(k,:) ) > 0.0_wp )  pmf2b(k,:) = pmf2b(k,:) / SUM( pmf2b(k,:) )
2142          ENDDO
2143
2144          DEALLOCATE( pr_z, pr_mass_fracs_a, pr_mass_fracs_b )
2145
2146       ELSE
2147          message_string = 'Input file '// TRIM( input_file_dynamic ) // TRIM( coupling_char ) //  &
2148                           ' for SALSA missing!'
2149          CALL message( 'salsa_mod: aerosol_init', 'PA0607', 1, 2, 0, 6, 0 )
2150!
2151!--       Close input file
2152          CALL close_input_file( id_dyn )
2153       ENDIF   ! netcdf_extend
2154
2155#else
2156       message_string = 'init_aerosol_type = 1 but preprocessor directive __netcdf is not used '// &
2157                        'in compiling!'
2158       CALL message( 'salsa_mod: aerosol_init', 'PA0608', 1, 2, 0, 6, 0 )
2159
2160#endif
2161
2162    ELSEIF ( init_aerosol_type == 0 )  THEN
2163!
2164!--    Mass fractions for species in a and b-bins
2165       IF ( index_so4 > 0 )  THEN
2166          pmf2a(:,1) = mass_fracs_a(index_so4)
2167          pmf2b(:,1) = mass_fracs_b(index_so4)
2168       ENDIF
2169       IF ( index_oc > 0 )  THEN
2170          pmf2a(:,2) = mass_fracs_a(index_oc)
2171          pmf2b(:,2) = mass_fracs_b(index_oc)
2172       ENDIF
2173       IF ( index_bc > 0 )  THEN
2174          pmf2a(:,3) = mass_fracs_a(index_bc)
2175          pmf2b(:,3) = mass_fracs_b(index_bc)
2176       ENDIF
2177       IF ( index_du > 0 )  THEN
2178          pmf2a(:,4) = mass_fracs_a(index_du)
2179          pmf2b(:,4) = mass_fracs_b(index_du)
2180       ENDIF
2181       IF ( index_ss > 0 )  THEN
2182          pmf2a(:,5) = mass_fracs_a(index_ss)
2183          pmf2b(:,5) = mass_fracs_b(index_ss)
2184       ENDIF
2185       IF ( index_no > 0 )  THEN
2186          pmf2a(:,6) = mass_fracs_a(index_no)
2187          pmf2b(:,6) = mass_fracs_b(index_no)
2188       ENDIF
2189       IF ( index_nh > 0 )  THEN
2190          pmf2a(:,7) = mass_fracs_a(index_nh)
2191          pmf2b(:,7) = mass_fracs_b(index_nh)
2192       ENDIF
2193       DO  k = nzb, nzt+1
2194          pmf2a(k,:) = pmf2a(k,:) / SUM( pmf2a(k,:) )
2195          IF ( SUM( pmf2b(k,:) ) > 0.0_wp ) pmf2b(k,:) = pmf2b(k,:) / SUM( pmf2b(k,:) )
2196       ENDDO
2197
2198       CALL size_distribution( n_lognorm, dpg, sigmag, nsect )
2199!
2200!--    Normalize by the given total number concentration
2201       nsect = nsect * SUM( n_lognorm ) / SUM( nsect )
2202       DO  ib = start_subrange_1a, end_subrange_2b
2203          pndist(:,ib) = nsect(ib)
2204       ENDDO
2205    ENDIF
2206
2207    IF ( init_gases_type == 1 )  THEN
2208!
2209!--    Read input profiles from PIDS_CHEM
2210#if defined( __netcdf )
2211!
2212!--    Location-dependent size distributions and compositions.
2213       INQUIRE( FILE = TRIM( input_file_dynamic ) //  TRIM( coupling_char ), EXIST = netcdf_extend )
2214       IF ( netcdf_extend  .AND.  .NOT. salsa_gases_from_chem )  THEN
2215!
2216!--       Open file in read-only mode
2217          CALL open_read_file( TRIM( input_file_dynamic ) // TRIM( coupling_char ), id_dyn )
2218!
2219!--       Inquire dimensions:
2220          CALL get_dimension_length( id_dyn, pr_nz, 'z' )
2221          IF ( pr_nz /= nz )  THEN
2222             WRITE( message_string, * ) 'Number of inifor horizontal grid points does not match '//&
2223                                        'the number of numeric grid points.'
2224             CALL message( 'aerosol_init', 'PA0609', 1, 2, 0, 6, 0 )
2225          ENDIF
2226!
2227!--       Read vertical profiles of gases:
2228          CALL get_variable( id_dyn, 'init_atmosphere_H2SO4', salsa_gas(1)%init(nzb+1:nzt) )
2229          CALL get_variable( id_dyn, 'init_atmosphere_HNO3',  salsa_gas(2)%init(nzb+1:nzt) )
2230          CALL get_variable( id_dyn, 'init_atmosphere_NH3',   salsa_gas(3)%init(nzb+1:nzt) )
2231          CALL get_variable( id_dyn, 'init_atmosphere_OCNV',  salsa_gas(4)%init(nzb+1:nzt) )
2232          CALL get_variable( id_dyn, 'init_atmosphere_OCSV',  salsa_gas(5)%init(nzb+1:nzt) )
2233!
2234!--       Set Neumann top and surface boundary condition for initial + initialise concentrations
2235          DO  ig = 1, ngases_salsa
2236             salsa_gas(ig)%init(nzb)   =  salsa_gas(ig)%init(nzb+1)
2237             salsa_gas(ig)%init(nzt+1) =  salsa_gas(ig)%init(nzt)
2238             IF ( .NOT. read_restart_data_salsa )  THEN
2239                DO  k = nzb, nzt+1
2240                   salsa_gas(ig)%conc(k,:,:) = salsa_gas(ig)%init(k)
2241                ENDDO
2242             ENDIF
2243          ENDDO
2244
2245       ELSEIF ( .NOT. netcdf_extend  .AND.  .NOT.  salsa_gases_from_chem )  THEN
2246          message_string = 'Input file '// TRIM( input_file_dynamic ) // TRIM( coupling_char ) //  &
2247                           ' for SALSA missing!'
2248          CALL message( 'salsa_mod: aerosol_init', 'PA0610', 1, 2, 0, 6, 0 )
2249!
2250!--       Close input file
2251          CALL close_input_file( id_dyn )
2252       ENDIF   ! netcdf_extend
2253#else
2254       message_string = 'init_gases_type = 1 but preprocessor directive __netcdf is not used in '//&
2255                        'compiling!'
2256       CALL message( 'salsa_mod: aerosol_init', 'PA0611', 1, 2, 0, 6, 0 )
2257
2258#endif
2259
2260    ENDIF
2261!
2262!-- Both SO4 and OC are included, so use the given mass fractions
2263    IF ( index_oc > 0  .AND.  index_so4 > 0 )  THEN
2264       pmfoc1a(:) = pmf2a(:,2) / ( pmf2a(:,2) + pmf2a(:,1) )  ! Normalize
2265!
2266!-- Pure organic carbon
2267    ELSEIF ( index_oc > 0 )  THEN
2268       pmfoc1a(:) = 1.0_wp
2269!
2270!-- Pure SO4
2271    ELSEIF ( index_so4 > 0 )  THEN
2272       pmfoc1a(:) = 0.0_wp
2273
2274    ELSE
2275       message_string = 'Either OC or SO4 must be active for aerosol region 1a!'
2276       CALL message( 'salsa_mod: aerosol_init', 'PA0612', 1, 2, 0, 6, 0 )
2277    ENDIF
2278
2279!
2280!-- Initialize concentrations
2281    DO  i = nxlg, nxrg
2282       DO  j = nysg, nyng
2283          DO  k = nzb, nzt+1
2284!
2285!--          Predetermine flag to mask topography
2286             flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_0(k,j,i), 0 ) )
2287!
2288!--          a) Number concentrations
2289!--          Region 1:
2290             DO  ib = start_subrange_1a, end_subrange_1a
2291                IF ( .NOT. read_restart_data_salsa )  THEN
2292                   aerosol_number(ib)%conc(k,j,i) = pndist(k,ib) * flag
2293                ENDIF
2294                IF ( prunmode == 1 )  THEN
2295                   aerosol_number(ib)%init = pndist(:,ib)
2296                ENDIF
2297             ENDDO
2298!
2299!--          Region 2:
2300             IF ( nreg > 1 )  THEN
2301                DO  ib = start_subrange_2a, end_subrange_2a
2302                   IF ( .NOT. read_restart_data_salsa )  THEN
2303                      aerosol_number(ib)%conc(k,j,i) = MAX( 0.0_wp, pnf2a(k) ) * pndist(k,ib) * flag
2304                   ENDIF
2305                   IF ( prunmode == 1 )  THEN
2306                      aerosol_number(ib)%init = MAX( 0.0_wp, nf2a ) * pndist(:,ib)
2307                   ENDIF
2308                ENDDO
2309                IF ( .NOT. no_insoluble )  THEN
2310                   DO  ib = start_subrange_2b, end_subrange_2b
2311                      IF ( pnf2a(k) < 1.0_wp )  THEN
2312                         IF ( .NOT. read_restart_data_salsa )  THEN
2313                            aerosol_number(ib)%conc(k,j,i) = MAX( 0.0_wp, 1.0_wp - pnf2a(k) ) *    &
2314                                                             pndist(k,ib) * flag
2315                         ENDIF
2316                         IF ( prunmode == 1 )  THEN
2317                            aerosol_number(ib)%init = MAX( 0.0_wp, 1.0_wp - nf2a ) * pndist(:,ib)
2318                         ENDIF
2319                      ENDIF
2320                   ENDDO
2321                ENDIF
2322             ENDIF
2323!
2324!--          b) Aerosol mass concentrations
2325!--             bin subrange 1: done here separately due to the SO4/OC convention
2326!
2327!--          SO4:
2328             IF ( index_so4 > 0 )  THEN
2329                ss = ( index_so4 - 1 ) * nbins_aerosol + start_subrange_1a !< start
2330                ee = ( index_so4 - 1 ) * nbins_aerosol + end_subrange_1a !< end
2331                ib = start_subrange_1a
2332                DO  ic = ss, ee
2333                   IF ( .NOT. read_restart_data_salsa )  THEN
2334                      aerosol_mass(ic)%conc(k,j,i) = MAX( 0.0_wp, 1.0_wp - pmfoc1a(k) ) *          &
2335                                                     pndist(k,ib) * core(ib) * arhoh2so4 * flag
2336                   ENDIF
2337                   IF ( prunmode == 1 )  THEN
2338                      aerosol_mass(ic)%init(k) = MAX( 0.0_wp, 1.0_wp - pmfoc1a(k) ) * pndist(k,ib) &
2339                                                 * core(ib) * arhoh2so4
2340                   ENDIF
2341                   ib = ib+1
2342                ENDDO
2343             ENDIF
2344!
2345!--          OC:
2346             IF ( index_oc > 0 ) THEN
2347                ss = ( index_oc - 1 ) * nbins_aerosol + start_subrange_1a !< start
2348                ee = ( index_oc - 1 ) * nbins_aerosol + end_subrange_1a !< end
2349                ib = start_subrange_1a
2350                DO  ic = ss, ee
2351                   IF ( .NOT. read_restart_data_salsa )  THEN
2352                      aerosol_mass(ic)%conc(k,j,i) = MAX( 0.0_wp, pmfoc1a(k) ) * pndist(k,ib) *    &
2353                                                     core(ib) * arhooc * flag
2354                   ENDIF
2355                   IF ( prunmode == 1 )  THEN
2356                      aerosol_mass(ic)%init(k) = MAX( 0.0_wp, pmfoc1a(k) ) * pndist(k,ib) *        &
2357                                                 core(ib) * arhooc
2358                   ENDIF
2359                   ib = ib+1
2360                ENDDO 
2361             ENDIF
2362          ENDDO !< k
2363
2364          prunmode = 3  ! Init only once
2365
2366       ENDDO !< j
2367    ENDDO !< i
2368
2369!
2370!-- c) Aerosol mass concentrations
2371!--    bin subrange 2:
2372    IF ( nreg > 1 ) THEN
2373
2374       IF ( index_so4 > 0 ) THEN
2375          CALL set_aero_mass( index_so4, pmf2a(:,1), pmf2b(:,1), pnf2a, pndist, core, arhoh2so4 )
2376       ENDIF
2377       IF ( index_oc > 0 ) THEN
2378          CALL set_aero_mass( index_oc, pmf2a(:,2), pmf2b(:,2), pnf2a, pndist, core, arhooc )
2379       ENDIF
2380       IF ( index_bc > 0 ) THEN
2381          CALL set_aero_mass( index_bc, pmf2a(:,3), pmf2b(:,3), pnf2a, pndist, core, arhobc )
2382       ENDIF
2383       IF ( index_du > 0 ) THEN
2384          CALL set_aero_mass( index_du, pmf2a(:,4), pmf2b(:,4), pnf2a, pndist, core, arhodu )
2385       ENDIF
2386       IF ( index_ss > 0 ) THEN
2387          CALL set_aero_mass( index_ss, pmf2a(:,5), pmf2b(:,5), pnf2a, pndist, core, arhoss )
2388       ENDIF
2389       IF ( index_no > 0 ) THEN
2390          CALL set_aero_mass( index_no, pmf2a(:,6), pmf2b(:,6), pnf2a, pndist, core, arhohno3 )
2391       ENDIF
2392       IF ( index_nh > 0 ) THEN
2393          CALL set_aero_mass( index_nh, pmf2a(:,7), pmf2b(:,7), pnf2a, pndist, core, arhonh3 )
2394       ENDIF
2395
2396    ENDIF
2397
2398 END SUBROUTINE aerosol_init
2399
2400!------------------------------------------------------------------------------!
2401! Description:
2402! ------------
2403!> Create a lognormal size distribution and discretise to a sectional
2404!> representation.
2405!------------------------------------------------------------------------------!
2406 SUBROUTINE size_distribution( in_ntot, in_dpg, in_sigma, psd_sect )
2407
2408    IMPLICIT NONE
2409
2410    INTEGER(iwp) ::  ib         !< running index: bin
2411    INTEGER(iwp) ::  iteration  !< running index: iteration
2412
2413    REAL(wp) ::  d1         !< particle diameter (m, dummy)
2414    REAL(wp) ::  d2         !< particle diameter (m, dummy)
2415    REAL(wp) ::  delta_d    !< (d2-d1)/10
2416    REAL(wp) ::  deltadp    !< bin width
2417    REAL(wp) ::  dmidi      !< ( d1 + d2 ) / 2
2418
2419    REAL(wp), DIMENSION(:), INTENT(in) ::  in_dpg    !< geometric mean diameter (m)
2420    REAL(wp), DIMENSION(:), INTENT(in) ::  in_ntot   !< number conc. (#/m3)
2421    REAL(wp), DIMENSION(:), INTENT(in) ::  in_sigma  !< standard deviation
2422
2423    REAL(wp), DIMENSION(:), INTENT(inout) ::  psd_sect  !< sectional size distribution
2424
2425    DO  ib = start_subrange_1a, end_subrange_2b
2426       psd_sect(ib) = 0.0_wp
2427!
2428!--    Particle diameter at the low limit (largest in the bin) (m)
2429       d1 = ( aero(ib)%vlolim / api6 )**0.33333333_wp
2430!
2431!--    Particle diameter at the high limit (smallest in the bin) (m)
2432       d2 = ( aero(ib)%vhilim / api6 )**0.33333333_wp
2433!
2434!--    Span of particle diameter in a bin (m)
2435       delta_d = 0.1_wp * ( d2 - d1 )
2436!
2437!--    Iterate:
2438       DO  iteration = 1, 10
2439          d1 = ( aero(ib)%vlolim / api6 )**0.33333333_wp + ( ib - 1) * delta_d
2440          d2 = d1 + delta_d
2441          dmidi = 0.5_wp * ( d1 + d2 )
2442          deltadp = LOG10( d2 / d1 )
2443!
2444!--       Size distribution
2445!--       in_ntot = total number, total area, or total volume concentration
2446!--       in_dpg = geometric-mean number, area, or volume diameter
2447!--       n(k) = number, area, or volume concentration in a bin
2448          psd_sect(ib) = psd_sect(ib) + SUM( in_ntot * deltadp / ( SQRT( 2.0_wp * pi ) *           &
2449                        LOG10( in_sigma ) ) * EXP( -LOG10( dmidi / in_dpg )**2.0_wp /              &
2450                        ( 2.0_wp * LOG10( in_sigma ) ** 2.0_wp ) ) )
2451
2452       ENDDO
2453    ENDDO
2454
2455 END SUBROUTINE size_distribution
2456
2457!------------------------------------------------------------------------------!
2458! Description:
2459! ------------
2460!> Sets the mass concentrations to aerosol arrays in 2a and 2b.
2461!>
2462!> Tomi Raatikainen, FMI, 29.2.2016
2463!------------------------------------------------------------------------------!
2464 SUBROUTINE set_aero_mass( ispec, pmf2a, pmf2b, pnf2a, pndist, pcore, prho )
2465
2466    IMPLICIT NONE
2467
2468    INTEGER(iwp) ::  ee        !< index: end
2469    INTEGER(iwp) ::  i         !< loop index
2470    INTEGER(iwp) ::  ib        !< loop index
2471    INTEGER(iwp) ::  ic        !< loop index
2472    INTEGER(iwp) ::  j         !< loop index
2473    INTEGER(iwp) ::  k         !< loop index
2474    INTEGER(iwp) ::  prunmode  !< 1 = initialise
2475    INTEGER(iwp) ::  ss        !< index: start
2476
2477    INTEGER(iwp), INTENT(in) :: ispec  !< Aerosol species index
2478
2479    REAL(wp) ::  flag   !< flag to mask topography grid points
2480
2481    REAL(wp), INTENT(in) ::  prho !< Aerosol density
2482
2483    REAL(wp), DIMENSION(nbins_aerosol), INTENT(in) ::  pcore !< Aerosol bin mid core volume
2484    REAL(wp), DIMENSION(0:nz+1), INTENT(in)        ::  pnf2a !< Number fraction for 2a
2485    REAL(wp), DIMENSION(0:nz+1), INTENT(in)        ::  pmf2a !< Mass distributions for a
2486    REAL(wp), DIMENSION(0:nz+1), INTENT(in)        ::  pmf2b !< and b bins
2487
2488    REAL(wp), DIMENSION(0:nz+1,nbins_aerosol), INTENT(in) ::  pndist !< Aerosol size distribution
2489
2490    prunmode = 1
2491
2492    DO i = nxlg, nxrg
2493       DO j = nysg, nyng
2494          DO k = nzb, nzt+1
2495!
2496!--          Predetermine flag to mask topography
2497             flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_0(k,j,i), 0 ) ) 
2498!
2499!--          Regime 2a:
2500             ss = ( ispec - 1 ) * nbins_aerosol + start_subrange_2a
2501             ee = ( ispec - 1 ) * nbins_aerosol + end_subrange_2a
2502             ib = start_subrange_2a
2503             DO ic = ss, ee
2504                IF ( .NOT. read_restart_data_salsa )  THEN
2505                   aerosol_mass(ic)%conc(k,j,i) = MAX( 0.0_wp, pmf2a(k) ) * pnf2a(k) * pndist(k,ib)&
2506                                                  * pcore(ib) * prho * flag
2507                ENDIF
2508                IF ( prunmode == 1 )  THEN
2509                   aerosol_mass(ic)%init(k) = MAX( 0.0_wp, pmf2a(k) ) * pnf2a(k) * pndist(k,ib) *  &
2510                                              pcore(ib) * prho
2511                ENDIF
2512                ib = ib + 1
2513             ENDDO
2514!
2515!--          Regime 2b:
2516             IF ( .NOT. no_insoluble )  THEN
2517                ss = ( ispec - 1 ) * nbins_aerosol + start_subrange_2b
2518                ee = ( ispec - 1 ) * nbins_aerosol + end_subrange_2b
2519                ib = start_subrange_2a
2520                DO ic = ss, ee
2521                   IF ( .NOT. read_restart_data_salsa )  THEN
2522                      aerosol_mass(ic)%conc(k,j,i) = MAX( 0.0_wp, pmf2b(k) ) * ( 1.0_wp - pnf2a(k))&
2523                                                     * pndist(k,ib) * pcore(ib) * prho * flag
2524                   ENDIF
2525                   IF ( prunmode == 1 )  THEN
2526                      aerosol_mass(ic)%init(k) = MAX( 0.0_wp, pmf2b(k) ) * ( 1.0_wp - pnf2a(k) ) * &
2527                                                 pndist(k,ib) * pcore(ib) * prho 
2528                   ENDIF
2529                   ib = ib + 1
2530                ENDDO  ! c
2531
2532             ENDIF
2533          ENDDO   ! k
2534
2535          prunmode = 3  ! Init only once
2536
2537       ENDDO   ! j
2538    ENDDO   ! i
2539
2540 END SUBROUTINE set_aero_mass
2541
2542!------------------------------------------------------------------------------!
2543! Description:
2544! ------------
2545!> Initialise the matching between surface types in LSM and deposition models.
2546!> Do the matching based on Zhang et al. (2001). Atmos. Environ. 35, 549-560
2547!> (here referred as Z01).
2548!------------------------------------------------------------------------------!
2549 SUBROUTINE init_deposition
2550
2551    USE surface_mod,                                                                               &
2552        ONLY:  surf_lsm_h, surf_lsm_v, surf_usm_h, surf_usm_v
2553
2554    IMPLICIT NONE
2555
2556    INTEGER(iwp) ::  l  !< loop index for vertical surfaces
2557
2558    LOGICAL :: match_lsm  !< flag to initilise LSM surfaces (if false, initialise USM surfaces)
2559
2560    IF ( depo_pcm_par == 'zhang2001' )  THEN
2561       depo_pcm_par_num = 1
2562    ELSEIF ( depo_pcm_par == 'petroff2010' )  THEN
2563       depo_pcm_par_num = 2
2564    ENDIF
2565
2566    IF ( depo_surf_par == 'zhang2001' )  THEN
2567       depo_surf_par_num = 1
2568    ELSEIF ( depo_surf_par == 'petroff2010' )  THEN
2569       depo_surf_par_num = 2
2570    ENDIF
2571!
2572!-- LSM: Pavement, vegetation and water
2573    IF ( nldepo_surf  .AND.  land_surface )  THEN
2574       match_lsm = .TRUE.
2575       ALLOCATE( lsm_to_depo_h%match_lupg(1:surf_lsm_h%ns),                                         &
2576                 lsm_to_depo_h%match_luvw(1:surf_lsm_h%ns),                                         &
2577                 lsm_to_depo_h%match_luww(1:surf_lsm_h%ns) )
2578       lsm_to_depo_h%match_lupg = 0
2579       lsm_to_depo_h%match_luvw = 0
2580       lsm_to_depo_h%match_luww = 0
2581       CALL match_sm_zhang( surf_lsm_h, lsm_to_depo_h%match_lupg, lsm_to_depo_h%match_luvw,        &
2582                            lsm_to_depo_h%match_luww, match_lsm )
2583       DO  l = 0, 3
2584          ALLOCATE( lsm_to_depo_v(l)%match_lupg(1:surf_lsm_v(l)%ns),                               &
2585                    lsm_to_depo_v(l)%match_luvw(1:surf_lsm_v(l)%ns),                               &
2586                    lsm_to_depo_v(l)%match_luww(1:surf_lsm_v(l)%ns) )
2587          lsm_to_depo_v(l)%match_lupg = 0
2588          lsm_to_depo_v(l)%match_luvw = 0
2589          lsm_to_depo_v(l)%match_luww = 0
2590          CALL match_sm_zhang( surf_lsm_v(l), lsm_to_depo_v(l)%match_lupg,                         &
2591                               lsm_to_depo_v(l)%match_luvw, lsm_to_depo_v(l)%match_luww, match_lsm )
2592       ENDDO
2593    ENDIF
2594!
2595!-- USM: Green roofs/walls, wall surfaces and windows
2596    IF ( nldepo_surf  .AND.  urban_surface )  THEN
2597       match_lsm = .FALSE.
2598       ALLOCATE( usm_to_depo_h%match_lupg(1:surf_usm_h%ns),                                        &
2599                 usm_to_depo_h%match_luvw(1:surf_usm_h%ns),                                        &
2600                 usm_to_depo_h%match_luww(1:surf_usm_h%ns) )
2601       usm_to_depo_h%match_lupg = 0
2602       usm_to_depo_h%match_luvw = 0
2603       usm_to_depo_h%match_luww = 0
2604       CALL match_sm_zhang( surf_usm_h, usm_to_depo_h%match_lupg, usm_to_depo_h%match_luvw,        &
2605                            usm_to_depo_h%match_luww, match_lsm )
2606       DO  l = 0, 3
2607          ALLOCATE( usm_to_depo_v(l)%match_lupg(1:surf_usm_v(l)%ns),                               &
2608                    usm_to_depo_v(l)%match_luvw(1:surf_usm_v(l)%ns),                               &
2609                    usm_to_depo_v(l)%match_luww(1:surf_usm_v(l)%ns) )
2610          usm_to_depo_v(l)%match_lupg = 0
2611          usm_to_depo_v(l)%match_luvw = 0
2612          usm_to_depo_v(l)%match_luww = 0
2613          CALL match_sm_zhang( surf_usm_v(l), usm_to_depo_v(l)%match_lupg,                         &
2614                               usm_to_depo_v(l)%match_luvw, usm_to_depo_v(l)%match_luww, match_lsm )
2615       ENDDO
2616    ENDIF
2617
2618    IF ( nldepo_pcm )  THEN
2619       SELECT CASE ( depo_pcm_type )
2620          CASE ( 'evergreen_needleleaf' )
2621             depo_pcm_type_num = 1
2622          CASE ( 'evergreen_broadleaf' )
2623             depo_pcm_type_num = 2
2624          CASE ( 'deciduous_needleleaf' )
2625             depo_pcm_type_num = 3
2626          CASE ( 'deciduous_broadleaf' )
2627             depo_pcm_type_num = 4
2628          CASE DEFAULT
2629             message_string = 'depo_pcm_type not set correctly.'
2630             CALL message( 'salsa_mod: init_deposition', 'PA0613', 1, 2, 0, 6, 0 )
2631       END SELECT
2632    ENDIF
2633
2634 END SUBROUTINE init_deposition
2635
2636!------------------------------------------------------------------------------!
2637! Description:
2638! ------------
2639!> Match the surface types in PALM and Zhang et al. 2001 deposition module
2640!------------------------------------------------------------------------------!
2641 SUBROUTINE match_sm_zhang( surf, match_pav_green, match_veg_wall, match_wat_win, match_lsm )
2642
2643    USE surface_mod,                                                           &
2644        ONLY:  ind_pav_green, ind_veg_wall, ind_wat_win, surf_type
2645
2646    IMPLICIT NONE
2647
2648    INTEGER(iwp) ::  m              !< index for surface elements
2649    INTEGER(iwp) ::  pav_type_palm  !< pavement / green wall type in PALM
2650    INTEGER(iwp) ::  veg_type_palm  !< vegetation / wall type in PALM
2651    INTEGER(iwp) ::  wat_type_palm  !< water / window type in PALM
2652
2653    INTEGER(iwp), DIMENSION(:), INTENT(inout) ::  match_pav_green  !<  matching pavement/green walls
2654    INTEGER(iwp), DIMENSION(:), INTENT(inout) ::  match_veg_wall   !<  matching vegetation/walls
2655    INTEGER(iwp), DIMENSION(:), INTENT(inout) ::  match_wat_win    !<  matching water/windows
2656
2657    LOGICAL, INTENT(in) :: match_lsm  !< flag to initilise LSM surfaces (if false, initialise USM)
2658
2659    TYPE(surf_type), INTENT(in) :: surf  !< respective surface type
2660
2661    DO  m = 1, surf%ns
2662       IF ( match_lsm )  THEN
2663!
2664!--       Vegetation (LSM):
2665          IF ( surf%frac(ind_veg_wall,m) > 0 )  THEN
2666             veg_type_palm = surf%vegetation_type(m)
2667             SELECT CASE ( veg_type_palm )
2668                CASE ( 0 )
2669                   message_string = 'No vegetation type defined.'
2670                   CALL message( 'salsa_mod: init_depo_surfaces', 'PA0614', 1, 2, 0, 6, 0 )
2671                CASE ( 1 )  ! bare soil
2672                   match_veg_wall(m) = 6  ! grass in Z01
2673                CASE ( 2 )  ! crops, mixed farming
2674                   match_veg_wall(m) = 7  !  crops, mixed farming Z01
2675                CASE ( 3 )  ! short grass
2676                   match_veg_wall(m) = 6  ! grass in Z01
2677                CASE ( 4 )  ! evergreen needleleaf trees
2678                    match_veg_wall(m) = 1  ! evergreen needleleaf trees in Z01
2679                CASE ( 5 )  ! deciduous needleleaf trees
2680                   match_veg_wall(m) = 3  ! deciduous needleleaf trees in Z01
2681                CASE ( 6 )  ! evergreen broadleaf trees
2682                   match_veg_wall(m) = 2  ! evergreen broadleaf trees in Z01
2683                CASE ( 7 )  ! deciduous broadleaf trees
2684                   match_veg_wall(m) = 4  ! deciduous broadleaf trees in Z01
2685                CASE ( 8 )  ! tall grass
2686                   match_veg_wall(m) = 6  ! grass in Z01
2687                CASE ( 9 )  ! desert
2688                   match_veg_wall(m) = 8  ! desert in Z01
2689                CASE ( 10 )  ! tundra
2690                   match_veg_wall(m) = 9  ! tundra in Z01
2691                CASE ( 11 )  ! irrigated crops
2692                   match_veg_wall(m) = 7  !  crops, mixed farming Z01
2693                CASE ( 12 )  ! semidesert
2694                   match_veg_wall(m) = 8  ! desert in Z01
2695                CASE ( 13 )  ! ice caps and glaciers
2696                   match_veg_wall(m) = 12  ! ice cap and glacier in Z01
2697                CASE ( 14 )  ! bogs and marshes
2698                   match_veg_wall(m) = 11  ! wetland with plants in Z01
2699                CASE ( 15 )  ! evergreen shrubs
2700                   match_veg_wall(m) = 10  ! shrubs and interrupted woodlands in Z01
2701                CASE ( 16 )  ! deciduous shrubs
2702                   match_veg_wall(m) = 10  ! shrubs and interrupted woodlands in Z01
2703                CASE ( 17 )  ! mixed forest/woodland
2704                   match_veg_wall(m) = 5  ! mixed broadleaf and needleleaf trees in Z01
2705                CASE ( 18 )  ! interrupted forest
2706                   match_veg_wall(m) = 10  ! shrubs and interrupted woodlands in Z01
2707             END SELECT
2708          ENDIF
2709!
2710!--       Pavement (LSM):
2711          IF ( surf%frac(ind_pav_green,m) > 0 )  THEN
2712             pav_type_palm = surf%pavement_type(m)
2713             IF ( pav_type_palm == 0 )  THEN  ! error
2714                message_string = 'No pavement type defined.'
2715                CALL message( 'salsa_mod: match_sm_zhang', 'PA0615', 1, 2, 0, 6, 0 )
2716             ELSE
2717                match_pav_green(m) = 15  ! urban in Z01
2718             ENDIF
2719          ENDIF
2720!
2721!--       Water (LSM):
2722          IF ( surf%frac(ind_wat_win,m) > 0 )  THEN
2723             wat_type_palm = surf%water_type(m)
2724             IF ( wat_type_palm == 0 )  THEN  ! error
2725                message_string = 'No water type defined.'
2726                CALL message( 'salsa_mod: match_sm_zhang', 'PA0616', 1, 2, 0, 6, 0 )
2727             ELSEIF ( wat_type_palm == 3 )  THEN
2728                match_wat_win(m) = 14  ! ocean in Z01
2729             ELSEIF ( wat_type_palm == 1  .OR.  wat_type_palm == 2 .OR.  wat_type_palm == 4        &
2730                      .OR.  wat_type_palm == 5  )  THEN
2731                match_wat_win(m) = 13  ! inland water in Z01
2732             ENDIF
2733          ENDIF
2734       ELSE
2735!
2736!--       Wall surfaces (USM):
2737          IF ( surf%frac(ind_veg_wall,m) > 0 )  THEN
2738             match_veg_wall(m) = 15  ! urban in Z01
2739          ENDIF
2740!
2741!--       Green walls and roofs (USM):
2742          IF ( surf%frac(ind_pav_green,m) > 0 )  THEN
2743             match_pav_green(m) =  6 ! (short) grass in Z01
2744          ENDIF
2745!
2746!--       Windows (USM):
2747          IF ( surf%frac(ind_wat_win,m) > 0 )  THEN
2748             match_wat_win(m) = 15  ! urban in Z01
2749          ENDIF
2750       ENDIF
2751
2752    ENDDO
2753
2754 END SUBROUTINE match_sm_zhang
2755
2756!------------------------------------------------------------------------------!
2757! Description:
2758! ------------
2759!> Swapping of timelevels
2760!------------------------------------------------------------------------------!
2761 SUBROUTINE salsa_swap_timelevel( mod_count )
2762
2763    IMPLICIT NONE
2764
2765    INTEGER(iwp) ::  ib   !<
2766    INTEGER(iwp) ::  ic   !<
2767    INTEGER(iwp) ::  icc  !<
2768    INTEGER(iwp) ::  ig   !<
2769
2770    INTEGER(iwp), INTENT(IN) ::  mod_count  !<
2771
2772    IF ( time_since_reference_point >= skip_time_do_salsa )  THEN
2773
2774       SELECT CASE ( mod_count )
2775
2776          CASE ( 0 )
2777
2778             DO  ib = 1, nbins_aerosol
2779                aerosol_number(ib)%conc(nzb:nzt+1,nysg:nyng,nxlg:nxrg)   => nconc_1(:,:,:,ib)
2780                aerosol_number(ib)%conc_p(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => nconc_2(:,:,:,ib)
2781
2782                DO  ic = 1, ncomponents_mass
2783                   icc = ( ic-1 ) * nbins_aerosol + ib
2784                   aerosol_mass(icc)%conc(nzb:nzt+1,nysg:nyng,nxlg:nxrg)   => mconc_1(:,:,:,icc)
2785                   aerosol_mass(icc)%conc_p(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => mconc_2(:,:,:,icc)
2786                ENDDO
2787             ENDDO
2788
2789             IF ( .NOT. salsa_gases_from_chem )  THEN
2790                DO  ig = 1, ngases_salsa
2791                   salsa_gas(ig)%conc(nzb:nzt+1,nysg:nyng,nxlg:nxrg)   => gconc_1(:,:,:,ig)
2792                   salsa_gas(ig)%conc_p(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => gconc_2(:,:,:,ig)
2793                ENDDO
2794             ENDIF
2795
2796          CASE ( 1 )
2797
2798             DO  ib = 1, nbins_aerosol
2799                aerosol_number(ib)%conc(nzb:nzt+1,nysg:nyng,nxlg:nxrg)   => nconc_2(:,:,:,ib)
2800                aerosol_number(ib)%conc_p(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => nconc_1(:,:,:,ib)
2801                DO  ic = 1, ncomponents_mass
2802                   icc = ( ic-1 ) * nbins_aerosol + ib
2803                   aerosol_mass(icc)%conc(nzb:nzt+1,nysg:nyng,nxlg:nxrg)   => mconc_2(:,:,:,icc)
2804                   aerosol_mass(icc)%conc_p(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => mconc_1(:,:,:,icc)
2805                ENDDO
2806             ENDDO
2807
2808             IF ( .NOT. salsa_gases_from_chem )  THEN
2809                DO  ig = 1, ngases_salsa
2810                   salsa_gas(ig)%conc(nzb:nzt+1,nysg:nyng,nxlg:nxrg)   => gconc_2(:,:,:,ig)
2811                   salsa_gas(ig)%conc_p(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => gconc_1(:,:,:,ig)
2812                ENDDO
2813             ENDIF
2814
2815       END SELECT
2816
2817    ENDIF
2818
2819 END SUBROUTINE salsa_swap_timelevel
2820
2821
2822!------------------------------------------------------------------------------!
2823! Description:
2824! ------------
2825!> This routine reads the respective restart data.
2826!------------------------------------------------------------------------------!
2827 SUBROUTINE salsa_rrd_local( k, nxlf, nxlc, nxl_on_file, nxrf, nxrc, nxr_on_file, nynf, nync,      &
2828                             nyn_on_file, nysf, nysc, nys_on_file, tmp_3d, found )
2829
2830    USE control_parameters,                                                                        &
2831        ONLY:  length, restart_string
2832
2833    IMPLICIT NONE
2834
2835    INTEGER(iwp) ::  ib              !<
2836    INTEGER(iwp) ::  ic              !<
2837    INTEGER(iwp) ::  ig              !<
2838    INTEGER(iwp) ::  k               !<
2839    INTEGER(iwp) ::  nxlc            !<
2840    INTEGER(iwp) ::  nxlf            !<
2841    INTEGER(iwp) ::  nxl_on_file     !<
2842    INTEGER(iwp) ::  nxrc            !<
2843    INTEGER(iwp) ::  nxrf            !<
2844    INTEGER(iwp) ::  nxr_on_file     !<
2845    INTEGER(iwp) ::  nync            !<
2846    INTEGER(iwp) ::  nynf            !<
2847    INTEGER(iwp) ::  nyn_on_file     !<
2848    INTEGER(iwp) ::  nysc            !<
2849    INTEGER(iwp) ::  nysf            !<
2850    INTEGER(iwp) ::  nys_on_file     !<
2851
2852    LOGICAL, INTENT(OUT)  ::  found  !<
2853
2854    REAL(wp), &
2855       DIMENSION(nzb:nzt+1,nys_on_file-nbgp:nyn_on_file+nbgp,nxl_on_file-nbgp:nxr_on_file+nbgp) :: tmp_3d   !<
2856
2857    found = .FALSE.
2858
2859    IF ( read_restart_data_salsa )  THEN
2860
2861       SELECT CASE ( restart_string(1:length) )
2862
2863          CASE ( 'aerosol_number' )
2864             DO  ib = 1, nbins_aerosol
2865                IF ( k == 1 )  READ ( 13 ) tmp_3d
2866                aerosol_number(ib)%conc(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) =               &
2867                                                   tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
2868                found = .TRUE.
2869             ENDDO
2870
2871          CASE ( 'aerosol_mass' )
2872             DO  ic = 1, ncomponents_mass * nbins_aerosol
2873                IF ( k == 1 )  READ ( 13 ) tmp_3d
2874                aerosol_mass(ic)%conc(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) =                 &
2875                                                   tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
2876                found = .TRUE.
2877             ENDDO
2878
2879          CASE ( 'salsa_gas' )
2880             DO  ig = 1, ngases_salsa
2881                IF ( k == 1 )  READ ( 13 ) tmp_3d
2882                salsa_gas(ig)%conc(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) =                    &
2883                                                   tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
2884                found = .TRUE.
2885             ENDDO
2886
2887          CASE DEFAULT
2888             found = .FALSE.
2889
2890       END SELECT
2891    ENDIF
2892
2893 END SUBROUTINE salsa_rrd_local
2894
2895!------------------------------------------------------------------------------!
2896! Description:
2897! ------------
2898!> This routine writes the respective restart data.
2899!> Note that the following input variables in PARIN have to be equal between
2900!> restart runs:
2901!>    listspec, nbin, nbin2, nf2a, ncc, mass_fracs_a, mass_fracs_b
2902!------------------------------------------------------------------------------!
2903 SUBROUTINE salsa_wrd_local
2904
2905    USE control_parameters,                                                                        &
2906        ONLY:  write_binary
2907
2908    IMPLICIT NONE
2909
2910    INTEGER(iwp) ::  ib   !<
2911    INTEGER(iwp) ::  ic   !<
2912    INTEGER(iwp) ::  ig  !<
2913
2914    IF ( write_binary  .AND.  write_binary_salsa )  THEN
2915
2916       CALL wrd_write_string( 'aerosol_number' )
2917       DO  ib = 1, nbins_aerosol
2918          WRITE ( 14 )  aerosol_number(ib)%conc
2919       ENDDO
2920
2921       CALL wrd_write_string( 'aerosol_mass' )
2922       DO  ic = 1, nbins_aerosol * ncomponents_mass
2923          WRITE ( 14 )  aerosol_mass(ic)%conc
2924       ENDDO
2925
2926       CALL wrd_write_string( 'salsa_gas' )
2927       DO  ig = 1, ngases_salsa
2928          WRITE ( 14 )  salsa_gas(ig)%conc
2929       ENDDO
2930
2931    ENDIF
2932
2933 END SUBROUTINE salsa_wrd_local
2934
2935!------------------------------------------------------------------------------!
2936! Description:
2937! ------------
2938!> Performs necessary unit and dimension conversion between the host model and
2939!> SALSA module, and calls the main SALSA routine.
2940!> Partially adobted form the original SALSA boxmodel version.
2941!> Now takes masses in as kg/kg from LES!! Converted to m3/m3 for SALSA
2942!> 05/2016 Juha: This routine is still pretty much in its original shape.
2943!>               It's dumb as a mule and twice as ugly, so implementation of
2944!>               an improved solution is necessary sooner or later.
2945!> Juha Tonttila, FMI, 2014
2946!> Jaakko Ahola, FMI, 2016
2947!> Only aerosol processes included, Mona Kurppa, UHel, 2017
2948!------------------------------------------------------------------------------!
2949 SUBROUTINE salsa_driver( i, j, prunmode )
2950
2951    USE arrays_3d,                                                                                 &
2952        ONLY: pt_p, q_p, u, v, w
2953
2954    USE plant_canopy_model_mod,                                                                    &
2955        ONLY: lad_s
2956
2957    USE surface_mod,                                                                               &
2958        ONLY:  surf_def_h, surf_def_v, surf_lsm_h, surf_lsm_v, surf_usm_h, surf_usm_v
2959
2960    IMPLICIT NONE
2961
2962    INTEGER(iwp) ::  endi    !< end index
2963    INTEGER(iwp) ::  ib      !< loop index
2964    INTEGER(iwp) ::  ic      !< loop index
2965    INTEGER(iwp) ::  ig      !< loop index
2966    INTEGER(iwp) ::  k_wall  !< vertical index of topography top
2967    INTEGER(iwp) ::  k       !< loop index
2968    INTEGER(iwp) ::  l       !< loop index
2969    INTEGER(iwp) ::  nc_h2o  !< index of H2O in the prtcl index table
2970    INTEGER(iwp) ::  ss      !< loop index
2971    INTEGER(iwp) ::  str     !< start index
2972    INTEGER(iwp) ::  vc      !< default index in prtcl
2973
2974    INTEGER(iwp), INTENT(in) ::  i         !< loop index
2975    INTEGER(iwp), INTENT(in) ::  j         !< loop index
2976    INTEGER(iwp), INTENT(in) ::  prunmode  !< 1: Initialization, 2: Spinup, 3: Regular runtime
2977
2978    REAL(wp) ::  cw_old  !< previous H2O mixing ratio
2979    REAL(wp) ::  flag    !< flag to mask topography grid points
2980    REAL(wp) ::  in_lad  !< leaf area density (m2/m3)
2981    REAL(wp) ::  in_rh   !< relative humidity
2982    REAL(wp) ::  zgso4   !< SO4
2983    REAL(wp) ::  zghno3  !< HNO3
2984    REAL(wp) ::  zgnh3   !< NH3
2985    REAL(wp) ::  zgocnv  !< non-volatile OC
2986    REAL(wp) ::  zgocsv  !< semi-volatile OC
2987
2988    REAL(wp), DIMENSION(nzb:nzt+1) ::  in_adn  !< air density (kg/m3)
2989    REAL(wp), DIMENSION(nzb:nzt+1) ::  in_cs   !< H2O sat. vapour conc.
2990    REAL(wp), DIMENSION(nzb:nzt+1) ::  in_cw   !< H2O vapour concentration
2991    REAL(wp), DIMENSION(nzb:nzt+1) ::  in_p    !< pressure (Pa)
2992    REAL(wp), DIMENSION(nzb:nzt+1) ::  in_t    !< temperature (K)
2993    REAL(wp), DIMENSION(nzb:nzt+1) ::  in_u    !< wind magnitude (m/s)
2994    REAL(wp), DIMENSION(nzb:nzt+1) ::  kvis    !< kinematic viscosity of air(m2/s)
2995    REAL(wp), DIMENSION(nzb:nzt+1) ::  ppm_to_nconc  !< Conversion factor from ppm to #/m3
2996
2997    REAL(wp), DIMENSION(nzb:nzt+1,nbins_aerosol) ::  schmidt_num  !< particle Schmidt number
2998    REAL(wp), DIMENSION(nzb:nzt+1,nbins_aerosol) ::  vd           !< particle fall seed (m/s)
2999
3000    TYPE(t_section), DIMENSION(nbins_aerosol) ::  lo_aero   !< additional variable for OpenMP
3001    TYPE(t_section), DIMENSION(nbins_aerosol) ::  aero_old  !< helper array
3002
3003    aero_old(:)%numc = 0.0_wp
3004    in_lad           = 0.0_wp
3005    in_u             = 0.0_wp
3006    kvis             = 0.0_wp
3007    lo_aero          = aero
3008    schmidt_num      = 0.0_wp
3009    vd               = 0.0_wp
3010    zgso4            = nclim
3011    zghno3           = nclim
3012    zgnh3            = nclim
3013    zgocnv           = nclim
3014    zgocsv           = nclim
3015!
3016!-- Aerosol number is always set, but mass can be uninitialized
3017    DO ib = 1, nbins_aerosol
3018       lo_aero(ib)%volc(:)  = 0.0_wp
3019       aero_old(ib)%volc(:) = 0.0_wp
3020    ENDDO
3021!
3022!-- Set the salsa runtime config (How to make this more efficient?)
3023    CALL set_salsa_runtime( prunmode )
3024!
3025!-- Calculate thermodynamic quantities needed in SALSA
3026    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 )
3027!
3028!-- Magnitude of wind: needed for deposition
3029    IF ( lsdepo )  THEN
3030       in_u(nzb+1:nzt) = SQRT( ( 0.5_wp * ( u(nzb+1:nzt,j,i) + u(nzb+1:nzt,j,i+1) ) )**2 +         &
3031                               ( 0.5_wp * ( v(nzb+1:nzt,j,i) + v(nzb+1:nzt,j+1,i) ) )**2 +         &
3032                               ( 0.5_wp * ( w(nzb:nzt-1,j,i) + w(nzb+1:nzt,j,  i) ) )**2 )
3033    ENDIF
3034!
3035!-- Calculate conversion factors for gas concentrations
3036    ppm_to_nconc(:) = for_ppm_to_nconc * in_p(:) / in_t(:)
3037!
3038!-- Determine topography-top index on scalar grid
3039    k_wall = k_topo_top(j,i)
3040
3041    DO k = nzb+1, nzt
3042!
3043!--    Predetermine flag to mask topography
3044       flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_0(k,j,i), 0 ) )
3045!
3046!--    Wind velocity for dry depositon on vegetation
3047       IF ( lsdepo_pcm  .AND.  plant_canopy )  THEN
3048          in_lad = lad_s( MAX( k-k_wall,0 ),j,i)
3049       ENDIF
3050!
3051!--    For initialization and spinup, limit the RH with the parameter rhlim
3052       IF ( prunmode < 3 ) THEN
3053          in_cw(k) = MIN( in_cw(k), in_cs(k) * rhlim )
3054       ELSE
3055          in_cw(k) = in_cw(k)
3056       ENDIF
3057       cw_old = in_cw(k) !* in_adn(k)
3058!
3059!--    Set volume concentrations:
3060!--    Sulphate (SO4) or sulphuric acid H2SO4
3061       IF ( index_so4 > 0 )  THEN
3062          vc = 1
3063          str = ( index_so4-1 ) * nbins_aerosol + 1    ! start index
3064          endi = index_so4 * nbins_aerosol             ! end index
3065          ic = 1
3066          DO ss = str, endi
3067             lo_aero(ic)%volc(vc) = aerosol_mass(ss)%conc(k,j,i) / arhoh2so4
3068             ic = ic+1
3069          ENDDO
3070          aero_old(1:nbins_aerosol)%volc(vc) = lo_aero(1:nbins_aerosol)%volc(vc)
3071       ENDIF
3072!
3073!--    Organic carbon (OC) compounds
3074       IF ( index_oc > 0 )  THEN
3075          vc = 2
3076          str = ( index_oc-1 ) * nbins_aerosol + 1
3077          endi = index_oc * nbins_aerosol
3078          ic = 1
3079          DO ss = str, endi
3080             lo_aero(ic)%volc(vc) = aerosol_mass(ss)%conc(k,j,i) / arhooc
3081             ic = ic+1
3082          ENDDO
3083          aero_old(1:nbins_aerosol)%volc(vc) = lo_aero(1:nbins_aerosol)%volc(vc)
3084       ENDIF
3085!
3086!--    Black carbon (BC)
3087       IF ( index_bc > 0 )  THEN
3088          vc = 3
3089          str = ( index_bc-1 ) * nbins_aerosol + 1 + end_subrange_1a
3090          endi = index_bc * nbins_aerosol
3091          ic = 1 + end_subrange_1a
3092          DO ss = str, endi
3093             lo_aero(ic)%volc(vc) = aerosol_mass(ss)%conc(k,j,i) / arhobc
3094             ic = ic+1
3095          ENDDO
3096          aero_old(1:nbins_aerosol)%volc(vc) = lo_aero(1:nbins_aerosol)%volc(vc)
3097       ENDIF
3098!
3099!--    Dust (DU)
3100       IF ( index_du > 0 )  THEN
3101          vc = 4
3102          str = ( index_du-1 ) * nbins_aerosol + 1 + end_subrange_1a
3103          endi = index_du * nbins_aerosol
3104          ic = 1 + end_subrange_1a
3105          DO ss = str, endi
3106             lo_aero(ic)%volc(vc) = aerosol_mass(ss)%conc(k,j,i) / arhodu
3107             ic = ic+1
3108          ENDDO
3109          aero_old(1:nbins_aerosol)%volc(vc) = lo_aero(1:nbins_aerosol)%volc(vc)
3110       ENDIF
3111!
3112!--    Sea salt (SS)
3113       IF ( index_ss > 0 )  THEN
3114          vc = 5
3115          str = ( index_ss-1 ) * nbins_aerosol + 1 + end_subrange_1a
3116          endi = index_ss * nbins_aerosol
3117          ic = 1 + end_subrange_1a
3118          DO ss = str, endi
3119             lo_aero(ic)%volc(vc) = aerosol_mass(ss)%conc(k,j,i) / arhoss
3120             ic = ic+1
3121          ENDDO
3122          aero_old(1:nbins_aerosol)%volc(vc) = lo_aero(1:nbins_aerosol)%volc(vc)
3123       ENDIF
3124!
3125!--    Nitrate (NO(3-)) or nitric acid HNO3
3126       IF ( index_no > 0 )  THEN
3127          vc = 6
3128          str = ( index_no-1 ) * nbins_aerosol + 1 
3129          endi = index_no * nbins_aerosol
3130          ic = 1
3131          DO ss = str, endi
3132             lo_aero(ic)%volc(vc) = aerosol_mass(ss)%conc(k,j,i) / arhohno3
3133             ic = ic+1
3134          ENDDO
3135          aero_old(1:nbins_aerosol)%volc(vc) = lo_aero(1:nbins_aerosol)%volc(vc)
3136       ENDIF
3137!
3138!--    Ammonium (NH(4+)) or ammonia NH3
3139       IF ( index_nh > 0 )  THEN
3140          vc = 7
3141          str = ( index_nh-1 ) * nbins_aerosol + 1
3142          endi = index_nh * nbins_aerosol
3143          ic = 1
3144          DO ss = str, endi
3145             lo_aero(ic)%volc(vc) = aerosol_mass(ss)%conc(k,j,i) / arhonh3
3146             ic = ic+1
3147          ENDDO
3148          aero_old(1:nbins_aerosol)%volc(vc) = lo_aero(1:nbins_aerosol)%volc(vc)
3149       ENDIF
3150!
3151!--    Water (always used)
3152       nc_h2o = get_index( prtcl,'H2O' )
3153       vc = 8
3154       str = ( nc_h2o-1 ) * nbins_aerosol + 1
3155       endi = nc_h2o * nbins_aerosol
3156       ic = 1
3157       IF ( advect_particle_water )  THEN
3158          DO ss = str, endi
3159             lo_aero(ic)%volc(vc) = aerosol_mass(ss)%conc(k,j,i) / arhoh2o
3160             ic = ic+1
3161          ENDDO
3162       ELSE
3163         lo_aero(1:nbins_aerosol)%volc(vc) = mclim
3164       ENDIF
3165       aero_old(1:nbins_aerosol)%volc(vc) = lo_aero(1:nbins_aerosol)%volc(vc)
3166!
3167!--    Number concentrations (numc) and particle sizes
3168!--    (dwet = wet diameter, core = dry volume)
3169       DO  ib = 1, nbins_aerosol
3170          lo_aero(ib)%numc = aerosol_number(ib)%conc(k,j,i)
3171          aero_old(ib)%numc = lo_aero(ib)%numc
3172          IF ( lo_aero(ib)%numc > nclim )  THEN
3173             lo_aero(ib)%dwet = ( SUM( lo_aero(ib)%volc(:) ) / lo_aero(ib)%numc / api6 )**0.33333333_wp
3174             lo_aero(ib)%core = SUM( lo_aero(ib)%volc(1:7) ) / lo_aero(ib)%numc
3175          ELSE
3176             lo_aero(ib)%dwet = lo_aero(ib)%dmid
3177             lo_aero(ib)%core = api6 * ( lo_aero(ib)%dwet )**3
3178          ENDIF
3179       ENDDO
3180!
3181!--    Calculate the ambient sizes of particles by equilibrating soluble fraction of particles with
3182!--    water using the ZSR method.
3183       in_rh = in_cw(k) / in_cs(k)
3184       IF ( prunmode==1  .OR.  .NOT. advect_particle_water )  THEN
3185          CALL equilibration( in_rh, in_t(k), lo_aero, .TRUE. )
3186       ENDIF
3187!
3188!--    Gaseous tracer concentrations in #/m3
3189       IF ( salsa_gases_from_chem )  THEN
3190!
3191!--       Convert concentrations in ppm to #/m3
3192          zgso4  = chem_species(gas_index_chem(1))%conc(k,j,i) * ppm_to_nconc(k)
3193          zghno3 = chem_species(gas_index_chem(2))%conc(k,j,i) * ppm_to_nconc(k)
3194          zgnh3  = chem_species(gas_index_chem(3))%conc(k,j,i) * ppm_to_nconc(k)
3195          zgocnv = chem_species(gas_index_chem(4))%conc(k,j,i) * ppm_to_nconc(k)
3196          zgocsv = chem_species(gas_index_chem(5))%conc(k,j,i) * ppm_to_nconc(k)
3197       ELSE
3198          zgso4  = salsa_gas(1)%conc(k,j,i)
3199          zghno3 = salsa_gas(2)%conc(k,j,i)
3200          zgnh3  = salsa_gas(3)%conc(k,j,i)
3201          zgocnv = salsa_gas(4)%conc(k,j,i)
3202          zgocsv = salsa_gas(5)%conc(k,j,i)
3203       ENDIF
3204!
3205!--    Calculate aerosol processes:
3206!--    *********************************************************************************************
3207!
3208!--    Coagulation
3209       IF ( lscoag )   THEN
3210          CALL coagulation( lo_aero, dt_salsa, in_t(k), in_p(k) )
3211       ENDIF
3212!
3213!--    Condensation
3214       IF ( lscnd )   THEN
3215          CALL condensation( lo_aero, zgso4, zgocnv, zgocsv,  zghno3, zgnh3, in_cw(k), in_cs(k),   &
3216                             in_t(k), in_p(k), dt_salsa, prtcl )
3217       ENDIF
3218!
3219!--    Deposition
3220       IF ( lsdepo )  THEN
3221          CALL deposition( lo_aero, in_t(k), in_adn(k), in_u(k), in_lad, kvis(k), schmidt_num(k,:),&
3222                           vd(k,:) )
3223       ENDIF
3224!
3225!--    Size distribution bin update
3226       IF ( lsdistupdate )   THEN
3227          CALL distr_update( lo_aero )
3228       ENDIF
3229!--    *********************************************************************************************
3230
3231       IF ( lsdepo ) sedim_vd(k,j,i,:) = vd(k,:)
3232!
3233!--    Calculate changes in concentrations
3234       DO ib = 1, nbins_aerosol
3235          aerosol_number(ib)%conc(k,j,i) = aerosol_number(ib)%conc(k,j,i) + ( lo_aero(ib)%numc -   &
3236                                           aero_old(ib)%numc ) * flag
3237       ENDDO
3238
3239       IF ( index_so4 > 0 )  THEN
3240          vc = 1
3241          str = ( index_so4-1 ) * nbins_aerosol + 1
3242          endi = index_so4 * nbins_aerosol
3243          ic = 1
3244          DO ss = str, endi
3245             aerosol_mass(ss)%conc(k,j,i) = aerosol_mass(ss)%conc(k,j,i) + ( lo_aero(ic)%volc(vc) -&
3246                                            aero_old(ic)%volc(vc) ) * arhoh2so4 * flag
3247             ic = ic+1
3248          ENDDO
3249       ENDIF
3250
3251       IF ( index_oc > 0 )  THEN
3252          vc = 2
3253          str = ( index_oc-1 ) * nbins_aerosol + 1
3254          endi = index_oc * nbins_aerosol
3255          ic = 1
3256          DO ss = str, endi
3257             aerosol_mass(ss)%conc(k,j,i) = aerosol_mass(ss)%conc(k,j,i) + ( lo_aero(ic)%volc(vc) -&
3258                                            aero_old(ic)%volc(vc) ) * arhooc * flag
3259             ic = ic+1
3260          ENDDO
3261       ENDIF
3262
3263       IF ( index_bc > 0 )  THEN
3264          vc = 3
3265          str = ( index_bc-1 ) * nbins_aerosol + 1 + end_subrange_1a
3266          endi = index_bc * nbins_aerosol
3267          ic = 1 + end_subrange_1a
3268          DO ss = str, endi
3269             aerosol_mass(ss)%conc(k,j,i) = aerosol_mass(ss)%conc(k,j,i) + ( lo_aero(ic)%volc(vc) -&
3270                                            aero_old(ic)%volc(vc) ) * arhobc * flag
3271             ic = ic+1
3272          ENDDO
3273       ENDIF
3274
3275       IF ( index_du > 0 )  THEN
3276          vc = 4
3277          str = ( index_du-1 ) * nbins_aerosol + 1 + end_subrange_1a
3278          endi = index_du * nbins_aerosol
3279          ic = 1 + end_subrange_1a
3280          DO ss = str, endi
3281             aerosol_mass(ss)%conc(k,j,i) = aerosol_mass(ss)%conc(k,j,i) + ( lo_aero(ic)%volc(vc) -&
3282                                            aero_old(ic)%volc(vc) ) * arhodu * flag
3283             ic = ic+1
3284          ENDDO
3285       ENDIF
3286
3287       IF ( index_ss > 0 )  THEN
3288          vc = 5
3289          str = ( index_ss-1 ) * nbins_aerosol + 1 + end_subrange_1a
3290          endi = index_ss * nbins_aerosol
3291          ic = 1 + end_subrange_1a
3292          DO ss = str, endi
3293             aerosol_mass(ss)%conc(k,j,i) = aerosol_mass(ss)%conc(k,j,i) + ( lo_aero(ic)%volc(vc) -&
3294                                            aero_old(ic)%volc(vc) ) * arhoss * flag
3295             ic = ic+1
3296          ENDDO
3297       ENDIF
3298
3299       IF ( index_no > 0 )  THEN
3300          vc = 6
3301          str = ( index_no-1 ) * nbins_aerosol + 1
3302          endi = index_no * nbins_aerosol
3303          ic = 1
3304          DO ss = str, endi
3305             aerosol_mass(ss)%conc(k,j,i) = aerosol_mass(ss)%conc(k,j,i) + ( lo_aero(ic)%volc(vc) -&
3306                                            aero_old(ic)%volc(vc) ) * arhohno3 * flag
3307             ic = ic+1
3308          ENDDO
3309       ENDIF
3310
3311       IF ( index_nh > 0 )  THEN
3312          vc = 7
3313          str = ( index_nh-1 ) * nbins_aerosol + 1
3314          endi = index_nh * nbins_aerosol
3315          ic = 1
3316          DO ss = str, endi
3317             aerosol_mass(ss)%conc(k,j,i) = aerosol_mass(ss)%conc(k,j,i) + ( lo_aero(ic)%volc(vc) -&
3318                                            aero_old(ic)%volc(vc) ) * arhonh3 * flag
3319             ic = ic+1
3320          ENDDO
3321       ENDIF
3322
3323       IF ( advect_particle_water )  THEN
3324          nc_h2o = get_index( prtcl,'H2O' )
3325          vc = 8
3326          str = ( nc_h2o-1 ) * nbins_aerosol + 1
3327          endi = nc_h2o * nbins_aerosol
3328          ic = 1
3329          DO ss = str, endi
3330             aerosol_mass(ss)%conc(k,j,i) = aerosol_mass(ss)%conc(k,j,i) + ( lo_aero(ic)%volc(vc) -&
3331                                            aero_old(ic)%volc(vc) ) * arhoh2o * flag
3332             ic = ic+1
3333          ENDDO
3334       ENDIF
3335       IF ( prunmode == 1 )  THEN
3336          nc_h2o = get_index( prtcl,'H2O' )
3337          vc = 8
3338          str = ( nc_h2o-1 ) * nbins_aerosol + 1
3339          endi = nc_h2o * nbins_aerosol
3340          ic = 1
3341          DO ss = str, endi
3342             aerosol_mass(ss)%init(k) = MAX( aerosol_mass(ss)%init(k), ( lo_aero(ic)%volc(vc) - &
3343                                             aero_old(ic)%volc(vc) ) * arhoh2o )
3344             IF ( k == nzb+1 )  THEN
3345                aerosol_mass(ss)%init(k-1) = aerosol_mass(ss)%init(k)
3346             ELSEIF ( k == nzt  )  THEN
3347                aerosol_mass(ss)%init(k+1) = aerosol_mass(ss)%init(k)
3348                aerosol_mass(ss)%conc(k+1,j,i) = aerosol_mass(ss)%init(k)
3349             ENDIF
3350             ic = ic+1
3351          ENDDO
3352       ENDIF
3353!
3354!--    Condensation of precursor gases
3355       IF ( lscndgas )  THEN
3356          IF ( salsa_gases_from_chem )  THEN
3357!
3358!--          SO4 (or H2SO4)
3359             ig = gas_index_chem(1)
3360             chem_species(ig)%conc(k,j,i) = chem_species(ig)%conc(k,j,i) + ( zgso4 /               &
3361                                            ppm_to_nconc(k) - chem_species(ig)%conc(k,j,i) ) * flag
3362!
3363!--          HNO3
3364             ig = gas_index_chem(2)
3365             chem_species(ig)%conc(k,j,i) = chem_species(ig)%conc(k,j,i) + ( zghno3 /              &
3366                                            ppm_to_nconc(k) - chem_species(ig)%conc(k,j,i) ) * flag
3367!
3368!--          NH3
3369             ig = gas_index_chem(3)
3370             chem_species(ig)%conc(k,j,i) = chem_species(ig)%conc(k,j,i) + ( zgnh3 /               &
3371                                            ppm_to_nconc(k) - chem_species(ig)%conc(k,j,i) ) * flag
3372!
3373!--          non-volatile OC
3374             ig = gas_index_chem(4)
3375             chem_species(ig)%conc(k,j,i) = chem_species(ig)%conc(k,j,i) + ( zgocnv /              &
3376                                            ppm_to_nconc(k) - chem_species(ig)%conc(k,j,i) ) * flag
3377!
3378!--          semi-volatile OC
3379             ig = gas_index_chem(5)
3380             chem_species(ig)%conc(k,j,i) = chem_species(ig)%conc(k,j,i) + ( zgocsv /              &
3381                                            ppm_to_nconc(k) - chem_species(ig)%conc(k,j,i) ) * flag
3382
3383          ELSE
3384!
3385!--          SO4 (or H2SO4)
3386             salsa_gas(1)%conc(k,j,i) = salsa_gas(1)%conc(k,j,i) + ( zgso4 -                       &
3387                                        salsa_gas(1)%conc(k,j,i) ) * flag
3388!
3389!--          HNO3
3390             salsa_gas(2)%conc(k,j,i) = salsa_gas(2)%conc(k,j,i) + ( zghno3 -                      &
3391                                        salsa_gas(2)%conc(k,j,i) ) * flag
3392!
3393!--          NH3
3394             salsa_gas(3)%conc(k,j,i) = salsa_gas(3)%conc(k,j,i) + ( zgnh3 -                       &
3395                                        salsa_gas(3)%conc(k,j,i) ) * flag
3396!
3397!--          non-volatile OC
3398             salsa_gas(4)%conc(k,j,i) = salsa_gas(4)%conc(k,j,i) + ( zgocnv -                      &
3399                                        salsa_gas(4)%conc(k,j,i) ) * flag
3400!
3401!--          semi-volatile OC
3402             salsa_gas(5)%conc(k,j,i) = salsa_gas(5)%conc(k,j,i) + ( zgocsv -                      &
3403                                        salsa_gas(5)%conc(k,j,i) ) * flag
3404          ENDIF
3405       ENDIF
3406!
3407!--    Tendency of water vapour mixing ratio is obtained from the change in RH during SALSA run.
3408!--    This releases heat and changes pt. Assumes no temperature change during SALSA run.
3409!--    q = r / (1+r), Euler method for integration
3410!
3411       IF ( feedback_to_palm )  THEN
3412          q_p(k,j,i) = q_p(k,j,i) + 1.0_wp / ( in_cw(k) * in_adn(k) + 1.0_wp )**2 *                &
3413                       ( in_cw(k) - cw_old ) * in_adn(k) * flag
3414          pt_p(k,j,i) = pt_p(k,j,i) + alv / c_p * ( in_cw(k) - cw_old ) * in_adn(k) / ( in_cw(k) / &
3415                        in_adn(k) + 1.0_wp )**2 * pt_p(k,j,i) / in_t(k) * flag
3416       ENDIF
3417
3418    ENDDO   ! k
3419
3420!
3421!-- Set surfaces and wall fluxes due to deposition
3422    IF ( lsdepo  .AND.  lsdepo_surf  .AND.  prunmode == 3 )  THEN
3423       IF ( .NOT. land_surface  .AND.  .NOT. urban_surface )  THEN
3424          CALL depo_surf( i, j, surf_def_h(0), vd, schmidt_num, kvis, in_u, .TRUE. )
3425          DO  l = 0, 3
3426             CALL depo_surf( i, j, surf_def_v(l), vd, schmidt_num, kvis, in_u, .FALSE. )
3427          ENDDO
3428       ELSE
3429          CALL depo_surf( i, j, surf_usm_h, vd, schmidt_num, kvis, in_u, .TRUE., usm_to_depo_h )
3430          DO  l = 0, 3
3431             CALL depo_surf( i, j, surf_usm_v(l), vd, schmidt_num, kvis, in_u, .FALSE.,            &
3432                             usm_to_depo_v(l) )
3433          ENDDO
3434          CALL depo_surf( i, j, surf_lsm_h, vd, schmidt_num, kvis, in_u, .TRUE., lsm_to_depo_h )
3435          DO  l = 0, 3
3436             CALL depo_surf( i, j, surf_lsm_v(l), vd, schmidt_num, kvis, in_u, .FALSE.,            &
3437                             lsm_to_depo_v(l) )
3438          ENDDO
3439       ENDIF
3440    ENDIF
3441
3442    IF ( prunmode < 3 )  THEN
3443       !$OMP MASTER
3444       aero = lo_aero
3445       !$OMP END MASTER
3446    END IF
3447
3448 END SUBROUTINE salsa_driver
3449
3450!------------------------------------------------------------------------------!
3451! Description:
3452! ------------
3453!> Set logical switches according to the salsa_parameters options.
3454!> Juha Tonttila, FMI, 2014
3455!> Only aerosol processes included, Mona Kurppa, UHel, 2017
3456!------------------------------------------------------------------------------!
3457 SUBROUTINE set_salsa_runtime( prunmode )
3458
3459    IMPLICIT NONE
3460
3461    INTEGER(iwp), INTENT(in) ::  prunmode
3462
3463    SELECT CASE(prunmode)
3464
3465       CASE(1) !< Initialization
3466          lscoag       = .FALSE.
3467          lscnd        = .FALSE.
3468          lscndgas     = .FALSE.
3469          lscndh2oae   = .FALSE.
3470          lsdepo       = .FALSE.
3471          lsdepo_pcm   = .FALSE.
3472          lsdepo_surf  = .FALSE.
3473          lsdistupdate = .TRUE.
3474          lspartition  = .FALSE.
3475
3476       CASE(2)  !< Spinup period
3477          lscoag      = ( .FALSE. .AND. nlcoag   )
3478          lscnd       = ( .TRUE.  .AND. nlcnd    )
3479          lscndgas    = ( .TRUE.  .AND. nlcndgas )
3480          lscndh2oae  = ( .TRUE.  .AND. nlcndh2oae )
3481
3482       CASE(3)  !< Run
3483          lscoag       = nlcoag
3484          lscnd        = nlcnd
3485          lscndgas     = nlcndgas
3486          lscndh2oae   = nlcndh2oae
3487          lsdepo       = nldepo
3488          lsdepo_pcm   = nldepo_pcm
3489          lsdepo_surf  = nldepo_surf
3490          lsdistupdate = nldistupdate
3491    END SELECT
3492
3493
3494 END SUBROUTINE set_salsa_runtime
3495 
3496!------------------------------------------------------------------------------!
3497! Description:
3498! ------------
3499!> Calculates the absolute temperature (using hydrostatic pressure), saturation
3500!> vapour pressure and mixing ratio over water, relative humidity and air
3501!> density needed in the SALSA model.
3502!> NOTE, no saturation adjustment takes place -> the resulting water vapour
3503!> mixing ratio can be supersaturated, allowing the microphysical calculations
3504!> in SALSA.
3505!
3506!> Juha Tonttila, FMI, 2014 (original SALSAthrm)
3507!> Mona Kurppa, UHel, 2017 (adjustment for PALM and only aerosol processes)
3508!------------------------------------------------------------------------------!
3509 SUBROUTINE salsa_thrm_ij( i, j, p_ij, temp_ij, cw_ij, cs_ij, adn_ij )
3510
3511    USE arrays_3d,                                                                                 &
3512        ONLY: pt, q, zu
3513
3514    USE basic_constants_and_equations_mod,                                                         &
3515        ONLY:  barometric_formula, exner_function, ideal_gas_law_rho, magnus
3516
3517    IMPLICIT NONE
3518
3519    INTEGER(iwp), INTENT(in) ::  i  !<
3520    INTEGER(iwp), INTENT(in) ::  j  !<
3521
3522    REAL(wp) ::  t_surface  !< absolute surface temperature (K)
3523
3524    REAL(wp), DIMENSION(nzb:nzt+1) ::  e_s  !< saturation vapour pressure over water (Pa)
3525
3526    REAL(wp), DIMENSION(:), INTENT(inout) ::  adn_ij   !< air density (kg/m3)
3527    REAL(wp), DIMENSION(:), INTENT(inout) ::  p_ij     !< air pressure (Pa)
3528    REAL(wp), DIMENSION(:), INTENT(inout) ::  temp_ij  !< air temperature (K)
3529
3530    REAL(wp), DIMENSION(:), INTENT(inout), OPTIONAL ::  cw_ij  !< water vapour concentration (kg/m3)
3531    REAL(wp), DIMENSION(:), INTENT(inout), OPTIONAL ::  cs_ij  !< saturation water vap. conc.(kg/m3)
3532!
3533!-- Pressure p_ijk (Pa) = hydrostatic pressure
3534    t_surface = pt_surface * exner_function( surface_pressure * 100.0_wp )
3535    p_ij(:) = barometric_formula( zu, t_surface, surface_pressure * 100.0_wp )
3536!
3537!-- Absolute ambient temperature (K)
3538    temp_ij(:) = pt(:,j,i) * exner_function( p_ij(:) )
3539!
3540!-- Air density
3541    adn_ij(:) = ideal_gas_law_rho( p_ij(:), temp_ij(:) )
3542!
3543!-- Water vapour concentration r_v (kg/m3)
3544    IF ( PRESENT( cw_ij ) )  THEN
3545       cw_ij(:) = ( q(:,j,i) / ( 1.0_wp - q(:,j,i) ) ) * adn_ij(:)
3546    ENDIF
3547!
3548!-- Saturation mixing ratio r_s (kg/kg) from vapour pressure at temp (Pa)
3549    IF ( PRESENT( cs_ij ) )  THEN
3550       e_s(:) = 611.0_wp * EXP( alv_d_rv * ( 3.6609E-3_wp - 1.0_wp /           &
3551                temp_ij(:) ) )! magnus( temp_ij(:) )
3552       cs_ij(:) = ( 0.622_wp * e_s / ( p_ij(:) - e_s(:) ) ) * adn_ij(:)
3553    ENDIF
3554
3555 END SUBROUTINE salsa_thrm_ij
3556
3557!------------------------------------------------------------------------------!
3558! Description:
3559! ------------
3560!> Calculates ambient sizes of particles by equilibrating soluble fraction of
3561!> particles with water using the ZSR method (Stokes and Robinson, 1966).
3562!> Method:
3563!> Following chemical components are assumed water-soluble
3564!> - (ammonium) sulphate (100%)
3565!> - sea salt (100 %)
3566!> - organic carbon (epsoc * 100%)
3567!> Exact thermodynamic considerations neglected.
3568!> - If particles contain no sea salt, calculation according to sulphate
3569!>   properties
3570!> - If contain sea salt but no sulphate, calculation according to sea salt
3571!>   properties
3572!> - If contain both sulphate and sea salt -> the molar fraction of these
3573!>   compounds determines which one of them is used as the basis of calculation.
3574!> If sulphate and sea salt coexist in a particle, it is assumed that the Cl is
3575!> replaced by sulphate; thus only either sulphate + organics or sea salt +
3576!> organics is included in the calculation of soluble fraction.
3577!> Molality parameterizations taken from Table 1 of Tang: Thermodynamic and
3578!> optical properties of mixed-salt aerosols of atmospheric importance,
3579!> J. Geophys. Res., 102 (D2), 1883-1893 (1997)
3580!
3581!> Coded by:
3582!> Hannele Korhonen (FMI) 2005
3583!> Harri Kokkola (FMI) 2006
3584!> Matti Niskanen(FMI) 2012
3585!> Anton Laakso  (FMI) 2013
3586!> Modified for the new aerosol datatype, Juha Tonttila (FMI) 2014
3587!
3588!> fxm: should sea salt form a solid particle when prh is very low (even though
3589!> it could be mixed with e.g. sulphate)?
3590!> fxm: crashes if no sulphate or sea salt
3591!> fxm: do we really need to consider Kelvin effect for subrange 2
3592!------------------------------------------------------------------------------!
3593 SUBROUTINE equilibration( prh, ptemp, paero, init )
3594
3595    IMPLICIT NONE
3596
3597    INTEGER(iwp) :: ib      !< loop index
3598    INTEGER(iwp) :: counti  !< loop index
3599
3600    LOGICAL, INTENT(in) ::  init   !< TRUE: Initialization, FALSE: Normal runtime: update water
3601                                   !< content only for 1a
3602
3603    REAL(wp) ::  zaw      !< water activity [0-1]
3604    REAL(wp) ::  zcore    !< Volume of dry particle
3605    REAL(wp) ::  zdold    !< Old diameter
3606    REAL(wp) ::  zdwet    !< Wet diameter or mean droplet diameter
3607    REAL(wp) ::  zke      !< Kelvin term in the Köhler equation
3608    REAL(wp) ::  zlwc     !< liquid water content [kg/m3-air]
3609    REAL(wp) ::  zrh      !< Relative humidity
3610
3611    REAL(wp), DIMENSION(maxspec) ::  zbinmol  !< binary molality of each components (mol/kg)
3612    REAL(wp), DIMENSION(maxspec) ::  zvpart   !< volume of chem. compounds in one particle
3613
3614    REAL(wp), INTENT(in) ::  prh    !< relative humidity [0-1]
3615    REAL(wp), INTENT(in) ::  ptemp  !< temperature (K)
3616
3617    TYPE(t_section), DIMENSION(nbins_aerosol), INTENT(inout) ::  paero  !< aerosol properties
3618
3619    zaw       = 0.0_wp
3620    zlwc      = 0.0_wp
3621!
3622!-- Relative humidity:
3623    zrh = prh
3624    zrh = MAX( zrh, 0.05_wp )
3625    zrh = MIN( zrh, 0.98_wp)
3626!
3627!-- 1) Regime 1: sulphate and partly water-soluble OC. Done for every CALL
3628    DO  ib = start_subrange_1a, end_subrange_1a   ! size bin
3629
3630       zbinmol = 0.0_wp
3631       zdold   = 1.0_wp
3632       zke     = 1.02_wp
3633
3634       IF ( paero(ib)%numc > nclim )  THEN
3635!
3636!--       Volume in one particle
3637          zvpart = 0.0_wp
3638          zvpart(1:2) = paero(ib)%volc(1:2) / paero(ib)%numc
3639          zvpart(6:7) = paero(ib)%volc(6:7) / paero(ib)%numc
3640!
3641!--       Total volume and wet diameter of one dry particle
3642          zcore = SUM( zvpart(1:2) )
3643          zdwet = paero(ib)%dwet
3644
3645          counti = 0
3646          DO  WHILE ( ABS( zdwet / zdold - 1.0_wp ) > 1.0E-2_wp )
3647
3648             zdold = MAX( zdwet, 1.0E-20_wp )
3649             zaw = MAX( 1.0E-3_wp, zrh / zke ) ! To avoid underflow
3650!
3651!--          Binary molalities (mol/kg):
3652!--          Sulphate
3653             zbinmol(1) = 1.1065495E+2_wp - 3.6759197E+2_wp * zaw + 5.0462934E+2_wp * zaw**2 -     &
3654                          3.1543839E+2_wp * zaw**3 + 6.770824E+1_wp  * zaw**4
3655!--          Organic carbon
3656             zbinmol(2) = 1.0_wp / ( zaw * amh2o ) - 1.0_wp / amh2o
3657!--          Nitric acid
3658             zbinmol(6) = 2.306844303E+1_wp - 3.563608869E+1_wp * zaw - 6.210577919E+1_wp * zaw**2 &
3659                          + 5.510176187E+2_wp * zaw**3 - 1.460055286E+3_wp * zaw**4                &
3660                          + 1.894467542E+3_wp * zaw**5 - 1.220611402E+3_wp * zaw**6                &
3661                          + 3.098597737E+2_wp * zaw**7
3662!
3663!--          Calculate the liquid water content (kg/m3-air) using ZSR (see e.g. Eq. 10.98 in
3664!--          Seinfeld and Pandis (2006))
3665             zlwc = ( paero(ib)%volc(1) * ( arhoh2so4 / amh2so4 ) ) / zbinmol(1) +                 &
3666                    epsoc * paero(ib)%volc(2) * ( arhooc / amoc ) / zbinmol(2) +                   &
3667                    ( paero(ib)%volc(6) * ( arhohno3/amhno3 ) ) / zbinmol(6)
3668!
3669!--          Particle wet diameter (m)
3670             zdwet = ( zlwc / paero(ib)%numc / arhoh2o / api6 + ( SUM( zvpart(6:7) ) / api6 ) +    &
3671                       zcore / api6 )**0.33333333_wp
3672!
3673!--          Kelvin effect (Eq. 10.85 in in Seinfeld and Pandis (2006)). Avoid
3674!--          overflow.
3675             zke = EXP( MIN( 50.0_wp, 4.0_wp * surfw0 * amvh2so4 / ( abo * ptemp *  zdwet ) ) )
3676
3677             counti = counti + 1
3678             IF ( counti > 1000 )  THEN
3679                message_string = 'Subrange 1: no convergence!'
3680                CALL message( 'salsa_mod: equilibration', 'PA0617', 1, 2, 0, 6, 0 )
3681             ENDIF
3682          ENDDO
3683!
3684!--       Instead of lwc, use the volume concentration of water from now on
3685!--       (easy to convert...)
3686          paero(ib)%volc(8) = zlwc / arhoh2o
3687!
3688!--       If this is initialization, update the core and wet diameter
3689          IF ( init )  THEN
3690             paero(ib)%dwet = zdwet
3691             paero(ib)%core = zcore
3692          ENDIF
3693
3694       ELSE
3695!--       If initialization
3696!--       1.2) empty bins given bin average values
3697          IF ( init )  THEN
3698             paero(ib)%dwet = paero(ib)%dmid
3699             paero(ib)%core = api6 * paero(ib)%dmid**3
3700          ENDIF
3701
3702       ENDIF
3703
3704    ENDDO  ! ib
3705!
3706!-- 2) Regime 2a: sulphate, OC, BC and sea salt
3707!--    This is done only for initialization call, otherwise the water contents
3708!--    are computed via condensation
3709    IF ( init )  THEN
3710       DO  ib = start_subrange_2a, end_subrange_2b
3711!
3712!--       Initialize
3713          zke     = 1.02_wp
3714          zbinmol = 0.0_wp
3715          zdold   = 1.0_wp
3716!
3717!--       1) Particle properties calculated for non-empty bins
3718          IF ( paero(ib)%numc > nclim )  THEN
3719!
3720!--          Volume in one particle [fxm]
3721             zvpart = 0.0_wp
3722             zvpart(1:7) = paero(ib)%volc(1:7) / paero(ib)%numc
3723!
3724!--          Total volume and wet diameter of one dry particle [fxm]
3725             zcore = SUM( zvpart(1:5) )
3726             zdwet = paero(ib)%dwet
3727
3728             counti = 0
3729             DO  WHILE ( ABS( zdwet / zdold - 1.0_wp ) > 1.0E-12_wp )
3730
3731                zdold = MAX( zdwet, 1.0E-20_wp )
3732                zaw = zrh / zke
3733!
3734!--             Binary molalities (mol/kg):
3735!--             Sulphate
3736                zbinmol(1) = 1.1065495E+2_wp - 3.6759197E+2_wp * zaw + 5.0462934E+2_wp * zaw**2 -  &
3737                             3.1543839E+2_wp * zaw**3 + 6.770824E+1_wp  * zaw**4
3738!--             Organic carbon
3739                zbinmol(2) = 1.0_wp / ( zaw * amh2o ) - 1.0_wp / amh2o
3740!--             Nitric acid
3741                zbinmol(6) = 2.306844303E+1_wp          - 3.563608869E+1_wp * zaw -                &
3742                             6.210577919E+1_wp * zaw**2 + 5.510176187E+2_wp * zaw**3 -             &
3743                             1.460055286E+3_wp * zaw**4 + 1.894467542E+3_wp * zaw**5 -             &
3744                             1.220611402E+3_wp * zaw**6 + 3.098597737E+2_wp * zaw**7 
3745!--             Sea salt (natrium chloride)
3746                zbinmol(5) = 5.875248E+1_wp - 1.8781997E+2_wp * zaw + 2.7211377E+2_wp * zaw**2 -   &
3747                             1.8458287E+2_wp * zaw**3 + 4.153689E+1_wp  * zaw**4
3748!
3749!--             Calculate the liquid water content (kg/m3-air)
3750                zlwc = ( paero(ib)%volc(1) * ( arhoh2so4 / amh2so4 ) ) / zbinmol(1) +              &
3751                       epsoc * ( paero(ib)%volc(2) * ( arhooc / amoc ) ) / zbinmol(2) +            &
3752                       ( paero(ib)%volc(6) * ( arhohno3 / amhno3 ) ) / zbinmol(6) +                &
3753                       ( paero(ib)%volc(5) * ( arhoss / amss ) ) / zbinmol(5)
3754
3755!--             Particle wet radius (m)
3756                zdwet = ( zlwc / paero(ib)%numc / arhoh2o / api6 + ( SUM( zvpart(6:7) ) / api6 )  + &
3757                           zcore / api6 )**0.33333333_wp
3758!
3759!--             Kelvin effect (Eq. 10.85 in Seinfeld and Pandis (2006))
3760                zke = EXP( MIN( 50.0_wp, 4.0_wp * surfw0 * amvh2so4 / ( abo * zdwet * ptemp ) ) )
3761
3762                counti = counti + 1
3763                IF ( counti > 1000 )  THEN
3764                   message_string = 'Subrange 2: no convergence!'
3765                CALL message( 'salsa_mod: equilibration', 'PA0618', 1, 2, 0, 6, 0 )
3766                ENDIF
3767             ENDDO
3768!
3769!--          Liquid water content; instead of LWC use the volume concentration
3770             paero(ib)%volc(8) = zlwc / arhoh2o
3771             paero(ib)%dwet    = zdwet
3772             paero(ib)%core    = zcore
3773
3774          ELSE
3775!--          2.2) empty bins given bin average values
3776             paero(ib)%dwet = paero(ib)%dmid
3777             paero(ib)%core = api6 * paero(ib)%dmid**3
3778          ENDIF
3779
3780       ENDDO   ! ib
3781    ENDIF
3782
3783 END SUBROUTINE equilibration
3784
3785!------------------------------------------------------------------------------!
3786!> Description:
3787!> ------------
3788!> Calculation of the settling velocity vc (m/s) per aerosol size bin and
3789!> deposition on plant canopy (lsdepo_pcm).
3790!
3791!> Deposition is based on either the scheme presented in:
3792!> Zhang et al. (2001), Atmos. Environ. 35, 549-560 (includes collection due to
3793!> Brownian diffusion, impaction, interception and sedimentation; hereafter ZO1)
3794!> OR
3795!> Petroff & Zhang (2010), Geosci. Model Dev. 3, 753-769 (includes also
3796!> collection due to turbulent impaction, hereafter P10)
3797!
3798!> Equation numbers refer to equation in Jacobson (2005): Fundamentals of
3799!> Atmospheric Modeling, 2nd Edition.
3800!
3801!> Subroutine follows closely sedim_SALSA in UCLALES-SALSA written by Juha
3802!> Tonttila (KIT/FMI) and Zubair Maalick (UEF).
3803!> Rewritten to PALM by Mona Kurppa (UH), 2017.
3804!
3805!> Call for grid point i,j,k
3806!------------------------------------------------------------------------------!
3807
3808 SUBROUTINE deposition( paero, tk, adn, mag_u, lad, kvis, schmidt_num, vc )
3809
3810    USE plant_canopy_model_mod,                                                                    &
3811        ONLY:  cdc
3812
3813    IMPLICIT NONE
3814
3815    INTEGER(iwp) ::  ib   !< loop index
3816    INTEGER(iwp) ::  ic   !< loop index
3817
3818    REAL(wp) ::  alpha             !< parameter, Table 3 in Z01
3819    REAL(wp) ::  avis              !< molecular viscocity of air (kg/(m*s))
3820    REAL(wp) ::  beta_im           !< parameter for turbulent impaction
3821    REAL(wp) ::  c_brownian_diff   !< coefficient for Brownian diffusion
3822    REAL(wp) ::  c_impaction       !< coefficient for inertial impaction
3823    REAL(wp) ::  c_interception    !< coefficient for interception
3824    REAL(wp) ::  c_turb_impaction  !< coefficient for turbulent impaction
3825    REAL(wp) ::  depo              !< deposition velocity (m/s)
3826    REAL(wp) ::  gamma             !< parameter, Table 3 in Z01
3827    REAL(wp) ::  lambda            !< molecular mean free path (m)
3828    REAL(wp) ::  mdiff             !< particle diffusivity coefficient
3829    REAL(wp) ::  par_a             !< parameter A for the characteristic radius of collectors,
3830                                   !< Table 3 in Z01
3831    REAL(wp) ::  par_l             !< obstacle characteristic dimension in P10
3832    REAL(wp) ::  pdn               !< particle density (kg/m3)
3833    REAL(wp) ::  ustar             !< friction velocity (m/s)
3834    REAL(wp) ::  va                !< thermal speed of an air molecule (m/s)
3835
3836    REAL(wp), INTENT(in) ::  adn    !< air density (kg/m3)
3837    REAL(wp), INTENT(in) ::  lad    !< leaf area density (m2/m3)
3838    REAL(wp), INTENT(in) ::  mag_u  !< wind velocity (m/s)
3839    REAL(wp), INTENT(in) ::  tk     !< abs.temperature (K)
3840
3841    REAL(wp), INTENT(inout) ::  kvis   !< kinematic viscosity of air (m2/s)
3842
3843    REAL(wp), DIMENSION(nbins_aerosol) ::  beta   !< Cunningham slip-flow correction factor
3844    REAL(wp), DIMENSION(nbins_aerosol) ::  Kn     !< Knudsen number
3845    REAL(wp), DIMENSION(nbins_aerosol) ::  zdwet  !< wet diameter (m)
3846
3847    REAL(wp), DIMENSION(:), INTENT(inout) ::  schmidt_num  !< particle Schmidt number
3848    REAL(wp), DIMENSION(:), INTENT(inout) ::  vc  !< critical fall speed i.e. settling velocity of
3849                                                  !< an aerosol particle (m/s)
3850
3851    TYPE(t_section), DIMENSION(nbins_aerosol), INTENT(inout) ::  paero  !< aerosol properties
3852!
3853!-- Initialise
3854    depo  = 0.0_wp
3855    pdn   = 1500.0_wp    ! default value
3856    ustar = 0.0_wp
3857!
3858!-- Molecular viscosity of air (Eq. 4.54)
3859    avis = 1.8325E-5_wp * ( 416.16_wp / ( tk + 120.0_wp ) ) * ( tk / 296.16_wp )**1.5_wp
3860!
3861!-- Kinematic viscosity (Eq. 4.55)
3862    kvis =  avis / adn
3863!
3864!-- Thermal velocity of an air molecule (Eq. 15.32)
3865    va = SQRT( 8.0_wp * abo * tk / ( pi * am_airmol ) )
3866!
3867!-- Mean free path (m) (Eq. 15.24)
3868    lambda = 2.0_wp * avis / ( adn * va )
3869!
3870!-- Particle wet diameter (m)
3871    zdwet = paero(:)%dwet
3872!
3873!-- Knudsen number (Eq. 15.23)
3874    Kn = MAX( 1.0E-2_wp, lambda / ( zdwet * 0.5_wp ) ) ! To avoid underflow
3875!
3876!-- Cunningham slip-flow correction (Eq. 15.30)
3877    beta = 1.0_wp + Kn * ( 1.249_wp + 0.42_wp * EXP( -0.87_wp / Kn ) )
3878!
3879!-- Critical fall speed i.e. settling velocity  (Eq. 20.4)
3880    vc = MIN( 1.0_wp, zdwet**2 * ( pdn - adn ) * g * beta / ( 18.0_wp * avis ) )
3881!
3882!-- Deposition on vegetation
3883    IF ( lsdepo_pcm  .AND.  plant_canopy  .AND.  lad > 0.0_wp )  THEN
3884!
3885!--    Parameters for the land use category 'deciduous broadleaf trees'(Table 3)
3886       alpha   = alpha_z01(depo_pcm_type_num)
3887       gamma   = gamma_z01(depo_pcm_type_num)
3888       par_a   = A_z01(depo_pcm_type_num, season_z01) * 1.0E-3_wp
3889!
3890!--    Deposition efficiencies from Table 1. Constants from Table 2.
3891       par_l            = l_p10(depo_pcm_type_num) * 0.01_wp
3892       c_brownian_diff  = c_b_p10(depo_pcm_type_num)
3893       c_interception   = c_in_p10(depo_pcm_type_num)
3894       c_impaction      = c_im_p10(depo_pcm_type_num)
3895       beta_im          = beta_im_p10(depo_pcm_type_num)
3896       c_turb_impaction = c_it_p10(depo_pcm_type_num)
3897
3898       DO  ib = 1, nbins_aerosol
3899
3900          IF ( paero(ib)%numc < ( 2.0_wp * nclim ) )  CYCLE
3901
3902!--       Particle diffusivity coefficient (Eq. 15.29)
3903          mdiff = ( abo * tk * beta(ib) ) / ( 3.0_wp * pi * avis * zdwet(ib) )
3904!
3905!--       Particle Schmidt number (Eq. 15.36)
3906          schmidt_num(ib) = kvis / mdiff
3907!
3908!--       Friction velocity for deposition on vegetation. Calculated following Prandtl (1925):
3909          ustar = SQRT( cdc ) * mag_u
3910          SELECT CASE ( depo_pcm_par_num )
3911
3912             CASE ( 1 )   ! Zhang et al. (2001)
3913                CALL depo_vel_Z01( vc(ib), ustar, schmidt_num(ib), paero(ib)%dwet, alpha,  gamma,  &
3914                                   par_a, depo )
3915             CASE ( 2 )   ! Petroff & Zhang (2010)
3916                CALL depo_vel_P10( vc(ib), mag_u, ustar, kvis, schmidt_num(ib), paero(ib)%dwet,    &
3917                                   par_l, c_brownian_diff, c_interception, c_impaction, beta_im,   &
3918                                   c_turb_impaction, depo )
3919          END SELECT
3920!
3921!--       Calculate the change in concentrations
3922          paero(ib)%numc = paero(ib)%numc - depo * lad * paero(ib)%numc * dt_salsa
3923          DO  ic = 1, maxspec+1
3924             paero(ib)%volc(ic) = paero(ib)%volc(ic) - depo * lad * paero(ib)%volc(ic) * dt_salsa
3925          ENDDO
3926       ENDDO
3927
3928    ENDIF
3929
3930 END SUBROUTINE deposition
3931
3932!------------------------------------------------------------------------------!
3933! Description:
3934! ------------
3935!> Calculate deposition velocity (m/s) based on Zhan et al. (2001, case 1).
3936!------------------------------------------------------------------------------!
3937
3938 SUBROUTINE depo_vel_Z01( vc, ustar, schmidt_num, diameter, alpha, gamma, par_a, depo )
3939
3940    IMPLICIT NONE
3941
3942    REAL(wp) ::  rs                !< overall quasi-laminar resistance for particles
3943    REAL(wp) ::  stokes_num        !< Stokes number for smooth or bluff surfaces
3944
3945    REAL(wp), INTENT(in) ::  alpha        !< parameter, Table 3 in Z01
3946    REAL(wp), INTENT(in) ::  gamma        !< parameter, Table 3 in Z01
3947    REAL(wp), INTENT(in) ::  par_a        !< parameter A for the characteristic diameter of
3948                                          !< collectors, Table 3 in Z01
3949    REAL(wp), INTENT(in) ::  diameter     !< particle diameter
3950    REAL(wp), INTENT(in) ::  schmidt_num  !< particle Schmidt number
3951    REAL(wp), INTENT(in) ::  ustar        !< friction velocity (m/s)
3952    REAL(wp), INTENT(in) ::  vc           !< terminal velocity (m/s)
3953
3954    REAL(wp), INTENT(inout)  ::  depo     !< deposition efficiency (m/s)
3955
3956    IF ( par_a > 0.0_wp )  THEN
3957!
3958!--    Initialise
3959       rs = 0.0_wp
3960!
3961!--    Stokes number for vegetated surfaces (Seinfeld & Pandis (2006): Eq.19.24)
3962       stokes_num = vc * ustar / ( g * par_a )
3963!
3964!--    The overall quasi-laminar resistance for particles (Zhang et al., Eq. 5)
3965       rs = MAX( EPSILON( 1.0_wp ), ( 3.0_wp * ustar * EXP( -stokes_num**0.5_wp ) *                &
3966                 ( schmidt_num**( -gamma ) + ( stokes_num / ( alpha + stokes_num ) )**2 +          &
3967                 0.5_wp * ( diameter / par_a )**2 ) ) )
3968
3969       depo = rs + vc
3970
3971    ELSE
3972       depo = 0.0_wp
3973    ENDIF
3974
3975 END SUBROUTINE depo_vel_Z01
3976
3977!------------------------------------------------------------------------------!
3978! Description:
3979! ------------
3980!> Calculate deposition velocity (m/s) based on Petroff & Zhang (2010, case 2).
3981!------------------------------------------------------------------------------!
3982
3983 SUBROUTINE depo_vel_P10( vc, mag_u, ustar, kvis_a, schmidt_num, diameter, par_l, c_brownian_diff, &
3984                          c_interception, c_impaction, beta_im, c_turb_impaction, depo )
3985
3986    IMPLICIT NONE
3987
3988    REAL(wp) ::  stokes_num        !< Stokes number for smooth or bluff surfaces
3989    REAL(wp) ::  tau_plus          !< dimensionless particle relaxation time
3990    REAL(wp) ::  v_bd              !< deposition velocity due to Brownian diffusion
3991    REAL(wp) ::  v_im              !< deposition velocity due to impaction
3992    REAL(wp) ::  v_in              !< deposition velocity due to interception
3993    REAL(wp) ::  v_it              !< deposition velocity due to turbulent impaction
3994
3995    REAL(wp), INTENT(in) ::  beta_im           !< parameter for turbulent impaction
3996    REAL(wp), INTENT(in) ::  c_brownian_diff   !< coefficient for Brownian diffusion
3997    REAL(wp), INTENT(in) ::  c_impaction       !< coefficient for inertial impaction
3998    REAL(wp), INTENT(in) ::  c_interception    !< coefficient for interception
3999    REAL(wp), INTENT(in) ::  c_turb_impaction  !< coefficient for turbulent impaction
4000    REAL(wp), INTENT(in) ::  kvis_a       !< kinematic viscosity of air (m2/s)
4001    REAL(wp), INTENT(in) ::  mag_u        !< wind velocity (m/s)
4002    REAL(wp), INTENT(in) ::  par_l        !< obstacle characteristic dimension in P10
4003    REAL(wp), INTENT(in) ::  diameter       !< particle diameter
4004    REAL(wp), INTENT(in) ::  schmidt_num  !< particle Schmidt number
4005    REAL(wp), INTENT(in) ::  ustar        !< friction velocity (m/s)
4006    REAL(wp), INTENT(in) ::  vc           !< terminal velocity (m/s)
4007
4008    REAL(wp), INTENT(inout)  ::  depo     !< deposition efficiency (m/s)
4009
4010    IF ( par_l > 0.0_wp )  THEN
4011!
4012!--    Initialise
4013       tau_plus = 0.0_wp
4014       v_bd     = 0.0_wp
4015       v_im     = 0.0_wp
4016       v_in     = 0.0_wp
4017       v_it     = 0.0_wp
4018!
4019!--    Stokes number for vegetated surfaces (Seinfeld & Pandis (2006): Eq.19.24)
4020       stokes_num = vc * ustar / ( g * par_l )
4021!
4022!--    Non-dimensional relexation time of the particle on top of canopy
4023       tau_plus = vc * ustar**2 / ( kvis_a * g )
4024!
4025!--    Brownian diffusion
4026       v_bd = mag_u * c_brownian_diff * schmidt_num**( -0.66666666_wp ) *                          &
4027              ( mag_u * par_l / kvis_a )**( -0.5_wp )
4028!
4029!--    Interception
4030       v_in = mag_u * c_interception * diameter / par_l *                                          &
4031              ( 2.0_wp + LOG( 2.0_wp * par_l / diameter ) )
4032!
4033!--    Impaction: Petroff (2009) Eq. 18
4034       v_im = mag_u * c_impaction * ( stokes_num / ( stokes_num + beta_im ) )**2
4035!
4036!--    Turbulent impaction
4037       IF ( tau_plus < 20.0_wp )  THEN
4038          v_it = 2.5E-3_wp * c_turb_impaction * tau_plus**2
4039       ELSE
4040          v_it = c_turb_impaction
4041       ENDIF
4042
4043       depo = ( v_bd + v_in + v_im + v_it + vc )
4044
4045    ELSE
4046       depo = 0.0_wp
4047    ENDIF
4048
4049 END SUBROUTINE depo_vel_P10
4050
4051!------------------------------------------------------------------------------!
4052! Description:
4053! ------------
4054!> Calculate the dry deposition on horizontal and vertical surfaces. Implement
4055!> as a surface flux.
4056!> @todo aerodynamic resistance ignored for now (not important for
4057!        high-resolution simulations)
4058!------------------------------------------------------------------------------!
4059 SUBROUTINE depo_surf( i, j, surf, vc, schmidt_num, kvis, mag_u, norm, match_array )
4060
4061    USE arrays_3d,                                                                                 &
4062        ONLY: rho_air_zw
4063
4064    USE surface_mod,                                                                               &
4065        ONLY:  ind_pav_green, ind_veg_wall, ind_wat_win, surf_type
4066
4067    IMPLICIT NONE
4068
4069    INTEGER(iwp) ::  ib      !< loop index
4070    INTEGER(iwp) ::  ic      !< loop index
4071    INTEGER(iwp) ::  icc     !< additional loop index
4072    INTEGER(iwp) ::  k       !< loop index
4073    INTEGER(iwp) ::  m       !< loop index
4074    INTEGER(iwp) ::  surf_e  !< End index of surface elements at (j,i)-gridpoint
4075    INTEGER(iwp) ::  surf_s  !< Start index of surface elements at (j,i)-gridpoint
4076
4077    INTEGER(iwp), INTENT(in) ::  i  !< loop index
4078    INTEGER(iwp), INTENT(in) ::  j  !< loop index
4079
4080    LOGICAL, INTENT(in) ::  norm   !< to normalise or not
4081
4082    REAL(wp) ::  alpha             !< parameter, Table 3 in Z01
4083    REAL(wp) ::  beta_im           !< parameter for turbulent impaction
4084    REAL(wp) ::  c_brownian_diff   !< coefficient for Brownian diffusion
4085    REAL(wp) ::  c_impaction       !< coefficient for inertial impaction
4086    REAL(wp) ::  c_interception    !< coefficient for interception
4087    REAL(wp) ::  c_turb_impaction  !< coefficient for turbulent impaction
4088    REAL(wp) ::  gamma             !< parameter, Table 3 in Z01
4089    REAL(wp) ::  norm_fac          !< normalisation factor (usually air density)
4090    REAL(wp) ::  par_a             !< parameter A for the characteristic radius of collectors,
4091                                   !< Table 3 in Z01
4092    REAL(wp) ::  par_l             !< obstacle characteristic dimension in P10
4093    REAL(wp) ::  rs                !< the overall quasi-laminar resistance for particles
4094    REAL(wp) ::  tau_plus          !< dimensionless particle relaxation time
4095    REAL(wp) ::  v_bd              !< deposition velocity due to Brownian diffusion
4096    REAL(wp) ::  v_im              !< deposition velocity due to impaction
4097    REAL(wp) ::  v_in              !< deposition velocity due to interception
4098    REAL(wp) ::  v_it              !< deposition velocity due to turbulent impaction
4099
4100    REAL(wp), DIMENSION(nbins_aerosol) ::  depo      !< deposition efficiency
4101    REAL(wp), DIMENSION(nbins_aerosol) ::  depo_sum  !< sum of deposition efficiencies
4102
4103    REAL(wp), DIMENSION(:), INTENT(in) ::  kvis   !< kinematic viscosity of air (m2/s)
4104    REAL(wp), DIMENSION(:), INTENT(in) ::  mag_u  !< wind velocity (m/s)
4105
4106    REAL(wp), DIMENSION(:,:), INTENT(in) ::  schmidt_num   !< particle Schmidt number
4107    REAL(wp), DIMENSION(:,:), INTENT(in) ::  vc            !< terminal velocity (m/s)
4108
4109    TYPE(match_surface), INTENT(in), OPTIONAL ::  match_array  !< match the deposition module and
4110                                                               !< LSM/USM surfaces
4111    TYPE(surf_type), INTENT(inout) :: surf                     !< respective surface type
4112!
4113!-- Initialise
4114    depo     = 0.0_wp
4115    depo_sum = 0.0_wp
4116    rs       = 0.0_wp
4117    surf_s   = surf%start_index(j,i)
4118    surf_e   = surf%end_index(j,i)
4119    tau_plus = 0.0_wp
4120    v_bd     = 0.0_wp
4121    v_im     = 0.0_wp
4122    v_in     = 0.0_wp
4123    v_it     = 0.0_wp
4124!
4125!-- Model parameters for the land use category. If LSM or USM is applied, import
4126!-- characteristics. Otherwise, apply surface type "urban".
4127    alpha   = alpha_z01(luc_urban)
4128    gamma   = gamma_z01(luc_urban)
4129    par_a   = A_z01(luc_urban, season_z01) * 1.0E-3_wp
4130
4131    par_l            = l_p10(luc_urban) * 0.01_wp
4132    c_brownian_diff  = c_b_p10(luc_urban)
4133    c_interception   = c_in_p10(luc_urban)
4134    c_impaction      = c_im_p10(luc_urban)
4135    beta_im          = beta_im_p10(luc_urban)
4136    c_turb_impaction = c_it_p10(luc_urban)
4137
4138
4139    IF ( PRESENT( match_array ) )  THEN  ! land or urban surface model
4140
4141       DO  m = surf_s, surf_e
4142
4143          k = surf%k(m)
4144          norm_fac = 1.0_wp
4145
4146          IF ( norm )  norm_fac = rho_air_zw(k)  ! normalise vertical fluxes by air density
4147
4148          IF ( match_array%match_lupg(m) > 0 )  THEN
4149             alpha = alpha_z01( match_array%match_lupg(m) )
4150             gamma = gamma_z01( match_array%match_lupg(m) )
4151             par_a = A_z01( match_array%match_lupg(m), season_z01 ) * 1.0E-3_wp
4152
4153             beta_im          = beta_im_p10( match_array%match_lupg(m) )
4154             c_brownian_diff  = c_b_p10( match_array%match_lupg(m) )
4155             c_impaction      = c_im_p10( match_array%match_lupg(m) )
4156             c_interception   = c_in_p10( match_array%match_lupg(m) )
4157             c_turb_impaction = c_it_p10( match_array%match_lupg(m) )
4158             par_l            = l_p10( match_array%match_lupg(m) ) * 0.01_wp
4159
4160             DO  ib = 1, nbins_aerosol
4161                IF ( aerosol_number(ib)%conc(k,j,i) < ( 2.0_wp * nclim )  .OR.                     &
4162                     schmidt_num(k+1,ib) < 1.0_wp )  CYCLE
4163
4164                SELECT CASE ( depo_surf_par_num )
4165
4166                   CASE ( 1 )
4167                      CALL depo_vel_Z01( vc(k+1,ib), surf%us(m), schmidt_num(k+1,ib),              &
4168                                         ra_dry(k,j,i,ib), alpha, gamma, par_a, depo(ib) )
4169                   CASE ( 2 )
4170                      CALL depo_vel_P10( vc(k+1,ib), mag_u(k+1), surf%us(m), kvis(k+1),            &
4171                                         schmidt_num(k+1,ib), ra_dry(k,j,i,ib), par_l,             &
4172                                         c_brownian_diff, c_interception, c_impaction, beta_im,    &
4173                                         c_turb_impaction, depo(ib) )
4174                END SELECT
4175             ENDDO
4176             depo_sum = depo_sum + surf%frac(ind_pav_green,m) * depo
4177          ENDIF
4178
4179          IF ( match_array%match_luvw(m) > 0 )  THEN
4180             alpha = alpha_z01( match_array%match_luvw(m) )
4181             gamma = gamma_z01( match_array%match_luvw(m) )
4182             par_a = A_z01( match_array%match_luvw(m), season_z01 ) * 1.0E-3_wp
4183
4184             beta_im          = beta_im_p10( match_array%match_luvw(m) )
4185             c_brownian_diff  = c_b_p10( match_array%match_luvw(m) )
4186             c_impaction      = c_im_p10( match_array%match_luvw(m) )
4187             c_interception   = c_in_p10( match_array%match_luvw(m) )
4188             c_turb_impaction = c_it_p10( match_array%match_luvw(m) )
4189             par_l            = l_p10( match_array%match_luvw(m) ) * 0.01_wp
4190
4191             DO  ib = 1, nbins_aerosol
4192                IF ( aerosol_number(ib)%conc(k,j,i) < ( 2.0_wp * nclim )  .OR.                     &
4193                     schmidt_num(k+1,ib) < 1.0_wp )  CYCLE
4194
4195                SELECT CASE ( depo_surf_par_num )
4196
4197                   CASE ( 1 )
4198                      CALL depo_vel_Z01( vc(k+1,ib), surf%us(m), schmidt_num(k+1,ib),              &
4199                                         ra_dry(k,j,i,ib), alpha, gamma, par_a, depo(ib) )
4200                   CASE ( 2 )
4201                      CALL depo_vel_P10( vc(k+1,ib), mag_u(k+1), surf%us(m), kvis(k+1),            &
4202                                         schmidt_num(k+1,ib), ra_dry(k,j,i,ib), par_l,             &
4203                                         c_brownian_diff, c_interception, c_impaction, beta_im,    &
4204                                         c_turb_impaction, depo(ib) )
4205                END SELECT
4206             ENDDO
4207             depo_sum = depo_sum + surf%frac(ind_veg_wall,m) * depo
4208          ENDIF
4209
4210          IF ( match_array%match_luww(m) > 0 )  THEN
4211             alpha = alpha_z01( match_array%match_luww(m) )
4212             gamma = gamma_z01( match_array%match_luww(m) )
4213             par_a = A_z01( match_array%match_luww(m), season_z01 ) * 1.0E-3_wp
4214
4215             beta_im          = beta_im_p10( match_array%match_luww(m) )
4216             c_brownian_diff  = c_b_p10( match_array%match_luww(m) )
4217             c_impaction      = c_im_p10( match_array%match_luww(m) )
4218             c_interception   = c_in_p10( match_array%match_luww(m) )
4219             c_turb_impaction = c_it_p10( match_array%match_luww(m) )
4220             par_l            = l_p10( match_array%match_luww(m) ) * 0.01_wp
4221
4222             DO  ib = 1, nbins_aerosol
4223                IF ( aerosol_number(ib)%conc(k,j,i) < ( 2.0_wp * nclim )  .OR.                     &
4224                     schmidt_num(k+1,ib) < 1.0_wp )  CYCLE
4225
4226                SELECT CASE ( depo_surf_par_num )
4227
4228                   CASE ( 1 )
4229                      CALL depo_vel_Z01( vc(k+1,ib), surf%us(m), schmidt_num(k+1,ib),              &
4230                                         ra_dry(k,j,i,ib), alpha, gamma, par_a, depo(ib) )
4231                   CASE ( 2 )
4232                      CALL depo_vel_P10( vc(k+1,ib), mag_u(k+1), surf%us(m), kvis(k+1),            &
4233                                         schmidt_num(k+1,ib), ra_dry(k,j,i,ib), par_l,             &
4234                                         c_brownian_diff, c_interception, c_impaction, beta_im,    &
4235                                         c_turb_impaction, depo(ib) )
4236                END SELECT
4237             ENDDO
4238             depo_sum = depo_sum + surf%frac(ind_wat_win,m) * depo
4239          ENDIF
4240
4241          DO  ib = 1, nbins_aerosol
4242             IF ( aerosol_number(ib)%conc(k,j,i) < ( 2.0_wp * nclim ) )  CYCLE
4243!
4244!--          Calculate changes in surface fluxes due to dry deposition
4245             IF ( include_emission )  THEN
4246                surf%answs(m,ib) = aerosol_number(ib)%source(j,i) - MAX( 0.0_wp,                   &
4247                                   depo_sum(ib) * norm_fac * aerosol_number(ib)%conc(k,j,i) )
4248                DO  ic = 1, ncomponents_mass
4249                   icc = ( ic - 1 ) * nbins_aerosol + ib
4250                   surf%amsws(m,icc) = aerosol_mass(icc)%source(j,i) - MAX( 0.0_wp,                &
4251                                       depo_sum(ib) *  norm_fac * aerosol_mass(icc)%conc(k,j,i) )
4252                ENDDO  ! ic
4253             ELSE
4254                surf%answs(m,ib) = -depo_sum(ib) * norm_fac * aerosol_number(ib)%conc(k,j,i)
4255                DO  ic = 1, ncomponents_mass
4256                   icc = ( ic - 1 ) * nbins_aerosol + ib
4257                   surf%amsws(m,icc) = -depo_sum(ib) *  norm_fac * aerosol_mass(icc)%conc(k,j,i)
4258                ENDDO  ! ic
4259             ENDIF
4260          ENDDO  ! ib
4261
4262       ENDDO
4263
4264    ELSE  ! default surfaces
4265
4266       DO  m = surf_s, surf_e
4267
4268          k = surf%k(m)
4269          norm_fac = 1.0_wp
4270
4271          IF ( norm )  norm_fac = rho_air_zw(k)  ! normalise vertical fluxes by air density
4272
4273          DO  ib = 1, nbins_aerosol
4274             IF ( aerosol_number(ib)%conc(k,j,i) < ( 2.0_wp * nclim )  .OR.                        &
4275                  schmidt_num(k+1,ib) < 1.0_wp )  CYCLE
4276
4277             SELECT CASE ( depo_surf_par_num )
4278
4279                CASE ( 1 )
4280                   CALL depo_vel_Z01( vc(k+1,ib), surf%us(m), schmidt_num(k+1,ib),                 &
4281                                      ra_dry(k,j,i,ib), alpha, gamma, par_a, depo(ib) )
4282                CASE ( 2 )
4283                   CALL depo_vel_P10( vc(k+1,ib), mag_u(k+1), surf%us(m), kvis(k+1),               &
4284                                      schmidt_num(k+1,ib), ra_dry(k,j,i,ib), par_l,                &
4285                                      c_brownian_diff, c_interception, c_impaction, beta_im,       &
4286                                      c_turb_impaction, depo(ib) )
4287             END SELECT
4288!
4289!--          Calculate changes in surface fluxes due to dry deposition
4290             IF ( include_emission )  THEN
4291                surf%answs(m,ib) = aerosol_number(ib)%source(j,i) - MAX( 0.0_wp,                   &
4292                                   depo(ib) * norm_fac * aerosol_number(ib)%conc(k,j,i) )
4293                DO  ic = 1, ncomponents_mass
4294                   icc = ( ic - 1 ) * nbins_aerosol + ib
4295                   surf%amsws(m,icc) = aerosol_mass(icc)%source(j,i) - MAX( 0.0_wp,                &
4296                                       depo(ib) *  norm_fac * aerosol_mass(icc)%conc(k,j,i) )
4297                ENDDO  ! ic
4298             ELSE
4299                surf%answs(m,ib) = -depo(ib) * norm_fac * aerosol_number(ib)%conc(k,j,i)
4300                DO  ic = 1, ncomponents_mass
4301                   icc = ( ic - 1 ) * nbins_aerosol + ib
4302                   surf%amsws(m,icc) = -depo(ib) *  norm_fac * aerosol_mass(icc)%conc(k,j,i)
4303                ENDDO  ! ic
4304             ENDIF
4305          ENDDO  ! ib
4306       ENDDO
4307
4308    ENDIF
4309
4310 END SUBROUTINE depo_surf
4311
4312!------------------------------------------------------------------------------!
4313! Description:
4314! ------------
4315!> Calculates particle loss and change in size distribution due to (Brownian)
4316!> coagulation. Only for particles with dwet < 30 micrometres.
4317!
4318!> Method:
4319!> Semi-implicit, non-iterative method: (Jacobson, 1994)
4320!> Volume concentrations of the smaller colliding particles added to the bin of
4321!> the larger colliding particles. Start from first bin and use the updated
4322!> number and volume for calculation of following bins. NB! Our bin numbering
4323!> does not follow particle size in subrange 2.
4324!
4325!> Schematic for bin numbers in different subranges:
4326!>             1                            2
4327!>    +-------------------------------------------+
4328!>  a | 1 | 2 | 3 || 4 | 5 | 6 | 7 |  8 |  9 | 10||
4329!>  b |           ||11 |12 |13 |14 | 15 | 16 | 17||
4330!>    +-------------------------------------------+
4331!
4332!> Exact coagulation coefficients for each pressure level are scaled according
4333!> to current particle wet size (linear scaling).
4334!> Bins are organized in terms of the dry size of the condensation nucleus,
4335!> while coagulation kernell is calculated with the actual hydrometeor
4336!> size.
4337!
4338!> Called from salsa_driver
4339!> fxm: Process selection should be made smarter - now just lots of IFs inside
4340!>      loops
4341!
4342!> Coded by:
4343!> Hannele Korhonen (FMI) 2005
4344!> Harri Kokkola (FMI) 2006
4345!> Tommi Bergman (FMI) 2012
4346!> Matti Niskanen(FMI) 2012
4347!> Anton Laakso  (FMI) 2013
4348!> Juha Tonttila (FMI) 2014
4349!------------------------------------------------------------------------------!
4350 SUBROUTINE coagulation( paero, ptstep, ptemp, ppres )
4351
4352    IMPLICIT NONE
4353
4354    INTEGER(iwp) ::  index_2a !< corresponding bin in subrange 2a
4355    INTEGER(iwp) ::  index_2b !< corresponding bin in subrange 2b
4356    INTEGER(iwp) ::  ib       !< loop index
4357    INTEGER(iwp) ::  ll       !< loop index
4358    INTEGER(iwp) ::  mm       !< loop index
4359    INTEGER(iwp) ::  nn       !< loop index
4360
4361    REAL(wp) ::  pressi          !< pressure
4362    REAL(wp) ::  temppi          !< temperature
4363    REAL(wp) ::  zdpart_mm       !< diameter of particle (m)
4364    REAL(wp) ::  zdpart_nn       !< diameter of particle (m)
4365    REAL(wp) ::  zminusterm      !< coagulation loss in a bin (1/s)
4366
4367    REAL(wp), INTENT(in) ::  ppres  !< ambient pressure (Pa)
4368    REAL(wp), INTENT(in) ::  ptemp  !< ambient temperature (K)
4369    REAL(wp), INTENT(in) ::  ptstep !< time step (s)
4370
4371    REAL(wp), DIMENSION(nbins_aerosol) ::  zmpart     !< approximate mass of particles (kg)
4372    REAL(wp), DIMENSION(maxspec+1)     ::  zplusterm  !< coagulation gain in a bin (for each
4373                                                      !< chemical compound)
4374    REAL(wp), DIMENSION(nbins_aerosol,nbins_aerosol) ::  zcc  !< updated coagulation coeff. (m3/s)
4375
4376    TYPE(t_section), DIMENSION(nbins_aerosol), INTENT(inout) ::  paero  !< Aerosol properties
4377
4378    zdpart_mm = 0.0_wp
4379    zdpart_nn = 0.0_wp
4380!
4381!-- 1) Coagulation to coarse mode calculated in a simplified way:
4382!--    CoagSink ~ Dp in continuum subrange --> 'effective' number conc. of coarse particles
4383
4384!-- 2) Updating coagulation coefficients
4385!
4386!-- Aerosol mass (kg). Density of 1500 kg/m3 assumed
4387    zmpart(1:end_subrange_2b) = api6 * ( MIN( paero(1:end_subrange_2b)%dwet, 30.0E-6_wp )**3 )     &
4388                                * 1500.0_wp
4389    temppi = ptemp
4390    pressi = ppres
4391    zcc    = 0.0_wp
4392!
4393!-- Aero-aero coagulation
4394    DO  mm = 1, end_subrange_2b   ! smaller colliding particle
4395       IF ( paero(mm)%numc < ( 2.0_wp * nclim ) )  CYCLE
4396       DO  nn = mm, end_subrange_2b   ! larger colliding particle
4397          IF ( paero(nn)%numc < ( 2.0_wp * nclim ) )  CYCLE
4398
4399          zdpart_mm = MIN( paero(mm)%dwet, 30.0E-6_wp )     ! Limit to 30 um
4400          zdpart_nn = MIN( paero(nn)%dwet, 30.0E-6_wp )     ! Limit to 30 um
4401!
4402!--       Coagulation coefficient of particles (m3/s)
4403          zcc(mm,nn) = coagc( zdpart_mm, zdpart_nn, zmpart(mm), zmpart(nn), temppi, pressi )
4404          zcc(nn,mm) = zcc(mm,nn)
4405       ENDDO
4406    ENDDO
4407
4408!
4409!-- 3) New particle and volume concentrations after coagulation:
4410!--    Calculated according to Jacobson (2005) eq. 15.9
4411!
4412!-- Aerosols in subrange 1a:
4413    DO  ib = start_subrange_1a, end_subrange_1a
4414       IF ( paero(ib)%numc < ( 2.0_wp * nclim ) )  CYCLE
4415       zminusterm   = 0.0_wp
4416       zplusterm(:) = 0.0_wp
4417!
4418!--    Particles lost by coagulation with larger aerosols
4419       DO  ll = ib+1, end_subrange_2b
4420          zminusterm = zminusterm + zcc(ib,ll) * paero(ll)%numc
4421       ENDDO
4422!
4423!--    Coagulation gain in a bin: change in volume conc. (cm3/cm3):
4424       DO ll = start_subrange_1a, ib - 1
4425          zplusterm(1:2) = zplusterm(1:2) + zcc(ll,ib) * paero(ll)%volc(1:2)
4426          zplusterm(6:7) = zplusterm(6:7) + zcc(ll,ib) * paero(ll)%volc(6:7)
4427          zplusterm(8)   = zplusterm(8)   + zcc(ll,ib) * paero(ll)%volc(8)
4428       ENDDO
4429!
4430!--    Volume and number concentrations after coagulation update [fxm]
4431       paero(ib)%volc(1:2) = ( paero(ib)%volc(1:2) + ptstep * zplusterm(1:2) * paero(ib)%numc ) /  &
4432                            ( 1.0_wp + ptstep * zminusterm )
4433       paero(ib)%volc(6:8) = ( paero(ib)%volc(6:8) + ptstep * zplusterm(6:8) * paero(ib)%numc ) /  &
4434                            ( 1.0_wp + ptstep * zminusterm )
4435       paero(ib)%numc = paero(ib)%numc / ( 1.0_wp + ptstep * zminusterm + 0.5_wp * ptstep *        &
4436                        zcc(ib,ib) * paero(ib)%numc )
4437    ENDDO
4438!
4439!-- Aerosols in subrange 2a:
4440    DO  ib = start_subrange_2a, end_subrange_2a
4441       IF ( paero(ib)%numc < ( 2.0_wp * nclim ) )  CYCLE
4442       zminusterm   = 0.0_wp
4443       zplusterm(:) = 0.0_wp
4444!
4445!--    Find corresponding size bin in subrange 2b
4446       index_2b = ib - start_subrange_2a + start_subrange_2b
4447!
4448!--    Particles lost by larger particles in 2a
4449       DO  ll = ib+1, end_subrange_2a
4450          zminusterm = zminusterm + zcc(ib,ll) * paero(ll)%numc
4451       ENDDO
4452!
4453!--    Particles lost by larger particles in 2b
4454       IF ( .NOT. no_insoluble )  THEN
4455          DO  ll = index_2b+1, end_subrange_2b
4456             zminusterm = zminusterm + zcc(ib,ll) * paero(ll)%numc
4457          ENDDO
4458       ENDIF
4459!
4460!--    Particle volume gained from smaller particles in subranges 1, 2a and 2b
4461       DO  ll = start_subrange_1a, ib-1
4462          zplusterm(1:2) = zplusterm(1:2) + zcc(ll,ib) * paero(ll)%volc(1:2)
4463          zplusterm(6:8) = zplusterm(6:8) + zcc(ll,ib) * paero(ll)%volc(6:8)
4464       ENDDO
4465!
4466!--    Particle volume gained from smaller particles in 2a
4467!--    (Note, for components not included in the previous loop!)
4468       DO  ll = start_subrange_2a, ib-1
4469          zplusterm(3:5) = zplusterm(3:5) + zcc(ll,ib)*paero(ll)%volc(3:5)
4470       ENDDO
4471!
4472!--    Particle volume gained from smaller (and equal) particles in 2b
4473       IF ( .NOT. no_insoluble )  THEN
4474          DO  ll = start_subrange_2b, index_2b
4475             zplusterm(1:8) = zplusterm(1:8) + zcc(ll,ib) * paero(ll)%volc(1:8)
4476          ENDDO
4477       ENDIF
4478!
4479!--    Volume and number concentrations after coagulation update [fxm]
4480       paero(ib)%volc(1:8) = ( paero(ib)%volc(1:8) + ptstep * zplusterm(1:8) * paero(ib)%numc ) /  &
4481                            ( 1.0_wp + ptstep * zminusterm )
4482       paero(ib)%numc = paero(ib)%numc / ( 1.0_wp + ptstep * zminusterm + 0.5_wp * ptstep *        &
4483                        zcc(ib,ib) * paero(ib)%numc )
4484    ENDDO
4485!
4486!-- Aerosols in subrange 2b:
4487    IF ( .NOT. no_insoluble )  THEN
4488       DO  ib = start_subrange_2b, end_subrange_2b
4489          IF ( paero(ib)%numc < ( 2.0_wp * nclim ) )  CYCLE
4490          zminusterm   = 0.0_wp
4491          zplusterm(:) = 0.0_wp
4492!
4493!--       Find corresponding size bin in subsubrange 2a
4494          index_2a = ib - start_subrange_2b + start_subrange_2a
4495!
4496!--       Particles lost to larger particles in subranges 2b
4497          DO  ll = ib + 1, end_subrange_2b
4498             zminusterm = zminusterm + zcc(ib,ll) * paero(ll)%numc
4499          ENDDO
4500!
4501!--       Particles lost to larger and equal particles in 2a
4502          DO  ll = index_2a, end_subrange_2a
4503             zminusterm = zminusterm + zcc(ib,ll) * paero(ll)%numc
4504          ENDDO
4505!
4506!--       Particle volume gained from smaller particles in subranges 1 & 2a
4507          DO  ll = start_subrange_1a, index_2a - 1
4508             zplusterm(1:8) = zplusterm(1:8) + zcc(ll,ib) * paero(ll)%volc(1:8)
4509          ENDDO
4510!
4511!--       Particle volume gained from smaller particles in 2b
4512          DO  ll = start_subrange_2b, ib - 1
4513             zplusterm(1:8) = zplusterm(1:8) + zcc(ll,ib) * paero(ll)%volc(1:8)
4514          ENDDO
4515!
4516!--       Volume and number concentrations after coagulation update [fxm]
4517          paero(ib)%volc(1:8) = ( paero(ib)%volc(1:8) + ptstep * zplusterm(1:8) * paero(ib)%numc ) &
4518                                / ( 1.0_wp + ptstep * zminusterm )
4519          paero(ib)%numc = paero(ib)%numc / ( 1.0_wp + ptstep * zminusterm + 0.5_wp * ptstep *     &
4520                           zcc(ib,ib) * paero(ib)%numc )
4521       ENDDO
4522    ENDIF
4523
4524 END SUBROUTINE coagulation
4525
4526!------------------------------------------------------------------------------!
4527! Description:
4528! ------------
4529!> Calculation of coagulation coefficients. Extended version of the function
4530!> originally found in mo_salsa_init.
4531!
4532!> J. Tonttila, FMI, 05/2014
4533!------------------------------------------------------------------------------!
4534 REAL(wp) FUNCTION coagc( diam1, diam2, mass1, mass2, temp, pres )
4535
4536    IMPLICIT NONE
4537
4538    REAL(wp) ::  fmdist  !< distance of flux matching (m)
4539    REAL(wp) ::  knud_p  !< particle Knudsen number
4540    REAL(wp) ::  mdiam   !< mean diameter of colliding particles (m)
4541    REAL(wp) ::  mfp     !< mean free path of air molecules (m)
4542    REAL(wp) ::  visc    !< viscosity of air (kg/(m s))
4543
4544    REAL(wp), INTENT(in) ::  diam1  !< diameter of colliding particle 1 (m)
4545    REAL(wp), INTENT(in) ::  diam2  !< diameter of colliding particle 2 (m)
4546    REAL(wp), INTENT(in) ::  mass1  !< mass of colliding particle 1 (kg)
4547    REAL(wp), INTENT(in) ::  mass2  !< mass of colliding particle 2 (kg)
4548    REAL(wp), INTENT(in) ::  pres   !< ambient pressure (Pa?) [fxm]
4549    REAL(wp), INTENT(in) ::  temp   !< ambient temperature (K)
4550
4551    REAL(wp), DIMENSION (2) ::  beta    !< Cunningham correction factor
4552    REAL(wp), DIMENSION (2) ::  dfpart  !< particle diffusion coefficient (m2/s)
4553    REAL(wp), DIMENSION (2) ::  diam    !< diameters of particles (m)
4554    REAL(wp), DIMENSION (2) ::  flux    !< flux in continuum and free molec. regime (m/s)
4555    REAL(wp), DIMENSION (2) ::  knud    !< particle Knudsen number
4556    REAL(wp), DIMENSION (2) ::  mpart   !< masses of particles (kg)
4557    REAL(wp), DIMENSION (2) ::  mtvel   !< particle mean thermal velocity (m/s)
4558    REAL(wp), DIMENSION (2) ::  omega   !< particle mean free path
4559    REAL(wp), DIMENSION (2) ::  tva     !< temporary variable (m)
4560!
4561!-- Initialisation
4562    coagc   = 0.0_wp
4563!
4564!-- 1) Initializing particle and ambient air variables
4565    diam  = (/ diam1, diam2 /) !< particle diameters (m)
4566    mpart = (/ mass1, mass2 /) !< particle masses (kg)
4567!
4568!-- Viscosity of air (kg/(m s))
4569    visc = ( 7.44523E-3_wp * temp ** 1.5_wp ) / ( 5093.0_wp * ( temp + 110.4_wp ) )
4570!
4571!-- Mean free path of air (m)
4572    mfp = ( 1.656E-10_wp * temp + 1.828E-8_wp ) * ( p_0 + 1325.0_wp ) / pres
4573!
4574!-- 2) Slip correction factor for small particles
4575    knud = 2.0_wp * EXP( LOG(mfp) - LOG(diam) )! Knudsen number for air (15.23)
4576!
4577!-- Cunningham correction factor (Allen and Raabe, Aerosol Sci. Tech. 4, 269)
4578    beta = 1.0_wp + knud * ( 1.142_wp + 0.558_wp * EXP( -0.999_wp / knud ) )
4579!
4580!-- 3) Particle properties
4581!-- Diffusion coefficient (m2/s) (Jacobson (2005) eq. 15.29)
4582    dfpart = beta * abo * temp / ( 3.0_wp * pi * visc * diam )
4583!
4584!-- Mean thermal velocity (m/s) (Jacobson (2005) eq. 15.32)
4585    mtvel = SQRT( ( 8.0_wp * abo * temp ) / ( pi * mpart ) )
4586!
4587!-- Particle mean free path (m) (Jacobson (2005) eq. 15.34 )
4588    omega = 8.0_wp * dfpart / ( pi * mtvel )
4589!
4590!-- Mean diameter (m)
4591    mdiam = 0.5_wp * ( diam(1) + diam(2) )
4592!
4593!-- 4) Calculation of fluxes (Brownian collision kernels) and flux matching
4594!-- following Jacobson (2005):
4595!
4596!-- Flux in continuum regime (m3/s) (eq. 15.28)
4597    flux(1) = 4.0_wp * pi * mdiam * ( dfpart(1) + dfpart(2) )
4598!
4599!-- Flux in free molec. regime (m3/s) (eq. 15.31)
4600    flux(2) = pi * SQRT( ( mtvel(1)**2 ) + ( mtvel(2)**2 ) ) * ( mdiam**2 )
4601!
4602!-- temporary variables (m) to calculate flux matching distance (m)
4603    tva(1) = ( ( mdiam + omega(1) )**3 - ( mdiam**2 + omega(1)**2 ) * SQRT( ( mdiam**2 +           &
4604               omega(1)**2 ) ) ) / ( 3.0_wp * mdiam * omega(1) ) - mdiam
4605    tva(2) = ( ( mdiam + omega(2) )**3 - ( mdiam**2 + omega(2)**2 ) * SQRT( ( mdiam**2 +           &
4606               omega(2)**2 ) ) ) / ( 3.0_wp * mdiam * omega(2) ) - mdiam
4607!
4608!-- Flux matching distance (m): the mean distance from the centre of a sphere reached by particles
4609!-- that leave sphere's surface and travel a distance of particle mean free path (eq. 15.34)
4610    fmdist = SQRT( tva(1)**2 + tva(2)**2 )
4611!
4612!-- 5) Coagulation coefficient = coalescence efficiency * collision kernel (m3/s) (eq. 15.33).
4613!--    Here assumed coalescence efficiency 1!!
4614    coagc = flux(1) / ( mdiam / ( mdiam + fmdist) + flux(1) / flux(2) )
4615!
4616!-- Corrected collision kernel (Karl et al., 2016 (ACP)): Include van der Waals and viscous forces
4617    IF ( van_der_waals_coagc )  THEN
4618       knud_p = SQRT( omega(1)**2 + omega(2)**2 ) / mdiam
4619       IF ( knud_p >= 0.1_wp  .AND.  knud_p <= 10.0_wp )  THEN
4620          coagc = coagc * ( 2.0_wp + 0.4_wp * LOG( knud_p ) )
4621       ELSE
4622          coagc = coagc * 3.0_wp
4623       ENDIF
4624    ENDIF
4625
4626 END FUNCTION coagc
4627
4628!------------------------------------------------------------------------------!
4629! Description:
4630! ------------
4631!> Calculates the change in particle volume and gas phase
4632!> concentrations due to nucleation, condensation and dissolutional growth.
4633!
4634!> Sulphuric acid and organic vapour: only condensation and no evaporation.
4635!
4636!> New gas and aerosol phase concentrations calculated according to Jacobson
4637!> (1997): Numerical techniques to solve condensational and dissolutional growth
4638!> equations when growth is coupled to reversible reactions, Aerosol Sci. Tech.,
4639!> 27, pp 491-498.
4640!
4641!> Following parameterization has been used:
4642!> Molecular diffusion coefficient of condensing vapour (m2/s)
4643!> (Reid et al. (1987): Properties of gases and liquids, McGraw-Hill, New York.)
4644!> D = {1.d-7*sqrt(1/M_air + 1/M_gas)*T^1.75} / &
4645!      {p_atm/p_stand * (d_air^(1/3) + d_gas^(1/3))^2 }
4646!> M_air = 28.965 : molar mass of air (g/mol)
4647!> d_air = 19.70  : diffusion volume of air
4648!> M_h2so4 = 98.08 : molar mass of h2so4 (g/mol)
4649!> d_h2so4 = 51.96  : diffusion volume of h2so4
4650!
4651!> Called from main aerosol model
4652!> For equations, see Jacobson, Fundamentals of Atmospheric Modeling, 2nd Edition (2005)
4653!
4654!> Coded by:
4655!> Hannele Korhonen (FMI) 2005
4656!> Harri Kokkola (FMI) 2006
4657!> Juha Tonttila (FMI) 2014
4658!> Rewritten to PALM by Mona Kurppa (UHel) 2017
4659!------------------------------------------------------------------------------!
4660 SUBROUTINE condensation( paero, pc_sa, pc_ocnv, pcocsv, pchno3, pc_nh3, pcw, pcs, ptemp, ppres,   &
4661                          ptstep, prtcl )
4662
4663    IMPLICIT NONE
4664
4665    INTEGER(iwp) ::  ss      !< start index
4666    INTEGER(iwp) ::  ee      !< end index
4667
4668    REAL(wp) ::  zcs_ocnv    !< condensation sink of nonvolatile organics (1/s)
4669    REAL(wp) ::  zcs_ocsv    !< condensation sink of semivolatile organics (1/s)
4670    REAL(wp) ::  zcs_su      !< condensation sink of sulfate (1/s)
4671    REAL(wp) ::  zcs_tot     !< total condensation sink (1/s) (gases)
4672    REAL(wp) ::  zcvap_new1  !< vapour concentration after time step (#/m3): sulphuric acid
4673    REAL(wp) ::  zcvap_new2  !< nonvolatile organics
4674    REAL(wp) ::  zcvap_new3  !< semivolatile organics
4675    REAL(wp) ::  zdfvap      !< air diffusion coefficient (m2/s)
4676    REAL(wp) ::  zdvap1      !< change in vapour concentration (#/m3): sulphuric acid
4677    REAL(wp) ::  zdvap2      !< nonvolatile organics
4678    REAL(wp) ::  zdvap3      !< semivolatile organics
4679    REAL(wp) ::  zmfp        !< mean free path of condensing vapour (m)
4680    REAL(wp) ::  zrh         !< Relative humidity [0-1]
4681    REAL(wp) ::  zvisc       !< viscosity of air (kg/(m s))
4682    REAL(wp) ::  zn_vs_c     !< ratio of nucleation of all mass transfer in the smallest bin
4683    REAL(wp) ::  zxocnv      !< ratio of organic vapour in 3nm particles
4684    REAL(wp) ::  zxsa        !< Ratio in 3nm particles: sulphuric acid
4685
4686    REAL(wp), INTENT(in) ::  ppres   !< ambient pressure (Pa)
4687    REAL(wp), INTENT(in) ::  pcs     !< Water vapour saturation concentration (kg/m3)
4688    REAL(wp), INTENT(in) ::  ptemp   !< ambient temperature (K)
4689    REAL(wp), INTENT(in) ::  ptstep  !< timestep (s)
4690
4691    REAL(wp), INTENT(inout) ::  pchno3   !< Gas concentrations (#/m3): nitric acid HNO3
4692    REAL(wp), INTENT(inout) ::  pc_nh3   !< ammonia NH3
4693    REAL(wp), INTENT(inout) ::  pc_ocnv  !< non-volatile organics
4694    REAL(wp), INTENT(inout) ::  pcocsv   !< semi-volatile organics
4695    REAL(wp), INTENT(inout) ::  pc_sa    !< sulphuric acid H2SO4
4696    REAL(wp), INTENT(inout) ::  pcw      !< Water vapor concentration (kg/m3)
4697
4698    REAL(wp), DIMENSION(nbins_aerosol)       ::  zbeta          !< transitional correction factor
4699    REAL(wp), DIMENSION(nbins_aerosol)       ::  zcolrate       !< collision rate (1/s)
4700    REAL(wp), DIMENSION(nbins_aerosol)       ::  zcolrate_ocnv  !< collision rate of OCNV (1/s)
4701    REAL(wp), DIMENSION(start_subrange_1a+1) ::  zdfpart        !< particle diffusion coef. (m2/s)
4702    REAL(wp), DIMENSION(nbins_aerosol)       ::  zdvoloc        !< change of organics volume
4703    REAL(wp), DIMENSION(nbins_aerosol)       ::  zdvolsa        !< change of sulphate volume
4704    REAL(wp), DIMENSION(2)                   ::  zj3n3          !< Formation massrate of molecules
4705                                                                !< in nucleation, (molec/m3s),
4706                                                                !< 1: H2SO4 and 2: organic vapor
4707    REAL(wp), DIMENSION(nbins_aerosol)       ::  zknud          !< particle Knudsen number
4708
4709    TYPE(component_index), INTENT(in) :: prtcl  !< Keeps track which substances are used
4710
4711    TYPE(t_section), DIMENSION(nbins_aerosol), INTENT(inout) ::  paero  !< Aerosol properties
4712
4713    zj3n3  = 0.0_wp
4714    zrh    = pcw / pcs
4715    zxocnv = 0.0_wp
4716    zxsa   = 0.0_wp
4717!
4718!-- Nucleation
4719    IF ( nsnucl > 0 )  THEN
4720       CALL nucleation( paero, ptemp, zrh, ppres, pc_sa, pc_ocnv, pc_nh3, ptstep, zj3n3, zxsa,     &
4721                        zxocnv )
4722    ENDIF
4723!
4724!-- Condensation on pre-existing particles
4725    IF ( lscndgas )  THEN
4726!
4727!--    Initialise:
4728       zdvolsa = 0.0_wp
4729       zdvoloc = 0.0_wp
4730       zcolrate = 0.0_wp
4731!
4732!--    1) Properties of air and condensing gases:
4733!--    Viscosity of air (kg/(m s)) (Eq. 4.54 in Jabonson (2005))
4734       zvisc = ( 7.44523E-3_wp * ptemp ** 1.5_wp ) / ( 5093.0_wp * ( ptemp + 110.4_wp ) )
4735!
4736!--    Diffusion coefficient of air (m2/s)
4737       zdfvap = 5.1111E-10_wp * ptemp ** 1.75_wp * ( p_0 + 1325.0_wp ) / ppres
4738!
4739!--    Mean free path (m): same for H2SO4 and organic compounds
4740       zmfp = 3.0_wp * zdfvap * SQRT( pi * amh2so4 / ( 8.0_wp * argas * ptemp ) )
4741!
4742!--    2) Transition regime correction factor zbeta for particles (Fuchs and Sutugin (1971)):
4743!--       Size of condensing molecule considered only for nucleation mode (3 - 20 nm).
4744!
4745!--    Particle Knudsen number: condensation of gases on aerosols
4746       ss = start_subrange_1a
4747       ee = start_subrange_1a+1
4748       zknud(ss:ee) = 2.0_wp * zmfp / ( paero(ss:ee)%dwet + d_sa )
4749       ss = start_subrange_1a+2
4750       ee = end_subrange_2b
4751       zknud(ss:ee) = 2.0_wp * zmfp / paero(ss:ee)%dwet
4752!
4753!--    Transitional correction factor: aerosol + gas (the semi-empirical Fuchs- Sutugin
4754!--    interpolation function (Fuchs and Sutugin, 1971))
4755       zbeta = ( zknud + 1.0_wp ) / ( 0.377_wp * zknud + 1.0_wp + 4.0_wp / ( 3.0_wp * massacc ) *  &
4756               ( zknud + zknud ** 2 ) )
4757!
4758!--    3) Collision rate of molecules to particles
4759!--       Particle diffusion coefficient considered only for nucleation mode (3 - 20 nm)
4760!
4761!--    Particle diffusion coefficient (m2/s) (e.g. Eq. 15.29 in Jacobson (2005))
4762       zdfpart = abo * ptemp * zbeta(start_subrange_1a:start_subrange_1a+1) / ( 3.0_wp * pi * zvisc&
4763                 * paero(start_subrange_1a:start_subrange_1a+1)%dwet)
4764!
4765!--    Collision rate (mass-transfer coefficient): gases on aerosols (1/s) (Eq. 16.64 in
4766!--    Jacobson (2005))
4767       ss = start_subrange_1a
4768       ee = start_subrange_1a+1
4769       zcolrate(ss:ee) = MERGE( 2.0_wp * pi * ( paero(ss:ee)%dwet + d_sa ) * ( zdfvap + zdfpart ) *&
4770                               zbeta(ss:ee) * paero(ss:ee)%numc, 0.0_wp, paero(ss:ee)%numc > nclim )
4771       ss = start_subrange_1a+2
4772       ee = end_subrange_2b
4773       zcolrate(ss:ee) = MERGE( 2.0_wp * pi * paero(ss:ee)%dwet * zdfvap * zbeta(ss:ee) *          &
4774                                paero(ss:ee)%numc, 0.0_wp, paero(ss:ee)%numc > nclim )
4775!
4776!-- 4) Condensation sink (1/s)
4777       zcs_tot = SUM( zcolrate )   ! total sink
4778!
4779!--    5) Changes in gas-phase concentrations and particle volume
4780!
4781!--    5.1) Organic vapours
4782!
4783!--    5.1.1) Non-volatile organic compound: condenses onto all bins
4784       IF ( pc_ocnv > 1.0E+10_wp  .AND.  zcs_tot > 1.0E-30_wp  .AND. index_oc > 0 )  &
4785       THEN
4786!--       Ratio of nucleation vs. condensation rates in the smallest bin
4787          zn_vs_c = 0.0_wp
4788          IF ( zj3n3(2) > 1.0_wp )  THEN
4789             zn_vs_c = ( zj3n3(2) ) / ( zj3n3(2) + pc_ocnv * zcolrate(start_subrange_1a) )
4790          ENDIF
4791!
4792!--       Collision rate in the smallest bin, including nucleation and condensation (see
4793!--       Jacobson (2005), eq. (16.73) )
4794          zcolrate_ocnv = zcolrate
4795          zcolrate_ocnv(start_subrange_1a) = zcolrate_ocnv(start_subrange_1a) + zj3n3(2) / pc_ocnv
4796!
4797!--       Total sink for organic vapor
4798          zcs_ocnv = zcs_tot + zj3n3(2) / pc_ocnv
4799!
4800!--       New gas phase concentration (#/m3)
4801          zcvap_new2 = pc_ocnv / ( 1.0_wp + ptstep * zcs_ocnv )
4802!
4803!--       Change in gas concentration (#/m3)
4804          zdvap2 = pc_ocnv - zcvap_new2
4805!
4806!--       Updated vapour concentration (#/m3)
4807          pc_ocnv = zcvap_new2
4808!
4809!--       Volume change of particles (m3(OC)/m3(air))
4810          zdvoloc = zcolrate_ocnv(start_subrange_1a:end_subrange_2b) / zcs_ocnv * amvoc * zdvap2
4811!
4812!--       Change of volume due to condensation in 1a-2b
4813          paero(start_subrange_1a:end_subrange_2b)%volc(2) =                                       &
4814                                          paero(start_subrange_1a:end_subrange_2b)%volc(2) + zdvoloc
4815!
4816!--       Change of number concentration in the smallest bin caused by nucleation (Jacobson (2005),
4817!--       eq. (16.75)). If zxocnv = 0, then the chosen nucleation mechanism doesn't take into
4818!--       account the non-volatile organic vapors and thus the paero doesn't have to be updated.
4819          IF ( zxocnv > 0.0_wp )  THEN
4820             paero(start_subrange_1a)%numc = paero(start_subrange_1a)%numc + zn_vs_c *             &
4821                                             zdvoloc(start_subrange_1a) / amvoc / ( n3 * zxocnv )
4822          ENDIF
4823       ENDIF
4824!
4825!--    5.1.2) Semivolatile organic compound: all bins except subrange 1
4826       zcs_ocsv = SUM( zcolrate(start_subrange_2a:end_subrange_2b) ) !< sink for semi-volatile org.
4827       IF ( pcocsv > 1.0E+10_wp  .AND.  zcs_ocsv > 1.0E-30  .AND. is_used( prtcl,'OC') )  THEN
4828!
4829!--       New gas phase concentration (#/m3)
4830          zcvap_new3 = pcocsv / ( 1.0_wp + ptstep * zcs_ocsv )
4831!
4832!--       Change in gas concentration (#/m3)
4833          zdvap3 = pcocsv - zcvap_new3 
4834!
4835!--       Updated gas concentration (#/m3)
4836          pcocsv = zcvap_new3
4837!
4838!--       Volume change of particles (m3(OC)/m3(air))
4839          ss = start_subrange_2a
4840          ee = end_subrange_2b
4841          zdvoloc(ss:ee) = zdvoloc(ss:ee) + zcolrate(ss:ee) / zcs_ocsv * amvoc * zdvap3
4842!
4843!--       Change of volume due to condensation in 1a-2b
4844          paero(start_subrange_1a:end_subrange_2b)%volc(2) =                                       &
4845                                          paero(start_subrange_1a:end_subrange_2b)%volc(2) + zdvoloc
4846       ENDIF
4847!
4848!--    5.2) Sulphate: condensed on all bins
4849       IF ( pc_sa > 1.0E+10_wp  .AND.  zcs_tot > 1.0E-30_wp  .AND.  index_so4 > 0 )  THEN
4850!
4851!--    Ratio of mass transfer between nucleation and condensation
4852          zn_vs_c = 0.0_wp
4853          IF ( zj3n3(1) > 1.0_wp )  THEN
4854             zn_vs_c = ( zj3n3(1) ) / ( zj3n3(1) + pc_sa * zcolrate(start_subrange_1a) )
4855          ENDIF
4856!
4857!--       Collision rate in the smallest bin, including nucleation and condensation (see
4858!--       Jacobson (2005), eq. (16.73))
4859          zcolrate(start_subrange_1a) = zcolrate(start_subrange_1a) + zj3n3(1) / pc_sa
4860!
4861!--       Total sink for sulfate (1/s)
4862          zcs_su = zcs_tot + zj3n3(1) / pc_sa
4863!
4864!--       Sulphuric acid:
4865!--       New gas phase concentration (#/m3)
4866          zcvap_new1 = pc_sa / ( 1.0_wp + ptstep * zcs_su )
4867!
4868!--       Change in gas concentration (#/m3)
4869          zdvap1 = pc_sa - zcvap_new1
4870!
4871!--       Updating vapour concentration (#/m3)
4872          pc_sa = zcvap_new1
4873!
4874!--       Volume change of particles (m3(SO4)/m3(air)) by condensation
4875          zdvolsa = zcolrate(start_subrange_1a:end_subrange_2b) / zcs_su * amvh2so4 * zdvap1
4876!
4877!--       Change of volume concentration of sulphate in aerosol [fxm]
4878          paero(start_subrange_1a:end_subrange_2b)%volc(1) =                                       &
4879                                          paero(start_subrange_1a:end_subrange_2b)%volc(1) + zdvolsa
4880!
4881!--       Change of number concentration in the smallest bin caused by nucleation
4882!--       (Jacobson (2005), equation (16.75))
4883          IF ( zxsa > 0.0_wp )  THEN
4884             paero(start_subrange_1a)%numc = paero(start_subrange_1a)%numc + zn_vs_c *             &
4885                                             zdvolsa(start_subrange_1a) / amvh2so4 / ( n3 * zxsa)
4886          ENDIF
4887       ENDIF
4888!
4889!--    Partitioning of H2O, HNO3, and NH3: Dissolutional growth
4890       IF ( lspartition  .AND.  ( pchno3 > 1.0E+10_wp  .OR.  pc_nh3 > 1.0E+10_wp ) )  THEN
4891          CALL gpparthno3( ppres, ptemp, paero, pchno3, pc_nh3, pcw, pcs, zbeta, ptstep )
4892       ENDIF
4893    ENDIF
4894!
4895!-- Condensation of water vapour
4896    IF ( lscndh2oae )  THEN
4897       CALL gpparth2o( paero, ptemp, ppres, pcs, pcw, ptstep )
4898    ENDIF
4899
4900 END SUBROUTINE condensation
4901
4902!------------------------------------------------------------------------------!
4903! Description:
4904! ------------
4905!> Calculates the particle number and volume increase, and gas-phase
4906!> concentration decrease due to nucleation subsequent growth to detectable size
4907!> of 3 nm.
4908!
4909!> Method:
4910!> When the formed clusters grow by condensation (possibly also by self-
4911!> coagulation), their number is reduced due to scavenging to pre-existing
4912!> particles. Thus, the apparent nucleation rate at 3 nm is significantly lower
4913!> than the real nucleation rate (at ~1 nm).
4914!
4915!> Calculation of the formation rate of detectable particles at 3 nm (i.e. J3):
4916!> nj3 = 1: Kerminen, V.-M. and Kulmala, M. (2002), J. Aerosol Sci.,33, 609-622.
4917!> nj3 = 2: Lehtinen et al. (2007), J. Aerosol Sci., 38(9), 988-994.
4918!> nj3 = 3: Anttila et al. (2010), J. Aerosol Sci., 41(7), 621-636.
4919!
4920!> c = aerosol of critical radius (1 nm)
4921!> x = aerosol with radius 3 nm
4922!> 2 = wet or mean droplet
4923!
4924!> Called from subroutine condensation (in module salsa_dynamics_mod.f90)
4925!
4926!> Calls one of the following subroutines:
4927!>  - binnucl
4928!>  - ternucl
4929!>  - kinnucl
4930!>  - actnucl
4931!
4932!> fxm: currently only sulphuric acid grows particles from 1 to 3 nm
4933!>  (if asked from Markku, this is terribly wrong!!!)
4934!
4935!> Coded by:
4936!> Hannele Korhonen (FMI) 2005
4937!> Harri Kokkola (FMI) 2006
4938!> Matti Niskanen(FMI) 2012
4939!> Anton Laakso  (FMI) 2013
4940!------------------------------------------------------------------------------!
4941
4942 SUBROUTINE nucleation( paero, ptemp, prh, ppres, pc_sa, pc_ocnv, pc_nh3, ptstep, pj3n3, pxsa,     &
4943                        pxocnv )
4944
4945    IMPLICIT NONE
4946
4947    INTEGER(iwp) ::  iteration
4948
4949    REAL(wp) ::  zc_h2so4     !< H2SO4 conc. (#/cm3) !UNITS!
4950    REAL(wp) ::  zc_org       !< organic vapour conc. (#/cm3)
4951    REAL(wp) ::  zcc_c        !< Cunningham correct factor for c = critical (1nm)
4952    REAL(wp) ::  zcc_x        !< Cunningham correct factor for x = 3nm
4953    REAL(wp) ::  zcoags_c     !< coagulation sink (1/s) for c = critical (1nm)
4954    REAL(wp) ::  zcoags_x     !< coagulation sink (1/s) for x = 3nm
4955    REAL(wp) ::  zcoagstot    !< total particle losses due to coagulation, including condensation
4956                              !< and self-coagulation
4957    REAL(wp) ::  zcocnv_local !< organic vapour conc. (#/m3)
4958    REAL(wp) ::  zcsink       !< condensational sink (#/m2)
4959    REAL(wp) ::  zcsa_local   !< H2SO4 conc. (#/m3)
4960    REAL(wp) ::  zcv_c        !< mean relative thermal velocity (m/s) for c = critical (1nm)
4961    REAL(wp) ::  zcv_x        !< mean relative thermal velocity (m/s) for x = 3nm
4962    REAL(wp) ::  zdcrit       !< diameter of critical cluster (m)
4963    REAL(wp) ::  zdelta_vap   !< change of H2SO4 and organic vapour concentration (#/m3)
4964    REAL(wp) ::  zdfvap       !< air diffusion coefficient (m2/s)
4965    REAL(wp) ::  zdmean       !< mean diameter of existing particles (m)
4966    REAL(wp) ::  zeta         !< constant: proportional to ratio of CS/GR (m)
4967                              !< (condensation sink / growth rate)
4968    REAL(wp) ::  zgamma       !< proportionality factor ((nm2*m2)/h)
4969    REAL(wp) ::  z_gr_clust   !< growth rate of formed clusters (nm/h)
4970    REAL(wp) ::  z_gr_tot     !< total growth rate
4971    REAL(wp) ::  zj3          !< number conc. of formed 3nm particles (#/m3)
4972    REAL(wp) ::  zjnuc        !< nucleation rate at ~1nm (#/m3s)
4973    REAL(wp) ::  z_k_eff      !< effective cogulation coefficient for freshly nucleated particles
4974    REAL(wp) ::  zknud_c      !< Knudsen number for c = critical (1nm)
4975    REAL(wp) ::  zknud_x      !< Knudsen number for x = 3nm
4976    REAL(wp) ::  zkocnv       !< lever: zkocnv=1 --> organic compounds involved in nucleation
4977    REAL(wp) ::  zksa         !< lever: zksa=1 --> H2SO4 involved in nucleation
4978    REAL(wp) ::  zlambda      !< parameter for adjusting the growth rate due to self-coagulation
4979    REAL(wp) ::  zm_c         !< particle mass (kg) for c = critical (1nm)
4980    REAL(wp) ::  zm_para      !< Parameter m for calculating the coagulation sink (Eq. 5&6 in
4981                              !< Lehtinen et al. 2007)
4982    REAL(wp) ::  zm_x         !< particle mass (kg) for x = 3nm
4983    REAL(wp) ::  zmfp         !< mean free path of condesing vapour(m)
4984    REAL(wp) ::  zmixnh3      !< ammonia mixing ratio (ppt)
4985    REAL(wp) ::  zmyy         !< gas dynamic viscosity (N*s/m2)
4986    REAL(wp) ::  z_n_nuc      !< number of clusters/particles at the size range d1-dx (#/m3)
4987    REAL(wp) ::  znoc         !< number of organic molecules in critical cluster
4988    REAL(wp) ::  znsa         !< number of H2SO4 molecules in critical cluster
4989
4990    REAL(wp), INTENT(in) ::  pc_nh3   !< ammonia concentration (#/m3)
4991    REAL(wp), INTENT(in) ::  pc_ocnv  !< conc. of non-volatile OC (#/m3)
4992    REAL(wp), INTENT(in) ::  pc_sa    !< sulphuric acid conc. (#/m3)
4993    REAL(wp), INTENT(in) ::  ppres    !< ambient air pressure (Pa)
4994    REAL(wp), INTENT(in) ::  prh      !< ambient rel. humidity [0-1]
4995    REAL(wp), INTENT(in) ::  ptemp    !< ambient temperature (K)
4996    REAL(wp), INTENT(in) ::  ptstep   !< time step (s) of SALSA
4997
4998    REAL(wp), INTENT(inout) ::  pj3n3(2) !< formation mass rate of molecules (molec/m3s) for
4999                                         !< 1: H2SO4 and 2: organic vapour
5000
5001    REAL(wp), INTENT(out) ::  pxocnv  !< ratio of non-volatile organic vapours in 3 nm particles
5002    REAL(wp), INTENT(out) ::  pxsa    !< ratio of H2SO4 in 3 nm aerosol particles
5003
5004    REAL(wp), DIMENSION(nbins_aerosol) ::  zbeta       !< transitional correction factor
5005    REAL(wp), DIMENSION(nbins_aerosol) ::  zcc_2       !< Cunningham correct factor:2
5006    REAL(wp), DIMENSION(nbins_aerosol) ::  zcv_2       !< mean relative thermal velocity (m/s): 2
5007    REAL(wp), DIMENSION(nbins_aerosol) ::  zcv_c2      !< average velocity after coagulation: c & 2
5008    REAL(wp), DIMENSION(nbins_aerosol) ::  zcv_x2      !< average velocity after coagulation: x & 2
5009    REAL(wp), DIMENSION(nbins_aerosol) ::  zdc_2       !< particle diffusion coefficient (m2/s): 2
5010    REAL(wp), DIMENSION(nbins_aerosol) ::  zdc_c       !< particle diffusion coefficient (m2/s): c
5011    REAL(wp), DIMENSION(nbins_aerosol) ::  zdc_c2      !< sum of diffusion coef. for c and 2
5012    REAL(wp), DIMENSION(nbins_aerosol) ::  zdc_x       !< particle diffusion coefficient (m2/s): x
5013    REAL(wp), DIMENSION(nbins_aerosol) ::  zdc_x2      !< sum of diffusion coef. for: x & 2
5014    REAL(wp), DIMENSION(nbins_aerosol) ::  zgamma_f_2  !< zgamma_f for calculating zomega
5015    REAL(wp), DIMENSION(nbins_aerosol) ::  zgamma_f_c  !< zgamma_f for calculating zomega
5016    REAL(wp), DIMENSION(nbins_aerosol) ::  zgamma_f_x  !< zgamma_f for calculating zomega
5017    REAL(wp), DIMENSION(nbins_aerosol) ::  z_k_c2      !< coagulation coef. in the continuum
5018                                                       !< regime: c & 2
5019    REAL(wp), DIMENSION(nbins_aerosol) ::  z_k_x2      !< coagulation coef. in the continuum
5020                                                       !< regime: x & 2
5021    REAL(wp), DIMENSION(nbins_aerosol) ::  zknud       !< particle Knudsen number
5022    REAL(wp), DIMENSION(nbins_aerosol) ::  zknud_2     !< particle Knudsen number: 2
5023    REAL(wp), DIMENSION(nbins_aerosol) ::  zm_2        !< particle mass (kg): 2
5024    REAL(wp), DIMENSION(nbins_aerosol) ::  zomega_2c   !< zomega (m) for calculating zsigma: c & 2
5025    REAL(wp), DIMENSION(nbins_aerosol) ::  zomega_2x   !< zomega (m) for calculating zsigma: x & 2
5026    REAL(wp), DIMENSION(nbins_aerosol) ::  zomega_c    !< zomega (m) for calculating zsigma: c
5027    REAL(wp), DIMENSION(nbins_aerosol) ::  zomega_x    !< zomega (m) for calculating zsigma: x
5028    REAL(wp), DIMENSION(nbins_aerosol) ::  z_r_c2      !< sum of the radii: c & 2
5029    REAL(wp), DIMENSION(nbins_aerosol) ::  z_r_x2      !< sum of the radii: x & 2
5030    REAL(wp), DIMENSION(nbins_aerosol) ::  zsigma_c2   !<
5031    REAL(wp), DIMENSION(nbins_aerosol) ::  zsigma_x2   !<
5032
5033    TYPE(t_section), DIMENSION(nbins_aerosol), INTENT(inout) ::  paero  !< aerosol properties
5034!
5035!-- 1) Nucleation rate (zjnuc) and diameter of critical cluster (zdcrit)
5036    zjnuc  = 0.0_wp
5037    znsa   = 0.0_wp
5038    znoc   = 0.0_wp
5039    zdcrit = 0.0_wp
5040    zksa   = 0.0_wp
5041    zkocnv = 0.0_wp
5042
5043    zc_h2so4 = pc_sa * 1.0E-6_wp   ! sulphuric acid conc. to #/cm3
5044    zc_org   = pc_ocnv * 1.0E-6_wp   ! conc. of non-volatile OC to #/cm3
5045    zmixnh3  = pc_nh3 * ptemp * argas / ( ppres * avo )
5046
5047    SELECT CASE ( nsnucl )
5048!
5049!--    Binary H2SO4-H2O nucleation
5050       CASE(1)
5051
5052          CALL binnucl( zc_h2so4, ptemp, prh, zjnuc, znsa, znoc, zdcrit,  zksa, zkocnv )
5053!
5054!--    Activation type nucleation (See Riipinen et al. (2007), Atmos. Chem. Phys., 7(8), 1899-1914)
5055       CASE(2)
5056!
5057!--       Nucleation rate (#/(m3 s))
5058          zc_h2so4  = MAX( zc_h2so4, 1.0E4_wp  )
5059          zc_h2so4  = MIN( zc_h2so4, 1.0E11_wp )
5060          zjnuc = act_coeff * pc_sa  ! (#/(m3 s))
5061!
5062!--       Organic compounds not involved when kinetic nucleation is assumed.
5063          zdcrit  = 7.9375E-10_wp   ! (m)
5064          zkocnv  = 0.0_wp
5065          zksa    = 1.0_wp
5066          znoc    = 0.0_wp
5067          znsa    = 2.0_wp
5068!
5069!--    Kinetically limited nucleation of (NH4)HSO4 clusters
5070!--    (See Sihto et al. (2006), Atmos. Chem. Phys., 6(12), 4079-4091.)
5071       CASE(3)
5072!
5073!--       Nucleation rate = coagcoeff*zpcsa**2 (#/(m3 s))
5074          zc_h2so4  = MAX( zc_h2so4, 1.0E4_wp  )
5075          zc_h2so4  = MIN( zc_h2so4, 1.0E11_wp )
5076          zjnuc = 5.0E-13_wp * zc_h2so4**2.0_wp * 1.0E+6_wp
5077!
5078!--       Organic compounds not involved when kinetic nucleation is assumed.
5079          zdcrit  = 7.9375E-10_wp   ! (m)
5080          zkocnv  = 0.0_wp
5081          zksa    = 1.0_wp
5082          znoc    = 0.0_wp
5083          znsa    = 2.0_wp
5084!
5085!--    Ternary H2SO4-H2O-NH3 nucleation
5086       CASE(4)
5087
5088          CALL ternucl( zc_h2so4, zmixnh3, ptemp, prh, zjnuc, znsa, znoc, zdcrit, zksa, zkocnv )
5089!
5090!--    Organic nucleation, J~[ORG] or J~[ORG]**2
5091!--    (See Paasonen et al. (2010), Atmos. Chem. Phys., 10, 11223-11242.)
5092       CASE(5)
5093!
5094!--       Homomolecular nuleation rate
5095          zjnuc = 1.3E-7_wp * pc_ocnv   ! (1/s) (Paasonen et al. Table 4: median a_org)
5096!
5097!--       H2SO4 not involved when pure organic nucleation is assumed.
5098          zdcrit  = 1.5E-9  ! (m)
5099          zkocnv  = 1.0_wp
5100          zksa    = 0.0_wp
5101          znoc    = 1.0_wp
5102          znsa    = 0.0_wp
5103!
5104!--    Sum of H2SO4 and organic activation type nucleation, J~[H2SO4]+[ORG]
5105!--    (See Paasonen et al. (2010), Atmos. Chem. Phys., 10, 11223-11242)
5106       CASE(6)
5107!
5108!--       Nucleation rate  (#/m3/s)
5109          zjnuc = 6.1E-7_wp * pc_sa + 0.39E-7_wp * pc_ocnv   ! (Paasonen et al. Table 3.)
5110!
5111!--       Both organic compounds and H2SO4 are involved when sumnucleation is assumed.
5112          zdcrit  = 1.5E-9_wp   ! (m)
5113          zkocnv  = 1.0_wp
5114          zksa    = 1.0_wp
5115          znoc    = 1.0_wp
5116          znsa    = 1.0_wp
5117!
5118!--    Heteromolecular nucleation, J~[H2SO4]*[ORG]
5119!--    (See Paasonen et al. (2010), Atmos. Chem. Phys., 10, 11223-11242.)
5120       CASE(7)
5121!
5122!--       Nucleation rate (#/m3/s)
5123          zjnuc = 4.1E-14_wp * pc_sa * pc_ocnv * 1.0E6_wp   ! (Paasonen et al. Table 4: median)
5124!
5125!--       Both organic compounds and H2SO4 are involved when heteromolecular nucleation is assumed
5126          zdcrit  = 1.5E-9_wp   ! (m)
5127          zkocnv  = 1.0_wp
5128          zksa    = 1.0_wp
5129          znoc    = 1.0_wp
5130          znsa    = 1.0_wp
5131!
5132!--    Homomolecular nucleation of H2SO4 and heteromolecular nucleation of H2SO4 and organic vapour,
5133!--    J~[H2SO4]**2 + [H2SO4]*[ORG] (EUCAARI project)
5134!--    (See Paasonen et al. (2010), Atmos. Chem. Phys., 10, 11223-11242)
5135       CASE(8)
5136!
5137!--       Nucleation rate (#/m3/s)
5138          zjnuc = ( 1.1E-14_wp * zc_h2so4**2 + 3.2E-14_wp * zc_h2so4 * zc_org ) * 1.0E+6_wp
5139!
5140!--       Both organic compounds and H2SO4 are involved when SAnucleation is assumed
5141          zdcrit  = 1.5E-9_wp   ! (m)
5142          zkocnv  = 1.0_wp
5143          zksa    = 1.0_wp
5144          znoc    = 1.0_wp
5145          znsa    = 3.0_wp
5146!
5147!--    Homomolecular nucleation of H2SO4 and organic vapour and heteromolecular nucleation of H2SO4
5148!--    and organic vapour, J~[H2SO4]**2 + [H2SO4]*[ORG]+[ORG]**2 (EUCAARI project)
5149       CASE(9)
5150!
5151!--       Nucleation rate (#/m3/s)
5152          zjnuc = ( 1.4E-14_wp * zc_h2so4**2 + 2.6E-14_wp * zc_h2so4 * zc_org + 0.037E-14_wp *     &
5153                    zc_org**2 ) * 1.0E+6_wp
5154!
5155!--       Both organic compounds and H2SO4 are involved when SAORGnucleation is assumed
5156          zdcrit  = 1.5E-9_wp   ! (m)
5157          zkocnv  = 1.0_wp
5158          zksa    = 1.0_wp
5159          znoc    = 3.0_wp
5160          znsa    = 3.0_wp
5161
5162    END SELECT
5163
5164    zcsa_local = pc_sa
5165    zcocnv_local = pc_ocnv
5166!
5167!-- 2) Change of particle and gas concentrations due to nucleation
5168!
5169!-- 2.1) Check that there is enough H2SO4 and organic vapour to produce the nucleation
5170    IF ( nsnucl <= 4 )  THEN 
5171!
5172!--    If the chosen nucleation scheme is 1-4, nucleation occurs only due to H2SO4. All of the total
5173!--    vapour concentration that is taking part to the nucleation is there for sulphuric acid
5174!--    (sa = H2SO4) and non-volatile organic vapour is zero.
5175       pxsa   = 1.0_wp   ! ratio of sulphuric acid in 3nm particles
5176       pxocnv = 0.0_wp   ! ratio of non-volatile origanic vapour
5177                                ! in 3nm particles
5178    ELSEIF ( nsnucl > 4 )  THEN
5179!
5180!--    If the chosen nucleation scheme is 5-9, nucleation occurs due to organic vapour or the
5181!--    combination of organic vapour and H2SO4. The number of needed molecules depends on the chosen
5182!--    nucleation type and it has an effect also on the minimum ratio of the molecules present.
5183       IF ( pc_sa * znsa + pc_ocnv * znoc < 1.E-14_wp )  THEN
5184          pxsa   = 0.0_wp
5185          pxocnv = 0.0_wp
5186       ELSE
5187          pxsa   = pc_sa * znsa / ( pc_sa * znsa + pc_ocnv * znoc ) 
5188          pxocnv = pc_ocnv * znoc / ( pc_sa * znsa + pc_ocnv * znoc )
5189       ENDIF
5190    ENDIF
5191!
5192!-- The change in total vapour concentration is the sum of the concentrations of the vapours taking
5193!-- part to the nucleation (depends on the chosen nucleation scheme)
5194    zdelta_vap = MIN( zjnuc * ( znoc + znsa ), ( pc_ocnv * zkocnv + pc_sa * zksa ) / ptstep )
5195!
5196!-- Nucleation rate J at ~1nm (#/m3s)
5197    zjnuc = zdelta_vap / ( znoc + znsa )
5198!
5199!-- H2SO4 concentration after nucleation (#/m3)
5200    zcsa_local = MAX( 1.0_wp, pc_sa - zdelta_vap * pxsa )
5201!
5202!-- Non-volative organic vapour concentration after nucleation (#/m3)
5203    zcocnv_local = MAX( 1.0_wp, pc_ocnv - zdelta_vap * pxocnv )
5204!
5205!-- 2.2) Formation rate of 3 nm particles (Kerminen & Kulmala, 2002)
5206!
5207!-- Growth rate by H2SO4 and organic vapour (nm/h, Eq. 21)
5208    z_gr_clust = 2.3623E-15_wp * SQRT( ptemp ) * ( zcsa_local + zcocnv_local )
5209!
5210!-- 2.2.2) Condensational sink of pre-existing particle population
5211!
5212!-- Diffusion coefficient (m2/s)
5213    zdfvap = 5.1111E-10_wp * ptemp**1.75_wp * ( p_0 + 1325.0_wp ) / ppres
5214!
5215!-- Mean free path of condensing vapour (m) (Jacobson (2005), Eq. 15.25 and 16.29)
5216    zmfp = 3.0_wp * zdfvap * SQRT( pi * amh2so4 / ( 8.0_wp * argas * ptemp ) )
5217!
5218!-- Knudsen number
5219    zknud = 2.0_wp * zmfp / ( paero(:)%dwet + d_sa )
5220!
5221!-- Transitional regime correction factor (zbeta) according to Fuchs and Sutugin (1971) (Eq. 4 in
5222!-- Kerminen and Kulmala, 2002)
5223    zbeta = ( zknud + 1.0_wp) / ( 0.377_wp * zknud + 1.0_wp + 4.0_wp / ( 3.0_wp * massacc ) *      &
5224            ( zknud + zknud**2 ) )
5225!
5226!-- Condensational sink (#/m2, Eq. 3)
5227    zcsink = SUM( paero(:)%dwet * zbeta * paero(:)%numc )
5228!
5229!-- 2.2.3) Parameterised formation rate of detectable 3 nm particles (i.e. J3)
5230    IF ( nj3 == 1 )  THEN   ! Kerminen and Kulmala (2002)
5231!
5232!--    Constants needed for the parameterisation: dapp = 3 nm and dens_nuc = 1830 kg/m3
5233       IF ( zcsink < 1.0E-30_wp )  THEN
5234          zeta = 0._dp
5235       ELSE
5236!
5237!--       Mean diameter of backgroud population (nm)
5238          zdmean = 1.0_wp / SUM( paero(:)%numc ) * SUM( paero(:)%numc * paero(:)%dwet ) * 1.0E+9_wp
5239!
5240!--       Proportionality factor (nm2*m2/h) (Eq. 22)
5241          zgamma = 0.23_wp * ( zdcrit * 1.0E+9_wp )**0.2_wp * ( zdmean / 150.0_wp )**0.048_wp *    &
5242                   ( ptemp / 293.0_wp )**( -0.75_wp ) * ( arhoh2so4 / 1000.0_wp )**( -0.33_wp )
5243!
5244!--       Factor eta (nm, Eq. 11)
5245          zeta = MIN( zgamma * zcsink / z_gr_clust, zdcrit * 1.0E11_wp )
5246       ENDIF
5247!
5248!--    Number conc. of clusters surviving to 3 nm in a time step (#/m3, Eq.14)
5249       zj3 = zjnuc * EXP( MIN( 0.0_wp, zeta / 3.0_wp - zeta / ( zdcrit * 1.0E9_wp ) ) )
5250
5251    ELSEIF ( nj3 > 1 )  THEN   ! Lehtinen et al. (2007) or Anttila et al. (2010)
5252!
5253!--    Defining the parameter m (zm_para) for calculating the coagulation sink onto background
5254!--    particles (Eq. 5&6 in Lehtinen et al. 2007). The growth is investigated between
5255!--    [d1,reglim(1)] = [zdcrit,3nm] and m = LOG( CoagS_dx / CoagX_zdcrit ) / LOG( reglim / zdcrit )
5256!--    (Lehtinen et al. 2007, Eq. 6).
5257!--    The steps for the coagulation sink for reglim = 3nm and zdcrit ~= 1nm are explained in
5258!--    Kulmala et al. (2001). The particles of diameter zdcrit ~1.14 nm  and reglim = 3nm are both
5259!--    in turn the "number 1" variables (Kulmala et al. 2001).
5260!--    c = critical (1nm), x = 3nm, 2 = wet or mean droplet
5261!
5262!--    Sum of the radii, R12 = R1 + R2 (m) of two particles 1 and 2
5263       z_r_c2 = zdcrit / 2.0_wp + paero(:)%dwet / 2.0_wp
5264       z_r_x2 = reglim(1) / 2.0_wp + paero(:)%dwet / 2.0_wp
5265!
5266!--    Particle mass (kg) (comes only from H2SO4)
5267       zm_c = 4.0_wp / 3.0_wp * pi * ( zdcrit / 2.0_wp )**3 * arhoh2so4
5268       zm_x = 4.0_wp / 3.0_wp * pi * ( reglim(1) / 2.0_wp )**3 * arhoh2so4
5269       zm_2 = 4.0_wp / 3.0_wp * pi * ( 0.5_wp * paero(:)%dwet )**3 * arhoh2so4
5270!
5271!--    Mean relative thermal velocity between the particles (m/s)
5272       zcv_c = SQRT( 8.0_wp * abo * ptemp / ( pi * zm_c ) )
5273       zcv_x = SQRT( 8.0_wp * abo * ptemp / ( pi * zm_x ) )
5274       zcv_2 = SQRT( 8.0_wp * abo * ptemp / ( pi * zm_2 ) )
5275!
5276!--    Average velocity after coagulation
5277       zcv_c2(:) = SQRT( zcv_c**2 + zcv_2**2 )
5278       zcv_x2(:) = SQRT( zcv_x**2 + zcv_2**2 )
5279!
5280!--    Knudsen number (zmfp = mean free path of condensing vapour)
5281       zknud_c = 2.0_wp * zmfp / zdcrit
5282       zknud_x = 2.0_wp * zmfp / reglim(1)
5283       zknud_2(:) = MAX( 0.0_wp, 2.0_wp * zmfp / paero(:)%dwet )
5284!
5285!--    Cunningham correction factors (Allen and Raabe, 1985)
5286       zcc_c    = 1.0_wp + zknud_c    * ( 1.142_wp + 0.558_wp * EXP( -0.999_wp / zknud_c ) )
5287       zcc_x    = 1.0_wp + zknud_x    * ( 1.142_wp + 0.558_wp * EXP( -0.999_wp / zknud_x ) )
5288       zcc_2(:) = 1.0_wp + zknud_2(:) * ( 1.142_wp + 0.558_wp * EXP( -0.999_wp / zknud_2(:) ) )
5289!
5290!--    Gas dynamic viscosity (N*s/m2). Here, viscocity(air @20C) = 1.81e-5_dp N/m2 *s (Hinds, p. 25)
5291       zmyy = 1.81E-5_wp * ( ptemp / 293.0_wp )**0.74_wp
5292!
5293!--    Particle diffusion coefficient (m2/s) (continuum regime)
5294       zdc_c(:) = abo * ptemp * zcc_c    / ( 3.0_wp * pi * zmyy * zdcrit )
5295       zdc_x(:) = abo * ptemp * zcc_x    / ( 3.0_wp * pi * zmyy * reglim(1) )
5296       zdc_2(:) = abo * ptemp * zcc_2(:) / ( 3.0_wp * pi * zmyy * paero(:)%dwet )
5297!
5298!--    D12 = D1+D2 (Seinfield and Pandis, 2nd ed. Eq. 13.38)
5299       zdc_c2 = zdc_c + zdc_2
5300       zdc_x2 = zdc_x + zdc_2
5301!
5302!--    zgamma_f = 8*D/pi/zcv (m) for calculating zomega (Fuchs, 1964)
5303       zgamma_f_c = 8.0_wp * zdc_c / pi / zcv_c
5304       zgamma_f_x = 8.0_wp * zdc_x / pi / zcv_x
5305       zgamma_f_2 = 8.0_wp * zdc_2 / pi / zcv_2
5306!
5307!--    zomega (m) for calculating zsigma
5308       zomega_c = ( ( z_r_c2 + zgamma_f_c )**3 - ( z_r_c2 ** 2 + zgamma_f_c )**1.5_wp ) /          &
5309                  ( 3.0_wp * z_r_c2 * zgamma_f_c ) - z_r_c2
5310       zomega_x = ( ( z_r_x2 + zgamma_f_x )**3 - ( z_r_x2**2 + zgamma_f_x )** 1.5_wp ) /           &
5311                  ( 3.0_wp * z_r_x2 * zgamma_f_x ) - z_r_x2
5312       zomega_2c = ( ( z_r_c2 + zgamma_f_2 )**3 - ( z_r_c2**2 + zgamma_f_2 )**1.5_wp ) /           &
5313                   ( 3.0_wp * z_r_c2 * zgamma_f_2 ) - z_r_c2
5314       zomega_2x = ( ( z_r_x2 + zgamma_f_2 )**3 - ( z_r_x2**2 + zgamma_f_2 )**1.5_wp ) /           &
5315                   ( 3.0_wp * z_r_x2 * zgamma_f_2 ) - z_r_x2 
5316!
5317!--    The distance (m) at which the two fluxes are matched (condensation and coagulation sinks)
5318       zsigma_c2 = SQRT( zomega_c**2 + zomega_2c**2 )
5319       zsigma_x2 = SQRT( zomega_x**2 + zomega_2x**2 )
5320!
5321!--    Coagulation coefficient in the continuum regime (m*m2/s, Eq. 17 in Kulmala et al., 2001)
5322       z_k_c2 = 4.0_wp * pi * z_r_c2 * zdc_c2 / ( z_r_c2 / ( z_r_c2 + zsigma_c2 ) +                &
5323               4.0_wp * zdc_c2 / ( zcv_c2 * z_r_c2 ) )
5324       z_k_x2 = 4.0_wp * pi * z_r_x2 * zdc_x2 / ( z_r_x2 / ( z_r_x2 + zsigma_x2 ) +                &
5325               4.0_wp * zdc_x2 / ( zcv_x2 * z_r_x2 ) )
5326!
5327!--    Coagulation sink (1/s, Eq. 16 in Kulmala et al., 2001)
5328       zcoags_c = MAX( 1.0E-20_wp, SUM( z_k_c2 * paero(:)%numc ) )
5329       zcoags_x = MAX( 1.0E-20_wp, SUM( z_k_x2 * paero(:)%numc ) )
5330!
5331!--    Parameter m for calculating the coagulation sink onto background particles (Eq. 5&6 in
5332!--    Lehtinen et al. 2007)
5333       zm_para = LOG( zcoags_x / zcoags_c ) / LOG( reglim(1) / zdcrit )
5334!
5335!--    Parameter gamma for calculating the formation rate J of particles having
5336!--    a diameter zdcrit < d < reglim(1) (Anttila et al. 2010, eq. 5 or Lehtinen et al.,2007, eq. 7)
5337       zgamma = ( ( ( reglim(1) / zdcrit )**( zm_para + 1.0_wp ) ) - 1.0_wp ) / ( zm_para + 1.0_wp )
5338
5339       IF ( nj3 == 2 )  THEN   ! Lehtinen et al. (2007): coagulation sink
5340!
5341!--       Formation rate J before iteration (#/m3s)
5342          zj3 = zjnuc * EXP( MIN( 0.0_wp, -zgamma * zdcrit * zcoags_c / ( z_gr_clust * 1.0E-9_wp / &
5343                60.0_wp**2 ) ) )
5344
5345       ELSEIF ( nj3 == 3 )  THEN  ! Anttila et al. (2010): coagulation sink and self-coag.
5346!
5347!--       If air is polluted, the self-coagulation becomes important. Self-coagulation of small
5348!--       particles < 3 nm.
5349!
5350!--       "Effective" coagulation coefficient between freshly-nucleated particles:
5351          z_k_eff = 5.0E-16_wp   ! m3/s
5352!
5353!--       zlambda parameter for "adjusting" the growth rate due to the self-coagulation
5354          zlambda = 6.0_wp
5355
5356          IF ( reglim(1) >= 10.0E-9_wp )  THEN   ! for particles >10 nm:
5357             z_k_eff   = 5.0E-17_wp
5358             zlambda = 3.0_wp
5359          ENDIF
5360!
5361!--       Initial values for coagulation sink and growth rate  (m/s)
5362          zcoagstot = zcoags_c
5363          z_gr_tot = z_gr_clust * 1.0E-9_wp / 60.0_wp**2
5364!
5365!--       Number of clusters/particles at the size range [d1,dx] (#/m3):
5366          z_n_nuc = zjnuc / zcoagstot !< Initial guess
5367!
5368!--       Coagulation sink and growth rate due to self-coagulation:
5369          DO  iteration = 1, 5
5370             zcoagstot = zcoags_c + z_k_eff * z_n_nuc * 1.0E-6_wp   ! (1/s, Anttila et al., eq. 1)
5371             z_gr_tot = z_gr_clust * 2.77777777E-7_wp +  1.5708E-6_wp * zlambda * zdcrit**3 *      &
5372                      ( z_n_nuc * 1.0E-6_wp ) * zcv_c * avo * 2.77777777E-7_wp ! (Eq. 3)
5373             zeta = - zcoagstot / ( ( zm_para + 1.0_wp ) * z_gr_tot * ( zdcrit**zm_para ) ) ! (Eq.7b)
5374!
5375!--          Calculate Eq. 7a (Taylor series for the number of particles between [d1,dx])
5376             z_n_nuc =  z_n_nuc_tayl( zdcrit, reglim(1), zm_para, zjnuc, zeta, z_gr_tot )
5377          ENDDO
5378!
5379!--       Calculate the final values with new z_n_nuc:
5380          zcoagstot = zcoags_c + z_k_eff * z_n_nuc * 1.0E-6_wp   ! (1/s)
5381          z_gr_tot = z_gr_clust * 1.0E-9_wp / 3600.0_wp + 1.5708E-6_wp *  zlambda * zdcrit**3 *    &
5382                   ( z_n_nuc * 1.0E-6_wp ) * zcv_c * avo * 1.0E-9_wp / 3600.0_wp !< (m/s)
5383          zj3 = zjnuc * EXP( MIN( 0.0_wp, -zgamma * zdcrit * zcoagstot / z_gr_tot ) ) ! (#/m3s, Eq.5a)
5384
5385       ENDIF
5386    ENDIF
5387!
5388!-- If J3 very small (< 1 #/cm3), neglect particle formation. In real atmosphere this would mean
5389!-- that clusters form but coagulate to pre-existing particles who gain sulphate. Since
5390!-- CoagS ~ CS (4piD*CS'), we do *not* update H2SO4 concentration here but let condensation take
5391!-- care of it. Formation mass rate of molecules (molec/m3s) for 1: H2SO4 and 2: organic vapour
5392    pj3n3(1) = zj3 * n3 * pxsa
5393    pj3n3(2) = zj3 * n3 * pxocnv
5394
5395 END SUBROUTINE nucleation
5396
5397!------------------------------------------------------------------------------!
5398! Description:
5399! ------------
5400!> Calculate the nucleation rate and the size of critical clusters assuming
5401!> binary nucleation.
5402!> Parametrisation according to Vehkamaki et al. (2002), J. Geophys. Res.,
5403!> 107(D22), 4622. Called from subroutine nucleation.
5404!------------------------------------------------------------------------------!
5405 SUBROUTINE binnucl( pc_sa, ptemp, prh, pnuc_rate, pn_crit_sa, pn_crit_ocnv, pd_crit, pk_sa,       &
5406                     pk_ocnv )
5407
5408    IMPLICIT NONE
5409
5410    REAL(wp) ::  za      !<
5411    REAL(wp) ::  zb      !<
5412    REAL(wp) ::  zc      !<
5413    REAL(wp) ::  zcoll   !<
5414    REAL(wp) ::  zlogsa  !<  LOG( zpcsa )
5415    REAL(wp) ::  zlogrh  !<  LOG( zrh )
5416    REAL(wp) ::  zm1     !<
5417    REAL(wp) ::  zm2     !<
5418    REAL(wp) ::  zma     !<
5419    REAL(wp) ::  zmw     !<
5420    REAL(wp) ::  zntot   !< number of molecules in critical cluster
5421    REAL(wp) ::  zpcsa   !< sulfuric acid concentration
5422    REAL(wp) ::  zrh     !< relative humidity
5423    REAL(wp) ::  zroo    !<
5424    REAL(wp) ::  zt      !< temperature
5425    REAL(wp) ::  zv1     !<
5426    REAL(wp) ::  zv2     !<
5427    REAL(wp) ::  zx      !< mole fraction of sulphate in critical cluster
5428    REAL(wp) ::  zxmass  !<
5429
5430    REAL(wp), INTENT(in) ::   pc_sa   !< H2SO4 conc. (#/cm3)
5431    REAL(wp), INTENT(in) ::   prh     !< relative humidity [0-1
5432    REAL(wp), INTENT(in) ::   ptemp   !< ambient temperature (K)
5433
5434    REAL(wp), INTENT(out) ::  pnuc_rate     !< nucleation rate (#/(m3 s))
5435    REAL(wp), INTENT(out) ::  pn_crit_sa    !< number of H2SO4 molecules in cluster (#)
5436    REAL(wp), INTENT(out) ::  pn_crit_ocnv  !< number of organic molecules in cluster (#)
5437    REAL(wp), INTENT(out) ::  pd_crit       !< diameter of critical cluster (m)
5438    REAL(wp), INTENT(out) ::  pk_sa         !< Lever: if pk_sa = 1, H2SO4 is involved in nucleation.
5439    REAL(wp), INTENT(out) ::  pk_ocnv       !< Lever: if pk_ocnv = 1, organic compounds are involved
5440
5441    pnuc_rate = 0.0_wp
5442    pd_crit   = 1.0E-9_wp
5443!
5444!-- 1) Checking that we are in the validity range of the parameterization
5445    zpcsa  = MAX( pc_sa, 1.0E4_wp  )
5446    zpcsa  = MIN( zpcsa, 1.0E11_wp )
5447    zrh    = MAX( prh,   0.0001_wp )
5448    zrh    = MIN( zrh,   1.0_wp    )
5449    zt     = MAX( ptemp, 190.15_wp )
5450    zt     = MIN( zt,    300.15_wp )
5451
5452    zlogsa = LOG( zpcsa )
5453    zlogrh   = LOG( prh )
5454!
5455!-- 2) Mole fraction of sulphate in a critical cluster (Eq. 11)
5456    zx = 0.7409967177282139_wp                  - 0.002663785665140117_wp * zt +                   &
5457         0.002010478847383187_wp * zlogrh       - 0.0001832894131464668_wp* zt * zlogrh +          &
5458         0.001574072538464286_wp * zlogrh**2    - 0.00001790589121766952_wp * zt * zlogrh**2 +     &
5459         0.0001844027436573778_wp * zlogrh**3   - 1.503452308794887E-6_wp * zt * zlogrh**3 -       &
5460         0.003499978417957668_wp * zlogsa     + 0.0000504021689382576_wp * zt * zlogsa
5461!
5462!-- 3) Nucleation rate (Eq. 12)
5463    pnuc_rate = 0.1430901615568665_wp + 2.219563673425199_wp * zt -                                &
5464                0.02739106114964264_wp * zt**2 + 0.00007228107239317088_wp * zt**3 +               &
5465                5.91822263375044_wp / zx + 0.1174886643003278_wp * zlogrh +                        &
5466                0.4625315047693772_wp * zt * zlogrh - 0.01180591129059253_wp * zt**2 * zlogrh +    &
5467                0.0000404196487152575_wp * zt**3 * zlogrh +                                        &
5468                ( 15.79628615047088_wp * zlogrh ) / zx - 0.215553951893509_wp * zlogrh**2 -        &
5469                0.0810269192332194_wp * zt * zlogrh**2 +                                           &
5470                0.001435808434184642_wp * zt**2 * zlogrh**2 -                                      &
5471                4.775796947178588E-6_wp * zt**3 * zlogrh**2 -                                      &
5472                ( 2.912974063702185_wp * zlogrh**2 ) / zx - 3.588557942822751_wp * zlogrh**3 +     &
5473                0.04950795302831703_wp * zt * zlogrh**3 -                                          &
5474                0.0002138195118737068_wp * zt**2 * zlogrh**3 +                                     &
5475                3.108005107949533E-7_wp * zt**3 * zlogrh**3 -                                      &
5476                ( 0.02933332747098296_wp * zlogrh**3 ) / zx + 1.145983818561277_wp * zlogsa -      &
5477                0.6007956227856778_wp * zt * zlogsa + 0.00864244733283759_wp * zt**2 * zlogsa -    &
5478                0.00002289467254710888_wp * zt**3 * zlogsa -                                       &
5479                ( 8.44984513869014_wp * zlogsa ) / zx + 2.158548369286559_wp * zlogrh * zlogsa +   &
5480                0.0808121412840917_wp * zt * zlogrh * zlogsa -                                     &
5481                0.0004073815255395214_wp * zt**2 * zlogrh * zlogsa -                               &
5482                4.019572560156515E-7_wp * zt**3 * zlogrh * zlogsa +                                &
5483                ( 0.7213255852557236_wp * zlogrh * zlogsa ) / zx +                                 &
5484                1.62409850488771_wp * zlogrh**2 * zlogsa -                                         &
5485                0.01601062035325362_wp * zt * zlogrh**2 * zlogsa +                                 &
5486                0.00003771238979714162_wp*zt**2* zlogrh**2 * zlogsa +                              &
5487                3.217942606371182E-8_wp * zt**3 * zlogrh**2 * zlogsa -                             &
5488                ( 0.01132550810022116_wp * zlogrh**2 * zlogsa ) / zx +                             &
5489                9.71681713056504_wp * zlogsa**2 - 0.1150478558347306_wp * zt * zlogsa**2 +         &
5490                0.0001570982486038294_wp * zt**2 * zlogsa**2 +                                     &
5491                4.009144680125015E-7_wp * zt**3 * zlogsa**2 +                                      &
5492                ( 0.7118597859976135_wp * zlogsa**2 ) / zx -                                       &
5493                1.056105824379897_wp * zlogrh * zlogsa**2 +                                        &
5494                0.00903377584628419_wp * zt * zlogrh * zlogsa**2 -                                 &
5495                0.00001984167387090606_wp * zt**2 * zlogrh * zlogsa**2 +                           &
5496                2.460478196482179E-8_wp * zt**3 * zlogrh * zlogsa**2 -                             &
5497                ( 0.05790872906645181_wp * zlogrh * zlogsa**2 ) / zx -                             &
5498                0.1487119673397459_wp * zlogsa**3 + 0.002835082097822667_wp * zt * zlogsa**3 -     &
5499                9.24618825471694E-6_wp * zt**2 * zlogsa**3 +                                       &
5500                5.004267665960894E-9_wp * zt**3 * zlogsa**3 -                                      &
5501                ( 0.01270805101481648_wp * zlogsa**3 ) / zx
5502!
5503!-- Nucleation rate in #/(cm3 s)
5504    pnuc_rate = EXP( pnuc_rate ) 
5505!
5506!-- Check the validity of parameterization
5507    IF ( pnuc_rate < 1.0E-7_wp )  THEN
5508       pnuc_rate = 0.0_wp
5509       pd_crit   = 1.0E-9_wp
5510    ENDIF
5511!
5512!-- 4) Total number of molecules in the critical cluster (Eq. 13)
5513    zntot = - 0.002954125078716302_wp - 0.0976834264241286_wp * zt +                               &
5514              0.001024847927067835_wp * zt**2 - 2.186459697726116E-6_wp * zt**3 -                  &
5515              0.1017165718716887_wp / zx - 0.002050640345231486_wp * zlogrh -                      &
5516              0.007585041382707174_wp * zt * zlogrh + 0.0001926539658089536_wp * zt**2 * zlogrh -  &
5517              6.70429719683894E-7_wp * zt**3 * zlogrh - ( 0.2557744774673163_wp * zlogrh ) / zx +  &
5518              0.003223076552477191_wp * zlogrh**2 + 0.000852636632240633_wp * zt * zlogrh**2 -     &
5519              0.00001547571354871789_wp * zt**2 * zlogrh**2 +                                      &
5520              5.666608424980593E-8_wp * zt**3 * zlogrh**2 +                                        &
5521              ( 0.03384437400744206_wp * zlogrh**2 ) / zx +                                        &
5522              0.04743226764572505_wp * zlogrh**3 - 0.0006251042204583412_wp * zt * zlogrh**3 +     &
5523              2.650663328519478E-6_wp * zt**2 * zlogrh**3 -                                        &
5524              3.674710848763778E-9_wp * zt**3 * zlogrh**3 -                                        &
5525              ( 0.0002672510825259393_wp * zlogrh**3 ) / zx - 0.01252108546759328_wp * zlogsa +    &
5526              0.005806550506277202_wp * zt * zlogsa - 0.0001016735312443444_wp * zt**2 * zlogsa +  &
5527              2.881946187214505E-7_wp * zt**3 * zlogsa + ( 0.0942243379396279_wp * zlogsa ) / zx - &
5528              0.0385459592773097_wp * zlogrh * zlogsa -                                            &
5529              0.0006723156277391984_wp * zt * zlogrh * zlogsa  +                                   &
5530              2.602884877659698E-6_wp * zt**2 * zlogrh * zlogsa +                                  &
5531              1.194163699688297E-8_wp * zt**3 * zlogrh * zlogsa -                                  &
5532              ( 0.00851515345806281_wp * zlogrh * zlogsa ) / zx -                                  &
5533              0.01837488495738111_wp * zlogrh**2 * zlogsa +                                        &
5534              0.0001720723574407498_wp * zt * zlogrh**2 * zlogsa -                                 &
5535              3.717657974086814E-7_wp * zt**2 * zlogrh**2 * zlogsa -                               &
5536              5.148746022615196E-10_wp * zt**3 * zlogrh**2 * zlogsa +                              &
5537              ( 0.0002686602132926594_wp * zlogrh**2 * zlogsa ) / zx -                             &
5538              0.06199739728812199_wp * zlogsa**2 + 0.000906958053583576_wp * zt * zlogsa**2 -      &
5539              9.11727926129757E-7_wp * zt**2 * zlogsa**2 -                                         &
5540              5.367963396508457E-9_wp * zt**3 * zlogsa**2 -                                        &
5541              ( 0.007742343393937707_wp * zlogsa**2 ) / zx +                                       &
5542              0.0121827103101659_wp * zlogrh * zlogsa**2 -                                         &
5543              0.0001066499571188091_wp * zt * zlogrh * zlogsa**2 +                                 &
5544              2.534598655067518E-7_wp * zt**2 * zlogrh * zlogsa**2 -                               &
5545              3.635186504599571E-10_wp * zt**3 * zlogrh * zlogsa**2 +                              &
5546              ( 0.0006100650851863252_wp * zlogrh * zlogsa **2 ) / zx +                            &
5547              0.0003201836700403512_wp * zlogsa**3 - 0.0000174761713262546_wp * zt * zlogsa**3 +   &
5548              6.065037668052182E-8_wp * zt**2 * zlogsa**3 -                                        &
5549              1.421771723004557E-11_wp * zt**3 * zlogsa**3 +                                       &
5550              ( 0.0001357509859501723_wp * zlogsa**3 ) / zx
5551    zntot = EXP( zntot )  ! in #
5552!
5553!-- 5) Size of the critical cluster pd_crit (m) (diameter) (Eq. 14)
5554    pn_crit_sa = zx * zntot
5555    pd_crit = 2.0E-9_wp * EXP( -1.6524245_wp + 0.42316402_wp * zx + 0.33466487_wp * LOG( zntot ) )
5556!
5557!-- 6) Organic compounds not involved when binary nucleation is assumed
5558    pn_crit_ocnv = 0.0_wp   ! number of organic molecules
5559    pk_sa        = 1.0_wp   ! if = 1, H2SO4 involved in nucleation
5560    pk_ocnv      = 0.0_wp   ! if = 1, organic compounds involved
5561!
5562!-- Set nucleation rate to collision rate
5563    IF ( pn_crit_sa < 4.0_wp ) THEN
5564!
5565!--    Volumes of the colliding objects
5566       zma    = 96.0_wp   ! molar mass of SO4 in g/mol
5567       zmw    = 18.0_wp   ! molar mass of water in g/mol
5568       zxmass = 1.0_wp    ! mass fraction of H2SO4
5569       za = 0.7681724_wp + zxmass * ( 2.1847140_wp + zxmass *                                      &
5570                                      ( 7.1630022_wp + zxmass *                                    &
5571                                        ( -44.31447_wp + zxmass *                                  &
5572                                          ( 88.75606 + zxmass *                                    &
5573                                            ( -75.73729_wp + zxmass * 23.43228_wp ) ) ) ) )
5574       zb = 1.808225E-3_wp + zxmass * ( -9.294656E-3_wp + zxmass *                                 &
5575                                        ( -0.03742148_wp + zxmass *                                &
5576                                          ( 0.2565321_wp + zxmass *                                &
5577                                            ( -0.5362872_wp + zxmass *                             &
5578                                              ( 0.4857736 - zxmass * 0.1629592_wp ) ) ) ) )
5579       zc = - 3.478524E-6_wp + zxmass * ( 1.335867E-5_wp + zxmass *                                &
5580                                          ( 5.195706E-5_wp + zxmass *                              &
5581                                            ( -3.717636E-4_wp + zxmass *                           &
5582                                              ( 7.990811E-4_wp + zxmass *                          &
5583                                                ( -7.458060E-4_wp + zxmass * 2.58139E-4_wp ) ) ) ) )
5584!
5585!--    Density for the sulphuric acid solution (Eq. 10 in Vehkamaki)
5586       zroo = ( za + zt * ( zb + zc * zt ) ) * 1.0E+3_wp   ! (kg/m^3
5587       zm1  = 0.098_wp   ! molar mass of H2SO4 in kg/mol
5588       zm2  = zm1
5589       zv1  = zm1 / avo / zroo   ! volume
5590       zv2  = zv1
5591!
5592!--    Collision rate
5593       zcoll =  zpcsa * zpcsa * ( 3.0_wp * pi / 4.0_wp )**0.16666666_wp *                          &
5594                SQRT( 6.0_wp * argas * zt / zm1 + 6.0_wp * argas * zt / zm2 ) *                    &
5595                ( zv1**0.33333333_wp + zv2**0.33333333_wp )**2 * 1.0E+6_wp    ! m3 -> cm3
5596       zcoll = MIN( zcoll, 1.0E+10_wp )
5597       pnuc_rate  = zcoll   ! (#/(cm3 s))
5598
5599    ELSE
5600       pnuc_rate  = MIN( pnuc_rate, 1.0E+10_wp )
5601    ENDIF
5602    pnuc_rate = pnuc_rate * 1.0E+6_wp   ! (#/(m3 s))
5603
5604 END SUBROUTINE binnucl
5605 
5606!------------------------------------------------------------------------------!
5607! Description:
5608! ------------
5609!> Calculate the nucleation rate and the size of critical clusters assuming
5610!> ternary nucleation. Parametrisation according to:
5611!> Napari et al. (2002), J. Chem. Phys., 116, 4221-4227 and
5612!> Napari et al. (2002), J. Geophys. Res., 107(D19), AAC 6-1-ACC 6-6.
5613!------------------------------------------------------------------------------!
5614 SUBROUTINE ternucl( pc_sa, pc_nh3, ptemp, prh, pnuc_rate, pn_crit_sa, pn_crit_ocnv, pd_crit,      &
5615                     pk_sa, pk_ocnv )
5616
5617    IMPLICIT NONE
5618
5619    REAL(wp) ::  zlnj     !< logarithm of nucleation rate
5620    REAL(wp) ::  zlognh3  !< LOG( pc_nh3 )
5621    REAL(wp) ::  zlogrh   !< LOG( prh )
5622    REAL(wp) ::  zlogsa   !< LOG( pc_sa )
5623
5624    REAL(wp), INTENT(in) ::   pc_nh3  !< ammonia mixing ratio (ppt)
5625    REAL(wp), INTENT(in) ::   pc_sa   !< H2SO4 conc. (#/cm3)
5626    REAL(wp), INTENT(in) ::   prh     !< relative humidity [0-1]
5627    REAL(wp), INTENT(in) ::   ptemp   !< ambient temperature (K)
5628
5629    REAL(wp), INTENT(out) ::  pd_crit  !< diameter of critical cluster (m)
5630    REAL(wp), INTENT(out) ::  pk_ocnv  !< if pk_ocnv = 1, organic compounds participate in nucleation
5631    REAL(wp), INTENT(out) ::  pk_sa    !< if pk_sa = 1, H2SO4 participate in nucleation
5632    REAL(wp), INTENT(out) ::  pn_crit_ocnv  !< number of organic molecules in cluster (#)
5633    REAL(wp), INTENT(out) ::  pn_crit_sa    !< number of H2SO4 molecules in cluster (#)
5634    REAL(wp), INTENT(out) ::  pnuc_rate     !< nucleation rate (#/(m3 s))
5635!
5636!-- 1) Checking that we are in the validity range of the parameterization.
5637!--    Validity of parameterization : DO NOT REMOVE!
5638    IF ( ptemp < 240.0_wp  .OR.  ptemp > 300.0_wp )  THEN
5639       message_string = 'Invalid input value: ptemp'
5640       CALL message( 'salsa_mod: ternucl', 'PA0648', 1, 2, 0, 6, 0 )
5641    ENDIF
5642    IF ( prh < 0.05_wp  .OR.  prh > 0.95_wp )  THEN
5643       message_string = 'Invalid input value: prh'
5644       CALL message( 'salsa_mod: ternucl', 'PA0649', 1, 2, 0, 6, 0 )
5645    ENDIF
5646    IF ( pc_sa < 1.0E+4_wp  .OR.  pc_sa > 1.0E+9_wp )  THEN
5647       message_string = 'Invalid input value: pc_sa'
5648       CALL message( 'salsa_mod: ternucl', 'PA0650', 1, 2, 0, 6, 0 )
5649    ENDIF
5650    IF ( pc_nh3 < 0.1_wp  .OR.  pc_nh3 > 100.0_wp )  THEN
5651       message_string = 'Invalid input value: pc_nh3'
5652       CALL message( 'salsa_mod: ternucl', 'PA0651', 1, 2, 0, 6, 0 )
5653    ENDIF
5654
5655    zlognh3 = LOG( pc_nh3 )
5656    zlogrh  = LOG( prh )
5657    zlogsa  = LOG( pc_sa )
5658!
5659!-- 2) Nucleation rate (Eq. 7 in Napari et al., 2002: Parameterization of
5660!--    ternary nucleation of sulfuric acid - ammonia - water.
5661    zlnj = - 84.7551114741543_wp + 0.3117595133628944_wp * prh +                                   &
5662           1.640089605712946_wp * prh * ptemp - 0.003438516933381083_wp * prh * ptemp**2 -         &
5663           0.00001097530402419113_wp * prh * ptemp**3 - 0.3552967070274677_wp / zlogsa -           &
5664           ( 0.06651397829765026_wp * prh ) / zlogsa - ( 33.84493989762471_wp * ptemp ) / zlogsa - &
5665           ( 7.823815852128623_wp * prh * ptemp ) / zlogsa +                                       &
5666           ( 0.3453602302090915_wp * ptemp**2 ) / zlogsa +                                         &
5667           ( 0.01229375748100015_wp * prh * ptemp**2 ) / zlogsa -                                  &
5668           ( 0.000824007160514956_wp *ptemp**3 ) / zlogsa +                                        &
5669           ( 0.00006185539100670249_wp * prh * ptemp**3 ) / zlogsa +                               &
5670           3.137345238574998_wp * zlogsa + 3.680240980277051_wp * prh * zlogsa -                   &
5671           0.7728606202085936_wp * ptemp * zlogsa - 0.204098217156962_wp * prh * ptemp * zlogsa +  &
5672           0.005612037586790018_wp * ptemp**2 * zlogsa +                                           &
5673           0.001062588391907444_wp * prh * ptemp**2 * zlogsa -                                     &
5674           9.74575691760229E-6_wp * ptemp**3 * zlogsa -                                            &
5675           1.265595265137352E-6_wp * prh * ptemp**3 * zlogsa + 19.03593713032114_wp * zlogsa**2 -  &
5676           0.1709570721236754_wp * ptemp * zlogsa**2 +                                             &
5677           0.000479808018162089_wp * ptemp**2 * zlogsa**2 -                                        &
5678           4.146989369117246E-7_wp * ptemp**3 * zlogsa**2 + 1.076046750412183_wp * zlognh3 +       &
5679           0.6587399318567337_wp * prh * zlognh3 + 1.48932164750748_wp * ptemp * zlognh3 +         &
5680           0.1905424394695381_wp * prh * ptemp * zlognh3 -                                         &
5681           0.007960522921316015_wp * ptemp**2 * zlognh3 -                                          &
5682           0.001657184248661241_wp * prh * ptemp**2 * zlognh3 +                                    &
5683           7.612287245047392E-6_wp * ptemp**3 * zlognh3 +                                          &
5684           3.417436525881869E-6_wp * prh * ptemp**3 * zlognh3 +                                    &
5685           ( 0.1655358260404061_wp * zlognh3 ) / zlogsa +                                          &
5686           ( 0.05301667612522116_wp * prh * zlognh3 ) / zlogsa +                                   &
5687           ( 3.26622914116752_wp * ptemp * zlognh3 ) / zlogsa -                                    &
5688           ( 1.988145079742164_wp * prh * ptemp * zlognh3 ) / zlogsa -                             &
5689           ( 0.04897027401984064_wp * ptemp**2 * zlognh3 ) / zlogsa +                              &
5690           ( 0.01578269253599732_wp * prh * ptemp**2 * zlognh3 ) / zlogsa +                        &
5691           ( 0.0001469672236351303_wp * ptemp**3 * zlognh3 ) / zlogsa -                            &
5692           ( 0.00002935642836387197_wp * prh * ptemp**3 *zlognh3 ) / zlogsa +                      &
5693           6.526451177887659_wp * zlogsa * zlognh3 -                                               &
5694           0.2580021816722099_wp * ptemp * zlogsa * zlognh3 +                                      &
5695           0.001434563104474292_wp * ptemp**2 * zlogsa * zlognh3 -                                 &
5696           2.020361939304473E-6_wp * ptemp**3 * zlogsa * zlognh3 -                                 &
5697           0.160335824596627_wp * zlogsa**2 * zlognh3 +                                            &
5698           0.00889880721460806_wp * ptemp * zlogsa**2 * zlognh3 -                                  &
5699           0.00005395139051155007_wp * ptemp**2 * zlogsa**2 * zlognh3 +                            &
5700           8.39521718689596E-8_wp * ptemp**3 * zlogsa**2 * zlognh3 +                               &
5701           6.091597586754857_wp * zlognh3**2 + 8.5786763679309_wp * prh * zlognh3**2 -             &
5702           1.253783854872055_wp * ptemp * zlognh3**2 -                                             &
5703           0.1123577232346848_wp * prh * ptemp * zlognh3**2 +                                      &
5704           0.00939835595219825_wp * ptemp**2 * zlognh3**2 +                                        &
5705           0.0004726256283031513_wp * prh * ptemp**2 * zlognh3**2 -                                &
5706           0.00001749269360523252_wp * ptemp**3 * zlognh3**2 -                                     &
5707           6.483647863710339E-7_wp * prh * ptemp**3 * zlognh3**2 +                                 &
5708           ( 0.7284285726576598_wp * zlognh3**2 ) / zlogsa +                                       &
5709           ( 3.647355600846383_wp * ptemp * zlognh3**2 ) / zlogsa -                                &
5710           ( 0.02742195276078021_wp * ptemp**2 * zlognh3**2 ) / zlogsa +                           &
5711           ( 0.00004934777934047135_wp * ptemp**3 * zlognh3**2 ) / zlogsa +                        &
5712           41.30162491567873_wp * zlogsa * zlognh3**2 -                                            &
5713           0.357520416800604_wp * ptemp * zlogsa * zlognh3**2 +                                    &
5714           0.000904383005178356_wp * ptemp**2 * zlogsa * zlognh3**2 -                              &
5715           5.737876676408978E-7_wp * ptemp**3 * zlogsa * zlognh3**2 -                              &
5716           2.327363918851818_wp * zlogsa**2 * zlognh3**2 +                                         &
5717           0.02346464261919324_wp * ptemp * zlogsa**2 * zlognh3**2 -                               &
5718           0.000076518969516405_wp * ptemp**2 * zlogsa**2 * zlognh3**2 +                           &
5719           8.04589834836395E-8_wp * ptemp**3 * zlogsa**2 * zlognh3**2 -                            &
5720           0.02007379204248076_wp * zlogrh - 0.7521152446208771_wp * ptemp * zlogrh +              &
5721           0.005258130151226247_wp * ptemp**2 * zlogrh -                                           &
5722           8.98037634284419E-6_wp * ptemp**3 * zlogrh +                                            &
5723           ( 0.05993213079516759_wp * zlogrh ) / zlogsa +                                          &
5724           ( 5.964746463184173_wp * ptemp * zlogrh ) / zlogsa -                                    &
5725           ( 0.03624322255690942_wp * ptemp**2 * zlogrh ) / zlogsa +                               &
5726           ( 0.00004933369382462509_wp * ptemp**3 * zlogrh ) / zlogsa -                            &
5727           0.7327310805365114_wp * zlognh3 * zlogrh -                                              &
5728           0.01841792282958795_wp * ptemp * zlognh3 * zlogrh +                                     &
5729           0.0001471855981005184_wp * ptemp**2 * zlognh3 * zlogrh -                                &
5730           2.377113195631848E-7_wp * ptemp**3 * zlognh3 * zlogrh
5731    pnuc_rate = EXP( zlnj )   ! (#/(cm3 s))
5732!
5733!-- Check validity of parametrization
5734    IF ( pnuc_rate < 1.0E-5_wp )  THEN
5735       pnuc_rate = 0.0_wp
5736       pd_crit   = 1.0E-9_wp
5737    ELSEIF ( pnuc_rate > 1.0E6_wp )  THEN
5738       message_string = 'Invalid output value: nucleation rate > 10^6 1/cm3s'
5739       CALL message( 'salsa_mod: ternucl', 'PA0623', 1, 2, 0, 6, 0 )
5740    ENDIF
5741    pnuc_rate = pnuc_rate * 1.0E6_wp   ! (#/(m3 s))
5742!
5743!-- 3) Number of H2SO4 molecules in a critical cluster (Eq. 9)
5744    pn_crit_sa = 38.16448247950508_wp + 0.7741058259731187_wp * zlnj +                             &
5745                 0.002988789927230632_wp * zlnj**2 - 0.3576046920535017_wp * ptemp -               &
5746                 0.003663583011953248_wp * zlnj * ptemp + 0.000855300153372776_wp * ptemp**2
5747!
5748!-- Kinetic limit: at least 2 H2SO4 molecules in a cluster
5749    pn_crit_sa = MAX( pn_crit_sa, 2.0E0_wp )
5750!
5751!-- 4) Size of the critical cluster in nm (Eq. 12)
5752    pd_crit = 0.1410271086638381_wp - 0.001226253898894878_wp * zlnj -                             &
5753              7.822111731550752E-6_wp * zlnj**2 - 0.001567273351921166_wp * ptemp -                &
5754              0.00003075996088273962_wp * zlnj * ptemp + 0.00001083754117202233_wp * ptemp**2
5755    pd_crit = pd_crit * 2.0E-9_wp   ! Diameter in m
5756!
5757!-- 5) Organic compounds not involved when ternary nucleation assumed
5758    pn_crit_ocnv = 0.0_wp
5759    pk_sa   = 1.0_wp
5760    pk_ocnv = 0.0_wp
5761
5762 END SUBROUTINE ternucl
5763
5764!------------------------------------------------------------------------------!
5765! Description:
5766! ------------
5767!> Function z_n_nuc_tayl is connected to the calculation of self-coagualtion of
5768!> small particles. It calculates number of the particles in the size range
5769!> [zdcrit,dx] using Taylor-expansion (please note that the expansion is not
5770!> valid for certain rational numbers, e.g. -4/3 and -3/2)
5771!------------------------------------------------------------------------------!
5772 FUNCTION z_n_nuc_tayl( d1, dx, zm_para, zjnuc_t, zeta, z_gr_tot )
5773
5774    IMPLICIT NONE
5775
5776    INTEGER(iwp) ::  i !< running index
5777
5778    REAL(wp) ::  d1            !< lower diameter limit
5779    REAL(wp) ::  dx            !< upper diameter limit
5780    REAL(wp) ::  zjnuc_t       !< initial nucleation rate (1/s)
5781    REAL(wp) ::  zeta          !< ratio of CS/GR (m) (condensation sink / growth rate)
5782    REAL(wp) ::  term1         !<
5783    REAL(wp) ::  term2         !<
5784    REAL(wp) ::  term3         !<
5785    REAL(wp) ::  term4         !<
5786    REAL(wp) ::  term5         !<
5787    REAL(wp) ::  z_n_nuc_tayl  !< final nucleation rate (1/s)
5788    REAL(wp) ::  z_gr_tot      !< total growth rate (nm/h)
5789    REAL(wp) ::  zm_para       !< m parameter in Lehtinen et al. (2007), Eq. 6
5790
5791    z_n_nuc_tayl = 0.0_wp
5792
5793    DO  i = 0, 29
5794       IF ( i == 0  .OR.  i == 1 )  THEN
5795          term1 = 1.0_wp
5796       ELSE
5797          term1 = term1 * REAL( i, SELECTED_REAL_KIND(12,307) )
5798       END IF
5799       term2 = ( REAL( i, SELECTED_REAL_KIND(12,307) ) * ( zm_para + 1.0_wp ) + 1.0_wp ) * term1
5800       term3 = zeta**i
5801       term4 = term3 / term2
5802       term5 = REAL( i, SELECTED_REAL_KIND(12,307) ) * ( zm_para + 1.0_wp ) + 1.0_wp
5803       z_n_nuc_tayl = z_n_nuc_tayl + term4 * ( dx**term5 - d1**term5 )
5804    ENDDO
5805    z_n_nuc_tayl = z_n_nuc_tayl * zjnuc_t * EXP( -zeta * ( d1**( zm_para + 1 ) ) ) / z_gr_tot
5806
5807 END FUNCTION z_n_nuc_tayl
5808
5809!------------------------------------------------------------------------------!
5810! Description:
5811! ------------
5812!> Calculates the condensation of water vapour on aerosol particles. Follows the
5813!> analytical predictor method by Jacobson (2005).
5814!> For equations, see Jacobson (2005), Fundamentals of atmospheric modelling
5815!> (2nd edition).
5816!------------------------------------------------------------------------------!
5817 SUBROUTINE gpparth2o( paero, ptemp, ppres, pcs, pcw, ptstep )
5818
5819    IMPLICIT NONE
5820
5821    INTEGER(iwp) ::  ib   !< loop index
5822    INTEGER(iwp) ::  nstr !<
5823
5824    REAL(wp) ::  adt        !< internal timestep in this subroutine
5825    REAL(wp) ::  rhoair     !< air density (kg/m3)
5826    REAL(wp) ::  ttot       !< total time (s)
5827    REAL(wp) ::  zact       !< Water activity
5828    REAL(wp) ::  zaelwc1    !< Current aerosol water content (kg/m3)
5829    REAL(wp) ::  zaelwc2    !< New aerosol water content after equilibrium calculation (kg/m3)
5830    REAL(wp) ::  zbeta      !< Transitional correction factor
5831    REAL(wp) ::  zcwc       !< Current water vapour mole concentration in aerosols (mol/m3)
5832    REAL(wp) ::  zcwint     !< Current and new water vapour mole concentrations (mol/m3)
5833    REAL(wp) ::  zcwn       !< New water vapour mole concentration (mol/m3)
5834    REAL(wp) ::  zcwtot     !< Total water mole concentration (mol/m3)
5835    REAL(wp) ::  zdfh2o     !< molecular diffusion coefficient (cm2/s) for water
5836    REAL(wp) ::  zhlp1      !< intermediate variable to calculate the mass transfer coefficient
5837    REAL(wp) ::  zhlp2      !< intermediate variable to calculate the mass transfer coefficient
5838    REAL(wp) ::  zhlp3      !< intermediate variable to calculate the mass transfer coefficient
5839    REAL(wp) ::  zknud      !< Knudsen number
5840    REAL(wp) ::  zmfph2o    !< mean free path of H2O gas molecule
5841    REAL(wp) ::  zrh        !< relative humidity [0-1]
5842    REAL(wp) ::  zthcond    !< thermal conductivity of air (W/m/K)
5843
5844    REAL(wp), DIMENSION(nbins_aerosol) ::  zcwcae     !< Current water mole concentrations
5845    REAL(wp), DIMENSION(nbins_aerosol) ::  zcwintae   !< Current and new aerosol water mole concentration
5846    REAL(wp), DIMENSION(nbins_aerosol) ::  zcwnae     !< New water mole concentration in aerosols
5847    REAL(wp), DIMENSION(nbins_aerosol) ::  zcwsurfae  !< Surface mole concentration
5848    REAL(wp), DIMENSION(nbins_aerosol) ::  zkelvin    !< Kelvin effect
5849    REAL(wp), DIMENSION(nbins_aerosol) ::  zmtae      !< Mass transfer coefficients
5850    REAL(wp), DIMENSION(nbins_aerosol) ::  zwsatae    !< Water saturation ratio above aerosols
5851
5852    REAL(wp), INTENT(in) ::  ppres   !< Air pressure (Pa)
5853    REAL(wp), INTENT(in) ::  pcs     !< Water vapour saturation concentration (kg/m3)
5854    REAL(wp), INTENT(in) ::  ptemp   !< Ambient temperature (K)
5855    REAL(wp), INTENT(in) ::  ptstep  !< timestep (s)
5856
5857    REAL(wp), INTENT(inout) ::  pcw  !< Water vapour concentration (kg/m3)
5858
5859    TYPE(t_section), DIMENSION(nbins_aerosol), INTENT(inout) ::  paero  !< Aerosol properties
5860!
5861!-- Relative humidity [0-1]
5862    zrh = pcw / pcs
5863!
5864!-- Calculate the condensation only for 2a/2b aerosol bins
5865    nstr = start_subrange_2a
5866!
5867!-- Save the current aerosol water content, 8 in paero is H2O
5868    zaelwc1 = SUM( paero(start_subrange_1a:end_subrange_2b)%volc(8) ) * arhoh2o
5869!
5870!-- Equilibration:
5871    IF ( advect_particle_water )  THEN
5872       IF ( zrh < 0.98_wp  .OR.  .NOT. lscndh2oae )  THEN
5873          CALL equilibration( zrh, ptemp, paero, .TRUE. )
5874       ELSE
5875          CALL equilibration( zrh, ptemp, paero, .FALSE. )
5876       ENDIF
5877    ENDIF
5878!
5879!-- The new aerosol water content after equilibrium calculation
5880    zaelwc2 = SUM( paero(start_subrange_1a:end_subrange_2b)%volc(8) ) * arhoh2o
5881!
5882!-- New water vapour mixing ratio (kg/m3)
5883    pcw = pcw - ( zaelwc2 - zaelwc1 ) * ppres * amdair / ( argas * ptemp )
5884!
5885!-- Initialise variables
5886    zcwsurfae(:) = 0.0_wp
5887    zhlp1        = 0.0_wp
5888    zhlp2        = 0.0_wp
5889    zhlp3        = 0.0_wp
5890    zmtae(:)     = 0.0_wp
5891    zwsatae(:)   = 0.0_wp
5892!
5893!-- Air:
5894!-- Density (kg/m3)
5895    rhoair = amdair * ppres / ( argas * ptemp )
5896!
5897!-- Thermal conductivity of air
5898    zthcond = 0.023807_wp + 7.1128E-5_wp * ( ptemp - 273.16_wp )
5899!
5900!-- Water vapour:
5901!-- Molecular diffusion coefficient (cm2/s) (eq.16.17)
5902    zdfh2o = ( 5.0_wp / ( 16.0_wp * avo * rhoair * 1.0E-3_wp * 3.11E-8_wp**2 ) ) * SQRT( argas *   &
5903               1.0E+7_wp * ptemp * amdair * 1.0E+3_wp * ( amh2o + amdair ) * 1.0E+3_wp /           &
5904               ( pi * amh2o * 2.0E+3_wp ) )
5905    zdfh2o = zdfh2o * 1.0E-4   ! Unit change to m^2/s
5906!
5907!-- Mean free path (eq. 15.25 & 16.29)
5908    zmfph2o = 3.0_wp * zdfh2o * SQRT( pi * amh2o / ( 8.0_wp * argas * ptemp ) )
5909!
5910!-- Kelvin effect (eq. 16.33)
5911    zkelvin(:) = EXP( 4.0_wp * surfw0 * amh2o / ( argas * ptemp * arhoh2o * paero(:)%dwet) )
5912
5913    DO  ib = 1, nbins_aerosol
5914       IF ( paero(ib)%numc > nclim  .AND.  zrh > 0.98_wp )  THEN
5915!
5916!--       Water activity
5917          zact = acth2o( paero(ib) )
5918!
5919!--       Saturation mole concentration over flat surface. Limit the super-
5920!--       saturation to max 1.01 for the mass transfer. Experimental!
5921          zcwsurfae(ib) = MAX( pcs, pcw / 1.01_wp ) * rhoair / amh2o
5922!
5923!--       Equilibrium saturation ratio
5924          zwsatae(ib) = zact * zkelvin(ib)
5925!
5926!--       Knudsen number (eq. 16.20)
5927          zknud = 2.0_wp * zmfph2o / paero(ib)%dwet
5928!
5929!--       Transitional correction factor (Fuks & Sutugin, 1971)
5930          zbeta = ( zknud + 1.0_wp ) / ( 0.377_wp * zknud + 1.0_wp + 4.0_wp /                      &
5931                  ( 3.0_wp * massacc(ib) ) * ( zknud + zknud**2 ) )
5932!
5933!--       Mass transfer of H2O: Eq. 16.64 but here D^eff =  zdfh2o * zbeta
5934          zhlp1 = paero(ib)%numc * 2.0_wp * pi * paero(ib)%dwet * zdfh2o * zbeta
5935!
5936!--       1st term on the left side of the denominator in eq. 16.55
5937          zhlp2 = amh2o * zdfh2o * alv * zwsatae(ib) * zcwsurfae(ib) / ( zthcond * ptemp )
5938!
5939!--       2nd term on the left side of the denominator in eq. 16.55
5940          zhlp3 = ( ( alv * amh2o ) / ( argas * ptemp ) ) - 1.0_wp
5941!
5942!--       Full eq. 16.64: Mass transfer coefficient (1/s)
5943          zmtae(ib) = zhlp1 / ( zhlp2 * zhlp3 + 1.0_wp )
5944       ENDIF
5945    ENDDO
5946!
5947!-- Current mole concentrations of water
5948    zcwc        = pcw * rhoair / amh2o   ! as vapour
5949    zcwcae(:)   = paero(:)%volc(8) * arhoh2o / amh2o   ! in aerosols
5950    zcwtot      = zcwc + SUM( zcwcae )   ! total water concentration
5951    zcwnae(:)   = 0.0_wp
5952    zcwintae(:) = zcwcae(:)
5953!
5954!-- Substepping loop
5955    zcwint = 0.0_wp
5956    ttot   = 0.0_wp
5957    DO  WHILE ( ttot < ptstep )
5958       adt = 2.0E-2_wp   ! internal timestep
5959!
5960!--    New vapour concentration: (eq. 16.71)
5961       zhlp1 = zcwc + adt * ( SUM( zmtae(nstr:nbins_aerosol) * zwsatae(nstr:nbins_aerosol) *       &
5962                                   zcwsurfae(nstr:nbins_aerosol) ) )   ! numerator
5963       zhlp2 = 1.0_wp + adt * ( SUM( zmtae(nstr:nbins_aerosol) ) )   ! denomin.
5964       zcwint = zhlp1 / zhlp2   ! new vapour concentration
5965       zcwint = MIN( zcwint, zcwtot )
5966       IF ( ANY( paero(:)%numc > nclim )  .AND. zrh > 0.98_wp )  THEN
5967          DO  ib = nstr, nbins_aerosol
5968             zcwintae(ib) = zcwcae(ib) + MIN( MAX( adt * zmtae(ib) * ( zcwint - zwsatae(ib) *      &
5969                                                   zcwsurfae(ib) ), -0.02_wp * zcwcae(ib) ),       &
5970                                            0.05_wp * zcwcae(ib) )
5971             zwsatae(ib) = acth2o( paero(ib), zcwintae(ib) ) * zkelvin(ib)
5972          ENDDO
5973       ENDIF
5974       zcwintae(nstr:nbins_aerosol) = MAX( zcwintae(nstr:nbins_aerosol), 0.0_wp )
5975!
5976!--    Update vapour concentration for consistency
5977       zcwint = zcwtot - SUM( zcwintae(1:nbins_aerosol) )
5978!
5979!--    Update "old" values for next cycle
5980       zcwcae = zcwintae
5981
5982       ttot = ttot + adt
5983
5984    ENDDO   ! ADT
5985
5986    zcwn      = zcwint
5987    zcwnae(:) = zcwintae(:)
5988    pcw       = zcwn * amh2o / rhoair
5989    paero(:)%volc(8) = MAX( 0.0_wp, zcwnae(:) * amh2o / arhoh2o )
5990
5991 END SUBROUTINE gpparth2o
5992
5993!------------------------------------------------------------------------------!
5994! Description:
5995! ------------
5996!> Calculates the activity coefficient of liquid water
5997!------------------------------------------------------------------------------!
5998 REAL(wp) FUNCTION acth2o( ppart, pcw )
5999
6000    IMPLICIT NONE
6001
6002    REAL(wp) ::  zns  !< molar concentration of solutes (mol/m3)
6003    REAL(wp) ::  znw  !< molar concentration of water (mol/m3)
6004
6005    REAL(wp), INTENT(in), OPTIONAL ::  pcw !< molar concentration of water (mol/m3)
6006
6007    TYPE(t_section), INTENT(in) ::  ppart !< Aerosol properties of a bin
6008
6009    zns = ( 3.0_wp * ( ppart%volc(1) * arhoh2so4 / amh2so4 ) + ( ppart%volc(2) * arhooc / amoc ) + &
6010            2.0_wp * ( ppart%volc(5) * arhoss / amss ) + ( ppart%volc(6) * arhohno3 / amhno3 ) +   &
6011            ( ppart%volc(7) * arhonh3 / amnh3 ) )
6012
6013    IF ( PRESENT(pcw) ) THEN
6014       znw = pcw
6015    ELSE
6016       znw = ppart%volc(8) * arhoh2o / amh2o
6017    ENDIF
6018!
6019!-- Activity = partial pressure of water vapour / sat. vapour pressure of water over a liquid surface
6020!--          = molality * activity coefficient (Jacobson, 2005: eq. 17.20-21)
6021!-- Assume activity coefficient of 1 for water
6022    acth2o = MAX( 0.1_wp, znw / MAX( EPSILON( 1.0_wp ),( znw + zns ) ) )
6023
6024 END FUNCTION acth2o
6025
6026!------------------------------------------------------------------------------!
6027! Description:
6028! ------------
6029!> Calculates the dissolutional growth of particles (i.e. gas transfers to a
6030!> particle surface and dissolves in liquid water on the surface). Treated here
6031!> as a non-equilibrium (time-dependent) process. Gases: HNO3 and NH3
6032!> (Chapter 17.14 in Jacobson, 2005).
6033!
6034!> Called from subroutine condensation.
6035!> Coded by:
6036!> Harri Kokkola (FMI)
6037!------------------------------------------------------------------------------!
6038 SUBROUTINE gpparthno3( ppres, ptemp, paero, pghno3, pgnh3, pcw, pcs, pbeta, ptstep )
6039
6040    IMPLICIT NONE
6041
6042    INTEGER(iwp) ::  ib  !< loop index
6043
6044    REAL(wp) ::  adt          !< timestep
6045    REAL(wp) ::  zc_nh3_c     !< Current NH3 gas concentration
6046    REAL(wp) ::  zc_nh3_int   !< Intermediate NH3 gas concentration
6047    REAL(wp) ::  zc_nh3_n     !< New NH3 gas concentration
6048    REAL(wp) ::  zc_nh3_tot   !< Total NH3 concentration
6049    REAL(wp) ::  zc_hno3_c    !< Current HNO3 gas concentration
6050    REAL(wp) ::  zc_hno3_int  !< Intermediate HNO3 gas concentration
6051    REAL(wp) ::  zc_hno3_n    !< New HNO3 gas concentration
6052    REAL(wp) ::  zc_hno3_tot  !< Total HNO3 concentration
6053    REAL(wp) ::  zdfvap       !< Diffusion coefficient for vapors
6054    REAL(wp) ::  zhlp1        !< intermediate variable
6055    REAL(wp) ::  zhlp2        !< intermediate variable
6056    REAL(wp) ::  zrh          !< relative humidity
6057
6058    REAL(wp), INTENT(in) ::  ppres      !< ambient pressure (Pa)
6059    REAL(wp), INTENT(in) ::  pcs        !< water vapour saturation
6060                                        !< concentration (kg/m3)
6061    REAL(wp), INTENT(in) ::  ptemp      !< ambient temperature (K)
6062    REAL(wp), INTENT(in) ::  ptstep     !< time step (s)
6063
6064    REAL(wp), INTENT(inout) ::  pghno3  !< nitric acid concentration (#/m3)
6065    REAL(wp), INTENT(inout) ::  pgnh3   !< ammonia conc. (#/m3)
6066    REAL(wp), INTENT(inout) ::  pcw     !< water vapour concentration (kg/m3)
6067
6068    REAL(wp), DIMENSION(nbins_aerosol) ::  zac_hno3_ae     !< Activity coefficients for HNO3
6069    REAL(wp), DIMENSION(nbins_aerosol) ::  zac_hhso4_ae    !< Activity coefficients for HHSO4
6070    REAL(wp), DIMENSION(nbins_aerosol) ::  zac_nh3_ae      !< Activity coefficients for NH3
6071    REAL(wp), DIMENSION(nbins_aerosol) ::  zac_nh4hso2_ae  !< Activity coefficients for NH4HSO2
6072    REAL(wp), DIMENSION(nbins_aerosol) ::  zcg_hno3_eq_ae  !< Equilibrium gas concentration: HNO3
6073    REAL(wp), DIMENSION(nbins_aerosol) ::  zcg_nh3_eq_ae   !< Equilibrium gas concentration: NH3
6074    REAL(wp), DIMENSION(nbins_aerosol) ::  zc_hno3_int_ae  !< Intermediate HNO3 aerosol concentration
6075    REAL(wp), DIMENSION(nbins_aerosol) ::  zc_hno3_c_ae    !< Current HNO3 in aerosols
6076    REAL(wp), DIMENSION(nbins_aerosol) ::  zc_hno3_n_ae    !< New HNO3 in aerosols
6077    REAL(wp), DIMENSION(nbins_aerosol) ::  zc_nh3_int_ae   !< Intermediate NH3 aerosol concentration
6078    REAL(wp), DIMENSION(nbins_aerosol) ::  zc_nh3_c_ae     !< Current NH3 in aerosols
6079    REAL(wp), DIMENSION(nbins_aerosol) ::  zc_nh3_n_ae     !< New NH3 in aerosols
6080    REAL(wp), DIMENSION(nbins_aerosol) ::  zkel_hno3_ae    !< Kelvin effect for HNO3
6081    REAL(wp), DIMENSION(nbins_aerosol) ::  zkel_nh3_ae     !< Kelvin effects for NH3
6082    REAL(wp), DIMENSION(nbins_aerosol) ::  zmt_hno3_ae     !< Mass transfer coefficients for HNO3
6083    REAL(wp), DIMENSION(nbins_aerosol) ::  zmt_nh3_ae      !< Mass transfer coefficients for NH3
6084    REAL(wp), DIMENSION(nbins_aerosol) ::  zsat_hno3_ae    !< HNO3 saturation ratio over a surface
6085    REAL(wp), DIMENSION(nbins_aerosol) ::  zsat_nh3_ae     !< NH3 saturation ratio over a surface
6086
6087    REAL(wp), DIMENSION(nbins_aerosol,maxspec) ::  zion_mols   !< Ion molalities from pdfite aerosols
6088
6089    REAL(wp), DIMENSION(nbins_aerosol), INTENT(in) ::  pbeta !< transitional correction factor for
6090
6091    TYPE(t_section), DIMENSION(nbins_aerosol), INTENT(inout) ::  paero !< Aerosol properties
6092!
6093!-- Initialise:
6094    adt            = ptstep
6095    zac_hhso4_ae   = 0.0_wp
6096    zac_nh3_ae     = 0.0_wp
6097    zac_nh4hso2_ae = 0.0_wp
6098    zac_hno3_ae    = 0.0_wp
6099    zcg_nh3_eq_ae  = 0.0_wp
6100    zcg_hno3_eq_ae = 0.0_wp
6101    zion_mols      = 0.0_wp
6102    zsat_nh3_ae    = 1.0_wp
6103    zsat_hno3_ae   = 1.0_wp
6104!
6105!-- Diffusion coefficient (m2/s)
6106    zdfvap = 5.1111E-10_wp * ptemp**1.75_wp * ( p_0 + 1325.0_wp ) / ppres
6107!
6108!-- Kelvin effects (Jacobson (2005), eq. 16.33)
6109    zkel_hno3_ae(1:nbins_aerosol) = EXP( 4.0_wp * surfw0 * amvhno3 /                               &
6110                                    ( abo * ptemp * paero(1:nbins_aerosol)%dwet ) )
6111    zkel_nh3_ae(1:nbins_aerosol) = EXP( 4.0_wp * surfw0 * amvnh3 /                                 &
6112                                   ( abo * ptemp * paero(1:nbins_aerosol)%dwet ) )
6113!
6114!-- Current vapour mole concentrations (mol/m3)
6115    zc_hno3_c = pghno3 / avo  ! HNO3
6116    zc_nh3_c = pgnh3 / avo   ! NH3
6117!
6118!-- Current particle mole concentrations (mol/m3)
6119    zc_hno3_c_ae(1:nbins_aerosol) = paero(1:nbins_aerosol)%volc(6) * arhohno3 / amhno3
6120    zc_nh3_c_ae(1:nbins_aerosol) = paero(1:nbins_aerosol)%volc(7) * arhonh3 / amnh3
6121!
6122!-- Total mole concentrations: gas and particle phase
6123    zc_hno3_tot = zc_hno3_c + SUM( zc_hno3_c_ae(1:nbins_aerosol) )
6124    zc_nh3_tot = zc_nh3_c + SUM( zc_nh3_c_ae(1:nbins_aerosol) )
6125!
6126!-- Relative humidity [0-1]
6127    zrh = pcw / pcs
6128!
6129!-- Mass transfer coefficients (Jacobson, Eq. 16.64)
6130    zmt_hno3_ae(:) = 2.0_wp * pi * paero(:)%dwet * zdfvap * paero(:)%numc * pbeta(:)
6131    zmt_nh3_ae(:)  = 2.0_wp * pi * paero(:)%dwet * zdfvap * paero(:)%numc * pbeta(:)
6132
6133!
6134!-- Get the equilibrium concentrations above aerosols
6135    CALL nitrate_ammonium_equilibrium( zrh, ptemp, paero, zcg_hno3_eq_ae, zcg_nh3_eq_ae,           &
6136                                       zac_hno3_ae, zac_nh3_ae, zac_nh4hso2_ae, zac_hhso4_ae,      &
6137                                       zion_mols )
6138!
6139!-- Calculate NH3 and HNO3 saturation ratios for aerosols
6140    CALL nitrate_ammonium_saturation( ptemp, paero, zac_hno3_ae, zac_nh4hso2_ae, zac_hhso4_ae,     &
6141                                      zcg_hno3_eq_ae, zc_hno3_c_ae, zc_nh3_c_ae, zkel_hno3_ae,     &
6142                                      zkel_nh3_ae, zsat_hno3_ae, zsat_nh3_ae )
6143!
6144!-- Intermediate gas concentrations of HNO3 and NH3
6145    zhlp1 = SUM( zc_hno3_c_ae(:) / ( 1.0_wp + adt * zmt_hno3_ae(:) * zsat_hno3_ae(:) ) )
6146    zhlp2 = SUM( zmt_hno3_ae(:) / ( 1.0_wp + adt * zmt_hno3_ae(:) * zsat_hno3_ae(:) ) )
6147    zc_hno3_int = ( zc_hno3_tot - zhlp1 ) / ( 1.0_wp + adt * zhlp2 )
6148
6149    zhlp1 = SUM( zc_nh3_c_ae(:) / ( 1.0_wp + adt * zmt_nh3_ae(:) * zsat_nh3_ae(:) ) )
6150    zhlp2 = SUM( zmt_nh3_ae(:) / ( 1.0_wp + adt * zmt_nh3_ae(:) * zsat_nh3_ae(:) ) )
6151    zc_nh3_int = ( zc_nh3_tot - zhlp1 )/( 1.0_wp + adt * zhlp2 )
6152
6153    zc_hno3_int = MIN( zc_hno3_int, zc_hno3_tot )
6154    zc_nh3_int = MIN( zc_nh3_int, zc_nh3_tot )
6155!
6156!-- Calculate the new concentration on aerosol particles
6157    zc_hno3_int_ae = zc_hno3_c_ae
6158    zc_nh3_int_ae = zc_nh3_c_ae
6159    DO  ib = 1, nbins_aerosol
6160       zc_hno3_int_ae(ib) = ( zc_hno3_c_ae(ib) + adt * zmt_hno3_ae(ib) * zc_hno3_int ) /           &
6161                            ( 1.0_wp + adt * zmt_hno3_ae(ib) * zsat_hno3_ae(ib) )
6162       zc_nh3_int_ae(ib) = ( zc_nh3_c_ae(ib) + adt * zmt_nh3_ae(ib) * zc_nh3_int ) /               &
6163                           ( 1.0_wp + adt * zmt_nh3_ae(ib) * zsat_nh3_ae(ib) )
6164    ENDDO
6165
6166    zc_hno3_int_ae(:) = MAX( zc_hno3_int_ae(:), 0.0_wp )
6167    zc_nh3_int_ae(:) = MAX( zc_nh3_int_ae(:), 0.0_wp )
6168!
6169!-- Final molar gas concentration and molar particle concentration of HNO3
6170    zc_hno3_n   = zc_hno3_int
6171    zc_hno3_n_ae = zc_hno3_int_ae
6172!
6173!-- Final molar gas concentration and molar particle concentration of NH3
6174    zc_nh3_n   = zc_nh3_int
6175    zc_nh3_n_ae = zc_nh3_int_ae
6176!
6177!-- Model timestep reached - update the gas concentrations
6178    pghno3 = zc_hno3_n * avo
6179    pgnh3  = zc_nh3_n * avo
6180!
6181!-- Update the particle concentrations
6182    DO  ib = start_subrange_1a, end_subrange_2b
6183       paero(ib)%volc(6) = zc_hno3_n_ae(ib) * amhno3 / arhohno3
6184       paero(ib)%volc(7) = zc_nh3_n_ae(ib) * amnh3 / arhonh3
6185    ENDDO
6186
6187 END SUBROUTINE gpparthno3
6188!------------------------------------------------------------------------------!
6189! Description:
6190! ------------
6191!> Calculate the equilibrium concentrations above aerosols (reference?)
6192!------------------------------------------------------------------------------!
6193 SUBROUTINE nitrate_ammonium_equilibrium( prh, ptemp, ppart, pcg_hno3_eq, pcg_nh3_eq, pgamma_hno3, &
6194                                          pgamma_nh4, pgamma_nh4hso2, pgamma_hhso4, pmols )
6195
6196    IMPLICIT NONE
6197
6198    INTEGER(iwp) ::  ib  !< loop index: aerosol bins
6199
6200    REAL(wp) ::  zhlp         !< intermediate variable
6201    REAL(wp) ::  zp_hcl       !< Equilibrium vapor pressures (Pa) of HCl
6202    REAL(wp) ::  zp_hno3      !< Equilibrium vapor pressures (Pa) of HNO3
6203    REAL(wp) ::  zp_nh3       !< Equilibrium vapor pressures (Pa) of NH3
6204    REAL(wp) ::  zwatertotal  !< Total water in particles (mol/m3)
6205
6206    REAL(wp), INTENT(in) ::  prh    !< relative humidity
6207    REAL(wp), INTENT(in) ::  ptemp  !< ambient temperature (K)
6208
6209    REAL(wp), DIMENSION(maxspec) ::  zgammas  !< Activity coefficients
6210    REAL(wp), DIMENSION(maxspec) ::  zions    !< molar concentration of ion (mol/m3)
6211
6212    REAL(wp), DIMENSION(nbins_aerosol), INTENT(inout) ::  pcg_nh3_eq      !< equilibrium molar
6213                                                                          !< concentration: of NH3
6214    REAL(wp), DIMENSION(nbins_aerosol), INTENT(inout) ::  pcg_hno3_eq     !< of HNO3
6215    REAL(wp), DIMENSION(nbins_aerosol), INTENT(inout) ::  pgamma_hhso4    !< activity coeff. of HHSO4
6216    REAL(wp), DIMENSION(nbins_aerosol), INTENT(inout) ::  pgamma_nh4      !< activity coeff. of NH3
6217    REAL(wp), DIMENSION(nbins_aerosol), INTENT(inout) ::  pgamma_nh4hso2  !< activity coeff. of NH4HSO2
6218    REAL(wp), DIMENSION(nbins_aerosol), INTENT(inout) ::  pgamma_hno3     !< activity coeff. of HNO3
6219
6220    REAL(wp), DIMENSION(nbins_aerosol,maxspec), INTENT(inout) ::  pmols  !< Ion molalities
6221
6222    TYPE(t_section), DIMENSION(nbins_aerosol), INTENT(inout) ::  ppart  !< Aerosol properties
6223
6224    zgammas     = 0.0_wp
6225    zhlp        = 0.0_wp
6226    zions       = 0.0_wp
6227    zp_hcl      = 0.0_wp
6228    zp_hno3     = 0.0_wp
6229    zp_nh3      = 0.0_wp
6230    zwatertotal = 0.0_wp
6231
6232    DO  ib = 1, nbins_aerosol
6233
6234       IF ( ppart(ib)%numc < nclim )  CYCLE
6235!
6236!--    Ion molar concentrations: 2*H2SO4 + CL + NO3 - Na - NH4
6237       zhlp = 2.0_wp * ppart(ib)%volc(1) * arhoh2so4 / amh2so4 + ppart(ib)%volc(5) * arhoss / amss &
6238              + ppart(ib)%volc(6) * arhohno3 / amhno3 - ppart(ib)%volc(5) * arhoss / amss -        &
6239              ppart(ib)%volc(7) * arhonh3 / amnh3
6240
6241       zions(1) = zhlp                                   ! H+
6242       zions(2) = ppart(ib)%volc(7) * arhonh3 / amnh3     ! NH4+
6243       zions(3) = ppart(ib)%volc(5) * arhoss / amss       ! Na+
6244       zions(4) = ppart(ib)%volc(1) * arhoh2so4 / amh2so4 ! SO4(2-)
6245       zions(5) = 0.0_wp                                 ! HSO4-
6246       zions(6) = ppart(ib)%volc(6) * arhohno3 / amhno3   ! NO3-
6247       zions(7) = ppart(ib)%volc(5) * arhoss / amss       ! Cl-
6248
6249       zwatertotal = ppart(ib)%volc(8) * arhoh2o / amh2o
6250       IF ( zwatertotal > 1.0E-30_wp )  THEN
6251          CALL inorganic_pdfite( prh, ptemp, zions, zwatertotal, zp_hno3, zp_hcl, zp_nh3, zgammas, &
6252                                 pmols(ib,:) )
6253       ENDIF
6254!
6255!--    Activity coefficients
6256       pgamma_hno3(ib)    = zgammas(1)  ! HNO3
6257       pgamma_nh4(ib)     = zgammas(3)  ! NH3
6258       pgamma_nh4hso2(ib) = zgammas(6)  ! NH4HSO2
6259       pgamma_hhso4(ib)   = zgammas(7)  ! HHSO4
6260!
6261!--    Equilibrium molar concentrations (mol/m3) from equlibrium pressures (Pa)
6262       pcg_hno3_eq(ib) = zp_hno3 / ( argas * ptemp )
6263       pcg_nh3_eq(ib) = zp_nh3 / ( argas * ptemp )
6264
6265    ENDDO
6266
6267  END SUBROUTINE nitrate_ammonium_equilibrium
6268
6269!------------------------------------------------------------------------------!
6270! Description:
6271! ------------
6272!> Calculate saturation ratios of NH4 and HNO3 for aerosols
6273!------------------------------------------------------------------------------!
6274 SUBROUTINE nitrate_ammonium_saturation( ptemp, ppart, pachno3, pacnh4hso2, pachhso4, pchno3eq,    &
6275                                         pchno3, pc_nh3, pkelhno3, pkelnh3, psathno3, psatnh3 )
6276
6277    IMPLICIT NONE
6278
6279    INTEGER(iwp) :: ib   !< running index for aerosol bins
6280
6281    REAL(wp) ::  k_ll_h2o   !< equilibrium constants of equilibrium reactions:
6282                            !< H2O(aq) <--> H+ + OH- (mol/kg)
6283    REAL(wp) ::  k_ll_nh3   !< NH3(aq) + H2O(aq) <--> NH4+ + OH- (mol/kg)
6284    REAL(wp) ::  k_gl_nh3   !< NH3(g) <--> NH3(aq) (mol/kg/atm)
6285    REAL(wp) ::  k_gl_hno3  !< HNO3(g) <--> H+ + NO3- (mol2/kg2/atm)
6286    REAL(wp) ::  zmol_no3   !< molality of NO3- (mol/kg)
6287    REAL(wp) ::  zmol_h     !< molality of H+ (mol/kg)
6288    REAL(wp) ::  zmol_so4   !< molality of SO4(2-) (mol/kg)
6289    REAL(wp) ::  zmol_cl    !< molality of Cl- (mol/kg)
6290    REAL(wp) ::  zmol_nh4   !< molality of NH4+ (mol/kg)
6291    REAL(wp) ::  zmol_na    !< molality of Na+ (mol/kg)
6292    REAL(wp) ::  zhlp1      !< intermediate variable
6293    REAL(wp) ::  zhlp2      !< intermediate variable
6294    REAL(wp) ::  zhlp3      !< intermediate variable
6295    REAL(wp) ::  zxi        !< particle mole concentration ratio: (NH3+SS)/H2SO4
6296    REAL(wp) ::  zt0        !< reference temp
6297
6298    REAL(wp), PARAMETER ::  a1 = -22.52_wp     !<
6299    REAL(wp), PARAMETER ::  a2 = -1.50_wp      !<
6300    REAL(wp), PARAMETER ::  a3 = 13.79_wp      !<
6301    REAL(wp), PARAMETER ::  a4 = 29.17_wp      !<
6302    REAL(wp), PARAMETER ::  b1 = 26.92_wp      !<
6303    REAL(wp), PARAMETER ::  b2 = 26.92_wp      !<
6304    REAL(wp), PARAMETER ::  b3 = -5.39_wp      !<
6305    REAL(wp), PARAMETER ::  b4 = 16.84_wp      !<
6306    REAL(wp), PARAMETER ::  K01 = 1.01E-14_wp  !<
6307    REAL(wp), PARAMETER ::  K02 = 1.81E-5_wp   !<
6308    REAL(wp), PARAMETER ::  K03 = 57.64_wp     !<
6309    REAL(wp), PARAMETER ::  K04 = 2.51E+6_wp   !<
6310
6311    REAL(wp), INTENT(in) ::  ptemp  !< ambient temperature (K)
6312
6313    REAL(wp), DIMENSION(nbins_aerosol), INTENT(in) ::  pachhso4    !< activity coeff. of HHSO4
6314    REAL(wp), DIMENSION(nbins_aerosol), INTENT(in) ::  pacnh4hso2  !< activity coeff. of NH4HSO2
6315    REAL(wp), DIMENSION(nbins_aerosol), INTENT(in) ::  pachno3     !< activity coeff. of HNO3
6316    REAL(wp), DIMENSION(nbins_aerosol), INTENT(in) ::  pchno3eq    !< eq. surface concentration: HNO3
6317    REAL(wp), DIMENSION(nbins_aerosol), INTENT(in) ::  pchno3      !< current particle mole
6318                                                                   !< concentration of HNO3 (mol/m3)
6319    REAL(wp), DIMENSION(nbins_aerosol), INTENT(in) ::  pc_nh3      !< of NH3 (mol/m3)
6320    REAL(wp), DIMENSION(nbins_aerosol), INTENT(in) ::  pkelhno3    !< Kelvin effect for HNO3
6321    REAL(wp), DIMENSION(nbins_aerosol), INTENT(in) ::  pkelnh3     !< Kelvin effect for NH3
6322
6323    REAL(wp), DIMENSION(nbins_aerosol), INTENT(out) ::  psathno3 !< saturation ratio of HNO3
6324    REAL(wp), DIMENSION(nbins_aerosol), INTENT(out) ::  psatnh3  !< saturation ratio of NH3
6325
6326    TYPE(t_section), DIMENSION(nbins_aerosol), INTENT(inout) ::  ppart  !< Aerosol properties
6327
6328    zmol_cl  = 0.0_wp
6329    zmol_h   = 0.0_wp
6330    zmol_na  = 0.0_wp
6331    zmol_nh4 = 0.0_wp
6332    zmol_no3 = 0.0_wp
6333    zmol_so4 = 0.0_wp
6334    zt0      = 298.15_wp
6335    zxi      = 0.0_wp
6336!
6337!-- Calculates equlibrium rate constants based on Table B.7 in Jacobson (2005):
6338!-- K^ll_H20, K^ll_NH3, K^gl_NH3, K^gl_HNO3
6339    zhlp1 = zt0 / ptemp
6340    zhlp2 = zhlp1 - 1.0_wp
6341    zhlp3 = 1.0_wp + LOG( zhlp1 ) - zhlp1
6342
6343    k_ll_h2o  = K01 * EXP( a1 * zhlp2 + b1 * zhlp3 )
6344    k_ll_nh3  = K02 * EXP( a2 * zhlp2 + b2 * zhlp3 )
6345    k_gl_nh3  = K03 * EXP( a3 * zhlp2 + b3 * zhlp3 )
6346    k_gl_hno3 = K04 * EXP( a4 * zhlp2 + b4 * zhlp3 )
6347
6348    DO  ib = 1, nbins_aerosol
6349
6350       IF ( ppart(ib)%numc > nclim  .AND.  ppart(ib)%volc(8) > 1.0E-30_wp  )  THEN
6351!
6352!--       Molality of H+ and NO3-
6353          zhlp1 = pc_nh3(ib) * amnh3 + ppart(ib)%volc(1) * arhoh2so4 + ppart(ib)%volc(2) * arhooc  &
6354                  + ppart(ib)%volc(5) * arhoss + ppart(ib)%volc(8) * arhoh2o
6355          zmol_no3 = pchno3(ib) / zhlp1  !< mol/kg
6356!
6357!--       Particle mole concentration ratio: (NH3+SS)/H2SO4
6358          zxi = ( pc_nh3(ib) + ppart(ib)%volc(5) * arhoss / amss ) / ( ppart(ib)%volc(1) *         &
6359                  arhoh2so4 / amh2so4 )
6360
6361          IF ( zxi <= 2.0_wp )  THEN
6362!
6363!--          Molality of SO4(2-)
6364             zhlp1 = pc_nh3(ib) * amnh3 + pchno3(ib) * amhno3 + ppart(ib)%volc(2) * arhooc +       &
6365                     ppart(ib)%volc(5) * arhoss + ppart(ib)%volc(8) * arhoh2o
6366             zmol_so4 = ( ppart(ib)%volc(1) * arhoh2so4 / amh2so4 ) / zhlp1
6367!
6368!--          Molality of Cl-
6369             zhlp1 = pc_nh3(ib) * amnh3 + pchno3(ib) * amhno3 + ppart(ib)%volc(2) * arhooc +       &
6370                     ppart(ib)%volc(1) * arhoh2so4 + ppart(ib)%volc(8) * arhoh2o
6371             zmol_cl = ( ppart(ib)%volc(5) * arhoss / amss ) / zhlp1
6372!
6373!--          Molality of NH4+
6374             zhlp1 =  pchno3(ib) * amhno3 + ppart(ib)%volc(1) * arhoh2so4 + ppart(ib)%volc(2) *    &
6375                      arhooc + ppart(ib)%volc(5) * arhoss + ppart(ib)%volc(8) * arhoh2o
6376             zmol_nh4 = pc_nh3(ib) / zhlp1
6377!
6378!--          Molality of Na+
6379             zmol_na = zmol_cl
6380!
6381!--          Molality of H+
6382             zmol_h = 2.0_wp * zmol_so4 + zmol_no3 + zmol_cl - ( zmol_nh4 + zmol_na )
6383
6384          ELSE
6385
6386             zhlp2 = pkelhno3(ib) * zmol_no3 * pachno3(ib)**2
6387
6388             IF ( zhlp2 > 1.0E-30_wp )  THEN
6389                zmol_h = k_gl_hno3 * pchno3eq(ib) / zhlp2 ! Eq. 17.38
6390             ELSE
6391                zmol_h = 0.0_wp
6392             ENDIF
6393
6394          ENDIF
6395
6396          zhlp1 = ppart(ib)%volc(8) * arhoh2o * argas * ptemp * k_gl_hno3
6397!
6398!--       Saturation ratio for NH3 and for HNO3
6399          IF ( zmol_h > 0.0_wp )  THEN
6400             zhlp2 = pkelnh3(ib) / ( zhlp1 * zmol_h )
6401             zhlp3 = k_ll_h2o / ( k_ll_nh3 + k_gl_nh3 )
6402             psatnh3(ib) = zhlp2 * ( ( pacnh4hso2(ib) / pachhso4(ib) )**2 ) * zhlp3
6403             psathno3(ib) = ( pkelhno3(ib) * zmol_h * pachno3(ib)**2 ) / zhlp1
6404          ELSE
6405             psatnh3(ib) = 1.0_wp
6406             psathno3(ib) = 1.0_wp
6407          ENDIF
6408       ELSE
6409          psatnh3(ib) = 1.0_wp
6410          psathno3(ib) = 1.0_wp
6411       ENDIF
6412
6413    ENDDO
6414
6415  END SUBROUTINE nitrate_ammonium_saturation
6416
6417!------------------------------------------------------------------------------!
6418! Description:
6419! ------------
6420!> Prototype module for calculating the water content of a mixed inorganic/
6421!> organic particle + equilibrium water vapour pressure above the solution
6422!> (HNO3, HCL, NH3 and representative organic compounds. Efficient calculation
6423!> of the partitioning of species between gas and aerosol. Based in a chamber
6424!> study.
6425!
6426!> Written by Dave Topping. Pure organic component properties predicted by Mark
6427!> Barley based on VOCs predicted in MCM simulations performed by Mike Jenkin.
6428!> Delivered by Gordon McFiggans as Deliverable D22 from WP1.4 in the EU FP6
6429!> EUCAARI Integrated Project.
6430!
6431!> REFERENCES
6432!> Clegg et al. (1998) A Thermodynamic Model of the System H+-NH4+-Na+-SO42- -NO3--Cl--H2O at
6433!>    298.15 K, J. Phys. Chem., 102A, 2155-2171.
6434!> Clegg et al. (2001) Thermodynamic modelling of aqueous aerosols containing electrolytes and
6435!>    dissolved organic compounds. Journal of Aerosol Science 2001;32(6):713-738.
6436!> Topping et al. (2005a) A curved multi-component aerosol hygroscopicity model framework: Part 1 -
6437!>    Inorganic compounds. Atmospheric Chemistry and Physics 2005;5:1205-1222.
6438!> Topping et al. (2005b) A curved multi-component aerosol hygroscopicity model framework: Part 2 -
6439!>    Including organic compounds. Atmospheric Chemistry and Physics 2005;5:1223-1242.
6440!> Wagman et al. (1982). The NBS tables of chemical thermodynamic properties: selected values for
6441!>    inorganic and C₁ and C₂ organic substances in SI units (book)
6442!> Zaveri et al. (2005). A new method for multicomponent activity coefficients of electrolytes in
6443!>    aqueous atmospheric aerosols, JGR, 110, D02201, 2005.
6444!
6445!> Queries concerning the use of this code through Gordon McFiggans,
6446!> g.mcfiggans@manchester.ac.uk,
6447!> Ownership: D. Topping, Centre for Atmospheric Sciences, University of
6448!> Manchester, 2007
6449!
6450!> Rewritten to PALM by Mona Kurppa, UHel, 2017
6451!------------------------------------------------------------------------------!
6452 SUBROUTINE inorganic_pdfite( rh, temp, ions, water_total, press_hno3, press_hcl, press_nh3,       &
6453                              gamma_out, mols_out )
6454
6455    IMPLICIT NONE
6456
6457    INTEGER(iwp) ::  binary_case
6458    INTEGER(iwp) ::  full_complexity
6459
6460    REAL(wp) ::  a                         !< auxiliary variable
6461    REAL(wp) ::  act_product               !< ionic activity coef. product:
6462                                           !< = (gamma_h2so4**3d0) / gamma_hhso4**2d0)
6463    REAL(wp) ::  ammonium_chloride         !<
6464    REAL(wp) ::  ammonium_chloride_eq_frac !<
6465    REAL(wp) ::  ammonium_nitrate          !<
6466    REAL(wp) ::  ammonium_nitrate_eq_frac  !<
6467    REAL(wp) ::  ammonium_sulphate         !<
6468    REAL(wp) ::  ammonium_sulphate_eq_frac !<
6469    REAL(wp) ::  b                         !< auxiliary variable
6470    REAL(wp) ::  binary_h2so4              !< binary H2SO4 activity coeff.
6471    REAL(wp) ::  binary_hcl                !< binary HCL activity coeff.
6472    REAL(wp) ::  binary_hhso4              !< binary HHSO4 activity coeff.
6473    REAL(wp) ::  binary_hno3               !< binary HNO3 activity coeff.
6474    REAL(wp) ::  binary_nh4hso4            !< binary NH4HSO4 activity coeff.
6475    REAL(wp) ::  c                         !< auxiliary variable
6476    REAL(wp) ::  charge_sum                !< sum of ionic charges
6477    REAL(wp) ::  gamma_h2so4               !< activity coefficient
6478    REAL(wp) ::  gamma_hcl                 !< activity coefficient
6479    REAL(wp) ::  gamma_hhso4               !< activity coeffient
6480    REAL(wp) ::  gamma_hno3                !< activity coefficient
6481    REAL(wp) ::  gamma_nh3                 !< activity coefficient
6482    REAL(wp) ::  gamma_nh4hso4             !< activity coefficient
6483    REAL(wp) ::  h_out                     !<
6484    REAL(wp) ::  h_real                    !< new hydrogen ion conc.
6485    REAL(wp) ::  h2so4_hcl                 !< contribution of H2SO4
6486    REAL(wp) ::  h2so4_hno3                !< contribution of H2SO4
6487    REAL(wp) ::  h2so4_nh3                 !< contribution of H2SO4
6488    REAL(wp) ::  h2so4_nh4hso4             !< contribution of H2SO4
6489    REAL(wp) ::  hcl_h2so4                 !< contribution of HCL
6490    REAL(wp) ::  hcl_hhso4                 !< contribution of HCL
6491    REAL(wp) ::  hcl_hno3                  !< contribution of HCL
6492    REAL(wp) ::  hcl_nh4hso4               !< contribution of HCL
6493    REAL(wp) ::  henrys_temp_dep           !< temperature dependence of Henry's Law
6494    REAL(wp) ::  hno3_h2so4                !< contribution of HNO3
6495    REAL(wp) ::  hno3_hcl                  !< contribution of HNO3
6496    REAL(wp) ::  hno3_hhso4                !< contribution of HNO3
6497    REAL(wp) ::  hno3_nh3                  !< contribution of HNO3
6498    REAL(wp) ::  hno3_nh4hso4              !< contribution of HNO3
6499    REAL(wp) ::  hso4_out                  !<
6500    REAL(wp) ::  hso4_real                 !< new bisulphate ion conc.
6501    REAL(wp) ::  hydrochloric_acid         !<
6502    REAL(wp) ::  hydrochloric_acid_eq_frac !<
6503    REAL(wp) ::  k_h                       !< equilibrium constant for H+
6504    REAL(wp) ::  k_hcl                     !< equilibrium constant of HCL
6505    REAL(wp) ::  k_hno3                    !< equilibrium constant of HNO3
6506    REAL(wp) ::  k_nh4                     !< equilibrium constant for NH4+
6507    REAL(wp) ::  k_h2o                     !< equil. const. for water_surface
6508    REAL(wp) ::  ln_h2so4_act              !< gamma_h2so4 = EXP(ln_h2so4_act)
6509    REAL(wp) ::  ln_HCL_act                !< gamma_hcl = EXP( ln_HCL_act )
6510    REAL(wp) ::  ln_hhso4_act              !< gamma_hhso4 = EXP(ln_hhso4_act)
6511    REAL(wp) ::  ln_hno3_act               !< gamma_hno3 = EXP( ln_hno3_act )
6512    REAL(wp) ::  ln_nh4hso4_act            !< gamma_nh4hso4 = EXP( ln_nh4hso4_act )
6513    REAL(wp) ::  molality_ratio_nh3        !< molality ratio of NH3 (NH4+ and H+)
6514    REAL(wp) ::  na2so4_h2so4              !< contribution of Na2SO4
6515    REAL(wp) ::  na2so4_hcl                !< contribution of Na2SO4
6516    REAL(wp) ::  na2so4_hhso4              !< contribution of Na2SO4
6517    REAL(wp) ::  na2so4_hno3               !< contribution of Na2SO4
6518    REAL(wp) ::  na2so4_nh3                !< contribution of Na2SO4
6519    REAL(wp) ::  na2so4_nh4hso4            !< contribution of Na2SO4
6520    REAL(wp) ::  nacl_h2so4                !< contribution of NaCl
6521    REAL(wp) ::  nacl_hcl                  !< contribution of NaCl
6522    REAL(wp) ::  nacl_hhso4                !< contribution of NaCl
6523    REAL(wp) ::  nacl_hno3                 !< contribution of NaCl
6524    REAL(wp) ::  nacl_nh3                  !< contribution of NaCl
6525    REAL(wp) ::  nacl_nh4hso4              !< contribution of NaCl
6526    REAL(wp) ::  nano3_h2so4               !< contribution of NaNO3
6527    REAL(wp) ::  nano3_hcl                 !< contribution of NaNO3
6528    REAL(wp) ::  nano3_hhso4               !< contribution of NaNO3
6529    REAL(wp) ::  nano3_hno3                !< contribution of NaNO3
6530    REAL(wp) ::  nano3_nh3                 !< contribution of NaNO3
6531    REAL(wp) ::  nano3_nh4hso4             !< contribution of NaNO3
6532    REAL(wp) ::  nh42so4_h2so4             !< contribution of NH42SO4
6533    REAL(wp) ::  nh42so4_hcl               !< contribution of NH42SO4
6534    REAL(wp) ::  nh42so4_hhso4             !< contribution of NH42SO4
6535    REAL(wp) ::  nh42so4_hno3              !< contribution of NH42SO4
6536    REAL(wp) ::  nh42so4_nh3               !< contribution of NH42SO4
6537    REAL(wp) ::  nh42so4_nh4hso4           !< contribution of NH42SO4
6538    REAL(wp) ::  nh4cl_h2so4               !< contribution of NH4Cl
6539    REAL(wp) ::  nh4cl_hcl                 !< contribution of NH4Cl
6540    REAL(wp) ::  nh4cl_hhso4               !< contribution of NH4Cl
6541    REAL(wp) ::  nh4cl_hno3                !< contribution of NH4Cl
6542    REAL(wp) ::  nh4cl_nh3                 !< contribution of NH4Cl
6543    REAL(wp) ::  nh4cl_nh4hso4             !< contribution of NH4Cl
6544    REAL(wp) ::  nh4no3_h2so4              !< contribution of NH4NO3
6545    REAL(wp) ::  nh4no3_hcl                !< contribution of NH4NO3
6546    REAL(wp) ::  nh4no3_hhso4              !< contribution of NH4NO3
6547    REAL(wp) ::  nh4no3_hno3               !< contribution of NH4NO3
6548    REAL(wp) ::  nh4no3_nh3                !< contribution of NH4NO3
6549    REAL(wp) ::  nh4no3_nh4hso4            !< contribution of NH4NO3
6550    REAL(wp) ::  nitric_acid               !<
6551    REAL(wp) ::  nitric_acid_eq_frac       !< Equivalent fractions
6552    REAL(wp) ::  press_hcl                 !< partial pressure of HCL
6553    REAL(wp) ::  press_hno3                !< partial pressure of HNO3
6554    REAL(wp) ::  press_nh3                 !< partial pressure of NH3
6555    REAL(wp) ::  rh                        !< relative humidity [0-1]
6556    REAL(wp) ::  root1                     !< auxiliary variable
6557    REAL(wp) ::  root2                     !< auxiliary variable
6558    REAL(wp) ::  so4_out                   !<
6559    REAL(wp) ::  so4_real                  !< new sulpate ion concentration
6560    REAL(wp) ::  sodium_chloride           !<
6561    REAL(wp) ::  sodium_chloride_eq_frac   !<
6562    REAL(wp) ::  sodium_nitrate            !<
6563    REAL(wp) ::  sodium_nitrate_eq_frac    !<
6564    REAL(wp) ::  sodium_sulphate           !<
6565    REAL(wp) ::  sodium_sulphate_eq_frac   !<
6566    REAL(wp) ::  solutes                   !<
6567    REAL(wp) ::  sulphuric_acid            !<
6568    REAL(wp) ::  sulphuric_acid_eq_frac    !<
6569    REAL(wp) ::  temp                      !< temperature
6570    REAL(wp) ::  water_total               !<
6571
6572    REAL(wp), DIMENSION(:) ::  gamma_out !< Activity coefficient for calculating the non-ideal
6573                                         !< dissociation constants
6574                                         !< 1: HNO3, 2: HCL, 3: NH4+/H+ (NH3), 4: HHSO4**2/H2SO4,
6575                                         !< 5: H2SO4**3/HHSO4**2, 6: NH4HSO2, 7: HHSO4
6576    REAL(wp), DIMENSION(:) ::  ions      !< ion molarities (mol/m3): 1: H+, 2: NH4+, 3: Na+,
6577                                         !< 4: SO4(2-), 5: HSO4-, 6: NO3-, 7: Cl-
6578    REAL(wp), DIMENSION(7) ::  ions_mol  !< ion molalities (mol/kg): 1: H+, 2: NH4+, 3: Na+,
6579                                         !< 4: SO4(2-), 5: HSO4-, 6: NO3-, 7: Cl-
6580    REAL(wp), DIMENSION(:) ::  mols_out  !< ion molality output (mol/kg): 1: H+, 2: NH4+, 3: Na+,
6581                                         !< 4: SO4(2-), 5: HSO4-, 6: NO3-, 7: Cl-
6582!
6583!-- Value initialisation
6584    binary_h2so4    = 0.0_wp
6585    binary_hcl      = 0.0_wp
6586    binary_hhso4    = 0.0_wp
6587    binary_hno3     = 0.0_wp
6588    binary_nh4hso4  = 0.0_wp
6589    henrys_temp_dep = ( 1.0_wp / temp - 0.0033557_wp ) ! 1/T - 1/298 K
6590    hcl_hno3        = 1.0_wp
6591    h2so4_hno3      = 1.0_wp
6592    nh42so4_hno3    = 1.0_wp
6593    nh4no3_hno3     = 1.0_wp
6594    nh4cl_hno3      = 1.0_wp
6595    na2so4_hno3     = 1.0_wp
6596    nano3_hno3      = 1.0_wp
6597    nacl_hno3       = 1.0_wp
6598    hno3_hcl        = 1.0_wp
6599    h2so4_hcl       = 1.0_wp
6600    nh42so4_hcl     = 1.0_wp
6601    nh4no3_hcl      = 1.0_wp
6602    nh4cl_hcl       = 1.0_wp
6603    na2so4_hcl      = 1.0_wp
6604    nano3_hcl       = 1.0_wp
6605    nacl_hcl        = 1.0_wp
6606    hno3_nh3        = 1.0_wp
6607    h2so4_nh3       = 1.0_wp
6608    nh42so4_nh3     = 1.0_wp
6609    nh4no3_nh3      = 1.0_wp
6610    nh4cl_nh3       = 1.0_wp
6611    na2so4_nh3      = 1.0_wp
6612    nano3_nh3       = 1.0_wp
6613    nacl_nh3        = 1.0_wp
6614    hno3_hhso4      = 1.0_wp
6615    hcl_hhso4       = 1.0_wp
6616    nh42so4_hhso4   = 1.0_wp
6617    nh4no3_hhso4    = 1.0_wp
6618    nh4cl_hhso4     = 1.0_wp
6619    na2so4_hhso4    = 1.0_wp
6620    nano3_hhso4     = 1.0_wp
6621    nacl_hhso4      = 1.0_wp
6622    hno3_h2so4      = 1.0_wp
6623    hcl_h2so4       = 1.0_wp
6624    nh42so4_h2so4   = 1.0_wp
6625    nh4no3_h2so4    = 1.0_wp
6626    nh4cl_h2so4     = 1.0_wp
6627    na2so4_h2so4    = 1.0_wp
6628    nano3_h2so4     = 1.0_wp
6629    nacl_h2so4      = 1.0_wp
6630!
6631!-- New NH3 variables
6632    hno3_nh4hso4    = 1.0_wp
6633    hcl_nh4hso4     = 1.0_wp
6634    h2so4_nh4hso4   = 1.0_wp
6635    nh42so4_nh4hso4 = 1.0_wp
6636    nh4no3_nh4hso4  = 1.0_wp
6637    nh4cl_nh4hso4   = 1.0_wp
6638    na2so4_nh4hso4  = 1.0_wp
6639    nano3_nh4hso4   = 1.0_wp
6640    nacl_nh4hso4    = 1.0_wp
6641!
6642!-- Juha Tonttila added
6643    mols_out   = 0.0_wp
6644    press_hno3 = 0.0_wp  !< Initialising vapour pressures over the
6645    press_hcl  = 0.0_wp  !< multicomponent particle
6646    press_nh3  = 0.0_wp
6647    gamma_out  = 1.0_wp  !< i.e. don't alter the ideal mixing ratios if there's nothing there.
6648!
6649!-- 1) - COMPOSITION DEFINITIONS
6650!
6651!-- a) Inorganic ion pairing:
6652!-- In order to calculate the water content, which is also used in calculating vapour pressures, one
6653!-- needs to pair the anions and cations for use in the ZSR mixing rule. The equation provided by
6654!-- Clegg et al. (2001) is used for ion pairing. The solutes chosen comprise of 9 inorganic salts
6655!-- and acids which provide a pairing between each anion and cation: (NH4)2SO4, NH4NO3, NH4Cl,
6656!-- Na2SO4, NaNO3, NaCl, H2SO4, HNO3, HCL. The organic compound is treated as a seperate solute.
6657!-- Ions: 1: H+, 2: NH4+, 3: Na+, 4: SO4(2-), 5: HSO4-, 6: NO3-, 7: Cl-
6658!
6659    charge_sum = ions(1) + ions(2) + ions(3) + 2.0_wp * ions(4) + ions(5) + ions(6) + ions(7)
6660    nitric_acid       = ( 2.0_wp * ions(1) * ions(6) ) / charge_sum
6661    hydrochloric_acid = ( 2.0_wp * ions(1) * ions(7) ) / charge_sum
6662    sulphuric_acid    = ( 2.0_wp * ions(1) * ions(4) ) / charge_sum
6663    ammonium_sulphate = ( 2.0_wp * ions(2) * ions(4) ) / charge_sum
6664    ammonium_nitrate  = ( 2.0_wp * ions(2) * ions(6) ) / charge_sum
6665    ammonium_chloride = ( 2.0_wp * ions(2) * ions(7) ) / charge_sum
6666    sodium_sulphate   = ( 2.0_wp * ions(3) * ions(4) ) / charge_sum
6667    sodium_nitrate    = ( 2.0_wp * ions(3) * ions(6) ) / charge_sum
6668    sodium_chloride   = ( 2.0_wp * ions(3) * ions(7) ) / charge_sum
6669    solutes = 0.0_wp
6670    solutes = 3.0_wp * sulphuric_acid    + 2.0_wp * hydrochloric_acid + 2.0_wp * nitric_acid +     &
6671              3.0_wp * ammonium_sulphate + 2.0_wp * ammonium_nitrate + 2.0_wp * ammonium_chloride +&
6672              3.0_wp * sodium_sulphate   + 2.0_wp * sodium_nitrate   + 2.0_wp * sodium_chloride
6673!
6674!-- b) Inorganic equivalent fractions:
6675!-- These values are calculated so that activity coefficients can be expressed by a linear additive
6676!-- rule, thus allowing more efficient calculations and future expansion (see more detailed
6677!-- description below)
6678    nitric_acid_eq_frac       = 2.0_wp * nitric_acid / solutes
6679    hydrochloric_acid_eq_frac = 2.0_wp * hydrochloric_acid / solutes
6680    sulphuric_acid_eq_frac    = 3.0_wp * sulphuric_acid / solutes
6681    ammonium_sulphate_eq_frac = 3.0_wp * ammonium_sulphate / solutes
6682    ammonium_nitrate_eq_frac  = 2.0_wp * ammonium_nitrate / solutes
6683    ammonium_chloride_eq_frac = 2.0_wp * ammonium_chloride / solutes
6684    sodium_sulphate_eq_frac   = 3.0_wp * sodium_sulphate / solutes
6685    sodium_nitrate_eq_frac    = 2.0_wp * sodium_nitrate / solutes
6686    sodium_chloride_eq_frac   = 2.0_wp * sodium_chloride / solutes
6687!
6688!-- Inorganic ion molalities
6689    ions_mol(1) = ions(1) / ( water_total * 18.01528E-3_wp )   ! H+
6690    ions_mol(2) = ions(2) / ( water_total * 18.01528E-3_wp )   ! NH4+
6691    ions_mol(3) = ions(3) / ( water_total * 18.01528E-3_wp )   ! Na+
6692    ions_mol(4) = ions(4) / ( water_total * 18.01528E-3_wp )   ! SO4(2-)
6693    ions_mol(5) = ions(5) / ( water_total * 18.01528E-3_wp )   ! HSO4(2-)
6694    ions_mol(6) = ions(6) / ( water_total * 18.01528E-3_wp )   !  NO3-
6695    ions_mol(7) = ions(7) / ( water_total * 18.01528E-3_wp )   ! Cl-
6696
6697!-- ***
6698!-- At this point we may need to introduce a method for prescribing H+ when there is no 'real' value
6699!-- for H+..i.e. in the sulphate poor domain. This will give a value for solve quadratic proposed by
6700!-- Zaveri et al. 2005
6701!
6702!-- 2) - WATER CALCULATION
6703!
6704!-- a) The water content is calculated using the ZSR rule with solute concentrations calculated
6705!-- using 1a above. Whilst the usual approximation of ZSR relies on binary data consisting of 5th or
6706!-- higher order polynomials, in this code 4 different RH regimes are used, each housing cubic
6707!-- equations for the water associated with each solute listed above. Binary water contents for
6708!-- inorganic components were calculated using AIM online (Clegg et al 1998). The water associated
6709!-- with the organic compound is calculated assuming ideality and that aw = RH.
6710!
6711!-- b) Molality of each inorganic ion and organic solute (initial input) is calculated for use in
6712!-- vapour pressure calculation.
6713!
6714!-- 3) - BISULPHATE ION DISSOCIATION CALCULATION
6715!
6716!-- The dissociation of the bisulphate ion is calculated explicitly. A solution to the equilibrium
6717!-- equation between the bisulphate ion, hydrogen ion and sulphate ion is found using tabulated
6718!-- equilibrium constants (referenced). It is necessary to calculate the activity coefficients of
6719!-- HHSO4 and H2SO4 in a non-iterative manner. These are calculated using the same format as
6720!-- described in 4) below, where both activity coefficients were fit to the output from ADDEM
6721!-- (Topping et al 2005a,b) covering an extensive composition space, providing the activity
6722!-- coefficients and bisulphate ion dissociation as a function of equivalent mole fractions and
6723!-- relative humidity.
6724!
6725!-- NOTE: the flags "binary_case" and "full_complexity" are not used in this prototype. They are
6726!-- used for simplification of the fit expressions when using limited composition regions. This
6727!-- section of code calculates the bisulphate ion concentration.
6728!
6729    IF ( ions(1) > 0.0_wp .AND. ions(4) > 0.0_wp ) THEN
6730!
6731!--    HHSO4:
6732       binary_case = 1
6733       IF ( rh > 0.1_wp  .AND.  rh < 0.9_wp )  THEN
6734          binary_hhso4 = -4.9521_wp * rh**3 + 9.2881_wp * rh**2 - 10.777_wp * rh + 6.0534_wp
6735       ELSEIF ( rh >= 0.9_wp  .AND.  rh < 0.955_wp )  THEN
6736          binary_hhso4 = -6.3777_wp * rh + 5.962_wp
6737       ELSEIF ( rh >= 0.955_wp  .AND.  rh < 0.99_wp )  THEN
6738          binary_hhso4 = 2367.2_wp * rh**3 - 6849.7_wp * rh**2 + 6600.9_wp * rh - 2118.7_wp
6739       ELSEIF ( rh >= 0.99_wp  .AND.  rh < 0.9999_wp )  THEN
6740          binary_hhso4 = 3E-7_wp * rh**5 - 2E-5_wp * rh**4 + 0.0004_wp * rh**3 - 0.0035_wp * rh**2 &
6741                         + 0.0123_wp * rh - 0.3025_wp
6742       ENDIF
6743
6744       IF ( nitric_acid > 0.0_wp )  THEN
6745          hno3_hhso4 = -4.2204_wp * rh**4 + 12.193_wp * rh**3 - 12.481_wp * rh**2 + 6.459_wp * rh  &
6746                       - 1.9004_wp
6747       ENDIF
6748
6749       IF ( hydrochloric_acid > 0.0_wp )  THEN
6750          hcl_hhso4 = -54.845_wp * rh**7 + 209.54_wp * rh**6 - 336.59_wp * rh**5 + 294.21_wp *     &
6751                      rh**4 - 150.07_wp * rh**3 + 43.767_wp * rh**2 - 6.5495_wp * rh + 0.60048_wp
6752       ENDIF
6753
6754       IF ( ammonium_sulphate > 0.0_wp )  THEN
6755          nh42so4_hhso4 = 16.768_wp * rh**3 - 28.75_wp * rh**2 + 20.011_wp * rh - 8.3206_wp
6756       ENDIF
6757
6758       IF ( ammonium_nitrate > 0.0_wp )  THEN
6759          nh4no3_hhso4 = -17.184_wp * rh**4 + 56.834_wp * rh**3 - 65.765_wp * rh**2 +              &
6760                         35.321_wp * rh - 9.252_wp
6761       ENDIF
6762
6763       IF (ammonium_chloride > 0.0_wp )  THEN
6764          IF ( rh < 0.2_wp .AND. rh >= 0.1_wp )  THEN
6765             nh4cl_hhso4 = 3.2809_wp * rh - 2.0637_wp
6766          ELSEIF ( rh >= 0.2_wp .AND. rh < 0.99_wp )  THEN
6767             nh4cl_hhso4 = -1.2981_wp * rh**3 + 4.7461_wp * rh**2 - 2.3269_wp * rh - 1.1259_wp
6768          ENDIF
6769       ENDIF
6770
6771       IF ( sodium_sulphate > 0.0_wp )  THEN
6772          na2so4_hhso4 = 118.87_wp * rh**6 - 358.63_wp * rh**5 + 435.85_wp * rh**4 - 272.88_wp *   &
6773                         rh**3 + 94.411_wp * rh**2 - 18.21_wp * rh + 0.45935_wp
6774       ENDIF
6775
6776       IF ( sodium_nitrate > 0.0_wp )  THEN
6777          IF ( rh < 0.2_wp  .AND.  rh >= 0.1_wp )  THEN
6778             nano3_hhso4 = 4.8456_wp * rh - 2.5773_wp
6779          ELSEIF ( rh >= 0.2_wp  .AND.  rh < 0.99_wp )  THEN
6780             nano3_hhso4 = 0.5964_wp * rh**3 - 0.38967_wp * rh**2 + 1.7918_wp * rh - 1.9691_wp
6781          ENDIF
6782       ENDIF
6783
6784       IF ( sodium_chloride > 0.0_wp )  THEN
6785          IF ( rh < 0.2_wp )  THEN
6786             nacl_hhso4 = 0.51995_wp * rh - 1.3981_wp
6787          ELSEIF ( rh >= 0.2_wp  .AND.  rh < 0.99_wp )  THEN
6788             nacl_hhso4 = 1.6539_wp * rh - 1.6101_wp
6789          ENDIF
6790       ENDIF
6791
6792       ln_hhso4_act = binary_hhso4 + nitric_acid_eq_frac * hno3_hhso4 +                            &
6793                      hydrochloric_acid_eq_frac * hcl_hhso4 +                                      &
6794                      ammonium_sulphate_eq_frac * nh42so4_hhso4 +                                  &
6795                      ammonium_nitrate_eq_frac  * nh4no3_hhso4 +                                   &
6796                      ammonium_chloride_eq_frac * nh4cl_hhso4 +                                    &
6797                      sodium_sulphate_eq_frac   * na2so4_hhso4 +                                   &
6798                      sodium_nitrate_eq_frac * nano3_hhso4 + sodium_chloride_eq_frac   * nacl_hhso4
6799
6800       gamma_hhso4 = EXP( ln_hhso4_act )   ! molal activity coefficient of HHSO4
6801
6802!--    H2SO4 (sulphuric acid):
6803       IF ( rh >= 0.1_wp  .AND.  rh < 0.9_wp )  THEN
6804          binary_h2so4 = 2.4493_wp * rh**2 - 6.2326_wp * rh + 2.1763_wp
6805       ELSEIF ( rh >= 0.9_wp  .AND.  rh < 0.98 )  THEN
6806          binary_h2so4 = 914.68_wp * rh**3 - 2502.3_wp * rh**2 + 2281.9_wp * rh - 695.11_wp
6807       ELSEIF ( rh >= 0.98  .AND.  rh < 0.9999 )  THEN
6808          binary_h2so4 = 3.0E-8_wp * rh**4 - 5E-6_wp * rh**3 + 0.0003_wp * rh**2 - 0.0022_wp *     &
6809                         rh - 1.1305_wp
6810       ENDIF
6811
6812       IF ( nitric_acid > 0.0_wp )  THEN
6813          hno3_h2so4 = - 16.382_wp * rh**5 + 46.677_wp * rh**4 - 54.149_wp * rh**3 + 34.36_wp *    &
6814                         rh**2 - 12.54_wp * rh + 2.1368_wp
6815       ENDIF
6816
6817       IF ( hydrochloric_acid > 0.0_wp )  THEN
6818          hcl_h2so4 = - 14.409_wp * rh**5 + 42.804_wp * rh**4 - 47.24_wp * rh**3 + 24.668_wp *     &
6819                        rh**2 - 5.8015_wp * rh + 0.084627_wp
6820       ENDIF
6821
6822       IF ( ammonium_sulphate > 0.0_wp )  THEN
6823          nh42so4_h2so4 = 66.71_wp * rh**5 - 187.5_wp * rh**4 + 210.57_wp * rh**3 - 121.04_wp *    &
6824                          rh**2 + 39.182_wp * rh - 8.0606_wp
6825       ENDIF
6826
6827       IF ( ammonium_nitrate > 0.0_wp )  THEN
6828          nh4no3_h2so4 = - 22.532_wp * rh**4 + 66.615_wp * rh**3 - 74.647_wp * rh**2 + 37.638_wp * &
6829                         rh - 6.9711_wp
6830       ENDIF
6831
6832       IF ( ammonium_chloride > 0.0_wp )  THEN
6833          IF ( rh >= 0.1_wp  .AND.  rh < 0.2_wp )  THEN
6834             nh4cl_h2so4 = - 0.32089_wp * rh + 0.57738_wp
6835          ELSEIF ( rh >= 0.2_wp  .AND.  rh < 0.9_wp )  THEN
6836             nh4cl_h2so4 = 18.089_wp * rh**5 - 51.083_wp * rh**4 + 50.32_wp * rh**3 - 17.012_wp *  &
6837                           rh**2 - 0.93435_wp * rh + 1.0548_wp
6838          ELSEIF ( rh >= 0.9_wp  .AND.  rh < 0.99_wp )  THEN
6839             nh4cl_h2so4 = - 1.5749_wp * rh + 1.7002_wp
6840          ENDIF
6841       ENDIF
6842
6843       IF ( sodium_sulphate > 0.0_wp )  THEN
6844          na2so4_h2so4 = 29.843_wp * rh**4 - 69.417_wp * rh**3 + 61.507_wp * rh**2 - 29.874_wp *   &
6845                         rh + 7.7556_wp
6846       ENDIF
6847
6848       IF ( sodium_nitrate > 0.0_wp )  THEN
6849          nano3_h2so4 = - 122.37_wp * rh**6 + 427.43_wp * rh**5 - 604.68_wp * rh**4 + 443.08_wp *  &
6850                        rh**3 - 178.61_wp * rh**2 + 37.242_wp * rh - 1.9564_wp
6851       ENDIF
6852
6853       IF ( sodium_chloride > 0.0_wp )  THEN
6854          nacl_h2so4 = - 40.288_wp * rh**5 + 115.61_wp * rh**4 - 129.99_wp * rh**3 + 72.652_wp *   &
6855                       rh**2 - 22.124_wp * rh + 4.2676_wp
6856       ENDIF
6857
6858       ln_h2so4_act = binary_h2so4 + nitric_acid_eq_frac * hno3_h2so4 +                            &
6859                      hydrochloric_acid_eq_frac * hcl_h2so4 +                                      &
6860                      ammonium_sulphate_eq_frac * nh42so4_h2so4 +                                  &
6861                      ammonium_nitrate_eq_frac  * nh4no3_h2so4 +                                   &
6862                      ammonium_chloride_eq_frac * nh4cl_h2so4 +                                    &
6863                      sodium_sulphate_eq_frac * na2so4_h2so4 +                                     &
6864                      sodium_nitrate_eq_frac * nano3_h2so4 + sodium_chloride_eq_frac * nacl_h2so4
6865
6866       gamma_h2so4 = EXP( ln_h2so4_act )    ! molal activity coefficient
6867!
6868!--    Export activity coefficients
6869       IF ( gamma_h2so4 > 1.0E-10_wp )  THEN
6870          gamma_out(4) = gamma_hhso4**2 / gamma_h2so4
6871       ENDIF
6872       IF ( gamma_hhso4 > 1.0E-10_wp )  THEN
6873          gamma_out(5) = gamma_h2so4**3 / gamma_hhso4**2
6874       ENDIF
6875!
6876!--    Ionic activity coefficient product
6877       act_product = gamma_h2so4**3 / gamma_hhso4**2
6878!
6879!--    Solve the quadratic equation (i.e. x in ax**2 + bx + c = 0)
6880       a = 1.0_wp
6881       b = -1.0_wp * ( ions(4) + ions(1) + ( ( water_total * 18.0E-3_wp ) /                        &
6882           ( 99.0_wp * act_product ) ) )
6883       c = ions(4) * ions(1)
6884       root1 = ( ( -1.0_wp * b ) + ( ( ( b**2 ) - 4.0_wp * a * c )**0.5_wp ) ) / ( 2.0_wp * a )
6885       root2 = ( ( -1.0_wp * b ) - ( ( ( b**2 ) - 4.0_wp * a * c) **0.5_wp ) ) / ( 2.0_wp * a )
6886
6887       IF ( root1 > ions(1)  .OR.  root1 < 0.0_wp )  THEN
6888          root1 = 0.0_wp
6889       ENDIF
6890
6891       IF ( root2 > ions(1)  .OR.  root2 < 0.0_wp )  THEN
6892          root2 = 0.0_wp
6893       ENDIF
6894!
6895!--    Calculate the new hydrogen ion, bisulphate ion and sulphate ion
6896!--    concentration
6897       h_real    = ions(1)
6898       so4_real  = ions(4)
6899       hso4_real = MAX( root1, root2 )
6900       h_real   = ions(1) - hso4_real
6901       so4_real = ions(4) - hso4_real
6902!
6903!--    Recalculate ion molalities
6904       ions_mol(1) = h_real    / ( water_total * 18.01528E-3_wp )   ! H+
6905       ions_mol(4) = so4_real  / ( water_total * 18.01528E-3_wp )   ! SO4(2-)
6906       ions_mol(5) = hso4_real / ( water_total * 18.01528E-3_wp )   ! HSO4(2-)
6907
6908       h_out    = h_real
6909       hso4_out = hso4_real
6910       so4_out  = so4_real
6911
6912    ELSE
6913       h_out    = ions(1)
6914       hso4_out = 0.0_wp
6915       so4_out  = ions(4)
6916    ENDIF
6917
6918!
6919!-- 4) ACTIVITY COEFFICIENTS -for vapour pressures of HNO3,HCL and NH3
6920!
6921!-- This section evaluates activity coefficients and vapour pressures using the water content
6922!-- calculated above) for each inorganic condensing species: a - HNO3, b - NH3, c - HCL.
6923!-- The following procedure is used: Zaveri et al (2005) found that one could express the variation
6924!-- of activity coefficients linearly in log-space if equivalent mole fractions were used.
6925!-- So, by a taylor series expansion LOG( activity coefficient ) =
6926!--    LOG( binary activity coefficient at a given RH ) +
6927!--    (equivalent mole fraction compound A) *
6928!--    ('interaction' parameter between A and condensing species) +
6929!--    equivalent mole fraction compound B) *
6930!--    ('interaction' parameter between B and condensing species).
6931!-- Here, the interaction parameters have been fit to ADDEM by searching the whole compositon space
6932!-- and fit usign the Levenberg-Marquardt non-linear least squares algorithm.
6933!
6934!-- They are given as a function of RH and vary with complexity ranging from linear to 5th order
6935!-- polynomial expressions, the binary activity coefficients were calculated using AIM online.
6936!-- NOTE: for NH3, no binary activity coefficient was used and the data were fit to the ratio of the
6937!-- activity coefficients for the ammonium and hydrogen ions. Once the activity coefficients are
6938!-- obtained the vapour pressure can be easily calculated using tabulated equilibrium constants
6939!-- (referenced). This procedure differs from that of Zaveri et al (2005) in that it is not assumed
6940!-- one can carry behaviour from binary mixtures in multicomponent systems. To this end we have fit
6941!-- the 'interaction' parameters explicitly to a general inorganic equilibrium model
6942!-- (ADDEM - Topping et al. 2005a,b). Such parameters take into account bisulphate ion dissociation
6943!-- and water content. This also allows us to consider one regime for all composition space, rather
6944!-- than defining sulphate rich and sulphate poor regimes.
6945!-- NOTE: The flags "binary_case" and "full_complexity" are not used in this prototype. They are
6946!-- used for simplification of the fit expressions when using limited composition regions.
6947!
6948!-- a) - ACTIVITY COEFF/VAPOUR PRESSURE - HNO3
6949    IF ( ions(1) > 0.0_wp  .AND.  ions(6) > 0.0_wp )  THEN
6950       binary_case = 1
6951       IF ( rh > 0.1_wp  .AND.  rh < 0.98_wp )  THEN
6952          IF ( binary_case == 1 )  THEN
6953             binary_hno3 = 1.8514_wp * rh**3 - 4.6991_wp * rh**2 + 1.5514_wp * rh + 0.90236_wp
6954          ELSEIF ( binary_case == 2 )  THEN
6955             binary_hno3 = - 1.1751_wp * ( rh**2 ) - 0.53794_wp * rh + 1.2808_wp
6956          ENDIF
6957       ELSEIF ( rh >= 0.98_wp  .AND.  rh < 0.9999_wp )  THEN
6958          binary_hno3 = 1244.69635941351_wp * rh**3 - 2613.93941099991_wp * rh**2 +                &
6959                        1525.0684974546_wp * rh -155.946764059316_wp
6960       ENDIF
6961!
6962!--    Contributions from other solutes
6963       full_complexity = 1
6964       IF ( hydrochloric_acid > 0.0_wp )  THEN   ! HCL
6965          IF ( full_complexity == 1  .OR.  rh < 0.4_wp )  THEN
6966             hcl_hno3 = 16.051_wp * rh**4 - 44.357_wp * rh**3 + 45.141_wp * rh**2 - 21.638_wp *    &
6967                        rh + 4.8182_wp
6968          ELSEIF ( full_complexity == 0  .AND.  rh > 0.4_wp )  THEN
6969             hcl_hno3 = - 1.5833_wp * rh + 1.5569_wp
6970          ENDIF
6971       ENDIF
6972
6973       IF ( sulphuric_acid > 0.0_wp )  THEN   ! H2SO4
6974          IF ( full_complexity == 1  .OR.  rh < 0.4_wp )  THEN
6975             h2so4_hno3 = - 3.0849_wp * rh**3 + 5.9609_wp * rh**2 - 4.468_wp * rh + 1.5658_wp
6976          ELSEIF ( full_complexity == 0  .AND.  rh > 0.4_wp )  THEN
6977             h2so4_hno3 = - 0.93473_wp * rh + 0.9363_wp
6978          ENDIF
6979       ENDIF
6980
6981       IF ( ammonium_sulphate > 0.0_wp )  THEN   ! NH42SO4
6982          nh42so4_hno3 = 16.821_wp * rh**3 - 28.391_wp * rh**2 + 18.133_wp * rh - 6.7356_wp
6983       ENDIF
6984
6985       IF ( ammonium_nitrate > 0.0_wp )  THEN   ! NH4NO3
6986          nh4no3_hno3 = 11.01_wp * rh**3 - 21.578_wp * rh**2 + 14.808_wp * rh - 4.2593_wp
6987       ENDIF
6988
6989       IF ( ammonium_chloride > 0.0_wp )  THEN   ! NH4Cl
6990          IF ( full_complexity == 1  .OR.  rh <= 0.4_wp )  THEN
6991             nh4cl_hno3 = - 1.176_wp * rh**3 + 5.0828_wp * rh**2 - 3.8792_wp * rh - 0.05518_wp
6992          ELSEIF ( full_complexity == 0  .AND.  rh > 0.4_wp )  THEN
6993             nh4cl_hno3 = 2.6219_wp * rh**2 - 2.2609_wp * rh - 0.38436_wp
6994          ENDIF
6995       ENDIF
6996
6997       IF ( sodium_sulphate > 0.0_wp )  THEN   ! Na2SO4
6998          na2so4_hno3 = 35.504_wp * rh**4 - 80.101_wp * rh**3 + 67.326_wp * rh**2 - 28.461_wp *    &
6999                        rh + 5.6016_wp
7000       ENDIF
7001
7002       IF ( sodium_nitrate > 0.0_wp )  THEN   ! NaNO3
7003          IF ( full_complexity == 1 .OR. rh <= 0.4_wp ) THEN
7004             nano3_hno3 = 23.659_wp * rh**5 - 66.917_wp * rh**4 + 74.686_wp * rh**3 - 40.795_wp *  &
7005                          rh**2 + 10.831_wp * rh - 1.4701_wp
7006          ELSEIF ( full_complexity == 0  .AND.  rh > 0.4_wp )  THEN
7007             nano3_hno3 = 14.749_wp * rh**4 - 35.237_wp * rh**3 + 31.196_wp * rh**2 - 12.076_wp *  &
7008                          rh + 1.3605_wp
7009          ENDIF
7010       ENDIF
7011
7012       IF ( sodium_chloride > 0.0_wp )  THEN   ! NaCl
7013          IF ( full_complexity == 1  .OR.  rh <= 0.4_wp )  THEN
7014             nacl_hno3 = 13.682_wp * rh**4 - 35.122_wp * rh**3 + 33.397_wp * rh**2 - 14.586_wp *   &
7015                         rh + 2.6276_wp
7016          ELSEIF ( full_complexity == 0  .AND.  rh > 0.4_wp )  THEN
7017             nacl_hno3 = 1.1882_wp * rh**3 - 1.1037_wp * rh**2 - 0.7642_wp * rh + 0.6671_wp
7018          ENDIF
7019       ENDIF
7020
7021       ln_hno3_act = binary_hno3 + hydrochloric_acid_eq_frac * hcl_hno3 +                          &
7022                     sulphuric_acid_eq_frac    * h2so4_hno3 +                                      &
7023                     ammonium_sulphate_eq_frac * nh42so4_hno3 +                                    &
7024                     ammonium_nitrate_eq_frac  * nh4no3_hno3 +                                     &
7025                     ammonium_chloride_eq_frac * nh4cl_hno3 +                                      &
7026                     sodium_sulphate_eq_frac * na2so4_hno3 +                                       &
7027                     sodium_nitrate_eq_frac * nano3_hno3 + sodium_chloride_eq_frac   * nacl_hno3
7028
7029       gamma_hno3   = EXP( ln_hno3_act )   ! Molal activity coefficient of HNO3
7030       gamma_out(1) = gamma_hno3
7031!
7032!--    Partial pressure calculation
7033!--    k_hno3 = 2.51 * ( 10**6 )
7034!--    k_hno3 = 2.628145923d6 !< calculated by AIM online (Clegg et al 1998) after Chameides (1984)
7035       k_hno3     = 2.6E6_wp * EXP( 8700.0_wp * henrys_temp_dep )
7036       press_hno3 = ( ions_mol(1) * ions_mol(6) * ( gamma_hno3**2 ) ) / k_hno3
7037    ENDIF
7038!
7039!-- b) - ACTIVITY COEFF/VAPOUR PRESSURE - NH3
7040!-- Follow the two solute approach of Zaveri et al. (2005)
7041    IF ( ions(2) > 0.0_wp  .AND.  ions_mol(1) > 0.0_wp )  THEN
7042!
7043!--    NH4HSO4:
7044       binary_nh4hso4 = 56.907_wp * rh**6 - 155.32_wp * rh**5 + 142.94_wp * rh**4 - 32.298_wp *    &
7045                        rh**3 - 27.936_wp * rh**2 + 19.502_wp * rh - 4.2618_wp
7046       IF ( nitric_acid > 0.0_wp)  THEN   ! HNO3
7047          hno3_nh4hso4 = 104.8369_wp * rh**8 - 288.8923_wp * rh**7 + 129.3445_wp * rh**6 +         &
7048                         373.0471_wp * rh**5 - 571.0385_wp * rh**4 + 326.3528_wp * rh**3 -         &
7049                         74.169_wp * rh**2 - 2.4999_wp * rh + 3.17_wp
7050       ENDIF
7051
7052       IF ( hydrochloric_acid > 0.0_wp)  THEN   ! HCL
7053          hcl_nh4hso4 = - 7.9133_wp * rh**8 + 126.6648_wp * rh**7 - 460.7425_wp * rh**6 +          &
7054                         731.606_wp * rh**5 - 582.7467_wp * rh**4 + 216.7197_wp * rh**3 -          &
7055                         11.3934_wp * rh**2 - 17.7728_wp  * rh + 5.75_wp
7056       ENDIF
7057
7058       IF ( sulphuric_acid > 0.0_wp)  THEN   ! H2SO4
7059          h2so4_nh4hso4 = 195.981_wp * rh**8 - 779.2067_wp * rh**7 + 1226.3647_wp * rh**6 -        &
7060                         964.0261_wp * rh**5 + 391.7911_wp * rh**4 - 84.1409_wp  * rh**3 +         &
7061                          20.0602_wp * rh**2 - 10.2663_wp  * rh + 3.5817_wp
7062       ENDIF
7063
7064       IF ( ammonium_sulphate > 0.0_wp)  THEN   ! NH42SO4
7065          nh42so4_nh4hso4 = 617.777_wp * rh**8 -  2547.427_wp * rh**7 + 4361.6009_wp * rh**6 -     &
7066                           4003.162_wp * rh**5 + 2117.8281_wp * rh**4 - 640.0678_wp * rh**3 +      &
7067                            98.0902_wp * rh**2 -    2.2615_wp * rh - 2.3811_wp
7068       ENDIF
7069
7070       IF ( ammonium_nitrate > 0.0_wp)  THEN   ! NH4NO3
7071          nh4no3_nh4hso4 = - 104.4504_wp * rh**8 + 539.5921_wp * rh**7 - 1157.0498_wp * rh**6 +    &
7072                            1322.4507_wp * rh**5 - 852.2475_wp * rh**4 + 298.3734_wp * rh**3 -     &
7073                              47.0309_wp * rh**2 +    1.297_wp * rh - 0.8029_wp
7074       ENDIF
7075
7076       IF ( ammonium_chloride > 0.0_wp)  THEN   ! NH4Cl
7077          nh4cl_nh4hso4 = 258.1792_wp * rh**8 - 1019.3777_wp * rh**7 + 1592.8918_wp * rh**6 -      &
7078                         1221.0726_wp * rh**5 +  442.2548_wp * rh**4 -   43.6278_wp * rh**3 -      &
7079                            7.5282_wp * rh**2 -    3.8459_wp * rh + 2.2728_wp
7080       ENDIF
7081
7082       IF ( sodium_sulphate > 0.0_wp)  THEN   ! Na2SO4
7083          na2so4_nh4hso4 = 225.4238_wp * rh**8 - 732.4113_wp * rh**7 + 843.7291_wp * rh**6 -       &
7084                           322.7328_wp * rh**5 -  88.6252_wp * rh**4 +  72.4434_wp * rh**3 +       &
7085                            22.9252_wp * rh**2 -  25.3954_wp * rh + 4.6971_wp
7086       ENDIF
7087
7088       IF ( sodium_nitrate > 0.0_wp)  THEN   ! NaNO3
7089          nano3_nh4hso4 = 96.1348_wp * rh**8 - 341.6738_wp * rh**7 + 406.5314_wp * rh**6 -         &
7090                          98.5777_wp * rh**5 - 172.8286_wp * rh**4 + 149.3151_wp * rh**3 -         &
7091                          38.9998_wp * rh**2 -   0.2251_wp * rh + 0.4953_wp
7092       ENDIF
7093
7094       IF ( sodium_chloride > 0.0_wp)  THEN   ! NaCl
7095          nacl_nh4hso4 = 91.7856_wp * rh**8 - 316.6773_wp * rh**7 + 358.2703_wp * rh**6 -          &
7096                         68.9142_wp * rh**5 - 156.5031_wp * rh**4 + 116.9592_wp * rh**3 -          &
7097                         22.5271_wp * rh**2 - 3.7716_wp * rh + 1.56_wp
7098       ENDIF
7099
7100       ln_nh4hso4_act = binary_nh4hso4 + nitric_acid_eq_frac * hno3_nh4hso4 +                      &
7101                        hydrochloric_acid_eq_frac * hcl_nh4hso4 +                                  &
7102                        sulphuric_acid_eq_frac * h2so4_nh4hso4 +                                   &
7103                        ammonium_sulphate_eq_frac * nh42so4_nh4hso4 +                              &
7104                        ammonium_nitrate_eq_frac * nh4no3_nh4hso4 +                                &
7105                        ammonium_chloride_eq_frac * nh4cl_nh4hso4 +                                &
7106                        sodium_sulphate_eq_frac * na2so4_nh4hso4 +                                 &
7107                        sodium_nitrate_eq_frac * nano3_nh4hso4 +                                   &
7108                        sodium_chloride_eq_frac * nacl_nh4hso4
7109
7110       gamma_nh4hso4 = EXP( ln_nh4hso4_act ) ! molal act. coefficient of NH4HSO4
7111!
7112!--    Molal activity coefficient of NO3-
7113       gamma_out(6)  = gamma_nh4hso4
7114!
7115!--    Molal activity coefficient of NH4+
7116       gamma_nh3     = gamma_nh4hso4**2 / gamma_hhso4**2
7117       gamma_out(3)  = gamma_nh3
7118!
7119!--    This actually represents the ratio of the ammonium to hydrogen ion activity coefficients
7120!--    (see Zaveri paper) - multiply this by the ratio of the ammonium to hydrogen ion molality and
7121!--    the ratio of appropriate equilibrium constants
7122!
7123!--    Equilibrium constants
7124!--    k_h = 57.64d0    ! Zaveri et al. (2005)
7125       k_h = 5.8E1_wp * EXP( 4085.0_wp * henrys_temp_dep )   ! after Chameides (1984)
7126!--    k_nh4 = 1.81E-5_wp    ! Zaveri et al. (2005)
7127       k_nh4 = 1.7E-5_wp * EXP( -4325.0_wp * henrys_temp_dep )   ! Chameides (1984)
7128!--    k_h2o = 1.01E-14_wp    ! Zaveri et al (2005)
7129       k_h2o = 1.E-14_wp * EXP( -6716.0_wp * henrys_temp_dep )   ! Chameides (1984)
7130!
7131       molality_ratio_nh3 = ions_mol(2) / ions_mol(1)
7132!
7133!--    Partial pressure calculation
7134       press_nh3 = molality_ratio_nh3 * gamma_nh3 * ( k_h2o / ( k_h * k_nh4 ) )
7135
7136    ENDIF
7137!
7138!-- c) - ACTIVITY COEFF/VAPOUR PRESSURE - HCL
7139    IF ( ions(1) > 0.0_wp  .AND.  ions(7) > 0.0_wp )  THEN
7140       binary_case = 1
7141       IF ( rh > 0.1_wp  .AND.  rh < 0.98 )  THEN
7142          IF ( binary_case == 1 )  THEN
7143             binary_hcl = - 5.0179_wp * rh**3 + 9.8816_wp * rh**2 - 10.789_wp * rh + 5.4737_wp
7144          ELSEIF ( binary_case == 2 )  THEN
7145             binary_hcl = - 4.6221_wp * rh + 4.2633_wp
7146          ENDIF
7147       ELSEIF ( rh >= 0.98_wp  .AND.  rh < 0.9999_wp )  THEN
7148          binary_hcl = 775.6111008626_wp * rh**3 - 2146.01320888771_wp * rh**2 +                   &
7149                       1969.01979670259_wp *  rh - 598.878230033926_wp
7150       ENDIF
7151    ENDIF
7152
7153    IF ( nitric_acid > 0.0_wp )  THEN   ! HNO3
7154       IF ( full_complexity == 1  .OR.  rh <= 0.4_wp )  THEN
7155          hno3_hcl = 9.6256_wp * rh**4 - 26.507_wp * rh**3 + 27.622_wp * rh**2 - 12.958_wp * rh +  &
7156                     2.2193_wp
7157       ELSEIF ( full_complexity == 0  .AND.  rh > 0.4_wp )  THEN
7158          hno3_hcl = 1.3242_wp * rh**2 - 1.8827_wp * rh + 0.55706_wp
7159       ENDIF
7160    ENDIF
7161
7162    IF ( sulphuric_acid > 0.0_wp )  THEN   ! H2SO4
7163       IF ( full_complexity == 1  .OR.  rh <= 0.4 )  THEN
7164          h2so4_hcl = 1.4406_wp * rh**3 - 2.7132_wp * rh**2 + 1.014_wp * rh + 0.25226_wp
7165       ELSEIF ( full_complexity == 0 .AND. rh > 0.4_wp ) THEN
7166          h2so4_hcl = 0.30993_wp * rh**2 - 0.99171_wp * rh + 0.66913_wp
7167       ENDIF
7168    ENDIF
7169
7170    IF ( ammonium_sulphate > 0.0_wp )  THEN   ! NH42SO4
7171       nh42so4_hcl = 22.071_wp * rh**3 - 40.678_wp * rh**2 + 27.893_wp * rh - 9.4338_wp
7172    ENDIF
7173
7174    IF ( ammonium_nitrate > 0.0_wp )  THEN   ! NH4NO3
7175       nh4no3_hcl = 19.935_wp * rh**3 - 42.335_wp * rh**2 + 31.275_wp * rh - 8.8675_wp
7176    ENDIF
7177
7178    IF ( ammonium_chloride > 0.0_wp )  THEN   ! NH4Cl
7179       IF ( full_complexity == 1  .OR.  rh <= 0.4_wp )  THEN
7180          nh4cl_hcl = 2.8048_wp * rh**3 - 4.3182_wp * rh**2 + 3.1971_wp * rh - 1.6824_wp
7181       ELSEIF ( full_complexity == 0  .AND.  rh > 0.4_wp )  THEN
7182          nh4cl_hcl = 1.2304_wp * rh**2 - 0.18262_wp * rh - 1.0643_wp
7183       ENDIF
7184    ENDIF
7185
7186    IF ( sodium_sulphate > 0.0_wp )  THEN   ! Na2SO4
7187       na2so4_hcl = 36.104_wp * rh**4 - 78.658_wp * rh**3 + 63.441_wp * rh**2 - 26.727_wp * rh +   &
7188                    5.7007_wp
7189    ENDIF
7190
7191    IF ( sodium_nitrate > 0.0_wp )  THEN   ! NaNO3
7192       IF ( full_complexity == 1  .OR.  rh <= 0.4_wp )  THEN
7193          nano3_hcl = 54.471_wp * rh**5 - 159.42_wp * rh**4 + 180.25_wp * rh**3 - 98.176_wp * rh**2&
7194                      + 25.309_wp * rh - 2.4275_wp
7195       ELSEIF ( full_complexity == 0  .AND.  rh > 0.4_wp )  THEN
7196          nano3_hcl = 21.632_wp * rh**4 - 53.088_wp * rh**3 + 47.285_wp * rh**2 - 18.519_wp * rh   &
7197                      + 2.6846_wp
7198       ENDIF
7199    ENDIF
7200
7201    IF ( sodium_chloride > 0.0_wp )  THEN   ! NaCl
7202       IF ( full_complexity == 1  .OR.  rh <= 0.4_wp )  THEN
7203          nacl_hcl = 5.4138_wp * rh**4 - 12.079_wp * rh**3 + 9.627_wp * rh**2 - 3.3164_wp * rh +   &
7204                     0.35224_wp
7205       ELSEIF ( full_complexity == 0  .AND.  rh > 0.4_wp )  THEN
7206          nacl_hcl = 2.432_wp * rh**3 - 4.3453_wp * rh**2 + 2.3834_wp * rh - 0.4762_wp
7207       ENDIF
7208    ENDIF
7209
7210    ln_HCL_act = binary_hcl + nitric_acid_eq_frac * hno3_hcl + sulphuric_acid_eq_frac * h2so4_hcl +&
7211                 ammonium_sulphate_eq_frac * nh42so4_hcl + ammonium_nitrate_eq_frac * nh4no3_hcl + &
7212                 ammonium_chloride_eq_frac * nh4cl_hcl + sodium_sulphate_eq_frac * na2so4_hcl +    &
7213                 sodium_nitrate_eq_frac    * nano3_hcl + sodium_chloride_eq_frac   * nacl_hcl
7214
7215     gamma_hcl    = EXP( ln_HCL_act )   ! Molal activity coefficient
7216     gamma_out(2) = gamma_hcl
7217!
7218!--  Equilibrium constant after Wagman et al. (1982) (and NIST database)
7219     k_hcl = 2E6_wp * EXP( 9000.0_wp * henrys_temp_dep )
7220
7221     press_hcl = ( ions_mol(1) * ions_mol(7) * gamma_hcl**2 ) / k_hcl
7222!
7223!-- 5) Ion molility output
7224    mols_out = ions_mol
7225
7226 END SUBROUTINE inorganic_pdfite
7227
7228!------------------------------------------------------------------------------!
7229! Description:
7230! ------------
7231!> Update the particle size distribution. Put particles into corrects bins.
7232!>
7233!> Moving-centre method assumed, i.e. particles are allowed to grow to their
7234!> exact size as long as they are not crossing the fixed diameter bin limits.
7235!> If the particles in a size bin cross the lower or upper diameter limit, they
7236!> are all moved to the adjacent diameter bin and their volume is averaged with
7237!> the particles in the new bin, which then get a new diameter.
7238!
7239!> Moving-centre method minimises numerical diffusion.
7240!------------------------------------------------------------------------------!
7241 SUBROUTINE distr_update( paero )
7242
7243    IMPLICIT NONE
7244
7245    INTEGER(iwp) ::  ib      !< loop index
7246    INTEGER(iwp) ::  mm      !< loop index
7247    INTEGER(iwp) ::  counti  !< number of while loops
7248
7249    LOGICAL  ::  within_bins !< logical (particle belongs to the bin?)
7250
7251    REAL(wp) ::  znfrac  !< number fraction to be moved to the larger bin
7252    REAL(wp) ::  zvfrac  !< volume fraction to be moved to the larger bin
7253    REAL(wp) ::  zvexc   !< Volume in the grown bin which exceeds the bin upper limit
7254    REAL(wp) ::  zvihi   !< particle volume at the high end of the bin
7255    REAL(wp) ::  zvilo   !< particle volume at the low end of the bin
7256    REAL(wp) ::  zvpart  !< particle volume (m3)
7257    REAL(wp) ::  zvrat   !< volume ratio of a size bin
7258
7259    real(wp), dimension(nbins_aerosol) ::  dummy
7260
7261    TYPE(t_section), DIMENSION(nbins_aerosol), INTENT(inout) ::  paero !< aerosol properties
7262
7263    zvpart      = 0.0_wp
7264    zvfrac      = 0.0_wp
7265    within_bins = .FALSE.
7266
7267    dummy = paero(:)%numc
7268!
7269!-- Check if the volume of the bin is within bin limits after update
7270    counti = 0
7271    DO  WHILE ( .NOT. within_bins )
7272       within_bins = .TRUE.
7273!
7274!--    Loop from larger to smaller size bins
7275       DO  ib = end_subrange_2b-1, start_subrange_1a, -1
7276          mm = 0
7277          IF ( paero(ib)%numc > nclim )  THEN
7278             zvpart = 0.0_wp
7279             zvfrac = 0.0_wp
7280
7281             IF ( ib == end_subrange_2a )  CYCLE
7282!
7283!--          Dry volume
7284             zvpart = SUM( paero(ib)%volc(1:7) ) / paero(ib)%numc
7285!
7286!--          Smallest bin cannot decrease
7287             IF ( paero(ib)%vlolim > zvpart  .AND.  ib == start_subrange_1a ) CYCLE
7288!
7289!--          Decreasing bins
7290             IF ( paero(ib)%vlolim > zvpart )  THEN
7291                mm = ib - 1
7292                IF ( ib == start_subrange_2b )  mm = end_subrange_1a    ! 2b goes to 1a
7293
7294                paero(mm)%numc = paero(mm)%numc + paero(ib)%numc
7295                paero(ib)%numc = 0.0_wp
7296                paero(mm)%volc(:) = paero(mm)%volc(:) + paero(ib)%volc(:)
7297                paero(ib)%volc(:) = 0.0_wp
7298                CYCLE
7299             ENDIF
7300!
7301!--          If size bin has not grown, cycle.
7302!--          Changed by Mona: compare to the arithmetic mean volume, as done originally. Now
7303!--          particle volume is derived from the geometric mean diameter, not arithmetic (see
7304!--          SUBROUTINE set_sizebins).
7305             IF ( zvpart <= api6 * ( ( aero(ib)%vhilim + aero(ib)%vlolim ) / ( 2.0_wp * api6 ) ) ) &
7306             CYCLE
7307!
7308!--          Avoid precision problems
7309             IF ( ABS( zvpart - api6 * paero(ib)%dmid**3 ) < 1.0E-35_wp )  CYCLE
7310!
7311!--          Volume ratio of the size bin
7312             zvrat = paero(ib)%vhilim / paero(ib)%vlolim
7313!
7314!--          Particle volume at the low end of the bin
7315             zvilo = 2.0_wp * zvpart / ( 1.0_wp + zvrat )
7316!
7317!--          Particle volume at the high end of the bin
7318             zvihi = zvrat * zvilo
7319!
7320!--          Volume in the grown bin which exceeds the bin upper limit
7321             zvexc = 0.5_wp * ( zvihi + paero(ib)%vhilim )
7322!
7323!--          Number fraction to be moved to the larger bin
7324             znfrac = MIN( 1.0_wp, ( zvihi - paero(ib)%vhilim) / ( zvihi - zvilo ) )
7325!
7326!--          Volume fraction to be moved to the larger bin
7327             zvfrac = MIN( 0.99_wp, znfrac * zvexc / zvpart )
7328             IF ( zvfrac < 0.0_wp )  THEN
7329                message_string = 'Error: zvfrac < 0'
7330                CALL message( 'salsa_mod: distr_update', 'PA0624', 1, 2, 0, 6, 0 )
7331             ENDIF
7332!
7333!--          Update bin
7334             mm = ib + 1
7335!
7336!--          Volume (cm3/cm3)
7337             paero(mm)%volc(:) = paero(mm)%volc(:) + znfrac * paero(ib)%numc * zvexc *             &
7338                                 paero(ib)%volc(:) / SUM( paero(ib)%volc(1:7) )
7339             paero(ib)%volc(:) = paero(ib)%volc(:) - znfrac * paero(ib)%numc * zvexc *             &
7340                                 paero(ib)%volc(:) / SUM( paero(ib)%volc(1:7) )
7341
7342!--          Number concentration (#/m3)
7343             paero(mm)%numc = paero(mm)%numc + znfrac * paero(ib)%numc
7344             paero(ib)%numc = paero(ib)%numc * ( 1.0_wp - znfrac )
7345
7346          ENDIF     ! nclim
7347
7348          IF ( paero(ib)%numc > nclim )   THEN
7349             zvpart = SUM( paero(ib)%volc(1:7) ) / paero(ib)%numc  ! Note: dry volume!
7350             within_bins = ( paero(ib)%vlolim < zvpart  .AND. zvpart < paero(ib)%vhilim )
7351          ENDIF
7352
7353       ENDDO ! - ib
7354
7355       counti = counti + 1
7356       IF ( counti > 100 )  THEN
7357          message_string = 'Error: Aerosol bin update not converged'
7358          CALL message( 'salsa_mod: distr_update', 'PA0625', 1, 2, 0, 6, 0 )
7359       ENDIF
7360
7361    ENDDO ! - within bins
7362
7363 END SUBROUTINE distr_update
7364
7365!------------------------------------------------------------------------------!
7366! Description:
7367! ------------
7368!> salsa_diagnostics: Update properties for the current timestep:
7369!>
7370!> Juha Tonttila, FMI, 2014
7371!> Tomi Raatikainen, FMI, 2016
7372!------------------------------------------------------------------------------!
7373 SUBROUTINE salsa_diagnostics( i, j )
7374
7375    USE cpulog,                                                                &
7376        ONLY:  cpu_log, log_point_s
7377
7378    IMPLICIT NONE
7379
7380    INTEGER(iwp) ::  ib   !<
7381    INTEGER(iwp) ::  ic   !<
7382    INTEGER(iwp) ::  icc  !<
7383    INTEGER(iwp) ::  ig   !<
7384    INTEGER(iwp) ::  k    !<
7385
7386    INTEGER(iwp), INTENT(in) ::  i  !<
7387    INTEGER(iwp), INTENT(in) ::  j  !<
7388
7389    REAL(wp), DIMENSION(nzb:nzt+1) ::  flag          !< flag to mask topography
7390    REAL(wp), DIMENSION(nzb:nzt+1) ::  flag_zddry    !< flag to mask zddry
7391    REAL(wp), DIMENSION(nzb:nzt+1) ::  in_adn        !< air density (kg/m3)
7392    REAL(wp), DIMENSION(nzb:nzt+1) ::  in_p          !< pressure
7393    REAL(wp), DIMENSION(nzb:nzt+1) ::  in_t          !< temperature (K)
7394    REAL(wp), DIMENSION(nzb:nzt+1) ::  mcsum         !< sum of mass concentration
7395    REAL(wp), DIMENSION(nzb:nzt+1) ::  ppm_to_nconc  !< Conversion factor: ppm to #/m3
7396    REAL(wp), DIMENSION(nzb:nzt+1) ::  zddry         !< particle dry diameter
7397    REAL(wp), DIMENSION(nzb:nzt+1) ::  zvol          !< particle volume
7398
7399    flag_zddry   = 0.0_wp
7400    in_adn       = 0.0_wp
7401    in_p         = 0.0_wp
7402    in_t         = 0.0_wp
7403    ppm_to_nconc = 1.0_wp
7404    zddry        = 0.0_wp
7405    zvol         = 0.0_wp
7406
7407    !$OMP MASTER
7408    CALL cpu_log( log_point_s(94), 'salsa diagnostics ', 'start' )
7409    !$OMP END MASTER
7410
7411!
7412!-- Calculate thermodynamic quantities needed in SALSA
7413    CALL salsa_thrm_ij( i, j, p_ij=in_p, temp_ij=in_t, adn_ij=in_adn )
7414!
7415!-- Calculate conversion factors for gas concentrations
7416    ppm_to_nconc = for_ppm_to_nconc * in_p / in_t
7417!
7418!-- Predetermine flag to mask topography
7419    flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_0(:,j,i), 0 ) )
7420
7421    DO  ib = 1, nbins_aerosol   ! aerosol size bins
7422!
7423!--    Remove negative values
7424       aerosol_number(ib)%conc(:,j,i) = MAX( nclim, aerosol_number(ib)%conc(:,j,i) ) * flag
7425!
7426!--    Calculate total mass concentration per bin
7427       mcsum = 0.0_wp
7428       DO  ic = 1, ncomponents_mass
7429          icc = ( ic - 1 ) * nbins_aerosol + ib
7430          mcsum = mcsum + aerosol_mass(icc)%conc(:,j,i) * flag
7431          aerosol_mass(icc)%conc(:,j,i) = MAX( mclim, aerosol_mass(icc)%conc(:,j,i) ) * flag
7432       ENDDO
7433!
7434!--    Check that number and mass concentration match qualitatively
7435       IF ( ANY( aerosol_number(ib)%conc(:,j,i) > nclim  .AND. mcsum <= 0.0_wp ) )  THEN
7436          DO  k = nzb+1, nzt
7437             IF ( aerosol_number(ib)%conc(k,j,i) >= nclim  .AND. mcsum(k) <= 0.0_wp )  THEN
7438                aerosol_number(ib)%conc(k,j,i) = nclim * flag(k)
7439                DO  ic = 1, ncomponents_mass
7440                   icc = ( ic - 1 ) * nbins_aerosol + ib
7441                   aerosol_mass(icc)%conc(k,j,i) = mclim * flag(k)
7442                ENDDO
7443             ENDIF
7444          ENDDO
7445       ENDIF
7446!
7447!--    Update aerosol particle radius
7448       CALL bin_mixrat( 'dry', ib, i, j, zvol )
7449       zvol = zvol / arhoh2so4    ! Why on sulphate?
7450!
7451!--    Particles smaller then 0.1 nm diameter are set to zero
7452       zddry = ( zvol / MAX( nclim, aerosol_number(ib)%conc(:,j,i) ) / api6 )**0.33333333_wp
7453       flag_zddry = MERGE( 1.0_wp, 0.0_wp, ( zddry < 1.0E-10_wp  .AND.                             &
7454                           aerosol_number(ib)%conc(:,j,i) > nclim ) )
7455!
7456!--    Volatile species to the gas phase
7457       IF ( index_so4 > 0 .AND. lscndgas )  THEN
7458          ic = ( index_so4 - 1 ) * nbins_aerosol + ib
7459          IF ( salsa_gases_from_chem )  THEN
7460             ig = gas_index_chem(1)
7461             chem_species(ig)%conc(:,j,i) = chem_species(ig)%conc(:,j,i) +                         &
7462                                            aerosol_mass(ic)%conc(:,j,i) * avo * flag_zddry /      &
7463                                            ( amh2so4 * ppm_to_nconc ) * flag
7464          ELSE
7465             salsa_gas(1)%conc(:,j,i) = salsa_gas(1)%conc(:,j,i) + aerosol_mass(ic)%conc(:,j,i) /  &
7466                                        amh2so4 * avo * flag_zddry * flag
7467          ENDIF
7468       ENDIF
7469       IF ( index_oc > 0  .AND.  lscndgas )  THEN
7470          ic = ( index_oc - 1 ) * nbins_aerosol + ib
7471          IF ( salsa_gases_from_chem )  THEN
7472             ig = gas_index_chem(5)
7473             chem_species(ig)%conc(:,j,i) = chem_species(ig)%conc(:,j,i) +                         &
7474                                            aerosol_mass(ic)%conc(:,j,i) * avo * flag_zddry /      &
7475                                            ( amoc * ppm_to_nconc ) * flag
7476          ELSE
7477             salsa_gas(5)%conc(:,j,i) = salsa_gas(5)%conc(:,j,i) + aerosol_mass(ic)%conc(:,j,i) /  &
7478                                        amoc * avo * flag_zddry * flag
7479          ENDIF
7480       ENDIF
7481       IF ( index_no > 0  .AND.  lscndgas )  THEN
7482          ic = ( index_no - 1 ) * nbins_aerosol + ib
7483          IF ( salsa_gases_from_chem )  THEN
7484             ig = gas_index_chem(2)
7485             chem_species(ig)%conc(:,j,i) = chem_species(ig)%conc(:,j,i) +                         &
7486                                            aerosol_mass(ic)%conc(:,j,i) * avo * flag_zddry /      &
7487                                            ( amhno3 * ppm_to_nconc ) *flag
7488          ELSE
7489             salsa_gas(2)%conc(:,j,i) = salsa_gas(2)%conc(:,j,i) + aerosol_mass(ic)%conc(:,j,i) /  &
7490                                        amhno3 * avo * flag_zddry * flag
7491          ENDIF
7492       ENDIF
7493       IF ( index_nh > 0  .AND.  lscndgas )  THEN
7494          ic = ( index_nh - 1 ) * nbins_aerosol + ib
7495          IF ( salsa_gases_from_chem )  THEN
7496             ig = gas_index_chem(3)
7497             chem_species(ig)%conc(:,j,i) = chem_species(ig)%conc(:,j,i) +                         &
7498                                            aerosol_mass(ic)%conc(:,j,i) * avo * flag_zddry /      &
7499                                            ( amnh3 * ppm_to_nconc ) *flag
7500          ELSE
7501             salsa_gas(3)%conc(:,j,i) = salsa_gas(3)%conc(:,j,i) + aerosol_mass(ic)%conc(:,j,i) /  &
7502                                        amnh3 * avo * flag_zddry *flag
7503          ENDIF
7504       ENDIF
7505!
7506!--    Mass and number to zero (insoluble species and water are lost)
7507       DO  ic = 1, ncomponents_mass
7508          icc = ( ic - 1 ) * nbins_aerosol + ib
7509          aerosol_mass(icc)%conc(:,j,i) = MERGE( mclim * flag, aerosol_mass(icc)%conc(:,j,i),      &
7510                                                 flag_zddry > 0.0_wp )
7511       ENDDO
7512       aerosol_number(ib)%conc(:,j,i) = MERGE( nclim * flag, aerosol_number(ib)%conc(:,j,i),       &
7513                                               flag_zddry > 0.0_wp )
7514       ra_dry(:,j,i,ib) = MAX( 1.0E-10_wp, 0.5_wp * zddry )
7515
7516    ENDDO
7517    IF ( .NOT. salsa_gases_from_chem )  THEN
7518       DO  ig = 1, ngases_salsa
7519          salsa_gas(ig)%conc(:,j,i) = MAX( nclim, salsa_gas(ig)%conc(:,j,i) ) * flag
7520       ENDDO
7521    ENDIF
7522
7523   !$OMP MASTER
7524    CALL cpu_log( log_point_s(94), 'salsa diagnostics ', 'stop' )
7525   !$OMP END MASTER
7526
7527 END SUBROUTINE salsa_diagnostics
7528
7529
7530!------------------------------------------------------------------------------!
7531! Description:
7532! ------------
7533!> Call for all grid points
7534!------------------------------------------------------------------------------!
7535 SUBROUTINE salsa_actions( location )
7536
7537
7538    CHARACTER (LEN=*), INTENT(IN) ::  location !< call location string
7539
7540    SELECT CASE ( location )
7541
7542       CASE ( 'before_timestep' )
7543
7544          IF ( ws_scheme_sca )  sums_salsa_ws_l = 0.0_wp
7545
7546       CASE DEFAULT
7547          CONTINUE
7548
7549    END SELECT
7550
7551 END SUBROUTINE salsa_actions
7552
7553
7554!------------------------------------------------------------------------------!
7555! Description:
7556! ------------
7557!> Call for grid points i,j
7558!------------------------------------------------------------------------------!
7559
7560 SUBROUTINE salsa_actions_ij( i, j, location )
7561
7562
7563    INTEGER(iwp),      INTENT(IN) ::  i         !< grid index in x-direction
7564    INTEGER(iwp),      INTENT(IN) ::  j         !< grid index in y-direction
7565    CHARACTER (LEN=*), INTENT(IN) ::  location  !< call location string
7566    INTEGER(iwp)  ::  dummy  !< call location string
7567
7568    IF ( salsa    )   dummy = i + j
7569
7570    SELECT CASE ( location )
7571
7572       CASE ( 'before_timestep' )
7573
7574          IF ( ws_scheme_sca )  sums_salsa_ws_l = 0.0_wp
7575
7576       CASE DEFAULT
7577          CONTINUE
7578
7579    END SELECT
7580
7581
7582 END SUBROUTINE salsa_actions_ij
7583
7584!------------------------------------------------------------------------------!
7585! Description:
7586! ------------
7587!> Call for all grid points
7588!------------------------------------------------------------------------------!
7589 SUBROUTINE salsa_non_advective_processes
7590
7591    USE cpulog,                                                                                    &
7592        ONLY:  cpu_log, log_point_s
7593
7594    IMPLICIT NONE
7595
7596    INTEGER(iwp) ::  i  !<
7597    INTEGER(iwp) ::  j  !<
7598
7599    IF ( time_since_reference_point >= skip_time_do_salsa )  THEN
7600       IF ( ( time_since_reference_point - last_salsa_time ) >= dt_salsa )  THEN
7601!
7602!--       Calculate aerosol dynamic processes. salsa_driver can be run with a longer time step.
7603          CALL cpu_log( log_point_s(90), 'salsa processes ', 'start' )
7604          DO  i = nxl, nxr
7605             DO  j = nys, nyn
7606                CALL salsa_diagnostics( i, j )
7607                CALL salsa_driver( i, j, 3 )
7608                CALL salsa_diagnostics( i, j )
7609             ENDDO
7610          ENDDO
7611          CALL cpu_log( log_point_s(90), 'salsa processes ', 'stop' )
7612       ENDIF
7613    ENDIF
7614
7615 END SUBROUTINE salsa_non_advective_processes
7616
7617
7618!------------------------------------------------------------------------------!
7619! Description:
7620! ------------
7621!> Call for grid points i,j
7622!------------------------------------------------------------------------------!
7623 SUBROUTINE salsa_non_advective_processes_ij( i, j )
7624
7625    USE cpulog,                                                                &
7626        ONLY:  cpu_log, log_point_s
7627
7628    IMPLICIT NONE
7629
7630    INTEGER(iwp), INTENT(IN) ::  i  !< grid index in x-direction
7631    INTEGER(iwp), INTENT(IN) ::  j  !< grid index in y-direction
7632
7633    IF ( time_since_reference_point >= skip_time_do_salsa )  THEN
7634       IF ( ( time_since_reference_point - last_salsa_time ) >= dt_salsa )  THEN
7635!
7636!--       Calculate aerosol dynamic processes. salsa_driver can be run with a longer time step.
7637          CALL cpu_log( log_point_s(90), 'salsa processes ', 'start' )
7638          CALL salsa_diagnostics( i, j )
7639          CALL salsa_driver( i, j, 3 )
7640          CALL salsa_diagnostics( i, j )
7641          CALL cpu_log( log_point_s(90), 'salsa processes ', 'stop' )
7642       ENDIF
7643    ENDIF
7644
7645 END SUBROUTINE salsa_non_advective_processes_ij
7646
7647!------------------------------------------------------------------------------!
7648! Description:
7649! ------------
7650!> Routine for exchange horiz of salsa variables.
7651!------------------------------------------------------------------------------!
7652 SUBROUTINE salsa_exchange_horiz_bounds
7653
7654    USE cpulog,                                                                &
7655        ONLY:  cpu_log, log_point_s
7656
7657    IMPLICIT NONE
7658
7659    INTEGER(iwp) ::  ib   !<
7660    INTEGER(iwp) ::  ic   !<
7661    INTEGER(iwp) ::  icc  !<
7662    INTEGER(iwp) ::  ig   !<
7663
7664    IF ( time_since_reference_point >= skip_time_do_salsa )  THEN
7665       IF ( ( time_since_reference_point - last_salsa_time ) >= dt_salsa )  THEN
7666
7667          CALL cpu_log( log_point_s(91), 'salsa exch-horiz ', 'start' )
7668!
7669!--       Exchange ghost points and decycle if needed.
7670          DO  ib = 1, nbins_aerosol
7671             CALL exchange_horiz( aerosol_number(ib)%conc, nbgp )
7672             CALL salsa_boundary_conds( aerosol_number(ib)%conc, aerosol_number(ib)%init )
7673             DO  ic = 1, ncomponents_mass
7674                icc = ( ic - 1 ) * nbins_aerosol + ib
7675                CALL exchange_horiz( aerosol_mass(icc)%conc, nbgp )
7676                CALL salsa_boundary_conds( aerosol_mass(icc)%conc, aerosol_mass(icc)%init )
7677             ENDDO
7678          ENDDO
7679          IF ( .NOT. salsa_gases_from_chem )  THEN
7680             DO  ig = 1, ngases_salsa
7681                CALL exchange_horiz( salsa_gas(ig)%conc, nbgp )
7682                CALL salsa_boundary_conds( salsa_gas(ig)%conc, salsa_gas(ig)%init )
7683             ENDDO
7684          ENDIF
7685          CALL cpu_log( log_point_s(91), 'salsa exch-horiz ', 'stop' )
7686!
7687!--       Update last_salsa_time
7688          last_salsa_time = time_since_reference_point
7689       ENDIF
7690    ENDIF
7691
7692 END SUBROUTINE salsa_exchange_horiz_bounds
7693
7694!------------------------------------------------------------------------------!
7695! Description:
7696! ------------
7697!> Calculate the prognostic equation for aerosol number and mass, and gas
7698!> concentrations. Cache-optimized.
7699!------------------------------------------------------------------------------!
7700 SUBROUTINE salsa_prognostic_equations_ij( i, j, i_omp_start, tn )
7701
7702    IMPLICIT NONE
7703
7704    INTEGER(iwp) ::  i            !<
7705    INTEGER(iwp) ::  i_omp_start  !<
7706    INTEGER(iwp) ::  ib           !< loop index for aerosol number bin OR gas index
7707    INTEGER(iwp) ::  ic           !< loop index for aerosol mass bin
7708    INTEGER(iwp) ::  icc          !< (c-1)*nbins_aerosol+b
7709    INTEGER(iwp) ::  ig           !< loop index for salsa gases
7710    INTEGER(iwp) ::  j            !<
7711    INTEGER(iwp) ::  tn           !<
7712
7713    IF ( time_since_reference_point >= skip_time_do_salsa )  THEN
7714!
7715!--    Aerosol number
7716       DO  ib = 1, nbins_aerosol
7717!kk          sums_salsa_ws_l = aerosol_number(ib)%sums_ws_l
7718          CALL salsa_tendency( 'aerosol_number', aerosol_number(ib)%conc_p, aerosol_number(ib)%conc,&
7719                               aerosol_number(ib)%tconc_m, i, j, i_omp_start, tn, ib, ib,          &
7720                               aerosol_number(ib)%flux_s, aerosol_number(ib)%diss_s,               &
7721                               aerosol_number(ib)%flux_l, aerosol_number(ib)%diss_l,               &
7722                               aerosol_number(ib)%init, .TRUE. )
7723!kk          aerosol_number(ib)%sums_ws_l = sums_salsa_ws_l
7724!
7725!--       Aerosol mass
7726          DO  ic = 1, ncomponents_mass
7727             icc = ( ic - 1 ) * nbins_aerosol + ib
7728!kk             sums_salsa_ws_l = aerosol_mass(icc)%sums_ws_l
7729             CALL salsa_tendency( 'aerosol_mass', aerosol_mass(icc)%conc_p, aerosol_mass(icc)%conc,&
7730                                  aerosol_mass(icc)%tconc_m, i, j, i_omp_start, tn, ib, ic,        &
7731                                  aerosol_mass(icc)%flux_s, aerosol_mass(icc)%diss_s,              &
7732                                  aerosol_mass(icc)%flux_l, aerosol_mass(icc)%diss_l,              &
7733                                  aerosol_mass(icc)%init, .TRUE. )
7734!kk             aerosol_mass(icc)%sums_ws_l = sums_salsa_ws_l
7735
7736          ENDDO  ! ic
7737       ENDDO  ! ib
7738!
7739!--    Gases
7740       IF ( .NOT. salsa_gases_from_chem )  THEN
7741
7742          DO  ig = 1, ngases_salsa
7743!kk             sums_salsa_ws_l = salsa_gas(ig)%sums_ws_l
7744             CALL salsa_tendency( 'salsa_gas', salsa_gas(ig)%conc_p, salsa_gas(ig)%conc,           &
7745                                  salsa_gas(ig)%tconc_m, i, j, i_omp_start, tn, ig, ig,            &
7746                                  salsa_gas(ig)%flux_s, salsa_gas(ig)%diss_s, salsa_gas(ig)%flux_l,&
7747                                  salsa_gas(ig)%diss_l, salsa_gas(ig)%init, .FALSE. )
7748!kk             salsa_gas(ig)%sums_ws_l = sums_salsa_ws_l
7749
7750          ENDDO  ! ig
7751
7752       ENDIF
7753
7754    ENDIF
7755
7756 END SUBROUTINE salsa_prognostic_equations_ij
7757!
7758!------------------------------------------------------------------------------!
7759! Description:
7760! ------------
7761!> Calculate the prognostic equation for aerosol number and mass, and gas
7762!> concentrations. For vector machines.
7763!------------------------------------------------------------------------------!
7764 SUBROUTINE salsa_prognostic_equations()
7765
7766    IMPLICIT NONE
7767
7768    INTEGER(iwp) ::  ib           !< loop index for aerosol number bin OR gas index
7769    INTEGER(iwp) ::  ic           !< loop index for aerosol mass bin
7770    INTEGER(iwp) ::  icc          !< (c-1)*nbins_aerosol+b
7771    INTEGER(iwp) ::  ig           !< loop index for salsa gases
7772
7773    IF ( time_since_reference_point >= skip_time_do_salsa )  THEN
7774!
7775!--    Aerosol number
7776       DO  ib = 1, nbins_aerosol
7777          sums_salsa_ws_l = aerosol_number(ib)%sums_ws_l
7778          CALL salsa_tendency( 'aerosol_number', aerosol_number(ib)%conc_p, aerosol_number(ib)%conc,&
7779                               aerosol_number(ib)%tconc_m, ib, ib, aerosol_number(ib)%init, .TRUE. )
7780          aerosol_number(ib)%sums_ws_l = sums_salsa_ws_l
7781!
7782!--       Aerosol mass
7783          DO  ic = 1, ncomponents_mass
7784             icc = ( ic - 1 ) * nbins_aerosol + ib
7785             sums_salsa_ws_l = aerosol_mass(icc)%sums_ws_l
7786             CALL salsa_tendency( 'aerosol_mass', aerosol_mass(icc)%conc_p, aerosol_mass(icc)%conc,&
7787                                  aerosol_mass(icc)%tconc_m, ib, ic, aerosol_mass(icc)%init, .TRUE. )
7788             aerosol_mass(icc)%sums_ws_l = sums_salsa_ws_l
7789
7790          ENDDO  ! ic
7791       ENDDO  ! ib
7792!
7793!--    Gases
7794       IF ( .NOT. salsa_gases_from_chem )  THEN
7795
7796          DO  ig = 1, ngases_salsa
7797             sums_salsa_ws_l = salsa_gas(ig)%sums_ws_l
7798             CALL salsa_tendency( 'salsa_gas', salsa_gas(ig)%conc_p, salsa_gas(ig)%conc,           &
7799                                  salsa_gas(ig)%tconc_m, ig, ig, salsa_gas(ig)%init, .FALSE. )
7800             salsa_gas(ig)%sums_ws_l = sums_salsa_ws_l
7801
7802          ENDDO  ! ig
7803
7804       ENDIF
7805
7806    ENDIF
7807
7808 END SUBROUTINE salsa_prognostic_equations
7809!
7810!------------------------------------------------------------------------------!
7811! Description:
7812! ------------
7813!> Tendencies for aerosol number and mass and gas concentrations.
7814!> Cache-optimized.
7815!------------------------------------------------------------------------------!
7816 SUBROUTINE salsa_tendency_ij( id, rs_p, rs, trs_m, i, j, i_omp_start, tn, ib, ic, flux_s, diss_s, &
7817                               flux_l, diss_l, rs_init, do_sedimentation )
7818
7819    USE advec_ws,                                                                                  &
7820        ONLY:  advec_s_ws
7821
7822    USE advec_s_pw_mod,                                                                            &
7823        ONLY:  advec_s_pw
7824
7825    USE advec_s_up_mod,                                                                            &
7826        ONLY:  advec_s_up
7827
7828    USE arrays_3d,                                                                                 &
7829        ONLY:  ddzu, rdf_sc, tend
7830
7831    USE diffusion_s_mod,                                                                           &
7832        ONLY:  diffusion_s
7833
7834    USE indices,                                                                                   &
7835        ONLY:  wall_flags_0
7836
7837    USE surface_mod,                                                                               &
7838        ONLY :  surf_def_h, surf_def_v, surf_lsm_h, surf_lsm_v, surf_usm_h, surf_usm_v
7839
7840    IMPLICIT NONE
7841
7842    CHARACTER(LEN = *) ::  id  !<
7843
7844    INTEGER(iwp) ::  i            !<
7845    INTEGER(iwp) ::  i_omp_start  !<
7846    INTEGER(iwp) ::  ib           !< loop index for aerosol number bin OR gas index
7847    INTEGER(iwp) ::  ic           !< loop index for aerosol mass bin
7848    INTEGER(iwp) ::  icc          !< (c-1)*nbins_aerosol+b
7849    INTEGER(iwp) ::  j            !<
7850    INTEGER(iwp) ::  k            !<
7851    INTEGER(iwp) ::  tn           !<
7852
7853    LOGICAL ::  do_sedimentation  !<
7854
7855    REAL(wp), DIMENSION(nzb:nzt+1) ::  rs_init  !<
7856
7857    REAL(wp), DIMENSION(nzb+1:nzt,0:threads_per_task-1) ::  diss_s  !<
7858    REAL(wp), DIMENSION(nzb+1:nzt,0:threads_per_task-1) ::  flux_s  !<
7859
7860    REAL(wp), DIMENSION(nzb+1:nzt,nys:nyn,0:threads_per_task-1) ::  diss_l  !<
7861    REAL(wp), DIMENSION(nzb+1:nzt,nys:nyn,0:threads_per_task-1) ::  flux_l  !<
7862
7863    REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ::  rs_p    !<
7864    REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ::  rs      !<
7865    REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ::  trs_m   !<
7866
7867    icc = ( ic - 1 ) * nbins_aerosol + ib
7868!
7869!-- Tendency-terms for reactive scalar
7870    tend(:,j,i) = 0.0_wp
7871!
7872!-- Advection terms
7873    IF ( timestep_scheme(1:5) == 'runge' )  THEN
7874       IF ( ws_scheme_sca )  THEN
7875          CALL advec_s_ws( salsa_advc_flags_s, i, j, rs, id, flux_s, diss_s, flux_l, diss_l,       &
7876                           i_omp_start, tn, bc_dirichlet_l  .OR.  bc_radiation_l,                  &
7877                           bc_dirichlet_n  .OR.  bc_radiation_n,                                   &
7878                           bc_dirichlet_r  .OR.  bc_radiation_r,                                   &
7879                           bc_dirichlet_s  .OR.  bc_radiation_s, monotonic_limiter_z )
7880       ELSE
7881          CALL advec_s_pw( i, j, rs )
7882       ENDIF
7883    ELSE
7884       CALL advec_s_up( i, j, rs )
7885    ENDIF
7886!
7887!-- Diffusion terms
7888    SELECT CASE ( id )
7889       CASE ( 'aerosol_number' )
7890          CALL diffusion_s( i, j, rs, surf_def_h(0)%answs(:,ib),                                   &
7891                                      surf_def_h(1)%answs(:,ib), surf_def_h(2)%answs(:,ib),        &
7892                                      surf_lsm_h%answs(:,ib),    surf_usm_h%answs(:,ib),           &
7893                                      surf_def_v(0)%answs(:,ib), surf_def_v(1)%answs(:,ib),        &
7894                                      surf_def_v(2)%answs(:,ib), surf_def_v(3)%answs(:,ib),        &
7895                                      surf_lsm_v(0)%answs(:,ib), surf_lsm_v(1)%answs(:,ib),        &
7896                                      surf_lsm_v(2)%answs(:,ib), surf_lsm_v(3)%answs(:,ib),        &
7897                                      surf_usm_v(0)%answs(:,ib), surf_usm_v(1)%answs(:,ib),        &
7898                                      surf_usm_v(2)%answs(:,ib), surf_usm_v(3)%answs(:,ib) )
7899       CASE ( 'aerosol_mass' )
7900          CALL diffusion_s( i, j, rs, surf_def_h(0)%amsws(:,icc),                                  &
7901                                      surf_def_h(1)%amsws(:,icc), surf_def_h(2)%amsws(:,icc),      &
7902                                      surf_lsm_h%amsws(:,icc),    surf_usm_h%amsws(:,icc),         &
7903                                      surf_def_v(0)%amsws(:,icc), surf_def_v(1)%amsws(:,icc),      &
7904                                      surf_def_v(2)%amsws(:,icc), surf_def_v(3)%amsws(:,icc),      &
7905                                      surf_lsm_v(0)%amsws(:,icc), surf_lsm_v(1)%amsws(:,icc),      &
7906                                      surf_lsm_v(2)%amsws(:,icc), surf_lsm_v(3)%amsws(:,icc),      &
7907                                      surf_usm_v(0)%amsws(:,icc), surf_usm_v(1)%amsws(:,icc),      &
7908                                      surf_usm_v(2)%amsws(:,icc), surf_usm_v(3)%amsws(:,icc) )
7909       CASE ( 'salsa_gas' )
7910          CALL diffusion_s( i, j, rs, surf_def_h(0)%gtsws(:,ib),                                   &
7911                                      surf_def_h(1)%gtsws(:,ib), surf_def_h(2)%gtsws(:,ib),        &
7912                                      surf_lsm_h%gtsws(:,ib), surf_usm_h%gtsws(:,ib),              &
7913                                      surf_def_v(0)%gtsws(:,ib), surf_def_v(1)%gtsws(:,ib),        &
7914                                      surf_def_v(2)%gtsws(:,ib), surf_def_v(3)%gtsws(:,ib),        &
7915                                      surf_lsm_v(0)%gtsws(:,ib), surf_lsm_v(1)%gtsws(:,ib),        &
7916                                      surf_lsm_v(2)%gtsws(:,ib), surf_lsm_v(3)%gtsws(:,ib),        &
7917                                      surf_usm_v(0)%gtsws(:,ib), surf_usm_v(1)%gtsws(:,ib),        &
7918                                      surf_usm_v(2)%gtsws(:,ib), surf_usm_v(3)%gtsws(:,ib) )
7919    END SELECT
7920!
7921!-- Sedimentation and prognostic equation for aerosol number and mass
7922    IF ( lsdepo  .AND.  do_sedimentation )  THEN
7923!DIR$ IVDEP
7924       DO  k = nzb+1, nzt
7925          tend(k,j,i) = tend(k,j,i) - MAX( 0.0_wp, ( rs(k+1,j,i) * sedim_vd(k+1,j,i,ib) -          &
7926                                                     rs(k,j,i) * sedim_vd(k,j,i,ib) ) * ddzu(k) )  &
7927                                    * MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_0(k-1,j,i), 0 ) )
7928          rs_p(k,j,i) = rs(k,j,i) + ( dt_3d * ( tsc(2) * tend(k,j,i) + tsc(3) * trs_m(k,j,i) )     &
7929                                      - tsc(5) * rdf_sc(k) * ( rs(k,j,i) - rs_init(k) ) )          &
7930                                  * MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_0(k,j,i), 0 ) )
7931          IF ( rs_p(k,j,i) < 0.0_wp )  rs_p(k,j,i) = 0.1_wp * rs(k,j,i)
7932       ENDDO
7933    ELSE
7934!
7935!--    Prognostic equation
7936!DIR$ IVDEP
7937       DO  k = nzb+1, nzt
7938          rs_p(k,j,i) = rs(k,j,i) + ( dt_3d * ( tsc(2) * tend(k,j,i) + tsc(3) * trs_m(k,j,i) )     &
7939                                                - tsc(5) * rdf_sc(k) * ( rs(k,j,i) - rs_init(k) ) )&
7940                                  * MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_0(k,j,i), 0 ) )
7941          IF ( rs_p(k,j,i) < 0.0_wp )  rs_p(k,j,i) = 0.1_wp * rs(k,j,i)
7942       ENDDO
7943    ENDIF
7944!
7945!-- Calculate tendencies for the next Runge-Kutta step
7946    IF ( timestep_scheme(1:5) == 'runge' )  THEN
7947       IF ( intermediate_timestep_count == 1 )  THEN
7948          DO  k = nzb+1, nzt
7949             trs_m(k,j,i) = tend(k,j,i)
7950          ENDDO
7951       ELSEIF ( intermediate_timestep_count < intermediate_timestep_count_max )  THEN
7952          DO  k = nzb+1, nzt
7953             trs_m(k,j,i) = -9.5625_wp * tend(k,j,i) + 5.3125_wp * trs_m(k,j,i)
7954          ENDDO
7955       ENDIF
7956    ENDIF
7957
7958 END SUBROUTINE salsa_tendency_ij
7959!
7960!------------------------------------------------------------------------------!
7961! Description:
7962! ------------
7963!> Calculate the tendencies for aerosol number and mass concentrations.
7964!> For vector machines.
7965!------------------------------------------------------------------------------!
7966 SUBROUTINE salsa_tendency( id, rs_p, rs, trs_m, ib, ic, rs_init, do_sedimentation )
7967
7968    USE advec_ws,                                                                                  &
7969        ONLY:  advec_s_ws
7970    USE advec_s_pw_mod,                                                                            &
7971        ONLY:  advec_s_pw
7972    USE advec_s_up_mod,                                                                            &
7973        ONLY:  advec_s_up
7974    USE arrays_3d,                                                                                 &
7975        ONLY:  ddzu, rdf_sc, tend
7976    USE diffusion_s_mod,                                                                           &
7977        ONLY:  diffusion_s
7978    USE indices,                                                                                   &
7979        ONLY:  wall_flags_0
7980    USE surface_mod,                                                                               &
7981        ONLY :  surf_def_h, surf_def_v, surf_lsm_h, surf_lsm_v, surf_usm_h, surf_usm_v
7982
7983    IMPLICIT NONE
7984
7985    CHARACTER(LEN = *) ::  id
7986
7987    INTEGER(iwp) ::  ib           !< loop index for aerosol number bin OR gas index
7988    INTEGER(iwp) ::  ic           !< loop index for aerosol mass bin
7989    INTEGER(iwp) ::  icc  !< (c-1)*nbins_aerosol+b
7990    INTEGER(iwp) ::  i    !<
7991    INTEGER(iwp) ::  j    !<
7992    INTEGER(iwp) ::  k    !<
7993
7994    LOGICAL ::  do_sedimentation  !<
7995
7996    REAL(wp), DIMENSION(nzb:nzt+1) ::  rs_init !<
7997
7998    REAL(wp), DIMENSION(:,:,:), POINTER ::  rs_p    !<
7999    REAL(wp), DIMENSION(:,:,:), POINTER ::  rs      !<
8000    REAL(wp), DIMENSION(:,:,:), POINTER ::  trs_m   !<
8001
8002    icc = ( ic - 1 ) * nbins_aerosol + ib
8003!
8004!-- Tendency-terms for reactive scalar
8005    tend = 0.0_wp
8006!
8007!-- Advection terms
8008    IF ( timestep_scheme(1:5) == 'runge' )  THEN
8009       IF ( ws_scheme_sca )  THEN
8010          CALL advec_s_ws( salsa_advc_flags_s, rs, id, bc_dirichlet_l  .OR.  bc_radiation_l,       &
8011                           bc_dirichlet_n  .OR.  bc_radiation_n,                                   &
8012                           bc_dirichlet_r  .OR.  bc_radiation_r,                                   &
8013                           bc_dirichlet_s  .OR.  bc_radiation_s )
8014       ELSE
8015          CALL advec_s_pw( rs )
8016       ENDIF
8017    ELSE
8018       CALL advec_s_up( rs )
8019    ENDIF
8020!
8021!-- Diffusion terms
8022    SELECT CASE ( id )
8023       CASE ( 'aerosol_number' )
8024          CALL diffusion_s( rs, surf_def_h(0)%answs(:,ib),                                         &
8025                                surf_def_h(1)%answs(:,ib), surf_def_h(2)%answs(:,ib),              &
8026                                surf_lsm_h%answs(:,ib),    surf_usm_h%answs(:,ib),                 &
8027                                surf_def_v(0)%answs(:,ib), surf_def_v(1)%answs(:,ib),              &
8028                                surf_def_v(2)%answs(:,ib), surf_def_v(3)%answs(:,ib),              &
8029                                surf_lsm_v(0)%answs(:,ib), surf_lsm_v(1)%answs(:,ib),              &
8030                                surf_lsm_v(2)%answs(:,ib), surf_lsm_v(3)%answs(:,ib),              &
8031                                surf_usm_v(0)%answs(:,ib), surf_usm_v(1)%answs(:,ib),              &
8032                                surf_usm_v(2)%answs(:,ib), surf_usm_v(3)%answs(:,ib) )
8033       CASE ( 'aerosol_mass' )
8034          CALL diffusion_s( rs, surf_def_h(0)%amsws(:,icc),                                        &
8035                                surf_def_h(1)%amsws(:,icc), surf_def_h(2)%amsws(:,icc),            &
8036                                surf_lsm_h%amsws(:,icc),    surf_usm_h%amsws(:,icc),               &
8037                                surf_def_v(0)%amsws(:,icc), surf_def_v(1)%amsws(:,icc),            &
8038                                surf_def_v(2)%amsws(:,icc), surf_def_v(3)%amsws(:,icc),            &
8039                                surf_lsm_v(0)%amsws(:,icc), surf_lsm_v(1)%amsws(:,icc),            &
8040                                surf_lsm_v(2)%amsws(:,icc), surf_lsm_v(3)%amsws(:,icc),            &
8041                                surf_usm_v(0)%amsws(:,icc), surf_usm_v(1)%amsws(:,icc),            &
8042                                surf_usm_v(2)%amsws(:,icc), surf_usm_v(3)%amsws(:,icc) )
8043       CASE ( 'salsa_gas' )
8044          CALL diffusion_s( rs, surf_def_h(0)%gtsws(:,ib),                                         &
8045                                surf_def_h(1)%gtsws(:,ib), surf_def_h(2)%gtsws(:,ib),              &
8046                                surf_lsm_h%gtsws(:,ib),    surf_usm_h%gtsws(:,ib),                 &
8047                                surf_def_v(0)%gtsws(:,ib), surf_def_v(1)%gtsws(:,ib),              &
8048                                surf_def_v(2)%gtsws(:,ib), surf_def_v(3)%gtsws(:,ib),              &
8049                                surf_lsm_v(0)%gtsws(:,ib), surf_lsm_v(1)%gtsws(:,ib),              &
8050                                surf_lsm_v(2)%gtsws(:,ib), surf_lsm_v(3)%gtsws(:,ib),              &
8051                                surf_usm_v(0)%gtsws(:,ib), surf_usm_v(1)%gtsws(:,ib),              &
8052                                surf_usm_v(2)%gtsws(:,ib), surf_usm_v(3)%gtsws(:,ib) )
8053    END SELECT
8054!
8055!-- Prognostic equation for a scalar
8056    DO  i = nxl, nxr
8057       DO  j = nys, nyn
8058!
8059!--       Sedimentation for aerosol number and mass
8060          IF ( lsdepo  .AND.  do_sedimentation )  THEN
8061             tend(nzb+1:nzt,j,i) = tend(nzb+1:nzt,j,i) - MAX( 0.0_wp, ( rs(nzb+2:nzt+1,j,i) *      &
8062                                   sedim_vd(nzb+2:nzt+1,j,i,ib) - rs(nzb+1:nzt,j,i) *              &
8063                                   sedim_vd(nzb+1:nzt,j,i,ib) ) * ddzu(nzb+1:nzt) ) *              &
8064                                   MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_0(nzb:nzt-1,j,i), 0 ) )
8065          ENDIF
8066          DO  k = nzb+1, nzt
8067             rs_p(k,j,i) = rs(k,j,i) +  ( dt_3d  * ( tsc(2) * tend(k,j,i) + tsc(3) * trs_m(k,j,i) )&
8068                                                  - tsc(5) * rdf_sc(k) * ( rs(k,j,i) - rs_init(k) )&
8069                                        ) * MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_0(k,j,i), 0 ) )
8070             IF ( rs_p(k,j,i) < 0.0_wp )  rs_p(k,j,i) = 0.1_wp * rs(k,j,i)
8071          ENDDO
8072       ENDDO
8073    ENDDO
8074!
8075!-- Calculate tendencies for the next Runge-Kutta step
8076    IF ( timestep_scheme(1:5) == 'runge' )  THEN
8077       IF ( intermediate_timestep_count == 1 )  THEN
8078          DO  i = nxl, nxr
8079             DO  j = nys, nyn
8080                DO  k = nzb+1, nzt
8081                   trs_m(k,j,i) = tend(k,j,i)
8082                ENDDO
8083             ENDDO
8084          ENDDO
8085       ELSEIF ( intermediate_timestep_count < intermediate_timestep_count_max )  THEN
8086          DO  i = nxl, nxr
8087             DO  j = nys, nyn
8088                DO  k = nzb+1, nzt
8089                   trs_m(k,j,i) =  -9.5625_wp * tend(k,j,i) + 5.3125_wp * trs_m(k,j,i)
8090                ENDDO
8091             ENDDO
8092          ENDDO
8093       ENDIF
8094    ENDIF
8095
8096 END SUBROUTINE salsa_tendency
8097
8098
8099!------------------------------------------------------------------------------!
8100! Description:
8101! ------------
8102!> Boundary conditions for prognostic variables in SALSA from module interface
8103!------------------------------------------------------------------------------!
8104 SUBROUTINE salsa_boundary_conditions
8105
8106    IMPLICIT NONE
8107
8108    INTEGER(iwp) ::  ib              !< index for aerosol size bins
8109    INTEGER(iwp) ::  ic              !< index for aerosol mass bins
8110    INTEGER(iwp) ::  icc             !< additional index for aerosol mass bins
8111    INTEGER(iwp) ::  ig              !< index for salsa gases
8112
8113
8114!
8115!-- moved from boundary_conds
8116    CALL salsa_boundary_conds
8117!
8118!-- Boundary conditions for prognostic quantitites of other modules:
8119!-- Here, only decycling is carried out
8120    IF ( time_since_reference_point >= skip_time_do_salsa )  THEN
8121
8122       DO  ib = 1, nbins_aerosol
8123          CALL salsa_boundary_conds( aerosol_number(ib)%conc_p, aerosol_number(ib)%init )
8124          DO  ic = 1, ncomponents_mass
8125             icc = ( ic - 1 ) * nbins_aerosol + ib
8126             CALL salsa_boundary_conds( aerosol_mass(icc)%conc_p, aerosol_mass(icc)%init )
8127          ENDDO
8128       ENDDO
8129       IF ( .NOT. salsa_gases_from_chem )  THEN
8130          DO  ig = 1, ngases_salsa
8131             CALL salsa_boundary_conds( salsa_gas(ig)%conc_p, salsa_gas(ig)%init )
8132          ENDDO
8133       ENDIF
8134
8135    ENDIF
8136
8137 END SUBROUTINE salsa_boundary_conditions
8138
8139!------------------------------------------------------------------------------!
8140! Description:
8141! ------------
8142!> Boundary conditions for prognostic variables in SALSA
8143!------------------------------------------------------------------------------!
8144 SUBROUTINE salsa_boundary_conds
8145
8146    USE arrays_3d,                                                                                 &
8147        ONLY:  dzu
8148
8149    USE surface_mod,                                                                               &
8150        ONLY :  bc_h
8151
8152    IMPLICIT NONE
8153
8154    INTEGER(iwp) ::  i    !< grid index x direction
8155    INTEGER(iwp) ::  ib   !< index for aerosol size bins
8156    INTEGER(iwp) ::  ic   !< index for chemical compounds in aerosols
8157    INTEGER(iwp) ::  icc  !< additional index for chemical compounds in aerosols
8158    INTEGER(iwp) ::  ig   !< idex for gaseous compounds
8159    INTEGER(iwp) ::  j    !< grid index y direction
8160    INTEGER(iwp) ::  k    !< grid index y direction
8161    INTEGER(iwp) ::  l    !< running index boundary type, for up- and downward-facing walls
8162    INTEGER(iwp) ::  m    !< running index surface elements
8163
8164    IF ( time_since_reference_point >= skip_time_do_salsa )  THEN
8165!
8166!--    Surface conditions:
8167       IF ( ibc_salsa_b == 0 )  THEN   ! Dirichlet
8168!
8169!--       Run loop over all non-natural and natural walls. Note, in wall-datatype the k coordinate
8170!--       belongs to the atmospheric grid point, therefore, set s_p at k-1
8171          DO  l = 0, 1
8172             !$OMP PARALLEL PRIVATE( ib, ic, icc, ig, i, j, k )
8173             !$OMP DO
8174             DO  m = 1, bc_h(l)%ns
8175
8176                i = bc_h(l)%i(m)
8177                j = bc_h(l)%j(m)
8178                k = bc_h(l)%k(m)
8179
8180                DO  ib = 1, nbins_aerosol
8181                   aerosol_number(ib)%conc_p(k+bc_h(l)%koff,j,i) =             &
8182                                    aerosol_number(ib)%conc(k+bc_h(l)%koff,j,i)
8183                   DO  ic = 1, ncomponents_mass
8184                      icc = ( ic - 1 ) * nbins_aerosol + ib
8185                      aerosol_mass(icc)%conc_p(k+bc_h(l)%koff,j,i) =           &
8186                                    aerosol_mass(icc)%conc(k+bc_h(l)%koff,j,i)
8187                   ENDDO
8188                ENDDO
8189                IF ( .NOT. salsa_gases_from_chem )  THEN
8190                   DO  ig = 1, ngases_salsa
8191                      salsa_gas(ig)%conc_p(k+bc_h(l)%koff,j,i) =               &
8192                                    salsa_gas(ig)%conc(k+bc_h(l)%koff,j,i)
8193                   ENDDO
8194                ENDIF
8195
8196             ENDDO
8197             !$OMP END PARALLEL
8198
8199          ENDDO
8200
8201       ELSE   ! Neumann
8202
8203          DO l = 0, 1
8204             !$OMP PARALLEL PRIVATE( ib, ic, icc, ig, i, j, k )
8205             !$OMP DO
8206             DO  m = 1, bc_h(l)%ns
8207
8208                i = bc_h(l)%i(m)
8209                j = bc_h(l)%j(m)
8210                k = bc_h(l)%k(m)
8211
8212                DO  ib = 1, nbins_aerosol
8213                   aerosol_number(ib)%conc_p(k+bc_h(l)%koff,j,i) =             &
8214                                               aerosol_number(ib)%conc_p(k,j,i)
8215                   DO  ic = 1, ncomponents_mass
8216                      icc = ( ic - 1 ) * nbins_aerosol + ib
8217                      aerosol_mass(icc)%conc_p(k+bc_h(l)%koff,j,i) =           &
8218                                               aerosol_mass(icc)%conc_p(k,j,i)
8219                   ENDDO
8220                ENDDO
8221                IF ( .NOT. salsa_gases_from_chem ) THEN
8222                   DO  ig = 1, ngases_salsa
8223                      salsa_gas(ig)%conc_p(k+bc_h(l)%koff,j,i) =               &
8224                                               salsa_gas(ig)%conc_p(k,j,i)
8225                   ENDDO
8226                ENDIF
8227
8228             ENDDO
8229             !$OMP END PARALLEL
8230          ENDDO
8231
8232       ENDIF
8233!
8234!--   Top boundary conditions:
8235       IF ( ibc_salsa_t == 0 )  THEN   ! Dirichlet
8236
8237          DO  ib = 1, nbins_aerosol
8238             aerosol_number(ib)%conc_p(nzt+1,:,:) = aerosol_number(ib)%conc(nzt+1,:,:)
8239             DO  ic = 1, ncomponents_mass
8240                icc = ( ic - 1 ) * nbins_aerosol + ib
8241                aerosol_mass(icc)%conc_p(nzt+1,:,:) = aerosol_mass(icc)%conc(nzt+1,:,:)
8242             ENDDO
8243          ENDDO
8244          IF ( .NOT. salsa_gases_from_chem )  THEN
8245             DO  ig = 1, ngases_salsa
8246                salsa_gas(ig)%conc_p(nzt+1,:,:) = salsa_gas(ig)%conc(nzt+1,:,:)
8247             ENDDO
8248          ENDIF
8249
8250       ELSEIF ( ibc_salsa_t == 1 )  THEN   ! Neumann
8251
8252          DO  ib = 1, nbins_aerosol
8253             aerosol_number(ib)%conc_p(nzt+1,:,:) = aerosol_number(ib)%conc_p(nzt,:,:)
8254             DO  ic = 1, ncomponents_mass
8255                icc = ( ic - 1 ) * nbins_aerosol + ib
8256                aerosol_mass(icc)%conc_p(nzt+1,:,:) = aerosol_mass(icc)%conc_p(nzt,:,:)
8257             ENDDO
8258          ENDDO
8259          IF ( .NOT. salsa_gases_from_chem )  THEN
8260             DO  ig = 1, ngases_salsa
8261                salsa_gas(ig)%conc_p(nzt+1,:,:) = salsa_gas(ig)%conc_p(nzt,:,:)
8262             ENDDO
8263          ENDIF
8264
8265       ELSEIF ( ibc_salsa_t == 2 )  THEN   ! Initial gradient
8266
8267          DO  ib = 1, nbins_aerosol
8268             aerosol_number(ib)%conc_p(nzt+1,:,:) = aerosol_number(ib)%conc_p(nzt,:,:) +           &
8269                                                    bc_an_t_val(ib) * dzu(nzt+1)
8270             DO  ic = 1, ncomponents_mass
8271                icc = ( ic - 1 ) * nbins_aerosol + ib
8272                aerosol_mass(icc)%conc_p(nzt+1,:,:) = aerosol_mass(icc)%conc_p(nzt,:,:) +          &
8273                                                      bc_am_t_val(icc) * dzu(nzt+1)
8274             ENDDO
8275          ENDDO
8276          IF ( .NOT. salsa_gases_from_chem )  THEN
8277             DO  ig = 1, ngases_salsa
8278                salsa_gas(ig)%conc_p(nzt+1,:,:) = salsa_gas(ig)%conc_p(nzt,:,:) +                  &
8279                                                  bc_gt_t_val(ig) * dzu(nzt+1)
8280             ENDDO
8281          ENDIF
8282
8283       ENDIF
8284!
8285!--    Lateral boundary conditions at the outflow
8286       IF ( bc_radiation_s )  THEN
8287          DO  ib = 1, nbins_aerosol
8288             aerosol_number(ib)%conc_p(:,nys-1,:) = aerosol_number(ib)%conc_p(:,nys,:)
8289             DO  ic = 1, ncomponents_mass
8290                icc = ( ic - 1 ) * nbins_aerosol + ib
8291                aerosol_mass(icc)%conc_p(:,nys-1,:) = aerosol_mass(icc)%conc_p(:,nys,:)
8292             ENDDO
8293          ENDDO
8294          IF ( .NOT. salsa_gases_from_chem )  THEN
8295             DO  ig = 1, ngases_salsa
8296                salsa_gas(ig)%conc_p(:,nys-1,:) = salsa_gas(ig)%conc_p(:,nys,:)
8297             ENDDO
8298          ENDIF
8299
8300       ELSEIF ( bc_radiation_n )  THEN
8301          DO  ib = 1, nbins_aerosol
8302             aerosol_number(ib)%conc_p(:,nyn+1,:) = aerosol_number(ib)%conc_p(:,nyn,:)
8303             DO  ic = 1, ncomponents_mass
8304                icc = ( ic - 1 ) * nbins_aerosol + ib
8305                aerosol_mass(icc)%conc_p(:,nyn+1,:) = aerosol_mass(icc)%conc_p(:,nyn,:)
8306             ENDDO
8307          ENDDO
8308          IF ( .NOT. salsa_gases_from_chem )  THEN
8309             DO  ig = 1, ngases_salsa
8310                salsa_gas(ig)%conc_p(:,nyn+1,:) = salsa_gas(ig)%conc_p(:,nyn,:)
8311             ENDDO
8312          ENDIF
8313
8314       ELSEIF ( bc_radiation_l )  THEN
8315          DO  ib = 1, nbins_aerosol
8316             aerosol_number(ib)%conc_p(:,:,nxl-1) = aerosol_number(ib)%conc_p(:,:,nxl)
8317             DO  ic = 1, ncomponents_mass
8318                icc = ( ic - 1 ) * nbins_aerosol + ib
8319                aerosol_mass(icc)%conc_p(:,:,nxl-1) = aerosol_mass(icc)%conc_p(:,:,nxl)
8320             ENDDO
8321          ENDDO
8322          IF ( .NOT. salsa_gases_from_chem )  THEN
8323             DO  ig = 1, ngases_salsa
8324                salsa_gas(ig)%conc_p(:,:,nxl-1) = salsa_gas(ig)%conc_p(:,:,nxl)
8325             ENDDO
8326          ENDIF
8327
8328       ELSEIF ( bc_radiation_r )  THEN
8329          DO  ib = 1, nbins_aerosol
8330             aerosol_number(ib)%conc_p(:,:,nxr+1) = aerosol_number(ib)%conc_p(:,:,nxr)
8331             DO  ic = 1, ncomponents_mass
8332                icc = ( ic - 1 ) * nbins_aerosol + ib
8333                aerosol_mass(icc)%conc_p(:,:,nxr+1) = aerosol_mass(icc)%conc_p(:,:,nxr)
8334             ENDDO
8335          ENDDO
8336          IF ( .NOT. salsa_gases_from_chem )  THEN
8337             DO  ig = 1, ngases_salsa
8338                salsa_gas(ig)%conc_p(:,:,nxr+1) = salsa_gas(ig)%conc_p(:,:,nxr)
8339             ENDDO
8340          ENDIF
8341
8342       ENDIF
8343
8344    ENDIF
8345
8346 END SUBROUTINE salsa_boundary_conds
8347
8348!------------------------------------------------------------------------------!
8349! Description:
8350! ------------
8351! Undoing of the previously done cyclic boundary conditions.
8352!------------------------------------------------------------------------------!
8353 SUBROUTINE salsa_boundary_conds_decycle ( sq, sq_init )
8354
8355    USE control_parameters,                                                                        &
8356        ONLY:  nesting_offline
8357
8358    IMPLICIT NONE
8359
8360    INTEGER(iwp) ::  boundary  !<
8361    INTEGER(iwp) ::  ee        !<
8362    INTEGER(iwp) ::  copied    !<
8363    INTEGER(iwp) ::  i         !<
8364    INTEGER(iwp) ::  j         !<
8365    INTEGER(iwp) ::  k         !<
8366    INTEGER(iwp) ::  ss        !<
8367
8368    REAL(wp) ::  flag  !< flag to mask topography grid points
8369
8370    REAL(wp), DIMENSION(nzb:nzt+1) ::  sq_init  !< initial concentration profile
8371
8372    REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ::  sq  !< concentration array
8373
8374    flag = 0.0_wp
8375!
8376!-- Skip input if forcing from a larger-scale models is applied.
8377    IF ( nesting_offline  .AND.  nesting_offline_salsa )  RETURN
8378!
8379!-- Left and right boundaries
8380    IF ( decycle_salsa_lr  .AND.  ( bc_lr_cyc  .OR. bc_lr == 'nested' ) )  THEN
8381
8382       DO  boundary = 1, 2
8383
8384          IF ( decycle_method_salsa(boundary) == 'dirichlet' )  THEN
8385!
8386!--          Initial profile is copied to ghost and first three layers
8387             ss = 1
8388             ee = 0
8389             IF ( boundary == 1  .AND.  nxl == 0 )  THEN
8390                ss = nxlg
8391                ee = nxl-1
8392             ELSEIF ( boundary == 2  .AND.  nxr == nx )  THEN
8393                ss = nxr+1
8394                ee = nxrg
8395             ENDIF
8396
8397             DO  i = ss, ee
8398                DO  j = nysg, nyng
8399                   DO  k = nzb+1, nzt
8400                      flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_0(k,j,i), 0 ) )
8401                      sq(k,j,i) = sq_init(k) * flag
8402                   ENDDO
8403                ENDDO
8404             ENDDO
8405
8406          ELSEIF ( decycle_method_salsa(boundary) == 'neumann' )  THEN
8407!
8408!--          The value at the boundary is copied to the ghost layers to simulate an outlet with
8409!--          zero gradient
8410             ss = 1
8411             ee = 0
8412             IF ( boundary == 1  .AND.  nxl == 0 )  THEN
8413                ss = nxlg
8414                ee = nxl-1
8415                copied = nxl
8416             ELSEIF ( boundary == 2  .AND.  nxr == nx )  THEN
8417                ss = nxr+1
8418                ee = nxrg
8419                copied = nxr
8420             ENDIF
8421
8422              DO  i = ss, ee
8423                DO  j = nysg, nyng
8424                   DO  k = nzb+1, nzt
8425                      flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_0(k,j,i), 0 ) )
8426                      sq(k,j,i) = sq(k,j,copied) * flag
8427                   ENDDO
8428                ENDDO
8429             ENDDO
8430
8431          ELSE
8432             WRITE(message_string,*) 'unknown decycling method: decycle_method_salsa (', boundary, &
8433                                     ') ="' // TRIM( decycle_method_salsa(boundary) ) // '"'
8434             CALL message( 'salsa_boundary_conds_decycle', 'PA0626', 1, 2, 0, 6, 0 )
8435          ENDIF
8436       ENDDO
8437    ENDIF
8438
8439!
8440!-- South and north boundaries
8441     IF ( decycle_salsa_ns  .AND.  ( bc_ns_cyc  .OR. bc_ns == 'nested' ) )  THEN
8442
8443       DO  boundary = 3, 4
8444
8445          IF ( decycle_method_salsa(boundary) == 'dirichlet' )  THEN
8446!
8447!--          Initial profile is copied to ghost and first three layers
8448             ss = 1
8449             ee = 0
8450             IF ( boundary == 3  .AND.  nys == 0 )  THEN
8451                ss = nysg
8452                ee = nys-1
8453             ELSEIF ( boundary == 4  .AND.  nyn == ny )  THEN
8454                ss = nyn+1
8455                ee = nyng
8456             ENDIF
8457
8458             DO  i = nxlg, nxrg
8459                DO  j = ss, ee
8460                   DO  k = nzb+1, nzt
8461                      flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_0(k,j,i), 0 ) )
8462                      sq(k,j,i) = sq_init(k) * flag
8463                   ENDDO
8464                ENDDO
8465             ENDDO
8466
8467          ELSEIF ( decycle_method_salsa(boundary) == 'neumann' )  THEN
8468!
8469!--          The value at the boundary is copied to the ghost layers to simulate an outlet with
8470!--          zero gradient
8471             ss = 1
8472             ee = 0
8473             IF ( boundary == 3  .AND.  nys == 0 )  THEN
8474                ss = nysg
8475                ee = nys-1
8476                copied = nys
8477             ELSEIF ( boundary == 4  .AND.  nyn == ny )  THEN
8478                ss = nyn+1
8479                ee = nyng
8480                copied = nyn
8481             ENDIF
8482
8483              DO  i = nxlg, nxrg
8484                DO  j = ss, ee
8485                   DO  k = nzb+1, nzt
8486                      flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_0(k,j,i), 0 ) )
8487                      sq(k,j,i) = sq(k,copied,i) * flag
8488                   ENDDO
8489                ENDDO
8490             ENDDO
8491
8492          ELSE
8493             WRITE(message_string,*) 'unknown decycling method: decycle_method_salsa (', boundary, &
8494                                     ') ="' // TRIM( decycle_method_salsa(boundary) ) // '"'
8495             CALL message( 'salsa_boundary_conds_decycle', 'PA0627', 1, 2, 0, 6, 0 )
8496          ENDIF
8497       ENDDO
8498    ENDIF
8499
8500 END SUBROUTINE salsa_boundary_conds_decycle
8501
8502!------------------------------------------------------------------------------!
8503! Description:
8504! ------------
8505!> Calculates the total dry or wet mass concentration for individual bins
8506!> Juha Tonttila (FMI) 2015
8507!> Tomi Raatikainen (FMI) 2016
8508!------------------------------------------------------------------------------!
8509 SUBROUTINE bin_mixrat( itype, ibin, i, j, mconc )
8510
8511    IMPLICIT NONE
8512
8513    CHARACTER(len=*), INTENT(in) ::  itype  !< 'dry' or 'wet'
8514
8515    INTEGER(iwp) ::  ic                 !< loop index for mass bin number
8516    INTEGER(iwp) ::  iend               !< end index: include water or not
8517
8518    INTEGER(iwp), INTENT(in) ::  ibin   !< index of the chemical component
8519    INTEGER(iwp), INTENT(in) ::  i      !< loop index for x-direction
8520    INTEGER(iwp), INTENT(in) ::  j      !< loop index for y-direction
8521
8522    REAL(wp), DIMENSION(:), INTENT(out) ::  mconc  !< total dry or wet mass concentration
8523
8524!-- Number of components
8525    IF ( itype == 'dry' )  THEN
8526       iend = prtcl%ncomp - 1 
8527    ELSE IF ( itype == 'wet' )  THEN
8528       iend = prtcl%ncomp
8529    ELSE
8530       message_string = 'Error in itype!'
8531       CALL message( 'bin_mixrat', 'PA0628', 2, 2, 0, 6, 0 )
8532    ENDIF
8533
8534    mconc = 0.0_wp
8535
8536    DO  ic = ibin, iend*nbins_aerosol+ibin, nbins_aerosol !< every nbins'th element
8537       mconc = mconc + aerosol_mass(ic)%conc(:,j,i)
8538    ENDDO
8539
8540 END SUBROUTINE bin_mixrat
8541
8542!------------------------------------------------------------------------------!
8543! Description:
8544! ------------
8545!> Sets surface fluxes
8546!------------------------------------------------------------------------------!
8547 SUBROUTINE salsa_emission_update
8548
8549    USE palm_date_time_mod,                                                                        &
8550        ONLY:  get_date_time
8551
8552    IMPLICIT NONE
8553
8554    IF ( include_emission )  THEN
8555
8556       IF ( time_since_reference_point >= skip_time_do_salsa  )  THEN
8557!
8558!--       Get time_utc_init from origin_date_time
8559          CALL get_date_time( 0.0_wp, second_of_day = time_utc_init )
8560
8561          IF ( next_aero_emission_update <=                                                        &
8562               MAX( time_since_reference_point, 0.0_wp ) + time_utc_init )  THEN
8563             CALL salsa_emission_setup( .FALSE. )
8564          ENDIF
8565
8566          IF ( next_gas_emission_update <=                                                         &
8567               MAX( time_since_reference_point, 0.0_wp ) + time_utc_init )  THEN
8568             IF ( salsa_emission_mode == 'read_from_file'  .AND.  .NOT. salsa_gases_from_chem )    &
8569             THEN
8570                CALL salsa_gas_emission_setup( .FALSE. )
8571             ENDIF
8572          ENDIF
8573
8574       ENDIF
8575    ENDIF
8576
8577 END SUBROUTINE salsa_emission_update
8578
8579!------------------------------------------------------------------------------!
8580!> Description:
8581!> ------------
8582!> Define aerosol fluxes: constant or read from a from file
8583!> @todo - Emission stack height is not used yet. For default mode, emissions
8584!>         are assumed to occur on upward facing horizontal surfaces.
8585!------------------------------------------------------------------------------!
8586 SUBROUTINE salsa_emission_setup( init )
8587
8588    USE netcdf_data_input_mod,                                                                     &
8589        ONLY:  check_existence, close_input_file, get_attribute, get_variable,                     &
8590               inquire_num_variables, inquire_variable_names,                                      &
8591               get_dimension_length, open_read_file, street_type_f
8592
8593    USE palm_date_time_mod,                                                                        &
8594        ONLY:  days_per_week, get_date_time, hours_per_day, months_per_year, seconds_per_hour
8595
8596    USE surface_mod,                                                                               &
8597        ONLY:  surf_def_h, surf_lsm_h, surf_usm_h
8598
8599    IMPLICIT NONE
8600
8601    CHARACTER(LEN=80) ::  daytype = 'workday'  !< default day type
8602    CHARACTER(LEN=25) ::  in_name              !< name of a gas in the input file
8603    CHARACTER(LEN=25) ::  mod_name             !< name in the input file
8604
8605    INTEGER(iwp) ::  day_of_month   !< day of the month
8606    INTEGER(iwp) ::  day_of_week    !< day of the week
8607    INTEGER(iwp) ::  day_of_year    !< day of the year
8608    INTEGER(iwp) ::  hour_of_day    !< hour of the day
8609    INTEGER(iwp) ::  i              !< loop index
8610    INTEGER(iwp) ::  ib             !< loop index: aerosol number bins
8611    INTEGER(iwp) ::  ic             !< loop index: aerosol chemical components
8612    INTEGER(iwp) ::  id_salsa       !< NetCDF id of aerosol emission input file
8613    INTEGER(iwp) ::  in             !< loop index: emission category
8614    INTEGER(iwp) ::  index_dd       !< index day
8615    INTEGER(iwp) ::  index_hh       !< index hour
8616    INTEGER(iwp) ::  index_mm       !< index month
8617    INTEGER(iwp) ::  inn            !< loop index
8618    INTEGER(iwp) ::  j              !< loop index
8619    INTEGER(iwp) ::  month_of_year  !< month of the year
8620    INTEGER(iwp) ::  ss             !< loop index
8621
8622    INTEGER(iwp), DIMENSION(maxspec) ::  cc_i2m   !<
8623
8624    LOGICAL  ::  netcdf_extend = .FALSE.  !< NetCDF input file exists
8625
8626    LOGICAL, INTENT(in) ::  init  !< if .TRUE. --> initialisation call
8627
8628    REAL(wp) ::  second_of_day  !< second of the day
8629
8630    REAL(wp), DIMENSION(24) ::  par_emis_time_factor =  & !< time factors for the parameterized mode
8631                                                      (/ 0.009, 0.004, 0.004, 0.009, 0.029, 0.039, &
8632                                                         0.056, 0.053, 0.051, 0.051, 0.052, 0.055, &
8633                                                         0.059, 0.061, 0.064, 0.067, 0.069, 0.069, &
8634                                                         0.049, 0.039, 0.039, 0.029, 0.024, 0.019 /)
8635
8636    REAL(wp), DIMENSION(:), ALLOCATABLE ::  nsect_emission  !< sectional number emission
8637
8638    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  source_array  !< temporary source array
8639
8640!
8641!-- Define emissions:
8642    SELECT CASE ( salsa_emission_mode )
8643
8644       CASE ( 'uniform', 'parameterized' )
8645
8646          IF ( init )  THEN  ! Do only once
8647!
8648!-           Form a sectional size distribution for the emissions
8649             ALLOCATE( nsect_emission(1:nbins_aerosol),                                            &
8650                       source_array(nys:nyn,nxl:nxr,1:nbins_aerosol) )
8651!
8652!--          Precalculate a size distribution for the emission based on the mean diameter, standard
8653!--          deviation and number concentration per each log-normal mode
8654             CALL size_distribution( surface_aerosol_flux, aerosol_flux_dpg, aerosol_flux_sigmag,  &
8655                                     nsect_emission )
8656             IF ( salsa_emission_mode == 'uniform' )  THEN
8657                DO  ib = 1, nbins_aerosol
8658                   source_array(:,:,ib) = nsect_emission(ib)
8659                ENDDO
8660             ELSE
8661!
8662!--             Get a time factor for the specific hour
8663                IF ( .NOT.  ALLOCATED( aero_emission_att%time_factor ) )                           &
8664                   ALLOCATE( aero_emission_att%time_factor(1) )
8665                CALL get_date_time( MAX( time_since_reference_point, 0.0_wp ), hour=hour_of_day )
8666                index_hh = hour_of_day
8667                aero_emission_att%time_factor(1) = par_emis_time_factor(index_hh+1)
8668
8669                IF ( street_type_f%from_file )  THEN
8670                   DO  i = nxl, nxr
8671                      DO  j = nys, nyn
8672                         IF ( street_type_f%var(j,i) >= main_street_id  .AND.                      &
8673                              street_type_f%var(j,i) < max_street_id )  THEN
8674                            source_array(j,i,:) = nsect_emission(:) * emiss_factor_main *          &
8675                                                  aero_emission_att%time_factor(1)
8676                         ELSEIF ( street_type_f%var(j,i) >= side_street_id  .AND.                  &
8677                                  street_type_f%var(j,i) < main_street_id )  THEN
8678                            source_array(j,i,:) = nsect_emission(:) * emiss_factor_side *          &
8679                                                  aero_emission_att%time_factor(1)
8680                         ENDIF
8681                      ENDDO
8682                   ENDDO
8683                ELSE
8684                   WRITE( message_string, * ) 'salsa_emission_mode = "parameterized" but the '//  &
8685                                              'street_type data is missing.'
8686                   CALL message( 'salsa_emission_setup', 'PA0661', 1, 2, 0, 6, 0 )
8687                ENDIF
8688             ENDIF
8689!
8690!--          Check which chemical components are used
8691             cc_i2m = 0
8692             IF ( index_so4 > 0 ) cc_i2m(1) = index_so4
8693             IF ( index_oc > 0 )  cc_i2m(2) = index_oc
8694             IF ( index_bc > 0 )  cc_i2m(3) = index_bc
8695             IF ( index_du > 0 )  cc_i2m(4) = index_du
8696             IF ( index_ss > 0 )  cc_i2m(5) = index_ss
8697             IF ( index_no > 0 )  cc_i2m(6) = index_no
8698             IF ( index_nh > 0 )  cc_i2m(7) = index_nh
8699!
8700!--          Normalise mass fractions so that their sum is 1
8701             aerosol_flux_mass_fracs_a = aerosol_flux_mass_fracs_a /                               &
8702                                         SUM( aerosol_flux_mass_fracs_a(1:ncc ) )
8703             IF ( salsa_emission_mode ==  'uniform' )  THEN
8704!
8705!--             Set uniform fluxes of default horizontal surfaces
8706                CALL set_flux( surf_def_h(0), cc_i2m, aerosol_flux_mass_fracs_a, source_array )
8707             ELSE
8708!
8709!--             Set fluxes normalised based on the street type on land surfaces
8710                CALL set_flux( surf_lsm_h, cc_i2m, aerosol_flux_mass_fracs_a, source_array )
8711             ENDIF
8712
8713             DEALLOCATE( nsect_emission, source_array )
8714          ENDIF
8715
8716       CASE ( 'read_from_file' )
8717!
8718!--       Reset surface fluxes
8719          surf_def_h(0)%answs = 0.0_wp
8720          surf_def_h(0)%amsws = 0.0_wp
8721          surf_lsm_h%answs = 0.0_wp
8722          surf_lsm_h%amsws = 0.0_wp
8723          surf_usm_h%answs = 0.0_wp
8724          surf_usm_h%amsws = 0.0_wp
8725
8726!
8727!--       Reset source arrays:
8728          DO  ib = 1, nbins_aerosol
8729             aerosol_number(ib)%source = 0.0_wp
8730          ENDDO
8731
8732          DO  ic = 1, ncomponents_mass * nbins_aerosol
8733             aerosol_mass(ic)%source = 0.0_wp
8734          ENDDO
8735
8736#if defined( __netcdf )
8737!
8738!--       Check existence of PIDS_SALSA file
8739          INQUIRE( FILE = TRIM( input_file_salsa ) // TRIM( coupling_char ), EXIST = netcdf_extend )
8740          IF ( .NOT. netcdf_extend )  THEN
8741             message_string = 'Input file '// TRIM( input_file_salsa ) //  TRIM( coupling_char )&
8742                              // ' missing!'
8743             CALL message( 'salsa_emission_setup', 'PA0629', 1, 2, 0, 6, 0 )
8744          ENDIF
8745!
8746!--       Open file in read-only mode
8747          CALL open_read_file( TRIM( input_file_salsa ) // TRIM( coupling_char ), id_salsa )
8748
8749          IF ( init )  THEN
8750!
8751!--          Variable names
8752             CALL inquire_num_variables( id_salsa, aero_emission_att%num_vars )
8753             ALLOCATE( aero_emission_att%var_names(1:aero_emission_att%num_vars) )
8754             CALL inquire_variable_names( id_salsa, aero_emission_att%var_names )
8755!
8756!--          Read the index and name of chemical components
8757             CALL get_dimension_length( id_salsa, aero_emission_att%ncc, 'composition_index' )
8758             ALLOCATE( aero_emission_att%cc_index(1:aero_emission_att%ncc) )
8759             CALL get_variable( id_salsa, 'composition_index', aero_emission_att%cc_index )
8760
8761             IF ( check_existence( aero_emission_att%var_names, 'composition_name' ) )  THEN
8762                CALL get_variable( id_salsa, 'composition_name', aero_emission_att%cc_name,        &
8763                                   aero_emission_att%ncc )
8764             ELSE
8765                message_string = 'Missing composition_name in ' // TRIM( input_file_salsa )
8766                CALL message( 'salsa_emission_setup', 'PA0657', 1, 2, 0, 6, 0 )
8767             ENDIF
8768!
8769!--          Find the corresponding chemical components in the model
8770             aero_emission_att%cc_in2mod = 0
8771             DO  ic = 1, aero_emission_att%ncc
8772                in_name = aero_emission_att%cc_name(ic)
8773                SELECT CASE ( TRIM( in_name ) )
8774                   CASE ( 'H2SO4', 'h2so4', 'SO4', 'so4' )
8775                      aero_emission_att%cc_in2mod(1) = ic
8776                   CASE ( 'OC', 'oc', 'organics' )
8777                      aero_emission_att%cc_in2mod(2) = ic
8778                   CASE ( 'BC', 'bc' )
8779                      aero_emission_att%cc_in2mod(3) = ic
8780                   CASE ( 'DU', 'du' )
8781                      aero_emission_att%cc_in2mod(4) = ic
8782                   CASE ( 'SS', 'ss' )
8783                      aero_emission_att%cc_in2mod(5) = ic
8784                   CASE ( 'HNO3', 'hno3', 'NO', 'no', 'NO3', 'no3' )
8785                      aero_emission_att%cc_in2mod(6) = ic
8786                   CASE ( 'NH3', 'nh3', 'NH', 'nh', 'NH4', 'nh4' )
8787                      aero_emission_att%cc_in2mod(7) = ic
8788                END SELECT
8789
8790             ENDDO
8791
8792             IF ( SUM( aero_emission_att%cc_in2mod ) == 0 )  THEN
8793                message_string = 'None of the aerosol chemical components in ' // TRIM(            &
8794                                 input_file_salsa ) // ' correspond to the ones applied in SALSA.'
8795                CALL message( 'salsa_emission_setup', 'PA0630', 1, 2, 0, 6, 0 )
8796             ENDIF
8797!
8798!--          Get number of emission categories
8799             CALL get_dimension_length( id_salsa, aero_emission_att%ncat, 'ncat' )
8800!
8801!--          Get the chemical composition (i.e. mass fraction of different species) in aerosols
8802             IF ( check_existence( aero_emission_att%var_names, 'emission_mass_fracs' ) )  THEN
8803                ALLOCATE( aero_emission%mass_fracs(1:aero_emission_att%ncat,                       &
8804                                                   1:aero_emission_att%ncc) )
8805                CALL get_variable( id_salsa, 'emission_mass_fracs', aero_emission%mass_fracs,      &
8806                                   0, aero_emission_att%ncc-1, 0, aero_emission_att%ncat-1 )
8807             ELSE
8808                message_string = 'Missing emission_mass_fracs in ' //  TRIM( input_file_salsa )
8809                CALL message( 'salsa_emission_setup', 'PA0659', 1, 2, 0, 6, 0 )
8810             ENDIF
8811!
8812!--          If the chemical component is not activated, set its mass fraction to 0 to avoid
8813!--          inbalance between number and mass flux
8814             cc_i2m = aero_emission_att%cc_in2mod
8815             IF ( index_so4 < 0  .AND.  cc_i2m(1) > 0 )                                            &
8816                aero_emission%mass_fracs(:,cc_i2m(1)) = 0.0_wp
8817             IF ( index_oc  < 0  .AND.  cc_i2m(2) > 0 )                                            &
8818                aero_emission%mass_fracs(:,cc_i2m(2)) = 0.0_wp
8819             IF ( index_bc  < 0  .AND.  cc_i2m(3) > 0 )                                            &
8820                aero_emission%mass_fracs(:,cc_i2m(3)) = 0.0_wp
8821             IF ( index_du  < 0  .AND.  cc_i2m(4) > 0 )                                            &
8822                aero_emission%mass_fracs(:,cc_i2m(4)) = 0.0_wp
8823             IF ( index_ss  < 0  .AND.  cc_i2m(5) > 0 )                                            &
8824                aero_emission%mass_fracs(:,cc_i2m(5)) = 0.0_wp
8825             IF ( index_no  < 0  .AND.  cc_i2m(6) > 0 )                                            &
8826                aero_emission%mass_fracs(:,cc_i2m(6)) = 0.0_wp
8827             IF ( index_nh  < 0  .AND.  cc_i2m(7) > 0 )                                            &
8828                aero_emission%mass_fracs(:,cc_i2m(7)) = 0.0_wp
8829!
8830!--          Then normalise the mass fraction so that SUM = 1
8831             DO  in = 1, aero_emission_att%ncat
8832                aero_emission%mass_fracs(in,:) = aero_emission%mass_fracs(in,:) /                  &
8833                                                 SUM( aero_emission%mass_fracs(in,:) )
8834             ENDDO
8835!
8836!--          Inquire the fill value
8837             CALL get_attribute( id_salsa, '_FillValue', aero_emission%fill, .FALSE.,              &
8838                                 'aerosol_emission_values' )
8839!
8840!--          Inquire units of emissions
8841             CALL get_attribute( id_salsa, 'units', aero_emission_att%units, .FALSE.,              &
8842                                 'aerosol_emission_values' )
8843!
8844!--          Inquire the level of detail (lod)
8845             CALL get_attribute( id_salsa, 'lod', aero_emission_att%lod, .FALSE.,                  &
8846                                 'aerosol_emission_values' )
8847
8848!
8849!--          Read different emission information depending on the level of detail of emissions:
8850
8851!
8852!--          Default mode:
8853             IF ( aero_emission_att%lod == 1 )  THEN
8854!
8855!--             Unit conversion factor: convert to SI units (kg/m2/s)
8856                IF ( aero_emission_att%units == 'kg/m2/yr' )  THEN
8857                   aero_emission_att%conversion_factor = 1.0_wp / 3600.0_wp
8858                ELSEIF ( aero_emission_att%units == 'g/m2/yr' )  THEN
8859                   aero_emission_att%conversion_factor = 0.001_wp / 3600.0_wp
8860                ELSE
8861                   message_string = 'unknown unit for aerosol emissions: ' //                      &
8862                                    TRIM( aero_emission_att%units ) // ' (lod1)'
8863                   CALL message( 'salsa_emission_setup','PA0631', 1, 2, 0, 6, 0 )
8864                ENDIF
8865!
8866!--             Allocate emission arrays
8867                ALLOCATE( aero_emission_att%cat_index(1:aero_emission_att%ncat),                   &
8868                          aero_emission_att%rho(1:aero_emission_att%ncat),                         &
8869                          aero_emission_att%time_factor(1:aero_emission_att%ncat) )
8870!
8871!--             Get emission category names and indices
8872                IF ( check_existence( aero_emission_att%var_names, 'emission_category_name' ) )  THEN
8873                   CALL get_variable( id_salsa, 'emission_category_name',                          &
8874                                      aero_emission_att%cat_name,  aero_emission_att%ncat )
8875                ELSE
8876                   message_string = 'Missing emission_category_name in ' // TRIM( input_file_salsa )
8877                   CALL message( 'salsa_emission_setup', 'PA0658', 1, 2, 0, 6, 0 )
8878                ENDIF
8879                CALL get_variable( id_salsa, 'emission_category_index', aero_emission_att%cat_index )
8880!
8881!--             Find corresponding emission categories
8882                DO  in = 1, aero_emission_att%ncat
8883                   in_name = aero_emission_att%cat_name(in)
8884                   DO  ss = 1, def_modes%ndc
8885                      mod_name = def_modes%cat_name_table(ss)
8886                      IF ( TRIM( in_name(1:4) ) == TRIM( mod_name(1:4 ) ) )  THEN
8887                         def_modes%cat_input_to_model(ss) = in
8888                      ENDIF
8889                   ENDDO
8890                ENDDO
8891
8892                IF ( SUM( def_modes%cat_input_to_model ) == 0 )  THEN
8893                   message_string = 'None of the emission categories in ' //  TRIM(                &
8894                                    input_file_salsa ) // ' match with the ones in the model.'
8895                   CALL message( 'salsa_emission_setup', 'PA0632', 1, 2, 0, 6, 0 )
8896                ENDIF
8897!
8898!--             Emission time factors: Find check whether emission time factors are given for each
8899!--             hour of year OR based on month, day and hour
8900!
8901!--             For each hour of year:
8902                IF ( check_existence( aero_emission_att%var_names, 'nhoursyear' ) )  THEN
8903                   CALL get_dimension_length( id_salsa, aero_emission_att%nhoursyear, 'nhoursyear' )
8904                   ALLOCATE( aero_emission_att%etf(1:aero_emission_att%ncat,                       &
8905                                                   1:aero_emission_att%nhoursyear) )
8906                   CALL get_variable( id_salsa, 'emission_time_factors', aero_emission_att%etf,    &
8907                                    0, aero_emission_att%nhoursyear-1, 0, aero_emission_att%ncat-1 )
8908!
8909!--             Based on the month, day and hour:
8910                ELSEIF ( check_existence( aero_emission_att%var_names, 'nmonthdayhour' ) )  THEN
8911                   CALL get_dimension_length( id_salsa, aero_emission_att%nmonthdayhour,           &
8912                                              'nmonthdayhour' )
8913                   ALLOCATE( aero_emission_att%etf(1:aero_emission_att%ncat,                       &
8914                                                   1:aero_emission_att%nmonthdayhour) )
8915                   CALL get_variable( id_salsa, 'emission_time_factors', aero_emission_att%etf,    &
8916                                 0, aero_emission_att%nmonthdayhour-1, 0, aero_emission_att%ncat-1 )
8917                ELSE
8918                   message_string = 'emission_time_factors should be given for each nhoursyear ' //&
8919                                    'OR nmonthdayhour'
8920                   CALL message( 'salsa_emission_setup','PA0633', 1, 2, 0, 6, 0 )
8921                ENDIF
8922!
8923!--             Next emission update
8924                CALL get_date_time( time_since_reference_point, second_of_day=second_of_day )
8925                next_aero_emission_update = MOD( second_of_day, seconds_per_hour ) !- seconds_per_hour
8926!
8927!--             Calculate average mass density (kg/m3)
8928                aero_emission_att%rho = 0.0_wp
8929
8930                IF ( cc_i2m(1) /= 0 )  aero_emission_att%rho = aero_emission_att%rho +  arhoh2so4 *&
8931                                                               aero_emission%mass_fracs(:,cc_i2m(1))
8932                IF ( cc_i2m(2) /= 0 )  aero_emission_att%rho = aero_emission_att%rho + arhooc *    &
8933                                                               aero_emission%mass_fracs(:,cc_i2m(2))
8934                IF ( cc_i2m(3) /= 0 )  aero_emission_att%rho = aero_emission_att%rho + arhobc *    &
8935                                                               aero_emission%mass_fracs(:,cc_i2m(3))
8936                IF ( cc_i2m(4) /= 0 )  aero_emission_att%rho = aero_emission_att%rho + arhodu *    &
8937                                                               aero_emission%mass_fracs(:,cc_i2m(4))
8938                IF ( cc_i2m(5) /= 0 )  aero_emission_att%rho = aero_emission_att%rho + arhoss *    &
8939                                                               aero_emission%mass_fracs(:,cc_i2m(5))
8940                IF ( cc_i2m(6) /= 0 )  aero_emission_att%rho = aero_emission_att%rho + arhohno3 *  &
8941                                                               aero_emission%mass_fracs(:,cc_i2m(6))
8942                IF ( cc_i2m(7) /= 0 )  aero_emission_att%rho = aero_emission_att%rho + arhonh3 *   &
8943                                                               aero_emission%mass_fracs(:,cc_i2m(7))
8944!
8945!--             Allocate and read surface emission data (in total PM)
8946                ALLOCATE( aero_emission%def_data(nys:nyn,nxl:nxr,1:aero_emission_att%ncat) )
8947                CALL get_variable( id_salsa, 'aerosol_emission_values', aero_emission%def_data,    &
8948                                   0, aero_emission_att%ncat-1, nxl, nxr, nys, nyn )
8949
8950!
8951!--          Pre-processed mode
8952             ELSEIF ( aero_emission_att%lod == 2 )  THEN
8953!
8954!--             Unit conversion factor: convert to SI units (#/m2/s)
8955                IF ( aero_emission_att%units == '#/m2/s' )  THEN
8956                   aero_emission_att%conversion_factor = 1.0_wp
8957                ELSE
8958                   message_string = 'unknown unit for aerosol emissions: ' //                      &
8959                                    TRIM( aero_emission_att%units )
8960                   CALL message( 'salsa_emission_setup','PA0634', 1, 2, 0, 6, 0 )
8961                ENDIF
8962!
8963!--             Number of aerosol size bins in the emission data
8964                CALL get_dimension_length( id_salsa, aero_emission_att%nbins, 'Dmid' )
8965                IF ( aero_emission_att%nbins /= nbins_aerosol )  THEN
8966                   message_string = 'The number of size bins in aerosol input data does not ' //   &
8967                                    'correspond to the model set-up'
8968                   CALL message( 'salsa_emission_setup','PA0635', 1, 2, 0, 6, 0 )
8969                ENDIF
8970!
8971!--             Number of time steps in the emission data
8972                CALL get_dimension_length( id_salsa, aero_emission_att%nt, 'time')
8973!
8974!--             Allocate bin diameters, time and mass fraction array
8975                ALLOCATE( aero_emission_att%dmid(1:nbins_aerosol),                                 &
8976                          aero_emission_att%time(1:aero_emission_att%nt),                          &
8977                          aero_emission%num_fracs(1:aero_emission_att%ncat,1:nbins_aerosol) )
8978!
8979!--             Read mean diameters
8980                CALL get_variable( id_salsa, 'Dmid', aero_emission_att%dmid )
8981!
8982!--             Check whether the sectional representation of the aerosol size distribution conform
8983!--             to the one applied in the model
8984                IF ( ANY( ABS( ( aero(1:nbins_aerosol)%dmid - aero_emission_att%dmid ) /           &
8985                               aero(1:nbins_aerosol)%dmid ) > 0.1_wp )  )  THEN
8986                   message_string = 'Mean diameters of size bins in ' // TRIM( input_file_salsa )  &
8987                                    // ' do not match with the ones in the model.'
8988                   CALL message( 'salsa_emission_setup','PA0636', 1, 2, 0, 6, 0 )
8989                ENDIF
8990!
8991!--             Read time stamps:
8992                IF ( check_existence( aero_emission_att%var_names, 'time' ) )  THEN
8993                   CALL get_variable( id_salsa, 'time', aero_emission_att%time )
8994                ELSE
8995                   message_string = 'Missing time in ' //  TRIM( input_file_salsa )
8996                   CALL message( 'salsa_emission_setup', 'PA0660', 1, 2, 0, 6, 0 )
8997                ENDIF
8998!
8999!--             Read emission number fractions per category
9000                IF ( check_existence( aero_emission_att%var_names, 'emission_number_fracs' ) )  THEN
9001                   CALL get_variable( id_salsa, 'emission_number_fracs', aero_emission%num_fracs,  &
9002                                      0, nbins_aerosol-1, 0, aero_emission_att%ncat-1 )
9003                ELSE
9004                   message_string = 'Missing emission_number_fracs in ' //  TRIM( input_file_salsa )
9005                   CALL message( 'salsa_emission_setup', 'PA0659', 1, 2, 0, 6, 0 )
9006                ENDIF
9007
9008             ELSE
9009                message_string = 'Unknown lod for aerosol_emission_values.'
9010                CALL message( 'salsa_emission','PA0637', 1, 2, 0, 6, 0 )
9011
9012             ENDIF  ! lod
9013
9014          ENDIF  ! init
9015!
9016!--       Define and set current emission values:
9017!
9018!--       Default type emissions (aerosol emission given as total mass emission per year):
9019          IF ( aero_emission_att%lod == 1 )  THEN
9020!
9021!--          Emission time factors for each emission category at current time step
9022             IF ( aero_emission_att%nhoursyear > aero_emission_att%nmonthdayhour )  THEN
9023!
9024!--             Get the index of the current hour
9025                CALL get_date_time( MAX( 0.0_wp, time_since_reference_point ),                     &
9026                                    day_of_year=day_of_year, hour=hour_of_day )
9027                index_hh = ( day_of_year - 1_iwp ) * hours_per_day + hour_of_day
9028                aero_emission_att%time_factor = aero_emission_att%etf(:,index_hh+1)
9029
9030             ELSEIF ( aero_emission_att%nhoursyear < aero_emission_att%nmonthdayhour )  THEN
9031!
9032!--             Get the index of current hour (index_hh) (TODO: Now "workday" is always assumed.
9033!--             Needs to be calculated.)
9034                CALL get_date_time( MAX( 0.0_wp, time_since_reference_point ), month=month_of_year,&
9035                                    day=day_of_month, hour=hour_of_day, day_of_week=day_of_week )
9036                index_mm = month_of_year
9037                index_dd = months_per_year + day_of_week
9038                SELECT CASE(TRIM(daytype))
9039
9040                   CASE ("workday")
9041                      index_hh = months_per_year + days_per_week + hour_of_day
9042
9043                   CASE ("weekend")
9044                      index_hh = months_per_year + days_per_week + hours_per_day + hour_of_day
9045
9046                   CASE ("holiday")
9047                      index_hh = months_per_year + days_per_week + 2*hours_per_day + hour_of_day
9048
9049                END SELECT
9050                aero_emission_att%time_factor = aero_emission_att%etf(:,index_mm) *                &
9051                                                aero_emission_att%etf(:,index_dd) *                &
9052                                                aero_emission_att%etf(:,index_hh+1)
9053             ENDIF
9054
9055!
9056!--          Create a sectional number size distribution for emissions
9057             ALLOCATE( nsect_emission(1:nbins_aerosol),source_array(nys:nyn,nxl:nxr,1:nbins_aerosol) )
9058             DO  in = 1, aero_emission_att%ncat
9059
9060                inn = def_modes%cat_input_to_model(in)
9061!
9062!--             Calculate the number concentration (1/m3) of a log-normal size distribution
9063!--             following Jacobson (2005): Eq 13.25.
9064                def_modes%ntot_table = 6.0_wp * def_modes%pm_frac_table(:,inn) / ( pi *            &
9065                                       ( def_modes%dpg_table )**3 *  EXP( 4.5_wp *                 &
9066                                       LOG( def_modes%sigmag_table )**2 ) )
9067!
9068!--             Sectional size distibution (1/m3) from a log-normal one
9069                CALL size_distribution( def_modes%ntot_table, def_modes%dpg_table,                 &
9070                                        def_modes%sigmag_table, nsect_emission )
9071
9072                source_array = 0.0_wp
9073                DO  ib = 1, nbins_aerosol
9074                   source_array(:,:,ib) = aero_emission%def_data(:,:,in) *                         &
9075                                          aero_emission_att%conversion_factor /                    &
9076                                          aero_emission_att%rho(in) * nsect_emission(ib) *         &
9077                                          aero_emission_att%time_factor(in)
9078                ENDDO
9079!
9080!--             Set surface fluxes of aerosol number and mass on horizontal surfaces. Set fluxes
9081!--             only for either default, land or urban surface.
9082                IF ( .NOT. land_surface  .AND.  .NOT. urban_surface )  THEN
9083                   CALL set_flux( surf_def_h(0), aero_emission_att%cc_in2mod,                      &
9084                                  aero_emission%mass_fracs(in,:), source_array )
9085                ELSE
9086                   CALL set_flux( surf_usm_h, aero_emission_att%cc_in2mod,                         &
9087                                  aero_emission%mass_fracs(in,:), source_array )
9088                   CALL set_flux( surf_lsm_h, aero_emission_att%cc_in2mod,                         &
9089                                  aero_emission%mass_fracs(in,:), source_array )
9090                ENDIF
9091             ENDDO
9092!
9093!--          The next emission update is again after one hour
9094             next_aero_emission_update = next_aero_emission_update + 3600.0_wp
9095
9096
9097             DEALLOCATE( nsect_emission, source_array )
9098!
9099!--       Pre-processed:
9100          ELSEIF ( aero_emission_att%lod == 2 )  THEN
9101!
9102!--          Get time_utc_init from origin_date_time
9103             CALL get_date_time( 0.0_wp, second_of_day = time_utc_init )
9104!
9105!--          Obtain time index for current point in time. Note, the time coordinate in the input
9106!--          file is relative to time_utc_init.
9107             aero_emission_att%tind = MINLOC( ABS( aero_emission_att%time - (                      &
9108                                                   time_utc_init + MAX( time_since_reference_point,&
9109                                                                        0.0_wp) ) ), DIM = 1 ) - 1
9110!
9111!--          Allocate the data input array always before reading in the data and deallocate after
9112             ALLOCATE( aero_emission%preproc_data(nys:nyn,nxl:nxr,1:aero_emission_att%ncat),       &
9113                       source_array(nys:nyn,nxl:nxr,1:nbins_aerosol) )
9114!
9115!--          Read in the next time step
9116             CALL get_variable( id_salsa, 'aerosol_emission_values', aero_emission%preproc_data,   &
9117                                aero_emission_att%tind, 0, aero_emission_att%ncat-1,               &
9118                                nxl, nxr, nys, nyn )
9119!
9120!--          Calculate the sources per category and set surface fluxes
9121             source_array = 0.0_wp
9122             DO  in = 1, aero_emission_att%ncat
9123                DO  ib = 1, nbins_aerosol
9124                   source_array(:,:,ib) = aero_emission%preproc_data(:,:,in) *                     &
9125                                          aero_emission%num_fracs(in,ib)
9126                ENDDO
9127!
9128!--             Set fluxes only for either default, land and urban surface.
9129                IF ( .NOT. land_surface  .AND.  .NOT. urban_surface )  THEN
9130                   CALL set_flux( surf_def_h(0), aero_emission_att%cc_in2mod,                      &
9131                                  aero_emission%mass_fracs(in,:), source_array )
9132                ELSE
9133                   CALL set_flux( surf_usm_h, aero_emission_att%cc_in2mod,                         &
9134                                  aero_emission%mass_fracs(in,:), source_array )
9135                   CALL set_flux( surf_lsm_h, aero_emission_att%cc_in2mod,                         &
9136                                  aero_emission%mass_fracs(in,:), source_array )
9137                ENDIF
9138             ENDDO
9139!
9140!--          Determine the next emission update
9141             next_aero_emission_update = aero_emission_att%time(aero_emission_att%tind+2)
9142
9143             DEALLOCATE( aero_emission%preproc_data, source_array )
9144
9145          ENDIF
9146!
9147!--       Close input file
9148          CALL close_input_file( id_salsa )
9149#else
9150          message_string = 'salsa_emission_mode = "read_from_file", but preprocessor directive ' //&
9151                           ' __netcdf is not used in compiling!'
9152          CALL message( 'salsa_emission_setup', 'PA0638', 1, 2, 0, 6, 0 )
9153
9154#endif
9155       CASE DEFAULT
9156          message_string = 'unknown salsa_emission_mode: ' // TRIM( salsa_emission_mode )
9157          CALL message( 'salsa_emission_setup', 'PA0639', 1, 2, 0, 6, 0 )
9158
9159    END SELECT
9160
9161    CONTAINS
9162
9163!------------------------------------------------------------------------------!
9164! Description:
9165! ------------
9166!> Sets the aerosol flux to aerosol arrays in 2a and 2b.
9167!------------------------------------------------------------------------------!
9168    SUBROUTINE set_flux( surface, cc_i_mod, mass_fracs, source_array )
9169
9170       USE arrays_3d,                                                                              &
9171           ONLY:  rho_air_zw
9172
9173       USE surface_mod,                                                                            &
9174           ONLY:  surf_type
9175
9176       IMPLICIT NONE
9177
9178       INTEGER(iwp) ::  i   !< loop index
9179       INTEGER(iwp) ::  ib  !< loop index
9180       INTEGER(iwp) ::  ic  !< loop index
9181       INTEGER(iwp) ::  j   !< loop index
9182       INTEGER(iwp) ::  k   !< loop index
9183       INTEGER(iwp) ::  m   !< running index for surface elements
9184
9185       INTEGER(iwp), DIMENSION(:) ::  cc_i_mod   !< index of chemical component in the input data
9186
9187       REAL(wp) ::  so4_oc  !< mass fraction between SO4 and OC in 1a
9188
9189       REAL(wp), DIMENSION(:), INTENT(in) ::  mass_fracs  !< mass fractions of chemical components
9190
9191       REAL(wp), DIMENSION(nys:nyn,nxl:nxr,1:nbins_aerosol), INTENT(inout) ::  source_array  !<
9192
9193       TYPE(surf_type), INTENT(inout) :: surface  !< respective surface type
9194
9195       so4_oc = 0.0_wp
9196
9197       DO  m = 1, surface%ns
9198!
9199!--       Get indices of respective grid point
9200          i = surface%i(m)
9201          j = surface%j(m)
9202          k = surface%k(m)
9203
9204          DO  ib = 1, nbins_aerosol
9205             IF ( source_array(j,i,ib) < nclim )  THEN
9206                source_array(j,i,ib) = 0.0_wp
9207             ENDIF
9208!
9209!--          Set mass fluxes.  First bins include only SO4 and/or OC.
9210             IF ( ib <= end_subrange_1a )  THEN
9211!
9212!--             Both sulphate and organic carbon
9213                IF ( index_so4 > 0  .AND.  index_oc > 0 )  THEN
9214
9215                   ic = ( index_so4 - 1 ) * nbins_aerosol + ib
9216                   so4_oc = mass_fracs(cc_i_mod(1)) / ( mass_fracs(cc_i_mod(1)) +                  &
9217                                                        mass_fracs(cc_i_mod(2)) )
9218                   surface%amsws(m,ic) = surface%amsws(m,ic) + so4_oc * source_array(j,i,ib)       &
9219                                         * api6 * aero(ib)%dmid**3 * arhoh2so4 * rho_air_zw(k-1)
9220                   aerosol_mass(ic)%source(j,i) = aerosol_mass(ic)%source(j,i) + surface%amsws(m,ic)
9221
9222                   ic = ( index_oc - 1 ) * nbins_aerosol + ib
9223                   surface%amsws(m,ic) = surface%amsws(m,ic) + ( 1-so4_oc ) * source_array(j,i,ib) &
9224                                         * api6 * aero(ib)%dmid**3 * arhooc * rho_air_zw(k-1)
9225                   aerosol_mass(ic)%source(j,i) = aerosol_mass(ic)%source(j,i) + surface%amsws(m,ic)
9226!
9227!--             Only sulphates
9228                ELSEIF ( index_so4 > 0  .AND.  index_oc < 0 )  THEN
9229                   ic = ( index_so4 - 1 ) * nbins_aerosol + ib
9230                   surface%amsws(m,ic) = surface%amsws(m,ic) + source_array(j,i,ib) * api6 *       &
9231                                         aero(ib)%dmid**3 * arhoh2so4 * rho_air_zw(k-1)
9232                   aerosol_mass(ic)%source(j,i) = aerosol_mass(ic)%source(j,i) + surface%amsws(m,ic)
9233!
9234!--             Only organic carbon
9235                ELSEIF ( index_so4 < 0  .AND.  index_oc > 0 )  THEN
9236                   ic = ( index_oc - 1 ) * nbins_aerosol + ib
9237                   surface%amsws(m,ic) = surface%amsws(m,ic) + source_array(j,i,ib) * api6 *       &
9238                                         aero(ib)%dmid**3 * arhooc * rho_air_zw(k-1)
9239                   aerosol_mass(ic)%source(j,i) = aerosol_mass(ic)%source(j,i) + surface%amsws(m,ic)
9240                ENDIF
9241
9242             ELSE
9243!
9244!--             Sulphate
9245                IF ( index_so4 > 0 )  THEN
9246                   ic = cc_i_mod(1)
9247                   CALL set_mass_flux( surface, m, ib, index_so4, mass_fracs(ic), arhoh2so4,       &
9248                                       source_array(j,i,ib) )
9249                ENDIF
9250!
9251!--             Organic carbon
9252                IF ( index_oc > 0 )  THEN
9253                   ic = cc_i_mod(2)
9254                   CALL set_mass_flux( surface, m, ib, index_oc, mass_fracs(ic),arhooc,            &
9255                                       source_array(j,i,ib) )
9256                ENDIF
9257!
9258!--             Black carbon
9259                IF ( index_bc > 0 )  THEN
9260                   ic = cc_i_mod(3)
9261                   CALL set_mass_flux( surface, m, ib, index_bc, mass_fracs(ic), arhobc,           &
9262                                       source_array(j,i,ib) )
9263                ENDIF
9264!
9265!--             Dust
9266                IF ( index_du > 0 )  THEN
9267                   ic = cc_i_mod(4)
9268                   CALL set_mass_flux( surface, m, ib, index_du, mass_fracs(ic), arhodu,           &
9269                                       source_array(j,i,ib) )
9270                ENDIF
9271!
9272!--             Sea salt
9273                IF ( index_ss > 0 )  THEN
9274                   ic = cc_i_mod(5)
9275                   CALL set_mass_flux( surface, m, ib, index_ss, mass_fracs(ic), arhoss,           &
9276                                       source_array(j,i,ib) )
9277                ENDIF
9278!
9279!--             Nitric acid
9280                IF ( index_no > 0 )  THEN
9281                    ic = cc_i_mod(6)
9282                   CALL set_mass_flux( surface, m, ib, index_no, mass_fracs(ic), arhohno3,         &
9283                                       source_array(j,i,ib) )
9284                ENDIF
9285!
9286!--             Ammonia
9287                IF ( index_nh > 0 )  THEN
9288                    ic = cc_i_mod(7)
9289                   CALL set_mass_flux( surface, m, ib, index_nh, mass_fracs(ic), arhonh3,          &
9290                                       source_array(j,i,ib) )
9291                ENDIF
9292
9293             ENDIF
9294!
9295!--          Save number fluxes in the end
9296             surface%answs(m,ib) = surface%answs(m,ib) + source_array(j,i,ib) * rho_air_zw(k-1)
9297             aerosol_number(ib)%source(j,i) = aerosol_number(ib)%source(j,i) + surface%answs(m,ib)
9298
9299          ENDDO  ! ib
9300       ENDDO  ! m
9301
9302    END SUBROUTINE set_flux
9303
9304!------------------------------------------------------------------------------!
9305! Description:
9306! ------------
9307!> Sets the mass emissions to aerosol arrays in 2a and 2b.
9308!------------------------------------------------------------------------------!
9309    SUBROUTINE set_mass_flux( surface, surf_num, ib, ispec, mass_frac, prho, nsource )
9310
9311       USE arrays_3d,                                                                              &
9312           ONLY:  rho_air_zw
9313
9314       USE surface_mod,                                                                            &
9315           ONLY:  surf_type
9316
9317       IMPLICIT NONE
9318
9319       INTEGER(iwp) ::  i   !< loop index
9320       INTEGER(iwp) ::  j   !< loop index
9321       INTEGER(iwp) ::  k   !< loop index
9322       INTEGER(iwp) ::  ic  !< loop index
9323
9324       INTEGER(iwp), INTENT(in) :: ib        !< Aerosol size bin index
9325       INTEGER(iwp), INTENT(in) :: ispec     !< Aerosol species index
9326       INTEGER(iwp), INTENT(in) :: surf_num  !< index surface elements
9327
9328       REAL(wp), INTENT(in) ::  mass_frac    !< mass fraction of a chemical compound in all bins
9329       REAL(wp), INTENT(in) ::  nsource      !< number source (#/m2/s)
9330       REAL(wp), INTENT(in) ::  prho         !< Aerosol density
9331
9332       TYPE(surf_type), INTENT(inout) ::  surface  !< respective surface type
9333!
9334!--    Get indices of respective grid point
9335       i = surface%i(surf_num)
9336       j = surface%j(surf_num)
9337       k = surface%k(surf_num)
9338!
9339!--    Subrange 2a:
9340       ic = ( ispec - 1 ) * nbins_aerosol + ib
9341       surface%amsws(surf_num,ic) = surface%amsws(surf_num,ic) + mass_frac * nsource *             &
9342                                    aero(ib)%core * prho * rho_air_zw(k-1)
9343       aerosol_mass(ic)%source(j,i) = aerosol_mass(ic)%source(j,i) + surface%amsws(surf_num,ic)
9344
9345    END SUBROUTINE set_mass_flux
9346
9347 END SUBROUTINE salsa_emission_setup
9348
9349!------------------------------------------------------------------------------!
9350! Description:
9351! ------------
9352!> Sets the gaseous fluxes
9353!------------------------------------------------------------------------------!
9354 SUBROUTINE salsa_gas_emission_setup( init )
9355
9356    USE netcdf_data_input_mod,                                                                     &
9357        ONLY:  check_existence, close_input_file, get_attribute, get_variable,                     &
9358               inquire_num_variables, inquire_variable_names,                                      &
9359               get_dimension_length, open_read_file
9360
9361    USE palm_date_time_mod,                                                                        &
9362        ONLY:  days_per_week, get_date_time, hours_per_day, months_per_year, seconds_per_hour
9363
9364    USE surface_mod,                                                                               &
9365        ONLY:  surf_def_h, surf_lsm_h, surf_usm_h
9366
9367    IMPLICIT NONE
9368
9369    CHARACTER(LEN=80) ::  daytype = 'workday'  !< default day type
9370    CHARACTER(LEN=25) ::  in_name              !< name of a gas in the input file
9371
9372    CHARACTER(LEN=100), DIMENSION(:), ALLOCATABLE ::  var_names   !<  variable names in input data
9373
9374
9375    INTEGER(iwp) ::  day_of_month   !< day of the month
9376    INTEGER(iwp) ::  day_of_week    !< day of the week
9377    INTEGER(iwp) ::  day_of_year    !< day of the year
9378    INTEGER(iwp) ::  hour_of_day    !< hour of the day
9379    INTEGER(iwp) ::  id_chem        !< NetCDF id of chemistry emission file
9380    INTEGER(iwp) ::  i              !< loop index
9381    INTEGER(iwp) ::  ig             !< loop index
9382    INTEGER(iwp) ::  in             !< running index for emission categories
9383    INTEGER(iwp) ::  index_dd       !< index day
9384    INTEGER(iwp) ::  index_hh       !< index hour
9385    INTEGER(iwp) ::  index_mm       !< index month
9386    INTEGER(iwp) ::  j              !< loop index
9387    INTEGER(iwp) ::  month_of_year  !< month of the year
9388    INTEGER(iwp) ::  num_vars       !< number of variables
9389
9390    LOGICAL  ::  netcdf_extend = .FALSE.  !< NetCDF input file exists
9391
9392    LOGICAL, INTENT(in) ::  init          !< if .TRUE. --> initialisation call
9393
9394    REAL(wp) ::  second_of_day    !< second of the day
9395
9396    REAL(wp), DIMENSION(:), ALLOCATABLE ::  time_factor  !< emission time factor
9397
9398    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  dum_var_3d  !<
9399
9400    REAL(wp), DIMENSION(:,:,:,:,:), ALLOCATABLE ::  dum_var_5d  !<
9401
9402!
9403!-- Reset surface fluxes
9404    surf_def_h(0)%gtsws = 0.0_wp
9405    surf_lsm_h%gtsws = 0.0_wp
9406    surf_usm_h%gtsws = 0.0_wp
9407
9408#if defined( __netcdf )
9409!
9410!-- Check existence of PIDS_CHEM file
9411    INQUIRE( FILE = 'PIDS_CHEM' // TRIM( coupling_char ), EXIST = netcdf_extend )
9412    IF ( .NOT. netcdf_extend )  THEN
9413       message_string = 'Input file PIDS_CHEM' //  TRIM( coupling_char ) // ' missing!'
9414       CALL message( 'salsa_gas_emission_setup', 'PA0640', 1, 2, 0, 6, 0 )
9415    ENDIF
9416!
9417!-- Open file in read-only mode
9418    CALL open_read_file( 'PIDS_CHEM' // TRIM( coupling_char ), id_chem )
9419
9420    IF ( init )  THEN
9421!
9422!--    Read the index and name of chemical components
9423       CALL get_dimension_length( id_chem, chem_emission_att%n_emiss_species, 'nspecies' )
9424       ALLOCATE( chem_emission_att%species_index(1:chem_emission_att%n_emiss_species) )
9425       CALL get_variable( id_chem, 'emission_index', chem_emission_att%species_index )
9426       CALL get_variable( id_chem, 'emission_name', chem_emission_att%species_name,                &
9427                          chem_emission_att%n_emiss_species )
9428!
9429!--    Allocate emission data
9430       ALLOCATE( chem_emission(1:chem_emission_att%n_emiss_species) )
9431!
9432!--    Find the corresponding indices in the model
9433       emission_index_chem = 0
9434       DO  ig = 1, chem_emission_att%n_emiss_species
9435          in_name = chem_emission_att%species_name(ig)
9436          SELECT CASE ( TRIM( in_name ) )
9437             CASE ( 'H2SO4', 'h2so4' )
9438                emission_index_chem(1) = ig
9439             CASE ( 'HNO3', 'hno3' )
9440                emission_index_chem(2) = ig
9441             CASE ( 'NH3', 'nh3' )
9442                emission_index_chem(3) = ig
9443             CASE ( 'OCNV', 'ocnv' )
9444                emission_index_chem(4) = ig
9445             CASE ( 'OCSV', 'ocsv' )
9446                emission_index_chem(5) = ig
9447          END SELECT
9448       ENDDO
9449!
9450!--    Inquire the fill value
9451       CALL get_attribute( id_chem, '_FillValue', aero_emission%fill, .FALSE., 'emission_values' )
9452!
9453!--    Inquire units of emissions
9454       CALL get_attribute( id_chem, 'units', chem_emission_att%units, .FALSE., 'emission_values' )
9455!
9456!--    Inquire the level of detail (lod)
9457       CALL get_attribute( id_chem, 'lod', lod_gas_emissions, .FALSE., 'emission_values' )
9458!
9459!--    Variable names
9460       CALL inquire_num_variables( id_chem, num_vars )
9461       ALLOCATE( var_names(1:num_vars) )
9462       CALL inquire_variable_names( id_chem, var_names )
9463!
9464!--    Default mode: as total emissions per year
9465       IF ( lod_gas_emissions == 1 )  THEN
9466
9467!
9468!--       Get number of emission categories and allocate emission arrays
9469          CALL get_dimension_length( id_chem, chem_emission_att%ncat, 'ncat' )
9470          ALLOCATE( chem_emission_att%cat_index(1:chem_emission_att%ncat),                         &
9471                    time_factor(1:chem_emission_att%ncat) )
9472!
9473!--       Get emission category names and indices
9474          CALL get_variable( id_chem, 'emission_category_name', chem_emission_att%cat_name,        &
9475                             chem_emission_att%ncat)
9476          CALL get_variable( id_chem, 'emission_category_index', chem_emission_att%cat_index )
9477!
9478!--       Emission time factors: Find check whether emission time factors are given for each hour
9479!--       of year OR based on month, day and hour
9480!
9481!--       For each hour of year:
9482          IF ( check_existence( var_names, 'nhoursyear' ) )  THEN
9483             CALL get_dimension_length( id_chem, chem_emission_att%nhoursyear, 'nhoursyear' )
9484             ALLOCATE( chem_emission_att%hourly_emis_time_factor(1:chem_emission_att%ncat,         &
9485                                                                 1:chem_emission_att%nhoursyear) )
9486             CALL get_variable( id_chem, 'emission_time_factors',                                  &
9487                                chem_emission_att%hourly_emis_time_factor,                         &
9488                                0, chem_emission_att%nhoursyear-1, 0, chem_emission_att%ncat-1 )
9489!
9490!--       Based on the month, day and hour:
9491          ELSEIF ( check_existence( var_names, 'nmonthdayhour' ) )  THEN
9492             CALL get_dimension_length( id_chem, chem_emission_att%nmonthdayhour, 'nmonthdayhour' )
9493             ALLOCATE( chem_emission_att%mdh_emis_time_factor(1:chem_emission_att%ncat,            &
9494                                                              1:chem_emission_att%nmonthdayhour) )
9495             CALL get_variable( id_chem, 'emission_time_factors',                                  &
9496                                chem_emission_att%mdh_emis_time_factor,                            &
9497                                0, chem_emission_att%nmonthdayhour-1, 0, chem_emission_att%ncat-1 )
9498          ELSE
9499             message_string = 'emission_time_factors should be given for each nhoursyear OR ' //   &
9500                              'nmonthdayhour'
9501             CALL message( 'salsa_gas_emission_setup','PA0641', 1, 2, 0, 6, 0 )
9502          ENDIF
9503!
9504!--       Next emission update
9505          CALL get_date_time( time_since_reference_point, second_of_day=second_of_day )
9506          next_gas_emission_update = MOD( second_of_day, seconds_per_hour ) !- seconds_per_hour
9507!
9508!--       Allocate and read surface emission data (in total PM) (NOTE that "preprocessed" input data
9509!--       array is applied now here)
9510          ALLOCATE( dum_var_5d(1,nys:nyn,nxl:nxr,1:chem_emission_att%n_emiss_species,              &
9511                               1:chem_emission_att%ncat) )
9512          CALL get_variable( id_chem, 'emission_values', dum_var_5d, 0, chem_emission_att%ncat-1,  &
9513                             0, chem_emission_att%n_emiss_species-1, nxl, nxr, nys, nyn, 0, 0 )
9514          DO  ig = 1, chem_emission_att%n_emiss_species
9515             ALLOCATE( chem_emission(ig)%default_emission_data(nys:nyn,nxl:nxr,                    &
9516                                                               1:chem_emission_att%ncat) )
9517             DO  in = 1, chem_emission_att%ncat
9518                DO  i = nxl, nxr
9519                   DO  j = nys, nyn
9520                      chem_emission(ig)%default_emission_data(j,i,in) = dum_var_5d(1,j,i,ig,in)
9521                   ENDDO
9522                ENDDO
9523             ENDDO
9524          ENDDO
9525          DEALLOCATE( dum_var_5d )
9526!
9527!--    Pre-processed mode:
9528       ELSEIF ( lod_gas_emissions == 2 )  THEN
9529!
9530!--       Number of time steps in the emission data
9531          CALL get_dimension_length( id_chem, chem_emission_att%dt_emission, 'time' )
9532!
9533!--       Allocate and read time
9534          ALLOCATE( gas_emission_time(1:chem_emission_att%dt_emission) )
9535          CALL get_variable( id_chem, 'time', gas_emission_time )
9536       ELSE
9537          message_string = 'Unknown lod for emission_values.'
9538          CALL message( 'salsa_gas_emission_setup','PA0642', 1, 2, 0, 6, 0 )
9539       ENDIF  ! lod
9540
9541    ENDIF  ! init
9542!
9543!-- Define and set current emission values:
9544
9545    IF ( lod_gas_emissions == 1 )  THEN
9546!
9547!--    Emission time factors for each emission category at current time step
9548       IF ( chem_emission_att%nhoursyear > chem_emission_att%nmonthdayhour )  THEN
9549!
9550!--       Get the index of the current hour
9551          CALL get_date_time( time_since_reference_point, &
9552                              day_of_year=day_of_year, hour=hour_of_day )
9553          index_hh = ( day_of_year - 1_iwp ) * hours_per_day + hour_of_day
9554          IF ( .NOT. ALLOCATED( time_factor ) )  ALLOCATE( time_factor(1:chem_emission_att%ncat) )
9555          time_factor = 0.0_wp
9556          time_factor = chem_emission_att%hourly_emis_time_factor(:,index_hh+1)
9557
9558       ELSEIF ( chem_emission_att%nhoursyear < chem_emission_att%nmonthdayhour )  THEN
9559!
9560!--       Get the index of current hour (index_hh) (TODO: Now "workday" is always assumed.
9561!--       Needs to be calculated.)
9562          CALL get_date_time( time_since_reference_point, &
9563                              month=month_of_year,        &
9564                              day=day_of_month,           &
9565                              hour=hour_of_day,           &
9566                              day_of_week=day_of_week     )
9567          index_mm = month_of_year
9568          index_dd = months_per_year + day_of_week
9569          SELECT CASE( TRIM( daytype ) )
9570
9571             CASE ("workday")
9572                index_hh = months_per_year + days_per_week + hour_of_day
9573
9574             CASE ("weekend")
9575                index_hh = months_per_year + days_per_week + hours_per_day + hour_of_day
9576
9577             CASE ("holiday")
9578                index_hh = months_per_year + days_per_week + 2*hours_per_day + hour_of_day
9579
9580          END SELECT
9581          time_factor = chem_emission_att%mdh_emis_time_factor(:,index_mm) *                       &
9582                        chem_emission_att%mdh_emis_time_factor(:,index_dd) *                       &
9583                        chem_emission_att%mdh_emis_time_factor(:,index_hh+1)
9584       ENDIF
9585!
9586!--    Set gas emissions for each emission category
9587       ALLOCATE( dum_var_3d(nys:nyn,nxl:nxr,1:chem_emission_att%n_emiss_species) )
9588
9589       DO  in = 1, chem_emission_att%ncat
9590          DO  ig = 1, chem_emission_att%n_emiss_species
9591             dum_var_3d(:,:,ig) = chem_emission(ig)%default_emission_data(:,:,in)
9592          ENDDO
9593!
9594!--       Set surface fluxes only for either default, land or urban surface
9595          IF ( .NOT. land_surface  .AND.  .NOT. urban_surface )  THEN
9596             CALL set_gas_flux( surf_def_h(0), emission_index_chem, chem_emission_att%units,    &
9597                                dum_var_3d, time_factor(in) )
9598          ELSE
9599             CALL set_gas_flux( surf_usm_h, emission_index_chem, chem_emission_att%units,       &
9600                                dum_var_3d, time_factor(in) )
9601             CALL set_gas_flux( surf_lsm_h, emission_index_chem, chem_emission_att%units,       &
9602                                dum_var_3d, time_factor(in) )
9603          ENDIF
9604       ENDDO
9605       DEALLOCATE( dum_var_3d )
9606!
9607!--    The next emission update is again after one hour
9608       next_gas_emission_update = next_gas_emission_update + 3600.0_wp
9609
9610    ELSEIF ( lod_gas_emissions == 2 )  THEN
9611!
9612!--    Get time_utc_init from origin_date_time
9613       CALL get_date_time( 0.0_wp, second_of_day = time_utc_init )
9614!
9615!--    Obtain time index for current point in time. Note, the time coordinate in the input file is
9616!--    relative to time_utc_init.
9617       chem_emission_att%i_hour = MINLOC( ABS( gas_emission_time - ( time_utc_init +               &
9618                                         MAX( time_since_reference_point, 0.0_wp) ) ), DIM = 1 ) - 1
9619!
9620!--    Allocate the data input array always before reading in the data and deallocate after (NOTE
9621!--    that "preprocessed" input data array is applied now here)
9622       ALLOCATE( dum_var_5d(1,1,nys:nyn,nxl:nxr,1:chem_emission_att%n_emiss_species) )
9623!
9624!--    Read in the next time step
9625       CALL get_variable( id_chem, 'emission_values', dum_var_5d,                                  &
9626                          0, chem_emission_att%n_emiss_species-1, nxl, nxr, nys, nyn, 0, 0,        &
9627                          chem_emission_att%i_hour, chem_emission_att%i_hour )
9628!
9629!--    Set surface fluxes only for either default, land or urban surface
9630       IF ( .NOT. land_surface  .AND.  .NOT. urban_surface )  THEN
9631          CALL set_gas_flux( surf_def_h(0), emission_index_chem, chem_emission_att%units,          &
9632                             dum_var_5d(1,1,:,:,:) )
9633       ELSE
9634          CALL set_gas_flux( surf_usm_h, emission_index_chem, chem_emission_att%units,             &
9635                             dum_var_5d(1,1,:,:,:) )
9636          CALL set_gas_flux( surf_lsm_h, emission_index_chem, chem_emission_att%units,             &
9637                             dum_var_5d(1,1,:,:,:) )
9638       ENDIF
9639       DEALLOCATE ( dum_var_5d )
9640!
9641!--    Determine the next emission update
9642       next_gas_emission_update = gas_emission_time(chem_emission_att%i_hour+2)
9643
9644    ENDIF
9645!
9646!-- Close input file
9647    CALL close_input_file( id_chem )
9648
9649#else
9650    message_string = 'salsa_emission_mode = "read_from_file", but preprocessor directive ' //   &
9651                     ' __netcdf is not used in compiling!'
9652    CALL message( 'salsa_gas_emission_setup', 'PA0643', 1, 2, 0, 6, 0 )
9653
9654#endif
9655
9656    CONTAINS
9657!------------------------------------------------------------------------------!
9658! Description:
9659! ------------
9660!> Set gas fluxes for selected type of surfaces
9661!------------------------------------------------------------------------------!
9662    SUBROUTINE set_gas_flux( surface, cc_i_mod, unit, source_array, time_fac )
9663
9664       USE arrays_3d,                                                                              &
9665           ONLY: dzw, hyp, pt, rho_air_zw
9666
9667       USE grid_variables,                                                                         &
9668           ONLY:  dx, dy
9669
9670       USE surface_mod,                                                                            &
9671           ONLY:  surf_type
9672
9673       IMPLICIT NONE
9674
9675       CHARACTER(LEN=*), INTENT(in) ::  unit  !< flux unit in the input file
9676
9677       INTEGER(iwp) ::  ig  !< running index for gases
9678       INTEGER(iwp) ::  i   !< loop index
9679       INTEGER(iwp) ::  j   !< loop index
9680       INTEGER(iwp) ::  k   !< loop index
9681       INTEGER(iwp) ::  m   !< running index for surface elements
9682
9683       INTEGER(iwp), DIMENSION(:) ::  cc_i_mod   !< index of different gases in the input data
9684
9685       LOGICAL ::  use_time_fac  !< .TRUE. is time_fac present
9686
9687       REAL(wp), OPTIONAL ::  time_fac  !< emission time factor
9688
9689       REAL(wp), DIMENSION(ngases_salsa) ::  conv     !< unit conversion factor
9690
9691       REAL(wp), DIMENSION(nys:nyn,nxl:nxr,1:chem_emission_att%n_emiss_species), INTENT(in) ::  source_array  !<
9692
9693       TYPE(surf_type), INTENT(inout) :: surface  !< respective surface type
9694
9695       conv = 1.0_wp
9696       use_time_fac = PRESENT( time_fac )
9697
9698       DO  m = 1, surface%ns
9699!
9700!--       Get indices of respective grid point
9701          i = surface%i(m)
9702          j = surface%j(m)
9703          k = surface%k(m)
9704!
9705!--       Unit conversion factor: convert to SI units (#/m2/s)
9706          SELECT CASE ( TRIM( unit ) )
9707             CASE ( 'kg/m2/yr' )
9708                conv(1) = avo / ( amh2so4 * 3600.0_wp )
9709                conv(2) = avo / ( amhno3 * 3600.0_wp )
9710                conv(3) = avo / ( amnh3 * 3600.0_wp )
9711                conv(4) = avo / ( amoc * 3600.0_wp )
9712                conv(5) = avo / ( amoc * 3600.0_wp )
9713             CASE ( 'g/m2/yr' )
9714                conv(1) = avo / ( amh2so4 * 3.6E+6_wp )
9715                conv(2) = avo / ( amhno3 * 3.6E+6_wp )
9716                conv(3) = avo / ( amnh3 * 3.6E+6_wp )
9717                conv(4) = avo / ( amoc * 3.6E+6_wp )
9718                conv(5) = avo / ( amoc * 3.6E+6_wp )
9719             CASE ( 'g/m2/s' )
9720                conv(1) = avo / ( amh2so4 * 1000.0_wp )
9721                conv(2) = avo / ( amhno3 * 1000.0_wp )
9722                conv(3) = avo / ( amnh3 * 1000.0_wp )
9723                conv(4) = avo / ( amoc * 1000.0_wp )
9724                conv(5) = avo / ( amoc * 1000.0_wp )
9725             CASE ( '#/m2/s' )
9726                conv = 1.0_wp
9727             CASE ( 'ppm/m2/s' )
9728                conv = for_ppm_to_nconc * hyp(k) / pt(k,j,i) * ( 1.0E5_wp / hyp(k) )**0.286_wp *   &
9729                       dx * dy * dzw(k)
9730             CASE ( 'mumol/m2/s' )
9731                conv = 1.0E-6_wp * avo
9732             CASE DEFAULT
9733                message_string = 'unknown unit for gas emissions: ' // TRIM( chem_emission_att%units )
9734                CALL message( 'set_gas_flux','PA0644', 1, 2, 0, 6, 0 )
9735
9736          END SELECT
9737
9738          DO  ig = 1, ngases_salsa
9739             IF ( use_time_fac )  THEN
9740                surface%gtsws(m,ig) = surface%gtsws(m,ig) + rho_air_zw(k-1) * conv(ig) * time_fac  &
9741                                      * MAX( 0.0_wp, source_array(j,i,cc_i_mod(ig) ) )
9742             ELSE
9743                surface%gtsws(m,ig) = surface%gtsws(m,ig) + rho_air_zw(k-1) * conv(ig)             &
9744                                      * MAX( 0.0_wp, source_array(j,i,cc_i_mod(ig) ) )
9745             ENDIF
9746          ENDDO  ! ig
9747
9748       ENDDO  ! m
9749
9750    END SUBROUTINE set_gas_flux
9751
9752 END SUBROUTINE salsa_gas_emission_setup
9753
9754!------------------------------------------------------------------------------!
9755! Description:
9756! ------------
9757!> Check data output for salsa.
9758!------------------------------------------------------------------------------!
9759 SUBROUTINE salsa_check_data_output( var, unit )
9760
9761    IMPLICIT NONE
9762
9763    CHARACTER(LEN=*) ::  unit     !<
9764    CHARACTER(LEN=*) ::  var      !<
9765
9766    INTEGER(iwp) ::  char_to_int   !< for converting character to integer
9767
9768    IF ( var(1:6) /= 'salsa_' )  THEN
9769       unit = 'illegal'
9770       RETURN
9771    ENDIF
9772!
9773!-- Treat bin-specific outputs separately
9774    IF ( var(7:11) ==  'N_bin' )  THEN
9775       READ( var(12:),* ) char_to_int
9776       IF ( char_to_int >= 1  .AND. char_to_int <= SUM( nbin ) )  THEN
9777          unit = '#/m3'
9778       ELSE
9779          unit = 'illegal'
9780          RETURN
9781       ENDIF
9782
9783    ELSEIF ( var(7:11) ==  'm_bin' )  THEN
9784       READ( var(12:),* ) char_to_int
9785       IF ( char_to_int >= 1  .AND. char_to_int <= SUM( nbin ) )  THEN
9786          unit = 'kg/m3'
9787       ELSE
9788          unit = 'illegal'
9789          RETURN
9790       ENDIF
9791
9792    ELSE
9793       SELECT CASE ( TRIM( var(7:) ) )
9794
9795          CASE ( 'g_H2SO4', 'g_HNO3', 'g_NH3', 'g_OCNV',  'g_OCSV' )
9796             IF (  air_chemistry )  THEN
9797                message_string = 'gases are imported from the chemistry module and thus output '// &
9798                                 'of "' // TRIM( var ) // '" is not allowed'
9799                CALL message( 'check_parameters', 'PA0653', 1, 2, 0, 6, 0 )
9800             ENDIF
9801             unit = '#/m3'
9802
9803          CASE ( 'LDSA' )
9804             unit = 'mum2/cm3'
9805
9806          CASE ( 'PM0.1', 'PM2.5', 'PM10', 's_BC', 's_DU', 's_H2O', 's_NH', 's_NO', 's_OC',        &
9807                 's_SO4', 's_SS' )
9808             unit = 'kg/m3'
9809
9810          CASE ( 'N_UFP', 'Ntot' )
9811             unit = '#/m3'
9812
9813          CASE DEFAULT
9814             unit = 'illegal'
9815
9816       END SELECT
9817    ENDIF
9818
9819 END SUBROUTINE salsa_check_data_output
9820
9821!------------------------------------------------------------------------------!
9822! Description:
9823! ------------
9824!> Check profile data output for salsa. Currently only for diagnostic variables
9825!> Ntot, N_UFP, PM0.1, PM2.5, PM10 and LDSA
9826!------------------------------------------------------------------------------!
9827 SUBROUTINE salsa_check_data_output_pr( var, var_count, unit, dopr_unit )
9828
9829    USE arrays_3d,                                                                                 &
9830        ONLY: zu
9831
9832    USE profil_parameter,                                                                          &
9833        ONLY:  dopr_index
9834
9835    USE statistics,                                                                                &
9836        ONLY:  hom, pr_palm, statistic_regions
9837
9838    IMPLICIT NONE
9839
9840    CHARACTER(LEN=*) ::  dopr_unit  !<
9841    CHARACTER(LEN=*) ::  unit       !<
9842    CHARACTER(LEN=*) ::  var        !<
9843
9844    INTEGER(iwp) ::  var_count     !<
9845
9846    IF ( var(1:6) /= 'salsa_' )  THEN
9847       unit = 'illegal'
9848       RETURN
9849    ENDIF
9850
9851    SELECT CASE ( TRIM( var(7:) ) )
9852
9853       CASE( 'LDSA' )
9854          salsa_pr_count = salsa_pr_count + 1
9855          salsa_pr_index(salsa_pr_count) = 1
9856          dopr_index(var_count) = pr_palm + salsa_pr_count
9857          dopr_unit = 'mum2/cm3'
9858          unit = dopr_unit
9859          hom(:,2,dopr_index(var_count),:) = SPREAD( zu, 2, statistic_regions+1 )
9860
9861       CASE( 'N_UFP' )
9862          salsa_pr_count = salsa_pr_count + 1
9863          salsa_pr_index(salsa_pr_count) = 2
9864          dopr_index(var_count) = pr_palm + salsa_pr_count
9865          dopr_unit = '#/m3'
9866          unit = dopr_unit
9867          hom(:,2,dopr_index(var_count),:) = SPREAD( zu, 2, statistic_regions+1 )
9868
9869       CASE( 'Ntot' )
9870          salsa_pr_count = salsa_pr_count + 1
9871          salsa_pr_index(salsa_pr_count) = 3
9872          dopr_index(var_count) = pr_palm + salsa_pr_count
9873          dopr_unit = '#/m3'
9874          unit = dopr_unit
9875          hom(:,2,dopr_index(var_count),:) = SPREAD( zu, 2, statistic_regions+1 )
9876
9877       CASE( 'PM0.1' )
9878          salsa_pr_count = salsa_pr_count + 1
9879          salsa_pr_index(salsa_pr_count) = 4
9880          dopr_index(var_count) = pr_palm + salsa_pr_count
9881          dopr_unit = 'kg/m3'
9882          unit = dopr_unit
9883          hom(:,2,dopr_index(var_count),:) = SPREAD( zu, 2, statistic_regions+1 )
9884
9885       CASE( 'PM2.5' )
9886          salsa_pr_count = salsa_pr_count + 1
9887          salsa_pr_index(salsa_pr_count) = 5
9888          dopr_index(var_count) = pr_palm + salsa_pr_count
9889          dopr_unit = 'kg/m3'
9890          unit = dopr_unit
9891          hom(:,2,dopr_index(var_count),:) = SPREAD( zu, 2, statistic_regions+1 )
9892
9893       CASE( 'PM10' )
9894          salsa_pr_count = salsa_pr_count + 1
9895          salsa_pr_index(salsa_pr_count) = 6
9896          dopr_index(var_count) = pr_palm + salsa_pr_count
9897          dopr_unit = 'kg/m3'
9898          unit = dopr_unit
9899          hom(:,2,dopr_index(var_count),:) = SPREAD( zu, 2, statistic_regions+1 )
9900
9901       CASE DEFAULT
9902          unit = 'illegal'
9903
9904    END SELECT
9905
9906
9907 END SUBROUTINE salsa_check_data_output_pr
9908
9909!-------------------------------------------------------------------------------!
9910!> Description:
9911!> Calculation of horizontally averaged profiles for salsa.
9912!-------------------------------------------------------------------------------!
9913 SUBROUTINE salsa_statistics( mode, sr, tn )
9914
9915    USE control_parameters,                                                                        &
9916        ONLY:  max_pr_user
9917
9918    USE chem_modules,                                                                              &
9919        ONLY:  max_pr_cs
9920
9921    USE statistics,                                                                                &
9922        ONLY:  pr_palm, rmask, sums_l
9923
9924    IMPLICIT NONE
9925
9926    CHARACTER(LEN=*) ::  mode  !<
9927
9928    INTEGER(iwp) ::  i    !< loop index
9929    INTEGER(iwp) ::  ib   !< loop index
9930    INTEGER(iwp) ::  ic   !< loop index
9931    INTEGER(iwp) ::  ii   !< loop index
9932    INTEGER(iwp) ::  ind  !< index in the statistical output
9933    INTEGER(iwp) ::  j    !< loop index
9934    INTEGER(iwp) ::  k    !< loop index
9935    INTEGER(iwp) ::  sr   !< statistical region
9936    INTEGER(iwp) ::  tn   !< thread number
9937
9938    REAL(wp) ::  df        !< For calculating LDSA: fraction of particles depositing in the alveolar
9939                           !< (or tracheobronchial) region of the lung. Depends on the particle size
9940    REAL(wp) ::  mean_d    !< Particle diameter in micrometres
9941    REAL(wp) ::  temp_bin  !< temporary variable
9942
9943    IF ( mode == 'profiles' )  THEN
9944       !$OMP DO
9945       DO  ii = 1, salsa_pr_count
9946
9947          ind = pr_palm + max_pr_user + max_pr_cs + ii
9948
9949          SELECT CASE( salsa_pr_index(ii) )
9950
9951             CASE( 1 )  ! LDSA
9952                DO  i = nxl, nxr
9953                   DO  j = nys, nyn
9954                      DO  k = nzb, nzt+1
9955                         temp_bin = 0.0_wp
9956                         DO  ib = 1, nbins_aerosol
9957   !
9958   !--                      Diameter in micrometres
9959                            mean_d = 1.0E+6_wp * ra_dry(k,j,i,ib) * 2.0_wp
9960   !
9961   !--                      Deposition factor: alveolar
9962                            df = ( 0.01555_wp / mean_d ) * ( EXP( -0.416_wp * ( LOG( mean_d ) +    &
9963                                   2.84_wp )**2 ) + 19.11_wp * EXP( -0.482_wp * ( LOG( mean_d ) -  &
9964                                   1.362_wp )**2 ) )
9965   !
9966   !--                      Lung-deposited surface area LDSA (units mum2/cm3)
9967                            temp_bin = temp_bin + pi * mean_d**2 * df * 1.0E-6_wp *                &
9968                                       aerosol_number(ib)%conc(k,j,i)
9969                         ENDDO
9970                         sums_l(k,ind,tn) = sums_l(k,ind,tn) + temp_bin * rmask(j,i,sr)  *         &
9971                                           MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_0(k,j,i), 22 ) )
9972                      ENDDO
9973                   ENDDO
9974                ENDDO
9975
9976             CASE( 2 )  ! N_UFP
9977                DO  i = nxl, nxr
9978                   DO  j = nys, nyn
9979                      DO  k = nzb, nzt+1
9980                         temp_bin = 0.0_wp
9981                         DO  ib = 1, nbins_aerosol
9982                            IF ( 2.0_wp * ra_dry(k,j,i,ib) <= 0.1E-6_wp )                          &
9983                               temp_bin = temp_bin + aerosol_number(ib)%conc(k,j,i)
9984                         ENDDO
9985                         sums_l(k,ind,tn) = sums_l(k,ind,tn) + temp_bin * rmask(j,i,sr)  *         &
9986                                           MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_0(k,j,i), 22 ) )
9987                      ENDDO
9988                   ENDDO
9989                ENDDO
9990
9991             CASE( 3 )  ! Ntot
9992                DO  i = nxl, nxr
9993                   DO  j = nys, nyn
9994                      DO  k = nzb, nzt+1
9995                         temp_bin = 0.0_wp
9996                         DO  ib = 1, nbins_aerosol
9997                            temp_bin = temp_bin + aerosol_number(ib)%conc(k,j,i)
9998                         ENDDO
9999                         sums_l(k,ind,tn) = sums_l(k,ind,tn) + temp_bin * rmask(j,i,sr)  *         &
10000                                           MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_0(k,j,i), 22 ) )
10001                      ENDDO
10002                   ENDDO
10003                ENDDO
10004
10005             CASE( 4 )  ! PM0.1
10006                DO  i = nxl, nxr
10007                   DO  j = nys, nyn
10008                      DO  k = nzb, nzt+1
10009                         temp_bin = 0.0_wp
10010                         DO  ib = 1, nbins_aerosol
10011                            IF ( 2.0_wp * ra_dry(k,j,i,ib) <= 0.1E-6_wp )  THEN
10012                               DO  ic = ib, nbins_aerosol * ncc, nbins_aerosol
10013                                  temp_bin = temp_bin + aerosol_mass(ic)%conc(k,j,i)
10014                               ENDDO
10015                            ENDIF
10016                         ENDDO
10017                         sums_l(k,ind,tn) = sums_l(k,ind,tn) + temp_bin * rmask(j,i,sr)  *         &
10018                                           MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_0(k,j,i), 22 ) )
10019                      ENDDO
10020                   ENDDO
10021                ENDDO
10022
10023             CASE( 5 )  ! PM2.5
10024                DO  i = nxl, nxr
10025                   DO  j = nys, nyn
10026                      DO  k = nzb, nzt+1
10027                         temp_bin = 0.0_wp
10028                         DO  ib = 1, nbins_aerosol
10029                            IF ( 2.0_wp * ra_dry(k,j,i,ib) <= 2.5E-6_wp )  THEN
10030                               DO  ic = ib, nbins_aerosol * ncc, nbins_aerosol
10031                                  temp_bin = temp_bin + aerosol_mass(ic)%conc(k,j,i)
10032                               ENDDO
10033                            ENDIF
10034                         ENDDO
10035                         sums_l(k,ind,tn) = sums_l(k,ind,tn) + temp_bin * rmask(j,i,sr)  *         &
10036                                           MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_0(k,j,i), 22 ) )
10037                      ENDDO
10038                   ENDDO
10039                ENDDO
10040
10041             CASE( 6 )  ! PM10
10042                DO  i = nxl, nxr
10043                   DO  j = nys, nyn
10044                      DO  k = nzb, nzt+1
10045                         temp_bin = 0.0_wp
10046                         DO  ib = 1, nbins_aerosol
10047                            IF ( 2.0_wp * ra_dry(k,j,i,ib) <= 10.0E-6_wp )  THEN
10048                               DO  ic = ib, nbins_aerosol * ncc, nbins_aerosol
10049                                  temp_bin = temp_bin + aerosol_mass(ic)%conc(k,j,i)
10050                               ENDDO
10051                            ENDIF
10052                         ENDDO
10053                         sums_l(k,ind,tn) = sums_l(k,ind,tn) + temp_bin * rmask(j,i,sr)  *         &
10054                                           MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_0(k,j,i), 22 ) )
10055                      ENDDO
10056                   ENDDO
10057                ENDDO
10058
10059          END SELECT
10060       ENDDO
10061
10062    ELSEIF ( mode == 'time_series' )  THEN
10063!
10064!--    TODO
10065    ENDIF
10066
10067 END SUBROUTINE salsa_statistics
10068
10069
10070!------------------------------------------------------------------------------!
10071!
10072! Description:
10073! ------------
10074!> Subroutine for averaging 3D data
10075!------------------------------------------------------------------------------!
10076 SUBROUTINE salsa_3d_data_averaging( mode, variable )
10077
10078    USE control_parameters,                                                                        &
10079        ONLY:  average_count_3d
10080
10081    IMPLICIT NONE
10082
10083    CHARACTER(LEN=*)  ::  mode       !<
10084    CHARACTER(LEN=10) ::  vari       !<
10085    CHARACTER(LEN=*)  ::  variable   !<
10086
10087    INTEGER(iwp) ::  char_to_int  !< for converting character to integer
10088    INTEGER(iwp) ::  found_index  !<
10089    INTEGER(iwp) ::  i            !<
10090    INTEGER(iwp) ::  ib           !<
10091    INTEGER(iwp) ::  ic           !<
10092    INTEGER(iwp) ::  j            !<
10093    INTEGER(iwp) ::  k            !<
10094
10095    REAL(wp) ::  df       !< For calculating LDSA: fraction of particles depositing in the alveolar
10096                          !< (or tracheobronchial) region of the lung. Depends on the particle size
10097    REAL(wp) ::  mean_d   !< Particle diameter in micrometres
10098    REAL(wp) ::  temp_bin !< temporary variable
10099
10100    REAL(wp), DIMENSION(:,:,:), POINTER ::  to_be_resorted  !< points to selected output variable
10101
10102    temp_bin = 0.0_wp
10103
10104    IF ( mode == 'allocate' )  THEN
10105
10106       IF ( variable(7:11) ==  'N_bin' )  THEN
10107          IF ( .NOT. ALLOCATED( nbins_av ) )  THEN
10108             ALLOCATE( nbins_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg,nbins_aerosol) )
10109          ENDIF
10110          nbins_av = 0.0_wp
10111
10112       ELSEIF ( variable(7:11) ==  'm_bin' )  THEN
10113          IF ( .NOT. ALLOCATED( mbins_av ) )  THEN
10114             ALLOCATE( mbins_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg,nbins_aerosol) )
10115          ENDIF
10116          mbins_av = 0.0_wp
10117
10118       ELSE
10119
10120          SELECT CASE ( TRIM( variable(7:) ) )
10121
10122             CASE ( 'g_H2SO4' )
10123                IF ( .NOT. ALLOCATED( g_h2so4_av ) )  THEN
10124                   ALLOCATE( g_h2so4_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
10125                ENDIF
10126                g_h2so4_av = 0.0_wp
10127
10128             CASE ( 'g_HNO3' )
10129                IF ( .NOT. ALLOCATED( g_hno3_av ) )  THEN
10130                   ALLOCATE( g_hno3_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
10131                ENDIF
10132                g_hno3_av = 0.0_wp
10133
10134             CASE ( 'g_NH3' )
10135                IF ( .NOT. ALLOCATED( g_nh3_av ) )  THEN
10136                   ALLOCATE( g_nh3_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
10137                ENDIF
10138                g_nh3_av = 0.0_wp
10139
10140             CASE ( 'g_OCNV' )
10141                IF ( .NOT. ALLOCATED( g_ocnv_av ) )  THEN
10142                   ALLOCATE( g_ocnv_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
10143                ENDIF
10144                g_ocnv_av = 0.0_wp
10145
10146             CASE ( 'g_OCSV' )
10147                IF ( .NOT. ALLOCATED( g_ocsv_av ) )  THEN
10148                   ALLOCATE( g_ocsv_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
10149                ENDIF
10150                g_ocsv_av = 0.0_wp
10151
10152             CASE ( 'LDSA' )
10153                IF ( .NOT. ALLOCATED( ldsa_av ) )  THEN
10154                   ALLOCATE( ldsa_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
10155                ENDIF
10156                ldsa_av = 0.0_wp
10157
10158             CASE ( 'N_UFP' )
10159                IF ( .NOT. ALLOCATED( nufp_av ) )  THEN
10160                   ALLOCATE( nufp_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
10161                ENDIF
10162                nufp_av = 0.0_wp
10163
10164             CASE ( 'Ntot' )
10165                IF ( .NOT. ALLOCATED( ntot_av ) )  THEN
10166                   ALLOCATE( ntot_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
10167                ENDIF
10168                ntot_av = 0.0_wp
10169
10170             CASE ( 'PM0.1' )
10171                IF ( .NOT. ALLOCATED( pm01_av ) )  THEN
10172                   ALLOCATE( pm01_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
10173                ENDIF
10174                pm01_av = 0.0_wp
10175
10176             CASE ( 'PM2.5' )
10177                IF ( .NOT. ALLOCATED( pm25_av ) )  THEN
10178                   ALLOCATE( pm25_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
10179                ENDIF
10180                pm25_av = 0.0_wp
10181
10182             CASE ( 'PM10' )
10183                IF ( .NOT. ALLOCATED( pm10_av ) )  THEN
10184                   ALLOCATE( pm10_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
10185                ENDIF
10186                pm10_av = 0.0_wp
10187
10188             CASE ( 's_BC' )
10189                IF ( .NOT. ALLOCATED( s_bc_av ) )  THEN
10190                   ALLOCATE( s_bc_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
10191                ENDIF
10192                s_bc_av = 0.0_wp
10193
10194             CASE ( 's_DU' )
10195                IF ( .NOT. ALLOCATED( s_du_av ) )  THEN
10196                   ALLOCATE( s_du_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
10197                ENDIF
10198                s_du_av = 0.0_wp
10199
10200             CASE ( 's_H2O' )
10201                IF ( .NOT. ALLOCATED( s_h2o_av ) )  THEN
10202                   ALLOCATE( s_h2o_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
10203                ENDIF
10204                s_h2o_av = 0.0_wp
10205
10206             CASE ( 's_NH' )
10207                IF ( .NOT. ALLOCATED( s_nh_av ) )  THEN
10208                   ALLOCATE( s_nh_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
10209                ENDIF
10210                s_nh_av = 0.0_wp
10211
10212             CASE ( 's_NO' )
10213                IF ( .NOT. ALLOCATED( s_no_av ) )  THEN
10214                   ALLOCATE( s_no_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
10215                ENDIF
10216                s_no_av = 0.0_wp
10217
10218             CASE ( 's_OC' )
10219                IF ( .NOT. ALLOCATED( s_oc_av ) )  THEN
10220                   ALLOCATE( s_oc_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
10221                ENDIF
10222                s_oc_av = 0.0_wp
10223
10224             CASE ( 's_SO4' )
10225                IF ( .NOT. ALLOCATED( s_so4_av ) )  THEN
10226                   ALLOCATE( s_so4_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
10227                ENDIF
10228                s_so4_av = 0.0_wp
10229
10230             CASE ( 's_SS' )
10231                IF ( .NOT. ALLOCATED( s_ss_av ) )  THEN
10232                   ALLOCATE( s_ss_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
10233                ENDIF
10234                s_ss_av = 0.0_wp
10235
10236             CASE DEFAULT
10237                CONTINUE
10238
10239          END SELECT
10240
10241       ENDIF
10242
10243    ELSEIF ( mode == 'sum' )  THEN
10244
10245       IF ( variable(7:11) ==  'N_bin' )  THEN
10246          READ( variable(12:),* ) char_to_int
10247          IF ( char_to_int >= 1  .AND. char_to_int <= SUM( nbin ) )  THEN
10248             ib = char_to_int
10249             DO  i = nxlg, nxrg
10250                DO  j = nysg, nyng
10251                   DO  k = nzb, nzt+1
10252                      nbins_av(k,j,i,ib) = nbins_av(k,j,i,ib) + aerosol_number(ib)%conc(k,j,i)
10253                   ENDDO
10254                ENDDO
10255             ENDDO
10256          ENDIF
10257
10258       ELSEIF ( variable(7:11) ==  'm_bin' )  THEN
10259          READ( variable(12:),* ) char_to_int
10260          IF ( char_to_int >= 1  .AND. char_to_int <= SUM( nbin ) )  THEN
10261             ib = char_to_int
10262             DO  i = nxlg, nxrg
10263                DO  j = nysg, nyng
10264                   DO  k = nzb, nzt+1
10265                      temp_bin = 0.0_wp
10266                      DO  ic = ib, nbins_aerosol * ncomponents_mass, nbins_aerosol
10267                         temp_bin = temp_bin + aerosol_mass(ic)%conc(k,j,i)
10268                      ENDDO
10269                      mbins_av(k,j,i,ib) = mbins_av(k,j,i,ib) + temp_bin
10270                   ENDDO
10271                ENDDO
10272             ENDDO
10273          ENDIF
10274       ELSE
10275
10276          SELECT CASE ( TRIM( variable(7:) ) )
10277
10278             CASE ( 'g_H2SO4', 'g_HNO3', 'g_NH3', 'g_OCNV', 'g_OCSV' )
10279
10280                vari = TRIM( variable(9:) )  ! remove salsa_g_ from beginning
10281
10282                SELECT CASE( vari )
10283
10284                   CASE( 'H2SO4' )
10285                      found_index = 1
10286                      to_be_resorted => g_h2so4_av
10287
10288                   CASE( 'HNO3' )
10289                      found_index = 2
10290                      to_be_resorted => g_hno3_av
10291
10292                   CASE( 'NH3' )
10293                      found_index = 3
10294                      to_be_resorted => g_nh3_av
10295
10296                   CASE( 'OCNV' )
10297                      found_index = 4
10298                      to_be_resorted => g_ocnv_av
10299
10300                   CASE( 'OCSV' )
10301                      found_index = 5
10302                      to_be_resorted => g_ocsv_av
10303
10304                END SELECT
10305
10306                DO  i = nxlg, nxrg
10307                   DO  j = nysg, nyng
10308                      DO  k = nzb, nzt+1
10309                         to_be_resorted(k,j,i) = to_be_resorted(k,j,i) +                           &
10310                                                 salsa_gas(found_index)%conc(k,j,i)
10311                      ENDDO
10312                   ENDDO
10313                ENDDO
10314
10315             CASE ( 'LDSA' )
10316                DO  i = nxlg, nxrg
10317                   DO  j = nysg, nyng
10318                      DO  k = nzb, nzt+1
10319                         temp_bin = 0.0_wp
10320                         DO  ib = 1, nbins_aerosol
10321   !
10322   !--                      Diameter in micrometres
10323                            mean_d = 1.0E+6_wp * ra_dry(k,j,i,ib) * 2.0_wp
10324   !
10325   !--                      Deposition factor: alveolar (use ra_dry)
10326                            df = ( 0.01555_wp / mean_d ) * ( EXP( -0.416_wp * ( LOG( mean_d ) +    &
10327                                   2.84_wp )**2 ) + 19.11_wp * EXP( -0.482_wp * ( LOG( mean_d ) -  &
10328                                   1.362_wp )**2 ) )
10329   !
10330   !--                      Lung-deposited surface area LDSA (units mum2/cm3)
10331                            temp_bin = temp_bin + pi * mean_d**2 * df * 1.0E-6_wp *                &
10332                                       aerosol_number(ib)%conc(k,j,i)
10333                         ENDDO
10334                         ldsa_av(k,j,i) = ldsa_av(k,j,i) + temp_bin
10335                      ENDDO
10336                   ENDDO
10337                ENDDO
10338
10339             CASE ( 'N_UFP' )
10340                DO  i = nxlg, nxrg
10341                   DO  j = nysg, nyng
10342                      DO  k = nzb, nzt+1
10343                         temp_bin = 0.0_wp
10344                         DO  ib = 1, nbins_aerosol
10345                            IF ( 2.0_wp * ra_dry(k,j,i,ib) <= 0.1E-6_wp )  THEN
10346                               temp_bin = temp_bin + aerosol_number(ib)%conc(k,j,i)
10347                            ENDIF
10348                         ENDDO
10349                         nufp_av(k,j,i) = nufp_av(k,j,i) + temp_bin
10350                      ENDDO
10351                   ENDDO
10352                ENDDO
10353
10354             CASE ( 'Ntot' )
10355                DO  i = nxlg, nxrg
10356                   DO  j = nysg, nyng
10357                      DO  k = nzb, nzt+1
10358                         DO  ib = 1, nbins_aerosol
10359                            ntot_av(k,j,i) = ntot_av(k,j,i) + aerosol_number(ib)%conc(k,j,i)
10360                         ENDDO
10361                      ENDDO
10362                   ENDDO
10363                ENDDO
10364
10365             CASE ( 'PM0.1' )
10366                DO  i = nxlg, nxrg
10367                   DO  j = nysg, nyng
10368                      DO  k = nzb, nzt+1
10369                         temp_bin = 0.0_wp
10370                         DO  ib = 1, nbins_aerosol
10371                            IF ( 2.0_wp * ra_dry(k,j,i,ib) <= 0.1E-6_wp )  THEN
10372                               DO  ic = ib, nbins_aerosol * ncc, nbins_aerosol
10373                                  temp_bin = temp_bin + aerosol_mass(ic)%conc(k,j,i)
10374                               ENDDO
10375                            ENDIF
10376                         ENDDO
10377                         pm01_av(k,j,i) = pm01_av(k,j,i) + temp_bin
10378                      ENDDO
10379                   ENDDO
10380                ENDDO
10381
10382             CASE ( 'PM2.5' )
10383                DO  i = nxlg, nxrg
10384                   DO  j = nysg, nyng
10385                      DO  k = nzb, nzt+1
10386                         temp_bin = 0.0_wp
10387                         DO  ib = 1, nbins_aerosol
10388                            IF ( 2.0_wp * ra_dry(k,j,i,ib) <= 2.5E-6_wp )  THEN
10389                               DO  ic = ib, nbins_aerosol * ncc, nbins_aerosol
10390                                  temp_bin = temp_bin + aerosol_mass(ic)%conc(k,j,i)
10391                               ENDDO
10392                            ENDIF
10393                         ENDDO
10394                         pm25_av(k,j,i) = pm25_av(k,j,i) + temp_bin
10395                      ENDDO
10396                   ENDDO
10397                ENDDO
10398
10399             CASE ( 'PM10' )
10400                DO  i = nxlg, nxrg
10401                   DO  j = nysg, nyng
10402                      DO  k = nzb, nzt+1
10403                         temp_bin = 0.0_wp
10404                         DO  ib = 1, nbins_aerosol
10405                            IF ( 2.0_wp * ra_dry(k,j,i,ib) <= 10.0E-6_wp )  THEN
10406                               DO  ic = ib, nbins_aerosol * ncc, nbins_aerosol
10407                                  temp_bin = temp_bin + aerosol_mass(ic)%conc(k,j,i)
10408                               ENDDO
10409                            ENDIF
10410                         ENDDO
10411                         pm10_av(k,j,i) = pm10_av(k,j,i) + temp_bin
10412                      ENDDO
10413                   ENDDO
10414                ENDDO
10415
10416             CASE ( 's_BC', 's_DU', 's_NH', 's_NO', 's_OC', 's_SO4', 's_SS' )
10417                IF ( is_used( prtcl, TRIM( variable(9:) ) ) )  THEN  ! 9: remove salsa_s_
10418                   found_index = get_index( prtcl, TRIM( variable(9:) ) )
10419                   IF ( TRIM( variable(9:) ) == 'BC' )   to_be_resorted => s_bc_av
10420                   IF ( TRIM( variable(9:) ) == 'DU' )   to_be_resorted => s_du_av
10421                   IF ( TRIM( variable(9:) ) == 'NH' )   to_be_resorted => s_nh_av
10422                   IF ( TRIM( variable(9:) ) == 'NO' )   to_be_resorted => s_no_av
10423                   IF ( TRIM( variable(9:) ) == 'OC' )   to_be_resorted => s_oc_av
10424                   IF ( TRIM( variable(9:) ) == 'SO4' )  to_be_resorted => s_so4_av
10425                   IF ( TRIM( variable(9:) ) == 'SS' )   to_be_resorted => s_ss_av
10426                   DO  i = nxlg, nxrg
10427                      DO  j = nysg, nyng
10428                         DO  k = nzb, nzt+1
10429                            DO  ic = ( found_index-1 ) * nbins_aerosol + 1, found_index * nbins_aerosol
10430                               to_be_resorted(k,j,i) = to_be_resorted(k,j,i) +                     &
10431                                                       aerosol_mass(ic)%conc(k,j,i)
10432                            ENDDO
10433                         ENDDO
10434                      ENDDO
10435                   ENDDO
10436                ENDIF
10437
10438             CASE ( 's_H2O' )
10439                found_index = get_index( prtcl,'H2O' )
10440                to_be_resorted => s_h2o_av
10441                DO  i = nxlg, nxrg
10442                   DO  j = nysg, nyng
10443                      DO  k = nzb, nzt+1
10444                         DO  ic = ( found_index-1 ) * nbins_aerosol + 1, found_index * nbins_aerosol
10445                            s_h2o_av(k,j,i) = s_h2o_av(k,j,i) + aerosol_mass(ic)%conc(k,j,i)
10446                         ENDDO
10447                      ENDDO
10448                   ENDDO
10449                ENDDO
10450
10451             CASE DEFAULT
10452                CONTINUE
10453
10454          END SELECT
10455
10456       ENDIF
10457
10458    ELSEIF ( mode == 'average' )  THEN
10459
10460       IF ( variable(7:11) ==  'N_bin' )  THEN
10461          READ( variable(12:),* ) char_to_int
10462          IF ( char_to_int >= 1  .AND. char_to_int <= SUM( nbin ) )  THEN
10463             ib = char_to_int
10464             DO  i = nxlg, nxrg
10465                DO  j = nysg, nyng
10466                   DO  k = nzb, nzt+1
10467                      nbins_av(k,j,i,ib) = nbins_av(k,j,i,ib) / REAL( average_count_3d, KIND=wp )
10468                   ENDDO
10469                ENDDO
10470             ENDDO
10471          ENDIF
10472
10473       ELSEIF ( variable(7:11) ==  'm_bin' )  THEN
10474          READ( variable(12:),* ) char_to_int
10475          IF ( char_to_int >= 1  .AND. char_to_int <= SUM( nbin ) )  THEN
10476             ib = char_to_int
10477             DO  i = nxlg, nxrg
10478                DO  j = nysg, nyng
10479                   DO  k = nzb, nzt+1
10480                      mbins_av(k,j,i,ib) = mbins_av(k,j,i,ib) / REAL( average_count_3d, KIND=wp)
10481                   ENDDO
10482                ENDDO
10483             ENDDO
10484          ENDIF
10485       ELSE
10486
10487          SELECT CASE ( TRIM( variable(7:) ) )
10488
10489             CASE ( 'g_H2SO4', 'g_HNO3', 'g_NH3', 'g_OCNV', 'g_OCSV' )
10490                IF ( TRIM( variable(9:) ) == 'H2SO4' )  THEN  ! 9: remove salsa_g_ from beginning
10491                   found_index = 1
10492                   to_be_resorted => g_h2so4_av
10493                ELSEIF ( TRIM( variable(9:) ) == 'HNO3' )  THEN
10494                   found_index = 2
10495                   to_be_resorted => g_hno3_av
10496                ELSEIF ( TRIM( variable(9:) ) == 'NH3' )  THEN
10497                   found_index = 3
10498                   to_be_resorted => g_nh3_av
10499                ELSEIF ( TRIM( variable(9:) ) == 'OCNV' )  THEN
10500                   found_index = 4
10501                   to_be_resorted => g_ocnv_av
10502                ELSEIF ( TRIM( variable(9:) ) == 'OCSV' )  THEN
10503                   found_index = 5
10504                   to_be_resorted => g_ocsv_av
10505                ENDIF
10506                DO  i = nxlg, nxrg
10507                   DO  j = nysg, nyng
10508                      DO  k = nzb, nzt+1
10509                         to_be_resorted(k,j,i) = to_be_resorted(k,j,i) /                           &
10510                                                 REAL( average_count_3d, KIND=wp )
10511                      ENDDO
10512                   ENDDO
10513                ENDDO
10514
10515             CASE ( 'LDSA' )
10516                DO  i = nxlg, nxrg
10517                   DO  j = nysg, nyng
10518                      DO  k = nzb, nzt+1
10519                         ldsa_av(k,j,i) = ldsa_av(k,j,i) / REAL( average_count_3d, KIND=wp )
10520                      ENDDO
10521                   ENDDO
10522                ENDDO
10523
10524             CASE ( 'N_UFP' )
10525                DO  i = nxlg, nxrg
10526                   DO  j = nysg, nyng
10527                      DO  k = nzb, nzt+1
10528                         nufp_av(k,j,i) = nufp_av(k,j,i) / REAL( average_count_3d, KIND=wp )
10529                      ENDDO
10530                   ENDDO
10531                ENDDO
10532
10533             CASE ( 'Ntot' )
10534                DO  i = nxlg, nxrg
10535                   DO  j = nysg, nyng
10536                      DO  k = nzb, nzt+1
10537                         ntot_av(k,j,i) = ntot_av(k,j,i) / REAL( average_count_3d, KIND=wp )
10538                      ENDDO
10539                   ENDDO
10540                ENDDO
10541
10542
10543             CASE ( 'PM0.1' )
10544                DO  i = nxlg, nxrg
10545                   DO  j = nysg, nyng
10546                      DO  k = nzb, nzt+1
10547                         pm01_av(k,j,i) = pm01_av(k,j,i) / REAL( average_count_3d, KIND=wp )
10548                      ENDDO
10549                   ENDDO
10550                ENDDO
10551
10552             CASE ( 'PM2.5' )
10553                DO  i = nxlg, nxrg
10554                   DO  j = nysg, nyng
10555                      DO  k = nzb, nzt+1
10556                         pm25_av(k,j,i) = pm25_av(k,j,i) / REAL( average_count_3d, KIND=wp )
10557                      ENDDO
10558                   ENDDO
10559                ENDDO
10560
10561             CASE ( 'PM10' )
10562                DO  i = nxlg, nxrg
10563                   DO  j = nysg, nyng
10564                      DO  k = nzb, nzt+1
10565                         pm10_av(k,j,i) = pm10_av(k,j,i) / REAL( average_count_3d, KIND=wp )
10566                      ENDDO
10567                   ENDDO
10568                ENDDO
10569
10570             CASE ( 's_BC', 's_DU', 's_NH', 's_NO', 's_OC', 's_SO4', 's_SS' )
10571                IF ( is_used( prtcl, TRIM( variable(9:) ) ) )  THEN  ! 9: remove salsa_s_
10572                   IF ( TRIM( variable(9:) ) == 'BC' )   to_be_resorted => s_bc_av
10573                   IF ( TRIM( variable(9:) ) == 'DU' )   to_be_resorted => s_du_av
10574                   IF ( TRIM( variable(9:) ) == 'NH' )   to_be_resorted => s_nh_av
10575                   IF ( TRIM( variable(9:) ) == 'NO' )   to_be_resorted => s_no_av
10576                   IF ( TRIM( variable(9:) ) == 'OC' )   to_be_resorted => s_oc_av
10577                   IF ( TRIM( variable(9:) ) == 'SO4' )  to_be_resorted => s_so4_av
10578                   IF ( TRIM( variable(9:) ) == 'SS' )   to_be_resorted => s_ss_av 
10579                   DO  i = nxlg, nxrg
10580                      DO  j = nysg, nyng
10581                         DO  k = nzb, nzt+1
10582                            to_be_resorted(k,j,i) = to_be_resorted(k,j,i) /                        &
10583                                                    REAL( average_count_3d, KIND=wp )
10584                         ENDDO
10585                      ENDDO
10586                   ENDDO
10587                ENDIF
10588
10589             CASE ( 's_H2O' )
10590                to_be_resorted => s_h2o_av
10591                DO  i = nxlg, nxrg
10592                   DO  j = nysg, nyng
10593                      DO  k = nzb, nzt+1
10594                         to_be_resorted(k,j,i) = to_be_resorted(k,j,i) /                           &
10595                                                 REAL( average_count_3d, KIND=wp )
10596                      ENDDO
10597                   ENDDO
10598                ENDDO
10599
10600          END SELECT
10601
10602       ENDIF
10603    ENDIF
10604
10605 END SUBROUTINE salsa_3d_data_averaging
10606
10607
10608!------------------------------------------------------------------------------!
10609!
10610! Description:
10611! ------------
10612!> Subroutine defining 2D output variables
10613!------------------------------------------------------------------------------!
10614 SUBROUTINE salsa_data_output_2d( av, variable, found, grid, mode, local_pf, two_d, nzb_do, nzt_do )
10615
10616    USE indices
10617
10618    USE kinds
10619
10620
10621    IMPLICIT NONE
10622
10623    CHARACTER(LEN=*) ::  grid       !<
10624    CHARACTER(LEN=*) ::  mode       !<
10625    CHARACTER(LEN=*) ::  variable   !<
10626    CHARACTER(LEN=5) ::  vari       !<  trimmed format of variable
10627
10628    INTEGER(iwp) ::  av           !<
10629    INTEGER(iwp) ::  char_to_int  !< for converting character to integer
10630    INTEGER(iwp) ::  found_index  !< index of a chemical compound
10631    INTEGER(iwp) ::  i            !<
10632    INTEGER(iwp) ::  ib           !< running index: size bins
10633    INTEGER(iwp) ::  ic           !< running index: mass bins
10634    INTEGER(iwp) ::  j            !<
10635    INTEGER(iwp) ::  k            !<
10636    INTEGER(iwp) ::  nzb_do       !<
10637    INTEGER(iwp) ::  nzt_do       !<
10638
10639    LOGICAL ::  found  !<
10640    LOGICAL ::  two_d  !< flag parameter to indicate 2D variables (horizontal cross sections)
10641
10642    REAL(wp) ::  df                       !< For calculating LDSA: fraction of particles
10643                                          !< depositing in the alveolar (or tracheobronchial)
10644                                          !< region of the lung. Depends on the particle size
10645    REAL(wp) ::  mean_d                   !< Particle diameter in micrometres
10646    REAL(wp) ::  temp_bin                 !< temporary array for calculating output variables
10647
10648    REAL(wp), DIMENSION(nxl:nxr,nys:nyn,nzb_do:nzt_do) ::  local_pf  !< output
10649
10650    REAL(wp), DIMENSION(:,:,:), POINTER ::  to_be_resorted           !< pointer
10651!
10652!-- Next statement is to avoid compiler warning about unused variable. May be removed in future.
10653    IF ( two_d )  CONTINUE
10654
10655    found = .TRUE.
10656    temp_bin  = 0.0_wp
10657
10658    IF ( variable(7:11)  == 'N_bin' )  THEN
10659
10660       READ( variable( 12:LEN( TRIM( variable ) ) - 3 ), * ) char_to_int
10661       IF ( char_to_int >= 1  .AND. char_to_int <= SUM( nbin ) )  THEN
10662
10663          ib = char_to_int
10664          IF ( av == 0 )  THEN
10665             DO  i = nxl, nxr
10666                DO  j = nys, nyn
10667                   DO  k = nzb_do, nzt_do
10668                      local_pf(i,j,k) = MERGE( aerosol_number(ib)%conc(k,j,i), REAL( fill_value,   &
10669                                               KIND = wp ), BTEST( wall_flags_0(k,j,i), 0 ) )
10670                   ENDDO
10671                ENDDO
10672             ENDDO
10673          ELSE
10674             DO  i = nxl, nxr
10675                DO  j = nys, nyn
10676                   DO  k = nzb_do, nzt_do
10677                      local_pf(i,j,k) = MERGE( nbins_av(k,j,i,ib), REAL( fill_value, KIND = wp ),  &
10678                                               BTEST( wall_flags_0(k,j,i), 0 ) )
10679                   ENDDO
10680                ENDDO
10681             ENDDO
10682          ENDIF
10683          IF ( mode == 'xy' )  grid = 'zu'
10684       ENDIF
10685
10686    ELSEIF ( variable(7:11)  == 'm_bin' )  THEN
10687
10688       READ( variable( 12:LEN( TRIM( variable ) ) - 3 ), * ) char_to_int
10689       IF ( char_to_int >= 1  .AND. char_to_int <= SUM( nbin ) )  THEN
10690
10691          ib = char_to_int
10692          IF ( av == 0 )  THEN
10693             DO  i = nxl, nxr
10694                DO  j = nys, nyn
10695                   DO  k = nzb_do, nzt_do
10696                      temp_bin = 0.0_wp
10697                      DO  ic = ib, ncomponents_mass * nbins_aerosol, nbins_aerosol
10698                         temp_bin = temp_bin + aerosol_mass(ic)%conc(k,j,i)
10699                      ENDDO
10700                      local_pf(i,j,k) = MERGE( temp_bin, REAL( fill_value, KIND = wp ),            &
10701                                               BTEST( wall_flags_0(k,j,i), 0 ) )
10702                   ENDDO
10703                ENDDO
10704             ENDDO
10705          ELSE
10706             DO  i = nxl, nxr
10707                DO  j = nys, nyn
10708                   DO  k = nzb_do, nzt_do
10709                      local_pf(i,j,k) = MERGE( mbins_av(k,j,i,ib), REAL( fill_value, KIND = wp ),  &
10710                                               BTEST( wall_flags_0(k,j,i), 0 ) )
10711                   ENDDO
10712                ENDDO
10713             ENDDO
10714          ENDIF
10715          IF ( mode == 'xy' )  grid = 'zu'
10716       ENDIF
10717
10718    ELSE
10719
10720       SELECT CASE ( TRIM( variable( 7:LEN( TRIM( variable ) ) - 3 ) ) )  ! cut out _xy, _xz or _yz
10721
10722          CASE ( 'g_H2SO4', 'g_HNO3', 'g_NH3', 'g_OCNV', 'g_OCSV' )
10723             vari = TRIM( variable( 9:LEN( TRIM( variable ) ) - 3 ) )  ! 9: remove salsa_g_
10724             IF ( av == 0 )  THEN
10725                IF ( vari == 'H2SO4')  found_index = 1
10726                IF ( vari == 'HNO3')   found_index = 2
10727                IF ( vari == 'NH3')    found_index = 3
10728                IF ( vari == 'OCNV')   found_index = 4
10729                IF ( vari == 'OCSV')   found_index = 5
10730                DO  i = nxl, nxr
10731                   DO  j = nys, nyn
10732                      DO  k = nzb_do, nzt_do
10733                         local_pf(i,j,k) = MERGE( salsa_gas(found_index)%conc(k,j,i),              &
10734                                                  REAL( fill_value,  KIND = wp ),                  &
10735                                                  BTEST( wall_flags_0(k,j,i), 0 ) )
10736                      ENDDO
10737                   ENDDO
10738                ENDDO
10739             ELSE
10740                IF ( vari == 'H2SO4' )  to_be_resorted => g_h2so4_av
10741                IF ( vari == 'HNO3' )   to_be_resorted => g_hno3_av
10742                IF ( vari == 'NH3' )    to_be_resorted => g_nh3_av
10743                IF ( vari == 'OCNV' )   to_be_resorted => g_ocnv_av
10744                IF ( vari == 'OCSV' )   to_be_resorted => g_ocsv_av
10745                DO  i = nxl, nxr
10746                   DO  j = nys, nyn
10747                      DO  k = nzb_do, nzt_do
10748                         local_pf(i,j,k) = MERGE( to_be_resorted(k,j,i), REAL( fill_value,         &
10749                                                  KIND = wp ), BTEST( wall_flags_0(k,j,i), 0 ) )
10750                      ENDDO
10751                   ENDDO
10752                ENDDO
10753             ENDIF
10754
10755             IF ( mode == 'xy' )  grid = 'zu'
10756
10757          CASE ( 'LDSA' )
10758             IF ( av == 0 )  THEN
10759                DO  i = nxl, nxr
10760                   DO  j = nys, nyn
10761                      DO  k = nzb_do, nzt_do
10762                         temp_bin = 0.0_wp
10763                         DO  ib = 1, nbins_aerosol
10764   !
10765   !--                      Diameter in micrometres
10766                            mean_d = 1.0E+6_wp * ra_dry(k,j,i,ib) * 2.0_wp 
10767   !
10768   !--                      Deposition factor: alveolar
10769                            df = ( 0.01555_wp / mean_d ) * ( EXP( -0.416_wp * ( LOG( mean_d ) +    &
10770                                   2.84_wp )**2 ) + 19.11_wp * EXP( -0.482_wp * ( LOG( mean_d ) -  &
10771                                   1.362_wp )**2 ) )
10772   !
10773   !--                      Lung-deposited surface area LDSA (units mum2/cm3)
10774                            temp_bin = temp_bin + pi * mean_d**2 * df * 1.0E-6_wp *                &
10775                                       aerosol_number(ib)%conc(k,j,i)
10776                         ENDDO
10777
10778                         local_pf(i,j,k) = MERGE( temp_bin, REAL( fill_value, KIND = wp ),         &
10779                                                  BTEST( wall_flags_0(k,j,i), 0 ) )
10780                      ENDDO
10781                   ENDDO
10782                ENDDO
10783             ELSE
10784                DO  i = nxl, nxr
10785                   DO  j = nys, nyn
10786                      DO  k = nzb_do, nzt_do
10787                         local_pf(i,j,k) = MERGE( ldsa_av(k,j,i), REAL( fill_value, KIND = wp ),   &
10788                                                  BTEST( wall_flags_0(k,j,i), 0 ) )
10789                      ENDDO
10790                   ENDDO
10791                ENDDO
10792             ENDIF
10793
10794             IF ( mode == 'xy' )  grid = 'zu'
10795
10796          CASE ( 'N_UFP' )
10797
10798             IF ( av == 0 )  THEN
10799                DO  i = nxl, nxr
10800                   DO  j = nys, nyn
10801                      DO  k = nzb_do, nzt_do
10802                         temp_bin = 0.0_wp
10803                         DO  ib = 1, nbins_aerosol
10804                            IF ( 2.0_wp * ra_dry(k,j,i,ib) <= 0.1E-6_wp )  THEN
10805                               temp_bin = temp_bin + aerosol_number(ib)%conc(k,j,i)
10806                            ENDIF
10807                         ENDDO
10808                         local_pf(i,j,k) = MERGE( temp_bin, REAL( fill_value, KIND = wp ),         &
10809                                                  BTEST( wall_flags_0(k,j,i), 0 ) )
10810                      ENDDO
10811                   ENDDO
10812                ENDDO
10813             ELSE
10814                DO  i = nxl, nxr
10815                   DO  j = nys, nyn
10816                      DO  k = nzb_do, nzt_do
10817                         local_pf(i,j,k) = MERGE( nufp_av(k,j,i), REAL( fill_value, KIND = wp ),   &
10818                                                  BTEST( wall_flags_0(k,j,i), 0 ) )
10819                      ENDDO
10820                   ENDDO
10821                ENDDO
10822             ENDIF
10823
10824             IF ( mode == 'xy' )  grid = 'zu'
10825
10826          CASE ( 'Ntot' )
10827
10828             IF ( av == 0 )  THEN
10829                DO  i = nxl, nxr
10830                   DO  j = nys, nyn
10831                      DO  k = nzb_do, nzt_do
10832                         temp_bin = 0.0_wp
10833                         DO  ib = 1, nbins_aerosol
10834                            temp_bin = temp_bin + aerosol_number(ib)%conc(k,j,i)
10835                         ENDDO
10836                         local_pf(i,j,k) = MERGE( temp_bin, REAL( fill_value, KIND = wp ),         &
10837                                                  BTEST( wall_flags_0(k,j,i), 0 ) )
10838                      ENDDO
10839                   ENDDO
10840                ENDDO
10841             ELSE
10842                DO  i = nxl, nxr
10843                   DO  j = nys, nyn
10844                      DO  k = nzb_do, nzt_do
10845                         local_pf(i,j,k) = MERGE( ntot_av(k,j,i), REAL( fill_value, KIND = wp ),   &
10846                                                  BTEST( wall_flags_0(k,j,i), 0 ) )
10847                      ENDDO
10848                   ENDDO
10849                ENDDO
10850             ENDIF
10851
10852             IF ( mode == 'xy' )  grid = 'zu'
10853
10854          CASE ( 'PM0.1' )
10855             IF ( av == 0 )  THEN
10856                DO  i = nxl, nxr
10857                   DO  j = nys, nyn
10858                      DO  k = nzb_do, nzt_do
10859                         temp_bin = 0.0_wp
10860                         DO  ib = 1, nbins_aerosol
10861                            IF ( 2.0_wp * ra_dry(k,j,i,ib) <= 0.1E-6_wp )  THEN
10862                               DO  ic = ib, nbins_aerosol * ncc, nbins_aerosol
10863                                  temp_bin = temp_bin + aerosol_mass(ic)%conc(k,j,i)
10864                               ENDDO
10865                            ENDIF
10866                         ENDDO
10867                         local_pf(i,j,k) = MERGE( temp_bin, REAL( fill_value, KIND = wp ),         &
10868                                                  BTEST( wall_flags_0(k,j,i), 0 ) )
10869                      ENDDO
10870                   ENDDO
10871                ENDDO
10872             ELSE
10873                DO  i = nxl, nxr
10874                   DO  j = nys, nyn
10875                      DO  k = nzb_do, nzt_do
10876                         local_pf(i,j,k) = MERGE( pm01_av(k,j,i), REAL( fill_value, KIND = wp ),   &
10877                                                  BTEST( wall_flags_0(k,j,i), 0 ) )
10878                      ENDDO
10879                   ENDDO
10880                ENDDO
10881             ENDIF
10882
10883             IF ( mode == 'xy' )  grid = 'zu'
10884
10885          CASE ( 'PM2.5' )
10886             IF ( av == 0 )  THEN
10887                DO  i = nxl, nxr
10888                   DO  j = nys, nyn
10889                      DO  k = nzb_do, nzt_do
10890                         temp_bin = 0.0_wp
10891                         DO  ib = 1, nbins_aerosol
10892                            IF ( 2.0_wp * ra_dry(k,j,i,ib) <= 2.5E-6_wp )  THEN
10893                               DO  ic = ib, nbins_aerosol * ncc, nbins_aerosol
10894                                  temp_bin = temp_bin + aerosol_mass(ic)%conc(k,j,i)
10895                               ENDDO
10896                            ENDIF
10897                         ENDDO
10898                         local_pf(i,j,k) = MERGE( temp_bin, REAL( fill_value, KIND = wp ),         &
10899                                                  BTEST( wall_flags_0(k,j,i), 0 ) )
10900                      ENDDO
10901                   ENDDO
10902                ENDDO
10903             ELSE
10904                DO  i = nxl, nxr
10905                   DO  j = nys, nyn
10906                      DO  k = nzb_do, nzt_do
10907                         local_pf(i,j,k) = MERGE( pm25_av(k,j,i), REAL( fill_value, KIND = wp ),   &
10908                                                  BTEST( wall_flags_0(k,j,i), 0 ) )
10909                      ENDDO
10910                   ENDDO
10911                ENDDO
10912             ENDIF
10913
10914             IF ( mode == 'xy' )  grid = 'zu'
10915
10916          CASE ( 'PM10' )
10917             IF ( av == 0 )  THEN
10918                DO  i = nxl, nxr
10919                   DO  j = nys, nyn
10920                      DO  k = nzb_do, nzt_do
10921                         temp_bin = 0.0_wp
10922                         DO  ib = 1, nbins_aerosol
10923                            IF ( 2.0_wp * ra_dry(k,j,i,ib) <= 10.0E-6_wp )  THEN
10924                               DO  ic = ib, nbins_aerosol * ncc, nbins_aerosol
10925                                  temp_bin = temp_bin + aerosol_mass(ic)%conc(k,j,i)
10926                               ENDDO
10927                            ENDIF
10928                         ENDDO
10929                         local_pf(i,j,k) = MERGE( temp_bin,  REAL( fill_value, KIND = wp ),        &
10930                                                  BTEST( wall_flags_0(k,j,i), 0 ) )
10931                      ENDDO
10932                   ENDDO
10933                ENDDO
10934             ELSE
10935                DO  i = nxl, nxr
10936                   DO  j = nys, nyn
10937                      DO  k = nzb_do, nzt_do
10938                         local_pf(i,j,k) = MERGE( pm10_av(k,j,i), REAL( fill_value, KIND = wp ),   &
10939                                                  BTEST( wall_flags_0(k,j,i), 0 ) )
10940                      ENDDO
10941                   ENDDO
10942                ENDDO
10943             ENDIF
10944
10945             IF ( mode == 'xy' )  grid = 'zu'
10946
10947          CASE ( 's_BC', 's_DU', 's_NH', 's_NO', 's_OC', 's_SO4', 's_SS' )
10948             vari = TRIM( variable( 9:LEN( TRIM( variable ) ) - 3 ) )  ! 9: remove salsa_s_
10949             IF ( is_used( prtcl, vari ) )  THEN
10950                found_index = get_index( prtcl, vari )
10951                IF ( av == 0 )  THEN
10952                   DO  i = nxl, nxr
10953                      DO  j = nys, nyn
10954                         DO  k = nzb_do, nzt_do
10955                            temp_bin = 0.0_wp
10956                            DO  ic = ( found_index-1 ) * nbins_aerosol+1, found_index * nbins_aerosol
10957                               temp_bin = temp_bin + aerosol_mass(ic)%conc(k,j,i)
10958                            ENDDO
10959                            local_pf(i,j,k) = MERGE( temp_bin, REAL( fill_value, KIND = wp ),      &
10960                                                     BTEST( wall_flags_0(k,j,i), 0 ) )
10961                         ENDDO
10962                      ENDDO
10963                   ENDDO
10964                ELSE
10965                   IF ( vari == 'BC' )   to_be_resorted => s_bc_av
10966                   IF ( vari == 'DU' )   to_be_resorted => s_du_av
10967                   IF ( vari == 'NH' )   to_be_resorted => s_nh_av
10968                   IF ( vari == 'NO' )   to_be_resorted => s_no_av
10969                   IF ( vari == 'OC' )   to_be_resorted => s_oc_av
10970                   IF ( vari == 'SO4' )  to_be_resorted => s_so4_av
10971                   IF ( vari == 'SS' )   to_be_resorted => s_ss_av
10972                   DO  i = nxl, nxr
10973                      DO  j = nys, nyn
10974                         DO  k = nzb_do, nzt_do
10975                            local_pf(i,j,k) = MERGE( to_be_resorted(k,j,i), REAL( fill_value,      &
10976                                                     KIND = wp ), BTEST( wall_flags_0(k,j,i), 0 ) )
10977                         ENDDO
10978                      ENDDO
10979                   ENDDO
10980                ENDIF
10981             ELSE
10982                local_pf = fill_value
10983             ENDIF
10984
10985             IF ( mode == 'xy' )  grid = 'zu'
10986
10987          CASE ( 's_H2O' )
10988             found_index = get_index( prtcl, 'H2O' )
10989             IF ( av == 0 )  THEN
10990                DO  i = nxl, nxr
10991                   DO  j = nys, nyn
10992                      DO  k = nzb_do, nzt_do
10993                         temp_bin = 0.0_wp
10994                         DO  ic = ( found_index-1 ) * nbins_aerosol+1, found_index * nbins_aerosol
10995                            temp_bin = temp_bin + aerosol_mass(ic)%conc(k,j,i)
10996                         ENDDO
10997                         local_pf(i,j,k) = MERGE( temp_bin, REAL( fill_value, KIND = wp ),         &
10998                                                  BTEST( wall_flags_0(k,j,i), 0 ) )
10999                      ENDDO
11000                   ENDDO
11001                ENDDO
11002             ELSE
11003                to_be_resorted => s_h2o_av
11004                DO  i = nxl, nxr
11005                   DO  j = nys, nyn
11006                      DO  k = nzb_do, nzt_do
11007                         local_pf(i,j,k) = MERGE( to_be_resorted(k,j,i), REAL( fill_value,         &
11008                                                  KIND = wp ), BTEST( wall_flags_0(k,j,i), 0 ) )
11009                      ENDDO
11010                   ENDDO
11011                ENDDO
11012             ENDIF
11013
11014             IF ( mode == 'xy' )  grid = 'zu'
11015
11016          CASE DEFAULT
11017             found = .FALSE.
11018             grid  = 'none'
11019
11020       END SELECT
11021
11022    ENDIF
11023
11024 END SUBROUTINE salsa_data_output_2d
11025
11026!------------------------------------------------------------------------------!
11027!
11028! Description:
11029! ------------
11030!> Subroutine defining 3D output variables
11031!------------------------------------------------------------------------------!
11032 SUBROUTINE salsa_data_output_3d( av, variable, found, local_pf, nzb_do, nzt_do )
11033
11034    USE indices
11035
11036    USE kinds
11037
11038
11039    IMPLICIT NONE
11040
11041    CHARACTER(LEN=*), INTENT(in) ::  variable   !<
11042
11043    INTEGER(iwp) ::  av           !<
11044    INTEGER(iwp) ::  char_to_int  !< for converting character to integer
11045    INTEGER(iwp) ::  found_index  !< index of a chemical compound
11046    INTEGER(iwp) ::  ib           !< running index: size bins
11047    INTEGER(iwp) ::  ic           !< running index: mass bins
11048    INTEGER(iwp) ::  i            !<
11049    INTEGER(iwp) ::  j            !<
11050    INTEGER(iwp) ::  k            !<
11051    INTEGER(iwp) ::  nzb_do       !<
11052    INTEGER(iwp) ::  nzt_do       !<
11053
11054    LOGICAL ::  found      !<
11055
11056    REAL(wp) ::  df                       !< For calculating LDSA: fraction of particles
11057                                          !< depositing in the alveolar (or tracheobronchial)
11058                                          !< region of the lung. Depends on the particle size
11059    REAL(wp) ::  mean_d                   !< Particle diameter in micrometres
11060    REAL(wp) ::  temp_bin                 !< temporary array for calculating output variables
11061
11062    REAL(sp), DIMENSION(nxl:nxr,nys:nyn,nzb_do:nzt_do) ::  local_pf  !< local
11063
11064    REAL(wp), DIMENSION(:,:,:), POINTER ::  to_be_resorted  !< pointer
11065
11066    found     = .TRUE.
11067    temp_bin  = 0.0_wp
11068
11069    IF ( variable(7:11) == 'N_bin' )  THEN
11070       READ( variable(12:),* ) char_to_int
11071       IF ( char_to_int >= 1  .AND. char_to_int <= SUM( nbin ) )  THEN
11072
11073          ib = char_to_int
11074          IF ( av == 0 )  THEN
11075             DO  i = nxl, nxr
11076                DO  j = nys, nyn
11077                   DO  k = nzb_do, nzt_do
11078                      local_pf(i,j,k) = MERGE( aerosol_number(ib)%conc(k,j,i), REAL( fill_value,   &
11079                                               KIND = wp ), BTEST( wall_flags_0(k,j,i), 0 ) )
11080                   ENDDO
11081                ENDDO
11082             ENDDO
11083          ELSE
11084             DO  i = nxl, nxr
11085                DO  j = nys, nyn
11086                   DO  k = nzb_do, nzt_do
11087                      local_pf(i,j,k) = MERGE( nbins_av(k,j,i,ib), REAL( fill_value, KIND = wp ),  &
11088                                               BTEST( wall_flags_0(k,j,i), 0 ) ) 
11089                   ENDDO
11090                ENDDO
11091             ENDDO
11092          ENDIF
11093       ENDIF
11094
11095    ELSEIF ( variable(7:11) == 'm_bin' )  THEN
11096       READ( variable(12:),* ) char_to_int
11097       IF ( char_to_int >= 1  .AND. char_to_int <= SUM( nbin ) )  THEN
11098
11099          ib = char_to_int
11100          IF ( av == 0 )  THEN
11101             DO  i = nxl, nxr
11102                DO  j = nys, nyn
11103                   DO  k = nzb_do, nzt_do
11104                      temp_bin = 0.0_wp
11105                      DO  ic = ib, ncomponents_mass * nbins_aerosol, nbins_aerosol
11106                         temp_bin = temp_bin + aerosol_mass(ic)%conc(k,j,i)
11107                      ENDDO
11108                      local_pf(i,j,k) = MERGE( temp_bin, REAL( fill_value, KIND = wp ),            &
11109                                               BTEST( wall_flags_0(k,j,i), 0 ) )
11110                   ENDDO
11111                ENDDO
11112             ENDDO
11113          ELSE
11114             DO  i = nxl, nxr
11115                DO  j = nys, nyn
11116                   DO  k = nzb_do, nzt_do
11117                      local_pf(i,j,k) = MERGE( mbins_av(k,j,i,ib), REAL( fill_value, KIND = wp ),  &
11118                                               BTEST( wall_flags_0(k,j,i), 0 ) ) 
11119                   ENDDO
11120                ENDDO
11121             ENDDO
11122          ENDIF
11123       ENDIF
11124
11125    ELSE
11126       SELECT CASE ( TRIM( variable(7:) ) )
11127
11128          CASE ( 'g_H2SO4', 'g_HNO3', 'g_NH3', 'g_OCNV',  'g_OCSV' )
11129             IF ( av == 0 )  THEN
11130                IF ( TRIM( variable(7:) ) == 'g_H2SO4')  found_index = 1
11131                IF ( TRIM( variable(7:) ) == 'g_HNO3')   found_index = 2
11132                IF ( TRIM( variable(7:) ) == 'g_NH3')    found_index = 3
11133                IF ( TRIM( variable(7:) ) == 'g_OCNV')   found_index = 4
11134                IF ( TRIM( variable(7:) ) == 'g_OCSV')   found_index = 5
11135
11136                DO  i = nxl, nxr
11137                   DO  j = nys, nyn
11138                      DO  k = nzb_do, nzt_do
11139                         local_pf(i,j,k) = MERGE( salsa_gas(found_index)%conc(k,j,i),              &
11140                                                  REAL( fill_value, KIND = wp ),                   &
11141                                                  BTEST( wall_flags_0(k,j,i), 0 ) )
11142                      ENDDO
11143                   ENDDO
11144                ENDDO
11145             ELSE
11146!
11147!--             9: remove salsa_g_ from the beginning
11148                IF ( TRIM( variable(9:) ) == 'H2SO4' ) to_be_resorted => g_h2so4_av
11149                IF ( TRIM( variable(9:) ) == 'HNO3' )  to_be_resorted => g_hno3_av
11150                IF ( TRIM( variable(9:) ) == 'NH3' )   to_be_resorted => g_nh3_av
11151                IF ( TRIM( variable(9:) ) == 'OCNV' )  to_be_resorted => g_ocnv_av
11152                IF ( TRIM( variable(9:) ) == 'OCSV' )  to_be_resorted => g_ocsv_av
11153                DO  i = nxl, nxr
11154                   DO  j = nys, nyn
11155                      DO  k = nzb_do, nzt_do
11156                         local_pf(i,j,k) = MERGE( to_be_resorted(k,j,i), REAL( fill_value,         &
11157                                                  KIND = wp ), BTEST( wall_flags_0(k,j,i), 0 ) )
11158                      ENDDO
11159                   ENDDO
11160                ENDDO
11161             ENDIF
11162
11163          CASE ( 'LDSA' )
11164             IF ( av == 0 )  THEN
11165                DO  i = nxl, nxr
11166                   DO  j = nys, nyn
11167                      DO  k = nzb_do, nzt_do
11168                         temp_bin = 0.0_wp
11169                         DO  ib = 1, nbins_aerosol
11170   !
11171   !--                      Diameter in micrometres
11172                            mean_d = 1.0E+6_wp * ra_dry(k,j,i,ib) * 2.0_wp
11173   !
11174   !--                      Deposition factor: alveolar
11175                            df = ( 0.01555_wp / mean_d ) * ( EXP( -0.416_wp * ( LOG( mean_d ) +    &
11176                                   2.84_wp )**2 ) + 19.11_wp * EXP( -0.482_wp * ( LOG( mean_d ) -  &
11177                                   1.362_wp )**2 ) )
11178   !
11179   !--                      Lung-deposited surface area LDSA (units mum2/cm3)
11180                            temp_bin = temp_bin + pi * mean_d**2 * df * 1.0E-6_wp *                &
11181                                       aerosol_number(ib)%conc(k,j,i)
11182                         ENDDO
11183                         local_pf(i,j,k) = MERGE( temp_bin, REAL( fill_value, KIND = wp ),         &
11184                                                  BTEST( wall_flags_0(k,j,i), 0 ) )
11185                      ENDDO
11186                   ENDDO
11187                ENDDO
11188             ELSE
11189                DO  i = nxl, nxr
11190                   DO  j = nys, nyn
11191                      DO  k = nzb_do, nzt_do
11192                         local_pf(i,j,k) = MERGE( ldsa_av(k,j,i), REAL( fill_value, KIND = wp ),   &
11193                                                  BTEST( wall_flags_0(k,j,i), 0 ) ) 
11194                      ENDDO
11195                   ENDDO
11196                ENDDO
11197             ENDIF
11198
11199          CASE ( 'N_UFP' )
11200             IF ( av == 0 )  THEN
11201                DO  i = nxl, nxr
11202                   DO  j = nys, nyn
11203                      DO  k = nzb_do, nzt_do
11204                         temp_bin = 0.0_wp
11205                         DO  ib = 1, nbins_aerosol
11206                            IF ( 2.0_wp * ra_dry(k,j,i,ib) <= 0.1E-6_wp )  THEN
11207                               temp_bin = temp_bin + aerosol_number(ib)%conc(k,j,i)
11208                            ENDIF
11209                         ENDDO
11210                         local_pf(i,j,k) = MERGE( temp_bin, REAL( fill_value, KIND = wp ),         &
11211                                                  BTEST( wall_flags_0(k,j,i), 0 ) )
11212                      ENDDO
11213                   ENDDO
11214                ENDDO
11215             ELSE
11216                DO  i = nxl, nxr
11217                   DO  j = nys, nyn
11218                      DO  k = nzb_do, nzt_do
11219                         local_pf(i,j,k) = MERGE( nufp_av(k,j,i), REAL( fill_value, KIND = wp ),   &
11220                                                  BTEST( wall_flags_0(k,j,i), 0 ) ) 
11221                      ENDDO
11222                   ENDDO
11223                ENDDO
11224             ENDIF
11225
11226          CASE ( 'Ntot' )
11227             IF ( av == 0 )  THEN
11228                DO  i = nxl, nxr
11229                   DO  j = nys, nyn
11230                      DO  k = nzb_do, nzt_do
11231                         temp_bin = 0.0_wp
11232                         DO  ib = 1, nbins_aerosol
11233                            temp_bin = temp_bin + aerosol_number(ib)%conc(k,j,i)
11234                         ENDDO
11235                         local_pf(i,j,k) = MERGE( temp_bin, REAL( fill_value, KIND = wp ),         &
11236                                                  BTEST( wall_flags_0(k,j,i), 0 ) )
11237                      ENDDO
11238                   ENDDO
11239                ENDDO
11240             ELSE
11241                DO  i = nxl, nxr
11242                   DO  j = nys, nyn
11243                      DO  k = nzb_do, nzt_do
11244                         local_pf(i,j,k) = MERGE( ntot_av(k,j,i), REAL( fill_value, KIND = wp ),   &
11245                                                  BTEST( wall_flags_0(k,j,i), 0 ) ) 
11246                      ENDDO
11247                   ENDDO
11248                ENDDO
11249             ENDIF
11250
11251          CASE ( 'PM0.1' )
11252             IF ( av == 0 )  THEN
11253                DO  i = nxl, nxr
11254                   DO  j = nys, nyn
11255                      DO  k = nzb_do, nzt_do
11256                         temp_bin = 0.0_wp
11257                         DO  ib = 1, nbins_aerosol
11258                            IF ( 2.0_wp * ra_dry(k,j,i,ib) <= 0.1E-6_wp )  THEN
11259                               DO  ic = ib, nbins_aerosol * ncc, nbins_aerosol
11260                                  temp_bin = temp_bin + aerosol_mass(ic)%conc(k,j,i)
11261                               ENDDO
11262                            ENDIF
11263                         ENDDO
11264                         local_pf(i,j,k) = MERGE( temp_bin, REAL( fill_value, KIND = wp ),         &
11265                                                  BTEST( wall_flags_0(k,j,i), 0 ) ) 
11266                      ENDDO
11267                   ENDDO
11268                ENDDO
11269             ELSE
11270                DO  i = nxl, nxr
11271                   DO  j = nys, nyn
11272                      DO  k = nzb_do, nzt_do
11273                         local_pf(i,j,k) = MERGE( pm01_av(k,j,i), REAL( fill_value, KIND = wp ),   &
11274                                                  BTEST( wall_flags_0(k,j,i), 0 ) ) 
11275                      ENDDO
11276                   ENDDO
11277                ENDDO
11278             ENDIF
11279
11280          CASE ( 'PM2.5' )
11281             IF ( av == 0 )  THEN
11282                DO  i = nxl, nxr
11283                   DO  j = nys, nyn
11284                      DO  k = nzb_do, nzt_do
11285                         temp_bin = 0.0_wp
11286                         DO  ib = 1, nbins_aerosol
11287                            IF ( 2.0_wp * ra_dry(k,j,i,ib) <= 2.5E-6_wp )  THEN
11288                               DO  ic = ib, nbins_aerosol * ncc, nbins_aerosol
11289                                  temp_bin = temp_bin + aerosol_mass(ic)%conc(k,j,i)
11290                               ENDDO
11291                            ENDIF
11292                         ENDDO
11293                         local_pf(i,j,k) = MERGE( temp_bin, REAL( fill_value, KIND = wp ),         &
11294                                                  BTEST( wall_flags_0(k,j,i), 0 ) ) 
11295                      ENDDO
11296                   ENDDO
11297                ENDDO
11298             ELSE
11299                DO  i = nxl, nxr
11300                   DO  j = nys, nyn
11301                      DO  k = nzb_do, nzt_do
11302                         local_pf(i,j,k) = MERGE( pm25_av(k,j,i), REAL( fill_value, KIND = wp ),   &
11303                                                  BTEST( wall_flags_0(k,j,i), 0 ) ) 
11304                      ENDDO
11305                   ENDDO
11306                ENDDO
11307             ENDIF
11308
11309          CASE ( 'PM10' )
11310             IF ( av == 0 )  THEN
11311                DO  i = nxl, nxr
11312                   DO  j = nys, nyn
11313                      DO  k = nzb_do, nzt_do
11314                         temp_bin = 0.0_wp
11315                         DO  ib = 1, nbins_aerosol
11316                            IF ( 2.0_wp * ra_dry(k,j,i,ib) <= 10.0E-6_wp )  THEN
11317                               DO  ic = ib, nbins_aerosol * ncc, nbins_aerosol
11318                                  temp_bin = temp_bin + aerosol_mass(ic)%conc(k,j,i)
11319                               ENDDO
11320                            ENDIF
11321                         ENDDO
11322                         local_pf(i,j,k) = MERGE( temp_bin, REAL( fill_value, KIND = wp ),         &
11323                                                  BTEST( wall_flags_0(k,j,i), 0 ) ) 
11324                      ENDDO
11325                   ENDDO
11326                ENDDO
11327             ELSE
11328                DO  i = nxl, nxr
11329                   DO  j = nys, nyn
11330                      DO  k = nzb_do, nzt_do
11331                         local_pf(i,j,k) = MERGE( pm10_av(k,j,i), REAL( fill_value, KIND = wp ),   &
11332                                                  BTEST( wall_flags_0(k,j,i), 0 ) )
11333                      ENDDO
11334                   ENDDO
11335                ENDDO
11336             ENDIF
11337
11338          CASE ( 's_BC', 's_DU', 's_NH', 's_NO', 's_OC', 's_SO4', 's_SS' )
11339             IF ( is_used( prtcl, TRIM( variable(9:) ) ) )  THEN  ! 9: remove salsa_s_
11340                found_index = get_index( prtcl, TRIM( variable(9:) ) )
11341                IF ( av == 0 )  THEN
11342                   DO  i = nxl, nxr
11343                      DO  j = nys, nyn
11344                         DO  k = nzb_do, nzt_do
11345                            temp_bin = 0.0_wp
11346                            DO  ic = ( found_index-1 ) * nbins_aerosol + 1, found_index * nbins_aerosol
11347                               temp_bin = temp_bin + aerosol_mass(ic)%conc(k,j,i)
11348                            ENDDO
11349                            local_pf(i,j,k) = MERGE( temp_bin, REAL( fill_value, KIND = wp ),      &
11350                                                     BTEST( wall_flags_0(k,j,i), 0 ) ) 
11351                         ENDDO
11352                      ENDDO
11353                   ENDDO
11354                ELSE
11355!
11356!--                9: remove salsa_s_ from the beginning
11357                   IF ( TRIM( variable(9:) ) == 'BC' )   to_be_resorted => s_bc_av
11358                   IF ( TRIM( variable(9:) ) == 'DU' )   to_be_resorted => s_du_av
11359                   IF ( TRIM( variable(9:) ) == 'NH' )   to_be_resorted => s_nh_av
11360                   IF ( TRIM( variable(9:) ) == 'NO' )   to_be_resorted => s_no_av
11361                   IF ( TRIM( variable(9:) ) == 'OC' )   to_be_resorted => s_oc_av
11362                   IF ( TRIM( variable(9:) ) == 'SO4' )  to_be_resorted => s_so4_av
11363                   IF ( TRIM( variable(9:) ) == 'SS' )   to_be_resorted => s_ss_av
11364                   DO  i = nxl, nxr
11365                      DO  j = nys, nyn
11366                         DO  k = nzb_do, nzt_do
11367                            local_pf(i,j,k) = MERGE( to_be_resorted(k,j,i), REAL( fill_value,      &
11368                                                     KIND = wp ), BTEST( wall_flags_0(k,j,i), 0 ) )
11369                         ENDDO
11370                      ENDDO
11371                   ENDDO
11372                ENDIF
11373             ENDIF
11374
11375          CASE ( 's_H2O' )
11376             found_index = get_index( prtcl, 'H2O' )
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  ic = ( found_index-1 ) * nbins_aerosol + 1, found_index * nbins_aerosol
11383                            temp_bin = temp_bin + aerosol_mass(ic)%conc(k,j,i)
11384                         ENDDO
11385                         local_pf(i,j,k) = MERGE( temp_bin, REAL( fill_value, KIND = wp ),         &
11386                                                  BTEST( wall_flags_0(k,j,i), 0 ) ) 
11387                      ENDDO
11388                   ENDDO
11389                ENDDO
11390             ELSE
11391                to_be_resorted => s_h2o_av
11392                DO  i = nxl, nxr
11393                   DO  j = nys, nyn
11394                      DO  k = nzb_do, nzt_do
11395                         local_pf(i,j,k) = MERGE( to_be_resorted(k,j,i), REAL( fill_value,         &
11396                                                  KIND = wp ), BTEST( wall_flags_0(k,j,i), 0 ) )
11397                      ENDDO
11398                   ENDDO
11399                ENDDO
11400             ENDIF
11401
11402          CASE DEFAULT
11403             found = .FALSE.
11404
11405       END SELECT
11406    ENDIF
11407
11408 END SUBROUTINE salsa_data_output_3d
11409
11410!------------------------------------------------------------------------------!
11411!
11412! Description:
11413! ------------
11414!> Subroutine defining mask output variables
11415!------------------------------------------------------------------------------!
11416 SUBROUTINE salsa_data_output_mask( av, variable, found, local_pf, mid )
11417
11418    USE arrays_3d,                                                                                 &
11419        ONLY:  tend
11420
11421    USE control_parameters,                                                                        &
11422        ONLY:  mask_i, mask_j, mask_k, mask_size_l, mask_surface, nz_do3d
11423
11424    IMPLICIT NONE
11425
11426    CHARACTER(LEN=5) ::  grid      !< flag to distinquish between staggered grid
11427    CHARACTER(LEN=*) ::  variable  !<
11428    CHARACTER(LEN=7) ::  vari      !< trimmed format of variable
11429
11430    INTEGER(iwp) ::  av             !<
11431    INTEGER(iwp) ::  char_to_int    !< for converting character to integer
11432    INTEGER(iwp) ::  found_index    !< index of a chemical compound
11433    INTEGER(iwp) ::  ib             !< loop index for aerosol size number bins
11434    INTEGER(iwp) ::  ic             !< loop index for chemical components
11435    INTEGER(iwp) ::  i              !< loop index in x-direction
11436    INTEGER(iwp) ::  j              !< loop index in y-direction
11437    INTEGER(iwp) ::  k              !< loop index in z-direction
11438    INTEGER(iwp) ::  im             !< loop index for masked variables
11439    INTEGER(iwp) ::  jm             !< loop index for masked variables
11440    INTEGER(iwp) ::  kk             !< loop index for masked output in z-direction
11441    INTEGER(iwp) ::  mid            !< masked output running index
11442    INTEGER(iwp) ::  ktt            !< k index of highest terrain surface
11443
11444    LOGICAL ::  found      !<
11445    LOGICAL ::  resorted   !<
11446
11447    REAL(wp) ::  df        !< For calculating LDSA: fraction of particles depositing in the alveolar
11448                           !< (or tracheobronchial) region of the lung. Depends on the particle size
11449    REAL(wp) ::  mean_d    !< Particle diameter in micrometres
11450    REAL(wp) ::  temp_bin  !< temporary array for calculating output variables
11451
11452    REAL(wp), DIMENSION(mask_size_l(mid,1),mask_size_l(mid,2),mask_size_l(mid,3)) ::  local_pf   !<
11453
11454    REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg), TARGET ::  temp_array  !< temporary array
11455
11456    REAL(wp), DIMENSION(:,:,:), POINTER ::  to_be_resorted  !< pointer
11457
11458    found      = .TRUE.
11459    resorted   = .FALSE.
11460    grid       = 's'
11461    temp_array = 0.0_wp
11462    temp_bin   = 0.0_wp
11463
11464    IF ( variable(7:11) == 'N_bin' )  THEN
11465       READ( variable(12:),* ) char_to_int
11466       IF ( char_to_int >= 1  .AND. char_to_int <= SUM( nbin ) )  THEN
11467          ib = char_to_int
11468          IF ( av == 0 )  THEN
11469             IF ( .NOT. mask_surface(mid) )  THEN
11470                DO  i = 1, mask_size_l(mid,1)
11471                   DO  j = 1, mask_size_l(mid,2)
11472                      DO  k = 1, mask_size_l(mid,3)
11473                         local_pf(i,j,k) = aerosol_number(ib)%conc( mask_k(mid,k), mask_j(mid,j),  &
11474                                                                    mask_i(mid,i) )
11475                      ENDDO
11476                   ENDDO
11477                ENDDO
11478             ELSE
11479                DO  i = 1, mask_size_l(mid,1)
11480                   DO  j = 1, mask_size_l(mid,2)
11481!
11482!--                   Get k index of the highest terraing surface
11483                      im = mask_i(mid,i)
11484                      jm = mask_j(mid,j)
11485                      ktt = MINLOC( MERGE( 1, 0, BTEST( wall_flags_0(:,jm,im), 5 )), DIM = 1 ) - 1
11486                      DO  k = 1, mask_size_l(mid,3)
11487                         kk = MIN( ktt+mask_k(mid,k), nzt+1 )
11488!
11489!--                      Set value if not in building
11490                         IF ( BTEST( wall_flags_0(kk,jm,im), 6 ) )  THEN
11491                            local_pf(i,j,k) = fill_value
11492                         ELSE
11493                            local_pf(i,j,k) = aerosol_number(ib)%conc(kk,jm,im)
11494                         ENDIF
11495                      ENDDO
11496                   ENDDO
11497                ENDDO
11498             ENDIF
11499             resorted = .TRUE.
11500          ELSE
11501             temp_array = nbins_av(:,:,:,ib)
11502             to_be_resorted => temp_array
11503          ENDIF
11504       ENDIF
11505
11506    ELSEIF ( variable(7:11) == 'm_bin' )  THEN
11507
11508       READ( variable(12:),* ) char_to_int
11509       IF ( char_to_int >= 1  .AND. char_to_int <= SUM( nbin ) )  THEN
11510
11511          ib = char_to_int
11512          IF ( av == 0 )  THEN
11513             DO  i = nxl, nxr
11514                DO  j = nys, nyn
11515                   DO  k = nzb, nz_do3d
11516                      temp_bin = 0.0_wp
11517                      DO  ic = ib, ncomponents_mass * nbins_aerosol, nbins_aerosol
11518                         temp_bin = temp_bin + aerosol_mass(ic)%conc(k,j,i)
11519                      ENDDO
11520                      tend(k,j,i) = temp_bin
11521                   ENDDO
11522                ENDDO
11523             ENDDO
11524             IF ( .NOT. mask_surface(mid) )  THEN
11525                DO  i = 1, mask_size_l(mid,1)
11526                   DO  j = 1, mask_size_l(mid,2)
11527                      DO  k = 1, mask_size_l(mid,3)
11528                         local_pf(i,j,k) = tend( mask_k(mid,k),  mask_j(mid,j), mask_i(mid,i) )
11529                      ENDDO
11530                   ENDDO
11531                ENDDO
11532             ELSE
11533                DO  i = 1, mask_size_l(mid,1)
11534                   DO  j = 1, mask_size_l(mid,2)
11535!
11536!--                   Get k index of the highest terraing surface
11537                      im = mask_i(mid,i)
11538                      jm = mask_j(mid,j)
11539                      ktt = MINLOC( MERGE( 1, 0, BTEST( wall_flags_0(:,jm,im), 5 )), DIM = 1 ) - 1
11540                      DO  k = 1, mask_size_l(mid,3)
11541                         kk = MIN( ktt+mask_k(mid,k), nzt+1 )
11542!
11543!--                      Set value if not in building
11544                         IF ( BTEST( wall_flags_0(kk,jm,im), 6 ) )  THEN
11545                            local_pf(i,j,k) = fill_value
11546                         ELSE
11547                            local_pf(i,j,k) = tend(kk,jm,im)
11548                         ENDIF
11549                      ENDDO
11550                   ENDDO
11551                ENDDO
11552             ENDIF
11553             resorted = .TRUE.
11554          ELSE
11555             temp_array = mbins_av(:,:,:,ib)
11556             to_be_resorted => temp_array
11557          ENDIF
11558       ENDIF
11559
11560    ELSE
11561       SELECT CASE ( TRIM( variable(7:) ) )
11562
11563          CASE ( 'g_H2SO4', 'g_HNO3', 'g_NH3', 'g_OCNV',  'g_OCSV' )
11564             vari = TRIM( variable(7:) )
11565             IF ( av == 0 )  THEN
11566                IF ( vari == 'g_H2SO4')  to_be_resorted => salsa_gas(1)%conc
11567                IF ( vari == 'g_HNO3')   to_be_resorted => salsa_gas(2)%conc
11568                IF ( vari == 'g_NH3')    to_be_resorted => salsa_gas(3)%conc
11569                IF ( vari == 'g_OCNV')   to_be_resorted => salsa_gas(4)%conc
11570                IF ( vari == 'g_OCSV')   to_be_resorted => salsa_gas(5)%conc
11571             ELSE
11572                IF ( vari == 'g_H2SO4') to_be_resorted => g_h2so4_av
11573                IF ( vari == 'g_HNO3')  to_be_resorted => g_hno3_av
11574                IF ( vari == 'g_NH3')   to_be_resorted => g_nh3_av
11575                IF ( vari == 'g_OCNV')  to_be_resorted => g_ocnv_av
11576                IF ( vari == 'g_OCSV')  to_be_resorted => g_ocsv_av
11577             ENDIF
11578
11579          CASE ( 'LDSA' )
11580             IF ( av == 0 )  THEN
11581                DO  i = nxl, nxr
11582                   DO  j = nys, nyn
11583                      DO  k = nzb, nz_do3d
11584                         temp_bin = 0.0_wp
11585                         DO  ib = 1, nbins_aerosol
11586   !
11587   !--                      Diameter in micrometres
11588                            mean_d = 1.0E+6_wp * ra_dry(k,j,i,ib) * 2.0_wp
11589   !
11590   !--                      Deposition factor: alveolar
11591                            df = ( 0.01555_wp / mean_d ) * ( EXP( -0.416_wp * ( LOG( mean_d ) +    &
11592                                   2.84_wp )**2 ) + 19.11_wp * EXP( -0.482_wp * ( LOG( mean_d ) -  &
11593                                   1.362_wp )**2 ) )
11594   !
11595   !--                      Lung-deposited surface area LDSA (units mum2/cm3)
11596                            temp_bin = temp_bin + pi * mean_d**2 * df * 1.0E-6_wp *                &
11597                                       aerosol_number(ib)%conc(k,j,i)
11598                         ENDDO
11599                         tend(k,j,i) = temp_bin
11600                      ENDDO
11601                   ENDDO
11602                ENDDO
11603                IF ( .NOT. mask_surface(mid) )  THEN
11604                   DO  i = 1, mask_size_l(mid,1)
11605                      DO  j = 1, mask_size_l(mid,2)
11606                         DO  k = 1, mask_size_l(mid,3)
11607                            local_pf(i,j,k) = tend( mask_k(mid,k),  mask_j(mid,j), mask_i(mid,i) )
11608                         ENDDO
11609                      ENDDO
11610                   ENDDO
11611                ELSE
11612                   DO  i = 1, mask_size_l(mid,1)
11613                      DO  j = 1, mask_size_l(mid,2)
11614!
11615!--                      Get k index of the highest terraing surface
11616                         im = mask_i(mid,i)
11617                         jm = mask_j(mid,j)
11618                         ktt = MINLOC( MERGE( 1, 0, BTEST( wall_flags_0(:,jm,im), 5 )), DIM = 1 ) - 1
11619                         DO  k = 1, mask_size_l(mid,3)
11620                            kk = MIN( ktt+mask_k(mid,k), nzt+1 )
11621!
11622!--                         Set value if not in building
11623                            IF ( BTEST( wall_flags_0(kk,jm,im), 6 ) )  THEN
11624                               local_pf(i,j,k) = fill_value
11625                            ELSE
11626                               local_pf(i,j,k) = tend(kk,jm,im)
11627                            ENDIF
11628                         ENDDO
11629                      ENDDO
11630                   ENDDO
11631                ENDIF
11632                resorted = .TRUE.
11633             ELSE
11634                to_be_resorted => ldsa_av
11635             ENDIF
11636
11637          CASE ( 'N_UFP' )
11638             IF ( av == 0 )  THEN
11639                DO  i = nxl, nxr
11640                   DO  j = nys, nyn
11641                      DO  k = nzb, nz_do3d
11642                         temp_bin = 0.0_wp
11643                         DO  ib = 1, nbins_aerosol
11644                            IF ( 2.0_wp * ra_dry(k,j,i,ib) <= 0.1E-6_wp )  THEN
11645                               temp_bin = temp_bin + aerosol_number(ib)%conc(k,j,i)
11646                            ENDIF
11647                         ENDDO
11648                         tend(k,j,i) = temp_bin
11649                      ENDDO
11650                   ENDDO
11651                ENDDO 
11652                IF ( .NOT. mask_surface(mid) )  THEN
11653                   DO  i = 1, mask_size_l(mid,1)
11654                      DO  j = 1, mask_size_l(mid,2)
11655                         DO  k = 1, mask_size_l(mid,3)
11656                            local_pf(i,j,k) = tend( mask_k(mid,k),  mask_j(mid,j), mask_i(mid,i) )
11657                         ENDDO
11658                      ENDDO
11659                   ENDDO
11660                ELSE
11661                   DO  i = 1, mask_size_l(mid,1)
11662                      DO  j = 1, mask_size_l(mid,2)
11663!
11664!--                      Get k index of the highest terraing surface
11665                         im = mask_i(mid,i)
11666                         jm = mask_j(mid,j)
11667                         ktt = MINLOC( MERGE( 1, 0, BTEST( wall_flags_0(:,jm,im), 5 )), DIM = 1 ) - 1
11668                         DO  k = 1, mask_size_l(mid,3)
11669                            kk = MIN( ktt+mask_k(mid,k), nzt+1 )
11670!
11671!--                         Set value if not in building
11672                            IF ( BTEST( wall_flags_0(kk,jm,im), 6 ) )  THEN
11673                               local_pf(i,j,k) = fill_value
11674                            ELSE
11675                               local_pf(i,j,k) = tend(kk,jm,im)
11676                            ENDIF
11677                         ENDDO
11678                      ENDDO
11679                   ENDDO
11680                ENDIF
11681                resorted = .TRUE.
11682             ELSE
11683                to_be_resorted => nufp_av
11684             ENDIF
11685
11686          CASE ( 'Ntot' )
11687             IF ( av == 0 )  THEN
11688                DO  i = nxl, nxr
11689                   DO  j = nys, nyn
11690                      DO  k = nzb, nz_do3d
11691                         temp_bin = 0.0_wp
11692                         DO  ib = 1, nbins_aerosol
11693                            temp_bin = temp_bin + aerosol_number(ib)%conc(k,j,i)
11694                         ENDDO
11695                         tend(k,j,i) = temp_bin
11696                      ENDDO
11697                   ENDDO
11698                ENDDO 
11699                IF ( .NOT. mask_surface(mid) )  THEN
11700                   DO  i = 1, mask_size_l(mid,1)
11701                      DO  j = 1, mask_size_l(mid,2)
11702                         DO  k = 1, mask_size_l(mid,3)
11703                            local_pf(i,j,k) = tend( mask_k(mid,k),  mask_j(mid,j), mask_i(mid,i) )
11704                         ENDDO
11705                      ENDDO
11706                   ENDDO
11707                ELSE
11708                   DO  i = 1, mask_size_l(mid,1)
11709                      DO  j = 1, mask_size_l(mid,2)
11710!
11711!--                      Get k index of the highest terraing surface
11712                         im = mask_i(mid,i)
11713                         jm = mask_j(mid,j)
11714                         ktt = MINLOC( MERGE( 1, 0, BTEST( wall_flags_0(:,jm,im), 5 )), DIM = 1 ) - 1
11715                         DO  k = 1, mask_size_l(mid,3)
11716                            kk = MIN( ktt+mask_k(mid,k), nzt+1 )
11717!
11718!--                         Set value if not in building
11719                            IF ( BTEST( wall_flags_0(kk,jm,im), 6 ) )  THEN
11720                               local_pf(i,j,k) = fill_value
11721                            ELSE
11722                               local_pf(i,j,k) = tend(kk,jm,im)
11723                            ENDIF
11724                         ENDDO
11725                      ENDDO
11726                   ENDDO
11727                ENDIF
11728                resorted = .TRUE.
11729             ELSE
11730                to_be_resorted => ntot_av
11731             ENDIF
11732
11733          CASE ( 'PM0.1' )
11734             IF ( av == 0 )  THEN
11735                DO  i = nxl, nxr
11736                   DO  j = nys, nyn
11737                      DO  k = nzb, nz_do3d
11738                         temp_bin = 0.0_wp
11739                         DO  ib = 1, nbins_aerosol
11740                            IF ( 2.0_wp * ra_dry(k,j,i,ib) <= 0.1E-6_wp )  THEN
11741                               DO  ic = ib, nbins_aerosol * ncc, nbins_aerosol
11742                                  temp_bin = temp_bin + aerosol_mass(ic)%conc(k,j,i)
11743                               ENDDO
11744                            ENDIF
11745                         ENDDO
11746                         tend(k,j,i) = temp_bin
11747                      ENDDO
11748                   ENDDO
11749                ENDDO 
11750                IF ( .NOT. mask_surface(mid) )  THEN
11751                   DO  i = 1, mask_size_l(mid,1)
11752                      DO  j = 1, mask_size_l(mid,2)
11753                         DO  k = 1, mask_size_l(mid,3)
11754                            local_pf(i,j,k) = tend( mask_k(mid,k),  mask_j(mid,j), mask_i(mid,i) )
11755                         ENDDO
11756                      ENDDO
11757                   ENDDO
11758                ELSE
11759                   DO  i = 1, mask_size_l(mid,1)
11760                      DO  j = 1, mask_size_l(mid,2)
11761!
11762!--                      Get k index of the highest terraing surface
11763                         im = mask_i(mid,i)
11764                         jm = mask_j(mid,j)
11765                         ktt = MINLOC( MERGE( 1, 0, BTEST( wall_flags_0(:,jm,im), 5 )), DIM = 1 ) - 1
11766                         DO  k = 1, mask_size_l(mid,3)
11767                            kk = MIN( ktt+mask_k(mid,k), nzt+1 )
11768!
11769!--                         Set value if not in building
11770                            IF ( BTEST( wall_flags_0(kk,jm,im), 6 ) )  THEN
11771                               local_pf(i,j,k) = fill_value
11772                            ELSE
11773                               local_pf(i,j,k) = tend(kk,jm,im)
11774                            ENDIF
11775                         ENDDO
11776                      ENDDO
11777                   ENDDO
11778                ENDIF
11779                resorted = .TRUE.
11780             ELSE
11781                to_be_resorted => pm01_av
11782             ENDIF
11783
11784          CASE ( 'PM2.5' )
11785             IF ( av == 0 )  THEN
11786                DO  i = nxl, nxr
11787                   DO  j = nys, nyn
11788                      DO  k = nzb, nz_do3d
11789                         temp_bin = 0.0_wp
11790                         DO  ib = 1, nbins_aerosol
11791                            IF ( 2.0_wp * ra_dry(k,j,i,ib) <= 2.5E-6_wp )  THEN
11792                               DO  ic = ib, nbins_aerosol * ncc, nbins_aerosol
11793                                  temp_bin = temp_bin + aerosol_mass(ic)%conc(k,j,i)
11794                               ENDDO
11795                            ENDIF
11796                         ENDDO
11797                         tend(k,j,i) = temp_bin
11798                      ENDDO
11799                   ENDDO
11800                ENDDO 
11801                IF ( .NOT. mask_surface(mid) )  THEN
11802                   DO  i = 1, mask_size_l(mid,1)
11803                      DO  j = 1, mask_size_l(mid,2)
11804                         DO  k = 1, mask_size_l(mid,3)
11805                            local_pf(i,j,k) = tend( mask_k(mid,k),  mask_j(mid,j), mask_i(mid,i) )
11806                         ENDDO
11807                      ENDDO
11808                   ENDDO
11809                ELSE
11810                   DO  i = 1, mask_size_l(mid,1)
11811                      DO  j = 1, mask_size_l(mid,2)
11812!
11813!--                      Get k index of the highest terraing surface
11814                         im = mask_i(mid,i)
11815                         jm = mask_j(mid,j)
11816                         ktt = MINLOC( MERGE( 1, 0, BTEST( wall_flags_0(:,jm,im), 5 )), DIM = 1 ) - 1
11817                         DO  k = 1, mask_size_l(mid,3)
11818                            kk = MIN( ktt+mask_k(mid,k), nzt+1 )
11819!
11820!--                         Set value if not in building
11821                            IF ( BTEST( wall_flags_0(kk,jm,im), 6 ) )  THEN
11822                               local_pf(i,j,k) = fill_value
11823                            ELSE
11824                               local_pf(i,j,k) = tend(kk,jm,im)
11825                            ENDIF
11826                         ENDDO
11827                      ENDDO
11828                   ENDDO
11829                ENDIF
11830                resorted = .TRUE.
11831             ELSE
11832                to_be_resorted => pm25_av
11833             ENDIF
11834
11835          CASE ( 'PM10' )
11836             IF ( av == 0 )  THEN
11837                DO  i = nxl, nxr
11838                   DO  j = nys, nyn
11839                      DO  k = nzb, nz_do3d
11840                         temp_bin = 0.0_wp
11841                         DO  ib = 1, nbins_aerosol
11842                            IF ( 2.0_wp * ra_dry(k,j,i,ib) <= 10.0E-6_wp )  THEN
11843                               DO  ic = ib, nbins_aerosol * ncc, nbins_aerosol
11844                                  temp_bin = temp_bin + aerosol_mass(ic)%conc(k,j,i)
11845                               ENDDO
11846                            ENDIF
11847                         ENDDO
11848                         tend(k,j,i) = temp_bin
11849                      ENDDO
11850                   ENDDO
11851                ENDDO 
11852                IF ( .NOT. mask_surface(mid) )  THEN
11853                   DO  i = 1, mask_size_l(mid,1)
11854                      DO  j = 1, mask_size_l(mid,2)
11855                         DO  k = 1, mask_size_l(mid,3)
11856                            local_pf(i,j,k) = tend( mask_k(mid,k),  mask_j(mid,j), mask_i(mid,i) )
11857                         ENDDO
11858                      ENDDO
11859                   ENDDO
11860                ELSE
11861                   DO  i = 1, mask_size_l(mid,1)
11862                      DO  j = 1, mask_size_l(mid,2)
11863!
11864!--                      Get k index of the highest terraing surface
11865                         im = mask_i(mid,i)
11866                         jm = mask_j(mid,j)
11867                         ktt = MINLOC( MERGE( 1, 0, BTEST( wall_flags_0(:,jm,im), 5 )), DIM = 1 ) - 1
11868                         DO  k = 1, mask_size_l(mid,3)
11869                            kk = MIN( ktt+mask_k(mid,k), nzt+1 )
11870!
11871!--                         Set value if not in building
11872                            IF ( BTEST( wall_flags_0(kk,jm,im), 6 ) )  THEN
11873                               local_pf(i,j,k) = fill_value
11874                            ELSE
11875                               local_pf(i,j,k) = tend(kk,jm,im)
11876                            ENDIF
11877                         ENDDO
11878                      ENDDO
11879                   ENDDO
11880                ENDIF
11881                resorted = .TRUE.
11882             ELSE
11883                to_be_resorted => pm10_av
11884             ENDIF
11885
11886          CASE ( 's_BC', 's_DU', 's_NH', 's_NO', 's_OC', 's_SO4', 's_SS' )
11887             IF ( av == 0 )  THEN
11888                IF ( is_used( prtcl, TRIM( variable(3:) ) ) )  THEN
11889                   found_index = get_index( prtcl, TRIM( variable(3:) ) )
11890                   DO  i = nxl, nxr
11891                      DO  j = nys, nyn
11892                         DO  k = nzb, nz_do3d
11893                            temp_bin = 0.0_wp
11894                            DO  ic = ( found_index-1 ) * nbins_aerosol + 1, found_index * nbins_aerosol
11895                               temp_bin = temp_bin + aerosol_mass(ic)%conc(k,j,i)
11896                            ENDDO
11897                            tend(k,j,i) = temp_bin
11898                         ENDDO
11899                      ENDDO
11900                   ENDDO
11901                ELSE
11902                   tend = 0.0_wp
11903                ENDIF
11904                IF ( .NOT. mask_surface(mid) )  THEN
11905                   DO  i = 1, mask_size_l(mid,1)
11906                      DO  j = 1, mask_size_l(mid,2)
11907                         DO  k = 1, mask_size_l(mid,3)
11908                            local_pf(i,j,k) = tend( mask_k(mid,k), mask_j(mid,j), mask_i(mid,i) )
11909                         ENDDO
11910                      ENDDO
11911                   ENDDO
11912                ELSE
11913                   DO  i = 1, mask_size_l(mid,1)
11914                      DO  j = 1, mask_size_l(mid,2)
11915!
11916!--                      Get k index of the highest terraing surface
11917                         im = mask_i(mid,i)
11918                         jm = mask_j(mid,j)
11919                         ktt = MINLOC( MERGE( 1, 0, BTEST( wall_flags_0(:,jm,im), 5 )), DIM = 1 ) - 1
11920                         DO  k = 1, mask_size_l(mid,3)
11921                            kk = MIN( ktt+mask_k(mid,k), nzt+1 )
11922!
11923!--                         Set value if not in building
11924                            IF ( BTEST( wall_flags_0(kk,jm,im), 6 ) )  THEN
11925                               local_pf(i,j,k) = fill_value
11926                            ELSE
11927                               local_pf(i,j,k) = tend(kk,jm,im)
11928                            ENDIF
11929                         ENDDO
11930                      ENDDO
11931                   ENDDO
11932                ENDIF
11933                resorted = .TRUE.
11934             ELSE
11935!
11936!--             9: remove salsa_s_ from the beginning
11937                IF ( TRIM( variable(9:) ) == 'BC' )   to_be_resorted => s_bc_av
11938                IF ( TRIM( variable(9:) ) == 'DU' )   to_be_resorted => s_du_av
11939                IF ( TRIM( variable(9:) ) == 'NH' )   to_be_resorted => s_nh_av
11940                IF ( TRIM( variable(9:) ) == 'NO' )   to_be_resorted => s_no_av
11941                IF ( TRIM( variable(9:) ) == 'OC' )   to_be_resorted => s_oc_av
11942                IF ( TRIM( variable(9:) ) == 'SO4' )  to_be_resorted => s_so4_av
11943                IF ( TRIM( variable(9:) ) == 'SS' )   to_be_resorted => s_ss_av
11944             ENDIF
11945
11946          CASE ( 's_H2O' )
11947             IF ( av == 0 )  THEN
11948                found_index = get_index( prtcl, 'H2O' )
11949                DO  i = nxl, nxr
11950                   DO  j = nys, nyn
11951                      DO  k = nzb, nz_do3d
11952                         temp_bin = 0.0_wp
11953                         DO  ic = ( found_index-1 ) * nbins_aerosol + 1, found_index * nbins_aerosol
11954                            temp_bin = temp_bin + aerosol_mass(ic)%conc(k,j,i)
11955                         ENDDO
11956                         tend(k,j,i) = temp_bin
11957                      ENDDO
11958                   ENDDO
11959                ENDDO
11960                IF ( .NOT. mask_surface(mid) )  THEN
11961                   DO  i = 1, mask_size_l(mid,1)
11962                      DO  j = 1, mask_size_l(mid,2)
11963                         DO  k = 1, mask_size_l(mid,3)
11964                            local_pf(i,j,k) = tend( mask_k(mid,k), mask_j(mid,j), mask_i(mid,i) )
11965                         ENDDO
11966                      ENDDO
11967                   ENDDO
11968                ELSE
11969                   DO  i = 1, mask_size_l(mid,1)
11970                      DO  j = 1, mask_size_l(mid,2)
11971!
11972!--                      Get k index of the highest terraing surface
11973                         im = mask_i(mid,i)
11974                         jm = mask_j(mid,j)
11975                         ktt = MINLOC( MERGE( 1, 0, BTEST( wall_flags_0(:,jm,im), 5 )), DIM = 1 ) - 1
11976                         DO  k = 1, mask_size_l(mid,3)
11977                            kk = MIN( ktt+mask_k(mid,k), nzt+1 )
11978!
11979!--                         Set value if not in building
11980                            IF ( BTEST( wall_flags_0(kk,jm,im), 6 ) )  THEN
11981                               local_pf(i,j,k) = fill_value
11982                            ELSE
11983                               local_pf(i,j,k) =  tend(kk,jm,im)
11984                            ENDIF
11985                         ENDDO
11986                      ENDDO
11987                   ENDDO
11988                ENDIF
11989                resorted = .TRUE.
11990             ELSE
11991                to_be_resorted => s_h2o_av
11992             ENDIF
11993
11994          CASE DEFAULT
11995             found = .FALSE.
11996
11997       END SELECT
11998    ENDIF
11999
12000    IF ( found  .AND.  .NOT. resorted )  THEN
12001       IF ( .NOT. mask_surface(mid) )  THEN
12002!
12003!--       Default masked output
12004          DO  i = 1, mask_size_l(mid,1)
12005             DO  j = 1, mask_size_l(mid,2)
12006                DO  k = 1, mask_size_l(mid,3)
12007                   local_pf(i,j,k) = to_be_resorted( mask_k(mid,k), mask_j(mid,j), mask_i(mid,i) )
12008                ENDDO
12009             ENDDO
12010          ENDDO
12011       ELSE
12012!
12013!--       Terrain-following masked output
12014          DO  i = 1, mask_size_l(mid,1)
12015             DO  j = 1, mask_size_l(mid,2)
12016!--             Get k index of the highest terraing surface
12017                im = mask_i(mid,i)
12018                jm = mask_j(mid,j)
12019                ktt = MINLOC( MERGE( 1, 0, BTEST( wall_flags_0(:,jm,im), 5 )), DIM = 1 ) - 1
12020                DO  k = 1, mask_size_l(mid,3)
12021                   kk = MIN( ktt+mask_k(mid,k), nzt+1 )
12022!--                Set value if not in building
12023                   IF ( BTEST( wall_flags_0(kk,jm,im), 6 ) )  THEN
12024                      local_pf(i,j,k) = fill_value
12025                   ELSE
12026                      local_pf(i,j,k) = to_be_resorted(kk,jm,im)
12027                   ENDIF
12028                ENDDO
12029             ENDDO
12030          ENDDO
12031       ENDIF
12032    ENDIF
12033
12034 END SUBROUTINE salsa_data_output_mask
12035
12036!------------------------------------------------------------------------------!
12037! Description:
12038! ------------
12039!> Creates index tables for different (aerosol) components
12040!------------------------------------------------------------------------------!
12041 SUBROUTINE component_index_constructor( self, ncomp, nlist, listcomp )
12042
12043    IMPLICIT NONE
12044
12045    INTEGER(iwp) ::  ii  !<
12046    INTEGER(iwp) ::  jj  !<
12047
12048    INTEGER(iwp), INTENT(in) ::  nlist ! < Maximum number of components
12049
12050    INTEGER(iwp), INTENT(inout) ::  ncomp  !< Number of components
12051
12052    CHARACTER(LEN=3), INTENT(in) ::  listcomp(nlist)  !< List cof component names
12053
12054    TYPE(component_index), INTENT(inout) ::  self  !< Object containing the indices of different
12055                                                   !< aerosol components
12056
12057    ncomp = 0
12058
12059    DO WHILE ( listcomp(ncomp+1) /= '  ' .AND. ncomp < nlist )
12060       ncomp = ncomp + 1
12061    ENDDO
12062
12063    self%ncomp = ncomp
12064    ALLOCATE( self%ind(ncomp), self%comp(ncomp) )
12065
12066    DO  ii = 1, ncomp
12067       self%ind(ii) = ii
12068    ENDDO
12069
12070    jj = 1
12071    DO  ii = 1, nlist
12072       IF ( listcomp(ii) == '') CYCLE
12073       self%comp(jj) = listcomp(ii)
12074       jj = jj + 1
12075    ENDDO
12076
12077 END SUBROUTINE component_index_constructor
12078
12079!------------------------------------------------------------------------------!
12080! Description:
12081! ------------
12082!> Gives the index of a component in the component list
12083!------------------------------------------------------------------------------!
12084 INTEGER FUNCTION get_index( self, incomp )
12085
12086    IMPLICIT NONE
12087
12088    CHARACTER(LEN=*), INTENT(in) ::  incomp !< Component name
12089
12090    INTEGER(iwp) ::  ii  !< index
12091
12092    TYPE(component_index), INTENT(in) ::  self  !< Object containing the indices of different
12093                                                !< aerosol components
12094    IF ( ANY( self%comp == incomp ) )  THEN
12095       ii = 1
12096       DO WHILE ( (self%comp(ii) /= incomp) )
12097          ii = ii + 1
12098       ENDDO
12099       get_index = ii
12100    ELSEIF ( incomp == 'H2O' )  THEN
12101       get_index = self%ncomp + 1
12102    ELSE
12103       WRITE( message_string, * ) 'Incorrect component name given!'
12104       CALL message( 'get_index', 'PA0591', 1, 2, 0, 6, 0 )
12105    ENDIF
12106
12107 END FUNCTION get_index
12108
12109!------------------------------------------------------------------------------!
12110! Description:
12111! ------------
12112!> Tells if the (aerosol) component is being used in the simulation
12113!------------------------------------------------------------------------------!
12114 LOGICAL FUNCTION is_used( self, icomp )
12115
12116    IMPLICIT NONE
12117
12118    CHARACTER(LEN=*), INTENT(in) ::  icomp !< Component name
12119
12120    TYPE(component_index), INTENT(in) ::  self  !< Object containing the indices of different
12121                                                !< aerosol components
12122
12123    IF ( ANY(self%comp == icomp) ) THEN
12124       is_used = .TRUE.
12125    ELSE
12126       is_used = .FALSE.
12127    ENDIF
12128
12129 END FUNCTION
12130
12131!------------------------------------------------------------------------------!
12132! Description:
12133! ------------
12134!> Set the lateral and top boundary conditions in case the PALM domain is
12135!> nested offline in a mesoscale model. Further, average boundary data and
12136!> determine mean profiles, further used for correct damping in the sponge
12137!> layer.
12138!------------------------------------------------------------------------------!
12139 SUBROUTINE salsa_nesting_offl_bc
12140
12141    USE control_parameters,                                                                        &
12142        ONLY:  bc_dirichlet_l, bc_dirichlet_n, bc_dirichlet_r, bc_dirichlet_s, dt_3d,              &
12143               time_since_reference_point
12144
12145    USE indices,                                                                                   &
12146        ONLY:  nbgp, nxl, nxr, nyn, nys, nzb, nzt
12147
12148    IMPLICIT NONE
12149
12150    INTEGER(iwp) ::  i    !< running index x-direction
12151    INTEGER(iwp) ::  ib   !< running index for aerosol number bins
12152    INTEGER(iwp) ::  ic   !< running index for aerosol mass bins
12153    INTEGER(iwp) ::  icc  !< running index for aerosol mass bins
12154    INTEGER(iwp) ::  ig   !< running index for gaseous species
12155    INTEGER(iwp) ::  j    !< running index y-direction
12156    INTEGER(iwp) ::  k    !< running index z-direction
12157
12158    REAL(wp) ::  fac_dt  !< interpolation factor
12159
12160    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  ref_mconc    !< reference profile for aerosol mass
12161    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  ref_mconc_l  !< reference profile for aerosol mass: subdomain
12162    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  ref_nconc    !< reference profile for aerosol number
12163    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  ref_nconc_l  !< reference profile for aerosol_number: subdomain
12164    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  ref_gconc    !< reference profile for gases
12165    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  ref_gconc_l  !< reference profile for gases: subdomain
12166
12167!
12168!-- Skip input if no forcing from larger-scale models is applied.
12169    IF ( .NOT. nesting_offline_salsa )  RETURN
12170!
12171!-- Allocate temporary arrays to compute salsa mean profiles
12172    ALLOCATE( ref_gconc(nzb:nzt+1,1:ngases_salsa), ref_gconc_l(nzb:nzt+1,1:ngases_salsa),          &
12173              ref_mconc(nzb:nzt+1,1:nbins_aerosol*ncomponents_mass),                               &
12174              ref_mconc_l(nzb:nzt+1,1:nbins_aerosol*ncomponents_mass),                             &
12175              ref_nconc(nzb:nzt+1,1:nbins_aerosol), ref_nconc_l(nzb:nzt+1,1:nbins_aerosol) )
12176    ref_gconc   = 0.0_wp
12177    ref_gconc_l = 0.0_wp
12178    ref_mconc   = 0.0_wp
12179    ref_mconc_l = 0.0_wp
12180    ref_nconc   = 0.0_wp
12181    ref_nconc_l = 0.0_wp
12182
12183!
12184!-- Determine interpolation factor and limit it to 1. This is because t+dt can slightly exceed
12185!-- time(tind_p) before boundary data is updated again.
12186    fac_dt = ( time_since_reference_point - salsa_nest_offl%time(salsa_nest_offl%tind)  + dt_3d )  &
12187             / ( salsa_nest_offl%time(salsa_nest_offl%tind_p) -                                    &
12188                 salsa_nest_offl%time(salsa_nest_offl%tind) )
12189    fac_dt = MIN( 1.0_wp, fac_dt )
12190
12191    IF ( bc_dirichlet_l )  THEN
12192       DO  ib = 1, nbins_aerosol
12193          DO  j = nys, nyn
12194             DO  k = nzb+1, nzt
12195                aerosol_number(ib)%conc(k,j,-1) = ( 1.0_wp - fac_dt ) *                            &
12196                                                  salsa_nest_offl%nconc_left(0,k,j,ib) + fac_dt *  &
12197                                                  salsa_nest_offl%nconc_left(1,k,j,ib)
12198             ENDDO
12199             ref_nconc_l(nzb+1:nzt,ib) = ref_nconc_l(nzb+1:nzt,ib) +                               &
12200                                         aerosol_number(ib)%conc(nzb+1:nzt,j,-1)
12201          ENDDO
12202          DO  ic = 1, ncomponents_mass
12203             icc = ( ic-1 ) * nbins_aerosol + ib
12204             DO  j = nys, nyn
12205                DO  k = nzb+1, nzt
12206                   aerosol_mass(icc)%conc(k,j,-1) = ( 1.0_wp - fac_dt ) *                          &
12207                                                    salsa_nest_offl%mconc_left(0,k,j,icc) + fac_dt &
12208                                                    * salsa_nest_offl%mconc_left(1,k,j,icc)
12209                ENDDO
12210                ref_mconc_l(nzb+1:nzt,icc) = ref_mconc_l(nzb+1:nzt,icc) +                          &
12211                                             aerosol_mass(icc)%conc(nzb+1:nzt,j,-1)
12212             ENDDO
12213          ENDDO
12214       ENDDO
12215       IF ( .NOT. salsa_gases_from_chem )  THEN
12216          DO  ig = 1, ngases_salsa
12217             DO  j = nys, nyn
12218                DO  k = nzb+1, nzt
12219                   salsa_gas(ig)%conc(k,j,-1) = ( 1.0_wp - fac_dt ) *                              &
12220                                                salsa_nest_offl%gconc_left(0,k,j,ig) + fac_dt *    &
12221                                                salsa_nest_offl%gconc_left(1,k,j,ig)
12222                ENDDO
12223                ref_gconc_l(nzb+1:nzt,ig) = ref_gconc_l(nzb+1:nzt,ig) +                            &
12224                                            salsa_gas(ig)%conc(nzb+1:nzt,j,-1)
12225             ENDDO
12226          ENDDO
12227       ENDIF
12228    ENDIF
12229
12230    IF ( bc_dirichlet_r )  THEN
12231       DO  ib = 1, nbins_aerosol
12232          DO  j = nys, nyn
12233             DO  k = nzb+1, nzt
12234                aerosol_number(ib)%conc(k,j,nxr+1) = ( 1.0_wp - fac_dt ) *                         &
12235                                                  salsa_nest_offl%nconc_right(0,k,j,ib) + fac_dt * &
12236                                                  salsa_nest_offl%nconc_right(1,k,j,ib)
12237             ENDDO
12238             ref_nconc_l(nzb+1:nzt,ib) = ref_nconc_l(nzb+1:nzt,ib) +                               &
12239                                         aerosol_number(ib)%conc(nzb+1:nzt,j,nxr+1)
12240          ENDDO
12241          DO  ic = 1, ncomponents_mass
12242             icc = ( ic-1 ) * nbins_aerosol + ib
12243             DO  j = nys, nyn
12244                DO  k = nzb+1, nzt
12245                   aerosol_mass(icc)%conc(k,j,nxr+1) = ( 1.0_wp - fac_dt ) *                       &
12246                                                    salsa_nest_offl%mconc_right(0,k,j,icc) + fac_dt&
12247                                                    * salsa_nest_offl%mconc_right(1,k,j,icc)
12248                ENDDO
12249                ref_mconc_l(nzb+1:nzt,icc) = ref_mconc_l(nzb+1:nzt,icc) +                          &
12250                                             aerosol_mass(icc)%conc(nzb+1:nzt,j,nxr+1)
12251             ENDDO
12252          ENDDO
12253       ENDDO
12254       IF ( .NOT. salsa_gases_from_chem )  THEN
12255          DO  ig = 1, ngases_salsa
12256             DO  j = nys, nyn
12257                DO  k = nzb+1, nzt
12258                   salsa_gas(ig)%conc(k,j,nxr+1) = ( 1.0_wp - fac_dt ) *                           &
12259                                                   salsa_nest_offl%gconc_right(0,k,j,ig) + fac_dt *&
12260                                                   salsa_nest_offl%gconc_right(1,k,j,ig)
12261                ENDDO
12262                ref_gconc_l(nzb+1:nzt,ig) = ref_gconc_l(nzb+1:nzt,ig) +                            &
12263                                            salsa_gas(ig)%conc(nzb+1:nzt,j,nxr+1)
12264             ENDDO
12265          ENDDO
12266       ENDIF
12267    ENDIF
12268
12269    IF ( bc_dirichlet_n )  THEN
12270       DO  ib = 1, nbins_aerosol
12271          DO  i = nxl, nxr
12272             DO  k = nzb+1, nzt
12273                aerosol_number(ib)%conc(k,nyn+1,i) = ( 1.0_wp - fac_dt ) *                         &
12274                                                  salsa_nest_offl%nconc_north(0,k,i,ib) + fac_dt * &
12275                                                  salsa_nest_offl%nconc_north(1,k,i,ib)
12276             ENDDO
12277             ref_nconc_l(nzb+1:nzt,ib) = ref_nconc_l(nzb+1:nzt,ib) +                               &
12278                                         aerosol_number(ib)%conc(nzb+1:nzt,nyn+1,i)
12279          ENDDO
12280          DO  ic = 1, ncomponents_mass
12281             icc = ( ic-1 ) * nbins_aerosol + ib
12282             DO  i = nxl, nxr
12283                DO  k = nzb+1, nzt
12284                   aerosol_mass(icc)%conc(k,nyn+1,i) = ( 1.0_wp - fac_dt ) *                       &
12285                                                    salsa_nest_offl%mconc_north(0,k,i,icc) + fac_dt&
12286                                                    * salsa_nest_offl%mconc_north(1,k,i,icc)
12287                ENDDO
12288                ref_mconc_l(nzb+1:nzt,icc) = ref_mconc_l(nzb+1:nzt,icc) +                          &
12289                                             aerosol_mass(icc)%conc(nzb+1:nzt,nyn+1,i)
12290             ENDDO
12291          ENDDO
12292       ENDDO
12293       IF ( .NOT. salsa_gases_from_chem )  THEN
12294          DO  ig = 1, ngases_salsa
12295             DO  i = nxl, nxr
12296                DO  k = nzb+1, nzt
12297                   salsa_gas(ig)%conc(k,nyn+1,i) = ( 1.0_wp - fac_dt ) *                           &
12298                                                   salsa_nest_offl%gconc_north(0,k,i,ig) + fac_dt *&
12299                                                   salsa_nest_offl%gconc_north(1,k,i,ig)
12300                ENDDO
12301                ref_gconc_l(nzb+1:nzt,ig) = ref_gconc_l(nzb+1:nzt,ig) +                            &
12302                                            salsa_gas(ig)%conc(nzb+1:nzt,nyn+1,i)
12303             ENDDO
12304          ENDDO
12305       ENDIF
12306    ENDIF
12307
12308    IF ( bc_dirichlet_s )  THEN
12309       DO  ib = 1, nbins_aerosol
12310          DO  i = nxl, nxr
12311             DO  k = nzb+1, nzt
12312                aerosol_number(ib)%conc(k,-1,i) = ( 1.0_wp - fac_dt ) *                            &
12313                                                  salsa_nest_offl%nconc_south(0,k,i,ib) + fac_dt * &
12314                                                  salsa_nest_offl%nconc_south(1,k,i,ib)
12315             ENDDO
12316             ref_nconc_l(nzb+1:nzt,ib) = ref_nconc_l(nzb+1:nzt,ib) +                               &
12317                                         aerosol_number(ib)%conc(nzb+1:nzt,-1,i)
12318          ENDDO
12319          DO  ic = 1, ncomponents_mass
12320             icc = ( ic-1 ) * nbins_aerosol + ib
12321             DO  i = nxl, nxr
12322                DO  k = nzb+1, nzt
12323                   aerosol_mass(icc)%conc(k,-1,i) = ( 1.0_wp - fac_dt ) *                          &
12324                                                    salsa_nest_offl%mconc_south(0,k,i,icc) + fac_dt&
12325                                                    * salsa_nest_offl%mconc_south(1,k,i,icc)
12326                ENDDO
12327                ref_mconc_l(nzb+1:nzt,icc) = ref_mconc_l(nzb+1:nzt,icc) +                          &
12328                                             aerosol_mass(icc)%conc(nzb+1:nzt,-1,i)
12329             ENDDO
12330          ENDDO
12331       ENDDO
12332       IF ( .NOT. salsa_gases_from_chem )  THEN
12333          DO  ig = 1, ngases_salsa
12334             DO  i = nxl, nxr
12335                DO  k = nzb+1, nzt
12336                   salsa_gas(ig)%conc(k,-1,i) = ( 1.0_wp - fac_dt ) *                              &
12337                                                salsa_nest_offl%gconc_south(0,k,i,ig) + fac_dt *   &
12338                                                salsa_nest_offl%gconc_south(1,k,i,ig)
12339                ENDDO
12340                ref_gconc_l(nzb+1:nzt,ig) = ref_gconc_l(nzb+1:nzt,ig) +                            &
12341                                            salsa_gas(ig)%conc(nzb+1:nzt,-1,i)
12342             ENDDO
12343          ENDDO
12344       ENDIF
12345    ENDIF
12346!
12347!-- Top boundary
12348    DO  ib = 1, nbins_aerosol
12349       DO  i = nxl, nxr
12350          DO  j = nys, nyn
12351             aerosol_number(ib)%conc(nzt+1,j,i) = ( 1.0_wp - fac_dt ) *                            &
12352                                                  salsa_nest_offl%nconc_top(0,j,i,ib) + fac_dt *   &
12353                                                  salsa_nest_offl%nconc_top(1,j,i,ib)
12354             ref_nconc_l(nzt+1,ib) = ref_nconc_l(nzt+1,ib) + aerosol_number(ib)%conc(nzt+1,j,i)
12355          ENDDO
12356       ENDDO
12357       DO  ic = 1, ncomponents_mass
12358          icc = ( ic-1 ) * nbins_aerosol + ib
12359          DO  i = nxl, nxr
12360             DO  j = nys, nyn
12361                aerosol_mass(icc)%conc(nzt+1,j,i) = ( 1.0_wp - fac_dt ) *                          &
12362                                                    salsa_nest_offl%mconc_top(0,j,i,icc) + fac_dt *&
12363                                                    salsa_nest_offl%mconc_top(1,j,i,icc)
12364                ref_mconc_l(nzt+1,icc) = ref_mconc_l(nzt+1,icc) + aerosol_mass(icc)%conc(nzt+1,j,i)
12365             ENDDO
12366          ENDDO
12367       ENDDO
12368    ENDDO
12369    IF ( .NOT. salsa_gases_from_chem )  THEN
12370       DO  ig = 1, ngases_salsa
12371          DO  i = nxl, nxr
12372             DO  j = nys, nyn
12373                salsa_gas(ig)%conc(nzt+1,j,i) = ( 1.0_wp - fac_dt ) *                              &
12374                                                salsa_nest_offl%gconc_top(0,j,i,ig) + fac_dt *     &
12375                                                salsa_nest_offl%gconc_top(1,j,i,ig)
12376                ref_gconc_l(nzt+1,ig) = ref_gconc_l(nzt+1,ig) + salsa_gas(ig)%conc(nzt+1,j,i)
12377             ENDDO
12378          ENDDO
12379       ENDDO
12380    ENDIF
12381!
12382!-- Do local exchange
12383    DO  ib = 1, nbins_aerosol
12384       CALL exchange_horiz( aerosol_number(ib)%conc, nbgp )
12385       DO  ic = 1, ncomponents_mass
12386          icc = ( ic-1 ) * nbins_aerosol + ib
12387          CALL exchange_horiz( aerosol_mass(icc)%conc, nbgp )
12388       ENDDO
12389    ENDDO
12390    IF ( .NOT. salsa_gases_from_chem )  THEN
12391       DO  ig = 1, ngases_salsa
12392          CALL exchange_horiz( salsa_gas(ig)%conc, nbgp )
12393       ENDDO
12394    ENDIF
12395!
12396!-- In case of Rayleigh damping, where the initial profiles are still used, update these profiles
12397!-- from the averaged boundary data. But first, average these data.
12398#if defined( __parallel )
12399    IF ( .NOT. salsa_gases_from_chem )                                                             &
12400       CALL MPI_ALLREDUCE( ref_gconc_l, ref_gconc, ( nzt+1-nzb+1 ) * SIZE( ref_gconc(nzb,:) ),     &
12401                           MPI_REAL, MPI_SUM, comm2d, ierr )
12402    CALL MPI_ALLREDUCE( ref_mconc_l, ref_mconc, ( nzt+1-nzb+1 ) * SIZE( ref_mconc(nzb,:) ),        &
12403                        MPI_REAL, MPI_SUM, comm2d, ierr )
12404    CALL MPI_ALLREDUCE( ref_nconc_l, ref_nconc, ( nzt+1-nzb+1 ) * SIZE( ref_nconc(nzb,:) ),        &
12405                        MPI_REAL, MPI_SUM, comm2d, ierr )
12406#else
12407    IF ( .NOT. salsa_gases_from_chem )  ref_gconc = ref_gconc_l
12408    ref_mconc = ref_mconc_l
12409    ref_nconc = ref_nconc_l
12410#endif
12411!
12412!-- Average data. Note, reference profiles up to nzt are derived from lateral boundaries, at the
12413!-- model top it is derived from the top boundary. Thus, number of input data is different from
12414!-- nzb:nzt compared to nzt+1.
12415!-- Derived from lateral boundaries.
12416    IF ( .NOT. salsa_gases_from_chem )                                                             &
12417       ref_gconc(nzb:nzt,:) = ref_gconc(nzb:nzt,:) / REAL( 2.0_wp * ( ny + 1 + nx + 1 ), KIND = wp )
12418    ref_mconc(nzb:nzt,:) = ref_mconc(nzb:nzt,:) / REAL( 2.0_wp * ( ny + 1 + nx + 1 ), KIND = wp )
12419    ref_nconc(nzb:nzt,:) = ref_nconc(nzb:nzt,:) / REAL( 2.0_wp * ( ny + 1 + nx + 1 ), KIND = wp )
12420!
12421!-- Derived from top boundary
12422    IF ( .NOT. salsa_gases_from_chem )                                                             &
12423       ref_gconc(nzt+1,:) = ref_gconc(nzt+1,:) / REAL( ( ny + 1 ) * ( nx + 1 ), KIND = wp )
12424    ref_mconc(nzt+1,:) = ref_mconc(nzt+1,:) / REAL( ( ny + 1 ) * ( nx + 1 ), KIND = wp )
12425    ref_nconc(nzt+1,:) = ref_nconc(nzt+1,:) / REAL( ( ny + 1 ) * ( nx + 1 ), KIND = wp )
12426!
12427!-- Write onto init profiles, which are used for damping. Also set lower boundary condition.
12428    DO  ib = 1, nbins_aerosol
12429       aerosol_number(ib)%init(:)   = ref_nconc(:,ib)
12430       aerosol_number(ib)%init(nzb) = aerosol_number(ib)%init(nzb+1)
12431       DO  ic = 1, ncomponents_mass
12432          icc = ( ic-1 ) * nbins_aerosol + ib
12433          aerosol_mass(icc)%init(:)   = ref_mconc(:,icc)
12434          aerosol_mass(icc)%init(nzb) = aerosol_mass(icc)%init(nzb+1)
12435       ENDDO
12436    ENDDO
12437    IF ( .NOT. salsa_gases_from_chem )  THEN
12438       DO  ig = 1, ngases_salsa
12439          salsa_gas(ig)%init(:)   = ref_gconc(:,ig)
12440          salsa_gas(ig)%init(nzb) = salsa_gas(ig)%init(nzb+1)
12441       ENDDO
12442    ENDIF
12443
12444    DEALLOCATE( ref_gconc, ref_gconc_l, ref_mconc, ref_mconc_l, ref_nconc, ref_nconc_l )
12445
12446 END SUBROUTINE salsa_nesting_offl_bc
12447
12448!------------------------------------------------------------------------------!
12449! Description:
12450! ------------
12451!> Allocate arrays used to read boundary data from NetCDF file and initialize
12452!> boundary data.
12453!------------------------------------------------------------------------------!
12454 SUBROUTINE salsa_nesting_offl_init
12455
12456    USE control_parameters,                                                                        &
12457        ONLY:  end_time, initializing_actions, spinup_time
12458
12459    USE palm_date_time_mod,                                                                        &
12460        ONLY:  get_date_time
12461
12462    IMPLICIT NONE
12463
12464    INTEGER(iwp) ::  ib          !< running index for aerosol number bins
12465    INTEGER(iwp) ::  ic          !< running index for aerosol mass bins
12466    INTEGER(iwp) ::  icc         !< additional running index for aerosol mass bins
12467    INTEGER(iwp) ::  ig          !< running index for gaseous species
12468    INTEGER(iwp) ::  nmass_bins  !< number of aerosol mass bins
12469
12470    nmass_bins = nbins_aerosol * ncomponents_mass
12471!
12472!-- Get time_utc_init from origin_date_time
12473    CALL get_date_time( 0.0_wp, second_of_day = time_utc_init )
12474!
12475!-- Allocate arrays for reading boundary values. Arrays will incorporate 2 time levels in order to
12476!-- interpolate in between.
12477    IF ( nesting_offline_salsa )  THEN
12478       IF ( bc_dirichlet_l )  THEN
12479          ALLOCATE( salsa_nest_offl%nconc_left(0:1,nzb+1:nzt,nys:nyn,1:nbins_aerosol) )
12480          ALLOCATE( salsa_nest_offl%mconc_left(0:1,nzb+1:nzt,nys:nyn,1:nmass_bins) )
12481       ENDIF
12482       IF ( bc_dirichlet_r )  THEN
12483          ALLOCATE( salsa_nest_offl%nconc_right(0:1,nzb+1:nzt,nys:nyn,1:nbins_aerosol) )
12484          ALLOCATE( salsa_nest_offl%mconc_right(0:1,nzb+1:nzt,nys:nyn,1:nmass_bins) )
12485       ENDIF
12486       IF ( bc_dirichlet_n )  THEN
12487          ALLOCATE( salsa_nest_offl%nconc_north(0:1,nzb+1:nzt,nxl:nxr,1:nbins_aerosol) )
12488          ALLOCATE( salsa_nest_offl%mconc_north(0:1,nzb+1:nzt,nxl:nxr,1:nmass_bins) )
12489       ENDIF
12490       IF ( bc_dirichlet_s )  THEN
12491          ALLOCATE( salsa_nest_offl%nconc_south(0:1,nzb+1:nzt,nxl:nxr,1:nbins_aerosol) )
12492          ALLOCATE( salsa_nest_offl%mconc_south(0:1,nzb+1:nzt,nxl:nxr,1:nmass_bins) )
12493       ENDIF
12494       ALLOCATE( salsa_nest_offl%nconc_top(0:1,nys:nyn,nxl:nxr,1:nbins_aerosol) )
12495       ALLOCATE( salsa_nest_offl%mconc_top(0:1,nys:nyn,nxl:nxr,1:nmass_bins) )
12496
12497       IF ( .NOT. salsa_gases_from_chem )  THEN
12498          IF ( bc_dirichlet_l )  THEN
12499             ALLOCATE( salsa_nest_offl%gconc_left(0:1,nzb+1:nzt,nys:nyn,1:ngases_salsa) )
12500          ENDIF
12501          IF ( bc_dirichlet_r )  THEN
12502             ALLOCATE( salsa_nest_offl%gconc_right(0:1,nzb+1:nzt,nys:nyn,1:ngases_salsa) )
12503          ENDIF
12504          IF ( bc_dirichlet_n )  THEN
12505             ALLOCATE( salsa_nest_offl%gconc_north(0:1,nzb+1:nzt,nxl:nxr,1:ngases_salsa) )
12506          ENDIF
12507          IF ( bc_dirichlet_s )  THEN
12508             ALLOCATE( salsa_nest_offl%gconc_south(0:1,nzb+1:nzt,nxl:nxr,1:ngases_salsa) )
12509          ENDIF
12510          ALLOCATE( salsa_nest_offl%gconc_top(0:1,nys:nyn,nxl:nxr,1:ngases_salsa) )
12511       ENDIF
12512
12513!
12514!--    Read data at lateral and top boundaries from a larger-scale model
12515       CALL salsa_nesting_offl_input
12516!
12517!--    Check if sufficient time steps are provided to cover the entire simulation. Note, dynamic
12518!--    input is only required for the 3D simulation, not for the soil/wall spinup. However, as the
12519!--    spinup time is added to the end_time, this must be considered here.
12520       IF ( end_time - spinup_time >                                           &
12521            salsa_nest_offl%time(salsa_nest_offl%nt-1) - time_utc_init )  THEN
12522          message_string = 'end_time of the simulation exceeds the time dimension in the dynamic'//&
12523                           ' input file.'
12524          CALL message( 'salsa_nesting_offl_init', 'PA0681', 1, 2, 0, 6, 0 ) 
12525       ENDIF
12526
12527       IF ( salsa_nest_offl%time(0) /= time_utc_init )  THEN
12528          message_string = 'Offline nesting: time dimension must start at time_utc_init.'
12529          CALL message( 'salsa_nesting_offl_init', 'PA0682', 1, 2, 0, 6, 0 )
12530       ENDIF
12531!
12532!--    Initialize boundary data. Please note, do not initialize boundaries in case of restart runs.
12533       IF ( TRIM( initializing_actions ) /= 'read_restart_data'  .AND.  read_restart_data_salsa )  &
12534       THEN
12535          IF ( bc_dirichlet_l )  THEN
12536             DO  ib = 1, nbins_aerosol
12537                aerosol_number(ib)%conc(nzb+1:nzt,nys:nyn,-1) =                                    &
12538                                                 salsa_nest_offl%nconc_left(0,nzb+1:nzt,nys:nyn,ib)
12539                DO  ic = 1, ncomponents_mass
12540                   icc = ( ic - 1 ) * nbins_aerosol + ib
12541                   aerosol_mass(icc)%conc(nzb+1:nzt,nys:nyn,-1) =                                  &
12542                                                 salsa_nest_offl%mconc_left(0,nzb+1:nzt,nys:nyn,icc)
12543                ENDDO
12544             ENDDO
12545             DO  ig = 1, ngases_salsa
12546                salsa_gas(ig)%conc(nzb+1:nzt,nys:nyn,-1) =                                         &
12547                                                 salsa_nest_offl%gconc_left(0,nzb+1:nzt,nys:nyn,ig)
12548             ENDDO
12549          ENDIF
12550          IF ( bc_dirichlet_r )  THEN
12551             DO  ib = 1, nbins_aerosol
12552                aerosol_number(ib)%conc(nzb+1:nzt,nys:nyn,nxr+1) =                                 &
12553                                                salsa_nest_offl%nconc_right(0,nzb+1:nzt,nys:nyn,ib)
12554                DO  ic = 1, ncomponents_mass
12555                   icc = ( ic - 1 ) * nbins_aerosol + ib
12556                   aerosol_mass(icc)%conc(nzb+1:nzt,nys:nyn,nxr+1) =                               &
12557                                                salsa_nest_offl%mconc_right(0,nzb+1:nzt,nys:nyn,icc)
12558                ENDDO
12559             ENDDO
12560             DO  ig = 1, ngases_salsa
12561                salsa_gas(ig)%conc(nzb+1:nzt,nys:nyn,nxr+1) =                                      &
12562                                                 salsa_nest_offl%gconc_right(0,nzb+1:nzt,nys:nyn,ig)
12563             ENDDO
12564          ENDIF
12565          IF ( bc_dirichlet_n )  THEN
12566             DO  ib = 1, nbins_aerosol
12567                aerosol_number(ib)%conc(nzb+1:nzt,nyn+1,nxl:nxr) =                                 &
12568                                                salsa_nest_offl%nconc_north(0,nzb+1:nzt,nxl:nxr,ib)
12569                DO  ic = 1, ncomponents_mass
12570                   icc = ( ic - 1 ) * nbins_aerosol + ib
12571                   aerosol_mass(icc)%conc(nzb+1:nzt,nyn+1,nxl:nxr) =                               &
12572                                                salsa_nest_offl%mconc_north(0,nzb+1:nzt,nxl:nxr,icc)
12573                ENDDO
12574             ENDDO
12575             DO  ig = 1, ngases_salsa
12576                salsa_gas(ig)%conc(nzb+1:nzt,nyn+1,nxl:nxr) =                                      &
12577                                                 salsa_nest_offl%gconc_north(0,nzb+1:nzt,nxl:nxr,ig)
12578             ENDDO
12579          ENDIF
12580          IF ( bc_dirichlet_s )  THEN
12581             DO  ib = 1, nbins_aerosol
12582                aerosol_number(ib)%conc(nzb+1:nzt,-1,nxl:nxr) =                                    &
12583                                                salsa_nest_offl%nconc_south(0,nzb+1:nzt,nxl:nxr,ib)
12584                DO  ic = 1, ncomponents_mass
12585                   icc = ( ic - 1 ) * nbins_aerosol + ib
12586                   aerosol_mass(icc)%conc(nzb+1:nzt,-1,nxl:nxr) =                                  &
12587                                                salsa_nest_offl%mconc_south(0,nzb+1:nzt,nxl:nxr,icc)
12588                ENDDO
12589             ENDDO
12590             DO  ig = 1, ngases_salsa
12591                salsa_gas(ig)%conc(nzb+1:nzt,-1,nxl:nxr) =                                         &
12592                                                 salsa_nest_offl%gconc_south(0,nzb+1:nzt,nxl:nxr,ig)
12593             ENDDO
12594          ENDIF
12595       ENDIF
12596    ENDIF
12597
12598 END SUBROUTINE salsa_nesting_offl_init
12599
12600!------------------------------------------------------------------------------!
12601! Description:
12602! ------------
12603!> Set the lateral and top boundary conditions in case the PALM domain is
12604!> nested offline in a mesoscale model. Further, average boundary data and
12605!> determine mean profiles, further used for correct damping in the sponge
12606!> layer.
12607!------------------------------------------------------------------------------!
12608 SUBROUTINE salsa_nesting_offl_input
12609
12610    USE netcdf_data_input_mod,                                                                     &
12611        ONLY:  check_existence, close_input_file, get_attribute, get_variable,                     &
12612               inquire_num_variables, inquire_variable_names,                                      &
12613               get_dimension_length, open_read_file
12614
12615    IMPLICIT NONE
12616
12617    CHARACTER(LEN=25) ::  vname  !< variable name
12618
12619    INTEGER(iwp) ::  ic        !< running index for aerosol chemical components
12620    INTEGER(iwp) ::  ig        !< running index for gases
12621    INTEGER(iwp) ::  num_vars  !< number of variables in netcdf input file
12622
12623!
12624!-- Skip input if no forcing from larger-scale models is applied.
12625    IF ( .NOT. nesting_offline_salsa )  RETURN
12626!
12627!-- Initialise
12628    IF ( .NOT. salsa_nest_offl%init )  THEN
12629
12630#if defined ( __netcdf )
12631!
12632!--    Open file in read-only mode
12633       CALL open_read_file( TRIM( input_file_dynamic ) // TRIM( coupling_char ),                   &
12634                            salsa_nest_offl%id_dynamic )
12635!
12636!--    At first, inquire all variable names.
12637       CALL inquire_num_variables( salsa_nest_offl%id_dynamic, num_vars )
12638!
12639!--    Allocate memory to store variable names.
12640       ALLOCATE( salsa_nest_offl%var_names(1:num_vars) )
12641       CALL inquire_variable_names( salsa_nest_offl%id_dynamic, salsa_nest_offl%var_names )
12642!
12643!--    Read time dimension, allocate memory and finally read time array
12644       CALL get_dimension_length( salsa_nest_offl%id_dynamic, salsa_nest_offl%nt,&
12645                                                    'time' )
12646
12647       IF ( check_existence( salsa_nest_offl%var_names, 'time' ) )  THEN
12648          ALLOCATE( salsa_nest_offl%time(0:salsa_nest_offl%nt-1) )
12649          CALL get_variable( salsa_nest_offl%id_dynamic, 'time', salsa_nest_offl%time )
12650       ENDIF
12651!
12652!--    Read the vertical dimension
12653       CALL get_dimension_length( salsa_nest_offl%id_dynamic,                    &
12654                                                    salsa_nest_offl%nzu, 'z' )
12655       ALLOCATE( salsa_nest_offl%zu_atmos(1:salsa_nest_offl%nzu) )
12656       CALL get_variable( salsa_nest_offl%id_dynamic, 'z', salsa_nest_offl%zu_atmos )
12657!
12658!--    Read the number of aerosol chemical components
12659       CALL get_dimension_length( salsa_nest_offl%id_dynamic,                    &
12660                                                    salsa_nest_offl%ncc, 'composition_index' )
12661!
12662!--    Read the names of aerosol chemical components
12663       CALL get_variable( salsa_nest_offl%id_dynamic, 'composition_name', salsa_nest_offl%cc_name, &
12664                          salsa_nest_offl%ncc )
12665!
12666!--    Define the index of each chemical component in the model
12667       DO  ic = 1, salsa_nest_offl%ncc
12668          SELECT CASE ( TRIM( salsa_nest_offl%cc_name(ic) ) )
12669             CASE ( 'H2SO4', 'SO4', 'h2so4', 'so4' )
12670                salsa_nest_offl%cc_in2mod(1) = ic
12671             CASE ( 'OC', 'oc' )
12672                salsa_nest_offl%cc_in2mod(2) = ic
12673             CASE ( 'BC', 'bc' )
12674                salsa_nest_offl%cc_in2mod(3) = ic
12675             CASE ( 'DU', 'du' )
12676                salsa_nest_offl%cc_in2mod(4) = ic
12677             CASE ( 'SS', 'ss' )
12678                salsa_nest_offl%cc_in2mod(5) = ic
12679             CASE ( 'HNO3', 'hno3', 'NO3', 'no3', 'NO', 'no' )
12680                salsa_nest_offl%cc_in2mod(6) = ic
12681             CASE ( 'NH3', 'nh3', 'NH4', 'nh4', 'NH', 'nh' )
12682                salsa_nest_offl%cc_in2mod(7) = ic
12683          END SELECT
12684       ENDDO
12685       IF ( SUM( salsa_nest_offl%cc_in2mod ) == 0 )  THEN
12686          message_string = 'None of the aerosol chemical components in ' //                        &
12687                           TRIM( input_file_dynamic ) // ' correspond to ones applied in SALSA.'
12688          CALL message( 'salsa_mod: salsa_nesting_offl_input',                      &
12689                        'PA0662', 2, 2, 0, 6, 0 )
12690       ENDIF
12691#endif
12692    ENDIF
12693!
12694!-- Check if dynamic driver data input is required.
12695    IF ( salsa_nest_offl%time(salsa_nest_offl%tind_p) <= MAX( time_since_reference_point, 0.0_wp)  &
12696         + time_utc_init  .OR.  .NOT.  salsa_nest_offl%init )  THEN
12697       CONTINUE
12698!
12699!-- Return otherwise
12700    ELSE
12701       RETURN
12702    ENDIF
12703!
12704!-- Obtain time index for current point in time.
12705    salsa_nest_offl%tind = MINLOC( ABS( salsa_nest_offl%time - ( time_utc_init +                   &
12706                                        MAX( time_since_reference_point, 0.0_wp) ) ), DIM = 1 ) - 1
12707    salsa_nest_offl%tind_p = salsa_nest_offl%tind + 1
12708!
12709!-- Open file in read-only mode
12710#if defined ( __netcdf )
12711
12712    CALL open_read_file( TRIM( input_file_dynamic ) // TRIM( coupling_char ),                      &
12713                         salsa_nest_offl%id_dynamic )
12714!
12715!-- Read data at the western boundary
12716    CALL get_variable( salsa_nest_offl%id_dynamic, 'ls_forcing_left_aerosol',                      &
12717                       salsa_nest_offl%nconc_left,                                                 &
12718                       MERGE( 0, 1, bc_dirichlet_l ), MERGE( nbins_aerosol-1, 0, bc_dirichlet_l ), &
12719                       MERGE( nys, 1, bc_dirichlet_l ), MERGE( nyn, 0, bc_dirichlet_l ),           &
12720                       MERGE( nzb, 1, bc_dirichlet_l ), MERGE( nzt-1, 0, bc_dirichlet_l ),         &
12721                       MERGE( salsa_nest_offl%tind,   1, bc_dirichlet_l ),                         &
12722                       MERGE( salsa_nest_offl%tind_p, 0, bc_dirichlet_l  ) )
12723    IF ( bc_dirichlet_l )  THEN
12724       salsa_nest_offl%nconc_left = MAX( nclim, salsa_nest_offl%nconc_left )
12725       CALL nesting_offl_aero_mass( salsa_nest_offl%tind, salsa_nest_offl%tind_p, nzb+1, nzt, nys, &
12726                                    nyn, 'ls_forcing_left_mass_fracs_a', 1 )
12727    ENDIF
12728    IF ( .NOT. salsa_gases_from_chem )  THEN
12729       DO  ig = 1, ngases_salsa
12730          vname = salsa_nest_offl%char_l // salsa_nest_offl%gas_name(ig)
12731          CALL get_variable( salsa_nest_offl%id_dynamic, TRIM( vname ),                            &
12732                             salsa_nest_offl%gconc_left(:,:,:,ig),                                 &
12733                             MERGE( nys, 1, bc_dirichlet_l ), MERGE( nyn, 0, bc_dirichlet_l ),     &
12734                             MERGE( nzb, 1, bc_dirichlet_l ), MERGE( nzt-1, 0, bc_dirichlet_l ),   &
12735                             MERGE( salsa_nest_offl%tind,   1, bc_dirichlet_l ),                   &
12736                             MERGE( salsa_nest_offl%tind_p, 0, bc_dirichlet_l ) )
12737          IF ( bc_dirichlet_l )  salsa_nest_offl%gconc_left(:,:,:,ig) =                            &
12738                                                  MAX( nclim, salsa_nest_offl%gconc_left(:,:,:,ig) )
12739       ENDDO
12740    ENDIF
12741!
12742!-- Read data at the eastern boundary
12743    CALL get_variable( salsa_nest_offl%id_dynamic, 'ls_forcing_right_aerosol',                     &
12744                       salsa_nest_offl%nconc_right,                                                &
12745                       MERGE( 0, 1, bc_dirichlet_r ), MERGE( nbins_aerosol-1, 0, bc_dirichlet_r ), &
12746                       MERGE( nys, 1, bc_dirichlet_r ), MERGE( nyn, 0, bc_dirichlet_r ),           &
12747                       MERGE( nzb, 1, bc_dirichlet_r ), MERGE( nzt-1, 0, bc_dirichlet_r ),         &
12748                       MERGE( salsa_nest_offl%tind,   1, bc_dirichlet_r ),                         &
12749                       MERGE( salsa_nest_offl%tind_p, 0, bc_dirichlet_r ) )
12750    IF ( bc_dirichlet_r )  THEN
12751       salsa_nest_offl%nconc_right = MAX( nclim, salsa_nest_offl%nconc_right )
12752       CALL nesting_offl_aero_mass( salsa_nest_offl%tind, salsa_nest_offl%tind_p, nzb+1, nzt, nys, &
12753                                    nyn, 'ls_forcing_right_mass_fracs_a', 2 )
12754    ENDIF
12755    IF ( .NOT. salsa_gases_from_chem )  THEN
12756       DO  ig = 1, ngases_salsa
12757          vname = salsa_nest_offl%char_r // salsa_nest_offl%gas_name(ig)
12758          CALL get_variable( salsa_nest_offl%id_dynamic, TRIM( vname ),                            &
12759                             salsa_nest_offl%gconc_right(:,:,:,ig),                                &
12760                             MERGE( nys, 1, bc_dirichlet_r ), MERGE( nyn, 0, bc_dirichlet_r ),     &
12761                             MERGE( nzb, 1, bc_dirichlet_r ), MERGE( nzt-1, 0, bc_dirichlet_r ),   &
12762                             MERGE( salsa_nest_offl%tind,   1, bc_dirichlet_r ),                   &
12763                             MERGE( salsa_nest_offl%tind_p, 0, bc_dirichlet_r ) )
12764          IF ( bc_dirichlet_r )  salsa_nest_offl%gconc_right(:,:,:,ig) =                           &
12765                                                 MAX( nclim, salsa_nest_offl%gconc_right(:,:,:,ig) )
12766       ENDDO
12767    ENDIF
12768!
12769!-- Read data at the northern boundary
12770    CALL get_variable( salsa_nest_offl%id_dynamic, 'ls_forcing_north_aerosol',                     &
12771                       salsa_nest_offl%nconc_north,                                                &
12772                       MERGE( 0, 1, bc_dirichlet_n ), MERGE( nbins_aerosol-1, 0, bc_dirichlet_n ), &
12773                       MERGE( nxl, 1, bc_dirichlet_n ), MERGE( nxr, 0, bc_dirichlet_n ),           &
12774                       MERGE( nzb, 1, bc_dirichlet_n ), MERGE( nzt-1, 0, bc_dirichlet_n ),         &
12775                       MERGE( salsa_nest_offl%tind,   1, bc_dirichlet_n ),                         &
12776                       MERGE( salsa_nest_offl%tind_p, 0, bc_dirichlet_n ) )
12777    IF ( bc_dirichlet_n )  THEN
12778       salsa_nest_offl%nconc_north = MAX( nclim, salsa_nest_offl%nconc_north )
12779       CALL nesting_offl_aero_mass( salsa_nest_offl%tind, salsa_nest_offl%tind_p, nzb+1, nzt, nxl, &
12780                                    nxr, 'ls_forcing_north_mass_fracs_a', 3 )
12781    ENDIF
12782    IF ( .NOT. salsa_gases_from_chem )  THEN
12783       DO  ig = 1, ngases_salsa
12784          vname = salsa_nest_offl%char_n // salsa_nest_offl%gas_name(ig)
12785          CALL get_variable( salsa_nest_offl%id_dynamic, TRIM( vname ),                            &
12786                             salsa_nest_offl%gconc_north(:,:,:,ig),                                &
12787                             MERGE( nxl, 1, bc_dirichlet_n ), MERGE( nxr, 0, bc_dirichlet_n ),     &
12788                             MERGE( nzb, 1, bc_dirichlet_n ), MERGE( nzt-1, 0, bc_dirichlet_n ),   &
12789                             MERGE( salsa_nest_offl%tind,   1, bc_dirichlet_n ),                   &
12790                             MERGE( salsa_nest_offl%tind_p, 0, bc_dirichlet_n ) )
12791          IF ( bc_dirichlet_n )  salsa_nest_offl%gconc_north(:,:,:,ig) =                           &
12792                                                 MAX( nclim, salsa_nest_offl%gconc_north(:,:,:,ig) )
12793       ENDDO
12794    ENDIF
12795!
12796!-- Read data at the southern boundary
12797    CALL get_variable( salsa_nest_offl%id_dynamic, 'ls_forcing_south_aerosol',                     &
12798                       salsa_nest_offl%nconc_south,                                                &
12799                       MERGE( 0, 1, bc_dirichlet_s ), MERGE( nbins_aerosol-1, 0, bc_dirichlet_s ), &
12800                       MERGE( nxl, 1, bc_dirichlet_s ), MERGE( nxr, 0, bc_dirichlet_s ),           &
12801                       MERGE( nzb, 1, bc_dirichlet_s ), MERGE( nzt-1, 0, bc_dirichlet_s ),         &
12802                       MERGE( salsa_nest_offl%tind,   1, bc_dirichlet_s ),                         &
12803                       MERGE( salsa_nest_offl%tind_p, 0, bc_dirichlet_s ) )
12804    IF ( bc_dirichlet_s )  THEN
12805       salsa_nest_offl%nconc_south = MAX( nclim, salsa_nest_offl%nconc_south )
12806       CALL nesting_offl_aero_mass( salsa_nest_offl%tind, salsa_nest_offl%tind_p, nzb+1, nzt, nxl, &
12807                                    nxr, 'ls_forcing_south_mass_fracs_a', 4 )
12808    ENDIF
12809    IF ( .NOT. salsa_gases_from_chem )  THEN
12810       DO  ig = 1, ngases_salsa
12811          vname = salsa_nest_offl%char_s // salsa_nest_offl%gas_name(ig)
12812          CALL get_variable( salsa_nest_offl%id_dynamic, TRIM( vname ),                            &
12813                             salsa_nest_offl%gconc_south(:,:,:,ig),                                &
12814                             MERGE( nxl, 1, bc_dirichlet_s ), MERGE( nxr, 0, bc_dirichlet_s ),     &
12815                             MERGE( nzb, 1, bc_dirichlet_s ), MERGE( nzt-1, 0, bc_dirichlet_s ),   &
12816                             MERGE( salsa_nest_offl%tind,   1, bc_dirichlet_s ),                   &
12817                             MERGE( salsa_nest_offl%tind_p, 0, bc_dirichlet_s ) )
12818          IF ( bc_dirichlet_s )  salsa_nest_offl%gconc_south(:,:,:,ig) =                           &
12819                                                 MAX( nclim, salsa_nest_offl%gconc_south(:,:,:,ig) )
12820       ENDDO
12821    ENDIF
12822!
12823!-- Read data at the top boundary
12824    CALL get_variable( salsa_nest_offl%id_dynamic, 'ls_forcing_top_aerosol',                       &
12825                       salsa_nest_offl%nconc_top(0:1,nys:nyn,nxl:nxr,1:nbins_aerosol),             &
12826                       0, nbins_aerosol-1, nxl, nxr, nys, nyn, salsa_nest_offl%tind,               &
12827                       salsa_nest_offl%tind_p )
12828    salsa_nest_offl%nconc_top = MAX( nclim, salsa_nest_offl%nconc_top )
12829    CALL nesting_offl_aero_mass( salsa_nest_offl%tind, salsa_nest_offl%tind_p, nys, nyn, nxl, nxr, &
12830                                 'ls_forcing_top_mass_fracs_a', 5 )
12831    IF ( .NOT. salsa_gases_from_chem )  THEN
12832       DO  ig = 1, ngases_salsa
12833          vname = salsa_nest_offl%char_t // salsa_nest_offl%gas_name(ig)
12834          CALL get_variable( salsa_nest_offl%id_dynamic, TRIM( vname ),                            &
12835                             salsa_nest_offl%gconc_top(:,:,:,ig), nxl, nxr, nys, nyn,              &
12836                             salsa_nest_offl%tind, salsa_nest_offl%tind_p )
12837          salsa_nest_offl%gconc_top(:,:,:,ig) = MAX( nclim, salsa_nest_offl%gconc_top(:,:,:,ig) )
12838       ENDDO
12839    ENDIF
12840!
12841!-- Close input file
12842    CALL close_input_file( salsa_nest_offl%id_dynamic )
12843
12844#endif
12845!
12846!-- Set control flag to indicate that initialization is already done
12847    salsa_nest_offl%init = .TRUE.
12848
12849 END SUBROUTINE salsa_nesting_offl_input
12850
12851!------------------------------------------------------------------------------!
12852! Description:
12853! ------------
12854!> Sets the mass concentrations to aerosol arrays in 2a and 2b.
12855!------------------------------------------------------------------------------!
12856 SUBROUTINE nesting_offl_aero_mass( ts, te, ks, ke, is, ie, varname_a, ibound )
12857
12858    USE netcdf_data_input_mod,                                                                     &
12859        ONLY:  get_variable
12860
12861    IMPLICIT NONE
12862
12863    CHARACTER(LEN=25) ::  varname_b  !< name for bins b
12864
12865    CHARACTER(LEN=*), INTENT(in) ::  varname_a  !< name for bins a
12866
12867    INTEGER(iwp) ::  ee                !< loop index: end
12868    INTEGER(iwp) ::  i                 !< loop index
12869    INTEGER(iwp) ::  ib                !< loop index
12870    INTEGER(iwp) ::  ic                !< loop index
12871    INTEGER(iwp) ::  k                 !< loop index
12872    INTEGER(iwp) ::  ss                !< loop index: start
12873    INTEGER(iwp) ::  t                 !< loop index
12874    INTEGER(iwp) ::  type_so4_oc = -1  !<
12875
12876    INTEGER(iwp), INTENT(in) ::  ibound  !< index: 1=left, 2=right, 3=north, 4=south, 5=top
12877    INTEGER(iwp), INTENT(in) ::  ie      !< loop index
12878    INTEGER(iwp), INTENT(in) ::  is      !< loop index
12879    INTEGER(iwp), INTENT(in) ::  ks      !< loop index
12880    INTEGER(iwp), INTENT(in) ::  ke      !< loop index
12881    INTEGER(iwp), INTENT(in) ::  ts      !< loop index
12882    INTEGER(iwp), INTENT(in) ::  te      !< loop index
12883
12884    INTEGER(iwp), DIMENSION(maxspec) ::  cc_i2m   !<
12885
12886    REAL(wp) ::  pmf1a !< mass fraction in 1a
12887
12888    REAL(wp), DIMENSION(nbins_aerosol) ::  core   !< size of the bin mid aerosol particle
12889
12890    REAL(wp), DIMENSION(0:1,ks:ke,is:ie,1:nbins_aerosol) ::  to_nconc                   !<
12891    REAL(wp), DIMENSION(0:1,ks:ke,is:ie,1:nbins_aerosol*ncomponents_mass) ::  to_mconc  !<
12892
12893    REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE ::  mf2a !< Mass distributions for a
12894    REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE ::  mf2b !< and b bins
12895
12896!
12897!-- Variable name for insoluble mass fraction
12898    varname_b = varname_a(1:LEN( TRIM( varname_a ) ) - 1 ) // 'b'
12899!
12900!-- Bin mean aerosol particle volume (m3)
12901    core(1:nbins_aerosol) = api6 * aero(1:nbins_aerosol)%dmid**3
12902!
12903!-- Allocate and read mass fraction arrays
12904    ALLOCATE( mf2a(0:1,ks:ke,is:ie,1:salsa_nest_offl%ncc),                                         &
12905              mf2b(0:1,ks:ke,is:ie,1:salsa_nest_offl%ncc) )
12906    IF ( ibound == 5 )  THEN
12907       CALL get_variable( salsa_nest_offl%id_dynamic, varname_a,                                   &
12908                          mf2a(0:1,ks:ke,is:ie,1:salsa_nest_offl%ncc), 0, salsa_nest_offl%ncc-1,   &
12909                          is, ie, ks, ke, ts, te )
12910    ELSE
12911       CALL get_variable( salsa_nest_offl%id_dynamic, varname_a,                                   &
12912                          mf2a(0:1,ks:ke,is:ie,1:salsa_nest_offl%ncc), 0, salsa_nest_offl%ncc-1,   &
12913                          is, ie, ks-1, ke-1, ts, te )
12914    ENDIF
12915!
12916!-- If the chemical component is not activated, set its mass fraction to 0 to avoid mass inbalance
12917    cc_i2m = salsa_nest_offl%cc_in2mod
12918    IF ( index_so4 < 0  .AND. cc_i2m(1) > 0 )  mf2a(:,:,:,cc_i2m(1)) = 0.0_wp
12919    IF ( index_oc < 0   .AND. cc_i2m(2) > 0 )  mf2a(:,:,:,cc_i2m(2)) = 0.0_wp
12920    IF ( index_bc < 0   .AND. cc_i2m(3) > 0 )  mf2a(:,:,:,cc_i2m(3)) = 0.0_wp
12921    IF ( index_du < 0   .AND. cc_i2m(4) > 0 )  mf2a(:,:,:,cc_i2m(4)) = 0.0_wp
12922    IF ( index_ss < 0   .AND. cc_i2m(5) > 0 )  mf2a(:,:,:,cc_i2m(5)) = 0.0_wp
12923    IF ( index_no < 0   .AND. cc_i2m(6) > 0 )  mf2a(:,:,:,cc_i2m(6)) = 0.0_wp
12924    IF ( index_nh < 0   .AND. cc_i2m(7) > 0 )  mf2a(:,:,:,cc_i2m(7)) = 0.0_wp
12925    mf2b = 0.0_wp
12926!
12927!-- Initialise variable type_so4_oc to indicate whether SO4 and/OC is included in mass fraction data
12928    IF ( ( cc_i2m(1) > 0  .AND.  index_so4 > 0 )  .AND. ( cc_i2m(2) > 0  .AND.  index_oc > 0 ) )   &
12929    THEN
12930       type_so4_oc = 1
12931    ELSEIF ( cc_i2m(1) > 0  .AND.  index_so4 > 0 )  THEN
12932       type_so4_oc = 2
12933    ELSEIF ( cc_i2m(2) > 0  .AND.  index_oc > 0 )  THEN
12934       type_so4_oc = 3
12935    ENDIF
12936
12937    SELECT CASE ( ibound )
12938       CASE( 1 )
12939          to_nconc = salsa_nest_offl%nconc_left
12940          to_mconc = salsa_nest_offl%mconc_left
12941       CASE( 2 )
12942          to_nconc = salsa_nest_offl%nconc_right
12943          to_mconc = salsa_nest_offl%mconc_right
12944       CASE( 3 )
12945          to_nconc = salsa_nest_offl%nconc_north
12946          to_mconc = salsa_nest_offl%mconc_north
12947       CASE( 4 )
12948          to_nconc = salsa_nest_offl%nconc_south
12949          to_mconc = salsa_nest_offl%mconc_south
12950       CASE( 5 )
12951          to_nconc = salsa_nest_offl%nconc_top
12952          to_mconc = salsa_nest_offl%mconc_top
12953    END SELECT
12954!
12955!-- Set mass concentrations:
12956!
12957!-- Regime 1:
12958    SELECT CASE ( type_so4_oc )
12959       CASE ( 1 )  ! Both SO4 and OC given
12960
12961          ss = ( index_so4 - 1 ) * nbins_aerosol + start_subrange_1a  ! start
12962          ee = ( index_so4 - 1 ) * nbins_aerosol + end_subrange_1a    ! end
12963          ib = start_subrange_1a
12964          DO  ic = ss, ee
12965             DO i = is, ie
12966                DO k = ks, ke
12967                   DO t = 0, 1
12968                      pmf1a = mf2a(t,k,i,cc_i2m(1)) / ( mf2a(t,k,i,cc_i2m(1)) + mf2a(t,k,i,cc_i2m(2)) )
12969                      to_mconc(t,k,i,ic) = pmf1a * to_nconc(t,k,i,ib) * core(ib) * arhoh2so4
12970                   ENDDO
12971                ENDDO
12972             ENDDO
12973             ib = ib + 1
12974          ENDDO
12975          ss = ( index_oc - 1 ) * nbins_aerosol + start_subrange_1a ! start
12976          ee = ( index_oc - 1 ) * nbins_aerosol + end_subrange_1a   ! end
12977          ib = start_subrange_1a
12978          DO  ic = ss, ee
12979             DO i = is, ie
12980                DO k = ks, ke
12981                   DO t = 0, 1
12982                      pmf1a = mf2a(t,k,i,cc_i2m(2)) / ( mf2a(t,k,i,cc_i2m(1)) + mf2a(t,k,i,cc_i2m(2)) )
12983                      to_mconc(t,k,i,ic) = pmf1a * to_nconc(t,k,i,ib) * core(ib) * arhooc
12984                   ENDDO
12985                ENDDO
12986             ENDDO
12987             ib = ib + 1
12988          ENDDO
12989       CASE ( 2 )  ! Only SO4
12990          ss = ( index_so4 - 1 ) * nbins_aerosol + start_subrange_1a  ! start
12991          ee = ( index_so4 - 1 ) * nbins_aerosol + end_subrange_1a    ! end
12992          ib = start_subrange_1a
12993          DO  ic = ss, ee
12994             DO i = is, ie
12995                DO k = ks, ke
12996                   DO t = 0, 1
12997                      to_mconc(t,k,i,ic) = to_nconc(t,k,i,ib) * core(ib) * arhoh2so4
12998                   ENDDO
12999                ENDDO
13000             ENDDO
13001             ib = ib + 1
13002          ENDDO
13003       CASE ( 3 )  ! Only OC
13004          ss = ( index_oc - 1 ) * nbins_aerosol + start_subrange_1a ! start
13005          ee = ( index_oc - 1 ) * nbins_aerosol + end_subrange_1a   ! end
13006          ib = start_subrange_1a
13007          DO  ic = ss, ee
13008             DO i = is, ie
13009                DO k = ks, ke
13010                   DO t = 0, 1
13011                      to_mconc(t,k,i,ic) = to_nconc(t,k,i,ib) * core(ib) * arhooc
13012                   ENDDO
13013                ENDDO
13014             ENDDO
13015             ib = ib + 1
13016          ENDDO
13017    END SELECT
13018!
13019!-- Regimes 2a and 2b:
13020    IF ( index_so4 > 0 ) THEN
13021       CALL set_nest_mass( index_so4, 1, arhoh2so4 )
13022    ENDIF
13023    IF ( index_oc > 0 ) THEN
13024       CALL set_nest_mass( index_oc, 2, arhooc )
13025    ENDIF
13026    IF ( index_bc > 0 ) THEN
13027       CALL set_nest_mass( index_bc, 3, arhobc )
13028    ENDIF
13029    IF ( index_du > 0 ) THEN
13030       CALL set_nest_mass( index_du, 4, arhodu )
13031    ENDIF
13032    IF ( index_ss > 0 ) THEN
13033       CALL set_nest_mass( index_ss, 5, arhoss )
13034    ENDIF
13035    IF ( index_no > 0 ) THEN
13036       CALL set_nest_mass( index_no, 6, arhohno3 )
13037    ENDIF
13038    IF ( index_nh > 0 ) THEN
13039       CALL set_nest_mass( index_nh, 7, arhonh3 )
13040    ENDIF
13041
13042    DEALLOCATE( mf2a, mf2b )
13043
13044    SELECT CASE ( ibound )
13045       CASE( 1 )
13046          salsa_nest_offl%mconc_left = to_mconc
13047       CASE( 2 )
13048          salsa_nest_offl%mconc_right = to_mconc
13049       CASE( 3 )
13050          salsa_nest_offl%mconc_north = to_mconc
13051       CASE( 4 )
13052          salsa_nest_offl%mconc_south = to_mconc
13053       CASE( 5 )
13054          salsa_nest_offl%mconc_top = to_mconc
13055    END SELECT
13056
13057    CONTAINS
13058
13059!------------------------------------------------------------------------------!
13060! Description:
13061! ------------
13062!> Set nesting boundaries for aerosol mass.
13063!------------------------------------------------------------------------------!
13064    SUBROUTINE set_nest_mass( ispec, ispec_def, prho )
13065
13066       IMPLICIT NONE
13067
13068       INTEGER(iwp) ::  ic   !< chemical component index: default
13069       INTEGER(iwp) ::  icc  !< loop index: mass bin
13070
13071       INTEGER(iwp), INTENT(in) ::  ispec      !< aerosol species index
13072       INTEGER(iwp), INTENT(in) ::  ispec_def  !< default aerosol species index
13073
13074       REAL(wp), INTENT(in) ::  prho !< aerosol density
13075!
13076!--    Define the index of the chemical component in the input data
13077       ic = salsa_nest_offl%cc_in2mod(ispec_def)
13078
13079       DO i = is, ie
13080          DO k = ks, ke
13081             DO t = 0, 1
13082!
13083!--             Regime 2a:
13084                ss = ( ispec - 1 ) * nbins_aerosol + start_subrange_2a
13085                ee = ( ispec - 1 ) * nbins_aerosol + end_subrange_2a
13086                ib = start_subrange_2a
13087                DO icc = ss, ee
13088                   to_mconc(t,k,i,icc) = MAX( 0.0_wp, mf2a(t,k,i,ic) / SUM( mf2a(t,k,i,:) ) ) *    &
13089                                         to_nconc(t,k,i,ib) * core(ib) * prho
13090                   ib = ib + 1
13091                ENDDO
13092!
13093!--             Regime 2b:
13094                IF ( .NOT. no_insoluble )  THEN
13095!
13096!--                 TODO!
13097                    mf2b(t,k,i,ic) = mf2b(t,k,i,ic)
13098                ENDIF
13099             ENDDO   ! k
13100
13101          ENDDO   ! j
13102       ENDDO   ! i
13103
13104    END SUBROUTINE set_nest_mass
13105
13106 END SUBROUTINE nesting_offl_aero_mass
13107
13108
13109 END MODULE salsa_mod
Note: See TracBrowser for help on using the repository browser.