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

Last change on this file since 3483 was 3483, checked in by raasch, 6 years ago

bugfix: misplaced positions of cpp-directives for netCDF and MPI fixed; output format limited to a maximum line length of 80

  • Property svn:keywords set to Id
File size: 510.0 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 1997-2018 Leibniz Universitaet Hannover
18!--------------------------------------------------------------------------------!
19!
20! Current revisions:
21! -----------------
22!
23!
24! Former revisions:
25! -----------------
26! $Id: salsa_mod.f90 3483 2018-11-02 14:19:26Z raasch $
27! bugfix: directives added to allow compilation without netCDF
28!
29! 3481 2018-11-02 09:14:13Z raasch
30! temporary variable cc introduced to circumvent a possible Intel18 compiler bug
31! related to contiguous/non-contguous pointer/target attributes
32!
33! 3473 2018-10-30 20:50:15Z suehring
34! NetCDF input routine renamed
35!
36! 3467 2018-10-30 19:05:21Z suehring
37! Initial revision
38!
39! 3412 2018-10-24 07:25:57Z monakurppa
40!
41! Authors:
42! --------
43! @author monakurppa
44!
45!
46! Description:
47! ------------
48!> Sectional aerosol module for large scale applications SALSA
49!> (Kokkola et al., 2008, ACP 8, 2469-2483). Solves the aerosol number and mass
50!> concentration as well as chemical composition. Includes aerosol dynamic
51!> processes: nucleation, condensation/evaporation of vapours, coagulation and
52!> deposition on tree leaves, ground and roofs.
53!> Implementation is based on formulations implemented in UCLALES-SALSA except
54!> for deposition which is based on parametrisations by Zhang et al. (2001,
55!> Atmos. Environ. 35, 549-560) or Petroff&Zhang (2010, Geosci. Model Dev. 3,
56!> 753-769)
57!>
58!> @todo Implement turbulent inflow of aerosols in inflow_turbulence.
59!> @todo Deposition on walls and horizontal surfaces calculated from the aerosol
60!>       dry radius, not wet
61!> @todo Deposition on subgrid scale vegetation
62!> @todo Deposition on vegetation calculated by default for deciduous broadleaf
63!>       trees
64!> @todo Revise masked data output. There is a potential bug in case of
65!>       terrain-following masked output, according to data_output_mask.
66!> @todo There are now improved interfaces for NetCDF data input which can be
67!>       used instead of get variable etc.
68!------------------------------------------------------------------------------!
69 MODULE salsa_mod
70
71    USE basic_constants_and_equations_mod,                                     &
72        ONLY:  c_p, g, p_0, pi, r_d
73 
74    USE chemistry_model_mod,                                                   &
75        ONLY:  chem_species, nspec, nvar, spc_names
76
77    USE chem_modules,                                                          &
78        ONLY:  call_chem_at_all_substeps, chem_gasphase_on
79
80    USE control_parameters
81       
82    USE indices,                                                               &
83        ONLY:  nbgp, nx, nxl, nxlg, nxr, nxrg, ny, nyn, nyng, nys, nysg, nzb,  &
84               nzb_s_inner, nz, nzt, wall_flags_0
85     
86    USE kinds
87   
88    USE pegrid
89   
90    USE salsa_util_mod
91
92    IMPLICIT NONE
93!
94!-- SALSA constants:
95!
96!-- Local constants:
97    INTEGER(iwp), PARAMETER ::  ngast   = 5 !< total number of gaseous tracers:
98                                            !< 1 = H2SO4, 2 = HNO3, 3 = NH3,
99                                            !< 4 = OCNV (non-volatile OC),
100                                            !< 5 = OCSV (semi-volatile) 
101    INTEGER(iwp), PARAMETER ::  nmod    = 7 !< number of modes for initialising
102                                            !< the aerosol size distribution                                             
103    INTEGER(iwp), PARAMETER ::  nreg    = 2 !< Number of main size subranges
104    INTEGER(iwp), PARAMETER ::  maxspec = 7 !< Max. number of aerosol species
105!   
106!-- Universal constants
107    REAL(wp), PARAMETER ::  abo    = 1.380662E-23_wp  !< Boltzmann constant (J/K)
108    REAL(wp), PARAMETER ::  alv    = 2.260E+6_wp      !< latent heat for H2O
109                                                      !< vaporisation (J/kg)
110    REAL(wp), PARAMETER ::  alv_d_rv  = 4896.96865_wp !< alv / rv
111    REAL(wp), PARAMETER ::  am_airmol = 4.8096E-26_wp !< Average mass of one air
112                                                      !< molecule (Jacobson,
113                                                      !< 2005, Eq. 2.3)                                                   
114    REAL(wp), PARAMETER ::  api6   = 0.5235988_wp     !< pi / 6   
115    REAL(wp), PARAMETER ::  argas  = 8.314409_wp      !< Gas constant (J/(mol K))
116    REAL(wp), PARAMETER ::  argas_d_cpd = 8.281283865E-3_wp !< argas per cpd
117    REAL(wp), PARAMETER ::  avo    = 6.02214E+23_wp   !< Avogadro constant (1/mol)
118    REAL(wp), PARAMETER ::  d_sa   = 5.539376964394570E-10_wp !< diameter of
119                                                      !< condensing sulphuric
120                                                      !< acid molecule (m) 
121    REAL(wp), PARAMETER ::  for_ppm_to_nconc =  7.243016311E+16_wp !<
122                                                 !< ppm * avo / R (K/(Pa*m3))
123    REAL(wp), PARAMETER ::  epsoc  = 0.15_wp          !< water uptake of organic
124                                                      !< material     
125    REAL(wp), PARAMETER ::  mclim  = 1.0E-23_wp    !< mass concentration min
126                                                   !< limit for aerosols (kg/m3)                                                   
127    REAL(wp), PARAMETER ::  n3     = 158.79_wp !< Number of H2SO4 molecules in
128                                               !< 3 nm cluster if d_sa=5.54e-10m
129    REAL(wp), PARAMETER ::  nclim  = 1.0_wp    !< number concentration min limit
130                                               !< for aerosols and gases (#/m3)
131    REAL(wp), PARAMETER ::  surfw0 = 0.073_wp  !< surface tension of pure water
132                                               !< at ~ 293 K (J/m2)   
133    REAL(wp), PARAMETER ::  vclim  = 1.0E-24_wp    !< volume concentration min
134                                                   !< limit for aerosols (m3/m3)                                           
135!-- Molar masses in kg/mol
136    REAL(wp), PARAMETER ::  ambc   = 12.0E-3_wp     !< black carbon (BC)
137    REAL(wp), PARAMETER ::  amdair = 28.970E-3_wp   !< dry air
138    REAL(wp), PARAMETER ::  amdu   = 100.E-3_wp     !< mineral dust
139    REAL(wp), PARAMETER ::  amh2o  = 18.0154E-3_wp  !< H2O
140    REAL(wp), PARAMETER ::  amh2so4  = 98.06E-3_wp  !< H2SO4
141    REAL(wp), PARAMETER ::  amhno3 = 63.01E-3_wp    !< HNO3
142    REAL(wp), PARAMETER ::  amn2o  = 44.013E-3_wp   !< N2O
143    REAL(wp), PARAMETER ::  amnh3  = 17.031E-3_wp   !< NH3
144    REAL(wp), PARAMETER ::  amo2   = 31.9988E-3_wp  !< O2
145    REAL(wp), PARAMETER ::  amo3   = 47.998E-3_wp   !< O3
146    REAL(wp), PARAMETER ::  amoc   = 150.E-3_wp     !< organic carbon (OC)
147    REAL(wp), PARAMETER ::  amss   = 58.44E-3_wp    !< sea salt (NaCl)
148!-- Densities in kg/m3
149    REAL(wp), PARAMETER ::  arhobc     = 2000.0_wp !< black carbon
150    REAL(wp), PARAMETER ::  arhodu     = 2650.0_wp !< mineral dust
151    REAL(wp), PARAMETER ::  arhoh2o    = 1000.0_wp !< H2O
152    REAL(wp), PARAMETER ::  arhoh2so4  = 1830.0_wp !< SO4
153    REAL(wp), PARAMETER ::  arhohno3   = 1479.0_wp !< HNO3
154    REAL(wp), PARAMETER ::  arhonh3    = 1530.0_wp !< NH3
155    REAL(wp), PARAMETER ::  arhooc     = 2000.0_wp !< organic carbon
156    REAL(wp), PARAMETER ::  arhoss     = 2165.0_wp !< sea salt (NaCl)
157!-- Volume of molecule in m3/#
158    REAL(wp), PARAMETER ::  amvh2o   = amh2o /avo / arhoh2o      !< H2O
159    REAL(wp), PARAMETER ::  amvh2so4 = amh2so4 / avo / arhoh2so4 !< SO4
160    REAL(wp), PARAMETER ::  amvhno3  = amhno3 / avo / arhohno3   !< HNO3
161    REAL(wp), PARAMETER ::  amvnh3   = amnh3 / avo / arhonh3     !< NH3 
162    REAL(wp), PARAMETER ::  amvoc    = amoc / avo / arhooc       !< OC
163    REAL(wp), PARAMETER ::  amvss    = amss / avo / arhoss       !< sea salt
164   
165!
166!-- SALSA switches:
167    INTEGER(iwp) ::  nj3 = 1 !< J3 parametrization (nucleation)
168                             !< 1 = condensational sink (Kerminen&Kulmala, 2002)
169                             !< 2 = coagulational sink (Lehtinen et al. 2007)
170                             !< 3 = coagS+self-coagulation (Anttila et al. 2010)                                       
171    INTEGER(iwp) ::  nsnucl = 0 !< Choice of the nucleation scheme:
172                                !< 0 = off   
173                                !< 1 = binary nucleation
174                                !< 2 = activation type nucleation
175                                !< 3 = kinetic nucleation
176                                !< 4 = ternary nucleation
177                                !< 5 = nucleation with ORGANICs
178                                !< 6 = activation type of nucleation with
179                                !<     H2SO4+ORG
180                                !< 7 = heteromolecular nucleation with H2SO4*ORG
181                                !< 8 = homomolecular nucleation of  H2SO4 +
182                                !<     heteromolecular nucleation with H2SO4*ORG
183                                !< 9 = homomolecular nucleation of  H2SO4 and ORG
184                                !<     +heteromolecular nucleation with H2SO4*ORG
185    LOGICAL ::  advect_particle_water = .TRUE.  !< advect water concentration of
186                                                !< particles                               
187    LOGICAL ::  decycle_lr            = .FALSE. !< Undo cyclic boundary
188                                                !< conditions: left and right
189    LOGICAL ::  decycle_ns            = .FALSE. !< north and south boundaries
190    LOGICAL ::  feedback_to_palm      = .FALSE. !< allow feedback due to
191                                                !< hydration and/or condensation
192                                                !< of H20
193    LOGICAL ::  no_insoluble          = .FALSE. !< Switch to exclude insoluble 
194                                                !< chemical components
195    LOGICAL ::  read_restart_data_salsa = .FALSE. !< read restart data for salsa
196    LOGICAL ::  salsa                 = .FALSE.   !< SALSA master switch
197    LOGICAL ::  salsa_gases_from_chem = .FALSE.   !< Transfer the gaseous
198                                                  !< components to SALSA from 
199                                                  !< from chemistry model
200    LOGICAL ::  van_der_waals_coagc   = .FALSE.   !< Enhancement of coagulation
201                                                  !< kernel by van der Waals and
202                                                  !< viscous forces
203    LOGICAL ::  write_binary_salsa    = .FALSE.   !< read binary for salsa
204!-- Process switches: nl* is read from the NAMELIST and is NOT changed.
205!--                   ls* is the switch used and will get the value of nl*
206!--                       except for special circumstances (spinup period etc.)
207    LOGICAL ::  nlcoag       = .FALSE. !< Coagulation master switch
208    LOGICAL ::  lscoag       = .FALSE. !<
209    LOGICAL ::  nlcnd        = .FALSE. !< Condensation master switch
210    LOGICAL ::  lscnd        = .FALSE. !<
211    LOGICAL ::  nlcndgas     = .FALSE. !< Condensation of precursor gases
212    LOGICAL ::  lscndgas     = .FALSE. !<
213    LOGICAL ::  nlcndh2oae   = .FALSE. !< Condensation of H2O on aerosol
214    LOGICAL ::  lscndh2oae   = .FALSE. !< particles (FALSE -> equilibrium calc.)
215    LOGICAL ::  nldepo       = .FALSE. !< Deposition master switch
216    LOGICAL ::  lsdepo       = .FALSE. !<
217    LOGICAL ::  nldepo_topo  = .FALSE. !< Deposition on vegetation master switch
218    LOGICAL ::  lsdepo_topo  = .FALSE. !<
219    LOGICAL ::  nldepo_vege  = .FALSE. !< Deposition on walls master switch
220    LOGICAL ::  lsdepo_vege  = .FALSE. !<
221    LOGICAL ::  nldistupdate = .TRUE.  !< Size distribution update master switch                                     
222    LOGICAL ::  lsdistupdate = .FALSE. !<                                     
223!
224!-- SALSA variables:
225    CHARACTER (LEN=20) ::  bc_salsa_b = 'neumann'   !< bottom boundary condition                                     
226    CHARACTER (LEN=20) ::  bc_salsa_t = 'neumann'   !< top boundary condition
227    CHARACTER (LEN=20) ::  depo_vege_type = 'zhang2001' !< or 'petroff2010'
228    CHARACTER (LEN=20) ::  depo_topo_type = 'zhang2001' !< or 'petroff2010'
229    CHARACTER (LEN=20), DIMENSION(4) ::  decycle_method = & 
230                             (/'dirichlet','dirichlet','dirichlet','dirichlet'/)
231                                 !< Decycling method at horizontal boundaries,
232                                 !< 1=left, 2=right, 3=south, 4=north
233                                 !< dirichlet = initial size distribution and
234                                 !< chemical composition set for the ghost and
235                                 !< first three layers
236                                 !< neumann = zero gradient
237    CHARACTER (LEN=3), DIMENSION(maxspec) ::  listspec = &  !< Active aerosols
238                                   (/'SO4','   ','   ','   ','   ','   ','   '/)
239    CHARACTER (LEN=20) ::  salsa_source_mode = 'no_source' 
240                                                    !< 'read_from_file',
241                                                    !< 'constant' or 'no_source'                                   
242    INTEGER(iwp) ::  dots_salsa = 0  !< starting index for salsa-timeseries
243    INTEGER(iwp) ::  fn1a = 1    !< last index for bin subranges:  subrange 1a
244    INTEGER(iwp) ::  fn2a = 1    !<                              subrange 2a
245    INTEGER(iwp) ::  fn2b = 1    !<                              subrange 2b
246    INTEGER(iwp), DIMENSION(ngast) ::  gas_index_chem = (/ 1, 1, 1, 1, 1/) !<
247                                 !< Index of gaseous compounds in the chemistry
248                                 !< model. In SALSA, 1 = H2SO4, 2 = HNO3,
249                                 !< 3 = NH3, 4 = OCNV, 5 = OCSV
250    INTEGER(iwp) ::  ibc_salsa_b !<
251    INTEGER(iwp) ::  ibc_salsa_t !<
252    INTEGER(iwp) ::  igctyp = 0  !< Initial gas concentration type
253                                 !< 0 = uniform (use H2SO4_init, HNO3_init,
254                                 !<     NH3_init, OCNV_init and OCSV_init)
255                                 !< 1 = read vertical profile from an input file 
256    INTEGER(iwp) ::  in1a = 1    !< start index for bin subranges: subrange 1a
257    INTEGER(iwp) ::  in2a = 1    !<                              subrange 2a
258    INTEGER(iwp) ::  in2b = 1    !<                              subrange 2b
259    INTEGER(iwp) ::  isdtyp = 0  !< Initial size distribution type
260                                 !< 0 = uniform
261                                 !< 1 = read vertical profile of the mode number
262                                 !<     concentration from an input file 
263    INTEGER(iwp) ::  ibc  = -1 !< Indice for: black carbon (BC)
264    INTEGER(iwp) ::  idu  = -1 !< dust
265    INTEGER(iwp) ::  inh  = -1 !< NH3
266    INTEGER(iwp) ::  ino  = -1 !< HNO3   
267    INTEGER(iwp) ::  ioc  = -1 !< organic carbon (OC)
268    INTEGER(iwp) ::  iso4 = -1 !< SO4 or H2SO4   
269    INTEGER(iwp) ::  iss  = -1 !< sea salt
270    INTEGER(iwp) ::  lod_aero = 0   !< level of detail for aerosol emissions
271    INTEGER(iwp) ::  lod_gases = 0  !< level of detail for gaseous emissions   
272    INTEGER(iwp), DIMENSION(nreg) ::  nbin = (/ 3, 7/)    !< Number of size bins
273                                               !< for each aerosol size subrange
274    INTEGER(iwp) ::  nbins = 1  !< total number of size bins
275    INTEGER(iwp) ::  ncc   = 1  !< number of chemical components used     
276    INTEGER(iwp) ::  ncc_tot = 1!< total number of chemical compounds (ncc+1
277                                !< if particle water is advected)
278    REAL(wp) ::  act_coeff = 1.0E-7_wp     !< Activation coefficient
279    REAL(wp) ::  aerosol_source = 0.0_wp   !< Constant aerosol flux (#/(m3*s))
280    REAL(wp), ALLOCATABLE, DIMENSION(:,:) ::  emission_mass_fracs  !< array for
281                                    !< aerosol composition per emission category
282                                    !< 1:SO4 2:OC 3:BC 4:DU 5:SS 6:NO 7:NH 
283    REAL(wp) ::  dt_salsa  = 0.00001_wp    !< Time step of SALSA
284    REAL(wp) ::  H2SO4_init = nclim        !< Init value for sulphuric acid gas
285    REAL(wp) ::  HNO3_init  = nclim        !< Init value for nitric acid gas
286    REAL(wp) ::  last_salsa_time = 0.0_wp  !< time of the previous salsa
287                                           !< timestep
288    REAL(wp) ::  nf2a = 1.0_wp             !< Number fraction allocated to a-
289                                           !< bins in subrange 2
290                                           !< (b-bins will get 1-nf2a)   
291    REAL(wp) ::  NH3_init  = nclim         !< Init value for ammonia gas
292    REAL(wp) ::  OCNV_init = nclim         !< Init value for non-volatile
293                                           !< organic gases
294    REAL(wp) ::  OCSV_init = nclim         !< Init value for semi-volatile
295                                           !< organic gases
296    REAL(wp), DIMENSION(nreg+1) ::  reglim = & !< Min&max diameters of size subranges
297                                 (/ 3.0E-9_wp, 5.0E-8_wp, 1.0E-5_wp/)
298    REAL(wp) ::  rhlim = 1.20_wp    !< RH limit in %/100. Prevents
299                                    !< unrealistically high RH in condensation                           
300    REAL(wp) ::  skip_time_do_salsa = 0.0_wp !< Starting time of SALSA (s)
301!-- Initial log-normal size distribution: mode diameter (dpg, micrometres),
302!-- standard deviation (sigmag) and concentration (n_lognorm, #/cm3)
303    REAL(wp), DIMENSION(nmod) ::  dpg   = (/0.013_wp, 0.054_wp, 0.86_wp,       &
304                                            0.2_wp, 0.2_wp, 0.2_wp, 0.2_wp/) 
305    REAL(wp), DIMENSION(nmod) ::  sigmag  = (/1.8_wp, 2.16_wp, 2.21_wp,        &
306                                              2.0_wp, 2.0_wp, 2.0_wp, 2.0_wp/) 
307    REAL(wp), DIMENSION(nmod) ::  n_lognorm = (/1.04e+5_wp, 3.23E+4_wp, 5.4_wp,&
308                                                0.0_wp, 0.0_wp, 0.0_wp, 0.0_wp/)
309!-- Initial mass fractions / chemical composition of the size distribution   
310    REAL(wp), DIMENSION(maxspec) ::  mass_fracs_a = & !< mass fractions between
311             (/1.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0/) !< aerosol species for A bins
312    REAL(wp), DIMENSION(maxspec) ::  mass_fracs_b = & !< mass fractions between
313             (/0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0/) !< aerosol species for B bins
314             
315    REAL(wp), ALLOCATABLE, DIMENSION(:) ::  bin_low_limits  !< to deliver
316                                                            !< information about
317                                                            !< the lower
318                                                            !< diameters per bin                                       
319    REAL(wp), ALLOCATABLE, DIMENSION(:) ::  nsect     !< Background number
320                                                      !< concentration per bin
321    REAL(wp), ALLOCATABLE, DIMENSION(:) ::  massacc   !< Mass accomodation
322                                                      !< coefficients per bin                                             
323!
324!-- SALSA derived datatypes:
325!
326!-- Prognostic variable: Aerosol size bin information (number (#/m3) and
327!-- mass (kg/m3) concentration) and the concentration of gaseous tracers (#/m3).
328!-- Gas tracers are contained sequentially in dimension 4 as:
329!-- 1. H2SO4, 2. HNO3, 3. NH3, 4. OCNV (non-volatile organics),
330!-- 5. OCSV (semi-volatile)
331    TYPE salsa_variable
332       REAL(wp), POINTER, DIMENSION(:,:,:), CONTIGUOUS     ::  conc
333       REAL(wp), POINTER, DIMENSION(:,:,:), CONTIGUOUS     ::  conc_p
334       REAL(wp), POINTER, DIMENSION(:,:,:), CONTIGUOUS     ::  tconc_m
335       REAL(wp), ALLOCATABLE, DIMENSION(:,:)   ::  flux_s, diss_s
336       REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) ::  flux_l, diss_l
337       REAL(wp), ALLOCATABLE, DIMENSION(:)     ::  init
338       REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) ::  source
339       REAL(wp), ALLOCATABLE, DIMENSION(:,:)   ::  sums_ws_l
340    END TYPE salsa_variable
341   
342!-- Map bin indices between parallel size distributions   
343    TYPE t_parallelbin
344       INTEGER(iwp) ::  cur  ! Index for current distribution
345       INTEGER(iwp) ::  par  ! Index for corresponding parallel distribution
346    END TYPE t_parallelbin
347   
348!-- Datatype used to store information about the binned size distributions of
349!-- aerosols
350    TYPE t_section
351       REAL(wp) ::  vhilim   !< bin volume at the high limit
352       REAL(wp) ::  vlolim   !< bin volume at the low limit
353       REAL(wp) ::  vratiohi !< volume ratio between the center and high limit
354       REAL(wp) ::  vratiolo !< volume ratio between the center and low limit
355       REAL(wp) ::  dmid     !< bin middle diameter (m)
356       !******************************************************
357       ! ^ Do NOT change the stuff above after initialization !
358       !******************************************************
359       REAL(wp) ::  dwet    !< Wet diameter or mean droplet diameter (m)
360       REAL(wp), DIMENSION(maxspec+1) ::  volc !< Volume concentrations
361                            !< (m^3/m^3) of aerosols + water. Since most of
362                            !< the stuff in SALSA is hard coded, these *have to
363                            !< be* in the order
364                            !< 1:SO4, 2:OC, 3:BC, 4:DU, 5:SS, 6:NO, 7:NH, 8:H2O
365       REAL(wp) ::  veqh2o  !< Equilibrium H2O concentration for each particle
366       REAL(wp) ::  numc    !< Number concentration of particles/droplets (#/m3)
367       REAL(wp) ::  core    !< Volume of dry particle
368    END TYPE t_section 
369!
370!-- Local aerosol properties in SALSA
371    TYPE(t_section), ALLOCATABLE ::  aero(:)
372!
373!-- SALSA tracers:
374!-- Tracers as x = x(k,j,i,bin). The 4th dimension contains all the size bins
375!-- sequentially for each aerosol species  + water.
376!
377!-- Prognostic tracers:
378!
379!-- Number concentration (#/m3)
380    TYPE(salsa_variable), ALLOCATABLE, DIMENSION(:), TARGET ::  aerosol_number
381    REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:), TARGET ::  nconc_1
382    REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:), TARGET ::  nconc_2
383    REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:), TARGET ::  nconc_3
384!
385!-- Mass concentration (kg/m3)
386    TYPE(salsa_variable), ALLOCATABLE, DIMENSION(:), TARGET ::  aerosol_mass
387    REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:), TARGET ::  mconc_1
388    REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:), TARGET ::  mconc_2
389    REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:), TARGET ::  mconc_3
390!
391!-- Gaseous tracers (#/m3)
392    TYPE(salsa_variable), ALLOCATABLE, DIMENSION(:), TARGET ::  salsa_gas
393    REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:), TARGET ::  gconc_1
394    REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:), TARGET ::  gconc_2
395    REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:), TARGET ::  gconc_3
396!
397!-- Diagnostic tracers
398    REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:) ::  sedim_vd !< sedimentation
399                                                           !< velocity per size
400                                                           !< bin (m/s)
401    REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:) ::  Ra_dry !< dry radius (m)
402   
403!-- Particle component index tables
404    TYPE(component_index) :: prtcl !< Contains "getIndex" which gives the index
405                                   !< for a given aerosol component name, i.e.
406                                   !< 1:SO4, 2:OC, 3:BC, 4:DU,
407                                   !< 5:SS, 6:NO, 7:NH, 8:H2O 
408!                                   
409!-- Data output arrays:
410!-- Gases:
411    REAL(wp), ALLOCATABLE, DIMENSION(:,:,:), TARGET ::  g_H2SO4_av  !< H2SO4
412    REAL(wp), ALLOCATABLE, DIMENSION(:,:,:), TARGET ::  g_HNO3_av   !< HNO3
413    REAL(wp), ALLOCATABLE, DIMENSION(:,:,:), TARGET ::  g_NH3_av    !< NH3
414    REAL(wp), ALLOCATABLE, DIMENSION(:,:,:), TARGET ::  g_OCNV_av   !< non-vola-
415                                                                    !< tile OC
416    REAL(wp), ALLOCATABLE, DIMENSION(:,:,:), TARGET ::  g_OCSV_av   !< semi-vol.
417                                                                    !< OC
418!-- Integrated:                                                                   
419    REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) ::  LDSA_av  !< lung deposited
420                                                         !< surface area                                                   
421    REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) ::  Ntot_av  !< total number conc.
422    REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) ::  PM25_av  !< PM2.5
423    REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) ::  PM10_av  !< PM10
424!-- In the particle phase:   
425    REAL(wp), ALLOCATABLE, DIMENSION(:,:,:), TARGET ::  s_BC_av  !< black carbon
426    REAL(wp), ALLOCATABLE, DIMENSION(:,:,:), TARGET ::  s_DU_av  !< dust
427    REAL(wp), ALLOCATABLE, DIMENSION(:,:,:), TARGET ::  s_H2O_av !< liquid water
428    REAL(wp), ALLOCATABLE, DIMENSION(:,:,:), TARGET ::  s_NH_av  !< ammonia
429    REAL(wp), ALLOCATABLE, DIMENSION(:,:,:), TARGET ::  s_NO_av  !< nitrates
430    REAL(wp), ALLOCATABLE, DIMENSION(:,:,:), TARGET ::  s_OC_av  !< org. carbon
431    REAL(wp), ALLOCATABLE, DIMENSION(:,:,:), TARGET ::  s_SO4_av !< sulphates
432    REAL(wp), ALLOCATABLE, DIMENSION(:,:,:), TARGET ::  s_SS_av  !< sea salt
433!-- Bins:   
434    REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:) ::  mbins_av  !< bin mass
435                                                            !< concentration
436    REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:) ::  Nbins_av  !< bin number
437                                                            !< concentration 
438       
439!
440!-- PALM interfaces:
441!
442!-- Boundary conditions:
443    INTERFACE salsa_boundary_conds
444       MODULE PROCEDURE salsa_boundary_conds
445       MODULE PROCEDURE salsa_boundary_conds_decycle
446    END INTERFACE salsa_boundary_conds
447!   
448!-- Data output checks for 2D/3D data to be done in check_parameters
449    INTERFACE salsa_check_data_output
450       MODULE PROCEDURE salsa_check_data_output
451    END INTERFACE salsa_check_data_output
452   
453!
454!-- Input parameter checks to be done in check_parameters
455    INTERFACE salsa_check_parameters
456       MODULE PROCEDURE salsa_check_parameters
457    END INTERFACE salsa_check_parameters
458
459!
460!-- Averaging of 3D data for output
461    INTERFACE salsa_3d_data_averaging
462       MODULE PROCEDURE salsa_3d_data_averaging
463    END INTERFACE salsa_3d_data_averaging
464
465!
466!-- Data output of 2D quantities
467    INTERFACE salsa_data_output_2d
468       MODULE PROCEDURE salsa_data_output_2d
469    END INTERFACE salsa_data_output_2d
470
471!
472!-- Data output of 3D data
473    INTERFACE salsa_data_output_3d
474       MODULE PROCEDURE salsa_data_output_3d
475    END INTERFACE salsa_data_output_3d
476   
477!
478!-- Data output of 3D data
479    INTERFACE salsa_data_output_mask
480       MODULE PROCEDURE salsa_data_output_mask
481    END INTERFACE salsa_data_output_mask
482
483!
484!-- Definition of data output quantities
485    INTERFACE salsa_define_netcdf_grid
486       MODULE PROCEDURE salsa_define_netcdf_grid
487    END INTERFACE salsa_define_netcdf_grid
488   
489!
490!-- Output of information to the header file
491    INTERFACE salsa_header
492       MODULE PROCEDURE salsa_header
493    END INTERFACE salsa_header
494 
495!
496!-- Initialization actions 
497    INTERFACE salsa_init
498       MODULE PROCEDURE salsa_init
499    END INTERFACE salsa_init
500 
501!
502!-- Initialization of arrays
503    INTERFACE salsa_init_arrays
504       MODULE PROCEDURE salsa_init_arrays
505    END INTERFACE salsa_init_arrays
506
507!
508!-- Writing of binary output for restart runs  !!! renaming?!
509    INTERFACE salsa_wrd_local
510       MODULE PROCEDURE salsa_wrd_local
511    END INTERFACE salsa_wrd_local
512   
513!
514!-- Reading of NAMELIST parameters
515    INTERFACE salsa_parin
516       MODULE PROCEDURE salsa_parin
517    END INTERFACE salsa_parin
518
519!
520!-- Reading of parameters for restart runs
521    INTERFACE salsa_rrd_local
522       MODULE PROCEDURE salsa_rrd_local
523    END INTERFACE salsa_rrd_local
524   
525!
526!-- Swapping of time levels (required for prognostic variables)
527    INTERFACE salsa_swap_timelevel
528       MODULE PROCEDURE salsa_swap_timelevel
529    END INTERFACE salsa_swap_timelevel
530
531    INTERFACE salsa_driver
532       MODULE PROCEDURE salsa_driver
533    END INTERFACE salsa_driver
534
535    INTERFACE salsa_tendency
536       MODULE PROCEDURE salsa_tendency
537       MODULE PROCEDURE salsa_tendency_ij
538    END INTERFACE salsa_tendency
539   
540   
541   
542    SAVE
543
544    PRIVATE
545!
546!-- Public functions:
547    PUBLIC salsa_boundary_conds, salsa_check_data_output,                      &
548           salsa_check_parameters, salsa_3d_data_averaging,                    &
549           salsa_data_output_2d, salsa_data_output_3d, salsa_data_output_mask, &
550           salsa_define_netcdf_grid, salsa_diagnostics, salsa_driver,          &
551           salsa_header, salsa_init, salsa_init_arrays, salsa_parin,           &
552           salsa_rrd_local, salsa_swap_timelevel, salsa_tendency,              &
553           salsa_wrd_local
554!
555!-- Public parameters, constants and initial values
556    PUBLIC dots_salsa, dt_salsa, last_salsa_time, lsdepo, salsa,               &
557           salsa_gases_from_chem, skip_time_do_salsa
558!
559!-- Public prognostic variables
560    PUBLIC aerosol_mass, aerosol_number, fn2a, fn2b, gconc_2, in1a, in2b,      &
561           mconc_2, nbins, ncc, ncc_tot, nclim, nconc_2, ngast, prtcl, Ra_dry, &
562           salsa_gas, sedim_vd
563
564 CONTAINS
565
566!------------------------------------------------------------------------------!
567! Description:
568! ------------
569!> Parin for &salsa_par for new modules
570!------------------------------------------------------------------------------!
571 SUBROUTINE salsa_parin
572
573    IMPLICIT NONE
574
575    CHARACTER (LEN=80) ::  line   !< dummy string that contains the current line
576                                  !< of the parameter file
577                                 
578    NAMELIST /salsa_parameters/             &
579                          advect_particle_water, & ! Switch for advecting
580                                                ! particle water. If .FALSE.,
581                                                ! equilibration is called at
582                                                ! each time step.       
583                          bc_salsa_b,       &   ! bottom boundary condition
584                          bc_salsa_t,       &   ! top boundary condition
585                          decycle_lr,       &   ! decycle SALSA components
586                          decycle_method,   &   ! decycle method applied:
587                                                ! 1=left 2=right 3=south 4=north
588                          decycle_ns,       &   ! decycle SALSA components
589                          depo_vege_type,   &   ! Parametrisation type
590                          depo_topo_type,   &   ! Parametrisation type
591                          dpg,              &   ! Mean diameter for the initial
592                                                ! log-normal modes
593                          dt_salsa,         &   ! SALSA timestep in seconds
594                          feedback_to_palm, &   ! allow feedback due to
595                                                ! hydration / condensation
596                          H2SO4_init,       &   ! Init value for sulphuric acid
597                          HNO3_init,        &   ! Init value for nitric acid
598                          igctyp,           &   ! Initial gas concentration type
599                          isdtyp,           &   ! Initial size distribution type                                               
600                          listspec,         &   ! List of actived aerosols
601                                                ! (string list)
602                          mass_fracs_a,     &   ! Initial relative contribution 
603                                                ! of each species to particle 
604                                                ! volume in a-bins, 0 for unused
605                          mass_fracs_b,     &   ! Initial relative contribution 
606                                                ! of each species to particle
607                                                ! volume in b-bins, 0 for unused
608                          n_lognorm,        &   ! Number concentration for the
609                                                ! log-normal modes                                               
610                          nbin,             &   ! Number of size bins for
611                                                ! aerosol size subranges 1 & 2
612                          nf2a,             &   ! Number fraction of particles
613                                                ! allocated to a-bins in
614                                                ! subrange 2 b-bins will get
615                                                ! 1-nf2a                         
616                          NH3_init,         &   ! Init value for ammonia
617                          nj3,              &   ! J3 parametrization
618                                                ! 1 = condensational sink
619                                                !     (Kerminen&Kulmala, 2002)
620                                                ! 2 = coagulational sink
621                                                !     (Lehtinen et al. 2007)
622                                                ! 3 = coagS+self-coagulation
623                                                !     (Anttila et al. 2010)                                                   
624                          nlcnd,            &   ! Condensation master switch
625                          nlcndgas,         &   ! Condensation of gases
626                          nlcndh2oae,       &   ! Condensation of H2O                           
627                          nlcoag,           &   ! Coagulation master switch
628                          nldepo,           &   ! Deposition master switch
629                          nldepo_vege,      &   ! Deposition on vegetation
630                                                ! master switch
631                          nldepo_topo,      &   ! Deposition on topo master
632                                                ! switch                         
633                          nldistupdate,     &   ! Size distribution update
634                                                ! master switch
635                          nsnucl,           &   ! Nucleation scheme:
636                                                ! 0 = off,
637                                                ! 1 = binary nucleation
638                                                ! 2 = activation type nucleation
639                                                ! 3 = kinetic nucleation
640                                                ! 4 = ternary nucleation
641                                                ! 5 = nucleation with organics
642                                                ! 6 = activation type of
643                                                !     nucleation with H2SO4+ORG
644                                                ! 7 = heteromolecular nucleation
645                                                !     with H2SO4*ORG
646                                                ! 8 = homomolecular nucleation 
647                                                !     of H2SO4 + heteromolecular
648                                                !     nucleation with H2SO4*ORG
649                                                ! 9 = homomolecular nucleation
650                                                !     of H2SO4 and ORG + hetero-
651                                                !     molecular nucleation with
652                                                !     H2SO4*ORG
653                          OCNV_init,        &   ! Init value for non-volatile
654                                                ! organic gases
655                          OCSV_init,        &   ! Init value for semi-volatile
656                                                ! organic gases
657                          read_restart_data_salsa, & ! read restart data for
658                                                     ! salsa
659                          reglim,           &   ! Min&max diameter limits of
660                                                ! size subranges
661                          salsa,            &   ! Master switch for SALSA
662                          salsa_source_mode,&   ! 'read_from_file' or 'constant'
663                                                ! or 'no_source'
664                          sigmag,           &   ! stdev for the initial log-
665                                                ! normal modes                                               
666                          skip_time_do_salsa, & ! Starting time of SALSA (s)
667                          van_der_waals_coagc,& ! include van der Waals forces
668                          write_binary_salsa    ! Write binary for salsa
669                           
670       
671    line = ' '
672       
673!
674!-- Try to find salsa package
675    REWIND ( 11 )
676    line = ' '
677    DO WHILE ( INDEX( line, '&salsa_parameters' ) == 0 )
678       READ ( 11, '(A)', END=10 )  line
679    ENDDO
680    BACKSPACE ( 11 )
681
682!
683!-- Read user-defined namelist
684    READ ( 11, salsa_parameters )
685
686!
687!-- Set flag that indicates that the new module is switched on
688!-- Note that this parameter needs to be declared in modules.f90
689    salsa = .TRUE.
690
691 10 CONTINUE
692       
693 END SUBROUTINE salsa_parin
694
695 
696!------------------------------------------------------------------------------!
697! Description:
698! ------------
699!> Check parameters routine for salsa.
700!------------------------------------------------------------------------------!
701 SUBROUTINE salsa_check_parameters
702
703    USE control_parameters,                                                    &
704        ONLY:  message_string
705       
706    IMPLICIT NONE
707   
708!
709!-- Checks go here (cf. check_parameters.f90).
710    IF ( salsa  .AND.  .NOT.  humidity )  THEN
711       WRITE( message_string, * ) 'salsa = ', salsa, ' is ',                   &
712              'not allowed with humidity = ', humidity
713       CALL message( 'check_parameters', 'SA0009', 1, 2, 0, 6, 0 )
714    ENDIF
715   
716    IF ( bc_salsa_b == 'dirichlet' )  THEN
717       ibc_salsa_b = 0
718    ELSEIF ( bc_salsa_b == 'neumann' )  THEN
719       ibc_salsa_b = 1
720    ELSE
721       message_string = 'unknown boundary condition: bc_salsa_b = "'           &
722                         // TRIM( bc_salsa_t ) // '"'
723       CALL message( 'check_parameters', 'SA0011', 1, 2, 0, 6, 0 )                 
724    ENDIF
725   
726    IF ( bc_salsa_t == 'dirichlet' )  THEN
727       ibc_salsa_t = 0
728    ELSEIF ( bc_salsa_t == 'neumann' )  THEN
729       ibc_salsa_t = 1
730    ELSE
731       message_string = 'unknown boundary condition: bc_salsa_t = "'           &
732                         // TRIM( bc_salsa_t ) // '"'
733       CALL message( 'check_parameters', 'SA0012', 1, 2, 0, 6, 0 )                 
734    ENDIF
735   
736    IF ( nj3 < 1  .OR.  nj3 > 3 )  THEN
737       message_string = 'unknown nj3 (must be 1-3)'
738       CALL message( 'check_parameters', 'SA0044', 1, 2, 0, 6, 0 )
739    ENDIF
740           
741 END SUBROUTINE salsa_check_parameters
742
743!------------------------------------------------------------------------------!
744!
745! Description:
746! ------------
747!> Subroutine defining appropriate grid for netcdf variables.
748!> It is called out from subroutine netcdf.
749!> Same grid as for other scalars (see netcdf_interface_mod.f90)
750!------------------------------------------------------------------------------!
751 SUBROUTINE salsa_define_netcdf_grid( var, found, grid_x, grid_y, grid_z )
752   
753    IMPLICIT NONE
754
755    CHARACTER (LEN=*), INTENT(OUT) ::  grid_x   !<
756    CHARACTER (LEN=*), INTENT(OUT) ::  grid_y   !<
757    CHARACTER (LEN=*), INTENT(OUT) ::  grid_z   !<
758    CHARACTER (LEN=*), INTENT(IN)  ::  var      !<
759   
760    LOGICAL, INTENT(OUT) ::  found   !<
761   
762    found  = .TRUE.
763!
764!-- Check for the grid
765
766    IF ( var(1:2) == 'g_' )  THEN
767       grid_x = 'x' 
768       grid_y = 'y' 
769       grid_z = 'zu'   
770    ELSEIF ( var(1:4) == 'LDSA' )  THEN
771       grid_x = 'x' 
772       grid_y = 'y' 
773       grid_z = 'zu'
774    ELSEIF ( var(1:5) == 'm_bin' )  THEN
775       grid_x = 'x' 
776       grid_y = 'y' 
777       grid_z = 'zu'
778    ELSEIF ( var(1:5) == 'N_bin' )  THEN
779       grid_x = 'x' 
780       grid_y = 'y' 
781       grid_z = 'zu'
782    ELSEIF ( var(1:4) == 'Ntot' ) THEN
783       grid_x = 'x' 
784       grid_y = 'y' 
785       grid_z = 'zu'
786    ELSEIF ( var(1:2) == 'PM' )  THEN
787       grid_x = 'x' 
788       grid_y = 'y' 
789       grid_z = 'zu'
790    ELSEIF ( var(1:2) == 's_' )  THEN
791       grid_x = 'x' 
792       grid_y = 'y' 
793       grid_z = 'zu'
794    ELSE
795       found  = .FALSE.
796       grid_x = 'none'
797       grid_y = 'none'
798       grid_z = 'none'
799    ENDIF
800
801 END SUBROUTINE salsa_define_netcdf_grid
802
803 
804!------------------------------------------------------------------------------!
805! Description:
806! ------------
807!> Header output for new module
808!------------------------------------------------------------------------------!
809 SUBROUTINE salsa_header( io )
810
811    IMPLICIT NONE
812 
813    INTEGER(iwp), INTENT(IN) ::  io   !< Unit of the output file
814!
815!-- Write SALSA header
816    WRITE( io, 1 )
817    WRITE( io, 2 ) skip_time_do_salsa
818    WRITE( io, 3 ) dt_salsa
819    WRITE( io, 12 )  SHAPE( aerosol_number(1)%conc ), nbins
820    IF ( advect_particle_water )  THEN
821       WRITE( io, 16 )  SHAPE( aerosol_mass(1)%conc ), ncc_tot*nbins,          &
822                        advect_particle_water
823    ELSE
824       WRITE( io, 16 )  SHAPE( aerosol_mass(1)%conc ), ncc*nbins,              &
825                        advect_particle_water
826    ENDIF
827    IF ( .NOT. salsa_gases_from_chem )  THEN
828       WRITE( io, 17 )  SHAPE( aerosol_mass(1)%conc ), ngast,                  &
829                        salsa_gases_from_chem
830    ENDIF
831    WRITE( io, 4 ) 
832    IF ( nsnucl > 0 )  THEN
833       WRITE( io, 5 ) nsnucl, nj3
834    ENDIF
835    IF ( nlcoag )  THEN
836       WRITE( io, 6 ) 
837    ENDIF
838    IF ( nlcnd )  THEN
839       WRITE( io, 7 ) nlcndgas, nlcndh2oae
840    ENDIF
841    IF ( nldepo )  THEN
842       WRITE( io, 14 ) nldepo_vege, nldepo_topo
843    ENDIF
844    WRITE( io, 8 )  reglim, nbin, bin_low_limits
845    WRITE( io, 15 ) nsect
846    WRITE( io, 13 ) ncc, listspec, mass_fracs_a, mass_fracs_b
847    IF ( .NOT. salsa_gases_from_chem )  THEN
848       WRITE( io, 18 ) ngast, H2SO4_init, HNO3_init, NH3_init, OCNV_init,      &
849                       OCSV_init
850    ENDIF
851    WRITE( io, 9 )  isdtyp, igctyp
852    IF ( isdtyp == 0 )  THEN
853       WRITE( io, 10 )  dpg, sigmag, n_lognorm
854    ELSE
855       WRITE( io, 11 )
856    ENDIF
857   
858
8591   FORMAT (//' SALSA information:'/                                           &
860              ' ------------------------------'/)
8612   FORMAT   ('    Starts at: skip_time_do_salsa = ', F10.2, '  s')
8623   FORMAT  (/'    Timestep: dt_salsa = ', F6.2, '  s')
86312  FORMAT  (/'    Array shape (z,y,x,bins):'/                                 &
864              '       aerosol_number:  ', 4(I3)) 
86516  FORMAT  (/'       aerosol_mass:    ', 4(I3),/                              &
866              '       (advect_particle_water = ', L1, ')')
86717  FORMAT   ('       salsa_gas: ', 4(I3),/                                    &
868              '       (salsa_gases_from_chem = ', L1, ')')
8694   FORMAT  (/'    Aerosol dynamic processes included: ')
8705   FORMAT  (/'       nucleation (scheme = ', I1, ' and J3 parametrization = ',&
871               I1, ')')
8726   FORMAT  (/'       coagulation')
8737   FORMAT  (/'       condensation (of precursor gases = ', L1,                &
874              '          and water vapour = ', L1, ')' )
87514  FORMAT  (/'       dry deposition (on vegetation = ', L1,                   &
876              '          and on topography = ', L1, ')')             
8778   FORMAT  (/'    Aerosol bin subrange limits (in metres): ',  3(ES10.2E3) /  &
878              '    Number of size bins for each aerosol subrange: ', 2I3,/     &
879              '    Aerosol bin limits (in metres): ', *(ES10.2E3))
88015  FORMAT   ('    Initial number concentration in bins at the lowest level',  &
881              ' (#/m**3):', *(ES10.2E3))       
88213  FORMAT  (/'    Number of chemical components used: ', I1,/                 &
883              '       Species: ',7(A6),/                                       &
884              '    Initial relative contribution of each species to particle', & 
885              ' volume in:',/                                                  &
886              '       a-bins: ', 7(F6.3),/                                     &
887              '       b-bins: ', 7(F6.3))
88818  FORMAT  (/'    Number of gaseous tracers used: ', I1,/                     &
889              '    Initial gas concentrations:',/                              &
890              '       H2SO4: ',ES12.4E3, ' #/m**3',/                           &
891              '       HNO3:  ',ES12.4E3, ' #/m**3',/                           &
892              '       NH3:   ',ES12.4E3, ' #/m**3',/                           &
893              '       OCNV:  ',ES12.4E3, ' #/m**3',/                           &
894              '       OCSV:  ',ES12.4E3, ' #/m**3')
8959    FORMAT (/'   Initialising concentrations: ', /                            &
896              '      Aerosol size distribution: isdtyp = ', I1,/               &
897              '      Gas concentrations: igctyp = ', I1 )
89810   FORMAT ( '      Mode diametres: dpg(nmod) = ', 7(F7.3),/                  &
899              '      Standard deviation: sigmag(nmod) = ', 7(F7.2),/           &
900              '      Number concentration: n_lognorm(nmod) = ', 7(ES12.4E3) )
90111   FORMAT (/'      Size distribution read from a file.')
902
903 END SUBROUTINE salsa_header
904
905!------------------------------------------------------------------------------!
906! Description:
907! ------------
908!> Allocate SALSA arrays and define pointers if required
909!------------------------------------------------------------------------------!
910 SUBROUTINE salsa_init_arrays
911 
912    USE surface_mod,                                                           &
913        ONLY:  surf_def_h, surf_def_v, surf_lsm_h, surf_lsm_v, surf_usm_h,     &
914               surf_usm_v
915
916    IMPLICIT NONE
917   
918    INTEGER(iwp) ::  gases_available !< Number of available gas components in
919                                     !< the chemistry model
920    INTEGER(iwp) ::  i   !< loop index for allocating
921    INTEGER(iwp) ::  l   !< loop index for allocating: surfaces
922    INTEGER(iwp) ::  lsp !< loop index for chem species in the chemistry model
923   
924    gases_available = 0
925
926!
927!-- Allocate prognostic variables (see salsa_swap_timelevel)
928#if defined( __nopointer )
929    message_string = 'SALSA runs only with POINTER Version'
930    CALL message( 'salsa_mod: salsa_init_arrays', 'SA0023', 1, 2, 0, 6, 0 )
931#else         
932!
933!-- Set derived indices:
934!-- (This does the same as the subroutine salsa_initialize in SALSA/
935!-- UCLALES-SALSA)       
936    in1a = 1                ! 1st index of subrange 1a
937    in2a = in1a + nbin(1)   ! 1st index of subrange 2a
938    fn1a = in2a - 1         ! last index of subrange 1a
939    fn2a = fn1a + nbin(2)   ! last index of subrange 2a
940   
941!   
942!-- If the fraction of insoluble aerosols in subrange 2 is zero: do not allocate
943!-- arrays for them
944    IF ( nf2a > 0.999999_wp  .AND.  SUM( mass_fracs_b ) < 0.00001_wp )  THEN
945       no_insoluble = .TRUE.
946       in2b = fn2a+1    ! 1st index of subrange 2b
947       fn2b = fn2a      ! last index of subrange 2b
948    ELSE
949       in2b = in2a + nbin(2)   ! 1st index of subrange 2b
950       fn2b = fn2a + nbin(2)   ! last index of subrange 2b
951    ENDIF
952   
953   
954    nbins = fn2b   ! total number of aerosol size bins
955!   
956!-- Create index tables for different aerosol components
957    CALL component_index_constructor( prtcl, ncc, maxspec, listspec )
958   
959    ncc_tot = ncc
960    IF ( advect_particle_water )  ncc_tot = ncc + 1  ! Add water
961   
962!
963!-- Allocate:
964    ALLOCATE( aero(nbins), bin_low_limits(nbins), nsect(nbins), massacc(nbins) )
965    IF ( nldepo ) ALLOCATE( sedim_vd(nzb:nzt+1,nysg:nyng,nxlg:nxrg,nbins) )         
966    ALLOCATE( Ra_dry(nzb:nzt+1,nysg:nyng,nxlg:nxrg,nbins) )
967   
968!   
969!-- Aerosol number concentration
970    ALLOCATE( aerosol_number(nbins) )
971    ALLOCATE( nconc_1(nzb:nzt+1,nysg:nyng,nxlg:nxrg,nbins),                    &
972              nconc_2(nzb:nzt+1,nysg:nyng,nxlg:nxrg,nbins),                    &
973              nconc_3(nzb:nzt+1,nysg:nyng,nxlg:nxrg,nbins) )
974    nconc_1 = 0.0_wp
975    nconc_2 = 0.0_wp
976    nconc_3 = 0.0_wp
977   
978    DO i = 1, nbins
979       aerosol_number(i)%conc(nzb:nzt+1,nysg:nyng,nxlg:nxrg)    => nconc_1(:,:,:,i)
980       aerosol_number(i)%conc_p(nzb:nzt+1,nysg:nyng,nxlg:nxrg)  => nconc_2(:,:,:,i)
981       aerosol_number(i)%tconc_m(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => nconc_3(:,:,:,i)
982       ALLOCATE( aerosol_number(i)%flux_s(nzb+1:nzt,0:threads_per_task-1),     &
983                 aerosol_number(i)%diss_s(nzb+1:nzt,0:threads_per_task-1),     &
984                 aerosol_number(i)%flux_l(nzb+1:nzt,nys:nyn,0:threads_per_task-1),&
985                 aerosol_number(i)%diss_l(nzb+1:nzt,nys:nyn,0:threads_per_task-1),&
986                 aerosol_number(i)%init(nzb:nzt+1),                            &
987                 aerosol_number(i)%sums_ws_l(nzb:nzt+1,0:threads_per_task-1) )
988    ENDDO     
989   
990!   
991!-- Aerosol mass concentration   
992    ALLOCATE( aerosol_mass(ncc_tot*nbins) ) 
993    ALLOCATE( mconc_1(nzb:nzt+1,nysg:nyng,nxlg:nxrg,ncc_tot*nbins),            &
994              mconc_2(nzb:nzt+1,nysg:nyng,nxlg:nxrg,ncc_tot*nbins),            &
995              mconc_3(nzb:nzt+1,nysg:nyng,nxlg:nxrg,ncc_tot*nbins) )
996    mconc_1 = 0.0_wp
997    mconc_2 = 0.0_wp
998    mconc_3 = 0.0_wp
999   
1000    DO i = 1, ncc_tot*nbins
1001       aerosol_mass(i)%conc(nzb:nzt+1,nysg:nyng,nxlg:nxrg)    => mconc_1(:,:,:,i)
1002       aerosol_mass(i)%conc_p(nzb:nzt+1,nysg:nyng,nxlg:nxrg)  => mconc_2(:,:,:,i)
1003       aerosol_mass(i)%tconc_m(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => mconc_3(:,:,:,i)       
1004       ALLOCATE( aerosol_mass(i)%flux_s(nzb+1:nzt,0:threads_per_task-1),       &
1005                 aerosol_mass(i)%diss_s(nzb+1:nzt,0:threads_per_task-1),       &
1006                 aerosol_mass(i)%flux_l(nzb+1:nzt,nys:nyn,0:threads_per_task-1),&
1007                 aerosol_mass(i)%diss_l(nzb+1:nzt,nys:nyn,0:threads_per_task-1),&
1008                 aerosol_mass(i)%init(nzb:nzt+1),                              &
1009                 aerosol_mass(i)%sums_ws_l(nzb:nzt+1,0:threads_per_task-1)  )
1010    ENDDO
1011   
1012!
1013!-- Surface fluxes: answs = aerosol number, amsws = aerosol mass
1014!
1015!-- Horizontal surfaces: default type
1016    DO  l = 0, 2   ! upward (l=0), downward (l=1) and model top (l=2)
1017       ALLOCATE( surf_def_h(l)%answs( 1:surf_def_h(l)%ns, nbins ) )
1018       ALLOCATE( surf_def_h(l)%amsws( 1:surf_def_h(l)%ns, nbins*ncc_tot ) )
1019       surf_def_h(l)%answs = 0.0_wp
1020       surf_def_h(l)%amsws = 0.0_wp
1021    ENDDO
1022!-- Horizontal surfaces: natural type   
1023    IF ( land_surface )  THEN
1024       ALLOCATE( surf_lsm_h%answs( 1:surf_lsm_h%ns, nbins ) )
1025       ALLOCATE( surf_lsm_h%amsws( 1:surf_lsm_h%ns, nbins*ncc_tot ) )
1026       surf_lsm_h%answs = 0.0_wp
1027       surf_lsm_h%amsws = 0.0_wp
1028    ENDIF
1029!-- Horizontal surfaces: urban type
1030    IF ( urban_surface )  THEN
1031       ALLOCATE( surf_usm_h%answs( 1:surf_usm_h%ns, nbins ) )
1032       ALLOCATE( surf_usm_h%amsws( 1:surf_usm_h%ns, nbins*ncc_tot ) )
1033       surf_usm_h%answs = 0.0_wp
1034       surf_usm_h%amsws = 0.0_wp
1035    ENDIF
1036!
1037!-- Vertical surfaces: northward (l=0), southward (l=1), eastward (l=2) and
1038!-- westward (l=3) facing
1039    DO  l = 0, 3   
1040       ALLOCATE( surf_def_v(l)%answs( 1:surf_def_v(l)%ns, nbins ) )
1041       surf_def_v(l)%answs = 0.0_wp
1042       ALLOCATE( surf_def_v(l)%amsws( 1:surf_def_v(l)%ns, nbins*ncc_tot ) )
1043       surf_def_v(l)%amsws = 0.0_wp
1044       
1045       IF ( land_surface)  THEN
1046          ALLOCATE( surf_lsm_v(l)%answs( 1:surf_lsm_v(l)%ns, nbins ) )
1047          surf_lsm_v(l)%answs = 0.0_wp
1048          ALLOCATE( surf_lsm_v(l)%amsws( 1:surf_lsm_v(l)%ns, nbins*ncc_tot ) )
1049          surf_lsm_v(l)%amsws = 0.0_wp
1050       ENDIF
1051       
1052       IF ( urban_surface )  THEN
1053          ALLOCATE( surf_usm_v(l)%answs( 1:surf_usm_v(l)%ns, nbins ) )
1054          surf_usm_v(l)%answs = 0.0_wp
1055          ALLOCATE( surf_usm_v(l)%amsws( 1:surf_usm_v(l)%ns, nbins*ncc_tot ) )
1056          surf_usm_v(l)%amsws = 0.0_wp
1057       ENDIF
1058    ENDDO   
1059   
1060!
1061!-- Concentration of gaseous tracers (1. SO4, 2. HNO3, 3. NH3, 4. OCNV, 5. OCSV)
1062!-- (number concentration (#/m3) )
1063!
1064!-- If chemistry is on, read gas phase concentrations from there. Otherwise,
1065!-- allocate salsa_gas array.
1066
1067    IF ( air_chemistry )  THEN   
1068       DO  lsp = 1, nvar
1069          IF ( TRIM( chem_species(lsp)%name ) == 'H2SO4' )  THEN
1070             gases_available = gases_available + 1
1071             gas_index_chem(1) = lsp
1072          ELSEIF ( TRIM( chem_species(lsp)%name ) == 'HNO3' )  THEN
1073             gases_available = gases_available + 1 
1074             gas_index_chem(2) = lsp
1075          ELSEIF ( TRIM( chem_species(lsp)%name ) == 'NH3' )  THEN
1076             gases_available = gases_available + 1
1077             gas_index_chem(3) = lsp
1078          ELSEIF ( TRIM( chem_species(lsp)%name ) == 'OCNV' )  THEN
1079             gases_available = gases_available + 1
1080             gas_index_chem(4) = lsp
1081          ELSEIF ( TRIM( chem_species(lsp)%name ) == 'OCSV' )  THEN
1082             gases_available = gases_available + 1
1083             gas_index_chem(5) = lsp
1084          ENDIF
1085       ENDDO
1086
1087       IF ( gases_available == ngast )  THEN
1088          salsa_gases_from_chem = .TRUE.
1089       ELSE
1090          WRITE( message_string, * ) 'SALSA is run together with chemistry '// &
1091                                     'but not all gaseous components are '//   &
1092                                     'provided by kpp (H2SO4, HNO3, NH3, '//   &
1093                                     'OCNV, OCSC)'
1094       CALL message( 'check_parameters', 'SA0024', 1, 2, 0, 6, 0 )
1095       ENDIF
1096
1097    ELSE
1098
1099       ALLOCATE( salsa_gas(ngast) ) 
1100       ALLOCATE( gconc_1(nzb:nzt+1,nysg:nyng,nxlg:nxrg,ngast),                 &
1101                 gconc_2(nzb:nzt+1,nysg:nyng,nxlg:nxrg,ngast),                 &
1102                 gconc_3(nzb:nzt+1,nysg:nyng,nxlg:nxrg,ngast) )
1103       gconc_1 = 0.0_wp
1104       gconc_2 = 0.0_wp
1105       gconc_3 = 0.0_wp
1106       
1107       DO i = 1, ngast
1108          salsa_gas(i)%conc(nzb:nzt+1,nysg:nyng,nxlg:nxrg)    => gconc_1(:,:,:,i)
1109          salsa_gas(i)%conc_p(nzb:nzt+1,nysg:nyng,nxlg:nxrg)  => gconc_2(:,:,:,i)
1110          salsa_gas(i)%tconc_m(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => gconc_3(:,:,:,i)
1111          ALLOCATE( salsa_gas(i)%flux_s(nzb+1:nzt,0:threads_per_task-1),       &
1112                    salsa_gas(i)%diss_s(nzb+1:nzt,0:threads_per_task-1),       &
1113                    salsa_gas(i)%flux_l(nzb+1:nzt,nys:nyn,0:threads_per_task-1),&
1114                    salsa_gas(i)%diss_l(nzb+1:nzt,nys:nyn,0:threads_per_task-1),&
1115                    salsa_gas(i)%init(nzb:nzt+1),                              &
1116                    salsa_gas(i)%sums_ws_l(nzb:nzt+1,0:threads_per_task-1) )
1117       ENDDO       
1118!
1119!--    Surface fluxes: gtsws = gaseous tracer flux
1120!
1121!--    Horizontal surfaces: default type
1122       DO  l = 0, 2   ! upward (l=0), downward (l=1) and model top (l=2)
1123          ALLOCATE( surf_def_h(l)%gtsws( 1:surf_def_h(l)%ns, ngast ) )
1124          surf_def_h(l)%gtsws = 0.0_wp
1125       ENDDO
1126!--    Horizontal surfaces: natural type   
1127       IF ( land_surface )  THEN
1128          ALLOCATE( surf_lsm_h%gtsws( 1:surf_lsm_h%ns, ngast ) )
1129          surf_lsm_h%gtsws = 0.0_wp
1130       ENDIF
1131!--    Horizontal surfaces: urban type         
1132       IF ( urban_surface )  THEN
1133          ALLOCATE( surf_usm_h%gtsws( 1:surf_usm_h%ns, ngast ) )
1134          surf_usm_h%gtsws = 0.0_wp
1135       ENDIF
1136!
1137!--    Vertical surfaces: northward (l=0), southward (l=1), eastward (l=2) and
1138!--    westward (l=3) facing
1139       DO  l = 0, 3     
1140          ALLOCATE( surf_def_v(l)%gtsws( 1:surf_def_v(l)%ns, ngast ) )
1141          surf_def_v(l)%gtsws = 0.0_wp
1142          IF ( land_surface )  THEN
1143             ALLOCATE( surf_lsm_v(l)%gtsws( 1:surf_lsm_v(l)%ns, ngast ) )
1144             surf_lsm_v(l)%gtsws = 0.0_wp
1145          ENDIF
1146          IF ( urban_surface )  THEN
1147             ALLOCATE( surf_usm_v(l)%gtsws( 1:surf_usm_v(l)%ns, ngast ) )
1148             surf_usm_v(l)%gtsws = 0.0_wp
1149          ENDIF
1150       ENDDO
1151    ENDIF
1152   
1153#endif
1154
1155 END SUBROUTINE salsa_init_arrays
1156
1157!------------------------------------------------------------------------------!
1158! Description:
1159! ------------
1160!> Initialization of SALSA. Based on salsa_initialize in UCLALES-SALSA.
1161!> Subroutines salsa_initialize, SALSAinit and DiagInitAero in UCLALES-SALSA are
1162!> also merged here.
1163!------------------------------------------------------------------------------!
1164 SUBROUTINE salsa_init
1165
1166    IMPLICIT NONE
1167   
1168    INTEGER(iwp) :: b
1169    INTEGER(iwp) :: c
1170    INTEGER(iwp) :: g
1171    INTEGER(iwp) :: i
1172    INTEGER(iwp) :: j
1173   
1174    bin_low_limits = 0.0_wp
1175    nsect          = 0.0_wp
1176    massacc        = 1.0_wp 
1177   
1178!
1179!-- Indices for chemical components used (-1 = not used)
1180    i = 0
1181    IF ( is_used( prtcl, 'SO4' ) )  THEN
1182       iso4 = get_index( prtcl,'SO4' )
1183       i = i + 1
1184    ENDIF
1185    IF ( is_used( prtcl,'OC' ) )  THEN
1186       ioc = get_index(prtcl, 'OC')
1187       i = i + 1
1188    ENDIF
1189    IF ( is_used( prtcl, 'BC' ) )  THEN
1190       ibc = get_index( prtcl, 'BC' )
1191       i = i + 1
1192    ENDIF
1193    IF ( is_used( prtcl, 'DU' ) )  THEN
1194       idu = get_index( prtcl, 'DU' )
1195       i = i + 1
1196    ENDIF
1197    IF ( is_used( prtcl, 'SS' ) )  THEN
1198       iss = get_index( prtcl, 'SS' )
1199       i = i + 1
1200    ENDIF
1201    IF ( is_used( prtcl, 'NO' ) )  THEN
1202       ino = get_index( prtcl, 'NO' )
1203       i = i + 1
1204    ENDIF
1205    IF ( is_used( prtcl, 'NH' ) )  THEN
1206       inh = get_index( prtcl, 'NH' )
1207       i = i + 1
1208    ENDIF
1209!   
1210!-- All species must be known
1211    IF ( i /= ncc )  THEN
1212       message_string = 'Unknown aerosol species/component(s) given in the' // &
1213                        ' initialization'
1214       CALL message( 'salsa_mod: salsa_init', 'SA0020', 1, 2, 0, 6, 0 )
1215    ENDIF
1216   
1217!
1218!-- Initialise
1219!
1220!-- Aerosol size distribution (TYPE t_section)
1221    aero(:)%dwet     = 1.0E-10_wp
1222    aero(:)%veqh2o   = 1.0E-10_wp
1223    aero(:)%numc     = nclim
1224    aero(:)%core     = 1.0E-10_wp
1225    DO c = 1, maxspec+1    ! 1:SO4, 2:OC, 3:BC, 4:DU, 5:SS, 6:NO, 7:NH, 8:H2O
1226       aero(:)%volc(c) = 0.0_wp
1227    ENDDO
1228   
1229    IF ( nldepo )  sedim_vd = 0.0_wp
1230!   
1231!-- Initilisation actions that are NOT conducted for restart runs
1232    IF ( .NOT. read_restart_data_salsa )  THEN   
1233   
1234       DO  b = 1, nbins
1235          aerosol_number(b)%conc      = nclim
1236          aerosol_number(b)%conc_p    = 0.0_wp
1237          aerosol_number(b)%tconc_m   = 0.0_wp
1238          aerosol_number(b)%flux_s    = 0.0_wp
1239          aerosol_number(b)%diss_s    = 0.0_wp
1240          aerosol_number(b)%flux_l    = 0.0_wp
1241          aerosol_number(b)%diss_l    = 0.0_wp
1242          aerosol_number(b)%init      = nclim
1243          aerosol_number(b)%sums_ws_l = 0.0_wp
1244       ENDDO
1245       DO  c = 1, ncc_tot*nbins
1246          aerosol_mass(c)%conc      = mclim
1247          aerosol_mass(c)%conc_p    = 0.0_wp
1248          aerosol_mass(c)%tconc_m   = 0.0_wp
1249          aerosol_mass(c)%flux_s    = 0.0_wp
1250          aerosol_mass(c)%diss_s    = 0.0_wp
1251          aerosol_mass(c)%flux_l    = 0.0_wp
1252          aerosol_mass(c)%diss_l    = 0.0_wp
1253          aerosol_mass(c)%init      = mclim
1254          aerosol_mass(c)%sums_ws_l = 0.0_wp
1255       ENDDO
1256       
1257       IF ( .NOT. salsa_gases_from_chem )  THEN
1258          DO  g = 1, ngast
1259             salsa_gas(g)%conc_p    = 0.0_wp
1260             salsa_gas(g)%tconc_m   = 0.0_wp
1261             salsa_gas(g)%flux_s    = 0.0_wp
1262             salsa_gas(g)%diss_s    = 0.0_wp
1263             salsa_gas(g)%flux_l    = 0.0_wp
1264             salsa_gas(g)%diss_l    = 0.0_wp
1265             salsa_gas(g)%sums_ws_l = 0.0_wp
1266          ENDDO
1267       
1268!
1269!--       Set initial value for gas compound tracers and initial values
1270          salsa_gas(1)%conc = H2SO4_init
1271          salsa_gas(1)%init = H2SO4_init
1272          salsa_gas(2)%conc = HNO3_init
1273          salsa_gas(2)%init = HNO3_init
1274          salsa_gas(3)%conc = NH3_init
1275          salsa_gas(3)%init = NH3_init
1276          salsa_gas(4)%conc = OCNV_init
1277          salsa_gas(4)%init = OCNV_init
1278          salsa_gas(5)%conc = OCSV_init
1279          salsa_gas(5)%init = OCSV_init     
1280       ENDIF
1281!
1282!--    Aerosol radius in each bin: dry and wet (m)
1283       Ra_dry = 1.0E-10_wp
1284!   
1285!--    Initialise aerosol tracers   
1286       aero(:)%vhilim   = 0.0_wp
1287       aero(:)%vlolim   = 0.0_wp
1288       aero(:)%vratiohi = 0.0_wp
1289       aero(:)%vratiolo = 0.0_wp
1290       aero(:)%dmid     = 0.0_wp
1291!
1292!--    Initialise the sectional particle size distribution
1293       CALL set_sizebins()
1294!
1295!--    Initialise location-dependent aerosol size distributions and
1296!--    chemical compositions:
1297       CALL aerosol_init 
1298!
1299!--    Initalisation run of SALSA
1300       DO  i = nxl, nxr
1301          DO  j = nys, nyn
1302             CALL salsa_driver( i, j, 1 )
1303             CALL salsa_diagnostics( i, j )
1304          ENDDO
1305       ENDDO 
1306    ENDIF
1307!
1308!-- Set the aerosol and gas sources
1309    IF ( salsa_source_mode == 'read_from_file' )  THEN
1310       CALL salsa_set_source
1311    ENDIF
1312   
1313 END SUBROUTINE salsa_init
1314
1315!------------------------------------------------------------------------------!
1316! Description:
1317! ------------
1318!> Initializes particle size distribution grid by calculating size bin limits
1319!> and mid-size for *dry* particles in each bin. Called from salsa_initialize
1320!> (only at the beginning of simulation).
1321!> Size distribution described using:
1322!>   1) moving center method (subranges 1 and 2)
1323!>      (Jacobson, Atmos. Env., 31, 131-144, 1997)
1324!>   2) fixed sectional method (subrange 3)
1325!> Size bins in each subrange are spaced logarithmically
1326!> based on given subrange size limits and bin number.
1327!
1328!> Mona changed 06/2017: Use geometric mean diameter to describe the mean
1329!> particle diameter in a size bin, not the arithmeric mean which clearly
1330!> overestimates the total particle volume concentration.
1331!
1332!> Coded by:
1333!> Hannele Korhonen (FMI) 2005
1334!> Harri Kokkola (FMI) 2006
1335!
1336!> Bug fixes for box model + updated for the new aerosol datatype:
1337!> Juha Tonttila (FMI) 2014
1338!------------------------------------------------------------------------------!
1339 SUBROUTINE set_sizebins
1340               
1341    IMPLICIT NONE
1342!   
1343!-- Local variables
1344    INTEGER(iwp) ::  cc
1345    INTEGER(iwp) ::  dd
1346    REAL(wp) ::  ratio_d !< ratio of the upper and lower diameter of subranges
1347!
1348!-- vlolim&vhilim: min & max *dry* volumes [fxm]
1349!-- dmid: bin mid *dry* diameter (m)
1350!-- vratiolo&vratiohi: volume ratio between the center and low/high limit
1351!
1352!-- 1) Size subrange 1:
1353    ratio_d = reglim(2) / reglim(1)   ! section spacing (m)
1354    DO  cc = in1a,fn1a
1355       aero(cc)%vlolim = api6 * ( reglim(1) * ratio_d **                       &
1356                                ( REAL( cc-1 ) / nbin(1) ) ) ** 3.0_wp
1357       aero(cc)%vhilim = api6 * ( reglim(1) * ratio_d **                       &
1358                                ( REAL( cc ) / nbin(1) ) ) ** 3.0_wp
1359       aero(cc)%dmid = SQRT( ( aero(cc)%vhilim / api6 ) ** ( 1.0_wp / 3.0_wp ) &
1360                           * ( aero(cc)%vlolim / api6 ) ** ( 1.0_wp / 3.0_wp ) )
1361       aero(cc)%vratiohi = aero(cc)%vhilim / ( api6 * aero(cc)%dmid ** 3.0_wp )
1362       aero(cc)%vratiolo = aero(cc)%vlolim / ( api6 * aero(cc)%dmid ** 3.0_wp )
1363    ENDDO
1364!
1365!-- 2) Size subrange 2:
1366!-- 2.1) Sub-subrange 2a: high hygroscopicity
1367    ratio_d = reglim(3) / reglim(2)   ! section spacing
1368    DO  dd = in2a, fn2a
1369       cc = dd - in2a
1370       aero(dd)%vlolim = api6 * ( reglim(2) * ratio_d **                       &
1371                                  ( REAL( cc ) / nbin(2) ) ) ** 3.0_wp
1372       aero(dd)%vhilim = api6 * ( reglim(2) * ratio_d **                       &
1373                                  ( REAL( cc+1 ) / nbin(2) ) ) ** 3.0_wp
1374       aero(dd)%dmid = SQRT( ( aero(dd)%vhilim / api6 ) ** ( 1.0_wp / 3.0_wp ) &
1375                           * ( aero(dd)%vlolim / api6 ) ** ( 1.0_wp / 3.0_wp ) )
1376       aero(dd)%vratiohi = aero(dd)%vhilim / ( api6 * aero(dd)%dmid ** 3.0_wp )
1377       aero(dd)%vratiolo = aero(dd)%vlolim / ( api6 * aero(dd)%dmid ** 3.0_wp )
1378    ENDDO
1379!         
1380!-- 2.2) Sub-subrange 2b: low hygroscopicity
1381    IF ( .NOT. no_insoluble )  THEN
1382       aero(in2b:fn2b)%vlolim   = aero(in2a:fn2a)%vlolim
1383       aero(in2b:fn2b)%vhilim   = aero(in2a:fn2a)%vhilim
1384       aero(in2b:fn2b)%dmid     = aero(in2a:fn2a)%dmid
1385       aero(in2b:fn2b)%vratiohi = aero(in2a:fn2a)%vratiohi
1386       aero(in2b:fn2b)%vratiolo = aero(in2a:fn2a)%vratiolo
1387    ENDIF
1388!         
1389!-- Initialize the wet diameter with the bin dry diameter to avoid numerical
1390!-- problems later
1391    aero(:)%dwet = aero(:)%dmid
1392!
1393!-- Save bin limits (lower diameter) to be delivered to the host model if needed
1394    DO cc = 1, nbins
1395       bin_low_limits(cc) = ( aero(cc)%vlolim / api6 )**( 1.0_wp / 3.0_wp )
1396    ENDDO   
1397   
1398 END SUBROUTINE set_sizebins
1399 
1400!------------------------------------------------------------------------------!
1401! Description:
1402! ------------
1403!> Initilize altitude-dependent aerosol size distributions and compositions.
1404!>
1405!> Mona added 06/2017: Correct the number and mass concentrations by normalizing
1406!< by the given total number and mass concentration.
1407!>
1408!> Tomi Raatikainen, FMI, 29.2.2016
1409!------------------------------------------------------------------------------!
1410 SUBROUTINE aerosol_init
1411 
1412    USE arrays_3d,                                                             &
1413        ONLY:  zu
1414 
1415!    USE NETCDF
1416   
1417    USE netcdf_data_input_mod,                                                 &
1418        ONLY:  get_attribute, netcdf_data_input_get_dimension_length,          &
1419               get_variable, open_read_file
1420   
1421    IMPLICIT NONE
1422   
1423    INTEGER(iwp) ::  b          !< loop index: size bins
1424    INTEGER(iwp) ::  c          !< loop index: chemical components
1425    INTEGER(iwp) ::  ee         !< index: end
1426    INTEGER(iwp) ::  g          !< loop index: gases
1427    INTEGER(iwp) ::  i          !< loop index: x-direction
1428    INTEGER(iwp) ::  id_faero   !< NetCDF id of PIDS_SALSA
1429    INTEGER(iwp) ::  id_fchem   !< NetCDF id of PIDS_CHEM
1430    INTEGER(iwp) ::  j          !< loop index: y-direction
1431    INTEGER(iwp) ::  k          !< loop index: z-direction
1432    INTEGER(iwp) ::  kk         !< loop index: z-direction
1433    INTEGER(iwp) ::  nz_file    !< Number of grid-points in file (heights)                           
1434    INTEGER(iwp) ::  prunmode
1435    INTEGER(iwp) ::  ss !< index: start
1436    LOGICAL  ::  netcdf_extend = .FALSE. !< Flag indicating wether netcdf
1437                                         !< topography input file or not
1438    REAL(wp), DIMENSION(nbins) ::  core  !< size of the bin mid aerosol particle,
1439    REAL(wp) ::  flag           !< flag to mask topography grid points
1440    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  pr_gas !< gas profiles
1441    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  pr_mass_fracs_a !< mass fraction
1442                                                              !< profiles: a
1443    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  pr_mass_fracs_b !< and b
1444    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  pr_nsect !< sectional size
1445                                                       !< distribution profile
1446    REAL(wp), DIMENSION(nbins)            ::  nsect  !< size distribution (#/m3)
1447    REAL(wp), DIMENSION(0:nz+1,nbins)     ::  pndist !< size dist as a function
1448                                                     !< of height (#/m3)
1449    REAL(wp), DIMENSION(0:nz+1)           ::  pnf2a  !< number fraction: bins 2a
1450    REAL(wp), DIMENSION(0:nz+1,maxspec)   ::  pvf2a  !< mass distributions of 
1451                                                     !< aerosol species for a 
1452    REAL(wp), DIMENSION(0:nz+1,maxspec)   ::  pvf2b  !< and b-bins     
1453    REAL(wp), DIMENSION(0:nz+1)           ::  pvfOC1a !< mass fraction between
1454                                                     !< SO4 and OC in 1a
1455    REAL(wp), DIMENSION(:), ALLOCATABLE   ::  pr_z
1456
1457    prunmode = 1
1458!
1459!-- Bin mean aerosol particle volume (m3)
1460    core(:) = 0.0_wp
1461    core(1:nbins) = api6 * aero(1:nbins)%dmid ** 3.0_wp
1462!   
1463!-- Set concentrations to zero
1464    nsect(:)     = 0.0_wp
1465    pndist(:,:)  = 0.0_wp
1466    pnf2a(:)     = nf2a   
1467    pvf2a(:,:)   = 0.0_wp
1468    pvf2b(:,:)   = 0.0_wp
1469    pvfOC1a(:)   = 0.0_wp
1470
1471    IF ( isdtyp == 1 )  THEN
1472!
1473!--    Read input profiles from PIDS_SALSA   
1474#if defined( __netcdf )
1475!   
1476!--    Location-dependent size distributions and compositions.     
1477       INQUIRE( FILE='PIDS_SALSA'// TRIM( coupling_char ), EXIST=netcdf_extend )
1478       IF ( netcdf_extend )  THEN
1479!
1480!--       Open file in read-only mode 
1481          CALL open_read_file( 'PIDS_SALSA' // TRIM( coupling_char ), id_faero )
1482!
1483!--       Input heights   
1484          CALL netcdf_data_input_get_dimension_length( id_faero, nz_file, "profile_z" ) 
1485         
1486          ALLOCATE( pr_z(nz_file), pr_mass_fracs_a(maxspec,nz_file),           &
1487                    pr_mass_fracs_b(maxspec,nz_file), pr_nsect(nbins,nz_file) ) 
1488          CALL get_variable( id_faero, 'profile_z', pr_z ) 
1489!       
1490!--       Mass fracs profile: 1: H2SO4 (sulphuric acid), 2: OC (organic carbon),
1491!--                           3: BC (black carbon),      4: DU (dust), 
1492!--                           5: SS (sea salt),          6: HNO3 (nitric acid),
1493!--                           7: NH3 (ammonia)         
1494          CALL get_variable( id_faero, "profile_mass_fracs_a", pr_mass_fracs_a,&
1495                             0, nz_file-1, 0, maxspec-1 )
1496          CALL get_variable( id_faero, "profile_mass_fracs_b", pr_mass_fracs_b,&
1497                             0, nz_file-1, 0, maxspec-1 )
1498          CALL get_variable( id_faero, "profile_nsect", pr_nsect, 0, nz_file-1,&
1499                             0, nbins-1 )                   
1500         
1501          kk = 1
1502          DO  k = nzb, nz+1
1503             IF ( kk < nz_file )  THEN
1504                DO  WHILE ( pr_z(kk+1) <= zu(k) )
1505                   kk = kk + 1
1506                   IF ( kk == nz_file )  EXIT
1507                ENDDO
1508             ENDIF
1509             IF ( kk < nz_file )  THEN
1510!             
1511!--             Set initial value for gas compound tracers and initial values
1512                pvf2a(k,:) = pr_mass_fracs_a(:,kk) + ( zu(k) - pr_z(kk) ) / (  &
1513                            pr_z(kk+1) - pr_z(kk) ) * ( pr_mass_fracs_a(:,kk+1)&
1514                            - pr_mass_fracs_a(:,kk) )   
1515                pvf2b(k,:) = pr_mass_fracs_b(:,kk) + ( zu(k) - pr_z(kk) ) / (  &
1516                            pr_z(kk+1) - pr_z(kk) ) * ( pr_mass_fracs_b(:,kk+1)&
1517                            - pr_mass_fracs_b(:,kk) )             
1518                pndist(k,:) = pr_nsect(:,kk) + ( zu(k) - pr_z(kk) ) / (        &
1519                              pr_z(kk+1) - pr_z(kk) ) * ( pr_nsect(:,kk+1) -   &
1520                              pr_nsect(:,kk) )
1521             ELSE
1522                pvf2a(k,:) = pr_mass_fracs_a(:,kk)       
1523                pvf2b(k,:) = pr_mass_fracs_b(:,kk)
1524                pndist(k,:) = pr_nsect(:,kk)
1525             ENDIF
1526             IF ( iso4 < 0 )  THEN
1527                pvf2a(k,1) = 0.0_wp
1528                pvf2b(k,1) = 0.0_wp
1529             ENDIF
1530             IF ( ioc < 0 )  THEN
1531                pvf2a(k,2) = 0.0_wp
1532                pvf2b(k,2) = 0.0_wp
1533             ENDIF
1534             IF ( ibc < 0 )  THEN
1535                pvf2a(k,3) = 0.0_wp
1536                pvf2b(k,3) = 0.0_wp
1537             ENDIF
1538             IF ( idu < 0 )  THEN
1539                pvf2a(k,4) = 0.0_wp
1540                pvf2b(k,4) = 0.0_wp
1541             ENDIF
1542             IF ( iss < 0 )  THEN
1543                pvf2a(k,5) = 0.0_wp
1544                pvf2b(k,5) = 0.0_wp
1545             ENDIF
1546             IF ( ino < 0 )  THEN
1547                pvf2a(k,6) = 0.0_wp
1548                pvf2b(k,6) = 0.0_wp
1549             ENDIF
1550             IF ( inh < 0 )  THEN
1551                pvf2a(k,7) = 0.0_wp
1552                pvf2b(k,7) = 0.0_wp
1553             ENDIF
1554!
1555!--          Then normalise the mass fraction so that SUM = 1
1556             pvf2a(k,:) = pvf2a(k,:) / SUM( pvf2a(k,:) )
1557             IF ( SUM( pvf2b(k,:) ) > 0.0_wp ) pvf2b(k,:) = pvf2b(k,:) /       &
1558                                                            SUM( pvf2b(k,:) )
1559          ENDDO         
1560          DEALLOCATE( pr_z, pr_mass_fracs_a, pr_mass_fracs_b, pr_nsect )
1561       ELSE
1562          message_string = 'Input file '// TRIM( 'PIDS_SALSA' ) //             &
1563                           TRIM( coupling_char ) // ' for SALSA missing!'
1564          CALL message( 'salsa_mod: aerosol_init', 'SA0032', 1, 2, 0, 6, 0 )               
1565       ENDIF   ! netcdf_extend   
1566#endif
1567 
1568    ELSEIF ( isdtyp == 0 )  THEN
1569!
1570!--    Mass fractions for species in a and b-bins
1571       IF ( iso4 > 0 )  THEN
1572          pvf2a(:,1) = mass_fracs_a(iso4) 
1573          pvf2b(:,1) = mass_fracs_b(iso4)
1574       ENDIF
1575       IF ( ioc > 0 )  THEN
1576          pvf2a(:,2) = mass_fracs_a(ioc)
1577          pvf2b(:,2) = mass_fracs_b(ioc) 
1578       ENDIF
1579       IF ( ibc > 0 )  THEN
1580          pvf2a(:,3) = mass_fracs_a(ibc) 
1581          pvf2b(:,3) = mass_fracs_b(ibc)
1582       ENDIF
1583       IF ( idu > 0 )  THEN
1584          pvf2a(:,4) = mass_fracs_a(idu)
1585          pvf2b(:,4) = mass_fracs_b(idu) 
1586       ENDIF
1587       IF ( iss > 0 )  THEN
1588          pvf2a(:,5) = mass_fracs_a(iss)
1589          pvf2b(:,5) = mass_fracs_b(iss) 
1590       ENDIF
1591       IF ( ino > 0 )  THEN
1592          pvf2a(:,6) = mass_fracs_a(ino)
1593          pvf2b(:,6) = mass_fracs_b(ino)
1594       ENDIF
1595       IF ( inh > 0 )  THEN
1596          pvf2a(:,7) = mass_fracs_a(inh)
1597          pvf2b(:,7) = mass_fracs_b(inh)
1598       ENDIF
1599       DO  k = nzb, nz+1
1600          pvf2a(k,:) = pvf2a(k,:) / SUM( pvf2a(k,:) )
1601          IF ( SUM( pvf2b(k,:) ) > 0.0_wp ) pvf2b(k,:) = pvf2b(k,:) /          &
1602                                                         SUM( pvf2b(k,:) )
1603       ENDDO
1604       
1605       CALL size_distribution( n_lognorm, dpg, sigmag, nsect )
1606!
1607!--    Normalize by the given total number concentration
1608       nsect = nsect * SUM( n_lognorm ) * 1.0E+6_wp / SUM( nsect )     
1609       DO  b = in1a, fn2b
1610          pndist(:,b) = nsect(b)
1611       ENDDO
1612    ENDIF
1613   
1614    IF ( igctyp == 1 )  THEN
1615!
1616!--    Read input profiles from PIDS_CHEM   
1617#if defined( __netcdf )
1618!   
1619!--    Location-dependent size distributions and compositions.     
1620       INQUIRE( FILE='PIDS_CHEM' // TRIM( coupling_char ), EXIST=netcdf_extend )
1621       IF ( netcdf_extend  .AND.  .NOT. salsa_gases_from_chem )  THEN
1622!
1623!--       Open file in read-only mode     
1624          CALL open_read_file( 'PIDS_CHEM' // TRIM( coupling_char ), id_fchem )
1625!
1626!--       Input heights   
1627          CALL netcdf_data_input_get_dimension_length( id_fchem, nz_file, "profile_z" ) 
1628          ALLOCATE( pr_z(nz_file), pr_gas(ngast,nz_file) ) 
1629          CALL get_variable( id_fchem, 'profile_z', pr_z ) 
1630!       
1631!--       Gases:
1632          CALL get_variable( id_fchem, "profile_H2SO4", pr_gas(1,:) )
1633          CALL get_variable( id_fchem, "profile_HNO3", pr_gas(2,:) )
1634          CALL get_variable( id_fchem, "profile_NH3", pr_gas(3,:) )
1635          CALL get_variable( id_fchem, "profile_OCNV", pr_gas(4,:) )
1636          CALL get_variable( id_fchem, "profile_OCSV", pr_gas(5,:) )
1637         
1638          kk = 1
1639          DO  k = nzb, nz+1
1640             IF ( kk < nz_file )  THEN
1641                DO  WHILE ( pr_z(kk+1) <= zu(k) )
1642                   kk = kk + 1
1643                   IF ( kk == nz_file )  EXIT
1644                ENDDO
1645             ENDIF
1646             IF ( kk < nz_file )  THEN
1647!             
1648!--             Set initial value for gas compound tracers and initial values
1649                DO  g = 1, ngast
1650                   salsa_gas(g)%init(k) =  pr_gas(g,kk) + ( zu(k) - pr_z(kk) ) &
1651                                           / ( pr_z(kk+1) - pr_z(kk) ) *       &
1652                                           ( pr_gas(g,kk+1) - pr_gas(g,kk) )
1653                   salsa_gas(g)%conc(k,:,:) = salsa_gas(g)%init(k)
1654                ENDDO
1655             ELSE
1656                DO  g = 1, ngast
1657                   salsa_gas(g)%init(k) =  pr_gas(g,kk) 
1658                   salsa_gas(g)%conc(k,:,:) = salsa_gas(g)%init(k)
1659                ENDDO
1660             ENDIF
1661          ENDDO
1662         
1663          DEALLOCATE( pr_z, pr_gas )
1664       ELSEIF ( .NOT. netcdf_extend  .AND.  .NOT.  salsa_gases_from_chem )  THEN
1665          message_string = 'Input file '// TRIM( 'PIDS_CHEM' ) //              &
1666                           TRIM( coupling_char ) // ' for SALSA missing!'
1667          CALL message( 'salsa_mod: aerosol_init', 'SA0033', 1, 2, 0, 6, 0 )               
1668       ENDIF   ! netcdf_extend     
1669#endif
1670
1671    ENDIF
1672
1673    IF ( ioc > 0  .AND.  iso4 > 0 )  THEN     
1674!--    Both are there, so use the given "massDistrA"
1675       pvfOC1a(:) = pvf2a(:,2) / ( pvf2a(:,2) + pvf2a(:,1) )  ! Normalize
1676    ELSEIF ( ioc > 0 )  THEN
1677!--    Pure organic carbon
1678       pvfOC1a(:) = 1.0_wp
1679    ELSEIF ( iso4 > 0 )  THEN
1680!--    Pure SO4
1681       pvfOC1a(:) = 0.0_wp   
1682    ELSE
1683       message_string = 'Either OC or SO4 must be active for aerosol region 1a!'
1684       CALL message( 'salsa_mod: aerosol_init', 'SA0021', 1, 2, 0, 6, 0 )
1685    ENDIF   
1686   
1687!
1688!-- Initialize concentrations
1689    DO  i = nxlg, nxrg 
1690       DO  j = nysg, nyng
1691          DO  k = nzb, nzt+1
1692!
1693!--          Predetermine flag to mask topography         
1694             flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_0(k,j,i), 0 ) )
1695!         
1696!--          a) Number concentrations
1697!--           Region 1:
1698             DO  b = in1a, fn1a
1699                aerosol_number(b)%conc(k,j,i) = pndist(k,b) * flag
1700                IF ( prunmode == 1 )  THEN
1701                   aerosol_number(b)%init = pndist(:,b)
1702                ENDIF
1703             ENDDO
1704!             
1705!--           Region 2:
1706             IF ( nreg > 1 )  THEN
1707                DO  b = in2a, fn2a
1708                   aerosol_number(b)%conc(k,j,i) = MAX( 0.0_wp, pnf2a(k) ) *   &
1709                                                    pndist(k,b) * flag
1710                   IF ( prunmode == 1 )  THEN
1711                      aerosol_number(b)%init = MAX( 0.0_wp, nf2a ) * pndist(:,b)
1712                   ENDIF
1713                ENDDO
1714                IF ( .NOT. no_insoluble )  THEN
1715                   DO  b = in2b, fn2b
1716                      IF ( pnf2a(k) < 1.0_wp )  THEN             
1717                         aerosol_number(b)%conc(k,j,i) = MAX( 0.0_wp, 1.0_wp   &
1718                                               - pnf2a(k) ) * pndist(k,b) * flag
1719                         IF ( prunmode == 1 )  THEN
1720                            aerosol_number(b)%init = MAX( 0.0_wp, 1.0_wp -     &
1721                                                          nf2a ) * pndist(:,b)
1722                         ENDIF
1723                      ENDIF
1724                   ENDDO
1725                ENDIF
1726             ENDIF
1727!
1728!--          b) Aerosol mass concentrations
1729!--             bin subrange 1: done here separately due to the SO4/OC convention
1730!--          SO4:
1731             IF ( iso4 > 0 )  THEN
1732                ss = ( iso4 - 1 ) * nbins + in1a !< start
1733                ee = ( iso4 - 1 ) * nbins + fn1a !< end
1734                b = in1a
1735                DO  c = ss, ee
1736                   aerosol_mass(c)%conc(k,j,i) = MAX( 0.0_wp, 1.0_wp -         &
1737                                                  pvfOC1a(k) ) * pndist(k,b) * &
1738                                                  core(b) * arhoh2so4 * flag
1739                   IF ( prunmode == 1 )  THEN
1740                      aerosol_mass(c)%init = MAX( 0.0_wp, 1.0_wp - MAXVAL(     &
1741                                             pvfOC1a ) ) * pndist(:,b) *       &
1742                                             core(b) * arhoh2so4
1743                   ENDIF
1744                   b = b+1
1745                ENDDO
1746             ENDIF
1747!--          OC:
1748             IF ( ioc > 0 ) THEN
1749                ss = ( ioc - 1 ) * nbins + in1a !< start
1750                ee = ( ioc - 1 ) * nbins + fn1a !< end
1751                b = in1a
1752                DO  c = ss, ee 
1753                   aerosol_mass(c)%conc(k,j,i) = MAX( 0.0_wp, pvfOC1a(k) ) *   &
1754                                           pndist(k,b) * core(b) * arhooc * flag
1755                   IF ( prunmode == 1 )  THEN
1756                      aerosol_mass(c)%init = MAX( 0.0_wp, MAXVAL( pvfOC1a ) )  &
1757                                             * pndist(:,b) *  core(b) * arhooc
1758                   ENDIF
1759                   b = b+1
1760                ENDDO 
1761             ENDIF
1762             
1763             prunmode = 3  ! Init only once
1764 
1765          ENDDO !< k
1766       ENDDO !< j
1767    ENDDO !< i
1768   
1769!
1770!-- c) Aerosol mass concentrations
1771!--    bin subrange 2:
1772    IF ( nreg > 1 ) THEN
1773   
1774       IF ( iso4 > 0 ) THEN
1775          CALL set_aero_mass( iso4, pvf2a(:,1), pvf2b(:,1), pnf2a, pndist,     &
1776                              core, arhoh2so4 )
1777       ENDIF
1778       IF ( ioc > 0 ) THEN
1779          CALL set_aero_mass( ioc, pvf2a(:,2), pvf2b(:,2), pnf2a, pndist, core,&
1780                              arhooc )
1781       ENDIF
1782       IF ( ibc > 0 ) THEN
1783          CALL set_aero_mass( ibc, pvf2a(:,3), pvf2b(:,3), pnf2a, pndist, core,&
1784                              arhobc )
1785       ENDIF
1786       IF ( idu > 0 ) THEN
1787          CALL set_aero_mass( idu, pvf2a(:,4), pvf2b(:,4), pnf2a, pndist, core,&
1788                              arhodu )
1789       ENDIF
1790       IF ( iss > 0 ) THEN
1791          CALL set_aero_mass( iss, pvf2a(:,5), pvf2b(:,5), pnf2a, pndist, core,&
1792                              arhoss )
1793       ENDIF
1794       IF ( ino > 0 ) THEN
1795          CALL set_aero_mass( ino, pvf2a(:,6), pvf2b(:,6), pnf2a, pndist, core,&
1796                              arhohno3 )
1797       ENDIF
1798       IF ( inh > 0 ) THEN
1799          CALL set_aero_mass( inh, pvf2a(:,7), pvf2b(:,7), pnf2a, pndist, core,&
1800                              arhonh3 )
1801       ENDIF
1802
1803    ENDIF
1804   
1805 END SUBROUTINE aerosol_init
1806 
1807!------------------------------------------------------------------------------!
1808! Description:
1809! ------------
1810!> Create a lognormal size distribution and discretise to a sectional
1811!> representation.
1812!------------------------------------------------------------------------------!
1813 SUBROUTINE size_distribution( in_ntot, in_dpg, in_sigma, psd_sect )
1814   
1815    IMPLICIT NONE
1816   
1817!-- Log-normal size distribution: modes   
1818    REAL(wp), DIMENSION(:), INTENT(in) ::  in_dpg    !< geometric mean diameter
1819                                                     !< (micrometres)
1820    REAL(wp), DIMENSION(:), INTENT(in) ::  in_ntot   !< number conc. (#/cm3)
1821    REAL(wp), DIMENSION(:), INTENT(in) ::  in_sigma  !< standard deviation
1822    REAL(wp), DIMENSION(:), INTENT(inout) ::  psd_sect !< sectional size
1823                                                       !< distribution
1824    INTEGER(iwp) ::  b          !< running index: bin
1825    INTEGER(iwp) ::  ib         !< running index: iteration
1826    REAL(wp) ::  d1             !< particle diameter (m, dummy)
1827    REAL(wp) ::  d2             !< particle diameter (m, dummy)
1828    REAL(wp) ::  delta_d        !< (d2-d1)/10                                                     
1829    REAL(wp) ::  deltadp        !< bin width
1830    REAL(wp) ::  dmidi          !< ( d1 + d2 ) / 2
1831   
1832    DO  b = in1a, fn2b !< aerosol size bins
1833       psd_sect(b) = 0.0_wp
1834!--    Particle diameter at the low limit (largest in the bin) (m)
1835       d1 = ( aero(b)%vlolim / api6 ) ** ( 1.0_wp / 3.0_wp )
1836!--    Particle diameter at the high limit (smallest in the bin) (m)
1837       d2 = ( aero(b)%vhilim / api6 ) ** ( 1.0_wp / 3.0_wp )
1838!--    Span of particle diameter in a bin (m)
1839       delta_d = ( d2 - d1 ) / 10.0_wp
1840!--    Iterate:             
1841       DO  ib = 1, 10
1842          d1 = ( aero(b)%vlolim / api6 ) ** ( 1.0_wp / 3.0_wp ) + ( ib - 1)    &
1843               * delta_d
1844          d2 = d1 + delta_d
1845          dmidi = ( d1 + d2 ) / 2.0_wp
1846          deltadp = LOG10( d2 / d1 )
1847         
1848!--       Size distribution
1849!--       in_ntot = total number, total area, or total volume concentration
1850!--       in_dpg = geometric-mean number, area, or volume diameter
1851!--       n(k) = number, area, or volume concentration in a bin
1852!--       n_lognorm and dpg converted to units of #/m3 and m
1853          psd_sect(b) = psd_sect(b) + SUM( in_ntot * 1.0E+6_wp * deltadp /     &
1854                     ( SQRT( 2.0_wp * pi ) * LOG10( in_sigma ) ) *             &
1855                     EXP( -LOG10( dmidi / ( 1.0E-6_wp * in_dpg ) )**2.0_wp /   &
1856                     ( 2.0_wp * LOG10( in_sigma ) ** 2.0_wp ) ) )
1857 
1858       ENDDO
1859    ENDDO
1860   
1861 END SUBROUTINE size_distribution
1862
1863!------------------------------------------------------------------------------!
1864! Description:
1865! ------------
1866!> Sets the mass concentrations to aerosol arrays in 2a and 2b.
1867!>
1868!> Tomi Raatikainen, FMI, 29.2.2016
1869!------------------------------------------------------------------------------!
1870 SUBROUTINE set_aero_mass( ispec, ppvf2a, ppvf2b, ppnf2a, ppndist, pcore, prho )
1871   
1872    IMPLICIT NONE
1873
1874    INTEGER(iwp), INTENT(in) :: ispec  !< Aerosol species index
1875    REAL(wp), INTENT(in) ::  pcore(nbins) !< Aerosol bin mid core volume   
1876    REAL(wp), INTENT(in) ::  ppndist(0:nz+1,nbins) !< Aerosol size distribution
1877    REAL(wp), INTENT(in) ::  ppnf2a(0:nz+1) !< Number fraction for 2a   
1878    REAL(wp), INTENT(in) ::  ppvf2a(0:nz+1) !< Mass distributions for a
1879    REAL(wp), INTENT(in) ::  ppvf2b(0:nz+1) !< and b bins   
1880    REAL(wp), INTENT(in) ::  prho !< Aerosol density
1881    INTEGER(iwp) ::  b  !< loop index
1882    INTEGER(iwp) ::  c  !< loop index       
1883    INTEGER(iwp) ::  ee !< index: end
1884    INTEGER(iwp) ::  i  !< loop index
1885    INTEGER(iwp) ::  j  !< loop index
1886    INTEGER(iwp) ::  k  !< loop index
1887    INTEGER(iwp) ::  prunmode  !< 1 = initialise
1888    INTEGER(iwp) ::  ss !< index: start
1889    REAL(wp) ::  flag   !< flag to mask topography grid points
1890   
1891    prunmode = 1
1892   
1893    DO i = nxlg, nxrg 
1894       DO j = nysg, nyng
1895          DO k = nzb, nzt+1 
1896!
1897!--          Predetermine flag to mask topography
1898             flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_0(k,j,i), 0 ) ) 
1899!             
1900!--          Regime 2a:
1901             ss = ( ispec - 1 ) * nbins + in2a
1902             ee = ( ispec - 1 ) * nbins + fn2a
1903             b = in2a
1904             DO c = ss, ee
1905                aerosol_mass(c)%conc(k,j,i) = MAX( 0.0_wp, ppvf2a(k) ) *       &
1906                               ppnf2a(k) * ppndist(k,b) * pcore(b) * prho * flag
1907                IF ( prunmode == 1 )  THEN
1908                   aerosol_mass(c)%init = MAX( 0.0_wp, MAXVAL( ppvf2a(:) ) ) * &
1909                                          MAXVAL( ppnf2a ) * pcore(b) * prho * &
1910                                          MAXVAL( ppndist(:,b) ) 
1911                ENDIF
1912                b = b+1
1913             ENDDO
1914!--          Regime 2b:
1915             IF ( .NOT. no_insoluble )  THEN
1916                ss = ( ispec - 1 ) * nbins + in2b
1917                ee = ( ispec - 1 ) * nbins + fn2b
1918                b = in2a
1919                DO c = ss, ee
1920                   aerosol_mass(c)%conc(k,j,i) = MAX( 0.0_wp, ppvf2b(k) ) * (  &
1921                                         1.0_wp - ppnf2a(k) ) * ppndist(k,b) * &
1922                                         pcore(b) * prho * flag
1923                   IF ( prunmode == 1 )  THEN
1924                      aerosol_mass(c)%init = MAX( 0.0_wp, MAXVAL( ppvf2b(:) ) )&
1925                                        * ( 1.0_wp - MAXVAL( ppnf2a ) ) *      &
1926                                        MAXVAL( ppndist(:,b) ) * pcore(b) * prho
1927                   ENDIF
1928                   b = b+1
1929                ENDDO
1930             ENDIF
1931             prunmode = 3  ! Init only once
1932          ENDDO
1933       ENDDO
1934    ENDDO
1935 END SUBROUTINE set_aero_mass
1936
1937!------------------------------------------------------------------------------!
1938! Description:
1939! ------------
1940!> Swapping of timelevels
1941!------------------------------------------------------------------------------!
1942 SUBROUTINE salsa_swap_timelevel( mod_count )
1943
1944    IMPLICIT NONE
1945
1946    INTEGER(iwp), INTENT(IN) ::  mod_count  !<
1947    INTEGER(iwp) ::  b  !<   
1948    INTEGER(iwp) ::  c  !<   
1949    INTEGER(iwp) ::  cc !<
1950    INTEGER(iwp) ::  g  !<
1951
1952!
1953!-- Example for prognostic variable "prog_var"
1954#if defined( __nopointer )
1955    IF ( myid == 0 )  THEN
1956       message_string =  ' SALSA runs only with POINTER Version'
1957       CALL message( 'salsa_swap_timelevel', 'SA0022', 1, 2, 0, 6, 0 )
1958    ENDIF
1959#else
1960   
1961    SELECT CASE ( mod_count )
1962
1963       CASE ( 0 )
1964
1965          DO  b = 1, nbins
1966             aerosol_number(b)%conc(nzb:nzt+1,nysg:nyng,nxlg:nxrg)   =>        &
1967                nconc_1(:,:,:,b)
1968             aerosol_number(b)%conc_p(nzb:nzt+1,nysg:nyng,nxlg:nxrg) =>        &
1969                nconc_2(:,:,:,b)
1970             DO  c = 1, ncc_tot
1971                cc = ( c-1 ) * nbins + b  ! required due to possible Intel18 bug
1972                aerosol_mass(cc)%conc(nzb:nzt+1,nysg:nyng,nxlg:nxrg)   =>      &
1973                   mconc_1(:,:,:,cc)
1974                aerosol_mass(cc)%conc_p(nzb:nzt+1,nysg:nyng,nxlg:nxrg) =>      &
1975                   mconc_2(:,:,:,cc)
1976             ENDDO
1977          ENDDO
1978         
1979          IF ( .NOT. salsa_gases_from_chem )  THEN
1980             DO  g = 1, ngast
1981                salsa_gas(g)%conc(nzb:nzt+1,nysg:nyng,nxlg:nxrg)   =>          &
1982                   gconc_1(:,:,:,g)
1983                salsa_gas(g)%conc_p(nzb:nzt+1,nysg:nyng,nxlg:nxrg) =>          &
1984                   gconc_2(:,:,:,g)
1985             ENDDO
1986          ENDIF
1987
1988       CASE ( 1 )
1989
1990          DO  b = 1, nbins
1991             aerosol_number(b)%conc(nzb:nzt+1,nysg:nyng,nxlg:nxrg)   =>        &
1992                nconc_2(:,:,:,b)
1993             aerosol_number(b)%conc_p(nzb:nzt+1,nysg:nyng,nxlg:nxrg) =>        &
1994                nconc_1(:,:,:,b)
1995             DO  c = 1, ncc_tot
1996                cc = ( c-1 ) * nbins + b  ! required due to possible Intel18 bug
1997                aerosol_mass(cc)%conc(nzb:nzt+1,nysg:nyng,nxlg:nxrg)   =>      &
1998                   mconc_2(:,:,:,cc)
1999                aerosol_mass(cc)%conc_p(nzb:nzt+1,nysg:nyng,nxlg:nxrg) =>      &
2000                   mconc_1(:,:,:,cc)
2001             ENDDO
2002          ENDDO
2003         
2004          IF ( .NOT. salsa_gases_from_chem )  THEN
2005             DO  g = 1, ngast
2006                salsa_gas(g)%conc(nzb:nzt+1,nysg:nyng,nxlg:nxrg)   =>          &
2007                   gconc_2(:,:,:,g)
2008                salsa_gas(g)%conc_p(nzb:nzt+1,nysg:nyng,nxlg:nxrg) =>          &
2009                   gconc_1(:,:,:,g)
2010             ENDDO
2011          ENDIF
2012
2013    END SELECT
2014#endif
2015
2016 END SUBROUTINE salsa_swap_timelevel
2017
2018
2019!------------------------------------------------------------------------------!
2020! Description:
2021! ------------
2022!> This routine reads the respective restart data.
2023!------------------------------------------------------------------------------!
2024 SUBROUTINE salsa_rrd_local 
2025
2026   
2027    IMPLICIT NONE
2028   
2029    CHARACTER (LEN=20) :: field_char   !<
2030    INTEGER(iwp) ::  b  !<   
2031    INTEGER(iwp) ::  c  !<
2032    INTEGER(iwp) ::  g  !<
2033    INTEGER(iwp) ::  i  !<
2034    INTEGER(iwp) ::  j  !<
2035    INTEGER(iwp) ::  k  !<   
2036   
2037    IF ( read_restart_data_salsa )  THEN
2038       READ ( 13 )  field_char
2039
2040       DO  WHILE ( TRIM( field_char ) /= '*** end salsa ***' )
2041       
2042          DO b = 1, nbins
2043             READ ( 13 )  aero(b)%vlolim
2044             READ ( 13 )  aero(b)%vhilim
2045             READ ( 13 )  aero(b)%dmid
2046             READ ( 13 )  aero(b)%vratiohi
2047             READ ( 13 )  aero(b)%vratiolo
2048          ENDDO
2049
2050          DO  i = nxl, nxr
2051             DO  j = nys, nyn
2052                DO k = nzb+1, nzt
2053                   DO  b = 1, nbins
2054                      READ ( 13 )  aerosol_number(b)%conc(k,j,i)
2055                      DO  c = 1, ncc_tot
2056                         READ ( 13 )  aerosol_mass((c-1)*nbins+b)%conc(k,j,i)
2057                      ENDDO
2058                   ENDDO
2059                   IF ( .NOT. salsa_gases_from_chem )  THEN
2060                      DO  g = 1, ngast
2061                         READ ( 13 )  salsa_gas(g)%conc(k,j,i)
2062                      ENDDO 
2063                   ENDIF
2064                ENDDO
2065             ENDDO
2066          ENDDO
2067
2068          READ ( 13 )  field_char
2069
2070       ENDDO
2071       
2072    ENDIF
2073
2074 END SUBROUTINE salsa_rrd_local
2075   
2076
2077!------------------------------------------------------------------------------!
2078! Description:
2079! ------------
2080!> This routine writes the respective restart data.
2081!> Note that the following input variables in PARIN have to be equal between
2082!> restart runs:
2083!>    listspec, nbin, nbin2, nf2a, ncc, mass_fracs_a, mass_fracs_b
2084!------------------------------------------------------------------------------!
2085 SUBROUTINE salsa_wrd_local
2086
2087    IMPLICIT NONE
2088   
2089    INTEGER(iwp) ::  b  !<   
2090    INTEGER(iwp) ::  c  !<
2091    INTEGER(iwp) ::  g  !<
2092    INTEGER(iwp) ::  i  !<
2093    INTEGER(iwp) ::  j  !<
2094    INTEGER(iwp) ::  k  !<
2095   
2096    IF ( write_binary  .AND.  write_binary_salsa )  THEN
2097       
2098       DO b = 1, nbins
2099          WRITE ( 14 )  aero(b)%vlolim
2100          WRITE ( 14 )  aero(b)%vhilim
2101          WRITE ( 14 )  aero(b)%dmid
2102          WRITE ( 14 )  aero(b)%vratiohi
2103          WRITE ( 14 )  aero(b)%vratiolo
2104       ENDDO
2105       
2106       DO  i = nxl, nxr
2107          DO  j = nys, nyn
2108             DO  k = nzb+1, nzt
2109                DO  b = 1, nbins
2110                   WRITE ( 14 )  aerosol_number(b)%conc(k,j,i)
2111                   DO  c = 1, ncc_tot
2112                      WRITE ( 14 )  aerosol_mass((c-1)*nbins+b)%conc(k,j,i)
2113                   ENDDO
2114                ENDDO
2115                IF ( .NOT. salsa_gases_from_chem )  THEN
2116                   DO  g = 1, ngast
2117                      WRITE ( 14 )  salsa_gas(g)%conc(k,j,i)
2118                   ENDDO 
2119                ENDIF
2120             ENDDO
2121          ENDDO
2122       ENDDO
2123       
2124       WRITE ( 14 )  '*** end salsa ***   '
2125         
2126    ENDIF
2127       
2128 END SUBROUTINE salsa_wrd_local   
2129
2130
2131!------------------------------------------------------------------------------!
2132! Description:
2133! ------------
2134!> Performs necessary unit and dimension conversion between the host model and
2135!> SALSA module, and calls the main SALSA routine.
2136!> Partially adobted form the original SALSA boxmodel version.
2137!> Now takes masses in as kg/kg from LES!! Converted to m3/m3 for SALSA
2138!> 05/2016 Juha: This routine is still pretty much in its original shape.
2139!>               It's dumb as a mule and twice as ugly, so implementation of
2140!>               an improved solution is necessary sooner or later.
2141!> Juha Tonttila, FMI, 2014
2142!> Jaakko Ahola, FMI, 2016
2143!> Only aerosol processes included, Mona Kurppa, UHel, 2017
2144!------------------------------------------------------------------------------!
2145 SUBROUTINE salsa_driver( i, j, prunmode )
2146
2147    USE arrays_3d,                                                             &
2148        ONLY: pt_p, q_p, rho_air_zw, u, v, w
2149       
2150    USE plant_canopy_model_mod,                                                &
2151        ONLY: lad_s
2152       
2153    USE surface_mod,                                                           &
2154        ONLY:  surf_def_h, surf_def_v, surf_lsm_h, surf_lsm_v, surf_usm_h,     &
2155               surf_usm_v
2156 
2157    IMPLICIT NONE
2158   
2159    INTEGER(iwp), INTENT(in) ::  i   !< loop index
2160    INTEGER(iwp), INTENT(in) ::  j   !< loop index
2161    INTEGER(iwp), INTENT(in) ::  prunmode !< 1: Initialization call
2162                                          !< 2: Spinup period call
2163                                          !< 3: Regular runtime call
2164!-- Local variables
2165    TYPE(t_section), DIMENSION(fn2b) ::  aero_old !< helper array
2166    INTEGER(iwp) ::  bb     !< loop index
2167    INTEGER(iwp) ::  cc     !< loop index
2168    INTEGER(iwp) ::  endi   !< end index
2169    INTEGER(iwp) ::  k_wall !< vertical index of topography top
2170    INTEGER(iwp) ::  k      !< loop index
2171    INTEGER(iwp) ::  l      !< loop index
2172    INTEGER(iwp) ::  nc_h2o !< index of H2O in the prtcl index table
2173    INTEGER(iwp) ::  ss     !< loop index
2174    INTEGER(iwp) ::  str    !< start index
2175    INTEGER(iwp) ::  vc     !< default index in prtcl
2176    REAL(wp) ::  cw_old     !< previous H2O mixing ratio
2177    REAL(wp) ::  flag       !< flag to mask topography grid points
2178    REAL(wp), DIMENSION(nzb:nzt+1) ::  in_adn !< air density (kg/m3)   
2179    REAL(wp), DIMENSION(nzb:nzt+1) ::  in_cs  !< H2O sat. vapour conc.
2180    REAL(wp), DIMENSION(nzb:nzt+1) ::  in_cw  !< H2O vapour concentration
2181    REAL(wp) ::  in_lad                       !< leaf area density (m2/m3)
2182    REAL(wp), DIMENSION(nzb:nzt+1) ::  in_p   !< pressure (Pa)     
2183    REAL(wp) ::  in_rh                        !< relative humidity                     
2184    REAL(wp), DIMENSION(nzb:nzt+1) ::  in_t   !< temperature (K)
2185    REAL(wp), DIMENSION(nzb:nzt+1) ::  in_u   !< wind magnitude (m/s)
2186    REAL(wp), DIMENSION(nzb:nzt+1) ::  kvis   !< kinematic viscosity of air(m2/s)                                           
2187    REAL(wp), DIMENSION(nzb:nzt+1,fn2b) ::  Sc      !< particle Schmidt number   
2188    REAL(wp), DIMENSION(nzb:nzt+1,fn2b) ::  vd      !< particle fall seed (m/s,
2189                                                    !< sedimentation velocity)
2190    REAL(wp), DIMENSION(nzb:nzt+1) ::  ppm_to_nconc !< Conversion factor
2191                                                    !< from ppm to #/m3                                                     
2192    REAL(wp) ::  zgso4  !< SO4
2193    REAL(wp) ::  zghno3 !< HNO3
2194    REAL(wp) ::  zgnh3  !< NH3
2195    REAL(wp) ::  zgocnv !< non-volatile OC
2196    REAL(wp) ::  zgocsv !< semi-volatile OC
2197   
2198    aero_old(:)%numc = 0.0_wp
2199    in_adn           = 0.0_wp   
2200    in_cs            = 0.0_wp
2201    in_cw            = 0.0_wp 
2202    in_lad           = 0.0_wp
2203    in_rh            = 0.0_wp
2204    in_p             = 0.0_wp 
2205    in_t             = 0.0_wp 
2206    in_u             = 0.0_wp
2207    kvis             = 0.0_wp
2208    Sc               = 0.0_wp
2209    vd               = 0.0_wp
2210    ppm_to_nconc     = 1.0_wp
2211    zgso4            = nclim
2212    zghno3           = nclim
2213    zgnh3            = nclim
2214    zgocnv           = nclim
2215    zgocsv           = nclim
2216   
2217!       
2218!-- Aerosol number is always set, but mass can be uninitialized
2219    DO cc = 1, nbins
2220       aero(cc)%volc     = 0.0_wp
2221       aero_old(cc)%volc = 0.0_wp
2222    ENDDO 
2223!   
2224!-- Set the salsa runtime config (How to make this more efficient?)
2225    CALL set_salsa_runtime( prunmode )
2226!             
2227!-- Calculate thermodynamic quantities needed in SALSA
2228    CALL salsa_thrm_ij( i, j, p_ij=in_p, temp_ij=in_t, cw_ij=in_cw,            &
2229                        cs_ij=in_cs, adn_ij=in_adn )
2230!
2231!-- Magnitude of wind: needed for deposition
2232    IF ( lsdepo )  THEN
2233       in_u(nzb+1:nzt) = SQRT(                                                 &
2234                   ( 0.5_wp * ( u(nzb+1:nzt,j,i) + u(nzb+1:nzt,j,i+1) ) )**2 + & 
2235                   ( 0.5_wp * ( v(nzb+1:nzt,j,i) + v(nzb+1:nzt,j+1,i) ) )**2 + &
2236                   ( 0.5_wp * ( w(nzb:nzt-1,j,i) + w(nzb+1:nzt,j,  i) ) )**2 )
2237    ENDIF
2238!
2239!-- Calculate conversion factors for gas concentrations
2240    ppm_to_nconc = for_ppm_to_nconc * in_p / in_t
2241!
2242!-- Determine topography-top index on scalar grid
2243    k_wall = MAXLOC( MERGE( 1, 0, BTEST( wall_flags_0(:,j,i), 12 ) ),          &
2244                     DIM = 1 ) - 1     
2245               
2246    DO k = nzb+1, nzt
2247!
2248!--    Predetermine flag to mask topography
2249       flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_0(k,j,i), 0 ) )
2250!       
2251!--    Do not run inside buildings       
2252       IF ( flag == 0.0_wp )  CYCLE   
2253!
2254!--    Wind velocity for dry depositon on vegetation   
2255       IF ( lsdepo_vege  .AND.  plant_canopy  )  THEN
2256          in_lad = lad_s(k-k_wall,j,i)
2257       ENDIF       
2258!
2259!--    For initialization and spinup, limit the RH with the parameter rhlim
2260       IF ( prunmode < 3 ) THEN
2261          in_cw(k) = MIN( in_cw(k), in_cs(k) * rhlim )
2262       ELSE
2263          in_cw(k) = in_cw(k)
2264       ENDIF
2265       cw_old = in_cw(k) !* in_adn(k)
2266!               
2267!--    Set volume concentrations:
2268!--    Sulphate (SO4) or sulphuric acid H2SO4
2269       IF ( iso4 > 0 )  THEN
2270          vc = 1
2271          str = ( iso4-1 ) * nbins + 1    ! start index
2272          endi = iso4 * nbins             ! end index
2273          cc = 1
2274          DO ss = str, endi
2275             aero(cc)%volc(vc) = aerosol_mass(ss)%conc(k,j,i) / arhoh2so4
2276             cc = cc+1
2277          ENDDO
2278          aero_old(1:nbins)%volc(vc) = aero(1:nbins)%volc(vc)
2279       ENDIF
2280       
2281!--    Organic carbon (OC) compounds
2282       IF ( ioc > 0 )  THEN
2283          vc = 2
2284          str = ( ioc-1 ) * nbins + 1
2285          endi = ioc * nbins
2286          cc = 1
2287          DO ss = str, endi
2288             aero(cc)%volc(vc) = aerosol_mass(ss)%conc(k,j,i) / arhooc 
2289             cc = cc+1
2290          ENDDO
2291          aero_old(1:nbins)%volc(vc) = aero(1:nbins)%volc(vc)
2292       ENDIF
2293       
2294!--    Black carbon (BC)
2295       IF ( ibc > 0 )  THEN
2296          vc = 3
2297          str = ( ibc-1 ) * nbins + 1 + fn1a
2298          endi = ibc * nbins
2299          cc = 1 + fn1a
2300          DO ss = str, endi
2301             aero(cc)%volc(vc) = aerosol_mass(ss)%conc(k,j,i) / arhobc 
2302             cc = cc+1
2303          ENDDO                   
2304          aero_old(1:nbins)%volc(vc) = aero(1:nbins)%volc(vc)
2305       ENDIF
2306
2307!--    Dust (DU)
2308       IF ( idu > 0 )  THEN
2309          vc = 4
2310          str = ( idu-1 ) * nbins + 1 + fn1a
2311          endi = idu * nbins
2312          cc = 1 + fn1a
2313          DO ss = str, endi
2314             aero(cc)%volc(vc) = aerosol_mass(ss)%conc(k,j,i) / arhodu 
2315             cc = cc+1
2316          ENDDO
2317          aero_old(1:nbins)%volc(vc) = aero(1:nbins)%volc(vc)
2318       ENDIF
2319
2320!--    Sea salt (SS)
2321       IF ( iss > 0 )  THEN
2322          vc = 5
2323          str = ( iss-1 ) * nbins + 1 + fn1a
2324          endi = iss * nbins
2325          cc = 1 + fn1a
2326          DO ss = str, endi
2327             aero(cc)%volc(vc) = aerosol_mass(ss)%conc(k,j,i) / arhoss 
2328             cc = cc+1
2329          ENDDO
2330          aero_old(1:nbins)%volc(vc) = aero(1:nbins)%volc(vc)
2331       ENDIF
2332
2333!--    Nitrate (NO(3-)) or nitric acid HNO3
2334       IF ( ino > 0 )  THEN
2335          vc = 6
2336          str = ( ino-1 ) * nbins + 1 
2337          endi = ino * nbins
2338          cc = 1
2339          DO ss = str, endi
2340             aero(cc)%volc(vc) = aerosol_mass(ss)%conc(k,j,i) / arhohno3 
2341             cc = cc+1
2342          ENDDO
2343          aero_old(1:nbins)%volc(vc) = aero(1:nbins)%volc(vc)
2344       ENDIF
2345
2346!--    Ammonium (NH(4+)) or ammonia NH3
2347       IF ( inh > 0 )  THEN
2348          vc = 7
2349          str = ( inh-1 ) * nbins + 1
2350          endi = inh * nbins
2351          cc = 1
2352          DO ss = str, endi
2353             aero(cc)%volc(vc) = aerosol_mass(ss)%conc(k,j,i) / arhonh3 
2354             cc = cc+1
2355          ENDDO
2356          aero_old(1:nbins)%volc(vc) = aero(1:nbins)%volc(vc)
2357       ENDIF
2358
2359!--    Water (always used)
2360       nc_h2o = get_index( prtcl,'H2O' )
2361       vc = 8
2362       str = ( nc_h2o-1 ) * nbins + 1
2363       endi = nc_h2o * nbins
2364       cc = 1
2365       IF ( advect_particle_water )  THEN
2366          DO ss = str, endi
2367             aero(cc)%volc(vc) = aerosol_mass(ss)%conc(k,j,i) / arhoh2o 
2368             cc = cc+1
2369          ENDDO
2370       ELSE
2371         aero(1:nbins)%volc(vc) = mclim 
2372       ENDIF
2373       aero_old(1:nbins)%volc(vc) = aero(1:nbins)%volc(vc)
2374!
2375!--    Number concentrations (numc) and particle sizes
2376!--    (dwet = wet diameter, core = dry volume)
2377       DO  bb = 1, nbins
2378          aero(bb)%numc = aerosol_number(bb)%conc(k,j,i) 
2379          aero_old(bb)%numc = aero(bb)%numc
2380          IF ( aero(bb)%numc > nclim )  THEN
2381             aero(bb)%dwet = ( SUM( aero(bb)%volc(:) ) / aero(bb)%numc / api6 )&
2382                                **( 1.0_wp / 3.0_wp )
2383             aero(bb)%core = SUM( aero(bb)%volc(1:7) ) / aero(bb)%numc 
2384          ELSE
2385             aero(bb)%dwet = aero(bb)%dmid
2386             aero(bb)%core = api6 * ( aero(bb)%dwet ) ** 3.0_wp
2387          ENDIF
2388       ENDDO
2389!       
2390!--    On EACH call of salsa_driver, calculate the ambient sizes of
2391!--    particles by equilibrating soluble fraction of particles with water
2392!--    using the ZSR method.
2393       in_rh = in_cw(k) / in_cs(k)
2394       IF ( prunmode==1  .OR.  .NOT. advect_particle_water )  THEN
2395          CALL equilibration( in_rh, in_t(k), aero, .TRUE. )
2396       ENDIF
2397!
2398!--    Gaseous tracer concentrations in #/m3
2399       IF ( salsa_gases_from_chem )  THEN       
2400!       
2401!--       Convert concentrations in ppm to #/m3
2402          zgso4  = chem_species(gas_index_chem(1))%conc(k,j,i) * ppm_to_nconc(k)
2403          zghno3 = chem_species(gas_index_chem(2))%conc(k,j,i) * ppm_to_nconc(k)
2404          zgnh3  = chem_species(gas_index_chem(3))%conc(k,j,i) * ppm_to_nconc(k)
2405          zgocnv = chem_species(gas_index_chem(4))%conc(k,j,i) * ppm_to_nconc(k)     
2406          zgocsv = chem_species(gas_index_chem(5))%conc(k,j,i) * ppm_to_nconc(k)                 
2407       ELSE
2408          zgso4  = salsa_gas(1)%conc(k,j,i) 
2409          zghno3 = salsa_gas(2)%conc(k,j,i) 
2410          zgnh3  = salsa_gas(3)%conc(k,j,i) 
2411          zgocnv = salsa_gas(4)%conc(k,j,i) 
2412          zgocsv = salsa_gas(5)%conc(k,j,i)
2413       ENDIF   
2414!
2415!--    ***************************************!
2416!--                   Run SALSA               !
2417!--    ***************************************!
2418       CALL run_salsa( in_p(k), in_cw(k), in_cs(k), in_t(k), in_u(k),          &
2419                       in_adn(k), in_lad, zgso4, zgocnv, zgocsv, zghno3, zgnh3,&
2420                       aero, prtcl, kvis(k), Sc(k,:), vd(k,:), dt_salsa )
2421!--    ***************************************!
2422       IF ( lsdepo ) sedim_vd(k,j,i,:) = vd(k,:)
2423!                           
2424!--    Calculate changes in concentrations
2425       DO bb = 1, nbins
2426          aerosol_number(bb)%conc(k,j,i) = aerosol_number(bb)%conc(k,j,i)      &
2427                                 +  ( aero(bb)%numc - aero_old(bb)%numc ) * flag
2428       ENDDO
2429       
2430       IF ( iso4 > 0 )  THEN
2431          vc = 1
2432          str = ( iso4-1 ) * nbins + 1
2433          endi = iso4 * nbins
2434          cc = 1
2435          DO ss = str, endi
2436             aerosol_mass(ss)%conc(k,j,i) = aerosol_mass(ss)%conc(k,j,i)       &
2437                               + ( aero(cc)%volc(vc) - aero_old(cc)%volc(vc) ) &
2438                               * arhoh2so4 * flag
2439             cc = cc+1
2440          ENDDO
2441       ENDIF
2442       
2443       IF ( ioc > 0 )  THEN
2444          vc = 2
2445          str = ( ioc-1 ) * nbins + 1
2446          endi = ioc * nbins
2447          cc = 1
2448          DO ss = str, endi
2449             aerosol_mass(ss)%conc(k,j,i) = aerosol_mass(ss)%conc(k,j,i)       &
2450                               + ( aero(cc)%volc(vc) - aero_old(cc)%volc(vc) ) &
2451                               * arhooc * flag
2452             cc = cc+1
2453          ENDDO
2454       ENDIF
2455       
2456       IF ( ibc > 0 )  THEN
2457          vc = 3
2458          str = ( ibc-1 ) * nbins + 1 + fn1a
2459          endi = ibc * nbins
2460          cc = 1 + fn1a
2461          DO ss = str, endi
2462             aerosol_mass(ss)%conc(k,j,i) = aerosol_mass(ss)%conc(k,j,i)       &
2463                               + ( aero(cc)%volc(vc) - aero_old(cc)%volc(vc) ) &
2464                               * arhobc * flag 
2465             cc = cc+1
2466          ENDDO
2467       ENDIF
2468       
2469       IF ( idu > 0 )  THEN
2470          vc = 4
2471          str = ( idu-1 ) * nbins + 1 + fn1a
2472          endi = idu * nbins
2473          cc = 1 + fn1a
2474          DO ss = str, endi
2475             aerosol_mass(ss)%conc(k,j,i) = aerosol_mass(ss)%conc(k,j,i)       &
2476                               + ( aero(cc)%volc(vc) - aero_old(cc)%volc(vc) ) &
2477                               * arhodu * flag
2478             cc = cc+1
2479          ENDDO
2480       ENDIF
2481       
2482       IF ( iss > 0 )  THEN
2483          vc = 5
2484          str = ( iss-1 ) * nbins + 1 + fn1a
2485          endi = iss * nbins
2486          cc = 1 + fn1a
2487          DO ss = str, endi
2488             aerosol_mass(ss)%conc(k,j,i) = aerosol_mass(ss)%conc(k,j,i)       &
2489                               + ( aero(cc)%volc(vc) - aero_old(cc)%volc(vc) ) &
2490                               * arhoss * flag
2491             cc = cc+1
2492          ENDDO
2493       ENDIF
2494       
2495       IF ( ino > 0 )  THEN
2496          vc = 6
2497          str = ( ino-1 ) * nbins + 1
2498          endi = ino * nbins
2499          cc = 1
2500          DO ss = str, endi
2501             aerosol_mass(ss)%conc(k,j,i) = aerosol_mass(ss)%conc(k,j,i)       &
2502                               + ( aero(cc)%volc(vc) - aero_old(cc)%volc(vc) ) &
2503                               * arhohno3 * flag
2504             cc = cc+1
2505          ENDDO
2506       ENDIF
2507       
2508       IF ( inh > 0 )  THEN
2509          vc = 7
2510          str = ( ino-1 ) * nbins + 1
2511          endi = ino * nbins
2512          cc = 1
2513          DO ss = str, endi
2514             aerosol_mass(ss)%conc(k,j,i) = aerosol_mass(ss)%conc(k,j,i)       &
2515                               + ( aero(cc)%volc(vc) - aero_old(cc)%volc(vc) ) &
2516                               * arhonh3 * flag
2517             cc = cc+1
2518          ENDDO
2519       ENDIF
2520       
2521       IF ( advect_particle_water )  THEN
2522          nc_h2o = get_index( prtcl,'H2O' )
2523          vc = 8
2524          str = ( nc_h2o-1 ) * nbins + 1
2525          endi = nc_h2o * nbins
2526          cc = 1
2527          DO ss = str, endi
2528             aerosol_mass(ss)%conc(k,j,i) = aerosol_mass(ss)%conc(k,j,i)       &
2529                               + ( aero(cc)%volc(vc) - aero_old(cc)%volc(vc) ) &
2530                               * arhoh2o * flag
2531             IF ( prunmode == 1 )  THEN
2532                aerosol_mass(ss)%init(k) = MAX( aerosol_mass(ss)%init(k),      &
2533                                               aerosol_mass(ss)%conc(k,j,i) )
2534             ENDIF
2535             cc = cc+1                             
2536          ENDDO
2537       ENDIF
2538
2539!--    Condensation of precursor gases
2540       IF ( lscndgas )  THEN
2541          IF ( salsa_gases_from_chem )  THEN         
2542!         
2543!--          SO4 (or H2SO4)
2544             chem_species( gas_index_chem(1) )%conc(k,j,i) =                &
2545                            chem_species( gas_index_chem(1) )%conc(k,j,i) + &
2546                                                  ( zgso4 / ppm_to_nconc(k) - &
2547                       chem_species( gas_index_chem(1) )%conc(k,j,i) ) * flag
2548!                           
2549!--          HNO3
2550             chem_species( gas_index_chem(2) )%conc(k,j,i) =                &
2551                            chem_species( gas_index_chem(2) )%conc(k,j,i) + &
2552                                                 ( zghno3 / ppm_to_nconc(k) - &
2553                       chem_species( gas_index_chem(2) )%conc(k,j,i) ) * flag
2554!                           
2555!--          NH3
2556             chem_species( gas_index_chem(3) )%conc(k,j,i) =                &
2557                            chem_species( gas_index_chem(3) )%conc(k,j,i) + &
2558                                                  ( zgnh3 / ppm_to_nconc(k) - &
2559                       chem_species( gas_index_chem(3) )%conc(k,j,i) ) * flag
2560!                           
2561!--          non-volatile OC
2562             chem_species( gas_index_chem(4) )%conc(k,j,i) =                &
2563                            chem_species( gas_index_chem(4) )%conc(k,j,i) + &
2564                                                 ( zgocnv / ppm_to_nconc(k) - &
2565                       chem_species( gas_index_chem(4) )%conc(k,j,i) ) * flag
2566!                           
2567!--          semi-volatile OC
2568             chem_species( gas_index_chem(5) )%conc(k,j,i) =                &
2569                            chem_species( gas_index_chem(5) )%conc(k,j,i) + &
2570                                                 ( zgocsv / ppm_to_nconc(k) - &
2571                       chem_species( gas_index_chem(5) )%conc(k,j,i) ) * flag                 
2572         
2573          ELSE
2574!         
2575!--          SO4 (or H2SO4)
2576             salsa_gas(1)%conc(k,j,i) = salsa_gas(1)%conc(k,j,i) + ( zgso4 -   &
2577                                          salsa_gas(1)%conc(k,j,i) ) * flag
2578!                           
2579!--          HNO3
2580             salsa_gas(2)%conc(k,j,i) = salsa_gas(2)%conc(k,j,i) + ( zghno3 -  &
2581                                          salsa_gas(2)%conc(k,j,i) ) * flag
2582!                           
2583!--          NH3
2584             salsa_gas(3)%conc(k,j,i) = salsa_gas(3)%conc(k,j,i) + ( zgnh3 -   &
2585                                          salsa_gas(3)%conc(k,j,i) ) * flag
2586!                           
2587!--          non-volatile OC
2588             salsa_gas(4)%conc(k,j,i) = salsa_gas(4)%conc(k,j,i) + ( zgocnv -  &
2589                                          salsa_gas(4)%conc(k,j,i) ) * flag
2590!                           
2591!--          semi-volatile OC
2592             salsa_gas(5)%conc(k,j,i) = salsa_gas(5)%conc(k,j,i) + ( zgocsv -  &
2593                                          salsa_gas(5)%conc(k,j,i) ) * flag
2594          ENDIF
2595       ENDIF
2596!               
2597!--    Tendency of water vapour mixing ratio is obtained from the
2598!--    change in RH during SALSA run. This releases heat and changes pt.
2599!--    Assumes no temperature change during SALSA run.
2600!--    q = r / (1+r), Euler method for integration
2601!
2602       IF ( feedback_to_palm )  THEN
2603          q_p(k,j,i) = q_p(k,j,i) + 1.0_wp / ( in_cw(k) * in_adn(k) + 1.0_wp ) &
2604                       ** 2.0_wp * ( in_cw(k) - cw_old ) * in_adn(k) 
2605          pt_p(k,j,i) = pt_p(k,j,i) + alv / c_p * ( in_cw(k) - cw_old ) *      &
2606                        in_adn(k) / ( in_cw(k) / in_adn(k) + 1.0_wp ) ** 2.0_wp&
2607                        * pt_p(k,j,i) / in_t(k)
2608       ENDIF
2609                         
2610    ENDDO   ! k
2611!   
2612!-- Set surfaces and wall fluxes due to deposition 
2613    IF ( lsdepo_topo  .AND.  prunmode == 3 )  THEN
2614       IF ( .NOT. land_surface  .AND.  .NOT. urban_surface )  THEN
2615          CALL depo_topo( i, j, surf_def_h(0), vd, Sc, kvis, in_u, rho_air_zw )
2616          DO  l = 0, 3
2617             CALL depo_topo( i, j, surf_def_v(l), vd, Sc, kvis, in_u,          &
2618                             rho_air_zw**0.0_wp )
2619          ENDDO
2620       ELSE
2621          CALL depo_topo( i, j, surf_usm_h, vd, Sc, kvis, in_u, rho_air_zw )
2622          DO  l = 0, 3
2623             CALL depo_topo( i, j, surf_usm_v(l), vd, Sc, kvis, in_u,          &
2624                             rho_air_zw**0.0_wp )
2625          ENDDO
2626          CALL depo_topo( i, j, surf_lsm_h, vd, Sc, kvis, in_u, rho_air_zw )
2627          DO  l = 0, 3
2628             CALL depo_topo( i, j, surf_lsm_v(l), vd, Sc, kvis, in_u,          &
2629                             rho_air_zw**0.0_wp )
2630          ENDDO
2631       ENDIF
2632    ENDIF
2633   
2634 END SUBROUTINE salsa_driver
2635
2636!------------------------------------------------------------------------------!
2637! Description:
2638! ------------
2639!> The SALSA subroutine
2640!> Modified for the new aerosol datatype,
2641!> Juha Tonttila, FMI, 2014.
2642!> Only aerosol processes included, Mona Kurppa, UHel, 2017
2643!------------------------------------------------------------------------------!   
2644 SUBROUTINE run_salsa( ppres, pcw, pcs, ptemp, mag_u, adn, lad, pc_h2so4,      &
2645                       pc_ocnv, pc_ocsv, pc_hno3, pc_nh3, paero, prtcl, kvis,  &
2646                       Sc, vc, ptstep )
2647
2648    IMPLICIT NONE
2649!
2650!-- Input parameters and variables
2651    REAL(wp), INTENT(in) ::  adn    !< air density (kg/m3)
2652    REAL(wp), INTENT(in) ::  lad    !< leaf area density (m2/m3)
2653    REAL(wp), INTENT(in) ::  mag_u  !< magnitude of wind (m/s)
2654    REAL(wp), INTENT(in) ::  ppres  !< atmospheric pressure at each grid
2655                                    !< point (Pa)
2656    REAL(wp), INTENT(in) ::  ptemp  !< temperature at each grid point (K)
2657    REAL(wp), INTENT(in) ::  ptstep !< time step of salsa processes (s)
2658    TYPE(component_index), INTENT(in) :: prtcl  !< part. component index table
2659!       
2660!-- Input variables that are changed within:
2661    REAL(wp), INTENT(inout) ::  kvis     !< kinematic viscosity of air (m2/s)
2662    REAL(wp), INTENT(inout) ::  Sc(:)    !< particle Schmidt number
2663    REAL(wp), INTENT(inout) ::  vc(:)    !< particle fall speed (m/s,
2664                                         !< sedimentation velocity)
2665!-- Gas phase concentrations at each grid point (#/m3)
2666    REAL(wp), INTENT(inout) ::  pc_h2so4 !< sulphuric acid
2667    REAL(wp), INTENT(inout) ::  pc_hno3  !< nitric acid
2668    REAL(wp), INTENT(inout) ::  pc_nh3   !< ammonia
2669    REAL(wp), INTENT(inout) ::  pc_ocnv  !< nonvolatile OC
2670    REAL(wp), INTENT(inout) ::  pc_ocsv  !< semivolatile OC
2671    REAL(wp), INTENT(inout) ::  pcs      !< Saturation concentration of water
2672                                         !< vapour (kg/m3)
2673    REAL(wp), INTENT(inout) ::  pcw      !< Water vapour concentration (kg/m3)                                                   
2674    TYPE(t_section), INTENT(inout) ::  paero(fn2b) 
2675!
2676!-- Coagulation
2677    IF ( lscoag )   THEN
2678       CALL coagulation( paero, ptstep, ptemp, ppres )
2679    ENDIF
2680!
2681!-- Condensation
2682    IF ( lscnd )   THEN
2683       CALL condensation( paero, pc_h2so4, pc_ocnv, pc_ocsv,  pc_hno3, pc_nh3, &
2684                          pcw, pcs, ptemp, ppres, ptstep, prtcl )
2685    ENDIF   
2686!   
2687!-- Deposition
2688    IF ( lsdepo )  THEN
2689       CALL deposition( paero, ptemp, adn, mag_u, lad, kvis, Sc, vc ) 
2690    ENDIF       
2691!
2692!-- Size distribution bin update
2693!-- Mona: why done 3 times in SALSA-standalone?
2694    IF ( lsdistupdate )   THEN
2695       CALL distr_update( paero )
2696    ENDIF
2697   
2698  END SUBROUTINE run_salsa 
2699 
2700!------------------------------------------------------------------------------!
2701! Description:
2702! ------------
2703!> Set logical switches according to the host model state and user-specified
2704!> NAMELIST options.
2705!> Juha Tonttila, FMI, 2014
2706!> Only aerosol processes included, Mona Kurppa, UHel, 2017
2707!------------------------------------------------------------------------------!
2708 SUBROUTINE set_salsa_runtime( prunmode )
2709 
2710    IMPLICIT NONE
2711   
2712    INTEGER(iwp), INTENT(in) ::  prunmode
2713   
2714    SELECT CASE(prunmode)
2715
2716       CASE(1) !< Initialization
2717          lscoag       = .FALSE.
2718          lscnd        = .FALSE.
2719          lscndgas     = .FALSE.
2720          lscndh2oae   = .FALSE.
2721          lsdepo       = .FALSE.
2722          lsdepo_vege  = .FALSE.
2723          lsdepo_topo  = .FALSE.
2724          lsdistupdate = .TRUE.
2725
2726       CASE(2)  !< Spinup period
2727          lscoag      = ( .FALSE. .AND. nlcoag   )
2728          lscnd       = ( .TRUE.  .AND. nlcnd    )
2729          lscndgas    = ( .TRUE.  .AND. nlcndgas )
2730          lscndh2oae  = ( .TRUE.  .AND. nlcndh2oae )
2731
2732       CASE(3)  !< Run
2733          lscoag       = nlcoag
2734          lscnd        = nlcnd
2735          lscndgas     = nlcndgas
2736          lscndh2oae   = nlcndh2oae
2737          lsdepo       = nldepo
2738          lsdepo_vege  = nldepo_vege
2739          lsdepo_topo  = nldepo_topo
2740          lsdistupdate = nldistupdate
2741
2742    END SELECT
2743
2744
2745 END SUBROUTINE set_salsa_runtime 
2746 
2747!------------------------------------------------------------------------------!
2748! Description:
2749! ------------
2750!> Calculates the absolute temperature (using hydrostatic pressure), saturation
2751!> vapour pressure and mixing ratio over water, relative humidity and air
2752!> density needed in the SALSA model.
2753!> NOTE, no saturation adjustment takes place -> the resulting water vapour
2754!> mixing ratio can be supersaturated, allowing the microphysical calculations
2755!> in SALSA.
2756!
2757!> Juha Tonttila, FMI, 2014 (original SALSAthrm)
2758!> Mona Kurppa, UHel, 2017 (adjustment for PALM and only aerosol processes)
2759!------------------------------------------------------------------------------!
2760 SUBROUTINE salsa_thrm_ij( i, j, p_ij, temp_ij, cw_ij, cs_ij, adn_ij )
2761 
2762    USE arrays_3d,                                                             &
2763        ONLY: p, pt, q, zu
2764       
2765    USE basic_constants_and_equations_mod,                                     &
2766        ONLY:  barometric_formula, exner_function, ideal_gas_law_rho, magnus 
2767       
2768    USE control_parameters,                                                    &
2769        ONLY: pt_surface, surface_pressure
2770       
2771    IMPLICIT NONE
2772   
2773    INTEGER(iwp), INTENT(in) ::  i
2774    INTEGER(iwp), INTENT(in) ::  j 
2775    REAL(wp), DIMENSION(:), INTENT(inout) ::  adn_ij
2776    REAL(wp), DIMENSION(:), INTENT(inout) ::  p_ij       
2777    REAL(wp), DIMENSION(:), INTENT(inout) ::  temp_ij
2778    REAL(wp), DIMENSION(:), INTENT(inout), OPTIONAL ::  cw_ij
2779    REAL(wp), DIMENSION(:), INTENT(inout), OPTIONAL ::  cs_ij 
2780    REAL(wp), DIMENSION(nzb:nzt+1) ::  e_s !< saturation vapour pressure
2781                                           !< over water (Pa)
2782    REAL(wp) ::  t_surface !< absolute surface temperature (K)
2783!
2784!-- Pressure p_ijk (Pa) = hydrostatic pressure + perturbation pressure (p)
2785    t_surface = pt_surface * exner_function( surface_pressure )
2786    p_ij(:) = 100.0_wp * barometric_formula( zu, t_surface, surface_pressure ) &
2787              + p(:,j,i)
2788!             
2789!-- Absolute ambient temperature (K)
2790    temp_ij(:) = pt(:,j,i) * exner_function( p_ij(:) )       
2791!
2792!-- Air density
2793    adn_ij(:) = ideal_gas_law_rho( p_ij(:), temp_ij(:) )
2794!
2795!-- Water vapour concentration r_v (kg/m3)
2796    IF ( PRESENT( cw_ij ) )  THEN
2797       cw_ij(:) = ( q(:,j,i) / ( 1.0_wp - q(:,j,i) ) ) * adn_ij(:) 
2798    ENDIF
2799!
2800!-- Saturation mixing ratio r_s (kg/kg) from vapour pressure at temp (Pa)
2801    IF ( PRESENT( cs_ij ) )  THEN
2802       e_s(:) = magnus( temp_ij(:) ) 
2803       cs_ij(:) = ( 0.622_wp * e_s / ( p_ij(:) - e_s(:) ) ) * adn_ij(:) 
2804    ENDIF
2805   
2806 END SUBROUTINE salsa_thrm_ij 
2807
2808!------------------------------------------------------------------------------!
2809! Description:
2810! ------------
2811!> Calculates ambient sizes of particles by equilibrating soluble fraction of
2812!> particles with water using the ZSR method (Stokes and Robinson, 1966).
2813!> Method:
2814!> Following chemical components are assumed water-soluble
2815!> - (ammonium) sulphate (100%)
2816!> - sea salt (100 %)
2817!> - organic carbon (epsoc * 100%)
2818!> Exact thermodynamic considerations neglected.
2819!> - If particles contain no sea salt, calculation according to sulphate
2820!>   properties
2821!> - If contain sea salt but no sulphate, calculation according to sea salt
2822!>   properties
2823!> - If contain both sulphate and sea salt -> the molar fraction of these
2824!>   compounds determines which one of them is used as the basis of calculation.
2825!> If sulphate and sea salt coexist in a particle, it is assumed that the Cl is
2826!> replaced by sulphate; thus only either sulphate + organics or sea salt +
2827!> organics is included in the calculation of soluble fraction.
2828!> Molality parameterizations taken from Table 1 of Tang: Thermodynamic and
2829!> optical properties of mixed-salt aerosols of atmospheric importance,
2830!> J. Geophys. Res., 102 (D2), 1883-1893 (1997)
2831!
2832!> Coded by:
2833!> Hannele Korhonen (FMI) 2005
2834!> Harri Kokkola (FMI) 2006
2835!> Matti Niskanen(FMI) 2012
2836!> Anton Laakso  (FMI) 2013
2837!> Modified for the new aerosol datatype, Juha Tonttila (FMI) 2014
2838!
2839!> fxm: should sea salt form a solid particle when prh is very low (even though
2840!> it could be mixed with e.g. sulphate)?
2841!> fxm: crashes if no sulphate or sea salt
2842!> fxm: do we really need to consider Kelvin effect for subrange 2
2843!------------------------------------------------------------------------------!     
2844 SUBROUTINE equilibration( prh, ptemp, paero, init )
2845     
2846    IMPLICIT NONE
2847!
2848!-- Input variables
2849    LOGICAL, INTENT(in) ::  init   !< TRUE: Initialization call
2850                                   !< FALSE: Normal runtime: update water
2851                                   !<        content only for 1a
2852    REAL(wp), INTENT(in) ::  prh   !< relative humidity [0-1]
2853    REAL(wp), INTENT(in) ::  ptemp !< temperature (K)
2854!
2855!-- Output variables
2856    TYPE(t_section), INTENT(inout) ::  paero(fn2b)     
2857!
2858!-- Local
2859    INTEGER(iwp) :: b      !< loop index
2860    INTEGER(iwp) :: counti  !< loop index
2861    REAL(wp) ::  zaw        !< water activity [0-1]       
2862    REAL(wp) ::  zbinmol(7) !< binary molality of each components (mol/kg)
2863    REAL(wp) ::  zcore      !< Volume of dry particle   
2864    REAL(wp) ::  zdold      !< Old diameter
2865    REAL(wp) ::  zdwet      !< Wet diameter or mean droplet diameter
2866    REAL(wp) ::  zke        !< Kelvin term in the Köhler equation
2867    REAL(wp) ::  zlwc       !< liquid water content [kg/m3-air]
2868    REAL(wp) ::  zrh        !< Relative humidity
2869    REAL(wp) ::  zvpart(7)  !< volume of chem. compounds in one particle
2870   
2871    zaw       = 0.0_wp
2872    zbinmol   = 0.0_wp
2873    zcore     = 0.0_wp
2874    zdold     = 0.0_wp
2875    zdwet     = 0.0_wp
2876    zlwc      = 0.0_wp
2877    zrh       = 0.0_wp
2878   
2879!               
2880!-- Relative humidity:
2881    zrh = prh
2882    zrh = MAX( zrh, 0.05_wp )
2883    zrh = MIN( zrh, 0.98_wp)   
2884!
2885!-- 1) Regime 1: sulphate and partly water-soluble OC. Done for every CALL
2886    DO  b = in1a, fn1a   ! size bin
2887         
2888       zbinmol = 0.0_wp
2889       zdold   = 1.0_wp 
2890       zke     = 1.02_wp
2891       
2892       IF ( paero(b)%numc > nclim )  THEN
2893!
2894!--       Volume in one particle
2895          zvpart = 0.0_wp
2896          zvpart(1:2) = paero(b)%volc(1:2) / paero(b)%numc
2897          zvpart(6:7) = paero(b)%volc(6:7) / paero(b)%numc
2898!               
2899!--       Total volume and wet diameter of one dry particle
2900          zcore = SUM( zvpart(1:2) )
2901          zdwet = paero(b)%dwet
2902         
2903          counti = 0
2904          DO  WHILE ( ABS( zdwet / zdold - 1.0_wp ) > 1.0E-2_wp ) 
2905         
2906             zdold = MAX( zdwet, 1.0E-20_wp )
2907             zaw = MAX( 1.0E-3_wp, zrh / zke ) ! To avoid underflow
2908!                   
2909!--          Binary molalities (mol/kg):
2910!--          Sulphate
2911             zbinmol(1) = 1.1065495E+2_wp - 3.6759197E+2_wp * zaw              &
2912                                          + 5.0462934E+2_wp * zaw**2.0_wp      &
2913                                          - 3.1543839E+2_wp * zaw**3.0_wp      &
2914                                          + 6.770824E+1_wp  * zaw**4.0_wp 
2915!--          Organic carbon                     
2916             zbinmol(2) = 1.0_wp / ( zaw * amh2o ) - 1.0_wp / amh2o 
2917!--          Nitric acid                             
2918             zbinmol(6) = 2.306844303E+1_wp - 3.563608869E+1_wp * zaw          &
2919                                            - 6.210577919E+1_wp * zaw**2.0_wp  &
2920                                            + 5.510176187E+2_wp * zaw**3.0_wp  &
2921                                            - 1.460055286E+3_wp * zaw**4.0_wp  &
2922                                            + 1.894467542E+3_wp * zaw**5.0_wp  &
2923                                            - 1.220611402E+3_wp * zaw**6.0_wp  &
2924                                            + 3.098597737E+2_wp * zaw**7.0_wp 
2925!
2926!--          Calculate the liquid water content (kg/m3-air) using ZSR (see e.g.
2927!--          Eq. 10.98 in Seinfeld and Pandis (2006))
2928             zlwc = ( paero(b)%volc(1) * ( arhoh2so4 / amh2so4 ) ) /           &
2929                    zbinmol(1) + epsoc * paero(b)%volc(2) * ( arhooc / amoc )  &
2930                    / zbinmol(2) + ( paero(b)%volc(6) * ( arhohno3/amhno3 ) )  &
2931                    / zbinmol(6)
2932!                           
2933!--          Particle wet diameter (m)
2934             zdwet = ( zlwc / paero(b)%numc / arhoh2o / api6 +                 &
2935                     ( SUM( zvpart(6:7) ) / api6 ) +      &
2936                       zcore / api6 )**( 1.0_wp / 3.0_wp )
2937!                             
2938!--          Kelvin effect (Eq. 10.85 in in Seinfeld and Pandis (2006)). Avoid
2939!--          overflow.
2940             zke = EXP( MIN( 50.0_wp,                                          &
2941                       4.0_wp * surfw0 * amvh2so4 / ( abo * ptemp *  zdwet ) ) )
2942             
2943             counti = counti + 1
2944             IF ( counti > 1000 )  THEN
2945                message_string = 'Subrange 1: no convergence!'
2946                CALL message( 'salsa_mod: equilibration', 'SA0042',            &
2947                              1, 2, 0, 6, 0 )
2948             ENDIF
2949          ENDDO
2950!               
2951!--       Instead of lwc, use the volume concentration of water from now on
2952!--       (easy to convert...)
2953          paero(b)%volc(8) = zlwc / arhoh2o
2954!               
2955!--       If this is initialization, update the core and wet diameter
2956          IF ( init )  THEN
2957             paero(b)%dwet = zdwet
2958             paero(b)%core = zcore
2959          ENDIF
2960         
2961       ELSE
2962!--       If initialization
2963!--       1.2) empty bins given bin average values 
2964          IF ( init )  THEN
2965             paero(b)%dwet = paero(b)%dmid
2966             paero(b)%core = api6 * paero(b)%dmid ** 3.0_wp
2967          ENDIF
2968         
2969       ENDIF
2970             
2971    ENDDO !< b
2972!
2973!-- 2) Regime 2a: sulphate, OC, BC and sea salt
2974!--    This is done only for initialization call, otherwise the water contents
2975!--    are computed via condensation
2976    IF ( init )  THEN
2977       DO  b = in2a, fn2b 
2978             
2979!--       Initialize
2980          zke     = 1.02_wp
2981          zbinmol = 0.0_wp
2982          zdold   = 1.0_wp
2983!               
2984!--       1) Particle properties calculated for non-empty bins
2985          IF ( paero(b)%numc > nclim )  THEN
2986!               
2987!--          Volume in one particle [fxm]
2988             zvpart = 0.0_wp
2989             zvpart(1:7) = paero(b)%volc(1:7) / paero(b)%numc
2990!
2991!--          Total volume and wet diameter of one dry particle [fxm]
2992             zcore = SUM( zvpart(1:5) )
2993             zdwet = paero(b)%dwet
2994
2995             counti = 0
2996             DO  WHILE ( ABS( zdwet / zdold - 1.0_wp ) > 1.0E-12_wp )
2997             
2998                zdold = MAX( zdwet, 1.0E-20_wp )
2999                zaw = zrh / zke
3000!                     
3001!--             Binary molalities (mol/kg):
3002!--             Sulphate
3003                zbinmol(1) = 1.1065495E+2_wp - 3.6759197E+2_wp * zaw           & 
3004                        + 5.0462934E+2_wp * zaw**2 - 3.1543839E+2_wp * zaw**3  &
3005                        + 6.770824E+1_wp  * zaw**4 
3006!--             Organic carbon                       
3007                zbinmol(2) = 1.0_wp / ( zaw * amh2o ) - 1.0_wp / amh2o 
3008!--             Nitric acid
3009                zbinmol(6) = 2.306844303E+1_wp - 3.563608869E+1_wp * zaw       &
3010                     - 6.210577919E+1_wp * zaw**2 + 5.510176187E+2_wp * zaw**3 &
3011                     - 1.460055286E+3_wp * zaw**4 + 1.894467542E+3_wp * zaw**5 &
3012                     - 1.220611402E+3_wp * zaw**6 + 3.098597737E+2_wp * zaw**7 
3013!--             Sea salt (natrium chloride)                                 
3014                zbinmol(5) = 5.875248E+1_wp - 1.8781997E+2_wp * zaw            &
3015                         + 2.7211377E+2_wp * zaw**2 - 1.8458287E+2_wp * zaw**3 &
3016                         + 4.153689E+1_wp  * zaw**4 
3017!                                 
3018!--             Calculate the liquid water content (kg/m3-air)
3019                zlwc = ( paero(b)%volc(1) * ( arhoh2so4 / amh2so4 ) ) /        &
3020                       zbinmol(1) + epsoc * ( paero(b)%volc(2) * ( arhooc /    &
3021                       amoc ) ) / zbinmol(2) + ( paero(b)%volc(6) * ( arhohno3 &
3022                       / amhno3 ) ) / zbinmol(6) + ( paero(b)%volc(5) *        &
3023                       ( arhoss / amss ) ) / zbinmol(5)
3024                       
3025!--             Particle wet radius (m)
3026                zdwet = ( zlwc / paero(b)%numc / arhoh2o / api6 +              &
3027                          ( SUM( zvpart(6:7) ) / api6 )  + &
3028                           zcore / api6 ) ** ( 1.0_wp / 3.0_wp )
3029!                               
3030!--             Kelvin effect (Eq. 10.85 in Seinfeld and Pandis (2006))
3031                zke = EXP( MIN( 50.0_wp,                                       &
3032                        4.0_wp * surfw0 * amvh2so4 / ( abo * zdwet * ptemp ) ) )
3033                         
3034                counti = counti + 1
3035                IF ( counti > 1000 )  THEN
3036                   message_string = 'Subrange 2: no convergence!'
3037                CALL message( 'salsa_mod: equilibration', 'SA0043',            &
3038                              1, 2, 0, 6, 0 )
3039                ENDIF
3040             ENDDO
3041!                   
3042!--          Liquid water content; instead of LWC use the volume concentration
3043             paero(b)%volc(8) = zlwc / arhoh2o
3044             paero(b)%dwet    = zdwet
3045             paero(b)%core    = zcore
3046             
3047          ELSE
3048!--          2.2) empty bins given bin average values
3049             paero(b)%dwet = paero(b)%dmid
3050             paero(b)%core = api6 * paero(b)%dmid ** 3.0_wp
3051          ENDIF
3052               
3053       ENDDO   ! b
3054    ENDIF
3055
3056 END SUBROUTINE equilibration 
3057 
3058!------------------------------------------------------------------------------!
3059!> Description:
3060!> ------------
3061!> Calculation of the settling velocity vc (m/s) per aerosol size bin and
3062!> deposition on plant canopy (lsdepo_vege).
3063!
3064!> Deposition is based on either the scheme presented in:
3065!> Zhang et al. (2001), Atmos. Environ. 35, 549-560 (includes collection due to
3066!> Brownian diffusion, impaction, interception and sedimentation)
3067!> OR
3068!> Petroff & Zhang (2010), Geosci. Model Dev. 3, 753-769 (includes also
3069!> collection due to turbulent impaction)
3070!
3071!> Equation numbers refer to equation in Jacobson (2005): Fundamentals of
3072!> Atmospheric Modeling, 2nd Edition.
3073!
3074!> Subroutine follows closely sedim_SALSA in UCLALES-SALSA written by Juha
3075!> Tonttila (KIT/FMI) and Zubair Maalick (UEF).
3076!> Rewritten to PALM by Mona Kurppa (UH), 2017.
3077!
3078!> Call for grid point i,j,k
3079!------------------------------------------------------------------------------!
3080
3081 SUBROUTINE deposition( paero, tk, adn, mag_u, lad, kvis, Sc, vc )
3082 
3083    USE plant_canopy_model_mod,                                                &
3084        ONLY: cdc
3085 
3086    IMPLICIT NONE
3087   
3088    REAL(wp), INTENT(in)    ::  adn    !< air density (kg/m3) 
3089    REAL(wp), INTENT(out)   ::  kvis   !< kinematic viscosity of air (m2/s)
3090    REAL(wp), INTENT(in) ::     lad    !< leaf area density (m2/m3)
3091    REAL(wp), INTENT(in)    ::  mag_u  !< wind velocity (m/s)
3092    REAL(wp), INTENT(out)   ::  Sc(:)  !< particle Schmidt number 
3093    REAL(wp), INTENT(in)    ::  tk     !< abs.temperature (K)   
3094    REAL(wp), INTENT(out)   ::  vc(:)  !< critical fall speed i.e. settling
3095                                       !< velocity of an aerosol particle (m/s)
3096    TYPE(t_section), INTENT(inout) ::  paero(fn2b)       
3097   
3098    INTEGER(iwp) ::  b      !< loop index
3099    INTEGER(iwp) ::  c      !< loop index
3100    REAL(wp) ::  avis       !< molecular viscocity of air (kg/(m*s))
3101    REAL(wp), PARAMETER ::  c_A = 1.249_wp !< Constants A, B and C for
3102    REAL(wp), PARAMETER ::  c_B = 0.42_wp  !< calculating  the Cunningham 
3103    REAL(wp), PARAMETER ::  c_C = 0.87_wp  !< slip-flow correction (Cc) 
3104                                           !< according to Jacobson (2005),
3105                                           !< Eq. 15.30
3106    REAL(wp) ::  Cc         !< Cunningham slip-flow correction factor     
3107    REAL(wp) ::  Kn         !< Knudsen number   
3108    REAL(wp) ::  lambda     !< molecular mean free path (m)
3109    REAL(wp) ::  mdiff      !< particle diffusivity coefficient   
3110    REAL(wp) ::  pdn        !< particle density (kg/m3)     
3111    REAL(wp) ::  ustar      !< friction velocity (m/s)   
3112    REAL(wp) ::  va         !< thermal speed of an air molecule (m/s)
3113    REAL(wp) ::  zdwet      !< wet diameter (m)                             
3114!
3115!-- Initialise
3116    Cc            = 0.0_wp
3117    Kn            = 0.0_wp
3118    mdiff         = 0.0_wp
3119    pdn           = 1500.0_wp    ! default value
3120    ustar         = 0.0_wp 
3121!
3122!-- Molecular viscosity of air (Eq. 4.54)
3123    avis = 1.8325E-5_wp * ( 416.16_wp / ( tk + 120.0_wp ) ) * ( tk /           &
3124           296.16_wp )**1.5_wp
3125!             
3126!-- Kinematic viscosity (Eq. 4.55)
3127    kvis =  avis / adn
3128!       
3129!-- Thermal velocity of an air molecule (Eq. 15.32)
3130    va = SQRT( 8.0_wp * abo * tk / ( pi * am_airmol ) ) 
3131!
3132!-- Mean free path (m) (Eq. 15.24)
3133    lambda = 2.0_wp * avis / ( adn * va )
3134   
3135    DO  b = 1, nbins
3136   
3137       IF ( paero(b)%numc < nclim )  CYCLE
3138       zdwet = paero(b)%dwet
3139!
3140!--    Knudsen number (Eq. 15.23)
3141       Kn = MAX( 1.0E-2_wp, lambda / ( zdwet * 0.5_wp ) ) ! To avoid underflow
3142!
3143!--    Cunningham slip-flow correction (Eq. 15.30)
3144       Cc = 1.0_wp + Kn * ( c_A + c_B * EXP( -c_C / Kn ) )
3145
3146!--    Particle diffusivity coefficient (Eq. 15.29)
3147       mdiff = ( abo * tk * Cc ) / ( 3.0_wp * pi * avis * zdwet )
3148!       
3149!--    Particle Schmidt number (Eq. 15.36)
3150       Sc(b) = kvis / mdiff       
3151!       
3152!--    Critical fall speed i.e. settling velocity  (Eq. 20.4)                 
3153       vc(b) = MIN( 1.0_wp, terminal_vel( 0.5_wp * zdwet, pdn, adn, avis, Cc) )
3154       
3155       IF ( lsdepo_vege  .AND.  plant_canopy  .AND.  lad > 0.0_wp )  THEN
3156!       
3157!--       Friction velocity calculated following Prandtl (1925):
3158          ustar = SQRT( cdc ) * mag_u
3159          CALL depo_vege( paero, b, vc(b), mag_u, ustar, kvis, Sc(b), lad )
3160       ENDIF
3161    ENDDO
3162 
3163 END SUBROUTINE deposition 
3164 
3165!------------------------------------------------------------------------------!
3166! Description:
3167! ------------
3168!> Calculate change in number and volume concentrations due to deposition on
3169!> plant canopy.
3170!------------------------------------------------------------------------------!
3171 SUBROUTINE depo_vege( paero, b, vc, mag_u, ustar, kvis_a, Sc, lad )
3172 
3173    IMPLICIT NONE
3174   
3175    INTEGER(iwp), INTENT(in) ::  b  !< loop index
3176    REAL(wp), INTENT(in) ::  kvis_a !< kinematic viscosity of air (m2/s)
3177    REAL(wp), INTENT(in) ::  lad    !< leaf area density (m2/m3)
3178    REAL(wp), INTENT(in) ::  mag_u  !< wind velocity (m/s)   
3179    REAL(wp), INTENT(in) ::  Sc     !< particle Schmidt number
3180    REAL(wp), INTENT(in) ::  ustar  !< friction velocity (m/s)                                   
3181    REAL(wp), INTENT(in) ::  vc     !< terminal velocity (m/s) 
3182    TYPE(t_section), INTENT(inout) ::  paero(fn2b) 
3183   
3184    INTEGER(iwp) ::  c      !< loop index
3185    REAL(wp), PARAMETER ::  c_A = 1.249_wp !< Constants A, B and C for
3186    REAL(wp), PARAMETER ::  c_B = 0.42_wp  !< calculating  the Cunningham 
3187    REAL(wp), PARAMETER ::  c_C = 0.87_wp  !< slip-flow correction (Cc) 
3188                                           !< according to Jacobson (2005),
3189                                           !< Eq. 15.30
3190    REAL(wp) ::  alpha       !< parameter, Table 3 in Zhang et al. (2001) 
3191    REAL(wp) ::  depo        !< deposition efficiency
3192    REAL(wp) ::  C_Br        !< coefficient for Brownian diffusion
3193    REAL(wp) ::  C_IM        !< coefficient for inertial impaction
3194    REAL(wp) ::  C_IN        !< coefficient for interception
3195    REAL(wp) ::  C_IT        !< coefficient for turbulent impaction   
3196    REAL(wp) ::  gamma       !< parameter, Table 3 in Zhang et al. (2001)   
3197    REAL(wp) ::  par_A       !< parameter A for the characteristic radius of
3198                             !< collectors, Table 3 in Zhang et al. (2001)   
3199    REAL(wp) ::  rt          !< the overall quasi-laminar resistance for
3200                             !< particles
3201    REAL(wp) ::  St          !< Stokes number for smooth surfaces or bluff
3202                             !< surface elements                                 
3203    REAL(wp) ::  tau_plus    !< dimensionless particle relaxation time   
3204    REAL(wp) ::  v_bd        !< deposition velocity due to Brownian diffusion
3205    REAL(wp) ::  v_im        !< deposition velocity due to impaction
3206    REAL(wp) ::  v_in        !< deposition velocity due to interception
3207    REAL(wp) ::  v_it        !< deposition velocity due to turbulent impaction                               
3208!
3209!-- Initialise
3210    depo     = 0.0_wp 
3211    rt       = 0.0_wp
3212    St       = 0.0_wp
3213    tau_plus = 0.0_wp
3214    v_bd     = 0.0_wp     
3215    v_im     = 0.0_wp       
3216    v_in     = 0.0_wp       
3217    v_it     = 0.0_wp         
3218       
3219    IF ( depo_vege_type == 'zhang2001' )  THEN
3220!       
3221!--    Parameters for the land use category 'deciduous broadleaf trees'(Table 3)     
3222       par_A = 5.0E-3_wp
3223       alpha = 0.8_wp
3224       gamma = 0.56_wp 
3225!       
3226!--    Stokes number for vegetated surfaces (Seinfeld & Pandis (2006): Eq.19.24) 
3227       St = vc * ustar / ( g * par_A )         
3228!         
3229!--    The overall quasi-laminar resistance for particles (Zhang et al., Eq. 5)       
3230       rt = MAX( EPSILON( 1.0_wp ), ( 3.0_wp * ustar * EXP( -St**0.5_wp ) *    &
3231                         ( Sc**( -gamma ) + ( St / ( alpha + St ) )**2.0_wp +  &
3232                           0.5_wp * ( paero(b)%dwet / par_A )**2.0_wp ) ) )
3233       depo = ( rt + vc ) * lad
3234       paero(b)%numc = paero(b)%numc - depo * paero(b)%numc * dt_salsa
3235       DO  c = 1, maxspec+1
3236          paero(b)%volc(c) = paero(b)%volc(c) - depo * paero(b)%volc(c) *      &
3237                             dt_salsa
3238       ENDDO
3239       
3240    ELSEIF ( depo_vege_type == 'petroff2010' )  THEN
3241!
3242!--    vd = v_BD + v_IN + v_IM + v_IT + vc
3243!--    Deposition efficiencies from Table 1. Constants from Table 2.
3244       C_Br  = 1.262_wp
3245       C_IM  = 0.130_wp
3246       C_IN  = 0.216_wp
3247       C_IT  = 0.056_wp
3248       par_A = 0.03_wp   ! Here: leaf width (m)     
3249!       
3250!--    Stokes number for vegetated surfaces (Seinfeld & Pandis (2006): Eq.19.24) 
3251       St = vc * ustar / ( g * par_A )         
3252!
3253!--    Non-dimensional relexation time of the particle on top of canopy
3254       tau_plus = vc * ustar**2.0_wp / ( kvis_a * g ) 
3255!
3256!--    Brownian diffusion
3257       v_bd = mag_u * C_Br * Sc**( -2.0_wp / 3.0_wp ) *                        &
3258              ( mag_u * par_A / kvis_a )**( -0.5_wp )
3259!
3260!--    Interception
3261       v_in = mag_u * C_IN * paero(b)%dwet / par_A * ( 2.0_wp + LOG( 2.0_wp *  &
3262              par_A / paero(b)%dwet ) )                     
3263!
3264!--    Impaction: Petroff (2009) Eq. 18
3265       v_im = mag_u * C_IM * ( St / ( St + 0.47_wp ) )**2.0_wp
3266       
3267       IF ( tau_plus < 20.0_wp )  THEN
3268          v_it = 2.5E-3_wp * C_IT * tau_plus**2.0_wp
3269       ELSE
3270          v_it = C_IT
3271       ENDIF
3272       depo = ( v_bd + v_in + v_im + v_it + vc ) * lad     
3273       paero(b)%numc = paero(b)%numc - depo * paero(b)%numc * dt_salsa     
3274       DO  c = 1, maxspec+1
3275          paero(b)%volc(c) = paero(b)%volc(c) - depo * paero(b)%volc(c) *      &
3276                             dt_salsa
3277       ENDDO
3278    ENDIF 
3279 
3280 END SUBROUTINE depo_vege
3281 
3282!------------------------------------------------------------------------------!
3283! Description:
3284! ------------ 
3285!> Calculate deposition on horizontal and vertical surfaces. Implement as
3286!> surface flux.
3287!------------------------------------------------------------------------------!
3288
3289 SUBROUTINE depo_topo( i, j, surf, vc, Sc, kvis, mag_u, norm )
3290 
3291    USE surface_mod,                                                           &
3292        ONLY:  surf_type
3293 
3294    IMPLICIT NONE
3295   
3296    INTEGER(iwp), INTENT(in) ::  i     !< loop index
3297    INTEGER(iwp), INTENT(in) ::  j     !< loop index
3298    REAL(wp), INTENT(in) ::  kvis(:)   !< kinematic viscosity of air (m2/s)
3299    REAL(wp), INTENT(in) ::  mag_u(:)  !< wind velocity (m/s)                                                 
3300    REAL(wp), INTENT(in) ::  norm(:)   !< normalisation (usually air density)
3301    REAL(wp), INTENT(in) ::  Sc(:,:)  !< particle Schmidt number
3302    REAL(wp), INTENT(in) ::  vc(:,:)  !< terminal velocity (m/s)   
3303    TYPE(surf_type), INTENT(inout) :: surf  !< respective surface type
3304    INTEGER(iwp) ::  b      !< loop index
3305    INTEGER(iwp) ::  c      !< loop index
3306    INTEGER(iwp) ::  k      !< loop index
3307    INTEGER(iwp) ::  m      !< loop index
3308    INTEGER(iwp) ::  surf_e !< End index of surface elements at (j,i)-gridpoint
3309    INTEGER(iwp) ::  surf_s !< Start index of surface elements at (j,i)-gridpoint
3310    REAL(wp) ::  alpha      !< parameter, Table 3 in Zhang et al. (2001)
3311    REAL(wp) ::  C_Br       !< coefficient for Brownian diffusion
3312    REAL(wp) ::  C_IM       !< coefficient for inertial impaction
3313    REAL(wp) ::  C_IN       !< coefficient for interception
3314    REAL(wp) ::  C_IT       !< coefficient for turbulent impaction
3315    REAL(wp) ::  depo       !< deposition efficiency
3316    REAL(wp) ::  gamma      !< parameter, Table 3 in Zhang et al. (2001)
3317    REAL(wp) ::  par_A      !< parameter A for the characteristic radius of
3318                            !< collectors, Table 3 in Zhang et al. (2001)
3319    REAL(wp) ::  rt         !< the overall quasi-laminar resistance for
3320                            !< particles
3321    REAL(wp) ::  St         !< Stokes number for bluff surface elements 
3322    REAL(wp) ::  tau_plus   !< dimensionless particle relaxation time   
3323    REAL(wp) ::  v_bd       !< deposition velocity due to Brownian diffusion
3324    REAL(wp) ::  v_im       !< deposition velocity due to impaction
3325    REAL(wp) ::  v_in       !< deposition velocity due to interception
3326    REAL(wp) ::  v_it       !< deposition velocity due to turbulent impaction 
3327!
3328!-- Initialise
3329    rt       = 0.0_wp
3330    St       = 0.0_wp
3331    tau_plus = 0.0_wp
3332    v_bd     = 0.0_wp     
3333    v_im     = 0.0_wp       
3334    v_in     = 0.0_wp       
3335    v_it     = 0.0_wp                                 
3336    surf_s   = surf%start_index(j,i)
3337    surf_e   = surf%end_index(j,i) 
3338   
3339    DO  m = surf_s, surf_e 
3340       k = surf%k(m)       
3341       DO  b = 1, nbins
3342          IF ( aerosol_number(b)%conc(k,j,i) <= nclim  .OR.                    &
3343               Sc(k+1,b) < 1.0_wp )  CYCLE   
3344                   
3345          IF ( depo_topo_type == 'zhang2001' )  THEN
3346!       
3347!--          Parameters for the land use category 'urban' in Table 3
3348             alpha = 1.5_wp
3349             gamma = 0.56_wp 
3350             par_A = 10.0E-3_wp
3351!       
3352!--          Stokes number for smooth surfaces or surfaces with bluff roughness
3353!--          elements (Seinfeld and Pandis, 2nd edition (2006): Eq. 19.23)       
3354             St = MAX( 0.01_wp, vc(k+1,b) * surf%us(m) ** 2.0_wp /             &
3355                       ( g * kvis(k+1)  ) ) 
3356!         
3357!--          The overall quasi-laminar resistance for particles (Eq. 5)       
3358             rt = MAX( EPSILON( 1.0_wp ), ( 3.0_wp * surf%us(m) * (            &
3359                       Sc(k+1,b)**( -gamma ) + ( St / ( alpha + St ) )**2.0_wp &
3360                        + 0.5_wp * ( Ra_dry(k,j,i,b) / par_A )**2.0_wp ) *     &
3361                       EXP( -St**0.5_wp ) ) ) 
3362             depo = vc(k+1,b) + rt
3363             
3364          ELSEIF ( depo_topo_type == 'petroff2010' )  THEN 
3365!
3366!--          vd = v_BD + v_IN + v_IM + v_IT + vc
3367!--          Deposition efficiencies from Table 1. Constants from Table 2.
3368             C_Br  = 1.262_wp
3369             C_IM  = 0.130_wp
3370             C_IN  = 0.216_wp
3371             C_IT  = 0.056_wp
3372             par_A = 0.03_wp   ! Here: leaf width (m) 
3373!       
3374!--          Stokes number for smooth surfaces or surfaces with bluff roughness
3375!--          elements (Seinfeld and Pandis, 2nd edition (2006): Eq. 19.23)       
3376             St = MAX( 0.01_wp, vc(k+1,b) * surf%us(m) ** 2.0_wp /             &
3377                       ( g *  kvis(k+1) ) )             
3378!
3379!--          Non-dimensional relexation time of the particle on top of canopy
3380             tau_plus = vc(k+1,b) * surf%us(m)**2.0_wp / ( kvis(k+1) * g ) 
3381!
3382!--          Brownian diffusion
3383             v_bd = mag_u(k+1) * C_Br * Sc(k+1,b)**( -2.0_wp / 3.0_wp ) *      &
3384                    ( mag_u(k+1) * par_A / kvis(k+1) )**( -0.5_wp )
3385!
3386!--          Interception
3387             v_in = mag_u(k+1) * C_IN * Ra_dry(k,j,i,b)/ par_A * ( 2.0_wp +    &
3388                    LOG( 2.0_wp * par_A / Ra_dry(k,j,i,b) ) )                     
3389!
3390!--          Impaction: Petroff (2009) Eq. 18
3391             v_im = mag_u(k+1) * C_IM * ( St / ( St + 0.47_wp ) )**2.0_wp
3392             
3393             IF ( tau_plus < 20.0_wp )  THEN
3394                v_it = 2.5E-3_wp * C_IT * tau_plus**2.0_wp
3395             ELSE
3396                v_it = C_IT
3397             ENDIF
3398             depo =  v_bd + v_in + v_im + v_it + vc(k+1,b)       
3399         
3400          ENDIF
3401          IF ( lod_aero == 3  .OR.  salsa_source_mode ==  'no_source' )  THEN
3402             surf%answs(m,b) = -depo * norm(k) * aerosol_number(b)%conc(k,j,i) 
3403             DO  c = 1, ncc_tot   
3404                surf%amsws(m,(c-1)*nbins+b) = -depo *  norm(k) *               &
3405                                         aerosol_mass((c-1)*nbins+b)%conc(k,j,i)
3406             ENDDO    ! c
3407          ELSE
3408             surf%answs(m,b) = SUM( aerosol_number(b)%source(:,j,i) ) -        &
3409                               MAX( 0.0_wp, depo * norm(k) *                   &
3410                               aerosol_number(b)%conc(k,j,i) )
3411             DO  c = 1, ncc_tot   
3412                surf%amsws(m,(c-1)*nbins+b) = SUM(                             &
3413                               aerosol_mass((c-1)*nbins+b)%source(:,j,i) ) -   &
3414                               MAX(  0.0_wp, depo *  norm(k) *                 &
3415                               aerosol_mass((c-1)*nbins+b)%conc(k,j,i) )
3416             ENDDO 
3417          ENDIF
3418       ENDDO    ! b
3419    ENDDO    ! m     
3420     
3421 END SUBROUTINE depo_topo
3422 
3423!------------------------------------------------------------------------------!
3424! Description:
3425! ------------
3426! Function for calculating terminal velocities for different particles sizes.
3427!------------------------------------------------------------------------------!
3428 REAL(wp) FUNCTION terminal_vel( radius, rhop, rhoa, visc, beta )
3429 
3430    IMPLICIT NONE
3431   
3432    REAL(wp), INTENT(in) ::  beta    !< Cunningham correction factor
3433    REAL(wp), INTENT(in) ::  radius  !< particle radius (m)
3434    REAL(wp), INTENT(in) ::  rhop    !< particle density (kg/m3)
3435    REAL(wp), INTENT(in) ::  rhoa    !< air density (kg/m3)
3436    REAL(wp), INTENT(in) ::  visc    !< molecular viscosity of air (kg/(m*s))
3437   
3438    REAL(wp), PARAMETER ::  rhoa_ref = 1.225_wp ! reference air density (kg/m3)
3439!
3440!-- Stokes law with Cunningham slip correction factor
3441    terminal_vel = ( 4.0_wp * radius**2.0_wp ) * ( rhop - rhoa ) * g * beta /  &
3442                   ( 18.0_wp * visc ) ! (m/s)
3443       
3444 END FUNCTION terminal_vel
3445 
3446!------------------------------------------------------------------------------!
3447! Description:
3448! ------------
3449!> Calculates particle loss and change in size distribution due to (Brownian)
3450!> coagulation. Only for particles with dwet < 30 micrometres.
3451!
3452!> Method:
3453!> Semi-implicit, non-iterative method: (Jacobson, 1994)
3454!> Volume concentrations of the smaller colliding particles added to the bin of
3455!> the larger colliding particles. Start from first bin and use the updated
3456!> number and volume for calculation of following bins. NB! Our bin numbering
3457!> does not follow particle size in subrange 2.
3458!
3459!> Schematic for bin numbers in different subranges:
3460!>             1                            2
3461!>    +-------------------------------------------+
3462!>  a | 1 | 2 | 3 || 4 | 5 | 6 | 7 |  8 |  9 | 10||
3463!>  b |           ||11 |12 |13 |14 | 15 | 16 | 17||
3464!>    +-------------------------------------------+
3465!
3466!> Exact coagulation coefficients for each pressure level are scaled according
3467!> to current particle wet size (linear scaling).
3468!> Bins are organized in terms of the dry size of the condensation nucleus,
3469!> while coagulation kernell is calculated with the actual hydrometeor
3470!> size.
3471!
3472!> Called from salsa_driver
3473!> fxm: Process selection should be made smarter - now just lots of IFs inside
3474!>      loops
3475!
3476!> Coded by:
3477!> Hannele Korhonen (FMI) 2005
3478!> Harri Kokkola (FMI) 2006
3479!> Tommi Bergman (FMI) 2012
3480!> Matti Niskanen(FMI) 2012
3481!> Anton Laakso  (FMI) 2013
3482!> Juha Tonttila (FMI) 2014
3483!------------------------------------------------------------------------------!
3484 SUBROUTINE coagulation( paero, ptstep, ptemp, ppres )
3485               
3486    IMPLICIT NONE
3487   
3488!-- Input and output variables
3489    TYPE(t_section), INTENT(inout) ::  paero(fn2b) !< Aerosol properties
3490    REAL(wp), INTENT(in) ::  ppres  !< ambient pressure (Pa)
3491    REAL(wp), INTENT(in) ::  ptemp  !< ambient temperature (K)
3492    REAL(wp), INTENT(in) ::  ptstep !< time step (s)
3493!-- Local variables
3494    INTEGER(iwp) ::  index_2a !< corresponding bin in subrange 2a
3495    INTEGER(iwp) ::  index_2b !< corresponding bin in subrange 2b
3496    INTEGER(iwp) ::  b !< loop index
3497    INTEGER(iwp) ::  ll !< loop index
3498    INTEGER(iwp) ::  mm !< loop index
3499    INTEGER(iwp) ::  nn !< loop index
3500    REAL(wp) ::  pressi !< pressure
3501    REAL(wp) ::  temppi !< temperature
3502    REAL(wp) ::  zcc(fn2b,fn2b)   !< updated coagulation coefficients (m3/s) 
3503    REAL(wp) ::  zdpart_mm        !< diameter of particle (m)
3504    REAL(wp) ::  zdpart_nn        !< diameter of particle (m)   
3505    REAL(wp) ::  zminusterm       !< coagulation loss in a bin (1/s)
3506    REAL(wp) ::  zplusterm(8)     !< coagulation gain in a bin (fxm/s)
3507                                  !< (for each chemical compound)
3508    REAL(wp) ::  zmpart(fn2b)     !< approximate mass of particles (kg)
3509   
3510    zcc       = 0.0_wp
3511    zmpart    = 0.0_wp
3512    zdpart_mm = 0.0_wp
3513    zdpart_nn = 0.0_wp
3514!
3515!-- 1) Coagulation to coarse mode calculated in a simplified way:
3516!--    CoagSink ~ Dp in continuum subrange, thus we calculate 'effective'
3517!--    number concentration of coarse particles
3518
3519!-- 2) Updating coagulation coefficients
3520!   
3521!-- Aerosol mass (kg). Density of 1500 kg/m3 assumed
3522    zmpart(1:fn2b) = api6 * ( MIN( paero(1:fn2b)%dwet, 30.0E-6_wp )**3.0_wp  ) &
3523                     * 1500.0_wp 
3524    temppi = ptemp
3525    pressi = ppres
3526    zcc    = 0.0_wp
3527!
3528!-- Aero-aero coagulation
3529    DO  mm = 1, fn2b   ! smaller colliding particle
3530       IF ( paero(mm)%numc < nclim )  CYCLE
3531       DO  nn = mm, fn2b   ! larger colliding particle
3532          IF ( paero(nn)%numc < nclim )  CYCLE
3533         
3534          zdpart_mm = MIN( paero(mm)%dwet, 30.0E-6_wp )     ! Limit to 30 um
3535          zdpart_nn = MIN( paero(nn)%dwet, 30.0E-6_wp )     ! Limit to 30 um
3536!             
3537!--       Coagulation coefficient of particles (m3/s)
3538          zcc(mm,nn) = coagc( zdpart_mm, zdpart_nn, zmpart(mm), zmpart(nn),    &
3539                              temppi, pressi )
3540          zcc(nn,mm) = zcc(mm,nn)
3541       ENDDO
3542    ENDDO
3543       
3544!   
3545!-- 3) New particle and volume concentrations after coagulation:
3546!--    Calculated according to Jacobson (2005) eq. 15.9
3547!
3548!-- Aerosols in subrange 1a:
3549    DO  b = in1a, fn1a
3550       IF ( paero(b)%numc < nclim )  CYCLE
3551       zminusterm   = 0.0_wp
3552       zplusterm(:) = 0.0_wp
3553!       
3554!--    Particles lost by coagulation with larger aerosols
3555       DO  ll = b+1, fn2b
3556          zminusterm = zminusterm + zcc(b,ll) * paero(ll)%numc
3557       ENDDO
3558!       
3559!--    Coagulation gain in a bin: change in volume conc. (cm3/cm3):
3560       DO ll = in1a, b-1
3561          zplusterm(1:2) = zplusterm(1:2) + zcc(ll,b) * paero(ll)%volc(1:2)
3562          zplusterm(6:7) = zplusterm(6:7) + zcc(ll,b) * paero(ll)%volc(6:7)
3563          zplusterm(8)   = zplusterm(8)   + zcc(ll,b) * paero(ll)%volc(8)
3564       ENDDO
3565!       
3566!--    Volume and number concentrations after coagulation update [fxm]
3567       paero(b)%volc(1:2) = ( paero(b)%volc(1:2) + ptstep * zplusterm(1:2) * &
3568                             paero(b)%numc ) / ( 1.0_wp + ptstep * zminusterm )
3569       paero(b)%volc(6:7) = ( paero(b)%volc(6:7) + ptstep * zplusterm(6:7) * &
3570                             paero(b)%numc ) / ( 1.0_wp + ptstep * zminusterm )
3571       paero(b)%volc(8)   = ( paero(b)%volc(8)   + ptstep * zplusterm(8) *   &
3572                             paero(b)%numc ) / ( 1.0_wp + ptstep * zminusterm )
3573       paero(b)%numc = paero(b)%numc / ( 1.0_wp + ptstep * zminusterm  +     &
3574                        0.5_wp * ptstep * zcc(b,b) * paero(b)%numc )               
3575    ENDDO
3576!             
3577!-- Aerosols in subrange 2a:
3578    DO  b = in2a, fn2a
3579       IF ( paero(b)%numc < nclim )  CYCLE
3580       zminusterm   = 0.0_wp
3581       zplusterm(:) = 0.0_wp
3582!       
3583!--    Find corresponding size bin in subrange 2b
3584       index_2b = b - in2a + in2b
3585!       
3586!--    Particles lost by larger particles in 2a
3587       DO  ll = b+1, fn2a
3588          zminusterm = zminusterm + zcc(b,ll) * paero(ll)%numc 
3589       ENDDO
3590!       
3591!--    Particles lost by larger particles in 2b
3592       IF ( .NOT. no_insoluble )  THEN
3593          DO  ll = index_2b+1, fn2b
3594             zminusterm = zminusterm + zcc(b,ll) * paero(ll)%numc
3595          ENDDO
3596       ENDIF
3597!       
3598!--    Particle volume gained from smaller particles in subranges 1, 2a and 2b
3599       DO  ll = in1a, b-1
3600          zplusterm(1:2) = zplusterm(1:2) + zcc(ll,b) * paero(ll)%volc(1:2)
3601          zplusterm(6:7) = zplusterm(6:7) + zcc(ll,b) * paero(ll)%volc(6:7)
3602          zplusterm(8)   = zplusterm(8)   + zcc(ll,b) * paero(ll)%volc(8)
3603       ENDDO 
3604!       
3605!--    Particle volume gained from smaller particles in 2a
3606!--    (Note, for components not included in the previous loop!)
3607       DO  ll = in2a, b-1
3608          zplusterm(3:5) = zplusterm(3:5) + zcc(ll,b)*paero(ll)%volc(3:5)             
3609       ENDDO
3610       
3611!       
3612!--    Particle volume gained from smaller (and equal) particles in 2b
3613       IF ( .NOT. no_insoluble )  THEN
3614          DO  ll = in2b, index_2b
3615             zplusterm(1:8) = zplusterm(1:8) + zcc(ll,b) * paero(ll)%volc(1:8)
3616          ENDDO
3617       ENDIF
3618!       
3619!--    Volume and number concentrations after coagulation update [fxm]
3620       paero(b)%volc(1:8) = ( paero(b)%volc(1:8) + ptstep * zplusterm(1:8) * &
3621                             paero(b)%numc ) / ( 1.0_wp + ptstep * zminusterm )
3622       paero(b)%numc = paero(b)%numc / ( 1.0_wp + ptstep * zminusterm +      &
3623                        0.5_wp * ptstep * zcc(b,b) * paero(b)%numc )
3624    ENDDO
3625!             
3626!-- Aerosols in subrange 2b:
3627    IF ( .NOT. no_insoluble )  THEN
3628       DO  b = in2b, fn2b
3629          IF ( paero(b)%numc < nclim )  CYCLE
3630          zminusterm   = 0.0_wp
3631          zplusterm(:) = 0.0_wp
3632!       
3633!--       Find corresponding size bin in subsubrange 2a
3634          index_2a = b - in2b + in2a
3635!       
3636!--       Particles lost to larger particles in subranges 2b
3637          DO  ll = b+1, fn2b
3638             zminusterm = zminusterm + zcc(b,ll) * paero(ll)%numc
3639          ENDDO
3640!       
3641!--       Particles lost to larger and equal particles in 2a
3642          DO  ll = index_2a, fn2a
3643             zminusterm = zminusterm + zcc(b,ll) * paero(ll)%numc
3644          ENDDO
3645!       
3646!--       Particle volume gained from smaller particles in subranges 1 & 2a
3647          DO  ll = in1a, index_2a-1
3648             zplusterm(1:8) = zplusterm(1:8) + zcc(ll,b) * paero(ll)%volc(1:8)
3649          ENDDO
3650!       
3651!--       Particle volume gained from smaller particles in 2b
3652          DO  ll = in2b, b-1
3653             zplusterm(1:8) = zplusterm(1:8) + zcc(ll,b) * paero(ll)%volc(1:8)
3654          ENDDO
3655!       
3656!--       Volume and number concentrations after coagulation update [fxm]
3657          paero(b)%volc(1:8) = ( paero(b)%volc(1:8) + ptstep * zplusterm(1:8)&
3658                           * paero(b)%numc ) / ( 1.0_wp + ptstep * zminusterm )
3659          paero(b)%numc = paero(b)%numc / ( 1.0_wp + ptstep * zminusterm  +  &
3660                           0.5_wp * ptstep * zcc(b,b) * paero(b)%numc )
3661       ENDDO
3662    ENDIF
3663
3664 END SUBROUTINE coagulation
3665
3666!------------------------------------------------------------------------------!
3667! Description:
3668! ------------
3669!> Calculation of coagulation coefficients. Extended version of the function
3670!> originally found in mo_salsa_init.
3671!
3672!> J. Tonttila, FMI, 05/2014
3673!------------------------------------------------------------------------------!
3674 REAL(wp) FUNCTION coagc( diam1, diam2, mass1, mass2, temp, pres )
3675 
3676    IMPLICIT NONE
3677!       
3678!-- Input and output variables
3679    REAL(wp), INTENT(in) ::  diam1 !< diameter of colliding particle 1 (m)
3680    REAL(wp), INTENT(in) ::  diam2 !< diameter of colliding particle 2 (m)
3681    REAL(wp), INTENT(in) ::  mass1 !< mass of colliding particle 1 (kg)
3682    REAL(wp), INTENT(in) ::  mass2 !< mass of colliding particle 2 (kg)
3683    REAL(wp), INTENT(in) ::  pres  !< ambient pressure (Pa?) [fxm]
3684    REAL(wp), INTENT(in) ::  temp  !< ambient temperature (K)       
3685!
3686!-- Local variables
3687    REAL(wp) ::  fmdist !< distance of flux matching (m)   
3688    REAL(wp) ::  knud_p !< particle Knudsen number
3689    REAL(wp) ::  mdiam  !< mean diameter of colliding particles (m) 
3690    REAL(wp) ::  mfp    !< mean free path of air molecules (m)   
3691    REAL(wp) ::  visc   !< viscosity of air (kg/(m s))                   
3692    REAL(wp), DIMENSION (2) ::  beta   !< Cunningham correction factor
3693    REAL(wp), DIMENSION (2) ::  dfpart !< particle diffusion coefficient
3694                                       !< (m2/s)       
3695    REAL(wp), DIMENSION (2) ::  diam   !< diameters of particles (m)
3696    REAL(wp), DIMENSION (2) ::  flux   !< flux in continuum and free molec.
3697                                       !< regime (m/s)       
3698    REAL(wp), DIMENSION (2) ::  knud   !< particle Knudsen number       
3699    REAL(wp), DIMENSION (2) ::  mpart  !< masses of particles (kg)
3700    REAL(wp), DIMENSION (2) ::  mtvel  !< particle mean thermal velocity (m/s)
3701    REAL(wp), DIMENSION (2) ::  omega  !< particle mean free path             
3702    REAL(wp), DIMENSION (2) ::  tva    !< temporary variable (m)       
3703!
3704!-- Initialisation
3705    coagc   = 0.0_wp
3706!
3707!-- 1) Initializing particle and ambient air variables
3708    diam  = (/ diam1, diam2 /) !< particle diameters (m)
3709    mpart = (/ mass1, mass2 /) !< particle masses (kg)
3710!-- Viscosity of air (kg/(m s))       
3711    visc = ( 7.44523E-3_wp * temp ** 1.5_wp ) /                                &
3712           ( 5093.0_wp * ( temp + 110.4_wp ) ) 
3713!-- Mean free path of air (m)           
3714    mfp = ( 1.656E-10_wp * temp + 1.828E-8_wp ) * ( p_0 + 1325.0_wp ) / pres
3715!
3716!-- 2) Slip correction factor for small particles
3717    knud = 2.0_wp * EXP( LOG(mfp) - LOG(diam) )! Knudsen number for air (15.23)
3718!-- Cunningham correction factor (Allen and Raabe, Aerosol Sci. Tech. 4, 269)       
3719    beta = 1.0_wp + knud * ( 1.142_wp + 0.558_wp * EXP( -0.999_wp / knud ) )
3720!
3721!-- 3) Particle properties
3722!-- Diffusion coefficient (m2/s) (Jacobson (2005) eq. 15.29)
3723    dfpart = beta * abo * temp / ( 3.0_wp * pi * visc * diam ) 
3724!-- Mean thermal velocity (m/s) (Jacobson (2005) eq. 15.32)
3725    mtvel = SQRT( ( 8.0_wp * abo * temp ) / ( pi * mpart ) )
3726!-- Particle mean free path (m) (Jacobson (2005) eq. 15.34 )
3727    omega = 8.0_wp * dfpart / ( pi * mtvel ) 
3728!-- Mean diameter (m)
3729    mdiam = 0.5_wp * ( diam(1) + diam(2) )
3730!
3731!-- 4) Calculation of fluxes (Brownian collision kernels) and flux matching
3732!-- following Jacobson (2005):
3733!-- Flux in continuum regime (m3/s) (eq. 15.28)
3734    flux(1) = 4.0_wp * pi * mdiam * ( dfpart(1) + dfpart(2) )
3735!-- Flux in free molec. regime (m3/s) (eq. 15.31)
3736    flux(2) = pi * SQRT( ( mtvel(1)**2.0_wp ) + ( mtvel(2)**2.0_wp ) ) *      &
3737              ( mdiam**2.0_wp )
3738!-- temporary variables (m) to calculate flux matching distance (m)
3739    tva(1) = ( ( mdiam + omega(1) )**3.0_wp - ( mdiam**2.0_wp +                &
3740               omega(1)**2.0_wp ) * SQRT( ( mdiam**2.0_wp + omega(1)**2.0_wp ) &
3741               ) ) / ( 3.0_wp * mdiam * omega(1) ) - mdiam
3742    tva(2) = ( ( mdiam + omega(2) )**3.0_wp - ( mdiam**2.0_wp +                &
3743               omega(2)**2.0_wp ) * SQRT( ( mdiam**2 + omega(2)**2 ) ) ) /     &
3744             ( 3.0_wp * mdiam * omega(2) ) - mdiam
3745!-- Flux matching distance (m) i.e. the mean distance from the centre of a
3746!-- sphere reached by particles leaving sphere's surface and travelling a
3747!-- distance of particle mean free path mfp (eq. 15 34)                 
3748    fmdist = SQRT( tva(1)**2 + tva(2)**2.0_wp) 
3749!
3750!-- 5) Coagulation coefficient (m3/s) (eq. 15.33). Here assumed
3751!-- coalescence efficiency 1!!
3752    coagc = flux(1) / ( mdiam / ( mdiam + fmdist) + flux(1) / flux(2) ) 
3753!-- coagulation coefficient = coalescence efficiency * collision kernel
3754!
3755!-- Corrected collision kernel following Karl et al., 2016 (ACP):
3756!-- Inclusion of van der Waals and viscous forces
3757    IF ( van_der_waals_coagc )  THEN
3758       knud_p = SQRT( omega(1)**2 + omega(2)**2 ) / mdiam   
3759       IF ( knud_p >= 0.1_wp  .AND.  knud_p <= 10.0_wp )  THEN
3760          coagc = coagc * ( 2.0_wp + 0.4_wp * LOG( knud_p ) )
3761       ELSE
3762          coagc = coagc * 3.0_wp
3763       ENDIF
3764    ENDIF
3765   
3766 END FUNCTION coagc
3767 
3768!------------------------------------------------------------------------------!   
3769! Description:
3770! ------------
3771!> Calculates the change in particle volume and gas phase
3772!> concentrations due to nucleation, condensation and dissolutional growth.
3773!
3774!> Sulphuric acid and organic vapour: only condensation and no evaporation.
3775!
3776!> New gas and aerosol phase concentrations calculated according to Jacobson
3777!> (1997): Numerical techniques to solve condensational and dissolutional growth
3778!> equations when growth is coupled to reversible reactions, Aerosol Sci. Tech.,
3779!> 27, pp 491-498.
3780!
3781!> Following parameterization has been used:
3782!> Molecular diffusion coefficient of condensing vapour (m2/s)
3783!> (Reid et al. (1987): Properties of gases and liquids, McGraw-Hill, New York.)
3784!> D = {1.d-7*sqrt(1/M_air + 1/M_gas)*T^1.75} / &
3785!      {p_atm/p_stand * (d_air^(1/3) + d_gas^(1/3))^2 }
3786! M_air = 28.965 : molar mass of air (g/mol)
3787! d_air = 19.70  : diffusion volume of air
3788! M_h2so4 = 98.08 : molar mass of h2so4 (g/mol)
3789! d_h2so4 = 51.96  : diffusion volume of h2so4
3790!
3791!> Called from main aerosol model
3792!
3793!> fxm: calculated for empty bins too
3794!> fxm: same diffusion coefficients and mean free paths used for sulphuric acid
3795!>      and organic vapours (average values? 'real' values for each?)
3796!> fxm: one should really couple with vapour production and loss terms as well
3797!>      should nucleation be coupled here as well????
3798!
3799! Coded by:
3800! Hannele Korhonen (FMI) 2005
3801! Harri Kokkola (FMI) 2006
3802! Juha Tonttila (FMI) 2014
3803! Rewritten to PALM by Mona Kurppa (UHel) 2017
3804!------------------------------------------------------------------------------!
3805 SUBROUTINE condensation( paero, pcsa, pcocnv, pcocsv, pchno3, pcnh3, pcw, pcs,&
3806                          ptemp, ppres, ptstep, prtcl )
3807       
3808    IMPLICIT NONE
3809   
3810!-- Input and output variables
3811    REAL(wp), INTENT(IN) ::  ppres !< ambient pressure (Pa)
3812    REAL(wp), INTENT(IN) ::  pcs   !< Water vapour saturation concentration
3813                                   !< (kg/m3)     
3814    REAL(wp), INTENT(IN) ::  ptemp !< ambient temperature (K)
3815    REAL(wp), INTENT(IN) ::  ptstep            !< timestep (s) 
3816    TYPE(component_index), INTENT(in) :: prtcl !< Keeps track which substances
3817                                               !< are used                                               
3818    REAL(wp), INTENT(INOUT) ::  pchno3 !< Gas concentrations (#/m3):
3819                                       !< nitric acid HNO3
3820    REAL(wp), INTENT(INOUT) ::  pcnh3  !< ammonia NH3
3821    REAL(wp), INTENT(INOUT) ::  pcocnv !< non-volatile organics
3822    REAL(wp), INTENT(INOUT) ::  pcocsv !< semi-volatile organics
3823    REAL(wp), INTENT(INOUT) ::  pcsa   !< sulphuric acid H2SO4
3824    REAL(wp), INTENT(INOUT) ::  pcw    !< Water vapor concentration (kg/m3)
3825    TYPE(t_section), INTENT(inout) ::  paero(fn2b) !< Aerosol properties                                     
3826!-- Local variables
3827    REAL(wp) ::  zbeta(fn2b) !< transitional correction factor for aerosols
3828    REAL(wp) ::  zcolrate(fn2b) !< collision rate of molecules to particles
3829                                !< (1/s)
3830    REAL(wp) ::  zcolrate_ocnv(fn2b) !< collision rate of organic molecules
3831                                     !< to particles (1/s)
3832    REAL(wp) ::  zcs_ocnv !< condensation sink of nonvolatile organics (1/s)       
3833    REAL(wp) ::  zcs_ocsv !< condensation sink of semivolatile organics (1/s)
3834    REAL(wp) ::  zcs_su !< condensation sink of sulfate (1/s)
3835    REAL(wp) ::  zcs_tot!< total condensation sink (1/s) (gases)
3836!-- vapour concentration after time step (#/m3)
3837    REAL(wp) ::  zcvap_new1 !< sulphuric acid
3838    REAL(wp) ::  zcvap_new2 !< nonvolatile organics
3839    REAL(wp) ::  zcvap_new3 !< semivolatile organics
3840    REAL(wp) ::  zdfpart(in1a+1) !< particle diffusion coefficient (m2/s)     
3841    REAL(wp) ::  zdfvap !< air diffusion coefficient (m2/s)
3842!-- change in vapour concentration (#/m3)
3843    REAL(wp) ::  zdvap1 !< sulphuric acid
3844    REAL(wp) ::  zdvap2 !< nonvolatile organics
3845    REAL(wp) ::  zdvap3 !< semivolatile organics
3846    REAL(wp) ::  zdvoloc(fn2b) !< change of organics volume in each bin [fxm]   
3847    REAL(wp) ::  zdvolsa(fn2b) !< change of sulphate volume in each bin [fxm]
3848    REAL(wp) ::  zj3n3(2)      !< Formation massrate of molecules in
3849                               !< nucleation, (molec/m3s). 1: H2SO4
3850                               !< and 2: organic vapor       
3851    REAL(wp) ::  zknud(fn2b) !< particle Knudsen number       
3852    REAL(wp) ::  zmfp    !< mean free path of condensing vapour (m)
3853    REAL(wp) ::  zrh     !< Relative humidity [0-1]         
3854    REAL(wp) ::  zvisc   !< viscosity of air (kg/(m s))     
3855    REAL(wp) ::  zn_vs_c !< ratio of nucleation of all mass transfer in the
3856                         !< smallest bin
3857    REAL(wp) ::  zxocnv  !< ratio of organic vapour in 3nm particles
3858    REAL(wp) ::  zxsa    !< Ratio in 3nm particles: sulphuric acid
3859   
3860    zj3n3  = 0.0_wp
3861    zrh    = pcw / pcs   
3862    zxocnv = 0.0_wp
3863    zxsa   = 0.0_wp
3864!
3865!-- Nucleation
3866    IF ( nsnucl > 0 )  THEN
3867       CALL nucleation( paero, ptemp, zrh, ppres, pcsa, pcocnv, pcnh3, ptstep, &
3868                        zj3n3, zxsa, zxocnv )
3869    ENDIF
3870!
3871!-- Condensation on pre-existing particles
3872    IF ( lscndgas )  THEN
3873!
3874!--    Initialise:
3875       zdvolsa = 0.0_wp 
3876       zdvoloc = 0.0_wp
3877       zcolrate = 0.0_wp
3878!             
3879!--    1) Properties of air and condensing gases:
3880!--    Viscosity of air (kg/(m s)) (Eq. 4.54 in Jabonson (2005))
3881       zvisc = ( 7.44523E-3_wp * ptemp ** 1.5_wp ) / ( 5093.0_wp *             &
3882                 ( ptemp + 110.4_wp ) )
3883!--    Diffusion coefficient of air (m2/s)
3884       zdfvap = 5.1111E-10_wp * ptemp ** 1.75_wp * ( p_0 + 1325.0_wp ) / ppres 
3885!--    Mean free path (m): same for H2SO4 and organic compounds
3886       zmfp = 3.0_wp * zdfvap * SQRT( pi * amh2so4 / ( 8.0_wp * argas * ptemp ) )
3887!                   
3888!--    2) Transition regime correction factor zbeta for particles:
3889!--       Fuchs and Sutugin (1971), In: Hidy et al. (ed.) Topics in current
3890!--       aerosol research, Pergamon. Size of condensing molecule considered 
3891!--       only for nucleation mode (3 - 20 nm)
3892!
3893!--    Particle Knudsen number: condensation of gases on aerosols
3894       zknud(in1a:in1a+1) = 2.0_wp * zmfp / ( paero(in1a:in1a+1)%dwet + d_sa )
3895       zknud(in1a+2:fn2b) = 2.0_wp * zmfp / paero(in1a+2:fn2b)%dwet
3896!   
3897!--    Transitional correction factor: aerosol + gas (the semi-empirical Fuchs-
3898!--    Sutugin interpolation function (Fuchs and Sutugin, 1971))
3899       zbeta = ( zknud + 1.0_wp ) / ( 0.377_wp * zknud + 1.0_wp + 4.0_wp /     &
3900               ( 3.0_wp * massacc ) * ( zknud + zknud ** 2.0_wp ) )
3901!                   
3902!--    3) Collision rate of molecules to particles
3903!--       Particle diffusion coefficient considered only for nucleation mode
3904!--       (3 - 20 nm)
3905!
3906!--    Particle diffusion coefficient (m2/s) (e.g. Eq. 15.29 in Jacobson (2005))
3907       zdfpart = abo * ptemp * zbeta(in1a:in1a+1) / ( 3.0_wp * pi * zvisc *    &
3908                 paero(in1a:in1a+1)%dwet )
3909!             
3910!--    Collision rate (mass-transfer coefficient): gases on aerosols (1/s)
3911!--    (Eq. 16.64 in Jacobson (2005))
3912       zcolrate(in1a:in1a+1) = MERGE( 2.0_wp * pi *                            &
3913                                      ( paero(in1a:in1a+1)%dwet + d_sa ) *     &
3914                                      ( zdfvap + zdfpart ) * zbeta(in1a:in1a+1)& 
3915                                        * paero(in1a:in1a+1)%numc, 0.0_wp,     &
3916                                      paero(in1a:in1a+1)%numc > nclim )
3917       zcolrate(in1a+2:fn2b) = MERGE( 2.0_wp * pi * paero(in1a+2:fn2b)%dwet *  &
3918                                      zdfvap * zbeta(in1a+2:fn2b) *            &
3919                                      paero(in1a+2:fn2b)%numc, 0.0_wp,         &
3920                                      paero(in1a+2:fn2b)%numc > nclim )
3921!                 
3922!-- 4) Condensation sink (1/s)
3923       zcs_tot = SUM( zcolrate )   ! total sink
3924!
3925!--    5) Changes in gas-phase concentrations and particle volume
3926!
3927!--    5.1) Organic vapours
3928!
3929!--    5.1.1) Non-volatile organic compound: condenses onto all bins
3930       IF ( pcocnv > 1.0E+10_wp  .AND.  zcs_tot > 1.0E-30_wp  .AND.            &
3931            is_used( prtcl,'OC' ) )                                            &
3932       THEN
3933!--       Ratio of nucleation vs. condensation rates in the smallest bin   
3934          zn_vs_c = 0.0_wp 
3935          IF ( zj3n3(2) > 1.0_wp )  THEN
3936             zn_vs_c = ( zj3n3(2) ) / ( zj3n3(2) + pcocnv * zcolrate(in1a) )
3937          ENDIF
3938!       
3939!--       Collision rate in the smallest bin, including nucleation and
3940!--       condensation(see Jacobson, Fundamentals of Atmospheric Modeling, 2nd
3941!--       Edition (2005), equation (16.73) )
3942          zcolrate_ocnv = zcolrate
3943          zcolrate_ocnv(in1a) = zcolrate_ocnv(in1a) + zj3n3(2) / pcocnv
3944!       
3945!--       Total sink for organic vapor
3946          zcs_ocnv = zcs_tot + zj3n3(2) / pcocnv
3947!       
3948!--       New gas phase concentration (#/m3)
3949          zcvap_new2 = pcocnv / ( 1.0_wp + ptstep * zcs_ocnv )
3950!       
3951!--       Change in gas concentration (#/m3)
3952          zdvap2 = pcocnv - zcvap_new2
3953!
3954!--       Updated vapour concentration (#/m3)               
3955          pcocnv = zcvap_new2
3956!       
3957!--       Volume change of particles (m3(OC)/m3(air))
3958          zdvoloc = zcolrate_ocnv(in1a:fn2b) / zcs_ocnv * amvoc * zdvap2
3959!       
3960!--       Change of volume due to condensation in 1a-2b
3961          paero(in1a:fn2b)%volc(2) = paero(in1a:fn2b)%volc(2) + zdvoloc 
3962!       
3963!--       Change of number concentration in the smallest bin caused by
3964!--       nucleation (Jacobson (2005), equation (16.75)). If zxocnv = 0, then 
3965!--       the chosen nucleation mechanism doesn't take into account the non-
3966!--       volatile organic vapors and thus the paero doesn't have to be updated.
3967          IF ( zxocnv > 0.0_wp )  THEN
3968             paero(in1a)%numc = paero(in1a)%numc + zn_vs_c * zdvoloc(in1a) /   &
3969                                amvoc / ( n3 * zxocnv )
3970          ENDIF
3971       ENDIF
3972!   
3973!--    5.1.2) Semivolatile organic compound: all bins except subrange 1
3974       zcs_ocsv = SUM( zcolrate(in2a:fn2b) ) !< sink for semi-volatile organics
3975       IF ( pcocsv > 1.0E+10_wp  .AND.  zcs_ocsv > 1.0E-30  .AND.              &
3976            is_used( prtcl,'OC') )                                             &
3977       THEN
3978!
3979!--       New gas phase concentration (#/m3)
3980          zcvap_new3 = pcocsv / ( 1.0_wp + ptstep * zcs_ocsv )
3981!       
3982!--       Change in gas concentration (#/m3)
3983          zdvap3 = pcocsv - zcvap_new3 
3984!       
3985!--       Updated gas concentration (#/m3)               
3986          pcocsv = zcvap_new3
3987!       
3988!--       Volume change of particles (m3(OC)/m3(air))
3989          zdvoloc(in2a:fn2b) = zdvoloc(in2a:fn2b) + zcolrate(in2a:fn2b) /      &
3990                               zcs_ocsv * amvoc * zdvap3
3991!                           
3992!--       Change of volume due to condensation in 1a-2b
3993          paero(in1a:fn2b)%volc(2) = paero(in1a:fn2b)%volc(2) + zdvoloc 
3994       ENDIF
3995!
3996!-- 5.2) Sulphate: condensed on all bins
3997       IF ( pcsa > 1.0E+10_wp  .AND.  zcs_tot > 1.0E-30_wp  .AND.              &
3998            is_used( prtcl,'SO4' ) )                                           &
3999       THEN
4000!   
4001!--    Ratio of mass transfer between nucleation and condensation
4002          zn_vs_c = 0.0_wp
4003          IF ( zj3n3(1) > 1.0_wp )  THEN
4004             zn_vs_c = ( zj3n3(1) ) / ( zj3n3(1) + pcsa * zcolrate(in1a) )
4005          ENDIF
4006!       
4007!--       Collision rate in the smallest bin, including nucleation and
4008!--       condensation (see Jacobson, Fundamentals of Atmospheric Modeling, 2nd
4009!--       Edition (2005), equation (16.73))
4010          zcolrate(in1a) = zcolrate(in1a) + zj3n3(1) / pcsa     
4011!       
4012!--       Total sink for sulfate (1/s)
4013          zcs_su = zcs_tot + zj3n3(1) / pcsa
4014!       
4015!--       Sulphuric acid:
4016!--       New gas phase concentration (#/m3)
4017          zcvap_new1 = pcsa / ( 1.0_wp + ptstep * zcs_su )
4018!       
4019!--       Change in gas concentration (#/m3)
4020          zdvap1 = pcsa - zcvap_new1
4021!       
4022!--       Updating vapour concentration (#/m3)
4023          pcsa = zcvap_new1
4024!       
4025!--       Volume change of particles (m3(SO4)/m3(air)) by condensation
4026          zdvolsa = zcolrate(in1a:fn2b) / zcs_su * amvh2so4 * zdvap1
4027!--       For validation: zdvolsa = 5.5 mum3/cm3 per 12 h       
4028       !   zdvolsa = zdvolsa / SUM( zdvolsa ) * 5.5E-12_wp * dt_salsa / 43200.0_wp 
4029          !0.3E-12_wp, 0.6E-12_wp, 11.0E-12_wp, 4.6E-12_wp, 9.2E-12_wp   
4030!       
4031!--       Change of volume concentration of sulphate in aerosol [fxm]
4032          paero(in1a:fn2b)%volc(1) = paero(in1a:fn2b)%volc(1) + zdvolsa
4033!       
4034!--       Change of number concentration in the smallest bin caused by nucleation
4035!--       (Jacobson (2005), equation (16.75))
4036          IF ( zxsa > 0.0_wp )  THEN
4037             paero(in1a)%numc = paero(in1a)%numc + zn_vs_c * zdvolsa(in1a) /   &
4038                                amvh2so4 / ( n3 * zxsa )
4039          ENDIF
4040       ENDIF
4041    ENDIF
4042!
4043!
4044!-- Condensation of water vapour
4045    IF ( lscndh2oae )  THEN
4046       CALL gpparth2o( paero, ptemp, ppres, pcs, pcw, ptstep )
4047    ENDIF
4048!   
4049!
4050!-- Partitioning of H2O, HNO3, and NH3: Dissolutional growth
4051    IF ( lscndgas  .AND.  ino > 0  .AND.  inh > 0  .AND.                       &
4052         ( pchno3 > 1.0E+10_wp  .OR.  pcnh3 > 1.0E+10_wp ) )                   &
4053    THEN
4054       CALL gpparthno3( ppres, ptemp, paero, pchno3, pcnh3, pcw, pcs, zbeta,   &
4055                        ptstep )
4056    ENDIF
4057   
4058 END SUBROUTINE condensation
4059 
4060!------------------------------------------------------------------------------!
4061! Description:
4062! ------------
4063!> Calculates the particle number and volume increase, and gas-phase
4064!> concentration decrease due to nucleation subsequent growth to detectable size
4065!> of 3 nm.
4066!
4067!> Method:
4068!> When the formed clusters grow by condensation (possibly also by self-
4069!> coagulation), their number is reduced due to scavenging to pre-existing
4070!> particles. Thus, the apparent nucleation rate at 3 nm is significantly lower
4071!> than the real nucleation rate (at ~1 nm).
4072!
4073!> Calculation of the formation rate of detectable particles at 3 nm (i.e. J3):
4074!> nj3 = 1: Kerminen, V.-M. and Kulmala, M. (2002), J. Aerosol Sci.,33, 609-622.
4075!> nj3 = 2: Lehtinen et al. (2007), J. Aerosol Sci., 38(9), 988-994.
4076!> nj3 = 3: Anttila et al. (2010), J. Aerosol Sci., 41(7), 621-636.
4077!
4078!> Called from subroutine condensation (in module salsa_dynamics_mod.f90)
4079!
4080!> Calls one of the following subroutines:
4081!>  - binnucl
4082!>  - ternucl
4083!>  - kinnucl
4084!>  - actnucl
4085!
4086!> fxm: currently only sulphuric acid grows particles from 1 to 3 nm
4087!>  (if asked from Markku, this is terribly wrong!!!)
4088!
4089!> Coded by:
4090!> Hannele Korhonen (FMI) 2005
4091!> Harri Kokkola (FMI) 2006
4092!> Matti Niskanen(FMI) 2012
4093!> Anton Laakso  (FMI) 2013
4094!------------------------------------------------------------------------------!
4095
4096 SUBROUTINE nucleation( paero, ptemp, prh, ppres, pcsa, pcocnv, pcnh3, ptstep, &
4097                        pj3n3, pxsa, pxocnv )
4098    IMPLICIT NONE
4099!       
4100!-- Input and output variables
4101    REAL(wp), INTENT(in) ::  pcnh3    !< ammonia concentration (#/m3)
4102    REAL(wp), INTENT(in) ::  pcocnv   !< conc. of non-volatile OC (#/m3)     
4103    REAL(wp), INTENT(in) ::  pcsa     !< sulphuric acid conc. (#/m3)
4104    REAL(wp), INTENT(in) ::  ppres    !< ambient air pressure (Pa)
4105    REAL(wp), INTENT(in) ::  prh      !< ambient rel. humidity [0-1]       
4106    REAL(wp), INTENT(in) ::  ptemp    !< ambient temperature (K)
4107    REAL(wp), INTENT(in) ::  ptstep   !< time step (s) of SALSA
4108    TYPE(t_section), INTENT(inout) ::  paero(fn2b) !< aerosol properties                                                 
4109    REAL(wp), INTENT(inout) ::  pj3n3(2) !< formation mass rate of molecules
4110                                         !< (molec/m3s) for 1: H2SO4 and
4111                                         !< 2: organic vapour
4112    REAL(wp), INTENT(out) ::  pxocnv !< ratio of non-volatile organic vapours in
4113                                     !< 3nm aerosol particles
4114    REAL(wp), INTENT(out) ::  pxsa   !< ratio of H2SO4 in 3nm aerosol particles
4115!-- Local variables
4116    INTEGER(iwp) ::  iteration
4117    REAL(wp) ::  zbeta(fn2b)  !< transitional correction factor                                         
4118    REAL(wp) ::  zc_h2so4     !< H2SO4 conc. (#/cm3) !UNITS!
4119    REAL(wp) ::  zc_org       !< organic vapour conc. (#/cm3)
4120    REAL(wp) ::  zCoagStot    !< total losses due to coagulation, including
4121                              !< condensation and self-coagulation       
4122    REAL(wp) ::  zcocnv_local !< organic vapour conc. (#/m3)
4123    REAL(wp) ::  zcsink       !< condensational sink (#/m2)       
4124    REAL(wp) ::  zcsa_local   !< H2SO4 conc. (#/m3)       
4125    REAL(wp) ::  zdcrit       !< diameter of critical cluster (m)
4126    REAL(wp) ::  zdelta_vap   !< change of H2SO4 and organic vapour
4127                              !< concentration (#/m3)       
4128    REAL(wp) ::  zdfvap       !< air diffusion coefficient (m2/s)
4129    REAL(wp) ::  zdmean       !< mean diameter of existing particles (m)
4130    REAL(wp) ::  zeta         !< constant: proportional to ratio of CS/GR (m)
4131                              !< (condensation sink / growth rate)                                   
4132    REAL(wp) ::  zgamma       !< proportionality factor ((nm2*m2)/h)                                       
4133    REAL(wp) ::  zGRclust     !< growth rate of formed clusters (nm/h)
4134    REAL(wp) ::  zGRtot       !< total growth rate       
4135    REAL(wp) ::  zj3          !< number conc. of formed 3nm particles (#/m3)       
4136    REAL(wp) ::  zjnuc        !< nucleation rate at ~1nm (#/m3s)
4137    REAL(wp) ::  zKeff        !< effective cogulation coefficient between
4138                              !< freshly nucleated particles       
4139    REAL(wp) ::  zknud(fn2b)  !< particle Knudsen number       
4140    REAL(wp) ::  zkocnv       !< lever: zkocnv=1 --> organic compounds involved
4141                              !< in nucleation   
4142    REAL(wp) ::  zksa         !< lever: zksa=1 --> H2SO4 involved in nucleation
4143    REAL(wp) ::  zlambda      !< parameter for adjusting the growth rate due to
4144                              !< self-coagulation                                 
4145    REAL(wp) ::  zmfp         !< mean free path of condesing vapour(m)                                       
4146    REAL(wp) ::  zmixnh3      !< ammonia mixing ratio (ppt)
4147    REAL(wp) ::  zNnuc        !< number of clusters/particles at the size range
4148                              !< d1-dx (#/m3) 
4149    REAL(wp) ::  znoc         !< number of organic molecules in critical cluster
4150    REAL(wp) ::  znsa         !< number of H2SO4 molecules in critical cluster                                           
4151!
4152!-- Variable determined for the m-parameter
4153    REAL(wp) ::  zCc_2(fn2b) !<
4154    REAL(wp) ::  zCc_c !<
4155    REAL(wp) ::  zCc_x !<
4156    REAL(wp) ::  zCoagS_c !<
4157    REAL(wp) ::  zCoagS_x !<
4158    REAL(wp) ::  zcv_2(fn2b) !<
4159    REAL(wp) ::  zcv_c !<
4160    REAL(wp) ::  zcv_c2(fn2b) !<
4161    REAL(wp) ::  zcv_x !<
4162    REAL(wp) ::  zcv_x2(fn2b) !<
4163    REAL(wp) ::  zDc_2(fn2b) !<
4164    REAL(wp) ::  zDc_c(fn2b) !<
4165    REAL(wp) ::  zDc_c2(fn2b) !<
4166    REAL(wp) ::  zDc_x(fn2b) !<
4167    REAL(wp) ::  zDc_x2(fn2b) !<
4168    REAL(wp) ::  zgammaF_2(fn2b) !<
4169    REAL(wp) ::  zgammaF_c(fn2b) !<
4170    REAL(wp) ::  zgammaF_x(fn2b) !<
4171    REAL(wp) ::  zK_c2(fn2b) !<
4172    REAL(wp) ::  zK_x2(fn2b) !<
4173    REAL(wp) ::  zknud_2(fn2b) !<
4174    REAL(wp) ::  zknud_c !<
4175    REAL(wp) ::  zknud_x !<       
4176    REAL(wp) ::  zm_2(fn2b) !<
4177    REAL(wp) ::  zm_c !<
4178    REAL(wp) ::  zm_para !<
4179    REAL(wp) ::  zm_x !<
4180    REAL(wp) ::  zmyy !<
4181    REAL(wp) ::  zomega_2c(fn2b) !<
4182    REAL(wp) ::  zomega_2x(fn2b) !<
4183    REAL(wp) ::  zomega_c(fn2b) !<
4184    REAL(wp) ::  zomega_x(fn2b) !<
4185    REAL(wp) ::  zRc2(fn2b) !<
4186    REAL(wp) ::  zRx2(fn2b) !<
4187    REAL(wp) ::  zsigma_c2(fn2b) !<
4188    REAL(wp) ::  zsigma_x2(fn2b) !<
4189!
4190!-- 1) Nucleation rate (zjnuc) and diameter of critical cluster (zdcrit)
4191    zjnuc  = 0.0_wp
4192    znsa   = 0.0_wp
4193    znoc   = 0.0_wp
4194    zdcrit = 0.0_wp
4195    zksa   = 0.0_wp
4196    zkocnv = 0.0_wp
4197   
4198    SELECT CASE ( nsnucl )
4199   
4200    CASE(1)   ! Binary H2SO4-H2O nucleation
4201       
4202       zc_h2so4 = pcsa * 1.0E-6_wp   ! sulphuric acid conc. to #/cm3
4203       CALL binnucl( zc_h2so4, ptemp, prh, zjnuc, znsa, znoc, zdcrit,  zksa, &
4204                     zkocnv )     
4205   
4206    CASE(2)   ! Activation type nucleation
4207   
4208       zc_h2so4 = pcsa * 1.0E-6_wp   ! sulphuric acid conc. to #/cm3
4209       CALL binnucl( zc_h2so4, ptemp, prh, zjnuc, znsa,  znoc, zdcrit, zksa,  &
4210                     zkocnv )
4211       CALL actnucl( pcsa, zjnuc, zdcrit, znsa, znoc, zksa, zkocnv, act_coeff )
4212   
4213    CASE(3)   ! Kinetically limited nucleation of (NH4)HSO4 clusters
4214       
4215       zc_h2so4 = pcsa * 1.0E-6_wp   ! sulphuric acid conc. to #/cm3
4216       CALL binnucl( zc_h2so4, ptemp, prh, zjnuc, znsa, znoc, zdcrit, zksa,    &
4217                     zkocnv )
4218
4219       CALL kinnucl( zc_h2so4, zjnuc, zdcrit, znsa, znoc, zksa, zkocnv )
4220   
4221    CASE(4)   ! Ternary H2SO4-H2O-NH3 nucleation
4222   
4223       zmixnh3 = pcnh3 * ptemp * argas / ( ppres * avo )
4224       zc_h2so4 = pcsa * 1.0E-6_wp   ! sulphuric acid conc. to #/cm3
4225       CALL ternucl( zc_h2so4, zmixnh3, ptemp, prh, zjnuc, znsa, znoc, zdcrit, &
4226                     zksa, zkocnv ) 
4227   
4228    CASE(5)   ! Organic nucleation, J~[ORG] or J~[ORG]**2
4229   
4230       zc_org = pcocnv * 1.0E-6_wp   ! conc. of non-volatile OC to #/cm3
4231       zc_h2so4 = pcsa * 1.0E-6_wp   ! sulphuric acid conc. to #/cm3
4232       CALL binnucl( zc_h2so4, ptemp, prh, zjnuc, znsa, znoc, zdcrit, zksa,    &
4233                     zkocnv ) 
4234       CALL orgnucl( pcocnv, zjnuc, zdcrit, znsa, znoc, zksa, zkocnv )
4235   
4236    CASE(6)   ! Sum of H2SO4 and organic activation type nucleation,
4237              ! J~[H2SO4]+[ORG]
4238       
4239       zc_h2so4 = pcsa * 1.0E-6_wp   ! sulphuric acid conc. to #/cm3
4240       CALL binnucl( zc_h2so4, ptemp, prh, zjnuc, znsa, znoc, zdcrit, zksa,    &
4241                     zkocnv ) 
4242       CALL sumnucl( pcsa, pcocnv, zjnuc, zdcrit, znsa, znoc, zksa, zkocnv )
4243
4244           
4245    CASE(7)   ! Heteromolecular nucleation, J~[H2SO4]*[ORG]
4246       
4247       zc_h2so4 = pcsa * 1.0E-6_wp   ! sulphuric acid conc. to #/cm3
4248       zc_org = pcocnv * 1.0E-6_wp   ! conc. of non-volatile OC to #/cm3
4249       CALL binnucl( zc_h2so4, ptemp, prh, zjnuc, znsa, znoc, zdcrit, zksa,    &
4250                     zkocnv ) 
4251       CALL hetnucl( zc_h2so4, zc_org, zjnuc, zdcrit, znsa, znoc, zksa, zkocnv )
4252   
4253    CASE(8)   ! Homomolecular nucleation of H2SO4 and heteromolecular
4254              ! nucleation of H2SO4 and organic vapour,
4255              ! J~[H2SO4]**2 + [H2SO4]*[ORG] (EUCAARI project)
4256       zc_h2so4 = pcsa * 1.0E-6_wp   ! sulphuric acid conc. to #/cm3
4257       zc_org = pcocnv * 1.0E-6_wp   ! conc. of non-volatile OC to #/cm3
4258       CALL binnucl( zc_h2so4, ptemp, prh, zjnuc, znsa, znoc, zdcrit, zksa,    &
4259                     zkocnv ) 
4260       CALL SAnucl( zc_h2so4, zc_org, zjnuc, zdcrit, znsa, znoc, zksa, zkocnv )
4261   
4262    CASE(9)   ! Homomolecular nucleation of H2SO4 and organic vapour and
4263              ! heteromolecular nucleation of H2SO4 and organic vapour,
4264              ! J~[H2SO4]**2 + [H2SO4]*[ORG]+[ORG]**2 (EUCAARI project)
4265   
4266       zc_h2so4 = pcsa * 1.0E-6_wp   ! sulphuric acid conc. to #/cm3
4267       zc_org = pcocnv * 1.0E-6_wp   ! conc. of non-volatile OC to #/cm3
4268       CALL binnucl( zc_h2so4, ptemp, prh, zjnuc, znsa, znoc, zdcrit, zksa,    &
4269                     zkocnv ) 
4270
4271       CALL SAORGnucl( zc_h2so4, zc_org, zjnuc, zdcrit, znsa, znoc, zksa,      &
4272                       zkocnv )
4273    END SELECT
4274   
4275    zcsa_local = pcsa
4276    zcocnv_local = pcocnv
4277!
4278!-- 2) Change of particle and gas concentrations due to nucleation
4279!         
4280!-- 2.1) Check that there is enough H2SO4 and organic vapour to produce the
4281!--      nucleation 
4282    IF ( nsnucl <= 4 )  THEN 
4283!--    If the chosen nucleation scheme is 1-4, nucleation occurs only due to
4284!--    H2SO4. All of the total vapour concentration that is taking part to the
4285!--    nucleation is there for sulphuric acid (sa = H2SO4) and non-volatile
4286!--    organic vapour is zero.
4287       pxsa   = 1.0_wp   ! ratio of sulphuric acid in 3nm particles
4288       pxocnv = 0.0_wp   ! ratio of non-volatile origanic vapour
4289                                ! in 3nm particles
4290    ELSEIF ( nsnucl > 4 )  THEN
4291!--    If the chosen nucleation scheme is 5-9, nucleation occurs due to organic
4292!--    vapour or the combination of organic vapour and H2SO4. The number of
4293!--    needed molecules depends on the chosen nucleation type and it has an
4294!--    effect also on the minimum ratio of the molecules present.
4295       IF ( pcsa * znsa + pcocnv * znoc < 1.E-14_wp )  THEN
4296          pxsa   = 0.0_wp
4297          pxocnv = 0.0_wp             
4298       ELSE
4299          pxsa   = pcsa * znsa / ( pcsa * znsa + pcocnv * znoc ) 
4300          pxocnv = pcocnv * znoc / ( pcsa * znsa + pcocnv * znoc )
4301       ENDIF 
4302    ENDIF
4303!   
4304!-- The change in total vapour concentration is the sum of the concentrations
4305!-- of the vapours taking part to the nucleation (depends on the chosen
4306!-- nucleation scheme)
4307    zdelta_vap = MIN( zjnuc * ( znoc + znsa ), ( pcocnv * zkocnv + pcsa *      &
4308                      zksa ) / ptstep ) 
4309!                     
4310!-- Nucleation rate J at ~1nm (#/m3s)                           
4311    zjnuc = zdelta_vap / ( znoc + znsa )
4312!   
4313!-- H2SO4 concentration after nucleation in #/m3           
4314    zcsa_local = MAX( 1.0_wp, pcsa - zdelta_vap * pxsa ) 
4315!   
4316!-- Non-volative organic vapour concentration after nucleation (#/m3)
4317    zcocnv_local = MAX( 1.0_wp, pcocnv - zdelta_vap * pxocnv )
4318!
4319!-- 2.2) Formation rate of 3 nm particles (Kerminen & Kulmala, 2002)
4320!
4321!-- 2.2.1) Growth rate of clusters formed by H2SO4
4322!
4323!-- GR = 3.0e-15 / dens_clus * sum( molecspeed * molarmass * conc )
4324
4325!-- dens_clus  = density of the clusters (here 1830 kg/m3)
4326!-- molarmass  = molar mass of condensing species (here 98.08 g/mol)
4327!-- conc       = concentration of condensing species [#/m3]
4328!-- molecspeed = molecular speed of condensing species [m/s]
4329!--            = sqrt( 8.0 * R * ptemp / ( pi * molarmass ) )
4330!-- (Seinfeld & Pandis, 1998)
4331!
4332!-- Growth rate by H2SO4 and organic vapour in nm/h (Eq. 21)
4333    zGRclust = 2.3623E-15_wp * SQRT( ptemp ) * ( zcsa_local + zcocnv_local )
4334!   
4335!-- 2.2.2) Condensational sink of pre-existing particle population
4336!
4337!-- Diffusion coefficient (m2/s)
4338    zdfvap = 5.1111E-10_wp * ptemp ** 1.75_wp * ( p_0 + 1325.0_wp ) / ppres
4339!-- Mean free path of condensing vapour (m) (Jacobson (2005), Eq. 15.25 and
4340!-- 16.29)
4341    zmfp = 3.0_wp * zdfvap * SQRT( pi * amh2so4 / ( 8.0_wp * argas * ptemp ) )
4342!-- Knudsen number           
4343    zknud = 2.0_wp * zmfp / ( paero(:)%dwet + d_sa )                     
4344!-- Transitional regime correction factor (zbeta) according to Fuchs and
4345!-- Sutugin (1971), In: Hidy et al. (ed.), Topics in current  aerosol research,
4346!-- Pergamon. (Eq. 4 in Kerminen and Kulmala, 2002)
4347    zbeta = ( zknud + 1.0_wp) / ( 0.377_wp * zknud + 1.0_wp + 4.0_wp /         &
4348            ( 3.0_wp * massacc ) * ( zknud + zknud ** 2 ) ) 
4349!-- Condensational sink (#/m2) (Eq. 3)
4350    zcsink = SUM( paero(:)%dwet * zbeta * paero(:)%numc )
4351!
4352!-- Parameterised formation rate of detectable 3 nm particles (i.e. J3)
4353    IF ( nj3 == 1 )  THEN   ! Kerminen and Kulmala (2002)
4354!--    2.2.3) Parameterised formation rate of detectable 3 nm particles
4355!--    Constants needed for the parameterisation:
4356!--    dapp = 3 nm and dens_nuc = 1830 kg/m3
4357       IF ( zcsink < 1.0E-30_wp )  THEN
4358          zeta = 0._dp
4359       ELSE
4360!--       Mean diameter of backgroud population (nm)
4361          zdmean = 1.0_wp / SUM( paero(:)%numc ) * SUM( paero(:)%numc *        &
4362                   paero(:)%dwet ) * 1.0E+9_wp
4363!--       Proportionality factor (nm2*m2/h) (Eq. 22)
4364          zgamma = 0.23_wp * ( zdcrit * 1.0E+9_wp ) ** 0.2_wp * ( zdmean /     &
4365                 150.0_wp ) ** 0.048_wp * ( ptemp / 293.0_wp ) ** ( -0.75_wp ) &
4366                 * ( arhoh2so4 / 1000.0_wp ) ** ( -0.33_wp )
4367!--       Factor eta (nm) (Eq. 11)
4368          zeta = MIN( zgamma * zcsink / zGRclust, zdcrit * 1.0E11_wp ) 
4369       ENDIF
4370!       
4371!--    Number conc. of clusters surviving to 3 nm in a time step (#/m3) (Eq.14)
4372       zj3 = zjnuc * EXP( MIN( 0.0_wp, zeta / 3.0_wp - zeta /                  &
4373                               ( zdcrit * 1.0E9_wp ) ) )                   
4374
4375    ELSEIF ( nj3 > 1 )  THEN
4376!--    Defining the value for zm_para. The growth is investigated between
4377!--    [d1,reglim(1)] = [zdcrit,3nm]   
4378!--    m = LOG( CoagS_dx / CoagX_zdcrit ) / LOG( reglim / zdcrit )
4379!--    (Lehtinen et al. 2007, Eq. 5)
4380!--    The steps for the coagulation sink for reglim = 3nm and zdcrit ~= 1nm are
4381!--    explained in article of Kulmala et al. (2001). The particles of diameter
4382!--    zdcrit ~1.14 nm  and reglim = 3nm are both in turn the "number 1"
4383!--    variables (Kulmala et al. 2001).             
4384!--    c = critical (1nm), x = 3nm, 2 = wet or mean droplet
4385!--    Sum of the radii, R12 = R1 + zR2 (m) of two particles 1 and 2
4386       zRc2 = zdcrit / 2.0_wp + paero(:)%dwet / 2.0_wp
4387       zRx2 = reglim(1) / 2.0_wp + paero(:)%dwet / 2.0_wp
4388!       
4389!--    The mass of particle (kg) (comes only from H2SO4)
4390       zm_c = 4.0_wp / 3.0_wp * pi * ( zdcrit / 2.0_wp ) ** 3.0_wp * arhoh2so4                     
4391       zm_x = 4.0_wp / 3.0_wp * pi * ( reglim(1) / 2.0_wp ) ** 3.0_wp *        &
4392              arhoh2so4                 
4393       zm_2 = 4.0_wp / 3.0_wp * pi * ( paero(:)%dwet / 2.0_wp )** 3.0_wp *     &
4394              arhoh2so4
4395!             
4396!--    Mean relative thermal velocity between the particles (m/s)
4397       zcv_c = SQRT( 8.0_wp * abo * ptemp / ( pi * zm_c ) )
4398       zcv_x = SQRT( 8.0_wp * abo * ptemp / ( pi * zm_x ) )
4399       zcv_2 = SQRT( 8.0_wp * abo * ptemp / ( pi * zm_2 ) )
4400!       
4401!--    Average velocity after coagulation               
4402       zcv_c2 = SQRT( zcv_c ** 2.0_wp + zcv_2 ** 2.0_wp )
4403       zcv_x2 = SQRT( zcv_x ** 2.0_wp + zcv_2 ** 2.0_wp )
4404!       
4405!--    Knudsen number (zmfp = mean free path of condensing vapour)
4406       zknud_c = 2.0_wp * zmfp / zdcrit
4407       zknud_x = 2.0_wp * zmfp / reglim(1)
4408       zknud_2 = MAX( 0.0_wp, 2.0_wp * zmfp / paero(:)%dwet )
4409!
4410!--    Cunningham correction factor               
4411       zCc_c = 1.0_wp + zknud_c * ( 1.142_wp + 0.558_wp *                      &
4412               EXP( -0.999_wp / zknud_c ) ) 
4413       zCc_x = 1.0_wp + zknud_x * ( 1.142_wp + 0.558_wp *                      &
4414               EXP( -0.999_wp / zknud_x ) )
4415       zCc_2 = 1.0_wp + zknud_2 * ( 1.142_wp + 0.558_wp *                      &
4416               EXP( -0.999_wp / zknud_2 ) )
4417!                     
4418!--    Gas dynamic viscosity (N*s/m2).
4419!--    Viscocity(air @20C) = 1.81e-5_dp N/m2 *s (Hinds, p. 25)                     
4420       zmyy = 1.81E-5_wp * ( ptemp / 293.0_wp) ** ( 0.74_wp ) 
4421!       
4422!--    Particle diffusion coefficient (m2/s)               
4423       zDc_c = abo * ptemp * zCc_c / ( 3.0_wp * pi * zmyy * zdcrit ) 
4424       zDc_x = abo * ptemp * zCc_x / ( 3.0_wp * pi * zmyy * reglim(1) )
4425       zDc_2 = abo * ptemp * zCc_2 / ( 3.0_wp * pi * zmyy * paero(:)%dwet )
4426!       
4427!--    D12 = D1+D2 (Seinfield and Pandis, 2nd ed. Eq. 13.38)
4428       zDc_c2 = zDc_c + zDc_2   
4429       zDc_x2 = zDc_x + zDc_2 
4430!       
4431!--    zgammaF = 8*D/pi/zcv (m) for calculating zomega
4432       zgammaF_c = 8.0_wp * zDc_c / pi / zcv_c 
4433       zgammaF_x = 8.0_wp * zDc_x / pi / zcv_x
4434       zgammaF_2 = 8.0_wp * zDc_2 / pi / zcv_2
4435!       
4436!--    zomega (m) for calculating zsigma             
4437       zomega_c = ( ( zRc2 + zgammaF_c ) ** 3 - ( zRc2 ** 2 +                  &
4438                      zgammaF_c ) ** ( 3.0_wp / 2.0_wp ) ) / ( 3.0_wp *        &
4439                      zRc2 * zgammaF_c ) - zRc2 
4440       zomega_x = ( ( zRx2 + zgammaF_x ) ** 3.0_wp - ( zRx2 ** 2.0_wp +        &
4441                      zgammaF_x ) ** ( 3.0_wp / 2.0_wp ) ) / ( 3.0_wp *        &
4442                      zRx2 * zgammaF_x ) - zRx2
4443       zomega_2c = ( ( zRc2 + zgammaF_2 ) ** 3.0_wp - ( zRc2 ** 2.0_wp +       &
4444                       zgammaF_2 ) ** ( 3.0_wp / 2.0_wp ) ) / ( 3.0_wp *       &
4445                       zRc2 * zgammaF_2 ) - zRc2 
4446       zomega_2x = ( ( zRx2 + zgammaF_2 ) ** 3.0_wp - ( zRx2 ** 2.0_wp +       &
4447                       zgammaF_2 ) ** ( 3.0_wp / 2.0_wp ) ) / ( 3.0_wp *       &
4448                       zRx2 * zgammaF_2 ) - zRx2 
4449!                       
4450!--    The distance (m) at which the two fluxes are matched (condensation and
4451!--    coagulation sinks?)           
4452       zsigma_c2 = SQRT( zomega_c ** 2.0_wp + zomega_2c ** 2.0_wp ) 
4453       zsigma_x2 = SQRT( zomega_x ** 2.0_wp + zomega_2x ** 2.0_wp ) 
4454!       
4455!--    Coagulation coefficient in the continuum regime (m*m2/s)
4456       zK_c2 = 4.0_wp * pi * zRc2 * zDc_c2 / ( zRc2 / ( zRc2 + zsigma_c2 ) +   &
4457               4.0_wp * zDc_c2 / ( zcv_c2 * zRc2 ) ) 
4458       zK_x2 = 4.0_wp * pi * zRx2 * zDc_x2 / ( zRx2 / ( zRx2 + zsigma_x2 ) +   &
4459               4.0_wp * zDc_x2 / ( zcv_x2 * zRx2 ) )
4460!               
4461!--    Coagulation sink (1/s)
4462       zCoagS_c = MAX( 1.0E-20_wp, SUM( zK_c2 * paero(:)%numc ) )         
4463       zCoagS_x = MAX( 1.0E-20_wp, SUM( zK_x2 * paero(:)%numc ) ) 
4464!       
4465!--    Parameter m for calculating the coagulation sink onto background
4466!--    particles (Eq. 5&6 in Lehtinen et al. 2007)             
4467       zm_para = LOG( zCoagS_x / zCoagS_c ) / LOG( reglim(1) / zdcrit )
4468!       
4469!--    Parameter gamma for calculating the formation rate J of particles having
4470!--    a diameter zdcrit < d < reglim(1) (Anttila et al. 2010, eq. 5)
4471       zgamma = ( ( ( reglim(1) / zdcrit ) ** ( zm_para + 1.0_wp ) ) - 1.0_wp )&
4472                / ( zm_para + 1.0_wp )     
4473               
4474       IF ( nj3 == 2 )  THEN   ! Coagulation sink
4475!       
4476!--       Formation rate J before iteration (#/m3s)               
4477          zj3 = zjnuc * EXP( MIN( 0.0_wp, -zgamma * zdcrit * zCoagS_c /        &
4478                ( zGRclust * 1.0E-9_wp / ( 60.0_wp ** 2.0_wp ) ) ) )
4479               
4480       ELSEIF ( nj3 == 3 )  THEN  ! Coagulation sink and self-coag.
4481!--       IF polluted air... then the self-coagulation becomes important.
4482!--       Self-coagulation of small particles < 3 nm.
4483!
4484!--       "Effective" coagulation coefficient between freshly-nucleated
4485!--       particles:
4486          zKeff = 5.0E-16_wp   ! cm3/s
4487!         
4488!--       zlambda parameter for "adjusting" the growth rate due to the
4489!--       self-coagulation
4490          zlambda = 6.0_wp 
4491          IF ( reglim(1) >= 10.0E-9_wp )  THEN   ! for particles >10 nm:
4492             zKeff   = 5.0E-17_wp
4493             zlambda = 3.0_wp
4494          ENDIF
4495!         
4496!--       Initial values for coagulation sink and growth rate  (m/s)
4497          zCoagStot = zCoagS_c
4498          zGRtot = zGRclust * 1.0E-9_wp / 60.0_wp ** 2.0_wp 
4499!         
4500!--       Number of clusters/particles at the size range [d1,dx] (#/m3):
4501          zNnuc = zjnuc / zCoagStot !< Initial guess
4502!         
4503!--       Coagulation sink and growth rate due to self-coagulation:
4504          DO  iteration = 1, 5
4505             zCoagStot = zCoagS_c + zKeff * zNnuc * 1.0E-6_wp   ! (1/s) 
4506             zGRtot = zGRclust * 1.0E-9_wp / ( 3600.0_wp ) +  1.5708E-6_wp *   &
4507                      zlambda * zdcrit ** 3.0_wp * ( zNnuc * 1.0E-6_wp ) *     &
4508                      zcv_c * avo * 1.0E-9_wp / 3600.0_wp 
4509             zeta = - zCoagStot / ( ( zm_para + 1.0_wp ) * zGRtot * ( zdcrit **&
4510                      zm_para ) )   ! Eq. 7b (Anttila)
4511             zNnuc =  zNnuc_tayl( zdcrit, reglim(1), zm_para, zjnuc, zeta,     &
4512                      zGRtot )
4513          ENDDO
4514!         
4515!--       Calculate the final values with new zNnuc:   
4516          zCoagStot = zCoagS_c + zKeff * zNnuc * 1.0E-6_wp   ! (1/s)
4517          zGRtot = zGRclust * 1.0E-9_wp / 3600.0_wp + 1.5708E-6_wp *  zlambda  &
4518                   * zdcrit ** 3.0_wp * ( zNnuc * 1.0E-6_wp ) * zcv_c * avo *  &
4519                   1.0E-9_wp / 3600.0_wp !< (m/s)
4520          zj3 = zjnuc * EXP( MIN( 0.0_wp, -zgamma * zdcrit * zCoagStot /       &
4521                zGRtot ) )   ! (Eq. 5a) (#/m3s)
4522               
4523       ENDIF
4524       
4525    ENDIF
4526!-- If J3 very small (< 1 #/cm3), neglect particle formation. In real atmosphere
4527!-- this would mean that clusters form but coagulate to pre-existing particles
4528!-- who gain sulphate. Since CoagS ~ CS (4piD*CS'), we do *not* update H2SO4
4529!-- concentration here but let condensation take care of it.
4530!-- Formation mass rate of molecules (molec/m3s) for 1: H2SO4 and 2: organic
4531!-- vapour
4532    pj3n3(1) = zj3 * n3 * pxsa
4533    pj3n3(2) = zj3 * n3 * pxocnv
4534                                 
4535                         
4536 END SUBROUTINE nucleation
4537
4538!------------------------------------------------------------------------------!
4539! Description:
4540! ------------
4541!> Calculate the nucleation rate and the size of critical clusters assuming
4542!> binary nucleation.
4543!> Parametrisation according to Vehkamaki et al. (2002), J. Geophys. Res.,
4544!> 107(D22), 4622. Called from subroutine nucleation.
4545!------------------------------------------------------------------------------!
4546 SUBROUTINE binnucl( pc_sa, ptemp, prh, pnuc_rate, pn_crit_sa, pn_crit_ocnv,   &
4547                     pd_crit, pk_sa, pk_ocnv )
4548                   
4549    IMPLICIT NONE
4550!       
4551!-- Input and output variables       
4552    REAL(wp), INTENT(in) ::   pc_sa        !< H2SO4 conc. (#/cm3)
4553    REAL(wp), INTENT(in) ::   prh          !< relative humidity [0-1]       
4554    REAL(wp), INTENT(in) ::   ptemp        !< ambient temperature (K)
4555    REAL(wp), INTENT(out) ::  pnuc_rate    !< nucleation rate (#/(m3 s))
4556    REAL(wp), INTENT(out) ::  pn_crit_sa   !< number of H2SO4 molecules in
4557                                           !< cluster (#)
4558    REAL(wp), INTENT(out) ::  pn_crit_ocnv !< number of organic molecules in
4559                                           !< cluster (#)
4560    REAL(wp), INTENT(out) ::  pd_crit      !< diameter of critical cluster (m)
4561    REAL(wp), INTENT(out) ::  pk_sa        !< Lever: if pk_sa = 1, H2SO4 is
4562                                           !< involved in nucleation.
4563    REAL(wp), INTENT(out) ::  pk_ocnv      !< Lever: if pk_ocnv = 1, organic
4564                                           !< compounds are involved in
4565                                           !< nucleation.
4566!-- Local variables
4567    REAL(wp) ::  zx    !< mole fraction of sulphate in critical cluster
4568    REAL(wp) ::  zntot !< number of molecules in critical cluster
4569    REAL(wp) ::  zt    !< temperature
4570    REAL(wp) ::  zpcsa !< sulfuric acid concentration
4571    REAL(wp) ::  zrh   !< relative humidity
4572    REAL(wp) ::  zma   !<
4573    REAL(wp) ::  zmw   !<
4574    REAL(wp) ::  zxmass!<
4575    REAL(wp) ::  za    !<
4576    REAL(wp) ::  zb    !<
4577    REAL(wp) ::  zc    !<
4578    REAL(wp) ::  zroo  !<
4579    REAL(wp) ::  zm1   !<
4580    REAL(wp) ::  zm2   !<
4581    REAL(wp) ::  zv1   !<
4582    REAL(wp) ::  zv2   !<
4583    REAL(wp) ::  zcoll !<
4584   
4585    pnuc_rate = 0.0_wp
4586    pd_crit   = 1.0E-9_wp
4587
4588!             
4589!-- 1) Checking that we are in the validity range of the parameterization 
4590    zt    = MAX( ptemp, 190.15_wp )
4591    zt    = MIN( zt,    300.15_wp )
4592    zpcsa = MAX( pc_sa, 1.0E4_wp  )
4593    zpcsa = MIN( zpcsa, 1.0E11_wp ) 
4594    zrh   = MAX( prh,   0.0001_wp )
4595    zrh   = MIN( zrh,   1.0_wp    )
4596!               
4597!-- 2) Mole fraction of sulphate in a critical cluster (Eq. 11)
4598    zx = 0.7409967177282139_wp                                           &
4599         - 0.002663785665140117_wp * zt                                  &
4600         + 0.002010478847383187_wp * LOG( zrh )                          &
4601         - 0.0001832894131464668_wp* zt * LOG( zrh )                     &
4602         + 0.001574072538464286_wp * LOG( zrh ) ** 2                     &
4603         - 0.00001790589121766952_wp * zt * LOG( zrh ) ** 2              &
4604         + 0.0001844027436573778_wp * LOG( zrh ) ** 3                    &
4605         - 1.503452308794887E-6_wp * zt * LOG( zrh ) ** 3                &
4606         - 0.003499978417957668_wp * LOG( zpcsa )                        &
4607         + 0.0000504021689382576_wp * zt * LOG( zpcsa )
4608!                   
4609!-- 3) Nucleation rate (Eq. 12)
4610    pnuc_rate = 0.1430901615568665_wp                                    &
4611        + 2.219563673425199_wp * zt                                      &
4612        - 0.02739106114964264_wp * zt ** 2                               &
4613        + 0.00007228107239317088_wp * zt ** 3                            &
4614        + 5.91822263375044_wp / zx                                       &
4615        + 0.1174886643003278_wp * LOG( zrh )                             &
4616        + 0.4625315047693772_wp * zt * LOG( zrh )                        &
4617        - 0.01180591129059253_wp * zt ** 2 * LOG( zrh )                  &
4618        + 0.0000404196487152575_wp * zt ** 3 * LOG( zrh )                &
4619        + ( 15.79628615047088_wp * LOG( zrh ) ) / zx                     &
4620        - 0.215553951893509_wp * LOG( zrh ) ** 2                         &
4621        - 0.0810269192332194_wp * zt * LOG( zrh ) ** 2                   &
4622        + 0.001435808434184642_wp * zt ** 2 * LOG( zrh ) ** 2            &
4623        - 4.775796947178588E-6_wp * zt ** 3 * LOG( zrh ) ** 2            &
4624        - (2.912974063702185_wp * LOG( zrh ) ** 2 ) / zx                 &
4625        - 3.588557942822751_wp * LOG( zrh ) ** 3                         &
4626        + 0.04950795302831703_wp * zt * LOG( zrh ) ** 3                  &
4627        - 0.0002138195118737068_wp * zt ** 2 * LOG( zrh ) ** 3           &
4628        + 3.108005107949533E-7_wp * zt ** 3 * LOG( zrh ) ** 3            &
4629        - ( 0.02933332747098296_wp * LOG( zrh ) ** 3 ) / zx              &
4630        + 1.145983818561277_wp * LOG( zpcsa )                            &
4631        - 0.6007956227856778_wp * zt * LOG( zpcsa )                      &
4632        + 0.00864244733283759_wp * zt ** 2 * LOG( zpcsa )                &
4633        - 0.00002289467254710888_wp * zt ** 3 * LOG( zpcsa )             &
4634        - ( 8.44984513869014_wp * LOG( zpcsa ) ) / zx                    &
4635        + 2.158548369286559_wp * LOG( zrh ) * LOG( zpcsa )               &
4636        + 0.0808121412840917_wp * zt * LOG( zrh ) * LOG( zpcsa )         &
4637        - 0.0004073815255395214_wp * zt ** 2 * LOG( zrh ) * LOG( zpcsa ) &
4638        - 4.019572560156515E-7_wp * zt ** 3 * LOG( zrh ) * LOG( zpcsa )  & 
4639        + ( 0.7213255852557236_wp * LOG( zrh ) * LOG( zpcsa ) ) / zx     &
4640        + 1.62409850488771_wp * LOG( zrh ) ** 2 * LOG( zpcsa )           &
4641        - 0.01601062035325362_wp * zt * LOG( zrh ) ** 2 * LOG( zpcsa )   &
4642        + 0.00003771238979714162_wp*zt**2* LOG( zrh )**2 * LOG( zpcsa )  &
4643        + 3.217942606371182E-8_wp * zt**3 * LOG( zrh )**2 * LOG( zpcsa ) &
4644        - (0.01132550810022116_wp * LOG( zrh )**2 * LOG( zpcsa ) ) / zx  &
4645        + 9.71681713056504_wp * LOG( zpcsa ) ** 2                        &
4646        - 0.1150478558347306_wp * zt * LOG( zpcsa ) ** 2                 &
4647        + 0.0001570982486038294_wp * zt ** 2 * LOG( zpcsa ) ** 2         &
4648        + 4.009144680125015E-7_wp * zt ** 3 * LOG( zpcsa ) ** 2          &
4649        + ( 0.7118597859976135_wp * LOG( zpcsa ) ** 2 ) / zx             &
4650        - 1.056105824379897_wp * LOG( zrh ) * LOG( zpcsa ) ** 2          &
4651        + 0.00903377584628419_wp * zt * LOG( zrh ) * LOG( zpcsa )**2     &
4652        - 0.00001984167387090606_wp*zt**2*LOG( zrh )*LOG( zpcsa )**2     &
4653        + 2.460478196482179E-8_wp * zt**3 * LOG( zrh ) * LOG( zpcsa )**2 &
4654        - ( 0.05790872906645181_wp * LOG( zrh ) * LOG( zpcsa )**2 ) / zx &
4655        - 0.1487119673397459_wp * LOG( zpcsa ) ** 3                      &
4656        + 0.002835082097822667_wp * zt * LOG( zpcsa ) ** 3               &
4657        - 9.24618825471694E-6_wp * zt ** 2 * LOG( zpcsa ) ** 3           &
4658        + 5.004267665960894E-9_wp * zt ** 3 * LOG( zpcsa ) ** 3          &
4659        - ( 0.01270805101481648_wp * LOG( zpcsa ) ** 3 ) / zx
4660!           
4661!-- Nucleation rate in #/(cm3 s)
4662    pnuc_rate = EXP( pnuc_rate ) 
4663!       
4664!-- Check the validity of parameterization
4665    IF ( pnuc_rate < 1.0E-7_wp )  THEN
4666       pnuc_rate = 0.0_wp
4667       pd_crit   = 1.0E-9_wp
4668    ENDIF
4669!               
4670!-- 4) Total number of molecules in the critical cluster (Eq. 13)
4671    zntot = - 0.002954125078716302_wp                                    &
4672      - 0.0976834264241286_wp * zt                                       &
4673      + 0.001024847927067835_wp * zt ** 2                                &
4674      - 2.186459697726116E-6_wp * zt ** 3                                &
4675      - 0.1017165718716887_wp / zx                                       &
4676      - 0.002050640345231486_wp * LOG( zrh )                             &
4677      - 0.007585041382707174_wp * zt * LOG( zrh )                        &
4678      + 0.0001926539658089536_wp * zt ** 2 * LOG( zrh )                  &
4679      - 6.70429719683894E-7_wp * zt ** 3 * LOG( zrh )                    &
4680      - ( 0.2557744774673163_wp * LOG( zrh ) ) / zx                      &
4681      + 0.003223076552477191_wp * LOG( zrh ) ** 2                        &
4682      + 0.000852636632240633_wp * zt * LOG( zrh ) ** 2                   &
4683      - 0.00001547571354871789_wp * zt ** 2 * LOG( zrh ) ** 2            &
4684      + 5.666608424980593E-8_wp * zt ** 3 * LOG( zrh ) ** 2              &
4685      + ( 0.03384437400744206_wp * LOG( zrh ) ** 2 ) / zx                &
4686      + 0.04743226764572505_wp * LOG( zrh ) ** 3                         &
4687      - 0.0006251042204583412_wp * zt * LOG( zrh ) ** 3                  &
4688      + 2.650663328519478E-6_wp * zt ** 2 * LOG( zrh ) ** 3              &
4689      - 3.674710848763778E-9_wp * zt ** 3 * LOG( zrh ) ** 3              &
4690      - ( 0.0002672510825259393_wp * LOG( zrh ) ** 3 ) / zx              &
4691      - 0.01252108546759328_wp * LOG( zpcsa )                            &
4692      + 0.005806550506277202_wp * zt * LOG( zpcsa )                      &
4693      - 0.0001016735312443444_wp * zt ** 2 * LOG( zpcsa )                &
4694      + 2.881946187214505E-7_wp * zt ** 3 * LOG( zpcsa )                 &
4695      + ( 0.0942243379396279_wp * LOG( zpcsa ) ) / zx                    &
4696      - 0.0385459592773097_wp * LOG( zrh ) * LOG( zpcsa )                &
4697      - 0.0006723156277391984_wp * zt * LOG( zrh ) * LOG( zpcsa )        &
4698      + 2.602884877659698E-6_wp * zt ** 2 * LOG( zrh ) * LOG( zpcsa )    &
4699      + 1.194163699688297E-8_wp * zt ** 3 * LOG( zrh ) * LOG( zpcsa )    &
4700      - ( 0.00851515345806281_wp * LOG( zrh ) * LOG( zpcsa ) ) / zx      &
4701      - 0.01837488495738111_wp * LOG( zrh ) ** 2 * LOG( zpcsa )          &
4702      + 0.0001720723574407498_wp * zt * LOG( zrh ) ** 2 * LOG( zpcsa )   &
4703      - 3.717657974086814E-7_wp * zt**2 * LOG( zrh )**2 * LOG( zpcsa )   &
4704      - 5.148746022615196E-10_wp * zt**3 * LOG( zrh )**2 * LOG( zpcsa )  &
4705      + ( 0.0002686602132926594_wp * LOG(zrh)**2 * LOG(zpcsa) ) / zx     &
4706      - 0.06199739728812199_wp * LOG( zpcsa ) ** 2                       &
4707      + 0.000906958053583576_wp * zt * LOG( zpcsa ) ** 2                 &
4708      - 9.11727926129757E-7_wp * zt ** 2 * LOG( zpcsa ) ** 2             &
4709      - 5.367963396508457E-9_wp * zt ** 3 * LOG( zpcsa ) ** 2            &
4710      - ( 0.007742343393937707_wp * LOG( zpcsa ) ** 2 ) / zx             &
4711      + 0.0121827103101659_wp * LOG( zrh ) * LOG( zpcsa ) ** 2           &
4712      - 0.0001066499571188091_wp * zt * LOG( zrh ) * LOG( zpcsa ) ** 2   &
4713      + 2.534598655067518E-7_wp * zt**2 * LOG( zrh ) * LOG( zpcsa )**2   &
4714      - 3.635186504599571E-10_wp * zt**3 * LOG( zrh ) * LOG( zpcsa )**2  &
4715      + ( 0.0006100650851863252_wp * LOG( zrh ) * LOG( zpcsa ) **2 )/ zx &
4716      + 0.0003201836700403512_wp * LOG( zpcsa ) ** 3                     &
4717      - 0.0000174761713262546_wp * zt * LOG( zpcsa ) ** 3                &
4718      + 6.065037668052182E-8_wp * zt ** 2 * LOG( zpcsa ) ** 3            &
4719      - 1.421771723004557E-11_wp * zt ** 3 * LOG( zpcsa ) ** 3           &
4720      + ( 0.0001357509859501723_wp * LOG( zpcsa ) ** 3 ) / zx
4721    zntot = EXP( zntot )  ! in #
4722!
4723!-- 5) Size of the critical cluster pd_crit (m) (diameter) (Eq. 14)
4724    pn_crit_sa = zx * zntot
4725    pd_crit    = 2.0E-9_wp * EXP( -1.6524245_wp + 0.42316402_wp  * zx +        &
4726                 0.33466487_wp * LOG( zntot ) )
4727!
4728!-- 6) Organic compounds not involved when binary nucleation is assumed
4729    pn_crit_ocnv = 0.0_wp   ! number of organic molecules
4730    pk_sa        = 1.0_wp   ! if = 1, H2SO4 involved in nucleation
4731    pk_ocnv      = 0.0_wp   ! if = 1, organic compounds involved
4732!               
4733!-- Set nucleation rate to collision rate               
4734    IF ( pn_crit_sa < 4.0_wp ) THEN
4735!       
4736!--    Volumes of the colliding objects
4737       zma    = 96.0_wp   ! molar mass of SO4 in g/mol
4738       zmw    = 18.0_wp   ! molar mass of water in g/mol
4739       zxmass = 1.0_wp    ! mass fraction of H2SO4
4740       za = 0.7681724_wp + zxmass * ( 2.1847140_wp + zxmass * (     &
4741            7.1630022_wp + zxmass * ( -44.31447_wp + zxmass * (     &
4742            88.75606 + zxmass * ( -75.73729_wp + zxmass *           &
4743            23.43228_wp ) ) ) ) )
4744       zb = 1.808225E-3_wp + zxmass * ( -9.294656E-3_wp + zxmass *  &
4745            ( -0.03742148_wp + zxmass * ( 0.2565321_wp + zxmass *   &
4746            ( -0.5362872_wp + zxmass * ( 0.4857736 - zxmass *       &
4747            0.1629592_wp ) ) ) ) )
4748       zc = - 3.478524E-6_wp + zxmass * ( 1.335867E-5_wp + zxmass * &
4749           ( 5.195706E-5_wp + zxmass * ( -3.717636E-4_wp + zxmass * &
4750           ( 7.990811E-4_wp + zxmass * ( -7.458060E-4_wp + zxmass * &
4751             2.58139E-4_wp ) ) ) ) )
4752!             
4753!--    Density for the sulphuric acid solution (Eq. 10 in Vehkamaki)
4754       zroo = za + zt * ( zb + zc * zt )   ! g/cm^3
4755       zroo = zroo * 1.0E+3_wp   ! kg/m^3
4756       zm1  = 0.098_wp   ! molar mass of H2SO4 in kg/mol
4757       zm2  = zm1
4758       zv1  = zm1 / avo / zroo   ! volume
4759       zv2  = zv1
4760!       
4761!--    Collision rate
4762       zcoll =  zpcsa * zpcsa * ( 3.0_wp * pi / 4.0_wp ) ** ( 1.0_wp / 6.0_wp )&
4763                * SQRT( 6.0_wp * argas * zt / zm1 + 6.0_wp * argas * zt / zm2 )&
4764                * ( zv1 ** ( 1.0_wp / 3.0_wp ) + zv2 ** ( 1.0_wp /3.0_wp ) ) **&
4765                2.0_wp * 1.0E+6_wp    ! m3 -> cm3
4766
4767       zcoll      = MIN( zcoll, 1.0E+10_wp )
4768       pnuc_rate  = zcoll   ! (#/(cm3 s))
4769       
4770    ELSE             
4771       pnuc_rate  = MIN( pnuc_rate, 1.0E+10_wp )               
4772    ENDIF             
4773    pnuc_rate = pnuc_rate * 1.0E+6_wp   ! (#/(m3 s))
4774       
4775 END SUBROUTINE binnucl
4776 
4777!------------------------------------------------------------------------------!
4778! Description:
4779! ------------
4780!> Calculate the nucleation rate and the size of critical clusters assuming
4781!> ternary nucleation. Parametrisation according to:
4782!> Napari et al. (2002), J. Chem. Phys., 116, 4221-4227 and
4783!> Napari et al. (2002), J. Geophys. Res., 107(D19), AAC 6-1-ACC 6-6.
4784!> Called from subroutine nucleation.
4785!------------------------------------------------------------------------------!
4786 SUBROUTINE ternucl( pc_sa, pc_nh3, ptemp, prh, pnuc_rate, pn_crit_sa,         &
4787                     pn_crit_ocnv, pd_crit, pk_sa, pk_ocnv )
4788                     
4789    IMPLICIT NONE
4790   
4791!-- Input and output variables
4792    REAL(wp), INTENT(in) ::   pc_nh3  !< ammonia mixing ratio (ppt)       
4793    REAL(wp), INTENT(in) ::   pc_sa   !< H2SO4 conc. (#/cm3)
4794    REAL(wp), INTENT(in) ::   prh     !< relative humidity [0-1]
4795    REAL(wp), INTENT(in) ::   ptemp   !< ambient temperature (K)
4796    REAL(wp), INTENT(out) ::  pd_crit !< diameter of critical
4797                                                  !< cluster (m)
4798    REAL(wp), INTENT(out) ::  pk_ocnv !< Lever: if pk_ocnv = 1,organic compounds
4799                                      !< are involved in nucleation                                                     
4800    REAL(wp), INTENT(out) ::  pk_sa   !< Lever: if pk_sa = 1, H2SO4 is involved
4801                                      !< in nucleation                                                     
4802    REAL(wp), INTENT(out) ::  pn_crit_ocnv !< number of organic molecules in
4803                                           !< cluster (#)
4804    REAL(wp), INTENT(out) ::  pn_crit_sa   !< number of H2SO4 molecules in
4805                                           !< cluster (#)                                                     
4806    REAL(wp), INTENT(out) ::  pnuc_rate    !< nucleation rate (#/(m3 s))
4807!-- Local variables
4808    REAL(wp) ::  zlnj !< logarithm of nucleation rate
4809   
4810!-- 1) Checking that we are in the validity range of the parameterization.
4811!--    Validity of parameterization : DO NOT REMOVE!
4812    IF ( ptemp < 240.0_wp  .OR.  ptemp > 300.0_wp )  THEN
4813       message_string = 'Invalid input value: ptemp'
4814       CALL message( 'salsa_mod: ternucl', 'SA0045', 1, 2, 0, 6, 0 )
4815    ENDIF
4816    IF ( prh < 0.05_wp  .OR.  prh > 0.95_wp )  THEN
4817       message_string = 'Invalid input value: prh'
4818       CALL message( 'salsa_mod: ternucl', 'SA0046', 1, 2, 0, 6, 0 )
4819    ENDIF
4820    IF ( pc_sa < 1.0E+4_wp  .OR.  pc_sa > 1.0E+9_wp )  THEN
4821       message_string = 'Invalid input value: pc_sa'
4822       CALL message( 'salsa_mod: ternucl', 'SA0047', 1, 2, 0, 6, 0 )
4823    ENDIF
4824    IF ( pc_nh3 < 0.1_wp  .OR.  pc_nh3 > 100.0_wp )  THEN
4825       message_string = 'Invalid input value: pc_nh3'
4826       CALL message( 'salsa_mod: ternucl', 'SA0048', 1, 2, 0, 6, 0 )
4827    ENDIF
4828!
4829!-- 2) Nucleation rate (Eq. 7 in Napari et al., 2002: Parameterization of
4830!--    ternary nucleation of sulfuric acid - ammonia - water.
4831    zlnj = - 84.7551114741543_wp                                               &
4832           + 0.3117595133628944_wp * prh                                       &
4833           + 1.640089605712946_wp * prh * ptemp                                &
4834           - 0.003438516933381083_wp * prh * ptemp ** 2.0_wp                   &
4835           - 0.00001097530402419113_wp * prh * ptemp ** 3.0_wp                 &
4836           - 0.3552967070274677_wp / LOG( pc_sa )                              &
4837           - ( 0.06651397829765026_wp * prh ) / LOG( pc_sa )                   &
4838           - ( 33.84493989762471_wp * ptemp ) / LOG( pc_sa )                   &
4839           - ( 7.823815852128623_wp * prh * ptemp ) / LOG( pc_sa)              &
4840           + ( 0.3453602302090915_wp * ptemp ** 2.0_wp ) / LOG( pc_sa )        &
4841           + ( 0.01229375748100015_wp * prh * ptemp ** 2.0_wp ) / LOG( pc_sa ) &
4842           - ( 0.000824007160514956_wp *ptemp ** 3.0_wp ) / LOG( pc_sa )       &
4843           + ( 0.00006185539100670249_wp * prh * ptemp ** 3.0_wp )             &
4844             / LOG( pc_sa )                                                    &
4845           + 3.137345238574998_wp * LOG( pc_sa )                               &
4846           + 3.680240980277051_wp * prh * LOG( pc_sa )                         &
4847           - 0.7728606202085936_wp * ptemp * LOG( pc_sa )                      &
4848           - 0.204098217156962_wp * prh * ptemp * LOG( pc_sa )                 &
4849           + 0.005612037586790018_wp * ptemp ** 2.0_wp * LOG( pc_sa )          &
4850           + 0.001062588391907444_wp * prh * ptemp ** 2.0_wp * LOG( pc_sa )    &
4851           - 9.74575691760229E-6_wp * ptemp ** 3.0_wp * LOG( pc_sa )           &
4852           - 1.265595265137352E-6_wp * prh * ptemp ** 3.0_wp * LOG( pc_sa )    &
4853           + 19.03593713032114_wp * LOG( pc_sa ) ** 2.0_wp                     &
4854           - 0.1709570721236754_wp * ptemp * LOG( pc_sa ) ** 2.0_wp            &
4855           + 0.000479808018162089_wp * ptemp ** 2.0_wp * LOG( pc_sa ) ** 2.0_wp&
4856           - 4.146989369117246E-7_wp * ptemp ** 3.0_wp * LOG( pc_sa ) ** 2.0_wp&
4857           + 1.076046750412183_wp * LOG( pc_nh3 )                              &
4858           + 0.6587399318567337_wp * prh * LOG( pc_nh3 )                       &
4859           + 1.48932164750748_wp * ptemp * LOG( pc_nh3 )                       & 
4860           + 0.1905424394695381_wp * prh * ptemp * LOG( pc_nh3 )               &
4861           - 0.007960522921316015_wp * ptemp ** 2.0_wp * LOG( pc_nh3 )         &
4862           - 0.001657184248661241_wp * prh * ptemp ** 2.0_wp * LOG( pc_nh3 )   &
4863           + 7.612287245047392E-6_wp * ptemp ** 3.0_wp * LOG( pc_nh3 )         &
4864           + 3.417436525881869E-6_wp * prh * ptemp ** 3.0_wp * LOG( pc_nh3 )   &
4865           + ( 0.1655358260404061_wp * LOG( pc_nh3 ) ) / LOG( pc_sa)           &
4866           + ( 0.05301667612522116_wp * prh * LOG( pc_nh3 ) ) / LOG( pc_sa )   &
4867           + ( 3.26622914116752_wp * ptemp * LOG( pc_nh3 ) ) / LOG( pc_sa )    &
4868           - ( 1.988145079742164_wp * prh * ptemp * LOG( pc_nh3 ) )            &
4869             / LOG( pc_sa )                                                    &
4870           - ( 0.04897027401984064_wp * ptemp ** 2.0_wp * LOG( pc_nh3) )       &
4871             / LOG( pc_sa )                                                    &
4872           + ( 0.01578269253599732_wp * prh * ptemp ** 2.0_wp * LOG( pc_nh3 )  &
4873             ) / LOG( pc_sa )                                                  &
4874           + ( 0.0001469672236351303_wp * ptemp ** 3.0_wp * LOG( pc_nh3 ) )    &
4875             / LOG( pc_sa )                                                    &
4876           - ( 0.00002935642836387197_wp * prh * ptemp ** 3.0_wp *LOG( pc_nh3 )&
4877             ) / LOG( pc_sa )                                                  &
4878           + 6.526451177887659_wp * LOG( pc_sa ) * LOG( pc_nh3 )               & 
4879           - 0.2580021816722099_wp * ptemp * LOG( pc_sa ) * LOG( pc_nh3 )      &
4880           + 0.001434563104474292_wp * ptemp ** 2.0_wp * LOG( pc_sa )          &
4881             * LOG( pc_nh3 )                                                   &
4882           -  2.020361939304473E-6_wp * ptemp ** 3.0_wp * LOG( pc_sa )         &
4883             * LOG( pc_nh3 )                                                   &
4884           - 0.160335824596627_wp * LOG( pc_sa ) ** 2.0_wp * LOG( pc_nh3 )     &
4885           +  0.00889880721460806_wp * ptemp * LOG( pc_sa ) ** 2.0_wp          &
4886             * LOG( pc_nh3 )                                                   &
4887           -  0.00005395139051155007_wp * ptemp ** 2.0_wp                      &
4888             * LOG( pc_sa) ** 2.0_wp * LOG( pc_nh3 )                           &
4889           +  8.39521718689596E-8_wp * ptemp ** 3.0_wp * LOG( pc_sa ) ** 2.0_wp&
4890             * LOG( pc_nh3 )                                                   &
4891           + 6.091597586754857_wp * LOG( pc_nh3 ) ** 2.0_wp                    &
4892           + 8.5786763679309_wp * prh * LOG( pc_nh3 ) ** 2.0_wp                &
4893           - 1.253783854872055_wp * ptemp * LOG( pc_nh3 ) ** 2.0_wp            &
4894           - 0.1123577232346848_wp * prh * ptemp * LOG( pc_nh3 ) ** 2.0_wp     &
4895           + 0.00939835595219825_wp * ptemp ** 2.0_wp * LOG( pc_nh3 ) ** 2.0_wp&
4896           + 0.0004726256283031513_wp * prh * ptemp ** 2.0_wp                  &
4897             * LOG( pc_nh3) ** 2.0_wp                                          &
4898           - 0.00001749269360523252_wp * ptemp ** 3.0_wp                       &
4899             * LOG( pc_nh3 ) ** 2.0_wp                                         &
4900           - 6.483647863710339E-7_wp * prh * ptemp ** 3.0_wp                   &
4901             * LOG( pc_nh3 ) ** 2.0_wp                                         &
4902           + ( 0.7284285726576598_wp * LOG( pc_nh3 ) ** 2.0_wp ) / LOG( pc_sa )&
4903           + ( 3.647355600846383_wp * ptemp * LOG( pc_nh3 ) ** 2.0_wp )        &
4904             / LOG( pc_sa )                                                    &
4905           - ( 0.02742195276078021_wp * ptemp ** 2.0_wp                        &
4906             * LOG( pc_nh3) ** 2.0_wp ) / LOG( pc_sa )                         &
4907           + ( 0.00004934777934047135_wp * ptemp ** 3.0_wp                     &
4908             * LOG( pc_nh3 ) ** 2.0_wp ) / LOG( pc_sa )                        &
4909           + 41.30162491567873_wp * LOG( pc_sa ) * LOG( pc_nh3 ) ** 2.0_wp     &
4910           - 0.357520416800604_wp * ptemp * LOG( pc_sa )                       &
4911             * LOG( pc_nh3 ) ** 2.0_wp                                         &
4912           + 0.000904383005178356_wp * ptemp ** 2.0_wp * LOG( pc_sa )          &
4913             * LOG( pc_nh3 ) ** 2.0_wp                                         &
4914           - 5.737876676408978E-7_wp * ptemp ** 3.0_wp * LOG( pc_sa )          &
4915             * LOG( pc_nh3 ) ** 2.0_wp                                         &
4916           - 2.327363918851818_wp * LOG( pc_sa ) ** 2.0_wp                     &
4917             * LOG( pc_nh3 ) ** 2.0_wp                                         &
4918           + 0.02346464261919324_wp * ptemp * LOG( pc_sa ) ** 2.0_wp           &
4919             * LOG( pc_nh3 ) ** 2.0_wp                                         &
4920           - 0.000076518969516405_wp * ptemp ** 2.0_wp                         &
4921             * LOG( pc_sa ) ** 2.0_wp * LOG( pc_nh3 ) ** 2.0_wp                &
4922           + 8.04589834836395E-8_wp * ptemp ** 3.0_wp * LOG( pc_sa ) ** 2.0_wp &
4923             * LOG( pc_nh3 ) ** 2.0_wp                                         &
4924           - 0.02007379204248076_wp * LOG( prh )                               &
4925           - 0.7521152446208771_wp * ptemp * LOG( prh )                        &
4926           + 0.005258130151226247_wp * ptemp ** 2.0_wp * LOG( prh )            &
4927           - 8.98037634284419E-6_wp * ptemp ** 3.0_wp * LOG( prh )             &
4928           + ( 0.05993213079516759_wp * LOG( prh ) ) / LOG( pc_sa )            &
4929           + ( 5.964746463184173_wp * ptemp * LOG( prh ) ) / LOG( pc_sa )      &
4930           - ( 0.03624322255690942_wp * ptemp ** 2.0_wp * LOG( prh ) )         &
4931             / LOG( pc_sa )                                                    &
4932           + ( 0.00004933369382462509_wp * ptemp ** 3.0_wp * LOG( prh ) )      &
4933             / LOG( pc_sa )                                                    &
4934           - 0.7327310805365114_wp * LOG( pc_nh3 ) * LOG( prh )                &
4935           - 0.01841792282958795_wp * ptemp * LOG( pc_nh3 ) * LOG( prh )       &
4936           + 0.0001471855981005184_wp * ptemp ** 2.0_wp * LOG( pc_nh3 )        &
4937             * LOG( prh )                                                      &
4938           - 2.377113195631848E-7_wp * ptemp ** 3.0_wp * LOG( pc_nh3 )         &
4939             * LOG( prh )
4940    pnuc_rate = EXP( zlnj )   ! (#/(cm3 s))
4941!   
4942!-- Check validity of parametrization             
4943    IF ( pnuc_rate < 1.0E-5_wp )  THEN
4944       pnuc_rate = 0.0_wp
4945       pd_crit   = 1.0E-9_wp
4946    ELSEIF ( pnuc_rate > 1.0E6_wp )  THEN
4947       message_string = 'Invalid output value: nucleation rate > 10^6 1/cm3s'
4948       CALL message( 'salsa_mod: ternucl', 'SA0049', 1, 2, 0, 6, 0 )
4949    ENDIF
4950    pnuc_rate = pnuc_rate * 1.0E6_wp   ! (#/(m3 s))
4951!             
4952!-- 3) Number of H2SO4 molecules in a critical cluster (Eq. 9)
4953    pn_crit_sa = 38.16448247950508_wp + 0.7741058259731187_wp * zlnj +         &
4954                 0.002988789927230632_wp * zlnj ** 2.0_wp -                    &
4955                 0.3576046920535017_wp * ptemp -                               &
4956                 0.003663583011953248_wp * zlnj * ptemp +                      &
4957                 0.000855300153372776_wp * ptemp ** 2.0_wp
4958!-- Kinetic limit: at least 2 H2SO4 molecules in a cluster                                 
4959    pn_crit_sa = MAX( pn_crit_sa, 2.0E0_wp ) 
4960!             
4961!-- 4) Size of the critical cluster in nm (Eq. 12)
4962    pd_crit = 0.1410271086638381_wp - 0.001226253898894878_wp * zlnj -         &
4963              7.822111731550752E-6_wp * zlnj ** 2.0_wp -                       &
4964              0.001567273351921166_wp * ptemp -                                &
4965              0.00003075996088273962_wp * zlnj * ptemp +                       &
4966              0.00001083754117202233_wp * ptemp ** 2.0_wp 
4967    pd_crit = pd_crit * 2.0E-9_wp   ! Diameter in m
4968!
4969!-- 5) Organic compounds not involved when ternary nucleation assumed
4970    pn_crit_ocnv = 0.0_wp 
4971    pk_sa   = 1.0_wp
4972    pk_ocnv = 0.0_wp
4973   
4974 END SUBROUTINE ternucl
4975 
4976!------------------------------------------------------------------------------!
4977! Description:
4978! ------------
4979!> Calculate the nucleation rate and the size of critical clusters assuming
4980!> kinetic nucleation. Each sulphuric acid molecule forms an (NH4)HSO4 molecule
4981!> in the atmosphere and two colliding (NH4)HSO4 molecules form a stable
4982!> cluster. See Sihto et al. (2006), Atmos. Chem. Phys., 6(12), 4079-4091.
4983!>
4984!> Below the following assumption have been made:
4985!>  nucrate = coagcoeff*zpcsa**2
4986!>  coagcoeff = 8*sqrt(3*boltz*ptemp*r_abs/dens_abs)
4987!>  r_abs = 0.315d-9 radius of bisulphate molecule [m]
4988!>  dens_abs = 1465  density of - " - [kg/m3]
4989!------------------------------------------------------------------------------!
4990 SUBROUTINE kinnucl( pc_sa, pnuc_rate, pd_crit, pn_crit_sa, pn_crit_ocnv,      &
4991                     pk_sa, pk_ocnv ) 
4992                     
4993    IMPLICIT NONE
4994   
4995!-- Input and output variables
4996    REAL(wp), INTENT(in) ::  pc_sa     !< H2SO4 conc. (#/m3)
4997    REAL(wp), INTENT(out) ::  pd_crit  !< critical diameter of clusters (m)
4998    REAL(wp), INTENT(out) ::  pk_ocnv  !< Lever: if pk_ocnv = 1, organic
4999                                       !< compounds are involved in nucleation
5000    REAL(wp), INTENT(out) ::  pk_sa    !< Lever: if pk_sa = 1, H2SO4 is involved
5001                                       !< in nucleation
5002    REAL(wp), INTENT(out) ::  pn_crit_ocnv !< number of organic molecules in
5003                                           !< cluster (#)
5004    REAL(wp), INTENT(out) ::  pn_crit_sa   !< number of H2SO4 molecules in
5005                                           !< cluster (#)
5006    REAL(wp), INTENT(out) ::  pnuc_rate    !< nucl. rate (#/(m3 s))
5007   
5008!-- Nucleation rate (#/(m3 s))
5009    pnuc_rate = 5.0E-13_wp * pc_sa ** 2.0_wp * 1.0E+6_wp
5010!-- Organic compounds not involved when kinetic nucleation is assumed.
5011    pn_crit_sa   = 2.0_wp
5012    pn_crit_ocnv = 0.0_wp 
5013    pk_sa        = 1.0_wp
5014    pk_ocnv      = 0.0_wp             
5015    pd_crit      = 7.9375E-10_wp   ! (m)
5016   
5017 END SUBROUTINE kinnucl
5018!------------------------------------------------------------------------------!
5019! Description:
5020! ------------
5021!> Calculate the nucleation rate and the size of critical clusters assuming
5022!> activation type nucleation.
5023!> See Riipinen et al. (2007), Atmos. Chem. Phys., 7(8), 1899-1914.
5024!------------------------------------------------------------------------------!
5025 SUBROUTINE actnucl( psa_conc, pnuc_rate, pd_crit, pn_crit_sa, pn_crit_ocnv,   &
5026                     pk_sa, pk_ocnv, activ ) 
5027
5028    IMPLICIT NONE
5029   
5030!-- Input and output variables
5031    REAL(wp), INTENT(in) ::  psa_conc !< H2SO4 conc. (#/m3)
5032    REAL(wp), INTENT(in) ::  activ    !<
5033    REAL(wp), INTENT(out) ::  pd_crit !< critical diameter of clusters (m)
5034    REAL(wp), INTENT(out) ::  pk_ocnv !< Lever: if pk_ocnv = 1, organic
5035                                      !< compounds are involved in nucleation
5036    REAL(wp), INTENT(out) ::  pk_sa   !< Lever: if pk_sa = 1, H2SO4 is involved
5037                                      !< in nucleation
5038    REAL(wp), INTENT(out) ::  pn_crit_ocnv !< number of organic molecules in
5039                                           !< cluster (#)
5040    REAL(wp), INTENT(out) ::  pn_crit_sa   !< number of H2SO4 molecules in
5041                                           !< cluster (#)
5042    REAL(wp), INTENT(out) ::  pnuc_rate    !< nucl. rate (#/(m3 s))
5043   
5044!-- act_coeff 1e-7 by default
5045    pnuc_rate = activ * psa_conc   ! (#/(m3 s))
5046!-- Organic compounds not involved when kinetic nucleation is assumed.
5047    pn_crit_sa   = 2.0_wp
5048    pn_crit_ocnv = 0.0_wp 
5049    pk_sa        = 1.0_wp
5050    pk_ocnv      = 0.0_wp
5051    pd_crit      = 7.9375E-10_wp   ! (m)
5052 END SUBROUTINE actnucl
5053!------------------------------------------------------------------------------!
5054! Description:
5055! ------------
5056!> Conciders only the organic matter in nucleation. Paasonen et al. (2010)
5057!> determined particle formation rates for 2 nm particles, J2, from different
5058!> kind of combinations of sulphuric acid and organic matter concentration.
5059!> See Paasonen et al. (2010), Atmos. Chem. Phys., 10, 11223-11242.
5060!------------------------------------------------------------------------------!
5061 SUBROUTINE orgnucl( pc_org, pnuc_rate, pd_crit, pn_crit_sa, pn_crit_ocnv,     &
5062                     pk_sa, pk_ocnv )
5063
5064    IMPLICIT NONE
5065   
5066!-- Input and output variables
5067    REAL(wp), INTENT(in) ::  pc_org   !< organic vapour concentration (#/m3)
5068    REAL(wp), INTENT(out) ::  pd_crit !< critical diameter of clusters (m)
5069    REAL(wp), INTENT(out) ::  pk_ocnv !< Lever: if pk_ocnv = 1, organic
5070                                      !< compounds are involved in nucleation
5071    REAL(wp), INTENT(out) ::  pk_sa !< Lever: if pk_sa = 1, H2SO4 is involved
5072                                    !< in nucleation
5073    REAL(wp), INTENT(out) ::  pn_crit_ocnv !< number of organic molecules in
5074                                           !< cluster (#)
5075    REAL(wp), INTENT(out) ::  pn_crit_sa   !< number of H2SO4 molecules in
5076                                           !< cluster (#)
5077    REAL(wp), INTENT(out) ::  pnuc_rate    !< nucl. rate (#/(m3 s))
5078!-- Local variables
5079    REAL(wp) ::  Aorg = 1.3E-7_wp !< (1/s) (Paasonen et al. Table 4: median)
5080   
5081!-- Homomolecular nuleation - which one?         
5082    pnuc_rate = Aorg * pc_org 
5083!-- H2SO4 not involved when pure organic nucleation is assumed.
5084    pn_crit_sa   = 0.0_wp
5085    pn_crit_ocnv = 1.0_wp 
5086    pk_sa        = 0.0_wp
5087    pk_ocnv      = 1.0_wp
5088    pd_crit      = 1.5E-9_wp   ! (m)
5089   
5090 END SUBROUTINE orgnucl
5091!------------------------------------------------------------------------------!
5092! Description:
5093! ------------
5094!> Conciders both the organic vapor and H2SO4 in nucleation - activation type
5095!> of nucleation.
5096!> See Paasonen et al. (2010), Atmos. Chem. Phys., 10, 11223-11242.
5097!------------------------------------------------------------------------------!
5098 SUBROUTINE sumnucl( pc_sa, pc_org, pnuc_rate, pd_crit, pn_crit_sa,            &
5099                     pn_crit_ocnv, pk_sa, pk_ocnv )
5100
5101    IMPLICIT NONE
5102   
5103!-- Input and output variables
5104    REAL(wp), INTENT(in) ::  pc_org   !< organic vapour concentration (#/m3)
5105    REAL(wp), INTENT(in) ::  pc_sa    !< H2SO4 conc. (#/m3)
5106    REAL(wp), INTENT(out) ::  pd_crit !< critical diameter of clusters (m)
5107    REAL(wp), INTENT(out) ::  pk_ocnv !< Lever: if pk_ocnv = 1, organic
5108                                      !< compounds are involved in nucleation
5109    REAL(wp), INTENT(out) ::  pk_sa   !< Lever: if pk_sa = 1, H2SO4 is involved
5110                                      !< in nucleation
5111    REAL(wp), INTENT(out) ::  pn_crit_ocnv !< number of organic molecules in
5112                                           !< cluster (#)
5113    REAL(wp), INTENT(out) ::  pn_crit_sa   !< number of H2SO4 molecules in
5114                                           !< cluster (#)
5115    REAL(wp), INTENT(out) ::  pnuc_rate    !< nucl. rate (#/(m3 s))
5116!-- Local variables
5117    REAL(wp) ::  As1 = 6.1E-7_wp  !< (1/s)
5118    REAL(wp) ::  As2 = 0.39E-7_wp !< (1/s) (Paasonen et al. Table 3.)
5119   
5120!-- Nucleation rate  (#/m3/s)
5121    pnuc_rate = As1 * pc_sa + As2 * pc_org 
5122!-- Both Organic compounds and H2SO4 are involved when SUMnucleation is assumed.
5123    pn_crit_sa   = 1.0_wp
5124    pn_crit_ocnv = 1.0_wp 
5125    pk_sa        = 1.0_wp
5126    pk_ocnv      = 1.0_wp           
5127    pd_crit      = 1.5E-9_wp   ! (m)
5128   
5129 END SUBROUTINE sumnucl
5130!------------------------------------------------------------------------------!
5131! Description:
5132! ------------
5133!> Conciders both the organic vapor and H2SO4 in nucleation - heteromolecular
5134!> nucleation.
5135!> See Paasonen et al. (2010), Atmos. Chem. Phys., 10, 11223-11242.
5136!------------------------------------------------------------------------------!
5137 SUBROUTINE hetnucl( pc_sa, pc_org, pnuc_rate, pd_crit, pn_crit_sa,            &
5138                     pn_crit_ocnv, pk_sa, pk_ocnv )
5139
5140    IMPLICIT NONE
5141   
5142!-- Input and output variables
5143    REAL(wp), INTENT(in) ::  pc_org   !< organic vapour concentration (#/m3)
5144    REAL(wp), INTENT(in) ::  pc_sa    !< H2SO4 conc. (#/m3)
5145    REAL(wp), INTENT(out) ::  pd_crit !< critical diameter of clusters (m)
5146    REAL(wp), INTENT(out) ::  pk_ocnv !< Lever: if pk_ocnv = 1, organic
5147                                      !< compounds are involved in nucleation
5148    REAL(wp), INTENT(out) ::  pk_sa   !< Lever: if pk_sa = 1, H2SO4 is involved
5149                                      !< in nucleation
5150    REAL(wp), INTENT(out) ::  pn_crit_ocnv !< number of organic molecules in
5151                                           !< cluster (#)
5152    REAL(wp), INTENT(out) ::  pn_crit_sa   !< number of H2SO4 molecules in
5153                                           !< cluster (#)
5154    REAL(wp), INTENT(out) ::  pnuc_rate    !< nucl. rate (#/(m3 s))
5155!-- Local variables
5156    REAL(wp) ::  zKhet = 4.1E-14_wp !< (cm3/s) (Paasonen et al. Table 4: median)
5157   
5158!-- Nucleation rate (#/m3/s)
5159    pnuc_rate = zKhet * pc_sa * pc_org * 1.0E6_wp 
5160!-- Both Organic compounds and H2SO4 are involved when heteromolecular
5161!-- nucleation is assumed.
5162    pn_crit_sa   = 1.0_wp
5163    pn_crit_ocnv = 1.0_wp 
5164    pk_sa        = 1.0_wp
5165    pk_ocnv      = 1.0_wp 
5166    pd_crit      = 1.5E-9_wp   ! (m)
5167   
5168 END SUBROUTINE hetnucl
5169!------------------------------------------------------------------------------!
5170! Description:
5171! ------------
5172!> Takes into account the homomolecular nucleation of sulphuric acid H2SO4 with
5173!> both of the available vapours.
5174!> See Paasonen et al. (2010), Atmos. Chem. Phys., 10, 11223-11242.
5175!------------------------------------------------------------------------------!
5176 SUBROUTINE SAnucl( pc_sa, pc_org, pnuc_rate, pd_crit, pn_crit_sa,             &
5177                    pn_crit_ocnv, pk_sa, pk_ocnv )
5178
5179    IMPLICIT NONE
5180   
5181!-- Input and output variables
5182    REAL(wp), INTENT(in) ::  pc_org   !< organic vapour concentration (#/m3)
5183    REAL(wp), INTENT(in) ::  pc_sa    !< H2SO4 conc. (#/m3)
5184    REAL(wp), INTENT(out) ::  pd_crit !< critical diameter of clusters (m)
5185    REAL(wp), INTENT(out) ::  pk_ocnv !< Lever: if pk_ocnv = 1, organic
5186                                      !< compounds are involved in nucleation
5187    REAL(wp), INTENT(out) ::  pk_sa   !< Lever: if pk_sa = 1, H2SO4 is involved
5188                                      !< in nucleation
5189    REAL(wp), INTENT(out) ::  pn_crit_ocnv !< number of organic molecules in
5190                                           !< cluster (#)
5191    REAL(wp), INTENT(out) ::  pn_crit_sa   !< number of H2SO4 molecules in
5192                                           !< cluster (#)
5193    REAL(wp), INTENT(out) ::  pnuc_rate    !< nucleation rate (#/(m3 s))
5194!-- Local variables
5195    REAL(wp) ::  zKsa1 = 1.1E-14_wp !< (cm3/s)
5196    REAL(wp) ::  zKsa2 = 3.2E-14_wp  !< (cm3/s) (Paasonen et al. Table 3.)
5197   
5198!-- Nucleation rate (#/m3/s)
5199    pnuc_rate = ( zKsa1 * pc_sa ** 2.0_wp + zKsa2 * pc_sa * pc_org ) * 1.0E+6_wp 
5200!-- Both Organic compounds and H2SO4 are involved when SAnucleation is assumed.
5201    pn_crit_sa   = 3.0_wp
5202    pn_crit_ocnv = 1.0_wp 
5203    pk_sa        = 1.0_wp
5204    pk_ocnv      = 1.0_wp
5205    pd_crit      = 1.5E-9_wp   ! (m)
5206   
5207 END SUBROUTINE SAnucl
5208!------------------------------------------------------------------------------!
5209! Description:
5210! ------------
5211!> Takes into account the homomolecular nucleation of both sulphuric acid and
5212!> Lorganic with heteromolecular nucleation.
5213!> See Paasonen et al. (2010), Atmos. Chem. Phys., 10, 11223-11242.
5214!------------------------------------------------------------------------------!
5215 SUBROUTINE SAORGnucl( pc_sa, pc_org, pnuc_rate, pd_crit, pn_crit_sa,          &
5216                       pn_crit_ocnv, pk_sa, pk_ocnv )
5217
5218    IMPLICIT NONE
5219   
5220!-- Input and output variables
5221    REAL(wp), INTENT(in) ::  pc_org   !< organic vapour concentration (#/m3)
5222    REAL(wp), INTENT(in) ::  pc_sa    !< H2SO4 conc. (#/m3)
5223    REAL(wp), INTENT(out) ::  pd_crit !< critical diameter of clusters (m)
5224    REAL(wp), INTENT(out) ::  pk_ocnv !< Lever: if pk_ocnv = 1, organic
5225                                      !< compounds are involved in nucleation
5226    REAL(wp), INTENT(out) ::  pk_sa   !< Lever: if pk_sa = 1, H2SO4 is involved
5227                                      !< in nucleation
5228    REAL(wp), INTENT(out) ::  pn_crit_ocnv !< number of organic molecules in
5229                                           !< cluster (#)
5230    REAL(wp), INTENT(out) ::  pn_crit_sa   !< number of H2SO4 molecules in
5231                                           !< cluster (#)
5232    REAL(wp), INTENT(out) ::  pnuc_rate    !< nucl. rate (#/(m3 s))
5233!-- Local variables
5234    REAL(wp) ::  zKs1 = 1.4E-14_wp   !< (cm3/s])
5235    REAL(wp) ::  zKs2 = 2.6E-14_wp   !< (cm3/s])
5236    REAL(wp) ::  zKs3 = 0.037E-14_wp !< (cm3/s]) (Paasonen et al. Table 3.)
5237   
5238!-- Nucleation rate (#/m3/s)         
5239    pnuc_rate = ( zKs1 * pc_sa **2 + zKs2 * pc_sa * pc_org + zKs3 *            &
5240                  pc_org ** 2.0_wp ) * 1.0E+6_wp
5241!-- Organic compounds not involved when kinetic nucleation is assumed.
5242    pn_crit_sa   = 3.0_wp
5243    pn_crit_ocnv = 3.0_wp 
5244    pk_sa        = 1.0_wp
5245    pk_ocnv      = 1.0_wp
5246    pd_crit      = 1.5E-9_wp   ! (m)
5247 
5248 END SUBROUTINE SAORGnucl
5249 
5250!------------------------------------------------------------------------------!
5251! Description:
5252! ------------
5253!> Function zNnuc_tayl is connected to the calculation of self-coagualtion of
5254!> small particles. It calculates number of the particles in the size range
5255!> [zdcrit,dx] using Taylor-expansion (please note that the expansion is not
5256!> valid for certain rational numbers, e.g. -4/3 and -3/2)
5257!------------------------------------------------------------------------------!
5258 FUNCTION zNnuc_tayl( d1, dx, zm_para, zjnuc_t, zeta, zGRtot ) 
5259    IMPLICIT NONE
5260 
5261    INTEGER(iwp) ::  i
5262    REAL(wp) ::  d1
5263    REAL(wp) ::  dx
5264    REAL(wp) ::  zjnuc_t
5265    REAL(wp) ::  zeta
5266    REAL(wp) ::  term1
5267    REAL(wp) ::  term2
5268    REAL(wp) ::  term3
5269    REAL(wp) ::  term4
5270    REAL(wp) ::  term5
5271    REAL(wp) ::  zNnuc_tayl
5272    REAL(wp) ::  zGRtot
5273    REAL(wp) ::  zm_para
5274
5275    zNnuc_tayl = 0.0_wp
5276
5277    DO  i = 0, 29
5278       IF ( i == 0  .OR.  i == 1 )  THEN
5279          term1 = 1.0_wp
5280       ELSE
5281          term1 = term1 * REAL( i, SELECTED_REAL_KIND(12,307) )
5282       END IF
5283       term2 = ( REAL( i, SELECTED_REAL_KIND(12,307) ) * ( zm_para + 1.0_wp    &
5284               ) + 1.0_wp ) * term1
5285       term3 = zeta ** i
5286       term4 = term3 / term2
5287       term5 = REAL( i, SELECTED_REAL_KIND(12,307) ) * ( zm_para + 1.0_wp )    &
5288               + 1.0_wp
5289       zNnuc_tayl = zNnuc_tayl + term4 * ( dx ** term5 - d1 ** term5 ) 
5290    ENDDO
5291    zNnuc_tayl = zNnuc_tayl * zjnuc_t * EXP( -zeta *                           &
5292                   ( d1 ** ( zm_para + 1 ) ) ) / zGRtot
5293                 
5294 END FUNCTION zNnuc_tayl
5295 
5296!------------------------------------------------------------------------------!
5297! Description:
5298! ------------
5299!> Calculates the condensation of water vapour on aerosol particles. Follows the
5300!> analytical predictor method by Jacobson (2005).
5301!> For equations, see Jacobson (2005), Fundamentals of atmospheric modelling
5302!> (2nd edition).
5303!------------------------------------------------------------------------------!
5304 SUBROUTINE gpparth2o( paero, ptemp, ppres, pcs, pcw, ptstep )
5305       
5306    IMPLICIT NONE
5307!
5308!-- Input and output variables 
5309    REAL(wp), INTENT(in) ::  ppres  !< Air pressure (Pa)
5310    REAL(wp), INTENT(in) ::  pcs    !< Water vapour saturation
5311                                             !< concentration (kg/m3)
5312    REAL(wp), INTENT(in) ::  ptemp  !< Ambient temperature (K) 
5313    REAL(wp), INTENT(in) ::  ptstep !< timestep (s)
5314    REAL(wp), INTENT(inout) ::  pcw !< Water vapour concentration
5315                                                !< (kg/m3)
5316    TYPE(t_section), INTENT(inout) ::  paero(nbins) !< Aerosol properties
5317!-- Local variables
5318    INTEGER(iwp) ::  b !< loop index
5319    INTEGER(iwp) ::  nstr
5320    REAL(wp) ::  adt     !< internal timestep in this subroutine
5321    REAL(wp) ::  adtc(nbins) 
5322    REAL(wp) ::  rhoair     
5323    REAL(wp) ::  ttot       
5324    REAL(wp) ::  zact    !< Water activity
5325    REAL(wp) ::  zaelwc1 !< Current aerosol water content
5326    REAL(wp) ::  zaelwc2 !< New aerosol water content after
5327                                     !< equilibrium calculation     
5328    REAL(wp) ::  zbeta   !< Transitional correction factor
5329    REAL(wp) ::  zcwc    !< Current water vapour mole concentration
5330    REAL(wp) ::  zcwcae(nbins) !< Current water mole concentrations
5331                               !< in aerosols
5332    REAL(wp) ::  zcwint  !< Current and new water vapour mole concentrations
5333    REAL(wp) ::  zcwintae(nbins) !< Current and new water mole concentrations
5334                                 !< in aerosols
5335    REAL(wp) ::  zcwn    !< New water vapour mole concentration
5336    REAL(wp) ::  zcwnae(nbins) !< New water mole concentration in aerosols
5337    REAL(wp) ::  zcwsurfae(nbins) !< Surface mole concentration
5338    REAL(wp) ::  zcwtot  !< Total water mole concentration
5339    REAL(wp) ::  zdfh2o
5340    REAL(wp) ::  zhlp1
5341    REAL(wp) ::  zhlp2
5342    REAL(wp) ::  zhlp3       
5343    REAL(wp) ::  zka(nbins)     !< Activity coefficient       
5344    REAL(wp) ::  zkelvin(nbins) !< Kelvin effect
5345    REAL(wp) ::  zknud
5346    REAL(wp) ::  zmfph2o        !< mean free path of H2O gas molecule
5347    REAL(wp) ::  zmtae(nbins)   !< Mass transfer coefficients
5348    REAL(wp) ::  zrh            !< Relative humidity [0-1]     
5349    REAL(wp) ::  zthcond       
5350    REAL(wp) ::  zwsatae(nbins) !< Water saturation ratio above aerosols
5351!
5352!-- Relative humidity [0-1]
5353    zrh = pcw / pcs
5354!-- Calculate the condensation only for 2a/2b aerosol bins
5355    nstr = in2a
5356!-- Save the current aerosol water content, 8 in paero is H2O
5357    zaelwc1 = SUM( paero(in1a:fn2b)%volc(8) ) * arhoh2o
5358!
5359!-- Equilibration:
5360    IF ( advect_particle_water )  THEN
5361       IF ( zrh < 0.98_wp  .OR.  .NOT. lscndh2oae )  THEN
5362          CALL equilibration( zrh, ptemp, paero, .TRUE. )
5363       ELSE
5364          CALL equilibration( zrh, ptemp, paero, .FALSE. )
5365       ENDIF
5366    ENDIF
5367!                                       
5368!-- The new aerosol water content after equilibrium calculation
5369    zaelwc2 = SUM( paero(in1a:fn2b)%volc(8) ) * arhoh2o
5370!-- New water vapour mixing ratio (kg/m3)
5371    pcw = pcw - ( zaelwc2 - zaelwc1 ) * ppres * amdair / ( argas * ptemp )
5372!                 
5373!-- Initialise variables
5374    adtc(:)  = 0.0_wp
5375    zcwc     = 0.0_wp
5376    zcwcae   = 0.0_wp       
5377    zcwint   = 0.0_wp
5378    zcwintae = 0.0_wp       
5379    zcwn     = 0.0_wp
5380    zcwnae   = 0.0_wp
5381    zhlp1    = 0.0_wp
5382    zwsatae  = 0.0_wp   
5383!         
5384!-- Air:
5385!-- Density (kg/m3)
5386    rhoair = amdair * ppres / ( argas * ptemp )
5387!-- Thermal conductivity of air                       
5388    zthcond = 0.023807_wp + 7.1128E-5_wp * ( ptemp - 273.16_wp )
5389!             
5390!-- Water vapour:
5391!
5392!-- Molecular diffusion coefficient (cm2/s) (eq.16.17)
5393    zdfh2o = ( 5.0_wp / ( 16.0_wp * avo * rhoair * 1.0E-3_wp *                 &
5394             ( 3.11E-8_wp ) ** 2.0_wp ) ) * SQRT( argas * 1.0E+7_wp * ptemp *  &
5395             amdair * 1.0E+3_wp * ( amh2o + amdair ) * 1.0E+3_wp / ( 2.0_wp *  &
5396             pi * amh2o * 1.0E+3_wp ) )
5397    zdfh2o = zdfh2o * 1.0E-4   ! Unit change to m^2/s
5398!   
5399!-- Mean free path (eq. 15.25 & 16.29)
5400    zmfph2o = 3.0_wp * zdfh2o * SQRT( pi * amh2o / ( 8.0_wp * argas * ptemp ) ) 
5401    zka = 1.0_wp   ! Assume activity coefficients as 1 for now.
5402!   
5403!-- Kelvin effect (eq. 16.33)
5404    zkelvin = 1.0_wp                   
5405    zkelvin(1:nbins) = EXP( 4.0_wp * surfw0 * amh2o / ( argas * ptemp *        &
5406                            arhoh2o * paero(1:nbins)%dwet) )
5407!                           
5408! --Aerosols:
5409    zmtae(:)     = 0.0_wp   ! mass transfer coefficient
5410    zcwsurfae(:) = 0.0_wp   ! surface mole concentrations
5411    DO  b = 1, nbins
5412       IF ( paero(b)%numc > nclim  .AND.  zrh > 0.98_wp )  THEN
5413!       
5414!--       Water activity
5415          zact = acth2o( paero(b) )
5416!         
5417!--       Saturation mole concentration over flat surface. Limit the super-
5418!--       saturation to max 1.01 for the mass transfer. Experimental!         
5419          zcwsurfae(b) = MAX( pcs, pcw / 1.01_wp ) * rhoair / amh2o
5420!         
5421!--       Equilibrium saturation ratio
5422          zwsatae(b) = zact * zkelvin(b)
5423!         
5424!--       Knudsen number (eq. 16.20)
5425          zknud = 2.0_wp * zmfph2o / paero(b)%dwet
5426!         
5427!--       Transitional correction factor (Fuks & Sutugin, 1971)
5428          zbeta = ( zknud + 1.0_wp ) / ( 0.377_wp * zknud + 1.0_wp + 4.0_wp /  &
5429                  ( 3.0_wp * massacc(b) ) * ( zknud + zknud ** 2.0_wp ) )
5430!                 
5431!--       Mass transfer of H2O: Eq. 16.64 but here D^eff =  zdfh2o * zbeta
5432          zhlp1 = paero(b)%numc * 2.0_wp * pi * paero(b)%dwet * zdfh2o *    &
5433                  zbeta 
5434!--       1st term on the left side of the denominator in eq. 16.55
5435          zhlp2 = amh2o * zdfh2o * alv * zwsatae(b) * zcwsurfae(b) /         &
5436                  ( zthcond * ptemp )
5437!--       2nd term on the left side of the denominator in eq. 16.55                           
5438          zhlp3 = ( (alv * amh2o ) / ( argas * ptemp ) ) - 1.0_wp
5439!--       Full eq. 16.64: Mass transfer coefficient (1/s)
5440          zmtae(b) = zhlp1 / ( zhlp2 * zhlp3 + 1.0_wp )
5441       ENDIF
5442    ENDDO
5443!
5444!-- Current mole concentrations of water
5445    zcwc = pcw * rhoair / amh2o   ! as vapour
5446    zcwcae(1:nbins) = paero(1:nbins)%volc(8) * arhoh2o / amh2o   ! in aerosols
5447    zcwtot = zcwc + SUM( zcwcae )   ! total water concentration
5448    ttot = 0.0_wp
5449    adtc = 0.0_wp
5450    zcwintae = zcwcae   
5451!             
5452!-- Substepping loop
5453    zcwint = 0.0_wp
5454    DO  WHILE ( ttot < ptstep )
5455       adt = 2.0E-2_wp   ! internal timestep
5456!       
5457!--    New vapour concentration: (eq. 16.71)
5458       zhlp1 = zcwc + adt * ( SUM( zmtae(nstr:nbins) * zwsatae(nstr:nbins) *   &
5459                                   zcwsurfae(nstr:nbins) ) )   ! numerator
5460       zhlp2 = 1.0_wp + adt * ( SUM( zmtae(nstr:nbins) ) )   ! denomin.
5461       zcwint = zhlp1 / zhlp2   ! new vapour concentration
5462       zcwint = MIN( zcwint, zcwtot )
5463       IF ( ANY( paero(:)%numc > nclim )  .AND. zrh > 0.98_wp )  THEN
5464          DO  b = nstr, nbins
5465             zcwintae(b) = zcwcae(b) + MIN( MAX( adt * zmtae(b) *           &
5466                          ( zcwint - zwsatae(b) * zcwsurfae(b) ),            &
5467                          -0.02_wp * zcwcae(b) ), 0.05_wp * zcwcae(b) )
5468             zwsatae(b) = acth2o( paero(b), zcwintae(b) ) * zkelvin(b)
5469          ENDDO
5470       ENDIF
5471       zcwintae(nstr:nbins) = MAX( zcwintae(nstr:nbins), 0.0_wp )
5472!       
5473!--    Update vapour concentration for consistency
5474       zcwint = zcwtot - SUM( zcwintae(1:nbins) )
5475!--    Update "old" values for next cycle
5476       zcwcae = zcwintae
5477
5478       ttot = ttot + adt
5479    ENDDO   ! ADT
5480    zcwn   = zcwint
5481    zcwnae = zcwintae
5482    pcw    = zcwn * amh2o / rhoair
5483    paero(1:nbins)%volc(8) = MAX( 0.0_wp, zcwnae(1:nbins) * amh2o / arhoh2o )
5484   
5485 END SUBROUTINE gpparth2o
5486
5487!------------------------------------------------------------------------------!
5488! Description:
5489! ------------
5490!> Calculates the activity coefficient of liquid water
5491!------------------------------------------------------------------------------!   
5492 REAL(wp) FUNCTION acth2o( ppart, pcw )
5493               
5494    IMPLICIT NONE
5495
5496    TYPE(t_section), INTENT(in) ::  ppart !< Aerosol properties of a bin
5497    REAL(wp), INTENT(in), OPTIONAL ::  pcw !< molar concentration of water
5498                                           !< (mol/m3)
5499
5500    REAL(wp) ::  zns !< molar concentration of solutes (mol/m3)
5501    REAL(wp) ::  znw !< molar concentration of water (mol/m3)
5502
5503    zns = ( 3.0_wp * ( ppart%volc(1) * arhoh2so4 / amh2so4 ) +               &
5504                     ( ppart%volc(2) * arhooc / amoc ) +                     &
5505            2.0_wp * ( ppart%volc(5) * arhoss / amss ) +                     &
5506                     ( ppart%volc(6) * arhohno3 / amhno3 ) +                 &
5507                     ( ppart%volc(7) * arhonh3 / amnh3 ) )
5508    IF ( PRESENT(pcw) ) THEN
5509       znw = pcw
5510    ELSE
5511       znw = ppart%volc(8) * arhoh2o / amh2o
5512    ENDIF
5513!-- Activity = partial pressure of water vapour /
5514!--            sat. vapour pressure of water over a bulk liquid surface
5515!--          = molality * activity coefficient (Jacobson, 2005: eq. 17.20-21)
5516!-- Assume activity coefficient of 1 for water
5517    acth2o = MAX( 0.1_wp, znw / MAX( EPSILON( 1.0_wp ),( znw + zns ) ) )
5518 END FUNCTION acth2o
5519
5520!------------------------------------------------------------------------------!
5521! Description:
5522! ------------
5523!> Calculates the dissolutional growth of particles (i.e. gas transfers to a
5524!> particle surface and dissolves in liquid water on the surface). Treated here
5525!> as a non-equilibrium (time-dependent) process. Gases: HNO3 and NH3
5526!> (Chapter 17.14 in Jacobson, 2005).
5527!
5528!> Called from subroutine condensation.
5529!> Coded by:
5530!> Harri Kokkola (FMI)
5531!------------------------------------------------------------------------------!
5532 SUBROUTINE gpparthno3( ppres, ptemp, paero, pghno3, pgnh3, pcw, pcs, pbeta,   &
5533                        ptstep )
5534               
5535    IMPLICIT NONE
5536!
5537!-- Input and output variables
5538    REAL(wp), INTENT(in) ::  pbeta(nbins) !< transitional correction factor for
5539                                          !< aerosols   
5540    REAL(wp), INTENT(in) ::  ppres        !< ambient pressure (Pa)
5541    REAL(wp), INTENT(in) ::  pcs          !< water vapour saturation
5542                                          !< concentration (kg/m3)
5543    REAL(wp), INTENT(in) ::  ptemp        !< ambient temperature (K)
5544    REAL(wp), INTENT(in) ::  ptstep       !< time step (s)
5545    REAL(wp), INTENT(inout) ::  pghno3    !< nitric acid concentration (#/m3)
5546    REAL(wp), INTENT(inout) ::  pgnh3     !< ammonia conc. (#/m3)   
5547    REAL(wp), INTENT(inout) ::  pcw       !< water vapour concentration (kg/m3)
5548    TYPE(t_section), INTENT(inout) ::  paero(nbins) !< Aerosol properties
5549!   
5550!-- Local variables
5551    INTEGER(iwp) ::  b              !< loop index
5552    REAL(wp) ::  adt                !< timestep
5553    REAL(wp) ::  zachhso4ae(nbins)  !< Activity coefficients for HHSO4
5554    REAL(wp) ::  zacnh3ae(nbins)    !< Activity coefficients for NH3
5555    REAL(wp) ::  zacnh4hso2ae(nbins)!< Activity coefficients for NH4HSO2
5556    REAL(wp) ::  zacno3ae(nbins)    !< Activity coefficients for HNO3
5557    REAL(wp) ::  zcgnh3eqae(nbins)  !< Equilibrium gas concentration: NH3
5558    REAL(wp) ::  zcgno3eqae(nbins)  !< Equilibrium gas concentration: HNO3
5559    REAL(wp) ::  zcgwaeqae(nbins)   !< Equilibrium gas concentration: H2O
5560    REAL(wp) ::  zcnh3c             !< Current NH3 gas concentration
5561    REAL(wp) ::  zcnh3int           !< Intermediate NH3 gas concentration
5562    REAL(wp) ::  zcnh3intae(nbins)  !< Intermediate NH3 aerosol concentration
5563    REAL(wp) ::  zcnh3n             !< New NH3 gas concentration
5564    REAL(wp) ::  zcnh3cae(nbins)    !< Current NH3 in aerosols
5565    REAL(wp) ::  zcnh3nae(nbins)    !< New NH3 in aerosols
5566    REAL(wp) ::  zcnh3tot           !< Total NH3 concentration
5567    REAL(wp) ::  zcno3c             !< Current HNO3 gas concentration
5568    REAL(wp) ::  zcno3int           !< Intermediate HNO3 gas concentration
5569    REAL(wp) ::  zcno3intae(nbins)  !< Intermediate HNO3 aerosol concentration
5570    REAL(wp) ::  zcno3n             !< New HNO3 gas concentration                 
5571    REAL(wp) ::  zcno3cae(nbins)    !< Current HNO3 in aerosols
5572    REAL(wp) ::  zcno3nae(nbins)    !< New HNO3 in aerosols
5573    REAL(wp) ::  zcno3tot           !< Total HNO3 concentration   
5574    REAL(wp) ::  zdfvap             !< Diffusion coefficient for vapors
5575    REAL(wp) ::  zhlp1              !< helping variable
5576    REAL(wp) ::  zhlp2              !< helping variable   
5577    REAL(wp) ::  zkelnh3ae(nbins)   !< Kelvin effects for NH3
5578    REAL(wp) ::  zkelno3ae(nbins)   !< Kelvin effect for HNO3
5579    REAL(wp) ::  zmolsae(nbins,7)   !< Ion molalities from pdfite
5580    REAL(wp) ::  zmtnh3ae(nbins)    !< Mass transfer coefficients for NH3
5581    REAL(wp) ::  zmtno3ae(nbins)    !< Mass transfer coefficients for HNO3
5582    REAL(wp) ::  zrh                !< relative humidity
5583    REAL(wp) ::  zsathno3ae(nbins)  !< HNO3 saturation ratio
5584    REAL(wp) ::  zsatnh3ae(nbins)   !< NH3 saturation ratio = the partial
5585                                    !< pressure of a gas divided by its
5586                                    !< saturation vapor pressure over a surface
5587!         
5588!-- Initialise:
5589    adt          = ptstep
5590    zachhso4ae   = 0.0_wp
5591    zacnh3ae     = 0.0_wp
5592    zacnh4hso2ae = 0.0_wp
5593    zacno3ae     = 0.0_wp
5594    zcgnh3eqae   = 0.0_wp
5595    zcgno3eqae   = 0.0_wp
5596    zcnh3c       = 0.0_wp
5597    zcnh3cae     = 0.0_wp
5598    zcnh3int     = 0.0_wp
5599    zcnh3intae   = 0.0_wp
5600    zcnh3n       = 0.0_wp
5601    zcnh3nae     = 0.0_wp
5602    zcnh3tot     = 0.0_wp
5603    zcno3c       = 0.0_wp
5604    zcno3cae     = 0.0_wp 
5605    zcno3int     = 0.0_wp
5606    zcno3intae   = 0.0_wp
5607    zcno3n       = 0.0_wp
5608    zcno3nae     = 0.0_wp
5609    zcno3tot     = 0.0_wp
5610    zhlp1        = 0.0_wp
5611    zhlp2        = 0.0_wp
5612    zkelno3ae    = 1.0_wp   
5613    zkelnh3ae    = 1.0_wp 
5614    zmolsae      = 0.0_wp
5615    zmtno3ae     = 0.0_wp
5616    zmtnh3ae     = 0.0_wp
5617    zrh          = 0.0_wp
5618    zsatnh3ae    = 1.0_wp
5619    zsathno3ae   = 1.0_wp
5620!             
5621!-- Diffusion coefficient (m2/s)             
5622    zdfvap = 5.1111E-10_wp * ptemp ** 1.75_wp * ( p_0 + 1325.0_wp ) / ppres 
5623!             
5624!-- Kelvin effects (Jacobson (2005), eq. 16.33)
5625    zkelno3ae(1:nbins) = EXP( 4.0_wp * surfw0 * amvhno3 / ( abo * ptemp *      &
5626                              paero(1:nbins)%dwet ) ) 
5627    zkelnh3ae(1:nbins) = EXP( 4.0_wp * surfw0 * amvnh3 / ( abo * ptemp *       &
5628                              paero(1:nbins)%dwet ) )
5629!                             
5630!-- Current vapour mole concentrations (mol/m3)
5631    zcno3c = pghno3 / avo            ! HNO3
5632    zcnh3c = pgnh3 / avo             ! NH3
5633!             
5634!-- Current particle mole concentrations (mol/m3)
5635    zcno3cae(1:nbins) = paero(1:nbins)%volc(6) * arhohno3 / amhno3
5636    zcnh3cae(1:nbins) = paero(1:nbins)%volc(7) * arhonh3 / amnh3
5637!   
5638!-- Total mole concentrations: gas and particle phase
5639    zcno3tot = zcno3c + SUM( zcno3cae(1:nbins) )
5640    zcnh3tot = zcnh3c + SUM( zcnh3cae(1:nbins) )
5641!   
5642!-- Relative humidity [0-1]
5643    zrh = pcw / pcs
5644!   
5645!-- Mass transfer coefficients (Jacobson, Eq. 16.64)
5646    zmtno3ae(1:nbins) = 2.0_wp * pi * paero(1:nbins)%dwet * zdfvap *           &
5647                        paero(1:nbins)%numc * pbeta(1:nbins)
5648    zmtnh3ae(1:nbins) = 2.0_wp * pi * paero(1:nbins)%dwet * zdfvap *           &
5649                        paero(1:nbins)%numc * pbeta(1:nbins)
5650
5651!   
5652!-- Get the equilibrium concentrations above aerosols
5653    CALL NONHEquil( zrh, ptemp, paero, zcgno3eqae, zcgnh3eqae, zacno3ae,       &
5654                    zacnh3ae, zacnh4hso2ae, zachhso4ae, zmolsae )
5655   
5656!
5657!-- NH4/HNO3 saturation ratios for aerosols
5658    CALL SVsat( ptemp, paero, zacno3ae, zacnh3ae, zacnh4hso2ae, zachhso4ae,    &
5659                zcgno3eqae, zcno3cae, zcnh3cae, zkelno3ae, zkelnh3ae,          &
5660                zsathno3ae, zsatnh3ae, zmolsae ) 
5661!   
5662!-- Intermediate concentrations   
5663    zhlp1 = SUM( zcno3cae(1:nbins) / ( 1.0_wp + adt * zmtno3ae(1:nbins) *      &
5664            zsathno3ae(1:nbins) ) )
5665    zhlp2 = SUM( zmtno3ae(1:nbins) / ( 1.0_wp + adt * zmtno3ae(1:nbins) *      &
5666            zsathno3ae(1:nbins) ) )
5667    zcno3int = ( zcno3tot - zhlp1 ) / ( 1.0_wp + adt * zhlp2 )
5668
5669    zhlp1 = SUM( zcnh3cae(1:nbins) / ( 1.0_wp + adt * zmtnh3ae(1:nbins) *      &
5670            zsatnh3ae(1:nbins) ) )
5671    zhlp2 = SUM( zmtnh3ae(1:nbins) / ( 1.0_wp + adt * zmtnh3ae(1:nbins) *      &
5672            zsatnh3ae(1:nbins) ) )
5673    zcnh3int = ( zcnh3tot - zhlp1 )/( 1.0_wp + adt * zhlp2 )
5674
5675    zcno3int = MIN(zcno3int, zcno3tot)
5676    zcnh3int = MIN(zcnh3int, zcnh3tot)
5677!
5678!-- Calculate the new particle concentrations
5679    zcno3intae = zcno3cae
5680    zcnh3intae = zcnh3cae
5681    DO  b = 1, nbins
5682       zcno3intae(b) = ( zcno3cae(b) + adt * zmtno3ae(b) * zcno3int ) /     &
5683            ( 1.0_wp + adt * zmtno3ae(b) * zsathno3ae(b) )
5684       zcnh3intae(b) = ( zcnh3cae(b) + adt * zmtnh3ae(b) * zcnh3int ) /     &
5685            ( 1.0_wp + adt * zmtnh3ae(b) * zsatnh3ae(b) )
5686    ENDDO
5687
5688    zcno3intae(1:nbins) = MAX( zcno3intae(1:nbins), 0.0_wp )
5689    zcnh3intae(1:nbins) = MAX( zcnh3intae(1:nbins), 0.0_wp )
5690
5691    zcno3n   = zcno3int    ! Final molar gas concentration of HNO3
5692    zcno3nae = zcno3intae  ! Final molar particle concentration of HNO3
5693   
5694    zcnh3n   = zcnh3int    ! Final molar gas concentration of NH3
5695    zcnh3nae = zcnh3intae  ! Final molar particle concentration of NH3
5696!
5697!-- Model timestep reached - update the new arrays
5698    pghno3 = zcno3n * avo
5699    pgnh3  = zcnh3n * avo
5700
5701    DO  b = in1a, fn2b
5702       paero(b)%volc(6) = zcno3nae(b) * amhno3 / arhohno3
5703       paero(b)%volc(7) = zcnh3nae(b) * amnh3 / arhonh3
5704    ENDDO
5705   
5706   
5707 END SUBROUTINE gpparthno3
5708!------------------------------------------------------------------------------!
5709! Description:
5710! ------------
5711!> Calculate the equilibrium concentrations above aerosols (reference?)
5712!------------------------------------------------------------------------------!
5713 SUBROUTINE NONHEquil( prh, ptemp, ppart, pcgno3eq, pcgnh3eq, pgammano,        &
5714                       pgammanh, pgammanh4hso2, pgammahhso4, pmols )
5715   
5716    IMPLICIT NONE
5717   
5718    REAL(wp), INTENT(in) ::  prh    !< relative humidity
5719    REAL(wp), INTENT(in) ::  ptemp  !< ambient temperature (K)
5720   
5721    TYPE(t_section), INTENT(inout) ::  ppart(nbins) !< Aerosol properties
5722!-- Equilibrium molar concentration above aerosols:
5723    REAL(wp), INTENT(inout) ::  pcgnh3eq(nbins)      !< of NH3
5724    REAL(wp), INTENT(inout) ::  pcgno3eq(nbins)      !< of HNO3
5725                                                     !< Activity coefficients:
5726    REAL(wp), INTENT(inout) ::  pgammahhso4(nbins)   !< HHSO4   
5727    REAL(wp), INTENT(inout) ::  pgammanh(nbins)      !< NH3
5728    REAL(wp), INTENT(inout) ::  pgammanh4hso2(nbins) !< NH4HSO2 
5729    REAL(wp), INTENT(inout) ::  pgammano(nbins)      !< HNO3
5730    REAL(wp), INTENT(inout) ::  pmols(nbins,7)       !< Ion molalities
5731   
5732    INTEGER(iwp) ::  b
5733
5734    REAL(wp) ::  zgammas(7)    !< Activity coefficients   
5735    REAL(wp) ::  zhlp          !< Dummy variable
5736    REAL(wp) ::  zions(7)      !< molar concentration of ion (mol/m3)
5737    REAL(wp) ::  zphcl         !< Equilibrium vapor pressures (Pa??)   
5738    REAL(wp) ::  zphno3        !< Equilibrium vapor pressures (Pa??)
5739    REAL(wp) ::  zpnh3         !< Equilibrium vapor pressures (Pa??)
5740    REAL(wp) ::  zwatertotal   !< Total water in particles (mol/m3) ???   
5741
5742    zgammas     = 0.0_wp
5743    zhlp        = 0.0_wp
5744    zions       = 0.0_wp
5745    zphcl       = 0.0_wp
5746    zphno3      = 0.0_wp
5747    zpnh3       = 0.0_wp
5748    zwatertotal = 0.0_wp
5749
5750    DO  b = 1, nbins
5751   
5752       IF ( ppart(b)%numc < nclim )  CYCLE
5753!
5754!--    2*H2SO4 + CL + NO3 - Na - NH4
5755       zhlp = 2.0_wp * ppart(b)%volc(1) * arhoh2so4 / amh2so4 +               &
5756              ppart(b)%volc(5) * arhoss / amss +                              &
5757              ppart(b)%volc(6) * arhohno3 / amhno3 -                          &
5758              ppart(b)%volc(5) * arhoss / amss -                              &
5759              ppart(b)%volc(7) * arhonh3 / amnh3
5760
5761       zhlp = MAX( zhlp, 1.0E-30_wp )
5762
5763       zions(1) = zhlp                                   ! H+
5764       zions(2) = ppart(b)%volc(7) * arhonh3 / amnh3     ! NH4+
5765       zions(3) = ppart(b)%volc(5) * arhoss / amss       ! Na+
5766       zions(4) = ppart(b)%volc(1) * arhoh2so4 / amh2so4 ! SO4(2-)
5767       zions(5) = 0.0_wp                                 ! HSO4-
5768       zions(6) = ppart(b)%volc(6) * arhohno3 / amhno3   ! NO3-
5769       zions(7) = ppart(b)%volc(5) * arhoss / amss       ! Cl-
5770
5771       zwatertotal = ppart(b)%volc(8) * arhoh2o / amh2o
5772       IF ( zwatertotal > 1.0E-30_wp )  THEN
5773          CALL inorganic_pdfite( prh, ptemp, zions, zwatertotal, zphno3, zphcl,&
5774                                 zpnh3, zgammas, pmols(b,:) )
5775       ENDIF
5776!
5777!--    Activity coefficients
5778       pgammano(b) = zgammas(1)           ! HNO3
5779       pgammanh(b) = zgammas(3)           ! NH3
5780       pgammanh4hso2(b) = zgammas(6)      ! NH4HSO2
5781       pgammahhso4(b) = zgammas(7)        ! HHSO4
5782!
5783!--    Equilibrium molar concentrations (mol/m3) from equlibrium pressures (Pa)
5784       pcgno3eq(b) = zphno3 / ( argas * ptemp )
5785       pcgnh3eq(b) = zpnh3 / ( argas * ptemp )
5786
5787    ENDDO
5788
5789  END SUBROUTINE NONHEquil
5790 
5791!------------------------------------------------------------------------------!
5792! Description:
5793! ------------
5794!> Calculate saturation ratios of NH4 and HNO3 for aerosols
5795!------------------------------------------------------------------------------!
5796 SUBROUTINE SVsat( ptemp, ppart, pachno3, pacnh3, pacnh4hso2, pachhso4,        &
5797                   pchno3eq, pchno3, pcnh3, pkelhno3, pkelnh3, psathno3,       &
5798                   psatnh3, pmols )
5799
5800    IMPLICIT NONE
5801   
5802    REAL(wp), INTENT(in) ::  ptemp  !< ambient temperature (K)
5803   
5804    TYPE(t_section), INTENT(inout) ::  ppart(nbins) !< Aerosol properties
5805!-- Activity coefficients
5806    REAL(wp), INTENT(in) ::  pachhso4(nbins)   !<
5807    REAL(wp), INTENT(in) ::  pacnh3(nbins)     !<
5808    REAL(wp), INTENT(in) ::  pacnh4hso2(nbins) !<
5809    REAL(wp), INTENT(in) ::  pachno3(nbins)    !<
5810    REAL(wp), INTENT(in) ::  pchno3eq(nbins) !< Equilibrium surface concentration
5811                                             !< of HNO3
5812    REAL(wp), INTENT(in) ::  pchno3(nbins)   !< Current particle mole
5813                                             !< concentration of HNO3 (mol/m3)
5814    REAL(wp), INTENT(in) ::  pcnh3(nbins)    !< Current particle mole
5815                                             !< concentration of NH3 (mol/m3)
5816    REAL(wp), INTENT(in) ::  pkelhno3(nbins) !< Kelvin effect for HNO3
5817    REAL(wp), INTENT(in) ::  pkelnh3(nbins)  !< Kelvin effect for NH3
5818    REAL(wp), INTENT(in) ::  pmols(nbins,7)
5819!-- Saturation ratios
5820    REAL(wp), INTENT(out) ::  psathno3(nbins) !<
5821    REAL(wp), INTENT(out) ::  psatnh3(nbins)  !<
5822   
5823    INTEGER :: b   !< running index for aerosol bins
5824!-- Constants for calculating equilibrium constants:   
5825    REAL(wp), PARAMETER ::  a1 = -22.52_wp     !<
5826    REAL(wp), PARAMETER ::  a2 = -1.50_wp      !<
5827    REAL(wp), PARAMETER ::  a3 = 13.79_wp      !<
5828    REAL(wp), PARAMETER ::  a4 = 29.17_wp      !<
5829    REAL(wp), PARAMETER ::  b1 = 26.92_wp      !<
5830    REAL(wp), PARAMETER ::  b2 = 26.92_wp      !<
5831    REAL(wp), PARAMETER ::  b3 = -5.39_wp      !<
5832    REAL(wp), PARAMETER ::  b4 = 16.84_wp      !<
5833    REAL(wp), PARAMETER ::  K01 = 1.01E-14_wp  !<
5834    REAL(wp), PARAMETER ::  K02 = 1.81E-5_wp   !<
5835    REAL(wp), PARAMETER ::  K03 = 57.64_wp     !<
5836    REAL(wp), PARAMETER ::  K04 = 2.51E+6_wp   !<
5837!-- Equilibrium constants of equilibrium reactions
5838    REAL(wp) ::  KllH2O    !< H2O(aq) <--> H+ + OH- (mol/kg)
5839    REAL(wp) ::  KllNH3    !< NH3(aq) + H2O(aq) <--> NH4+ + OH- (mol/kg)
5840    REAL(wp) ::  KglNH3    !< NH3(g) <--> NH3(aq) (mol/kg/atm)
5841    REAL(wp) ::  KglHNO3   !< HNO3(g) <--> H+ + NO3- (mol2/kg2/atm)
5842    REAL(wp) ::  zmolno3   !< molality of NO3- (mol/kg)
5843    REAL(wp) ::  zmolhp    !< molality of H+ (mol/kg)
5844    REAL(wp) ::  zmolso4   !< molality of SO4(2-) (mol/kg)
5845    REAL(wp) ::  zmolcl    !< molality of Cl (mol/kg)
5846    REAL(wp) ::  zmolnh4   !< Molality of NH4 (mol/kg)
5847    REAL(wp) ::  zmolna    !< Molality of Na (mol/kg)
5848    REAL(wp) ::  zhlp1     !<
5849    REAL(wp) ::  zhlp2     !<
5850    REAL(wp) ::  zhlp3     !<
5851    REAL(wp) ::  zxi       !<
5852    REAL(wp) ::  zt0       !< Reference temp
5853   
5854    zhlp1   = 0.0_wp
5855    zhlp2   = 0.0_wp 
5856    zhlp3   = 0.0_wp
5857    zmolcl  = 0.0_wp
5858    zmolhp  = 0.0_wp
5859    zmolna  = 0.0_wp
5860    zmolnh4 = 0.0_wp
5861    zmolno3 = 0.0_wp
5862    zmolso4 = 0.0_wp
5863    zt0     = 298.15_wp 
5864    zxi     = 0.0_wp
5865!
5866!-- Calculates equlibrium rate constants based on Table B.7 in Jacobson (2005)
5867!-- K^ll_H20, K^ll_NH3, K^gl_NH3, K^gl_HNO3
5868    zhlp1 = zt0 / ptemp
5869    zhlp2 = zhlp1 - 1.0_wp
5870    zhlp3 = 1.0_wp + LOG( zhlp1 ) - zhlp1
5871
5872    KllH2O = K01 * EXP( a1 * zhlp2 + b1 * zhlp3 )
5873    KllNH3 = K02 * EXP( a2 * zhlp2 + b2 * zhlp3 )
5874    KglNH3 = K03 * EXP( a3 * zhlp2 + b3 * zhlp3 )
5875    KglHNO3 = K04 * EXP( a4 * zhlp2 + b4 * zhlp3 )
5876
5877    DO  b = 1, nbins
5878
5879       IF ( ppart(b)%numc > nclim  .AND.  ppart(b)%volc(8) > 1.0E-30_wp  )  THEN
5880!
5881!--       Molality of H+ and NO3-
5882          zhlp1 = pcnh3(b) * amnh3 + ppart(b)%volc(1) * arhoh2so4 +            &
5883                  ppart(b)%volc(2) * arhooc + ppart(b)%volc(5) * arhoss +      &
5884                  ppart(b)%volc(8) * arhoh2o
5885          zmolno3 = pchno3(b) / zhlp1  !< mol/kg
5886!
5887!--       Particle mole concentration ratio: (NH3+SS)/H2SO4       
5888          zxi = ( pcnh3(b) + ppart(b)%volc(5) * arhoss / amss ) /              &
5889                ( ppart(b)%volc(1) * arhoh2so4 / amh2so4 )
5890               
5891          IF ( zxi <= 2.0_wp )  THEN
5892!
5893!--          Molality of SO4(2-)
5894             zhlp1 = pcnh3(b) * amnh3 + pchno3(b) * amhno3 +                   &
5895                     ppart(b)%volc(2) * arhooc + ppart(b)%volc(5) * arhoss +   &
5896                     ppart(b)%volc(8) * arhoh2o
5897             zmolso4 = ( ppart(b)%volc(1) * arhoh2so4 / amh2so4 ) / zhlp1
5898!
5899!--          Molality of Cl-
5900             zhlp1 = pcnh3(b) * amnh3 + pchno3(b) * amhno3 +                   &
5901                     ppart(b)%volc(2) * arhooc + ppart(b)%volc(1) * arhoh2so4  &
5902                     + ppart(b)%volc(8) * arhoh2o
5903             zmolcl = ( ppart(b)%volc(5) * arhoss / amss ) / zhlp1
5904!
5905!--          Molality of NH4+
5906             zhlp1 =  pchno3(b) * amhno3 + ppart(b)%volc(1) * arhoh2so4 +      &
5907                      ppart(b)%volc(2) * arhooc + ppart(b)%volc(5) * arhoss +  &
5908                      ppart(b)%volc(8) * arhoh2o
5909             zmolnh4 = pcnh3(b) / zhlp1
5910!             
5911!--          Molality of Na+
5912             zmolna = zmolcl
5913!
5914!--          Molality of H+
5915             zmolhp = 2.0_wp * zmolso4 + zmolno3 + zmolcl - ( zmolnh4 + zmolna )
5916
5917          ELSE
5918
5919             zhlp2 = pkelhno3(b) * zmolno3 * pachno3(b) ** 2.0_wp
5920!
5921!--          Mona debugging
5922             IF ( zhlp2 > 1.0E-30_wp )  THEN
5923                zmolhp = KglHNO3 * pchno3eq(b) / zhlp2 ! Eq. 17.38
5924             ELSE
5925                zmolhp = 0.0_wp
5926             ENDIF
5927
5928          ENDIF
5929
5930          zhlp1 = ppart(b)%volc(8) * arhoh2o * argas * ptemp * KglHNO3
5931!
5932!--       Saturation ratio for NH3 and for HNO3
5933          IF ( zmolhp > 0.0_wp )  THEN
5934             zhlp2 = pkelnh3(b) / ( zhlp1 * zmolhp )
5935             zhlp3 = KllH2O / ( KllNH3 + KglNH3 )
5936             psatnh3(b) = zhlp2 * ( ( pacnh4hso2(b) / pachhso4(b) ) **2.0_wp ) &
5937                          * zhlp3
5938             psathno3(b) = ( pkelhno3(b) * zmolhp * pachno3(b)**2.0_wp ) / zhlp1
5939          ELSE
5940             psatnh3(b) = 1.0_wp
5941             psathno3(b) = 1.0_wp
5942          ENDIF
5943       ELSE
5944          psatnh3(b) = 1.0_wp
5945          psathno3(b) = 1.0_wp
5946       ENDIF
5947
5948    ENDDO
5949
5950  END SUBROUTINE SVsat
5951 
5952!------------------------------------------------------------------------------!
5953! Description:
5954! ------------
5955!> Prototype module for calculating the water content of a mixed inorganic/
5956!> organic particle + equilibrium water vapour pressure above the solution
5957!> (HNO3, HCL, NH3 and representative organic compounds. Efficient calculation
5958!> of the partitioning of species between gas and aerosol. Based in a chamber
5959!> study.
5960!
5961!> Written by Dave Topping. Pure organic component properties predicted by Mark
5962!> Barley based on VOCs predicted in MCM simulations performed by Mike Jenkin.
5963!> Delivered by Gordon McFiggans as Deliverable D22 from WP1.4 in the EU FP6
5964!> EUCAARI Integrated Project.
5965!
5966!> Queries concerning the use of this code through Gordon McFiggans,
5967!> g.mcfiggans@manchester.ac.uk,
5968!> Ownership: D. Topping, Centre for Atmospheric Sciences, University of
5969!> Manchester, 2007
5970!
5971!> Rewritten to PALM by Mona Kurppa, UHel, 2017
5972!------------------------------------------------------------------------------!
5973 SUBROUTINE inorganic_pdfite( RH, temp, ions, water_total, Press_HNO3,         &
5974                               Press_HCL, Press_NH3, gamma_out, mols_out )
5975   
5976    IMPLICIT NONE
5977   
5978    REAL(wp), DIMENSION(:) ::  gamma_out !< Activity coefficient for calculating
5979                                         !< the non-ideal dissociation constants
5980                                         !< 1: HNO3, 2: HCL, 3: NH4+/H+ (NH3)
5981                                         !< 4: HHSO4**2/H2SO4,
5982                                         !< 5: H2SO4**3/HHSO4**2
5983                                         !< 6: NH4HSO2, 7: HHSO4
5984    REAL(wp), DIMENSION(:) ::  ions      !< ion molarities (mol/m3)
5985                                         !< 1: H+, 2: NH4+, 3: Na+, 4: SO4(2-),
5986                                         !< 5: HSO4-, 6: NO3-, 7: Cl-
5987    REAL(wp), DIMENSION(7) ::  ions_mol  !< ion molalities (mol/kg)
5988                                         !< 1: H+, 2: NH4+, 3: Na+, 4: SO4(2-),
5989                                         !< 5: HSO4-, 6: NO3-, 7: Cl-
5990    REAL(wp), DIMENSION(:) ::  mols_out  !< ion molality output (mol/kg)
5991                                         !< 1: H+, 2: NH4+, 3: Na+, 4: SO4(2-),
5992                                         !< 5: HSO4-, 6: NO3-, 7: Cl-
5993    REAL(wp) ::  act_product               !< ionic activity coef. product:
5994                                           !< = (gamma_h2so4**3d0) /
5995                                           !<   (gamma_hhso4**2d0)       
5996    REAL(wp) ::  ammonium_chloride         !<
5997    REAL(wp) ::  ammonium_chloride_eq_frac !<                         
5998    REAL(wp) ::  ammonium_nitrate          !<
5999    REAL(wp) ::  ammonium_nitrate_eq_frac  !<       
6000    REAL(wp) ::  ammonium_sulphate         !< 
6001    REAL(wp) ::  ammonium_sulphate_eq_frac !<
6002    REAL(wp) ::  binary_h2so4              !< binary H2SO4 activity coeff.       
6003    REAL(wp) ::  binary_hcl                !< binary HCL activity coeff.
6004    REAL(wp) ::  binary_hhso4              !< binary HHSO4 activity coeff.     
6005    REAL(wp) ::  binary_hno3               !< binary HNO3 activity coeff.
6006    REAL(wp) ::  binary_nh4hso4            !< binary NH4HSO4 activity coeff.   
6007    REAL(wp) ::  charge_sum                !< sum of ionic charges
6008    REAL(wp) ::  gamma_h2so4               !< activity coefficient       
6009    REAL(wp) ::  gamma_hcl                 !< activity coefficient
6010    REAL(wp) ::  gamma_hhso4               !< activity coeffient       
6011    REAL(wp) ::  gamma_hno3                !< activity coefficient
6012    REAL(wp) ::  gamma_nh3                 !< activity coefficient
6013    REAL(wp) ::  gamma_nh4hso4             !< activity coefficient
6014    REAL(wp) ::  h_out                     !<
6015    REAL(wp) ::  h_real                    !< new hydrogen ion conc.
6016    REAL(wp) ::  H2SO4_hcl                 !< contribution of H2SO4       
6017    REAL(wp) ::  H2SO4_hno3                !< contribution of H2SO4
6018    REAL(wp) ::  H2SO4_nh3                 !< contribution of H2SO4
6019    REAL(wp) ::  H2SO4_nh4hso4             !< contribution of H2SO4       
6020    REAL(wp) ::  HCL_h2so4                 !< contribution of HCL       
6021    REAL(wp) ::  HCL_hhso4                 !< contribution of HCL       
6022    REAL(wp) ::  HCL_hno3                  !< contribution of HCL
6023    REAL(wp) ::  HCL_nh3                   !< contribution of HCL
6024    REAL(wp) ::  HCL_nh4hso4               !< contribution of HCL
6025    REAL(wp) ::  henrys_temp_dep           !< temperature dependence of
6026                                           !< Henry's Law       
6027    REAL(wp) ::  HNO3_h2so4                !< contribution of HNO3       
6028    REAL(wp) ::  HNO3_hcl                  !< contribution of HNO3
6029    REAL(wp) ::  HNO3_hhso4                !< contribution of HNO3
6030    REAL(wp) ::  HNO3_nh3                  !< contribution of HNO3
6031    REAL(wp) ::  HNO3_nh4hso4              !< contribution of HNO3
6032    REAL(wp) ::  hso4_out                  !<
6033    REAL(wp) ::  hso4_real                 !< new bisulphate ion conc.
6034    REAL(wp) ::  hydrochloric_acid         !<
6035    REAL(wp) ::  hydrochloric_acid_eq_frac !<
6036    REAL(wp) ::  Kh                        !< equilibrium constant for H+       
6037    REAL(wp) ::  K_hcl                     !< equilibrium constant of HCL       
6038    REAL(wp) ::  K_hno3                    !< equilibrium constant of HNO3
6039    REAL(wp) ::  Knh4                      !< equilibrium constant for NH4+
6040    REAL(wp) ::  Kw                        !< equil. const. for water_surface 
6041    REAL(wp) ::  Ln_h2so4_act              !< gamma_h2so4 = EXP(Ln_h2so4_act)
6042    REAL(wp) ::  Ln_HCL_act                !< gamma_hcl = EXP( Ln_HCL_act )
6043    REAL(wp) ::  Ln_hhso4_act              !< gamma_hhso4 = EXP(Ln_hhso4_act)
6044    REAL(wp) ::  Ln_HNO3_act               !< gamma_hno3 = EXP( Ln_HNO3_act )
6045    REAL(wp) ::  Ln_NH4HSO4_act            !< gamma_nh4hso4 =
6046                                           !< EXP( Ln_NH4HSO4_act )
6047    REAL(wp) ::  molality_ratio_nh3        !< molality ratio of NH3
6048                                           !< (NH4+ and H+)
6049    REAL(wp) ::  Na2SO4_h2so4              !< contribution of Na2SO4                                             
6050    REAL(wp) ::  Na2SO4_hcl                !< contribution of Na2SO4
6051    REAL(wp) ::  Na2SO4_hhso4              !< contribution of Na2SO4       
6052    REAL(wp) ::  Na2SO4_hno3               !< contribution of Na2SO4
6053    REAL(wp) ::  Na2SO4_nh3                !< contribution of Na2SO4
6054    REAL(wp) ::  Na2SO4_nh4hso4            !< contribution of Na2SO4       
6055    REAL(wp) ::  NaCl_h2so4                !< contribution of NaCl       
6056    REAL(wp) ::  NaCl_hcl                  !< contribution of NaCl
6057    REAL(wp) ::  NaCl_hhso4                !< contribution of NaCl       
6058    REAL(wp) ::  NaCl_hno3                 !< contribution of NaCl
6059    REAL(wp) ::  NaCl_nh3                  !< contribution of NaCl
6060    REAL(wp) ::  NaCl_nh4hso4              !< contribution of NaCl       
6061    REAL(wp) ::  NaNO3_h2so4               !< contribution of NaNO3       
6062    REAL(wp) ::  NaNO3_hcl                 !< contribution of NaNO3
6063    REAL(wp) ::  NaNO3_hhso4               !< contribution of NaNO3       
6064    REAL(wp) ::  NaNO3_hno3                !< contribution of NaNO3
6065    REAL(wp) ::  NaNO3_nh3                 !< contribution of NaNO3 
6066    REAL(wp) ::  NaNO3_nh4hso4             !< contribution of NaNO3       
6067    REAL(wp) ::  NH42SO4_h2so4             !< contribution of NH42SO4       
6068    REAL(wp) ::  NH42SO4_hcl               !< contribution of NH42SO4
6069    REAL(wp) ::  NH42SO4_hhso4             !< contribution of NH42SO4       
6070    REAL(wp) ::  NH42SO4_hno3              !< contribution of NH42SO4
6071    REAL(wp) ::  NH42SO4_nh3               !< contribution of NH42SO4
6072    REAL(wp) ::  NH42SO4_nh4hso4           !< contribution of NH42SO4
6073    REAL(wp) ::  NH4Cl_h2so4               !< contribution of NH4Cl       
6074    REAL(wp) ::  NH4Cl_hcl                 !< contribution of NH4Cl
6075    REAL(wp) ::  NH4Cl_hhso4               !< contribution of NH4Cl       
6076    REAL(wp) ::  NH4Cl_hno3                !< contribution of NH4Cl
6077    REAL(wp) ::  NH4Cl_nh3                 !< contribution of NH4Cl
6078    REAL(wp) ::  NH4Cl_nh4hso4             !< contribution of NH4Cl       
6079    REAL(wp) ::  NH4NO3_h2so4              !< contribution of NH4NO3
6080    REAL(wp) ::  NH4NO3_hcl                !< contribution of NH4NO3
6081    REAL(wp) ::  NH4NO3_hhso4              !< contribution of NH4NO3
6082    REAL(wp) ::  NH4NO3_hno3               !< contribution of NH4NO3
6083    REAL(wp) ::  NH4NO3_nh3                !< contribution of NH4NO3
6084    REAL(wp) ::  NH4NO3_nh4hso4            !< contribution of NH4NO3       
6085    REAL(wp) ::  nitric_acid               !<
6086    REAL(wp) ::  nitric_acid_eq_frac       !< Equivalent fractions
6087    REAL(wp) ::  Press_HCL                 !< partial pressure of HCL       
6088    REAL(wp) ::  Press_HNO3                !< partial pressure of HNO3
6089    REAL(wp) ::  Press_NH3                 !< partial pressure of NH3       
6090    REAL(wp) ::  RH                        !< relative humidity [0-1]
6091    REAL(wp) ::  temp                      !< temperature
6092    REAL(wp) ::  so4_out                   !<
6093    REAL(wp) ::  so4_real                  !< new sulpate ion concentration       
6094    REAL(wp) ::  sodium_chloride           !<
6095    REAL(wp) ::  sodium_chloride_eq_frac   !<   
6096    REAL(wp) ::  sodium_nitrate            !<
6097    REAL(wp) ::  sodium_nitrate_eq_frac    !<   
6098    REAL(wp) ::  sodium_sulphate           !<
6099    REAL(wp) ::  sodium_sulphate_eq_frac   !<       
6100    REAL(wp) ::  solutes                   !<
6101    REAL(wp) ::  sulphuric_acid            !<       
6102    REAL(wp) ::  sulphuric_acid_eq_frac    !<
6103    REAL(wp) ::  water_total               !<
6104   
6105    REAL(wp) ::  a !< auxiliary variable
6106    REAL(wp) ::  b !< auxiliary variable
6107    REAL(wp) ::  c !< auxiliary variable
6108    REAL(wp) ::  root1 !< auxiliary variable
6109    REAL(wp) ::  root2 !< auxiliary variable
6110
6111    INTEGER(iwp) ::  binary_case
6112    INTEGER(iwp) ::  full_complexity
6113!       
6114!-- Value initialisation
6115    binary_h2so4    = 0.0_wp   
6116    binary_hcl      = 0.0_wp 
6117    binary_hhso4    = 0.0_wp 
6118    binary_hno3     = 0.0_wp 
6119    binary_nh4hso4  = 0.0_wp 
6120    henrys_temp_dep = ( 1.0_wp / temp - 1.0_wp / 298.0_wp )
6121    HCL_hno3        = 1.0_wp
6122    H2SO4_hno3      = 1.0_wp
6123    NH42SO4_hno3    = 1.0_wp
6124    NH4NO3_hno3     = 1.0_wp
6125    NH4Cl_hno3      = 1.0_wp
6126    Na2SO4_hno3     = 1.0_wp
6127    NaNO3_hno3      = 1.0_wp
6128    NaCl_hno3       = 1.0_wp
6129    HNO3_hcl        = 1.0_wp
6130    H2SO4_hcl       = 1.0_wp
6131    NH42SO4_hcl     = 1.0_wp
6132    NH4NO3_hcl      = 1.0_wp
6133    NH4Cl_hcl       = 1.0_wp
6134    Na2SO4_hcl      = 1.0_wp 
6135    NaNO3_hcl       = 1.0_wp
6136    NaCl_hcl        = 1.0_wp
6137    HNO3_nh3        = 1.0_wp
6138    HCL_nh3         = 1.0_wp
6139    H2SO4_nh3       = 1.0_wp 
6140    NH42SO4_nh3     = 1.0_wp 
6141    NH4NO3_nh3      = 1.0_wp
6142    NH4Cl_nh3       = 1.0_wp
6143    Na2SO4_nh3      = 1.0_wp
6144    NaNO3_nh3       = 1.0_wp
6145    NaCl_nh3        = 1.0_wp
6146    HNO3_hhso4      = 1.0_wp 
6147    HCL_hhso4       = 1.0_wp
6148    NH42SO4_hhso4   = 1.0_wp
6149    NH4NO3_hhso4    = 1.0_wp
6150    NH4Cl_hhso4     = 1.0_wp
6151    Na2SO4_hhso4    = 1.0_wp
6152    NaNO3_hhso4     = 1.0_wp
6153    NaCl_hhso4      = 1.0_wp
6154    HNO3_h2so4      = 1.0_wp
6155    HCL_h2so4       = 1.0_wp
6156    NH42SO4_h2so4   = 1.0_wp 
6157    NH4NO3_h2so4    = 1.0_wp
6158    NH4Cl_h2so4     = 1.0_wp
6159    Na2SO4_h2so4    = 1.0_wp
6160    NaNO3_h2so4     = 1.0_wp
6161    NaCl_h2so4      = 1.0_wp
6162!-- New NH3 variables
6163    HNO3_nh4hso4    = 1.0_wp 
6164    HCL_nh4hso4     = 1.0_wp
6165    H2SO4_nh4hso4   = 1.0_wp
6166    NH42SO4_nh4hso4 = 1.0_wp 
6167    NH4NO3_nh4hso4  = 1.0_wp
6168    NH4Cl_nh4hso4   = 1.0_wp
6169    Na2SO4_nh4hso4  = 1.0_wp
6170    NaNO3_nh4hso4   = 1.0_wp
6171    NaCl_nh4hso4    = 1.0_wp
6172!
6173!-- Juha Tonttila added
6174    mols_out   = 0.0_wp
6175    Press_HNO3 = 0.0_wp
6176    Press_HCL  = 0.0_wp
6177    Press_NH3  = 0.0_wp !< Initialising vapour pressure over the
6178                        !< multicomponent particle
6179    gamma_out  = 1.0_wp !< i.e. don't alter the ideal mixing ratios if
6180                        !< there's nothing there.
6181!       
6182!-- 1) - COMPOSITION DEFINITIONS
6183!
6184!-- a) Inorganic ion pairing:
6185!-- In order to calculate the water content, which is also used in
6186!-- calculating vapour pressures, one needs to pair the anions and cations
6187!-- for use in the ZSR mixing rule. The equation provided by Clegg et al.
6188!-- (2001) is used for ion pairing. The solutes chosen comprise of 9
6189!-- inorganic salts and acids which provide a pairing between each anion and
6190!-- cation: (NH4)2SO4, NH4NO3, NH4Cl, Na2SO4, NaNO3, NaCl, H2SO4, HNO3, HCL. 
6191!-- The organic compound is treated as a seperate solute.
6192!-- Ions: 1: H+, 2: NH4+, 3: Na+, 4: SO4(2-), 5: HSO4-, 6: NO3-, 7: Cl-
6193!
6194    charge_sum = ions(1) + ions(2) + ions(3) + 2.0_wp * ions(4) + ions(5) +    &
6195                 ions(6) + ions(7)
6196    nitric_acid       = 0.0_wp   ! HNO3
6197    nitric_acid       = ( 2.0_wp * ions(1) * ions(6) *                         &
6198                        ( ( 1.0_wp / 1.0_wp ) ** 0.5_wp ) ) / ( charge_sum )
6199    hydrochloric_acid = 0.0_wp   ! HCL
6200    hydrochloric_acid = ( 2.0_wp * ions(1) * ions(7) *                         &
6201                        ( ( 1.0_wp / 1.0_wp ) ** 0.5_wp ) ) / ( charge_sum )
6202    sulphuric_acid    = 0.0_wp   ! H2SO4
6203    sulphuric_acid    = ( 2.0_wp * ions(1) * ions(4) *                         &
6204                        ( ( 2.0_wp / 2.0_wp ) ** 0.5_wp ) ) / ( charge_sum )
6205    ammonium_sulphate = 0.0_wp   ! (NH4)2SO4
6206    ammonium_sulphate = ( 2.0_wp * ions(2) * ions(4) *                         &
6207                        ( ( 2.0_wp / 2.0_wp ) ** 0.5_wp ) ) / ( charge_sum ) 
6208    ammonium_nitrate  = 0.0_wp   ! NH4NO3
6209    ammonium_nitrate  = ( 2.0_wp * ions(2) * ions(6) *                         &
6210                        ( ( 1.0_wp / 1.0_wp ) ** 0.5_wp ) ) / ( charge_sum )
6211    ammonium_chloride = 0.0_wp   ! NH4Cl
6212    ammonium_chloride = ( 2.0_wp * ions(2) * ions(7) *                         &
6213                        ( ( 1.0_wp / 1.0_wp ) ** 0.5_wp ) ) / ( charge_sum )   
6214    sodium_sulphate   = 0.0_wp   ! Na2SO4
6215    sodium_sulphate   = ( 2.0_wp * ions(3) * ions(4) *                         &
6216                        ( ( 2.0_wp / 2.0_wp ) ** 0.5_wp ) ) / ( charge_sum )
6217    sodium_nitrate    = 0.0_wp   ! NaNO3
6218    sodium_nitrate    = ( 2.0_wp * ions(3) *ions(6) *                          &
6219                        ( ( 1.0_wp / 1.0_wp ) ** 0.5_wp ) ) / ( charge_sum )
6220    sodium_chloride   = 0.0_wp   ! NaCl
6221    sodium_chloride   = ( 2.0_wp * ions(3) * ions(7) *                         &
6222                        ( ( 1.0_wp / 1.0_wp ) ** 0.5_wp ) ) / ( charge_sum )
6223    solutes = 0.0_wp
6224    solutes = 3.0_wp * sulphuric_acid +   2.0_wp * hydrochloric_acid +         &
6225              2.0_wp * nitric_acid +      3.0_wp * ammonium_sulphate +         &
6226              2.0_wp * ammonium_nitrate + 2.0_wp * ammonium_chloride +         &
6227              3.0_wp * sodium_sulphate +  2.0_wp * sodium_nitrate +            &
6228              2.0_wp * sodium_chloride
6229
6230!
6231!-- b) Inorganic equivalent fractions:
6232!-- These values are calculated so that activity coefficients can be
6233!-- expressed by a linear additive rule, thus allowing more efficient
6234!-- calculations and future expansion (see more detailed description below)               
6235    nitric_acid_eq_frac       = 2.0_wp * nitric_acid / ( solutes )
6236    hydrochloric_acid_eq_frac = 2.0_wp * hydrochloric_acid / ( solutes )
6237    sulphuric_acid_eq_frac    = 3.0_wp * sulphuric_acid / ( solutes )
6238    ammonium_sulphate_eq_frac = 3.0_wp * ammonium_sulphate / ( solutes )
6239    ammonium_nitrate_eq_frac  = 2.0_wp * ammonium_nitrate / ( solutes )
6240    ammonium_chloride_eq_frac = 2.0_wp * ammonium_chloride / ( solutes )
6241    sodium_sulphate_eq_frac   = 3.0_wp * sodium_sulphate / ( solutes )
6242    sodium_nitrate_eq_frac    = 2.0_wp * sodium_nitrate / ( solutes )
6243    sodium_chloride_eq_frac   = 2.0_wp * sodium_chloride / ( solutes )
6244!
6245!-- Inorganic ion molalities
6246    ions_mol(:) = 0.0_wp
6247    ions_mol(1) = ions(1) / ( water_total * 18.01528E-3_wp )   ! H+
6248    ions_mol(2) = ions(2) / ( water_total * 18.01528E-3_wp )   ! NH4+
6249    ions_mol(3) = ions(3) / ( water_total * 18.01528E-3_wp )   ! Na+
6250    ions_mol(4) = ions(4) / ( water_total * 18.01528E-3_wp )   ! SO4(2-)
6251    ions_mol(5) = ions(5) / ( water_total * 18.01528E-3_wp )   ! HSO4(2-)
6252    ions_mol(6) = ions(6) / ( water_total * 18.01528E-3_wp )   !  NO3-
6253    ions_mol(7) = ions(7) / ( water_total * 18.01528E-3_wp )   ! Cl-
6254
6255!--    ***
6256!-- At this point we may need to introduce a method for prescribing H+ when
6257!-- there is no 'real' value for H+..i.e. in the sulphate poor domain
6258!-- This will give a value for solve quadratic proposed by Zaveri et al. 2005
6259!
6260!-- 2) - WATER CALCULATION
6261!
6262!-- a) The water content is calculated using the ZSR rule with solute
6263!-- concentrations calculated using 1a above. Whilst the usual approximation of
6264!-- ZSR relies on binary data consisting of 5th or higher order polynomials, in
6265!-- this code 4 different RH regimes are used, each housing cubic equations for
6266!-- the water associated with each solute listed above. Binary water contents
6267!-- for inorganic components were calculated using AIM online (Clegg et al
6268!-- 1998). The water associated with the organic compound is calculated assuming
6269!-- ideality and that aw = RH.
6270!
6271!-- b) Molality of each inorganic ion and organic solute (initial input) is
6272!-- calculated for use in vapour pressure calculation.
6273!
6274!-- 3) - BISULPHATE ION DISSOCIATION CALCULATION
6275!
6276!-- The dissociation of the bisulphate ion is calculated explicitly. A solution
6277!-- to the equilibrium equation between the bisulphate ion, hydrogen ion and
6278!-- sulphate ion is found using tabulated equilibrium constants (referenced). It
6279!-- is necessary to calculate the activity coefficients of HHSO4 and H2SO4 in a
6280!-- non-iterative manner. These are calculated using the same format as
6281!-- described in 4) below, where both activity coefficients were fit to the
6282!-- output from ADDEM (Topping et al 2005a,b) covering an extensive composition
6283!-- space, providing the activity coefficients and bisulphate ion dissociation
6284!-- as a function of equivalent mole fractions and relative humidity.
6285!
6286!-- NOTE: the flags "binary_case" and "full_complexity" are not used in this
6287!-- prototype. They are used for simplification of the fit expressions when
6288!-- using limited composition regions. This section of code calculates the
6289!-- bisulphate ion concentration
6290!
6291    IF ( ions(1) > 0.0_wp .AND. ions(4) > 0.0_wp ) THEN
6292!       
6293!--    HHSO4:
6294       binary_case = 1
6295       IF ( RH > 0.1_wp  .AND.  RH < 0.9_wp )  THEN
6296          binary_hhso4 = - 4.9521_wp * ( RH**3 ) + 9.2881_wp * ( RH**2 ) -     &
6297                           10.777_wp * RH + 6.0534_wp
6298       ELSEIF ( RH >= 0.9_wp  .AND.  RH < 0.955_wp )  THEN
6299          binary_hhso4 = - 6.3777_wp * RH + 5.962_wp
6300       ELSEIF ( RH >= 0.955_wp  .AND.  RH < 0.99_wp )  THEN
6301          binary_hhso4 = 2367.2_wp * ( RH**3 ) - 6849.7_wp * ( RH**2 ) +       &
6302                         6600.9_wp * RH - 2118.7_wp   
6303       ELSEIF ( RH >= 0.99_wp  .AND.  RH < 0.9999_wp )  THEN
6304          binary_hhso4 = 3E-7_wp * ( RH**5 ) - 2E-5_wp * ( RH**4 ) +           &
6305                         0.0004_wp * ( RH**3 ) - 0.0035_wp * ( RH**2 ) +       &
6306                         0.0123_wp * RH - 0.3025_wp
6307       ENDIF
6308       
6309       IF ( nitric_acid > 0.0_wp )  THEN
6310          HNO3_hhso4 = - 4.2204_wp * ( RH**4 ) + 12.193_wp * ( RH**3 ) -       &
6311                         12.481_wp * ( RH**2 ) + 6.459_wp * RH - 1.9004_wp
6312       ENDIF
6313       
6314       IF ( hydrochloric_acid > 0.0_wp )  THEN
6315          HCL_hhso4 = - 54.845_wp * ( RH**7 ) + 209.54_wp * ( RH**6 ) -        &
6316                        336.59_wp * ( RH**5 ) + 294.21_wp * ( RH**4 ) -        &
6317                        150.07_wp * ( RH**3 ) + 43.767_wp * ( RH**2 ) -        &
6318                        6.5495_wp * RH + 0.60048_wp
6319       ENDIF
6320       
6321       IF ( ammonium_sulphate > 0.0_wp )  THEN
6322          NH42SO4_hhso4 = 16.768_wp * ( RH**3 ) - 28.75_wp * ( RH**2 ) +       &
6323                          20.011_wp * RH - 8.3206_wp
6324       ENDIF
6325       
6326       IF ( ammonium_nitrate > 0.0_wp )  THEN
6327          NH4NO3_hhso4 = - 17.184_wp * ( RH**4 ) + 56.834_wp * ( RH**3 ) -     &
6328                           65.765_wp * ( RH**2 ) + 35.321_wp * RH - 9.252_wp
6329       ENDIF
6330       
6331       IF (ammonium_chloride > 0.0_wp )  THEN
6332          IF ( RH < 0.2_wp .AND. RH >= 0.1_wp )  THEN
6333             NH4Cl_hhso4 = 3.2809_wp * RH - 2.0637_wp
6334          ELSEIF ( RH >= 0.2_wp .AND. RH < 0.99_wp )  THEN
6335             NH4Cl_hhso4 = - 1.2981_wp * ( RH**3 ) + 4.7461_wp * ( RH**2 ) -   &
6336                             2.3269_wp * RH - 1.1259_wp
6337          ENDIF
6338       ENDIF
6339       
6340       IF ( sodium_sulphate > 0.0_wp )  THEN
6341          Na2SO4_hhso4 = 118.87_wp * ( RH**6 ) - 358.63_wp * ( RH**5 ) +       &
6342                         435.85_wp * ( RH**4 ) - 272.88_wp * ( RH**3 ) +       &
6343                         94.411_wp * ( RH**2 ) - 18.21_wp * RH + 0.45935_wp
6344       ENDIF
6345       
6346       IF ( sodium_nitrate > 0.0_wp )  THEN
6347          IF ( RH < 0.2_wp  .AND.  RH >= 0.1_wp )  THEN
6348             NaNO3_hhso4 = 4.8456_wp * RH - 2.5773_wp   
6349          ELSEIF ( RH >= 0.2_wp  .AND.  RH < 0.99_wp )  THEN
6350             NaNO3_hhso4 = 0.5964_wp * ( RH**3 ) - 0.38967_wp * ( RH**2 ) +    &
6351                           1.7918_wp * RH - 1.9691_wp 
6352          ENDIF
6353       ENDIF
6354       
6355       IF ( sodium_chloride > 0.0_wp )  THEN
6356          IF ( RH < 0.2_wp )  THEN
6357             NaCl_hhso4 = 0.51995_wp * RH - 1.3981_wp
6358          ELSEIF ( RH >= 0.2_wp  .AND.  RH < 0.99_wp )  THEN
6359             NaCl_hhso4 = 1.6539_wp * RH - 1.6101_wp
6360          ENDIF
6361       ENDIF
6362       
6363       Ln_hhso4_act = binary_hhso4 +                                           &
6364                      nitric_acid_eq_frac       * HNO3_hhso4 +                 &
6365                      hydrochloric_acid_eq_frac * HCL_hhso4 +                  &
6366                      ammonium_sulphate_eq_frac * NH42SO4_hhso4 +              &
6367                      ammonium_nitrate_eq_frac  * NH4NO3_hhso4 +               &
6368                      ammonium_chloride_eq_frac * NH4Cl_hhso4 +                &
6369                      sodium_sulphate_eq_frac   * Na2SO4_hhso4 +               &
6370                      sodium_nitrate_eq_frac    * NaNO3_hhso4 +                &
6371                      sodium_chloride_eq_frac   * NaCl_hhso4
6372       gamma_hhso4 = EXP( Ln_hhso4_act )   ! molal activity coefficient of HHSO4
6373
6374!--    H2SO4 (sulphuric acid):
6375       IF ( RH >= 0.1_wp  .AND.  RH < 0.9_wp )  THEN
6376          binary_h2so4 = 2.4493_wp * ( RH**2 ) - 6.2326_wp * RH + 2.1763_wp
6377       ELSEIF ( RH >= 0.9_wp  .AND.  RH < 0.98 )  THEN
6378          binary_h2so4 = 914.68_wp * ( RH**3 ) - 2502.3_wp * ( RH**2 ) +       &
6379                         2281.9_wp * RH - 695.11_wp
6380       ELSEIF ( RH >= 0.98  .AND.  RH < 0.9999 )  THEN
6381          binary_h2so4 = 3E-8_wp * ( RH**4 ) - 5E-6_wp * ( RH**3 ) +           &
6382                       0.0003_wp * ( RH**2 ) - 0.0022_wp * RH - 1.1305_wp
6383       ENDIF
6384       
6385       IF ( nitric_acid > 0.0_wp )  THEN
6386          HNO3_h2so4 = - 16.382_wp * ( RH**5 ) + 46.677_wp * ( RH**4 ) -       &
6387                         54.149_wp * ( RH**3 ) + 34.36_wp * ( RH**2 ) -        &
6388                         12.54_wp * RH + 2.1368_wp
6389       ENDIF
6390       
6391       IF ( hydrochloric_acid > 0.0_wp )  THEN
6392          HCL_h2so4 = - 14.409_wp * ( RH**5 ) + 42.804_wp * ( RH**4 ) -        &
6393                         47.24_wp * ( RH**3 ) + 24.668_wp * ( RH**2 ) -        &
6394                        5.8015_wp * RH + 0.084627_wp
6395       ENDIF
6396       
6397       IF ( ammonium_sulphate > 0.0_wp )  THEN
6398          NH42SO4_h2so4 = 66.71_wp * ( RH**5 ) - 187.5_wp * ( RH**4 ) +        &
6399                         210.57_wp * ( RH**3 ) - 121.04_wp * ( RH**2 ) +       &
6400                         39.182_wp * RH - 8.0606_wp
6401       ENDIF
6402       
6403       IF ( ammonium_nitrate > 0.0_wp )  THEN
6404          NH4NO3_h2so4 = - 22.532_wp * ( RH**4 ) + 66.615_wp * ( RH**3 ) -     &
6405                           74.647_wp * ( RH**2 ) + 37.638_wp * RH - 6.9711_wp 
6406       ENDIF
6407       
6408       IF ( ammonium_chloride > 0.0_wp )  THEN
6409          IF ( RH >= 0.1_wp  .AND.  RH < 0.2_wp )  THEN
6410             NH4Cl_h2so4 = - 0.32089_wp * RH + 0.57738_wp
6411          ELSEIF ( RH >= 0.2_wp  .AND.  RH < 0.9_wp )  THEN
6412             NH4Cl_h2so4 = 18.089_wp * ( RH**5 ) - 51.083_wp * ( RH**4 ) +     &
6413                            50.32_wp * ( RH**3 ) - 17.012_wp * ( RH**2 ) -     &
6414                          0.93435_wp * RH + 1.0548_wp
6415          ELSEIF ( RH >= 0.9_wp  .AND.  RH < 0.99_wp )  THEN
6416             NH4Cl_h2so4 = - 1.5749_wp * RH + 1.7002_wp
6417          ENDIF
6418       ENDIF
6419       
6420       IF ( sodium_sulphate > 0.0_wp )  THEN
6421          Na2SO4_h2so4 = 29.843_wp * ( RH**4 ) - 69.417_wp * ( RH**3 ) +       &
6422                         61.507_wp * ( RH**2 ) - 29.874_wp * RH + 7.7556_wp
6423       ENDIF
6424       
6425       IF ( sodium_nitrate > 0.0_wp )  THEN
6426          NaNO3_h2so4 = - 122.37_wp * ( RH**6 ) + 427.43_wp * ( RH**5 ) -      &
6427                          604.68_wp * ( RH**4 ) + 443.08_wp * ( RH**3 ) -      &
6428                          178.61_wp * ( RH**2 ) + 37.242_wp * RH - 1.9564_wp
6429       ENDIF
6430       
6431       IF ( sodium_chloride > 0.0_wp )  THEN
6432          NaCl_h2so4 = - 40.288_wp * ( RH**5 ) + 115.61_wp * ( RH**4 ) -       &
6433                         129.99_wp * ( RH**3 ) + 72.652_wp * ( RH**2 ) -       &
6434                         22.124_wp * RH + 4.2676_wp
6435       ENDIF
6436       
6437       Ln_h2so4_act = binary_h2so4 +                                           &
6438                      nitric_acid_eq_frac       * HNO3_h2so4 +                 &
6439                      hydrochloric_acid_eq_frac * HCL_h2so4 +                  &
6440                      ammonium_sulphate_eq_frac * NH42SO4_h2so4 +              &
6441                      ammonium_nitrate_eq_frac  * NH4NO3_h2so4 +               &
6442                      ammonium_chloride_eq_frac * NH4Cl_h2so4 +                &
6443                      sodium_sulphate_eq_frac   * Na2SO4_h2so4 +               &
6444                      sodium_nitrate_eq_frac    * NaNO3_h2so4 +                &
6445                      sodium_chloride_eq_frac   * NaCl_h2so4                     
6446
6447       gamma_h2so4 = EXP( Ln_h2so4_act )    ! molal activity coefficient
6448!         
6449!--    Export activity coefficients
6450       IF ( gamma_h2so4 > 1.0E-10_wp )  THEN
6451          gamma_out(4) = ( gamma_hhso4**2.0_wp ) / gamma_h2so4
6452       ENDIF
6453       IF ( gamma_hhso4 > 1.0E-10_wp )  THEN
6454          gamma_out(5) = ( gamma_h2so4**3.0_wp ) / ( gamma_hhso4**2.0_wp )
6455       ENDIF
6456!
6457!--    Ionic activity coefficient product
6458       act_product = ( gamma_h2so4**3.0_wp ) / ( gamma_hhso4**2.0_wp )
6459!
6460!--    Solve the quadratic equation (i.e. x in ax**2 + bx + c = 0)
6461       a = 1.0_wp
6462       b = - 1.0_wp * ( ions(4) + ions(1) + ( ( water_total * 18.0E-3_wp ) /   &
6463          ( 99.0_wp * act_product ) ) )
6464       c = ions(4) * ions(1)
6465       root1 = ( ( -1.0_wp * b ) + ( ( ( b**2 ) - 4.0_wp * a * c )**0.5_wp     &
6466               ) ) / ( 2 * a )
6467       root2 = ( ( -1.0_wp * b ) - ( ( ( b**2 ) - 4.0_wp * a * c) **0.5_wp     &
6468               ) ) / ( 2 * a )
6469
6470       IF ( root1 > ions(1)  .OR.  root1 < 0.0_wp )  THEN
6471          root1 = 0.0_wp
6472       ENDIF
6473
6474       IF ( root2 > ions(1)  .OR.  root2 < 0.0_wp )  THEN
6475          root2 = 0.0_wp
6476       ENDIF
6477!         
6478!--    Calculate the new hydrogen ion, bisulphate ion and sulphate ion
6479!--    concentration
6480       hso4_real = 0.0_wp
6481       h_real    = ions(1)
6482       so4_real  = ions(4)
6483       IF ( root1 == 0.0_wp )  THEN
6484          hso4_real = root2
6485       ELSEIF ( root2 == 0.0_wp )  THEN
6486          hso4_real = root1
6487       ENDIF
6488       h_real   = ions(1) - hso4_real
6489       so4_real = ions(4) - hso4_real
6490!
6491!--    Recalculate ion molalities
6492       ions_mol(1) = h_real    / ( water_total * 18.01528E-3_wp )   ! H+
6493       ions_mol(4) = so4_real  / ( water_total * 18.01528E-3_wp )   ! SO4(2-)
6494       ions_mol(5) = hso4_real / ( water_total * 18.01528E-3_wp )   ! HSO4(2-)
6495
6496       h_out    = h_real
6497       hso4_out = hso4_real
6498       so4_out  = so4_real
6499       
6500    ELSEIF ( ions(1) == 0.0_wp  .OR.  ions(4) == 0.0_wp )  THEN
6501       h_out    = ions(1)
6502       hso4_out = 0.0_wp
6503       so4_out  = ions(4)
6504    ENDIF
6505
6506!
6507!-- 4) ACTIVITY COEFFICIENTS -for vapour pressures of HNO3,HCL and NH3
6508!
6509!-- This section evaluates activity coefficients and vapour pressures using the
6510!-- water content calculated above) for each inorganic condensing species:
6511!-- a - HNO3, b - NH3, c - HCL.
6512!-- The following procedure is used:
6513!-- Zaveri et al (2005) found that one could express the variation of activity
6514!-- coefficients linearly in log-space if equivalent mole fractions were used.
6515!-- So, by a taylor series expansion LOG( activity coefficient ) =
6516!--    LOG( binary activity coefficient at a given RH ) +
6517!--    (equivalent mole fraction compound A) *
6518!--    ('interaction' parameter between A and condensing species) +
6519!--    equivalent mole fraction compound B) *
6520!--    ('interaction' parameter between B and condensing species).
6521!-- Here, the interaction parameters have been fit to ADDEM by searching the
6522!-- whole compositon space and fit usign the Levenberg-Marquardt non-linear
6523!-- least squares algorithm.
6524!
6525!-- They are given as a function of RH and vary with complexity ranging from
6526!-- linear to 5th order polynomial expressions, the binary activity coefficients
6527!-- were calculated using AIM online.
6528!-- NOTE: for NH3, no binary activity coefficient was used and the data were fit
6529!-- to the ratio of the activity coefficients for the ammonium and hydrogen
6530!-- ions. Once the activity coefficients are obtained the vapour pressure can be
6531!-- easily calculated using tabulated equilibrium constants (referenced). This
6532!-- procedure differs from that of Zaveri et al (2005) in that it is not assumed
6533!-- one can carry behaviour from binary mixtures in multicomponent systems. To
6534!-- this end we have fit the 'interaction' parameters explicitly to a general
6535!-- inorganic equilibrium model (ADDEM - Topping et al. 2005a,b). Such
6536!-- parameters take into account bisulphate ion dissociation and water content.
6537!-- This also allows us to consider one regime for all composition space, rather
6538!-- than defining sulphate rich and sulphate poor regimes
6539!-- NOTE: The flags "binary_case" and "full_complexity" are not used in this
6540!-- prototype. They are used for simplification of the fit expressions when
6541!-- using limited composition regions.
6542!
6543!-- a) - ACTIVITY COEFF/VAPOUR PRESSURE - HNO3
6544    IF ( ions(1) > 0.0_wp  .AND.  ions(6) > 0.0_wp )  THEN
6545       binary_case = 1
6546       IF ( RH > 0.1_wp  .AND.  RH < 0.98_wp )  THEN
6547          IF ( binary_case == 1 )  THEN
6548             binary_hno3 = 1.8514_wp * ( RH**3 ) - 4.6991_wp * ( RH**2 ) +     &
6549                           1.5514_wp * RH + 0.90236_wp
6550          ELSEIF ( binary_case == 2 )  THEN
6551             binary_hno3 = - 1.1751_wp * ( RH**2 ) - 0.53794_wp * RH +         &
6552                             1.2808_wp
6553          ENDIF
6554       ELSEIF ( RH >= 0.98_wp  .AND.  RH < 0.9999_wp )  THEN
6555          binary_hno3 = 1244.69635941351_wp * ( RH**3 ) -                      &
6556                        2613.93941099991_wp * ( RH**2 ) +                      &
6557                        1525.0684974546_wp * RH -155.946764059316_wp
6558       ENDIF
6559!         
6560!--    Contributions from other solutes
6561       full_complexity = 1
6562       IF ( hydrochloric_acid > 0.0_wp )  THEN   ! HCL
6563          IF ( full_complexity == 1  .OR.  RH < 0.4_wp )  THEN
6564             HCL_hno3 = 16.051_wp * ( RH**4 ) - 44.357_wp * ( RH**3 ) +        &
6565                        45.141_wp * ( RH**2 ) - 21.638_wp * RH + 4.8182_wp
6566          ELSEIF ( full_complexity == 0  .AND.  RH > 0.4_wp )  THEN
6567             HCL_hno3 = - 1.5833_wp * RH + 1.5569_wp
6568          ENDIF
6569       ENDIF
6570       
6571       IF ( sulphuric_acid > 0.0_wp )  THEN   ! H2SO4
6572          IF ( full_complexity == 1  .OR.  RH < 0.4_wp )  THEN
6573             H2SO4_hno3 = - 3.0849_wp * ( RH**3 ) + 5.9609_wp * ( RH**2 ) -    &
6574                             4.468_wp * RH + 1.5658_wp
6575          ELSEIF ( full_complexity == 0  .AND.  RH > 0.4_wp )  THEN
6576             H2SO4_hno3 = - 0.93473_wp * RH + 0.9363_wp
6577          ENDIF
6578       ENDIF
6579       
6580       IF ( ammonium_sulphate > 0.0_wp )  THEN   ! NH42SO4
6581          NH42SO4_hno3 = 16.821_wp * ( RH**3 ) - 28.391_wp * ( RH**2 ) +       &
6582                         18.133_wp * RH - 6.7356_wp
6583       ENDIF
6584       
6585       IF ( ammonium_nitrate > 0.0_wp )  THEN   ! NH4NO3
6586          NH4NO3_hno3 = 11.01_wp * ( RH**3 ) - 21.578_wp * ( RH**2 ) +         &
6587                       14.808_wp * RH - 4.2593_wp
6588       ENDIF
6589       
6590       IF ( ammonium_chloride > 0.0_wp )  THEN   ! NH4Cl
6591          IF ( full_complexity == 1  .OR.  RH <= 0.4_wp )  THEN
6592             NH4Cl_hno3 = - 1.176_wp * ( RH**3 ) + 5.0828_wp * ( RH**2 ) -     &
6593                           3.8792_wp * RH - 0.05518_wp
6594          ELSEIF ( full_complexity == 0  .AND.  RH > 0.4_wp )  THEN
6595             NH4Cl_hno3 = 2.6219_wp * ( RH**2 ) - 2.2609_wp * RH - 0.38436_wp
6596          ENDIF
6597       ENDIF
6598       
6599       IF ( sodium_sulphate > 0.0_wp )  THEN   ! Na2SO4
6600          Na2SO4_hno3 = 35.504_wp * ( RH**4 ) - 80.101_wp * ( RH**3 ) +        &
6601                        67.326_wp * ( RH**2 ) - 28.461_wp * RH + 5.6016_wp
6602       ENDIF
6603       
6604       IF ( sodium_nitrate > 0.0_wp )  THEN   ! NaNO3
6605          IF ( full_complexity == 1 .OR. RH <= 0.4_wp ) THEN
6606             NaNO3_hno3 = 23.659_wp * ( RH**5 ) - 66.917_wp * ( RH**4 ) +      &
6607                          74.686_wp * ( RH**3 ) - 40.795_wp * ( RH**2 ) +      &
6608                          10.831_wp * RH - 1.4701_wp
6609          ELSEIF ( full_complexity == 0  .AND.  RH > 0.4_wp )  THEN
6610             NaNO3_hno3 = 14.749_wp * ( RH**4 ) - 35.237_wp * ( RH**3 ) +      &
6611                          31.196_wp * ( RH**2 ) - 12.076_wp * RH + 1.3605_wp
6612          ENDIF
6613       ENDIF
6614       
6615       IF ( sodium_chloride > 0.0_wp )  THEN   ! NaCl
6616          IF ( full_complexity == 1  .OR.  RH <= 0.4_wp )  THEN
6617             NaCl_hno3 = 13.682_wp * ( RH**4 ) - 35.122_wp * ( RH**3 ) +       &
6618                         33.397_wp * ( RH**2 ) - 14.586_wp * RH + 2.6276_wp
6619          ELSEIF ( full_complexity == 0  .AND.  RH > 0.4_wp )  THEN
6620             NaCl_hno3 = 1.1882_wp * ( RH**3 ) - 1.1037_wp * ( RH**2 ) -       &
6621                         0.7642_wp * RH + 0.6671_wp
6622          ENDIF
6623       ENDIF
6624       
6625       Ln_HNO3_act = binary_hno3 +                                             &
6626                     hydrochloric_acid_eq_frac * HCL_hno3 +                    &
6627                     sulphuric_acid_eq_frac    * H2SO4_hno3 +                  &
6628                     ammonium_sulphate_eq_frac * NH42SO4_hno3 +                &
6629                     ammonium_nitrate_eq_frac  * NH4NO3_hno3 +                 &
6630                     ammonium_chloride_eq_frac * NH4Cl_hno3 +                  &
6631                     sodium_sulphate_eq_frac   * Na2SO4_hno3 +                 &
6632                     sodium_nitrate_eq_frac    * NaNO3_hno3 +                  &
6633                     sodium_chloride_eq_frac   * NaCl_hno3
6634
6635       gamma_hno3   = EXP( Ln_HNO3_act )   ! Molal activity coefficient of HNO3
6636       gamma_out(1) = gamma_hno3
6637!
6638!--    Partial pressure calculation
6639!--    K_hno3 = 2.51 * ( 10**6 ) 
6640!--    K_hno3 = 2.628145923d6 !< calculated by AIM online (Clegg et al 1998)
6641!--    after Chameides (1984) (and NIST database)
6642       K_hno3     = 2.6E6_wp * EXP( 8700.0_wp * henrys_temp_dep) 
6643       Press_HNO3 = ( ions_mol(1) * ions_mol(6) * ( gamma_hno3**2 ) ) /        &
6644                      K_hno3
6645    ENDIF
6646!       
6647!-- b) - ACTIVITY COEFF/VAPOUR PRESSURE - NH3
6648!-- Follow the two solute approach of Zaveri et al. (2005)
6649    IF ( ions(2) > 0.0_wp  .AND.  ions_mol(1) > 0.0_wp )  THEN 
6650!--    NH4HSO4:
6651       binary_nh4hso4 = 56.907_wp * ( RH**6 ) - 155.32_wp * ( RH**5 ) +        &
6652                        142.94_wp * ( RH**4 ) - 32.298_wp * ( RH**3 ) -        &
6653                        27.936_wp * ( RH**2 ) + 19.502_wp * RH - 4.2618_wp
6654       IF ( nitric_acid > 0.0_wp)  THEN   ! HNO3
6655          HNO3_nh4hso4 = 104.8369_wp * ( RH**8 ) - 288.8923_wp * ( RH**7 ) +   &
6656                         129.3445_wp * ( RH**6 ) + 373.0471_wp * ( RH**5 ) -   &
6657                         571.0385_wp * ( RH**4 ) + 326.3528_wp * ( RH**3 ) -   &
6658                           74.169_wp * ( RH**2 ) - 2.4999_wp * RH + 3.17_wp
6659       ENDIF
6660       
6661       IF ( hydrochloric_acid > 0.0_wp)  THEN   ! HCL
6662          HCL_nh4hso4 = - 7.9133_wp * ( RH**8 ) + 126.6648_wp * ( RH**7 ) -    &
6663                        460.7425_wp * ( RH**6 ) + 731.606_wp  * ( RH**5 ) -    &
6664                        582.7467_wp * ( RH**4 ) + 216.7197_wp * ( RH**3 ) -   &
6665                         11.3934_wp * ( RH**2 ) - 17.7728_wp  * RH + 5.75_wp
6666       ENDIF
6667       
6668       IF ( sulphuric_acid > 0.0_wp)  THEN   ! H2SO4
6669          H2SO4_nh4hso4 = 195.981_wp * ( RH**8 ) - 779.2067_wp * ( RH**7 ) +   &
6670                        1226.3647_wp * ( RH**6 ) - 964.0261_wp * ( RH**5 ) +   &
6671                         391.7911_wp * ( RH**4 ) - 84.1409_wp  * ( RH**3 ) +   &
6672                          20.0602_wp * ( RH**2 ) - 10.2663_wp  * RH + 3.5817_wp
6673       ENDIF
6674       
6675       IF ( ammonium_sulphate > 0.0_wp)  THEN   ! NH42SO4
6676          NH42SO4_nh4hso4 = 617.777_wp * ( RH**8 ) - 2547.427_wp * ( RH**7 )   &
6677                        + 4361.6009_wp * ( RH**6 ) - 4003.162_wp * ( RH**5 )   &
6678                        + 2117.8281_wp * ( RH**4 ) - 640.0678_wp * ( RH**3 )   &
6679                        + 98.0902_wp   * ( RH**2 ) - 2.2615_wp  * RH - 2.3811_wp
6680       ENDIF
6681       
6682       IF ( ammonium_nitrate > 0.0_wp)  THEN   ! NH4NO3
6683          NH4NO3_nh4hso4 = - 104.4504_wp * ( RH**8 ) + 539.5921_wp *           &
6684                ( RH**7 ) - 1157.0498_wp * ( RH**6 ) + 1322.4507_wp *          &
6685                ( RH**5 ) - 852.2475_wp * ( RH**4 ) + 298.3734_wp *            &
6686                ( RH**3 ) - 47.0309_wp * ( RH**2 ) + 1.297_wp * RH -           &
6687                0.8029_wp
6688       ENDIF
6689       
6690       IF ( ammonium_chloride > 0.0_wp)  THEN   ! NH4Cl
6691          NH4Cl_nh4hso4 = 258.1792_wp * ( RH**8 ) - 1019.3777_wp *             &
6692             ( RH**7 ) + 1592.8918_wp * ( RH**6 ) - 1221.0726_wp *             &
6693             ( RH**5 ) + 442.2548_wp * ( RH**4 ) - 43.6278_wp *                &
6694             ( RH**3 ) - 7.5282_wp * ( RH**2 ) - 3.8459_wp * RH + 2.2728_wp
6695       ENDIF
6696       
6697       IF ( sodium_sulphate > 0.0_wp)  THEN   ! Na2SO4
6698          Na2SO4_nh4hso4 = 225.4238_wp * ( RH**8 ) - 732.4113_wp *             &
6699               ( RH**7 ) + 843.7291_wp * ( RH**6 ) - 322.7328_wp *             &
6700               ( RH**5 ) - 88.6252_wp * ( RH**4 ) + 72.4434_wp *               &
6701               ( RH**3 ) + 22.9252_wp * ( RH**2 ) - 25.3954_wp * RH +          &
6702               4.6971_wp
6703       ENDIF
6704       
6705       IF ( sodium_nitrate > 0.0_wp)  THEN   ! NaNO3
6706          NaNO3_nh4hso4 = 96.1348_wp * ( RH**8 ) - 341.6738_wp * ( RH**7 ) +   &
6707                         406.5314_wp * ( RH**6 ) - 98.5777_wp * ( RH**5 ) -    &
6708                         172.8286_wp * ( RH**4 ) + 149.3151_wp * ( RH**3 ) -   &
6709                          38.9998_wp * ( RH**2 ) - 0.2251 * RH + 0.4953_wp
6710       ENDIF
6711       
6712       IF ( sodium_chloride > 0.0_wp)  THEN   ! NaCl
6713          NaCl_nh4hso4 = 91.7856_wp * ( RH**8 ) - 316.6773_wp * ( RH**7 ) +    &
6714                        358.2703_wp * ( RH**6 ) - 68.9142 * ( RH**5 ) -        &
6715                        156.5031_wp * ( RH**4 ) + 116.9592_wp * ( RH**3 ) -    &
6716                        22.5271_wp * ( RH**2 ) - 3.7716_wp * RH + 1.56_wp
6717       ENDIF
6718
6719       Ln_NH4HSO4_act = binary_nh4hso4 +                                       &
6720                        nitric_acid_eq_frac       * HNO3_nh4hso4 +             &
6721                        hydrochloric_acid_eq_frac * HCL_nh4hso4 +              &
6722                        sulphuric_acid_eq_frac    * H2SO4_nh4hso4 +            & 
6723                        ammonium_sulphate_eq_frac * NH42SO4_nh4hso4 +          &
6724                        ammonium_nitrate_eq_frac  * NH4NO3_nh4hso4 +           &
6725                        ammonium_chloride_eq_frac * NH4Cl_nh4hso4 +            &
6726                        sodium_sulphate_eq_frac   * Na2SO4_nh4hso4 +           & 
6727                        sodium_nitrate_eq_frac    * NaNO3_nh4hso4 +            &
6728                        sodium_chloride_eq_frac   * NaCl_nh4hso4
6729 
6730       gamma_nh4hso4 = EXP( Ln_NH4HSO4_act ) ! molal act. coefficient of NH4HSO4
6731!--    Molal activity coefficient of NO3-
6732       gamma_out(6)  = gamma_nh4hso4
6733!--    Molal activity coefficient of NH4+       
6734       gamma_nh3     = ( gamma_nh4hso4**2 ) / ( gamma_hhso4**2 )   
6735       gamma_out(3)  = gamma_nh3
6736!       
6737!--    This actually represents the ratio of the ammonium to hydrogen ion
6738!--    activity coefficients (see Zaveri paper) - multiply this by the ratio
6739!--    of the ammonium to hydrogen ion molality and the ratio of appropriate
6740!--    equilibrium constants
6741!
6742!--    Equilibrium constants
6743!--    Kh = 57.64d0    ! Zaveri et al. (2005)
6744       Kh = 5.8E1_wp * EXP( 4085.0_wp * henrys_temp_dep )   ! after Chameides
6745!                                                   ! (1984) (and NIST database)
6746!--    Knh4 = 1.81E-5_wp    ! Zaveri et al. (2005)
6747       Knh4 = 1.7E-5_wp * EXP( -4325.0_wp * henrys_temp_dep )   ! Chameides
6748                                                                ! (1984)
6749!--    Kw = 1.01E-14_wp    ! Zaveri et al (2005)
6750       Kw = 1.E-14_wp * EXP( -6716.0_wp * henrys_temp_dep )   ! Chameides
6751                                                              ! (1984)
6752!
6753       molality_ratio_nh3 = ions_mol(2) / ions_mol(1)
6754!--    Partial pressure calculation       
6755       Press_NH3 = molality_ratio_nh3 * gamma_nh3 * ( Kw / ( Kh * Knh4 ) )
6756   
6757    ENDIF
6758!       
6759!-- c) - ACTIVITY COEFF/VAPOUR PRESSURE - HCL
6760    IF ( ions(1) > 0.0_wp  .AND.  ions(7) > 0.0_wp )  THEN
6761       binary_case = 1
6762       IF ( RH > 0.1_wp  .AND.  RH < 0.98 )  THEN
6763          IF ( binary_case == 1 )  THEN
6764             binary_hcl = - 5.0179_wp * ( RH**3 ) + 9.8816_wp * ( RH**2 ) -    &
6765                            10.789_wp * RH + 5.4737_wp
6766          ELSEIF ( binary_case == 2 )  THEN
6767             binary_hcl = - 4.6221_wp * RH + 4.2633_wp
6768          ENDIF
6769       ELSEIF ( RH >= 0.98_wp  .AND.  RH < 0.9999_wp )  THEN
6770          binary_hcl = 775.6111008626_wp * ( RH**3 ) - 2146.01320888771_wp *   &
6771                     ( RH**2 ) + 1969.01979670259_wp *  RH - 598.878230033926_wp
6772       ENDIF
6773    ENDIF
6774   
6775    IF ( nitric_acid > 0.0_wp )  THEN   ! HNO3
6776       IF ( full_complexity == 1  .OR.  RH <= 0.4_wp )  THEN
6777          HNO3_hcl = 9.6256_wp * ( RH**4 ) - 26.507_wp * ( RH**3 ) +           &
6778                     27.622_wp * ( RH**2 ) - 12.958_wp * RH + 2.2193_wp
6779       ELSEIF ( full_complexity == 0  .AND.  RH > 0.4_wp )  THEN
6780          HNO3_hcl = 1.3242_wp * ( RH**2 ) - 1.8827_wp * RH + 0.55706_wp
6781       ENDIF
6782    ENDIF
6783   
6784    IF ( sulphuric_acid > 0.0_wp )  THEN   ! H2SO4
6785       IF ( full_complexity == 1  .OR.  RH <= 0.4 )  THEN
6786          H2SO4_hcl = 1.4406_wp * ( RH**3 ) - 2.7132_wp * ( RH**2 ) +          &
6787                       1.014_wp * RH + 0.25226_wp
6788       ELSEIF ( full_complexity == 0 .AND. RH > 0.4_wp ) THEN
6789          H2SO4_hcl = 0.30993_wp * ( RH**2 ) - 0.99171_wp * RH + 0.66913_wp
6790       ENDIF
6791    ENDIF
6792   
6793    IF ( ammonium_sulphate > 0.0_wp )  THEN   ! NH42SO4
6794       NH42SO4_hcl = 22.071_wp * ( RH**3 ) - 40.678_wp * ( RH**2 ) +           &
6795                     27.893_wp * RH - 9.4338_wp
6796    ENDIF
6797   
6798    IF ( ammonium_nitrate > 0.0_wp )  THEN   ! NH4NO3
6799       NH4NO3_hcl = 19.935_wp * ( RH**3 ) - 42.335_wp * ( RH**2 ) +            &
6800                    31.275_wp * RH - 8.8675_wp
6801    ENDIF
6802   
6803    IF ( ammonium_chloride > 0.0_wp )  THEN   ! NH4Cl
6804       IF ( full_complexity == 1  .OR.  RH <= 0.4_wp )  THEN
6805          NH4Cl_hcl = 2.8048_wp * ( RH**3 ) - 4.3182_wp * ( RH**2 ) +          &
6806                      3.1971_wp * RH - 1.6824_wp
6807       ELSEIF ( full_complexity == 0  .AND.  RH > 0.4_wp )  THEN
6808          NH4Cl_hcl = 1.2304_wp * ( RH**2 ) - 0.18262_wp * RH - 1.0643_wp
6809       ENDIF
6810    ENDIF
6811   
6812    IF ( sodium_sulphate > 0.0_wp )  THEN   ! Na2SO4
6813       Na2SO4_hcl = 36.104_wp * ( RH**4 ) - 78.658_wp * ( RH**3 ) +            &
6814                    63.441_wp * ( RH**2 ) - 26.727_wp * RH + 5.7007_wp
6815    ENDIF
6816   
6817    IF ( sodium_nitrate > 0.0_wp )  THEN   ! NaNO3
6818       IF ( full_complexity == 1  .OR.  RH <= 0.4_wp )  THEN
6819          NaNO3_hcl = 54.471_wp * ( RH**5 ) - 159.42_wp * ( RH**4 ) +          &
6820                      180.25_wp * ( RH**3 ) - 98.176_wp * ( RH**2 ) +          &
6821                      25.309_wp * RH - 2.4275_wp
6822       ELSEIF ( full_complexity == 0  .AND.  RH > 0.4_wp )  THEN
6823          NaNO3_hcl = 21.632_wp * ( RH**4 ) - 53.088_wp * ( RH**3 ) +          &
6824                      47.285_wp * ( RH**2 ) - 18.519_wp * RH + 2.6846_wp
6825       ENDIF
6826    ENDIF
6827   
6828    IF ( sodium_chloride > 0.0_wp )  THEN   ! NaCl
6829       IF ( full_complexity == 1  .OR.  RH <= 0.4_wp )  THEN
6830          NaCl_hcl = 5.4138_wp * ( RH**4 ) - 12.079_wp * ( RH**3 ) +           &
6831                      9.627_wp * ( RH**2 ) - 3.3164_wp * RH + 0.35224_wp
6832       ELSEIF ( full_complexity == 0  .AND.  RH > 0.4_wp )  THEN
6833          NaCl_hcl = 2.432_wp * ( RH**3 ) - 4.3453_wp * ( RH**2 ) +            &
6834                    2.3834_wp * RH - 0.4762_wp
6835       ENDIF
6836    ENDIF
6837             
6838    Ln_HCL_act = binary_hcl +                                                  &
6839                 nitric_acid_eq_frac       * HNO3_hcl +                        &
6840                 sulphuric_acid_eq_frac    * H2SO4_hcl +                       &
6841                 ammonium_sulphate_eq_frac * NH42SO4_hcl +                     &
6842                 ammonium_nitrate_eq_frac  * NH4NO3_hcl +                      &
6843                 ammonium_chloride_eq_frac * NH4Cl_hcl +                       &
6844                 sodium_sulphate_eq_frac   * Na2SO4_hcl +                      &
6845                 sodium_nitrate_eq_frac    * NaNO3_hcl +                       &
6846                 sodium_chloride_eq_frac   * NaCl_hcl
6847
6848     gamma_hcl    = EXP( Ln_HCL_act )   ! Molal activity coefficient
6849     gamma_out(2) = gamma_hcl
6850!     
6851!--  Equilibrium constant after Wagman et al. (1982) (and NIST database)
6852     K_hcl = 2E6_wp * EXP( 9000.0_wp * henrys_temp_dep )   
6853                                                   
6854     Press_HCL = ( ions_mol(1) * ions_mol(7) * ( gamma_hcl**2 ) ) / K_hcl
6855!
6856!-- 5) Ion molility output
6857    mols_out = ions_mol
6858!
6859!-- REFERENCES
6860!-- Clegg et al. (1998) A Thermodynamic Model of the System
6861!--    H+-NH4+-Na+-SO42- -NO3--Cl--H2O at 298.15 K, J. Phys. Chem., 102A,     
6862!--    2155-2171.
6863!-- Clegg et al. (2001) Thermodynamic modelling of aqueous aerosols containing
6864!--    electrolytes and dissolved organic compounds. Journal of Aerosol Science
6865!--    2001;32(6):713-738.
6866!-- Topping et al. (2005a) A curved multi-component aerosol hygroscopicity model
6867!--    framework: Part 1 - Inorganic compounds. Atmospheric Chemistry and
6868!--    Physics 2005;5:1205-1222.
6869!-- Topping et al. (2005b) A curved multi-component aerosol hygroscopicity model
6870!--    framework: Part 2 - Including organic compounds. Atmospheric Chemistry
6871!--    and Physics 2005;5:1223-1242.
6872!-- Wagman et al. (1982). The NBS tables of chemical thermodynamic properties:
6873!--    selected values for inorganic and C₁ and C₂ organic substances in SI
6874!--    units (book)
6875!-- Zaveri et al. (2005). A new method for multicomponent activity coefficients
6876!--    of electrolytes in aqueous atmospheric aerosols, JGR, 110, D02201, 2005.
6877 END SUBROUTINE inorganic_pdfite
6878 
6879!------------------------------------------------------------------------------!
6880! Description:
6881! ------------
6882!> Update the particle size distribution. Put particles into corrects bins.
6883!>
6884!> Moving-centre method assumed, i.e. particles are allowed to grow to their
6885!> exact size as long as they are not crossing the fixed diameter bin limits.
6886!> If the particles in a size bin cross the lower or upper diameter limit, they
6887!> are all moved to the adjacent diameter bin and their volume is averaged with
6888!> the particles in the new bin, which then get a new diameter.
6889!
6890!> Moving-centre method minimises numerical diffusion.
6891!------------------------------------------------------------------------------!     
6892 SUBROUTINE distr_update( paero )
6893   
6894    IMPLICIT NONE
6895
6896!-- Input and output variables
6897    TYPE(t_section), INTENT(inout) ::  paero(fn2b) !< Aerosols particle
6898                                    !< size distribution and properties
6899!-- Local variables
6900    INTEGER(iwp) ::  b !< loop index
6901    INTEGER(iwp) ::  mm !< loop index
6902    INTEGER(iwp) ::  counti
6903    LOGICAL  ::  within_bins !< logical (particle belongs to the bin?)   
6904    REAL(wp) ::  znfrac !< number fraction to be moved to the larger bin
6905    REAL(wp) ::  zvfrac !< volume fraction to be moved to the larger bin
6906    REAL(wp) ::  zVexc  !< Volume in the grown bin which exceeds the bin
6907                        !< upper limit   
6908    REAL(wp) ::  zVihi  !< particle volume at the high end of the bin   
6909    REAL(wp) ::  zVilo  !< particle volume at the low end of the bin     
6910    REAL(wp) ::  zvpart !< particle volume (m3)   
6911    REAL(wp) ::  zVrat  !< volume ratio of a size bin
6912   
6913    zvpart = 0.0_wp
6914    zvfrac = 0.0_wp
6915
6916    within_bins = .FALSE.
6917   
6918!
6919!-- Check if the volume of the bin is within bin limits after update
6920    counti = 0
6921    DO  WHILE ( .NOT. within_bins )
6922       within_bins = .TRUE.
6923
6924       DO  b = fn2b-1, in1a, -1
6925          mm = 0
6926          IF ( paero(b)%numc > nclim )  THEN
6927
6928             zvpart = 0.0_wp
6929             zvfrac = 0.0_wp
6930
6931             IF ( b == fn2a )  CYCLE 
6932!
6933!--          Dry volume
6934             zvpart = SUM( paero(b)%volc(1:7) ) / paero(b)%numc 
6935!
6936!--          Smallest bin cannot decrease
6937             IF ( paero(b)%vlolim > zvpart  .AND.  b == in1a ) CYCLE
6938!
6939!--          Decreasing bins
6940             IF ( paero(b)%vlolim > zvpart )  THEN
6941                mm = b - 1
6942                IF ( b == in2b )  mm = fn1a    ! 2b goes to 1a
6943               
6944                paero(mm)%numc = paero(mm)%numc + paero(b)%numc
6945                paero(b)%numc = 0.0_wp
6946                paero(mm)%volc(:) = paero(mm)%volc(:) + paero(b)%volc(:) 
6947                paero(b)%volc(:) = 0.0_wp
6948                CYCLE
6949             ENDIF
6950!
6951!--          If size bin has not grown, cycle
6952!--          Changed by Mona: compare to the arithmetic mean volume, as done
6953!--          originally. Now particle volume is derived from the geometric mean
6954!--          diameter, not arithmetic (see SUBROUTINE set_sizebins).
6955             IF ( zvpart <= api6 * ( ( aero(b)%vhilim + aero(b)%vlolim ) /     &
6956                  ( 2.0_wp * api6 ) ) )  CYCLE 
6957             IF ( ABS( zvpart - api6 * paero(b)%dmid ** 3.0_wp ) < &
6958                  1.0E-35_wp )  CYCLE  ! Mona: to avoid precision problems
6959!                   
6960!--          Volume ratio of the size bin
6961             zVrat = paero(b)%vhilim / paero(b)%vlolim
6962!--          Particle volume at the low end of the bin
6963             zVilo = 2.0_wp * zvpart / ( 1.0_wp + zVrat )
6964!--          Particle volume at the high end of the bin
6965             zVihi = zVrat * zVilo
6966!--          Volume in the grown bin which exceeds the bin upper limit
6967             zVexc = 0.5_wp * ( zVihi + paero(b)%vhilim )
6968!--          Number fraction to be moved to the larger bin
6969             znfrac = MIN( 1.0_wp, ( zVihi - paero(b)%vhilim) /                &
6970                           ( zVihi - zVilo ) )
6971!--          Volume fraction to be moved to the larger bin
6972             zvfrac = MIN( 0.99_wp, znfrac * zVexc / zvpart )
6973             IF ( zvfrac < 0.0_wp )  THEN
6974                message_string = 'Error: zvfrac < 0'
6975                CALL message( 'salsa_mod: distr_update', 'SA0050',             &
6976                              1, 2, 0, 6, 0 )
6977             ENDIF
6978!
6979!--          Update bin
6980             mm = b + 1
6981!--          Volume (cm3/cm3)
6982             paero(mm)%volc(:) = paero(mm)%volc(:) + znfrac * paero(b)%numc *  &
6983                                 zVexc * paero(b)%volc(:) /                    &
6984                                 SUM( paero(b)%volc(1:7) )
6985             paero(b)%volc(:) = paero(b)%volc(:) - znfrac * paero(b)%numc *    &
6986                                 zVexc * paero(b)%volc(:) /                    &
6987                                 SUM( paero(b)%volc(1:7) )
6988
6989!--          Number concentration (#/m3)
6990             paero(mm)%numc = paero(mm)%numc + znfrac * paero(b)%numc
6991             paero(b)%numc = paero(b)%numc * ( 1.0_wp - znfrac )
6992
6993          ENDIF     ! nclim
6994         
6995          IF ( paero(b)%numc > nclim )   THEN
6996             zvpart = SUM( paero(b)%volc(1:7) ) / paero(b)%numc 
6997             within_bins = ( paero(b)%vlolim < zvpart  .AND.                  &
6998                             zvpart < paero(b)%vhilim )
6999          ENDIF
7000
7001       ENDDO ! - b
7002
7003       counti = counti + 1
7004       IF ( counti > 100 )  THEN
7005          message_string = 'Error: Aerosol bin update not converged'
7006          CALL message( 'salsa_mod: distr_update', 'SA0051', 1, 2, 0, 6, 0 )
7007       ENDIF
7008
7009    ENDDO ! - within bins
7010   
7011 END SUBROUTINE distr_update
7012     
7013!------------------------------------------------------------------------------!
7014! Description:
7015! ------------
7016!> salsa_diagnostics: Update properties for the current timestep:
7017!>
7018!> Juha Tonttila, FMI, 2014
7019!> Tomi Raatikainen, FMI, 2016
7020!------------------------------------------------------------------------------!
7021 SUBROUTINE salsa_diagnostics( i, j )
7022 
7023    USE arrays_3d,                                                             &
7024        ONLY:  p, pt, zu
7025       
7026    USE basic_constants_and_equations_mod,                                     &
7027        ONLY: g
7028   
7029    USE control_parameters,                                                    &
7030        ONLY:  pt_surface, surface_pressure
7031       
7032    USE cpulog,                                                                &
7033        ONLY:  cpu_log, log_point_s
7034
7035    IMPLICIT NONE
7036   
7037    INTEGER(iwp), INTENT(in) ::  i  !<
7038    INTEGER(iwp), INTENT(in) ::  j  !<   
7039
7040    INTEGER(iwp) ::  b !<
7041    INTEGER(iwp) ::  c  !<
7042    INTEGER(iwp) ::  gt  !<
7043    INTEGER(iwp) ::  k  !<
7044    INTEGER(iwp) ::  nc !<
7045    REAL(wp), DIMENSION(nzb:nzt+1) ::  flag         !< flag to mask topography
7046    REAL(wp), DIMENSION(nzb:nzt+1) ::  flag_zddry   !< flag to mask zddry
7047    REAL(wp), DIMENSION(nzb:nzt+1) ::  in_adn       !< air density (kg/m3)   
7048    REAL(wp), DIMENSION(nzb:nzt+1) ::  in_p         !< pressure
7049    REAL(wp), DIMENSION(nzb:nzt+1) ::  in_t         !< temperature (K)   
7050    REAL(wp), DIMENSION(nzb:nzt+1) ::  mcsum        !< sum of mass concentration
7051    REAL(wp), DIMENSION(nzb:nzt+1) ::  ppm_to_nconc !< Conversion factor
7052                                                    !< from ppm to #/m3
7053    REAL(wp), DIMENSION(nzb:nzt+1) ::  zddry  !<
7054    REAL(wp), DIMENSION(nzb:nzt+1) ::  zvol   !<
7055   
7056    flag_zddry   = 0.0_wp
7057    in_adn       = 0.0_wp
7058    in_p         = 0.0_wp
7059    in_t         = 0.0_wp
7060    ppm_to_nconc = 1.0_wp
7061    zddry        = 0.0_wp
7062    zvol         = 0.0_wp
7063   
7064    CALL cpu_log( log_point_s(94), 'salsa diagnostics ', 'start' )
7065
7066!             
7067!-- Calculate thermodynamic quantities needed in SALSA
7068    CALL salsa_thrm_ij( i, j, p_ij=in_p, temp_ij=in_t, adn_ij=in_adn )       
7069!
7070!-- Calculate conversion factors for gas concentrations
7071    ppm_to_nconc = for_ppm_to_nconc * in_p / in_t
7072!
7073!-- Predetermine flag to mask topography
7074    flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_0(:,j,i), 0 ) ) 
7075   
7076    DO  b = 1, nbins   ! aerosol size bins
7077!             
7078!--    Remove negative values
7079       aerosol_number(b)%conc(:,j,i) = MAX( nclim,                             &
7080                                       aerosol_number(b)%conc(:,j,i) ) * flag
7081       mcsum = 0.0_wp   ! total mass concentration
7082       DO  c = 1, ncc_tot
7083!             
7084!--       Remove negative concentrations
7085          aerosol_mass((c-1)*nbins+b)%conc(:,j,i) = MAX( mclim,                &
7086                                     aerosol_mass((c-1)*nbins+b)%conc(:,j,i) ) &
7087                                     * flag
7088          mcsum = mcsum + aerosol_mass((c-1)*nbins+b)%conc(:,j,i) * flag
7089       ENDDO         
7090!               
7091!--    Check that number and mass concentration match qualitatively
7092       IF ( ANY ( aerosol_number(b)%conc(:,j,i) > nclim  .AND.                 &
7093                  mcsum <= 0.0_wp ) )                                          &
7094       THEN
7095          DO  k = nzb+1, nzt
7096             IF ( aerosol_number(b)%conc(k,j,i) > nclim  .AND.                 &
7097               mcsum(k) <= 0.0_wp ) &
7098             THEN
7099                aerosol_number(b)%conc(k,j,i) = nclim * flag(k)
7100                DO  c = 1, ncc_tot
7101                   aerosol_mass((c-1)*nbins+b)%conc(k,j,i) = mclim * flag(k)
7102                ENDDO
7103             ENDIF
7104          ENDDO
7105       ENDIF
7106!             
7107!--    Update aerosol particle radius
7108       CALL bin_mixrat( 'dry', b, i, j, zvol )
7109       zvol = zvol / arhoh2so4    ! Why on sulphate?
7110!                   
7111!--    Particles smaller then 0.1 nm diameter are set to zero
7112       zddry = ( zvol / MAX( nclim, aerosol_number(b)%conc(:,j,i) ) / api6 )** &
7113               ( 1.0_wp / 3.0_wp )
7114       flag_zddry = MERGE( 1.0_wp, 0.0_wp, ( zddry < 1.0E-10_wp  .AND.         &
7115                                       aerosol_number(b)%conc(:,j,i) > nclim ) )
7116!                   
7117!--    Volatile species to the gas phase
7118       IF ( is_used( prtcl, 'SO4' ) .AND. lscndgas )  THEN
7119          nc = get_index( prtcl, 'SO4' )
7120          c = ( nc - 1 ) * nbins + b                     
7121          IF ( salsa_gases_from_chem )  THEN
7122             chem_species( gas_index_chem(1) )%conc(:,j,i) =                   &
7123                               chem_species( gas_index_chem(1) )%conc(:,j,i) + &
7124                               aerosol_mass(c)%conc(:,j,i) * avo * flag *      &
7125                               flag_zddry / ( amh2so4 * ppm_to_nconc ) 
7126          ELSE
7127             salsa_gas(1)%conc(:,j,i) = salsa_gas(1)%conc(:,j,i) +             &
7128                                        aerosol_mass(c)%conc(:,j,i) / amh2so4 *&
7129                                        avo * flag * flag_zddry
7130          ENDIF
7131       ENDIF
7132       IF ( is_used( prtcl, 'OC' )  .AND.  lscndgas )  THEN
7133          nc = get_index( prtcl, 'OC' )
7134          c = ( nc - 1 ) * nbins + b
7135          IF ( salsa_gases_from_chem )  THEN
7136             chem_species( gas_index_chem(5) )%conc(:,j,i) =                   &
7137                               chem_species( gas_index_chem(5) )%conc(:,j,i) + &
7138                               aerosol_mass(c)%conc(:,j,i) * avo * flag *      &
7139                               flag_zddry / ( amoc * ppm_to_nconc ) 
7140          ELSE                         
7141             salsa_gas(5)%conc(:,j,i) = salsa_gas(5)%conc(:,j,i) + &
7142                                        aerosol_mass(c)%conc(:,j,i) / amoc *   &
7143                                        avo * flag * flag_zddry
7144          ENDIF
7145       ENDIF
7146       IF ( is_used( prtcl, 'NO' )  .AND.  lscndgas )  THEN
7147          nc = get_index( prtcl, 'NO' )
7148          c = ( nc - 1 ) * nbins + b                     
7149          IF ( salsa_gases_from_chem )  THEN
7150                chem_species( gas_index_chem(2) )%conc(:,j,i) =                &
7151                               chem_species( gas_index_chem(2) )%conc(:,j,i) + &
7152                               aerosol_mass(c)%conc(:,j,i) * avo * flag *      &
7153                               flag_zddry / ( amhno3 * ppm_to_nconc )                   
7154          ELSE
7155             salsa_gas(2)%conc(:,j,i) = salsa_gas(2)%conc(:,j,i) +             &
7156                                        aerosol_mass(c)%conc(:,j,i) / amhno3 * &
7157                                        avo * flag * flag_zddry
7158          ENDIF
7159       ENDIF
7160       IF ( is_used( prtcl, 'NH' )  .AND.  lscndgas )  THEN
7161          nc = get_index( prtcl, 'NH' )
7162          c = ( nc - 1 ) * nbins + b                     
7163          IF ( salsa_gases_from_chem )  THEN
7164                chem_species( gas_index_chem(3) )%conc(:,j,i) =                &
7165                               chem_species( gas_index_chem(3) )%conc(:,j,i) + &
7166                               aerosol_mass(c)%conc(:,j,i) * avo * flag *      &
7167                               flag_zddry / ( amnh3 * ppm_to_nconc )                         
7168          ELSE
7169             salsa_gas(3)%conc(:,j,i) = salsa_gas(3)%conc(:,j,i) +             &
7170                                        aerosol_mass(c)%conc(:,j,i) / amnh3 *  &
7171                                        avo * flag * flag_zddry
7172          ENDIF
7173       ENDIF
7174!                     
7175!--    Mass and number to zero (insoluble species and water are lost)
7176       DO  c = 1, ncc_tot
7177          aerosol_mass((c-1)*nbins+b)%conc(:,j,i) = MERGE( mclim * flag,       &
7178                                      aerosol_mass((c-1)*nbins+b)%conc(:,j,i), &
7179                                      flag_zddry > 0.0_wp )
7180       ENDDO
7181       aerosol_number(b)%conc(:,j,i) = MERGE( nclim * flag,                    &
7182                                              aerosol_number(b)%conc(:,j,i),   &
7183                                              flag_zddry > 0.0_wp )       
7184       Ra_dry(:,j,i,b) = MAX( 1.0E-10_wp, 0.5_wp * zddry )     
7185       
7186    ENDDO
7187    IF ( .NOT. salsa_gases_from_chem )  THEN
7188       DO  gt = 1, ngast
7189          salsa_gas(gt)%conc(:,j,i) = MAX( nclim, salsa_gas(gt)%conc(:,j,i) )  &
7190                                      * flag
7191       ENDDO
7192    ENDIF
7193   
7194    CALL cpu_log( log_point_s(94), 'salsa diagnostics ', 'stop' )
7195
7196 END SUBROUTINE salsa_diagnostics
7197
7198 
7199!
7200!------------------------------------------------------------------------------!
7201! Description:
7202! ------------
7203!> Calculate the tendencies for aerosol number and mass concentrations.
7204!> Cache-optimized.
7205!------------------------------------------------------------------------------!
7206 SUBROUTINE salsa_tendency_ij( id, rs_p, rs, trs_m, i, j, i_omp_start, tn, b,  &
7207                               c, flux_s, diss_s, flux_l, diss_l, rs_init )
7208   
7209    USE advec_ws,                                                              &
7210        ONLY:  advec_s_ws 
7211    USE advec_s_pw_mod,                                                        &
7212        ONLY:  advec_s_pw
7213    USE advec_s_up_mod,                                                        &
7214        ONLY:  advec_s_up
7215    USE arrays_3d,                                                             &
7216        ONLY:  ddzu, hyp, pt, rdf_sc, tend
7217    USE diffusion_s_mod,                                                       &
7218        ONLY:  diffusion_s
7219    USE indices,                                                               &
7220        ONLY:  wall_flags_0
7221    USE pegrid,                                                                &
7222        ONLY:  threads_per_task, myid     
7223    USE surface_mod,                                                           &
7224        ONLY :  surf_def_h, surf_def_v, surf_lsm_h, surf_lsm_v, surf_usm_h,    &
7225                                 surf_usm_v
7226   
7227    IMPLICIT NONE
7228   
7229    CHARACTER (LEN = *) ::  id
7230    INTEGER(iwp) ::  b   !< bin index in derived type aerosol_size_bin   
7231    INTEGER(iwp) ::  c   !< bin index in derived type aerosol_size_bin   
7232    INTEGER(iwp) ::  i   !<
7233    INTEGER(iwp) ::  i_omp_start !<
7234    INTEGER(iwp) ::  j   !<
7235    INTEGER(iwp) ::  k   !<
7236    INTEGER(iwp) ::  nc  !< (c-1)*nbins+b
7237    INTEGER(iwp) ::  tn  !<
7238    REAL(wp), DIMENSION(nzb+1:nzt,nys:nyn,0:threads_per_task-1) ::  diss_l  !<
7239    REAL(wp), DIMENSION(nzb+1:nzt,0:threads_per_task-1)         ::  diss_s  !<
7240    REAL(wp), DIMENSION(nzb+1:nzt,nys:nyn,0:threads_per_task-1) ::  flux_l  !<
7241    REAL(wp), DIMENSION(nzb+1:nzt,0:threads_per_task-1)         ::  flux_s  !<
7242    REAL(wp), DIMENSION(nzb:nzt+1)                              ::  rs_init !<
7243    REAL(wp), DIMENSION(:,:,:), POINTER                         ::  rs_p    !<
7244    REAL(wp), DIMENSION(:,:,:), POINTER                         ::  rs      !<
7245    REAL(wp), DIMENSION(:,:,:), POINTER                         ::  trs_m   !<
7246   
7247    nc = (c-1)*nbins+b   
7248!
7249!-- Tendency-terms for reactive scalar
7250    tend(:,j,i) = 0.0_wp
7251   
7252    IF ( id == 'aerosol_number'  .AND.  lod_aero == 3 )  THEN
7253       tend(:,j,i) = tend(:,j,i) + aerosol_number(b)%source(:,j,i)
7254    ELSEIF ( id == 'aerosol_mass'  .AND.  lod_aero == 3 )  THEN
7255       tend(:,j,i) = tend(:,j,i) + aerosol_mass(nc)%source(:,j,i)
7256    ENDIF
7257!   
7258!-- Advection terms
7259    IF ( timestep_scheme(1:5) == 'runge' )  THEN
7260       IF ( ws_scheme_sca )  THEN
7261          CALL advec_s_ws( i, j, rs, id, flux_s, diss_s, flux_l, diss_l,       &
7262                           i_omp_start, tn )
7263       ELSE
7264          CALL advec_s_pw( i, j, rs )
7265       ENDIF
7266    ELSE
7267       CALL advec_s_up( i, j, rs )
7268    ENDIF
7269!
7270!-- Diffusion terms   
7271    IF ( id == 'aerosol_number' )  THEN
7272       CALL diffusion_s( i, j, rs,                   surf_def_h(0)%answs(:,b), &
7273                           surf_def_h(1)%answs(:,b), surf_def_h(2)%answs(:,b), &
7274                           surf_lsm_h%answs(:,b),    surf_usm_h%answs(:,b),    &
7275                           surf_def_v(0)%answs(:,b), surf_def_v(1)%answs(:,b), &
7276                           surf_def_v(2)%answs(:,b), surf_def_v(3)%answs(:,b), &
7277                           surf_lsm_v(0)%answs(:,b), surf_lsm_v(1)%answs(:,b), &
7278                           surf_lsm_v(2)%answs(:,b), surf_lsm_v(3)%answs(:,b), &
7279                           surf_usm_v(0)%answs(:,b), surf_usm_v(1)%answs(:,b), &
7280                           surf_usm_v(2)%answs(:,b), surf_usm_v(3)%answs(:,b) )
7281!
7282!--    Sedimentation for aerosol number and mass
7283       IF ( lsdepo )  THEN
7284          tend(nzb+1:nzt,j,i) = tend(nzb+1:nzt,j,i) - MAX( 0.0_wp,             &
7285                         ( rs(nzb+2:nzt+1,j,i) * sedim_vd(nzb+2:nzt+1,j,i,b) - &
7286                           rs(nzb+1:nzt,j,i) * sedim_vd(nzb+1:nzt,j,i,b) ) *   &
7287                         ddzu(nzb+1:nzt) ) * MERGE( 1.0_wp, 0.0_wp,            &
7288                         BTEST( wall_flags_0(nzb:nzt-1,j,i), 0 ) )
7289       ENDIF
7290       
7291    ELSEIF ( id == 'aerosol_mass' )  THEN
7292       CALL diffusion_s( i, j, rs,                  surf_def_h(0)%amsws(:,nc), & 
7293                         surf_def_h(1)%amsws(:,nc), surf_def_h(2)%amsws(:,nc), &
7294                         surf_lsm_h%amsws(:,nc),    surf_usm_h%amsws(:,nc),    &
7295                         surf_def_v(0)%amsws(:,nc), surf_def_v(1)%amsws(:,nc), &
7296                         surf_def_v(2)%amsws(:,nc), surf_def_v(3)%amsws(:,nc), &
7297                         surf_lsm_v(0)%amsws(:,nc), surf_lsm_v(1)%amsws(:,nc), &
7298                         surf_lsm_v(2)%amsws(:,nc), surf_lsm_v(3)%amsws(:,nc), &
7299                         surf_usm_v(0)%amsws(:,nc), surf_usm_v(1)%amsws(:,nc), &
7300                         surf_usm_v(2)%amsws(:,nc), surf_usm_v(3)%amsws(:,nc) ) 
7301!
7302!--    Sedimentation for aerosol number and mass
7303       IF ( lsdepo )  THEN
7304          tend(nzb+1:nzt,j,i) = tend(nzb+1:nzt,j,i) - MAX( 0.0_wp,             &
7305                         ( rs(nzb+2:nzt+1,j,i) * sedim_vd(nzb+2:nzt+1,j,i,b) - &
7306                           rs(nzb+1:nzt,j,i) * sedim_vd(nzb+1:nzt,j,i,b) ) *   &
7307                         ddzu(nzb+1:nzt) ) * MERGE( 1.0_wp, 0.0_wp,            &
7308                         BTEST( wall_flags_0(nzb:nzt-1,j,i), 0 ) )
7309       ENDIF                         
7310    ELSEIF ( id == 'salsa_gas' )  THEN
7311       CALL diffusion_s( i, j, rs,                   surf_def_h(0)%gtsws(:,b), &
7312                           surf_def_h(1)%gtsws(:,b), surf_def_h(2)%gtsws(:,b), &
7313                           surf_lsm_h%gtsws(:,b),    surf_usm_h%gtsws(:,b),    &
7314                           surf_def_v(0)%gtsws(:,b), surf_def_v(1)%gtsws(:,b), &
7315                           surf_def_v(2)%gtsws(:,b), surf_def_v(3)%gtsws(:,b), &
7316                           surf_lsm_v(0)%gtsws(:,b), surf_lsm_v(1)%gtsws(:,b), &
7317                           surf_lsm_v(2)%gtsws(:,b), surf_lsm_v(3)%gtsws(:,b), &
7318                           surf_usm_v(0)%gtsws(:,b), surf_usm_v(1)%gtsws(:,b), &
7319                           surf_usm_v(2)%gtsws(:,b), surf_usm_v(3)%gtsws(:,b) ) 
7320    ENDIF
7321!
7322!-- Prognostic equation for a scalar
7323    DO  k = nzb+1, nzt
7324       rs_p(k,j,i) = rs(k,j,i) +  ( dt_3d  * ( tsc(2) * tend(k,j,i) +          &
7325                                               tsc(3) * trs_m(k,j,i) )         &
7326                                             - tsc(5) * rdf_sc(k)              &
7327                                           * ( rs(k,j,i) - rs_init(k) ) )      &
7328                                  * MERGE( 1.0_wp, 0.0_wp,                     &
7329                                           BTEST( wall_flags_0(k,j,i), 0 ) )
7330       IF ( rs_p(k,j,i) < 0.0_wp )  rs_p(k,j,i) = 0.1_wp * rs(k,j,i) 
7331    ENDDO
7332
7333!
7334!-- Calculate tendencies for the next Runge-Kutta step
7335    IF ( timestep_scheme(1:5) == 'runge' )  THEN
7336       IF ( intermediate_timestep_count == 1 )  THEN
7337          DO  k = nzb+1, nzt
7338             trs_m(k,j,i) = tend(k,j,i)
7339          ENDDO
7340       ELSEIF ( intermediate_timestep_count < &
7341                intermediate_timestep_count_max )  THEN
7342          DO  k = nzb+1, nzt
7343             trs_m(k,j,i) = -9.5625_wp * tend(k,j,i) + 5.3125_wp * trs_m(k,j,i)
7344          ENDDO
7345       ENDIF
7346    ENDIF
7347 
7348 END SUBROUTINE salsa_tendency_ij
7349 
7350!
7351!------------------------------------------------------------------------------!
7352! Description:
7353! ------------
7354!> Calculate the tendencies for aerosol number and mass concentrations.
7355!> Vector-optimized.
7356!------------------------------------------------------------------------------!
7357 SUBROUTINE salsa_tendency( id, rs_p, rs, trs_m, b, c, rs_init )
7358   
7359    USE advec_ws,                                                              &
7360        ONLY:  advec_s_ws 
7361    USE advec_s_pw_mod,                                                        &
7362        ONLY:  advec_s_pw
7363    USE advec_s_up_mod,                                                        &
7364        ONLY:  advec_s_up
7365    USE arrays_3d,                                                             &
7366        ONLY:  ddzu, hyp, pt, rdf_sc, tend
7367    USE diffusion_s_mod,                                                       &
7368        ONLY:  diffusion_s
7369    USE indices,                                                               &
7370        ONLY:  wall_flags_0
7371    USE surface_mod,                                                           &
7372        ONLY :  surf_def_h, surf_def_v, surf_lsm_h, surf_lsm_v, surf_usm_h,    &
7373                                 surf_usm_v
7374   
7375    IMPLICIT NONE
7376   
7377    CHARACTER (LEN = *) ::  id
7378    INTEGER(iwp) ::  b   !< bin index in derived type aerosol_size_bin   
7379    INTEGER(iwp) ::  c   !< bin index in derived type aerosol_size_bin   
7380    INTEGER(iwp) ::  i   !<
7381    INTEGER(iwp) ::  j   !<
7382    INTEGER(iwp) ::  k   !<
7383    INTEGER(iwp) ::  nc  !< (c-1)*nbins+b
7384    REAL(wp), DIMENSION(nzb:nzt+1)                              ::  rs_init !<
7385    REAL(wp), DIMENSION(:,:,:), POINTER                         ::  rs_p    !<
7386    REAL(wp), DIMENSION(:,:,:), POINTER                         ::  rs      !<
7387    REAL(wp), DIMENSION(:,:,:), POINTER                         ::  trs_m   !<
7388   
7389    nc = (c-1)*nbins+b   
7390!
7391!-- Tendency-terms for reactive scalar
7392    tend = 0.0_wp
7393   
7394    IF ( id == 'aerosol_number'  .AND.  lod_aero == 3 )  THEN
7395       tend = tend + aerosol_number(b)%source
7396    ELSEIF ( id == 'aerosol_mass'  .AND.  lod_aero == 3 )  THEN
7397       tend = tend + aerosol_mass(nc)%source
7398    ENDIF
7399!   
7400!-- Advection terms
7401    IF ( timestep_scheme(1:5) == 'runge' )  THEN
7402       IF ( ws_scheme_sca )  THEN
7403          CALL advec_s_ws( rs, id )
7404       ELSE
7405          CALL advec_s_pw( rs )
7406       ENDIF
7407    ELSE
7408       CALL advec_s_up( rs )
7409    ENDIF
7410!
7411!-- Diffusion terms   
7412    IF ( id == 'aerosol_number' )  THEN
7413       CALL diffusion_s(   rs,                       surf_def_h(0)%answs(:,b), &
7414                           surf_def_h(1)%answs(:,b), surf_def_h(2)%answs(:,b), &
7415                           surf_lsm_h%answs(:,b),    surf_usm_h%answs(:,b),    &
7416                           surf_def_v(0)%answs(:,b), surf_def_v(1)%answs(:,b), &
7417                           surf_def_v(2)%answs(:,b), surf_def_v(3)%answs(:,b), &
7418                           surf_lsm_v(0)%answs(:,b), surf_lsm_v(1)%answs(:,b), &
7419                           surf_lsm_v(2)%answs(:,b), surf_lsm_v(3)%answs(:,b), &
7420                           surf_usm_v(0)%answs(:,b), surf_usm_v(1)%answs(:,b), &
7421                           surf_usm_v(2)%answs(:,b), surf_usm_v(3)%answs(:,b) )                                 
7422    ELSEIF ( id == 'aerosol_mass' )  THEN
7423       CALL diffusion_s( rs,                        surf_def_h(0)%amsws(:,nc), & 
7424                         surf_def_h(1)%amsws(:,nc), surf_def_h(2)%amsws(:,nc), &
7425                         surf_lsm_h%amsws(:,nc),    surf_usm_h%amsws(:,nc),    &
7426                         surf_def_v(0)%amsws(:,nc), surf_def_v(1)%amsws(:,nc), &
7427                         surf_def_v(2)%amsws(:,nc), surf_def_v(3)%amsws(:,nc), &
7428                         surf_lsm_v(0)%amsws(:,nc), surf_lsm_v(1)%amsws(:,nc), &
7429                         surf_lsm_v(2)%amsws(:,nc), surf_lsm_v(3)%amsws(:,nc), &
7430                         surf_usm_v(0)%amsws(:,nc), surf_usm_v(1)%amsws(:,nc), &
7431                         surf_usm_v(2)%amsws(:,nc), surf_usm_v(3)%amsws(:,nc) )                         
7432    ELSEIF ( id == 'salsa_gas' )  THEN
7433       CALL diffusion_s(   rs,                       surf_def_h(0)%gtsws(:,b), &
7434                           surf_def_h(1)%gtsws(:,b), surf_def_h(2)%gtsws(:,b), &
7435                           surf_lsm_h%gtsws(:,b),    surf_usm_h%gtsws(:,b),    &
7436                           surf_def_v(0)%gtsws(:,b), surf_def_v(1)%gtsws(:,b), &
7437                           surf_def_v(2)%gtsws(:,b), surf_def_v(3)%gtsws(:,b), &
7438                           surf_lsm_v(0)%gtsws(:,b), surf_lsm_v(1)%gtsws(:,b), &
7439                           surf_lsm_v(2)%gtsws(:,b), surf_lsm_v(3)%gtsws(:,b), &
7440                           surf_usm_v(0)%gtsws(:,b), surf_usm_v(1)%gtsws(:,b), &
7441                           surf_usm_v(2)%gtsws(:,b), surf_usm_v(3)%gtsws(:,b) ) 
7442    ENDIF
7443!
7444!-- Prognostic equation for a scalar
7445    DO  i = nxl, nxr
7446       DO  j = nys, nyn
7447          IF ( id == 'salsa_gas'  .AND.  lod_gases == 3 )  THEN
7448             tend(:,j,i) = tend(:,j,i) + salsa_gas(b)%source(:,j,i) *          &
7449                           for_ppm_to_nconc * hyp(:) / pt(:,j,i) * ( hyp(:) /  &
7450                           100000.0_wp )**0.286_wp ! ppm to #/m3
7451          ELSEIF ( id == 'aerosol_mass'  .OR.  id == 'aerosol_number')  THEN
7452!
7453!--          Sedimentation for aerosol number and mass
7454             IF ( lsdepo )  THEN
7455                tend(nzb+1:nzt,j,i) = tend(nzb+1:nzt,j,i) - MAX( 0.0_wp,       &
7456                         ( rs(nzb+2:nzt+1,j,i) * sedim_vd(nzb+2:nzt+1,j,i,b) - &
7457                           rs(nzb+1:nzt,j,i) * sedim_vd(nzb+1:nzt,j,i,b) ) *   &
7458                         ddzu(nzb+1:nzt) ) * MERGE( 1.0_wp, 0.0_wp,            &
7459                         BTEST( wall_flags_0(nzb:nzt-1,j,i), 0 ) )
7460             ENDIF 
7461          ENDIF
7462          DO  k = nzb+1, nzt
7463             rs_p(k,j,i) = rs(k,j,i) +  ( dt_3d  * ( tsc(2) * tend(k,j,i) +    &
7464                                                     tsc(3) * trs_m(k,j,i) )   &
7465                                                   - tsc(5) * rdf_sc(k)        &
7466                                                 * ( rs(k,j,i) - rs_init(k) ) )&
7467                                        * MERGE( 1.0_wp, 0.0_wp,               &
7468                                          BTEST( wall_flags_0(k,j,i), 0 ) )
7469             IF ( rs_p(k,j,i) < 0.0_wp )  rs_p(k,j,i) = 0.1_wp * rs(k,j,i) 
7470          ENDDO
7471       ENDDO
7472    ENDDO
7473
7474!
7475!-- Calculate tendencies for the next Runge-Kutta step
7476    IF ( timestep_scheme(1:5) == 'runge' )  THEN
7477       IF ( intermediate_timestep_count == 1 )  THEN
7478          DO  i = nxl, nxr
7479             DO  j = nys, nyn
7480                DO  k = nzb+1, nzt
7481                   trs_m(k,j,i) = tend(k,j,i)
7482                ENDDO
7483             ENDDO
7484          ENDDO
7485       ELSEIF ( intermediate_timestep_count < &
7486                intermediate_timestep_count_max )  THEN
7487          DO  i = nxl, nxr
7488             DO  j = nys, nyn
7489                DO  k = nzb+1, nzt
7490                   trs_m(k,j,i) =  -9.5625_wp * tend(k,j,i)                    &
7491                                   + 5.3125_wp * trs_m(k,j,i)
7492                ENDDO
7493             ENDDO
7494          ENDDO
7495       ENDIF
7496    ENDIF
7497 
7498 END SUBROUTINE salsa_tendency
7499 
7500!------------------------------------------------------------------------------!
7501! Description:
7502! ------------
7503!> Boundary conditions for prognostic variables in SALSA
7504!------------------------------------------------------------------------------!
7505 SUBROUTINE salsa_boundary_conds
7506 
7507    USE surface_mod,                                                           &
7508        ONLY :  bc_h
7509
7510    IMPLICIT NONE
7511
7512    INTEGER(iwp) ::  b  !< index for aerosol size bins   
7513    INTEGER(iwp) ::  c  !< index for chemical compounds in aerosols
7514    INTEGER(iwp) ::  g  !< idex for gaseous compounds
7515    INTEGER(iwp) ::  i  !< grid index x direction
7516    INTEGER(iwp) ::  j  !< grid index y direction
7517    INTEGER(iwp) ::  k  !< grid index y direction
7518    INTEGER(iwp) ::  kb !< variable to set respective boundary value, depends on
7519                        !< facing.
7520    INTEGER(iwp) ::  l  !< running index boundary type, for up- and downward-
7521                        !< facing walls
7522    INTEGER(iwp) ::  m  !< running index surface elements
7523   
7524!
7525!-- Surface conditions:
7526    IF ( ibc_salsa_b == 0 )  THEN   ! Dirichlet
7527!   
7528!--    Run loop over all non-natural and natural walls. Note, in wall-datatype
7529!--    the k coordinate belongs to the atmospheric grid point, therefore, set
7530!--    s_p at k-1
7531 
7532       DO  l = 0, 1
7533!
7534!--       Set kb, for upward-facing surfaces value at topography top (k-1) is
7535!--       set, for downward-facing surfaces at topography bottom (k+1)
7536          kb = MERGE ( -1, 1, l == 0 )
7537          !$OMP PARALLEL PRIVATE( b, c, g, i, j, k )
7538          !$OMP DO
7539          DO  m = 1, bc_h(l)%ns
7540         
7541             i = bc_h(l)%i(m)
7542             j = bc_h(l)%j(m)
7543             k = bc_h(l)%k(m)
7544             
7545             DO  b = 1, nbins
7546                aerosol_number(b)%conc_p(k+kb,j,i) =                           &
7547                                                aerosol_number(b)%conc(k+kb,j,i)
7548                DO  c = 1, ncc_tot
7549                   aerosol_mass((c-1)*nbins+b)%conc_p(k+kb,j,i) =              &
7550                                      aerosol_mass((c-1)*nbins+b)%conc(k+kb,j,i)
7551                ENDDO
7552             ENDDO
7553             IF ( .NOT. salsa_gases_from_chem )  THEN
7554                DO  g = 1, ngast
7555                   salsa_gas(g)%conc_p(k+kb,j,i) = salsa_gas(g)%conc(k+kb,j,i)
7556                ENDDO
7557             ENDIF
7558             
7559          ENDDO
7560          !$OMP END PARALLEL
7561         
7562       ENDDO
7563   
7564    ELSE   ! Neumann
7565   
7566       DO l = 0, 1
7567!
7568!--       Set kb, for upward-facing surfaces value at topography top (k-1) is
7569!--       set, for downward-facing surfaces at topography bottom (k+1)       
7570          kb = MERGE( -1, 1, l == 0 )
7571          !$OMP PARALLEL PRIVATE( b, c, g, i, j, k )
7572          !$OMP DO
7573          DO  m = 1, bc_h(l)%ns
7574             
7575             i = bc_h(l)%i(m)
7576             j = bc_h(l)%j(m)
7577             k = bc_h(l)%k(m)
7578             
7579             DO  b = 1, nbins
7580                aerosol_number(b)%conc_p(k+kb,j,i) =                           &
7581                                                 aerosol_number(b)%conc_p(k,j,i)
7582                DO  c = 1, ncc_tot
7583                   aerosol_mass((c-1)*nbins+b)%conc_p(k+kb,j,i) =              &
7584                                       aerosol_mass((c-1)*nbins+b)%conc_p(k,j,i)
7585                ENDDO
7586             ENDDO
7587             IF ( .NOT. salsa_gases_from_chem ) THEN
7588                DO  g = 1, ngast
7589                   salsa_gas(g)%conc_p(k+kb,j,i) = salsa_gas(g)%conc_p(k,j,i)
7590                ENDDO
7591             ENDIF
7592               
7593          ENDDO
7594          !$OMP END PARALLEL
7595       ENDDO
7596     
7597    ENDIF
7598
7599!
7600!--Top boundary conditions:
7601    IF ( ibc_salsa_t == 0 )  THEN   ! Dirichlet
7602   
7603       DO  b = 1, nbins
7604          aerosol_number(b)%conc_p(nzt+1,:,:) =                                &
7605                                               aerosol_number(b)%conc(nzt+1,:,:)
7606          DO  c = 1, ncc_tot
7607             aerosol_mass((c-1)*nbins+b)%conc_p(nzt+1,:,:) =                   &
7608                                     aerosol_mass((c-1)*nbins+b)%conc(nzt+1,:,:)
7609          ENDDO
7610       ENDDO
7611       IF ( .NOT. salsa_gases_from_chem )  THEN
7612          DO  g = 1, ngast
7613             salsa_gas(g)%conc_p(nzt+1,:,:) = salsa_gas(g)%conc(nzt+1,:,:)
7614          ENDDO
7615       ENDIF
7616       
7617    ELSEIF ( ibc_salsa_t == 1 )  THEN   ! Neumann
7618   
7619       DO  b = 1, nbins
7620          aerosol_number(b)%conc_p(nzt+1,:,:) =                                &
7621                                               aerosol_number(b)%conc_p(nzt,:,:)
7622          DO  c = 1, ncc_tot
7623             aerosol_mass((c-1)*nbins+b)%conc_p(nzt+1,:,:) =                   &
7624                                     aerosol_mass((c-1)*nbins+b)%conc_p(nzt,:,:)
7625          ENDDO
7626       ENDDO
7627       IF ( .NOT. salsa_gases_from_chem )  THEN
7628          DO  g = 1, ngast
7629             salsa_gas(g)%conc_p(nzt+1,:,:) = salsa_gas(g)%conc_p(nzt,:,:)
7630          ENDDO
7631       ENDIF
7632       
7633    ENDIF
7634!
7635!-- Lateral boundary conditions at the outflow   
7636    IF ( bc_radiation_s )  THEN
7637       DO  b = 1, nbins
7638          aerosol_number(b)%conc_p(:,nys-1,:) = aerosol_number(b)%conc_p(:,nys,:)
7639          DO  c = 1, ncc_tot
7640             aerosol_mass((c-1)*nbins+b)%conc_p(:,nys-1,:) =                   &
7641                                     aerosol_mass((c-1)*nbins+b)%conc_p(:,nys,:)
7642          ENDDO
7643       ENDDO
7644    ELSEIF ( bc_radiation_n )  THEN
7645       DO  b = 1, nbins
7646          aerosol_number(b)%conc_p(:,nyn+1,:) = aerosol_number(b)%conc_p(:,nyn,:)
7647          DO  c = 1, ncc_tot
7648             aerosol_mass((c-1)*nbins+b)%conc_p(:,nyn+1,:) =                   &
7649                                     aerosol_mass((c-1)*nbins+b)%conc_p(:,nyn,:)
7650          ENDDO
7651       ENDDO
7652    ELSEIF ( bc_radiation_l )  THEN
7653       DO  b = 1, nbins
7654          aerosol_number(b)%conc_p(:,nxl-1,:) = aerosol_number(b)%conc_p(:,nxl,:)
7655          DO  c = 1, ncc_tot
7656             aerosol_mass((c-1)*nbins+b)%conc_p(:,nxl-1,:) =                   &
7657                                     aerosol_mass((c-1)*nbins+b)%conc_p(:,nxl,:)
7658          ENDDO
7659       ENDDO
7660    ELSEIF ( bc_radiation_r )  THEN
7661       DO  b = 1, nbins
7662          aerosol_number(b)%conc_p(:,nxr+1,:) = aerosol_number(b)%conc_p(:,nxr,:)
7663          DO  c = 1, ncc_tot
7664             aerosol_mass((c-1)*nbins+b)%conc_p(:,nxr+1,:) =                   &
7665                                     aerosol_mass((c-1)*nbins+b)%conc_p(:,nxr,:)
7666          ENDDO
7667       ENDDO
7668    ENDIF
7669
7670 END SUBROUTINE salsa_boundary_conds
7671
7672!------------------------------------------------------------------------------!
7673! Description:
7674! ------------
7675! Undoing of the previously done cyclic boundary conditions.
7676!------------------------------------------------------------------------------!
7677 SUBROUTINE salsa_boundary_conds_decycle ( sq, sq_init )
7678
7679    IMPLICIT NONE
7680
7681    INTEGER(iwp) ::  boundary !<
7682    INTEGER(iwp) ::  ee !<
7683    INTEGER(iwp) ::  copied !<
7684    INTEGER(iwp) ::  i  !<
7685    INTEGER(iwp) ::  j  !<
7686    INTEGER(iwp) ::  k  !<
7687    INTEGER(iwp) ::  ss !<
7688    REAL(wp), DIMENSION(nzb:nzt+1) ::  sq_init
7689    REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ::  sq
7690    REAL(wp) ::  flag !< flag to mask topography grid points
7691
7692    flag = 0.0_wp
7693!
7694!-- Left and right boundaries
7695    IF ( decycle_lr  .AND.  ( bc_lr_cyc  .OR. bc_lr == 'nested' ) )  THEN
7696   
7697       DO  boundary = 1, 2
7698
7699          IF ( decycle_method(boundary) == 'dirichlet' )  THEN
7700!   
7701!--          Initial profile is copied to ghost and first three layers         
7702             ss = 1
7703             ee = 0
7704             IF ( boundary == 1  .AND.  nxl == 0 )  THEN
7705                ss = nxlg
7706                ee = nxl+2
7707             ELSEIF ( boundary == 2  .AND.  nxr == nx )  THEN
7708                ss = nxr-2
7709                ee = nxrg
7710             ENDIF
7711             
7712             DO  i = ss, ee
7713                DO  j = nysg, nyng
7714                   DO  k = nzb+1, nzt             
7715                      flag = MERGE( 1.0_wp, 0.0_wp,                            &
7716                                    BTEST( wall_flags_0(k,j,i), 0 ) )
7717                      sq(k,j,i) = sq_init(k) * flag
7718                   ENDDO
7719                ENDDO
7720             ENDDO
7721             
7722          ELSEIF ( decycle_method(boundary) == 'neumann' )  THEN
7723!
7724!--          The value at the boundary is copied to the ghost layers to simulate
7725!--          an outlet with zero gradient
7726             ss = 1
7727             ee = 0
7728             IF ( boundary == 1  .AND.  nxl == 0 )  THEN
7729                ss = nxlg
7730                ee = nxl-1
7731                copied = nxl
7732             ELSEIF ( boundary == 2  .AND.  nxr == nx )  THEN
7733                ss = nxr+1
7734                ee = nxrg
7735                copied = nxr
7736             ENDIF
7737             
7738              DO  i = ss, ee
7739                DO  j = nysg, nyng
7740                   DO  k = nzb+1, nzt             
7741                      flag = MERGE( 1.0_wp, 0.0_wp,                            &
7742                                    BTEST( wall_flags_0(k,j,i), 0 ) )
7743                      sq(k,j,i) = sq(k,j,copied) * flag
7744                   ENDDO
7745                ENDDO
7746             ENDDO
7747             
7748          ELSE
7749             WRITE(message_string,*)                                           &
7750                                 'unknown decycling method: decycle_method (', &
7751                     boundary, ') ="' // TRIM( decycle_method(boundary) ) // '"'
7752             CALL message( 'salsa_boundary_conds_decycle', 'SA0029',           &
7753                           1, 2, 0, 6, 0 )
7754          ENDIF
7755       ENDDO
7756    ENDIF
7757   
7758!
7759!-- South and north boundaries
7760     IF ( decycle_ns  .AND.  ( bc_ns_cyc  .OR. bc_ns == 'nested' ) )  THEN
7761   
7762       DO  boundary = 3, 4
7763
7764          IF ( decycle_method(boundary) == 'dirichlet' )  THEN
7765!   
7766!--          Initial profile is copied to ghost and first three layers         
7767             ss = 1
7768             ee = 0
7769             IF ( boundary == 3  .AND.  nys == 0 )  THEN
7770                ss = nysg
7771                ee = nys+2
7772             ELSEIF ( boundary == 4  .AND.  nyn == ny )  THEN
7773                ss = nyn-2
7774                ee = nyng
7775             ENDIF
7776             
7777             DO  i = nxlg, nxrg
7778                DO  j = ss, ee
7779                   DO  k = nzb+1, nzt             
7780                      flag = MERGE( 1.0_wp, 0.0_wp,                            &
7781                                    BTEST( wall_flags_0(k,j,i), 0 ) )
7782                      sq(k,j,i) = sq_init(k) * flag
7783                   ENDDO
7784                ENDDO
7785             ENDDO
7786             
7787          ELSEIF ( decycle_method(boundary) == 'neumann' )  THEN
7788!
7789!--          The value at the boundary is copied to the ghost layers to simulate
7790!--          an outlet with zero gradient
7791             ss = 1
7792             ee = 0
7793             IF ( boundary == 3  .AND.  nys == 0 )  THEN
7794                ss = nysg
7795                ee = nys-1
7796                copied = nys
7797             ELSEIF ( boundary == 4  .AND.  nyn == ny )  THEN
7798                ss = nyn+1
7799                ee = nyng
7800                copied = nyn
7801             ENDIF
7802             
7803              DO  i = nxlg, nxrg
7804                DO  j = ss, ee
7805                   DO  k = nzb+1, nzt             
7806                      flag = MERGE( 1.0_wp, 0.0_wp,                            &
7807                                    BTEST( wall_flags_0(k,j,i), 0 ) )
7808                      sq(k,j,i) = sq(k,copied,i) * flag
7809                   ENDDO
7810                ENDDO
7811             ENDDO
7812             
7813          ELSE
7814             WRITE(message_string,*)                                           &
7815                                 'unknown decycling method: decycle_method (', &
7816                     boundary, ') ="' // TRIM( decycle_method(boundary) ) // '"'
7817             CALL message( 'salsa_boundary_conds_decycle', 'SA0030',           &
7818                           1, 2, 0, 6, 0 )
7819          ENDIF
7820       ENDDO
7821    ENDIF   
7822 
7823 END SUBROUTINE salsa_boundary_conds_decycle
7824
7825!------------------------------------------------------------------------------!
7826! Description:
7827! ------------
7828!> Calculates the total dry or wet mass concentration for individual bins
7829!> Juha Tonttila (FMI) 2015
7830!> Tomi Raatikainen (FMI) 2016
7831!------------------------------------------------------------------------------!
7832 SUBROUTINE bin_mixrat( itype, ibin, i, j, mconc )
7833
7834    IMPLICIT NONE
7835   
7836    CHARACTER(len=*), INTENT(in) ::  itype !< 'dry' or 'wet'
7837    INTEGER(iwp), INTENT(in) ::  ibin   !< index of the chemical component
7838    INTEGER(iwp), INTENT(in) ::  i      !< loop index for x-direction
7839    INTEGER(iwp), INTENT(in) ::  j      !< loop index for y-direction
7840    REAL(wp), DIMENSION(:), INTENT(out) ::  mconc     !< total dry or wet mass
7841                                                      !< concentration
7842                                                     
7843    INTEGER(iwp) ::  c                  !< loop index for mass bin number
7844    INTEGER(iwp) ::  iend               !< end index: include water or not     
7845   
7846!-- Number of components
7847    IF ( itype == 'dry' )  THEN
7848       iend = get_n_comp( prtcl ) - 1 
7849    ELSE IF ( itype == 'wet' )  THEN
7850       iend = get_n_comp( prtcl ) 
7851    ELSE
7852       STOP 'bin_mixrat: Error in itype'
7853    ENDIF
7854
7855    mconc = 0.0_wp
7856   
7857    DO c = ibin, iend*nbins+ibin, nbins !< every nbins'th element
7858       mconc = mconc + aerosol_mass(c)%conc(:,j,i)
7859    ENDDO
7860   
7861 END SUBROUTINE bin_mixrat 
7862
7863!------------------------------------------------------------------------------!
7864!> Description:
7865!> ------------
7866!> Define aerosol fluxes: constant or read from a from file
7867!------------------------------------------------------------------------------!
7868 SUBROUTINE salsa_set_source
7869 
7870 !   USE date_and_time_mod,                                                     &
7871 !       ONLY:  index_dd, index_hh, index_mm
7872#if defined( __netcdf )
7873    USE NETCDF
7874   
7875    USE netcdf_data_input_mod,                                                 &
7876        ONLY:  get_attribute, netcdf_data_input_get_dimension_length,          &
7877               get_variable, open_read_file
7878   
7879    USE surface_mod,                                                           &
7880        ONLY:  surf_def_h, surf_lsm_h, surf_usm_h
7881 
7882    IMPLICIT NONE
7883   
7884    INTEGER(iwp), PARAMETER ::  ndm = 3  !< number of default modes
7885    INTEGER(iwp), PARAMETER ::  ndc = 4  !< number of default categories
7886   
7887    CHARACTER (LEN=10) ::  unita !< Unit of aerosol fluxes
7888    CHARACTER (LEN=10) ::  unitg !< Unit of gaseous fluxes
7889    INTEGER(iwp) ::  b           !< loop index: aerosol number bins
7890    INTEGER(iwp) ::  c           !< loop index: aerosol chemical components
7891    INTEGER(iwp) ::  ee          !< loop index: end
7892    INTEGER(iwp), ALLOCATABLE, DIMENSION(:) ::  eci !< emission category index
7893    INTEGER(iwp) ::  g           !< loop index: gaseous tracers
7894    INTEGER(iwp) ::  i           !< loop index: x-direction   
7895    INTEGER(iwp) ::  id_faero    !< NetCDF id of aerosol source input file
7896    INTEGER(iwp) ::  id_fchem    !< NetCDF id of aerosol source input file                             
7897    INTEGER(iwp) ::  id_sa       !< NetCDF id of variable: source   
7898    INTEGER(iwp) ::  j           !< loop index: y-direction
7899    INTEGER(iwp) ::  k           !< loop index: z-direction
7900    INTEGER(iwp) ::  kg          !< loop index: z-direction (gases)
7901    INTEGER(iwp) ::  n_dt        !< number of time steps in the emission file
7902    INTEGER(iwp) ::  nc_stat     !< local variable for storing the result of
7903                                 !< netCDF calls for error message handling
7904    INTEGER(iwp) ::  nb_file     !< Number of grid-points in file (bins)                                 
7905    INTEGER(iwp) ::  ncat        !< Number of emission categories
7906    INTEGER(iwp) ::  ng_file     !< Number of grid-points in file (gases) 
7907    INTEGER(iwp) ::  num_vars    !< number of variables in input file
7908    INTEGER(iwp) ::  nz_file     !< number of grid-points in file     
7909    INTEGER(iwp) ::  n           !< loop index
7910    INTEGER(iwp) ::  ni          !< loop index
7911    INTEGER(iwp) ::  ss          !< loop index
7912    LOGICAL  ::  netcdf_extend = .FALSE. !< Flag indicating wether netcdf
7913                                         !< topography input file or not   
7914    REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:)   :: dum_var_4d !< variable for
7915                                                              !< temporary data                                       
7916    REAL(wp) ::  fillval         !< fill value
7917    REAL(wp) ::  flag            !< flag to mask topography grid points
7918    REAL(wp), DIMENSION(nbins) ::  nsect_emission  !< sectional emission (lod1)
7919    REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) ::  pm_emission  !< aerosol mass
7920                                                             !< emission (lod1)
7921    REAL(wp), DIMENSION(nbins) ::  source_ijka !< aerosol source at (k,j,i)
7922!
7923!-- The default size distribution and mass composition per emission category:
7924!-- 1 = traffic, 2 = road dust, 3 = wood combustion, 4 = other
7925!-- Mass fractions: H2SO4, OC, BC, DU, SS, HNO3, NH3
7926    CHARACTER(LEN=15), DIMENSION(ndc) ::  cat_name_table = &!< emission category
7927                                         (/'road traffic   ','road dust      ',&
7928                                           'wood combustion','other          '/)
7929    REAL(wp), DIMENSION(ndc) ::  avg_density        !< average density
7930    REAL(wp), DIMENSION(ndc) ::  conversion_factor  !< unit conversion factor 
7931                                                    !< for aerosol emissions
7932    REAL(wp), DIMENSION(ndm), PARAMETER ::  dpg_table = & !< mean diameter (mum)
7933                                            (/ 13.5E-3_wp, 1.4_wp, 5.4E-2_wp/)
7934    REAL(wp), DIMENSION(ndm) ::  ntot_table                                       
7935    REAL(wp), DIMENSION(maxspec,ndc), PARAMETER ::  mass_fraction_table =      &
7936       RESHAPE( (/ 0.04_wp, 0.48_wp, 0.48_wp, 0.0_wp,  0.0_wp, 0.0_wp, 0.0_wp, &
7937                   0.0_wp,  0.05_wp, 0.0_wp,  0.95_wp, 0.0_wp, 0.0_wp, 0.0_wp, &
7938                   0.0_wp,  0.5_wp,  0.5_wp,  0.0_wp,  0.0_wp, 0.0_wp, 0.0_wp, &
7939                   0.0_wp,  0.5_wp,  0.5_wp,  0.0_wp,  0.0_wp, 0.0_wp, 0.0_wp  &
7940                /), (/maxspec,ndc/) )         
7941    REAL(wp), DIMENSION(ndm,ndc), PARAMETER ::  PMfrac_table = & !< rel. mass
7942                                     RESHAPE( (/ 0.016_wp, 0.000_wp, 0.984_wp, &
7943                                                 0.000_wp, 1.000_wp, 0.000_wp, &
7944                                                 0.000_wp, 0.000_wp, 1.000_wp, &
7945                                                 1.000_wp, 0.000_wp, 1.000_wp  &
7946                                              /), (/ndm,ndc/) )                                   
7947    REAL(wp), DIMENSION(ndm), PARAMETER ::  sigmag_table = &     !< mode std
7948                                            (/1.6_wp, 1.4_wp, 1.7_wp/) 
7949    avg_density    = 1.0_wp
7950    nb_file        = 0
7951    ng_file        = 0
7952    nsect_emission = 0.0_wp
7953    nz_file        = 0
7954    source_ijka    = 0.0_wp
7955!
7956!-- First gases, if needed:
7957    IF ( .NOT. salsa_gases_from_chem )  THEN   
7958!       
7959!--    Read sources from PIDS_CHEM     
7960       INQUIRE( FILE='PIDS_CHEM' // TRIM( coupling_char ), EXIST=netcdf_extend )
7961       IF ( .NOT. netcdf_extend )  THEN
7962          message_string = 'Input file '// TRIM( 'PIDS_CHEM' ) //              &
7963                           TRIM( coupling_char ) // ' for SALSA missing!'
7964          CALL message( 'salsa_mod: salsa_set_source', 'SA0027', 1, 2, 0, 6, 0 )               
7965       ENDIF   ! netcdf_extend 
7966       
7967       CALL location_message( '    salsa_set_source: NOTE! Gaseous emissions'//&
7968               ' should be provided with following emission indices:'//        &
7969               ' 1=H2SO4, 2=HNO3, 3=NH3, 4=OCNV, 5=OCSV', .TRUE. )
7970       CALL location_message( '    salsa_set_source: No time dependency for '//&
7971                              'gaseous emissions. Use emission_values '//      &
7972                              'directly.', .TRUE. )
7973!
7974!--    Open PIDS_CHEM in read-only mode
7975       CALL open_read_file( 'PIDS_CHEM' // TRIM( coupling_char ), id_fchem )
7976!
7977!--    Inquire the level of detail (lod)
7978       CALL get_attribute( id_fchem, 'lod', lod_gases, .FALSE.,                &
7979                           "emission_values" ) 
7980                           
7981       IF ( lod_gases == 2 )  THEN
7982!                             
7983!--       Index of gaseous compounds
7984          CALL netcdf_data_input_get_dimension_length( id_fchem, ng_file, "nspecies" ) 
7985          IF ( ng_file < 5 )  THEN
7986             message_string = 'Some gaseous emissions missing.'
7987             CALL message( 'salsa_mod: salsa_set_source', 'SA0041',            &
7988                           1, 2, 0, 6, 0 )
7989          ENDIF       
7990!
7991!--       Get number of emission categories 
7992          CALL netcdf_data_input_get_dimension_length( id_fchem, ncat, "ncat" )       
7993!
7994!--       Inquire the unit of gaseous fluxes
7995          CALL get_attribute( id_fchem, 'units', unitg, .FALSE.,               &
7996                              "emission_values")       
7997!
7998!--       Inquire the fill value
7999          CALL get_attribute( id_fchem, '_FillValue', fillval, .FALSE.,        &
8000                              "emission_values" )
8001!       
8002!--       Read surface emission data (x,y) PE-wise   
8003          ALLOCATE( dum_var_4d(ng_file,ncat,nys:nyn,nxl:nxr) )     
8004          CALL get_variable( id_fchem, 'emission_values', dum_var_4d, nxl, nxr,&
8005                             nys, nyn, 0, ncat-1, 0, ng_file-1 )
8006          DO  g = 1, ngast
8007             ALLOCATE( salsa_gas(g)%source(ncat,nys:nyn,nxl:nxr) )
8008             salsa_gas(g)%source = 0.0_wp
8009             salsa_gas(g)%source = salsa_gas(g)%source + dum_var_4d(g,:,:,:)
8010          ENDDO                   
8011!   
8012!--       Set surface fluxes of gaseous compounds on horizontal surfaces.
8013!--       Set fluxes only for either default, land or urban surface.
8014          IF ( .NOT. land_surface  .AND.  .NOT. urban_surface )  THEN
8015             CALL set_gas_flux( surf_def_h(0), ncat, unitg  )
8016          ELSE
8017             CALL set_gas_flux( surf_lsm_h, ncat, unitg  )
8018             CALL set_gas_flux( surf_usm_h, ncat, unitg  )
8019          ENDIF
8020         
8021          DEALLOCATE( dum_var_4d )
8022          DO  g = 1, ngast
8023             DEALLOCATE( salsa_gas(g)%source )
8024          ENDDO
8025       ELSE
8026          message_string = 'Input file PIDS_CHEM needs to have lod = 2 when '//&
8027                           'SALSA is applied but not the chemistry module!'
8028          CALL message( 'salsa_mod: salsa_set_source', 'SA0039', 1, 2, 0, 6, 0 )   
8029       ENDIF             
8030    ENDIF 
8031!       
8032!-- Read sources from PIDS_SALSA       
8033    INQUIRE( FILE='PIDS_SALSA' // TRIM( coupling_char ), EXIST=netcdf_extend )
8034    IF ( .NOT. netcdf_extend )  THEN
8035       message_string = 'Input file '// TRIM( 'PIDS_SALSA' ) //                &
8036                         TRIM( coupling_char ) // ' for SALSA missing!'
8037       CALL message( 'salsa_mod: salsa_set_source', 'SA0034', 1, 2, 0, 6, 0 )               
8038    ENDIF   ! netcdf_extend     
8039!
8040!-- Open file in read-only mode     
8041    CALL open_read_file( 'PIDS_SALSA' // TRIM( coupling_char ), id_faero )
8042!
8043!-- Get number of emission categories and their indices       
8044    CALL netcdf_data_input_get_dimension_length( id_faero, ncat, "ncat" ) 
8045!
8046!-- Get emission category indices
8047    ALLOCATE( eci(1:ncat) )
8048    CALL get_variable( id_faero, 'emission_category_index', eci ) 
8049!
8050!-- Inquire the level of detail (lod)
8051    CALL get_attribute( id_faero, 'lod', lod_aero, .FALSE.,                    &
8052                        "aerosol_emission_values" ) 
8053                           
8054    IF ( lod_aero < 3  .AND.  ibc_salsa_b  == 0 ) THEN
8055       message_string = 'lod1/2 for aerosol emissions requires '//             &
8056                        'bc_salsa_b = "Neumann"'
8057       CALL message( 'salsa_mod: salsa_set_source','SA0025', 1, 2, 0, 6, 0 )
8058    ENDIF
8059!
8060!-- Inquire the fill value
8061    CALL get_attribute( id_faero, '_FillValue', fillval, .FALSE.,              &
8062                        "aerosol_emission_values" )
8063!
8064!-- Aerosol chemical composition:
8065    ALLOCATE( emission_mass_fracs(1:ncat,1:maxspec) )
8066    emission_mass_fracs = 0.0_wp
8067!-- Chemical composition: 1: H2SO4 (sulphuric acid), 2: OC (organic carbon),
8068!--                       3: BC (black carbon), 4: DU (dust), 
8069!--                       5: SS (sea salt),     6: HNO3 (nitric acid),
8070!--                       7: NH3 (ammonia)
8071    DO  n = 1, ncat
8072       IF  ( lod_aero < 2 )  THEN
8073          emission_mass_fracs(n,:) = mass_fraction_table(:,n)
8074       ELSE
8075          CALL get_variable( id_faero, "emission_mass_fracs",                  &
8076                             emission_mass_fracs(n,:) )
8077       ENDIF 
8078!
8079!--    If the chemical component is not activated, set its mass fraction to 0
8080!--    to avoid inbalance between number and mass flux
8081       IF ( iso4 < 0 )  emission_mass_fracs(n,1) = 0.0_wp
8082       IF ( ioc  < 0 )  emission_mass_fracs(n,2) = 0.0_wp
8083       IF ( ibc  < 0 )  emission_mass_fracs(n,3) = 0.0_wp
8084       IF ( idu  < 0 )  emission_mass_fracs(n,4) = 0.0_wp
8085       IF ( iss  < 0 )  emission_mass_fracs(n,5) = 0.0_wp
8086       IF ( ino  < 0 )  emission_mass_fracs(n,6) = 0.0_wp
8087       IF ( inh  < 0 )  emission_mass_fracs(n,7) = 0.0_wp
8088!--    Then normalise the mass fraction so that SUM = 1                   
8089       emission_mass_fracs(n,:) = emission_mass_fracs(n,:) /                   &
8090                                  SUM( emission_mass_fracs(n,:) )
8091    ENDDO
8092   
8093    IF ( lod_aero > 1 )  THEN
8094!
8095!--    Aerosol geometric mean diameter 
8096       CALL netcdf_data_input_get_dimension_length( id_faero, nb_file, 'Dmid' )     
8097       IF ( nb_file /= nbins )  THEN
8098          message_string = 'The number of size bins in aerosol input data '//  &
8099                           'does not correspond to the model set-up'
8100          CALL message( 'salsa_mod: salsa_set_source','SA0040', 1, 2, 0, 6, 0 )
8101       ENDIF
8102    ENDIF
8103
8104    IF ( lod_aero < 3 )  THEN
8105       CALL location_message( '    salsa_set_source: No time dependency for '//&
8106                             'aerosol emissions. Use aerosol_emission_values'//&
8107                             ' directly.', .TRUE. )
8108!
8109!--    Allocate source arrays
8110       DO  b = 1, nbins
8111          ALLOCATE( aerosol_number(b)%source(1:ncat,nys:nyn,nxl:nxr) )
8112          aerosol_number(b)%source = 0.0_wp
8113       ENDDO 
8114       DO  c = 1, ncc_tot*nbins
8115          ALLOCATE( aerosol_mass(c)%source(1:ncat,nys:nyn,nxl:nxr) )
8116          aerosol_mass(c)%source = 0.0_wp
8117       ENDDO
8118       
8119       IF ( lod_aero == 1 )  THEN
8120          DO  n = 1, ncat
8121             avg_density(n) = emission_mass_fracs(n,1) * arhoh2so4 +           &
8122                              emission_mass_fracs(n,2) * arhooc +              &
8123                              emission_mass_fracs(n,3) * arhobc +              &
8124                              emission_mass_fracs(n,4) * arhodu +              &
8125                              emission_mass_fracs(n,5) * arhoss +              &
8126                              emission_mass_fracs(n,6) * arhohno3 +            &
8127                              emission_mass_fracs(n,7) * arhonh3
8128          ENDDO   
8129!
8130!--       Emission unit
8131          CALL get_attribute( id_faero, 'units', unita, .FALSE.,               &
8132                              "aerosol_emission_values")
8133          conversion_factor = 1.0_wp
8134          IF  ( unita == 'kg/m2/yr' )  THEN
8135             conversion_factor = 3.170979e-8_wp / avg_density
8136          ELSEIF  ( unita == 'g/m2/yr' )  THEN
8137             conversion_factor = 3.170979e-8_wp * 1.0E-3_wp / avg_density
8138          ELSEIF  ( unita == 'kg/m2/s' )  THEN
8139             conversion_factor = 1.0_wp / avg_density
8140          ELSEIF  ( unita == 'g/m2/s' )  THEN
8141             conversion_factor = 1.0E-3_wp / avg_density
8142          ELSE
8143             message_string = 'unknown unit for aerosol emissions: '           &
8144                              // TRIM( unita ) // ' (lod1)'
8145             CALL message( 'salsa_mod: salsa_set_source','SA0035',             &
8146                           1, 2, 0, 6, 0 )
8147          ENDIF
8148!       
8149!--       Read surface emission data (x,y) PE-wise 
8150          ALLOCATE( pm_emission(ncat,nys:nyn,nxl:nxr) )
8151          CALL get_variable( id_faero, 'aerosol_emission_values', pm_emission, &
8152                             nxl, nxr, nys, nyn, 0, ncat-1 )
8153          DO  ni = 1, SIZE( eci )
8154             n = eci(ni)
8155!
8156!--          Calculate the number concentration of a log-normal size
8157!--          distribution following Jacobson (2005): Eq 13.25.
8158             ntot_table = 6.0_wp * PMfrac_table(:,n) / ( pi * dpg_table**3 *   &
8159                          EXP( 4.5_wp * LOG( sigmag_table )**2 ) ) * 1.0E+12_wp
8160!                         
8161!--          Sectional size distibution from a log-normal one                         
8162             CALL size_distribution( ntot_table, dpg_table, sigmag_table,      &
8163                                     nsect_emission )
8164             DO  b = 1, nbins
8165                aerosol_number(b)%source(ni,:,:) =                             &
8166                                    aerosol_number(b)%source(ni,:,:) +         &
8167                                    pm_emission(ni,:,:) * conversion_factor(n) &
8168                                    * nsect_emission(b) 
8169             ENDDO
8170          ENDDO
8171       ELSEIF ( lod_aero == 2 )  THEN             
8172!       
8173!--       Read surface emission data (x,y) PE-wise   
8174          ALLOCATE( dum_var_4d(nb_file,ncat,nys:nyn,nxl:nxr) )
8175          CALL get_variable( id_faero, 'aerosol_emission_values', dum_var_4d,  &
8176                             nxl, nxr, nys, nyn, 0, ncat-1, 0, nb_file-1 )
8177          DO  b = 1, nbins
8178             aerosol_number(b)%source = dum_var_4d(b,:,:,:)
8179          ENDDO
8180          DEALLOCATE( dum_var_4d )
8181       ENDIF
8182!   
8183!--    Set surface fluxes of aerosol number and mass on horizontal surfaces.
8184!--    Set fluxes only for either default, land or urban surface.
8185       IF ( .NOT. land_surface  .AND.  .NOT. urban_surface )  THEN
8186          CALL set_flux( surf_def_h(0), ncat )
8187       ELSE
8188          CALL set_flux( surf_usm_h, ncat )
8189          CALL set_flux( surf_lsm_h, ncat )
8190       ENDIF
8191         
8192    ELSEIF ( lod_aero == 3 )  THEN
8193!
8194!--    Inquire aerosol emission rate per bin (#/(m3s))
8195       nc_stat = NF90_INQ_VARID( id_faero, "aerosol_emission_values", id_sa )
8196 
8197!
8198!--    Emission time step
8199       CALL netcdf_data_input_get_dimension_length( id_faero, n_dt, 'dt_emission' ) 
8200       IF ( n_dt > 1 )  THEN
8201          CALL location_message( '    salsa_set_source: hourly emission data'//&
8202                                 ' provided but currently the value of the '// &
8203                                 ' first hour is applied.', .TRUE. )
8204       ENDIF
8205!
8206!--    Allocate source arrays
8207       DO  b = 1, nbins
8208          ALLOCATE( aerosol_number(b)%source(nzb:nzt+1,nys:nyn,nxl:nxr) )
8209          aerosol_number(b)%source = 0.0_wp
8210       ENDDO
8211       DO  c = 1, ncc_tot*nbins
8212          ALLOCATE( aerosol_mass(c)%source(nzb:nzt+1,nys:nyn,nxl:nxr) )
8213          aerosol_mass(c)%source = 0.0_wp
8214       ENDDO
8215!
8216!--    Get dimension of z-axis:     
8217       CALL netcdf_data_input_get_dimension_length( id_faero, nz_file, 'z' )
8218!       
8219!--    Read surface emission data (x,y) PE-wise             
8220       DO  i = nxl, nxr
8221          DO  j = nys, nyn
8222             DO  k = 0, nz_file-1
8223!
8224!--             Predetermine flag to mask topography                                 
8225                flag = MERGE( 1.0_wp, 0.0_wp, BTEST(wall_flags_0(k,j,i), 0 ))
8226!                                             
8227!--             No sources inside buildings !                                         
8228                IF ( flag == 0.0_wp )  CYCLE                         
8229!
8230!--             Read volume source:
8231                nc_stat = NF90_GET_VAR( id_faero, id_sa, source_ijka,          &
8232                                        start = (/ i+1, j+1, k+1, 1, 1 /),     &
8233                                        count = (/ 1, 1, 1, 1, nb_file /) )
8234                IF ( nc_stat /= NF90_NOERR )  THEN
8235                   message_string = 'error in aerosol emissions: lod3'
8236                   CALL message( 'salsa_mod: salsa_set_source','SA0038', 1, 2, &
8237                                 0, 6, 0 )
8238                ENDIF
8239!       
8240!--             Set mass fluxes.  First bins include only SO4 and/or OC. Call
8241!--             subroutine set_mass_source for larger bins.                           
8242!
8243!--             Sulphate and organic carbon
8244                IF ( iso4 > 0  .AND.  ioc > 0 ) THEN                 
8245!--                First sulphate:                     
8246                   ss = ( iso4 - 1 ) * nbins + in1a   ! start
8247                   ee = ( iso4 - 1 ) * nbins + fn1a   ! end
8248                   b = in1a           
8249                   DO  c = ss, ee
8250                      IF ( source_ijka(b) /= fillval )                         &
8251                      aerosol_mass(c)%source(k,j,i) =                          &
8252                         aerosol_mass(c)%source(k,j,i) +                       &
8253                         emission_mass_fracs(1,1) / ( emission_mass_fracs(1,1) &
8254                         + emission_mass_fracs(1,2) ) * source_ijka(b) *       &
8255                         aero(b)%core * arhoh2so4 
8256                      b = b+1
8257                   ENDDO                 
8258!--                Then organic carbon:                     
8259                   ss = ( ioc - 1 ) * nbins + in1a   ! start
8260                   ee = ( ioc - 1 ) * nbins + fn1a   ! end
8261                   b = in1a
8262                   DO  c = ss, ee 
8263                      IF ( source_ijka(b) /= fillval )                         &
8264                      aerosol_mass(c)%source(k,j,i) =                          &
8265                         aerosol_mass(c)%source(k,j,i) +                       &
8266                         emission_mass_fracs(1,2) / ( emission_mass_fracs(1,1) &
8267                         + emission_mass_fracs(1,2) ) * source_ijka(b) *       &
8268                         aero(b)%core * arhooc 
8269                      b = b+1
8270                   ENDDO
8271                   
8272                   CALL set_mass_source( k, j, i, iso4,                        &
8273                                        emission_mass_fracs(1,1), arhoh2so4,   &
8274                                        source_ijka, fillval )
8275                   CALL set_mass_source( k, j, i, ioc, emission_mass_fracs(1,2),&
8276                                         arhooc, source_ijka, fillval )                     
8277!--             Only sulphate:                                             
8278                ELSEIF ( iso4 > 0  .AND.  ioc < 0 ) THEN                   
8279                   ss = ( iso4 - 1 ) * nbins + in1a   ! start
8280                   ee = ( iso4 - 1 ) * nbins + fn1a   ! end
8281                   b = in1a           
8282                   DO  c = ss, ee
8283                      IF ( source_ijka(b) /= fillval )                         &
8284                      aerosol_mass(c)%source(k,j,i) =                          &
8285                         aerosol_mass(c)%source(k,j,i) + source_ijka(b) *      &
8286                         aero(b)%core * arhoh2so4 
8287                      b = b+1
8288                   ENDDO 
8289                   CALL set_mass_source( k, j, i, iso4,                        &
8290                                        emission_mass_fracs(1,1), arhoh2so4,   &
8291                                        source_ijka, fillval )   
8292!--             Only organic carbon:                                           
8293                ELSEIF ( iso4 < 0  .AND.  ioc > 0 ) THEN                   
8294                   ss = ( ioc - 1 ) * nbins + in1a   ! start
8295                   ee = ( ioc - 1 ) * nbins + fn1a   ! end
8296                   b = in1a
8297                   DO  c = ss, ee 
8298                      IF ( source_ijka(b) /= fillval )                         &
8299                      aerosol_mass(c)%source(k,j,i) =                          &
8300                         aerosol_mass(c)%source(k,j,i) + source_ijka(b)  *     &
8301                         aero(b)%core * arhooc 
8302                      b = b+1
8303                   ENDDO 
8304                   CALL set_mass_source( k, j, i, ioc, emission_mass_fracs(1,2),&
8305                                         arhooc,  source_ijka, fillval )                                   
8306                ENDIF
8307!--             Black carbon
8308                IF ( ibc > 0 ) THEN
8309                   CALL set_mass_source( k, j, i, ibc, emission_mass_fracs(1,3),&
8310                                         arhobc, source_ijka, fillval )
8311                ENDIF
8312!--             Dust
8313                IF ( idu > 0 ) THEN
8314                   CALL set_mass_source( k, j, i, idu, emission_mass_fracs(1,4),&
8315                                         arhodu, source_ijka, fillval )
8316                ENDIF
8317!--             Sea salt
8318                IF ( iss > 0 ) THEN
8319                   CALL set_mass_source( k, j, i, iss, emission_mass_fracs(1,5),&
8320                                         arhoss, source_ijka, fillval )
8321                ENDIF
8322!--             Nitric acid
8323                IF ( ino > 0 ) THEN
8324                   CALL set_mass_source( k, j, i, ino, emission_mass_fracs(1,6),&
8325                                         arhohno3, source_ijka, fillval )
8326                ENDIF
8327!--             Ammonia
8328                IF ( inh > 0 ) THEN
8329                   CALL set_mass_source( k, j, i, inh, emission_mass_fracs(1,7),&
8330                                         arhonh3, source_ijka, fillval )
8331                ENDIF
8332!                             
8333!--             Save aerosol number sources in the end                           
8334                DO  b = 1, nbins
8335                   IF ( source_ijka(b) /= fillval )                            &
8336                   aerosol_number(b)%source(k,j,i) =                           &
8337                      aerosol_number(b)%source(k,j,i) + source_ijka(b)
8338                ENDDO                     
8339             ENDDO    ! k
8340          ENDDO    ! j
8341       ENDDO    ! i
8342
8343    ELSE     
8344       message_string = 'NetCDF attribute lod is not set properly.'
8345       CALL message( 'salsa_mod: salsa_set_source','SA0026', 1, 2, 0, 6, 0 )
8346    ENDIF 
8347 
8348#endif   
8349 END SUBROUTINE salsa_set_source
8350 
8351!------------------------------------------------------------------------------!
8352! Description:
8353! ------------
8354!> Sets the gaseous fluxes
8355!------------------------------------------------------------------------------!
8356 SUBROUTINE set_gas_flux( surface, ncat_emission, unit )
8357 
8358    USE arrays_3d,                                                             &
8359        ONLY: dzw, hyp, pt, rho_air_zw
8360       
8361    USE grid_variables,                                                        &
8362        ONLY:  dx, dy
8363 
8364    USE surface_mod,                                                           &
8365        ONLY:  surf_type
8366   
8367    IMPLICIT NONE
8368   
8369    CHARACTER(LEN=*) ::  unit       !< flux unit in the input file 
8370    INTEGER(iwp) ::  ncat_emission  !< number of emission categories
8371    TYPE(surf_type), INTENT(inout) :: surface  !< respective surface type
8372    INTEGER(iwp) ::  g   !< loop index
8373    INTEGER(iwp) ::  i   !< loop index
8374    INTEGER(iwp) ::  j   !< loop index
8375    INTEGER(iwp) ::  k   !< loop index
8376    INTEGER(iwp) ::  m   !< running index for surface elements
8377    INTEGER(iwp) ::  n   !< running index for emission categories
8378    REAL(wp), DIMENSION(ngast) ::  conversion_factor 
8379   
8380    conversion_factor = 1.0_wp
8381   
8382    DO  m = 1, surface%ns
8383!
8384!--    Get indices of respective grid point
8385       i = surface%i(m)
8386       j = surface%j(m)
8387       k = surface%k(m)
8388       
8389       IF ( unit == '#/m2/s' )  THEN
8390          conversion_factor = 1.0_wp
8391       ELSEIF ( unit == 'g/m2/s' )  THEN
8392          conversion_factor(1) = avo / ( amh2so4 * 1000.0_wp )
8393          conversion_factor(2) = avo / ( amhno3 * 1000.0_wp )
8394          conversion_factor(3) = avo / ( amnh3 * 1000.0_wp )
8395          conversion_factor(4) = avo / ( amoc * 1000.0_wp )
8396          conversion_factor(5) = avo / ( amoc * 1000.0_wp )
8397       ELSEIF ( unit == 'ppm/m2/s' )  THEN
8398          conversion_factor = for_ppm_to_nconc * hyp(k) / pt(k,j,i) * ( hyp(k) &
8399                              / 100000.0_wp )**0.286_wp * dx * dy * dzw(k)
8400       ELSEIF ( unit == 'mumol/m2/s' )  THEN
8401          conversion_factor = 1.0E-6_wp * avo
8402       ELSE
8403          message_string = 'Unknown unit for gaseous emissions!'
8404          CALL message( 'salsa_mod: set_gas_flux', 'SA0031', 1, 2, 0, 6, 0 )
8405       ENDIF
8406       
8407       DO  n = 1, ncat_emission
8408          DO  g = 1, ngast
8409             IF ( .NOT. salsa_gas(g)%source(n,j,i) > 0.0_wp )  THEN
8410                salsa_gas(g)%source(n,j,i) = 0.0_wp
8411                CYCLE
8412             ENDIF
8413             surface%gtsws(m,g) = surface%gtsws(m,g) +                         &
8414                                  salsa_gas(g)%source(n,j,i) * rho_air_zw(k-1) &
8415                                  * conversion_factor(g)
8416          ENDDO
8417       ENDDO
8418    ENDDO
8419   
8420 END SUBROUTINE set_gas_flux 
8421 
8422 
8423!------------------------------------------------------------------------------!
8424! Description:
8425! ------------
8426!> Sets the aerosol flux to aerosol arrays in 2a and 2b.
8427!------------------------------------------------------------------------------!
8428 SUBROUTINE set_flux( surface, ncat_emission )
8429 
8430    USE arrays_3d,                                                             &
8431        ONLY: hyp, pt, rho_air_zw
8432 
8433    USE surface_mod,                                                           &
8434        ONLY:  surf_type
8435   
8436    IMPLICIT NONE
8437
8438    INTEGER(iwp) ::  ncat_emission  !< number of emission categories
8439    TYPE(surf_type), INTENT(inout) :: surface  !< respective surface type
8440    INTEGER(iwp) ::  b  !< loop index
8441    INTEGER(iwp) ::  ee  !< loop index
8442    INTEGER(iwp) ::  g   !< loop index
8443    INTEGER(iwp) ::  i   !< loop index
8444    INTEGER(iwp) ::  j   !< loop index
8445    INTEGER(iwp) ::  k   !< loop index
8446    INTEGER(iwp) ::  m   !< running index for surface elements
8447    INTEGER(iwp) ::  n   !< loop index for emission categories
8448    INTEGER(iwp) ::  c   !< loop index
8449    INTEGER(iwp) ::  ss  !< loop index
8450   
8451    DO  m = 1, surface%ns
8452!
8453!--    Get indices of respective grid point
8454       i = surface%i(m)
8455       j = surface%j(m)
8456       k = surface%k(m)
8457       
8458       DO  n = 1, ncat_emission 
8459          DO  b = 1, nbins
8460             IF (  aerosol_number(b)%source(n,j,i) < 0.0_wp )  THEN
8461                aerosol_number(b)%source(n,j,i) = 0.0_wp
8462                CYCLE
8463             ENDIF
8464!       
8465!--          Set mass fluxes.  First bins include only SO4 and/or OC.     
8466
8467             IF ( b <= fn1a )  THEN
8468!
8469!--             Both sulphate and organic carbon
8470                IF ( iso4 > 0  .AND.  ioc > 0 )  THEN
8471               
8472                   c = ( iso4 - 1 ) * nbins + b   
8473                   surface%amsws(m,c) = surface%amsws(m,c) +                   &
8474                                        emission_mass_fracs(n,1) /             &
8475                                        ( emission_mass_fracs(n,1) +           &
8476                                          emission_mass_fracs(n,2) ) *         &
8477                                          aerosol_number(b)%source(n,j,i) *    &
8478                                          api6 * aero(b)%dmid**3.0_wp *        &
8479                                          arhoh2so4 * rho_air_zw(k-1)
8480                   aerosol_mass(c)%source(n,j,i) =                             &
8481                              aerosol_mass(c)%source(n,j,i) + surface%amsws(m,c)
8482                   c = ( ioc - 1 ) * nbins + b   
8483                   surface%amsws(m,c) = surface%amsws(m,c) +                   &
8484                                        emission_mass_fracs(n,2) /             &
8485                                        ( emission_mass_fracs(n,1) +           & 
8486                                          emission_mass_fracs(n,2) ) *         &
8487                                          aerosol_number(b)%source(n,j,i) *    &
8488                                          api6 * aero(b)%dmid**3.0_wp * arhooc &
8489                                          * rho_air_zw(k-1)
8490                   aerosol_mass(c)%source(n,j,i) =                             &
8491                              aerosol_mass(c)%source(n,j,i) + surface%amsws(m,c)
8492!
8493!--             Only sulphates
8494                ELSEIF ( iso4 > 0  .AND.  ioc < 0 )  THEN
8495                   c = ( iso4 - 1 ) * nbins + b   
8496                   surface%amsws(m,c) = surface%amsws(m,c) +                   &
8497                                        aerosol_number(b)%source(n,j,i) * api6 &
8498                                        * aero(b)%dmid**3.0_wp * arhoh2so4     &
8499                                        * rho_air_zw(k-1)
8500                   aerosol_mass(c)%source(n,j,i) =                             &
8501                              aerosol_mass(c)%source(n,j,i) + surface%amsws(m,c)
8502!             
8503!--             Only organic carbon             
8504                ELSEIF ( iso4 < 0  .AND.  ioc > 0 )  THEN
8505                   c = ( ioc - 1 ) * nbins + b   
8506                   surface%amsws(m,c) = surface%amsws(m,c) +                   &
8507                                        aerosol_number(b)%source(n,j,i) * api6 &
8508                                        * aero(b)%dmid**3.0_wp * arhooc        &
8509                                        * rho_air_zw(k-1)
8510                   aerosol_mass(c)%source(n,j,i) =                             &
8511                              aerosol_mass(c)%source(n,j,i) + surface%amsws(m,c)
8512                ENDIF
8513               
8514             ELSEIF ( b > fn1a )  THEN
8515!
8516!--             Sulphate
8517                IF ( iso4 > 0 )  THEN
8518                   CALL set_mass_flux( surface, m, b, iso4, n,                 &
8519                                       emission_mass_fracs(n,1), arhoh2so4,    &
8520                                       aerosol_number(b)%source(n,j,i) )
8521                ENDIF 
8522!             
8523!--             Organic carbon                 
8524                IF ( ioc > 0 )  THEN         
8525                  CALL set_mass_flux( surface, m, b, ioc, n,                   &
8526                                      emission_mass_fracs(n,2), arhooc,        &
8527                                      aerosol_number(b)%source(n,j,i) )
8528                ENDIF
8529!
8530!--             Black carbon
8531                IF ( ibc > 0 )  THEN
8532                   CALL set_mass_flux( surface, m, b, ibc, n,                  &
8533                                       emission_mass_fracs(n,3), arhobc,       &
8534                                       aerosol_number(b)%source(n,j,i) )
8535                ENDIF
8536!
8537!--             Dust
8538                IF ( idu > 0 )  THEN
8539                   CALL set_mass_flux( surface, m, b, idu, n,                  &
8540                                       emission_mass_fracs(n,4), arhodu,       &
8541                                       aerosol_number(b)%source(n,j,i) )
8542                ENDIF
8543!
8544!--             Sea salt
8545                IF ( iss > 0 )  THEN
8546                   CALL set_mass_flux( surface, m, b, iss, n,                  &
8547                                       emission_mass_fracs(n,5), arhoss,       &
8548                                       aerosol_number(b)%source(n,j,i) )
8549                ENDIF
8550!
8551!--             Nitric acid
8552                IF ( ino > 0 )  THEN
8553                   CALL set_mass_flux( surface, m, b, ino, n,                  &
8554                                       emission_mass_fracs(n,6), arhohno3,     &
8555                                       aerosol_number(b)%source(n,j,i) )
8556                ENDIF
8557!
8558!--             Ammonia
8559                IF ( inh > 0 )  THEN
8560                   CALL set_mass_flux( surface, m, b, inh, n,                  &
8561                                       emission_mass_fracs(n,7), arhonh3,      &
8562                                       aerosol_number(b)%source(n,j,i) )
8563                ENDIF
8564               
8565             ENDIF
8566!             
8567!--          Save number fluxes in the end
8568             surface%answs(m,b) = surface%answs(m,b) +                         &
8569                               aerosol_number(b)%source(n,j,i) * rho_air_zw(k-1)
8570             aerosol_number(b)%source(n,j,i) = surface%answs(m,b)
8571          ENDDO
8572       
8573       ENDDO
8574       
8575    ENDDO
8576   
8577 END SUBROUTINE set_flux 
8578 
8579!------------------------------------------------------------------------------!
8580! Description:
8581! ------------
8582!> Sets the mass emissions to aerosol arrays in 2a and 2b.
8583!------------------------------------------------------------------------------!
8584 SUBROUTINE set_mass_flux( surface, surf_num, b, ispec, n, mass_frac, prho,    &
8585                           nsource )
8586                           
8587    USE arrays_3d,                                                             &
8588        ONLY:  rho_air_zw
8589
8590    USE surface_mod,                                                           &
8591        ONLY:  surf_type
8592   
8593    IMPLICIT NONE
8594
8595    INTEGER(iwp), INTENT(in) :: b         !< Aerosol size bin index
8596    INTEGER(iwp), INTENT(in) :: ispec     !< Aerosol species index
8597    INTEGER(iwp), INTENT(in) :: n         !< emission category number   
8598    INTEGER(iwp), INTENT(in) :: surf_num  !< index surface elements
8599    REAL(wp), INTENT(in) ::  mass_frac    !< mass fraction of a chemical
8600                                          !< compound in all bins
8601    REAL(wp), INTENT(in) ::  nsource      !< number source (#/m2/s)
8602    REAL(wp), INTENT(in) ::  prho         !< Aerosol density
8603    TYPE(surf_type), INTENT(inout) ::  surface  !< respective surface type
8604     
8605    INTEGER(iwp) ::  ee !< index: end
8606    INTEGER(iwp) ::  i  !< loop index
8607    INTEGER(iwp) ::  j  !< loop index
8608    INTEGER(iwp) ::  k  !< loop index
8609    INTEGER(iwp) ::  c  !< loop index
8610    INTEGER(iwp) ::  ss !<index: start
8611   
8612!
8613!-- Get indices of respective grid point
8614    i = surface%i(surf_num)
8615    j = surface%j(surf_num)
8616    k = surface%k(surf_num)
8617!         
8618!-- Subrange 2a:
8619    c = ( ispec - 1 ) * nbins + b
8620    surface%amsws(surf_num,c) = surface%amsws(surf_num,c) + mass_frac * nsource&
8621                                * aero(b)%core * prho * rho_air_zw(k-1)
8622    aerosol_mass(c)%source(n,j,i) = aerosol_mass(c)%source(n,j,i) +            &
8623                                    surface%amsws(surf_num,c)
8624!         
8625!-- Subrange 2b:
8626    IF ( .NOT. no_insoluble )  THEN
8627       WRITE(*,*) 'All emissions are soluble!'
8628    ENDIF
8629   
8630 END SUBROUTINE set_mass_flux
8631 
8632!------------------------------------------------------------------------------!
8633! Description:
8634! ------------
8635!> Sets the mass sources to aerosol arrays in 2a and 2b.
8636!------------------------------------------------------------------------------!
8637 SUBROUTINE set_mass_source( k, j, i,  ispec, mass_frac, prho, nsource, fillval )
8638
8639    USE surface_mod,                                                           &
8640        ONLY:  surf_type
8641   
8642    IMPLICIT NONE
8643   
8644    INTEGER(iwp), INTENT(in) :: ispec     !< Aerosol species index
8645    REAL(wp), INTENT(in) ::  fillval      !< _FillValue in the NetCDF file
8646    REAL(wp), INTENT(in) ::  mass_frac    !< mass fraction of a chemical
8647                                          !< compound in all bins 
8648    REAL(wp), INTENT(in), DIMENSION(:) ::  nsource  !< number source
8649    REAL(wp), INTENT(in) ::  prho         !< Aerosol density
8650   
8651    INTEGER(iwp) ::  b !< loop index   
8652    INTEGER(iwp) ::  ee !< index: end
8653    INTEGER(iwp) ::  i  !< loop index
8654    INTEGER(iwp) ::  j  !< loop index
8655    INTEGER(iwp) ::  k  !< loop index
8656    INTEGER(iwp) ::  c  !< loop index
8657    INTEGER(iwp) ::  ss !<index: start
8658!         
8659!-- Subrange 2a:
8660    ss = ( ispec - 1 ) * nbins + in2a
8661    ee = ( ispec - 1 ) * nbins + fn2a
8662    b = in2a
8663    DO c = ss, ee
8664       IF ( nsource(b) /= fillval )  THEN
8665          aerosol_mass(c)%source(k,j,i) = aerosol_mass(c)%source(k,j,i) +      &
8666                                       mass_frac * nsource(b) * aero(b)%core * &
8667                                       prho 
8668       ENDIF
8669       b = b+1
8670    ENDDO
8671!         
8672!-- Subrange 2b:
8673    IF ( .NOT. no_insoluble )  THEN
8674       WRITE(*,*) 'All sources are soluble!'
8675    ENDIF
8676   
8677 END SUBROUTINE set_mass_source 
8678 
8679!------------------------------------------------------------------------------!
8680! Description:
8681! ------------
8682!> Check data output for salsa.
8683!------------------------------------------------------------------------------!
8684 SUBROUTINE salsa_check_data_output( var, unit )
8685 
8686    USE control_parameters,                                                    &
8687        ONLY:  message_string
8688
8689    IMPLICIT NONE
8690
8691    CHARACTER (LEN=*) ::  unit     !<
8692    CHARACTER (LEN=*) ::  var      !<
8693
8694    SELECT CASE ( TRIM( var ) )
8695         
8696       CASE ( 'g_H2SO4', 'g_HNO3', 'g_NH3', 'g_OCNV',  'g_OCSV',               &
8697              'N_bin1', 'N_bin2', 'N_bin3', 'N_bin4',  'N_bin5',  'N_bin6',    &
8698              'N_bin7', 'N_bin8', 'N_bin9', 'N_bin10', 'N_bin11', 'N_bin12',   &
8699              'Ntot' )
8700          IF (  .NOT.  salsa )  THEN
8701             message_string = 'output of "' // TRIM( var ) // '" requi' //  &
8702                       'res salsa = .TRUE.'
8703             CALL message( 'check_parameters', 'SA0006', 1, 2, 0, 6, 0 )
8704          ENDIF
8705          unit = '#/m3'
8706         
8707       CASE ( 'LDSA' )
8708          IF (  .NOT.  salsa )  THEN
8709             message_string = 'output of "' // TRIM( var ) // '" requi' //  &
8710                       'res salsa = .TRUE.'
8711             CALL message( 'check_parameters', 'SA0003', 1, 2, 0, 6, 0 )
8712          ENDIF
8713          unit = 'mum2/cm3'         
8714         
8715       CASE ( 'm_bin1', 'm_bin2', 'm_bin3', 'm_bin4',  'm_bin5',  'm_bin6',    &
8716              'm_bin7', 'm_bin8', 'm_bin9', 'm_bin10', 'm_bin11', 'm_bin12',   &
8717              'PM2.5',  'PM10',   's_BC',   's_DU',    's_H2O',   's_NH',      &
8718              's_NO',   's_OC',   's_SO4',  's_SS' )
8719          IF (  .NOT.  salsa )  THEN
8720             message_string = 'output of "' // TRIM( var ) // '" requi' //  &
8721                       'res salsa = .TRUE.'
8722             CALL message( 'check_parameters', 'SA0001', 1, 2, 0, 6, 0 )
8723          ENDIF
8724          unit = 'kg/m3'
8725             
8726       CASE DEFAULT
8727          unit = 'illegal'
8728
8729    END SELECT
8730
8731 END SUBROUTINE salsa_check_data_output
8732 
8733!------------------------------------------------------------------------------!
8734!
8735! Description:
8736! ------------
8737!> Subroutine for averaging 3D data
8738!------------------------------------------------------------------------------!
8739 SUBROUTINE salsa_3d_data_averaging( mode, variable )
8740 
8741
8742    USE control_parameters
8743
8744    USE indices
8745
8746    USE kinds
8747
8748    IMPLICIT NONE
8749
8750    CHARACTER (LEN=*) ::  mode       !<
8751    CHARACTER (LEN=*) ::  variable   !<
8752
8753    INTEGER(iwp) ::  b   !<     
8754    INTEGER(iwp) ::  c   !<
8755    INTEGER(iwp) ::  i   !<
8756    INTEGER(iwp) ::  icc !<
8757    INTEGER(iwp) ::  j   !<
8758    INTEGER(iwp) ::  k   !<
8759   
8760    REAL(wp) ::  df       !< For calculating LDSA: fraction of particles
8761                          !< depositing in the alveolar (or tracheobronchial)
8762                          !< region of the lung. Depends on the particle size
8763    REAL(wp) ::  mean_d   !< Particle diameter in micrometres
8764    REAL(wp) ::  nc       !< Particle number concentration in units 1/cm**3
8765    REAL(wp) ::  temp_bin !<
8766    REAL(wp), DIMENSION(:,:,:), POINTER ::  to_be_resorted  !< points to
8767                                                     !< selected output variable
8768   
8769    temp_bin = 0.0_wp
8770
8771    IF ( mode == 'allocate' )  THEN
8772
8773       SELECT CASE ( TRIM( variable ) )
8774       
8775          CASE ( 'g_H2SO4' )
8776             IF ( .NOT. ALLOCATED( g_H2SO4_av ) )  THEN
8777                ALLOCATE( g_H2SO4_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
8778             ENDIF
8779             g_H2SO4_av = 0.0_wp
8780             
8781          CASE ( 'g_HNO3' )
8782             IF ( .NOT. ALLOCATED( g_HNO3_av ) )  THEN
8783                ALLOCATE( g_HNO3_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
8784             ENDIF
8785             g_HNO3_av = 0.0_wp
8786             
8787          CASE ( 'g_NH3' )
8788             IF ( .NOT. ALLOCATED( g_NH3_av ) )  THEN
8789                ALLOCATE( g_NH3_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
8790             ENDIF
8791             g_NH3_av = 0.0_wp
8792             
8793          CASE ( 'g_OCNV' )
8794             IF ( .NOT. ALLOCATED( g_OCNV_av ) )  THEN
8795                ALLOCATE( g_OCNV_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
8796             ENDIF
8797             g_OCNV_av = 0.0_wp
8798             
8799          CASE ( 'g_OCSV' )
8800             IF ( .NOT. ALLOCATED( g_OCSV_av ) )  THEN
8801                ALLOCATE( g_OCSV_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
8802             ENDIF
8803             g_OCSV_av = 0.0_wp             
8804             
8805          CASE ( 'LDSA' )
8806             IF ( .NOT. ALLOCATED( LDSA_av ) )  THEN
8807                ALLOCATE( LDSA_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
8808             ENDIF
8809             LDSA_av = 0.0_wp
8810             
8811          CASE ( 'N_bin1', 'N_bin2', 'N_bin3', 'N_bin4', 'N_bin5', 'N_bin6',   &
8812                 'N_bin7', 'N_bin8', 'N_bin9', 'N_bin10', 'N_bin11', 'N_bin12' )
8813             IF ( .NOT. ALLOCATED( Nbins_av ) )  THEN
8814                ALLOCATE( Nbins_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg,nbins) )
8815             ENDIF
8816             Nbins_av = 0.0_wp
8817             
8818          CASE ( 'Ntot' )
8819             IF ( .NOT. ALLOCATED( Ntot_av ) )  THEN
8820                ALLOCATE( Ntot_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
8821             ENDIF
8822             Ntot_av = 0.0_wp
8823             
8824          CASE ( 'm_bin1', 'm_bin2', 'm_bin3', 'm_bin4', 'm_bin5', 'm_bin6',   &
8825                 'm_bin7', 'm_bin8', 'm_bin9', 'm_bin10', 'm_bin11', 'm_bin12' )
8826             IF ( .NOT. ALLOCATED( mbins_av ) )  THEN
8827                ALLOCATE( mbins_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg,nbins) )
8828             ENDIF
8829             mbins_av = 0.0_wp
8830             
8831          CASE ( 'PM2.5' )
8832             IF ( .NOT. ALLOCATED( PM25_av ) )  THEN
8833                ALLOCATE( PM25_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
8834             ENDIF
8835             PM25_av = 0.0_wp
8836             
8837          CASE ( 'PM10' )
8838             IF ( .NOT. ALLOCATED( PM10_av ) )  THEN
8839                ALLOCATE( PM10_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
8840             ENDIF
8841             PM10_av = 0.0_wp
8842             
8843          CASE ( 's_BC' )
8844             IF ( .NOT. ALLOCATED( s_BC_av ) )  THEN
8845                ALLOCATE( s_BC_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
8846             ENDIF
8847             s_BC_av = 0.0_wp
8848         
8849          CASE ( 's_DU' )
8850             IF ( .NOT. ALLOCATED( s_DU_av ) )  THEN
8851                ALLOCATE( s_DU_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
8852             ENDIF
8853             s_DU_av = 0.0_wp
8854             
8855          CASE ( 's_H2O' )
8856             IF ( .NOT. ALLOCATED( s_H2O_av ) )  THEN
8857                ALLOCATE( s_H2O_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
8858             ENDIF
8859             s_H2O_av = 0.0_wp
8860             
8861          CASE ( 's_NH' )
8862             IF ( .NOT. ALLOCATED( s_NH_av ) )  THEN
8863                ALLOCATE( s_NH_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
8864             ENDIF
8865             s_NH_av = 0.0_wp
8866             
8867          CASE ( 's_NO' )
8868             IF ( .NOT. ALLOCATED( s_NO_av ) )  THEN
8869                ALLOCATE( s_NO_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
8870             ENDIF
8871             s_NO_av = 0.0_wp
8872             
8873          CASE ( 's_OC' )
8874             IF ( .NOT. ALLOCATED( s_OC_av ) )  THEN
8875                ALLOCATE( s_OC_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
8876             ENDIF
8877             s_OC_av = 0.0_wp
8878             
8879          CASE ( 's_SO4' )
8880             IF ( .NOT. ALLOCATED( s_SO4_av ) )  THEN
8881                ALLOCATE( s_SO4_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
8882             ENDIF
8883             s_SO4_av = 0.0_wp   
8884         
8885          CASE ( 's_SS' )
8886             IF ( .NOT. ALLOCATED( s_SS_av ) )  THEN
8887                ALLOCATE( s_SS_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
8888             ENDIF
8889             s_SS_av = 0.0_wp
8890         
8891          CASE DEFAULT
8892             CONTINUE
8893
8894       END SELECT
8895
8896    ELSEIF ( mode == 'sum' )  THEN
8897
8898       SELECT CASE ( TRIM( variable ) )
8899       
8900          CASE ( 'g_H2SO4', 'g_HNO3', 'g_NH3', 'g_OCNV', 'g_OCSV' )
8901             IF ( TRIM( variable(3:) ) == 'H2SO4' )  THEN
8902                icc = 1
8903                to_be_resorted => g_H2SO4_av
8904             ELSEIF ( TRIM( variable(3:) ) == 'HNO3' )  THEN
8905                icc = 2
8906                to_be_resorted => g_HNO3_av   
8907             ELSEIF ( TRIM( variable(3:) ) == 'NH3' )  THEN
8908                icc = 3
8909                to_be_resorted => g_NH3_av   
8910             ELSEIF ( TRIM( variable(3:) ) == 'OCNV' )  THEN
8911                icc = 4
8912                to_be_resorted => g_OCNV_av   
8913             ELSEIF ( TRIM( variable(3:) ) == 'OCSV' )  THEN
8914                icc = 5
8915                to_be_resorted => g_OCSV_av       
8916             ENDIF
8917             DO  i = nxlg, nxrg
8918                DO  j = nysg, nyng
8919                   DO  k = nzb, nzt+1
8920                      to_be_resorted(k,j,i) = to_be_resorted(k,j,i) +         &
8921                                              salsa_gas(icc)%conc(k,j,i)
8922                   ENDDO
8923                ENDDO
8924             ENDDO
8925             
8926          CASE ( 'LDSA' )
8927             DO  i = nxlg, nxrg
8928                DO  j = nysg, nyng
8929                   DO  k = nzb, nzt+1
8930                      temp_bin = 0.0_wp
8931                      DO  b = 1, nbins 
8932!                     
8933!--                      Diameter in micrometres
8934                         mean_d = 1.0E+6_wp * Ra_dry(k,j,i,b) * 2.0_wp
8935!                               
8936!--                      Deposition factor: alveolar (use Ra_dry)                             
8937                         df = ( 0.01555_wp / mean_d ) * ( EXP( -0.416_wp *     &
8938                                ( LOG( mean_d ) + 2.84_wp )**2.0_wp )          &
8939                                  + 19.11_wp * EXP( -0.482_wp *                &
8940                                  ( LOG( mean_d ) - 1.362_wp )**2.0_wp ) )
8941!                                   
8942!--                      Number concentration in 1/cm3
8943                         nc = 1.0E-6_wp * aerosol_number(b)%conc(k,j,i)   
8944!                         
8945!--                      Lung-deposited surface area LDSA (units mum2/cm3)                           
8946                         temp_bin = temp_bin + pi * mean_d**2.0_wp * df * nc
8947                      ENDDO
8948                      LDSA_av(k,j,i) = LDSA_av(k,j,i) + temp_bin
8949                   ENDDO
8950                ENDDO
8951             ENDDO
8952             
8953          CASE ( 'N_bin1', 'N_bin2', 'N_bin3', 'N_bin4', 'N_bin5', 'N_bin6',   &
8954                 'N_bin7', 'N_bin8', 'N_bin9', 'N_bin10', 'N_bin11', 'N_bin12' )
8955             DO  i = nxlg, nxrg
8956                DO  j = nysg, nyng
8957                   DO  k = nzb, nzt+1
8958                      DO  b = 1, nbins 
8959                         Nbins_av(k,j,i,b) = Nbins_av(k,j,i,b) +               &
8960                                             aerosol_number(b)%conc(k,j,i)
8961                      ENDDO
8962                   ENDDO
8963                ENDDO
8964             ENDDO
8965         
8966          CASE ( 'Ntot' )
8967             DO  i = nxlg, nxrg
8968                DO  j = nysg, nyng
8969                   DO  k = nzb, nzt+1
8970                      DO  b = 1, nbins 
8971                         Ntot_av(k,j,i) = Ntot_av(k,j,i) +                     &
8972                                          aerosol_number(b)%conc(k,j,i)
8973                      ENDDO
8974                   ENDDO
8975                ENDDO
8976             ENDDO
8977             
8978          CASE ( 'm_bin1', 'm_bin2', 'm_bin3', 'm_bin4', 'm_bin5', 'm_bin6',   &
8979                 'm_bin7', 'm_bin8', 'm_bin9', 'm_bin10', 'm_bin11', 'm_bin12' )
8980             DO  i = nxlg, nxrg
8981                DO  j = nysg, nyng
8982                   DO  k = nzb, nzt+1
8983                      DO  b = 1, nbins 
8984                         DO  c = b, nbins*ncc_tot, nbins
8985                            mbins_av(k,j,i,b) = mbins_av(k,j,i,b) +            &
8986                                                aerosol_mass(c)%conc(k,j,i)
8987                         ENDDO
8988                      ENDDO
8989                   ENDDO
8990                ENDDO
8991             ENDDO
8992             
8993          CASE ( 'PM2.5' )
8994             DO  i = nxlg, nxrg
8995                DO  j = nysg, nyng
8996                   DO  k = nzb, nzt+1
8997                      temp_bin = 0.0_wp
8998                      DO  b = 1, nbins
8999                         IF ( 2.0_wp * Ra_dry(k,j,i,b) <= 2.5E-6_wp )  THEN
9000                            DO  c = b, nbins*ncc, nbins
9001                               temp_bin = temp_bin + aerosol_mass(c)%conc(k,j,i)
9002                            ENDDO
9003                         ENDIF
9004                      ENDDO
9005                      PM25_av(k,j,i) = PM25_av(k,j,i) + temp_bin
9006                   ENDDO
9007                ENDDO
9008             ENDDO
9009             
9010          CASE ( 'PM10' )
9011             DO  i = nxlg, nxrg
9012                DO  j = nysg, nyng
9013                   DO  k = nzb, nzt+1
9014                      temp_bin = 0.0_wp
9015                      DO  b = 1, nbins
9016                         IF ( 2.0_wp * Ra_dry(k,j,i,b) <= 10.0E-6_wp )  THEN
9017                            DO  c = b, nbins*ncc, nbins
9018                               temp_bin = temp_bin + aerosol_mass(c)%conc(k,j,i)
9019                            ENDDO
9020                         ENDIF
9021                      ENDDO
9022                      PM10_av(k,j,i) = PM10_av(k,j,i) + temp_bin
9023                   ENDDO
9024                ENDDO
9025             ENDDO
9026             
9027          CASE ( 's_BC', 's_DU', 's_H2O', 's_NH', 's_NO', 's_OC', 's_SO4',     &
9028                 's_SS' )
9029             IF ( is_used( prtcl, TRIM( variable(3:) ) ) )  THEN
9030                icc = get_index( prtcl, TRIM( variable(3:) ) )
9031                IF ( TRIM( variable(3:) ) == 'BC' )   to_be_resorted => s_BC_av
9032                IF ( TRIM( variable(3:) ) == 'DU' )   to_be_resorted => s_DU_av   
9033                IF ( TRIM( variable(3:) ) == 'NH' )   to_be_resorted => s_NH_av   
9034                IF ( TRIM( variable(3:) ) == 'NO' )   to_be_resorted => s_NO_av   
9035                IF ( TRIM( variable(3:) ) == 'OC' )   to_be_resorted => s_OC_av   
9036                IF ( TRIM( variable(3:) ) == 'SO4' )  to_be_resorted => s_SO4_av   
9037                IF ( TRIM( variable(3:) ) == 'SS' )   to_be_resorted => s_SS_av       
9038                DO  i = nxlg, nxrg
9039                   DO  j = nysg, nyng
9040                      DO  k = nzb, nzt+1
9041                         DO  c = ( icc-1 )*nbins+1, icc*nbins 
9042                            to_be_resorted(k,j,i) = to_be_resorted(k,j,i) +    &
9043                                                    aerosol_mass(c)%conc(k,j,i)
9044                         ENDDO
9045                      ENDDO
9046                   ENDDO
9047                ENDDO
9048             ENDIF
9049             
9050          CASE DEFAULT
9051             CONTINUE
9052
9053       END SELECT
9054
9055    ELSEIF ( mode == 'average' )  THEN
9056
9057       SELECT CASE ( TRIM( variable ) )
9058       
9059          CASE ( 'g_H2SO4', 'g_HNO3', 'g_NH3', 'g_OCNV', 'g_OCSV' )
9060             IF ( TRIM( variable(3:) ) == 'H2SO4' )  THEN
9061                icc = 1
9062                to_be_resorted => g_H2SO4_av
9063             ELSEIF ( TRIM( variable(3:) ) == 'HNO3' )  THEN
9064                icc = 2
9065                to_be_resorted => g_HNO3_av   
9066             ELSEIF ( TRIM( variable(3:) ) == 'NH3' )  THEN
9067                icc = 3
9068                to_be_resorted => g_NH3_av   
9069             ELSEIF ( TRIM( variable(3:) ) == 'OCNV' )  THEN
9070                icc = 4
9071                to_be_resorted => g_OCNV_av   
9072             ELSEIF ( TRIM( variable(3:) ) == 'OCSV' )  THEN
9073                icc = 5
9074                to_be_resorted => g_OCSV_av       
9075             ENDIF
9076             DO  i = nxlg, nxrg
9077                DO  j = nysg, nyng
9078                   DO  k = nzb, nzt+1
9079                      to_be_resorted(k,j,i) = to_be_resorted(k,j,i)            &
9080                                             / REAL( average_count_3d, KIND=wp )
9081                   ENDDO
9082                ENDDO
9083             ENDDO
9084             
9085          CASE ( 'LDSA' )
9086             DO  i = nxlg, nxrg
9087                DO  j = nysg, nyng
9088                   DO  k = nzb, nzt+1
9089                      LDSA_av(k,j,i) = LDSA_av(k,j,i)                          &
9090                                        / REAL( average_count_3d, KIND=wp )
9091                   ENDDO
9092                ENDDO
9093             ENDDO
9094             
9095          CASE ( 'N_bin1', 'N_bin2', 'N_bin3', 'N_bin4', 'N_bin5', 'N_bin6',   &
9096                 'N_bin7', 'N_bin8', 'N_bin9', 'N_bin10', 'N_bin11', 'N_bin12' )
9097             DO  i = nxlg, nxrg
9098                DO  j = nysg, nyng
9099                   DO  k = nzb, nzt+1
9100                      DO  b = 1, nbins 
9101                         Nbins_av(k,j,i,b) = Nbins_av(k,j,i,b)                 &
9102                                             / REAL( average_count_3d, KIND=wp )
9103                      ENDDO
9104                   ENDDO
9105                ENDDO
9106             ENDDO
9107             
9108          CASE ( 'Ntot' )
9109             DO  i = nxlg, nxrg
9110                DO  j = nysg, nyng
9111                   DO  k = nzb, nzt+1
9112                      Ntot_av(k,j,i) = Ntot_av(k,j,i)                          &
9113                                        / REAL( average_count_3d, KIND=wp )
9114                   ENDDO
9115                ENDDO
9116             ENDDO
9117             
9118          CASE ( 'm_bin1', 'm_bin2', 'm_bin3', 'm_bin4', 'm_bin5', 'm_bin6',   &
9119                 'm_bin7', 'm_bin8', 'm_bin9', 'm_bin10', 'm_bin11', 'm_bin12' )
9120             DO  i = nxlg, nxrg
9121                DO  j = nysg, nyng
9122                   DO  k = nzb, nzt+1
9123                      DO  b = 1, nbins 
9124                         DO  c = b, nbins*ncc, nbins
9125                            mbins_av(k,j,i,b) = mbins_av(k,j,i,b)              &
9126                                             / REAL( average_count_3d, KIND=wp )
9127                         ENDDO
9128                      ENDDO
9129                   ENDDO
9130                ENDDO
9131             ENDDO
9132             
9133          CASE ( 'PM2.5' )
9134             DO  i = nxlg, nxrg
9135                DO  j = nysg, nyng
9136                   DO  k = nzb, nzt+1
9137                      PM25_av(k,j,i) = PM25_av(k,j,i)                          &
9138                                        / REAL( average_count_3d, KIND=wp )
9139                   ENDDO
9140                ENDDO
9141             ENDDO
9142             
9143          CASE ( 'PM10' )
9144             DO  i = nxlg, nxrg
9145                DO  j = nysg, nyng
9146                   DO  k = nzb, nzt+1
9147                      PM10_av(k,j,i) = PM10_av(k,j,i)                          &
9148                                        / REAL( average_count_3d, KIND=wp )
9149                   ENDDO
9150                ENDDO
9151             ENDDO
9152             
9153          CASE ( 's_BC', 's_DU', 's_H2O', 's_NH', 's_NO', 's_OC', 's_SO4',     &
9154                 's_SS' )
9155             IF ( is_used( prtcl, TRIM( variable(3:) ) ) )  THEN
9156                icc = get_index( prtcl, TRIM( variable(3:) ) )
9157                IF ( TRIM( variable(3:) ) == 'BC' )   to_be_resorted => s_BC_av
9158                IF ( TRIM( variable(3:) ) == 'DU' )   to_be_resorted => s_DU_av   
9159                IF ( TRIM( variable(3:) ) == 'NH' )   to_be_resorted => s_NH_av   
9160                IF ( TRIM( variable(3:) ) == 'NO' )   to_be_resorted => s_NO_av   
9161                IF ( TRIM( variable(3:) ) == 'OC' )   to_be_resorted => s_OC_av   
9162                IF ( TRIM( variable(3:) ) == 'SO4' )  to_be_resorted => s_SO4_av   
9163                IF ( TRIM( variable(3:) ) == 'SS' )   to_be_resorted => s_SS_av 
9164                DO  i = nxlg, nxrg
9165                   DO  j = nysg, nyng
9166                      DO  k = nzb, nzt+1
9167                         to_be_resorted(k,j,i) = to_be_resorted(k,j,i)         &
9168                                             / REAL( average_count_3d, KIND=wp )
9169                      ENDDO
9170                   ENDDO
9171                ENDDO
9172             ENDIF
9173
9174       END SELECT
9175
9176    ENDIF
9177
9178 END SUBROUTINE salsa_3d_data_averaging
9179
9180
9181!------------------------------------------------------------------------------!
9182!
9183! Description:
9184! ------------
9185!> Subroutine defining 2D output variables
9186!------------------------------------------------------------------------------!
9187 SUBROUTINE salsa_data_output_2d( av, variable, found, grid, mode,             &
9188                                      local_pf, two_d )
9189 
9190    USE indices
9191
9192    USE kinds
9193
9194    IMPLICIT NONE
9195
9196    CHARACTER (LEN=*) ::  grid       !<
9197    CHARACTER (LEN=*) ::  mode       !<
9198    CHARACTER (LEN=*) ::  variable   !<
9199    CHARACTER (LEN=5) ::  vari       !<  trimmed format of variable
9200
9201    INTEGER(iwp) ::  av   !<
9202    INTEGER(iwp) ::  b    !<
9203    INTEGER(iwp) ::  c    !<
9204    INTEGER(iwp) ::  i    !<
9205    INTEGER(iwp) ::  icc  !< index of a chemical compound
9206    INTEGER(iwp) ::  j    !<
9207    INTEGER(iwp) ::  k    !<
9208
9209    LOGICAL ::  found   !<
9210    LOGICAL ::  two_d   !< flag parameter that indicates 2D variables
9211                        !< (horizontal cross sections)
9212   
9213    REAL(wp) ::  df       !< For calculating LDSA: fraction of particles
9214                          !< depositing in the alveolar (or tracheobronchial)
9215                          !< region of the lung. Depends on the particle size
9216    REAL(wp) ::  mean_d   !< Particle diameter in micrometres
9217    REAL(wp) ::  nc       !< Particle number concentration in units 1/cm**3
9218    REAL(wp), DIMENSION(nxl:nxr,nys:nyn,nzb:nzt+1) ::  local_pf !< local
9219       !< array to which output data is resorted to
9220    REAL(wp) ::  temp_bin !<
9221    REAL(wp), DIMENSION(:,:,:), POINTER ::  to_be_resorted  !< points to
9222                                                     !< selected output variable
9223   
9224    found = .TRUE.
9225    temp_bin  = 0.0_wp
9226   
9227    IF ( TRIM( variable(1:2) ) == 'g_' )  THEN
9228       vari = TRIM( variable( 3:LEN( TRIM( variable ) ) - 3 ) )
9229       IF ( av == 0 )  THEN
9230          IF ( vari == 'H2SO4')  icc = 1
9231          IF ( vari == 'HNO3')   icc = 2
9232          IF ( vari == 'NH3')    icc = 3
9233          IF ( vari == 'OCNV')   icc = 4
9234          IF ( vari == 'OCSV')   icc = 5
9235          DO  i = nxl, nxr
9236             DO  j = nys, nyn
9237                DO  k = nzb, nzt+1
9238                   local_pf(i,j,k) = MERGE( salsa_gas(icc)%conc(k,j,i),        &
9239                                            REAL( -999.0_wp, KIND = wp ),      &
9240                                            BTEST( wall_flags_0(k,j,i), 0 ) ) 
9241                ENDDO
9242             ENDDO
9243          ENDDO
9244       ELSE
9245          IF ( vari == 'H2SO4' )  to_be_resorted => g_H2SO4_av
9246          IF ( vari == 'HNO3' )   to_be_resorted => g_HNO3_av   
9247          IF ( vari == 'NH3' )    to_be_resorted => g_NH3_av   
9248          IF ( vari == 'OCNV' )   to_be_resorted => g_OCNV_av   
9249          IF ( vari == 'OCSV' )   to_be_resorted => g_OCSV_av       
9250          DO  i = nxl, nxr
9251             DO  j = nys, nyn
9252                DO  k = nzb, nzt+1
9253                   local_pf(i,j,k) = MERGE( to_be_resorted(k,j,i),             &
9254                                            REAL( -999.0_wp, KIND = wp ),      &
9255                                            BTEST( wall_flags_0(k,j,i), 0 ) ) 
9256                ENDDO
9257             ENDDO
9258          ENDDO
9259       ENDIF
9260
9261       IF ( mode == 'xy' )  grid = 'zu'
9262
9263    ELSEIF ( TRIM( variable(1:4) ) == 'LDSA' )  THEN
9264       IF ( av == 0 )  THEN
9265          DO  i = nxl, nxr
9266             DO  j = nys, nyn
9267                DO  k = nzb, nzt+1
9268                   temp_bin = 0.0_wp
9269                   DO  b = 1, nbins
9270!                     
9271!--                   Diameter in micrometres
9272                      mean_d = 1.0E+6_wp * Ra_dry(k,j,i,b) * 2.0_wp 
9273!                               
9274!--                   Deposition factor: alveolar                               
9275                      df = ( 0.01555_wp / mean_d ) * ( EXP( -0.416_wp * ( LOG( &
9276                             mean_d ) + 2.84_wp )**2.0_wp ) + 19.11_wp * EXP(  &
9277                            -0.482_wp * ( LOG( mean_d ) - 1.362_wp )**2.0_wp ) )
9278!                                   
9279!--                   Number concentration in 1/cm3
9280                      nc = 1.0E-6_wp * aerosol_number(b)%conc(k,j,i)
9281!                         
9282!--                   Lung-deposited surface area LDSA (units mum2/cm3)                       
9283                      temp_bin = temp_bin + pi * mean_d**2.0_wp * df * nc 
9284                   ENDDO
9285                   local_pf(i,j,k) = MERGE( temp_bin,  REAL( -999.0_wp,        &
9286                                  KIND = wp ), BTEST( wall_flags_0(k,j,i), 0 ) ) 
9287                ENDDO
9288             ENDDO
9289          ENDDO
9290       ELSE
9291          DO  i = nxl, nxr
9292             DO  j = nys, nyn
9293                DO  k = nzb, nzt+1
9294                   local_pf(i,j,k) = MERGE( LDSA_av(k,j,i), REAL( -999.0_wp,   &
9295                                  KIND = wp ), BTEST( wall_flags_0(k,j,i), 0 ) ) 
9296                ENDDO
9297             ENDDO
9298          ENDDO
9299       ENDIF
9300
9301       IF ( mode == 'xy' )  grid = 'zu'
9302   
9303    ELSEIF ( TRIM( variable(1:6) ) == 'N_bin1' )  THEN
9304       IF ( av == 0 )  THEN
9305          DO  i = nxl, nxr
9306             DO  j = nys, nyn
9307                DO  k = nzb, nzt+1                     
9308                   local_pf(i,j,k) = MERGE( aerosol_number(1)%conc(k,j,i),     &
9309                                            REAL( -999.0_wp, KIND = wp ),      &
9310                                            BTEST( wall_flags_0(k,j,i), 0 ) ) 
9311                ENDDO
9312             ENDDO
9313          ENDDO
9314       ELSE
9315          DO  i = nxl, nxr
9316             DO  j = nys, nyn
9317                DO  k = nzb, nzt+1                     
9318                   local_pf(i,j,k) = MERGE( Nbins_av(k,j,i,1),                 &
9319                                            REAL( -999.0_wp, KIND = wp ),      &
9320                                            BTEST( wall_flags_0(k,j,i), 0 ) ) 
9321                ENDDO
9322             ENDDO
9323          ENDDO
9324       ENDIF
9325   
9326    ELSEIF ( TRIM( variable(1:6) ) == 'N_bin2' )  THEN
9327       IF ( av == 0 )  THEN
9328          DO  i = nxl, nxr
9329             DO  j = nys, nyn
9330                DO  k = nzb, nzt+1                     
9331                   local_pf(i,j,k) = MERGE( aerosol_number(2)%conc(k,j,i),     &
9332                                            REAL( -999.0_wp, KIND = wp ),      &
9333                                            BTEST( wall_flags_0(k,j,i), 0 ) ) 
9334                ENDDO
9335             ENDDO
9336          ENDDO
9337       ELSE
9338          DO  i = nxl, nxr
9339             DO  j = nys, nyn
9340                DO  k = nzb, nzt+1                     
9341                   local_pf(i,j,k) = MERGE( Nbins_av(k,j,i,2),                 &
9342                                            REAL( -999.0_wp, KIND = wp ),      &
9343                                            BTEST( wall_flags_0(k,j,i), 0 ) ) 
9344                ENDDO
9345             ENDDO
9346          ENDDO
9347       ENDIF
9348       
9349    ELSEIF ( TRIM( variable(1:6) ) == 'N_bin3' )  THEN
9350       IF ( av == 0 )  THEN
9351          DO  i = nxl, nxr
9352             DO  j = nys, nyn
9353                DO  k = nzb, nzt+1                     
9354                   local_pf(i,j,k) = MERGE( aerosol_number(3)%conc(k,j,i),     &
9355                                            REAL( -999.0_wp, KIND = wp ),      &
9356                                            BTEST( wall_flags_0(k,j,i), 0 ) ) 
9357                ENDDO
9358             ENDDO
9359          ENDDO
9360       ELSE
9361          DO  i = nxl, nxr
9362             DO  j = nys, nyn
9363                DO  k = nzb, nzt+1                     
9364                   local_pf(i,j,k) = MERGE( Nbins_av(k,j,i,3),                 &
9365                                            REAL( -999.0_wp, KIND = wp ),      &
9366                                            BTEST( wall_flags_0(k,j,i), 0 ) ) 
9367                ENDDO
9368             ENDDO
9369          ENDDO
9370       ENDIF
9371   
9372    ELSEIF ( TRIM( variable(1:6) ) == 'N_bin4' )  THEN
9373       IF ( av == 0 )  THEN
9374          DO  i = nxl, nxr
9375             DO  j = nys, nyn
9376                DO  k = nzb, nzt+1                     
9377                   local_pf(i,j,k) = MERGE( aerosol_number(4)%conc(k,j,i),     &
9378                                            REAL( -999.0_wp, KIND = wp ),      &
9379                                            BTEST( wall_flags_0(k,j,i), 0 ) ) 
9380                ENDDO
9381             ENDDO
9382          ENDDO
9383       ELSE
9384          DO  i = nxl, nxr
9385             DO  j = nys, nyn
9386                DO  k = nzb, nzt+1                     
9387                   local_pf(i,j,k) = MERGE( Nbins_av(k,j,i,4),                 &
9388                                            REAL( -999.0_wp, KIND = wp ),      &
9389                                            BTEST( wall_flags_0(k,j,i), 0 ) ) 
9390                ENDDO
9391             ENDDO
9392          ENDDO
9393       ENDIF
9394       
9395    ELSEIF ( TRIM( variable(1:6) ) == 'N_bin5' )  THEN
9396       IF ( av == 0 )  THEN
9397          DO  i = nxl, nxr
9398             DO  j = nys, nyn
9399                DO  k = nzb, nzt+1                     
9400                   local_pf(i,j,k) = MERGE( aerosol_number(5)%conc(k,j,i),     &
9401                                            REAL( -999.0_wp, KIND = wp ),      &
9402                                            BTEST( wall_flags_0(k,j,i), 0 ) ) 
9403                ENDDO
9404             ENDDO
9405          ENDDO
9406       ELSE
9407          DO  i = nxl, nxr
9408             DO  j = nys, nyn
9409                DO  k = nzb, nzt+1                     
9410                   local_pf(i,j,k) = MERGE( Nbins_av(k,j,i,5),                 &
9411                                            REAL( -999.0_wp, KIND = wp ),      &
9412                                            BTEST( wall_flags_0(k,j,i), 0 ) ) 
9413                ENDDO
9414             ENDDO
9415          ENDDO
9416       ENDIF
9417       
9418    ELSEIF ( TRIM( variable(1:6) ) == 'N_bin6' )  THEN
9419       IF ( av == 0 )  THEN
9420          DO  i = nxl, nxr
9421             DO  j = nys, nyn
9422                DO  k = nzb, nzt+1                     
9423                   local_pf(i,j,k) = MERGE( aerosol_number(6)%conc(k,j,i),     &
9424                                            REAL( -999.0_wp, KIND = wp ),      &
9425                                            BTEST( wall_flags_0(k,j,i), 0 ) ) 
9426                ENDDO
9427             ENDDO
9428          ENDDO
9429       ELSE
9430          DO  i = nxl, nxr
9431             DO  j = nys, nyn
9432                DO  k = nzb, nzt+1                     
9433                   local_pf(i,j,k) = MERGE( Nbins_av(k,j,i,6),                 &
9434                                            REAL( -999.0_wp, KIND = wp ),      &
9435                                            BTEST( wall_flags_0(k,j,i), 0 ) ) 
9436                ENDDO
9437             ENDDO
9438          ENDDO
9439       ENDIF
9440       
9441    ELSEIF ( TRIM( variable(1:6) ) == 'N_bin7' )  THEN
9442       IF ( av == 0 )  THEN
9443          DO  i = nxl, nxr
9444             DO  j = nys, nyn
9445                DO  k = nzb, nzt+1                     
9446                   local_pf(i,j,k) = MERGE( aerosol_number(7)%conc(k,j,i),     &
9447                                            REAL( -999.0_wp, KIND = wp ),      &
9448                                            BTEST( wall_flags_0(k,j,i), 0 ) ) 
9449                ENDDO
9450             ENDDO
9451          ENDDO
9452       ELSE
9453          DO  i = nxl, nxr
9454             DO  j = nys, nyn
9455                DO  k = nzb, nzt+1                     
9456                   local_pf(i,j,k) = MERGE( Nbins_av(k,j,i,7),                 &
9457                                            REAL( -999.0_wp, KIND = wp ),      &
9458                                            BTEST( wall_flags_0(k,j,i), 0 ) ) 
9459                ENDDO
9460             ENDDO
9461          ENDDO
9462       ENDIF
9463       
9464    ELSEIF ( TRIM( variable(1:6) ) == 'N_bin8' )  THEN
9465       IF ( av == 0 )  THEN
9466          DO  i = nxl, nxr
9467             DO  j = nys, nyn
9468                DO  k = nzb, nzt+1                     
9469                   local_pf(i,j,k) = MERGE( aerosol_number(8)%conc(k,j,i),     &
9470                                            REAL( -999.0_wp, KIND = wp ),      &
9471                                            BTEST( wall_flags_0(k,j,i), 0 ) ) 
9472                ENDDO
9473             ENDDO
9474          ENDDO
9475       ELSE
9476          DO  i = nxl, nxr
9477             DO  j = nys, nyn
9478                DO  k = nzb, nzt+1                     
9479                   local_pf(i,j,k) = MERGE( Nbins_av(k,j,i,8),                 &
9480                                            REAL( -999.0_wp, KIND = wp ),      &
9481                                            BTEST( wall_flags_0(k,j,i), 0 ) ) 
9482                ENDDO
9483             ENDDO
9484          ENDDO
9485       ENDIF
9486       
9487    ELSEIF ( TRIM( variable(1:6) ) == 'N_bin9' )  THEN
9488       IF ( av == 0 )  THEN
9489          DO  i = nxl, nxr
9490             DO  j = nys, nyn
9491                DO  k = nzb, nzt+1                     
9492                   local_pf(i,j,k) = MERGE( aerosol_number(9)%conc(k,j,i),     &
9493                                            REAL( -999.0_wp, KIND = wp ),      &
9494                                            BTEST( wall_flags_0(k,j,i), 0 ) ) 
9495                ENDDO
9496             ENDDO
9497          ENDDO
9498       ELSE
9499          DO  i = nxl, nxr
9500             DO  j = nys, nyn
9501                DO  k = nzb, nzt+1                     
9502                   local_pf(i,j,k) = MERGE( Nbins_av(k,j,i,9),                 &
9503                                            REAL( -999.0_wp, KIND = wp ),      &
9504                                            BTEST( wall_flags_0(k,j,i), 0 ) ) 
9505                ENDDO
9506             ENDDO
9507          ENDDO
9508       ENDIF
9509   
9510    ELSEIF ( TRIM( variable(1:7) ) == 'N_bin10' )  THEN
9511       IF ( av == 0 )  THEN
9512          DO  i = nxl, nxr
9513             DO  j = nys, nyn
9514                DO  k = nzb, nzt+1                     
9515                   local_pf(i,j,k) = MERGE( aerosol_number(10)%conc(k,j,i),    &
9516                                            REAL( -999.0_wp, KIND = wp ),      &
9517                                            BTEST( wall_flags_0(k,j,i), 0 ) ) 
9518                ENDDO
9519             ENDDO
9520          ENDDO
9521       ELSE
9522          DO  i = nxl, nxr
9523             DO  j = nys, nyn
9524                DO  k = nzb, nzt+1                     
9525                   local_pf(i,j,k) = MERGE( Nbins_av(k,j,i,10),                &
9526                                            REAL( -999.0_wp, KIND = wp ),      &
9527                                            BTEST( wall_flags_0(k,j,i), 0 ) ) 
9528                ENDDO
9529             ENDDO
9530          ENDDO
9531       ENDIF
9532       
9533    ELSEIF ( TRIM( variable(1:7) ) == 'N_bin11' )  THEN
9534       IF ( av == 0 )  THEN
9535          DO  i = nxl, nxr
9536             DO  j = nys, nyn
9537                DO  k = nzb, nzt+1                     
9538                   local_pf(i,j,k) = MERGE( aerosol_number(11)%conc(k,j,i),    &
9539                                            REAL( -999.0_wp, KIND = wp ),      &
9540                                            BTEST( wall_flags_0(k,j,i), 0 ) ) 
9541                ENDDO
9542             ENDDO
9543          ENDDO
9544       ELSE
9545          DO  i = nxl, nxr
9546             DO  j = nys, nyn
9547                DO  k = nzb, nzt+1                     
9548                   local_pf(i,j,k) = MERGE( Nbins_av(k,j,i,11),                &
9549                                            REAL( -999.0_wp, KIND = wp ),      &
9550                                            BTEST( wall_flags_0(k,j,i), 0 ) ) 
9551                ENDDO
9552             ENDDO
9553          ENDDO
9554       ENDIF
9555       
9556    ELSEIF ( TRIM( variable(1:7) ) == 'N_bin12' )  THEN
9557       IF ( av == 0 )  THEN
9558          DO  i = nxl, nxr
9559             DO  j = nys, nyn
9560                DO  k = nzb, nzt+1                     
9561                   local_pf(i,j,k) = MERGE( aerosol_number(12)%conc(k,j,i),    &
9562                                            REAL( -999.0_wp, KIND = wp ),      &
9563                                            BTEST( wall_flags_0(k,j,i), 0 ) ) 
9564                ENDDO
9565             ENDDO
9566          ENDDO
9567       ELSE
9568          DO  i = nxl, nxr
9569             DO  j = nys, nyn
9570                DO  k = nzb, nzt+1                     
9571                   local_pf(i,j,k) = MERGE( Nbins_av(k,j,i,12),                &
9572                                            REAL( -999.0_wp, KIND = wp ),      &
9573                                            BTEST( wall_flags_0(k,j,i), 0 ) ) 
9574                ENDDO
9575             ENDDO
9576          ENDDO
9577       ENDIF
9578   
9579    ELSEIF ( TRIM( variable(1:4) ) == 'Ntot' )  THEN
9580       IF ( av == 0 )  THEN
9581          DO  i = nxl, nxr
9582             DO  j = nys, nyn
9583                DO  k = nzb, nzt+1
9584                   temp_bin = 0.0_wp
9585                   DO  b = 1, nbins
9586                      temp_bin = temp_bin + aerosol_number(b)%conc(k,j,i)
9587                   ENDDO
9588                   local_pf(i,j,k) = MERGE( temp_bin, REAL( -999.0_wp,         &
9589                                  KIND = wp ), BTEST( wall_flags_0(k,j,i), 0 ) ) 
9590                ENDDO
9591             ENDDO
9592          ENDDO
9593       ELSE
9594          DO  i = nxl, nxr
9595             DO  j = nys, nyn
9596                DO  k = nzb, nzt+1
9597                   local_pf(i,j,k) = MERGE( Ntot_av(k,j,i), REAL( -999.0_wp,   &
9598                                  KIND = wp ), BTEST( wall_flags_0(k,j,i), 0 ) ) 
9599                ENDDO
9600             ENDDO
9601          ENDDO
9602       ENDIF
9603
9604       IF ( mode == 'xy' )  grid = 'zu'
9605   
9606   
9607    ELSEIF ( TRIM( variable(1:6) ) == 'm_bin1' )  THEN
9608       IF ( av == 0 )  THEN
9609          DO  i = nxl, nxr
9610             DO  j = nys, nyn
9611                DO  k = nzb, nzt+1   
9612                   temp_bin = 0.0_wp
9613                   DO  c = 1, ncc_tot*nbins, nbins
9614                      temp_bin = temp_bin + aerosol_mass(c)%conc(k,j,i)
9615                   ENDDO
9616                   local_pf(i,j,k) = MERGE( temp_bin, REAL( -999.0_wp,         &
9617                                  KIND = wp ), BTEST( wall_flags_0(k,j,i), 0 ) )
9618                ENDDO
9619             ENDDO
9620          ENDDO
9621       ELSE
9622          DO  i = nxl, nxr
9623             DO  j = nys, nyn
9624                DO  k = nzb, nzt+1                     
9625                   local_pf(i,j,k) = MERGE( mbins_av(k,j,i,1), REAL( -999.0_wp,&
9626                                  KIND = wp ), BTEST( wall_flags_0(k,j,i), 0 ) ) 
9627                ENDDO
9628             ENDDO
9629          ENDDO
9630       ENDIF
9631   
9632    ELSEIF ( TRIM( variable(1:6) ) == 'm_bin2' )  THEN
9633       IF ( av == 0 )  THEN
9634          DO  i = nxl, nxr
9635             DO  j = nys, nyn
9636                DO  k = nzb, nzt+1   
9637                   temp_bin = 0.0_wp
9638                   DO  c = 2, ncc_tot*nbins, nbins
9639                      temp_bin = temp_bin + aerosol_mass(c)%conc(k,j,i)
9640                   ENDDO
9641                   local_pf(i,j,k) = MERGE( temp_bin, REAL( -999.0_wp,         &
9642                                  KIND = wp ), BTEST( wall_flags_0(k,j,i), 0 ) )
9643                ENDDO
9644             ENDDO
9645          ENDDO
9646       ELSE
9647          DO  i = nxl, nxr
9648             DO  j = nys, nyn
9649                DO  k = nzb, nzt+1                     
9650                   local_pf(i,j,k) = MERGE( mbins_av(k,j,i,2), REAL( -999.0_wp,&
9651                                  KIND = wp ), BTEST( wall_flags_0(k,j,i), 0 ) ) 
9652                ENDDO
9653             ENDDO
9654          ENDDO
9655       ENDIF
9656       
9657    ELSEIF ( TRIM( variable(1:6) ) == 'm_bin3' )  THEN
9658       IF ( av == 0 )  THEN
9659          DO  i = nxl, nxr
9660             DO  j = nys, nyn
9661                DO  k = nzb, nzt+1   
9662                   temp_bin = 0.0_wp
9663                   DO  c = 3, ncc_tot*nbins, nbins
9664                      temp_bin = temp_bin + aerosol_mass(c)%conc(k,j,i)
9665                   ENDDO
9666                   local_pf(i,j,k) = MERGE( temp_bin, REAL( -999.0_wp,         &
9667                                  KIND = wp ), BTEST( wall_flags_0(k,j,i), 0 ) )
9668                ENDDO
9669             ENDDO
9670          ENDDO
9671       ELSE
9672          DO  i = nxl, nxr
9673             DO  j = nys, nyn
9674                DO  k = nzb, nzt+1                     
9675                   local_pf(i,j,k) = MERGE( mbins_av(k,j,i,3), REAL( -999.0_wp,&
9676                                  KIND = wp ), BTEST( wall_flags_0(k,j,i), 0 ) ) 
9677                ENDDO
9678             ENDDO
9679          ENDDO
9680       ENDIF
9681       
9682    ELSEIF ( TRIM( variable(1:6) ) == 'm_bin4' )  THEN
9683       IF ( av == 0 )  THEN
9684          DO  i = nxl, nxr
9685             DO  j = nys, nyn
9686                DO  k = nzb, nzt+1   
9687                   temp_bin = 0.0_wp
9688                   DO  c = 4, ncc_tot*nbins, nbins
9689                      temp_bin = temp_bin + aerosol_mass(c)%conc(k,j,i)
9690                   ENDDO
9691                   local_pf(i,j,k) = MERGE( temp_bin, REAL( -999.0_wp,         &
9692                                  KIND = wp ), BTEST( wall_flags_0(k,j,i), 0 ) )
9693                ENDDO
9694             ENDDO
9695          ENDDO
9696       ELSE
9697          DO  i = nxl, nxr
9698             DO  j = nys, nyn
9699                DO  k = nzb, nzt+1                     
9700                   local_pf(i,j,k) = MERGE( mbins_av(k,j,i,4), REAL( -999.0_wp,&
9701                                  KIND = wp ), BTEST( wall_flags_0(k,j,i), 0 ) ) 
9702                ENDDO
9703             ENDDO
9704          ENDDO
9705       ENDIF
9706       
9707    ELSEIF ( TRIM( variable(1:6) ) == 'm_bin5' )  THEN
9708       IF ( av == 0 )  THEN
9709          DO  i = nxl, nxr
9710             DO  j = nys, nyn
9711                DO  k = nzb, nzt+1   
9712                   temp_bin = 0.0_wp
9713                   DO  c = 5, ncc_tot*nbins, nbins
9714                      temp_bin = temp_bin + aerosol_mass(c)%conc(k,j,i)
9715                   ENDDO
9716                   local_pf(i,j,k) = MERGE( temp_bin, REAL( -999.0_wp,         &
9717                                  KIND = wp ), BTEST( wall_flags_0(k,j,i), 0 ) )
9718                ENDDO
9719             ENDDO
9720          ENDDO
9721       ELSE
9722          DO  i = nxl, nxr
9723             DO  j = nys, nyn
9724                DO  k = nzb, nzt+1                     
9725                   local_pf(i,j,k) = MERGE( mbins_av(k,j,i,5), REAL( -999.0_wp,&
9726                                  KIND = wp ), BTEST( wall_flags_0(k,j,i), 0 ) ) 
9727                ENDDO
9728             ENDDO
9729          ENDDO
9730       ENDIF
9731       
9732    ELSEIF ( TRIM( variable(1:6) ) == 'm_bin6' )  THEN
9733       IF ( av == 0 )  THEN
9734          DO  i = nxl, nxr
9735             DO  j = nys, nyn
9736                DO  k = nzb, nzt+1   
9737                   temp_bin = 0.0_wp
9738                   DO  c = 6, ncc_tot*nbins, nbins
9739                      temp_bin = temp_bin + aerosol_mass(c)%conc(k,j,i)
9740                   ENDDO
9741                   local_pf(i,j,k) = MERGE( temp_bin, REAL( -999.0_wp,         &
9742                                  KIND = wp ), BTEST( wall_flags_0(k,j,i), 0 ) )
9743                ENDDO
9744             ENDDO
9745          ENDDO
9746       ELSE
9747          DO  i = nxl, nxr
9748             DO  j = nys, nyn
9749                DO  k = nzb, nzt+1                     
9750                   local_pf(i,j,k) = MERGE( mbins_av(k,j,i,6), REAL( -999.0_wp,&
9751                                  KIND = wp ), BTEST( wall_flags_0(k,j,i), 0 ) ) 
9752                ENDDO
9753             ENDDO
9754          ENDDO
9755       ENDIF
9756       
9757    ELSEIF ( TRIM( variable(1:6) ) == 'm_bin7' )  THEN
9758       IF ( av == 0 )  THEN
9759          DO  i = nxl, nxr
9760             DO  j = nys, nyn
9761                DO  k = nzb, nzt+1   
9762                   temp_bin = 0.0_wp
9763                   DO  c = 7, ncc_tot*nbins, nbins
9764                      temp_bin = temp_bin + aerosol_mass(c)%conc(k,j,i)
9765                   ENDDO
9766                   local_pf(i,j,k) = MERGE( temp_bin, REAL( -999.0_wp,         &
9767                                  KIND = wp ), BTEST( wall_flags_0(k,j,i), 0 ) )
9768                ENDDO
9769             ENDDO
9770          ENDDO
9771       ELSE
9772          DO  i = nxl, nxr
9773             DO  j = nys, nyn
9774                DO  k = nzb, nzt+1                     
9775                   local_pf(i,j,k) = MERGE( mbins_av(k,j,i,7), REAL( -999.0_wp,&
9776                                  KIND = wp ), BTEST( wall_flags_0(k,j,i), 0 ) ) 
9777                ENDDO
9778             ENDDO
9779          ENDDO
9780       ENDIF
9781       
9782    ELSEIF ( TRIM( variable(1:6) ) == 'm_bin8' )  THEN
9783       IF ( av == 0 )  THEN
9784          DO  i = nxl, nxr
9785             DO  j = nys, nyn
9786                DO  k = nzb, nzt+1   
9787                   temp_bin = 0.0_wp
9788                   DO  c = 8, ncc_tot*nbins, nbins
9789                      temp_bin = temp_bin + aerosol_mass(c)%conc(k,j,i)
9790                   ENDDO
9791                   local_pf(i,j,k) = MERGE( temp_bin, REAL( -999.0_wp,         &
9792                                  KIND = wp ), BTEST( wall_flags_0(k,j,i), 0 ) )
9793                ENDDO
9794             ENDDO
9795          ENDDO
9796       ELSE
9797          DO  i = nxl, nxr
9798             DO  j = nys, nyn
9799                DO  k = nzb, nzt+1                     
9800                   local_pf(i,j,k) = MERGE( mbins_av(k,j,i,8), REAL( -999.0_wp,&
9801                                  KIND = wp ), BTEST( wall_flags_0(k,j,i), 0 ) ) 
9802                ENDDO
9803             ENDDO
9804          ENDDO
9805       ENDIF
9806       
9807    ELSEIF ( TRIM( variable(1:6) ) == 'm_bin9' )  THEN
9808       IF ( av == 0 )  THEN
9809          DO  i = nxl, nxr
9810             DO  j = nys, nyn
9811                DO  k = nzb, nzt+1   
9812                   temp_bin = 0.0_wp
9813                   DO  c = 9, ncc_tot*nbins, nbins
9814                      temp_bin = temp_bin + aerosol_mass(c)%conc(k,j,i)
9815                   ENDDO
9816                   local_pf(i,j,k) = MERGE( temp_bin, REAL( -999.0_wp,         &
9817                                  KIND = wp ), BTEST( wall_flags_0(k,j,i), 0 ) )
9818                ENDDO
9819             ENDDO
9820          ENDDO
9821       ELSE
9822          DO  i = nxl, nxr
9823             DO  j = nys, nyn
9824                DO  k = nzb, nzt+1                     
9825                   local_pf(i,j,k) = MERGE( mbins_av(k,j,i,9), REAL( -999.0_wp,&
9826                                  KIND = wp ), BTEST( wall_flags_0(k,j,i), 0 ) ) 
9827                ENDDO
9828             ENDDO
9829          ENDDO
9830       ENDIF
9831       
9832    ELSEIF ( TRIM( variable(1:7) ) == 'm_bin10' )  THEN
9833       IF ( av == 0 )  THEN
9834          DO  i = nxl, nxr
9835             DO  j = nys, nyn
9836                DO  k = nzb, nzt+1   
9837                   temp_bin = 0.0_wp
9838                   DO  c = 10, ncc_tot*nbins, nbins
9839                      temp_bin = temp_bin + aerosol_mass(c)%conc(k,j,i)
9840                   ENDDO
9841                   local_pf(i,j,k) = MERGE( temp_bin, REAL( -999.0_wp,         &
9842                                  KIND = wp ), BTEST( wall_flags_0(k,j,i), 0 ) )
9843                ENDDO
9844             ENDDO
9845          ENDDO
9846       ELSE
9847          DO  i = nxl, nxr
9848             DO  j = nys, nyn
9849                DO  k = nzb, nzt+1                     
9850                   local_pf(i,j,k) = MERGE( mbins_av(k,j,i,10), REAL(          &
9851                       -999.0_wp, KIND = wp ), BTEST( wall_flags_0(k,j,i), 0 ) ) 
9852                ENDDO
9853             ENDDO
9854          ENDDO
9855       ENDIF
9856       
9857    ELSEIF ( TRIM( variable(1:7) ) == 'm_bin11' )  THEN
9858       IF ( av == 0 )  THEN
9859          DO  i = nxl, nxr
9860             DO  j = nys, nyn
9861                DO  k = nzb, nzt+1   
9862                   temp_bin = 0.0_wp
9863                   DO  c = 11, ncc_tot*nbins, nbins
9864                      temp_bin = temp_bin + aerosol_mass(c)%conc(k,j,i)
9865                   ENDDO
9866                   local_pf(i,j,k) = MERGE( temp_bin, REAL( -999.0_wp,         &
9867                                  KIND = wp ), BTEST( wall_flags_0(k,j,i), 0 ) )
9868                ENDDO
9869             ENDDO
9870          ENDDO
9871       ELSE
9872          DO  i = nxl, nxr
9873             DO  j = nys, nyn
9874                DO  k = nzb, nzt+1                     
9875                   local_pf(i,j,k) = MERGE( mbins_av(k,j,i,11), REAL(          &
9876                       -999.0_wp, KIND = wp ), BTEST( wall_flags_0(k,j,i), 0 ) ) 
9877                ENDDO
9878             ENDDO
9879          ENDDO
9880       ENDIF
9881       
9882    ELSEIF ( TRIM( variable(1:7) ) == 'm_bin12' )  THEN
9883       IF ( av == 0 )  THEN
9884          DO  i = nxl, nxr
9885             DO  j = nys, nyn
9886                DO  k = nzb, nzt+1   
9887                   temp_bin = 0.0_wp
9888                   DO  c = 12, ncc_tot*nbins, nbins
9889                      temp_bin = temp_bin + aerosol_mass(c)%conc(k,j,i)
9890                   ENDDO
9891                   local_pf(i,j,k) = MERGE( temp_bin, REAL( -999.0_wp,         &
9892                                  KIND = wp ), BTEST( wall_flags_0(k,j,i), 0 ) )
9893                ENDDO
9894             ENDDO
9895          ENDDO
9896       ELSE
9897          DO  i = nxl, nxr
9898             DO  j = nys, nyn
9899                DO  k = nzb, nzt+1                     
9900                   local_pf(i,j,k) = MERGE( mbins_av(k,j,i,12), REAL(          &
9901                       -999.0_wp, KIND = wp ), BTEST( wall_flags_0(k,j,i), 0 ) ) 
9902                ENDDO
9903             ENDDO
9904          ENDDO
9905       ENDIF
9906   
9907    ELSEIF ( TRIM( variable(1:5) ) == 'PM2.5' )  THEN
9908       IF ( av == 0 )  THEN
9909          DO  i = nxl, nxr
9910             DO  j = nys, nyn
9911                DO  k = nzb, nzt+1
9912                   temp_bin = 0.0_wp
9913                   DO  b = 1, nbins
9914                      IF ( 2.0_wp * Ra_dry(k,j,i,b) <= 2.5E-6_wp )  THEN
9915                         DO  c = b, nbins*ncc, nbins
9916                            temp_bin = temp_bin + aerosol_mass(c)%conc(k,j,i)
9917                         ENDDO
9918                      ENDIF
9919                   ENDDO
9920                   local_pf(i,j,k) = MERGE( temp_bin, REAL( -999.0_wp,         &
9921                                  KIND = wp ), BTEST( wall_flags_0(k,j,i), 0 ) ) 
9922                ENDDO
9923             ENDDO
9924          ENDDO
9925       ELSE
9926          DO  i = nxl, nxr
9927             DO  j = nys, nyn
9928                DO  k = nzb, nzt+1
9929                   local_pf(i,j,k) = MERGE( PM25_av(k,j,i), REAL( -999.0_wp,   &
9930                                  KIND = wp ), BTEST( wall_flags_0(k,j,i), 0 ) ) 
9931                ENDDO
9932             ENDDO
9933          ENDDO
9934       ENDIF
9935
9936       IF ( mode == 'xy' )  grid = 'zu'
9937   
9938   
9939    ELSEIF ( TRIM( variable(1:4) ) == 'PM10' )  THEN
9940       IF ( av == 0 )  THEN
9941          DO  i = nxl, nxr
9942             DO  j = nys, nyn
9943                DO  k = nzb, nzt+1
9944                   temp_bin = 0.0_wp
9945                   DO  b = 1, nbins
9946                      IF ( 2.0_wp * Ra_dry(k,j,i,b) <= 10.0E-6_wp )  THEN
9947                         DO  c = b, nbins*ncc, nbins
9948                            temp_bin = temp_bin + aerosol_mass(c)%conc(k,j,i)
9949                         ENDDO
9950                      ENDIF
9951                   ENDDO
9952                   local_pf(i,j,k) = MERGE( temp_bin,  REAL( -999.0_wp,        &
9953                                  KIND = wp ), BTEST( wall_flags_0(k,j,i), 0 ) ) 
9954                ENDDO
9955             ENDDO
9956          ENDDO
9957       ELSE
9958          DO  i = nxl, nxr
9959             DO  j = nys, nyn
9960                DO  k = nzb, nzt+1
9961                   local_pf(i,j,k) = MERGE( PM10_av(k,j,i), REAL( -999.0_wp,   &
9962                                 KIND = wp ),  BTEST( wall_flags_0(k,j,i), 0 ) ) 
9963                ENDDO
9964             ENDDO
9965          ENDDO
9966       ENDIF
9967
9968       IF ( mode == 'xy' )  grid = 'zu'
9969   
9970    ELSEIF ( TRIM( variable(1:2) ) == 's_' )  THEN
9971       vari = TRIM( variable( 3:LEN( TRIM( variable ) ) - 3 ) )
9972       IF ( is_used( prtcl, vari ) )  THEN
9973          icc = get_index( prtcl, vari )
9974          IF ( av == 0 )  THEN
9975             DO  i = nxl, nxr
9976                DO  j = nys, nyn
9977                   DO  k = nzb, nzt+1
9978                      temp_bin = 0.0_wp
9979                      DO  c = ( icc-1 )*nbins+1, icc*nbins, 1
9980                         temp_bin = temp_bin + aerosol_mass(c)%conc(k,j,i)
9981                      ENDDO
9982                      local_pf(i,j,k) = MERGE( temp_bin, REAL( -999.0_wp,      &
9983                                  KIND = wp ), BTEST( wall_flags_0(k,j,i), 0 ) ) 
9984                   ENDDO
9985                ENDDO
9986             ENDDO
9987          ELSE
9988             IF ( vari == 'BC' )   to_be_resorted => s_BC_av
9989             IF ( vari == 'DU' )   to_be_resorted => s_DU_av   
9990             IF ( vari == 'NH' )   to_be_resorted => s_NH_av   
9991             IF ( vari == 'NO' )   to_be_resorted => s_NO_av   
9992             IF ( vari == 'OC' )   to_be_resorted => s_OC_av   
9993             IF ( vari == 'SO4' )  to_be_resorted => s_SO4_av   
9994             IF ( vari == 'SS' )   to_be_resorted => s_SS_av       
9995             DO  i = nxl, nxr
9996                DO  j = nys, nyn
9997                   DO  k = nzb, nzt+1
9998                      local_pf(i,j,k) = MERGE( to_be_resorted(k,j,i),          &
9999                                               REAL( -999.0_wp, KIND = wp ),   &
10000                                               BTEST( wall_flags_0(k,j,i), 0 ) ) 
10001                   ENDDO
10002                ENDDO
10003             ENDDO
10004          ENDIF
10005       ELSE
10006          local_pf = 0.0_wp 
10007       ENDIF
10008
10009       IF ( mode == 'xy' )  grid = 'zu'
10010       
10011    ELSE
10012       found = .FALSE.
10013       grid  = 'none'
10014   
10015    ENDIF
10016 
10017 END SUBROUTINE salsa_data_output_2d
10018
10019 
10020!------------------------------------------------------------------------------!
10021!
10022! Description:
10023! ------------
10024!> Subroutine defining 3D output variables
10025!------------------------------------------------------------------------------!
10026 SUBROUTINE salsa_data_output_3d( av, variable, found, local_pf )
10027
10028    USE indices
10029
10030    USE kinds
10031
10032    IMPLICIT NONE
10033
10034    CHARACTER (LEN=*), INTENT(in) ::  variable   !<
10035   
10036    INTEGER(iwp) ::  av   !<
10037    INTEGER(iwp) ::  c    !<
10038    INTEGER(iwp) ::  i    !<
10039    INTEGER(iwp) ::  icc  !< index of a chemical compound
10040    INTEGER(iwp) ::  j    !<
10041    INTEGER(iwp) ::  k    !<
10042    INTEGER(iwp) ::  n    !<
10043
10044    LOGICAL ::  found   !<
10045    REAL(wp) ::  df       !< For calculating LDSA: fraction of particles
10046                          !< depositing in the alveolar (or tracheobronchial)
10047                          !< region of the lung. Depends on the particle size
10048    REAL(wp) ::  mean_d   !< Particle diameter in micrometres
10049    REAL(wp) ::  nc       !< Particle number concentration in units 1/cm**3
10050
10051    REAL(sp), DIMENSION(nxl:nxr,nys:nyn,nzb:nzt+1) ::  local_pf  !< local
10052                                  !< array to which output data is resorted to
10053    REAL(wp) ::  temp_bin  !<
10054    REAL(wp), DIMENSION(:,:,:), POINTER ::  to_be_resorted  !< points to
10055                                                     !< selected output variable
10056       
10057    found     = .TRUE.
10058    temp_bin  = 0.0_wp
10059   
10060    SELECT CASE ( TRIM( variable ) )
10061   
10062       CASE ( 'g_H2SO4', 'g_HNO3', 'g_NH3', 'g_OCNV',  'g_OCSV' )
10063          IF ( av == 0 )  THEN
10064             IF ( TRIM( variable ) == 'g_H2SO4')  icc = 1
10065             IF ( TRIM( variable ) == 'g_HNO3')   icc = 2
10066             IF ( TRIM( variable ) == 'g_NH3')    icc = 3
10067             IF ( TRIM( variable ) == 'g_OCNV')   icc = 4
10068             IF ( TRIM( variable ) == 'g_OCSV')   icc = 5
10069             
10070             DO  i = nxl, nxr
10071                DO  j = nys, nyn
10072                   DO  k = nzb, nzt+1
10073                      local_pf(i,j,k) = MERGE( salsa_gas(icc)%conc(k,j,i),     &
10074                                               REAL( -999.0_wp, KIND = wp ),   &
10075                                               BTEST( wall_flags_0(k,j,i), 0 ) ) 
10076                   ENDDO
10077                ENDDO
10078             ENDDO
10079          ELSE
10080             IF ( TRIM( variable(3:) ) == 'H2SO4' ) to_be_resorted => g_H2SO4_av
10081             IF ( TRIM( variable(3:) ) == 'HNO3' )  to_be_resorted => g_HNO3_av   
10082             IF ( TRIM( variable(3:) ) == 'NH3' )   to_be_resorted => g_NH3_av   
10083             IF ( TRIM( variable(3:) ) == 'OCNV' )  to_be_resorted => g_OCNV_av   
10084             IF ( TRIM( variable(3:) ) == 'OCSV' )  to_be_resorted => g_OCSV_av 
10085             DO  i = nxl, nxr
10086                DO  j = nys, nyn
10087                   DO  k = nzb, nzt+1
10088                      local_pf(i,j,k) = MERGE( to_be_resorted(k,j,i),          &
10089                                               REAL( -999.0_wp, KIND = wp ),   &
10090                                               BTEST( wall_flags_0(k,j,i), 0 ) ) 
10091                   ENDDO
10092                ENDDO
10093             ENDDO
10094          ENDIF
10095         
10096       CASE ( 'LDSA' )
10097          IF ( av == 0 )  THEN
10098             DO  i = nxl, nxr
10099                DO  j = nys, nyn
10100                   DO  k = nzb, nzt+1
10101                      temp_bin = 0.0_wp
10102                      DO  n = 1, nbins
10103!                     
10104!--                      Diameter in micrometres
10105                         mean_d = 1.0E+6_wp * Ra_dry(k,j,i,n) * 2.0_wp 
10106!                               
10107!--                      Deposition factor: alveolar                             
10108                         df = ( 0.01555_wp / mean_d ) * ( EXP( -0.416_wp *     &
10109                                ( LOG( mean_d ) + 2.84_wp )**2.0_wp )          &
10110                                  + 19.11_wp * EXP( -0.482_wp *                &
10111                                  ( LOG( mean_d ) - 1.362_wp )**2.0_wp ) )
10112!                                   
10113!--                      Number concentration in 1/cm3
10114                         nc = 1.0E-6_wp * aerosol_number(n)%conc(k,j,i)
10115!                         
10116!--                      Lung-deposited surface area LDSA (units mum2/cm3)
10117                         temp_bin = temp_bin + pi * mean_d**2.0_wp * df * nc 
10118                      ENDDO
10119                      local_pf(i,j,k) = MERGE( temp_bin,                       &
10120                                               REAL( -999.0_wp, KIND = wp ),   &
10121                                               BTEST( wall_flags_0(k,j,i), 0 ) ) 
10122                   ENDDO
10123                ENDDO
10124             ENDDO
10125          ELSE
10126             DO  i = nxl, nxr
10127                DO  j = nys, nyn
10128                   DO  k = nzb, nzt+1
10129                      local_pf(i,j,k) = MERGE( LDSA_av(k,j,i),                 &
10130                                               REAL( -999.0_wp, KIND = wp ),   &
10131                                               BTEST( wall_flags_0(k,j,i), 0 ) ) 
10132                   ENDDO
10133                ENDDO
10134             ENDDO
10135          ENDIF
10136         
10137       CASE ( 'Ntot' )
10138          IF ( av == 0 )  THEN
10139             DO  i = nxl, nxr
10140                DO  j = nys, nyn
10141                   DO  k = nzb, nzt+1
10142                      temp_bin = 0.0_wp
10143                      DO  n = 1, nbins                         
10144                         temp_bin = temp_bin + aerosol_number(n)%conc(k,j,i)
10145                      ENDDO
10146                      local_pf(i,j,k) = MERGE( temp_bin,                       &
10147                                               REAL( -999.0_wp, KIND = wp ),   &
10148                                               BTEST( wall_flags_0(k,j,i), 0 ) ) 
10149                   ENDDO
10150                ENDDO
10151             ENDDO
10152          ELSE
10153             DO  i = nxl, nxr
10154                DO  j = nys, nyn
10155                   DO  k = nzb, nzt+1
10156                      local_pf(i,j,k) = MERGE( Ntot_av(k,j,i),                 &
10157                                               REAL( -999.0_wp, KIND = wp ),   &
10158                                               BTEST( wall_flags_0(k,j,i), 0 ) ) 
10159                   ENDDO
10160                ENDDO
10161             ENDDO
10162          ENDIF
10163         
10164       CASE ( 'PM2.5' )
10165          IF ( av == 0 )  THEN
10166             DO  i = nxl, nxr
10167                DO  j = nys, nyn
10168                   DO  k = nzb, nzt+1
10169                      temp_bin = 0.0_wp
10170                      DO  n = 1, nbins
10171                         IF ( 2.0_wp * Ra_dry(k,j,i,n) <= 2.5E-6_wp )  THEN
10172                            DO  c = n, nbins*ncc, nbins
10173                               temp_bin = temp_bin + aerosol_mass(c)%conc(k,j,i)
10174                            ENDDO
10175                         ENDIF
10176                      ENDDO
10177                      local_pf(i,j,k) = MERGE( temp_bin,                       &
10178                                               REAL( -999.0_wp, KIND = wp ),   &
10179                                               BTEST( wall_flags_0(k,j,i), 0 ) ) 
10180                   ENDDO
10181                ENDDO
10182             ENDDO
10183          ELSE
10184             DO  i = nxl, nxr
10185                DO  j = nys, nyn
10186                   DO  k = nzb, nzt+1
10187                      local_pf(i,j,k) = MERGE( PM25_av(k,j,i),                 &
10188                                               REAL( -999.0_wp, KIND = wp ),   &
10189                                               BTEST( wall_flags_0(k,j,i), 0 ) ) 
10190                   ENDDO
10191                ENDDO
10192             ENDDO
10193          ENDIF
10194         
10195       CASE ( 'PM10' )
10196          IF ( av == 0 )  THEN
10197             DO  i = nxl, nxr
10198                DO  j = nys, nyn
10199                   DO  k = nzb, nzt+1
10200                      temp_bin = 0.0_wp
10201                      DO  n = 1, nbins
10202                         IF ( 2.0_wp * Ra_dry(k,j,i,n) <= 10.0E-6_wp )  THEN
10203                            DO  c = n, nbins*ncc, nbins
10204                               temp_bin = temp_bin + aerosol_mass(c)%conc(k,j,i)
10205                            ENDDO
10206                         ENDIF
10207                      ENDDO
10208                      local_pf(i,j,k) = MERGE( temp_bin,                       &
10209                                               REAL( -999.0_wp, KIND = wp ),   &
10210                                               BTEST( wall_flags_0(k,j,i), 0 ) ) 
10211                   ENDDO
10212                ENDDO
10213             ENDDO
10214          ELSE
10215             DO  i = nxl, nxr
10216                DO  j = nys, nyn
10217                   DO  k = nzb, nzt+1
10218                      local_pf(i,j,k) = MERGE( PM10_av(k,j,i),                 &
10219                                               REAL( -999.0_wp, KIND = wp ),   &
10220                                               BTEST( wall_flags_0(k,j,i), 0 ) ) 
10221                   ENDDO
10222                ENDDO
10223             ENDDO
10224          ENDIF
10225         
10226       CASE ( 'N_bin1' )
10227          IF ( av == 0 )  THEN
10228             DO  i = nxl, nxr
10229                DO  j = nys, nyn
10230                   DO  k = nzb, nzt+1                     
10231                      local_pf(i,j,k) = MERGE( aerosol_number(1)%conc(k,j,i),  &
10232                                               REAL( -999.0_wp, KIND = wp ),   &
10233                                               BTEST( wall_flags_0(k,j,i), 0 ) ) 
10234                   ENDDO
10235                ENDDO
10236             ENDDO
10237          ELSE
10238             DO  i = nxl, nxr
10239                DO  j = nys, nyn
10240                   DO  k = nzb, nzt+1                     
10241                      local_pf(i,j,k) = MERGE( Nbins_av(k,j,i,1),              &
10242                                               REAL( -999.0_wp, KIND = wp ),   &
10243                                               BTEST( wall_flags_0(k,j,i), 0 ) ) 
10244                   ENDDO
10245                ENDDO
10246             ENDDO
10247          ENDIF
10248       
10249       CASE ( 'N_bin2' )
10250          IF ( av == 0 )  THEN
10251             DO  i = nxl, nxr
10252                DO  j = nys, nyn
10253                   DO  k = nzb, nzt+1 
10254                      local_pf(i,j,k) = MERGE( aerosol_number(2)%conc(k,j,i),  &
10255                                               REAL( -999.0_wp, KIND = wp ),   &
10256                                               BTEST( wall_flags_0(k,j,i), 0 ) )
10257                   ENDDO
10258                ENDDO
10259             ENDDO
10260          ELSE
10261             DO  i = nxl, nxr
10262                DO  j = nys, nyn
10263                   DO  k = nzb, nzt+1                     
10264                      local_pf(i,j,k) = MERGE( Nbins_av(k,j,i,2),              &
10265                                               REAL( -999.0_wp, KIND = wp ),   &
10266                                               BTEST( wall_flags_0(k,j,i), 0 ) ) 
10267                   ENDDO
10268                ENDDO
10269             ENDDO
10270          ENDIF
10271         
10272       CASE ( 'N_bin3' )
10273          IF ( av == 0 )  THEN
10274             DO  i = nxl, nxr
10275                DO  j = nys, nyn
10276                   DO  k = nzb, nzt+1                     
10277                      local_pf(i,j,k) = MERGE( aerosol_number(3)%conc(k,j,i),  &
10278                                               REAL( -999.0_wp, KIND = wp ),   &
10279                                               BTEST( wall_flags_0(k,j,i), 0 ) )
10280                   ENDDO
10281                ENDDO
10282             ENDDO
10283          ELSE
10284             DO  i = nxl, nxr
10285                DO  j = nys, nyn
10286                   DO  k = nzb, nzt+1                     
10287                      local_pf(i,j,k) = MERGE( Nbins_av(k,j,i,3),              &
10288                                               REAL( -999.0_wp, KIND = wp ),   &
10289                                               BTEST( wall_flags_0(k,j,i), 0 ) ) 
10290                   ENDDO
10291                ENDDO
10292             ENDDO
10293          ENDIF
10294       
10295       CASE ( 'N_bin4' )
10296          IF ( av == 0 )  THEN
10297             DO  i = nxl, nxr
10298                DO  j = nys, nyn
10299                   DO  k = nzb, nzt+1   
10300                      local_pf(i,j,k) = MERGE( aerosol_number(4)%conc(k,j,i),  &
10301                                               REAL( -999.0_wp, KIND = wp ),   &
10302                                               BTEST( wall_flags_0(k,j,i), 0 ) )
10303                   ENDDO
10304                ENDDO
10305             ENDDO
10306          ELSE
10307             DO  i = nxl, nxr
10308                DO  j = nys, nyn
10309                   DO  k = nzb, nzt+1                     
10310                      local_pf(i,j,k) = MERGE( Nbins_av(k,j,i,4),              &
10311                                               REAL( -999.0_wp, KIND = wp ),   &
10312                                               BTEST( wall_flags_0(k,j,i), 0 ) ) 
10313                   ENDDO
10314                ENDDO
10315             ENDDO
10316          ENDIF
10317         
10318       CASE ( 'N_bin5' )
10319          IF ( av == 0 )  THEN
10320             DO  i = nxl, nxr
10321                DO  j = nys, nyn
10322                   DO  k = nzb, nzt+1                     
10323                      local_pf(i,j,k) = MERGE( aerosol_number(5)%conc(k,j,i),  &
10324                                               REAL( -999.0_wp, KIND = wp ),   &
10325                                               BTEST( wall_flags_0(k,j,i), 0 ) )
10326                   ENDDO
10327                ENDDO
10328             ENDDO
10329          ELSE
10330             DO  i = nxl, nxr
10331                DO  j = nys, nyn
10332                   DO  k = nzb, nzt+1                     
10333                      local_pf(i,j,k) = MERGE( Nbins_av(k,j,i,5),              &
10334                                               REAL( -999.0_wp, KIND = wp ),   &
10335                                               BTEST( wall_flags_0(k,j,i), 0 ) ) 
10336                   ENDDO
10337                ENDDO
10338             ENDDO
10339          ENDIF
10340       
10341       CASE ( 'N_bin6' )
10342          IF ( av == 0 )  THEN
10343             DO  i = nxl, nxr
10344                DO  j = nys, nyn
10345                   DO  k = nzb, nzt+1                     
10346                      local_pf(i,j,k) = MERGE( aerosol_number(6)%conc(k,j,i),  &
10347                                               REAL( -999.0_wp, KIND = wp ),   &
10348                                               BTEST( wall_flags_0(k,j,i), 0 ) )
10349                   ENDDO
10350                ENDDO
10351             ENDDO
10352          ELSE
10353             DO  i = nxl, nxr
10354                DO  j = nys, nyn
10355                   DO  k = nzb, nzt+1                     
10356                      local_pf(i,j,k) = MERGE( Nbins_av(k,j,i,6),              &
10357                                               REAL( -999.0_wp, KIND = wp ),   &
10358                                               BTEST( wall_flags_0(k,j,i), 0 ) ) 
10359                   ENDDO
10360                ENDDO
10361             ENDDO
10362          ENDIF
10363         
10364       CASE ( 'N_bin7' )
10365          IF ( av == 0 )  THEN
10366             DO  i = nxl, nxr
10367                DO  j = nys, nyn
10368                   DO  k = nzb, nzt+1                     
10369                      local_pf(i,j,k) = MERGE( aerosol_number(7)%conc(k,j,i),  &
10370                                               REAL( -999.0_wp, KIND = wp ),   &
10371                                               BTEST( wall_flags_0(k,j,i), 0 ) )
10372                   ENDDO
10373                ENDDO
10374             ENDDO
10375          ELSE
10376             DO  i = nxl, nxr
10377                DO  j = nys, nyn
10378                   DO  k = nzb, nzt+1                     
10379                      local_pf(i,j,k) = MERGE( Nbins_av(k,j,i,7),              &
10380                                               REAL( -999.0_wp, KIND = wp ),   &
10381                                               BTEST( wall_flags_0(k,j,i), 0 ) ) 
10382                   ENDDO
10383                ENDDO
10384             ENDDO
10385          ENDIF
10386       
10387       CASE ( 'N_bin8' )
10388          IF ( av == 0 )  THEN
10389             DO  i = nxl, nxr
10390                DO  j = nys, nyn
10391                   DO  k = nzb, nzt+1                 
10392                      local_pf(i,j,k) = MERGE( aerosol_number(8)%conc(k,j,i),  &
10393                                               REAL( -999.0_wp, KIND = wp ),   &
10394                                               BTEST( wall_flags_0(k,j,i), 0 ) )
10395                   ENDDO
10396                ENDDO
10397             ENDDO
10398          ELSE
10399             DO  i = nxl, nxr
10400                DO  j = nys, nyn
10401                   DO  k = nzb, nzt+1                     
10402                      local_pf(i,j,k) = MERGE( Nbins_av(k,j,i,8),              &
10403                                               REAL( -999.0_wp, KIND = wp ),   &
10404                                               BTEST( wall_flags_0(k,j,i), 0 ) ) 
10405                   ENDDO
10406                ENDDO
10407             ENDDO
10408          ENDIF
10409         
10410       CASE ( 'N_bin9' )
10411          IF ( av == 0 )  THEN
10412             DO  i = nxl, nxr
10413                DO  j = nys, nyn
10414                   DO  k = nzb, nzt+1                     
10415                      local_pf(i,j,k) = MERGE( aerosol_number(9)%conc(k,j,i),  &
10416                                               REAL( -999.0_wp, KIND = wp ),   &
10417                                               BTEST( wall_flags_0(k,j,i), 0 ) )
10418                   ENDDO
10419                ENDDO
10420             ENDDO
10421          ELSE
10422             DO  i = nxl, nxr
10423                DO  j = nys, nyn
10424                   DO  k = nzb, nzt+1                     
10425                      local_pf(i,j,k) = MERGE( Nbins_av(k,j,i,9),              &
10426                                               REAL( -999.0_wp, KIND = wp ),   &
10427                                               BTEST( wall_flags_0(k,j,i), 0 ) ) 
10428                   ENDDO
10429                ENDDO
10430             ENDDO
10431          ENDIF
10432       
10433       CASE ( 'N_bin10' )
10434          IF ( av == 0 )  THEN
10435             DO  i = nxl, nxr
10436                DO  j = nys, nyn
10437                   DO  k = nzb, nzt+1                     
10438                      local_pf(i,j,k) = MERGE( aerosol_number(10)%conc(k,j,i), &
10439                                               REAL( -999.0_wp, KIND = wp ),   &
10440                                               BTEST( wall_flags_0(k,j,i), 0 ) )
10441                   ENDDO
10442                ENDDO
10443             ENDDO
10444          ELSE
10445             DO  i = nxl, nxr
10446                DO  j = nys, nyn
10447                   DO  k = nzb, nzt+1                     
10448                      local_pf(i,j,k) = MERGE( Nbins_av(k,j,i,10),             &
10449                                               REAL( -999.0_wp, KIND = wp ),   &
10450                                               BTEST( wall_flags_0(k,j,i), 0 ) ) 
10451                   ENDDO
10452                ENDDO
10453             ENDDO
10454          ENDIF
10455         
10456       CASE ( 'N_bin11' )
10457          IF ( av == 0 )  THEN
10458             DO  i = nxl, nxr
10459                DO  j = nys, nyn
10460                   DO  k = nzb, nzt+1                     
10461                      local_pf(i,j,k) = MERGE( aerosol_number(11)%conc(k,j,i), &
10462                                               REAL( -999.0_wp, KIND = wp ),   &
10463                                               BTEST( wall_flags_0(k,j,i), 0 ) )
10464                   ENDDO
10465                ENDDO
10466             ENDDO
10467          ELSE
10468             DO  i = nxl, nxr
10469                DO  j = nys, nyn
10470                   DO  k = nzb, nzt+1                     
10471                      local_pf(i,j,k) = MERGE( Nbins_av(k,j,i,11),             &
10472                                               REAL( -999.0_wp, KIND = wp ),   &
10473                                               BTEST( wall_flags_0(k,j,i), 0 ) ) 
10474                   ENDDO
10475                ENDDO
10476             ENDDO
10477          ENDIF
10478         
10479       CASE ( 'N_bin12' )
10480          IF ( av == 0 )  THEN
10481             DO  i = nxl, nxr
10482                DO  j = nys, nyn
10483                   DO  k = nzb, nzt+1                     
10484                      local_pf(i,j,k) = MERGE( aerosol_number(12)%conc(k,j,i), &
10485                                               REAL( -999.0_wp, KIND = wp ),   &
10486                                               BTEST( wall_flags_0(k,j,i), 0 ) )
10487                   ENDDO
10488                ENDDO
10489             ENDDO
10490          ELSE
10491             DO  i = nxl, nxr
10492                DO  j = nys, nyn
10493                   DO  k = nzb, nzt+1                     
10494                      local_pf(i,j,k) = MERGE( Nbins_av(k,j,i,12),             &
10495                                               REAL( -999.0_wp, KIND = wp ),   &
10496                                               BTEST( wall_flags_0(k,j,i), 0 ) ) 
10497                   ENDDO
10498                ENDDO
10499             ENDDO
10500          ENDIF
10501         
10502       CASE ( 'm_bin1' )
10503          IF ( av == 0 )  THEN
10504             DO  i = nxl, nxr
10505                DO  j = nys, nyn
10506                   DO  k = nzb, nzt+1   
10507                      temp_bin = 0.0_wp
10508                      DO  c = 1, ncc_tot*nbins, nbins
10509                         temp_bin = temp_bin + aerosol_mass(c)%conc(k,j,i)
10510                      ENDDO
10511                      local_pf(i,j,k) = MERGE( temp_bin,                       &
10512                                               REAL( -999.0_wp, KIND = wp ),   &
10513                                               BTEST( wall_flags_0(k,j,i), 0 ) )
10514                   ENDDO
10515                ENDDO
10516             ENDDO
10517          ELSE
10518             DO  i = nxl, nxr
10519                DO  j = nys, nyn
10520                   DO  k = nzb, nzt+1                     
10521                      local_pf(i,j,k) = MERGE( mbins_av(k,j,i,1),              &
10522                                               REAL( -999.0_wp, KIND = wp ),   &
10523                                               BTEST( wall_flags_0(k,j,i), 0 ) ) 
10524                   ENDDO
10525                ENDDO
10526             ENDDO
10527          ENDIF
10528       
10529       CASE ( 'm_bin2' )
10530          IF ( av == 0 )  THEN
10531             DO  i = nxl, nxr
10532                DO  j = nys, nyn
10533                   DO  k = nzb, nzt+1   
10534                      temp_bin = 0.0_wp
10535                      DO  c = 2, ncc_tot*nbins, nbins
10536                         temp_bin = temp_bin + aerosol_mass(c)%conc(k,j,i)
10537                      ENDDO
10538                      local_pf(i,j,k) = MERGE( temp_bin,                       &
10539                                               REAL( -999.0_wp, KIND = wp ),   &
10540                                               BTEST( wall_flags_0(k,j,i), 0 ) )
10541                   ENDDO
10542                ENDDO
10543             ENDDO
10544          ELSE
10545             DO  i = nxl, nxr
10546                DO  j = nys, nyn
10547                   DO  k = nzb, nzt+1                     
10548                      local_pf(i,j,k) = MERGE( mbins_av(k,j,i,2),              &
10549                                               REAL( -999.0_wp, KIND = wp ),   &
10550                                               BTEST( wall_flags_0(k,j,i), 0 ) ) 
10551                   ENDDO
10552                ENDDO
10553             ENDDO
10554          ENDIF
10555         
10556       CASE ( 'm_bin3' )
10557          IF ( av == 0 )  THEN
10558             DO  i = nxl, nxr
10559                DO  j = nys, nyn
10560                   DO  k = nzb, nzt+1   
10561                      temp_bin = 0.0_wp
10562                      DO  c = 3, ncc_tot*nbins, nbins
10563                         temp_bin = temp_bin + aerosol_mass(c)%conc(k,j,i)
10564                      ENDDO
10565                      local_pf(i,j,k) = MERGE( temp_bin,                       &
10566                                               REAL( -999.0_wp, KIND = wp ),   &
10567                                               BTEST( wall_flags_0(k,j,i), 0 ) )
10568                   ENDDO
10569                ENDDO
10570             ENDDO
10571          ELSE
10572             DO  i = nxl, nxr
10573                DO  j = nys, nyn
10574                   DO  k = nzb, nzt+1                     
10575                      local_pf(i,j,k) = MERGE( mbins_av(k,j,i,3),              &
10576                                               REAL( -999.0_wp, KIND = wp ),   &
10577                                               BTEST( wall_flags_0(k,j,i), 0 ) ) 
10578                   ENDDO
10579                ENDDO
10580             ENDDO
10581          ENDIF
10582       
10583       CASE ( 'm_bin4' )
10584          IF ( av == 0 )  THEN
10585             DO  i = nxl, nxr
10586                DO  j = nys, nyn
10587                   DO  k = nzb, nzt+1   
10588                      temp_bin = 0.0_wp
10589                      DO  c = 4, ncc_tot*nbins, nbins
10590                         temp_bin = temp_bin + aerosol_mass(c)%conc(k,j,i)
10591                      ENDDO
10592                      local_pf(i,j,k) = MERGE( temp_bin,                       &
10593                                               REAL( -999.0_wp, KIND = wp ),   &
10594                                               BTEST( wall_flags_0(k,j,i), 0 ) )
10595                   ENDDO
10596                ENDDO
10597             ENDDO
10598          ELSE
10599             DO  i = nxl, nxr
10600                DO  j = nys, nyn
10601                   DO  k = nzb, nzt+1                     
10602                      local_pf(i,j,k) = MERGE( mbins_av(k,j,i,4),              &
10603                                               REAL( -999.0_wp, KIND = wp ),   &
10604                                               BTEST( wall_flags_0(k,j,i), 0 ) ) 
10605                   ENDDO
10606                ENDDO
10607             ENDDO
10608          ENDIF
10609         
10610       CASE ( 'm_bin5' )
10611          IF ( av == 0 )  THEN
10612             DO  i = nxl, nxr
10613                DO  j = nys, nyn
10614                   DO  k = nzb, nzt+1   
10615                      temp_bin = 0.0_wp
10616                      DO  c = 5, ncc_tot*nbins, nbins
10617                         temp_bin = temp_bin + aerosol_mass(c)%conc(k,j,i)
10618                      ENDDO
10619                      local_pf(i,j,k) = MERGE( temp_bin,                       &
10620                                               REAL( -999.0_wp, KIND = wp ),   &
10621                                               BTEST( wall_flags_0(k,j,i), 0 ) )
10622                   ENDDO
10623                ENDDO
10624             ENDDO
10625          ELSE
10626             DO  i = nxl, nxr
10627                DO  j = nys, nyn
10628                   DO  k = nzb, nzt+1                     
10629                      local_pf(i,j,k) = MERGE( mbins_av(k,j,i,5),              &
10630                                               REAL( -999.0_wp, KIND = wp ),   &
10631                                               BTEST( wall_flags_0(k,j,i), 0 ) ) 
10632                   ENDDO
10633                ENDDO
10634             ENDDO
10635          ENDIF
10636       
10637       CASE ( 'm_bin6' )
10638          IF ( av == 0 )  THEN
10639             DO  i = nxl, nxr
10640                DO  j = nys, nyn
10641                   DO  k = nzb, nzt+1   
10642                      temp_bin = 0.0_wp
10643                      DO  c = 6, ncc_tot*nbins, nbins
10644                         temp_bin = temp_bin + aerosol_mass(c)%conc(k,j,i)
10645                      ENDDO
10646                      local_pf(i,j,k) = MERGE( temp_bin,                       &
10647                                               REAL( -999.0_wp, KIND = wp ),   &
10648                                               BTEST( wall_flags_0(k,j,i), 0 ) )
10649                   ENDDO
10650                ENDDO
10651             ENDDO
10652          ELSE
10653             DO  i = nxl, nxr
10654                DO  j = nys, nyn
10655                   DO  k = nzb, nzt+1                     
10656                      local_pf(i,j,k) = MERGE( mbins_av(k,j,i,6),              &
10657                                               REAL( -999.0_wp, KIND = wp ),   &
10658                                               BTEST( wall_flags_0(k,j,i), 0 ) ) 
10659                   ENDDO
10660                ENDDO
10661             ENDDO
10662          ENDIF
10663         
10664       CASE ( 'm_bin7' )
10665          IF ( av == 0 )  THEN
10666             DO  i = nxl, nxr
10667                DO  j = nys, nyn
10668                   DO  k = nzb, nzt+1   
10669                      temp_bin = 0.0_wp
10670                      DO  c = 7, ncc_tot*nbins, nbins
10671                         temp_bin = temp_bin + aerosol_mass(c)%conc(k,j,i)
10672                      ENDDO
10673                      local_pf(i,j,k) = MERGE( temp_bin,                       &
10674                                               REAL( -999.0_wp, KIND = wp ),   &
10675                                               BTEST( wall_flags_0(k,j,i), 0 ) )
10676                   ENDDO
10677                ENDDO
10678             ENDDO
10679          ELSE
10680             DO  i = nxl, nxr
10681                DO  j = nys, nyn
10682                   DO  k = nzb, nzt+1                     
10683                      local_pf(i,j,k) = MERGE( mbins_av(k,j,i,7),              &
10684                                               REAL( -999.0_wp, KIND = wp ),   &
10685                                               BTEST( wall_flags_0(k,j,i), 0 ) ) 
10686                   ENDDO
10687                ENDDO
10688             ENDDO
10689          ENDIF
10690       
10691       CASE ( 'm_bin8' )
10692          IF ( av == 0 )  THEN
10693             DO  i = nxl, nxr
10694                DO  j = nys, nyn
10695                   DO  k = nzb, nzt+1   
10696                      temp_bin = 0.0_wp
10697                      DO  c = 8, ncc_tot*nbins, nbins
10698                         temp_bin = temp_bin + aerosol_mass(c)%conc(k,j,i)
10699                      ENDDO
10700                      local_pf(i,j,k) = MERGE( temp_bin,                       &
10701                                               REAL( -999.0_wp, KIND = wp ),   &
10702                                               BTEST( wall_flags_0(k,j,i), 0 ) )
10703                   ENDDO
10704                ENDDO
10705             ENDDO
10706          ELSE
10707             DO  i = nxl, nxr
10708                DO  j = nys, nyn
10709                   DO  k = nzb, nzt+1                     
10710                      local_pf(i,j,k) = MERGE( mbins_av(k,j,i,8),              &
10711                                               REAL( -999.0_wp, KIND = wp ),   &
10712                                               BTEST( wall_flags_0(k,j,i), 0 ) ) 
10713                   ENDDO
10714                ENDDO
10715             ENDDO
10716          ENDIF
10717         
10718       CASE ( 'm_bin9' )
10719          IF ( av == 0 )  THEN
10720             DO  i = nxl, nxr
10721                DO  j = nys, nyn
10722                   DO  k = nzb, nzt+1   
10723                      temp_bin = 0.0_wp
10724                      DO  c = 9, ncc_tot*nbins, nbins
10725                         temp_bin = temp_bin + aerosol_mass(c)%conc(k,j,i)
10726                      ENDDO
10727                      local_pf(i,j,k) = MERGE( temp_bin,                       &
10728                                               REAL( -999.0_wp, KIND = wp ),   &
10729                                               BTEST( wall_flags_0(k,j,i), 0 ) )
10730                   ENDDO
10731                ENDDO
10732             ENDDO
10733          ELSE
10734             DO  i = nxl, nxr
10735                DO  j = nys, nyn
10736                   DO  k = nzb, nzt+1                     
10737                      local_pf(i,j,k) = MERGE( mbins_av(k,j,i,9),              &
10738                                               REAL( -999.0_wp, KIND = wp ),   &
10739                                               BTEST( wall_flags_0(k,j,i), 0 ) ) 
10740                   ENDDO
10741                ENDDO
10742             ENDDO
10743          ENDIF
10744       
10745       CASE ( 'm_bin10' )
10746          IF ( av == 0 )  THEN
10747             DO  i = nxl, nxr
10748                DO  j = nys, nyn
10749                   DO  k = nzb, nzt+1   
10750                      temp_bin = 0.0_wp
10751                      DO  c = 10, ncc_tot*nbins, nbins
10752                         temp_bin = temp_bin + aerosol_mass(c)%conc(k,j,i)
10753                      ENDDO
10754                      local_pf(i,j,k) = MERGE( temp_bin,                       &
10755                                               REAL( -999.0_wp, KIND = wp ),   &
10756                                               BTEST( wall_flags_0(k,j,i), 0 ) )
10757                   ENDDO
10758                ENDDO
10759             ENDDO
10760          ELSE
10761             DO  i = nxl, nxr
10762                DO  j = nys, nyn
10763                   DO  k = nzb, nzt+1                     
10764                      local_pf(i,j,k) = MERGE( mbins_av(k,j,i,10),             &
10765                                               REAL( -999.0_wp, KIND = wp ),   &
10766                                               BTEST( wall_flags_0(k,j,i), 0 ) ) 
10767                   ENDDO
10768                ENDDO
10769             ENDDO
10770          ENDIF
10771         
10772       CASE ( 'm_bin11' )
10773          IF ( av == 0 )  THEN
10774             DO  i = nxl, nxr
10775                DO  j = nys, nyn
10776                   DO  k = nzb, nzt+1   
10777                      temp_bin = 0.0_wp
10778                      DO  c = 11, ncc_tot*nbins, nbins
10779                         temp_bin = temp_bin + aerosol_mass(c)%conc(k,j,i)
10780                      ENDDO
10781                      local_pf(i,j,k) = MERGE( temp_bin,                       &
10782                                               REAL( -999.0_wp, KIND = wp ),   &
10783                                               BTEST( wall_flags_0(k,j,i), 0 ) )
10784                   ENDDO
10785                ENDDO
10786             ENDDO
10787          ELSE
10788             DO  i = nxl, nxr
10789                DO  j = nys, nyn
10790                   DO  k = nzb, nzt+1                     
10791                      local_pf(i,j,k) = MERGE( mbins_av(k,j,i,11),             &
10792                                               REAL( -999.0_wp, KIND = wp ),   &
10793                                               BTEST( wall_flags_0(k,j,i), 0 ) ) 
10794                   ENDDO
10795                ENDDO
10796             ENDDO
10797          ENDIF
10798         
10799       CASE ( 'm_bin12' )
10800          IF ( av == 0 )  THEN
10801             DO  i = nxl, nxr
10802                DO  j = nys, nyn
10803                   DO  k = nzb, nzt+1   
10804                      temp_bin = 0.0_wp
10805                      DO  c = 12, ncc_tot*nbins, nbins
10806                         temp_bin = temp_bin + aerosol_mass(c)%conc(k,j,i)
10807                      ENDDO
10808                      local_pf(i,j,k) = MERGE( temp_bin,                       &
10809                                               REAL( -999.0_wp, KIND = wp ),   &
10810                                               BTEST( wall_flags_0(k,j,i), 0 ) )
10811                   ENDDO
10812                ENDDO
10813             ENDDO
10814          ELSE
10815             DO  i = nxl, nxr
10816                DO  j = nys, nyn
10817                   DO  k = nzb, nzt+1                     
10818                      local_pf(i,j,k) = MERGE( mbins_av(k,j,i,12),             &
10819                                               REAL( -999.0_wp, KIND = wp ),   &
10820                                               BTEST( wall_flags_0(k,j,i), 0 ) ) 
10821                   ENDDO
10822                ENDDO
10823             ENDDO
10824          ENDIF
10825                 
10826       CASE ( 's_BC', 's_DU', 's_H2O', 's_NH', 's_NO', 's_OC', 's_SO4', 's_SS' )
10827          IF ( is_used( prtcl, TRIM( variable(3:) ) ) )  THEN
10828             icc = get_index( prtcl, TRIM( variable(3:) ) )
10829             IF ( av == 0 )  THEN
10830                DO  i = nxl, nxr
10831                   DO  j = nys, nyn
10832                      DO  k = nzb, nzt+1
10833                         temp_bin = 0.0_wp
10834                         DO  c = ( icc-1 )*nbins+1, icc*nbins                         
10835                            temp_bin = temp_bin + aerosol_mass(c)%conc(k,j,i)
10836                         ENDDO
10837                         local_pf(i,j,k) = MERGE( temp_bin,                    &
10838                                               REAL( -999.0_wp, KIND = wp ),   &
10839                                               BTEST( wall_flags_0(k,j,i), 0 ) ) 
10840                      ENDDO
10841                   ENDDO
10842                ENDDO
10843             ELSE
10844                IF ( TRIM( variable(3:) ) == 'BC' )   to_be_resorted => s_BC_av
10845                IF ( TRIM( variable(3:) ) == 'DU' )   to_be_resorted => s_DU_av   
10846                IF ( TRIM( variable(3:) ) == 'NH' )   to_be_resorted => s_NH_av   
10847                IF ( TRIM( variable(3:) ) == 'NO' )   to_be_resorted => s_NO_av   
10848                IF ( TRIM( variable(3:) ) == 'OC' )   to_be_resorted => s_OC_av   
10849                IF ( TRIM( variable(3:) ) == 'SO4' )  to_be_resorted => s_SO4_av   
10850                IF ( TRIM( variable(3:) ) == 'SS' )   to_be_resorted => s_SS_av 
10851                DO  i = nxl, nxr
10852                   DO  j = nys, nyn
10853                      DO  k = nzb, nzt+1                     
10854                         local_pf(i,j,k) = MERGE( to_be_resorted(k,j,i),       &
10855                                               REAL( -999.0_wp, KIND = wp ),   &
10856                                               BTEST( wall_flags_0(k,j,i), 0 ) ) 
10857                      ENDDO
10858                   ENDDO
10859                ENDDO
10860             ENDIF
10861          ENDIF
10862       CASE DEFAULT
10863          found = .FALSE.
10864
10865    END SELECT
10866
10867 END SUBROUTINE salsa_data_output_3d
10868
10869!------------------------------------------------------------------------------!
10870!
10871! Description:
10872! ------------
10873!> Subroutine defining mask output variables
10874!------------------------------------------------------------------------------!
10875 SUBROUTINE salsa_data_output_mask( av, variable, found, local_pf )
10876 
10877    USE control_parameters,                                                    &
10878        ONLY:  mask_size_l, mid
10879 
10880    IMPLICIT NONE
10881   
10882    CHARACTER (LEN=*) ::  variable   !<
10883
10884    INTEGER(iwp) ::  av   !<
10885    INTEGER(iwp) ::  c    !<
10886    INTEGER(iwp) ::  i    !<
10887    INTEGER(iwp) ::  icc  !< index of a chemical compound
10888    INTEGER(iwp) ::  j    !<
10889    INTEGER(iwp) ::  k    !<
10890    INTEGER(iwp) ::  n    !<
10891
10892    LOGICAL  ::  found    !<
10893    REAL(wp) ::  df       !< For calculating LDSA: fraction of particles
10894                          !< depositing in the alveolar (or tracheobronchial)
10895                          !< region of the lung. Depends on the particle size
10896    REAL(wp) ::  mean_d       !< Particle diameter in micrometres
10897    REAL(wp) ::  nc       !< Particle number concentration in units 1/cm**3
10898
10899    REAL(wp),                                                                  &
10900       DIMENSION(mask_size_l(mid,1),mask_size_l(mid,2),mask_size_l(mid,3)) ::  &
10901          local_pf   !<
10902    REAL(wp) ::  temp_bin   !<
10903    REAL(wp), DIMENSION(:,:,:), POINTER ::  to_be_resorted  !< points to
10904                                                     !< selected output variable
10905
10906    found     = .TRUE.
10907    temp_bin  = 0.0_wp
10908
10909    SELECT CASE ( TRIM( variable ) )
10910   
10911       CASE ( 'g_H2SO4', 'g_HNO3', 'g_NH3', 'g_OCNV',  'g_OCSV' )
10912          IF ( av == 0 )  THEN
10913             IF ( TRIM( variable ) == 'g_H2SO4')  icc = 1
10914             IF ( TRIM( variable ) == 'g_HNO3')   icc = 2
10915             IF ( TRIM( variable ) == 'g_NH3')    icc = 3
10916             IF ( TRIM( variable ) == 'g_OCNV')   icc = 4
10917             IF ( TRIM( variable ) == 'g_OCSV')   icc = 5
10918             
10919             DO  i = 1, mask_size_l(mid,1)
10920                DO  j = 1, mask_size_l(mid,2)
10921                   DO  k = 1, mask_size_l(mid,3)
10922                      local_pf(i,j,k) = salsa_gas(icc)%conc(mask_k(mid,k),     &
10923                                                    mask_j(mid,j),mask_i(mid,i))
10924                   ENDDO
10925                ENDDO
10926             ENDDO
10927          ELSE
10928             IF ( TRIM( variable(3:) ) == 'H2SO4' ) to_be_resorted => g_H2SO4_av
10929             IF ( TRIM( variable(3:) ) == 'HNO3' )  to_be_resorted => g_HNO3_av   
10930             IF ( TRIM( variable(3:) ) == 'NH3' )   to_be_resorted => g_NH3_av   
10931             IF ( TRIM( variable(3:) ) == 'OCNV' )  to_be_resorted => g_OCNV_av   
10932             IF ( TRIM( variable(3:) ) == 'OCSV' )  to_be_resorted => g_OCSV_av 
10933             DO  i = 1, mask_size_l(mid,1)
10934                DO  j = 1, mask_size_l(mid,2)
10935                   DO  k = 1, mask_size_l(mid,3)
10936                      local_pf(i,j,k) = to_be_resorted(mask_k(mid,k),          &
10937                                                    mask_j(mid,j),mask_i(mid,i))
10938                   ENDDO
10939                ENDDO
10940             ENDDO
10941          ENDIF
10942       
10943       CASE ( 'LDSA' )
10944          IF ( av == 0 )  THEN
10945             DO  i = 1, mask_size_l(mid,1)
10946                DO  j = 1, mask_size_l(mid,2)
10947                   DO  k = 1, mask_size_l(mid,3)
10948                      temp_bin = 0.0_wp
10949                      DO  n = 1, nbins
10950!                     
10951!--                      Diameter in micrometres
10952                         mean_d = 1.0E+6_wp * Ra_dry(mask_k(mid,k),            &
10953                                       mask_j(mid,j),mask_i(mid,i),n) * 2.0_wp
10954!                               
10955!--                      Deposition factor: alveolar (use Ra_dry for the size??)                               
10956                         df = ( 0.01555_wp / mean_d ) * ( EXP( -0.416_wp *     &
10957                                ( LOG( mean_d ) + 2.84_wp )**2.0_wp )          &
10958                                  + 19.11_wp * EXP( -0.482_wp *                &
10959                                  ( LOG( mean_d ) - 1.362_wp )**2.0_wp ) )
10960!                                   
10961!--                      Number concentration in 1/cm3
10962                         nc = 1.0E-6_wp * aerosol_number(n)%conc(mask_k(mid,k),&
10963                                                    mask_j(mid,j),mask_i(mid,i))
10964!                         
10965!--                      Lung-deposited surface area LDSA (units mum2/cm3)
10966                         temp_bin = temp_bin + pi * mean_d**2.0_wp * df * nc 
10967                      ENDDO
10968                      local_pf(i,j,k) = temp_bin
10969                   ENDDO
10970                ENDDO
10971             ENDDO
10972          ELSE
10973             DO  i = 1, mask_size_l(mid,1)
10974                DO  j = 1, mask_size_l(mid,2)
10975                   DO  k = 1, mask_size_l(mid,3)
10976                       local_pf(i,j,k) = LDSA_av(mask_k(mid,k),                &
10977                                                 mask_j(mid,j),mask_i(mid,i))
10978                   ENDDO
10979                ENDDO
10980             ENDDO
10981          ENDIF
10982       
10983       CASE ( 'Ntot' )
10984          IF ( av == 0 )  THEN
10985             DO  i = 1, mask_size_l(mid,1)
10986                DO  j = 1, mask_size_l(mid,2)
10987                   DO  k = 1, mask_size_l(mid,3)
10988                      temp_bin = 0.0_wp
10989                      DO  n = 1, nbins
10990                         temp_bin = temp_bin + aerosol_number(n)%conc(         &
10991                                    mask_k(mid,k),mask_j(mid,j),mask_i(mid,i))
10992                      ENDDO
10993                      local_pf(i,j,k) = temp_bin
10994                   ENDDO
10995                ENDDO
10996             ENDDO
10997          ELSE
10998             DO  i = 1, mask_size_l(mid,1)
10999                DO  j = 1, mask_size_l(mid,2)
11000                   DO  k = 1, mask_size_l(mid,3)
11001                       local_pf(i,j,k) = Ntot_av(mask_k(mid,k),                &
11002                                                 mask_j(mid,j),mask_i(mid,i))
11003                   ENDDO
11004                ENDDO
11005             ENDDO
11006          ENDIF
11007       
11008       CASE ( 'PM2.5' )
11009          IF ( av == 0 )  THEN
11010             DO  i = 1, mask_size_l(mid,1)
11011                DO  j = 1, mask_size_l(mid,2)
11012                   DO  k = 1, mask_size_l(mid,3)
11013                      temp_bin = 0.0_wp
11014                      DO  n = 1, nbins
11015                         IF ( 2.0_wp * Ra_dry(mask_k(mid,k),mask_j(mid,j),     &
11016                              mask_i(mid,i),n) <= 2.5E-6_wp )  THEN
11017                            DO  c = n, nbins*ncc, nbins
11018                               temp_bin = temp_bin + aerosol_mass(c)%conc(     &
11019                                     mask_k(mid,k), mask_j(mid,j),mask_i(mid,i))
11020                            ENDDO
11021                         ENDIF
11022                      ENDDO
11023                      local_pf(i,j,k) = temp_bin
11024                   ENDDO
11025                ENDDO
11026             ENDDO
11027          ELSE
11028             DO  i = 1, mask_size_l(mid,1)
11029                DO  j = 1, mask_size_l(mid,2)
11030                   DO  k = 1, mask_size_l(mid,3)
11031                       local_pf(i,j,k) = PM25_av(mask_k(mid,k),                &
11032                                                 mask_j(mid,j),mask_i(mid,i))
11033                   ENDDO
11034                ENDDO
11035             ENDDO
11036          ENDIF
11037       
11038       CASE ( 'PM10' )
11039          IF ( av == 0 )  THEN
11040             DO  i = 1, mask_size_l(mid,1)
11041                DO  j = 1, mask_size_l(mid,2)
11042                   DO  k = 1, mask_size_l(mid,3)
11043                      temp_bin = 0.0_wp
11044                      DO  n = 1, nbins
11045                         IF ( 2.0_wp * Ra_dry(mask_k(mid,k),mask_j(mid,j),     &
11046                              mask_i(mid,i),n) <= 10.0E-6_wp )  THEN
11047                            DO  c = n, nbins*ncc, nbins
11048                               temp_bin = temp_bin + aerosol_mass(c)%conc(     &
11049                                      mask_k(mid,k),mask_j(mid,j),mask_i(mid,i))
11050                            ENDDO
11051                         ENDIF
11052                      ENDDO
11053                      local_pf(i,j,k) = temp_bin
11054                   ENDDO
11055                ENDDO
11056             ENDDO
11057          ELSE
11058             DO  i = 1, mask_size_l(mid,1)
11059                DO  j = 1, mask_size_l(mid,2)
11060                   DO  k = 1, mask_size_l(mid,3)
11061                       local_pf(i,j,k) = PM10_av(mask_k(mid,k),                &
11062                                                 mask_j(mid,j),mask_i(mid,i))
11063                   ENDDO
11064                ENDDO
11065             ENDDO
11066          ENDIF
11067         
11068       CASE ( 'N_bin1' )
11069          IF ( av == 0 )  THEN
11070             DO  i = 1, mask_size_l(mid,1)
11071                DO  j = 1, mask_size_l(mid,2)
11072                   DO  k = 1, mask_size_l(mid,3)                     
11073                      local_pf(i,j,k) = aerosol_number(1)%conc(mask_k(mid,k),  &
11074                                                 mask_j(mid,j),mask_i(mid,i))
11075                   ENDDO
11076                ENDDO
11077             ENDDO
11078          ELSE
11079             DO  i = 1, mask_size_l(mid,1)
11080                DO  j = 1, mask_size_l(mid,2)
11081                   DO  k = 1, mask_size_l(mid,3)
11082                       local_pf(i,j,k) = Nbins_av(mask_k(mid,k),               &
11083                                                  mask_j(mid,j),mask_i(mid,i),1)
11084                   ENDDO
11085                ENDDO
11086             ENDDO
11087          ENDIF
11088       
11089       CASE ( 'N_bin2' )
11090          IF ( av == 0 )  THEN
11091             DO  i = 1, mask_size_l(mid,1)
11092                DO  j = 1, mask_size_l(mid,2)
11093                   DO  k = 1, mask_size_l(mid,3)                     
11094                      local_pf(i,j,k) = aerosol_number(2)%conc(mask_k(mid,k),  &
11095                                                 mask_j(mid,j),mask_i(mid,i)) 
11096                   ENDDO
11097                ENDDO
11098             ENDDO
11099          ELSE
11100             DO  i = 1, mask_size_l(mid,1)
11101                DO  j = 1, mask_size_l(mid,2)
11102                   DO  k = 1, mask_size_l(mid,3)
11103                       local_pf(i,j,k) = Nbins_av(mask_k(mid,k),               &
11104                                                  mask_j(mid,j),mask_i(mid,i),2)
11105                   ENDDO
11106                ENDDO
11107             ENDDO
11108          ENDIF
11109         
11110       CASE ( 'N_bin3' )
11111          IF ( av == 0 )  THEN
11112             DO  i = 1, mask_size_l(mid,1)
11113                DO  j = 1, mask_size_l(mid,2)
11114                   DO  k = 1, mask_size_l(mid,3)                     
11115                      local_pf(i,j,k) = aerosol_number(3)%conc(mask_k(mid,k),  &
11116                                                 mask_j(mid,j),mask_i(mid,i))
11117                   ENDDO
11118                ENDDO
11119             ENDDO
11120          ELSE
11121             DO  i = 1, mask_size_l(mid,1)
11122                DO  j = 1, mask_size_l(mid,2)
11123                   DO  k = 1, mask_size_l(mid,3)
11124                       local_pf(i,j,k) = Nbins_av(mask_k(mid,k),               &
11125                                                  mask_j(mid,j),mask_i(mid,i),3)
11126                   ENDDO
11127                ENDDO
11128             ENDDO
11129          ENDIF
11130       
11131       CASE ( 'N_bin4' )
11132          IF ( av == 0 )  THEN
11133             DO  i = 1, mask_size_l(mid,1)
11134                DO  j = 1, mask_size_l(mid,2)
11135                   DO  k = 1, mask_size_l(mid,3)                     
11136                      local_pf(i,j,k) = aerosol_number(4)%conc(mask_k(mid,k),  &
11137                                                 mask_j(mid,j),mask_i(mid,i))
11138                   ENDDO
11139                ENDDO
11140             ENDDO
11141          ELSE
11142             DO  i = 1, mask_size_l(mid,1)
11143                DO  j = 1, mask_size_l(mid,2)
11144                   DO  k = 1, mask_size_l(mid,3)
11145                       local_pf(i,j,k) = Nbins_av(mask_k(mid,k),               &
11146                                                  mask_j(mid,j),mask_i(mid,i),4)
11147                   ENDDO
11148                ENDDO
11149             ENDDO
11150          ENDIF
11151       
11152       CASE ( 'N_bin5' )
11153          IF ( av == 0 )  THEN
11154             DO  i = 1, mask_size_l(mid,1)
11155                DO  j = 1, mask_size_l(mid,2)
11156                   DO  k = 1, mask_size_l(mid,3)                     
11157                      local_pf(i,j,k) = aerosol_number(5)%conc(mask_k(mid,k),  &
11158                                                 mask_j(mid,j),mask_i(mid,i))
11159                   ENDDO
11160                ENDDO
11161             ENDDO
11162          ELSE
11163             DO  i = 1, mask_size_l(mid,1)
11164                DO  j = 1, mask_size_l(mid,2)
11165                   DO  k = 1, mask_size_l(mid,3)
11166                       local_pf(i,j,k) = Nbins_av(mask_k(mid,k),               &
11167                                                  mask_j(mid,j),mask_i(mid,i),5)
11168                   ENDDO
11169                ENDDO
11170             ENDDO
11171          ENDIF
11172       
11173       CASE ( 'N_bin6' )
11174          IF ( av == 0 )  THEN
11175             DO  i = 1, mask_size_l(mid,1)
11176                DO  j = 1, mask_size_l(mid,2)
11177                   DO  k = 1, mask_size_l(mid,3)                     
11178                      local_pf(i,j,k) = aerosol_number(6)%conc(mask_k(mid,k),  &
11179                                                 mask_j(mid,j),mask_i(mid,i)) 
11180                   ENDDO
11181                ENDDO
11182             ENDDO
11183          ELSE
11184             DO  i = 1, mask_size_l(mid,1)
11185                DO  j = 1, mask_size_l(mid,2)
11186                   DO  k = 1, mask_size_l(mid,3)
11187                       local_pf(i,j,k) = Nbins_av(mask_k(mid,k),               &
11188                                                  mask_j(mid,j),mask_i(mid,i),6)
11189                   ENDDO
11190                ENDDO
11191             ENDDO
11192          ENDIF
11193         
11194       CASE ( 'N_bin7' )
11195          IF ( av == 0 )  THEN
11196             DO  i = 1, mask_size_l(mid,1)
11197                DO  j = 1, mask_size_l(mid,2)
11198                   DO  k = 1, mask_size_l(mid,3)                     
11199                      local_pf(i,j,k) = aerosol_number(7)%conc(mask_k(mid,k),  &
11200                                                 mask_j(mid,j),mask_i(mid,i)) 
11201                   ENDDO
11202                ENDDO
11203             ENDDO
11204          ELSE
11205             DO  i = 1, mask_size_l(mid,1)
11206                DO  j = 1, mask_size_l(mid,2)
11207                   DO  k = 1, mask_size_l(mid,3)
11208                       local_pf(i,j,k) = Nbins_av(mask_k(mid,k),               &
11209                                                  mask_j(mid,j),mask_i(mid,i),7)
11210                   ENDDO
11211                ENDDO
11212             ENDDO
11213          ENDIF
11214       
11215       CASE ( 'N_bin8' )
11216          IF ( av == 0 )  THEN
11217             DO  i = 1, mask_size_l(mid,1)
11218                DO  j = 1, mask_size_l(mid,2)
11219                   DO  k = 1, mask_size_l(mid,3)                     
11220                      local_pf(i,j,k) = aerosol_number(8)%conc(mask_k(mid,k),  &
11221                                                 mask_j(mid,j),mask_i(mid,i)) 
11222                   ENDDO
11223                ENDDO
11224             ENDDO
11225          ELSE
11226             DO  i = 1, mask_size_l(mid,1)
11227                DO  j = 1, mask_size_l(mid,2)
11228                   DO  k = 1, mask_size_l(mid,3)
11229                       local_pf(i,j,k) = Nbins_av(mask_k(mid,k),               &
11230                                                  mask_j(mid,j),mask_i(mid,i),8)
11231                   ENDDO
11232                ENDDO
11233             ENDDO
11234          ENDIF
11235         
11236       CASE ( 'N_bin9' )
11237          IF ( av == 0 )  THEN
11238             DO  i = 1, mask_size_l(mid,1)
11239                DO  j = 1, mask_size_l(mid,2)
11240                   DO  k = 1, mask_size_l(mid,3)                     
11241                      local_pf(i,j,k) = aerosol_number(9)%conc(mask_k(mid,k),  &
11242                                                 mask_j(mid,j),mask_i(mid,i)) 
11243                   ENDDO
11244                ENDDO
11245             ENDDO
11246          ELSE
11247             DO  i = 1, mask_size_l(mid,1)
11248                DO  j = 1, mask_size_l(mid,2)
11249                   DO  k = 1, mask_size_l(mid,3)
11250                       local_pf(i,j,k) = Nbins_av(mask_k(mid,k),               &
11251                                                  mask_j(mid,j),mask_i(mid,i),9)
11252                   ENDDO
11253                ENDDO
11254             ENDDO
11255          ENDIF
11256       
11257       CASE ( 'N_bin10' )
11258          IF ( av == 0 )  THEN
11259             DO  i = 1, mask_size_l(mid,1)
11260                DO  j = 1, mask_size_l(mid,2)
11261                   DO  k = 1, mask_size_l(mid,3)                     
11262                      local_pf(i,j,k) = aerosol_number(10)%conc(mask_k(mid,k), &
11263                                                 mask_j(mid,j),mask_i(mid,i)) 
11264                   ENDDO
11265                ENDDO
11266             ENDDO
11267          ELSE
11268             DO  i = 1, mask_size_l(mid,1)
11269                DO  j = 1, mask_size_l(mid,2)
11270                   DO  k = 1, mask_size_l(mid,3)
11271                       local_pf(i,j,k) = Nbins_av(mask_k(mid,k),               &
11272                                                 mask_j(mid,j),mask_i(mid,i),10)
11273                   ENDDO
11274                ENDDO
11275             ENDDO
11276          ENDIF
11277       
11278       CASE ( 'N_bin11' )
11279          IF ( av == 0 )  THEN
11280             DO  i = 1, mask_size_l(mid,1)
11281                DO  j = 1, mask_size_l(mid,2)
11282                   DO  k = 1, mask_size_l(mid,3)                     
11283                      local_pf(i,j,k) = aerosol_number(11)%conc(mask_k(mid,k), &
11284                                                 mask_j(mid,j),mask_i(mid,i)) 
11285                   ENDDO
11286                ENDDO
11287             ENDDO
11288          ELSE
11289             DO  i = 1, mask_size_l(mid,1)
11290                DO  j = 1, mask_size_l(mid,2)
11291                   DO  k = 1, mask_size_l(mid,3)
11292                       local_pf(i,j,k) = Nbins_av(mask_k(mid,k),               &
11293                                                 mask_j(mid,j),mask_i(mid,i),11)
11294                   ENDDO
11295                ENDDO
11296             ENDDO
11297          ENDIF
11298         
11299       CASE ( 'N_bin12' )
11300          IF ( av == 0 )  THEN
11301             DO  i = 1, mask_size_l(mid,1)
11302                DO  j = 1, mask_size_l(mid,2)
11303                   DO  k = 1, mask_size_l(mid,3)                     
11304                      local_pf(i,j,k) = aerosol_number(12)%conc(mask_k(mid,k), &
11305                                                 mask_j(mid,j),mask_i(mid,i)) 
11306                   ENDDO
11307                ENDDO
11308             ENDDO
11309          ELSE
11310             DO  i = 1, mask_size_l(mid,1)
11311                DO  j = 1, mask_size_l(mid,2)
11312                   DO  k = 1, mask_size_l(mid,3)
11313                       local_pf(i,j,k) = Nbins_av(mask_k(mid,k),               &
11314                                                 mask_j(mid,j),mask_i(mid,i),12)
11315                   ENDDO
11316                ENDDO
11317             ENDDO
11318          ENDIF
11319         
11320       CASE ( 'm_bin1' )
11321          IF ( av == 0 )  THEN
11322             DO  i = 1, mask_size_l(mid,1)
11323                DO  j = 1, mask_size_l(mid,2)
11324                   DO  k = 1, mask_size_l(mid,3)
11325                      temp_bin = 0.0_wp
11326                      DO  c = 1, ncc_tot*nbins, nbins
11327                         temp_bin = temp_bin + aerosol_mass(c)%conc(           &
11328                                    mask_k(mid,k),mask_j(mid,j),mask_i(mid,i))
11329                      ENDDO
11330                      local_pf(i,j,k) = temp_bin
11331                   ENDDO
11332                ENDDO
11333             ENDDO
11334          ELSE
11335             DO  i = 1, mask_size_l(mid,1)
11336                DO  j = 1, mask_size_l(mid,2)
11337                   DO  k = 1, mask_size_l(mid,3)
11338                       local_pf(i,j,k) = mbins_av(mask_k(mid,k),               &
11339                                                  mask_j(mid,j),mask_i(mid,i),1)
11340                   ENDDO
11341                ENDDO
11342             ENDDO
11343          ENDIF
11344       
11345       CASE ( 'm_bin2' )
11346          IF ( av == 0 )  THEN
11347             DO  i = 1, mask_size_l(mid,1)
11348                DO  j = 1, mask_size_l(mid,2)
11349                   DO  k = 1, mask_size_l(mid,3)
11350                      temp_bin = 0.0_wp
11351                      DO  c = 2, ncc_tot*nbins, nbins
11352                         temp_bin = temp_bin + aerosol_mass(c)%conc(           &
11353                                    mask_k(mid,k),mask_j(mid,j),mask_i(mid,i))
11354                      ENDDO
11355                      local_pf(i,j,k) = temp_bin
11356                   ENDDO
11357                ENDDO
11358             ENDDO
11359          ELSE
11360             DO  i = 1, mask_size_l(mid,1)
11361                DO  j = 1, mask_size_l(mid,2)
11362                   DO  k = 1, mask_size_l(mid,3)
11363                       local_pf(i,j,k) = mbins_av(mask_k(mid,k),               &
11364                                                  mask_j(mid,j),mask_i(mid,i),2)
11365                   ENDDO
11366                ENDDO
11367             ENDDO
11368          ENDIF
11369         
11370       CASE ( 'm_bin3' )
11371          IF ( av == 0 )  THEN
11372             DO  i = 1, mask_size_l(mid,1)
11373                DO  j = 1, mask_size_l(mid,2)
11374                   DO  k = 1, mask_size_l(mid,3)
11375                      temp_bin = 0.0_wp
11376                      DO  c = 3, ncc_tot*nbins, nbins
11377                         temp_bin = temp_bin + aerosol_mass(c)%conc(           &
11378                                    mask_k(mid,k),mask_j(mid,j),mask_i(mid,i))
11379                      ENDDO
11380                      local_pf(i,j,k) = temp_bin
11381                   ENDDO
11382                ENDDO
11383             ENDDO
11384          ELSE
11385             DO  i = 1, mask_size_l(mid,1)
11386                DO  j = 1, mask_size_l(mid,2)
11387                   DO  k = 1, mask_size_l(mid,3)
11388                       local_pf(i,j,k) = mbins_av(mask_k(mid,k),               &
11389                                                  mask_j(mid,j),mask_i(mid,i),3)
11390                   ENDDO
11391                ENDDO
11392             ENDDO
11393          ENDIF
11394       
11395       CASE ( 'm_bin4' )
11396          IF ( av == 0 )  THEN
11397             DO  i = 1, mask_size_l(mid,1)
11398                DO  j = 1, mask_size_l(mid,2)
11399                   DO  k = 1, mask_size_l(mid,3)
11400                      temp_bin = 0.0_wp
11401                      DO  c = 4, ncc_tot*nbins, nbins
11402                         temp_bin = temp_bin + aerosol_mass(c)%conc(           &
11403                                    mask_k(mid,k),mask_j(mid,j),mask_i(mid,i))
11404                      ENDDO
11405                      local_pf(i,j,k) = temp_bin
11406                   ENDDO
11407                ENDDO
11408             ENDDO
11409          ELSE
11410             DO  i = 1, mask_size_l(mid,1)
11411                DO  j = 1, mask_size_l(mid,2)
11412                   DO  k = 1, mask_size_l(mid,3)
11413                       local_pf(i,j,k) = mbins_av(mask_k(mid,k),               &
11414                                                  mask_j(mid,j),mask_i(mid,i),4)
11415                   ENDDO
11416                ENDDO
11417             ENDDO
11418          ENDIF
11419       
11420       CASE ( 'm_bin5' )
11421          IF ( av == 0 )  THEN
11422             DO  i = 1, mask_size_l(mid,1)
11423                DO  j = 1, mask_size_l(mid,2)
11424                   DO  k = 1, mask_size_l(mid,3)
11425                      temp_bin = 0.0_wp
11426                      DO  c = 5, ncc_tot*nbins, nbins
11427                         temp_bin = temp_bin + aerosol_mass(c)%conc(           &
11428                                    mask_k(mid,k),mask_j(mid,j),mask_i(mid,i))
11429                      ENDDO
11430                      local_pf(i,j,k) = temp_bin
11431                   ENDDO
11432                ENDDO
11433             ENDDO
11434          ELSE
11435             DO  i = 1, mask_size_l(mid,1)
11436                DO  j = 1, mask_size_l(mid,2)
11437                   DO  k = 1, mask_size_l(mid,3)
11438                       local_pf(i,j,k) = mbins_av(mask_k(mid,k),               &
11439                                                  mask_j(mid,j),mask_i(mid,i),5)
11440                   ENDDO
11441                ENDDO
11442             ENDDO
11443          ENDIF
11444       
11445       CASE ( 'm_bin6' )
11446          IF ( av == 0 )  THEN
11447             DO  i = 1, mask_size_l(mid,1)
11448                DO  j = 1, mask_size_l(mid,2)
11449                   DO  k = 1, mask_size_l(mid,3)
11450                      temp_bin = 0.0_wp
11451                      DO  c = 6, ncc_tot*nbins, nbins
11452                         temp_bin = temp_bin + aerosol_mass(c)%conc(           &
11453                                    mask_k(mid,k),mask_j(mid,j),mask_i(mid,i))
11454                      ENDDO
11455                      local_pf(i,j,k) = temp_bin
11456                   ENDDO
11457                ENDDO
11458             ENDDO
11459          ELSE
11460             DO  i = 1, mask_size_l(mid,1)
11461                DO  j = 1, mask_size_l(mid,2)
11462                   DO  k = 1, mask_size_l(mid,3)
11463                       local_pf(i,j,k) = mbins_av(mask_k(mid,k),               &
11464                                                  mask_j(mid,j),mask_i(mid,i),6)
11465                   ENDDO
11466                ENDDO
11467             ENDDO
11468          ENDIF
11469         
11470       CASE ( 'm_bin7' )
11471          IF ( av == 0 )  THEN
11472             DO  i = 1, mask_size_l(mid,1)
11473                DO  j = 1, mask_size_l(mid,2)
11474                   DO  k = 1, mask_size_l(mid,3)
11475                      temp_bin = 0.0_wp
11476                      DO  c = 7, ncc_tot*nbins, nbins
11477                         temp_bin = temp_bin + aerosol_mass(c)%conc(           &
11478                                    mask_k(mid,k),mask_j(mid,j),mask_i(mid,i))
11479                      ENDDO
11480                      local_pf(i,j,k) = temp_bin
11481                   ENDDO
11482                ENDDO
11483             ENDDO
11484          ELSE
11485             DO  i = 1, mask_size_l(mid,1)
11486                DO  j = 1, mask_size_l(mid,2)
11487                   DO  k = 1, mask_size_l(mid,3)
11488                       local_pf(i,j,k) = mbins_av(mask_k(mid,k),               &
11489                                                  mask_j(mid,j),mask_i(mid,i),7)
11490                   ENDDO
11491                ENDDO
11492             ENDDO
11493          ENDIF
11494       
11495       CASE ( 'm_bin8' )
11496          IF ( av == 0 )  THEN
11497             DO  i = 1, mask_size_l(mid,1)
11498                DO  j = 1, mask_size_l(mid,2)
11499                   DO  k = 1, mask_size_l(mid,3)
11500                      temp_bin = 0.0_wp
11501                      DO  c = 8, ncc_tot*nbins, nbins
11502                         temp_bin = temp_bin + aerosol_mass(c)%conc(           &
11503                                    mask_k(mid,k),mask_j(mid,j),mask_i(mid,i))
11504                      ENDDO
11505                      local_pf(i,j,k) = temp_bin
11506                   ENDDO
11507                ENDDO
11508             ENDDO
11509          ELSE
11510             DO  i = 1, mask_size_l(mid,1)
11511                DO  j = 1, mask_size_l(mid,2)
11512                   DO  k = 1, mask_size_l(mid,3)
11513                       local_pf(i,j,k) = mbins_av(mask_k(mid,k),               &
11514                                                  mask_j(mid,j),mask_i(mid,i),8)
11515                   ENDDO
11516                ENDDO
11517             ENDDO
11518          ENDIF
11519         
11520       CASE ( 'm_bin9' )
11521          IF ( av == 0 )  THEN
11522             DO  i = 1, mask_size_l(mid,1)
11523                DO  j = 1, mask_size_l(mid,2)
11524                   DO  k = 1, mask_size_l(mid,3)
11525                      temp_bin = 0.0_wp
11526                      DO  c = 9, ncc_tot*nbins, nbins
11527                         temp_bin = temp_bin + aerosol_mass(c)%conc(           &
11528                                    mask_k(mid,k),mask_j(mid,j),mask_i(mid,i))
11529                      ENDDO
11530                      local_pf(i,j,k) = temp_bin
11531                   ENDDO
11532                ENDDO
11533             ENDDO
11534          ELSE
11535             DO  i = 1, mask_size_l(mid,1)
11536                DO  j = 1, mask_size_l(mid,2)
11537                   DO  k = 1, mask_size_l(mid,3)
11538                       local_pf(i,j,k) = mbins_av(mask_k(mid,k),               &
11539                                                  mask_j(mid,j),mask_i(mid,i),9)
11540                   ENDDO
11541                ENDDO
11542             ENDDO
11543          ENDIF
11544       
11545       CASE ( 'm_bin10' )
11546          IF ( av == 0 )  THEN
11547             DO  i = 1, mask_size_l(mid,1)
11548                DO  j = 1, mask_size_l(mid,2)
11549                   DO  k = 1, mask_size_l(mid,3)
11550                      temp_bin = 0.0_wp
11551                      DO  c = 10, ncc_tot*nbins, nbins
11552                         temp_bin = temp_bin + aerosol_mass(c)%conc(           &
11553                                    mask_k(mid,k),mask_j(mid,j),mask_i(mid,i))
11554                      ENDDO
11555                      local_pf(i,j,k) = temp_bin
11556                   ENDDO
11557                ENDDO
11558             ENDDO
11559          ELSE
11560             DO  i = 1, mask_size_l(mid,1)
11561                DO  j = 1, mask_size_l(mid,2)
11562                   DO  k = 1, mask_size_l(mid,3)
11563                       local_pf(i,j,k) = mbins_av(mask_k(mid,k),               &
11564                                                 mask_j(mid,j),mask_i(mid,i),10)
11565                   ENDDO
11566                ENDDO
11567             ENDDO
11568          ENDIF
11569         
11570       CASE ( 'm_bin11' )
11571         IF ( av == 0 )  THEN
11572             DO  i = 1, mask_size_l(mid,1)
11573                DO  j = 1, mask_size_l(mid,2)
11574                   DO  k = 1, mask_size_l(mid,3)
11575                      temp_bin = 0.0_wp
11576                      DO  c = 11, ncc_tot*nbins, nbins
11577                         temp_bin = temp_bin + aerosol_mass(c)%conc(           &
11578                                    mask_k(mid,k),mask_j(mid,j),mask_i(mid,i))
11579                      ENDDO
11580                      local_pf(i,j,k) = temp_bin
11581                   ENDDO
11582                ENDDO
11583             ENDDO
11584          ELSE
11585             DO  i = 1, mask_size_l(mid,1)
11586                DO  j = 1, mask_size_l(mid,2)
11587                   DO  k = 1, mask_size_l(mid,3)
11588                       local_pf(i,j,k) = mbins_av(mask_k(mid,k),               &
11589                                                 mask_j(mid,j),mask_i(mid,i),11)
11590                   ENDDO
11591                ENDDO
11592             ENDDO
11593          ENDIF
11594         
11595       CASE ( 'm_bin12' )
11596          IF ( av == 0 )  THEN
11597             DO  i = 1, mask_size_l(mid,1)
11598                DO  j = 1, mask_size_l(mid,2)
11599                   DO  k = 1, mask_size_l(mid,3)
11600                      temp_bin = 0.0_wp
11601                      DO  c = 12, ncc_tot*nbins, nbins
11602                         temp_bin = temp_bin + aerosol_mass(c)%conc(           &
11603                                    mask_k(mid,k),mask_j(mid,j),mask_i(mid,i))
11604                      ENDDO
11605                      local_pf(i,j,k) = temp_bin
11606                   ENDDO
11607                ENDDO
11608             ENDDO
11609          ELSE
11610             DO  i = 1, mask_size_l(mid,1)
11611                DO  j = 1, mask_size_l(mid,2)
11612                   DO  k = 1, mask_size_l(mid,3)
11613                       local_pf(i,j,k) = mbins_av(mask_k(mid,k),               &
11614                                                 mask_j(mid,j),mask_i(mid,i),12)
11615                   ENDDO
11616                ENDDO
11617             ENDDO
11618          ENDIF
11619         
11620       CASE ( 's_BC', 's_DU', 's_NH', 's_NO', 's_OC', 's_SO4', 's_SS' )
11621          IF ( is_used( prtcl, TRIM( variable(3:) ) ) )  THEN
11622             icc = get_index( prtcl, TRIM( variable(3:) ) )
11623             IF ( av == 0 )  THEN
11624                DO  i = 1, mask_size_l(mid,1)
11625                   DO  j = 1, mask_size_l(mid,2)
11626                      DO  k = 1, mask_size_l(mid,3)
11627                         temp_bin = 0.0_wp
11628                         DO  c = ( icc-1 )*nbins+1, icc*nbins 
11629                            temp_bin = temp_bin + aerosol_mass(c)%conc(        &
11630                                      mask_k(mid,k),mask_j(mid,j),mask_i(mid,i))
11631                         ENDDO
11632                         local_pf(i,j,k) = temp_bin
11633                      ENDDO
11634                   ENDDO
11635                ENDDO
11636             ELSE
11637                IF ( TRIM( variable(3:) ) == 'BC' )   to_be_resorted => s_BC_av
11638                IF ( TRIM( variable(3:) ) == 'DU' )   to_be_resorted => s_DU_av   
11639                IF ( TRIM( variable(3:) ) == 'NH' )   to_be_resorted => s_NH_av   
11640                IF ( TRIM( variable(3:) ) == 'NO' )   to_be_resorted => s_NO_av   
11641                IF ( TRIM( variable(3:) ) == 'OC' )   to_be_resorted => s_OC_av   
11642                IF ( TRIM( variable(3:) ) == 'SO4' )  to_be_resorted => s_SO4_av   
11643                IF ( TRIM( variable(3:) ) == 'SS' )   to_be_resorted => s_SS_av 
11644                DO  i = 1, mask_size_l(mid,1)
11645                   DO  j = 1, mask_size_l(mid,2)
11646                      DO  k = 1, mask_size_l(mid,3)                   
11647                         local_pf(i,j,k) = to_be_resorted(mask_k(mid,k),       &
11648                                                    mask_j(mid,j),mask_i(mid,i))
11649                      ENDDO
11650                   ENDDO
11651                ENDDO
11652             ENDIF
11653          ENDIF
11654       
11655       CASE DEFAULT
11656          found = .FALSE.
11657   
11658    END SELECT
11659   
11660 END SUBROUTINE salsa_data_output_mask
11661 
11662
11663 END MODULE salsa_mod
Note: See TracBrowser for help on using the repository browser.